summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-08-19 16:48:59 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-08-19 16:48:59 -0700
commit07fcbb558d797272b9f43547da60beda485873a3 (patch)
tree77d5da14e9f9d9d8b1d877c70c01296fd3893796
parentc9bdeff3e45a7ac84a74a81bb048046f82dddc91 (diff)
parentfb81c8c3adf8633f2f617c82f6019aef630860c7 (diff)
downloademacs-07fcbb558d797272b9f43547da60beda485873a3.tar.gz
Merge remote-tracking branch 'origin/master' into athena/unstable
-rw-r--r--.gitignore12
-rw-r--r--CONTRIBUTE17
-rw-r--r--ChangeLog.3395
-rw-r--r--GNUmakefile2
-rw-r--r--Makefile.in205
-rw-r--r--admin/CPP-DEFINES45
-rw-r--r--admin/MAINTAINERS7
-rw-r--r--admin/admin.el13
-rw-r--r--admin/authors.el6
-rw-r--r--admin/charsets/Makefile.in23
-rw-r--r--admin/charsets/eucjp-ms.awk2
-rw-r--r--admin/charsets/mapfiles/README4
-rw-r--r--admin/charsets/mule-charsets.el2
-rwxr-xr-xadmin/check-doc-strings57
-rw-r--r--admin/cus-test.el12
-rwxr-xr-xadmin/emake16
-rw-r--r--admin/gitmerge.el2
-rw-r--r--admin/grammars/Makefile.in58
-rw-r--r--admin/grammars/c.by2
-rw-r--r--admin/grammars/grammar.wy10
-rw-r--r--admin/grammars/python.wy33
-rw-r--r--admin/make-tarball.txt107
-rwxr-xr-xadmin/merge-gnulib2
-rw-r--r--admin/notes/emba15
-rw-r--r--admin/notes/years6
-rw-r--r--admin/unidata/Makefile.in33
-rw-r--r--admin/unidata/unidata-gen.el6
-rwxr-xr-xadmin/update_autogen12
-rwxr-xr-xbuild-aux/make-info-dir30
-rw-r--r--configure.ac290
-rw-r--r--doc/emacs/Makefile.in28
-rw-r--r--doc/emacs/back.texi102
-rw-r--r--doc/emacs/basic.texi21
-rw-r--r--doc/emacs/book-spine.texi20
-rw-r--r--doc/emacs/buffers.texi12
-rw-r--r--doc/emacs/building.texi7
-rw-r--r--doc/emacs/commands.texi2
-rw-r--r--doc/emacs/custom.texi43
-rw-r--r--doc/emacs/dired.texi43
-rw-r--r--doc/emacs/display.texi48
-rw-r--r--doc/emacs/docstyle.texi1
-rw-r--r--doc/emacs/emacs.texi10
-rw-r--r--doc/emacs/files.texi39
-rw-r--r--doc/emacs/fixit.texi9
-rw-r--r--doc/emacs/frames.texi37
-rw-r--r--doc/emacs/help.texi59
-rw-r--r--doc/emacs/killing.texi126
-rw-r--r--doc/emacs/m-x.texi20
-rw-r--r--doc/emacs/maintaining.texi207
-rw-r--r--doc/emacs/mini.texi34
-rw-r--r--doc/emacs/misc.texi47
-rw-r--r--doc/emacs/modes.texi10
-rw-r--r--doc/emacs/msdos.texi9
-rw-r--r--doc/emacs/mule.texi6
-rw-r--r--doc/emacs/package.texi30
-rw-r--r--doc/emacs/search.texi31
-rw-r--r--doc/emacs/text.texi67
-rw-r--r--doc/emacs/windows.texi3
-rw-r--r--doc/lispintro/Makefile.in25
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi113
-rw-r--r--doc/lispref/Makefile.in25
-rw-r--r--doc/lispref/backups.texi6
-rw-r--r--doc/lispref/buffers.texi7
-rw-r--r--doc/lispref/commands.texi134
-rw-r--r--doc/lispref/compile.texi256
-rw-r--r--doc/lispref/control.texi35
-rw-r--r--doc/lispref/customize.texi26
-rw-r--r--doc/lispref/debugging.texi16
-rw-r--r--doc/lispref/display.texi95
-rw-r--r--doc/lispref/edebug.texi102
-rw-r--r--doc/lispref/elisp.texi11
-rw-r--r--doc/lispref/errors.texi9
-rw-r--r--doc/lispref/eval.texi4
-rw-r--r--doc/lispref/files.texi129
-rw-r--r--doc/lispref/frames.texi26
-rw-r--r--doc/lispref/functions.texi34
-rw-r--r--doc/lispref/help.texi22
-rw-r--r--doc/lispref/hooks.texi2
-rw-r--r--doc/lispref/internals.texi2
-rw-r--r--doc/lispref/intro.texi2
-rw-r--r--doc/lispref/keymaps.texi16
-rw-r--r--doc/lispref/lists.texi14
-rw-r--r--doc/lispref/loading.texi39
-rw-r--r--doc/lispref/macros.texi28
-rw-r--r--doc/lispref/maps.texi3
-rw-r--r--doc/lispref/markers.texi4
-rw-r--r--doc/lispref/minibuf.texi183
-rw-r--r--doc/lispref/modes.texi142
-rw-r--r--doc/lispref/nonascii.texi10
-rw-r--r--doc/lispref/numbers.texi5
-rw-r--r--doc/lispref/objects.texi12
-rw-r--r--doc/lispref/os.texi27
-rw-r--r--doc/lispref/package.texi9
-rw-r--r--doc/lispref/positions.texi1
-rw-r--r--doc/lispref/processes.texi349
-rw-r--r--doc/lispref/searching.texi50
-rw-r--r--doc/lispref/sequences.texi19
-rw-r--r--doc/lispref/strings.texi16
-rw-r--r--doc/lispref/syntax.texi19
-rw-r--r--doc/lispref/text.texi86
-rw-r--r--doc/lispref/tips.texi21
-rw-r--r--doc/lispref/variables.texi33
-rw-r--r--doc/lispref/windows.texi134
-rw-r--r--doc/man/emacs.1.in4
-rw-r--r--doc/man/etags.123
-rw-r--r--doc/misc/Makefile.in75
-rw-r--r--doc/misc/autotype.texi2
-rw-r--r--doc/misc/bovine.texi25
-rw-r--r--doc/misc/calc.texi833
-rw-r--r--doc/misc/cc-mode.texi236
-rw-r--r--doc/misc/cl.texi15
-rw-r--r--doc/misc/ede.texi138
-rw-r--r--doc/misc/efaq-w32.texi9
-rw-r--r--doc/misc/efaq.texi153
-rw-r--r--doc/misc/eieio.texi88
-rw-r--r--doc/misc/emacs-mime.texi5
-rw-r--r--doc/misc/epa.texi54
-rw-r--r--doc/misc/erc.texi134
-rw-r--r--doc/misc/ert.texi4
-rw-r--r--doc/misc/eshell.texi4
-rw-r--r--doc/misc/eww.texi19
-rw-r--r--doc/misc/forms.texi3
-rw-r--r--doc/misc/gnus-faq.texi14
-rw-r--r--doc/misc/gnus.texi153
-rw-r--r--doc/misc/message.texi171
-rw-r--r--doc/misc/mh-e.texi248
-rw-r--r--doc/misc/modus-themes.org4677
-rw-r--r--doc/misc/modus-themes.texi2834
-rw-r--r--doc/misc/nxml-mode.texi2
-rw-r--r--doc/misc/octave-mode.texi5
-rw-r--r--doc/misc/org-setup.org53
-rw-r--r--doc/misc/org.org21904
-rw-r--r--doc/misc/org.texi23148
-rw-r--r--doc/misc/pcl-cvs.texi2
-rw-r--r--doc/misc/rcirc.texi47
-rw-r--r--doc/misc/reftex.texi87
-rw-r--r--doc/misc/remember.texi3
-rw-r--r--doc/misc/sem-user.texi2
-rw-r--r--doc/misc/smtpmail.texi22
-rw-r--r--doc/misc/srecode.texi2
-rw-r--r--doc/misc/texinfo.tex4
-rw-r--r--doc/misc/todo-mode.texi70
-rw-r--r--doc/misc/tramp.texi715
-rw-r--r--doc/misc/trampver.texi2
-rw-r--r--doc/misc/wisent.texi6
-rw-r--r--doc/misc/woman.texi8
-rw-r--r--etc/HELLO1
-rw-r--r--etc/HISTORY2
-rw-r--r--etc/NEWS1533
-rw-r--r--etc/NEWS.191
-rw-r--r--etc/NEWS.2748
-rw-r--r--etc/ORG-NEWS2
-rw-r--r--etc/TODO18
-rw-r--r--etc/compilation.txt8
-rw-r--r--etc/emacs-mail.desktop2
-rw-r--r--etc/emacs.desktop2
-rw-r--r--etc/emacs.metainfo.xml (renamed from etc/emacs.appdata.xml)25
-rw-r--r--etc/emacsclient-mail.desktop20
-rw-r--r--etc/emacsclient.desktop16
-rw-r--r--etc/grep.txt4
-rw-r--r--etc/images/README27
-rw-r--r--etc/images/checkbox-mixed.svg6
-rw-r--r--etc/images/checked.svg6
-rw-r--r--etc/images/down.svg40
-rw-r--r--etc/images/left.svg40
-rw-r--r--etc/images/radio-checked.svg6
-rw-r--r--etc/images/radio-mixed.svg6
-rw-r--r--etc/images/radio.svg3
-rw-r--r--etc/images/right.svg40
-rw-r--r--etc/images/unchecked.svg3
-rw-r--r--etc/images/up.svg40
-rw-r--r--etc/refcards/de-refcard.tex2
-rw-r--r--etc/refcards/fr-refcard.tex2
-rw-r--r--etc/refcards/pl-refcard.tex2
-rw-r--r--etc/refcards/pt-br-refcard.tex2
-rw-r--r--etc/refcards/refcard.tex4
-rw-r--r--etc/schema/OpenDocument-schema-v1.3+libreoffice.rnc892
-rw-r--r--etc/schema/OpenDocument-schema-v1.3.rnc (renamed from etc/schema/od-schema-v1.2-os.rnc)10812
-rw-r--r--etc/schema/schemas.xml6
-rw-r--r--etc/themes/manoj-dark-theme.el2
-rw-r--r--etc/themes/modus-operandi-theme.el4670
-rw-r--r--etc/themes/modus-themes.el7598
-rw-r--r--etc/themes/modus-vivendi-theme.el4670
-rw-r--r--etc/themes/wombat-theme.el4
-rw-r--r--etc/tutorials/TUTORIAL6
-rw-r--r--etc/tutorials/TUTORIAL.es6
-rw-r--r--etc/tutorials/TUTORIAL.he4
-rw-r--r--etc/tutorials/TUTORIAL.it34
-rw-r--r--etc/tutorials/TUTORIAL.sv6
-rw-r--r--leim/Makefile.in26
-rw-r--r--leim/leim-ext.el2
-rw-r--r--lib-src/Makefile.in73
-rw-r--r--lib-src/emacsclient.c226
-rw-r--r--lib-src/etags.c647
-rw-r--r--lib-src/movemail.c14
-rw-r--r--lib-src/seccomp-filter.c370
-rw-r--r--lib/Makefile.in36
-rw-r--r--lib/af_alg.h115
-rw-r--r--lib/file-has-acl.c510
-rw-r--r--lib/gnulib.mk.in11
-rw-r--r--lib/pipe2.c2
-rw-r--r--lisp/Makefile.in67
-rw-r--r--lisp/align.el6
-rw-r--r--lisp/allout-widgets.el101
-rw-r--r--lisp/allout.el148
-rw-r--r--lisp/ansi-color.el35
-rw-r--r--lisp/apropos.el147
-rw-r--r--lisp/arc-mode.el10
-rw-r--r--lisp/array.el54
-rw-r--r--lisp/auth-source-pass.el67
-rw-r--r--lisp/auth-source.el13
-rw-r--r--lisp/autoarg.el4
-rw-r--r--lisp/autoinsert.el4
-rw-r--r--lisp/autorevert.el9
-rw-r--r--lisp/avoid.el38
-rw-r--r--lisp/battery.el8
-rw-r--r--lisp/bindings.el78
-rw-r--r--lisp/bookmark.el234
-rw-r--r--lisp/bs.el3
-rw-r--r--lisp/buff-menu.el186
-rw-r--r--lisp/button.el5
-rw-r--r--lisp/calc/calc-aent.el4
-rw-r--r--lisp/calc/calc-alg.el12
-rw-r--r--lisp/calc/calc-ext.el32
-rw-r--r--lisp/calc/calc-forms.el2
-rw-r--r--lisp/calc/calc-graph.el2
-rw-r--r--lisp/calc/calc-keypd.el2
-rw-r--r--lisp/calc/calc-lang.el8
-rw-r--r--lisp/calc/calc-menu.el4
-rw-r--r--lisp/calc/calc-nlfit.el2
-rw-r--r--lisp/calc/calc-prog.el93
-rw-r--r--lisp/calc/calc-sel.el4
-rw-r--r--lisp/calc/calc-units.el2
-rw-r--r--lisp/calc/calc-yank.el5
-rw-r--r--lisp/calc/calc.el20
-rw-r--r--lisp/calc/calcalg2.el6
-rw-r--r--lisp/calc/calcalg3.el6
-rw-r--r--lisp/calculator.el73
-rw-r--r--lisp/calendar/appt.el15
-rw-r--r--lisp/calendar/cal-bahai.el4
-rw-r--r--lisp/calendar/cal-coptic.el2
-rw-r--r--lisp/calendar/cal-dst.el8
-rw-r--r--lisp/calendar/cal-french.el192
-rw-r--r--lisp/calendar/cal-html.el2
-rw-r--r--lisp/calendar/cal-menu.el6
-rw-r--r--lisp/calendar/cal-persia.el2
-rw-r--r--lisp/calendar/cal-tex.el20
-rw-r--r--lisp/calendar/calendar.el14
-rw-r--r--lisp/calendar/diary-lib.el18
-rw-r--r--lisp/calendar/holidays.el2
-rw-r--r--lisp/calendar/icalendar.el88
-rw-r--r--lisp/calendar/iso8601.el25
-rw-r--r--lisp/calendar/parse-time.el64
-rw-r--r--lisp/calendar/solar.el2
-rw-r--r--lisp/calendar/time-date.el6
-rw-r--r--lisp/calendar/timeclock.el2
-rw-r--r--lisp/calendar/todo-mode.el18
-rw-r--r--lisp/cedet/cedet-cscope.el13
-rw-r--r--lisp/cedet/cedet-files.el6
-rw-r--r--lisp/cedet/cedet-global.el11
-rw-r--r--lisp/cedet/cedet-idutils.el21
-rw-r--r--lisp/cedet/cedet.el41
-rw-r--r--lisp/cedet/data-debug.el101
-rw-r--r--lisp/cedet/ede.el79
-rw-r--r--lisp/cedet/ede/auto.el6
-rw-r--r--lisp/cedet/ede/autoconf-edit.el2
-rw-r--r--lisp/cedet/ede/base.el75
-rw-r--r--lisp/cedet/ede/config.el12
-rw-r--r--lisp/cedet/ede/cpp-root.el12
-rw-r--r--lisp/cedet/ede/custom.el66
-rw-r--r--lisp/cedet/ede/detect.el2
-rw-r--r--lisp/cedet/ede/dired.el13
-rw-r--r--lisp/cedet/ede/emacs.el27
-rw-r--r--lisp/cedet/ede/files.el24
-rw-r--r--lisp/cedet/ede/generic.el20
-rw-r--r--lisp/cedet/ede/linux.el6
-rw-r--r--lisp/cedet/ede/locate.el48
-rw-r--r--lisp/cedet/ede/make.el19
-rw-r--r--lisp/cedet/ede/makefile-edit.el2
-rw-r--r--lisp/cedet/ede/pconf.el24
-rw-r--r--lisp/cedet/ede/pmake.el85
-rw-r--r--lisp/cedet/ede/proj-archive.el6
-rw-r--r--lisp/cedet/ede/proj-aux.el2
-rw-r--r--lisp/cedet/ede/proj-comp.el46
-rw-r--r--lisp/cedet/ede/proj-elisp.el41
-rw-r--r--lisp/cedet/ede/proj-info.el9
-rw-r--r--lisp/cedet/ede/proj-misc.el2
-rw-r--r--lisp/cedet/ede/proj-obj.el15
-rw-r--r--lisp/cedet/ede/proj-prog.el6
-rw-r--r--lisp/cedet/ede/proj-scheme.el4
-rw-r--r--lisp/cedet/ede/proj-shared.el8
-rw-r--r--lisp/cedet/ede/proj.el34
-rw-r--r--lisp/cedet/ede/project-am.el119
-rw-r--r--lisp/cedet/ede/shell.el2
-rw-r--r--lisp/cedet/ede/simple.el6
-rw-r--r--lisp/cedet/ede/source.el4
-rw-r--r--lisp/cedet/ede/speedbar.el56
-rw-r--r--lisp/cedet/ede/srecode.el3
-rw-r--r--lisp/cedet/ede/system.el2
-rw-r--r--lisp/cedet/ede/util.el2
-rw-r--r--lisp/cedet/mode-local.el42
-rw-r--r--lisp/cedet/pulse.el117
-rw-r--r--lisp/cedet/semantic.el89
-rw-r--r--lisp/cedet/semantic/analyze.el32
-rw-r--r--lisp/cedet/semantic/analyze/complete.el16
-rw-r--r--lisp/cedet/semantic/analyze/debug.el25
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el4
-rw-r--r--lisp/cedet/semantic/analyze/refs.el4
-rw-r--r--lisp/cedet/semantic/bovine.el32
-rw-r--r--lisp/cedet/semantic/bovine/c.el100
-rw-r--r--lisp/cedet/semantic/bovine/debug.el4
-rw-r--r--lisp/cedet/semantic/bovine/el.el50
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el22
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el13
-rw-r--r--lisp/cedet/semantic/bovine/make.el12
-rw-r--r--lisp/cedet/semantic/bovine/scm.el11
-rw-r--r--lisp/cedet/semantic/chart.el12
-rw-r--r--lisp/cedet/semantic/complete.el123
-rw-r--r--lisp/cedet/semantic/ctxt.el24
-rw-r--r--lisp/cedet/semantic/db-debug.el6
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el50
-rw-r--r--lisp/cedet/semantic/db-el.el16
-rw-r--r--lisp/cedet/semantic/db-file.el37
-rw-r--r--lisp/cedet/semantic/db-find.el17
-rw-r--r--lisp/cedet/semantic/db-global.el19
-rw-r--r--lisp/cedet/semantic/db-javascript.el22
-rw-r--r--lisp/cedet/semantic/db-mode.el2
-rw-r--r--lisp/cedet/semantic/db-ref.el8
-rw-r--r--lisp/cedet/semantic/db-typecache.el26
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/debug.el52
-rw-r--r--lisp/cedet/semantic/decorate.el11
-rw-r--r--lisp/cedet/semantic/decorate/include.el16
-rw-r--r--lisp/cedet/semantic/decorate/mode.el30
-rw-r--r--lisp/cedet/semantic/dep.el26
-rw-r--r--lisp/cedet/semantic/doc.el4
-rw-r--r--lisp/cedet/semantic/ede-grammar.el34
-rw-r--r--lisp/cedet/semantic/edit.el21
-rw-r--r--lisp/cedet/semantic/find.el6
-rw-r--r--lisp/cedet/semantic/format.el10
-rw-r--r--lisp/cedet/semantic/fw.el90
-rw-r--r--lisp/cedet/semantic/grammar-wy.el496
-rw-r--r--lisp/cedet/semantic/grammar.el113
-rw-r--r--lisp/cedet/semantic/grm-wy-boot.el503
-rw-r--r--lisp/cedet/semantic/html.el10
-rw-r--r--lisp/cedet/semantic/ia-sb.el36
-rw-r--r--lisp/cedet/semantic/ia.el13
-rw-r--r--lisp/cedet/semantic/idle.el244
-rw-r--r--lisp/cedet/semantic/imenu.el38
-rw-r--r--lisp/cedet/semantic/java.el70
-rw-r--r--lisp/cedet/semantic/lex-spp.el79
-rw-r--r--lisp/cedet/semantic/lex.el81
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el20
-rw-r--r--lisp/cedet/semantic/sb.el14
-rw-r--r--lisp/cedet/semantic/scope.el18
-rw-r--r--lisp/cedet/semantic/senator.el21
-rw-r--r--lisp/cedet/semantic/sort.el20
-rw-r--r--lisp/cedet/semantic/symref.el8
-rw-r--r--lisp/cedet/semantic/symref/cscope.el4
-rw-r--r--lisp/cedet/semantic/symref/filter.el10
-rw-r--r--lisp/cedet/semantic/symref/global.el2
-rw-r--r--lisp/cedet/semantic/symref/grep.el4
-rw-r--r--lisp/cedet/semantic/symref/idutils.el4
-rw-r--r--lisp/cedet/semantic/symref/list.el30
-rw-r--r--lisp/cedet/semantic/tag-file.el2
-rw-r--r--lisp/cedet/semantic/tag-ls.el23
-rw-r--r--lisp/cedet/semantic/tag-write.el4
-rw-r--r--lisp/cedet/semantic/tag.el80
-rw-r--r--lisp/cedet/semantic/texi.el18
-rw-r--r--lisp/cedet/semantic/util-modes.el68
-rw-r--r--lisp/cedet/semantic/util.el11
-rw-r--r--lisp/cedet/semantic/wisent.el33
-rw-r--r--lisp/cedet/semantic/wisent/comp.el125
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el43
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el15
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el23
-rw-r--r--lisp/cedet/semantic/wisent/python.el16
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el19
-rw-r--r--lisp/cedet/srecode.el2
-rw-r--r--lisp/cedet/srecode/args.el2
-rw-r--r--lisp/cedet/srecode/compile.el13
-rw-r--r--lisp/cedet/srecode/cpp.el7
-rw-r--r--lisp/cedet/srecode/ctxt.el2
-rw-r--r--lisp/cedet/srecode/dictionary.el21
-rw-r--r--lisp/cedet/srecode/document.el11
-rw-r--r--lisp/cedet/srecode/el.el2
-rw-r--r--lisp/cedet/srecode/expandproto.el2
-rw-r--r--lisp/cedet/srecode/extract.el20
-rw-r--r--lisp/cedet/srecode/fields.el31
-rw-r--r--lisp/cedet/srecode/filters.el2
-rw-r--r--lisp/cedet/srecode/find.el23
-rw-r--r--lisp/cedet/srecode/getset.el4
-rw-r--r--lisp/cedet/srecode/insert.el17
-rw-r--r--lisp/cedet/srecode/java.el2
-rw-r--r--lisp/cedet/srecode/map.el6
-rw-r--r--lisp/cedet/srecode/mode.el35
-rw-r--r--lisp/cedet/srecode/srt-mode.el16
-rw-r--r--lisp/cedet/srecode/srt.el8
-rw-r--r--lisp/cedet/srecode/table.el6
-rw-r--r--lisp/cedet/srecode/template.el8
-rw-r--r--lisp/cedet/srecode/texi.el4
-rw-r--r--lisp/chistory.el21
-rw-r--r--lisp/cmuscheme.el107
-rw-r--r--lisp/comint.el94
-rw-r--r--lisp/completion.el186
-rw-r--r--lisp/cus-dep.el11
-rw-r--r--lisp/cus-edit.el19
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/cus-start.el47
-rw-r--r--lisp/cus-theme.el118
-rw-r--r--lisp/custom.el82
-rw-r--r--lisp/delsel.el9
-rw-r--r--lisp/descr-text.el2
-rw-r--r--lisp/desktop.el13
-rw-r--r--lisp/dframe.el4
-rw-r--r--lisp/dired-aux.el322
-rw-r--r--lisp/dired-x.el181
-rw-r--r--lisp/dired.el872
-rw-r--r--lisp/dirtrack.el14
-rw-r--r--lisp/display-line-numbers.el21
-rw-r--r--lisp/dnd.el1
-rw-r--r--lisp/doc-view.el20
-rw-r--r--lisp/dos-fns.el12
-rw-r--r--lisp/dos-w32.el2
-rw-r--r--lisp/double.el4
-rw-r--r--lisp/dynamic-setting.el11
-rw-r--r--lisp/ebuff-menu.el90
-rw-r--r--lisp/echistory.el77
-rw-r--r--lisp/edmacro.el38
-rw-r--r--lisp/electric.el5
-rw-r--r--lisp/emacs-lisp/advice.el5
-rw-r--r--lisp/emacs-lisp/autoload.el28
-rw-r--r--lisp/emacs-lisp/avl-tree.el61
-rw-r--r--lisp/emacs-lisp/backtrace.el8
-rw-r--r--lisp/emacs-lisp/benchmark.el100
-rw-r--r--lisp/emacs-lisp/bindat.el883
-rw-r--r--lisp/emacs-lisp/byte-opt.el506
-rw-r--r--lisp/emacs-lisp/byte-run.el31
-rw-r--r--lisp/emacs-lisp/bytecomp.el617
-rw-r--r--lisp/emacs-lisp/cconv.el304
-rw-r--r--lisp/emacs-lisp/chart.el72
-rw-r--r--lisp/emacs-lisp/check-declare.el2
-rw-r--r--lisp/emacs-lisp/checkdoc.el31
-rw-r--r--lisp/emacs-lisp/cl-extra.el34
-rw-r--r--lisp/emacs-lisp/cl-generic.el129
-rw-r--r--lisp/emacs-lisp/cl-indent.el2
-rw-r--r--lisp/emacs-lisp/cl-lib.el118
-rw-r--r--lisp/emacs-lisp/cl-macs.el335
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el21
-rw-r--r--lisp/emacs-lisp/comp-cstr.el1197
-rw-r--r--lisp/emacs-lisp/comp.el4234
-rw-r--r--lisp/emacs-lisp/copyright.el29
-rw-r--r--lisp/emacs-lisp/crm.el3
-rw-r--r--lisp/emacs-lisp/debug.el10
-rw-r--r--lisp/emacs-lisp/derived.el7
-rw-r--r--lisp/emacs-lisp/disass.el31
-rw-r--r--lisp/emacs-lisp/easy-mmode.el242
-rw-r--r--lisp/emacs-lisp/easymenu.el42
-rw-r--r--lisp/emacs-lisp/edebug.el781
-rw-r--r--lisp/emacs-lisp/eieio-base.el5
-rw-r--r--lisp/emacs-lisp/eieio-compat.el2
-rw-r--r--lisp/emacs-lisp/eieio-core.el171
-rw-r--r--lisp/emacs-lisp/eieio-custom.el4
-rw-r--r--lisp/emacs-lisp/eieio-opt.el6
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el16
-rw-r--r--lisp/emacs-lisp/eieio.el107
-rw-r--r--lisp/emacs-lisp/eldoc.el23
-rw-r--r--lisp/emacs-lisp/elp.el50
-rw-r--r--lisp/emacs-lisp/ert-x.el14
-rw-r--r--lisp/emacs-lisp/ert.el117
-rw-r--r--lisp/emacs-lisp/faceup.el5
-rw-r--r--lisp/emacs-lisp/find-func.el21
-rw-r--r--lisp/emacs-lisp/float-sup.el1
-rw-r--r--lisp/emacs-lisp/generator.el2
-rw-r--r--lisp/emacs-lisp/gv.el119
-rw-r--r--lisp/emacs-lisp/inline.el2
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el52
-rw-r--r--lisp/emacs-lisp/lisp-mode.el47
-rw-r--r--lisp/emacs-lisp/lisp.el246
-rw-r--r--lisp/emacs-lisp/macroexp.el272
-rw-r--r--lisp/emacs-lisp/map-ynp.el92
-rw-r--r--lisp/emacs-lisp/map.el390
-rw-r--r--lisp/emacs-lisp/memory-report.el27
-rw-r--r--lisp/emacs-lisp/nadvice.el20
-rw-r--r--lisp/emacs-lisp/package.el233
-rw-r--r--lisp/emacs-lisp/pcase.el383
-rw-r--r--lisp/emacs-lisp/pp.el11
-rw-r--r--lisp/emacs-lisp/radix-tree.el15
-rw-r--r--lisp/emacs-lisp/re-builder.el102
-rw-r--r--lisp/emacs-lisp/ring.el2
-rw-r--r--lisp/emacs-lisp/rmc.el154
-rw-r--r--lisp/emacs-lisp/rx.el47
-rw-r--r--lisp/emacs-lisp/seq.el34
-rw-r--r--lisp/emacs-lisp/shadow.el9
-rw-r--r--lisp/emacs-lisp/shortdoc.el174
-rw-r--r--lisp/emacs-lisp/smie.el40
-rw-r--r--lisp/emacs-lisp/subr-x.el48
-rw-r--r--lisp/emacs-lisp/syntax.el17
-rw-r--r--lisp/emacs-lisp/tabulated-list.el87
-rw-r--r--lisp/emacs-lisp/tcover-ses.el10
-rw-r--r--lisp/emacs-lisp/testcover.el4
-rw-r--r--lisp/emacs-lisp/text-property-search.el44
-rw-r--r--lisp/emacs-lisp/thunk.el2
-rw-r--r--lisp/emacs-lisp/trace.el4
-rw-r--r--lisp/emacs-lisp/unsafep.el2
-rw-r--r--lisp/emacs-lisp/warnings.el2
-rw-r--r--lisp/emulation/cua-base.el211
-rw-r--r--lisp/emulation/cua-gmrk.el53
-rw-r--r--lisp/emulation/cua-rect.el150
-rw-r--r--lisp/emulation/edt-mapper.el8
-rw-r--r--lisp/emulation/edt.el146
-rw-r--r--lisp/emulation/keypad.el18
-rw-r--r--lisp/emulation/viper-cmd.el168
-rw-r--r--lisp/emulation/viper-ex.el41
-rw-r--r--lisp/emulation/viper-init.el6
-rw-r--r--lisp/emulation/viper-keym.el66
-rw-r--r--lisp/emulation/viper-macs.el65
-rw-r--r--lisp/emulation/viper-mous.el53
-rw-r--r--lisp/emulation/viper-util.el96
-rw-r--r--lisp/emulation/viper.el6
-rw-r--r--lisp/env.el4
-rw-r--r--lisp/epa-file.el4
-rw-r--r--lisp/epa-ks.el345
-rw-r--r--lisp/epa-mail.el20
-rw-r--r--lisp/epa.el62
-rw-r--r--lisp/epg-config.el6
-rw-r--r--lisp/epg.el2
-rw-r--r--lisp/erc/erc-autoaway.el54
-rw-r--r--lisp/erc/erc-backend.el87
-rw-r--r--lisp/erc/erc-button.el59
-rw-r--r--lisp/erc/erc-capab.el36
-rw-r--r--lisp/erc/erc-dcc.el106
-rw-r--r--lisp/erc/erc-desktop-notifications.el12
-rw-r--r--lisp/erc/erc-ezbounce.el18
-rw-r--r--lisp/erc/erc-fill.el18
-rw-r--r--lisp/erc/erc-goodies.el65
-rw-r--r--lisp/erc/erc-ibuffer.el11
-rw-r--r--lisp/erc/erc-identd.el19
-rw-r--r--lisp/erc/erc-imenu.el9
-rw-r--r--lisp/erc/erc-join.el28
-rw-r--r--lisp/erc/erc-lang.el4
-rw-r--r--lisp/erc/erc-list.el26
-rw-r--r--lisp/erc/erc-log.el59
-rw-r--r--lisp/erc/erc-match.el50
-rw-r--r--lisp/erc/erc-menu.el9
-rw-r--r--lisp/erc/erc-netsplit.el25
-rw-r--r--lisp/erc/erc-networks.el34
-rw-r--r--lisp/erc/erc-notify.el26
-rw-r--r--lisp/erc/erc-page.el18
-rw-r--r--lisp/erc/erc-pcomplete.el20
-rw-r--r--lisp/erc/erc-replace.el15
-rw-r--r--lisp/erc/erc-ring.el32
-rw-r--r--lisp/erc/erc-services.el69
-rw-r--r--lisp/erc/erc-sound.el15
-rw-r--r--lisp/erc/erc-speedbar.el33
-rw-r--r--lisp/erc/erc-spelling.el10
-rw-r--r--lisp/erc/erc-stamp.el66
-rw-r--r--lisp/erc/erc-status-sidebar.el30
-rw-r--r--lisp/erc/erc-track.el85
-rw-r--r--lisp/erc/erc-truncate.el7
-rw-r--r--lisp/erc/erc-xdcc.el16
-rw-r--r--lisp/erc/erc.el350
-rw-r--r--lisp/eshell/em-cmpl.el6
-rw-r--r--lisp/eshell/em-dirs.el13
-rw-r--r--lisp/eshell/em-glob.el2
-rw-r--r--lisp/eshell/em-hist.el9
-rw-r--r--lisp/eshell/em-ls.el6
-rw-r--r--lisp/eshell/em-pred.el225
-rw-r--r--lisp/eshell/em-script.el11
-rw-r--r--lisp/eshell/em-xtra.el44
-rw-r--r--lisp/eshell/esh-mode.el2
-rw-r--r--lisp/eshell/esh-opt.el8
-rw-r--r--lisp/eshell/esh-proc.el40
-rw-r--r--lisp/eshell/esh-util.el206
-rw-r--r--lisp/eshell/esh-var.el4
-rw-r--r--lisp/eshell/eshell.el6
-rw-r--r--lisp/expand.el23
-rw-r--r--lisp/facemenu.el139
-rw-r--r--lisp/faces.el125
-rw-r--r--lisp/ffap.el54
-rw-r--r--lisp/filecache.el39
-rw-r--r--lisp/fileloop.el8
-rw-r--r--lisp/filenotify.el2
-rw-r--r--lisp/files-x.el17
-rw-r--r--lisp/files.el1180
-rw-r--r--lisp/filesets.el64
-rw-r--r--lisp/find-dired.el4
-rw-r--r--lisp/find-file.el310
-rw-r--r--lisp/finder.el54
-rw-r--r--lisp/foldout.el71
-rw-r--r--lisp/follow.el141
-rw-r--r--lisp/font-core.el1
-rw-r--r--lisp/font-lock.el39
-rw-r--r--lisp/format.el26
-rw-r--r--lisp/forms.el84
-rw-r--r--lisp/frame.el279
-rw-r--r--lisp/frameset.el2
-rw-r--r--lisp/fringe.el13
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/.dir-locals.el4
-rw-r--r--lisp/gnus/deuglify.el10
-rw-r--r--lisp/gnus/gnus-art.el488
-rw-r--r--lisp/gnus/gnus-bookmark.el24
-rw-r--r--lisp/gnus/gnus-cache.el8
-rw-r--r--lisp/gnus/gnus-cite.el20
-rw-r--r--lisp/gnus/gnus-cus.el11
-rw-r--r--lisp/gnus/gnus-delay.el8
-rw-r--r--lisp/gnus/gnus-diary.el9
-rw-r--r--lisp/gnus/gnus-dired.el9
-rw-r--r--lisp/gnus/gnus-draft.el6
-rw-r--r--lisp/gnus/gnus-eform.el4
-rw-r--r--lisp/gnus/gnus-fun.el30
-rw-r--r--lisp/gnus/gnus-gravatar.el4
-rw-r--r--lisp/gnus/gnus-group.el454
-rw-r--r--lisp/gnus/gnus-icalendar.el68
-rw-r--r--lisp/gnus/gnus-int.el2
-rw-r--r--lisp/gnus/gnus-kill.el6
-rw-r--r--lisp/gnus/gnus-mh.el2
-rw-r--r--lisp/gnus/gnus-mlspl.el4
-rw-r--r--lisp/gnus/gnus-msg.el125
-rw-r--r--lisp/gnus/gnus-notifications.el2
-rw-r--r--lisp/gnus/gnus-picon.el8
-rw-r--r--lisp/gnus/gnus-range.el17
-rw-r--r--lisp/gnus/gnus-registry.el27
-rw-r--r--lisp/gnus/gnus-rfc1843.el2
-rw-r--r--lisp/gnus/gnus-salt.el10
-rw-r--r--lisp/gnus/gnus-score.el55
-rw-r--r--lisp/gnus/gnus-search.el201
-rw-r--r--lisp/gnus/gnus-sieve.el2
-rw-r--r--lisp/gnus/gnus-spec.el2
-rw-r--r--lisp/gnus/gnus-srvr.el89
-rw-r--r--lisp/gnus/gnus-start.el18
-rw-r--r--lisp/gnus/gnus-sum.el714
-rw-r--r--lisp/gnus/gnus-topic.el327
-rw-r--r--lisp/gnus/gnus-util.el74
-rw-r--r--lisp/gnus/gnus-uu.el105
-rw-r--r--lisp/gnus/gnus-vm.el4
-rw-r--r--lisp/gnus/gnus.el106
-rw-r--r--lisp/gnus/legacy-gnus-agent.el2
-rw-r--r--lisp/gnus/message.el425
-rw-r--r--lisp/gnus/mm-archive.el2
-rw-r--r--lisp/gnus/mm-decode.el2
-rw-r--r--lisp/gnus/mm-partial.el16
-rw-r--r--lisp/gnus/mm-view.el27
-rw-r--r--lisp/gnus/mml-sec.el46
-rw-r--r--lisp/gnus/mml-smime.el2
-rw-r--r--lisp/gnus/mml.el4
-rw-r--r--lisp/gnus/mml2015.el2
-rw-r--r--lisp/gnus/nnbabyl.el4
-rw-r--r--lisp/gnus/nndiary.el2
-rw-r--r--lisp/gnus/nnfolder.el4
-rw-r--r--lisp/gnus/nnheader.el2
-rw-r--r--lisp/gnus/nnimap.el59
-rw-r--r--lisp/gnus/nnmail.el8
-rw-r--r--lisp/gnus/nnmaildir.el22
-rw-r--r--lisp/gnus/nnmairix.el2
-rw-r--r--lisp/gnus/nnmh.el2
-rw-r--r--lisp/gnus/nnoo.el2
-rw-r--r--lisp/gnus/nnrss.el76
-rw-r--r--lisp/gnus/nnselect.el73
-rw-r--r--lisp/gnus/nntp.el6
-rw-r--r--lisp/gnus/nnvirtual.el6
-rw-r--r--lisp/gnus/score-mode.el6
-rw-r--r--lisp/gnus/smiley.el2
-rw-r--r--lisp/gnus/smime.el4
-rw-r--r--lisp/gnus/spam-report.el12
-rw-r--r--lisp/gnus/spam-stat.el3
-rw-r--r--lisp/gnus/spam.el25
-rw-r--r--lisp/help-at-pt.el5
-rw-r--r--lisp/help-fns.el224
-rw-r--r--lisp/help-macro.el257
-rw-r--r--lisp/help-mode.el128
-rw-r--r--lisp/help.el295
-rw-r--r--lisp/hexl.el136
-rw-r--r--lisp/hi-lock.el54
-rw-r--r--lisp/hilit-chg.el141
-rw-r--r--lisp/hippie-exp.el57
-rw-r--r--lisp/hl-line.el5
-rw-r--r--lisp/htmlfontify.el63
-rw-r--r--lisp/ibuf-ext.el163
-rw-r--r--lisp/ibuf-macs.el32
-rw-r--r--lisp/ibuffer.el598
-rw-r--r--lisp/icomplete.el561
-rw-r--r--lisp/ido.el18
-rw-r--r--lisp/iimage.el13
-rw-r--r--lisp/image-dired.el339
-rw-r--r--lisp/image-mode.el42
-rw-r--r--lisp/image.el80
-rw-r--r--lisp/image/exif.el5
-rw-r--r--lisp/image/image-converter.el14
-rw-r--r--lisp/imenu.el74
-rw-r--r--lisp/indent.el6
-rw-r--r--lisp/info-look.el11
-rw-r--r--lisp/info-xref.el4
-rw-r--r--lisp/info.el235
-rw-r--r--lisp/informat.el4
-rw-r--r--lisp/international/ccl.el6
-rw-r--r--lisp/international/characters.el62
-rw-r--r--lisp/international/fontset.el48
-rw-r--r--lisp/international/ja-dic-cnv.el6
-rw-r--r--lisp/international/latin1-disp.el4
-rw-r--r--lisp/international/mule-cmds.el130
-rw-r--r--lisp/international/mule-conf.el6
-rw-r--r--lisp/international/mule-diag.el22
-rw-r--r--lisp/international/mule-util.el28
-rw-r--r--lisp/international/mule.el33
-rw-r--r--lisp/international/quail.el150
-rw-r--r--lisp/international/titdic-cnv.el26
-rw-r--r--lisp/isearch.el452
-rw-r--r--lisp/isearchb.el9
-rw-r--r--lisp/jit-lock.el2
-rw-r--r--lisp/jka-cmpr-hook.el29
-rw-r--r--lisp/jka-compr.el152
-rw-r--r--lisp/json.el380
-rw-r--r--lisp/jsonrpc.el8
-rw-r--r--lisp/kmacro.el119
-rw-r--r--lisp/language/burmese.el2
-rw-r--r--lisp/language/cham.el2
-rw-r--r--lisp/language/cyrillic.el2
-rw-r--r--lisp/language/ethio-util.el58
-rw-r--r--lisp/language/japan-util.el4
-rw-r--r--lisp/language/khmer.el2
-rw-r--r--lisp/language/korea-util.el2
-rw-r--r--lisp/language/sinhala.el2
-rw-r--r--lisp/language/tai-viet.el2
-rw-r--r--lisp/language/thai-word.el4
-rw-r--r--lisp/language/tv-util.el3
-rw-r--r--lisp/ldefs-boot.el2639
-rw-r--r--lisp/leim/quail/croatian.el2
-rw-r--r--lisp/leim/quail/hangul.el22
-rw-r--r--lisp/leim/quail/hebrew.el2
-rw-r--r--lisp/leim/quail/indian.el20
-rw-r--r--lisp/leim/quail/ipa-praat.el2
-rw-r--r--lisp/leim/quail/ipa.el12
-rw-r--r--lisp/leim/quail/japanese.el10
-rw-r--r--lisp/leim/quail/lao.el4
-rw-r--r--lisp/leim/quail/latin-ltx.el54
-rw-r--r--lisp/leim/quail/latin-post.el60
-rw-r--r--lisp/leim/quail/latin-pre.el31
-rw-r--r--lisp/leim/quail/lrt.el4
-rw-r--r--lisp/leim/quail/persian.el2
-rw-r--r--lisp/leim/quail/programmer-dvorak.el2
-rw-r--r--lisp/leim/quail/sisheng.el2
-rw-r--r--lisp/leim/quail/thai.el2
-rw-r--r--lisp/leim/quail/tibetan.el8
-rw-r--r--lisp/leim/quail/uni-input.el19
-rw-r--r--lisp/linum.el8
-rw-r--r--lisp/loadhist.el17
-rw-r--r--lisp/loadup.el70
-rw-r--r--lisp/lpr.el39
-rw-r--r--lisp/ls-lisp.el76
-rw-r--r--lisp/mail/binhex.el14
-rw-r--r--lisp/mail/blessmail.el2
-rw-r--r--lisp/mail/emacsbug.el30
-rw-r--r--lisp/mail/feedmail.el12
-rw-r--r--lisp/mail/flow-fill.el4
-rw-r--r--lisp/mail/ietf-drums.el6
-rw-r--r--lisp/mail/mail-extr.el56
-rw-r--r--lisp/mail/mail-hist.el15
-rw-r--r--lisp/mail/mail-parse.el39
-rw-r--r--lisp/mail/mail-utils.el12
-rw-r--r--lisp/mail/mailabbrev.el30
-rw-r--r--lisp/mail/mailclient.el2
-rw-r--r--lisp/mail/mailheader.el35
-rw-r--r--lisp/mail/mspools.el10
-rw-r--r--lisp/mail/rfc2047.el4
-rw-r--r--lisp/mail/rfc2231.el8
-rw-r--r--lisp/mail/rfc2368.el2
-rw-r--r--lisp/mail/rfc822.el2
-rw-r--r--lisp/mail/rmail-spam-filter.el48
-rw-r--r--lisp/mail/rmail.el109
-rw-r--r--lisp/mail/rmailedit.el8
-rw-r--r--lisp/mail/rmailkwd.el6
-rw-r--r--lisp/mail/rmailmm.el202
-rw-r--r--lisp/mail/rmailmsc.el4
-rw-r--r--lisp/mail/rmailout.el15
-rw-r--r--lisp/mail/rmailsort.el6
-rw-r--r--lisp/mail/rmailsum.el7
-rw-r--r--lisp/mail/sendmail.el46
-rw-r--r--lisp/mail/smtpmail.el163
-rw-r--r--lisp/mail/supercite.el104
-rw-r--r--lisp/mail/uce.el35
-rw-r--r--lisp/mail/undigest.el2
-rw-r--r--lisp/mail/unrmail.el4
-rw-r--r--lisp/mail/uudecode.el2
-rw-r--r--lisp/man.el49
-rw-r--r--lisp/master.el15
-rw-r--r--lisp/mb-depth.el15
-rw-r--r--lisp/menu-bar.el35
-rw-r--r--lisp/mh-e/ChangeLog.12
-rw-r--r--lisp/mh-e/mh-acros.el35
-rw-r--r--lisp/mh-e/mh-alias.el27
-rw-r--r--lisp/mh-e/mh-buffers.el4
-rw-r--r--lisp/mh-e/mh-comp.el26
-rw-r--r--lisp/mh-e/mh-compat.el10
-rw-r--r--lisp/mh-e/mh-e.el122
-rw-r--r--lisp/mh-e/mh-folder.el131
-rw-r--r--lisp/mh-e/mh-funcs.el10
-rw-r--r--lisp/mh-e/mh-gnus.el6
-rw-r--r--lisp/mh-e/mh-identity.el14
-rw-r--r--lisp/mh-e/mh-inc.el20
-rw-r--r--lisp/mh-e/mh-junk.el225
-rw-r--r--lisp/mh-e/mh-letter.el17
-rw-r--r--lisp/mh-e/mh-limit.el6
-rw-r--r--lisp/mh-e/mh-mime.el60
-rw-r--r--lisp/mh-e/mh-print.el9
-rw-r--r--lisp/mh-e/mh-scan.el40
-rw-r--r--lisp/mh-e/mh-search.el78
-rw-r--r--lisp/mh-e/mh-seq.el30
-rw-r--r--lisp/mh-e/mh-show.el23
-rw-r--r--lisp/mh-e/mh-speed.el16
-rw-r--r--lisp/mh-e/mh-thread.el40
-rw-r--r--lisp/mh-e/mh-tool-bar.el8
-rw-r--r--lisp/mh-e/mh-utils.el32
-rw-r--r--lisp/mh-e/mh-xface.el6
-rw-r--r--lisp/minibuffer.el737
-rw-r--r--lisp/misc.el2
-rw-r--r--lisp/misearch.el57
-rw-r--r--lisp/mouse-copy.el5
-rw-r--r--lisp/mouse-drag.el2
-rw-r--r--lisp/mouse.el219
-rw-r--r--lisp/mpc.el193
-rw-r--r--lisp/msb.el88
-rw-r--r--lisp/mwheel.el54
-rw-r--r--lisp/net/ange-ftp.el23
-rw-r--r--lisp/net/browse-url.el100
-rw-r--r--lisp/net/dbus.el6
-rw-r--r--lisp/net/dictionary-connection.el18
-rw-r--r--lisp/net/dictionary.el137
-rw-r--r--lisp/net/dig.el15
-rw-r--r--lisp/net/dns.el31
-rw-r--r--lisp/net/eudc-bob.el20
-rw-r--r--lisp/net/eudc-export.el78
-rw-r--r--lisp/net/eudc-hotlist.el14
-rw-r--r--lisp/net/eudc.el36
-rw-r--r--lisp/net/eudcb-bbdb.el125
-rw-r--r--lisp/net/eudcb-ldap.el18
-rw-r--r--lisp/net/eudcb-mab.el2
-rw-r--r--lisp/net/eudcb-macos-contacts.el6
-rw-r--r--lisp/net/eww.el124
-rw-r--r--lisp/net/gnutls.el13
-rw-r--r--lisp/net/goto-addr.el59
-rw-r--r--lisp/net/imap.el58
-rw-r--r--lisp/net/ldap.el10
-rw-r--r--lisp/net/mailcap.el44
-rw-r--r--lisp/net/mairix.el164
-rw-r--r--lisp/net/net-utils.el116
-rw-r--r--lisp/net/network-stream.el3
-rw-r--r--lisp/net/newst-backend.el266
-rw-r--r--lisp/net/newst-plainview.el124
-rw-r--r--lisp/net/newst-reader.el10
-rw-r--r--lisp/net/newst-ticker.el12
-rw-r--r--lisp/net/newst-treeview.el212
-rw-r--r--lisp/net/nsm.el2
-rw-r--r--lisp/net/pop3.el10
-rw-r--r--lisp/net/puny.el6
-rw-r--r--lisp/net/quickurl.el29
-rw-r--r--lisp/net/rcirc.el1492
-rw-r--r--lisp/net/secrets.el12
-rw-r--r--lisp/net/shr-color.el14
-rw-r--r--lisp/net/shr.el108
-rw-r--r--lisp/net/sieve-manage.el28
-rw-r--r--lisp/net/sieve-mode.el8
-rw-r--r--lisp/net/sieve.el84
-rw-r--r--lisp/net/snmp-mode.el44
-rw-r--r--lisp/net/soap-client.el30
-rw-r--r--lisp/net/soap-inspect.el46
-rw-r--r--lisp/net/socks.el6
-rw-r--r--lisp/net/telnet.el20
-rw-r--r--lisp/net/tramp-adb.el51
-rw-r--r--lisp/net/tramp-archive.el25
-rw-r--r--lisp/net/tramp-cache.el46
-rw-r--r--lisp/net/tramp-cmds.el68
-rw-r--r--lisp/net/tramp-compat.el43
-rw-r--r--lisp/net/tramp-crypt.el47
-rw-r--r--lisp/net/tramp-fuse.el214
-rw-r--r--lisp/net/tramp-gvfs.el32
-rw-r--r--lisp/net/tramp-integration.el40
-rw-r--r--lisp/net/tramp-rclone.el264
-rw-r--r--lisp/net/tramp-sh.el985
-rw-r--r--lisp/net/tramp-smb.el72
-rw-r--r--lisp/net/tramp-sshfs.el391
-rw-r--r--lisp/net/tramp-sudoedit.el58
-rw-r--r--lisp/net/tramp.el699
-rw-r--r--lisp/net/trampver.el11
-rw-r--r--lisp/net/webjump.el2
-rw-r--r--lisp/newcomment.el26
-rw-r--r--lisp/notifications.el101
-rw-r--r--lisp/novice.el2
-rw-r--r--lisp/nxml/nxml-mode.el13
-rw-r--r--lisp/nxml/nxml-outln.el2
-rw-r--r--lisp/nxml/rng-cmpct.el10
-rw-r--r--lisp/nxml/rng-loc.el2
-rw-r--r--lisp/nxml/rng-match.el2
-rw-r--r--lisp/nxml/rng-nxml.el18
-rw-r--r--lisp/nxml/rng-uri.el4
-rw-r--r--lisp/nxml/rng-util.el28
-rw-r--r--lisp/nxml/rng-xsd.el6
-rw-r--r--lisp/nxml/xmltok.el47
-rw-r--r--lisp/obsolete/abbrevlist.el4
-rw-r--r--lisp/obsolete/bruce.el10
-rw-r--r--lisp/obsolete/cc-compat.el4
-rw-r--r--lisp/obsolete/cl-compat.el51
-rw-r--r--lisp/obsolete/cl.el49
-rw-r--r--lisp/obsolete/complete.el80
-rw-r--r--lisp/obsolete/crisp.el130
-rw-r--r--lisp/obsolete/cust-print.el47
-rw-r--r--lisp/obsolete/erc-compat.el7
-rw-r--r--lisp/obsolete/erc-hecomplete.el11
-rw-r--r--lisp/obsolete/eudcb-ph.el6
-rw-r--r--lisp/obsolete/fast-lock.el144
-rw-r--r--lisp/obsolete/gs.el4
-rw-r--r--lisp/obsolete/gulp.el17
-rw-r--r--lisp/obsolete/html2text.el2
-rw-r--r--lisp/obsolete/info-edit.el4
-rw-r--r--lisp/obsolete/inversion.el (renamed from lisp/cedet/inversion.el)36
-rw-r--r--lisp/obsolete/iswitchb.el192
-rw-r--r--lisp/obsolete/landmark.el153
-rw-r--r--lisp/obsolete/lazy-lock.el168
-rw-r--r--lisp/obsolete/longlines.el57
-rw-r--r--lisp/obsolete/mailpost.el4
-rw-r--r--lisp/obsolete/mantemp.el2
-rw-r--r--lisp/obsolete/meese.el2
-rw-r--r--lisp/obsolete/messcompat.el2
-rw-r--r--lisp/obsolete/metamail.el13
-rw-r--r--lisp/obsolete/mouse-sel.el16
-rw-r--r--lisp/obsolete/nnir.el116
-rw-r--r--lisp/obsolete/old-emacs-lock.el16
-rw-r--r--lisp/obsolete/otodo-mode.el113
-rw-r--r--lisp/obsolete/patcomp.el2
-rw-r--r--lisp/obsolete/pc-mode.el18
-rw-r--r--lisp/obsolete/pc-select.el17
-rw-r--r--lisp/obsolete/pgg-def.el10
-rw-r--r--lisp/obsolete/pgg-gpg.el12
-rw-r--r--lisp/obsolete/pgg-parse.el18
-rw-r--r--lisp/obsolete/pgg-pgp.el16
-rw-r--r--lisp/obsolete/pgg-pgp5.el14
-rw-r--r--lisp/obsolete/pgg.el113
-rw-r--r--lisp/obsolete/rcompile.el21
-rw-r--r--lisp/obsolete/s-region.el8
-rw-r--r--lisp/obsolete/sb-image.el2
-rw-r--r--lisp/obsolete/sregex.el40
-rw-r--r--lisp/obsolete/starttls.el34
-rw-r--r--lisp/obsolete/sup-mouse.el2
-rw-r--r--lisp/obsolete/terminal.el76
-rw-r--r--lisp/obsolete/tls.el33
-rw-r--r--lisp/obsolete/tpu-edt.el441
-rw-r--r--lisp/obsolete/tpu-extras.el35
-rw-r--r--lisp/obsolete/tpu-mapper.el4
-rw-r--r--lisp/obsolete/url-ns.el45
-rw-r--r--lisp/obsolete/vc-arch.el31
-rw-r--r--lisp/obsolete/vi.el308
-rw-r--r--lisp/obsolete/vip.el324
-rw-r--r--lisp/obsolete/ws-mode.el242
-rw-r--r--lisp/obsolete/yow.el5
-rw-r--r--lisp/org/ob-clojure.el2
-rw-r--r--lisp/org/ob-comint.el6
-rw-r--r--lisp/org/ob-core.el17
-rw-r--r--lisp/org/ob-hledger.el2
-rw-r--r--lisp/org/ob-lilypond.el6
-rw-r--r--lisp/org/ob-mscgen.el4
-rw-r--r--lisp/org/ob-ocaml.el2
-rw-r--r--lisp/org/ob-tangle.el3
-rw-r--r--lisp/org/ol-eshell.el2
-rw-r--r--lisp/org/ol-gnus.el4
-rw-r--r--lisp/org/ol-irc.el6
-rw-r--r--lisp/org/ol-w3m.el6
-rw-r--r--lisp/org/ol.el6
-rw-r--r--lisp/org/org-agenda.el13
-rw-r--r--lisp/org/org-capture.el2
-rw-r--r--lisp/org/org-clock.el40
-rw-r--r--lisp/org/org-colview.el60
-rw-r--r--lisp/org/org-compat.el4
-rw-r--r--lisp/org/org-crypt.el2
-rw-r--r--lisp/org/org-ctags.el4
-rw-r--r--lisp/org/org-element.el2
-rw-r--r--lisp/org/org-indent.el2
-rw-r--r--lisp/org/org-install.el2
-rw-r--r--lisp/org/org-list.el2
-rw-r--r--lisp/org/org-macs.el61
-rw-r--r--lisp/org/org-mouse.el88
-rw-r--r--lisp/org/org-pcomplete.el11
-rw-r--r--lisp/org/org-protocol.el4
-rw-r--r--lisp/org/org-refile.el6
-rw-r--r--lisp/org/org-src.el2
-rw-r--r--lisp/org/org-table.el6
-rw-r--r--lisp/org/org-tempo.el2
-rw-r--r--lisp/org/org-timer.el17
-rw-r--r--lisp/org/org-version.el2
-rw-r--r--lisp/org/org.el8
-rw-r--r--lisp/org/ox-beamer.el8
-rw-r--r--lisp/org/ox-man.el2
-rw-r--r--lisp/org/ox-odt.el11
-rw-r--r--lisp/org/ox-texinfo.el16
-rw-r--r--lisp/org/ox.el4
-rw-r--r--lisp/outline.el134
-rw-r--r--lisp/pcmpl-gnu.el8
-rw-r--r--lisp/pcmpl-linux.el11
-rw-r--r--lisp/pcmpl-unix.el7
-rw-r--r--lisp/pcmpl-x.el5
-rw-r--r--lisp/pcomplete.el42
-rw-r--r--lisp/pixel-scroll.el8
-rw-r--r--lisp/play/5x5.el73
-rw-r--r--lisp/play/blackbox.el18
-rw-r--r--lisp/play/bubbles.el156
-rw-r--r--lisp/play/cookie1.el14
-rw-r--r--lisp/play/decipher.el104
-rw-r--r--lisp/play/doctor.el4
-rw-r--r--lisp/play/dunnet.el20
-rw-r--r--lisp/play/gametree.el2
-rw-r--r--lisp/play/gomoku.el109
-rw-r--r--lisp/play/handwrite.el5
-rw-r--r--lisp/play/hanoi.el2
-rw-r--r--lisp/play/morse.el27
-rw-r--r--lisp/play/snake.el15
-rw-r--r--lisp/play/tetris.el19
-rw-r--r--lisp/play/zone.el21
-rw-r--r--lisp/plstore.el3
-rw-r--r--lisp/printing.el344
-rw-r--r--lisp/proced.el2
-rw-r--r--lisp/profiler.el10
-rw-r--r--lisp/progmodes/antlr-mode.el476
-rw-r--r--lisp/progmodes/asm-mode.el20
-rw-r--r--lisp/progmodes/bug-reference.el223
-rw-r--r--lisp/progmodes/cc-align.el12
-rw-r--r--lisp/progmodes/cc-awk.el4
-rw-r--r--lisp/progmodes/cc-bytecomp.el29
-rw-r--r--lisp/progmodes/cc-cmds.el150
-rw-r--r--lisp/progmodes/cc-defs.el288
-rw-r--r--lisp/progmodes/cc-engine.el1698
-rw-r--r--lisp/progmodes/cc-fonts.el173
-rw-r--r--lisp/progmodes/cc-guess.el6
-rw-r--r--lisp/progmodes/cc-langs.el284
-rw-r--r--lisp/progmodes/cc-menus.el2
-rw-r--r--lisp/progmodes/cc-mode.el76
-rw-r--r--lisp/progmodes/cc-styles.el10
-rw-r--r--lisp/progmodes/cc-vars.el5
-rw-r--r--lisp/progmodes/cfengine.el12
-rw-r--r--lisp/progmodes/cmacexp.el51
-rw-r--r--lisp/progmodes/compile.el30
-rw-r--r--lisp/progmodes/cperl-mode.el1067
-rw-r--r--lisp/progmodes/cpp.el43
-rw-r--r--lisp/progmodes/cwarn.el11
-rw-r--r--lisp/progmodes/dcl-mode.el246
-rw-r--r--lisp/progmodes/ebnf-abn.el6
-rw-r--r--lisp/progmodes/ebnf-bnf.el2
-rw-r--r--lisp/progmodes/ebnf-dtd.el2
-rw-r--r--lisp/progmodes/ebnf-ebx.el2
-rw-r--r--lisp/progmodes/ebnf-iso.el4
-rw-r--r--lisp/progmodes/ebnf-otz.el2
-rw-r--r--lisp/progmodes/ebnf-yac.el10
-rw-r--r--lisp/progmodes/ebnf2ps.el20
-rw-r--r--lisp/progmodes/ebrowse.el7
-rw-r--r--lisp/progmodes/elisp-mode.el356
-rw-r--r--lisp/progmodes/etags.el57
-rw-r--r--lisp/progmodes/executable.el31
-rw-r--r--lisp/progmodes/flymake.el37
-rw-r--r--lisp/progmodes/fortran.el143
-rw-r--r--lisp/progmodes/gdb-mi.el123
-rw-r--r--lisp/progmodes/glasses.el4
-rw-r--r--lisp/progmodes/grep.el174
-rw-r--r--lisp/progmodes/gud.el304
-rw-r--r--lisp/progmodes/hideif.el1219
-rw-r--r--lisp/progmodes/hideshow.el13
-rw-r--r--lisp/progmodes/icon.el119
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el9
-rw-r--r--lisp/progmodes/idlw-help.el99
-rw-r--r--lisp/progmodes/idlw-shell.el225
-rw-r--r--lisp/progmodes/idlw-toolbar.el117
-rw-r--r--lisp/progmodes/idlwave.el1050
-rw-r--r--lisp/progmodes/inf-lisp.el141
-rw-r--r--lisp/progmodes/js.el86
-rw-r--r--lisp/progmodes/ld-script.el3
-rw-r--r--lisp/progmodes/m4-mode.el76
-rw-r--r--lisp/progmodes/make-mode.el199
-rw-r--r--lisp/progmodes/meta-mode.el102
-rw-r--r--lisp/progmodes/modula2.el76
-rw-r--r--lisp/progmodes/octave.el62
-rw-r--r--lisp/progmodes/pascal.el30
-rw-r--r--lisp/progmodes/perl-mode.el29
-rw-r--r--lisp/progmodes/prog-mode.el25
-rw-r--r--lisp/progmodes/project.el202
-rw-r--r--lisp/progmodes/prolog.el106
-rw-r--r--lisp/progmodes/ps-mode.el39
-rw-r--r--lisp/progmodes/python.el41
-rw-r--r--lisp/progmodes/ruby-mode.el44
-rw-r--r--lisp/progmodes/scheme.el65
-rw-r--r--lisp/progmodes/sh-script.el141
-rw-r--r--lisp/progmodes/simula.el181
-rw-r--r--lisp/progmodes/sql.el62
-rw-r--r--lisp/progmodes/tcl.el4
-rw-r--r--lisp/progmodes/vera-mode.el6
-rw-r--r--lisp/progmodes/verilog-mode.el512
-rw-r--r--lisp/progmodes/vhdl-mode.el986
-rw-r--r--lisp/progmodes/which-func.el21
-rw-r--r--lisp/progmodes/xref.el238
-rw-r--r--lisp/progmodes/xscheme.el20
-rw-r--r--lisp/ps-bdf.el4
-rw-r--r--lisp/ps-mule.el50
-rw-r--r--lisp/ps-print.el5
-rw-r--r--lisp/ps-samp.el2
-rw-r--r--lisp/recentf.el108
-rw-r--r--lisp/rect.el2
-rw-r--r--lisp/registry.el33
-rw-r--r--lisp/repeat.el184
-rw-r--r--lisp/replace.el539
-rw-r--r--lisp/reposition.el232
-rw-r--r--lisp/rot13.el29
-rw-r--r--lisp/ruler-mode.el58
-rw-r--r--lisp/savehist.el41
-rw-r--r--lisp/saveplace.el12
-rw-r--r--lisp/scroll-all.el23
-rw-r--r--lisp/select.el18
-rw-r--r--lisp/server.el34
-rw-r--r--lisp/ses.el129
-rw-r--r--lisp/shadowfile.el139
-rw-r--r--lisp/shell.el52
-rw-r--r--lisp/simple.el875
-rw-r--r--lisp/skeleton.el11
-rw-r--r--lisp/so-long.el225
-rw-r--r--lisp/speedbar.el79
-rw-r--r--lisp/startup.el56
-rw-r--r--lisp/strokes.el179
-rw-r--r--lisp/subr.el482
-rw-r--r--lisp/svg.el48
-rw-r--r--lisp/tab-bar.el810
-rw-r--r--lisp/tab-line.el135
-rw-r--r--lisp/talk.el4
-rw-r--r--lisp/tar-mode.el118
-rw-r--r--lisp/term.el42
-rw-r--r--lisp/term/konsole.el2
-rw-r--r--lisp/term/linux.el7
-rw-r--r--lisp/term/lk201.el2
-rw-r--r--lisp/term/pc-win.el2
-rw-r--r--lisp/term/screen.el2
-rw-r--r--lisp/term/st.el13
-rw-r--r--lisp/term/tmux.el2
-rw-r--r--lisp/term/w32-win.el8
-rw-r--r--lisp/term/w32console.el2
-rw-r--r--lisp/term/x-win.el2
-rw-r--r--lisp/term/xterm.el32
-rw-r--r--lisp/textmodes/artist.el115
-rw-r--r--lisp/textmodes/bib-mode.el21
-rw-r--r--lisp/textmodes/bibtex-style.el5
-rw-r--r--lisp/textmodes/bibtex.el9
-rw-r--r--lisp/textmodes/conf-mode.el83
-rw-r--r--lisp/textmodes/css-mode.el22
-rw-r--r--lisp/textmodes/dns-mode.el26
-rw-r--r--lisp/textmodes/enriched.el61
-rw-r--r--lisp/textmodes/fill.el48
-rw-r--r--lisp/textmodes/flyspell.el56
-rw-r--r--lisp/textmodes/ispell.el148
-rw-r--r--lisp/textmodes/less-css-mode.el10
-rw-r--r--lisp/textmodes/makeinfo.el20
-rw-r--r--lisp/textmodes/mhtml-mode.el2
-rw-r--r--lisp/textmodes/nroff-mode.el54
-rw-r--r--lisp/textmodes/page-ext.el2
-rw-r--r--lisp/textmodes/page.el2
-rw-r--r--lisp/textmodes/paragraphs.el33
-rw-r--r--lisp/textmodes/picture.el28
-rw-r--r--lisp/textmodes/refbib.el27
-rw-r--r--lisp/textmodes/refer.el34
-rw-r--r--lisp/textmodes/refill.el21
-rw-r--r--lisp/textmodes/reftex-auc.el64
-rw-r--r--lisp/textmodes/reftex-cite.el73
-rw-r--r--lisp/textmodes/reftex-dcr.el46
-rw-r--r--lisp/textmodes/reftex-global.el34
-rw-r--r--lisp/textmodes/reftex-index.el259
-rw-r--r--lisp/textmodes/reftex-parse.el19
-rw-r--r--lisp/textmodes/reftex-ref.el40
-rw-r--r--lisp/textmodes/reftex-sel.el207
-rw-r--r--lisp/textmodes/reftex-toc.el114
-rw-r--r--lisp/textmodes/reftex-vars.el124
-rw-r--r--lisp/textmodes/reftex.el198
-rw-r--r--lisp/textmodes/remember.el106
-rw-r--r--lisp/textmodes/rst.el350
-rw-r--r--lisp/textmodes/sgml-mode.el112
-rw-r--r--lisp/textmodes/table.el110
-rw-r--r--lisp/textmodes/tex-mode.el137
-rw-r--r--lisp/textmodes/texinfmt.el176
-rw-r--r--lisp/textmodes/texinfo.el337
-rw-r--r--lisp/textmodes/texnfo-upd.el48
-rw-r--r--lisp/textmodes/text-mode.el59
-rw-r--r--lisp/textmodes/tildify.el19
-rw-r--r--lisp/textmodes/two-column.el59
-rw-r--r--lisp/thingatpt.el43
-rw-r--r--lisp/thumbs.el101
-rw-r--r--lisp/time-stamp.el571
-rw-r--r--lisp/time.el27
-rw-r--r--lisp/tmm.el25
-rw-r--r--lisp/tooltip.el15
-rw-r--r--lisp/transient.el3676
-rw-r--r--lisp/tree-widget.el4
-rw-r--r--lisp/tutorial.el12
-rw-r--r--lisp/uniquify.el33
-rw-r--r--lisp/url/ChangeLog.12
-rw-r--r--lisp/url/url-auth.el8
-rw-r--r--lisp/url/url-cookie.el10
-rw-r--r--lisp/url/url-dav.el17
-rw-r--r--lisp/url/url-handlers.el10
-rw-r--r--lisp/url/url-history.el16
-rw-r--r--lisp/url/url-http.el25
-rw-r--r--lisp/url/url-mailto.el6
-rw-r--r--lisp/url/url-news.el7
-rw-r--r--lisp/url/url-proxy.el10
-rw-r--r--lisp/url/url-util.el9
-rw-r--r--lisp/url/url-vars.el9
-rw-r--r--lisp/url/url.el135
-rw-r--r--lisp/userlock.el83
-rw-r--r--lisp/vc/add-log.el115
-rw-r--r--lisp/vc/compare-w.el26
-rw-r--r--lisp/vc/cvs-status.el16
-rw-r--r--lisp/vc/diff-mode.el93
-rw-r--r--lisp/vc/diff.el12
-rw-r--r--lisp/vc/ediff-diff.el12
-rw-r--r--lisp/vc/ediff-help.el2
-rw-r--r--lisp/vc/ediff-init.el50
-rw-r--r--lisp/vc/ediff-merg.el2
-rw-r--r--lisp/vc/ediff-mult.el55
-rw-r--r--lisp/vc/ediff-util.el169
-rw-r--r--lisp/vc/ediff-vers.el18
-rw-r--r--lisp/vc/ediff-wind.el40
-rw-r--r--lisp/vc/ediff.el52
-rw-r--r--lisp/vc/emerge.el69
-rw-r--r--lisp/vc/log-edit.el151
-rw-r--r--lisp/vc/pcvs-defs.el19
-rw-r--r--lisp/vc/pcvs-info.el6
-rw-r--r--lisp/vc/pcvs-parse.el27
-rw-r--r--lisp/vc/pcvs-util.el30
-rw-r--r--lisp/vc/pcvs.el16
-rw-r--r--lisp/vc/smerge-mode.el50
-rw-r--r--lisp/vc/vc-annotate.el24
-rw-r--r--lisp/vc/vc-bzr.el99
-rw-r--r--lisp/vc/vc-cvs.el69
-rw-r--r--lisp/vc/vc-dav.el22
-rw-r--r--lisp/vc/vc-dir.el163
-rw-r--r--lisp/vc/vc-dispatcher.el16
-rw-r--r--lisp/vc/vc-filewise.el4
-rw-r--r--lisp/vc/vc-git.el159
-rw-r--r--lisp/vc/vc-hg.el72
-rw-r--r--lisp/vc/vc-hooks.el72
-rw-r--r--lisp/vc/vc-mtn.el20
-rw-r--r--lisp/vc/vc-rcs.el28
-rw-r--r--lisp/vc/vc-sccs.el36
-rw-r--r--lisp/vc/vc-src.el21
-rw-r--r--lisp/vc/vc-svn.el84
-rw-r--r--lisp/vc/vc.el25
-rw-r--r--lisp/vcursor.el298
-rw-r--r--lisp/view.el169
-rw-r--r--lisp/vt-control.el16
-rw-r--r--lisp/w32-fns.el1
-rw-r--r--lisp/wdired.el504
-rw-r--r--lisp/whitespace.el5
-rw-r--r--lisp/wid-browse.el36
-rw-r--r--lisp/wid-edit.el45
-rw-r--r--lisp/widget.el2
-rw-r--r--lisp/windmove.el270
-rw-r--r--lisp/window.el461
-rw-r--r--lisp/winner.el32
-rw-r--r--lisp/woman.el255
-rw-r--r--lisp/xdg.el10
-rw-r--r--lisp/xml.el4
-rw-r--r--lwlib/Makefile.in19
-rw-r--r--m4/gnulib-comp.m43
-rwxr-xr-xmake-dist18
-rw-r--r--nextstep/Makefile.in12
-rw-r--r--nt/Makefile.in24
-rw-r--r--nt/epaths.nt5
-rw-r--r--nt/gnulib-cfg.mk1
-rw-r--r--nt/mingw-cfg.site9
-rw-r--r--oldXMenu/Create.c2
-rw-r--r--oldXMenu/Internal.c31
-rw-r--r--oldXMenu/Makefile.in19
-rw-r--r--oldXMenu/XMakeAssoc.c2
-rw-r--r--src/Makefile.in68
-rw-r--r--src/alloc.c120
-rw-r--r--src/buffer.c90
-rw-r--r--src/buffer.h3
-rw-r--r--src/callint.c14
-rw-r--r--src/callproc.c82
-rw-r--r--src/character.c112
-rw-r--r--src/character.h6
-rw-r--r--src/charset.c2
-rw-r--r--src/chartab.c104
-rw-r--r--src/cmds.c2
-rw-r--r--src/coding.c52
-rw-r--r--src/comp.c5440
-rw-r--r--src/comp.h114
-rw-r--r--src/composite.c114
-rw-r--r--src/composite.h21
-rw-r--r--src/conf_post.h31
-rw-r--r--src/data.c207
-rw-r--r--src/decompress.c102
-rw-r--r--src/dispextern.h9
-rw-r--r--src/dispnew.c167
-rw-r--r--src/doc.c38
-rw-r--r--src/doprnt.c4
-rw-r--r--src/dynlib.c6
-rw-r--r--src/editfns.c35
-rw-r--r--src/emacs-module.c8
-rw-r--r--src/emacs.c400
-rw-r--r--src/epaths.in4
-rw-r--r--src/eval.c217
-rw-r--r--src/fileio.c146
-rw-r--r--src/filelock.c213
-rw-r--r--src/fns.c207
-rw-r--r--src/font.c44
-rw-r--r--src/fontset.c6
-rw-r--r--src/frame.c902
-rw-r--r--src/frame.h242
-rw-r--r--src/fringe.c15
-rw-r--r--src/ftfont.c21
-rw-r--r--src/gmalloc.c32
-rw-r--r--src/gnutls.c9
-rw-r--r--src/gtkutil.c186
-rw-r--r--src/image.c245
-rw-r--r--src/indent.c7
-rw-r--r--src/insdel.c11
-rw-r--r--src/json.c102
-rw-r--r--src/keyboard.c250
-rw-r--r--src/keymap.c31
-rw-r--r--src/lisp.h98
-rw-r--r--src/lread.c263
-rw-r--r--src/macros.c2
-rw-r--r--src/marker.c7
-rw-r--r--src/minibuf.c545
-rw-r--r--src/nsfns.m52
-rw-r--r--src/nsfont.m46
-rw-r--r--src/nsimage.m58
-rw-r--r--src/nsmenu.m89
-rw-r--r--src/nsterm.h87
-rw-r--r--src/nsterm.m1687
-rw-r--r--src/pdumper.c375
-rw-r--r--src/pdumper.h15
-rw-r--r--src/print.c13
-rw-r--r--src/process.c55
-rw-r--r--src/process.h3
-rw-r--r--src/search.c17
-rw-r--r--src/sound.c5
-rw-r--r--src/syntax.c18
-rw-r--r--src/sysdep.c237
-rw-r--r--src/term.c17
-rw-r--r--src/termhooks.h2
-rw-r--r--src/thread.c17
-rw-r--r--src/verbose.mk.in50
-rw-r--r--src/w32.c131
-rw-r--r--src/w32.h4
-rw-r--r--src/w32common.h12
-rw-r--r--src/w32console.c2
-rw-r--r--src/w32fns.c124
-rw-r--r--src/w32heap.c4
-rw-r--r--src/w32inevt.c12
-rw-r--r--src/w32notify.c2
-rw-r--r--src/w32proc.c21
-rw-r--r--src/w32select.c2
-rw-r--r--src/w32term.c184
-rw-r--r--src/w32term.h2
-rw-r--r--src/widget.c75
-rw-r--r--src/window.c151
-rw-r--r--src/window.h5
-rw-r--r--src/xdisp.c396
-rw-r--r--src/xfaces.c103
-rw-r--r--src/xfns.c185
-rw-r--r--src/xfont.c5
-rw-r--r--src/xftfont.c6
-rw-r--r--src/xgselect.c16
-rw-r--r--src/xmenu.c32
-rw-r--r--src/xselect.c21
-rw-r--r--src/xsmfns.c2
-rw-r--r--src/xterm.c375
-rw-r--r--src/xterm.h2
-rw-r--r--test/Makefile.in59
-rw-r--r--test/README21
-rw-r--r--test/file-organization.org4
-rw-r--r--test/infra/Dockerfile.emba28
-rw-r--r--test/infra/gitlab-ci.yml127
-rw-r--r--test/lisp/auth-source-pass-tests.el24
-rw-r--r--test/lisp/auth-source-tests.el4
-rw-r--r--test/lisp/autorevert-tests.el14
-rw-r--r--test/lisp/calc/calc-tests.el103
-rw-r--r--test/lisp/calculator-tests.el51
-rw-r--r--test/lisp/calendar/cal-french-tests.el113
-rw-r--r--test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american2
-rw-r--r--test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european2
-rw-r--r--test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso2
-rw-r--r--test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american2
-rw-r--r--test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european2
-rw-r--r--test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso2
-rw-r--r--test/lisp/calendar/icalendar-tests.el114
-rw-r--r--test/lisp/calendar/iso8601-tests.el10
-rw-r--r--test/lisp/calendar/parse-time-tests.el2
-rw-r--r--test/lisp/cedet/cedet-files-tests.el54
-rw-r--r--test/lisp/cedet/semantic-utest-c.el1
-rw-r--r--test/lisp/cedet/semantic-utest-fmt.el127
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/test.mk (renamed from test/manual/cedet/tests/test.mk)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/test.srt (renamed from test/manual/cedet/tests/test.srt)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/test.texi (renamed from test/manual/cedet/tests/test.texi)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp (renamed from test/manual/cedet/tests/testdoublens.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp (renamed from test/manual/cedet/tests/testdoublens.hpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp (renamed from test/manual/cedet/tests/testfriends.cpp)1
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java (renamed from test/manual/cedet/tests/testjavacomp.java)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp (renamed from test/manual/cedet/tests/testlocalvars.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp (renamed from test/manual/cedet/tests/testnsp.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c (renamed from test/manual/cedet/tests/testsppcomplete.c)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp (renamed from test/manual/cedet/tests/teststruct.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp (renamed from test/manual/cedet/tests/testsubclass.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh (renamed from test/manual/cedet/tests/testsubclass.hh)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp (renamed from test/manual/cedet/tests/testtemplates.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp (renamed from test/manual/cedet/tests/testtypedefs.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp (renamed from test/manual/cedet/tests/testusing.cpp)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testusing.hh (renamed from test/manual/cedet/tests/testusing.hh)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c (renamed from test/manual/cedet/tests/testvarnames.c)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java (renamed from test/manual/cedet/tests/testvarnames.java)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy (renamed from test/manual/cedet/tests/testwisent.wy)0
-rw-r--r--test/lisp/cedet/semantic-utest-ia.el71
-rw-r--r--test/lisp/cedet/semantic-utest.el2
-rw-r--r--test/lisp/cedet/semantic/bovine/gcc-tests.el129
-rw-r--r--test/lisp/cedet/semantic/format-resources/test-fmt.cpp (renamed from test/manual/cedet/tests/test-fmt.cpp)0
-rw-r--r--test/lisp/cedet/semantic/format-resources/test-fmt.el (renamed from test/manual/cedet/tests/test-fmt.el)4
-rw-r--r--test/lisp/cedet/semantic/format-tests.el95
-rw-r--r--test/lisp/cedet/semantic/fw-tests.el45
-rw-r--r--test/lisp/cedet/srecode-utest-template.el2
-rw-r--r--test/lisp/cedet/srecode/document-tests.el80
-rw-r--r--test/lisp/cedet/srecode/fields-tests.el (renamed from test/manual/cedet/srecode-tests.el)94
-rw-r--r--test/lisp/comint-tests.el1
-rw-r--r--test/lisp/cus-edit-tests.el4
-rw-r--r--test/lisp/custom-resources/custom--test-theme.el6
-rw-r--r--test/lisp/custom-tests.el275
-rw-r--r--test/lisp/descr-text-tests.el2
-rw-r--r--test/lisp/dired-x-tests.el13
-rw-r--r--test/lisp/dom-tests.el10
-rw-r--r--test/lisp/electric-tests.el137
-rw-r--r--test/lisp/emacs-lisp/bindat-tests.el134
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/bc-test-alpha.el9
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/bc-test-beta.el6
-rw-r--r--test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el5
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el472
-rw-r--r--test/lisp/emacs-lisp/cconv-tests.el9
-rw-r--r--test/lisp/emacs-lisp/check-declare-tests.el10
-rw-r--r--test/lisp/emacs-lisp/checkdoc-tests.el44
-rw-r--r--test/lisp/emacs-lisp/cl-extra-tests.el22
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el21
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el22
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el63
-rw-r--r--test/lisp/emacs-lisp/comp-cstr-tests.el233
-rw-r--r--test/lisp/emacs-lisp/copyright-tests.el4
-rw-r--r--test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el42
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el153
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el2
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el18
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el24
-rw-r--r--test/lisp/emacs-lisp/ert-x-tests.el22
-rw-r--r--test/lisp/emacs-lisp/generator-tests.el3
-rw-r--r--test/lisp/emacs-lisp/lisp-mnt-tests.el36
-rw-r--r--test/lisp/emacs-lisp/lisp-mode-tests.el2
-rw-r--r--test/lisp/emacs-lisp/lisp-tests.el2
-rw-r--r--test/lisp/emacs-lisp/macroexp-resources/m1.el36
-rw-r--r--test/lisp/emacs-lisp/macroexp-resources/m2.el33
-rw-r--r--test/lisp/emacs-lisp/macroexp-tests.el72
-rw-r--r--test/lisp/emacs-lisp/map-tests.el529
-rw-r--r--test/lisp/emacs-lisp/memory-report-tests.el16
-rw-r--r--test/lisp/emacs-lisp/package-tests.el68
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el84
-rw-r--r--test/lisp/emacs-lisp/rx-tests.el36
-rw-r--r--test/lisp/emacs-lisp/seq-tests.el24
-rw-r--r--test/lisp/emacs-lisp/shortdoc-tests.el45
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el7
-rw-r--r--test/lisp/emacs-lisp/testcover-resources/testcases.el22
-rw-r--r--test/lisp/emacs-lisp/testcover-tests.el22
-rw-r--r--test/lisp/epg-config-tests.el47
-rw-r--r--test/lisp/erc/erc-tests.el64
-rw-r--r--test/lisp/eshell/em-hist-tests.el2
-rw-r--r--test/lisp/eshell/em-ls-tests.el2
-rw-r--r--test/lisp/eshell/esh-opt-tests.el2
-rw-r--r--test/lisp/eshell/eshell-tests.el2
-rw-r--r--test/lisp/ffap-tests.el19
-rw-r--r--test/lisp/filenotify-tests.el257
-rw-r--r--test/lisp/files-resources/.dir-locals.el5
-rw-r--r--test/lisp/files-resources/auto-test.zot11
-rw-r--r--test/lisp/files-resources/auto-test.zot21
-rw-r--r--test/lisp/files-resources/auto-test.zot31
-rw-r--r--test/lisp/files-resources/whatever.quux2
-rw-r--r--test/lisp/files-tests.el176
-rw-r--r--test/lisp/gnus/gnus-search-tests.el12
-rw-r--r--test/lisp/gnus/gnus-util-tests.el45
-rw-r--r--test/lisp/gnus/message-tests.el31
-rw-r--r--test/lisp/gnus/mm-decode-tests.el6
-rw-r--r--test/lisp/gnus/mml-sec-tests.el9
-rw-r--r--test/lisp/gnus/nnrss-tests.el16
-rw-r--r--test/lisp/help-fns-tests.el4
-rw-r--r--test/lisp/help-tests.el29
-rw-r--r--test/lisp/image-tests.el16
-rw-r--r--test/lisp/info-xref-tests.el2
-rw-r--r--test/lisp/international/mule-util-resources/utf-8.txt2
-rw-r--r--test/lisp/international/mule-util-tests.el40
-rw-r--r--test/lisp/international/ucs-normalize-tests.el2
-rw-r--r--test/lisp/json-tests.el195
-rw-r--r--test/lisp/jsonrpc-tests.el2
-rw-r--r--test/lisp/kmacro-tests.el2
-rw-r--r--test/lisp/loadhist-tests.el57
-rw-r--r--test/lisp/lpr-tests.el41
-rw-r--r--test/lisp/mail/mail-parse-tests.el54
-rw-r--r--test/lisp/mail/mail-utils-tests.el104
-rw-r--r--test/lisp/minibuffer-tests.el208
-rw-r--r--test/lisp/net/netrc-resources/netrc-folding6
-rw-r--r--test/lisp/net/netrc-tests.el7
-rw-r--r--test/lisp/net/network-stream-tests.el3
-rw-r--r--test/lisp/net/nsm-tests.el2
-rw-r--r--test/lisp/net/ntlm-resources/authinfo1
-rw-r--r--test/lisp/net/ntlm-tests.el368
-rw-r--r--test/lisp/net/puny-tests.el6
-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/socks-tests.el291
-rw-r--r--test/lisp/net/tramp-archive-tests.el120
-rw-r--r--test/lisp/net/tramp-tests.el542
-rw-r--r--test/lisp/nxml/nxml-mode-tests.el2
-rw-r--r--test/lisp/nxml/xsd-regexp-tests.el2
-rw-r--r--test/lisp/obsolete/cl-tests.el22
-rw-r--r--test/lisp/obsolete/inversion-tests.el81
-rw-r--r--test/lisp/play/cookie1-resources/cookies8
-rw-r--r--test/lisp/play/cookie1-tests.el40
-rw-r--r--test/lisp/progmodes/compile-tests.el47
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl14
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl10
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl21
-rw-r--r--test/lisp/progmodes/cperl-mode-resources/grammar.pl158
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el260
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el19
-rw-r--r--test/lisp/progmodes/executable-tests.el51
-rw-r--r--test/lisp/progmodes/f90-tests.el3
-rw-r--r--test/lisp/progmodes/grep-tests.el69
-rw-r--r--test/lisp/progmodes/octave-tests.el49
-rw-r--r--test/lisp/progmodes/perl-mode-tests.el9
-rw-r--r--test/lisp/progmodes/project-tests.el110
-rw-r--r--test/lisp/progmodes/python-tests.el24
-rw-r--r--test/lisp/progmodes/ruby-mode-tests.el53
-rw-r--r--test/lisp/progmodes/xref-resources/file1.txt2
-rw-r--r--test/lisp/progmodes/xref-resources/file3.txt1
-rw-r--r--test/lisp/progmodes/xref-tests.el68
-rw-r--r--test/lisp/replace-tests.el20
-rw-r--r--test/lisp/shadowfile-tests.el22
-rw-r--r--test/lisp/shell-tests.el19
-rw-r--r--test/lisp/simple-tests.el136
-rw-r--r--test/lisp/so-long-tests/so-long-tests-helpers.el32
-rw-r--r--test/lisp/so-long-tests/so-long-tests.el265
-rw-r--r--test/lisp/so-long-tests/spelling-tests.el2
-rw-r--r--test/lisp/subr-tests.el67
-rw-r--r--test/lisp/term-tests.el2
-rw-r--r--test/lisp/textmodes/css-mode-tests.el12
-rw-r--r--test/lisp/textmodes/dns-mode-tests.el21
-rw-r--r--test/lisp/textmodes/fill-tests.el2
-rw-r--r--test/lisp/textmodes/sgml-mode-tests.el27
-rw-r--r--test/lisp/textmodes/tildify-tests.el2
-rw-r--r--test/lisp/thingatpt-tests.el35
-rw-r--r--test/lisp/thumbs-tests.el34
-rw-r--r--test/lisp/time-stamp-tests.el453
-rw-r--r--test/lisp/time-tests.el1
-rw-r--r--test/lisp/vc/diff-mode-tests.el154
-rw-r--r--test/lisp/vc/vc-bzr-tests.el2
-rw-r--r--test/lisp/wdired-tests.el4
-rw-r--r--test/lisp/xml-tests.el2
-rw-r--r--test/manual/biditest.el6
-rw-r--r--test/manual/cedet/cedet-utests.el150
-rw-r--r--test/manual/cedet/ede-tests.el14
-rw-r--r--test/manual/cedet/semantic-tests.el143
-rw-r--r--test/manual/cedet/tests/test.el5
-rw-r--r--test/manual/etags/CTAGS.good99
-rw-r--r--test/manual/etags/ETAGS.good_11562
-rw-r--r--test/manual/etags/ETAGS.good_21631
-rw-r--r--test/manual/etags/ETAGS.good_31582
-rw-r--r--test/manual/etags/ETAGS.good_41888
-rw-r--r--test/manual/etags/ETAGS.good_51977
-rw-r--r--test/manual/etags/ETAGS.good_61977
-rw-r--r--test/manual/etags/Makefile4
-rw-r--r--test/manual/etags/README60
-rw-r--r--test/manual/etags/el-src/TAGTEST.EL2
-rw-r--r--test/manual/etags/merc-src/accumulator.m1962
-rw-r--r--test/manual/etags/rs-src/test.rs14
-rw-r--r--test/manual/image-circular-tests.el2
-rw-r--r--test/manual/image-size-tests.el5
-rw-r--r--test/manual/image-transforms-tests.el2
-rw-r--r--test/manual/indent/scheme.scm23
-rw-r--r--test/manual/indent/scss-mode.scss6
-rw-r--r--test/manual/redisplay-testsuite.el2
-rw-r--r--test/manual/scroll-tests.el2
-rw-r--r--test/misc/test-custom-deps.el42
-rw-r--r--test/misc/test-custom-libs.el48
-rw-r--r--test/misc/test-custom-noloads.el45
-rw-r--r--test/misc/test-custom-opts.el39
-rw-r--r--test/src/buffer-tests.el65
-rw-r--r--test/src/character-tests.el45
-rw-r--r--test/src/coding-tests.el4
-rw-r--r--test/src/comp-resources/comp-test-45603.el28
-rw-r--r--test/src/comp-resources/comp-test-funcs-dyn.el50
-rw-r--r--test/src/comp-resources/comp-test-funcs.el710
-rw-r--r--test/src/comp-resources/comp-test-pure.el40
-rw-r--r--test/src/comp-tests.el1443
-rw-r--r--test/src/data-tests.el23
-rw-r--r--test/src/editfns-tests.el6
-rw-r--r--test/src/emacs-module-resources/mod-test.c4
-rw-r--r--test/src/emacs-module-tests.el6
-rw-r--r--test/src/emacs-tests.el263
-rw-r--r--test/src/fileio-tests.el24
-rw-r--r--test/src/filelock-tests.el183
-rw-r--r--test/src/fns-tests.el22
-rw-r--r--test/src/font-tests.el25
-rw-r--r--test/src/indent-tests.el22
-rw-r--r--test/src/json-tests.el30
-rw-r--r--test/src/keyboard-tests.el39
-rw-r--r--test/src/keymap-tests.el58
-rw-r--r--test/src/lread-tests.el67
-rw-r--r--test/src/process-tests.el55
-rw-r--r--test/src/search-tests.el42
-rw-r--r--test/src/syntax-tests.el11
-rw-r--r--test/src/thread-tests.el8
-rw-r--r--test/src/timefns-tests.el2
-rw-r--r--test/src/undo-tests.el2
1618 files changed, 132863 insertions, 88954 deletions
diff --git a/.gitignore b/.gitignore
index 0ae6b16f46b..7539e152ba4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -81,6 +81,7 @@ lib/unistd.h
src/buildobj.h
src/globals.h
src/lisp.mk
+src/verbose.mk
# Lisp-level sources built by 'make'.
*cus-load.el
@@ -92,6 +93,7 @@ lisp/cedet/semantic/wisent/javat-wy.el
lisp/cedet/semantic/wisent/js-wy.el
lisp/cedet/semantic/wisent/python-wy.el
lisp/cedet/srecode/srt-wy.el
+lisp/cedet/semantic/grammar-wy.el
lisp/eshell/esh-groups.el
lisp/finder-inf.el
lisp/leim/ja-dic/
@@ -138,6 +140,7 @@ src/gl-stamp
*.dll
*.core
*.elc
+*.eln
*.o
*.res
*.so
@@ -192,6 +195,7 @@ lib-src/make-docfile
lib-src/make-fingerprint
lib-src/movemail
lib-src/profile
+lib-src/seccomp-filter
lib-src/test-distrib
lib-src/update-game-score
nextstep/Cocoa/Emacs.base/Contents/Info.plist
@@ -258,6 +262,8 @@ doc/*/*/*.ps
doc/emacs/emacsver.texi
doc/man/emacs.1
doc/misc/cc-mode.ss
+doc/misc/modus-themes.texi
+doc/misc/org.texi
etc/DOC
etc/refcards/emacsver.tex
gnustmp*
@@ -303,3 +309,9 @@ nt/emacs.rc
nt/emacsclient.rc
src/gdb.ini
/var/
+
+# Seccomp filter files.
+lib-src/seccomp-filter.bpf
+lib-src/seccomp-filter.pfc
+lib-src/seccomp-filter-exec.bpf
+lib-src/seccomp-filter-exec.pfc
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 9b2af9ccf13..2d70c4916ca 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -66,11 +66,18 @@ more reliably, and makes the job of applying the patches easier and less
error-prone. It also allows sending patches whose author is someone
other than the email sender.
-Once the cumulative amount of your submissions exceeds about 15 lines
-of non-trivial code, we will need you to assign to the FSF the
-copyright for your contributions. Ask on emacs-devel@gnu.org, and we
-will send you the necessary form together with the instructions to
-fill and email it, in order to start this legal paperwork.
+Once the cumulative amount of your submissions exceeds a dozen or so
+lines of non-trivial changes, we will need you to assign to the FSF
+the copyright for your contributions. (To see how many lines were
+non-trivially changed, count only added and modified lines in the
+patched code. Consider an added or changed line non-trivial if it
+includes at least one identifier, string, or substantial comment.)
+In most cases, to start the assignment process you should download
+https://git.savannah.gnu.org/cgit/gnulib.git/plain/doc/Copyright/request-assign.future
+and return the completed information to the address at the top.
+(There are other assignment options, but they are much less commonly used.)
+If you have questions about the assignment process, you can ask the
+address listed on the form, and/or emacs-devel@gnu.org.
** Issue tracker (a.k.a. "bug tracker")
diff --git a/ChangeLog.3 b/ChangeLog.3
index 460a1d2ffa6..8b872a0726e 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,393 @@
+2021-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ * Version 27.2 released.
+
+2021-03-18 Basil L. Contovounesios <contovob@tcd.ie>
+
+ Fix 'frame-inner-height' in non-GUI builds
+
+ Include tab bar in frame's inner height in non-GUI builds that
+ don't define 'tab-bar-height'. This is consistent with the
+ inclusion of the menu bar in the calculated height. It is also
+ consistent with TTY frames of GUI builds, for which
+ 'tab-bar-height' is always zero anyway (bug#47234).
+ Fix suggested by Eli Zaretskii <eliz@gnu.org>.
+
+ * lisp/frame.el (frame-inner-height): Don't assume
+ 'tab-bar-height' is defined in builds --without-x.
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * etc/HISTORY: Update for Emacs 27.2.
+
+ * README:
+ * configure.ac:
+ * nt/README.W32:
+ * msdos/sed2v2.inp: Set version to 27.2
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Document that `buffer-string' retains text properties
+
+ * doc/lispref/text.texi (Buffer Contents): Mention text properties
+ in the `buffer-string' documentation.
+ * src/editfns.c (Fbuffer_string): Mention text properties in the
+ doc string (bug#47220).
+
+ (cherry picked from commit 60af754170f22f5d25510af069ed0ebfec95f992)
+
+2021-03-18 Fabrice Bauzac <noon@mykolab.com>
+
+ Remove duplicate @table item from ELisp manual
+
+ * doc/lispref/objects.texi (Special Read Syntax): Remove duplicate
+ item "#@N" from the table of Special Read Syntax. (Bug#47200)
+
+2021-03-18 Daniel Martín <mardani29@yahoo.es>
+
+ Fix reference to 'diff-font-lock-syntax' in diff-mode documentation
+
+ * doc/emacs/files.texi (Diff Mode): Add the omitted name of the
+ variable. (Bug#47129)
+
+2021-03-18 Alan Third <alan@idiocy.org>
+
+ Fix buffer overflow in xbm_scan (bug#47094)
+
+ * src/image.c (xbm_scan): Ensure reading a string doesn't overflow the
+ buffer.
+
+ (cherry picked from commit ebc3b25409dd614c1814a0643960452683e37aa3)
+
+2021-03-18 Matt Armstrong <matt@rfc20.org>
+
+ Fix typos and omissions for (elisp)Button Buffer Commands
+
+ * doc/lispref/display.texi (Button Buffer Commands): Minor
+ typo and omission fixes `backward-button' and
+ `forward-button'. (Bug#47051)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Teach Rmail about NBSP in "Re:"
+
+ * lisp/mail/rmail.el (rmail-simplified-subject)
+ (rmail-reply-regexp): Allow NBSP in "RE:" prefixes.
+
+2021-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Revert "* lisp/mouse.el: Fix mouse-1-clock-follows-mouse = double"
+
+ This reverts commit 02a5cfce471613f671722b35536d2a78f17b0429.
+ That commit breaks because of a missing patch to `parse_modifiers_uncached`
+ in `src/keyboard.c`. IOW, too risky for `emacs-27`.
+
+ Don't merge to `master`.
+
+2021-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/mouse.el: Fix mouse-1-clock-follows-mouse = double
+
+ This functionality was broken by commit 3d5e31eceb9dc1fb62b2b2,
+ the problem being that we end up considering as distinct the events
+ `down-double-mouse-1` and `double-down-mouse-1`.
+
+ Reported by Eyal Soha <eyalsoha@gmail.com>
+
+ (mouse--click-1-maybe-follows-link): Make sure the last element of
+ the list passed to `event-convert-list` is indeed a "basic" event.
+
+2021-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/gv.el (edebug-after): Don't run the getter in the setter
+
+ This fixes bug#46573 which was introduced by commit
+ d79cf638f278e50c22feb53d6ba556f5ce9d7853.
+ The new code is a middle ground, which makes sure the instrumentation
+ point is used (so the coverage checker won't have ghost unreachable
+ instrumentation points) yet without artificially running the getter
+ when we only need to run the setter.
+
+2021-03-18 Masahiro Nakamura <tsuucat@icloud.com>
+
+ * doc/misc/tramp.texi (Remote shell setup): Fix reference. (Do not merge)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix initialization of 'while-no-input-ignore-events'
+
+ * src/keyboard.c (syms_of_keyboard_for_pdumper): Don't reset
+ 'while-no-input-ignore-events' after loading the dump file.
+ (Bug#46940)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Update documentation of reading passwords
+
+ * doc/emacs/mini.texi (Passwords): Update to match the modified
+ implementation. (Bug#46902) Add indexing.
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Improve the 'dired-do-kill-lines' doc string
+
+ * lisp/dired-aux.el (dired-do-kill-lines): Document the FMT
+ parameter (bug#46867).
+
+ (cherry picked from commit b9cb3b904008a80c69ab433f4851377967b100db)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes in Mew due to corrupted tool-bar label
+
+ * src/gtkutil.c (update_frame_tool_bar): Don't keep around a
+ 'char *' pointer to a Lisp string's contents when calling Lisp,
+ because that could relocate string data; keep the Lisp string
+ itself instead. This avoids crashes in Mew. (Bug#46791)
+
+2021-03-18 Stefan Kangas <stefan@marxist.se>
+
+ * lisp/tooltip.el (tooltip): Doc fix for GTK.
+
+2021-03-18 Stefan Kangas <stefan@marxist.se>
+
+ * lisp/help.el (help-for-help-internal): Doc fix; use imperative.
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ More accurate documentation of the "r" interactive spec
+
+ * doc/lispref/commands.texi (Interactive Codes): Describe the
+ effect of 'mark-even-if-inactive'.
+
+2021-03-18 Stefan Kangas <stefan@marxist.se>
+
+ Mention the GNU Kind Communications Guidelines in the FAQ
+
+ * doc/misc/efaq.texi (Guidelines for newsgroup postings): Mention
+ the GNU Kind Communications Guidelines.
+
+2021-03-18 Ryan Prior <rprior@protonmail.com> (tiny change)
+
+ Allow newlines in password prompts again in comint
+
+ * lisp/comint.el (comint-password-prompt-regexp): Match all
+ whitespace (including newline) at the end of the passphrase, not
+ just space and \t (bug#46609).
+ (comint-watch-for-password-prompt): Remove trailing newlines from
+ the prompt (bug#46609).
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid point movement when visiting image files
+
+ * lisp/image-mode.el (image-toggle-display-image): Preserve point
+ around the call to exif-parse-buffer, to prevent it from moving
+ into the image data. (Bug#46552)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violation in callproc.c
+
+ * src/callproc.c (call_process): Avoid assertion violation when
+ DESTINATION is a cons cell '(:file . "FOO")'. (Bug#46426)
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify "changes" in CONTRIBUTE
+
+ * CONTRIBUTE: Clarify that "changes" doesn't include removing code
+ (bug#44834).
+
+ (cherry picked from commit 33c9556c9db9b8c62dcd80dd3cc665e669ea66d4)
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify when activate-mark-hook is run
+
+ * doc/lispref/markers.texi (The Mark):
+ * lisp/simple.el (activate-mark-hook): Clarify when the hook is
+ run (bug#23444).
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix language-environment and font selection on MS-Windows
+
+ These changes improve setting the language-environment and font
+ selection when MS-Windows returns useless "ZZZ" as the "language
+ name", which then disrupts all the setup of the locale-dependent
+ stuff, and in particular font selection.
+ * lisp/w32-fns.el (w32-charset-info-alist): Add an element for
+ "iso8859-5", in case LANG is set to something unusable, like
+ "ZZZ". This allows fonts capable of displaying Cyrillic
+ characters to be used even when language preferences are screwed.
+
+ * src/w32.c (init_environment): If GetLocaleInfo returns "ZZZ" as
+ the "language name" for LOCALE_USER_DEFAULT, try again with locale
+ ID based on what GetUserDefaultUILanguage returns. (Bug#39286)
+
+2021-03-18 Petteri Hintsanen <petterih@iki.fi>
+
+ Fix example in Sequence Functions node in the manual
+
+ * doc/lispref/sequences.texi (Sequence Functions): Fix the result
+ from the example.
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Improve doc string of 'text-scale-adjust'
+
+ * lisp/face-remap.el (text-scale-adjust): Clarify that "default
+ face height" refers to the 'default' face. (Bug#25168)
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify the indent-rigidly doc string
+
+ * lisp/indent.el (indent-rigidly): Clarify exiting the transient
+ mode (bug#46296).
+
+2021-03-18 Martin Rudalics <rudalics@gmx.at>
+
+ Fix two small tab bar issues
+
+ * lisp/cus-start.el (frame-inhibit-implied-resize): Update version tag.
+ * lisp/frame.el (frame-inner-height): Do not count in tab bar.
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change in syntax.texi
+
+ * doc/lispref/syntax.texi (Syntax Properties): Fix wording in last
+ change. (Bug#46274)
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Correct the lispref manual about flushing ppss info
+
+ * doc/lispref/syntax.texi (Syntax Properties): Correct the
+ information about flushing the state by copying the text from the
+ doc string (bug#46274).
+
+ (cherry picked from commit ff701ce2b261acce1dfcd1fe137268d87d5eab35)
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify how transient indentation modes are exited in the manual
+
+ * doc/emacs/indent.texi (Indentation Commands): Clarify that the
+ other keys don't just exit the transient mode, but are also
+ handled as normally (bug#46296).
+
+2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix the previous change
+
+ * lisp/progmodes/project.el (project-find-regexp):
+ Fix the previous change (project-root is not defined in this version).
+ (project-or-external-find-regexp): Same.
+
+2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ Bind default-directory to the project root
+
+ * lisp/progmodes/project.el (project-find-regexp):
+ Bind default-directory to the project root, to save this value
+ in the resulting buffer (esp. if the project selector was used,
+ (https://lists.gnu.org/archive/html/emacs-devel/2021-02/msg00140.html).
+ (project-or-external-find-regexp): Same.
+
+ (cherry picked from commit c07ebfcbe084e8219d8c2588f23f77ba4ef39087)
+
+2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ Make sure default-directory relates to the originating buffer
+
+ * lisp/progmodes/xref.el (xref--show-xref-buffer):
+ Pick up default-directory value from the caller
+ (https://lists.gnu.org/archive/html/emacs-devel/2021-01/msg00551.html).
+ (xref-show-definitions-buffer-at-bottom): Same.
+
+ (cherry picked from commit 6e73e07a6f5cbdd1c5ae6e0f3fbd0f8f56813f1a)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Initialize signal descriptions after pdumping
+
+ * src/sysdep.c (init_signals) [!HAVE_DECL_SYS_SIGLIST]: Reinit
+ sys_siglist also after pdumping. (Bug#46284)
+
+2021-03-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify the "Sentinels" node in the lispref manual
+
+ * doc/lispref/processes.texi (Sentinels): Mention "run" and that
+ the strings can be anything (bug#30461).
+
+ (cherry picked from commit 859a4cb6b22f75a3456e29d08fcfe9b8940fbe8b)
+
+2021-03-18 Alexandre Duret-Lutz <adl@lrde.epita.fr> (tiny change)
+
+ Fix problem with non-ASCII characters in nnmaildir
+
+ * lisp/gnus/nnmaildir.el (nnmaildir-request-article): Enable
+ multipart 8bit-content-transfer-encoded files to be displayed
+ correctly by reading as `raw-text' instead of having Emacs
+ (incorrectly) decode the files (bug#44307).
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/window.el (recenter-top-bottom): Clarify doc string.
+
+2021-03-18 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ url-http.el: Special-case NTLM authentication
+
+ * lisp/url/url-http.el (url-http-handle-authentication): Do not
+ signal an error on NTLM authorization strings. (Bug#43566)
+
+2021-03-18 Juri Linkov <juri@linkov.net>
+
+ * lisp/isearch.el (isearch-lazy-highlight): Fix defcustom type (bug#46208)
+
+2021-03-18 Stefan Kangas <stefan@marxist.se>
+
+ Sync latest SKK-JISYO.L
+
+ * leim/SKK-DIC/SKK-JISYO.L: Sync to current upstream version.
+
+2021-03-18 Alan Third <alan@idiocy.org>
+
+ Fix build failure on macOS 10.7 (bug#46036)
+
+ * src/nsfns.m (ns_set_represented_filename): Define the NSNumber in a
+ more compatible manner.
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of auto-resize-tool/tab-bars
+
+ * src/xdisp.c (syms_of_xdisp) <auto-resize-tool-bars>
+ <auto-resize-tab-bars>: Doc fix. (Bug#46178)
+
+2021-03-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ (xref-revert-buffer): Also 'erase-buffer' when handling a user-error
+
+ * lisp/progmodes/xref.el (xref-revert-buffer):
+ Also 'erase-buffer' when handling a user-error (bug#46042).
+
+ (cherry picked from commit e86b30d6fd04070b86560774ec82392dbe24ca1e)
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Update files for 27.1.91 pretest
+
+ * ChangeLog.3:
+ * etc/AUTHORS
+ * lisp/ldefs-boot.el: Update.
+
+2021-03-18 Eli Zaretskii <eliz@gnu.org>
2021-02-03 Eli Zaretskii <eliz@gnu.org>
Bump Emacs version to 27.1.91
@@ -76559,7 +76949,7 @@
* lisp/emacs-lisp/lisp-mode.el (lisp-cl-font-lock-keywords-2):
Highlight the Common Lisp conventional names as described in
- http://www.cliki.net/Naming+conventions.
+ https://www.cliki.net/Naming+conventions.
(lisp-el-font-lock-keywords-2): Remove the already commented out
code for `do-' and `with-' because Emacs Lisp does not have a similar
convention.
@@ -121750,7 +122140,7 @@
I roughly followed the Bordeaux threads API:
- http://trac.common-lisp.net/bordeaux-threads/wiki/ApiDocumentation
+ https://sionescu.github.io/bordeaux-threads/
... but not identically. In particular I chose not to implement
interrupt-thread or destroy-thread, but instead a thread-signaling
@@ -144446,6 +144836,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
+2021-03-18bd67a4f40a733cb139ace3af4616bc2702282 (inclusive).
2021-02-03d9244f7cbef9f91e697ad5fc0ce49ec97 (inclusive).
commit 1ca4da054be7eb340c511d817f3ec89c8b819db7 (inclusive).
See ChangeLog.2 for earlier changes.
diff --git a/GNUmakefile b/GNUmakefile
index f27163840b7..5155487de28 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -50,6 +50,8 @@ help:
@echo "make distclean -- delete all build and configuration files,"
@echo " leave only files included in source distribution"
@echo "make maintainer-clean -- delete almost everything that can be regenerated"
+ @echo "make extraclean -- like maintainer-clean, and also delete"
+ @echo " backup and autosave files"
@echo "make bootstrap -- delete all compiled files to force a new bootstrap"
@echo " from a clean slate, then build in the normal way"
@echo "make uninstall -- remove files installed by 'make install'"
diff --git a/Makefile.in b/Makefile.in
index 20683622991..235b707673f 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -48,8 +48,6 @@
#
# make extraclean
# Still more severe - delete backup and autosave files, too.
-# Also generated files that do not normally change and can be slow
-# to rebuild (eg leim/ja-dic).
#
# make bootstrap
# Removes all the compiled files to force a new bootstrap from a
@@ -95,25 +93,24 @@ configuration=@configuration@
### The nt/ subdirectory gets built only for MinGW
NTDIR=@NTDIR@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+top_builddir = @top_builddir@
+-include ${top_builddir}/src/verbose.mk
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+FIND_DELETE = @FIND_DELETE@
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+
+USE_STARTUP_NOTIFICATION = @USE_STARTUP_NOTIFICATION@
# ==================== Where To Install Things ====================
# Location to install Emacs.app under GNUstep / macOS.
# Later values may use these.
+ns_appdir=@ns_appdir@
ns_appbindir=@ns_appbindir@
+ns_applibexecdir=@ns_applibexecdir@
ns_appresdir=@ns_appresdir@
+ns_applibdir=@ns_applibdir@
# Either yes or no depending on whether this is a relocatable Emacs.app.
ns_self_contained=@ns_self_contained@
@@ -166,9 +163,6 @@ infodir=@infodir@
# Info files not in the doc/misc directory (we get those via make echo-info).
INFO_NONMISC=emacs.info eintr.info elisp.info
-# If no makeinfo was found and configured --without-makeinfo, "no"; else "yes".
-HAVE_MAKEINFO=@HAVE_MAKEINFO@
-
# Directory for local state files for all programs.
localstatedir=@localstatedir@
@@ -196,8 +190,8 @@ x_default_search_path=@x_default_search_path@
# Where the etc/emacs.desktop file is to be installed.
desktopdir=$(datarootdir)/applications
-# Where the etc/emacs.appdata.xml file is to be installed.
-appdatadir=$(datarootdir)/metainfo
+# Where the etc/emacs.metainfo.xml file is to be installed.
+metainfodir=$(datarootdir)/metainfo
# Where the etc/emacs.service file is to be installed.
# The system value (typically /usr/lib/systemd/user) can be
@@ -221,6 +215,10 @@ iconsrcdir=$(srcdir)/etc/images/icons
# These variables hold the values Emacs will actually use. They are
# based on the values of the standard Make variables above.
+# Where lisp files are installed in a distributed with Emacs (relative
+# path to the installation directory).
+lispdirrel=@lispdirrel@
+
# Where to install the lisp files distributed with Emacs.
# This includes the Emacs version, so that the lisp files for different
# versions of Emacs will install themselves in separate directories.
@@ -330,9 +328,17 @@ CONFIG_STATUS_FILES_IN = \
COPYDIR = ${srcdir}/etc ${srcdir}/lisp
COPYDESTS = "$(DESTDIR)${etcdir}" "$(DESTDIR)${lispdir}"
+ifeq (${ns_self_contained},no)
+BIN_DESTDIR='$(DESTDIR)${bindir}/'
+ELN_DESTDIR = $(DESTDIR)${libdir}/emacs/${version}/
+else
+BIN_DESTDIR='${ns_appbindir}/'
+ELN_DESTDIR = ${ns_applibdir}/
+endif
+
all: ${SUBDIR} info
-.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 etc-emacsver
+.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 epaths-force-ns-self-contained etc-emacsver
# If configure were to just generate emacsver.tex from emacsver.tex.in
# in the normal way, the timestamp of emacsver.tex would always be
@@ -364,6 +370,7 @@ epaths-force:
@(gamedir='${gamedir}'; \
sed < ${srcdir}/src/epaths.in > epaths.h.$$$$ \
-e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "${standardlisppath}";' \
+ -e 's;\(#.*PATH_REL_LOADSEARCH\).*$$;\1 "${lispdirrel}";' \
-e 's;\(#.*PATH_SITELOADSEARCH\).*$$;\1 "${locallisppath}";' \
-e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "${buildlisppath}";' \
-e '/^#define PATH_[^ ]*SEARCH /s/\([":]\):*/\1/g' \
@@ -394,11 +401,23 @@ epaths-force-w32:
w32locallisppath=$${w32locallisppath//$${w32prefix}/"%emacs_dir%"} ; \
sed < ${srcdir}/nt/epaths.nt > epaths.h.$$$$ \
-e 's;\(#.*PATH_SITELOADSEARCH\).*$$;\1 "'"$${w32locallisppath//;/\\;}"'";' \
+ -e 's;\(#.*PATH_REL_LOADSEARCH\).*$$;\1 "${lispdirrel}";' \
-e '/^.*#/s/@VER@/${version}/g' \
-e '/^.*#/s/@CFG@/${configuration}/g' \
-e "/^.*#/s|@SRC@|$${w32srcdir}|g") && \
${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h
+# A NextStep style app bundle is relocatable, so instead of
+# hard-coding paths try to generate them at run-time.
+#
+# The paths are mostly the same, and the bundle paths are different
+# between macOS and GNUstep, so just replace any references to the app
+# bundle root itself with the relative path.
+epaths-force-ns-self-contained: epaths-force
+ @(sed < src/epaths.h > epaths.h.$$$$ \
+ -e 's;${ns_appdir}/;;') && \
+ ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h
+
lib-src src: $(NTDIR) lib
src: lib-src
@@ -421,7 +440,8 @@ lib lib-src lisp nt: Makefile
dirstate = .git/logs/HEAD
VCSWITNESS = $(if $(wildcard $(srcdir)/$(dirstate)),$$(srcdir)/../$(dirstate))
src: Makefile
- $(MAKE) -C $@ VCSWITNESS='$(VCSWITNESS)' all
+ $(MAKE) -C $@ VCSWITNESS='$(VCSWITNESS)' BIN_DESTDIR='$(BIN_DESTDIR)' \
+ ELN_DESTDIR='$(ELN_DESTDIR)' all
blessmail: Makefile src
$(MAKE) -C lib-src maybe-blessmail
@@ -461,14 +481,14 @@ $(srcdir)/configure: $(srcdir)/configure.ac $(srcdir)/m4/*.m4
# ==================== Installation ====================
.PHONY: install install-arch-dep install-arch-indep install-etcdoc install-info
-.PHONY: install-man install-etc install-strip install-$(NTDIR)
+.PHONY: install-man install-etc install-strip install-$(NTDIR) install-eln
.PHONY: uninstall uninstall-$(NTDIR)
## If we let lib-src do its own installation, that means we
## don't have to duplicate the list of utilities to install in
## this Makefile as well.
-install: all install-arch-indep install-etcdoc install-arch-dep install-$(NTDIR) blessmail
+install: all install-arch-indep install-etcdoc install-arch-dep install-$(NTDIR) blessmail install-eln
@true
## Ensure that $subdir contains a subdirs.el file.
@@ -650,9 +670,6 @@ install-etcdoc: src install-arch-indep
## If info/dir is missing, but we have install-info, we should let
## that handle it. If info/dir is present and we do not have install-info,
## we should check for missing entries and add them by hand.
-##
-## FIXME:
-## If HAVE_MAKEINFO = no and there are no info files, do not install info/dir.
install-info: info
umask 022; ${MKDIR_P} "$(DESTDIR)${infodir}"
-unset CDPATH; \
@@ -664,10 +681,9 @@ install-info: info
[ -f "$(DESTDIR)${infodir}/dir" ] || \
[ ! -f ${srcdir}/info/dir ] || \
${INSTALL_DATA} ${srcdir}/info/dir "$(DESTDIR)${infodir}/dir"; \
- info_misc=`$(MAKE) --no-print-directory -s -C doc/misc echo-info`; \
+ info_misc=`MAKEFLAGS= $(MAKE) --no-print-directory -s -C doc/misc echo-info`; \
cd ${srcdir}/info ; \
for elt in ${INFO_NONMISC} $${info_misc}; do \
- test "$(HAVE_MAKEINFO)" = "no" && test ! -f $$elt && continue; \
for f in `ls $$elt $$elt-[1-9] $$elt-[1-9][0-9] 2>/dev/null`; do \
(cd "$${thisdir}"; \
${INSTALL_DATA} ${srcdir}/info/$$f "$(DESTDIR)${infodir}/$$f"); \
@@ -706,11 +722,15 @@ install-man:
## Note: emacs22 does not have all the resolutions.
EMACS_ICON=emacs
+ifeq (${USE_STARTUP_NOTIFICATION},no)
+USE_STARTUP_NOTIFICATION_SED_CMD=-e "/^StartupNotify=true$$/d"
+endif
install-etc:
umask 022; ${MKDIR_P} "$(DESTDIR)${desktopdir}"
tmp=etc/emacs.tmpdesktop; rm -f $${tmp}; \
sed -e "/^Exec=emacs/ s/emacs/${EMACS_NAME}/" \
-e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \
+ $(USE_STARTUP_NOTIFICATION_SED_CMD) \
${srcdir}/etc/emacs.desktop > $${tmp}; \
${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"; \
rm -f $${tmp}
@@ -718,14 +738,28 @@ install-etc:
client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \
sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \
-e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \
+ $(USE_STARTUP_NOTIFICATION_SED_CMD) \
${srcdir}/etc/emacsclient.desktop > $${tmp}; \
${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}.desktop"; \
rm -f $${tmp}
- umask 022; ${MKDIR_P} "$(DESTDIR)${appdatadir}"
- tmp=etc/emacs.tmpappdata; rm -f $${tmp}; \
+ tmp=etc/emacs-mail.tmpdesktop; rm -f $${tmp}; \
+ sed -e "/^Exec=emacs/ s/emacs/${EMACS_NAME}/" \
+ -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \
+ ${srcdir}/etc/emacs-mail.desktop > $${tmp}; \
+ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/${EMACS_NAME}-mail.desktop"; \
+ rm -f $${tmp}
+ tmp=etc/emacsclient-mail.tmpdesktop; rm -f $${tmp}; \
+ client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \
+ sed -e "/^Exec=emacsclient/ s|emacsclient|${bindir}/$${client_name}|" \
+ -e "/^Icon=emacs/ s/emacs/${EMACS_NAME}/" \
+ ${srcdir}/etc/emacsclient-mail.desktop > $${tmp}; \
+ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${desktopdir}/$${client_name}-mail.desktop"; \
+ rm -f $${tmp}
+ umask 022; ${MKDIR_P} "$(DESTDIR)${metainfodir}"
+ tmp=etc/emacs.tmpmetainfo; rm -f $${tmp}; \
sed -e "s/emacs\.desktop/${EMACS_NAME}.desktop/" \
- ${srcdir}/etc/emacs.appdata.xml > $${tmp}; \
- ${INSTALL_DATA} $${tmp} "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml"; \
+ ${srcdir}/etc/emacs.metainfo.xml > $${tmp}; \
+ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${metainfodir}/${EMACS_NAME}.metainfo.xml"; \
rm -f $${tmp}
umask 022; $(MKDIR_P) "$(DESTDIR)$(systemdunitdir)"
tmp=etc/emacs.tmpservice; rm -f $${tmp}; \
@@ -752,6 +786,14 @@ install-etc:
done ; \
done
+### Install native compiled Lisp files.
+install-eln: lisp
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ umask 022 ; \
+ find native-lisp -type d -exec $(MKDIR_P) "$(ELN_DESTDIR){}" \; ; \
+ find native-lisp -type f -exec ${INSTALL_DATA} "{}" "$(ELN_DESTDIR){}" \;
+endif
+
### Build Emacs and install it, stripping binaries while installing them.
install-strip:
$(MAKE) INSTALL_STRIP=-s install
@@ -779,7 +821,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
done
-rm -rf "$(DESTDIR)${libexecdir}/emacs/${version}"
thisdir=`/bin/pwd`; \
- (info_misc=`$(MAKE) --no-print-directory -s -C doc/misc echo-info`; \
+ (info_misc=`MAKEFLAGS= $(MAKE) --no-print-directory -s -C doc/misc echo-info`; \
if cd "$(DESTDIR)${infodir}"; then \
for elt in ${INFO_NONMISC} $${info_misc}; do \
(cd "$${thisdir}"; \
@@ -804,7 +846,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc
"hicolor/scalable/mimetypes/${EMACS_NAME}-document23.svg"; \
fi)
-rm -f "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop"
- -rm -f "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml"
+ -rm -f "$(DESTDIR)${metainfodir}/${EMACS_NAME}.metainfo.xml"
-rm -f "$(DESTDIR)$(systemdunitdir)/${EMACS_NAME}.service"
ifneq (,$(use_gamedir))
for file in snake-scores tetris-scores; do \
@@ -838,12 +880,11 @@ endef
### target for GCC does not delete 'libgcc.a', because recompiling it
### is rarely necessary and takes a lot of time.
mostlyclean_dirs = src oldXMenu lwlib lib lib-src nt doc/emacs doc/misc \
- doc/lispref doc/lispintro
+ doc/lispref doc/lispintro test
$(foreach dir,$(mostlyclean_dirs),$(eval $(call submake_template,$(dir),mostlyclean)))
mostlyclean: $(mostlyclean_dirs:=_mostlyclean)
- [ ! -d test ] || $(MAKE) -C test $@
### 'clean'
### Delete all files from the current directory that are normally
@@ -853,15 +894,14 @@ mostlyclean: $(mostlyclean_dirs:=_mostlyclean)
### with them.
###
### Delete '.dvi' files here if they are not part of the distribution.
-clean_dirs = $(mostlyclean_dirs) nextstep
+clean_dirs = $(mostlyclean_dirs) nextstep admin/charsets admin/unidata
$(foreach dir,$(clean_dirs),$(eval $(call submake_template,$(dir),clean)))
clean: $(clean_dirs:=_clean)
- $(MAKE) -C admin/charsets $@
- [ ! -d test ] || $(MAKE) -C test $@
-rm -f ./*.tmp etc/*.tmp*
-rm -rf info-dir.*
+ -rm -rf native-lisp
### 'bootclean'
### Delete all files that need to be remade for a clean bootstrap.
@@ -879,17 +919,11 @@ top_distclean=\
rm -f config.status config.log~ \
Makefile makefile lib/gnulib.mk ${SUBDIR_MAKEFILES}
-distclean_dirs = $(clean_dirs) leim lisp
+distclean_dirs = $(clean_dirs) leim lisp admin/grammars
$(foreach dir,$(distclean_dirs),$(eval $(call submake_template,$(dir),distclean)))
-maybeclean_dirs = test admin/grammars admin/unidata admin/charsets
-
distclean: $(distclean_dirs:=_distclean)
- for dir in $(filter-out test,$(maybeclean_dirs)); do \
- $(MAKE) -C $$dir $@ || exit; \
- done
- [ ! -d test ] || $(MAKE) -C test $@
${top_distclean}
### 'bootstrap-clean'
@@ -898,10 +932,6 @@ distclean: $(distclean_dirs:=_distclean)
$(foreach dir,$(distclean_dirs),$(eval $(call submake_template,$(dir),bootstrap-clean)))
bootstrap-clean: $(distclean_dirs:=_bootstrap-clean)
- for dir in $(filter-out test,$(maybeclean_dirs)); do \
- $(MAKE) -C $$dir $@ || exit; \
- done
- [ ! -d test ] || $(MAKE) -C test $@
[ ! -f config.log ] || mv -f config.log config.log~
rm -rf ${srcdir}/info
rm -f ${srcdir}/etc/refcards/emacsver.tex
@@ -920,36 +950,25 @@ bootstrap-clean: $(distclean_dirs:=_bootstrap-clean)
### begin to build the program.
top_maintainer_clean=\
${top_distclean}; \
- rm -fr autom4te.cache
+ rm -fr ${srcdir}/autom4te.cache
-maintainer_clean_dirs = src leim lisp
+$(foreach dir,$(distclean_dirs),$(eval $(call submake_template,$(dir),maintainer-clean)))
-$(foreach dir,$(maintainer_clean_dirs),$(eval $(call submake_template,$(dir),maintainer-clean)))
-
-maintainer-clean: bootstrap-clean $(maintainer_clean_dirs:=_maintainer-clean)
- for dir in $(filter-out test,$(maybeclean_dirs)); do \
- $(MAKE) -C $$dir $@ || exit; \
- done
- [ ! -d test ] || $(MAKE) -C test $@
+maintainer-clean: $(distclean_dirs:=_maintainer-clean)
+ rm -rf ${srcdir}/info
+ rm -f ${srcdir}/etc/refcards/emacsver.tex
${top_maintainer_clean}
### This doesn't actually appear in the coding standards, but Karl
### says GCC supports it, and that's where the configuration part of
### the coding standards seem to come from. It's like distclean, but
### it deletes backup and autosave files too.
-### Note that we abuse this in some subdirectories (eg leim),
-### to delete some generated files that are slow to rebuild.
-extraclean_dirs = ${NTDIR} lib-src src leim \
- admin/charsets admin/grammars admin/unidata lisp lib
-
-$(foreach dir,$(extraclean_dirs),$(eval $(call submake_template,$(dir),extraclean)))
-
-extraclean: $(extraclean_dirs:=_extraclean)
- ${top_maintainer_clean}
- -rm -f config-tmp-* aclocal.m4 configure
- -rm -f ./*~ \#* etc/refcards/emacsver.tex doc/emacs/emacsver.texi
- -rm -f info/*.info info/dir
- -rmdir info 2>/dev/null
+extraclean: maintainer-clean
+ -rm -f config-tmp-* ${srcdir}/aclocal.m4 ${srcdir}/configure \
+ ${srcdir}/src/config.in
+ -[ "${srcdir}" = "." ] || \
+ find ${srcdir} '(' -name '*~' -o -name '#*' ')' ${FIND_DELETE}
+ -find . '(' -name '*~' -o -name '#*' ')' ${FIND_DELETE}
# The src subdir knows how to do the right thing
# even when the build directory and source dir are different.
@@ -958,16 +977,15 @@ extraclean: $(extraclean_dirs:=_extraclean)
# I removed it because it causes `make tags` to build Emacs.
TAGS tags: lib lib-src # src
$(MAKE) -C src tags
+ $(MAKE) -C doc/emacs tags
+ $(MAKE) -C doc/lispintro tags
+ $(MAKE) -C doc/lispref tags
+ $(MAKE) -C doc/misc tags
CHECK_TARGETS = check check-maybe check-expensive check-all
.PHONY: $(CHECK_TARGETS)
$(CHECK_TARGETS): all
-ifeq ($(wildcard test),test)
$(MAKE) -C test $@
-else
- @echo "You do not seem to have the test/ directory."
- @echo "Maybe you used a release tarfile that lacks tests."
-endif
test/%:
$(MAKE) -C test $*
@@ -987,24 +1005,34 @@ $(DOCS):
$(MAKE) -C doc/$(subst -, ,$@)
.PHONY: $(DOCS) docs pdf ps
-.PHONY: info dvi dist html info-real info-dir check-info
+.PHONY: info dvi dist html info-dir check-info
## TODO add etc/refcards.
docs: $(DOCS)
dvi: $(DVIS)
html: $(HTMLS)
-info-real: $(INFOS)
+info: $(INFOS) info-dir
pdf: $(PDFS)
ps: $(PSS)
+# This dependency is due to those doc/misc/ manuals that use .org sources.
+# Depending on src is sufficient, but ends up being slow, since the
+# uncompiled lisp/org/*.el files are used to build the .texi files
+# (which can be slow even with the elc files).
+misc-info: lisp
+# Using src rather than lisp because one is less likely to get unnecessary
+# rebuilds of stuff that is not strictly necessary for generating manuals.
+misc-dvi misc-html misc-pdf misc-ps: src
+
info-dir: ${srcdir}/info/dir
-## Hopefully doc/misc/*.texi is not too long for some systems?
+texi_misc = $(shell MAKEFLAGS= ${MAKE} --no-print-directory -s -C doc/misc echo-sources)
+
srcdir_doc_info_dir_inputs = \
${srcdir}/doc/emacs/emacs.texi \
${srcdir}/doc/lispintro/emacs-lisp-intro.texi \
${srcdir}/doc/lispref/elisp.texi \
- $(sort $(wildcard ${srcdir}/doc/misc/*.texi))
+ $(addprefix ${srcdir}/doc/misc/,${texi_misc})
info_dir_inputs = \
../build-aux/dir_top \
$(subst ${srcdir}/doc/,,${srcdir_doc_info_dir_inputs})
@@ -1017,7 +1045,7 @@ info_dir_deps = \
## installation location by the install-info rule, but we also
## need one in the source directory for people running uninstalled.
## FIXME it would be faster to use the install-info program if we have it,
-## but then we would need to depend on info-real, which would
+## but then we would need to depend on ${INFOS}, which would
## slow down parallelization.
${srcdir}/info/dir: ${info_dir_deps}
$(AM_V_at)${MKDIR_P} ${srcdir}/info
@@ -1072,23 +1100,6 @@ uninstall-html: $(UNINSTALL_HTML)
uninstall-pdf: $(UNINSTALL_PDF)
uninstall-ps: $(UNINSTALL_PS)
-
-# Note that man/Makefile knows how to put the info files in $(srcdir),
-# so we can do ok running make in the build dir.
-# This used to have a clause that exited with an error if MAKEINFO = no.
-# But it is inappropriate to do so without checking if makeinfo is
-# actually needed - it is not if the info files are up-to-date. (Bug#3982)
-# Only the doc/*/Makefiles can decide that, so we let those rules run
-# and give a standard error if makeinfo is needed but missing.
-# While it would be nice to give a more detailed error message, that
-# would require changing every rule in doc/ that builds an info file,
-# and it's not worth it. This case is only relevant if you download a
-# release, then change the .texi files.
-info:
- ifneq ($(HAVE_MAKEINFO),no)
- $(MAKE) info-real info-dir
- endif
-
## build-aux/make-info-dir expects only certain dircategories.
check-info: info
cd info ; \
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index a40b4302723..68c12438f5a 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -81,7 +81,6 @@ anymore, so they can be removed.
AMPERSAND_FULL_NAME
BROKEN_DATAGRAM_SOCKETS
-BROKEN_FIONREAD
BROKEN_GET_CURRENT_DIR_NAME
BROKEN_PTY_READ_AFTER_EAGAIN
DEFAULT_SOUND_DEVICE
@@ -94,16 +93,12 @@ EMACS_CONFIG_OPTIONS
EMACS_INT
EMACS_UINT
GC_MARK_SECONDARY_STACK
-GC_MARK_STACK
GC_SETJMP_WORKS
GNU_MALLOC
-HAVE_AIX_SMT_EXP
-HAVE_ALARM
HAVE_ALLOCA
HAVE_ALLOCA_H
HAVE_ALSA
HAVE_BDFFONT
-HAVE_BOXES
HAVE_CFMAKERAW
HAVE_CFSETSPEED
HAVE_CLOCK_GETTIME
@@ -117,7 +112,6 @@ HAVE_DBUS_VALIDATE_INTERFACE
HAVE_DBUS_VALIDATE_MEMBER
HAVE_DBUS_VALIDATE_PATH
HAVE_DBUS_WATCH_GET_UNIX_FD
-HAVE_DECL_GETENV
HAVE_DECL_LOCALTIME_R
HAVE_DECL_STRMODE
HAVE_DECL_STRTOIMAX
@@ -126,8 +120,6 @@ HAVE_DECL_STRTOULL
HAVE_DECL_STRTOUMAX
HAVE_DECL_TZNAME
HAVE_DIALOGS
-HAVE_DIFFTIME
-HAVE_DUP2
HAVE_ENDGRENT
HAVE_ENDPWENT
HAVE_ENVIRON_DECL
@@ -141,11 +133,9 @@ HAVE_FUTIMES
HAVE_FUTIMESAT
HAVE_GAI_STRERROR
HAVE_GCONF
-HAVE_GETDELIM
HAVE_GETGRENT
HAVE_GETHOSTNAME
HAVE_GETIFADDRS
-HAVE_GETLINE
HAVE_GETLOADAVG
HAVE_GETOPT_H
HAVE_GETOPT_LONG_ONLY
@@ -164,18 +154,8 @@ HAVE_GPM
HAVE_GRANTPT
HAVE_GSETTINGS
HAVE_GTK3
-HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE
-HAVE_GTK_DIALOG_GET_ACTION_AREA
HAVE_GTK_FILE_SELECTION_NEW
-HAVE_GTK_MAIN
-HAVE_GTK_MULTIDISPLAY
-HAVE_GTK_ORIENTABLE_SET_ORIENTATION
-HAVE_GTK_WIDGET_GET_MAPPED
-HAVE_GTK_WIDGET_GET_SENSITIVE
-HAVE_GTK_WIDGET_GET_WINDOW
-HAVE_GTK_WIDGET_SET_HAS_WINDOW
HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP
-HAVE_G_TYPE_INIT
HAVE_IFADDRS_H
HAVE_IMAGEMAGICK
HAVE_INTTYPES_H
@@ -193,10 +173,8 @@ HAVE_LIBLOCKFILE
HAVE_LIBMAIL
HAVE_LIBOTF
HAVE_LIBPERFSTAT
-HAVE_LIBPNG_PNG_H
HAVE_LIBSELINUX
HAVE_LIBXML2
-HAVE_LIBXMU
HAVE_LOCALTIME_R
HAVE_LOCAL_SOCKETS
HAVE_LRAND48
@@ -209,24 +187,18 @@ HAVE_MAGICKEXPORTIMAGEPIXELS
HAVE_MAGICKMERGEIMAGELAYERS
HAVE_MAILLOCK_H
HAVE_MALLOC_MALLOC_H
-HAVE_MATHERR
HAVE_MBSTATE_T
-HAVE_MEMCMP
-HAVE_MEMMOVE
HAVE_MEMORY_H
HAVE_MEMSET
-HAVE_MENUS
HAVE_MKSTEMP
HAVE_MMAP
HAVE_MULTILINGUAL_MENU
-HAVE_NANOTIME
HAVE_NET_IF_DL_H
HAVE_NET_IF_H
HAVE_NLIST_H
HAVE_OTF_GET_VARIATION_GLYPHS
HAVE_PERSONALITY_ADDR_NO_RANDOMIZE
HAVE_PNG
-HAVE_PNG_H
HAVE_POSIX_MEMALIGN
HAVE_PROCFS
HAVE_PSELECT
@@ -263,15 +235,12 @@ HAVE_SOUNDCARD_H
HAVE_STDINT_H
HAVE_STDIO_EXT_H
HAVE_STDLIB_H
-HAVE_STLIB_H_1
HAVE_STRINGS_H
HAVE_STRING_H
-HAVE_STRNCASECMP
HAVE_STRSIGNAL
HAVE_STRTOIMAX
HAVE_STRTOLL
HAVE_STRTOULL
-HAVE_STRTOUMAX
HAVE_STRUCT_ERA_ENTRY
HAVE_STRUCT_IFREQ_IFR_ADDR
HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
@@ -287,9 +256,7 @@ HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC
HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC
HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC
HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC
-HAVE_STRUCT_TIMEZONE
HAVE_STRUCT_TM_TM_ZONE
-HAVE_STRUCT_UTIMBUF
HAVE_ST_DM_MODE
HAVE_SYMLINK
HAVE_SYNC
@@ -303,26 +270,20 @@ HAVE_SYS_SOCKET_H
HAVE_SYS_SOUNDCARD_H
HAVE_SYS_STAT_H
HAVE_SYS_SYSTEMINFO_H
-HAVE_SYS_TIMEB_H
HAVE_SYS_TIME_H
HAVE_SYS_TYPES_H
HAVE_SYS_UN_H
HAVE_SYS_UTSNAME_H
HAVE_SYS_VLIMIT_H
HAVE_SYS_WAIT_H
-HAVE_TCATTR
HAVE_TERM_H
HAVE_TIFF
-HAVE_TIMEVAL
HAVE_TM_GMTOFF
HAVE_TM_ZONE
HAVE_TOUCHLOCK
HAVE_TZNAME
-HAVE_TZSET
HAVE_UTIL_H
HAVE_UTIMENSAT
-HAVE_UTIMES
-HAVE_UTIME_H
HAVE_UTMP_H
HAVE_VFORK
HAVE_VFORK_H
@@ -342,14 +303,10 @@ HAVE_XRMSETDATABASE
HAVE_XSCREENNUMBEROFSCREEN
HAVE_XSCREENRESOURCESTRING
HAVE_X_I18N
-HAVE_X_MENU
HAVE_X_SM
HAVE_X_WINDOWS
-HAVE__BOOL
-HAVE__FTIME
HAVE___BUILTIN_UNWIND_INIT
HAVE___EXECUTABLE_START
-HAVE___FPENDING
INTERNAL_TERMINAL
IS_ANY_SEP
IS_DIRECTORY_SEP
@@ -359,7 +316,6 @@ MAIL_USE_POP
MAIL_USE_SYSTEM_LOCK
MAXPATHLEN
NLIST_STRUCT
-NO_EDITRES
NSIG
NSIG_MINIMUM
NULL_DEVICE
@@ -378,7 +334,6 @@ SYSTEM_MALLOC
TAB3
TABDLY
TERM
-TIME_WITH_SYS_TIME
TIOCSIGSEND
TM_IN_SYS_TIME
UNIX98_PTYS
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index 53afe87a0f8..02b8cf39bd6 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -131,6 +131,13 @@ Amin Bandali
lisp/erc/*
doc/misc/erc.texi
+Andrea Corallo
+ Lisp native compiler
+ src/comp.c
+ lisp/emacs-lisp/comp.el
+ lisp/emacs-lisp/comp-cstr.el
+ test/src/comp-*.el
+
==============================================================================
2. Areas that someone is willing to maintain, although he would not
necessarily mind if someone else was the official maintainer.
diff --git a/admin/admin.el b/admin/admin.el
index d032c1ceb85..ad4208beef0 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -151,7 +151,7 @@ Root must be the root of an Emacs source tree."
(display-warning 'admin
"NEWS file contains empty sections - remove them?"))
(goto-char (point-min))
- (if (re-search-forward "^\\(\\+\\+\\+ *$\\|--- *$\\|Temporary note:\\)" nil t)
+ (if (re-search-forward "^\\(\\+\\+\\+? *$\\|---? *$\\|Temporary note:\\)" nil t)
(display-warning 'admin
"NEWS file still contains temporary markup.
Documentation changes might not have been completed!"))))
@@ -545,7 +545,7 @@ Leave point after the table."
(forward-line 1)
(while (not done)
(cond ((re-search-forward "<tr><td.*&bull; \\(<a.*</a>\\)\
-:</td><td>&nbsp;&nbsp;</td><td[^>]*>\\(.*\\)" (line-end-position) t)
+:?</td><td>&nbsp;&nbsp;</td><td[^>]*>\\(.*\\)" (line-end-position) t)
(replace-match (format "<tr><td%s>\\1</td>\n<td>\\2"
(if table-workaround
" bgcolor=\"white\"" "")))
@@ -665,6 +665,8 @@ style=\"text-align:left\">")
(defconst make-manuals-dist-output-variables
'(("@\\(top_\\)?srcdir@" . ".") ; top_srcdir is wrong, but not used
+ ("@\\(abs_\\)?top_builddir@" . ".") ; wrong but unused
+ ("^\\(EMACS *=\\).*" . "\\1 emacs")
("^\\(\\(?:texinfo\\|buildinfo\\|emacs\\)dir *=\\).*" . "\\1 .")
("^\\(clean:.*\\)" . "\\1 infoclean")
("@MAKEINFO@" . "makeinfo")
@@ -682,9 +684,7 @@ style=\"text-align:left\">")
("@INSTALL@" . "install -c")
("@INSTALL_DATA@" . "${INSTALL} -m 644")
("@configure_input@" . "")
- ("@AM_DEFAULT_VERBOSITY@" . "0")
- ("@AM_V@" . "${V}")
- ("@AM_DEFAULT_V@" . "${AM_DEFAULT_VERBOSITY}"))
+ ("@AM_DEFAULT_VERBOSITY@" . "0"))
"Alist of (REGEXP . REPLACEMENT) pairs for `make-manuals-dist'.")
(defun make-manuals-dist--1 (root type)
@@ -714,7 +714,8 @@ style=\"text-align:left\">")
(string-match-p "\\.\\(eps\\|pdf\\)\\'" file)))
(copy-file file stem)))
(with-temp-buffer
- (let ((outvars make-manuals-dist-output-variables))
+ (let ((outvars make-manuals-dist-output-variables)
+ (case-fold-search nil))
(push `("@version@" . ,version) outvars)
(insert-file-contents (format "../doc/%s/Makefile.in" type))
(dolist (cons outvars)
diff --git a/admin/authors.el b/admin/authors.el
index 6c81c7872fc..b4e6c934b67 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -1330,7 +1330,7 @@ to print a message if FILE is not found."
(unless (or valid
(member file authors-ignored-files)
(authors-obsolete-file-p file)
- (string-match "[*]" file)
+ (string-search "*" file)
(string-match "^[0-9.]+$" file)
laxlog)
(setq authors-invalid-file-names
@@ -1465,7 +1465,7 @@ Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)")))
((looking-at "^[ \t]+\\*")
(let ((line (buffer-substring-no-properties
(match-end 0) (line-end-position))))
- (while (and (not (string-match ":" line))
+ (while (and (not (string-search ":" line))
(forward-line 1)
(not (looking-at ":\\|^[ \t]*$")))
(setq line (concat line
@@ -1475,7 +1475,7 @@ Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)")))
(when (string-match ":" line)
(setq line (substring line 0 (match-beginning 0)))
(setq line (replace-regexp-in-string "[[(<{].*$" "" line))
- (setq line (replace-regexp-in-string "," "" line))
+ (setq line (string-replace "," "" line))
(dolist (file (split-string line))
(when (setq file (authors-canonical-file-name file log-file pos (car authors)))
(dolist (author authors)
diff --git a/admin/charsets/Makefile.in b/admin/charsets/Makefile.in
index 0fd130d346e..f043077e318 100644
--- a/admin/charsets/Makefile.in
+++ b/admin/charsets/Makefile.in
@@ -31,6 +31,7 @@ AWK = @AWK@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
charsetdir = ${top_srcdir}/etc/charsets
lispintdir = ${top_srcdir}/lisp/international
@@ -38,16 +39,7 @@ mapfiledir = ${srcdir}/mapfiles
GLIBC_CHARMAPS = ${srcdir}/glibc
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
# Note: We can not prepend "ISO-" to these map files because of file
# name limits on DOS.
@@ -305,17 +297,18 @@ ${charsetdir}/%.map: ${GLIBC_CHARMAPS}/%.gz ${mapconv} ${compact}
${AM_V_GEN}${run_mapconv} $< '/^<.*[ ]\/x/' GLIBC-1 ${compact} > $@
-.PHONY: clean bootstrap-clean distclean maintainer-clean extraclean
+.PHONY: clean bootstrap-clean distclean maintainer-clean gen-clean
clean:
+## IMO this should also run gen-clean.
bootstrap-clean: clean
distclean: clean
rm -f Makefile
-maintainer-clean: distclean
-
-## Do not remove these files, even in a bootstrap. They rarely change.
-extraclean:
+gen-clean:
rm -f ${CHARSETS} ${SED_SCRIPT} ${TRANS_TABLE} ${srcdir}/charsets.stamp
+
+maintainer-clean: gen-clean distclean
+
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index ca9a317611b..033b37f5ede 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -38,7 +38,7 @@ BEGIN {
JISX0208_FROM2 = "/xf5/xa1";
JISX0212_FROM = "/x8f/xf3/xf3";
- print ";;; eucjp-ms.el -- translation table for eucJP-ms -*- lexical-binding:t -*-";
+ print ";;; eucjp-ms.el --- translation table for eucJP-ms -*- lexical-binding:t -*-";
print ";;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz";
print "(let ((map";
print " '(;JISEXT<->UNICODE";
diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README
index 60f09125a91..fb078269d6f 100644
--- a/admin/charsets/mapfiles/README
+++ b/admin/charsets/mapfiles/README
@@ -63,8 +63,8 @@ to "JIS X 0213:2004".
* MULE-*.map
-Created by using ../mule-charsets.el in Emacs 22 as this:
- % emacs-22 -batch -l ../mule-charsets.el
+Created by using ../mule-charsets.el in Emacs as this:
+ % emacs -batch -l ../mule-charsets.el
This file is part of GNU Emacs.
diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el
index 99a8c60d880..7bcceb39b23 100644
--- a/admin/charsets/mule-charsets.el
+++ b/admin/charsets/mule-charsets.el
@@ -1,4 +1,4 @@
-;; mule-charsets.el -- Generate Mule-original charset maps. -*- lexical-binding: t -*-
+;;; mule-charsets.el --- Generate Mule-original charset maps. -*- lexical-binding: t -*-
;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
diff --git a/admin/check-doc-strings b/admin/check-doc-strings
index 63856d32871..135090b34ce 100755
--- a/admin/check-doc-strings
+++ b/admin/check-doc-strings
@@ -59,7 +59,7 @@ sub Check_texi_function {
$arglist_parm{$parm} = 1;
}
- foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) {
+ foreach my $parm ($docstring =~ /\@var\{([^{}]+)\}/g) {
$docstring_parm{$parm} = 1;
}
@@ -111,7 +111,9 @@ sub Check_function {
# $arglist_parm{$parm} = 1;
#}
foreach my $parm (@parms) {
- next if $parm eq '&optional' || $parm eq '&rest';
+ next if $parm eq '&optional'
+ || $parm eq '&rest'
+ || $parm eq 'Lisp-Object';
$arglist_parm{$parm} = 1;
}
my $doc_tmp = $docstring;
@@ -150,6 +152,22 @@ sub Check_function {
next if $parm eq 'primary';
next if $parm eq 'secondary';
next if $parm eq 'clipboard';
+ next if $parm eq 'bbdb';
+ next if $parm eq 'dos';
+ next if $parm eq 'erc';
+ next if $parm eq 'exif';
+ next if $parm eq 'ldap';
+ next if $parm eq 'ime';
+ next if $parm eq 'rfc';
+ next if $parm eq 'ms-dos';
+ next if $parm eq 'url';
+ next if $parm eq 'w32';
+ next if $parm eq 'todo'; # org-mode
+ next if $parm eq 'done'; # org-mode
+ next if $parm eq 'waiting'; #org-mode
+ next if $parm eq 'ordered'; #org-mode
+ next if $parm eq 'deadline'; #org-mode
+ next if $parm eq 'scheduled'; #org-mode
next if length $parm < 3;
if (! exists $arglist_parm{$parm}) {
print "bogus parm: $function: $parm\n";
@@ -228,20 +246,43 @@ open (FIND, "find src -name '*.c' -print |") or die;
while (my $file = <FIND>) {
my @matches =
((FileContents $file) =~
- /\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
+ /\b
+ DEFUN\s*\(\s*
+ ## $function
+ \"((?:[^\\\"]|\\.)+)\"\s*,
+ \s*\S+\s*, \s*\S+\s*,
+ ## $minargs
+ \s*(\S+)\s*,
+ ## $maxargs
+ \s*(\S+)\s*,
+ ## $interactive
+ \s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,
+ ## $docstring
+ \s*doc:\s*\/\*\s*(.*?)\s*\*\/
+ # attributes -- skip
+ (?:\s*attributes:\s*
+ (?:noreturn|const)
+ \s*)?
+ \s*\)
+ ### $parms
+ \s*\(
+ ([^()]*)
+ \)
+ /sgox);
while (@matches) {
my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6);
$docstring =~ s/^\n+//s;
$docstring =~ s/\n+$//s;
$parms =~ s/,/ /g;
- my @parms = split (' ',$parms);
+ my @parms = $parms eq 'void' ? () : split (' ', $parms);
for (@parms) { tr/_/-/; s/-$//; }
if ($parms !~ /Lisp_Object/) {
if ($minargs < @parms) {
- if ($maxargs =~ /^\d+$/) {
- die unless $maxargs eq @parms;
- splice (@parms, $minargs, 0, '&optional');
- }
+ if ($maxargs =~ /^\d+$/) {
+ die "$function: $maxargs"
+ unless $maxargs eq @parms;
+ splice (@parms, $minargs, 0, '&optional');
+ }
}
}
my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 995586f9c71..30b5f655617 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -37,6 +37,13 @@
;;
;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads
;;
+;; or as a part of the test suite with
+;;
+;; make -C test test-custom-opts
+;; make -C test test-custom-deps
+;; make -C test test-custom-libs
+;; make -C test test-custom-noloads
+;;
;; in the emacs source directory.
;;
;; For interactive use: Load this file. Then
@@ -320,7 +327,8 @@ If it is \"all\", load all Lisp files."
(lambda (file)
(condition-case alpha
(unless (member file cus-test-libs-noloads)
- (load (file-name-sans-extension (expand-file-name file lispdir)))
+ (load (file-name-sans-extension (expand-file-name file lispdir))
+ nil t)
(push file cus-test-libs-loaded))
(error
(push (cons file alpha) cus-test-libs-errors)
@@ -349,6 +357,8 @@ Optional argument ALL non-nil means list all (non-obsolete) Lisp files."
(mapcar (lambda (e) (substring e 2))
(apply #'process-lines find-program
"." "-name" "obsolete" "-prune" "-o"
+ "-name" "ldefs-boot.el" "-prune" "-o"
+ "-name" "*loaddefs.el" "-prune" "-o"
"-name" "[^.]*.el" ; ignore .dir-locals.el
(if all
'("-print")
diff --git a/admin/emake b/admin/emake
index d9aa4ea74bd..bdaabc026b3 100755
--- a/admin/emake
+++ b/admin/emake
@@ -27,19 +27,21 @@ s#^Configuring local git # Configuring local git #
s#^Installing git hooks...# Installing git hooks...#
s#^Running # Running #
s#^Configured for # Configured for #
-s#^./temacs # ./temacs #
-s#^Dumping under the name# Dumping under the name#
+s#^./temacs.*# \\& #
' | \
egrep --line-buffered -v "^make|\
^Loading|\
SCRAPE|\
-INFO.*Scraping.*[.]\$|\
+INFO.*Scraping.*[.] ?\$|\
+INFO.*Scraping.*done\$|\
+GEN.*etc/DOC|\
^Waiting for git|\
^Finding pointers|\
^Using load-path|\
^Adding name|\
^Dump mode|\
^Dumping finger|\
+^Dumping under the name|\
^Byte counts|\
^Reloc counts|\
^Pure-hashed|\
@@ -68,6 +70,8 @@ GEN.*loaddefs|\
^\"configure\" file built.|\
^There seems to be no|\
^config.status:|\
+ELN_DESTDIR|\
+--bin-dest |\
^ *$|\
^Makefile built|\
The GNU allocators don't work|\
@@ -83,3 +87,9 @@ do
[[ "X${REPLY:0:3}" == "X " ]] && C="\033[1;31m"
[[ "X$C" == "X" ]] && printf "%s\n" "$REPLY" || printf "$C%s\033[0m\n" "$REPLY"
done
+
+# Run a "make check" on all test files belonging to files that have
+# changed since last time.
+make -j$cores check-maybe 2>&1 | \
+ sed -n '/contained unexpected results/,$p' | \
+ egrep --line-buffered -v "^make"
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index b92ecc7c78f..851212c7bb1 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -7,6 +7,8 @@
;; Keywords: maint
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index 98c9c623abc..aaf95c08973 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -28,24 +28,13 @@ srcdir = @srcdir@
top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH
EMACS = ${top_builddir}/src/emacs
-emacs = EMACSLOADPATH= "${EMACS}" -batch --no-site-file --no-site-lisp
+emacs = EMACSLOADPATH= "${EMACS}" -batch --no-site-file --no-site-lisp --eval '(setq load-prefer-newer t)'
make_bovine = ${emacs} -l semantic/bovine/grammar -f bovine-batch-make-parser
make_wisent = ${emacs} -l semantic/wisent/grammar -f wisent-batch-make-parser
@@ -54,19 +43,19 @@ cedetdir = ${top_srcdir}/lisp/cedet
bovinedir = ${cedetdir}/semantic/bovine
wisentdir = ${cedetdir}/semantic/wisent
+grammar_bovine = ${bovinedir}/grammar.el
+grammar_wisent = ${wisentdir}/grammar.el
+
BOVINE = \
${bovinedir}/c-by.el \
${bovinedir}/make-by.el \
${bovinedir}/scm-by.el
-## FIXME Should include this one too:
-## ${cedetdir}/semantic/grammar-wy.el
-## but semantic/grammar.el (which is what we use to generate grammar-wy.el)
-## requires it!
-WISENT = \
- ${wisentdir}/javat-wy.el \
- ${wisentdir}/js-wy.el \
- ${wisentdir}/python-wy.el \
+WISENT = \
+ ${cedetdir}/semantic/grammar-wy.el \
+ ${wisentdir}/javat-wy.el \
+ ${wisentdir}/js-wy.el \
+ ${wisentdir}/python-wy.el \
${cedetdir}/srecode/srt-wy.el
ALL = ${BOVINE} ${WISENT}
@@ -80,46 +69,45 @@ bovine: ${BOVINE}
wisent: ${WISENT}
## c-by.el, make-by.el.
-${bovinedir}/%-by.el: ${srcdir}/%.by
+${bovinedir}/%-by.el: ${srcdir}/%.by ${grammar_bovine}
$(AM_V_GEN)[ ! -f "$@" ] || chmod +w "$@"
$(AM_V_at)${make_bovine} -o "$@" $<
-${bovinedir}/scm-by.el: ${srcdir}/scheme.by
+${bovinedir}/scm-by.el: ${srcdir}/scheme.by ${grammar_bovine}
$(AM_V_GEN)[ ! -f "$@" ] || chmod +w "$@"
$(AM_V_at)${make_bovine} -o "$@" $<
## grammar-wy.el
-${cedetdir}/semantic/%-wy.el: ${srcdir}/%.wy
+${cedetdir}/semantic/%-wy.el: ${srcdir}/%.wy ${grammar_wisent}
$(AM_V_GEN)[ ! -f "$@" ] || chmod +w "$@"
$(AM_V_at)${make_wisent} -o "$@" $<
## js-wy.el, python-wy.el
-${wisentdir}/%-wy.el: ${srcdir}/%.wy
+${wisentdir}/%-wy.el: ${srcdir}/%.wy ${grammar_wisent}
$(AM_V_GEN)[ ! -f "$@" ] || chmod +w "$@"
$(AM_V_at)${make_wisent} -o "$@" $<
-${wisentdir}/javat-wy.el: ${srcdir}/java-tags.wy
+${wisentdir}/javat-wy.el: ${srcdir}/java-tags.wy ${grammar_wisent}
$(AM_V_GEN)[ ! -f "$@" ] || chmod +w "$@"
$(AM_V_at)${make_wisent} -o "$@" $<
-${cedetdir}/srecode/srt-wy.el: ${srcdir}/srecode-template.wy
+${cedetdir}/srecode/srt-wy.el: ${srcdir}/srecode-template.wy ${grammar_wisent}
$(AM_V_GEN)[ ! -f "$@" ] || chmod +w "$@"
$(AM_V_at)${make_wisent} -o "$@" $<
-
-.PHONY: distclean bootstrap-clean maintainer-clean extraclean
+.PHONY: distclean bootstrap-clean maintainer-clean gen-clean
distclean:
rm -f Makefile
-## Perhaps this should do what extraclean (qv) does.
+## IMO this should run gen-clean.
bootstrap-clean:
-maintainer-clean: distclean
-
-## We do not normally delete the generated files, even in bootstrap.
-## Creating them does not take long, so we could easily change this.
-extraclean:
+gen-clean:
rm -f ${ALL}
+maintainer-clean: gen-clean distclean
+
+
+
# Makefile.in ends here
diff --git a/admin/grammars/c.by b/admin/grammars/c.by
index 2d04c999aca..289081e3ced 100644
--- a/admin/grammars/c.by
+++ b/admin/grammars/c.by
@@ -415,7 +415,7 @@ typesimple
: struct-or-class opt-class opt-name opt-template-specifier
opt-class-parents semantic-list
(TYPE-TAG (car $3) (car $1)
- (let ((semantic-c-classname (cons (car ,$3) (car ,$1))))
+ (dlet ((semantic-c-classname (cons (car ,$3) (car ,$1))))
(EXPANDFULL $6 classsubparts))
$5
:template-specifier $4
diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy
index 054e85bf70d..35fb7e832e9 100644
--- a/admin/grammars/grammar.wy
+++ b/admin/grammars/grammar.wy
@@ -128,7 +128,7 @@ epilogue:
;;
declaration:
decl
- (eval $1)
+ (eval $1 t)
;
decl:
@@ -206,7 +206,7 @@ put_decl:
put_name_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-name (EXPANDFULL $1 put_names))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 put_names))
;
put_names:
@@ -226,7 +226,7 @@ put_name:
put_value_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-code-detail (EXPANDFULL $1 put_values))
+ (mapcar #'semantic-tag-code-detail (EXPANDFULL $1 put_values))
;
put_values:
@@ -300,7 +300,7 @@ plist:
use_name_list:
BRACE_BLOCK
- (mapcar 'semantic-tag-name (EXPANDFULL $1 use_names))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 use_names))
;
use_names:
@@ -356,7 +356,7 @@ nonterminal:
rules:
lifo_rules
- (apply 'nconc (nreverse $1))
+ (apply #'nconc (nreverse $1))
;
lifo_rules:
diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy
index aaa25ced202..2539d1bec8c 100644
--- a/admin/grammars/python.wy
+++ b/admin/grammars/python.wy
@@ -88,15 +88,17 @@
%package wisent-python-wy
%provide semantic/wisent/python-wy
-%expectedconflicts 4
+%expectedconflicts 5
%{
+(require 'semantic/tag)
(declare-function wisent-python-reconstitute-function-tag
"semantic/wisent/python" (tag suite))
(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python"
(tag))
(declare-function semantic-parse-region "semantic"
(start end &optional nonterminal depth returnonerror))
+(defvar wisent-python-EXPANDING-block)
}
%languagemode python-mode
@@ -184,6 +186,7 @@
%token <punctuation> ASSIGN "="
%token <punctuation> BACKQUOTE "`"
%token <punctuation> AT "@"
+%token <punctuation> FOLLOWS "->"
;; -----------------
@@ -808,12 +811,17 @@ decorators
;; funcdef: [decorators] 'def' NAME parameters ':' suite
funcdef
- : DEF NAME function_parameter_list COLON suite
+ : DEF NAME function_parameter_list return_type_hint COLON suite
(wisent-python-reconstitute-function-tag
- (FUNCTION-TAG $2 nil $3) $5)
- | decorators DEF NAME function_parameter_list COLON suite
+ (FUNCTION-TAG $2 nil $3) $6)
+ | decorators DEF NAME function_parameter_list return_type_hint COLON suite
(wisent-python-reconstitute-function-tag
- (FUNCTION-TAG $3 nil $4 :decorators $1) $6)
+ (FUNCTION-TAG $3 nil $4 :decorators $1) $7)
+ ;
+
+return_type_hint
+ : ;;EMPTY
+ | FOLLOWS type
;
function_parameter_list
@@ -865,7 +873,7 @@ paren_class_list_opt
paren_class_list
: PAREN_BLOCK
(let ((wisent-python-EXPANDING-block t))
- (mapcar 'semantic-tag-name (EXPANDFULL $1 paren_classes)))
+ (mapcar #'semantic-tag-name (EXPANDFULL $1 paren_classes)))
;
;; parameters: '(' [varargslist] ')'
@@ -887,7 +895,7 @@ paren_classes
;; parser can parse general expressions, I don't see much benefit in
;; generating a string of expression as base class "name".
paren_class
- : dotted_name
+ : type
;
;;;****************************************************************************
@@ -1140,7 +1148,7 @@ fpdef_opt_test
;; fpdef: NAME | '(' fplist ')'
fpdef
- : NAME
+ : NAME type_hint
(VARIABLE-TAG $1 nil nil)
;; Below breaks the parser. Don't know why, but my guess is that
;; LPAREN/RPAREN clashes with the ones in function_parameters.
@@ -1160,6 +1168,15 @@ fpdef
;; | fpdef_list COMMA fpdef
;; ;
+type_hint
+ : ;;EMPTY
+ | COLON type
+ ;
+
+type
+ : test
+ ;
+
;; ['=' test]
eq_test_opt
: ;;EMPTY
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 5125086e881..ae007d76b03 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -33,6 +33,11 @@ General steps (for each step, check for possible errors):
or some form of "git clean -x". It's probably simpler and safer to
make a new working directory exclusively for the release branch.
+ If the working directory has subdirectories created when making
+ previous releases or pretests, remove those subdirectories, as the
+ command which updates the ChangeLog file might attempt to recurse
+ there and scan any ChangeLog.* files there.
+
Make sure the tree is built, or at least configured. That's
because some of the commands below run Make, so they need
Makefiles to be present.
@@ -68,20 +73,29 @@ General steps (for each step, check for possible errors):
3. Set the version number (M-x load-file RET admin/admin.el RET, then
M-x set-version RET). For a pretest, start at version .90. After
- .99, use .990 (so that it sorts).
+ .99, use .990 (so that it sorts). Commit the resulting changes
+ as one, with nothing else included, and using a log message
+ of the format "Bump Emacs version to ...", so that the commit can
+ be skipped when merging branches (see admin/gitmerge.el).
The final pretest should be a release candidate.
Before a release candidate is made, the tasks listed in
admin/release-process must be completed.
- Set the version number to that of the actual release. Pick a date
- about a week from now when you intend to make the release. Use M-x
- add-release-logs to add entries to etc/HISTORY and the ChangeLog
- file. It's best not to commit these files until the release is
- actually made. Merge the entries from (unversioned) ChangeLog
- into the top of the current versioned ChangeLog.N and commit that
- along with etc/HISTORY. Then you can tag that commit as the
- release.
+ Set the version number to that of the actual release (commit in
+ one, as described above). Pick a date about a week from now when
+ you intend to make the release. Use M-x add-release-logs to add
+ entries to etc/HISTORY and the ChangeLog file. It's best not to
+ commit these files until the release is actually made. Merge the
+ entries from (unversioned) ChangeLog into the top of the current
+ versioned ChangeLog.N and commit that along with etc/HISTORY.
+ Then you can tag that commit as the release.
+
+ Alternatively, you can commit and tag with the RC tag right away,
+ and delay the final tagging until you actually decide to make a
+ release and announce it. The "git tag" command can tag a specific
+ commit if you give it the SHA1 of that commit, even if additional
+ commits have been pushed in the meantime.
Name the tar file as emacs-XX.Y-rc1.tar. If all goes well in the
following week, you can simply rename the file and use it for the
@@ -96,11 +110,11 @@ General steps (for each step, check for possible errors):
Never replace an existing tarfile! If you need to fix something,
always upload it with a different name.
-4. autoreconf -i -I m4 --force
- make bootstrap
+4. autoreconf -i -I m4 --force
+ make bootstrap
- make -C etc/refcards
- make -C etc/refcards clean
+ make -C etc/refcards
+ make -C etc/refcards clean
If some of the etc/refcards, especially the non-English ones, fail
to build, you probably need to install some TeX/LaTeX packages, in
@@ -114,13 +128,18 @@ General steps (for each step, check for possible errors):
5. Copy lisp/loaddefs.el to lisp/ldefs-boot.el.
Commit ChangeLog.N, etc/AUTHORS, lisp/ldefs-boot.el, and the
- files changed by M-x set-version.
+ files changed by M-x set-version. The easiest way of doing that
+ is "C-x v d ROOT-DIR RET", then go to the first modified file,
+ press 'M' to mark all modified files, and finally 'v' to commit
+ them. Make sure the commit log message mentions all the changes
+ in all modified files, as by default 'v' doesn't necessarily do
+ so.
If someone else made a commit between step 1 and now,
you need to repeat from step 4 onwards. (You can commit the files
from step 2 and 3 earlier to reduce the chance of this.)
-6. ./make-dist --snapshot --no-compress
+6. ./make-dist --snapshot --no-compress
Check the contents of the new tar with admin/diff-tar-files
against the previous release (if this is the first pretest) or the
@@ -128,6 +147,14 @@ General steps (for each step, check for possible errors):
yourself, find it at <https://alpha.gnu.org/gnu/emacs/pretest>.
Releases are of course at <https://ftp.gnu.org/pub/gnu/emacs/>.
+ ./admin/diff-tar-files emacs-OLD.tar.gz emacs-NEW.tar.gz
+
+ Alternatively:
+
+ tar tJf emacs-OLD.tar.xz | sed -e 's,^[^/]*,,' | sort > old_tmp
+ tar tJf emacs-NEW.tar.xz | sed -e 's,^[^/]*,,' | sort > new_tmp
+ diff -u old_tmp new_tmp
+
If this is the first pretest of a major release, just comparing
with the previous release may overlook many new files. You can try
something like 'find . | sort' in a clean repository, and compare the
@@ -135,6 +162,7 @@ General steps (for each step, check for possible errors):
7. tar -xf emacs-NEW.tar; cd emacs-NEW
./configure --prefix=/tmp/emacs && make check && make install
+
Use 'script' or M-x compile to save the compilation log in
compile-NEW.log and compare it against an old one. The easiest way
to do that is to visit the old log in Emacs, change the version
@@ -142,8 +170,23 @@ General steps (for each step, check for possible errors):
M-x ediff. Especially check that Info files aren't built, and that
no autotools (autoconf etc) run.
-8. cd EMACS_ROOT_DIR && git tag -a TAG && git push origin tag TAG
- TAG is emacs-XX.Y.ZZ for a pretest, emacs-XX.Y for a release.
+8. You can now tag the release/pretest and push it together with the
+ last commit:
+
+ cd EMACS_ROOT_DIR && git tag -a TAG -m "Emacs TAG"
+ git push
+ git push --tags
+
+ Here TAG is emacs-XX.Y.ZZ for a pretest, emacs-XX.Y for a release.
+ For a release, if you are producing a release candidate first, use
+ emacs-XX.Y-rcN (N = 1, 2, ...) when you tar the RC, and add the
+ actual release tag later, when the official release tarball is
+ uploaded to ftp.gnu.org. When adding a tag later, it is safer to
+ use the SHA1 of the last commit which went into the release
+ tarball, in case there were some intervening commits since then:
+
+ git tag -a TAG -m "Emacs TAG" SHA1
+ git push --tags
9. Decide what compression schemes to offer.
For a release, at least gz and xz:
@@ -207,26 +250,48 @@ General steps (for each step, check for possible errors):
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.
+12. After a release, update the Emacs pages as described below.
+13. Bump the Emacs version on the release branch.
+ If the released version was XX.Y, use 'set-version' from
+ admin/admin.el to bump the version on the release branch to
+ XX.Y.50. Commit the changes.
UPDATING THE EMACS WEB PAGES AFTER A RELEASE
-As soon as possible after a release, the Emacs web pages should be updated.
-(See admin/notes/www for general information.)
+As soon as possible after a release, the Emacs web pages at
+https://www.gnu.org/software/emacs/ should be updated. (See
+admin/notes/www for general information.)
The pages to update are:
emacs.html (for a new major release, a more thorough update is needed)
history.html
add the new NEWS file as news/NEWS.xx.y
+Copy new etc/MACHINES to MACHINES and CONTRIBUTE to CONTRIBUTE
For every new release, a banner is displayed on top of the emacs.html
page. Uncomment and the release banner in emacs.html. Keep it on the
-page for about a month, then comment it again.
+page for about a month, then comment it again. The new release banner
+looks like this:
+
+ <div class="release-banner">
+ <div class="container">
+ <h2><em>Emacs 27.1 is out</em>, download it <a href="download.html">here</a>!</h2>
+ </div>
+ </div>
Regenerate the various manuals in manual/.
The scripts admin/make-manuals and admin/upload-manuals summarize the process.
+If you have Texinfo installed locally, make-manuals might fail if it
+cannot find epsf.tex. In that case define in the environment
+
+ TEXINPUTS=:/path/to/texinfo-tree/doc
+
+where /path/to/texinfo-tree is the absolute file name of the top-level
+directory where you have the Texinfo source tree. Then re-run
+make-manuals.
+
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 1c8b4427000..c12e83dd2fa 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -33,7 +33,7 @@ GNULIB_MODULES='
crypto/md5-buffer crypto/sha1-buffer crypto/sha256-buffer crypto/sha512-buffer
d-type diffseq double-slash-root dtoastr dtotimespec dup2
environ execinfo explicit_bzero faccessat
- fchmodat fcntl fcntl-h fdopendir
+ fchmodat fcntl fcntl-h fdopendir file-has-acl
filemode filename filevercmp flexmember fpieee
free-posix fstatat fsusage fsync futimens
getloadavg getopt-gnu getrandom gettime gettimeofday gitlog-to-changelog
diff --git a/admin/notes/emba b/admin/notes/emba
index adebcefcf3e..36b126e7735 100644
--- a/admin/notes/emba
+++ b/admin/notes/emba
@@ -36,6 +36,21 @@ of the Emacs git repository to perform a bootstrap and test of Emacs.
This could happen for several jobs with changed configuration, compile
and test parameters.
+There are different types of jobs: 'prep-image-base' is responsible to
+prepare the environment for the following jobs. 'build-image-*' jobs
+are responsible to compile Emacs in different configuration. The
+corresponding 'test-*' jobs run the ert tests.
+
+A special job is 'test-all-inotify', which runs 'make check-expensive'.
+While most of the jobs run as soon as a respective file has been
+committed into the Emacs git repository, this test job runs scheduled,
+every 8 hours.
+
+The log files for every test job are kept on the server for a week.
+They can be downloaded from the server, visiting the URL
+<https://emba.gnu.org/emacs/emacs/-/pipelines>, and selecting the job
+in question.
+
* Emba configuration
The emba configuration files are hosted on
diff --git a/admin/notes/years b/admin/notes/years
index b56d94a1eda..19c72c39184 100644
--- a/admin/notes/years
+++ b/admin/notes/years
@@ -5,6 +5,12 @@ rolls around, add that year to every FSF (and AIST) copyright notice.
Do this by running the 'admin/update-copyright' script on a fresh repo
checkout. Inspect the results for plausibility, then commit them.
+You should also run the etags test suite in test/manual/etags/. It
+will most probably fail because the contents of the test files changes
+due to copyright years update, so you need to move each ETAGS and
+CTAGS file produced by the test runs into the corresponding
+ETAGS.good* and CTAGS.good files, and then commit the new test files.
+
There's no need to worry about whether an individual file has changed
in a given year - it's sufficient that Emacs as a whole has changed.
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index f31e1bb09fd..357b8126783 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -36,23 +36,7 @@ emacs = "${EMACS}" -batch --no-site-file --no-site-lisp
lparen = (
unifiles = $(addprefix ${unidir}/,$(sort $(shell sed -n 's/^[ \t][ \t]*${lparen}"\(uni-[^"]*\)"$$/\1/p' ${srcdir}/unidata-gen.el)))
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_ELC = $(am__v_ELC_@AM_V@)
-am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
-am__v_ELC_0 = @echo " ELC " $@;
-am__v_ELC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
.PHONY: all
@@ -101,26 +85,25 @@ ${unidir}/charscript.el: ${srcdir}/Blocks.txt ${blocks}
$(AM_V_GEN)$(AWK) -f ${blocks} < $< > $@
-.PHONY: clean bootstrap-clean distclean maintainer-clean extraclean
+.PHONY: clean bootstrap-clean distclean maintainer-clean gen-clean
clean:
rm -f ${srcdir}/*.elc unidata.txt
+## IMO this should also run gen-clean.
bootstrap-clean: clean
distclean: clean
rm -f Makefile
-maintainer-clean: distclean
-
-## Do not remove these files, even in a bootstrap, because they rarely
-## change and it slows down bootstrap (a tiny bit).
-## Cf leim/ja-dic (which is much slower).
-
## macuvs.h is a generated file, but it's also checked in because
## macOS builds would need to do a headless bootstrap without it,
## which is currently awkward. To avoid changing checked-in files
## from a make target, we don't delete it here.
-extraclean: distclean
+gen-clean:
rm -f ${unidir}/charscript.el*
rm -f ${unifiles} ${unidir}/charprop.el
+## ref: https://lists.gnu.org/r/emacs-devel/2013-11/msg01029.html
+
+maintainer-clean: gen-clean distclean
+
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 221c9b104e0..abd41e34a48 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -1,4 +1,4 @@
-;; unidata-gen.el -- Create files containing character property data -*- lexical-binding:t -*-
+;;; unidata-gen.el --- Create files containing character property data -*- lexical-binding:t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -1446,7 +1446,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; End:\n\n"
- (format ";; %s ends here\n" basename)))))
+ (format ";;; %s ends here\n" basename)))))
(or noninteractive (message "Generating %s...done" file)))
(defun unidata-gen-charprop (&optional charprop-file)
@@ -1470,7 +1470,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
";; no-byte-compile: t\n"
";; no-update-autoloads: t\n"
";; End:\n\n"
- (format ";; %s ends here\n"
+ (format ";;; %s ends here\n"
(file-name-nondirectory charprop-file)))))
diff --git a/admin/update_autogen b/admin/update_autogen
index 35c391da19e..11c4313ae37 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -317,7 +317,7 @@ EOF
echo "Finding loaddef targets..."
find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \
- sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
+ sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \
>| $tempfile || die "Error finding targets"
genfiles=
@@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error"
## Ignore comment differences.
-[ ! "$lboot_flag" ] || \
+[ ! "$lboot_flag" ] || \
diff -q -I '^;' $ldefs_in $ldefs_out || \
cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
+# Refresh the prebuilt grammar-wy.el
+grammar_in=lisp/cedet/semantic/grammar-wy.el
+grammar_out=lisp/cedet/semantic/grm-wy-boot.el
+make -C admin/grammars/ ../../$grammar_in
+cp $grammar_in $grammar_out || die "cp grm_wy_boot error"
+
echo "Checking status of loaddef files..."
## It probably would be fine to just check+commit lisp/, since
## making autoloads should not effect any other files. But better
## safe than sorry.
-modified=$(status $genfiles $ldefs_out) || die
+modified=$(status $genfiles $ldefs_out $grammar_out) || die
commit "loaddefs" $modified || die "commit error"
diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir
index ea26479cd96..256c9f025cc 100755
--- a/build-aux/make-info-dir
+++ b/build-aux/make-info-dir
@@ -52,8 +52,11 @@ exec "${AWK-awk}" '
topic[ntopics++] = "Emacs misc features"
topic[ntopics++] = "Emacs lisp libraries"
topic[ntopics] = "Unknown category"
+ texinfo = 0
}
+
/^@dircategory / {
+ texinfo = 1
sub(/^@dircategory /, "")
detexinfo()
for (dircat = 0; dircat < ntopics && topic[dircat] != $0; dircat++)
@@ -66,6 +69,33 @@ exec "${AWK-awk}" '
data[dircat] = data[dircat] $0 "\n"
}
}
+
+ ## Org stuff. TODO we assume the order of the texinfo items.
+ {
+ ## TODO Check FILENAME suffix instead?
+ ## TODO Is this portable awk?
+ if (FNR == 1) texinfo = 0
+
+ ## If applied to the generated org.texi file, this picks up the examples.
+ ## Thanks for making life more difficult...
+ if (texinfo) next
+
+ if (tolower($0) ~ /^#\+texinfo_dir_category/) {
+ sub(/^#[^:]*: /, "")
+ for (dircat = 0; dircat < ntopics && topic[dircat] != $0; dircat++)
+ continue;
+ }
+ if (tolower($0) ~ /^#\+texinfo_dir_title/) {
+ sub(/^#[^:]*: /, "")
+ ## Note this does not fill any long descriptions.
+ data[dircat] = data[dircat] sprintf("* %-30s", ($0 ". "))
+ }
+ if (tolower($0) ~ /^#\+texinfo_dir_desc/) {
+ sub(/^#[^:]*: /, "")
+ data[dircat] = data[dircat] $0 ".\n"
+ }
+ }
+
END {
for (dircat = 0; dircat <= ntopics; dircat++)
if (data[dircat])
diff --git a/configure.ac b/configure.ac
index 08f3c0cd857..eff55915436 100644
--- a/configure.ac
+++ b/configure.ac
@@ -187,7 +187,8 @@ dnl It is important that variables on the RHS not be expanded here,
dnl hence the single quotes. This is per the GNU coding standards, see
dnl (autoconf) Installation Directory Variables
dnl See also epaths.h below.
-lispdir='${datadir}/emacs/${version}/lisp'
+lispdirrel='${version}/lisp'
+lispdir='${datadir}/emacs/'${lispdirrel}
standardlisppath='${lispdir}'
locallisppath='${datadir}/emacs/${version}/site-lisp:'\
'${datadir}/emacs/site-lisp'
@@ -409,19 +410,18 @@ dnl This should be the last --with option, because --with-x is
dnl added later on when we find the file name of X, and it's best to
dnl keep them together visually.
AC_ARG_WITH([x-toolkit],[AS_HELP_STRING([--with-x-toolkit=KIT],
- [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, motif, no)])],
+ [use an X toolkit (KIT one of: yes or gtk, gtk2, gtk3, lucid or athena, no)])],
[ case "${withval}" in
y | ye | yes ) val=gtk ;;
n | no ) val=no ;;
l | lu | luc | luci | lucid ) val=lucid ;;
a | at | ath | athe | athen | athena ) val=athena ;;
- m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
gtk2 ) val=gtk2 ;;
gtk3 ) val=gtk3 ;;
* )
AC_MSG_ERROR(['--with-x-toolkit=$withval' is invalid;
-this option's value should be 'yes', 'no', 'lucid', 'athena', 'motif', 'gtk',
+this option's value should be 'yes', 'no', 'lucid', 'athena', 'gtk',
'gtk2' or 'gtk3'. 'yes' and 'gtk' are synonyms.
'athena' and 'lucid' are synonyms.])
;;
@@ -460,7 +460,7 @@ OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping])
OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping])
-OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif/Xaw3d/GTK toolkit scroll bars])
+OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Xaw3d/GTK toolkit scroll bars])
OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d])
OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off])
OPTION_DEFAULT_ON([xdbe],[don't use X11 double buffering support])
@@ -484,6 +484,7 @@ OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
OPTION_DEFAULT_ON([zlib],[don't compile with zlib decompression support])
OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support])
OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support])
+OPTION_DEFAULT_OFF([native-compilation],[compile with Emacs Lisp native compiler support])
AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB],
[use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])],
@@ -507,11 +508,6 @@ otherwise for the first of 'inotify', 'kqueue' or 'gfile' that is usable.])
OPTION_DEFAULT_OFF([xwidgets],
[enable use of xwidgets in Emacs buffers (requires gtk3 or macOS Cocoa)])
-## For the times when you want to build Emacs but don't have
-## a suitable makeinfo, and can live without the manuals.
-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.
AC_SUBST(cache_file)
@@ -1190,9 +1186,6 @@ AC_DEFUN([AM_CONDITIONAL],
dnl Prefer silent make output. For verbose output, use
dnl 'configure --disable-silent-rules' or 'make V=1' .
-dnl This code is adapted from Automake.
-dnl Although it can be simplified now that GNU Make is assumed,
-dnl the simplification hasn't been done yet.
AC_ARG_ENABLE([silent-rules],
[AS_HELP_STRING(
[--disable-silent-rules],
@@ -1202,11 +1195,8 @@ if test "$enable_silent_rules" = no; then
else
AM_DEFAULT_VERBOSITY=0
fi
-AM_V='$(V)'
-AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
-AC_SUBST([AM_V])
-AC_SUBST([AM_DEFAULT_V])
AC_SUBST([AM_DEFAULT_VERBOSITY])
+AC_CONFIG_FILES([src/verbose.mk])
dnl Some other nice autoconf tests.
AC_PROG_INSTALL
@@ -1344,15 +1334,17 @@ if test -n "$BREW"; then
[`$BREW --prefix texinfo 2>/dev/null`/bin$PATH_SEPARATOR$PATH])
fi
+# Check MacPorts on macOS.
+AC_PATH_PROG(HAVE_MACPORTS, port)
+
## Require makeinfo >= 4.13 (last of the 4.x series) to build the manuals.
-if test "${MAKEINFO:=makeinfo}" != "no"; then
- case `($MAKEINFO --version) 2>/dev/null` in
- *' (GNU texinfo) '4.1[[3-9]]* | \
- *' (GNU texinfo) '[[5-9]]* | \
- *' (GNU texinfo) '[[1-9][0-9]]* ) ;;
- *) MAKEINFO=no;;
- esac
-fi
+: ${MAKEINFO:=makeinfo}
+case `($MAKEINFO --version) 2>/dev/null` in
+ *' (GNU texinfo) '4.1[[3-9]]* | \
+ *' (GNU texinfo) '[[5-9]]* | \
+ *' (GNU texinfo) '[[1-9][0-9]]* ) ;;
+ *) MAKEINFO=no;;
+esac
## Makeinfo is unusual. For a released Emacs, the manuals are
## pre-built, and not deleted by the normal clean rules. makeinfo is
@@ -1363,21 +1355,19 @@ fi
## should test for it as it does for any other build requirement.
## We use the presence of $srcdir/info/emacs to distinguish a release,
## with pre-built manuals, from a repository checkout.
-HAVE_MAKEINFO=yes
-
if test "$MAKEINFO" = "no"; then
MAKEINFO=makeinfo
- if test "x${with_makeinfo}" = "xno"; then
- HAVE_MAKEINFO=no
- elif test ! -e "$srcdir/info/emacs" && test ! -e "$srcdir/info/emacs.info"; then
+ if test ! -e "$srcdir/info/emacs" && test ! -e "$srcdir/info/emacs.info"; then
AC_MSG_ERROR( [You do not seem to have makeinfo >= 4.13, and your
source tree does not seem to have pre-built manuals in the 'info' directory.
-Either install a suitable version of makeinfo, or re-run configure
-with the '--without-makeinfo' option to build without the manuals.] )
+Please install a suitable version of makeinfo.] )
+ else
+ AC_MSG_WARN( [You do not seem to have makeinfo >= 4.13.
+You will not be able to rebuild the manuals if you delete them or change
+their sources.] )
fi
fi
AC_SUBST([MAKEINFO])
-AC_SUBST(HAVE_MAKEINFO)
if test $opsys = mingw32; then
DOCMISC_W32=efaq-w32
@@ -1768,8 +1758,8 @@ fi
dnl On Solaris 8 there's a compilation warning for term.h because
dnl it doesn't define 'bool'.
-AC_CHECK_HEADERS(term.h, , , -)
-AC_HEADER_TIME
+AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[#include <term.h>]],[[]])],
+ AC_DEFINE(HAVE_TERM_H, 1, [Define to 1 if you have the <term.h> header file.]))
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS_ONCE(sys/socket.h)
@@ -1907,6 +1897,8 @@ if test "${with_ns}" != no; then
NS_IMPL_COCOA=yes
ns_appdir=`pwd`/nextstep/Emacs.app
ns_appbindir=${ns_appdir}/Contents/MacOS
+ ns_applibexecdir=${ns_appdir}/Contents/MacOS/libexec
+ ns_applibdir=${ns_appdir}/Contents/Frameworks
ns_appresdir=${ns_appdir}/Contents/Resources
ns_appsrc=Cocoa/Emacs.base
ns_fontfile=macfont.o
@@ -1964,6 +1956,8 @@ fail;
if test $NS_IMPL_GNUSTEP = yes; then
ns_appdir=`pwd`/nextstep/Emacs.app
ns_appbindir=${ns_appdir}
+ ns_applibexecdir=${ns_appdir}/libexec
+ ns_applibdir=${ns_appdir}/Frameworks
ns_appresdir=${ns_appdir}/Resources
ns_appsrc=GNUstep/Emacs.base
ns_fontfile=nsfont.o
@@ -2020,12 +2014,13 @@ if test "${HAVE_NS}" = yes; then
window_system=nextstep
# set up packaging dirs
if test "${EN_NS_SELF_CONTAINED}" = yes; then
+ AC_DEFINE(NS_SELF_CONTAINED, 1, [Build an NS bundled app])
ns_self_contained=yes
prefix=${ns_appresdir}
exec_prefix=${ns_appbindir}
dnl This one isn't really used, only archlibdir is.
- libexecdir="\${ns_appbindir}/libexec"
- archlibdir="\${ns_appbindir}/libexec"
+ libexecdir="\${ns_applibexecdir}"
+ archlibdir="\${ns_applibexecdir}"
etcdocdir="\${ns_appresdir}/etc"
etcdir="\${ns_appresdir}/etc"
dnl FIXME maybe set datarootdir instead.
@@ -2033,7 +2028,8 @@ if test "${HAVE_NS}" = yes; then
infodir="\${ns_appresdir}/info"
mandir="\${ns_appresdir}/man"
lispdir="\${ns_appresdir}/lisp"
- test "$locallisppathset" = no && locallisppath=""
+ lispdirrel="\${ns_appresdir}/lisp"
+ test "$locallisppathset" = no && locallisppath="\${ns_appresdir}/site-lisp"
INSTALL_ARCH_INDEP_EXTRA=
fi
@@ -2252,7 +2248,7 @@ if test "$window_system" = none && test "X$with_x" != "Xno"; then
then
AC_MSG_ERROR([You seem to be running X, but no X development libraries
were found. You should install the relevant development files for X
-and for the toolkit you want, such as Gtk+ or Motif. Also make
+and for the toolkit you want, such as Gtk+. Also make
sure you have development files for image handling, i.e.
tiff, gif, jpeg, png and xpm.
If you are sure you want Emacs compiled without X window support, pass
@@ -2285,6 +2281,9 @@ doug_lea_malloc=$emacs_cv_var_doug_lea_malloc
hybrid_malloc=
system_malloc=yes
+dnl This must be before the test of $ac_cv_func_sbrk below.
+AC_CHECK_FUNCS_ONCE([sbrk])
+
test $with_unexec = yes &&
case "$opsys" in
## darwin ld insists on the use of malloc routines in the System framework.
@@ -2901,6 +2900,11 @@ fi
AC_SUBST(SETTINGS_CFLAGS)
AC_SUBST(SETTINGS_LIBS)
+USE_STARTUP_NOTIFICATION=no
+if test "${HAVE_GTK}" = "yes"; then
+ USE_STARTUP_NOTIFICATION=yes
+fi
+AC_SUBST(USE_STARTUP_NOTIFICATION)
dnl SELinux is available for GNU/Linux only.
HAVE_LIBSELINUX=no
@@ -3675,6 +3679,7 @@ AC_SUBST(LIBZ)
LIBMODULES=
HAVE_MODULES=no
MODULES_OBJ=
+NEED_DYNLIB=no
case $opsys in
cygwin|mingw32) MODULES_SUFFIX=".dll" ;;
darwin) MODULES_SUFFIX=".dylib" ;;
@@ -3710,7 +3715,8 @@ if test "${with_modules}" != "no"; then
fi
if test "${HAVE_MODULES}" = yes; then
- MODULES_OBJ="dynlib.o emacs-module.o"
+ MODULES_OBJ="emacs-module.o"
+ NEED_DYNLIB=yes
AC_DEFINE(HAVE_MODULES, 1, [Define to 1 if dynamic modules are enabled])
AC_DEFINE_UNQUOTED(MODULES_SUFFIX, "$MODULES_SUFFIX",
[System extension for dynamic libraries])
@@ -3737,6 +3743,147 @@ module_env_snippet_28="$srcdir/src/module-env-28.h"
emacs_major_version="${PACKAGE_VERSION%%.*}"
AC_SUBST(emacs_major_version)
+### Emacs Lisp native compiler support
+
+AC_DEFUN([libgccjit_smoke_test], [
+ AC_LANG_SOURCE(
+ [[#include <libgccjit.h>
+ #include <stdlib.h>
+ #include <stdio.h>
+ int
+ main (int argc, char **argv)
+ {
+ gcc_jit_context *ctxt;
+ gcc_jit_result *result;
+ ctxt = gcc_jit_context_acquire ();
+ if (!ctxt)
+ exit (1);
+ gcc_jit_type *int_type =
+ gcc_jit_context_get_type (ctxt, GCC_JIT_TYPE_INT);
+ gcc_jit_function *func =
+ gcc_jit_context_new_function (ctxt, NULL,
+ GCC_JIT_FUNCTION_EXPORTED,
+ int_type, "foo", 0, NULL, 0);
+ gcc_jit_block *block = gcc_jit_function_new_block (func, "foo");
+ gcc_jit_block_end_with_return (
+ block,
+ NULL,
+ gcc_jit_context_new_rvalue_from_int (ctxt, int_type, 1));
+ result = gcc_jit_context_compile (ctxt);
+ if (!result)
+ exit (1);
+ typedef int (*fn_type) (void);
+ fn_type foo =
+ (fn_type)gcc_jit_result_get_code (result, "foo");
+ if (!foo)
+ exit (1);
+ if (foo () != 1)
+ exit (1);
+ gcc_jit_context_release (ctxt);
+ gcc_jit_result_release (result);
+ return 0;
+ }]])])
+
+AC_DEFUN([libgccjit_not_found], [
+ AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit was not found.
+Please try installing libgccjit or a similar package.
+If you are sure you want Emacs be compiled without ELisp native compiler,
+pass the --without-native-compilation option to configure.])])
+
+AC_DEFUN([libgccjit_dev_not_found], [
+ AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit header files were
+not found.
+Please try installing libgccjit-dev or a similar package.
+If you are sure you want Emacs be compiled without ELisp native compiler,
+pass the --without-nativecomp option to configure.])])
+
+AC_DEFUN([libgccjit_broken], [
+ AC_MSG_ERROR([The installed libgccjit failed to compile and run a test program using
+the libgccjit library; see config.log for the details of the failure.
+The test program can be found here:
+<https://gcc.gnu.org/onlinedocs/jit/intro/tutorial01.html>.
+You can try compiling it yourself to investigate the issues.
+Please report the issue to your distribution if libgccjit was installed
+through that.
+You can find the instructions on how to compile and install libgccjit from
+source on this site:
+<https://gcc.gnu.org/wiki/JIT>.])])
+
+HAVE_NATIVE_COMP=no
+LIBGCCJIT_LIBS=
+LIBGCCJIT_CFLAGS=
+if test "${with_native_compilation}" != "no"; then
+ if test "${HAVE_PDUMPER}" = no; then
+ AC_MSG_ERROR(['--with-nativecomp' requires '--with-dumping=pdumper'])
+ fi
+ if test "${HAVE_ZLIB}" = no; then
+ AC_MSG_ERROR(['--with-nativecomp' requires zlib])
+ fi
+
+ # Ensure libgccjit installed by Homebrew can be found.
+ if test -n "$BREW"; then
+ BREW_LIBGCCJIT_PREFIX=`$BREW --prefix --installed libgccjit 2>/dev/null`
+ if test "$BREW_LIBGCCJIT_PREFIX"; then
+ brew_libdir=`find ${BREW_LIBGCCJIT_PREFIX}/ -name \*.so \
+ | sed -e '1!d;s|/[[^/]]*\.so$||'`
+ CFLAGS="$CFLAGS -I${BREW_LIBGCCJIT_PREFIX}/include"
+ LDFLAGS="$LDFLAGS -L${brew_libdir} -I${BREW_LIBGCCJIT_PREFIX}/include"
+ fi
+ fi
+
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ # Determine which gcc version has been installed (gcc11, for
+ # instance).
+ PORT_PACKAGE=$(port installed active | grep '^ *gcc@<:@0-9@:>@* ' | \
+ awk '{ print $1; }')
+ MACPORTS_LIBGCCJIT_INCLUDE=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.h))
+ MACPORTS_LIBGCCJIT_LIB=$(dirname $(port contents $PORT_PACKAGE | \
+ grep libgccjit.dylib))
+ CFLAGS="$CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LDFLAGS="$LDFLAGS -L${MACPORTS_LIBGCCJIT_LIB}"
+ fi
+
+ # Check if libgccjit is available.
+ AC_CHECK_LIB(gccjit, gcc_jit_context_acquire, [], [libgccjit_not_found])
+ AC_CHECK_HEADERS(libgccjit.h, [], [libgccjit_dev_not_found])
+ emacs_save_LIBS=$LIBS
+ LIBS="-lgccjit"
+ # Check if libgccjit really works.
+ AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken])
+ LIBS=$emacs_save_LIBS
+ HAVE_NATIVE_COMP=yes
+ case "${opsys}" in
+ # mingw32 loads the library dynamically.
+ mingw32) ;;
+ # OpenBSD doesn't have libdl, all the functions are in libc
+ netbsd|openbsd)
+ LIBGCCJIT_LIBS="-lgccjit" ;;
+ *)
+ LIBGCCJIT_LIBS="-lgccjit -ldl" ;;
+ esac
+ NEED_DYNLIB=yes
+ AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if native compiler is available.])
+
+ # Ensure libgccjit installed by MacPorts can be found.
+ if test -n "$HAVE_MACPORTS"; then
+ LIBGCCJIT_CFLAGS="$LIBGCCJIT_CFLAGS -I${MACPORTS_LIBGCCJIT_INCLUDE}"
+ LIBGCCJIT_LIBS="-L${MACPORTS_LIBGCCJIT_LIB} $LIBGCCJIT_LIBS"
+ fi
+fi
+AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln",
+ [System extension for native compiled elisp])
+AC_SUBST(HAVE_NATIVE_COMP)
+AC_SUBST(LIBGCCJIT_CFLAGS)
+AC_SUBST(LIBGCCJIT_LIBS)
+
+DYNLIB_OBJ=
+if test "${NEED_DYNLIB}" = yes; then
+ DYNLIB_OBJ="dynlib.o"
+fi
+AC_SUBST(DYNLIB_OBJ)
+
### Use -lpng if available, unless '--with-png=no'.
HAVE_PNG=no
LIBPNG=
@@ -3912,6 +4059,11 @@ case $with_json,$HAVE_JSON in
WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";;
esac
if test "X${MISSING}" != X; then
+ # If we have a missing library, and we don't have pkg-config installed,
+ # the missing pkg-config may be the reason. Give the user a hint.
+ if test "X${PKG_CONFIG}" = X; then
+ AC_MSG_WARN([Unable to locate a usable pkg-config])
+ fi
AC_MSG_ERROR([The following required libraries were not found:
$MISSING
Maybe some development libraries/packages are missing?
@@ -4189,6 +4341,22 @@ fi
AC_SUBST([BLESSMAIL_TARGET])
AC_SUBST([LIBS_MAIL])
+HAVE_SECCOMP=no
+AC_CHECK_HEADERS(
+ [linux/seccomp.h linux/filter.h],
+ [AC_CHECK_DECLS(
+ [SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC],
+ [HAVE_SECCOMP=yes], [],
+ [[
+ #include <linux/seccomp.h>
+ ]])])
+AC_SUBST([HAVE_SECCOMP])
+
+EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0])
+AC_SUBST([HAVE_LIBSECCOMP])
+AC_SUBST([LIBSECCOMP_LIBS])
+AC_SUBST([LIBSECCOMP_CFLAGS])
+
OLD_LIBS=$LIBS
LIBS="$LIB_PTHREAD $LIB_MATH $LIBS"
AC_CHECK_FUNCS(accept4 fchdir gethostname \
@@ -4196,7 +4364,7 @@ getrusage get_current_dir_name \
lrand48 random rint trunc \
select getpagesize setlocale newlocale \
getrlimit setrlimit shutdown \
-pthread_sigmask strsignal setitimer timer_getoverrun \
+pthread_sigmask strsignal setitimer \
sendto recvfrom getsockname getifaddrs freeifaddrs \
gai_strerror sync \
getpwent endpwent getgrent endgrent \
@@ -4548,7 +4716,7 @@ AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
-AC_CHECK_FUNCS_ONCE([__lsan_ignore_object sbrk])
+AC_CHECK_FUNCS_ONCE([__lsan_ignore_object])
AC_FUNC_FORK
@@ -4717,10 +4885,10 @@ if test "$USE_X_TOOLKIT" != "none"; then
else
OTHERLIBS="-lXt -$LIBXMU"
fi
- AC_TRY_LINK(
- [#include <X11/Intrinsic.h>
- #include <X11/Xmu/Editres.h>],
- [_XEditResCheckMessages (0, 0, 0, 0);],
+ AC_LINK_IFELSE([AC_LANG_PROGRAM(
+ [[#include <X11/Intrinsic.h>
+ #include <X11/Xmu/Editres.h>]],
+ [[_XEditResCheckMessages (0, 0, 0, 0);]])],
[AC_DEFINE([X_TOOLKIT_EDITRES], 1,
[Define to 1 if we should use XEditRes.])])
LIBS=$OLDLIBS
@@ -4741,7 +4909,7 @@ emacs_broken_SIGIO=no
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
- hpux* | nacl | openbsd | solaris | unixware )
+ hpux* | nacl | solaris | unixware )
emacs_broken_SIGIO=yes
;;
@@ -5252,6 +5420,7 @@ AC_SUBST(sharedstatedir)
AC_SUBST(libexecdir)
AC_SUBST(mandir)
AC_SUBST(infodir)
+AC_SUBST(lispdirrel)
AC_SUBST(lispdir)
AC_SUBST(standardlisppath)
AC_SUBST(locallisppath)
@@ -5275,6 +5444,8 @@ AC_SUBST(CFLAGS)
AC_SUBST(X_TOOLKIT_TYPE)
AC_SUBST(ns_appdir)
AC_SUBST(ns_appbindir)
+AC_SUBST(ns_applibexecdir)
+AC_SUBST(ns_applibdir)
AC_SUBST(ns_appresdir)
AC_SUBST(ns_appsrc)
AC_SUBST(GNU_OBJC_CFLAGS)
@@ -5493,6 +5664,12 @@ gl_INIT
CFLAGS=$SAVE_CFLAGS
LIBS=$SAVE_LIBS
+# timer_getoverrun needs the same libarary as timer_settime
+OLD_LIBS=$LIBS
+LIBS="$LIB_TIMER_TIME $LIBS"
+AC_CHECK_FUNCS(timer_getoverrun)
+LIBS=$OLD_LIBS
+
if test "${opsys}" = "mingw32"; then
CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc"
# Remove unneeded switches from the value of CC that goes to Makefiles
@@ -5508,7 +5685,8 @@ case "$opsys" in
if test "$HAVE_NS" = "yes"; then
libs_nsgui="-framework AppKit"
if test "$NS_IMPL_COCOA" = "yes"; then
- libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon -framework IOSurface"
+ libs_nsgui="$libs_nsgui -framework IOKit -framework Carbon \
+ -framework IOSurface -framework QuartzCore"
fi
else
libs_nsgui=
@@ -5548,6 +5726,13 @@ case "$opsys" in
x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x400000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;;
*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;;
esac
+ ## If they want unexec, disable Windows ASLR for the Emacs binary
+ if test "$with_dumping" = "unexec"; then
+ case "$canonical" in
+ x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -Wl,-disable-dynamicbase -Wl,-disable-high-entropy-va -Wl,-default-image-base-low" ;;
+ *) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -Wl,-disable-dynamicbase" ;;
+ esac
+ fi
;;
*) LD_SWITCH_SYSTEM_TEMACS= ;;
@@ -5682,7 +5867,8 @@ optsep=
emacs_config_features=
for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
- M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND THREADS TIFF \
+ M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \
+ SOUND THREADS TIFF \
TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
ZLIB; do
@@ -5758,6 +5944,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs support the portable dumper? ${with_pdumper}
Does Emacs support legacy unexec dumping? ${with_unexec}
Which dumping strategy does Emacs use? ${with_dumping}
+ Does Emacs have native lisp compiler? ${HAVE_NATIVE_COMP}
"])
if test -n "${EMACSDATA}"; then
@@ -5860,10 +6047,13 @@ dnl the use of force in the 'epaths-force' rule in Makefile.in.
AC_CONFIG_COMMANDS([src/epaths.h], [
if test "${opsys}" = "mingw32"; then
${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32
+elif test "$HAVE_NS" = "yes" && test "$EN_NS_SELF_CONTAINED" = "yes"; then
+ ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-ns-self-contained
else
${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force
fi || AC_MSG_ERROR(['src/epaths.h' could not be made.])
-], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys"])
+], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys" HAVE_NS="$HAVE_NS"
+ EN_NS_SELF_CONTAINED="$EN_NS_SELF_CONTAINED"])
dnl NB we have to cheat and use the ac_... version because abs_top_srcdir
dnl is not yet set, sigh. Or we could use ../$srcdir/src/.gdbinit,
diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in
index 2a3f53f740d..69d39efa8b9 100644
--- a/doc/emacs/Makefile.in
+++ b/doc/emacs/Makefile.in
@@ -28,6 +28,8 @@ srcdir=@srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
+
version = @version@
## Where the output files go.
@@ -73,13 +75,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = $(AM_V_GEN)TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
@@ -224,7 +220,7 @@ infoclean:
$(buildinfodir)/emacs.info-[1-9][0-9]
bootstrap-clean maintainer-clean: distclean infoclean
- rm -f ${srcdir}/emacsver.texi
+ rm -f ${srcdir}/emacsver.texi TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -273,4 +269,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} --include=../lispref/TAGS --include=../misc/TAGS $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
+
### Makefile ends here
diff --git a/doc/emacs/back.texi b/doc/emacs/back.texi
new file mode 100644
index 00000000000..dc4e218d378
--- /dev/null
+++ b/doc/emacs/back.texi
@@ -0,0 +1,102 @@
+\input texinfo @c -*-texinfo-*-
+@c This is part of the Emacs manual.
+@c Copyright (C) 1985--1987, 1993--1995, 1997, 2001--2021 Free Software
+@c Foundation, Inc.
+@c See file emacs.texi for copying conditions.
+@c
+@c %**start of header
+@setfilename back-cover
+@settitle GNU Emacs Manual
+@include docstyle.texi
+@c %**end of header
+.
+@sp 7
+@center @titlefont {GNU Emacs Manual}
+@sp 1
+
+@quotation
+GNU Emacs is much @strong{more than a text editor;} over the years, it
+has expanded to become @strong{an entire workflow environment,}
+impressing programmers with its integrated debugging and
+project-management features. It is also a multi-lingual word
+processor, can handle all your email and Usenet news needs, display
+web pages, and even has a diary and a calendar for your appointments!
+
+Features include:
+
+@itemize @bullet
+@item
+Special editing modes for @strong{27 programming languages,} including C,
+C@t{++}, Fortran, Java, JavaScript, Lisp, Objective C, Pascal, Perl,
+and Scheme.
+
+@item
+Special @strong{scripting language modes} for Bash, other common shells,
+and creating Makefiles for GNU/Linux, UNIX, Windows/DOS, and VMS
+systems.
+
+@item
+Support for typing and displaying in @strong{60 non-English languages,}
+including Arabic, Chinese, Czech, Hebrew, Hindi, Japanese, Korean,
+Russian, Vietnamese, and all Western European languages.
+
+@item
+The ability to:
+
+@itemize @minus
+@item
+Create @strong{PostScript output} from plain-text files (special
+editing modes for @LaTeX{} and @TeX{} are included).
+
+
+@item
+@strong{Compile} and @strong{debug} from inside Emacs.
+
+@item
+Maintain program @strong{ChangeLogs.}
+
+@item
+Flag, move, and delete files and sub-directories recursively
+@strong{(directory navigation).}
+
+@item
+Run @strong{shell commands} from inside Emacs, or even use Emacs itself
+as a shell (Eshell).
+
+@item
+Enjoy the use of extensive @strong{merge} and @strong{diff} functions.
+
+@item
+Take advantage of built-in support for many @strong{version control
+systems,} including Git, Mercurial, Bazaar, Subversion, and CVS.
+
+@item
+And much more!
+@end itemize
+@end itemize
+
+Emacs comes with an introductory online tutorial available in many
+languages, and this nineteenth edition of the manual picks up where
+that tutorial ends. It explains the full range of the power of Emacs,
+now up to @strong[version 27.2,} and contains reference material
+useful to expert users. It also includes appendices with specific
+material about X and GTK resources, and with details for users of
+macOS and Microsoft Windows.
+
+And when you tire of all the work you can accomplish with Emacs, enjoy
+the games that come with it.
+
+@strong{About the original and principal author:}
+
+Richard M.@: Stallman developed the first Emacs in 1976 and wrote GNU
+Emacs in 1984/85. He has received the ACM Grace Hopper Award, a
+MacArthur Foundation fellowship, the Electronic Frontier Foundation's
+Pioneer award, the Takeda Award for Social/Economic Betterment, and
+the ACM Software and System Award, as well as several doctorates
+@emph{honoris causa.}
+@end quotation
+
+@hfil
+@bye
+
++++++++++++++++++++++++++++++++++++++++++++++++++++++++
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 444b28f24be..ba8d822b18e 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -112,7 +112,7 @@ just like digits. Case is ignored.
@cindex curly quotes, inserting
@cindex curved quotes, inserting
A few common Unicode characters can be inserted via a command
-starting with @kbd{C-x 8}. For example, @kbd{C-x 8 [} inserts @t{‘}
+starting with @w{@kbd{C-x 8}}. For example, @kbd{C-x 8 [} inserts @t{‘}
which is Unicode code-point U+2018 @sc{left single quotation mark},
sometimes called a left single ``curved quote'' or ``curly quote''.
Similarly, @w{@kbd{C-x 8 ]}}, @kbd{C-x 8 @{} and @kbd{C-x 8 @}} insert the
@@ -331,6 +331,11 @@ a plain prefix argument. Alternatively, you can use the command
@code{goto-line-relative} to move point to the line relative to the
accessible portion of the narrowed buffer.
+@code{goto-line} has its own history list (@pxref{Minibuffer
+History}). You can have either a single list shared between all
+buffers (the default) or a separate list for each buffer, by
+customizing the user option @code{goto-line-history-local}.
+
@item M-g @key{TAB}
@kindex M-g TAB
@findex move-to-column
@@ -880,3 +885,17 @@ characters. You can repeat that command (including its argument) three
additional times, to delete a total of 80 characters, by typing @kbd{C-x
z z z}. The first @kbd{C-x z} repeats the command once, and each
subsequent @kbd{z} repeats it once again.
+
+@findex repeat-mode
+ Also you can activate @code{repeat-mode} that temporarily enables
+a transient mode with short keys after a limited number of commands.
+Currently supported shorter key sequences are @kbd{C-x u u} instead of
+@kbd{C-x u C-x u} to undo many changes, @kbd{C-x o o} instead of
+@kbd{C-x o C-x o} to switch several windows, @kbd{C-x @{ @{ @} @} ^ ^
+v v} to resize the selected window interactively, @kbd{M-g n n p p} to
+navigate @code{next-error} matches. Any other key exits transient mode
+and then is executed normally. The user option @code{repeat-exit-key}
+defines an additional key to exit this transient mode. Also it's
+possible to break the repetition chain automatically after idle time
+by customizing the user option @code{repeat-exit-timeout} to a number
+of seconds.
diff --git a/doc/emacs/book-spine.texi b/doc/emacs/book-spine.texi
new file mode 100644
index 00000000000..9634cceedaf
--- /dev/null
+++ b/doc/emacs/book-spine.texi
@@ -0,0 +1,20 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename book-spine
+@settitle book-spine
+@include docstyle.texi
+@c %**end of header
+
+@include emacsver.texi
+
+@c need dot in text so first space command works!
+.
+@sp 7
+
+@center @titlefont{GNU Emacs Manual}
+@sp 5
+@center @value{EDITION} edition, for Emacs version @value{EMACSVER}
+@sp 5
+
+@center by Richard M.@: Stallman et al.
+@bye
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index 3a166e404a8..c4e5bc32b7c 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -586,9 +586,6 @@ every @code{auto-revert-interval} seconds if you enable Auto Revert
mode in this buffer, as long as it is not marked modified. Global
Auto Revert mode applies to the @file{*Buffer List*} buffer only if
@code{global-auto-revert-non-file-buffers} is non-@code{nil}.
-@iftex
-@inforef{Auto Reverting the Buffer Menu,, emacs-xtra}, for details.
-@end iftex
@ifnottex
@xref{Auto Reverting the Buffer Menu, global-auto-revert-non-file-buffers}, for details.
@end ifnottex
@@ -765,6 +762,15 @@ your initialization file (@pxref{Init File}):
the variable @code{fido-mode} to @code{t} (@pxref{Easy
Customization}).
+@findex icomplete-vertical-mode
+@cindex Icomplete vertical mode
+
+ Icomplete mode and Fido mode display the possible completions on the
+same line as the prompt by default. To display the completion candidates
+vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or
+customize the variable @code{icomplete-vertical-mode} to @code{t}
+(@pxref{Easy Customization}).
+
@node Buffer Menus
@subsection Customizing Buffer Menus
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 7194eb90ca9..8de93867baa 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -1486,6 +1486,13 @@ Emacs Lisp code goes in a separate file whose name ends in
@file{foo.elc}. @xref{Byte Compilation,, Byte Compilation, elisp, the
Emacs Lisp Reference Manual}.
+@cindex native compilation
+ Emacs Lisp code can also be compiled into @dfn{native code}: machine
+code not unlike the one produced by a C or Fortran compiler. Native
+code runs even faster than byte-code. Natively-compiled Emacs Lisp
+code is stored in files whose names end in @samp{.eln}. @xref{Native
+Compilation,, Byte Compilation, elisp, the Emacs Lisp Reference Manual}.
+
@findex load-file
To @dfn{load} an Emacs Lisp file, type @kbd{M-x load-file}. This
command reads a file name using the minibuffer, and executes the
diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi
index 82a917ce7d1..f56f820b399 100644
--- a/doc/emacs/commands.texi
+++ b/doc/emacs/commands.texi
@@ -121,7 +121,7 @@ C-k} is two key sequences, not one.
By default, the prefix keys in Emacs are @kbd{C-c}, @kbd{C-h},
@kbd{C-x}, @kbd{C-x @key{RET}}, @kbd{C-x @@}, @kbd{C-x a}, @kbd{C-x
n}, @kbd{C-x r}, @kbd{C-x t}, @kbd{C-x v}, @kbd{C-x 4}, @kbd{C-x 5},
-@kbd{C-x 6}, @key{ESC}, @kbd{M-g}, and @kbd{M-o}. (@key{F1} and
+@kbd{C-x 6}, @key{ESC}, and @kbd{M-g}. (@key{F1} and
@key{F2} are aliases for @kbd{C-h} and @kbd{C-x 6}.) This list is not
cast in stone; if you customize Emacs, you can make new prefix keys.
You could even eliminate some of the standard ones, though this is not
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index ccf5f1932f9..999234e6d33 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -388,15 +388,15 @@ file. For example:
Emacs versions, like this:
@example
-(cond ((< emacs-major-version 22)
- ;; @r{Emacs 21 customization.}
- (setq custom-file "~/.config/custom-21.el"))
- ((and (= emacs-major-version 22)
+(cond ((< emacs-major-version 28)
+ ;; @r{Emacs 27 customization.}
+ (setq custom-file "~/.config/custom-27.el"))
+ ((and (= emacs-major-version 26)
(< emacs-minor-version 3))
- ;; @r{Emacs 22 customization, before version 22.3.}
- (setq custom-file "~/.config/custom-22.el"))
+ ;; @r{Emacs 26 customization, before version 26.3.}
+ (setq custom-file "~/.config/custom-26.el"))
(t
- ;; @r{Emacs version 22.3 or later.}
+ ;; @r{Emacs version 28.1 or later.}
(setq custom-file "~/.config/emacs-custom.el")))
(load custom-file)
@@ -519,12 +519,9 @@ Set up a customization buffer for all the settings and groups that
match @var{regexp}.
@item M-x customize-changed @key{RET} @var{version} @key{RET}
-Set up a customization buffer with all the settings and groups
-whose meaning has changed since Emacs version @var{version}.
-
-@item M-x customize-changed-options @key{RET} @var{version} @key{RET}
-Set up a customization buffer with all the options whose meaning or
-default values have changed since Emacs version @var{version}.
+Set up a customization buffer with all the user options, faces and
+groups whose meaning has changed since (or been added after) Emacs
+version @var{version}.
@item M-x customize-saved
Set up a customization buffer containing all settings that you
@@ -626,7 +623,7 @@ button.
the theme file and asks if you really want to load it. Because
loading a Custom theme can execute arbitrary Lisp code, you should
only say yes if you know that the theme is safe; in that case, Emacs
-offers to remember in the future that the theme is safe (this is done
+offers to remember in the future that the theme is safe(this is done
by saving the theme file's SHA-256 hash to the variable
@code{custom-safe-themes}; if you want to treat all themes as safe,
change its value to @code{t}). Themes that come with Emacs (in the
@@ -1274,7 +1271,13 @@ confirmation prompt. When Emacs encounters these variable/value pairs
subsequently, in the same file or others, it will assume they are
safe.
+ You can also tell Emacs to permanently ignore all the variable/value
+pairs in the file, by typing @kbd{i} at the confirmation prompt --
+these pairs will thereafter be ignored in this file and in all other
+files.
+
@vindex safe-local-variable-values
+@vindex ignored-local-variable-values
@cindex risky variable
Some variables, such as @code{load-path}, are considered
particularly @dfn{risky}: there is seldom any reason to specify them
@@ -1286,6 +1289,8 @@ can enter @kbd{!} at the prompt. It applies all the variables, but only
marks the non-risky ones as safe for the future. If you really want to
record safe values for risky variables, do it directly by customizing
@samp{safe-local-variable-values} (@pxref{Easy Customization}).
+Similarly, if you want to record values of risky variables that should
+be permanently ignored, customize @code{ignored-local-variable-values}.
@vindex enable-local-variables
The variable @code{enable-local-variables} allows you to change the
@@ -1410,6 +1415,16 @@ meanings as they would have in file local variables. @code{coding}
cannot be specified as a directory local variable. @xref{File
Variables}.
+The special key @code{auto-mode-alist} in a @file{.dir-locals.el} lets
+you set a file's major mode. It works much like the variable
+@code{auto-mode-alist} (@pxref{Choosing Modes}). For example, here is
+how you can tell Emacs that @file{.def} source files in this directory
+should be in C mode:
+
+@example
+((auto-mode-alist . (("\\.def\\'" . c-mode))))
+@end example
+
@findex add-dir-local-variable
@findex delete-dir-local-variable
@findex copy-file-locals-to-dir-locals
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 34d12acc349..680b20c5938 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -129,6 +129,12 @@ options (that is, single characters) requiring no arguments, and long
options (starting with @samp{--}) whose arguments are specified with
@samp{=}.
+ Dired does not handle files that have names with embedded newline
+characters well. If you have many such files, you may consider adding
+@samp{-b} to @code{dired-listing-switches}. This will quote all
+special characters and allow Dired to handle them better. (You can
+also use the @kbd{C-u C-x d} command to add @samp{-b} temporarily.)
+
@vindex dired-switches-in-mode-line
Dired displays in the mode line an indication of what were the
switches used to invoke @command{ls}. By default, Dired will try to
@@ -451,6 +457,15 @@ Visit the parent directory of the current directory
for @file{..} and typing @kbd{f} there.
@end table
+@defopt dired-kill-when-opening-new-dired-buffer
+ When visiting a new sub-directory in Dired, Emacs will (by default)
+open a new buffer to display this new directory, and leave the old
+Dired buffer as is. If this user option is non-@code{nil}, the old
+Dired buffer will be killed after selecting the new directory. This
+means that if you're traversing a directory structure in Dired, you
+won't end up with more than a single Dired buffer.
+@end defopt
+
@node Marks vs Flags
@section Dired Marks vs.@: Flags
@@ -856,21 +871,24 @@ Compress the specified files (@code{dired-do-compress}). If the file
appears to be a compressed file already, uncompress it instead. Each
marked file is compressed into its own archive; this uses the
@command{gzip} program if it is available, otherwise it uses
-@command{compress}. On a directory name, this command produces a
-compressed @file{.tar.gz} archive containing all of the directory's
-files, by running the @command{tar} command with output piped to
-@command{gzip}. To allow decompression of compressed directories,
-typing @kbd{Z} on a @file{.tar.gz} or @file{.tgz} archive file unpacks
-all the files in the archive into a directory whose name is the
-archive name with the extension removed.
+@command{compress}.
+
+On a directory name, this command produces a compressed archive
+depending on the @code{dired-compress-directory-default-suffix} user
+option. The default is a @file{.tar.gz} archive containing all of the
+directory's files, by running the @command{tar} command with output
+piped to @command{gzip}. To allow decompression of compressed
+directories, typing @kbd{Z} on a @file{.tar.gz} or @file{.tgz} archive
+file unpacks all the files in the archive into a directory whose name
+is the archive name with the extension removed.
@findex dired-do-compress-to
@kindex c @r{(Dired)}
@item c
Compress the specified files (@code{dired-do-compress-to}) into a
-single archive anywhere on the file system. The compression algorithm
-is determined by the extension of the archive, see
-@code{dired-compress-files-alist}.
+single archive anywhere on the file system. The default archive is
+controlled by the @code{dired-compress-directory-default-suffix} user
+option. Also see @code{dired-compress-files-alist}.
@findex epa-dired-do-decrypt
@kindex :d @r{(Dired)}
@@ -1535,6 +1553,11 @@ image. You comment a file from the thumbnail buffer by typing
@kbd{c}. You will be prompted for a comment. Type @kbd{C-t c} to add
a comment from Dired (@code{image-dired-dired-comment-files}).
+@vindex image-dired-thumb-visible-marks
+ Files that are marked in Dired will also be marked in Image-Dired if
+@code{image-dired-thumb-visible-marks} is non-@code{nil} (which is the
+default).
+
Image-Dired also provides simple image manipulation. In the
thumbnail buffer, type @kbd{L} to rotate the original image 90 degrees
anti clockwise, and @kbd{R} to rotate it 90 degrees clockwise. This
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 58d08b43c0e..ae345c11df5 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1189,8 +1189,8 @@ that has some special meaning for formatting the source code of a
program.
To activate the fill-column indication display, use the minor modes
-@w{@kbd{M-x display-fill-column-indicator-mode}} and
-@w{@kbd{M-x global-display-fill-column-indicator-mode}}, which enable
+@code{display-fill-@-column-indicator-mode} and
+@code{global-display-fill-column-indicator-mode}, which enable
the indicator locally or globally, respectively.
Alternatively, you can set the two buffer-local variables
@@ -1220,8 +1220,8 @@ The value @code{nil} disables the indicator. When the mode is enabled
through the functions @code{display-fill-column-indicator-mode} or
@code{global-display-fill-column-indicator-mode}, they will use the
character specified by this variable, if it is non-@code{nil};
-otherwise Emacs will use the character @samp{U+2502 VERTICAL LINE},
-falling back to @samp{|} if @code{U+2502} cannot be displayed.
+otherwise Emacs will use the character U+2502 @sc{box drawings light vertical},
+falling back to @samp{|} if U+2502 cannot be displayed.
@item fill-column-indicator
@vindex fill-column-indicator
@@ -1577,8 +1577,8 @@ characters, as well as many non-@acronym{ASCII} characters.
@cindex control characters on display
The @acronym{ASCII} character set contains non-printing @dfn{control
characters}. Two of these are displayed specially: the newline
-character (Unicode code point @code{U+000A}) is displayed by starting
-a new line, while the tab character (@code{U+0009}) is displayed as a
+character (Unicode code point U+000A) is displayed by starting
+a new line, while the tab character (U+0009) is displayed as a
space that extends to the next tab stop column (normally every 8
columns). The number of spaces per tab is controlled by the
buffer-local variable @code{tab-width}, which must have an integer
@@ -1587,17 +1587,17 @@ character in the buffer is displayed has nothing to do with the
definition of @key{TAB} as a command.
Other @acronym{ASCII} control characters, whose codes are below
-@code{U+0020} (octal 40, decimal 32), are displayed as a caret
+U+0020 (octal 40, decimal 32), are displayed as a caret
(@samp{^}) followed by the non-control version of the character, with
the @code{escape-glyph} face. For instance, the @samp{control-A}
-character, @code{U+0001}, is displayed as @samp{^A}.
+character, U+0001, is displayed as @samp{^A}.
@cindex octal escapes
@vindex ctl-arrow
- The raw bytes with codes @code{U+0080} (octal 200) through
-@code{U+009F} (octal 237) are displayed as @dfn{octal escape
+ The raw bytes with codes U+0080 (octal 200) through
+U+009F (octal 237) are displayed as @dfn{octal escape
sequences}, with the @code{escape-glyph} face. For instance,
-character code @code{U+0098} (octal 230) is displayed as @samp{\230}.
+character code U+0098 (octal 230) is displayed as @samp{\230}.
If you change the buffer-local variable @code{ctl-arrow} to
@code{nil}, the @acronym{ASCII} control characters are also displayed
as octal escape sequences instead of caret escape sequences. (You can
@@ -1616,11 +1616,11 @@ can cause problems if they are entered into a buffer without your
realization, e.g., by yanking; for instance, source code compilers
typically do not treat non-@acronym{ASCII} spaces as whitespace
characters. To deal with this problem, Emacs displays such characters
-specially: it displays @code{U+00A0} (no-break space) and other
+specially: it displays U+00A0 @sc{no-break space} and other
characters from the Unicode horizontal space class with the
-@code{nobreak-space} face, and it displays @code{U+00AD} (soft
-hyphen), @code{U+2010} (hyphen), and @code{U+2011} (non-breaking
-hyphen) with the @code{nobreak-hyphen} face. To disable this, change
+@code{nobreak-space} face, and it displays U+00AD @sc{soft
+hyphen}, U+2010 @sc{hyphen}, and U+2011 @sc{non-breaking
+hyphen} with the @code{nobreak-hyphen} face. To disable this, change
the variable @code{nobreak-char-display} to @code{nil}. If you give
this variable a non-@code{nil} and non-@code{t} value, Emacs instead
displays such characters as a highlighted backslash followed by a
@@ -1649,10 +1649,10 @@ for details.
@cindex curved quotes, and terminal capabilities
@cindex @code{homoglyph} face
-Emacs tries to determine if the curved quotes @samp{‘} and @samp{’}
+Emacs tries to determine if the curved quotes @t{‘} and @t{’}
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
+be so, then Emacs will translate the @acronym{ASCII} quotes @w{(@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}).
@@ -1661,7 +1661,7 @@ Documentation,,, elisp, The Emacs Lisp Reference Manual}).
known to look just like @acronym{ASCII} characters, they are shown
with the @code{homoglyph} face. Curved quotes that are known not to
be displayable are shown as their @acronym{ASCII} approximations
-@t{`}, @t{'}, and @t{"} with the @code{homoglyph} face.
+@samp{`}, @samp{'}, and @samp{"} with the @code{homoglyph} face.
@node Cursor Display
@section Displaying the Cursor
@@ -1829,15 +1829,15 @@ variable @code{visual-line-fringe-indicators}.
That produces incorrect results when CJK and Latin text are mixed
together (because CJK characters don't use whitespace to separate
words). You can customize the option @code{word-wrap-by-category} to
-allow Emacs to break lines after any character with ``|'' category
+allow Emacs to break lines after any character with @samp{|} category
(@pxref{Categories,,, elisp, the Emacs Lisp Reference Manual}), which
provides better support for CJK characters. Also, if this variable is
set using Customize, Emacs automatically loads @file{kinsoku.el}.
When @file{kinsoku.el} is loaded, Emacs respects kinsoku rules when
-breaking lines. That means characters with the ``>'' category don't
-appear at the beginning of a line (e.g., U+FF0C FULLWIDTH COMMA), and
-characters with the ``<'' category don't appear at the end of a line
-(e.g., U+300A LEFT DOUBLE ANGLE BRACKET). You can view the category
+breaking lines. That means characters with the @samp{>} category don't
+appear at the beginning of a line (e.g., U+FF0C @sc{fullwidth comma}), and
+characters with the @samp{<} category don't appear at the end of a line
+(e.g., U+300A @sc{left double angle bracket}). You can view the category
set of a character using the commands @code{char-category-set} and
@code{category-set-mnemonics}, or by typing @kbd{C-u C-x =} with point
on the character and looking at the ``category'' section in the
diff --git a/doc/emacs/docstyle.texi b/doc/emacs/docstyle.texi
index 5bdcd079d91..e7404398d24 100644
--- a/doc/emacs/docstyle.texi
+++ b/doc/emacs/docstyle.texi
@@ -15,4 +15,5 @@
@hyphenation{work-a-round}
@hyphenation{work-a-rounds}
@hyphenation{un-marked}
+@hyphenation{dic-tion-ary}
@end iftex
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 4054b094def..d2011ebf974 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -92,13 +92,14 @@ developing GNU and promoting software freedom.''
Published by the Free Software Foundation @*
51 Franklin Street, Fifth Floor @*
Boston, MA 02110-1301 USA @*
-ISBN 978-0-9831592-5-4
+ISBN 978-0-9831592-8-5
@sp 2
-Cover art by Etienne Suvasa; cover design by Matt Lee.
+Cover art by Etienne Suvasa; cover design by FSF staff.
@end titlepage
+@headings double
@summarycontents
@contents
@@ -159,7 +160,7 @@ Fundamental Editing Commands
Important Text-Changing Commands
* Mark:: The mark: how to delimit a region of text.
-* Killing:: Killing (cutting) and yanking (copying) text.
+* Killing:: Killing (cutting) and yanking (pasting) text.
* Registers:: Saving a text string or a location in the buffer.
* Display:: Controlling what text is displayed.
* Search:: Finding or replacing occurrences of a string.
@@ -794,6 +795,8 @@ Maintaining Large Programs
@ifnottex
* Emerge:: A convenient way of merging two versions of a program.
@end ifnottex
+* Bug Reference:: Highlighting references to bug reports and browsing
+ them in their issue trackers.
Version Control
@@ -861,6 +864,7 @@ Projects
* Project File Commands:: Commands for handling project files.
* Project Buffer Commands:: Commands for handling project buffers.
* Switching Projects:: Switching between projects.
+* Managing Projects:: Managing the project list file.
Change Logs
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 6b3bc430d97..8304e40706a 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -227,6 +227,15 @@ File Names}, for information on how to visit a file whose name
actually contains wildcard characters. You can disable the wildcard
feature by customizing @code{find-file-wildcards}.
+@vindex query-about-changed-file
+ If you're asking to visit a file that's already visited in a buffer,
+but the file has changed externally, Emacs normally asks you whether
+you want to re-read the file from disk. But if you set
+@code{query-about-changed-file} to @code{nil}, Emacs won't query you,
+but will instead just display the buffer's contents before the
+changes, and show an echo-area message telling you how to revert the
+buffer from the file.
+
@kindex C-x C-v
@findex find-alternate-file
If you visit the wrong file unintentionally by typing its name
@@ -789,7 +798,9 @@ Emacs buffer visiting it has unsaved changes.
@vindex create-lockfiles
You can prevent the creation of lock files by setting the variable
@code{create-lockfiles} to @code{nil}. @strong{Caution:} by
-doing so you will lose the benefits that this feature provides.
+doing so you will lose the benefits that this feature provides. You
+can also control where lock files are written by using the
+@code{lock-file-name-transforms} variable.
@cindex collision
If you begin to modify the buffer while the visited file is locked by
@@ -834,6 +845,14 @@ warning message and asks for confirmation before saving; answer
place, one way to compare the buffer to its file is the @kbd{M-x
diff-buffer-with-file} command. @xref{Comparing Files}.
+@vindex remote-file-name-inhibit-locks
+ You can prevent the creation of remote lock files by setting the
+variable @code{remote-file-name-inhibit-locks} to @code{t}.
+
+@cindex lock-file-mode
+ The minor mode @code{lock-file-mode}, called interactively, toggles
+the local value of @code{create-lockfiles} in the current buffer.
+
@node File Shadowing
@subsection Shadowing Files
@cindex shadow files
@@ -929,7 +948,7 @@ Manual}). For customizations, see the Custom group @code{time-stamp}.
then change your mind, you can @dfn{revert} the changes and go back to
the saved version of the file. To do this, type @kbd{C-x x g}. Since
reverting unintentionally could lose a lot of work, Emacs asks for
-confirmation first.
+confirmation first if the buffer is modified.
The @code{revert-buffer} command tries to position point in such a
way that, if the file was edited only slightly, you will be at
@@ -972,6 +991,17 @@ revert it automatically if it has changed---provided the buffer itself
is not modified. (If you have edited the text, it would be wrong to
discard your changes.)
+@vindex revert-buffer-quick-short-answers
+@findex revert-buffer-quick
+ The @kbd{C-x x g} keystroke is bound to the
+@code{revert-buffer-quick} command. This is like the
+@code{revert-buffer} command, but prompts less. Unlike
+@code{revert-buffer}, it will not prompt if the current buffer visits
+a file, and the buffer is not modified. It also respects the
+@code{revert-buffer-quick-short-answers} user option. If this option
+is non-@code{nil}, use a shorter @kbd{y/n} query instead of a longer
+@kbd{yes/no} query.
+
You can also tell Emacs to revert buffers automatically when their
visited files change on disk; @pxref{Auto Revert}.
@@ -1670,8 +1700,9 @@ modify the original (``old'') source files rather than the patched
(``new'') source files.
@vindex diff-font-lock-syntax
- If non-@code{nil}, fragments of source in hunks are highlighted
-according to the appropriate major mode.
+ If @code{diff-font-lock-syntax} is non-@code{nil}, fragments of
+source in hunks are highlighted according to the appropriate major
+mode.
@node Copying and Naming
@section Copying, Naming and Renaming Files
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 6b41849ccc8..b558ebc3fdc 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -263,6 +263,13 @@ systems.
@xref{Top, Aspell,, aspell, The Aspell Manual}.
@end ifnottex
+@vindex ispell-program-name
+ If you have only one of the spelling checker programs installed,
+Emacs will find it when you invoke for the first time one of the
+commands described here. If you have more than one of them installed,
+you can control which one is used by customizing the variable
+@code{ispell-program-name}.
+
@table @kbd
@item M-$
Check and correct spelling of the word at point (@code{ispell-word}).
@@ -365,7 +372,7 @@ Like @kbd{i}, but you can also specify dictionary completion
information.
@item u
-Insert the lower-case version of this word in your private dic@-tion@-ary
+Insert the lower-case version of this word in your private dictionary
file.
@item l @var{word} @key{RET}
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index e1a4e64a7d4..5b15e6290d0 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -366,20 +366,15 @@ This menu is for changing the default face within the window's buffer.
@xref{Text Scale}.
@end table
+@cindex context menu
+@findex context-menu-mode
+@vindex context-menu-functions
+@kindex Down-mouse-3
Some graphical applications use @kbd{mouse-3} for a mode-specific
-menu. If you prefer @kbd{mouse-3} in Emacs to bring up such a menu
-instead of running the @code{mouse-save-then-kill} command, rebind
-@kbd{mouse-3} by adding the following line to your init file
-(@pxref{Init Rebinding}):
-
-@smallexample
-(global-set-key [mouse-3]
- '(menu-item "Menu Bar" ignore
- :filter (lambda (_)
- (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
- (mouse-menu-bar-map)
- (mouse-menu-major-mode-map)))))
-@end smallexample
+menu. If you prefer @kbd{mouse-3} in Emacs to bring up such a context
+menu instead of running the @code{mouse-save-then-kill} command,
+enable @code{context-menu-mode} and customize the variable
+@code{context-menu-functions}.
@node Mode Line Mouse
@section Mode Line Mouse Commands
@@ -480,9 +475,10 @@ frame. This runs @code{find-file-read-only-other-frame}.
@xref{Visiting}.
@item C-x 5 5
-A more general prefix command affects the buffer displayed by the next
-command invoked immediately after this prefix command. It requests
-the buffer of the next command to be displayed in another frame.
+A more general prefix command that affects the buffer displayed by the
+next command invoked immediately after this prefix command
+(@code{other-frame-prefix}). It requests the buffer of the next
+command to be displayed in another frame.
@end table
You can control the appearance and behavior of the newly-created
@@ -614,7 +610,10 @@ 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 support for
-Gsettings (or the older Gconf).
+Gsettings (or the older Gconf). (To be specific, the Gsettings
+configuration names used are
+@samp{org.gnome.desktop.interface monospace-font-name} and
+@samp{org.gnome.desktop.interface font-name}.)
@item
Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font
@@ -1214,7 +1213,9 @@ the use of menu bars at startup, customize the variable
terminals, where this makes one additional line available for text.
If the menu bar is off, you can still pop up a menu of its contents
with @kbd{C-mouse-3} on a display which supports pop-up menus.
-@xref{Menu Mouse Clicks}.
+Or you can enable @code{context-menu-mode} and customize the variable
+@code{context-menu-functions} to pop up a context menu with
+@kbd{mouse-3}. @xref{Menu Mouse Clicks}.
@xref{Menu Bar}, for information on how to invoke commands with the
menu bar. @xref{X Resources}, for how to customize the menu bar
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 81cdeb4be54..0caab681d34 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -107,8 +107,8 @@ Display the @file{*Messages*} buffer
(@code{view-echo-area-messages}). @xref{Misc Help}.
@item C-h f @var{function} @key{RET}
Display documentation on the Lisp function named @var{function}
-(@code{describe-function}). Since commands are Lisp functions,
-this works for commands too. @xref{Name Help}.
+(@code{describe-function}). Since commands are Lisp functions, this
+works for commands too, but you can also use @code{C-h x}. @xref{Name Help}.
@item C-h h
Display the @file{HELLO} file, which shows examples of various character
sets.
@@ -154,6 +154,9 @@ Display the documentation of the Lisp variable @var{var}
@item C-h w @var{command} @key{RET}
Show which keys run the command named @var{command} (@code{where-is}).
@xref{Key Help}.
+@item C-h x @var{command} @key{RET}
+Display documentation on the named @var{command}
+(@code{describe-command}). @xref{Name Help}.
@item C-h C @var{coding} @key{RET}
Describe the coding system @var{coding}
(@code{describe-coding-system}). @xref{Coding Systems}.
@@ -233,31 +236,31 @@ the button.
@node Name Help
@section Help by Command or Variable Name
-@kindex C-h f
-@findex describe-function
- @kbd{C-h f @var{function} @key{RET}} (@code{describe-function})
-displays the documentation of Lisp function @var{function}, in a
-window. Since commands are Lisp functions, you can use this method to
-view the documentation of any command whose name you know. For
-example,
+@kindex C-h x
+@findex describe-command
+ @kbd{C-h x @var{command} @key{RET}} (@code{describe-command})
+displays the documentation of the named @var{command}, in a
+window. For example,
@example
-C-h f auto-fill-mode @key{RET}
+C-h x auto-fill-mode @key{RET}
@end example
@noindent
-displays the documentation of @code{auto-fill-mode}. This is the only
-way to get the documentation of a command that is not bound to any key
+displays the documentation of @code{auto-fill-mode}. This is how you
+would get the documentation of a command that is not bound to any key
(one which you would normally run using @kbd{M-x}).
- @kbd{C-h f} is also useful for Lisp functions that you use in a Lisp
-program. For example, if you have just written the expression
+@kindex C-h f
+@findex describe-function
+ @kbd{C-h f @var{function} @key{RET}} (@code{describe-function})
+displays the documentation of Lisp @var{function}. This command is
+intended for Lisp functions that you use in a Lisp program. For
+example, if you have just written the expression
@code{(make-vector len)} and want to check that you are using
-@code{make-vector} properly, type @kbd{C-h f make-vector @key{RET}}.
-Because @kbd{C-h f} allows all function names, not just command names,
-you may find that some of your favorite completion abbreviations that
-work in @kbd{M-x} don't work in @kbd{C-h f}. An abbreviation that is
-unique among command names may not be unique among all function names.
+@code{make-vector} properly, type @w{@kbd{C-h f make-vector @key{RET}}}.
+Additionally, since all commands are Lisp functions, you can also use
+this command to view the documentation of any command.
If you type @kbd{C-h f @key{RET}}, it describes the function called
by the innermost Lisp expression in the buffer around point,
@@ -265,7 +268,7 @@ by the innermost Lisp expression in the buffer around point,
(That name appears as the default while you enter the argument.) For
example, if point is located following the text @samp{(make-vector
(car x)}, the innermost list containing point is the one that starts
-with @samp{(make-vector}, so @kbd{C-h f @key{RET}} describes the
+with @samp{(make-vector}, so @w{@kbd{C-h f @key{RET}}} describes the
function @code{make-vector}.
@kbd{C-h f} is also useful just to verify that you spelled a
@@ -448,6 +451,13 @@ Go forward to the next help topic (@code{help-go-forward}).
@item C-c C-b
@itemx l
Go back to the previous help topic (@code{help-go-back}).
+@item s
+View the source of the current help topic (if any)
+(@code{help-view-source}).
+@item i
+Look up the current topic in the manual(s) (@code{help-goto-info}).
+@item c
+Customize the variable or the face (@code{help-customize}).
@end table
@cindex hyperlink
@@ -619,13 +629,14 @@ Emacs Lisp Reference Manual}).
@findex describe-prefix-bindings
You can get a list of subcommands for a particular prefix key by
-typing @kbd{C-h}, @kbd{?}, or @key{F1}
+typing @kbd{C-h}, @kbd{?}, or @key{f1}
(@code{describe-prefix-bindings}) after the prefix key. (There are a
few prefix keys for which not all of these keys work---those that
provide their own bindings for that key. One of these prefix keys
-is @key{ESC}, because @kbd{@key{ESC} C-h} is actually @kbd{C-M-h},
-which marks a defun. However, @w{@kbd{@key{ESC} @key{F1}}} and
-@w{@kbd{@key{ESC} ?}} work fine.)
+is @key{ESC}, because @kbd{@key{ESC} C-h} and @kbd{@key{ESC} ?} are
+actually @kbd{C-M-h} (@code{mark-defun}) and @kbd{M-?}
+(@code{xref-find-references}), respectively. However,
+@w{@kbd{@key{ESC} @key{f1}}} works fine.)
@findex describe-keymap
Finally, @kbd{M-x describe-keymap} prompts for the name of a keymap,
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 8434040bcea..6e4fd77e8b9 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -269,6 +269,21 @@ happens. But if you set the variable @code{kill-read-only-ok} to a
non-@code{nil} value, they just print a message in the echo area to
explain why the text has not been erased.
+@vindex kill-transform-function
+ Before saving the kill to the kill ring, you can transform the
+string using @code{kill-transform-function}. It's called with the
+string to be killed, and it should return the string you want to be
+saved. It can also return @code{nil}, in which case the string won't
+be saved to the kill ring. For instance, if you never want to save
+a pure white space string to the kill ring, you can say:
+
+@lisp
+(setq kill-transform-function
+ (lambda (string)
+ (and (not (string-blank-p string))
+ string)))
+@end lisp
+
@vindex kill-do-not-save-duplicates
If you change the variable @code{kill-do-not-save-duplicates} to a
non-@code{nil} value, identical subsequent kills yield a single
@@ -289,8 +304,9 @@ way to move or copy text is to kill it and then yank it elsewhere.
@item C-y
Yank the last kill into the buffer, at point (@code{yank}).
@item M-y
-Replace the text just yanked with an earlier batch of killed text
-(@code{yank-pop}). @xref{Earlier Kills}.
+Either replace the text just yanked with an earlier batch of killed
+text (@code{yank-pop}), or allow to select from the list of
+previously-killed batches of text. @xref{Earlier Kills}.
@item C-M-w
Cause the following command, if it is a kill command, to append to the
previous kill (@code{append-next-kill}). @xref{Appending Kills}.
@@ -310,13 +326,13 @@ the end. Using any other prefix argument specifies an earlier kill;
e.g., @kbd{C-u 4 C-y} reinserts the fourth most recent kill.
@xref{Earlier Kills}.
- On graphical displays, @kbd{C-y} first checks if another application
-has placed any text in the system clipboard more recently than the
-last Emacs kill. If so, it inserts the clipboard's text instead.
-Thus, Emacs effectively treats ``cut'' or ``copy'' clipboard
-operations performed in other applications like Emacs kills, except
-that they are not recorded in the kill ring. @xref{Cut and Paste},
-for details.
+ On graphical displays and on capable text-mode displays, @kbd{C-y}
+first checks if another application has placed any text in the system
+clipboard more recently than the last Emacs kill. If so, it inserts
+the clipboard's text instead. Thus, Emacs effectively treats ``cut''
+or ``copy'' clipboard operations performed in other applications like
+Emacs kills, except that they are not recorded in the kill ring.
+@xref{Cut and Paste}, for details.
@menu
* Kill Ring:: Where killed text is stored.
@@ -354,7 +370,7 @@ with @kbd{C-h v kill-ring}.
@kbd{C-y} to yank text that is no longer the most recent kill. This
is useful if you remember which kill ring entry you want. If you
don't, you can use the @kbd{M-y} (@code{yank-pop}) command to cycle
-through the possibilities.
+through the possibilities or to select one of the earlier kills.
@kindex M-y
@findex yank-pop
@@ -363,45 +379,64 @@ that was yanked and replaces it with the text from an earlier kill.
So, to recover the text of the next-to-the-last kill, first use
@kbd{C-y} to yank the last kill, and then use @kbd{M-y} to replace it
with the previous kill. This works only after a @kbd{C-y}
-or another @kbd{M-y}.
-
- You can understand @kbd{M-y} in terms of a last-yank pointer which
-points at an entry in the kill ring. Each time you kill, the last-yank
-pointer moves to the newly made entry at the front of the ring.
-@kbd{C-y} yanks the entry which the last-yank pointer points to.
-@kbd{M-y} moves the last-yank pointer to a different entry, and the
-text in the buffer changes to match. Enough @kbd{M-y} commands can move
-the pointer to any entry in the ring, so you can get any entry into the
-buffer. Eventually the pointer reaches the end of the ring; the next
-@kbd{M-y} loops back around to the first entry again.
+or another @kbd{M-y}. (If @kbd{M-y} is invoked after some other
+command, it works differently, see below.)
+
+ You can understand this operation mode of @kbd{M-y} in terms of a
+last-yank pointer which points at an entry in the kill ring. Each
+time you kill, the last-yank pointer moves to the newly made entry at
+the front of the ring. @kbd{C-y} yanks the entry which the last-yank
+pointer points to. @kbd{M-y} after a @kbd{C-y} or another @kbd{M-y}
+moves the last-yank pointer to the previous entry, and the text in the
+buffer changes to match. Enough @kbd{M-y} commands one after another
+can move the pointer to any entry in the ring, so you can get any
+entry into the buffer. Eventually the pointer reaches the end of the
+ring; the next @kbd{M-y} loops back around to the first entry again.
@kbd{M-y} moves the last-yank pointer around the ring, but it does
not change the order of the entries in the ring, which always runs from
the most recent kill at the front to the oldest one still remembered.
- @kbd{M-y} can take a numeric argument, which tells it how many entries
-to advance the last-yank pointer by. A negative argument moves the
-pointer toward the front of the ring; from the front of the ring, it
-moves around to the last entry and continues forward from there.
+ When used after @kbd{C-y} or @kbd{M-y}, @kbd{M-y} can take a numeric
+argument, which tells it how many entries to advance the last-yank
+pointer by. A negative argument moves the pointer toward the front of
+the ring; from the front of the ring, it moves around to the last
+entry and continues forward from there.
- Once the text you are looking for is brought into the buffer, you can
-stop doing @kbd{M-y} commands and it will stay there. It's just a copy
-of the kill ring entry, so editing it in the buffer does not change
-what's in the ring. As long as no new killing is done, the last-yank
-pointer remains at the same place in the kill ring, so repeating
-@kbd{C-y} will yank another copy of the same previous kill.
+ Once the text you are looking for is brought into the buffer, you
+can stop doing @kbd{M-y} commands and the last yanked text will stay
+there. It's just a copy of the kill ring entry, so editing it in the
+buffer does not change what's in the ring. As long as no new killing
+is done, the last-yank pointer remains at the same place in the kill
+ring, so repeating @kbd{C-y} will yank another copy of the same
+previous kill.
When you call @kbd{C-y} with a numeric argument, that also sets the
last-yank pointer to the entry that it yanks.
- Alternatively, when the previous command was not a yank command,
-@kbd{M-y} activates the minibuffer where you can browse previous kills
-using the minibuffer history commands (@pxref{Minibuffer History}), or
-you can use completion commands (@pxref{Completion}) on a list of
-previously killed blocks of text from the kill ring. Exiting the
-minibuffer will insert the selected text to the buffer. With a plain
-prefix argument (@kbd{C-u M-y}), this command leaves the cursor in
-front of the inserted text, and sets the mark at the end.
+ You can also invoke @kbd{M-y} after a command that is not a yank
+command. In that case, @kbd{M-y} prompts you in the minibuffer for
+one of the previous kills. You can use the minibuffer history
+commands (@pxref{Minibuffer History}) to navigate or search through
+the entries in the kill ring until you find the one you want to
+reinsert. Or you can use completion commands (@pxref{Completion
+Commands}) to complete on an entry from the list of entries in the
+kill ring or pop up the @file{*Completions*} buffer with the candidate
+entries from which you can choose. After selecting the kill-ring
+entry, you can optionally edit it in the minibuffer. Finally, type
+@kbd{RET} to exit the minibuffer and insert the text of the selected
+kill-ring entry. Like in case of @kbd{M-y} after another yank
+command, the last-yank pointer is left pointing at the text you just
+yanked, whether it is one of the previous kills or an entry from the
+kill-ring that you edited before inserting it. (In the latter case,
+the edited entry is added to the front of the kill-ring.) So here,
+too, typing @kbd{C-y} will yank another copy of the text just
+inserted.
+
+ When invoked with a plain prefix argument (@kbd{C-u M-y}) after a
+command that is not a yank command, @kbd{M-y} leaves the cursor in
+front of the inserted text, and sets the mark at the end, like
+@kbd{C-y} does.
@node Appending Kills
@subsection Appending Kills
@@ -502,11 +537,14 @@ clipboard.
@vindex save-interprogram-paste-before-kill
When an Emacs kill command puts text in the clipboard, the existing
-clipboard contents are normally lost. Optionally, you can change
-@code{save-interprogram-paste-before-kill} to @code{t}. Then Emacs
-will first save the clipboard to its kill ring, preventing you from
-losing the old clipboard data---at the risk of high memory consumption
-if that data turns out to be large.
+clipboard contents are normally lost. Optionally, Emacs can save the
+existing clipboard contents to the kill ring, preventing you from
+losing the old clipboard data. If
+@code{save-interprogram-paste-before-kill} changed to a number, then
+this data is copied over if it's smaller (in characters) than this
+number. If this variable is any other non-@code{nil} value, it's
+always copied over---at the risk of high memory consumption if that
+data turns out to be large.
Yank commands, such as @kbd{C-y} (@code{yank}), also use the
clipboard. If another application ``owns'' the clipboard---i.e., if
diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi
index 865220fb218..d35a8351541 100644
--- a/doc/emacs/m-x.texi
+++ b/doc/emacs/m-x.texi
@@ -46,9 +46,25 @@ from running the command by name.
@cindex obsolete command
When @kbd{M-x} completes on commands, it ignores the commands that
are declared @dfn{obsolete}; for these, you will have to type their
-full name. Obsolete commands are those for which newer, better
+full name. (Obsolete commands are those for which newer, better
alternatives exist, and which are slated for removal in some future
-Emacs release.
+Emacs release.)
+
+@vindex read-extended-command-predicate
+ In addition, @kbd{M-x} completion can exclude commands that are not
+relevant to, and generally cannot work with, the current buffer's
+major mode (@pxref{Major Modes}) and minor modes (@pxref{Minor
+Modes}). By default, no commands are excluded, but you can customize
+the option @code{read-extended-command-predicate} to exclude those
+irrelevant commands from completion results.
+
+@kindex M-S-x
+ Conversely, Emacs can exclude all commands except those that are
+particularly relevant to the current buffer. The @kbd{M-S-x} (that's
+``meta shift x'') command works just like @kbd{M-x}, but instead of
+listing all (or most) of the commands Emacs knows about, it will only
+list the commands that have been marked as ``belonging'' to the
+current major mode, or any enabled minor modes.
To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead
of entering the command name. This takes you back to command level.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index bc276c49046..3205e6dbdf7 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -32,6 +32,10 @@ symbols (a.k.a.@: ``identifiers'') and their references.
A mode for merging changes to program sources made on separate
branches of development.
@end ifnottex
+
+@item
+A minor-mode for highlighting bug references and visiting the
+referenced bug reports in their issue tracker.
@end itemize
If you are maintaining a large Lisp program, then in addition to the
@@ -49,6 +53,8 @@ Lisp Regression Testing}).
@ifnottex
* Emerge:: A convenient way of merging two versions of a program.
@end ifnottex
+* Bug Reference:: Highlighting references to bug reports and browsing
+ them in their issue trackers.
@end menu
@node Version Control
@@ -1611,6 +1617,10 @@ branch ID for a branch starting at the current revision. For example,
if the current revision is 2.5, the branch ID should be 2.5.1, 2.5.2,
and so on, depending on the number of existing branches at that point.
+ This procedure will not work for distributed version control systems
+like git or Mercurial. For those systems you should use the prefix
+argument to @code{vc-create-tag} (@kbd{C-u C-x v s}) instead.
+
To create a new branch at an older revision (one that is no longer
the head of a branch), first select that revision (@pxref{Switching
Branches}). Your procedure will then differ depending on whether you
@@ -1660,6 +1670,7 @@ the project back-end. For example, the VC back-end doesn't consider
* Project File Commands:: Commands for handling project files.
* Project Buffer Commands:: Commands for handling project buffers.
* Switching Projects:: Switching between projects.
+* Managing Projects:: Managing the project list file.
@end menu
@node Project File Commands
@@ -1839,6 +1850,21 @@ in the menu, and which key invokes each command.
records the list of known projects. It defaults to the file
@file{projects} in @code{user-emacs-directory} (@pxref{Find Init}).
+@node Managing Projects
+@subsection Managing the Project List File
+
+@table @kbd
+@item M-x project-remove-known-project
+Remove a known project from the @code{project-list-file}.
+@end table
+
+@findex project-remove-known-project
+ Normally Emacs automatically adds and removes projects to and from the
+@code{project-list-file}, but sometimes you may want to manually edit
+the available projects. @kbd{M-x project-remove-known-project}
+prompts you to choose one of the available projects, and then removes
+it from the file.
+
@node Change Log
@section Change Logs
@@ -2193,7 +2219,8 @@ the special XREF mode:
@table @kbd
@item @key{RET}
@itemx mouse-2
-Display the reference on the current line.
+Display the reference on the current line (@code{xref-goto-xref}).
+With prefix argument, also bury the @file{*xref*} buffer.
@item n
@itemx .
@@ -2222,11 +2249,6 @@ display it in the other window (@code{xref-prev-group}).
Display the reference on the current line in the other window
(@code{xref-show-location-at-point}).
-@item @key{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}).
-
@item r @var{pattern} @key{RET} @var{replacement} @key{RET}
Perform interactive query-replace on references that match
@var{pattern} (@code{xref-query-replace-in-results}), replacing
@@ -2641,6 +2663,10 @@ generate a tag.
@item
In Ruby code, @code{def} or @code{class} or @code{module} at the
beginning of a line generate a tag. Constants also generate tags.
+
+@item
+In Rust code, tags anything defined with @code{fn}, @code{enum},
+@code{struct} or @code{macro_rules!}.
@end itemize
You can also generate tags based on regexp matching (@pxref{Etags
@@ -3033,3 +3059,172 @@ the target should be built.
@ifnottex
@include emerge-xtra.texi
@end ifnottex
+
+
+@node Bug Reference
+@section Bug Reference
+@cindex bug reference
+
+Most projects with a certain amount of users track bug reports in some
+issue tracking software which assigns each report a unique and short
+number or identifier. Those are used to reference a given bug, e.g.,
+in a source code comment above the code fixing some bug, in
+documentation files, or in discussions on some mailinglist or IRC
+channel.
+
+@findex bug-reference-mode
+@findex bug-reference-prog-mode
+ The minor modes @code{bug-reference-mode} and
+@code{bug-reference-prog-mode} highlight such bug references and make
+it possible to follow them to the corresponding bug report on the
+project's issue tracker. @code{bug-reference-prog-mode} is a variant
+of @code{bug-reference-mode} which highlights bug references only
+inside source code comments and strings.
+
+@vindex bug-reference-bug-regexp
+@vindex bug-reference-url-format
+ For its working, bug reference mode needs to know the syntax of bug
+references (@code{bug-reference-bug-regexp}), and the URL of the
+tracker where bug reports can be looked up
+(@code{bug-reference-url-format}). Since those are typically
+different from project to project, it makes sense to specify them in
+@pxref{Directory Variables} or @pxref{File Variables}.
+
+For example, let's assume in our project, we usually write references
+to bug reports as bug#1234, or Bug-1234 and that this bug's page on
+the issue tracker is @url{https://project.org/issues/1234}, then
+these local variables section would do.
+
+@smallexample
+;; Local Variables:
+;; bug-reference-bug-regexp: "\\([Bb]ug[#-]\\)\\([0-9]+\\)"
+;; bug-reference-url-format: "https://project.org/issues/%s"
+;; End:
+@end smallexample
+
+The string captured by the second regexp group in
+@code{bug-reference-bug-regexp} is used to replace the @code{%s}
+template in the @code{bug-reference-url-format}.
+
+Note that @code{bug-reference-url-format} may also be a function in
+order to cater for more complex scenarios, e.g., when the part before
+the actual bug number has to be used to distinguish between issues and
+merge requests where each of them has a different URL.
+
+
+@heading Automatic Setup
+
+@vindex bug-reference-auto-setup-functions
+If @code{bug-reference-mode} is activated,
+@code{bug-reference-mode-hook} has been run and still
+@code{bug-reference-bug-regexp}, and @code{bug-reference-url-format}
+aren't both set, it'll try to setup suitable values for these two
+variables itself by calling the functions in
+@code{bug-reference-auto-setup-functions} one after the other until
+one is able to set the variables.
+
+@vindex bug-reference-setup-from-vc-alist
+@vindex bug-reference-setup-from-mail-alist
+@vindex bug-reference-setup-from-irc-alist
+ Right now, there are three types of setup functions.
+@enumerate
+@item
+Setup for version-controlled files configurable by the variable
+@code{bug-reference-setup-from-vc-alist}. The default is able to
+setup GNU projects where @url{https://debbugs.gnu.org} is used as
+issue tracker and issues are usually referenced as @code{bug#13} (but
+many different notations are considered, too), Sourcehut projects
+where issues are referenced using the notation @code{#17}, Codeberg
+and Github projects where both bugs and pull requests are referenced
+using the same notation, and GitLab projects where bugs are referenced
+with @code{#17}, too, but merge requests use the @code{!18} notation.
+
+@item
+Setup for email guessing from mail folder/mbox names, and mail header
+values configurable by the variable
+@code{bug-reference-setup-from-mail-alist}. The built-in news- and
+mailreader @ref{Gnus} and @ref{Rmail} are supported.
+
+@item
+Setup for IRC channels configurable by the variable
+@code{bug-reference-setup-from-irc-alist}. The built-in IRC clients
+Rcirc, @xref{Top, Rcirc,, rcirc, The Rcirc Manual}, and ERC,
+@xref{Top, ERC,, erc, The ERC Manual}, are supported.
+@end enumerate
+
+For almost all of those modes, it's enough to simply enable
+@code{bug-reference-mode}, only Rmail requires a slightly different
+setup.
+
+@smallexample
+;; Use VC-based setup if file is under version control.
+(add-hook 'prog-mode-hook #'bug-reference-prog-mode)
+
+;; Gnus (summary & article buffers)
+(add-hook 'gnus-mode-hook #'bug-reference-mode)
+
+;; Rmail
+(add-hook 'rmail-show-message-hook #'bug-reference-mode-force-auto-setup)
+
+;; Rcirc
+(add-hook 'rcirc-mode-hook #'bug-reference-mode)
+
+;; ERC
+(add-hook 'erc-mode-hook #'bug-reference-mode)
+@end smallexample
+
+In the Rmail case, instead of the mode hook, the
+@code{rmail-show-message-hook} has to be used in combination with the
+function @code{bug-reference-mode-force-auto-setup} which activates
+@code{bug-reference-mode} and forces auto-setup. The reason is that
+with Rmail all messages reside in the same buffer but the setup needs
+to be performed whenever another messages is displayed.
+
+
+@heading Adding support for third-party packages
+
+@vindex bug-reference-auto-setup-functions
+Adding support for bug-reference' auto-setup is usually quite
+straight-forward: write a setup function of zero arguments which
+gathers the required information (e.g., List-Id/To/From/Cc mail header
+values in the case of a MUA), and then calls one of the following
+helper functions:
+@itemize @bullet
+@item
+@code{bug-reference-maybe-setup-from-vc} which does the setup
+according to @code{bug-reference-setup-from-vc-alist},
+
+@item
+@code{bug-reference-maybe-setup-from-mail} which does the setup
+according to @code{bug-reference-setup-from-mail-alist},
+
+@item
+and @code{bug-reference-maybe-setup-from-irc} which does the setup
+according to @code{bug-reference-setup-from-irc-alist}.
+@end itemize
+A setup function should return non-nil if it could setup bug-reference
+mode which is the case if the last thing the function does is calling
+one of the helper functions above.
+
+Finally, the setup function has to be added to
+@code{bug-reference-auto-setup-functions}.
+
+Note that these auto-setup functions should check as a first step if
+they are applicable, e.g., by checking the @code{major-mode} value.
+
+
+@heading Integration with the debbugs package
+
+@findex debbugs-browse-mode
+If your project's issues are tracked on the server
+@url{https://debbugs.gnu.org}, you can browse and reply to reports
+directly in Emacs using the @code{debbugs} package, which can be
+downloaded via the Package Menu (@pxref{Packages}). This package adds
+the minor mode @code{debbugs-browse-mode}, which can be activated on
+top of @code{bug-reference-mode} and @code{bug-reference-prog-mode} as
+follows:
+
+@smallexample
+(add-hook 'bug-reference-mode-hook 'debbugs-browse-mode)
+(add-hook 'bug-reference-prog-mode-hook 'debbugs-browse-mode)
+@end smallexample
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index f81e64bdf9b..6dcee3fa824 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -64,10 +64,10 @@ minibuffer-electric-default-mode}.
Since the minibuffer appears in the echo area, it can conflict with
other uses of the echo area. If an error message or an informative
-message is emitted while the minibuffer is active, the message hides
-the minibuffer for a few seconds, or until you type something; then
-the minibuffer comes back. While the minibuffer is in use, Emacs does
-not echo keystrokes.
+message is emitted while the minibuffer is active, the message is
+displayed in brackets after the minibuffer text for a few seconds, or
+until you type something; then the message disappears. While the
+minibuffer is in use, Emacs does not echo keystrokes.
@vindex minibuffer-follows-selected-frame
While using the minibuffer, you can switch to a different frame,
@@ -82,7 +82,9 @@ after a recursive minibuffer has been opened in the current command
(@pxref{Recursive Mini,,, elisp}). This option is mainly to retain
(approximately) the behavior prior to Emacs 28.1. Note that the
effect of the command, when you finally finish using the minibuffer,
-always takes place in the frame where you first opened it.
+always takes place in the frame where you first opened it. The sole
+exception is that when that frame no longer exists, the action takes
+place in the currently selected frame.
@node Minibuffer File
@section Minibuffers for File Names
@@ -245,6 +247,9 @@ You might need also to enable @code{minibuffer-depth-indicate-mode}
to show the current recursion depth in the minibuffer prompt
on recursive use of the minibuffer.
+ When active, the minibuffer is usually in @code{minibuffer-mode}.
+This is an internal Emacs mode without any special features.
+
@findex minibuffer-inactive-mode
When not active, the minibuffer is in @code{minibuffer-inactive-mode},
and clicking @kbd{mouse-1} there shows the @file{*Messages*} buffer.
@@ -369,9 +374,9 @@ used with the completion list:
@itemx @key{prior}
Typing @kbd{M-v}, while in the minibuffer, selects the window showing
the completion list (@code{switch-to-completions}). This paves the
-way for using the commands below. @key{PageUp} or @key{prior} does
-the same. You can also select the window in other ways
-(@pxref{Windows}).
+way for using the commands below. @key{PageUp}, @key{prior} and
+@kbd{M-g M-c} does the same. You can also select the window in other
+ways (@pxref{Windows}).
@findex choose-completion
@item @key{RET}
@@ -383,12 +388,14 @@ point (@code{choose-completion}).
@findex next-completion
@item @key{TAB}
@item @key{RIGHT}
+@item @key{n}
While in the completion list buffer, these keys move point to the
following completion alternative (@code{next-completion}).
@findex previous-completion
@item @key{S-TAB}
@item @key{LEFT}
+@item @key{p}
While in the completion list buffer, these keys move point to the
previous completion alternative (@code{previous-completion}).
@@ -623,6 +630,14 @@ in a cyclic manner. If you give @code{completion-cycle-threshold} a
numeric value @var{n}, completion commands switch to this cycling
behavior only when there are @var{n} or fewer alternatives.
+@vindex completions-format
+ When displaying completions, Emacs will normally pop up a new buffer
+to display the completions. The completions will (by default) be
+sorted in columns horizontally in alphabetical order, but this can be
+changed by changing the @code{completions-format} user option. If
+@code{vertical}, sort the completions vertically in columns instead,
+and if @code{one-column}, just use a single column.
+
@node Minibuffer History
@section Minibuffer History
@cindex minibuffer history
@@ -800,6 +815,7 @@ can re-execute a command by calling @code{eval} with the
@node Passwords
@section Entering passwords
+@cindex entering passwords
Sometimes, you may need to enter a password into Emacs. For instance,
when you tell Emacs to visit a file on another machine via a network
@@ -810,7 +826,7 @@ access to the machine (@pxref{Remote Files}).
displays a prompt in the echo area (such as @samp{Password: }); after
you type the required password, press @key{RET} to submit it. To
prevent others from seeing your password, every character you type is
-displayed as a dot (@samp{.}) instead of its usual form.
+displayed as an asterisk (@samp{*}) instead of its usual form.
Most of the features and commands associated with the minibuffer
@emph{cannot} be used when entering a password. There is no history
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index fbb8122a1b8..528cfa94c66 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -163,14 +163,13 @@ List killed groups (@code{gnus-group-list-killed}).
List zombie groups (@code{gnus-group-list-zombies}).
@kindex u @r{(Gnus Group mode)}
-@findex gnus-group-unsubscribe-current-group
+@findex gnus-group-toggle-subscription
@cindex subscribe groups
@cindex unsubscribe groups
@item u
Toggle the subscription status of the group
-(@code{gnus-group-unsubscribe-current-group}) on the current line
-(i.e., turn a subscribed group into an unsubscribed group, or vice
-versa). Invoking this on a killed or zombie group turns it into an
+(@code{gnus-group-toggle-subscription}) on the current line.
+Invoking this on a killed or zombie group turns it into an
unsubscribed group.
@kindex C-k @r{(Gnus Group mode)}
@@ -1021,7 +1020,10 @@ pending in the shell buffer and not yet sent.
@findex comint-delete-output
Delete the last batch of output from a shell command
(@code{comint-delete-output}). This is useful if a shell command spews
-out lots of output that just gets in the way.
+out lots of output that just gets in the way. With a prefix argument,
+this command saves the deleted text in the @code{kill-ring}
+(@pxref{Kill Ring}), so that you could later yank it (@pxref{Yanking})
+elsewhere.
@item C-c C-s
@kindex C-c C-s @r{(Shell mode)}
@@ -1757,6 +1759,13 @@ expression @code{(+ 1 2)} on the @samp{foo} server, and returns
@code{3}. (If there is no server with that name, an error is
signaled.) Currently, this feature is mainly useful for developers.
+ If your operating system’s desktop environment is
+@url{https://www.freedesktop.org/wiki/Specifications/,,freedesktop.org-compatible}
+(which is true of most GNU/Linux and other recent Unix-like GUIs), you
+may use the @samp{Emacs (Client)} menu entry to connect to an Emacs
+server with @command{emacsclient}. The daemon starts if not
+already running.
+
@menu
* TCP Emacs server:: Listening to a TCP socket.
* Invoking emacsclient:: Connecting to the Emacs server.
@@ -1864,6 +1873,12 @@ it to exit. Programs that use @env{EDITOR} usually wait for the
editor---in this case @command{emacsclient}---to exit before doing
something else.
+@findex server-edit-abort
+ If you want to abandon the edit instead, use the @w{@kbd{M-x
+server-edit-abort}} command. This sends a message back to the
+@command{emacsclient} program, telling it to exit with abnormal exit
+status, and doesn't save any buffers.
+
You can also call @command{emacsclient} with multiple file name
arguments: @samp{emacsclient @var{file1} @var{file2} ...} tells the
Emacs server to visit @var{file1}, @var{file2}, and so forth. Emacs
@@ -2018,7 +2033,7 @@ evaluation performed is for side-effect rather than result.
Connect to the Emacs server named @var{server-name}. (This option is
not supported on MS-Windows.) The server name is given by the
variable @code{server-name} on the Emacs server. If this option is
-omitted, @command{emacsclient} connects to the first server it finds.
+omitted, @command{emacsclient} connects to the default socket.
If you set @code{server-name} of the Emacs server to an absolute file
name, give the same absolute file name as @var{server-name} to this
option to instruct @command{emacsclient} to connect to that server.
@@ -2576,6 +2591,17 @@ Other Hexl commands let you insert strings (sequences) of binary
bytes, move by @code{short}s or @code{int}s, etc.; type @kbd{C-h a
hexl-@key{RET}} for details.
+ Hexl mode can also be used for editing text files. This could come
+in handy if the text file includes unusual characters or uses unusual
+encoding (@pxref{Coding Systems}). For this purpose, Hexl commands
+that insert bytes can also insert @acronym{ASCII} and
+non-@acronym{ASCII} characters, including multibyte characters. To
+edit a text file with Hexl, visit the file as usual, and then type
+@w{@kbd{M-x hexl-mode @key{RET}}} to switch to Hexl mode. You can now
+insert text characters by typing them. However, inserting multibyte
+characters requires special care, to avoid the danger of creating
+invalid multibyte sequences: you should start typing such characters
+when point is on the first byte of a multibyte sequence in the file.
@node Saving Emacs Sessions
@section Saving Emacs Sessions
@@ -2947,6 +2973,15 @@ URLs.
For more information, view the package commentary by typing @kbd{C-h P
browse-url @key{RET}}.
+@findex url-handler-mode
+ Emacs also has a minor mode that has some support for handling
+@acronym{URL}s as if they were files. @code{url-handler-mode} is a
+global minor mode that affects most of the Emacs commands and
+primitives that deal with file names. After switching on this mode,
+you can say, for instance, @kbd{C-x C-f https://www.gnu.org/ RET} to
+see the @acronym{HTML} for that web page, and you can then edit it and
+save it to a local file, for instance.
+
@node Goto Address mode
@subsection Activating URLs
@findex goto-address-mode
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index cc25d3e1e33..9014221edff 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -357,8 +357,12 @@ preferences. If you personally want to use a minor mode for a
particular file type, it is better to enable the minor mode via a
major mode hook (@pxref{Major Modes}).
+ Second, Emacs checks whether the file's extension matches an entry
+in any directory-local @code{auto-mode-alist}. These are found using
+the @file{.dir-locals.el} facility (@pxref{Directory Variables}).
+
@vindex interpreter-mode-alist
- Second, if there is no file variable specifying a major mode, Emacs
+ Third, if there is no file variable specifying a major mode, Emacs
checks whether the file's contents begin with @samp{#!}. If so, that
indicates that the file can serve as an executable shell command,
which works by running an interpreter named on the file's first line
@@ -376,7 +380,7 @@ same is true for man pages which start with the magic string
@samp{'\"} to specify a list of troff preprocessors.
@vindex magic-mode-alist
- Third, Emacs tries to determine the major mode by looking at the
+ Fourth, Emacs tries to determine the major mode by looking at the
text at the start of the buffer, based on the variable
@code{magic-mode-alist}. By default, this variable is @code{nil} (an
empty list), so Emacs skips this step; however, you can customize it
@@ -404,7 +408,7 @@ where @var{match-function} is a Lisp function that is called at the
beginning of the buffer; if the function returns non-@code{nil}, Emacs
set the major mode with @var{mode-function}.
- Fourth---if Emacs still hasn't found a suitable major mode---it
+ Fifth---if Emacs still hasn't found a suitable major mode---it
looks at the file's name. The correspondence between file names and
major modes is controlled by the variable @code{auto-mode-alist}. Its
value is a list in which each element has this form,
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 4b58f6aa2f7..33d389acd50 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -549,10 +549,6 @@ meanings by enabling CUA Mode (@pxref{CUA Bindings}). Another
optional feature which will make Emacs behave like other Windows
applications is Delete Selection mode (@pxref{Using Region}).
-@iftex
-@inforef{Windows Keyboard, , emacs}, for information about additional
-Windows-specific variables in this category.
-@end iftex
@ifnottex
@vindex w32-alt-is-meta
@cindex @code{Alt} key (MS-Windows)
@@ -1176,11 +1172,6 @@ the default when such software is detected when running Emacs.
When this variable is non-@code{nil}, other variables affecting the
cursor display have no effect.
-@iftex
-@inforef{Windows Misc, , emacs}, for information about additional
-Windows-specific variables in this category.
-@end iftex
-
@ifnottex
@vindex w32-grab-focus-on-raise
@cindex frame focus policy, MS-Windows
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 922eec7426e..22b3677b5b0 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -174,8 +174,10 @@ characters in the range @code{#x0080..#x00FF}.
@cindex font of character at point
@cindex text properties at point
@cindex face at point
- With a prefix argument (@kbd{C-u C-x =}), this command displays a
-detailed description of the character in a window:
+@findex describe-char
+ With a prefix argument (@kbd{C-u C-x =}), this command additionally
+calls the command @code{describe-char}, which displays a detailed
+description of the character:
@itemize @bullet
@item
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 038a31a35b9..d419a4e24b5 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -126,6 +126,13 @@ line; typing @kbd{x} (see below) will delete the package.
@xref{Package Files}, for information about what package deletion
entails.
+@item w
+@kindex w @r{(Package Menu)}
+@findex package-browse-url
+Open the home page of the package on the current line in a browser
+(@code{package-browse-url}). @code{browse-url} is used to open the
+browser.
+
@item ~
@kindex ~ @r{(Package Menu)}
@findex package-menu-mark-obsolete-for-deletion
@@ -409,12 +416,12 @@ just make some new commands available, while others have more
wide-ranging effects on the Emacs session. For such information,
consult the package's help buffer.
- After a package is installed, it is automatically made available by
-Emacs in all subsequent sessions. This happens at startup, before
-processing the init file but after processing the early init file
-(@pxref{Early Init File}). As an exception, Emacs does not make
-packages available at startup if invoked with the @samp{-q} or
-@samp{--no-init-file} options (@pxref{Initial Options}).
+ Installed packages are automatically made available by Emacs in all
+subsequent sessions. This happens at startup, before processing the
+init file but after processing the early init file (@pxref{Early Init
+File}). As an exception, Emacs does not make packages available at
+startup if invoked with the @samp{-q} or @samp{--no-init-file} options
+(@pxref{Initial Options}).
@vindex package-enable-at-startup
To keep Emacs from automatically making packages available at
@@ -423,6 +430,17 @@ startup, change the variable @code{package-enable-at-startup} to
is read before loading the regular init file. Currently this variable
cannot be set via Customize.
+@findex package-quickstart-refresh
+@vindex package-quickstart
+ If you have many packages installed, you can improve startup times
+by setting the user option @code{package-quickstart} to @code{t}.
+Setting this option will make Emacs precompute many things instead of
+re-computing them on every Emacs startup. However, if you do this,
+then you have to manually run the command
+@code{package-quickstart-refresh} when the activations need to be
+changed, such as when you change the value of
+@code{package-load-list}.
+
@findex package-activate-all
If you have set @code{package-enable-at-startup} to @code{nil}, you
can still make packages available either during or after startup. To
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index f3c42bcea7f..a1760ad66ff 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -201,6 +201,14 @@ something before the starting point, type @kbd{C-r} to switch to a
backward search, leaving the search string unchanged. Similarly,
@kbd{C-s} in a backward search switches to a forward search.
+@cindex search, changing direction
+@vindex isearch-repeat-on-direction-change
+ When you change the direction of a search, the first command you
+type will, by default, remain on the same match, and the cursor will
+move to the other end of the match. To move to another match
+immediately, customize the variable
+@code{isearch-repeat-on-direction-change} to @code{t}.
+
@cindex search, wrapping around
@cindex search, overwrapped
@cindex wrapped search
@@ -293,13 +301,11 @@ from point to the @var{n}th occurrence of the specified character.
@findex isearch-yank-x-selection
Within incremental search, @kbd{C-y} (@code{isearch-yank-kill})
appends the current kill to the search string. @kbd{M-y}
-(@code{isearch-yank-pop}), if called after @kbd{C-y}, replaces that
-appended text with an earlier kill, similar to the usual @kbd{M-y}
-(@code{yank-pop}) command. When @kbd{M-y} is called not after
-@kbd{C-y}, then it activates the minibuffer where you can select
-a previous kill to append to the search string (@pxref{Earlier
-Kills}). Clicking @kbd{mouse-2} in the echo area appends the current
-X selection (@pxref{Primary Selection}) to the search string
+(@code{isearch-yank-pop}), if called after @kbd{C-y} during
+incremental search, replaces that appended text with an earlier kill,
+similar to the usual @kbd{M-y} (@code{yank-pop}) command. Clicking
+@kbd{mouse-2} in the echo area appends the current X selection
+(@pxref{Primary Selection}) to the search string
(@code{isearch-yank-x-selection}).
@kindex C-M-d @r{(Incremental search)}
@@ -1965,6 +1971,17 @@ it never deletes lines that are only partially contained in the region
(a newline that ends a line counts as part of that line).
If a match is split across lines, this command keeps all those lines.
+
+@findex kill-matching-lines
+@item M-x kill-matching-lines
+Like @code{flush-lines}, but also add the matching lines to the kill
+ring. The command adds the matching lines to the kill ring as a
+single string, including the newlines that separated the lines.
+
+@findex copy-matching-lines
+@item M-x copy-matching-lines
+Like @code{kill-matching-lines}, but the matching lines are not
+removed from the buffer.
@end table
@node Search Customizations
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 54e16698a74..dc8ca903b72 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -61,7 +61,7 @@ use Picture mode, a special major mode for editing such pictures.
@cindex autotyping
@cindex automatic typing
The automatic typing features may be useful when writing text.
-@inforef{Top,The Autotype Manual,autotype}.
+@xref{Top, Autotyping, The Autotype Manual, autotype}.
@end ifinfo
@menu
@@ -421,13 +421,12 @@ beginning of a line.
@cindex curved quotes
@cindex guillemets
@findex electric-quote-mode
-@c The funny quoting below is to make the printed version look
-@c correct. FIXME.
+
One common way to quote is the typewriter convention, which quotes
-using straight apostrophes @t{'like this'} or double-quotes @t{"like
+using straight apostrophes @samp{'like this'} or double-quotes @samp{"like
this"}. Another common way is the curved quote convention, which uses
-left and right single or double quotation marks `@t{like this}' or
-``@t{like this}''@footnote{
+left and right single or double quotation marks @t{‘like this’} or
+@t{“like this”}@footnote{
The curved single quote characters are U+2018 @sc{left single quotation
mark} and U+2019 @sc{right single quotation mark}; the curved double quotes
are U+201C @sc{left double quotation mark} and U+201D @sc{right double
@@ -445,7 +444,7 @@ default quotes listed above, by customizing the variable
@code{electric-quote-chars}, a list of four characters, where the
items correspond to the left single quote, the right single quote, the
left double quote and the right double quote, respectively, whose
-default value is @code{'(?@r{`} ?@r{'} ?@r{``} ?@r{''})}.
+default value is @w{@code{'(@w{?}‘ ?’ ?“ ?”)}}.
@vindex electric-quote-paragraph
@vindex electric-quote-comment
@@ -461,7 +460,7 @@ 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
+a non-@code{nil} value. Then, typing @kbd{"} 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.
@@ -473,7 +472,7 @@ To toggle it globally, type
type @kbd{C-q `} or @kbd{C-q '} instead of @kbd{`} or @kbd{'}. To
insert a curved quote even when Electric Quote is disabled or
inactive, you can type @kbd{C-x 8 [} for @t{‘}, @kbd{C-x 8 ]} for
-@t{’}, @kbd{C-x 8 @{} for ``, and @kbd{C-x 8 @}} for ''.
+@t{’}, @kbd{C-x 8 @{} for @t{“}, and @kbd{C-x 8 @}} for @t{”}.
@xref{Inserting Text}. Note that the value of
@code{electric-quote-chars} does not affect these keybindings, they
are not keybindings of @code{electric-quote-mode} but bound in
@@ -502,8 +501,8 @@ text.
@cindex mode, Auto Fill
@dfn{Auto Fill} mode is a buffer-local minor mode (@pxref{Minor
-Modes}) in which lines are broken automatically at spaces when the
-line becomes too wide.
+Modes}) in which lines are broken automatically when the line becomes
+too wide and you type @kbd{@key{SPC}} or @kbd{@key{RET}}.
@table @kbd
@item M-x auto-fill-mode
@@ -522,12 +521,21 @@ certain major modes, add @code{auto-fill-mode} to the mode hooks
(@pxref{Major Modes}). When Auto Fill mode is enabled, the mode
indicator @samp{Fill} appears in the mode line (@pxref{Mode Line}).
- Auto Fill mode breaks lines automatically at spaces whenever they
-get longer than the desired width. This line breaking occurs only
-when you type @key{SPC} or @key{RET}. If you wish to insert a space
-or newline without permitting line-breaking, type @kbd{C-q @key{SPC}}
-or @kbd{C-q C-j} respectively. Also, @kbd{C-o} inserts a newline
-without line breaking.
+ Auto Fill mode breaks lines automatically at the appropriate places
+whenever lines get longer than the desired width. This line breaking
+occurs only when you type @kbd{@key{SPC}} or @kbd{@key{RET}}. If you
+wish to insert a space or newline without permitting line-breaking,
+type @kbd{C-q @key{SPC}} or @kbd{C-q C-j} respectively. Also,
+@kbd{C-o} inserts a newline without line breaking.
+
+@cindex kinsoku line-breaking rules
+ The place where Auto Fill breaks a line depends on the line's
+characters. For characters from @acronym{ASCII}, Latin, and most
+other scripts Emacs breaks a line on space characters, to keep the
+words intact. But for CJK scripts, a line can be broken between any
+two characters. (If you load the @file{kinsoku} library, Emacs will
+avoid breaking a line between certain pairs of CJK characters, where
+special rules prohibit that.)
When Auto Fill mode breaks a line, it tries to obey the
@dfn{adaptive fill prefix}: if a fill prefix can be deduced from the
@@ -549,6 +557,9 @@ described in the next section.
(@pxref{Fill Commands}).
@end ifnottex
+ A similar feature that wraps long lines automatically at display
+time is Visual Line Mode (@pxref{Visual Line Mode}).
+
@node Fill Commands
@subsection Explicit Fill Commands
@@ -561,7 +572,7 @@ Set the fill column (@code{set-fill-column}).
Fill each paragraph in the region (@code{fill-region}).
@item M-x fill-region-as-paragraph
Fill the region, considering it as one paragraph.
-@item M-o M-s
+@item M-x center-line
Center a line.
@end table
@@ -571,7 +582,11 @@ Center a line.
current paragraph. It redistributes the line breaks within the
paragraph, and deletes any excess space and tab characters occurring
within the paragraph, in such a way that the lines end up fitting
-within a certain maximum width.
+within a certain maximum width. Like Auto Fill mode, this and other
+filling commands usually break lines at space characters, but for CJK
+characters these commands can break a line between almost any two
+characters, and they can also obey the kinsoku rules. @xref{Auto
+Fill}.
@findex fill-region
Normally, @kbd{M-q} acts on the paragraph where point is, but if
@@ -606,10 +621,9 @@ numeric argument, it uses that as the new fill column. With just
@kbd{C-u} as argument, it sets @code{fill-column} to the current
horizontal position of point.
-@kindex M-o M-s @r{(Text mode)}
@cindex centering
@findex center-line
- The command @kbd{M-o M-s} (@code{center-line}) centers the current line
+ The command @kbd{M-x center-line} centers the current line
within the current fill column. With an argument @var{n}, it centers
@var{n} lines individually and moves past them. This binding is
made by Text mode and is available only in that and related modes
@@ -645,8 +659,8 @@ or before @samp{)}, @samp{:} or @samp{?}); and
even if preceded by a non-whitespace character).
Emacs can display an indicator in the @code{fill-column} position
-using the Display fill column indicator mode
-(@pxref{Displaying Boundaries, display-fill-column-indicator}).
+using the Display fill column indicator mode (@pxref{Displaying
+Boundaries, display-fill-column-indicator}).
@node Fill Prefix
@subsection The Fill Prefix
@@ -982,6 +996,13 @@ specific file (@pxref{File Variables}).
major mode's special commands. (The variable
@code{outline-minor-mode-prefix} controls the prefix used.)
+@vindex outline-minor-mode-cycle
+ If the @code{outline-minor-mode-cycle} user option is
+non-@code{nil}, the @kbd{TAB} and @kbd{S-TAB} keys are enabled on the
+outline heading lines. @kbd{TAB} cycles hiding, showing the
+sub-heading, and showing all for the current section. @kbd{S-TAB}
+does the same for the entire buffer.
+
@menu
* Outline Format:: What the text of an outline looks like.
* Outline Motion:: Special commands for moving through outlines.
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index c66deb77487..facbc7f3ed8 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -310,6 +310,9 @@ the space that it occupied is given to an adjacent window (but not the
minibuffer window, even if that is active at the time). Deleting the
window has no effect on the buffer it used to display; the buffer
continues to exist, and you can still switch to it with @kbd{C-x b}.
+The option @code{delete-window-choose-selected} allows to choose which
+window becomes the new selected window instead (@pxref{Deleting
+Windows,,, elisp, The Emacs Lisp Reference Manual}).
@findex kill-buffer-and-window
@kindex C-x 4 0
diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in
index d8b909c9c10..294b310d673 100644
--- a/doc/lispintro/Makefile.in
+++ b/doc/lispintro/Makefile.in
@@ -20,6 +20,7 @@
SHELL = @SHELL@
srcdir = @srcdir@
+top_builddir = @top_builddir@
buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
@@ -55,13 +56,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = \
$(AM_V_GEN)TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \
@@ -124,6 +119,7 @@ infoclean:
$(buildinfodir)/eintr.info-[1-9]
bootstrap-clean maintainer-clean: distclean infoclean
+ rm -f TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -171,5 +167,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
### Makefile ends here
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index d5c280b7924..fade4096e38 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -1364,19 +1364,6 @@ C-e}:
(this is an unquoted list)
@end smallexample
-@ignore
-@noindent
-What you see depends on which version of Emacs you are running. GNU
-Emacs version 22 provides more information than version 20 and before.
-First, the more recent result of generating an error; then the
-earlier, version 20 result.
-
-@need 1250
-@noindent
-In GNU Emacs version 22, a @file{*Backtrace*} window will open up and
-you will see the following in it:
-@end ignore
-
A @file{*Backtrace*} window will open up and you should see the
following in it:
@@ -1838,19 +1825,6 @@ Debugger entered--Lisp error: (void-function fill-column)
(Remember, to quit the debugger and make the debugger window go away,
type @kbd{q} in the @file{*Backtrace*} buffer.)
-@ignore
-@need 800
-In GNU Emacs 20 and before, you will produce an error message that says:
-
-@smallexample
-Symbol's function definition is void:@: fill-column
-@end smallexample
-
-@noindent
-(The message will go away as soon as you move the cursor or type
-another key.)
-@end ignore
-
@node Void Variable
@subsection Error Message for a Symbol Without a Value
@cindex Symbol without value error
@@ -1907,18 +1881,6 @@ Since @code{+} does not have a value bound to it, just the function
definition, the error message reported that the symbol's value as a
variable was void.
-@ignore
-@need 800
-In GNU Emacs version 20 and before, your error message will say:
-
-@example
-Symbol's value as variable is void:@: +
-@end example
-
-@noindent
-The meaning is the same as in GNU Emacs 22.
-@end ignore
-
@node Arguments
@section Arguments
@cindex Arguments
@@ -2197,19 +2159,6 @@ addition had been passed the correct type of object, the value passed
would have been a number, such as 37, rather than a symbol like
@code{hello}. But then you would not have got the error message.
-@ignore
-@need 1250
-In GNU Emacs version 20 and before, the echo area displays an error
-message that says:
-
-@smallexample
-Wrong type argument:@: number-or-marker-p, hello
-@end smallexample
-
-This says, in different words, the same as the top line of the
-@file{*Backtrace*} buffer.
-@end ignore
-
@node message
@subsection The @code{message} Function
@findex message
@@ -6663,9 +6612,9 @@ original text of the function:
@end group
@end smallexample
-(In recent versions of GNU Emacs, the @code{what-line} function has
+(In modern versions of GNU Emacs, the @code{what-line} function has
been expanded to tell you your line number in a narrowed buffer as
-well as your line number in a widened buffer. The recent version is
+well as your line number in a widened buffer. The modern version is
more complex than the version shown here. If you feel adventurous,
you might want to look at it after figuring out how this version
works. You will probably need to use @kbd{C-h f}
@@ -10392,9 +10341,8 @@ echo area: @code{^Jgazelle^J^Jgiraffe^J^Jlion^J^Jtiger^Jnil}, in which
each @samp{^J} stands for a newline.)
@need 1500
-In a recent instance of GNU Emacs, you can evaluate these expressions
-directly in the Info buffer, and the echo area will grow to show the
-results.
+You can evaluate these expressions directly in the Info buffer, and
+the echo area will grow to show the results.
@smallexample
@group
@@ -17532,10 +17480,9 @@ Here is the definition:
@need 1250
Now for the keybinding.
-Nowadays, function keys as well as mouse button events and
-non-@sc{ascii} characters are written within square brackets, without
-quotation marks. (In Emacs version 18 and before, you had to write
-different function key bindings for each different make of terminal.)
+Function keys as well as mouse button events and non-@sc{ascii}
+characters are written within square brackets, without quotation
+marks.
I bind @code{line-to-top-of-window} to my @key{F6} function key like
this:
@@ -17550,18 +17497,18 @@ Your Init File, emacs, The GNU Emacs Manual}.
@cindex Conditional 'twixt two versions of Emacs
@cindex Version of Emacs, choosing
@cindex Emacs version, choosing
-If you run two versions of GNU Emacs, such as versions 22 and 23, and
+If you run two versions of GNU Emacs, such as versions 27 and 28, and
use one @file{.emacs} file, you can select which code to evaluate with
the following conditional:
@smallexample
@group
(cond
- ((= 22 emacs-major-version)
- ;; evaluate version 22 code
+ ((= 27 emacs-major-version)
+ ;; evaluate version 27 code
( @dots{} ))
- ((= 23 emacs-major-version)
- ;; evaluate version 23 code
+ ((= 28 emacs-major-version)
+ ;; evaluate version 28 code
( @dots{} )))
@end group
@end smallexample
@@ -18105,8 +18052,7 @@ argument of 4:
@end smallexample
@noindent
-In a recent GNU Emacs, you will create and enter a @file{*Backtrace*}
-buffer that says:
+This will create and enter a @file{*Backtrace*} buffer that says:
@noindent
@smallexample
@@ -18140,25 +18086,12 @@ In practice, for a bug as simple as this, the Lisp error line will
tell you what you need to know to correct the definition. The
function @code{1=} is void.
-@ignore
-@need 800
-In GNU Emacs 20 and before, you will see:
-
-@smallexample
-Symbol's function definition is void:@: 1=
-@end smallexample
-
-@noindent
-which has the same meaning as the @file{*Backtrace*} buffer line in
-version 21.
-@end ignore
-
However, suppose you are not quite certain what is going on?
You can read the complete backtrace.
-In this case, you need to run a recent GNU Emacs, which automatically
-starts the debugger that puts you in the @file{*Backtrace*} buffer; or
-else, you need to start the debugger manually as described below.
+Emacs automatically starts the debugger that puts you in the
+@file{*Backtrace*} buffer. You can also start the debugger manually
+as described below.
Read the @file{*Backtrace*} buffer from the bottom up; it tells you
what Emacs did that led to the error. Emacs made an interactive call
@@ -18198,14 +18131,8 @@ then run your test again.
@section @code{debug-on-entry}
@findex debug-on-entry
-A recent GNU Emacs starts the debugger automatically when your
-function has an error.
-
-@ignore
-GNU Emacs version 20 and before did not; it simply
-presented you with an error message. You had to start the debugger
-manually.
-@end ignore
+Emacs starts the debugger automatically when your function has an
+error.
Incidentally, you can start the debugger manually for all versions of
Emacs; the advantage is that the debugger runs even if you do not have
@@ -20080,8 +20007,8 @@ the tic marks themselves and their spacing:
@code{defvar}. The @code{boundp} predicate checks whether it has
already been set; @code{boundp} returns @code{nil} if it has not. If
@code{graph-blank} were unbound and we did not use this conditional
-construction, in a recent GNU Emacs, we would enter the debugger and
-see an error message saying @samp{@w{Debugger entered--Lisp error:}
+construction, we would enter the debugger and see an error message
+saying @samp{@w{Debugger entered--Lisp error:}
@w{(void-variable graph-blank)}}.)
@need 1200
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 271f06edddc..a7701c5f98e 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -24,6 +24,7 @@ SHELL = @SHELL@
# Standard configure variables.
srcdir = @srcdir@
+top_builddir = @top_builddir@
buildinfodir = $(srcdir)/../../info
# Directory with the (customized) texinfo.tex file.
@@ -59,13 +60,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = \
$(AM_V_GEN)TEXINPUTS="$(srcdir):$(texinfodir):$(emacsdir):$(TEXINPUTS)" \
@@ -185,6 +180,7 @@ infoclean:
$(buildinfodir)/elisp.info-[1-9][0-9]
bootstrap-clean maintainer-clean: distclean infoclean
+ rm -f TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -232,5 +228,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
### Makefile ends here
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index c0a4065bdbf..85a4f9e0acc 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -481,6 +481,12 @@ all directory separators were changed to @samp{!} to prevent clashes.
(This will not work correctly if your filesystem truncates the
resulting name.)
+If @var{uniquify} is one of the members of
+@code{secure-hash-algorithms}, Emacs constructs the nondirectory part
+of the auto-save file name by applying that @code{secure-hash} to the
+buffer file name. This avoids any risk of excessively long file
+names.
+
All the transforms in the list are tried, in the order they are listed.
When one transform applies, its result is final;
no further transforms are tried.
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 69733f91c4a..55e9d00d8bf 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -309,7 +309,6 @@ foo
This function renames the current buffer to @var{newname}. An error
is signaled if @var{newname} is not a string.
-@c Emacs 19 feature
Ordinarily, @code{rename-buffer} signals an error if @var{newname} is
already in use. However, if @var{unique} is non-@code{nil}, it modifies
@var{newname} to make a name that is not in use. Interactively, you can
@@ -344,7 +343,6 @@ a name. For example:
See also the function @code{get-buffer-create} in @ref{Creating Buffers}.
@end defun
-@c Emacs 19 feature
@defun generate-new-buffer-name starting-name &optional ignore
This function returns a name that would be unique for a new buffer---but
does not create the buffer. It starts with @var{starting-name}, and
@@ -879,7 +877,6 @@ then @code{other-buffer} uses that predicate to decide which buffers to
consider. It calls the predicate once for each buffer, and if the value
is @code{nil}, that buffer is ignored. @xref{Buffer Parameters}.
-@c Emacs 19 feature
If @var{visible-ok} is @code{nil}, @code{other-buffer} avoids returning
a buffer visible in any window on any visible frame, except as a last
resort. If @var{visible-ok} is non-@code{nil}, then it does not matter
@@ -1186,7 +1183,7 @@ buffer.
the base buffer effectively kills the indirect buffer in that it cannot
ever again be the current buffer.
-@deffn Command make-indirect-buffer base-buffer name &optional clone
+@deffn Command make-indirect-buffer base-buffer name &optional clone inhibit-buffer-hooks
This creates and returns an indirect buffer named @var{name} whose
base buffer is @var{base-buffer}. The argument @var{base-buffer} may
be a live buffer or the name (a string) of an existing buffer. If
@@ -1202,6 +1199,8 @@ If @var{base-buffer} is an indirect buffer, its base buffer is used as
the base for the new buffer. If, in addition, @var{clone} is
non-@code{nil}, the initial state is copied from the actual base
buffer, not from @var{base-buffer}.
+
+@xref{Creating Buffers}, for the meaning of @var{inhibit-buffer-hooks}.
@end deffn
@deffn Command clone-indirect-buffer newname display-flag &optional norecord
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 3a2c7d019ef..6d450998673 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -144,6 +144,7 @@ commands by adding the @code{interactive} form to them.
* Interactive Codes:: The standard letter-codes for reading arguments
in various ways.
* Interactive Examples:: Examples of how to read interactive arguments.
+* Command Modes:: Specifying that commands are for a specific mode.
* Generic Commands:: Select among command alternatives.
@end menu
@@ -156,7 +157,7 @@ commands by adding the @code{interactive} form to them.
makes a Lisp function an interactively-callable command, and how to
examine a command's @code{interactive} form.
-@defspec interactive arg-descriptor
+@defspec interactive &optional arg-descriptor &rest modes
This special form declares that a function is a command, and that it
may therefore be called interactively (via @kbd{M-x} or by entering a
key sequence bound to it). The argument @var{arg-descriptor} declares
@@ -177,6 +178,10 @@ forms are executed; at this time, if the @code{interactive} form
occurs within the body, the form simply returns @code{nil} without
even evaluating its argument.
+The @var{modes} list allows specifying which modes the command is
+meant to be used in. See @ref{Command Modes} for more details about
+the effect of specifying @var{modes}, and when to use it.
+
By convention, you should put the @code{interactive} form in the
function body, as the first top-level form. If there is an
@code{interactive} form in both the @code{interactive-form} symbol
@@ -449,10 +454,13 @@ This kind of input is used by commands such as @code{describe-key} and
@code{global-set-key}.
@item K
-A key sequence, whose definition you intend to change. This works like
-@samp{k}, except that it suppresses, for the last input event in the key
-sequence, the conversions that are normally used (when necessary) to
-convert an undefined key into a defined one.
+A key sequence on a form that can be used as input to functions like
+@code{define-key}. This works like @samp{k}, except that it
+suppresses, for the last input event in the key sequence, the
+conversions that are normally used (when necessary) to convert an
+undefined key into a defined one (@pxref{Key Sequence Input}), so this
+form is usually used when prompting for a new key sequence that is to
+be bound to a command.
@item m
@cindex marker argument
@@ -488,7 +496,10 @@ I/O.
Point and the mark, as two numeric arguments, smallest first. This is
the only code letter that specifies two successive arguments rather than
one. This will signal an error if the mark is not set in the buffer
-which is current when the command is invoked. No I/O.
+which is current when the command is invoked. If Transient Mark mode
+is turned on (@pxref{The Mark}) --- as it is by default --- and user
+option @code{mark-even-if-inactive} is @code{nil}, Emacs will signal
+an error even if the mark @emph{is} set, but is inactive. No I/O.
@item s
Arbitrary text, read in the minibuffer and returned as a string
@@ -588,6 +599,80 @@ Put them into three windows, selecting the last one."
@end group
@end example
+@node Command Modes
+@subsection Specifying Modes For Commands
+@cindex commands, mode-specific
+@cindex commands, specify as mode-specific
+@cindex mode-specific commands
+
+Many commands in Emacs are general, and not tied to any specific mode.
+For instance, @kbd{M-x kill-region} can be used in pretty much any
+mode that has editable text, and commands that display information
+(like @kbd{M-x list-buffers}) can be used in pretty much any context.
+
+Many other commands, however, are specifically tied to a mode, and
+make no sense outside of that context. For instance, @code{M-x
+dired-diff} will just signal an error if used outside of a Dired
+buffer.
+
+Emacs therefore has a mechanism for specifying what mode (or modes) a
+command ``belongs'' to:
+
+@lisp
+(defun dired-diff (...)
+ ...
+ (interactive "p" dired-mode)
+ ...)
+@end lisp
+
+This will mark the command as applicable to @code{dired-mode} only (or
+any modes that are derived from @code{dired-mode}). Any number of
+modes can be added to the @code{interactive} form.
+
+@vindex read-extended-command-predicate
+Specifying modes may affect completion in @kbd{M-x}, depending on the
+value of @code{read-extended-command-predicate}.
+
+For instance, when using the
+@code{command-completion-default-include-p} predicate, @kbd{M-x} won't
+list commands that have been marked as being applicable to a specific
+mode (unless you are in a buffer that uses that mode, of course).
+This goes for both major and minor modes.
+
+Marking commands this way will also make @kbd{C-h m} list these
+commands (if they aren't bound to any keys).
+
+If using this extended @code{interactive} form isn't convenient
+(because the code is supposed to work in older versions of Emacs that
+don't support the extended @code{interactive} form), the following
+equivalent declaration (@pxref{Declare Form}) can be used instead:
+
+@lisp
+(declare (modes dired-mode))
+@end lisp
+
+Which commands to tag with modes is to some degree a matter of taste,
+but commands that clearly do not work outside of the mode should be
+tagged. This includes commands that will signal an error if called
+from somewhere else, but also commands that are destructive when
+called from an unexpected mode. (This usually includes most of the
+commands that are written for special (i.e., non-editing) modes.)
+
+Some commands may be harmless, and ``work'' when called from other
+modes, but should still be tagged with a mode if they don't actually
+make much sense to use elsewhere. For instance, many special modes
+have commands to exit the buffer bound to @kbd{q}, and may not do
+anything but issue a message like "Goodbye from this mode" and then
+call @code{kill-buffer}. This command will ``work'' from any mode,
+but it is highly unlikely that anybody would actually want to use the
+command outside the context of this special mode.
+
+Many modes have a set of different commands that start the mode in
+different ways (e.g., @code{eww-open-in-new-buffer} and
+@code{eww-open-file}). Commands like that should never be tagged as
+mode-specific, as they can be issued by the user from pretty much any
+context.
+
@node Generic Commands
@subsection Select among Command Alternatives
@cindex generic commands
@@ -756,6 +841,29 @@ part of the prompt.
@result{} t
@end group
@end example
+
+@vindex read-extended-command-predicate
+@findex command-completion-default-include-p
+This command heeds the @code{read-extended-command-predicate}
+variable, which can filter out commands that are not applicable to the
+current major mode (or enabled minor modes). By default, the value of
+this variable is @code{nil}, and no commands are filtered out.
+However, customizing it to invoke the function
+@code{command-completion-default-include-p} will perform
+mode-dependent filtering. @code{read-extended-command-predicate} can
+be any predicate function; it will be called with two parameters: the
+command's symbol and the current buffer. If should return
+non-@code{nil} if the command is to be included when completing in
+that buffer.
+@end deffn
+
+@deffn Command execute-extended-command-for-buffer prefix-argument
+This is like @code{execute-extended-command}, but limits the commands
+offered for completion to those commands that are of particular
+relevance to the current major mode (and enabled minor modes). This
+includes commands that are tagged with the modes (@pxref{Using
+Interactive}), and also commands that are bound to locally active
+keymaps.
@end deffn
@node Distinguish Interactive
@@ -3276,6 +3384,12 @@ nil)}. This is the same thing that quitting does. (See @code{signal}
in @ref{Errors}.)
@end deffn
+ To quit without aborting a keyboard macro definition or execution,
+you can signal the @code{minibuffer-quit} condition. This has almost
+the same effect as the @code{quit} condition except that the error
+handling in the command loop handles it without exiting keyboard macro
+definition or execution.
+
You can specify a character other than @kbd{C-g} to use for quitting.
See the function @code{set-input-mode} in @ref{Input Modes}.
@@ -3460,12 +3574,14 @@ commands.
@code{recursive-edit}. This function contains the command loop; it also
contains a call to @code{catch} with tag @code{exit}, which makes it
possible to exit the recursive editing level by throwing to @code{exit}
-(@pxref{Catch and Throw}). If you throw a value other than @code{t},
-then @code{recursive-edit} returns normally to the function that called
-it. The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
+(@pxref{Catch and Throw}). If you throw a @code{nil} value, then
+@code{recursive-edit} returns normally to the function that called it.
+The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
Throwing a @code{t} value causes @code{recursive-edit} to quit, so that
control returns to the command loop one level up. This is called
@dfn{aborting}, and is done by @kbd{C-]} (@code{abort-recursive-edit}).
+You can also throw a function value. In that case,
+@code{recursive-edit} will call it without arguments before returning.
Most applications should not use recursive editing, except as part of
using the minibuffer. Usually it is more convenient for the user if you
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 66242343157..f48f4f47e8b 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -361,7 +361,7 @@ it does nothing. It always returns @var{function}.
These features permit you to write code to be evaluated during
compilation of a program.
-@defspec eval-and-compile body@dots{}
+@defmac eval-and-compile body@dots{}
This form marks @var{body} to be evaluated both when you compile the
containing code and when you run it (whether compiled or not).
@@ -386,9 +386,9 @@ If functions are defined programmatically (with @code{fset} say), then
@code{eval-and-compile} can be used to have that done at compile-time
as well as run-time, so calls to those functions are checked (and
warnings about ``not known to be defined'' suppressed).
-@end defspec
+@end defmac
-@defspec eval-when-compile body@dots{}
+@defmac eval-when-compile body@dots{}
This form marks @var{body} to be evaluated at compile time but not when
the compiled program is loaded. The result of evaluation by the
compiler becomes a constant which appears in the compiled program. If
@@ -434,7 +434,7 @@ with other versions of Emacs.
Lisp idiom @code{(eval-when (compile eval) @dots{})}. Elsewhere, the
Common Lisp @samp{#.} reader macro (but not when interpreting) is closer
to what @code{eval-when-compile} does.
-@end defspec
+@end defmac
@node Compiler Errors
@section Compiler Errors
@@ -793,3 +793,251 @@ The @code{silly-loop} function is somewhat more complex:
17 return ; @r{Return value of the top of stack.}
@end group
@end example
+
+@node Native Compilation
+@chapter Compilation of Lisp to Native Code
+@cindex native compilation
+@cindex compilation to native code (Emacs Lisp)
+
+@cindex native code
+ In addition to the byte-compilation, described in @ref{Byte
+Compilation, the previous chapter}, Emacs can also optionally compile
+Lisp function definitions into a true compiled code, known as
+@dfn{native code}. This feature uses the @file{libgccjit} library,
+which is part of the GCC distribution, and requires that Emacs be
+built with support for using that library. It also requires to have
+GCC and Binutils (the assembler and linker) available on your system
+for you to be able to native-compile Lisp code.
+
+@vindex native-compile@r{, a Lisp feature}
+ To determine whether the current Emacs process can produce and load
+natively-compiled Lisp code, test whether the @code{native-compile}
+feature is available (@pxref{Named Features}). Alternatively, call
+@code{native-comp-available-p} (@pxref{Native-Compilation Functions}).
+
+ Unlike byte-compiled code, natively-compiled Lisp code is executed
+directly by the machine's hardware, and therefore runs at full speed
+that the host CPU can provide. The resulting speedup generally
+depends on what the Lisp code does, but is usually 2.5 to 5 times
+faster than the corresponding byte-compiled code.
+
+ Since native code is generally incompatible between different
+systems, the natively-compiled code is @emph{not} transportable from
+one machine to another, it can only be used on the same machine where
+it was produced or on very similar ones (having the same CPU and
+run-time libraries). The transportability of natively-compiled code
+is the same as that of shared libraries (@file{.so} or @file{.dll}
+files).
+
+ Libraries of natively-compiled code include crucial dependencies on
+Emacs Lisp primitives (@pxref{What Is a Function}) and their calling
+conventions, and thus Emacs usually won't load natively-compiled code
+produced by earlier or later Emacs versions; native compilation of the
+same Lisp code by a different Emacs version will usually produce a
+natively-compiled library under a unique file name that only that
+version of Emacs will be able to load. However, the use of unique
+file names allows to have in the same directory several versions of
+the same Lisp library natively-compiled by several different versions
+of Emacs.
+
+@vindex no-native-compile
+ A non-@code{nil} file-local variable binding of
+@code{no-byte-compile} (@pxref{Byte Compilation}) also disables the
+native compilation of that file. In addition, a similar variable
+@code{no-native-compile} disables just the native compilation of the
+file. If both @code{no-byte-compile} and @code{no-native-compile} are
+specified, the former takes precedence.
+
+@menu
+* Native-Compilation Functions:: Functions to natively-compile Lisp.
+* Native-Compilation Variables:: Variables controlling native compilation.
+@end menu
+
+@node Native-Compilation Functions
+@section Native-Compilation Functions
+@cindex native-compilation functions
+
+ Native-Compilation is implemented as a side effect of
+byte-compilation (@pxref{Byte Compilation}). Thus, compiling Lisp
+code natively always produces its byte code as well, and therefore all
+the rules and caveats of preparing Lisp code for byte compilation
+(@pxref{Compilation Functions}) are valid for native-compilation as
+well.
+
+ You can natively-compile either a single function or macro
+definition, or a whole file of Lisp code, with the
+@code{native-compile} function. Natively-compiling a file will
+produce both the corresponding @file{.elc} file with byte code and the
+@file{.eln} file with native code.
+
+@findex native-comp-limple-mode
+@vindex native-comp-verbose
+ Native compilation might produce warning or error messages; these
+are normally recorded in the buffer called
+@file{*Native-compile-Log*}. In interactive sessions, it uses the
+special LIMPLE mode (@code{native-comp-limple-mode}), which sets up
+@code{font-lock} as appropriate for this log, and is otherwise the
+same as Fundamental mode. Logging of messages resulting from
+native-compilation can be controlled by the @code{native-comp-verbose}
+variable (@pxref{Native-Compilation Variables}).
+
+ When Emacs is run non-interactively, messages produced by
+native-compilation are reported by calling @code{message}
+(@pxref{Displaying Messages}), and are usually displayed on the
+standard error stream of the terminal from which Emacs was invoked.
+
+@defun native-compile function-or-file &optional output
+This function compiles @var{function-or-file} into native code. The
+argument @var{function-or-file} can be a function symbol, a Lisp form,
+or a name (a string) of the file which contains the Emacs Lisp source
+code to compile. If the optional argument @var{output} is provided,
+it must be a string specifying the name of the file to write the
+compiled code into. Otherwise, if @var{function-or-file} is a
+function or a Lisp form, this function returns the compiled object,
+and if @var{function-or-file} is a file name, the function returns the
+full absolute name of the file it created for the compiled code. The
+output file is by default given the @file{.eln} extension.
+
+This function runs the final phase of the native compilation, which
+invokes GCC via @file{libgccjit}, in a separate subprocess, which
+invokes the same Emacs executable as the process that called this
+function.
+@end defun
+
+@defun batch-native-compile
+This function runs native-compilation on files specified on the Emacs
+command line in batch mode. It must be used only in a batch execution
+of Emacs, as it kills Emacs upon completion of the compilation. If
+one or more of the files fail to compile, the Emacs process will
+attempt to compile all the other files, and will terminate with a
+non-zero status code.
+@end defun
+
+Native compilation can be run entirely asynchronously, in a subprocess
+of the main Emacs process. This leaves the main Emacs process free to
+use while the compilation runs in the background. This is the method
+used by Emacs to natively-compile any Lisp file or byte-compiled Lisp
+file that is loaded into Emacs, when no natively-compiled file for it
+is available.
+
+@defun native-compile-async files &optional recursively load selector
+This function compiles the named @var{files} asynchronously. The
+argument @var{files} should be a single file name (a string) or a list
+of one or more file and/or directory names. If directories are
+present in the list, the optional argument @var{recursively} should be
+non-@code{nil} to cause the compilation to recurse into those
+directories. If @var{load} is non-@code{nil}, Emacs will load each
+file that it succeeded to compile. The optional argument
+@var{selector} allows control of which of @var{files} will be
+compiled; it can have one of the following values:
+
+@table @asis
+@item @code{nil} or omitted
+Select all the files and directories in @var{files}.
+@item a regular expression string
+Select the files and directories whose names match the regexp.
+@item a function
+A predicate function, which will be called with each file and
+directory in @var{files}, and should return non-@code{nil} if the file
+or the directory should be selected for compilation.
+@end table
+
+On systems with multiple CPU execution units, when @var{files} names
+more than one file, this function will normally start several
+compilation subprocesses in parallel, under the control of
+@code{native-comp-async-jobs-number} (@pxref{Native-Compilation
+Variables}).
+@end defun
+
+ The following function allows Lisp programs to test whether
+native-compilation is available at runtime.
+
+@defun native-comp-available-p
+This function returns non-@code{nil} if the running Emacs process has
+the native-compilation support compiled into it. On systems that load
+@file{libgccjit} dynamically, it also makes sure that library is
+available and can be loaded. Lisp programs that need to know up front
+whether native-compilation is available should use this predicate.
+@end defun
+
+@node Native-Compilation Variables
+@section Native-Compilation Variables
+@cindex native-compilation variables
+
+ This section documents the variables that control
+native-compilation.
+
+@defopt native-comp-speed
+This variable specifies the optimization level for native compilation.
+Its value should be a number between @minus{}1 and 3. Values between
+0 and 3 specify the optimization levels equivalent to the
+corresponding compiler @option{-O0}, @option{-O1}, etc.@: command-line
+options of the compiler. The value @minus{}1 means disable
+native-compilation; functions and files will be only byte-compiled.
+The default value is 2.
+@end defopt
+
+@defopt native-comp-debug
+This variable specifies the level of debugging information produced by
+native-compilation. Its value should be a number between zero and 3,
+with the following meaning:
+
+@table @asis
+@item 0
+No debugging output. This is the default.
+@item 1
+Emit debugging symbols with the native code. This allows easier
+debugging of the native code with debuggers such as @command{gdb}.
+@item 2
+Like 1, and in addition dump pseudo-C code.
+@item 3
+Like 2, and in addition dump the GCC intermediate passes and
+@file{libgccjit} log file.
+@end table
+@end defopt
+
+@defopt native-comp-verbose
+This variable controls the verbosity of native-compilation by
+suppressing some or all of the log messages emitted by it. If its
+value is zero, the default, all of the log messages are suppressed.
+Setting it to a value between 1 and 3 will allow logging of the
+messages whose level is above the value. The values have the
+following interpretations:
+
+@table @asis
+@item 0
+No logging. This is the default.
+@item 1
+Log the final @acronym{LIMPLE} representation of the code.
+@item 2
+Log the @acronym{LAP}, the final @acronym{LIMPLE}, and some additional
+pass info.
+@item 3
+Maximum verbosity: log everything.
+@end table
+@end defopt
+
+@defopt native-comp-async-jobs-number
+This variable determines the maximum number of native-compilation
+subprocesses that will be started simultaneously. It should be a
+non-negative number. The default value is zero, which means use half
+the number of the CPU execution units, or 1 if the CPU has only one
+execution unit.
+@end defopt
+
+@defopt native-comp-async-report-warnings-errors
+If this variable's value is non-@code{nil}, warnings and errors from
+asynchronous native-compilation subprocesses are reported in the main
+Emacs session in a buffer named @file{*Warnings*}. The default value
+@code{t} means display the resulting buffer. To log warnings without
+popping up the @file{*Warnings*} buffer, set this variable to
+@code{silent}.
+@end defopt
+
+@defopt native-comp-async-query-on-exit
+If this variable's value is non-nil, Emacs will query upon exiting
+whether to exit and kill any asynchronous native-compilation
+subprocesses that are still running, thus preventing the corresponding
+@file{.eln} files from being written. If the value is @code{nil}, the
+default, Emacs will kill these subprocesses without querying.
+@end defopt
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 80e9eb7dd8e..aacf66c5cf8 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -555,6 +555,16 @@ Two symbols to avoid are @code{t}, which behaves like @code{_}
Likewise, it makes no sense to bind keyword symbols
(@pxref{Constant Variables}).
+@item (cl-type @var{type})
+Matches if @var{expval} is of type @var{type}, which is a type
+descriptor as accepted by @code{cl-typep} (@pxref{cl-typep,,,cl,Common
+Lisp Extensions}). Examples:
+
+@lisp
+(cl-type integer)
+(cl-type (integer 0 10))
+@end lisp
+
@item (pred @var{function})
Matches if the predicate @var{function} returns non-@code{nil}
when called on @var{expval}. The test can be negated with the syntax
@@ -617,17 +627,13 @@ match, @code{and} matches.
@item (or @var{pattern1} @var{pattern2}@dots{})
Attempts to match @var{pattern1}, @var{pattern2}, @dots{}, in order,
until one of them succeeds. In that case, @code{or} likewise matches,
-and the rest of the sub-patterns are not tested. (Note that there
-must be at least two sub-patterns.
-Simply @w{@code{(or @var{pattern1})}} signals error.)
-@c Issue: Is this correct and intended?
-@c Are there exceptions, qualifications?
-@c (Btw, ``Please avoid it'' is a poor error message.)
+and the rest of the sub-patterns are not tested.
To present a consistent environment (@pxref{Intro Eval})
to @var{body-forms} (thus avoiding an evaluation error on match),
-if any of the sub-patterns let-binds a set of symbols,
-they @emph{must} all bind the same set of symbols.
+the set of variables bound by the pattern is the union of the
+variables bound by each sub-pattern. If a variable is not bound by
+the sub-pattern that matched, then it is bound to @code{nil}.
@ifnottex
@anchor{rx in pcase}
@@ -1306,6 +1312,10 @@ element of @var{list}. The bindings are performed as if by
up being equivalent to @code{dolist} (@pxref{Iteration}).
@end defmac
+@defmac pcase-setq pattern value@dots{}
+Assign values to variables in a @code{setq} form, destructuring each
+@var{value} according to its respective @var{pattern}.
+@end defmac
@node Iteration
@section Iteration
@@ -2016,7 +2026,8 @@ that can be handled).
This special form establishes the error handlers @var{handlers} around
the execution of @var{protected-form}. If @var{protected-form} executes
without error, the value it returns becomes the value of the
-@code{condition-case} form; in this case, the @code{condition-case} has
+@code{condition-case} form (in the absence of a success handler; see below).
+In this case, the @code{condition-case} has
no effect. The @code{condition-case} form makes a difference when an
error occurs during @var{protected-form}.
@@ -2066,6 +2077,12 @@ error description.
If @var{var} is @code{nil}, that means no variable is bound. Then the
error symbol and associated data are not available to the handler.
+@cindex success handler
+As a special case, one of the @var{handlers} can be a list of the
+form @code{(:success @var{body}@dots{})}, where @var{body} is executed
+with @var{var} (if non-@code{nil}) bound to the return value of
+@var{protected-form} when that expression terminates without error.
+
@cindex rethrow a signal
Sometimes it is necessary to re-throw a signal caught by
@code{condition-case}, for some outer-level handler to catch. Here's
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 8fd12f79026..bc35982c172 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -1474,7 +1474,7 @@ To protect against loading themes containing malicious code, Emacs
displays the source file and asks for confirmation from the user
before loading any non-built-in theme for the first time. As
such, themes are not ordinarily byte-compiled, and source files
-always take precedence when Emacs is looking for a theme to load.
+usually take precedence when Emacs is looking for a theme to load.
The following functions are useful for programmatically enabling and
disabling themes:
@@ -1508,6 +1508,30 @@ confirmation before loading the theme, unless the optional argument
@var{no-confirm} is non-@code{nil}.
@end deffn
+@defun require-theme feature &optional noerror
+This function searches @code{custom-theme-load-path} for a file that
+provides @var{feature} and then loads it. This is like the function
+@code{require} (@pxref{Named Features}), except it searches
+@code{custom-theme-load-path} instead of @code{load-path}
+(@pxref{Library Search}). This can be useful in Custom themes that
+need to load supporting Lisp files when @code{require} is unsuitable
+for that.
+
+If @var{feature}, which should be a symbol, is not already present in
+the current Emacs session according to @code{featurep}, then
+@code{require-theme} searches for a file named @var{feature} with an
+added @samp{.elc} or @samp{.el} suffix, in that order, in the
+directories specified by @code{custom-theme-load-path}.
+
+If a file providing @var{feature} is successfully found and loaded,
+then @code{require-theme} returns @var{feature}. The optional
+argument @var{noerror} determines what happens if the search or
+loading fails. If it is @code{nil}, the function signals an error;
+otherwise, it returns @code{nil}. If the file loads successfully but
+does not provide @var{feature}, then @code{require-theme} signals an
+error; this cannot be suppressed.
+@end defun
+
@deffn Command enable-theme theme
This function enables the Custom theme named @var{theme}. It signals
an error if no such theme has been loaded.
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 8e4b0ebfe96..e458d76d5d0 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -997,11 +997,12 @@ start looking for ways to optimize that piece.
@findex profiler-report
@findex profiler-stop
Emacs has built-in support for this. To begin profiling, type
-@kbd{M-x profiler-start}. You can choose to profile by processor
-usage, memory usage, or both. Then run the code you'd like to speed
-up. After that, type @kbd{M-x profiler-report} to display a summary
-buffer for each resource (cpu and memory) that you chose to profile.
-The names of the report buffers include the times at which the reports
+@w{@kbd{M-x profiler-start}}. You can choose to sample CPU usage
+periodically (@code{cpu}), when memory is allocated (@code{memory}),
+or both. Then run the code you'd like to speed up. After that, type
+@kbd{M-x profiler-report} to display a summary buffer for CPU usage
+sampled by each type (cpu and memory) that you chose to profile. The
+names of the report buffers include the times at which the reports
were generated, so you can generate another report later on without
erasing previous results. When you have finished profiling, type
@kbd{M-x profiler-stop} (there is a small overhead associated with
@@ -1009,7 +1010,7 @@ profiling, so we don't recommend leaving it active except when you are
actually running the code you want to examine).
The profiler report buffer shows, on each line, a function that was
-called, preceded by how much resources (cpu or memory) it used in
+called, preceded by how much CPU resources it used in
absolute and percentage terms since profiling started. If a given
line has a @samp{+} symbol to the left of the function name, you can
expand that line by typing @kbd{@key{RET}}, in order to see the
@@ -1041,7 +1042,8 @@ functions written in Lisp, it cannot profile Emacs primitives.
@cindex @file{benchmark.el}
@cindex benchmarking
You can measure the time it takes to evaluate individual Emacs Lisp
-forms using the @file{benchmark} library. See the macros
+forms using the @file{benchmark} library. See the function
+@code{benchmark-call} as well as the macros
@code{benchmark-run}, @code{benchmark-run-compiled} and
@code{benchmark-progn} in @file{benchmark.el}. You can also use the
@code{benchmark} command for timing forms interactively.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 93e935ccf86..7ab2896778d 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -646,9 +646,9 @@ If the value is zero, then command input is not echoed.
@defvar message-truncate-lines
Normally, displaying a long message resizes the echo area to display
-the entire message. But if the variable @code{message-truncate-lines}
-is non-@code{nil}, the echo area does not resize, and the message is
-truncated to fit it.
+the entire message, wrapping long line as needed. But if the variable
+@code{message-truncate-lines} is non-@code{nil}, long lines of
+echo-area message are instead truncated to fit the mini-window width.
@end defvar
The variable @code{max-mini-window-height}, which specifies the
@@ -1861,9 +1861,12 @@ from the buffer.
@item keymap
@cindex keymap of character (and overlays)
@kindex keymap @r{(overlay property)}
-If this property is non-@code{nil}, it specifies a keymap for a portion of the
-text. This keymap is used when the character after point is within the
-overlay, and takes precedence over most other keymaps. @xref{Active Keymaps}.
+If this property is non-@code{nil}, it specifies a keymap for a
+portion of the text. This keymap takes precedence over most other
+keymaps (@pxref{Active Keymaps}), and it is used when point is within
+the overlay, where the front-
+and rear-advance properties define whether the boundaries are
+considered as being @emph{within} or not.
@item local-map
@kindex local-map @r{(overlay property)}
@@ -1914,7 +1917,8 @@ This function returns a list of the overlays that overlap the region
contains one or more characters in the region; empty overlays
(@pxref{Managing Overlays, empty overlay}) overlap if they are at
@var{beg}, strictly between @var{beg} and @var{end}, or at @var{end}
-when @var{end} denotes the position at the end of the buffer.
+when @var{end} denotes the position at the end of the accessible part
+of the buffer.
@end defun
@defun next-overlay-change pos
@@ -1965,9 +1969,18 @@ Tables}). The width of a tab character is usually @code{tab-width}
(@pxref{Usual Display}).
@end defun
-@defun string-width string
+@defun string-width string &optional from to
This function returns the width in columns of the string @var{string},
if it were displayed in the current buffer and the selected window.
+Optional arguments @var{from} and @var{to} specify the substring of
+@var{string} to consider, and are interpreted as in @code{substring}
+(@pxref{Creating Strings}).
+
+The return value is an approximation: it only considers the values
+returned by @code{char-width} for the constituent characters, always
+takes a tab character as taking @code{tab-width} columns, ignores
+display properties and fonts, etc. For these reasons, we recommend
+using @code{window-text-pixel-size}, described below, instead.
@end defun
@defun truncate-string-to-width string width &optional start-column padding ellipsis ellipsis-text-property
@@ -1997,7 +2010,7 @@ the beginning of the result if a multi-column character in
If @var{ellipsis} is non-@code{nil}, it should be a string which will
replace the end of @var{string} when it is truncated. In this case,
-more charcaters will be removed from @var{string} to free enough space
+more characters will be removed from @var{string} to free enough space
for @var{ellipsis} to fit within @var{width} columns. However, if
the display width of @var{string} is less than the display width of
@var{ellipsis}, @var{ellipsis} will not be appended to the result. If
@@ -2998,9 +3011,10 @@ This function returns non-@code{nil} if face @var{face} specifies
a non-@code{nil} @code{:inverse-video} attribute.
@end defun
-@defun face-extend-p face &optional frame
+@defun face-extend-p face &optional frame inherit
This function returns non-@code{nil} if face @var{face} specifies
-a non-@code{nil} @code{:extend} attribute.
+a non-@code{nil} @code{:extend} attribute. The @var{inherit} argument
+is passed to @code{face-attribute}.
@end defun
@@ -4752,6 +4766,7 @@ window on a minibuffer-less frame.
@node Display Property
@section The @code{display} Property
@cindex display specification
+@cindex display property
@kindex display @r{(text property)}
The @code{display} text property (or overlay property) is used to
@@ -5289,6 +5304,16 @@ where @var{props} is a property list of alternating keyword symbols
and values, including at least the pair @code{:type @var{type}} that
specifies the image type.
+ Image descriptors which define image dimensions, @code{:width},
+@code{:height}, @code{:max-width} and @code{:max-height}, may take
+either an integer, which represents the dimension in pixels, or a pair
+@code{(@var{value} . em)}, where @var{value} is the dimension's
+length in @dfn{ems}@footnote{In typography an em is a distance
+equivalent to the height of the type. For example when using 12 point
+type 1 em is equal to 12 points. Its use ensures distances and type
+remain proportional.}. One em is equivalent to the height of the font
+and @var{value} may be an integer or a float.
+
The following is a list of properties that are meaningful for all
image types (there are also properties which are meaningful only for
certain image types, as documented in the following subsections):
@@ -5392,6 +5417,21 @@ are supported, unless the image type is @code{imagemagick}. Positive
values rotate clockwise, negative values counter-clockwise. Rotation
is performed after scaling and cropping.
+@item :transform-smoothing @var{smooth}
+If this is @code{t}, any image transform will have smoothing applied;
+if @code{nil}, no smoothing will be applied. The exact algorithm used
+is platform dependent, but should be equivalent to bilinear
+filtering. Disabling smoothing will use the nearest neighbor
+algorithm.
+
+If this property is not specified, @code{create-image} will use the
+@code{image-transform-smoothing} user option to say whether scaling
+should be done or not. This option can be @code{nil} (no smoothing),
+@code{t} (use smoothing) or a predicate function that's called with
+the image object as the only parameter, and should return either
+@code{nil} or @code{t}. The default is for down-scaling to apply
+smoothing, and for large up-scaling to not apply smoothing.
+
@item :index @var{frame}
@xref{Multi-Frame Images}.
@@ -5736,6 +5776,28 @@ Cropping is performed after scaling but before rotation.
@cindex SVG images
SVG (Scalable Vector Graphics) is an XML format for specifying images.
+SVG images support the following additional image descriptor
+properties:
+
+@table @code
+@item :foreground @var{foreground}
+@var{foreground}, if non-@code{nil}, should be a string specifying a
+color, which is used as the image's foreground color. If the value is
+@code{nil}, it defaults to the current face's foreground color.
+
+@item :background @var{background}
+@var{background}, if non-@code{nil}, should be a string specifying a
+color, which is used as the image's background color if the image
+supports transparency. If the value is @code{nil}, it defaults to the
+current face's background color.
+
+@item :css @var{css}
+@var{css}, if non-@code{nil}, should be a string specifying the CSS to
+override the default CSS used when generating the image.
+@end table
+
+@subsubheading SVG library
+
If your Emacs build has SVG support, you can create and manipulate
these images with the following functions from the @file{svg.el}
library.
@@ -7041,11 +7103,11 @@ end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
is skipped over. Returns the button found, and signals an error if no
-buttons can be found. If @var{no-error} in non-@code{nil}, return nil
+buttons can be found. If @var{no-error} is non-@code{nil}, return nil
instead of signaling the error.
@end deffn
-@deffn Command backward-button n &optional wrap display-message
+@deffn Command backward-button n &optional wrap display-message no-error
Move to the @var{n}th previous button, or @var{n}th next button if
@var{n} is negative. If @var{n} is zero, move to the start of any
button at point. If @var{wrap} is non-@code{nil}, moving past either
@@ -7053,7 +7115,7 @@ end of the buffer continues from the other end. If
@var{display-message} is non-@code{nil}, the button's help-echo string
is displayed. Any button with a non-@code{nil} @code{skip} property
is skipped over. Returns the button found, and signals an error if no
-buttons can be found. If @var{no-error} in non-@code{nil}, return nil
+buttons can be found. If @var{no-error} is non-@code{nil}, return nil
instead of signaling the error.
@end deffn
@@ -7558,7 +7620,7 @@ Chars}.
The above display conventions apply even when there is a display
table, for any character whose entry in the active display table is
@code{nil}. Thus, when you set up a display table, you need only
-specify the characters for which you want special behavior.
+specify the characters for which you want special display behavior.
The following variables affect how certain characters are displayed
on the screen. Since they change the number of columns the characters
@@ -7592,7 +7654,8 @@ command @code{tab-to-tab-stop}. @xref{Indent Tabs}.
(@pxref{Char-Tables}), with @code{display-table} as its subtype, which
is used to override the usual character display conventions. This
section describes how to make, inspect, and assign elements to a
-display table object.
+display table object. The next section (@pxref{Active Display Table})
+describes the various standard display tables and their precedence.
@defun make-display-table
This creates and returns a display table. The table initially has
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 569545d83f1..323130f2378 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1203,7 +1203,7 @@ define Edebug specifications for special forms implemented in C.
@defmac def-edebug-spec macro specification
Specify which expressions of a call to macro @var{macro} are forms to be
-evaluated. @var{specification} should be the edebug specification.
+evaluated. @var{specification} should be the Edebug specification.
Neither argument is evaluated.
The @var{macro} argument can actually be any symbol, not just a macro
@@ -1290,14 +1290,6 @@ Short for @code{&rest form}. See @code{&rest} below. If your macro
wraps its body of code with @code{lambda} before it is evaluated, use
@code{def-body} instead. See @code{def-body} below.
-@item function-form
-A function form: either a quoted function symbol, a quoted lambda
-expression, or a form (that should evaluate to a function symbol or
-lambda expression). This is useful when an argument that's a lambda
-expression might be quoted with @code{quote} rather than
-@code{function}, since it instruments the body of the lambda expression
-either way.
-
@item lambda-expr
A lambda expression with no quoting.
@@ -1370,6 +1362,21 @@ is primarily used to generate more specific syntax error messages. See
edebug-spec; it aborts the instrumentation, displaying the message in
the minibuffer.
+@item &interpose
+Lets a function control the parsing of the remaining code.
+It takes the form @code{&interpose @var{spec} @var{fun} @var{args...}}
+and means that Edebug will first match @var{spec} against the code and
+then call @var{fun} with the code that matched @code{spec}, a parsing
+function @var{pf}, and finally @var{args...}. The parsing
+function expects a single argument indicating the specification list
+to use to parse the remaining code. It should be called exactly once
+and returns the instrumented code that @var{fun} is expected to return.
+For example @code{(&interpose symbolp pcase--match-pat-args)} matches
+sexps whose first element is a symbol and then lets
+@code{pcase--match-pat-args} lookup the specs associated
+with that head symbol according to @code{pcase--match-pat-args} and
+pass them to the @var{pf} it received as argument.
+
@item @var{other-symbol}
@cindex indirect specifications
Any other symbol in a specification list may be a predicate or an
@@ -1378,8 +1385,13 @@ indirect specification.
If the symbol has an Edebug specification, this @dfn{indirect
specification} should be either a list specification that is used in
place of the symbol, or a function that is called to process the
-arguments. The specification may be defined with @code{def-edebug-spec}
-just as for macros. See the @code{defun} example.
+arguments. The specification may be defined with
+@code{def-edebug-elem-spec}:
+
+@defun def-edebug-elem-spec element specification
+Define the @var{specification} to use in place of the symbol @var{element}.
+@var{specification} has to be a list.
+@end defun
Otherwise, the symbol should be a predicate. The predicate is called
with the argument, and if the predicate returns @code{nil}, the
@@ -1428,29 +1440,23 @@ Here is a list of additional specifications that may appear only after
@code{&define}. See the @code{defun} example.
@table @code
+@item &name
+Extracts the name of the current defining form from the code.
+It takes the form @code{&name [@var{prestring}] @var{spec}
+[@var{poststring}] @var{fun} @var{args...}} and means that Edebug will
+match @var{spec} against the code and then call @var{fun} with the
+concatenation of the current name, @var{args...}, @var{prestring},
+the code that matched @code{spec}, and @var{poststring}. If @var{fun}
+is absent, it defaults to a function that concatenates the arguments
+(with an @code{@@} between the previous name and the new).
+
@item name
The argument, a symbol, is the name of the defining form.
+Shorthand for @code{[&name symbolp]}.
A defining form is not required to have a name field; and it may have
multiple name fields.
-@item :name
-This construct does not actually match an argument. The element
-following @code{:name} should be a symbol; it is used as an additional
-name component for the definition. You can use this to add a unique,
-static component to the name of the definition. It may be used more
-than once.
-
-@item :unique
-This construct is like @code{:name}, but generates unique names. It
-does not match an argument. The element following @code{:unique}
-should be a string; it is used as the prefix for an additional name
-component for the definition. You can use this to add a unique,
-dynamic component to the name of the definition. This is useful for
-macros that can define the same symbol multiple times in different
-scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may
-be used more than once.
-
@item arg
The argument, a symbol, is the name of an argument of the defining form.
However, lambda-list keywords (symbols starting with @samp{&})
@@ -1504,11 +1510,11 @@ form specifications (that is, @code{form}, @code{body}, @code{def-form}, and
must be in the form itself rather than at a higher level.
Backtracking is also disabled after successfully matching a quoted
-symbol or string specification, since this usually indicates a
-recognized construct. But if you have a set of alternative constructs that
-all begin with the same symbol, you can usually work around this
-constraint by factoring the symbol out of the alternatives, e.g.,
-@code{["foo" &or [first case] [second case] ...]}.
+symbol, string specification, or @code{&define} keyword, since this
+usually indicates a recognized construct. But if you have a set of
+alternative constructs that all begin with the same symbol, you can
+usually work around this constraint by factoring the symbol out of the
+alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}.
Most needs are satisfied by these two ways that backtracking is
automatically disabled, but occasionally it is useful to explicitly
@@ -1557,14 +1563,14 @@ specification for @code{defmacro} is very similar to that for
[&optional ("interactive" interactive)]
def-body))
-(def-edebug-spec lambda-list
- (([&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg]
- )))
+(def-edebug-elem-spec 'lambda-list
+ '(([&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )))
-(def-edebug-spec interactive
- (&optional &or stringp def-form)) ; @r{Notice: @code{def-form}}
+(def-edebug-elem-spec 'interactive
+ '(&optional &or stringp def-form)) ; @r{Notice: @code{def-form}}
@end smallexample
The specification for backquote below illustrates how to match
@@ -1577,11 +1583,11 @@ could fail.)
@smallexample
(def-edebug-spec \` (backquote-form)) ; @r{Alias just for clarity.}
-(def-edebug-spec backquote-form
- (&or ([&or "," ",@@"] &or ("quote" backquote-form) form)
- (backquote-form . [&or nil backquote-form])
- (vector &rest backquote-form)
- sexp))
+(def-edebug-elem-spec 'backquote-form
+ '(&or ([&or "," ",@@"] &or ("quote" backquote-form) form)
+ (backquote-form . [&or nil backquote-form])
+ (vector &rest backquote-form)
+ sexp))
@end smallexample
@@ -1624,10 +1630,10 @@ option. @xref{Instrumenting}.
@defopt edebug-eval-macro-args
When this is non-@code{nil}, all macro arguments will be instrumented
-in the generated code. For any macro, an @code{edebug-form-spec}
+in the generated code. For any macro, the @code{debug} declaration
overrides this option. So to specify exceptions for macros that have
-some arguments evaluated and some not, use @code{def-edebug-spec} to
-specify an @code{edebug-form-spec}.
+some arguments evaluated and some not, use the @code{debug} declaration
+specify an Edebug form specification.
@end defopt
@defopt edebug-save-windows
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 12255d122f9..55bcf399d81 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -197,6 +197,7 @@ To view this manual in other formats, click
* Loading:: Reading files of Lisp code into Lisp.
* Byte Compilation:: Compilation makes programs run faster.
+* Native Compilation:: Compile Lisp into native machine code.
* Debugging:: Tools and tips for debugging Lisp programs.
* Read and Print:: Converting Lisp objects to text and back.
@@ -531,6 +532,7 @@ Scoping Rules for Variable Bindings
* Dynamic Binding Tips:: Avoiding problems with dynamic binding.
* Lexical Binding:: A different type of local variable binding.
* Using Lexical Binding:: How to enable lexical binding.
+* Converting to Lexical Binding:: Convert existing code to lexical binding.
Buffer-Local Variables
@@ -645,6 +647,11 @@ Byte Compilation
* Byte-Code Objects:: The data type used for byte-compiled functions.
* Disassembly:: Disassembling byte-code; how to read byte-code.
+Native Compilation
+
+* Native-Compilation Functions:: Functions to natively-compile Lisp.
+* Native-Compilation Variables:: Variables controlling native compilation.
+
Debugging Lisp Programs
* Debugger:: A debugger for the Emacs Lisp evaluator.
@@ -781,6 +788,7 @@ Defining Commands
* Interactive Codes:: The standard letter-codes for reading arguments
in various ways.
* Interactive Examples:: Examples of how to read interactive arguments.
+* Command Modes:: Specifying that commands are for a specific mode.
* Generic Commands:: Select among command alternatives.
@@ -1408,8 +1416,9 @@ Low-Level Network Access
Packing and Unpacking Byte Arrays
-* Bindat Spec:: Describing data layout.
+* Bindat Types:: Describing data layout.
* Bindat Functions:: Doing the unpacking and packing.
+* Bindat Computed Types:: Advanced data layout specifications.
Emacs Display
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index fb393b951f1..f848218e267 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -20,8 +20,9 @@ the errors in accessing files have the condition @code{file-error}. If
we do not say here that a certain error symbol has additional error
conditions, that means it has none.
- As a special exception, the error symbol @code{quit} does not have the
-condition @code{error}, because quitting is not considered an error.
+ As a special exception, the error symbols @code{quit} and
+@code{minibuffer-quit} don't have the condition @code{error}, because
+quitting is not considered an error.
Most of these error symbols are defined in C (mainly @file{data.c}),
but some are defined in Lisp. For example, the file @file{userlock.el}
@@ -40,6 +41,10 @@ The message is @samp{error}. @xref{Errors}.
@item quit
The message is @samp{Quit}. @xref{Quitting}.
+@item minibuffer-quit
+The message is @samp{Quit}. This is a subcategory of @code{quit}.
+@xref{Quitting}.
+
@item args-out-of-range
The message is @samp{Args out of range}. This happens when trying to
access an element beyond the range of a sequence, buffer, or other
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 80e038c96d9..7893895eee9 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -332,7 +332,6 @@ or just
The built-in function @code{indirect-function} provides an easy way to
perform symbol function indirection explicitly.
-@c Emacs 19 feature
@defun indirect-function function &optional noerror
@anchor{Definition of indirect-function}
This function returns the meaning of @var{function} as a function. If
@@ -351,7 +350,8 @@ Here is how you could define @code{indirect-function} in Lisp:
@example
(defun indirect-function (function)
- (if (symbolp function)
+ (if (and function
+ (symbolp function))
(indirect-function (symbol-function function))
function))
@end example
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 4110c51099d..266501d46d0 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -455,7 +455,6 @@ Even though this is not a normal hook, you can use @code{add-hook} and
@code{remove-hook} to manipulate the list. @xref{Hooks}.
@end defvar
-@c Emacs 19 feature
@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
@@ -486,7 +485,6 @@ this hook to make sure the file you are saving has the current year in
its copyright notice.
@end defopt
-@c Emacs 19 feature
@defopt after-save-hook
This normal hook runs after a buffer has been saved in its visited file.
@end defopt
@@ -622,7 +620,6 @@ If @var{start} is @code{nil}, then the command writes the entire buffer
contents (@emph{not} just the accessible portion) to the file and
ignores @var{end}.
-@c Emacs 19 feature
If @var{start} is a string, then @code{write-region} writes or appends
that string, rather than text from the buffer. @var{end} is ignored in
this case.
@@ -653,7 +650,6 @@ It also sets the last file modification time for the current buffer to
feature is used by @code{save-buffer}, but you probably should not use
it yourself.
-@c Emacs 19 feature
If @var{visit} is a string, it specifies the file name to visit. This
way, you can write the data to one file (@var{filename}) while recording
the buffer as visiting another file (@var{visit}). The argument
@@ -722,7 +718,7 @@ Emacs can then detect the first attempt to modify a buffer visiting a
file that is locked by another Emacs job, and ask the user what to do.
The file lock is really a file, a symbolic link with a special name,
stored in the same directory as the file you are editing. The name is
-constructed by prepending @file{.#} to the filename of the buffer.
+constructed by prepending @file{.#} to the file name of the buffer.
The target of the symbolic link will be of the form
@code{@var{user}@@@var{host}.@var{pid}:@var{boot}}, where @var{user}
is replaced with the current username (from @code{user-login-name}),
@@ -768,12 +764,28 @@ This function unlocks the file being visited in the current buffer,
if the buffer is modified. If the buffer is not modified, then
the file should not be locked, so this function does nothing. It also
does nothing if the current buffer is not visiting a file, or is not locked.
+This function handles file system errors by calling @code{display-warning}
+and otherwise ignores the error.
@end defun
@defopt create-lockfiles
If this variable is @code{nil}, Emacs does not lock files.
@end defopt
+@defopt lock-file-name-transforms
+By default, Emacs creates the lock files in the same directory as the
+files that are being locked. This can be changed by customizing this
+variable. Is has the same syntax as
+@code{auto-save-file-name-transforms} (@pxref{Auto-Saving}). For
+instance, to make Emacs write all the lock files to @file{/var/tmp/},
+you could say something like:
+
+@lisp
+(setq lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+@end lisp
+@end defopt
+
@defun ask-user-about-lock file other-user
This function is called when the user tries to modify @var{file}, but it
is locked by another user named @var{other-user}. The default
@@ -809,6 +821,16 @@ If you wish, you can replace the @code{ask-user-about-lock} function
with your own version that makes the decision in another way.
@end defun
+@defopt remote-file-name-inhibit-locks
+You can prevent the creation of remote lock files by setting the
+variable @code{remote-file-name-inhibit-locks} to @code{t}.
+@end defopt
+
+@deffn Command lock-file-mode
+This command, called interactively, toggles the local value of
+@code{create-lockfiles} in the current buffer.
+@end deffn
+
@node Information about Files
@section Information about Files
@cindex file, information about
@@ -1934,7 +1956,7 @@ is a symbolic link and @var{flag} is @code{nofollow}.
@defun set-file-extended-attributes filename attribute-alist
This function sets the Emacs-recognized extended file attributes for
-@code{filename}. The second argument @var{attribute-alist} should be
+@var{filename}. The second argument @var{attribute-alist} should be
an alist of the same form returned by @code{file-extended-attributes}.
The return value is @code{t} if the attributes are successfully set,
otherwise it is @code{nil}.
@@ -2131,6 +2153,25 @@ the period that delimits the extension, and if @var{filename} has no
extension, the value is @code{""}.
@end defun
+@defun file-name-with-extension filename extension
+This function returns @var{filename} with its extension set to
+@var{extension}. A single leading dot in the @var{extension} will be
+stripped if there is one. For example:
+
+@example
+(file-name-with-extension "file" "el")
+ @result{} "file.el"
+(file-name-with-extension "file" ".el")
+ @result{} "file.el"
+(file-name-with-extension "file.c" "el")
+ @result{} "file.el"
+@end example
+
+Note that this function will error if @var{filename} or
+@var{extension} are empty, or if the @var{filename} is shaped like a
+directory (i.e., if @code{directory-name-p} returns non-@code{nil}).
+@end defun
+
@defun file-name-sans-extension filename
This function returns @var{filename} minus its extension, if any. The
version/backup part, if present, is only removed if the file has an
@@ -2246,7 +2287,7 @@ form.
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
+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.
@@ -2302,49 +2343,26 @@ entirely of directory separators.
@end example
@end defun
- Given a directory name, you can combine it with a relative file name
-using @code{concat}:
+@defun file-name-concat directory &rest components
+Concatenate @var{components} to @var{directory}, inserting a slash
+before the components if @var{directory} or the preceding component
+didn't end with a slash.
@example
-(concat @var{dirname} @var{relfile})
-@end example
-
-@noindent
-Be sure to verify that the file name is relative before doing that.
-If you use an absolute file name, the results could be syntactically
-invalid or refer to the wrong file.
-
- If you want to use a directory file name in making such a
-combination, you must first convert it to a directory name using
-@code{file-name-as-directory}:
-
-@example
-(concat (file-name-as-directory @var{dirfile}) @var{relfile})
-@end example
-
-@noindent
-Don't try concatenating a slash by hand, as in
-
-@example
-;;; @r{Wrong!}
-(concat @var{dirfile} "/" @var{relfile})
+@group
+(file-name-concat "/tmp" "foo")
+ @result{} "/tmp/foo"
+@end group
@end example
-@noindent
-because this is not portable. Always use
-@code{file-name-as-directory}.
-
- To avoid the issues mentioned above, or if the @var{dirname} value
-might be @code{nil} (for example, from an element of @code{load-path}),
-use:
-
-@example
-(expand-file-name @var{relfile} @var{dirname})
-@end example
+A @var{directory} or components that are @code{nil} or the empty
+string are ignored---they are filtered out first and do not affect the
+results in any way.
-However, @code{expand-file-name} expands leading @samp{~} in
-@var{relfile}, which may not be what you want. @xref{File Name
-Expansion}.
+This is almost the same as using @code{concat}, but @var{dirname} (and
+the non-final components) may or may not end with slash characters,
+and this function will not double those characters.
+@end defun
To convert a directory name to its abbreviation, use this
function:
@@ -2417,7 +2435,7 @@ 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
+File names containing @samp{.} or @samp{..} are simplified to their
canonical form:
@example
@@ -3094,7 +3112,6 @@ which generate the listing with Lisp code.
@node Create/Delete Dirs
@section Creating, Copying and Deleting Directories
@cindex creating, copying and deleting directories
-@c Emacs 19 features
Most Emacs Lisp file-manipulation functions get errors when used on
files that are directories. For example, you cannot delete a directory
@@ -3257,7 +3274,7 @@ first, before handlers for jobs such as remote file access.
@code{file-equal-p},
@code{file-executable-p}, @code{file-exists-p},
@code{file-in-directory-p},
-@code{file-local-copy},
+@code{file-local-copy}, @code{file-locked-p},
@code{file-modes}, @code{file-name-all-completions},
@code{file-name-as-directory},
@code{file-name-case-insensitive-p},
@@ -3276,10 +3293,11 @@ first, before handlers for jobs such as remote file access.
@code{get-file-buffer},
@code{insert-directory},
@code{insert-file-contents},@*
-@code{load},
+@code{load}, @code{lock-file},
@code{make-auto-save-file-name},
@code{make-directory},
@code{make-directory-internal},
+@code{make-lock-file-name},
@code{make-nearby-temp-file},
@code{make-process},
@code{make-symbolic-link},@*
@@ -3291,6 +3309,7 @@ first, before handlers for jobs such as remote file access.
@code{substitute-in-file-name},@*
@code{temporary-file-directory},
@code{unhandled-file-name-directory},
+@code{unlock-file},
@code{vc-registered},
@code{verify-visited-file-modtime},@*
@code{write-region}.
@@ -3315,7 +3334,7 @@ first, before handlers for jobs such as remote file access.
@code{file-equal-p},
@code{file-executable-p}, @code{file-exists-p},
@code{file-in-directory-p},
-@code{file-local-copy},
+@code{file-local-copy}, @code{file-locked-p},
@code{file-modes}, @code{file-name-all-completions},
@code{file-name-as-directory},
@code{file-name-case-insensitive-p},
@@ -3334,10 +3353,12 @@ first, before handlers for jobs such as remote file access.
@code{get-file-buffer},
@code{insert-directory},
@code{insert-file-contents},
-@code{load},
+@code{load}, @code{lock-file},
@code{make-auto-save-file-name},
@code{make-direc@discretionary{}{}{}tory},
@code{make-direc@discretionary{}{}{}tory-internal},
+@code{make-lock-file-name},
+@code{make-nearby-temp-file},
@code{make-process},
@code{make-symbolic-link},
@code{process-file},
@@ -3346,7 +3367,9 @@ first, before handlers for jobs such as remote file access.
@code{set-visited-file-modtime}, @code{shell-command},
@code{start-file-process},
@code{substitute-in-file-name},
+@code{temporary-file-directory},
@code{unhandled-file-name-directory},
+@code{unlock-file},
@code{vc-regis@discretionary{}{}{}tered},
@code{verify-visited-file-modtime},
@code{write-region}.
@@ -3460,11 +3483,11 @@ identifies the remote system.
This identifier string can include a host name and a user name, as
well as characters designating the method used to access the remote
-system. For example, the remote identifier string for the filename
+system. For example, the remote identifier string for the file name
@code{/sudo::/some/file} is @code{/sudo:root@@localhost:}.
If @code{file-remote-p} returns the same identifier for two different
-filenames, that means they are stored on the same file system and can
+file names, that means they are stored on the same file system and can
be accessed locally with respect to each other. This means, for
example, that it is possible to start a remote process accessing both
files at the same time. Implementers of file name handlers need to
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index f4316b753d8..25706befc8d 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -1120,9 +1120,9 @@ The optional fourth argument @var{pixelwise} non-@code{nil} means that
refuse to truly honor the request if it does not increase/decrease the
frame height to a multiple of its character height.
-When used interactively, this command will set the height of the
-currently selected frame to the number of lines specified by the
-numeric prefix.
+When used interactively, this command will ask the user for the number
+of lines to set the height of the currently selected frame. You can
+also provide this value with a numeric prefix.
@end defun
@defun set-frame-width frame width &optional pretend pixelwise
@@ -1136,9 +1136,9 @@ The optional fourth argument @var{pixelwise} non-@code{nil} means that
refuse to fully honor the request if it does not increase/decrease the
frame width to a multiple of its character width.
-When used interactively, this command will set the width of the
-currently selected frame to the number of columns specified by the
-numeric prefix.
+When used interactively, this command will ask the user for the number
+of columns to set the width of the currently selected frame. You can
+also provide this value with a numeric prefix.
@end defun
None of these three functions will make a frame smaller than needed to
@@ -2023,8 +2023,8 @@ the @sc{cdr} of the cell is either @code{t} or @code{top-only}.
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.
+frame with the mouse by dragging the header or tab 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,
@@ -2041,6 +2041,11 @@ borders, if present, with the mouse.
If non-@code{nil}, the frame can be moved with the mouse by dragging the
header line of its topmost window.
+@vindex drag-with-tab-line@r{, a frame parameter}
+@item drag-with-tab-line
+If non-@code{nil}, the frame can be moved with the mouse by dragging the
+tab line of its topmost window.
+
@vindex drag-with-mode-line@r{, a frame parameter}
@item drag-with-mode-line
If non-@code{nil}, the frame can be moved with the mouse by dragging the
@@ -2628,7 +2633,7 @@ When Emacs gets one of these commands, it generates a
@code{delete-frame} event, whose normal definition is a command that
calls the function @code{delete-frame}. @xref{Misc Events}.
-@deffn Command delete-other-frames &optional frame
+@deffn Command delete-other-frames &optional frame iconify
This command deletes all frames on @var{frame}'s terminal, except
@var{frame}. If @var{frame} uses another frame's minibuffer, that
minibuffer frame is left untouched. The argument @var{frame} must
@@ -2639,6 +2644,9 @@ this command works by calling @code{delete-frame} with @var{force}
This function does not delete any of @var{frame}'s child frames
(@pxref{Child Frames}). If @var{frame} is a child frame, it deletes
@var{frame}'s siblings only.
+
+With the prefix argument @var{iconify}, the frames are iconified rather
+than deleted.
@end deffn
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 414035f684b..77d1465c876 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -863,6 +863,10 @@ This function returns @var{argument} and has no side effects.
This function ignores any @var{arguments} and returns @code{nil}.
@end defun
+@defun always &rest arguments
+This function ignores any @var{arguments} and returns @code{t}.
+@end defun
+
Some functions are user-visible @dfn{commands}, which can be called
interactively (usually by a key sequence). It is possible to invoke
such a command exactly as though it was called interactively, by using
@@ -1177,7 +1181,7 @@ This form defines a method like @code{cl-defmethod} does.
@end table
@end defmac
-@defmac cl-defmethod name [qualifier] arguments [&context (expr spec)@dots{}] &rest [docstring] body
+@defmac cl-defmethod name [extra] [qualifier] arguments [&context (expr spec)@dots{}] &rest [docstring] body
This macro defines a particular implementation for the generic
function called @var{name}. The implementation code is given by
@var{body}. If present, @var{docstring} is the documentation string
@@ -1263,6 +1267,10 @@ Parent type: @code{array}.
@item font-object
@end table
+The optional @var{extra} element, expressed as @samp{:extra
+@var{string}}, allows you to add more methods, distinguished by
+@var{string}, for the same specializers and qualifiers.
+
The optional @var{qualifier} allows combining several applicable
methods. If it is not present, the defined method is a @dfn{primary}
method, responsible for providing the primary implementation of the
@@ -1284,9 +1292,6 @@ This auxiliary method will run @emph{instead} of the primary method.
The most specific of such methods will be run before any other method.
Such methods normally use @code{cl-call-next-method}, described below,
to invoke the other auxiliary or primary methods.
-@item :extra @var{string}
-This allows you to add more methods, distinguished by @var{string},
-for the same specializers and qualifiers.
@end table
Functions defined using @code{cl-defmethod} cannot be made
@@ -2309,6 +2314,16 @@ form @code{(lambda (@var{arg}) @var{body})} in which case that function will
additionally have access to the macro (or function)'s arguments and it will
be passed to @code{gv-define-setter}.
+@item (completion @var{completion-predicate})
+Declare @var{completion-predicate} as a function to determine whether
+to include the symbol in the list of functions when asking for
+completions in @kbd{M-x}. @var{completion-predicate} is called with
+two parameters: The first parameter is the symbol, and the second is
+the current buffer.
+
+@item (modes @var{modes})
+Specify that this command is meant to be applicable for @var{modes}
+only.
@end table
@end defmac
@@ -2406,11 +2421,12 @@ opposed to an unspecified one).
@cindex safety of functions
Some major modes, such as SES, call functions that are stored in user
-files. (@inforef{Top, ,ses}, for more information on SES@.) User
-files sometimes have poor pedigrees---you can get a spreadsheet from
-someone you've just met, or you can get one through email from someone
-you've never met. So it is risky to call a function whose source code
-is stored in a user file until you have determined that it is safe.
+files. (@xref{Top, Simple Emacs Spreadsheet,,ses}, for more
+information on SES@.) User files sometimes have poor pedigrees---you
+can get a spreadsheet from someone you've just met, or you can get one
+through email from someone you've never met. So it is risky to call a
+function whose source code is stored in a user file until you have
+determined that it is safe.
@defun unsafep form &optional unsafep-vars
Returns @code{nil} if @var{form} is a @dfn{safe} Lisp expression, or
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 298bec5230c..a788852de75 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -818,7 +818,7 @@ summaries of using those functions. The optional argument
@var{functions} is a list whose elements are of the form:
@lisp
-(@var{func} @var{keyword} @var{val} @dots{})
+(@var{func} [@var{keyword} @var{val}]@dots{})
@end lisp
The following keywords are recognized:
@@ -839,7 +839,7 @@ evaluated, and the result used. For instance:
@end example
@noindent
-will be printed as
+will result in:
@example
(concat "foo" "bar" "zot")
@@ -866,13 +866,14 @@ should be included.
@end example
@item :no-eval*
-Like @code{:no-eval}, but alaways inserts @samp{[it depends]} as the
-result.
+Like @code{:no-eval}, but always inserts @samp{[it depends]} as the
+result. For instance:
@example
:no-eval* (buffer-string)
@end example
+@noindent
will result in:
@example
@@ -894,17 +895,26 @@ Used to output the result from non-evaluating example forms.
@item :eg-result
Used to output an example result from non-evaluating example forms.
+For instance:
@example
:no-eval (looking-at "f[0-9]")
:eg-result t
@end example
+@noindent
+will result in:
+
+@example
+(looking-at "f[0-9]")
+eg. @click{} t
+@end example
+
@item :result-string
@itemx :eg-result-string
These two are the same as @code{:result} and @code{:eg-result},
respectively, but are inserted as is. This is useful when the result
-is unreadable or should be on a particular form:
+is unreadable or should be of a particular form:
@example
:no-eval (find-file "/tmp/foo")
@@ -951,7 +961,7 @@ sections.
@defun shortdoc-add-function shortdoc-add-function group section elem
Lisp packages can add functions to groups with this command. Each
-@var{elem} should be a function descriptions, as described above.
+@var{elem} should be a function description, as described above.
@var{group} is the function group, and @var{section} is what section
in the function group to insert the function into.
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index b1c7e613719..394928454b0 100644
--- a/doc/lispref/hooks.texi
+++ b/doc/lispref/hooks.texi
@@ -184,7 +184,7 @@ The command loop runs this soon after @code{post-command-hook} (q.v.).
@item mouse-leave-buffer-hook
@vindex mouse-leave-buffer-hook
-Hook run when about to switch windows with a mouse command.
+Hook run when the user mouse-clicks in a window.
@item mouse-position-function
@xref{Mouse Position}.
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 4150a2b21b8..0e250d0f59b 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1429,7 +1429,7 @@ other words, if a module function wants to call Lisp functions or
Emacs primitives, convert @code{emacs_value} objects to and from C
datatypes (@pxref{Module Values}), or interact with Emacs in any other
way, some call from Emacs to @code{emacs_module_init} or to a module
-function must be in the call stack. Module function may not interact
+function must be in the call stack. Module functions may not interact
with Emacs while garbage collection is running; @pxref{Garbage
Collection}. They may only interact with Emacs from Lisp interpreter
threads (including the main thread) created by Emacs; @pxref{Threads}.
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 35f852b7e4b..c2ed96472b9 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -89,7 +89,7 @@ you are criticizing.
@cindex suggestions
Please send comments and corrections using @kbd{M-x
report-emacs-bug}. If you wish to contribute new code (or send a
-patch to fix a problem), use @kbd{M-x submit-emacs-patch}).
+patch to fix a problem), use @kbd{M-x submit-emacs-patch}.
@node Lisp History
@section Lisp History
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 55d179b8753..4097c86f074 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -369,7 +369,6 @@ appear directly as bindings in @var{keymap} are also copied recursively,
and so on to any number of levels. However, recursive copying does not
take place when the definition of a character is a symbol whose function
definition is a keymap; the same symbol appears in the new copy.
-@c Emacs 19 feature
@example
@group
@@ -574,12 +573,6 @@ key.
key.
@item
-@cindex @kbd{M-o}
-@vindex facemenu-keymap
-@code{facemenu-keymap} is the global keymap used for the @kbd{M-o}
-prefix key.
-
-@item
The other Emacs prefix keys are @kbd{C-x @@}, @kbd{C-x a i}, @kbd{C-x
@key{ESC}} and @kbd{@key{ESC} @key{ESC}}. They use keymaps that have
no special names.
@@ -1146,7 +1139,6 @@ and have extra events at the end that do not fit into a single key
sequence. Then the value is a number, the number of events at the front
of @var{key} that compose a complete key.
-@c Emacs 19 feature
If @var{accept-defaults} is non-@code{nil}, then @code{lookup-key}
considers default bindings as well as bindings for the specific events
in @var{key}. Otherwise, @code{lookup-key} reports only bindings for
@@ -1188,7 +1180,6 @@ not cause an error.
This function returns the binding for @var{key} in the current
local keymap, or @code{nil} if it is undefined there.
-@c Emacs 19 feature
The argument @var{accept-defaults} controls checking for default bindings,
as in @code{lookup-key} (above).
@end defun
@@ -1197,12 +1188,10 @@ as in @code{lookup-key} (above).
This function returns the binding for command @var{key} in the
current global keymap, or @code{nil} if it is undefined there.
-@c Emacs 19 feature
The argument @var{accept-defaults} controls checking for default bindings,
as in @code{lookup-key} (above).
@end defun
-@c Emacs 19 feature
@defun minor-mode-key-binding key &optional accept-defaults
This function returns a list of all the active minor mode bindings of
@var{key}. More precisely, it returns an alist of pairs
@@ -1420,7 +1409,6 @@ standard bindings:
@end group
@end smallexample
-@c Emacs 19 feature
If @var{oldmap} is non-@code{nil}, that changes the behavior of
@code{substitute-key-definition}: the bindings in @var{oldmap} determine
which keys to rebind. The rebindings still happen in @var{keymap}, not
@@ -1698,7 +1686,7 @@ presence of such a binding can still prevent translation from taking place.
For example, let us return to our VT100 example above and add a binding for
@kbd{C-c @key{ESC}} to the global map; now when the user hits @kbd{C-c
@key{PF1}} Emacs will fail to decode @kbd{C-c @key{ESC} O P} into @kbd{C-c
-@key{PF1}} because it will stop reading keys right after @kbd{C-x @key{ESC}},
+@key{PF1}} because it will stop reading keys right after @kbd{C-c @key{ESC}},
leaving @kbd{O P} for later. This is in case the user really hit @kbd{C-c
@key{ESC}}, in which case Emacs should not sit there waiting for the next key
to decide whether the user really pressed @kbd{@key{ESC}} or @kbd{@key{PF1}}.
@@ -2932,7 +2920,7 @@ menu item.
@item :active @var{enable}
@var{enable} is an expression; if it evaluates to @code{nil}, the item
-is make unselectable.. @code{:enable} is an alias for @code{:active}.
+is made unselectable. @code{:enable} is an alias for @code{:active}.
@item :visible @var{include}
@var{include} is an expression; if it evaluates to @code{nil}, the
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 2805b1f5fdc..bbe1dce42d8 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1557,10 +1557,12 @@ of property lists and association lists.
@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
-@var{testfn} if it is non-@code{nil} and @code{equal} otherwise
-(@pxref{Equality Predicates}). It returns @code{nil} if no
-association in @var{alist} has a @sc{car} equal to @var{key}. For
-example:
+@var{testfn} if it is a function, and @code{equal} otherwise
+(@pxref{Equality Predicates}). If @var{testfn} is a function, it is
+called with two arguments: the @sc{car} of an element from @var{alist}
+and @var{key}. The function returns @code{nil} if no
+association in @var{alist} has a @sc{car} equal to @var{key}, as
+tested by @var{testfn}. For example:
@smallexample
(setq trees '((pine . cones) (oak . acorns) (maple . seeds)))
@@ -1804,7 +1806,7 @@ through a simple example:
(let-alist colors
(if (eq .rose 'red)
.lily))
-=> white
+ @result{} white
@end lisp
The @var{body} is inspected at compilation time, and only the symbols
@@ -1820,7 +1822,7 @@ Nested association lists is supported:
(let-alist colors
(if (eq .rose 'red)
.lily.belladonna))
-=> yellow
+ @result{} yellow
@end lisp
Nesting @code{let-alist} inside each other is allowed, but the code in
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 22f0dde593a..4d683da1ad3 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -71,7 +71,11 @@ forms in it, and closes the file.
To find the file, @code{load} first looks for a file named
@file{@var{filename}.elc}, that is, for a file whose name is
@var{filename} with the extension @samp{.elc} appended. If such a
-file exists, it is loaded. If there is no file by that name, then
+file exists, and Emacs was compiled with native-compilation support
+(@pxref{Native Compilation}), @code{load} attempts to find a
+corresponding @samp{.eln} file, and if found, loads it instead of
+@file{@var{filename}.elc}. Otherwise, it loads
+@file{@var{filename}.elc}. If there is no file by that name, then
@code{load} looks for a file named @file{@var{filename}.el}. If that
file exists, it is loaded. If Emacs was compiled with support for
dynamic modules (@pxref{Dynamic Modules}), @code{load} next looks for
@@ -109,6 +113,8 @@ explicit directory name.
If the option @code{load-prefer-newer} is non-@code{nil}, then when
searching suffixes, @code{load} selects whichever version of a file
(@samp{.elc}, @samp{.el}, etc.)@: has been modified most recently.
+In this case, @code{load} doesn't load the @samp{.eln}
+natively-compiled file even if it exists.
If @var{filename} is a relative file name, such as @file{foo} or
@file{baz/foo.bar}, @code{load} searches for the file using the variable
@@ -153,7 +159,8 @@ during compilation. @xref{Compiling Macros}.
Messages like @samp{Loading foo...} and @samp{Loading foo...done} appear
in the echo area during loading unless @var{nomessage} is
-non-@code{nil}.
+non-@code{nil}. If a natively-compiled @samp{.eln} file is loaded,
+the message says so.
@cindex load errors
Any unhandled errors while loading a file terminate loading. If the
@@ -430,6 +437,28 @@ optional argument @code{stringp} is non-@code{nil}, it instead returns
the shadowed files as a string.
@end deffn
+ If Emacs was compiled with support for native compilation
+(@pxref{Native Compilation}), then when a @samp{.elc} byte-compiled
+file is found by searching @code{load-path}, Emacs will try to look
+for a corresponding @samp{.eln} file holding the corresponding
+natively-compiled code. The natively-compiled files are looked up in
+the directories listed by the @code{native-comp-eln-load-path}.
+
+@vindex comp-native-version-dir
+@defvar native-comp-eln-load-path
+This variable holds a list of directories where Emacs looks for
+natively-compiled @samp{.eln} files. File names in the list that are
+not absolute are interpreted as relative to @code{invocation-directory}
+(@pxref{System Environment}). The last directory in the list is the
+system directory, i.e.@: the directory with @samp{.eln} files
+installed by the Emacs build and installation procedure. In each of
+the directories in the list, Emacs looks for @samp{.eln} files in a
+subdirectory whose name is constructed from the Emacs version and an
+8-character hash that depends on the current native-compilation
+@acronym{ABI}; the name of this subdirectory is stored in the variable
+@code{comp-native-version-dir}.
+@end defvar
+
@node Loading Non-ASCII
@section Loading Non-@acronym{ASCII} Characters
@cindex loading, and non-ASCII characters
@@ -510,6 +539,9 @@ specification is not given here; it's not needed unless the user
actually calls @var{function}, and when that happens, it's time to load
the real definition.
+If @var{interactive} is a list, it is interpreted as a list of modes
+this command is applicable for.
+
You can autoload macros and keymaps as well as ordinary functions.
Specify @var{type} as @code{macro} if @var{function} is really a macro.
Specify @var{type} as @code{keymap} if @var{function} is really a
@@ -1049,7 +1081,6 @@ rather than replacing that element. @xref{Eval}.
@section Unloading
@cindex unloading packages
-@c Emacs 19 feature
You can discard the functions and variables loaded by a library to
reclaim memory for other Lisp objects. To do this, use the function
@code{unload-feature}:
@@ -1125,7 +1156,7 @@ You don't need to give a directory or extension in the file name
@var{library}. Normally, you just give a bare file name, like this:
@example
-(with-eval-after-load "edebug" (def-edebug-spec c-point t))
+(with-eval-after-load "js" (define-key js-mode-map "\C-c\C-c" 'js-eval))
@end example
To restrict which files can trigger the evaluation, include a
diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi
index e56a85c7478..cf23ecb9d4e 100644
--- a/doc/lispref/macros.texi
+++ b/doc/lispref/macros.texi
@@ -241,7 +241,6 @@ of constants and nonconstant parts. To make this easier, use the
@samp{`} syntax (@pxref{Backquote}). For example:
@example
-@example
@group
(defmacro t-becomes-nil (variable)
`(if (eq ,variable t)
@@ -253,7 +252,6 @@ of constants and nonconstant parts. To make this easier, use the
@equiv{} (if (eq foo t) (setq foo nil))
@end group
@end example
-@end example
@node Problems with Macros
@section Common Problems Using Macros
@@ -480,12 +478,16 @@ in expressions ordinarily.
Another problem can happen if the macro definition itself
evaluates any of the macro argument expressions, such as by calling
-@code{eval} (@pxref{Eval}). If the argument is supposed to refer to the
-user's variables, you may have trouble if the user happens to use a
-variable with the same name as one of the macro arguments. Inside the
-macro body, the macro argument binding is the most local binding of this
-variable, so any references inside the form being evaluated do refer to
-it. Here is an example:
+@code{eval} (@pxref{Eval}). You have to take into account that macro
+expansion may take place long before the code is executed, when the
+context of the caller (where the macro expansion will be evaluated) is
+not yet accessible.
+
+ Also, if your macro definition does not use @code{lexical-binding}, its
+formal arguments may hide the user's variables of the same name. Inside
+the macro body, the macro argument binding is the most local binding of
+such variable, so any references inside the form being evaluated do refer
+to it. Here is an example:
@example
@group
@@ -508,12 +510,10 @@ it. Here is an example:
@code{x}, because @code{a} conflicts with the macro argument variable
@code{a}.
- Another problem with calling @code{eval} in a macro definition is that
-it probably won't do what you intend in a compiled program. The
-byte compiler runs macro definitions while compiling the program, when
-the program's own computations (which you might have wished to access
-with @code{eval}) don't occur and its local variable bindings don't
-exist.
+ Also, the expansion of @code{(foo x)} above will return something
+different or signal an error when the code is compiled, since in that case
+@code{(foo x)} is expanded during compilation, whereas the execution of
+@code{(setq x 'b)} will only take place later when the code is executed.
To avoid these problems, @strong{don't evaluate an argument expression
while computing the macro expansion}. Instead, substitute the
diff --git a/doc/lispref/maps.texi b/doc/lispref/maps.texi
index aea02424086..59c6e6f57ad 100644
--- a/doc/lispref/maps.texi
+++ b/doc/lispref/maps.texi
@@ -53,9 +53,6 @@ A sparse keymap for subcommands of the prefix @kbd{C-x r}.@*
@item esc-map
A full keymap for @key{ESC} (or @key{Meta}) commands.
-@item facemenu-keymap
-A sparse keymap used for the @kbd{M-o} prefix key.
-
@item function-key-map
The parent keymap of all @code{local-function-key-map} (q.v.@:) instances.
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index b39373f0727..80f79b67e52 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -609,8 +609,8 @@ the function @code{use-region-p} for that (@pxref{The Region}).
@defvarx deactivate-mark-hook
These normal hooks are run, respectively, when the mark becomes active
and when it becomes inactive. The hook @code{activate-mark-hook} is
-also run at the end of the command loop if the mark is active and it
-is possible that the region may have changed.
+also run when the region is reactivated, for instance after using a
+command that switches back to a buffer that has an active mark.
@ignore
This piece of command_loop_1, run unless deactivating the mark:
if (current_buffer != prev_buffer || MODIFF != prev_modiff)
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 185d355ba70..d54c654562f 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -97,6 +97,14 @@ to be done. @xref{Text from Minibuffer}, for the non-completion
minibuffer local maps. @xref{Completion Commands}, for the minibuffer
local maps for completion.
+@cindex active minibuffer
+ An active minibuffer usually has major mode @code{minibuffer-mode}.
+This is an Emacs internal mode without any special features. To
+customize the setup of minibuffers, we suggest you use
+@code{minibuffer-setup-hook} (@pxref{Minibuffer Misc}) rather than
+@code{minibuffer-mode-hook}, since the former is run later, after the
+minibuffer has been fully initialized.
+
@cindex inactive minibuffer
When a minibuffer is inactive, its major mode is
@code{minibuffer-inactive-mode}, with keymap
@@ -167,8 +175,10 @@ various applications such as completion.
The argument @var{history} specifies a history list variable to use
for saving the input and for history commands used in the minibuffer.
-It defaults to @code{minibuffer-history}. You can optionally specify
-a starting position in the history list as well. @xref{Minibuffer History}.
+It defaults to @code{minibuffer-history}. If @var{history} is the
+symbol @code{t}, history is not recorded. You can optionally specify
+a starting position in the history list as well. @xref{Minibuffer
+History}.
If the variable @code{minibuffer-allow-text-properties} is
non-@code{nil}, then the string that is returned includes whatever text
@@ -379,8 +389,6 @@ default, it makes the following bindings:
@end table
@end defvar
-@c In version 18, initial is required
-@c Emacs 19 feature
@defun read-no-blanks-input prompt &optional initial inherit-input-method
This function reads a string from the minibuffer, but does not allow
whitespace characters as part of the input: instead, those characters
@@ -461,6 +469,18 @@ If @var{default} is a non-@code{nil} list, the first element of the
list is used in the prompt.
@end defun
+@defvar read-minibuffer-restore-windows
+If this option is non-@code{nil} (the default), getting input from the
+minibuffer will restore, on exit, the window configurations of the frame
+where the minibuffer was entered from and, if it is different, the frame
+that owns the minibuffer window. This means that if, for example, a
+user splits a window while getting input from the minibuffer on the same
+frame, that split will be undone when exiting the minibuffer.
+
+If this option is @code{nil}, no such restorations are done. Hence, the
+window split mentioned above will persist after exiting the minibuffer.
+@end defvar
+
@node Object from Minibuffer
@section Reading Lisp Objects with the Minibuffer
@cindex minibuffer input, reading lisp objects
@@ -701,8 +721,9 @@ A history list for numbers read by @code{read-number}.
@end defvar
@defvar goto-line-history
-A history list for arguments to @code{goto-line}. This variable is
-buffer local.
+A history list for arguments to @code{goto-line}. This variable can
+be made local in every buffer by customizing the user option
+@code{goto-line-history-local}.
@end defvar
@c Less common: coding-system-history, input-method-history,
@@ -971,16 +992,19 @@ and @var{suffix} holds the text after point.
Normally completion operates on the whole string, so for all normal
collections, this will always return @code{(0 . (length
-@var{suffix}))}. But more complex completion such as completion on
-files is done one field at a time. For example, completion of
+@var{suffix}))}. But more complex completion, such as completion on
+files, is done one field at a time. For example, completion of
@code{"/usr/sh"} will include @code{"/usr/share/"} but not
@code{"/usr/share/doc"} even if @code{"/usr/share/doc"} exists.
Also @code{all-completions} on @code{"/usr/sh"} will not include
@code{"/usr/share/"} but only @code{"share/"}. So if @var{string} is
@code{"/usr/sh"} and @var{suffix} is @code{"e/doc"},
-@code{completion-boundaries} will return @code{(5 . 1)} which tells us
+@code{completion-boundaries} will return @w{@code{(5 . 1)}} which tells us
that the @var{collection} will only return completion information that
pertains to the area after @code{"/usr/"} and before @code{"/doc"}.
+@code{try-completion} is not affected by nontrivial boundaries; e.g.,
+@code{try-completion} on @code{"/usr/sh"} might still return
+@code{"/usr/share/"}, not @code{"share/"}.
@end defun
If you store a completion alist in a variable, you should mark the
@@ -1108,9 +1132,10 @@ The function @code{completing-read} uses
@code{minibuffer-local-must-match-map} if @var{require-match} is
non-@code{nil}. @xref{Completion Commands}.
-The argument @var{history} specifies which history list variable to use for
-saving the input and for minibuffer history commands. It defaults to
-@code{minibuffer-history}. @xref{Minibuffer History}.
+The argument @var{history} specifies which history list variable to
+use for saving the input and for minibuffer history commands. It
+defaults to @code{minibuffer-history}. If @var{history} is the symbol
+@code{t}, history is not recorded. @xref{Minibuffer History}.
The argument @var{initial} is mostly deprecated; we recommend using a
non-@code{nil} value only in conjunction with specifying a cons cell
@@ -1175,9 +1200,9 @@ in the minibuffer to do completion.
@defvar minibuffer-completion-table
The value of this variable is the completion table (@pxref{Basic
Completion}) used for completion in the minibuffer. This is the
-global variable that contains what @code{completing-read} passes to
+buffer-local variable that contains what @code{completing-read} passes to
@code{try-completion}. It is used by minibuffer completion commands
-such as @code{minibuffer-complete-word}.
+such as @code{minibuffer-complete}.
@end defvar
@defvar minibuffer-completion-predicate
@@ -1188,7 +1213,7 @@ minibuffer completion functions.
@defvar minibuffer-completion-confirm
This variable determines whether Emacs asks for confirmation before
-exiting the minibuffer; @code{completing-read} binds this variable,
+exiting the minibuffer; @code{completing-read} sets this variable,
and the function @code{minibuffer-complete-and-exit} checks the value
before exiting. If the value is @code{nil}, confirmation is not
required. If the value is @code{confirm}, the user may exit with an
@@ -1806,12 +1831,10 @@ default to that string.
@item :affixation-function
The value should be a function to add prefixes and suffixes to
completions. This function must accept one argument, a list of
-completions, and should return such a list of completions where
-each element contains a list of three elements: a completion,
-a prefix string, and a suffix string. When this function
-returns a list of two elements, it is interpreted as a list
-of a completion and a suffix string like in @code{:annotation-function}.
-This function takes priority over @code{:annotation-function}.
+completions, and should return a list of annotated completions. Each
+element of the returned list must be a three-element list, the
+completion, a prefix string, and a suffix string. This function takes
+priority over @code{:annotation-function}.
@item :exit-function
The value should be a function to run after performing completion.
@@ -1884,6 +1907,13 @@ should return @code{(boundaries @var{start} . @var{end})}, where
string, and @var{end} is the position of the end boundary in
@var{suffix}.
+If a Lisp program returns nontrivial boundaries, it should make sure that the
+@code{all-completions} operation is consistent with them. The
+completions returned by @code{all-completions} should only pertain to
+the piece of the prefix and suffix covered by the completion
+boundaries. @xref{Basic Completion}, for the precise expected semantics
+of completion boundaries.
+
@item metadata
This specifies a request for information about the state of the
current completion. The return value should have the form
@@ -1922,10 +1952,18 @@ completions. The function should take one argument,
return such a list of @var{completions} where each element contains a list
of three elements: a completion, a prefix which is displayed before
the completion string in the @file{*Completions*} buffer, and
-a suffix displayed after the completion string. When this function
-returns a list of two elements, it is interpreted as a list of
-a completion and a suffix string like in @code{annotation-function}.
-This function takes priority over @code{annotation-function}.
+a suffix displayed after the completion string. This function
+takes priority over @code{annotation-function}.
+
+@item group-function
+The value should be a function for grouping the completion candidates.
+The function must take two arguments, @var{completion}, which is a
+completion candidate and @var{transform}, which is a boolean flag. If
+@var{transform} is @code{nil}, the function must return the group
+title of the group to which the candidate belongs. The returned title
+can also be @code{nil}. Otherwise the function must return the
+transformed candidate. The transformation can for example remove a
+redundant prefix, which is displayed in the group title.
@item display-sort-function
The value should be a function for sorting completions. The function
@@ -1962,7 +2000,7 @@ was entered.
The return value of @code{completion-table-dynamic} is a function that
can be used as the 2nd argument to @code{try-completion} and
@code{all-completions}. Note that this function will always return
-empty metadata and trivial boundaries (@pxref{Programmed Completion}).
+empty metadata and trivial boundaries.
@end defun
@defun completion-table-with-cache function &optional ignore-case
@@ -2219,9 +2257,10 @@ This function asks the user a series of questions, reading a
single-character answer in the echo area for each one.
The value of @var{list} specifies the objects to ask questions about.
-It should be either a list of objects or a generator function. If it is
-a function, it should expect no arguments, and should return either the
-next object to ask about, or @code{nil}, meaning to stop asking questions.
+It should be either a list of objects or a generator function. If it
+is a function, it will be called with no arguments, and should return
+either the next object to ask about, or @code{nil}, meaning to stop
+asking questions.
The argument @var{prompter} specifies how to ask each question. If
@var{prompter} is a string, the question text is computed like this:
@@ -2232,19 +2271,20 @@ The argument @var{prompter} specifies how to ask each question. If
@noindent
where @var{object} is the next object to ask about (as obtained from
-@var{list}).
+@var{list}). @xref{Formatting Strings}, for more information about
+@code{format}.
-If not a string, @var{prompter} should be a function of one argument
-(the next object to ask about) and should return the question text. If
-the value is a string, that is the question to ask the user. The
-function can also return @code{t}, meaning do act on this object (and
-don't ask the user), or @code{nil}, meaning ignore this object (and don't
-ask the user).
+If @var{prompter} is not a string, it should be a function of one
+argument (the object to ask about) and should return the question text
+for that object. If the value @var{prompter} returns is a string,
+that is the question to ask the user. The function can also return
+@code{t}, meaning to act on this object without asking the user, or
+@code{nil}, which means to silently ignore this object.
-The argument @var{actor} says how to act on the answers that the user
-gives. It should be a function of one argument, and it is called with
-each object that the user says yes for. Its argument is always an
-object obtained from @var{list}.
+The argument @var{actor} says how to act on the objects for which the
+user answers yes. It should be a function of one argument, and will
+be called with each object from @var{list} for which the user answers
+yes.
If the argument @var{help} is given, it should be a list of this form:
@@ -2254,34 +2294,49 @@ If the argument @var{help} is given, it should be a list of this form:
@noindent
where @var{singular} is a string containing a singular noun that
-describes the objects conceptually being acted on, @var{plural} is the
+describes a single object to be acted on, @var{plural} is the
corresponding plural noun, and @var{action} is a transitive verb
-describing what @var{actor} does.
+describing what @var{actor} does with the objects.
-If you don't specify @var{help}, the default is @code{("object"
-"objects" "act on")}.
+If you don't specify @var{help}, it defaults to the list
+@w{@code{("object" "objects" "act on")}}.
-Each time a question is asked, the user may enter @kbd{y}, @kbd{Y}, or
-@key{SPC} to act on that object; @kbd{n}, @kbd{N}, or @key{DEL} to skip
-that object; @kbd{!} to act on all following objects; @key{ESC} or
-@kbd{q} to exit (skip all following objects); @kbd{.} (period) to act on
-the current object and then exit; or @kbd{C-h} to get help. These are
-the same answers that @code{query-replace} accepts. The keymap
-@code{query-replace-map} defines their meaning for @code{map-y-or-n-p}
-as well as for @code{query-replace}; see @ref{Search and Replace}.
+Each time a question is asked, the user can answer as follows:
+
+@table @asis
+@item @kbd{y}, @kbd{Y}, or @kbd{@key{SPC}}
+act on the object
+@item @kbd{n}, @kbd{N}, or @kbd{@key{DEL}}
+skip the object
+@item @kbd{!}
+act on all the following objects
+@item @kbd{@key{ESC}} or @kbd{q}
+exit (skip all following objects)
+@item @kbd{.} (period)
+act on the object and then exit
+@item @kbd{C-h}
+get help
+@end table
+
+@noindent
+These are the same answers that @code{query-replace} accepts. The
+keymap @code{query-replace-map} defines their meaning for
+@code{map-y-or-n-p} as well as for @code{query-replace}; see
+@ref{Search and Replace}.
You can use @var{action-alist} to specify additional possible answers
-and what they mean. It is an alist of elements of the form
-@code{(@var{char} @var{function} @var{help})}, each of which defines one
-additional answer. In this element, @var{char} is a character (the
+and what they mean. If provided, @var{action-alist} should be an
+alist whose elements are of the form @w{@code{(@var{char}
+@var{function} @var{help})}}. Each of the alist elements defines one
+additional answer. In each element, @var{char} is a character (the
answer); @var{function} is a function of one argument (an object from
-@var{list}); @var{help} is a string.
-
-When the user responds with @var{char}, @code{map-y-or-n-p} calls
-@var{function}. If it returns non-@code{nil}, the object is considered
-acted upon, and @code{map-y-or-n-p} advances to the next object in
-@var{list}. If it returns @code{nil}, the prompt is repeated for the
-same object.
+@var{list}); and @var{help} is a string. When the user responds with
+@var{char}, @code{map-y-or-n-p} calls @var{function}. If it returns
+non-@code{nil}, the object is considered to have been acted upon, and
+@code{map-y-or-n-p} advances to the next object in @var{list}. If it
+returns @code{nil}, the prompt is repeated for the same object. If
+the user requests help, the text in @var{help} is used to describe
+these additional answers.
Normally, @code{map-y-or-n-p} binds @code{cursor-in-echo-area} while
prompting. But if @var{no-cursor-in-echo-area} is non-@code{nil}, it
@@ -2393,7 +2448,7 @@ minibuffer.
@deffn Command exit-minibuffer
This command exits the active minibuffer. It is normally bound to
keys in minibuffer local keymaps. The command throws an error if the
-current buffer is not the active minibuffer.
+current buffer is a minibuffer, but not the active minibuffer.
@end deffn
@deffn Command self-insert-and-exit
@@ -2474,7 +2529,6 @@ 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 @code{t} if @var{window} is a minibuffer window.
@var{window} defaults to the selected window.
@@ -2618,7 +2672,6 @@ when the minibuffer is active, not even if you switch to another window
to do it.
@end defopt
-@c Emacs 19 feature
If a command name has a property @code{enable-recursive-minibuffers}
that is non-@code{nil}, then the command can use the minibuffer to read
arguments even if it is invoked from the minibuffer. A command can
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index ce7727b87eb..d9caeab3bc3 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -861,6 +861,13 @@ abbrev table as @var{parent}, or @code{fundamental-mode-abbrev-table}
if @var{parent} is @code{nil}. (Again, a @code{nil} value is
@emph{not} equivalent to not specifying this keyword.)
+@item :interactive
+Modes are interactive commands by default. If you specify a
+@code{nil} value, the mode defined here won't be interactive. This is
+useful for modes that are never meant to be activated by users
+manually, but are only supposed to be used in some specially-formatted
+buffer.
+
@item :group
If this is specified, the value should be the customization group for
this mode. (Not all major modes have one.) The command
@@ -1454,6 +1461,16 @@ used only with Diff mode.
other minor modes in effect. It should be possible to activate and
deactivate minor modes in any order.
+@defvar local-minor-modes
+This buffer-local variable lists the currently enabled minor modes in
+the current buffer, and is a list of symbols.
+@end defvar
+
+@defvar global-minor-modes
+This variable lists the currently enabled global minor modes, and is a
+list of symbols.
+@end defvar
+
@defvar minor-mode-list
The value of this variable is a list of all minor mode commands.
@end defvar
@@ -1643,7 +1660,7 @@ reserved for users. @xref{Key Binding Conventions}.
The macro @code{define-minor-mode} offers a convenient way of
implementing a mode in one self-contained definition.
-@defmac define-minor-mode mode doc [init-value [lighter [keymap]]] keyword-args@dots{} body@dots{}
+@defmac define-minor-mode mode doc keyword-args@dots{} body@dots{}
This macro defines a new minor mode whose name is @var{mode} (a
symbol). It defines a command named @var{mode} to toggle the minor
mode, with @var{doc} as its documentation string.
@@ -1658,41 +1675,12 @@ If @var{doc} is @code{nil}, the macro supplies a default documentation string
explaining the above.
By default, it also defines a variable named @var{mode}, which is set to
-@code{t} or @code{nil} by enabling or disabling the mode. The variable
-is initialized to @var{init-value}. Except in unusual circumstances
-(see below), this value must be @code{nil}.
-
-The string @var{lighter} says what to display in the mode line
-when the mode is enabled; if it is @code{nil}, the mode is not displayed
-in the mode line.
-
-The optional argument @var{keymap} specifies the keymap for the minor
-mode. If non-@code{nil}, it should be a variable name (whose value is
-a keymap), a keymap, or an alist of the form
-
-@example
-(@var{key-sequence} . @var{definition})
-@end example
-
-@noindent
-where each @var{key-sequence} and @var{definition} are arguments
-suitable for passing to @code{define-key} (@pxref{Changing Key
-Bindings}). If @var{keymap} is a keymap or an alist, this also
-defines the variable @code{@var{mode}-map}.
+@code{t} or @code{nil} by enabling or disabling the mode.
-The above three arguments @var{init-value}, @var{lighter}, and
-@var{keymap} can be (partially) omitted when @var{keyword-args} are
-used. The @var{keyword-args} consist of keywords followed by
+The @var{keyword-args} consist of keywords followed by
corresponding values. A few keywords have special meanings:
@table @code
-@item :group @var{group}
-Custom group name to use in all generated @code{defcustom} forms.
-Defaults to @var{mode} without the possible trailing @samp{-mode}.
-@strong{Warning:} don't use this default group name unless you have
-written a @code{defgroup} to define that group properly. @xref{Group
-Definitions}.
-
@item :global @var{global}
If non-@code{nil}, this specifies that the minor mode should be global
rather than buffer-local. It defaults to @code{nil}.
@@ -1702,19 +1690,34 @@ One of the effects of making a minor mode global is that the
through the Customize interface turns the mode on and off, and its
value can be saved for future Emacs sessions (@pxref{Saving
Customizations,,, emacs, The GNU Emacs Manual}. For the saved
-variable to work, you should ensure that the @code{define-minor-mode}
-form is evaluated each time Emacs starts; for packages that are not
-part of Emacs, the easiest way to do this is to specify a
-@code{:require} keyword.
+variable to work, you should ensure that the minor mode function
+is available each time Emacs starts; usually this is done by
+marking the @code{define-minor-mode} form as autoloaded.
@item :init-value @var{init-value}
-This is equivalent to specifying @var{init-value} positionally.
+This is the value to which the @var{mode} variable is initialized.
+Except in unusual circumstances (see below), this value must be
+@code{nil}.
@item :lighter @var{lighter}
-This is equivalent to specifying @var{lighter} positionally.
+The string @var{lighter} says what to display in the mode line
+when the mode is enabled; if it is @code{nil}, the mode is not displayed
+in the mode line.
@item :keymap @var{keymap}
-This is equivalent to specifying @var{keymap} positionally.
+The optional argument @var{keymap} specifies the keymap for the minor
+mode. If non-@code{nil}, it should be a variable name (whose value is
+a keymap), a keymap, or an alist of the form
+
+@example
+(@var{key-sequence} . @var{definition})
+@end example
+
+@noindent
+where each @var{key-sequence} and @var{definition} are arguments
+suitable for passing to @code{define-key} (@pxref{Changing Key
+Bindings}). If @var{keymap} is a keymap or an alist, this also
+defines the variable @code{@var{mode}-map}.
@item :variable @var{place}
This replaces the default variable @var{mode}, used to store the state
@@ -1725,11 +1728,17 @@ anything that can be used with the @code{setf} function
(@pxref{Generalized Variables}).
@var{place} can also be a cons @code{(@var{get} . @var{set})},
where @var{get} is an expression that returns the current state,
-and @var{set} is a function of one argument (a state) that sets it.
+and @var{set} is a function of one argument (a state) which should be
+assigned to @var{place}.
@item :after-hook @var{after-hook}
This defines a single Lisp form which is evaluated after the mode hooks
have run. It should not be quoted.
+
+@item :interactive @var{value}
+Minor modes are interactive commands by default. If @var{value} is
+@code{nil}, this is inhibited. If @var{value} is a list of symbols,
+it's used to say which major modes this minor mode is useful in.
@end table
Any other keyword arguments are passed directly to the
@@ -2243,16 +2252,15 @@ number.
The format used to display column numbers when
@code{column-number-mode} (@pxref{Optional Mode Line,,, emacs, The GNU
Emacs Manual}) is switched on. @samp{%c} in the format will be
-replaced with the column number, and this is zero-based if
-@code{column-number-indicator-zero-based} is non-@code{nil}, and
-one-based if @code{column-number-indicator-zero-based} is @code{nil}.
+replaced with a zero-based column number, and @samp{%C} will be
+replaced with a one-based column number.
@end defvar
@defvar mode-line-position-column-line-format
The format used to display column numbers when both
@code{line-number-mode} and @code{column-number-mode} are switched on.
-See the previous two variables for the meaning of the @samp{%l} and
-@samp{%c} format specs.
+See the previous two variables for the meaning of the @samp{%l},
+@samp{%c} and @samp{%C} format specs.
@end defvar
@defvar minor-mode-alist
@@ -2279,11 +2287,14 @@ enabled separately in each buffer.
@defvar global-mode-string
This variable holds a mode line construct that, by default, appears in
-the mode line just after the @code{which-function-mode} minor mode if set,
-else after @code{mode-line-modes}. The command @code{display-time} sets
+the mode line just after the @code{which-function-mode} minor mode if
+set, else after @code{mode-line-modes}. Elements that are added to
+this construct should normally end in a space (to ensure that
+consecutive @code{global-mode-string} elements display properly). For
+instance, the command @code{display-time} sets
@code{global-mode-string} to refer to the variable
-@code{display-time-string}, which holds a string containing the time and
-load information.
+@code{display-time-string}, which holds a string containing the time
+and load information.
The @samp{%M} construct substitutes the value of
@code{global-mode-string}, but that is obsolete, since the variable is
@@ -2977,10 +2988,6 @@ highlighted (instead of the entire text that @var{matcher} matched).
("fu\\(bar\\)" . 1)
@end example
-If you use @code{regexp-opt} to produce the regular expression
-@var{matcher}, you can use @code{regexp-opt-depth} (@pxref{Regexp
-Functions}) to calculate the value for @var{subexp}.
-
@item (@var{matcher} . @var{facespec})
In this kind of element, @var{facespec} is an expression whose value
specifies the face to use for highlighting. In the simplest case,
@@ -2996,7 +3003,8 @@ name.
However, @var{facespec} can also evaluate to a list of this form:
@example
-(face @var{face} @var{prop1} @var{val1} @var{prop2} @var{val2}@dots{})
+(@var{subexp}
+(face @var{face} @var{prop1} @var{val1} @var{prop2} @var{val2}@dots{}))
@end example
@noindent
@@ -3225,8 +3233,7 @@ set by means of @var{other-vars} in @code{font-lock-defaults}
@defvar font-lock-mark-block-function
If this variable is non-@code{nil}, it should be a function that is
called with no arguments, to choose an enclosing range of text for
-refontification for the command @kbd{M-o M-o}
-(@code{font-lock-fontify-block}).
+refontification for the command @kbd{M-x font-lock-fontify-block}.
The function should report its choice by placing the region around it.
A good choice is a range of text large enough to give proper results,
@@ -3438,9 +3445,17 @@ for string constants.
@item font-lock-doc-face
@vindex font-lock-doc-face
-for documentation strings in the code. This inherits, by default, from
+for documentation embedded in program code inside specially-formed
+comments or strings. This face inherits, by default, from
@code{font-lock-string-face}.
+@item font-lock-doc-markup-face
+@vindex font-lock-doc-markup-face
+for mark-up elements in text using @code{font-lock-doc-face}.
+It is typically used for the mark-up constructs in documentation embedded
+in program code, following conventions such as Haddock, Javadoc or Doxygen.
+This face inherits, by default, from @code{font-lock-constant-face}.
+
@item font-lock-negation-char-face
@vindex font-lock-negation-char-face
for easily-overlooked negation characters.
@@ -3547,7 +3562,7 @@ which will instruct font-lock not to start or end the scan in the
middle of the construct.
@end itemize
- There are three ways to do rehighlighting of multiline constructs:
+ There are several ways to do rehighlighting of multiline constructs:
@itemize
@item
@@ -3569,6 +3584,17 @@ This works only if @code{jit-lock-contextually} is used, and with the
same delay before rehighlighting, but like @code{font-lock-multiline},
it also handles the case where highlighting depends on
subsequent lines.
+@item
+If parsing the @emph{syntax} of a construct depends on it being parsed in one
+single chunk, you can add the @code{syntax-multiline} text property
+over the construct in question. The most common use for this is when
+the syntax property to apply to @samp{FOO} depend on some later text
+@samp{BAR}: By placing this text property over the whole of
+@samp{FOO...BAR}, you make sure that any change of @samp{BAR} will
+also cause the syntax property of @samp{FOO} to be recomputed.
+Note: For this to work, the mode needs to add
+@code{syntax-propertize-multiline} to
+@code{syntax-propertize-extend-region-functions}.
@end itemize
@menu
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index 84f5d2f0819..c22930d624e 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -301,7 +301,7 @@ character, and returns that character. If @var{char} is neither
@end defun
@defun unibyte-char-to-multibyte char
-This convert the unibyte character @var{char} to a multibyte
+This converts the unibyte character @var{char} to a multibyte
character, assuming @var{char} is either @acronym{ASCII} or raw 8-bit
byte.
@end defun
@@ -676,7 +676,7 @@ This function returns the value of @var{char}'s @var{propname} property.
@end group
@group
(get-char-code-property ?\( 'paired-bracket)
- @result{} 41 ;; closing parenthesis
+ @result{} 41 ; closing parenthesis
@end group
@group
(get-char-code-property ?\) 'bracket-type)
@@ -955,13 +955,13 @@ translating the result.
@defvar standard-translation-table-for-decode
This is the default translation table for decoding. If a coding
-systems specifies its own translation tables, the table that is the
+system specifies its own translation tables, the table that is the
value of this variable, if non-@code{nil}, is applied after them.
@end defvar
@defvar standard-translation-table-for-encode
This is the default translation table for encoding. If a coding
-systems specifies its own translation tables, the table that is the
+system specifies its own translation tables, the table that is the
value of this variable, if non-@code{nil}, is applied after them.
@end defvar
@@ -1258,7 +1258,7 @@ name or @code{nil}.
@defun check-coding-system coding-system
This function checks the validity of @var{coding-system}. If that is
valid, it returns @var{coding-system}. If @var{coding-system} is
-@code{nil}, the function return @code{nil}. For any other values, it
+@code{nil}, the function returns @code{nil}. For any other values, it
signals an error whose @code{error-symbol} is @code{coding-system-error}
(@pxref{Signaling Errors, signal}).
@end defun
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 63e3e0bace5..d28e15869aa 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -237,7 +237,8 @@ precede the number and its exponent. For example, @samp{1500.0},
@samp{+15e2}, @samp{15.0e+2}, @samp{+1500000e-3}, and @samp{.15e4} are
five ways of writing a floating-point number whose value is 1500.
They are all equivalent. Like Common Lisp, Emacs Lisp requires at
-least one digit after any decimal point in a floating-point number;
+least one digit after a decimal point in a floating-point number that
+does not have an exponent;
@samp{1500.} is an integer, not a floating-point number.
Emacs Lisp treats @code{-0.0} as numerically equal to ordinary zero
@@ -1250,7 +1251,7 @@ other strings to choose various seed values.
This function returns a pseudo-random integer. Repeated calls return a
series of pseudo-random integers.
-If @var{limit} is a positive fixnum, the value is chosen to be
+If @var{limit} is a positive integer, the value is chosen to be
nonnegative and less than @var{limit}. Otherwise, the value might be
any fixnum, i.e., any integer from @code{most-negative-fixnum} through
@code{most-positive-fixnum} (@pxref{Integer Basics}).
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 64e7d53d935..365d5ac8d61 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -148,9 +148,6 @@ starting list count:
object, so when reading back the object, they will be the same object
instead of copies (@pxref{Circular Objects}).
-@item #@@N
-Skip the next @samp{N} characters (@pxref{Comments}).
-
@item #xN
@samp{N} represented as a hexadecimal number (@samp{#x2a}).
@@ -1004,6 +1001,13 @@ It looks like this:
@end example
@end ifnottex
+ As a somewhat peculiar side effect of @code{(a b . c)} and
+@code{(a . (b . c))} being equivalent, for consistency this means
+that if you replace @code{b} here with the empty sequence, then it
+follows that @code{(a . c)} and @code{(a . ( . c))} are equivalent,
+too. This also means that @code{( . c)} is equivalent to @code{c},
+but this is seldom used.
+
@node Association List Type
@subsubsection Association List Type
@@ -2414,7 +2418,7 @@ that is evaluated. For example:
@noindent
Although the list @code{(0.5)} was mutable when it was created, it should not
-have been changed via @code{setcar} because it given to @code{eval}. The
+have been changed via @code{setcar} because it was given to @code{eval}. The
reverse does not occur: an object that should not be changed never
becomes mutable afterwards.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 37fde0a953d..12ddaf04b6a 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2167,6 +2167,11 @@ if @var{time} is @code{t}, then the timer runs whenever the time is a
multiple of @var{repeat} seconds after the epoch. This is useful for
functions like @code{display-time}.
+If Emacs didn't get any CPU time when the timer would have run (for
+example if the system was busy running another process or if the
+computer was sleeping or in a suspended state), the timer will run as
+soon as Emacs resumes and is idle.
+
The function @code{run-at-time} returns a timer value that identifies
the particular scheduled future action. You can use this value to call
@code{cancel-timer} (see below).
@@ -2369,11 +2374,17 @@ has no effect except in @sc{cbreak} mode.
The argument @var{meta} controls support for input character codes
above 127. If @var{meta} is @code{t}, Emacs converts characters with
-the 8th bit set into Meta characters. If @var{meta} is @code{nil},
+the 8th bit set into Meta characters, before it decodes them as needed
+(@pxref{Terminal I/O Encoding}). If @var{meta} is @code{nil},
Emacs disregards the 8th bit; this is necessary when the terminal uses
-it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil},
-Emacs uses all 8 bits of input unchanged. This is good for terminals
-that use 8-bit character sets.
+it as a parity bit. If @var{meta} is the symbol @code{encoded}, Emacs
+first decodes the characters using all the 8 bits of each byte, and
+then converts the decoded single-byte characters into Meta characters
+if they have their eighth bit set. Finally, if @var{meta} is neither
+@code{t} nor @code{nil} nor @code{encoded}, Emacs uses all 8 bits of
+input unchanged, both before and after decoding them. This is good
+for terminals that use 8-bit character sets and don't encode the Meta
+modifier as the eighth bit.
If @var{quit-char} is non-@code{nil}, it specifies the character to
use for quitting. Normally this character is @kbd{C-g}.
@@ -2398,9 +2409,11 @@ flow control for output to the terminal. This value is meaningful only
when @var{interrupt} is @code{nil}.
@item meta
is @code{t} if Emacs treats the eighth bit of input characters as
-the meta bit; @code{nil} means Emacs clears the eighth bit of every
-input character; any other value means Emacs uses all eight bits as the
-basic character code.
+the Meta bit before decoding input; @code{encoded} if Emacs treats the
+eighth bit of the decoded single-byte characters as the Meta bit;
+@code{nil} if Emacs clears the eighth bit of every input character;
+any other value means Emacs uses all eight bits as the basic character
+code.
@item quit
is the character Emacs currently uses for quitting, usually @kbd{C-g}.
@end table
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index e8aaa3ae1d1..9c033fe3df8 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -283,11 +283,14 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example:
@section Creating and Maintaining Package Archives
@cindex package archive
+@cindex GNU ELPA
+@cindex non-GNU ELPA
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{https://elpa.gnu.org}. This
-section describes how to set up and maintain a package archive.
+@code{package-archives}, whose default value lists the archives
+hosted on @url{https://elpa.gnu.org, GNU ELPA} and
+@url{https://elpa.nongnu.org, non-GNU ELPA}. This section describes
+how to set up and maintain a package archive.
@cindex base location, package archive
@defopt package-archives
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index dc0c7442d8d..769aeed75f8 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -232,7 +232,6 @@ backward until encountering the front of a word, rather than forward.
@end deffn
@defopt words-include-escapes
-@c Emacs 19 feature
This variable affects the behavior of @code{forward-word} and
@code{backward-word}, and everything that uses them. If it is
non-@code{nil}, then characters in the escape and character-quote
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 83461656063..90c42156372 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -247,6 +247,16 @@ protected by @code{shell-quote-argument};
@code{combine-and-quote-strings} is @emph{not} intended to protect
special characters from shell evaluation.
+@defun split-string-shell-command string
+This function splits @var{string} into substrings, respecting double
+and single quotes, as well as backslash quoting.
+
+@smallexample
+(split-string-shell-command "ls /tmp/'foo bar'")
+ @result{} ("ls" "/tmp/foo bar")
+@end smallexample
+@end defun
+
@defun split-string-and-unquote string &optional separators
This function splits @var{string} into substrings at matches for the
regular expression @var{separators}, like @code{split-string} does
@@ -1325,7 +1335,7 @@ the numeric ID of the foreground process group of @var{process}; it
returns @code{nil} if Emacs can be certain that this is not so. The
value is @code{t} if Emacs cannot tell whether this is true. This
function signals an error if @var{process} is a network, serial, or
-pipe connection, or is the subprocess is not active.
+pipe connection, or if the subprocess is not active.
@end defun
@node Signals to Processes
@@ -3354,24 +3364,37 @@ To use the functions referred to in this section, load the
direction is also known as @dfn{serializing} or @dfn{packing}.
@menu
-* Bindat Spec:: Describing data layout.
-* Bindat Functions:: Doing the unpacking and packing.
+* Bindat Types:: Describing data layout.
+* Bindat Functions:: Doing the unpacking and packing.
+* Bindat Computed Types:: Advanced data layout specifications.
@end menu
-@node Bindat Spec
+@node Bindat Types
@subsection Describing Data Layout
+@cindex bindat types
+@cindex data layout specification
+@cindex bindat type expression
+@cindex base type, in bindat specification
+@cindex composite type, in bindat specification
To control unpacking and packing, you write a @dfn{data layout
-specification}, a special nested list describing named and typed
-@dfn{fields}. This specification controls the length of each field to be
-processed, and how to pack or unpack it. We normally keep bindat specs
-in variables whose names end in @samp{-bindat-spec}; that kind of name
-is automatically recognized as risky.
-
-@cindex endianness
-@cindex big endian
-@cindex little endian
-@cindex network byte ordering
+specification}, also called a @dfn{Bindat type expression}. This can
+be a @dfn{base type} or a @dfn{composite type} made of several fields,
+where the specification controls the length of each field to be
+processed, and how to pack or unpack it. We normally keep bindat type
+values in variables whose names end in @code{-bindat-spec}; that kind
+of name is automatically recognized as risky (@pxref{File Local
+Variables}).
+
+@defmac bindat-type &rest type
+Creates a Bindat type @emph{value} object according to the Bindat type
+@emph{expression} @var{type}.
+@end defmac
+
+@cindex endianness, in bindat specification
+@cindex big endian, in bindat specification
+@cindex little endian, in bindat specification
+@cindex network byte ordering, in Bindat specification
A field's @dfn{type} describes the size (in bytes) of the object
that the field represents and, in the case of multibyte fields, how
the bytes are ordered within the field. The two possible orderings
@@ -3386,164 +3409,92 @@ type values:
@itemx byte
Unsigned byte, with length 1.
-@item u16
-@itemx word
-@itemx short
-Unsigned integer in network byte order, with length 2.
-
-@item u24
-Unsigned integer in network byte order, with length 3.
+@item uint @var{bitlen}
+Unsigned integer in network byte order, with @var{bitlen} bits.
+@var{bitlen} has to be a multiple of 8.
-@item u32
-@itemx dword
-@itemx long
-Unsigned integer in network byte order, with length 4.
-Note: These values may be limited by Emacs's integer implementation limits.
-
-@item u16r
-@itemx u24r
-@itemx u32r
-Unsigned integer in little endian order, with length 2, 3 and 4, respectively.
+@item uintr @var{bitlen}
+Unsigned integer in little endian order, with @var{bitlen} bits.
+@var{bitlen} has to be a multiple of 8.
@item str @var{len}
-String of length @var{len}.
+String of bytes of length @var{len}.
-@item strz @var{len}
-Zero-terminated string, in a fixed-size field with length @var{len}.
+@item strz &optional @var{len}
+Zero-terminated string of bytes, can be of arbitrary length or in a fixed-size
+field with length @var{len}.
@item vec @var{len} [@var{type}]
-Vector of @var{len} elements of type @var{type}, defaulting to bytes.
-The @var{type} is any of the simple types above, or another vector
-specified as a list of the form @code{(vec @var{len} [@var{type}])}.
+Vector of @var{len} elements. The type of the elements is given by
+@var{type}, defaulting to bytes. The @var{type} can be any Bindat
+type expression.
-@item ip
-@c FIXME? IPv6?
-Four-byte vector representing an Internet address. For example:
-@code{[127 0 0 1]} for localhost.
+@item repeat @var{len} [@var{type}]
+Like @code{vec}, but it unpacks to and packs from lists, whereas
+@code{vec} unpacks to vectors.
@item bits @var{len}
-List of set bits in @var{len} bytes. The bytes are taken in big
-endian order and the bits are numbered starting with @code{8 *
-@var{len} @minus{} 1} and ending with zero. For example: @code{bits
-2} unpacks @code{#x28} @code{#x1c} to @code{(2 3 4 11 13)} and
-@code{#x1c} @code{#x28} to @code{(3 5 10 11 12)}.
-
-@item (eval @var{form})
-@var{form} is a Lisp expression evaluated at the moment the field is
-unpacked or packed. The result of the evaluation should be one of the
-above-listed type specifications.
-@end table
-
-For a fixed-size field, the length @var{len} is given as an integer
-specifying the number of bytes in the field.
-
-When the length of a field is not fixed, it typically depends on the
-value of a preceding field. In this case, the length @var{len} can be
-given either as a list @code{(@var{name} ...)} identifying a
-@dfn{field name} in the format specified for @code{bindat-get-field}
-below, or by an expression @code{(eval @var{form})} where @var{form}
-should evaluate to an integer, specifying the field length.
-
-A field specification generally has the form @code{([@var{name}]
-@var{handler})}, where @var{name} is optional. Don't use names that
-are symbols meaningful as type specifications (above) or handler
-specifications (below), since that would be ambiguous. @var{name} can
-be a symbol or an expression @code{(eval @var{form})}, in which case
-@var{form} should evaluate to a symbol.
-
-@var{handler} describes how to unpack or pack the field and can be one
-of the following:
-
-@table @code
-@item @var{type}
-Unpack/pack this field according to the type specification @var{type}.
-
-@item eval @var{form}
-Evaluate @var{form}, a Lisp expression, for side-effect only. If the
-field name is specified, the value is bound to that field name.
+List of bits that are set to 1 in @var{len} bytes. The bytes are
+taken in big-endian order, and the bits are numbered starting with
+@code{8 * @var{len} @minus{} 1} and ending with zero. For example:
+@code{bits 2} unpacks @code{#x28} @code{#x1c} to @w{@code{(2 3 4 11 13)}}
+and @code{#x1c} @code{#x28} to @w{@code{(3 5 10 11 12)}}.
@item fill @var{len}
-Skip @var{len} bytes. In packing, this leaves them unchanged,
-which normally means they remain zero. In unpacking, this means
-they are ignored.
+@var{len} bytes used as a mere filler. In packing, these bytes are
+are left unchanged, which normally means they remain zero.
+When unpacking, this just returns nil.
@item align @var{len}
-Skip to the next multiple of @var{len} bytes.
-
-@item struct @var{spec-name}
-Process @var{spec-name} as a sub-specification. This describes a
-structure nested within another structure.
-
-@item union @var{form} (@var{tag} @var{spec})@dots{}
-@c ??? I don't see how one would actually use this.
-@c ??? what kind of expression would be useful for @var{form}?
-Evaluate @var{form}, a Lisp expression, find the first @var{tag}
-that matches it, and process its associated data layout specification
-@var{spec}. Matching can occur in one of three ways:
-
-@itemize
-@item
-If a @var{tag} has the form @code{(eval @var{expr})}, evaluate
-@var{expr} with the variable @code{tag} dynamically bound to the value
-of @var{form}. A non-@code{nil} result indicates a match.
-
-@item
-@var{tag} matches if it is @code{equal} to the value of @var{form}.
-
-@item
-@var{tag} matches unconditionally if it is @code{t}.
-@end itemize
-
-@item repeat @var{count} @var{field-specs}@dots{}
-Process the @var{field-specs} recursively, in order, then repeat
-starting from the first one, processing all the specifications @var{count}
-times overall. The @var{count} is given using the same formats as a
-field length---if an @code{eval} form is used, it is evaluated just once.
-For correct operation, each specification in @var{field-specs} must
-include a name.
+Same as @code{fill} except the number of bytes is that needed to skip
+to the next multiple of @var{len} bytes.
+
+@item type @var{exp}
+This lets you refer to a type indirectly: @var{exp} is a Lisp
+expression which should return a Bindat type @emph{value}.
+
+@item unit @var{exp}
+This is a trivial type which uses up 0 bits of space. @var{exp}
+describes the value returned when we try to ``unpack'' such a field.
+
+@item struct @var{fields}...
+Composite type made of several fields. Every field is of the form
+@code{(@var{name} @var{type})} where @var{type} can be any Bindat
+type expression. @var{name} can be @code{_} when the field's value
+does not deserve to be named, as is often the case for @code{align}
+and @code{fill} fields.
+When the context makes it clear that this is a Bindat type expression,
+the symbol @code{struct} can be omitted.
@end table
-For the @code{(eval @var{form})} forms used in a bindat specification,
-the @var{form} can access and update these dynamically bound variables
-during evaluation:
+In the types above, @var{len} and @var{bitlen} are given as an integer
+specifying the number of bytes (or bits) in the field. When the
+length of a field is not fixed, it typically depends on the value of
+preceding fields. For this reason, the length @var{len} does not have
+to be a constant but can be any Lisp expression and it can refer to
+the value of previous fields via their name.
-@table @code
-@item last
-Value of the last field processed.
-
-@item bindat-raw
-The data as a byte array.
-
-@item bindat-idx
-Current index (within @code{bindat-raw}) for unpacking or packing.
-
-@item struct
-The alist containing the structured data that have been unpacked so
-far, or the entire structure being packed. You can use
-@code{bindat-get-field} to access specific fields of this structure.
-
-@item count
-@itemx index
-Inside a @code{repeat} block, these contain the maximum number of
-repetitions (as specified by the @var{count} parameter), and the
-current repetition number (counting from 0). Setting @code{count} to
-zero will terminate the inner-most repeat block after the current
-repetition has completed.
-@end table
+For example, the specification of a data layout where a leading byte gives
+the size of a subsequent vector of 16 bit integers could be:
+@example
+(bindat-type
+ (len u8)
+ (payload vec (1+ len) uint 16))
+@end example
@node Bindat Functions
@subsection Functions to Unpack and Pack Bytes
+@cindex bindat functions
- In the following documentation, @var{spec} refers to a data layout
-specification, @code{bindat-raw} to a byte array, and @var{struct} to an
-alist representing unpacked field data.
+ In the following documentation, @var{type} refers to a Bindat type
+value as returned from @code{bindat-type}, @var{raw} to a byte
+array, and @var{struct} to an alist representing unpacked field data.
-@defun bindat-unpack spec bindat-raw &optional bindat-idx
-@c FIXME? Again, no multibyte?
+@defun bindat-unpack type raw &optional idx
This function unpacks data from the unibyte string or byte
-array @code{bindat-raw}
-according to @var{spec}. Normally, this starts unpacking at the
-beginning of the byte array, but if @var{bindat-idx} is non-@code{nil}, it
+array @var{raw}
+according to @var{type}. Normally, this starts unpacking at the
+beginning of the byte array, but if @var{idx} is non-@code{nil}, it
specifies a zero-based starting position to use instead.
The value is an alist or nested alist in which each element describes
@@ -3555,12 +3506,13 @@ This function selects a field's data from the nested alist
@var{struct}. Usually @var{struct} was returned by
@code{bindat-unpack}. If @var{name} corresponds to just one argument,
that means to extract a top-level field value. Multiple @var{name}
-arguments specify repeated lookup of sub-structures. An integer name
-acts as an array index.
+arguments specify repeated lookup of sub-structures. An integer
+@var{name} acts as an array index.
-For example, if @var{name} is @code{(a b 2 c)}, that means to find
-field @code{c} in the third element of subfield @code{b} of field
-@code{a}. (This corresponds to @code{struct.a.b[2].c} in C.)
+For example, @w{@code{(bindat-get-field @var{struct} a b 2 c)}} means
+to find field @code{c} in the third element of subfield @code{b} of
+field @code{a}. (This corresponds to @code{@var{struct}.a.b[2].c} in
+the C programming language syntax.)
@end defun
Although packing and unpacking operations change the organization of
@@ -3571,20 +3523,20 @@ both pieces of information contribute to its calculation. Likewise, the
length of a string or array being unpacked may be longer than the data's
total length as described by the specification.
-@defun bindat-length spec struct
+@defun bindat-length type struct
This function returns the total length of the data in @var{struct},
-according to @var{spec}.
+according to @var{type}.
@end defun
-@defun bindat-pack spec struct &optional bindat-raw bindat-idx
-This function returns a byte array packed according to @var{spec} from
+@defun bindat-pack type struct &optional raw idx
+This function returns a byte array packed according to @var{type} from
the data in the alist @var{struct}. It normally creates and fills a
-new byte array starting at the beginning. However, if @var{bindat-raw}
+new byte array starting at the beginning. However, if @var{raw}
is non-@code{nil}, it specifies a pre-allocated unibyte string or vector to
-pack into. If @var{bindat-idx} is non-@code{nil}, it specifies the starting
-offset for packing into @code{bindat-raw}.
+pack into. If @var{idx} is non-@code{nil}, it specifies the starting
+offset for packing into @var{raw}.
-When pre-allocating, you should make sure @code{(length @var{bindat-raw})}
+When pre-allocating, you should make sure @code{(length @var{raw})}
meets or exceeds the total length to avoid an out-of-range error.
@end defun
@@ -3598,3 +3550,74 @@ dotted notation.
@result{} "127.0.0.1"
@end example
@end defun
+
+@node Bindat Computed Types
+@subsection Advanced data layout specifications
+@cindex bindat computed types
+
+Bindat type expressions are not limited to the types described
+earlier. They can also be arbitrary Lisp forms returning Bindat
+type expressions. For example, the type below describes data which
+can either contain a 24-bit error code or a vector of bytes:
+
+@example
+(bindat-type
+ (len u8)
+ (payload . (if (zerop len) (uint 24) (vec (1- len)))))
+@end example
+
+@cindex bindat packing and unpacking into arbitrary types
+Furthermore, while composite types are normally unpacked to (and
+packed from) association lists, this can be changed via the use of
+the following special keyword arguments:
+
+@table @code
+@item :unpack-val @var{exp}
+When the list of fields ends with this keyword argument, then the value
+returned when unpacking is the value of @var{exp} instead of the
+standard alist. @var{exp} can refer to all the previous fields by
+their name.
+
+@item :pack-val @var{exp}
+If a field's type is followed by this keyword argument, then the value
+packed into this field is returned by @var{exp} instead of being
+extracted from the alist.
+
+@item :pack-var @var{name}
+If the list of fields is preceded by this keyword argument, then all
+the subsequent @code{:pack-val} arguments can refer to the overall
+value to pack into this composite type via the variable named
+@var{name}.
+@end table
+
+For example, one could describe a 16-bit signed integer as follows:
+
+@example
+(defconst sint16-bindat-spec
+ (let* ((max (ash 1 15))
+ (wrap (+ max max)))
+ (bindat-type :pack-var v
+ (n uint 16 :pack-val (if (< v 0) (+ v wrap) v))
+ :unpack-val (if (>= n max) (- n wrap) n))))
+@end example
+
+Which would then behave as follows:
+@example
+(bindat-pack sint16-bindat-spec -8)
+ @result{} "\377\370"
+
+(bindat-unpack sint16-bindat-spec "\300\100")
+ @result{} -16320
+@end example
+
+@cindex define new bindat type forms
+@cindex bindat, define new type forms
+Finally, you can define new Bindat type forms to use in Bindat type
+expressions with @code{bindat-defmacro}:
+
+@defmac bindat-defmacro name args &rest body
+Define a new Bindat type expression named @var{name} and taking
+arguments @var{args}. Its behavior follows that of @code{defmacro},
+which the important difference that the new forms can only be used
+within Bindat type expressions.
+@end defmac
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 16a8e56e90a..4d5ae3cb437 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -251,6 +251,11 @@ matches in the target buffer are highlighted. Each parenthesized
sub-expression of the regexp is shown in a distinct face, which makes
it easier to verify even very complex regexps.
+ Note that by default Emacs search ignores case (@pxref{Searching and
+Case}). To enable case-sensitive regexp search and match, bind
+@code{case-fold-search} to @code{nil} around the code you want to be
+case-sensitive.
+
@menu
* Syntax of Regexps:: Rules for writing regular expressions.
* Regexp Example:: Illustrates regular expression syntax.
@@ -363,7 +368,7 @@ preceding expression either once or not at all. For example,
@anchor{Non-greedy repetition}
@item @samp{*?}, @samp{+?}, @samp{??}
@cindex non-greedy repetition characters in regexp
-These are @dfn{non-greedy} variants of the operators @samp{*}, @samp{+}
+are @dfn{non-greedy} variants of the operators @samp{*}, @samp{+}
and @samp{?}. Where those operators match the largest possible
substring (consistent with matching the entire containing expression),
the non-greedy variants match the smallest possible substring
@@ -438,6 +443,13 @@ including newline. However, a reversed range should always be from
the letter @samp{z} to the letter @samp{a} to make it clear that it is
not a typo; for example, @samp{[+-*/]} should be avoided, because it
matches only @samp{/} rather than the likely-intended four characters.
+
+@item
+If the end points of a range are raw 8-bit bytes (@pxref{Text
+Representations}), or if the range start is ASCII and the end is a raw
+byte (as in @samp{[a-\377]}), the range will match only ASCII
+characters and raw 8-bit bytes, but not non-ASCII characters. This
+feature is intended for searching text in unibyte buffers and strings.
@end enumerate
Some kinds of character alternatives are not the best style even
@@ -2528,9 +2540,9 @@ associated with it still exists.
@cindex replacement after search
@cindex searching and replacing
- If you want to find all matches for a regexp in part of the buffer,
-and replace them, the best way is to write an explicit loop using
-@code{re-search-forward} and @code{replace-match}, like this:
+ If you want to find all matches for a regexp in part of the buffer
+and replace them, the most flexible way is to write an explicit loop
+using @code{re-search-forward} and @code{replace-match}, like this:
@example
(while (re-search-forward "foo[ \t]+bar" nil t)
@@ -2541,9 +2553,33 @@ and replace them, the best way is to write an explicit loop using
@xref{Replacing Match,, Replacing the Text that Matched}, for a
description of @code{replace-match}.
- However, replacing matches in a string is more complex, especially
-if you want to do it efficiently. So Emacs provides two functions to do
-this.
+ It may be more convenient to limit the replacements to a specific
+region. The function @code{replace-regexp-in-region} does that.
+
+@defun replace-regexp-in-region regexp replacement &optional start end
+This function replaces all the occurrences of @var{regexp} with
+@var{replacement} in the region of buffer text between @var{start} and
+@var{end}; @var{start} defaults to position of point, and @var{end}
+defaults to the last accessible position of the buffer. The search
+for @var{regexp} is case-sensitive, and @var{replacement} is inserted
+without changing its letter-case. The @var{replacement} string can
+use the same special elements starting with @samp{\} as
+@code{replace-match} does. The function returns the number of
+replaced occurrences, or @code{nil} if @var{regexp} is not found. The
+function preserves the position of point.
+
+@example
+(replace-regexp-in-region "foo[ \t]+bar" "foobar")
+@end example
+@end defun
+
+@defun replace-string-in-region string replacement &optional start end
+ This function works similarly to @code{replace-regexp-in-region},
+but searches for, and replaces, literal @var{string}s instead of
+regular expressions.
+@end defun
+
+ Emacs also has special functions for replacing matches in a string.
@defun replace-regexp-in-string regexp rep string &optional fixedcase literal subexp start
This function copies @var{string} and searches it for matches for
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 0c74dbe2aa4..20816ce8ca2 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -609,7 +609,7 @@ returned value is a list.
(seq-map-indexed (lambda (elt idx)
(list idx elt))
'(a b c))
-@result{} ((0 a) (b 1) (c 2))
+@result{} ((0 a) (1 b) (2 c))
@end group
@end example
@end defun
@@ -1111,6 +1111,23 @@ The @code{pcase} patterns provide an alternative facility for
destructuring binding, see @ref{Destructuring with pcase Patterns}.
@end defmac
+@defmac seq-setq var-sequence val-sequence
+@cindex sequence destructuring
+ This macro works similarly to @code{seq-let}, except that values are
+assigned to variables as if by @code{setq} instead of as in a
+@code{let} binding.
+
+@example
+@group
+(let ((a nil)
+ (b nil))
+ (seq-setq (_ a _ b) '(1 2 3 4))
+ (list a b))
+@result{} (2 4)
+@end group
+@end example
+@end defmac
+
@defun seq-random-elt sequence
This function returns an element of @var{sequence} taken at random.
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 5cae939b7bf..b4d7bc729f5 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -390,6 +390,22 @@ whitespace to a single space character, as well as removing all
whitespace from the start and the end of @var{string}.
@end defun
+@defun string-trim-left string &optional regexp
+Remove the leading text that matches @var{regexp} from @var{string}.
+@var{regexp} defaults to @samp{[ \t\n\r]+}.
+@end defun
+
+@defun string-trim-right string &optional regexp
+Remove the trailing text that matches @var{regexp} from @var{string}.
+@var{regexp} defaults to @samp{[ \t\n\r]+}.
+@end defun
+
+@defun string-trim string &optional trim-left trim-right
+Remove the leading text that matches @var{trim-left} and trailing text
+that matches @var{trim-right} from from @var{string}. Both regexps
+default to @samp{[ \t\n\r]+}.
+@end defun
+
@defun string-fill string length
Attempt to Word-wrap @var{string} so that no lines are longer than
@var{length}. Filling is done on whitespace boundaries only. If
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 2df6c15c4ca..deec3f44c08 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -572,12 +572,14 @@ The function is called by @code{syntax-ppss} (@pxref{Position Parse}),
and by Font Lock mode during syntactic fontification (@pxref{Syntactic
Font Lock}). It is called with two arguments, @var{start} and
@var{end}, which are the starting and ending positions of the text on
-which it should act. It is allowed to call @code{syntax-ppss} on any
-position before @var{end}, but if a Lisp program calls
-@code{syntax-ppss} on some position and later modifies the buffer at
-some earlier position, then it is that program's responsibility to
-call @code{syntax-ppss-flush-cache} to flush the now obsolete info
-from the cache.
+which it should act. It is allowed to arbitrarily move point within
+the region delimited by @var{start} and @var{end}; such motions don't
+need to use @code{save-excursion} (@pxref{Excursions}). It is also
+allowed to call @code{syntax-ppss} on any position before @var{end},
+but if a Lisp program calls @code{syntax-ppss} on some position and
+later modifies the buffer at some earlier position, then it is that
+program's responsibility to call @code{syntax-ppss-flush-cache} to
+flush the now obsolete info from the cache.
@strong{Caution:} When this variable is non-@code{nil}, Emacs removes
@code{syntax-table} text properties arbitrarily and relies on
@@ -1045,6 +1047,11 @@ Given a syntax descriptor @var{desc} (a string), this function returns
the corresponding raw syntax descriptor.
@end defun
+@defun syntax-class-to-char syntax
+Given a raw syntax descriptor @var{syntax} (an integer), this function
+returns the corresponding syntax descriptor (a character).
+@end defun
+
@defun syntax-after pos
This function returns the raw syntax descriptor for the character in
the buffer after position @var{pos}, taking account of syntax
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index b3673465240..9e0401fffb9 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -222,7 +222,9 @@ properties, just the characters themselves. @xref{Text Properties}.
@defun buffer-string
This function returns the contents of the entire accessible portion of
-the current buffer, as a string.
+the current buffer, as a string. If the text being copied has any
+text properties, these are copied into the string along with the
+characters they belong to.
@end defun
If you need to make sure the resulting string, when copied to a
@@ -313,10 +315,11 @@ word on the same line is acceptable.
@defun thing-at-point thing &optional no-properties
Return the @var{thing} around or next to point, as a string.
-The argument @var{thing} is a symbol which specifies a kind of syntactic
-entity. Possibilities include @code{symbol}, @code{list}, @code{sexp},
-@code{defun}, @code{filename}, @code{url}, @code{word}, @code{sentence},
-@code{whitespace}, @code{line}, @code{page}, and others.
+The argument @var{thing} is a symbol which specifies a kind of
+syntactic entity. Possibilities include @code{symbol}, @code{list},
+@code{sexp}, @code{defun}, @code{filename}, @code{existing-filename},
+@code{url}, @code{word}, @code{sentence}, @code{whitespace},
+@code{line}, @code{page}, and others.
When the optional argument @var{no-properties} is non-@code{nil}, this
function strips text properties from the return value.
@@ -500,6 +503,15 @@ This is like @code{insert-buffer-substring} except that it does not
copy any text properties.
@end defun
+@defun insert-into-buffer to-buffer &optional start end
+This is like @code{insert-buffer-substring}, but works in the opposite
+direction: The text is copied from the current buffer into
+@var{to-buffer}. The block of text is copied to the current point in
+@var{to-buffer}, and point (in that buffer) is advanced to after the
+end of the copied text. Is @code{start}/@code{end} is @code{nil}, the
+entire text in the current buffer is copied over.
+@end defun
+
@xref{Sticky Properties}, for other insertion functions that inherit
text properties from the nearby text in addition to inserting it.
Whitespace inserted by indentation functions also inherits text
@@ -1116,25 +1128,32 @@ one, it rotates the kill ring to place the yanked string at the front.
@end deffn
@deffn Command yank-pop &optional arg
-This command replaces the just-yanked entry from the kill ring with a
-different entry from the kill ring.
-
-This works only immediately after a @code{yank} or another
-@code{yank-pop}. At such a time, the region contains text that was just
-inserted by yanking. @code{yank-pop} deletes that text and inserts in
-its place a different piece of killed text. It does not add the deleted
-text to the kill ring, since it is already in the kill ring somewhere.
-It does however rotate the kill ring to place the newly yanked string at
-the front.
+When invoked immediately after a @code{yank} or another
+@code{yank-pop}, this command replaces the just-yanked entry from the
+kill ring with a different entry from the kill ring. When this
+command is invoked like that, the region contains text that was just
+inserted by another yank command. @code{yank-pop} deletes that text
+and inserts in its place a different piece of killed text. It does
+not add the deleted text to the kill ring, since it is already in the
+kill ring somewhere. It does however rotate the kill ring to place
+the newly yanked string at the front.
If @var{arg} is @code{nil}, then the replacement text is the previous
element of the kill ring. If @var{arg} is numeric, the replacement is
the @var{arg}th previous kill. If @var{arg} is negative, a more recent
kill is the replacement.
-The sequence of kills in the kill ring wraps around, so that after the
-oldest one comes the newest one, and before the newest one goes the
-oldest.
+The sequence of kills in the kill ring wraps around, so if
+@code{yank-pop} is invoked repeatedly and reaches the oldest kill, the
+one that comes after it is the newest one, and the one before the
+newest one is the oldest one.
+
+This command can also be invoked after a command that is not a yank
+command. In that case, it prompts in the minibuffer for a kill-ring
+entry, with completion, and uses the kill ring elements as the
+minibuffer history (@pxref{Minibuffer History}). This allows the user
+to interactively select one of the previous kills recorded in the kill
+ring.
The return value is always @code{nil}.
@end deffn
@@ -4157,7 +4176,7 @@ file names only:
If the condition value is anything else, then the position is inside a
link and the condition itself is the action code. Clearly, you should
specify this kind of condition only when applying the condition via a
-text or property overlay on the link text (so that it does not apply
+text or overlay property on the link text (so that it does not apply
to the entire buffer).
@end table
@@ -4390,7 +4409,8 @@ based on their character codes.
@cindex replace characters
This function replaces all occurrences of the character @var{old-char}
with the character @var{new-char} in the region of the current buffer
-defined by @var{start} and @var{end}.
+defined by @var{start} and @var{end}. Both characters must have the
+same length of their multibyte form.
@cindex undo avoidance
If @var{noundo} is non-@code{nil}, then @code{subst-char-in-region} does
@@ -4419,6 +4439,16 @@ ThXs Xs the contents of the buffer before.
@end example
@end defun
+
+@defun subst-char-in-string fromchar tochar string &optional inplace
+@cindex replace characters in string
+This function replaces all occurrences of the character @var{fromchar}
+with @var{tochar} in @var{string}. By default, substitution occurs in
+a copy of @var{string}, but if the optional argument @var{inplace} is
+non-@code{nil}, the function modifies the @var{string} itself. In any
+case, the function returns the resulting string.
+@end defun
+
@deffn Command translate-region start end table
This function applies a translation table to the characters in the
buffer between positions @var{start} and @var{end}.
@@ -5272,11 +5302,20 @@ represents @code{@{@}}, the empty JSON object; not @code{null},
@code{false}, or an empty array, all of which are different JSON
values.
+@defun json-available-p
+This predicate returns non-@code{nil} if Emacs has been built with
+@acronym{JSON} support, and the library is available on the current
+system.
+@end defun
+
If some Lisp object can't be represented in JSON, the serialization
functions will signal an error of type @code{wrong-type-argument}.
The parsing functions can also signal the following errors:
@table @code
+@item json-unavailable
+Signaled when the parsing library isn't available.
+
@item json-end-of-file
Signaled when encountering a premature end of the input text.
@@ -5288,10 +5327,9 @@ object parsed.
Signaled when encountering invalid JSON syntax.
@end table
- Only top-level values (arrays and objects) can be serialized to
-JSON@. The subobjects within these top-level values can be of any
-type. Likewise, the parsing functions will only return vectors,
-hashtables, alists, and plists.
+ Top-level values and the subobjects within these top-level values
+can be serialized to JSON@. Likewise, the parsing functions will
+return any of the possible types described above.
@defun json-serialize object &rest args
This function returns a new Lisp string which contains the JSON
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 4a7793a976d..8aa225a00c3 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -75,8 +75,8 @@ 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.
+variables, etc., work better if they start with @samp{define-}, 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
@@ -168,11 +168,12 @@ follow the naming conventions for hooks. @xref{Hooks}.
@item
@cindex unloading packages, preparing for
-If loading the file adds functions to hooks, define a function
-@code{@var{feature}-unload-function}, where @var{feature} is the name
-of the feature the package provides, and make it undo any such
-changes. Using @code{unload-feature} to unload the file will run this
-function. @xref{Unloading}.
+Using @code{unload-feature} will undo the changes usually done by
+loading a feature (like adding functions to hooks). However, if
+loading @var{feature} does something unusual and more complex, you can
+define a function named @code{@var{feature}-unload-function}, and make
+it undo any such special changes. @code{unload-feature} will then
+automatically run this function if it exists. @xref{Unloading}.
@item
It is a bad idea to define aliases for the Emacs primitives. Normally
@@ -1034,7 +1035,7 @@ the conventional possibilities for @var{header-name}:
@table @samp
@item Author
-This line states the name and email address of at least the principal
+This header states the name and email address of at least the principal
author of the library. If there are multiple authors, list them on
continuation lines led by @code{;;} and a tab or at least two spaces.
We recommend including a contact email address, of the form
@@ -1053,8 +1054,8 @@ This header has the same format as the Author header. It lists the
person(s) who currently maintain(s) the file (respond to bug reports,
etc.).
-If there is no maintainer line, the person(s) in the Author field
-is/are presumed to be the maintainers. Some files in Emacs use
+If there is no Maintainer header, the person(s) in the Author header
+is/are presumed to be the maintainer(s). Some files in Emacs use
@samp{emacs-devel@@gnu.org} for the maintainer, which means the author is
no longer responsible for the file, and that it is maintained as part
of Emacs.
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 63438170d1a..9356fb9f699 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1010,6 +1010,9 @@ a dynamic local binding, Emacs records the contents of the value cell
value cell. When the binding construct finishes executing, Emacs pops
the old value off the stack, and puts it in the value cell.
+ Note that when code using Dynamic Binding is native compiled the
+native compiler will not perform any Lisp specific optimization.
+
@node Dynamic Binding Tips
@subsection Proper Use of Dynamic Binding
@@ -1579,6 +1582,12 @@ buffer-local binding in buffer @var{buffer}, it returns the default
value (@pxref{Default Value}) of @var{variable} instead.
@end defun
+@defun buffer-local-boundp variable buffer
+This returns non-@code{nil} if there's either a buffer-local binding
+of @var{variable} (a symbol) in buffer @var{buffer}, or @var{variable}
+has a global binding.
+@end defun
+
@defun buffer-local-variables &optional buffer
This function returns a list describing the buffer-local variables in
buffer @var{buffer}. (If @var{buffer} is omitted, the current buffer
@@ -1696,7 +1705,6 @@ buffer has a buffer-local binding. For example, you could use
you are in a C or Lisp mode buffer that has a buffer-local value for
this variable.
-@c Emacs 19 feature
The special forms @code{defvar} and @code{defconst} also set the
default value (if they set the variable at all), rather than any
buffer-local value.
@@ -1708,7 +1716,6 @@ this variable. If @var{symbol} is not buffer-local, this is equivalent
to @code{symbol-value} (@pxref{Accessing Variables}).
@end defun
-@c Emacs 19 feature
@defun default-boundp symbol
The function @code{default-boundp} tells you whether @var{symbol}'s
default value is nonvoid. If @code{(default-boundp 'foo)} returns
@@ -1884,6 +1891,14 @@ any form of file-local variable. For examples of why you might want
to use this, @pxref{Auto Major Mode}.
@end defvar
+@defvar permanently-enabled-local-variables
+Some local variable settings will, by default, be heeded even if
+@code{enable-local-variables} is @code{nil}. By default, this is only
+the case for the @code{lexical-binding} local variable setting, but
+this can be controlled by using this variable, which is a list of
+symbols.
+@end defvar
+
@defun hack-local-variables &optional handle-mode
This function parses, and binds or evaluates as appropriate, any local
variables specified by the contents of the current buffer. The variable
@@ -1980,6 +1995,20 @@ Doing so adds those variable/value pairs to
file.
@end defopt
+@defopt ignored-local-variable-values
+If there are some values of particular local variables that you always
+want to ignore completely, you can use this variable. Its value has
+the same form as @code{safe-local-variable-values}; a file-local
+variable setting to the value that appears in the list will always be
+ignored when processing the local variables specified by the file. As
+with that variable, when Emacs queries the user about whether to obey
+file-local variables, the user can choose to ignore their particular
+values permanently, and that will alter this variable and save it to
+the user's custom file. Variable-value pairs that appear in this
+variable take precedence over the same pairs in
+@code{safe-local-variable-values}.
+@end defopt
+
@defun safe-local-variable-p sym val
This function returns non-@code{nil} if it is safe to give @var{sym}
the value @var{val}, based on the above criteria.
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index f305d1a8ee8..26f85df160e 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -1318,6 +1318,33 @@ lieu of the usual action of @code{delete-window}. @xref{Window
Parameters}.
@end deffn
+When @code{delete-window} deletes the selected window of its frame, it
+has to make another window the new selected window of that frame. The
+following option allows configuring which window is chosen.
+
+@defopt delete-window-choose-selected
+This option allows specifying which window should become a frame's
+selected window after @code{delete-window} has deleted the previously
+selected one. Possible choices are
+
+@itemize
+@item @code{mru}
+(the default) choose the most recently used window on that frame.
+
+@item @code{pos}
+choose the window comprising the frame coordinates of point of the
+previously selected window on that frame.
+
+@item @code{nil}
+choose the first window (the window returned by
+@code{frame-first-window}) on that frame.
+@end itemize
+
+A window with a non-@code{nil} @code{no-other-window} parameter is
+chosen only if all other windows on that frame have that parameter set
+to a non-@code{nil} value too.
+@end defopt
+
@deffn Command delete-other-windows &optional window
This function makes @var{window} fill its frame, deleting other
windows as necessary. If @var{window} is omitted or @code{nil}, it
@@ -1838,6 +1865,14 @@ with @var{window} as the selected window without needlessly running
@code{buffer-list-update-hook}.
@end defmac
+@defmac with-selected-frame frame forms@dots{}
+This macro executes @var{forms} with @var{frame} as the selected
+frame. The value returned is the value of the last form in
+@var{forms}. This macro saves and restores the selected frame, and
+changes the order of neither the recently selected windows nor the
+buffers in the buffer list.
+@end defmac
+
@defun frame-selected-window &optional frame
This function returns the window on @var{frame} that is selected
within that frame. @var{frame} should be a live frame; if omitted or
@@ -1999,7 +2034,7 @@ meaning as for @code{next-window}.
criterion, without selecting it:
@cindex least recently used window
-@defun get-lru-window &optional all-frames dedicated not-selected
+@defun get-lru-window &optional all-frames dedicated not-selected no-other
This function returns a live window which is heuristically the least
recently used. The optional argument @var{all-frames} has
the same meaning as in @code{next-window}.
@@ -2010,33 +2045,25 @@ window (@pxref{Dedicated Windows}) is never a candidate unless the
optional argument @var{dedicated} is non-@code{nil}. The selected
window is never returned, unless it is the only candidate. However, if
the optional argument @var{not-selected} is non-@code{nil}, this
-function returns @code{nil} in that case.
+function returns @code{nil} in that case. The optional argument
+@var{no-other}, if non-@code{nil}, means to never return a window whose
+@code{no-other-window} parameter is non-@code{nil}.
@end defun
@cindex most recently used window
-@defun get-mru-window &optional all-frames dedicated not-selected
+@defun get-mru-window &optional all-frames dedicated not-selected no-other
This function is like @code{get-lru-window}, but it returns the most
recently used window instead. The meaning of the arguments is the
-same as described for @code{get-lru-window}.
+same as for @code{get-lru-window}.
@end defun
@cindex largest window
-@defun get-largest-window &optional all-frames dedicated not-selected
+@defun get-largest-window &optional all-frames dedicated not-selected no-other
This function returns the window with the largest area (height times
-width). The optional argument @var{all-frames} specifies the windows to
-search, and has the same meaning as in @code{next-window}.
-
-A minibuffer window is never a candidate. A dedicated window
-(@pxref{Dedicated Windows}) is never a candidate unless the optional
-argument @var{dedicated} is non-@code{nil}. The selected window is not
-a candidate if the optional argument @var{not-selected} is
-non-@code{nil}. If the optional argument @var{not-selected} is
-non-@code{nil} and the selected window is the only candidate, this
-function returns @code{nil}.
-
-If there are two candidate windows of the same size, this function
-prefers the one that comes first in the cyclic ordering of windows,
-starting from the selected window.
+width). If there are two candidate windows of the same size, it prefers
+the one that comes first in the cyclic ordering of windows, starting
+from the selected window. The meaning of the arguments is the same as
+for @code{get-lru-window}.
@end defun
@cindex window that satisfies a predicate
@@ -2164,12 +2191,13 @@ the name of an existing buffer; if omitted or @code{nil}, it defaults to
the current buffer.
The replacement buffer in each window is chosen via
-@code{switch-to-prev-buffer} (@pxref{Window History}). Any dedicated
-window displaying @var{buffer-or-name} is deleted if possible
-(@pxref{Dedicated Windows}). If such a window is the only window on its
-frame and there are other frames on the same terminal, the frame is
-deleted as well. If the dedicated window is the only window on the only
-frame on its terminal, the buffer is replaced anyway.
+@code{switch-to-prev-buffer} (@pxref{Window History}). With the
+exception of side windows (@pxref{Side Windows}), any dedicated window
+displaying @var{buffer-or-name} is deleted if possible (@pxref{Dedicated
+Windows}). If such a window is the only window on its frame and there
+are other frames on the same terminal, the frame is deleted as well.
+If the dedicated window is the only window on the only frame on its
+terminal, the buffer is replaced anyway.
@end deffn
@@ -2557,7 +2585,7 @@ frame visible and, unless @var{alist} contains an
This function tries to display @var{buffer} by finding a window
that is displaying a buffer in a given mode.
-If @var{alist} contains a @code{mode} entry, its value specifes a
+If @var{alist} contains a @code{mode} entry, its value specifies a
major mode (a symbol) or a list of major modes. If @var{alist}
contains no @code{mode} entry, the current major mode of @var{buffer}
is used instead. A window is a candidate if it displays a buffer
@@ -2986,6 +3014,8 @@ If non-@code{nil}, such an entry tells @code{display-buffer} to mark
any window it creates as dedicated to its buffer (@pxref{Dedicated
Windows}). It does that by calling @code{set-window-dedicated-p} with
the chosen window as first argument and the entry's value as second.
+Side windows are by default dedicated with the value @code{side}
+((@pxref{Side Window Options and Functions}).
@vindex preserve-size@r{, a buffer display action alist entry}
@item preserve-size
@@ -4034,18 +4064,19 @@ slightly different, see below.
Functions supposed to remove a buffer from a window or a window from
a frame can behave specially when a window they operate on is dedicated.
-We will distinguish three basic cases, namely where (1) the window is
+We will distinguish four basic cases, namely where (1) the window is
not the only window on its frame, (2) the window is the only window on
-its frame but there are other frames on the same terminal left, and (3)
-the window is the only window on the only frame on the same terminal.
+its frame but there are other frames on the same terminal left, (3)
+the window is the only window on the only frame on the same terminal,
+and (4) the dedication's value is @code{side}
+(@pxref{Displaying Buffers in Side Windows}).
In particular, @code{delete-windows-on} (@pxref{Deleting Windows})
-handles case (2) by deleting the associated frame and case (3) by
-showing another buffer in that frame's only window. The function
+handles case (2) by deleting the associated frame and cases (3) and (4)
+by showing another buffer in that frame's only window. The function
@code{replace-buffer-in-windows} (@pxref{Buffers and Windows}) which is
called when a buffer gets killed, deletes the window in case (1) and
behaves like @code{delete-windows-on} otherwise.
-@c FIXME: Does replace-buffer-in-windows _delete_ a window in case (1)?
When @code{bury-buffer} (@pxref{Buffer List}) operates on the
selected window (which shows the buffer that shall be buried), it
@@ -4308,6 +4339,25 @@ means to use a slot following (that is, below or on the right of) the
middle slot. Hence, all windows on a specific side are ordered by their
@code{slot} value. If unspecified, the window is located in the middle
of the specified side.
+
+@item dedicated
+The dedicated flag (@pxref{Dedicated Windows}) has a slightly different
+meaning for side windows. When a side window is created, that flag is
+set to the value @code{side} to prevent @code{display-buffer} to use the
+window in other action functions. Its value persists across invocations
+of @code{quit-window}, @code{kill-buffer}, @code{previous-buffer} and
+@code{next-buffer}.
+
+In particular, these commands will refrain from showing, in a side
+window, buffers that have not been displayed in that window before.
+They will also refrain from having a normal, non-side window show a
+buffer that has been already displayed in a side window. A notable
+exception to the latter rule occurs when an application, after
+displaying a buffer, resets that buffer’s local variables. To override
+these rules and always delete a side window with @code{quit-window} or
+@code{kill-buffer}, and eventually prevent the use of
+@code{previous-buffer} and @code{next-buffer}, set this value to
+@code{t} or specify a value via @code{display-buffer-mark-dedicated}.
@end table
If you specify the same slot on the same side for two or more different
@@ -4328,16 +4378,6 @@ Functions}) unless it is explicitly specified as target of that
action. Note also that @code{delete-other-windows} cannot make a side
window the only window on its frame (@pxref{Deleting Windows}).
- Once set up, side windows also change the behavior of the commands
-@code{switch-to-prev-buffer} and @code{switch-to-next-buffer}
-(@pxref{Window History}). In particular, these commands will refrain
-from showing, in a side window, buffers that have not been displayed in
-that window before. They will also refrain from having a normal,
-non-side window show a buffer that has been already displayed in a side
-window. A notable exception to the latter rule occurs when an
-application, after displaying a buffer, resets that buffer's local
-variables.
-
@node Side Window Options and Functions
@subsection Side Window Options and Functions
@@ -5877,7 +5917,7 @@ which window parameters (if any) are saved by this function.
@xref{Window Parameters}.
@end defun
-@defun set-window-configuration configuration &optional dont-set-frame
+@defun set-window-configuration configuration &optional dont-set-frame dont-set-miniwindow
This function restores the configuration of windows and buffers as
specified by @var{configuration}, for the frame that
@var{configuration} was created for, regardless of whether that frame
@@ -5885,8 +5925,12 @@ is selected or not. The argument @var{configuration} must be a value
that was previously returned by @code{current-window-configuration}
for that frame. Normally the function also selects the frame which is
recorded in the configuration, but if @var{dont-set-frame} is
-non-@code{nil}, it leaves selected the frame which was current at the
-start of the function.
+non-@code{nil}, it leaves selected the frame which was already
+selected at the start of the function.
+
+Normally the function restores the saved minibuffer (if any), but if
+@var{dont-set-miniwindow} is non-@code{nil}, the minibuffer current
+at the start of the function (if any) remains in the mini-window.
If the frame from which @var{configuration} was saved is dead, all
this function does is to restore the value of the variable
diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in
index da912bd5112..290be604e3b 100644
--- a/doc/man/emacs.1.in
+++ b/doc/man/emacs.1.in
@@ -197,7 +197,7 @@ searches for Lisp files.
.\" START DELETING HERE IF YOU'RE NOT USING X
.SS Using Emacs with X
.I Emacs
-has been tailored to work well with the X window system.
+has been tailored to work well with the X Window System.
If you run
.I Emacs
from under X windows, it will create its own X window to
@@ -566,7 +566,7 @@ distribution.
/usr/local/share/info \(em files for the Info documentation browser.
The complete text of the Emacs reference manual is included in a
convenient tree structured form.
-Also includes the Emacs Lisp Reference Manual, useful to anyone
+This includes the Emacs Lisp Reference Manual, useful to anyone
wishing to write programs in the Emacs Lisp extension language,
and the Introduction to Programming in Emacs Lisp.
diff --git a/doc/man/etags.1 b/doc/man/etags.1
index c5c15fb1826..cbd3c1a646e 100644
--- a/doc/man/etags.1
+++ b/doc/man/etags.1
@@ -1,5 +1,5 @@
.\" See section COPYING for copyright and redistribution information.
-.TH ETAGS 1 "2019-06-24" "GNU Tools" "GNU"
+.TH ETAGS 1 "2021-03-30" "GNU Tools" "GNU"
.de BP
.sp
.ti -.2i
@@ -50,9 +50,9 @@ format understood by
.BR vi ( 1 )\c
\&. Both forms of the program understand
the syntax of C, Objective C, C++, Java, Fortran, Ada, Cobol, Erlang,
-Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Pascal, Perl,
-Ruby, PHP, PostScript, Python, Prolog, Scheme and
-most assembler\-like syntaxes.
+Forth, Go, HTML, LaTeX, Emacs Lisp/Common Lisp, Lua, Makefile, Mercury, Pascal,
+Perl, Ruby, Rust, PHP, PostScript, Python, Prolog, Scheme and most
+assembler\-like syntaxes.
Both forms read the files specified on the command line, and write a tag
table (defaults: \fBTAGS\fP for \fBetags\fP, \fBtags\fP for
\fBctags\fP) in the current working directory.
@@ -91,6 +91,9 @@ Only \fBctags\fP accepts this option.
In C and derived languages, create tags for function declarations,
and create tags for extern variables unless \-\-no\-globals is used.
In Lisp, create tags for (defvar foo) declarations.
+In Mercury, declarations start a line with "\|\fB:-\fP\|" and are always
+tagged. In addition, this option tags predicates or functions in first
+rules of clauses, as in Prolog.
.TP
.B \-D, \-\-no\-defines
Do not create tag entries for C preprocessor constant definitions
@@ -125,10 +128,14 @@ final brace of a function or structure definition in C and C++.
Parse the following files according to the given language. More than
one such options may be intermixed with filenames. Use \fB\-\-help\fP
to get a list of the available languages and their default filename
-extensions. The "auto" language can be used to restore automatic
-detection of language based on the file name. The "none"
-language may be used to disable language parsing altogether; only
-regexp matching is done in this case (see the \fB\-\-regex\fP option).
+extensions. For example, as Mercury and Objective-C have same
+filename extension \fI.m\fP, a test based on contents tries to detect
+the language. If this test fails, \fB\-\-language=\fP\fImercury\fP or
+\fB\-\-language=\fP\fIobjc\fP should be used.
+The "auto" language can be used to restore automatic detection of language
+based on the file name. The "none" language may be used to disable language
+parsing altogether; only regexp matching is done in this case (see the
+\fB\-\-regex\fP option).
.TP
.B \-\-members
Create tag entries for variables that are members of structure-like
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index d627055ae1d..7982c0dc5ae 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -22,6 +22,8 @@ SHELL = @SHELL@
# Where to find the source code. $(srcdir) will be the doc/misc subdirectory
# of the source tree. This is set by configure's '--srcdir' option.
srcdir=@srcdir@
+top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
## Where the output files go.
## Note that all the Info targets build the Info files in srcdir.
@@ -82,11 +84,23 @@ INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32)
## because the info files are pre-built in release tarfiles.
INFO_TARGETS = $(INFO_COMMON) efaq-w32
+## Some manuals have their source in .org format.
+## This is discouraged because the .texi files it generates
+## are not as well formatted as handwritten ones.
+ORG_SETUP = $(wildcard ${srcdir}/*-setup.org)
+ORG_SRC = $(filter-out ${ORG_SETUP},$(wildcard ${srcdir}/*.org))
+TEXI_FROM_ORG = ${ORG_SRC:.org=.texi}
+
# There are some naming differences between the info targets and the other
# targets, so let's resolve them here.
TARGETS_1 = $(INFO_INSTALL:ccmode=cc-mode)
TARGETS = $(TARGETS_1:info.info=info)
+texi_sources = $(addsuffix .texi,${TARGETS})
+texi_notgen = $(filter-out $(notdir ${TEXI_FROM_ORG}),${texi_sources})
+texi_and_org = $(notdir ${ORG_SRC}) ${texi_notgen}
+SOURCES = $(sort ${texi_and_org})
+
DVI_TARGETS = $(TARGETS:=.dvi)
HTML_TARGETS = $(TARGETS:=.html)
PDF_TARGETS = $(TARGETS:=.pdf)
@@ -96,13 +110,7 @@ TEXI2DVI = texi2dvi
TEXI2PDF = texi2pdf
DVIPS = dvips
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
+-include ${top_builddir}/src/verbose.mk
ENVADD = $(AM_V_GEN)TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \
MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)"
@@ -110,7 +118,7 @@ ENVADD = $(AM_V_GEN)TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \
gfdl = ${srcdir}/doclicense.texi
style = ${emacsdir}/docstyle.texi
-.PHONY: info dvi html pdf ps echo-info $(INFO_TARGETS)
+.PHONY: info dvi html pdf ps echo-info echo-sources $(INFO_TARGETS)
## Prevent implicit rule triggering for foo.info.
.SUFFIXES:
@@ -126,6 +134,9 @@ echo-info:
@echo "$(INFO_INSTALL) " | \
sed -e 's|[^ ]*/||g' -e 's/\.info//g' -e "s/ */.info /g"
+echo-sources:
+ @echo ${SOURCES}
+
dvi: $(DVI_TARGETS)
html: $(HTML_TARGETS)
@@ -221,6 +232,30 @@ gnus.pdf: $(gnus_deps)
${buildinfodir}/tramp.info tramp.html: ${srcdir}/trampver.texi
+abs_top_builddir = @abs_top_builddir@
+EMACS = ${abs_top_builddir}/src/emacs
+emacs = "${EMACS}" -batch --no-site-file --no-site-lisp --eval '(setq load-prefer-newer t)'
+
+# Generated .texi files go in srcdir so they can be included in the
+# release tarfile along with the others.
+# Work in srcdir (and use abs_top_builddir) so that +setupfile and
+# things like org-setup's "version" macro work. Sigh.
+define org_template
+ $(1:.org=.texi): $(1) ${top_srcdir}/lisp/org/ox-texinfo.el
+ $${AM_V_GEN}cd "$${srcdir}" && $${emacs} -l ox-texinfo \
+ -f org-texinfo-export-to-texinfo-batch $$(notdir $$<) $$(notdir $$@)
+endef
+
+$(foreach orgfile,${ORG_SRC},$(eval $(call org_template,$(orgfile))))
+
+## foo.org depends on foo-setup.org, if the latter exists.
+define org_setup_template
+ $(1:-setup.org=.texi): $(1)
+endef
+
+$(foreach orgfile,${ORG_SETUP},$(eval $(call org_setup_template,$(orgfile))))
+
+
.PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean
mostlyclean:
@@ -245,7 +280,13 @@ infoclean:
$(buildinfodir)/$${file}-[1-9][0-9]; \
done
-bootstrap-clean maintainer-clean: distclean infoclean
+.PHONY: orgclean
+
+orgclean:
+ rm -f ${TEXI_FROM_ORG}
+
+bootstrap-clean maintainer-clean: distclean infoclean orgclean
+ rm -f TAGS
.PHONY: install-dvi install-html install-pdf install-ps install-doc
@@ -295,4 +336,20 @@ uninstall-pdf:
uninstall-doc: uninstall-dvi uninstall-html uninstall-pdf uninstall-ps
+ETAGS = ../../lib-src/etags${EXEEXT}
+
+${ETAGS}: FORCE
+ $(MAKE) -C $(dir $@) $(notdir $@)
+
+texifiles = $(wildcard ${srcdir}/*.texi)
+
+TAGS: ${ETAGS} $(texifiles)
+ $(AM_V_GEN)${ETAGS} $(texifiles)
+
+tags: TAGS
+.PHONY: tags
+
+FORCE:
+.PHONY: FORCE
+
### Makefile ends here
diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi
index 72ba73697d3..5f9dc01d33f 100644
--- a/doc/misc/autotype.texi
+++ b/doc/misc/autotype.texi
@@ -579,7 +579,7 @@ table:
@vindex skeleton-transformation
Insert string or character. Literal strings and characters are passed through
@code{skeleton-transformation} when that is non-@code{nil}.
-@item @code{?\n}
+@item @code{\n}
@c ??? something seems very wrong here.
Insert a newline and align under current line, but not if this is the
last element of a skeleton and the newline would be inserted at end of
diff --git a/doc/misc/bovine.texi b/doc/misc/bovine.texi
index 780f0addb59..9bfb117d1a5 100644
--- a/doc/misc/bovine.texi
+++ b/doc/misc/bovine.texi
@@ -78,13 +78,13 @@ The @dfn{bovine} parser is the original @semantic{} parser, and is an
implementation of an @acronym{LL} parser. It is good for simple
languages. It has many conveniences making grammar writing easy. The
conveniences make it less powerful than a Bison-like @acronym{LALR}
-parser. For more information, @inforef{Top, The Wisent Parser Manual,
+parser. For more information, @pxref{Top,, Wisent Parser Development,
wisent}.
Bovine @acronym{LL} grammars are stored in files with a @file{.by}
extension. When compiled, the contents is converted into a file of
the form @file{NAME-by.el}. This, in turn is byte compiled.
-@inforef{top, Grammar Framework Manual, grammar-fw}.
+@xref{top,, Grammar Framework Manual, grammar-fw}.
@ifnottex
@insertcopying
@@ -105,7 +105,8 @@ the form @file{NAME-by.el}. This, in turn is byte compiled.
In Bison, one and only one nonterminal is designated as the ``start''
symbol. In @semantic{}, one or more nonterminals can be designated as
the ``start'' symbol. They are declared following the @code{%start}
-keyword separated by spaces. @inforef{start Decl, ,grammar-fw}.
+keyword separated by spaces. @xref{start Decl,, Grammar Framework
+Manual, grammar-fw}.
If no @code{%start} keyword is used in a grammar, then the very first
is used. Internally the first start nonterminal is targeted by the
@@ -115,7 +116,8 @@ parser harness.
To find locally defined variables, the local context handler needs to
parse the body of functional code. The @code{scopestart} declaration
specifies the name of a nonterminal used as the goal to parse a local
-context, @inforef{scopestart Decl, ,grammar-fw}. Internally the
+context, @pxref{scopestart Decl,, Grammar Framework Manual,
+grammar-fw}. Internally the
scopestart nonterminal is targeted by the reserved symbol
@code{bovine-inner-scope}, so it can be found by the parser harness.
@@ -124,7 +126,7 @@ scopestart nonterminal is targeted by the reserved symbol
The rules are what allow the compiler to create tags from a language
file. Once the setup is done in the prologue, you can start writing
-rules. @inforef{Grammar Rules, ,grammar-fw}.
+rules. @xref{Grammar Rules,, Grammar Framework Manual, grammar-fw}.
@example
@var{result} : @var{components1} @var{optional-semantic-action1})
@@ -146,8 +148,8 @@ A particular @var{result} written into your grammar becomes
the parser's goal. It is designated by a @code{%start} statement
(@pxref{Starting Rules}). The value returned by the associated
@var{optional-semantic-action} is the parser's result. It should be
-a tree of @semantic{} @dfn{tags}, @inforef{Semantic Tags, ,
-semantic-appdev}.
+a tree of @semantic{} @dfn{tags}, @pxref{Semantic Tags,, Semantic
+Application Development, semantic-appdev}.
@var{components} is made up of symbols. A symbol such as @code{FOO}
means that a syntactic token of class @code{FOO} must be matched.
@@ -170,8 +172,9 @@ For instance:
@end example
Means that @code{FOO} is a reserved language keyword, matched as such
-by looking up into a keyword table, @inforef{keyword Decl,
-,grammar-fw}. This is because @code{"foo"} will be converted to
+by looking up into a keyword table, @pxref{keyword Decl,, Grammar
+Framework Manual, grammar-fw}. This is because @code{"foo"} will be
+converted to
@code{FOO} in the lexical analysis stage. Thus the symbol @code{FOO}
won't be available any other way.
@@ -383,8 +386,8 @@ Is an optional set of labeled values such as @code{:constant-flag t :parent
Create a tag with @var{name} of respectively the class
@code{variable}, @code{function}, @code{type}, @code{include},
@code{package}, and @code{code}.
-See @inforef{Creating Tags, , semantic-appdev} for the lisp
-functions these translate into.
+See @ref{Creating Tags,, Semantic Application Development,
+semantic-appdev}, for the lisp functions these translate into.
@end table
If the symbol @code{%quotemode backquote} is specified, then use
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index c4ccea3caf4..e11267e7a20 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -588,7 +588,7 @@ there are Quick mode, Keypad mode, and Embedded mode.
* Other C-x * Commands::
@end menu
-@node Starting Calc, The Standard Interface, Using Calc, Using Calc
+@node Starting Calc
@subsection Starting Calc
@noindent
@@ -619,7 +619,7 @@ type the full command (like @kbd{calc-keypad}) and press Return.
The same commands (like @kbd{C-x * c} or @kbd{C-x * *}) that start
the Calculator also turn it off if it is already on.
-@node The Standard Interface, Quick Mode Overview, Starting Calc, Using Calc
+@node The Standard Interface
@subsection The Standard Calc Interface
@noindent
@@ -713,7 +713,7 @@ switch you to the Calc Trail window. So @kbd{C-x * o} is a handy
way to switch out of Calc momentarily to edit your file; you can then
type @kbd{C-x * c} to switch back into Calc when you are done.
-@node Quick Mode Overview, Keypad Mode Overview, The Standard Interface, Using Calc
+@node Quick Mode Overview
@subsection Quick Mode (Overview)
@noindent
@@ -736,7 +736,7 @@ go into regular Calc (with @kbd{C-x * c}) to change the mode settings.
@c [fix-ref Quick Calculator mode]
@xref{Quick Calculator}, for further information.
-@node Keypad Mode Overview, Standalone Operation, Quick Mode Overview, Using Calc
+@node Keypad Mode Overview
@subsection Keypad Mode (Overview)
@noindent
@@ -814,7 +814,7 @@ left, the stack in the lower right, and the trail on top.
@c [fix-ref Keypad Mode]
@xref{Keypad Mode}, for further information.
-@node Standalone Operation, Embedded Mode Overview, Keypad Mode Overview, Using Calc
+@node Standalone Operation
@subsection Standalone Operation
@noindent
@@ -841,7 +841,7 @@ In standalone operation, quitting the Calculator (by pressing
@kbd{q} or clicking on the keypad @key{EXIT} button) quits Emacs
itself.
-@node Embedded Mode Overview, Other C-x * Commands, Standalone Operation, Using Calc
+@node Embedded Mode Overview
@subsection Embedded Mode (Overview)
@noindent
@@ -972,7 +972,7 @@ A slope of one-third corresponds to an angle of 18.4349488229 degrees.
@c [fix-ref Embedded Mode]
@xref{Embedded Mode}, for full details.
-@node Other C-x * Commands, , Embedded Mode Overview, Using Calc
+@node Other C-x * Commands
@subsection Other @kbd{C-x *} Commands
@noindent
@@ -1329,7 +1329,7 @@ Calc.
* Answers to Exercises::
@end menu
-@node Basic Tutorial, Arithmetic Tutorial, Tutorial, Tutorial
+@node Basic Tutorial
@section Basic Tutorial
@noindent
@@ -1344,7 +1344,7 @@ to control various modes of the Calculator.
* Modes Tutorial:: Common mode-setting commands.
@end menu
-@node RPN Tutorial, Algebraic Tutorial, Basic Tutorial, Basic Tutorial
+@node RPN Tutorial
@subsection RPN Calculations and the Stack
@cindex RPN notation
@@ -1738,7 +1738,7 @@ Another common idiom is @kbd{M-0 @key{DEL}}, which clears the stack.
(The @kbd{M-0} numeric prefix tells @key{DEL} to operate on the
entire stack.)
-@node Algebraic Tutorial, Undo Tutorial, RPN Tutorial, Basic Tutorial
+@node Algebraic Tutorial
@subsection Algebraic-Style Calculations
@noindent
@@ -2038,7 +2038,7 @@ You can also ``unstore'' a variable when you are through with it:
We will encounter formulas involving variables and functions again
when we discuss the algebra and calculus features of the Calculator.
-@node Undo Tutorial, Modes Tutorial, Algebraic Tutorial, Basic Tutorial
+@node Undo Tutorial
@subsection Undo and Redo
@noindent
@@ -2175,7 +2175,7 @@ new number. This works for formulas, vectors, and all other types
of values you can put on the stack. The @kbd{`} key also works
during entry of a number or algebraic formula.
-@node Modes Tutorial, , Undo Tutorial, Basic Tutorial
+@node Modes Tutorial
@subsection Mode-Setting Commands
@noindent
@@ -2655,7 +2655,7 @@ again when we change to Fraction mode. All @samp{=>} expressions
on the stack are recomputed every time you change any mode that
might affect their values.
-@node Arithmetic Tutorial, Vector/Matrix Tutorial, Basic Tutorial, Tutorial
+@node Arithmetic Tutorial
@section Arithmetic Tutorial
@noindent
@@ -3041,7 +3041,7 @@ like @code{pv}, @code{rate}, and @code{sln}).
@xref{Binary Functions}, to read about the commands for operating
on binary numbers (like @code{and}, @code{xor}, and @code{lsh}).
-@node Vector/Matrix Tutorial, Types Tutorial, Arithmetic Tutorial, Tutorial
+@node Vector/Matrix Tutorial
@section Vector/Matrix Tutorial
@noindent
@@ -3056,7 +3056,7 @@ a vector as a list of objects.
* List Tutorial::
@end menu
-@node Vector Analysis Tutorial, Matrix Tutorial, Vector/Matrix Tutorial, Vector/Matrix Tutorial
+@node Vector Analysis Tutorial
@subsection Vector Analysis
@noindent
@@ -3181,7 +3181,7 @@ probabilities for the particle to be at the corresponding positions.
Find the average position of the particle.
@xref{Vector Answer 2, 2}. (@bullet{})
-@node Matrix Tutorial, List Tutorial, Vector Analysis Tutorial, Vector/Matrix Tutorial
+@node Matrix Tutorial
@subsection Matrices
@noindent
@@ -3507,7 +3507,7 @@ $$
@noindent
@xref{Matrix Answer 3, 3}. (@bullet{})
-@node List Tutorial, , Matrix Tutorial, Vector/Matrix Tutorial
+@node List Tutorial
@subsection Vectors as Lists
@noindent
@@ -4214,7 +4214,7 @@ walk to walk a unit distance, but in a random direction, at each step.
(Hint: The @code{sincos} function returns a vector of the cosine and
sine of an angle.) @xref{List Answer 14, 14}. (@bullet{})
-@node Types Tutorial, Algebra Tutorial, Vector/Matrix Tutorial, Tutorial
+@node Types Tutorial
@section Types Tutorial
@noindent
@@ -4738,7 +4738,7 @@ Power Pill he eats doubles his speed. How many Power Pills can he
swallow and still travel legally on most US highways?
@xref{Types Answer 15, 15}. (@bullet{})
-@node Algebra Tutorial, Programming Tutorial, Types Tutorial, Tutorial
+@node Algebra Tutorial
@section Algebra and Calculus Tutorial
@noindent
@@ -4751,7 +4751,7 @@ formulas.
* Rewrites Tutorial::
@end menu
-@node Basic Algebra Tutorial, Rewrites Tutorial, Algebra Tutorial, Algebra Tutorial
+@node Basic Algebra Tutorial
@subsection Basic Algebra
@noindent
@@ -5246,7 +5246,7 @@ details and examples.
@c hard exercise: simplify (2^(n r) - 2^(r*(n - 1))) / (2^r - 1) 2^(n - 1)
@c to 2^((n-1)*(r-1)).
-@node Rewrites Tutorial, , Basic Algebra Tutorial, Algebra Tutorial
+@node Rewrites Tutorial
@subsection Rewrite Rules
@noindent
@@ -5687,7 +5687,7 @@ a nasty surprise when you use Calc to balance your checkbook!)
@xref{Rewrite Rules}, for the whole story on rewrite rules.
-@node Programming Tutorial, Answers to Exercises, Algebra Tutorial, Tutorial
+@node Programming Tutorial
@section Programming Tutorial
@noindent
@@ -6346,7 +6346,7 @@ The rest of this manual tells the whole story.
@c Volume II of this manual, the @dfn{Calc Reference}, tells the whole story.
@page
-@node Answers to Exercises, , Programming Tutorial, Tutorial
+@node Answers to Exercises
@section Answers to Exercises
@noindent
@@ -6433,7 +6433,7 @@ This section includes answers to all the exercises in the Calc tutorial.
\gdef\chapternofonts{\let\write=\skipwrite\oldchapternofonts}
@end tex
-@node RPN Answer 1, RPN Answer 2, Answers to Exercises, Answers to Exercises
+@node RPN Answer 1
@subsection RPN Tutorial Exercise 1
@noindent
@@ -6443,7 +6443,7 @@ The result is
@texline @math{1 - (2 \times (3 + 4)) = -13}.
@infoline @expr{1 - (2 * (3 + 4)) = -13}.
-@node RPN Answer 2, RPN Answer 3, RPN Answer 1, Answers to Exercises
+@node RPN Answer 2
@subsection RPN Tutorial Exercise 2
@noindent
@@ -6500,7 +6500,7 @@ advantage of using only three stack levels. But since Calc's stack
can grow arbitrarily large this isn't really an issue. Which method
you choose is purely a matter of taste.
-@node RPN Answer 3, RPN Answer 4, RPN Answer 2, Answers to Exercises
+@node RPN Answer 3
@subsection RPN Tutorial Exercise 3
@noindent
@@ -6531,7 +6531,7 @@ Similarly, @kbd{M-@key{TAB}} gives you access to the number in level 3.
@end group
@end smallexample
-@node RPN Answer 4, Algebraic Answer 1, RPN Answer 3, Answers to Exercises
+@node RPN Answer 4
@subsection RPN Tutorial Exercise 4
@noindent
@@ -6569,7 +6569,7 @@ enough that Calc provides a special key, @kbd{M-@key{DEL}}, to do just that.
@kbd{M-@key{DEL}} is just like @kbd{@key{TAB} @key{DEL}}, except that it doesn't exhibit
the ``feature'' that tripped poor Joe.)
-@node Algebraic Answer 1, Algebraic Answer 2, RPN Answer 4, Answers to Exercises
+@node Algebraic Answer 1
@subsection Algebraic Entry Tutorial Exercise 1
@noindent
@@ -6582,7 +6582,7 @@ Or, RPN style, @kbd{0.5 ^}.
a closer equivalent, since @samp{9^0.5} yields @expr{3.0} whereas
@samp{sqrt(9)} and @samp{9^1:2} yield the exact integer @expr{3}.)
-@node Algebraic Answer 2, Algebraic Answer 3, Algebraic Answer 1, Answers to Exercises
+@node Algebraic Answer 2
@subsection Algebraic Entry Tutorial Exercise 2
@noindent
@@ -6591,7 +6591,7 @@ name with @samp{1+y} as its argument. Assigning a value to a variable
has no relation to a function by the same name. Joe needed to use an
explicit @samp{*} symbol here: @samp{2 x*(1+y)}.
-@node Algebraic Answer 3, Modes Answer 1, Algebraic Answer 2, Answers to Exercises
+@node Algebraic Answer 3
@subsection Algebraic Entry Tutorial Exercise 3
@noindent
@@ -6608,11 +6608,12 @@ multiply infinity by zero, Calc uses another special new symbol to
show that the answer is ``indeterminate.'' @xref{Infinities}, for
further discussion of infinite and indeterminate values.
-@node Modes Answer 1, Modes Answer 2, Algebraic Answer 3, Answers to Exercises
+@node Modes Answer 1
@subsection Modes Tutorial Exercise 1
@noindent
-Calc always stores its numbers in decimal, so even though one-third has
+Calc always stores its floating-point numbers in decimal,
+so even though one-third has
an exact base-3 representation (@samp{3#0.1}), it is still stored as
0.3333333 (chopped off after 12 or however many decimal digits) inside
the calculator's memory. When this inexact number is converted back
@@ -6668,7 +6669,7 @@ in binary, octal, or hexadecimal is also exact in decimal, so the kinds
of problems we saw in this exercise are likely to be severe only when
you use a relatively unusual radix like 3.
-@node Modes Answer 2, Modes Answer 3, Modes Answer 1, Answers to Exercises
+@node Modes Answer 2
@subsection Modes Tutorial Exercise 2
If the radix is 15 or higher, we can't use the letter @samp{e} to mark
@@ -6688,7 +6689,7 @@ it by the floating-point @samp{16#1.23}). While this wouldn't normally
matter for display purposes, it could give you a nasty surprise if you
copied that number into a file and later moved it back into Calc.
-@node Modes Answer 3, Modes Answer 4, Modes Answer 2, Answers to Exercises
+@node Modes Answer 3
@subsection Modes Tutorial Exercise 3
@noindent
@@ -6730,7 +6731,7 @@ exactly was the quantity 45 degrees, so the precision must be raised
before anything is done after the number 45 has been entered in order
for the higher precision to be meaningful.
-@node Modes Answer 4, Arithmetic Answer 1, Modes Answer 3, Answers to Exercises
+@node Modes Answer 4
@subsection Modes Tutorial Exercise 4
@noindent
@@ -6751,7 +6752,7 @@ Also, rational numbers cannot express the results of all calculations.
There is no fractional form for the square root of two, so if you type
@w{@kbd{2 Q}}, Calc has no choice but to give you a floating-point answer.
-@node Arithmetic Answer 1, Arithmetic Answer 2, Modes Answer 4, Answers to Exercises
+@node Arithmetic Answer 1
@subsection Arithmetic Tutorial Exercise 1
@noindent
@@ -6771,7 +6772,7 @@ produces the exact fraction @expr{123456789:2}, which can be rounded
down by the @kbd{F} command without ever switching to floating-point
format.
-@node Arithmetic Answer 2, Vector Answer 1, Arithmetic Answer 1, Answers to Exercises
+@node Arithmetic Answer 2
@subsection Arithmetic Tutorial Exercise 2
@noindent
@@ -6783,7 +6784,7 @@ or (when in Fraction mode) the reciprocal of an integer. But there is
no efficient way to search the space of all possible rational numbers
for an exact answer, so Calc doesn't try.
-@node Vector Answer 1, Vector Answer 2, Arithmetic Answer 2, Answers to Exercises
+@node Vector Answer 1
@subsection Vector Tutorial Exercise 1
@noindent
@@ -6803,7 +6804,7 @@ by its length: @kbd{@key{RET} A /}.
The final @kbd{A} command shows that the normalized vector does
indeed have unit length.
-@node Vector Answer 2, Matrix Answer 1, Vector Answer 1, Answers to Exercises
+@node Vector Answer 2
@subsection Vector Tutorial Exercise 2
@noindent
@@ -6812,14 +6813,14 @@ positions times their corresponding probabilities. This is the
definition of the dot product operation. So all you need to do
is to put the two vectors on the stack and press @kbd{*}.
-@node Matrix Answer 1, Matrix Answer 2, Vector Answer 2, Answers to Exercises
+@node Matrix Answer 1
@subsection Matrix Tutorial Exercise 1
@noindent
The trick is to multiply by a vector of ones. Use @kbd{r 4 [1 1 1] *} to
get the row sum. Similarly, use @kbd{[1 1] r 4 *} to get the column sum.
-@node Matrix Answer 2, Matrix Answer 3, Matrix Answer 1, Answers to Exercises
+@node Matrix Answer 2
@subsection Matrix Tutorial Exercise 2
@ifnottex
@@ -6865,7 +6866,7 @@ mode:
Type @kbd{d N} to return to Normal display mode afterwards.
-@node Matrix Answer 3, List Answer 1, Matrix Answer 2, Answers to Exercises
+@node Matrix Answer 3
@subsection Matrix Tutorial Exercise 3
@noindent
@@ -6983,7 +6984,7 @@ the original system of equations to see how well they match.
This is reasonably close to our original @expr{B} vector,
@expr{[6, 2, 3, 11]}.
-@node List Answer 1, List Answer 2, Matrix Answer 3, Answers to Exercises
+@node List Answer 1
@subsection List Tutorial Exercise 1
@noindent
@@ -7015,7 +7016,7 @@ vector.
@end group
@end smallexample
-@node List Answer 2, List Answer 3, List Answer 1, Answers to Exercises
+@node List Answer 2
@subsection List Tutorial Exercise 2
@noindent
@@ -7098,7 +7099,7 @@ arithmetic functions!
In fact, there is a built-in @kbd{a F} command that does least-squares
fits. @xref{Curve Fitting}.
-@node List Answer 3, List Answer 4, List Answer 2, Answers to Exercises
+@node List Answer 3
@subsection List Tutorial Exercise 3
@noindent
@@ -7142,7 +7143,7 @@ how many numbers are in this list. Then we could type:
You could also type @kbd{& ^} to take the reciprocal of 9 and
then raise the number to that power.)
-@node List Answer 4, List Answer 5, List Answer 3, Answers to Exercises
+@node List Answer 4
@subsection List Tutorial Exercise 4
@noindent
@@ -7182,7 +7183,7 @@ The first divisor function is the sum of the divisors.
Once again, the last two steps just compute a dot product for which
a simple @kbd{*} would have worked equally well.
-@node List Answer 5, List Answer 6, List Answer 4, Answers to Exercises
+@node List Answer 5
@subsection List Tutorial Exercise 5
@noindent
@@ -7221,14 +7222,14 @@ Incidentally, Calc provides the @dfn{Möbius μ}
function which is zero if and only if its argument is square-free. It
would be a much more convenient way to do the above test in practice.
-@node List Answer 6, List Answer 7, List Answer 5, Answers to Exercises
+@node List Answer 6
@subsection List Tutorial Exercise 6
@noindent
First use @kbd{v x 6 @key{RET}} to get a list of integers, then @kbd{V M v x}
to get a list of lists of integers!
-@node List Answer 7, List Answer 8, List Answer 6, Answers to Exercises
+@node List Answer 7
@subsection List Tutorial Exercise 7
@noindent
@@ -7301,7 +7302,7 @@ triangular list.
since each element of the main vector is itself a small vector,
@kbd{V R +} computes the sum of its elements.)
-@node List Answer 8, List Answer 9, List Answer 7, Answers to Exercises
+@node List Answer 8
@subsection List Tutorial Exercise 8
@noindent
@@ -7390,7 +7391,7 @@ The output from @kbd{a X} is a vector containing the value of @expr{x}
that maximizes the function, and the function's value at that maximum.
As you can see, our simple search got quite close to the right answer.
-@node List Answer 9, List Answer 10, List Answer 8, Answers to Exercises
+@node List Answer 9
@subsection List Tutorial Exercise 9
@noindent
@@ -7512,7 +7513,7 @@ Another way to do this final step would be to reduce the formula
@end group
@end smallexample
-@node List Answer 10, List Answer 11, List Answer 9, Answers to Exercises
+@node List Answer 10
@subsection List Tutorial Exercise 10
@noindent
@@ -7543,7 +7544,7 @@ Here's a more correct method:
@end group
@end smallexample
-@node List Answer 11, List Answer 12, List Answer 10, Answers to Exercises
+@node List Answer 11
@subsection List Tutorial Exercise 11
@noindent
@@ -7610,7 +7611,7 @@ will be slightly different from the one shown here!)
If you typed @kbd{v .} and @kbd{t .} before, type them again to
return to full-sized display of vectors.
-@node List Answer 12, List Answer 13, List Answer 11, Answers to Exercises
+@node List Answer 12
@subsection List Tutorial Exercise 12
@noindent
@@ -7721,7 +7722,7 @@ exercise 10, of Knuth's @emph{Art of Computer Programming}, volume II.
If you typed @kbd{v .} and @kbd{t .} before, type them again to
return to full-sized display of vectors.
-@node List Answer 13, List Answer 14, List Answer 12, Answers to Exercises
+@node List Answer 13
@subsection List Tutorial Exercise 13
@noindent
@@ -7861,7 +7862,7 @@ Later in the tutorial we will encounter @dfn{modulo forms}, which
basically automate the idea of reducing every intermediate result
modulo some value @var{m}.
-@node List Answer 14, Types Answer 1, List Answer 13, Answers to Exercises
+@node List Answer 14
@subsection List Tutorial Exercise 14
We want to use @kbd{H V U} to nest a function which adds a random
@@ -7926,7 +7927,7 @@ and in the second we could use polar complex numbers with random phase
angles. (This exercise was first suggested in this form by Randal
Schwartz.)
-@node Types Answer 1, Types Answer 2, List Answer 14, Answers to Exercises
+@node Types Answer 1
@subsection Types Tutorial Exercise 1
@noindent
@@ -7970,7 +7971,7 @@ Notice that we didn't need to re-round the number when we reduced the
precision. Remember, arithmetic operations always round their inputs
to the current precision before they begin.
-@node Types Answer 2, Types Answer 3, Types Answer 1, Answers to Exercises
+@node Types Answer 2
@subsection Types Tutorial Exercise 2
@noindent
@@ -8006,7 +8007,7 @@ input. As in the @expr{1 / 0} case, Calc will only use infinities
here if you have turned on Infinite mode. Otherwise, it will
treat @samp{ln(0)} as an error.
-@node Types Answer 3, Types Answer 4, Types Answer 2, Answers to Exercises
+@node Types Answer 3
@subsection Types Tutorial Exercise 3
@noindent
@@ -8028,7 +8029,7 @@ for infinities (only the direction counts, not the ``size''); but
Calc is careful to write @code{nan} any time this simple model is
unable to tell what the true answer is.
-@node Types Answer 4, Types Answer 5, Types Answer 3, Answers to Exercises
+@node Types Answer 4
@subsection Types Tutorial Exercise 4
@smallexample
@@ -8057,7 +8058,7 @@ The average song length is two minutes and 47.4 seconds.
@noindent
The album would be 53 minutes and 6 seconds long.
-@node Types Answer 5, Types Answer 6, Types Answer 4, Answers to Exercises
+@node Types Answer 5
@subsection Types Tutorial Exercise 5
@noindent
@@ -8109,7 +8110,7 @@ Et voilà, September 13, 1991 is a Friday.
@noindent
And the answer to our original question: 242 days to go.
-@node Types Answer 6, Types Answer 7, Types Answer 5, Answers to Exercises
+@node Types Answer 6
@subsection Types Tutorial Exercise 6
@noindent
@@ -8155,7 +8156,7 @@ of course, that the algorithm for computing leap years remains
unchanged for that long. @xref{Date Forms}, for some interesting
background information in that regard.)
-@node Types Answer 7, Types Answer 8, Types Answer 6, Answers to Exercises
+@node Types Answer 7
@subsection Types Tutorial Exercise 7
@noindent
@@ -8200,7 +8201,7 @@ well as a vector. This saves us some retyping of numbers.
@noindent
Thus the volume is 6316 cubic centimeters, within about 11 percent.
-@node Types Answer 8, Types Answer 9, Types Answer 7, Answers to Exercises
+@node Types Answer 8
@subsection Types Tutorial Exercise 8
@noindent
@@ -8232,7 +8233,7 @@ It may be disappointing to hear ``the answer lies somewhere between
minus infinity and plus infinity, inclusive,'' but that's the best
that interval arithmetic can do in this case.
-@node Types Answer 9, Types Answer 10, Types Answer 8, Answers to Exercises
+@node Types Answer 9
@subsection Types Tutorial Exercise 9
@smallexample
@@ -8256,7 +8257,7 @@ for different numbers.
The same issue arises when you try to square an error form.
-@node Types Answer 10, Types Answer 11, Types Answer 9, Answers to Exercises
+@node Types Answer 10
@subsection Types Tutorial Exercise 10
@noindent
@@ -8304,7 +8305,7 @@ numbers it does an exact test; for large numbers it uses a variant
of the Fermat test we used here. You can use @kbd{k p} repeatedly
to prove that a large integer is prime with any desired probability.
-@node Types Answer 11, Types Answer 12, Types Answer 10, Answers to Exercises
+@node Types Answer 11
@subsection Types Tutorial Exercise 11
@noindent
@@ -8352,7 +8353,7 @@ HMS form:
The @kbd{=} key is necessary to evaluate the symbol @samp{pi} to
the actual number 3.14159...
-@node Types Answer 12, Types Answer 13, Types Answer 11, Answers to Exercises
+@node Types Answer 12
@subsection Types Tutorial Exercise 12
@noindent
@@ -8382,13 +8383,13 @@ each.
@noindent
No matter how long it is, the album will fit nicely on one CD.
-@node Types Answer 13, Types Answer 14, Types Answer 12, Answers to Exercises
+@node Types Answer 13
@subsection Types Tutorial Exercise 13
@noindent
Type @kbd{' 1 yr @key{RET} u c s @key{RET}}. The answer is 31557600 seconds.
-@node Types Answer 14, Types Answer 15, Types Answer 13, Answers to Exercises
+@node Types Answer 14
@subsection Types Tutorial Exercise 14
@noindent
@@ -8422,7 +8423,7 @@ Thus a signal could take up to 81 percent of a clock cycle just to
go from one place to another inside the computer, assuming the signal
could actually attain the full speed of light. Pretty tight!
-@node Types Answer 15, Algebra Answer 1, Types Answer 14, Answers to Exercises
+@node Types Answer 15
@subsection Types Tutorial Exercise 15
@noindent
@@ -8456,7 +8457,7 @@ answer, assuming that each successive pill doubles his speed.
@noindent
Thus Sam can take up to 14 pills without a worry.
-@node Algebra Answer 1, Algebra Answer 2, Types Answer 15, Answers to Exercises
+@node Algebra Answer 1
@subsection Algebra Tutorial Exercise 1
@noindent
@@ -8468,7 +8469,7 @@ simplified to @samp{abs(x)}, but for general complex arguments even
that is not safe. (@xref{Declarations}, for a way to tell Calc
that @expr{x} is known to be real.)
-@node Algebra Answer 2, Algebra Answer 3, Algebra Answer 1, Answers to Exercises
+@node Algebra Answer 2
@subsection Algebra Tutorial Exercise 2
@noindent
@@ -8511,7 +8512,7 @@ familiar form.
Sure enough, our answer (multiplied by a suitable constant) is the
same as the original polynomial.
-@node Algebra Answer 3, Algebra Answer 4, Algebra Answer 2, Answers to Exercises
+@node Algebra Answer 3
@subsection Algebra Tutorial Exercise 3
@smallexample
@@ -8574,7 +8575,7 @@ same as the original polynomial.
@end group
@end smallexample
-@node Algebra Answer 4, Rewrites Answer 1, Algebra Answer 3, Answers to Exercises
+@node Algebra Answer 4
@subsection Algebra Tutorial Exercise 4
@noindent
@@ -8644,7 +8645,7 @@ same thing.
@noindent
Wow! That's even better than the result from the Taylor series method.
-@node Rewrites Answer 1, Rewrites Answer 2, Algebra Answer 4, Answers to Exercises
+@node Rewrites Answer 1
@subsection Rewrites Tutorial Exercise 1
@noindent
@@ -8696,7 +8697,7 @@ The multiply-by-conjugate rule turns out to be useful in many
different circumstances, such as when the denominator involves
sines and cosines or the imaginary constant @code{i}.
-@node Rewrites Answer 2, Rewrites Answer 3, Rewrites Answer 1, Answers to Exercises
+@node Rewrites Answer 2
@subsection Rewrites Tutorial Exercise 2
@noindent
@@ -8732,7 +8733,7 @@ help keep this from happening by accident would be to use something like
@samp{ZzFib} instead of @code{fib} as the name of the three-argument
function.
-@node Rewrites Answer 3, Rewrites Answer 4, Rewrites Answer 2, Answers to Exercises
+@node Rewrites Answer 3
@subsection Rewrites Tutorial Exercise 3
@noindent
@@ -8754,7 +8755,7 @@ to it. While this may seem odd, it's just as valid a solution as the
on the lefthand side, so that the rule matches the actual variable
@samp{x} rather than letting @samp{x} stand for something else.)
-@node Rewrites Answer 4, Rewrites Answer 5, Rewrites Answer 3, Answers to Exercises
+@node Rewrites Answer 4
@subsection Rewrites Tutorial Exercise 4
@noindent
@@ -8827,7 +8828,7 @@ will not get into an infinite loop. Calc will not be able to prove
the symbol @samp{x} is either even or odd, so none of the rules will
apply and the rewrites will stop right away.
-@node Rewrites Answer 5, Rewrites Answer 6, Rewrites Answer 4, Answers to Exercises
+@node Rewrites Answer 5
@subsection Rewrites Tutorial Exercise 5
@noindent
@@ -8851,7 +8852,7 @@ Here we have taken advantage of the fact that earlier rules always
match before later rules; @samp{nterms(x)} will only be tried if we
already know that @samp{x} is not a sum.
-@node Rewrites Answer 6, Programming Answer 1, Rewrites Answer 5, Answers to Exercises
+@node Rewrites Answer 6
@subsection Rewrites Tutorial Exercise 6
@noindent
@@ -8926,7 +8927,7 @@ for a way to do this in Calc, although for something as involved as
this it would probably be better to write the formatting routine
in Lisp.)
-@node Programming Answer 1, Programming Answer 2, Rewrites Answer 6, Answers to Exercises
+@node Programming Answer 1
@subsection Programming Tutorial Exercise 1
@noindent
@@ -8939,7 +8940,7 @@ to be used within @code{ninteg}.
The exact keystrokes are @kbd{Z F s Si @key{RET} @key{RET} C-b C-b @key{DEL} @key{DEL} @key{RET} y}.
(The @kbd{C-b C-b @key{DEL} @key{DEL}} are what fix the argument list.)
-@node Programming Answer 2, Programming Answer 3, Programming Answer 1, Answers to Exercises
+@node Programming Answer 2
@subsection Programming Tutorial Exercise 2
@noindent
@@ -8956,7 +8957,7 @@ which is just what we want: @kbd{C-x ( M-- 3 n C-x )}.
Just for kicks, let's also do it algebraically:
@w{@kbd{C-x ( ' -$$$, $$, $ @key{RET} C-x )}}.
-@node Programming Answer 3, Programming Answer 4, Programming Answer 2, Answers to Exercises
+@node Programming Answer 3
@subsection Programming Tutorial Exercise 3
@noindent
@@ -8992,13 +8993,13 @@ next command.)
Using algebraic entry: @kbd{C-x ( ' index($) @key{RET} C-x )}.
-@node Programming Answer 4, Programming Answer 5, Programming Answer 3, Answers to Exercises
+@node Programming Answer 4
@subsection Programming Tutorial Exercise 4
@noindent
Here's one way: @kbd{C-x ( @key{RET} V R + @key{TAB} v l / C-x )}.
-@node Programming Answer 5, Programming Answer 6, Programming Answer 4, Answers to Exercises
+@node Programming Answer 5
@subsection Programming Tutorial Exercise 5
@smallexample
@@ -9014,7 +9015,7 @@ Here's one way: @kbd{C-x ( @key{RET} V R + @key{TAB} v l / C-x )}.
@noindent
This answer is quite accurate.
-@node Programming Answer 6, Programming Answer 7, Programming Answer 5, Answers to Exercises
+@node Programming Answer 6
@subsection Programming Tutorial Exercise 6
@noindent
@@ -9043,7 +9044,7 @@ number (a 209-digit integer!)@: in about 10 steps; even though the
@kbd{Z < ... Z >} solution had much simpler steps, it would have
required so many steps that it would not have been practical.
-@node Programming Answer 7, Programming Answer 8, Programming Answer 6, Answers to Exercises
+@node Programming Answer 7
@subsection Programming Tutorial Exercise 7
@noindent
@@ -9084,7 +9085,7 @@ loop counter exceeds 4.
Thus we find that the 30th harmonic number is 3.99, and the 31st
harmonic number is 4.02.
-@node Programming Answer 8, Programming Answer 9, Programming Answer 7, Answers to Exercises
+@node Programming Answer 8
@subsection Programming Tutorial Exercise 8
@noindent
@@ -9200,7 +9201,7 @@ Also, of course, @kbd{a R} is a built-in command that uses Newton's
method (among others) to look for numerical solutions to any equation.
@xref{Root Finding}.
-@node Programming Answer 9, Programming Answer 10, Programming Answer 8, Answers to Exercises
+@node Programming Answer 9
@subsection Programming Tutorial Exercise 9
@noindent
@@ -9323,7 +9324,7 @@ C-x )
@end group
@end example
-@node Programming Answer 10, Programming Answer 11, Programming Answer 9, Answers to Exercises
+@node Programming Answer 10
@subsection Programming Tutorial Exercise 10
@noindent
@@ -9421,7 +9422,7 @@ C-x ( 1 + 0 @key{RET} 1 C-u v x ' x @key{RET} @key{TAB} V M ^ * C-x )
@end group
@end example
-@node Programming Answer 11, Programming Answer 12, Programming Answer 10, Answers to Exercises
+@node Programming Answer 11
@subsection Programming Tutorial Exercise 11
@noindent
@@ -9526,7 +9527,7 @@ first, because @code{read-kbd-macro} doesn't need to execute the
definition as it reads it in. For this reason, @code{C-x * m} is often
the easiest way to create recursive programs in Calc.
-@node Programming Answer 12, , Programming Answer 11, Answers to Exercises
+@node Programming Answer 12
@subsection Programming Tutorial Exercise 12
@noindent
@@ -9567,7 +9568,7 @@ the last rule.
@c [reference]
-@node Introduction, Data Types, Tutorial, Top
+@node Introduction
@chapter Introduction
@noindent
@@ -9592,7 +9593,7 @@ numeric entry, undo, numeric prefix arguments, etc.
* Troubleshooting Commands::
@end menu
-@node Basic Commands, Help Commands, Introduction, Introduction
+@node Basic Commands
@section Basic Commands
@noindent
@@ -9761,7 +9762,7 @@ the stack but resets everything else to its initial state; with a
negative prefix argument, @kbd{C-x * 0} preserves the contents of the
stack but resets everything else to its default state.
-@node Help Commands, Stack Basics, Basic Commands, Introduction
+@node Help Commands
@section Help Commands
@noindent
@@ -9906,7 +9907,7 @@ distribution, and warranty information about Calc. These work by
pulling up the appropriate parts of the ``Copying'' or ``Reporting
Bugs'' sections of the manual.
-@node Stack Basics, Numeric Entry, Help Commands, Introduction
+@node Stack Basics
@section Stack Basics
@noindent
@@ -9958,7 +9959,7 @@ The @key{TAB} key swaps the top two objects on the stack.
@xref{Stack and Trail}, for descriptions of these and other stack-related
commands.
-@node Numeric Entry, Algebraic Entry, Stack Basics, Introduction
+@node Numeric Entry
@section Numeric Entry
@noindent
@@ -9995,7 +9996,7 @@ data types. @xref{Data Types}.
During numeric entry, the only editing key available is @key{DEL}.
-@node Algebraic Entry, Quick Calculator, Numeric Entry, Introduction
+@node Algebraic Entry
@section Algebraic Entry
@noindent
@@ -10113,7 +10114,7 @@ is being pushed on the stack. Thus @kbd{' 1+2 @key{RET}} pushes 3
on the stack, but @kbd{' 1+2 @key{LFD}} pushes the formula @expr{1+2};
you might then press @kbd{=} when it is time to evaluate this formula.
-@node Quick Calculator, Prefix Arguments, Algebraic Entry, Introduction
+@node Quick Calculator
@section ``Quick Calculator'' Mode
@noindent
@@ -10182,7 +10183,7 @@ or computing the answer than the full Calculator; the name ``quick''
merely refers to the fact that it's much less hassle to use for
small calculations.
-@node Prefix Arguments, Undo, Quick Calculator, Introduction
+@node Prefix Arguments
@section Numeric Prefix Arguments
@noindent
@@ -10230,7 +10231,7 @@ to the fourth power and set the precision to that value.
Conversely, if you have typed a numeric prefix argument the @kbd{~} key
pushes it onto the stack in the form of an integer.
-@node Undo, Error Messages, Prefix Arguments, Introduction
+@node Undo
@section Undoing Mistakes
@noindent
@@ -10288,7 +10289,7 @@ It is also possible to recall previous results or inputs using the trail.
The standard Emacs @kbd{C-_} undo key is recognized as a synonym for @kbd{U}.
-@node Error Messages, Multiple Calculators, Undo, Introduction
+@node Error Messages
@section Error Messages
@noindent
@@ -10319,7 +10320,7 @@ after your computation finishes.) By default, this occurs only for
@emph{all} messages automatically, or to report none automatically (so
that you must always press @kbd{w} yourself to see the messages).
-@node Multiple Calculators, Troubleshooting Commands, Error Messages, Introduction
+@node Multiple Calculators
@section Multiple Calculators
@noindent
@@ -10346,7 +10347,7 @@ the stack and mode settings of the buffer being quit as the new defaults.
There is only one trail buffer, @file{*Calc Trail*}, used by all
Calculator buffers.
-@node Troubleshooting Commands, , Multiple Calculators, Introduction
+@node Troubleshooting Commands
@section Troubleshooting Commands
@noindent
@@ -10363,7 +10364,7 @@ to a bug or deficiency in Calc.
* Debugging Calc::
@end menu
-@node Autoloading Problems, Recursion Depth, Troubleshooting Commands, Troubleshooting Commands
+@node Autoloading Problems
@subsection Autoloading Problems
@noindent
@@ -10380,7 +10381,7 @@ If this happens, the easiest workaround is to type @kbd{C-x * L}
loaded right away. This will cause Emacs to take up a lot more
memory than it would otherwise, but it's guaranteed to fix the problem.
-@node Recursion Depth, Caches, Autoloading Problems, Troubleshooting Commands
+@node Recursion Depth
@subsection Recursion Depth
@noindent
@@ -10408,7 +10409,7 @@ The default value is 1000.
These commands also double or halve @code{max-specpdl-size}, another
internal Lisp recursion limit. The minimum value for this limit is 600.
-@node Caches, Debugging Calc, Recursion Depth, Troubleshooting Commands
+@node Caches
@subsection Caches
@noindent
@@ -10437,7 +10438,7 @@ If you suspect a Calculator cache has become corrupt, you can use the
The @kbd{C-x * 0} (with the zero key) command also resets caches along
with all other aspects of the Calculator's state.
-@node Debugging Calc, , Caches, Troubleshooting Commands
+@node Debugging Calc
@subsection Debugging Calc
@noindent
@@ -10490,7 +10491,7 @@ error. After you have executed @code{calc-pass-errors}, Lisp
errors will be reported correctly but the user-friendly message
will be lost.
-@node Data Types, Stack and Trail, Introduction, Top
+@node Data Types
@chapter Data Types
@noindent
@@ -10525,7 +10526,7 @@ matrices, or algebraic formulas.
* Formulas::
@end menu
-@node Integers, Fractions, Data Types, Data Types
+@node Integers
@section Integers
@noindent
@@ -10551,7 +10552,7 @@ to set the default radix for display of integers. Numbers of any radix
may be entered at any time. If you press @kbd{#} at the beginning of a
number, the current display radix is used.
-@node Fractions, Floats, Integers, Data Types
+@node Fractions
@section Fractions
@noindent
@@ -10572,7 +10573,7 @@ Non-decimal fractions are entered and displayed as
@samp{@var{radix}#@var{num}:@var{denom}} (or in the analogous three-part
form). The numerator and denominator always use the same radix.
-@node Floats, Complex Numbers, Fractions, Data Types
+@node Floats
@section Floats
@noindent
@@ -10646,7 +10647,7 @@ the letter @samp{e} is a digit, so scientific notation must be written
out, e.g., @samp{16#123.4567*16^2}. The first two exercises of the
Modes Tutorial explore some of the properties of non-decimal floats.
-@node Complex Numbers, Infinities, Floats, Data Types
+@node Complex Numbers
@section Complex Numbers
@noindent
@@ -10684,7 +10685,7 @@ A complex result in which the imaginary part is zero (or the phase angle
is 0 or 180 degrees or @cpi{} radians) is automatically converted to a real
number.
-@node Infinities, Vectors and Matrices, Complex Numbers, Data Types
+@node Infinities
@section Infinities
@noindent
@@ -10771,7 +10772,7 @@ expressions are @samp{inf - inf} and @samp{inf ^ 0}. Also,
Infinities are especially useful as parts of @dfn{intervals}.
@xref{Interval Forms}.
-@node Vectors and Matrices, Strings, Infinities, Data Types
+@node Vectors and Matrices
@section Vectors and Matrices
@noindent
@@ -10813,7 +10814,7 @@ to build @samp{[a, b, c]}, @samp{cvec(a, n, m)} to build an
matrix of @samp{a}s, and @samp{index(n)} to build a vector of integers
from 1 to @samp{n}.
-@node Strings, HMS Forms, Vectors and Matrices, Data Types
+@node Strings
@section Strings
@noindent
@@ -10890,7 +10891,7 @@ the resulting string is breakable across multiple lines if it doesn't
fit all on one line. Potential break points occur at every space
character in the string.
-@node HMS Forms, Date Forms, Strings, Data Types
+@node HMS Forms
@section HMS Forms
@noindent
@@ -10952,7 +10953,7 @@ two HMS forms produces a real-valued ratio of the two angles.
Just for kicks, @kbd{M-x calc-time} pushes the current time of day on
the stack as an HMS form.
-@node Date Forms, Modulo Forms, HMS Forms, Data Types
+@node Date Forms
@section Date Forms
@noindent
@@ -11108,7 +11109,7 @@ for California time. The same is usually true of Julian day
counts.) The built-in @kbd{t U} command performs these
conversions.
-@node Modulo Forms, Error Forms, Date Forms, Data Types
+@node Modulo Forms
@section Modulo Forms
@noindent
@@ -11192,7 +11193,7 @@ You can use @kbd{v p} and @kbd{%} to modify modulo forms.
The algebraic function @samp{makemod(a, m)} builds the modulo form
@w{@samp{a mod m}}.
-@node Error Forms, Interval Forms, Modulo Forms, Data Types
+@node Error Forms
@section Error Forms
@noindent
@@ -11307,7 +11308,7 @@ the mean and the error should be HMS forms if either one is.
@tindex sdev
The algebraic function @samp{sdev(a, b)} builds the error form @samp{a +/- b}.
-@node Interval Forms, Incomplete Objects, Error Forms, Data Types
+@node Interval Forms
@section Interval Forms
@noindent
@@ -11422,7 +11423,7 @@ should yield the interval @samp{[1..2]} again, but in fact it yields the
(slightly too small) interval @samp{[1..1.9999999]} due to roundoff
error.
-@node Incomplete Objects, Variables, Interval Forms, Data Types
+@node Incomplete Objects
@section Incomplete Objects
@noindent
@@ -11485,7 +11486,7 @@ the @code{calc-dots} command.
If you find incomplete entry distracting, you may wish to enter vectors
and complex numbers as algebraic formulas by pressing the apostrophe key.
-@node Variables, Formulas, Incomplete Objects, Data Types
+@node Variables
@section Variables
@noindent
@@ -11556,7 +11557,7 @@ a value into any of these special variables.
@xref{Store and Recall}, for a discussion of commands dealing with variables.
-@node Formulas, , Variables, Data Types
+@node Formulas
@section Formulas
@noindent
@@ -11714,7 +11715,7 @@ formats.
@xref{Algebra}, for commands for manipulating formulas symbolically.
-@node Stack and Trail, Mode Settings, Data Types, Top
+@node Stack and Trail
@chapter Stack and Trail Commands
@noindent
@@ -11729,7 +11730,7 @@ type, such as numbers, vectors, formulas, and incomplete objects.)
* Keep Arguments::
@end menu
-@node Stack Manipulation, Editing Stack Entries, Stack and Trail, Stack and Trail
+@node Stack Manipulation
@section Stack Manipulation Commands
@noindent
@@ -11858,7 +11859,7 @@ the line containing @samp{30}, @kbd{C-u 2 C-x C-t} creates
@samp{10 40 20 30 50}. With an argument of 0, @kbd{C-x C-t} will switch
the stack objects at the levels determined by the point and the mark.
-@node Editing Stack Entries, Trail Commands, Stack Manipulation, Stack and Trail
+@node Editing Stack Entries
@section Editing Stack Entries
@noindent
@@ -11912,7 +11913,7 @@ The @kbd{`} key also works during numeric or algebraic entry. The
text entered so far is moved to the @file{*Calc Edit*} buffer for
more extensive editing than is convenient in the minibuffer.
-@node Trail Commands, Keep Arguments, Editing Stack Entries, Stack and Trail
+@node Trail Commands
@section Trail Commands
@noindent
@@ -12033,7 +12034,7 @@ kills the @var{n} lines below or above the selected one.
The @kbd{t .} (@code{calc-full-trail-vectors}) command is described
elsewhere; @pxref{Vector and Matrix Formats}.
-@node Keep Arguments, , Trail Commands, Stack and Trail
+@node Keep Arguments
@section Keep Arguments
@noindent
@@ -12076,7 +12077,7 @@ onto the stack. Note that the order of things on the stack will be
different than with @kbd{K}: @kbd{2 @key{RET} 3 + M-@key{RET}} leaves
@samp{5 2 3} on the stack instead of @samp{2 3 5}. @xref{Undo}.
-@node Mode Settings, Arithmetic, Stack and Trail, Top
+@node Mode Settings
@chapter Mode Settings
@noindent
@@ -12097,7 +12098,7 @@ the @emph{appearance} or @emph{interpretation} of the stack's contents.
* Calc Mode Line::
@end menu
-@node General Mode Commands, Precision, Mode Settings, Mode Settings
+@node General Mode Commands
@section General Mode Commands
@noindent
@@ -12179,7 +12180,7 @@ the @kbd{z} and @kbd{Z} prefix keys are always distinct. Also, the @kbd{h}
prefix is not affected by this mode. Press @kbd{m S} again to disable
shifted-prefix mode.
-@node Precision, Inverse and Hyperbolic, General Mode Commands, Mode Settings
+@node Precision
@section Precision
@noindent
@@ -12236,7 +12237,7 @@ would round this to 150 cents, i.e., $1.50.
@xref{Floats}, for still more on floating-point precision and related
issues.
-@node Inverse and Hyperbolic, Calculation Modes, Precision, Mode Settings
+@node Inverse and Hyperbolic
@section Inverse and Hyperbolic Flags
@noindent
@@ -12279,7 +12280,7 @@ to subtract and keep arguments).
Another Calc prefix flag, @kbd{K} (keep-arguments), is discussed
elsewhere. @xref{Keep Arguments}.
-@node Calculation Modes, Simplification Modes, Inverse and Hyperbolic, Mode Settings
+@node Calculation Modes
@section Calculation Modes
@noindent
@@ -12299,7 +12300,7 @@ The @samp{m a} (@code{calc-algebraic-mode}) command is described elsewhere
* Working Message::
@end menu
-@node Angular Modes, Polar Mode, Calculation Modes, Calculation Modes
+@node Angular Modes
@subsection Angular Modes
@noindent
@@ -12330,7 +12331,7 @@ and @kbd{m h} (@code{calc-hms-mode}) commands control the angular mode.
The current angular mode is displayed on the Emacs mode line.
The default angular mode is Degrees.
-@node Polar Mode, Fraction Mode, Angular Modes, Calculation Modes
+@node Polar Mode
@subsection Polar Mode
@noindent
@@ -12347,7 +12348,7 @@ The @kbd{m p} (@code{calc-polar-mode}) command toggles complex-number
preference between rectangular and polar forms. In Polar mode, all
of the above example situations would produce polar complex numbers.
-@node Fraction Mode, Infinite Mode, Polar Mode, Calculation Modes
+@node Fraction Mode
@subsection Fraction Mode
@noindent
@@ -12373,7 +12374,7 @@ At any time you can use @kbd{c f} (@code{calc-float}) to convert a
fraction to a float, or @kbd{c F} (@code{calc-fraction}) to convert a
float to a fraction. @xref{Conversions}.
-@node Infinite Mode, Symbolic Mode, Fraction Mode, Calculation Modes
+@node Infinite Mode
@subsection Infinite Mode
@noindent
@@ -12413,7 +12414,7 @@ single symbol, @samp{0}. One consequence of this is that, while
you might expect @samp{1 / -0 = -inf}, actually @samp{1 / -0}
is equivalent to @samp{1 / 0}, which is equal to positive @code{inf}.
-@node Symbolic Mode, Matrix Mode, Infinite Mode, Calculation Modes
+@node Symbolic Mode
@subsection Symbolic Mode
@noindent
@@ -12446,7 +12447,7 @@ contains, you can use the key sequence @kbd{m s a v m s} (this uses
@code{calc-alg-evaluate}, which resimplifies but doesn't evaluate
variables.)
-@node Matrix Mode, Automatic Recomputation, Symbolic Mode, Calculation Modes
+@node Matrix Mode
@subsection Matrix and Scalar Modes
@noindent
@@ -12518,7 +12519,7 @@ of the formula without affecting the rest just select that part,
change into Scalar mode and press @kbd{=} to resimplify the part
under this mode, then change back to Matrix mode before deselecting.
-@node Automatic Recomputation, Working Message, Matrix Mode, Calculation Modes
+@node Automatic Recomputation
@subsection Automatic Recomputation
@noindent
@@ -12542,7 +12543,7 @@ To update @samp{=>} operators in an Embedded buffer while
automatic recomputation is off, use @w{@kbd{C-x * u}}.
@xref{Embedded Mode}.
-@node Working Message, , Automatic Recomputation, Calculation Modes
+@node Working Message
@subsection Working Messages
@noindent
@@ -12569,7 +12570,7 @@ considerably, experiments have shown that their impact is actually
quite small. But if your terminal is slow you may find that it helps
to turn the messages off.
-@node Simplification Modes, Declarations, Calculation Modes, Mode Settings
+@node Simplification Modes
@section Simplification Modes
@noindent
@@ -12650,7 +12651,7 @@ A common technique is to set the simplification mode down to the lowest
amount of simplification you will allow to be applied automatically, then
use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to
perform higher types of simplifications on demand.
-@node Declarations, Display Modes, Simplification Modes, Mode Settings
+@node Declarations
@section Declarations
@noindent
@@ -12665,7 +12666,7 @@ take the fully general situation into account.
* Functions for Declarations::
@end menu
-@node Declaration Basics, Kinds of Declarations, Declarations, Declarations
+@node Declaration Basics
@subsection Declaration Basics
@noindent
@@ -12730,7 +12731,7 @@ are explicitly declared without @code{real} in some other row.
The @kbd{s d} command declares @code{All} if you give a blank
response to the variable-name prompt.
-@node Kinds of Declarations, Functions for Declarations, Declaration Basics, Declarations
+@node Kinds of Declarations
@subsection Kinds of Declarations
@noindent
@@ -12920,7 +12921,7 @@ using a variable for a new purpose, it is best to use @kbd{s d}
or @kbd{s D} to check to make sure you don't still have an old
declaration for the variable that will conflict with its new meaning.
-@node Functions for Declarations, , Kinds of Declarations, Declarations
+@node Functions for Declarations
@subsection Functions for Declarations
@noindent
@@ -13059,7 +13060,7 @@ provably scalar, and @samp{!dscalar(a)} is ``true'' only if @code{a}
is provably non-scalar; both are ``false'' if there is insufficient
information to tell.
-@node Display Modes, Language Modes, Declarations, Mode Settings
+@node Display Modes
@section Display Modes
@noindent
@@ -13104,7 +13105,7 @@ words, @kbd{I d s} is equivalent to @kbd{H d s d @key{RET} H d (@var{old mode})}
* Labels::
@end menu
-@node Radix Modes, Grouping Digits, Display Modes, Display Modes
+@node Radix Modes
@subsection Radix Modes
@noindent
@@ -13189,7 +13190,7 @@ to
will be represented using Calc's usual notation (in the appropriate
radix).
-@node Grouping Digits, Float Formats, Radix Modes, Display Modes
+@node Grouping Digits
@subsection Grouping Digits
@noindent
@@ -13227,7 +13228,7 @@ if re-read in textual form, say by the use of @kbd{C-x * y} and @kbd{C-x * g}.
the @samp{\,} separator, which doesn't interfere with parsing because it
is ignored by @TeX{} language mode.
-@node Float Formats, Complex Formats, Grouping Digits, Display Modes
+@node Float Formats
@subsection Float Formats
@noindent
@@ -13293,7 +13294,7 @@ may wish to change this to a comma. Note that this is only a display
style; on entry, periods must always be used to denote floating-point
numbers, and commas to separate elements in a list.
-@node Complex Formats, Fraction Formats, Float Formats, Display Modes
+@node Complex Formats
@subsection Complex Formats
@noindent
@@ -13324,7 +13325,7 @@ to @samp{(2,3)}. Other commands (like @code{calc-sin}) will @emph{not}
interpret the formula @samp{2 + 3 * i} as a complex number.
@xref{Variables}, under ``special constants.''
-@node Fraction Formats, HMS Formats, Complex Formats, Display Modes
+@node Fraction Formats
@subsection Fraction Formats
@noindent
@@ -13361,7 +13362,7 @@ The fraction format does not affect the way fractions or integers are
stored, only the way they appear on the screen. The fraction format
never affects floats.
-@node HMS Formats, Date Formats, Fraction Formats, Display Modes
+@node HMS Formats
@subsection HMS Formats
@noindent
@@ -13388,7 +13389,7 @@ The @kbd{'} key is recognized as ``minutes'' only if @kbd{@@} (or @kbd{h} or
@kbd{o}) has already been pressed; otherwise it means to switch to algebraic
entry.
-@node Date Formats, Truncating the Stack, HMS Formats, Display Modes
+@node Date Formats
@subsection Date Formats
@noindent
@@ -13419,7 +13420,7 @@ functions, your date formats should avoid using the @samp{#} character.
* Standard Date Formats::
@end menu
-@node ISO 8601, Date Formatting Codes, Date Formats, Date Formats
+@node ISO 8601
@subsubsection ISO 8601
@noindent
@@ -13497,7 +13498,7 @@ and seconds can be omitted, and decimals can be added. If a date with a
time is represented, they should be separated by a literal ``T'', so noon
on December 13, 2012 can be represented as 2012-12-13T12:00.
-@node Date Formatting Codes, Free-Form Dates, ISO 8601, Date Formats
+@node Date Formatting Codes
@subsubsection Date Formatting Codes
@noindent
@@ -13688,7 +13689,7 @@ The ``j,'' ``J,'' and ``U'' formats do not make any time zone
adjustment. They effectively use @samp{julian(x,0)} and
@samp{unixtime(x,0)} to make the conversion; @pxref{Date Arithmetic}.
-@node Free-Form Dates, Standard Date Formats, Date Formatting Codes, Date Formats
+@node Free-Form Dates
@subsubsection Free-Form Dates
@noindent
@@ -13754,7 +13755,7 @@ minus sign on the year value.
If you always enter a four-digit year, and use a name instead
of a number for the month, there is no danger of ambiguity.
-@node Standard Date Formats, , Free-Form Dates, Date Formats
+@node Standard Date Formats
@subsubsection Standard Date Formats
@noindent
@@ -13797,7 +13798,7 @@ command (@pxref{Mode Settings}).
@samp{IYYY-Iww-w<Thh:mm:ss>} (ISO 8601 week numbering format)
@end table
-@node Truncating the Stack, Justification, Date Formats, Display Modes
+@node Truncating the Stack
@subsection Truncating the Stack
@noindent
@@ -13832,7 +13833,7 @@ The @kbd{d [} (@code{calc-truncate-up}) and @kbd{d ]}
(@code{calc-truncate-down}) commands move the @samp{.} up or down one
line at a time (or several lines with a prefix argument).
-@node Justification, Labels, Truncating the Stack, Display Modes
+@node Justification
@subsection Justification
@noindent
@@ -13893,7 +13894,7 @@ when positioning by explicit origins and widths. In the latter
case, the display is formatted as specified, and then uniformly
shifted over four spaces to fit the line numbers.
-@node Labels, , Justification, Display Modes
+@node Labels
@subsection Labels
@noindent
@@ -13924,7 +13925,7 @@ document (possibly using Embedded mode). The equations would
typically be centered, and the equation numbers would be on the
left or right as you prefer.
-@node Language Modes, Modes Variable, Display Modes, Mode Settings
+@node Language Modes
@section Language Modes
@noindent
@@ -13977,7 +13978,7 @@ shifted letter key.
* Syntax Tables::
@end menu
-@node Normal Language Modes, C FORTRAN Pascal, Language Modes, Language Modes
+@node Normal Language Modes
@subsection Normal Language Modes
@noindent
@@ -14079,7 +14080,7 @@ all four modes, and unformatted notation works in any language mode
(except that Mathematica mode expects square brackets instead of
parentheses).
-@node C FORTRAN Pascal, TeX and LaTeX Language Modes, Normal Language Modes, Language Modes
+@node C FORTRAN Pascal
@subsection C, FORTRAN, and Pascal Modes
@noindent
@@ -14154,7 +14155,7 @@ modes will use upper-case letters exclusively for display, and will
convert to lower-case on input. With a negative prefix, these modes
convert to lower-case for display and input.
-@node TeX and LaTeX Language Modes, Eqn Language Mode, C FORTRAN Pascal, Language Modes
+@node TeX and LaTeX Language Modes
@subsection @TeX{} and @LaTeX{} Language Modes
@noindent
@@ -14574,7 +14575,7 @@ $$ \pmatrix{ {a \over b} & 0 \cr 0 & 2^{(x + 1)} } $$
@sp 2
@end iftex
-@node Eqn Language Mode, Yacas Language Mode, TeX and LaTeX Language Modes, Language Modes
+@node Eqn Language Mode
@subsection Eqn Language Mode
@noindent
@@ -14650,7 +14651,7 @@ The words @code{lcol} and @code{rcol} are recognized as synonyms
for @code{ccol} during input, and are generated instead of @code{ccol}
if the matrix justification mode so specifies.
-@node Yacas Language Mode, Maxima Language Mode, Eqn Language Mode, Language Modes
+@node Yacas Language Mode
@subsection Yacas Language Mode
@noindent
@@ -14680,7 +14681,7 @@ use square brackets. If, for example, @samp{A} represents the list
@samp{@{a,2,c,4@}}, then @samp{A[3]} would equal @samp{c}.
-@node Maxima Language Mode, Giac Language Mode, Yacas Language Mode, Language Modes
+@node Maxima Language Mode
@subsection Maxima Language Mode
@noindent
@@ -14705,7 +14706,7 @@ Maxima uses square brackets for lists and vectors, and matrices are
written as calls to the function @code{matrix}, given the row vectors of
the matrix as arguments. Square brackets are also used as subscripts.
-@node Giac Language Mode, Mathematica Language Mode, Maxima Language Mode, Language Modes
+@node Giac Language Mode
@subsection Giac Language Mode
@noindent
@@ -14730,7 +14731,7 @@ Calc reads @samp{2 .. 3} as the closed interval @samp{[2 .. 3]} and
writes any kind of interval as @samp{2 .. 3}. This means you cannot see
the difference between an open and a closed interval while in Giac mode.
-@node Mathematica Language Mode, Maple Language Mode, Giac Language Mode, Language Modes
+@node Mathematica Language Mode
@subsection Mathematica Language Mode
@noindent
@@ -14753,7 +14754,7 @@ Non-decimal numbers are written, e.g., @samp{16^^7fff}. Floating-point
numbers in scientific notation are written @samp{1.23*10.^3}.
Subscripts use double square brackets: @samp{a[[i]]}.
-@node Maple Language Mode, Compositions, Mathematica Language Mode, Language Modes
+@node Maple Language Mode
@subsection Maple Language Mode
@noindent
@@ -14787,7 +14788,7 @@ Among things not currently handled by Calc's Maple mode are the
various quote symbols, procedures and functional operators, and
inert (@samp{&}) operators.
-@node Compositions, Syntax Tables, Maple Language Mode, Language Modes
+@node Compositions
@subsection Compositions
@noindent
@@ -14823,7 +14824,7 @@ the language modes.
* User-Defined Compositions::
@end menu
-@node Composition Basics, Horizontal Compositions, Compositions, Compositions
+@node Composition Basics
@subsubsection Composition Basics
@noindent
@@ -14964,7 +14965,7 @@ in a function call), then the break points in that @code{bstring}
will be on the same level as the break points of the surrounding
object.
-@node Horizontal Compositions, Vertical Compositions, Composition Basics, Compositions
+@node Horizontal Compositions
@subsubsection Horizontal Compositions
@noindent
@@ -15008,7 +15009,7 @@ formats as @samp{2 (a + b c + (d = e))}.
The baseline of a horizontal composition is the same as the
baselines of the component compositions, which are all aligned.
-@node Vertical Compositions, Other Compositions, Horizontal Compositions, Compositions
+@node Vertical Compositions
@subsubsection Vertical Compositions
@noindent
@@ -15129,7 +15130,7 @@ Like @code{choriz}, the vertical compositions accept a second argument
which gives the precedence to use when formatting the components.
Vertical compositions do not support separator strings.
-@node Other Compositions, Information about Compositions, Vertical Compositions, Compositions
+@node Other Compositions
@subsubsection Other Compositions
@noindent
@@ -15223,7 +15224,7 @@ b -
@end group
@end example
-@node Information about Compositions, User-Defined Compositions, Other Compositions, Compositions
+@node Information about Compositions
@subsubsection Information about Compositions
@noindent
@@ -15265,7 +15266,7 @@ For @samp{a / b} in Big mode, @code{cascent} returns 2 and @code{cdescent}
returns 1. The only formula for which @code{cascent} will return zero
is @samp{cvspace(0)} or equivalents.
-@node User-Defined Compositions, , Information about Compositions, Compositions
+@node User-Defined Compositions
@subsubsection User-Defined Compositions
@noindent
@@ -15396,7 +15397,7 @@ produce a large, unwieldy integer.
You can save your display formats permanently using the @kbd{Z P}
command (@pxref{Creating User Keys}).
-@node Syntax Tables, , Compositions, Language Modes
+@node Syntax Tables
@subsection Syntax Tables
@noindent
@@ -15426,7 +15427,7 @@ the syntax tables along with the other mode settings;
* Conditional Syntax Rules::
@end menu
-@node Syntax Table Basics, Precedence in Syntax Tables, Syntax Tables, Syntax Tables
+@node Syntax Table Basics
@subsubsection Syntax Table Basics
@noindent
@@ -15574,7 +15575,7 @@ respectively).
Finally, the notation @samp{%%} anywhere in a syntax table causes
the rest of the line to be ignored as a comment.
-@node Precedence in Syntax Tables, Advanced Syntax Patterns, Syntax Table Basics, Syntax Tables
+@node Precedence in Syntax Tables
@subsubsection Precedence
@noindent
@@ -15609,7 +15610,7 @@ can create a right-associative operator.
standard Calc operators. For the precedences of operators in other
language modes, look in the Calc source file @file{calc-lang.el}.
-@node Advanced Syntax Patterns, Conditional Syntax Rules, Precedence in Syntax Tables, Syntax Tables
+@node Advanced Syntax Patterns
@subsubsection Advanced Syntax Patterns
@noindent
@@ -15729,7 +15730,7 @@ backs up and tries the other alternative. Thus Calc has ``partial''
backtracking. A fully backtracking parser would go on to make sure
the rest of the pattern matched before finalizing the choice.
-@node Conditional Syntax Rules, , Advanced Syntax Patterns, Syntax Tables
+@node Conditional Syntax Rules
@subsubsection Conditional Syntax Rules
@noindent
@@ -15803,7 +15804,7 @@ Normal language mode for editing expressions in syntax rules, so we
must use regular Calc notation for the interval @samp{[b..c]} that
will correspond to the Maple mode interval @samp{1..10}.
-@node Modes Variable, Calc Mode Line, Language Modes, Mode Settings
+@node Modes Variable
@section The @code{Modes} Variable
@noindent
@@ -15905,7 +15906,7 @@ would not work for fixed-point mode, but it wouldn't be hard to
do a full emulation with the help of the @kbd{Z [} and @kbd{Z ]}
programming commands. @xref{Conditionals in Macros}.)
-@node Calc Mode Line, , Modes Variable, Mode Settings
+@node Calc Mode Line
@section The Calc Mode Line
@noindent
@@ -16124,7 +16125,7 @@ Stack is truncated (@kbd{d t}; @pxref{Truncating the Stack}).
In addition, the symbols @code{Active} and @code{~Active} can appear
as minor modes on an Embedded buffer's mode line. @xref{Embedded Mode}.
-@node Arithmetic, Scientific Functions, Mode Settings, Top
+@node Arithmetic
@chapter Arithmetic Functions
@noindent
@@ -16154,7 +16155,7 @@ interpret a prefix argument.
* Binary Functions::
@end menu
-@node Basic Arithmetic, Integer Truncation, Arithmetic, Arithmetic
+@node Basic Arithmetic
@section Basic Arithmetic
@noindent
@@ -16511,7 +16512,7 @@ way floating-point numbers work.
Incrementing a date/time form adjusts it by a certain number of seconds.
Incrementing a pure date form adjusts it by a certain number of days.
-@node Integer Truncation, Complex Number Functions, Basic Arithmetic, Arithmetic
+@node Integer Truncation
@section Integer Truncation
@noindent
@@ -16634,7 +16635,7 @@ and @kbd{f Q} (integer square root) commands, which are analogous to
@kbd{/}, @kbd{B}, and @kbd{Q}, respectively, except that they take integer
arguments and return the result rounded down to an integer.
-@node Complex Number Functions, Conversions, Integer Truncation, Arithmetic
+@node Complex Number Functions
@section Complex Number Functions
@noindent
@@ -16702,7 +16703,7 @@ The @kbd{v u} (@code{calc-unpack}) command takes the complex number
(or other composite object) on the top of the stack and unpacks it
into its separate components.
-@node Conversions, Date Arithmetic, Complex Number Functions, Arithmetic
+@node Conversions
@section Conversions
@noindent
@@ -16865,7 +16866,7 @@ you wouldn't want it automatically converted to a 100-digit integer).
With the Hyperbolic flag, @kbd{H c c} and @kbd{H c 0} through @kbd{H c 9}
operate non-pervasively [@code{clean}].
-@node Date Arithmetic, Financial Functions, Conversions, Arithmetic
+@node Date Arithmetic
@section Date Arithmetic
@noindent
@@ -16889,11 +16890,11 @@ additional argument from the top of the stack.
@menu
* Date Conversions::
* Date Functions::
-* Time Zones::
* Business Days::
+* Time Zones::
@end menu
-@node Date Conversions, Date Functions, Date Arithmetic, Date Arithmetic
+@node Date Conversions
@subsection Date Conversions
@noindent
@@ -16981,7 +16982,7 @@ zone is used for that prompt. You can also answer the first
prompt with @kbd{$} to take the two time zone names from the
stack (and the date to be converted from the third stack level).
-@node Date Functions, Business Days, Date Conversions, Date Arithmetic
+@node Date Functions
@subsection Date Functions
@noindent
@@ -17145,7 +17146,7 @@ serves this purpose. Similarly, instead of @code{incday} and
@xref{Basic Arithmetic}, for the @kbd{f ]} [@code{incr}] command
which can adjust a date/time form by a certain number of seconds.
-@node Business Days, Time Zones, Date Functions, Date Arithmetic
+@node Business Days
@subsection Business Days
@noindent
@@ -17288,7 +17289,7 @@ any date form and returns 1 if that date falls on a weekend or
holiday, as defined in @code{Holidays}, or 0 if the date is a
business day.
-@node Time Zones, , Business Days, Date Arithmetic
+@node Time Zones
@subsection Time Zones
@noindent
@@ -17510,7 +17511,7 @@ daylight saving time (e.g., @code{PDT} or @code{PST}) the
the algorithms described above are used. If @var{zone} is omitted,
the computation is done for the current time zone.
-@node Financial Functions, Binary Functions, Date Arithmetic, Arithmetic
+@node Financial Functions
@section Financial Functions
@noindent
@@ -17537,7 +17538,7 @@ of this section to make sure the functions have the meaning you expect.
* Definitions of Financial Functions::
@end menu
-@node Percentages, Future Value, Financial Functions, Financial Functions
+@node Percentages
@subsection Percentages
@kindex M-%
@@ -17602,7 +17603,7 @@ in the second case, we're decreasing by 20% of 50.) The effect
of @kbd{40 @key{RET} 50 b %} is to compute @expr{(50-40)/40}, converting
the answer to percentage form as if by @kbd{c %}.
-@node Future Value, Present Value, Percentages, Financial Functions
+@node Future Value
@subsection Future Value
@noindent
@@ -17664,7 +17665,7 @@ now counting the payment at year five (which, since it didn't have
a chance to earn interest, counts as $1000). Indeed, @expr{5569.96 =
5870.73 - 1300.78 + 1000} (give or take a bit of roundoff error).
-@node Present Value, Related Financial Functions, Future Value, Financial Functions
+@node Present Value
@subsection Present Value
@noindent
@@ -17748,7 +17749,7 @@ The @kbd{I b N} [@code{npvb}] command computes the net present
value where payments occur at the beginning of each interval
rather than at the end.
-@node Related Financial Functions, Depreciation Functions, Present Value, Financial Functions
+@node Related Financial Functions
@subsection Related Financial Functions
@noindent
@@ -17836,7 +17837,7 @@ this rate is known as the @dfn{internal rate of return}.
The @kbd{I b I} [@code{irrb}] command computes the internal rate of
return assuming payments occur at the beginning of each period.
-@node Depreciation Functions, Definitions of Financial Functions, Related Financial Functions, Financial Functions
+@node Depreciation Functions
@subsection Depreciation Functions
@noindent
@@ -17907,7 +17908,7 @@ Summing columns with @kbd{V R : +} yields @expr{[10000, 10000, 10000]};
the total depreciation in any method is (by definition) the
difference between the cost and the salvage value.
-@node Definitions of Financial Functions, , Depreciation Functions, Financial Functions
+@node Definitions of Financial Functions
@subsection Definitions
@noindent
@@ -18061,7 +18062,7 @@ and the depreciation is zero for all subsequent periods. The @code{ddb}
function returns the amount the book value decreased in the specified
period.
-@node Binary Functions, , Financial Functions, Arithmetic
+@node Binary Functions
@section Binary Number Functions
@noindent
@@ -18251,7 +18252,7 @@ unpack; type @kbd{31 @key{TAB} -} to replace each bit-number in the set
with 31 minus that bit-number; type @kbd{b p} to pack the set back
into a binary integer.
-@node Scientific Functions, Matrix Functions, Arithmetic, Top
+@node Scientific Functions
@chapter Scientific Functions
@noindent
@@ -18318,7 +18319,7 @@ interpret a prefix argument.
* Probability Distribution Functions::
@end menu
-@node Logarithmic Functions, Trigonometric and Hyperbolic Functions, Scientific Functions, Scientific Functions
+@node Logarithmic Functions
@section Logarithmic Functions
@noindent
@@ -18412,7 +18413,7 @@ The @kbd{f L} (@code{calc-lnp1}) [@code{lnp1}] command computes
@infoline @expr{ln(x+1)},
producing a more accurate answer when @expr{x} is close to zero.
-@node Trigonometric and Hyperbolic Functions, Advanced Math Functions, Logarithmic Functions, Scientific Functions
+@node Trigonometric and Hyperbolic Functions
@section Trigonometric/Hyperbolic Functions
@noindent
@@ -18589,7 +18590,7 @@ counterparts, which are also available separately as @code{calc-sech}
[@code{sech}], @code{calc-csch} [@code{csch}] and @code{calc-coth}
[@code{coth}]. (These commands do not accept the Inverse flag.)
-@node Advanced Math Functions, Branch Cuts, Trigonometric and Hyperbolic Functions, Scientific Functions
+@node Advanced Math Functions
@section Advanced Mathematical Functions
@noindent
@@ -18726,7 +18727,7 @@ Calc's implementation of the Bessel functions currently limits the
precision to 8 digits, and may not be exact even to that precision.
Use with care!
-@node Branch Cuts, Random Numbers, Advanced Math Functions, Scientific Functions
+@node Branch Cuts
@section Branch Cuts and Principal Values
@noindent
@@ -18870,7 +18871,7 @@ The ``advanced math'' functions (gamma, Bessel, etc.@:) are also defined
for general complex arguments, but their branch cuts and principal values
are not rigorously specified at present.
-@node Random Numbers, Combinatorial Functions, Branch Cuts, Scientific Functions
+@node Random Numbers
@section Random Numbers
@noindent
@@ -18888,9 +18889,7 @@ Each possible value @expr{N} appears with equal probability.
With no numeric prefix argument, the @kbd{k r} command takes its argument
from the stack instead. Once again, if this is a positive integer @expr{M}
-the result is a random integer less than @expr{M}. However, note that
-while numeric prefix arguments are limited to six digits or so, an @expr{M}
-taken from the stack can be arbitrarily large. If @expr{M} is negative,
+the result is a random integer less than @expr{M}. If @expr{M} is negative,
the result is a random integer in the range
@texline @math{M < N \le 0}.
@infoline @expr{M < N <= 0}.
@@ -19000,7 +18999,7 @@ elements of this vector. @xref{Matrix Functions}.
* Random Number Generator:: (Complete description of Calc's algorithm)
@end menu
-@node Random Number Generator, , Random Numbers, Random Numbers
+@node Random Number Generator
@subsection Random Number Generator
Calc's random number generator uses several methods to ensure that
@@ -19098,7 +19097,7 @@ The Gaussian random numbers generated by @samp{random(0.0)} use the
generates a pair of Gaussian random numbers at a time, so only every
other call to @samp{random(0.0)} will require significant calculations.
-@node Combinatorial Functions, Probability Distribution Functions, Random Numbers, Scientific Functions
+@node Combinatorial Functions
@section Combinatorial Functions
@noindent
@@ -19314,7 +19313,7 @@ distinct factors, this is @expr{(-1)^k}. If the input number has any
duplicate factors (i.e., can be divided by the same prime more than once),
the result is zero.
-@node Probability Distribution Functions, , Combinatorial Functions, Scientific Functions
+@node Probability Distribution Functions
@section Probability Distribution Functions
@noindent
@@ -19465,7 +19464,7 @@ Since the distribution functions are monotonic, @kbd{a R} is guaranteed
to be able to find a solution given any initial guess.
@xref{Numerical Solutions}.
-@node Matrix Functions, Algebra, Scientific Functions, Top
+@node Matrix Functions
@chapter Vector/Matrix Functions
@noindent
@@ -19493,7 +19492,7 @@ vector of matrices, and so on.)
* Vector and Matrix Formats::
@end menu
-@node Packing and Unpacking, Building Vectors, Matrix Functions, Matrix Functions
+@node Packing and Unpacking
@section Packing and Unpacking
@noindent
@@ -19713,7 +19712,7 @@ Subscript notation is a useful way to extract a particular part
of an object. For example, to get the numerator of a rational
number, you can use @samp{unpack(-10, @var{x})_1}.
-@node Building Vectors, Extracting Elements, Packing and Unpacking, Matrix Functions
+@node Building Vectors
@section Building Vectors
@noindent
@@ -19881,7 +19880,7 @@ representing the remainder of the vector. Thus the vector
Also, @samp{head([a, b, c, d]) = a}, @samp{tail([a, b, c, d]) = [b, c, d]},
@samp{rhead([a, b, c, d]) = [a, b, c]}, and @samp{rtail([a, b, c, d]) = d}.
-@node Extracting Elements, Manipulating Vectors, Building Vectors, Matrix Functions
+@node Extracting Elements
@section Extracting Vector Elements
@noindent
@@ -19987,7 +19986,7 @@ produces @samp{[a, d, e]}. It is always true that @code{subvec} and
@xref{Selecting Subformulas}, for an alternative way to operate on
vectors one element at a time.
-@node Manipulating Vectors, Vector and Matrix Arithmetic, Extracting Elements, Matrix Functions
+@node Manipulating Vectors
@section Manipulating Vectors
@noindent
@@ -20219,7 +20218,7 @@ operation across the two vectors. @xref{Logical Operations}. Note that
the @code{? :} operation also discussed there allows other types of
masking using vectors.
-@node Vector and Matrix Arithmetic, Set Operations, Manipulating Vectors, Matrix Functions
+@node Vector and Matrix Arithmetic
@section Vector and Matrix Arithmetic
@noindent
@@ -20341,7 +20340,7 @@ elements of the matrix.
The @kbd{V K} (@code{calc-kron}) [@code{kron}] command computes
the Kronecker product of two matrices.
-@node Set Operations, Statistical Operations, Vector and Matrix Arithmetic, Matrix Functions
+@node Set Operations
@section Set Operations using Vectors
@noindent
@@ -20531,7 +20530,7 @@ representation
@texline (@math{2^{100}}, a 31-digit integer, in this case).
@infoline (@expr{2^100}, a 31-digit integer, in this case).
-@node Statistical Operations, Reducing and Mapping, Set Operations, Matrix Functions
+@node Statistical Operations
@section Statistical Operations on Vectors
@noindent
@@ -20560,7 +20559,7 @@ probability distribution functions.
* Paired-Sample Statistics::
@end menu
-@node Single-Variable Statistics, Paired-Sample Statistics, Statistical Operations, Statistical Operations
+@node Single-Variable Statistics
@subsection Single-Variable Statistics
@noindent
@@ -20829,7 +20828,7 @@ arguments, interpreted in the same way as the other functions
in this section. For example, @samp{vflat(1, [2, [3, 4]], 5)}
returns @samp{[1, 2, 3, 4, 5]}.
-@node Paired-Sample Statistics, , Single-Variable Statistics, Statistical Operations
+@node Paired-Sample Statistics
@subsection Paired-Sample Statistics
@noindent
@@ -20890,7 +20889,7 @@ between sample or population statistics here.)
$$ r_{x\!y} = { \sigma_{x\!y}^2 \over \sigma_x^2 \sigma_y^2 } $$
@end tex
-@node Reducing and Mapping, Vector and Matrix Formats, Statistical Operations, Matrix Functions
+@node Reducing and Mapping
@section Reducing and Mapping Vectors
@noindent
@@ -20920,7 +20919,7 @@ While @kbd{V A} is useful in some cases, you will usually find that either
* Generalized Products::
@end menu
-@node Specifying Operators, Mapping, Reducing and Mapping, Reducing and Mapping
+@node Specifying Operators
@subsection Specifying Operators
@noindent
@@ -21071,7 +21070,7 @@ a function, since the name @code{gcd} corresponds to the Lisp variable
automatically makes this translation, so you don't have to worry
about it.)
-@node Mapping, Reducing, Specifying Operators, Reducing and Mapping
+@node Mapping
@subsection Mapping
@noindent
@@ -21168,7 +21167,7 @@ mapping command. The default @kbd{V M} always means map-by-elements.
@xref{Storing Variables}, for the @kbd{s m} command which modifies a
variable's stored value using a @kbd{V M}-like operator.
-@node Reducing, Nesting and Fixed Points, Mapping, Reducing and Mapping
+@node Reducing
@subsection Reducing
@noindent
@@ -21249,7 +21248,7 @@ The commands @kbd{C-x * :} and @kbd{C-x * _} are equivalent to typing
@kbd{V R : +} or @kbd{V R _ +}, respectively, to sum the columns or
rows of the matrix. @xref{Grabbing From Buffers}.
-@node Nesting and Fixed Points, Generalized Products, Reducing, Reducing and Mapping
+@node Nesting and Fixed Points
@subsection Nesting and Fixed Points
@noindent
@@ -21329,7 +21328,7 @@ computes the square root of @samp{A} given the initial guess @samp{B},
stopping when the result is correct within the specified tolerance, or
when 20 steps have been taken, whichever is sooner.
-@node Generalized Products, , Nesting and Fixed Points, Reducing and Mapping
+@node Generalized Products
@subsection Generalized Products
@kindex v O
@@ -21366,7 +21365,7 @@ use @kbd{$} twice to take both operator formulas from the stack, the
first (multiplicative) operator is taken from the top of the stack
and the second (additive) operator is taken from second-to-top.
-@node Vector and Matrix Formats, , Reducing and Mapping, Matrix Functions
+@node Vector and Matrix Formats
@section Vector and Matrix Display Formats
@noindent
@@ -21513,7 +21512,7 @@ line. This mode causes all vectors, whether matrices or not, to be
displayed with a single element per line. Sub-vectors within the
vectors will still use the normal linear form.
-@node Algebra, Units, Matrix Functions, Top
+@node Algebra
@chapter Algebra
@noindent
@@ -21553,7 +21552,7 @@ of these modes. You may also wish to select Big display mode (@kbd{d B}).
* Rewrite Rules::
@end menu
-@node Selecting Subformulas, Algebraic Manipulation, Algebra, Algebra
+@node Selecting Subformulas
@section Selecting Sub-Formulas
@noindent
@@ -21579,7 +21578,7 @@ on one element of a vector in-place, simply select that element as a
* Rearranging with Selections::
@end menu
-@node Making Selections, Changing Selections, Selecting Subformulas, Selecting Subformulas
+@node Making Selections
@subsection Making Selections
@noindent
@@ -21740,7 +21739,7 @@ position.
The @kbd{j c} (@code{calc-clear-selections}) command unselects all
stack elements.
-@node Changing Selections, Displaying Selections, Making Selections, Selecting Subformulas
+@node Changing Selections
@subsection Changing Selections
@noindent
@@ -21829,7 +21828,7 @@ The Info @kbd{m} command is somewhat similar to Calc's @kbd{j s} and
@kbd{j l}; in each case, you can jump directly to a sub-component
of the hierarchy simply by pointing to it with the cursor.
-@node Displaying Selections, Operating on Selections, Changing Selections, Selecting Subformulas
+@node Displaying Selections
@subsection Displaying Selections
@noindent
@@ -21860,7 +21859,7 @@ and the selected sub-formula will be highlighted by using a more
noticeable face (@code{calc-selected-face}) instead of @samp{#}
signs. (@pxref{Customizing Calc}.)
-@node Operating on Selections, Rearranging with Selections, Displaying Selections, Selecting Subformulas
+@node Operating on Selections
@subsection Operating on Selections
@noindent
@@ -22017,7 +22016,7 @@ to be simplified.
@end group
@end smallexample
-@node Rearranging with Selections, , Operating on Selections, Selecting Subformulas
+@node Rearranging with Selections
@subsection Rearranging Formulas using Selections
@noindent
@@ -22266,7 +22265,7 @@ The @kbd{j "} (@code{calc-sel-expand-formula}) command is to @kbd{a "}
You can use the @kbd{j r} (@code{calc-rewrite-selection}) command
to define other algebraic operations on sub-formulas. @xref{Rewrite Rules}.
-@node Algebraic Manipulation, Simplifying Formulas, Selecting Subformulas, Algebra
+@node Algebraic Manipulation
@section Algebraic Manipulation
@noindent
@@ -22430,7 +22429,7 @@ evaluated immediately, even if its arguments are variables, so if
you wish to put a call to @code{subst} onto the stack you must
turn the default simplifications off first (with @kbd{m O}).
-@node Simplifying Formulas, Polynomials, Algebraic Manipulation, Algebra
+@node Simplifying Formulas
@section Simplifying Formulas
@noindent
@@ -22479,7 +22478,7 @@ combinations of @samp{sinh}s and @samp{cosh}s before simplifying.
* Simplification of Units::
@end menu
-@node Basic Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas
+@node Basic Simplifications
@subsection Basic Simplifications
@noindent
@@ -22809,7 +22808,7 @@ Most other Calc functions have few if any basic simplifications
defined, aside of course from evaluation when the arguments are
suitable numbers.
-@node Algebraic Simplifications, Unsafe Simplifications, Basic Simplifications, Simplifying Formulas
+@node Algebraic Simplifications
@subsection Algebraic Simplifications
@noindent
@@ -23042,7 +23041,7 @@ all simplified to 0, but @expr{x > 3} is simplified to 1.
By a similar analysis, @expr{abs(x) >= 0} is simplified to 1,
as is @expr{x^2 >= 0} if @expr{x} is known to be real.
-@node Unsafe Simplifications, Simplification of Units, Algebraic Simplifications, Simplifying Formulas
+@node Unsafe Simplifications
@subsection ``Unsafe'' Simplifications
@noindent
@@ -23135,7 +23134,7 @@ on whether you believe @expr{x} is positive or negative).
The @kbd{a M /} command can be used to divide a factor out of
both sides of an inequality.
-@node Simplification of Units, , Unsafe Simplifications, Simplifying Formulas
+@node Simplification of Units
@subsection Simplification of Units
@noindent
@@ -23220,7 +23219,7 @@ that have angular units like @code{rad} or @code{arcmin} are
simplified by converting to base units (radians), then evaluating
with the angular mode temporarily set to radians.
-@node Polynomials, Calculus, Simplifying Formulas, Algebra
+@node Polynomials
@section Polynomials
A @dfn{polynomial} is a sum of terms which are coefficients times
@@ -23444,7 +23443,7 @@ polynomial routines used in the above commands.
@xref{Decomposing Polynomials}, for several useful functions for
extracting the individual coefficients of a polynomial.
-@node Calculus, Solving Equations, Polynomials, Algebra
+@node Calculus
@section Calculus
@noindent
@@ -23462,7 +23461,7 @@ readable way.
* Taylor Series::
@end menu
-@node Differentiation, Integration, Calculus, Calculus
+@node Differentiation
@subsection Differentiation
@noindent
@@ -23520,7 +23519,7 @@ Various higher-order derivatives can be formed in the obvious way, e.g.,
@samp{f'@var{}'2'3(x,y,z)} (@code{f} differentiated with respect to each
argument once).
-@node Integration, Customizing the Integrator, Differentiation, Calculus
+@node Integration
@subsection Integration
@noindent
@@ -23607,7 +23606,7 @@ table-lookup solutions of integrals. You might then wish to define
rewrite rules for integration by parts, various kinds of substitutions,
and so on. @xref{Rewrite Rules}.
-@node Customizing the Integrator, Numerical Integration, Integration, Calculus
+@node Customizing the Integrator
@subsection Customizing the Integrator
@noindent
@@ -23733,7 +23732,7 @@ of times until no further changes are possible. Rewriting by
finished, not at every step as for @code{IntegRules} and
@code{IntegSimpRules}.
-@node Numerical Integration, Taylor Series, Customizing the Integrator, Calculus
+@node Numerical Integration
@subsection Numerical Integration
@noindent
@@ -23771,7 +23770,7 @@ The integral of @samp{1/sqrt(x)} from 0 to 1 exists (it can be found
by Calc's symbolic integrator, for example), but @kbd{a I} will fail
because the integrand goes to infinity at one of the endpoints.
-@node Taylor Series, , Numerical Integration, Calculus
+@node Taylor Series
@subsection Taylor Series
@noindent
@@ -23792,7 +23791,7 @@ If the @kbd{a i} command is unable to find a symbolic integral for a
function, you can get an approximation by integrating the function's
Taylor series.
-@node Solving Equations, Numerical Solutions, Calculus, Algebra
+@node Solving Equations
@section Solving Equations
@noindent
@@ -23836,7 +23835,7 @@ another formula with @expr{x} set equal to @expr{y/3 - 2}.
* Decomposing Polynomials::
@end menu
-@node Multiple Solutions, Solving Systems of Equations, Solving Equations, Solving Equations
+@node Multiple Solutions
@subsection Multiple Solutions
@noindent
@@ -23950,7 +23949,7 @@ formula on the stack with Symbolic mode temporarily off.) Naturally,
@kbd{a P} can only provide numerical roots if the polynomial coefficients
are all numbers (real or complex).
-@node Solving Systems of Equations, Decomposing Polynomials, Multiple Solutions, Solving Equations
+@node Solving Systems of Equations
@subsection Solving Systems of Equations
@noindent
@@ -24017,7 +24016,7 @@ Another way to deal with certain kinds of overdetermined systems of
equations is the @kbd{a F} command, which does least-squares fitting
to satisfy the equations. @xref{Curve Fitting}.
-@node Decomposing Polynomials, , Solving Systems of Equations, Solving Equations
+@node Decomposing Polynomials
@subsection Decomposing Polynomials
@noindent
@@ -24161,7 +24160,7 @@ if necessary) by its content. If the input polynomial has rational
coefficients, the result will have integer coefficients in simplest
terms.
-@node Numerical Solutions, Curve Fitting, Solving Equations, Algebra
+@node Numerical Solutions
@section Numerical Solutions
@noindent
@@ -24180,7 +24179,7 @@ on numerical data.)
* Numerical Systems of Equations::
@end menu
-@node Root Finding, Minimization, Numerical Solutions, Numerical Solutions
+@node Root Finding
@subsection Root Finding
@noindent
@@ -24256,7 +24255,7 @@ form on the stack, it will normally display an explanation for why
no root was found. If you miss this explanation, press @kbd{w}
(@code{calc-why}) to get it back.
-@node Minimization, Numerical Systems of Equations, Root Finding, Numerical Solutions
+@node Minimization
@subsection Minimization
@noindent
@@ -24328,7 +24327,7 @@ the initial guess is a complex number the variable will be minimized
over the complex numbers; if it is real or an interval it will
be minimized over the reals.
-@node Numerical Systems of Equations, , Minimization, Numerical Solutions
+@node Numerical Systems of Equations
@subsection Systems of Equations
@noindent
@@ -24354,7 +24353,7 @@ multidimensional @kbd{a R}, the formula being minimized should
still be a single formula, @emph{not} a vector. Beware that
multidimensional minimization is currently @emph{very} slow.
-@node Curve Fitting, Summations, Numerical Solutions, Algebra
+@node Curve Fitting
@section Curve Fitting
@noindent
@@ -24380,7 +24379,7 @@ plotted after the formula is determined. This will be indicated by a
* Interpolation::
@end menu
-@node Linear Fits, Polynomial and Multilinear Fits, Curve Fitting, Curve Fitting
+@node Linear Fits
@subsection Linear Fits
@noindent
@@ -24546,7 +24545,7 @@ vector of @expr{y} values. If there is only one independent variable,
the @expr{x} values can be either a one-row matrix or a plain vector,
in which case the @kbd{C-u} prefix is the same as a @w{@kbd{C-u 2}} prefix.
-@node Polynomial and Multilinear Fits, Error Estimates for Fits, Linear Fits, Curve Fitting
+@node Polynomial and Multilinear Fits
@subsection Polynomial and Multilinear Fits
@noindent
@@ -24661,7 +24660,7 @@ would enter @kbd{a F ' 2.3 + a x}.
Another class of models that will work but must be entered by hand
are multinomial fits, e.g., @expr{a + b x + c y + d x^2 + e y^2 + f x y}.
-@node Error Estimates for Fits, Standard Nonlinear Models, Polynomial and Multilinear Fits, Curve Fitting
+@node Error Estimates for Fits
@subsection Error Estimates for Fits
@noindent
@@ -24822,7 +24821,7 @@ in the input, and thus there is no redundant information left
over to use for a confidence test.
@end enumerate
-@node Standard Nonlinear Models, Curve Fitting Details, Error Estimates for Fits, Curve Fitting
+@node Standard Nonlinear Models
@subsection Standard Nonlinear Models
@noindent
@@ -25006,7 +25005,7 @@ Fourier analysis, which is beyond the scope of the @kbd{a F} command.
(Unfortunately, Calc does not currently have any facilities for
taking Fourier and related transforms.)
-@node Curve Fitting Details, Interpolation, Standard Nonlinear Models, Curve Fitting
+@node Curve Fitting Details
@subsection Curve Fitting Details
@noindent
@@ -25398,7 +25397,7 @@ linearizer was unable to put the model into the required form.
The @code{efit} (corresponding to @kbd{H a F}) and @code{xfit}
(for @kbd{I a F}) functions are completely analogous.
-@node Interpolation, , Curve Fitting Details, Curve Fitting
+@node Interpolation
@subsection Polynomial Interpolation
@kindex a p
@@ -25455,7 +25454,7 @@ used by @kbd{H a p}. (The algorithm never generates these coefficients
explicitly, and quotients of polynomials are beyond @w{@kbd{a F}}'s
capabilities to fit.)
-@node Summations, Logical Operations, Curve Fitting, Algebra
+@node Summations
@section Summations
@noindent
@@ -25616,7 +25615,7 @@ like @code{sum} and @code{prod}, but its result is simply a
vector of the results. For example, @samp{table(a_i, i, 1, 7, 2)}
produces @samp{[a_1, a_3, a_5, a_7]}.
-@node Logical Operations, Rewrite Rules, Summations, Algebra
+@node Logical Operations
@section Logical Operations
@noindent
@@ -25994,7 +25993,7 @@ declarations are used when deciding whether a formula is true;
it returns 0 when @code{dnonzero} would return 0 or leave itself
in symbolic form.)
-@node Rewrite Rules, , Logical Operations, Algebra
+@node Rewrite Rules
@section Rewrite Rules
@noindent
@@ -26036,7 +26035,7 @@ Calc formulas.
* Examples of Rewrite Rules::
@end menu
-@node Entering Rewrite Rules, Basic Rewrite Rules, Rewrite Rules, Rewrite Rules
+@node Entering Rewrite Rules
@subsection Entering Rewrite Rules
@noindent
@@ -26102,7 +26101,7 @@ Calc also accepts an obsolete notation for rules, as vectors
@samp{[@var{old}, @var{new}]}. But because it is easily confused with a
vector of two rules, the use of this notation is no longer recommended.
-@node Basic Rewrite Rules, Conditional Rewrite Rules, Entering Rewrite Rules, Rewrite Rules
+@node Basic Rewrite Rules
@subsection Basic Rewrite Rules
@noindent
@@ -26146,7 +26145,7 @@ throughout the target formula until no further changes are possible
(up to a limit of 100 times). Use @kbd{C-u 1 a r} to make only one
change at a time.
-@node Conditional Rewrite Rules, Algebraic Properties of Rewrite Rules, Basic Rewrite Rules, Rewrite Rules
+@node Conditional Rewrite Rules
@subsection Conditional Rewrite Rules
@noindent
@@ -26229,7 +26228,7 @@ the condition @samp{1} is always true (nonzero) so it has no effect on
the functioning of the rule. (The rewrite compiler will ensure that
it doesn't even impact the speed of matching the rule.)
-@node Algebraic Properties of Rewrite Rules, Other Features of Rewrite Rules, Conditional Rewrite Rules, Rewrite Rules
+@node Algebraic Properties of Rewrite Rules
@subsection Algebraic Properties of Rewrite Rules
@noindent
@@ -26568,7 +26567,7 @@ In this example, we are still allowing the pattern-matcher to
use all the algebra it can muster, but the righthand side will
always simplify to a literal addition like @samp{f((-y) + x)}.
-@node Other Features of Rewrite Rules, Composing Patterns in Rewrite Rules, Algebraic Properties of Rewrite Rules, Rewrite Rules
+@node Other Features of Rewrite Rules
@subsection Other Features of Rewrite Rules
@noindent
@@ -26970,7 +26969,7 @@ rule remembers only every fourth result. Note that @samp{remember(1)}
is equivalent to @samp{remember}, and @samp{remember(0)} has no effect.
@end table
-@node Composing Patterns in Rewrite Rules, Nested Formulas with Rewrite Rules, Other Features of Rewrite Rules, Rewrite Rules
+@node Composing Patterns in Rewrite Rules
@subsection Composing Patterns in Rewrite Rules
@noindent
@@ -27139,7 +27138,7 @@ disastrous: since @code{a} was unbound so far, the pattern @samp{a}
would have matched anything at all, and the pattern @samp{!!!a}
therefore would @emph{not} have matched anything at all!
-@node Nested Formulas with Rewrite Rules, Multi-Phase Rewrite Rules, Composing Patterns in Rewrite Rules, Rewrite Rules
+@node Nested Formulas with Rewrite Rules
@subsection Nested Formulas with Rewrite Rules
@noindent
@@ -27223,7 +27222,7 @@ integer, or @samp{inf} or @samp{-inf}. If @var{n} is omitted
the @code{iterations} value from the rule set is used; if both
are omitted, 100 is used.
-@node Multi-Phase Rewrite Rules, Selections with Rewrite Rules, Nested Formulas with Rewrite Rules, Rewrite Rules
+@node Multi-Phase Rewrite Rules
@subsection Multi-Phase Rewrite Rules
@noindent
@@ -27344,7 +27343,7 @@ rules were finished, some components might be put away into vectors
before they had a chance to recombine. By putting these rules in
two separate phases, this problem is neatly avoided.
-@node Selections with Rewrite Rules, Matching Commands, Multi-Phase Rewrite Rules, Rewrite Rules
+@node Selections with Rewrite Rules
@subsection Selections with Rewrite Rules
@noindent
@@ -27417,7 +27416,7 @@ purpose rules with @samp{select( )} hints inside them so that they
will ``do the right thing'' in both @kbd{a r} and @kbd{j r},
both with and without selections.
-@node Matching Commands, Automatic Rewrites, Selections with Rewrite Rules, Rewrite Rules
+@node Matching Commands
@subsection Matching Commands
@noindent
@@ -27469,7 +27468,7 @@ the meta-variables instead of the number 1. For example,
@samp{vmatches(f(1,2), f(a,b))} returns @samp{[a := 1, b := 2]}.
If the match fails, the function returns the number 0.
-@node Automatic Rewrites, Debugging Rewrites, Matching Commands, Rewrite Rules
+@node Automatic Rewrites
@subsection Automatic Rewrites
@noindent
@@ -27643,7 +27642,7 @@ also apply @code{EvalRules} and @code{AlgSimpRules}. The variable
@code{IntegSimpRules} contains simplification rules that are used
only during integration by @kbd{a i}.
-@node Debugging Rewrites, Examples of Rewrite Rules, Automatic Rewrites, Rewrite Rules
+@node Debugging Rewrites
@subsection Debugging Rewrites
@noindent
@@ -27663,7 +27662,7 @@ buffer (with @kbd{C-x k *Trace* @key{RET}}). If you leave it in
existence and forget about it, all your future rewrite commands will
be needlessly slow.
-@node Examples of Rewrite Rules, , Debugging Rewrites, Rewrite Rules
+@node Examples of Rewrite Rules
@subsection Examples of Rewrite Rules
@noindent
@@ -27753,7 +27752,7 @@ results in the four-argument form, just append the two items
of the rule set. (But remember that multi-phase rule sets don't work
in @code{EvalRules}.)
-@node Units, Store and Recall, Algebra, Top
+@node Units
@chapter Operating on Units
@noindent
@@ -27772,7 +27771,7 @@ begin with the @kbd{u} prefix key.
* Musical Notes::
@end menu
-@node Basic Operations on Units, The Units Table, Units, Units
+@node Basic Operations on Units
@section Basic Operations on Units
@noindent
@@ -27977,7 +27976,7 @@ is also the actual name of another unit; @samp{1e-15 t} would normally
be considered a ``femto-ton,'' but it is written as @samp{1000 at}
(1000 atto-tons) instead because @code{ft} would be confused with feet.
-@node The Units Table, Predefined Units, Basic Operations on Units, Units
+@node The Units Table
@section The Units Table
@noindent
@@ -28034,7 +28033,7 @@ for the expression @samp{62 km^2 g / s^2 mol K}, the description is
command uses the English descriptions that appear in the righthand
column of the Units Table.
-@node Predefined Units, User-Defined Units, The Units Table, Units
+@node Predefined Units
@section Predefined Units
@noindent
@@ -28131,7 +28130,7 @@ really is unitless.)
@c Describe angular units, luminosity vs. steradians problem.
-@node User-Defined Units, Logarithmic Units, Predefined Units, Units
+@node User-Defined Units
@section User-Defined Units
@noindent
@@ -28215,7 +28214,7 @@ was already a set of user-defined units in your Calc init file, it
is replaced by the new set. (@xref{General Mode Commands}, for a way to
tell Calc to use a different file for the Calc init file.)
-@node Logarithmic Units, Musical Notes, User-Defined Units, Units
+@node Logarithmic Units
@section Logarithmic Units
The units @code{dB} (decibels) and @code{Np} (nepers) are logarithmic
@@ -28454,7 +28453,7 @@ number; the @kbd{l /} (@code{calc-lu-divide}) [@code{lupdiv}] and
unit by a number. Note that the reference quantities don't play a role
in this arithmetic.
-@node Musical Notes, , Logarithmic Units, Units
+@node Musical Notes
@section Musical Notes
Calc can convert between musical notes and their associated
@@ -28522,7 +28521,7 @@ notation @code{B_3 + 99.9962592773 cents}; with the default value of
@code{1}, Calc converts @code{261.625 Hz} to @code{C_4}.
-@node Store and Recall, Graphics, Units, Top
+@node Store and Recall
@chapter Storing and Recalling
@noindent
@@ -28539,7 +28538,7 @@ to variables use the @kbd{s} prefix key.
* Evaluates-To Operator::
@end menu
-@node Storing Variables, Recalling Variables, Store and Recall, Store and Recall
+@node Storing Variables
@section Storing Variables
@noindent
@@ -28767,7 +28766,7 @@ stored in the Calc variable @code{pi}. If one of the other special
variables, @code{inf}, @code{uinf} or @code{nan}, is given a value, its
original behavior can be restored by voiding it with @kbd{s u}.
-@node Recalling Variables, Operations on Variables, Storing Variables, Store and Recall
+@node Recalling Variables
@section Recalling Variables
@noindent
@@ -28790,7 +28789,7 @@ latter will produce an error message.
The @kbd{r} prefix may be followed by a digit, so that @kbd{r 9} is
equivalent to @kbd{s r 9}.
-@node Operations on Variables, Let Command, Recalling Variables, Store and Recall
+@node Operations on Variables
@section Other Operations on Variables
@noindent
@@ -28947,7 +28946,7 @@ omits the same set of variables as @w{@kbd{s p @key{RET}}}; the difference
is that @kbd{s i} will store the variables in any buffer, and it also
stores in a more human-readable format.)
-@node Let Command, Evaluates-To Operator, Operations on Variables, Store and Recall
+@node Let Command
@section The Let Command
@noindent
@@ -28985,7 +28984,7 @@ example, letting @expr{n=2} in @samp{f(n pi)} with @kbd{a b} will
produce @samp{f(2 pi)}, whereas @kbd{s l} would give @samp{f(6.28)}
since the evaluation step will also evaluate @code{pi}.
-@node Evaluates-To Operator, , Let Command, Store and Recall
+@node Evaluates-To Operator
@section The Evaluates-To Operator
@noindent
@@ -29111,7 +29110,7 @@ and value from the stack and replaces them with an assignment.
@TeX{} language output. The @dfn{eqn} mode gives similar
treatment to @samp{=>}.
-@node Graphics, Kill and Yank, Store and Recall, Top
+@node Graphics
@chapter Graphics
@noindent
@@ -29142,7 +29141,7 @@ POSIX-compatible terminal.
* Devices::
@end menu
-@node Basic Graphics, Three Dimensional Graphics, Graphics, Graphics
+@node Basic Graphics
@section Basic Graphics
@noindent
@@ -29228,7 +29227,7 @@ to use @kbd{g c} if you don't want to---if you give another @kbd{g f}
or @kbd{g p} command later on, it will reuse the existing graphics
window if there is one.
-@node Three Dimensional Graphics, Managing Curves, Basic Graphics, Graphics
+@node Three Dimensional Graphics
@section Three-Dimensional Graphics
@kindex g F
@@ -29296,7 +29295,7 @@ helix (a three-dimensional spiral).
As for @kbd{g f}, each of ``x'', ``y'', and ``z'' may instead be
variables containing the relevant data.
-@node Managing Curves, Graphics Options, Three Dimensional Graphics, Graphics
+@node Managing Curves
@section Managing Curves
@noindent
@@ -29455,7 +29454,7 @@ Provided everything is set up properly, @kbd{g p} will plot to
the screen unless you have specified otherwise and @kbd{g P} will
always plot to the printer.
-@node Graphics Options, Devices, Managing Curves, Graphics
+@node Graphics Options
@section Graphics Options
@noindent
@@ -29621,7 +29620,7 @@ lines, and the third curve to have lines in style 3. Point styles will
still be assigned automatically, but you could store another vector in
@code{PointStyles} to define them, too.
-@node Devices, , Graphics Options, Graphics
+@node Devices
@section Graphical Devices
@noindent
@@ -29814,7 +29813,7 @@ except that it also views the @file{*Gnuplot Trail*} buffer so that
you can see the process being killed. This is better if you are
killing GNUPLOT because you think it has gotten stuck.
-@node Kill and Yank, Keypad Mode, Graphics, Top
+@node Kill and Yank
@chapter Kill and Yank Functions
@noindent
@@ -29834,7 +29833,7 @@ work with Calc from a regular editing buffer. @xref{Embedded Mode}.
* X Cut and Paste::
@end menu
-@node Killing From Stack, Yanking Into Stack, Kill and Yank, Kill and Yank
+@node Killing From Stack
@section Killing from the Stack
@noindent
@@ -29878,7 +29877,7 @@ with no argument copies only the number itself into the kill ring, whereas
@kbd{C-k} with a prefix argument of 1 copies the number with its trailing
newline.
-@node Yanking Into Stack, Saving Into Registers, Killing From Stack, Kill and Yank
+@node Yanking Into Stack
@section Yanking into the Stack
@noindent
@@ -29910,7 +29909,7 @@ allow the text being yanked to be read in a different base (such as if
the text is an algebraic expression), then the prefix will have no
effect.
-@node Saving Into Registers, Inserting From Registers, Yanking Into Stack, Kill and Yank
+@node Saving Into Registers
@section Saving into Registers
@noindent
@@ -29944,7 +29943,7 @@ region to the beginning of the register contents. Both commands take
@kbd{C-u} arguments, which will cause the region to be deleted after being
added to the register.
-@node Inserting From Registers, Grabbing From Buffers, Saving Into Registers, Kill and Yank
+@node Inserting From Registers
@section Inserting from Registers
@noindent
@kindex r i
@@ -29956,7 +29955,7 @@ within Calc, then the full internal structure of the contents will be
inserted into the Calculator, otherwise whatever text is in the
register is reparsed and then inserted into the Calculator.
-@node Grabbing From Buffers, Yanking Into Buffers, Inserting From Registers, Kill and Yank
+@node Grabbing From Buffers
@section Grabbing from Other Buffers
@noindent
@@ -30073,7 +30072,7 @@ handy way to find the product of a vector or matrix of numbers.
@xref{Statistical Operations}. Another approach would be to use
an explicit column reduction command, @kbd{V R : *}.
-@node Yanking Into Buffers, X Cut and Paste, Grabbing From Buffers, Kill and Yank
+@node Yanking Into Buffers
@section Yanking into Other Buffers
@noindent
@@ -30127,7 +30126,7 @@ The @kbd{C-x * y} key sequence is equivalent to @kbd{y} except that
it can be typed anywhere, not just in Calc. This provides an easy
way to guarantee that Calc knows which editing buffer you want to use!
-@node X Cut and Paste, , Yanking Into Buffers, Kill and Yank
+@node X Cut and Paste
@section X Cut and Paste
@noindent
@@ -30156,7 +30155,7 @@ whole line. So you can usually transfer a single number into Calc
just by double-clicking on it in the shell, then middle-clicking
in the Calc window.
-@node Keypad Mode, Embedded Mode, Kill and Yank, Top
+@node Keypad Mode
@chapter Keypad Mode
@noindent
@@ -30208,7 +30207,7 @@ original buffer.
* Keypad Modes Menu::
@end menu
-@node Keypad Main Menu, Keypad Functions Menu, Keypad Mode, Keypad Mode
+@node Keypad Main Menu
@section Main Menu
@smallexample
@@ -30339,7 +30338,7 @@ running standalone (the @code{full-calc-keypad} command appeared in the
command line that started Emacs), then @kbd{OFF} is replaced with
@kbd{EXIT}; clicking on this actually exits Emacs itself.
-@node Keypad Functions Menu, Keypad Binary Menu, Keypad Main Menu, Keypad Mode
+@node Keypad Functions Menu
@section Functions Menu
@smallexample
@@ -30382,7 +30381,7 @@ same limit as last time.
@key{NXTP} finds the next prime after a number. @kbd{INV NXTP}
finds the previous prime.
-@node Keypad Binary Menu, Keypad Vectors Menu, Keypad Functions Menu, Keypad Mode
+@node Keypad Binary Menu
@section Binary Menu
@smallexample
@@ -30415,7 +30414,7 @@ and allows you to enter a new word size. You can respond to the prompt
using either the keyboard or the digits and @key{ENTER} from the keypad.
The initial word size is 32 bits.
-@node Keypad Vectors Menu, Keypad Modes Menu, Keypad Binary Menu, Keypad Mode
+@node Keypad Vectors Menu
@section Vectors Menu
@smallexample
@@ -30497,7 +30496,7 @@ With @key{INV}, @key{HYP}, or @key{INV} and @key{HYP}, the
@kbd{"x"} key pushes the variable names @expr{y}, @expr{z}, and
@expr{t}, respectively.
-@node Keypad Modes Menu, , Keypad Vectors Menu, Keypad Mode
+@node Keypad Modes Menu
@section Modes Menu
@smallexample
@@ -30553,7 +30552,7 @@ The @key{STO} and @key{RCL} keys are analogous to @kbd{s t} and
variables are not available in Keypad mode.) You can also use,
for example, @kbd{STO + 3} to add to register 3.
-@node Embedded Mode, Programming, Keypad Mode, Top
+@node Embedded Mode
@chapter Embedded Mode
@noindent
@@ -30570,7 +30569,7 @@ linked to the stack and this copying is taken care of automatically.
* Customizing Embedded Mode::
@end menu
-@node Basic Embedded Mode, More About Embedded Mode, Embedded Mode, Embedded Mode
+@node Basic Embedded Mode
@section Basic Embedded Mode
@noindent
@@ -30734,7 +30733,7 @@ own Undo command (typed before you turn Embedded mode back off)
will not do you any good, because as far as Calc is concerned
you haven't done anything with this formula yet.
-@node More About Embedded Mode, Assignments in Embedded Mode, Basic Embedded Mode, Embedded Mode
+@node More About Embedded Mode
@section More About Embedded Mode
@noindent
@@ -30918,7 +30917,7 @@ embedded formula at the current point as if by @kbd{`} (@code{calc-edit}).
Embedded mode does not have to be enabled for this to work. Press
@kbd{C-c C-c} to finish the edit, or @kbd{C-x k} to cancel.
-@node Assignments in Embedded Mode, Mode Settings in Embedded Mode, More About Embedded Mode, Embedded Mode
+@node Assignments in Embedded Mode
@section Assignments in Embedded Mode
@noindent
@@ -31144,7 +31143,7 @@ Operator}. When you turn automatic recomputation back on, the
stack will be updated but the Embedded buffer will not; you must
use @kbd{C-x * u} to update the buffer by hand.
-@node Mode Settings in Embedded Mode, Customizing Embedded Mode, Assignments in Embedded Mode, Embedded Mode
+@node Mode Settings in Embedded Mode
@section Mode Settings in Embedded Mode
@kindex m e
@@ -31289,7 +31288,7 @@ annotations at all.
When Embedded mode is not enabled, mode-recording modes except
for @code{Save} have no effect.
-@node Customizing Embedded Mode, , Mode Settings in Embedded Mode, Embedded Mode
+@node Customizing Embedded Mode
@section Customizing Embedded Mode
@noindent
@@ -31441,7 +31440,7 @@ is simply a newline, @code{"\n"}, but may be different for different
major modes. If you change this, it is a good idea still to end with a
newline so that mode annotations will appear on lines by themselves.
-@node Programming, Copying, Embedded Mode, Top
+@node Programming
@chapter Programming
@noindent
@@ -31492,7 +31491,7 @@ described elsewhere; @pxref{User-Defined Compositions}.)
* Lisp Definitions::
@end menu
-@node Creating User Keys, Keyboard Macros, Programming, Programming
+@node Creating User Keys
@section Creating User Keys
@noindent
@@ -31567,7 +31566,7 @@ of a user key. This works for keys that have been defined by either
keyboard macros or formulas; further details are contained in the relevant
following sections.
-@node Keyboard Macros, Invocation Macros, Creating User Keys, Programming
+@node Keyboard Macros
@section Programming with Keyboard Macros
@noindent
@@ -31610,7 +31609,7 @@ analogous to those provided by a traditional programmable calculator.
* Queries in Macros::
@end menu
-@node Naming Keyboard Macros, Conditionals in Macros, Keyboard Macros, Keyboard Macros
+@node Naming Keyboard Macros
@subsection Naming Keyboard Macros
@noindent
@@ -31660,7 +31659,7 @@ of spelled-out keystrokes and defines it as the current keyboard macro.
It is a convenient way to define a keyboard macro that has been stored
in a file, or to define a macro without executing it at the same time.
-@node Conditionals in Macros, Loops in Macros, Naming Keyboard Macros, Keyboard Macros
+@node Conditionals in Macros
@subsection Conditionals in Keyboard Macros
@noindent
@@ -31736,7 +31735,7 @@ If Calc gets stuck while skipping characters during the definition of a
macro, type @kbd{Z C-g} to cancel the definition. (Typing plain @kbd{C-g}
actually adds a @kbd{C-g} keystroke to the macro.)
-@node Loops in Macros, Local Values in Macros, Conditionals in Macros, Keyboard Macros
+@node Loops in Macros
@subsection Loops in Keyboard Macros
@noindent
@@ -31829,7 +31828,7 @@ as easily as in a macro definition.
@xref{Conditionals in Macros}, for some additional notes about
conditional and looping commands.
-@node Local Values in Macros, Queries in Macros, Loops in Macros, Keyboard Macros
+@node Local Values in Macros
@subsection Local Values in Macros
@noindent
@@ -31894,7 +31893,7 @@ The contents of the stack and trail, values of non-quick variables, and
other settings such as the language mode and the various display modes,
are @emph{not} affected by @kbd{Z `} and @kbd{Z '}.
-@node Queries in Macros, , Local Values in Macros, Keyboard Macros
+@node Queries in Macros
@subsection Queries in Keyboard Macros
@c @noindent
@@ -31934,7 +31933,7 @@ keyboard input during a keyboard macro. In particular, you can use
any Calculator operations interactively before pressing @kbd{C-M-c} to
return control to the keyboard macro.
-@node Invocation Macros, Algebraic Definitions, Keyboard Macros, Programming
+@node Invocation Macros
@section Invocation Macros
@kindex C-x * z
@@ -31967,7 +31966,7 @@ The @kbd{m m} command saves the last invocation macro defined by
@kbd{Z I} along with all the other Calc mode settings.
@xref{General Mode Commands}.
-@node Algebraic Definitions, Lisp Definitions, Invocation Macros, Programming
+@node Algebraic Definitions
@section Programming with Formulas
@noindent
@@ -32079,7 +32078,7 @@ default simplifications cures this problem: The definition will be stored
in symbolic form without ever activating the @code{deriv} function. Press
@kbd{m D} to turn the default simplifications back on afterwards.
-@node Lisp Definitions, , Algebraic Definitions, Programming
+@node Lisp Definitions
@section Programming with Lisp
@noindent
@@ -32115,7 +32114,7 @@ for the true Lisp enthusiast.
* Internals::
@end menu
-@node Defining Functions, Defining Simple Commands, Lisp Definitions, Lisp Definitions
+@node Defining Functions
@subsection Defining New Functions
@noindent
@@ -32240,7 +32239,7 @@ as the value of a function. You can use @code{return} anywhere
inside the body of the function.
@end itemize
-Non-integer numbers (and extremely large integers) cannot be included
+Non-integer numbers cannot be included
directly into a @code{defmath} definition. This is because the Lisp
reader will fail to parse them long before @code{defmath} ever gets control.
Instead, use the notation, @samp{:"3.1415"}. In fact, any algebraic
@@ -32336,7 +32335,7 @@ property are @code{defmath} calls, @code{define-key} calls that modify
the Calc key map, and any calls that redefine things defined inside Calc.
Ordinary @code{defun}s need not be enclosed with @code{calc-define}.
-@node Defining Simple Commands, Defining Stack Commands, Defining Functions, Lisp Definitions
+@node Defining Simple Commands
@subsection Defining New Simple Commands
@noindent
@@ -32374,7 +32373,7 @@ This expands to the pair of definitions,
@noindent
where in this case the latter function would never really be used! Note
-that since the Calculator stores small integers as plain Lisp integers,
+that since the Calculator stores integers as plain Lisp integers,
the @code{math-add} function will work just as well as the native
@code{+} even when the intent is to operate on native Lisp integers.
@@ -32498,7 +32497,7 @@ decreases the precision.
(run-hooks 'calc-check-defines)
@end smallexample
-@node Defining Stack Commands, Argument Qualifiers, Defining Simple Commands, Lisp Definitions
+@node Defining Stack Commands
@subsection Defining New Stack-Based Commands
@noindent
@@ -32600,7 +32599,7 @@ number of objects to remove from the stack and pass to the function.
In this case, the integer @var{num} serves as a default number of
arguments to be used when no prefix is supplied.
-@node Argument Qualifiers, Example Definitions, Defining Stack Commands, Lisp Definitions
+@node Argument Qualifiers
@subsection Argument Qualifiers
@noindent
@@ -32643,8 +32642,8 @@ Like @samp{integer}, but the argument must be non-negative.
@item fixnum
@findex fixnum
-Like @samp{integer}, but the argument must fit into a native Lisp integer,
-which on most systems means less than 2^23 in absolute value. The
+Like @samp{integer}, but the argument must fit into a native Lisp fixnum,
+which on most systems means less than 2^61 in absolute value. The
argument is converted into Lisp-integer form if necessary.
@item float
@@ -32687,7 +32686,7 @@ expands to
which performs the necessary checks and conversions before executing the
body of the function.
-@node Example Definitions, Calling Calc from Your Programs, Argument Qualifiers, Lisp Definitions
+@node Example Definitions
@subsection Example Definitions
@noindent
@@ -32700,7 +32699,7 @@ These programs make use of some of the Calculator's internal functions;
* Sine Example::
@end menu
-@node Bit Counting Example, Sine Example, Example Definitions, Example Definitions
+@node Bit Counting Example
@subsubsection Bit-Counting
@noindent
@@ -32740,51 +32739,7 @@ Emacs Lisp function:
count))
@end smallexample
-If the input numbers are large, this function involves a fair amount
-of arithmetic. A binary right shift is essentially a division by two;
-recall that Calc stores integers in decimal form so bit shifts must
-involve actual division.
-
-To gain a bit more efficiency, we could divide the integer into
-@var{n}-bit chunks, each of which can be handled quickly because
-they fit into Lisp integers. It turns out that Calc's arithmetic
-routines are especially fast when dividing by an integer less than
-1000, so we can set @var{n = 9} bits and use repeated division by 512:
-
-@smallexample
-(defmath bcount ((natnum n))
- (interactive 1 "bcnt")
- (let ((count 0))
- (while (not (fixnump n))
- (let ((qr (idivmod n 512)))
- (setq count (+ count (bcount-fixnum (cdr qr)))
- n (car qr))))
- (+ count (bcount-fixnum n))))
-
-(defun bcount-fixnum (n)
- (let ((count 0))
- (while (> n 0)
- (setq count (+ count (logand n 1))
- n (ash n -1)))
- count))
-@end smallexample
-
-@noindent
-Note that the second function uses @code{defun}, not @code{defmath}.
-Because this function deals only with native Lisp integers (``fixnums''),
-it can use the actual Emacs @code{+} and related functions rather
-than the slower but more general Calc equivalents which @code{defmath}
-uses.
-
-The @code{idivmod} function does an integer division, returning both
-the quotient and the remainder at once. Again, note that while it
-might seem that @samp{(logand n 511)} and @samp{(ash n -9)} are
-more efficient ways to split off the bottom nine bits of @code{n},
-actually they are less efficient because each operation is really
-a division by 512 in disguise; @code{idivmod} allows us to do the
-same thing with a single division by 512.
-
-@node Sine Example, , Bit Counting Example, Example Definitions
+@node Sine Example
@subsubsection The Sine Function
@noindent
@@ -32868,7 +32823,7 @@ it carefully as shown in this second example. For quick-and-dirty programs,
when you know that your own use of the sine function will never encounter
a large argument, a simpler program like the first one shown is fine.
-@node Calling Calc from Your Programs, Internals, Example Definitions, Lisp Definitions
+@node Calling Calc from Your Programs
@subsection Calling Calc from Your Lisp Programs
@noindent
@@ -33042,9 +32997,7 @@ in this case it would be easier to call the low-level @code{math-add}
function in Calc, if you can remember its name.
In particular, note that a plain Lisp integer is acceptable to Calc
-as a raw object. (All Lisp integers are accepted on input, but
-integers of more than six decimal digits are converted to ``big-integer''
-form for output. @xref{Data Type Formats}.)
+as a raw object.
When it comes time to display the object, just use @samp{(calc-eval a)}
to format it as a string.
@@ -33264,7 +33217,7 @@ Note the use of @code{insert-before-markers} when changing between
``F'' and ``C'', so that the character winds up before the cursor
instead of after it.
-@node Internals, , Calling Calc from Your Programs, Lisp Definitions
+@node Internals
@subsection Calculator Internals
@noindent
@@ -33304,35 +33257,15 @@ you can't prove this file will already be loaded.
* Hooks::
@end menu
-@node Data Type Formats, Interactive Lisp Functions, Internals, Internals
+@node Data Type Formats
@subsubsection Data Type Formats
@noindent
-Integers are stored in either of two ways, depending on their magnitude.
-Integers less than one million in absolute value are stored as standard
-Lisp integers. This is the only storage format for Calc data objects
-which is not a Lisp list.
-
-Large integers are stored as lists of the form @samp{(bigpos @var{d0}
-@var{d1} @var{d2} @dots{})} for sufficiently large positive integers
-(where ``sufficiently large'' depends on the machine), or
-@samp{(bigneg @var{d0} @var{d1} @var{d2} @dots{})} for negative
-integers. Each @var{d} is a base-@expr{10^n} ``digit'' (where again,
-@expr{n} depends on the machine), a Lisp integer from 0 to
-99@dots{}9. The least significant digit is @var{d0}; the last digit,
-@var{dn}, which is always nonzero, is the most significant digit. For
-example, the integer @mathit{-12345678} might be stored as
-@samp{(bigneg 678 345 12)}.
-
-The distinction between small and large integers is entirely hidden from
-the user. In @code{defmath} definitions, the Lisp predicate @code{integerp}
-returns true for either kind of integer, and in general both big and small
-integers are accepted anywhere the word ``integer'' is used in this manual.
-If the distinction must be made, native Lisp integers are called @dfn{fixnums}
-and large integers are called @dfn{bignums}.
+Integers are stored as standard Lisp integers. This is the only
+storage format for Calc data objects which is not a Lisp list.
Fractions are stored as a list of the form, @samp{(frac @var{n} @var{d})}
-where @var{n} is an integer (big or small) numerator, @var{d} is an
+where @var{n} is an integer numerator, @var{d} is an
integer denominator greater than one, and @var{n} and @var{d} are relatively
prime. Note that fractions where @var{d} is one are automatically converted
to plain integers by all math routines; fractions where @var{d} is negative
@@ -33341,7 +33274,7 @@ are normalized by negating the numerator and denominator.
Floating-point numbers are stored in the form, @samp{(float @var{mant}
@var{exp})}, where @var{mant} (the ``mantissa'') is an integer less than
@samp{10^@var{p}} in absolute value (@var{p} represents the current
-precision), and @var{exp} (the ``exponent'') is a fixnum. The value of
+precision), and @var{exp} (the ``exponent'') is an integer. The value of
the float is @samp{@var{mant} * 10^@var{exp}}. For example, the number
@mathit{-3.14} is stored as @samp{(float -314 -2) = -314*10^-2}. Other constraints
are that the number 0.0 is always stored as @samp{(float 0 0)}, and,
@@ -33444,7 +33377,7 @@ functions which are the outer-level call in an expression whose value is
about to be pushed on the stack; this feature is considered obsolete
and is not used by any built-in Calc functions.)
-@node Interactive Lisp Functions, Stack Lisp Functions, Data Type Formats, Internals
+@node Interactive Lisp Functions
@subsubsection Interactive Functions
@noindent
@@ -33505,7 +33438,7 @@ i.e., if the Inverse (@kbd{I} key) flag was set.
This predicate is the analogous function for the @kbd{H} key.
@end defun
-@node Stack Lisp Functions, Predicates, Interactive Lisp Functions, Internals
+@node Stack Lisp Functions
@subsubsection Stack-Oriented Functions
@noindent
@@ -33692,7 +33625,7 @@ is suppressed, but a flag is set so that the entire stack will be refreshed
rather than just the top few elements when the macro finishes.)
@end defun
-@node Predicates, Computational Lisp Functions, Stack Lisp Functions, Internals
+@node Predicates
@subsubsection Predicates
@noindent
@@ -33736,7 +33669,7 @@ Returns true if @var{x} is an integer of any size.
@end defun
@defun fixnump x
-Returns true if @var{x} is a native Lisp integer.
+Returns true if @var{x} is a native Lisp fixnum.
@end defun
@defun natnump x
@@ -33744,7 +33677,7 @@ Returns true if @var{x} is a nonnegative integer of any size.
@end defun
@defun fixnatnump x
-Returns true if @var{x} is a nonnegative Lisp integer.
+Returns true if @var{x} is a nonnegative Lisp fixnum.
@end defun
@defun num-integerp x
@@ -33899,7 +33832,7 @@ converted to @samp{(math-equal x y)}.
@defun equal-int x n
Returns true if @var{x} and @var{n} are numerically equal, where @var{n}
-is a fixnum which is not a multiple of 10. This will automatically be
+is an integer which is not a multiple of 10. This will automatically be
used by @code{defmath} in place of the more general @code{math-equal}
whenever possible.
@end defun
@@ -33960,7 +33893,7 @@ This signals an error that will be reported as a floating-point overflow.
This signals a floating-point underflow.
@end defun
-@node Computational Lisp Functions, Vector Lisp Functions, Predicates, Internals
+@node Computational Lisp Functions
@subsubsection Computational Functions
@noindent
@@ -33980,12 +33913,8 @@ respectively, instead.
@defun normalize val
(Full form: @code{math-normalize}.)
-Reduce the value @var{val} to standard form. For example, if @var{val}
-is a fixnum, it will be converted to a bignum if it is too large, and
-if @var{val} is a bignum it will be normalized by clipping off trailing
-(i.e., most-significant) zero digits and converting to a fixnum if it is
-small. All the various data types are similarly converted to their standard
-forms. Variables are left alone, but function calls are actually evaluated
+Reduce the value @var{val} to standard form.
+Variables are left alone, but function calls are actually evaluated
in formulas. For example, normalizing @samp{(+ 2 (calcFunc-abs -4))} will
return 6.
@@ -34098,9 +34027,9 @@ integer rather than truncating.
@end defun
@defun fixnum n
-Return the integer @var{n} as a fixnum, i.e., a native Lisp integer.
-If @var{n} is outside the permissible range for Lisp integers (usually
-24 binary bits) the result is undefined.
+Return the integer @var{n} as a fixnum, i.e., a small Lisp integer.
+If @var{n} is outside the permissible range for Lisp fixnums (usually
+62 binary bits) the result is undefined.
@end defun
@defun sqr x
@@ -34304,7 +34233,7 @@ it returns 1 or 3. If @var{n} is anything else, this function
returns @code{nil}.
@end defun
-@node Vector Lisp Functions, Symbolic Lisp Functions, Computational Lisp Functions, Internals
+@node Vector Lisp Functions
@subsubsection Vector Functions
@noindent
@@ -34441,7 +34370,7 @@ is true, with the side effect of exchanging the first two rows of
@var{m}.
@end defun
-@node Symbolic Lisp Functions, Formatting Lisp Functions, Vector Lisp Functions, Internals
+@node Symbolic Lisp Functions
@subsubsection Symbolic Functions
@noindent
@@ -35012,7 +34941,7 @@ Return a copy of @var{expr} with everything but units variables replaced
by ones.
@end defun
-@node Formatting Lisp Functions, Hooks, Symbolic Lisp Functions, Internals
+@node Formatting Lisp Functions
@subsubsection I/O and Formatting Functions
@noindent
@@ -35158,7 +35087,7 @@ If composition @var{c} is a ``flat'' composition, return the last
@comment @noindent
@comment (This section is currently unfinished.)
-@node Hooks, , Formatting Lisp Functions, Internals
+@node Hooks
@subsubsection Hooks
@noindent
@@ -35313,15 +35242,15 @@ used the first time, your hook should add a variable to the
list and also call @code{make-local-variable} itself.
@end defvar
-@node Copying, GNU Free Documentation License, Programming, Top
+@node Copying
@appendix GNU GENERAL PUBLIC LICENSE
@include gpl.texi
-@node GNU Free Documentation License, Customizing Calc, Copying, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Customizing Calc, Reporting Bugs, GNU Free Documentation License, Top
+@node Customizing Calc
@appendix Customizing Calc
The usual prefix for Calc is the key sequence @kbd{C-x *}. If you wish
@@ -35715,7 +35644,7 @@ choose from, or the user can enter their own date.
The default value of @code{calc-gregorian-switch} is @code{nil}.
@end defvar
-@node Reporting Bugs, Summary, Customizing Calc, Top
+@node Reporting Bugs
@appendix Reporting Bugs
@noindent
@@ -35740,7 +35669,7 @@ The latest version of Calc is available from Savannah, in the Emacs
repository. See @uref{https://savannah.gnu.org/projects/emacs}.
@c [summary]
-@node Summary, Key Index, Reporting Bugs, Top
+@node Summary
@appendix Calc Summary
@noindent
@@ -37011,12 +36940,12 @@ grabs the @var{n}th mode value only.
@c [end-summary]
-@node Key Index, Command Index, Summary, Top
+@node Key Index
@unnumbered Index of Key Sequences
@printindex ky
-@node Command Index, Function Index, Key Index, Top
+@node Command Index
@unnumbered Index of Calculator Commands
Since all Calculator commands begin with the prefix @samp{calc-}, the
@@ -37026,7 +36955,7 @@ types @samp{calc-} for you. Thus, @kbd{x last-args} is short for
@printindex pg
-@node Function Index, Concept Index, Command Index, Top
+@node Function Index
@unnumbered Index of Algebraic Functions
This is a list of built-in functions and operators usable in algebraic
@@ -37039,12 +36968,12 @@ Calc keystrokes and can also be found in the Calc Summary.
@printindex tp
-@node Concept Index, Variable Index, Function Index, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
-@node Variable Index, Lisp Function Index, Concept Index, Top
+@node Variable Index
@unnumbered Index of Variables
The variables in this list that do not contain dashes are accessible
@@ -37056,7 +36985,7 @@ in your Calc init file or @file{.emacs} file.
@printindex vr
-@node Lisp Function Index, , Variable Index, Top
+@node Lisp Function Index
@unnumbered Index of Lisp Math Functions
The following functions are meant to be used with @code{defmath}, not
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 24ab4b773c6..98ded68e713 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -219,10 +219,9 @@ or can be downloaded from @url{https://savannah.gnu.org/projects/emacs/}.
@summarycontents
@contents
-@node Top, Introduction, (dir), (dir)
-@comment node-name, next, previous, up
@ifnottex
+@node Top
@top @ccmode{}
@ccmode{} is a GNU Emacs mode for editing files containing C, C++,
@@ -360,8 +359,7 @@ Custom Macros
@end detailmenu
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Introduction, Overview, Top, Top
-@comment node-name, next, previous, up
+@node Introduction
@chapter Introduction
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -420,7 +418,7 @@ also like to thank all the @ccmode{} victims who help enormously
during the early beta stages of @ccmode{}'s development.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Overview, Getting Started, Introduction, Top
+@node Overview
@comment node-name, next, previous, up@cindex organization of the manual
@chapter Overview of the Manual
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -489,8 +487,7 @@ project: whether for updating @ccmode{} or submitting bug reports.
Finally, there are the customary indices.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Getting Started, Commands, Overview, Top
-@comment node-name, next, previous, up
+@node Getting Started
@chapter Getting Started
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -601,8 +598,7 @@ where @samp{XX} is the minor release number.
@end deffn
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Commands, Font Locking, Getting Started, Top
-@comment node-name, next, previous, up
+@node Commands
@chapter Commands
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -638,7 +634,7 @@ structures.
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Indentation Commands, Comment Commands, Commands, Commands
+@node Indentation Commands
@comment node-name, next, previous,up
@section Indentation Commands
@cindex indentation
@@ -817,8 +813,7 @@ often (in seconds) progress messages are to be displayed.
@end defopt
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Comment Commands, Movement Commands, Indentation Commands, Commands
-@comment node-name, next, previous, up
+@node Comment Commands
@section Comment Commands
@cindex comments (insertion of)
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -886,8 +881,7 @@ lines.
@end table
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Movement Commands, Filling and Breaking, Comment Commands, Commands
-@comment node-name, next, previous, up
+@node Movement Commands
@section Movement Commands
@cindex movement
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1042,7 +1036,7 @@ Movement}. They might be removed from a future release of @ccmode{}.
@end table
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Filling and Breaking, Minor Modes, Movement Commands, Commands
+@node Filling and Breaking
@comment node-name, next, previous, up
@section Filling and Line Breaking Commands
@cindex text filling
@@ -1136,8 +1130,7 @@ line break.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Minor Modes, Electric Keys, Filling and Breaking, Commands
-@comment node-name, next, previous, up
+@node Minor Modes
@section Minor Modes
@cindex Minor Modes
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1257,8 +1250,7 @@ value will turn it (or them) off.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Electric Keys, Auto-newlines, Minor Modes, Commands
-@comment node-name, next, previous, up
+@node Electric Keys
@section Electric Keys and Keywords
@cindex electric characters
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1437,8 +1429,7 @@ modes except IDL mode, since CORBA IDL doesn't have any statements.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Auto-newlines, Hungry WS Deletion, Electric Keys, Commands
-@comment node-name, next, previous, up
+@node Auto-newlines
@section Auto-newline Insertion
@cindex auto-newline
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1493,8 +1484,7 @@ clean-ups listed by key.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Hungry WS Deletion, Subword Movement, Auto-newlines, Commands
-@comment node-name, next, previous, up
+@node Hungry WS Deletion
@section Hungry Deletion of Whitespace
@cindex hungry-deletion
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1651,8 +1641,7 @@ trouble with this in GNU Emacs.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Subword Movement, Other Commands, Hungry WS Deletion, Commands
-@comment node-name, next, previous, up
+@node Subword Movement
@section Subword Movement and Editing
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1744,8 +1733,7 @@ As a bonus, you can also use @code{subword-mode} in non-@ccmode{}
buffers by typing @kbd{M-x subword-mode}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Other Commands, , Subword Movement, Commands
-@comment node-name, next, previous, up
+@node Other Commands
@section Other Commands
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1842,8 +1830,7 @@ ask for help in the standard (X)Emacs forums.
@end table
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Font Locking, Config Basics, Commands, Top
-@comment node-name, next, previous, up
+@node Font Locking
@chapter Font Locking
@cindex font locking
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1874,8 +1861,7 @@ sections apply to the other languages.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Font Locking Preliminaries, Faces, Font Locking, Font Locking
-@comment node-name, next, previous, up
+@node Font Locking Preliminaries
@section Font Locking Preliminaries
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1972,8 +1958,7 @@ recognize types.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Faces, Doc Comments, Font Locking Preliminaries, Font Locking
-@comment node-name, next, previous, up
+@node Faces
@section Faces
@cindex faces
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2071,8 +2056,7 @@ since those aren't syntactic errors in themselves.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Doc Comments, Wrong Comment Style, Faces, Font Locking
-@comment node-name, next, previous, up
+@node Doc Comments
@section Documentation Comments
@cindex documentation comments
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2156,7 +2140,7 @@ If you add support for another doc comment style, please consider
contributing it: send a note to @email{bug-cc-mode@@gnu.org}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Wrong Comment Style, Misc Font Locking, Doc Comments, Font Locking
+@node Wrong Comment Style
@comment node-name, next, previous, up
@section Marking ``Wrong'' style comments
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2178,7 +2162,7 @@ which aren't of the default style will be fontified with
@end defvar
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Misc Font Locking, AWK Mode Font Locking, Wrong Comment Style, Font Locking
+@node Misc Font Locking
@comment node-name, next, previous, up
@section Miscellaneous Font Locking
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2233,7 +2217,7 @@ section only applies when CC Mode cannot disambiguate a construct in
any other way.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node AWK Mode Font Locking, , Misc Font Locking, Font Locking
+@node AWK Mode Font Locking
@comment node-name, next, previous, up
@section AWK Mode Font Locking
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2294,7 +2278,7 @@ escaped newline. The @samp{\} is highlighted.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Config Basics, Custom Filling and Breaking, Font Locking, Top
+@node Config Basics
@comment node-name, next, previous, up
@chapter Configuration Basics
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2486,8 +2470,7 @@ have it enabled by default by placing the following in your
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node CC Hooks, Style Variables, Config Basics, Config Basics
-@comment node-name, next, previous, up
+@node CC Hooks
@section Hooks
@cindex mode hooks
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2560,8 +2543,7 @@ file.
@end example
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Style Variables, Styles, CC Hooks, Config Basics
-@comment node-name, next, previous, up
+@node Style Variables
@section Style Variables
@cindex styles
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2648,8 +2630,7 @@ Commas});@*
(@pxref{Custom Macros}).
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Styles, , Style Variables, Config Basics
-@comment node-name, next, previous, up
+@node Styles
@section Styles
@cindex styles
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2683,8 +2664,7 @@ already formatted piece of your code, @ref{Guessing the Style}.
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Built-in Styles, Choosing a Style, Styles, Styles
-@comment node-name, next, previous, up
+@node Built-in Styles
@subsection Built-in Styles
@cindex styles, built-in
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2761,8 +2741,7 @@ afterwards.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Choosing a Style, Adding Styles, Built-in Styles, Styles
-@comment node-name, next, previous, up
+@node Choosing a Style
@subsection Choosing a Style
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2819,8 +2798,7 @@ string.
@end defvar
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Adding Styles, Guessing the Style, Choosing a Style, Styles
-@comment node-name, next, previous, up
+@node Adding Styles
@subsection Adding and Amending Styles
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -2907,8 +2885,7 @@ should not be changed directly; use @code{c-add-style} instead.
@end defvar
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Guessing the Style, File Styles, Adding Styles, Styles
-@comment node-name, next, previous, up
+@node Guessing the Style
@subsection Guessing the Style
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3030,8 +3007,7 @@ these offsets or the parent style name.
@end table
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node File Styles, , Guessing the Style, Styles
-@comment node-name, next, previous, up
+@node File Styles
@subsection File Styles
@cindex styles, file local
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3079,8 +3055,7 @@ mode hooks (@pxref{CC Hooks}). Any individual setting of a variable
will override one made through @code{c-file-style} or
@code{c-file-offsets}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Custom Filling and Breaking, Custom Auto-newlines, Config Basics, Top
-@comment node-name, next, previous, up
+@node Custom Filling and Breaking
@chapter Customizing Filling and Line Breaking
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3298,8 +3273,7 @@ as one comment, and the rest of the paragraph handling code
inconsistent behavior.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Custom Auto-newlines, Clean-ups, Custom Filling and Breaking, Top
-@comment node-name, next, previous, up
+@node Custom Auto-newlines
@chapter Customizing Auto-newlines
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3354,8 +3328,7 @@ circumstances. @xref{Clean-ups}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Hanging Braces, Hanging Colons, Custom Auto-newlines, Custom Auto-newlines
-@comment node-name, next, previous, up
+@node Hanging Braces
@section Hanging Braces
@cindex hanging braces
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3504,8 +3477,7 @@ themselves.
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Custom Braces, , Hanging Braces, Hanging Braces
-@comment node-name, next, previous, up
+@node Custom Braces
@subsection Custom Brace Hanging
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3592,8 +3564,7 @@ In all other cases, it returns the list @samp{(before after)} so
that the brace appears on a line by itself.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Hanging Colons, Hanging Semicolons and Commas, Hanging Braces, Custom Auto-newlines
-@comment node-name, next, previous, up
+@node Hanging Colons
@section Hanging Colons
@cindex hanging colons
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3635,8 +3606,7 @@ them are controlled by a different mechanism, called @dfn{clean-ups} in
@ccmode{}. @xref{Clean-ups}, for details.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Hanging Semicolons and Commas, , Hanging Colons, Custom Auto-newlines
-@comment node-name, next, previous, up
+@node Hanging Semicolons and Commas
@section Hanging Semicolons and Commas
@cindex hanging semicolons
@cindex hanging commas
@@ -3715,8 +3685,7 @@ newlines after semicolons inside one-line inline method definitions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Clean-ups, Indentation Engine Basics, Custom Auto-newlines, Top
-@comment node-name, next, previous, up
+@node Clean-ups
@chapter Clean-ups
@cindex clean-ups
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -3968,8 +3937,7 @@ situation if you just want a literal @samp{/} inserted.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Indentation Engine Basics, Customizing Indentation, Clean-ups, Top
-@comment node-name, next, previous, up
+@node Indentation Engine Basics
@chapter Indentation Engine Basics
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4028,8 +3996,7 @@ of the variables associated with indentation, not even
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Syntactic Analysis, Syntactic Symbols, Indentation Engine Basics, Indentation Engine Basics
-@comment node-name, next, previous, up
+@node Syntactic Analysis
@section Syntactic Analysis
@cindex syntactic analysis
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4187,8 +4154,7 @@ anchor position.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Syntactic Symbols, Indentation Calculation, Syntactic Analysis, Indentation Engine Basics
-@comment node-name, next, previous, up
+@node Syntactic Symbols
@section Syntactic Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4435,8 +4401,7 @@ Java. @ref{Java Symbols}.
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Function Symbols, Class Symbols, Syntactic Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Function Symbols
@subsection Function Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4478,8 +4443,7 @@ isn't much special about them. Note however that line 8 is given
on the previous line.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Class Symbols, Conditional Construct Symbols, Function Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Class Symbols
@subsection Class related Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4625,8 +4589,7 @@ Here, line 1 is analyzed as a @code{topmost-intro}, but lines 2 and 3
are both analyzed as @code{template-args-cont} lines.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Conditional Construct Symbols, Switch Statement Symbols, Class Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Conditional Construct Symbols
@subsection Conditional Construct Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4693,8 +4656,7 @@ the same line as the preceding close brace, that line would still have
@code{block-close} syntax.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Switch Statement Symbols, Brace List Symbols, Conditional Construct Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Switch Statement Symbols
@subsection Switch Statement Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4729,8 +4691,7 @@ is treated slightly differently since it contains a brace that opens a
block; it is given @code{statement-case-open} syntax.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Brace List Symbols, External Scope Symbols, Switch Statement Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Brace List Symbols
@subsection Brace List Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4796,8 +4757,7 @@ giving @code{brace-list-entry} an offset of
@code{brace-list-entry} anchored on the @samp{1} of line 8.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node External Scope Symbols, Paren List Symbols, Brace List Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node External Scope Symbols
@subsection External Scope Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4860,8 +4820,7 @@ that isn't the case for historical reasons.}
@end table
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Paren List Symbols, Literal Symbols, External Scope Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Paren List Symbols
@subsection Parenthesis (Argument) List Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4920,8 +4879,7 @@ parenthesis that opens an argument list, appearing on a separate line,
is assigned the @code{statement-cont} syntax instead.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Literal Symbols, Multiline Macro Symbols, Paren List Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Literal Symbols
@subsection Comment String Label and Macro Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5009,8 +4967,7 @@ Line 17 is assigned @code{stream-op} syntax.
@end itemize
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Multiline Macro Symbols, Objective-C Method Symbols, Literal Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Multiline Macro Symbols
@subsection Multiline Macro Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5050,8 +5007,7 @@ macros.}.
@xref{Custom Macros}, for more info about the treatment of macros.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Objective-C Method Symbols, Java Symbols, Multiline Macro Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Objective-C Method Symbols
@subsection Objective-C Method Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5077,8 +5033,7 @@ assigned @code{objc-method-args-cont} syntax. Lines 5 and 6 are both
assigned @code{objc-method-call-cont} syntax.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Java Symbols, Statement Block Symbols, Objective-C Method Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Java Symbols
@subsection Java Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5115,8 +5070,7 @@ syntax due to it being a continuation of a variable declaration where preceding
the declaration is an annotation.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Statement Block Symbols, K&R Symbols, Java Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node Statement Block Symbols
@subsection Statement Block Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5194,8 +5148,7 @@ example above. The other similar special function, @code{gauge}, is
handled like this too.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node K&R Symbols, , Statement Block Symbols, Syntactic Symbols
-@comment node-name, next, previous, up
+@node K&R Symbols
@subsection K&R Symbols
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5221,8 +5174,7 @@ syntax.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Indentation Calculation, , Syntactic Symbols, Indentation Engine Basics
-@comment node-name, next, previous, up
+@node Indentation Calculation
@section Indentation Calculation
@cindex indentation
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5320,8 +5272,7 @@ minibuffer when you hit @kbd{TAB}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Customizing Indentation, Custom Macros, Indentation Engine Basics, Top
-@comment node-name, next, previous, up
+@node Customizing Indentation
@chapter Customizing Indentation
@cindex customization, indentation
@cindex indentation
@@ -5367,8 +5318,7 @@ indentation.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node c-offsets-alist, Interactive Customization, Customizing Indentation, Customizing Indentation
-@comment node-name, next, previous, up
+@node c-offsets-alist
@section c-offsets-alist
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5536,8 +5486,7 @@ it doesn't work well with some of the alignment functions that return
@code{c-strict-syntax-p} set to @code{nil}.}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Interactive Customization, Line-Up Functions, c-offsets-alist, Customizing Indentation
-@comment node-name, next, previous, up
+@node Interactive Customization
@section Interactive Customization
@cindex customization, interactive
@cindex interactive customization
@@ -5644,8 +5593,7 @@ for that syntactic element.
@c End of MOVE THIS BIT.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Line-Up Functions, Custom Line-Up, Interactive Customization, Customizing Indentation
-@comment node-name, next, previous, up
+@node Line-Up Functions
@section Line-Up Functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5718,8 +5666,7 @@ Works with:
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Brace/Paren Line-Up, List Line-Up, Line-Up Functions, Line-Up Functions
-@comment node-name, next, previous, up
+@node Brace/Paren Line-Up
@subsection Brace and Parenthesis Line-Up Functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -5975,8 +5922,7 @@ and @code{inextern-lang}.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node List Line-Up, Operator Line-Up, Brace/Paren Line-Up, Line-Up Functions
-@comment node-name, next, previous, up
+@node List Line-Up
@subsection List Line-Up Functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -6300,8 +6246,7 @@ the current line with the colon on the previous line.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Operator Line-Up, Comment Line-Up, List Line-Up, Line-Up Functions
-@comment node-name, next, previous, up
+@node Operator Line-Up
@subsection Operator Line-Up Functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -6468,8 +6413,7 @@ lineup functions.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Comment Line-Up, Misc Line-Up, Operator Line-Up, Line-Up Functions
-@comment node-name, next, previous, up
+@node Comment Line-Up
@subsection Comment Line-Up Functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -6578,8 +6522,7 @@ expressions.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Misc Line-Up, , Comment Line-Up, Line-Up Functions
-@comment node-name, next, previous, up
+@node Misc Line-Up
@subsection Miscellaneous Line-Up Functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -6780,8 +6723,7 @@ the_larch, @hereFn{c-lineup-topmost-intro-cont}
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Custom Line-Up, Other Indentation, Line-Up Functions, Customizing Indentation
-@comment node-name, next, previous, up
+@node Custom Line-Up
@section Custom Line-Up Functions
@cindex customization, indentation functions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -6896,8 +6838,7 @@ any syntactic symbol that appears in @code{c-offsets-alist} can have a
custom line-up function associated with it.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Other Indentation, , Custom Line-Up, Customizing Indentation
-@comment node-name, next, previous, up
+@node Other Indentation
@section Other Special Indentations
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -6948,8 +6889,7 @@ functions to this hook, not remove them. @xref{Style Variables}.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Custom Macros, Odds and Ends, Customizing Indentation, Top
-@comment node-name, next, previous, up
+@node Custom Macros
@chapter Customizing Macros
@cindex macros
@cindex preprocessor directives
@@ -6997,7 +6937,7 @@ Macros}.
@end menu
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Macro Backslashes, Macros with ;, Custom Macros, Custom Macros
+@node Macro Backslashes
@comment node-name, next, previous, up
@section Customizing Macro Backslashes
@cindex @code{#define}
@@ -7045,7 +6985,7 @@ get aligned only when you explicitly invoke the command
@end defopt
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Macros with ;, Noise Macros, Macro Backslashes, Custom Macros
+@node Macros with ;
@comment node-name, next, previous, up
@section Macros with semicolons
@cindex macros with semicolons
@@ -7103,8 +7043,7 @@ initialization code, after the mode hooks have run.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Noise Macros, Indenting Directives, Macros with ;, Custom Macros
-@comment node-name, next, previous, up
+@node Noise Macros
@section Noise Macros
@cindex noise macros
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7160,8 +7099,7 @@ after the mode hooks have run.
@end defun
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Indenting Directives, , Noise Macros, Custom Macros
-@comment node-name, next, previous, up
+@node Indenting Directives
@section Indenting Directives
@cindex Indenting Directives
@cindex Indenting #pragma
@@ -7202,8 +7140,7 @@ depends on that variable.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Odds and Ends, Sample Init File, Custom Macros, Top
-@comment node-name, next, previous, up
+@node Odds and Ends
@chapter Odds and Ends
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7246,8 +7183,7 @@ anchoring position to indent the line in that case.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Sample Init File, Performance Issues, Odds and Ends, Top
-@comment node-name, next, previous, up
+@node Sample Init File
@appendix Sample Init File
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7305,8 +7241,7 @@ to change some of the actual values.
@end verbatim
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Performance Issues, Limitations and Known Bugs, Sample Init File, Top
-@comment node-name, next, previous, up
+@node Performance Issues
@appendix Performance Issues
@cindex performance
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7414,8 +7349,7 @@ more info.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Limitations and Known Bugs, FAQ, Performance Issues, Top
-@comment node-name, next, previous, up
+@node Limitations and Known Bugs
@appendix Limitations and Known Bugs
@cindex limitations
@cindex bugs
@@ -7480,8 +7414,7 @@ early on:
@end itemize
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node FAQ, Updating CC Mode, Limitations and Known Bugs, Top
-@comment node-name, next, previous, up
+@node FAQ
@appendix Frequently Asked Questions
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7609,8 +7542,7 @@ there since it's got its own system to keep track of blocks.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Updating CC Mode, Mailing Lists and Bug Reports, FAQ, Top
-@comment node-name, next, previous, up
+@node Updating CC Mode
@appendix Getting the Latest CC Mode Release
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7629,8 +7561,7 @@ compatibility, etc.@: are all available on the web site:
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Mailing Lists and Bug Reports, GNU Free Documentation License, Updating CC Mode, Top
-@comment node-name, next, previous, up
+@node Mailing Lists and Bug Reports
@appendix Mailing Lists and Submitting Bug Reports
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7673,15 +7604,14 @@ to the Usenet newsgroups @code{gnu.emacs.sources}, @code{comp.emacs},
@c There is no newsgroup for Pike. :-(
-@node GNU Free Documentation License, Command and Function Index, Mailing Lists and Bug Reports, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
@c Removed the tentative node "Mode Initialization" from here, 2005/8/27.
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Command and Function Index, Variable Index, GNU Free Documentation License, Top
-@comment node-name, next, previous, up
+@node Command and Function Index
@unnumbered Command and Function Index
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7695,8 +7625,7 @@ Since most @ccmode{} commands are prepended with the string
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Variable Index, Concept and Key Index, Command and Function Index, Top
-@comment node-name, next, previous, up
+@node Variable Index
@unnumbered Variable Index
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -7710,8 +7639,7 @@ Since most @ccmode{} variables are prepended with the string
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-@node Concept and Key Index, , Variable Index, Top
-@comment node-name, next, previous, up
+@node Concept and Key Index
@unnumbered Concept and Key Index
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 7464ba2eb1d..c89e0e75f85 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -2084,14 +2084,15 @@ This clause also accepts optional @samp{from @var{pos}} and
@samp{to @var{pos}} terms, limiting the clause to overlays which
overlap the specified region.
-@item for @var{var} being the intervals [of @var{buffer}] @dots{}
-This clause iterates over all intervals of a buffer with constant
-text properties. The variable @var{var} will be bound to conses
-of start and end positions, where one start position is always equal
-to the previous end position. The clause allows @code{of},
+@item for @var{var} being the intervals [of @var{object}] @dots{}
+This clause iterates over all intervals of a buffer or string with
+constant text properties. The variable @var{var} will be bound to
+conses of start and end positions, where one start position is always
+equal to the previous end position. The clause allows @code{of},
@code{from}, @code{to}, and @code{property} terms, where the latter
term restricts the search to just the specified property. The
-@code{of} term may specify either a buffer or a string.
+@code{of} term may specify either a buffer or a string. @xref{Text
+Properties,,,elisp}.
@item for @var{var} being the frames
This clause iterates over all Emacs frames. The clause @code{screens} is
@@ -2238,7 +2239,7 @@ were non-@code{nil}, the loop returns @code{t}:
@item never @var{condition}
This clause is like @code{always}, except that the loop returns
-@code{t} if any conditions were false, or @code{nil} otherwise.
+@code{t} if all conditions were false, or @code{nil} otherwise.
@item thereis @var{condition}
This clause stops the loop when the specified form is non-@code{nil};
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index a53f879c961..a0f316f8480 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -67,7 +67,7 @@ modify this GNU manual.''
@contents
-@node Top, EDE Project Concepts, (dir), (dir)
+@node Top
@top EDE
@comment node-name, next, previous, up
@@ -95,7 +95,7 @@ learn and adopt GNU ways of doing things.
* GNU Free Documentation License:: The license for this documentation.
@end menu
-@node EDE Project Concepts, EDE Mode, Top, Top
+@node EDE Project Concepts
@chapter @ede{} Project Concepts
@ede{} is a generic interface for managing projects. It specifies a
@@ -130,7 +130,7 @@ of search to files in a single target, or to discover the location of
documentation or interface files. @ede{} can provide this
information.
-@node EDE Mode, Quick Start, EDE Project Concepts, Top
+@node EDE Mode
@chapter @ede{} Mode
@ede{} is implemented as a minor mode, which augments other modes such
@@ -147,7 +147,7 @@ bar. This menu provides several menu items for high-level @ede{}
commands. These menu items, and their corresponding keybindings, are
independent of the type of project you are actually working on.
-@node Quick Start, Creating a project, EDE Mode, Top
+@node Quick Start
@chapter Quick Start
Once you have @ede{} enabled, you can create a project. This chapter
@@ -443,7 +443,7 @@ C-c . R @key{RET} @key{RET}
If your program takes command line arguments, you can type them in
when it offers the command line you want to use to run your program.
-@node Creating a project, Modifying your project, Quick Start, Top
+@node Creating a project
@chapter Creating a project
To create a new project, first visit a file that you want to include
@@ -488,7 +488,7 @@ the top-most project's makefile as a starting place for the build. How
the toplevel project handles subprojects in the build process is
dependent on that project's type.
-@node Modifying your project, Building and Debugging, Creating a project, Top
+@node Modifying your project
@chapter Modifying your project
In this chapter, we describe the generic features for manipulating
@@ -504,7 +504,7 @@ detailed information about exactly what these features do.
* EDE Project Features::
@end menu
-@node Add/Remove target, Add/Remove files, Modifying your project, Modifying your project
+@node Add/Remove target
@section Add/Remove target
To create a new target, type @kbd{C-c . t} (@code{ede-new-target}) or
@@ -520,7 +520,7 @@ To remove a target from the project, type @kbd{M-x ede-delete-target},
or use the @samp{Remove Target} menu item in the @samp{Project
Options} submenu.
-@node Add/Remove files, Customize Features, Add/Remove target, Modifying your project
+@node Add/Remove files
@section Add/Remove files
To add the current file to an existing target, type @kbd{C-c . a}
@@ -541,7 +541,7 @@ not wish to add the file to any target, you can choose @samp{none}.
You can customize this behavior with the variable
@command{ede-auto-add-method}.
-@node Customize Features, Project Local Variables, Add/Remove files, Modifying your project
+@node Customize Features
@section Customize Features
A project, and its targets, are objects using the @samp{EIEIO} object
@@ -561,7 +561,7 @@ object, you can edit the file by typing @kbd{C-c . e}
(@code{ede-edit-file-target}). You should ``rescan'' the project
afterwards (@pxref{Miscellaneous commands}).
-@node Project Local Variables, EDE Project Features, Customize Features, Modifying your project
+@node Project Local Variables
@section Project Local Variables
EDE projects can store and manager project local variables. The
@@ -598,7 +598,7 @@ the format is an association list. For example:
(compile-command . "make -f MyCustomMakefile all")))
@end example
-@node EDE Project Features, , Project Local Variables, Modifying your project
+@node EDE Project Features
@section EDE Project Features
This section details user facing features of an @ede{} @samp{Make}
@@ -618,7 +618,7 @@ additional details.
* Configurations::
@end menu
-@node Changing Compilers and Flags, Configurations, EDE Project Features, EDE Project Features
+@node Changing Compilers and Flags
@subsection Changing Compilers and Flags
Targets that build stuff need compilers. To change compilers, you
@@ -638,7 +638,7 @@ see what commands are inserted. Once you have determined the variable
you need to modify, you can add a configuration for it.
@xref{Configurations}.
-@node Configurations, , Changing Compilers and Flags, EDE Project Features
+@node Configurations
@subsection Configurations
Configurations specify different ways to build a project. For
@@ -658,7 +658,7 @@ block for ``configurations''. Add a new named configuration here.
To switch between different active configurations, modify the
``configuration default'' slot.
-@node Building and Debugging, Miscellaneous commands, Modifying your project, Top
+@node Building and Debugging
@chapter Building and Debugging
@ede{} provides the following ``project-aware'' compilation and
@@ -677,7 +677,7 @@ Build a distribution file for your project.
These commands are also available from the @samp{Development} menu.
-@node Miscellaneous commands, Extending EDE, Building and Debugging, Top
+@node Miscellaneous commands
@chapter Miscellaneous commands
If you opt to go in and edit @ede{} project files directly---for
@@ -716,7 +716,7 @@ To activate the speedbar in this mode, type @kbd{C-c . s}
* Simple projects:: Projects @ede{} doesn't manage.
@end menu
-@node Make and Automake projects, Automake direct projects, Miscellaneous commands, Miscellaneous commands
+@node Make and Automake projects
@section Make and Automake projects
A project of @samp{ede-project} type creates a file called
@@ -728,7 +728,7 @@ in @samp{Makefile} mode, then this project will autogenerate a
routines will also import and maintain a configure.am script and a
host of other files required by Automake.
-@node Automake direct projects, Simple projects, Make and Automake projects, Miscellaneous commands
+@node Automake direct projects
@section Automake direct projects
The project type that reads @file{Makefile.am} directly is derived
@@ -738,7 +738,7 @@ distributed independently. This mode eventually became @ede{}. The
not generate them automatically, or create new ones. As such, it is
useful as a browsing tool, or as maintenance in managing file lists.
-@node Simple projects, , Automake direct projects, Miscellaneous commands
+@node Simple projects
@section Simple Projects
There is a wide array of simple projects. In this case a simple
@@ -756,7 +756,7 @@ belonging to a project, but doesn't provide many features of a typical
* Custom Locate:: Customizing how to locate files in a simple project
@end menu
-@node ede-cpp-root, ede-emacs, Simple projects, Simple projects
+@node ede-cpp-root
@subsection ede-cpp-root
The @code{ede-cpp-root} project type allows you to create a single
@@ -897,7 +897,7 @@ of project.
@xref{ede-cpp-root-project}, for details about the class that defines
the @code{ede-cpp-root} project type.
-@node ede-emacs, ede-linux, ede-cpp-root, Simple projects
+@node ede-emacs
@subsection ede-emacs
The @code{ede-emacs} project automatically identifies an Emacs source
@@ -906,7 +906,7 @@ tree, and enables EDE project mode for it.
It pre-populates the C Preprocessor symbol map for correct parsing,
and has an optimized include file identification function.
-@node ede-linux, ede-generic-project, ede-emacs, Simple projects
+@node ede-linux
@subsection ede-linux
The @code{ede-linux} project will automatically identify a Linux
@@ -921,7 +921,7 @@ directory and its architecture, respectively. The default is to assume that
the build happens in the source directory and to auto-detect the
architecture; if the auto-detection fails, you will be asked.
-@node ede-generic-project, Custom Locate, ede-linux, Simple projects
+@node ede-generic-project
@subsection ede-generic-project
The @code{ede-generic-project} is a project system that makes it easy
@@ -972,7 +972,7 @@ This example project will detect any directory with the file
Customization of the project will allow you to make build and debug
commands more precise.
-@node Custom Locate, , ede-generic-project, Simple projects
+@node Custom Locate
@subsection Custom Locate
The various simple project styles all have one major drawback, which
@@ -1014,7 +1014,7 @@ simple example.
More on idutils and cscope is in the CEDET manual, and they each have
their own section.
-@node Extending EDE, GNU Free Documentation License, Miscellaneous commands, Top
+@node Extending EDE
@chapter Extending @ede{}
This chapter is intended for users who want to write new parts or fix
@@ -1069,7 +1069,7 @@ examples.
* Compilers:: Details of compiler classes.
@end menu
-@node Development Overview, Detecting a Project, Extending EDE, Extending EDE
+@node Development Overview
@section Development Overview
@ede{} is made up of a series of classes implemented with @eieio{}.
@@ -1161,7 +1161,7 @@ Here is a high-level UML diagram for the @ede{} system created with @cogre{}..
@end example
-@node Detecting a Project, User interface methods, Development Overview, Extending EDE
+@node Detecting a Project
@section Detecting a Project
Project detection happens with the list of @code{ede-project-autoload}
@@ -1226,7 +1226,7 @@ to the global list of all projects. All subprojects are then created
and assembled into the project data structures.
-@node User interface methods, Base project methods, Detecting a Project, Extending EDE
+@node User interface methods
@section User interface methods
These methods are core behaviors associated with user commands.
@@ -1258,7 +1258,7 @@ Make a distribution (tar archive) of the project.
Rescan a project file, changing the data in the existing objects.
@end table
-@node Base project methods, Sourcecode objects, User interface methods, Extending EDE
+@node Base project methods
@section Base project methods
These methods are important for querying base information from project
@@ -1296,7 +1296,7 @@ stored in.
List all documentation a project or target is responsible for.
@end table
-@node Sourcecode objects, Compiler and Linker objects, Base project methods, Extending EDE
+@node Sourcecode objects
@section Sourcecode objects
@ede{} projects track source file / target associates via source code
@@ -1342,7 +1342,7 @@ In this case, the garbage pattern is the same.
@xref{Sourcecode}.
-@node Compiler and Linker objects, Project, Sourcecode objects, Extending EDE
+@node Compiler and Linker objects
@section Compiler and Linker objects
In order for a target to create a @file{Makefile}, it must know how to
@@ -1403,7 +1403,7 @@ See @file{ede-proj-obj.el} for examples of the combination.
@defindex sc
@defindex cm
-@node Project, Targets, Compiler and Linker objects, Extending EDE
+@node Project
@section Project
@menu
@@ -1417,7 +1417,7 @@ See @file{ede-proj-obj.el} for examples of the combination.
* ede-step-project::
@end menu
-@node ede-project-placeholder, ede-project, Project, Project
+@node ede-project-placeholder
@subsection ede-project-placeholder
@pjindex ede-project-placeholder
@@ -1503,7 +1503,7 @@ Make sure placeholder @var{THIS} is replaced with the real thing, and pass throu
Make sure placeholder @var{THIS} is replaced with the real thing, and pass through.
@end deffn
-@node ede-project, ede-cpp-root-project, ede-project-placeholder, Project
+@node ede-project
@subsection ede-project
@pjindex ede-project
@@ -1789,7 +1789,7 @@ Retrieves the slot @code{menu} from an object of class @code{ede-project}
Commit change to local variables in @var{PROJ}.
@end deffn
-@node ede-cpp-root-project, ede-simple-project, ede-project, Project
+@node ede-cpp-root-project
@subsection ede-cpp-root-project
@pjindex ede-cpp-root-project
@@ -1911,7 +1911,7 @@ Within this project @var{PROJ}, find the file @var{NAME}.
This knows details about or source tree.
@end deffn
-@node ede-simple-project, ede-simple-base-project, ede-cpp-root-project, Project
+@node ede-simple-project
@subsection ede-simple-project
@pjindex ede-simple-project
@@ -1941,7 +1941,7 @@ No children
Commit any change to @var{PROJ} to its file.
@end deffn
-@node ede-simple-base-project, ede-proj-project, ede-simple-project, Project
+@node ede-simple-base-project
@subsection ede-simple-base-project
@pjindex ede-simple-base-project
@@ -1971,7 +1971,7 @@ This one project could control a tree of subdirectories.
@table @asis
@end table
-@node ede-proj-project, project-am-makefile, ede-simple-base-project, Project
+@node ede-proj-project
@subsection ede-proj-project
@pjindex ede-proj-project
@@ -2161,7 +2161,7 @@ Return a list of files that constitutes a distribution of @var{THIS} project.
Commit change to local variables in @var{PROJ}.
@end deffn
-@node project-am-makefile, ede-step-project, ede-proj-project, Project
+@node project-am-makefile
@subsection project-am-makefile
@pjindex project-am-makefile
@@ -2203,7 +2203,7 @@ Despite the fact that this is a method, it depends on the current
buffer being in order to provide a smart default target type.
@end deffn
-@node ede-step-project, , project-am-makefile, Project
+@node ede-step-project
@subsection ede-step-project
@pjindex ede-step-project
@@ -2328,7 +2328,7 @@ Return a list of files that constitutes a distribution of @var{THIS} project.
Commit change to local variables in @var{PROJ}.
@end deffn
-@node Targets, Sourcecode, Project, Extending EDE
+@node Targets
@section Targets
@menu
@@ -2356,7 +2356,7 @@ Commit change to local variables in @var{PROJ}.
@end menu
-@node ede-target, ede-proj-target, Targets, Targets
+@node ede-target
@subsection ede-target
@tgindex ede-target
@@ -2565,7 +2565,7 @@ Return the name of @var{THIS} target, suitable for make or debug style commands.
Retrieves the slot @code{menu} from an object of class @code{ede-target}
@end deffn
-@node ede-proj-target, ede-proj-target-makefile, ede-target, Targets
+@node ede-proj-target
@subsection ede-proj-target
@tgindex ede-proj-target
@@ -2754,7 +2754,7 @@ sources variable.
@end deffn
-@node ede-proj-target-makefile, semantic-ede-proj-target-grammar, ede-proj-target, Targets
+@node ede-proj-target-makefile
@subsection ede-proj-target-makefile
@tgindex ede-proj-target-makefile
@@ -2852,7 +2852,7 @@ Return a list of configuration variables from @var{THIS}.
Use @var{CONFIGURATION} as the current configuration to query.
@end deffn
-@node semantic-ede-proj-target-grammar, ede-proj-target-makefile-objectcode, ede-proj-target-makefile, Targets
+@node semantic-ede-proj-target-grammar
@subsection semantic-ede-proj-target-grammar
@tgindex semantic-ede-proj-target-grammar
@@ -2906,7 +2906,7 @@ Argument @var{THIS} is the target that should insert stuff.
@end deffn
-@node ede-proj-target-makefile-objectcode, ede-proj-target-makefile-archive, semantic-ede-proj-target-grammar, Targets
+@node ede-proj-target-makefile-objectcode
@subsection ede-proj-target-makefile-objectcode
@tgindex ede-proj-target-makefile-objectcode
@@ -2968,7 +2968,7 @@ Argument @var{THIS} is the target to get sources from.
@end deffn
-@node ede-proj-target-makefile-archive, ede-proj-target-makefile-program, ede-proj-target-makefile-objectcode, Targets
+@node ede-proj-target-makefile-archive
@subsection ede-proj-target-makefile-archive
@tgindex ede-proj-target-makefile-archive
@@ -3011,7 +3011,7 @@ Makefile.am generator, so use it to add this important bin program.
@end deffn
-@node ede-proj-target-makefile-program, ede-proj-target-makefile-shared-object, ede-proj-target-makefile-archive, Targets
+@node ede-proj-target-makefile-program
@subsection ede-proj-target-makefile-program
@tgindex ede-proj-target-makefile-program
@@ -3090,7 +3090,7 @@ Insert bin_PROGRAMS variables needed by target @var{THIS}.
@end deffn
-@node ede-proj-target-makefile-shared-object, ede-proj-target-elisp, ede-proj-target-makefile-program, Targets
+@node ede-proj-target-makefile-shared-object
@subsection ede-proj-target-makefile-shared-object
@tgindex ede-proj-target-makefile-shared-object
@@ -3150,7 +3150,7 @@ Makefile.am generator, so use it to add this important bin program.
@end deffn
-@node ede-proj-target-elisp, ede-proj-target-elisp-autoloads, ede-proj-target-makefile-shared-object, Targets
+@node ede-proj-target-elisp
@subsection ede-proj-target-elisp
@tgindex ede-proj-target-elisp
@@ -3226,7 +3226,7 @@ There are standards in Elisp files specifying how the version string
is found, such as a @code{-version} variable, or the standard header.
@end deffn
-@node ede-proj-target-elisp-autoloads, ede-proj-target-makefile-miscelaneous, ede-proj-target-elisp, Targets
+@node ede-proj-target-elisp-autoloads
@subsection ede-proj-target-elisp-autoloads
@tgindex ede-proj-target-elisp-autoloads
@@ -3341,7 +3341,7 @@ sources variable.
@end deffn
-@node ede-proj-target-makefile-miscelaneous, ede-proj-target-makefile-info, ede-proj-target-elisp-autoloads, Targets
+@node ede-proj-target-makefile-miscelaneous
@subsection ede-proj-target-makefile-miscelaneous
@tgindex ede-proj-target-makefile-miscelaneous
@@ -3397,7 +3397,7 @@ Return a list of files which @var{THIS} target depends on.
@end deffn
-@node ede-proj-target-makefile-info, ede-proj-target-scheme, ede-proj-target-makefile-miscelaneous, Targets
+@node ede-proj-target-makefile-info
@subsection ede-proj-target-makefile-info
@tgindex ede-proj-target-makefile-info
@@ -3483,7 +3483,7 @@ Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode.
@end deffn
-@node ede-proj-target-scheme, project-am-target, ede-proj-target-makefile-info, Targets
+@node ede-proj-target-scheme
@subsection ede-proj-target-scheme
@tgindex ede-proj-target-scheme
@@ -3527,7 +3527,7 @@ Tweak the configure file (current buffer) to accommodate @var{THIS}.
@end deffn
-@node project-am-target, project-am-objectcode, ede-proj-target-scheme, Targets
+@node project-am-target
@subsection project-am-target
@tgindex project-am-target
@@ -3565,7 +3565,7 @@ Run the current project in the debugger.
Edit the target associated w/ this file.
@end deffn
-@node project-am-objectcode, project-am-program, project-am-target, Targets
+@node project-am-objectcode
@subsection project-am-objectcode
@tgindex project-am-objectcode
@@ -3610,7 +3610,7 @@ Default target to use when compiling an object code target.
There are no default header files.
@end deffn
-@node project-am-program, project-am-header-noinst, project-am-objectcode, Targets
+@node project-am-program
@subsection project-am-program
@tgindex project-am-program
@@ -3648,7 +3648,7 @@ Additional LD args.
@end table
@end table
-@node project-am-header-noinst, project-am-header-inst, project-am-program, Targets
+@node project-am-header-noinst
@subsection project-am-header-noinst
@tgindex project-am-header-noinst
@@ -3681,7 +3681,7 @@ No children
Return the default macro to 'edit' for this object.
@end deffn
-@node project-am-header-inst, project-am-lisp, project-am-header-noinst, Targets
+@node project-am-header-inst
@subsection project-am-header-inst
@tgindex project-am-header-inst
@@ -3714,7 +3714,7 @@ No children
Return the default macro to 'edit' for this object.
@end deffn
-@node project-am-lisp, project-am-texinfo, project-am-header-inst, Targets
+@node project-am-lisp
@subsection project-am-lisp
@tgindex project-am-lisp
@@ -3744,7 +3744,7 @@ No children
Return the default macro to 'edit' for this object.
@end deffn
-@node project-am-texinfo, project-am-man, project-am-lisp, Targets
+@node project-am-texinfo
@subsection project-am-texinfo
@tgindex project-am-texinfo
@@ -3795,7 +3795,7 @@ Documentation is not for object @var{THIS}, but is provided by @var{THIS} for ot
files in the project.
@end deffn
-@node project-am-man, , project-am-texinfo, Targets
+@node project-am-man
@comment node-name, next, previous, up
@subsection project-am-man
@tgindex project-am-man
@@ -3826,7 +3826,7 @@ No children
Return the default macro to 'edit' for this object type.
@end deffn
-@node Sourcecode, Compilers, Targets, Extending EDE
+@node Sourcecode
@section Sourcecode
The source code type is an object designed to associated files with
@@ -3837,7 +3837,7 @@ targets.
@end menu
-@node ede-sourcecode, , Sourcecode, Sourcecode
+@node ede-sourcecode
@subsection ede-sourcecode
@scindex ede-sourcecode
@@ -3934,7 +3934,7 @@ Return non-@code{nil} if @var{THIS} will take @var{FILENAME} as an auxiliary .
Return non-@code{nil} if @var{THIS} will take @var{FILENAME} as an auxiliary .
@end deffn
-@node Compilers, , Sourcecode, Extending EDE
+@node Compilers
@section Compilers
The compiler object is designed to associate source code with
@@ -3950,7 +3950,7 @@ compile commands.
@end menu
-@node ede-compilation-program, ede-compiler, Compilers, Compilers
+@node ede-compilation-program
@subsection ede-compilation-program
@cmindex ede-compilation-program
@@ -4061,7 +4061,7 @@ Tweak the configure file (current buffer) to accommodate @var{THIS}.
@end deffn
-@node ede-compiler, ede-object-compiler, ede-compilation-program, Compilers
+@node ede-compiler
@subsection ede-compiler
@cmindex ede-compiler
@@ -4169,7 +4169,7 @@ Return a string based on @var{THIS} representing a make object variable.
@end deffn
-@node ede-object-compiler, ede-linker, ede-compiler, Compilers
+@node ede-object-compiler
@subsection ede-object-compiler
@cmindex ede-object-compiler
@@ -4212,7 +4212,7 @@ A variable dedicated to dependency generation.
Insert variables needed by the compiler @var{THIS}.
@end deffn
-@node ede-linker, , ede-object-compiler, Compilers
+@node ede-linker
@subsection ede-linker
@cmindex ede-linker
@@ -4274,7 +4274,7 @@ For example, C code uses .o on unix, and Emacs Lisp uses .elc.
@end table
@end table
-@node GNU Free Documentation License, , Extending EDE, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index 2abde2c2843..6eff88b76e3 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -370,11 +370,10 @@ On Windows, the @file{.emacs} file may be called @file{_emacs} for
backward compatibility with DOS and FAT filesystems where filenames
could not start with a dot. Some users prefer to continue using such
a name due to historical problems various Windows tools had in the
-past with file names that begin with a dot. In Emacs 22 and later,
-the init file may also be called @file{.emacs.d/init.el}. Many of the
-other files that are created by lisp packages are now stored in the
-@file{.emacs.d} directory too, so this keeps all your Emacs related
-files in one place.
+past with file names that begin with a dot. The init file may also be
+called @file{.emacs.d/init.el}. Many of the other files that are
+created by Lisp packages are stored in the @file{.emacs.d} directory
+too, which keeps all your Emacs related files in one place.
All the files mentioned above should go in your @env{HOME} directory.
The @env{HOME} directory is determined by following the steps below:
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index f26ae637788..d66c12f9fc3 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -323,8 +323,8 @@ Free Software Foundation, and related organizations.
@menu
* Real meaning of copyleft::
-* Guidelines for newsgroup postings::
-* Newsgroup archives::
+* Guidelines for mailing list postings::
+* Mailing list archives::
* Reporting bugs::
* Unsubscribing from Emacs lists::
* Contacting the FSF::
@@ -343,9 +343,10 @@ There has never been a copyright infringement case involving the GPL to
set any precedents. Although legal actions have been brought against
companies for violating the terms of the GPL, so far all have been
settled out of court (in favor of the plaintiffs). Please take any
-discussion regarding this issue to the newsgroup
-@uref{news:gnu.misc.discuss}, which was created to hold the extensive
-flame wars on the subject.
+discussion regarding this issue to
+@uref{https://lists.gnu.org/mailman/listinfo/gnu-misc-discuss, the
+gnu-misc-discuss mailing list}, which was created to hold the
+extensive flame wars on the subject.
RMS writes:
@@ -359,49 +360,60 @@ distribute any version of Emacs or a related program, and give the
recipients the same freedom that you enjoyed.
@end quotation
-@node Guidelines for newsgroup postings
-@section What are appropriate messages for the various Emacs newsgroups?
+@node Guidelines for mailing list postings
+@section What are appropriate messages for the various Emacs mailing lists?
@cindex Newsgroups, appropriate messages for
@cindex GNU newsgroups, appropriate messages for
+@cindex GNU mailing lists, appropriate messages for
@cindex Usenet groups, appropriate messages for
@cindex Mailing lists, appropriate messages for
-@cindex Posting messages to newsgroups
+@cindex Posting messages to mailing lists
@cindex GNU mailing lists
The Emacs mailing lists are described at
@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
-in general. The newsgroup @uref{news:gnu.emacs.help} is specifically
-for GNU Emacs. It therefore makes no sense to cross-post to both
-groups, since only one can be appropriate to any question.
-
-Messages advocating ``non-free'' software are considered unacceptable on
-any of the @code{gnu.*} newsgroups except for @uref{news:gnu.misc.discuss},
-which was created to hold the extensive flame-wars on the subject.
-``Non-free'' software includes any software for which the end user can't
-freely modify the source code and exchange enhancements. Be careful to
-remove the @code{gnu.*} groups from the @samp{Newsgroups:} line when
-posting a followup that recommends such software.
-
-@uref{news:gnu.emacs.bug} is a place where bug reports appear, but avoid
-posting bug reports to this newsgroup directly (@pxref{Reporting bugs}).
-
-@node Newsgroup archives
-@section Where can I get old postings to @uref{news:gnu.emacs.help} and other GNU groups?
-@cindex Archived postings from @code{gnu.emacs.help}
-@cindex Usenet archives for GNU groups
-@cindex Old Usenet postings for GNU groups
+page}.
+
+Messages advocating ``non-free'' software are considered unacceptable
+on any of the GNU mailing lists, except for
+@url{https://lists.gnu.org/mailman/listinfo/gnu-misc-discuss, the
+gnu-misc-discuss mailing list} which was created to hold the extensive
+flame-wars on the subject.
+
+``Non-free'' software includes any software for which the end user
+can't freely modify the source code and exchange enhancements. Be
+careful to remove any GNU mailing lists from @samp{Cc:} when posting a
+reply that recommends such software.
+
+@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
+bug-gnu-emacs list} is a place where bug reports appear, but we
+recommend using the commands @kbd{M-x report-emacs-bug} or @kbd{M-x
+submit-emacs-patch} if at all possible (@pxref{Reporting bugs}).
+
+Some GNU mailing lists are gatewayed to (Usenet) newsgroups.
+For example, sending an email to
+@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
+bug-gnu-emacs list} has the effect of posting on the newsgroup
+@uref{news:gnu.emacs.help}).
+
+Finally, we recommend reading the
+@url{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind
+Communications Guidelines} before posting to any GNU lists or
+newsgroups.
+
+@node Mailing list archives
+@section Where can I read archives for @code{help-gnu-emacs} and other GNU lists?
+@cindex Archived postings from @code{help-gnu-emacs}
+@cindex Old mailing list posts for GNU lists
+@cindex Mailing list archives for GNU lists
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{https://lists.gnu.org/r/, the GNU mail archive}.
-Web-based Usenet search services, such as
-@uref{https://groups.google.com/groups/dir?q=gnu&, Google}, also
-archive the @code{gnu.*} groups.
+Some web-based Usenet search services also archive the @code{gnu.*}
+newsgroups.
@node Reporting bugs
@section Where should I report bugs and other problems with Emacs?
@@ -414,39 +426,25 @@ The correct way to report Emacs bugs is to use the command
@kbd{M-x report-emacs-bug}. It sets up a mail buffer with the
essential information and the correct e-mail address,
@email{bug-gnu-emacs@@gnu.org}.
-Anything sent there also appears in the
-newsgroup @uref{news:gnu.emacs.bug}, but please use e-mail instead of
-news to submit the bug report. This ensures a reliable return address
-so you can be contacted for further details.
Be sure to read the ``Bugs'' section of the Emacs manual before reporting
a bug! The manual describes in detail how to submit a useful bug
report (@pxref{Bugs, , Reporting Bugs, emacs, The GNU Emacs Manual}).
(@xref{Emacs manual}, if you don't know how to read the manual.)
-RMS says:
-
-@quotation
Sending bug reports to
-@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{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
-bug-gnu-emacs list} reaches a much smaller group of people who are
+@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, the
+help-gnu-emacs mailing list} 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{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.
-@end quotation
-
-RMS says it is sometimes fine to post to @uref{news:gnu.emacs.help}:
-@quotation
If you have reported a bug and you don't hear about a possible fix,
then after a suitable delay (such as a week) it is okay to post on
-@code{gnu.emacs.help} asking if anyone can help you.
-@end quotation
+@code{help-gnu-emacs@@gnu.org} asking if anyone can help you.
If you are unsure whether you have found a bug, consider the following
non-exhaustive list, courtesy of RMS:
@@ -458,6 +456,11 @@ is a bug. If Lisp code does not do what the documentation says it
does, that is a bug.
@end quotation
+Anything sent to @email{bug-gnu-emacs@@gnu.org} also appears in the
+newsgroup @uref{news:gnu.emacs.bug}, but please use e-mail instead of
+news to submit the bug report. This ensures a reliable return address
+so you can be contacted for further details.
+
@node Unsubscribing from Emacs lists
@section How do I unsubscribe from a mailing list?
@cindex Unsubscribing from GNU mailing lists
@@ -1516,6 +1519,7 @@ of files from Macintosh, Microsoft, and Unix platforms.
* Documentation for etags::
* Disabling backups::
* Disabling auto-save-mode::
+* Not writing files to the current directory::
* Going to a line by number::
* Modifying pull-down menus::
* Deleting menus and menu options::
@@ -2617,6 +2621,39 @@ such as @file{/tmp}.
To disable or change how @code{auto-save-mode} works,
@pxref{Auto Save,,, emacs, The GNU Emacs Manual}.
+@node Not writing files to the current directory
+@section Making Emacs write all auxiliary files somewhere else
+@cindex Writing all auxiliary files to the same directory
+
+By default, Emacs may create many new files in the directory where
+you're editing a file. If you're editing the file
+@file{/home/user/foo.txt}, Emacs will create the lock file
+@file{/home/user/.#foo.txt}, the auto-save file
+@file{/home/user/#foo.txt#}, and when you save the file, Emacs will
+create the backup file @file{/home/user/foo.txt~}. (The first two
+files are deleted when you save the file.)
+
+This may be inconvenient in some setups, so Emacs has mechanisms for
+changing the locations of all these files.
+
+@table @code
+@item auto-save-file-name-transforms (@pxref{Auto-Saving,,,elisp, GNU Emacs Lisp Reference Manual}).
+@item lock-file-name-transforms (@pxref{File Locks,,,elisp, GNU Emacs Lisp Reference Manual}).
+@item backup-directory-alist (@pxref{Making Backups,,,elisp, GNU Emacs Lisp Reference Manual}).
+@end table
+
+For instance, to write all these things to
+@file{~/.emacs.d/aux/}:
+
+@lisp
+(setq lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
+(setq auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
+(setq backup-directory-alist
+ '((".*" . "~/.emacs.d/aux/")))
+@end lisp
+
@node Going to a line by number
@section How can I go to a certain line given its number?
@cindex Going to a line by number
@@ -3526,10 +3563,8 @@ installing any nonfree software, we recommend for your freedom's sake
that you stay away from it.
The @uref{https://lists.gnu.org/mailman/listinfo/gnu-emacs-sources,
-GNU Emacs sources mailing list}, which is gatewayed to the
-@uref{news:gnu.emacs.sources, Emacs sources newsgroup} (although the
-connection between the two can be unreliable) is an official place
-where people can post or announce their extensions to Emacs.
+GNU Emacs sources mailing list} is an official place where people can
+post or announce their extensions to Emacs.
The @uref{https://emacswiki.org, Emacs Wiki} contains pointers to some
additional extensions. @uref{https://wikemacs.org, WikEmacs} is an
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index 4952e909902..63b42827311 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -115,10 +115,10 @@ Each class can have methods, which are defined like this:
(cl-defmethod call-person ((pers person) &optional scriptname)
"Dial the phone for the person PERS.
Execute the program SCRIPTNAME to dial the phone."
- (message "Dialing the phone for %s" (oref pers name))
+ (message "Dialing the phone for %s" (slot-value pers 'name))
(shell-command (concat (or scriptname "dialphone.sh")
" "
- (oref pers phone))))
+ (slot-value pers 'phone))))
@end example
@noindent
@@ -693,16 +693,43 @@ for each slot. For example:
@node Accessing Slots
@chapter Accessing Slots
-There are several ways to access slot values in an object. The naming
-and argument-order conventions are similar to those used for
-referencing vectors (@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference
-Manual}).
+There are several ways to access slot values in an object.
+The following accessors are defined by CLOS to reference or modify
+slot values, and use the previously mentioned set/ref routines.
+
+@defun slot-value object slot
+@anchor{slot-value}
+This function retrieves the value of @var{slot} from @var{object}.
+
+This is a generalized variable that can be used with @code{setf} to
+modify the value stored in @var{slot}. @xref{Generalized
+Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
+@end defun
+
+@defun set-slot-value object slot value
+@anchor{set-slot-value}
+This function sets the value of @var{slot} from @var{object}.
+
+This is not a CLOS function, but is the obsolete setter for
+@code{slot-value} used by the @code{setf} macro. It is therefore
+recommended to use @w{@code{(setf (slot-value @var{object} @var{slot})
+@var{value})}} instead.
+@end defun
+
+@defun slot-makeunbound object slot
+This function unbinds @var{slot} in @var{object}. Referencing an
+unbound slot can signal an error.
+@end defun
+
+The following accessors follow a naming and argument-order conventions
+are similar to those used for referencing vectors
+(@pxref{Vectors,,,elisp,GNU Emacs Lisp Reference Manual}).
@defmac oref obj slot
@anchor{oref}
This macro retrieves the value stored in @var{obj} in the named
-@var{slot}. Slot names are determined by @code{defclass} which
-creates the slot.
+@var{slot}. Unlike @code{slot-value}, the symbol for @var{slot} must
+not be quoted.
This is a generalized variable that can be used with @code{setf} to
modify the value stored in @var{slot}. @xref{Generalized
@@ -737,35 +764,6 @@ changed, this can be arranged by simply executing this bit of code:
@end example
@end defmac
-The following accessors are defined by CLOS to reference or modify
-slot values, and use the previously mentioned set/ref routines.
-
-@defun slot-value object slot
-@anchor{slot-value}
-This function retrieves the value of @var{slot} from @var{object}.
-Unlike @code{oref}, the symbol for @var{slot} must be quoted.
-
-This is a generalized variable that can be used with @code{setf} to
-modify the value stored in @var{slot}. @xref{Generalized
-Variables,,,elisp,GNU Emacs Lisp Reference Manual}.
-@end defun
-
-@defun set-slot-value object slot value
-@anchor{set-slot-value}
-This function sets the value of @var{slot} from @var{object}. Unlike
-@code{oset}, the symbol for @var{slot} must be quoted.
-
-This is not a CLOS function, but is the obsolete setter for
-@code{slot-value} used by the @code{setf} macro. It is therefore
-recommended to use @w{@code{(setf (slot-value @var{object} @var{slot})
-@var{value})}} instead.
-@end defun
-
-@defun slot-makeunbound object slot
-This function unbinds @var{slot} in @var{object}. Referencing an
-unbound slot can signal an error.
-@end defun
-
@defun object-add-to-list object slot item &optional append
@anchor{object-add-to-list}
In OBJECT's @var{slot}, add @var{item} to the list of elements.
@@ -807,7 +805,7 @@ Where each @var{var} is the local variable given to the associated
variable name of the same name as the slot.
@example
-(defclass myclass () (x :initform 1))
+(defclass myclass () ((x :initform 1)))
(setq mc (make-instance 'myclass))
(with-slots (x) mc x) => 1
(with-slots ((something x)) mc something) => 1
@@ -981,8 +979,8 @@ the @code{subclass} specializer with @code{cl-defmethod}:
new))
@end example
-The first argument of a static method will be a class rather than an
-object. Use the functions @code{oref-default} or @code{oset-default} which
+The argument of a static method will be a class rather than an object.
+Use the functions @code{oref-default} or @code{oset-default} which
will work on a class.
A class's @code{make-instance} method is defined as a static
@@ -1238,12 +1236,6 @@ of CLOS.
Return the list of public slots for @var{obj}.
@end defun
-@defun class-slot-initarg class slot
-For the given @var{class} return an :initarg associated with
-@var{slot}. Not all slots have initargs, so the return value can be
-@code{nil}.
-@end defun
-
@node Base Classes
@chapter Base Classes
@@ -1656,8 +1648,8 @@ Method invoked when an attempt to access a slot in @var{object} fails.
that was requested, and optional @var{new-value} is the value that was desired
to be set.
-This method is called from @code{oref}, @code{oset}, and other functions which
-directly reference slots in EIEIO objects.
+This method is called from @code{slot-value}, @code{set-slot-value},
+and other functions which directly reference slots in EIEIO objects.
The default method signals an error of type @code{invalid-slot-name}.
@xref{Signals}.
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 0cf5ba96506..7cd3e5f5828 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -1870,6 +1870,11 @@ A customizable list of viewers that take preference over
Interface functions:
@table @code
+@item mailcap-view-file
+@findex mailcap-view-file
+Prompt for a file name, and start a viewer applicable for the file
+type in question.
+
@item mailcap-parse-mailcaps
@findex mailcap-parse-mailcaps
@vindex mailcap-prefer-mailcap-viewers
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi
index cca0d300fa7..e777771cf73 100644
--- a/doc/misc/epa.texi
+++ b/doc/misc/epa.texi
@@ -42,7 +42,7 @@ modify this GNU manual.''
@contents
-@node Top, Overview, (dir), (dir)
+@node Top
@top EasyPG Assistant user's manual
EasyPG Assistant is an Emacs user interface to GNU Privacy Guard
@@ -60,8 +60,8 @@ called EasyPG Library.
* Overview::
* Quick start::
* Commands::
-* Caching Passphrases::
* GnuPG version compatibility::
+* Caching Passphrases::
* Bug Reports::
* GNU Free Documentation License:: The license for this documentation.
* Key Index::
@@ -69,7 +69,7 @@ called EasyPG Library.
* Variable Index::
@end menu
-@node Overview, Quick start, Top, Top
+@node Overview
@chapter Overview
EasyPG Assistant provides the following features.
@@ -83,7 +83,7 @@ EasyPG Assistant provides the following features.
@item Automatic encryption/decryption of *.gpg files.
@end itemize
-@node Quick start, Commands, Overview, Top
+@node Quick start
@chapter Quick start
EasyPG Assistant commands are prefixed by @samp{epa-}. For example,
@@ -94,13 +94,15 @@ EasyPG Assistant commands are prefixed by @samp{epa-}. For example,
@item To create a cleartext signature of the region, type @kbd{M-x epa-sign-region}
@item To encrypt a file, type @kbd{M-x epa-encrypt-file}
+
+@item To query a key server for keys, type @kbd{M-x epa-search-keys}
@end itemize
EasyPG Assistant provides several cryptographic features which can be
integrated into other Emacs functionalities. For example, automatic
encryption/decryption of @file{*.gpg} files.
-@node Commands, GnuPG version compatibility, Quick start, Top
+@node Commands
@chapter Commands
This chapter introduces various commands for typical use cases.
@@ -112,9 +114,10 @@ This chapter introduces various commands for typical use cases.
* Dired integration::
* Mail-mode integration::
* Encrypting/decrypting gpg files::
+* Querying a key server::
@end menu
-@node Key management, Cryptographic operations on regions, Commands, Commands
+@node Key management
@section Key management
Probably the first step of using EasyPG Assistant is to browse your
keyring. @kbd{M-x epa-list-keys} is corresponding to @samp{gpg
@@ -197,7 +200,7 @@ Delete selected keys. If @var{allow-secret} is non-@code{nil}, it
also delete the secret keys.
@end deffn
-@node Cryptographic operations on regions, Cryptographic operations on files, Key management, Commands
+@node Cryptographic operations on regions
@section Cryptographic operations on regions
@deffn Command epa-decrypt-region start end
@@ -242,7 +245,7 @@ also ask you whether or not to sign the text before encryption and if
you answered yes, it will let you select the signing keys.
@end deffn
-@node Cryptographic operations on files, Dired integration, Cryptographic operations on regions, Commands
+@node Cryptographic operations on files
@section Cryptographic operations on files
@deffn Command epa-decrypt-file file &optional output
@@ -263,7 +266,7 @@ select signing keys, and then a signature type.
Encrypt @var{file}. It will let you select recipients.
@end deffn
-@node Dired integration, Mail-mode integration, Cryptographic operations on files, Commands
+@node Dired integration
@section Dired integration
EasyPG Assistant extends Dired Mode for GNU Emacs to allow users to
@@ -302,7 +305,7 @@ Encrypt marked files.
@end table
-@node Mail-mode integration, Encrypting/decrypting gpg files, Dired integration, Commands
+@node Mail-mode integration
@section Mail-mode integration
EasyPG Assistant provides a minor mode @code{epa-mail-mode} to help
@@ -357,7 +360,7 @@ With prefix argument, asks you to select the recipients interactively,
whether to sign, and which key(s) to sign with.
@end table
-@node Encrypting/decrypting gpg files, , Mail-mode integration, Commands
+@node Encrypting/decrypting gpg files
@section Encrypting/decrypting gpg files
By default, every file whose name ends with @file{.gpg} will be
treated as encrypted. That is, when you open such a file, the
@@ -440,7 +443,22 @@ If non-@code{nil}, disable auto-saving when opening an encrypted file.
The default value is @code{t}.
@end defvar
-@node GnuPG version compatibility, Caching Passphrases, Commands, Top
+@node Querying a key server
+@section Querying a key server
+
+The @code{epa-search-keys} command can be used to query a
+@acronym{GPG} key server. Emacs will then pop up a buffer that lists
+the matches, and you can then fetch (and add) keys to your personal
+key ring.
+
+In the key search buffer, you can use the @kbd{f} command to mark keys
+for fetching, and then @kbd{x} to fetch the keys (and incorporate them
+into your key ring).
+
+The @code{epa-keyserver} variable says which server to query.
+
+
+@node GnuPG version compatibility
@chapter GnuPG version compatibility
As of February 2016, there are three active branches of GnuPG: 2.1,
@@ -472,7 +490,7 @@ specifically, with 2.0 (as of 2.0.29), there is no way to avoid the
graphical prompt.
@end itemize
-@node Caching Passphrases, Bug Reports, GnuPG version compatibility, Top
+@node Caching Passphrases
@chapter Caching Passphrases
Typing passphrases is a troublesome task if you frequently open and
@@ -512,7 +530,7 @@ To set up elisp passphrase cache, set
@code{epa-file-cache-passphrase-for-symmetric-encryption}.
@xref{Encrypting/decrypting gpg files}.
-@node Bug Reports, GNU Free Documentation License, Caching Passphrases, Top
+@node Bug Reports
@chapter Bug Reports
Bugs and problems with EasyPG Assistant are actively worked on by the
@@ -534,19 +552,19 @@ Before reporting the bug, you should set @code{epg-debug} in the
of the @file{ *epg-debug*} buffer. Note that the first letter of the
buffer name is a whitespace.
-@node GNU Free Documentation License, Key Index, Bug Reports, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Key Index, Function Index, GNU Free Documentation License, Top
+@node Key Index
@unnumbered Key Index
@printindex ky
-@node Function Index, Variable Index, Key Index, Top
+@node Function Index
@unnumbered Function Index
@printindex fn
-@node Variable Index, , Function Index, Top
+@node Variable Index
@unnumbered Variable Index
@printindex vr
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index d635cac5abb..10ced678e1d 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -131,21 +131,30 @@ customize-variable @key{RET} erc-modules @key{RET}}.
@node Sample Session
@section Sample Session
-This is an example ERC session which shows how to connect to the #emacs
-channel on Freenode. Another IRC channel on Freenode that may be of
-interest is #erc, which is a channel where ERC users and developers hang
-out.
+This is an example ERC session which shows how to connect to the
+#emacs channel on Libera.Chat. Another IRC channel on Libera.Chat
+that may be of interest is #erc, which is a channel where ERC users
+and developers hang out. These channels used to live on the Freenode
+IRC network until June 2021, when they---along with the official IRC
+channels of the GNU Project, the Free Software Foundation, and many
+other free software communities---relocated to the Libera.Chat network
+in the aftermath of changes in governance and policies of Freenode in
+May and June 2021. GNU and FSF's announcements about this are at
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html},
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html},
+and
+@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}.
@itemize @bullet
-@item Connect to Freenode
+@item Connect to Libera.Chat
-Run @kbd{M-x erc}. Use ``chat.freenode.net'' as the IRC server,
-``6667'' as the port, and choose a nickname.
+Run @kbd{M-x erc}. Use ``irc.libera.chat as the IRC server, ``6667''
+as the port, and choose a nickname.
@item Get used to the interface
-Switch to the ``chat.freenode.net:6667'' buffer, if you're not already
+Switch to the ``irc.libera.chat:6667'' buffer, if you're not already
there. You will see first some messages about checking for ident, and
then a bunch of other messages that describe the current IRC server.
@@ -158,13 +167,13 @@ background. If the latter, switch to the ``#emacs'' buffer. You will
see the channel topic and a list of the people who are currently on the
channel.
-@item Register your nickname with Freenode
+@item Register your nickname with Libera.Chat
If you would like to be able to talk with people privately on the
-Freenode network, you will have to ``register'' your nickname. To do
-so, switch to the ``chat.freenode.net:6667'' buffer and type ``/msg
-NickServ register <password>'', replacing ``<password>'' with your
-desired password. It should tell you that the operation was
+Libera.Chat network, you will have to ``register'' your nickname.
+To do so, switch to the ``irc.libera.chat:6667'' buffer and type
+``/msg NickServ register <password>'', replacing ``<password>'' with
+your desired password. It should tell you that the operation was
successful.
@item Talk to people in the channel
@@ -514,15 +523,85 @@ Non-interactively, it takes the following keyword arguments.
That is, if called with the following arguments, @var{server} and
@var{full-name} will be set to those values, whereas
-@code{erc-compute-port}, @code{erc-compute-nick} and
-@code{erc-compute-full-name} will be invoked for the values of the other
-parameters.
+@code{erc-compute-port} and @code{erc-compute-nick} will be invoked
+for the values of the other parameters.
@example
-(erc :server "chat.freenode.net" :full-name "Harry S Truman")
+(erc :server "irc.libera.chat" :full-name "J. Random Hacker")
@end example
@end defun
+To connect securely over an encrypted TLS connection, use @kbd{M-x
+erc-tls}.
+
+@defun erc-tls
+Select connection parameters and run ERC over TLS@.
+Non-interactively, it takes the following keyword arguments.
+
+@itemize @bullet
+@item @var{server}
+@item @var{port}
+@item @var{nick}
+@item @var{password}
+@item @var{full-name}
+@item @var{client-certificate}
+@end itemize
+
+That is, if called with the following arguments, @var{server} and
+@var{full-name} will be set to those values, whereas
+@code{erc-compute-port} and @code{erc-compute-nick} will be invoked
+for the values of the other parameters, and @code{client-certificate}
+will be @code{nil}.
+
+@example
+(erc-tls :server "irc.libera.chat" :full-name "J. Random Hacker")
+@end example
+
+To use a certificate with @code{erc-tls}, specify the optional
+@var{client-certificate} keyword argument, whose value should be as
+described in the documentation of @code{open-network-stream}: if
+non-@code{nil}, it should either be a list where the first element is
+the file name of the private key corresponding to a client certificate
+and the second element is the file name of the client certificate
+itself to use when connecting over TLS, or @code{t}, which means that
+@code{auth-source} will be queried for the private key and the
+certificate. Authenticating using a TLS client certificate is also
+referred to as ``CertFP'' (Certificate Fingerprint) authentication by
+various IRC networks.
+
+Examples of use:
+
+@example
+(erc-tls :server "irc.libera.chat" :port 6697
+ :client-certificate
+ '("/home/bandali/my-cert.key"
+ "/home/bandali/my-cert.crt"))
+@end example
+
+@example
+(erc-tls :server "irc.libera.chat" :port 6697
+ :client-certificate
+ `(,(expand-file-name "~/cert-libera.key")
+ ,(expand-file-name "~/cert-libera.crt")))
+@end example
+
+@example
+(erc-tls :server "irc.libera.chat" :port 6697
+ :client-certificate t)
+@end example
+
+In the case of @code{:client-certificate t}, you will need to add a
+line like the following to your authinfo file
+(e.g. @file{~/.authinfo.gpg}):
+
+@example
+machine irc.libera.chat key /home/bandali/my-cert.key cert /home/bandali/my-cert.crt
+@end example
+
+@xref{Help for users,,,auth, Emacs auth-source Library}, for more on the
+@file{.authinfo}/@file{.netrc} backend of @code{auth-source}.
+@end defun
+
@subheading Server
@defun erc-compute-server &optional server
@@ -692,11 +771,10 @@ stuff, to the current ERC buffer."
(erc-send-message
(concat "@{Uptime@} [" uname-output "]"))))
-;; This causes ERC to connect to the Freenode network upon hitting
+;; This causes ERC to connect to the Libera.Chat network upon hitting
;; C-c e f. Replace MYNICK with your IRC nick.
(global-set-key "\C-cef" (lambda () (interactive)
- (erc :server "chat.freenode.net"
- :port "6667"
+ (erc :server "irc.libera.chat" :port "6667"
:nick "MYNICK")))
;; This causes ERC to connect to the IRC server on your own machine (if
@@ -716,13 +794,15 @@ stuff, to the current ERC buffer."
;;; Options
-;; Join the #emacs and #erc channels whenever connecting to Freenode.
-(setq erc-autojoin-channels-alist '(("freenode.net" "#emacs" "#erc")))
+;; Join the #emacs and #erc channels whenever connecting to
+;; Libera.Chat.
+(setq erc-autojoin-channels-alist
+ '(("Libera.Chat" "#emacs" "#erc")))
;; Rename server buffers to reflect the current network name instead
-;; of SERVER:PORT (e.g., "freenode" instead of "chat.freenode.net:6667").
-;; This is useful when using a bouncer like ZNC where you have multiple
-;; connections to the same server.
+;; of SERVER:PORT (e.g., "Libera.Chat" instead of
+;; "irc.libera.chat:6667"). This is useful when using a bouncer like
+;; ZNC where you have multiple connections to the same server.
(setq erc-rename-buffers t)
;; Interpret mIRC-style color commands in IRC chats
@@ -762,7 +842,7 @@ If non, @code{nil}, this is a list of IRC networks and message types
to hide, e.g.:
@example
-(setq erc-network-hide-list (("freenode" "JOIN" "PART" "QUIT")
+(setq erc-network-hide-list (("Libera.Chat" "JOIN" "PART" "QUIT")
("OFTC" "JOIN" "PART""))
@end example
@end defopt
@@ -811,7 +891,7 @@ You can ask questions about using ERC on the Emacs mailing list,
@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}.
@item
-You can visit the IRC Freenode channel @samp{#emacs}. Many of the
+You can visit the IRC Libera.Chat channel @samp{#emacs}. Many of the
contributors are frequently around and willing to answer your
questions.
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index a4e2cb506a3..fafdb8c4eb4 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -347,6 +347,10 @@ emacs -batch -l ert -l my-tests.el \
-eval '(ert-run-tests-batch-and-exit "to-match")'
@end example
+By default, ERT test failure summaries are quite brief in batch
+mode--only the names of the failed tests are listed. If the
+EMACS_TEST_VERBOSE environment variable is set, the failure summaries
+will also include the data from the failing test.
@node Test Selectors
@section Test Selectors
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index e106f39cdd9..fc2e3f3b111 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -515,8 +515,8 @@ below the @code{completion-cycle-threshold}), press @kbd{M-?}.
@subsection pcomplete
Pcomplete, short for programmable completion, is the completion
library originally written for Eshell, but usable for command
-completion@footnote{Command completion as opposed to code completion,
-which is a beyond the scope of pcomplete.} in other modes.
+completion@footnote{Command completion, as opposed to code completion,
+which is beyond the scope of pcomplete.} in other modes.
Completions are defined as functions (with @code{defun}) named
@code{pcomplete/COMMAND}, where @code{COMMAND} is the name of the
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 6e82a97030e..cc546a92d63 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -124,17 +124,25 @@ which part of the document contains the ``readable'' text, and will
only display this part. This usually gets rid of menus and the like.
@findex eww-toggle-fonts
-@findex shr-use-fonts
+@vindex shr-use-fonts
@kindex F
The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use
variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable.
@findex eww-toggle-colors
-@findex shr-use-colors
-@kindex F
+@vindex shr-use-colors
+@kindex M-C
The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use
HTML-specified colors or not. This sets the @code{shr-use-colors} variable.
+@findex eww-toggle-images
+@vindex shr-inhibit-images
+@kindex M-I
+@cindex Image Display
+ The @kbd{M-I} command (@code{eww-toggle-images}, capital letter i)
+toggles whether to display images or not. This also sets the
+@code{shr-inhibit-images} variable.
+
@findex eww-download
@vindex eww-download-directory
@kindex d
@@ -305,6 +313,11 @@ of the width and height. If Emacs supports image scaling (ImageMagick
support required) then larger images are scaled down. You can block
specific images completely by customizing @code{shr-blocked-images}.
+@vindex shr-inhibit-images
+ You can control image display by customizing
+@code{shr-inhibit-images}. If this variable is @code{nil}, display
+the ``ALT'' text of images instead.
+
@vindex shr-color-visible-distance-min
@vindex shr-color-visible-luminance-min
@cindex Contrast
diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi
index 3d7ac96cc24..15fcd97c5b9 100644
--- a/doc/misc/forms.texi
+++ b/doc/misc/forms.texi
@@ -6,6 +6,7 @@
@setfilename ../../info/forms.info
@settitle Forms Mode User's Manual
@include docstyle.texi
+@include emacsver.texi
@syncodeindex vr cp
@syncodeindex fn cp
@syncodeindex ky cp
@@ -47,7 +48,7 @@ modify this GNU manual.''
@sp 4
@center Forms-Mode version 2
@sp 1
-@center for GNU Emacs 22.1
+@center for GNU Emacs @value{EMACSVER}
@sp 1
@center April 2007
@sp 5
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 4c29976c05e..28bee11d2bd 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -160,13 +160,7 @@ Where and how to get Gnus?
@subsubheading Answer
-Gnus is released independent from releases of Emacs. Therefore, the
-version bundled with Emacs 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{https://www.gnus.org/dist/gnus.tar.gz}
-or from
-@uref{https://ftp.gnus.org/pub/gnus/gnus.tar.gz}.
+Gnus is bundled with Emacs.
@node FAQ 1-4
@subsubheading Question 1.4
@@ -1941,13 +1935,13 @@ when you're online.
Let's talk about Unix systems first: For the news part,
the easiest solution is a small nntp server like
-@uref{http://www.leafnode.org/, Leafnode} or
+@uref{https://www.leafnode.org/, Leafnode} or
@uref{http://patrik.iki.fi/sn/, sn},
of course you can also install a full featured news
server like
@uref{https://www.isc.org/othersoftware/, inn}.
Then you want to fetch your Mail, popular choices
-are @uref{http://www.fetchmail.info/, fetchmail}
+are @uref{https://www.fetchmail.info/, fetchmail}
and @uref{http://pyropus.ca/software/getmail/, getmail}.
You should tell those to write the mail to your disk and
Gnus to read it from there. Last but not least the mail
@@ -2144,7 +2138,7 @@ I need real-time help, where to find it?
@subsubheading Answer
-Point your IRC client to chat.freenode.net, channel #gnus.
+Point your IRC client to irc.libera.chat, channel #gnus.
@node FAQ 9 - Tuning Gnus
@subsection Tuning Gnus
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 5a79cbc08fc..5f3fba00df7 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -815,7 +815,7 @@ Various
* Undo:: Some actions can be undone.
* Predicate Specifiers:: Specifying predicates.
* Moderation:: What to do if you're a moderator.
-* Image Enhancements:: Modern versions of Emacs can display images.
+* Image Enhancements:: Emacs can display images.
* Fuzzy Matching:: What's the big fuzz?
* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email.
* Spam Package:: A package for filtering and processing spam.
@@ -2318,19 +2318,18 @@ commands listed in @ref{Browse Foreign Server} at hand.
@itemx u
@kindex S t @r{(Group)}
@kindex u @r{(Group)}
-@findex gnus-group-unsubscribe-current-group
-@c @icon{gnus-group-unsubscribe}
-Toggle subscription to the current group
-(@code{gnus-group-unsubscribe-current-group}).
+@findex gnus-group-toggle-subscription-at-point
+@c @icon{gnus-group-toggle-subscription-at-point}
+Toggle subscription to group under point
+(@code{gnus-group-toggle-subscription-at-point}).
@item S s
@itemx U
@kindex S s @r{(Group)}
@kindex U @r{(Group)}
-@findex gnus-group-unsubscribe-group
-Prompt for a group to subscribe, and then subscribe it. If it was
-subscribed already, unsubscribe it instead
-(@code{gnus-group-unsubscribe-group}).
+@findex gnus-group-toggle-subscription
+Prompt for group, and toggle its subscription.
+(@code{gnus-group-toggle-subscription}).
@item S k
@itemx C-k
@@ -2583,25 +2582,28 @@ with the process mark and then execute the command.
@itemx M m
@kindex M m @r{(Group)}
@findex gnus-group-mark-group
-Set the mark on the current group (@code{gnus-group-mark-group}).
+Toggle the process mark for the current group
+(@code{gnus-group-mark-group}).@*
+If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark
+for the current group.
@item M-#
@kindex M-# @r{(Group)}
@itemx M u
@kindex M u @r{(Group)}
@findex gnus-group-unmark-group
-Remove the mark from the current group
+Remove the process mark, if any, from the current group
(@code{gnus-group-unmark-group}).
@item M U
@kindex M U @r{(Group)}
@findex gnus-group-unmark-all-groups
-Remove the mark from all groups (@code{gnus-group-unmark-all-groups}).
+Remove the process mark from all groups (@code{gnus-group-unmark-all-groups}).
@item M w
@kindex M w @r{(Group)}
@findex gnus-group-mark-region
-Mark all groups between point and mark (@code{gnus-group-mark-region}).
+Mark groups in region (@code{gnus-group-mark-region}).
@item M b
@kindex M b @r{(Group)}
@@ -3733,10 +3735,10 @@ Enter the current group (@code{gnus-browse-select-group}).
@item u
@kindex u @r{(Browse)}
-@findex gnus-browse-unsubscribe-current-group
+@findex gnus-browse-toggle-subscription
@vindex gnus-browse-subscribe-newsgroup-method
-Unsubscribe to the current group, or, as will be the case here,
-subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You
+Toggle subscription of the current group
+(@code{gnus-browse-toggle-subscription}). You
can affect the way the new group is entered into the Group buffer
using the variable @code{gnus-browse-subscribe-newsgroup-method}. See
@pxref{Subscription Methods} for available options.
@@ -4041,9 +4043,11 @@ Toggle hiding empty topics
@item T #
@kindex T # @r{(Topic)}
@findex gnus-topic-mark-topic
-Mark all groups in the current topic with the process mark
+Toggle the process mark for all groups in the current topic
(@code{gnus-topic-mark-topic}). This command works recursively on
-sub-topics unless given a prefix.
+sub-topics unless given a prefix.@*
+If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark
+for the current topic.
@item T M-#
@kindex T M-# @r{(Topic)}
@@ -4121,6 +4125,8 @@ Visibility.
Level.
@item g
Number of groups in the topic.
+@item G
+Number of groups in the topic and all its subtopics.
@item a
Number of unread articles in the topic.
@item A
@@ -4139,6 +4145,25 @@ The default is 2.
The @code{gnus-topic-display-empty-topics} says whether to display even
topics that have no unread articles in them. The default is @code{t}.
+@vindex gnus-topic-display-predicate
+If @code{gnus-topic-display-predicate} is non-@code{nil}, it should be
+a function that says whether the topic is to be displayed or not.
+The function will be called with one parameter (the name of the topic)
+and should return non-@code{nil} is the topic is to be displayed.
+
+For instance, if you don't even want to be reminded that work exists
+outside of office hours, you can gather all the work-related groups
+into a topic called @samp{"Work"}, and then say something like the
+following:
+
+@lisp
+(setq gnus-topic-display-predicate
+ (lambda (name)
+ (or (not (equal name "Work"))
+ (< 090000
+ (string-to-number (format-time-string "%H%M%S"))
+ 170000))))
+@end lisp
@node Topic Sorting
@subsection Topic Sorting
@@ -5230,8 +5255,23 @@ Newsgroups:full
@end example
to the end of her @file{overview.fmt} file, then you can use that just
-as you would the extra headers from the mail groups.
+as you would the extra headers from the mail groups. Otherwise, you
+have to disable fetching headers with @samp{XOVER}:
+
+@lisp
+(setq nntp-nov-is-evil t
+ gnus-nov-is-evil t)
+@end lisp
+
+Be aware, though, that this will make entering an @acronym{NNTP} group
+much, much slower, so this is not recommended.
+One particular scenario in which it can be desirable to not use
+@samp{XOVER} is for @code{nnvirtual} groups in order to support
+limiting by extra headers (e.g., by the newsgroup of its component
+groups). Because group parameters are not inherited, a separate
+select method for the component groups with the appropriate
+@code{nov-is-evil} set as a method variable is required.
@node Summary Buffer Mode Line
@subsection Summary Buffer Mode Line
@@ -6608,14 +6648,16 @@ articles into the cache. For more information,
@kindex # @r{(Summary)}
@kindex M P p @r{(Summary)}
@findex gnus-summary-mark-as-processable
-Mark the current article with the process mark
-(@code{gnus-summary-mark-as-processable}).
-@findex gnus-summary-unmark-as-processable
+Toggle the process mark for the current article
+(@code{gnus-summary-mark-as-processable}).@*
+If @code{gnus-process-mark-toggle} is @code{nil}, set the process mark
+for the current article.
@item M P u
@itemx M-#
@kindex M P u @r{(Summary)}
@kindex M-# @r{(Summary)}
+@findex gnus-summary-unmark-as-processable
Remove the process mark, if any, from the current article
(@code{gnus-summary-unmark-as-processable}).
@@ -7503,6 +7545,7 @@ Matching}).
@findex gnus-thread-sort-by-author
@findex gnus-thread-sort-by-recipient
@findex gnus-thread-sort-by-number
+@findex gnus-thread-sort-by-newsgroups
@findex gnus-thread-sort-by-random
@vindex gnus-thread-sort-functions
@findex gnus-thread-sort-by-most-recent-number
@@ -7520,6 +7563,7 @@ predicate functions include @code{gnus-thread-sort-by-number},
@code{gnus-thread-sort-by-score},
@code{gnus-thread-sort-by-most-recent-number},
@code{gnus-thread-sort-by-most-recent-date},
+@code{gnus-thread-sort-by-newsgroups} and
@code{gnus-thread-sort-by-random} and
@code{gnus-thread-sort-by-total-score}.
@@ -7581,6 +7625,7 @@ tickles your fancy.
@findex gnus-article-sort-by-score
@findex gnus-article-sort-by-subject
@findex gnus-article-sort-by-author
+@findex gnus-article-sort-by-newsgroups
@findex gnus-article-sort-by-random
@findex gnus-article-sort-by-number
@findex gnus-article-sort-by-most-recent-number
@@ -7592,8 +7637,8 @@ different functions for article comparison. Available sorting
predicate functions are @code{gnus-article-sort-by-number},
@code{gnus-article-sort-by-author},
@code{gnus-article-sort-by-subject}, @code{gnus-article-sort-by-date},
-@code{gnus-article-sort-by-random}, and
-@code{gnus-article-sort-by-score}.
+@code{gnus-article-sort-by-newsgroups}, @code{gnus-article-sort-by-random},
+and @code{gnus-article-sort-by-score}.
If you want to sort an unthreaded summary display by subject, you could
say something like:
@@ -10381,6 +10426,17 @@ Sort by article ``readedness'' marks (@code{gnus-summary-sort-by-marks}).
@findex gnus-summary-sort-by-score
Sort by score (@code{gnus-summary-sort-by-score}).
+@item C-c C-s C-u
+@kindex C-c C-s C-u @r{(Summary)}
+@findex gnus-summary-sort-by-newsgroups
+Sort by newsgroups (@code{gnus-summary-sort-by-newsgroups}).
+
+@item C-c C-s C-x
+@kindex C-c C-s C-x @r{(Summary)}
+@findex gnus-summary-sort-by-extra
+Prompts for extra header to sort by (@code{gnus-summary-sort-by-extra}).
+An error will be raised if no sort functions for the header are defined.
+
@item C-c C-s C-r
@kindex C-c C-s C-r @r{(Summary)}
@findex gnus-summary-sort-by-random
@@ -10553,13 +10609,15 @@ Here are the available keystrokes when using pick mode:
@item .
@kindex . @r{(Pick)}
@findex gnus-pick-article-or-thread
-Pick the article or thread on the current line
-(@code{gnus-pick-article-or-thread}). If the variable
+Pick the article or thread on the current line or unpick it if is
+already picked (@code{gnus-pick-article-or-thread}). If the variable
@code{gnus-thread-hide-subtree} is true, then this key selects the
entire thread when used at the first article of the thread. Otherwise,
it selects just the article. If given a numerical prefix, go to that
thread or article and pick it. (The line number is normally displayed
-at the beginning of the summary pick lines.)
+at the beginning of the summary pick lines.) If
+@code{gnus-process-mark-toggle} is @code{nil}, this key will pick an
+article or thread.
@item @key{SPC}
@kindex SPC @r{(Pick)}
@@ -14477,7 +14535,8 @@ this should be set to @code{anonymous}. If this variable isn't set,
the normal login methods will be used. If you wish to specify a
specific login method to be used, you can set this variable to either
@code{login} (the traditional @acronym{IMAP} login method),
-@code{plain} or @code{cram-md5}.
+@code{plain}, @code{cram-md5} or @code{xoauth2}. (The latter method
+requires using the @file{oauth2.el} library.)
@item nnimap-expunge
When to expunge deleted messages. If @code{never}, deleted articles
@@ -14515,6 +14574,17 @@ names. If your IMAP mailboxes are called something like @samp{INBOX}
and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to
be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option.
+@item nnimap-keepalive-intervals
+By default, nnimap will send occasional @samp{NOOP} (keepalive)
+commands to the server, to keep the connection alive. This option
+governs how often that happens. It is a cons of two integers,
+representing seconds: first how often to run the keepalive check, and
+the second how many seconds of user inactivity are required to
+actually send the command. The default, @code{(900 . 300)}, means run
+the check every fifteen minutes and, if the user has been inactive for
+five minutes, send the keepalive command. Set to @code{nil} to
+disable keepalive commands altogether.
+
@end table
@@ -16237,7 +16307,7 @@ cleaning up the headers. Functions that can be used include:
Clear leading white space that ``helpful'' listservs have added to the
headers to make them look nice. Aaah.
-(Note that this function works on both the header on the body of all
+(Note that this function works on both the header and the body of all
messages, so it is a potentially dangerous function to use (if a body
of a message contains something that looks like a header line). So
rather than fix the bug, it is of course the right solution to make it
@@ -16269,7 +16339,6 @@ Translate all @samp{@key{TAB}} characters into @samp{@key{SPC}} characters.
@item nnmail-ignore-broken-references
@findex nnmail-ignore-broken-references
-@c @findex nnmail-fix-eudora-headers
@cindex Eudora
@cindex Pegasus
Some mail user agents (e.g., Eudora and Pegasus) produce broken
@@ -16359,9 +16428,8 @@ If you start using any of the mail back ends, they have the annoying
habit of assuming that you want to read mail with them. This might not
be unreasonable, but it might not be what you want.
-If you set @code{mail-sources} and @code{nnmail-spool-file} to
-@code{nil}, none of the back ends will ever attempt to read incoming
-mail, which should help.
+If you set @code{mail-sources} to @code{nil}, none of the back ends
+will ever attempt to read incoming mail, which should help.
@vindex nnbabyl-get-new-mail
@vindex nnmbox-get-new-mail
@@ -17968,7 +18036,7 @@ This creates a group including all flagged messages from all groups on
two IMAP servers, "home" and "work".
And one last example. Here is a function that runs a search query to
-find all message that have been received recently from certain groups:
+find all messages that have been received recently from certain groups:
@lisp
(defun my-recent-email (args)
@@ -19357,6 +19425,9 @@ and dormant. If @code{nil} (which is the default), only read articles
are eligible for expiry, and unread, ticked and dormant articles will
be kept indefinitely.
+The last (i.e., newest) article in a group will normally not be
+expired (due to internal book-keeping reasons).
+
If you find that some articles eligible for expiry are never expired,
perhaps some Gnus Agent files are corrupted. There's are special
commands, @code{gnus-agent-regenerate} and
@@ -22504,7 +22575,7 @@ to you, using @kbd{G b u} and updating the group will usually fix this.
* Predicate Specifiers:: Specifying predicates.
* Moderation:: What to do if you're a moderator.
* Fetching a Group:: Starting Gnus just to read a group.
-* Image Enhancements:: Modern versions of Emacs can display images.
+* Image Enhancements:: Emacs can display images.
* Fuzzy Matching:: What's the big fuzz?
* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email.
* Spam Package:: A package for filtering and processing spam.
@@ -23667,9 +23738,8 @@ It takes the group name as a parameter.
@node Image Enhancements
@section Image Enhancements
-Emacs 21@footnote{Emacs 21 on MS Windows doesn't
-support images, Emacs 22 does.} and up are able to display pictures and
-stuff, so Gnus has taken advantage of that.
+Emacs is able to display pictures and stuff, so Gnus has taken
+advantage of that.
@menu
* X-Face:: Display a funky, teensy black-and-white image.
@@ -26810,9 +26880,10 @@ but at the common table.@*
If you want to investigate the person responsible for this outrage,
you can point your (feh!) web browser to
-@uref{https://quimby.gnus.org/}. This is also the primary
-distribution point for the new and spiffy versions of Gnus, and is
-known as The Site That Destroys Newsrcs And Drives People Mad.
+@uref{https://quimby.gnus.org/}. This used to be the primary
+distribution point for the new and spiffy versions of Gnus, and was
+known as The Site That Destroys Newsrcs And Drives People Mad, but
+these days Gnus is developed in the Emacs repository.
During the first extended alpha period of development, the new Gnus was
called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index be6c9a419b2..c0e3dfae12d 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -540,6 +540,7 @@ better than you do.
@node System Mailer Setup
@section System Mailer Setup
@cindex mailto:
+@cindex System Mailer
Emacs can be set up as the system mailer, so that Emacs is opened when
you click on @samp{mailto:} links in other programs.
@@ -548,10 +549,11 @@ How this is done varies from system to system, but commonly there's a
way to set the default application for a @acronym{MIME} type, and the
relevant type here is @samp{x-scheme-handler/mailto;}.
-The application to start should be @samp{"emacs -f message-mailto %u"}.
+The application to start should be @w{@samp{emacs -f message-mailto %u}}.
This will start Emacs, and then run the @code{message-mailto}
command. It will parse the given @acronym{URL}, and set up a Message
-buffer with the given parameters.
+buffer with the given parameters. If you prefer to use emacsclient,
+use @w{@samp{emacsclient -e '(message-mailto "%u")'}} as the application.
For instance, @samp{mailto:larsi@@gnus.org?subject=This+is+a+test}
will open a Message buffer with the @samp{To:} header filled in with
@@ -1790,8 +1792,89 @@ member list with elements @code{CC} and @code{To}, then
@code{message-carefully-insert-headers} will not insert a @code{To}
header when the message is already @code{CC}ed to the recipient.
+@item message-syntax-checks
+@vindex message-syntax-checks
+Controls what syntax checks should not be performed on outgoing posts.
+To disable checking of long signatures, for instance, add
+
+@lisp
+(signature . disabled)
+@end lisp
+
+to this list.
+
+Valid checks are:
+
+@table @code
+@item approved
+@cindex approved
+Check whether the article has an @code{Approved} header, which is
+something only moderators should include.
+@item continuation-headers
+Check whether there are continuation header lines that don't begin with
+whitespace.
+@item control-chars
+Check for invalid characters.
+@item empty
+Check whether the article is empty.
+@item existing-newsgroups
+Check whether the newsgroups mentioned in the @code{Newsgroups} and
+@code{Followup-To} headers exist.
+@item from
+Check whether the @code{From} header seems nice.
+@item illegible-text
+Check whether there is any non-printable character in the body.
+@item invisible-text
+Check whether there is any invisible text in the buffer.
+@item long-header-lines
+Check for too long header lines.
+@item long-lines
+@cindex long lines
+Check for too long lines in the body.
+@item message-id
+Check whether the @code{Message-ID} looks syntactically ok.
+@item multiple-headers
+Check for the existence of multiple equal headers.
+@item new-text
+Check whether there is any new text in the messages.
+@item newsgroups
+Check whether the @code{Newsgroups} header exists and is not empty.
+@item quoting-style
+Check whether text follows last quoted portion.
+@item repeated-newsgroups
+Check whether the @code{Newsgroups} and @code{Followup-To} headers
+contains repeated group names.
+@item reply-to
+Check whether the @code{Reply-To} header looks ok.
+@item sender
+@cindex Sender
+Insert a new @code{Sender} header if the @code{From} header looks odd.
+@item sendsys
+@cindex sendsys
+Check for the existence of version and sendsys commands.
+@item shoot
+Check whether the domain part of the @code{Message-ID} header looks ok.
+@item shorten-followup-to
+Check whether to add a @code{Followup-To} header to shorten the number
+of groups to post to.
+@item signature
+Check the length of the signature.
+@item size
+Check for excessive size.
+@item subject
+Check whether the @code{Subject} header exists and is not empty.
+@item subject-cmsg
+Check the subject for commands.
+@item valid-newsgroups
+Check whether the @code{Newsgroups} and @code{Followup-To} headers
+are valid syntactically.
@end table
+All these conditions are checked by default, except for @code{sender}
+for which the check is disabled by default if
+@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
+
+@end table
@node Mail Headers
@section Mail Headers
@@ -2001,7 +2084,7 @@ This optional header will be computed by Message.
@vindex user-mail-address
@findex system-name
@cindex Sun
-@cindex i-did-not-set--mail-host-address--so-tickle-me
+@cindex mail-host-address-is-not-set
This required header will be generated by Message. A unique ID will be
created based on the date, time, user name (for the local part) and the
domain part. For the domain part, message will look (in this order) at
@@ -2070,88 +2153,6 @@ Other variables for customizing outgoing news articles:
@table @code
-@item message-syntax-checks
-@vindex message-syntax-checks
-Controls what syntax checks should not be performed on outgoing posts.
-To disable checking of long signatures, for instance, add
-
-@lisp
-(signature . disabled)
-@end lisp
-
-to this list.
-
-Valid checks are:
-
-@table @code
-@item approved
-@cindex approved
-Check whether the article has an @code{Approved} header, which is
-something only moderators should include.
-@item continuation-headers
-Check whether there are continuation header lines that don't begin with
-whitespace.
-@item control-chars
-Check for invalid characters.
-@item empty
-Check whether the article is empty.
-@item existing-newsgroups
-Check whether the newsgroups mentioned in the @code{Newsgroups} and
-@code{Followup-To} headers exist.
-@item from
-Check whether the @code{From} header seems nice.
-@item illegible-text
-Check whether there is any non-printable character in the body.
-@item invisible-text
-Check whether there is any invisible text in the buffer.
-@item long-header-lines
-Check for too long header lines.
-@item long-lines
-@cindex long lines
-Check for too long lines in the body.
-@item message-id
-Check whether the @code{Message-ID} looks syntactically ok.
-@item multiple-headers
-Check for the existence of multiple equal headers.
-@item new-text
-Check whether there is any new text in the messages.
-@item newsgroups
-Check whether the @code{Newsgroups} header exists and is not empty.
-@item quoting-style
-Check whether text follows last quoted portion.
-@item repeated-newsgroups
-Check whether the @code{Newsgroups} and @code{Followup-To} headers
-contains repeated group names.
-@item reply-to
-Check whether the @code{Reply-To} header looks ok.
-@item sender
-@cindex Sender
-Insert a new @code{Sender} header if the @code{From} header looks odd.
-@item sendsys
-@cindex sendsys
-Check for the existence of version and sendsys commands.
-@item shoot
-Check whether the domain part of the @code{Message-ID} header looks ok.
-@item shorten-followup-to
-Check whether to add a @code{Followup-To} header to shorten the number
-of groups to post to.
-@item signature
-Check the length of the signature.
-@item size
-Check for excessive size.
-@item subject
-Check whether the @code{Subject} header exists and is not empty.
-@item subject-cmsg
-Check the subject for commands.
-@item valid-newsgroups
-Check whether the @code{Newsgroups} and @code{Followup-To} headers
-are valid syntactically.
-@end table
-
-All these conditions are checked by default, except for @code{sender}
-for which the check is disabled by default if
-@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
-
@item message-ignored-news-headers
@vindex message-ignored-news-headers
Regexp of headers to be removed before posting. The default is@*
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 308ea3f34c9..a7c1fed29cb 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -78,7 +78,7 @@ Public License.''
@html
<!--
@end html
-@node Top, Preface, (dir), (dir)
+@node Top
@top The MH-E Manual
@html
-->
@@ -197,7 +197,7 @@ History of MH-E
-->
@end html
-@node Preface, Conventions, Top, Top
+@node Preface
@unnumbered Preface
@cindex Emacs
@@ -272,7 +272,7 @@ Bill Wohler <@i{wohler at newt.com}>@*
8 February 1995@*
24 February 2006
-@node Conventions, Getting Started, Preface, Top
+@node Conventions
@chapter GNU Emacs Terms and Conventions
@cindex Emacs
@@ -513,7 +513,7 @@ you enter something in the minibuffer, but then you change your mind,
type @kbd{C-g} and you'll be back where you started. If you want to
exit Emacs entirely, use @kbd{C-x C-c}.
-@node Getting Started, Tour Through MH-E, Conventions, Top
+@node Getting Started
@chapter Getting Started
@cindex MH-E, versions
@@ -658,7 +658,7 @@ after these variables have been set. This hook can be used the change
the value of these variables if you need to run with different values
between MH and MH-E.
-@node Tour Through MH-E, Using This Manual, Getting Started, Top
+@node Tour Through MH-E
@chapter Tour Through MH-E
@cindex introduction
@@ -684,7 +684,7 @@ get the big picture, and then you can read the manual as you wish.
* More About MH-E::
@end menu
-@node Sending Mail Tour, Reading Mail Tour, Tour Through MH-E, Tour Through MH-E
+@node Sending Mail Tour
@section Sending Mail
@cindex MH-Letter mode
@@ -750,7 +750,7 @@ more complete help with the @kbd{C-h m} (@code{describe-mode})
command.}, but at this time we'll only use @kbd{C-c C-c} to send your
message. Type @kbd{C-c C-c} now. That's all there is to it!
-@node Reading Mail Tour, Processing Mail Tour, Sending Mail Tour, Tour Through MH-E
+@node Reading Mail Tour
@section Receiving Mail
@cindex @command{inc}
@@ -823,7 +823,7 @@ This is a test message to get the wheels churning...
If you typed a long message, you can view subsequent pages with
@key{SPC} and previous pages with @key{DEL}.
-@node Processing Mail Tour, Leaving MH-E, Reading Mail Tour, Tour Through MH-E
+@node Processing Mail Tour
@section Processing Mail
@cindex processing mail
@@ -949,7 +949,7 @@ available via the prefix characters, type the prefix character
followed by a @kbd{?}, for example, @kbd{F ?}. More complete help is
available with the @kbd{C-h m} (@code{describe-mode}) command.
-@node Leaving MH-E, More About MH-E, Processing Mail Tour, Tour Through MH-E
+@node Leaving MH-E
@section Leaving MH-E
@cindex Emacs, quitting
@@ -988,7 +988,7 @@ already exists, so you can use @samp{folders -recurse -fast} in a
script to copy all of your messages into a single file, or using the
@samp{-file} argument, a file for each folder.
-@node More About MH-E, , Leaving MH-E, Tour Through MH-E
+@node More About MH-E
@section More About MH-E
These are the basic commands to get you going, but there are plenty
@@ -1054,7 +1054,7 @@ Place messages in a file (@pxref{Files and Pipes}).
Remember that you can also use MH commands when you're not running
MH-E (and when you are!).
-@node Using This Manual, Incorporating Mail, Tour Through MH-E, Top
+@node Using This Manual
@chapter Using This Manual
This chapter begins the meat of the manual which goes into more detail
@@ -1150,7 +1150,7 @@ your initials. (Unless, of course, your initials happen to be @emph{mh}!)
* Folder Selection::
@end menu
-@node Options, Ranges, Using This Manual, Using This Manual
+@node Options
@section Options
@cindex Emacs, customizing
@@ -1210,7 +1210,7 @@ function. Try entering @kbd{M-x customize-group @key{RET} mh
the MH-E customization groups. Another way to view the MH-E
customization group is to use @kbd{M-x mh-customize @key{RET}}.
-@node Ranges, Folder Selection, Options, Using This Manual
+@node Ranges
@section Ranges
@c Sync with mh-folder-mode docstring.
@@ -1279,7 +1279,7 @@ interpret input such as @samp{200} as @samp{last:200} if the
default). If you need to scan just the message 200, then use the range
@samp{200:1} or @samp{200-200}.
-@node Folder Selection, , Ranges, Using This Manual
+@node Folder Selection
@section Folder Selection
@cindex completion, folders
@@ -1359,7 +1359,7 @@ folder name used is suggested. This is useful if you get mail from
various people for whom you have an alias, but file them all in the
same project folder.
-@node Incorporating Mail, Reading Mail, Using This Manual, Top
+@node Incorporating Mail
@chapter Incorporating Your Mail
@cindex @samp{Folder} menu
@@ -1535,7 +1535,7 @@ the message numbers from outside of MH-E.
@end group
@end smalllisp
-@node Reading Mail, Folders, Incorporating Mail, Top
+@node Reading Mail
@chapter Reading Your Mail
@cindex @samp{+inbox}
@@ -2003,7 +2003,7 @@ detail in the following sections.
* Miscellaneous Commands and Options::
@end menu
-@node Viewing, Viewing Attachments, Reading Mail, Reading Mail
+@node Viewing
@section Viewing Your Mail
@findex mh-header-display
@@ -2276,7 +2276,7 @@ of @code{"@{show-%s@} %d"} yields a mode line of
-----@{show-+inbox@} 4 (MH-Show)--Bot--------------------------------
@end smallexample
-@node Viewing Attachments, HTML, Viewing, Reading Mail
+@node Viewing Attachments
@section Viewing Attachments
@cindex attachments
@@ -2516,7 +2516,7 @@ Article Buttons} and
in the @cite{The Gnus Manual}.
@end ifnotinfo
-@node HTML, Digests, Viewing Attachments, Reading Mail
+@node HTML
@section HTML
@cindex HTML
@@ -2670,7 +2670,7 @@ buffer, including HTML buffers.
(global-set-key [S-mouse-2] 'browse-url-at-mouse)
@end smalllisp
-@node Digests, Reading PGP, HTML, Reading Mail
+@node Digests
@section Digests
@cindex digests
@@ -2714,7 +2714,7 @@ preceded with a @samp{>} so that your reply can't create the
@samp{To:} field yourself. This is described later (@pxref{Editing
Drafts}).
-@node Reading PGP, Printing, Digests, Reading Mail
+@node Reading PGP
@section Signed and Encrypted Messages
@cindex GPG
@@ -2848,7 +2848,7 @@ See
@cite{The PGG Manual}}.
@end ifhtml
-@node Printing, Files and Pipes, Reading PGP, Reading Mail
+@node Printing
@section Printing Your Mail
@cindex printing
@@ -2933,7 +2933,7 @@ If you do this, do not delete the message until it is printed or else
the output may be truncated. These options are not used by the
commands @kbd{P p} or @kbd{P f}.
-@node Files and Pipes, Navigating, Printing, Reading Mail
+@node Files and Pipes
@section Files and Pipes
@cindex files
@@ -2993,7 +2993,7 @@ through @command{uuencode} or @command{shar}. For example, you can
extract the contents of the current buffer in your home directory by
typing @kbd{M-x mh-store-buffer @key{RET} ~ @key{RET}}.
-@node Navigating, Miscellaneous Commands and Options, Files and Pipes, Reading Mail
+@node Navigating
@section Navigating
@cindex moving between messages
@@ -3094,7 +3094,7 @@ The hook @code{mh-delete-msg-hook} is called after you mark a message
for deletion. For example, a past maintainer of MH-E used this once
when he kept statistics on his mail usage.
-@node Miscellaneous Commands and Options, , Navigating, Reading Mail
+@node Miscellaneous Commands and Options
@section Miscellaneous Commands and Options
This section contains a few more miscellaneous commands and options.
@@ -3207,7 +3207,7 @@ displayed or @code{mh-rmail} is run, and the MH-E window configuration
is shown. Otherwise, the MH-E window configuration is saved and the
original configuration is displayed.
-@node Folders, Sending Mail, Reading Mail, Top
+@node Folders
@chapter Organizing Your Mail with Folders
@cindex @samp{Folder} menu
@@ -3842,7 +3842,7 @@ running dired on my mail directory (@kbd{M-x dired @key{RET} ~/Mail
@key{RET}}), moving my cursor to @samp{out} and using the command
@kbd{R} (@code{dired-do-rename}).
-@node Sending Mail, Editing Drafts, Folders, Top
+@node Sending Mail
@chapter Sending Mail
@cindex sending mail
@@ -4002,7 +4002,7 @@ more detail in the following sections.
* Editing Again::
@end menu
-@node Composing, Replying, Sending Mail, Sending Mail
+@node Composing
@section Composing
@cindex @file{.emacs}
@@ -4125,7 +4125,7 @@ is that you can write a function to write and send the message for
you. This function is passed three arguments: the contents of the
@samp{To:}, @samp{Subject:}, and @samp{Cc:} header fields.
-@node Replying, Forwarding, Composing, Sending Mail
+@node Replying
@section Replying to Mail
@cindex @command{mhl}
@@ -4221,7 +4221,7 @@ buffer by turning off the option @code{mh-reply-show-message-flag}.
If you wish to customize the header or other parts of the reply draft,
please see @command{repl}(1) and @code{mh-format}(5).
-@node Forwarding, Redistributing, Replying, Sending Mail
+@node Forwarding
@section Forwarding Mail
@cindex @command{forw}
@@ -4283,7 +4283,7 @@ and creates a subject header field of:
Subject: Greg DesBrisay: Re: 49er football
@end smallexample
-@node Redistributing, Editing Again, Forwarding, Sending Mail
+@node Redistributing
@section Redistributing Your Mail
@cindex @command{dist}
@@ -4323,7 +4323,7 @@ a message that has been redistributed before, turn off this option.
The hook @code{mh-annotate-msg-hook} is run after annotating the
message and scan line (@pxref{Sending Mail}).
-@node Editing Again, , Redistributing, Sending Mail
+@node Editing Again
@section Editing Old Drafts and Bounced Messages
@cindex @file{draft}
@@ -4359,7 +4359,7 @@ the message for editing by removing the @i{Mailer-Daemon} envelope and
unneeded header fields. Fix whatever addressing problem you had, and
send the message again with @kbd{C-c C-c}.
-@node Editing Drafts, Aliases, Sending Mail, Top
+@node Editing Drafts
@chapter Editing a Draft
@cindex @samp{Letter} menu
@@ -4754,7 +4754,7 @@ detail in the following sections.
* Killing Draft::
@end menu
-@node Editing Message, Inserting Letter, Editing Drafts, Editing Drafts
+@node Editing Message
@section Editing the Message
@cindex @samp{Bcc} header field
@@ -4929,7 +4929,7 @@ the first period in the paragraph above, the result would be this:
@end group
@end smallexample
-@node Inserting Letter, Inserting Messages, Editing Message, Editing Drafts
+@node Inserting Letter
@section Inserting Letter to Which You're Replying
@cindex inserting messages
@@ -5055,7 +5055,7 @@ For example, if you use the hook function
@code{trivial-cite}} (which is NOT part of Emacs), set
@code{mh-yank-behavior} to @samp{Body and Header}.
-@node Inserting Messages, Signature, Inserting Letter, Editing Drafts
+@node Inserting Messages
@section Inserting Messages
@cindex inserting messages
@@ -5081,7 +5081,7 @@ left intact, the message is not indented, and @samp{> } is not
inserted before each line. This command leaves the mark before the
letter and point after it.
-@node Signature, Picture, Inserting Messages, Editing Drafts
+@node Signature
@section Inserting Your Signature
@cindex signature
@@ -5136,7 +5136,7 @@ function used to insert the signature with
The signature can also be inserted using Identities.
@xref{Identities}.
-@node Picture, Adding Attachments, Signature, Editing Drafts
+@node Picture
@section Inserting Your Picture
@cindex @file{.face}
@@ -5186,7 +5186,7 @@ defined by this option doesn't exist.
@xref{Viewing}, to see how these header fields are displayed in MH-E.
-@node Adding Attachments, Sending PGP, Picture, Editing Drafts
+@node Adding Attachments
@section Adding Attachments
@cindex @command{mhbuild}
@@ -5530,7 +5530,7 @@ prefix argument (as in @kbd{C-u C-c C-e}).
The hook @code{mh-mh-to-mime-hook} is called after the message has
been formatted by @kbd{C-c C-e}.
-@node Sending PGP, Checking Recipients, Adding Attachments, Editing Drafts
+@node Sending PGP
@section Signing and Encrypting Messages
@cindex signing messages
@@ -5621,7 +5621,7 @@ all messages I encrypt are encrypted with my public key as well. If
you keep a copy of all of your outgoing mail with a @samp{Fcc:} header
field, this setting is vital so that you can read the mail you write!
-@node Checking Recipients, Sending Message, Sending PGP, Editing Drafts
+@node Checking Recipients
@section Checking Recipients
@cindex @file{*MH-E Recipients*}
@@ -5640,7 +5640,7 @@ you can check the actual address(es) in the alias. A new buffer named
@uref{@value{MH-BOOK-HOME}/senove.html#WhaPro, What now?---and the
whatnow Program} in the MH book.}.
-@node Sending Message, Killing Draft, Checking Recipients, Editing Drafts
+@node Sending Message
@section Sending a Message
@cindex buffers, @file{*MH-E Mail Delivery*}
@@ -5678,7 +5678,7 @@ in the MH book.} is installed under a different name, use
The hook @code{mh-annotate-msg-hook} is run after annotating the
message and scan line (@pxref{Sending Mail}).
-@node Killing Draft, , Sending Message, Editing Drafts
+@node Killing Draft
@section Killing the Draft
@cindex killing draft
@@ -5692,7 +5692,7 @@ command @kbd{C-c C-q} (@code{mh-fully-kill-draft}) to kill the draft
buffer and delete the draft message. Use the command @kbd{C-x k}
(@code{kill-buffer}) if you don't want to delete the draft message.
-@node Aliases, Identities, Editing Drafts, Top
+@node Aliases
@chapter Aliases
@cindex aliases
@@ -6019,7 +6019,7 @@ Syntax of Regular Expressions} in
@cite{The GNU Emacs Manual}).
@end ifhtml
-@node Identities, Speedbar, Aliases, Top
+@node Identities
@chapter Identities
@cindex identities
@@ -6256,7 +6256,7 @@ example, @samp{:signature}), and the action @samp{'remove} or
@samp{'add}. If the action is @samp{'add}, an additional argument
containing the value for the field is given.
-@node Speedbar, Menu Bar, Identities, Top
+@node Speedbar
@chapter The Speedbar
@cindex folder navigation
@@ -6354,7 +6354,7 @@ Selected folder face.
Selected folder face when folder contains unread messages.
@end vtable
-@node Menu Bar, Tool Bar, Speedbar, Top
+@node Menu Bar
@chapter The Menu Bar
@cindex @samp{Folder} menu
@@ -6414,7 +6414,7 @@ manual in two ways: all of the menu items are listed alphabetically,
and you can also browse all of the items under the index entry
@samp{menu item}.
-@node Tool Bar, Searching, Menu Bar, Top
+@node Tool Bar
@chapter The Tool Bar
@cindex tool bar
@@ -6498,7 +6498,7 @@ variable is set to anything other than @samp{Same As Default Tool Bar}
and the default tool bar is in a different location, then two tool
bars will be displayed: the MH-E tool bar and the default tool bar.
-@node Searching, Threading, Tool Bar, Top
+@node Searching
@chapter Searching Through Messages
@cindex @samp{Search} menu
@@ -7037,7 +7037,7 @@ MH-Search buffer. Instead, you simply enter a regular expression in
the minibuffer. For help in constructing regular expressions, see your
man page for @command{grep}.
-@node Threading, Limits, Searching, Top
+@node Threading
@chapter Viewing Message Threads
@cindex threading
@@ -7166,7 +7166,7 @@ ensure that the byte-compiled version appears first in the
installed MH-E yourself, please refer to the installation directions
in the file @file{README} in the distribution.}.
-@node Limits, Sequences, Threading, Top
+@node Limits
@chapter Limiting Display
@cindex limits
@@ -7274,7 +7274,7 @@ command to limit the display to messages in a range (@pxref{Ranges}).
Each limit can be undone in turn with the @kbd{/ w} (@code{mh-widen})
command. Give this command a prefix argument to remove all limits.
-@node Sequences, Junk, Limits, Top
+@node Sequences
@chapter Using Sequences
@cindex @samp{Sequence} menu
@@ -7383,8 +7383,8 @@ The name of the MH sequence for ticked messages (default: @samp{'tick}).
@item mh-update-sequences-after-mh-show-flag
On means flush MH sequences to disk after message is shown (default:
@samp{on}).
-@item mh-whitelist-preserves-sequences-flag
-On means that sequences are preserved when messages are whitelisted
+@item mh-allowlist-preserves-sequences-flag
+On means that sequences are preserved when messages are allowlisted
(default: @samp{on}).
@end vtable
@@ -7528,7 +7528,7 @@ command dealing with sequences is @command{mark}@footnote{See the
section @uref{@value{MH-BOOK-HOME}/mmbwm.html, Make Message Bookmarks
with mark} in the MH book.}.
-@node Junk, Miscellaneous, Sequences, Top
+@node Junk
@chapter Dealing With Junk Mail
@cindex Marshall Rose
@@ -7540,17 +7540,17 @@ Marshall Rose once wrote a paper on MH entitled, @cite{How to process
could be entitled, @cite{How to process 1000 spams a day and still get
some real work done}.
-@cindex blacklisting
+@cindex blocklisting
@cindex ham
@cindex viruses
-@cindex whitelisting
+@cindex allowlisting
@cindex worms
We use the terms @dfn{junk mail} and @dfn{spam} interchangeably for
any unwanted message which includes spam, @dfn{viruses}, and
@dfn{worms}. The opposite of spam is @dfn{ham}. The act of classifying
-a sender as one who sends junk mail is called @dfn{blacklisting}; the
-opposite is called @dfn{whitelisting}.
+a sender as one who sends junk mail is called @dfn{blocklisting}; the
+opposite is called @dfn{allowlisting}.
@table @kbd
@kindex J ?
@@ -7560,14 +7560,14 @@ Display cheat sheet for the commands of the current prefix in
minibuffer (@code{mh-prefix-help}).
@c -------------------------
@kindex J b
-@findex mh-junk-blacklist
+@findex mh-junk-blocklist
@item J b
-Blacklist range as spam (@code{mh-junk-blacklist}).
+Blocklist range as spam (@code{mh-junk-blocklist}).
@c -------------------------
-@kindex J w
-@findex mh-junk-whitelist
-@item J w
-Whitelist range as ham (@code{mh-junk-whitelist}).
+@kindex J a
+@findex mh-junk-allowlist
+@item J a
+Allowlist range as ham (@code{mh-junk-allowlist}).
@c -------------------------
@item @code{mh-spamassassin-identify-spammers}
Identify spammers who are repeat offenders.
@@ -7597,31 +7597,31 @@ The following option in the @samp{mh-sequences} customization group is
also available.
@vtable @code
-@item mh-whitelist-preserves-sequences-flag
-On means that sequences are preserved when messages are whitelisted
+@item mh-allowlist-preserves-sequences-flag
+On means that sequences are preserved when messages are allowlisted
(default: @samp{on}).
@end vtable
The following hooks are available.
@vtable @code
-@item mh-blacklist-msg-hook
-Hook run by @kbd{J b} (@code{mh-junk-blacklist}) after marking each
-message for blacklisting (default: @code{nil}).
+@item mh-blocklist-msg-hook
+Hook run by @kbd{J b} (@code{mh-junk-blocklist}) after marking each
+message for blocklisting (default: @code{nil}).
@c -------------------------
-@item mh-whitelist-msg-hook
-Hook run by @kbd{J w} (@code{mh-junk-whitelist}) after marking each
-message for whitelisting (default @samp{nil}).
+@item mh-allowlist-msg-hook
+Hook run by @kbd{J a} (@code{mh-junk-allowlist}) after marking each
+message for allowlisting (default @samp{nil}).
@end vtable
The following faces are available.
@vtable @code
-@item mh-folder-blacklisted
-Blacklisted message face.
+@item mh-folder-blocklisted
+Blocklisted message face.
@c -------------------------
-@item mh-folder-whitelisted
-Whitelisted message face
+@item mh-folder-allowlisted
+Allowlisted message face
@end vtable
@cindex SpamProbe
@@ -7647,21 +7647,21 @@ example, you have both SpamAssassin and bogofilter installed and you
want to use bogofilter, then you can set this option to
@samp{Bogofilter}.
-@findex mh-junk-blacklist
+@findex mh-junk-blocklist
@kindex J b
@vindex mh-junk-disposition
-The command @kbd{J b} (@code{mh-junk-blacklist}) trains the spam
+The command @kbd{J b} (@code{mh-junk-blocklist}) trains the spam
program in use with the content of the range (@pxref{Ranges}) and then
handles the message(s) as specified by the option
@code{mh-junk-disposition}. By default, this option is set to
@samp{Delete Spam} but you can also specify the name of the folder
which is useful for building a corpus of spam for training purposes.
-@findex mh-junk-whitelist
-@kindex J w
+@findex mh-junk-allowlist
+@kindex J a
-In contrast, the command @kbd{J w} (@code{mh-junk-whitelist})
+In contrast, the command @kbd{J a} (@code{mh-junk-allowlist})
reclassifies a range of messages (@pxref{Ranges}) as ham if it were
incorrectly classified as spam. It then refiles the message into the
@file{+inbox} folder.
@@ -7671,12 +7671,12 @@ incorrectly classified as spam. It then refiles the message into the
@cindex @samp{Previous-Sequence} MH profile component
@cindex sequence, @samp{cur}
@cindex sequence, @samp{Previous-Sequence}
-@vindex mh-whitelist-preserves-sequences-flag
+@vindex mh-allowlist-preserves-sequences-flag
If a message is in any sequence (except @samp{Previous-Sequence:} and
-@samp{cur}) when it is whitelisted, then it will still be in those
+@samp{cur}) when it is allowlisted, then it will still be in those
sequences in the destination folder. If this behavior is not desired,
-then turn off the option @code{mh-whitelist-preserves-sequences-flag}.
+then turn off the option @code{mh-allowlist-preserves-sequences-flag}.
@cindex @file{*MH-E Log*}
@cindex buffers, @file{*MH-E Log*}
@@ -7687,7 +7687,7 @@ By default, the programs are run in the foreground, but this can be
slow when junking large numbers of messages. If you have enough memory
or don't junk that many messages at the same time, you might try
turning on the option @code{mh-junk-background}. @footnote{Note that
-the option @code{mh-junk-background} is used as the @code{display}
+the option @code{mh-junk-background} is used as the @code{destination}
argument in the call to @code{call-process}. Therefore, turning on
this option means setting its value to @samp{0}. You can also set its
value to @samp{t} to direct the programs' output to the @file{*MH-E
@@ -7756,33 +7756,33 @@ the @samp{+spam} folder for later review. The major weakness of
rules-based filters is a plethora of false positives so it is
worthwhile to check.
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If SpamAssassin classifies a message incorrectly, or is unsure, you can
-use the MH-E commands @kbd{J b} (@code{mh-junk-blacklist}) and
-@kbd{J w} (@code{mh-junk-whitelist}).
+use the MH-E commands @kbd{J b} (@code{mh-junk-blocklist}) and
+@kbd{J a} (@code{mh-junk-allowlist}).
@cindex @command{sa-learn}
@cindex @file{.spamassassin/user_prefs}
@cindex files, @file{.spamassassin/user_prefs}
-The command @kbd{J b} (@code{mh-junk-blacklist}) adds a
+The command @kbd{J b} (@code{mh-junk-blocklist}) adds a
@samp{blacklist_from} entry to @file{~/spamassassin/user_prefs},
deletes the message, and sends the message to the Razor, so that
others might not see this spam. If the @command{sa-learn} command is
available, the message is also recategorized as spam.
-The command@kbd{J w} (@code{mh-junk-whitelist}) adds a
+The command@kbd{J a} (@code{mh-junk-allowlist}) adds a
@samp{whitelist_from} rule to @samp{~/.spamassassin/user_prefs}. If
the @command{sa-learn} command is available, the message is also
recategorized as ham.
Over time, you'll observe that the same host or domain occurs
repeatedly in the @samp{blacklist_from} entries, so you might think
-that you could avoid future spam by blacklisting all mail from a
+that you could avoid future spam by blocklisting all mail from a
particular domain. The utility function
@code{mh-spamassassin-identify-spammers} helps you do precisely that.
This function displays a frequency count of the hosts and domains in
@@ -7796,7 +7796,7 @@ blacklist_from *@@*amazingoffersdirect2u.com
@end smallexample
In versions of SpamAssassin (2.50 and on) that support a Bayesian
-classifier, @kbd{J b} @code{(mh-junk-blacklist}) uses the program
+classifier, @kbd{J b} @code{(mh-junk-blocklist}) uses the program
@command{sa-learn} to recategorize the message as spam. Neither MH-E,
nor SpamAssassin, rebuilds the database after adding words, so you
will need to run @samp{sa-learn --rebuild} periodically. This can be
@@ -7856,14 +7856,14 @@ spam/.
spam/unsure/.
@end smallexample
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If bogofilter classifies a message incorrectly, or is unsure, you can
-use the MH-E commands @kbd{J b} (@code{mh-junk-blacklist}) and @kbd{J
-w} (@code{mh-junk-whitelist}) to update bogofilter's training.
+use the MH-E commands @kbd{J b} (@code{mh-junk-blocklist}) and
+@kbd{J a} (@code{mh-junk-allowlist}) to update bogofilter's training.
The @cite{Bogofilter FAQ} suggests that you run the following
occasionally to shrink the database:
@@ -7908,14 +7908,14 @@ SCORE=| spamprobe receive
spam/.
@end smallexample
-@findex mh-junk-blacklist
-@findex mh-junk-whitelist
+@findex mh-junk-blocklist
+@findex mh-junk-allowlist
@kindex J b
-@kindex J w
+@kindex J a
If SpamProbe classifies a message incorrectly, you can use the MH-E
-commands @kbd{J b} (@code{mh-junk-blacklist}) and @kbd{J w}
-(@code{mh-junk-whitelist}) to update SpamProbe's training.
+commands @kbd{J b} (@code{mh-junk-blocklist}) and @kbd{J a}
+(@code{mh-junk-allowlist}) to update SpamProbe's training.
@subheading Other Things You Can Do
@@ -7966,7 +7966,7 @@ spam/unreadable/.
spam/unreadable/.
@end smallexample
-@node Miscellaneous, Scan Line Formats, Junk, Top
+@node Miscellaneous
@chapter Miscellaneous Commands, Variables, and Buffers
This chapter covers the following command and the various MH-E
@@ -8053,7 +8053,7 @@ it is hidden because the first character in the name is a space.
You'll generally not have any need for this buffer.
@end table
-@node Scan Line Formats, Procmail, Miscellaneous, Top
+@node Scan Line Formats
@appendix Scan Line Formats
@cindex scan line formats
@@ -8521,7 +8521,7 @@ Finally, add the following to delete and refile messages.
This is just a bare minimum; it's best to adjust all of the regular
expressions to ensure that MH-E and highlighting perform well.
-@node Procmail, Odds and Ends, Scan Line Formats, Top
+@node Procmail
@appendix Reading Mailing Lists Effectively
@cindex @command{procmail}
@@ -8680,7 +8680,7 @@ example above, you would tell Gnus about it the first time only with
@kbd{G m gnucash @key{RET} nnml @key{RET}}. In MH-E, this folder is
known as @samp{+gnucash}.
-@node Odds and Ends, History, Procmail, Top
+@node Odds and Ends
@appendix Odds and Ends
This appendix covers a few topics that don't fit elsewhere. Here I
@@ -8694,7 +8694,7 @@ I also point out some additional sources of information.
* Getting MH-E::
@end menu
-@node Bug Reports, Mailing Lists, Odds and Ends, Odds and Ends
+@node Bug Reports
@appendixsec Bug Reports
@cindex bugs
@@ -8708,7 +8708,7 @@ to do that it shouldn't be a restriction for you. Please include the
output of @kbd{M-x mh-version} (@pxref{Miscellaneous}) in any bug
report you send unless you're 110% positive we won't ask for it.
-@node Mailing Lists, MH FAQ and Support, Bug Reports, Odds and Ends
+@node Mailing Lists
@appendixsec MH-E Mailing Lists
@cindex SourceForge
@@ -8721,7 +8721,7 @@ the archives at @uref{https://sourceforge.net/p/mh-e/mailman/,
SourceForge}. Do not report bugs on these lists; please submit them
via SourceForge (@pxref{Bug Reports}).
-@node MH FAQ and Support, Getting MH-E, Mailing Lists, Odds and Ends
+@node MH FAQ and Support
@appendixsec MH FAQ and Support
@cindex FAQ
@@ -8740,7 +8740,7 @@ You can find FAQs on MH-E by searching for @i{labels:support} on the
Tickets} page on SourceForge. If you don't find the answer to your
question, file a ticket and your question will become a new FAQ!
-@node Getting MH-E, , MH FAQ and Support, Odds and Ends
+@node Getting MH-E
@appendixsec Getting MH-E
@cindex MH-E, obtaining
@@ -8795,7 +8795,7 @@ also contains doc and contrib packages. The former is the latest
release of this manual, and the latter contains a few contributed
packages you might find useful.
-@node History, GFDL, Odds and Ends, Top
+@node History
@appendix History of MH-E
@cindex Bill Wohler
@@ -8826,7 +8826,7 @@ lives today.
* From Bill Wohler::
@end menu
-@node From Brian Reid, From Jim Larus, History, History
+@node From Brian Reid
@appendixsec From Brian Reid
@cindex Brian Reid
@@ -8858,7 +8858,7 @@ the ideas as well. Perhaps one day, MH-E will again resemble MHE
Brian Reid, June 1994
-@node From Jim Larus, From Stephen Gildea, From Brian Reid, History
+@node From Jim Larus
@appendixsec From Jim Larus
@cindex Jim Larus
@@ -8904,7 +8904,7 @@ since then.
Jim Larus, June 1994
-@node From Stephen Gildea, From Bill Wohler, From Jim Larus, History
+@node From Stephen Gildea
@appendixsec From Stephen Gildea
@cindex Gildea, Stephen
@@ -8946,7 +8946,7 @@ version 5 was released.
Stephen Gildea, June 1994
-@node From Bill Wohler, , From Stephen Gildea, History
+@node From Bill Wohler
@appendixsec From Bill Wohler
@cindex Wohler, Bill
@@ -8993,27 +8993,27 @@ new features and several bug fixes.
Bill Wohler, August 2008
-@node GFDL, GPL, History, Top
+@node GFDL
@appendix GNU Free Documentation License
@include doclicense.texi
-@node GPL, Key Index, GFDL, Top
+@node GPL
@appendix GNU General Public License
@include gpl.texi
-@node Key Index, Command Index, GPL, Top
+@node Key Index
@unnumbered Key (Character) Index
@printindex ky
-@node Command Index, Option Index, Key Index, Top
+@node Command Index
@unnumbered Command Index
@printindex fn
-@node Option Index, Concept Index, Command Index, Top
+@node Option Index
@unnumbered Option (Variable) Index
@printindex vr
-@node Concept Index, , Option Index, Top
+@node Concept Index
@unnumbered Concept Index
@printindex cp
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
new file mode 100644
index 00000000000..5bb230f892a
--- /dev/null
+++ b/doc/misc/modus-themes.org
@@ -0,0 +1,4677 @@
+#+title: Modus themes for GNU Emacs
+#+author: Protesilaos Stavrou
+#+email: info@protesilaos.com
+#+language: en
+#+options: ':t toc:nil author:t email:t num:t
+#+startup: content
+
+#+macro: stable-version 1.5.0
+#+macro: release-date 2021-07-15
+#+macro: development-version 1.6.0-dev
+#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
+#+macro: space @@texinfo:@: @@
+#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
+
+#+texinfo_filename: modus-themes.info
+#+texinfo_dir_category: Emacs misc features
+#+texinfo_dir_title: Modus Themes: (modus-themes)
+#+texinfo_dir_desc: Highly accessible themes (WCAG AAA)
+#+texinfo_header: @set MAINTAINERSITE @uref{https://protesilaos.com,maintainer webpage}
+#+texinfo_header: @set MAINTAINER Protesilaos Stavrou
+#+texinfo_header: @set MAINTAINEREMAIL @email{info@protesilaos.com}
+#+texinfo_header: @set MAINTAINERCONTACT @uref{mailto:info@protesilaos.com,contact the maintainer}
+
+#+texinfo: @insertcopying
+
+This manual, written by Protesilaos Stavrou, describes the customization
+options for the ~modus-operandi~ and ~modus-vivendi~ themes, and provides
+every other piece of information pertinent to them.
+
+The documentation furnished herein corresponds to stable version
+{{{stable-version}}}, released on {{{release-date}}}. Any reference to a newer
+feature which does not yet form part of the latest tagged commit, is
+explicitly marked as such.
+
+Current development target is {{{development-version}}}.
+
+#+toc: headlines 8 insert TOC here, with eight headline levels
+
+* COPYING
+:properties:
+:copying: t
+:custom_id: h:b14c3fcb-13dd-4144-9d92-2c58b3ed16d3
+:end:
+
+Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+#+begin_quote
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being “A GNU Manual,” and
+with the Back-Cover Texts as in (a) below. A copy of the license is
+included in the section entitled “GNU Free Documentation License.”
+
+(a) The FSF’s Back-Cover Text is: “You have the freedom to copy and
+modify this GNU manual.”
+#+end_quote
+
+* Overview
+:properties:
+:custom_id: h:f0f3dbcb-602d-40cf-b918-8f929c441baf
+:end:
+
+The Modus themes are designed for accessible readability. They conform
+with the highest standard for color contrast between any given
+combination of background and foreground values. This corresponds to
+the WCAG AAA standard, which specifies a minimum rate of distance in
+relative luminance of 7:1.
+
+Modus Operandi (~modus-operandi~) is a light theme, while Modus Vivendi
+(~modus-vivendi~) is dark. Each theme's color palette is designed to meet
+the needs of the numerous interfaces that are possible in the Emacs
+computing environment.
+
+The overarching objective of this project is to always offer accessible
+color combinations. There shall never be a compromise on this
+principle. If there arises an inescapable trade-off between readability
+and stylistic considerations, we will always opt for the former.
+
+To ensure that users have a consistently accessible experience, the
+themes strive to achieve as close to full face coverage as possible
+([[#h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19][Face coverage]]).
+
+Furthermore, the themes are designed to empower users with red-green
+color deficiency (deuteranopia). This is achieved through customization
+options which have the effect of replacing all relevant instances of
+green with a variant of blue ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
+
+Starting with version 0.12.0 and onwards, the themes are built into GNU
+Emacs.
+
+** How do the themes look like
+:properties:
+:custom_id: h:69b92089-069c-4ba1-9d94-cc3415fc4f87
+:end:
+#+cindex: Screenshots
+
+Check the web page with [[https://protesilaos.com/modus-themes-pictures/][the screen shots]]. There are lots of scenarios
+on display that draw attention to details and important aspects in the
+design of the themes. They also showcase the numerous customization
+options.
+
+[[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization options]].
+
+** Learn about the latest changes
+:properties:
+:custom_id: h:2cc37c36-6c1a-48b2-a010-1050b270ee18
+:end:
+#+cindex: Changelog
+
+Please refer to the [[https://protesilaos.com/modus-themes-changelog][web page with the change log]]. It is comprehensive
+and covers everything that goes into every tagged release of the themes.
+
+* Installation
+:properties:
+:custom_id: h:1af85373-7f81-4c35-af25-afcef490c111
+:end:
+
+The Modus themes are distributed with Emacs starting with version 28.1.
+On older versions of Emacs, they can be installed using Emacs' package
+manager or manually from their code repository. There also exist
+packages for distributions of GNU/Linux.
+
+** Install manually from source
+:properties:
+:custom_id: h:da3414b7-1426-46b8-8e76-47b845b76fd0
+:end:
+
+In the following example, we are assuming that your Emacs files are
+stored in =~/.emacs.d= and that you want to place the Modus themes in
+=~/.emacs.d/modus-themes=.
+
+1. Get the source and store it in the desired path by running the
+ following in the command line shell:
+
+: $ git clone https://gitlab.com/protesilaos/modus-themes.git ~/.emacs.d/modus-themes
+
+2. Add that path to your known Elisp libraries' list, by placing this
+ snippet of Emacs Lisp in your init file (e.g. {{{file(init.el)}}}):
+
+#+begin_src emacs-lisp
+(add-to-list 'load-path "~/.emacs.d/modus-themes")
+#+end_src
+
+The themes are now ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]].
+
+** Install from the archives
+:properties:
+:custom_id: h:c4b10085-149f-43e2-bd4d-347f33aee054
+:end:
+
+The ~modus-themes~ package is available from the GNU ELPA archive, which
+is configured by default.
+
+Prior to querying any package archive, make sure to have updated the
+index, with {{{kbd(M-x package-refresh-contents)}}}. Then all you need to do
+is type {{{kbd(M-x package-install)}}} and specify the ~modus-themes~.
+
+Note that older versions of the themes used to be distributed as
+standalone packages. This practice has been discontinued starting with
+version 1.0.0 of this project.
+
+Once installed, the themes are ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]].
+
+** Install on GNU/Linux
+:properties:
+:custom_id: h:da640eb1-95dd-4e86-bb4e-1027b27885f0
+:end:
+
+The themes are also available from the archives of some distributions of
+GNU/Linux. These should correspond to a tagged release rather than
+building directly from the latest Git commit. It all depends on the
+distro's packaging policies.
+
+*** Debian 11 Bullseye
+:properties:
+:custom_id: h:7e570360-9ee6-4bc5-8c04-9dc11418a3e4
+:end:
+
+The themes are part of Debian 11 Bullseye. Get them with:
+
+#+begin_src sh
+sudo apt install elpa-modus-themes
+#+end_src
+
+They are now ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]].
+
+*** GNU Guix
+:properties:
+:custom_id: h:a4ca52cd-869f-46a5-9e16-4d9665f5b88e
+:end:
+
+Users of Guix can get the themes with this command:
+
+#+begin_src sh
+guix package -i emacs-modus-themes
+#+end_src
+
+They are now ready to be used: [[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]].
+
+* Enable and load
+:properties:
+:custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9
+:end:
+#+findex: modus-themes-load-themes
+#+findex: modus-themes-toggle
+#+findex: modus-themes-load-operandi
+#+findex: modus-themes-load-vivendi
+#+cindex: Essential configuration
+#+vindex: modus-themes-after-load-theme-hook
+
+Users of the built-in themes can load and automatically enable the theme
+of their preference by adding either form to their init file:
+
+#+begin_src emacs-lisp
+(load-theme 'modus-operandi) ; Light theme
+(load-theme 'modus-vivendi) ; Dark theme
+#+end_src
+
+This is all one needs.
+
+Users of packaged variants of the themes must add a few more lines to
+ensure that everything works as intended. First, one has to require the
+main library before loading either theme:
+
+#+begin_src emacs-lisp
+(require 'modus-themes)
+#+end_src
+
+Then it is recommended to load the individual theme files with the
+helper function ~modus-themes-load-themes~:
+
+#+begin_src emacs-lisp
+;; Load the theme files before enabling a theme (else you get an error).
+(modus-themes-load-themes)
+#+end_src
+
+Once the libraries that define the themes are enabled, one can activate
+a theme with either of the following expressions:
+
+#+begin_src emacs-lisp
+(modus-themes-load-operandi) ; Light theme
+;; OR
+(modus-themes-load-vivendi) ; Dark theme
+#+end_src
+
+Changes to the available customization options must always be evaluated
+before loading a theme ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]). An exception to this
+norm is when using the various Custom interfaces or with commands like
+{{{kbd(M-x customize-set-variable)}}}, which automatically reload the theme by
+default ([[#h:9001527a-4e2c-43e0-98e8-3ef72d770639][Option for inhibiting theme reload]]). This is how a basic setup
+could look like:
+
+#+begin_src emacs-lisp
+(require 'modus-themes)
+
+;; Your customisations here. For example:
+(setq modus-themes-bold-constructs t
+ modus-themes-mode-line '3d)
+
+;; Load the theme files before enabling a theme (else you get an error).
+(modus-themes-load-themes)
+
+;; Enable the theme of your preference:
+(modus-themes-load-operandi)
+
+;; Optionally add a key binding for the toggle between the themes:
+(define-key global-map (kbd "<f5>") #'modus-themes-toggle)
+#+end_src
+
+[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration for use-package]].
+
+With those granted, bear in mind a couple of technical points on
+~modus-themes-load-operandi~ and ~modus-themes-load-vivendi~, as well as
+~modus-themes-toggle~ which relies on them:
+
+1. Those functions call ~load-theme~. Some users prefer to opt for
+ ~enable-theme~ instead ([[#h:e68560b3-7fb0-42bc-a151-e015948f8a35][Differences between loading and enabling]]).
+
+2. The functions will run the ~modus-themes-after-load-theme-hook~ as
+ their final step. This can be employed for bespoke configurations
+ ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization (do-it-yourself)]]). Experienced users may not
+ wish to rely on such a hook and the functions that run it: they may
+ prefer a custom solution ([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]]).
+
+** Sample configuration for use-package
+:properties:
+:custom_id: h:e979734c-a9e1-4373-9365-0f2cd36107b8
+:end:
+#+cindex: use-package configuration
+
+It is common for Emacs users to rely on ~use-package~ for declaring
+package configurations in their setup. We use this as an example:
+
+#+begin_src emacs-lisp
+(use-package modus-themes
+ :ensure ; omit this to use the built-in themes
+ :init
+ ;; Add all your customizations prior to loading the themes
+ (setq modus-themes-italic-constructs t
+ modus-themes-bold-constructs nil
+ modus-themes-region '(bg-only no-extend))
+
+ ;; Load the theme files before enabling a theme (else you get an error).
+ (modus-themes-load-themes)
+ :config
+ ;; Load the theme of your choice:
+ (modus-themes-load-operandi) ;; OR (modus-themes-load-vivendi)
+ :bind ("<f5>" . modus-themes-toggle))
+#+end_src
+
+[[#h:e68560b3-7fb0-42bc-a151-e015948f8a35][Differences between loading and enabling]].
+
+Note: make sure not to customize the variable ~custom-theme-load-path~
+or ~custom-theme-directory~ after the themes' package declaration. That
+will lead to failures in loading the files. If either or both of those
+variables need to be changed, their values should be defined before the
+package declaration of the themes.
+
+** Differences between loading and enabling
+:properties:
+:custom_id: h:e68560b3-7fb0-42bc-a151-e015948f8a35
+:end:
+#+cindex: load-theme VS enable-theme
+
+The reason we recommend ~load-theme~ instead of the other option of
+~enable-theme~ is that the former does a kind of "reset" on the face
+specs. It quite literally loads (or re-loads) the theme. Whereas the
+latter simply puts an already loaded theme at the top of the list of
+enabled items, re-using whatever state was last loaded.
+
+As such, ~load-theme~ reads all customizations that may happen during
+any given Emacs session: even after the initial setup of a theme.
+Examples are calls to ~custom-set-faces~, as well as new values assigned
+to the options the Modus themes provide ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
+
+Our tests show that ~enable-theme~ does not read such variables anew, so
+it might appear to the unsuspecting user that the themes are somehow
+broken whenever they try to assign a new value to a customization option
+or some face.
+
+This "reset" that ~load-theme~ conducts does, however, come at the cost
+of being somewhat slower than ~enable-theme~. Users who have a stable
+setup and who seldom update their variables during a given Emacs
+session, are better off using something like this:
+
+#+begin_src emacs-lisp
+(require 'modus-themes)
+(load-theme 'modus-operandi t t)
+(load-theme 'modus-vivendi t t)
+
+(enable-theme 'modus-operandi) ;; OR (enable-theme 'modus-vivendi)
+#+end_src
+
+[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration for use-package]].
+
+With the above granted, other sections of the manual discuss how to
+configure custom faces, where ~load-theme~ is expected, though
+~enable-theme~ could still apply in stable setups:
+
+[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]].
+
+[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]].
+
+* Customization Options
+:properties:
+:custom_id: h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f
+:end:
+
+The Modus themes are highly configurable, though they should work well
+without any further tweaks. By default, all customization options are
+set to nil, unless otherwise noted in this manual.
+
+Remember that all customization options must be evaluated before loading
+a theme ([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]).
+
+Below is a summary of what you will learn in the subsequent sections of
+this manual.
+
+#+begin_src emacs-lisp
+(setq modus-themes-italic-constructs t
+ modus-themes-bold-constructs nil
+ modus-themes-no-mixed-fonts nil
+ modus-themes-subtle-line-numbers nil
+ modus-themes-success-deuteranopia t
+ modus-themes-inhibit-reload t ; only applies to `customize-set-variable' and related
+
+ modus-themes-fringes nil ; {nil,'subtle,'intense}
+
+ ;; Options for `modus-themes-lang-checkers' are either nil (the
+ ;; default), or a list of properties that may include any of those
+ ;; symbols: `straight-underline', `text-also', `background',
+ ;; `intense'
+ modus-themes-lang-checkers nil
+
+ ;; Options for `modus-themes-mode-line' are either nil, or a list
+ ;; that can combine any of `3d' OR `moody', `borderless',
+ ;; `accented'. The variable's doc string shows all possible
+ ;; combinations.
+ modus-themes-mode-line '(3d accented)
+
+ ;; Options for `modus-themes-syntax' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `faint', `yellow-comments', `green-strings', `alt-syntax'
+ modus-themes-syntax nil
+
+ ;; Options for `modus-themes-hl-line' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `accented', `underline', `intense'
+ modus-themes-hl-line '(underline accented)
+
+ ;; Options for `modus-themes-paren-match' are either nil (the
+ ;; default), or a list of properties that may include any of those
+ ;; symbols: `bold', `intense', `underline'
+ modus-themes-paren-match '(bold intense)
+
+ ;; Options for `modus-themes-links' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `neutral-underline' OR `no-underline', `faint' OR `no-color',
+ ;; `bold', `italic', `background'
+ modus-themes-links '(neutral-underline background)
+
+ ;; Options for `modus-themes-prompts' are either nil (the
+ ;; default), or a list of properties that may include any of those
+ ;; symbols: `background', `bold', `gray', `intense', `italic'
+ modus-themes-prompts '(intense bold)
+
+ modus-themes-completions 'moderate ; {nil,'moderate,'opinionated}
+
+ modus-themes-mail-citations nil ; {nil,'faint,'monochrome}
+
+ ;; Options for `modus-themes-region' are either nil (the default),
+ ;; or a list of properties that may include any of those symbols:
+ ;; `no-extend', `bg-only', `accented'
+ modus-themes-region '(bg-only no-extend)
+
+ ;; Options for `modus-themes-diffs': nil, 'desaturated,
+ ;; 'bg-only, 'deuteranopia, 'fg-only-deuteranopia
+ modus-themes-diffs 'fg-only-deuteranopia
+
+ modus-themes-org-blocks 'gray-background ; {nil,'gray-background,'tinted-background}
+
+ modus-themes-org-agenda ; this is an alist: read the manual or its doc string
+ '((header-block . (variable-pitch scale-title))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light-deuteranopia))
+
+ modus-themes-headings ; this is an alist: read the manual or its doc string
+ '((1 . (overline background))
+ (2 . (rainbow overline))
+ (t . (no-bold)))
+
+ modus-themes-variable-pitch-ui nil
+ modus-themes-variable-pitch-headings t
+ modus-themes-scale-headings t
+ modus-themes-scale-1 1.1
+ modus-themes-scale-2 1.15
+ modus-themes-scale-3 1.21
+ modus-themes-scale-4 1.27
+ modus-themes-scale-title 1.33)
+#+end_src
+
+** Option for inhibiting theme reload
+:properties:
+:alt_title: Custom reload theme
+:description: Toggle auto-reload of the theme when setting custom variables
+:custom_id: h:9001527a-4e2c-43e0-98e8-3ef72d770639
+:end:
+#+vindex: modus-themes-inhibit-reload
+
+Symbol: ~modus-themes-inhibit-reload~
+
+Possible values:
+
+1. ~nil~
+2. ~t~ (default)
+
+By default, customizing a theme-related user option through the Custom
+interfaces or with {{{kbd(M-x customize-set-variable)}}} will not reload the
+currently active Modus theme.
+
+Enable this behaviour by setting this variable to ~nil~.
+
+** Option for color-coding success state (deuteranopia)
+:properties:
+:alt_title: Success' color-code
+:description: Toggle blue color for success or done states
+:custom_id: h:3ed03a48-20d8-4ce7-b214-0eb7e4c79abe
+:end:
+#+vindex: modus-themes-success-deuteranopia
+
+Symbol: ~modus-themes-success-deuteranopia~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+The default is to colorise all faces that denote "success", "done", or
+similar with a variant of green.
+
+With a non-nil value (~t~), use variants of blue instead of green. This
+is meant to empower users with red-green color deficiency.
+
+The present customization option should apply to all contexts where
+there can be a color-coded distinction between success and failure,
+to-do and done, and so on.
+
+Diffs, which have a red/green dichotomy by default, can also be
+configured to conform with deuteranopia.
+
+[[#h:ea7ac54f-5827-49bd-b09f-62424b3b6427][Option for diff buffer looks]].
+
+** Option for more bold constructs
+:properties:
+:alt_title: Bold constructs
+:description: Toggle bold constructs in code
+:custom_id: h:b25714f6-0fbe-41f6-89b5-6912d304091e
+:end:
+#+vindex: modus-themes-bold-constructs
+
+Symbol: ~modus-themes-bold-constructs~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+The default is to use a bold typographic weight only when it is
+required.
+
+With a non-nil value (~t~) display several syntactic constructs in bold
+weight. This concerns keywords and other important aspects of code
+syntax. It also affects certain mode line indicators and command-line
+prompts.
+
+Advanced users may also want to configure the exact attributes of the
+~bold~ face.
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
+** Option for more italic constructs
+:properties:
+:alt_title: Italic constructs
+:description: Toggle italic font constructs in code
+:custom_id: h:977c900d-0d6d-4dbb-82d9-c2aae69543d6
+:end:
+#+vindex: modus-themes-italic-constructs
+
+Symbol: ~modus-themes-italic-constructs~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+The default is to not use slanted text forms (italics) unless it is
+absolutely necessary.
+
+With a non-nil value (~t~) choose to render more faces in italics. This
+typically affects documentation strings and code comments.
+
+Advanced users may also want to configure the exact attributes of the
+~italic~ face.
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
+** Option for syntax highlighting
+:properties:
+:alt_title: Syntax styles
+:description: Choose the overall aesthetic of code syntax
+:custom_id: h:c119d7b2-fcd4-4e44-890e-5e25733d5e52
+:end:
+#+vindex: modus-themes-syntax
+
+Symbol: ~modus-themes-syntax~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ ~faint~
++ ~yellow-comments~
++ ~green-strings~
++ ~alt-syntax~
+
+The default (a ~nil~ value or an empty list) is to use a balanced
+combination of colors on the cyan-blue-magenta side of the spectrum.
+There is little to no use of greens, yellows, and reds. Comments are
+gray, strings are blue colored, doc strings are a shade of cyan, while
+color combinations are designed to avoid exaggerations.
+
+The property ~faint~ fades the saturation of all applicable colors, where
+that is possible or appropriate.
+
+The property ~yellow-comments~ applies a yellow color to comments.
+
+The property ~green-strings~ applies a green color to strings and a green
+tint to doc strings.
+
+The property ~alt-syntax~ changes the combination of colors beyond strings
+and comments, so that the effective palette is broadened to provide
+greater variety relative to the default.
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(faint)
+(green-strings yellow-comments)
+(alt-syntax green-strings yellow-comments)
+(faint alt-syntax green-strings yellow-comments)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-syntax '(faint alt-syntax))
+#+end_src
+
+Independent of this variable, users may also control the use of a bold
+weight or italic text: ~modus-themes-bold-constructs~ and
+~modus-themes-italic-constructs~.
+
+[[#h:b25714f6-0fbe-41f6-89b5-6912d304091e][Option for more bold constructs]].
+
+[[#h:977c900d-0d6d-4dbb-82d9-c2aae69543d6][Option for more italic constructs]].
+
+** Option for no font mixing
+:properties:
+:alt_title: No mixed fonts
+:description: Toggle mixing of font families
+:custom_id: h:115e6c23-ee35-4a16-8cef-e2fcbb08e28b
+:end:
+#+vindex: modus-themes-no-mixed-fonts
+
+Symbol: ~modus-themes-no-mixed-fonts~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+By default, the themes configure some spacing-sensitive faces like Org
+tables and code blocks to always inherit from the ~fixed-pitch~ face.
+This is to ensure that those constructs remain monospaced even when
+users opt for a mode that remaps typeface families, such as the built-in
+{{{kbd(M-x variable-pitch-mode)}}}. Otherwise the layout would appear
+broken, due to how spacing is done. To disable this behaviour, set the
+option to ~t~.
+
+Users may prefer to use another package for handling mixed typeface
+configurations, rather than letting the theme do it, perhaps because a
+purpose-specific package has extra functionality. Two possible options
+are ~org-variable-pitch~ and ~mixed-pitch~.
+
+[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]].
+
+** Option for links
+:properties:
+:alt_title: Link styles
+:description: Choose among several styles, with or without underline
+:custom_id: h:c119d7b2-fcd4-4e44-890e-5e25733d5e52
+:end:
+#+vindex: modus-themes-links
+
+Symbol: ~modus-themes-links~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ Underline style:
+ - ~neutral-underline~
+ - ~no-underline~
++ Text coloration:
+ - ~faint~
+ - ~no-color~
++ ~bold~
++ ~italic~
++ ~background~
+
+The default (a ~nil~ value or an empty list) is a prominent text color,
+typically blue, with an underline of the same color.
+
+For the style of the underline, a ~neutral-underline~ property turns the
+color of the line into a subtle gray, while the ~no-underline~ property
+removes the line altogether. If both of those are set, the latter takes
+precedence.
+
+For text coloration, a ~faint~ property desaturates the color of the text
+and the underline, unless the underline is affected by the
+aforementioned properties. While a ~no-color~ property removes the color
+from the text. If both of those are set, the latter takes precedence.
+
+A ~bold~ property applies a heavy typographic weight to the text of the
+link.
+
+An ~italic~ property adds a slant to the link's text (italic or oblique
+forms, depending on the typeface).
+
+A ~background~ property applies a subtle tinted background color.
+
+In case both ~no-underline~ and ~no-color~ are set, then a subtle gray
+background is applied to all links. This can still be combined with the
+~bold~ and ~italic~ properties.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+#+begin_src emacs-lisp
+(faint)
+(no-underline faint)
+(no-color no-underline bold)
+(italic bold background no-color no-underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-links '(neutral-underline background))
+#+end_src
+
+The placement of the underline, meaning its proximity to the text, is
+controlled by ~x-use-underline-position-properties~,
+~x-underline-at-descent-line~, ~underline-minimum-offset~. Please refer to
+their documentation strings.
+
+** Option for command prompt styles
+:properties:
+:alt_title: Command prompts
+:description: Choose among plain, subtle, or intense prompts
+:custom_id: h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1
+:end:
+#+vindex: modus-themes-prompts
+
+Symbol: ~modus-themes-prompts~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ ~background~
++ ~bold~
++ ~gray~
++ ~intense~
++ ~italic~
+
+The default (a ~nil~ value or an empty list) means to only use a subtle
+accented foreground color.
+
+The property ~background~ applies a background color to the prompt's text.
+By default, this is a subtle accented value.
+
+The property ~intense~ makes the foreground color more prominent. If the
+~background~ property is also set, it amplifies the value of the
+background as well.
+
+The property ~gray~ changes the prompt's colors to grayscale. This
+affects the foreground and, if the ~background~ property is also set, the
+background. Its effect is subtle, unless it is combined with the
+~intense~ property.
+
+The property ~bold~ makes the text use a bold typographic weight.
+Similarly, ~italic~ adds a slant to the font's forms (italic or oblique
+forms, depending on the typeface).
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(intense)
+(bold intense)
+(intense bold gray)
+(intense background gray bold)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-prompts '(background gray))
+#+end_src
+
+** Option for mode line presentation
+:properties:
+:alt_title: Mode line
+:description: Choose among several styles, with or without borders
+:custom_id: h:27943af6-d950-42d0-bc23-106e43f50a24
+:end:
+#+vindex: modus-themes-mode-line
+
+Symbol: ~modus-themes-mode-line~
+
+Possible values, which can be expressed as a list of combinations of box
+effect, color, and border visibility:
+
++ Overall style:
+ - ~3d~
+ - ~moody~
++ ~accented~
++ ~borderless~
+
+The default (a nil value or an empty list) is a two-dimensional
+rectangle with a border around it. The active and the inactive
+mode lines use different shades of grayscale values for the
+background, foreground, border.
+
+The ~3d~ property applies a three-dimensional effect to the
+active mode line. The inactive mode lines remain two-dimensional
+and are toned down a bit, relative to the default style.
+
+The ~moody~ property optimizes the mode line for use with the
+library of the same name (hereinafter referred to as 'Moody').
+In practice, it removes the box effect and replaces it with
+underline and overline properties. It also tones down the
+inactive mode lines. Despite its intended purpose, this option
+can also be used without the Moody library (please consult the
+themes' manual on this point for more details). If both ~3d~ and
+~moody~ properties are set, the latter takes precedence.
+
+The ~borderless~ property removes the color of the borders. It
+does not actually remove the borders, but only makes their color
+the same as the background, effectively creating some padding.
+
+The ~accented~ property ensures that the active mode line uses a
+colored background instead of the standard shade of gray.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+#+begin_src emacs-lisp
+(accented)
+(borderless 3d)
+(moody accented borderless)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-prompts '(borderless accented))
+#+end_src
+
+Note that Moody does not expose any faces that the themes could style
+directly. Instead it re-purposes existing ones to render its tabs and
+ribbons. As such, there may be cases where the contrast ratio falls
+below the 7:1 target that the themes conform with (WCAG AAA). To hedge
+against this, we configure a fallback foreground for the ~moody~ property,
+which will come into effect when the background of the mode line changes
+to something less accessible, such as Moody ribbons (read the doc string
+of ~set-face-attribute~, specifically ~:distant-foreground~). This fallback
+is activated when Emacs determines that the background and foreground of
+the given construct are too close to each other in terms of color
+distance. In practice, users will need to experiment with the variable
+~face-near-same-color-threshold~ to trigger the effect. We find that a
+value of =45000= shall suffice, contrary to the default =30000=. Though for
+the combinations that involve the ~accented~ and ~moody~ properties, as
+mentioned above, that should be raised up to =70000=. Do not set it too
+high, because it has the adverse effect of always overriding the default
+colors (which have been carefully designed to be highly accessible).
+
+Furthermore, because Moody expects an underline and overline instead of
+a box style, it is advised to set ~x-underline-at-descent-line~ to a
+non-nil value.
+
+** Option for completion framework aesthetics
+:properties:
+:alt_title: Completion UIs
+:description: Choose among standard, moderate, or opinionated looks
+:custom_id: h:f1c20c02-7b34-4c35-9c65-99170efb2882
+:end:
+#+vindex: modus-themes-completions
+
+Symbol: ~modus-themes-completions~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~moderate~
+3. ~opinionated~
+
+This is a special option that has different effects depending on the
+completion UI. The interfaces can be grouped in two categories, based
+on their default aesthetics: (i) those that only or mostly use
+foreground colors for their interaction model, and (ii) those that
+combine background and foreground values for some of their metaphors.
+The former category encompasses Icomplete, Ido, Selectrum, Vertico, as
+well as pattern matching styles like Orderless and Flx. The latter
+covers Helm, Ivy, and Sallet.
+
+A value of ~nil~ (the default) will simply respect the metaphors of each
+completion framework.
+
+Option ~moderate~ applies a combination of background and foreground that
+is fairly subtle. For Icomplete and friends this constitutes a
+departure from their default aesthetics, however the difference is
+small. While Helm, Ivy et al appear slightly different than their
+original looks, as they are toned down a bit.
+
+Option ~opinionated~ uses color combinations that refashion the completion
+UI. For the Icomplete camp this means that intense background and
+foreground combinations are used: in effect their looks emulate those of
+Helm, Ivy and co. in their original style. Whereas the other group of
+packages will revert to an even more nuanced aesthetic with some
+additional changes to the choice of hues.
+
+To appreciate the scope of this customization option, you should spend
+some time with every one of the ~nil~ (default), ~moderate~, and ~opinionated~
+possibilities.
+
+** Option for mail citations
+:properties:
+:alt_title: Mail citations
+:description: Choose among colorful, desaturated, monochrome citations
+:custom_id: h:5a12765d-0ba0-4a75-ab11-e35d3bbb317d
+:end:
+#+vindex: modus-themes-mail-citations
+
+Symbol: ~modus-themes-mail-citations~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~faint~
+3. ~monochrome~
+
+By default, citations in email-related buffers apply contrasting hues to
+different levels of depth in cited text. The colors are fairly easy to
+tell apart.
+
+A value of ~faint~ makes all citation levels less intense, while retaining
+the default style of contrasting hues (albeit very subtle ones).
+
+Option ~monochrome~ turns all citations in to a uniform shade of gray.
+
+Whatever the value assigned to this variable, citations in emails are
+controlled by typographic elements or indentation, which the themes do
+not touch.
+
+** Option for fringe visibility
+:properties:
+:alt_title: Fringes
+:description: Choose among invisible, subtle, or intense fringe styles
+:custom_id: h:1983c3fc-74f6-44f3-b917-967c403bebae
+:end:
+#+vindex: modus-themes-fringes
+
+Symbol: ~modus-themes-fringes~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~subtle~
+3. ~intense~
+
+The default is to use the same color as that of the main background,
+meaning that the fringes are not obvious though they still occupy the
+space given to them by ~fringe-mode~.
+
+Options ~subtle~ and ~intense~ apply a gray background, making the fringes
+visible. The difference between the two is one of degree, as their
+names imply.
+
+** Option for language checkers
+:properties:
+:alt_title: Language checkers
+:description: Control the style of language checkers/linters
+:custom_id: h:4b13743a-8ebf-4d2c-a043-cceba10b1eb4
+:end:
+#+vindex: modus-themes-lang-checkers
+
+Symbol: ~modus-themes-lang-checkers~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ ~straight-underline~
++ ~text-also~
++ ~background~
++ ~intense~
+
+The default (a ~nil~ value or an empty list) applies a color-coded
+underline to the affected text, while it leaves the original foreground
+intact. If the display spec of Emacs has support for it, the
+underline's style is that of a wave, otherwise it is a straight line.
+
+The property ~straight-underline~ ensures that the underline under the
+affected text is always drawn as a straight line.
+
+The property ~text-also~ applies the same color of the underline to the
+affected text.
+
+The property ~background~ adds a color-coded background.
+
+The property ~intense~ amplifies the applicable colors if ~background~
+and/or ~text-only~ are set. If ~intense~ is set on its own, then it implies
+~text-only~.
+
+To disable fringe indicators for Flymake or Flycheck, refer to variables
+~flymake-fringe-indicator-position~ and ~flycheck-indication-mode~,
+respectively.
+
+Combinations of any of those properties can be expressed in a
+list, as in those examples:
+
+#+begin_src emacs-lisp
+(background)
+(straight-underline intense)
+(background text-also straight-underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-lang-checkers '(text-also background))
+#+end_src
+
+NOTE: The placement of the straight underline, though not the wave
+style, is controlled by the built-in variables ~underline-minimum-offset~,
+~x-underline-at-descent-line~, ~x-use-underline-position-properties~.
+
+** Option for line highlighting (hl-line-mode)
+:properties:
+:alt_title: Line highlighting
+:description: Choose style of current line (hl-line-mode)
+:custom_id: h:1dba1cfe-d079-4c13-a810-f768e8789177
+:end:
+#+vindex: modus-themes-hl-line
+
+Symbol: ~modus-themes-hl-line~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ ~accented~
++ ~intense~
++ ~underline~
+
+The default (a ~nil~ value or an empty list) is a subtle gray background
+color.
+
+The property ~accented~ changes the background to a colored variant.
+
+An ~underline~ property draws a line below the highlighted area. Its
+color is similar to the background, so gray by default or an accent
+color when ~accented~ is also set.
+
+An ~intense~ property amplifies the colors in use, which may be both the
+background and the underline.
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(intense)
+(underline intense)
+(accented intense underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-hl-line '(underline accented))
+#+end_src
+
+Set ~x-underline-at-descent-line~ to a non-nil value for better results
+with underlines.
+
+This style affects several packages that enable ~hl-line-mode~, such as
+=elfeed=, =notmuch=, and =mu4e=.
+
+** Option for line numbers (display-line-numbers-mode)
+:properties:
+:alt_title: Line numbers
+:description: Toggle subtle style for line numbers
+:custom_id: h:8c4a6230-2e43-4aa2-a631-3b7179392e09
+:end:
+#+vindex: modus-themes-subtle-line-numbers
+
+Symbol: ~modus-themes-subtle-line-numbers~
+
+Possible value:
+
+1. ~nil~ (default)
+2. ~t~
+
+The default style for ~display-line-numbers-mode~ and its global variant
+is to apply a subtle gray background to the line numbers. The current
+line has a more pronounced background and foreground combination to
+bring more attention to itself.
+
+Similarly, the faces for ~display-line-numbers-major-tick~ and its
+counterpart ~display-line-numbers-minor-tick~ use appropriate styles that
+involve a bespoke background and foreground combination.
+
+With a non-nil value (~t~), line numbers have no background of their own.
+Instead they retain the primary background of the theme, blending with
+the rest of the buffer. Foreground values for all relevant faces are
+updated to accommodate this aesthetic.
+
+** Option for parenthesis matching (show-paren-mode)
+:properties:
+:alt_title: Matching parentheses
+:description: Choose between various styles for matching delimiters/parentheses
+:custom_id: h:e66a7e4d-a512-4bc7-9f86-fbbb5923bf37
+:end:
+#+vindex: modus-themes-paren-match
+
+Symbol: ~modus-themes-paren-match~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ ~bold~
++ ~intense~
++ ~underline~
+
+The default (a ~nil~ value or an empty list) is a subtle background color.
+
+The ~bold~ property adds a bold weight to the characters of the matching
+delimiters.
+
+The ~intense~ property applies a more prominent background color to the
+delimiters.
+
+The ~underline~ property draws a straight line under the affected text.
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(bold)
+(underline intense)
+(bold intense underline)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-paren-match '(bold intense))
+#+end_src
+
+This customization variable affects the built-in ~show-paren-mode~ and the
+=smartparens= package.
+
+** Option for active region
+:properties:
+:alt_title: Active region
+:description: Choose between various styles for the active region
+:custom_id: h:60798063-b4ad-45ea-b9a7-ff7b5c0ab74c
+:end:
+#+vindex: modus-themes-region
+
+Symbol: ~modus-themes-region~
+
+Possible values are expressed as a list of properties (default is ~nil~ or
+an empty list). The list can include any of the following symbols:
+
++ ~no-extend~
++ ~bg-only~
++ ~accented~
+
+The default (a ~nil~ value or an empty list) is a prominent gray
+background that overrides all foreground colors in the area it
+encompasses. Its reach extends to the edge of the window.
+
+The ~no-extend~ property limits the region to the end of the line, so that
+it does not reach the edge of the window.
+
+The ~bg-only~ property makes the region's background color more subtle to
+allow the underlying text to retain its foreground colors.
+
+The ~accented~ property applies a more colorful background to the region.
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(no-extend)
+(bg-only accented)
+(accented bg-only no-extend)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-region '(bg-only no-extend))
+#+end_src
+
+** Option for diff buffer looks
+:properties:
+:alt_title: Diffs
+:description: Choose among intense, desaturated, or text-only diffs
+:custom_id: h:ea7ac54f-5827-49bd-b09f-62424b3b6427
+:end:
+#+vindex: modus-themes-diffs
+
+Symbol: ~modus-themes-diffs~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~desaturated~
+3. ~bg-only~
+4. ~deuteranopia~
+5. ~fg-only-deuteranopia~
+
+The default (~nil~) uses fairly intense color combinations for diffs, by
+applying prominently colored backgrounds, with appropriate foregrounds.
+
+Option ~desaturated~ follows the same principles as with the default
+(~nil~), though it tones down all relevant colors.
+
+Option ~bg-only~ applies a background but does not override the text's
+foreground. This makes it suitable for a non-nil value passed to
+~diff-font-lock-syntax~ (note: Magit does not support syntax highlighting
+in diffs---last checked on 2021-04-21).
+
+Option ~deuteranopia~ is like the default (~nil~) in terms of using
+prominently colored backgrounds, except that it also accounts for
+red-green color defficiency by replacing all instances of green with
+colors on the blue side of the spectrum. Other stylistic changes are
+made in the interest of optimizing for such a use-case.
+
+Option ~fg-only-deuteranopia~ removes all colored backgrounds, except from
+word-wise or refined changes. Instead, it only uses color-coded
+foreground values to differentiate between added, removed, and changed
+lines. If a background is necessary to denote context, a subtle
+grayscale value is applied. The color used for added lines is a variant
+of blue to account for red-green color defficiency but also because
+green text alone is hard to discern in the diff's context (hard for our
+accessibility purposes). The ~fg-only~ option that existed in older
+versions of the themes is now an alias of ~fg-only-deuteranopia~, in the
+interest of backward compatibility.
+
+** Option for org-mode block styles
+:properties:
+:alt_title: Org mode blocks
+:description: Choose among plain, gray, or tinted backgrounds
+:custom_id: h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2
+:end:
+#+vindex: modus-themes-org-blocks
+
+Symbol: ~modus-themes-org-blocks~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~gray-background~ (value ~grayscale~ exists for backward compatibility)
+3. ~tinted-background~ (value ~rainbow~ exists for backward compatibility)
+
+The default means that the block has no distinct background of its own
+and uses the one that applies to the rest of the buffer.
+
+Option ~gray-background~ applies a subtle gray background to the block's
+contents. It also affects the begin and end lines of the block: their
+background extends to the edge of the window for Emacs version >= 27
+where the ~:extend~ keyword is recognized by ~set-face-attribute~ (this is
+contingent on the variable ~org-fontify-whole-block-delimiter-line~).
+
+Option ~tinted-background~ uses a slightly colored background for the
+contents of the block. The exact color will depend on the programming
+language and is controlled by the variable ~org-src-block-faces~ (refer to
+the theme's source code for the current association list). For this to
+take effect, Org must be restarted with {{{kbd(M-x org-mode-restart)}}}.
+
+Code blocks use their major mode's colors only when the variable
+~org-src-fontify-natively~ is non-nil. While quote/verse blocks require
+setting ~org-fontify-quote-and-verse-blocks~ to a non-nil value.
+
+[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter fontification]].
+
+Older versions of the themes provided options ~grayscale~ (or ~greyscale~)
+and ~rainbow~. Those will continue to work as they are aliases for
+~gray-background~ and ~tinted-background~, respectively.
+
+** Option for Org agenda constructs
+:properties:
+:alt_title: Org agenda
+:description: Control each element in the presentation of the agenda
+:custom_id: h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc
+:end:
+#+vindex: modus-themes-org-agenda
+
+Symbol: ~modus-themes-org-agenda~
+
+This is an alist that accepts a =(key . value)= combination. Some values
+are specified as a list. Here is a sample, followed by a description of
+all possible combinations:
+
+#+begin_src emacs-lisp
+(setq modus-themes-org-agenda
+ '((header-block . (variable-pitch scale-title))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light)))
+#+end_src
+
+A ~header-block~ key applies to elements that concern the headings which
+demarcate blocks in the structure of the agenda. By default (a ~nil~
+value) those are rendered in a bold typographic weight, plus a height
+that is slightly taller than the default font size. Acceptable values
+come in the form of a list that can include either or both of those
+properties:
+
+- ~variable-pitch~ to use a proportionately spaced typeface;
+- ~scale-title~ to increase the size to the number assigned to
+ ~modus-themes-scale-title~ ([[#h:6868baa1-beba-45ed-baa5-5fd68322ccb3][Control the scale of headings]]) or ~no-scale~
+ to make the font use the same height as the rest of the buffer.
+
+In case both ~scale-title~ and ~no-scale~ are in the list, the latter takes
+precedence.
+
+Example usage:
+
+#+begin_src emacs-lisp
+(header-block . nil)
+(header-block . (scale-title))
+(header-block . (no-scale))
+(header-block . (variable-pitch scale-title))
+#+end_src
+
+A ~header-date~ key covers date headings. Dates use only a foreground
+color by default (a ~nil~ value), with weekdays and weekends having a
+slight difference in hueness. The current date has an added gray
+background. This key accepts a list of values that can include any of
+the following properties:
+
+- ~grayscale~ to make weekdays use the main foreground color and
+ weekends a more subtle gray;
+- ~workaholic~ to make weekdays and weekends look the same in
+ terms of color;
+- ~bold-today~ to apply a bold typographic weight to the current
+ date;
+- ~bold-all~ to render all date headings in a bold weight.
+
+For example:
+
+#+begin_src emacs-lisp
+(header-date . nil)
+(header-date . (workaholic))
+(header-date . (grayscale bold-all))
+(header-date . (grayscale workaholic))
+(header-date . (grayscale workaholic bold-today))
+#+end_src
+
+A ~scheduled~ key applies to tasks with a scheduled date. By default (a
+~nil~ value), those use varying shades of yellow to denote (i) a past or
+current date and (ii) a future date. Valid values are symbols:
+
+- nil (default);
+- ~uniform~ to make all scheduled dates the same color;
+- ~rainbow~ to use contrasting colors for past, present, future
+ scheduled dates.
+
+For example:
+
+#+begin_src emacs-lisp
+(scheduled . nil)
+(scheduled . uniform)
+(scheduled . rainbow)
+#+end_src
+
+A ~habit~ key applies to the ~org-habit~ graph. All possible value are
+passed as a symbol. Those are:
+
+- The default (~nil~) is meant to conform with the original aesthetic of
+ ~org-habit~. It employs all four color codes that correspond to the
+ org-habit states---clear, ready, alert, and overdue---while
+ distinguishing between their present and future variants. This
+ results in a total of eight colors in use: red, yellow, green, blue,
+ in tinted and shaded versions. They cover the full set of information
+ provided by the ~org-habit~ consistency graph.
+- ~simplified~ is like the default except that it removes the dichotomy
+ between current and future variants by applying uniform color-coded
+ values. It applies a total of four colors: red, yellow, green, blue.
+ They produce a simplified consistency graph that is more legible (or
+ less busy) than the default. The intent is to shift focus towards the
+ distinction between the four states of a habit task, rather than each
+ state's present/future outlook.
+- ~traffic-light~ further reduces the available colors to red, yellow, and
+ green. As in ~simplified~, present and future variants appear
+ uniformly, but differently from it, the ~clear~ state is rendered in a
+ green hue, instead of the original blue. This is meant to capture the
+ use-case where a habit task being too early is less important than it
+ being too late. The difference between ready and clear states is
+ attenuated by painting both of them using shades of green. This
+ option thus highlights the alert and overdue states.
+- ~traffic-light-deuteranopia~ is like the ~traffic-light~ except its three
+ colors are red, yellow, and blue to be suitable for users with
+ red-green color deficiency (deuteranopia).
+
+For example:
+
+#+begin_src emacs-lisp
+(habit . nil)
+(habit . simplified)
+(habit . traffic-light)
+#+end_src
+
+Putting it all together, the alist can look like this:
+
+#+begin_src emacs-lisp
+'((header-block . (scale-title variable-pitch))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light))
+
+;; Or else:
+(setq modus-themes-org-agenda
+ '((header-block . (scale-title variable-pitch))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light)))
+#+end_src
+
+** Option for the headings' overall style
+:properties:
+:alt_title: Heading styles
+:description: Choose among several styles, also per heading level
+:custom_id: h:271eff19-97aa-4090-9415-a6463c2f9ae1
+:end:
+#+vindex: modus-themes-headings
+
+Symbol: ~modus-themes-headings~
+
+This is an alist that accepts a =(key . list-of-values)= combination. The
+key is either a number, representing the heading's level or ~t~, which
+pertains to the fallback style. The list of values covers symbols that
+refer to properties, as described below. Here is a sample, followed by
+a presentation of all available properties:
+
+#+begin_src emacs-lisp
+(setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (overline rainbow))
+ (t . (monochrome))))
+#+end_src
+
+Properties:
+
++ ~rainbow~
++ ~overline~
++ ~background~
++ ~no-bold~
++ ~monochrome~
+
+By default (a ~nil~ value for this variable), all headings have a bold
+typographic weight and use a desaturated text color.
+
+A ~rainbow~ property makes the text color more saturated.
+
+An ~overline~ property draws a line above the area of the heading.
+
+A ~background~ property adds a subtle tinted color to the background of
+the heading.
+
+A ~no-bold~ property removes the bold weight from the heading's text.
+
+A ~monochrome~ property makes all headings the same base color, which is
+that of the default for the active theme (black/white). When ~background~
+is also set, ~monochrome~ changes its color to gray. If both ~monochrome~
+and ~rainbow~ are set, the former takes precedence.
+
+Combinations of any of those properties are expressed as a list, like in
+these examples:
+
+#+begin_src emacs-lisp
+(no-bold)
+(rainbow background)
+(overline monochrome no-bold)
+#+end_src
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+#+begin_src emacs-lisp
+(setq modus-themes-headings
+ '((1 . (background overline rainbow))
+ (2 . (background overline))
+ (t . (overline no-bold))))
+#+end_src
+
+When defining the styles per heading level, it is possible to pass a
+non-nil value (~t~) instead of a list of properties. This will retain the
+original aesthetic for that level. For example:
+
+#+begin_src emacs-lisp
+(setq modus-themes-headings
+ '((1 . t) ; keep the default style
+ (2 . (background overline))
+ (t . (rainbow)))) ; style for all other headings
+
+(setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (rainbow no-bold))
+ (t . t))) ; default style for all other levels
+#+end_src
+
+For Org users, the extent of the heading depends on the variable
+~org-fontify-whole-heading-line~. This affects the ~overline~ and
+~background~ properties. Depending on the version of Org, there may be
+others, such as ~org-fontify-done-headline~.
+
+[[#h:075eb022-37a6-41a4-a040-cc189f6bfa1f][Option for scaled headings]].
+
+[[#h:97caca76-fa13-456c-aef1-a2aa165ea274][Option for variable-pitch font in headings]].
+
+** Option for scaled headings
+:properties:
+:alt_title: Scaled headings
+:description: Toggle scaling of headings
+:custom_id: h:075eb022-37a6-41a4-a040-cc189f6bfa1f
+:end:
+#+vindex: modus-themes-scale-headings
+
+Symbol: ~modus-themes-scale-headings~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+The default is to use the same size for headings and paragraph text.
+
+With a non-nil value (~t~) make headings larger in height relative to the
+main text. This is noticeable in modes like Org, Markdown, and Info.
+
+*** Control the scale of headings
+:properties:
+:alt_title: Scaled heading sizes
+:description: Specify rate of increase for scaled headings
+:custom_id: h:6868baa1-beba-45ed-baa5-5fd68322ccb3
+:end:
+
+In addition to the toggle for enabling scaled headings, users can also
+specify a number of their own.
+
++ If it is a floating point, say, =1.5=, it is interpreted as a multiple
+ of the base font size. This is the recommended method, because it
+ will always adapt to changes in the base font size, such as while
+ using the ~text-scale-adjust~ command.
+
++ If it is an integer, it is read as an absolute font height that is
+ 1/10 of the typographic point size. Thus a value of =18pt= must be
+ expressed as =180=. Setting an absolute value is discouraged, as it
+ will break the layout in cases where the base font size must change,
+ such as with the ~text-scale-adjust~ command ([[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations]]).
+ While we discourage using absolute values, we still provide for this
+ option for users who do not need to perform text-scaling operations or
+ who are content with whatever discrepancies in height.
+
+Below are the variables in their default values, using the floating
+point paradigm. The numbers are very conservative, but one is free to
+change them to their liking, such as =1.2=, =1.4=, =1.6=, =1.8=, =2.0=---or use a
+resource for finding a consistent scale:
+
+#+begin_src emacs-lisp
+(setq modus-themes-scale-1 1.05
+ modus-themes-scale-2 1.1
+ modus-themes-scale-3 1.15
+ modus-themes-scale-4 1.2
+ modus-themes-scale-title 1.3)
+#+end_src
+
+As for the application of that scale, the variables that range from
+~modus-themes-scale-1~ up to ~modus-themes-scale-4~ apply to regular
+headings within the context of the given major mode. The former is the
+smallest, while the latter is the largest. "Regular headings" are those
+that have a standard syntax for their scale, such as Org mode's eight
+levels of asterisks or Markdown's six columns.
+
+Whereas ~modus-themes-scale-title~ is applied to special headings that do
+not conform with the aforementioned syntax, yet which are expected to be
+larger than the largest value on that implied scale or at least have
+some unique purpose in the buffer. Put concretely, Org's =#+title= meta
+datum is not part of the eight levels of headings in an Org file, yet is
+supposed to signify the primary header. Similarly, the Org Agenda's
+structure headings are not part of a recognisable scale and so they also
+get ~modus-themes-scale-title~ ([[#h:68f481bc-5904-4725-a3e6-d7ecfa7c3dbc][Option for Org agenda constructs]]).
+
+Users who wish to maintain scaled headings for the normal syntax while
+preventing special headings from standing out, can assign a value of =1.0=
+to ~modus-themes-scale-title~ to make it the same as body text (or
+whatever value would render it indistinguishable from the desired point
+of reference).
+
+Note that in earlier versions of Org, scaling would only increase the
+size of the heading, but not of keywords that were added to it, like
+"TODO". The issue has been fixed upstream:
+<https://protesilaos.com/codelog/2020-09-24-org-headings-adapt/>.
+
+** Option for variable-pitch font in UI elements
+:properties:
+:alt_title: UI typeface
+:description: Toggle the use of variable-pitch across the User Interface
+:custom_id: h:16cf666c-5e65-424c-a855-7ea8a4a1fcac
+:end:
+#+vindex: modus-themes-variable-pitch-ui
+
+Symbol: ~modus-themes-variable-pitch-ui~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+This option concerns User Interface elements that are under the direct
+control of Emacs. In particular: the mode line, header line, tab bar,
+and tab line.
+
+The default is to use the same font as the rest of Emacs, which usually
+is a monospaced family.
+
+With a non-nil value (~t~) apply a proportionately spaced typeface. This
+is done by assigning the ~variable-pitch~ face to the relevant items.
+
+[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]].
+
+** Option for variable-pitch font in headings
+:properties:
+:alt_title: Headings' typeface
+:description: Toggle the use of variable-pitch in headings
+:custom_id: h:97caca76-fa13-456c-aef1-a2aa165ea274
+:end:
+#+vindex: modus-themes-variable-pitch-headings
+
+Symbol: ~modus-themes-variable-pitch-headings~
+
+Possible values:
+
+1. ~nil~ (default)
+2. ~t~
+
+The default is to use the main font family, which typically is
+monospaced.
+
+With a non-nil value (~t~) apply a proportionately spaced typeface, else
+"variable-pitch", to headings (such as in Org mode).
+
+[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]].
+
+* Advanced customization (do-it-yourself)
+:properties:
+:custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb
+:end:
+
+Unlike the predefined customization options which follow a clear pattern
+of allowing the user to quickly specify their preference, the themes
+also provide a more flexible, albeit difficult, mechanism to control
+things with precision ([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
+
+This section is of interest only to users who are prepared to maintain
+their own local tweaks and who are willing to deal with any possible
+incompatibilities between versioned releases of the themes. As such,
+they are labelled as "do-it-yourself" or "DIY".
+
+** Per-theme customization settings (DIY)
+:properties:
+:custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193
+:end:
+
+If you prefer to maintain different customization options between the
+two themes, it is best you write your own functions that first set those
+options and then load the relevant theme. The following code does
+exactly that by simply differentiating the two themes on the choice of
+bold constructs in code syntax (enabled for one, disabled for the
+other).
+
+#+begin_src emacs-lisp
+(defun my-demo-modus-operandi ()
+ (interactive)
+ (setq modus-themes-bold-constructs t) ; ENABLE bold
+ (modus-themes-load-operandi))
+
+(defun my-demo-modus-vivendi ()
+ (interactive)
+ (setq modus-themes-bold-constructs nil) ; DISABLE bold
+ (modus-themes-load-vivendi))
+
+(defun my-demo-modus-themes-toggle ()
+ (if (eq (car custom-enabled-themes) 'modus-operandi)
+ (my-demo-modus-vivendi)
+ (my-demo-modus-operandi)))
+#+end_src
+
+Then assign ~my-demo-modus-themes-toggle~ to a key instead of the
+equivalent the themes provide.
+
+For a more elaborate design, it is better to inspect the source code of
+~modus-themes-toggle~ and relevant functions.
+
+** Case-by-case face specs using the themes' palette (DIY)
+:properties:
+:custom_id: h:1487c631-f4fe-490d-8d58-d72ffa3bd474
+:end:
+#+findex: modus-themes-color
+#+findex: modus-themes-color-alts
+#+cindex: Extracting individual colors
+
+This section is about tweaking individual faces. If you plan to do
+things at scale, consult the next section: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Set multiple faces]].
+
+We already covered in previous sections how to toggle between the themes
+and how to configure options prior to loading. We also explained that
+some of the functions made available to users will fire up a hook that
+can be used to pass tweaks in the post-theme-load phase.
+
+Now assume you wish to change a single face, say, the ~cursor~. And you
+would like to get the standard "blue" color value of the active Modus
+theme, whether it is Modus Operandi or Modus Vivendi. To do that, you
+can use the ~modus-themes-color~ function. It accepts a symbol that is
+associated with a color in ~modus-themes-operandi-colors~ and
+~modus-themes-vivendi-colors~. Like this:
+
+#+begin_src emacs-lisp
+(modus-themes-color 'blue)
+#+end_src
+
+The function always extracts the color value of the active Modus theme.
+
+#+begin_src emacs-lisp
+(progn
+ (load-theme 'modus-operandi t)
+ (modus-themes-color 'blue)) ; "#0031a9" for `modus-operandi'
+
+(progn
+ (load-theme 'modus-vivendi t)
+ (modus-themes-color 'blue)) ; "#2fafff" for `modus-vivendi'
+#+end_src
+
+Do {{{kbd(C-h v)}}} on the aforementioned variables to check all the available
+symbols that can be passed to this function.
+
+With that granted, let us expand the example to actually change the
+~cursor~ face's background property. We employ the built-in function of
+~set-face-attribute~:
+
+#+begin_src emacs-lisp
+(set-face-attribute 'cursor nil :background (modus-themes-color 'blue))
+#+end_src
+
+If you evaluate this form, your cursor will become blue. But if you
+change themes, such as with ~modus-themes-toggle~, your edits will be
+lost, because the newly loaded theme will override the ~:background~
+attribute you had assigned to that face.
+
+For such changes to persist, we need to make them after loading the
+theme. So we rely on ~modus-themes-after-load-theme-hook~, which gets
+called from ~modus-themes-load-operandi~, ~modus-themes-load-vivendi~, as
+well as the command ~modus-themes-toggle~. Here is a sample function that
+tweaks two faces and then gets added to the hook:
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-custom-faces ()
+ (set-face-attribute 'cursor nil :background (modus-themes-color 'blue))
+ (set-face-attribute 'font-lock-type-face nil :foreground (modus-themes-color 'magenta-alt)))
+
+(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
+#+end_src
+
+[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]].
+
+Using this principle, it is possible to override the styles of faces
+without having to find color values for each case.
+
+Another application is to control the precise weight for bold
+constructs. This is particularly useful if your typeface has several
+variants such as "heavy", "extrabold", "semibold". All you have to do
+is edit the ~bold~ face. For example:
+
+#+begin_src emacs-lisp
+(set-face-attribute 'bold nil :weight 'semibold)
+#+end_src
+
+Remember to use the custom function and hook combo we demonstrated
+above. Because the themes do not hard-wire a specific weight, this
+simple form is enough to change the weight of all bold constructs
+throughout the interface.
+
+Finally, there are cases where you want to tweak colors though wish to
+apply different ones to each theme, say, a blue hue for Modus Operandi
+and a shade of red for Modus Vivendi. To this end, we provide
+~modus-themes-color-alts~ as a convenience function to save you from the
+trouble of writing separate wrappers for each theme. It still returns a
+single value by querying either of ~modus-themes-operandi-colors~ and
+~modus-themes-vivendi-colors~, only here you pass the two keys you want,
+first for ~modus-operandi~ then ~modus-vivendi~.
+
+Take the previous example with the ~cursor~ face:
+
+#+begin_src emacs-lisp
+;; Blue for `modus-operandi' and red for `modus-vivendi'
+(set-face-attribute 'cursor nil :background (modus-themes-color-alts 'blue 'red))
+#+end_src
+
+** Face specs at scale using the themes' palette (DIY)
+:properties:
+:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
+:end:
+#+findex: modus-themes-with-colors
+#+cindex: Extracting colors en masse
+
+The examples here are for large scale operations. For simple, one-off
+tweaks, you may prefer the approach documented in the previous section
+([[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]]).
+
+The ~modus-themes-with-colors~ macro lets you retrieve multiple color
+values by employing the backquote/backtick and comma notation. The
+values are stored in the alists ~modus-themes-operandi-colors~ and
+~modus-themes-vivendi-colors~, while the macro always queries that of the
+active Modus theme.
+
+Here is an abstract example that just returns a list of color values
+while ~modus-operandi~ is enabled:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (list fg-main
+ blue-faint
+ magenta
+ magenta-alt-other
+ cyan-alt-other
+ fg-special-cold
+ blue-alt
+ magenta-faint
+ cyan
+ fg-main
+ green-faint
+ red-alt-faint
+ blue-alt-faint
+ fg-special-warm
+ cyan-alt
+ blue))
+;; =>
+;; ("#000000" "#002f88" "#721045" "#5317ac"
+;; "#005a5f" "#093060" "#2544bb" "#752f50"
+;; "#00538b" "#000000" "#104410" "#702f00"
+;; "#003f78" "#5d3026" "#30517f" "#0031a9")
+#+end_src
+
+Getting a list of colors may have its applications, though what you are
+most likely interested in is how to use those variables to configure
+several faces at once. To do so we can rely on the built-in
+~custom-set-faces~ function, which sets face specifications for the
+special ~user~ theme. That "theme" gets applied on top of regular themes
+like ~modus-operandi~ and ~modus-vivendi~.
+
+This is how it works:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (custom-set-faces
+ `(cursor ((,class :background ,blue)))
+ `(mode-line ((,class :background ,yellow-nuanced-bg
+ :foreground ,yellow-nuanced-fg)))
+ `(mode-line-inactive ((,class :background ,blue-nuanced-bg
+ :foreground ,blue-nuanced-fg)))))
+#+end_src
+
+The above snippet will immediately refashion the faces it names once it
+is evaluated. However, if you switch between the Modus themes, say,
+from ~modus-operandi~ to ~modus-vivendi~, the colors will not get updated to
+match those of the new theme. To make things work across the themes, we
+need to employ the same technique we discussed in the previous section,
+namely, to pass our changes at the post-theme-load phase via a hook.
+
+The themes provide the ~modus-themes-after-load-theme-hook~, which gets
+called from ~modus-themes-load-operandi~, ~modus-themes-load-vivendi~, as
+well as the command ~modus-themes-toggle~. With this knowledge, you can
+wrap the macro in a function and then assign that function to the hook.
+Thus:
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-custom-faces ()
+ (modus-themes-with-colors
+ (custom-set-faces
+ `(cursor ((,class :background ,blue)))
+ `(mode-line ((,class :background ,yellow-nuanced-bg
+ :foreground ,yellow-nuanced-fg)))
+ `(mode-line-inactive ((,class :background ,blue-nuanced-bg
+ :foreground ,blue-nuanced-fg))))))
+
+(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
+#+end_src
+
+[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]].
+
+To discover the faces defined by all loaded libraries, you may do
+{{{kbd(M-x list-faces-display)}}}. Be warned that when you ~:inherit~ a face
+you are introducing an implicit dependency, so try to avoid doing so for
+libraries other than the built-in {{{file(faces.el)}}} (or at least understand
+that things may break if you inherit from a yet-to-be-loaded face).
+
+Also bear in mind that these examples are meant to work with the Modus
+themes. If you are cycling between multiple themes you may encounter
+unforeseen issues, such as the colors of the Modus themes being applied
+to a non-Modus item.
+
+Finally, note that you can still use other functions where those make
+sense. For example, the ~modus-themes-color-alts~ that was discussed in
+the previous section. Adapt the above example like this:
+
+#+begin_src emacs-lisp
+...
+(modus-themes-with-colors
+ (custom-set-faces
+ `(cursor ((,class :background ,(modus-themes-color-alts 'blue 'green))))
+ ...))
+#+end_src
+
+** Remap face with local value (DIY)
+:properties:
+:custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f
+:end:
+#+cindex: Remapping faces
+
+There are cases where we need to change the buffer-local attributes of a
+face. This might be because we have our own minor mode that re-uses a
+face for a particular purpose, such as a line selection tool that
+activates ~hl-line-mode~, but we wish to keep it distinct from other
+buffers. This is where ~face-remap-add-relative~ can be applied and may
+be combined with ~modus-themes-with-colors~ to deliver consistent results.
+
+[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]].
+
+In this example we will write a simple interactive function that adjusts
+the background color of the ~region~ face. This is the sample code:
+
+#+begin_src emacs-lisp
+(defvar my-rainbow-region-colors
+ (modus-themes-with-colors
+ `((red . ,red-subtle-bg)
+ (green . ,green-subtle-bg)
+ (yellow . ,yellow-subtle-bg)
+ (blue . ,blue-subtle-bg)
+ (magenta . ,magenta-subtle-bg)
+ (cyan . ,cyan-subtle-bg)))
+ "Sample list of color values for `my-rainbow-region'.")
+
+(defun my-rainbow-region (color)
+ "Remap buffer-local attribute of `region' using COLOR."
+ (interactive
+ (list
+ (completing-read "Pick a color: " my-rainbow-region-colors)))
+ (face-remap-add-relative
+ 'region
+ `( :background ,(alist-get (intern color) my-rainbow-region-colors)
+ :foreground ,(face-attribute 'default :foreground))))
+#+end_src
+
+When ~my-rainbow-region~ is called interactively, it prompts for a color
+to use. The list of candidates is drawn from the car of each
+association in ~my-rainbow-region-colors~ (so "red", "green", etc.).
+
+To extend this principle, we may write wrapper functions that pass a
+color directly. Those can be useful in tandem with hooks. Consider
+this example:
+
+#+begin_src emacs-lisp
+(defun my-rainbow-region-magenta ()
+ (my-rainbow-region 'magenta))
+
+(add-hook 'diff-mode-hook #'my-rainbow-region-magenta)
+#+end_src
+
+Whenever we enter a ~diff-mode~ buffer, we now get a magenta-colored
+region.
+
+Perhaps you may wish to generalise those findings in to a set of
+functions that also accept an arbitrary face. We shall leave the
+experimentation up to you.
+
+** Cycle through arbitrary colors (DIY)
+:properties:
+:custom_id: h:77dc4a30-b96a-4849-85a8-fee3c2995305
+:end:
+#+cindex: Cycle colors
+
+Users may opt to customize individual faces of the themes to accommodate
+their particular needs. One such case is with the color intensity of
+comments, specifically the foreground of ~font-lock-comment-face~. The
+Modus themes set that to a readable value, in accordance with their
+accessibility objective, though users may prefer to lower the overall
+contrast on an on-demand basis.
+
+One way to achieve this is to design a command that cycles through three
+distinct levels of intensity, though the following can be adapted to any
+kind of cyclic behaviour, such as to switch between red, green, and
+blue.
+
+In the following example, we employ the ~modus-themes-color~ function
+which reads a symbol that represents an entry in the active theme's
+color palette ([[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Case-by-case face specs using the themes' palette]]).
+Those are stored in ~my-modus-themes-comment-colors~.
+
+#+begin_src emacs-lisp
+(defvar my-modus-themes-comment-colors
+ ;; We are abusing the palette here, as those colors have their own
+ ;; purpose in the palette, so please ignore the semantics of their
+ ;; names.
+ '((low . bg-region)
+ (medium . bg-tab-inactive-alt)
+ (high . fg-alt))
+ "Alist of levels of intensity mapped to color palette entries.
+The entries are found in `modus-themes-operandi-colors' or
+`modus-themes-vivendi-colors'.")
+
+(defvar my-modus-themes--adjust-comment-color-state nil
+ "The cyclic state of `my-modus-themes-adjust-comment-color'.
+For internal use.")
+
+(defun my-modus-themes--comment-foreground (degree state)
+ "Set `font-lock-comment-face' foreground.
+Use `my-modus-themes-comment-colors' to extract the color value
+for each level of intensity.
+
+This is complementary to `my-modus-themes-adjust-comment-color'."
+ (let ((palette-colors my-modus-themes-comment-colors))
+ (set-face-foreground
+ 'font-lock-comment-face
+ (modus-themes-color (alist-get degree palette-colors)))
+ (setq my-modus-themes--adjust-comment-color-state state)
+ (message "Comments are set to %s contrast" degree)))
+
+(defun my-modus-themes-adjust-comment-color ()
+ "Cycle through levels of intensity for comments.
+The levels are determined by `my-modus-themes-comment-colors'."
+ (interactive)
+ (pcase my-modus-themes--adjust-comment-color-state
+ ('nil
+ (my-modus-themes--comment-foreground 'low 1))
+ (1
+ (my-modus-themes--comment-foreground 'medium 2))
+ (_
+ (my-modus-themes--comment-foreground 'high nil))))
+#+end_src
+
+With the above, {{{kbd(M-x my-modus-themes-adjust-comment-color)}}} will cycle
+through the three levels of intensity that have been specified.
+
+Another approach is to not read from the active theme's color palette
+and instead provide explicit color values, either in hexadecimal RGB
+notation (like =#123456=) or as the names that are displayed in the output
+of {{{kbd(M-x list-colors-display)}}}. In this case, the alist with the
+colors will have to account for the active theme, so as to set the
+appropriate colors. While this introduces a bit more complexity, it
+ultimately offers greater flexibility on the choice of colors for such a
+niche functionality (so there is no need to abuse the palette of the
+active Modus theme):
+
+#+begin_src emacs-lisp
+(defvar my-modus-themes-comment-colors
+ '((light . ((low . "gray75")
+ (medium . "gray50")
+ (high . "#505050"))) ; the default for `modus-operandi'
+
+ (dark . ((low . "gray25")
+ (medium . "gray50")
+ (high . "#a8a8a8")))) ; the default for `modus-vivendi'
+ "Alist of levels of intensity mapped to color values.
+For such colors, consult the command `list-colors-display'. Pass
+the name of a color or its hex value.")
+
+(defvar my-modus-themes--adjust-comment-color-state nil
+ "The cyclic state of `my-modus-themes-adjust-comment-color'.
+For internal use.")
+
+(defun my-modus-themes--comment-foreground (degree state)
+ "Set `font-lock-comment-face' foreground.
+Use `my-modus-themes-comment-colors' to extract the color value
+for each level of intensity.
+
+This is complementary to `my-modus-themes-adjust-comment-color'."
+ (let* ((colors my-modus-themes-comment-colors)
+ (levels (pcase (car custom-enabled-themes)
+ ('modus-operandi (alist-get 'light colors))
+ ('modus-vivendi (alist-get 'dark colors)))))
+ (set-face-foreground
+ 'font-lock-comment-face
+ (alist-get degree levels))
+ (setq my-modus-themes--adjust-comment-color-state state)
+ (message "Comments are set to %s contrast" degree)))
+
+(defun my-modus-themes-adjust-comment-color ()
+ "Cycle through levels of intensity for comments.
+The levels are determined by `my-modus-themes-comment-colors'."
+ (interactive)
+ (pcase my-modus-themes--adjust-comment-color-state
+ ('nil
+ (my-modus-themes--comment-foreground 'low 1))
+ (1
+ (my-modus-themes--comment-foreground 'medium 2))
+ (_
+ (my-modus-themes--comment-foreground 'high nil))))
+#+end_src
+
+The effect of the above configurations on ~font-lock-comment-face~ is
+global. To make it buffer-local, one must tweak the code to employ the
+function ~face-remap-add-relative~ ([[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value]]).
+
+So this form in ~my-modus-themes--comment-foreground~:
+
+#+begin_src emacs-lisp
+;; example 1
+(...
+ (set-face-foreground
+ 'font-lock-comment-face
+ (modus-themes-color (alist-get degree palette-colors)))
+ ...)
+
+;; example 2
+(...
+ (set-face-foreground
+ 'font-lock-comment-face
+ (alist-get degree levels))
+ ...)
+#+end_src
+
+Must become this:
+
+#+begin_src emacs-lisp
+;; example 1
+(...
+ (face-remap-add-relative
+ 'font-lock-comment-face
+ `(:foreground ,(modus-themes-color (alist-get degree palette-colors))))
+ ...)
+
+;; example 2
+(...
+ (face-remap-add-relative
+ 'font-lock-comment-face
+ `(:foreground ,(alist-get degree levels)))
+ ...)
+#+end_src
+
+** Override colors (DIY)
+:properties:
+:custom_id: h:307d95dd-8dbd-4ece-a543-10ae86f155a6
+:end:
+#+vindex: modus-themes-operandi-color-overrides
+#+vindex: modus-themes-vivendi-color-overrides
+#+cindex: Change a theme's colors
+
+The themes provide a mechanism for overriding their color values. This
+is controlled by the variables ~modus-themes-operandi-color-overrides~ and
+~modus-themes-vivendi-color-overrides~, which are alists that should
+mirror a subset of the associations in ~modus-themes-operandi-colors~ and
+~modus-themes-vivendi-colors~ respectively. As with all customisations,
+overriding must be done before loading the affected theme.
+
+Let us approach the present topic one step at a time. Here is a
+simplified excerpt of the default palette for Modus Operandi with some
+basic background values that apply to buffers and the mode line
+(remember to inspect the actual value to find out all the associations
+that can be overridden):
+
+#+begin_src emacs-lisp
+(defconst modus-themes-operandi-colors
+ '((bg-main . "#ffffff")
+ (bg-dim . "#f8f8f8")
+ (bg-alt . "#f0f0f0")
+ (bg-active . "#d7d7d7")
+ (bg-inactive . "#efefef")))
+#+end_src
+
+As one can tell, we bind a key to a hexadecimal RGB color value. Now
+say we wish to override those specific values and have our changes
+propagate to all faces that use those keys. We could write something
+like this, which adds a subtle ochre tint:
+
+#+begin_src emacs-lisp
+(setq modus-themes-operandi-color-overrides
+ '((bg-main . "#fefcf4")
+ (bg-dim . "#faf6ef")
+ (bg-alt . "#f7efe5")
+ (bg-active . "#e8dfd1")
+ (bg-inactive . "#f6ece5")))
+#+end_src
+
+Once this is evaluated, any subsequent loading of ~modus-operandi~ will
+use those values instead of the defaults. No further intervention is
+required.
+
+To reset the changes, we apply this and reload the theme:
+
+#+begin_src emacs-lisp
+(setq modus-themes-operandi-color-overrides nil)
+#+end_src
+
+Users who wish to leverage such a mechanism can opt to implement it
+on-demand by means of a global minor mode. The following snippet covers
+both themes and expands to some more assosiations in the palette:
+
+#+begin_src emacs-lisp
+(define-minor-mode my-modus-themes-tinted
+ "Tweak some Modus themes colors."
+ :init-value nil
+ :global t
+ (if my-modus-themes-tinted
+ (setq modus-themes-operandi-color-overrides
+ '((bg-main . "#fefcf4")
+ (bg-dim . "#faf6ef")
+ (bg-alt . "#f7efe5")
+ (bg-hl-line . "#f4f0e3")
+ (bg-active . "#e8dfd1")
+ (bg-inactive . "#f6ece5")
+ (bg-region . "#c6bab1")
+ (bg-header . "#ede3e0")
+ (bg-tab-bar . "#dcd3d3")
+ (bg-tab-active . "#fdf6eb")
+ (bg-tab-inactive . "#c8bab8")
+ (fg-unfocused . "#55556f"))
+ modus-themes-vivendi-color-overrides
+ '((bg-main . "#100b17")
+ (bg-dim . "#161129")
+ (bg-alt . "#181732")
+ (bg-hl-line . "#191628")
+ (bg-active . "#282e46")
+ (bg-inactive . "#1a1e39")
+ (bg-region . "#393a53")
+ (bg-header . "#202037")
+ (bg-tab-bar . "#262b41")
+ (bg-tab-active . "#120f18")
+ (bg-tab-inactive . "#3a3a5a")
+ (fg-unfocused . "#9a9aab")))
+ (setq modus-themes-operandi-color-overrides nil
+ modus-themes-vivendi-color-overrides nil)))
+#+end_src
+
+With this in place, one can invoke {{{kbd(M-x my-modus-themes-tinted)}}} and
+then load the Modus theme of their choice. The new palette subset will
+come into effect: subtle ochre tints for Modus Operandi and night sky
+shades for Modus Vivendi. Switching between the two themes, such as
+with {{{kbd(M-x modus-themes-toggle)}}} will also use the overrides.
+
+Given that this is a user-level customisation, one is free to implement
+whatever color values they desire, even if the possible combinations
+fall below the minimum 7:1 contrast ratio that governs the design of the
+themes (the WCAG AAA legibility standard). Alternatively, this can also
+be done programmatically ([[#h:4589acdc-2505-41fc-9f5e-699cfc45ab00][Override color saturation]]).
+
+For manual interventions it is advised to inspect the source code of
+~modus-themes-operandi-colors~ and ~modus-themes-vivendi-colors~ for the
+inline commentary: it explains what the intended use of each palette
+subset is.
+
+Furthermore, users may benefit from the ~modus-themes-contrast~ function
+that we provide: [[#h:02e25930-e71a-493d-828a-8907fc80f874][test color combinations]]. It measures the contrast
+ratio between two color values, so it can help in overriding the palette
+(or a subset thereof) without making the end result inaccessible.
+
+** Override color saturation (DIY)
+:properties:
+:custom_id: h:4589acdc-2505-41fc-9f5e-699cfc45ab00
+:end:
+#+cindex: Change a theme's color saturation
+
+In the previous section we documented how one can override color values
+manually ([[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]]). Here we use a programmatic approach which
+leverages the built-in ~color-saturate-name~ function to adjust the
+saturation of all color values used by the active Modus theme. Our goal
+is to prepare a counterpart of the active theme's palette that holds
+modified color values, adjusted for a percent change in saturation. A
+positive number amplifies the effect, while a negative one will move
+towards a grayscale spectrum.
+
+We start with a function that can be either called from Lisp or invoked
+interactively. In the former scenario, we pass to it the rate of change
+we want. While in the latter, a minibuffer prompt asks for a number to
+apply the desired effect. In either case, we intend to assign anew the
+value of ~modus-themes-operandi-color-overrides~ (light theme) and the
+same for ~modus-themes-vivendi-color-overrides~ (dark theme).
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-saturate (percent)
+ "Saturate current Modus theme palette overrides by PERCENT."
+ (interactive
+ (list (read-number "Saturation by percent: ")))
+ (let* ((theme (modus-themes--current-theme))
+ (palette (pcase theme
+ ('modus-operandi modus-themes-operandi-colors)
+ ('modus-vivendi modus-themes-vivendi-colors)
+ (_ (error "No Modus theme is active"))))
+ (overrides (pcase theme
+ ('modus-operandi 'modus-themes-operandi-color-overrides)
+ ('modus-vivendi 'modus-themes-vivendi-color-overrides)
+ (_ (error "No Modus theme is active")))))
+ (let (name cons colors)
+ (dolist (cons palette)
+ (setq name (color-saturate-name (cdr cons) percent))
+ (setq name (format "%s" name))
+ (setq cons `(,(car cons) . ,name))
+ (push cons colors))
+ (set overrides colors))
+ (pcase theme
+ ('modus-operandi (modus-themes-load-operandi))
+ ('modus-vivendi (modus-themes-load-vivendi)))))
+
+;; sample Elisp calls (or call `my-modus-themes-saturate' interactively)
+(my-modus-themes-saturate 50)
+(my-modus-themes-saturate -75)
+#+end_src
+
+Using the above has an immediate effect, as it reloads the active Modus
+theme.
+
+The =my-modus-themes-saturate= function stores new color values in the
+variables =modus-themes-operandi-color-overrides= and
+=modus-themes-vivendi-color-overrides=, meaning that it undoes changes
+implemented by the user on individual colors. To have both automatic
+saturation adjustment across the board and retain per-case edits to the
+palette, some tweaks to the above function are required. For example:
+
+#+begin_src emacs-lisp
+(defvar my-modus-themes-vivendi-extra-color-overrides
+ '((fg-main . "#ead0c0")
+ (bg-main . "#050515"))
+ "My bespoke colors for `modus-vivendi'.")
+
+(defvar my-modus-themes-operandi-extra-color-overrides
+ '((fg-main . "#1a1a1a")
+ (bg-main . "#fefcf4"))
+ "My bespoke colors for `modus-operandi'.")
+
+(defun my-modus-themes-saturate (percent)
+ "Saturate current Modus theme palette overrides by PERCENT.
+Preserve the color values stored in
+`my-modus-themes-operandi-extra-color-overrides',
+`my-modus-themes-vivendi-extra-color-overrides'."
+ (interactive
+ (list (read-number "Saturation by percent: ")))
+ (let* ((theme (modus-themes--current-theme))
+ (palette (pcase theme
+ ('modus-operandi modus-themes-operandi-colors)
+ ('modus-vivendi modus-themes-vivendi-colors)
+ (_ (error "No Modus theme is active"))))
+ (overrides (pcase theme
+ ('modus-operandi 'modus-themes-operandi-color-overrides)
+ ('modus-vivendi 'modus-themes-vivendi-color-overrides)
+ (_ (error "No Modus theme is active"))))
+ (extra-overrides (pcase theme
+ ('modus-operandi my-modus-themes-operandi-extra-color-overrides)
+ ('modus-vivendi my-modus-themes-vivendi-extra-color-overrides)
+ (_ (error "No Modus theme is active")))))
+ (let (name cons colors)
+ (dolist (cons palette)
+ (setq name (color-saturate-name (cdr cons) percent))
+ (setq name (format "%s" name))
+ (setq cons `(,(car cons) . ,name))
+ (push cons colors))
+ (set overrides (append extra-overrides colors)))
+ (pcase theme
+ ('modus-operandi (modus-themes-load-operandi))
+ ('modus-vivendi (modus-themes-load-vivendi)))))
+#+end_src
+
+To disable the effect, one must reset the aforementioned variables of
+the themes to ~nil~. Or specify a command for it, such as by taking
+inspiration from the ~modus-themes-toggle~ we already provide:
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-revert-overrides ()
+ "Reset palette overrides and reload active Modus theme."
+ (interactive)
+ (setq modus-themes-operandi-color-overrides nil
+ modus-themes-vivendi-color-overrides nil)
+ (pcase (modus-themes--current-theme)
+ ('modus-operandi (modus-themes-load-operandi))
+ ('modus-vivendi (modus-themes-load-vivendi))))
+#+end_src
+
+** Font configurations for Org and others (DIY)
+:properties:
+:custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929
+:end:
+#+cindex: Font configurations
+
+The themes are designed to cope well with mixed font configurations.
+
+[[#h:115e6c23-ee35-4a16-8cef-e2fcbb08e28b][Option for no font mixing]].
+
+This mostly concerns ~org-mode~ and ~markdown-mode~, though expect to find
+it elsewhere like in ~Info-mode~.
+
+In practice it means that the user can safely opt for a more
+prose-friendly proportionately spaced typeface as their default, while
+letting spacing-sensitive elements like tables and inline code always
+use a monospaced font, by inheriting from the ~fixed-pitch~ face.
+
+Users can try the built-in {{{kbd(M-x variable-pitch-mode)}}} to see the
+effect in action.
+
+To make everything use your desired font families, you need to configure
+the ~variable-pitch~ (proportional spacing) and ~fixed-pitch~ (monospaced)
+faces respectively. It may also be convenient to set your main typeface
+by configuring the ~default~ face the same way.
+
+Put something like this in your initialization file (also consider
+reading the doc string of ~set-face-attribute~):
+
+#+begin_src emacs-lisp
+;; Main typeface
+(set-face-attribute 'default nil :family "DejaVu Sans Mono" :height 110)
+
+;; Proportionately spaced typeface
+(set-face-attribute 'variable-pitch nil :family "DejaVu Serif" :height 1.0)
+
+;; Monospaced typeface
+(set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.0)
+#+end_src
+
+The next section shows how to make those work in a more elaborate setup
+that is robust to changes between the Modus themes.
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
+Note the differences in the ~:height~ property. The ~default~ face must
+specify an absolute value, which is the point size × 10. So if you want
+to use a font at point size =11=, you set the height to =110=.[fn:: ~:height~
+values do not need to be rounded to multiples of ten: the likes of =115=
+are perfectly valid—some typefaces will change to account for those
+finer increments.] Whereas every other face must have a value that is
+relative to the default, represented as a floating point (if you use an
+integer, then that means an absolute height). This is of paramount
+importance: it ensures that all fonts can scale gracefully when using
+something like the ~text-scale-adjust~ command which only operates on the
+base font size (i.e. the ~default~ face's absolute height).
+
+[[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts (SHR fonts)]].
+
+** Configure bold and italic faces (DIY)
+:properties:
+:custom_id: h:2793a224-2109-4f61-a106-721c57c01375
+:end:
+#+cindex: Bold and italic fonts
+
+The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the
+thousands of faces they cover. Instead, they configure the generic
+faces called ~bold~ and ~italic~ to use the appropriate styles and then
+instruct all relevant faces that require emphasis to inherit from them.
+
+This practically means that users can change the particularities of what
+it means for a construct to be bold/italic, by tweaking the ~bold~ and
+~italic~ faces. Cases where that can be useful include:
+
++ The default typeface does not have a variant with slanted glyphs
+ (e.g. Fira Mono/Code as of this writing on 2021-07-07), so the user
+ wants to add another family for the italics, such as Hack.
+
++ The typeface of choice provides a multitude of weights and the user
+ prefers the light one by default. To prevent the bold weight from
+ being too heavy compared to the light one, they opt to make ~bold~ use a
+ semibold weight.
+
++ The typeface distinguishes between oblique and italic forms by
+ providing different font variants (the former are just slanted
+ versions of the upright forms, while the latter have distinguishing
+ features as well). In this case, the user wants to specify the font
+ that applies to the ~italic~ face.
+
+To achieve those effects, one must first be sure that the fonts they use
+have support for those features. It then is a matter of following the
+instructions for all face tweaks.
+
+[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]].
+
+In this example, we set the default font family to Fira Code, while we
+choose to render italics in the Hack typeface (obviously you need to
+pick fonts that work well together):
+
+#+begin_src emacs-lisp
+(set-face-attribute 'default nil :family "Fira Code" :height 110)
+(set-face-attribute 'italic nil :family "Hack")
+#+end_src
+
+And here we play with different weights, using Source Code Pro:
+
+#+begin_src emacs-lisp
+(set-face-attribute 'default nil :family "Source Code Pro" :height 110 :weight 'light)
+(set-face-attribute 'bold nil :weight 'semibold)
+#+end_src
+
+To reset the font family, one can use this:
+
+#+begin_src emacs-lisp
+(set-face-attribute 'italic nil :family 'unspecified)
+#+end_src
+
+To ensure that the effects persist after switching between the Modus
+themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to
+write their configurations to a function and hook it up to the
+~modus-themes-after-load-theme-hook~. This is necessary because the
+themes set the default styles of faces (otherwise changing themes would
+not be possible).
+
+[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme loading]].
+
+This is a minimal setup to preserve font configurations across theme
+load phases. For a more permanent setup, it is better to employ the
+~custom-set-faces~ function: ~set-face-attribute~ works just fine, though it
+is more convenient for quick previews or for smaller scale operations
+(~custom-set-faces~ follows the format used in the source code of the
+themes).
+
+#+begin_src emacs-lisp
+;; our generic function
+(defun my-modes-themes-bold-italic-faces ()
+ (set-face-attribute 'default nil :family "Source Code Pro" :height 110)
+ (set-face-attribute 'bold nil :weight 'semibold))
+
+;; or use this if you configure a lot of face and attributes and
+;; especially if you plan to use `modus-themes-with-colors', as shown
+;; elsewhere in the manual
+(defun my-modes-themes-bold-italic-faces ()
+ (custom-set-faces
+ '(default ((t :family "Source Code Pro" :height 110)))
+ '(bold ((t :weight semibold)))))
+
+;; and here is the hook
+(add-hook 'modus-themes-after-load-theme-hook #'my-modes-themes-bold-italic-faces)
+#+end_src
+
+** Custom Org user faces (DIY)
+:properties:
+:custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad
+:end:
+#+cindex: Org extra faces
+
+Users of ~org-mode~ have the option to configure various keywords and
+priority cookies to better match their workflow. User options are
+~org-todo-keyword-faces~ and ~org-priority-faces~.
+
+As those are meant to be custom faces, it is futile to have the themes
+guess what each user wants to use, which keywords to target, and so on.
+Instead, we can provide guidelines on how to customize things to one's
+liking with the intent of retaining the overall aesthetic of the themes.
+
+Please bear in mind that the end result of those is not controlled by
+the active Modus theme but by how Org maps faces to its constructs.
+Editing those while ~org-mode~ is active requires re-initialization of the
+mode with {{{kbd(M-x org-mode-restart)}}} for changes to take effect.
+
+Let us assume you wish to visually differentiate your keywords. You
+have something like this:
+
+#+begin_src emacs-lisp
+(setq org-todo-keywords
+ '((sequence "TODO(t)" "|" "DONE(D)" "CANCEL(C)")
+ (sequence "MEET(m)" "|" "MET(M)")
+ (sequence "STUDY(s)" "|" "STUDIED(S)")
+ (sequence "WRITE(w)" "|" "WROTE(W)")))
+#+end_src
+
+You could then use a variant of the following to inherit from a face
+that uses the styles you want and also to preserve the properties
+applied by the ~org-todo~ face (in case there is a difference between the
+two):
+
+#+begin_src emacs-lisp
+(setq org-todo-keyword-faces
+ '(("MEET" . '(font-lock-preprocessor-face org-todo))
+ ("STUDY" . '(font-lock-variable-name-face org-todo))
+ ("WRITE" . '(font-lock-type-face org-todo))))
+#+end_src
+
+This will refashion the keywords you specify, while letting the other
+items in ~org-todo-keywords~ use their original styles (which are defined
+in the ~org-todo~ and ~org-done~ faces).
+
+If you want back the defaults, try specifying just the ~org-todo~ face:
+
+#+begin_src emacs-lisp
+(setq org-todo-keyword-faces
+ '(("MEET" . org-todo)
+ ("STUDY" . org-todo)
+ ("WRITE" . org-todo)))
+#+end_src
+
+When you inherit from multiple faces, you need to quote the list as
+shown further above. The order is significant: the first entry is
+applied on top of the second, overriding any properties that are
+explicitly set for both of them: any property that is not specified is
+not overridden, so, for example, if ~org-todo~ has a background and a
+foreground, while ~font-lock-type-face~ only has a foreground, the merged
+face will include the background of the former and the foreground of the
+latter. If you do not want to blend multiple faces, you do not need a
+quoted list. A pattern of =keyword . face= will suffice.
+
+Both approaches can be used simultaneously, as illustrated in this
+configuration of the priority cookies:
+
+#+begin_src emacs-lisp
+(setq org-priority-faces
+ '((?A . '(org-scheduled-today org-priority))
+ (?B . org-priority)
+ (?C . '(shadow org-priority))))
+#+end_src
+
+To find all the faces that are loaded in your current Emacs session, use
+{{{kbd(M-x list-faces-display)}}}. Try {{{kbd(M-x describe-variable)}}} as well and
+then specify the name of each of those Org variables demonstrated above.
+Their documentation strings will offer you further guidance.
+
+Recall that the themes let you retrieve a color from their palette. Do
+it if you plan to control face attributes.
+
+[[#h:1487c631-f4fe-490d-8d58-d72ffa3bd474][Custom face specs using the themes' palette]].
+
+[[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]].
+
+** Update Org block delimiter fontification (DIY)
+:properties:
+:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50
+:end:
+
+As noted in the section about ~modus-themes-org-blocks~, Org contains a
+variable that determines whether the block's begin and end lines are
+extended to the edge of the window ([[#h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2][Option for org-mode block styles]]).
+The variable is ~org-fontify-whole-block-delimiter-line~.
+
+Users who change the style of Org blocks from time to time may prefer to
+automatically update delimiter line fontification, such as with the
+following setup:
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-org-fontify-block-delimiter-lines ()
+ "Match `org-fontify-whole-block-delimiter-line' to theme style.
+Run this function at the post theme load phase, such as with the
+`modus-themes-after-load-theme-hook'."
+ (if (eq modus-themes-org-blocks 'gray-background)
+ (setq org-fontify-whole-block-delimiter-line t)
+ (setq org-fontify-whole-block-delimiter-line nil)))
+
+(add-hook 'modus-themes-after-load-theme-hook
+ #'my-modus-themes-org-fontify-block-delimiter-lines)
+#+end_src
+
+Then {{{kbd(M-x org-mode-restart)}}} for changes to take effect, though manual
+intervention can be circumvented by tweaking the function thus:
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-org-fontify-block-delimiter-lines ()
+ "Match `org-fontify-whole-block-delimiter-line' to theme style.
+Run this function at the post theme load phase, such as with the
+`modus-themes-after-load-theme-hook'."
+ (if (eq modus-themes-org-blocks 'gray-background)
+ (setq org-fontify-whole-block-delimiter-line t)
+ (setq org-fontify-whole-block-delimiter-line nil))
+ (when (derived-mode-p 'org-mode)
+ (font-lock-flush)))
+#+end_src
+
+** Measure color contrast (DIY)
+:properties:
+:custom_id: h:02e25930-e71a-493d-828a-8907fc80f874
+:end:
+#+findex: modus-themes-contrast
+#+findex: modus-themes-wcag-formula
+#+cindex: Color contrast
+
+The themes provide the functions ~modus-themes-wcag-formula~ and
+~modus-themes-contrast~. The former is a direct implementation of the
+WCAG formula: <https://www.w3.org/TR/WCAG20-TECHS/G18.html>. It
+calculates the relative luminance of a color value that is expressed in
+hexadecimal RGB notation. While the latter function is just a
+convenient wrapper for comparing the relative luminance between two
+colors.
+
+In practice, one needs to work only with ~modus-themes-contrast~. It
+accepts two color values and returns their contrast ratio. Values range
+from 1 to 21 (lowest to highest). The themes are designed to always be
+equal or higher than 7 for each combination of background and foreground
+that they use (this is the WCAG AAA standard---the most demanding of its
+kind).
+
+A couple of examples (rounded numbers):
+
+#+begin_src emacs-lisp
+;; Pure white with pure green
+(modus-themes-contrast "#ffffff" "#00ff00")
+;; => 1.37
+;; That is an outright inaccessible combo
+
+;; Pure black with pure green
+(modus-themes-contrast "#000000" "#00ff00")
+;; => 15.3
+;; That is is a highly accessible combo
+#+end_src
+
+It does not matter which color value comes first. The ratio is always
+the same.
+
+If one does not wish to read all the decimal points, it is possible to
+try something like this:
+
+#+begin_src emacs-lisp
+(format "%0.2f" (modus-themes-contrast "#000000" "#00ff00"))
+#+end_src
+
+While it is fine to perform such calculations on a case-by-case basis,
+it is preferable to implement formulas and tables for more demanding
+tasks. Such instruments are provided by ~org-mode~ or ~orgtbl-mode~, both
+of which are built into Emacs. Below is such a table that derives the
+contrast ratio of all colors in the first column (pure red, green, blue)
+relative to the color specified in the first row of the second column
+(pure white) and rounds the results:
+
+#+begin_example
+| | #ffffff |
+|---------+---------|
+| #ff0000 | 4.00 |
+| #00ff00 | 1.37 |
+| #0000ff | 8.59 |
+#+tblfm: $2='(modus-themes-contrast $1 @1$2);%0.2f
+#+end_example
+
+To measure color contrast one needs to start from a known value. This
+typically is the background. The Modus themes define an expanded
+palette in large part because certain colors are only meant to be used
+in combination with some others. Consult the source code for the
+minutia and relevant commentary.
+
+Such knowledge may prove valuable while attempting to override some of
+the themes' colors: [[#h:307d95dd-8dbd-4ece-a543-10ae86f155a6][Override colors]].
+
+** Load theme depending on time of day (DIY)
+:properties:
+:custom_id: h:1d1ef4b4-8600-4a09-993c-6de3af0ddd26
+:end:
+
+While we do provide ~modus-themes-toggle~ to manually switch between the
+themes, users may also set up their system to perform such a task
+automatically at sunrise and sunset.
+
+This can be accomplished by specifying the coordinates of one's location
+using the built-in {{{file(solar.el)}}} and then configuring the =circadian=
+package:
+
+#+begin_src emacs-lisp
+(use-package solar ; built-in
+ :config
+ (setq calendar-latitude 35.17
+ calendar-longitude 33.36))
+
+(use-package circadian ; you need to install this
+ :ensure
+ :after solar
+ (setq circadian-themes '((:sunrise . modus-operandi)
+ (:sunset . modus-vivendi)))
+ (circadian-setup))
+#+end_src
+
+** Backdrop for pdf-tools (DIY)
+:properties:
+:custom_id: h:ff69dfe1-29c0-447a-915c-b5ff7c5509cd
+:end:
+#+cindex: Remapping pdf-tools backdrop
+
+Most PDF files use a white background for their page, making it
+impossible to discern the file's boundaries in the buffer while using
+the Modus Operandi theme. To introduce a distinction between the
+buffer's backdrop and the PDF page's background, the former must be
+rendered as some shade of gray. Ideally, ~pdf-tools~ would provide a face
+that the themes could support directly, though this does not seem to be
+the case for the time being. We must thus employ the face remapping
+technique that is documented elsewhere in this document to change the
+buffer-local value of the ~default~ face.
+
+[[#h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f][Remap face with local value]].
+
+To remap the buffer's backdrop, we start with a function like this one:
+
+#+begin_src emacs-lisp
+(defun my-pdf-tools-backdrop ()
+ (face-remap-add-relative
+ 'default
+ `(:background ,(modus-themes-color 'bg-alt))))
+
+(add-hook 'pdf-tools-enabled-hook #'my-pdf-tools-backdrop)
+#+end_src
+
+The idea is to assign that function to a hook that gets called when
+~pdf-tools~ renders the document: ~pdf-tools-enabled-hook~. This is enough
+when you only use one theme. However it has the downside of setting the
+background color value only at render time. In other words, the face
+remapping function does not get evaluated anew whenever the theme
+changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}.
+
+To have our face remapping adapt gracefully while switching between the
+Modus themes, we need to also account for the current theme and control
+the activation of ~pdf-view-midnight-minor-mode~. To which end we arrive
+at something like the following, which builds on the above example:
+
+#+begin_src emacs-lisp
+(defun my-pdf-tools-backdrop ()
+ (face-remap-add-relative
+ 'default
+ `(:background ,(modus-themes-color 'bg-alt))))
+
+(defun my-pdf-tools-midnight-mode-toggle ()
+ (when (derived-mode-p 'pdf-view-mode)
+ (if (eq (car custom-enabled-themes) 'modus-vivendi)
+ (pdf-view-midnight-minor-mode 1)
+ (pdf-view-midnight-minor-mode -1))
+ (my-pdf-tools-backdrop)))
+
+(add-hook 'pdf-tools-enabled-hook #'my-pdf-tools-midnight-mode-toggle)
+(add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-midnight-mode-toggle)
+#+end_src
+
+With those in place, PDFs have a distinct backdrop for their page, while
+they automatically switch to their dark mode when ~modus-themes-toggle~ is
+called from inside a buffer whose major-mode is ~pdf-view-mode~.
+
+** A theme-agnostic hook for theme loading (DIY)
+:properties:
+:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776
+:end:
+
+The themes are designed with the intent to be useful to Emacs users of
+varying skill levels, from beginners to experts. This means that we try
+to make things easier by not expecting anyone reading this document to
+be proficient in Emacs Lisp or programming in general.
+
+Such a case is with the use of the ~modus-themes-after-load-theme-hook~,
+which runs after ~modus-themes-toggle~, ~modus-themes-load-operandi~, or
+~modus-themes-load-vivendi~ is evaluated. We recommend using that hook
+for advanced customizations, because (1) we know for sure that it is
+available once the themes are loaded, and (2) anyone consulting this
+manual, especially the sections on enabling and loading the themes, will
+be in a good position to benefit from that hook.
+
+Advanced users who have a need to switch between the Modus themes and
+other items will find that such a hook does not meet their requirements:
+it only works with the Modus themes and only with the aforementioned
+functions.
+
+A theme-agnostic setup can be configured thus:
+
+#+begin_src emacs-lisp
+(defvar after-enable-theme-hook nil
+ "Normal hook run after enabling a theme.")
+
+(defun run-after-enable-theme-hook (&rest _args)
+ "Run `after-enable-theme-hook'."
+ (run-hooks 'after-enable-theme-hook))
+
+(advice-add 'enable-theme :after #'run-after-enable-theme-hook)
+#+end_src
+
+This creates the ~after-enable-theme-hook~ and makes it run after each
+call to ~enable-theme~, which means that it will work for all themes and
+also has the benefit that it does not depend on functions such as
+~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is
+called internally by ~load-theme~, so the hook works everywhere.
+
+Now this specific piece of Elisp may be simple for experienced users,
+but it is not easy to read for newcomers, including the author of the
+Modus themes for the first several months of their time as an Emacs
+user. Hence our hesitation to recommend it as part of the standard
+setup of the Modus themes (it is generally a good idea to understand
+what the implications are of advising a function).
+
+* Face coverage
+:properties:
+:custom_id: h:a9c8f29d-7f72-4b54-b74b-ddefe15d6a19
+:end:
+
+The Modus themes try to provide as close to full face coverage as
+possible. This is necessary to ensure a consistently accessible reading
+experience across all available interfaces.
+
+** Full support for packages or face groups
+:properties:
+:alt_title: Supported packages
+:description: Full list of covered face groups
+:custom_id: h:60ed4275-60d6-49f8-9287-9a64e54bea0e
+:end:
+#+cindex: Explicitly supported packages
+
+This list will always be updated to reflect the current state of the
+project. The idea is to offer an overview of the known status of all
+affected face groups. The items with an appended asterisk =*= tend to
+have lots of extensions, so the "full support" may not be 100% true…
+
++ ace-window
++ ag
++ alert
++ all-the-icons
++ annotate
++ anzu
++ apropos
++ apt-sources-list
++ artbollocks-mode
++ auctex and TeX
++ auto-dim-other-buffers
++ avy
++ awesome-tray
++ bbdb
++ binder
++ bm
++ bongo
++ boon
++ bookmark
++ breakpoint (provided by the built-in {{{file(gdb-mi.el)}}} library)
++ buffer-expose
++ calendar and diary
++ calfw
++ centaur-tabs
++ cfrs
++ change-log and log-view (such as ~vc-print-log~, ~vc-print-root-log~)
++ cider
++ circe
++ color-rg
++ column-enforce-mode
++ company-mode*
++ company-posframe
++ compilation-mode
++ completions
++ consult
++ corfu
++ counsel*
++ counsel-css
++ counsel-org-capture-string
++ cov
++ cperl-mode
++ css-mode
++ csv-mode
++ ctrlf
++ custom (what you get with {{{kbd(M-x customize)}}})
++ dap-mode
++ dashboard (emacs-dashboard)
++ deadgrep
++ debbugs
++ define-word
++ deft
++ dictionary
++ diff-hl
++ diff-mode
++ dim-autoload
++ dir-treeview
++ dired
++ dired-async
++ dired-git
++ dired-git-info
++ dired-narrow
++ dired-subtree
++ diredc
++ diredfl
++ diredp (dired+)
++ disk-usage
++ display-fill-column-indicator-mode
++ doom-modeline
++ dynamic-ruler
++ easy-jekyll
++ easy-kill
++ ebdb
++ ediff
++ eglot
++ el-search
++ eldoc-box
++ elfeed
++ elfeed-score
++ embark
++ emms
++ enh-ruby-mode (enhanced-ruby-mode)
++ epa
++ equake
++ erc
++ eros
++ ert
++ eshell
++ eshell-fringe-status
++ eshell-git-prompt
++ eshell-prompt-extras (epe)
++ eshell-syntax-highlighting
++ evil* (evil-mode)
++ evil-goggles
++ evil-snipe
++ evil-visual-mark-mode
++ eww
++ exwm
++ eyebrowse
++ fancy-dabbrev
++ flycheck
++ flycheck-color-mode-line
++ flycheck-indicator
++ flycheck-posframe
++ flymake
++ flyspell
++ flyspell-correct
++ flx
++ freeze-it
++ frog-menu
++ focus
++ fold-this
++ font-lock (generic syntax highlighting)
++ forge
++ fountain (fountain-mode)
++ geiser
++ git-commit
++ git-gutter (and variants)
++ git-lens
++ git-rebase
++ git-timemachine
++ git-walktree
++ gnus
++ gotest
++ golden-ratio-scroll-screen
++ helm*
++ helm-ls-git
++ helm-switch-shell
++ helm-xref
++ helpful
++ highlight-blocks
++ highlight-defined
++ highlight-escape-sequences (~hes-mode~)
++ highlight-indentation
++ highlight-numbers
++ highlight-symbol
++ highlight-tail
++ highlight-thing
++ hl-defined
++ hl-fill-column
++ hl-line-mode
++ hl-todo
++ hydra
++ hyperlist
++ ibuffer
++ icomplete
++ icomplete-vertical
++ ido-mode
++ iedit
++ iflipb
++ imenu-list
++ indium
++ info
++ info-colors
++ interaction-log
++ ioccur
++ isearch, occur, etc.
++ isl (isearch-light)
++ ivy*
++ ivy-posframe
++ jira (org-jira)
++ journalctl-mode
++ js2-mode
++ julia
++ jupyter
++ kaocha-runner
++ keycast
++ ledger-mode
++ line numbers (~display-line-numbers-mode~ and global variant)
++ lsp-mode
++ lsp-ui
++ macrostep
++ magit
++ magit-imerge
++ make-mode
++ man
++ marginalia
++ markdown-mode
++ markup-faces (~adoc-mode~)
++ mentor
++ messages
++ minibuffer-line
++ minimap
++ mmm-mode
++ mode-line
++ mood-line
++ moody
++ mpdel
++ mu4e
++ mu4e-conversation
++ multiple-cursors
++ neotree
++ no-emoji
++ notmuch
++ num3-mode
++ nxml-mode
++ objed
++ orderless
++ org*
++ org-journal
++ org-noter
++ org-pomodoro
++ org-recur
++ org-roam
++ org-superstar
++ org-table-sticky-header
++ org-tree-slide
++ org-treescope
++ origami
++ outline-mode
++ outline-minor-faces
++ package (what you get with {{{kbd(M-x list-packages)}}})
++ page-break-lines
++ pandoc-mode
++ paradox
++ paren-face
++ parrot
++ pass
++ pdf-tools
++ persp-mode
++ perspective
++ phi-grep
++ phi-search
++ pkgbuild-mode
++ pomidor
++ popup
++ powerline
++ powerline-evil
++ prism ([[#h:a94272e0-99da-4149-9e80-11a7e67a2cf2][Note for prism.el]])
++ proced
++ prodigy
++ pulse
++ quick-peek
++ racket-mode
++ rainbow-blocks
++ rainbow-identifiers
++ rainbow-delimiters
++ rcirc
++ recursion-indicator
++ regexp-builder (also known as ~re-builder~)
++ rg (rg.el)
++ ripgrep
++ rmail
++ ruler-mode
++ sallet
++ selectrum
++ selectrum-prescient
++ semantic
++ sesman
++ shell-script-mode
++ shortdoc
++ show-paren-mode
++ shr
++ side-notes
++ sieve-mode
++ skewer-mode
++ smart-mode-line
++ smartparens
++ smerge
++ solaire
++ spaceline
++ speedbar
++ spell-fu
++ spray
++ stripes
++ suggest
++ switch-window
++ swiper
++ swoop
++ sx
++ symbol-overlay
++ syslog-mode
++ tab-bar-groups
++ tab-bar-mode
++ tab-line-mode
++ table (built-in table.el)
++ telega
++ telephone-line
++ terraform-mode
++ term
++ tomatinho
++ transient (pop-up windows such as Magit's)
++ trashed
++ treemacs
++ tty-menu
++ tuareg
++ typescript
++ undo-tree
++ vc (vc-dir.el, vc-hooks.el)
++ vc-annotate (the output of {{{kbd(C-x v g)}}})
++ vdiff
++ vertico
++ vimish-fold
++ visible-mark
++ visual-regexp
++ volatile-highlights
++ vterm
++ wcheck-mode
++ web-mode
++ wgrep
++ which-function-mode
++ which-key
++ whitespace-mode
++ window-divider-mode
++ winum
++ writegood-mode
++ woman
++ xah-elisp-mode
++ xref
++ xterm-color (and ansi-colors)
++ yaml-mode
++ yasnippet
++ ztree
+
+Plus many other miscellaneous faces that are provided by the upstream
+GNU Emacs distribution.
+
+** Indirectly covered packages
+:properties:
+:custom_id: h:2cb359c7-3a84-4262-bab3-dcdc1d0034d7
+:end:
+#+cindex: Implicitly supported packages
+
+These do not require any extra styles because they are configured to
+inherit from some basic faces or their dependencies which are directly
+supported by the themes.
+
++ counsel-notmuch
++ edit-indirect
++ evil-owl
++ fortran-mode
++ goggles
++ i3wm-config-mode
++ perl-mode
++ php-mode
++ rjsx-mode
++ swift-mode
++ tab-bar-echo-area
+
+* Notes on individual packages
+:properties:
+:custom_id: h:4c4d901a-84d7-4f20-bd99-0808c2b06eba
+:end:
+
+This section covers information that may be of interest to users of
+individual packages.
+
+** Note on avy hints
+:properties:
+:custom_id: h:2fdce705-6de7-44e6-ab7f-18f59af99e01
+:end:
+
+Hints can appear everywhere, in wildly varying contexts, hence, their
+appearance, by necessity, is a compromise. However, there are various
+options for making them stand out. First is dimming the surroundings:
+
+#+begin_src emacs-lisp
+(setq avy-background t)
+#+end_src
+
+Dimming works well when you find it difficult to spot hints, any hint.
+Second is limiting the number of faces used by hints:
+
+#+begin_src emacs-lisp
+(setq avy-lead-faces
+ '(avy-lead-face
+ avy-lead-face-1
+ avy-lead-face-1
+ avy-lead-face-1
+ avy-lead-face-1))
+#+end_src
+
+Limiting the number of faces works well with longer hints when you find
+it difficult to identify individual hints, especially with hints
+touching each other. The first character of the hint will have an
+intense color, the remaining ones the same neutral color.
+
+Third is preferring commands that produce fewer candidates. Fewer hints
+is less noise: ~avy-goto-char-timer~ is an excellent alternative to
+~avy-goto-char~.
+
+** Note on calendar.el weekday and weekend colors
+:properties:
+:custom_id: h:b2db46fb-32f4-44fd-8e11-d2b261cf51ae
+:end:
+
+By default, the {{{kbd(M-x calendar)}}} interface differentiates weekdays from
+weekends by applying a gray color to the former and a faint red to the
+latter. The idea for this approach is that the weekend should serve as
+a subtle warning that no work is supposed to be done on that day, per
+the design of traditional calendars.
+
+Users who prefer all days to look the same can configure the variable
+~calendar-weekend-days~ to either use gray of weekdays or the faint red of
+weekends uniformly.
+
+#+begin_src emacs-lisp
+;; All are treated like weekdays (gray color)
+(setq calendar-weekend-days nil)
+
+;; All are treated like weekends (red-faint color)
+(setq calendar-weekend-days (number-sequence 0 6))
+
+;; The default marks the Saturday and Sunday as the weekend
+(setq calendar-weekend-days '(0 6))
+#+end_src
+
+For changes to take effect, the Calendar buffer needs to be generated
+anew.
+
+** Note on underlines in compilation buffers
+:properties:
+:custom_id: h:420f5a33-c7a9-4112-9b04-eaf2cbad96bd
+:end:
+
+Various buffers that produce compilation results or run tests on code
+apply an underline to the file names they reference or to relevant
+messages. Users may consider this unnecessary or excessive.
+
+To outright disable the effect, use this:
+
+#+begin_src emacs-lisp
+(setq compilation-message-face nil)
+#+end_src
+
+If some element of differentiation is still desired, a good option is to
+render the affected text using the ~italic~ face:
+
+#+begin_src emacs-lisp
+(setq compilation-message-face 'italic)
+#+end_src
+
+[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+
+** Note on inline Latex in Org buffers
+:properties:
+:custom_id: h:dd8478da-f56a-45cd-b199-b836c85c3c5a
+:end:
+
+Org can work with inline latex and related syntax. To actually fontify
+those constructs, set the variable ~org-highlight-latex-and-related~ to
+the desired list of values (per its doc string). For example:
+
+#+begin_src emacs-lisp
+(setq org-highlight-latex-and-related '(latex script))
+#+end_src
+
+Remember to use {{{kbd(M-x org-mode-restart)}}} for changes to take effect.
+
+** Note on dimmer.el
+:properties:
+:custom_id: h:8eb4b758-d318-4480-9ead-357a571beb93
+:end:
+
+The {{{file(dimmer.el)}}} library by Neil Okamoto can be configured to
+automatically dim the colors of inactive Emacs windows. To guarantee
+consistent results with the Modus themes, we suggest some tweaks to the
+default styles, such as in this minimal setup:
+
+#+begin_src emacs-lisp
+(use-package dimmer
+ :config
+ (setq dimmer-fraction 0.3)
+ (setq dimmer-adjustment-mode :foreground)
+ (setq dimmer-use-colorspace :rgb)
+
+ (dimmer-mode 1))
+#+end_src
+
+Of the above, we strongly recommend the RGB color space because it is
+the one that remains faithful to the hueness of the colors used by the
+themes. Whereas the default CIELAB space has a tendency to distort
+colors in addition to applying the dim effect, which can be somewhat
+disorienting.
+
+The value of the ~dimmer-fraction~ has been selected empirically. Users
+might prefer to tweak it further (increasing it makes the dim effect
+more pronounced).
+
+Changing the ~dimmer-adjustment-mode~ is a matter of preference. Though
+because the Modus themes use black and white as their base colors, any
+other value for that variable will turn the main background gray. This
+inadvertently leads to the opposite of the intended utility of this
+package: it draws too much attention to unfocused windows.
+
+** Note on display-fill-column-indicator-mode
+:properties:
+:custom_id: h:2a602816-bc1b-45bf-9675-4cbbd7bf6cab
+:end:
+
+While designing the style for ~display-fill-column-indicator-mode~, we
+stayed close to the mode's defaults: to apply a subtle foreground color
+to the ~fill-column-indicator~ face, which blends well with the rest of
+theme and is consistent with the role of that mode. This is to not
+upset the expectations of users.
+
+Nevertheless, ~display-fill-column-indicator-mode~ has some known
+limitations pertaining to its choice of using typographic characters to
+draw its indicator. What should be a continuous vertical line might
+appear as a series of dashes in certain contexts or under specific
+conditions: a non-default value for ~line-spacing~, scaled and/or
+variable-pitch headings have been observed to cause this effect.
+
+Given that we cannot control such factors, it may be better for affected
+users to deviate from the default style of the ~fill-column-indicator~
+face. Instead of setting a foreground color, one could use a background
+and have the foreground be indistinguishable from it. For example:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (custom-set-faces
+ `(fill-column-indicator ((,class :background ,bg-inactive
+ :foreground ,bg-inactive)))))
+#+end_src
+
+[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]].
+
+** Note on mmm-mode.el background colors
+:properties:
+:custom_id: h:99cf0d6c-e478-4e26-9932-3bf3427d13f6
+:end:
+
+The faces used by {{{file(mmm-mode.el)}}} are expected to have a colorful
+background, while they should not touch any foreground value. The idea
+is that they must not interfere with existing fontification. Those
+background colors need to be distinct from each other, such as an
+unambiguous red juxtaposed with a clear blue.
+
+While this design may be internally consistent with the raison d'être of
+that library, it inevitably produces inaccessible color combinations.
+
+There are two competing goals at play:
+
+1. Legibility of the text, understood as the contrast ratio between the
+ background and the foreground.
+
+2. Semantic precision of each face which entails faithfulness to
+ color-coding of the underlying background.
+
+As the Modus themes are designed with the express purpose of conforming
+with the first point, we have to forgo the apparent color-coding of the
+background elements. Instead we use subtle colors that do not undermine
+the legibility of the affected text while they still offer a sense of
+added context.
+
+Users who might prefer to fall below the minimum 7:1 contrast ratio in
+relative luminance (the accessibility target we conform with), can opt
+to configure the relevant faces on their own.
+
+[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]].
+
+This example uses more vivid background colors, though it comes at the
+very high cost of degraded legibility.
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (custom-set-faces
+ `(mmm-cleanup-submode-face ((,class :background ,yellow-refine-bg)))
+ `(mmm-code-submode-face ((,class :background ,bg-active)))
+ `(mmm-comment-submode-face ((,class :background ,blue-refine-bg)))
+ `(mmm-declaration-submode-face ((,class :background ,cyan-refine-bg)))
+ `(mmm-default-submode-face ((,class :background ,bg-alt)))
+ `(mmm-init-submode-face ((,class :background ,magenta-refine-bg)))
+ `(mmm-output-submode-face ((,class :background ,red-refine-bg)))
+ `(mmm-special-submode-face ((,class :background ,green-refine-bg)))))
+#+end_src
+
+** Note on prism.el
+:properties:
+:alt_title: Note for prism
+:custom_id: h:a94272e0-99da-4149-9e80-11a7e67a2cf2
+:end:
+
+This package by Adam Porter, aka "alphapapa" or "github-alphapapa",
+implements an alternative to the typical coloration of code. Instead of
+highlighting the syntactic constructs, it applies color to different
+levels of depth in the code structure.
+
+As {{{file(prism.el)}}} offers a broad range of customisations, we cannot
+style it directly at the theme level: that would run contrary to the
+spirit of the package. Instead, we may offer preset color schemes.
+Those should offer a starting point for users to adapt to their needs.
+
+In the following code snippets, we employ the ~modus-themes-with-colors~
+macro: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]].
+
+These are the minimum recommended settings with 16 colors:
+
+#+begin_src emacs-lisp
+(setq prism-num-faces 16)
+
+(prism-set-colors
+ :desaturations '(0) ; do not change---may lower the contrast ratio
+ :lightens '(0) ; same
+ :colors (modus-themes-with-colors
+ (list fg-main
+ magenta
+ cyan-alt-other
+ magenta-alt-other
+ blue
+ magenta-alt
+ cyan-alt
+ red-alt-other
+ green
+ fg-main
+ cyan
+ yellow
+ blue-alt
+ red-alt
+ green-alt-other
+ fg-special-warm)))
+#+end_src
+
+With 8 colors:
+
+#+begin_src emacs-lisp
+(setq prism-num-faces 8)
+
+(prism-set-colors
+ :desaturations '(0) ; do not change---may lower the contrast ratio
+ :lightens '(0) ; same
+ :colors (modus-themes-with-colors
+ (list fg-special-cold
+ magenta
+ magenta-alt-other
+ cyan-alt-other
+ fg-main
+ blue-alt
+ red-alt-other
+ cyan)))
+#+end_src
+
+And this is with 4 colors, which produces results that are the closest
+to the themes' default aesthetic:
+
+#+begin_src emacs-lisp
+(setq prism-num-faces 4)
+
+(prism-set-colors
+ :desaturations '(0) ; do not change---may lower the contrast ratio
+ :lightens '(0) ; same
+ :colors (modus-themes-with-colors
+ (list fg-main
+ cyan-alt-other
+ magenta-alt-other
+ magenta)))
+#+end_src
+
+If you need to apply desaturation and lightening, you can use what the
+{{{file(prism.el)}}} documentation recommends, like this (adapting to the
+examples with the 4, 8, 16 colors):
+
+#+begin_src emacs-lisp
+(prism-set-colors
+ :desaturations (cl-loop for i from 0 below 16 collect (* i 2.5))
+ :lightens (cl-loop for i from 0 below 16 collect (* i 2.5))
+ :colors (modus-themes-with-colors
+ (list fg-main
+ cyan-alt-other
+ magenta-alt-other
+ magenta)))
+#+end_src
+
+** Note on god-mode.el
+:properties:
+:alt_title: Note for god-mode
+:custom_id: h:4da1d515-3e05-47ef-9e45-8251fc7e986a
+:end:
+
+The ~god-mode~ library does not provide faces that could be configured by
+the Modus themes. Users who would like to get some visual feedback on
+the status of {{{kbd(M-x god-mode)}}} are instead encouraged by upstream to
+set up their own configurations, such as by changing the ~mode-line~ face
+([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization (do-it-yourself)]]). This is an adaptation of the
+approach followed in the upstream README:
+
+#+begin_src emacs-lisp
+(defun my-god-mode-update-mode-line ()
+ "Make `mode-line' blue if God local mode is active."
+ (modus-themes-with-colors
+ (if god-local-mode
+ (set-face-attribute 'mode-line nil
+ :foreground blue-active
+ :background bg-active-accent
+ :box blue)
+ (set-face-attribute 'mode-line nil
+ :foreground fg-active
+ :background bg-active
+ :box fg-alt))))
+
+(add-hook 'post-command-hook 'my-god-mode-update-mode-line)
+#+end_src
+
+We employ the ~modus-themes-with-colors~ which provides access to color
+variables defined by the active theme. Its use is covered elsewhere in
+this manual ([[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Face specs at scale using the themes' palette]]). As for the
+attributes that can be passed to each face, start by consulting the
+documentation string of ~set-face-attribute~.
+
+** Note on company-mode overlay pop-up
+:properties:
+:custom_id: h:20cef8c4-d11f-4053-8b2c-2872925780b1
+:end:
+
+By default, the ~company-mode~ pop-up that lists completion candidates is
+drawn using an overlay. This creates alignment issues every time it is
+placed above a piece of text that has a different height than the
+default.
+
+The solution recommended by the project's maintainer is to use an
+alternative front-end for drawing the pop-up which draws child frames
+instead of overlays.[fn::
+https://github.com/company-mode/company-mode/issues/1010][fn::
+https://github.com/tumashu/company-posframe/]
+
+** Note on ERC escaped color sequences
+:properties:
+:custom_id: h:98bdf319-1e32-4469-8a01-771200fba65c
+:end:
+
+The built-in IRC client ~erc~ has the ability to colorise any text using
+escape sequences that start with =^C= (inserted with {{{kbd(C-q C-c)}}}) and are
+followed by a number for the foreground and background.[fn:: This page
+explains the basics, though it is not specific to Emacs:
+https://www.mirc.com/colors.html] Possible numbers are 0-15, with the
+first entry being the foreground and the second the background,
+separated by a comma. Like this =^C1,6=. The minimum setup is this:
+
+#+begin_src emacs-lisp
+(add-to-list 'erc-modules 'irccontrols)
+(setq erc-interpret-controls-p t
+ erc-interpret-mirc-color t)
+#+end_src
+
+As this allows users the chance to make arbitrary combinations, it is
+impossible to guarantee a consistently high contrast ratio. All we can
+we do is provide guidance on the combinations that satisfy the
+accessibility standard of the themes:
+
++ Modus Operandi :: Use foreground color 1 for all backgrounds from
+ 2-15. Like so: {{{kbd(C-q C-c1,N)}}} where =N= is the background.
+
++ Modus Vivendi :: Use foreground color 0 for all backgrounds from
+ 2-13. Use foreground =1= for backgrounds 14, 15.
+
+Colors 0 and 1 are white and black respectively. So combine them
+together, if you must.
+
+** Note on powerline or spaceline
+:properties:
+:custom_id: h:9130a8ba-d8e3-41be-a58b-3cb1eb7b6d17
+:end:
+
+Both Powerline and Spaceline package users will likely need to use the
+command ~powerline-reset~ whenever they make changes to their themes
+and/or mode line setup.
+
+** Note on SHR colors
+:properties:
+:custom_id: h:4cc767dc-ffef-4c5c-9f10-82eb7b8921bf
+:end:
+
+Emacs' HTML rendering library ({{{file(shr.el)}}}) may need explicit
+configuration to respect the theme's colors instead of whatever
+specifications the webpage provides.
+
+Consult {{{kbd(C-h v shr-use-colors)}}}.
+
+** Note on EWW and Elfeed fonts (SHR fonts)
+:properties:
+:custom_id: h:e6c5451f-6763-4be7-8fdb-b4706a422a4c
+:end:
+
+EWW and Elfeed rely on the Simple HTML Renderer to display their
+content. The {{{file(shr.el)}}} library contains the variable ~shr-use-fonts~
+that controls whether the text in the buffer is set to a ~variable-pitch~
+typeface (proportionately spaced) or if just retains whatever the
+default font family is. Its default value is non-nil, which means that
+~variable-pitch~ is applied.
+
+[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and others]].
+
+** Note on Helm grep
+:properties:
+:custom_id: h:d28879a2-8e4b-4525-986e-14c0f873d229
+:end:
+
+There is one face from the Helm package that is meant to highlight the
+matches of a grep or grep-like command (=ag= or =ripgrep=). It is
+~helm-grep-match~. However, this face can only apply when the user does
+not pass =--color=always= as a command-line option for their command.
+
+Here is the docstring for that face, which is defined in the
+{{{file(helm-grep.el)}}} library (you can always visit the source code with
+{{{kbd(M-x find-library)}}}).
+
+#+begin_quote
+Face used to highlight grep matches. Have no effect when grep backend
+use "--color="
+#+end_quote
+
+The user must either remove =--color= from the flags passed to the grep
+function, or explicitly use =--color=never= (or equivalent). Helm
+provides user-facing customization options for controlling the grep
+function's parameters, such as ~helm-grep-default-command~ and
+~helm-grep-git-grep-command~.
+
+When =--color=always= is in effect, the grep output will use red text in
+bold letter forms to present the matching part in the list of
+candidates. That style still meets the contrast ratio target of >= 7:1
+(accessibility standard WCAG AAA), because it draws the reference to
+ANSI color number 1 (red) from the already-supported array of
+~ansi-color-names-vector~.
+
+** Note on vc-annotate-background-mode
+:properties:
+:custom_id: h:5095cbd1-e17a-419c-93e8-951c186362a3
+:end:
+
+Due to the unique way ~vc-annotate~ ({{{kbd(C-x v g)}}}) applies colors, support
+for its background mode (~vc-annotate-background-mode~) is disabled at the
+theme level.
+
+Normally, such a drastic measure should not belong in a theme: assuming
+the user's preferences is bad practice. However, it has been deemed
+necessary in the interest of preserving color contrast accessibility
+while still supporting a useful built-in tool.
+
+If there actually is a way to avoid such a course of action, without
+prejudice to the accessibility standard of this project, then please
+report as much or send patches ([[#h:9c3cd842-14b7-44d7-84b2-a5c8bc3fc3b1][Contributing]]).
+
+** Note on pdf-tools link hints
+:properties:
+:custom_id: h:2659d13e-b1a5-416c-9a89-7c3ce3a76574
+:end:
+
+Hints are drawn by [[https://imagemagick.org/][ImageMagick]], not Emacs, i.e., ImageMagick doesn't
+know about the hint face unless you tell ImageMagick about it. By
+default, only the foreground and background color attributes are
+passed. The below snippet adds to those the various font attributes. As
+it queries various faces, specifically ~pdf-links-read-link~ and the faces
+it inherits, it needs to be added to your initialization file after
+you've customized any faces.
+
+#+begin_src emacs-lisp
+(use-package pdf-links
+ :config
+ (let ((spec
+ (apply #'append
+ (mapcar
+ (lambda (name)
+ (list name
+ (face-attribute 'pdf-links-read-link
+ name nil 'default)))
+ '(:family :width :weight :slant)))))
+ (setq pdf-links-read-link-convert-commands
+ `("-density" "96"
+ "-family" ,(plist-get spec :family)
+ "-stretch" ,(let* ((width (plist-get spec :width))
+ (name (symbol-name width)))
+ (replace-regexp-in-string "-" ""
+ (capitalize name)))
+ "-weight" ,(pcase (plist-get spec :weight)
+ ('ultra-light "Thin")
+ ('extra-light "ExtraLight")
+ ('light "Light")
+ ('semi-bold "SemiBold")
+ ('bold "Bold")
+ ('extra-bold "ExtraBold")
+ ('ultra-bold "Black")
+ (_weight "Normal"))
+ "-style" ,(pcase (plist-get spec :slant)
+ ('italic "Italic")
+ ('oblique "Oblique")
+ (_slant "Normal"))
+ "-pointsize" "%P"
+ "-undercolor" "%f"
+ "-fill" "%b"
+ "-draw" "text %X,%Y '%c'"))))
+#+end_src
+
+* Frequently Asked Questions (FAQ)
+:properties:
+:custom_id: h:b3384767-30d3-4484-ba7f-081729f03a47
+:end:
+#+cindex: Frequently Asked Questions (FAQ)
+
+In this section we provide answers related to some aspects of the Modus
+themes' design and application.
+
+** Is the contrast ratio about adjacent colors?
+:properties:
+:custom_id: h:5ce7ae2e-9348-4e55-b4cf-9302345b1826
+:end:
+#+cindex: Contrast between adjacent colors
+
+The minimum contrast ratio in relative luminance that the themes conform
+with always refers to any given combination of background and foreground
+colors. If we have some blue colored text next to a magenta one, both
+against a white background, we do not mean to imply that blue:magenta is
+7:1 in terms of relative luminance. Rather, we state that blue:white
+and magenta:white each are 7:1 or higher.
+
+The point of reference is always the background. Because colors have
+about the same minimum distance in luminance from their backdrop, they
+necessarily are fairly close to each other in this measure. A possible
+blue:magenta combination would naturally be around 1:1 in contrast of
+the sort here considered.
+
+To differentiate between sequential colors, we rely on hueness by
+mapping contrasting hues to adjacent constructs, while avoiding
+exaggerations. A blue next to a magenta can be told apart regardless of
+their respective contrast ratio against their common background.
+Exceptions would be tiny characters in arguably not so realistic cases,
+such as two dots drawn side-by-side which for some reason would need to
+be colored differently. They would still be legible though, which is
+the primary objective of the Modus themes.
+
+** What does it mean to avoid exaggerations?
+:properties:
+:custom_id: h:44284e1f-fab8-4c4f-92f0-544728a7c91e
+:end:
+#+cindex: Avoiding exaggerations in design
+
+The Modus themes are designed with restraint, so that their default
+looks do not overdo it with the application of color.
+
+[[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]].
+
+This is the non-quantifiable aspect of the themes' design: the artistic
+part, if you will. There are a lot of cases where color can be used
+inconsiderately, without accounting for layout, typographic, or other
+properties of the presentation. For example, two headings with distinct
+markers, such as leading asterisks in Org buffers, do not have to have
+highly contrasting hues between them in order to be told apart: the
+added element of contrast in hueness does not contribute significantly
+more to the distinction between the headings than colors whose hues are
+relatively closer to each other in the color space.
+
+Exaggerations can be hard to anticipate or identify. Multiple shades of
+blue and magenta in the same context may not seem optimal: one might
+think that it would be better to use highly contrasting hues to ensure
+that all colors stand out, such as by placing blue next to yellow, next
+to magenta, and green. That would, however, be a case of design for its
+own sake; a case where color is being applied without consideration of
+its end results in the given context. Too many contrasting hues in
+close proximity force an erratic rate to how the eye jumps from one
+piece of text to the next. Whereas multiple shades of, say, blue and
+magenta can suffice to tell things apart and avoid excess coloration: a
+harmonious rhythm.
+
+** Why are colors mostly variants of blue, magenta, cyan?
+:properties:
+:custom_id: h:0b26cb47-9733-4cb1-87d9-50850cb0386e
+:end:
+#+cindex: Innate color qualities of the palette
+
+Due to the innate properties of color, some options are better than
+others for the accessibility purposes of the themes, the stylistic
+consistency between ~modus-operandi~ and ~modus-vivendi~, and the avoidance
+of exaggerations in design.
+
+[[#h:44284e1f-fab8-4c4f-92f0-544728a7c91e][What does it mean to avoid exaggerations?]]
+
+What we describe as color is a function of three distinct channels of
+light: red, green, blue. In hexadecimal RGB notation, a color value is
+read as three pairs of red, green, and blue light: =#RRGGBB=. Of those
+three, the most luminant is green, while the least luminant is blue.
+
+The three basic colors represent each of the channels of light. They
+can be intermixed to give us six colors: red and green derive yellow,
+green and blue make cyan, red and blue turn into magenta.
+
+We can test the luminance of each of those against white and black to
+get a sense of how not all colors are equally good for accessibility
+(white is =#ffffff=, which means that all three light channels are fully
+luminated, while black is =#000000= meaning that no light is present
+(notwithstanding display technology)).
+
+#+begin_example
+| Name | | #ffffff | #000000 |
+|---------+---------+---------+---------|
+| red | #ff0000 | 4.00 | 5.25 |
+| yellow | #ffff00 | 1.07 | 19.56 |
+| green | #00ff00 | 1.37 | 15.30 |
+| cyan | #00ffff | 1.25 | 16.75 |
+| blue | #0000ff | 8.59 | 2.44 |
+| magenta | #ff00ff | 3.14 | 6.70 |
+#+end_example
+
+[[#h:02e25930-e71a-493d-828a-8907fc80f874][Measure color contrast]].
+
+By reading this table we learn that every color that has a high level of
+green light (green, yellow, cyan) is virtually unreadable against a
+white background and, conversely, can be easily read against black.
+
+We can then infer that red and blue, in different combinations, with
+green acting as calibrator for luminance, will give us fairly moderate
+colors that pass the 7:1 target. Blue with a bit of green produce
+appropriate variants of cyan. Similarly, blue combined with some red
+and hints of green give us suitable shades of purple.
+
+Due to the need of maintaining some difference in hueness between
+adjacent colors, it is not possible to make red, green, and yellow the
+primary colors, because blue could not be used to control their
+luminance and, thus the relevant space would shrink considerably.
+
+[[#h:5ce7ae2e-9348-4e55-b4cf-9302345b1826][Is the contrast ratio about adjacent colors?]]
+
+This phenomenon is best illustrated by the following table that measures
+the relative luminance of shades of red, yellow, magenta against white:
+
+#+begin_example
+| | #ffffff |
+|---------+---------|
+| #990000 | 8.92 |
+| #995500 | 5.75 |
+| #990099 | 7.46 |
+#+end_example
+
+We notice that equal values of red and blue light in =#990099= (magenta
+shade) do not lead to a considerable change in luminance compared with
+=#990000= (red variant). Whereas less amount of green light in =#995500=
+leads to a major drop in luminance relative to white. It follows that
+using the green channel of light to calibrate the luminance of colors is
+more effective than trying to do the same with either red or blue (the
+latter is the least effective in that regard).
+
+When we need to work with several colors, it is always better to have
+sufficient manoeuvring space, especially since we cannot pick arbitrary
+colors but only those that satisfy the accessibility objectives of the
+themes.
+
+As for why we do not mostly use green, yellow, cyan for the dark theme,
+it is because those colors are far more luminant than their counterparts
+on the other side of the spectrum, so to ensure that they all have about
+the same contrast ratios we would have to alter their hueness
+considerably. In short, the effect would not be optimal as it would
+lead to exaggerations. Plus, it would make ~modus-vivendi~ look
+completely different than ~modus-operandi~, to the effect that the two
+could not be properly considered part of the same project.
+
+** What is the best setup for legibility?
+:properties:
+:custom_id: h:f60cc2ae-129d-47c0-9849-4f6bbd87d8be
+:end:
+#+cindex: General setup for readability
+
+The Modus themes can be conceptually simplified as combinations of color
+values that account for relative luminance and inner harmony. Those
+qualities do not guarantee that every end-user will have the same
+experience, due to differences between people, but also because of
+variances in hardware capabilities and configurations. For the purposes
+of this document, we may only provide suggestions pertaining to the
+latter case.
+
+~modus-operandi~ is best used outdoors or in a room that either gets
+direct sunlight or has plenty of light. Whereas ~modus-vivendi~ works
+better when there is not a lot of sunshine or the room has a source of
+light, preferably a faint or warm one. It is possible to use
+~modus-operandi~ at night and ~modus-vivendi~ during the day, though that
+will depend on several variables, such as one's overall perception of
+color, the paint on the walls and how that contributes to the impression
+of lightness in the room, the sense of space within the eye's peripheral
+vision, hardware specifications, and environmental factors.
+
+In general, an additional source of light other than that of the monitor
+can help reduce eye strain: the eyes are more relaxed when they do not
+have to focus on one point to gather light.
+
+The monitor's display settings must be accounted for. Gamma values, in
+particular, need to be calibrated to neither amplify nor distort the
+perception of black. Same principle for sharpness, brightness, and
+contrast as determined by the hardware, which all have an effect on how
+text is read on the screen.
+
+There are software level methods on offer, such as the XrandR utility
+for the X Window System (X.org), which can make gamma corrections for
+each of the three channels of light (red, green, blue). For example:
+
+: xrandr --output LVDS1 --brightness 1.0 --gamma 0.76:0.75:0.68
+
+Typography is another variable. Some font families are blurry at small
+point sizes. Others may have a regular weight that is lighter (thiner)
+than that of their peers which may, under certain circumstances, cause a
+halo effect around each glyph.
+
+The gist is that legibility cannot be fully solved at the theme level.
+The color combinations may have been optimized for accessibility, though
+the remaining contributing factors in each case need to be considered in
+full.
+
+* Contributing
+:properties:
+:custom_id: h:9c3cd842-14b7-44d7-84b2-a5c8bc3fc3b1
+:end:
+
+This section documents the canonical sources of the themes and the ways
+in which you can contribute to their ongoing development.
+
+** Sources of the themes
+:properties:
+:custom_id: h:89504f1c-c9a1-4bd9-ab39-78fd0eddb47c
+:end:
+#+cindex: Sources of the themes
+
+The ~modus-operandi~ and ~modus-vivendi~ themes are built into Emacs.
+Currently they are in Emacs' git main branch (trunk), which is tracking
+the next development release target.
+
+The source code of the themes is [[https://gitlab.com/protesilaos/modus-themes/][available on Gitlab]], for the time
+being. A [[https://github.com/protesilaos/modus-themes/][mirror on Github]] is also on offer.
+
+An HTML version of this manual is provided as an extension of the
+[[https://protesilaos.com/modus-themes/][author's personal website]] (does not rely on any non-free code).
+
+** Issues you can help with
+:properties:
+:custom_id: h:6536c8d5-3f98-43ab-a787-b94120e735e8
+:end:
+#+cindex: Contributing
+
+A few tasks you can help with:
+
++ Suggest refinements to packages that are covered.
++ Report packages not covered thus far.
++ Report bugs, inconsistencies, shortcomings.
++ Help expand the documentation of covered-but-not-styled packages.
++ Suggest refinements to the color palette.
++ Help expand this document or any other piece of documentation.
++ Merge requests for code refinements.
+
+[[#h:111773e2-f26f-4b68-8c4f-9794ca6b9633][Patches require copyright assignment to the FSF]].
+
+It is preferable that your feedback includes some screenshots, GIFs, or
+short videos, as well as further instructions to reproduce a given
+setup. Though this is not a requirement.
+
+Whatever you do, bear in mind the overarching objective of the Modus
+themes: to keep a contrast ratio that is greater or equal to 7:1 between
+background and foreground colors. If a compromise is ever necessary
+between aesthetics and accessibility, it shall always be made in the
+interest of the latter.
+
+** Patches require copyright assignment to the FSF
+:properties:
+:custom_id: h:111773e2-f26f-4b68-8c4f-9794ca6b9633
+:end:
+
+Code contributions are most welcome. For any major edit (more than 15
+lines, or so, in aggregate per person), you need to make a copyright
+assignment to the Free Software Foundation. This is necessary because
+the themes are part of the upstream Emacs distribution: the FSF must at
+all times be in a position to enforce the GNU General Public License.
+
+Copyright assignment is a simple process. Check the request form below
+(please adapt it accordingly). You must write an email to the address
+mentioned in the form and then wait for the FSF to send you a legal
+agreement. Sign the document and file it back to them. This could all
+happen via email and take about a week. You are encouraged to go
+through this process. You only need to do it once. It will allow you
+to make contributions to Emacs in general.
+
+#+begin_example text
+Please email the following information to assign@gnu.org, and we
+will send you the assignment form for your past and future changes.
+
+Please use your full legal name (in ASCII characters) as the subject
+line of the message.
+----------------------------------------------------------------------
+REQUEST: SEND FORM FOR PAST AND FUTURE CHANGES
+
+[What is the name of the program or package you're contributing to?]
+
+GNU Emacs
+
+[Did you copy any files or text written by someone else in these changes?
+Even if that material is free software, we need to know about it.]
+
+Copied a few snippets from the same files I edited. Their author,
+Protesilaos Stavrou, has already assigned copyright to the Free Software
+Foundation.
+
+[Do you have an employer who might have a basis to claim to own
+your changes? Do you attend a school which might make such a claim?]
+
+
+[For the copyright registration, what country are you a citizen of?]
+
+
+[What year were you born?]
+
+
+[Please write your email address here.]
+
+
+[Please write your postal address here.]
+
+
+
+
+
+[Which files have you changed so far, and which new files have you written
+so far?]
+
+#+end_example
+
+* Acknowledgements
+:properties:
+:custom_id: h:95c3da23-217f-404e-b5f3-56c75760ebcf
+:end:
+#+cindex: Contributors
+
+The Modus themes are a collective effort. Every bit of work matters.
+
++ Author/maintainer :: Protesilaos Stavrou.
+
++ Contributions to code or documentation :: Anders Johansson, Basil
+ L.{{{space()}}} Contovounesios, Carlo Zancanaro, Eli Zaretskii, Fritz Grabo,
+ Kostadin Ninev, Madhavan Krishnan, Markus Beppler, Matthew Stevenson,
+ Mauro Aranda, Nicolas De Jaeghere, Philip Kaludercic, Rudolf
+ Adamkovič, Shreyas Ragavan, Stefan Kangas, Vincent Murphy, Xinglu
+ Chen.
+
++ Ideas and user feedback :: Aaron Jensen, Adam Spiers, Adrian Manea,
+ Alex Griffin, Alex Peitsinis, Alexey Shmalko, Alok Singh, Anders
+ Johansson, André Alexandre Gomes, Arif Rezai, Basil L.{{{space()}}}
+ Contovounesios, Burgess Chang, Christian Tietze, Christopher Dimech,
+ Damien Cassou, Daniel Mendler, Dario Gjorgjevski, David Edmondson,
+ Davor Rotim, Divan Santana, Emanuele Michele Alberto Monterosso,
+ Farasha Euker, Gautier Ponsinet, Gerry Agbobada, Gianluca Recchia,
+ Gustavo Barros, Hörmetjan Yiltiz, Ilja Kocken, Iris Garcia, Jeremy
+ Friesen, Jerry Zhang, John Haman, Joshua O'Connor, Kevin Fleming,
+ Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Manuel Uberti, Mark
+ Burton, Markus Beppler, Mauro Aranda, Michael Goldenberg, Morgan
+ Smith, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere, Paul
+ Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic,
+ Pierre Téchoueyres, Roman Rudakov, Ryan Phillips, Rudolf Adamkovič,
+ Sam Kleinman, Shreyas Ragavan, Simon Pugnet, Tassilo Horn, Thibaut
+ Verron, Thomas Heartman, Trey Merkley, Togan Muftuoglu, Toon Claes,
+ Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben,
+ CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji,
+ Nick, TheBlob42, Trey, bepolymathe, doolio, fleimgruber, iSeeU,
+ jixiuf, okamsn, pRot0ta1p.
+
++ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii, Glenn
+ Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core Emacs),
+ Stefan Monnier (GNU Elpa), André Alexandre Gomes, Dimakakos Dimos,
+ Morgan Smith, Nicolas Goaziou (Guix), Dhavan Vaidya (Debian).
+
++ Inspiration for certain features :: Bozhidar Batsov (zenburn-theme),
+ Fabrice Niessen (leuven-theme).
+
+Special thanks, in no particular order, to Manuel Uberti, Gustavo
+Barros, and Omar Antolín Camarena for their long time contributions and
+insightful commentary.
+
+* Meta
+:properties:
+:custom_id: h:13752581-4378-478c-af17-165b6e76bc1b
+:end:
+#+cindex: Development notes
+
+If you are curious about the principles that govern the development of
+this project read the essay [[https://protesilaos.com/codelog/2020-03-17-design-modus-themes-emacs/][On the design of the Modus themes]]
+(2020-03-17).
+
+Here are some more publications for those interested in the kind of work
+that goes into this project (sometimes the commits also include details
+of this sort):
+
++ [[https://protesilaos.com/codelog/2020-05-10-modus-operandi-palette-review/][Modus Operandi theme subtle palette review]] (2020-05-10)
++ [[https://protesilaos.com/codelog/2020-06-13-modus-vivendi-palette-review/][Modus Vivendi theme subtle palette review]] (2020-06-13)
++ [[https://protesilaos.com/codelog/2020-07-04-modus-themes-faint-colours/][Modus themes: new "faint syntax" option]] (2020-07-04)
++ [[https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/][Modus themes: major review of "nuanced" colours]] (2020-07-08)
++ [[https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/][Modus themes: review of blue colours]] (2020-09-14)
++ [[https://protesilaos.com/codelog/2020-12-27-modus-themes-review-rainbow-delimiters/][Modus themes: review rainbow-delimiters faces]] (2020-12-27)
++ [[https://protesilaos.com/codelog/2021-01-11-modus-themes-review-select-faint-colours/][Modus themes: review of select "faint" colours]] (2021-01-11)
++ [[https://protesilaos.com/codelog/2021-02-25-modus-themes-diffs-deuteranopia/][The Modus themes now cover deuteranopia in diffs]] (2021-02-25)
+
+And here are the canonical sources of this project's documentation:
+
++ Manual :: <https://protesilaos.com/modus-themes>
++ Change Log :: <https://protesilaos.com/modus-themes-changelog>
++ Screenshots :: <https://protesilaos.com/modus-themes-pictures>
+
+* GNU Free Documentation License
+:properties:
+:appendix: t
+:custom_id: h:3077c3d2-7f90-4228-8f0a-73124f4026f6
+:end:
+
+#+texinfo: @include doclicense.texi
+
+#+begin_export html
+<pre>
+
+ GNU Free Documentation License
+ Version 1.3, 3 November 2008
+
+
+ Copyright (C) 2000, 2001, 2002, 2007, 2008 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.
+
+0. PREAMBLE
+
+The purpose of this License is to make a manual, textbook, or other
+functional and useful document "free" in the sense of freedom: to
+assure everyone the effective freedom to copy and redistribute it,
+with or without modifying it, either commercially or noncommercially.
+Secondarily, this License preserves for the author and publisher a way
+to get credit for their work, while not being considered responsible
+for modifications made by others.
+
+This License is a kind of "copyleft", which means that derivative
+works of the document must themselves be free in the same sense. It
+complements the GNU General Public License, which is a copyleft
+license designed for free software.
+
+We have designed this License in order to use it for manuals for free
+software, because free software needs free documentation: a free
+program should come with manuals providing the same freedoms that the
+software does. But this License is not limited to software manuals;
+it can be used for any textual work, regardless of subject matter or
+whether it is published as a printed book. We recommend this License
+principally for works whose purpose is instruction or reference.
+
+
+1. APPLICABILITY AND DEFINITIONS
+
+This License applies to any manual or other work, in any medium, that
+contains a notice placed by the copyright holder saying it can be
+distributed under the terms of this License. Such a notice grants a
+world-wide, royalty-free license, unlimited in duration, to use that
+work under the conditions stated herein. The "Document", below,
+refers to any such manual or work. Any member of the public is a
+licensee, and is addressed as "you". You accept the license if you
+copy, modify or distribute the work in a way requiring permission
+under copyright law.
+
+A "Modified Version" of the Document means any work containing the
+Document or a portion of it, either copied verbatim, or with
+modifications and/or translated into another language.
+
+A "Secondary Section" is a named appendix or a front-matter section of
+the Document that deals exclusively with the relationship of the
+publishers or authors of the Document to the Document's overall
+subject (or to related matters) and contains nothing that could fall
+directly within that overall subject. (Thus, if the Document is in
+part a textbook of mathematics, a Secondary Section may not explain
+any mathematics.) The relationship could be a matter of historical
+connection with the subject or with related matters, or of legal,
+commercial, philosophical, ethical or political position regarding
+them.
+
+The "Invariant Sections" are certain Secondary Sections whose titles
+are designated, as being those of Invariant Sections, in the notice
+that says that the Document is released under this License. If a
+section does not fit the above definition of Secondary then it is not
+allowed to be designated as Invariant. The Document may contain zero
+Invariant Sections. If the Document does not identify any Invariant
+Sections then there are none.
+
+The "Cover Texts" are certain short passages of text that are listed,
+as Front-Cover Texts or Back-Cover Texts, in the notice that says that
+the Document is released under this License. A Front-Cover Text may
+be at most 5 words, and a Back-Cover Text may be at most 25 words.
+
+A "Transparent" copy of the Document means a machine-readable copy,
+represented in a format whose specification is available to the
+general public, that is suitable for revising the document
+straightforwardly with generic text editors or (for images composed of
+pixels) generic paint programs or (for drawings) some widely available
+drawing editor, and that is suitable for input to text formatters or
+for automatic translation to a variety of formats suitable for input
+to text formatters. A copy made in an otherwise Transparent file
+format whose markup, or absence of markup, has been arranged to thwart
+or discourage subsequent modification by readers is not Transparent.
+An image format is not Transparent if used for any substantial amount
+of text. A copy that is not "Transparent" is called "Opaque".
+
+Examples of suitable formats for Transparent copies include plain
+ASCII without markup, Texinfo input format, LaTeX input format, SGML
+or XML using a publicly available DTD, and standard-conforming simple
+HTML, PostScript or PDF designed for human modification. Examples of
+transparent image formats include PNG, XCF and JPG. Opaque formats
+include proprietary formats that can be read and edited only by
+proprietary word processors, SGML or XML for which the DTD and/or
+processing tools are not generally available, and the
+machine-generated HTML, PostScript or PDF produced by some word
+processors for output purposes only.
+
+The "Title Page" means, for a printed book, the title page itself,
+plus such following pages as are needed to hold, legibly, the material
+this License requires to appear in the title page. For works in
+formats which do not have any title page as such, "Title Page" means
+the text near the most prominent appearance of the work's title,
+preceding the beginning of the body of the text.
+
+The "publisher" means any person or entity that distributes copies of
+the Document to the public.
+
+A section "Entitled XYZ" means a named subunit of the Document whose
+title either is precisely XYZ or contains XYZ in parentheses following
+text that translates XYZ in another language. (Here XYZ stands for a
+specific section name mentioned below, such as "Acknowledgements",
+"Dedications", "Endorsements", or "History".) To "Preserve the Title"
+of such a section when you modify the Document means that it remains a
+section "Entitled XYZ" according to this definition.
+
+The Document may include Warranty Disclaimers next to the notice which
+states that this License applies to the Document. These Warranty
+Disclaimers are considered to be included by reference in this
+License, but only as regards disclaiming warranties: any other
+implication that these Warranty Disclaimers may have is void and has
+no effect on the meaning of this License.
+
+2. VERBATIM COPYING
+
+You may copy and distribute the Document in any medium, either
+commercially or noncommercially, provided that this License, the
+copyright notices, and the license notice saying this License applies
+to the Document are reproduced in all copies, and that you add no
+other conditions whatsoever to those of this License. You may not use
+technical measures to obstruct or control the reading or further
+copying of the copies you make or distribute. However, you may accept
+compensation in exchange for copies. If you distribute a large enough
+number of copies you must also follow the conditions in section 3.
+
+You may also lend copies, under the same conditions stated above, and
+you may publicly display copies.
+
+
+3. COPYING IN QUANTITY
+
+If you publish printed copies (or copies in media that commonly have
+printed covers) of the Document, numbering more than 100, and the
+Document's license notice requires Cover Texts, you must enclose the
+copies in covers that carry, clearly and legibly, all these Cover
+Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
+the back cover. Both covers must also clearly and legibly identify
+you as the publisher of these copies. The front cover must present
+the full title with all words of the title equally prominent and
+visible. You may add other material on the covers in addition.
+Copying with changes limited to the covers, as long as they preserve
+the title of the Document and satisfy these conditions, can be treated
+as verbatim copying in other respects.
+
+If the required texts for either cover are too voluminous to fit
+legibly, you should put the first ones listed (as many as fit
+reasonably) on the actual cover, and continue the rest onto adjacent
+pages.
+
+If you publish or distribute Opaque copies of the Document numbering
+more than 100, you must either include a machine-readable Transparent
+copy along with each Opaque copy, or state in or with each Opaque copy
+a computer-network location from which the general network-using
+public has access to download using public-standard network protocols
+a complete Transparent copy of the Document, free of added material.
+If you use the latter option, you must take reasonably prudent steps,
+when you begin distribution of Opaque copies in quantity, to ensure
+that this Transparent copy will remain thus accessible at the stated
+location until at least one year after the last time you distribute an
+Opaque copy (directly or through your agents or retailers) of that
+edition to the public.
+
+It is requested, but not required, that you contact the authors of the
+Document well before redistributing any large number of copies, to
+give them a chance to provide you with an updated version of the
+Document.
+
+
+4. MODIFICATIONS
+
+You may copy and distribute a Modified Version of the Document under
+the conditions of sections 2 and 3 above, provided that you release
+the Modified Version under precisely this License, with the Modified
+Version filling the role of the Document, thus licensing distribution
+and modification of the Modified Version to whoever possesses a copy
+of it. In addition, you must do these things in the Modified Version:
+
+A. Use in the Title Page (and on the covers, if any) a title distinct
+ from that of the Document, and from those of previous versions
+ (which should, if there were any, be listed in the History section
+ of the Document). You may use the same title as a previous version
+ if the original publisher of that version gives permission.
+B. List on the Title Page, as authors, one or more persons or entities
+ responsible for authorship of the modifications in the Modified
+ Version, together with at least five of the principal authors of the
+ Document (all of its principal authors, if it has fewer than five),
+ unless they release you from this requirement.
+C. State on the Title page the name of the publisher of the
+ Modified Version, as the publisher.
+D. Preserve all the copyright notices of the Document.
+E. Add an appropriate copyright notice for your modifications
+ adjacent to the other copyright notices.
+F. Include, immediately after the copyright notices, a license notice
+ giving the public permission to use the Modified Version under the
+ terms of this License, in the form shown in the Addendum below.
+G. Preserve in that license notice the full lists of Invariant Sections
+ and required Cover Texts given in the Document's license notice.
+H. Include an unaltered copy of this License.
+I. Preserve the section Entitled "History", Preserve its Title, and add
+ to it an item stating at least the title, year, new authors, and
+ publisher of the Modified Version as given on the Title Page. If
+ there is no section Entitled "History" in the Document, create one
+ stating the title, year, authors, and publisher of the Document as
+ given on its Title Page, then add an item describing the Modified
+ Version as stated in the previous sentence.
+J. Preserve the network location, if any, given in the Document for
+ public access to a Transparent copy of the Document, and likewise
+ the network locations given in the Document for previous versions
+ it was based on. These may be placed in the "History" section.
+ You may omit a network location for a work that was published at
+ least four years before the Document itself, or if the original
+ publisher of the version it refers to gives permission.
+K. For any section Entitled "Acknowledgements" or "Dedications",
+ Preserve the Title of the section, and preserve in the section all
+ the substance and tone of each of the contributor acknowledgements
+ and/or dedications given therein.
+L. Preserve all the Invariant Sections of the Document,
+ unaltered in their text and in their titles. Section numbers
+ or the equivalent are not considered part of the section titles.
+M. Delete any section Entitled "Endorsements". Such a section
+ may not be included in the Modified Version.
+N. Do not retitle any existing section to be Entitled "Endorsements"
+ or to conflict in title with any Invariant Section.
+O. Preserve any Warranty Disclaimers.
+
+If the Modified Version includes new front-matter sections or
+appendices that qualify as Secondary Sections and contain no material
+copied from the Document, you may at your option designate some or all
+of these sections as invariant. To do this, add their titles to the
+list of Invariant Sections in the Modified Version's license notice.
+These titles must be distinct from any other section titles.
+
+You may add a section Entitled "Endorsements", provided it contains
+nothing but endorsements of your Modified Version by various
+parties--for example, statements of peer review or that the text has
+been approved by an organization as the authoritative definition of a
+standard.
+
+You may add a passage of up to five words as a Front-Cover Text, and a
+passage of up to 25 words as a Back-Cover Text, to the end of the list
+of Cover Texts in the Modified Version. Only one passage of
+Front-Cover Text and one of Back-Cover Text may be added by (or
+through arrangements made by) any one entity. If the Document already
+includes a cover text for the same cover, previously added by you or
+by arrangement made by the same entity you are acting on behalf of,
+you may not add another; but you may replace the old one, on explicit
+permission from the previous publisher that added the old one.
+
+The author(s) and publisher(s) of the Document do not by this License
+give permission to use their names for publicity for or to assert or
+imply endorsement of any Modified Version.
+
+
+5. COMBINING DOCUMENTS
+
+You may combine the Document with other documents released under this
+License, under the terms defined in section 4 above for modified
+versions, provided that you include in the combination all of the
+Invariant Sections of all of the original documents, unmodified, and
+list them all as Invariant Sections of your combined work in its
+license notice, and that you preserve all their Warranty Disclaimers.
+
+The combined work need only contain one copy of this License, and
+multiple identical Invariant Sections may be replaced with a single
+copy. If there are multiple Invariant Sections with the same name but
+different contents, make the title of each such section unique by
+adding at the end of it, in parentheses, the name of the original
+author or publisher of that section if known, or else a unique number.
+Make the same adjustment to the section titles in the list of
+Invariant Sections in the license notice of the combined work.
+
+In the combination, you must combine any sections Entitled "History"
+in the various original documents, forming one section Entitled
+"History"; likewise combine any sections Entitled "Acknowledgements",
+and any sections Entitled "Dedications". You must delete all sections
+Entitled "Endorsements".
+
+
+6. COLLECTIONS OF DOCUMENTS
+
+You may make a collection consisting of the Document and other
+documents released under this License, and replace the individual
+copies of this License in the various documents with a single copy
+that is included in the collection, provided that you follow the rules
+of this License for verbatim copying of each of the documents in all
+other respects.
+
+You may extract a single document from such a collection, and
+distribute it individually under this License, provided you insert a
+copy of this License into the extracted document, and follow this
+License in all other respects regarding verbatim copying of that
+document.
+
+
+7. AGGREGATION WITH INDEPENDENT WORKS
+
+A compilation of the Document or its derivatives with other separate
+and independent documents or works, in or on a volume of a storage or
+distribution medium, is called an "aggregate" if the copyright
+resulting from the compilation is not used to limit the legal rights
+of the compilation's users beyond what the individual works permit.
+When the Document is included in an aggregate, this License does not
+apply to the other works in the aggregate which are not themselves
+derivative works of the Document.
+
+If the Cover Text requirement of section 3 is applicable to these
+copies of the Document, then if the Document is less than one half of
+the entire aggregate, the Document's Cover Texts may be placed on
+covers that bracket the Document within the aggregate, or the
+electronic equivalent of covers if the Document is in electronic form.
+Otherwise they must appear on printed covers that bracket the whole
+aggregate.
+
+
+8. TRANSLATION
+
+Translation is considered a kind of modification, so you may
+distribute translations of the Document under the terms of section 4.
+Replacing Invariant Sections with translations requires special
+permission from their copyright holders, but you may include
+translations of some or all Invariant Sections in addition to the
+original versions of these Invariant Sections. You may include a
+translation of this License, and all the license notices in the
+Document, and any Warranty Disclaimers, provided that you also include
+the original English version of this License and the original versions
+of those notices and disclaimers. In case of a disagreement between
+the translation and the original version of this License or a notice
+or disclaimer, the original version will prevail.
+
+If a section in the Document is Entitled "Acknowledgements",
+"Dedications", or "History", the requirement (section 4) to Preserve
+its Title (section 1) will typically require changing the actual
+title.
+
+
+9. TERMINATION
+
+You may not copy, modify, sublicense, or distribute the Document
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense, or distribute it is void, and
+will automatically terminate your rights under this License.
+
+However, if you cease all violation of this License, then your license
+from a particular copyright holder is reinstated (a) provisionally,
+unless and until the copyright holder explicitly and finally
+terminates your license, and (b) permanently, if the copyright holder
+fails to notify you of the violation by some reasonable means prior to
+60 days after the cessation.
+
+Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, receipt of a copy of some or all of the same material does
+not give you any rights to use it.
+
+
+10. FUTURE REVISIONS OF THIS LICENSE
+
+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
+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
+License "or any later version" applies to it, you have the option of
+following the terms and conditions either of that specified version or
+of any later version that has been published (not as a draft) by the
+Free Software Foundation. If the Document does not specify a version
+number of this License, you may choose any version ever published (not
+as a draft) by the Free Software Foundation. If the Document
+specifies that a proxy can decide which future versions of this
+License can be used, that proxy's public statement of acceptance of a
+version permanently authorizes you to choose that version for the
+Document.
+
+11. RELICENSING
+
+"Massive Multiauthor Collaboration Site" (or "MMC Site") means any
+World Wide Web server that publishes copyrightable works and also
+provides prominent facilities for anybody to edit those works. A
+public wiki that anybody can edit is an example of such a server. A
+"Massive Multiauthor Collaboration" (or "MMC") contained in the site
+means any set of copyrightable works thus published on the MMC site.
+
+"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
+license published by Creative Commons Corporation, a not-for-profit
+corporation with a principal place of business in San Francisco,
+California, as well as future copyleft versions of that license
+published by that same organization.
+
+"Incorporate" means to publish or republish a Document, in whole or in
+part, as part of another Document.
+
+An MMC is "eligible for relicensing" if it is licensed under this
+License, and if all works that were first published under this License
+somewhere other than this MMC, and subsequently incorporated in whole or
+in part into the MMC, (1) had no cover texts or invariant sections, and
+(2) were thus incorporated prior to November 1, 2008.
+
+The operator of an MMC Site may republish an MMC contained in the site
+under CC-BY-SA on the same site at any time before August 1, 2009,
+provided the MMC is eligible for relicensing.
+
+
+ADDENDUM: How to use this License for your documents
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and
+license notices just after the title page:
+
+ Copyright (c) YEAR YOUR NAME.
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.3
+ or any later version published by the Free Software Foundation;
+ with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
+ A copy of the license is included in the section entitled "GNU
+ Free Documentation License".
+
+If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
+replace the "with...Texts." line with this:
+
+ with the Invariant Sections being LIST THEIR TITLES, with the
+ Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST.
+
+If you have Invariant Sections without Cover Texts, or some other
+combination of the three, merge those two alternatives to suit the
+situation.
+
+If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of
+free software license, such as the GNU General Public License,
+to permit their use in free software.
+</pre>
+#+end_export
+
+#+html: <!--
+
+* Indices
+:properties:
+:custom_id: h:55104b26-8e94-46cf-9975-43ea00316489
+:end:
+
+** Function index
+:properties:
+:index: fn
+:custom_id: h:6bec5005-529c-4521-ae05-3d990baffb5b
+:end:
+
+** Variable index
+:properties:
+:index: vr
+:custom_id: h:16ad8df6-b015-40a9-9259-03d4f7a23ee4
+:end:
+
+** Concept index
+:properties:
+:index: cp
+:custom_id: h:6aa7a656-884b-4c39-b759-087e412eec13
+:end:
+
+#+html: -->
diff --git a/doc/misc/modus-themes.texi b/doc/misc/modus-themes.texi
deleted file mode 100644
index b16aece2ee5..00000000000
--- a/doc/misc/modus-themes.texi
+++ /dev/null
@@ -1,2834 +0,0 @@
-\input texinfo @c -*- texinfo -*-
-@c %**start of header
-@setfilename ../../info/modus-themes.info
-@settitle Modus themes for GNU Emacs
-@include docstyle.texi
-@documentencoding UTF-8
-@documentlanguage en
-@c %**end of header
-
-@include emacsver.texi
-
-@dircategory Emacs misc features
-@direntry
-* Modus Themes: (modus-themes). Highly accessible themes (WCAG AAA).
-@end direntry
-
-@finalout
-@titlepage
-@title Modus themes for GNU Emacs
-@author Protesilaos Stavrou (@email{info@@protesilaos.com})
-@end titlepage
-
-@ifnottex
-@node Top
-@top Modus themes for GNU Emacs
-
-This manual, written by Protesilaos Stavrou, describes the customization
-options for the @samp{modus-operandi} and @samp{modus-vivendi} themes, and provides
-every other piece of information pertinent to them.
-
-The documentation furnished herein corresponds to version 0.13.0,
-released on 2020-10-08. Any reference to a newer feature which does
-not yet form part of the latest tagged commit, is explicitly marked as
-such.
-
-Copyright (C) 2020--2021 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this
-document under the terms of the GNU Free Documentation License,
-Version 1.3 or any later version published by the Free Software
-Foundation; with no Invariant Sections, with no Front-Cover Texts,
-and with no Back-Cover Texts.
-
-@end quotation
-
-@end ifnottex
-
-@menu
-* Overview::
-* Installation::
-* Enable and load::
-* Customization Options::
-* Advanced customization (do-it-yourself)::
-* Face coverage::
-* Notes for individual packages::
-* Contributing::
-* Acknowledgements::
-* Meta::
-* External projects (ports)::
-* GNU Free Documentation License::
-
-@detailmenu
---- The Detailed Node Listing ---
-
-Overview
-
-* How do the themes look like::
-* Learn about the latest changes::
-
-Installation
-
-* Install from the archives::
-* Install on GNU/Linux::
-
-Install on GNU/Linux
-
-* Debian 11 Bullseye::
-* GNU Guix::
-
-Enable and load
-
-* Load automatically::
-* Load at a given time or at sunset/sunrise::
-* Toggle between the themes on demand::
-* Configure options prior to loading::
-
-Customization Options
-
-* Bold constructs:: Toggle bold constructs in code
-* Slanted constructs:: Toggle slanted constructs (italics) in code
-* Syntax highlighting:: Toggle subtle coloration in programming modes
-* No mixed fonts:: Toggle mixing of font families
-* Link underline:: Toggle underlined text in links
-* Command prompts:: Choose among plain, subtle, or intense prompts
-* Mode line:: Choose among plain, three-dimension, or moody-compliant styles
-* Completion UIs:: Choose among standard, moderate, or opinionated looks
-* Fringes:: Choose among plain, subtle, or intense fringe visibility
-* Line highlighting:: Toggle intense style for current line highlighting
-* Matching parentheses:: Toggle intense style for matching delimiters/parentheses
-* Diffs:: Choose among intense, desaturated, or text-only diffs
-* Org mode blocks:: Choose among plain, greyscale, or rainbow styles
-* Heading styles:: Choose among several styles, also per heading level
-* Scaled headings:: Toggle scaling of headings
-* Headings' font:: Toggle proportionately spaced fonts in headings
-
-Scaled headings
-
-* Scaled heading sizes:: Specify rate of increase for scaled headings
-
-Advanced customization (do-it-yourself)
-
-* Tweak colors (DIY):: Declare your own palette overrides
-* Font configs (DIY):: Optimise for mixed typeface buffers
-* Org user faces (DIY):: Extend styles for org-mode keywords and priorities
-
-Face coverage
-
-* Supported packages:: Full list of covered face groups
-* Covered indirectly::
-* Will NOT be supported::
-
-Notes for individual packages
-
-* Note on company-mode overlay pop-up::
-* Note for ERC escaped color sequences::
-* Note for powerline or spaceline::
-* Note on shr colors::
-* Note for Helm grep::
-* Note on vc-annotate-background-mode::
-
-Contributing
-
-* Sources of the themes::
-* Issues you can help with::
-* Merge requests:: Legal considerations for code patches
-
-@end detailmenu
-@end menu
-
-@node Overview
-@chapter Overview
-
-The Modus themes are designed for accessible readability. They conform
-with the highest standard for color contrast between any given
-combination of background and foreground values. This corresponds to
-the WCAG AAA standard, which specifies a minimum rate of distance in
-relative luminance of 7:1.
-
-Modus Operandi (@samp{modus-operandi}) is a light theme, while Modus Vivendi
-(@samp{modus-vivendi}) is dark. Each theme's color palette is designed to
-meet the needs of the numerous interfaces that are possible in the Emacs
-computing environment.
-
-The overarching objective of this project is to always offer accessible
-color combinations. There shall never be a compromise on this
-principle. If there arises an inescapable trade-off between readability
-and stylistic considerations, we will always opt for the former.
-
-To ensure that users have a consistently accessible experience, the
-themes strive to achieve as close to full face coverage as possible
-(see @ref{Face coverage}).
-
-Starting with version 0.12.0 and onwards, the themes are built into GNU
-Emacs (current version is 0.13.0).
-
-@menu
-* How do the themes look like::
-* Learn about the latest changes::
-@end menu
-
-@node How do the themes look like
-@section How do the themes look like
-
-Check the web page with @uref{https://protesilaos.com/modus-themes-pictures/, the screen shots}. There are lots of scenarios on
-display that draw attention to details and important aspects in the
-design of the themes. They also showcase the numerous customization
-options.
-
-@xref{Customization Options}.
-
-@node Learn about the latest changes
-@section Learn about the latest changes
-
-Please refer to the @uref{https://protesilaos.com/modus-themes-changelog, web page with the change log}. It is comprehensive
-and covers everything that goes into every tagged release of the themes.
-
-@node Installation
-@chapter Installation
-
-The Modus themes are distributed with Emacs starting with version 28.1.
-On older versions of Emacs, they can be installed using Emacs' package
-manager or manually from their code repository.
-
-Modus Operandi (light theme) and Modus Vivendi (dark) are normally
-distributed as standalone packages in Emacs-specific archives. There
-also exist packages for GNU/Linux distributions.
-
-@menu
-* Install from the archives::
-* Install on GNU/Linux::
-@end menu
-
-@node Install from the archives
-@section Install from the archives
-
-@samp{modus-operandi-theme} and @samp{modus-vivendi-theme} are
-available from the GNU ELPA archive, which is configured by default.
-
-Prior to querying any package archive, make sure to have updated the
-index, with @samp{M-x package-refresh-contents}. Then all you need to do is
-type @samp{M-x package-install} and specify the theme of your choice.
-
-@node Install on GNU/Linux
-@section Install on GNU/Linux
-
-The themes are also available from the archives of some GNU/Linux
-distributions. These should correspond to a tagged release rather than
-building directly from the latest Git commit. It all depends on the
-distro's packaging policies.
-
-@menu
-* Debian 11 Bullseye::
-* GNU Guix::
-@end menu
-
-@node Debian 11 Bullseye
-@subsection Debian 11 Bullseye
-
-The two themes are distributed as a single package for Debian and its
-derivatives. Currently in the unstable and testing suites and should be
-available in time for Debian 11 Bullseye (next stable).
-
-Get them with:
-
-@example
-sudo apt install elpa-modus-themes
-@end example
-
-@node GNU Guix
-@subsection GNU Guix
-
-Users of either the Guix System (the distro) or just Guix (the package
-manager) can get each theme as a standalone package.
-
-@example
-guix package -i emacs-modus-operandi-theme
-@end example
-
-And/or:
-
-@example
-guix package -i emacs-modus-vivendi-theme
-@end example
-
-@node Enable and load
-@chapter Enable and load
-
-This section documents how to load the theme of your choice and how to
-further control its initialization. It also includes some sample code
-snippets that could help you in the task, especially if you intend to
-use both Modus Operandi and Modus Vivendi.
-
-@menu
-* Load automatically::
-* Load at a given time or at sunset/sunrise::
-* Toggle between the themes on demand::
-* Configure options prior to loading::
-@end menu
-
-@node Load automatically
-@section Load automatically
-
-A simple way to load the theme from your Emacs initialization file is to
-include either of the following expressions:
-
-@lisp
-(load-theme 'modus-operandi t) ; Light theme
-(load-theme 'modus-vivendi t) ; Dark theme
-@end lisp
-
-Make sure to remove any other theme that is being loaded, otherwise you
-might run into unexpected issues.
-
-Note that you can always @samp{M-x disable-theme} and specify an item. The
-command does exactly what its name suggests. To deactivate all enabled
-themes at once, in case you have multiple of them enabled, you may
-evaluate the expression:
-
-@lisp
-(mapc #'disable-theme custom-enabled-themes)
-@end lisp
-
-@node Load at a given time or at sunset/sunrise
-@section Load at a given time or at sunset/sunrise
-
-It is possible to schedule a time during the day at or after which a
-given theme will be loaded.@footnote{Contributed on Reddit by user @samp{b3n}
-@uref{https://www.reddit.com/r/emacs/comments/gdtqov/weekly_tipstricketc_thread/fq9186h/}.}
-
-@lisp
-;; Light for the day
-(load-theme 'modus-operandi t t)
-(run-at-time "05:00" (* 60 60 24)
- (lambda ()
- (enable-theme 'modus-operandi)))
-
-;; Dark for the night
-(load-theme 'modus-vivendi t t)
-(run-at-time "21:00" (* 60 60 24)
- (lambda ()
- (enable-theme 'modus-vivendi)))
-@end lisp
-
-A modified version of the above technique is to use the sunrise and
-sunset as references, instead of specifying a fixed hour value.@footnote{Contributed directly by André Alexandre Gomes @uref{https://gitlab.com/aadcg}.}
-If you set @samp{calendar-latitude} and @samp{calendar-longitude} (defined in the
-built-in @samp{solar.el} library---read it with @samp{M-x find-library}), you can
-automatically switch between both themes at the appropriate time-of-day.
-Note that @emph{those calendar variables need to be set before loading the
-themes}.
-
-@lisp
-;; Define coordinates
-(setq calendar-latitude 35.17
- calendar-longitude 33.36)
-
-;; Light at sunrise
-(load-theme 'modus-operandi t t)
-(run-at-time (nth 1 (split-string (sunrise-sunset)))
- (* 60 60 24)
- (lambda ()
- (enable-theme 'modus-operandi)))
-
-;; Dark at sunset
-(load-theme 'modus-vivendi t t)
-(run-at-time (nth 4 (split-string (sunrise-sunset)))
- (* 60 60 24)
- (lambda ()
- (enable-theme 'modus-vivendi)))
-@end lisp
-
-For the sake of completeness, the @samp{load-theme} call in these snippets is
-slightly different than the one shown in @ref{Load automatically}, because it
-does not enable the theme directly: the subsequent @samp{enable-theme} does
-that when needed.
-
-@node Toggle between the themes on demand
-@section Toggle between the themes on demand
-
-With both themes available, it is possible to design a simple command to
-switch between them on demand.
-
-@lisp
-(defun modus-themes-toggle ()
- "Toggle between `modus-operandi' and `modus-vivendi' themes."
- (interactive)
- (if (eq (car custom-enabled-themes) 'modus-operandi)
- (progn
- (disable-theme 'modus-operandi)
- (load-theme 'modus-vivendi t))
- (disable-theme 'modus-vivendi)
- (load-theme 'modus-operandi t)))
-@end lisp
-
-You could use @samp{(mapc #'disable-theme custom-enabled-themes)} instead of
-disabling a single target, but you get the idea.
-
-@node Configure options prior to loading
-@section Configure options prior to loading
-
-If you plan to use both themes and wish to apply styles consistently
-(see @ref{Customization Options}), you could define wrapper functions around
-the standard @samp{load-theme} command. These extend the simple function we
-presented in @ref{Toggle between the themes on demand}.
-
-Here is a comprehensive setup (the values assigned to the variables are
-just for the sake of this demonstration):@footnote{The @samp{defmacro} and @samp{dolist}
-method were contributed on Reddit by user @samp{b3n},
-@uref{https://www.reddit.com/r/emacs/comments/gqsz8u/weekly_tipstricketc_thread/fsfakhg/}.}
-
-@lisp
-(defmacro modus-themes-format-sexp (sexp &rest objects)
- `(eval (read (format ,(format "%S" sexp) ,@@objects))))
-
-(dolist (theme '("operandi" "vivendi"))
- (modus-themes-format-sexp
- (defun modus-%1$s-theme-load ()
- (setq modus-%1$s-theme-slanted-constructs t
- modus-%1$s-theme-bold-constructs t
- modus-%1$s-theme-fringes 'subtle ; @{nil,'subtle,'intense@}
- modus-%1$s-theme-mode-line '3d ; @{nil,'3d,'moody@}
- modus-%1$s-theme-faint-syntax nil
- modus-%1$s-theme-intense-hl-line nil
- modus-%1$s-theme-intense-paren-match nil
- modus-%1$s-theme-no-link-underline t
- modus-%1$s-theme-no-mixed-fonts nil
- modus-%1$s-theme-prompts nil ; @{nil,'subtle,'intense@}
- modus-%1$s-theme-completions 'moderate ; @{nil,'moderate,'opinionated@}
- modus-%1$s-theme-diffs nil ; @{nil,'desaturated,'fg-only@}
- modus-%1$s-theme-org-blocks 'greyscale ; @{nil,'greyscale,'rainbow@}
- modus-%1$s-theme-headings ; Read further below in the manual for this one
- '((1 . section)
- (2 . line)
- (t . rainbow-line-no-bold))
- modus-%1$s-theme-variable-pitch-headings nil
- modus-%1$s-theme-scale-headings t
- modus-%1$s-theme-scale-1 1.1
- modus-%1$s-theme-scale-2 1.15
- modus-%1$s-theme-scale-3 1.21
- modus-%1$s-theme-scale-4 1.27
- modus-%1$s-theme-scale-5 1.33)
- (load-theme 'modus-%1$s t))
- theme))
-
-(defun modus-themes-toggle ()
- "Toggle between `modus-operandi' and `modus-vivendi' themes."
- (interactive)
- (if (eq (car custom-enabled-themes) 'modus-operandi)
- (progn
- (disable-theme 'modus-operandi)
- (modus-vivendi-theme-load))
- (disable-theme 'modus-vivendi)
- (modus-operandi-theme-load)))
-@end lisp
-
-@node Customization Options
-@chapter Customization Options
-
-The Modus themes are highly configurable, though they should work well
-without any further tweaks.
-
-By default, all customization options are set to @samp{nil}.
-
-All customization options need to be evaluated before loading their
-theme (@pxref{Enable and load}).
-
-@menu
-* Bold constructs:: Toggle bold constructs in code
-* Slanted constructs:: Toggle slanted constructs (italics) in code
-* Syntax highlighting:: Toggle subtle coloration in programming modes
-* No mixed fonts:: Toggle mixing of font families
-* Link underline:: Toggle underlined text in links
-* Command prompts:: Choose among plain, subtle, or intense prompts
-* Mode line:: Choose among plain, three-dimension, or moody-compliant styles
-* Completion UIs:: Choose among standard, moderate, or opinionated looks
-* Fringes:: Choose among plain, subtle, or intense fringe visibility
-* Line highlighting:: Toggle intense style for current line highlighting
-* Matching parentheses:: Toggle intense style for matching delimiters/parentheses
-* Diffs:: Choose among intense, desaturated, or text-only diffs
-* Org mode blocks:: Choose among plain, greyscale, or rainbow styles
-* Heading styles:: Choose among several styles, also per heading level
-* Scaled headings:: Toggle scaling of headings
-* Headings' font:: Toggle proportionately spaced fonts in headings
-@end menu
-
-@node Bold constructs
-@section Option for more bold constructs
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-bold-constructs}
-@item
-@samp{modus-vivendi-theme-bold-constructs}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Display several constructs in bold weight. This concerns keywords and
-other important aspects of code syntax. It also affects certain mode
-line indicators and command-line prompts.
-
-The default is to only use a bold weight when it is required.
-
-Additionally, and while not necessary, to define the precise weight for
-bold constructs, you can change the typographic intensity of the @samp{bold}
-face. The standard is a bold weight. It requires no further
-intervention. Assuming though that your typeface of choice supports a
-``semibold'' weight, adding the following snippet to your init file should
-suffice.
-
-@lisp
-(set-face-attribute 'bold nil :weight 'semibold)
-@end lisp
-
-Note that if you are switching themes, you need to re-evaluate this
-expression after the new theme is loaded.
-
-@node Slanted constructs
-@section Option for more slanted constructs
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-slanted-constructs}
-@item
-@samp{modus-vivendi-theme-slanted-constructs}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Choose to render more faces in slanted text (italics). This typically
-affects documentation strings and code comments.
-
-The default is to not use italics unless it is absolutely necessary.
-
-@node Syntax highlighting
-@section Option for faint code syntax highlighting
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-faint-syntax}
-@item
-@samp{modus-vivendi-theme-faint-syntax}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Use less saturated colors in programming modes for highlighting code
-syntax. The default is to use saturated colors.
-
-This option essentially affects the font-lock faces, so it may also have
-implications in other places that are hard-wired to rely directly on
-them instead of specifying their own faces (which could inherit from
-font-lock if that is the intent). The author is aware of @samp{vc-dir} as a
-case in point.
-
-@node No mixed fonts
-@section Option for no font mixing
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-no-mixed-fonts}
-@item
-@samp{modus-vivendi-theme-no-mixed-fonts}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-By default, the themes configure some spacing-sensitive faces, such as
-Org tables and code blocks, to always inherit from the @samp{fixed-pitch} face.
-This is to ensure that those constructs remain monospaced when users opt
-for something like the built-in @kbd{M-x variable-pitch-mode}. Otherwise the
-layout would appear broken. To disable this behaviour, set the option
-to @samp{t}.
-
-Users may prefer to use another package for handling mixed typeface
-configurations, rather than letting the theme do it, perhaps because a
-purpose-specific package has extra functionality. Two possible options
-are @samp{org-variable-pitch} and @samp{mixed-pitch}.
-
-@node Link underline
-@section Option for no link underline
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-no-link-underline}
-@item
-@samp{modus-vivendi-theme-no-link-underline}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Remove the underline effect from links, symbolic links, and buttons.
-The default is to apply an underline.
-
-@node Command prompts
-@section Option for command prompt styles
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-prompts}
-@item
-@samp{modus-vivendi-theme-prompts}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{subtle}
-@item
-@samp{intense}
-@end enumerate
-
-The symbols ``subtle'' and ``intense'' will apply a combination of accented
-background and foreground to the minibuffer and other REPL prompts (like
-@samp{M-x shell} and @samp{M-x eshell}). The difference between the two is that the
-latter has a more pronounced/noticeable effect than the former.
-
-The default does not use any background for such prompts, while relying
-exclusively on an accented foreground color.
-
-@node Mode line
-@section Option for mode line presentation
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-mode-line}
-@item
-@samp{modus-vivendi-theme-mode-line}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{3d}
-@item
-@samp{moody}
-@end enumerate
-
-The default value (@samp{nil}) produces a two-dimensional effect both for the
-active and inactive modelines. The differences between the two are
-limited to distinct shades of greyscale values, with the active being
-more intense than the inactive.
-
-A @samp{3d} symbol will make the active modeline look like a three-dimensional
-rectangle. Inactive modelines remain 2D, though they are slightly toned
-down relative to the default. This aesthetic is the same as what you
-get when you run Emacs without any customizations (@kbd{emacs -Q} on the
-command line).
-
-While @samp{moody} removes all box effects from the modelines and applies
-underline and overline properties instead. It also tones down a bit the
-inactive modelines. This is meant to optimize things for use with the
-@uref{https://github.com/tarsius/moody, moody package} (hereinafter referred to as ``Moody''), though it can work
-fine even without it.
-
-Note that Moody does not expose any faces that the themes could style
-directly. Instead it re-purposes existing ones to render its tabs and
-ribbons. As such, there may be cases where the contrast ratio falls
-below the 7:1 target that the themes conform with (WCAG AAA). To hedge
-against this, we configure a fallback foreground for the @samp{moody} option,
-which will come into effect when the background of the modeline changes
-to something less accessible, such as Moody ribbons (read the doc string
-of @samp{set-face-attribute}, specifically @samp{:distant-foreground}). This fallback
-comes into effect when Emacs determines that the background and
-foreground of the given construct are too close to each other in terms
-of color distance. In effect, users would need to experiment with the
-variable @samp{face-near-same-color-threshold} to trigger the fallback color.
-We find that a value of @samp{45000} would suffice, contrary to the default
-@samp{30000}. Do not set the value too high, because that would have the
-adverse effect of always overriding the default color (which has been
-carefully designed to be highly accessible).
-
-Furthermore, because Moody expects an underline and overline instead of
-a box style, it is recommended you also include this in your setup:
-
-@lisp
-(setq x-underline-at-descent-line t)
-@end lisp
-
-@node Completion UIs
-@section Option for completion framework aesthetics
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-completions}
-@item
-@samp{modus-vivendi-theme-completions}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{moderate}
-@item
-@samp{opinionated}
-@end enumerate
-
-This is a special option that has different effects depending on the
-completion UI@. The interfaces can be grouped in two categories, based
-on their default aesthetics: (i) those that only or mostly use
-foreground colors for their interaction model, and (ii) those that
-combine background and foreground values for some of their metaphors.
-The former category encompasses Icomplete, Ido, Selectrum as well as
-pattern matching styles like Orderless and Flx. The latter covers Helm,
-Ivy, and similar.
-
-A value of @samp{nil} will respect the metaphors of each completion framework.
-
-The symbol @samp{moderate} will apply a combination of background and
-foreground that is fairly subtle. For Icomplete and friends this
-constitutes a departure from their default aesthetics, however the
-difference is small. While Helm et al will appear slightly different
-than their original looks, as they are toned down a bit.
-
-The symbol @samp{opinionated} will apply color combinations that refashion the
-completion UI@. For the Icomplete camp this means that intense
-background and foreground combinations are used: in effect their looks
-emulate those of Ivy and co. in their original style. Whereas the other
-group of packages will revert to an even more nuanced aesthetic with
-some additional changes to the choice of hues.
-
-To appreciate the scope of this customization option, you should spend
-some time with every one of the @samp{nil} (default), @samp{moderate}, and @samp{opinionated}
-possibilities.
-
-@node Fringes
-@section Option for fringe visibility
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-fringes}
-@item
-@samp{modus-vivendi-theme-fringes}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{subtle}
-@item
-@samp{intense}
-@end enumerate
-
-The ``subtle'' symbol will apply a greyscale background that is visible,
-yet close enough to the main background color. While the ``intense''
-symbol will use a more noticeable greyscale background.
-
-The default is to use the same color as that of the main background,
-meaning that the fringes are not obvious though they still occupy the
-space given to them by @samp{fringe-mode}.
-
-@node Line highlighting
-@section Option for line highlighting (hl-line-mode)
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-intense-hl-line}
-@item
-@samp{modus-vivendi-theme-intense-hl-line}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Draw the current line of @samp{hl-line-mode} or its global equivalent in a more
-prominent background color. This would also affect several packages
-that enable @samp{hl-line-mode}, such as @samp{elfeed} and @samp{mu4e}.
-
-The default is to use a more subtle gray.
-
-@node Matching parentheses
-@section Option for parenthesis matching (show-paren-mode)
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-intense-paren-match}
-@item
-@samp{modus-vivendi-theme-intense-paren-match}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Apply a more intense background to the matching parentheses (or
-delimiters). This affects tools such as the built-in @samp{show-paren-mode}.
-The default is to use a subtle warm color for the background of those
-overlays.
-
-@node Diffs
-@section Option for diff buffer looks
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-diffs}
-@item
-@samp{modus-vivendi-theme-diffs}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{desaturated}
-@item
-@samp{fg-only}
-@end enumerate
-
-By default the themes will apply richly colored backgrounds to the
-output of diffs, such as those of @samp{diff-mode}, @samp{ediff}, @samp{smerge-mode}, and
-@samp{magit}. These are color combinations of an accented background and
-foreground so that, for example, added lines have a pronounced green
-background with an appropriate shade of green for the affected text.
-Word-wise or ``refined'' changes follow this pattern but use different
-shades of those colors to remain distinct.
-
-A @samp{desaturated} value tones down all relevant color values. It still
-combines an accented background with an appropriate foreground, yet its
-overall impression is very subtle. Refined changes are a bit more
-intense to fulfil their intended function, though still less saturated
-than default.
-
-While @samp{fg-only} will remove all accented backgrounds and instead rely on
-color-coded text to denote changes. For instance, added lines use an
-intense green foreground, while their background is the same as the rest
-of the buffer. Word-wise highlights still use a background value which
-is, nonetheless, more subtle than its default equivalent.
-
-Concerning @samp{magit}, an extra set of tweaks are introduced for the effect
-of highlighting the current diff hunk, so as to remain consistent with
-the overall experience of that mode. Expect changes that are consistent
-with the overall intent of the aforementioned.
-
-@node Org mode blocks
-@section Option for org-mode block styles
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-org-blocks}
-@item
-@samp{modus-vivendi-theme-org-blocks}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{greyscale}
-@item
-@samp{rainbow}
-@end enumerate
-
-The default is to use the same background as the rest of the buffer for
-the contents of the block.
-
-A value of @samp{greyscale} will apply a subtle neutral gray background to the
-block's contents. It will also extend to the edge of the window the
-background of the ``begin'' and ``end'' block delimiter lines (only relevant
-for Emacs versions >= 27 where the 'extend' keyword is recognised by
-@samp{set-face-attribute}).
-
-While @samp{rainbow} will instead use an accented background for the contents
-of the block. The exact color will depend on the programming language
-and is controlled by the @samp{org-src-block-faces} variable (refer to the
-theme's source code for the current association list). This is most
-suitable for users who work on literate programming documents that mix
-and match several languages.
-
-Note that the ``rainbow'' blocks may require you to also reload the
-major-mode so that the colors are applied properly: use @kbd{M-x org-mode} or
-@kbd{M-x org-mode-restart} to refresh the buffer. Or start typing in each
-code block (inefficient at scale, but it still works).
-
-@node Heading styles
-@section Option for headings' overall style
-
-This is defined as an alist and, therefore, uses a different approach
-than other customization options documented in this manual.
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-headings}
-@item
-@samp{modus-vivendi-theme-headings}
-@end itemize
-
-Possible values, which can be specified for each heading level (examples
-further below):
-
-@itemize
-@item
-nil (default fallback option---covers all heading levels)
-@item
-@samp{t} (default style for a single heading, when the fallback differs)
-@item
-@samp{no-bold}
-@item
-@samp{line}
-@item
-@samp{line-no-bold}
-@item
-@samp{rainbow}
-@item
-@samp{rainbow-line}
-@item
-@samp{rainbow-line-no-bold}
-@item
-@samp{highlight}
-@item
-@samp{highlight-no-bold}
-@item
-@samp{rainbow-highlight}
-@item
-@samp{rainbow-highlight-no-bold}
-@item
-@samp{section}
-@item
-@samp{section-no-bold}
-@item
-@samp{rainbow-section}
-@item
-@samp{rainbow-section-no-bold}
-@end itemize
-
-To control faces per level from 1-8, use something like this (same for
-@samp{modus-vivendi-theme-headings}):
-
-@lisp
-(setq modus-operandi-theme-headings
- '((1 . section)
- (2 . line)
- (3 . highlight)
- (t . rainbow-no-bold)))
-@end lisp
-
-The above uses the @samp{section} value for heading levels 1, the @samp{line} for
-headings 2, @samp{highlight} for 3. All other levels fall back to
-@samp{rainbow-line-no-bold}.
-
-To set a uniform value for all heading levels, use this pattern:
-
-@lisp
-;; A given style for every heading
-(setq modus-operandi-theme-headings
- '((t . rainbow-line-no-bold)))
-
-;; Default aesthetic for every heading
-(setq modus-operandi-theme-headings
- '((t . nil)))
-@end lisp
-
-The default style for headings uses a fairly desaturated foreground
-value in combination with a bold typographic weight. To specify this
-style for a given level N (assuming you wish to have another fallback
-option), just specify the value @samp{t} like this:
-
-@lisp
-(setq modus-operandi-theme-headings
- '((1 . t)
- (2 . line)
- (t . rainbow-line-no-bold)))
-@end lisp
-
-A description of all other possible styles:
-
-@itemize
-@item
-@samp{no-bold} retains the default text color while removing the typographic
-weight.
-
-@item
-@samp{line} is the same as the default plus an overline over the heading.
-
-@item
-@samp{line-no-bold} is the same as @samp{line} without bold weight.
-
-@item
-@samp{rainbow} uses a more colorful foreground in combination with bold
-weight.
-
-@item
-@samp{rainbow-line} is the same as @samp{rainbow} plus an overline.
-
-@item
-@samp{rainbow-line-no-bold} is the same as @samp{rainbow-line} without the bold
-weight.
-
-@item
-@samp{highlight} retains the default style of a fairly desaturated foreground
-combined with a bold weight and adds to it a subtle accented
-background.
-
-@item
-@samp{highlight-no-bold} is the same as @samp{highlight} without a bold weight.
-
-@item
-@samp{rainbow-highlight} is the same as @samp{highlight} but with a more colorful
-foreground.
-
-@item
-@samp{rainbow-highlight-no-bold} is the same as @samp{rainbow-highlight} without a
-bold weight.
-
-@item
-@samp{section} retains the default looks and adds to them both an overline
-and a slightly accented background. It is, in effect, a combination
-of the @samp{line} and @samp{highlight} values.
-
-@item
-@samp{section-no-bold} is the same as @samp{section} without a bold weight.
-
-@item
-@samp{rainbow-section} is the same as @samp{section} but with a more colorful
-foreground.
-
-@item
-@samp{rainbow-section-no-bold} is the same as @samp{rainbow-section} without a bold
-weight.``
-@end itemize
-
-@node Scaled headings
-@section Option for scaled headings
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-scale-headings}
-@item
-@samp{modus-vivendi-theme-scale-headings}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Make headings larger in height relative to the main text. This is
-noticeable in modes like Org. The default is to use the same size for
-headings and body copy.
-
-@menu
-* Scaled heading sizes:: Specify rate of increase for scaled headings
-@end menu
-
-@node Scaled heading sizes
-@subsection Control the scale of headings
-
-In addition to toggles for enabling scaled headings, users can also
-specify a number of their own.
-
-@itemize
-@item
-If it is a floating point, say, @samp{1.5}, it is interpreted as a multiple
-of the base font size. This is the recommended method.
-
-@item
-If it is an integer, it is read as an absolute font height. The
-number is basically the point size multiplied by ten. So if you want
-it to be @samp{18pt} you must pass @samp{180}. Please understand that setting an
-absolute value is discouraged, as it will break the layout when you
-try to change font sizes with the built-in @samp{text-scale-adjust} command
-(see @ref{Font configs (DIY), , Font configurations}).
-@end itemize
-
-Below are the variables in their default values, using the floating
-point paradigm. The numbers are very conservative, but you are free to
-change them to your liking, such as @samp{1.2}, @samp{1.4}, @samp{1.6}, @samp{1.8}, @samp{2.0}---or use a
-resource for finding a consistent scale:
-
-@lisp
-(setq modus-operandi-theme-scale-1 1.05
- modus-operandi-theme-scale-2 1.1
- modus-operandi-theme-scale-3 1.15
- modus-operandi-theme-scale-4 1.2
- modus-operandi-theme-scale-5 1.3)
-
-(setq modus-vivendi-theme-scale-1 1.05
- modus-vivendi-theme-scale-2 1.1
- modus-vivendi-theme-scale-3 1.15
- modus-vivendi-theme-scale-4 1.2
- modus-vivendi-theme-scale-5 1.3)
-@end lisp
-
-Note that in earlier versions of Org, scaling would only increase the
-size of the heading, but not of keywords that were added to it, like
-``TODO''. The issue has been fixed upstream:
-@uref{https://protesilaos.com/codelog/2020-09-24-org-headings-adapt/}.
-
-@node Headings' font
-@section Option for variable-pitch font in headings
-
-Symbol names:
-
-@itemize
-@item
-@samp{modus-operandi-theme-variable-pitch-headings}
-@item
-@samp{modus-vivendi-theme-variable-pitch-headings}
-@end itemize
-
-Possible values:
-
-@enumerate
-@item
-@samp{nil} (default)
-@item
-@samp{t}
-@end enumerate
-
-Choose to apply a proportionately spaced, else ``variable-pitch'',
-typeface to headings (such as in Org mode). The default is to use the
-main font family.
-
-@ref{Font configs (DIY), , Font configurations for Org (and others)}.
-
-@node Advanced customization (do-it-yourself)
-@chapter Advanced customization (do-it-yourself)
-
-Unlike the predefined customization options which follow a
-straightforward pattern of allowing the user to quickly specify their
-preference, the themes also provide a more flexible, albeit difficult,
-mechanism to control things with precision (see @ref{Customization Options}).
-
-This section is of interest only to users who are prepared to maintain
-their own local tweaks and who are willing to deal with any possible
-incompatibilities between versioned releases of the themes. As such,
-they are labelled as ``do-it-yourself'' or ``DIY''.
-
-@menu
-* Tweak colors (DIY):: Declare your own palette overrides
-* Font configs (DIY):: Optimise for mixed typeface buffers
-* Org user faces (DIY):: Extend styles for org-mode keywords and priorities
-@end menu
-
-@node Tweak colors (DIY)
-@section Full access to the themes' palette
-
-The variables are:
-
-@itemize
-@item
-@samp{modus-operandi-theme-override-colors-alist}
-@item
-@samp{modus-vivendi-theme-override-colors-alist}
-@end itemize
-
-Users can specify an association list that maps the names of color
-variables to hexadecimal RGB values (in the form of @samp{#RRGGBB}). This
-means that it is possible to override the entire palette or subsets
-thereof (see the source code for the actual names and values).
-
-Example:
-
-@lisp
-;; Redefine the values of those three variables for the given theme
-(setq modus-vivendi-theme-override-colors-alist
- '(("magenta" . "#ffaabb")
- ("magenta-alt" . "#ee88ff")
- ("magenta-alt-other" . "#bbaaff")))
-@end lisp
-
-If you want to be creative, you can define a minor mode that refashions
-the themes on demand. The following is a minor mode that gets activated
-on demand. We combine it with the function to switch between Modus
-Operandi and Modus Vivendi (@pxref{Toggle between the themes on demand}, for
-a basic command, and/or @pxref{Configure options prior to loading}, for a more
-comprehensive setup).
-
-@lisp
-(define-minor-mode modus-themes-alt-mode
- "Override Modus themes' palette variables with custom values.
-
-This is intended as a proof-of-concept. It is, nonetheless, a
-perfectly accessible alternative, conforming with the design
-principles of the Modus themes. It still is not as good as the
-default colors."
- :init-value nil
- :global t
- (if modus-themes-alt-mode
- (setq modus-operandi-theme-override-colors-alist
- '(("bg-main" . "#fefcf4")
- ("bg-dim" . "#faf6ef")
- ("bg-alt" . "#f7efe5")
- ("bg-hl-line" . "#f4f0e3")
- ("bg-active" . "#e8dfd1")
- ("bg-inactive" . "#f6ece5")
- ("bg-region" . "#c6bab1")
- ("bg-header" . "#ede3e0")
- ("bg-tab-bar" . "#dcd3d3")
- ("bg-tab-active" . "#fdf6eb")
- ("bg-tab-inactive" . "#c8bab8")
- ("fg-unfocused" . "#55556f"))
- modus-vivendi-theme-override-colors-alist
- '(("bg-main" . "#100b17")
- ("bg-dim" . "#161129")
- ("bg-alt" . "#181732")
- ("bg-hl-line" . "#191628")
- ("bg-active" . "#282e46")
- ("bg-inactive" . "#1a1e39")
- ("bg-region" . "#393a53")
- ("bg-header" . "#202037")
- ("bg-tab-bar" . "#262b41")
- ("bg-tab-active" . "#120f18")
- ("bg-tab-inactive" . "#3a3a5a")
- ("fg-unfocused" . "#9a9aab")))
- (setq modus-operandi-theme-override-colors-alist nil
- modus-vivendi-theme-override-colors-alist nil)))
-
-(defun modus-themes-toggle (&optional arg)
- "Toggle between `modus-operandi' and `modus-vivendi' themes.
-
-With optional \\[universal-argument] prefix, enable
-`modus-themes-alt-mode' for the loaded theme."
- (interactive "P")
- (if arg
- (modus-themes-alt-mode 1)
- (modus-themes-alt-mode -1))
- (if (eq (car custom-enabled-themes) 'modus-operandi)
- (progn
- (disable-theme 'modus-operandi)
- (load-theme 'modus-vivendi t))
- (disable-theme 'modus-vivendi)
- (load-theme 'modus-operandi t)))
-@end lisp
-
-@printindex cp
-
-@node Font configs (DIY)
-@section Font configurations for Org (and others)
-
-The themes are designed to cope well with mixed font settings (@ref{No mixed fonts, , Option
-for no font mixing}). Currently this applies to @samp{org-mode} and
-@samp{markdown-mode}.
-
-In practice it means that the user can safely opt for a more
-prose-friendly proportionately spaced typeface as their default, while
-letting spacing-sensitive elements like tables and inline code always
-use a monospaced font, by inheriting from the @samp{fixed-pitch} face.
-
-Users can try the built-in @kbd{M-x variable-pitch-mode} to see the effect in
-action.
-
-To make everything use your desired font families, you need to configure
-the @samp{variable-pitch} (proportional spacing) and @samp{fixed-pitch} (monospaced)
-faces respectively. It may also be convenient to set your main typeface
-by configuring the @samp{default} face the same way.
-
-Put something like this in your initialization file (make sure to read
-the documentation of @samp{set-face-attribute}, with @kbd{M-x describe-function}):
-
-@lisp
-;; Main typeface
-(set-face-attribute 'default nil :family "DejaVu Sans Mono" :height 110)
-
-;; Proportionately spaced typeface
-(set-face-attribute 'variable-pitch nil :family "DejaVu Serif" :height 1.0)
-
-;; Monospaced typeface
-(set-face-attribute 'fixed-pitch nil :family "DejaVu Sans Mono" :height 1.0)
-@end lisp
-
-Note the differences in the @samp{:height} property. The @samp{default} face must
-specify an absolute value, which is the point size × 10. So if you want
-to use a font at point size @samp{11}, you set the height at @samp{110}.@footnote{@samp{:height}
-values do not need to be rounded to multiples of ten: the likes of @samp{115}
-are perfectly valid—some typefaces will change to account for those
-finer increments.} Whereas every other face must have a value that is
-relative to the default, represented as a floating point (if you use an
-integer, say, @samp{15} then that means an absolute height). This is of
-paramount importantance: it ensures that all fonts can scale gracefully
-when using something like the @samp{text-scale-adjust} command which only
-operates on the base font size (i.e. the @samp{default} face's absolute
-height).
-
-An alternative syntax for the @samp{default} face, is to pass all typeface
-parameters directly to a @samp{font} property.@footnote{Has the benefit of
-accepting @samp{fontconfig} parameters (GNU/Linux), such as @samp{"DejaVu Sans
-Mono-11:hintstyle=hintslight:autohint=false"}.
-@uref{https://www.freedesktop.org/software/fontconfig/fontconfig-user.html}}
-Note that here we use a standard point size:
-
-@lisp
-(set-face-attribute 'default nil :font "DejaVu Sans Mono-11")
-@end lisp
-
-Again, remember to only ever specify an absolute height for the @samp{default}.
-
-@printindex cp
-
-@node Org user faces (DIY)
-@section Org user faces (DIY)
-
-Users of @samp{org-mode} have the option to configure various keywords and
-priority cookies to better match their workflow. User options are
-@samp{org-todo-keyword-faces} and @samp{org-priority-faces}.
-
-As those are meant to be custom faces, it would be futile to have the
-themes try to guess what each user would want to use, which keywords to
-target, and so on. Instead, we can provide guidelines on how to
-customize things to one's liking with the intent of retaining the
-overall aesthetics of the theme.
-
-Please bear in mind that the end result of those is not controlled by
-the active theme but by how Org maps faces to its constructs. Editing
-those while @samp{org-mode} is active requires @kbd{M-x org-mode-restart} for changes
-to take effect.
-
-Let us assume you wish to visually differentiate your keywords. You
-have something like this:
-
-@lisp
-(setq org-todo-keywords
- '((sequence "TODO(t)" "|" "DONE(D)" "CANCEL(C)")
- (sequence "MEET(m)" "|" "MET(M)")
- (sequence "STUDY(s)" "|" "STUDIED(S)")
- (sequence "WRITE(w)" "|" "WROTE(W)")))
-@end lisp
-
-You could then use a variant of the following to inherit from a face
-that uses the styles you want and also to preserve the properties
-applied by the @samp{org-todo} face:
-
-@lisp
-(setq org-todo-keyword-faces
- '(("MEET" . '(font-lock-preprocessor-face org-todo))
- ("STUDY" . '(font-lock-variable-name-face org-todo))
- ("WRITE" . '(font-lock-type-face org-todo))))
-@end lisp
-
-This will refashion the keywords you specify, while letting the other
-items in @samp{org-todo-keywords} use their original styles (which are defined
-in the @samp{org-todo} and @samp{org-done} faces).
-
-If you want back the defaults, try specifying just the @samp{org-todo} face:
-
-@lisp
-(setq org-todo-keyword-faces
- '(("MEET" . org-todo)
- ("STUDY" . org-todo)
- ("WRITE" . org-todo)))
-@end lisp
-
-When you inherit from multiple faces, you need to quote the list as
-shown further above. The order is important: the last item is applied
-over the previous ones. If you do not want to blend multiple faces, you
-do not need a quoted list. A pattern of @samp{keyword . face} would suffice.
-
-Both approaches can be used simultaneously, as illustrated in this
-configuration of the priority cookies:
-
-@lisp
-(setq org-priority-faces
- '((?A . '(org-scheduled-today org-priority))
- (?B . org-priority)
- (?C . '(shadow org-priority))))
-@end lisp
-
-To find all the faces that are loaded in your current Emacs session, use
-@kbd{M-x list-faces-display}. Also try @kbd{M-x describe-variable} and then specify
-the name of each of those Org variables demonstrated above. Their
-documentation strings will offer you further guidance.
-
-Furthermore, consider reading the ``Notes for aspiring Emacs theme
-developers'', published on 2020-08-28 by me (Protesilaos Stavrou):
-@uref{https://protesilaos.com/codelog/2020-08-28-notes-emacs-theme-devs/}.
-
-@printindex cp
-
-@printindex cp
-
-@node Face coverage
-@chapter Face coverage
-
-Modus Operandi and Modus Vivendi try to provide as close to full face
-coverage as possible. This is necessary to ensure a consistently
-accessible reading experience across all possible interfaces.
-
-@menu
-* Supported packages:: Full list of covered face groups
-* Covered indirectly::
-* Will NOT be supported::
-@end menu
-
-@node Supported packages
-@section Full support for packages or face groups
-
-This list will always be updated to reflect the current state of the
-project. The idea is to offer an overview of the known status of all
-affected face groups. The items with an appended asterisk @samp{*} tend to
-have lots of extensions, so the ``full support'' may not be 100% true…
-
-@itemize
-@item
-ace-window
-@item
-ag
-@item
-alert
-@item
-all-the-icons
-@item
-annotate
-@item
-anzu
-@item
-apropos
-@item
-apt-sources-list
-@item
-artbollocks-mode
-@item
-auctex and @TeX{}
-@item
-auto-dim-other-buffers
-@item
-avy
-@item
-awesome-tray
-@item
-binder
-@item
-bm
-@item
-bongo
-@item
-boon
-@item
-breakpoint (provided by the built-in @samp{gdb-mi.el} library)
-@item
-buffer-expose
-@item
-calendar and diary
-@item
-calfw
-@item
-centaur-tabs
-@item
-change-log and log-view (such as @samp{vc-print-log} and @samp{vc-print-root-log})
-@item
-cider
-@item
-circe
-@item
-color-rg
-@item
-column-enforce-mode
-@item
-company-mode*
-@item
-company-posframe
-@item
-compilation-mode
-@item
-completions
-@item
-counsel*
-@item
-counsel-css
-@item
-counsel-notmuch
-@item
-counsel-org-capture-string
-@item
-cov
-@item
-cperl-mode
-@item
-csv-mode
-@item
-ctrlf
-@item
-custom (@kbd{M-x customize})
-@item
-dap-mode
-@item
-dashboard (emacs-dashboard)
-@item
-deadgrep
-@item
-debbugs
-@item
-define-word
-@item
-deft
-@item
-dictionary
-@item
-diff-hl
-@item
-diff-mode
-@item
-dim-autoload
-@item
-dir-treeview
-@item
-dired
-@item
-dired-async
-@item
-dired-git
-@item
-dired-git-info
-@item
-dired-narrow
-@item
-dired-subtree
-@item
-diredfl
-@item
-disk-usage
-@item
-doom-modeline
-@item
-dynamic-ruler
-@item
-easy-jekyll
-@item
-easy-kill
-@item
-ebdb
-@item
-ediff
-@item
-eglot
-@item
-el-search
-@item
-eldoc-box
-@item
-elfeed
-@item
-elfeed-score
-@item
-emms
-@item
-enhanced-ruby-mode
-@item
-epa
-@item
-equake
-@item
-erc
-@item
-eros
-@item
-ert
-@item
-eshell
-@item
-eshell-fringe-status
-@item
-eshell-git-prompt
-@item
-eshell-prompt-extras (epe)
-@item
-eshell-syntax-highlighting
-@item
-evil* (evil-mode)
-@item
-evil-goggles
-@item
-evil-visual-mark-mode
-@item
-eww
-@item
-eyebrowse
-@item
-fancy-dabbrev
-@item
-flycheck
-@item
-flycheck-color-mode-line
-@item
-flycheck-indicator
-@item
-flycheck-posframe
-@item
-flymake
-@item
-flyspell
-@item
-flyspell-correct
-@item
-flx
-@item
-freeze-it
-@item
-frog-menu
-@item
-focus
-@item
-fold-this
-@item
-font-lock (generic syntax highlighting)
-@item
-forge
-@item
-fountain (fountain-mode)
-@item
-geiser
-@item
-git-commit
-@item
-git-gutter (and variants)
-@item
-git-lens
-@item
-git-rebase
-@item
-git-timemachine
-@item
-git-walktree
-@item
-gnus
-@item
-golden-ratio-scroll-screen
-@item
-helm*
-@item
-helm-ls-git
-@item
-helm-switch-shell
-@item
-helm-xref
-@item
-helpful
-@item
-highlight-blocks
-@item
-highlight-defined
-@item
-highlight-escape-sequences (@samp{hes-mode})
-@item
-highlight-indentation
-@item
-highlight-numbers
-@item
-highlight-symbol
-@item
-highlight-tail
-@item
-highlight-thing
-@item
-hl-defined
-@item
-hl-fill-column
-@item
-hl-line-mode
-@item
-hl-todo
-@item
-hydra
-@item
-hyperlist
-@item
-ibuffer
-@item
-icomplete
-@item
-icomplete-vertical
-@item
-ido-mode
-@item
-iedit
-@item
-iflipb
-@item
-imenu-list
-@item
-indium
-@item
-info
-@item
-info-colors
-@item
-interaction-log
-@item
-ioccur
-@item
-isearch, occur, etc.
-@item
-ivy*
-@item
-ivy-posframe
-@item
-jira (org-jira)
-@item
-journalctl-mode
-@item
-js2-mode
-@item
-julia
-@item
-jupyter
-@item
-kaocha-runner
-@item
-keycast
-@item
-line numbers (@samp{display-line-numbers-mode} and global variant)
-@item
-lsp-mode
-@item
-lsp-ui
-@item
-magit
-@item
-magit-imerge
-@item
-man
-@item
-markdown-mode
-@item
-markup-faces (@samp{adoc-mode})
-@item
-mentor
-@item
-messages
-@item
-minibuffer-line
-@item
-minimap
-@item
-modeline
-@item
-mood-line
-@item
-moody
-@item
-mpdel
-@item
-mu4e
-@item
-mu4e-conversation
-@item
-multiple-cursors
-@item
-neotree
-@item
-no-emoji
-@item
-notmuch
-@item
-num3-mode
-@item
-nxml-mode
-@item
-objed
-@item
-orderless
-@item
-org*
-@item
-org-journal
-@item
-org-noter
-@item
-org-pomodoro
-@item
-org-recur
-@item
-org-roam
-@item
-org-superstar
-@item
-org-table-sticky-header
-@item
-org-treescope
-@item
-origami
-@item
-outline-mode
-@item
-outline-minor-faces
-@item
-package (@kbd{M-x list-packages})
-@item
-page-break-lines
-@item
-paradox
-@item
-paren-face
-@item
-parrot
-@item
-pass
-@item
-persp-mode
-@item
-perspective
-@item
-phi-grep
-@item
-phi-search
-@item
-pkgbuild-mode
-@item
-pomidor
-@item
-powerline
-@item
-powerline-evil
-@item
-proced
-@item
-prodigy
-@item
-racket-mode
-@item
-rainbow-blocks
-@item
-rainbow-identifiers
-@item
-rainbow-delimiters
-@item
-rcirc
-@item
-regexp-builder (also known as @samp{re-builder})
-@item
-rg (rg.el)
-@item
-ripgrep
-@item
-rmail
-@item
-ruler-mode
-@item
-sallet
-@item
-selectrum
-@item
-semantic
-@item
-sesman
-@item
-shell-script-mode
-@item
-show-paren-mode
-@item
-side-notes
-@item
-skewer-mode
-@item
-smart-mode-line
-@item
-smartparens
-@item
-smerge
-@item
-spaceline
-@item
-speedbar
-@item
-spell-fu
-@item
-stripes
-@item
-suggest
-@item
-switch-window
-@item
-swiper
-@item
-swoop
-@item
-sx
-@item
-symbol-overlay
-@item
-syslog-mode
-@item
-table (built-in table.el)
-@item
-telephone-line
-@item
-term
-@item
-tomatinho
-@item
-transient (pop-up windows such as Magit's)
-@item
-trashed
-@item
-treemacs
-@item
-tty-menu
-@item
-tuareg
-@item
-typescript
-@item
-undo-tree
-@item
-vc (built-in mode line status for version control)
-@item
-vc-annotate (@kbd{C-x v g})
-@item
-vdiff
-@item
-vimish-fold
-@item
-visible-mark
-@item
-visual-regexp
-@item
-volatile-highlights
-@item
-vterm
-@item
-wcheck-mode
-@item
-web-mode
-@item
-wgrep
-@item
-which-function-mode
-@item
-which-key
-@item
-whitespace-mode
-@item
-window-divider-mode
-@item
-winum
-@item
-writegood-mode
-@item
-woman
-@item
-xah-elisp-mode
-@item
-xref
-@item
-xterm-color (and ansi-colors)
-@item
-yaml-mode
-@item
-yasnippet
-@item
-ztree
-@end itemize
-
-Plus many other miscellaneous faces that are provided by the upstream
-GNU Emacs distribution.
-
-@node Covered indirectly
-@section Covered indirectly
-
-These do not require any extra styles because they are configured to
-inherit from some basic faces. Please confirm.
-
-@itemize
-@item
-edit-indirect
-@item
-evil-owl
-@item
-perl-mode
-@item
-php-mode
-@item
-rjsx-mode
-@item
-swift-mode
-@end itemize
-
-@node Will NOT be supported
-@section Will NOT be supported
-
-I have thus far identified a single package that does fit into the
-overarching objective of this project: @uref{https://github.com/hlissner/emacs-solaire-mode, solaire}. It basically tries to
-cast a less intense background on the main file-visiting buffers, so
-that secondary elements like sidebars can have the default (pure
-white/black) background.
-
-I will only cover this package if it ever supports the inverse effect:
-less intense colors (but still accessible) for ancillary interfaces
-and the intended styles for the content you are actually working on.
-
-@node Notes for individual packages
-@chapter Notes for individual packages
-
-This section covers information that may be of interest to users of
-individual packages.
-
-@menu
-* Note on company-mode overlay pop-up::
-* Note for ERC escaped color sequences::
-* Note for powerline or spaceline::
-* Note on shr colors::
-* Note for Helm grep::
-* Note on vc-annotate-background-mode::
-@end menu
-
-@node Note on company-mode overlay pop-up
-@section Note on company-mode overlay pop-up
-
-By default, the @samp{company-mode} pop-up that lists completion candidates is
-drawn using an overlay. This creates alignment issues every time it is
-placed above a piece of text that has a different height than the
-default.
-
-The solution recommended by the project's maintainer is to use an
-alternative front-end for drawing the pop-up which uses child frames
-instead of overlays.@footnote{@uref{https://github.com/company-mode/company-mode/issues/1010}}@footnote{@uref{https://github.com/tumashu/company-posframe/}}
-
-@node Note for ERC escaped color sequences
-@section Note for ERC escaped color sequences
-
-The built-in IRC client @samp{erc} has the ability to colorise any text using
-escape sequences that start with @samp{^C} (inserted with @samp{C-q C-c}) and are
-followed by a number for the foreground and background.@footnote{This page
-explains the basics, though it is not specific to Emacs:
-@uref{https://www.mirc.com/colors.html}} Possible numbers are 0-15, with the
-first entry being the foreground and the second the background,
-separated by a comma. Like this @samp{^C1,6}. The minimum setup is this:
-
-@lisp
-(add-to-list 'erc-modules 'irccontrols)
-(setq erc-interpret-controls-p t
- erc-interpret-mirc-color t)
-@end lisp
-
-As this allows users to make arbitrary combinations, it is impossible to
-guarantee a consistently high contrast ratio. All we can we do is
-provide guidance on the combinations that satisfy the accessibility
-standard of the themes:
-
-@table @asis
-@item Modus Operandi
-Use foreground color 1 for all backgrounds from
-2-15. Like so: @samp{C-q C-c1,N} where @samp{N} is the background.
-
-@item Modus Vivendi
-Use foreground color 0 for all backgrounds from
-2-13. Use foreground @samp{1} for backgrounds 14, 15.
-@end table
-
-Colors 0 and 1 are white and black respectively. So combine them
-together, if you must.
-
-@node Note for powerline or spaceline
-@section Note for powerline or spaceline
-
-Both Powerline and Spaceline package users will likely need to use the
-command @samp{powerline-reset} whenever they make changes to their themes
-and/or modeline setup.
-
-@node Note on shr colors
-@section Note on shr colors
-
-Emacs' HTML rendering mechanism (@samp{shr}) may need explicit configuration to
-respect the theme's colors instead of whatever specifications the
-webpage provides. Consult @kbd{C-h v shr-use-colors}.
-
-@node Note for Helm grep
-@section Note for Helm grep
-
-There is one face from the Helm package that is meant to highlight the
-matches of a grep or grep-like command (@samp{ag} or @samp{ripgrep}). It is
-@samp{helm-grep-match}. However, this face can only apply when the user does
-not pass @samp{--color=always} as a command-line option for their command.
-
-Here is the docstring for that face, which is defined in the
-@samp{helm-grep.el} library (view a library with @samp{M-x find-library}).
-
-@quotation
-Face used to highlight grep matches. Have no effect when grep backend
-use ``--color=''
-
-@end quotation
-
-The user must either remove @samp{--color} from the flags passed to the grep
-function, or explicitly use @samp{--color=never} (or equivalent). Helm
-provides user-facing customization options for controlling the grep
-function's parameters, such as @samp{helm-grep-default-command} and
-@samp{helm-grep-git-grep-command}.
-
-When @samp{--color=always} is in effect, the grep output will use red text in
-bold letter forms to present the matching part in the list of
-candidates. That style still meets the contrast ratio target of >= 7:1
-(accessibility standard WCAG AAA), because it draws the reference to
-ANSI color number 1 (red) from the already-supported array of
-@samp{ansi-color-names-vector}.
-
-@node Note on vc-annotate-background-mode
-@section Note on vc-annotate-background-mode
-
-Due to the unique way @samp{vc-annotate} (@kbd{C-x v g}) applies colors, support for
-its background mode (@samp{vc-annotate-background-mode}) is disabled at the
-theme level.
-
-Normally, such a drastic measure should not belong in a theme: assuming
-the user's preferences is bad practice. However, it has been deemed
-necessary in the interest of preserving color contrast accessibility
-while still supporting a useful built-in tool.
-
-If there actually is a way to avoid such a course of action, without
-prejudice to the accessibility standard of this project, then please
-report as much or send patches (see @ref{Contributing}).
-
-@node Contributing
-@chapter Contributing
-
-This section documents the canonical sources of the themes and the ways
-in which you can contribute to their ongoing development.
-
-@menu
-* Sources of the themes::
-* Issues you can help with::
-* Merge requests:: Legal considerations for code patches
-@end menu
-
-@node Sources of the themes
-@section Sources of the themes
-
-The @samp{modus-operandi} and @samp{modus-vivendi} themes are built into Emacs.
-Currently they are in the project's @samp{master} branch, which is tracking the
-next development release target.
-
-The source code of the themes is @uref{https://gitlab.com/protesilaos/modus-themes/, available on Gitlab}, for the time
-being. A @uref{https://github.com/protesilaos/modus-themes/, mirror on Github} is also on offer.
-
-An HTML version of this manual is available as an extension to the
-@uref{https://protesilaos.com/modus-themes/, author's personal website} (does not rely on any non-free code).
-
-@node Issues you can help with
-@section Issues you can help with
-
-A few tasks you can help with:
-
-@itemize
-@item
-Suggest refinements to packages that are covered.
-@item
-Report packages not covered thus far.
-@item
-Report bugs, inconsistencies, shortcomings.
-@item
-Help expand the documentation of covered-but-not-styled packages.
-@item
-Suggest refinements to the color palette.
-@item
-Help expand this document or any other piece of documentation.
-@item
-Merge requests for code refinements.
-@end itemize
-
-@xref{Merge requests, , Patches require copyright assignment to the FSF}.
-
-It would be great if your feedback also includes some screenshots, GIFs,
-or short videos, as well as further instructions to reproduce a given
-setup. Though this is not a requirement.
-
-Whatever you do, bear in mind the overarching objective of the Modus
-themes: to keep a contrast ratio that is greater or equal to 7:1 between
-background and foreground colors. If a compromise is ever necessary
-between aesthetics and accessibility, it shall always be made in the
-interest of the latter.
-
-@node Merge requests
-@section Patches require copyright assignment to the FSF
-
-Code contributions are most welcome. For any major edit (more than 15
-lines, or so, in aggregate per person), you need to make a copyright
-assignment to the Free Software Foundation. This is necessary because
-the themes are part of the upstream Emacs distribution: the FSF must at
-all times be in a position to enforce the GNU General Public License.
-
-Copyright assignment is a simple process. Check the request form below
-(please adapt it accordingly). You must write an email to the address
-mentioned in the form and then wait for the FSF to send you a legal
-agreement. Sign the document and file it back to them. This could all
-happen via email and take about a week. You are encouraged to go
-through this process. You only need to do it once. It will allow you
-to make contributions to Emacs in general.
-
-@example
-Please email the following information to assign@@gnu.org, and we
-will send you the assignment form for your past and future changes.
-
-Please use your full legal name (in ASCII characters) as the subject
-line of the message.
-----------------------------------------------------------------------
-REQUEST: SEND FORM FOR PAST AND FUTURE CHANGES
-
-[What is the name of the program or package you're contributing to?]
-
-GNU Emacs
-
-[Did you copy any files or text written by someone else in these changes?
-Even if that material is free software, we need to know about it.]
-
-Copied a few snippets from the same files I edited. Their author,
-Protesilaos Stavrou, has already assigned copyright to the Free Software
-Foundation.
-
-[Do you have an employer who might have a basis to claim to own
-your changes? Do you attend a school which might make such a claim?]
-
-
-[For the copyright registration, what country are you a citizen of?]
-
-
-[What year were you born?]
-
-
-[Please write your email address here.]
-
-
-[Please write your postal address here.]
-
-
-
-
-
-[Which files have you changed so far, and which new files have you written
-so far?]
-
-Changed a couple of themes that are part of the Emacs source code:
-
-./etc/themes/modus-operandi-theme.el
-./etc/themes/modus-vivendi-theme.el
-@end example
-
-@node Acknowledgements
-@chapter Acknowledgements
-
-The Modus themes are a collective effort. Every contribution counts.
-
-@table @asis
-@item Author/maintainer
-Protesilaos Stavrou.
-
-@item Code contributions
-Anders Johansson, Basil L@. Contovounesios,
-Markus Beppler, Matthew Stevenson.
-
-@item Ideas and user feedback
-Aaron Jensen, Adam Spiers, Alex Griffin,
-Alex Peitsinis, Alexey Shmalko, Anders Johansson, André Alexandre
-Gomes, Arif Rezai, Basil L@. Contovounesios, Damien Cassou, Dario
-Gjorgjevski, David Edmondson, Davor Rotim, Divan Santana, Gerry
-Agbobada, Gianluca Recchia, Iris Garcia, Len Trigg, Manuel Uberti,
-Mark Burton, Markus Beppler, Michael Goldenberg, Murilo Pereira,
-Nicolas De Jaeghere, Pierre Téchoueyres, Roman Rudakov, Ryan Phillips,
-Shreyas Ragavan, Tassilo Horn, Thibaut Verron, Trey Merkley, Uri
-Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben,
-Fourchaux, Fredrik, Moesasji, Nick, TheBlob42, dinko, doolio, jixiuf,
-okamsn, tycho garen.
-
-@item Packaging
-Dhavan Vaidya (Debian), Stefan Kangas (core Emacs),
-Stefan Monnier (GNU Elpa).
-
-@item Inspiration for certain features
-Fabrice Niessen (leuven-theme),
-Bozhidar Batsov (zenburn-theme).
-@end table
-
-@node Meta
-@chapter Meta
-
-If you are curious about the principles that govern the development of
-this project read the essay @uref{https://protesilaos.com/codelog/2020-03-17-design-modus-themes-emacs/, On the design of the Modus themes}
-(2020-03-17).
-
-Here are some more publications for those interested in the kind of work
-that goes into this project (sometimes the commits also include details
-of this sort):
-
-@itemize
-@item
-@uref{https://protesilaos.com/codelog/2020-05-10-modus-operandi-palette-review/, Modus Operandi theme subtle palette review} (2020-05-10)
-@item
-@uref{https://protesilaos.com/codelog/2020-06-13-modus-vivendi-palette-review/, Modus Vivendi theme subtle palette review} (2020-06-13)
-@item
-@uref{https://protesilaos.com/codelog/2020-07-04-modus-themes-faint-colours/, Modus themes: new ``faint syntax'' option} (2020-07-04)
-@item
-@uref{https://protesilaos.com/codelog/2020-07-08-modus-themes-nuanced-colours/, Modus themes: major review of ``nuanced'' colours} (2020-07-08)
-@item
-@uref{https://protesilaos.com/codelog/2020-09-14-modus-themes-review-blues/, Modus themes: review of blue colours} (2020-09-14)
-@end itemize
-
-And here are the canonical sources for this project's documentation:
-
-@table @asis
-@item Manual
-@uref{https://protesilaos.com/modus-themes}
-@item Change Log
-@uref{https://protesilaos.com/modus-themes-changelog}
-@item Screenshots
-@uref{https://protesilaos.com/modus-themes-pictures}
-@end table
-
-@node External projects (ports)
-@chapter External projects (ports)
-
-The present section documents projects that extend the scope of the
-Modus themes. The following list will be updated whenever relevant
-information is brought to my attention. If you already have or intend
-to produce such a port, feel welcome @uref{https://protesilaos.com/contact, to contact me}.
-
-@table @asis
-@item Modus exporter
-This is @uref{https://github.com/polaris64/modus-exporter, an Elisp library written by Simon Pugnet}.
-Licensed under the terms of the GNU General Public License. It is
-meant to capture the color values of the active Modus theme (Operandi
-or Vivendi) and output it as a valid theme for some other application.
-@end table
-
-@node GNU Free Documentation License
-@appendix GNU Free Documentation License
-
-@example
- GNU Free Documentation License
- Version 1.3, 3 November 2008
-
-
- Copyright (C) 2000, 2001, 2002, 2007, 2008 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.
-
-0. PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-functional and useful document "free" in the sense of freedom: to
-assure everyone the effective freedom to copy and redistribute it,
-with or without modifying it, either commercially or noncommercially.
-Secondarily, this License preserves for the author and publisher a way
-to get credit for their work, while not being considered responsible
-for modifications made by others.
-
-This License is a kind of "copyleft", which means that derivative
-works of the document must themselves be free in the same sense. It
-complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for free
-software, because free software needs free documentation: a free
-program should come with manuals providing the same freedoms that the
-software does. But this License is not limited to software manuals;
-it can be used for any textual work, regardless of subject matter or
-whether it is published as a printed book. We recommend this License
-principally for works whose purpose is instruction or reference.
-
-
-1. APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work, in any medium, that
-contains a notice placed by the copyright holder saying it can be
-distributed under the terms of this License. Such a notice grants a
-world-wide, royalty-free license, unlimited in duration, to use that
-work under the conditions stated herein. The "Document", below,
-refers to any such manual or work. Any member of the public is a
-licensee, and is addressed as "you". You accept the license if you
-copy, modify or distribute the work in a way requiring permission
-under copyright law.
-
-A "Modified Version" of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A "Secondary Section" is a named appendix or a front-matter section of
-the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall
-subject (or to related matters) and contains nothing that could fall
-directly within that overall subject. (Thus, if the Document is in
-part a textbook of mathematics, a Secondary Section may not explain
-any mathematics.) The relationship could be a matter of historical
-connection with the subject or with related matters, or of legal,
-commercial, philosophical, ethical or political position regarding
-them.
-
-The "Invariant Sections" are certain Secondary Sections whose titles
-are designated, as being those of Invariant Sections, in the notice
-that says that the Document is released under this License. If a
-section does not fit the above definition of Secondary then it is not
-allowed to be designated as Invariant. The Document may contain zero
-Invariant Sections. If the Document does not identify any Invariant
-Sections then there are none.
-
-The "Cover Texts" are certain short passages of text that are listed,
-as Front-Cover Texts or Back-Cover Texts, in the notice that says that
-the Document is released under this License. A Front-Cover Text may
-be at most 5 words, and a Back-Cover Text may be at most 25 words.
-
-A "Transparent" copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, that is suitable for revising the document
-straightforwardly with generic text editors or (for images composed of
-pixels) generic paint programs or (for drawings) some widely available
-drawing editor, and that is suitable for input to text formatters or
-for automatic translation to a variety of formats suitable for input
-to text formatters. A copy made in an otherwise Transparent file
-format whose markup, or absence of markup, has been arranged to thwart
-or discourage subsequent modification by readers is not Transparent.
-An image format is not Transparent if used for any substantial amount
-of text. A copy that is not "Transparent" is called "Opaque".
-
-Examples of suitable formats for Transparent copies include plain
-ASCII without markup, Texinfo input format, LaTeX input format, SGML
-or XML using a publicly available DTD, and standard-conforming simple
-HTML, PostScript or PDF designed for human modification. Examples of
-transparent image formats include PNG, XCF and JPG. Opaque formats
-include proprietary formats that can be read and edited only by
-proprietary word processors, SGML or XML for which the DTD and/or
-processing tools are not generally available, and the
-machine-generated HTML, PostScript or PDF produced by some word
-processors for output purposes only.
-
-The "Title Page" means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the material
-this License requires to appear in the title page. For works in
-formats which do not have any title page as such, "Title Page" means
-the text near the most prominent appearance of the work's title,
-preceding the beginning of the body of the text.
-
-The "publisher" means any person or entity that distributes copies of
-the Document to the public.
-
-A section "Entitled XYZ" means a named subunit of the Document whose
-title either is precisely XYZ or contains XYZ in parentheses following
-text that translates XYZ in another language. (Here XYZ stands for a
-specific section name mentioned below, such as "Acknowledgements",
-"Dedications", "Endorsements", or "History".) To "Preserve the Title"
-of such a section when you modify the Document means that it remains a
-section "Entitled XYZ" according to this definition.
-
-The Document may include Warranty Disclaimers next to the notice which
-states that this License applies to the Document. These Warranty
-Disclaimers are considered to be included by reference in this
-License, but only as regards disclaiming warranties: any other
-implication that these Warranty Disclaimers may have is void and has
-no effect on the meaning of this License.
-
-2. VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License applies
-to the Document are reproduced in all copies, and that you add no
-other conditions whatsoever to those of this License. You may not use
-technical measures to obstruct or control the reading or further
-copying of the copies you make or distribute. However, you may accept
-compensation in exchange for copies. If you distribute a large enough
-number of copies you must also follow the conditions in section 3.
-
-You may also lend copies, under the same conditions stated above, and
-you may publicly display copies.
-
-
-3. COPYING IN QUANTITY
-
-If you publish printed copies (or copies in media that commonly have
-printed covers) of the Document, numbering more than 100, and the
-Document's license notice requires Cover Texts, you must enclose the
-copies in covers that carry, clearly and legibly, all these Cover
-Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
-the back cover. Both covers must also clearly and legibly identify
-you as the publisher of these copies. The front cover must present
-the full title with all words of the title equally prominent and
-visible. You may add other material on the covers in addition.
-Copying with changes limited to the covers, as long as they preserve
-the title of the Document and satisfy these conditions, can be treated
-as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto adjacent
-pages.
-
-If you publish or distribute Opaque copies of the Document numbering
-more than 100, you must either include a machine-readable Transparent
-copy along with each Opaque copy, or state in or with each Opaque copy
-a computer-network location from which the general network-using
-public has access to download using public-standard network protocols
-a complete Transparent copy of the Document, free of added material.
-If you use the latter option, you must take reasonably prudent steps,
-when you begin distribution of Opaque copies in quantity, to ensure
-that this Transparent copy will remain thus accessible at the stated
-location until at least one year after the last time you distribute an
-Opaque copy (directly or through your agents or retailers) of that
-edition to the public.
-
-It is requested, but not required, that you contact the authors of the
-Document well before redistributing any large number of copies, to
-give them a chance to provide you with an updated version of the
-Document.
-
-
-4. MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document under
-the conditions of sections 2 and 3 above, provided that you release
-the Modified Version under precisely this License, with the Modified
-Version filling the role of the Document, thus licensing distribution
-and modification of the Modified Version to whoever possesses a copy
-of it. In addition, you must do these things in the Modified Version:
-
-A. Use in the Title Page (and on the covers, if any) a title distinct
- from that of the Document, and from those of previous versions
- (which should, if there were any, be listed in the History section
- of the Document). You may use the same title as a previous version
- if the original publisher of that version gives permission.
-B. List on the Title Page, as authors, one or more persons or entities
- responsible for authorship of the modifications in the Modified
- Version, together with at least five of the principal authors of the
- Document (all of its principal authors, if it has fewer than five),
- unless they release you from this requirement.
-C. State on the Title page the name of the publisher of the
- Modified Version, as the publisher.
-D. Preserve all the copyright notices of the Document.
-E. Add an appropriate copyright notice for your modifications
- adjacent to the other copyright notices.
-F. Include, immediately after the copyright notices, a license notice
- giving the public permission to use the Modified Version under the
- terms of this License, in the form shown in the Addendum below.
-G. Preserve in that license notice the full lists of Invariant Sections
- and required Cover Texts given in the Document's license notice.
-H. Include an unaltered copy of this License.
-I. Preserve the section Entitled "History", Preserve its Title, and add
- to it an item stating at least the title, year, new authors, and
- publisher of the Modified Version as given on the Title Page. If
- there is no section Entitled "History" in the Document, create one
- stating the title, year, authors, and publisher of the Document as
- given on its Title Page, then add an item describing the Modified
- Version as stated in the previous sentence.
-J. Preserve the network location, if any, given in the Document for
- public access to a Transparent copy of the Document, and likewise
- the network locations given in the Document for previous versions
- it was based on. These may be placed in the "History" section.
- You may omit a network location for a work that was published at
- least four years before the Document itself, or if the original
- publisher of the version it refers to gives permission.
-K. For any section Entitled "Acknowledgements" or "Dedications",
- Preserve the Title of the section, and preserve in the section all
- the substance and tone of each of the contributor acknowledgements
- and/or dedications given therein.
-L. Preserve all the Invariant Sections of the Document,
- unaltered in their text and in their titles. Section numbers
- or the equivalent are not considered part of the section titles.
-M. Delete any section Entitled "Endorsements". Such a section
- may not be included in the Modified Version.
-N. Do not retitle any existing section to be Entitled "Endorsements"
- or to conflict in title with any Invariant Section.
-O. Preserve any Warranty Disclaimers.
-
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section Entitled "Endorsements", provided it contains
-nothing but endorsements of your Modified Version by various
-parties--for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-
-
-5. COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under this
-License, under the terms defined in section 4 above for modified
-versions, provided that you include in the combination all of the
-Invariant Sections of all of the original documents, unmodified, and
-list them all as Invariant Sections of your combined work in its
-license notice, and that you preserve all their Warranty Disclaimers.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name but
-different contents, make the title of each such section unique by
-adding at the end of it, in parentheses, the name of the original
-author or publisher of that section if known, or else a unique number.
-Make the same adjustment to the section titles in the list of
-Invariant Sections in the license notice of the combined work.
-
-In the combination, you must combine any sections Entitled "History"
-in the various original documents, forming one section Entitled
-"History"; likewise combine any sections Entitled "Acknowledgements",
-and any sections Entitled "Dedications". You must delete all sections
-Entitled "Endorsements".
-
-
-6. COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other
-documents released under this License, and replace the individual
-copies of this License in the various documents with a single copy
-that is included in the collection, provided that you follow the rules
-of this License for verbatim copying of each of the documents in all
-other respects.
-
-You may extract a single document from such a collection, and
-distribute it individually under this License, provided you insert a
-copy of this License into the extracted document, and follow this
-License in all other respects regarding verbatim copying of that
-document.
-
-
-7. AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other separate
-and independent documents or works, in or on a volume of a storage or
-distribution medium, is called an "aggregate" if the copyright
-resulting from the compilation is not used to limit the legal rights
-of the compilation's users beyond what the individual works permit.
-When the Document is included in an aggregate, this License does not
-apply to the other works in the aggregate which are not themselves
-derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one half of
-the entire aggregate, the Document's Cover Texts may be placed on
-covers that bracket the Document within the aggregate, or the
-electronic equivalent of covers if the Document is in electronic form.
-Otherwise they must appear on printed covers that bracket the whole
-aggregate.
-
-
-8. TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of section 4.
-Replacing Invariant Sections with translations requires special
-permission from their copyright holders, but you may include
-translations of some or all Invariant Sections in addition to the
-original versions of these Invariant Sections. You may include a
-translation of this License, and all the license notices in the
-Document, and any Warranty Disclaimers, provided that you also include
-the original English version of this License and the original versions
-of those notices and disclaimers. In case of a disagreement between
-the translation and the original version of this License or a notice
-or disclaimer, the original version will prevail.
-
-If a section in the Document is Entitled "Acknowledgements",
-"Dedications", or "History", the requirement (section 4) to Preserve
-its Title (section 1) will typically require changing the actual
-title.
-
-
-9. TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense, or distribute it is void, and
-will automatically terminate your rights under this License.
-
-However, if you cease all violation of this License, then your license
-from a particular copyright holder is reinstated (a) provisionally,
-unless and until the copyright holder explicitly and finally
-terminates your license, and (b) permanently, if the copyright holder
-fails to notify you of the violation by some reasonable means prior to
-60 days after the cessation.
-
-Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
-Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, receipt of a copy of some or all of the same material does
-not give you any rights to use it.
-
-
-10. FUTURE REVISIONS OF THIS LICENSE
-
-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
-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
-License "or any later version" applies to it, you have the option of
-following the terms and conditions either of that specified version or
-of any later version that has been published (not as a draft) by the
-Free Software Foundation. If the Document does not specify a version
-number of this License, you may choose any version ever published (not
-as a draft) by the Free Software Foundation. If the Document
-specifies that a proxy can decide which future versions of this
-License can be used, that proxy's public statement of acceptance of a
-version permanently authorizes you to choose that version for the
-Document.
-
-11. RELICENSING
-
-"Massive Multiauthor Collaboration Site" (or "MMC Site") means any
-World Wide Web server that publishes copyrightable works and also
-provides prominent facilities for anybody to edit those works. A
-public wiki that anybody can edit is an example of such a server. A
-"Massive Multiauthor Collaboration" (or "MMC") contained in the site
-means any set of copyrightable works thus published on the MMC site.
-
-"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
-license published by Creative Commons Corporation, a not-for-profit
-corporation with a principal place of business in San Francisco,
-California, as well as future copyleft versions of that license
-published by that same organization.
-
-"Incorporate" means to publish or republish a Document, in whole or in
-part, as part of another Document.
-
-An MMC is "eligible for relicensing" if it is licensed under this
-License, and if all works that were first published under this License
-somewhere other than this MMC, and subsequently incorporated in whole or
-in part into the MMC, (1) had no cover texts or invariant sections, and
-(2) were thus incorporated prior to November 1, 2008.
-
-The operator of an MMC Site may republish an MMC contained in the site
-under CC-BY-SA on the same site at any time before August 1, 2009,
-provided the MMC is eligible for relicensing.
-
-
-ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
- Copyright (c) YEAR YOUR NAME.
- Permission is granted to copy, distribute and/or modify this document
- under the terms of the GNU Free Documentation License, Version 1.3
- or any later version published by the Free Software Foundation;
- with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
- A copy of the license is included in the section entitled "GNU
- Free Documentation License".
-
-If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the "with...Texts." line with this:
-
- with the Invariant Sections being LIST THEIR TITLES, with the
- Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST.
-
-If you have Invariant Sections without Cover Texts, or some other
-combination of the three, merge those two alternatives to suit the
-situation.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License,
-to permit their use in free software.
-@end example
-
-@bye
diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi
index 3671ac8f3d2..4ca223d46c4 100644
--- a/doc/misc/nxml-mode.texi
+++ b/doc/misc/nxml-mode.texi
@@ -82,7 +82,7 @@ documents.
To get validation and schema-sensitive editing, you need a RELAX NG Compact
Syntax (RNC) schema for your document (@pxref{Locating a schema}). The
@file{etc/schema} directory includes some schemas for popular document
-types. See @url{http://relaxng.org/} for more information on RELAX NG@.
+types. See @url{https://relaxng.org/} for more information on RELAX NG@.
You can use the @samp{Trang} program from
@url{http://www.thaiopensource.com/relaxng/trang.html} to
automatically create RNC schemas. This program can:
diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi
index 1adc2689697..e3306060159 100644
--- a/doc/misc/octave-mode.texi
+++ b/doc/misc/octave-mode.texi
@@ -83,9 +83,12 @@ addition to the standard Emacs commands.
@kindex C-M-j
@findex octave-indent-new-comment-line
@vindex octave-continuation-string
+@vindex octave-string-continuation-marker
Break Octave line at point, continuing comment if within one. Insert
@code{octave-continuation-string} before breaking the line unless
-inside a list. Signal an error if within a single-quoted string.
+inside a list. If within a double-quoted string, insert
+@code{octave-string-continuation-marker} instead. Signal an error if
+within a single-quoted string.
@item C-c ;
@kindex C-c ;
diff --git a/doc/misc/org-setup.org b/doc/misc/org-setup.org
new file mode 100644
index 00000000000..d0392f10a20
--- /dev/null
+++ b/doc/misc/org-setup.org
@@ -0,0 +1,53 @@
+# SETUPFILE for Org manual
+
+# Copyright (C) 2021 Free Software Foundation, Inc.
+#
+# This file is part of GNU Emacs.
+#
+# GNU Emacs is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# GNU Emacs is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+# XXX: We cannot use TODO keyword as a node starts with "TODO".
+#+todo: REVIEW FIXME | DONE
+#+property: header-args :eval no
+#+startup: overview nologdone
+
+# Use proper quote and backtick for code sections in PDF output
+# Cf. Texinfo manual 14.2
+#+texinfo_header: @set txicodequoteundirected
+#+texinfo_header: @set txicodequotebacktick
+
+# Contact Info
+#+texinfo_header: @set MAINTAINERSITE @uref{https://orgmode.org,maintainers webpage}
+#+texinfo_header: @set MAINTAINER Bastien Guerry
+#+texinfo_header: @set MAINTAINEREMAIL @email{bzg@gnu.org}
+#+texinfo_header: @set MAINTAINERCONTACT @uref{mailto:bzg@gnu.org,contact the maintainer}
+
+#+options: H:4 num:t toc:t author:t \n:nil ::t |:t ^:nil -:t f:t *:t <:t e:t ':t
+#+options: d:nil todo:nil pri:nil tags:not-in-toc stat:nil broken-links:mark
+#+select_tags: export
+#+exclude_tags: noexport
+
+#+macro: cite @@texinfo:@cite{@@$1@@texinfo:}@@
+#+macro: var @@texinfo:@var{@@$1@@texinfo:}@@
+
+# The "version" macro extracts "Version" keyword from "org.el". It
+# returns major.minor version number. This is sufficient since bugfix
+# releases are not expected to add features and therefore imply manual
+# modifications.
+#+macro: version (eval (with-current-buffer (find-file-noselect "../../lisp/org/org.el") (org-with-point-at 1 (if (re-search-forward "Version: +\\([0-9.]+\\)" nil t) (mapconcat #'identity (cl-subseq (split-string (match-string-no-properties 1) "\\.") 0 2) ".") (error "Missing \"Version\" keyword in \"org.el\"")))))
+
+# The "kbd" macro turns KBD into @kbd{KBD}. Additionally, it
+# encloses case-sensitive special keys (SPC, RET...) within @key{...}.
+#+macro: kbd (eval (let ((case-fold-search nil) (regexp (regexp-opt '("SPC" "RET" "LFD" "TAB" "BS" "ESC" "DELETE" "SHIFT" "Ctrl" "Meta" "Alt" "Cmd" "Super" "UP" "LEFT" "RIGHT" "DOWN") 'words))) (format "@@texinfo:@kbd{@@%s@@texinfo:}@@" (replace-regexp-in-string regexp "@@texinfo:@key{@@\\&@@texinfo:}@@" $1 t))))
+
diff --git a/doc/misc/org.org b/doc/misc/org.org
new file mode 100644
index 00000000000..f072b5e00e0
--- /dev/null
+++ b/doc/misc/org.org
@@ -0,0 +1,21904 @@
+#+title: The Org Manual
+#+subtitle: Release {{{version}}}
+#+author: The Org Mode Developers
+#+language: en
+
+
+#+texinfo: @insertcopying
+
+* Introduction
+:PROPERTIES:
+:DESCRIPTION: Getting started.
+:END:
+#+cindex: introduction
+
+** Summary
+:PROPERTIES:
+:DESCRIPTION: Brief summary of what Org does.
+:END:
+#+cindex: summary
+
+Org is a mode for keeping notes, maintaining TODO lists, and project
+planning with a fast and effective plain-text markup language. 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 make use of metadata which is part of an outline
+node. Based on this data, specific entries can be extracted in
+queries and create dynamic /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
+[[https://orgmode.org]].
+
+#+cindex: print edition
+An earlier version (7.3) of this manual is available as a [[http://www.network-theory.co.uk/org/manual/][paperback
+book from Network Theory Ltd.]].
+
+** Installation
+:PROPERTIES:
+:DESCRIPTION: Installing Org.
+:END:
+#+cindex: installation
+
+Org is included in all recent distributions of GNU Emacs, so you
+probably do not need to install it. Most users will simply activate
+Org and begin exploring its many features.
+
+If, for one reason or another, you want to install Org on top of this
+pre-packaged version, there are three ways to do it:
+
+- by using the Emacs package system;
+- by downloading Org as an archive; or
+- by using Org's git repository.
+
+We *strongly recommend* sticking to a single installation method.
+
+*** Using Emacs packaging system
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Recent Emacs distributions include a packaging system which lets you
+install Elisp libraries. You can install Org from the "package menu",
+with {{{kbd(M-x list-packages)}}}. See [[info:emacs::Package Menu][Package Menu]].
+
+#+attr_texinfo: :tag Important
+#+begin_quote
+You need to do this in a session where no =.org= file has been
+visited, i.e., where no Org built-in function have been loaded.
+Otherwise autoload Org functions will mess up the installation.
+#+end_quote
+
+If you want to use Org's package repository, check out the [[https://orgmode.org/elpa.html][Org ELPA
+page]].
+
+*** Downloading Org as an archive
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+You can download Org latest release from [[https://orgmode.org/][Org's website]]. In this case,
+make sure you set the load path correctly in your Emacs init file:
+
+#+begin_src emacs-lisp
+(add-to-list 'load-path "~/path/to/orgdir/lisp")
+#+end_src
+
+The downloaded archive contains contributed libraries that are not
+included in Emacs. If you want to use them, add the =contrib/=
+directory to your load path:
+
+#+begin_src emacs-lisp
+(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
+#+end_src
+
+Optionally, you can compile the files and/or install them in your
+system. Run =make help= to list compilation and installation options.
+
+*** Using Org's git repository
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+You can clone Org's repository and install Org like this:
+
+#+begin_example
+$ cd ~/src/
+$ git clone https://code.orgmode.org/bzg/org-mode.git
+$ cd org-mode/
+$ make autoloads
+#+end_example
+
+Note that in this case, =make autoloads= is mandatory: it defines
+Org's version in =org-version.el= and Org's autoloads in
+=org-loaddefs.el=.
+
+Remember to add the correct load path as described in the method
+above.
+
+You can also compile with =make=, generate the documentation with
+=make doc=, create a local configuration with =make config= and
+install Org with =make install=. Please run =make help= to get the
+list of compilation/installation options.
+
+For more detailed explanations on Org's build system, please check the
+Org Build System page on [[https://orgmode.org/worg/dev/org-build-system.html][Worg]].
+
+** Activation
+:PROPERTIES:
+:DESCRIPTION: How to activate Org for certain buffers.
+:END:
+#+cindex: activation
+#+cindex: autoload
+#+cindex: ELPA
+#+cindex: global key bindings
+#+cindex: key bindings, global
+
+Org mode buffers need Font Lock to be turned on: this is the default
+in Emacs[fn:1].
+
+There are compatibility issues between Org mode and some other Elisp
+packages (see [[*Packages that conflict with Org mode]]). Please take the
+time to check the list.
+
+#+findex: org-agenda
+#+findex: org-capture
+#+findex: org-store-link
+For a better experience, the three Org commands ~org-store-link~,
+~org-capture~ and ~org-agenda~ ought to be accessible anywhere in
+Emacs, not just in Org buffers. To that effect, you need to bind them
+to globally available keys, like the ones reserved for users (see
+[[info:elisp::Key Binding Conventions]]). Here are suggested bindings,
+please modify the keys to your own liking.
+
+#+begin_src emacs-lisp
+(global-set-key (kbd "C-c l") 'org-store-link)
+(global-set-key (kbd "C-c a") 'org-agenda)
+(global-set-key (kbd "C-c c") 'org-capture)
+#+end_src
+
+#+cindex: Org mode, turning on
+Files with the =.org= extension use Org mode by default. To turn on
+Org mode in a file that does not have the extension =.org=, make the
+first line of a file look like this:
+
+: MY PROJECTS -*- mode: org; -*-
+
+#+vindex: org-insert-mode-line-in-empty-file
+#+texinfo: @noindent
+which selects Org mode for this buffer no matter what the file's name
+is. See also the variable ~org-insert-mode-line-in-empty-file~.
+
+Many commands in Org work on the region if the region is /active/. To
+make use of this, you need to have Transient Mark mode turned on,
+which is the default. If you do not like it, you can create an active
+region by using the mouse to select a region, or pressing
+{{{kbd(C-SPC)}}} twice before moving point.
+
+** Feedback
+:PROPERTIES:
+:DESCRIPTION: Bug reports, ideas, patches, etc.
+:END:
+#+cindex: feedback
+#+cindex: bug reports
+#+cindex: reporting a bug
+#+cindex: maintainer
+#+cindex: author
+
+If you find problems with Org, or if you have questions, remarks, or
+ideas about it, please send an email to the Org mailing list
+[[mailto:emacs-orgmode@gnu.org]]. You can subscribe to the list [[https://lists.gnu.org/mailman/listinfo/emacs-orgmode][from this
+web page]]. If you are not a member of the mailing list, your mail will
+be passed to the list after a moderator has approved it[fn:2]. We ask
+you to read and respect the [[https://www.gnu.org/philosophy/kind-communication.html][GNU Kind Communications Guidelines]] when
+sending messages on this mailing list.
+
+#+findex: org-version
+#+findex: org-submit-bug-report
+For bug reports, please first try to reproduce the bug with the latest
+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)}}}) and Org ({{{kbd(M-x org-version)}}}), as well as
+the Org related setup in the Emacs init file. The easiest way to do
+this is to use the command
+
+: M-x org-submit-bug-report <RET>
+
+#+texinfo: @noindent
+which puts all this information into an Emacs mail buffer so 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 setup. Before reporting a bug, it is very helpful to start
+Emacs with minimal customizations and reproduce the problem. Doing so
+often helps you determine if the problem is with your customization or
+with Org mode itself. You can start a typical minimal session with
+a command like the example below.
+
+: $ emacs -Q -l /path/to/minimal-org.el
+
+However if you are using Org mode as distributed with Emacs, a minimal
+setup is not necessary. In that case it is sufficient to start Emacs
+as =emacs -Q=. The =minimal-org.el= setup file can have contents as
+shown below.
+
+#+begin_src emacs-lisp
+;;; Minimal setup to load latest `org-mode'.
+
+;; Activate debugging.
+(setq debug-on-error t
+ debug-on-signal nil
+ 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))
+#+end_src
+
+If an error occurs, a "backtrace" can be very useful---see below on
+how to create one. Often a small example file helps, along with clear
+information about:
+
+1. What exactly did you do?
+2. What did you expect to happen?
+3. What happened instead?
+
+Thank you for helping to improve this program.
+
+*** How to create a useful backtrace
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: backtrace of an error
+If working with Org produces an error with a message you do not
+understand, you may have hit a bug. The best way to report this is by
+providing, in addition to what was mentioned above, a backtrace. This
+is information from the built-in debugger about where and how the
+error occurred. Here is how to produce a useful backtrace:
+
+1. Reload uncompiled versions of all Org mode Lisp files. The
+ backtrace contains much more information if it is produced with
+ uncompiled code. To do this, use
+
+ : C-u M-x org-reload <RET>
+
+ #+texinfo: @noindent
+ or, from the menu: Org \rarr Refresh/Reload \rarr Reload Org uncompiled.
+
+2. Then, activate the debugger:
+
+ : M-x toggle-debug-on-error <RET>
+
+ #+texinfo: @noindent
+ or, from the menu: Options \rarr Enter Debugger on Error.
+
+3. Do whatever you have to do to hit the error. Do not forget to
+ document the steps you take.
+
+4. When you hit the error, a =*Backtrace*= buffer appears on the
+ screen. Save this buffer to a file---for example using {{{kbd(C-x
+ C-w)}}}---and attach it to your bug report.
+
+** Typesetting Conventions Used in this Manual
+:PROPERTIES:
+:DESCRIPTION: Typesetting conventions used in this manual.
+:ALT_TITLE: Conventions
+:END:
+
+*** TODO keywords, tags, properties, etc.
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Org uses various syntactical elements: TODO keywords, tags, property
+names, keywords, blocks, etc. In this manual we use the following
+conventions:
+
+#+attr_texinfo: :sep ,
+- =TODO=, =WAITING= ::
+
+ TODO keywords are written with all capitals, even if they are
+ user-defined.
+
+- =boss=, =ARCHIVE= ::
+
+ Tags are case-sensitive. User-defined tags are written in
+ lowercase; built-in tags with special meaning are written as they
+ should appear in the document, usually with all capitals.
+
+- =Release=, =PRIORITY= ::
+
+ User-defined properties are capitalized; built-in properties with
+ special meaning are written with all capitals.
+
+- =TITLE=, =BEGIN= ... =END= ::
+
+ Keywords and blocks are written in uppercase to enhance their
+ readability, but you can use lowercase in your Org files.
+
+*** Key bindings and commands
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+The manual lists both the keys and the corresponding commands for
+accessing a functionality. Org mode often uses the same key for
+different functions, depending on context. The command that is bound
+to such keys has a generic name, like ~org-metaright~. In the manual
+we will, wherever possible, give the function that is internally
+called by the generic command. For example, in the chapter on
+document structure, {{{kbd(M-RIGHT)}}} will be listed to call
+~org-do-demote~, while in the chapter on tables, it will be listed to
+call ~org-table-move-column-right~.
+
+* Document Structure
+:PROPERTIES:
+:DESCRIPTION: A tree works like your brain.
+:END:
+
+#+cindex: document structure
+#+cindex: structure of document
+Org is an outliner. Outlines allow a document to be organized in
+a hierarchical structure, which, least for me, is the best
+representation of notes and thoughts. An overview of this structure
+is achieved by folding, i.e., hiding large parts of the document to
+show only the general document structure and the parts currently being
+worked on. Org greatly simplifies the use of outlines by compressing
+the entire show and hide functionalities into a single command,
+~org-cycle~, which is bound to the {{{kbd(TAB)}}} key.
+
+** Headlines
+:PROPERTIES:
+:DESCRIPTION: How to typeset Org tree headlines.
+:END:
+#+cindex: headlines
+#+cindex: outline tree
+#+vindex: org-special-ctrl-a/e
+#+vindex: org-special-ctrl-k
+#+vindex: org-ctrl-k-protect-subtree
+
+Headlines define the structure of an outline tree. Org headlines
+start on the left margin[fn:3] with one or more stars followed by
+a space. For example:
+
+#+begin_example
+,* Top level headline
+,** Second level
+,*** Third level
+ some text
+,*** Third level
+ more text
+,* Another top level headline
+#+end_example
+
+#+vindex: org-footnote-section
+The name defined in ~org-footnote-section~ is reserved. Do not use it
+as a title for your own headings.
+
+Some people find the many stars too noisy and would prefer an outline
+that has whitespace followed by a single star as headline starters.
+This can be achieved using a Org Indent minor mode. See [[*A Cleaner
+Outline View]] for more information.
+
+Headlines are not numbered. However, you may want to dynamically
+number some, or all, of them. See [[*Dynamic Headline Numbering]].
+
+#+vindex: org-cycle-separator-lines
+An empty line after the end of a subtree is considered part of it and
+is hidden when the subtree is folded. However, if you leave at least
+two empty lines, one empty line remains visible after folding the
+subtree, in order to structure the collapsed view. See the variable
+~org-cycle-separator-lines~ to modify this behavior.
+
+** Visibility Cycling
+:PROPERTIES:
+:DESCRIPTION: Show and hide, much simplified.
+:END:
+#+cindex: cycling, visibility
+#+cindex: visibility cycling
+#+cindex: trees, visibility
+#+cindex: show hidden text
+#+cindex: hide text
+
+*** Global and local cycling
+:PROPERTIES:
+:DESCRIPTION: Cycling through various visibility states.
+:END:
+#+cindex: subtree visibility states
+#+cindex: subtree cycling
+#+cindex: folded, subtree visibility state
+#+cindex: children, subtree visibility state
+#+cindex: subtree, subtree visibility state
+
+Outlines make it possible to hide parts of the text in the buffer.
+Org uses just two commands, bound to {{{kbd(TAB)}}} and
+{{{kbd(S-TAB)}}} to change the visibility in the buffer.
+
+#+attr_texinfo: :sep ,
+- {{{kbd(TAB)}}} (~org-cycle~) ::
+
+ #+kindex: TAB
+ #+findex: org-cycle
+ /Subtree cycling/: Rotate current subtree among the states
+
+ #+begin_example
+ ,-> FOLDED -> CHILDREN -> SUBTREE --.
+ '-----------------------------------'
+ #+end_example
+
+ #+vindex: org-cycle-emulate-tab
+ Point must be on a headline for this to work[fn:4].
+
+- {{{kbd(S-TAB)}}} (~org-global-cycle~), {{{kbd(C-u TAB)}}} ::
+
+ #+cindex: global visibility states
+ #+cindex: global cycling
+ #+cindex: overview, global visibility state
+ #+cindex: contents, global visibility state
+ #+cindex: show all, global visibility state
+ #+kindex: C-u TAB
+ #+kindex: S-TAB
+ #+findex: org-global-cycle
+ /Global cycling/: Rotate the entire buffer among the states
+
+ #+begin_example
+ ,-> OVERVIEW -> CONTENTS -> SHOW ALL --.
+ '--------------------------------------'
+ #+end_example
+
+ When {{{kbd(S-TAB)}}} is called with a numeric prefix argument
+ {{{var(N)}}}, view contents only up to headlines of level
+ {{{var(N)}}}.
+
+ Note that inside tables (see [[*Tables]]), {{{kbd(S-TAB)}}} jumps to the
+ previous field instead.
+
+ #+vindex: org-cycle-global-at-bob
+ You can run global cycling using {{{kbd(TAB)}}} only if point is at
+ the very beginning of the buffer, but not on a headline, and
+ ~org-cycle-global-at-bob~ is set to a non-~nil~ value.
+
+- {{{kbd(C-u C-u TAB)}}} (~org-set-startup-visibility~) ::
+
+ #+cindex: startup visibility
+ #+kindex: C-u C-u TAB
+ #+findex: org-set-startup-visibility
+ Switch back to the startup visibility of the buffer (see [[*Initial
+ visibility]]).
+
+- {{{kbd(C-u C-u C-u TAB)}}} (~outline-show-all~) ::
+
+ #+cindex: show all, command
+ #+kindex: C-u C-u C-u TAB
+ #+findex: outline-show-all
+ Show all, including drawers.
+
+- {{{kbd(C-c C-r)}}} (~org-reveal~) ::
+
+ #+cindex: revealing context
+ #+kindex: C-c C-r
+ #+findex: org-reveal
+ Reveal context around point, showing the current entry, the
+ following heading and the hierarchy above. It is useful for working
+ near a location that has been exposed by a sparse tree command (see
+ [[*Sparse Trees]]) or an agenda command (see [[*Commands in the Agenda
+ Buffer]]). With a prefix argument, show, on each level, all sibling
+ headings. With a double prefix argument, also show the entire
+ subtree of the parent.
+
+- {{{kbd(C-c C-k)}}} (~outline-show-branches~) ::
+
+ #+cindex: show branches, command
+ #+kindex: C-c C-k
+ #+findex: outline-show-branches
+ Expose all the headings of the subtree, but not their bodies.
+
+- {{{kbd(C-c TAB)}}} (~outline-show-children~) ::
+
+ #+cindex: show children, command
+ #+kindex: C-c TAB
+ #+findex: outline-show-children
+ Expose all direct children of the subtree. With a numeric prefix
+ argument {{{var(N)}}}, expose all children down to level
+ {{{var(N)}}}.
+
+- {{{kbd(C-c C-x b)}}} (~org-tree-to-indirect-buffer~) ::
+
+ #+kindex: C-c C-x b
+ #+findex: org-tree-to-indirect-buffer
+ Show the current subtree in an indirect buffer[fn:5]. With
+ a numeric prefix argument {{{var(N)}}}, go up to level {{{var(N)}}}
+ and then take that tree. If {{{var(N)}}} is negative then go up
+ that many levels. With a {{{kbd(C-u)}}} prefix, do not remove the
+ previously used indirect buffer.
+
+- {{{kbd(C-c C-x v)}}} (~org-copy-visible~) ::
+
+ #+kindex: C-c C-x v
+ #+findex: org-copy-visible
+ Copy the /visible/ text in the region into the kill ring.
+
+*** Initial visibility
+:PROPERTIES:
+:DESCRIPTION: Setting the initial visibility state.
+:END:
+
+#+vindex: org-startup-folded
+When Emacs first visits an Org file, the global state is set to
+~showeverything~, i.e., all file content is visible[fn:6]. This can
+be configured through the variable ~org-startup-folded~, or on
+a per-file basis by adding one of the following lines anywhere in the
+buffer:
+
+#+cindex: @samp{STARTUP}, keyword
+#+begin_example
+,#+STARTUP: overview
+,#+STARTUP: content
+,#+STARTUP: showall
+,#+STARTUP: showeverything
+#+end_example
+
+#+cindex: @samp{VISIBILITY}, property
+Furthermore, any entries with a =VISIBILITY= property (see [[*Properties
+and Columns]]) get their visibility adapted accordingly. Allowed values
+for this property are =folded=, =children=, =content=, and =all=.
+
+- {{{kbd(C-u C-u TAB)}}} (~org-set-startup-visibility~) ::
+
+ #+kindex: C-u C-u TAB
+ #+findex: org-set-startup-visibility
+ Switch back to the startup visibility of the buffer, i.e., whatever
+ is requested by startup options and =VISIBILITY= properties in
+ individual entries.
+
+*** Catching invisible edits
+:PROPERTIES:
+:DESCRIPTION: Preventing mistakes when editing invisible parts.
+:END:
+#+cindex: edits, catching invisible
+
+#+vindex: org-catch-invisible-edits
+Sometimes you may inadvertently edit an invisible part of the buffer
+and be confused on what has been edited and how to undo the mistake.
+Setting ~org-catch-invisible-edits~ to non-~nil~ helps preventing
+this. See the docstring of this option on how Org should catch
+invisible edits and process them.
+
+** Motion
+:PROPERTIES:
+:DESCRIPTION: Jumping to other headlines.
+:END:
+#+cindex: motion, between headlines
+#+cindex: jumping, to headlines
+#+cindex: headline navigation
+
+The following commands jump to other headlines in the buffer.
+
+- {{{kbd(C-c C-n)}}} (~org-next-visible-heading~) ::
+
+ #+kindex: C-c C-n
+ #+findex: org-next-visible-heading
+ Next heading.
+
+- {{{kbd(C-c C-p)}}} (~org-previous-visible-heading~) ::
+
+ #+kindex: C-c C-p
+ #+findex: org-previous-visible-heading
+ Previous heading.
+
+- {{{kbd(C-c C-f)}}} (~org-forward-heading-same-level~) ::
+
+ #+kindex: C-c C-f
+ #+findex: org-forward-heading-same-level
+ Next heading same level.
+
+- {{{kbd(C-c C-b)}}} (~org-backward-heading-same-level~) ::
+
+ #+kindex: C-c C-b
+ #+findex: org-backward-heading-same-level
+ Previous heading same level.
+
+- {{{kbd(C-c C-u)}}} (~outline-up-heading~) ::
+
+ #+kindex: C-c C-u
+ #+findex: outline-up-heading
+ Backward to higher level heading.
+
+- {{{kbd(C-c C-j)}}} (~org-goto~) ::
+
+ #+kindex: C-c C-j
+ #+findex: org-goto
+ #+vindex: org-goto-auto-isearch
+ Jump to a different place without changing the current outline
+ visibility. Shows the document structure in a temporary buffer,
+ where you can use the following keys to find your destination:
+
+ #+attr_texinfo: :columns 0.3 0.7
+ | {{{kbd(TAB)}}} | Cycle visibility. |
+ | {{{kbd(DOWN)}}} / {{{kbd(UP)}}} | Next/previous visible headline. |
+ | {{{kbd(RET)}}} | Select this location. |
+ | {{{kbd(/)}}} | Do a Sparse-tree search |
+
+ #+texinfo: @noindent
+ The following keys work if you turn off ~org-goto-auto-isearch~
+
+ #+attr_texinfo: :columns 0.3 0.7
+ | {{{kbd(n)}}} / {{{kbd(p)}}} | Next/previous visible headline. |
+ | {{{kbd(f)}}} / {{{kbd(b)}}} | Next/previous headline same level. |
+ | {{{kbd(u)}}} | One level up. |
+ | {{{kbd(0)}}} ... {{{kbd(9)}}} | Digit argument. |
+ | {{{kbd(q)}}} | Quit. |
+
+ #+vindex: org-goto-interface
+ #+texinfo: @noindent
+ See also the variable ~org-goto-interface~.
+
+** Structure Editing
+:PROPERTIES:
+:DESCRIPTION: Changing sequence and level of headlines.
+:END:
+#+cindex: structure editing
+#+cindex: headline, promotion and demotion
+#+cindex: promotion, of subtrees
+#+cindex: demotion, of subtrees
+#+cindex: subtree, cut and paste
+#+cindex: pasting, of subtrees
+#+cindex: cutting, of subtrees
+#+cindex: copying, of subtrees
+#+cindex: sorting, of subtrees
+#+cindex: subtrees, cut and paste
+
+#+attr_texinfo: :sep ,
+- {{{kbd(M-RET)}}} (~org-meta-return~) ::
+
+ #+kindex: M-RET
+ #+findex: org-meta-return
+ #+vindex: org-M-RET-may-split-line
+ Insert a new heading, item or row.
+
+ If the command is used at the /beginning/ of a line, and if there is
+ a heading or a plain list item (see [[*Plain Lists]]) at point, the new
+ heading/item is created /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
+ ~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.
+
+- {{{kbd(C-RET)}}} (~org-insert-heading-respect-content~) ::
+
+ #+kindex: C-RET
+ #+findex: org-insert-heading-respect-content
+ Insert a new heading at the end of the current subtree.
+
+- {{{kbd(M-S-RET)}}} (~org-insert-todo-heading~) ::
+
+ #+kindex: M-S-RET
+ #+findex: 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 variable ~org-treat-insert-todo-heading-as-state-change~.
+
+- {{{kbd(C-S-RET)}}} (~org-insert-todo-heading-respect-content~) ::
+
+ #+kindex: C-S-RET
+ #+findex: org-insert-todo-heading-respect-content
+ Insert new TODO entry with same level as current heading. Like
+ {{{kbd(C-RET)}}}, the new headline is inserted after the current
+ subtree.
+
+- {{{kbd(TAB)}}} (~org-cycle~) ::
+
+ #+kindex: TAB
+ #+findex: org-cycle
+ In a new entry with no text yet, the first {{{kbd(TAB)}}} demotes
+ the entry to become a child of the previous one. The next
+ {{{kbd(TAB)}}} makes it a parent, and so on, all the way to top
+ level. Yet another {{{kbd(TAB)}}}, and you are back to the initial
+ level.
+
+- {{{kbd(M-LEFT)}}} (~org-do-promote~), {{{kbd(M-RIGHT)}}} (~org-do-demote~) ::
+
+ #+kindex: M-LEFT
+ #+findex: org-do-promote
+ #+kindex: M-RIGHT
+ #+findex: org-do-demote
+ Promote or demote current heading by one level.
+
+ #+cindex: region, active
+ #+cindex: active region
+ #+cindex: transient mark mode
+ When there is an active region---i.e., when Transient Mark mode is
+ active---promotion and demotion work on all headlines in the region.
+ To select a region of headlines, it is best to place both point and
+ mark at the beginning of a line, mark at the beginning of the first
+ headline, and point at the line just after the last headline to
+ change.
+
+- {{{kbd(M-S-LEFT)}}} (~org-promote-subtree~) ::
+
+ #+kindex: M-S-LEFT
+ #+findex: org-promote-subtree
+ Promote the current subtree by one level.
+
+- {{{kbd(M-S-RIGHT)}}} (~org-demote-subtree~) ::
+
+ #+kindex: M-S-RIGHT
+ #+findex: org-demote-subtree
+ Demote the current subtree by one level.
+
+- {{{kbd(M-UP)}}} (~org-move-subtree-up~) ::
+
+ #+kindex: M-UP
+ #+findex: org-move-subtree-up
+ Move subtree up, i.e., swap with previous subtree of same level.
+
+- {{{kbd(M-DOWN)}}} (~org-move-subtree-down~) ::
+
+ #+kindex: M-DOWN
+ #+findex: org-move-subtree-down
+ Move subtree down, i.e., swap with next subtree of same level.
+
+- {{{kbd(C-c @)}}} (~org-mark-subtree~) ::
+
+ #+kindex: C-c @@
+ #+findex: org-mark-subtree
+ Mark the subtree at point. Hitting repeatedly marks subsequent
+ subtrees of the same level as the marked subtree.
+
+- {{{kbd(C-c C-x C-w)}}} (~org-cut-subtree~) ::
+
+ #+kindex: C-c C-x C-w
+ #+findex: org-cut-subtree
+ Kill subtree, i.e., remove it from buffer but save in kill ring.
+ With a numeric prefix argument N, kill N sequential subtrees.
+
+- {{{kbd(C-c C-x M-w)}}} (~org-copy-subtree~) ::
+
+ #+kindex: C-c C-x M-w
+ #+findex: org-copy-subtree
+ Copy subtree to kill ring. With a numeric prefix argument N, copy
+ the N sequential subtrees.
+
+- {{{kbd(C-c C-x C-y)}}} (~org-paste-subtree~) ::
+
+ #+kindex: C-c C-x C-y
+ #+findex: org-paste-subtree
+ Yank subtree from kill ring. This does modify the level of the
+ subtree to make sure the tree fits in nicely at the yank position.
+ The yank level can also be specified with a numeric prefix argument,
+ or by yanking after a headline marker like =****=.
+
+- {{{kbd(C-y)}}} (~org-yank~) ::
+
+ #+kindex: C-y
+ #+findex: org-yank
+ #+vindex: org-yank-adjusted-subtrees
+ #+vindex: org-yank-folded-subtrees
+ Depending on the variables ~org-yank-adjusted-subtrees~ and
+ ~org-yank-folded-subtrees~, Org's internal ~yank~ command pastes
+ subtrees folded and in a clever way, using the same command as
+ {{{kbd(C-c C-x C-y)}}}. With the default settings, no level
+ adjustment takes place, but the yanked tree is folded unless doing
+ so would swallow text previously visible. Any prefix argument to
+ this command forces a normal ~yank~ to be executed, with the prefix
+ passed along. A good way to force a normal yank is {{{kbd(C-u
+ C-y)}}}. If you use ~yank-pop~ after a yank, it yanks previous kill
+ items plainly, without adjustment and folding.
+
+- {{{kbd(C-c C-x c)}}} (~org-clone-subtree-with-time-shift~) ::
+
+ #+kindex: C-c C-x c
+ #+findex: org-clone-subtree-with-time-shift
+ Clone a subtree by making a number of sibling copies of it. You are
+ prompted for the number of copies to make, and you can also specify
+ if any timestamps in the entry should be shifted. This can be
+ useful, for example, to create a number of tasks related to a series
+ of lectures to prepare. For more details, see the docstring of the
+ command ~org-clone-subtree-with-time-shift~.
+
+- {{{kbd(C-c C-w)}}} (~org-refile~) ::
+
+ #+kindex: C-c C-w
+ #+findex: org-refile
+ Refile entry or region to a different location. See [[*Refile and
+ Copy]].
+
+- {{{kbd(C-c ^)}}} (~org-sort~) ::
+
+ #+kindex: C-c ^
+ #+findex: org-sort
+ Sort same-level entries. When there is an active region, all
+ entries in the region are sorted. Otherwise the children of the
+ current headline are sorted. The command prompts for the sorting
+ method, which can be alphabetically, numerically, by time---first
+ timestamp with active preferred, creation time, scheduled time,
+ deadline time---by priority, by TODO keyword---in the sequence the
+ keywords have been defined in the setup---or by the value of
+ a property. Reverse sorting is possible as well. You can also
+ supply your own function to extract the sorting key. With
+ a {{{kbd(C-u)}}} prefix, sorting is case-sensitive.
+
+- {{{kbd(C-x n s)}}} (~org-narrow-to-subtree~) ::
+
+ #+kindex: C-x n s
+ #+findex: org-narrow-to-subtree
+ Narrow buffer to current subtree.
+
+- {{{kbd(C-x n b)}}} (~org-narrow-to-block~) ::
+
+ #+kindex: C-x n b
+ #+findex: org-narrow-to-block
+ Narrow buffer to current block.
+
+- {{{kbd(C-x n w)}}} (~widen~) ::
+
+ #+kindex: C-x n w
+ #+findex: widen
+ Widen buffer to remove narrowing.
+
+- {{{kbd(C-c *)}}} (~org-toggle-heading~) ::
+
+ #+kindex: C-c *
+ #+findex: org-toggle-heading
+ Turn a normal line or plain list item into a headline---so that it
+ becomes a subheading at its location. Also turn a headline into
+ a normal line by removing the stars. If there is an active region,
+ turn all lines in the region into headlines. If the first line in
+ the region was an item, turn only the item lines into headlines.
+ Finally, if the first line is a headline, remove the stars from all
+ headlines in the region.
+
+Note that when point is inside a table (see [[*Tables]]), the Meta-Cursor
+keys have different functionality.
+
+** Sparse Trees
+:PROPERTIES:
+:DESCRIPTION: Matches embedded in context.
+:END:
+#+cindex: sparse trees
+#+cindex: trees, sparse
+#+cindex: folding, sparse trees
+#+cindex: occur, command
+
+#+vindex: org-show-context-detail
+An important feature of Org mode is the ability to construct /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[fn:7].
+Just try it out and you will see immediately how it works.
+
+Org mode contains several commands creating such trees, all these
+commands can be accessed through a dispatcher:
+
+- {{{kbd(C-c /)}}} (~org-sparse-tree~) ::
+
+ #+kindex: C-c /
+ #+findex: org-sparse-tree
+ This prompts for an extra key to select a sparse-tree creating
+ command.
+
+- {{{kbd(C-c / r)}}} or {{{kbd(C-c / /)}}} (~org-occur~) ::
+
+ #+kindex: C-c / r
+ #+kindex: C-c / /
+ #+findex: 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 the body of an entry, headline and body are made
+ visible. In order to provide minimal context, also the full
+ hierarchy of headlines above the match is shown, as well as the
+ headline following the match. Each match is also highlighted; the
+ highlights disappear when the buffer is changed by an editing
+ command, or by pressing {{{kbd(C-c C-c)}}}[fn:8]. When called with
+ a {{{kbd(C-u)}}} prefix argument, previous highlights are kept, so
+ several calls to this command can be stacked.
+
+- {{{kbd(M-g n)}}} or {{{kbd(M-g M-n)}}} (~next-error~) ::
+
+ #+kindex: M-g n
+ #+kindex: M-g M-n
+ #+findex: next-error
+ Jump to the next sparse tree match in this buffer.
+
+- {{{kbd(M-g p)}}} or {{{kbd(M-g M-p)}}} (~previous-error~) ::
+
+ #+kindex: M-g p
+ #+kindex: M-g M-p
+ #+findex: previous-error
+ Jump to the previous sparse tree match in this buffer.
+
+#+vindex: org-agenda-custom-commands
+For frequently used sparse trees of specific search strings, you can
+use the variable ~org-agenda-custom-commands~ to define fast keyboard
+access to specific sparse trees. These commands will then be
+accessible through the agenda dispatcher (see [[*The Agenda Dispatcher]]).
+For example:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("f" occur-tree "FIXME")))
+#+end_src
+
+#+texinfo: @noindent
+defines the key {{{kbd(f)}}} as a shortcut for creating a sparse tree
+matching the string =FIXME=.
+
+The other sparse tree commands select headings based on TODO keywords,
+tags, or properties and are discussed later in this manual.
+
+#+kindex: C-c C-e C-v
+#+cindex: printing sparse trees
+#+cindex: visible text, printing
+To print a sparse tree, you can use the Emacs command
+~ps-print-buffer-with-faces~ which does not print invisible parts of
+the document. Or you can use the command {{{kbd(C-c C-e C-v)}}} to
+export only the visible part of the document and print the resulting
+file.
+
+** Plain Lists
+:PROPERTIES:
+:DESCRIPTION: Additional structure within an entry.
+:END:
+#+cindex: plain lists
+#+cindex: lists, plain
+#+cindex: lists, ordered
+#+cindex: ordered lists
+
+Within an entry of the outline tree, hand-formatted lists can provide
+additional structure. They also provide a way to create lists of
+checkboxes (see [[*Checkboxes]]). Org supports editing such lists, and
+every exporter (see [[*Exporting]]) can parse and format them.
+
+Org knows ordered lists, unordered lists, and description lists.
+
+#+attr_texinfo: :indic @bullet
+- /Unordered/ list items start with =-=, =+=, or =*=[fn:9] as bullets.
+
+-
+ #+vindex: org-plain-list-ordered-item-terminator
+ #+vindex: org-alphabetical-lists
+ /Ordered/ list items start with a numeral followed by either
+ a period or a right parenthesis[fn:10], such as =1.= or =1)=[fn:11]
+ If you want a list to start with a different value---e.g.,
+ 20---start the text of the item with =[@20]=[fn:12]. Those
+ constructs can be used in any item of the list in order to enforce
+ a particular numbering.
+
+- /Description/ list items are unordered list items, and contain the
+ separator =::= to distinguish the description /term/ from the
+ description.
+
+Items belonging to the same list must have the same indentation on the
+first line. In particular, if an ordered list reaches number =10.=,
+then the 2-digit numbers must be written left-aligned with the other
+numbers in the list. An item ends before the next line that is less
+or equally indented than its bullet/number.
+
+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. In that case, all items are closed. Here is an
+example:
+
+#+begin_example
+,* Lord of the Rings
+My favorite scenes are (in this order)
+1. The attack of the Rohirrim
+2. Eowyn's fight with the witch king
+ + this was already my favorite scene in the book
+ + I really like Miranda Otto.
+3. Peter Jackson being shot by Legolas
+ - on DVD only
+ He makes a really funny face when it happens.
+But in the end, no individual scenes matter but the film as a whole.
+Important actors in this film are:
+- Elijah Wood :: He plays Frodo
+- Sean Astin :: He plays Sam, Frodo's friend. I still remember him
+ very well from his role as Mikey Walsh in /The Goonies/.
+#+end_example
+
+Org supports these lists by tuning filling and wrapping commands to
+deal with them correctly, and by exporting them properly (see
+[[*Exporting]]). Since indentation is what governs the structure of these
+lists, many structural constructs like =#+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 ~org-list-demote-modify-bullet~. To get a greater difference
+of indentation between items and theirs sub-items, customize
+~org-list-indent-offset~.
+
+#+vindex: org-list-automatic-rules
+The following commands act on items when point is in the first line of
+an item---the line with the bullet or number. Some of them imply the
+application of automatic rules to keep list structure intact. If some
+of these actions get in your way, configure ~org-list-automatic-rules~
+to disable them individually.
+
+#+attr_texinfo: :sep ,
+- {{{kbd(TAB)}}} (~org-cycle~) ::
+
+ #+cindex: cycling, in plain lists
+ #+kindex: TAB
+ #+findex: org-cycle
+ #+vindex: org-cycle-include-plain-lists
+ Items can be folded just like headline levels. Normally this works
+ only if point is on a plain list item. For more details, see the
+ variable ~org-cycle-include-plain-lists~. If this variable is set
+ to ~integrate~, plain list items are treated like low-level
+ headlines. The level of an item is then given by the indentation of
+ the bullet/number. Items are always subordinate to real headlines,
+ however; the hierarchies remain completely separated. In a new item
+ with no text yet, the first {{{kbd(TAB)}}} demotes the item to
+ become a child of the previous one. Subsequent {{{kbd(TAB)}}}s move
+ the item to meaningful levels in the list and eventually get it back
+ to its initial position.
+
+- {{{kbd(M-RET)}}} (~org-insert-heading~) ::
+
+ #+kindex: M-RET
+ #+findex: org-insert-heading
+ #+vindex: org-M-RET-may-split-line
+ Insert new item at current level. With a prefix argument, force
+ a new heading (see [[*Structure Editing]]). If this command is used in
+ the middle of an item, that item is /split/ in two, and the second
+ part becomes the new item[fn:13]. If this command is executed
+ /before item's body/, the new item is created /before/ the current
+ one.
+
+- {{{kbd(M-S-RET)}}} ::
+
+ #+kindex: M-S-RET
+ Insert a new item with a checkbox (see [[*Checkboxes]]).
+
+- {{{kbd(S-UP)}}}, {{{kbd(S-DOWN)}}} ::
+
+ #+kindex: S-UP
+ #+kindex: S-DOWN
+ #+cindex: shift-selection-mode
+ #+vindex: org-support-shift-select
+ #+vindex: org-list-use-circular-motion
+ Jump to the previous/next item in the current list, but only if
+ ~org-support-shift-select~ is off[fn:14]. If not, you can still use
+ paragraph jumping commands like {{{kbd(C-UP)}}} and
+ {{{kbd(C-DOWN)}}} to quite similar effect.
+
+- {{{kbd(M-UP)}}}, {{{kbd(M-DOWN)}}} ::
+
+ #+kindex: M-UP
+ #+kindex: M-DOWN
+ Move the item including subitems up/down[fn:15], i.e., swap with
+ previous/next item of same indentation. If the list is ordered,
+ renumbering is automatic.
+
+- {{{kbd(M-LEFT)}}}, {{{kbd(M-RIGHT)}}} ::
+
+ #+kindex: M-LEFT
+ #+kindex: M-RIGHT
+ Decrease/increase the indentation of an item, leaving children
+ alone.
+
+- {{{kbd(M-S-LEFT)}}}, {{{kbd(M-S-RIGHT)}}} ::
+
+ #+kindex: M-S-LEFT
+ #+kindex: M-S-RIGHT
+ Decrease/increase the indentation of the item, including subitems.
+ Initially, the item tree is selected based on current indentation.
+ When these commands are executed several times in direct succession,
+ the initially selected region is used, even if the new indentation
+ would imply a different hierarchy. To use the new hierarchy, break
+ the command chain by moving point.
+
+ As a special case, using this command on the very first item of
+ a list moves the whole list. This behavior can be disabled by
+ configuring ~org-list-automatic-rules~. The global indentation of
+ a list has no influence on the text /after/ the list.
+
+- {{{kbd(C-c C-c)}}} ::
+
+ #+kindex: C-c C-c
+ If there is a checkbox (see [[*Checkboxes]]) in the item line, toggle
+ the state of the checkbox. In any case, verify bullets and
+ indentation consistency in the whole list.
+
+- {{{kbd(C-c -)}}} ::
+
+ #+kindex: C-c -
+ #+vindex: org-plain-list-ordered-item-terminator
+ Cycle the entire list level through the different itemize/enumerate
+ bullets (=-=, =+=, =*=, =1.=, =1)=) or a subset of them, depending
+ on ~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, all lines are converted to list items. With a prefix
+ argument, the selected text is changed into a single item. If the
+ first line already was a list item, any item marker is removed from
+ the list. Finally, even without an active region, a normal line is
+ converted into a list item.
+
+- {{{kbd(C-c *)}}} ::
+
+ #+kindex: C-c *
+ Turn a plain list item into a headline---so that it becomes
+ a subheading at its location. See [[*Structure Editing]], for
+ a detailed explanation.
+
+- {{{kbd(C-c C-*)}}} ::
+
+ #+kindex: C-c C-*
+ Turn the whole plain list into a subtree of the current heading.
+ Checkboxes (see [[*Checkboxes]]) become =TODO=, respectively =DONE=,
+ keywords when unchecked, respectively checked.
+
+- {{{kbd(S-LEFT)}}}, {{{kbd(S-RIGHT)}}} ::
+
+ #+vindex: org-support-shift-select
+ #+kindex: S-LEFT
+ #+kindex: S-RIGHT
+ This command also cycles bullet styles when point is in on the
+ bullet or anywhere in an item line, details depending on
+ ~org-support-shift-select~.
+
+- {{{kbd(C-c ^)}}} ::
+
+ #+kindex: C-c ^
+ #+cindex: sorting, of plain list
+ Sort the plain list. Prompt for the sorting method: numerically,
+ alphabetically, by time, or by custom function.
+
+** Drawers
+:PROPERTIES:
+:DESCRIPTION: Tucking stuff away.
+:END:
+#+cindex: drawers
+#+cindex: visibility cycling, drawers
+
+Sometimes you want to keep information associated with an entry, but
+you normally do not want to see it. For this, Org mode has /drawers/.
+They can contain anything but a headline and another drawer. Drawers
+look like this:
+
+#+begin_example
+,** This is a headline
+Still outside the drawer
+:DRAWERNAME:
+This is inside the drawer.
+:END:
+After the drawer.
+#+end_example
+
+#+kindex: C-c C-x d
+#+findex: org-insert-drawer
+You can interactively insert a drawer at point by calling
+~org-insert-drawer~, which is bound to {{{kbd(C-c C-x d)}}}. With an
+active region, this command puts the region inside the drawer. With
+a prefix argument, this command calls ~org-insert-property-drawer~,
+which creates a =PROPERTIES= drawer right below the current headline.
+Org mode uses this special drawer for storing properties (see
+[[*Properties and Columns]]). You cannot use it for anything else.
+
+Completion over drawer keywords is also possible using
+{{{kbd(M-TAB)}}}[fn:16].
+
+Visibility cycling (see [[*Visibility Cycling]]) on the headline hides and
+shows the entry, but keep the drawer collapsed to a single line. In
+order to look inside the drawer, you need to move point to the drawer
+line and press {{{kbd(TAB)}}} there.
+
+You can also arrange for state change notes (see [[Tracking TODO state
+changes]]) and clock times (see [[*Clocking Work Time]]) to be stored in
+a =LOGBOOK= drawer. If you want to store a quick note there, in
+a similar way to state changes, use
+
+- {{{kbd(C-c C-z)}}} ::
+
+ #+kindex: C-c C-z
+ Add a time-stamped note to the =LOGBOOK= drawer.
+
+** Blocks
+:PROPERTIES:
+:DESCRIPTION: Folding blocks.
+:END:
+#+vindex: org-hide-block-startup
+#+cindex: blocks, folding
+
+Org mode uses =#+BEGIN= ... =#+END= blocks for various purposes from
+including source code examples (see [[*Literal Examples]]) to capturing
+time logging information (see [[*Clocking Work Time]]). These blocks can
+be folded and unfolded by pressing {{{kbd(TAB)}}} in the =#+BEGIN=
+line. You can also get all blocks folded at startup by configuring
+the variable ~org-hide-block-startup~ or on a per-file basis by using
+
+#+cindex: STARTUP, keyword
+#+begin_example
+,#+STARTUP: hideblocks
+,#+STARTUP: nohideblocks
+#+end_example
+
+* Tables
+:PROPERTIES:
+:DESCRIPTION: Pure magic for quick formatting.
+:END:
+#+cindex: tables
+#+cindex: editing tables
+
+Org comes with a fast and intuitive table editor. Spreadsheet-like
+calculations are supported using the Emacs Calc package (see [[info:calc][GNU Emacs
+Calculator Manual]]).
+
+** Built-in Table Editor
+:PROPERTIES:
+:DESCRIPTION: Simple tables.
+:END:
+#+cindex: table editor, built-in
+
+#+cindex: header lines, in tables
+#+cindex: horizontal rule, in tables
+#+cindex: row separator, in tables
+#+cindex: table syntax
+Org makes it easy to format tables in plain ASCII. Any line with =|=
+as the first non-whitespace character is considered part of a table.
+=|= is also the column separator[fn:17]. Moreover, a line starting
+with =|-= is a horizontal rule. It separates rows explicitly. Rows
+before the first horizontal rule are header lines. A table might look
+like this:
+
+#+begin_example
+| Name | Phone | Age |
+|-------+-------+-----|
+| Peter | 1234 | 17 |
+| Anna | 4321 | 25 |
+#+end_example
+
+A table is re-aligned automatically each time you press
+{{{kbd(TAB)}}}, {{{kbd(RET)}}} or {{{kbd(C-c C-c)}}} inside the table.
+{{{kbd(TAB)}}} also moves to the next field---{{{kbd(RET)}}} to the
+next row---and creates new table rows at the end of the table or
+before horizontal lines. The indentation of the table is set by the
+first line. Horizontal rules are automatically expanded on every
+re-align to span the whole table width. So, to create the above
+table, you would only type
+
+#+begin_example
+|Name|Phone|Age|
+|-
+#+end_example
+
+#+texinfo: @noindent
+and then press {{{kbd(TAB)}}} to align the table and start filling in
+fields. Even faster would be to type =|Name|Phone|Age= followed by
+{{{kbd(C-c RET)}}}.
+
+When typing text into a field, Org treats {{{kbd(DEL)}}},
+{{{kbd(Backspace)}}}, and all character keys in a special way, so that
+inserting and deleting avoids shifting other fields. Also, when
+typing /immediately/ after point was moved into a new field with
+{{{kbd(TAB)}}}, {{{kbd(S-TAB)}}} or {{{kbd(RET)}}}, the field is
+automatically made blank. If this behavior is too unpredictable for
+you, configure the option ~org-table-auto-blank-field~.
+
+*** Creation and conversion
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c |)}}} (~org-table-create-or-convert-from-region~) ::
+
+ #+kindex: C-c |
+ #+findex: org-table-create-or-convert-from-region
+ Convert the active region to table. If every line contains at least
+ one {{{kbd(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
+ {{{kbd(TAB)}}}, {{{kbd(C-u C-u C-u)}}} prompts for a regular
+ expression to match the separator, and a numeric argument
+ N indicates that at least N consecutive spaces, or alternatively
+ a {{{kbd(TAB)}}} will be the separator.
+
+ If there is no active region, this command creates an empty Org
+ table. But it is easier just to start typing, like {{{kbd(|
+ N a m e | P h o n e | A g e RET | - TAB)}}}.
+
+*** Re-aligning and field motion
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c C-c)}}} (~org-table-align~) ::
+
+ #+kindex: C-c C-c
+ #+findex: org-table-align
+ Re-align the table without moving point.
+
+- {{{kbd(TAB)}}} (~org-table-next-field~) ::
+
+ #+kindex: TAB
+ #+findex: org-table-next-field
+ Re-align the table, move to the next field. Creates a new row if
+ necessary.
+
+- {{{kbd(C-c SPC)}}} (~org-table-blank-field~) ::
+
+ #+kindex: C-c SPC
+ #+findex: org-table-blank-field
+ Blank the field at point.
+
+- {{{kbd(S-TAB)}}} (~org-table-previous-field~) ::
+
+ #+kindex: S-TAB
+ #+findex: org-table-previous-field
+ Re-align, move to previous field.
+
+- {{{kbd(RET)}}} (~org-table-next-row~) ::
+
+ #+kindex: RET
+ #+findex: org-table-next-row
+ Re-align the table and move down to next row. Creates a new row if
+ necessary. At the beginning or end of a line, {{{kbd(RET)}}} still
+ inserts a new line, so it can be used to split a table.
+
+- {{{kbd(M-a)}}} (~org-table-beginning-of-field~) ::
+
+ #+kindex: M-a
+ #+findex: org-table-beginning-of-field
+ Move to beginning of the current table field, or on to the previous
+ field.
+
+- {{{kbd(M-e)}}} (~org-table-end-of-field~) ::
+
+ #+kindex: M-e
+ #+findex: org-table-end-of-field
+ Move to end of the current table field, or on to the next field.
+
+*** Column and row editing
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(M-LEFT)}}} (~org-table-move-column-left~) ::
+
+ #+kindex: M-LEFT
+ #+findex: org-table-move-column-left
+ Move the current column left.
+
+- {{{kbd(M-RIGHT)}}} (~org-table-move-column-right~) ::
+
+ #+kindex: M-RIGHT
+ #+findex: org-table-move-column-right
+ Move the current column right.
+
+- {{{kbd(M-S-LEFT)}}} (~org-table-delete-column~) ::
+
+ #+kindex: M-S-LEFT
+ #+findex: org-table-delete-column
+ Kill the current column.
+
+- {{{kbd(M-S-RIGHT)}}} (~org-table-insert-column~) ::
+
+ #+kindex: M-S-RIGHT
+ #+findex: org-table-insert-column
+ Insert a new column at point position. Move the recent column and
+ all cells to the right of this column to the right.
+
+- {{{kbd(M-UP)}}} (~org-table-move-row-up~) ::
+
+ #+kindex: M-UP
+ #+findex: org-table-move-row-up
+ Move the current row up.
+
+- {{{kbd(M-DOWN)}}} (~org-table-move-row-down~) ::
+
+ #+kindex: M-DOWN
+ #+findex: org-table-move-row-down
+ Move the current row down.
+
+- {{{kbd(M-S-UP)}}} (~org-table-kill-row~) ::
+
+ #+kindex: M-S-UP
+ #+findex: org-table-kill-row
+ Kill the current row or horizontal line.
+
+- {{{kbd(S-UP)}}} (~org-table-move-cell-up~) ::
+
+ #+kindex: S-UP
+ #+findex: org-table-move-cell-up
+ Move cell up by swapping with adjacent cell.
+
+- {{{kbd(S-DOWN)}}} (~org-table-move-cell-down~) ::
+
+ #+kindex: S-DOWN
+ #+findex: org-table-move-cell-down
+ Move cell down by swapping with adjacent cell.
+
+- {{{kbd(S-LEFT)}}} (~org-table-move-cell-left~) ::
+
+ #+kindex: S-LEFT
+ #+findex: org-table-move-cell-left
+ Move cell left by swapping with adjacent cell.
+
+- {{{kbd(S-RIGHT)}}} (~org-table-move-cell-right~) ::
+
+ #+kindex: S-RIGHT
+ #+findex: org-table-move-cell-right
+ Move cell right by swapping with adjacent cell.
+
+- {{{kbd(M-S-DOWN)}}} (~org-table-insert-row~) ::
+
+ #+kindex: M-S-DOWN
+ #+findex: org-table-insert-row
+ Insert a new row above the current row. With a prefix argument, the
+ line is created below the current one.
+
+- {{{kbd(C-c -)}}} (~org-table-insert-hline~) ::
+
+ #+kindex: C-c -
+ #+findex: org-table-insert-hline
+ Insert a horizontal line below current row. With a prefix argument,
+ the line is created above the current line.
+
+- {{{kbd(C-c RET)}}} (~org-table-hline-and-move~) ::
+
+ #+kindex: C-c RET
+ #+findex: org-table-hline-and-move
+ Insert a horizontal line below current row, and move point into the
+ row below that line.
+
+- {{{kbd(C-c ^)}}} (~org-table-sort-lines~) ::
+
+ #+kindex: C-c ^
+ #+findex: org-table-sort-lines
+ Sort the table lines in the region. The position of point indicates
+ the column to be used for sorting, and the range of lines is the
+ range between the nearest horizontal separator lines, or the entire
+ table. If point is before the first column, you are 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. 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 is case-sensitive.
+
+*** Regions
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c C-x M-w)}}} (~org-table-copy-region~) ::
+
+ #+kindex: C-c C-x M-w
+ #+findex: org-table-copy-region
+ Copy a rectangular region from a table to a special clipboard.
+ Point and mark determine edge fields of the rectangle. If there is
+ no active region, copy just the current field. The process ignores
+ horizontal separator lines.
+
+- {{{kbd(C-c C-x C-w)}}} (~org-table-cut-region~) ::
+
+ #+kindex: C-c C-x C-w
+ #+findex: org-table-cut-region
+ Copy a rectangular region from a table to a special clipboard, and
+ blank all fields in the rectangle. So this is the "cut" operation.
+
+- {{{kbd(C-c C-x C-y)}}} (~org-table-paste-rectangle~) ::
+
+ #+kindex: C-c C-x C-y
+ #+findex: org-table-paste-rectangle
+ Paste a rectangular region into a table. The upper left corner ends
+ up in the current field. All involved fields are overwritten. If
+ the rectangle does not fit into the present table, the table is
+ enlarged as needed. The process ignores horizontal separator lines.
+
+- {{{kbd(M-RET)}}} (~org-table-wrap-region~) ::
+
+ #+kindex: M-RET
+ #+findex: org-table-wrap-region
+ Split the current field at point position and move the rest to the
+ line below. 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. A numeric prefix argument may
+ be used to change the number of desired lines. If there is no
+ region, but you specify a prefix argument, the current field is made
+ blank, and the content is appended to the field above.
+
+*** Calculations
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: formula, in tables
+#+cindex: calculations, in tables
+
+- {{{kbd(C-c +)}}} (~org-table-sum~) ::
+
+ #+kindex: C-c +
+ #+findex: org-table-sum
+ Sum the numbers in the current column, or in the rectangle defined
+ by the active region. The result is shown in the echo area and can
+ be inserted with {{{kbd(C-y)}}}.
+
+- {{{kbd(S-RET)}}} (~org-table-copy-down~) ::
+
+ #+kindex: S-RET
+ #+findex: org-table-copy-down
+ #+vindex: org-table-copy-increment
+ When current field is empty, copy from first non-empty field above.
+ When not empty, copy current field down to next row and move point
+ along with it.
+
+ Depending on the variable ~org-table-copy-increment~, integer and
+ time stamp field values, and fields prefixed or suffixed with
+ a whole number, can be incremented during copy. Also, a ~0~ prefix
+ argument temporarily disables the increment.
+
+ This key is also used by shift-selection and related modes (see
+ [[*Packages that conflict with Org mode]]).
+
+*** Miscellaneous
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c `)}}} (~org-table-edit-field~) ::
+
+ #+kindex: C-c `
+ #+findex: org-table-edit-field
+ Edit the current field in a separate window. This is useful for
+ fields that are not fully visible (see [[*Column Width and Alignment]]).
+ When called with a {{{kbd(C-u)}}} prefix, just make the full field
+ visible, so that it can be edited in place. When called with two
+ {{{kbd(C-u)}}} prefixes, make the editor window follow point through
+ the table and always show the current field. The follow mode exits
+ automatically when point leaves the table, or when you repeat this
+ command with {{{kbd(C-u C-u C-c `)}}}.
+
+- {{{kbd(M-x org-table-import)}}} ::
+
+ #+findex: org-table-import
+ Import a file as a table. The table should be TAB or whitespace
+ separated. Use, for example, to import a spreadsheet table or data
+ from a database, because these programs generally can write
+ TAB-separated text files. This command works by inserting the file
+ into the buffer and then converting the region to a table. Any
+ prefix argument is passed on to the converter, which uses it to
+ determine the separator.
+
+- {{{kbd(C-c |)}}} (~org-table-create-or-convert-from-region~) ::
+
+ #+kindex: C-c |
+ #+findex: org-table-create-or-convert-from-region
+ Tables can also be imported by pasting tabular text into the Org
+ buffer, selecting the pasted text with {{{kbd(C-x C-x)}}} and then
+ using the {{{kbd(C-c |)}}} command (see [[*Creation and conversion]]).
+
+- {{{kbd(M-x org-table-export)}}} ::
+
+ #+findex: org-table-export
+ #+vindex: org-table-export-default-format
+ Export the table, by default as a TAB-separated file. Use for data
+ exchange with, for example, spreadsheet or database programs. The
+ format used to export the file can be configured in the variable
+ ~org-table-export-default-format~. You may also use properties
+ =TABLE_EXPORT_FILE= and =TABLE_EXPORT_FORMAT= to specify the file
+ name and the format for table export in a subtree. Org supports
+ quite general formats for exported tables. The exporter format is
+ the same as the format used by Orgtbl radio tables, see [[*Translator
+ functions]], for a detailed description.
+
+- {{{kbd(M-x org-table-header-line-mode)}}} ::
+
+ #+findex: org-table-header-line-mode
+ #+vindex: org-table-header-line-p
+ Turn on the display of the first data row of the table at point in
+ the window header line when this first row is not visible anymore in
+ the buffer. You can activate this minor mode by default by setting
+ the option ~org-table-header-line-p~ to ~t~.
+
+- {{{kbd(M-x org-table-transpose-table-at-point)}}} ::
+
+ #+findex: org-table-transpose-table-at-point
+ Transpose the table at point and eliminate hlines.
+
+** Column Width and Alignment
+:PROPERTIES:
+:DESCRIPTION: Overrule the automatic settings.
+:END:
+#+cindex: narrow columns in tables
+#+cindex: alignment in tables
+
+The width of columns is automatically determined by the table editor.
+The alignment of a column is determined automatically from the
+fraction of number-like versus non-number fields in the column.
+
+#+vindex: org-table-automatic-realign
+Editing a field may modify alignment of the table. Moving
+a contiguous row or column---i.e., using {{{kbd(TAB)}}} or
+{{{kbd(RET)}}}---automatically re-aligns it. If you want to disable
+this behavior, set ~org-table-automatic-realign~ to ~nil~. In any
+case, you can always align manually a table:
+
+- {{{kbd(C-c C-c)}}} (~org-table-align~) ::
+
+ #+kindex: C-c C-c
+ #+findex: org-table-align
+ Align the current table.
+
+#+vindex: org-startup-align-all-tables
+Setting the option ~org-startup-align-all-tables~ re-aligns all tables
+in a file upon visiting it. You can also set this option on
+a per-file basis with:
+
+#+begin_example
+,#+STARTUP: align
+,#+STARTUP: noalign
+#+end_example
+
+Sometimes a single field or a few fields need to carry more text,
+leading to inconveniently wide columns. Maybe you want to hide away
+several columns or display them with a fixed width, regardless of
+content, as shown in the following example.
+
+#+begin_example
+|---+---------------------+--------| |---+-------…+…|
+| | <6> | | | | <6> …|…|
+| 1 | one | some | ----\ | 1 | one …|…|
+| 2 | two | boring | ----/ | 2 | two …|…|
+| 3 | This is a long text | column | | 3 | This i…|…|
+|---+---------------------+--------| |---+-------…+…|
+#+end_example
+
+To set the width of a column, one field anywhere in the column may
+contain just the string =<N>= where {{{var(N)}}} specifies the width
+as a number of characters. You control displayed width of columns
+with the following tools:
+
+- {{{kbd(C-c TAB)}}} (~org-table-toggle-column-width~) ::
+
+ #+kindex: C-c TAB
+ #+findex: org-table-toggle-column-width
+ Shrink or expand current column.
+
+ If a width cookie specifies a width W for the column, shrinking it
+ displays the first W visible characters only. Otherwise, the column
+ is shrunk to a single character.
+
+ When called before the first column or after the last one, ask for
+ a list of column ranges to operate on.
+
+- {{{kbd(C-u C-c TAB)}}} (~org-table-shrink~) ::
+
+ #+kindex: C-u C-c TAB
+ #+findex: org-table-shrink
+ Shrink all columns with a column width. Expand the others.
+
+- {{{kbd(C-u C-u C-c TAB)}}} (~org-table-expand~) ::
+
+ #+kindex: C-u C-u C-c TAB
+ #+findex: org-table-expand
+ Expand all columns.
+
+To see the full text of a shrunk field, hold the mouse over it:
+a tool-tip window then shows the full contents of the field.
+Alternatively, {{{kbd(C-h .)}}} (~display-local-help~) reveals them,
+too. For convenience, any change near the shrunk part of a column
+expands it.
+
+#+vindex: org-startup-shrink-all-tables
+Setting the option ~org-startup-shrink-all-tables~ shrinks all columns
+containing a width cookie in a file the moment it is visited. You can
+also set this option on a per-file basis with:
+
+: #+STARTUP: shrink
+
+If you would like to overrule the automatic alignment of number-rich
+columns to the right and of string-rich columns to the left, you can
+use =<r>=, =<c>= or =<l>= in a similar fashion. You may also combine
+alignment and field width like this: =<r10>=.
+
+Lines which only contain these formatting cookies are removed
+automatically upon exporting the document.
+
+** Column Groups
+:PROPERTIES:
+:DESCRIPTION: Grouping to trigger vertical lines.
+:END:
+#+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 =/=. The further fields can either contain
+=<= to indicate that this column should start a group, =>= to indicate
+the end of a column, or =<>= (no space between =<= and =>=) to make
+a column a group of its own. Upon export, boundaries between column
+groups are marked with vertical lines. Here is an example:
+
+#+begin_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
+
+It is also sufficient to just insert the column group starters after
+every vertical line you would like to have:
+
+#+begin_example
+| N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) |
+|---+-----+-----+-----+---------+------------|
+| / | < | | | < | |
+#+end_example
+
+** The Orgtbl Minor Mode
+:PROPERTIES:
+:DESCRIPTION: The table editor as minor mode.
+:ALT_TITLE: Orgtbl Mode
+:END:
+#+cindex: Orgtbl mode
+#+cindex: minor mode for tables
+
+#+findex: orgtbl-mode
+If you like the intuitive way the Org table editor works, you might
+also want to use it in other modes like Text mode or Mail mode. The
+minor mode Orgtbl mode makes this possible. You can always toggle the
+mode with {{{kbd(M-x orgtbl-mode)}}}. To turn it on by default, for
+example in Message mode, use
+
+#+begin_src emacs-lisp
+(add-hook 'message-mode-hook 'turn-on-orgtbl)
+#+end_src
+
+Furthermore, with some special setup, it is possible to maintain
+tables in arbitrary syntax with Orgtbl mode. For example, it is
+possible to construct LaTeX tables with the underlying ease and power
+of Orgtbl mode, including spreadsheet capabilities. For details, see
+[[*Tables in Arbitrary Syntax]].
+
+** The Spreadsheet
+:PROPERTIES:
+:DESCRIPTION: The table editor has spreadsheet capabilities.
+:END:
+#+cindex: calculations, in tables
+#+cindex: spreadsheet capabilities
+#+cindex: Calc package
+
+The table editor makes use of the Emacs Calc package to implement
+spreadsheet-like capabilities. It can also evaluate Emacs Lisp forms
+to derive fields from other fields. While fully featured, Org's
+implementation is not identical to other spreadsheets. For example,
+Org knows the concept of a /column formula/ that will be applied to
+all non-header fields in a column without having to copy the formula
+to each relevant field. There is also a formula debugger, and a
+formula editor with features for highlighting fields in the table
+corresponding to the references at point in the formula, moving these
+references by arrow keys.
+
+*** References
+:PROPERTIES:
+:DESCRIPTION: How to refer to another field or range.
+:END:
+#+cindex: references
+
+To compute fields in the table from other fields, formulas must
+reference other fields or ranges. In Org, fields can be referenced by
+name, by absolute coordinates, and by relative coordinates. To find
+out what the coordinates of a field are, press {{{kbd(C-c ?)}}} in
+that field, or press {{{kbd(C-c })}}} to toggle the display of a grid.
+
+**** Field references
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: field references
+#+cindex: references, to fields
+Formulas can reference the value of another field in two ways. Like
+in any other spreadsheet, you may reference fields with
+a letter/number combination like =B3=, meaning the second field in the
+third row. However, Org prefers to use another, more general
+representation that looks like this:[fn:18]
+
+: @ROW$COLUMN
+
+Column specifications can be absolute like =$1=, =$2=, ..., =$N=, or
+relative to the current column, i.e., the column of the field which is
+being computed, like =$+1= or =$-2=. =$<= and =$>= are immutable
+references to the first and last column, respectively, and you can use
+=$>>>= to indicate the third column from the right.
+
+The row specification only counts data lines and ignores horizontal
+separator lines, or "hlines". Like with columns, you can use absolute
+row numbers =@1=, =@2=, ..., =@N=, and row numbers relative to the
+current row like =@+3= or =@-1=. =@<= and =@>= are immutable
+references the first and last row in the table, respectively. You may
+also specify the row relative to one of the hlines: =@I= refers to the
+first hline, =@II= to the second, etc. =@-I= refers to the first such
+line above the current line, =@+I= to the first such line below the
+current line. You can also write =@III+2= which is the second data
+line after the third hline in the table.
+
+=@0= and =$0= refer to the current row and column, respectively, i.e.,
+to the row/column for the field being computed. Also, if you omit
+either the column or the row part of the reference, the current
+row/column is implied.
+
+Org's references with /unsigned/ numbers are fixed references in the
+sense that if you use the same reference in the formula for two
+different fields, the same field is referenced each time. Org's
+references with /signed/ numbers are floating references because the
+same reference operator can reference different fields depending on
+the field being calculated by the formula.
+
+Here are a few examples:
+
+#+attr_texinfo: :columns 0.2 0.8
+| =@2$3= | 2nd row, 3rd column (same as =C2=) |
+| =$5= | column 5 in the current row (same as =E&=) |
+| =@2= | current column, row 2 |
+| =@-1$-3= | field one row up, three columns to the left |
+| =@-I$2= | field just under hline above current row, column 2 |
+| =@>$5= | field in the last row, in column 5 |
+
+**** Range references
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: range references
+#+cindex: references, to ranges
+You may reference a rectangular range of fields by specifying two
+field references connected by two dots =..=. The ends are included in
+the range. If both fields are in the current row, you may simply use
+=$2..$7=, but if at least one field is in a different row, you need to
+use the general =@ROW$COLUMN= format at least for the first field,
+i.e., the reference must start with =@= in order to be interpreted
+correctly. Examples:
+
+#+attr_texinfo: :columns 0.2 0.8
+| =$1..$3= | first three fields in the current row |
+| =$P..$Q= | range, using column names (see [[*Advanced features]]) |
+| =$<<<..$>>= | start in third column, continue to the last but one |
+| =@2$1..@4$3= | nine fields between these two fields (same as =A2..C4=) |
+| =@-1$-2..@-1= | 3 fields in the row above, starting from 2 columns on the left |
+| =@I..II= | between first and second hline, short for =@I..@II= |
+
+#+texinfo: @noindent
+Range references return a vector of values that can be fed into Calc
+vector functions. Empty fields in ranges are normally suppressed, so
+that the vector contains only the non-empty fields. For other options
+with the mode switches =E=, =N= and examples, see [[*Formula syntax for
+Calc]].
+
+**** Field coordinates in formulas
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: field coordinates
+#+cindex: coordinates, of field
+#+cindex: row, of field coordinates
+#+cindex: column, of field coordinates
+#+vindex: org-table-current-column
+#+vindex: org-table-current-dline
+One of the very first actions during evaluation of Calc formulas and
+Lisp formulas is to substitute =@#= and =$#= 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 ~org-table-current-dline~
+and ~org-table-current-column~. Examples:
+
+- =if(@# % 2, $#, string(""))= ::
+
+ Insert column number on odd rows, set field to empty on even rows.
+
+- =$2 = '(identity remote(FOO, @@#$1))= ::
+
+ Copy text or values of each row of column 1 of the table named
+ {{{var(FOO)}}} into column 2 of the current table.
+
+- =@3 = 2 * remote(FOO, @1$$#)= ::
+
+ Insert the doubled value of each column of row 1 of the table
+ named {{{var(FOO)}}} into row 3 of the current table.
+
+#+texinfo: @noindent
+For the second and third examples, table {{{var(FOO)}}} must have at
+least as many rows or columns as the current table. Note that this is
+inefficient[fn:19] for large number of rows.
+
+**** Named references
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: named references
+#+cindex: references, named
+#+cindex: name, of column or field
+#+cindex: constants, in calculations
+#+cindex: @samp{CONSTANTS}, keyword
+#+vindex: org-table-formula-constants
+
+=$name= is interpreted as the name of a column, parameter or constant.
+Constants are defined globally through the variable
+~org-table-formula-constants~, and locally---for the file---through
+a line like this example:
+
+: #+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6
+
+#+vindex: constants-unit-system
+#+pindex: constants.el
+Also, properties (see [[*Properties and Columns]]) can be used as
+constants in table formulas: for a property =Xyz= use the name
+=$PROP_Xyz=, and the property will be searched in the current outline
+entry and in the hierarchy above it. If you have the =constants.el=
+package, it will also be used to resolve constants, including natural
+constants like =$h= for Planck's constant, and units like =$km= for
+kilometers[fn:20]. Column names and parameters can be specified in
+special table lines. These are described below, see [[*Advanced
+features]]. All names must start with a letter, and further consist
+of letters and numbers.
+
+**** Remote references
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: remote references
+#+cindex: references, remote
+#+cindex: references, to a different table
+#+cindex: name, of column or field
+#+cindex: @samp{NAME}, keyword
+You may also reference constants, fields and ranges from a different
+table, either in the current file or even in a different file. The
+syntax is
+
+: remote(NAME,REF)
+
+#+texinfo: @noindent
+where {{{var(NAME)}}} can be the name of a table in the current file
+as set by a =#+NAME:= line before the table. It can also be the ID of
+an entry, even in a different file, and the reference then refers to
+the first table in that entry. {{{var(REF)}}} is an absolute field or
+range reference as described above for example =@3$3= or =$somename=,
+valid in the referenced table.
+
+#+cindex: table indirection
+When {{{var(NAME)}}} has the format =@ROW$COLUMN=, it is substituted
+with the name or ID found in this field of the current table. For
+example =remote($1, @@>$2)= \Rightarrow =remote(year_2013, @@>$1)=. The format
+=B3= is not supported because it can not be distinguished from a plain
+table name or ID.
+
+*** Formula syntax for Calc
+:PROPERTIES:
+:DESCRIPTION: Using Calc to compute stuff.
+:END:
+#+cindex: formula syntax, Calc
+#+cindex: syntax, of formulas
+
+A formula can be any algebraic expression understood by the Emacs Calc
+package. Note that Calc has the non-standard convention that =/= has
+lower precedence than =*=, so that =a/b*c= is interpreted as
+=(a/(b*c))=. Before evaluation by ~calc-eval~ (see [[info:calc#Calling Calc from Your Programs][Calling Calc from
+Your Lisp Programs]]), variable substitution takes place according to
+the rules described above.
+
+#+cindex: vectors, in table calculations
+The range vectors can be directly fed into the Calc vector functions
+like ~vmean~ and ~vsum~.
+
+#+cindex: format specifier, in spreadsheet
+#+cindex: mode, for Calc
+#+vindex: org-calc-default-modes
+A formula can contain an optional mode string after a semicolon. This
+string consists of flags to influence Calc and other modes during
+execution. By default, Org uses the standard Calc modes (precision
+12, angular units degrees, fraction and symbolic modes off). The
+display format, however, has been changed to =(float 8)= to keep
+tables compact. The default settings can be configured using the
+variable ~org-calc-default-modes~.
+
+- =p20= ::
+
+ Set the internal Calc calculation precision to 20 digits.
+
+- =n3=, =s3=, =e2=, =f4= ::
+
+ Normal, scientific, engineering or fixed format of the result of
+ Calc passed back to Org. Calc formatting is unlimited in precision
+ as long as the Calc calculation precision is greater.
+
+- =D=, =R= ::
+
+ Degree and radian angle modes of Calc.
+
+- =F=, =S= ::
+
+ Fraction and symbolic modes of Calc.
+
+- =T=, =t=, =U= ::
+
+ Duration computations in Calc or Lisp, [[*Durations and time values]].
+
+- =E= ::
+
+ If and how to consider empty fields. Without =E= empty fields in
+ range references are suppressed so that the Calc vector or Lisp list
+ contains only the non-empty fields. With =E= the empty fields are
+ kept. For empty fields in ranges or empty field references the
+ value =nan= (not a number) is used in Calc formulas and the empty
+ string is used for Lisp formulas. Add =N= to use 0 instead for both
+ formula types. For the value of a field the mode =N= has higher
+ precedence than =E=.
+
+- =N= ::
+
+ Interpret all fields as numbers, use 0 for non-numbers. See the
+ next section to see how this is essential for computations with Lisp
+ formulas. In Calc formulas it is used only occasionally because
+ there number strings are already interpreted as numbers without =N=.
+
+- =L= ::
+
+ Literal, for Lisp formulas only. See the next section.
+
+Unless you use large integer numbers or high-precision calculation and
+display for floating point numbers you may alternatively provide
+a ~printf~ format specifier to reformat the Calc result after it has
+been passed back to Org instead of letting Calc already do the
+formatting[fn:21]. A few examples:
+
+| =$1+$2= | Sum of first and second field |
+| =$1+$2;%.2f= | Same, format result to two decimals |
+| =exp($2)+exp($1)= | Math functions can be used |
+| =$0;%.1f= | Reformat current cell to 1 decimal |
+| =($3-32)*5/9= | Degrees F \to C conversion |
+| =$c/$1/$cm= | Hz \to cm conversion, using =constants.el= |
+| =tan($1);Dp3s1= | Compute in degrees, precision 3, display SCI 1 |
+| =sin($1);Dp3%.1e= | Same, but use ~printf~ specifier for display |
+| =vmean($2..$7)= | Compute column range mean, using vector function |
+| =vmean($2..$7);EN= | Same, but treat empty fields as 0 |
+| =taylor($3,x=7,2)= | Taylor series of $3, at x=7, second degree |
+
+Calc also contains a complete set of logical operations (see [[info:calc#Logical Operations][Logical
+Operations]]). For example
+
+- =if($1 < 20, teen, string(""))= ::
+
+ ="teen"= if age =$1= is less than 20, else the Org table result
+ field is set to empty with the empty string.
+
+- =if("$1" =​= "nan" || "$2" =​= "nan", string(""), $1 + $2); E f-1= ::
+
+ Sum of the first two columns. When at least one of the input fields
+ is empty the Org table result field is set to empty. =E= is
+ required to not convert empty fields to 0. =f-1= is an optional
+ Calc format string similar to =%.1f= but leaves empty results empty.
+
+- =if(typeof(vmean($1..$7)) =​= 12, string(""), vmean($1..$7); E= ::
+
+ Mean value of a range unless there is any empty field. Every field
+ in the range that is empty is replaced by =nan= which lets =vmean=
+ result in =nan=. Then =typeof == 12= detects the =nan= from ~vmean~
+ and the Org table result field is set to empty. Use this when the
+ sample set is expected to never have missing values.
+
+- =if("$1..$7" =​= "[]", string(""), vmean($1..$7))= ::
+
+ Mean value of a range with empty fields skipped. Every field in the
+ range that is empty is skipped. When all fields in the range are
+ empty the mean value is not defined and the Org table result field
+ is set to empty. Use this when the sample set can have a variable
+ size.
+
+- =vmean($1..$7); EN= ::
+
+ To complete the example before: Mean value of a range with empty
+ fields counting as samples with value 0. Use this only when
+ incomplete sample sets should be padded with 0 to the full size.
+
+You can add your own Calc functions defined in Emacs Lisp with
+~defmath~ and use them in formula syntax for Calc.
+
+*** Emacs Lisp forms as formulas
+:PROPERTIES:
+:DESCRIPTION: Writing formulas in Emacs Lisp.
+:ALT_TITLE: Formula syntax for Lisp
+:END:
+#+cindex: Lisp forms, as table formulas
+
+It is also possible to write a formula in Emacs Lisp. This can be
+useful for string manipulation and control structures, if Calc's
+functionality is not enough.
+
+If a formula starts with a single-quote followed by an opening
+parenthesis, then it is evaluated as a Lisp form. The evaluation
+should return either a string or a number. Just as with Calc
+formulas, you can specify modes and a ~printf~ format after
+a semicolon.
+
+With Emacs Lisp forms, you need to be conscious about the way field
+references are interpolated into the form. By default, a reference is
+interpolated as a Lisp string (in double-quotes) containing the field.
+If you provide the =N= mode switch, all referenced elements are
+numbers---non-number fields will be zero---and interpolated as Lisp
+numbers, without quotes. If you provide the =L= flag, all fields are
+interpolated literally, without quotes. For example, if you want a
+reference to be interpreted as a string by the Lisp form, enclose the
+reference operator itself in double-quotes, like ="$3"=. Ranges are
+inserted as space-separated fields, so you can embed them in list or
+vector syntax.
+
+Here are a few examples---note how the =N= mode is used when we do
+computations in Lisp:
+
+- ='(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2))= ::
+
+ Swap the first two characters of the content of column 1.
+
+- ='(+ $1 $2);N= ::
+
+ Add columns 1 and 2, equivalent to Calc's =$1+$2=.
+
+- ='(apply '+ '($1..$4));N= ::
+
+ Compute the sum of columns 1 to 4, like Calc's =vsum($1..$4)=.
+
+*** Durations and time values
+:PROPERTIES:
+:DESCRIPTION: How to compute durations and time values.
+:END:
+#+cindex: duration, computing
+#+cindex: time, computing
+#+vindex: org-table-duration-custom-format
+
+If you want to compute time values use the =T=, =t=, or =U= flag,
+either in Calc formulas or Elisp formulas:
+
+#+begin_example
+| 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;U::@4$3=$1+$2;t
+#+end_example
+
+Input duration values must be of the form =HH:MM[:SS]=, where seconds
+are optional. With the =T= flag, computed durations are displayed as
+=HH:MM:SS= (see the first formula above). With the =U= flag, seconds
+are omitted so that the result is only =HH:MM= (see second formula
+above). Zero-padding of the hours field depends upon the value of the
+variable ~org-table-duration-hour-zero-padding~.
+
+With the =t= flag, computed durations are displayed according to the
+value of the option ~org-table-duration-custom-format~, which defaults
+to ~hours~ and displays 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 are
+considered as seconds in addition and subtraction.
+
+*** Field and range formulas
+:PROPERTIES:
+:DESCRIPTION: Formula for specific (ranges of) fields.
+:END:
+#+cindex: field formula
+#+cindex: range formula
+#+cindex: formula, for individual table field
+#+cindex: formula, for range of fields
+
+To assign a formula to a particular field, type it directly into the
+field, preceded by =:==, for example =vsum(@II..III)=. When you press
+{{{kbd(TAB)}}} or {{{kbd(RET)}}} or {{{kbd(C-c C-c)}}} with point
+still in the field, the formula is stored as the formula for this
+field, evaluated, and the current field is replaced with the result.
+
+#+cindex: @samp{TBLFM}, keyword
+Formulas are stored in a special =TBLFM= keyword located directly
+below the table. If you type the equation in the fourth field of the
+third data line in the table, the formula looks like =@3$4=$1+$2=.
+When inserting/deleting/swapping column and rows with the appropriate
+commands, /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 =@<=, =@>=, =$<=, =$>=), or at
+hlines using the =@I= notation. Automatic adaptation of field
+references does not happen if you edit the table structure with normal
+editing commands---you must fix the formulas yourself.
+
+Instead of typing an equation into the field, you may also use the
+following command
+
+- {{{kbd(C-u C-c =)}}} (~org-table-eval-formula~) ::
+
+ #+kindex: C-u C-c =
+ #+findex: org-table-eval-formula
+ Install a new formula for the current field. The command prompts
+ for a formula with default taken from the =TBLFM= keyword,
+ applies it to the current field, and stores it.
+
+The left-hand side of a formula can also be a special expression in
+order to assign the formula to a number of different fields. There is
+no keyboard shortcut to enter such range formulas. To add them, use
+the formula editor (see [[*Editing and debugging formulas]]) or edit
+the =TBLFM= keyword directly.
+
+- =$2== ::
+
+ Column formula, valid for the entire column. This is so common that
+ Org treats these formulas in a special way, see [[*Column formulas]].
+
+- =@3== ::
+
+ Row formula, applies to all fields in the specified row. =@>==
+ means the last row.
+
+- =@1$2..@4$3== ::
+
+ Range formula, applies to all fields in the given rectangular range.
+ This can also be used to assign a formula to some but not all fields
+ in a row.
+
+- =$NAME== ::
+
+ Named field, see [[*Advanced features]].
+
+*** Column formulas
+:PROPERTIES:
+:DESCRIPTION: Formulas valid for an entire column.
+:END:
+#+cindex: column formula
+#+cindex: formula, for table column
+
+When you assign a formula to a simple column reference like =$3==, the
+same formula is used in all fields of that column, with the following
+very convenient exceptions: (i) If the table contains horizontal
+separator hlines with rows above and below, everything before the
+first such hline is considered part of the table /header/ and is not
+modified by column formulas. Therefore a header is mandatory when you
+use column formulas and want to add hlines to group rows, like for
+example to separate a total row at the bottom from the summand rows
+above. (ii) Fields that already get a value from a field/range
+formula are left alone by column formulas. These conditions make
+column formulas very easy to use.
+
+To assign a formula to a column, type it directly into any field in
+the column, preceded by an equal sign, like ==$1+$2=. When you press
+{{{kbd(TAB)}}} or {{{kbd(RET)}}} or {{{kbd(C-c C-c)}}} with point
+still in the field, the formula is stored as the formula for the
+current column, evaluated and the current field replaced with the
+result. If the field contains only ===, the previously stored formula
+for this column is used. For each column, Org only remembers the most
+recently used formula. In the =TBLFM= keyword, column formulas look
+like =$4=$1+$2=. The left-hand side of a column formula can not be
+the name of column, it must be the numeric column reference or =$>=.
+
+Instead of typing an equation into the field, you may also use the
+following command:
+
+- {{{kbd(C-c =)}}} (~org-table-eval-formula~) ::
+
+ #+kindex: C-c =
+ #+findex: org-table-eval-formula
+ Install a new formula for the current column and replace current
+ field with the result of the formula. The command prompts for
+ a formula, with default taken from the =TBLFM= keyword, applies it
+ to the current field and stores it. With a numeric prefix argument,
+ e.g., {{{kbd(C-5 C-c =)}}}, the command applies it to that many
+ consecutive fields in the current column.
+
+*** Lookup functions
+:PROPERTIES:
+:DESCRIPTION: Lookup functions for searching tables.
+:END:
+#+cindex: lookup functions in tables
+#+cindex: table lookup functions
+
+Org has three predefined Emacs Lisp functions for lookups in tables.
+
+- =(org-lookup-first VAL S-LIST R-LIST &optional PREDICATE)= ::
+
+ #+findex: org-lookup-first
+ Searches for the first element {{{var(S)}}} in list
+ {{{var(S-LIST)}}} for which
+ #+begin_src emacs-lisp
+ (PREDICATE VAL S)
+ #+end_src
+ is non-~nil~; returns the value from the corresponding position in
+ list {{{var(R-LIST)}}}. The default {{{var(PREDICATE)}}} is
+ ~equal~. Note that the parameters {{{var(VAL)}}} and {{{var(S)}}}
+ are passed to {{{var(PREDICATE)}}} in the same order as the
+ corresponding parameters are in the call to ~org-lookup-first~,
+ where {{{var(VAL)}}} precedes {{{var(S-LIST)}}}. If
+ {{{var(R-LIST)}}} is ~nil~, the matching element {{{var(S)}}} of
+ {{{var(S-LIST)}}} is returned.
+
+- =(org-lookup-last VAL S-LIST R-LIST &optional PREDICATE)= ::
+
+ #+findex: org-lookup-last
+ Similar to ~org-lookup-first~ above, but searches for the /last/
+ element for which {{{var(PREDICATE)}}} is non-~nil~.
+
+- =(org-lookup-all VAL S-LIST R-LIST &optional PREDICATE)= ::
+
+ #+findex: org-lookup-all
+ Similar to ~org-lookup-first~, but searches for /all/ elements for
+ which {{{var(PREDICATE)}}} is non-~nil~, and returns /all/
+ corresponding values. This function can not be used by itself in
+ a formula, because it returns a list of values. However, powerful
+ lookups can be built when this function is combined with other Emacs
+ Lisp functions.
+
+If the ranges used in these functions contain empty fields, the =E=
+mode for the formula should usually be specified: otherwise empty
+fields are not included in {{{var(S-LIST)}}} and/or {{{var(R-LIST)}}}
+which can, for example, result in an incorrect mapping from an element
+of {{{var(S-LIST)}}} to the corresponding element of
+{{{var(R-LIST)}}}.
+
+These three functions can be used to implement associative arrays,
+count matching cells, rank results, group data, etc. For practical
+examples see [[https://orgmode.org/worg/org-tutorials/org-lookups.html][this tutorial on Worg]].
+
+*** Editing and debugging formulas
+:PROPERTIES:
+:DESCRIPTION: Fixing formulas.
+:END:
+#+cindex: formula editing
+#+cindex: editing, of table formulas
+
+#+vindex: org-table-use-standard-references
+You can edit individual formulas in the minibuffer or directly in the
+field. Org can also prepare a special buffer with all active formulas
+of a table. When offering a formula for editing, Org converts
+references to the standard format (like =B3= or =D&=) if possible. If
+you prefer to only work with the internal format (like =@3$2= or
+=$4=), configure the variable ~org-table-use-standard-references~.
+
+- {{{kbd(C-c =)}}} or {{{kbd(C-u C-c =)}}} (~org-table-eval-formula~) ::
+
+ #+kindex: C-c =
+ #+kindex: C-u C-c =
+ #+findex: org-table-eval-formula
+ Edit the formula associated with the current column/field in the
+ minibuffer. See [[*Column formulas]], and [[*Field and range formulas]].
+
+- {{{kbd(C-u C-u C-c =)}}} (~org-table-eval-formula~) ::
+
+ #+kindex: C-u C-u C-c =
+ #+findex: org-table-eval-formula
+ Re-insert the active formula (either a field formula, or a column
+ formula) into the current field, so that you can edit it directly in
+ the field. The advantage over editing in the minibuffer is that you
+ can use the command {{{kbd(C-c ?)}}}.
+
+- {{{kbd(C-c ?)}}} (~org-table-field-info~) ::
+
+ #+kindex: C-c ?
+ #+findex: org-table-field-info
+ While editing a formula in a table field, highlight the field(s)
+ referenced by the reference at point position in the formula.
+
+- {{{kbd(C-c })}}} (~org-table-toggle-coordinate-overlays~) ::
+
+ #+kindex: C-c @}
+ #+findex: org-table-toggle-coordinate-overlays
+ Toggle the display of row and column numbers for a table, using
+ overlays. These are updated each time the table is aligned; you can
+ force it with {{{kbd(C-c C-c)}}}.
+
+- {{{kbd(C-c {)}}} (~org-table-toggle-formula-debugger~) ::
+
+ #+kindex: C-c @{
+ #+findex: org-table-toggle-formula-debugger
+ Toggle the formula debugger on and off. See below.
+
+- {{{kbd(C-c ')}}} (~org-table-edit-formulas~) ::
+
+ #+kindex: C-c '
+ #+findex: org-table-edit-formulas
+ Edit all formulas for the current table in a special buffer, where
+ the formulas are displayed one per line. If the current field has
+ an active formula, point in the formula editor marks it. While
+ inside the special buffer, Org automatically highlights any field or
+ range reference at point position. You may edit, remove and add
+ formulas, and use the following commands:
+
+ - {{{kbd(C-c C-c)}}} or {{{kbd(C-x C-s)}}} (~org-table-fedit-finish~) ::
+
+ #+kindex: C-x C-s
+ #+kindex: C-c C-c
+ #+findex: org-table-fedit-finish
+ Exit the formula editor and store the modified formulas. With
+ {{{kbd(C-u)}}} prefix, also apply the new formulas to the
+ entire table.
+
+ - {{{kbd(C-c C-q)}}} (~org-table-fedit-abort~) ::
+
+ #+kindex: C-c C-q
+ #+findex: org-table-fedit-abort
+ Exit the formula editor without installing changes.
+
+ - {{{kbd(C-c C-r)}}} (~org-table-fedit-toggle-ref-type~) ::
+
+ #+kindex: C-c C-r
+ #+findex: org-table-fedit-toggle-ref-type
+ Toggle all references in the formula editor between standard (like
+ =B3=) and internal (like =@3$2=).
+
+ - {{{kbd(TAB)}}} (~org-table-fedit-lisp-indent~) ::
+
+ #+kindex: TAB
+ #+findex: org-table-fedit-lisp-indent
+ Pretty-print or indent Lisp formula at point. When in a line
+ containing a Lisp formula, format the formula according to Emacs
+ Lisp rules. Another {{{kbd(TAB)}}} collapses the formula back
+ again. In the open formula, {{{kbd(TAB)}}} re-indents just like
+ in Emacs Lisp mode.
+
+ - {{{kbd(M-TAB)}}} (~lisp-complete-symbol~) ::
+
+ #+kindex: M-TAB
+ #+findex: lisp-complete-symbol
+ Complete Lisp symbols, just like in Emacs Lisp mode.
+
+ - {{{kbd(S-UP)}}}, {{{kbd(S-DOWN)}}}, {{{kbd(S-LEFT)}}}, {{{kbd(S-RIGHT)}}} ::
+
+ #+kindex: S-UP
+ #+kindex: S-DOWN
+ #+kindex: S-LEFT
+ #+kindex: S-RIGHT
+ #+findex: org-table-fedit-ref-up
+ #+findex: org-table-fedit-ref-down
+ #+findex: org-table-fedit-ref-left
+ #+findex: org-table-fedit-ref-right
+ Shift the reference at point. For example, if the reference is
+ =B3= and you press {{{kbd(S-RIGHT)}}}, it becomes =C3=. This also
+ works for relative references and for hline references.
+
+ - {{{kbd(M-S-UP)}}} (~org-table-fedit-line-up~) ::
+
+ #+kindex: M-S-UP
+ #+findex: org-table-fedit-line-up
+ Move the test line for column formulas up in the Org buffer.
+
+ - {{{kbd(M-S-DOWN)}}} (~org-table-fedit-line-down~) ::
+
+ #+kindex: M-S-DOWN
+ #+findex: org-table-fedit-line-down
+ Move the test line for column formulas down in the Org buffer.
+
+ - {{{kbd(M-UP)}}} (~org-table-fedit-scroll-up~) ::
+
+ #+kindex: M-UP
+ #+findex: org-table-fedit-scroll-up
+ Scroll up the window displaying the table.
+
+ - {{{kbd(M-DOWN)}}} (~org-table-fedit-scroll-down~) ::
+
+ #+kindex: M-DOWN
+ #+findex: org-table-fedit-scroll-down
+ Scroll down the window displaying the table.
+
+ - {{{kbd(C-c })}}} ::
+
+ #+kindex: C-c @}
+ #+findex: org-table-toggle-coordinate-overlays
+ Turn the coordinate grid in the table on and off.
+
+Making a table field blank does not remove the formula associated with
+the field, because that is stored in a different line---the =TBLFM=
+keyword line. During the next recalculation, the field will be filled
+again. To remove a formula from a field, you have to give an empty
+reply when prompted for the formula, or to edit the =TBLFM= keyword.
+
+#+kindex: C-c C-c
+You may edit the =TBLFM= keyword directly and re-apply the changed
+equations with {{{kbd(C-c C-c)}}} in that line or with the normal
+recalculation commands in the table.
+
+**** Using multiple =TBLFM= lines
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: multiple formula lines
+#+cindex: @samp{TBLFM} keywords, multiple
+#+cindex: @samp{TBLFM}, switching
+
+#+kindex: C-c C-c
+You may apply the formula temporarily. This is useful when you want
+to switch the formula applied to the table. Place multiple =TBLFM=
+keywords right after the table, and then press {{{kbd(C-c C-c)}}} on
+the formula to apply. Here is an example:
+
+#+begin_example
+| x | y |
+|---+---|
+| 1 | |
+| 2 | |
+,#+TBLFM: $2=$1*1
+,#+TBLFM: $2=$1*2
+#+end_example
+
+#+texinfo: @noindent
+Pressing {{{kbd(C-c C-c)}}} in the line of =#+TBLFM: $2=$1*2= yields:
+
+#+begin_example
+| x | y |
+|---+---|
+| 1 | 2 |
+| 2 | 4 |
+,#+TBLFM: $2=$1*1
+,#+TBLFM: $2=$1*2
+#+end_example
+
+#+texinfo: @noindent
+If you recalculate this table, with {{{kbd(C-u C-c *)}}}, for example,
+you get the following result from applying only the first =TBLFM=
+keyword.
+
+#+begin_example
+| x | y |
+|---+---|
+| 1 | 1 |
+| 2 | 2 |
+,#+TBLFM: $2=$1*1
+,#+TBLFM: $2=$1*2
+#+end_example
+
+**** Debugging formulas
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: formula debugging
+#+cindex: debugging, of table formulas
+
+When the evaluation of a formula leads to an error, the field content
+becomes the string =#ERROR=. If you would like to see what is going
+on during variable substitution and calculation in order to find
+a bug, turn on formula debugging in the Tbl menu and repeat the
+calculation, for example by pressing {{{kbd(C-u C-u C-c = RET)}}} in
+a field. Detailed information are displayed.
+
+*** Updating the table
+:PROPERTIES:
+:DESCRIPTION: Recomputing all dependent fields.
+:END:
+#+cindex: recomputing table fields
+#+cindex: updating, table
+
+Recalculation of a table is normally not automatic, but needs to be
+triggered by a command. To make recalculation at least
+semi-automatic, see [[*Advanced features]].
+
+In order to recalculate a line of a table or the entire table, use the
+following commands:
+
+- {{{kbd(C-c *)}}} (~org-table-recalculate~) ::
+
+ #+kindex: C-c *
+ #+findex: org-table-recalculate
+ Recalculate the current row by first applying the stored column
+ formulas from left to right, and all field/range formulas in the
+ current row.
+
+- {{{kbd(C-u C-c *)}}} or {{{kbd(C-u C-c C-c)}}} ::
+
+ #+kindex: C-u C-c *
+ #+kindex: C-u C-c C-c
+ Recompute the entire table, line by line. Any lines before the
+ first hline are left alone, assuming that these are part of the
+ table header.
+
+- {{{kbd(C-u C-u C-c *)}}} or {{{kbd(C-u C-u C-c C-c)}}} (~org-table-iterate~) ::
+
+ #+kindex: C-u C-u C-c *
+ #+kindex: C-u C-u C-c C-c
+ #+findex: org-table-iterate
+ Iterate the table by recomputing it until no further changes occur.
+ This may be necessary if some computed fields use the value of other
+ fields that are computed /later/ in the calculation sequence.
+
+- {{{kbd(M-x org-table-recalculate-buffer-tables)}}} ::
+
+ #+findex: org-table-recalculate-buffer-tables
+ Recompute all tables in the current buffer.
+
+- {{{kbd(M-x org-table-iterate-buffer-tables)}}} ::
+
+ #+findex: org-table-iterate-buffer-tables
+ Iterate all tables in the current buffer, in order to converge
+ table-to-table dependencies.
+
+*** Advanced features
+:PROPERTIES:
+:DESCRIPTION: Field and column names, automatic recalculation...
+:END:
+
+If you want the recalculation of fields to happen automatically, or if
+you want to be able to assign /names/[fn:22] to fields and columns,
+you need to reserve the first column of the table for special marking
+characters.
+
+- {{{kbd(C-#)}}} (~org-table-rotate-recalc-marks~) ::
+
+ #+kindex: C-#
+ #+findex: org-table-rotate-recalc-marks
+ Rotate the calculation mark in first column through the states =#=,
+ =*=, =!=, =$=. When there is an active region, change all marks in
+ the region.
+
+Here is an example of a table that collects exam results of students
+and makes use of these features:
+
+#+begin_example
+|---+---------+--------+--------+--------+-------+------|
+| | Student | Prob 1 | Prob 2 | Prob 3 | Total | Note |
+|---+---------+--------+--------+--------+-------+------|
+| ! | | P1 | P2 | P3 | Tot | |
+| # | Maximum | 10 | 15 | 25 | 50 | 10.0 |
+| ^ | | m1 | m2 | m3 | mt | |
+|---+---------+--------+--------+--------+-------+------|
+| # | Peter | 10 | 8 | 23 | 41 | 8.2 |
+| # | Sam | 2 | 4 | 3 | 9 | 1.8 |
+|---+---------+--------+--------+--------+-------+------|
+| | Average | | | | 25.0 | |
+| ^ | | | | | at | |
+| $ | max=50 | | | | | |
+|---+---------+--------+--------+--------+-------+------|
+,#+TBLFM: $6=vsum($P1..$P3)::$7=10*$Tot/$max;%.1f::$at=vmean(@-II..@-I);%.1f
+#+end_example
+
+#+attr_texinfo: :tag Important
+#+begin_quote
+Please note that for these special tables, recalculating the table
+with {{{kbd(C-u C-c *)}}} only affects rows that are marked =#= or
+=*=, and fields that have a formula assigned to the field itself. The
+column formulas are not applied in rows with empty first field.
+#+end_quote
+
+#+cindex: marking characters, tables
+The marking characters have the following meaning:
+
+- =!= ::
+
+ The fields in this line define names for the columns, so that you
+ may refer to a column as =$Tot= instead of =$6=.
+
+- =^= ::
+
+ This row defines names for the fields /above/ the row. With such
+ a definition, any formula in the table may use =$m1= to refer to the
+ value =10=. Also, if you assign a formula to a names field, it is
+ stored as =$name = ...=.
+
+- =_= ::
+
+ Similar to =^=, but defines names for the fields in the row /below/.
+
+- =$= ::
+
+ Fields in this row can define /parameters/ for formulas. For
+ example, if a field in a =$= row contains =max=50=, then formulas in
+ this table can refer to the value 50 using =$max=. Parameters work
+ exactly like constants, only that they can be defined on a per-table
+ basis.
+
+- =#= ::
+
+ Fields in this row are automatically recalculated when pressing
+ {{{kbd(TAB)}}} or {{{kbd(RET)}}} or {{{kbd(S-TAB)}}} in this row.
+ Also, this row is selected for a global recalculation with
+ {{{kbd(C-u C-c *)}}}. Unmarked lines are left alone by this
+ command.
+
+- =*= ::
+
+ Selects this line for global recalculation with {{{kbd(C-u C-c
+ *)}}}, but not for automatic recalculation. Use this when automatic
+ recalculation slows down editing too much.
+
+- =/= ::
+
+ Do not export this line. Useful for lines that contain the
+ narrowing =<N>= markers or column group markers.
+
+Finally, just to whet your appetite for what can be done with the
+fantastic Calc package, here is a table that computes the Taylor
+series of degree n at location x for a couple of functions.
+
+#+begin_example
+|---+-------------+---+-----+--------------------------------------|
+| | Func | n | x | Result |
+|---+-------------+---+-----+--------------------------------------|
+| # | exp(x) | 1 | x | 1 + x |
+| # | exp(x) | 2 | x | 1 + x + x^2 / 2 |
+| # | exp(x) | 3 | x | 1 + x + x^2 / 2 + x^3 / 6 |
+| # | x^2+sqrt(x) | 2 | x=0 | x*(0.5 / 0) + x^2 (2 - 0.25 / 0) / 2 |
+| # | x^2+sqrt(x) | 2 | x=1 | 2 + 2.5 x - 2.5 + 0.875 (x - 1)^2 |
+| * | tan(x) | 3 | x | 0.0175 x + 1.77e-6 x^3 |
+|---+-------------+---+-----+--------------------------------------|
+,#+TBLFM: $5=taylor($2,$4,$3);n3
+#+end_example
+
+** Org Plot
+:PROPERTIES:
+:DESCRIPTION: Plotting from Org tables.
+:END:
+#+cindex: graph, in tables
+#+cindex: plot tables using Gnuplot
+
+Org Plot can produce graphs of information stored in Org tables,
+either graphically or in ASCII art.
+
+*** Graphical plots using Gnuplot
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{PLOT}, keyword
+Org Plot can produce 2D and 3D graphs of information stored in Org
+tables using [[http://www.gnuplot.info/][Gnuplot]] and [[http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html][Gnuplot mode]]. To see this in action, ensure
+that you have both Gnuplot and Gnuplot mode installed on your system,
+then call {{{kbd(C-c \quot g)}}} or {{{kbd(M-x org-plot/gnuplot)}}} on the
+following table.
+
+#+begin_example
+,#+PLOT: title:"Citas" ind:1 deps:(3) type:2d with:histograms set:"yrange [0:]"
+| Sede | Max cites | H-index |
+|-----------+-----------+---------|
+| Chile | 257.72 | 21.39 |
+| Leeds | 165.77 | 19.68 |
+| Sao Paolo | 71.00 | 11.50 |
+| Stockholm | 134.19 | 14.33 |
+| Morelia | 257.56 | 17.67 |
+#+end_example
+
+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 =PLOT= keyword
+preceding a table. See below for a complete list of Org Plot options.
+For more information and examples see the [[https://orgmode.org/worg/org-tutorials/org-plot.html][Org Plot tutorial]].
+
+**** Plot options
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- =set= ::
+
+ Specify any Gnuplot option to be set when graphing.
+
+- =title= ::
+
+ Specify the title of the plot.
+
+- =ind= ::
+
+ Specify which column of the table to use as the =x= axis.
+
+- =deps= ::
+
+ Specify the columns to graph as a Lisp style list, surrounded by
+ parentheses and separated by spaces for example =dep:(3 4)= to graph
+ the third and fourth columns. Defaults to graphing all other
+ columns aside from the =ind= column.
+
+- =type= ::
+
+ Specify whether the plot is =2d=, =3d=, or =grid=.
+
+- =with= ::
+
+ Specify a =with= option to be inserted for every column being
+ plotted, e.g., =lines=, =points=, =boxes=, =impulses=. Defaults to
+ =lines=.
+
+- =file= ::
+
+ If you want to plot to a file, specify
+ ="path/to/desired/output-file"=.
+
+- =labels= ::
+
+ List of labels to be used for the =deps=. Defaults to the column
+ headers if they exist.
+
+- =line= ::
+
+ Specify an entire line to be inserted in the Gnuplot script.
+
+- =map= ::
+
+ When plotting =3d= or =grid= types, set this to =t= to graph a flat
+ mapping rather than a =3d= slope.
+
+- =timefmt= ::
+
+ Specify format of Org mode timestamps as they will be parsed by
+ Gnuplot. Defaults to =%Y-%m-%d-%H:%M:%S=.
+
+- =script= ::
+
+ If you want total control, you can specify a script file---place the
+ file name between double-quotes---which will be used to plot.
+ Before plotting, every instance of =$datafile= in the specified
+ script will be replaced with the path to the generated data file.
+ Note: even if you set this option, you may still want to specify the
+ plot type, as that can impact the content of the data file.
+
+*** ASCII bar plots
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+While point is on a column, typing {{{kbd(C-c " a)}}} or {{{kbd(M-x
+orgtbl-ascii-plot)}}} 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 *)}}}.
+
+#+begin_example
+| 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_example
+
+The formula is an Elisp call.
+
+#+attr_texinfo: :options orgtbl-ascii-draw value min max &optional width
+#+begin_defun
+Draw an ASCII bar in a table.
+
+{{{var(VALUE)}}} is the value to plot.
+
+{{{var(MIN)}}} is the value displayed as an empty bar. {{{var(MAX)}}}
+is the value filling all the {{{var(WIDTH)}}}. Sources values outside
+this range are displayed as =too small= or =too large=.
+
+{{{var(WIDTH)}}} is the number of characters of the bar plot. It
+defaults to =12=.
+#+end_defun
+
+* Hyperlinks
+:PROPERTIES:
+:DESCRIPTION: Notes in context.
+:END:
+#+cindex: hyperlinks
+
+Like HTML, Org provides support for links inside a file, external
+links to other files, Usenet articles, emails, and much more.
+
+** Link Format
+:PROPERTIES:
+:DESCRIPTION: How links in Org are formatted.
+:END:
+#+cindex: link format
+#+cindex: format, of links
+
+#+cindex: angle bracket links
+#+cindex: plain links
+Org recognizes plain URIs, possibly wrapped within angle
+brackets[fn:23], and activate them as clickable links.
+
+#+cindex: bracket links
+The general link format, however, looks like this:
+
+: [[LINK][DESCRIPTION]]
+
+#+texinfo: @noindent
+or alternatively
+
+: [[LINK]]
+
+#+cindex: escape syntax, for links
+#+cindex: backslashes, in links
+Some =\=, =[= and =]= characters in the {{{var(LINK)}}} part need to
+be "escaped", i.e., preceded by another =\= character. More
+specifically, the following characters, and only them, must be
+escaped:
+
+1. all =[= and =]= characters,
+2. every =\= character preceding either =]= or =[=,
+3. every =\= character at the end of the link.
+
+#+findex: org-link-escape
+Functions inserting links (see [[*Handling Links]]) properly escape
+ambiguous characters. You only need to bother about the rules above
+when inserting directly, or yanking, a URI within square brackets.
+When in doubt, you may use the function ~org-link-escape~, which turns
+a link string into its escaped form.
+
+Once a link in the buffer is complete, with all brackets present, Org
+changes the display so that =DESCRIPTION= is displayed instead of
+=[[LINK][DESCRIPTION]]= and =LINK= is displayed instead of =[[LINK]]=.
+Links are highlighted in the ~org-link~ face, which, by default, is an
+underlined face.
+
+You can directly edit the visible part of a link. This can be either
+the {{{var(LINK)}}} part, if there is no description, or the
+{{{var(DESCRIPTION)}}} part otherwise. To also edit the invisible
+{{{var(LINK)}}} part, use {{{kbd(C-c C-l)}}} with point on the link
+(see [[*Handling Links]]).
+
+If you place point at the beginning or just behind the end of the
+displayed text and press {{{kbd(BS)}}}, you remove
+the---invisible---bracket at that location[fn:24]. This makes the link
+incomplete and the internals are again displayed as plain text.
+Inserting the missing bracket hides the link internals again. To show
+the internal structure of all links, use the menu: Org \rarr Hyperlinks \rarr
+Literal links.
+
+** Internal Links
+:PROPERTIES:
+:DESCRIPTION: Links to other places in the current file.
+:END:
+#+cindex: internal links
+#+cindex: links, internal
+
+A link that does not look like a URL---i.e., does not start with
+a known scheme or a file name---refers to the current document. You
+can follow it with {{{kbd(C-c C-o)}}} when point is on the link, or
+with a mouse click (see [[*Handling Links]]).
+
+#+cindex: @samp{CUSTOM_ID}, property
+Org provides several refinements to internal navigation within
+a document. Most notably, a construct like =[[#my-custom-id]]=
+specifically targets the entry with the =CUSTOM_ID= property set to
+=my-custom-id=. Also, an internal link looking like =[[*Some
+section]]= points to a headline with the name =Some section=[fn:25].
+
+#+cindex: targets, for links
+When the link does not belong to any of the cases above, Org looks for
+a /dedicated target/: the same string in double angular brackets, like
+=<<My Target>>=.
+
+#+cindex: @samp{NAME}, keyword
+If no dedicated target exists, the link tries to match the exact name
+of an element within the buffer. Naming is done, unsurprisingly, with
+the =NAME= keyword, which has to be put in the line before the element
+it refers to, as in the following example
+
+#+begin_example
+,#+NAME: My Target
+| a | table |
+|----+------------|
+| of | four cells |
+#+end_example
+
+#+vindex: org-link-search-must-match-exact-headline
+Ultimately, if none of the above succeeds, Org searches for a headline
+that is exactly the link text but may also include a TODO keyword and
+tags, or initiates a plain text search, according to the value of
+~org-link-search-must-match-exact-headline~.
+
+Note that you must make sure custom IDs, dedicated targets, and names
+are unique throughout the document. Org provides a linter to assist
+you in the process, if needed. See [[*Org Syntax]].
+
+During export, internal links are used to mark objects and assign them
+a number. Marked objects are then referenced by links pointing to
+them. In particular, links without a description appear as the number
+assigned to the marked object[fn:26]. In the following excerpt from
+an Org buffer
+
+#+begin_example
+1. one item
+2. <<target>>another item
+Here we refer to item [[target]].
+#+end_example
+
+#+texinfo: @noindent
+The last sentence will appear as =Here we refer to item 2= when
+exported.
+
+In non-Org files, the search looks for the words in the link text. In
+the above example the search would be for =target=.
+
+Following a link pushes a mark onto Org's own mark ring. You can
+return to the previous position with {{{kbd(C-c &)}}}. Using this
+command several times in direct succession goes back to positions
+recorded earlier.
+
+** Radio Targets
+:PROPERTIES:
+:DESCRIPTION: Make targets trigger links in plain text.
+:END:
+#+cindex: radio targets
+#+cindex: targets, radio
+#+cindex: links, radio targets
+
+Org can automatically turn any occurrences of certain target names in
+normal text into a link. So without explicitly creating a link, the
+text connects to the target radioing its position. Radio targets are
+enclosed by triple angular brackets. For example, a target =<<<My
+Target>>>= causes each occurrence of =my target= in normal text to
+become activated as a link. The Org file is scanned automatically 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
+point on or at a target.
+
+** External Links
+:PROPERTIES:
+:DESCRIPTION: URL-like links to the world.
+:END:
+#+cindex: links, external
+#+cindex: external links
+#+cindex: attachment links
+#+cindex: BBDB links
+#+cindex: Elisp links
+#+cindex: file links
+#+cindex: Gnus links
+#+cindex: Help links
+#+cindex: IRC links
+#+cindex: Info links
+#+cindex: MH-E links
+#+cindex: Rmail links
+#+cindex: shell links
+#+cindex: URL links
+#+cindex: Usenet links
+
+Org supports links to files, websites, Usenet and email messages, BBDB
+database entries and links to both IRC conversations and their logs.
+External links are URL-like locators. They start with a short
+identifying string followed by a colon. There can be no space after
+the colon.
+
+Here is the full set of built-in link types:
+
+- =file= ::
+
+ File links. File name may be remote, absolute, or relative.
+
+ Additionally, you can specify a line number, or a text search.
+ In Org files, you may link to a headline name, a custom ID, or a
+ code reference instead.
+
+ As a special case, "file" prefix may be omitted if the file name
+ is complete, e.g., it starts with =./=, or =/=.
+
+- =attachment= ::
+
+ Same as file links but for files and folders attached to the current
+ node (see [[*Attachments]]). Attachment links are intended to behave
+ exactly as file links but for files relative to the attachment
+ directory.
+
+- =bbdb= ::
+
+ Link to a BBDB record, with possible regexp completion.
+
+- =docview= ::
+
+ Link to a document opened with DocView mode. You may specify a page
+ number.
+
+- =doi= ::
+
+ Link to an electronic resource, through its handle.
+
+- =elisp= ::
+
+ Execute an Elisp command upon activation.
+
+- =gnus=, =rmail=, =mhe= ::
+
+ Link to messages or folders from a given Emacs' MUA.
+
+- =help= ::
+
+ Display documentation of a symbol in =*Help*= buffer.
+
+- =http=, =https= ::
+
+ Web links.
+
+- =id= ::
+
+ Link to a specific headline by its ID property, in an Org file.
+
+- =info= ::
+
+ Link to an Info manual, or to a specific node.
+
+- =irc= ::
+
+ Link to an IRC channel.
+
+- =mailto= ::
+
+ Link to message composition.
+
+- =news= ::
+
+ Usenet links.
+
+- =shell= ::
+
+ Execute a shell command upon activation.
+
+The following table illustrates the link types above, along with their
+options:
+
+| Link Type | Example |
+|------------+----------------------------------------------------------|
+| http | =http://staff.science.uva.nl/c.dominik/= |
+| https | =https://orgmode.org/= |
+| doi | =doi:10.1000/182= |
+| file | =file:/home/dominik/images/jupiter.jpg= |
+| | =/home/dominik/images/jupiter.jpg= (same as above) |
+| | =file:papers/last.pdf= |
+| | =./papers/last.pdf= (same as above) |
+| | =file:/ssh:me@some.where:papers/last.pdf= (remote) |
+| | =/ssh:me@some.where:papers/last.pdf= (same as above) |
+| | =file:sometextfile::NNN= (jump to line number) |
+| | =file:projects.org= |
+| | =file:projects.org::some words= (text search)[fn:27] |
+| | =file:projects.org::*task title= (headline search) |
+| | =file:projects.org::#custom-id= (headline search) |
+| attachment | =attachment:projects.org= |
+| | =attachment:projects.org::some words= (text search) |
+| docview | =docview:papers/last.pdf::NNN= |
+| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= |
+| news | =news:comp.emacs= |
+| mailto | =mailto:adent@galaxy.net= |
+| mhe | =mhe:folder= (folder link) |
+| | =mhe:folder#id= (message link) |
+| rmail | =rmail:folder= (folder link) |
+| | =rmail:folder#id= (message link) |
+| gnus | =gnus:group= (group link) |
+| | =gnus:group#id= (article link) |
+| bbdb | =bbdb:R.*Stallman= (record with regexp) |
+| irc | =irc:/irc.com/#emacs/bob= |
+| help | =help:org-store-link= |
+| info | =info:org#External links= |
+| shell | =shell:ls *.org= |
+| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) |
+| | =elisp:org-agenda= (interactive Elisp command) |
+
+#+cindex: VM links
+#+cindex: Wanderlust links
+On top of these built-in link types, additional ones are available
+through the =contrib/= directory (see [[*Installation]]). For example,
+these links to VM or Wanderlust messages are available when you load
+the corresponding libraries from the =contrib/= directory:
+
+| =vm:folder= | VM folder link |
+| =vm:folder#id= | VM message link |
+| =vm://myself@some.where.org/folder#id= | VM on remote machine |
+| =vm-imap:account:folder= | VM IMAP folder link |
+| =vm-imap:account:folder#id= | VM IMAP message link |
+| =wl:folder= | Wanderlust folder link |
+| =wl:folder#id= | Wanderlust message link |
+
+For information on customizing Org to add new link types, see [[*Adding
+Hyperlink Types]].
+
+A link should be enclosed in double brackets and may contain
+descriptive text to be displayed instead of the URL (see [[*Link
+Format]]), for example:
+
+: [[https://www.gnu.org/software/emacs/][GNU Emacs]]
+
+If the description is a file name or URL that points to an image, HTML
+export (see [[*HTML Export]]) inlines the image as a clickable button. If
+there is no description at all and the link points to an image, that
+image is inlined into the exported HTML file.
+
+#+cindex: square brackets, around links
+#+cindex: angular brackets, around links
+#+cindex: plain text external links
+Org also recognizes external links amid normal text and activates them
+as links. If spaces must be part of the link (for example in
+=bbdb:R.*Stallman=), or if you need to remove ambiguities about the
+end of the link, enclose the link in square or angular brackets.
+
+** Handling Links
+:PROPERTIES:
+:DESCRIPTION: Creating, inserting and following.
+:END:
+#+cindex: links, handling
+
+Org provides methods to create a link in the correct syntax, to insert
+it into an Org file, and to follow the link.
+
+#+findex: org-store-link
+#+cindex: storing links
+The main function is ~org-store-link~, called with {{{kbd(M-x
+org-store-link)}}}. Because of its importance, we suggest to bind it
+to a widely available key (see [[*Activation]]). It stores a link to the
+current location. The link is stored for later insertion into an Org
+buffer---see below. The kind of link that is created depends on the
+current buffer:
+
+- /Org mode buffers/ ::
+
+ For Org files, if there is a =<<target>>= at point, the link points
+ to the target. Otherwise it points to the current headline, which
+ is also the description[fn:28].
+
+ #+vindex: org-id-link-to-org-use-id
+ #+cindex: @samp{CUSTOM_ID}, property
+ #+cindex: @samp{ID}, property
+ If the headline has a =CUSTOM_ID= property, store a link to this
+ custom ID. In addition or alternatively, depending on the value of
+ ~org-id-link-to-org-use-id~, create and/or use a globally unique
+ =ID= property for the link[fn:29]. So using this command in Org
+ buffers potentially creates two links: a human-readable link 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.
+
+- /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
+
+ #+vindex: org-link-email-description-format
+ Pretty much all Emacs mail clients are supported. The link points
+ to the current article, or, in some Gnus buffers, to the group. The
+ description is constructed according to the variable
+ ~org-link-email-description-format~. By default, it refers to the
+ addressee and the subject.
+
+- /Web browsers: W3, W3M and EWW/ ::
+
+ Here the link is the current URL, with the page title as the
+ description.
+
+- /Contacts: BBDB/ ::
+
+ Links created in a BBDB buffer point to the current entry.
+
+- /Chat: IRC/ ::
+
+ #+vindex: org-irc-links-to-logs
+ For IRC links, if the variable ~org-irc-link-to-logs~ is non-~nil~,
+ create a =file= style link to the relevant point in the logs for the
+ current conversation. Otherwise store an =irc= style link to the
+ user/channel/server under the point.
+
+- /Other files/ ::
+
+ For any other file, the link points to the file, with a search
+ string (see [[*Search Options in File Links]]) pointing to the contents
+ of the current line. If there is an active region, the selected
+ words form the basis of the search string. You can write custom Lisp
+ functions to select the search string and perform the search for
+ particular file types (see [[*Custom Searches]]).
+
+ You can also define dedicated links to other files. See [[*Adding
+ Hyperlink Types]].
+
+- /Agenda view/ ::
+
+ When point is in an agenda view, the created link points to the
+ entry referenced by the current line.
+
+From an Org buffer, the following commands create, navigate or, more
+generally, act on links.
+
+#+attr_texinfo: :sep ,
+- {{{kbd(C-c C-l)}}} (~org-insert-link~) ::
+
+ #+kindex: C-c C-l
+ #+findex: org-insert-link
+ #+cindex: link completion
+ #+cindex: completion, of links
+ #+cindex: inserting links
+ #+vindex: org-link-keep-stored-after-insertion
+ Insert a link[fn:30]. This prompts for a link to be inserted into
+ the buffer. You can just type a link, using text for an internal
+ link, or one of the link type prefixes mentioned in the examples
+ above. The link is inserted into the buffer, along with
+ a descriptive text[fn:31]. If some text was selected at this time,
+ it becomes the default description.
+
+ - /Inserting stored links/ ::
+
+ All links stored during the current session are part of the
+ history for this prompt, so you can access them with {{{kbd(UP)}}}
+ and {{{kbd(DOWN)}}} (or {{{kbd(M-p)}}}, {{{kbd(M-n)}}}).
+
+ - /Completion support/ ::
+
+ Completion with {{{kbd(TAB)}}} helps you to insert valid link
+ prefixes like =http= or =ftp=, including the prefixes defined
+ through link abbreviations (see [[*Link Abbreviations]]). If you
+ press {{{kbd(RET)}}} after inserting only the prefix, Org offers
+ specific completion support for some link types[fn:32]. For
+ example, if you type {{{kbd(f i l e RET)}}}---alternative access:
+ {{{kbd(C-u C-c C-l)}}}, see below---Org offers file name
+ completion, and after {{{kbd(b b d b RET)}}} you can complete
+ contact names.
+
+- {{{kbd(C-u C-c C-l)}}} ::
+
+ #+cindex: file name completion
+ #+cindex: completion, of file names
+ #+kindex: C-u C-c C-l
+ When {{{kbd(C-c C-l)}}} is called with a {{{kbd(C-u)}}} prefix
+ argument, insert a link to a file. You may use file name completion
+ to select the name of the file. The path to the file is inserted
+ relative to the directory of the current Org file, if the linked
+ file is in the current directory or in a sub-directory of it, or if
+ the path is written relative to the current directory using =../=.
+ Otherwise an absolute path is used, if possible with =~/= for your
+ home directory. You can force an absolute path with two
+ {{{kbd(C-u)}}} prefixes.
+
+- {{{kbd(C-c C-l)}}} (with point on existing link) ::
+
+ #+cindex: following links
+ When point is on an existing link, {{{kbd(C-c C-l)}}} allows you to
+ edit the link and description parts of the link.
+
+- {{{kbd(C-c C-o)}}} (~org-open-at-point~) ::
+
+ #+kindex: C-c C-o
+ #+findex: org-open-at-point
+ #+vindex: org-file-apps
+ Open link at point. This launches a web browser for URL (using
+ ~browse-url-at-point~), run VM/MH-E/Wanderlust/Rmail/Gnus/BBDB for
+ the corresponding links, and execute the command in a shell link.
+ When point is on an internal link, this command runs the
+ corresponding search. When point is on the tags part of a headline,
+ it creates the corresponding tags view (see [[*Matching tags and
+ properties]]). If point is on a timestamp, it compiles the agenda for
+ that date. Furthermore, it visits text and remote files in =file=
+ links with Emacs and select a suitable application for local
+ non-text files. Classification of files is based on file extension
+ only. See option ~org-file-apps~. If you want to override the
+ default application and visit the file with Emacs, use
+ a {{{kbd(C-u)}}} prefix. If you want to avoid opening in Emacs, use
+ a {{{kbd(C-u C-u)}}} prefix.
+
+ #+vindex: org-link-frame-setup
+ If point is on a headline, but not on a link, offer all links in the
+ headline and entry text. If you want to setup the frame
+ configuration for following links, customize ~org-link-frame-setup~.
+
+- {{{kbd(RET)}}} ::
+
+ #+vindex: org-return-follows-link
+ #+kindex: RET
+ When ~org-return-follows-link~ is set, {{{kbd(RET)}}} also follows
+ the link at point.
+
+- {{{kbd(mouse-2)}}} or {{{kbd(mouse-1)}}} ::
+
+ #+kindex: mouse-2
+ #+kindex: mouse-1
+ On links, {{{kbd(mouse-1)}}} and {{{kbd(mouse-2)}}} opens the link
+ just as {{{kbd(C-c C-o)}}} does.
+
+- {{{kbd(mouse-3)}}} ::
+
+ #+vindex: org-link-use-indirect-buffer-for-internals
+ #+kindex: mouse-3
+ Like {{{kbd(mouse-2)}}}, but force file links to be opened with
+ Emacs, and internal links to be displayed in another window[fn:33].
+
+- {{{kbd(C-c %)}}} (~org-mark-ring-push~) ::
+
+ #+kindex: C-c %
+ #+findex: org-mark-ring-push
+ #+cindex: mark ring
+ Push the current position onto the Org mark ring, to be able to
+ return easily. Commands following an internal link do this
+ automatically.
+
+- {{{kbd(C-c &)}}} (~org-mark-ring-goto~) ::
+
+ #+kindex: C-c &
+ #+findex: org-mark-ring-goto
+ #+cindex: links, returning to
+ Jump back to a recorded position. A position is recorded by the
+ commands following internal links, and by {{{kbd(C-c %)}}}. Using
+ this command several times in direct succession moves through a ring
+ of previously recorded positions.
+
+- {{{kbd(C-c C-x C-n)}}} (~org-next-link~), {{{kbd(C-c C-x C-p)}}} (~org-previous-link~) ::
+
+ #+kindex: C-c C-x C-p
+ #+findex: org-previous-link
+ #+kindex: C-c C-x C-n
+ #+findex: org-next-link
+ #+cindex: links, finding next/previous
+ Move forward/backward to the next link in the buffer. At the limit
+ of the buffer, the search fails once, and then wraps around. The
+ key bindings for this are really too long; you might want to bind
+ this also to {{{kbd(M-n)}}} and {{{kbd(M-p)}}}.
+
+ #+begin_src emacs-lisp
+ (with-eval-after-load 'org
+ (define-key org-mode-map (kbd "M-n") 'org-next-link)
+ (define-key org-mode-map (kbd "M-p") 'org-previous-link))
+ #+end_src
+
+** Using Links Outside Org
+:PROPERTIES:
+:DESCRIPTION: Linking from my C source code?
+:END:
+
+#+findex: org-insert-link-global
+#+findex: org-open-at-point-global
+You can insert and follow links that have Org syntax not only in Org,
+but in any Emacs buffer. For this, Org provides two functions:
+~org-insert-link-global~ and ~org-open-at-point-global~.
+
+You might want to bind them to globally available keys. See
+[[*Activation]] for some advice.
+
+** Link Abbreviations
+:PROPERTIES:
+:DESCRIPTION: Shortcuts for writing complex links.
+:END:
+#+cindex: link abbreviations
+#+cindex: abbreviation, links
+
+Long URL can be cumbersome to type, and often many similar links are
+needed in a document. For this you can use link abbreviations. An
+abbreviated link looks like this
+
+: [[linkword:tag][description]]
+
+#+texinfo: @noindent
+#+vindex: org-link-abbrev-alist
+where the tag is optional. The /linkword/ must be a word, starting
+with a letter, followed by letters, numbers, =-=, and =_=.
+Abbreviations are resolved according to the information in the
+variable ~org-link-abbrev-alist~ that relates the linkwords to
+replacement text. Here is an example:
+
+#+begin_src emacs-lisp
+(setq org-link-abbrev-alist
+ '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
+ ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h")
+ ("duckduckgo" . "https://duckduckgo.com/?q=%s")
+ ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")
+ ("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"")))
+#+end_src
+
+If the replacement text contains the string =%s=, it is replaced with
+the tag. Using =%h= instead of =%s= percent-encodes the tag (see the
+example above, where we need to encode the URL parameter). Using
+=%(my-function)= passes the tag to a custom Lisp function, and replace
+it by the resulting string.
+
+If the replacement text do not contain any specifier, it is simply
+appended to the string in order to create the link.
+
+Instead of a string, you may also specify a Lisp function to create
+the link. Such a function will be called with the tag as the only
+argument.
+
+With the above setting, you could link to a specific bug with
+=[[bugzilla:129]]=, search the web for =OrgMode= with =[[duckduckgo:OrgMode]]=,
+show the map location of the Free Software Foundation =[[gmap:51
+Franklin Street, Boston]]= or of Carsten office =[[omap:Science Park 904,
+Amsterdam, The Netherlands]]= and find out what the Org author is doing
+besides Emacs hacking with =[[ads:Dominik,C]]=.
+
+If you need special abbreviations just for a single Org buffer, you
+can define them in the file with
+
+#+cindex: @samp{LINK}, keyword
+#+begin_example
+,#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
+,#+LINK: duckduckgo https://duckduckgo.com/?q=%s
+#+end_example
+
+In-buffer completion (see [[*Completion]]) can be used after =[= to
+complete link abbreviations. You may also define a Lisp 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 should return the full link with a prefix. You can set
+the link completion function like this:
+
+#+begin_src emacs-lisp
+(org-link-set-parameter "type" :complete #'some-completion-function)
+#+end_src
+
+** Search Options in File Links
+:PROPERTIES:
+:DESCRIPTION: Linking to a specific location.
+:ALT_TITLE: Search Options
+:END:
+#+cindex: search option in file links
+#+cindex: file links, searching
+#+cindex: attachment links, searching
+
+File links can contain additional information to make Emacs jump to a
+particular location in the file when following a link. This can be a
+line number or a search option after a double colon[fn:34]. For
+example, when the command ~org-store-link~ creates a link (see
+[[*Handling Links]]) to a file, it encodes the words in the current line
+as a search string that can be used to find this line back later when
+following the link with {{{kbd(C-c C-o)}}}.
+
+Note that all search options apply for Attachment links in the same
+way that they apply for File links.
+
+Here is the syntax of the different ways to attach a search to a file
+link, together with explanations for each:
+
+#+begin_example
+[[file:~/code/main.c::255]]
+[[file:~/xx.org::My Target]]
+[[file:~/xx.org::*My Target]]
+[[file:~/xx.org::#my-custom-id]]
+[[file:~/xx.org::/regexp/]]
+[[attachment:main.c::255]]
+#+end_example
+
+- =255= ::
+
+ Jump to line 255.
+
+- =My Target= ::
+
+ Search for a link target =<<My Target>>=, or do a text search for
+ =my target=, similar to the search in internal links, see [[*Internal
+ Links]]. In HTML export (see [[*HTML Export]]), such a file link becomes
+ a HTML reference to the corresponding named anchor in the linked
+ file.
+
+- =*My Target= ::
+
+ In an Org file, restrict search to headlines.
+
+- =#my-custom-id= ::
+
+ Link to a heading with a =CUSTOM_ID= property
+
+- =/REGEXP/= ::
+
+ Do a regular expression search for {{{var(REGEXP)}}}. This uses the
+ Emacs command ~occur~ to list all matches in a separate window. If
+ the target file is in Org mode, ~org-occur~ is used to create
+ a sparse tree with the matches.
+
+As a degenerate case, a file link with an empty file name can be used
+to search the current file. For example, =[[file:::find me]]= does
+a search for =find me= in the current file, just as =[[find me]]=
+would.
+
+** Custom Searches
+:PROPERTIES:
+:DESCRIPTION: When the default search is not enough.
+:END:
+#+cindex: custom search strings
+#+cindex: search strings, custom
+
+The default mechanism for creating search strings and for doing the
+actual search related to a file link may not work correctly in all
+cases. For example, BibTeX database files have many entries like
+~year="1993"~ which would not result in good search strings, because
+the only unique identification for a BibTeX entry is the citation key.
+
+#+vindex: org-create-file-search-functions
+#+vindex: org-execute-file-search-functions
+If you come across such a problem, you can write custom functions to
+set the right search string for a particular file type, and to do the
+search for the string in the file. Using ~add-hook~, these functions
+need to be added to the hook variables
+~org-create-file-search-functions~ and
+~org-execute-file-search-functions~. See the docstring for these
+variables for more information. Org actually uses this mechanism for
+BibTeX database files, and you can use the corresponding code as an
+implementation example. See the file =ol-bibtex.el=.
+
+* TODO Items
+:PROPERTIES:
+:DESCRIPTION: Every tree branch can be a TODO item.
+:END:
+#+cindex: TODO items
+
+Org mode does not maintain TODO lists as separate documents[fn:35].
+Instead, TODO items are an integral part of the notes file, because
+TODO items usually come up while taking notes! With Org mode, simply
+mark any entry in a tree as being a TODO item. In this way,
+information is not duplicated, and the entire context from which the
+TODO item emerged is always present.
+
+Of course, this technique for managing TODO items scatters them
+throughout your notes file. Org mode compensates for this by
+providing methods to give you an overview of all the things that you
+have to do.
+
+** Basic TODO Functionality
+:PROPERTIES:
+:DESCRIPTION: Marking and displaying TODO entries.
+:ALT_TITLE: TODO Basics
+:END:
+
+Any headline becomes a TODO item when it starts with the word =TODO=,
+for example:
+
+: *** TODO Write letter to Sam Fortune
+
+The most important commands to work with TODO entries are:
+
+- {{{kbd(C-c C-t)}}} (~org-todo~) ::
+
+ #+kindex: C-c C-t
+ #+cindex: cycling, of TODO states
+ Rotate the TODO state of the current item among
+
+ #+begin_example
+ ,-> (unmarked) -> TODO -> DONE --.
+ '--------------------------------'
+ #+end_example
+
+ If TODO keywords have fast access keys (see [[*Fast access to TODO
+ states]]), prompt for a TODO keyword through the fast selection
+ interface; this is the default behavior when
+ ~org-use-fast-todo-selection~ is non-~nil~.
+
+ The same state changing can also be done "remotely" from the agenda
+ buffer with the {{{kbd(t)}}} command key (see [[*Commands in the
+ Agenda Buffer]]).
+
+- {{{kbd(S-RIGHT)}}} {{{kbd(S-LEFT)}}} ::
+
+ #+kindex: S-RIGHT
+ #+kindex: S-LEFT
+ #+vindex: org-treat-S-cursor-todo-selection-as-state-change
+ Select the following/preceding TODO state, similar to cycling.
+ Useful mostly if more than two TODO states are possible (see
+ [[*Extended Use of TODO Keywords]]). See also [[*Packages that conflict
+ with Org mode]], for a discussion of the interaction with
+ shift-selection. See also the variable
+ ~org-treat-S-cursor-todo-selection-as-state-change~.
+
+- {{{kbd(C-c / t)}}} (~org-show-todo-tree~) ::
+
+ #+kindex: C-c / t
+ #+cindex: sparse tree, for TODO
+ #+vindex: org-todo-keywords
+ #+findex: org-show-todo-tree
+ View TODO items in a /sparse tree/ (see [[*Sparse Trees]]). Folds the
+ entire buffer, but shows all TODO items---with not-DONE state---and
+ the headings hierarchy above them. With a prefix argument, or by
+ using {{{kbd(C-c / T)}}}, search for a specific TODO. You are
+ prompted for the keyword, and you can also give a list of keywords
+ like =KWD1|KWD2|...= to list entries that match any one of these
+ keywords. With a numeric prefix argument N, show the tree for the
+ Nth keyword in the variable ~org-todo-keywords~. With two prefix
+ arguments, find all TODO states, both un-done and done.
+
+- {{{kbd(M-x org-agenda t)}}} (~org-todo-list~) ::
+
+ #+kindex: t @r{(Agenda dispatcher)}
+ Show the global TODO list. Collects the TODO items (with not-DONE
+ states) from all agenda files (see [[*Agenda Views]]) into a single
+ buffer. The new buffer is in Org Agenda mode, which provides
+ commands to examine and manipulate the TODO entries from the new
+ buffer (see [[*Commands in the Agenda Buffer]]). See [[*The global TODO
+ list]], for more information.
+
+- {{{kbd(S-M-RET)}}} (~org-insert-todo-heading~) ::
+
+ #+kindex: S-M-RET
+ #+findex: org-insert-todo-heading
+ Insert a new TODO entry below the current one.
+
+#+vindex: org-todo-state-tags-triggers
+Changing a TODO state can also trigger tag changes. See the docstring
+of the option ~org-todo-state-tags-triggers~ for details.
+
+** Extended Use of TODO Keywords
+:PROPERTIES:
+:DESCRIPTION: Workflow and assignments.
+:ALT_TITLE: TODO Extensions
+:END:
+#+cindex: extended TODO keywords
+
+#+vindex: org-todo-keywords
+By default, marked TODO entries have one of only two states: TODO and
+DONE. Org mode allows you to classify TODO items in more complex ways
+with /TODO keywords/ (stored in ~org-todo-keywords~). With special
+setup, the TODO keyword system can work differently in different
+files.
+
+Note that /tags/ are another way to classify headlines in general and
+TODO items in particular (see [[*Tags]]).
+
+*** TODO keywords as workflow states
+:PROPERTIES:
+:DESCRIPTION: From TODO to DONE in steps.
+:ALT_TITLE: Workflow states
+:END:
+#+cindex: TODO workflow
+#+cindex: workflow states as TODO keywords
+
+You can use TODO keywords to indicate different, possibly /sequential/
+states in the process of working on an item, for example[fn:36]:
+
+#+begin_src emacs-lisp
+(setq org-todo-keywords
+ '((sequence "TODO" "FEEDBACK" "VERIFY" "|" "DONE" "DELEGATED")))
+#+end_src
+
+The vertical bar separates the TODO keywords (states that /need
+action/) from the DONE states (which need /no further action/). If
+you do not provide the separator bar, the last state is used as the
+DONE state.
+
+#+cindex: completion, of TODO keywords
+With this setup, the command {{{kbd(C-c C-t)}}} cycles an entry from
+=TODO= to =FEEDBACK=, then to =VERIFY=, and finally to =DONE= and
+=DELEGATED=. You may also use a numeric prefix argument to quickly
+select a specific state. For example {{{kbd(C-3 C-c C-t)}}} changes
+the state immediately to =VERIFY=. Or you can use {{{kbd(S-RIGHT)}}}
+and {{{kbd(S-LEFT)}}} to go forward and backward through the states.
+If you define many keywords, you can use in-buffer completion (see
+[[*Completion]]) or a special one-key selection scheme (see [[*Fast
+access to TODO states]]) to insert these words into the buffer.
+Changing a TODO state can be logged with a timestamp, see [[*Tracking
+TODO state changes]], for more information.
+
+*** TODO keywords as types
+:PROPERTIES:
+:DESCRIPTION: I do this, Fred does the rest.
+:ALT_TITLE: TODO types
+:END:
+#+cindex: TODO types
+#+cindex: names as TODO keywords
+#+cindex: types as TODO keywords
+
+The second possibility is to use TODO keywords to indicate different
+/types/ of action items. For example, you might want to indicate that
+items are for "work" or "home". Or, when you work with several people
+on a single project, you might want to assign action items directly to
+persons, by using their names as TODO keywords. This type of
+functionality is actually much better served by using tags (see
+[[*Tags]]), so the TODO implementation is kept just for backward
+compatibility.
+
+Using TODO types, it would be set up like this:
+
+#+begin_src emacs-lisp
+(setq org-todo-keywords '((type "Fred" "Sara" "Lucy" "|" "DONE")))
+#+end_src
+
+In this case, different keywords do not indicate states, 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)}}}[fn:37]. When used several times in succession, it still
+cycles 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 M-x org-agenda
+t)}}}.
+
+*** Multiple keyword sets in one file
+:PROPERTIES:
+:DESCRIPTION: Mixing it all, still finding your way.
+:ALT_TITLE: Multiple sets in one file
+:END:
+#+cindex: TODO keyword sets
+
+Sometimes you may want to use different sets of TODO keywords in
+parallel. For example, you may want to have the basic TODO/DONE, but
+also a workflow for bug fixing, and a separate state indicating that
+an item has been canceled---so it is not DONE, but also does not
+require action. Your setup would then look like this:
+
+#+begin_src emacs-lisp
+(setq org-todo-keywords
+ '((sequence "TODO" "|" "DONE")
+ (sequence "REPORT" "BUG" "KNOWNCAUSE" "|" "FIXED")
+ (sequence "|" "CANCELED")))
+#+end_src
+
+The keywords should all be different, this helps Org mode keep track
+of which subsequence should be used for a given entry. In this setup,
+{{{kbd(C-c C-t)}}} only operates within a sub-sequence, so it switches
+from =DONE= to (nothing) to =TODO=, and from =FIXED= to (nothing) to
+=REPORT=. Therefore you need a mechanism to initially select the
+correct sequence. In addition to typing a keyword or using completion
+(see [[*Completion]]), you may also apply the following commands:
+
+#+attr_texinfo: :sep ,
+- {{{kbd(C-u C-u C-c C-t)}}}, {{{kbd(C-S-RIGHT)}}}, {{{kbd(C-S-LEFT)}}} ::
+
+ #+kindex: C-S-RIGHT
+ #+kindex: C-S-LEFT
+ #+kindex: C-u C-u C-c C-t
+ These keys jump from one TODO sub-sequence to the next. In the
+ above example, {{{kbd(C-u C-u C-c C-t)}}} or {{{kbd(C-S-RIGHT)}}}
+ would jump from =TODO= or =DONE= to =REPORT=, and any of the words
+ in the second row to =CANCELED=. Note that the {{{kbd(C-S-)}}} key
+ binding conflict with shift-selection (see [[*Packages that conflict
+ with Org mode]]).
+
+- {{{kbd(S-RIGHT)}}}, {{{kbd(S-LEFT)}}} ::
+
+ #+kindex: S-RIGHT
+ #+kindex: S-LEFT
+ {{{kbd(S-LEFT)}}} and {{{kbd(S-RIGHT)}}} walk through /all/ keywords
+ from all sub-sequences, so for example {{{kbd(S-RIGHT)}}} would
+ switch from =DONE= to =REPORT= in the example above. For
+ a discussion of the interaction with shift-selection, see [[*Packages
+ that conflict with Org mode]].
+
+*** Fast access to TODO states
+:PROPERTIES:
+:DESCRIPTION: Single letter selection of state.
+:END:
+
+If you would like to quickly change an entry to an arbitrary TODO
+state instead of cycling through the states, you can set up keys for
+single-letter access to the states. This is done by adding the
+selection character after each keyword, in parentheses[fn:38]. For
+example:
+
+#+begin_src emacs-lisp
+(setq org-todo-keywords
+ '((sequence "TODO(t)" "|" "DONE(d)")
+ (sequence "REPORT(r)" "BUG(b)" "KNOWNCAUSE(k)" "|" "FIXED(f)")
+ (sequence "|" "CANCELED(c)")))
+#+end_src
+
+#+vindex: org-fast-tag-selection-include-todo
+If you then press {{{kbd(C-c C-t)}}} followed by the selection key,
+the entry is switched to this state. {{{kbd(SPC)}}} can be used to
+remove any TODO keyword from an entry[fn:39].
+
+*** Setting up keywords for individual files
+:PROPERTIES:
+:DESCRIPTION: Different files, different requirements.
+:ALT_TITLE: Per-file keywords
+:END:
+#+cindex: keyword options
+#+cindex: per-file keywords
+#+cindex: @samp{TODO}, keyword
+#+cindex: @samp{TYP_TODO}, keyword
+#+cindex: @samp{SEQ_TODO}, keyword
+
+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:
+
+: #+TODO: TODO FEEDBACK VERIFY | DONE CANCELED
+
+You may also write =#+SEQ_TODO= to be explicit about the
+interpretation, but it means the same as =#+TODO=, or
+
+: #+TYP_TODO: Fred Sara Lucy Mike | DONE
+
+A setup for using several sets in parallel would be:
+
+#+begin_example
+,#+TODO: TODO | DONE
+,#+TODO: REPORT BUG KNOWNCAUSE | FIXED
+,#+TODO: | CANCELED
+#+end_example
+
+#+cindex: completion, of option keywords
+#+kindex: M-TAB
+To make sure you are using the correct keyword, type =#+= into the
+buffer and then use {{{kbd(M-TAB)}}} to complete it (see [[*Completion]]).
+
+#+cindex: DONE, final TODO keyword
+Remember that the keywords after the vertical bar---or the last
+keyword if no bar is there---must always mean that the item is DONE,
+although you may use a different word. After changing one of these
+lines, use {{{kbd(C-c C-c)}}} with point still in the line to make the
+changes known to Org mode[fn:40].
+
+*** Faces for TODO keywords
+:PROPERTIES:
+:DESCRIPTION: Highlighting states.
+:END:
+#+cindex: faces, for TODO keywords
+
+#+vindex: org-todo, face
+#+vindex: org-done, face
+#+vindex: org-todo-keyword-faces
+Org mode highlights TODO keywords with special faces: ~org-todo~ for
+keywords indicating that an item still has to be acted upon, and
+~org-done~ for keywords indicating that an item is finished. If you
+are using more than two different states, you might want to use
+special faces for some of them. This can be done using the variable
+~org-todo-keyword-faces~. For example:
+
+#+begin_src emacs-lisp
+(setq org-todo-keyword-faces
+ '(("TODO" . org-warning) ("STARTED" . "yellow")
+ ("CANCELED" . (:foreground "blue" :weight bold))))
+#+end_src
+
+#+vindex: org-faces-easy-properties
+While using a list with face properties as shown for =CANCELED=
+/should/ work, this does not always seem to be the case. If
+necessary, define a special face and use that. A string is
+interpreted as a color. The variable ~org-faces-easy-properties~
+determines if that color is interpreted as a foreground or
+a background color.
+
+*** TODO dependencies
+:PROPERTIES:
+:DESCRIPTION: When one task needs to wait for others.
+:END:
+#+cindex: TODO dependencies
+#+cindex: dependencies, of TODO states
+
+#+vindex: org-enforce-todo-dependencies
+#+cindex: @samp{ORDERED}, property
+The structure of Org files---hierarchy and lists---makes it easy to
+define TODO dependencies. Usually, a parent TODO task should not be
+marked as done until all TODO subtasks, or children tasks, are marked
+as done. Sometimes there is a logical sequence to (sub)tasks, so that
+one subtask cannot be acted upon before all siblings above it have
+been marked as done. If you customize the variable
+~org-enforce-todo-dependencies~, Org blocks entries from changing
+state to DONE while they have TODO children that are not DONE.
+Furthermore, if an entry has a property =ORDERED=, each of its TODO
+children is blocked until all earlier siblings are marked as done.
+Here is an example:
+
+#+begin_example
+,* TODO Blocked until (two) is done
+,** DONE one
+,** TODO two
+
+,* Parent
+:PROPERTIES:
+:ORDERED: t
+:END:
+,** TODO a
+,** TODO b, needs to wait for (a)
+,** TODO c, needs to wait for (a) and (b)
+#+end_example
+
+#+cindex: TODO dependencies, @samp{NOBLOCKING}
+#+cindex: @samp{NOBLOCKING}, property
+You can ensure an entry is never blocked by using the =NOBLOCKING=
+property (see [[*Properties and Columns]]):
+
+#+begin_example
+,* This entry is never blocked
+:PROPERTIES:
+:NOBLOCKING: t
+:END:
+#+end_example
+
+- {{{kbd(C-c C-x o)}}} (~org-toggle-ordered-property~) ::
+
+ #+kindex: C-c C-x o
+ #+findex: org-toggle-ordered-property
+ #+vindex: org-track-ordered-property-with-tag
+ Toggle the =ORDERED= property of the current entry. A property is
+ used for this behavior because this should be local to the current
+ entry, not inherited from entries above like a tag (see [[*Tags]]).
+ However, if you would like to /track/ the value of this property
+ with a tag for better visibility, customize the variable
+ ~org-track-ordered-property-with-tag~.
+
+- {{{kbd(C-u C-u C-u C-c C-t)}}} ::
+
+ #+kindex: C-u C-u C-u C-u C-c C-t
+ Change TODO state, regardless of any state blocking.
+
+#+vindex: org-agenda-dim-blocked-tasks
+If you set the variable ~org-agenda-dim-blocked-tasks~, TODO entries
+that cannot be marked as done because of unmarked children are shown
+in a dimmed font or even made invisible in agenda views (see [[*Agenda
+Views]]).
+
+#+cindex: checkboxes and TODO dependencies
+#+vindex: org-enforce-todo-dependencies
+You can also block changes of TODO states by using checkboxes (see
+[[*Checkboxes]]). If you set the variable
+~org-enforce-todo-checkbox-dependencies~, an entry that has unchecked
+checkboxes is blocked from switching to DONE.
+
+If you need more complex dependency structures, for example
+dependencies between entries in different trees or files, check out
+the contributed module =org-depend.el=.
+
+** Progress Logging
+:PROPERTIES:
+:DESCRIPTION: Dates and notes for progress.
+:END:
+#+cindex: progress logging
+#+cindex: logging, of progress
+
+To record a timestamp and a note when changing a TODO state, call the
+command ~org-todo~ with a prefix argument.
+
+- {{{kbd(C-u C-c C-t)}}} (~org-todo~) ::
+
+ #+kindex: C-u C-c C-t
+ Prompt for a note and record a the time of the TODO state change.
+ The note is inserted as a list item below the headline, but can also
+ be placed into a drawer, see [[*Tracking TODO state changes]].
+
+If you want to be more systematic, Org mode can automatically record a
+timestamp and optionally a note when you mark a TODO item as DONE, or
+even each time you change the state of a TODO item. This system is
+highly configurable, settings can be on a per-keyword basis and can be
+localized to a file or even a subtree. For information on how to
+clock working time for a task, see [[*Clocking Work Time]].
+
+*** Closing items
+:PROPERTIES:
+:DESCRIPTION: When was this entry marked as done?
+:END:
+
+The most basic automatic logging is to keep track of /when/ a certain
+TODO item was marked as done. This can be achieved with[fn:41]
+
+#+begin_src emacs-lisp
+(setq org-log-done 'time)
+#+end_src
+
+#+vindex: org-closed-keep-when-no-todo
+#+texinfo: @noindent
+Then each time you turn an entry from a TODO (not-done) state into any
+of the DONE states, a line =CLOSED: [timestamp]= is inserted just
+after the headline. If you turn the entry back into a TODO item
+through further state cycling, that line is removed again. If you
+turn the entry back to a non-TODO state (by pressing {{{kbd(C-c C-t
+SPC)}}} for example), that line is also removed, unless you set
+~org-closed-keep-when-no-todo~ to non-~nil~. If you want to record
+a note along with the timestamp, use[fn:42]
+
+#+begin_src emacs-lisp
+(setq org-log-done 'note)
+#+end_src
+
+#+texinfo: @noindent
+You are then prompted for a note, and that note is stored below the
+entry with a =Closing Note= heading.
+
+*** Tracking TODO state changes
+:PROPERTIES:
+:DESCRIPTION: When did the status change?
+:END:
+#+cindex: drawer, for state change recording
+
+#+vindex: org-log-states-order-reversed
+#+vindex: org-log-into-drawer
+#+cindex: @samp{LOG_INTO_DRAWER}, property
+You might want to automatically keep track of when a state change
+occurred and maybe take a note about this change. You can either
+record just a timestamp, or a time-stamped note. These records are
+inserted after the headline as an itemized list, newest first[fn:43].
+When taking a lot of notes, you might want to get the notes out of the
+way into a drawer (see [[*Drawers]]). Customize the variable
+~org-log-into-drawer~ to get this behavior---the recommended drawer
+for this is called =LOGBOOK=[fn:44]. You can also overrule the
+setting of this variable for a subtree by setting a =LOG_INTO_DRAWER=
+property.
+
+Since it is normally too much to record a note for every state, Org
+mode expects configuration on a per-keyword basis for this. This is
+achieved by adding special markers =!= (for a timestamp) or =@= (for
+a note with timestamp) in parentheses after each keyword. For
+example, with the setting
+
+#+begin_src emacs-lisp
+(setq org-todo-keywords
+ '((sequence "TODO(t)" "WAIT(w@/!)" "|" "DONE(d!)" "CANCELED(c@)")))
+#+end_src
+
+#+texinfo: @noindent
+To record a timestamp without a note for TODO keywords configured with
+=@=, just type {{{kbd(C-c C-c)}}} to enter a blank note when prompted.
+
+#+vindex: org-log-done
+You not only define global TODO keywords and fast access keys, but
+also request that a time is recorded when the entry is set to =DONE=,
+and that a note is recorded when switching to =WAIT= or
+=CANCELED=[fn:45]. The setting for =WAIT= is even more special: the
+=!= after the slash means that in addition to the note taken when
+entering the state, a timestamp should be recorded when /leaving/ the
+=WAIT= state, if and only if the /target/ state does not configure
+logging for entering it. So it has no effect when switching from
+=WAIT= to =DONE=, because =DONE= is configured to record a timestamp
+only. But when switching from =WAIT= back to =TODO=, the =/!= in the
+=WAIT= setting now triggers a timestamp even though =TODO= has no
+logging configured.
+
+You can use the exact same syntax for setting logging preferences local
+to a buffer:
+
+: #+TODO: TODO(t) WAIT(w@/!) | DONE(d!) CANCELED(c@)
+
+#+cindex: @samp{LOGGING}, property
+In order to define logging settings that are local to a subtree or
+a single item, define a =LOGGING= property in this entry. Any
+non-empty =LOGGING= property resets all logging settings to ~nil~.
+You may then turn on logging for this specific tree using =STARTUP=
+keywords like =lognotedone= or =logrepeat=, as well as adding state
+specific settings like =TODO(!)=. For example:
+
+#+begin_example
+,* TODO Log each state with only a time
+ :PROPERTIES:
+ :LOGGING: TODO(!) WAIT(!) DONE(!) CANCELED(!)
+ :END:
+,* TODO Only log when switching to WAIT, and when repeating
+ :PROPERTIES:
+ :LOGGING: WAIT(@) logrepeat
+ :END:
+,* TODO No logging at all
+ :PROPERTIES:
+ :LOGGING: nil
+ :END:
+#+end_example
+
+*** Tracking your habits
+:PROPERTIES:
+:DESCRIPTION: How consistent have you been?
+:END:
+#+cindex: habits
+#+cindex: @samp{STYLE}, property
+
+Org has the ability to track the consistency of a special category of
+TODO, called "habits." To use habits, you have to enable the ~habits~
+module by customizing the variable ~org-modules~.
+
+A habit has the following properties:
+
+1. The habit is a TODO item, with a TODO keyword representing an open
+ state.
+
+2. The property =STYLE= is set to the value =habit= (see [[*Properties
+ and Columns]]).
+
+3. The TODO has a scheduled date, usually with a =.+= style repeat
+ interval. A =++= style may be appropriate for habits with time
+ constraints, e.g., must be done on weekends, or a =+= style for an
+ unusual habit that can have a backlog, e.g., weekly reports.
+
+4. The TODO may also have minimum and maximum ranges specified by
+ using the syntax =.+2d/3d=, which says that you want to do the task
+ at least every three days, but at most every two days.
+
+5. State logging for the DONE state is enabled (see [[*Tracking TODO
+ state changes]]), in order for historical data to be represented in
+ the consistency graph. If it is not enabled it is not an error,
+ but the consistency graphs are largely meaningless.
+
+To give you an idea of what the above rules look like in action, here's an
+actual habit with some history:
+
+#+begin_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]
+ - State "DONE" from "TODO" [2009-10-04 Sun]
+ - State "DONE" from "TODO" [2009-10-02 Fri]
+ - State "DONE" from "TODO" [2009-09-29 Tue]
+ - State "DONE" from "TODO" [2009-09-25 Fri]
+ - State "DONE" from "TODO" [2009-09-19 Sat]
+ - State "DONE" from "TODO" [2009-09-16 Wed]
+ - State "DONE" from "TODO" [2009-09-12 Sat]
+#+end_example
+
+What this habit says is: I want to shave at most every 2 days---given
+by the =SCHEDULED= date and repeat interval---and at least every
+4 days. If today is the 15th, then the habit first appears in the
+agenda (see [[*Agenda Views]]) on Oct 17, after the minimum of 2 days has
+elapsed, and will appear overdue on Oct 19, after four days have
+elapsed.
+
+What's really useful about habits is that they are displayed along
+with a consistency graph, to show how consistent you've been at
+getting that task done in the past. This graph shows every day that
+the task was done over the past three weeks, with colors for each day.
+The colors used are:
+
+- Blue :: If the task was not to be done yet on that day.
+- Green :: If the task could have been done on that day.
+- Yellow :: If the task was going to be overdue the next day.
+- Red :: If the task was overdue on that day.
+
+In addition to coloring each day, the day is also marked with an
+asterisk if the task was actually done that day, and an exclamation
+mark to show where the current day falls in the graph.
+
+There are several configuration variables that can be used to change
+the way habits are displayed in the agenda.
+
+- ~org-habit-graph-column~ ::
+
+ #+vindex: org-habit-graph-column
+ The buffer column at which the consistency graph should be drawn.
+ This overwrites any text in that column, so it is a good idea to
+ keep your habits' titles brief and to the point.
+
+- ~org-habit-preceding-days~ ::
+
+ #+vindex: org-habit-preceding-days
+ The amount of history, in days before today, to appear in
+ consistency graphs.
+
+- ~org-habit-following-days~ ::
+
+ #+vindex: org-habit-following-days
+ The number of days after today that appear in consistency graphs.
+
+- ~org-habit-show-habits-only-for-today~ ::
+
+ #+vindex: org-habit-show-habits-only-for-today
+ If non-~nil~, only show habits in today's agenda view. The default
+ value is ~t~. Pressing {{{kbd(C-u K)}}} in the agenda toggles this
+ variable.
+
+Lastly, pressing {{{kbd(K)}}} in the agenda buffer causes habits to
+temporarily be disabled and do not 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.
+
+** Priorities
+:PROPERTIES:
+:DESCRIPTION: Some things are more important than others.
+:END:
+#+cindex: priorities
+#+cindex: priority cookie
+
+If you use Org mode extensively, you may end up with enough TODO items
+that it starts to make sense to prioritize them. Prioritizing can be
+done by placing a /priority cookie/ into the headline of a TODO item
+right after the TODO keyword, like this:
+
+: *** TODO [#A] Write letter to Sam Fortune
+
+#+vindex: org-priority-faces
+By default, Org mode supports three priorities: =A=, =B=, and =C=.
+=A= is the highest priority. An entry without a cookie is treated as
+equivalent if it had priority =B=. Priorities make a difference only
+for sorting in the agenda (see [[*Weekly/daily agenda]]). Outside the
+agenda, they have no inherent meaning to Org mode. The cookies are
+displayed with the face defined by the variable ~org-priority-faces~,
+which can be customized.
+
+You can also use numeric values for priorities, such as
+
+: *** TODO [#1] Write letter to Sam Fortune
+
+When using numeric priorities, you need to set ~org-priority-highest~,
+~org-priority-lowest~ and ~org-priority-default~ to integers, which
+must all be strictly inferior to 65.
+
+Priorities can be attached to any outline node; they do not need to be
+TODO items.
+
+#+attr_texinfo: :sep ;
+- {{{kbd(C-c \,)}}} (~org-priority~) ::
+
+ #+kindex: C-c ,
+ #+findex: org-priority
+ Set the priority of the current headline. The command prompts for
+ a priority character =A=, =B= or =C=. When you press {{{kbd(SPC)}}}
+ instead, the priority cookie, if one is set, is removed from the
+ headline. The priorities can also be changed "remotely" from the
+ agenda buffer with the {{{kbd(\,)}}} command (see [[*Commands in the
+ Agenda Buffer]]).
+
+- {{{kbd(S-UP)}}} (~org-priority-up~); {{{kbd(S-DOWN)}}} (~org-priority-down~) ::
+
+ #+kindex: S-UP
+ #+kindex: S-DOWN
+ #+findex: org-priority-up
+ #+findex: org-priority-down
+ #+vindex: org-priority-start-cycle-with-default
+ Increase/decrease the priority of the current headline[fn:46]. Note
+ that these keys are also used to modify timestamps (see [[*Creating
+ Timestamps]]). See also [[*Packages that conflict with Org mode]], for
+ a discussion of the interaction with shift-selection.
+
+#+vindex: org-priority-highest
+#+vindex: org-priority-lowest
+#+vindex: org-priority-default
+You can change the range of allowed priorities by setting the
+variables ~org-priority-highest~, ~org-priority-lowest~, and
+~org-priority-default~. For an individual buffer, you may set these
+values (highest, lowest, default) like this (please make sure that the
+highest priority is earlier in the alphabet than the lowest priority):
+
+#+cindex: @samp{PRIORITIES}, keyword
+: #+PRIORITIES: A C B
+
+Or, using numeric values:
+
+: #+PRIORITIES: 1 10 5
+
+** Breaking Down Tasks into Subtasks
+:PROPERTIES:
+:DESCRIPTION: Splitting a task into manageable pieces.
+:ALT_TITLE: Breaking Down Tasks
+:END:
+#+cindex: tasks, breaking down
+#+cindex: statistics, for TODO items
+
+#+vindex: org-agenda-todo-list-sublevels
+It is often advisable to break down large tasks into smaller,
+manageable subtasks. You can do this by creating an outline tree
+below a TODO item, with detailed subtasks on the tree[fn:47]. To keep
+an overview of the fraction of subtasks that have already been marked
+as done, insert either =[/]= or =[%]= anywhere in the headline. These
+cookies are updated each time the TODO status of a child changes, or
+when pressing {{{kbd(C-c C-c)}}} on the cookie. For example:
+
+#+begin_example
+,* Organize Party [33%]
+,** TODO Call people [1/2]
+,*** TODO Peter
+,*** DONE Sarah
+,** TODO Buy food
+,** DONE Talk to neighbor
+#+end_example
+
+#+cindex: @samp{COOKIE_DATA}, property
+If a heading has both checkboxes and TODO children below it, the
+meaning of the statistics cookie become ambiguous. Set the property
+=COOKIE_DATA= to either =checkbox= or =todo= to resolve this issue.
+
+#+vindex: org-hierarchical-todo-statistics
+If you would like to have the statistics cookie count any TODO entries
+in the subtree (not just direct children), configure the variable
+~org-hierarchical-todo-statistics~. To do this for a single subtree,
+include the word =recursive= into the value of the =COOKIE_DATA=
+property.
+
+#+begin_example org
+,* Parent capturing statistics [2/20]
+ :PROPERTIES:
+ :COOKIE_DATA: todo recursive
+ :END:
+#+end_example
+
+If you would like a TODO entry to automatically change to DONE when
+all children are done, you can use the following setup:
+
+#+begin_src emacs-lisp
+(defun org-summary-todo (n-done n-not-done)
+ "Switch entry to DONE when all subentries are done, to TODO otherwise."
+ (let (org-log-done org-log-states) ; turn off logging
+ (org-todo (if (= n-not-done 0) "DONE" "TODO"))))
+
+(add-hook 'org-after-todo-statistics-hook 'org-summary-todo)
+#+end_src
+
+Another possibility is the use of checkboxes to identify (a hierarchy
+of) a large number of subtasks (see [[*Checkboxes]]).
+
+** Checkboxes
+:PROPERTIES:
+:DESCRIPTION: Tick-off lists.
+:END:
+#+cindex: checkboxes
+
+#+vindex: org-list-automatic-rules
+Every item in a plain list[fn:48] (see [[*Plain Lists]]) can be made into
+a checkbox by starting it with the string =[ ]=. This feature is
+similar to TODO items (see [[*TODO Items]]), but is more lightweight.
+Checkboxes are not included into 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.
+
+Here is an example of a checkbox list.
+
+#+begin_example
+,* TODO Organize party [2/4]
+ - [-] call people [1/3]
+ - [ ] Peter
+ - [X] Sarah
+ - [ ] Sam
+ - [X] order food
+ - [ ] think about what music to play
+ - [X] talk to the neighbors
+#+end_example
+
+Checkboxes work hierarchically, so if a checkbox item has children
+that are checkboxes, toggling one of the children checkboxes makes the
+parent checkbox reflect if none, some, or all of the children are
+checked.
+
+#+cindex: statistics, for checkboxes
+#+cindex: checkbox statistics
+#+cindex: @samp{COOKIE_DATA}, property
+#+vindex: org-hierarchical-checkbox-statistics
+The =[2/4]= and =[1/3]= in the first and second line are cookies
+indicating how many checkboxes present in this entry have been checked
+off, and the total number of checkboxes present. This can give you an
+idea on how many checkboxes remain, even without opening a folded
+entry. The cookies can be placed into a headline or into (the first
+line of) a plain list item. Each cookie covers checkboxes of direct
+children structurally below the headline/item on which the cookie
+appears[fn:49]. You have to insert the cookie yourself by typing
+either =[/]= or =[%]=. With =[/]= you get an =n out of m= result, as
+in the examples above. With =[%]= you get information about the
+percentage of checkboxes checked (in the above example, this would be
+=[50%]= and =[33%]=, respectively). In a headline, a cookie can count
+either checkboxes below the heading or TODO states of children, and it
+displays whatever was changed last. Set the property =COOKIE_DATA= to
+either =checkbox= or =todo= to resolve this issue.
+
+#+cindex: blocking, of checkboxes
+#+cindex: checkbox blocking
+#+cindex: @samp{ORDERED}, property
+If the current outline node has an =ORDERED= property, checkboxes must
+be checked off in sequence, and an error is thrown if you try to check
+off a box while there are unchecked boxes above it.
+
+The following commands work with checkboxes:
+
+- {{{kbd(C-c C-c)}}} (~org-toggle-checkbox~) ::
+
+ #+kindex: C-c C-c
+ #+findex: org-toggle-checkbox
+ Toggle checkbox status or---with prefix argument---checkbox presence
+ at point. With a single prefix argument, add an empty checkbox or
+ remove the current one[fn:50]. With a double prefix argument, set
+ it to =[-]=, which is considered to be an intermediate state.
+
+- {{{kbd(C-c C-x C-b)}}} (~org-toggle-checkbox~) ::
+
+ #+kindex: C-c C-x C-b
+ Toggle checkbox status or---with prefix argument---checkbox presence
+ at point. With double prefix argument, set it to =[-]=, which is
+ considered to be an intermediate state.
+
+ - 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 argument, add or remove the checkbox for all
+ items in the region.
+
+ - If point is in a headline, toggle checkboxes in the region between
+ this headline and the next---so /not/ the entire subtree.
+
+ - If there is no active region, just toggle the checkbox at point.
+
+- {{{kbd(C-c C-x C-r)}}} (~org-toggle-radio-button~) ::
+
+ #+kindex: C-c C-x C-r
+ #+findex: org-toggle-radio-button
+ #+cindex: radio button, checkbox as
+ Toggle checkbox status by using the checkbox of the item at point as
+ a radio button: when the checkbox is turned on, all other checkboxes
+ on the same level will be turned off. With a universal prefix
+ argument, toggle the presence of the checkbox. With a double prefix
+ argument, set it to =[-]=.
+
+ #+findex: org-list-checkbox-radio-mode
+ {{{kbd(C-c C-c)}}} can be told to consider checkboxes as radio buttons by
+ setting =#+ATTR_ORG: :radio t= right before the list or by calling
+ {{{kbd(M-x org-list-checkbox-radio-mode)}}} to activate this minor mode.
+
+- {{{kbd(M-S-RET)}}} (~org-insert-todo-heading~) ::
+
+ #+kindex: M-S-RET
+ #+findex: org-insert-todo-heading
+ Insert a new item with a checkbox. This works only if point is
+ already in a plain list item (see [[*Plain Lists]]).
+
+- {{{kbd(C-c C-x o)}}} (~org-toggle-ordered-property~) ::
+
+ #+kindex: C-c C-x o
+ #+findex: org-toggle-ordered-property
+ #+vindex: org-track-ordered-property-with-tag
+ Toggle the =ORDERED= property of the entry, to toggle if checkboxes
+ must be checked off in sequence. A property is used for this
+ behavior because this should be local to the current entry, not
+ inherited like a tag. However, if you would like to /track/ the
+ value of this property with a tag for better visibility, customize
+ ~org-track-ordered-property-with-tag~.
+
+- {{{kbd(C-c #)}}} (~org-update-statistics-cookies~) ::
+
+ #+kindex: C-c #
+ #+findex: org-update-statistics-cookies
+ Update the statistics cookie in the current outline entry. When
+ called with a {{{kbd(C-u)}}} prefix, update the entire file.
+ Checkbox statistic cookies are updated automatically if you toggle
+ checkboxes with {{{kbd(C-c C-c)}}} and make new ones with
+ {{{kbd(M-S-RET)}}}. TODO statistics cookies update when changing
+ TODO states. If you delete boxes/entries or add/change them by
+ hand, use this command to get things back into sync.
+
+* Tags
+:PROPERTIES:
+:DESCRIPTION: Tagging headlines and matching sets of tags.
+:END:
+#+cindex: tags
+#+cindex: headline tagging
+#+cindex: matching, tags
+#+cindex: sparse tree, tag based
+
+An excellent way to implement labels and contexts for
+cross-correlating information is to assign /tags/ to headlines. Org
+mode has extensive support for tags.
+
+#+vindex: org-tag-faces
+Every headline can contain a list of tags; they occur at the end of
+the headline. Tags are normal words containing letters, numbers, =_=,
+and =@=. Tags must be preceded and followed by a single colon, e.g.,
+=:work:=. Several tags can be specified, as in =:work:urgent:=. Tags
+by default are in bold face with the same color as the headline. You
+may specify special faces for specific tags using the variable
+~org-tag-faces~, in much the same way as you can for TODO keywords
+(see [[*Faces for TODO keywords]]).
+
+** Tag Inheritance
+:PROPERTIES:
+:DESCRIPTION: Tags use the tree structure of an outline.
+:END:
+#+cindex: tag inheritance
+#+cindex: inheritance, of tags
+#+cindex: sublevels, inclusion into tags match
+
+/Tags/ make use of the hierarchical structure of outline trees. If
+a heading has a certain tag, all subheadings inherit the tag as well.
+For example, in the list
+
+#+begin_example
+,* Meeting with the French group :work:
+,** Summary by Frank :boss:notes:
+,*** TODO Prepare slides for him :action:
+#+end_example
+
+#+texinfo: @noindent
+the final heading has the tags =work=, =boss=, =notes=, and =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[fn:51]
+
+#+cindex: @samp{FILETAGS}, keyword
+: #+FILETAGS: :Peter:Boss:Secret:
+
+#+vindex: org-use-tag-inheritance
+#+vindex: org-tags-exclude-from-inheritance
+To limit tag inheritance to specific tags, or to turn it off entirely,
+use the variables ~org-use-tag-inheritance~ and
+~org-tags-exclude-from-inheritance~.
+
+#+vindex: org-tags-match-list-sublevels
+When a headline matches during a tags search while tag inheritance is
+turned on, all the sublevels in the same tree---for a simple match
+form---match as well[fn:52]. The list of matches may then become
+very long. If you only want to see the first tags match in a subtree,
+configure the variable ~org-tags-match-list-sublevels~ (not
+recommended).
+
+#+vindex: org-agenda-use-tag-inheritance
+Tag inheritance is relevant when the agenda search tries to match
+a tag, either in the ~tags~ or ~tags-todo~ agenda types. In other
+agenda types, ~org-use-tag-inheritance~ has no effect. Still, you may
+want to have your tags correctly set in the agenda, so that tag
+filtering works fine, with inherited tags. Set
+~org-agenda-use-tag-inheritance~ to control this: the default value
+includes all agenda types, but setting this to ~nil~ can really speed
+up agenda generation.
+
+** Setting Tags
+:PROPERTIES:
+:DESCRIPTION: How to assign tags to a headline.
+:END:
+#+cindex: setting tags
+#+cindex: tags, setting
+
+#+kindex: M-TAB
+Tags can simply be typed into the buffer at the end of a headline.
+After a colon, {{{kbd(M-TAB)}}} offers completion on tags. There is
+also a special command for inserting tags:
+
+- {{{kbd(C-c C-q)}}} (~org-set-tags-command~) ::
+
+ #+kindex: C-c C-q
+ #+findex: org-set-tags-command
+ #+cindex: completion, of tags
+ #+vindex: org-tags-column
+ Enter new tags for the current headline. Org mode either offers
+ completion or a special single-key interface for setting tags, see
+ below. After pressing {{{kbd(RET)}}}, the tags are inserted and
+ aligned to ~org-tags-column~. When called with a {{{kbd(C-u)}}}
+ prefix, all tags in the current buffer are aligned to that column,
+ just to make things look nice. Tags are automatically realigned
+ after promotion, demotion, and TODO state changes (see [[*Basic TODO
+ Functionality]]).
+
+- {{{kbd(C-c C-c)}}} (~org-set-tags-command~) ::
+
+ #+kindex: C-c C-c
+ When point is in a headline, this does the same as {{{kbd(C-c
+ C-q)}}}.
+
+#+vindex: org-complete-tags-always-offer-all-agenda-tags
+#+vindex: org-tag-alist
+#+cindex: @samp{TAGS}, keyword
+Org supports tag insertion based on a /list of tags/. By default this
+list is constructed dynamically, containing all tags currently used in
+the buffer[fn:53]. You may also globally specify a hard list of tags
+with the variable ~org-tag-alist~. Finally you can set the default
+tags for a given file using the =TAGS= keyword, like
+
+#+begin_example
+,#+TAGS: @work @home @tennisclub
+,#+TAGS: laptop car pc sailboat
+#+end_example
+
+If you have globally defined your preferred set of tags using the
+variable ~org-tag-alist~, but would like to use a dynamic tag list in
+a specific file, add an empty =TAGS= keyword to that file:
+
+: #+TAGS:
+
+#+vindex: org-tag-persistent-alist
+If you have a preferred set of tags that you would like to use in
+every file, in addition to those defined on a per-file basis by =TAGS=
+keyword, then you may specify a list of tags with the variable
+~org-tag-persistent-alist~. You may turn this off on a per-file basis
+by adding a =STARTUP= keyword to that file:
+
+: #+STARTUP: noptag
+
+By default Org mode uses the standard minibuffer completion facilities
+for entering tags. However, it also implements another, quicker, tag
+selection method called /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
+~org-tag-alist~ in your Emacs init file. For example, you may find
+the need to tag many items in different files with =@home=. In this
+case you can set something like:
+
+#+begin_src emacs-lisp
+(setq org-tag-alist '(("@work" . ?w) ("@home" . ?h) ("laptop" . ?l)))
+#+end_src
+
+If the tag is only relevant to the file you are working on, then you
+can instead set the =TAGS= keyword as:
+
+: #+TAGS: @work(w) @home(h) @tennisclub(t) laptop(l) pc(p)
+
+The tags interface shows the available tags in a splash window. If
+you want to start a new line after a specific tag, insert =\n= into
+the tag list
+
+: #+TAGS: @work(w) @home(h) @tennisclub(t) \n laptop(l) pc(p)
+
+#+texinfo: @noindent
+or write them in two lines:
+
+#+begin_example
+,#+TAGS: @work(w) @home(h) @tennisclub(t)
+,#+TAGS: laptop(l) pc(p)
+#+end_example
+
+You can also group together tags that are mutually exclusive by using
+braces, as in:
+
+: #+TAGS: { @work(w) @home(h) @tennisclub(t) } laptop(l) pc(p)
+
+#+texinfo: @noindent
+you indicate that at most one of =@work=, =@home=, and =@tennisclub=
+should be selected. Multiple such groups are allowed.
+
+Do not forget to press {{{kbd(C-c C-c)}}} with point in one of these
+lines to activate any changes.
+
+To set these mutually exclusive groups in the variable
+~org-tags-alist~, you must use the dummy tags ~:startgroup~ and
+~:endgroup~ instead of the braces. Similarly, you can use ~:newline~
+to indicate a line break. The previous example would be set globally
+by the following configuration:
+
+#+begin_src emacs-lisp
+(setq org-tag-alist '((:startgroup . nil)
+ ("@work" . ?w) ("@home" . ?h)
+ ("@tennisclub" . ?t)
+ (:endgroup . nil)
+ ("laptop" . ?l) ("pc" . ?p)))
+#+end_src
+
+If at least one tag has a selection key then pressing {{{kbd(C-c
+C-c)}}} automatically presents you with a special interface, listing
+inherited tags, the tags of the current headline, and a list of all
+valid tags with corresponding keys[fn:54].
+
+Pressing keys assigned to tags adds or removes them from the list of
+tags in the current line. Selecting a tag in a group of mutually
+exclusive tags turns off any other tag from that group.
+
+In this interface, you can also use the following special keys:
+
+- {{{kbd(TAB)}}} ::
+
+ #+kindex: TAB
+ Enter a tag in the minibuffer, even if the tag is not in the
+ predefined list. You can complete on all tags present in the
+ buffer. You can also add several tags: just separate them with
+ a comma.
+
+- {{{kbd(SPC)}}} ::
+
+ #+kindex: SPC
+ Clear all tags for this line.
+
+- {{{kbd(RET)}}} ::
+
+ #+kindex: RET
+ Accept the modified set.
+
+- {{{kbd(C-g)}}} ::
+
+ #+kindex: C-g
+ Abort without installing changes.
+
+- {{{kbd(q)}}} ::
+
+ #+kindex: q
+ If {{{kbd(q)}}} is not assigned to a tag, it aborts like
+ {{{kbd(C-g)}}}.
+
+- {{{kbd(!)}}} ::
+
+ #+kindex: !
+ Turn off groups of mutually exclusive tags. Use this to (as an
+ exception) assign several tags from such a group.
+
+- {{{kbd(C-c)}}} ::
+
+ #+kindex: C-c C-c
+ Toggle auto-exit after the next change (see below). If you are
+ using expert mode, the first {{{kbd(C-c)}}} displays the selection
+ window.
+
+This method lets you assign tags to a headline with very few keys.
+With the above setup, you could clear the current tags and set
+=@home=, =laptop= and =pc= tags with just the following keys:
+{{{kbd(C-c C-c SPC h l p RET)}}}. Switching from =@home= to =@work=
+would be done with {{{kbd(C-c C-c w RET)}}} or alternatively with
+{{{kbd(C-c C-c C-c w)}}}. Adding the non-predefined tag =sarah= could
+be done with {{{kbd(C-c C-c TAB s a r a h RET)}}}.
+
+#+vindex: org-fast-tag-selection-single-key
+If you find that most of the time you need only a single key press to
+modify your list of tags, set the variable
+~org-fast-tag-selection-single-key~. Then you no longer have to press
+{{{kbd(RET)}}} to exit fast tag selection---it exits after the first
+change. If you then occasionally need more keys, press {{{kbd(C-c)}}}
+to turn off auto-exit for the current tag selection process (in
+effect: start selection with {{{kbd(C-c C-c C-c)}}} instead of
+{{{kbd(C-c C-c)}}}). If you set the variable to the value ~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)}}}.
+
+** Tag Hierarchy
+:PROPERTIES:
+:DESCRIPTION: Create a hierarchy of tags.
+:END:
+#+cindex: group tags
+#+cindex: tags, groups
+#+cindex: tags hierarchy
+
+Tags can be defined in hierarchies. A tag can be defined as a /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 group tags and
+nesting them creates a tag hierarchy.
+
+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 return matches for all members in
+the group and its subgroups. In an agenda view, filtering by a group
+tag displays 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:
+
+: #+TAGS: [ GTD : Control Persp ]
+
+In this example, =GTD= is the group tag and it is related to two other
+tags: =Control=, =Persp=. Defining =Control= and =Persp= as group
+tags creates a hierarchy of tags:
+
+#+begin_example
+,#+TAGS: [ Control : Context Task ]
+,#+TAGS: [ Persp : Vision Goal AOF Project ]
+#+end_example
+
+That can conceptually be seen as a hierarchy of tags:
+
+- =GTD=
+ - =Persp=
+ - =Vision=
+ - =Goal=
+ - =AOF=
+ - =Project=
+ - =Control=
+ - =Context=
+ - =Task=
+
+You can use the ~:startgrouptag~, ~:grouptags~ and ~:endgrouptag~
+keyword directly when setting ~org-tag-alist~ directly:
+
+#+begin_src emacs-lisp
+(setq org-tag-alist '((:startgrouptag)
+ ("GTD")
+ (:grouptags)
+ ("Control")
+ ("Persp")
+ (:endgrouptag)
+ (:startgrouptag)
+ ("Control")
+ (:grouptags)
+ ("Context")
+ ("Task")
+ (:endgrouptag)))
+#+end_src
+
+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.
+
+: #+TAGS: { Context : @Home @Work @Call }
+
+When setting ~org-tag-alist~ you can use ~:startgroup~ and ~:endgroup~
+instead of ~:startgrouptag~ and ~:endgrouptag~ to make the tags
+mutually exclusive.
+
+Furthermore, the members of a 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 curly brackets. Here is an expanded example:
+
+#+begin_example
+,#+TAGS: [ Vision : {V@.+} ]
+,#+TAGS: [ Goal : {G@.+} ]
+,#+TAGS: [ AOF : {AOF@.+} ]
+,#+TAGS: [ Project : {P@.+} ]
+#+end_example
+
+Searching for the tag =Project= now lists all tags also including
+regular expression matches for =P@.+=, and similarly for tag searches
+on =Vision=, =Goal= and =AOF=. For example, this would work well for
+a project tagged with a common project-identifier, e.g.,
+=P@2014_OrgTags=.
+
+#+kindex: C-c C-x q
+#+findex: org-toggle-tags-groups
+#+vindex: org-group-tags
+If you want to ignore group tags temporarily, toggle group tags
+support with ~org-toggle-tags-groups~, bound to {{{kbd(C-c C-x q)}}}.
+If you want to disable tag groups completely, set ~org-group-tags~ to
+~nil~.
+
+** Tag Searches
+:PROPERTIES:
+:DESCRIPTION: Searching for combinations of tags.
+:END:
+#+cindex: tag searches
+#+cindex: searching for tags
+
+Once a system of tags has been set up, it can be used to collect
+related information into special lists.
+
+- {{{kbd(C-c / m)}}} or {{{kbd(C-c \)}}} (~org-match-sparse-tree~) ::
+
+ #+kindex: C-c / m
+ #+kindex: C-c \
+ #+findex: org-match-sparse-tree
+ Create a sparse tree with all headlines matching a tags search.
+ With a {{{kbd(C-u)}}} prefix argument, ignore headlines that are not
+ a TODO line.
+
+- {{{kbd(M-x org-agenda m)}}} (~org-tags-view~) ::
+
+ #+kindex: m @r{(Agenda dispatcher)}
+ #+findex: org-tags-view
+ Create a global list of tag matches from all agenda files. See
+ [[*Matching tags and properties]].
+
+- {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) ::
+
+ #+kindex: M @r{(Agenda dispatcher)}
+ #+vindex: org-tags-match-list-sublevels
+ Create a global list of tag matches from all agenda files, but check
+ only TODO items and force checking subitems (see the option
+ ~org-tags-match-list-sublevels~).
+
+These commands all prompt for a match string which allows basic
+Boolean logic like =+boss+urgent-project1=, to find entries with tags
+=boss= and =urgent=, but not =project1=, or =Kathy|Sally= to find
+entries which are tagged, like =Kathy= or =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 [[*Matching tags and properties]].
+
+* Properties and Columns
+:PROPERTIES:
+:DESCRIPTION: Storing information about an entry.
+:END:
+#+cindex: properties
+
+A property is a key-value pair associated with an entry. Properties
+can be set so they are associated with a single entry, with every
+entry in a tree, or with the whole buffer.
+
+There are two main applications for properties in Org mode. First,
+properties are like tags, but with a value. Imagine maintaining
+a file where you document bugs and plan releases for a piece of
+software. Instead of using tags like =release_1=, =release_2=, you
+can use a property, say =Release=, that in different subtrees has
+different values, such as =1.0= or =2.0=. Second, you can use
+properties to implement (very basic) database capabilities in an Org
+buffer. Imagine keeping track of your music CDs, where properties
+could be things such as the album, artist, date of release, number of
+tracks, and so on.
+
+Properties can be conveniently edited and viewed in column view (see
+[[*Column View]]).
+
+** Property Syntax
+:PROPERTIES:
+:DESCRIPTION: How properties are spelled out.
+:END:
+#+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 (see [[*Drawers]]) with the name =PROPERTIES=, which has to be
+located right below a headline, and its planning line (see [[*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:
+
+#+begin_example
+,* CD collection
+,** Classic
+,*** Goldberg Variations
+ :PROPERTIES:
+ :Title: Goldberg Variations
+ :Composer: J.S. Bach
+ :Artist: Glenn Gould
+ :Publisher: Deutsche Grammophon
+ :NDisks: 1
+ :END:
+#+end_example
+
+Depending on the value of ~org-use-property-inheritance~, a property
+set this way is associated either with a single entry, or with the
+sub-tree defined by the entry, see [[*Property Inheritance]].
+
+You may define the allowed values for a particular property =Xyz= by
+setting a property =Xyz_ALL=. This special property is /inherited/,
+so if you set it in a level 1 entry, it applies to the entire tree.
+When allowed values are defined, setting the corresponding property
+becomes easier and is less prone to typing errors. For the example
+with the CD collection, we can pre-define publishers and the number of
+disks in a box like this:
+
+#+begin_example
+,* CD collection
+ :PROPERTIES:
+ :NDisks_ALL: 1 2 3 4
+ :Publisher_ALL: "Deutsche Grammophon" Philips EMI
+ :END:
+#+end_example
+
+Properties can be inserted on buffer level. That means they apply
+before the first headline and can be inherited by all entries in a
+file. Property blocks defined before first headline needs to be
+located at the top of the buffer, allowing only comments above.
+
+Properties can also be defined using lines like:
+
+#+cindex: @samp{_ALL} suffix, in properties
+#+cindex: @samp{PROPERTY}, keyword
+: #+PROPERTY: NDisks_ALL 1 2 3 4
+
+#+cindex: @samp{+} suffix, in properties
+If you want to add to the value of an existing property, append a =+=
+to the property name. The following results in the property =var=
+having the value =foo=1 bar=2=.
+
+#+begin_example
+,#+PROPERTY: var foo=1
+,#+PROPERTY: var+ bar=2
+#+end_example
+
+It is also possible to add to the values of inherited properties. The
+following results in the =Genres= property having the value =Classic
+Baroque= under the =Goldberg Variations= subtree.
+
+#+begin_example
+,* CD collection
+,** Classic
+ :PROPERTIES:
+ :Genres: Classic
+ :END:
+,*** Goldberg Variations
+ :PROPERTIES:
+ :Title: Goldberg Variations
+ :Composer: J.S. Bach
+ :Artist: Glenn Gould
+ :Publisher: Deutsche Grammophon
+ :NDisks: 1
+ :Genres+: Baroque
+ :END:
+#+end_example
+
+Note that a property can only have one entry per drawer.
+
+#+vindex: org-global-properties
+Property values set with the global variable ~org-global-properties~
+can be inherited by all entries in all Org files.
+
+The following commands help to work with properties:
+
+#+attr_texinfo: :sep ,
+- {{{kbd(M-TAB)}}} (~pcomplete~) ::
+
+ #+kindex: M-TAB
+ #+findex: pcomplete
+ After an initial colon in a line, complete property keys. All keys
+ used in the current file are offered as possible completions.
+
+- {{{kbd(C-c C-x p)}}} (~org-set-property~) ::
+
+ #+kindex: C-c C-x p
+ #+findex: org-set-property
+ Set a property. This prompts for a property name and a value. If
+ necessary, the property drawer is created as well.
+
+- {{{kbd(C-u M-x org-insert-drawer)}}} ::
+
+ #+findex: org-insert-drawer
+ Insert a property drawer into the current entry. The drawer is
+ inserted early in the entry, but after the lines with planning
+ information like deadlines. If before first headline the drawer is
+ inserted at the top of the drawer after any potential comments.
+
+- {{{kbd(C-c C-c)}}} (~org-property-action~) ::
+
+ #+kindex: C-c C-c
+ #+findex: org-property-action
+ With point in a property drawer, this executes property commands.
+
+- {{{kbd(C-c C-c s)}}} (~org-set-property~) ::
+
+ #+kindex: C-c C-c s
+ #+findex: org-set-property
+ Set a property in the current entry. Both the property and the
+ value can be inserted using completion.
+
+- {{{kbd(S-RIGHT)}}} (~org-property-next-allowed-values~), {{{kbd(S-LEFT)}}} (~org-property-previous-allowed-value~) ::
+
+ #+kindex: S-RIGHT
+ #+kindex: S-LEFT
+ Switch property at point to the next/previous allowed value.
+
+- {{{kbd(C-c C-c d)}}} (~org-delete-property~) ::
+
+ #+kindex: C-c C-c d
+ #+findex: org-delete-property
+ Remove a property from the current entry.
+
+- {{{kbd(C-c C-c D)}}} (~org-delete-property-globally~) ::
+
+ #+kindex: C-c C-c D
+ #+findex: org-delete-property-globally
+ Globally remove a property, from all entries in the current file.
+
+- {{{kbd(C-c C-c c)}}} (~org-compute-property-at-point~) ::
+
+ #+kindex: C-c C-c c
+ #+findex: org-compute-property-at-point
+ Compute the property at point, using the operator and scope from the
+ nearest column format definition.
+
+** Special Properties
+:PROPERTIES:
+:DESCRIPTION: Access to other Org mode features.
+:END:
+#+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 (see [[*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: @samp{ALLTAGS}, special property
+#+cindex: @samp{BLOCKED}, special property
+#+cindex: @samp{CLOCKSUM}, special property
+#+cindex: @samp{CLOCKSUM_T}, special property
+#+cindex: @samp{CLOSED}, special property
+#+cindex: @samp{DEADLINE}, special property
+#+cindex: @samp{FILE}, special property
+#+cindex: @samp{ITEM}, special property
+#+cindex: @samp{PRIORITY}, special property
+#+cindex: @samp{SCHEDULED}, special property
+#+cindex: @samp{TAGS}, special property
+#+cindex: @samp{TIMESTAMP}, special property
+#+cindex: @samp{TIMESTAMP_IA}, special property
+#+cindex: @samp{TODO}, special property
+| =ALLTAGS= | All tags, including inherited ones. |
+| =BLOCKED= | ~t~ if task is currently blocked by children or siblings. |
+| =CATEGORY= | The category of an entry. |
+| =CLOCKSUM= | The sum of CLOCK intervals in the subtree. ~org-clock-sum~ |
+| | must be run first to compute the values in the current buffer. |
+| =CLOCKSUM_T= | The sum of CLOCK intervals in the subtree for today. |
+| | ~org-clock-sum-today~ must be run first to compute the |
+| | values in the current buffer. |
+| =CLOSED= | When was this entry closed? |
+| =DEADLINE= | The deadline timestamp. |
+| =FILE= | The filename the entry is located in. |
+| =ITEM= | The headline of the entry. |
+| =PRIORITY= | The priority of the entry, a string with a single letter. |
+| =SCHEDULED= | The scheduling timestamp. |
+| =TAGS= | The tags defined directly in the headline. |
+| =TIMESTAMP= | The first keyword-less timestamp in the entry. |
+| =TIMESTAMP_IA= | The first inactive timestamp in the entry. |
+| =TODO= | The TODO keyword of the entry. |
+
+** Property Searches
+:PROPERTIES:
+:DESCRIPTION: Matching property values.
+:END:
+#+cindex: properties, searching
+#+cindex: searching, of properties
+
+To create sparse trees and special lists with selection based on
+properties, the same commands are used as for tag searches (see [[*Tag
+Searches]]).
+
+- {{{kbd(C-c / m)}}} or {{{kbd(C-c \)}}} (~org-match-sparse-tree~) ::
+
+ #+kindex: C-c / m
+ #+kindex: C-c \
+ #+findex: org-match-sparse-tree
+ Create a sparse tree with all matching entries. With
+ a {{{kbd(C-u)}}} prefix argument, ignore headlines that are not
+ a TODO line.
+
+- {{{kbd(M-x org-agenda m)}}} (~org-tags-view~) ::
+
+ #+kindex: m @r{(Agenda dispatcher)}
+ #+findex: org-tags-view
+ Create a global list of tag/property matches from all agenda files.
+
+- {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) ::
+
+ #+kindex: M @r{(Agenda dispatcher)}
+ #+vindex: org-tags-match-list-sublevels
+ Create a global list of tag matches from all agenda files, but check
+ only TODO items and force checking of subitems (see the option
+ ~org-tags-match-list-sublevels~).
+
+The syntax for the search string is described in [[*Matching tags and
+properties]].
+
+There is also a special command for creating sparse trees based on a
+single property:
+
+- {{{kbd(C-c / p)}}} ::
+
+ #+kindex: C-c / p
+ Create a sparse tree based on the value of a property. This first
+ prompts for the name of a property, and then for a value. A sparse
+ tree is created with all entries that define this property with the
+ given value. If you enclose the value in curly braces, it is
+ interpreted as a regular expression and matched against the property
+ values.
+
+** Property Inheritance
+:PROPERTIES:
+:DESCRIPTION: Passing values down a tree.
+:END:
+#+cindex: properties, inheritance
+#+cindex: inheritance, of properties
+
+#+vindex: org-use-property-inheritance
+The outline structure of Org documents lends itself to an inheritance
+model of properties: if the parent in a tree has a certain property,
+the children can inherit this property. Org mode does not turn this
+on by default, because it can slow down property searches
+significantly and is often not needed. However, if you find
+inheritance useful, you can turn it on by setting the variable
+~org-use-property-inheritance~. It may be set to ~t~ to make all
+properties inherited from the parent, to a list of properties that
+should be inherited, or to a regular expression that matches inherited
+properties. If a property has the value ~nil~, this is interpreted as
+an explicit un-define of the property, so that inheritance search
+stops at this value and returns ~nil~.
+
+Org mode has a few properties for which inheritance is hard-coded, at
+least for the special applications for which they are used:
+
+- ~COLUMNS~ ::
+
+ #+cindex: @samp{COLUMNS}, property
+ The =COLUMNS= property defines the format of column view (see
+ [[*Column View]]). It is inherited in the sense that the level where
+ a =COLUMNS= property is defined is used as the starting point for
+ a column view table, independently of the location in the subtree
+ from where columns view is turned on.
+
+- ~CATEGORY~ ::
+
+ #+cindex: @samp{CATEGORY}, property
+ For agenda view, a category set through a =CATEGORY= property
+ applies to the entire subtree.
+
+- ~ARCHIVE~ ::
+
+ #+cindex: @samp{ARCHIVE}, property
+ For archiving, the =ARCHIVE= property may define the archive
+ location for the entire subtree (see [[*Moving a tree to an archive
+ file]]).
+
+- ~LOGGING~ ::
+
+ #+cindex: @samp{LOGGING}, property
+ The =LOGGING= property may define logging settings for an entry or
+ a subtree (see [[*Tracking TODO state changes]]).
+
+** Column View
+:PROPERTIES:
+:DESCRIPTION: Tabular viewing and editing.
+:END:
+
+A great way to view and edit properties in an outline tree is /column
+view/. In column view, each outline node is turned into a table row.
+Columns in this table provide access to properties of the entries.
+Org mode implements columns by overlaying a tabular structure over the
+headline of each item. While the headlines have been turned into
+a table row, you can still change the visibility of the outline tree.
+For example, you get a compact table by switching to "contents"
+view---{{{kbd(S-TAB)}}} {{{kbd(S-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 (see
+[[*Agenda Views]]) where queries have collected selected items, possibly
+from a number of files.
+
+*** Defining columns
+:PROPERTIES:
+:DESCRIPTION: The COLUMNS format property.
+:END:
+#+cindex: column view, for properties
+#+cindex: properties, column view
+
+Setting up a column view first requires defining the columns. This is
+done by defining a column format line.
+
+**** Scope of column definitions
+:PROPERTIES:
+:DESCRIPTION: Where defined, where valid?
+:END:
+
+To specify a format that only applies to a specific tree, add
+a =COLUMNS= property to the top node of that tree, for example:
+
+#+begin_example
+,** Top node for columns view
+ :PROPERTIES:
+ :COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
+ :END:
+#+end_example
+
+A =COLUMNS= property within a property drawer before first headline
+will apply to the entire file. As an addition to property drawers,
+keywords can also be defined for an entire file using a line like:
+
+#+cindex: @samp{COLUMNS}, keyword
+: #+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
+
+If a =COLUMNS= property is present in an entry, it defines columns for
+the entry itself, and for the entire subtree below it. Since the
+column definition is part of the hierarchical structure of the
+document, 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.
+
+**** Column attributes
+:PROPERTIES:
+:DESCRIPTION: Appearance and content of a column.
+:END:
+
+A column definition sets the attributes of a column. The general
+definition looks like this:
+
+: %[WIDTH]PROPERTY[(TITLE)][{SUMMARY-TYPE}]
+
+#+texinfo: @noindent
+Except for the percent sign and the property name, all items are
+optional. The individual parts have the following meaning:
+
+- {{{var(WIDTH)}}} ::
+
+ An integer specifying the width of the column in characters. If
+ omitted, the width is determined automatically.
+
+- {{{var(PROPERTY)}}} ::
+
+ The property that should be edited in this column. Special
+ properties representing meta data are allowed here as well (see
+ [[*Special Properties]]).
+
+- {{{var(TITLE)}}} ::
+
+ The header text for the column. If omitted, the property name is
+ used.
+
+- {{{var(SUMMARY-TYPE)}}} ::
+
+ The summary type. If specified, the column values for parent nodes
+ are computed from the children[fn:55].
+
+ Supported summary types are:
+
+ | =+= | Sum numbers in this column. |
+ | =+;%.1f= | Like =+=, but format result with =%.1f=. |
+ | =$= | Currency, short for =+;%.2f=. |
+ | =min= | Smallest number in column. |
+ | =max= | Largest number. |
+ | =mean= | Arithmetic mean of numbers. |
+ | =X= | Checkbox status, =[X]= if all children are =[X]=. |
+ | =X/= | Checkbox status, =[n/m]=. |
+ | =X%= | Checkbox status, =[n%]=. |
+ | =:= | Sum times, HH:MM, plain numbers are minutes. |
+ | =:min= | Smallest time value in column. |
+ | =:max= | Largest time value. |
+ | =:mean= | Arithmetic mean of time values. |
+ | =@min= | Minimum age[fn:56] (in days/hours/mins/seconds). |
+ | =@max= | Maximum age (in days/hours/mins/seconds). |
+ | =@mean= | Arithmetic mean of ages (in days/hours/mins/seconds). |
+ | =est+= | Add low-high estimates. |
+
+ #+vindex: org-columns-summary-types
+ You can also define custom summary types by setting
+ ~org-columns-summary-types~.
+
+The =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 do not 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, =est+= adds
+the statistical mean and variance of the subtasks, generating a final
+estimate from the sum. For example, suppose you had ten tasks, each
+of which was estimated at 0.5 to 2 days of work. Straight addition
+produces an estimate of 5 to 20 days, representing what to expect if
+everything goes either extremely well or extremely poorly. In
+contrast, =est+= estimates the full job more realistically, at 10--15
+days.
+
+Here is an example for a complete columns definition, along with
+allowed values[fn:57].
+
+#+begin_example
+:COLUMNS: %25ITEM %9Approved(Approved?){X} %Owner %11Status \
+ %10Time_Estimate{:} %CLOCKSUM %CLOCKSUM_T
+:Owner_ALL: Tammy Mark Karl Lisa Don
+:Status_ALL: "In progress" "Not started yet" "Finished" ""
+:Approved_ALL: "[ ]" "[X]"
+#+end_example
+
+#+texinfo: @noindent
+The first column, =%25ITEM=, means the first 25 characters of the item
+itself, i.e., of the headline. You probably always should start the
+column definition with the =ITEM= specifier. The other specifiers
+create columns =Owner= with a list of names as allowed values, for
+=Status= with four different possible values, and for a checkbox field
+=Approved=. When no width is given after the =%= character, the
+column is exactly as wide as it needs to be in order to fully display
+all values. The =Approved= column does have a modified title
+(=Approved?=, with a question mark). Summaries are created for the
+=Time_Estimate= column by adding time duration expressions like HH:MM,
+and for the =Approved= column, by providing an =[X]= status if all
+children have been checked. The =CLOCKSUM= and =CLOCKSUM_T= columns
+are special, they lists the sums of CLOCK intervals in the subtree,
+either for all clocks or just for today.
+
+*** Using column view
+:PROPERTIES:
+:DESCRIPTION: How to create and use column view.
+:END:
+
+**** Turning column view on or off
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c C-x C-c)}}} (~org-columns~) ::
+
+ #+kindex: C-c C-x C-c
+ #+vindex: org-columns
+ #+vindex: org-columns-default-format
+ Turn on column view. If point is before the first headline in the
+ file, column view is turned on for the entire file, using the
+ =#+COLUMNS= definition. If point is somewhere inside the outline,
+ this command searches the hierarchy, up from point, for a =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 =COLUMNS= property. If no such property is found, the
+ format is taken from the =#+COLUMNS= line or from the variable
+ ~org-columns-default-format~, and column view is established for the
+ current entry and its subtree.
+
+- {{{kbd(r)}}} or {{{kbd(g)}}} on a columns view line (~org-columns-redo~) ::
+
+ #+kindex: r
+ #+kindex: g
+ #+findex: org-columns-redo
+ Recreate the column view, to include recent changes made in the
+ buffer.
+
+- {{{kbd(C-c C-c)}}} or {{{kbd(q)}}} on a columns view line (~org-columns-quit~) ::
+
+ #+kindex: q
+ #+kindex: C-c C-c
+ #+findex: org-columns-quit
+ Exit column view.
+
+**** Editing values
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+attr_texinfo: :sep and
+- {{{kbd(LEFT)}}}, {{{kbd(RIGHT)}}}, {{{kbd(UP)}}}, {{{kbd(DOWN)}}} ::
+
+ Move through the column view from field to field.
+
+- {{{kbd(1..9\,0)}}} ::
+
+ #+kindex: 1..9,0
+ Directly select the Nth allowed value, {{{kbd(0)}}} selects the
+ 10th value.
+
+- {{{kbd(n)}}} or {{{kbd(S-RIGHT)}}} (~org-columns-next-allowed-value~) and {{{kbd(p)}}} or {{{kbd(S-LEFT)}}} (~org-columns-previous-allowed-value~) ::
+
+ #+kindex: n
+ #+kindex: S-RIGHT
+ #+kindex: p
+ #+kindex: S-LEFT
+ #+findex: org-columns-next-allowed-value
+ #+findex: org-columns-previous-allowed-value
+ Switch to the next/previous allowed value of the field. For this,
+ you have to have specified allowed values for a property.
+
+- {{{kbd(e)}}} (~org-columns-edit-value~) ::
+
+ #+kindex: e
+ #+findex: org-columns-edit-value
+ Edit the property at point. For the special properties, this
+ invokes the same interface that you normally use to change that
+ property. For example, the tag completion or fast selection
+ interface pops up when editing a =TAGS= property.
+
+- {{{kbd(C-c C-c)}}} (~org-columns-toggle-or-columns-quit~) ::
+
+ #+kindex: C-c C-c
+ #+findex: org-columns-toggle-or-columns-quit
+ When there is a checkbox at point, toggle it. Else exit column
+ view.
+
+- {{{kbd(v)}}} (~org-columns-show-value~) ::
+
+ #+kindex: v
+ #+findex: org-columns-show-value
+ View the full value of this property. This is useful if the width
+ of the column is smaller than that of the value.
+
+- {{{kbd(a)}}} (~org-columns-edit-allowed~) ::
+
+ #+kindex: a
+ #+findex: 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 found, the new value is stored in the first entry that is
+ part of the current column view.
+
+**** Modifying column view on-the-fly
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+attr_texinfo: :sep and
+- {{{kbd(<)}}} (~org-columns-narrow~) and {{{kbd(>)}}} (~org-columns-widen~) ::
+
+ #+kindex: <
+ #+kindex: >
+ #+findex: org-columns-narrow
+ #+findex: org-columns-widen
+ Make the column narrower/wider by one character.
+
+- {{{kbd(S-M-RIGHT)}}} (~org-columns-new~) ::
+
+ #+kindex: S-M-RIGHT
+ #+findex: org-columns-new
+ Insert a new column, to the left of the current column.
+
+- {{{kbd(S-M-LEFT)}}} (~org-columns-delete~) ::
+
+ #+kindex: S-M-LEFT
+ #+findex: org-columns-delete
+ Delete the current column.
+
+*** Capturing column view
+:PROPERTIES:
+:DESCRIPTION: A dynamic block for column view.
+:END:
+
+Since column view is just an overlay over a buffer, it cannot be
+exported or printed directly. If you want to capture a column view,
+use a =columnview= dynamic block (see [[*Dynamic Blocks]]). The frame of
+this block looks like this:
+
+#+cindex: @samp{BEGIN columnview}
+#+begin_example
+,* The column view
+,#+BEGIN: columnview :hlines 1 :id "label"
+
+,#+END:
+#+end_example
+
+This dynamic block has the following parameters:
+
+- =:id= ::
+
+ This is the most important parameter. Column view is a feature that
+ is often localized to a certain (sub)tree, and the capture block
+ might be at a different location in the file. To identify the tree
+ whose view to capture, you can use four values:
+
+ - =local= ::
+
+ Use the tree in which the capture block is located.
+
+ - =global= ::
+
+ Make a global view, including all headings in the file.
+
+ - =file:FILENAME= ::
+
+ Run column view at the top of the {{{var(FILENAME)}}} file.
+
+ - =LABEL= ::
+
+ #+cindex: @samp{ID}, property
+ Call column view in the tree that has an =ID= property with the
+ value {{{var(LABEL)}}}. You can use {{{kbd(M-x org-id-copy)}}} to
+ create a globally unique ID for the current entry and copy it to
+ the kill-ring.
+
+- =:match= ::
+
+ When set to a string, use this as a tags/property match filter to
+ select only a subset of the headlines in the scope set by the ~:id~
+ parameter.
+
+
+- =:hlines= ::
+
+ When ~t~, insert an hline after every line. When a number N, insert
+ an hline before each headline with level ~<= N~.
+
+- =:vlines= ::
+
+ When non-~nil~, force column groups to get vertical lines.
+
+- =:maxlevel= ::
+
+ When set to a number, do not capture entries below this level.
+
+- =:skip-empty-rows= ::
+
+ When non-~nil~, skip rows where the only non-empty specifier of
+ the column view is =ITEM=.
+
+- =:exclude-tags= ::
+
+ List of tags to exclude from column view table: entries with these
+ tags will be excluded from the column view.
+
+- =:indent= ::
+
+ When non-~nil~, indent each =ITEM= field according to its level.
+
+- =:format= ::
+
+ Specify a column attribute (see [[*Column attributes]]) for the dynamic
+ block.
+
+The following commands insert or update the dynamic block:
+
+- ~org-columns-insert-dblock~ ::
+
+ #+kindex: C-c C-x x
+ #+findex: org-columns-insert-dblock
+ Insert a dynamic block capturing a column view. Prompt for the
+ scope or ID of the view.
+
+ This command can be invoked by calling
+ ~org-dynamic-block-insert-dblock~ ({{{kbd(C-c C-x x)}}}) and
+ selecting "columnview" (see [[*Dynamic Blocks]]).
+
+- {{{kbd(C-c C-c)}}} {{{kbd(C-c C-x C-u)}}} (~org-dblock-update~) ::
+
+ #+kindex: C-c C-c
+ #+kindex: C-c C-x C-u
+ #+findex: org-dblock-update
+ Update dynamic block at point. point needs to be in the =#+BEGIN=
+ line of the dynamic block.
+
+- {{{kbd(C-u C-c C-x C-u)}}} (~org-update-all-dblocks~) ::
+
+ #+kindex: C-u C-c C-x C-u
+ Update all dynamic blocks (see [[*Dynamic Blocks]]). This is useful if
+ you have several clock table blocks, column-capturing blocks or
+ other dynamic blocks in a buffer.
+
+You can add formulas to the column view table and you may add plotting
+instructions in front of the table---these survive an update of the
+block. If there is a =TBLFM= keyword after the table, the table is
+recalculated automatically after an update.
+
+An alternative way to capture and process property values into a table
+is provided by Eric Schulte's =org-collector.el=, which is
+a contributed package[fn:58]. It provides a general API to collect
+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.
+
+* Dates and Times
+:PROPERTIES:
+:DESCRIPTION: Making items useful for planning.
+:END:
+#+cindex: dates
+#+cindex: times
+#+cindex: timestamp
+#+cindex: date stamp
+
+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 /timestamp/ in Org mode. This may be
+a little confusing because timestamp is often used as indicating when
+something was created or last changed. However, in Org mode this term
+is used in a much wider sense.
+
+** Timestamps
+:PROPERTIES:
+:DESCRIPTION: Assigning a time to a tree entry.
+:END:
+#+cindex: timestamps
+#+cindex: ranges, time
+#+cindex: date stamps
+#+cindex: deadlines
+#+cindex: scheduling
+
+A timestamp is a specification of a date (possibly with a time or
+a range of times) in a special format, either =<2003-09-16 Tue>= or
+=<2003-09-16 Tue 09:39>= or =<2003-09-16 Tue 12:00-12:30>=[fn:59].
+A timestamp can appear anywhere in the headline or body of an Org tree
+entry. Its presence causes entries to be shown on specific dates in
+the agenda (see [[*Weekly/daily agenda]]). We distinguish:
+
+- 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 agenda display, the headline of an entry associated with
+ a plain timestamp is shown exactly on that date.
+
+ #+begin_example
+ ,* Meet Peter at the movies
+ <2006-11-01 Wed 19:15>
+ ,* Discussion on climate change
+ <2006-11-02 Thu 20:00-22:00>
+ #+end_example
+
+- Timestamp with repeater interval ::
+
+ #+cindex: timestamp, with repeater interval
+ A timestamp may contain a /repeater interval/, indicating that it
+ applies not only on the given date, but again and again after
+ a certain interval of N days (d), weeks (w), months (m), or years
+ (y). The following shows up in the agenda every Wednesday:
+
+ #+begin_example
+ ,* Pick up Sam at school
+ <2007-05-16 Wed 12:30 +1w>
+ #+end_example
+
+- Diary-style expression entries ::
+
+ #+cindex: diary style timestamps
+ #+cindex: sexp timestamps
+ For more complex date specifications, Org mode supports using the
+ special expression diary entries implemented in the Emacs Calendar
+ package[fn:60]. For example, with optional time:
+
+ #+begin_example
+ ,* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month
+ <%%(diary-float t 4 2)>
+ #+end_example
+
+- Time/Date range ::
+
+ #+cindex: timerange
+ #+cindex: date range
+ Two timestamps connected by =--= denote a range. The headline is
+ shown on the first and last day of the range, and on any dates that
+ are displayed and fall in the range. Here is an example:
+
+ #+begin_example
+ ,** Meeting in Amsterdam
+ <2004-08-23 Mon>--<2004-08-26 Thu>
+ #+end_example
+
+- Inactive timestamp ::
+
+ #+cindex: timestamp, inactive
+ #+cindex: inactive timestamp
+ Just like a plain timestamp, but with square brackets instead of
+ angular ones. These timestamps are inactive in the sense that they
+ do /not/ trigger an entry to show up in the agenda.
+
+ #+begin_example
+ ,* Gillian comes late for the fifth time
+ [2006-11-01 Wed]
+ #+end_example
+
+** Creating Timestamps
+:PROPERTIES:
+:DESCRIPTION: Commands to insert timestamps.
+:END:
+
+For Org mode to recognize timestamps, they need to be in the specific
+format. All commands listed below produce timestamps in the correct
+format.
+
+#+attr_texinfo: :sep ,
+- {{{kbd(C-c .)}}} (~org-time-stamp~) ::
+
+ #+kindex: C-c .
+ #+findex: org-time-stamp
+ Prompt for a date and insert a corresponding timestamp. When point
+ is at an existing timestamp in the buffer, the command is used to
+ modify this timestamp instead of inserting a new one. When this
+ command is used twice in succession, a time range is inserted.
+
+ #+kindex: C-u C-c .
+ #+vindex: org-time-stamp-rounding-minutes
+ When called with a prefix argument, use the alternative format which
+ contains date and time. The default time can be rounded to
+ multiples of 5 minutes. See the option
+ ~org-time-stamp-rounding-minutes~.
+
+ #+kindex: C-u C-u C-c .
+ With two prefix arguments, insert an active timestamp with the
+ current time without prompting.
+
+- {{{kbd(C-c !)}}} (~org-time-stamp-inactive~) ::
+
+ #+kindex: C-c !
+ #+kindex: C-u C-c !
+ #+kindex: C-u C-u C-c !
+ #+findex: org-time-stamp-inactive
+ Like {{{kbd(C-c .)}}}, but insert an inactive timestamp that does
+ not cause an agenda entry.
+
+- {{{kbd(C-c C-c)}}} ::
+
+ #+kindex: C-c C-c
+ Normalize timestamp, insert or fix day name if missing or wrong.
+
+- {{{kbd(C-c <)}}} (~org-date-from-calendar~) ::
+
+ #+kindex: C-c <
+ #+findex: org-date-from-calendar
+ Insert a timestamp corresponding to point date in the calendar.
+
+- {{{kbd(C-c >)}}} (~org-goto-calendar~) ::
+
+ #+kindex: C-c >
+ #+findex: org-goto-calendar
+ Access the Emacs calendar for the current date. If there is
+ a timestamp in the current line, go to the corresponding date
+ instead.
+
+- {{{kbd(C-c C-o)}}} (~org-open-at-point~) ::
+
+ #+kindex: C-c C-o
+ #+findex: org-open-at-point
+ Access the agenda for the date given by the timestamp or -range at
+ point (see [[*Weekly/daily agenda]]).
+
+- {{{kbd(S-LEFT)}}} (~org-timestamp-down-day~), {{{kbd(S-RIGHT)}}} (~org-timestamp-up-day~) ::
+
+ #+kindex: S-LEFT
+ #+kindex: S-RIGHT
+ #+findex: org-timestamp-down-day
+ #+findex: org-timestamp-up-day
+ Change date at point by one day. These key bindings conflict with
+ shift-selection and related modes (see [[*Packages that conflict with
+ Org mode]]).
+
+- {{{kbd(S-UP)}}} (~org-timestamp-up~), {{{kbd(S-DOWN)}}} (~org-timestamp-down~) ::
+
+ #+kindex: S-UP
+ #+kindex: S-DOWN
+ On the beginning or enclosing bracket of a timestamp, change its
+ type. Within a timestamp, change the item under point. Point can
+ be on a year, month, day, hour or minute. When the timestamp
+ contains a time range like =15:30-16:30=, modifying the first time
+ also shifts the second, shifting the time block with constant
+ length. To change the length, modify the second time. Note that if
+ point is in a headline and not at a timestamp, these same keys
+ modify the priority of an item (see [[*Priorities]]). The key bindings
+ also conflict with shift-selection and related modes (see [[*Packages
+ that conflict with Org mode]]).
+
+- {{{kbd(C-c C-y)}}} (~org-evaluate-time-range~) ::
+
+ #+kindex: C-c C-y
+ #+findex: org-evaluate-time-range
+ #+cindex: evaluate time range
+ Evaluate a time range by computing the difference between start and
+ end. With a prefix argument, insert result after the time range (in
+ a table: into the following column).
+
+*** The date/time prompt
+:PROPERTIES:
+:DESCRIPTION: How Org mode helps you enter dates and times.
+:END:
+#+cindex: date, reading in minibuffer
+#+cindex: time, reading in minibuffer
+
+#+vindex: org-read-date-prefer-future
+When Org mode prompts for a date/time, the default is shown in default
+date/time format, and the prompt therefore seems to ask for a specific
+format. But it in fact accepts date/time information in a variety of
+formats. Generally, the information should start at the beginning of
+the string. Org mode finds whatever information is in there and
+derives anything you have not specified from the /default date and
+time/. The default is usually the current date and time, but when
+modifying an existing timestamp, or when entering the second stamp of
+a range, it is taken from the stamp in the buffer. When filling in
+information, Org mode assumes that most of the time you want to enter
+a date in the future: if you omit the month/year and the given
+day/month is /before/ today, it assumes that you mean a future
+date[fn:61]. If the date has been automatically shifted into the
+future, the time prompt shows this with =(=>F)=.
+
+For example, let's assume that today is *June 13, 2006*. Here is how
+various inputs are interpreted, the items filled in by Org mode are in
+*bold*.
+
+| =3-2-5= | \rArr{} 2003-02-05 |
+| =2/5/3= | \rArr{} 2003-02-05 |
+| =14= | \rArr{} *2006*-*06*-14 |
+| =12= | \rArr{} *2006*-*07*-12 |
+| =2/5= | \rArr{} *2007*-02-05 |
+| =Fri= | \rArr{} nearest Friday (default date or later) |
+| =sep 15= | \rArr{} *2006*-09-15 |
+| =feb 15= | \rArr{} *2007*-02-15 |
+| =sep 12 9= | \rArr{} 2009-09-12 |
+| =12:45= | \rArr{} *2006*-*06*-*13* 12:45 |
+| =22 sept 0:34= | \rArr{} *2006*-09-22 0:34 |
+| =w4= | \rArr{} ISO week for of the current year *2006* |
+| =2012 w4 fri= | \rArr{} Friday of ISO week 4 in 2012 |
+| =2012-w04-5= | \rArr{} Same as above |
+
+Furthermore you can specify a relative date by giving, as the /first/
+thing in the input: a plus/minus sign, a number and a letter---=h=,
+=d=, =w=, =m= or =y=---to indicate a change in hours, days, weeks,
+months, or years. With =h= the date is relative to the current time,
+with the other letters and a single plus or minus, the date is
+relative to today at 00:00. With a double plus or minus, it is
+relative to the default date. If instead of a single letter, you use
+the abbreviation of day name, the date is the Nth such day, e.g.:
+
+| =+0= | \rArr{} today |
+| =.= | \rArr{} today |
+| =+2h= | \rArr{} two hours from now |
+| =+4d= | \rArr{} four days from today |
+| =+4= | \rArr{} same as +4d |
+| =+2w= | \rArr{} two weeks from today |
+| =++5= | \rArr{} five days from default date |
+| =+2tue= | \rArr{} second Tuesday from now |
+
+#+vindex: parse-time-months
+#+vindex: parse-time-weekdays
+The function understands English month and weekday abbreviations. If
+you want to use un-abbreviated names and/or other languages, configure
+the variables ~parse-time-months~ and ~parse-time-weekdays~.
+
+#+vindex: org-read-date-force-compatible-dates
+Not all dates can be represented in a given Emacs implementation. By
+default Org mode forces dates into the compatibility range 1970--2037
+which works on all Emacs implementations. If you want to use dates
+outside of this range, read the docstring of the variable
+~org-read-date-force-compatible-dates~.
+
+You can specify a time range by giving start and end times or by
+giving a start time and a duration (in HH:MM format). Use one or two
+dash(es) as the separator in the former case and use =+= as the
+separator in the latter case, e.g.:
+
+| =11am-1:15pm= | \rArr{} 11:00-13:15 |
+| =11am--1:15pm= | \rArr{} same as above |
+| =11am+2:15= | \rArr{} same as above |
+
+#+cindex: calendar, for selecting date
+#+vindex: org-popup-calendar-for-date-prompt
+Parallel to the minibuffer prompt, a calendar is popped up[fn:62].
+When you exit the date prompt, either by clicking on a date in the
+calendar, or by pressing {{{kbd(RET)}}}, the date selected in the
+calendar is combined with the information entered at the prompt. You
+can control the calendar fully from the minibuffer:
+
+#+kindex: <
+#+kindex: >
+#+kindex: M-v
+#+kindex: C-v
+#+kindex: mouse-1
+#+kindex: S-RIGHT
+#+kindex: S-LEFT
+#+kindex: S-DOWN
+#+kindex: S-UP
+#+kindex: M-S-RIGHT
+#+kindex: M-S-LEFT
+#+kindex: RET
+#+kindex: .
+#+kindex: C-.
+#+attr_texinfo: :columns 0.25 0.55
+| {{{kbd(RET)}}} | Choose date at point in calendar. |
+| {{{kbd(mouse-1)}}} | Select date by clicking on it. |
+| {{{kbd(S-RIGHT)}}} | One day forward. |
+| {{{kbd(S-LEFT)}}} | One day backward. |
+| {{{kbd(S-DOWN)}}} | One week forward. |
+| {{{kbd(S-UP)}}} | One week backward. |
+| {{{kbd(M-S-RIGHT)}}} | One month forward. |
+| {{{kbd(M-S-LEFT)}}} | One month backward. |
+| {{{kbd(>)}}} | Scroll calendar forward by one month. |
+| {{{kbd(<)}}} | Scroll calendar backward by one month. |
+| {{{kbd(M-v)}}} | Scroll calendar forward by 3 months. |
+| {{{kbd(C-v)}}} | Scroll calendar backward by 3 months. |
+| {{{kbd(C-.)}}} | Select today's date[fn:63] |
+
+#+vindex: org-read-date-display-live
+The actions of the date/time prompt may seem complex, but I assure you
+they will grow on you, and you will start getting annoyed by pretty
+much any other way of entering a date/time out there. To help you
+understand what is going on, the current interpretation of your input
+is displayed live in the minibuffer[fn:64].
+
+*** Custom time format
+:PROPERTIES:
+:DESCRIPTION: Making dates look different.
+:END:
+#+cindex: custom date/time format
+#+cindex: time format, custom
+#+cindex: date format, custom
+
+#+vindex: org-display-custom-times
+#+vindex: org-time-stamp-custom-formats
+Org mode uses the standard ISO notation for dates and times as it is
+defined in ISO 8601. If you cannot get used to this and require
+another representation of date and time to keep you happy, you can get
+it by customizing the variables ~org-display-custom-times~ and
+~org-time-stamp-custom-formats~.
+
+- {{{kbd(C-c C-x C-t)}}} (~org-toggle-time-stamp-overlays~) ::
+
+ #+kindex: C-c C-x C-t
+ #+findex: org-toggle-time-stamp-overlays
+ Toggle the display of custom formats for dates and times.
+
+Org mode needs the default format for scanning, so the custom
+date/time format does not /replace/ the default format. Instead, it
+is put /over/ the default format using text properties. This has the
+following consequences:
+
+- You cannot place point onto a timestamp anymore, only before or
+ after.
+
+- The {{{kbd(S-UP)}}} and {{{kbd(S-DOWN)}}} keys can no longer be used
+ to adjust each component of a timestamp. If point is at the
+ beginning of the stamp, {{{kbd(S-UP)}}} and {{{kbd(S-DOWN)}}} change
+ the stamp by one day, just like {{{kbd(S-LEFT)}}}
+ {{{kbd(S-RIGHT)}}}. At the end of the stamp, change the time by one
+ minute.
+
+- If the timestamp contains a range of clock times or a repeater,
+ these are not overlaid, but remain in the buffer as they were.
+
+- When you delete a timestamp character-by-character, it only
+ disappears from the buffer after /all/ (invisible) characters
+ belonging to the ISO timestamp have been removed.
+
+- If the custom timestamp format is longer than the default and you
+ are using dates in tables, table alignment will be messed up. If
+ the custom format is shorter, things do work as expected.
+
+** Deadlines and Scheduling
+:PROPERTIES:
+:DESCRIPTION: Planning your work.
+:END:
+
+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.
+
+- =DEADLINE= ::
+
+ #+cindex: @samp{DEADLINE} marker
+ Meaning: the task---most likely a TODO item, though not
+ necessarily---is supposed to be finished on that date.
+
+ #+vindex: org-deadline-warning-days
+ On the deadline date, the task is listed in the agenda. In
+ addition, the agenda for /today/ carries a warning about the
+ approaching or missed deadline, starting ~org-deadline-warning-days~
+ before the due date, and continuing until the entry is marked as
+ done. An example:
+
+ #+begin_example
+ ,*** TODO write article about the Earth for the Guide
+ DEADLINE: <2004-02-29 Sun>
+ The editor in charge is [[bbdb:Ford Prefect]]
+ #+end_example
+
+ #+vindex: org-agenda-skip-deadline-prewarning-if-scheduled
+ You can specify a different lead time for warnings for a specific
+ deadlines using the following syntax. Here is an example with
+ a warning period of 5 days =DEADLINE: <2004-02-29 Sun -5d>=. This
+ warning is deactivated if the task gets scheduled and you set
+ ~org-agenda-skip-deadline-prewarning-if-scheduled~ to ~t~.
+
+- =SCHEDULED= ::
+
+ #+cindex: @samp{SCHEDULED} marker
+ Meaning: you are planning to start working on that task on the given
+ date.
+
+ #+vindex: org-agenda-skip-scheduled-if-done
+ The headline is listed under the given date[fn:65]. In addition,
+ a reminder that the scheduled date has passed is present in the
+ compilation for /today/, until the entry is marked as done, i.e.,
+ the task is automatically forwarded until completed.
+
+ #+begin_example
+ ,*** TODO Call Trillian for a date on New Years Eve.
+ SCHEDULED: <2004-12-25 Sat>
+ #+end_example
+
+ #+vindex: org-scheduled-delay-days
+ #+vindex: org-agenda-skip-scheduled-delay-if-deadline
+ If you want to /delay/ the display of this task in the agenda, use
+ =SCHEDULED: <2004-12-25 Sat -2d>=: the task is still scheduled on
+ the 25th but will appear two days later. In case the task contains
+ a repeater, the delay is considered to affect all occurrences; if
+ you want the delay to only affect the first scheduled occurrence of
+ the task, use =--2d= instead. See ~org-scheduled-delay-days~ and
+ ~org-agenda-skip-scheduled-delay-if-deadline~ for details on how to
+ control this globally or per agenda.
+
+ #+attr_texinfo: :tag Important
+ #+begin_quote
+ Scheduling an item in Org mode should /not/ be understood in the
+ same way that we understand /scheduling a meeting/. Setting a date
+ for a meeting is just a simple appointment, you should mark this
+ entry with a simple plain timestamp, to get this item shown on the
+ date where it applies. This is a frequent misunderstanding by Org
+ users. In Org mode, /scheduling/ means setting a date when you want
+ to start working on an action item.
+ #+end_quote
+
+You may use timestamps with repeaters in scheduling and deadline
+entries. Org mode issues early and late warnings based on the
+assumption that the timestamp represents the /nearest instance/ of the
+repeater. However, the use of diary expression entries like
+
+: <%%(diary-float t 42)>
+
+#+texinfo: @noindent
+in scheduling and deadline timestamps is limited. Org mode does not
+know enough about the internals of each function to issue early and
+late warnings. However, it shows the item on each day where the
+expression entry matches.
+
+*** Inserting deadlines or schedules
+:PROPERTIES:
+:DESCRIPTION: Planning items.
+:ALT_TITLE: Inserting deadline/schedule
+:END:
+
+The following commands allow you to quickly insert a deadline or to
+schedule an item:[fn:66]
+
+- {{{kbd(C-c C-d)}}} (~org-deadline~) ::
+
+ #+kindex: C-c C-d
+ #+findex: org-deadline
+ #+vindex: org-log-redeadline
+ Insert =DEADLINE= keyword along with a stamp. The insertion happens
+ in the line directly following the headline. Remove any =CLOSED=
+ timestamp . When called with a prefix argument, also remove any
+ existing deadline from the entry. Depending on the variable
+ ~org-log-redeadline~, take a note when changing an existing
+ deadline[fn:67].
+
+- {{{kbd(C-c C-s)}}} (~org-schedule~) ::
+
+ #+kindex: C-c C-s
+ #+findex: org-schedule
+ #+vindex: org-log-reschedule
+ Insert =SCHEDULED= keyword along with a stamp. The insertion
+ happens in the line directly following the headline. Remove any
+ =CLOSED= timestamp. When called with a prefix argument, also remove
+ the scheduling date from the entry. Depending on the variable
+ ~org-log-reschedule~, take a note when changing an existing
+ scheduling time[fn:68].
+
+- {{{kbd(C-c / d)}}} (~org-check-deadlines~) ::
+
+ #+kindex: C-c / d
+ #+findex: org-check-deadlines
+ #+cindex: sparse tree, for deadlines
+ #+vindex: org-deadline-warning-days
+ Create a sparse tree with all deadlines that are either past-due, or
+ which will become due within ~org-deadline-warning-days~. With
+ {{{kbd(C-u)}}} prefix, show all deadlines in the file. With
+ a numeric prefix, check that many days. For example, {{{kbd(C-1 C-c
+ / d)}}} shows all deadlines due tomorrow.
+
+- {{{kbd(C-c / b)}}} (~org-check-before-date~) ::
+
+ #+kindex: C-c / b
+ #+findex: org-check-before-date
+ Sparse tree for deadlines and scheduled items before a given date.
+
+- {{{kbd(C-c / a)}}} (~org-check-after-date~) ::
+
+ #+kindex: C-c / a
+ #+findex: org-check-after-date
+ Sparse tree for deadlines and scheduled items after a given date.
+
+Note that ~org-schedule~ and ~org-deadline~ supports setting the date
+by indicating a relative time e.g., =+1d= sets the date to the next
+day after today, and =--1w= sets the date to the previous week before
+any current timestamp.
+
+*** Repeated tasks
+:PROPERTIES:
+:DESCRIPTION: Items that show up again and again.
+:END:
+#+cindex: tasks, repeated
+#+cindex: repeated tasks
+
+Some tasks need to be repeated again and again. Org mode helps to
+organize such tasks using a so-called repeater in a =DEADLINE=,
+=SCHEDULED=, or plain timestamps[fn:69]. In the following example:
+
+#+begin_example
+,** TODO Pay the rent
+ DEADLINE: <2005-10-01 Sat +1m>
+#+end_example
+
+#+texinfo: @noindent
+the =+1m= is a repeater; the intended interpretation is that the task
+has a deadline on =<2005-10-01>= and repeats itself every (one) month
+starting from that time. You can use yearly, monthly, weekly, daily
+and hourly repeat cookies by using the =y=, =m=, =w=, =d= and =h=
+letters. If you need both a repeater and a special warning period in
+a deadline entry, the repeater should come first and the warning
+period last
+
+: DEADLINE: <2005-10-01 Sat +1m -3d>
+
+#+vindex: org-todo-repeat-to-state
+Deadlines and scheduled items produce entries in the agenda when they
+are over-due, so it is important to be able to mark such an entry as
+done once you have done so. When you mark a =DEADLINE= or
+a =SCHEDULED= with the TODO keyword =DONE=, it no longer produces
+entries in the agenda. The problem with this is, however, is that
+then also the /next/ instance of the repeated entry will not be
+active. Org mode deals with this in the following way: when you try
+to mark such an entry as done, using {{{kbd(C-c C-t)}}}, it shifts the
+base date of the repeating timestamp by the repeater interval, and
+immediately sets the entry state back to TODO[fn:70]. In the example
+above, setting the state to =DONE= would actually switch the date like
+this:
+
+#+begin_example
+,** TODO Pay the rent
+ DEADLINE: <2005-11-01 Tue +1m>
+#+end_example
+
+To mark a task with a repeater as DONE, use {{{kbd(C-- 1 C-c C-t)}}},
+i.e., ~org-todo~ with a numeric prefix argument of =-1=.
+
+#+vindex: org-log-repeat
+A timestamp[fn:71] is added under the deadline, to keep a record that
+you actually acted on the previous instance of this deadline.
+
+As a consequence of shifting the base date, this entry is no longer
+visible in the agenda when checking past dates, but all future
+instances will be visible.
+
+With the =+1m= cookie, the date shift is always exactly one month. So
+if you have not paid the rent for three months, marking this entry
+DONE still keeps it as an overdue deadline. Depending on the task,
+this may not be the best way to handle it. For example, if you forgot
+to call your father for 3 weeks, it does not make sense to call him
+3 times in a single day to make up for it. Finally, there are tasks,
+like changing batteries, which should always repeat a certain time
+/after/ the last time you did it. For these tasks, Org mode has
+special repeaters =++= and =.+=. For example:
+
+#+begin_example
+,** TODO Call Father
+ DEADLINE: <2008-02-10 Sun ++1w>
+ Marking this DONE shifts the date by at least one week, 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 shifts 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 shifts the date to one month after today.
+
+,** TODO Wash my hands
+ DEADLINE: <2019-04-05 08:00 Sun .+1h>
+ Marking this DONE shifts the date to exactly one hour from now.
+#+end_example
+
+#+vindex: org-agenda-skip-scheduled-if-deadline-is-shown
+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 ~org-agenda-skip-scheduled-if-deadline-is-shown~ to
+~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.
+
+An alternative to using a repeater is to create a number of copies of
+a task subtree, with dates shifted in each copy. The command
+{{{kbd(C-c C-x c)}}} was created for this purpose; it is described in
+[[*Structure Editing]].
+
+** Clocking Work Time
+:PROPERTIES:
+:DESCRIPTION: Tracking how long you spend on a task.
+:END:
+#+cindex: clocking time
+#+cindex: time clocking
+
+Org mode allows you to clock the time you spend on specific tasks in
+a project. When you start working on an item, you can start the
+clock. When 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[fn:72] 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:
+
+#+begin_src emacs-lisp
+(setq org-clock-persist 'history)
+(org-clock-persistence-insinuate)
+#+end_src
+
+#+vindex: org-clock-persist
+When you clock into a new task after resuming Emacs, the incomplete
+clock[fn:73] is retrieved (see [[*Resolving idle time]]) and you are
+prompted about what to do with it.
+
+*** Clocking commands
+:PROPERTIES:
+:DESCRIPTION: Starting and stopping a clock.
+:END:
+
+#+attr_texinfo: :sep ,
+- {{{kbd(C-c C-x C-i)}}} (~org-clock-in~) ::
+
+ #+kindex: C-c C-x C-i
+ #+findex: org-clock-in
+ #+vindex: org-clock-into-drawer
+ #+vindex: org-clock-continuously
+ #+cindex: @samp{LOG_INTO_DRAWER}, property
+ Start the clock on the current item (clock-in). This inserts the
+ =CLOCK= keyword together with a timestamp. If this is not the first
+ clocking of this item, the multiple =CLOCK= lines are wrapped into
+ a =LOGBOOK= drawer (see also the variable ~org-clock-into-drawer~).
+ You can also overrule the setting of this variable for a subtree by
+ setting a =CLOCK_INTO_DRAWER= or =LOG_INTO_DRAWER= property. When
+ called with a {{{kbd(C-u)}}} prefix argument, select the task from
+ a list of recently clocked tasks. With two {{{kbd(C-u C-u)}}}
+ prefixes, clock into the task at point and mark it as the default
+ task; the default task is always be available with letter
+ {{{kbd(d)}}} when selecting a clocking task. With three {{{kbd(C-u
+ C-u C-u)}}} prefixes, force continuous clocking by starting the
+ clock when the last clock stopped.
+
+ #+cindex: @samp{CLOCK_MODELINE_TOTAL}, property
+ #+cindex: @samp{LAST_REPEAT}, property
+ #+vindex: org-clock-mode-line-total
+ #+vindex: org-clock-in-prepare-hook
+ While the clock is running, Org shows the current clocking time in
+ the mode line, along with the title of the task. The clock time
+ shown is all time ever clocked for this task and its children. If
+ the task has an effort estimate (see [[*Effort Estimates]]), the mode
+ line displays the current clocking time against it[fn:74]. If the
+ task is a repeating one (see [[*Repeated tasks]]), show only the time
+ since the last reset of the task[fn:75]. You can exercise more
+ control over show time with the =CLOCK_MODELINE_TOTAL= property. It
+ may have the values =current= to show only the current clocking
+ instance, =today= to show all time clocked on this tasks today---see
+ also the variable ~org-extend-today-until~, ~all~ to include all
+ time, or ~auto~ which is the default[fn:76]. Clicking with
+ {{{kbd(mouse-1)}}} onto the mode line entry pops up a menu with
+ clocking options.
+
+- {{{kbd(C-c C-x C-o)}}} (~org-clock-out~) ::
+
+ #+kindex: C-c C-x C-o
+ #+findex: org-clock-out
+ #+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
+ ==>HH:MM=. See the variable ~org-log-note-clock-out~ for the
+ possibility to record an additional note together with the clock-out
+ timestamp[fn:77].
+
+- {{{kbd(C-c C-x C-x)}}} (~org-clock-in-last~) ::
+
+ #+kindex: C-c C-x C-x
+ #+findex: org-clock-in-last
+ #+vindex: org-clock-continuously
+ Re-clock the last clocked task. With one {{{kbd(C-u)}}} prefix
+ argument, select the task from the clock history. With two
+ {{{kbd(C-u)}}} prefixes, force continuous clocking by starting the
+ clock when the last clock stopped.
+
+- {{{kbd(C-c C-x C-e)}}} (~org-clock-modify-effort-estimate~) ::
+
+ #+kindex: C-c C-x C-e
+ #+findex: org-clock-modify-effort-estimate
+ Update the effort estimate for the current clock task.
+
+- {{{kbd(C-c C-c)}}} or {{{kbd(C-c C-y)}}} (~org-evaluate-time-range~) ::
+
+ #+kindex: C-c C-c
+ #+kindex: C-c C-y
+ #+findex: org-evaluate-time-range
+ Recompute the time interval after changing one of the timestamps.
+ This is only necessary if you edit the timestamps directly. If you
+ change them with {{{kbd(S-<cursor>)}}} keys, the update is
+ automatic.
+
+- {{{kbd(C-S-UP)}}} (~org-clock-timestamps-up~), {{{kbd(C-S-DOWN)}}} (~org-clock-timestamps-down~) ::
+
+ #+kindex: C-S-UP
+ #+findex: org-clock-timestamps-up
+ #+kindex: C-S-DOWN
+ #+findex: org-clock-timestamps-down
+ On CLOCK log lines, increase/decrease both timestamps so that the
+ clock duration keeps the same value.
+
+- {{{kbd(S-M-UP)}}} (~org-timestamp-up~), {{{kbd(S-M-DOWN)}}} (~org-timestamp-down~) ::
+
+ #+kindex: S-M-UP
+ #+findex: org-clock-timestamp-up
+ #+kindex: S-M-DOWN
+ #+findex: org-clock-timestamp-down
+ On =CLOCK= log lines, increase/decrease the timestamp at point and
+ the one of the previous, or the next, clock timestamp by the same
+ duration. For example, if you hit {{{kbd(S-M-UP)}}} to increase
+ a clocked-out timestamp by five minutes, then the clocked-in
+ timestamp of the next clock is increased by five minutes.
+
+- {{{kbd(C-c C-t)}}} (~org-todo~) ::
+
+ #+kindex: C-c C-t
+ #+findex: org-todo
+ Changing the TODO state of an item to DONE automatically stops the
+ clock if it is running in this same item.
+
+- {{{kbd(C-c C-x C-q)}}} (~org-clock-cancel~) ::
+
+ #+kindex: C-c C-x C-q
+ #+findex: org-clock-cancel
+ Cancel the current clock. This is useful if a clock was started by
+ mistake, or if you ended up working on something else.
+
+- {{{kbd(C-c C-x C-j)}}} (~org-clock-goto~) ::
+
+ #+kindex: C-c C-x C-j
+ #+findex: or-clock-goto
+ Jump to the headline of the currently clocked in task. With
+ a {{{kbd(C-u)}}} prefix argument, select the target task from a list
+ of recently clocked tasks.
+
+- {{{kbd(C-c C-x C-d)}}} (~org-clock-display~) ::
+
+ #+kindex: C-c C-x C-d
+ #+findex: org-clock-display
+ #+vindex: org-remove-highlights-with-change
+ Display time summaries for each subtree in the current buffer. This
+ puts overlays at the end of each headline, showing the total time
+ recorded under that heading, including the time of any subheadings.
+ You can use visibility cycling to study the tree, but the overlays
+ disappear when you change the buffer (see variable
+ ~org-remove-highlights-with-change~) or press {{{kbd(C-c C-c)}}}.
+
+The {{{kbd(l)}}} key may be used in the agenda (see [[*Weekly/daily
+agenda]]) to show which tasks have been worked on or closed during
+a day.
+
+*Important:* note that both ~org-clock-out~ and ~org-clock-in-last~
+can have a global keybinding and do not modify the window disposition.
+
+*** The clock table
+:PROPERTIES:
+:DESCRIPTION: Detailed reports.
+:END:
+#+cindex: clocktable, dynamic block
+#+cindex: report, of clocked time
+
+Org mode can produce quite complex reports based on the time clocking
+information. Such a report is called a /clock table/, because it is
+formatted as one or several Org tables.
+
+#+attr_texinfo: :sep ,
+- ~org-clock-report~ ::
+
+ #+kindex: C-c C-x x
+ #+findex: org-clock-report
+ Insert or update a clock table. When called with a prefix argument,
+ jump to the first clock table in the current document and update it.
+ The clock table includes archived trees.
+
+ This command can be invoked by calling
+ ~org-dynamic-block-insert-dblock~ ({{{kbd(C-c C-x x)}}}) and
+ selecting "clocktable" (see [[*Dynamic Blocks]]).
+
+- {{{kbd(C-c C-c)}}} or {{{kbd(C-c C-x C-u)}}} (~org-dblock-update~) ::
+
+ #+kindex: C-c C-c
+ #+kindex: C-c C-x C-u
+ #+findex: org-dblock-update
+ Update dynamic block at point. Point needs to be in the =BEGIN=
+ line of the dynamic block.
+
+- {{{kbd(C-u C-c C-x C-u)}}} ::
+
+ #+kindex: C-u C-c C-x C-u
+ Update all dynamic blocks (see [[*Dynamic Blocks]]). This is useful if
+ you have several clock table blocks in a buffer.
+
+- {{{kbd(S-LEFT)}}}, {{{kbd(S-RIGHT)}}} (~org-clocktable-try-shift~) ::
+
+ #+kindex: S-LEFT
+ #+kindex: S-RIGHT
+ #+findex: org-clocktable-try-shift
+ Shift the current =:block= interval and update the table. Point
+ needs to be in the =#+BEGIN: clocktable= line for this command. If
+ =:block= is =today=, it is shifted to =today-1=, etc.
+
+Here is an example of the frame for a clock table as it is inserted
+into the buffer by ~org-clock-report~:
+
+#+cindex: @samp{BEGIN clocktable}
+#+begin_example
+,#+BEGIN: clocktable :maxlevel 2 :emphasize nil :scope file
+,#+END: clocktable
+#+end_example
+
+#+vindex: org-clocktable-defaults
+The =#+BEGIN= line contains options to define the scope, structure,
+and formatting of the report. Defaults for all these options can be
+configured in the variable ~org-clocktable-defaults~.
+
+First there are options that determine which clock entries are to
+be selected:
+
+- =:maxlevel= ::
+
+ Maximum level depth to which times are listed in the table. Clocks
+ at deeper levels are summed into the upper level.
+
+- =:scope= ::
+
+ The scope to consider. This can be any of the following:
+
+ | =nil= | the current buffer or narrowed region |
+ | =file= | the full current buffer |
+ | =subtree= | the subtree where the clocktable is located |
+ | =treeN= | the surrounding level N tree, for example =tree3= |
+ | =tree= | the surrounding level 1 tree |
+ | =agenda= | all agenda files |
+ | =("file" ...)= | scan these files |
+ | =FUNCTION= | scan files returned by calling {{{var(FUNCTION)}}} with no argument |
+ | =file-with-archives= | current file and its archives |
+ | =agenda-with-archives= | all agenda files, including archives |
+
+- =:block= ::
+
+ The time block to consider. This block is specified either
+ absolutely, or relative to the current time and may be any of these
+ formats:
+
+ | =2007-12-31= | New year eve 2007 |
+ | =2007-12= | December 2007 |
+ | =2007-W50= | ISO-week 50 in 2007 |
+ | =2007-Q2= | 2nd quarter in 2007 |
+ | =2007= | the year 2007 |
+ | =today=, =yesterday=, =today-N= | a relative day |
+ | =thisweek=, =lastweek=, =thisweek-N= | a relative week |
+ | =thismonth=, =lastmonth=, =thismonth-N= | a relative month |
+ | =thisyear=, =lastyear=, =thisyear-N= | a relative year |
+ | =untilnow=[fn:78] | all clocked time ever |
+
+ #+vindex: org-clock-display-default-range
+ When this option is not set, Org falls back to the value in
+ ~org-clock-display-default-range~, which defaults to the current
+ year.
+
+ Use {{{kbd(S-LEFT)}}} or {{{kbd(S-RIGHT)}}} to shift the time
+ interval.
+
+- =:tstart= ::
+
+ A time string specifying when to start considering times. Relative
+ times like ="<-2w>"= can also be used. See [[*Matching tags and
+ properties]] for relative time syntax.
+
+- =:tend= ::
+
+ A time string specifying when to stop considering times. Relative
+ times like ="<now>"= can also be used. See [[*Matching tags and
+ properties]] for relative time syntax.
+
+- =:wstart= ::
+
+ The starting day of the week. The default is 1 for Monday.
+
+- =:mstart= ::
+
+ The starting day of the month. The default is 1 for the first.
+
+- =:step= ::
+
+ Set to =day=, =week=, =semimonth=, =month=, or =year= to split the
+ table into chunks. To use this, either =:block=, or =:tstart= and
+ =:tend= are required.
+
+- =:stepskip0= ::
+
+ When non-~nil~, do not show steps that have zero time.
+
+- =:fileskip0= ::
+
+ When non-~nil~, do not show table sections from files which did not
+ contribute.
+
+- =:match= ::
+
+ A tags match to select entries that should contribute. See
+ [[*Matching tags and properties]] for the match syntax.
+
+#+findex: org-clocktable-write-default
+Then there are options that determine the formatting of the table.
+There options are interpreted by the function
+~org-clocktable-write-default~, but you can specify your own function
+using the =:formatter= parameter.
+
+- =:emphasize= ::
+
+ When non-~nil~, emphasize level one and level two items.
+
+- =:lang= ::
+
+ Language[fn:79] to use for descriptive cells like "Task".
+
+- =:link= ::
+
+ Link the item headlines in the table to their origins.
+
+- =:narrow= ::
+
+ An integer to limit the width of the headline column in the Org
+ table. If you write it like =50!=, then the headline is also
+ shortened in export.
+
+- =:indent= ::
+
+ Indent each headline field according to its level.
+
+- =:hidefiles= ::
+
+ Hide the file column when multiple files are used to produce the
+ table.
+
+- =:tcolumns= ::
+
+ Number of columns to be used for times. If this is smaller than
+ =:maxlevel=, lower levels are lumped into one column.
+
+- =:level= ::
+
+ Should a level number column be included?
+
+- =:sort= ::
+
+ A cons cell containing the column to sort and a sorting type. E.g.,
+ =:sort (1 . ?a)= sorts the first column alphabetically.
+
+- =:compact= ::
+
+ Abbreviation for =:level nil :indent t :narrow 40! :tcolumns 1=.
+ All are overwritten except if there is an explicit =:narrow=.
+
+- =:timestamp= ::
+
+ A timestamp for the entry, when available. Look for =SCHEDULED=,
+ =DEADLINE=, =TIMESTAMP= and =TIMESTAMP_IA= special properties (see
+ [[*Special Properties]]), in this order.
+
+- =:tags= ::
+
+ When this flag is non-~nil~, show the headline's tags.
+
+- =:properties= ::
+
+ List of properties shown in the table. Each property gets its own
+ column.
+
+- =:inherit-props= ::
+
+ When this flag is non-~nil~, the values for =:properties= are
+ inherited.
+
+- =:formula= ::
+
+ Content of a =TBLFM= keyword to be added and evaluated. As
+ a special case, =:formula %= adds a column with % time. If you do
+ not specify a formula here, any existing formula below the clock
+ table survives updates and is evaluated.
+
+- =:formatter= ::
+
+ A function to format clock data and insert it into the buffer.
+
+To get a clock summary of the current level 1 tree, for the current
+day, you could write:
+
+#+begin_example
+,#+BEGIN: clocktable :maxlevel 2 :block today :scope tree1 :link t
+,#+END: clocktable
+#+end_example
+
+#+texinfo: @noindent
+To use a specific time range you could write[fn:80]
+
+#+begin_example
+,#+BEGIN: clocktable :tstart "<2006-08-10 Thu 10:00>"
+ :tend "<2006-08-10 Thu 12:00>"
+,#+END: clocktable
+#+end_example
+
+#+texinfo: @noindent
+A range starting a week ago and ending right now could be written as
+
+#+begin_example
+,#+BEGIN: clocktable :tstart "<-1w>" :tend "<now>"
+,#+END: clocktable
+#+end_example
+
+#+texinfo: @noindent
+A summary of the current subtree with % times would be
+
+#+begin_example
+,#+BEGIN: clocktable :scope subtree :link t :formula %
+,#+END: clocktable
+#+end_example
+
+#+texinfo: @noindent
+A horizontally compact representation of everything clocked during
+last week would be
+
+#+begin_example
+,#+BEGIN: clocktable :scope agenda :block lastweek :compact t
+,#+END: clocktable
+#+end_example
+
+*** Resolving idle time and continuous clocking
+:PROPERTIES:
+:DESCRIPTION: Resolving time when you've been idle.
+:ALT_TITLE: Resolving idle time
+:END:
+
+**** Resolving idle time
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: resolve idle time
+#+cindex: idle, resolve, dangling
+
+If you clock in on a work item, and then walk away from your
+computer---perhaps to take a phone call---you often need to
+"resolve" the time you were away by either subtracting it from the
+current clock, or applying it to another one.
+
+#+vindex: org-clock-idle-time
+#+vindex: org-clock-x11idle-program-name
+By customizing the variable ~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[fn:81], and ask what
+you want to do with the idle time. There will be a question waiting
+for you when you get back, indicating how much idle time has passed
+constantly updated with the current amount, as well as a set of
+choices to correct the discrepancy:
+
+- {{{kbd(k)}}} ::
+
+ #+kindex: k
+ To keep some or all of the minutes and stay clocked in, press
+ {{{kbd(k)}}}. Org asks how many of the minutes to keep. Press
+ {{{kbd(RET)}}} to keep them all, effectively changing nothing, or
+ enter a number to keep that many minutes.
+
+- {{{kbd(K)}}} ::
+
+ #+kindex: K
+ If you use the shift key and press {{{kbd(K)}}}, it keeps however
+ many minutes you request and then immediately clock out of that
+ task. If you keep all of the minutes, this is the same as just
+ clocking out of the current task.
+
+- {{{kbd(s)}}} ::
+
+ #+kindex: s
+ To keep none of the minutes, use {{{kbd(s)}}} to subtract all the
+ away time from the clock, and then check back in from the moment you
+ returned.
+
+- {{{kbd(S)}}} ::
+
+ #+kindex: S
+ To keep none of the minutes and just clock out at the start of the
+ away time, use the shift key and press {{{kbd(S)}}}. Remember that
+ using shift always leave you clocked out, no matter which option you
+ choose.
+
+- {{{kbd(C)}}} ::
+
+ #+kindex: C
+ To cancel the clock altogether, use {{{kbd(C)}}}. Note that if
+ instead of canceling you subtract the away time, and the resulting
+ clock amount is less than a minute, the clock is still canceled
+ rather than cluttering up the log with an empty entry.
+
+What if you subtracted those away minutes from the current clock, and
+now want to apply them to a new clock? Simply clock in to any task
+immediately after the subtraction. Org will notice that you have
+subtracted time "on the books", so to speak, and will ask if you want
+to apply those minutes to the next task you clock in on.
+
+There is one other instance when this clock resolution magic occurs.
+Say you were clocked in and hacking away, and suddenly your cat chased
+a mouse who scared a hamster that crashed into your UPS's power
+button! You suddenly lose all your buffers, but thanks to auto-save
+you still have your recent Org mode changes, including your last clock
+in.
+
+If you restart Emacs and clock into any task, Org will notice that you
+have a dangling clock which was never clocked out from your last
+session. Using that clock's starting time as the beginning of the
+unaccounted-for period, Org will ask how you want to resolve that
+time. The logic and behavior is identical to dealing with away time
+due to idleness; it is just happening due to a recovery event rather
+than a set amount of idle time.
+
+You can also check all the files visited by your Org agenda for
+dangling clocks at any time using {{{kbd(M-x org-resolve-clocks
+RET)}}} (or {{{kbd(C-c C-x C-z)}}}).
+
+**** Continuous clocking
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: continuous clocking
+
+#+vindex: org-clock-continuously
+You may want to start clocking from the time when you clocked out the
+previous task. To enable this systematically, set
+~org-clock-continuously~ to non-~nil~. Each time you clock in, Org
+retrieves the clock-out time of the 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 ~org-clock-in~ and two {{{kbd(C-u C-u)}}} with
+~org-clock-in-last~.
+
+**** Clocking out automatically after some idle time
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: auto clocking out after idle time
+
+#+vindex: org-clock-auto-clockout-timer
+When you often forget to clock out before being idle and you don't
+want to manually set the clocking time to take into account, you can
+set ~org-clock-auto-clockout-timer~ to a number of seconds and add
+=(org-clock-auto-clockout-insinuate)= to your =.emacs= file.
+
+When the clock is running and Emacs is idle for more than this number
+of seconds, the clock will be clocked out automatically.
+
+Use =M-x org-clock-toggle-auto-clockout RET= to temporarily turn this
+on or off.
+
+** Effort Estimates
+:PROPERTIES:
+:DESCRIPTION: Planning work effort in advance.
+:END:
+#+cindex: effort estimates
+#+cindex: @samp{EFFORT}, property
+#+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 =EFFORT=. Multiple
+formats are supported, such as =3:12=, =1:23:45=, or =1d3h5min=; see
+the file =org-duration.el= for more detailed information about the
+format.
+
+You can set the effort for an entry with the following commands:
+
+- {{{kbd(C-c C-x e)}}} (~org-set-effort~) ::
+
+ #+kindex: C-c C-x e
+ #+findex: org-set-effort
+ Set the effort estimate for the current entry. With a prefix
+ argument, set it to the next allowed value---see below. This
+ command is also accessible from the agenda with the {{{kbd(e)}}}
+ key.
+
+- {{{kbd(C-c C-x C-e)}}} (~org-clock-modify-effort-estimate~) ::
+
+ #+kindex: C-c C-x C-e
+ #+findex: org-clock-modify-effort-estimate
+ Modify the effort estimate of the item currently being clocked.
+
+Clearly the best way to work with effort estimates is through column
+view (see [[*Column View]]). You should start by setting up discrete
+values for effort estimates, and a =COLUMNS= format that displays
+these values together with clock sums---if you want to clock your
+time. For a specific buffer you can use:
+
+#+begin_example
+,#+PROPERTY: Effort_ALL 0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00
+,#+COLUMNS: %40ITEM(Task) %17Effort(Estimated Effort){:} %CLOCKSUM
+#+end_example
+
+#+texinfo: @noindent
+#+vindex: org-global-properties
+#+vindex: org-columns-default-format
+or, even better, you can set up these values globally by customizing
+the variables ~org-global-properties~ and
+~org-columns-default-format~. In particular if you want to use this
+setup also in the agenda, a global setup may be advised.
+
+The way to assign estimates to individual items is then to switch to
+column mode, and to use {{{kbd(S-RIGHT)}}} and {{{kbd(S-LEFT)}}} to
+change the value. The values you enter are immediately summed up in
+the hierarchy. In the column next to it, any clocked time is
+displayed.
+
+#+vindex: org-agenda-columns-add-appointments-to-effort-sum
+If you switch to column view in the daily/weekly agenda, the effort
+column summarizes the estimated work effort for each day[fn:82], and
+you can use this to find space in your schedule. To get an overview
+of the entire part of the day that is committed, you can set the
+option ~org-agenda-columns-add-appointments-to-effort-sum~. The
+appointments on a day that take place over a specified time interval
+are then also added to the load estimate of the day.
+
+Effort estimates can be used in secondary agenda filtering that is
+triggered with the {{{kbd(/)}}} key in the agenda (see [[*Commands in
+the Agenda Buffer]]). If you have these estimates defined consistently,
+two or three key presses narrow down the list to stuff that fits into
+an available time slot.
+
+** Taking Notes with a Relative Timer
+:PROPERTIES:
+:DESCRIPTION: Notes with a running timer.
+:ALT_TITLE: Timers
+:END:
+#+cindex: relative timer
+#+cindex: countdown timer
+
+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.
+
+- {{{kbd(C-c C-x 0)}}} (~org-timer-start~) ::
+
+ #+kindex: C-c C-x 0
+ #+findex: 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.
+
+- {{{kbd(C-c C-x ;)}}} (~org-timer-set-timer~) ::
+
+ #+kindex: C-c C-x ;
+ #+findex: org-timer-set-timer
+ #+vindex: org-timer-default-timer
+ Start a countdown timer. The user is prompted for a duration.
+ ~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.
+
+Once started, relative and countdown timers are controlled with the
+same commands.
+
+- {{{kbd(C-c C-x .)}}} (~org-timer~) ::
+
+ #+kindex: C-c C-x .
+ #+findex: org-timer
+ Insert a relative time into the buffer. The first time you use
+ this, the timer starts. Using a prefix argument restarts it.
+
+- {{{kbd(C-c C-x -)}}} (~org-timer-item~) ::
+
+ #+kindex: C-c C-x -
+ #+findex: org-timer-item
+ Insert a description list item with the current relative time. With
+ a prefix argument, first reset the timer to 0.
+
+- {{{kbd(M-RET)}}} (~org-insert-heading~) ::
+
+ #+kindex: M-RET
+ #+findex: org-insert-heading
+ Once the timer list is started, you can also use {{{kbd(M-RET)}}} to
+ insert new timer items.
+
+- {{{kbd(C-c C-x \,)}}} (~org-timer-pause-or-continue~) ::
+
+ #+kindex: C-c C-x ,
+ #+findex: org-timer-pause-or-continue
+ Pause the timer, or continue it if it is already paused.
+
+- {{{kbd(C-c C-x _)}}} (~org-timer-stop~) ::
+
+ #+kindex: C-c C-x _
+ #+findex: 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.
+
+* Refiling and Archiving
+:PROPERTIES:
+:DESCRIPTION: Moving and copying information with ease.
+:END:
+#+cindex: refiling notes
+#+cindex: copying notes
+#+cindex: archiving
+
+Once information is in the system, it may need to be moved around.
+Org provides Refile, Copy and Archive commands for this. Refile and
+Copy helps with moving and copying outlines. Archiving helps to keep
+the system compact and fast.
+
+** Refile and Copy
+:PROPERTIES:
+:DESCRIPTION: Moving/copying a tree from one place to another.
+:END:
+#+cindex: refiling notes
+#+cindex: copying notes
+
+When reviewing the captured data, you may want to refile or to copy
+some of the entries into a different list, for example into a project.
+Cutting, finding the right location, and then pasting the note is
+cumbersome. To simplify this process, you can use the following
+special command:
+
+- {{{kbd(C-c C-w)}}} (~org-refile~) ::
+
+ #+kindex: C-c C-w
+ #+findex: org-refile
+ #+vindex: org-reverse-note-order
+ #+vindex: org-refile-targets
+ #+vindex: org-refile-use-outline-path
+ #+vindex: org-outline-path-complete-in-steps
+ #+vindex: org-refile-allow-creating-parent-nodes
+ #+vindex: org-log-refile
+ Refile the entry or region at point. This command offers possible
+ locations for refiling the entry and lets you select one with
+ completion. The item (or all items in the region) is filed below
+ the target heading as a subitem. Depending on
+ ~org-reverse-note-order~, it is either the first or last subitem.
+
+ By default, all level 1 headlines in the current buffer are
+ considered to be targets, but you can have more complex definitions
+ across a number of files. See the variable ~org-refile-targets~ for
+ details. If you would like to select a location via
+ a file-path-like completion along the outline path, see the
+ variables ~org-refile-use-outline-path~ and
+ ~org-outline-path-complete-in-steps~. If you would like to be able
+ to create new nodes as new parents for refiling on the fly, check
+ the variable ~org-refile-allow-creating-parent-nodes~. When the
+ variable ~org-log-refile~[fn:83] is set, a timestamp or a note is
+ recorded whenever an entry is refiled.
+
+- {{{kbd(C-u C-c C-w)}}} ::
+
+ #+kindex: C-u C-c C-w
+ Use the refile interface to jump to a heading.
+
+- {{{kbd(C-u C-u C-c C-w)}}} (~org-refile-goto-last-stored~) ::
+
+ #+kindex: C-u C-u C-c C-w
+ #+findex: org-refile-goto-last-stored
+ Jump to the location where ~org-refile~ last moved a tree to.
+
+- {{{kbd(C-2 C-c C-w)}}} ::
+
+ #+kindex: C-2 C-c C-w
+ Refile as the child of the item currently being clocked.
+
+- {{{kbd(C-3 C-c C-w)}}} ::
+
+ #+kindex: C-3 C-c C-w
+ #+vindex: org-refile-keep
+ Refile and keep the entry in place. Also see ~org-refile-keep~ to
+ make this the default behavior, and beware that this may result in
+ duplicated =ID= properties.
+
+- {{{kbd(C-0 C-c C-w)}}} or {{{kbd(C-u C-u C-u C-c C-w)}}} (~org-refile-cache-clear~) ::
+
+ #+kindex: C-u C-u C-u C-c C-w
+ #+kindex: C-0 C-c C-w
+ #+findex: org-refile-cache-clear
+ #+vindex: org-refile-use-cache
+ Clear the target cache. Caching of refile targets can be turned on
+ by setting ~org-refile-use-cache~. To make the command see new
+ possible targets, you have to clear the cache with this command.
+
+- {{{kbd(C-c M-w)}}} (~org-refile-copy~) ::
+
+ #+kindex: C-c M-w
+ #+findex: org-refile-copy
+ Copying works like refiling, except that the original note is not
+ deleted.
+
+** Archiving
+:PROPERTIES:
+:DESCRIPTION: What to do with finished products.
+:END:
+#+cindex: archiving
+
+When a project represented by a (sub)tree is finished, you may want to
+move the tree out of the way and to stop it from contributing to the
+agenda. Archiving is important to keep your working files compact and
+global searches like the construction of agenda views fast.
+
+- {{{kbd(C-c C-x C-a)}}} (~org-archive-subtree-default~) ::
+
+ #+kindex: C-c C-x C-a
+ #+findex: org-archive-subtree-default
+ #+vindex: org-archive-default-command
+ Archive the current entry using the command specified in the
+ variable ~org-archive-default-command~.
+
+*** Moving a tree to an archive file
+:PROPERTIES:
+:DESCRIPTION: Moving a tree to an archive file.
+:ALT_TITLE: Moving subtrees
+:END:
+#+cindex: external archiving
+
+The most common archiving action is to move a project tree to another
+file, the archive file.
+
+- {{{kbd(C-c C-x C-s)}}} or short {{{kbd(C-c $)}}} (~org-archive-subtree~) ::
+
+ #+kindex: C-c C-x C-s
+ #+kindex: C-c $
+ #+findex: org-archive-subtree
+ #+vindex: org-archive-location
+ Archive the subtree starting at point position to the location given
+ by ~org-archive-location~.
+
+- {{{kbd(C-u C-c C-x C-s)}}} ::
+
+ #+kindex: C-u C-c C-x C-s
+ Check if any direct children of the current headline could be moved
+ to the archive. To do this, check each subtree for open TODO
+ entries. If none is found, the command offers to move it to the
+ archive location. If point is /not/ on a headline when this command
+ is invoked, check level 1 trees.
+
+- {{{kbd(C-u C-u C-c C-x C-s)}}} ::
+
+ #+kindex: C-u C-u C-c C-x C-s
+ As above, but check subtree for timestamps instead of TODO entries.
+ The command offers to archive the subtree if it /does/ contain
+ a timestamp, and that timestamp is in the past.
+
+#+cindex: archive locations
+The default archive location is a file in the same directory as the
+current file, with the name derived by appending =_archive= to the
+current file name. You can also choose what heading to file archived
+items under, with the possibility to add them to a datetree in a file.
+For information and examples on how to specify the file and the
+heading, see the documentation string of the variable
+~org-archive-location~.
+
+There is also an in-buffer option for setting this variable, for
+example:
+
+#+cindex: @samp{ARCHIVE}, keyword
+: #+ARCHIVE: %s_done::
+
+#+cindex: ARCHIVE, property
+If you would like to have a special archive location for a single
+entry or a (sub)tree, give the entry an =ARCHIVE= property with the
+location as the value (see [[*Properties and Columns]]).
+
+#+vindex: org-archive-save-context-info
+When a subtree is moved, it receives a number of special properties
+that record context information like the file from where the entry
+came, its outline path the archiving time etc. Configure the variable
+~org-archive-save-context-info~ to adjust the amount of information
+added.
+
+#+vindex: org-archive-subtree-save-file-p
+When ~org-archive-subtree-save-file-p~ is non-~nil~, save the target
+archive buffer.
+
+*** Internal archiving
+:PROPERTIES:
+:DESCRIPTION: Switch off a tree but keep it in the file.
+:END:
+
+#+cindex: @samp{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 (see [[*Tags]]) stays at
+its location in the outline tree, but behaves in the following way:
+
+-
+ #+vindex: org-cycle-open-archived-trees
+ It does not open when you attempt to do so with a visibility cycling
+ command (see [[*Visibility Cycling]]). You can force cycling archived
+ subtrees with {{{kbd(C-TAB)}}}, or by setting the option
+ ~org-cycle-open-archived-trees~. Also normal outline commands, like
+ ~outline-show-all~, open archived subtrees.
+
+-
+ #+vindex: org-sparse-tree-open-archived-trees
+ During sparse tree construction (see [[*Sparse Trees]]), matches in
+ archived subtrees are not exposed, unless you configure the option
+ ~org-sparse-tree-open-archived-trees~.
+
+-
+ #+vindex: org-agenda-skip-archived-trees
+ During agenda view construction (see [[*Agenda Views]]), the content of
+ archived trees is ignored unless you configure the option
+ ~org-agenda-skip-archived-trees~, in which case these trees are
+ always included. In the agenda you can press {{{kbd(v a)}}} to get
+ archives temporarily included.
+
+-
+ #+vindex: org-export-with-archived-trees
+ Archived trees are not exported (see [[*Exporting]]), only the headline
+ is. Configure the details using the variable
+ ~org-export-with-archived-trees~.
+
+-
+ #+vindex: org-columns-skip-archived-trees
+ Archived trees are excluded from column view unless the variable
+ ~org-columns-skip-archived-trees~ is configured to ~nil~.
+
+The following commands help manage the =ARCHIVE= tag:
+
+- {{{kbd(C-c C-x a)}}} (~org-toggle-archive-tag~) ::
+
+ #+kindex: C-c C-x a
+ #+findex: org-toggle-archive-tag
+ Toggle the archive tag for the current headline. When the tag is
+ set, the headline changes to a shadowed face, and the subtree below
+ it is hidden.
+
+- {{{kbd(C-u C-c C-x a)}}} ::
+
+ #+kindex: C-u C-c C-x a
+ Check if any direct children of the current headline should be
+ archived. To do this, check each subtree for open TODO entries. If
+ none is found, the command offers to set the =ARCHIVE= tag for the
+ child. If point is /not/ on a headline when this command is
+ invoked, check the level 1 trees.
+
+- {{{kbd(C-c C-TAB)}}} (~org-force-cycle-archived~) ::
+
+ #+kindex: C-TAB
+ Cycle a tree even if it is tagged with =ARCHIVE=.
+
+- {{{kbd(C-c C-x A)}}} (~org-archive-to-archive-sibling~) ::
+
+ #+kindex: C-c C-x A
+ #+findex: org-archive-to-archive-sibling
+ Move the current entry to the /Archive Sibling/. This is a sibling
+ of the entry with the heading =Archive= and the archive tag. The
+ entry becomes a child of that sibling and in this way retains a lot
+ of its original context, including inherited tags and approximate
+ position in the outline.
+
+* Capture and Attachments
+:PROPERTIES:
+:DESCRIPTION: Dealing with external data.
+:END:
+#+cindex: capture
+#+cindex: attachments
+#+cindex: RSS feeds
+#+cindex: Atom feeds
+#+cindex: protocols, for external access
+
+An important part of any organization system is the ability to quickly
+capture new ideas and tasks, and to associate reference material with
+them. Org does this using a process called /capture/. It also can
+store files related to a task (/attachments/) in a special directory.
+Finally, it can parse RSS feeds for information. To learn how to let
+external programs (for example a web browser) trigger Org to capture
+material, see [[*Protocols for External Access]].
+
+** Capture
+:PROPERTIES:
+:DESCRIPTION: Capturing new stuff.
+:END:
+#+cindex: capture
+
+Capture lets you quickly store notes with little interruption of your
+work flow. Org's method for capturing new items is heavily inspired
+by John Wiegley's excellent Remember package.
+
+*** Setting up capture
+:PROPERTIES:
+:DESCRIPTION: Where notes will be stored.
+:END:
+
+The following customization sets a default target file for notes.
+
+#+vindex: org-default-notes-file
+#+begin_src emacs-lisp
+(setq org-default-notes-file (concat org-directory "/notes.org"))
+#+end_src
+
+You may also define a global key for capturing new material (see
+[[*Activation]]).
+
+*** Using capture
+:PROPERTIES:
+:DESCRIPTION: Commands to invoke and terminate capture.
+:END:
+
+- {{{kbd(M-x org-capture)}}} (~org-capture~) ::
+
+ #+findex: org-capture
+ #+cindex: date tree
+ Display the capture templates menu. If you have templates defined
+ (see [[*Capture templates]]), it offers these templates for selection or
+ use a new Org outline node as the default template. It inserts the
+ template into the target file and switch to an indirect buffer
+ narrowed to this new node. You may then insert the information you
+ want.
+
+- {{{kbd(C-c C-c)}}} (~org-capture-finalize~) ::
+
+ #+kindex: C-c C-c @r{(Capture buffer)}
+ #+findex: org-capture-finalize
+ Once you have finished entering information into the capture buffer,
+ {{{kbd(C-c C-c)}}} returns you to the window configuration before
+ the capture process, so that you can resume your work without
+ further distraction. When called with a prefix argument, finalize
+ and then jump to the captured item.
+
+- {{{kbd(C-c C-w)}}} (~org-capture-refile~) ::
+
+ #+kindex: C-c C-w @r{(Capture buffer)}
+ #+findex: org-capture-refile
+ Finalize the capture process by refiling the note to a different
+ place (see [[*Refile and Copy]]). Please realize that this is a normal
+ refiling command that will be executed---so point position at the
+ moment you run this command is important. If you have inserted
+ a tree with a parent and children, first move point back to the
+ parent. Any prefix argument given to this command is passed on to
+ the ~org-refile~ command.
+
+- {{{kbd(C-c C-k)}}} (~org-capture-kill~) ::
+
+ #+kindex: C-c C-k @r{(Capture buffer)}
+ #+findex: org-capture-kill
+ Abort the capture process and return to the previous state.
+
+#+kindex: k c @r{(Agenda)}
+You can also call ~org-capture~ in a special way from the agenda,
+using the {{{kbd(k c)}}} key combination. With this access, any
+timestamps inserted by the selected capture template defaults to the
+date at point in the agenda, rather than to the current date.
+
+To find the locations of the last stored capture, use ~org-capture~
+with prefix commands:
+
+- {{{kbd(C-u M-x org-capture)}}} ::
+
+ Visit the target location of a capture template. You get to select
+ the template in the usual way.
+
+- {{{kbd(C-u C-u M-x org-capture)}}} ::
+
+ Visit the last stored capture item in its buffer.
+
+#+vindex: org-capture-bookmark
+#+vindex: org-capture-last-stored
+You can also jump to the bookmark ~org-capture-last-stored~, which is
+automatically created unless you set ~org-capture-bookmark~ to ~nil~.
+
+To insert the capture at point in an Org buffer, call ~org-capture~
+with a {{{kbd(C-0)}}} prefix argument.
+
+*** Capture templates
+:PROPERTIES:
+:DESCRIPTION: Define the outline of different note types.
+:END:
+#+cindex: templates, for Capture
+
+You can use templates for different types of capture items, and for
+different target locations. The easiest way to create such templates
+is through the customize interface.
+
+- {{{kbd(C)}}} ::
+
+ #+kindex: C @r{(Capture menu}
+ #+vindex: org-capture-templates
+ Customize the variable ~org-capture-templates~.
+
+Before we give the formal description of template definitions, let's
+look at an example. Say you would like to use one template to create
+general TODO entries, and you want to put these entries under the
+heading =Tasks= in your file =~/org/gtd.org=. Also, a date tree in
+the file =journal.org= should capture journal entries. A possible
+configuration would look like:
+
+#+begin_src emacs-lisp
+(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")
+ "* %?\nEntered on %U\n %i\n %a")))
+#+end_src
+
+If you then press {{{kbd(t)}}} from the capture menu, Org will prepare
+the template for you like this:
+
+#+begin_example
+,* TODO
+ [[file:LINK TO WHERE YOU INITIATED CAPTURE]]
+#+end_example
+
+#+texinfo: @noindent
+During expansion of the template, =%a= has been replaced by a link to
+the location from where you called the capture command. This can be
+extremely useful for deriving tasks from emails, for example. You
+fill in the task definition, press {{{kbd(C-c C-c)}}} and Org returns
+you to the same place where you started the capture process.
+
+To define special keys to capture to a particular template without
+going through the interactive template selection, you can create your
+key binding like this:
+
+#+begin_src emacs-lisp
+(define-key global-map (kbd "C-c x")
+ (lambda () (interactive) (org-capture nil "x")))
+#+end_src
+
+**** Template elements
+:PROPERTIES:
+:DESCRIPTION: What is needed for a complete template entry.
+:END:
+
+Now lets look at the elements of a template definition. Each entry in
+~org-capture-templates~ is a list with the following items:
+
+- keys ::
+
+ The keys that selects the template, as a string, characters only,
+ for example ="a"=, for a template to be selected with a single key,
+ or ="bt"= for selection with two keys. When using several keys,
+ keys using the same prefix key must be sequential in the list and
+ preceded by a 2-element entry explaining the prefix key, for
+ example:
+
+ #+begin_src emacs-lisp
+ ("b" "Templates for marking stuff to buy")
+ #+end_src
+
+ If you do not define a template for the {{{kbd(C)}}} key, this key
+ opens the Customize buffer for this complex variable.
+
+- description ::
+
+ A short string describing the template, shown during selection.
+
+- type ::
+
+ The type of entry, a symbol. Valid values 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. The target file should
+ be an Org file.
+
+ - ~item~ ::
+
+ A plain list item, placed in the first plain list at the target
+ location. Again the target file should be an Org file.
+
+ - ~checkitem~ ::
+
+ A checkbox item. This only differs from the plain list item by
+ the default template.
+
+ - ~table-line~ ::
+
+ A new line in the first table at the target location. Where
+ exactly the line will be inserted depends on the properties
+ ~:prepend~ and ~:table-line-pos~ (see below).
+
+ - ~plain~ ::
+
+ Text to be inserted as it is.
+
+- target ::
+
+ #+vindex: org-default-notes-file
+ #+vindex: org-directory
+ Specification of where the captured item should be placed. 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 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")= ::
+
+ Filing as child of this entry, or in the body of the entry.
+
+ - =(file+headline "filename" "node headline")= ::
+
+ Fast configuration if the target heading is unique in the file.
+
+ - =(file+olp "filename" "Level 1 heading" "Level 2" ...)= ::
+
+ For non-unique headings, the full path is safer.
+
+ - =(file+regexp "filename" "regexp to find location")= ::
+
+ Use a regular expression to position point.
+
+ - =(file+olp+datetree "filename" [ "Level 1 heading" ...])= ::
+
+ This target[fn:84] creates a heading in a date tree[fn:85] 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 ~:time-prompt~ and ~:tree-type~ properties
+ below for additional options.
+
+ - =(file+function "filename" function-finding-location)= ::
+
+ A function to find the right location in the file.
+
+ - =(clock)= ::
+
+ File to the entry that is currently being clocked.
+
+ - =(function function-finding-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. Otherwise this
+ is a string with escape codes, which will be replaced depending on
+ time and context of the capture call. You may also get this
+ template string from a file[fn:86], or dynamically, from a function
+ using either syntax:
+
+ : (file "/path/to/template-file")
+ : (function FUNCTION-RETURNING-THE-TEMPLATE)
+
+- properties ::
+
+ The rest of the entry is a property list of additional options.
+ Recognized properties are:
+
+ - ~:prepend~ ::
+
+ Normally new captured information will be appended at the target
+ location (last child, last table line, last list item, ...).
+ Setting this property changes that.
+
+ - ~:immediate-finish~ ::
+
+ When set, do not offer to edit the information, just file it away
+ immediately. This makes sense if the template only needs
+ information that can be added automatically.
+
+ - ~:jump-to-captured~ ::
+
+ When set, jump to the captured entry when finished.
+
+ - ~:empty-lines~ ::
+
+ Set this to the number of lines to insert before and after the new
+ item. Default 0, and the only other common value is 1.
+
+ - ~:empty-lines-after~ ::
+
+ Set this to the number of lines that should be inserted after the
+ new item. Overrides ~:empty-lines~ for the number of lines
+ inserted after.
+
+ - ~:empty-lines-before~ ::
+
+ Set this to the number of lines that should be inserted before the
+ new item. Overrides ~:empty-lines~ for the number lines inserted
+ before.
+
+ - ~:clock-in~ ::
+
+ Start the clock in this item.
+
+ - ~:clock-keep~ ::
+
+ Keep the clock running when filing the captured entry.
+
+ - ~:clock-resume~ ::
+
+ If starting the capture interrupted a clock, restart that clock
+ when finished with the capture. Note that ~:clock-keep~ has
+ precedence over ~:clock-resume~. When setting both to non-~nil~,
+ 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. 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 ~org-capture~ with
+ a {{{kbd(C-1)}}} prefix argument.
+
+ - ~:tree-type~ ::
+
+ Use ~week~ to make a week tree instead of the month-day tree,
+ i.e., place the headings for each day under a heading with the
+ current ISO week. Use ~month~ to group entries by month
+ only. Default is to group entries by day.
+
+ - ~: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.
+
+ - ~:table-line-pos~ ::
+
+ Specification of the location in the table where the new line
+ should be inserted. It should be a string like =II-3= meaning
+ that the new line should become the third line before the second
+ horizontal separator line.
+
+ - ~:kill-buffer~ ::
+
+ If the target file was not yet visited when capture was invoked,
+ kill the buffer again after capture is completed.
+
+ - ~:no-save~ ::
+
+ Do not save the target file after finishing the capture.
+
+**** Template expansion
+:PROPERTIES:
+:DESCRIPTION: Filling in information about time and context.
+:END:
+
+In the template itself, special "%-escapes"[fn:87] allow dynamic
+insertion of content. The templates are expanded in the order given
+here:
+
+- =%[FILE]= ::
+
+ Insert the contents of the file given by {{{var(FILE)}}}.
+
+- =%(EXP)= ::
+
+ Evaluate Elisp expression {{{var(EXP)}}} and replace it with the
+ result. The {{{var(EXP)}}} form must return a string. Only
+ placeholders pre-existing within the template, or introduced with
+ =%[file]=, are expanded this way. Since this happens after
+ expanding non-interactive "%-escapes", those can be used to fill the
+ expression.
+
+- =%<FORMAT>= ::
+
+ The result of format-time-string on the {{{var(FORMAT)}}}
+ specification.
+
+- =%t= ::
+
+ Timestamp, date only.
+
+- =%T= ::
+
+ Timestamp, with date and time.
+
+- =%u=, =%U= ::
+
+ Like =%t=, =%T= above, but inactive timestamps.
+
+- =%i= ::
+
+ Initial content, the region when capture is called while the region
+ is active. If there is text before =%i= on the same line, such as
+ indentation, and =%i= is not inside a =%(exp)= form, that prefix is
+ added before every line in the inserted text.
+
+- =%a= ::
+
+ Annotation, normally the link created with ~org-store-link~.
+
+- =%A= ::
+
+ Like =%a=, but prompt for the description part.
+
+- =%l= ::
+
+ Like =%a=, but only insert the literal link.
+
+- =%c= ::
+
+ Current kill ring head.
+
+- =%x= ::
+
+ Content of the X clipboard.
+
+- =%k= ::
+
+ Title of the currently clocked task.
+
+- =%K= ::
+
+ Link to the currently clocked task.
+
+- =%n= ::
+
+ User name (taken from ~user-full-name~).
+
+- =%f= ::
+
+ File visited by current buffer when org-capture was called.
+
+- =%F= ::
+
+ Full path of the file or directory visited by current buffer.
+
+- =%:keyword= ::
+
+ Specific information for certain link types, see below.
+
+- =%^g= ::
+
+ Prompt for tags, with completion on tags in target file.
+
+- =%^G= ::
+
+ Prompt for tags, with completion all tags in all agenda files.
+
+- =%^t= ::
+
+ Like =%t=, but prompt for date. Similarly =%^T=, =%^u=, =%^U=. You
+ may define a prompt like =%^{Birthday}t=.
+
+- =%^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 {{{var(PROP)}}}.
+
+- =%^{PROMPT}= ::
+
+ Prompt the user for a string and replace this sequence with it. You
+ may specify a default value and a completion table with
+ =%^{prompt|default|completion2|completion3...}=. The arrow keys
+ access a prompt-specific history.
+
+- =%\N= ::
+
+ Insert the text entered at the {{{var(N)}}}th =%^{PROMPT}=, where
+ {{{var(N)}}} is a number, starting from 1.
+
+- =%?= ::
+
+ After completing the template, position point here.
+
+#+vindex: org-store-link-props
+For specific link types, the following keywords are defined[fn:88]:
+
+#+vindex: org-link-from-user-regexp
+| Link type | Available keywords |
+|--------------+----------------------------------------------------------|
+| bbdb | =%:name=, =%:company= |
+| irc | =%:server=, =%:port=, =%:nick= |
+| mh, rmail | =%:type=, =%:subject=, =%:message-id= |
+| | =%:from=, =%:fromname=, =%:fromaddress= |
+| | =%:to=, =%:toname=, =%:toaddress= |
+| | =%:date= (message date header field) |
+| | =%:date-timestamp= (date as active timestamp) |
+| | =%:date-timestamp-inactive= (date as inactive timestamp) |
+| | =%:fromto= (either "to NAME" or "from NAME")[fn:89] |
+| gnus | =%:group=, for messages also all email fields |
+| w3, w3m | =%:url= |
+| info | =%:file=, =%:node= |
+| calendar | =%:date= |
+| org-protocol | =%:link=, =%:description=, =%:annotation= |
+
+**** Templates in contexts
+:PROPERTIES:
+:DESCRIPTION: Only show a template in a specific context.
+:END:
+
+#+vindex: org-capture-templates-contexts
+To control whether a capture template should be accessible from
+a specific context, you can customize
+~org-capture-templates-contexts~. Let's say, for example, that you
+have a capture template "p" for storing Gnus emails containing
+patches. Then you would configure this option like this:
+
+#+begin_src emacs-lisp
+(setq org-capture-templates-contexts
+ '(("p" (in-mode . "message-mode"))))
+#+end_src
+
+You can also tell that the command key {{{kbd(p)}}} should refer to
+another template. In that case, add this command key like this:
+
+#+begin_src emacs-lisp
+(setq org-capture-templates-contexts
+ '(("p" "q" (in-mode . "message-mode"))))
+#+end_src
+
+See the docstring of the variable for more information.
+
+** Attachments
+:PROPERTIES:
+:DESCRIPTION: Attach files to outlines.
+:END:
+#+cindex: attachments
+
+It is often useful to associate reference material with an outline
+node. Small chunks of plain text can simply be stored in the subtree
+of a project. Hyperlinks (see [[*Hyperlinks]]) can establish associations
+with files that live elsewhere on a local, or even remote, computer,
+like emails or source code files belonging to a project.
+
+Another method is /attachments/, which are files located in a
+directory belonging to an outline node. Org uses directories either
+named by a unique ID of each entry, or by a =DIR= property.
+
+*** Attachment defaults and dispatcher
+:PROPERTIES:
+:DESCRIPTION: How to access attachment commands
+:END:
+
+By default, Org attach uses ID properties when adding attachments to
+outline nodes. This makes working with attachments fully automated.
+There is no decision needed for folder-name or location. ID-based
+directories are by default located in the =data/= directory, which
+lives in the same directory where your Org file lives[fn:90].
+
+When attachments are made using ~org-attach~ a default tag =ATTACH= is
+added to the node that gets the attachments.
+
+For more control over the setup, see [[*Attachment options]].
+
+The following commands deal with attachments:
+
+- {{{kbd(C-c C-a)}}} (~org-attach~) ::
+
+ #+kindex: C-c C-a
+ #+findex: org-attach
+ The dispatcher for commands related to the attachment system. After
+ these keys, a list of commands is displayed and you must press an
+ additional key to select a command:
+
+ - {{{kbd(a)}}} (~org-attach-attach~) ::
+
+ #+kindex: C-c C-a a
+ #+findex: org-attach-attach
+ #+vindex: org-attach-method
+ Select a file and move it into the task's attachment directory.
+ The file is copied, moved, or linked, depending on
+ ~org-attach-method~. Note that hard links are not supported on
+ all systems.
+
+ - {{{kbd(c)}}}/{{{kbd(m)}}}/{{{kbd(l)}}} ::
+
+ #+kindex: C-c C-a c
+ #+kindex: C-c C-a m
+ #+kindex: C-c C-a l
+ Attach a file using the copy/move/link method. Note that hard
+ links are not supported on all systems.
+
+ - {{{kbd(b)}}} (~org-attach-buffer~) ::
+
+ #+kindex: C-c C-a b
+ #+findex: org-attach-buffer
+ Select a buffer and save it as a file in the task's attachment
+ directory.
+
+ - {{{kbd(n)}}} (~org-attach-new~) ::
+
+ #+kindex: C-c C-a n
+ #+findex: org-attach-new
+ Create a new attachment as an Emacs buffer.
+
+ - {{{kbd(z)}}} (~org-attach-sync~) ::
+
+ #+kindex: C-c C-a z
+ #+findex: org-attach-sync
+ Synchronize the current task with its attachment directory, in
+ case you added attachments yourself.
+
+ - {{{kbd(o)}}} (~org-attach-open~) ::
+
+ #+kindex: C-c C-a o
+ #+findex: org-attach-open
+ #+vindex: org-file-apps
+ Open current task's attachment. If there is more than one, prompt
+ for a file name first. Opening follows the rules set by
+ ~org-file-apps~. For more details, see the information on
+ following hyperlinks (see [[*Handling Links]]).
+
+ - {{{kbd(O)}}} (~org-attach-open-in-emacs~) ::
+
+ #+kindex: C-c C-a O
+ #+findex: org-attach-open-in-emacs
+ Also open the attachment, but force opening the file in Emacs.
+
+ - {{{kbd(f)}}} (~org-attach-reveal~) ::
+
+ #+kindex: C-c C-a f
+ #+findex: org-attach-reveal
+ Open the current task's attachment directory.
+
+ - {{{kbd(F)}}} (~org-attach-reveal-in-emacs~) ::
+
+ #+kindex: C-c C-a F
+ #+findex: org-attach-reveal-in-emacs
+ Also open the directory, but force using Dired in Emacs.
+
+ - {{{kbd(d)}}} (~org-attach-delete-one~) ::
+
+ #+kindex: C-c C-a d
+ Select and delete a single attachment.
+
+ - {{{kbd(D)}}} (~org-attach-delete-all~) ::
+
+ #+kindex: C-c C-a D
+ Delete all of a task's attachments. A safer way is to open the
+ directory in Dired and delete from there.
+
+ - {{{kbd(s)}}} (~org-attach-set-directory~) ::
+
+ #+kindex: C-c C-a s
+ #+cindex: @samp{DIR}, property
+ Set a specific directory as the entry's attachment directory.
+ This works by putting the directory path into the =DIR=
+ property.
+
+ - {{{kbd(S)}}} (~org-attach-unset-directory~) ::
+
+ #+kindex: C-c C-a S
+ #+cindex: @samp{DIR}, property
+ Remove the attachment directory. This command removes the =DIR=
+ property and asks the user to either move content inside that
+ folder, if an =ID= property is set, delete the content, or to
+ leave the attachment directory as is but no longer attached to the
+ outline node.
+
+*** Attachment options
+:PROPERTIES:
+:DESCRIPTION: Configuring the attachment system
+:END:
+
+There are a couple of options for attachments that are worth
+mentioning.
+
+- ~org-attach-id-dir~ ::
+ #+vindex: org-attach-id-dir
+ The directory where attachments are stored when =ID= is used as
+ method.
+
+- ~org-attach-dir-relative~ ::
+ #+vindex: org-attach-dir-relative
+ When setting the =DIR= property on a node using {{{kbd(C-c C-a s)}}}
+ (~org-attach-set-directory~), absolute links are entered by default.
+ This option changes that to relative links.
+
+- ~org-attach-use-inheritance~ ::
+ #+vindex: org-attach-use-inheritance
+ By default folders attached to an outline node are inherited from
+ parents according to ~org-use-property-inheritance~. If one instead
+ want to set inheritance specifically for Org attach that can be done
+ using ~org-attach-use-inheritance~. Inheriting documents through
+ the node hierarchy makes a lot of sense in most cases. Especially
+ when using attachment links (see [[*Attachment links]]). The following
+ example shows one use case for attachment inheritance:
+
+ #+begin_example
+ ,* Chapter A ...
+ :PROPERTIES:
+ :DIR: Chapter A/
+ :END:
+ ,** Introduction
+ Some text
+
+ #+NAME: Image 1
+ [[attachment:image 1.jpg]]
+ #+end_example
+
+ Without inheritance one would not be able to resolve the link to
+ =image 1.jpg=, since the link is inside a sub-heading to =Chapter
+ A=.
+
+ Inheritance works the same way for both =ID= and =DIR= property. If
+ both properties are defined on the same headline then =DIR= takes
+ precedence. This is also true if inheritance is enabled. If =DIR=
+ is inherited from a parent node in the outline, that property still
+ takes precedence over an =ID= property defined on the node itself.
+
+- ~org-attach-method~ ::
+ #+vindex: org-attach-method
+ When attaching files using the dispatcher {{{kbd(C-c C-a)}}} it
+ defaults to copying files. The behavior can be changed by
+ customizing ~org-attach-method~. Options are Copy, Move/Rename,
+ Hard link or Symbolic link.
+
+- ~org-attach-preferred-new-method~ ::
+ #+vindex: org-attach-preferred-new-method
+ This customization lets you choose the default way to attach to
+ nodes without existing =ID= and =DIR= property. It defaults to ~id~
+ but can also be set to ~dir~, ~ask~ or ~nil~.
+
+- ~org-attach-archive-delete~ ::
+ #+vindex: org-attach-archive-delete
+ Configure this to determine if attachments should be deleted or not
+ when a subtree that has attachments is archived.
+
+- ~org-attach-auto-tag~ ::
+ #+vindex: org-attach-auto-tag
+ When attaching files to a heading it will be assigned a tag
+ according to what is set here.
+
+- ~org-attach-id-to-path-function-list~ ::
+ #+vindex: org-attach-id-to-path-function-list
+ When =ID= is used for attachments, the ID is parsed into a part of a
+ directory-path. See ~org-attach-id-uuid-folder-format~ for the
+ default function. Define a new one and add it as first element in
+ ~org-attach-id-to-path-function-list~ if you want the folder
+ structure in any other way. All functions in this list will be
+ tried when resolving existing ID's into paths, to maintain backward
+ compatibility with existing folders in your system.
+
+- ~org-attach-store-link-p~ ::
+ #+vindex: org-attach-store-link-p
+ Stores a link to the file that is being attached. The link is
+ stored in ~org-stored-links~ for later insertion with {{{kbd(C-c
+ C-l)}}} (see [[*Handling Links]]). Depending on what option is set in
+ ~org-attach-store-link-p~, the link is stored to either the original
+ location as a file link, the attachment location as an attachment
+ link or to the attachment location as a file link.
+
+- ~org-attach-commands~ ::
+ #+vindex: org-attach-commands
+ List of all commands used in the attach dispatcher.
+
+- ~org-attach-expert~ ::
+ #+vindex: org-attach-expert
+ Do not show the splash buffer with the attach dispatcher when
+ ~org-attach-expert~ is set to non-~nil~.
+
+See customization group =Org Attach= if you want to change the
+default settings.
+
+*** Attachment links
+:PROPERTIES:
+:DESCRIPTION: Hyperlink access to attachments
+:END:
+
+Attached files and folders can be referenced using attachment links.
+This makes it easy to refer to the material added to an outline node.
+Especially if it was attached using the unique ID of the entry!
+
+#+begin_example
+,* TODO Some task
+ :PROPERTIES:
+ :ID: 95d50008-c12e-479f-a4f2-cc0238205319
+ :END:
+See attached document for more information: [[attachment:info.org]]
+#+end_example
+
+See [[*External Links]] for more information about these links.
+
+*** Automatic version-control with Git
+:PROPERTIES:
+:DESCRIPTION: Everything safely stored away
+:END:
+
+If the directory attached to an outline node is a Git repository, Org
+can be configured to automatically commit changes to that repository
+when it sees them.
+
+To make Org mode take care of versioning of attachments for you, add
+the following to your Emacs config:
+
+#+begin_src emacs-lisp
+ (require 'org-attach-git)
+#+end_src
+
+*** Attach from Dired
+:PROPERTIES:
+:DESCRIPTION: Using dired to select an attachment
+:END:
+#+cindex: attach from Dired
+#+findex: org-attach-dired-to-subtree
+
+It is possible to attach files to a subtree from a Dired buffer. To
+use this feature, have one window in Dired mode containing the file(s)
+to be attached and another window with point in the subtree that shall
+get the attachments. In the Dired window, with point on a file,
+{{{kbd(M-x org-attach-dired-to-subtree)}}} attaches the file to the
+subtree using the attachment method set by variable
+~org-attach-method~. When files are marked in the Dired window then
+all marked files get attached.
+
+Add the following lines to the Emacs init file to have {{{kbd(C-c C-x
+a)}}} attach files in Dired buffers.
+
+#+begin_src emacs-lisp
+(add-hook 'dired-mode-hook
+ (lambda ()
+ (define-key dired-mode-map
+ (kbd "C-c C-x a")
+ #'org-attach-dired-to-subtree)))
+#+end_src
+
+The following code shows how to bind the previous command with
+a specific attachment method.
+
+#+begin_src emacs-lisp
+(add-hook 'dired-mode-hook
+ (lambda ()
+ (define-key dired-mode-map (kbd "C-c C-x c")
+ (lambda ()
+ (interactive)
+ (let ((org-attach-method 'cp))
+ (call-interactively #'org-attach-dired-to-subtree))))))
+#+end_src
+
+** RSS Feeds
+:PROPERTIES:
+:DESCRIPTION: Getting input from RSS feeds.
+:END:
+#+cindex: RSS feeds
+#+cindex: Atom feeds
+
+Org can add and change entries based on information found in RSS feeds
+and Atom feeds. You could use this to make a task out of each new
+podcast in a podcast feed. Or you could use a phone-based
+note-creating service on the web to import tasks into Org. To access
+feeds, configure the variable ~org-feed-alist~. The docstring of this
+variable has detailed information. With the following
+
+#+begin_src emacs-lisp
+(setq org-feed-alist
+ '(("Slashdot"
+ "http://rss.slashdot.org/Slashdot/slashdot"
+ "~/txt/org/feeds.org" "Slashdot Entries")))
+#+end_src
+
+#+texinfo: @noindent
+new items from the feed provided by =rss.slashdot.org= result in new
+entries in the file =~/org/feeds.org= under the heading =Slashdot
+Entries=, whenever the following command is used:
+
+- {{{kbd(C-c C-x g)}}} (~org-feed-update-all~) ::
+
+ #+kindex: C-c C-x g
+ Collect items from the feeds configured in ~org-feed-alist~ and act
+ upon them.
+
+- {{{kbd(C-c C-x G)}}} (~org-feed-goto-inbox~) ::
+
+ #+kindex: C-c C-x G
+ Prompt for a feed name and go to the inbox configured for this feed.
+
+Under the same headline, Org creates a drawer =FEEDSTATUS= in which it
+stores information about the status of items in the feed, to avoid
+adding the same item several times.
+
+For more information, including how to read atom feeds, see
+=org-feed.el= and the docstring of ~org-feed-alist~.
+
+* Agenda Views
+:PROPERTIES:
+:DESCRIPTION: Collecting information into views.
+:END:
+#+cindex: agenda views
+
+Due to the way Org works, TODO items, time-stamped items, and tagged
+headlines can be scattered throughout a file or even a number of
+files. To get an overview of open action items, or of events that are
+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. Six different view types are provided:
+
+- an /agenda/ that is like a calendar and shows information for
+ specific dates,
+
+- a /TODO list/ that covers all unfinished action items,
+
+- a /match view/, showings headlines based on the tags, properties,
+ and TODO state associated with them,
+
+- a /text search view/ that shows all entries from multiple files that
+ contain specified keywords,
+
+- a /stuck projects view/ showing projects that currently do not move
+ along, and
+
+- /custom views/ that are special searches and combinations of
+ different views.
+
+The extracted information is displayed in a special /agenda 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 (see [[*Comment Lines]]) and
+archived (see [[*Internal archiving]]) entries. You can override this by
+setting ~org-agenda-skip-comment-trees~ and
+~org-agenda-skip-archived-trees~ to ~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 window configuration is restored when the agenda exits:
+~org-agenda-window-setup~ and ~org-agenda-restore-windows-after-quit~.
+
+** Agenda Files
+:PROPERTIES:
+:DESCRIPTION: Files being searched for agenda information.
+:END:
+#+cindex: agenda files
+#+cindex: files for agenda
+
+#+vindex: org-agenda-files
+The information to be shown is normally collected from all /agenda
+files/, the files listed in the variable ~org-agenda-files~[fn:91].
+If a directory is part of this list, all files with the extension
+=.org= in this directory are part of the list.
+
+Thus, even if you only work with a single Org file, that file should
+be put into the list[fn:92]. You can customize ~org-agenda-files~,
+but the easiest way to maintain it is through the following commands
+
+#+attr_texinfo: :sep and
+- {{{kbd(C-c [)}}} (~org-agenda-file-to-front~) ::
+
+ #+kindex: C-c [
+ #+findex: org-agenda-file-to-front
+ #+cindex: files, adding to agenda list
+ Add current file to the list of agenda files. The file is added to
+ the front of the list. If it was already in the list, it is moved
+ to the front. With a prefix argument, file is added/moved to the
+ end.
+
+- {{{kbd(C-c ])}}} (~org-remove-file~) ::
+
+ #+kindex: C-c ]
+ #+findex: org-remove-file
+ Remove current file from the list of agenda files.
+
+- {{{kbd(C-')}}} and {{{kbd(C-\,)}}} (~org-cycle-agenda-files~) ::
+
+ #+kindex: C-'
+ #+kindex: C-,
+ #+findex: org-cycle-agenda-files
+ #+cindex: cycling, of agenda files
+ Cycle through agenda file list, visiting one file after the other.
+
+- {{{kbd(M-x org-switchb)}}} ::
+
+ #+findex: org-switchb
+ Command to use an Iswitchb-like interface to switch to and between
+ Org buffers.
+
+#+texinfo: @noindent
+The Org menu contains the current list of files and can be used to
+visit any of them.
+
+If you would like to focus the agenda temporarily on a file not in
+this list, or on just one file in the list, or even on only a subtree
+in a file, then this can be done in different ways. For a single
+agenda command, you may press {{{kbd(<)}}} once or several times in
+the dispatcher (see [[*The Agenda Dispatcher]]). To restrict the agenda
+scope for an extended period, use the following commands:
+
+- {{{kbd(C-c C-x <)}}} (~org-agenda-set-restriction-lock~) ::
+
+ #+kindex: C-c C-x <
+ #+findex: org-agenda-set-restriction-lock
+ Restrict the agenda to the current subtree. If there already is
+ a restriction at point, remove it. When called with a universal
+ prefix argument or with point before the first headline in a file,
+ set the agenda scope to the entire file. This restriction remains
+ in effect until removed with {{{kbd(C-c C-x >)}}}, or by typing
+ either {{{kbd(<)}}} or {{{kbd(>)}}} in the agenda dispatcher. If
+ there is a window displaying an agenda view, the new restriction
+ takes effect immediately.
+
+- {{{kbd(C-c C-x >)}}} (~org-agenda-remove-restriction-lock~) ::
+
+ #+kindex: C-c C-x >
+ #+findex: org-agenda-remove-restriction-lock
+ Remove the restriction created by {{{kbd(C-c C-x <)}}}.
+
+When working with Speedbar, you can use the following commands in the
+Speedbar frame:
+
+- {{{kbd(<)}}} (~org-speedbar-set-agenda-restriction~) ::
+
+ #+findex: org-speedbar-set-agenda-restriction
+ Restrict the agenda to the item---either an Org file or a subtree in
+ such a file---at point in the Speedbar frame. If agenda is already
+ restricted there, remove the restriction. If there is a window
+ displaying an agenda view, the new restriction takes effect
+ immediately.
+
+- {{{kbd(>)}}} (~org-agenda-remove-restriction-lock~) ::
+
+ #+findex: org-agenda-remove-restriction-lock
+ Remove the restriction.
+
+** The Agenda Dispatcher
+:PROPERTIES:
+:DESCRIPTION: Keyboard access to agenda views.
+:ALT_TITLE: Agenda Dispatcher
+:END:
+#+cindex: agenda dispatcher
+#+cindex: dispatching agenda commands
+
+The views are created through a dispatcher, accessible with {{{kbd(M-x
+org-agenda)}}}, or, better, bound to a global key (see [[*Activation]]).
+It displays a menu from which an additional letter is required to
+execute a command. The dispatcher offers the following default
+commands:
+
+#+attr_texinfo: :sep ,
+- {{{kbd(a)}}} ::
+
+ Create the calendar-like agenda (see [[*Weekly/daily agenda]]).
+
+- {{{kbd(t)}}}, {{{kbd(T)}}} ::
+
+ Create a list of all TODO items (see [[*The global TODO list]]).
+
+- {{{kbd(m)}}}, {{{kbd(M)}}} ::
+
+ Create a list of headlines matching a given expression (see
+ [[*Matching tags and properties]]).
+
+- {{{kbd(s)}}} ::
+
+ #+kindex: s @r{(Agenda dispatcher)}
+ 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.
+
+- {{{kbd(/)}}} ::
+
+ #+kindex: / @r{(Agenda dispatcher)}
+ #+vindex: org-agenda-text-search-extra-files
+ Search for a regular expression in all agenda files and additionally
+ in the files listed in ~org-agenda-text-search-extra-files~. This
+ uses the Emacs command ~multi-occur~. A prefix argument can be used
+ to specify the number of context lines for each match, default is
+ 1.
+
+- {{{kbd(#)}}} ::
+
+ Create a list of stuck projects (see [[*Stuck projects]]).
+
+- {{{kbd(!)}}} ::
+
+ Configure the list of stuck projects (see [[*Stuck projects]]).
+
+- {{{kbd(<)}}} ::
+
+ #+kindex: < @r{(Agenda dispatcher)}
+ Restrict an agenda command to the current buffer[fn:93]. If
+ narrowing is in effect restrict to the narrowed part of the buffer.
+ After pressing {{{kbd(<)}}}, you still need to press the character
+ selecting the command.
+
+- {{{kbd(< <)}}} ::
+
+ #+kindex: < < @r{(Agenda dispatcher)}
+ If there is an active region, restrict the following agenda command
+ to the region. Otherwise, restrict it to the current
+ subtree[fn:94]. After pressing {{{kbd(< <)}}}, you still need to
+ press the character selecting the command.
+
+- {{{kbd(*)}}} ::
+
+ #+kindex: * @r{(Agenda dispatcher)}
+ #+vindex: org-agenda-sticky
+ #+findex: org-toggle-sticky-agenda
+ 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
+ ~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 ~org-toggle-sticky-agenda~.
+
+You can also define custom commands that are accessible through the
+dispatcher, just like the default commands. This includes the
+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. See [[*Custom Agenda Views]].
+
+** The Built-in Agenda Views
+:PROPERTIES:
+:DESCRIPTION: What is available out of the box?
+:ALT_TITLE: Built-in Agenda Views
+:END:
+
+In this section we describe the built-in views.
+
+*** Weekly/daily agenda
+:PROPERTIES:
+:DESCRIPTION: The calendar page with current tasks.
+:END:
+#+cindex: agenda
+#+cindex: weekly agenda
+#+cindex: daily agenda
+
+The purpose of the weekly/daily /agenda/ is to act like a page of
+a paper agenda, showing all the tasks for the current week or day.
+
+- {{{kbd(M-x org-agenda a)}}} (~org-agenda-list~) ::
+
+ #+kindex: a @r{(Agenda dispatcher)}
+ #+findex: org-agenda-list
+ #+cindex: org-agenda, command
+ Compile an agenda for the current week from a list of Org files.
+ The agenda shows the entries for each day. With a numeric prefix
+ argument[fn:95]---like {{{kbd(C-u 2 1 M-x org-agenda a)}}}---you may
+ set the number of days to be displayed.
+
+#+vindex: org-agenda-span
+#+vindex: org-agenda-start-day
+#+vindex: org-agenda-start-on-weekday
+The default number of days displayed in the agenda is set by the
+variable ~org-agenda-span~. This variable can be set to any number of
+days you want to see by default in the agenda, or to a span name, such
+a ~day~, ~week~, ~month~ or ~year~. For weekly agendas, the default
+is to start on the previous Monday (see
+~org-agenda-start-on-weekday~). You can also set the start date using
+a date shift: =(setq org-agenda-start-day "+10d")= starts the agenda
+ten days from today in the future.
+
+Remote editing from the agenda buffer means, for example, that you can
+change the dates of deadlines and appointments from the agenda buffer.
+The commands available in the Agenda buffer are listed in [[*Commands in
+the Agenda Buffer]].
+
+**** Calendar/Diary integration
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: calendar integration
+#+cindex: diary integration
+
+Emacs contains the calendar and diary by Edward\nbsp{}M.\nbsp{}Reingold. The
+calendar displays a three-month calendar with holidays from different
+countries and cultures. The diary allows you to keep track of
+anniversaries, lunar phases, sunrise/set, recurrent appointments
+(weekly, monthly) and more. In this way, it is quite complementary to
+Org. It can be very useful to combine output from Org with the diary.
+
+In order to include entries from the Emacs diary into Org mode's
+agenda, you only need to customize the variable
+
+#+begin_src emacs-lisp
+(setq org-agenda-include-diary t)
+#+end_src
+
+#+texinfo: @noindent
+After that, everything happens automatically. All diary entries
+including holidays, anniversaries, etc., are included in the agenda
+buffer created by Org mode. {{{kbd(SPC)}}}, {{{kbd(TAB)}}}, and
+{{{kbd(RET)}}} can be used from the agenda buffer to jump to the diary
+file in order to edit existing diary entries. The {{{kbd(i)}}}
+command to insert new entries for the current date works in the agenda
+buffer, as well as the commands {{{kbd(S)}}}, {{{kbd(M)}}}, and
+{{{kbd(C)}}} to display Sunrise/Sunset times, show lunar phases and to
+convert to other calendars, respectively. {{{kbd(c)}}} can be used to
+switch back and forth between calendar and agenda.
+
+If you are using the diary only for expression entries and holidays,
+it is faster to not use the above setting, but instead to copy or even
+move the entries into an Org file. Org mode evaluates diary-style
+expression entries, and does it faster because there is no overhead
+for first creating the diary display. Note that the expression
+entries must start at the left margin, no whitespace is allowed before
+them, as seen in the following segment of an Org file:[fn:96]
+
+#+begin_example
+,* Holidays
+ :PROPERTIES:
+ :CATEGORY: Holiday
+ :END:
+%%(org-calendar-holiday) ; special function for holiday names
+
+,* Birthdays
+ :PROPERTIES:
+ :CATEGORY: Ann
+ :END:
+%%(org-anniversary 1956 5 14) Arthur Dent is %d years old
+%%(org-anniversary 1869 10 2) Mahatma Gandhi would be %d years old
+#+end_example
+
+**** Anniversaries from BBDB
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: BBDB, anniversaries
+#+cindex: anniversaries, from BBDB
+
+#+findex: org-bbdb-anniversaries
+If you are using the Insidious Big Brother Database to store your
+contacts, you very likely prefer to store anniversaries in BBDB rather
+than in a separate Org or diary file. Org supports this and can show
+BBDB anniversaries as part of the agenda. All you need to do is to
+add the following to one of your agenda files:
+
+#+begin_example
+,* Anniversaries
+ :PROPERTIES:
+ :CATEGORY: Anniv
+ :END:
+%%(org-bbdb-anniversaries)
+#+end_example
+
+You can then go ahead and define anniversaries for a BBDB record.
+Basically, you need a field named =anniversary= for the BBDB record
+which contains the date in the format =YYYY-MM-DD= or =MM-DD=,
+followed by a space and the class of the anniversary (=birthday=,
+=wedding=, or a format string). If you omit the class, it defaults to
+=birthday=. Here are a few examples, the header for the file
+=ol-bbdb.el= contains more detailed information.
+
+#+begin_example
+1973-06-22
+06-22
+1955-08-02 wedding
+2008-04-14 %s released version 6.01 of Org mode, %d years ago
+#+end_example
+
+After a change to BBDB, or for the first agenda display during an
+Emacs session, the agenda display suffers a short delay as Org updates
+its hash with anniversaries. However, from then on things will be
+very fast, much faster in fact than a long list of
+=%%(diary-anniversary)= entries in an Org or Diary file.
+
+#+findex: org-bbdb-anniversaries-future
+If you would like to see upcoming anniversaries with a bit of
+forewarning, you can use the following instead:
+
+#+begin_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.
+
+**** Appointment reminders
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: @file{appt.el}
+#+cindex: appointment reminders
+#+cindex: appointment
+#+cindex: reminders
+
+#+cindex: APPT_WARNTIME, keyword
+Org can interact with Emacs appointments notification facility. To
+add the appointments of your agenda files, use the command
+~org-agenda-to-appt~. This command lets you filter through the list
+of your appointments and add only those belonging to a specific
+category or matching a regular expression. It also reads
+a =APPT_WARNTIME= property which overrides the value of
+~appt-message-warning-time~ for this appointment. See the docstring
+for details.
+
+*** The global TODO list
+:PROPERTIES:
+:DESCRIPTION: All unfinished action items.
+:ALT_TITLE: Global TODO list
+:END:
+#+cindex: global TODO list
+#+cindex: TODO list, global
+
+The global TODO list contains all unfinished TODO items formatted and
+collected into a single place.
+
+- {{{kbd(M-x org-agenda t)}}} (~org-todo-list~) ::
+
+ #+kindex: t @r{(Agenda dispatcher)}
+ #+findex: org-todo-list
+ Show the global TODO list. This collects the TODO items from all
+ agenda files (see [[*Agenda Views]]) into a single buffer. By default,
+ this lists items with a state the is not a DONE state. The buffer
+ is in Agenda mode, so there are commands to examine and manipulate
+ the TODO entries directly from that buffer (see [[*Commands in the
+ Agenda Buffer]]).
+
+- {{{kbd(M-x org-agenda T)}}} (~org-todo-list~) ::
+
+ #+kindex: T @r{(Agenda dispatcher)}
+ #+findex: org-todo-list
+ #+cindex: TODO keyword matching
+ #+vindex: org-todo-keywords
+ Like the above, but allows selection of a specific TODO keyword.
+ You can also do this by specifying a prefix argument to
+ {{{kbd(t)}}}. You are prompted for a keyword, and you may also
+ specify several keywords by separating them with =|= as the boolean
+ OR operator. With a numeric prefix, the Nth keyword in
+ ~org-todo-keywords~ is selected.
+
+ #+kindex: r
+ The {{{kbd(r)}}} key in the agenda buffer regenerates it, and you
+ can give a prefix argument to this command to change the selected
+ TODO keyword, for example {{{kbd(3 r)}}}. If you often need
+ a search for a specific keyword, define a custom command for it (see
+ [[*The Agenda Dispatcher]]).
+
+ Matching specific TODO keywords can also be done as part of a tags
+ search (see [[*Tag Searches]]).
+
+Remote editing of TODO items means that you can change the state of
+a TODO entry with a single key press. The commands available in the
+TODO list are described in [[*Commands in the Agenda Buffer]].
+
+#+cindex: sublevels, inclusion into TODO list
+Normally the global TODO list simply shows all headlines with TODO
+keywords. This list can become very long. There are two ways to keep
+it more compact:
+
+-
+ #+vindex: org-agenda-todo-ignore-scheduled
+ #+vindex: org-agenda-todo-ignore-deadlines
+ #+vindex: org-agenda-todo-ignore-timestamp
+ #+vindex: org-agenda-todo-ignore-with-date
+ Some people view a TODO item that has been /scheduled/ for execution
+ or have a /deadline/ (see [[*Timestamps]]) as no longer /open/.
+ Configure the variables ~org-agenda-todo-ignore-scheduled~ to
+ exclude some or all scheduled items from the global TODO list,
+ ~org-agenda-todo-ignore-deadlines~ to exclude some or all items with
+ a deadline set, ~org-agenda-todo-ignore-timestamp~ to exclude some
+ or all items with an active timestamp other than a DEADLINE or
+ a SCHEDULED timestamp and/or ~org-agenda-todo-ignore-with-date~ to
+ exclude items with at least one active timestamp.
+
+-
+ #+vindex: org-agenda-todo-list-sublevels
+ TODO items may have sublevels to break up the task into subtasks.
+ In such cases it may be enough to list only the highest level TODO
+ headline and omit the sublevels from the global list. Configure the
+ variable ~org-agenda-todo-list-sublevels~ to get this behavior.
+
+*** Matching tags and properties
+:PROPERTIES:
+:DESCRIPTION: Structured information with fine-tuned search.
+:END:
+#+cindex: matching, of tags
+#+cindex: matching, of properties
+#+cindex: tags view
+#+cindex: match view
+
+If headlines in the agenda files are marked with /tags/ (see [[*Tags]]),
+or have properties (see [[*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)}}}.
+
+- {{{kbd(M-x org-agenda m)}}} (~org-tags-view~) ::
+
+ #+kindex: m @r{(Agenda dispatcher)}
+ #+findex: org-tags-view
+ Produce a list of all headlines that match a given set of tags. The
+ command prompts for a selection criterion, which is a boolean logic
+ expression with tags, like =+work+urgent-withboss= or =work|home=
+ (see [[*Tags]]). If you often need a specific search, define a custom
+ command for it (see [[*The Agenda Dispatcher]]).
+
+- {{{kbd(M-x org-agenda M)}}} (~org-tags-view~) ::
+
+ #+kindex: M @r{(Agenda dispatcher)}
+ #+findex: org-tags-view
+ #+vindex: org-tags-match-list-sublevels
+ #+vindex: org-agenda-tags-todo-honor-ignore-options
+ Like {{{kbd(m)}}}, but only select headlines that are also TODO
+ items and force checking subitems (see the variable
+ ~org-tags-match-list-sublevels~). To exclude scheduled/deadline
+ items, see the variable ~org-agenda-tags-todo-honor-ignore-options~.
+ Matching specific TODO keywords together with a tags match is also
+ possible, see [[*Tag Searches]].
+
+The commands available in the tags list are described in [[*Commands in
+the Agenda Buffer]].
+
+#+cindex: boolean logic, for agenda searches
+A search string can use Boolean operators =&= for AND and =|= for OR.
+=&= binds more strongly than =|=. Parentheses are currently not
+implemented. Each element in the search is either a tag, a regular
+expression matching tags, or an expression like =PROPERTY OPERATOR
+VALUE= with a comparison operator, accessing a property value. Each
+element may be preceded by =-= to select against it, and =+= is
+syntactic sugar for positive selection. The AND operator =&= is
+optional when =+= or =-= is present. Here are some examples, using
+only tags.
+
+- =+work-boss= ::
+
+ Select headlines tagged =work=, but discard those also tagged
+ =boss=.
+
+- =work|laptop= ::
+
+ Selects lines tagged =work= or =laptop=.
+
+- =work|laptop+night= ::
+
+ Like before, but require the =laptop= lines to be tagged also
+ =night=.
+
+#+cindex: regular expressions, with tags search
+Instead of a tag, you may also specify a regular expression enclosed
+in curly braces. For example, =work+{^boss.*}= matches headlines that
+contain the tag =:work:= and any tag /starting/ with =boss=.
+
+#+cindex: group tags, as regular expressions
+Group tags (see [[*Tag Hierarchy]]) are expanded as regular expressions.
+E.g., if =work= is a group tag for the group =:work:lab:conf:=, then
+searching for =work= also searches for ={\(?:work\|lab\|conf\)}= and
+searching for =-work= searches for all headlines but those with one of
+the tags in the group (i.e., =-{\(?:work\|lab\|conf\)}=).
+
+#+cindex: TODO keyword matching, with tags search
+#+cindex: level, for tags/property match
+#+cindex: category, for tags/property match
+#+vindex: org-odd-levels-only
+You may also test for properties (see [[*Properties and Columns]]) at the
+same time as matching tags. The properties may be real properties, or
+special properties that represent other metadata (see [[*Special
+Properties]]). For example, the property =TODO= represents the TODO
+keyword of the entry. Or, the property =LEVEL= represents the level
+of an entry. So searching =+LEVEL=3+boss-TODO​="DONE"= lists all level
+three headlines that have the tag =boss= and are /not/ marked with the
+TODO keyword =DONE=. In buffers with ~org-odd-levels-only~ set,
+=LEVEL= does not count the number of stars, but =LEVEL=2= corresponds
+to 3 stars etc.
+
+Here are more examples:
+
+- =work+TODO​="WAITING"= ::
+
+ Select =work=-tagged TODO lines with the specific TODO keyword
+ =WAITING=.
+
+- =work+TODO​="WAITING"|home+TODO​="WAITING"= ::
+
+ Waiting tasks both at work and at home.
+
+When matching properties, a number of different operators can be used
+to test the value of a property. Here is a complex example:
+
+#+begin_example
++work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2
+ +With={Sarah|Denny}+SCHEDULED>="<2008-10-11>"
+#+end_example
+
+#+texinfo: @noindent
+The type of comparison depends on how the comparison value is written:
+
+- If the comparison value is a plain number, a numerical comparison is
+ done, and the allowed operators are =<=, ===, =>=, =<==, =>==, and
+ =<>=.
+
+- If the comparison value is enclosed in double-quotes, a string
+ comparison is done, and the same operators are allowed.
+
+- If the comparison value is enclosed in double-quotes /and/ angular
+ brackets (like =DEADLINE<​="<2008-12-24 18:30>"=), both values are
+ assumed to be date/time specifications in the standard Org way, and
+ the comparison is done accordingly. Valid values also include
+ ="<now>"= for now (including time), ="<today>"=, and ="<tomorrow>"=
+ for these days at 0:00 hours, i.e., without a time specification.
+ You can also use strings like ="<+5d>"= or ="<-2m>"= with units =d=,
+ =w=, =m=, and =y= for day, week, month, and year, respectively.
+
+- If the comparison value is enclosed in curly braces, a regexp match
+ is performed, with === meaning that the regexp matches the property
+ value, and =<>= meaning that it does not match.
+
+So the search string in the example finds entries tagged =work= but
+not =boss=, which also have a priority value =A=, a =Coffee= property
+with the value =unlimited=, an =EFFORT= property that is numerically
+smaller than 2, a =With= property that is matched by the regular
+expression =Sarah|Denny=, and that are scheduled on or after October
+11, 2008.
+
+You can configure Org mode to use property inheritance during
+a search, but beware that this can slow down searches considerably.
+See [[*Property Inheritance]], for details.
+
+For backward compatibility, and also for typing speed, there is also
+a different way to test TODO states in a search. For this, terminate
+the tags/property part of the search string (which may include several
+terms connected with =|=) with a =/= and then specify a Boolean
+expression just for TODO keywords. The syntax is then similar to that
+for tags, but should be applied with care: for example, a positive
+selection on several TODO keywords cannot meaningfully be combined
+with boolean AND. However, /negative selection/ combined with AND can
+be meaningful. To make sure that only lines are checked that actually
+have any TODO keyword (resulting in a speed-up), use {{{kbd(M-x
+org-agenda M)}}}, or equivalently start the TODO part after the slash
+with =!=. Using {{{kbd(M-x org-agenda M)}}} or =/!= does not match
+TODO keywords in a DONE state. Examples:
+
+- =work/WAITING= ::
+
+ Same as =work+TODO​="WAITING"=.
+
+- =work/!-WAITING-NEXT= ::
+
+ Select =work=-tagged TODO lines that are neither =WAITING= nor
+ =NEXT=.
+
+- =work/!+WAITING|+NEXT= ::
+
+ Select =work=-tagged TODO lines that are either =WAITING= or =NEXT=.
+
+*** Search view
+:PROPERTIES:
+:DESCRIPTION: Find entries by searching for text.
+:END:
+#+cindex: search view
+#+cindex: text search
+#+cindex: searching, for text
+
+This agenda view is a general text search facility for Org mode
+entries. It is particularly useful to find notes.
+
+- {{{kbd(M-x org-agenda s)}}} (~org-search-view~) ::
+
+ #+kindex: s @r{(Agenda dispatcher)}
+ #+findex: org-search-view
+ This is a special search that lets you select entries by matching
+ a substring or specific words using a boolean logic.
+
+For example, the search string =computer equipment= matches entries
+that contain =computer equipment= as a substring, even if the two
+words are separated by more space or a line break.
+
+Search view can also search for specific keywords in the entry, using
+Boolean logic. The search string =+computer
++wifi -ethernet -{8\.11[bg]}= matches note entries that contain the
+keywords =computer= and =wifi=, but not the keyword =ethernet=, and
+which are also not matched by the regular expression =8\.11[bg]=,
+meaning to exclude both =8.11b= and =8.11g=. The first =+= is
+necessary to turn on boolean search, other =+= characters are
+optional. For more details, see the docstring of the command
+~org-search-view~.
+
+You can incrementally and conveniently adjust a boolean search from
+the agenda search view with the following keys
+
+#+attr_texinfo: :columns 0.1 0.6
+| {{{kbd([)}}} | Add a positive search word |
+| {{{kbd(])}}} | Add a negative search word |
+| {{{kbd({)}}} | Add a positive regular expression |
+| {{{kbd(})}}} | Add a negative regular expression |
+
+#+vindex: org-agenda-text-search-extra-files
+Note that in addition to the agenda files, this command also searches
+the files listed in ~org-agenda-text-search-extra-files~.
+
+*** Stuck projects
+:PROPERTIES:
+:DESCRIPTION: Find projects you need to review.
+:END:
+#+pindex: GTD, Getting Things Done
+
+If you are following a system like David Allen's GTD to organize your
+work, one of the "duties" you have is a regular review to make sure
+that all projects move along. A /stuck/ project is a project that has
+no defined next actions, so it never shows up in the TODO lists Org
+mode produces. During the review, you need to identify such projects
+and define next actions for them.
+
+- {{{kbd(M-x org-agenda #)}}} (~org-agenda-list-stuck-projects~) ::
+
+ #+kindex: # @r{(Agenda dispatcher)}
+ #+findex: org-agenda-list-stuck-projects
+ List projects that are stuck.
+
+- {{{kbd(M-x org-agenda !)}}} ::
+
+ #+kindex: ! @r{(Agenda dispatcher)}
+ #+vindex: org-stuck-projects
+ Customize the variable ~org-stuck-projects~ to define what a stuck
+ project is and how to find it.
+
+You almost certainly need to configure this view before it works for
+you. The built-in default assumes that all your projects are level-2
+headlines, and that a project is not stuck if it has at least one
+entry marked with a TODO keyword =TODO= or =NEXT= or =NEXTACTION=.
+
+Let's assume that you, in your own way of using Org mode, identify
+projects with a tag =:PROJECT:=, and that you use a TODO keyword
+=MAYBE= to indicate a project that should not be considered yet.
+Let's further assume that the TODO keyword =DONE= marks finished
+projects, and that =NEXT= and =TODO= indicate next actions. The tag
+=:@shop:= indicates shopping and is a next action even without the
+NEXT tag. Finally, if the project contains the special word =IGNORE=
+anywhere, it should not be listed either. In this case you would
+start by identifying eligible projects with a tags/TODO match (see
+[[*Tag Searches]]) =+PROJECT/-MAYBE-DONE=, and then check for =TODO=,
+=NEXT=, =@shop=, and =IGNORE= in the subtree to identify projects that
+are not stuck. The correct customization for this is:
+
+#+begin_src emacs-lisp
+(setq org-stuck-projects
+ '("+PROJECT/-MAYBE-DONE" ("NEXT" "TODO") ("@shop")
+ "\\<IGNORE\\>"))
+#+end_src
+
+Note that if a project is identified as non-stuck, the subtree of this
+entry is searched for stuck projects.
+
+** Presentation and Sorting
+:PROPERTIES:
+:DESCRIPTION: How agenda items are prepared for display.
+:END:
+#+cindex: presentation, of agenda items
+
+#+vindex: org-agenda-prefix-format
+#+vindex: org-agenda-tags-column
+Before displaying items in an agenda view, Org mode visually prepares
+the items and sorts them. Each item occupies a single line. The line
+starts with a /prefix/ that contains the /category/ (see [[*Categories]])
+of the item and other important information. You can customize in
+which column tags are displayed through ~org-agenda-tags-column~. You
+can also customize the prefix using the option
+~org-agenda-prefix-format~. This prefix is followed by a cleaned-up
+version of the outline headline associated with the item.
+
+*** Categories
+:PROPERTIES:
+:DESCRIPTION: Not all tasks are equal.
+:END:
+#+cindex: category
+#+cindex: @samp{CATEGORY}, keyword
+
+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:
+
+: #+CATEGORY: Thesis
+
+#+cindex: @samp{CATEGORY}, property
+If you would like to have a special category for a single entry or
+a (sub)tree, give the entry a =CATEGORY= property with the special
+category you want to apply as the value.
+
+#+vindex: org-agenda-category-icon-alist
+The display in the agenda buffer looks best if the category is not
+longer than 10 characters. You can set up icons for category by
+customizing the ~org-agenda-category-icon-alist~ variable.
+
+*** Time-of-day specifications
+:PROPERTIES:
+:DESCRIPTION: How the agenda knows the time.
+:END:
+#+cindex: time-of-day specification
+
+Org mode checks each agenda item for a time-of-day specification. The
+time can be part of the timestamp that triggered inclusion into the
+agenda, for example
+
+: <2005-05-10 Tue 19:00>
+
+#+texinfo: @noindent
+Time ranges can be specified with two timestamps:
+
+: <2005-05-10 Tue 20:30>--<2005-05-10 Tue 22:15>
+
+#+vindex: org-agenda-search-headline-for-time
+In the headline of the entry itself, a time(range)---like =12:45= or
+a =8:30-1pm=---may also appear as plain text[fn:97].
+
+If the agenda integrates the Emacs diary (see [[*Weekly/daily agenda]]),
+time specifications in diary entries are recognized as well.
+
+For agenda display, Org mode extracts the time and displays it in
+a standard 24 hour format as part of the prefix. The example times in
+the previous paragraphs would end up in the agenda like this:
+
+#+begin_example
+ 8:30-13:00 Arthur Dent lies in front of the bulldozer
+12:45...... Ford Prefect arrives and takes Arthur to the pub
+19:00...... The Vogon reads his poem
+20:30-22:15 Marvin escorts the Hitchhikers to the bridge
+#+end_example
+
+#+cindex: time grid
+If the agenda is in single-day mode, or for the display of today, the
+timed entries are embedded in a time grid, like
+
+#+begin_example
+ 8:00...... ------------------
+ 8:30-13:00 Arthur Dent lies in front of the bulldozer
+10:00...... ------------------
+12:00...... ------------------
+12:45...... Ford Prefect arrives and takes Arthur to the pub
+14:00...... ------------------
+16:00...... ------------------
+18:00...... ------------------
+19:00...... The Vogon reads his poem
+20:00...... ------------------
+20:30-22:15 Marvin escorts the Hitchhikers to the bridge
+#+end_example
+
+#+vindex: org-agenda-use-time-grid
+#+vindex: org-agenda-time-grid
+The time grid can be turned on and off with the variable
+~org-agenda-use-time-grid~, and can be configured with
+~org-agenda-time-grid~.
+
+*** Sorting of agenda items
+:PROPERTIES:
+:DESCRIPTION: The order of things.
+:END:
+#+cindex: sorting, of agenda items
+#+cindex: priorities, of agenda items
+
+Before being inserted into a view, the items are sorted. How this is
+done depends on the type of view.
+
+-
+ #+vindex: org-agenda-files
+ For the daily/weekly agenda, the items for each day are sorted. The
+ default order is to first collect all items containing an explicit
+ time-of-day specification. These entries are shown at the beginning
+ of the list, as a /schedule/ for the day. After that, items remain
+ grouped in categories, in the sequence given by ~org-agenda-files~.
+ Within each category, items are sorted by priority (see
+ [[*Priorities]]), which is composed of the base priority (2000 for
+ priority =A=, 1000 for =B=, and 0 for =C=), plus additional
+ increments for overdue scheduled or deadline items.
+
+- For the TODO list, items remain in the order of categories, but
+ within each category, sorting takes place according to priority (see
+ [[*Priorities]]). The priority used for sorting derives from the
+ priority cookie, with additions depending on how close an item is to
+ its due or scheduled date.
+
+- For tags matches, items are not sorted at all, but just appear in
+ the sequence in which they are found in the agenda files.
+
+#+vindex: org-agenda-sorting-strategy
+Sorting can be customized using the variable
+~org-agenda-sorting-strategy~, and may also include criteria based on
+the estimated effort of an entry (see [[*Effort Estimates]]).
+
+*** Filtering/limiting agenda items
+:PROPERTIES:
+:DESCRIPTION: Dynamically narrow the agenda.
+:END:
+
+#+vindex: org-agenda-category-filter-preset
+#+vindex: org-agenda-tag-filter-preset
+#+vindex: org-agenda-effort-filter-preset
+#+vindex: org-agenda-regexp-filter-preset
+Agenda built-in or custom commands are statically defined. Agenda
+filters and limits allow to flexibly narrow down the list of agenda
+entries.
+
+/Filters/ only change the visibility of items, are very fast and are
+mostly used interactively[fn:98]. You can switch quickly between
+different filters without having to recreate the agenda. /Limits/ on
+the other hand take effect before the agenda buffer is populated, so
+they are mostly useful when defined as local variables within custom
+agenda commands.
+
+**** Filtering in the agenda
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: agenda filtering
+#+cindex: filtering entries, in agenda
+#+cindex: tag filtering, in agenda
+#+cindex: category filtering, in agenda
+#+cindex: top headline filtering, in agenda
+#+cindex: effort filtering, in agenda
+#+cindex: query editing, in agenda
+
+The general filtering command is ~org-agenda-filter~, bound to
+{{{kbd(/)}}}. Before we introduce it, we describe commands for
+individual filter types. All filtering commands handle prefix
+arguments in the same way: A single {{{kbd(C-u)}}} prefix negates the
+filter, so it removes lines selected by the filter. A double prefix
+adds the new filter condition to the one(s) already in place, so
+filter elements are accumulated.
+
+- {{{kbd(\)}}} (~org-agenda-filter-by-tag~) ::
+
+ #+findex: org-agenda-filter-by-tag
+ Filter the agenda view with respect to a tag. You are prompted for
+ a tag selection letter; {{{kbd(SPC)}}} means any tag at all.
+ Pressing {{{kbd(TAB)}}} at that prompt offers 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. Pressing {{{kbd(+)}}} or {{{kbd(-)}}} at the prompt switches
+ between filtering for and against the next tag. To clear the
+ filter, press {{{kbd(\)}}} twice (once to call the command again,
+ and once at the prompt).
+
+- {{{kbd(<)}}} (~org-agenda-filter-by-category~) ::
+
+ #+findex: org-agenda-filter-by-category
+ Filter by category of the line at point, and show only entries with
+ this category. When called with a prefix argument, hide all entries
+ with the category at point. To clear the filter, call this command
+ again by pressing {{{kbd(<)}}}.
+
+- {{{kbd(=)}}} (~org-agenda-filter-by-regexp~) ::
+
+ #+findex: org-agenda-filter-by-regexp
+ Filter the agenda view by a regular expression: only show agenda
+ entries matching the regular expression the user entered. To clear
+ the filter, call the command again by pressing {{{kbd(=)}}}.
+
+- {{{kbd(_)}}} (~org-agenda-filter-by-effort~) ::
+
+ #+findex: org-agenda-filter-by-effort
+ Filter the agenda view with respect to effort estimates, so select
+ tasks that take the right amount of time. You first need to set up
+ a list of efforts globally, for example
+
+ #+begin_src emacs-lisp
+ (setq org-global-properties
+ '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00")))
+ #+end_src
+
+ #+vindex: org-sort-agenda-noeffort-is-high
+ 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 then
+ restricts 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 are treated according to
+ the value of ~org-sort-agenda-noeffort-is-high~. To clear the
+ filter, press {{{kbd(_)}}} twice (once to call the command again,
+ and once at the first prompt).
+
+- {{{kbd(^)}}} (~org-agenda-filter-by-top-headline~) ::
+
+ #+findex: org-agenda-filter-by-top-headline
+ Filter the current agenda view and only display items that fall
+ under the same top-level headline as the current entry. To clear
+ the filter, call this command again by pressing {{{kbd(^)}}}.
+
+- {{{kbd(/)}}} (~org-agenda-filter~) ::
+
+ #+findex: org-agenda-filter
+ This is the unified interface to four of the five filter methods
+ described above. At the prompt, specify different filter elements
+ in a single string, with full completion support. For example,
+
+ : +work-John+<0:10-/plot/
+
+ selects entries with category =work= and effort estimates below 10
+ minutes, and deselects entries with tag =John= or matching the
+ regexp =plot=. You can leave =+= out if that does not lead to
+ ambiguities. The sequence of elements is arbitrary. The filter
+ syntax assumes that there is no overlap between categories and tags.
+ Otherwise, tags take priority. If you reply to the prompt with the
+ empty string, all filtering is removed. If a filter is specified,
+ it replaces all current filters. But if you call the command with
+ a double prefix argument, or if you add an additional =+= (e.g.,
+ =++work=) to the front of the string, the new filter elements are
+ added to the active ones. A single prefix argument applies the
+ entire filter in a negative sense.
+
+- {{{kbd(|)}}} (~org-agenda-filter-remove-all~) ::
+
+ Remove all filters in the current agenda view.
+
+**** Computed tag filtering
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+vindex: org-agenda-auto-exclude-function
+If the variable ~org-agenda-auto-exclude-function~ is set to
+a user-defined function, that function can select tags that should be
+used as a tag filter when requested. The function will be called with
+lower-case versions of all tags represented in the current view. The
+function should return ="-tag"= if the filter should remove
+entries with that tag, ="+tag"= if only entries with this tag should
+be kept, or =nil= if that tag is irrelevant. For example, let's say
+you use a =Net= tag to identify tasks which need network access, an
+=Errand= tag for errands in town, and a =Call= tag for making phone
+calls. You could auto-exclude these tags based on the availability of
+the Internet, and outside of business hours, with something like this:
+
+#+begin_src emacs-lisp
+(defun my-auto-exclude-fn (tag)
+ (when (cond ((string= tag "net")
+ (/= 0 (call-process "/sbin/ping" nil nil nil
+ "-c1" "-q" "-t1" "mail.gnu.org")))
+ ((member tag '("errand" "call"))
+ (let ((hr (nth 2 (decode-time))))
+ (or (< hr 8) (> hr 21)))))
+ (concat "-" tag)))
+
+(setq org-agenda-auto-exclude-function #'my-auto-exclude-fn)
+#+end_src
+
+You can apply this self-adapting filter by using a triple prefix
+argument to ~org-agenda-filter~, i.e.\nbsp{}press {{{kbd(C-u C-u C-u /)}}},
+or by pressing {{{kbd(RET)}}} in ~org-agenda-filter-by-tag~.
+
+**** Setting limits for the agenda
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: limits, in agenda
+
+Here is a list of options that you can set, either globally, or
+locally in your custom agenda views (see [[*Custom Agenda Views]]).
+
+- ~org-agenda-max-entries~ ::
+
+ #+vindex: org-agenda-max-entries
+ Limit the number of entries.
+
+- ~org-agenda-max-effort~ ::
+
+ #+vindex: org-agenda-max-effort
+ Limit the duration of accumulated efforts (as minutes).
+
+- ~org-agenda-max-todos~ ::
+
+ #+vindex: org-agenda-max-todos
+ Limit the number of entries with TODO keywords.
+
+- ~org-agenda-max-tags~ ::
+
+ #+vindex: org-agenda-max-tags
+ Limit the number of tagged entries.
+
+When set to a positive integer, each option excludes entries from
+other categories: for example, =(setq org-agenda-max-effort 100)=
+limits 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 ~org-agenda-max-effort~. One
+useful setup is to use ~org-agenda-max-entries~ locally in a custom
+command. For example, this custom command displays the next five
+entries with a =NEXT= TODO keyword.
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("n" todo "NEXT"
+ ((org-agenda-max-entries 5)))))
+#+end_src
+
+Once you mark one of these five entry as 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, which are lost when
+rebuilding the agenda:
+
+- {{{kbd(~ )}}} (~org-agenda-limit-interactively~) ::
+
+ #+findex: org-agenda-limit-interactively
+ This prompts for the type of limit to apply and its value.
+
+** Commands in the Agenda Buffer
+:PROPERTIES:
+:DESCRIPTION: Remote editing of Org trees.
+:ALT_TITLE: Agenda Commands
+:END:
+#+cindex: commands, in agenda buffer
+
+Entries in the agenda buffer are linked back to the Org file or diary
+file where they originate. You are not allowed to edit the agenda
+buffer itself, but commands are provided to show and jump to the
+original entry location, and to edit the Org files "remotely" from the
+agenda buffer. In this way, all information is stored only once,
+removing the risk that your agenda and note files may diverge.
+
+Some commands can be executed with mouse clicks on agenda lines. For
+the other commands, point needs to be in the desired line.
+
+*** Motion
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: motion commands in agenda
+
+- {{{kbd(n)}}} (~org-agenda-next-line~) ::
+
+ #+kindex: n
+ #+findex: org-agenda-next-line
+ Next line (same as {{{kbd(DOWN)}}} and {{{kbd(C-n)}}}).
+
+- {{{kbd(p)}}} (~org-agenda-previous-line~) ::
+
+ #+kindex: p
+ #+findex: org-agenda-previous-line
+ Previous line (same as {{{kbd(UP)}}} and {{{kbd(C-p)}}}).
+
+*** View/Go to Org file
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: view file commands in agenda
+
+- {{{kbd(SPC)}}} or {{{kbd(mouse-3)}}} (~org-agenda-show-and-scroll-up~) ::
+
+ #+kindex: SPC
+ #+kindex: mouse-3
+ #+findex: org-agenda-show-and-scroll-up
+ Display the original location of the item in another window.
+ With a prefix argument, make sure that drawers stay folded.
+
+- {{{kbd(L)}}} (~org-agenda-recenter~) ::
+
+ #+findex: org-agenda-recenter
+ Display original location and recenter that window.
+
+- {{{kbd(TAB)}}} or {{{kbd(mouse-2)}}} (~org-agenda-goto~) ::
+
+ #+kindex: TAB
+ #+kindex: mouse-2
+ #+findex: org-agenda-goto
+ Go to the original location of the item in another window.
+
+- {{{kbd(RET)}}} (~org-agenda-switch-to~) ::
+
+ #+kindex: RET
+ #+findex: org-agenda-switch-to
+ Go to the original location of the item and delete other windows.
+
+- {{{kbd(F)}}} (~org-agenda-follow-mode~) ::
+
+ #+kindex: F
+ #+findex: org-agenda-follow-mode
+ #+vindex: org-agenda-start-with-follow-mode
+ Toggle Follow mode. In Follow mode, as you move point through the
+ agenda buffer, the other window always shows the corresponding
+ location in the Org file. The initial setting for this mode in new
+ agenda buffers can be set with the variable
+ ~org-agenda-start-with-follow-mode~.
+
+- {{{kbd(C-c C-x b)}}} (~org-agenda-tree-to-indirect-buffer~) ::
+
+ #+kindex: C-c C-x b
+ #+findex: org-agenda-tree-to-indirect-buffer
+ Display the entire subtree of the current item in an indirect
+ buffer. With a numeric prefix argument N, go up to level N and then
+ take that tree. If N is negative, go up that many levels. With
+ a {{{kbd(C-u)}}} prefix, do not remove the previously used indirect
+ buffer.
+
+- {{{kbd(C-c C-o)}}} (~org-agenda-open-link~) ::
+
+ #+kindex: C-c C-o
+ #+findex: org-agenda-open-link
+ Follow a link in the entry. This offers a selection of any links in
+ the text belonging to the referenced Org node. If there is only one
+ link, follow it without a selection prompt.
+
+*** Change display
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: change agenda display
+#+cindex: display changing, in agenda
+
+#+attr_texinfo: :sep ,
+- {{{kbd(A)}}} ::
+
+ #+kindex: A
+ Interactively select another agenda view and append it to the
+ current view.
+
+- {{{kbd(o)}}} ::
+
+ #+kindex: o
+ Delete other windows.
+
+- {{{kbd(v d)}}} or short {{{kbd(d)}}} (~org-agenda-day-view~) ::
+
+ #+kindex: v d
+ #+kindex: d
+ #+findex: org-agenda-day-view
+ Switch to day view. When switching to day view, this setting
+ becomes the default for subsequent agenda refreshes. A numeric
+ prefix argument may be used to jump directly to a specific day of
+ the year. For example, {{{kbd(32 d)}}} jumps to February 1st. When
+ setting day view, a year may be encoded in the prefix argument as
+ well. For example, {{{kbd(200712 d)}}} jumps to January 12, 2007.
+ If such a year specification has only one or two digits, it is
+ expanded into one of the 30 next years or the last 69 years.
+
+- {{{kbd(v w)}}} or short {{{kbd(w)}}} (~org-agenda-week-view~) ::
+
+ #+kindex: v w
+ #+kindex: w
+ #+findex: org-agenda-week-view
+ Switch to week view. When switching week view, this setting becomes
+ the default for subsequent agenda refreshes. A numeric prefix
+ argument may be used to jump directly to a specific day of the ISO
+ week. For example {{{kbd(9 w)}}} to ISO week number 9. When
+ setting week view, a year may be encoded in the prefix argument as
+ well. For example, {{{kbd(200712 w)}}} jumps to week 12 in 2007.
+ If such a year specification has only one or two digits, it is
+ expanded into one of the 30 next years or the last 69 years.
+
+- {{{kbd(v m)}}} (~org-agenda-month-view~) ::
+
+ #+kindex: v m
+ #+findex: org-agenda-month-view
+ Switch to month view. Because month views are slow to create, they
+ do not become the default for subsequent agenda refreshes.
+ A numeric prefix argument may be used to jump directly to a specific
+ day of the month. When setting month view, a year may be encoded in
+ the prefix argument as well. For example, {{{kbd(200712 m)}}} jumps
+ to December, 2007. If such a year specification has only one or two
+ digits, it is expanded into one of the 30 next years or the last 69
+ years.
+
+- {{{kbd(v y)}}} (~org-agenda-year-view~) ::
+
+ #+kindex: v y
+ #+findex: org-agenda-year-view
+ Switch to year view. Because year views are slow to create, they do
+ not become the default for subsequent agenda refreshes. A numeric
+ prefix argument may be used to jump directly to a specific day of
+ the year.
+
+- {{{kbd(v SPC)}}} (~org-agenda-reset-view~) ::
+
+ #+kindex: v SPC
+ #+findex: org-agenda-reset-view
+ #+vindex: org-agenda-span
+ Reset the current view to ~org-agenda-span~.
+
+- {{{kbd(f)}}} (~org-agenda-later~) ::
+
+ #+kindex: f
+ #+findex: org-agenda-later
+ Go forward in time to display the span following the current one.
+ For example, if the display covers a week, switch to the following
+ week. With a prefix argument, repeat that many times.
+
+- {{{kbd(b)}}} (~org-agenda-earlier~) ::
+
+ #+kindex: b
+ #+findex: org-agenda-earlier
+ Go backward in time to display earlier dates.
+
+- {{{kbd(.)}}} (~org-agenda-goto-today~) ::
+
+ #+kindex: .
+ #+findex: org-agenda-goto-today
+ Go to today.
+
+- {{{kbd(j)}}} (~org-agenda-goto-date~) ::
+
+ #+kindex: j
+ #+findex: org-agenda-goto-date
+ Prompt for a date and go there.
+
+- {{{kbd(J)}}} (~org-agenda-clock-goto~) ::
+
+ #+kindex: J
+ #+findex: org-agenda-clock-goto
+ Go to the currently clocked-in task /in the agenda buffer/.
+
+- {{{kbd(D)}}} (~org-agenda-toggle-diary~) ::
+
+ #+kindex: D
+ #+findex: org-agenda-toggle-diary
+ Toggle the inclusion of diary entries. See [[*Weekly/daily agenda]].
+
+- {{{kbd(v l)}}} or {{{kbd(v L)}}} or short {{{kbd(l)}}} (~org-agenda-log-mode~) ::
+
+ #+kindex: v l
+ #+kindex: l
+ #+kindex: v L
+ #+findex: org-agenda-log-mode
+ #+vindex: org-log-done
+ #+vindex: org-agenda-log-mode-items
+ Toggle Logbook mode. In Logbook mode, entries that were marked as
+ done while logging was on (see the variable ~org-log-done~) are
+ shown in the agenda, as are entries that have been clocked on that
+ day. You can configure the entry types that should be included in
+ log mode using the variable ~org-agenda-log-mode-items~. When
+ called with a {{{kbd(C-u)}}} prefix argument, show all possible
+ logbook entries, including state changes. When called with two
+ prefix arguments {{{kbd(C-u C-u)}}}, show only logging information,
+ nothing else. {{{kbd(v L)}}} is equivalent to {{{kbd(C-u v l)}}}.
+
+- {{{kbd(v [)}}} or short {{{kbd([)}}} (~org-agenda-manipulate-query-add~) ::
+
+ #+kindex: v [
+ #+kindex: [
+ #+findex: org-agenda-manipulate-query-add
+ Include inactive timestamps into the current view. Only for
+ weekly/daily agenda.
+
+- {{{kbd(v a)}}} (~org-agenda-archives-mode~) ::
+
+ #+kindex: v a
+ #+findex: org-agenda-archives-mode
+ Toggle Archives mode. In Archives mode, trees that are archived
+ (see [[*Internal archiving]]) are also scanned when producing the
+ agenda. To exit archives mode, press {{{kbd(v a)}}} again.
+
+- {{{kbd(v A)}}} ::
+
+ #+kindex: v A
+ Toggle Archives mode. Include all archive files as well.
+
+- {{{kbd(v R)}}} or short {{{kbd(R)}}} (~org-agenda-clockreport-mode~) ::
+
+ #+kindex: v R
+ #+kindex: R
+ #+findex: org-agenda-clockreport-mode
+ #+vindex: org-agenda-start-with-clockreport-mode
+ #+vindex: org-clock-report-include-clocking-task
+ Toggle Clockreport mode. In Clockreport mode, the daily/weekly
+ agenda always shows a table with the clocked times for the time span
+ and file scope covered by the current agenda view. The initial
+ setting for this mode in new agenda buffers can be set with the
+ variable ~org-agenda-start-with-clockreport-mode~. By using
+ a prefix argument when toggling this mode (i.e., {{{kbd(C-u R)}}}),
+ the clock table does not show contributions from entries that are
+ hidden by agenda filtering[fn:99]. See also the variable
+ ~org-clock-report-include-clocking-task~.
+
+- {{{kbd(v c)}}} ::
+
+ #+kindex: v c
+ #+vindex: org-agenda-clock-consistency-checks
+ Show overlapping clock entries, clocking gaps, and other clocking
+ problems in the current agenda range. You can then visit clocking
+ lines and fix them manually. See the variable
+ ~org-agenda-clock-consistency-checks~ for information on how to
+ customize the definition of what constituted a clocking problem. To
+ return to normal agenda display, press {{{kbd(l)}}} to exit Logbook
+ mode.
+
+- {{{kbd(v E)}}} or short {{{kbd(E)}}} (~org-agenda-entry-text-mode~) ::
+
+ #+kindex: v E
+ #+kindex: E
+ #+findex: org-agenda-entry-text-mode
+ #+vindex: org-agenda-start-with-entry-text-mode
+ #+vindex: org-agenda-entry-text-maxlines
+ Toggle entry text mode. In entry text mode, a number of lines from
+ the Org outline node referenced by an agenda line are displayed
+ below the line. The maximum number of lines is given by the
+ variable ~org-agenda-entry-text-maxlines~. Calling this command
+ with a numeric prefix argument temporarily modifies that number to
+ the prefix value.
+
+- {{{kbd(G)}}} (~org-agenda-toggle-time-grid~) ::
+
+ #+kindex: G
+ #+vindex: org-agenda-use-time-grid
+ #+vindex: org-agenda-time-grid
+ Toggle the time grid on and off. See also the variables
+ ~org-agenda-use-time-grid~ and ~org-agenda-time-grid~.
+
+- {{{kbd(r)}}} (~org-agenda-redo~), {{{kbd(g)}}} ::
+
+ #+kindex: r
+ #+kindex: g
+ #+findex: org-agenda-redo
+ Recreate the agenda buffer, for example to reflect the changes after
+ modification of the timestamps of items with {{{kbd(S-LEFT)}}} and
+ {{{kbd(S-RIGHT)}}}. When the buffer is the global TODO list,
+ a prefix argument is interpreted to create a selective list for
+ a specific TODO keyword.
+
+- {{{kbd(C-x C-s)}}} or short {{{kbd(s)}}} (~org-save-all-org-buffers~) ::
+
+ #+kindex: C-x C-s
+ #+findex: org-save-all-org-buffers
+ #+kindex: s
+ Save all Org buffers in the current Emacs session, and also the
+ locations of IDs.
+
+- {{{kbd(C-c C-x C-c)}}} (~org-agenda-columns~) ::
+
+ #+kindex: C-c C-x C-c
+ #+findex: org-agenda-columns
+ #+vindex: org-columns-default-format
+ Invoke column view (see [[*Column View]]) in the agenda buffer. The
+ column view format is taken from the entry at point, or, if there is
+ no entry at point, from the first entry in the agenda view. So
+ whatever the format for that entry would be in the original buffer
+ (taken from a property, from a =COLUMNS= keyword, or from the
+ default variable ~org-columns-default-format~) is used in the
+ agenda.
+
+- {{{kbd(C-c C-x >)}}} (~org-agenda-remove-restriction-lock~) ::
+
+ #+kindex: C-c C-x >
+ #+findex: org-agenda-remove-restriction-lock
+ Remove the restriction lock on the agenda, if it is currently
+ restricted to a file or subtree (see [[*Agenda Files]]).
+
+- {{{kbd(M-UP)}}} (~org-agenda-drag-line-backward~) ::
+
+ #+kindex: M-UP
+ #+findex: org-agenda-drag-line-backward
+ Drag the line at point backward one line. With a numeric prefix
+ argument, drag backward by that many lines.
+
+ Moving agenda lines does not persist after an agenda refresh and
+ does not modify the contributing Org files.
+
+- {{{kbd(M-DOWN)}}} (~org-agenda-drag-line-forward~) ::
+
+ #+kindex: M-DOWN
+ #+findex: org-agenda-drag-line-forward
+ Drag the line at point forward one line. With a numeric prefix
+ argument, drag forward by that many lines.
+
+*** Remote editing
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: remote editing, from agenda
+
+- {{{kbd(0--9)}}} ::
+
+ Digit argument.
+
+- {{{kbd(C-_)}}} (~org-agenda-undo~) ::
+
+ #+kindex: C-_
+ #+findex: org-agenda-undo
+ #+cindex: undoing remote-editing events
+ #+cindex: remote editing, undo
+ Undo a change due to a remote editing command. The change is undone
+ both in the agenda buffer and in the remote buffer.
+
+- {{{kbd(t)}}} (~org-agenda-todo~) ::
+
+ #+kindex: t
+ #+findex: org-agenda-todo
+ Change the TODO state of the item, both in the agenda and in the
+ original Org file. A prefix arg is passed through to the ~org-todo~
+ command, so for example a {{{kbd(C-u)}}} prefix are will trigger
+ taking a note to document the state change.
+
+- {{{kbd(C-S-RIGHT)}}} (~org-agenda-todo-nextset~) ::
+
+ #+kindex: C-S-RIGHT
+ #+findex: org-agenda-todo-nextset
+ Switch to the next set of TODO keywords.
+
+- {{{kbd(C-S-LEFT)}}}, ~org-agenda-todo-previousset~ ::
+
+ #+kindex: C-S-LEFT
+ Switch to the previous set of TODO keywords.
+
+- {{{kbd(C-k)}}} (~org-agenda-kill~) ::
+
+ #+kindex: C-k
+ #+findex: org-agenda-kill
+ #+vindex: org-agenda-confirm-kill
+ Delete the current agenda item along with the entire subtree
+ belonging to it in the original Org file. If the text to be deleted
+ remotely is longer than one line, the kill needs to be confirmed by
+ the user. See variable ~org-agenda-confirm-kill~.
+
+- {{{kbd(C-c C-w)}}} (~org-agenda-refile~) ::
+
+ #+kindex: C-c C-w
+ #+findex: org-agenda-refile
+ Refile the entry at point.
+
+- {{{kbd(C-c C-x C-a)}}} or short {{{kbd(a)}}} (~org-agenda-archive-default-with-confirmation~) ::
+
+ #+kindex: C-c C-x C-a
+ #+kindex: a
+ #+findex: org-agenda-archive-default-with-confirmation
+ #+vindex: org-archive-default-command
+ Archive the subtree corresponding to the entry at point using the
+ default archiving command set in ~org-archive-default-command~.
+ When using the {{{kbd(a)}}} key, confirmation is required.
+
+- {{{kbd(C-c C-x a)}}} (~org-agenda-toggle-archive-tag~) ::
+
+ #+kindex: C-c C-x a
+ #+findex: org-agenda-toggle-archive-tag
+ Toggle the archive tag (see [[*Internal archiving]]) for the current
+ headline.
+
+- {{{kbd(C-c C-x A)}}} (~org-agenda-archive-to-archive-sibling~) ::
+
+ #+kindex: C-c C-x A
+ #+findex: org-agenda-archive-to-archive-sibling
+ Move the subtree corresponding to the current entry to its /archive
+ sibling/.
+
+- {{{kbd(C-c C-x C-s)}}} or short {{{kbd($)}}} (~org-agenda-archive~) ::
+
+ #+kindex: C-c C-x C-s
+ #+kindex: $
+ #+findex: org-agenda-archive
+ Archive the subtree corresponding to the current headline. This
+ means the entry is moved to the configured archive location, most
+ likely a different file.
+
+- {{{kbd(T)}}} (~org-agenda-show-tags~) ::
+
+ #+kindex: T
+ #+findex: org-agenda-show-tags
+ #+vindex: org-agenda-show-inherited-tags
+ Show all tags associated with the current item. This is useful if
+ you have turned off ~org-agenda-show-inherited-tags~, but still want
+ to see all tags of a headline occasionally.
+
+- {{{kbd(:)}}} (~org-agenda-set-tags~) ::
+
+ #+kindex: :
+ #+findex: org-agenda-set-tags
+ Set tags for the current headline. If there is an active region in
+ the agenda, change a tag for all headings in the region.
+
+- {{{kbd(\,)}}} (~org-agenda-priority~) ::
+
+ #+kindex: ,
+ #+findex: org-agenda-priority
+ Set the priority for the current item. Org mode prompts for the
+ priority character. If you reply with {{{kbd(SPC)}}}, the priority
+ cookie is removed from the entry.
+
+- {{{kbd(+)}}} or {{{kbd(S-UP)}}} (~org-agenda-priority-up~) ::
+
+ #+kindex: +
+ #+kindex: S-UP
+ #+findex: org-agenda-priority-up
+ Increase the priority of the current item. The priority is changed
+ in the original buffer, but the agenda is not resorted. Use the
+ {{{kbd(r)}}} key for this.
+
+- {{{kbd(-)}}} or {{{kbd(S-DOWN)}}} (~org-agenda-priority-down~) ::
+
+ #+kindex: -
+ #+kindex: S-DOWN
+ #+findex: org-agenda-priority-down
+ Decrease the priority of the current item.
+
+- {{{kbd(C-c C-x e)}}} or short {{{kbd(e)}}} (~org-agenda-set-effort~) ::
+
+ #+kindex: e
+ #+kindex: C-c C-x e
+ #+findex: org-agenda-set-effort
+ Set the effort property for the current item.
+
+- {{{kbd(C-c C-z)}}} or short {{{kbd(z)}}} (~org-agenda-add-note~) ::
+
+ #+kindex: z
+ #+kindex: C-c C-z
+ #+findex: org-agenda-add-note
+ #+vindex: org-log-into-drawer
+ Add a note to the entry. This note is recorded, and then filed to
+ the same location where state change notes are put. Depending on
+ ~org-log-into-drawer~, this may be inside a drawer.
+
+- {{{kbd(C-c C-a)}}} (~org-attach~) ::
+
+ #+kindex: C-c C-a
+ #+findex: org-attach
+ Dispatcher for all command related to attachments.
+
+- {{{kbd(C-c C-s)}}} (~org-agenda-schedule~) ::
+
+ #+kindex: C-c C-s
+ #+findex: org-agenda-schedule
+ Schedule this item. With a prefix argument, remove the
+ scheduling timestamp
+
+- {{{kbd(C-c C-d)}}} (~org-agenda-deadline~) ::
+
+ #+kindex: C-c C-d
+ #+findex: org-agenda-deadline
+ Set a deadline for this item. With a prefix argument, remove the
+ deadline.
+
+- {{{kbd(S-RIGHT)}}} (~org-agenda-do-date-later~) ::
+
+ #+kindex: S-RIGHT
+ #+findex: org-agenda-do-date-later
+ Change the timestamp associated with the current line by one day
+ into the future. If the date is in the past, the first call to this
+ command moves it to today. With a numeric prefix argument, change
+ it by that many days. For example, {{{kbd(3 6 5 S-RIGHT)}}} changes
+ it by a year. With a {{{kbd(C-u)}}} prefix, change the time by one
+ hour. If you immediately repeat the command, it will continue to
+ change hours even without the prefix argument. With a double
+ {{{kbd(C-u C-u)}}} prefix, do the same for changing minutes. The
+ stamp is changed in the original Org file, but the change is not
+ directly reflected in the agenda buffer. Use {{{kbd(r)}}} or
+ {{{kbd(g)}}} to update the buffer.
+
+- {{{kbd(S-LEFT)}}} (~org-agenda-do-date-earlier~) ::
+
+ #+kindex: S-LEFT
+ #+findex: org-agenda-do-date-earlier
+ Change the timestamp associated with the current line by one day
+ into the past.
+
+- {{{kbd(>)}}} (~org-agenda-date-prompt~) ::
+
+ #+kindex: >
+ #+findex: org-agenda-date-prompt
+ Change the timestamp associated with the current line. The key
+ {{{kbd(>)}}} has been chosen, because it is the same as
+ {{{kbd(S-.)}}} on my keyboard.
+
+- {{{kbd(I)}}} (~org-agenda-clock-in~) ::
+
+ #+kindex: I
+ #+findex: org-agenda-clock-in
+ Start the clock on the current item. If a clock is running already,
+ it is stopped first.
+
+- {{{kbd(O)}}} (~org-agenda-clock-out~) ::
+
+ #+kindex: O
+ #+findex: org-agenda-clock-out
+ Stop the previously started clock.
+
+- {{{kbd(X)}}} (~org-agenda-clock-cancel~) ::
+
+ #+kindex: X
+ #+findex: org-agenda-clock-cancel
+ Cancel the currently running clock.
+
+- {{{kbd(J)}}} (~org-agenda-clock-goto~) ::
+
+ #+kindex: J
+ #+findex: org-agenda-clock-goto
+ Jump to the running clock in another window.
+
+- {{{kbd(k)}}} (~org-agenda-capture~) ::
+
+ #+kindex: k
+ #+findex: org-agenda-capture
+ #+cindex: capturing, from agenda
+ #+vindex: org-capture-use-agenda-date
+ Like ~org-capture~, but use the date at point as the default date
+ for the capture template. See ~org-capture-use-agenda-date~ to make
+ this the default behavior of ~org-capture~.
+
+*** Bulk remote editing selected entries
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: remote editing, bulk, from agenda
+#+vindex: org-agenda-bulk-custom-functions
+
+- {{{kbd(m)}}} (~org-agenda-bulk-mark~) ::
+ #+kindex: m
+ #+findex: org-agenda-bulk-mark
+
+ Mark the entry at point for bulk action. If there is an active
+ region in the agenda, mark the entries in the region. With numeric
+ prefix argument, mark that many successive entries.
+
+- {{{kbd(*)}}} (~org-agenda-bulk-mark-all~) ::
+ #+kindex: *
+ #+findex: org-agenda-bulk-mark-all
+
+ Mark all visible agenda entries for bulk action.
+
+- {{{kbd(u)}}} (~org-agenda-bulk-unmark~) ::
+ #+kindex: u
+ #+findex: org-agenda-bulk-unmark
+
+ Unmark entry for bulk action.
+
+- {{{kbd(U)}}} (~org-agenda-bulk-remove-all-marks~) ::
+ #+kindex: U
+ #+findex: org-agenda-bulk-remove-all-marks
+
+ Unmark all marked entries for bulk action.
+
+- {{{kbd(M-m)}}} (~org-agenda-bulk-toggle~) ::
+ #+kindex: M-m
+ #+findex: org-agenda-bulk-toggle
+
+ Toggle mark of the entry at point for bulk action.
+
+- {{{kbd(M-*)}}} (~org-agenda-bulk-toggle-all~) ::
+ #+kindex: M-*
+ #+findex: org-agenda-bulk-toggle-all
+
+ Toggle mark of every entry for bulk action.
+
+- {{{kbd(%)}}} (~org-agenda-bulk-mark-regexp~) ::
+ #+kindex: %
+ #+findex: org-agenda-bulk-mark-regexp
+
+ Mark entries matching a regular expression for bulk action.
+
+- {{{kbd(B)}}} (~org-agenda-bulk-action~) ::
+ #+kindex: B
+ #+findex: org-agenda-bulk-action
+ #+vindex: org-agenda-bulk-persistent-marks
+
+ Bulk action: act on all marked entries in the agenda. This prompts
+ for another key to select the action to be applied. The prefix
+ argument to {{{kbd(B)}}} is 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 ~org-agenda-bulk-persistent-marks~ to ~t~ or hit
+ {{{kbd(p)}}} at the prompt.
+
+ - {{{kbd(p)}}} ::
+
+ Toggle persistent marks.
+
+ - {{{kbd($)}}} ::
+
+ Archive all selected entries.
+
+ - {{{kbd(A)}}} ::
+
+ Archive entries by moving them to their respective archive
+ siblings.
+
+ - {{{kbd(t)}}} ::
+
+ Change TODO state. This prompts for a single TODO keyword and
+ changes the state of all selected entries, bypassing blocking and
+ suppressing logging notes---but not timestamps.
+
+ - {{{kbd(+)}}} ::
+
+ Add a tag to all selected entries.
+
+ - {{{kbd(-)}}} ::
+
+ Remove a tag from all selected entries.
+
+ - {{{kbd(s)}}} ::
+
+ Schedule all items to a new date. To shift existing schedule
+ dates by a fixed number of days, use something starting with
+ double plus at the prompt, for example =++8d= or =++2w=.
+
+ - {{{kbd(d)}}} ::
+
+ Set deadline to a specific date.
+
+ - {{{kbd(r)}}} ::
+
+ Prompt for a single refile target and move all entries. The
+ entries are no longer in the agenda; refresh ({{{kbd(g)}}}) to
+ bring them back.
+
+ - {{{kbd(S)}}} ::
+
+ Reschedule randomly into the coming N days. N is prompted for.
+ With a prefix argument ({{{kbd(C-u B S)}}}), scatter only across
+ weekdays.
+
+ - {{{kbd(f)}}} ::
+
+ #+vindex: org-agenda-bulk-custom-functions
+ Apply a function[fn:100] to marked entries. For example, the
+ function below sets the =CATEGORY= property of the entries to
+ =web=.
+
+ #+begin_src emacs-lisp
+ (defun set-category ()
+ (interactive "P")
+ (let ((marker (or (org-get-at-bol 'org-hd-marker)
+ (org-agenda-error))))
+ (org-with-point-at marker
+ (org-back-to-heading t)
+ (org-set-property "CATEGORY" "web"))))
+ #+end_src
+
+*** Calendar commands
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: calendar commands, from agenda
+
+- {{{kbd(c)}}} (~org-agenda-goto-calendar~) ::
+
+ #+kindex: c
+ #+findex: org-agenda-goto-calendar
+ Open the Emacs calendar and go to the date at point in the agenda.
+
+- {{{kbd(c)}}} (~org-calendar-goto-agenda~) ::
+
+ #+kindex: c
+ #+findex: org-calendar-goto-agenda
+ When in the calendar, compute and show the Org agenda for the date
+ at point.
+
+- {{{kbd(i)}}} (~org-agenda-diary-entry~) ::
+ #+kindex: i
+ #+findex: org-agenda-diary-entry
+
+ #+cindex: diary entries, creating from agenda
+ Insert a new entry into the diary, using the date at point and (for
+ block entries) the date at the mark. This adds to the Emacs diary
+ file[fn:101], in a way similar to the {{{kbd(i)}}} command in the
+ calendar. The diary file pops up in another window, where you can
+ add the entry.
+
+ #+vindex: org-agenda-diary-file
+ If you configure ~org-agenda-diary-file~ to point to an Org file,
+ Org creates entries in that file instead. Most entries are stored
+ in a date-based outline tree that will later make it easy to archive
+ appointments from previous months/years. The tree is built under an
+ entry with a =DATE_TREE= property, or else with years as top-level
+ entries. Emacs prompts you for the entry text---if you specify it,
+ the entry is created in ~org-agenda-diary-file~ without further
+ interaction. If you directly press {{{kbd(RET)}}} at the prompt
+ without typing text, the target file is shown in another window for
+ you to finish the entry there. See also the {{{kbd(k r)}}} command.
+
+- {{{kbd(M)}}} (~org-agenda-phases-of-moon~) ::
+
+ #+kindex: M
+ #+findex: org-agenda-phases-of-moon
+ Show the phases of the moon for the three months around current
+ date.
+
+- {{{kbd(S)}}} (~org-agenda-sunrise-sunset~) ::
+
+ #+kindex: S
+ #+findex: org-agenda-sunrise-sunset
+ Show sunrise and sunset times. The geographical location must be
+ set with calendar variables, see the documentation for the Emacs
+ calendar.
+
+- {{{kbd(C)}}} (~org-agenda-convert-date~) ::
+
+ #+kindex: C
+ #+findex: org-agenda-convert-date
+ Convert the date at point into many other cultural and historic
+ calendars.
+
+- {{{kbd(H)}}} (~org-agenda-holidays~) ::
+
+ #+kindex: H
+ #+findex: org-agenda-holidays
+ Show holidays for three months around point date.
+
+*** Quit and exit
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(q)}}} (~org-agenda-quit~) ::
+ #+kindex: q
+ #+findex: org-agenda-quit
+
+ Quit agenda, remove the agenda buffer.
+
+- {{{kbd(x)}}} (~org-agenda-exit~) ::
+ #+kindex: x
+ #+findex: org-agenda-exit
+
+ #+cindex: agenda files, removing buffers
+ Exit agenda, remove the agenda buffer and all buffers loaded by
+ Emacs for the compilation of the agenda. Buffers created by the
+ user to visit Org files are not removed.
+
+** Custom Agenda Views
+:PROPERTIES:
+:DESCRIPTION: Defining special searches and views.
+:END:
+#+cindex: custom agenda views
+#+cindex: agenda views, custom
+
+Custom agenda commands serve two purposes: to store and quickly access
+frequently used TODO and tags searches, and to create special
+composite agenda buffers. Custom agenda commands are accessible
+through the dispatcher (see [[*The Agenda Dispatcher]]), just like the
+default commands.
+
+*** Storing searches
+:PROPERTIES:
+:DESCRIPTION: Type once, use often.
+:END:
+
+The first application of custom searches is the definition of keyboard
+shortcuts for frequently used searches, either creating an agenda
+buffer, or a sparse tree (the latter covering of course only the
+current buffer).
+
+#+kindex: C @r{(Agenda dispatcher)}
+#+vindex: org-agenda-custom-commands
+#+cindex: agenda views, main example
+#+cindex: agenda, as an agenda views
+#+cindex: agenda*, as an agenda views
+#+cindex: tags, as an agenda view
+#+cindex: todo, as an agenda view
+#+cindex: tags-todo
+#+cindex: todo-tree
+#+cindex: occur-tree
+#+cindex: tags-tree
+Custom commands are configured in the variable
+~org-agenda-custom-commands~. You can customize this variable, for
+example by pressing {{{kbd(C)}}} from the agenda dispatcher (see [[*The
+Agenda Dispatcher]]). You can also directly set it with Emacs Lisp in
+the Emacs init file. The following example contains all valid agenda
+views:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("x" agenda)
+ ("y" agenda*)
+ ("w" todo "WAITING")
+ ("W" todo-tree "WAITING")
+ ("u" tags "+boss-urgent")
+ ("v" tags-todo "+boss-urgent")
+ ("U" tags-tree "+boss-urgent")
+ ("f" occur-tree "\\<FIXME\\>")
+ ("h" . "HOME+Name tags searches") ;description for "h" prefix
+ ("hl" tags "+home+Lisa")
+ ("hp" tags "+home+Peter")
+ ("hk" tags "+home+Kim")))
+#+end_src
+
+The initial string in each entry defines the keys you have to press
+after the dispatcher command in order to access the command. Usually
+this is just a single character, but if you have many similar
+commands, you can also define two-letter combinations where the first
+character is the same in several combinations and serves as a prefix
+key[fn:102]. The second parameter is the search type, followed by the
+string or regular expression to be used for the matching. The example
+above will therefore define:
+
+- {{{kbd(x)}}} ::
+
+ as a global search for agenda entries planned[fn:103] this week/day.
+
+- {{{kbd(y)}}} ::
+
+ as the same search, but only for entries with an hour specification
+ like =[h]h:mm=---think of them as appointments.
+
+- {{{kbd(w)}}} ::
+
+ as a global search for TODO entries with =WAITING= as the TODO
+ keyword.
+
+- {{{kbd(W)}}} ::
+
+ as the same search, but only in the current buffer and displaying
+ the results as a sparse tree.
+
+- {{{kbd(u)}}} ::
+
+ as a global tags search for headlines tagged =boss= but not
+ =urgent=.
+
+- {{{kbd(v)}}} ::
+
+ The same search, but limiting it to headlines that are also TODO
+ items.
+
+- {{{kbd(U)}}} ::
+
+ as the same search, but only in the current buffer and displaying
+ the result as a sparse tree.
+
+- {{{kbd(f)}}} ::
+
+ to create a sparse tree (again, current buffer only) with all
+ entries containing the word =FIXME=.
+
+- {{{kbd(h)}}} ::
+
+ as a prefix command for a =HOME= tags search where you have to press
+ an additional key ({{{kbd(l)}}}, {{{kbd(p)}}} or {{{kbd(k)}}}) to
+ select a name (Lisa, Peter, or Kim) as additional tag to match.
+
+Note that ~*-tree~ agenda views need to be called from an Org buffer
+as they operate on the current buffer only.
+
+*** Block agenda
+:PROPERTIES:
+:DESCRIPTION: All the stuff you need in a single buffer.
+:END:
+#+cindex: block agenda
+#+cindex: agenda, with block views
+
+Another possibility is the construction of agenda views that comprise
+the results of /several/ commands, each of which creates a block in
+the agenda buffer. The available commands include ~agenda~ for the
+daily or weekly agenda (as created with {{{kbd(a)}}}) , ~alltodo~ for
+the global TODO list (as constructed with {{{kbd(t)}}}), ~stuck~ for
+the list of stuck projects (as obtained with {{{kbd(#)}}}) and the
+matching commands discussed above: ~todo~, ~tags~, and ~tags-todo~.
+
+Here are two examples:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("h" "Agenda and Home-related tasks"
+ ((agenda "")
+ (tags-todo "home")
+ (tags "garden")))
+ ("o" "Agenda and Office-related tasks"
+ ((agenda "")
+ (tags-todo "work")
+ (tags "office")))))
+#+end_src
+
+#+texinfo: @noindent
+This defines {{{kbd(h)}}} to create a multi-block view for stuff you
+need to attend to at home. The resulting agenda buffer contains your
+agenda for the current week, all TODO items that carry the tag =home=,
+and also all lines tagged with =garden=. Finally the command
+{{{kbd(o)}}} provides a similar view for office tasks.
+
+*** Setting options for custom commands
+:PROPERTIES:
+:DESCRIPTION: Changing the rules.
+:ALT_TITLE: Setting options
+:END:
+#+cindex: options, for custom agenda views
+
+#+vindex: org-agenda-custom-commands
+Org mode contains a number of variables regulating agenda construction
+and display. The global variables define the behavior for all agenda
+commands, including the custom commands. However, if you want to
+change some settings just for a single custom view, you can do so.
+Setting options requires inserting a list of variable names and values
+at the right spot in ~org-agenda-custom-commands~. For example:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("w" todo "WAITING"
+ ((org-agenda-sorting-strategy '(priority-down))
+ (org-agenda-prefix-format " Mixed: ")))
+ ("U" tags-tree "+boss-urgent"
+ ((org-show-context-detail 'minimal)))
+ ("N" search ""
+ ((org-agenda-files '("~org/notes.org"))
+ (org-agenda-text-search-extra-files nil)))))
+#+end_src
+
+#+texinfo: @noindent
+Now the {{{kbd(w)}}} command sorts the collected entries only by
+priority, and the prefix format is modified to just say =Mixed:=
+instead of giving the category of the entry. The sparse tags tree of
+{{{kbd(U)}}} now turns out ultra-compact, because neither the headline
+hierarchy above the match, nor the headline following the match are
+shown. The command {{{kbd(N)}}} does a text search limited to only
+a single file.
+
+For command sets creating a block agenda, ~org-agenda-custom-commands~
+has two separate spots for setting options. You can add options that
+should be valid for just a single command in the set, and options that
+should be valid for all commands in the set. The former are just
+added to the command entry; the latter must come after the list of
+command entries. Going back to the block agenda example (see [[*Block
+agenda]]), let's change the sorting strategy for the {{{kbd(h)}}}
+commands to ~priority-down~, but let's sort the results for =garden=
+tags query in the opposite order, ~priority-up~. This would look like
+this:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("h" "Agenda and Home-related tasks"
+ ((agenda)
+ (tags-todo "home")
+ (tags "garden"
+ ((org-agenda-sorting-strategy '(priority-up)))))
+ ((org-agenda-sorting-strategy '(priority-down))))
+ ("o" "Agenda and Office-related tasks"
+ ((agenda)
+ (tags-todo "work")
+ (tags "office")))))
+#+end_src
+
+As you see, the values and parentheses setting is a little complex.
+When in doubt, use the customize interface to set this variable---it
+fully supports its structure. Just one caveat: when setting options
+in this interface, the /values/ are just Lisp expressions. So if the
+value is a string, you need to add the double-quotes around the value
+yourself.
+
+#+vindex: org-agenda-custom-commands-contexts
+To control whether an agenda command should be accessible from
+a specific context, you can customize
+~org-agenda-custom-commands-contexts~. Let's say for example that you
+have an agenda command {{{kbd(o)}}} displaying a view that you only
+need when reading emails. Then you would configure this option like
+this:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands-contexts
+ '(("o" (in-mode . "message-mode"))))
+#+end_src
+
+You can also tell that the command key {{{kbd(o)}}} should refer to
+another command key {{{kbd(r)}}}. In that case, add this command key
+like this:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands-contexts
+ '(("o" "r" (in-mode . "message-mode"))))
+#+end_src
+
+See the docstring of the variable for more information.
+
+** Exporting Agenda Views
+:PROPERTIES:
+:DESCRIPTION: Writing a view to a file.
+:END:
+#+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[fn:104], Postscript,
+PDF[fn:105], and iCalendar files. If you want to do this only
+occasionally, use the following command:
+
+- {{{kbd(C-x C-w)}}} (~org-agenda-write~) ::
+ #+kindex: C-x C-w
+ #+findex: org-agenda-write
+ #+cindex: exporting agenda views
+ #+cindex: agenda views, exporting
+
+ #+vindex: org-agenda-exporter-settings
+ Write the agenda view to a file.
+
+If you need to export certain agenda views frequently, you can
+associate any custom agenda command with a list of output file
+names[fn:106]. Here is an example that first defines custom commands
+for the agenda and the global TODO list, together with a number of
+files to which to export them. Then we define two block agenda
+commands and specify file names for them as well. File names can be
+relative to the current working directory, or absolute.
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("X" agenda "" nil ("agenda.html" "agenda.ps"))
+ ("Y" alltodo "" nil ("todo.html" "todo.txt" "todo.ps"))
+ ("h" "Agenda and Home-related tasks"
+ ((agenda "")
+ (tags-todo "home")
+ (tags "garden"))
+ nil
+ ("~/views/home.html"))
+ ("o" "Agenda and Office-related tasks"
+ ((agenda)
+ (tags-todo "work")
+ (tags "office"))
+ nil
+ ("~/views/office.ps" "~/calendars/office.ics"))))
+#+end_src
+
+The extension of the file name determines the type of export. If it
+is =.html=, Org mode uses the htmlize package to convert the buffer to
+HTML and save it to this file name. If the extension is =.ps=,
+~ps-print-buffer-with-faces~ is used to produce Postscript output. If
+the extension is =.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 /not/ created when you use one of those
+commands interactively because this might use too much overhead.
+Instead, there is a special command to produce /all/ specified
+files in one step:
+
+- {{{kbd(e)}}} (~org-store-agenda-views~) ::
+
+ #+kindex: e @r{(Agenda dispatcher)}
+ #+findex: org-store-agenda-views
+ Export all agenda views that have export file names associated with
+ them.
+
+You can use the options section of the custom agenda commands to also
+set options for the export commands. For example:
+
+#+begin_src emacs-lisp
+(setq org-agenda-custom-commands
+ '(("X" agenda ""
+ ((ps-number-of-columns 2)
+ (ps-landscape-mode t)
+ (org-agenda-prefix-format " [ ] ")
+ (org-agenda-with-colors nil)
+ (org-agenda-remove-tags t))
+ ("theagenda.ps"))))
+#+end_src
+
+#+texinfo: @noindent
+#+vindex: org-agenda-exporter-settings
+This command sets two options for the Postscript exporter, to make it
+print in two columns in landscape format---the resulting page can be
+cut in two and then used in a paper agenda. The remaining settings
+modify the agenda prefix to omit category and scheduling information,
+and instead include a checkbox to check off items. We also remove the
+tags to make the lines compact, and we do not want to use colors for
+the black-and-white printer. Settings specified in
+~org-agenda-exporter-settings~ also apply, e.g.,
+
+#+begin_src emacs-lisp
+(setq org-agenda-exporter-settings
+ '((ps-number-of-columns 2)
+ (ps-landscape-mode t)
+ (org-agenda-add-entry-text-maxlines 5)
+ (htmlize-output-type 'css)))
+#+end_src
+
+#+texinfo: @noindent
+but the settings in ~org-agenda-custom-commands~ take precedence.
+
+From the command line you may also use:
+
+#+begin_src shell
+emacs -eval (org-batch-store-agenda-views) -kill
+#+end_src
+
+#+texinfo: @noindent
+or, if you need to modify some parameters[fn:107]
+
+#+begin_src shell
+emacs -eval '(org-batch-store-agenda-views \
+ org-agenda-span (quote month) \
+ org-agenda-start-day "2007-11-01" \
+ org-agenda-include-diary nil \
+ org-agenda-files (quote ("~/org/project.org")))' \
+ -kill
+#+end_src
+
+#+texinfo: @noindent
+which creates the agenda views restricted to the file
+=~/org/project.org=, without diary entries and with a 30-day extent.
+
+You can also extract agenda information in a way that allows further
+processing by other programs. See [[*Extracting Agenda Information]], for
+more information.
+
+** Using Column View in the Agenda
+:PROPERTIES:
+:DESCRIPTION: Using column view for collected entries.
+:ALT_TITLE: Agenda Column View
+:END:
+#+cindex: column view, in agenda
+#+cindex: agenda, column view
+
+Column view (see [[*Column View]]) is normally used to view and edit
+properties embedded in the hierarchical structure of an Org file. It
+can be quite useful to use column view also from the agenda, where
+entries are collected by certain criteria.
+
+- {{{kbd(C-c C-x C-c)}}} (~org-agenda-columns~) ::
+ #+kindex: C-c C-x C-c
+ #+findex: org-agenda-columns
+
+ Turn on column view in the agenda.
+
+To understand how to use this properly, it is important to realize
+that the entries in the agenda are no longer in their proper outline
+environment. This causes the following issues:
+
+1.
+ #+vindex: org-columns-default-format-for-agenda
+ #+vindex: org-columns-default-format
+ Org needs to make a decision which columns format to use. Since
+ the entries in the agenda are collected from different files, and
+ different files may have different columns formats, this is a
+ non-trivial problem. Org first checks if
+ ~org-overriding-columns-format~ is currently set, and if so, takes
+ the format from there. You should set this variable only in the
+ /local settings section/ of a custom agenda command (see [[*Custom
+ Agenda Views]]) to make it valid for that specific agenda view. If
+ no such binding exists, it checks, in sequence,
+ ~org-columns-default-format-for-agenda~, the format associated with
+ the first item in the agenda (through a property or a =#+COLUMNS=
+ setting in that buffer) and finally ~org-columns-default-format~.
+
+2.
+ #+cindex: @samp{CLOCKSUM}, special property
+ If any of the columns has a summary type defined (see [[*Column
+ attributes]]), turning on column view in the agenda visits all
+ relevant agenda files and make sure that the computations of this
+ property are up to date. This is also true for the special
+ =CLOCKSUM= property. Org then sums the values displayed in the
+ agenda. In the daily/weekly agenda, the sums cover a single day;
+ in all other views they cover the entire block.
+
+ It is important to realize that the agenda may show the same entry
+ /twice/---for example as scheduled and as a deadline---and it may
+ show two entries from the same hierarchy (for example a /parent/
+ and its /child/). In these cases, the summation in the agenda
+ leads to incorrect results because some values count double.
+
+3. When the column view in the agenda shows the =CLOCKSUM= property,
+ that is always the entire clocked time for this item. So even in
+ the daily/weekly agenda, the clocksum listed in column view may
+ originate from times outside the current view. This has the
+ advantage that you can compare these values with a column listing
+ the planned total effort for a task---one of the major
+ applications for column view in the agenda. If you want
+ information about clocked time in the displayed period use clock
+ table mode (press {{{kbd(R)}}} in the agenda).
+
+4.
+ #+cindex: @samp{CLOCKSUM_T}, special property
+ When the column view in the agenda shows the =CLOCKSUM_T= property,
+ 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 =CLOCKSUM=---and with
+ the planned total effort for it.
+
+* Markup for Rich Contents
+:PROPERTIES:
+:DESCRIPTION: Compose beautiful documents.
+:END:
+
+Org is primarily about organizing and searching through your
+plain-text notes. However, it also provides a lightweight yet robust
+markup language for rich text formatting and more. For instance, you
+may want to center or emphasize text. Or you may need to insert
+a formula or image in your writing. Org offers syntax for all of this
+and more. Used in conjunction with the export framework (see
+[[*Exporting]]), you can author beautiful documents in Org---like the fine
+manual you are currently reading.
+
+** Paragraphs
+:PROPERTIES:
+:DESCRIPTION: The basic unit of text.
+:END:
+
+#+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 =\\= at the end of
+a line.
+
+#+cindex: line breaks, markup rules
+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: @samp{BEGIN_VERSE}
+#+cindex: verse blocks
+#+begin_example
+,#+BEGIN_VERSE
+ Great clouds overhead
+ Tiny black birds rise and fall
+ Snow covers Emacs
+
+ ---AlexSchroeder
+,#+END_VERSE
+#+end_example
+
+When quoting a passage from another document, it is customary to
+format this as a paragraph that is indented on both the left and the
+right margin. You can include quotations in Org documents like this:
+
+#+cindex: @samp{BEGIN_QUOTE}
+#+cindex: quote blocks
+#+begin_example
+,#+BEGIN_QUOTE
+Everything should be made as simple as possible,
+but not any simpler ---Albert Einstein
+,#+END_QUOTE
+#+end_example
+
+If you would like to center some text, do it like this:
+
+#+cindex: @samp{BEGIN_CENTER}
+#+cindex: center blocks
+#+begin_example
+,#+BEGIN_CENTER
+Everything should be made as simple as possible, \\
+but not any simpler
+,#+END_CENTER
+#+end_example
+
+** Emphasis and Monospace
+:PROPERTIES:
+:DESCRIPTION: Bold, italic, etc.
+:END:
+#+cindex: underlined text, markup rules
+#+cindex: bold text, markup rules
+#+cindex: italic text, markup rules
+#+cindex: verbatim text, markup rules
+#+cindex: code text, markup rules
+#+cindex: strike-through text, markup rules
+
+You can make words =*bold*=, =/italic/=, =_underlined_=, ==verbatim==
+and =~code~=, and, if you must, =+strike-through+=. Text in the code
+and verbatim string is not processed for Org specific syntax; it is
+exported verbatim.
+
+#+vindex: org-fontify-emphasized-text
+To turn off fontification for marked up text, you can set
+~org-fontify-emphasized-text~ to ~nil~. To narrow down the list of
+available markup syntax, you can customize ~org-emphasis-alist~.
+
+** Subscripts and Superscripts
+:PROPERTIES:
+:DESCRIPTION: Simple syntax for raising/lowering text.
+:END:
+#+cindex: subscript
+#+cindex: superscript
+
+=^= and =_= 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. For
+example
+
+#+begin_example
+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
+If you write a text where the underscore is often used in a different
+context, Org's convention to always interpret these as subscripts can
+get in your way. Configure the variable ~org-use-sub-superscripts~ to
+change this convention. For example, when setting this variable to
+~{}~, =a_b= is not interpreted as a subscript, but =a_{b}= is.
+
+You can set ~org-use-sub-superscripts~ in a file using the export
+option =^:= (see [[*Export Settings][Export Settings]]). For example, =#+OPTIONS: ^:{}=
+sets ~org-use-sub-superscripts~ to ~{}~ and limits super- and
+subscripts to the curly bracket notation.
+
+You can also toggle the visual display of super- and subscripts:
+
+- {{{kbd(C-c C-x \)}}} (~org-toggle-pretty-entities~) ::
+
+ #+kindex: C-c C-x \
+ #+findex: org-toggle-pretty-entities
+ This command formats sub- and superscripts in a WYSIWYM way.
+
+#+vindex: org-pretty-entities
+#+vindex: org-pretty-entities-include-sub-superscripts
+Set both ~org-pretty-entities~ and
+~org-pretty-entities-include-sub-superscripts~ to ~t~ to start with
+super- and subscripts /visually/ interpreted as specified by the
+option ~org-use-sub-superscripts~.
+
+** Special Symbols
+:PROPERTIES:
+:DESCRIPTION: Greek letters and other symbols.
+:END:
+#+cindex: math symbols
+#+cindex: special symbols
+#+cindex: entities
+
+You can use LaTeX-like syntax to insert special symbols---named
+entities---like =\alpha= to indicate the Greek letter, or =\to= to indicate
+an arrow. Completion for these symbols is available, just type =\=
+and maybe a few letters, and press {{{kbd(M-TAB)}}} to see possible
+completions. If you need such a symbol inside a word, terminate it
+with a pair of curly brackets. For example
+
+#+begin_example
+Pro tip: Given a circle \Gamma of diameter d, the length of its
+circumference is \pi{}d.
+#+end_example
+
+#+findex: org-entities-help
+#+vindex: org-entities-user
+A large number of entities is provided, with names taken from both
+HTML and LaTeX; you can comfortably browse the complete list from
+a dedicated buffer using the command ~org-entities-help~. It is also
+possible to provide your own special symbols in the variable
+~org-entities-user~.
+
+During export, these symbols are transformed into the native format of
+the exporter back-end. Strings like =\alpha= are exported as =&alpha;= in
+the HTML output, and as =\(\alpha\)= in the LaTeX output. Similarly, =\nbsp=
+becomes =&nbsp;= in HTML and =~= in LaTeX.
+
+#+cindex: special symbols, in-buffer display
+If you would like to see entities displayed as UTF-8 characters, use
+the following command[fn:108]:
+
+- {{{kbd(C-c C-x \)}}} (~org-toggle-pretty-entities~) ::
+ #+kindex: C-c C-x \
+ #+findex: org-toggle-pretty-entities
+
+ Toggle display of entities as UTF-8 characters. This does not
+ change the buffer content which remains plain ASCII, but it overlays
+ the UTF-8 character for display purposes only.
+
+#+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[fn:109] the following commonly used character
+combinations: =\-= is treated as a shy hyphen, =--= and =---= are
+converted into dashes, and =...= becomes a compact set of dots.
+
+** Embedded LaTeX
+:PROPERTIES:
+:DESCRIPTION: LaTeX can be freely used inside Org documents.
+:END:
+#+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[fn:110] 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.
+
+*** LaTeX fragments
+:PROPERTIES:
+:DESCRIPTION: Complex formulas made easy.
+:END:
+#+cindex: @LaTeX{} fragments
+
+#+vindex: org-format-latex-header
+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
+[[http://www.mathjax.org][MathJax]] (see [[*Math formatting in HTML export]]) or transcode the math
+into images (see [[*Previewing LaTeX fragments]]).
+
+LaTeX fragments do not need any special marking at all. The following
+snippets are identified as LaTeX source code:
+
+- Environments of any kind[fn:111]. The only requirement is that the
+ =\begin= statement appears on a new line, preceded by only
+ whitespace.
+
+- Text within the usual LaTeX math delimiters. To avoid conflicts
+ with currency specifications, single =$= characters are only
+ recognized as math delimiters if the enclosed text contains at most
+ two line breaks, is directly attached to the =$= characters with no
+ whitespace in between, and if the closing =$= is followed by
+ whitespace, punctuation or a dash. For the other delimiters, there
+ is no such restriction, so when in doubt, use =\(...\)= as inline
+ math delimiters.
+
+#+texinfo: @noindent
+For example:
+
+#+begin_example
+\begin{equation} % arbitrary environments,
+x=\sqrt{b} % even tables, figures
+\end{equation} % etc
+
+If $a^2=b$ and \( b=2 \), then the solution must be
+either $$ a=+\sqrt{2} $$ or \[ a=-\sqrt{2} \].
+#+end_example
+
+#+vindex: org-export-with-latex
+LaTeX processing can be configured with the variable
+~org-export-with-latex~. The default setting is ~t~ which means
+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:
+
+| =#+OPTIONS: tex:t= | Do the right thing automatically (MathJax) |
+| =#+OPTIONS: tex:nil= | Do not process LaTeX fragments at all |
+| =#+OPTIONS: tex:verbatim= | Verbatim export, for jsMath or so |
+
+*** Previewing LaTeX fragments
+:PROPERTIES:
+:DESCRIPTION: What will this snippet look like?
+:END:
+#+cindex: @LaTeX{} fragments, preview
+
+#+vindex: org-preview-latex-default-process
+If you have a working LaTeX installation and =dvipng=, =dvisvgm= or
+=convert= installed[fn:112], LaTeX fragments can be processed to
+produce images of the typeset expressions to be used for inclusion
+while exporting to HTML (see [[*LaTeX fragments]]), or for inline
+previewing within Org mode.
+
+#+vindex: org-format-latex-options
+#+vindex: org-format-latex-header
+You can customize the variables ~org-format-latex-options~ and
+~org-format-latex-header~ to influence some aspects of the preview.
+In particular, the ~:scale~ (and for HTML export, ~:html-scale~)
+property of the former can be used to adjust the size of the preview
+images.
+
+- {{{kbd(C-c C-x C-l)}}} (~org-latex-preview~) ::
+ #+kindex: C-c C-x C-l
+ #+findex: org-latex-preview
+
+ Produce a preview image of the LaTeX fragment at point and overlay
+ it over the source code. If there is no fragment at point, process
+ all fragments in the current entry---between two headlines.
+
+ When called with a single prefix argument, clear all images in the
+ current entry. Two prefix arguments produce a preview image for all
+ fragments in the buffer, while three of them clear all the images in
+ that buffer.
+
+#+vindex: org-startup-with-latex-preview
+You can turn on the previewing of all LaTeX fragments in a file with
+
+: #+STARTUP: latexpreview
+
+To disable it, simply use
+
+: #+STARTUP: nolatexpreview
+
+*** Using CDLaTeX to enter math
+:PROPERTIES:
+:DESCRIPTION: Speed up entering of formulas.
+:ALT_TITLE: CDLaTeX mode
+:END:
+#+cindex: CD@LaTeX{}
+
+CDLaTeX mode is a minor mode that is normally used in combination with
+a major LaTeX mode like AUCTeX in order to speed-up insertion of
+environments and math templates. Inside Org mode, you can make use of
+some of the features of CDLaTeX mode. You need to install
+=cdlatex.el= and =texmathp.el= (the latter comes also with AUCTeX)
+using [[https://melpa.org/][MELPA]] with the [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Package-Installation.html][Emacs packaging system]] or alternatively from
+[[https://staff.fnwi.uva.nl/c.dominik/Tools/cdlatex/]]. Do not use
+CDLaTeX mode itself under Org mode, but use the special version Org
+CDLaTeX minor mode that comes as part of Org. Turn it on for the
+current buffer with {{{kbd(M-x org-cdlatex-mode)}}}, or for all Org
+files with
+
+#+begin_src emacs-lisp
+(add-hook 'org-mode-hook 'turn-on-org-cdlatex)
+#+end_src
+
+When this mode is enabled, the following features are present (for
+more details see the documentation of CDLaTeX mode):
+
+#+attr_texinfo: :sep ,
+- {{{kbd(C-c {)}}} ::
+ #+kindex: C-c @{
+
+ Insert an environment template.
+
+- {{{kbd(TAB)}}} ::
+ #+kindex: TAB
+
+ The {{{kbd(TAB)}}} key expands the template if point is inside
+ a LaTeX fragment[fn:113]. For example, {{{kbd(TAB)}}} expands =fr=
+ to =\frac{}{}= and position point correctly inside the first brace.
+ Another {{{kbd(TAB)}}} gets you into the second brace.
+
+ Even outside fragments, {{{kbd(TAB)}}} expands environment
+ abbreviations at the beginning of a line. For example, if you write
+ =equ= at the beginning of a line and press {{{kbd(TAB)}}}, this
+ abbreviation is expanded to an =equation= environment. To get
+ a list of all abbreviations, type {{{kbd(M-x
+ cdlatex-command-help)}}}.
+
+- {{{kbd(^)}}}, {{{kbd(_)}}} ::
+ #+kindex: _
+ #+kindex: ^
+ #+vindex: cdlatex-simplify-sub-super-scripts
+
+ Pressing {{{kbd(_)}}} and {{{kbd(^)}}} inside a LaTeX fragment
+ inserts these characters together with a pair of braces. If you use
+ {{{kbd(TAB)}}} to move out of the braces, and if the braces surround
+ only a single character or macro, they are removed again (depending
+ on the variable ~cdlatex-simplify-sub-super-scripts~).
+
+- {{{kbd(`)}}} ::
+ #+kindex: `
+
+ Pressing the backquote followed by a character inserts math macros,
+ also outside LaTeX fragments. If you wait more than 1.5 seconds
+ after the backquote, a help window pops up.
+
+- {{{kbd(')}}} ::
+ #+kindex: '
+
+ Pressing the single-quote followed by another character modifies the
+ symbol before point with an accent or a font. If you wait more than
+ 1.5 seconds after the single-quote, a help window pops up.
+ Character modification works only inside LaTeX fragments; outside
+ the quote is normal.
+
+** Literal Examples
+:PROPERTIES:
+:DESCRIPTION: Source code examples with special formatting.
+:END:
+#+cindex: literal examples, markup rules
+#+cindex: code line references, markup rules
+
+You can include literal examples that should not be subjected to
+markup. Such examples are typeset in monospace, so this is well
+suited for source code and similar examples.
+
+#+cindex: @samp{BEGIN_EXAMPLE}
+#+cindex: example block
+#+begin_example
+,#+BEGIN_EXAMPLE
+ Some example from a text file.
+,#+END_EXAMPLE
+#+end_example
+
+#+cindex: comma escape, in literal examples
+There is one limitation, however. You must insert a comma right
+before lines starting with either =*=, =,*=, =#+= or =,#+=, as those
+may be interpreted as outlines nodes or some other special syntax.
+Org transparently strips these additional commas whenever it accesses
+the contents of the block.
+
+#+begin_example
+,#+BEGIN_EXAMPLE
+,,* I am no real headline
+,#+END_EXAMPLE
+#+end_example
+
+For simplicity when using small examples, you can also start the
+example lines with a colon followed by a space. There may also be
+additional whitespace before the colon:
+
+#+begin_example
+Here is an example
+ : Some example from a text file.
+#+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[fn:114]. This
+is done with the code block, where you also need to specify the name
+of the major mode that should be used to fontify the example[fn:115],
+see [[*Structure Templates]] for shortcuts to easily insert code blocks.
+
+#+cindex: @samp{BEGIN_SRC}
+#+cindex: source block
+#+begin_example
+,#+BEGIN_SRC emacs-lisp
+ (defun org-xor (a b)
+ "Exclusive or."
+ (if a (not b) b))
+ ,#+END_SRC
+#+end_example
+
+Both in =example= and in =src= snippets, you can add a =-n= switch to
+the end of the =#+BEGIN= line, to get the lines of the example
+numbered. The =-n= takes an optional numeric argument specifying the
+starting line number of the block. If you use a =+n= switch, the
+numbering from the previous numbered snippet is continued in the
+current one. The =+n= switch can also take a numeric argument. This
+adds the value of the argument to the last line of the previous block
+to determine the starting line number.
+
+#+begin_example
+,#+BEGIN_SRC emacs-lisp -n 20
+ ;; This exports with line number 20.
+ (message "This is line 21")
+,#+END_SRC
+
+,#+BEGIN_SRC emacs-lisp +n 10
+ ;; This is listed as line 31.
+ (message "This is line 32")
+,#+END_SRC
+#+end_example
+
+In literal examples, Org interprets strings like =(ref:name)= as
+labels, and use them as targets for special hyperlinks like
+=[[(name)]]=---i.e., the reference name enclosed in single parenthesis.
+In HTML, hovering the mouse over such a link remote-highlights the
+corresponding code line, which is kind of cool.
+
+You can also add a =-r= switch which /removes/ the labels from the
+source code[fn:116]. With the =-n= switch, links to these references
+are labeled by the line numbers from the code listing. Otherwise
+links use the labels with no parentheses. Here is an example:
+
+#+begin_example -l "(dumb-reference:%s)"
+,#+BEGIN_SRC emacs-lisp -n -r
+ (save-excursion (ref:sc)
+ (goto-char (point-min)) (ref:jump)
+,#+END_SRC
+In line [[(sc)]] we remember the current position. [[(jump)][Line (jump)]]
+jumps to point-min.
+#+end_example
+
+#+cindex: indentation, in source blocks
+Source code and examples may be /indented/ in order to align nicely
+with the surrounding text, and in particular with plain list structure
+(see [[*Plain Lists]]). By default, Org only retains the relative
+indentation between lines, e.g., when exporting the contents of the
+block. However, you can use the =-i= switch to also preserve the
+global indentation, if it does matter. See [[*Editing Source Code]].
+
+#+vindex: org-coderef-label-format
+If the syntax for the label format conflicts with the language syntax,
+use a =-l= switch to change the format, for example
+
+: #+BEGIN_SRC pascal -n -r -l "((%s))"
+
+#+texinfo: @noindent
+See also the variable ~org-coderef-label-format~.
+
+HTML export also allows examples to be published as text areas (see
+[[*Text areas in HTML export]]).
+
+Because the =#+BEGIN= ... =#+END= patterns need to be added so often,
+a shortcut is provided (see [[*Structure Templates]]).
+
+- {{{kbd(C-c ')}}} (~org-edit-special~) ::
+
+ #+kindex: C-c '
+ #+findex: org-edit-special
+ Edit the source code example at point in its native mode. This
+ works by switching to a temporary buffer with the source code. You
+ need to exit by pressing {{{kbd(C-c ')}}} again. The edited version
+ then replaces the old version in the Org buffer. Fixed-width
+ regions---where each line starts with a colon followed by
+ a space---are edited using Artist mode[fn:117] to allow creating
+ ASCII drawings easily. Using this command in an empty line creates
+ a new fixed-width region.
+
+#+cindex: storing link, in a source code buffer
+Calling ~org-store-link~ (see [[*Handling Links]]) while editing a source
+code example in a temporary buffer created with {{{kbd(C-c ')}}}
+prompts for a label. Make sure that it is unique in the current
+buffer, and insert it with the proper formatting like =(ref:label)= at
+the end of the current line. Then the label is stored as a link
+=(label)=, for retrieval with {{{kbd(C-c C-l)}}}.
+
+** Images
+:PROPERTIES:
+:DESCRIPTION: Display an image.
+:END:
+
+#+cindex: inlining images
+#+cindex: images, markup rules
+An image is a link to an image file[fn:118] that does not have
+a description part, for example
+
+: ./img/cat.jpg
+
+If you wish to define a caption for the image (see [[*Captions]]) and
+maybe a label for internal cross references (see [[*Internal Links]]),
+make sure that the link is on a line by itself and precede it with
+=CAPTION= and =NAME= keywords as follows:
+
+#+begin_example
+,#+CAPTION: This is the caption for the next figure link (or table)
+,#+NAME: fig:SED-HR4049
+[[./img/a.jpg]]
+#+end_example
+
+Such images can be displayed within the buffer with the following
+command:
+
+- {{{kbd(C-c C-x C-v)}}} (~org-toggle-inline-images~) ::
+
+ #+kindex: C-c C-x C-v
+ #+findex: org-toggle-inline-images
+ #+vindex: org-startup-with-inline-images
+ Toggle the inline display of linked images. When called with
+ a prefix argument, also display images that do have a link
+ description. You can ask for inline images to be displayed at
+ startup by configuring the variable
+ ~org-startup-with-inline-images~[fn:119].
+
+** Captions
+:PROPERTIES:
+:DESCRIPTION: Describe tables, images...
+:END:
+#+cindex: captions, markup rules
+#+cindex: @samp{CAPTION}, keyword
+
+You can assign a caption to a specific part of a document by inserting
+a =CAPTION= keyword immediately before it:
+
+#+begin_example
+,#+CAPTION: This is the caption for the next table (or link)
+| ... | ... |
+|-----+-----|
+#+end_example
+
+Optionally, the caption can take the form:
+
+: #+CAPTION[Short caption]: Longer caption.
+
+Even though images and tables are prominent examples of captioned
+structures, 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.
+
+** Horizontal Rules
+:PROPERTIES:
+:DESCRIPTION: Make a line.
+:END:
+
+#+cindex: horizontal rules, markup rules
+A line consisting of only dashes, and at least 5 of them, is exported
+as a horizontal line.
+
+** Creating Footnotes
+:PROPERTIES:
+:DESCRIPTION: Edit and read footnotes.
+:END:
+#+cindex: 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. Markers always start with =fn:=. For example:
+
+#+begin_example
+The Org homepage[fn:1] now looks a lot better than it used to.
+...
+[fn:1] The link is: https://orgmode.org
+#+end_example
+
+Org mode extends the number-based syntax to /named/ footnotes and
+optional inline definition. Here are the valid references:
+
+- =[fn:NAME]= ::
+
+ A named footnote reference, where {{{var(NAME)}}} is a unique
+ label word, or, for simplicity of automatic creation, a number.
+
+- =[fn:: This is the inline definition of this footnote]= ::
+
+ An anonymous footnote where the definition is given directly at the
+ reference point.
+
+- =[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 =[fn:NAME]= to create additional references.
+
+#+vindex: org-footnote-auto-label
+Footnote labels can be created automatically, or you can create names
+yourself. This is handled by the variable ~org-footnote-auto-label~
+and its corresponding =STARTUP= keywords. See the docstring of that
+variable for details.
+
+The following command handles footnotes:
+
+- {{{kbd(C-c C-x f)}}} ::
+
+ The footnote action command.
+
+ #+kindex: C-c C-x f
+ When point is on a footnote reference, jump to the definition. When
+ it is at a definition, jump to the---first---reference.
+
+ #+vindex: org-footnote-define-inline
+ #+vindex: org-footnote-section
+ Otherwise, create a new footnote. Depending on the variable
+ ~org-footnote-define-inline~[fn:120], the definition is placed right
+ into the text as part of the reference, or separately into the
+ location determined by the variable ~org-footnote-section~.
+
+ When this command is called with a prefix argument, a menu of
+ additional options is offered:
+
+ #+attr_texinfo: :columns 0.1 0.9
+ | {{{kbd(s)}}} | Sort the footnote definitions by reference sequence. |
+ | {{{kbd(r)}}} | Renumber the simple =fn:N= footnotes. |
+ | {{{kbd(S)}}} | Short for first {{{kbd(r)}}}, then {{{kbd(s)}}} action. |
+ | {{{kbd(n)}}} | Rename all footnotes into a =fn:1= ... =fn:n= sequence. |
+ | {{{kbd(d)}}} | Delete the footnote at point, including definition and references. |
+
+ #+vindex: org-footnote-auto-adjust
+ Depending on the variable ~org-footnote-auto-adjust~[fn:121],
+ renumbering and sorting footnotes can be automatic after each
+ insertion or deletion.
+
+- {{{kbd(C-c C-c)}}} ::
+
+ #+kindex: C-c C-c
+ If point is on a footnote reference, jump to the definition. If it
+ is at the definition, jump back to the reference. When called at
+ a footnote location with a prefix argument, offer the same menu as
+ {{{kbd(C-c C-x f)}}}.
+
+- {{{kbd(C-c C-o)}}} or {{{kbd(mouse-1/2)}}} ::
+
+ #+kindex: C-c C-o
+ #+kindex: mouse-1
+ #+kindex: mouse-2
+ Footnote labels are also links to the corresponding definition or
+ reference, and you can use the usual commands to follow these links.
+
+* Exporting
+:PROPERTIES:
+:DESCRIPTION: Sharing and publishing notes.
+:END:
+#+cindex: exporting
+
+At some point you might want to print your notes, publish them on the
+web, or share them with people not using Org. Org can convert and
+export documents to a variety of other formats while retaining as much
+structure (see [[*Document Structure]]) and markup (see [[*Markup for Rich
+Contents]]) as possible.
+
+#+cindex: export back-end
+The libraries responsible for translating Org files to other formats
+are called /back-ends/. Org ships with support for the following
+back-ends:
+
+- /ascii/ (ASCII format)
+- /beamer/ (LaTeX Beamer format)
+- /html/ (HTML format)
+- /icalendar/ (iCalendar format)
+- /latex/ (LaTeX format)
+- /md/ (Markdown format)
+- /odt/ (OpenDocument Text format)
+- /org/ (Org format)
+- /texinfo/ (Texinfo format)
+- /man/ (Man page format)
+
+Users can install libraries for additional formats from the Emacs
+packaging system. For easy discovery, these packages have a common
+naming scheme: ~ox-NAME~, where {{{var(NAME)}}} is a format. For
+example, ~ox-koma-letter~ for /koma-letter/ back-end. More libraries
+can be found in the =contrib/= directory (see [[*Installation]]).
+
+#+vindex: org-export-backends
+Org only loads back-ends for the following formats by default: ASCII,
+HTML, iCalendar, LaTeX, and ODT. Additional back-ends can be loaded
+in either of two ways: by configuring the ~org-export-backends~
+variable, or by requiring libraries in the Emacs init file. For
+example, to load the Markdown back-end, add this to your Emacs config:
+
+#+begin_src emacs-lisp
+(require 'ox-md)
+#+end_src
+
+** The Export Dispatcher
+:PROPERTIES:
+:DESCRIPTION: The main interface.
+:END:
+#+cindex: dispatcher, for export commands
+#+cindex: export, dispatcher
+
+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.
+
+#+vindex: org-export-dispatch-use-expert-ui
+Org also has a minimal prompt interface for the export dispatcher.
+When the variable ~org-export-dispatch-use-expert-ui~ is set to
+a non-~nil~ value, Org prompts in the minibuffer. To switch back to
+the hierarchical menu, press {{{kbd(?)}}}.
+
+- {{{kbd(C-c C-e)}}} (~org-export~) ::
+ #+kindex: C-c C-e
+ #+findex: org-export
+
+ 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.
+
+Org exports the entire buffer by default. If the Org buffer has an
+active region, then Org exports just that region.
+
+Within the dispatcher interface, the following key combinations can
+further alter what is exported, and how.
+
+- {{{kbd(C-a)}}} ::
+ #+kindex: C-c C-e C-a
+
+ Toggle asynchronous export. Asynchronous export uses an external
+ Emacs process with a specially configured initialization file to
+ complete the exporting process in the background, without tying-up
+ Emacs. This is particularly useful when exporting long documents.
+
+ Output from an asynchronous export is saved on 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
+ You can make asynchronous export the default by setting
+ ~org-export-in-background~.
+
+ #+vindex: org-export-async-init-file
+ You can set the initialization file used by the background process
+ by setting ~org-export-async-init-file~.
+
+- {{{kbd(C-b)}}} ::
+ #+kindex: C-c C-e C-b
+
+ Toggle body-only export. Useful for excluding headers and footers
+ in the export. Affects only those back-end formats that have
+ sections like =<head>...</head>= in HTML.
+
+- {{{kbd(C-s)}}} ::
+ #+kindex: C-c C-e C-s
+
+ Toggle sub-tree export. When turned on, Org exports only the
+ sub-tree starting from point position at the time the export
+ dispatcher was invoked. Org uses the top heading of this sub-tree
+ as the document's title. If point is not on a heading, Org uses the
+ nearest enclosing header. If point is in the document preamble, Org
+ signals an error and aborts export.
+
+ #+vindex: org-export-initial-scope
+ To make sub-tree export the default, customize the variable
+ ~org-export-initial-scope~.
+
+- {{{kbd(C-v)}}} ::
+ #+kindex: C-c C-e C-v
+
+ Toggle visible-only export. This is useful for exporting only
+ certain parts of an Org document by adjusting the visibility of
+ particular headings.
+
+** Export Settings
+:PROPERTIES:
+:DESCRIPTION: Common export settings.
+:END:
+#+cindex: options, for export
+#+cindex: Export, settings
+
+#+cindex: @samp{OPTIONS}, keyword
+Export options can be set: globally with variables; for an individual
+file by making variables buffer-local with in-buffer settings (see
+[[*Summary of In-Buffer Settings]]); by setting individual keywords or
+specifying them in compact form with the =OPTIONS= keyword; or for
+a tree by setting properties (see [[*Properties and Columns]]). Options
+set at a specific level override options set at a more general level.
+
+#+cindex: @samp{SETUPFILE}, keyword
+In-buffer settings may appear anywhere in the file, either directly or
+indirectly through a file included using =#+SETUPFILE: filename or
+URL= syntax. Option keyword sets tailored to a particular back-end
+can be inserted from the export dispatcher (see [[*The Export
+Dispatcher]]) using the =Insert template= command by pressing
+{{{kbd(#)}}}. To insert keywords individually, a good way to make
+sure the keyword is correct is to type =#+= and then to use
+{{{kbd(M-TAB)}}}[fn:16] for completion.
+
+The export keywords available for every back-end, and their equivalent
+global variables, include:
+
+- =AUTHOR= ::
+
+ #+cindex: @samp{AUTHOR}, keyword
+ #+vindex: user-full-name
+ The document author (~user-full-name~).
+
+- =CREATOR= ::
+
+ #+cindex: @samp{CREATOR}, keyword
+ #+vindex: org-expot-creator-string
+ Entity responsible for output generation
+ (~org-export-creator-string~).
+
+- =DATE= ::
+
+ #+cindex: @samp{DATE}, keyword
+ #+vindex: org-export-date-timestamp-format
+ A date or a time-stamp[fn:122].
+
+- =EMAIL= ::
+
+ #+cindex: @samp{EMAIL}, keyword
+ #+vindex: user-mail-address
+ The email address (~user-mail-address~).
+
+- =LANGUAGE= ::
+
+ #+cindex: @samp{LANGUAGE}, keyword
+ #+vindex: org-export-default-language
+ Language to use for translating certain strings
+ (~org-export-default-language~). With =#+LANGUAGE: fr=, for
+ example, Org translates =Table of contents= to the French =Table des
+ matières=[fn:123].
+
+- =SELECT_TAGS= ::
+
+ #+cindex: @samp{SELECT_TAGS}, keyword
+ #+vindex: org-export-select-tags
+ The default value is =("export")=. When a tree is tagged with
+ =export= (~org-export-select-tags~), Org selects that tree and its
+ sub-trees for export. Org excludes trees with =noexport= tags, see
+ below. When selectively exporting files with =export= tags set, Org
+ does not export any text that appears before the first headline.
+
+- =EXCLUDE_TAGS= ::
+
+ #+cindex: @samp{EXCLUDE_TAGS}, keyword
+ #+vindex: org-export-exclude-tags
+ The default value is =("noexport")=. When a tree is tagged with
+ =noexport= (~org-export-exclude-tags~), Org excludes that tree and
+ its sub-trees from export. Entries tagged with =noexport= are
+ unconditionally excluded from the export, even if they have an
+ =export= tag. Even if a sub-tree is not exported, Org executes any
+ code blocks contained there.
+
+- =TITLE= ::
+
+ #+cindex: @samp{TITLE}, keyword
+ #+cindex: document title
+ Org displays this title. For long titles, use multiple =#+TITLE=
+ lines.
+
+- =EXPORT_FILE_NAME= ::
+
+ #+cindex: @samp{EXPORT_FILE_NAME}, keyword
+ 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.
+
+The =OPTIONS= keyword is a compact form. To configure multiple
+options, use several =OPTIONS= lines. =OPTIONS= recognizes the
+following arguments.
+
+- ~'~ ::
+
+ #+vindex: org-export-with-smart-quotes
+ Toggle smart quotes (~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.
+
+- ~*~ ::
+
+ #+vindex: org-export-with-emphasize
+ Toggle emphasized text (~org-export-with-emphasize~).
+
+- ~-~ ::
+
+ #+vindex: org-export-with-special-strings
+ Toggle conversion of special strings
+ (~org-export-with-special-strings~).
+
+- ~:~ ::
+
+ #+vindex: org-export-with-fixed-width
+ Toggle fixed-width sections (~org-export-with-fixed-width~).
+
+- ~<~ ::
+
+ #+vindex: org-export-with-timestamps
+ Toggle inclusion of time/date active/inactive stamps
+ (~org-export-with-timestamps~).
+
+- ~\n~ ::
+
+ #+vindex: org-export-preserve-breaks
+ Toggles whether to preserve line breaks
+ (~org-export-preserve-breaks~).
+
+- ~^~ ::
+
+ #+vindex: org-export-with-sub-superscripts
+ Toggle TeX-like syntax for sub- and superscripts. If you write
+ =^:{}=, =a_{b}= is interpreted, but the simple =a_b= is left as it
+ is (~org-export-with-sub-superscripts~).
+
+- ~arch~ ::
+
+ #+vindex: org-export-with-archived-trees
+ Configure how archived trees are exported. When set to ~headline~,
+ the export process skips the contents and processes only the
+ headlines (~org-export-with-archived-trees~).
+
+- ~author~ ::
+
+ #+vindex: org-export-with-author
+ Toggle inclusion of author name into exported file
+ (~org-export-with-author~).
+
+- ~broken-links~ ::
+
+ #+vindex: org-export-with-broken-links
+ Toggles if Org should continue exporting upon finding a broken
+ internal link. When set to ~mark~, Org clearly marks the problem
+ link in the output (~org-export-with-broken-links~).
+
+- ~c~ ::
+
+ #+vindex: org-export-with-clocks
+ Toggle inclusion of =CLOCK= keywords (~org-export-with-clocks~).
+
+- ~creator~ ::
+
+ #+vindex: org-export-with-creator
+ Toggle inclusion of creator information in the exported file
+ (~org-export-with-creator~).
+
+- ~d~ ::
+
+ #+vindex: org-export-with-drawers
+ Toggles inclusion of drawers, or list of drawers to include, or list
+ of drawers to exclude (~org-export-with-drawers~).
+
+- ~date~ ::
+
+ #+vindex: org-export-with-date
+ Toggle inclusion of a date into exported file
+ (~org-export-with-date~).
+
+- ~e~ ::
+
+ #+vindex: org-export-with-entities
+ Toggle inclusion of entities (~org-export-with-entities~).
+
+- ~email~ ::
+
+ #+vindex: org-export-with-email
+ Toggle inclusion of the author's e-mail into exported file
+ (~org-export-with-email~).
+
+- ~f~ ::
+
+ #+vindex: org-export-with-footnotes
+ Toggle the inclusion of footnotes (~org-export-with-footnotes~).
+
+- ~H~ ::
+
+ #+vindex: org-export-headline-levels
+ Set the number of headline levels for export
+ (~org-export-headline-levels~). Below that level, headlines are
+ treated differently. In most back-ends, they become list items.
+
+- ~inline~ ::
+
+ #+vindex: org-export-with-inlinetasks
+ Toggle inclusion of inlinetasks (~org-export-with-inlinetasks~).
+
+- ~num~ ::
+
+ #+vindex: org-export-with-section-numbers
+ #+cindex: @samp{UNNUMBERED}, property
+ Toggle section-numbers (~org-export-with-section-numbers~). When
+ set to number N, Org numbers only those headlines at level N or
+ above. Set =UNNUMBERED= property to non-~nil~ to disable numbering
+ of heading and subheadings entirely. Moreover, when the value is
+ =notoc= the headline, and all its children, do not appear in the
+ table of contents either (see [[*Table of Contents]]).
+
+- ~p~ ::
+
+ #+vindex: org-export-with-planning
+ Toggle export of planning information (~org-export-with-planning~).
+ "Planning information" comes from lines located right after the
+ headline and contain any combination of these cookies: =SCHEDULED=,
+ =DEADLINE=, or =CLOSED=.
+
+- ~pri~ ::
+
+ #+vindex: org-export-with-priority
+ Toggle inclusion of priority cookies
+ (~org-export-with-priority~).
+
+- ~prop~ ::
+
+ #+vindex: org-export-with-properties
+ Toggle inclusion of property drawers, or list the properties to
+ include (~org-export-with-properties~).
+
+- ~stat~ ::
+
+ #+vindex: org-export-with-statistics-cookies
+ Toggle inclusion of statistics cookies
+ (~org-export-with-statistics-cookies~).
+
+- ~tags~ ::
+
+ #+vindex: org-export-with-tags
+ Toggle inclusion of tags, may also be ~not-in-toc~
+ (~org-export-with-tags~).
+
+- ~tasks~ ::
+
+ #+vindex: org-export-with-tasks
+ Toggle inclusion of tasks (TODO items); or ~nil~ to remove all
+ tasks; or ~todo~ to remove done tasks; or list the keywords to keep
+ (~org-export-with-tasks~).
+
+- ~tex~ ::
+
+ #+vindex: org-export-with-latex
+ ~nil~ does not export; ~t~ exports; ~verbatim~ keeps everything in
+ verbatim (~org-export-with-latex~).
+
+- ~timestamp~ ::
+
+ #+vindex: org-export-time-stamp-file
+ Toggle inclusion of the creation time in the exported file
+ (~org-export-time-stamp-file~).
+
+- ~title~ ::
+
+ #+vindex: org-export-with-title
+ Toggle inclusion of title (~org-export-with-title~).
+
+- ~toc~ ::
+
+ #+vindex: org-export-with-toc
+ Toggle inclusion of the table of contents, or set the level limit
+ (~org-export-with-toc~).
+
+- ~todo~ ::
+
+ #+vindex: org-export-with-todo-keywords
+ Toggle inclusion of TODO keywords into exported text
+ (~org-export-with-todo-keywords~).
+
+- ~|~ ::
+
+ #+vindex: org-export-with-tables
+ Toggle inclusion of tables (~org-export-with-tables~).
+
+When exporting sub-trees, special node properties can override the
+above keywords. These properties have an =EXPORT_= prefix. For
+example, =DATE= becomes, =EXPORT_DATE= when used for a specific
+sub-tree. Except for =SETUPFILE=, all other keywords listed above
+have an =EXPORT_= equivalent.
+
+#+cindex: @samp{BIND}, keyword
+#+vindex: org-export-allow-bind-keywords
+If ~org-export-allow-bind-keywords~ is non-~nil~, Emacs variables can
+become buffer-local during export by using the =BIND= keyword. Its
+syntax is =#+BIND: variable value=. This is particularly useful for
+in-buffer settings that cannot be changed using keywords.
+
+** Table of Contents
+:PROPERTIES:
+:DESCRIPTION: The if and where of the table of contents.
+:END:
+#+cindex: table of contents
+#+cindex: list of tables
+#+cindex: list of listings
+
+#+cindex: @samp{toc}, in @samp{OPTIONS} keyword
+#+vindex: org-export-with-toc
+The table of contents includes all headlines in the document. Its
+depth is therefore the same as the headline levels in the file. If
+you need to use a different depth, or turn it off entirely, set the
+~org-export-with-toc~ variable accordingly. You can achieve the same
+on a per file basis, using the following =toc= item in =OPTIONS=
+keyword:
+
+#+begin_example
+,#+OPTIONS: toc:2 (only include two levels in TOC)
+,#+OPTIONS: toc:nil (no default TOC at all)
+#+end_example
+
+#+cindex: excluding entries from table of contents
+#+cindex: table of contents, exclude entries
+Org includes both numbered and unnumbered headlines in the table of
+contents[fn:124]. If you need to exclude an unnumbered headline,
+along with all its children, set the =UNNUMBERED= property to =notoc=
+value.
+
+#+begin_example
+,* Subtree not numbered, not in table of contents either
+ :PROPERTIES:
+ :UNNUMBERED: notoc
+ :END:
+#+end_example
+
+#+cindex: @samp{TOC}, keyword
+Org normally inserts the table of contents directly before the first
+headline of the file. To move the table of contents to a different
+location, first turn off the default with ~org-export-with-toc~
+variable or with =#+OPTIONS: toc:nil=. Then insert =#+TOC: headlines
+N= at the desired location(s).
+
+#+begin_example
+,#+OPTIONS: toc:nil
+...
+,#+TOC: headlines 2
+#+end_example
+
+To adjust the table of contents depth for a specific section of the
+Org document, append an additional =local= parameter. This parameter
+becomes a relative depth for the current level. The following example
+inserts a local table of contents, with direct children only.
+
+#+begin_example
+,* Section
+,#+TOC: headlines 1 local
+#+end_example
+
+Note that for this feature to work properly in LaTeX export, the Org
+file requires the inclusion of the titletoc package. Because of
+compatibility issues, titletoc has to be loaded /before/ hyperref.
+Customize the ~org-latex-default-packages-alist~ variable.
+
+The following example inserts a table of contents that links to the
+children of the specified target.
+
+#+begin_example
+,* Target
+ :PROPERTIES:
+ :CUSTOM_ID: TargetSection
+ :END:
+,** Heading A
+,** Heading B
+,* Another section
+,#+TOC: headlines 1 :target #TargetSection
+#+end_example
+
+The =:target= attribute is supported in HTML, Markdown, ODT, and ASCII export.
+
+Use the =TOC= keyword to generate list of tables---respectively, all
+listings---with captions.
+
+#+begin_example
+,#+TOC: listings
+,#+TOC: tables
+#+end_example
+
+#+cindex: @samp{ALT_TITLE}, property
+Normally Org uses the headline for its entry in the table of contents.
+But with =ALT_TITLE= property, a different entry can be specified for
+the table of contents.
+
+** Include Files
+:PROPERTIES:
+:DESCRIPTION: Include additional files into a document.
+:END:
+#+cindex: include files, during export
+#+cindex: export, include files
+#+cindex: @samp{INCLUDE}, keyword
+
+During export, you can include the content of another file. For
+example, to include your =.emacs= file, you could use:
+
+: #+INCLUDE: "~/.emacs" src emacs-lisp
+
+#+texinfo: @noindent
+The first parameter is the file name to include. The optional second
+parameter specifies the block type: =example=, =export= or =src=. The
+optional third parameter specifies the source code language to use for
+formatting the contents. This is relevant to both =export= and =src=
+block types.
+
+If an included file is specified as having a markup language, Org
+neither checks for valid syntax nor changes the contents in any way.
+For example and source blocks, Org code-escapes the contents before
+inclusion.
+
+#+cindex: @samp{minlevel}, include
+If an included 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 (see [[*Creating Footnotes]])
+in the included file local to that file. The contents of the included
+file belong to the same structure---headline, item---containing the
+=INCLUDE= keyword. In particular, headlines within the file become
+children of the current section. That behavior can be changed by
+providing an additional keyword parameter, =: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:
+
+: #+INCLUDE: "~/my-book/chapter2.org" :minlevel 1
+
+#+cindex: @samp{lines}, include
+Inclusion of only portions of files are specified using ranges
+parameter with =: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.
+
+| =#+INCLUDE: "~/.emacs" :lines "5-10"= | Include lines 5 to 10, 10 excluded |
+| =#+INCLUDE: "~/.emacs" :lines "-10"= | Include lines 1 to 10, 10 excluded |
+| =#+INCLUDE: "~/.emacs" :lines "10-"= | Include lines from 10 to EOF |
+
+Inclusions may specify a file-link to extract an object matched by
+~org-link-search~[fn:125] (see [[*Search Options in File Links]]). The
+ranges for =:lines= keyword are relative to the requested element.
+Therefore,
+
+: #+INCLUDE: "./paper.org::*conclusion" :lines 1-20
+
+#+texinfo: @noindent
+includes the first 20 lines of the headline named =conclusion=.
+
+#+cindex: @samp{only-contents}, include
+To extract only the contents of the matched object, set
+=:only-contents= property to non-~nil~. This omits any planning lines
+or property drawers. For example, to include the body of the heading
+with the custom ID =theory=, you can use
+
+: #+INCLUDE: "./paper.org::#theory" :only-contents t
+
+The following command allows navigating to the included document:
+
+- {{{kbd(C-c ')}}} (~org-edit~special~) ::
+ #+kindex: C-c '
+ #+findex: org-edit-special
+
+ Visit the included file at point.
+
+** Macro Replacement
+:PROPERTIES:
+:DESCRIPTION: Use macros to create templates.
+:END:
+#+cindex: macro replacement, during export
+#+cindex: @samp{MACRO}, keyword
+
+#+vindex: org-export-global-macros
+Macros replace text snippets during export. Macros are defined
+globally in ~org-export-global-macros~, or document-wise with the
+following syntax:
+
+: #+MACRO: name replacement text; $1, $2 are arguments
+
+#+texinfo: @noindent
+which can be referenced using ={{{name(arg1, arg2)}}}=[fn:126]. For
+example
+
+#+begin_example
+,#+MACRO: poem Rose is $1, violet's $2. Life's ordered: Org assists you.
+{{{poem(red,blue)}}}
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+: Rose is red, violet's blue. Life's ordered: Org assists you.
+
+As a special case, Org parses any replacement text starting with
+=(eval= as an Emacs Lisp expression and evaluates it accordingly.
+Within such templates, arguments become strings. Thus, the following
+macro
+
+: #+MACRO: gnustamp (eval (concat "GNU/" (capitalize $1)))
+
+#+texinfo: @noindent
+turns ={{{gnustamp(linux)}}}= into =GNU/Linux= during export.
+
+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 =CAPTION=, =TITLE=,
+=AUTHOR=, =DATE=, and for some back-end specific export options.
+
+Org comes with following pre-defined macros:
+
+#+attr_texinfo: :sep ;
+- ={{{keyword(NAME)}}}=; ={{{title}}}=; ={{{author}}}=; ={{{email}}}= ::
+
+ #+cindex: @samp{keyword}, macro
+ #+cindex: @samp{title}, macro
+ #+cindex: @samp{author}, macro
+ #+cindex: @samp{email}, macro
+ The =keyword= macro collects all values from {{{var(NAME)}}}
+ keywords throughout the buffer, separated with white space.
+ =title=, =author= and =email= macros are shortcuts for,
+ respectively, ={{{keyword(TITLE)}}}=, ={{{keyword(AUTHOR)}}}= and
+ ={{{keyword(EMAIL)}}}=.
+
+- ={{{date}}}=; ={{{date(FORMAT)}}}= ::
+
+ #+cindex: @samp{date}, macro
+ This macro refers to the =DATE= keyword. {{{var(FORMAT)}}} is an
+ optional argument to the =date= macro that is used only if =DATE= is
+ a single timestamp. {{{var(FORMAT)}}} should be a format string
+ understood by ~format-time-string~.
+
+- ={{{time(FORMAT)}}}=; ={{{modification-time(FORMAT, VC)}}}= ::
+
+ #+cindex: @samp{time}, macro
+ #+cindex: @samp{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 ~format-time-string~. If the second argument to the
+ ~modification-time~ macro is non-~nil~, Org uses =vc.el= to retrieve
+ the document's modification time from the version control system.
+ Otherwise Org reads the file attributes.
+
+- ={{{input-file}}}= ::
+
+ #+cindex: @samp{input-file}, macro
+ This macro refers to the filename of the exported file.
+
+- ={{{property(PROPERTY-NAME)}}}=; ={{{property(PROPERTY-NAME, SEARCH OPTION)}}}= ::
+
+ #+cindex: @samp{property}, macro
+ This macro returns the value of property {{{var(PROPERTY-NAME)}}} in
+ the current entry. If {{{var(SEARCH-OPTION)}}} (see [[*Search
+ Options in File Links]]) refers to a remote entry, use it instead.
+
+- ={{{n}}}=; ={{{n(NAME)}}}=; ={{{n(NAME, ACTION)}}}= ::
+
+ #+cindex: @samp{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 =-=, 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.
+
+#+cindex: @samp{results}, macro
+Moreover, inline source blocks (see [[*Structure of Code Blocks]]) use the
+special =results= macro to mark their output. As such, you are
+advised against re-defining it, unless you know what you are doing.
+
+#+vindex: org-hide-macro-markers
+The surrounding brackets can be made invisible by setting
+~org-hide-macro-markers~ to a non-~nil~ value.
+
+Org expands macros at the very beginning of the export process.
+
+** Comment Lines
+:PROPERTIES:
+:DESCRIPTION: What will not be exported.
+:END:
+#+cindex: exporting, not
+
+#+cindex: comment lines
+Lines starting with zero or more whitespace characters followed by one
+=#= and a whitespace are treated as comments and, as such, are not
+exported.
+
+#+cindex: @samp{BEGIN_COMMENT}
+#+cindex: comment block
+Likewise, regions surrounded by =#+BEGIN_COMMENT= ... =#+END_COMMENT=
+are not exported.
+
+#+cindex: comment trees
+Finally, a =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[fn:127]. The command below helps changing the
+comment status of a headline.
+
+- {{{kbd(C-c ;)}}} (~org-toggle-comment~) ::
+ #+kindex: C-c ;
+ #+findex: org-toggle-comment
+
+ Toggle the =COMMENT= keyword at the beginning of an entry.
+
+** ASCII/Latin-1/UTF-8 export
+:PROPERTIES:
+:DESCRIPTION: Exporting to flat files with encoding.
+:END:
+#+cindex: ASCII export
+#+cindex: Latin-1 export
+#+cindex: UTF-8 export
+
+ASCII export produces an output file containing only plain ASCII
+characters. This is the simplest and most direct text output. It
+does not contain any Org markup. 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 ~org-ascii-text-width~.
+
+#+vindex: org-ascii-links-to-notes
+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 ~org-ascii-links-to-notes~ for details.
+
+*** ASCII export commands
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+attr_texinfo: :sep ,
+- {{{kbd(C-c C-e t a)}}} (~org-ascii-export-to-ascii~), {{{kbd(C-c C-e t l)}}}, {{{kbd(C-c C-e t u)}}} ::
+ #+kindex: C-c C-e t a
+ #+kindex: C-c C-e t l
+ #+kindex: C-c C-e t u
+ #+findex: org-ascii-export-to-ascii
+
+ Export as an ASCII file with a =.txt= extension. For =myfile.org=,
+ Org exports to =myfile.txt=, overwriting without warning. For
+ =myfile.txt=, Org exports to =myfile.txt.txt= in order to prevent
+ data loss.
+
+- {{{kbd(C-c C-e t A)}}} (~org-ascii-export-to-ascii~), {{{kbd(C-c C-e t L)}}}, {{{kbd(C-c C-e t U)}}} ::
+ #+kindex: C-c C-e t A
+ #+kindex: C-c C-e t L
+ #+kindex: C-c C-e t U
+ #+findex: org-ascii-export-as-ascii
+
+ Export to a temporary buffer. Does not create a file.
+
+*** ASCII specific export settings
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+The ASCII export back-end has one extra keyword for customizing ASCII
+output. Setting this keyword works similar to the general options
+(see [[*Export Settings]]).
+
+- =SUBTITLE= ::
+
+ #+cindex: @samp{SUBTITLE}, keyword
+ The document subtitle. For long subtitles, use multiple
+ =#+SUBTITLE= lines in the Org file. Org prints them on one
+ continuous line, wrapping into multiple lines if necessary.
+
+*** Header and sectioning structure
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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, see [[*Export Settings]].
+
+*** Quoting ASCII text
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+To insert text within the Org file by the ASCII back-end, use one the
+following constructs, inline, keyword, or export block:
+
+#+cindex: @samp{ASCII}, keyword
+#+cindex: @samp{BEGIN_EXPORT ascii}
+#+begin_example
+Inline text @@ascii:and additional text@@ within a paragraph.
+
+,#+ASCII: Some text
+
+,#+BEGIN_EXPORT ascii
+Org exports text in this block only when using ASCII back-end.
+,#+END_EXPORT
+#+end_example
+
+*** ASCII specific attributes
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: @samp{ATTR_ASCII}, keyword
+#+cindex: horizontal rules, in ASCII export
+
+ASCII back-end recognizes only one attribute, =:width=, which
+specifies the width of a horizontal rule in number of characters. The
+keyword and syntax for specifying widths is:
+
+#+begin_example
+,#+ATTR_ASCII: :width 10
+-----
+#+end_example
+
+*** ASCII special blocks
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+cindex: special blocks, in ASCII export
+#+cindex: @samp{BEGIN_JUSTIFYLEFT}
+#+cindex: @samp{BEGIN_JUSTIFYRIGHT}
+
+Besides =#+BEGIN_CENTER= blocks (see [[*Paragraphs]]), ASCII back-end has
+these two left and right justification blocks:
+
+#+begin_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
+
+** Beamer Export
+:PROPERTIES:
+:DESCRIPTION: Producing presentations and slides.
+:END:
+#+cindex: Beamer export
+
+Org uses Beamer export to convert an Org file tree structure into
+high-quality interactive slides for presentations. Beamer is a LaTeX
+document class for creating presentations in PDF, HTML, and other
+popular display formats.
+
+*** Beamer export commands
+:PROPERTIES:
+:DESCRIPTION: For creating Beamer documents.
+:END:
+
+- {{{kbd(C-c C-e l b)}}} (~org-beamer-export-to-latex~) ::
+ #+kindex: C-c C-e l b
+ #+findex: org-beamer-export-to-latex
+
+ Export as LaTeX file with a =.tex= extension. For =myfile.org=, Org
+ exports to =myfile.tex=, overwriting without warning.
+
+- {{{kbd(C-c C-e l B)}}} (~org-beamer-export-as-latex~) ::
+ #+kindex: C-c C-e l B
+ #+findex: org-beamer-export-as-latex
+
+ Export to a temporary buffer. Does not create a file.
+
+- {{{kbd(C-c C-e l P)}}} (~org-beamer-export-to-pdf~) ::
+ #+kindex: C-c C-e l P
+ #+findex: org-beamer-export-to-pdf
+
+ Export as LaTeX file and then convert it to PDF format.
+
+- {{{kbd(C-c C-e l O)}}} ::
+ #+kindex: C-c C-e l O
+
+ Export as LaTeX file, convert it to PDF format, and then open the
+ PDF file.
+
+*** Beamer specific export settings
+:PROPERTIES:
+:DESCRIPTION: For customizing Beamer export.
+:END:
+
+Beamer export back-end has several additional keywords for customizing
+Beamer output. These keywords work similar to the general options
+settings (see [[*Export Settings]]).
+
+- =BEAMER_THEME= ::
+
+ #+cindex: @samp{BEAMER_THEME}, keyword
+ #+vindex: org-beamer-theme
+ The Beamer layout theme (~org-beamer-theme~). Use square brackets
+ for options. For example:
+
+ : #+BEAMER_THEME: Rochester [height=20pt]
+
+- =BEAMER_FONT_THEME= ::
+
+ #+cindex: @samp{BEAMER_FONT_THEME}, keyword
+ The Beamer font theme.
+
+- =BEAMER_INNER_THEME= ::
+
+ #+cindex: @samp{BEAMER_INNER_THEME}, keyword
+ The Beamer inner theme.
+
+- =BEAMER_OUTER_THEME= ::
+
+ #+cindex: @samp{BEAMER_OUTER_THEME}, keyword
+ The Beamer outer theme.
+
+- =BEAMER_HEADER= ::
+
+ #+cindex: @samp{BEAMER_HEADER}, keyword
+ Arbitrary lines inserted in the preamble, just before the =hyperref=
+ settings.
+
+- =DESCRIPTION= ::
+
+ #+cindex: @samp{DESCRIPTION}, keyword
+ The document description. For long descriptions, use multiple
+ =DESCRIPTION= keywords. By default, =hyperref= inserts
+ =DESCRIPTION= as metadata. Use ~org-latex-hyperref-template~ to
+ configure document metadata. Use ~org-latex-title-command~ to
+ configure typesetting of description as part of front matter.
+
+- =KEYWORDS= ::
+
+ #+cindex: @samp{KEYWORDS}, keyword
+ The keywords for defining the contents of the document. Use
+ multiple =KEYWORDS= lines if necessary. By default, =hyperref=
+ inserts =KEYWORDS= as metadata. Use ~org-latex-hyperref-template~
+ to configure document metadata. Use ~org-latex-title-command~ to
+ configure typesetting of keywords as part of front matter.
+
+- =SUBTITLE= ::
+
+ #+cindex: @samp{SUBTITLE}, keyword
+ Document's subtitle. For typesetting, use
+ ~org-beamer-subtitle-format~ string. Use
+ ~org-latex-hyperref-template~ to configure document metadata. Use
+ ~org-latex-title-command~ to configure typesetting of subtitle as
+ part of front matter.
+
+*** Frames and Blocks in Beamer
+:PROPERTIES:
+:DESCRIPTION: For composing Beamer slides.
+:END:
+
+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.
+
+-
+ #+vindex: org-beamer-frame-level
+ Org headlines become Beamer frames when the heading level in Org is
+ equal to ~org-beamer-frame-level~ or =H= value in a =OPTIONS= line
+ (see [[*Export Settings]]).
+
+ #+cindex: @samp{BEAMER_ENV}, property
+ Org overrides headlines to frames conversion for the current tree of
+ an Org file if it encounters the =BEAMER_ENV= property set to
+ =frame= or =fullframe=. Org ignores whatever
+ ~org-beamer-frame-level~ happens to be for that headline level in
+ the Org tree. In Beamer terminology, a full frame is a frame
+ without its title.
+
+- Org exports a Beamer frame's objects as block environments. Org can
+ enforce wrapping in special block types when =BEAMER_ENV= property
+ is set[fn:128]. For valid values see
+ ~org-beamer-environments-default~. To add more values, see
+ ~org-beamer-environments-extra~.
+ #+vindex: org-beamer-environments-default
+ #+vindex: org-beamer-environments-extra
+
+-
+ #+cindex: @samp{BEAMER_REF}, property
+ If =BEAMER_ENV= is set to =appendix=, Org exports the entry as an
+ appendix. When set to =note=, Org exports the entry as a note
+ within the frame or between frames, depending on the entry's heading
+ level. When set to =noteNH=, Org exports the entry as a note
+ without its title. When set to =againframe=, Org exports the entry
+ with =\againframe= command, which makes setting the =BEAMER_REF=
+ property mandatory because =\againframe= needs frame to resume.
+
+ When =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 =column=
+ environment. @end itemize
+
+ #+cindex: @samp{BEAMER_ACT}, property
+ #+cindex: @samp{BEAMER_OPT}, property
+ When =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 =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
+ =fragile= option for any code that may require a verbatim block.
+
+ #+cindex: @samp{BEAMER_COL}, property
+ To create a column on the Beamer slide, use the =BEAMER_COL=
+ property for its headline in the Org file. Set the value of
+ =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 =BEAMER_ENV= property.
+
+*** Beamer specific syntax
+:PROPERTIES:
+:DESCRIPTION: For using in Org documents.
+:END:
+
+Since Org's Beamer export back-end is an extension of the LaTeX
+back-end, it recognizes other LaTeX specific syntax---for example,
+=#+LATEX:= or =#+ATTR_LATEX:=. See [[*LaTeX Export]], for details.
+
+Beamer export wraps the table of contents generated with =toc:t=
+=OPTION= keyword in a =frame= environment. Beamer export does not
+wrap the table of contents generated with =TOC= keyword (see [[*Table of
+Contents]]). Use square brackets for specifying options.
+
+: #+TOC: headlines [currentsection]
+
+Insert Beamer-specific code using the following constructs:
+
+#+cindex: @samp{BEAMER}, keyword
+#+cindex: @samp{BEGIN_EXPORT beamer}
+#+begin_example
+,#+BEAMER: \pause
+
+,#+BEGIN_EXPORT beamer
+ Only Beamer export back-end exports this.
+,#+END_BEAMER
+
+Text @@beamer:some code@@ within a paragraph.
+#+end_example
+
+Inline constructs, such as the last one above, are useful for adding
+overlay specifications to objects with ~bold~, ~item~, ~link~,
+~radio-target~ and ~target~ types. Enclose the value in angular
+brackets and place the specification at the beginning of the object as
+shown in this example:
+
+: A *@@beamer:<2->@@useful* feature
+
+#+cindex: @samp{ATTR_BEAMER}, keyword
+Beamer export recognizes the =ATTR_BEAMER= keyword with the following
+attributes from Beamer configurations: =:environment= for changing
+local Beamer environment, =:overlay= for specifying Beamer overlays in
+angular or square brackets, and =:options= for inserting optional
+arguments.
+
+#+begin_example
+,#+ATTR_BEAMER: :environment nonindentlist
+- item 1, not indented
+- item 2, not indented
+- item 3, not indented
+#+end_example
+
+#+begin_example
+,#+ATTR_BEAMER: :overlay <+->
+- item 1
+- item 2
+#+end_example
+
+#+begin_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
+
+*** Editing support
+:PROPERTIES:
+:DESCRIPTION: Editing support.
+:END:
+
+Org Beamer mode is a special minor mode for faster editing of Beamer
+documents.
+
+: #+STARTUP: beamer
+
+- {{{kbd(C-c C-b)}}} (~org-beamer-select-environment~) ::
+ #+kindex: C-c C-b
+ #+findex: org-beamer-select-environment
+
+ Org Beamer mode provides this key for quicker selections in Beamer
+ normal environments, and for selecting the =BEAMER_COL= property.
+
+*** A Beamer example
+:PROPERTIES:
+:DESCRIPTION: A complete presentation.
+:END:
+
+Here is an example of an Org document ready for Beamer export.
+
+#+begin_example
+,#+TITLE: Example Presentation
+,#+AUTHOR: Carsten Dominik
+,#+OPTIONS: H:2 toc:t num:t
+,#+LATEX_CLASS: beamer
+,#+LATEX_CLASS_OPTIONS: [presentation]
+,#+BEAMER_THEME: Madrid
+,#+COLUMNS: %45ITEM %10BEAMER_ENV(Env) %10BEAMER_ACT(Act) %4BEAMER_COL(Col)
+
+,* This is the first structural section
+
+,** Frame 1
+,*** 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:
+ :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:
+ :PROPERTIES:
+ :BEAMER_env: note
+ :END:
+,** Frame 2 (where we will not use columns)
+,*** Request
+ Please test this stuff!
+#+end_example
+
+** HTML Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to HTML.
+:END:
+#+cindex: HTML export
+
+Org mode contains an HTML exporter with extensive HTML formatting
+compatible with XHTML 1.0 strict standard.
+
+*** HTML export commands
+:PROPERTIES:
+:DESCRIPTION: Invoking HTML export.
+:END:
+
+- {{{kbd(C-c C-e h h)}}} (~org-html-export-to-html~) ::
+ #+kindex: C-c C-e h h
+ #+kindex: C-c C-e h o
+ #+findex: org-html-export-to-html
+
+ Export as HTML file with a =.html= extension. For =myfile.org=, Org
+ exports to =myfile.html=, overwriting without warning. {{{kbd{C-c
+ C-e h o)}}} exports to HTML and opens it in a web browser.
+
+- {{{kbd(C-c C-e h H)}}} (~org-html-export-as-html~) ::
+ #+kindex: C-c C-e h H
+ #+findex: org-html-export-as-html
+
+ Exports to a temporary buffer. Does not create a file.
+
+*** HTML specific export settings
+:PROPERTIES:
+:DESCRIPTION: Settings for HTML export.
+:END:
+
+HTML export has a number of keywords, similar to the general options
+settings described in [[*Export Settings]].
+
+- =DESCRIPTION= ::
+
+ #+cindex: @samp{DESCRIPTION}, keyword
+ 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 =DESCRIPTION= lines. The exporter takes care of wrapping
+ the lines properly.
+
+- =HTML_DOCTYPE= ::
+
+ #+cindex: @samp{HTML_DOCTYPE}, keyword
+ #+vindex: org-html-doctype
+ Specify the document type, for example: HTML5 (~org-html-doctype~).
+
+- =HTML_CONTAINER= ::
+
+ #+cindex: @samp{HTML_CONTAINER}, keyword
+ #+vindex: org-html-container-element
+ Specify the HTML container, such as =div=, for wrapping sections and
+ elements (~org-html-container-element~).
+
+- =HTML_LINK_HOME= ::
+
+ #+cindex: @samp{HTML_LINK_HOME}, keyword
+ #+vindex: org-html-link-home
+ The URL for home link (~org-html-link-home~).
+
+- =HTML_LINK_UP= ::
+
+ #+cindex: @samp{HTML_LINK_UP}, keyword
+ #+vindex: org-html-link-up
+ The URL for the up link of exported HTML pages (~org-html-link-up~).
+
+- =HTML_MATHJAX= ::
+
+ #+cindex: @samp{HTML_MATHJAX}, keyword
+ #+vindex: org-html-mathjax-options
+ Options for MathJax (~org-html-mathjax-options~). MathJax is used
+ to typeset LaTeX math in HTML documents. See [[*Math formatting in
+ HTML export]], for an example.
+
+- =HTML_HEAD= ::
+
+ #+cindex: @samp{HTML_HEAD}, keyword
+ #+vindex: org-html-head
+ Arbitrary lines for appending to the HTML document's head
+ (~org-html-head~).
+
+- =HTML_HEAD_EXTRA= ::
+
+ #+cindex: @samp{HTML_HEAD_EXTRA}, keyword
+ #+vindex: org-html-head-extra
+ More arbitrary lines for appending to the HTML document's head
+ (~org-html-head-extra~).
+
+- =KEYWORDS= ::
+
+ #+cindex: @samp{KEYWORDS}, keyword
+ Keywords to describe the document's content. HTML exporter inserts
+ these keywords as HTML meta tags. For long keywords, use multiple
+ =KEYWORDS= lines.
+
+- =LATEX_HEADER= ::
+
+ #+cindex: @samp{LATEX_HEADER}, keyword
+ Arbitrary lines for appending to the preamble; HTML exporter appends
+ when transcoding LaTeX fragments to images (see [[*Math formatting in
+ HTML export]]).
+
+- =SUBTITLE= ::
+
+ #+cindex: @samp{SUBTITLE}, keyword
+ The document's subtitle. HTML exporter formats subtitle if document
+ type is =HTML5= and the CSS has a =subtitle= class.
+
+Some of these keywords are explained in more detail in the following
+sections of the manual.
+
+*** HTML doctypes
+:PROPERTIES:
+:DESCRIPTION: Exporting various (X)HTML flavors.
+:END:
+
+Org can export to various (X)HTML flavors.
+
+#+vindex: org-html-doctype
+#+vindex: org-html-doctype-alist
+Set the ~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:
+
+- ~"html4-strict"~
+- ~"html4-transitional"~
+- ~"html4-frameset"~
+- ~"xhtml-strict"~
+- ~"xhtml-transitional"~
+- ~"xhtml-frameset"~
+- ~"xhtml-11"~
+- ~"html5"~
+- ~"xhtml5"~
+
+#+texinfo: @noindent
+See the variable ~org-html-doctype-alist~ for details. The default is
+~"xhtml-strict"~.
+
+#+vindex: org-html-html5-fancy
+#+cindex: @samp{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
+~org-html-html5-fancy~ to non-~nil~. Or use an =OPTIONS= line in the
+file to set =html5-fancy=.
+
+HTML5 documents can now have arbitrary =#+BEGIN= ... =#+END= blocks.
+For example:
+
+#+begin_example
+,#+BEGIN_aside
+ Lorem ipsum
+,#+END_aside
+#+end_example
+
+#+texinfo: @noindent
+exports to:
+
+#+begin_src html
+<aside>
+ <p>Lorem ipsum</p>
+</aside>
+#+end_src
+
+#+texinfo: @noindent
+while this:
+
+#+begin_example
+,#+ATTR_HTML: :controls controls :width 350
+,#+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_example
+
+#+texinfo: @noindent
+exports to:
+
+#+begin_src html
+<video controls="controls" width="350">
+ <source src="movie.mp4" type="video/mp4">
+ <source src="movie.ogg" type="video/ogg">
+ <p>Your browser does not support the video tag.</p>
+</video>
+#+end_src
+
+#+vindex: org-html-html5-elements
+When special blocks do not have a corresponding HTML5 element, the
+HTML exporter reverts to standard translation (see
+~org-html-html5-elements~). For example, =#+BEGIN_lederhosen= exports
+to ~<div class="lederhosen">~.
+
+Special blocks cannot have headlines. For the HTML exporter to wrap
+the headline and its contents in ~<section>~ or ~<article>~ tags, set
+the =HTML_CONTAINER= property for the headline.
+
+*** HTML preamble and postamble
+:PROPERTIES:
+:DESCRIPTION: Inserting preamble and postamble.
+:END:
+#+vindex: org-html-preamble
+#+vindex: org-html-postamble
+#+vindex: org-html-preamble-format
+#+vindex: org-html-postamble-format
+#+vindex: org-html-validation-link
+#+vindex: org-export-creator-string
+#+vindex: org-export-time-stamp-file
+
+The HTML exporter has delineations for preamble and postamble. The
+default value for ~org-html-preamble~ is ~t~, which makes the HTML
+exporter insert the preamble. See the variable
+~org-html-preamble-format~ for the format string.
+
+Set ~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 does not insert
+a preamble if ~org-html-preamble~ is set ~nil~.
+
+The default value for ~org-html-postamble~ is ~auto~, which makes the
+HTML exporter build a postamble from looking up author's name, email
+address, creator's name, and date. Set ~org-html-postamble~ to ~t~ to
+insert the postamble in the format specified in the
+~org-html-postamble-format~ variable. The HTML exporter does not
+insert a postamble if ~org-html-postamble~ is set to ~nil~.
+
+*** Quoting HTML tags
+:PROPERTIES:
+:DESCRIPTION: Using direct HTML in Org files.
+:END:
+
+The HTML export back-end transforms =<= and =>= to =&lt;= and =&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:
+=@@html:...@@=. For example:
+
+: @@html:<b>@@bold text@@html:</b>@@
+
+#+cindex: @samp{HTML}, keyword
+#+cindex: @samp{BEGIN_EXPORT html}
+For larger raw HTML code blocks, use these HTML export code blocks:
+
+#+begin_example
+,#+HTML: Literal HTML code for export
+
+,#+BEGIN_EXPORT html
+ All lines between these markers are exported literally
+,#+END_EXPORT
+#+end_example
+
+*** Headlines in HTML export
+:PROPERTIES:
+:DESCRIPTION: Formatting headlines.
+:END:
+#+cindex: headlines, in HTML export
+
+Headlines are exported to =<h1>=, =<h2>=, etc. Each headline gets the
+=id= attribute from =CUSTOM_ID= property, or a unique generated value,
+see [[*Internal Links]].
+
+#+vindex: org-html-self-link-headlines
+When ~org-html-self-link-headlines~ is set to a non-~nil~ value, the
+text of the headlines is also wrapped in =<a>= tags. These tags have
+a =href= attribute making the headlines link to themselves.
+
+*** Links in HTML export
+:PROPERTIES:
+:DESCRIPTION: Inserting and formatting links.
+:END:
+#+cindex: links, in HTML export
+#+cindex: internal links, in HTML export
+#+cindex: external links, in HTML export
+
+The HTML export back-end transforms Org's internal links (see
+[[*Internal Links]]) to equivalent HTML links in the output. The back-end
+similarly handles Org's automatic links created by radio targets (see
+[[*Radio Targets]]) similarly. For Org links to external files, the
+back-end transforms the links to /relative/ paths.
+
+#+vindex: org-html-link-org-files-as-html
+For Org links to other =.org= files, the back-end automatically
+changes the file extension to =.html= and makes file paths relative.
+If the =.org= files have an equivalent =.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 ~org-html-link-org-files-as-html~ to ~nil~. When
+disabled, the HTML export back-end substitutes the ID-based links in
+the HTML output. For more about linking files when publishing to
+a directory, see [[*Publishing links]].
+
+Org files can also have special directives to the HTML export
+back-end. For example, by using =#+ATTR_HTML= lines to specify new
+format attributes to ~<a>~ or ~<img>~ tags. This example shows
+changing the link's title and style:
+
+#+cindex: @samp{ATTR_HTML}, keyword
+#+begin_example
+,#+ATTR_HTML: :title The Org mode homepage :style color:red;
+[[https://orgmode.org]]
+#+end_example
+
+*** Tables in HTML export
+:PROPERTIES:
+:DESCRIPTION: How to modify the formatting of tables.
+:END:
+#+cindex: tables, in HTML
+#+vindex: org-export-html-table-tag
+
+The HTML export back-end uses ~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: @samp{CAPTION}, keyword
+#+cindex: @samp{ATTR_HTML}, keyword
+#+begin_example
+,#+CAPTION: This is a table with lines around and between cells
+,#+ATTR_HTML: :border 2 :rules all :frame border
+#+end_example
+
+The HTML export back-end preserves column groupings in Org tables (see
+[[*Column Groups]]) when exporting to HTML.
+
+Additional options for customizing tables for HTML export.
+
+- ~org-html-table-align-individual-fields~ ::
+
+ #+vindex: org-html-table-align-individual-fields
+ Non-~nil~ attaches style attributes for alignment to each table
+ field.
+
+- ~org-html-table-caption-above~ ::
+
+ #+vindex: org-html-table-caption-above
+ Non-~nil~ places caption string at the beginning of the table.
+
+- ~org-html-table-data-tags~ ::
+
+ #+vindex: org-html-table-data-tags
+ Opening and ending tags for table data fields.
+
+- ~org-html-table-default-attributes~ ::
+
+ #+vindex: org-html-table-default-attributes
+ Default attributes and values for table tags.
+
+- ~org-html-table-header-tags~ ::
+
+ #+vindex: org-html-table-header-tags
+ Opening and ending tags for table's header fields.
+
+- ~org-html-table-row-tags~ ::
+
+ #+vindex: org-html-table-row-tags
+ Opening and ending tags for table rows.
+
+- ~org-html-table-use-header-tags-for-first-column~ ::
+
+ #+vindex: org-html-table-use-header-tags-for-first-column
+ Non-~nil~ formats column one in tables with header tags.
+
+*** Images in HTML export
+:PROPERTIES:
+:DESCRIPTION: How to insert figures into HTML output.
+:END:
+#+cindex: images, inline in HTML
+#+cindex: inlining images in HTML
+
+The HTML export back-end has features to convert Org image links to
+HTML inline images and HTML clickable image links.
+
+#+vindex: org-html-inline-images
+When the link in the Org file has no description, the HTML export
+back-end by default in-lines that image. For example:
+=[[file:myimg.jpg]]= is in-lined, while =[[file:myimg.jpg][the image]]= links to the text,
+=the image=. For more details, see the variable
+~org-html-inline-images~.
+
+On the other hand, if the description part of the Org link is itself
+another link, such as =file:= or =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:
+
+: [[file:highres.jpg][file:thumb.jpg]]
+
+To change attributes of in-lined images, use =#+ATTR_HTML= lines in
+the Org file. This example shows realignment to right, and adds ~alt~
+and ~title~ attributes in support of text viewers and modern web
+accessibility standards.
+
+#+cindex: @samp{CAPTION}, keyword
+#+cindex: @samp{ATTR_HTML}, keyword
+#+begin_example
+,#+CAPTION: A black cat stalking a spider
+,#+ATTR_HTML: :alt cat/spider image :title Action! :align right
+[[./img/a.jpg]]
+#+end_example
+
+The HTML export back-end copies the =http= links from the Org file
+as-is.
+
+*** Math formatting in HTML export
+:PROPERTIES:
+:DESCRIPTION: Beautiful math also on the web.
+:END:
+#+cindex: MathJax
+#+cindex: dvipng
+#+cindex: dvisvgm
+#+cindex: ImageMagick
+
+#+vindex: org-html-mathjax-options~
+LaTeX math snippets (see [[*LaTeX fragments]]) can be displayed in two
+different ways on HTML pages. The default is to use the [[http://www.mathjax.org][MathJax]],
+which should work out of the box with Org[fn:129][fn:130]. Some MathJax
+display options can be configured via ~org-html-mathjax-options~, or
+in the buffer. For example, with the following settings,
+
+#+begin_example
+,#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
+,#+HTML_MATHJAX: cancel.js noErrors.js
+#+end_example
+
+#+texinfo: @noindent
+equation labels are displayed on the left margin and equations are
+five em from the left margin. In addition, it loads the two MathJax
+extensions =cancel.js= and =noErrors.js=[fn:131].
+
+#+vindex: org-html-mathjax-template
+See the docstring of ~org-html-mathjax-options~ for all supported
+variables. The MathJax template can be configure via
+~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 dvipng program, dvisvgm or
+ImageMagick suite is available on your system. You can still get this
+processing with
+
+: #+OPTIONS: tex:dvipng
+
+: #+OPTIONS: tex:dvisvgm
+
+#+texinfo: @noindent
+or
+
+: #+OPTIONS: tex:imagemagick
+
+*** Text areas in HTML export
+:PROPERTIES:
+:DESCRIPTION: An alternate way to show an example.
+:END:
+
+#+cindex: text areas, in HTML
+Before Org mode's Babel, one popular approach to publishing code in
+HTML was by using =: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
+=#+ATTR_HTML= line as shown in the example below with the =:textarea=
+option. This must be followed by either an example or a source code
+block. Other Org block types do not honor the =:textarea= option.
+
+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 =:width= and =:height= options on the =#+ATTR_HTML=
+line.
+
+#+begin_example
+,#+ATTR_HTML: :textarea t :width 40
+,#+BEGIN_EXAMPLE
+ (defun org-xor (a b)
+ "Exclusive or."
+ (if a (not b) b))
+,#+END_EXAMPLE
+#+end_example
+
+*** CSS support
+:PROPERTIES:
+:DESCRIPTION: Changing the appearance of the output.
+:END:
+#+cindex: CSS, for HTML export
+#+cindex: HTML export, CSS
+
+#+vindex: org-export-html-todo-kwd-class-prefix
+#+vindex: org-export-html-tag-class-prefix
+You can modify the CSS style definitions for the exported file. The
+HTML exporter assigns the following special CSS classes[fn:132] to
+appropriate parts of the document---your style specifications may
+change these, in addition to any of the standard classes like for
+headlines, tables, etc.
+
+| ~p.author~ | author information, including email |
+| ~p.date~ | publishing date |
+| ~p.creator~ | creator info, about org mode version |
+| ~.title~ | document title |
+| ~.subtitle~ | document subtitle |
+| ~.todo~ | TODO keywords, all not-done states |
+| ~.done~ | the DONE keywords, all states that count as done |
+| ~.WAITING~ | each TODO keyword also uses a class named after itself |
+| ~.timestamp~ | timestamp |
+| ~.timestamp-kwd~ | keyword associated with a timestamp, like =SCHEDULED= |
+| ~.timestamp-wrapper~ | span around keyword plus timestamp |
+| ~.tag~ | tag in a headline |
+| ~._HOME~ | each tag uses itself as a class, "@" replaced by "_" |
+| ~.target~ | target for links |
+| ~.linenr~ | the line number in a code example |
+| ~.code-highlighted~ | for highlighting referenced code lines |
+| ~div.outline-N~ | div for outline level N (headline plus text) |
+| ~div.outline-text-N~ | extra div for text at outline level N |
+| ~.section-number-N~ | section number in headlines, different for each level |
+| ~.figure-number~ | label like "Figure 1:" |
+| ~.table-number~ | label like "Table 1:" |
+| ~.listing-number~ | label like "Listing 1:" |
+| ~div.figure~ | how to format an in-lined image |
+| ~pre.src~ | formatted source code |
+| ~pre.example~ | normal example |
+| ~p.verse~ | verse paragraph |
+| ~div.footnotes~ | footnote section headline |
+| ~p.footnote~ | footnote definition paragraph, containing a footnote |
+| ~.footref~ | a footnote reference number (always a <sup>) |
+| ~.footnum~ | footnote number in footnote definition (always <sup>) |
+| ~.org-svg~ | default class for a linked =.svg= image |
+
+#+vindex: org-html-style-default
+#+vindex: org-html-head
+#+vindex: org-html-head-extra
+#+cindex: @samp{HTML_INCLUDE_STYLE}, keyword
+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: @samp{HTML_HEAD}, keyword
+#+cindex: @samp{HTML_HEAD_EXTRA}, keyword
+#+begin_example
+,#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="style1.css" />
+,#+HTML_HEAD_EXTRA: <link rel="alternate stylesheet" type="text/css" href="style2.css" />
+#+end_example
+
+#+vindex: org-html-head-include-default-style
+To just turn off the default style, customize
+~org-html-head-include-default-style~ variable, or use this option
+line in the Org file.
+
+#+cindex: @samp{html-style}, @samp{OPTIONS} item
+: #+OPTIONS: html-style:nil
+
+For longer style definitions, either use several =HTML_HEAD= and
+=HTML_HEAD_EXTRA= keywords, or use ~<style> ... </style>~ blocks
+around them. Both of these approaches can avoid referring to an
+external file.
+
+#+cindex: @samp{HTML_CONTAINER_CLASS}, property
+#+cindex: @samp{HTML_HEADLINE_CLASS}, property
+In order to add styles to a sub-tree, use the =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 =CUSTOM_ID= property. You can also assign a specific class to
+a headline with the =HTML_HEADLINE_CLASS= property.
+
+Never change the ~org-html-style-default~ constant. Instead use other
+simpler ways of customizing as described above.
+
+*** JavaScript supported display of web pages
+:PROPERTIES:
+:DESCRIPTION: Info and folding in a web browser.
+:ALT_TITLE: JavaScript support
+:END:
+
+Sebastian Rose has written a JavaScript program especially designed to
+allow two different ways of viewing HTML files created with Org. One
+is an /Info/-like mode where each section is displayed separately and
+navigation can be done with the {{{kbd(n)}}} and {{{kbd(p)}}} keys, and some other
+keys as well, press {{{kbd(?)}}} for an overview of the available keys. The
+second one has a /folding/ view, much like Org provides inside Emacs.
+The script is available at https://orgmode.org/org-info.js and the
+documentation at https://orgmode.org/worg/code/org-info-js/. The
+script is hosted on https://orgmode.org, but for reliability, prefer
+installing it on your own web server.
+
+To use this program, just add this line to the Org file:
+
+#+cindex: @samp{INFOJS_OPT}, keyword
+: #+INFOJS_OPT: view:info toc:nil
+
+#+texinfo: @noindent
+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:
+
+- =path:= ::
+
+ The path to the script. The default is to grab the script from
+ [[https://orgmode.org/org-info.js]], but you might want to have a local
+ copy and use a path like =../scripts/org-info.js=.
+
+- =view:= ::
+
+ Initial view when the website is first shown. Possible values are:
+
+ | =info= | Info-like interface with one section per page |
+ | =overview= | Folding interface, initially showing only top-level |
+ | =content= | Folding interface, starting with all headlines visible |
+ | =showall= | Folding interface, all headlines and text visible |
+
+- =sdepth:= ::
+
+ Maximum headline level still considered as an independent section
+ for info and folding modes. The default is taken from
+ ~org-export-headline-levels~, i.e., the =H= switch in =OPTIONS=. If
+ this is smaller than in ~org-export-headline-levels~, each
+ info/folding section can still contain child headlines.
+
+- =toc:= ::
+
+ Should the table of contents /initially/ be visible? Even when
+ =nil=, you can always get to the "toc" with {{{kbd(i)}}}.
+
+- =tdepth:= ::
+
+ The depth of the table of contents. The defaults are taken from the
+ variables ~org-export-headline-levels~ and ~org-export-with-toc~.
+
+- =ftoc:= ::
+
+ Does the CSS of the page specify a fixed position for the "toc"? If
+ yes, the toc is displayed as a section.
+
+- =ltoc:= ::
+
+ Should there be short contents (children) in each section? Make
+ this =above= if the section should be above initial text.
+
+- =mouse:= ::
+
+ Headings are highlighted when the mouse is over them. Should be
+ =underline= (default) or a background color like =#cccccc=.
+
+- =buttons:= ::
+
+ Should view-toggle buttons be everywhere? When =nil= (the default),
+ only one such button is present.
+
+#+vindex: org-infojs-options
+#+vindex: org-export-html-use-infojs
+You can choose default values for these options by customizing the
+variable ~org-infojs-options~. If you always want to apply the script
+to your pages, configure the variable ~org-export-html-use-infojs~.
+
+** LaTeX Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to @LaTeX{} and processing to PDF.
+:END:
+#+cindex: @LaTeX{} export
+#+cindex: PDF export
+
+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
+~org-latex-compiler~; for build sequences, see
+~org-latex-pdf-process~; for packages, see
+~org-latex-default-packages-alist~ and ~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.
+
+*** LaTeX/PDF export commands
+:PROPERTIES:
+:DESCRIPTION: For producing @LaTeX{} and PDF documents.
+:END:
+
+- {{{kbd(C-c C-e l l)}}} (~org-latex-export-to-latex~) ::
+
+ #+kindex: C-c C-e l l
+ #+findex: org-latex-export-to-latex~
+ Export to a LaTeX file with a =.tex= extension. For =myfile.org=,
+ Org exports to =myfile.tex=, overwriting without warning.
+
+- {{{kbd(C-c C-e l L)}}} (~org-latex-export-as-latex~) ::
+
+ #+kindex: C-c C-e l L
+ #+findex: org-latex-export-as-latex
+ Export to a temporary buffer. Do not create a file.
+
+- {{{kbd(C-c C-e l p)}}} (~org-latex-export-to-pdf~) ::
+
+ #+kindex: C-c C-e l p
+ #+findex: org-latex-export-to-pdf
+ Export as LaTeX file and convert it to PDF file.
+
+- {{{kbd(C-c C-e l o)}}} ::
+
+ #+kindex: C-c C-e l o
+ Export as LaTeX file and convert it to PDF, then open the PDF using
+ the default viewer.
+
+- {{{kbd(M-x org-export-region-as-latex)}}} ::
+
+ Convert the region to LaTeX under the assumption that it was in Org
+ mode syntax before. This is a global command that can be invoked in
+ any buffer.
+
+#+vindex: org-latex-compiler
+#+vindex: org-latex-bibtex-compiler
+#+vindex: org-latex-default-packages-alist
+#+cindex: pdflatex
+#+cindex: xelatex
+#+cindex: lualatex
+#+cindex: @samp{LATEX_COMPILER}, keyword
+The LaTeX export back-end can use any of these LaTeX engines:
+=pdflatex=, =xelatex=, and =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
+~org-latex-compiler~ variable or the =#+LATEX_COMPILER= keyword in the
+Org file. See the docstring for the
+~org-latex-default-packages-alist~ for loading packages with certain
+compilers. Also see ~org-latex-bibtex-compiler~ to set the
+bibliography compiler[fn:133].
+
+*** LaTeX specific export settings
+:PROPERTIES:
+:DESCRIPTION: Unique to this @LaTeX{} back-end.
+:END:
+
+The LaTeX export back-end has several additional keywords for
+customizing LaTeX output. Setting these keywords works similar to the
+general options (see [[*Export Settings]]).
+
+#+attr_texinfo: :sep ,
+- =DESCRIPTION= ::
+ #+cindex: @samp{DESCRIPTION}, keyword
+ #+vindex: org-latex-hyperref-template
+ #+vindex: org-latex-title-command
+ The document's description. The description along with author name,
+ keywords, and related file metadata are inserted in the output file
+ by the hyperref package. See ~org-latex-hyperref-template~ for
+ customizing metadata items. See ~org-latex-title-command~ for
+ typesetting description into the document's front matter. Use
+ multiple =DESCRIPTION= keywords for long descriptions.
+
+- =LANGUAGE= ::
+ #+cindex: @samp{LANGUAGE}, keyword
+ #+vindex: org-latex-packages-alist
+ In order to be effective, the =babel= or =polyglossia=
+ packages---according to the LaTeX compiler used---must be loaded
+ with the appropriate language as argument. This can be accomplished
+ by modifying the ~org-latex-packages-alist~ variable, e.g., with the
+ following snippet:
+
+ #+begin_src emacs-lisp
+ (add-to-list 'org-latex-packages-alist
+ '("AUTO" "babel" t ("pdflatex")))
+ (add-to-list 'org-latex-packages-alist
+ '("AUTO" "polyglossia" t ("xelatex" "lualatex")))
+ #+end_src
+
+- =LATEX_CLASS= ::
+
+ #+cindex: @samp{LATEX_CLASS}, keyword
+ #+vindex: org-latex-default-class
+ #+vindex: org-latex-classes
+ This is LaTeX document class, such as /article/, /report/, /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 ~org-latex-default-class~ variable.
+ Org has /article/ as the default class. A valid default class must
+ be an element of ~org-latex-classes~.
+
+- =LATEX_CLASS_OPTIONS= ::
+
+ #+cindex: @samp{LATEX_CLASS_OPTIONS}, keyword
+ Options the LaTeX export back-end uses when calling the LaTeX
+ document class.
+
+- =LATEX_COMPILER= ::
+
+ #+cindex: @samp{LATEX_COMPILER}, keyword
+ #+vindex: org-latex-compiler
+ The compiler, such as =pdflatex=, =xelatex=, =lualatex=, for
+ producing the PDF. See ~org-latex-compiler~.
+
+- =LATEX_HEADER=, =LATEX_HEADER_EXTRA= ::
+
+ #+cindex: @samp{LATEX_HEADER}, keyword
+ #+cindex: @samp{LATEX_HEADER_EXTRA}, keyword
+ #+vindex: org-latex-classes
+ Arbitrary lines to add to the document's preamble, before the
+ hyperref settings. See ~org-latex-classes~ for adjusting the
+ structure and order of the LaTeX headers.
+
+- =KEYWORDS= ::
+
+ #+cindex: @samp{KEYWORDS}, keyword
+ #+vindex: org-latex-hyperref-template
+ #+vindex: org-latex-title-command
+ The keywords for the document. The description along with author
+ name, keywords, and related file metadata are inserted in the output
+ file by the hyperref package. See ~org-latex-hyperref-template~ for
+ customizing metadata items. See ~org-latex-title-command~ for
+ typesetting description into the document's front matter. Use
+ multiple =KEYWORDS= lines if necessary.
+
+- =SUBTITLE= ::
+
+ #+cindex: @samp{SUBTITLE}, keyword
+ #+vindex: org-latex-subtitle-separate
+ #+vindex: org-latex-subtitle-format
+ The document's subtitle. It is typeset as per
+ ~org-latex-subtitle-format~. If ~org-latex-subtitle-separate~ is
+ non-~nil~, it is typed outside of the ~\title~ macro. See
+ ~org-latex-hyperref-template~ for customizing metadata items. See
+ ~org-latex-title-command~ for typesetting description into the
+ document's front matter.
+
+The following sections have further details.
+
+*** LaTeX header and sectioning structure
+:PROPERTIES:
+:DESCRIPTION: Setting up the export file structure.
+:ALT_TITLE: LaTeX header and sectioning
+:END:
+#+cindex: @LaTeX{} class
+#+cindex: @LaTeX{} sectioning structure
+#+cindex: @LaTeX{} header
+#+cindex: header, for @LaTeX{} files
+#+cindex: sectioning structure, for @LaTeX{} export
+
+The LaTeX export back-end converts the first three of Org's outline
+levels into LaTeX headlines. The remaining Org levels are exported as
+lists. To change this globally for the cut-off point between levels
+and lists, (see [[*Export Settings]]).
+
+By default, the LaTeX export back-end uses the /article/ class.
+
+#+vindex: org-latex-default-class
+#+vindex: org-latex-classes
+#+vindex: org-latex-default-packages-alist
+#+vindex: org-latex-packages-alist
+To change the default class globally, edit ~org-latex-default-class~.
+To change the default class locally in an Org file, add option lines
+=#+LATEX_CLASS: myclass=. To change the default class for just a part
+of the Org file, set a sub-tree property, =EXPORT_LATEX_CLASS=. The
+class name entered here must be valid member of ~org-latex-classes~.
+This variable defines a header template for each class into which the
+exporter splices the values of ~org-latex-default-packages-alist~ and
+~org-latex-packages-alist~. Use the same three variables to define
+custom sectioning or custom classes.
+
+#+cindex: @samp{LATEX_CLASS}, keyword
+#+cindex: @samp{LATEX_CLASS_OPTIONS}, keyword
+#+cindex: @samp{EXPORT_LATEX_CLASS}, property
+#+cindex: @samp{EXPORT_LATEX_CLASS_OPTIONS}, property
+The LaTeX export back-end sends the =LATEX_CLASS_OPTIONS= keyword and
+=EXPORT_LATEX_CLASS_OPTIONS= property as options to the LaTeX
+~\documentclass~ macro. The options and the syntax for specifying
+them, including enclosing them in square brackets, follow LaTeX
+conventions.
+
+: #+LATEX_CLASS_OPTIONS: [a4paper,11pt,twoside,twocolumn]
+
+#+cindex: @samp{LATEX_HEADER}, keyword
+#+cindex: @samp{LATEX_HEADER_EXTRA}, keyword
+The LaTeX export back-end appends values from =LATEX_HEADER= and
+=LATEX_HEADER_EXTRA= keywords to the LaTeX header. The docstring for
+~org-latex-classes~ explains in more detail. Also note that LaTeX
+export back-end does not append =LATEX_HEADER_EXTRA= to the header
+when previewing LaTeX snippets (see [[*Previewing LaTeX fragments]]).
+
+A sample Org file with the above headers:
+
+#+begin_example
+,#+LATEX_CLASS: article
+,#+LATEX_CLASS_OPTIONS: [a4paper]
+,#+LATEX_HEADER: \usepackage{xyz}
+
+,* Headline 1
+ some text
+,* Headline 2
+ some more text
+#+end_example
+
+*** Quoting LaTeX code
+:PROPERTIES:
+:DESCRIPTION: Incorporating literal @LaTeX{} code.
+:END:
+
+The LaTeX export back-end can insert any arbitrary LaTeX code, see
+[[*Embedded LaTeX]]. There are three ways to embed such code in the Org
+file and they all use different quoting syntax.
+
+#+cindex: inline, in @LaTeX{} export
+Inserting in-line quoted with @ symbols:
+
+: Code embedded in-line @@latex:any arbitrary LaTeX code@@ in a paragraph.
+
+#+cindex: @samp{LATEX}, keyword
+Inserting as one or more keyword lines in the Org file:
+
+: #+LATEX: any arbitrary LaTeX code
+
+#+cindex: @samp{BEGIN_EXPORT latex}
+Inserting as an export block in the Org file, where the back-end
+exports any code between begin and end markers:
+
+#+begin_example
+,#+BEGIN_EXPORT latex
+ any arbitrary LaTeX code
+,#+END_EXPORT
+#+end_example
+
+*** Tables in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Options for exporting tables to @LaTeX{}.
+:END:
+#+cindex: tables, in @LaTeX{} export
+
+The LaTeX export back-end can pass several LaTeX attributes for table
+contents and layout. Besides specifying a label (see [[*Internal Links]])
+and a caption (see [[*Captions]]), the other valid LaTeX attributes
+include:
+
+#+attr_texinfo: :sep ,
+- =:mode= ::
+
+ #+vindex: 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
+ =table=, =math=, =inline-math= or =verbatim=.
+
+ For =math= or =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
+ ~org-latex-default-table-mode~. The LaTeX export back-end merges
+ contiguous tables in the same mode into a single environment.
+
+- =:environment= ::
+
+ #+vindex: org-latex-default-table-environment
+ 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: tabularx, longtable,
+ array, tabu, and bmatrix. For packages, such as tabularx and tabu,
+ or any newer replacements, include them in the
+ ~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 ~org-latex-packages-alist~
+ variable for configuring these packages for LaTeX snippet previews,
+ if any.
+
+- =:caption= ::
+
+ Use =CAPTION= keyword to set a simple caption for a table (see
+ [[*Captions]]). For custom captions, use =:caption= attribute, which
+ accepts raw LaTeX code. =:caption= value overrides =CAPTION= value.
+
+- =:float=, =:placement= ::
+
+ The table environments by default are not floats in LaTeX. To make
+ them floating objects use =:float= with one of the following
+ options: =sideways=, =multicolumn=, =t=, and =nil=.
+
+ LaTeX floats can also have additional layout =:placement=
+ attributes. These are the usual =[h t b p ! H]= permissions
+ specified in square brackets. Note that for =:float sideways=
+ tables, the LaTeX export back-end ignores =:placement= attributes.
+
+- =:align=, =:font=, =:width= ::
+
+ The LaTeX export back-end uses these attributes for regular tables
+ to set their alignments, fonts, and widths.
+
+- =:spread= ::
+
+ When =:spread= is non-~nil~, the LaTeX export back-end spreads or
+ shrinks the table by the =:width= for tabu and longtabu
+ environments. =:spread= has no effect if =:width= is not set.
+
+- =:booktabs=, =:center=, =:rmlines= ::
+
+ #+vindex: org-latex-tables-booktabs
+ #+vindex: org-latex-tables-centered
+ All three commands are toggles. =:booktabs= brings in modern
+ typesetting enhancements to regular tables. The booktabs package
+ has to be loaded through ~org-latex-packages-alist~. =:center= is
+ for centering the table. =:rmlines= removes all but the very first
+ horizontal line made of ASCII characters from "table.el" tables
+ only.
+
+- =:math-prefix=, =:math-suffix=, =:math-arguments= ::
+
+ The LaTeX export back-end inserts =:math-prefix= string value in
+ a math environment before the table. The LaTeX export back-end
+ inserts =:math-suffix= string value in a math environment after the
+ table. The LaTeX export back-end inserts =:math-arguments= string
+ value between the macro name and the table's contents.
+ =:math-arguments= comes in use for matrix macros that require more
+ than one argument, such as =qbordermatrix=.
+
+LaTeX table attributes help formatting tables for a wide range of
+situations, such as matrix product or spanning multiple pages:
+
+#+begin_example
+,#+ATTR_LATEX: :environment longtable :align l|lp{3cm}r|l
+| ... | ... |
+| ... | ... |
+
+,#+ATTR_LATEX: :mode math :environment bmatrix :math-suffix \times
+| a | b |
+| c | d |
+,#+ATTR_LATEX: :mode math :environment bmatrix
+| 1 | 2 |
+| 3 | 4 |
+#+end_example
+
+Set the caption with the LaTeX command
+=\bicaption{HeadingA}{HeadingB}=:
+
+#+begin_example
+,#+ATTR_LATEX: :caption \bicaption{HeadingA}{HeadingB}
+| ... | ... |
+| ... | ... |
+#+end_example
+
+*** Images in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: How to insert figures into @LaTeX{} output.
+:END:
+#+cindex: images, inline in LaTeX
+#+cindex: inlining images in LaTeX
+#+cindex: @samp{ATTR_LATEX}, keyword
+
+The LaTeX export back-end processes image links in Org files that do
+not have descriptions, such as these links =[[file:img.jpg]]= or
+=[[./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 =\includegraphics= macro to
+insert the image. But for TikZ (http://sourceforge.net/projects/pgf/)
+images, the back-end uses an ~\input~ macro wrapped within
+a ~tikzpicture~ environment.
+
+For specifying image =:width=, =:height=, =:scale= and other =:options=,
+use this syntax:
+
+#+begin_example
+,#+ATTR_LATEX: :width 5cm :options angle=90
+[[./img/sed-hr4049.pdf]]
+#+end_example
+
+A =:scale= attribute overrides both =:width= and =:height= attributes.
+
+For custom commands for captions, use the =:caption= attribute. It
+overrides the default =#+CAPTION= value:
+
+#+begin_example
+,#+ATTR_LATEX: :caption \bicaption{HeadingA}{HeadingB}
+[[./img/sed-hr4049.pdf]]
+#+end_example
+
+When captions follow the method as described in [[*Captions]], the LaTeX
+export back-end wraps the picture in a floating =figure= environment.
+To float an image without specifying a caption, set the =:float=
+attribute to one of the following:
+
+- =t= ::
+
+ For a standard =figure= environment; used by default whenever an
+ image has a caption.
+
+- =multicolumn= ::
+
+ To span the image across multiple columns of a page; the back-end
+ wraps the image in a =figure*= environment.
+
+- =wrap= ::
+
+ For text to flow around the image on the right; the figure occupies
+ the left half of the page.
+
+- =sideways= ::
+
+ For a new page with the image sideways, rotated ninety degrees, in
+ a =sidewaysfigure= environment; overrides =:placement= setting.
+
+- =nil= ::
+
+ To avoid a =:float= even if using a caption.
+
+Use the =placement= attribute to modify a floating environment's
+placement.
+
+#+begin_example
+,#+ATTR_LATEX: :float wrap :width 0.38\textwidth :placement {r}{0.4\textwidth}
+[[./img/hst.png]]
+#+end_example
+
+#+vindex: org-latex-images-centered
+#+cindex: center image in LaTeX export
+#+cindex: image, centering in LaTeX export
+The LaTeX export back-end centers all images by default. Setting
+=:center= to =nil= disables centering. To disable centering globally,
+set ~org-latex-images-centered~ to =t=.
+
+Set the =:comment-include= attribute to non-~nil~ value for the LaTeX
+export back-end to comment out the =\includegraphics= macro.
+
+*** Plain lists in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to lists.
+:END:
+
+#+cindex: plain lists, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+The LaTeX export back-end accepts the =environment= and =options=
+attributes for plain lists. Both attributes work together for
+customizing lists, as shown in the examples:
+
+#+begin_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
+
+Since LaTeX supports only four levels of nesting for lists, use an
+external package, such as =enumitem= in LaTeX, for levels deeper than
+four:
+
+#+begin_example
+,#+LATEX_HEADER: \usepackage{enumitem}
+,#+LATEX_HEADER: \renewlist{itemize}{itemize}{9}
+,#+LATEX_HEADER: \setlist[itemize]{label=$\circ$}
+- One
+ - Two
+ - Three
+ - Four
+ - Five
+#+end_example
+
+*** Source blocks in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to source code blocks.
+:END:
+#+cindex: source blocks, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+
+The LaTeX export back-end can make source code blocks into floating
+objects through the attributes =:float= and =:options=. For =:float=:
+
+- =t= ::
+
+ Makes a source block float; by default floats any source block with
+ a caption.
+
+- =multicolumn= ::
+
+ Spans the source block across multiple columns of a page.
+
+- =nil= ::
+
+ Avoids a =:float= even if using a caption; useful for source code
+ blocks that may not fit on a page.
+
+#+begin_example
+,#+ATTR_LATEX: :float nil
+,#+BEGIN_SRC emacs-lisp
+ 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 =:options= to LaTeX
+packages for customization of that specific source block. In the
+example below, the =:options= are set for Minted. Minted is a source
+code highlighting LaTeX package with many configurable options.
+
+#+begin_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
+
+To apply similar configuration options for all source blocks in
+a file, use the ~org-latex-listings-options~ and
+~org-latex-minted-options~ variables.
+
+*** Example blocks in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to example blocks.
+:END:
+#+cindex: example blocks, in @LaTeX{} export
+#+cindex: verbatim blocks, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+
+The LaTeX export back-end wraps the contents of example blocks in
+a =verbatim= environment. To change this behavior to use another
+environment globally, specify an appropriate export filter (see
+[[*Advanced Export Configuration]]). To change this behavior to use
+another environment for each block, use the =:environment= parameter
+to specify a custom environment.
+
+#+begin_example
+,#+ATTR_LATEX: :environment myverbatim
+,#+BEGIN_EXAMPLE
+ This sentence is false.
+,#+END_EXAMPLE
+#+end_example
+
+*** Special blocks in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to special blocks.
+:END:
+
+#+cindex: special blocks, in @LaTeX{} export
+#+cindex: abstract, in @LaTeX{} export
+#+cindex: proof, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+
+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
+=:options=, if any, and appends as-is to that environment's opening
+string. For example:
+
+#+begin_example
+,#+BEGIN_abstract
+ We demonstrate how to solve the Syracuse problem.
+,#+END_abstract
+
+,#+ATTR_LATEX: :options [Proof of important theorem]
+,#+BEGIN_proof
+ ...
+ Therefore, any even number greater than 2 is the sum of two primes.
+,#+END_proof
+#+end_example
+
+#+texinfo: @noindent
+exports to
+
+#+begin_example
+\begin{abstract}
+ We demonstrate how to solve the Syracuse problem.
+\end{abstract}
+
+\begin{proof}[Proof of important theorem]
+ ...
+ Therefore, any even number greater than 2 is the sum of two primes.
+\end{proof}
+#+end_example
+
+If you need to insert a specific caption command, use =:caption=
+attribute. It overrides standard =CAPTION= value, if any. For
+example:
+
+#+begin_example
+,#+ATTR_LATEX: :caption \MyCaption{HeadingA}
+,#+BEGIN_proof
+ ...
+,#+END_proof
+#+end_example
+
+*** Horizontal rules in LaTeX export
+:PROPERTIES:
+:DESCRIPTION: Attributes specific to horizontal rules.
+:END:
+#+cindex: horizontal rules, in @LaTeX{} export
+#+cindex: @samp{ATTR_LATEX}, keyword
+
+The LaTeX export back-end converts horizontal rules by the specified
+=:width= and =:thickness= attributes. For example:
+
+#+begin_example
+,#+ATTR_LATEX: :width .6\textwidth :thickness 0.8pt
+-----
+#+end_example
+
+** Markdown Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to Markdown.
+:END:
+#+cindex: Markdown export
+
+The Markdown export back-end, "md", converts an Org file to Markdown
+format, as defined at http://daringfireball.net/projects/markdown/.
+
+Since it is built on top of the HTML back-end (see [[*HTML Export]]), it
+converts every Org construct not defined in Markdown syntax, such as
+tables, to HTML.
+
+*** Markdown export commands
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c C-e m m)}}} (~org-md-export-to-markdown~) ::
+
+ #+kindex: C-c C-c m m
+ #+findex: org-md-export-to-markdown
+ Export to a text file with Markdown syntax. For =myfile.org=, Org
+ exports to =myfile.md=, overwritten without warning.
+
+- {{{kbd(C-c C-e m M)}}} (~org-md-export-as-markdown~) ::
+
+ #+kindex: C-c C-c m M
+ #+findex: org-md-export-as-markdown
+ Export to a temporary buffer. Does not create a file.
+
+- {{{kbd(C-c C-e m o)}}} ::
+
+ #+kindex: C-c C-e m o
+ Export as a text file with Markdown syntax, then open it.
+
+*** Header and sectioning structure
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+vindex: org-md-headline-style
+Based on ~org-md-headline-style~, Markdown export can generate
+headlines of both /atx/ and /setext/ types. /atx/ limits headline
+levels to two whereas /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 (see [[*Export Settings]]).
+
+** OpenDocument Text Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to OpenDocument Text.
+:END:
+#+cindex: ODT
+#+cindex: OpenDocument
+#+cindex: export, OpenDocument
+#+cindex: LibreOffice
+
+The ODT export back-end handles creating of OpenDocument Text (ODT)
+format. Documents created by this exporter use the
+{{{cite(OpenDocument-v1.2 specification)}}}[fn:134] and are compatible
+with LibreOffice 3.4.
+
+*** Pre-requisites for ODT export
+:PROPERTIES:
+:DESCRIPTION: Required packages.
+:END:
+#+cindex: zip
+
+The ODT export back-end relies on the zip program to create the final
+compressed ODT output. Check if =zip= is locally available and
+executable. Without it, export cannot finish.
+
+*** ODT export commands
+:PROPERTIES:
+:DESCRIPTION: Invoking export.
+:END:
+
+- {{{kbd(C-c C-e o o)}}} (~org-export-to-odt~) ::
+
+ #+kindex: C-c C-e o o
+ #+findex: org-export-to-odt
+ Export as OpenDocument Text file.
+
+ #+cindex: @samp{EXPORT_FILE_NAME}, property
+ #+vindex: org-odt-preferred-output-format
+
+ If ~org-odt-preferred-output-format~ is specified, the ODT export
+ back-end automatically converts the exported file to that format.
+
+ For =myfile.org=, Org exports to =myfile.odt=, overwriting without
+ warning. The ODT export back-end exports a region only if a region
+ was active.
+
+ 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 =EXPORT_FILE_NAME= property, the ODT export back-end
+ uses that for file name.
+
+- {{{kbd(C-c C-e o O)}}} ::
+
+ #+kindex: C-c C-e o O
+ Export as an OpenDocument Text file and open the resulting file.
+
+ #+vindex: org-export-odt-preferred-output-format
+ If ~org-export-odt-preferred-output-format~ is specified, open the
+ converted file instead. See [[*Automatically exporting to other
+ formats]].
+
+*** ODT specific export settings
+:PROPERTIES:
+:DESCRIPTION: Configuration options.
+:END:
+
+The ODT export back-end has several additional keywords for
+customizing ODT output. Setting these keywords works similar to the
+general options (see [[*Export Settings]]).
+
+- =DESCRIPTION= ::
+
+ #+cindex: @samp{DESCRIPTION}, keyword
+ This is the document's description, which the ODT export back-end
+ inserts as document metadata. For long descriptions, use multiple
+ lines, prefixed with =DESCRIPTION=.
+
+- =KEYWORDS= ::
+
+ #+cindex: @samp{KEYWORDS}, keyword
+ 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 =KEYWORDS= if
+ necessary.
+
+- =ODT_STYLES_FILE= ::
+
+ #+cindex: @samp{ODT_STYLES_FILE}, keyword
+ #+vindex: org-odt-styles-file
+ The ODT export back-end uses the ~org-odt-styles-file~ by default.
+ See [[*Applying custom styles]] for details.
+
+- =SUBTITLE= ::
+
+ #+cindex: @samp{SUBTITLE}, keyword
+ The document subtitle.
+
+*** Extending ODT export
+:PROPERTIES:
+:DESCRIPTION: Producing DOC, PDF files.
+:END:
+
+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 =doc=, or
+convert a document from one format, say =csv=, to another format, say
+=xls=.
+
+#+cindex: @file{unoconv}
+#+vindex: org-odt-convert-process
+Customize ~org-odt-convert-process~ variable to point to =unoconv=,
+which is the ODT's preferred converter. Working installations of
+LibreOffice would already have =unoconv= installed. Alternatively,
+other converters may be substituted here. See [[*Configuring
+a document converter]].
+
+**** Automatically exporting to other formats
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+vindex: org-odt-preferred-output-format
+If ODT format is just an intermediate step to get to other formats,
+such as =doc=, =docx=, =rtf=, or =pdf=, etc., then extend the ODT
+export back-end to directly produce that format. Specify the final
+format in the ~org-odt-preferred-output-format~ variable. This is one
+way to extend (see [[*ODT export commands]]).
+
+**** Converting between document formats
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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:
+
+- {{{kbd(M-x org-odt-convert)}}} ::
+
+ #+findex: org-odt-convert
+ Convert an existing document from one format to another. With
+ a prefix argument, opens the newly produced file.
+
+*** Applying custom styles
+:PROPERTIES:
+:DESCRIPTION: Styling the output.
+:END:
+#+cindex: styles, custom
+#+cindex: template, custom
+
+The ODT export back-end comes with many OpenDocument styles (see
+[[*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.
+
+**** Applying custom styles: the easy way
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+1. Create a sample =example.org= file with settings as shown below,
+ and export it to ODT format.
+
+ : #+OPTIONS: H:10 num:t
+
+2. Open the above =example.odt= using LibreOffice. Use the /Stylist/
+ to locate the target styles, which typically have the "Org" prefix.
+ Open one, modify, and save as either OpenDocument Text (ODT) or
+ OpenDocument Template (OTT) file.
+
+3.
+ #+vindex: org-odt-styles-file
+ Customize the variable ~org-odt-styles-file~ and point it to the
+ newly created file. For additional configuration options, see
+ [[x-overriding-factory-styles][Overriding factory styles]].
+
+ #+cindex: @samp{ODT_STYLES_FILE}, keyword
+ To apply an ODT style to a particular file, use the
+ =ODT_STYLES_FILE= keyword as shown in the example below:
+
+ : #+ODT_STYLES_FILE: "/path/to/example.ott"
+
+ #+texinfo: @noindent
+ or
+
+ : #+ODT_STYLES_FILE: ("/path/to/file.ott" ("styles.xml" "image/hdr.png"))
+
+**** Using third-party styles and templates
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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.
+
+*** Links in ODT export
+:PROPERTIES:
+:DESCRIPTION: Handling and formatting links.
+:END:
+#+cindex: links, in ODT export
+
+ODT exporter creates native cross-references for internal links. It
+creates Internet-style links for all other links.
+
+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 =\ref{label}=-style reference to an image, table etc., is replaced
+with a cross-reference and sequence number of the labeled entity. See
+[[*Labels and captions in ODT export]].
+
+*** Tables in ODT export
+:PROPERTIES:
+:DESCRIPTION: Org tables conversions.
+:END:
+
+#+cindex: tables, in ODT export
+
+The ODT export back-end handles native Org mode tables (see [[*Tables]])
+and simple =table.el= tables. Complex =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
+(see [[*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 (see [[*Column Width and Alignment]]).
+
+Note that the ODT export back-end interprets column widths as weighted
+ratios, the default weight being 1.
+
+#+cindex: @samp{ATTR_ODT}, keyword
+Specifying =:rel-width= property on an =ATTR_ODT= line controls the
+width of the table. For example:
+
+#+begin_example
+,#+ATTR_ODT: :rel-width 50
+| Area/Month | Jan | Feb | Mar | Sum |
+|---------------+-------+-------+-------+-------|
+| / | < | | | < |
+| <l13> | <r5> | <r5> | <r5> | <r6> |
+| North America | 1 | 21 | 926 | 948 |
+| Middle East | 6 | 75 | 844 | 925 |
+| Asia Pacific | 9 | 27 | 790 | 826 |
+|---------------+-------+-------+-------+-------|
+| Sum | 16 | 123 | 2560 | 2699 |
+#+end_example
+
+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.
+
+For even more customization, create custom table styles and associate
+them with a table using the =ATTR_ODT= keyword. See [[*Customizing
+tables in ODT export]].
+
+*** Images in ODT export
+:PROPERTIES:
+:DESCRIPTION: Inserting images.
+:END:
+#+cindex: images, embedding in ODT
+#+cindex: embedding images in ODT
+
+**** Embedding images
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+The ODT export back-end processes image links in Org files that do not
+have descriptions, such as these links =[[file:img.jpg]]= or =[[./img.jpg]]=,
+as direct image insertions in the final output. Either of these
+examples works:
+
+: [[file:img.png]]
+
+: [[./img.png]]
+
+**** Embedding clickable images
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+For clickable images, provide a link whose description is another link
+to an image file. For example, to embed an image
+=org-mode-unicorn.png= which when clicked jumps to https://orgmode.org
+website, do the following
+
+: [[https://orgmode.org][./org-mode-unicorn.png]]
+
+**** Sizing and scaling of embedded images
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{ATTR_ODT}, keyword
+
+Control the size and scale of the embedded images with the =ATTR_ODT=
+attribute.
+
+#+cindex: identify, ImageMagick
+#+vindex: org-odt-pixels-per-inch
+The ODT export back-end starts with establishing the size of the image
+in the final document. The dimensions of this size are 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 identify program or Emacs ~create-image~ and
+~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 ~org-odt-pixels-per-inch~ into the familiar 72
+dpi or 96 dpi. The default value for this is in
+~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:
+
+- Explicitly size the image ::
+
+ To embed =img.png= as a 10 cm x 10 cm image, do the following:
+
+ #+begin_example
+ ,#+ATTR_ODT: :width 10 :height 10
+ [[./img.png]]
+ #+end_example
+
+- Scale the image ::
+
+ To embed =img.png= at half its size, do the following:
+
+ #+begin_example
+ ,#+ATTR_ODT: :scale 0.5
+ [[./img.png]]
+ #+end_example
+
+- Scale the image to a specific width ::
+
+ To embed =img.png= with a width of 10 cm while retaining the
+ original height:width ratio, do the following:
+
+ #+begin_example
+ ,#+ATTR_ODT: :width 10
+ [[./img.png]]
+ #+end_example
+
+- Scale the image to a specific height ::
+
+ To embed =img.png= with a height of 10 cm while retaining the
+ original height:width ratio, do the following:
+
+ #+begin_example
+ ,#+ATTR_ODT: :height 10
+ [[./img.png]]
+ #+end_example
+
+**** Anchoring of images
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{ATTR_ODT}, keyword
+The ODT export back-end can anchor images to =as-char=, =paragraph=,
+or =page=. Set the preferred anchor using the =:anchor= property of
+the =ATTR_ODT= line.
+
+To create an image that is anchored to a page:
+
+#+begin_example
+,#+ATTR_ODT: :anchor page
+[[./img.png]]
+#+end_example
+
+*** Math formatting in ODT export
+:PROPERTIES:
+:DESCRIPTION: Formatting @LaTeX{} fragments.
+:END:
+
+The ODT exporter has special support for handling math.
+
+**** LaTeX math snippets
+:PROPERTIES:
+:DESCRIPTION: Embedding in @LaTeX{} format.
+:END:
+
+LaTeX math snippets (see [[*LaTeX fragments]]) can be embedded in the ODT
+document in one of the following ways:
+
+- MathML ::
+
+ #+cindex: MathML
+ Add this line to the Org file. This option is activated on
+ a per-file basis.
+
+ : #+OPTIONS: tex:t
+
+ With this option, LaTeX fragments are first converted into MathML
+ fragments using an external LaTeX-to-MathML converter program. The
+ resulting MathML fragments are then embedded as an OpenDocument
+ Formula in 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 ~org-latex-to-mathml-convert-command~ and
+ ~org-latex-to-mathml-jar-file~.
+
+ If you prefer to use MathToWeb[fn:135] as your converter, you can
+ configure the above variables as shown below.
+
+ #+begin_src emacs-lisp
+ (setq org-latex-to-mathml-convert-command
+ "java -jar %j -unicode -force -df %o %I"
+ org-latex-to-mathml-jar-file
+ "/path/to/mathtoweb.jar")
+ #+end_src
+
+ #+texinfo: @noindent
+ or, to use LaTeX​ML[fn:136] instead,
+
+ #+begin_src emacs-lisp
+ (setq org-latex-to-mathml-convert-command
+ "latexmlmath \"%i\" --presentationmathml=%o")
+ #+end_src
+
+ To quickly verify the reliability of the LaTeX-to-MathML
+ converter, use the following commands:
+
+ - {{{kbd(M-x org-export-as-odf)}}} ::
+
+ Convert a LaTeX math snippet to an OpenDocument formula (=.odf=)
+ file.
+
+ - {{{kbd(M-x org-export-as-odf-and-open)}}} ::
+
+ Convert a LaTeX math snippet to an OpenDocument formula (=.odf=)
+ file and open the formula file with the system-registered
+ application.
+
+- PNG images ::
+
+ #+cindex: dvipng
+ #+cindex: dvisvgm
+ #+cindex: ImageMagick
+ Add this line to the Org file. This option is activated on
+ a per-file basis.
+
+ : #+OPTIONS: tex:dvipng
+
+ : #+OPTIONS: tex:dvisvgm
+
+ #+texinfo: @noindent
+ or
+
+ : #+OPTIONS: tex:imagemagick
+
+ 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 dvipng program, dvisvgm or
+ ImageMagick programs.
+
+**** MathML and OpenDocument formula files
+:PROPERTIES:
+:DESCRIPTION: Embedding in native format.
+:END:
+
+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 (=.mml=) source or its OpenDocument formula (=.odf=) file as
+shown below:
+
+: [[./equation.mml]]
+
+#+texinfo: @noindent
+or
+
+: [[./equation.odf]]
+
+*** Labels and captions in ODT export
+:PROPERTIES:
+:DESCRIPTION: Rendering objects.
+:END:
+
+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.
+
+#+begin_example
+,#+CAPTION: Bell curve
+,#+NAME: fig:SED-HR4049
+[[./img/a.png]]
+#+end_example
+
+When rendered, it may show as follows in the exported document:
+
+: Figure 2: Bell curve
+
+#+vindex: org-odt-category-map-alist
+To modify the category component of the caption, customize the option
+~org-odt-category-map-alist~. For example, to tag embedded images
+with the string "Illustration" instead of the default string "Figure",
+use the following setting:
+
+#+begin_src emacs-lisp
+(setq org-odt-category-map-alist
+ '(("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)))
+#+end_src
+
+With the above modification, the previous example changes to:
+
+: Illustration 2: Bell curve
+
+*** Literal examples in ODT export
+:PROPERTIES:
+:DESCRIPTION: For source code and example blocks.
+:END:
+
+The ODT export back-end supports literal examples (see [[*Literal
+Examples]]) with full fontification. Internally, the ODT export
+back-end relies on =htmlfontify.el= to generate the style definitions
+needed for fancy listings. The auto-generated styles get =OrgSrc=
+prefix and inherit colors from the faces used by Emacs Font Lock
+library for that source language.
+
+#+vindex: org-odt-fontify-srcblocks
+For custom fontification styles, customize the
+~org-odt-create-custom-styles-for-srcblocks~ option.
+
+#+vindex: org-odt-create-custom-styles-for-srcblocks
+To turn off fontification of literal examples, customize the
+~org-odt-fontify-srcblocks~ option.
+
+*** Advanced topics in ODT export
+:PROPERTIES:
+:DESCRIPTION: For power users.
+:END:
+
+The ODT export back-end has extensive features useful for power users
+and frequent uses of ODT formats.
+
+**** Configuring a document converter
+:PROPERTIES:
+:DESCRIPTION: Registering a document converter.
+:UNNUMBERED: notoc
+:END:
+#+cindex: convert
+#+cindex: doc, docx, rtf
+#+cindex: converter
+
+The ODT export back-end works with popular converters with little or
+no extra configuration. See [[*Extending ODT export]]. The following is
+for unsupported converters or tweaking existing defaults.
+
+- Register the converter ::
+
+ #+vindex: org-export-odt-convert-processes
+ Add the name of the converter to the ~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.
+
+- Configure its capabilities ::
+
+ #+vindex: org-export-odt-convert-capabilities
+ Specify which formats the converter can handle by customizing the
+ variable ~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.
+
+- Choose the converter ::
+
+ #+vindex: org-export-odt-convert-process
+ Select the newly added converter as the preferred one by customizing
+ the option ~org-odt-convert-process~.
+
+**** Working with OpenDocument style files
+:PROPERTIES:
+:DESCRIPTION: Exploring internals.
+:UNNUMBERED: notoc
+:END:
+#+cindex: styles, custom
+#+cindex: template, custom
+
+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.
+
+The ODT exporter relies on two files for generating its output. These
+files are bundled with the distribution under the directory pointed to
+by the variable ~org-odt-styles-dir~. The two files are:
+
+- =OrgOdtStyles.xml= <<x-orgodtstyles-xml>> ::
+
+ This file contributes to the =styles.xml= file of the final ODT
+ document. This file gets modified for the following purposes:
+
+ 1. To control outline numbering based on user settings;
+
+ 2. To add styles generated by =htmlfontify.el= for fontification of
+ code blocks.
+
+- =OrgOdtContentTemplate.xml= <<x-orgodtcontenttemplate-xml>> ::
+
+ This file contributes to the =content.xml= file of the final ODT
+ document. The contents of the Org outline are inserted between the
+ =<office:text>= ... =</office:text>= elements of this file.
+
+ Apart from serving as a template file for the final =content.xml=,
+ the file serves the following purposes:
+
+ 1. It contains automatic styles for formatting of tables which are
+ referenced by the exporter;
+
+ 2. It contains =<text:sequence-decl>= ... =</text:sequence-decl>=
+ elements that control numbering of tables, images, equations, and
+ similar entities.
+
+<<x-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.
+
+- ~org-odt-styles-file~ ::
+
+ The ODT export back-end uses the file pointed to by this variable,
+ such as =styles.xml=, for the final output. It can take one of the
+ following values:
+
+ - =FILE.xml= ::
+
+ Use this file instead of the default =styles.xml=
+
+ - =FILE.odt= or =FILE.ott= ::
+
+ Use the =styles.xml= contained in the specified OpenDocument
+ Text or Template file
+
+ - =FILE.odt= or =FILE.ott= and a subset of included files ::
+
+ Use the =styles.xml= contained in the specified OpenDocument Text
+ or Template file. Additionally extract the specified member files
+ and embed those within the final ODT document.
+
+ Use this option if the =styles.xml= file references additional
+ files like header and footer images.
+
+ - ~nil~ ::
+
+ Use the default =styles.xml=.
+
+- ~org-odt-content-template-file~ ::
+
+ Use this variable to specify the blank =content.xml= used in the
+ final output.
+
+**** Creating one-off styles
+:PROPERTIES:
+:DESCRIPTION: Customizing styles, highlighting...
+:UNNUMBERED: notoc
+:END:
+
+The ODT export back-end can read embedded raw OpenDocument XML from
+the Org file. Such direct formatting is useful for one-off instances.
+
+- Embedding ODT tags as part of regular text ::
+
+ Enclose OpenDocument syntax in =@@odt:...@@= for inline markup. For
+ example, to highlight a region of text do the following:
+
+ #+begin_example
+ @@odt:<text:span text:style-name="Highlight">This is highlighted
+ text</text:span>@@. But this is regular text.
+ #+end_example
+
+ *Hint:* To see the above example in action, edit the =styles.xml=
+ (see [[x-orgodtstyles-xml][Factory styles]]) and add a custom /Highlight/ style as shown
+ below:
+
+ #+begin_example
+ <style:style style:name="Highlight" style:family="text">
+ <style:text-properties fo:background-color="#ff0000"/>
+ </style:style>
+ #+end_example
+
+- Embedding a one-line OpenDocument XML ::
+
+ #+cindex: @samp{ODT}, keyword
+ The ODT export back-end can read one-liner options with =#+ODT:= in
+ the Org file. For example, to force a page break:
+
+ #+begin_example
+ ,#+ODT: <text:p text:style-name="PageBreak"/>
+ #+end_example
+
+ *Hint:* To see the above example in action, edit your
+ =styles.xml= (see [[x-orgodtstyles-xml][Factory styles]]) and add a custom =PageBreak=
+ style as shown below.
+
+ #+begin_example
+ <style:style style:name="PageBreak" style:family="paragraph"
+ style:parent-style-name="Text_20_body">
+ <style:paragraph-properties fo:break-before="page"/>
+ </style:style>
+ #+end_example
+
+- Embedding a block of OpenDocument XML ::
+
+ The ODT export back-end can also read ODT export blocks for
+ OpenDocument XML. Such blocks use the =#+BEGIN_EXPORT odt=
+ ... =#+END_EXPORT= constructs.
+
+ For example, to create a one-off paragraph that uses bold text, do
+ the following:
+
+ #+begin_example
+ ,#+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_EXPORT
+ #+end_example
+
+**** Customizing tables in ODT export
+:PROPERTIES:
+:DESCRIPTION: Defining table templates.
+:UNNUMBERED: notoc
+:END:
+#+cindex: tables, in ODT export
+#+cindex: @samp{ATTR_ODT}, keyword
+
+Override the default table format by specifying a custom table style
+with the =#+ATTR_ODT= line. For a discussion on default formatting of
+tables, see [[*Tables in ODT export]].
+
+This feature closely mimics the way table templates are defined in the
+OpenDocument-v1.2 specification[fn:137].
+
+#+vindex: org-odt-table-styles
+For quick preview of this feature, install the settings below and export the
+table that follows:
+
+#+begin_src emacs-lisp
+(setq org-export-odt-table-styles
+ (append org-export-odt-table-styles
+ '(("TableWithHeaderRowAndColumn" "Custom"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ ("TableWithFirstRowandLastRow" "Custom"
+ ((use-first-row-styles . t)
+ (use-last-row-styles . t))))))
+#+end_src
+
+#+begin_example
+,#+ATTR_ODT: :style TableWithHeaderRowAndColumn
+| Name | Phone | Age |
+| Peter | 1234 | 17 |
+| Anna | 4321 | 25 |
+#+end_example
+
+The example above used =Custom= template and installed two table
+styles =TableWithHeaderRowAndColumn= and
+=TableWithFirstRowandLastRow=. *Important:* The OpenDocument styles
+needed for producing the above template were pre-defined. They are
+available in the section marked =Custom Table Template= in
+=OrgOdtContentTemplate.xml= (see [[x-orgodtcontenttemplate-xml][Factory styles]]). For adding new
+templates, define new styles there.
+
+To use this feature proceed as follows:
+
+1. Create a table template[fn:138].
+
+ A table template is set of =table-cell= and =paragraph= styles for
+ each of the following table cell categories:
+
+ - Body
+ - First column
+ - Last column
+ - First row
+ - Last row
+ - Even row
+ - Odd row
+ - Even column
+ - Odd Column
+
+ The names for the above styles must be chosen based on the name of
+ the table template using a well-defined convention.
+
+ The naming convention is better illustrated with an example. For
+ a table template with the name =Custom=, the needed style names are
+ listed in the following table.
+
+ | Cell type | Cell style | Paragraph style |
+ |--------------+------------------------------+-----------------------------------|
+ | Body | =CustomTableCell= | =CustomTableParagraph= |
+ | First column | =CustomFirstColumnTableCell= | =CustomFirstColumnTableParagraph= |
+ | Last column | =CustomLastColumnTableCell= | =CustomLastColumnTableParagraph= |
+ | First row | =CustomFirstRowTableCell= | =CustomFirstRowTableParagraph= |
+ | Last row | =CustomLastRowTableCell= | =CustomLastRowTableParagraph= |
+ | Even row | =CustomEvenRowTableCell= | =CustomEvenRowTableParagraph= |
+ | Odd row | =CustomOddRowTableCell= | =CustomOddRowTableParagraph= |
+ | Even column | =CustomEvenColumnTableCell= | =CustomEvenColumnTableParagraph= |
+ | Odd column | =CustomOddColumnTableCell= | =CustomOddColumnTableParagraph= |
+
+ To create a table template with the name =Custom=, define the above
+ styles in the =<office:automatic-styles>= ...
+ =</office:automatic-styles>= element of the content template file
+ (see [[x-orgodtcontenttemplate-xml][Factory styles]]).
+
+2. Define a table style[fn:139].
+
+ #+vindex: org-odt-table-styles
+ To define a table style, create an entry for the style in the
+ variable ~org-odt-table-styles~ and specify the following:
+
+ - the name of the table template created in step (1),
+ - the set of cell styles in that template that are to be activated.
+
+ For example, the entry below defines two different table styles
+ =TableWithHeaderRowAndColumn= and =TableWithFirstRowandLastRow=
+ based on the same template =Custom=. The styles achieve their
+ intended effect by selectively activating the individual cell
+ styles in that template.
+
+ #+begin_src emacs-lisp
+ (setq org-export-odt-table-styles
+ (append org-export-odt-table-styles
+ '(("TableWithHeaderRowAndColumn" "Custom"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ ("TableWithFirstRowandLastRow" "Custom"
+ ((use-first-row-styles . t)
+ (use-last-row-styles . t))))))
+ #+end_src
+
+3. Associate a table with the table style.
+
+ To do this, specify the table style created in step (2) as part of
+ the =ATTR_ODT= line as shown below.
+
+ #+begin_example
+ ,#+ATTR_ODT: :style TableWithHeaderRowAndColumn
+ | Name | Phone | Age |
+ | Peter | 1234 | 17 |
+ | Anna | 4321 | 25 |
+ #+end_example
+
+**** Validating OpenDocument XML
+:PROPERTIES:
+:DESCRIPTION: Debugging corrupted OpenDocument files.
+:UNNUMBERED: notoc
+:END:
+
+Sometimes ODT format files may not open due to =.odt= file corruption.
+To verify if such a file is corrupt, validate it against the
+OpenDocument Relax NG Compact (RNC) syntax schema. But first the
+=.odt= files have to be decompressed using =zip=. Note that =.odt=
+files are ZIP archives: [[info:emacs::File Archives]]. The contents of
+ODT files are in XML. For general help with validation---and
+schema-sensitive editing---of XML files: [[info:nxml-mode::Introduction]].
+
+#+vindex: org-export-odt-schema-dir
+Customize ~org-odt-schema-dir~ to point to a directory with
+OpenDocument RNC files and the needed schema-locating rules. The ODT
+export back-end takes care of updating the
+~rng-schema-locating-files~.
+
+** Org Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to Org.
+:END:
+
+#+cindex: Org export
+/org/ export back-end creates a normalized version of the Org document
+in current buffer. The exporter evaluates Babel code (see [[*Evaluating
+Code Blocks]]) and removes content specific to other back-ends.
+
+*** Org export commands
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- {{{kbd(C-c C-e O o)}}} (~org-org-export-to-org~) ::
+
+ #+kindex: C-c C-e O o
+ #+findex: org-org-export-to-org
+ Export as an Org file with a =.org= extension. For =myfile.org=,
+ Org exports to =myfile.org.org=, overwriting without warning.
+
+- {{{kbd(C-c C-e O v)}}} (~~) ::
+
+ #+kindex: C-c C-e O v
+ Export to an Org file, then open it.
+
+** Texinfo Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to Texinfo.
+:END:
+
+*** Texinfo export commands
+:PROPERTIES:
+:DESCRIPTION: Invoking commands.
+:END:
+
+- {{{kbd(C-c C-e i t)}}} (~org-texinfo-export-to-texinfo~) ::
+
+ #+kindex: C-c C-e i t
+ #+findex: org-texinfo-export-to-texinfo
+ Export as a Texinfo file with =.texi= extension. For =myfile.org=,
+ Org exports to =myfile.texi=, overwriting without warning.
+
+- {{{kbd(C-c C-e i i)}}} (~org-texinfo-export-to-info~) ::
+
+ #+kindex: C-c C-e i i
+ #+findex: org-texinfo-export-to-info
+ #+vindex: org-texinfo-info-process
+ Export to Texinfo format first and then process it to make an Info
+ file. To generate other formats, such as DocBook, customize the
+ ~org-texinfo-info-process~ variable.
+
+*** Texinfo specific export settings
+:PROPERTIES:
+:DESCRIPTION: Setting the environment.
+:END:
+
+The Texinfo export back-end has several additional keywords for
+customizing Texinfo output. Setting these keywords works similar to
+the general options (see [[*Export Settings]]).
+
+- =SUBTITLE= ::
+
+ #+cindex: @samp{SUBTITLE}, keyword
+ The document subtitle.
+
+- =SUBAUTHOR= ::
+
+ #+cindex: @samp{SUBAUTHOR}, keyword
+ Additional authors for the document.
+
+- =TEXINFO_FILENAME= ::
+
+ #+cindex: @samp{TEXINFO_FILENAME}, keyword
+ The Texinfo filename.
+
+- =TEXINFO_CLASS= ::
+
+ #+cindex: @samp{TEXINFO_CLASS}, keyword
+ #+vindex: org-texinfo-default-class
+ The default document class (~org-texinfo-default-class~), which must
+ be a member of ~org-texinfo-classes~.
+
+- =TEXINFO_HEADER= ::
+
+ #+cindex: @samp{TEXINFO_HEADER}, keyword
+ Arbitrary lines inserted at the end of the header.
+
+- =TEXINFO_POST_HEADER= ::
+
+ #+cindex: @samp{TEXINFO_POST_HEADER}, keyword
+ Arbitrary lines inserted after the end of the header.
+
+- =TEXINFO_DIR_CATEGORY= ::
+
+ #+cindex: @samp{TEXINFO_DIR_CATEGORY}, keyword
+ The directory category of the document.
+
+- =TEXINFO_DIR_TITLE= ::
+
+ #+cindex: @samp{TEXINFO_DIR_TITLE}, keyword
+ The directory title of the document.
+
+- =TEXINFO_DIR_DESC= ::
+
+ #+cindex: @samp{TEXINFO_DIR_DESC}, keyword
+ The directory description of the document.
+
+- =TEXINFO_PRINTED_TITLE= ::
+
+ #+cindex: @samp{TEXINFO_PRINTED_TITLE}, keyword
+ The printed title of the document.
+
+*** Texinfo file header
+:PROPERTIES:
+:DESCRIPTION: Generating the header.
+:END:
+
+#+cindex: @samp{TEXINFO_FILENAME}, keyword
+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 =TEXINFO_FILENAME= keyword.
+
+#+vindex: org-texinfo-coding-system
+#+cindex: @samp{TEXINFO_HEADER}, keyword
+Along with the output's file name, the Texinfo header also contains
+language details (see [[*Export Settings]]) and encoding system as set in
+the ~org-texinfo-coding-system~ variable. Insert =TEXINFO_HEADER=
+keywords for each additional command in the header, for example:
+
+: #+TEXINFO_HEADER: @synindex
+
+#+cindex: @samp{TEXINFO_CLASS}, keyword
+#+vindex: org-texinfo-classes
+Instead of repeatedly installing the same set of commands, define
+a class in ~org-texinfo-classes~ once, and then activate it in the
+document by setting the =TEXINFO_CLASS= keyword to that class.
+
+*** Texinfo title and copyright page
+:PROPERTIES:
+:DESCRIPTION: Creating preamble pages.
+:END:
+
+#+cindex: @samp{TEXINFO_PRINTED_TITLE}, keyword
+The default template for hard copy output has a title page with
+=TITLE= and =AUTHOR= keywords (see [[*Export Settings]]). To replace the
+regular title with something different for the printed version, use
+the =TEXINFO_PRINTED_TITLE= and =SUBTITLE= keywords. Both expect raw
+Texinfo code for setting their values.
+
+#+cindex: @samp{SUBAUTHOR}, keyword
+If one =AUTHOR= line is not sufficient, add multiple =SUBAUTHOR=
+keywords. They have to be set in raw Texinfo code.
+
+#+begin_example
+,#+AUTHOR: Jane Smith
+,#+SUBAUTHOR: John Doe
+,#+TEXINFO_PRINTED_TITLE: This Long Title@@inlinefmt{tex,@*} Is Broken in @TeX{}
+#+end_example
+
+#+cindex: @samp{COPYING}, property
+Copying material is defined in a dedicated headline with a non-~nil~
+=COPYING= property. The back-end inserts the contents within
+a =@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.
+
+#+begin_example
+,* Legalese
+ :PROPERTIES:
+ :COPYING: t
+ :END:
+
+ This is a short example of a complete Texinfo file, version 1.0.
+
+ Copyright \copy 2016 Free Software Foundation, Inc.
+#+end_example
+
+*** Info directory file
+:PROPERTIES:
+:DESCRIPTION: Installing a manual in Info file hierarchy.
+:END:
+
+#+cindex: @samp{dir} file, in Texinfo export
+#+cindex: Info directory file, in Texinfo export
+#+cindex: @code{install-info}, in Texinfo export
+
+#+cindex: @samp{TEXINFO_DIR_CATEGORY}, keyword
+#+cindex: @samp{TEXINFO_DIR_TITLE}, keyword
+#+cindex: @samp{TEXINFO_DIR_DESC}, keyword
+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: =TEXINFO_DIR_CATEGORY=, =TEXINFO_DIR_TITLE=,
+and =TEXINFO_DIR_DESC= keywords that establish where in the Info
+hierarchy the file fits.
+
+Here is an example that writes to the Info directory file:
+
+#+begin_example
+,#+TEXINFO_DIR_CATEGORY: Emacs
+,#+TEXINFO_DIR_TITLE: Org Mode: (org)
+,#+TEXINFO_DIR_DESC: Outline-based notes management and organizer
+#+end_example
+
+*** Headings and sectioning structure
+:PROPERTIES:
+:DESCRIPTION: Building document structure.
+:END:
+
+#+vindex: org-texinfo-classes
+#+vindex: org-texinfo-default-class
+#+cindex: @samp{TEXINFO_CLASS}, keyword
+The Texinfo export back-end uses a pre-defined scheme to convert Org
+headlines to equivalent Texinfo structuring commands. A scheme like
+this maps top-level headlines to numbered chapters tagged as
+~@chapter~ and lower-level headlines to unnumbered chapters tagged as
+~@unnumbered~. To override such mappings to introduce ~@part~ or
+other Texinfo structuring commands, define a new class in
+~org-texinfo-classes~. Activate the new class with the
+=TEXINFO_CLASS= keyword. When no new class is defined and activated,
+the Texinfo export back-end defaults to the
+~org-texinfo-default-class~.
+
+If an Org headline's level has no associated Texinfo structuring
+command, or is below a certain threshold (see [[*Export Settings]]), then
+the Texinfo export back-end makes it into a list item.
+
+#+cindex: @samp{APPENDIX}, property
+The Texinfo export back-end makes any headline with a non-~nil~
+=APPENDIX= property into an appendix. This happens independent of the
+Org headline level or the =TEXINFO_CLASS= keyword.
+
+#+cindex: @samp{ALT_TITLE}, property
+#+cindex: @samp{DESCRIPTION}, property
+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 =ALT_TITLE= property (see [[*Table of
+Contents]]). Texinfo menu entries also have an option for a longer
+=DESCRIPTION= property. Here's an example that uses both to override
+the default menu entry:
+
+#+begin_example
+,* Controlling Screen Display
+ :PROPERTIES:
+ :ALT_TITLE: Display
+ :DESCRIPTION: Controlling Screen Display
+ :END:
+#+end_example
+
+#+cindex: Top node, in Texinfo export
+The text before the first headline belongs to the /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 =.texi=
+file. See [[info:texinfo::The Top Node]], for more information.
+
+*** Indices
+:PROPERTIES:
+:DESCRIPTION: Creating indices.
+:END:
+
+#+cindex: @samp{CINDEX}, keyword
+#+cindex: concept index, in Texinfo export
+#+cindex: @samp{FINDEX}, keyword
+#+cindex: function index, in Texinfo export
+#+cindex: @samp{KINDEX}, keyword
+#+cindex: keystroke index, in Texinfo export
+#+cindex: @samp{PINDEX}, keyword
+#+cindex: program index, in Texinfo export
+#+cindex: @samp{TINDEX}, keyword
+#+cindex: data type index, in Texinfo export
+#+cindex: @samp{VINDEX}, keyword
+#+cindex: variable index, in Texinfo export
+The Texinfo export back-end recognizes these indexing keywords if used
+in the Org file: =CINDEX=, =FINDEX=, =KINDEX=, =PINDEX=, =TINDEX= and
+=VINDEX=. Write their value as verbatim Texinfo code; in particular,
+={=, =}= and =@= characters need to be escaped with =@= if they do not
+belong to a Texinfo command.
+
+: #+CINDEX: Defining indexing entries
+
+#+cindex: @samp{INDEX}, property
+For the back-end to generate an index entry for a headline, set the
+=INDEX= property to =cp= or =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.
+
+#+begin_example
+,* Concept Index
+ :PROPERTIES:
+ :INDEX: cp
+ :END:
+#+end_example
+
+*** Quoting Texinfo code
+:PROPERTIES:
+:DESCRIPTION: Incorporating literal Texinfo code.
+:END:
+
+Use any of the following three methods to insert or escape raw Texinfo
+code:
+
+#+cindex: @samp{TEXINFO}, keyword
+#+cindex: @samp{BEGIN_EXPORT texinfo}
+#+begin_example
+Richard @@texinfo:@sc{@@Stallman@@texinfo:}@@ commence' GNU.
+
+,#+TEXINFO: @need800
+This paragraph is preceded by...
+
+,#+BEGIN_EXPORT texinfo
+ @auindex Johnson, Mark
+ @auindex Lakoff, George
+,#+END_EXPORT
+#+end_example
+
+*** Plain lists in Texinfo export
+:PROPERTIES:
+:DESCRIPTION: List attributes.
+:END:
+
+#+cindex: @samp{ATTR_TEXINFO}, keyword
+#+cindex: two-column tables, in Texinfo export
+#+cindex: table-type, Texinfo attribute
+The Texinfo export back-end by default converts description lists in
+the Org file using the default command =@table=, which results in
+a table with two columns. To change this behavior, set =:table-type=
+attribute to either =ftable= or =vtable= value. For more information,
+see [[info:texinfo::Two-column Tables]].
+
+#+vindex: org-texinfo-table-default-markup
+#+cindex: indic, Texinfo attribute
+The Texinfo export back-end by default also applies a text highlight
+based on the defaults stored in ~org-texinfo-table-default-markup~.
+To override the default highlight command, specify another one with
+the =:indic= attribute.
+
+#+cindex: multiple items in Texinfo lists
+#+cindex: sep, Texinfo attribute
+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 =:sep= attribute. Each part then becomes a new
+entry in the first column of the table.
+
+The following example illustrates all the attributes above:
+
+#+begin_example
+,#+ATTR_TEXINFO: :table-type vtable :sep , :indic asis
+- foo, bar :: This is the common text for variables foo and bar.
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+#+begin_example
+@vtable @asis
+@item foo
+@itemx bar
+This is the common text for variables foo and bar.
+@end table
+#+end_example
+
+#+cindex: lettered lists, in Texinfo export
+#+cindex: enum, Texinfo attribute
+Ordered lists are numbered when exported to Texinfo format. Such
+numbering obeys any counter (see [[*Plain Lists]]) in the first item of
+the list. The =:enum= attribute also let you start the list at
+a specific number, or switch to a lettered list, as illustrated here
+
+#+begin_example
+#+ATTR_TEXINFO: :enum A
+1. Alpha
+2. Bravo
+3. Charlie
+#+end_example
+
+*** Tables in Texinfo export
+:PROPERTIES:
+:DESCRIPTION: Table attributes.
+:END:
+
+#+cindex: @samp{ATTR_TEXINFO}, keyword
+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 =:columns= attribute. See example
+below.
+
+#+begin_example
+,#+ATTR_TEXINFO: :columns .5 .5
+| a cell | another cell |
+#+end_example
+
+*** Images in Texinfo export
+:PROPERTIES:
+:DESCRIPTION: Image attributes.
+:END:
+
+#+cindex: @samp{ATTR_TEXINFO}, keyword
+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 =:width= and =:height= attributes. For alternate text, use =:alt=
+and specify the text using Texinfo code, as shown in the example:
+
+#+begin_example
+,#+ATTR_TEXINFO: :width 1in :alt Alternate @i{text}
+[[ridt.pdf]]
+#+end_example
+
+*** Quotations in Texinfo export
+:PROPERTIES:
+:DESCRIPTION: Quote block attributes.
+:END:
+
+#+cindex: @samp{ATTR_TEXINFO}, keyword
+You can write the text of a quotation within a quote block (see
+[[*Paragraphs]]). You may also emphasize some text at the beginning of
+the quotation with the =:tag= attribute.
+
+#+begin_example
+,#+ATTR_TEXINFO: :tag Warning
+,#+BEGIN_QUOTE
+Striking your thumb with a hammer may cause severe pain and discomfort.
+,#+END_QUOTE
+#+end_example
+
+To specify the author of the quotation, use the =:author= attribute.
+
+#+begin_example
+,#+ATTR_TEXINFO: :author King Arthur
+,#+BEGIN_QUOTE
+The Lady of the Lake, her arm clad in the purest shimmering samite,
+held aloft Excalibur from the bosom of the water, signifying by divine
+providence that I, Arthur, was to carry Excalibur. That is why I am
+your king.
+,#+END_QUOTE
+#+end_example
+
+*** Special blocks in Texinfo export
+:PROPERTIES:
+:DESCRIPTION: Special block attributes.
+:END:
+
+#+cindex: @samp{ATTR_TEXINFO}, keyword
+
+The Texinfo export back-end converts special blocks to commands with
+the same name. It also adds any =:options= attributes to the end of
+the command, as shown in this example:
+
+#+begin_example
+,#+ATTR_TEXINFO: :options org-org-export-to-org ...
+,#+BEGIN_defun
+ A somewhat obsessive function name.
+,#+END_defun
+#+end_example
+
+#+texinfo: @noindent
+becomes
+
+#+begin_example
+@defun org-org-export-to-org ...
+ A somewhat obsessive function name.
+@end defun
+#+end_example
+
+*** A Texinfo example
+:PROPERTIES:
+:DESCRIPTION: Processing Org to Texinfo.
+:END:
+
+Here is a more detailed example Org file. See
+[[info:texinfo::GNU Sample Texts]] for an equivalent example using
+Texinfo code.
+
+#+begin_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
+
+,#+TEXINFO_DIR_CATEGORY: Texinfo documentation system
+,#+TEXINFO_DIR_TITLE: sample: (sample)
+,#+TEXINFO_DIR_DESC: Invoking sample
+
+,#+TEXINFO_PRINTED_TITLE: GNU Sample
+
+This manual is for GNU Sample (version {{{version}}},
+{{{updated}}}).
+
+,* Copying
+ :PROPERTIES:
+ :COPYING: t
+ :END:
+
+ This manual is for GNU Sample (version {{{version}}},
+ {{{updated}}}), which is an example in the Texinfo documentation.
+
+ Copyright \copy 2016 Free Software Foundation, Inc.
+
+ ,#+BEGIN_QUOTE
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.3 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with no Front-Cover Texts,
+ and with no Back-Cover Texts. A copy of the license is included in
+ the section entitled "GNU Free Documentation License".
+ ,#+END_QUOTE
+
+,* Invoking sample
+
+ ,#+PINDEX: sample
+ ,#+CINDEX: invoking @command{sample}
+
+ This is a sample manual. There is no sample program to invoke, but
+ if there were, you could see its basic usage and command line
+ options here.
+
+,* GNU Free Documentation License
+ :PROPERTIES:
+ :APPENDIX: t
+ :END:
+
+ ,#+INCLUDE: fdl.org
+
+,* Index
+ :PROPERTIES:
+ :INDEX: cp
+ :END:
+#+end_example
+
+** iCalendar Export
+:PROPERTIES:
+:DESCRIPTION: Exporting to iCalendar.
+:END:
+#+cindex: iCalendar export
+
+A large part of Org mode's interoperability 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.
+
+#+vindex: org-icalendar-include-todo
+#+vindex: org-icalendar-use-deadline
+#+vindex: org-icalendar-use-scheduled
+The iCalendar export back-end can also incorporate TODO entries based
+on the configuration of the ~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 ~org-icalendar-use-deadline~ and
+~org-icalendar-use-scheduled~ variables for more details.
+
+#+vindex: org-icalendar-categories
+#+vindex: org-icalendar-alarm-time
+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 ~org-icalendar-categories~. To assign
+clock alarms based on time, configure the ~org-icalendar-alarm-time~
+variable.
+
+#+vindex: org-icalendar-store-UID
+#+cindex: @samp{ID}, property
+The iCalendar format standard requires globally unique identifier---or
+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 ~org-icalendar-store-UID~. The back-end looks for the =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---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.
+
+- {{{kbd(C-c C-e c f)}}} (~org-icalendar-export-to-ics~) ::
+
+ #+kindex: C-c C-e c f
+ #+findex: org-icalendar-export-to-ics
+ Create iCalendar entries from the current Org buffer and store them
+ in the same directory, using a file extension =.ics=.
+
+- {{{kbd(C-c C-e c a)}}} (~org-icalendar-export-agenda-files~) ::
+
+ #+kindex: C-c C-e c a
+ #+findex: org-icalendar-export-agenda-files
+ Create iCalendar entries from Org files in ~org-agenda-files~ and
+ store in a separate iCalendar file for each Org file.
+
+- {{{kbd(C-c C-e c c)}}} (~org-icalendar-combine-agenda-files~) ::
+
+ #+kindex: C-c C-e c c
+ #+findex: org-icalendar-combine-agenda-files
+ #+vindex: org-icalendar-combined-agenda-file
+ Create a combined iCalendar file from Org files in
+ ~org-agenda-files~ and write it to
+ ~org-icalendar-combined-agenda-file~ file name.
+
+#+cindex: @samp{SUMMARY}, property
+#+cindex: @samp{DESCRIPTION}, property
+#+cindex: @samp{LOCATION}, property
+#+cindex: @samp{TIMEZONE}, property
+#+cindex: @samp{CLASS}, property
+The iCalendar export back-end includes =SUMMARY=, =DESCRIPTION=,
+=LOCATION=, =TIMEZONE= and =CLASS= properties from the Org entries
+when exporting. To force the back-end to inherit the =LOCATION=,
+=TIMEZONE= and =CLASS= properties, configure the
+~org-use-property-inheritance~ variable.
+
+#+vindex: org-icalendar-include-body
+When Org entries do not have =SUMMARY=, =DESCRIPTION=, =LOCATION= and
+=CLASS= properties, the iCalendar export back-end derives the summary
+from the headline, and derives the description from the body of the
+Org item. The ~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 is 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.
+
+The =CLASS= property can be used to specify a per-entry visibility
+class or access restrictions, and is applied to any entry with class
+information. The iCalendar standard defines three visibility classes:
+- =PUBLIC= :: The entry is publicly visible (this is the default).
+- =CONFIDENTIAL= :: Only a limited group of clients get access to the
+ event.
+- =PRIVATE= :: The entry can be retrieved only by its owner.
+The server should treat unknown class properties the same as
+=PRIVATE=.
+
+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.
+
+** Other Built-in Back-ends
+:PROPERTIES:
+:DESCRIPTION: Exporting to a man page.
+:END:
+
+Other export back-ends included with Org are:
+
+- =ox-man.el=: Export to a man page.
+
+To activate such back-ends, either customize ~org-export-backends~ or
+load directly with =(require 'ox-man)=. On successful load, the
+back-end adds new keys in the export dispatcher (see [[*The Export
+Dispatcher]]).
+
+Follow the comment section of such files, for example, =ox-man.el=,
+for usage and configuration details.
+
+** Advanced Export Configuration
+:PROPERTIES:
+:DESCRIPTION: Fine-tuning the export output.
+:END:
+
+*** Hooks
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+vindex: org-export-before-processing-hook
+#+vindex: org-export-before-parsing-hook
+The export process executes two hooks before the actual exporting
+begins. The first hook, ~org-export-before-processing-hook~, runs
+before any expansions of macros, Babel code, and include keywords in
+the buffer. The second hook, ~org-export-before-parsing-hook~, runs
+before the buffer is parsed.
+
+Functions added to these hooks are called with a single argument: the
+export back-end actually used, as a symbol. You may use them for
+heavy duty structural modifications of the document. For example, you
+can remove every headline in the buffer during export like this:
+
+#+begin_src emacs-lisp
+(defun my-headline-removal (backend)
+ "Remove all headlines in the current buffer.
+BACKEND is the export back-end being used, as a symbol."
+ (org-map-entries
+ (lambda () (delete-region (point) (line-beginning-position 2)))))
+
+(add-hook 'org-export-before-parsing-hook 'my-headline-removal)
+#+end_src
+
+*** Filters
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: Filters, exporting
+Filters are 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: ~org-export-filter-TYPE-functions~, where {{{var(TYPE)}}}
+is the type targeted by the filter. Valid types are:
+
+#+attr_texinfo: :columns 0.33 0.33 0.33
+| body | bold | babel-call |
+| center-block | clock | code |
+| diary-sexp | drawer | dynamic-block |
+| entity | example-block | export-block |
+| export-snippet | final-output | fixed-width |
+| footnote-definition | footnote-reference | headline |
+| horizontal-rule | inline-babel-call | inline-src-block |
+| inlinetask | italic | item |
+| keyword | latex-environment | latex-fragment |
+| line-break | link | node-property |
+| options | paragraph | parse-tree |
+| plain-list | plain-text | planning |
+| property-drawer | quote-block | radio-target |
+| section | special-block | src-block |
+| statistics-cookie | strike-through | subscript |
+| superscript | table | table-cell |
+| table-row | target | timestamp |
+| underline | verbatim | verse-block |
+
+Here is an example filter that replaces non-breaking spaces ~ ~ in the
+Org buffer with =~= for the LaTeX back-end.
+
+#+begin_src emacs-lisp
+(defun my-latex-filter-nobreaks (text backend info)
+ "Ensure \" \" are properly handled in LaTeX export."
+ (when (org-export-derived-backend-p backend 'latex)
+ (replace-regexp-in-string " " "~" text)))
+
+(add-to-list 'org-export-filter-plain-text-functions
+ 'my-latex-filter-nobreaks)
+#+end_src
+
+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
+~org-export-derived-backend-p~ predicate that tests for /latex/
+back-end or any other back-end, such as /beamer/, derived from
+/latex/.
+
+*** Defining filters for individual files
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+The Org export can filter not just for back-ends, but also for
+specific files through the =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 code block in the same Org file, which is a handy location for
+debugging.
+
+#+begin_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
+
+*** Extending an existing back-end
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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.
+
+For this example, make the /ascii/ back-end display the language used
+in a source code block. Also make it display only when some attribute
+is non-~nil~, like the following:
+
+: #+ATTR_ASCII: :language t
+
+Then extend ASCII back-end with a custom "my-ascii" back-end.
+
+#+begin_src emacs-lisp
+(defun my-ascii-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to ASCII.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (if (not (org-export-read-attribute :attr_ascii src-block :language))
+ (org-export-with-backend 'ascii src-block contents info)
+ (concat
+ (format ",--[ %s ]--\n%s`----"
+ (org-element-property :language src-block)
+ (replace-regexp-in-string
+ "^" "| "
+ (org-element-normalize-string
+ (org-export-format-code-default src-block info)))))))
+
+(org-export-define-derived-backend 'my-ascii 'ascii
+ :translate-alist '((src-block . my-ascii-src-block)))
+#+end_src
+
+The ~my-ascii-src-block~ function looks at the attribute above the
+current element. If not true, hands over to /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 ~src-block~ type elements.
+
+To use the newly defined back-end, evaluate the following from an Org
+buffer:
+
+#+begin_src emacs-lisp
+(org-export-to-buffer 'my-ascii "*Org MY-ASCII Export*")
+#+end_src
+
+Further steps to consider would be an interactive function,
+self-installing an item in the export dispatcher menu, and other
+user-friendly improvements.
+
+** Export in Foreign Buffers
+:PROPERTIES:
+:DESCRIPTION: Author tables and lists in Org syntax.
+:END:
+
+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:
+
+- ~org-ascii-convert-region-to-ascii~ ::
+
+ #+findex: org-ascii-convert-region-to-ascii
+ Convert the selected region into ASCII.
+
+- ~org-ascii-convert-region-to-utf8~ ::
+
+ #+findex: org-ascii-convert-region-to-utf8
+ Convert the selected region into UTF-8.
+
+- ~org-html-convert-region-to-html~ ::
+
+ #+findex: org-html-convert-region-to-html
+ Convert the selected region into HTML.
+
+- ~org-latex-convert-region-to-latex~ ::
+
+ #+findex: org-latex-convert-region-to-latex
+ Convert the selected region into LaTeX.
+
+- ~org-texinfo-convert-region-to-texinfo~ ::
+
+ #+findex: org-texinfo-convert-region-to-texinfo
+ Convert the selected region into Texinfo.
+
+- ~org-md-convert-region-to-md~ ::
+
+ #+findex: org-md-convert-region-to-md
+ Convert the selected region into Markdown.
+
+In-place conversions are particularly handy for quick conversion of
+tables and lists in foreign buffers. For example, in an HTML buffer,
+write a list in Org syntax, select it, and convert it to HTML with
+{{{kbd(M-x org-html-convert-region-to-html)}}}.
+
+*** Exporting to minimal HTML
+:PROPERTIES:
+:DESCRIPTION: Exporting HTML without CSS, Javascript, etc.
+:ALT_TITLE: Bare HTML
+:END:
+
+If you want to output a minimal HTML file, with no CSS, no Javascript,
+no preamble or postamble, here are the variable you would need to set:
+
+#+vindex: org-html-head
+#+vindex: org-html-head-extra
+#+vindex: org-html-head-include-default-style
+#+vindex: org-html-head-include-scripts
+#+vindex: org-html-preamble
+#+vindex: org-html-postamble
+#+vindex: org-html-use-infojs
+#+begin_src emacs-lisp
+(setq org-html-head ""
+ org-html-head-extra ""
+ org-html-head-include-default-style nil
+ org-html-head-include-scripts nil
+ org-html-preamble nil
+ org-html-postamble nil
+ org-html-use-infojs nil)
+#+end_src
+
+* Publishing
+:PROPERTIES:
+:DESCRIPTION: Create a web site of linked Org files.
+:END:
+#+cindex: publishing
+
+Org includes a publishing management system that allows you to
+configure automatic HTML conversion of /projects/ composed of
+interlinked Org files. You can also configure Org to automatically
+upload your exported HTML pages and related attachments, such as
+images and source code files, to a web server.
+
+You can also use Org to convert files into PDF, or even combine HTML
+and PDF conversion so that files are available in both formats on the
+server.
+
+Publishing has been contributed to Org by David O'Toole.
+
+** Configuration
+:PROPERTIES:
+:DESCRIPTION: Defining projects.
+:END:
+Publishing needs significant configuration to specify files,
+destination and many other properties of a project.
+
+*** The variable ~org-publish-project-alist~
+:PROPERTIES:
+:DESCRIPTION: The central configuration variable.
+:ALT_TITLE: Project alist
+:END:
+#+cindex: projects, for publishing
+
+#+vindex: org-publish-project-alist
+Publishing is configured almost entirely through setting the value of
+one variable, called ~org-publish-project-alist~. Each element of the
+list configures one project, and may be in one of the two following
+forms:
+
+#+begin_src emacs-lisp
+("project-name" :property value :property value ...)
+#+end_src
+
+#+texinfo: @noindent
+i.e., a well-formed property list with alternating keys and values,
+or:
+
+#+begin_src emacs-lisp
+("project-name" :components ("project-name" "project-name" ...))
+#+end_src
+
+In both cases, projects are configured by specifying property values.
+A project defines the set of files that are to be published, as well
+as the publishing configuration to use when publishing those files.
+When a project takes the second form listed above, the individual
+members of the ~:components~ property are taken to be sub-projects,
+which group together files requiring different publishing options.
+When you publish such a "meta-project", all the components are also
+published, in the sequence given.
+
+*** Sources and destinations for files
+:PROPERTIES:
+:DESCRIPTION: From here to there.
+:ALT_TITLE: Sources and destinations
+:END:
+#+cindex: directories, for publishing
+
+Most properties are optional, but some should always be set. In
+particular, Org needs to know where to look for source files, and
+where to put published files.
+
+- ~:base-directory~ ::
+
+ Directory containing publishing source files.
+
+- ~:publishing-directory~ ::
+
+ Directory where output files are published. You can directly
+ publish to a webserver using a file name syntax appropriate for the
+ Emacs tramp package. Or you can publish to a local directory and
+ use external tools to upload your website (see [[*Uploading Files]]).
+
+- ~:preparation-function~ ::
+
+ Function or list of functions to be called before starting the
+ publishing process, for example, to run =make= for updating files to
+ be published. Each preparation function is called with a single
+ argument, the project property list.
+
+- ~:completion-function~ ::
+
+ Function or list of functions called after finishing the publishing
+ process, for example, to change permissions of the resulting files.
+ Each completion function is called with a single argument, the
+ project property list.
+
+*** Selecting files
+:PROPERTIES:
+:DESCRIPTION: What files are part of the project?
+:END:
+#+cindex: files, selecting for publishing
+
+By default, all files with extension =.org= in the base directory are
+considered part of the project. This can be modified by setting the
+following properties
+
+- ~:base-extension~ ::
+
+ Extension---without the dot---of source files. This actually is
+ a regular expression. Set this to the symbol ~any~ if you want to
+ get all files in ~:base-directory~, even without extension.
+
+- ~:exclude~ ::
+
+ Regular expression to match file names that should not be published,
+ even though they have been selected on the basis of their extension.
+
+- ~:include~ ::
+
+ List of files to be included regardless of ~:base-extension~ and
+ ~:exclude~.
+
+- ~:recursive~ ::
+
+ Non-~nil~ means, check base-directory recursively for files to
+ publish.
+
+*** Publishing action
+:PROPERTIES:
+:DESCRIPTION: Setting the function doing the publishing.
+:END:
+#+cindex: action, for publishing
+
+Publishing means that a file is copied to the destination directory
+and possibly transformed in the process. The default transformation
+is to export Org files as HTML files, and this is done by the function
+~org-publish-org-to-html~ which calls the HTML exporter (see [[*HTML
+Export]]). But you can also publish your content as PDF files using
+~org-publish-org-to-pdf~, or as ASCII, Texinfo, etc., using the
+corresponding functions.
+
+If you want to publish the Org file as an =.org= file but with
+/archived/, /commented/, and /tag-excluded/ trees removed, use
+~org-publish-org-to-org~. This produces =file.org= and put it in the
+publishing directory. If you want a htmlized version of this file,
+set the parameter ~:htmlized-source~ to ~t~. It produces
+=file.org.html= in the publishing directory[fn:140].
+
+Other files like images only need to be copied to the publishing
+destination; for this you can use ~org-publish-attachment~. For
+non-Org files, you always need to specify the publishing function:
+
+- ~:publishing-function~ ::
+
+ Function executing the publication of a file. This may also be
+ a list of functions, which are all called in turn.
+
+- ~:htmlized-source~ ::
+
+ Non-~nil~ means, publish htmlized source.
+
+The function must accept three arguments: a property list containing
+at least a ~:publishing-directory~ property, the name of the file to
+be published, 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.
+
+*** Options for the exporters
+:PROPERTIES:
+:DESCRIPTION: Tweaking HTML/@LaTeX{} export.
+:ALT_TITLE: Publishing options
+:END:
+#+cindex: options, for publishing
+#+cindex: publishing options
+
+The property list can be used to set many export options for the HTML
+and LaTeX exporters. In most cases, these properties correspond to
+user variables in Org. The table below lists these properties along
+with the variable they belong to. See the documentation string for
+the respective variable for details.
+
+#+vindex: org-publish-project-alist
+When a property is given a value in ~org-publish-project-alist~, its
+setting overrides the value of the corresponding user variable, if
+any, during publishing. Options set within a file (see [[*Export
+Settings]]), however, override everything.
+
+**** Generic properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:archived-trees~ | ~org-export-with-archived-trees~ |
+| ~:exclude-tags~ | ~org-export-exclude-tags~ |
+| ~:headline-levels~ | ~org-export-headline-levels~ |
+| ~:language~ | ~org-export-default-language~ |
+| ~:preserve-breaks~ | ~org-export-preserve-breaks~ |
+| ~:section-numbers~ | ~org-export-with-section-numbers~ |
+| ~:select-tags~ | ~org-export-select-tags~ |
+| ~:with-author~ | ~org-export-with-author~ |
+| ~:with-broken-links~ | ~org-export-with-broken-links~ |
+| ~:with-clocks~ | ~org-export-with-clocks~ |
+| ~:with-creator~ | ~org-export-with-creator~ |
+| ~:with-date~ | ~org-export-with-date~ |
+| ~:with-drawers~ | ~org-export-with-drawers~ |
+| ~:with-email~ | ~org-export-with-email~ |
+| ~:with-emphasize~ | ~org-export-with-emphasize~ |
+| ~:with-fixed-width~ | ~org-export-with-fixed-width~ |
+| ~:with-footnotes~ | ~org-export-with-footnotes~ |
+| ~: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-special-strings~ | ~org-export-with-special-strings~ |
+| ~:with-sub-superscript~ | ~org-export-with-sub-superscripts~ |
+| ~:with-tables~ | ~org-export-with-tables~ |
+| ~:with-tags~ | ~org-export-with-tags~ |
+| ~:with-tasks~ | ~org-export-with-tasks~ |
+| ~:with-timestamps~ | ~org-export-with-timestamps~ |
+| ~:with-title~ | ~org-export-with-title~ |
+| ~:with-toc~ | ~org-export-with-toc~ |
+| ~:with-todo-keywords~ | ~org-export-with-todo-keywords~ |
+
+**** ASCII specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:ascii-bullets~ | ~org-ascii-bullets~ |
+| ~:ascii-caption-above~ | ~org-ascii-caption-above~ |
+| ~:ascii-charset~ | ~org-ascii-charset~ |
+| ~:ascii-global-margin~ | ~org-ascii-global-margin~ |
+| ~:ascii-format-drawer-function~ | ~org-ascii-format-drawer-function~ |
+| ~:ascii-format-inlinetask-function~ | ~org-ascii-format-inlinetask-function~ |
+| ~:ascii-headline-spacing~ | ~org-ascii-headline-spacing~ |
+| ~:ascii-indented-line-width~ | ~org-ascii-indented-line-width~ |
+| ~:ascii-inlinetask-width~ | ~org-ascii-inlinetask-width~ |
+| ~:ascii-inner-margin~ | ~org-ascii-inner-margin~ |
+| ~:ascii-links-to-notes~ | ~org-ascii-links-to-notes~ |
+| ~:ascii-list-margin~ | ~org-ascii-list-margin~ |
+| ~:ascii-paragraph-spacing~ | ~org-ascii-paragraph-spacing~ |
+| ~:ascii-quote-margin~ | ~org-ascii-quote-margin~ |
+| ~:ascii-table-keep-all-vertical-lines~ | ~org-ascii-table-keep-all-vertical-lines~ |
+| ~:ascii-table-use-ascii-art~ | ~org-ascii-table-use-ascii-art~ |
+| ~:ascii-table-widen-columns~ | ~org-ascii-table-widen-columns~ |
+| ~:ascii-text-width~ | ~org-ascii-text-width~ |
+| ~:ascii-underline~ | ~org-ascii-underline~ |
+| ~:ascii-verbatim-format~ | ~org-ascii-verbatim-format~ |
+
+**** Beamer specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:beamer-theme~ | ~org-beamer-theme~ |
+| ~:beamer-column-view-format~ | ~org-beamer-column-view-format~ |
+| ~:beamer-environments-extra~ | ~org-beamer-environments-extra~ |
+| ~:beamer-frame-default-options~ | ~org-beamer-frame-default-options~ |
+| ~:beamer-outline-frame-options~ | ~org-beamer-outline-frame-options~ |
+| ~:beamer-outline-frame-title~ | ~org-beamer-outline-frame-title~ |
+| ~:beamer-subtitle-format~ | ~org-beamer-subtitle-format~ |
+
+**** HTML specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:html-allow-name-attribute-in-anchors~ | ~org-html-allow-name-attribute-in-anchors~ |
+| ~:html-checkbox-type~ | ~org-html-checkbox-type~ |
+| ~:html-container~ | ~org-html-container-element~ |
+| ~:html-divs~ | ~org-html-divs~ |
+| ~:html-doctype~ | ~org-html-doctype~ |
+| ~:html-extension~ | ~org-html-extension~ |
+| ~:html-footnote-format~ | ~org-html-footnote-format~ |
+| ~:html-footnote-separator~ | ~org-html-footnote-separator~ |
+| ~:html-footnotes-section~ | ~org-html-footnotes-section~ |
+| ~:html-format-drawer-function~ | ~org-html-format-drawer-function~ |
+| ~:html-format-headline-function~ | ~org-html-format-headline-function~ |
+| ~:html-format-inlinetask-function~ | ~org-html-format-inlinetask-function~ |
+| ~:html-head-extra~ | ~org-html-head-extra~ |
+| ~:html-head-include-default-style~ | ~org-html-head-include-default-style~ |
+| ~:html-head-include-scripts~ | ~org-html-head-include-scripts~ |
+| ~:html-head~ | ~org-html-head~ |
+| ~:html-home/up-format~ | ~org-html-home/up-format~ |
+| ~:html-html5-fancy~ | ~org-html-html5-fancy~ |
+| ~:html-indent~ | ~org-html-indent~ |
+| ~:html-infojs-options~ | ~org-html-infojs-options~ |
+| ~:html-infojs-template~ | ~org-html-infojs-template~ |
+| ~:html-inline-image-rules~ | ~org-html-inline-image-rules~ |
+| ~:html-inline-images~ | ~org-html-inline-images~ |
+| ~:html-link-home~ | ~org-html-link-home~ |
+| ~:html-link-org-files-as-html~ | ~org-html-link-org-files-as-html~ |
+| ~:html-link-up~ | ~org-html-link-up~ |
+| ~:html-link-use-abs-url~ | ~org-html-link-use-abs-url~ |
+| ~:html-mathjax-options~ | ~org-html-mathjax-options~ |
+| ~:html-mathjax-template~ | ~org-html-mathjax-template~ |
+| ~:html-equation-reference-format~ | ~org-html-equation-reference-format~ |
+| ~:html-metadata-timestamp-format~ | ~org-html-metadata-timestamp-format~ |
+| ~:html-postamble-format~ | ~org-html-postamble-format~ |
+| ~:html-postamble~ | ~org-html-postamble~ |
+| ~:html-preamble-format~ | ~org-html-preamble-format~ |
+| ~:html-preamble~ | ~org-html-preamble~ |
+| ~:html-self-link-headlines~ | ~org-html-self-link-headlines~ |
+| ~:html-table-align-individual-field~ | ~de{org-html-table-align-individual-fields~ |
+| ~:html-table-attributes~ | ~org-html-table-default-attributes~ |
+| ~:html-table-caption-above~ | ~org-html-table-caption-above~ |
+| ~:html-table-data-tags~ | ~org-html-table-data-tags~ |
+| ~:html-table-header-tags~ | ~org-html-table-header-tags~ |
+| ~:html-table-row-tags~ | ~org-html-table-row-tags~ |
+| ~:html-table-use-header-tags-for-first-column~ | ~org-html-table-use-header-tags-for-first-column~ |
+| ~:html-tag-class-prefix~ | ~org-html-tag-class-prefix~ |
+| ~:html-text-markup-alist~ | ~org-html-text-markup-alist~ |
+| ~:html-todo-kwd-class-prefix~ | ~org-html-todo-kwd-class-prefix~ |
+| ~:html-toplevel-hlevel~ | ~org-html-toplevel-hlevel~ |
+| ~:html-use-infojs~ | ~org-html-use-infojs~ |
+| ~:html-validation-link~ | ~org-html-validation-link~ |
+| ~:html-viewport~ | ~org-html-viewport~ |
+| ~:html-wrap-src-lines~ | ~org-html-wrap-src-lines~ |
+| ~:html-xml-declaration~ | ~org-html-xml-declaration~ |
+
+**** LaTeX specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:latex-active-timestamp-format~ | ~org-latex-active-timestamp-format~ |
+| ~:latex-caption-above~ | ~org-latex-caption-above~ |
+| ~:latex-classes~ | ~org-latex-classes~ |
+| ~:latex-class~ | ~org-latex-default-class~ |
+| ~:latex-compiler~ | ~org-latex-compiler~ |
+| ~:latex-default-figure-position~ | ~org-latex-default-figure-position~ |
+| ~:latex-default-table-environment~ | ~org-latex-default-table-environment~ |
+| ~:latex-default-table-mode~ | ~org-latex-default-table-mode~ |
+| ~:latex-diary-timestamp-format~ | ~org-latex-diary-timestamp-format~ |
+| ~:latex-footnote-defined-format~ | ~org-latex-footnote-defined-format~ |
+| ~:latex-footnote-separator~ | ~org-latex-footnote-separator~ |
+| ~:latex-format-drawer-function~ | ~org-latex-format-drawer-function~ |
+| ~:latex-format-headline-function~ | ~org-latex-format-headline-function~ |
+| ~:latex-format-inlinetask-function~ | ~org-latex-format-inlinetask-function~ |
+| ~:latex-hyperref-template~ | ~org-latex-hyperref-template~ |
+| ~:latex-image-default-height~ | ~org-latex-image-default-height~ |
+| ~:latex-image-default-option~ | ~org-latex-image-default-option~ |
+| ~:latex-image-default-width~ | ~org-latex-image-default-width~ |
+| ~:latex-images-centered~ | ~org-latex-images-centered~ |
+| ~:latex-inactive-timestamp-format~ | ~org-latex-inactive-timestamp-format~ |
+| ~:latex-inline-image-rules~ | ~org-latex-inline-image-rules~ |
+| ~:latex-link-with-unknown-path-format~ | ~org-latex-link-with-unknown-path-format~ |
+| ~:latex-listings-langs~ | ~org-latex-listings-langs~ |
+| ~:latex-listings-options~ | ~org-latex-listings-options~ |
+| ~:latex-listings~ | ~org-latex-listings~ |
+| ~:latex-minted-langs~ | ~org-latex-minted-langs~ |
+| ~:latex-minted-options~ | ~org-latex-minted-options~ |
+| ~:latex-prefer-user-labels~ | ~org-latex-prefer-user-labels~ |
+| ~:latex-subtitle-format~ | ~org-latex-subtitle-format~ |
+| ~:latex-subtitle-separate~ | ~org-latex-subtitle-separate~ |
+| ~:latex-table-scientific-notation~ | ~org-latex-table-scientific-notation~ |
+| ~:latex-tables-booktabs~ | ~org-latex-tables-booktabs~ |
+| ~:latex-tables-centered~ | ~org-latex-tables-centered~ |
+| ~:latex-text-markup-alist~ | ~org-latex-text-markup-alist~ |
+| ~:latex-title-command~ | ~org-latex-title-command~ |
+| ~:latex-toc-command~ | ~org-latex-toc-command~ |
+
+**** Markdown specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:md-footnote-format~ | ~org-md-footnote-format~ |
+| ~:md-footnotes-section~ | ~org-md-footnotes-section~ |
+| ~:md-headline-style~ | ~org-md-headline-style~ |
+
+**** ODT specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:odt-content-template-file~ | ~org-odt-content-template-file~ |
+| ~:odt-display-outline-level~ | ~org-odt-display-outline-level~ |
+| ~:odt-fontify-srcblocks~ | ~org-odt-fontify-srcblocks~ |
+| ~:odt-format-drawer-function~ | ~org-odt-format-drawer-function~ |
+| ~:odt-format-headline-function~ | ~org-odt-format-headline-function~ |
+| ~:odt-format-inlinetask-function~ | ~org-odt-format-inlinetask-function~ |
+| ~:odt-inline-formula-rules~ | ~org-odt-inline-formula-rules~ |
+| ~:odt-inline-image-rules~ | ~org-odt-inline-image-rules~ |
+| ~:odt-pixels-per-inch~ | ~org-odt-pixels-per-inch~ |
+| ~:odt-styles-file~ | ~org-odt-styles-file~ |
+| ~:odt-table-styles~ | ~org-odt-table-styles~ |
+| ~:odt-use-date-fields~ | ~org-odt-use-date-fields~ |
+
+**** Texinfo specific properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+| ~:texinfo-active-timestamp-format~ | ~org-texinfo-active-timestamp-format~ |
+| ~:texinfo-classes~ | ~org-texinfo-classes~ |
+| ~:texinfo-class~ | ~org-texinfo-default-class~ |
+| ~:texinfo-table-default-markup~ | ~org-texinfo-table-default-markup~ |
+| ~:texinfo-diary-timestamp-format~ | ~org-texinfo-diary-timestamp-format~ |
+| ~:texinfo-filename~ | ~org-texinfo-filename~ |
+| ~:texinfo-format-drawer-function~ | ~org-texinfo-format-drawer-function~ |
+| ~:texinfo-format-headline-function~ | ~org-texinfo-format-headline-function~ |
+| ~:texinfo-format-inlinetask-function~ | ~org-texinfo-format-inlinetask-function~ |
+| ~:texinfo-inactive-timestamp-format~ | ~org-texinfo-inactive-timestamp-format~ |
+| ~:texinfo-link-with-unknown-path-format~ | ~org-texinfo-link-with-unknown-path-format~ |
+| ~:texinfo-node-description-column~ | ~org-texinfo-node-description-column~ |
+| ~:texinfo-table-scientific-notation~ | ~org-texinfo-table-scientific-notation~ |
+| ~:texinfo-tables-verbatim~ | ~org-texinfo-tables-verbatim~ |
+| ~:texinfo-text-markup-alist~ | ~org-texinfo-text-markup-alist~ |
+
+*** Publishing links
+:PROPERTIES:
+:DESCRIPTION: Which links keep working after publishing?
+:END:
+#+cindex: links, publishing
+
+To create a link from one Org file to another, you would use something
+like =[[file:foo.org][The foo]]= or simply =[[file:foo.org]]= (see [[*External Links]]). When
+published, this link becomes a link to =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 =http= link instead of
+a =file:= link, because =file= links are converted to link to the
+corresponding =.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 [[*Example: complex publishing configuration]], for an example of this
+usage.
+
+Eventually, links between published documents can contain some search
+options (see [[*Search Options in File Links]]), 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 =foo.html=.
+
+#+begin_example
+[[file:foo.org::*heading]]
+[[file:foo.org::#custom-id]]
+[[file:foo.org::target]]
+#+end_example
+
+*** Generating a sitemap
+:PROPERTIES:
+:DESCRIPTION: Generating a list of all pages.
+:ALT_TITLE: Site map
+:END:
+#+cindex: sitemap, of published pages
+
+The following properties may be used to control publishing of
+a map of files for a given project.
+
+- ~:auto-sitemap~ ::
+
+ When non-~nil~, publish a sitemap during
+ ~org-publish-current-project~ or ~org-publish-all~.
+
+- ~:sitemap-filename~ ::
+
+ Filename for output of sitemap. Defaults to =sitemap.org=, which
+ becomes =sitemap.html=.
+
+- ~:sitemap-title~ ::
+
+ Title of sitemap page. Defaults to name of file.
+
+- ~:sitemap-format-entry~ ::
+
+ #+findex: org-publish-find-date
+ #+findex: org-publish-find-property
+ #+findex: org-publish-find-title
+ 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 ~org-publish-find-date~, ~org-publish-find-title~ and
+ ~org-publish-find-property~, to retrieve additional information
+ about published documents.
+
+- ~:sitemap-function~ ::
+
+ 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 nested
+ list, which can further be transformed using ~org-list-to-generic~,
+ ~org-list-to-subtree~ and alike. Default value generates a plain
+ list of links to all files in the project.
+
+- ~:sitemap-sort-folders~ ::
+
+ Where folders should appear in the sitemap. Set this to ~first~
+ (default) or ~last~ to display folders first or last, respectively.
+ When set to ~ignore~, folders are ignored altogether. Any other
+ value mixes files and folders. This variable has no effect when
+ site-map style is ~tree~.
+
+- ~:sitemap-sort-files~ ::
+
+ How the files are sorted in the site map. Set this to
+ ~alphabetically~ (default), ~chronologically~ or
+ ~anti-chronologically~. ~chronologically~ sorts the files with
+ older date first while ~anti-chronologically~ sorts the files with
+ newer date first. ~alphabetically~ sorts the files alphabetically.
+ The date of a file is retrieved with ~org-publish-find-date~.
+
+- ~:sitemap-ignore-case~ ::
+
+ Should sorting be case-sensitive? Default ~nil~.
+
+- ~:sitemap-file-entry-format~ ::
+
+ 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:
+ ~%t~ stands for the title of the file, ~%a~ stands for the author of
+ the file and ~%d~ stands for the date of the file. The date is
+ retrieved with the ~org-publish-find-date~ function and formatted
+ with ~org-publish-sitemap-date-format~. Default ~%t~.
+
+- ~:sitemap-date-format~ ::
+
+ Format string for the ~format-time-string~ function that tells how
+ a sitemap entry's date is to be formatted. This property bypasses
+ ~org-publish-sitemap-date-format~ which defaults to ~%Y-%m-%d~.
+
+*** Generating an index
+:PROPERTIES:
+:DESCRIPTION: An index that reaches across pages.
+:END:
+#+cindex: index, in a publishing project
+
+Org mode can generate an index across the files of a publishing project.
+
+- ~:makeindex~ ::
+
+ When non-~nil~, generate in index in the file =theindex.org= and
+ publish it as =theindex.html=.
+
+The file is created when first publishing a project with the
+~:makeindex~ set. The file only contains a statement =#+INCLUDE:
+"theindex.inc"=. You can then build around this include statement by
+adding a title, style information, etc.
+
+#+cindex: @samp{INDEX}, keyword
+Index entries are specified with =INDEX= keyword. An entry that
+contains an exclamation mark creates a sub item.
+
+#+begin_example
+,*** Curriculum Vitae
+,#+INDEX: CV
+,#+INDEX: Application!CV
+#+end_example
+
+** Uploading Files
+:PROPERTIES:
+:DESCRIPTION: How to get files up on the server.
+:END:
+#+cindex: rsync
+#+cindex: unison
+
+For those people already utilizing third party sync tools such as
+Rsync or Unison, it might be preferable not to use the built-in remote
+publishing facilities of Org mode which rely heavily on Tramp. Tramp,
+while very useful and powerful, tends not to be so efficient for
+multiple file transfer and has been known to cause problems under
+heavy usage.
+
+Specialized synchronization utilities offer several advantages. In
+addition to timestamp comparison, they also do content and
+permissions/attribute checks. For this reason you might prefer to
+publish your web to a local directory---possibly even /in place/ with
+your Org files---and then use Unison or Rsync to do the
+synchronization with the remote host.
+
+Since Unison, for example, can be configured as to which files to
+transfer to a certain remote destination, it can greatly simplify the
+project publishing definition. Simply keep all files in the correct
+location, process your Org files with ~org-publish~ and let the
+synchronization tool do the rest. You do not need, in this scenario,
+to include attachments such as JPG, CSS or PNG files in the project
+definition since the third-party tool syncs them.
+
+Publishing to a local directory is also much faster than to a remote
+one, so that you can afford more easily to republish entire projects.
+If you set ~org-publish-use-timestamps-flag~ to ~nil~, you gain the
+main benefit of re-including any changed external files such as source
+example files you might include with =INCLUDE= keyword. The timestamp
+mechanism in Org is not smart enough to detect if included files have
+been modified.
+
+** Sample Configuration
+:PROPERTIES:
+:DESCRIPTION: Example projects.
+:END:
+
+Below we provide two example configurations. The first one is
+a simple project publishing only a set of Org files. The second
+example is more complex, with a multi-component project.
+
+*** Example: simple publishing configuration
+:PROPERTIES:
+:DESCRIPTION: One-component publishing.
+:ALT_TITLE: Simple example
+:END:
+
+This example publishes a set of Org files to the =public_html=
+directory on the local machine.
+
+#+begin_src emacs-lisp
+(setq org-publish-project-alist
+ '(("org"
+ :base-directory "~/org/"
+ :publishing-directory "~/public_html"
+ :section-numbers nil
+ :table-of-contents nil
+ :style "<link rel=\"stylesheet\"
+ href=\"../other/mystyle.css\"
+ type=\"text/css\"/>")))
+#+end_src
+
+*** Example: complex publishing configuration
+:PROPERTIES:
+:DESCRIPTION: A multi-component publishing example.
+:ALT_TITLE: Complex example
+:END:
+
+This more complicated example publishes an entire website, including
+Org files converted to HTML, image files, Emacs Lisp source code, and
+style sheets. The publishing directory is remote and private files
+are excluded.
+
+To ensure that links are preserved, care should be taken to replicate
+your directory structure on the web server, and to use relative file
+paths. For example, if your Org files are kept in =~/org/= and your
+publishable images in =~/images/=, you would link to an image with
+
+: file:../images/myimage.png
+
+On the web server, the relative path to the image should be the same.
+You can accomplish this by setting up an =images/= folder in the right
+place on the web server, and publishing images to it.
+
+#+begin_src emacs-lisp
+(setq org-publish-project-alist
+ '(("orgfiles"
+ :base-directory "~/org/"
+ :base-extension "org"
+ :publishing-directory "/ssh:user@host:~/html/notebook/"
+ :publishing-function org-html-publish-to-html
+ :exclude "PrivatePage.org" ;; regexp
+ :headline-levels 3
+ :section-numbers nil
+ :with-toc nil
+ :html-head "<link rel=\"stylesheet\"
+ href=\"../other/mystyle.css\" type=\"text/css\"/>"
+ :html-preamble t)
+
+ ("images"
+ :base-directory "~/images/"
+ :base-extension "jpg\\|gif\\|png"
+ :publishing-directory "/ssh:user@host:~/html/images/"
+ :publishing-function org-publish-attachment)
+
+ ("other"
+ :base-directory "~/other/"
+ :base-extension "css\\|el"
+ :publishing-directory "/ssh:user@host:~/html/other/"
+ :publishing-function org-publish-attachment)
+ ("website" :components ("orgfiles" "images" "other"))))
+#+end_src
+
+** Triggering Publication
+:PROPERTIES:
+:DESCRIPTION: Publication commands.
+:END:
+
+Once properly configured, Org can publish with the following commands:
+
+- {{{kbd(C-c C-e P x)}}} (~org-publish~) ::
+
+ #+kindex: C-c C-e P x
+ #+findex: org-publish
+ Prompt for a specific project and publish all files that belong to
+ it.
+
+- {{{kbd(C-c C-e P p)}}} (~org-publish-current-project~) ::
+
+ #+kindex: C-c C-e P p
+ #+findex: org-publish-current-project
+ Publish the project containing the current file.
+
+- {{{kbd(C-c C-e P f)}}} (~org-publish-current-file~) ::
+
+ #+kindex: C-c C-e P f
+ #+findex: org-publish-current-file
+ Publish only the current file.
+
+- {{{kbd(C-c C-e P a)}}} (~org-publish-all~) ::
+
+ #+kindex: C-c C-e P a
+ #+findex: org-publish-all
+ Publish every project.
+
+#+vindex: org-publish-use-timestamps-flag
+Org uses timestamps to track when a file has changed. The above
+functions normally only publish changed files. You can override this
+and force publishing of all files by giving a prefix argument to any
+of the commands above, or by customizing the variable
+~org-publish-use-timestamps-flag~. This may be necessary in
+particular if files include other files via =SETUPFILE= or =INCLUDE=
+keywords.
+
+* Working with Source Code
+:PROPERTIES:
+:DESCRIPTION: Export, evaluate, and tangle code blocks.
+:END:
+#+cindex: source code, working with
+
+Source code here refers to any plain text collection of computer
+instructions, possibly with comments, written using a human-readable
+programming language. Org can manage source code in an Org document
+when the source code is identified with begin and end markers.
+Working with source code begins with identifying source code blocks.
+A source code block can be placed almost anywhere in an Org document;
+it is not restricted to the preamble or the end of the document.
+However, Org cannot manage a source code block if it is placed inside
+an Org comment or within a fixed width section.
+
+Here is an example source code block in the Emacs Lisp language:
+
+#+begin_example
+,#+BEGIN_SRC emacs-lisp
+ (defun org-xor (a b)
+ "Exclusive or."
+ (if a (not b) b))
+,#+END_SRC
+#+end_example
+
+Source code blocks are one of many Org block types, which also include
+"center", "comment", "dynamic", "example", "export", "quote",
+"special", and "verse". This section pertains to blocks between
+=#+BEGIN_SRC= and =#+END_SRC=.
+
+Details of Org's facilities for working with source code are described
+in the following sections.
+
+** Features Overview
+:PROPERTIES:
+:DESCRIPTION: Enjoy the versatility of source blocks.
+:END:
+
+Org can manage the source code in the block delimited by =#+BEGIN_SRC=
+... =#+END_SRC= in several ways that can simplify housekeeping tasks
+essential to modern source code maintenance. Org can edit, format,
+extract, export, and publish source code blocks. Org can also compile
+and execute a source code block, then capture the results. The Org
+mode literature sometimes refers to source code blocks as /live code/
+blocks because they can alter the content of the Org document or the
+material that it exports. Users can control how live they want each
+source code block by tweaking the header arguments (see [[*Using Header
+Arguments]]) for compiling, execution, extraction, and exporting.
+
+For editing and formatting a source code block, Org uses an
+appropriate Emacs major mode that includes features specifically
+designed for source code in that language.
+
+Org can extract one or more source code blocks and write them to one
+or more source files---a process known as /tangling/ in literate
+programming terminology.
+
+For exporting and publishing, Org's back-ends can format a source code
+block appropriately, often with native syntax highlighting.
+
+For executing and compiling a source code block, the user can
+configure Org to select the appropriate compiler. Org provides
+facilities to collect the result of the execution or compiler output,
+insert it into the Org document, and/or export it. In addition to
+text results, Org can insert links to other data types, including
+audio, video, and graphics. Org can also link a compiler error
+message to the appropriate line in the source code block.
+
+An important feature of Org's management of source code blocks is the
+ability to pass variables, functions, and results to one another using
+a common syntax for source code blocks in any language. Although most
+literate programming facilities are restricted to one language or
+another, Org's language-agnostic approach lets the literate programmer
+match each programming task with the appropriate computer language and
+to mix them all together in a single Org document. This
+interoperability among languages explains why Org's source code
+management facility was named /Org Babel/ by its originators, Eric
+Schulte and Dan Davison.
+
+Org mode fulfills the promise of easy verification and maintenance of
+publishing reproducible research by keeping text, data, code,
+configuration settings of the execution environment, the results of
+the execution, and associated narratives, claims, references, and
+internal and external links in a single Org document.
+
+** Structure of Code Blocks
+:PROPERTIES:
+:DESCRIPTION: Code block syntax described.
+:END:
+#+cindex: code block, structure
+#+cindex: source code, block structure
+#+cindex: @samp{NAME} keyword, in source blocks
+#+cindex: @samp{BEGIN_SRC}
+
+Org offers two ways to structure source code in Org documents: in
+a source code block, and directly inline. Both specifications are
+shown below.
+
+A source code block conforms to this structure:
+
+#+begin_example
+,#+NAME: <name>
+,#+BEGIN_SRC <language> <switches> <header arguments>
+ <body>
+,#+END_SRC
+#+end_example
+
+Do not be put-off by having to remember the source block syntax. Org
+mode offers a command for wrapping existing text in a block (see
+[[*Structure Templates]]). 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.
+
+#+cindex: source code, inline
+An inline code block conforms to this structure:
+
+: src_<language>{<body>}
+
+#+texinfo: @noindent
+or
+
+: src_<language>[<header arguments>]{<body>}
+
+- =#+NAME: <name>= ::
+
+ Optional. Names the source block so it can be called, like
+ a function, from other source blocks or inline code to evaluate or
+ to capture the results. Code from other blocks, other files, and
+ from table formulas (see [[*The Spreadsheet]]) can use the name to
+ reference a source 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.
+
+- =#+BEGIN_SRC= ... =#+END_SRC= ::
+
+ Mandatory. They mark the start and end of a block that Org
+ requires. The =#+BEGIN_SRC= line takes additional arguments, as
+ described next.
+
+- =<language>= ::
+
+ #+cindex: language, in code blocks
+ Mandatory. It is the identifier of the source code language in the
+ block. See [[*Languages]], for identifiers of supported languages.
+
+- =<switches>= ::
+
+ #+cindex: switches, in code blocks
+ Optional. Switches provide finer control of the code execution,
+ export, and format (see the discussion of switches in [[*Literal
+ Examples]]).
+
+- =<header arguments>= ::
+
+ #+cindex: header arguments, in code blocks
+ Optional. Heading arguments control many aspects of evaluation,
+ export and tangling of code blocks (see [[*Using 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.
+
+- =<body>= ::
+
+ Source code in the dialect of the specified language identifier.
+
+** Using Header Arguments
+:PROPERTIES:
+:DESCRIPTION: Different ways to set header arguments.
+:END:
+
+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 source code blocks. A header argument is
+specified with an initial colon followed by the argument's name in
+lowercase.
+
+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.
+
+*** System-wide header arguments
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+#+vindex: org-babel-default-header-args
+
+#+vindex: org-babel-default-header-args
+System-wide values of header arguments can be specified by customizing
+the ~org-babel-default-header-args~ variable, which defaults to the
+following values:
+
+#+begin_example
+:session => "none"
+:results => "replace"
+:exports => "code"
+:cache => "no"
+:noweb => "no"
+#+end_example
+
+The example below sets =:noweb= header arguments to =yes=, which makes
+Org expand =:noweb= references by default.
+
+#+begin_src emacs-lisp
+(setq org-babel-default-header-args
+ (cons '(:noweb . "yes")
+ (assq-delete-all :noweb org-babel-default-header-args)))
+#+end_src
+
+#+cindex: language specific default header arguments
+#+cindex: default header arguments per language
+Each language can have separate default header arguments by
+customizing the variable ~org-babel-default-header-args:<LANG>~, where
+{{{var(<LANG>)}}} is the name of the language. For details, see the
+language-specific online documentation at
+https://orgmode.org/worg/org-contrib/babel/.
+
+*** Header arguments in Org mode properties
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+For header arguments applicable to the buffer, use =PROPERTY= keyword
+anywhere in the Org file (see [[*Property Syntax]]).
+
+The following example makes all the R code blocks execute in the same
+session. Setting =:results= to =silent= ignores the results of
+executions for all blocks, not just R code blocks; no results inserted
+for any block.
+
+#+begin_example
+,#+PROPERTY: header-args:R :session *R*
+,#+PROPERTY: header-args :results silent
+#+end_example
+
+#+vindex: org-use-property-inheritance
+Header arguments set through Org's property drawers (see [[*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
+~org-use-property-inheritance~ setting.
+
+In this example, =:cache= defaults to =yes= for all code blocks in the
+sub-tree.
+
+#+begin_example
+,* sample header
+ :PROPERTIES:
+ :header-args: :cache yes
+ :END:
+#+end_example
+
+#+kindex: C-c C-x p
+#+findex: org-set-property
+Properties defined through ~org-set-property~ function, bound to
+{{{kbd(C-c C-x p)}}}, apply to all active languages. They override
+properties set in ~org-babel-default-header-args~.
+
+#+cindex: language specific header arguments properties
+#+cindex: header arguments per language
+Language-specific header arguments are also read from properties
+=header-args:<LANG>= where {{{var(<LANG>)}}} is the language
+identifier. For example,
+
+#+begin_example
+,* Heading
+ :PROPERTIES:
+ :header-args:clojure: :session *clojure-1*
+ :header-args:R: :session *R*
+ :END:
+,** Subheading
+ :PROPERTIES:
+ :header-args:clojure: :session *clojure-2*
+ :END:
+#+end_example
+
+#+texinfo: @noindent
+would force separate sessions for Clojure blocks in =Heading= and
+=Subheading=, but use the same session for all R blocks. Blocks in
+=Subheading= inherit settings from =Heading=.
+
+*** Code block specific header arguments
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Header arguments are most commonly set at the source code block level,
+on the =#+BEGIN_SRC= line. Arguments set at this level take
+precedence over those set in the ~org-babel-default-header-args~
+variable, and also those set as header properties.
+
+In the following example, setting =:results= to =silent= makes it
+ignore results of the code execution. Setting =:exports= to =code=
+exports only the body of the code block to HTML or LaTeX.
+
+#+begin_example
+,#+NAME: factorial
+,#+BEGIN_SRC haskell :results silent :exports code :var n=0
+ fac 0 = 1
+ fac n = n * fac (n-1)
+,#+END_SRC
+#+end_example
+
+The same header arguments in an inline code block:
+
+: src_haskell[:exports both]{fac 5}
+
+#+cindex: @samp{HEADER}, keyword
+Code block header arguments can span multiple lines using =#+HEADER:=
+on each line. Note that Org currently accepts the plural spelling of
+=#+HEADER:= only as a convenience for backward-compatibility. It may
+be removed at some point.
+
+Multi-line header arguments on an unnamed code block:
+
+#+begin_example
+,#+HEADER: :var data1=1
+,#+BEGIN_SRC emacs-lisp :var data2=2
+ (message "data1:%S, data2:%S" data1 data2)
+,#+END_SRC
+
+,#+RESULTS:
+: data1:1, data2:2
+#+end_example
+
+Multi-line header arguments on a named code block:
+
+#+begin_example
+,#+NAME: named-block
+,#+HEADER: :var data=2
+,#+BEGIN_SRC emacs-lisp
+ (message "data:%S" data)
+,#+END_SRC
+
+,#+RESULTS: named-block
+ : data:2
+#+end_example
+
+*** Header arguments in function calls
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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 =#+CALL:= examples are shown below. For the complete
+syntax of =CALL= keyword, see [[*Evaluating Code Blocks]].
+
+In this example, =:exports results= header argument is applied to the
+evaluation of the =#+CALL:= line.
+
+: #+CALL: factorial(n=5) :exports results
+
+In this example, =:session special= header argument is applied to the
+evaluation of =factorial= code block.
+
+: #+CALL: factorial[:session special](n=5)
+
+** Environment of a Code Block
+:PROPERTIES:
+:DESCRIPTION: Arguments, sessions, working directory...
+:END:
+
+*** Passing arguments
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: passing arguments to code blocks
+#+cindex: arguments, in code blocks
+#+cindex: @samp{var}, header argument
+Use =var= for passing arguments to source code blocks. The specifics
+of variables in code blocks vary by the source language and are
+covered in the language-specific documentation. The syntax for =var=,
+however, is the same for all languages. This includes declaring
+a variable, and assigning a default value.
+
+The following syntax is used to pass arguments to code blocks using
+the =var= header argument.
+
+: :var NAME=ASSIGN
+
+#+texinfo: @noindent
+{{{var(NAME)}}} is the name of the variable bound in the code block
+body. {{{var(ASSIGN)}}} is a literal value, such as a string,
+a number, a reference to a table, a list, a literal example, another
+code block---with or without arguments---or the results of evaluating
+a code block.
+
+Here are examples of passing values by reference:
+
+- table ::
+
+ A table named with a =NAME= keyword.
+
+ #+begin_example
+ ,#+NAME: example-table
+ | 1 |
+ | 2 |
+ | 3 |
+ | 4 |
+
+ ,#+NAME: table-length
+ ,#+BEGIN_SRC emacs-lisp :var table=example-table
+ (length table)
+ ,#+END_SRC
+
+ ,#+RESULTS: table-length
+ : 4
+ #+end_example
+
+ When passing a table, you can treat specially the row, or the
+ column, containing labels for the columns, or the rows, in the
+ table.
+
+ #+cindex: @samp{colnames}, header argument
+ The =colnames= header argument accepts =yes=, =no=, or =nil= values.
+ The default value is =nil=: if an input table has column
+ names---because the second row is a horizontal rule---then Org
+ removes the column names, processes the table, puts back the column
+ names, and then writes the table to the results block. Using =yes=,
+ Org does the same to the first row, even if the initial table does
+ not contain any horizontal rule. When set to =no=, Org does not
+ pre-process column names at all.
+
+ #+begin_example
+ ,#+NAME: less-cols
+ | a |
+ |---|
+ | b |
+ | c |
+
+ ,#+BEGIN_SRC python :var tab=less-cols :colnames nil
+ return [[val + '*' for val in row] for row in tab]
+ ,#+END_SRC
+
+ ,#+RESULTS:
+ | a |
+ |----|
+ | b* |
+ | c* |
+ #+end_example
+
+ #+cindex: @samp{rownames}, header argument
+ Similarly, the =rownames= header argument can take two values: =yes=
+ or =no=. When set to =yes=, Org removes the first column, processes
+ the table, puts back the first column, and then writes the table to
+ the results block. The default is =no=, which means Org does not
+ pre-process the first column. Note that Emacs Lisp code blocks
+ ignore =rownames= header argument because of the ease of
+ table-handling in Emacs.
+
+ #+begin_example
+ ,#+NAME: with-rownames
+ | one | 1 | 2 | 3 | 4 | 5 |
+ | two | 6 | 7 | 8 | 9 | 10 |
+
+ ,#+BEGIN_SRC python :var tab=with-rownames :rownames yes
+ return [[val + 10 for val in row] for row in tab]
+ ,#+END_SRC
+
+ ,#+RESULTS:
+ | one | 11 | 12 | 13 | 14 | 15 |
+ | two | 16 | 17 | 18 | 19 | 20 |
+ #+end_example
+
+- list ::
+
+ A simple named list.
+
+ #+begin_example
+ ,#+NAME: example-list
+ - simple
+ - not
+ - nested
+ - list
+
+ ,#+BEGIN_SRC emacs-lisp :var x=example-list
+ (print x)
+ ,#+END_SRC
+
+ ,#+RESULTS:
+ | simple | list |
+ #+end_example
+
+ Note that only the top level list items are passed along. Nested
+ list items are ignored.
+
+- code block without arguments ::
+
+ A code block name, as assigned by =NAME= keyword from the example
+ above, optionally followed by parentheses.
+
+ #+begin_example
+ ,#+BEGIN_SRC emacs-lisp :var length=table-length()
+ (* 2 length)
+ ,#+END_SRC
+
+ ,#+RESULTS:
+ : 8
+ #+end_example
+
+- code block with arguments ::
+
+ A code block name, as assigned by =NAME= keyword, followed by
+ parentheses and optional arguments passed within the parentheses.
+
+ #+begin_example
+ ,#+NAME: double
+ ,#+BEGIN_SRC emacs-lisp :var input=8
+ (* 2 input)
+ ,#+END_SRC
+
+ ,#+RESULTS: double
+ : 16
+
+ ,#+NAME: squared
+ ,#+BEGIN_SRC emacs-lisp :var input=double(input=1)
+ (* input input)
+ ,#+END_SRC
+
+ ,#+RESULTS: squared
+ : 4
+ #+end_example
+
+- literal example ::
+
+ A literal example block named with a =NAME= keyword.
+
+ #+begin_example
+ ,#+NAME: literal-example
+ ,#+BEGIN_EXAMPLE
+ A literal example
+ on two lines
+ ,#+END_EXAMPLE
+
+ ,#+NAME: read-literal-example
+ ,#+BEGIN_SRC emacs-lisp :var x=literal-example
+ (concatenate #'string x " for you.")
+ ,#+END_SRC
+
+ ,#+RESULTS: read-literal-example
+ : A literal example
+ : on two lines for you.
+ #+end_example
+
+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 commas then each subsequent section
+indexes as the next dimension. Note that this indexing occurs
+/before/ other table-related header arguments are applied, such as
+=hlines=, =colnames= and =rownames=. The following example assigns
+the last cell of the first row the table =example-table= to the
+variable =data=:
+
+#+begin_example
+,#+NAME: example-table
+| 1 | a |
+| 2 | b |
+| 3 | c |
+| 4 | d |
+
+,#+BEGIN_SRC emacs-lisp :var data=example-table[0,-1]
+ data
+,#+END_SRC
+
+,#+RESULTS:
+: a
+#+end_example
+
+Two integers separated by a colon reference a range of variable
+values. In that case the entire inclusive range is referenced. For
+example the following assigns the middle three rows of =example-table=
+to =data=.
+
+#+begin_example
+,#+NAME: example-table
+| 1 | a |
+| 2 | b |
+| 3 | c |
+| 4 | d |
+| 5 | 3 |
+
+,#+BEGIN_SRC emacs-lisp :var data=example-table[1:3]
+ data
+,#+END_SRC
+
+,#+RESULTS:
+| 2 | b |
+| 3 | c |
+| 4 | d |
+#+end_example
+
+To pick the entire range, use an empty index, or the single character
+=*=. =0:-1= does the same thing. Example below shows how to
+reference the first column only.
+
+#+begin_example
+,#+NAME: example-table
+| 1 | a |
+| 2 | b |
+| 3 | c |
+| 4 | d |
+
+,#+BEGIN_SRC emacs-lisp :var data=example-table[,0]
+ data
+,#+END_SRC
+
+,#+RESULTS:
+| 1 | 2 | 3 | 4 |
+#+end_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.
+
+#+begin_example
+,#+NAME: 3D
+,#+BEGIN_SRC emacs-lisp
+ '(((1 2 3) (4 5 6) (7 8 9))
+ ((10 11 12) (13 14 15) (16 17 18))
+ ((19 20 21) (22 23 24) (25 26 27)))
+,#+END_SRC
+
+,#+BEGIN_SRC emacs-lisp :var data=3D[1,,1]
+ data
+,#+END_SRC
+
+,#+RESULTS:
+| 11 | 14 | 17 |
+#+end_example
+
+Note that row names and column names are not removed prior to variable
+indexing. You need to take them into account, even when =colnames= or
+=rownames= header arguments remove them.
+
+Emacs lisp code can also set the values for variables. To
+differentiate a value from Lisp code, Org interprets any value
+starting with =(=, =[=, ='= or =`= 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 the 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.
+
+#+begin_example
+,#+BEGIN_SRC sh :var filename=(buffer-file-name) :exports both
+ wc -w $filename
+,#+END_SRC
+#+end_example
+
+Note that values read from tables and lists are not mistakenly
+evaluated as Emacs Lisp code, as illustrated in the following example.
+
+#+begin_example
+,#+NAME: table
+| (a b c) |
+
+,#+HEADER: :var data=table[0,0]
+,#+BEGIN_SRC perl
+ $data
+,#+END_SRC
+
+,#+RESULTS:
+: (a b c)
+#+end_example
+
+*** Using sessions
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: using sessions in code blocks
+#+cindex: @samp{session}, header argument
+Two code blocks can share the same environment. The =session= header
+argument is for running multiple source code blocks under one session.
+Org runs code blocks with the same session name in the same
+interpreter process.
+
+- =none= ::
+
+ Default. Each code block gets a new interpreter process to execute.
+ The process terminates once the block is evaluated.
+
+- {{{var(STRING)}}} ::
+
+ Any string besides =none= turns that string into the name of that
+ session. For example, =:session STRING= names it =STRING=. If
+ =session= has no value, 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.
+
+Only languages that provide interactive evaluation can have session
+support. Not all languages provide this support, such as C and ditaa.
+Even languages, such as Python and Haskell, that do support
+interactive evaluation impose limitations on allowable language
+constructs that can run interactively. Org inherits those limitations
+for those code blocks running in a session.
+
+*** Choosing a working directory
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: working directory, in a code block
+#+cindex: @samp{dir}, header argument
+#+cindex: @samp{mkdirp}, header argument
+The =dir= header argument 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 =:dir
+DIRECTORY= temporarily has the same effect as changing the current
+directory with {{{kbd(M-x cd RET DIRECTORY)}}}, and then not setting
+=dir=. Under the surface, =dir= simply sets the value of the Emacs
+variable ~default-directory~. Setting =mkdirp= header argument to
+a non-~nil~ value creates the directory, if necessary.
+
+For example, to save the plot file in the =Work/= folder of the home
+directory---notice tilde is expanded:
+
+#+begin_example
+,#+BEGIN_SRC R :file myplot.png :dir ~/Work
+ matplot(matrix(rnorm(100), 10), type="l")
+,#+END_SRC
+#+end_example
+
+To evaluate the code block on a remote machine, supply a remote
+directory name using Tramp syntax. For example:
+
+#+begin_example
+,#+BEGIN_SRC R :file plot.png :dir /scp:dand@yakuba.princeton.edu:
+ plot(1:10, main=system("hostname", intern=TRUE))
+,#+END_SRC
+#+end_example
+
+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 Tramp. Org constructs the remote path to the file name from
+=dir= and ~default-directory~, as illustrated here:
+
+: [[file:/scp:dand@yakuba.princeton.edu:/home/dand/plot.png][plot.png]]
+
+When =dir= is used with =session=, Org sets the starting directory for
+a new session. But Org does not alter the directory of an already
+existing session.
+
+Do not use =dir= with =:exports results= or with =:exports both= to
+avoid Org inserting incorrect links to remote files. That is because
+Org does not expand ~default directory~ to avoid some underlying
+portability issues.
+
+*** Inserting headers and footers
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: headers, in code blocks
+#+cindex: footers, in code blocks
+#+cindex: @samp{prologue}, header argument
+The =prologue= header argument is for appending to the top of the code
+block for execution, like a reset instruction. For example, you may
+use =:prologue "reset"= in a Gnuplot code block or, for every such
+block:
+
+#+begin_src emacs-lisp
+(add-to-list 'org-babel-default-header-args:gnuplot
+ '((:prologue . "reset")))
+
+#+end_src
+
+#+cindex: @samp{epilogue}, header argument
+Likewise, the value of the =epilogue= header argument is for appending
+to the end of the code block for execution.
+
+** Evaluating Code Blocks
+:PROPERTIES:
+:DESCRIPTION: Place results of evaluation in the Org buffer.
+:END:
+#+cindex: code block, evaluating
+#+cindex: source code, evaluating
+#+cindex: @samp{RESULTS}, keyword
+
+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 [[*Code Evaluation and Security Issues]].
+
+*** How to evaluate source code
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Org captures the results of the code block evaluation and inserts them
+in the Org file, right after the code block. The insertion point is
+after a newline and the =RESULTS= keyword. Org creates the =RESULTS=
+keyword if one is not already there.
+
+By default, Org enables only Emacs Lisp code blocks for execution.
+See [[*Languages]] to enable other languages.
+
+#+kindex: C-c C-c
+#+kindex: C-c C-v e
+#+findex: org-babel-execute-src-block
+Org provides many ways to execute code blocks. {{{kbd(C-c C-c)}}} or
+{{{kbd(C-c C-v e)}}} with the point on a code block[fn:141] calls the
+~org-babel-execute-src-block~ function, which executes the code in the
+block, collects the results, and inserts them in the buffer.
+
+#+cindex: @samp{CALL}, keyword
+#+vindex: org-babel-inline-result-wrap
+By calling a named code block[fn:142] from an Org mode buffer or
+a table. Org can call the named code blocks from the current Org mode
+buffer or from the "Library of Babel" (see [[*Library of Babel]]).
+
+The syntax for =CALL= keyword is:
+
+#+begin_example
+,#+CALL: <name>(<arguments>)
+,#+CALL: <name>[<inside header arguments>](<arguments>) <end header arguments>
+#+end_example
+
+The syntax for inline named code blocks is:
+
+#+begin_example
+... call_<name>(<arguments>) ...
+... call_<name>[<inside header arguments>](<arguments>)[<end header arguments>] ...
+#+end_example
+
+When inline syntax is used, the result is wrapped based on the
+variable ~org-babel-inline-result-wrap~, which by default is set to
+~"=%s="~ to produce verbatim text suitable for markup.
+
+- =<name>= ::
+
+ This is the name of the code block (see [[*Structure of Code Blocks]])
+ to be evaluated in the current document. If the block is located in
+ another file, start =<name>= with the file name followed by
+ a colon. For example, in order to execute a block named =clear-data=
+ in =file.org=, you can write the following:
+
+ : #+CALL: file.org:clear-data()
+
+- =<arguments>= ::
+
+ Org passes arguments to the code block using standard function call
+ syntax. For example, a =#+CALL:= line that passes =4= to a code
+ block named =double=, which declares the header argument =:var n=2=,
+ would be written as:
+
+ : #+CALL: double(n=4)
+
+ #+texinfo: @noindent
+ Note how this function call syntax is different from the header
+ argument syntax.
+
+- =<inside header arguments>= ::
+
+ Org passes inside header arguments to the named code block using the
+ header argument syntax. Inside header arguments apply to code block
+ evaluation. For example, =[:results output]= collects results
+ printed to stdout during code execution of that block. Note how
+ this header argument syntax is different from the function call
+ syntax.
+
+- =<end header arguments>= ::
+
+ End header arguments affect the results returned by the code block.
+ For example, =:results html= wraps the results in a =#+BEGIN_EXPORT
+ html= block before inserting the results in the Org buffer.
+
+*** Limit code block evaluation
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{eval}, header argument
+#+cindex: control code block evaluation
+The =eval= header argument can limit evaluation of specific code
+blocks and =CALL= keyword. It is useful for protection against
+evaluating untrusted code blocks by prompting for a confirmation.
+
+- =never= or =no= ::
+
+ Org never evaluates the source code.
+
+- =query= ::
+
+ Org prompts the user for permission to evaluate the source code.
+
+- =never-export= or =no-export= ::
+
+ Org does not evaluate the source code when exporting, yet the user
+ can evaluate it interactively.
+
+- =query-export= ::
+
+ Org prompts the user for permission to evaluate the source code
+ during export.
+
+If =eval= header argument is not set, then Org determines whether to
+evaluate the source code from the ~org-confirm-babel-evaluate~
+variable (see [[*Code Evaluation and Security Issues]]).
+
+*** Cache results of evaluation
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{cache}, header argument
+#+cindex: cache results of code evaluation
+The =cache= header argument is for caching results of evaluating code
+blocks. Caching results can avoid re-evaluating a code block 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 =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 code blocks are pure functions,
+that is functions that return the same value for the same input
+arguments (see [[*Environment of a Code Block]]), 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 =cache= is used in a session, caching may
+cause unexpected results.
+
+When the caching mechanism tests for any source code changes, it does
+not expand noweb style references (see [[*Noweb Reference Syntax]]).
+
+The =cache= header argument can have one of two values: =yes= or =no=.
+
+- =no= ::
+
+ Default. No caching of results; code block evaluated every time.
+
+- =yes= ::
+
+ Whether to run the code or return the cached results is determined
+ by comparing the SHA1 hash value of the combined code block and
+ arguments passed to it. This hash value is packed on the
+ =#+RESULTS:= line from previous evaluation. When hash values match,
+ Org does not evaluate the code block. When hash values mismatch,
+ Org evaluates the code block, inserts the results, recalculates the
+ hash value, and updates =#+RESULTS:= line.
+
+In this example, both functions are cached. But =caller= runs only if
+the result from =random= has changed since the last run.
+
+#+begin_example
+,#+NAME: random
+,#+BEGIN_SRC R :cache yes
+ runif(1)
+,#+END_SRC
+
+,#+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random
+0.4659510825295
+
+,#+NAME: caller
+,#+BEGIN_SRC emacs-lisp :var x=random :cache yes
+ x
+,#+END_SRC
+
+,#+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller
+0.254227238707244
+#+end_example
+
+** Results of Evaluation
+:PROPERTIES:
+:DESCRIPTION: Choosing a results type, post-processing...
+:END:
+#+cindex: code block, results of evaluation
+#+cindex: source code, results of evaluation
+
+#+cindex: @samp{results}, header argument
+How Org handles results of a code block execution depends on many
+header arguments working together. The primary determinant, however,
+is the =results= header argument. It accepts four classes of options.
+Each code block can take only one option per class:
+
+- Collection ::
+
+ For how the results should be collected from the code block;
+
+- Type ::
+
+ For which type of result the code block will return; affects how Org
+ processes and inserts results in the Org buffer;
+
+- Format ::
+
+ For the result; affects how Org processes results;
+
+- Handling ::
+
+ For inserting results once they are properly formatted.
+
+*** Collection
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Collection options specify the results. Choose one of the options;
+they are mutually exclusive.
+
+- =value= ::
+
+ Default for most Babel libraries[fn:142]. Functional mode. Org
+ gets the value by wrapping the code in a function definition in the
+ language of the source block. That is why when using =:results
+ value=, code should execute like a function and return a value. For
+ languages like Python, an explicit ~return~ statement is mandatory
+ when using =:results value=. Result is the value returned by the
+ last statement in the code block.
+
+ When evaluating the code block in a session (see [[*Environment of
+ a Code Block]]), Org passes the code to an interpreter running as an
+ interactive Emacs inferior process. Org gets the value from the
+ source code interpreter's last statement output. Org has to use
+ language-specific methods to obtain the value. For example, from
+ the variable ~_~ in Ruby, and the value of ~.Last.value~ in R.
+
+- =output= ::
+
+ Scripting mode. Org passes the code to an external process running
+ the interpreter. Org returns the contents of the standard output
+ stream as text results.
+
+ When using a session, Org passes the code to the interpreter running
+ as an interactive Emacs inferior process. Org concatenates any text
+ output from the interpreter and returns the collection as a result.
+
+*** Type
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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.
+
+#+attr_texinfo: :sep ,
+- =table=, =vector= ::
+
+ 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:
+ =:results value table=.
+
+ #+cindex: @samp{hlines}, header argument
+ In-between each table row or below the table headings, sometimes
+ results have horizontal lines, which are also known as "hlines".
+ The =hlines= argument with the default =no= value strips such lines
+ from the input table. For most code, this is desirable, or else
+ those =hline= symbols raise unbound variable errors. A =yes=
+ accepts such lines, as demonstrated in the following example.
+
+ #+begin_example
+ ,#+NAME: many-cols
+ | a | b | c |
+ |---+---+---|
+ | d | e | f |
+ |---+---+---|
+ | g | h | i |
+
+ ,#+NAME: no-hline
+ ,#+BEGIN_SRC python :var tab=many-cols :hlines no
+ return tab
+ ,#+END_SRC
+
+ ,#+RESULTS: no-hline
+ | a | b | c |
+ | d | e | f |
+ | g | h | i |
+
+ ,#+NAME: hlines
+ ,#+BEGIN_SRC python :var tab=many-cols :hlines yes
+ return tab
+ ,#+END_SRC
+
+ ,#+RESULTS: hlines
+ | a | b | c |
+ |---+---+---|
+ | d | e | f |
+ |---+---+---|
+ | g | h | i |
+ #+end_example
+
+- =list= ::
+
+ Interpret the results as an Org list. If the result is a single
+ value, create a list of one element.
+
+- =scalar=, =verbatim= ::
+
+ Interpret literally and insert as quoted text. Do not create
+ a table. Usage example: =:results value verbatim=.
+
+- =file= ::
+
+ Interpret as a filename. Save the results of execution of the code
+ block to that file, then insert a link to it. You can control both
+ the filename and the description associated to the link.
+
+ #+cindex: @samp{file}, header argument
+ #+cindex: @samp{output-dir}, header argument
+ Org first tries to generate the filename from the value of the
+ =file= header argument and the directory specified using the
+ =output-dir= header arguments. If =output-dir= is not specified,
+ Org assumes it is the current directory.
+
+ #+begin_example
+ ,#+BEGIN_SRC asymptote :results value file :file circle.pdf :output-dir img/
+ size(2cm);
+ draw(unitcircle);
+ ,#+END_SRC
+ #+end_example
+
+ #+cindex: @samp{file-ext}, header argument
+ If =file= header argument is missing, Org generates the base name of
+ the output file from the name of the code block, and its extension
+ from the =file-ext= header argument. In that case, both the name
+ and the extension are mandatory.
+
+ #+begin_example
+ ,#+name: circle
+ ,#+BEGIN_SRC asymptote :results value file :file-ext pdf
+ size(2cm);
+ draw(unitcircle);
+ ,#+END_SRC
+ #+end_example
+
+ #+cindex: @samp{file-desc}, header argument
+ The =file-desc= header argument defines the description (see
+ [[*Link Format]]) for the link. If =file-desc= is present but has no value,
+ the =file= value is used as the link description. When this
+ argument is not present, the description is omitted.
+
+ #+cindex: @samp{sep}, header argument
+ By default, Org assumes that a table written to a file has
+ TAB-delimited output. You can choose a different separator with
+ the =sep= header argument.
+
+ #+cindex: @samp{file-mode}, header argument
+ The =file-mode= header argument defines the file permissions. To
+ make it executable, use =:file-mode (identity #o755)=.
+
+ #+begin_example
+ ,#+BEGIN_SRC shell :results file :file script.sh :file-mode (identity #o755)
+ echo "#!/bin/bash"
+ echo "echo Hello World"
+ ,#+END_SRC
+ #+end_example
+
+*** Format
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Format pertains to the type of the result returned by the code block.
+Choose one of the options; they are mutually exclusive. The default
+follows from the type specified above.
+
+#+attr_texinfo: :sep ,
+- =code= ::
+
+ Result enclosed in a code block. Useful for parsing. Usage
+ example: =:results value code=.
+
+- =drawer= ::
+
+ Result wrapped in a =RESULTS= drawer. Useful for containing =raw=
+ or =org= results for later scripting and automated processing.
+ Usage example: =:results value drawer=.
+
+- =html= ::
+
+ Results enclosed in a =BEGIN_EXPORT html= block. Usage example:
+ =:results value html=.
+
+- =latex= ::
+
+ Results enclosed in a =BEGIN_EXPORT latex= block. Usage example:
+ =:results value latex=.
+
+- =link=, =graphics= ::
+
+ When used along with =file= type, the result is a link to the file
+ specified in =:file= header argument. However, unlike plain =file=
+ type, nothing is written to the disk. The block is used for its
+ side-effects only, as in the following example:
+
+ #+begin_example
+ ,#+begin_src shell :results file link :file "download.tar.gz"
+ wget -c "http://example.com/download.tar.gz"
+ ,#+end_src
+ #+end_example
+
+- =org= ::
+
+ Results enclosed in a =BEGIN_SRC org= block. For comma-escape,
+ either {{{kbd(TAB)}}} in the block, or export the file. Usage
+ example: =:results value org=.
+
+- =pp= ::
+
+ Result converted to pretty-print source code. Enclosed in a code
+ block. Languages supported: Emacs Lisp, Python, and Ruby. Usage
+ example: =:results value pp=.
+
+- =raw= ::
+
+ Interpreted as raw Org mode. Inserted directly into the buffer.
+ Aligned if it is a table. Usage example: =:results value raw=.
+
+#+cindex: @samp{wrap}, header argument
+The =wrap= header argument unconditionally marks the results block by
+appending strings to =#+BEGIN_= and =#+END_=. If no string is
+specified, Org wraps the results in a =#+BEGIN_results=
+... =#+END_results= block. It takes precedent over the =results=
+value listed above. E.g.,
+
+#+begin_example
+,#+BEGIN_SRC emacs-lisp :results html :wrap EXPORT markdown
+"<blink>Welcome back to the 90's</blink>"
+,#+END_SRC
+
+,#+RESULTS:
+,#+BEGIN_EXPORT markdown
+<blink>Welcome back to the 90's</blink>
+,#+END_EXPORT
+#+end_example
+
+*** Handling
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+Handling options after collecting the results.
+
+- =silent= ::
+
+ Do not insert results in the Org mode buffer, but echo them in the
+ minibuffer. Usage example: =:results output silent=.
+
+- =replace= ::
+
+ Default. Insert results in the Org buffer. Remove previous
+ results. Usage example: =:results output replace=.
+
+- =append= ::
+
+ Append results to the Org buffer. Latest results are at the bottom.
+ Does not remove previous results. Usage example: =:results output
+ append=.
+
+- =prepend= ::
+
+ Prepend results to the Org buffer. Latest results are at the top.
+ Does not remove previous results. Usage example: =:results output
+ prepend=.
+
+*** Post-processing
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{post}, header argument
+#+cindex: @samp{*this*}, in @samp{post} header argument
+The =post= header argument is for post-processing results from block
+evaluation. When =post= has any value, Org binds the results to
+~*this*~ variable for easy passing to =var= header argument
+specifications (see [[*Environment of a Code Block]]). That makes results
+available to other code blocks, or even for direct Emacs Lisp code
+execution.
+
+The following two examples illustrate =post= header argument in
+action. The first one shows how to attach an =ATTR_LATEX= keyword
+using =post=.
+
+#+begin_example
+,#+NAME: attr_wrap
+,#+BEGIN_SRC sh :var data="" :var width="\\textwidth" :results output
+ echo "#+ATTR_LATEX: :width $width"
+ echo "$data"
+,#+END_SRC
+
+,#+HEADER: :file /tmp/it.png
+,#+BEGIN_SRC dot :post attr_wrap(width="5cm", data=*this*) :results drawer
+ digraph{
+ a -> b;
+ b -> c;
+ c -> a;
+ }
+,#+end_src
+
+,#+RESULTS:
+:RESULTS:
+,#+ATTR_LATEX :width 5cm
+[[file:/tmp/it.png]]
+:END:
+#+end_example
+
+The second example shows use of =colnames= header argument in =post=
+to pass data between code blocks.
+
+#+begin_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
+
+** Exporting Code Blocks
+:PROPERTIES:
+:DESCRIPTION: Export contents and/or results.
+:END:
+#+cindex: code block, exporting
+#+cindex: source code, exporting
+
+It is possible to export the /code/ of code blocks, the /results/ of
+code block evaluation, /both/ the code and the results of code block
+evaluation, or /none/. Org defaults to exporting /code/ for most
+languages. For some languages, such as ditaa, Org defaults to
+/results/. To export just the body of code blocks, see [[*Literal
+Examples]]. To selectively export sub-trees of an Org document, see
+[[*Exporting]].
+
+#+cindex: @samp{exports}, header argument
+The =exports= header argument is to specify if that part of the Org
+file is exported to, say, HTML or LaTeX formats.
+
+- =code= ::
+
+ The default. The body of code is included into the exported file.
+ Example: =:exports code=.
+
+- =results= ::
+
+ The results of evaluation of the code is included in the exported
+ file. Example: =:exports results=.
+
+- =both= ::
+
+ Both the code and results of evaluation are included in the exported
+ file. Example: =:exports both=.
+
+- =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: =:exports none=.
+
+#+vindex: org-export-use-babel
+To stop Org from evaluating code blocks to speed exports, use the
+header argument =:eval never-export= (see [[*Evaluating Code Blocks]]).
+To stop Org from evaluating code blocks for greater security, set the
+~org-export-use-babel~ variable to ~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 =:eval never-export= (see [[*Evaluating Code Blocks]]).
+
+Org never evaluates code blocks in commented sub-trees when exporting
+(see [[*Comment Lines]]). On the other hand, Org does evaluate code
+blocks in sub-trees excluded from export (see [[*Export Settings]]).
+
+** Extracting Source Code
+:PROPERTIES:
+:DESCRIPTION: Create pure source code files.
+:END:
+#+cindex: tangling
+#+cindex: source code, extracting
+#+cindex: code block, extracting source code
+
+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 /woven/ with code and
+documentation, and on export, the code is 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 code blocks, it expands, merges, and transforms them.
+Then Org recomposes them into one or more separate files, as
+configured through the options. During this tangling process, Org
+expands variables in the source code, and resolves any noweb style
+references (see [[*Noweb Reference Syntax]]).
+
+*** Header arguments
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+cindex: @samp{tangle}, header argument
+The =tangle= header argument specifies if the code block is exported
+to source file(s).
+
+- =yes= ::
+
+ Export the 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: =:tangle yes=.
+
+- =no= ::
+
+ The default. Do not extract the code in a source code file.
+ Example: =:tangle no=.
+
+- {{{var(FILENAME)}}} ::
+
+ Export the code block to source file whose file name is derived from
+ any string passed to the =tangle= header argument. Org derives the
+ file name as being relative to the directory of the Org file's
+ location. Example: =:tangle FILENAME=.
+
+#+cindex: @samp{mkdirp}, header argument
+The =mkdirp= header argument creates parent directories for tangled
+files if the directory does not exist. A =yes= value enables
+directory creation whereas =no= inhibits it.
+
+#+cindex: @samp{comments}, header argument
+The =comments= header argument controls inserting comments into
+tangled files. These are above and beyond whatever comments may
+already exist in the code block.
+
+- =no= ::
+
+ The default. Do not insert any extra comments during tangling.
+
+- =link= ::
+
+ Wrap the code block in comments. Include links pointing back to the
+ place in the Org file from where the code was tangled.
+
+- =yes= ::
+
+ Kept for backward compatibility; same as =link=.
+
+- =org= ::
+
+ 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.
+
+- =both= ::
+
+ Includes both =link= and =org= options.
+
+- =noweb= ::
+
+ Includes =link= option, expands noweb references (see [[*Noweb
+ Reference Syntax]]), and wraps them in link comments inside the body
+ of the code block.
+
+#+cindex: @samp{padline}, header argument
+The =padline= header argument controls insertion of newlines to pad
+source code in the tangled file.
+
+- =yes= ::
+
+ Default. Insert a newline before and after each code block in the
+ tangled file.
+
+- =no= ::
+
+ Do not insert newlines to pad the tangled code blocks.
+
+#+cindex: @samp{shebang}, header argument
+The =shebang= header argument can turn results into executable script
+files. By setting it to a string value---for example, =:shebang
+"#!/bin/bash"=---Org inserts that string as the first line of the
+tangled file that the code block is extracted to. Org then turns on
+the tangled file's executable permission.
+
+#+cindex: @samp{tangle-mode}, header argument
+The =tangle-mode= header argument specifies what permissions to set
+for tangled files by ~set-file-modes~. For example, to make
+a read-only tangled file, use =:tangle-mode (identity #o444)=. To
+make it executable, use =:tangle-mode (identity #o755)=. It also
+overrides executable permission granted by =shebang=. When multiple
+source code blocks tangle to a single file with different and
+conflicting =tangle-mode= header arguments, Org's behavior is
+undefined.
+
+#+cindex: @samp{no-expand}, header argument
+By default Org expands code blocks during tangling. The =no-expand=
+header argument turns off such expansions. Note that one side-effect
+of expansion by ~org-babel-expand-src-block~ also assigns values (see
+[[*Environment of a Code Block]]) to variables. Expansions also replace
+noweb references with their targets (see [[*Noweb Reference Syntax]]).
+Some of these expansions may cause premature assignment, hence this
+option. This option makes a difference only for tangling. It has no
+effect when exporting since code blocks for execution have to be
+expanded anyway.
+
+*** Functions
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- ~org-babel-tangle~ ::
+
+ #+findex: org-babel-tangle
+ #+kindex: C-c C-v t
+ Tangle the current file. Bound to {{{kbd(C-c C-v t)}}}.
+
+ With prefix argument only tangle the current code block.
+
+- ~org-babel-tangle-file~ ::
+
+ #+findex: org-babel-tangle-file
+ #+kindex: C-c C-v f
+ Choose a file to tangle. Bound to {{{kbd(C-c C-v f)}}}.
+
+*** Hooks
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- ~org-babel-post-tangle-hook~ ::
+
+ #+vindex: org-babel-post-tangle-hook
+ This hook is run from within code files tangled by
+ ~org-babel-tangle~, making it suitable for post-processing,
+ compilation, and evaluation of code in the tangled files.
+
+*** Jumping between code and Org
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+#+findex: org-babel-tangle-jump-to-org
+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
+~org-babel-tangle-jump-to-org~ function with two additional source
+code block header arguments:
+
+1. Set =padline= to true---this is the default setting.
+2. Set =comments= to =link=, which makes Org insert links to the Org
+ file.
+
+** Languages
+:PROPERTIES:
+:DESCRIPTION: List of supported code block languages.
+:END:
+#+cindex: babel, languages
+#+cindex: source code, languages
+#+cindex: code block, languages
+
+Code blocks in the following languages are supported.
+
+#+attr_texinfo: :columns 0.25 0.25 0.25 0.20
+| Language | Identifier | Language | Identifier |
+|------------+---------------+----------------+--------------|
+| Asymptote | =asymptote= | Lisp | =lisp= |
+| Awk | =awk= | Lua | =lua= |
+| C | =C= | MATLAB | =matlab= |
+| C++ | =C++=[fn:143] | Mscgen | =mscgen= |
+| Clojure | =clojure= | Objective Caml | =ocaml= |
+| CSS | =css= | Octave | =octave= |
+| D | =D=[fn:144] | Org mode | =org= |
+| ditaa | =ditaa= | Oz | =oz= |
+| Emacs Calc | =calc= | Perl | =perl= |
+| Emacs Lisp | =emacs-lisp= | Plantuml | =plantuml= |
+| Eshell | =eshell= | Processing.js | =processing= |
+| Fortran | =fortran= | Python | =python= |
+| Gnuplot | =gnuplot= | R | =R= |
+| GNU Screen | =screen= | Ruby | =ruby= |
+| Graphviz | =dot= | Sass | =sass= |
+| Haskell | =haskell= | Scheme | =scheme= |
+| Java | =java= | Sed | =sed= |
+| Javascript | =js= | shell | =sh= |
+| LaTeX | =latex= | SQL | =sql= |
+| Ledger | =ledger= | SQLite | =sqlite= |
+| Lilypond | =lilypond= | Vala | =vala= |
+
+Additional documentation for some languages is at
+https://orgmode.org/worg/org-contrib/babel/languages.html.
+
+#+vindex: org-babel-load-languages
+By default, only Emacs Lisp is enabled for evaluation. To enable or
+disable other languages, customize the ~org-babel-load-languages~
+variable either through the Emacs customization interface, or by
+adding code to the init file as shown next.
+
+In this example, evaluation is disabled for Emacs Lisp, and enabled
+for R.
+
+#+begin_src emacs-lisp
+(org-babel-do-load-languages
+ 'org-babel-load-languages
+ '((emacs-lisp . nil)
+ (R . t)))
+#+end_src
+
+Note that this is not the only way to enable a language. Org also
+enables languages when loaded with ~require~ statement. For example,
+the following enables execution of Clojure code blocks:
+
+#+begin_src emacs-lisp
+(require 'ob-clojure)
+#+end_src
+
+** Editing Source Code
+:PROPERTIES:
+:DESCRIPTION: Language major-mode editing.
+:END:
+#+cindex: code block, editing
+#+cindex: source code, editing
+
+#+kindex: C-c '
+Use {{{kbd(C-c ')}}} to edit the current code block. It opens a new
+major mode edit buffer containing the body of the source code block,
+ready for any edits. Use {{{kbd(C-c ')}}} again to close the buffer
+and return to the Org buffer.
+
+#+kindex: C-x C-s
+#+vindex: org-edit-src-auto-save-idle-delay
+#+cindex: auto-save, in code block editing
+{{{kbd(C-x C-s)}}} saves the buffer and updates the contents of the
+Org buffer. Set ~org-edit-src-auto-save-idle-delay~ to save the base
+buffer after a certain idle delay time. Set
+~org-edit-src-turn-on-auto-save~ to auto-save this buffer into
+a separate file using Auto-save mode.
+
+While editing the source code in the major mode, the Org Src minor
+mode remains active. It provides these customization variables as
+described below. For even more variables, look in the customization
+group ~org-edit-structure~.
+
+- ~org-src-lang-modes~ ::
+
+ #+vindex: org-src-lang-modes
+ If an Emacs major-mode named ~<LANG>-mode~ exists, where
+ {{{var(<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.
+
+- ~org-src-window-setup~ ::
+
+ #+vindex: org-src-window-setup
+ For specifying Emacs window arrangement when the new edit buffer is
+ created.
+
+- ~org-src-preserve-indentation~ ::
+
+ #+cindex: indentation, in code blocks
+ #+vindex: org-src-preserve-indentation
+ Default is ~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-~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.
+
+- ~org-src-ask-before-returning-to-edit-buffer~ ::
+
+ #+vindex: org-src-ask-before-returning-to-edit-buffer
+ When ~nil~, Org returns to the edit buffer without further prompts.
+ The default prompts for a confirmation.
+
+#+vindex: org-src-fontify-natively
+#+vindex: org-src-block-faces
+Set ~org-src-fontify-natively~ to non-~nil~ to turn on native code
+fontification in the /Org/ buffer. Fontification of code blocks can
+give visual separation of text and code on the display page. To
+further customize the appearance of ~org-block~ for specific
+languages, customize ~org-src-block-faces~. The following example
+shades the background of regular blocks, and colors source blocks only
+for Python and Emacs Lisp languages.
+
+#+begin_src emacs-lisp
+(require 'color)
+(set-face-attribute 'org-block nil :background
+ (color-darken-name
+ (face-attribute 'default :background) 3))
+
+(setq org-src-block-faces '(("emacs-lisp" (:background "#EEE2FF"))
+ ("python" (:background "#E5FFB8"))))
+#+end_src
+
+** Noweb Reference Syntax
+:PROPERTIES:
+:DESCRIPTION: Literate programming in Org mode.
+:END:
+#+cindex: code block, noweb reference
+#+cindex: syntax, noweb
+#+cindex: source code, noweb reference
+
+#+cindex: @samp{noweb-ref}, header argument
+Source code blocks can include references to other source code blocks,
+using a noweb[fn:145] style syntax:
+
+: <<CODE-BLOCK-ID>>
+
+#+texinfo: @noindent
+where {{{var(CODE-BLOCK-ID)}}} refers to either the =NAME= of a single
+source code block, or a collection of one or more source code blocks
+sharing the same =noweb-ref= header argument (see [[*Using Header
+Arguments]]). Org can replace such references with the source code of
+the block or blocks being referenced, or, in the case of a single
+source code block named with =NAME=, with the results of an evaluation
+of that block.
+
+#+cindex: @samp{noweb}, header argument
+The =noweb= header argument controls expansion of noweb syntax
+references. Expansions occur when source code blocks are evaluated,
+tangled, or exported.
+
+- =no= ::
+
+ Default. No expansion of noweb syntax references in the body of the
+ code when evaluating, tangling, or exporting.
+
+- =yes= ::
+
+ Expansion of noweb syntax references in the body of the code block
+ when evaluating, tangling, or exporting.
+
+- =tangle= ::
+
+ Expansion of noweb syntax references in the body of the code block
+ when tangling. No expansion when evaluating or exporting.
+
+- =no-export= ::
+
+ Expansion of noweb syntax references in the body of the code block
+ when evaluating or tangling. No expansion when exporting.
+
+- =strip-export= ::
+
+ Expansion of noweb syntax references in the body of the code block
+ when expanding prior to evaluating or tangling. Removes noweb
+ syntax references when exporting.
+
+- =eval= ::
+
+ Expansion of noweb syntax references in the body of the code block
+ only before evaluating.
+
+In the most simple case, the contents of a single source block is
+inserted within other blocks. Thus, in following example,
+
+#+begin_example
+,#+NAME: initialization
+,#+BEGIN_SRC emacs-lisp
+ (setq sentence "Never a foot too far, even.")
+,#+END_SRC
+
+,#+BEGIN_SRC emacs-lisp :noweb yes
+ <<initialization>>
+ (reverse sentence)
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+the second code block is expanded as
+
+#+begin_example
+,#+BEGIN_SRC emacs-lisp :noweb yes
+ (setq sentence "Never a foot too far, even.")
+ (reverse sentence)
+,#+END_SRC
+#+end_example
+
+You may also include the contents of multiple blocks sharing a common
+=noweb-ref= header argument, which can be set at the file, sub-tree,
+or code block level. In the example Org file shown next, the body of
+the source code in each block is extracted for concatenation to a pure
+code file when tangled.
+
+#+begin_example
+,#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh
+ <<fullest-disk>>
+,#+END_SRC
+,* the mount point of the fullest disk
+ :PROPERTIES:
+ :header-args: :noweb-ref fullest-disk
+ :END:
+
+,** query all mounted disks
+,#+BEGIN_SRC sh
+ df \
+,#+END_SRC
+
+,** strip the header row
+,#+BEGIN_SRC sh
+ |sed '1d' \
+,#+END_SRC
+
+,** output mount point of fullest disk
+,#+BEGIN_SRC sh
+ |awk '{if (u < +$5) {u = +$5; m = $6}} END {print m}'
+,#+END_SRC
+#+end_example
+
+#+cindex: @samp{noweb-sep}, header argument
+By default a newline separates each noweb reference concatenation. To
+use a different separator, edit the =noweb-sep= header argument.
+
+Alternatively, Org can include the results of evaluation of a single
+code block rather than its body. Evaluation occurs when parentheses,
+possibly including arguments, are appended to the code block name, as
+shown below.
+
+: <<NAME(optional arguments)>>
+
+Note that in this case, a code block name set by =NAME= keyword is
+required; the reference set by =noweb-ref= will not work when
+evaluation is desired.
+
+Here is an example that demonstrates how the exported content changes
+when noweb style references are used with parentheses versus without.
+Given:
+
+#+begin_example
+,#+NAME: some-code
+,#+BEGIN_SRC python :var num=0 :results output :exports none
+ print(num*10)
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+this code block:
+
+#+begin_example
+,#+BEGIN_SRC text :noweb yes
+ <<some-code>>
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+expands to:
+
+: print(num*10)
+
+Below, a similar noweb style reference is used, but with parentheses,
+while setting a variable =num= to 10:
+
+#+begin_example
+,#+BEGIN_SRC text :noweb yes
+ <<some-code(num=10)>>
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+Note that the expansion now contains the results of the code block
+=some-code=, not the code block itself:
+
+: 100
+
+Noweb insertions honor prefix characters that appear before the noweb
+syntax reference. This behavior is illustrated in the following
+example. Because the =<<example>>= noweb reference appears behind the
+SQL comment syntax, each line of the expanded noweb reference is
+commented. With:
+
+#+begin_example
+,#+NAME: example
+,#+BEGIN_SRC text
+ this is the
+ multi-line body of example
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+this code block:
+
+#+begin_example
+,#+BEGIN_SRC sql :noweb yes
+ ---<<example>>
+,#+END_SRC
+#+end_example
+
+#+texinfo: @noindent
+expands to:
+
+#+begin_example
+,#+BEGIN_SRC sql :noweb yes
+ ---this is the
+ ---multi-line body of example
+,#+END_SRC
+#+end_example
+
+Since this change does not affect noweb replacement text without
+newlines in them, inline noweb references are acceptable.
+
+This feature can also be used for management of indentation in
+exported code snippets. With:
+
+#+begin_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
+
+#+texinfo: @noindent
+this code block:
+
+#+begin_example
+,#+begin_src python :noweb yes :results output
+ if true:
+ <<if-true>>
+ else:
+ <<if-false>>
+,#+end_src
+#+end_example
+
+#+texinfo: @noindent
+expands to:
+
+#+begin_example
+if true:
+ print('do things when true')
+else:
+ print('do things when false')
+#+end_example
+
+When in doubt about the outcome of a source code block expansion, you
+can preview the results with the following command:
+
+- {{{kbd(C-c C-v v)}}} or {{{kbd(C-c C-v C-v)}}} (~org-babel-expand-src-block~) ::
+
+ #+findex: org-babel-expand-src-block
+ #+kindex: C-c C-v v
+ #+kindex: C-c C-v C-v
+ Expand the current source code block according to its header
+ arguments and pop open the results in a preview buffer.
+
+** Library of Babel
+:PROPERTIES:
+:DESCRIPTION: Use and contribute to a library of useful code blocks.
+:END:
+#+cindex: babel, library of
+#+cindex: source code, library
+#+cindex: code block, library
+
+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 [[https://orgmode.org/worg/library-of-babel.html][Worg]]. For
+remote code block evaluation syntax, see [[*Evaluating Code Blocks]].
+
+#+kindex: C-c C-v i
+#+findex: org-babel-lob-ingest
+For any user to add code to the library, first save the code in
+regular code blocks of an Org file, and then load the Org file with
+~org-babel-lob-ingest~, which is bound to {{{kbd(C-c C-v i)}}}.
+
+** Key bindings and Useful Functions
+:PROPERTIES:
+:DESCRIPTION: Work quickly with code blocks.
+:END:
+#+cindex: code block, key bindings
+
+Many common Org mode key sequences are re-bound depending on
+the context.
+
+Active key bindings in code blocks:
+
+#+kindex: C-c C-c
+#+findex: org-babel-execute-src-block
+#+kindex: C-c C-o
+#+findex: org-babel-open-src-block-result
+#+kindex: M-UP
+#+findex: org-babel-load-in-session
+#+kindex: M-DOWN
+#+findex: org-babel-pop-to-session
+#+attr_texinfo: :columns 0.2 0.55
+| Key binding | Function |
+|--------------------+-----------------------------------|
+| {{{kbd(C-c C-c)}}} | ~org-babel-execute-src-block~ |
+| {{{kbd(C-c C-o)}}} | ~org-babel-open-src-block-result~ |
+| {{{kbd(M-UP)}}} | ~org-babel-load-in-session~ |
+| {{{kbd(M-DOWN)}}} | ~org-babel-pop-to-session~ |
+
+Active key bindings in Org mode buffer:
+
+#+kindex: C-c C-v p
+#+kindex: C-c C-v C-p
+#+kindex: C-c C-v n
+#+kindex: C-c C-v C-n
+#+kindex: C-c C-v e
+#+kindex: C-c C-v C-e
+#+kindex: C-c C-v o
+#+kindex: C-c C-v C-o
+#+kindex: C-c C-v v
+#+kindex: C-c C-v C-v
+#+kindex: C-c C-v u
+#+kindex: C-c C-v C-u
+#+kindex: C-c C-v g
+#+kindex: C-c C-v C-g
+#+kindex: C-c C-v r
+#+kindex: C-c C-v C-r
+#+kindex: C-c C-v b
+#+kindex: C-c C-v C-b
+#+kindex: C-c C-v s
+#+kindex: C-c C-v C-s
+#+kindex: C-c C-v d
+#+kindex: C-c C-v C-d
+#+kindex: C-c C-v t
+#+kindex: C-c C-v C-t
+#+kindex: C-c C-v f
+#+kindex: C-c C-v C-f
+#+kindex: C-c C-v c
+#+kindex: C-c C-v C-c
+#+kindex: C-c C-v j
+#+kindex: C-c C-v C-j
+#+kindex: C-c C-v l
+#+kindex: C-c C-v C-l
+#+kindex: C-c C-v i
+#+kindex: C-c C-v C-i
+#+kindex: C-c C-v I
+#+kindex: C-c C-v C-I
+#+kindex: C-c C-v z
+#+kindex: C-c C-v C-z
+#+kindex: C-c C-v a
+#+kindex: C-c C-v C-a
+#+kindex: C-c C-v h
+#+kindex: C-c C-v C-h
+#+kindex: C-c C-v x
+#+kindex: C-c C-v C-x
+#+findex: org-babel-previous-src-block
+#+findex: org-babel-next-src-block
+#+findex: org-babel-execute-maybe
+#+findex: org-babel-open-src-block-result
+#+findex: org-babel-expand-src-block
+#+findex: org-babel-goto-src-block-head
+#+findex: org-babel-goto-named-src-block
+#+findex: org-babel-goto-named-result
+#+findex: org-babel-execute-buffer
+#+findex: org-babel-execute-subtree
+#+findex: org-babel-demarcate-block
+#+findex: org-babel-tangle
+#+findex: org-babel-tangle-file
+#+findex: org-babel-check-src-block
+#+findex: org-babel-insert-header-arg
+#+findex: org-babel-load-in-session
+#+findex: org-babel-lob-ingest
+#+findex: org-babel-view-src-block-info
+#+findex: org-babel-switch-to-session-with-code
+#+findex: org-babel-sha1-hash
+#+findex: org-babel-describe-bindings
+#+findex: org-babel-do-key-sequence-in-edit-buffer
+#+attr_texinfo: :columns 0.45 0.55
+| Key binding | Function |
+|------------------------------------------------+--------------------------------------------|
+| {{{kbd(C-c C-v p)}}} or {{{kbd(C-c C-v C-p)}}} | ~org-babel-previous-src-block~ |
+| {{{kbd(C-c C-v n)}}} or {{{kbd(C-c C-v C-n)}}} | ~org-babel-next-src-block~ |
+| {{{kbd(C-c C-v e)}}} or {{{kbd(C-c C-v C-e)}}} | ~org-babel-execute-maybe~ |
+| {{{kbd(C-c C-v o)}}} or {{{kbd(C-c C-v C-o)}}} | ~org-babel-open-src-block-result~ |
+| {{{kbd(C-c C-v v)}}} or {{{kbd(C-c C-v C-v)}}} | ~org-babel-expand-src-block~ |
+| {{{kbd(C-c C-v u)}}} or {{{kbd(C-c C-v C-u)}}} | ~org-babel-goto-src-block-head~ |
+| {{{kbd(C-c C-v g)}}} or {{{kbd(C-c C-v C-g)}}} | ~org-babel-goto-named-src-block~ |
+| {{{kbd(C-c C-v r)}}} or {{{kbd(C-c C-v C-r)}}} | ~org-babel-goto-named-result~ |
+| {{{kbd(C-c C-v b)}}} or {{{kbd(C-c C-v C-b)}}} | ~org-babel-execute-buffer~ |
+| {{{kbd(C-c C-v s)}}} or {{{kbd(C-c C-v C-s)}}} | ~org-babel-execute-subtree~ |
+| {{{kbd(C-c C-v d)}}} or {{{kbd(C-c C-v C-d)}}} | ~org-babel-demarcate-block~ |
+| {{{kbd(C-c C-v t)}}} or {{{kbd(C-c C-v C-t)}}} | ~org-babel-tangle~ |
+| {{{kbd(C-c C-v f)}}} or {{{kbd(C-c C-v C-f)}}} | ~org-babel-tangle-file~ |
+| {{{kbd(C-c C-v c)}}} or {{{kbd(C-c C-v C-c)}}} | ~org-babel-check-src-block~ |
+| {{{kbd(C-c C-v j)}}} or {{{kbd(C-c C-v C-j)}}} | ~org-babel-insert-header-arg~ |
+| {{{kbd(C-c C-v l)}}} or {{{kbd(C-c C-v C-l)}}} | ~org-babel-load-in-session~ |
+| {{{kbd(C-c C-v i)}}} or {{{kbd(C-c C-v C-i)}}} | ~org-babel-lob-ingest~ |
+| {{{kbd(C-c C-v I)}}} or {{{kbd(C-c C-v C-I)}}} | ~org-babel-view-src-block-info~ |
+| {{{kbd(C-c C-v z)}}} or {{{kbd(C-c C-v C-z)}}} | ~org-babel-switch-to-session-with-code~ |
+| {{{kbd(C-c C-v a)}}} or {{{kbd(C-c C-v C-a)}}} | ~org-babel-sha1-hash~ |
+| {{{kbd(C-c C-v h)}}} or {{{kbd(C-c C-v C-h)}}} | ~org-babel-describe-bindings~ |
+| {{{kbd(C-c C-v x)}}} or {{{kbd(C-c C-v C-x)}}} | ~org-babel-do-key-sequence-in-edit-buffer~ |
+
+** Batch Execution
+:PROPERTIES:
+:DESCRIPTION: Call functions from the command line.
+:END:
+#+cindex: code block, batch execution
+#+cindex: source code, batch execution
+
+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.
+
+The sample script shows batch processing of multiple files using
+~org-babel-tangle~.
+
+#+begin_example
+#!/bin/sh
+# Tangle files with Org mode
+#
+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
+
+* Miscellaneous
+:PROPERTIES:
+:DESCRIPTION: All the rest which did not fit elsewhere.
+:END:
+
+** Completion
+:PROPERTIES:
+:DESCRIPTION: @kbd{M-@key{TAB}} guesses completions.
+:END:
+#+cindex: completion, of @TeX{} symbols
+#+cindex: completion, of TODO keywords
+#+cindex: completion, of dictionary words
+#+cindex: completion, of option keywords
+#+cindex: completion, of tags
+#+cindex: completion, of property keys
+#+cindex: completion, of link abbreviations
+#+cindex: @TeX{} symbol completion
+#+cindex: TODO keywords completion
+#+cindex: dictionary word completion
+#+cindex: option keyword completion
+#+cindex: tag completion
+#+cindex: link abbreviations, completion of
+
+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 offers 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.
+
+- {{{kbd(M-TAB)}}} ::
+ #+kindex: M-TAB
+
+ Complete word at point.
+
+ - At the beginning of an empty headline, complete TODO keywords.
+
+ - After =\=, complete TeX symbols supported by the exporter.
+
+ - After =:= in a headline, complete tags. Org deduces the list of
+ tags from the =TAGS= in-buffer option (see [[*Setting Tags]]), the
+ variable ~org-tag-alist~, or from all tags used in the current
+ buffer.
+
+ - After =:= and not in a headline, complete property keys. The list
+ of keys is constructed dynamically from all keys used in the
+ current buffer.
+
+ - After =[[=, complete link abbreviations (see [[*Link Abbreviations]]).
+
+ - After =[[*=, complete headlines in the current buffer so that they
+ can be used in search links like: =[[*find this headline]]=
+
+ - After =#+=, complete the special keywords like =TYP_TODO= or
+ file-specific =OPTIONS=. After option keyword is complete,
+ pressing {{{kbd(M-TAB)}}} again inserts example settings for this
+ keyword.
+
+ - After =STARTUP= keyword, complete startup items.
+
+ - When point is anywhere else, complete dictionary words using
+ Ispell.
+
+** Structure Templates
+:PROPERTIES:
+:DESCRIPTION: Quick insertion of structural elements.
+:END:
+#+cindex: template insertion
+#+cindex: insertion, of templates
+
+With just a few keystrokes, it is possible to insert empty structural
+blocks, such as =#+BEGIN_SRC= ... =#+END_SRC=, or to wrap existing
+text in such a block.
+
+- {{{kbd(C-c C-\,)}}} (~org-insert-structure-template~) ::
+
+ #+findex: org-insert-structure-template
+ #+kindex: C-c C-,
+ Prompt for a type of block structure, and insert the block at point.
+ If the region is active, it is wrapped in the block. First prompts
+ the user for keys, which are used to look up a structure type from
+ the variable below. If the key is {{{kbd(TAB)}}}, {{{kbd(RET)}}},
+ or {{{kbd(SPC)}}}, the user is prompted to enter a block type.
+
+#+vindex: org-structure-template-alist
+Available structure types are defined in
+~org-structure-template-alist~, see the docstring for adding or
+changing values.
+
+#+cindex: Tempo
+#+cindex: template expansion
+#+cindex: insertion, of templates
+#+vindex: org-tempo-keywords-alist
+Org Tempo expands snippets to structures defined in
+~org-structure-template-alist~ and ~org-tempo-keywords-alist~. For
+example, {{{kbd(< s TAB)}}} creates a code block. Enable it by
+customizing ~org-modules~ or add =(require 'org-tempo)= to your Emacs
+init file[fn:146].
+
+#+attr_texinfo: :columns 0.1 0.9
+| {{{kbd(a)}}} | =#+BEGIN_EXPORT ascii= ... =#+END_EXPORT= |
+| {{{kbd(c)}}} | =#+BEGIN_CENTER= ... =#+END_CENTER= |
+| {{{kbd(C)}}} | =#+BEGIN_COMMENT= ... =#+END_COMMENT= |
+| {{{kbd(e)}}} | =#+BEGIN_EXAMPLE= ... =#+END_EXAMPLE= |
+| {{{kbd(E)}}} | =#+BEGIN_EXPORT= ... =#+END_EXPORT= |
+| {{{kbd(h)}}} | =#+BEGIN_EXPORT html= ... =#+END_EXPORT= |
+| {{{kbd(l)}}} | =#+BEGIN_EXPORT latex= ... =#+END_EXPORT= |
+| {{{kbd(q)}}} | =#+BEGIN_QUOTE= ... =#+END_QUOTE= |
+| {{{kbd(s)}}} | =#+BEGIN_SRC= ... =#+END_SRC= |
+| {{{kbd(v)}}} | =#+BEGIN_VERSE= ... =#+END_VERSE= |
+
+** Speed Keys
+:PROPERTIES:
+:DESCRIPTION: Electric commands at the beginning of a headline.
+:END:
+#+cindex: speed keys
+
+Single keystrokes can execute custom commands in an Org file when
+point 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
+key chords.
+
+#+vindex: org-use-speed-commands
+By default, Org has Speed Keys disabled. To activate Speed Keys, set
+the variable ~org-use-speed-commands~ to a non-~nil~ value. To
+trigger a Speed Key, point must be at the beginning of an Org
+headline, before any of the stars.
+
+#+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, ~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
+point is at the beginning of an Org headline, shows currently active
+Speed Keys, including the user-defined ones.
+
+** A Cleaner Outline View
+:PROPERTIES:
+:DESCRIPTION: Getting rid of leading stars in the outline.
+:ALT_TITLE: Clean View
+:END:
+#+cindex: hiding leading stars
+#+cindex: dynamic indentation
+#+cindex: odd-levels-only outlines
+#+cindex: clean outline view
+
+Org's outline with stars and no indents can look cluttered for short
+documents. For /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 displays only one
+star and indents text to line up with the heading:
+
+#+begin_example
+,* Top level headline | * Top level headline
+,** Second level | * Second level
+,*** Third level | * Third level
+some text | some text
+,*** Third level | * Third level
+more text | more text
+,* Another top level headline | * Another top level headline
+#+end_example
+
+Org can achieve this in two ways, (1) by just displaying the buffer in
+this way without changing it, or (2) by actually indenting every line
+in the desired amount with hard spaces and hiding leading stars.
+
+*** Org Indent Mode
+
+#+cindex: Indent mode
+#+findex: org-indent-mode
+To display the buffer in the indented view, activate Org Indent minor
+mode, using {{{kbd(M-x org-indent-mode)}}}. Text lines that are not
+headlines are prefixed with virtual spaces to vertically align with
+the headline text[fn:147].
+
+#+vindex: org-indent-indentation-per-level
+To make more horizontal space, the headlines are shifted by two
+characters. Configure ~org-indent-indentation-per-level~ variable for
+a different number.
+
+#+vindex: org-indent-mode-turns-on-hiding-stars
+#+vindex: org-indent-mode-turns-off-org-adapt-indentation
+By default, Org Indent mode turns off ~org-adapt-indentation~ and does
+hide leading stars by locally setting ~org-hide-leading-stars~ to ~t~:
+only one star on each headline is visible, the rest are masked with
+the same font color as the background. If you want to customize this
+default behavior, see ~org-indent-mode-turns-on-hiding-stars~ and
+~org-indent-mode-turns-off-org-adapt-indentation~.
+
+#+vindex: org-startup-indented
+To globally turn on Org Indent mode for all files, customize the
+variable ~org-startup-indented~. To control it for individual files,
+use =STARTUP= keyword as follows:
+
+: #+STARTUP: indent
+: #+STARTUP: noindent
+
+*** Hard indentation
+
+It is possible to use hard spaces to achieve the indentation instead,
+if the bare ASCII file should have the indented look also outside
+Emacs[fn:148]. With Org's support, you have to indent all lines to
+line up with the outline headers. You would use these
+settings[fn:149]:
+
+ #+begin_src emacs-lisp
+ (setq org-adapt-indentation t
+ org-hide-leading-stars t
+ org-odd-levels-only t)
+ #+end_src
+
+- /Indentation of text below headlines/ (~org-adapt-indentation~) ::
+
+ #+vindex: org-adapt-indentation
+ The first setting modifies paragraph filling, line wrapping, and
+ structure editing commands to preserving or adapting the indentation
+ as appropriate.
+
+- /Hiding leading stars/ (~org-hide-leading-stars~) ::
+
+ #+vindex: org-hide-leading-stars
+ #+vindex: org-hide, face
+ The second setting makes leading stars invisible by applying the
+ face ~org-hide~ to them. For per-file preference, use these file
+ =STARTUP= options:
+
+ #+begin_example
+ ,#+STARTUP: hidestars
+ ,#+STARTUP: showstars
+ #+end_example
+
+- /Odd levels/ (~org-odd-levels-only~) ::
+
+ #+vindex: org-odd-levels-only
+ The third setting makes Org use only odd levels, 1, 3, 5, ..., in
+ the outline to create more indentation. On a per-file level,
+ control this with:
+
+ #+begin_example
+ ,#+STARTUP: odd
+ ,#+STARTUP: oddeven
+ #+end_example
+
+ To convert a file between single and double stars layouts, use
+ {{{kbd(M-x org-convert-to-odd-levels)}}} and {{{kbd(M-x
+ org-convert-to-oddeven-levels)}}}.
+
+** Execute commands in the active region
+:PROPERTIES:
+:DESCRIPTION: Execute commands on multiple items in Org or agenda view.
+:END:
+
+#+vindex: org-loop-over-headlines-in-active-region
+When in an Org buffer and the region is active, some commands will
+apply to all the subtrees in the active region. For example, hitting
+{{{kbd(C-c C-s)}}} when multiple headlines are within the active region will
+successively prompt you for a new schedule date and time. To disable
+this, set the option ~org-loop-over-headlines-in-active-region~ to
+non-~t~, activate the region and run the command normally.
+
+#+vindex: org-agenda-loop-over-headlines-in-active-region
+~org-agenda-loop-over-headlines-in-active-region~ is the equivalent
+option of the agenda buffer, where you can also use [[*Bulk remote editing selected entries][bulk editing of
+selected entries]].
+
+Not all commands can loop in the active region and what subtrees or
+headlines are considered can be refined: see the docstrings of these
+options for more details.
+
+** Dynamic Headline Numbering
+:PROPERTIES:
+:DESCRIPTION: Display and update outline numbering.
+:END:
+
+#+cindex: Org Num mode
+#+cindex: number headlines
+The Org Num minor mode, toggled with {{{kbd(M-x org-num-mode)}}},
+displays outline numbering on top of headlines. It also updates it
+automatically upon changes to the structure of the document.
+
+#+vindex: org-num-max-level
+#+vindex: org-num-skip-tags
+#+vindex: org-num-skip-commented
+#+vindex: org-num-skip-unnumbered
+By default, all headlines are numbered. You can limit numbering to
+specific headlines according to their level, tags, =COMMENT= keyword,
+or =UNNUMBERED= property. Set ~org-num-max-level~,
+~org-num-skip-tags~, ~org-num-skip-commented~,
+~org-num-skip-unnumbered~, or ~org-num-skip-footnotes~ accordingly.
+
+#+vindex: org-num-skip-footnotes
+If ~org-num-skip-footnotes~ is non-~nil~, footnotes sections (see
+[[*Creating Footnotes]]) are not numbered either.
+
+#+vindex: org-num-face
+#+vindex: org-num-format-function
+You can control how the numbering is displayed by setting
+~org-num-face~ and ~org-num-format-function~.
+
+#+vindex: org-startup-numerated
+You can also turn this mode globally for all Org files by setting the
+option ~org-startup-numerated~ to =t=, or locally on a file by using
+=#+startup: num=.
+
+** The Very Busy {{{kbd(C-c C-c)}}} Key
+:PROPERTIES:
+:DESCRIPTION: When in doubt, press @kbd{C-c C-c}.
+:END:
+#+kindex: C-c C-c
+#+cindex: @kbd{C-c C-c}, overview
+
+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 throughout this
+manual, but here is a consolidated list for easy reference.
+
+- If column view (see [[*Column View]]) is on, exit column view.
+
+- If any highlights shown in the buffer from the creation of a sparse
+ tree, or from clock display, remove such highlights.
+
+- If point is in one of the special =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 =SETUPFILE=.
+
+- If point is inside a table, realign the table.
+
+- If point is on a =TBLFM= keyword, re-apply the formulas to the
+ entire table.
+
+- 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.
+
+- If point is on a =<<<target>>>=, update radio targets and
+ corresponding links in this buffer.
+
+- If point is on a property line or at the start or end of a property
+ drawer, offer property commands.
+
+- If point is at a footnote reference, go to the corresponding
+ definition, and /vice versa/.
+
+- If point is on a statistics cookie, update it.
+
+- If point is in a plain list item with a checkbox, toggle the status
+ of the checkbox.
+
+- If point is on a numbered item in a plain list, renumber the ordered
+ list.
+
+- If point is on the =#+BEGIN= line of a dynamic block, the block is
+ updated.
+
+- If point is at a timestamp, fix the day name in the timestamp.
+
+** Summary of In-Buffer Settings
+:PROPERTIES:
+:DESCRIPTION: Overview of keywords.
+:ALT_TITLE: In-buffer Settings
+:END:
+#+cindex: in-buffer settings
+#+cindex: special keywords
+
+In-buffer settings start with =#+=, 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.
+
+#+cindex: refresh set-up
+{{{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.
+
+#+attr_texinfo: :sep ,
+- =#+ARCHIVE: %s_done::= ::
+
+ #+cindex: @samp{ARCHIVE}, keyword
+ #+vindex: org-archive-location
+ Sets the archive location of the agenda file. The corresponding
+ variable is ~org-archive-location~.
+
+- =#+CATEGORY= ::
+
+ #+cindex: @samp{CATEGORY}, keyword
+ Sets the category of the agenda file, which applies to the entire
+ document.
+
+- =#+COLUMNS: %25ITEM ...= ::
+
+ #+cindex: @samp{COLUMNS}, property
+ Set the default format for columns view. This format applies when
+ columns view is invoked in locations where no =COLUMNS= property
+ applies.
+
+- =#+CONSTANTS: name1=value1 ...= ::
+
+ #+cindex: @samp{CONSTANTS}, keyword
+ #+vindex: org-table-formula-constants
+ #+vindex: org-table-formula
+ Set file-local values for constants that table formulas can use.
+ This line sets the local variable
+ ~org-table-formula-constants-local~. The global version of this
+ variable is ~org-table-formula-constants~.
+
+- =#+FILETAGS: :tag1:tag2:tag3:= ::
+
+ #+cindex: @samp{FILETAGS}, keyword
+ Set tags that all entries in the file inherit from, including the
+ top-level entries.
+
+- =#+LINK: linkword replace= ::
+
+ #+cindex: @samp{LINK}, keyword
+ #+vindex: org-link-abbrev-alist
+ Each line specifies one abbreviation for one link. Use multiple
+ =LINK= keywords for more, see [[*Link Abbreviations]]. The
+ corresponding variable is ~org-link-abbrev-alist~.
+
+- =#+PRIORITIES: highest lowest default= ::
+
+ #+cindex: @samp{PRIORITIES}, keyword
+ #+vindex: org-priority-highest
+ #+vindex: org-priority-lowest
+ #+vindex: org-priority-default
+ This line sets the limits and the default for the priorities. All
+ three must be either letters A--Z or numbers 0--9. The highest
+ priority must have a lower ASCII number than the lowest priority.
+
+- =#+PROPERTY: Property_Name Value= ::
+
+ #+cindex: @samp{PROPERTY}, keyword
+ This line sets a default inheritance value for entries in the
+ current buffer, most useful for specifying the allowed values of
+ a property.
+
+- =#+SETUPFILE: file= ::
+
+ #+cindex: @samp{SETUPFILE}, keyword
+ 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 parses and
+ loads the file, and also resets 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---use {{{kbd(C-c ')}}} while point is on the line with the
+ file name.
+
+- =#+STARTUP:= ::
+
+ #+cindex: @samp{STARTUP}, keyword
+ Startup options Org uses when first visiting a file.
+
+ #+vindex: org-startup-folded
+ The first set of options deals with the initial visibility of the
+ outline tree. The corresponding variable for global default
+ settings is ~org-startup-folded~ with a default value of
+ ~showeverything~.
+
+ | =overview= | Top-level headlines only. |
+ | =content= | All headlines. |
+ | =showall= | No folding on any entry. |
+ | =showeverything= | Show even drawer contents. |
+
+ #+vindex: org-startup-indented
+ Dynamic virtual indentation is controlled by the variable
+ ~org-startup-indented~[fn:150].
+
+ | =indent= | Start with Org Indent mode turned on. |
+ | =noindent= | Start with Org Indent mode turned off. |
+
+ #+vindex: org-startup-numerated
+ Dynamic virtual numeration of headlines is controlled by the variable
+ ~org-startup-numerated~.
+
+ | =num= | Start with Org num mode turned on. |
+ | =nonum= | Start with Org num mode turned off. |
+
+ #+vindex: org-startup-align-all-tables
+ Aligns tables consistently upon visiting a file. The
+ corresponding variable is ~org-startup-align-all-tables~ with
+ ~nil~ as default value.
+
+ | =align= | Align all tables. |
+ | =noalign= | Do not align tables on startup. |
+
+ #+vindex: org-startup-shrink-all-tables
+ Shrink table columns with a width cookie. The corresponding
+ variable is ~org-startup-shrink-all-tables~ with ~nil~ as
+ default value.
+
+ #+vindex: org-startup-with-inline-images
+ When visiting a file, inline images can be automatically
+ displayed. The corresponding variable is
+ ~org-startup-with-inline-images~, with a default value ~nil~ to
+ avoid delays when visiting a file.
+
+ | =inlineimages= | Show inline images. |
+ | =noinlineimages= | Do not show inline images on startup. |
+
+ #+vindex: org-log-done
+ #+vindex: org-log-note-clock-out
+ #+vindex: org-log-repeat
+ Logging the closing and reopening of TODO items and clock
+ intervals can be configured using these options (see variables
+ ~org-log-done~, ~org-log-note-clock-out~, and ~org-log-repeat~).
+
+ | =logdone= | Record a timestamp when an item is marked as done. |
+ | =lognotedone= | Record timestamp and a note when DONE. |
+ | =nologdone= | Do not record when items are marked as done. |
+ | =logrepeat= | Record a time when reinstating a repeating item. |
+ | =lognoterepeat= | Record a note when reinstating a repeating item. |
+ | =nologrepeat= | Do not record when reinstating repeating item. |
+ | =lognoteclock-out= | Record a note when clocking out. |
+ | =nolognoteclock-out= | Do not record a note when clocking out. |
+ | =logreschedule= | Record a timestamp when scheduling time changes. |
+ | =lognotereschedule= | Record a note when scheduling time changes. |
+ | =nologreschedule= | Do not record when a scheduling date changes. |
+ | =logredeadline= | Record a timestamp when deadline changes. |
+ | =lognoteredeadline= | Record a note when deadline changes. |
+ | =nologredeadline= | Do not record when a deadline date changes. |
+ | =logrefile= | Record a timestamp when refiling. |
+ | =lognoterefile= | Record a note when refiling. |
+ | =nologrefile= | Do not record when refiling. |
+
+ #+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 ~org-hide-leading-stars~ and
+ ~org-odd-levels-only~, both with a default setting ~nil~
+ (meaning =showstars= and =oddeven=).
+
+ | =hidestars= | Make all but one of the stars starting a headline invisible. |
+ | =showstars= | Show all stars starting a headline. |
+ | =indent= | Virtual indentation according to outline level. |
+ | =noindent= | No virtual indentation according to outline level. |
+ | =odd= | Allow only odd outline levels (1, 3, ...). |
+ | =oddeven= | Allow all outline levels. |
+
+ #+vindex: org-put-time-stamp-overlays
+ #+vindex: org-time-stamp-overlay-formats
+ To turn on custom format overlays over timestamps (variables
+ ~org-put-time-stamp-overlays~ and
+ ~org-time-stamp-overlay-formats~), use:
+
+ | =customtime= | Overlay custom time format. |
+
+ #+vindex: constants-unit-system
+ The following options influence the table spreadsheet (variable
+ ~constants-unit-system~).
+
+ | =constcgs= | =constants.el= should use the c-g-s unit system. |
+ | =constSI= | =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 ~org-footnote-define-inline~,
+ ~org-footnote-auto-label~, and ~org-footnote-auto-adjust~.
+
+ | =fninline= | Define footnotes inline. |
+ | =fnnoinline= | Define footnotes in separate section. |
+ | =fnlocal= | Define footnotes near first reference, but not inline. |
+ | =fnprompt= | Prompt for footnote labels. |
+ | =fnauto= | Create =[fn:1]=-like labels automatically (default). |
+ | =fnconfirm= | Offer automatic label for editing or confirmation. |
+ | =fnadjust= | Automatically renumber and sort footnotes. |
+ | =nofnadjust= | Do not renumber and sort automatically. |
+
+ #+vindex: org-hide-block-startup
+ To hide blocks on startup, use these keywords. The
+ corresponding variable is ~org-hide-block-startup~.
+
+ | =hideblocks= | Hide all begin/end blocks on startup. |
+ | =nohideblocks= | Do not hide blocks on startup. |
+
+ #+vindex: org-pretty-entities
+ The display of entities as UTF-8 characters is governed by the
+ variable ~org-pretty-entities~ and the keywords
+
+ | =entitiespretty= | Show entities as UTF-8 characters where possible. |
+ | =entitiesplain= | Leave entities plain. |
+
+- =#+TAGS: TAG1(c1) TAG2(c2)= ::
+
+ #+cindex: @samp{TAGS}, keyword
+ #+vindex: org-tag-alist
+ These lines (several such lines are allowed) specify the valid tags
+ in this file, and (potentially) the corresponding /fast tag
+ selection/ keys. The corresponding variable is ~org-tag-alist~.
+
+- =#+TODO:=, =#+SEQ_TODO:=, =#+TYP_TODO:= ::
+
+ #+cindex: @samp{SEQ_TODO}, keyword
+ #+cindex: @samp{TODO}, keyword
+ #+cindex: @samp{TYP_TODO}, keyword
+ #+vindex: org-todo-keywords
+ These lines set the TODO keywords and their interpretation in the
+ current file. The corresponding variable is ~org-todo-keywords~.
+
+** Org Syntax
+:PROPERTIES:
+:DESCRIPTION: Formal description of Org's syntax.
+:END:
+
+A reference document providing a formal description of Org's syntax is
+available as [[https://orgmode.org/worg/dev/org-syntax.html][a draft on Worg]], written and maintained by Nicolas
+Goaziou. It defines Org's core internal concepts such as "headlines",
+"sections", "affiliated keywords", "(greater) elements" and "objects".
+Each part of an Org document belongs to one of the previous
+categories.
+
+To explore the abstract structure of an Org buffer, run this in
+a buffer:
+
+: M-: (org-element-parse-buffer) <RET>
+
+#+texinfo: @noindent
+It outputs a list containing the buffer's content represented as an
+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.
+
+#+cindex: syntax checker
+#+cindex: linter
+#+findex: org-lint
+You can probe the syntax of your documents with the command
+
+: M-x org-lint <RET>
+
+#+texinfo: @noindent
+It runs a number of checks to find common mistakes. It then displays
+their location in a dedicated buffer, along with a description and
+a "trust level", since false-positive are possible. From there, you
+can operate on the reports with the following keys:
+
+#+attr_texinfo: :columns 0.22 0.78
+| {{{kbd(C-j)}}}, {{{kbd(TAB)}}} | Display the offending line |
+| {{{kbd(RET)}}} | Move point to the offending line |
+| {{{kbd(g)}}} | Check the document again |
+| {{{kbd(h)}}} | Hide all reports from the same checker |
+| {{{kbd(i)}}} | Also remove them from all subsequent checks |
+| {{{kbd(S)}}} | Sort reports by the column at point |
+
+** Context Dependent Documentation
+:PROPERTIES:
+:DESCRIPTION: Read documentation about current syntax.
+:ALT_TITLE: Documentation Access
+:END:
+#+cindex: documentation
+#+cindex: Info
+
+#+findex: org-info-find-node
+#+kindex: C-c C-x I
+{{{kbd(C-c C-x I)}}} in an Org file tries to open a suitable section
+of the Org manual depending on the syntax at point. For example,
+using it on a headline displays "Document Structure" section.
+
+{{{kbd(q)}}} closes the Info window.
+
+** Escape Character
+:PROPERTIES:
+:DESCRIPTION: Prevent Org from interpreting your writing.
+:END:
+
+#+cindex: escape character
+#+cindex: zero width space
+You may sometimes want to write text that looks like Org syntax, but
+should really read as plain text. Org may use a specific escape
+character in some situations, i.e., a backslash in macros (see [[*Macro
+Replacement]]) and links (see [[*Link Format]]), or a comma in source and
+example blocks (see [[*Literal Examples]]). In the general case, however,
+we suggest to use the zero width space. You can insert one with any
+of the following:
+
+: C-x 8 <RET> zero width space <RET>
+: C-x 8 <RET> 200B <RET>
+
+For example, in order to write =[[1,2]]= as-is in your document, you
+may write instead
+
+: [X[1,2]]
+
+where =X= denotes the zero width space character.
+
+** Code Evaluation and Security Issues
+:PROPERTIES:
+:DESCRIPTION: Org files evaluate in-line code.
+:ALT_TITLE: Code Evaluation Security
+:END:
+
+Unlike plain text, running code comes with risk. Each source 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 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.
+
+Org evaluates code in the following circumstances:
+
+- /Source code blocks/ ::
+
+ Org evaluates source code blocks in an Org file during export. Org
+ also evaluates a source 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.
+
+ #+attr_texinfo: :options org-confirm-babel-evaluate
+ #+begin_defopt
+ When ~t~, Org prompts the user for confirmation before executing
+ each code block. When ~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 ~t~ or ~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 blocks without
+ prompting:
+
+ #+begin_src emacs-lisp
+ (defun my-org-confirm-babel-evaluate (lang body)
+ (not (string= lang "ditaa"))) ;don't ask for ditaa
+ (setq org-confirm-babel-evaluate #'my-org-confirm-babel-evaluate)
+ #+end_src
+
+- /Following =shell= and =elisp= links/ ::
+
+ Org has two link types that can directly evaluate code (see
+ [[*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:
+
+ #+attr_texinfo: :options org-link-shell-confirm-function
+ #+begin_defopt
+ Function that prompts the user before executing a shell link.
+ #+end_defopt
+
+ #+attr_texinfo: :options org-link-elisp-confirm-function
+ #+begin_defopt
+ Function that prompts the user before executing an Emacs Lisp link.
+ #+end_defopt
+
+- /Formulas in tables/ ::
+
+ Formulas in tables (see [[*The Spreadsheet]]) are code that is evaluated
+ either by the Calc interpreter, or by the Emacs Lisp interpreter.
+
+** Interaction with Other Packages
+:PROPERTIES:
+:DESCRIPTION: With other Emacs packages.
+:ALT_TITLE: Interaction
+:END:
+#+cindex: packages, interaction with other
+
+Org's compatibility and the level of interaction with other Emacs
+packages are documented here.
+
+*** Packages that Org cooperates with
+:PROPERTIES:
+:DESCRIPTION: Packages Org cooperates with.
+:ALT_TITLE: Cooperation
+:END:
+
+- =calc.el= by Dave Gillespie ::
+ #+cindex: @file{calc.el}
+
+ Org uses the Calc package for implementing spreadsheet functionality
+ in its tables (see [[*The Spreadsheet]]). Org also uses Calc for
+ embedded calculations. See [[info:calc::Embedded Mode][GNU Emacs Calc Manual]].
+
+- =constants.el= by Carsten Dominik ::
+ #+cindex: @file{constants.el}
+ #+vindex: org-table-formula-constants
+
+ Org can use names for constants in formulas in tables. Org can also
+ use calculation suffixes for units, such as =M= for =Mega=. For
+ a standard collection of such constants, install the =constants=
+ package. Install version 2.0 of this package, available at
+ [[http://www.astro.uva.nl/~dominik/Tools]]. Org checks if the function
+ ~constants-get~ has been autoloaded. Installation instructions are
+ in the file =constants.el=.
+
+- =cdlatex.el= by Carsten Dominik ::
+ #+cindex: @file{cdlatex.el}
+
+ Org mode can make use of the CDLaTeX package to efficiently enter
+ LaTeX fragments into Org files. See [[*Using CDLaTeX to enter math]].
+
+- =imenu.el= by Ake Stenhoff and Lars Lindberg ::
+ #+cindex: @file{imenu.el}
+
+ 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:
+
+ #+begin_src emacs-lisp
+ (add-hook 'org-mode-hook
+ (lambda () (imenu-add-to-menubar "Imenu")))
+ #+end_src
+
+ #+vindex: org-imenu-depth
+ By default the index is two levels deep---you can modify the
+ depth using the option ~org-imenu-depth~.
+
+- =speedbar.el= by Eric\nbsp{}M.\nbsp{}Ludlam ::
+ #+cindex: @file{speedbar.el}
+
+ 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.
+
+- =table.el= by Takaaki Ota ::
+ #+cindex: table editor, @file{table.el}
+ #+cindex: @file{table.el}
+
+ Complex ASCII tables with automatic line wrapping, column- and
+ row-spanning, and alignment can be created using the Emacs table
+ package by Takaaki Ota. Org mode recognizes such tables and exports
+ them properly. {{{kbd(C-c ')}}} to edit these tables in a special
+ buffer, much like Org's code blocks. Because of interference with
+ other Org mode functionality, Takaaki Ota tables cannot be edited
+ directly in the Org buffer.
+
+ - {{{kbd(C-c ')}}} (~org-edit-special~) ::
+
+ #+kindex: C-c '
+ #+findex: org-edit-special
+ Edit a =table.el= table. Works when point is in a =table.el=
+ table.
+
+ - {{{kbd(C-c ~​)}}} (~org-table-create-with-table.el~) ::
+
+ #+kindex: C-c ~
+ #+findex: org-table-create-with-table.el
+ Insert a =table.el= table. If there is already a table at point,
+ this command converts it between the =table.el= format and the Org
+ mode format. See the documentation string of the command
+ ~org-convert-table~ for the restrictions under which this is
+ possible.
+
+*** Packages that conflict with Org mode
+:PROPERTIES:
+:DESCRIPTION: Packages that lead to conflicts.
+:ALT_TITLE: Conflicts
+:END:
+
+#+cindex: shift-selection
+#+vindex: org-support-shift-select
+In Emacs, shift-selection combines motions of point with shift key to
+enlarge regions. Emacs sets this mode by default. This conflicts
+with Org's use of {{{kbd(S-<cursor>)}}} commands to change timestamps,
+TODO keywords, priorities, and item bullet types, etc. Since
+{{{kbd(S-<cursor>)}}} commands outside of specific contexts do not do
+anything, Org offers the variable ~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 point
+moves across a special context.
+
+- =cua.el= by Kim\nbsp{}F.\nbsp{}Storm ::
+
+ #+cindex: @file{cua.el}
+ #+vindex: org-replace-disputed-keys
+ 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 ~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.
+
+ #+attr_texinfo: :columns 0.4 0.4
+ | {{{kbd(S-UP)}}} \rArr{} {{{kbd(M-p)}}} | {{{kbd(S-DOWN)}}} \rArr{} {{{kbd(M-n)}}} |
+ | {{{kbd(S-LEFT)}}} \rArr{} {{{kbd(M--)}}} | {{{kbd(S-RIGHT)}}} \rArr{} {{{kbd(M-+)}}} |
+ | {{{kbd(C-S-LEFT)}}} \rArr{} {{{kbd(M-S--)}}} | {{{kbd(C-S-RIGHT)}}} \rArr{} {{{kbd(M-S-+)}}} |
+
+ #+vindex: org-disputed-keys
+ Yes, these are unfortunately more difficult to remember. If you
+ want to have other replacement keys, look at the variable
+ ~org-disputed-keys~.
+
+- =ecomplete.el= by Lars Magne Ingebrigtsen ::
+
+ #+cindex: @file{ecomplete.el}
+ Ecomplete provides "electric" address completion in address header
+ lines in message buffers. Sadly Orgtbl mode cuts Ecomplete's power
+ supply: no completion happens when Orgtbl mode is enabled in message
+ buffers while entering text in address header lines. If one wants
+ to use ecomplete one should /not/ follow the advice to automagically
+ turn on Orgtbl mode in message buffers (see [[*The Orgtbl Minor Mode]]),
+ but instead---after filling in the message headers---turn on Orgtbl
+ mode manually when needed in the messages body.
+
+- =filladapt.el= by Kyle Jones ::
+
+ #+cindex: @file{filladapt.el}
+ Org mode tries to do the right thing when filling paragraphs, list
+ items and other elements. Many users reported problems using both
+ =filladapt.el= and Org mode, so a safe thing to do is to disable
+ filladapt like this:
+
+ #+begin_src emacs-lisp
+ (add-hook 'org-mode-hook 'turn-off-filladapt-mode)
+ #+end_src
+
+- =viper.el= by Michael Kifer ::
+ #+cindex: @file{viper.el}
+ #+kindex: C-c /
+
+ Viper uses {{{kbd(C-c /)}}} and therefore makes this key not access
+ the corresponding Org mode command ~org-sparse-tree~. You need to
+ find another key for this command, or override the key in
+ ~viper-vi-global-user-map~ with
+
+ #+begin_src emacs-lisp
+ (define-key viper-vi-global-user-map "C-c /" 'org-sparse-tree)
+ #+end_src
+
+- =windmove.el= by Hovav Shacham ::
+ #+cindex: @file{windmove.el}
+
+ This package also uses the {{{kbd(S-<cursor>)}}} keys, so everything
+ written in the paragraph above about CUA mode also applies here. If
+ you want to make the windmove function active in locations where Org
+ mode does not have special functionality on {{{kbd(S-<cursor>)}}},
+ add this to your configuration:
+
+ #+begin_src emacs-lisp
+ ;; Make windmove work in Org mode:
+ (add-hook 'org-shiftup-final-hook 'windmove-up)
+ (add-hook 'org-shiftleft-final-hook 'windmove-left)
+ (add-hook 'org-shiftdown-final-hook 'windmove-down)
+ (add-hook 'org-shiftright-final-hook 'windmove-right)
+ #+end_src
+
+- =yasnippet.el= ::
+
+ #+cindex: @file{yasnippet.el}
+ The way Org mode binds the {{{kbd(TAB)}}} key (binding to ~[tab]~
+ instead of ~"\t"~) overrules YASnippet's access to this key. The
+ following code fixed this problem:
+
+ #+begin_src emacs-lisp
+ (add-hook 'org-mode-hook
+ (lambda ()
+ (setq-local yas/trigger-key [tab])
+ (define-key yas/keymap [tab] 'yas/next-field-or-maybe-expand)))
+ #+end_src
+
+ The latest version of YASnippet does not play well with Org mode.
+ If the above code does not fix the conflict, start by defining
+ the following function:
+
+ #+begin_src emacs-lisp
+ (defun yas/org-very-safe-expand ()
+ (let ((yas/fallback-behavior 'return-nil)) (yas/expand)))
+ #+end_src
+
+ Then, tell Org mode to use that function:
+
+ #+begin_src emacs-lisp
+ (add-hook 'org-mode-hook
+ (lambda ()
+ (make-variable-buffer-local 'yas/trigger-key)
+ (setq yas/trigger-key [tab])
+ (add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand)
+ (define-key yas/keymap [tab] 'yas/next-field)))
+ #+end_src
+** Using Org on a TTY
+:PROPERTIES:
+:DESCRIPTION: Using Org on a tty.
+:ALT_TITLE: TTY Keys
+:END:
+#+cindex: tty key bindings
+
+Org provides alternative key bindings for TTY and modern mobile
+devices that cannot perform movement commands on point and key
+bindings with modifier keys. 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-<cursor>)}}} for editing timestamp might be better with
+{{{kbd(C-c .)}}} chord.
+
+#+attr_texinfo: :columns 0.2 0.28 0.15 0.21
+| Default | Alternative 1 | Speed key | Alternative 2 |
+|----------------------+--------------------------+--------------+----------------------|
+| {{{kbd(S-TAB)}}} | {{{kbd(C-u TAB)}}} | {{{kbd(C)}}} | |
+| {{{kbd(M-LEFT)}}} | {{{kbd(C-c C-x l)}}} | {{{kbd(l)}}} | {{{kbd(Esc LEFT)}}} |
+| {{{kbd(M-S-LEFT)}}} | {{{kbd(C-c C-x L)}}} | {{{kbd(L)}}} | |
+| {{{kbd(M-RIGHT)}}} | {{{kbd(C-c C-x r)}}} | {{{kbd(r)}}} | {{{kbd(Esc RIGHT)}}} |
+| {{{kbd(M-S-RIGHT)}}} | {{{kbd(C-c C-x R)}}} | {{{kbd(R)}}} | |
+| {{{kbd(M-UP)}}} | {{{kbd(C-c C-x u)}}} | | {{{kbd(Esc UP)}}} |
+| {{{kbd(M-S-UP)}}} | {{{kbd(C-c C-x U)}}} | {{{kbd(U)}}} | |
+| {{{kbd(M-DOWN)}}} | {{{kbd(C-c C-x d)}}} | | {{{kbd(Esc DOWN)}}} |
+| {{{kbd(M-S-DOWN)}}} | {{{kbd(C-c C-x D)}}} | {{{kbd(D)}}} | |
+| {{{kbd(S-RET)}}} | {{{kbd(C-c C-x c)}}} | | |
+| {{{kbd(M-RET)}}} | {{{kbd(C-c C-x m)}}} | | {{{kbd(Esc RET)}}} |
+| {{{kbd(M-S-RET)}}} | {{{kbd(C-c C-x M)}}} | | |
+| {{{kbd(S-LEFT)}}} | {{{kbd(C-c LEFT)}}} | | |
+| {{{kbd(S-RIGHT)}}} | {{{kbd(C-c RIGHT)}}} | | |
+| {{{kbd(S-UP)}}} | {{{kbd(C-c UP)}}} | | |
+| {{{kbd(S-DOWN)}}} | {{{kbd(C-c DOWN)}}} | | |
+| {{{kbd(C-S-LEFT)}}} | {{{kbd(C-c C-x LEFT)}}} | | |
+| {{{kbd(C-S-RIGHT)}}} | {{{kbd(C-c C-x RIGHT)}}} | | |
+
+** Protocols for External Access
+:PROPERTIES:
+:DESCRIPTION: External access to Emacs and Org.
+:ALT_TITLE: Protocols
+:END:
+#+cindex: protocols, for external access
+
+Org protocol is a tool 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 (see [[*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
+=org-protocol://= as a valid scheme-handler. External calls are
+passed to Emacs through the =emacsclient= command, so you also need to
+ensure an Emacs server is running. More precisely, when the
+application calls
+
+: emacsclient org-protocol://PROTOCOL?key1=val1&key2=val2
+
+#+texinfo: @noindent
+Emacs calls the handler associated to {{{var(PROTOCOL)}}} with
+argument =(: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 ~org-protocol-protocol-alist~ to define
+your own.
+
+*** The ~store-link~ protocol
+:PROPERTIES:
+:DESCRIPTION: Store a link, push URL to kill-ring.
+:END:
+#+cindex: store-link protocol
+#+cindex: protocol, store-link
+
+Using the ~store-link~ handler, you can copy links, to that they can
+be inserted using {{{kbd(M-x org-insert-link)}}} or yanking. More
+precisely, the command
+
+: emacsclient org-protocol://store-link?url=URL&title=TITLE
+
+#+texinfo: @noindent
+stores the following link:
+
+: [[URL][TITLE]]
+
+In addition, {{{var(URL)}}} is pushed on the kill-ring for yanking.
+You need to encode {{{var(URL)}}} and {{{var(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., =Org: store-link= and enter this as /Location/:
+
+#+begin_example
+javascript:location.href='org-protocol://store-link?url='+
+ encodeURIComponent(location.href);
+#+end_example
+
+*** The ~capture~ protocol
+:PROPERTIES:
+:DESCRIPTION: Fill a buffer with external information.
+:END:
+#+cindex: capture protocol
+#+cindex: protocol, capture
+
+Activating the "capture" handler pops up a =Capture= buffer in Emacs,
+using acapture template.
+
+: emacsclient org-protocol://capture?template=X?url=URL?title=TITLE?body=BODY
+
+To use this feature, add a bookmark with an arbitrary name, e.g.,
+=Org: capture=, and enter this as =Location=:
+
+#+begin_example
+javascript:location.href='org-protocol://capture?template=x'+
+ '&url='+encodeURIComponent(window.location.href)+
+ '&title='+encodeURIComponent(document.title)+
+ '&body='+encodeURIComponent(window.getSelection());
+#+end_example
+
+#+vindex: org-protocol-default-template-key
+The capture template to be used can be specified in the bookmark (like
+=X= above). If unspecified, the template key is set in the variable
+~org-protocol-default-template-key~. The following template
+placeholders are available:
+
+#+begin_example
+%:link The URL
+%:description The webpage title
+%:annotation Equivalent to [[%:link][%:description]]
+%i The selected text
+#+end_example
+
+*** The ~open-source~ protocol
+:PROPERTIES:
+:DESCRIPTION: Edit published contents.
+:END:
+#+cindex: open-source protocol
+#+cindex: protocol, open-source
+
+The ~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:
+
+#+begin_example
+javascript:location.href='org-protocol://open-source?&url='+
+ encodeURIComponent(location.href)
+#+end_example
+
+#+vindex: org-protocol-project-alist
+The variable ~org-protocol-project-alist~ maps URLs to local file
+names, by stripping URL parameters from the end and replacing the
+~:base-url~ with ~:working-directory~ and ~:online-suffix~ with
+~:working-suffix~. For example, assuming you own a local copy of
+=https://orgmode.org/worg/= contents at =/home/user/worg=, you can set
+~org-protocol-project-alist~ to the following
+
+#+begin_src emacs-lisp
+(setq org-protocol-project-alist
+ '(("Worg"
+ :base-url "https://orgmode.org/worg/"
+ :working-directory "/home/user/worg/"
+ :online-suffix ".html"
+ :working-suffix ".org")))
+#+end_src
+
+#+texinfo: @noindent
+If you are now browsing
+=https://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: rewritten URL in open-source protocol
+#+cindex: protocol, open-source rewritten URL
+However, such mapping may not always yield the desired results.
+Suppose you maintain an online store located at =http://example.com/=.
+The local sources reside in =/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 =http://example.com/print/posters.html= might be
+rewritten on the server to something like
+=http://example.com/shop/products.php/posters.html.php=. The
+~open-source~ handler probably cannot find a file named
+=/home/user/example/print/posters.html.php= and fails.
+
+Such an entry in ~org-protocol-project-alist~ may hold an additional
+property ~:rewrites~. This property is a list of cons cells, each of
+which maps a regular expression to a path relative to the
+~:working-directory~.
+
+Now map the URL to the path =/home/user/example/products.php= by
+adding ~:rewrites~ rules like this:
+
+#+begin_src emacs-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_src
+
+#+texinfo: @noindent
+Since =example.com/$= is used as a regular expression, it maps
+=http://example.com/=, =https://example.com=,
+=http://www.example.com/= and similar to
+=/home/user/example/index.php=.
+
+The ~: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: mappings in open-source protocol
+#+findex: org-protocol-create
+#+findex: org-protocol-create-for-org
+Two functions can help you filling ~org-protocol-project-alist~ with
+valid contents: ~org-protocol-create~ and
+~org-protocol-create-for-org~. The latter is of use if you're editing
+an Org file that is part of a publishing project.
+** Org Crypt
+:PROPERTIES:
+:DESCRIPTION: Encrypting Org files.
+:END:
+
+Org Crypt encrypts the text of an entry, but not the headline, or
+properties. Behind the scene, it uses the Emacs EasyPG library to
+encrypt and decrypt files.
+
+#+vindex: org-crypt-tag-matcher
+Any text below a headline that has a =crypt= tag is automatically
+encrypted when the file is saved. To use a different tag, customize
+the ~org-crypt-tag-matcher~ setting.
+
+Here is a suggestion for Org Crypt settings in Emacs init file:
+
+#+begin_src emacs-lisp
+(require 'org-crypt)
+(org-crypt-use-before-save-magic)
+(setq org-tags-exclude-from-inheritance '("crypt"))
+
+(setq org-crypt-key nil)
+;; GPG key to use for encryption
+;; Either the Key ID or set to nil to use symmetric encryption.
+
+(setq auto-save-default nil)
+;; Auto-saving does not cooperate with org-crypt.el: so you need to
+;; turn it off if you plan to use org-crypt.el quite often. Otherwise,
+;; you'll get an (annoying) message each time you start Org.
+
+;; To turn it off only locally, you can insert this:
+;;
+;; # -*- buffer-auto-save-file-name: nil; -*-
+#+end_src
+
+It's possible to use different keys for different headings by
+specifying the respective key as property =CRYPTKEY=, e.g.:
+
+#+begin_example
+,* Totally secret :crypt:
+ :PROPERTIES:
+ :CRYPTKEY: 0x0123456789012345678901234567890123456789
+ :END:
+#+end_example
+
+Excluding the =crypt= tag from inheritance prevents already encrypted
+text from being encrypted again.
+
+** Org Mobile
+:PROPERTIES:
+:DESCRIPTION: Viewing and capture on a mobile device.
+:END:
+#+cindex: smartphone
+
+Org Mobile is a protocol for synchronizing Org files between Emacs and
+other applications, e.g., on mobile devices. It enables offline-views
+and capture support for an Org mode system that is rooted on a "real"
+computer. The external application can also record changes to
+existing entries.
+
+This appendix describes Org's support for agenda view formats
+compatible with Org Mobile. It also describes synchronizing changes,
+such as to notes, between the mobile application and the computer.
+
+To change tags and TODO states in the mobile application, first
+customize the variables ~org-todo-keywords~, ~org-tag-alist~ and
+~org-tag-persistent-alist~. These should cover all the important tags
+and TODO keywords, even if Org files use only some of them. Though
+the mobile application is expected to support in-buffer settings, it
+is required to understand TODO states /sets/ (see [[*Setting up keywords
+for individual files]]) and /mutually exclusive/ tags (see [[*Setting
+Tags]]) only for those set in these variables.
+
+*** Setting up the staging area
+:PROPERTIES:
+:DESCRIPTION: For the mobile device.
+:END:
+
+#+vindex: org-mobile-directory
+The mobile application needs access to a file directory on
+a server[fn:151] to interact with Emacs. Pass its location through
+the ~org-mobile-directory~ variable. If you can mount that directory
+locally just set the variable to point to that directory:
+
+#+begin_src emacs-lisp
+(setq org-mobile-directory "~/orgmobile/")
+#+end_src
+
+Alternatively, by using TRAMP (see [[info:tramp][TRAMP User Manual]]),
+~org-mobile-directory~ may point to a remote directory accessible
+through, for example, SSH, SCP, or DAVS:
+
+#+begin_src emacs-lisp
+(setq org-mobile-directory "/davs:user@remote.host:/org/webdav/")
+#+end_src
+
+#+vindex: org-mobile-encryption
+With a public server, consider encrypting the files. Org also
+requires OpenSSL installed on the local computer. To turn on
+encryption, set the same password in the mobile application and in
+Emacs. Set the password in the variable
+~org-mobile-use-encryption~[fn:152]. Note that even after the mobile
+application encrypts the file contents, the file name remains visible
+on the file systems of the local computer, the server, and the mobile
+device.
+
+*** Pushing to the mobile application
+:PROPERTIES:
+:DESCRIPTION: Uploading Org files and agendas.
+:END:
+
+#+findex: org-mobile-push
+#+vindex: org-mobile-files
+The command ~org-mobile-push~ copies files listed in
+~org-mobile-files~ into the staging area. Files include agenda files
+(as listed in ~org-agenda-files~). Customize ~org-mobile-files~ to
+add other files. File names are staged with paths relative to
+~org-directory~, so all files should be inside this directory[fn:153].
+
+Push creates a special Org file =agendas.org= with custom agenda views
+defined by the user[fn:154].
+
+Finally, Org writes the file =index.org=, containing links to other
+files. The mobile application reads this file first from the server
+to determine what other files to download for agendas. For faster
+downloads, it is expected to only read files whose checksums[fn:155]
+have changed.
+
+*** Pulling from the mobile application
+:PROPERTIES:
+:DESCRIPTION: Integrating captured and flagged items.
+:END:
+
+#+findex: org-mobile-pull
+The command ~org-mobile-pull~ synchronizes changes with the server.
+More specifically, it first pulls the Org files for viewing. It then
+appends captured entries and pointers to flagged or changed entries to
+the file =mobileorg.org= on the server. Org ultimately integrates its
+data in an inbox file format, through the following steps:
+
+1.
+ #+vindex: org-mobile-inbox-for-pull
+ Org moves all entries found in =mobileorg.org=[fn:156] and appends
+ them to the file pointed to by the variable
+ ~org-mobile-inbox-for-pull~. It should reside neither in the
+ staging area nor on the server. Each captured entry and each
+ editing event is a top-level entry in the inbox file.
+
+2.
+ #+cindex: @samp{FLAGGED}, tag
+ After moving the entries, Org processes changes to the shared
+ files. Some of them are applied directly and without user
+ interaction. Examples include changes to tags, TODO state,
+ headline and body text. Entries requiring further action are
+ tagged as =FLAGGED=. Org marks entries with problems with an error
+ message in the inbox. They have to be resolved manually.
+
+3. Org generates an agenda view for flagged entries for user
+ intervention to clean up. For notes stored in flagged entries, Org
+ displays them in the echo area when point is on the corresponding
+ agenda item.
+
+ - {{{kbd(?)}}} ::
+
+ 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
+ =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.
+
+#+kindex: ? @r{(Agenda dispatcher)}
+From the agenda dispatcher, {{{kbd(?)}}} returns to the view to finish
+processing flagged entries. Note that these entries may not be the
+most recent since the mobile application searches files that were last
+pulled. To get an updated agenda view with changes since the last
+pull, pull again.
+
+* Hacking
+:PROPERTIES:
+:DESCRIPTION: How to hack your way around.
+:APPENDIX: t
+:END:
+#+cindex: hacking
+
+This appendix describes some ways a user can extend the functionality
+of Org.
+
+** Hooks
+:PROPERTIES:
+:DESCRIPTION: How to reach into Org's internals.
+:END:
+#+cindex: hooks
+
+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
+https://orgmode.org/worg/doc.html#hooks.
+
+** Add-on Packages
+:PROPERTIES:
+:DESCRIPTION: Available extensions.
+:END:
+#+cindex: add-on packages
+
+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
+https://orgmode.org. See the =contrib/README= file in the source code
+directory for a list of contributed files. Worg page with more
+information is at: https://orgmode.org/worg/org-contrib/.
+
+** Adding Hyperlink Types
+:PROPERTIES:
+:DESCRIPTION: New custom link types.
+:END:
+#+cindex: hyperlinks, adding new types
+
+Org has many built-in hyperlink types (see [[*Hyperlinks]]), and an
+interface for adding new link types. The following example shows the
+process of adding Org links to Unix man pages, which look like this
+
+: [[man:printf][The printf manual]]
+
+#+texinfo: @noindent
+The following =ol-man.el= file implements it
+
+#+begin_src emacs-lisp
+;;; ol-man.el - Support for links to man pages in Org mode
+(require 'ol)
+
+(org-link-set-parameters "man"
+ :follow #'org-man-open
+ :export #'org-man-export
+ :store #'org-man-store-link)
+
+(defcustom org-man-command 'man
+ "The Emacs command to be used to display a man page."
+ :group 'org-link
+ :type '(choice (const man) (const woman)))
+
+(defun org-man-open (path _)
+ "Visit the manpage on PATH.
+PATH should be a topic that can be thrown at the man command."
+ (funcall org-man-command path))
+
+(defun org-man-store-link ()
+ "Store a link to a man page."
+ (when (memq major-mode '(Man-mode woman-mode))
+ ;; This is a man page, we do make this link.
+ (let* ((page (org-man-get-page-name))
+ (link (concat "man:" page))
+ (description (format "Man page for %s" page)))
+ (org-link-store-props
+ :type "man"
+ :link link
+ :description description))))
+
+(defun org-man-get-page-name ()
+ "Extract the page name from the buffer name."
+ ;; This works for both `Man-mode' and `woman-mode'.
+ (if (string-match " \\(\\S-+\\)\\*" (buffer-name))
+ (match-string 1 (buffer-name))
+ (error "Cannot create link to this man page")))
+
+(defun org-man-export (link description format _)
+ "Export a man page link from Org files."
+ (let ((path (format "http://man.he.net/?topic=%s&section=all" link))
+ (desc (or description link)))
+ (pcase format
+ (`html (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
+ (`latex (format "\\href{%s}{%s}" path desc))
+ (`texinfo (format "@uref{%s,%s}" path desc))
+ (`ascii (format "%s (%s)" desc path))
+ (t path))))
+
+(provide ol-man)
+;;; ol-man.el ends here
+#+end_src
+
+#+texinfo: @noindent
+To activate links to man pages in Org, enter this in the Emacs init
+file:
+
+#+begin_src emacs-lisp
+(require 'ol-man)
+#+end_src
+
+#+texinfo: @noindent
+A review of =ol-man.el=:
+
+1. First, =(require 'ol)= ensures that =ol.el= is loaded.
+
+2.
+
+ #+findex: org-link-set-parameters
+ #+vindex: org-link-parameters
+ Then ~org-link-set-parameters~ defines a new link type with =man=
+ prefix and associates functions for following, exporting and
+ storing such links. See the variable ~org-link-parameters~ for
+ a complete list of possible associations.
+
+3. The rest of the file implements necessary variables and functions.
+
+ For example, ~org-man-store-link~ is responsible for storing a link
+ when ~org-store-link~ (see [[*Handling Links]]) is called from a buffer
+ displaying a man page. It first checks if the major mode is
+ appropriate. If check fails, the function returns ~nil~, which
+ means it isn't responsible for creating a link to the current
+ buffer. Otherwise the function makes a link string by combining
+ the =man:= prefix with the man topic. It also provides a default
+ description. The function ~org-insert-link~ can insert it back
+ into an Org buffer later on.
+
+** Adding Export Back-ends
+:PROPERTIES:
+:DESCRIPTION: How to write new export back-ends.
+:END:
+#+cindex: Export, writing back-ends
+
+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.
+
+#+findex: org-export-define-backend
+#+findex: org-export-define-derived-backend
+The two main entry points to the export engine are:
+~org-export-define-backend~ and ~org-export-define-derived-backend~.
+To grok these functions, see =ox-latex.el= for an example of defining
+a new back-end from scratch, and =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 ~:menu-entry~
+keyword. For export options specific to this back-end, set the
+~:options-alist~.
+
+For creating a new back-end from an existing one, set
+~:translate-alist~ to an alist of export functions. This alist
+replaces the parent back-end functions.
+
+For complete documentation, see [[https://orgmode.org/worg/dev/org-export-reference.html][the Org Export Reference on Worg]].
+
+** Tables in Arbitrary Syntax
+:PROPERTIES:
+:DESCRIPTION: Orgtbl for LaTeX and other programs.
+:END:
+#+cindex: tables, in other modes
+#+cindex: lists, in other modes
+#+cindex: Orgtbl mode
+
+Due to Org's success in handling tables with Orgtbl, a frequently
+requested feature is the use of Org's table functions in other modes,
+e.g., 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 /translate/ function that
+operates on a native Org /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 is in the hands of those who know those formats
+best.
+
+*** Radio tables
+:PROPERTIES:
+:DESCRIPTION: Sending and receiving radio tables.
+:END:
+#+cindex: radio tables
+
+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 is the magic words =BEGIN/END
+RECEIVE ORGTBL=. They have to appear as comments in the current mode.
+If the mode is C, then:
+
+#+begin_example
+/* BEGIN RECEIVE ORGTBL table_name */
+/* END RECEIVE ORGTBL table_name */
+#+end_example
+
+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: @samp{ORGTBL}, keyword
+: #+ORGTBL: SEND table_name translation_function arguments ...
+
+#+texinfo: @noindent
+=table_name= is the table's reference name, which is also used in the
+receiver lines, and the =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:
+
+- =:skip N= ::
+
+ Skip the first N lines of the table. Hlines do count; include them
+ if they are to be skipped.
+
+- =:skipcols (n1 n2 ...)= ::
+
+ 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
+ =skipcols=.
+
+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:
+
+- Place the table in a block comment. For example, in C mode you
+ could wrap the table between =/*= and =*/= lines.
+
+- Put the table after an "end" statement. For example ~\bye~ in TeX
+ and ~\end{document}~ in LaTeX.
+
+- Comment and un-comment each line of the table during edits. The
+ {{{kbd(M-x orgtbl-toggle-comment)}}} command makes toggling easy.
+
+*** A LaTeX example of radio tables
+:PROPERTIES:
+:DESCRIPTION: Step by step, almost a tutorial.
+:ALT_TITLE: A LaTeX example
+:END:
+#+cindex: @LaTeX{}, and Orgtbl mode
+
+To wrap a source table in LaTeX, use the =comment= environment
+provided by =comment.sty=[fn:157]. To activate it, put
+~\usepackage{comment}~ in the document header. Orgtbl mode inserts
+a radio table skeleton[fn:158] with the command {{{kbd(M-x
+orgtbl-insert-radio-table)}}}, which prompts for a table name. For
+example, if =salesfigures= is the name, the template inserts:
+
+#+begin_example
+% BEGIN RECEIVE ORGTBL salesfigures
+% END RECEIVE ORGTBL salesfigures
+\begin{comment}
+,#+ORGTBL: SEND salesfigures orgtbl-to-latex
+| | |
+\end{comment}
+#+end_example
+
+#+vindex: LaTeX-verbatim-environments
+#+texinfo: @noindent
+The line =#+ORGTBL: SEND= tells Orgtbl mode to use the function
+~orgtbl-to-latex~ to convert the table to LaTeX format, then insert
+the table at the target (receive) location named =salesfigures=. Now
+the table is ready for data entry. It can even use spreadsheet
+features[fn:159]:
+
+#+begin_example
+% BEGIN RECEIVE ORGTBL salesfigures
+% END RECEIVE ORGTBL salesfigures
+\begin{comment}
+,#+ORGTBL: SEND salesfigures orgtbl-to-latex
+| Month | Days | Nr sold | per day |
+|-------+------+---------+---------|
+| Jan | 23 | 55 | 2.4 |
+| Feb | 21 | 16 | 0.8 |
+| March | 22 | 278 | 12.6 |
+,#+TBLFM: $4=$3/$2;%.1f
+% $ (optional extra dollar to keep Font Lock happy, see footnote)
+\end{comment}
+#+end_example
+
+After editing, {{{kbd(C-c C-c)}}} inserts the translated table at the
+target location, between the two marker lines.
+
+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
+/splice/ out the target table without the header and footer.
+
+#+begin_example
+\begin{tabular}{lrrr}
+Month & \multicolumn{1}{c}{Days} & Nr.\ sold & per day\\
+% BEGIN RECEIVE ORGTBL salesfigures
+% END RECEIVE ORGTBL salesfigures
+\end{tabular}
+%
+\begin{comment}
+,#+ORGTBL: SEND salesfigures orgtbl-to-latex :splice t :skip 2
+| Month | Days | Nr sold | per day |
+|-------+------+---------+---------|
+| Jan | 23 | 55 | 2.4 |
+| Feb | 21 | 16 | 0.8 |
+| March | 22 | 278 | 12.6 |
+,#+TBLFM: $4=$3/$2;%.1f
+\end{comment}
+#+end_example
+
+The LaTeX translator function ~orgtbl-to-latex~ is already part of
+Orgtbl mode and uses a =tabular= environment to typeset the table and
+marks horizontal lines with ~\hline~. For additional parameters to
+control output, see [[*Translator functions]]:
+
+- =:splice BOOLEAN= ::
+
+ When {{{var(BOOLEAN}}} is non-~nil~, return only table body lines;
+ i.e., not wrapped in =tabular= environment. Default is ~nil~.
+
+- =:fmt FMT= ::
+
+ Format string to warp each field. It should contain =%s= for the
+ original field value. For example, to wrap each field value in
+ dollar symbol, you could use =:fmt "$%s$"=. Format can also wrap
+ a property list with column numbers and formats, for example =:fmt
+ (2 "$%s$" 4 "%s\\%%")=. In place of a string, a function of one
+ argument can be used; the function must return a formatted string.
+
+- =:efmt EFMT= ::
+
+ Format numbers as exponentials. The spec 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, for
+ example =:efmt (2 "$%s\\times10^{%s}$" 4 "$%s\\cdot10^{%s}$")=. After
+ {{{var(EFMT)}}} has been applied to a value, {{{var(FMT)}}}---see
+ above---is also applied. Functions with two arguments can be
+ supplied instead of strings. By default, no special formatting is
+ applied.
+
+*** Translator functions
+:PROPERTIES:
+:DESCRIPTION: Copy and modify.
+:END:
+#+cindex: HTML, and Orgtbl mode
+#+cindex: translator function
+
+#+findex: orgtbl-to-csv
+#+findex: orgtbl-to-tsv
+#+findex: orgtbl-to-latex
+#+findex: orgtbl-to-html
+#+findex: orgtbl-to-texinfo
+#+findex: orgtbl-to-unicode
+#+findex: orgtbl-to-orgtbl
+#+findex: orgtbl-to-generic
+Orgtbl mode has built-in translator functions: ~orgtbl-to-csv~
+(comma-separated values), ~orgtbl-to-tsv~ (TAB-separated values),
+~orgtbl-to-latex~, ~orgtbl-to-html~, ~orgtbl-to-texinfo~,
+~orgtbl-to-unicode~ and ~orgtbl-to-orgtbl~. They use the generic
+translator, ~orgtbl-to-generic~, which delegates translations to
+various export back-ends.
+
+Properties passed to the function through the =ORGTBL SEND= line take
+precedence over properties defined inside the function. For example,
+this overrides the default LaTeX line endings, ~\\~, with ~\\[2mm]~:
+
+: #+ORGTBL: SEND test orgtbl-to-latex :lend " \\\\[2mm]"
+
+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 =!BTBL!= and =!ETBL!=;
+a beginning and ending of lines with =!BL!= and =!EL!=; and uses a TAB
+for a field separator:
+
+#+begin_src emacs-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_src
+
+#+texinfo: @noindent
+The documentation for the ~orgtbl-to-generic~ function shows
+a complete list of parameters, each of which can be passed through to
+~orgtbl-to-latex~, ~orgtbl-to-texinfo~, and any other function 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 ~hline~. The second argument is the property
+list consisting of parameters specified in the =#+ORGTBL: SEND= line.
+Please share your translator functions by posting them to the Org
+users mailing list, at mailto:emacs-orgmode@gnu.org.
+
+** Dynamic Blocks
+:PROPERTIES:
+:DESCRIPTION: Automatically filled blocks.
+:END:
+#+cindex: dynamic blocks
+
+Org supports /dynamic blocks/ in Org documents. They are inserted
+with begin and end markers like any other code block, but the contents
+are updated automatically by a user function.
+
+#+kindex: C-c C-x x
+#+findex: org-dynamic-block-insert-dblock
+You can insert a dynamic block with ~org-dynamic-block-insert-dblock~,
+which is bound to {{{kbd(C-c C-x x)}}} by default. For example,
+{{{kbd(C-c C-x x c l o c k t a b l e RET)}}} inserts a table that
+updates the work time (see [[*Clocking Work Time]]).
+
+Dynamic blocks can have names and function parameters. The syntax is
+similar to source code block specifications:
+
+#+begin_example
+,#+BEGIN: myblock :parameter1 value1 :parameter2 value2 ...
+ ...
+,#+END:
+#+end_example
+
+These commands update dynamic blocks:
+
+- {{{kbd(C-c C-x C-u)}}} (~org-dblock-update~) ::
+
+ #+kindex: C-c C-x C-u
+ #+findex: org-dblock-update
+ Update dynamic block at point.
+
+- {{{kbd(C-u C-c C-x C-u)}}} ::
+
+ #+kindex: C-u C-c C-x C-u
+ Update all dynamic blocks in the current file.
+
+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 as a plist. The
+previous content of the dynamic block becomes erased from the buffer
+and appended to the plist under ~:content~.
+
+The syntax for naming a writer function with a dynamic block labeled
+=myblock= is: ~org-dblock-write:myblock~.
+
+The following is an example of a dynamic block and a block writer function
+that updates the time when the function was last run:
+
+#+begin_example
+,#+BEGIN: block-update-time :format "on %m/%d/%Y at %H:%M"
+ ...
+,#+END:
+#+end_example
+
+#+texinfo: @noindent
+The dynamic block's writer function:
+
+#+begin_src emacs-lisp
+(defun org-dblock-write:block-update-time (params)
+ (let ((fmt (or (plist-get params :format) "%d. %m. %Y")))
+ (insert "Last block update at: "
+ (format-time-string fmt))))
+#+end_src
+
+To keep dynamic blocks up-to-date in an Org file, use the function,
+~org-update-all-dblocks~ in hook, such as ~before-save-hook~. The
+~org-update-all-dblocks~ function does not run if the file is not in
+Org mode.
+
+#+findex: org-narrow-to-block
+Dynamic blocks, like any other block, can be narrowed with
+~org-narrow-to-block~.
+
+** Special Agenda Views
+:PROPERTIES:
+:DESCRIPTION: Customized views.
+:END:
+#+cindex: agenda views, user-defined
+
+#+vindex: org-agenda-skip-function
+#+vindex: org-agenda-skip-function-global
+Org provides a special hook to further limit items in agenda views:
+~agenda~, ~agenda*~[fn:160], ~todo~, ~alltodo~, ~tags~, ~tags-todo~,
+~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
+~org-agenda-skip-function-global~ variable. Org uses a global
+condition with ~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 ~nil~ on match. Otherwise it gives the location from where
+the search continues.
+
+#+begin_src emacs-lisp
+(defun my-skip-unless-waiting ()
+ "Skip trees that are not waiting"
+ (let ((subtree-end (save-excursion (org-end-of-subtree t))))
+ (if (re-search-forward ":waiting:" subtree-end t)
+ nil ; tag found, do not skip
+ subtree-end))) ; tag not found, continue after end of subtree
+#+end_src
+
+To use this custom function in a custom agenda command:
+
+#+begin_src emacs-lisp
+(org-add-agenda-custom-command
+ '("b" todo "PROJECT"
+ ((org-agenda-skip-function 'my-skip-unless-waiting)
+ (org-agenda-overriding-header "Projects waiting for something: "))))
+#+end_src
+
+#+vindex: org-agenda-overriding-header
+Note that this also binds ~org-agenda-overriding-header~ to a more
+meaningful string suitable for the agenda view.
+
+#+vindex: org-odd-levels-only
+#+vindex: org-agenda-skip-function
+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 =LEVEL>0=[fn:161]. Then to selectively pick
+the matched entries, use ~org-agenda-skip-function~, which also
+accepts Lisp forms, such as ~org-agenda-skip-entry-if~ and
+~org-agenda-skip-subtree-if~. For example:
+
+- =(org-agenda-skip-entry-if 'scheduled)= ::
+
+ Skip current entry if it has been scheduled.
+
+- =(org-agenda-skip-entry-if 'notscheduled)= ::
+
+ Skip current entry if it has not been scheduled.
+
+- =(org-agenda-skip-entry-if 'deadline)= ::
+
+ Skip current entry if it has a deadline.
+
+- =(org-agenda-skip-entry-if 'scheduled 'deadline)= ::
+
+ Skip current entry if it has a deadline, or if it is scheduled.
+
+- =(org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))= ::
+
+ Skip current entry if the TODO keyword is TODO or WAITING.
+
+- =(org-agenda-skip-entry-if 'todo 'done)= ::
+
+ Skip current entry if the TODO keyword marks a DONE state.
+
+- =(org-agenda-skip-entry-if 'timestamp)= ::
+
+ Skip current entry if it has any timestamp, may also be deadline or
+ scheduled.
+
+- =(org-agenda-skip-entry-if 'regexp "regular expression")= ::
+
+ Skip current entry if the regular expression matches in the entry.
+
+- =(org-agenda-skip-entry-if 'notregexp "regular expression")= ::
+
+ Skip current entry unless the regular expression matches.
+
+- =(org-agenda-skip-subtree-if 'regexp "regular expression")= ::
+
+ Same as above, but check and skip the entire subtree.
+
+The following is an example of a search for =waiting= without the
+special function:
+
+#+begin_src emacs-lisp
+(org-add-agenda-custom-command
+ '("b" todo "PROJECT"
+ ((org-agenda-skip-function '(org-agenda-skip-subtree-if
+ 'regexp ":waiting:"))
+ (org-agenda-overriding-header "Projects waiting for something: "))))
+#+end_src
+
+** Speeding Up Your Agendas
+:PROPERTIES:
+:DESCRIPTION: Tips on how to speed up your agendas.
+:END:
+#+cindex: agenda views, optimization
+
+Some agenda commands slow down when the Org files grow in size or
+number. Here are tips to speed up:
+
+- Reduce the number of Org agenda files to avoid slowdowns due to hard drive
+ accesses.
+
+- Reduce the number of DONE and archived headlines so agenda
+ operations that skip over these can finish faster.
+
+- Do not dim blocked tasks:
+ #+vindex: org-agenda-dim-blocked-tasks
+
+ #+begin_src emacs-lisp
+ (setq org-agenda-dim-blocked-tasks nil)
+ #+end_src
+
+- Stop preparing agenda buffers on startup:
+ #+vindex: org-startup-folded
+ #+vindex: org-agenda-inhibit-startup
+
+ #+begin_src emacs-lisp
+ (setq org-agenda-inhibit-startup t)
+ #+end_src
+
+- Disable tag inheritance for agendas:
+ #+vindex: org-agenda-show-inherited-tags
+ #+vindex: org-agenda-use-tag-inheritance
+
+ #+begin_src emacs-lisp
+ (setq org-agenda-use-tag-inheritance nil)
+ #+end_src
+
+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 [[https://orgmode.org/worg/agenda-optimization.html][dedicated Worg page]] for agenda
+optimization.
+
+** Extracting Agenda Information
+:PROPERTIES:
+:DESCRIPTION: Post-processing agenda information.
+:END:
+#+cindex: agenda, pipe
+#+cindex: scripts, for agenda processing
+
+Org provides commands to access agendas through Emacs batch mode.
+Through this command-line interface, agendas are automated for further
+processing or printing.
+
+#+vindex: org-agenda-custom-commands
+#+findex: org-batch-agenda
+~org-batch-agenda~ creates an agenda view in ASCII and outputs to
+standard output. This command takes one string parameter. When
+string consists of a single character, Org uses it as a key to
+~org-agenda-custom-commands~. These are the same ones available
+through the agenda dispatcher (see [[*The Agenda Dispatcher]]).
+
+This example command line directly prints the TODO list to the printer:
+
+: emacs -batch -l ~/.emacs -eval '(org-batch-agenda "t")' | lpr
+
+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 =shop=, but excludes items tagged with
+=NewYork=:
+
+#+begin_example
+emacs -batch -l ~/.emacs \
+ -eval '(org-batch-agenda "+shop-NewYork")' | lpr
+#+end_example
+
+#+texinfo: @noindent
+An example showing on-the-fly parameter modifications:
+
+#+begin_example
+emacs -batch -l ~/.emacs \
+ -eval '(org-batch-agenda "a" \
+ org-agenda-span (quote month) \
+ org-agenda-include-diary nil \
+ org-agenda-files (quote ("~/org/project.org")))' \
+ | lpr
+#+end_example
+
+#+texinfo: @noindent
+which produces an agenda for the next 30 days from just the
+=~/org/projects.org= file.
+
+#+findex: org-batch-agenda-csv
+For structured processing of agenda output, use ~org-batch-agenda-csv~
+with the following fields:
+
+- category :: The category of the item
+- head :: The headline, without TODO keyword, TAGS and PRIORITY
+- type :: The type of the agenda entry, can be
+
+ | ~todo~ | selected in TODO match |
+ | ~tagsmatch~ | selected in tags match |
+ | ~diary~ | imported from diary |
+ | ~deadline~ | a deadline |
+ | ~scheduled~ | scheduled |
+ | ~timestamp~ | appointment, selected by timestamp |
+ | ~closed~ | entry was closed on date |
+ | ~upcoming-deadline~ | warning about nearing deadline |
+ | ~past-scheduled~ | forwarded scheduled item |
+ | ~block~ | entry has date block including date |
+
+- todo :: The TODO keyword, if any
+- tags :: All tags including inherited ones, separated by colons
+- date :: The relevant date, like =2007-2-14=
+- time :: The time, like =15:00-16:50=
+- extra :: String with extra planning info
+- priority-l :: The priority letter if any was given
+- priority-n :: The computed numerical priority
+
+If the selection of the agenda item was based on a timestamp,
+including those items with =DEADLINE= and =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.
+
+Here is an example of a post-processing script in Perl. It takes the
+CSV output from Emacs and prints with a checkbox:
+
+#+begin_src perl
+#!/usr/bin/perl
+
+# define the Emacs command to run
+$cmd = "emacs -batch -l ~/.emacs -eval '(org-batch-agenda-csv \"t\")'";
+
+# run it and capture the output
+$agenda = qx{$cmd 2>/dev/null};
+
+# loop over all lines
+foreach $line (split(/\n/,$agenda)) {
+ # get the individual values
+ ($category,$head,$type,$todo,$tags,$date,$time,$extra,
+ $priority_l,$priority_n) = split(/,/,$line);
+ # process and print
+ print "[ ] $head\n";
+}
+#+end_src
+
+** Using the Property API
+:PROPERTIES:
+:DESCRIPTION: Writing programs that use entry properties.
+:END:
+#+cindex: API, for properties
+#+cindex: properties, API
+
+Here is a description of the functions that can be used to work with
+properties.
+
+#+attr_texinfo: :options org-entry-properties &optional pom which
+#+begin_defun
+Get all properties of the entry at point-or-marker {{{var(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. {{{var(POM)}}} may also
+be ~nil~, in which case the current entry is used. If
+{{{var(WHICH)}}} is ~nil~ or ~all~, get all properties. If
+{{{var(WHICH)}}} is ~special~ or ~standard~, only get that subclass.
+#+end_defun
+
+#+vindex: org-use-property-inheritance
+#+findex: org-insert-property-drawer
+#+attr_texinfo: :options org-entry-get pom property &optional inherit
+#+begin_defun
+Get value of {{{var(PROPERTY)}}} for entry at point-or-marker
+{{{var(POM)}}}. By default, this only looks at properties defined
+locally in the entry. If {{{var(INHERIT)}}} is non-~nil~ and the
+entry does not have the property, then also check higher levels of the
+hierarchy. If {{{var(INHERIT)}}} is the symbol ~selective~, use
+inheritance if and only if the setting of
+~org-use-property-inheritance~ selects {{{var(PROPERTY)}}} for
+inheritance.
+#+end_defun
+
+#+attr_texinfo: :options org-entry-delete pom property
+#+begin_defun
+Delete the property {{{var(PROPERTY)}}} from entry at point-or-marker
+{{{var(POM)}}}.
+#+end_defun
+
+#+attr_texinfo: :options org-entry-put pom property value
+#+begin_defun
+Set {{{var(PROPERTY)}}} to {{{var(VALUES)}}} for entry at
+point-or-marker POM.
+#+end_defun
+
+#+attr_texinfo: :options org-buffer-property-keys &optional include-specials
+#+begin_defun
+Get all property keys in the current buffer.
+#+end_defun
+
+#+attr_texinfo: :options org-insert-property-drawer
+#+begin_defun
+Insert a property drawer for the current entry. Also
+#+end_defun
+
+#+attr_texinfo: :options org-entry-put-multivalued-property pom property &rest values
+#+begin_defun
+Set {{{var(PROPERTY)}}} at point-or-marker {{{var(POM)}}} to
+{{{var(VALUES)}}}. {{{var(VALUES)}}} should be a list of strings.
+They are concatenated, with spaces as separators.
+#+end_defun
+
+#+attr_texinfo: :options org-entry-get-multivalued-property pom property
+#+begin_defun
+Treat the value of the property {{{var(PROPERTY)}}} as
+a whitespace-separated list of values and return the values as a list
+of strings.
+#+end_defun
+
+#+attr_texinfo: :options org-entry-add-to-multivalued-property pom property value
+#+begin_defun
+Treat the value of the property {{{var(PROPERTY)}}} as
+a whitespace-separated list of values and make sure that
+{{{var(VALUE)}}} is in this list.
+#+end_defun
+
+#+attr_texinfo: :options org-entry-remove-from-multivalued-property pom property value
+#+begin_defun
+Treat the value of the property {{{var(PROPERTY)}}} as
+a whitespace-separated list of values and make sure that
+{{{var(VALUE)}}} is /not/ in this list.
+#+end_defun
+
+#+attr_texinfo: :options org-entry-member-in-multivalued-property pom property value
+#+begin_defun
+Treat the value of the property {{{var(PROPERTY)}}} as
+a whitespace-separated list of values and check if {{{var(VALUE)}}} is
+in this list.
+#+end_defun
+
+#+attr_texinfo: :options org-property-allowed-value-functions
+#+begin_defopt
+Hook for functions supplying allowed values for a specific property.
+The functions must take a single argument, the name of the property,
+and return a flat list of allowed values. If =:ETC= is one of the
+values, use the values as completion help, but allow also other values
+to be entered. The functions must return ~nil~ if they are not
+responsible for this property.
+#+end_defopt
+
+** Using the Mapping API
+:PROPERTIES:
+:DESCRIPTION: Mapping over all or selected entries.
+:END:
+#+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:
+
+#+attr_texinfo: :options org-map-entries func &optional match scope &rest skip
+#+begin_defun
+Call {{{var(FUNC)}}} at each headline selected by {{{var(MATCH)}}} in
+{{{var(SCOPE)}}}.
+
+{{{var(FUNC)}}} is a function or a Lisp form. With point positioned
+at the beginning of the headline, call the function without arguments.
+Org returns an alist of return values of calls to the function.
+
+To avoid preserving point, Org wraps the call to {{{var(FUNC)}}} in
+~save-excursion~ form. After evaluation, Org moves point 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
+{{{var(FUNC)}}} set the variable ~org-map-continue-from~ to a specific
+buffer position.
+
+{{{var(MATCH)}}} is a tags/property/TODO match. Org iterates only
+matched headlines. Org iterates over all headlines when
+{{{var(MATCH)}}} is ~nil~ or ~t~.
+
+{{{var(SCOPE)}}} determines the scope of this command. It can be any
+of:
+
+- ~nil~ ::
+
+ The current buffer, respecting the restriction, if any.
+
+- ~tree~ ::
+
+ The subtree started with the entry at point.
+
+- ~region~ ::
+
+ The entries within the active region, if any.
+
+- ~file~ ::
+
+ The current buffer, without restriction.
+
+- ~file-with-archives~ ::
+
+ The current buffer, and any archives associated with it.
+
+- ~agenda~ ::
+
+ All agenda files.
+
+- ~agenda-with-archives~ ::
+
+ All agenda files with any archive files associated with them.
+
+- list of filenames ::
+
+ If this is a list, all files in the list are scanned.
+
+#+texinfo: @noindent
+The remaining arguments are treated as settings for the scanner's
+skipping facilities. Valid arguments are:
+
+- ~archive~ ::
+
+ Skip trees with the =ARCHIVE= tag.
+
+- ~comment~ ::
+
+ Skip trees with the COMMENT keyword.
+
+- function or Lisp form ::
+
+ #+vindex: org-agenda-skip-function
+ Used as value for ~org-agenda-skip-function~, so whenever the
+ function returns ~t~, {{{var(FUNC)}}} is called for that entry and
+ search continues from the point where the function leaves it.
+#+end_defun
+
+The mapping routine can call any arbitrary function, even functions
+that change meta data or query the property API (see [[*Using the
+Property API]]). Here are some handy functions:
+
+#+attr_texinfo: :options org-todo &optional arg
+#+begin_defun
+Change the TODO state of the entry. See the docstring of the
+functions for the many possible values for the argument
+{{{var(ARG)}}}.
+#+end_defun
+
+#+attr_texinfo: :options org-priority &optional action
+#+begin_defun
+Change the priority of the entry. See the docstring of this function
+for the possible values for {{{var(ACTION)}}}.
+#+end_defun
+
+#+attr_texinfo: :options org-toggle-tag tag &optional onoff
+#+begin_defun
+Toggle the tag {{{var(TAG)}}} in the current entry. Setting
+{{{var(ONOFF)}}} to either ~on~ or ~off~ does not toggle tag, but
+ensure that it is either on or off.
+#+end_defun
+
+#+attr_texinfo: :options org-promote
+#+begin_defun
+Promote the current entry.
+#+end_defun
+
+#+attr_texinfo: :options org-demote
+#+begin_defun
+Demote the current entry.
+#+end_defun
+
+This example turns all entries tagged with =TOMORROW= into TODO
+entries with keyword =UPCOMING=. Org ignores entries in comment trees
+and archive trees.
+
+#+begin_src emacs-lisp
+(org-map-entries '(org-todo "UPCOMING")
+ "+TOMORROW" 'file 'archive 'comment)
+#+end_src
+
+The following example counts the number of entries with TODO keyword
+=WAITING=, in all agenda files.
+
+#+begin_src emacs-lisp
+(length (org-map-entries t "/+WAITING" 'agenda))
+#+end_src
+
+* History and Acknowledgments
+:PROPERTIES:
+:DESCRIPTION: How Org came into being.
+:APPENDIX: t
+:END:
+
+** From Carsten
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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. /Visibility cycling/
+and /structure editing/ were originally implemented in the package
+=outline-magic.el=, but quickly moved to the more general =org.el=.
+As this environment became comfortable for project planning, the next
+step was adding /TODO entries/, basic /timestamps/, and /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 the
+[[mailto:emacs-orgmode@gnu.org][mailing list]] have provided a constant stream of bug reports, feedback,
+new ideas, and sometimes patches and add-on code. Many thanks to
+everyone who has helped to improve this package. I am trying to keep
+here a list of the people who had significant influence in shaping one
+or more aspects of Org. The list may not be complete, if I have
+forgotten someone, please accept my apologies and let me know.
+
+Before I get to this list, a few special mentions are in order:
+
+- 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 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.
+
+- 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. This has
+ become one of Org's killer features that define what Org is today.
+
+- John Wiegley ::
+
+ John has contributed a number of great ideas and patches directly to
+ Org, including the attachment system (=org-attach.el=), integration
+ with Apple Mail (=org-mac-message.el=), hierarchical dependencies of
+ TODO items, habit tracking (=org-habits.el=), and encryption
+ (=org-crypt.el=). Also, the capture system is really an extended
+ copy of his great =remember.el=.
+
+- Sebastian Rose ::
+
+ Without Sebastian, the HTML/XHTML publishing of Org would be the
+ pitiful work of an ignorant amateur. Sebastian has pushed this part
+ of Org onto a much higher level. He also wrote =org-info.js=,
+ a JavaScript program for displaying webpages derived from Org using
+ an Info-like or a folding interface with single-key navigation.
+
+See below for the full list of contributions! Again, please let me
+know what I am missing here!
+
+** From Bastien
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+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 getting more confident over time, with both the community and the
+code.
+
+When I took over maintainership, I knew I would have to make Org more
+collaborative than ever, as I would have to rely on people that are
+more knowledgeable than I am on many parts of the code. Here is
+a list of the persons I could rely on, they should really be
+considered co-maintainers, either of the code or the community:
+
+- Eric Schulte ::
+
+ 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.
+
+- Nicolas Goaziou ::
+
+ Nicolas is maintaining the consistency of the deepest parts of Org.
+ His work on =org-element.el= and =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.
+
+- Achim Gratz ::
+
+ Achim rewrote the building process of Org, turning some /ad hoc/
+ tools into a flexible and conceptually clean process. He patiently
+ coped with the many hiccups that such a change can create for users.
+
+- Nick Dokos ::
+
+ The Org mode mailing list would not be such a nice place without
+ Nick, who patiently helped users so many times. It is impossible to
+ overestimate such a great help, and the list would not be so active
+ without him.
+
+I received support from so many users that it is clearly impossible to
+be fair when shortlisting a few of them, but Org's history would not
+be complete if the ones above were not mentioned in this manual.
+
+** List of Contributions
+:PROPERTIES:
+:UNNUMBERED: notoc
+:END:
+
+- Russell Adams came up with the idea for drawers.
+
+- Thomas Baumann wrote =ol-bbdb.el= and =ol-mhe.el=.
+
+- Christophe Bataillon created the great unicorn logo that we use on
+ the Org mode website.
+
+- Alex Bochannek provided a patch for rounding timestamps.
+
+- Jan Böcker wrote =ol-docview.el=.
+
+- Brad Bozarth showed how to pull RSS feed data into Org files.
+
+- Tom Breton wrote =org-choose.el=.
+
+- Charles Cave's suggestion sparked the implementation of templates
+ for Remember, which are now templates for capture.
+
+- Pavel Chalmoviansky influenced the agenda treatment of items with
+ specified time.
+
+- Gregory Chernov patched support for Lisp forms into table
+ calculations and improved XEmacs compatibility, in particular by
+ porting =nouline.el= to XEmacs.
+
+- Sacha Chua suggested copying some linking code from Planner.
+
+- Baoqiu Cui contributed the DocBook exporter.
+
+- Eddward DeVilla proposed and tested checkbox statistics. He also
+ came up with the idea of properties, and that there should be an API
+ for them.
+
+- Nick Dokos tracked down several nasty bugs.
+
+- Kees Dullemond used to edit projects lists directly in HTML and so
+ inspired some of the early development, including HTML export. He
+ also asked for a way to narrow wide table columns.
+
+- Thomas\nbsp{}S.\nbsp{}Dye contributed documentation on Worg and helped
+ integrating the Org Babel documentation into the manual.
+
+- Christian Egli converted the documentation into Texinfo format,
+ inspired the agenda, patched CSS formatting into the HTML exporter,
+ and wrote =org-taskjuggler.el=.
+
+- David Emery provided a patch for custom CSS support in exported HTML
+ agendas.
+
+- Nic Ferrier contributed mailcap and XOXO support.
+
+- Miguel\nbsp{}A.\nbsp{}Figueroa-Villanueva implemented hierarchical checkboxes.
+
+- John Foerch figured out how to make incremental search show context
+ around a match in a hidden outline tree.
+
+- Raimar Finken wrote =org-git-line.el=.
+
+- Mikael Fornius works as a mailing list moderator.
+
+- Austin Frank works as a mailing list moderator.
+
+- Eric Fraga drove the development of Beamer export with ideas and
+ testing.
+
+- Barry Gidden did proofreading the manual in preparation for the book
+ publication through Network Theory Ltd.
+
+- Niels Giesen had the idea to automatically archive DONE trees.
+
+- Nicolas Goaziou rewrote much of the plain list code.
+
+- Kai Grossjohann pointed out key-binding conflicts with other
+ packages.
+
+- Brian Gough of Network Theory Ltd publishes the Org mode manual as
+ a book.
+
+- Bernt Hansen has driven much of the support for auto-repeating
+ tasks, task state change logging, and the clocktable. His clear
+ explanations have been critical when we started to adopt the Git
+ version control system.
+
+- Manuel Hermenegildo has contributed various ideas, small fixes and
+ patches.
+
+- Phil Jackson wrote =ol-irc.el=.
+
+- Scott Jaderholm proposed footnotes, control over whitespace between
+ folded entries, and column view for properties.
+
+- Matt Jones wrote MobileOrg Android.
+
+- Tokuya Kameshima wrote =org-wl.el= and =org-mew.el=.
+
+- Shidai Liu ("Leo") asked for embedded LaTeX and tested it. He also
+ provided frequent feedback and some patches.
+
+- Matt Lundin has proposed last-row references for table formulas and
+ named invisible anchors. He has also worked a lot on the FAQ.
+
+- David Maus wrote =org-atom.el=, maintains the issues file for Org,
+ and is a prolific contributor on the mailing list with competent
+ replies, small fixes and patches.
+
+- Jason\nbsp{}F.\nbsp{}McBrayer suggested agenda export to CSV format.
+
+- Max Mikhanosha came up with the idea of refiling.
+
+- Dmitri Minaev sent a patch to set priority limits on a per-file
+ basis.
+
+- Stefan Monnier provided a patch to keep the Emacs Lisp compiler
+ happy.
+
+- Richard Moreland wrote MobileOrg for the iPhone.
+
+- Rick Moynihan proposed allowing multiple TODO sequences in a file
+ and being able to quickly restrict the agenda to a subtree.
+
+- Todd Neal provided patches for links to Info files and Elisp forms.
+
+- Greg Newman refreshed the unicorn logo into its current form.
+
+- Tim O'Callaghan suggested in-file links, search options for general
+ file links, and tags.
+
+- Osamu Okano wrote =orgcard2ref.pl=, a Perl program to create a text
+ version of the reference card.
+
+- Takeshi Okano translated the manual and David O'Toole's tutorial
+ into Japanese.
+
+- Oliver Oppitz suggested multi-state TODO items.
+
+- Scott Otterson sparked the introduction of descriptive text for
+ links, among other things.
+
+- Pete Phillips helped during the development of the TAGS feature,
+ and provided frequent feedback.
+
+- Martin Pohlack provided the code snippet to bundle character
+ insertion into bundles of 20 for undo.
+
+- T.\nbsp{}V.\nbsp{}Raman reported bugs and suggested improvements.
+
+- Matthias Rempe (Oelde) provided ideas, Windows support, and quality
+ control.
+
+- Paul Rivier provided the basic implementation of named footnotes.
+ He also acted as mailing list moderator for some time.
+
+- Kevin Rogers contributed code to access VM files on remote hosts.
+
+- Frank Ruell solved the mystery of the =keymapp nil= bug, a conflict
+ with =allout.el=.
+
+- Jason Riedy generalized the send-receive mechanism for Orgtbl
+ tables with extensive patches.
+
+- Philip Rooke created the Org reference card, provided lots of
+ feedback, developed and applied standards to the Org documentation.
+
+- Christian Schlauer proposed angular brackets around links, among
+ other things.
+
+- Paul Sexton wrote =org-ctags.el=.
+
+- Tom Shannon's =organizer-mode.el= inspired linking to VM/BBDB/Gnus.
+
+- Ilya Shlyakhter proposed the Archive Sibling, line numbering in
+ literal examples, and remote highlighting for referenced code lines.
+
+- Stathis Sideris wrote the =ditaa.jar= ASCII to PNG converter that is
+ now packaged into Org's =contrib/= directory.
+
+- Daniel Sinder came up with the idea of internal archiving by locking
+ subtrees.
+
+- Dale Smith proposed link abbreviations.
+
+- James TD Smith has contributed a large number of patches for
+ useful tweaks and features.
+
+- Adam Spiers asked for global linking commands, inspired the link
+ extension system, added support for Mairix, and proposed the mapping
+ API.
+
+- Ulf Stegemann created the table to translate special symbols to
+ HTML, LaTeX, UTF-8, Latin-1 and ASCII.
+
+- Andy Stewart contributed code to =ol-w3m.el=, to copy
+ HTML content with links transformation to Org syntax.
+
+- David O'Toole wrote =org-publish.el= and drafted the
+ manual chapter about publishing.
+
+- Jambunathan\nbsp{}K.\nbsp{}contributed the ODT exporter.
+
+- Sebastien Vauban reported many issues with LaTeX and Beamer export
+ and enabled source code highlighting in Gnus.
+
+- Stefan Vollmar organized a video-recorded talk at the
+ Max-Planck-Institute for Neurology. He also inspired the creation
+ of a concept index for HTML export.
+
+- Jürgen Vollmer contributed code generating the table of contents in
+ HTML output.
+
+- Samuel Wales has provided important feedback and bug reports.
+
+- Chris Wallace provided a patch implementing the =QUOTE= block.
+
+- David Wainberg suggested archiving, and improvements to the
+ linking system.
+
+- Carsten Wimmer suggested some changes and helped fix a bug in
+ linking to Gnus.
+
+- Roland Winkler requested additional key bindings to make Org work on
+ a TTY.
+
+- Piotr Zielinski wrote =org-mouse.el=, proposed agenda
+ blocks and contributed various ideas and code snippets.
+
+- Marco Wahl wrote =ol-eww.el=.
+
+* GNU Free Documentation License
+:PROPERTIES:
+:APPENDIX: t
+:DESCRIPTION: The license for this documentation.
+:END:
+
+#+texinfo: @include doclicense.texi
+
+* Main Index
+:PROPERTIES:
+:INDEX: cp
+:DESCRIPTION: An index of Org's concepts and features.
+:END:
+
+* Key Index
+:PROPERTIES:
+:DESCRIPTION: Key bindings and where they are described.
+:INDEX: ky
+:END:
+
+* Command and Function Index
+:PROPERTIES:
+:DESCRIPTION: Command names and some internal functions.
+:INDEX: fn
+:END:
+
+* Variable Index
+:PROPERTIES:
+:DESCRIPTION: Variables mentioned in the manual.
+:INDEX: vr
+:END:
+
+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)}}} and then click yourself through the tree.
+
+* Copying
+:PROPERTIES:
+:copying: t
+:END:
+
+This manual is for Org version {{{version}}}.
+
+Copyright \copy 2004--2021 Free Software Foundation, Inc.
+
+#+begin_quote
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being "A GNU Manual,"
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled "GNU Free Documentation License."
+
+(a) The FSF's Back-Cover Text is: "You have the freedom to copy and
+modify this GNU manual."
+#+end_quote
+
+* Export Setup :noexport:
+
+#+setupfile: org-setup.org
+
+#+export_file_name: org.texi
+
+#+texinfo_dir_category: Emacs editing modes
+#+texinfo_dir_title: Org Mode: (org)
+#+texinfo_dir_desc: Outline-based notes management and organizer
+
+* Footnotes
+
+[fn:1] If you do not use Font Lock globally turn it on in Org buffer
+with =(add-hook 'org-mode-hook 'turn-on-font-lock)=.
+
+[fn:2] Please consider subscribing to the mailing list in order to
+minimize the work the mailing list moderators have to do.
+
+[fn:3] See the variables ~org-special-ctrl-a/e~, ~org-special-ctrl-k~,
+and ~org-ctrl-k-protect-subtree~ to configure special behavior of
+{{{kbd(C-a)}}}, {{{kbd(C-e)}}}, and {{{kbd(C-k)}}} in headlines. Note
+also that clocking only works with headings indented less than 30
+stars.
+
+[fn:4] See, however, the option ~org-cycle-emulate-tab~.
+
+[fn:5] The indirect buffer contains the entire buffer, but is narrowed
+to the current tree. Editing the indirect buffer also changes the
+original buffer, but without affecting visibility in that buffer. For
+more information about indirect buffers, see [[info:emacs#Indirect Buffers][GNU Emacs Manual]].
+
+[fn:6] When ~org-agenda-inhibit-startup~ is non-~nil~, Org does not
+honor the default visibility state when first opening a file for the
+agenda (see [[*Speeding Up Your Agendas]]).
+
+[fn:7] See also the variable ~org-show-context-detail~ to decide how
+much context is shown around each match.
+
+[fn:8] This depends on the option ~org-remove-highlights-with-change~.
+
+[fn:9] When using =*= as a bullet, lines must be indented so that they
+are not interpreted as headlines. Also, when you are hiding leading
+stars to get a clean outline view, plain list items starting with
+a star may be hard to distinguish from true headlines. In short: even
+though =*= is supported, it may be better to not use it for plain list
+items.
+
+[fn:10] You can filter out any of them by configuring
+~org-plain-list-ordered-item-terminator~.
+
+[fn:11] You can also get =a.=, =A.=, =a)= and =A)= by configuring
+~org-list-allow-alphabetical~. To minimize confusion with normal
+text, those are limited to one character only. Beyond that limit,
+bullets automatically become numbers.
+
+[fn:12] If there's a checkbox in the item, the cookie must be put
+/before/ the checkbox. If you have activated alphabetical lists, you
+can also use counters like =[@b]=.
+
+[fn:13] If you do not want the item to be split, customize the
+variable ~org-M-RET-may-split-line~.
+
+[fn:14] If you want to cycle around items that way, you may customize
+~org-list-use-circular-motion~.
+
+[fn:15] See ~org-list-use-circular-motion~ for a cyclic behavior.
+
+[fn:16] Many desktops intercept {{{kbd(M-TAB)}}} to switch windows.
+Use {{{kbd(C-M-i)}}} or {{{kbd(ESC TAB)}}} instead.
+
+[fn:17] To insert a vertical bar into a table field, use =\vert= or,
+inside a word =abc\vert{}def=.
+
+[fn:18] Org understands references typed by the user as =B4=, but it
+does not use this syntax when offering a formula for editing. You can
+customize this behavior using the variable
+~org-table-use-standard-references~.
+
+[fn:19] The computation time scales as O(N^2) because table
+{{{var(FOO)}}} is parsed for each field to be copied.
+
+[fn:20] The file =constants.el= can supply the values of constants in
+two different unit systems, =SI= and =cgs=. Which one is used depends
+on the value of the variable ~constants-unit-system~. You can use the
+=STARTUP= options =constSI= and =constcgs= to set this value for the
+current buffer.
+
+[fn:21] The printf reformatting is limited in precision because the
+value passed to it is converted into an "integer" or "double". The
+"integer" is limited in size by truncating the signed value to 32
+bits. The "double" is limited in precision to 64 bits overall which
+leaves approximately 16 significant decimal digits.
+
+[fn:22] Such names must start with an alphabetic character and use
+only alphanumeric/underscore characters.
+
+[fn:23] Plain URIs are recognized only for a well-defined set of
+schemes. See [[*External Links]]. Unlike URI syntax, they cannot contain
+parenthesis or white spaces, either. URIs within angle brackets have
+no such limitation.
+
+[fn:24] More accurately, the precise behavior depends on how point
+arrived there---see [[info:elisp#Invisible Text][Invisible Text]].
+
+[fn:25] To insert a link targeting a headline, in-buffer completion
+can be used. Just type a star followed by a few optional letters into
+the buffer and press {{{kbd(M-TAB)}}}. All headlines in the current
+buffer are offered as completions.
+
+[fn:26] When targeting a =NAME= keyword, the =CAPTION= keyword is
+mandatory in order to get proper numbering (see [[*Captions]]).
+
+[fn:27] The actual behavior of the search depends on the value of the
+variable ~org-link-search-must-match-exact-headline~. If its value is
+~nil~, then a fuzzy text search is done. If it is ~t~, then only the
+exact headline is matched, ignoring spaces and statistic cookies. If
+the value is ~query-to-create~, then an exact headline is searched; if
+it is not found, then the user is queried to create it.
+
+[fn:28] If the headline contains a timestamp, it is removed from the
+link, which results in a wrong link---you should avoid putting
+a timestamp in the headline.
+
+[fn:29] The Org Id library must first be loaded, either through
+~org-customize~, by enabling ~id~ in ~org-modules~, or by adding
+=(require 'org-id)= in your Emacs init file.
+
+[fn:30] Note that you do not 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 descriptive text.
+
+[fn:31] After insertion of a stored link, the link will be removed
+from the list of stored links. To keep it in the list for later use,
+use a triple {{{kbd(C-u)}}} prefix argument to {{{kbd(C-c C-l)}}}, or
+configure the option ~org-link-keep-stored-after-insertion~.
+
+[fn:32] This works if a function has been defined in the ~:complete~
+property of a link in ~org-link-parameters~.
+
+[fn:33] See the variable ~org-link-use-indirect-buffer-for-internals~.
+
+[fn:34] For backward compatibility, line numbers can also follow a
+single colon.
+
+[fn:35] Of course, you can make a document that contains only long
+lists of TODO items, but this is not required.
+
+[fn:36] Changing the variable ~org-todo-keywords~ only becomes
+effective after restarting Org mode in a buffer.
+
+[fn:37] This is also true for the {{{kbd(t)}}} command in the agenda
+buffer.
+
+[fn:38] All characters are allowed except =@=, =^= and =!=, which have
+a special meaning here.
+
+[fn:39] Check also the variable ~org-fast-tag-selection-include-todo~,
+it allows you to change the TODO state through the tags interface (see
+[[*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.
+
+[fn:40] Org mode parses these lines only when Org mode is activated
+after visiting a file. {{{kbd(C-c C-c)}}} with point in a line
+starting with =#+= is simply restarting Org mode for the current
+buffer.
+
+[fn:41] The corresponding in-buffer setting is: =#+STARTUP: logdone=.
+
+[fn:42] The corresponding in-buffer setting is: =#+STARTUP:
+lognotedone=.
+
+[fn:43] See the variable ~org-log-states-order-reversed~.
+
+[fn:44] Note that the =LOGBOOK= drawer is unfolded when pressing
+{{{kbd(SPC)}}} in the agenda to show an entry---use {{{kbd(C-u
+SPC)}}} to keep it folded here.
+
+[fn:45] It is possible that Org mode records two timestamps when you
+are using both ~org-log-done~ and state change logging. However, it
+never prompts for two notes: if you have configured both, the state
+change recording note takes precedence and cancel the closing note.
+
+[fn:46] See also the option ~org-priority-start-cycle-with-default~.
+
+[fn:47] To keep subtasks out of the global TODO list, see the option
+~org-agenda-todo-list-sublevels~.
+
+[fn:48] With the exception of description lists. But you can allow it
+by modifying ~org-list-automatic-rules~ accordingly.
+
+[fn:49] Set the variable ~org-hierarchical-checkbox-statistics~ if you
+want such cookies to count all checkboxes below the cookie, not just
+those belonging to direct children.
+
+[fn:50] {{{kbd(C-u C-c C-c)}}} on the /first/ item of a list with no
+checkbox adds checkboxes to the rest of the list.
+
+[fn:51] As with all these in-buffer settings, pressing {{{kbd(C-c
+C-c)}}} activates any changes in the line.
+
+[fn:52] This is only true if the search does not involve more complex
+tests including properties (see [[*Property Searches]]).
+
+[fn:53] To extend this default list to all tags used in all agenda
+files (see [[*Agenda Views]]), customize the variable
+~org-complete-tags-always-offer-all-agenda-tags~.
+
+[fn:54] Keys are automatically assigned to tags that have no
+configured keys.
+
+[fn:55] If more than one summary type applies to the same property,
+the parent values are computed according to the first of them.
+
+[fn:56] An age can be defined as a duration, using units defined in
+~org-duration-units~, e.g., =3d 1h=. If any value in the column is as
+such, the summary is also expressed as a duration.
+
+[fn:57] Please note that the =COLUMNS= definition must be on a single
+line; it is wrapped here only because of formatting constraints.
+
+[fn:58] Contributed packages are not part of Emacs, but are
+distributed with the main distribution of Org---visit
+[[https://orgmode.org]].
+
+[fn:59] The Org date format is inspired by the standard ISO 8601
+date/time format. To use an alternative format, see [[*Custom time
+format]]. The day name is optional when you type the date yourself.
+However, any date inserted or modified by Org adds that day name, for
+reading convenience.
+
+[fn:60] When working with the standard diary expression functions, you
+need to be very careful with the order of the arguments. That order
+depends evilly on the variable ~calendar-date-style~. For example, to
+specify a date December 12, 2005, the call might look like
+=(diary-date 12 1 2005)= or =(diary-date 1 12 2005)= or =(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 ~org-date~ or ~org-anniversary~. These work just
+like the corresponding ~diary-~ functions, but with stable ISO order
+of arguments (year, month, day) wherever applicable, independent of
+the value of ~calendar-date-style~.
+
+[fn:61] See the variable ~org-read-date-prefer-future~. You may set
+that variable to the symbol ~time~ to even make a time before now
+shift the date to tomorrow.
+
+[fn:62] If you do not need/want the calendar, configure the variable
+~org-popup-calendar-for-date-prompt~.
+
+[fn:63] You can also use the calendar command {{{kbd(.)}}} to jump to
+today's date, but if you are inserting an hour specification for your
+timestamp, {{{kbd(.)}}} will then insert a dot after the hour. By contrast,
+{{{kbd(C-.)}}} will always jump to today's date.
+
+[fn:64] If you find this distracting, turn off the display with
+~org-read-date-display-live~.
+
+[fn:65] It will still be listed on that date after it has been marked
+as done. If you do not like this, set the variable
+~org-agenda-skip-scheduled-if-done~.
+
+[fn:66] The =SCHEDULED= and =DEADLINE= dates are inserted on the line
+right below the headline. Do not put any text between this line and
+the headline.
+
+[fn:67] Note the corresponding =STARTUP= options =logredeadline=,
+=lognoteredeadline=, and =nologredeadline=.
+
+[fn:68] Note the corresponding =STARTUP= options =logreschedule=,
+=lognotereschedule=, and =nologreschedule=.
+
+[fn:69] Org does not repeat inactive timestamps, however. See
+[[*Timestamps]].
+
+[fn:70] In fact, the target state is taken from, in this sequence, the
+=REPEAT_TO_STATE= property, the variable ~org-todo-repeat-to-state~ if
+it is a string, the previous TODO state if ~org-todo-repeat-to-state~
+is ~t~, or the first state of the TODO state sequence.
+
+[fn:71] You can change this using the option ~org-log-repeat~, or the
+=STARTUP= options =logrepeat=, =lognoterepeat=, and =nologrepeat=.
+With =lognoterepeat=, you will also be prompted for a note.
+
+[fn:72] Clocking only works if all headings are indented with less
+than 30 stars. This is a hard-coded limitation of ~lmax~ in
+~org-clock-sum~.
+
+[fn:73] To resume the clock under the assumption that you have worked
+on this task while outside Emacs, use =(setq org-clock-persist t)=.
+
+[fn:74] To add an effort estimate "on the fly", hook a function doing
+this to ~org-clock-in-prepare-hook~.
+
+[fn:75] The last reset of the task is recorded by the =LAST_REPEAT=
+property.
+
+[fn:76] See also the variable ~org-clock-mode-line-total~.
+
+[fn:77] The corresponding in-buffer setting is: =#+STARTUP:
+lognoteclock-out=.
+
+[fn:78] When using ~:step~, ~untilnow~ starts from the beginning of
+2003, not the beginning of time.
+
+[fn:79] Language terms can be set through the variable
+~org-clock-clocktable-language-setup~.
+
+[fn:80] Note that all parameters must be specified in a single
+line---the line is broken here only to fit it into the manual.
+
+[fn:81] On computers using macOS, idleness is based on actual user
+idleness, not just Emacs' idle time. For X11, you can install
+a utility program =x11idle.c=, available in the =contrib/scripts/=
+directory of the Org Git distribution, or install the xprintidle
+package and set it to the variable ~org-clock-x11idle-program-name~ if
+you are running Debian, to get the same general treatment of idleness.
+On other systems, idle time refers to Emacs idle time only.
+
+[fn:82] Please note the pitfalls of summing hierarchical data in
+a flat list (see [[*Using Column View in the Agenda]]).
+
+[fn:83] Note the corresponding =STARTUP= options =logrefile=,
+=lognoterefile=, and =nologrefile=.
+
+[fn:84] Org used to offer four different targets for date/week tree
+capture. Now, Org automatically translates these to use
+~file+olp+datetree~, applying the ~:time-prompt~ and ~:tree-type~
+properties. Please rewrite your date/week-tree targets using
+~file+olp+datetree~ since the older targets are now deprecated.
+
+[fn:85] 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.
+
+[fn:86] When the file name is not absolute, Org assumes it is relative
+to ~org-directory~.
+
+[fn:87] If you need one of these sequences literally, escape the =%=
+with a backslash.
+
+[fn:88] If you define your own link types (see [[*Adding Hyperlink
+Types]]), any property you store with ~org-store-link-props~ can be
+accessed in capture templates in a similar way.
+
+[fn:89] This is always the other, not the user. See the variable
+~org-link-from-user-regexp~.
+
+[fn:90] If you move entries or Org files from one directory to
+another, you may want to configure ~org-attach-id-dir~ to contain
+an absolute path.
+
+[fn:91] If the value of that variable is not a list, but a single file
+name, then the list of agenda files in maintained in that external
+file.
+
+[fn:92] When using the dispatcher, pressing {{{kbd(<)}}} before
+selecting a command actually limits the command to the current file,
+and ignores ~org-agenda-files~ until the next dispatcher command.
+
+[fn:93] For backward compatibility, you can also press {{{kbd(1)}}} to
+restrict to the current buffer.
+
+[fn:94] For backward compatibility, you can also press {{{kbd(0)}}} to
+restrict to the current region/subtree.
+
+[fn:95] For backward compatibility, the universal prefix argument
+{{{kbd(C-u)}}} causes all TODO entries to be listed before the agenda.
+This feature is deprecated, use the dedicated TODO list, or a block
+agenda instead (see [[*Block agenda]]).
+
+[fn:96] The variable ~org-anniversary~ used in the example is just
+like ~diary-anniversary~, but the argument order is always according
+to ISO and therefore independent of the value of
+~calendar-date-style~.
+
+[fn:97] You can, however, disable this by setting
+~org-agenda-search-headline-for-time~ variable to a ~nil~ value.
+
+[fn:98] Custom agenda commands can preset a filter by binding one of
+the variables ~org-agenda-tag-filter-preset~,
+~org-agenda-category-filter-preset~, ~org-agenda-effort-filter-preset~
+or ~org-agenda-regexp-filter-preset~ as an option. This filter is
+then applied to the view and persists as a basic filter through
+refreshes and more secondary filtering. The filter is a global
+property of the entire agenda view---in a block agenda, you should
+only set this in the global options section, not in the section of an
+individual block.
+
+[fn:99] Only tags filtering is respected here, effort filtering is
+ignored.
+
+[fn:100] You can also create persistent custom functions through
+~org-agenda-bulk-custom-functions~.
+
+[fn:101] This file is parsed for the agenda when
+~org-agenda-include-diary~ is set.
+
+[fn:102] You can provide a description for a prefix key by inserting
+a cons cell with the prefix and the description.
+
+[fn:103] /Planned/ means here that these entries have some planning
+information attached to them, like a time-stamp, a scheduled or
+a deadline string. See ~org-agenda-entry-types~ on how to set what
+planning information is taken into account.
+
+[fn:104] For HTML you need to install Hrvoje Nikšić's =htmlize.el=
+as an Emacs package from MELPA or from [[https://github.com/hniksic/emacs-htmlize][Hrvoje Nikšić's repository]].
+
+[fn:105] To create PDF output, the Ghostscript ps2pdf utility must be
+installed on the system. Selecting a PDF file also creates the
+postscript file.
+
+[fn:106] If you want to store standard views like the weekly agenda or
+the global TODO list as well, you need to define custom commands for
+them in order to be able to specify file names.
+
+[fn:107] Quoting depends on the system you use, please check the FAQ
+for examples.
+
+[fn:108] You can turn this on by default by setting the variable
+~org-pretty-entities~, or on a per-file base with the =STARTUP= option
+=entitiespretty=.
+
+[fn:109] This behavior can be disabled with =-= export setting (see
+[[*Export Settings]]).
+
+[fn:110] LaTeX is a macro system based on Donald\nbsp{}E.\nbsp{}Knuth's TeX
+system. Many of the features described here as "LaTeX" are really
+from TeX, but for simplicity I am blurring this distinction.
+
+[fn:111] When MathJax is used, only the environments recognized by
+MathJax are processed. When dvipng, dvisvgm, or ImageMagick suite is
+used to create images, any LaTeX environment is handled.
+
+[fn:112] These are respectively available at
+[[http://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]]
+and from the ImageMagick suite. Choose the converter by setting the
+variable ~org-preview-latex-default-process~ accordingly.
+
+[fn:113] Org mode has a method to test if point is inside such
+a fragment, see the documentation of the function
+~org-inside-LaTeX-fragment-p~.
+
+[fn:114] This works automatically for the HTML backend (it requires
+version 1.34 of the =htmlize.el= package, which you need to install).
+Fontified code chunks in LaTeX can be achieved using either the
+[[https://www.ctan.org/pkg/listings][listings]] package or the [[https://www.ctan.org/pkg/minted][minted]] package. Refer to
+~org-export-latex-listings~ for details.
+
+[fn:115] Source code in code blocks may also be evaluated either
+interactively or on export. See [[*Working with Source Code]] for more
+information on evaluating code blocks.
+
+[fn:116] Adding =-k= to =-n -r= /keeps/ the labels in the source code
+while using line numbers for the links, which might be useful to
+explain those in an Org mode example code.
+
+[fn:117] You may select a different mode with the variable
+~org-edit-fixed-width-region-mode~.
+
+[fn:118] What Emacs considers to be an image depends on
+~image-file-name-extensions~ and ~image-file-name-regexps~.
+
+[fn:119] The variable ~org-startup-with-inline-images~ can be set
+within a buffer with the =STARTUP= options =inlineimages= and
+=noinlineimages=.
+
+[fn:120] The corresponding in-buffer setting is: =#+STARTUP: fninline=
+or =#+STARTUP: nofninline=.
+
+[fn:121] The corresponding in-buffer options are =#+STARTUP: fnadjust=
+and =#+STARTUP: nofnadjust=.
+
+[fn:122] The variable ~org-export-date-timestamp-format~ defines how
+this timestamp are exported.
+
+[fn:123] DEFINITION NOT FOUND.
+
+[fn:124] At the moment, some export back-ends do not obey this
+specification. For example, LaTeX export excludes every unnumbered
+headline from the table of contents.
+
+[fn:125] Note that ~org-link-search-must-match-exact-headline~ is
+locally bound to non-~nil~. Therefore, ~org-link-search~ only matches
+headlines and named elements.
+
+[fn:126] 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.
+
+[fn:127] For a less drastic behavior, consider using a select tag (see
+[[*Export Settings]]) instead.
+
+[fn:128] If =BEAMER_ENV= is set, Org export adds =B_environment= tag
+to make it visible. The tag serves as a visual aid and has no
+semantic relevance.
+
+[fn:129] By default Org loads MathJax from [[https://cdnjs.com][cdnjs.com]] as recommended by
+[[http://www.mathjax.org][MathJax]].
+
+[fn:130] Please note that exported formulas are part of an HTML
+document, and that signs such as =<=, =>=, or =&= have special
+meanings. See [[http://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents][MathJax TeX and LaTeX support]].
+
+[fn:131] See [[http://docs.mathjax.org/en/latest/tex.html#tex-extensions][TeX and LaTeX extensions]] in the [[http://docs.mathjax.org][MathJax manual]] to learn
+about extensions.
+
+[fn:132] If the classes on TODO keywords and tags lead to conflicts,
+use the variables ~org-html-todo-kwd-class-prefix~ and
+~org-html-tag-class-prefix~ to make them unique.
+
+[fn:133] This does not allow setting different bibliography compilers
+for different files. However, "smart" LaTeX compilation systems, such
+as latexmk, can select the correct bibliography compiler.
+
+[fn:134] See [[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document Format for Office Applications
+(OpenDocument) Version 1.2]].
+
+[fn:135] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].
+
+[fn:136] See [[http://dlmf.nist.gov/LaTeXML/]].
+
+[fn:137] [[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2 Specification]]
+
+[fn:138] See the =<table:table-template>= element of the
+OpenDocument-v1.2 specification.
+
+[fn:139] See the attributes =table:template-name=,
+=table:use-first-row-styles=, =table:use-last-row-styles=,
+=table:use-first-column-styles=, =table:use-last-column-styles=,
+=table:use-banding-rows-styles=, and =table:use-banding-column-styles=
+of the =<table:table>= element in the OpenDocument-v1.2 specification.
+
+[fn:140] If the publishing directory is the same as the source
+directory, =file.org= is exported as =file.org.org=, so you probably
+do not want to do this.
+
+[fn:141] The option ~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.
+
+[fn:142] Actually, the constructs =call_<name>()= and =src_<lang>{}=
+are not evaluated when they appear in a keyword (see [[*Summary of
+In-Buffer Settings]]).
+
+[fn:143] C++ language is handled in =ob-C.el=. Even though the
+identifier for such source blocks is =C++=, you activate it by loading
+the C language.
+
+[fn:144] D language is handled in =ob-C.el=. Even though the
+identifier for such source blocks is =D=, you activate it by loading
+the C language.
+
+[fn:145] For noweb literate programming details, see
+http://www.cs.tufts.edu/~nr/noweb/.
+
+[fn:146] For more information, please refer to the commentary section
+in =org-tempo.el=.
+
+[fn:147] Org Indent mode also sets ~wrap-prefix~ correctly for
+indenting and wrapping long lines of headlines or text. This minor
+mode also handles Visual Line mode and directly applied settings
+through ~word-wrap~.
+
+[fn:148] This works, but requires extra effort. Org Indent mode is
+more convenient for most applications.
+
+[fn:149] ~org-adapt-indentation~ can also be set to ='headline-data=,
+in which case only data lines below the headline will be indented.
+
+[fn:150] Note that Org Indent mode also sets the ~wrap-prefix~
+property, such that Visual Line mode (or purely setting ~word-wrap~)
+wraps long lines, including headlines, correctly indented.
+
+[fn:151] For a server to host files, consider using a WebDAV server,
+such as [[https://nextcloud.com][Nextcloud]]. Additional help is at this [[https://orgmode.org/worg/org-faq.html#mobileorg_webdav][FAQ entry]].
+
+[fn:152] If Emacs is configured for safe storing of passwords, then
+configure the variable ~org-mobile-encryption-password~; please read
+the docstring of that variable.
+
+[fn:153] Symbolic links in ~org-directory~ need to have the same name
+as their targets.
+
+[fn:154] While creating the agendas, Org mode forces =ID= properties
+on all referenced entries, so that these entries can be uniquely
+identified if Org Mobile flags them for further action. To avoid
+setting properties configure the variable
+~org-mobile-force-id-on-agenda-items~ to ~nil~. Org mode then relies
+on outline paths, assuming they are unique.
+
+[fn:155] Checksums are stored automatically in the file
+=checksums.dat=.
+
+[fn:156] The file will be empty after this operation.
+
+[fn:157] https://www.ctan.org/pkg/comment
+
+[fn:158] By default this works only for LaTeX, HTML, and Texinfo.
+Configure the variable ~orgtbl-radio-table-templates~ to install
+templates for other modes.
+
+[fn:159] If the =TBLFM= keyword 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 =comment= environment that is used to balance the dollar
+expressions. If you are using AUCTeX with the font-latex library,
+a much better solution is to add the =comment= environment to the
+variable ~LaTeX-verbatim-environments~.
+
+[fn:160] The ~agenda*~ view is the same as ~agenda~ except that it
+only considers /appointments/, i.e., scheduled and deadline items that
+have a time specification =[h]h:mm= in their time-stamps.
+
+[fn:161] Note that, for ~org-odd-levels-only~, a level number
+corresponds to order in the hierarchy, not to the number of stars.
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
deleted file mode 100644
index 8902d628875..00000000000
--- a/doc/misc/org.texi
+++ /dev/null
@@ -1,23148 +0,0 @@
-\input texinfo @c -*- texinfo -*-
-@c %**start of header
-@setfilename org.info
-@settitle The Org Manual
-@documentencoding UTF-8
-@documentlanguage en
-@set txicodequoteundirected
-@set txicodequotebacktick
-@set MAINTAINERSITE @uref{https://orgmode.org,maintainers webpage}
-@set MAINTAINER Bastien Guerry
-@set MAINTAINEREMAIL @email{bzg@gnu.org}
-@set MAINTAINERCONTACT @uref{mailto:bzg@gnu.org,contact the maintainer}
-@c %**end of header
-
-@copying
-This manual is for Org version 9.4.
-
-Copyright @copyright{} 2004--2021 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,''
-and with the Back-Cover Texts as in (a) below. A copy of the license
-is included in the section entitled ``GNU Free Documentation License.''
-
-(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
-modify this GNU manual.''
-
-@end quotation
-@end copying
-
-@dircategory Emacs editing modes
-@direntry
-* Org Mode: (org). Outline-based notes management and organizer.
-@end direntry
-
-@finalout
-@titlepage
-@title The Org Manual
-@subtitle Release 9.4
-@author The Org Mode Developers
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@contents
-
-@ifnottex
-@node Top
-@top The Org Manual
-
-@insertcopying
-@end ifnottex
-
-@menu
-* Introduction:: Getting started.
-* 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.
-* Tags:: Tagging headlines and matching sets of tags.
-* Properties and Columns:: Storing information about an entry.
-* Dates and Times:: Making items useful for planning.
-* Refiling and Archiving:: Moving and copying information with ease.
-* Capture and Attachments:: Dealing with external data.
-* Agenda Views:: Collecting information into views.
-* Markup for Rich Contents:: Compose beautiful documents.
-* Exporting:: Sharing and publishing notes.
-* Publishing:: Create a web site of linked Org files.
-* 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.
-* 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.
-* Command and Function Index:: Command names and some internal functions.
-* Variable Index:: Variables mentioned in the manual.
-
-@detailmenu
---- The Detailed Node Listing ---
-
-Introduction
-
-* Summary:: Brief summary of what Org does.
-* Installation:: Installing Org.
-* Activation:: How to activate Org for certain buffers.
-* Feedback:: Bug reports, ideas, patches, etc.
-* Conventions:: Typesetting conventions used in this manual.
-
-Document Structure
-
-* Headlines:: How to typeset Org tree headlines.
-* Visibility Cycling:: Show and hide, much simplified.
-* Motion:: Jumping to other headlines.
-* Structure Editing:: Changing sequence and level of headlines.
-* Sparse Trees:: Matches embedded in context.
-* Plain Lists:: Additional structure within an entry.
-* Drawers:: Tucking stuff away.
-* Blocks:: Folding blocks.
-
-Visibility Cycling
-
-* Global and local cycling:: Cycling through various visibility states.
-* Initial visibility:: Setting the initial visibility state.
-* Catching invisible edits:: Preventing mistakes when editing invisible parts.
-
-Tables
-
-* Built-in Table Editor:: Simple tables.
-* Column Width and Alignment:: Overrule the automatic settings.
-* Column Groups:: Grouping to trigger vertical lines.
-* Orgtbl Mode:: The table editor as minor mode.
-* The Spreadsheet:: The table editor has spreadsheet capabilities.
-* Org Plot:: Plotting from Org tables.
-
-The Spreadsheet
-
-* References:: How to refer to another field or range.
-* Formula syntax for Calc:: Using Calc to compute stuff.
-* Formula syntax for Lisp:: Writing formulas in Emacs Lisp.
-* Durations and time values:: How to compute durations and time values.
-* Field and range formulas:: Formula for specific (ranges of) fields.
-* Column formulas:: Formulas valid for an entire column.
-* Lookup functions:: Lookup functions for searching tables.
-* Editing and debugging formulas:: Fixing formulas.
-* Updating the table:: Recomputing all dependent fields.
-* Advanced features:: Field and column names, automatic recalculation...
-
-Hyperlinks
-
-* Link Format:: How links in Org are formatted.
-* Internal Links:: Links to other places in the current file.
-* Radio Targets:: Make targets trigger links in plain text.
-* External Links:: URL-like links to the world.
-* Handling Links:: Creating, inserting and following.
-* Using Links Outside Org:: Linking from my C source code?
-* Link Abbreviations:: Shortcuts for writing complex links.
-* Search Options:: Linking to a specific location.
-* Custom Searches:: When the default search is not enough.
-
-TODO Items
-
-* TODO Basics:: Marking and displaying TODO entries.
-* TODO Extensions:: Workflow and assignments.
-* Progress Logging:: Dates and notes for progress.
-* Priorities:: Some things are more important than others.
-* Breaking Down Tasks:: Splitting a task into manageable pieces.
-* Checkboxes:: Tick-off lists.
-
-TODO Extensions
-
-* Workflow states:: From TODO to DONE in steps.
-* TODO types:: I do this, Fred does the rest.
-* Multiple sets in one file:: Mixing it all, still finding your way.
-* Fast access to TODO states:: Single letter selection of state.
-* Per-file keywords:: Different files, different requirements.
-* Faces for TODO keywords:: Highlighting states.
-* TODO dependencies:: When one task needs to wait for others.
-
-Progress Logging
-
-* Closing items:: When was this entry marked as done?
-* Tracking TODO state changes:: When did the status change?
-* Tracking your habits:: How consistent have you been?
-
-Tags
-
-* Tag Inheritance:: Tags use the tree structure of an outline.
-* Setting Tags:: How to assign tags to a headline.
-* Tag Hierarchy:: Create a hierarchy of tags.
-* Tag Searches:: Searching for combinations of tags.
-
-Properties and Columns
-
-* Property Syntax:: How properties are spelled out.
-* Special Properties:: Access to other Org mode features.
-* Property Searches:: Matching property values.
-* Property Inheritance:: Passing values down a tree.
-* Column View:: Tabular viewing and editing.
-
-Column View
-
-* Defining columns:: The COLUMNS format property.
-* Using column view:: How to create and use column view.
-* Capturing column view:: A dynamic block for column view.
-
-Defining columns
-
-* Scope of column definitions:: Where defined, where valid?
-* Column attributes:: Appearance and content of a column.
-
-Dates and Times
-
-* Timestamps:: Assigning a time to a tree entry.
-* Creating Timestamps:: Commands to insert timestamps.
-* Deadlines and Scheduling:: Planning your work.
-* Clocking Work Time:: Tracking how long you spend on a task.
-* Effort Estimates:: Planning work effort in advance.
-* Timers:: Notes with a running timer.
-
-Creating Timestamps
-
-* The date/time prompt:: How Org mode helps you enter dates and times.
-* Custom time format:: Making dates look different.
-
-Deadlines and Scheduling
-
-* Inserting deadline/schedule:: Planning items.
-* Repeated tasks:: Items that show up again and again.
-
-Clocking Work Time
-
-* Clocking commands:: Starting and stopping a clock.
-* The clock table:: Detailed reports.
-* Resolving idle time:: Resolving time when you've been idle.
-
-Refiling and Archiving
-
-* Refile and Copy:: Moving/copying a tree from one place to another.
-* Archiving:: What to do with finished products.
-
-Archiving
-
-* Moving subtrees:: Moving a tree to an archive file.
-* Internal archiving:: Switch off a tree but keep it in the file.
-
-Capture and Attachments
-
-* Capture:: Capturing new stuff.
-* Attachments:: Attach files to outlines.
-* RSS Feeds:: Getting input from RSS feeds.
-
-Capture
-
-* Setting up capture:: Where notes will be stored.
-* Using capture:: Commands to invoke and terminate capture.
-* Capture templates:: Define the outline of different note types.
-
-Capture templates
-
-* Template elements:: What is needed for a complete template entry.
-* Template expansion:: Filling in information about time and context.
-* Templates in contexts:: Only show a template in a specific context.
-
-Attachments
-
-* Attachment defaults and dispatcher:: How to access attachment commands
-* Attachment options:: Configuring the attachment system
-* Attachment links:: Hyperlink access to attachments
-* Automatic version-control with Git:: Everything safely stored away
-* Attach from Dired:: Using dired to select an attachment
-
-Agenda Views
-
-* Agenda Files:: Files being searched for agenda information.
-* Agenda Dispatcher:: Keyboard access to agenda views.
-* Built-in Agenda Views:: What is available out of the box?
-* 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.
-* Agenda Column View:: Using column view for collected entries.
-
-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.
-* Search view:: Find entries by searching for text.
-* Stuck projects:: Find projects you need to review.
-
-Presentation and Sorting
-
-* Categories:: Not all tasks are equal.
-* Time-of-day specifications:: How the agenda knows the time.
-* Sorting of agenda items:: The order of things.
-* Filtering/limiting agenda items:: Dynamically narrow the agenda.
-
-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.
-
-Markup for Rich Contents
-
-* Paragraphs:: The basic unit of text.
-* Emphasis and Monospace:: Bold, italic, etc.
-* Subscripts and Superscripts:: Simple syntax for raising/lowering text.
-* Special Symbols:: Greek letters and other symbols.
-* Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents.
-* Literal Examples:: Source code examples with special formatting.
-* Images:: Display an image.
-* Captions:: Describe tables, images...
-* Horizontal Rules:: Make a line.
-* Creating Footnotes:: Edit and read footnotes.
-
-Embedded @LaTeX{}
-
-* @LaTeX{} fragments:: Complex formulas made easy.
-* Previewing @LaTeX{} fragments:: What will this snippet look like?
-* CD@LaTeX{} mode:: Speed up entering of formulas.
-
-Exporting
-
-* 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:: Producing presentations and slides.
-* HTML Export:: Exporting to HTML.
-* @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.
-* Advanced Export 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.
-* Frames and Blocks in Beamer:: For composing Beamer slides.
-* Beamer specific syntax:: For using in Org documents.
-* Editing support:: Editing support.
-* A Beamer example:: A complete presentation.
-
-HTML Export
-
-* 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.
-* Headlines in HTML export:: Formatting headlines.
-* Links in HTML export:: Inserting and formatting links.
-* 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 alternate way to show an example.
-* CSS support:: Changing the appearance of the output.
-* JavaScript support:: Info and folding in a web browser.
-
-@LaTeX{} Export
-
-* @LaTeX{}/PDF export commands:: For producing @LaTeX{} and PDF documents.
-* @LaTeX{} specific export settings:: Unique to this @LaTeX{} back-end.
-* @LaTeX{} header and sectioning:: Setting up the export file structure.
-* Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code.
-* Tables in @LaTeX{} export:: Options for exporting tables to @LaTeX{}.
-* Images in @LaTeX{} export:: How to insert figures into @LaTeX{} output.
-* 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:: Required packages.
-* ODT export commands:: Invoking export.
-* ODT specific export settings:: Configuration options.
-* Extending ODT export:: Producing DOC, PDF files.
-* Applying custom styles:: Styling the output.
-* Links in ODT export:: Handling and formatting links.
-* Tables in ODT export:: Org tables 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
-
-* @LaTeX{} math snippets:: Embedding in @LaTeX{} format.
-* MathML and OpenDocument formula files:: Embedding in native format.
-
-Texinfo Export
-
-* 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.
-* Quotations in Texinfo export:: Quote block attributes.
-* Special blocks in Texinfo export:: Special block attributes.
-* A Texinfo example:: Processing Org to Texinfo.
-
-Export in Foreign Buffers
-
-* Bare HTML:: Exporting HTML without CSS, Javascript, etc.
-
-Publishing
-
-* Configuration:: Defining projects.
-* Uploading Files:: How to get files up on the server.
-* Sample Configuration:: Example projects.
-* Triggering Publication:: Publication commands.
-
-Configuration
-
-* Project alist:: The central configuration variable.
-* Sources and destinations:: From here to there.
-* Selecting files:: What files are part of the project?
-* Publishing action:: Setting the function doing the publishing.
-* Publishing options:: Tweaking HTML/@LaTeX{} export.
-* Publishing links:: Which links keep working after publishing?
-* Site map:: Generating a list of all pages.
-* Generating an index:: An index that reaches across pages.
-
-Sample Configuration
-
-* Simple example:: One-component publishing.
-* Complex example:: A multi-component publishing example.
-
-Working with Source Code
-
-* Features Overview:: Enjoy the versatility of source blocks.
-* Structure of Code Blocks:: Code block syntax described.
-* Using Header Arguments:: Different ways to set header arguments.
-* Environment of a Code Block:: Arguments, sessions, working directory...
-* Evaluating Code Blocks:: Place results of evaluation in the Org buffer.
-* Results of Evaluation:: Choosing a results type, post-processing...
-* Exporting Code Blocks:: Export contents and/or results.
-* Extracting Source Code:: Create pure source code files.
-* Languages:: List of supported code block languages.
-* Editing Source Code:: Language major-mode editing.
-* Noweb Reference Syntax:: Literate programming in Org mode.
-* Library of Babel:: Use and contribute to a library of useful code blocks.
-* Key bindings and Useful Functions:: Work quickly with code blocks.
-* Batch Execution:: Call functions from the command line.
-
-Miscellaneous
-
-* Completion:: @kbd{M-@key{TAB}} guesses completions.
-* Structure Templates:: Quick insertion of structural elements.
-* Speed Keys:: Electric commands at the beginning of a headline.
-* Clean View:: Getting rid of leading stars in the outline.
-* Execute commands in the active region:: Execute commands on multiple items in Org or agenda view.
-* Dynamic Headline Numbering:: Display and update outline numbering.
-* The Very Busy @kbd{C-c C-c} Key:: When in doubt, press @kbd{C-c C-c}.
-* In-buffer Settings:: Overview of keywords.
-* Org Syntax:: Formal description of Org's syntax.
-* Documentation Access:: Read documentation about current syntax.
-* Escape Character:: Prevent Org from interpreting your writing.
-* Code Evaluation Security:: Org files evaluate in-line code.
-* Interaction:: With other Emacs packages.
-* TTY Keys:: Using Org on a tty.
-* Protocols:: External access to Emacs and Org.
-* Org Crypt:: Encrypting Org files.
-* Org Mobile:: Viewing and capture on a mobile device.
-
-Clean View
-
-* Org Indent Mode::
-* Hard indentation::
-
-Interaction
-
-* Cooperation:: Packages Org cooperates with.
-* Conflicts:: Packages that lead to conflicts.
-
-Protocols
-
-* The @code{store-link} protocol:: Store a link, push URL to kill-ring.
-* The @code{capture} protocol:: Fill a buffer with external information.
-* The @code{open-source} protocol:: Edit published contents.
-
-Org Mobile
-
-* Setting up the staging area:: For the mobile device.
-* Pushing to the mobile application:: Uploading Org files and agendas.
-* Pulling from the mobile application:: Integrating captured and flagged items.
-
-Hacking
-
-* Hooks: Hooks (2). How to reach into Org's internals.
-* Add-on Packages:: Available extensions.
-* Adding Hyperlink Types:: New custom link types.
-* Adding Export Back-ends:: How to write new export back-ends.
-* Tables in Arbitrary Syntax:: Orgtbl for LaTeX and other programs.
-* Dynamic Blocks:: Automatically filled blocks.
-* Special Agenda Views:: Customized views.
-* Speeding Up Your Agendas:: Tips on how to speed up your agendas.
-* Extracting Agenda Information:: Post-processing agenda information.
-* Using the Property API:: Writing programs that use entry properties.
-* Using the Mapping API:: Mapping over all or selected entries.
-
-Tables in Arbitrary Syntax
-
-* Radio tables:: Sending and receiving radio tables.
-* A @LaTeX{} example:: Step by step, almost a tutorial.
-* Translator functions:: Copy and modify.
-
-@end detailmenu
-@end menu
-
-@node Introduction
-@chapter Introduction
-
-@cindex introduction
-
-@menu
-* Summary:: Brief summary of what Org does.
-* Installation:: Installing Org.
-* Activation:: How to activate Org for certain buffers.
-* Feedback:: Bug reports, ideas, patches, etc.
-* Conventions:: Typesetting conventions used in this manual.
-@end menu
-
-@node Summary
-@section Summary
-
-@cindex summary
-
-Org is a mode for keeping notes, maintaining TODO lists, and project
-planning with a fast and effective plain-text markup language. 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 make use of metadata which is part of an outline
-node. Based on this data, specific entries can be extracted in
-queries and create dynamic @emph{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{https://orgmode.org}.
-
-@cindex print edition
-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.}.
-
-@node Installation
-@section Installation
-
-@cindex installation
-
-Org is included in all recent distributions of GNU Emacs, so you
-probably do not need to install it. Most users will simply activate
-Org and begin exploring its many features.
-
-If, for one reason or another, you want to install Org on top of this
-pre-packaged version, there are three ways to do it:
-
-@itemize
-@item
-by using the Emacs package system;
-@item
-by downloading Org as an archive; or
-@item
-by using Org's git repository.
-@end itemize
-
-We @strong{strongly recommend} sticking to a single installation method.
-
-@anchor{Using Emacs packaging system}
-@subheading Using Emacs packaging system
-
-Recent Emacs distributions include a packaging system which lets you
-install Elisp libraries. You can install Org from the ``package menu'',
-with @kbd{M-x list-packages}. See @ref{Package Menu,Package Menu,,emacs,}.
-
-@quotation Important
-You need to do this in a session where no @samp{.org} file has been
-visited, i.e., where no Org built-in function have been loaded.
-Otherwise autoload Org functions will mess up the installation.
-
-@end quotation
-
-If you want to use Org's package repository, check out the @uref{https://orgmode.org/elpa.html, Org ELPA
-page}.
-
-@anchor{Downloading Org as an archive}
-@subheading Downloading Org as an archive
-
-You can download Org latest release from @uref{https://orgmode.org/, Org's website}. In this case,
-make sure you set the load path correctly in your Emacs init file:
-
-@lisp
-(add-to-list 'load-path "~/path/to/orgdir/lisp")
-@end lisp
-
-The downloaded archive contains contributed libraries that are not
-included in Emacs. If you want to use them, add the @samp{contrib/}
-directory to your load path:
-
-@lisp
-(add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
-@end lisp
-
-Optionally, you can compile the files and/or install them in your
-system. Run @samp{make help} to list compilation and installation options.
-
-@anchor{Using Org's git repository}
-@subheading Using Org's git repository
-
-You can clone Org's repository and install Org like this:
-
-@example
-$ cd ~/src/
-$ git clone https://code.orgmode.org/bzg/org-mode.git
-$ cd org-mode/
-$ make autoloads
-@end example
-
-Note that in this case, @samp{make autoloads} is mandatory: it defines
-Org's version in @samp{org-version.el} and Org's autoloads in
-@samp{org-loaddefs.el}.
-
-Remember to add the correct load path as described in the method
-above.
-
-You can also compile with @samp{make}, generate the documentation with
-@samp{make doc}, create a local configuration with @samp{make config} and
-install Org with @samp{make install}. Please run @samp{make help} to get the
-list of compilation/installation options.
-
-For more detailed explanations on Org's build system, please check the
-Org Build System page on @uref{https://orgmode.org/worg/dev/org-build-system.html, Worg}.
-
-@node Activation
-@section Activation
-
-@cindex activation
-@cindex autoload
-@cindex ELPA
-@cindex global key bindings
-@cindex key bindings, global
-
-Org mode buffers need Font Lock to be turned on: this is the default
-in Emacs@footnote{If you do not use Font Lock globally turn it on in Org buffer
-with @samp{(add-hook 'org-mode-hook 'turn-on-font-lock)}.}.
-
-There are compatibility issues between Org mode and some other Elisp
-packages (see @ref{Conflicts}). Please take the
-time to check the list.
-
-@findex org-agenda
-@findex org-capture
-@findex org-store-link
-For a better experience, the three Org commands @code{org-store-link},
-@code{org-capture} and @code{org-agenda} ought to be accessible anywhere in
-Emacs, not just in Org buffers. To that effect, you need to bind them
-to globally available keys, like the ones reserved for users (see
-@ref{Key Binding Conventions,,,elisp,}). Here are suggested bindings,
-please modify the keys to your own liking.
-
-@lisp
-(global-set-key (kbd "C-c l") 'org-store-link)
-(global-set-key (kbd "C-c a") 'org-agenda)
-(global-set-key (kbd "C-c c") 'org-capture)
-@end lisp
-
-@cindex Org mode, turning on
-Files with the @samp{.org} extension use Org mode by default. To turn on
-Org mode in a file that does not have the extension @samp{.org}, make the
-first line of a file look like this:
-
-@example
-MY PROJECTS -*- mode: org; -*-
-@end example
-
-
-@vindex org-insert-mode-line-in-empty-file
-@noindent
-which selects Org mode for this buffer no matter what 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 @emph{active}. To
-make use of this, you need to have Transient Mark mode turned on,
-which is the default. If you do not like it, you can create an active
-region by using the mouse to select a region, or pressing
-@kbd{C-@key{SPC}} twice before moving point.
-
-@node Feedback
-@section Feedback
-
-@cindex feedback
-@cindex bug reports
-@cindex reporting a bug
-@cindex maintainer
-@cindex author
-
-If you find problems with Org, or if you have questions, remarks, or
-ideas about it, please send an email to the Org mailing list
-@email{emacs-orgmode@@gnu.org}. You can subscribe to the list @uref{https://lists.gnu.org/mailman/listinfo/emacs-orgmode, from this
-web page}. If you are not a member of the mailing list, your mail will
-be passed to the list after a moderator has approved it@footnote{Please consider subscribing to the mailing list in order to
-minimize the work the mailing list moderators have to do.}. We ask
-you to read and respect the @uref{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind Communications Guidelines} when
-sending messages on this mailing list.
-
-@findex org-version
-@findex org-submit-bug-report
-For bug reports, please first try to reproduce the bug with the latest
-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}) and Org (@kbd{M-x org-version}), as well as
-the Org related setup in the Emacs init file. The easiest way to do
-this is to use the command
-
-@example
-M-x org-submit-bug-report <RET>
-@end example
-
-
-@noindent
-which puts all this information into an Emacs mail buffer so 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 setup. Before reporting a bug, it is very helpful to start
-Emacs with minimal customizations and reproduce the problem. Doing so
-often helps you determine if the problem is with your customization or
-with Org mode itself. You can start a typical minimal session with
-a command like the example below.
-
-@example
-$ emacs -Q -l /path/to/minimal-org.el
-@end example
-
-
-However if you are using Org mode as distributed with Emacs, a minimal
-setup is not necessary. In that case it is sufficient to start Emacs
-as @samp{emacs -Q}. The @samp{minimal-org.el} setup file can have contents as
-shown below.
-
-@lisp
-;;; Minimal setup to load latest `org-mode'.
-
-;; Activate debugging.
-(setq debug-on-error t
- debug-on-signal nil
- 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))
-@end lisp
-
-If an error occurs, a ``backtrace'' can be very useful---see below on
-how to create one. Often a small example file helps, along with clear
-information about:
-
-@enumerate
-@item
-What exactly did you do?
-@item
-What did you expect to happen?
-@item
-What happened instead?
-@end enumerate
-
-Thank you for helping to improve this program.
-
-@anchor{How to create a useful backtrace}
-@subheading How to create a useful backtrace
-
-@cindex backtrace of an error
-If working with Org produces an error with a message you do not
-understand, you may have hit a bug. The best way to report this is by
-providing, in addition to what was mentioned above, a backtrace. This
-is information from the built-in debugger about where and how the
-error occurred. Here is how to produce a useful backtrace:
-
-@enumerate
-@item
-Reload uncompiled versions of all Org mode Lisp files. The
-backtrace contains much more information if it is produced with
-uncompiled code. To do this, use
-
-@example
-C-u M-x org-reload <RET>
-@end example
-
-
-@noindent
-or, from the menu: Org @arrow{} Refresh/Reload @arrow{} Reload Org uncompiled.
-
-@item
-Then, activate the debugger:
-
-@example
-M-x toggle-debug-on-error <RET>
-@end example
-
-
-@noindent
-or, from the menu: Options @arrow{} Enter Debugger on Error.
-
-@item
-Do whatever you have to do to hit the error. Do not forget to
-document the steps you take.
-
-@item
-When you hit the error, a @samp{*Backtrace*} buffer appears on the
-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
-@section Typesetting Conventions Used in this Manual
-
-
-
-@anchor{TODO keywords tags properties etc}
-@subheading TODO keywords, tags, properties, etc.
-
-Org uses various syntactical elements: TODO keywords, tags, property
-names, keywords, blocks, etc. In this manual we use the following
-conventions:
-
-@table @asis
-@item @samp{TODO}
-@itemx @samp{WAITING}
-TODO keywords are written with all capitals, even if they are
-user-defined.
-
-@item @samp{boss}
-@itemx @samp{ARCHIVE}
-Tags are case-sensitive. User-defined tags are written in
-lowercase; built-in tags with special meaning are written as they
-should appear in the document, usually with all capitals.
-
-@item @samp{Release}
-@itemx @samp{PRIORITY}
-User-defined properties are capitalized; built-in properties with
-special meaning are written with all capitals.
-
-@item @samp{TITLE}
-@itemx @samp{BEGIN} @dots{} @samp{END}
-Keywords and blocks are written in uppercase to enhance their
-readability, but you can use lowercase in your Org files.
-@end table
-
-@anchor{Key bindings and commands}
-@subheading Key bindings and commands
-
-The manual lists both the keys and the corresponding commands for
-accessing a functionality. Org mode often uses the same key for
-different functions, depending on context. The command that is bound
-to such keys has a generic name, like @code{org-metaright}. In the manual
-we will, wherever possible, give the function that is internally
-called by the generic command. For example, in the chapter on
-document structure, @kbd{M-@key{RIGHT}} will be listed to call
-@code{org-do-demote}, while in the chapter on tables, it will be listed to
-call @code{org-table-move-column-right}.
-
-@node Document Structure
-@chapter Document Structure
-
-@cindex document structure
-@cindex structure of document
-Org is an outliner. Outlines allow a document to be organized in
-a hierarchical structure, which, least for me, is the best
-representation of notes and thoughts. An overview of this structure
-is achieved by folding, i.e., hiding large parts of the document to
-show only the general document structure and the parts currently being
-worked on. Org greatly simplifies the use of outlines by compressing
-the entire show and hide functionalities into a single command,
-@code{org-cycle}, which is bound to the @kbd{@key{TAB}} key.
-
-@menu
-* Headlines:: How to typeset Org tree headlines.
-* Visibility Cycling:: Show and hide, much simplified.
-* Motion:: Jumping to other headlines.
-* Structure Editing:: Changing sequence and level of headlines.
-* Sparse Trees:: Matches embedded in context.
-* Plain Lists:: Additional structure within an entry.
-* Drawers:: Tucking stuff away.
-* Blocks:: Folding blocks.
-@end menu
-
-@node Headlines
-@section Headlines
-
-@cindex headlines
-@cindex outline tree
-@vindex org-special-ctrl-a/e
-@vindex org-special-ctrl-k
-@vindex org-ctrl-k-protect-subtree
-
-Headlines define the structure of an outline tree. Org headlines
-start on the left margin@footnote{See the variables @code{org-special-ctrl-a/e}, @code{org-special-ctrl-k},
-and @code{org-ctrl-k-protect-subtree} to configure special behavior of
-@kbd{C-a}, @kbd{C-e}, and @kbd{C-k} in headlines. Note
-also that clocking only works with headings indented less than 30
-stars.} with one or more stars followed by
-a space. For example:
-
-@example
-* Top level headline
-** Second level
-*** Third level
- some text
-*** Third level
- more text
-* Another top level headline
-@end example
-
-@vindex org-footnote-section
-The name defined in @code{org-footnote-section} is reserved. Do not use it
-as a title for your own headings.
-
-Some people find the many stars too noisy and would prefer an outline
-that has whitespace followed by a single star as headline starters.
-This can be achieved using a Org Indent minor mode. See @ref{Clean View} for more information.
-
-Headlines are not numbered. However, you may want to dynamically
-number some, or all, of them. See @ref{Dynamic Headline Numbering}.
-
-@vindex org-cycle-separator-lines
-An empty line after the end of a subtree is considered part of it and
-is hidden when the subtree is folded. However, if you leave at least
-two empty lines, one empty line remains 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
-@section Visibility Cycling
-
-@cindex cycling, visibility
-@cindex visibility cycling
-@cindex trees, visibility
-@cindex show hidden text
-@cindex hide text
-
-@menu
-* Global and local cycling:: Cycling through various visibility states.
-* Initial visibility:: Setting the initial visibility state.
-* Catching invisible edits:: Preventing mistakes when editing invisible parts.
-@end menu
-
-@node Global and local cycling
-@subsection Global and local cycling
-
-@cindex subtree visibility states
-@cindex subtree cycling
-@cindex folded, subtree visibility state
-@cindex children, subtree visibility state
-@cindex subtree, subtree visibility state
-
-Outlines make it possible to hide parts of the text in the buffer.
-Org uses just two commands, bound to @kbd{@key{TAB}} and
-@kbd{S-@key{TAB}} to change the visibility in the buffer.
-
-@table @asis
-@item @kbd{@key{TAB}} (@code{org-cycle})
-@kindex TAB
-@findex org-cycle
-@emph{Subtree cycling}: Rotate current subtree among the states
-
-@example
-,-> FOLDED -> CHILDREN -> SUBTREE --.
-'-----------------------------------'
-@end example
-
-@vindex org-cycle-emulate-tab
-Point must be on a headline for this to work@footnote{See, however, the option @code{org-cycle-emulate-tab}.}.
-
-@item @kbd{S-@key{TAB}} (@code{org-global-cycle})
-@itemx @kbd{C-u @key{TAB}}
-@cindex global visibility states
-@cindex global cycling
-@cindex overview, global visibility state
-@cindex contents, global visibility state
-@cindex show all, global visibility state
-@kindex C-u TAB
-@kindex S-TAB
-@findex org-global-cycle
-@emph{Global cycling}: Rotate the entire buffer among the states
-
-@example
-,-> OVERVIEW -> CONTENTS -> SHOW ALL --.
-'--------------------------------------'
-@end example
-
-When @kbd{S-@key{TAB}} is called with a numeric prefix argument
-@var{N}, view contents only up to headlines of level
-@var{N}.
-
-Note that inside tables (see @ref{Tables}), @kbd{S-@key{TAB}} jumps to the
-previous field instead.
-
-@vindex org-cycle-global-at-bob
-You can run global cycling using @kbd{@key{TAB}} only if point is at
-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.
-
-@item @kbd{C-u C-u @key{TAB}} (@code{org-set-startup-visibility})
-@cindex startup visibility
-@kindex C-u C-u TAB
-@findex org-set-startup-visibility
-Switch back to the startup visibility of the buffer (see @ref{Initial visibility}).
-
-@item @kbd{C-u C-u C-u @key{TAB}} (@code{outline-show-all})
-@cindex show all, command
-@kindex C-u C-u C-u TAB
-@findex outline-show-all
-Show all, including drawers.
-
-@item @kbd{C-c C-r} (@code{org-reveal})
-@cindex revealing context
-@kindex C-c C-r
-@findex org-reveal
-Reveal context around point, showing the current entry, the
-following heading and the hierarchy above. It is useful for working
-near a location that has been exposed by a sparse tree command (see
-@ref{Sparse Trees}) or an agenda command (see @ref{Agenda Commands}). With a prefix argument, show, on each level, all sibling
-headings. With a double prefix argument, also show the entire
-subtree of the parent.
-
-@item @kbd{C-c C-k} (@code{outline-show-branches})
-@cindex show branches, command
-@kindex C-c C-k
-@findex outline-show-branches
-Expose all the headings of the subtree, but not their bodies.
-
-@item @kbd{C-c @key{TAB}} (@code{outline-show-children})
-@cindex show children, command
-@kindex C-c TAB
-@findex outline-show-children
-Expose all direct children of the subtree. With a numeric prefix
-argument @var{N}, expose all children down to level
-@var{N}.
-
-@item @kbd{C-c C-x b} (@code{org-tree-to-indirect-buffer})
-@kindex C-c C-x b
-@findex org-tree-to-indirect-buffer
-Show the current subtree in an indirect buffer@footnote{The indirect buffer contains the entire buffer, but is narrowed
-to the current tree. Editing the indirect buffer also changes the
-original buffer, but without affecting visibility in that buffer. For
-more information about indirect buffers, see @ref{Indirect Buffers,GNU Emacs Manual,,emacs,}.}. With
-a numeric prefix argument @var{N}, go up to level @var{N}
-and then take that tree. If @var{N} is negative then go up
-that many levels. With a @kbd{C-u} prefix, do not remove the
-previously used indirect buffer.
-
-@item @kbd{C-c C-x v} (@code{org-copy-visible})
-@kindex C-c C-x v
-@findex org-copy-visible
-Copy the @emph{visible} text in the region into the kill ring.
-@end table
-
-@node Initial visibility
-@subsection Initial visibility
-
-@vindex org-startup-folded
-When Emacs first visits an Org file, the global state is set to
-@code{showeverything}, i.e., all file content is visible@footnote{When @code{org-agenda-inhibit-startup} is non-@code{nil}, Org does not
-honor the default visibility state when first opening a file for the
-agenda (see @ref{Speeding Up Your Agendas}).}. This can
-be configured through the variable @code{org-startup-folded}, or on
-a per-file basis by adding one of the following lines anywhere in the
-buffer:
-
-@cindex @samp{STARTUP}, keyword
-@example
-#+STARTUP: overview
-#+STARTUP: content
-#+STARTUP: showall
-#+STARTUP: showeverything
-@end example
-
-@cindex @samp{VISIBILITY}, property
-Furthermore, any entries with a @samp{VISIBILITY} property (see @ref{Properties and Columns}) get their visibility adapted accordingly. Allowed values
-for this property are @samp{folded}, @samp{children}, @samp{content}, and @samp{all}.
-
-@table @asis
-@item @kbd{C-u C-u @key{TAB}} (@code{org-set-startup-visibility})
-@kindex C-u C-u TAB
-@findex org-set-startup-visibility
-Switch back to the startup visibility of the buffer, i.e., whatever
-is requested by startup options and @samp{VISIBILITY} properties in
-individual entries.
-@end table
-
-@node Catching invisible edits
-@subsection Catching invisible edits
-
-@cindex edits, catching invisible
-
-@vindex org-catch-invisible-edits
-Sometimes you may inadvertently edit an invisible part of the buffer
-and be confused on what has been edited and how to undo the mistake.
-Setting @code{org-catch-invisible-edits} to non-@code{nil} helps preventing
-this. See the docstring of this option on how Org should catch
-invisible edits and process them.
-
-@node Motion
-@section Motion
-
-@cindex motion, between headlines
-@cindex jumping, to headlines
-@cindex headline navigation
-
-The following commands jump to other headlines in the buffer.
-
-@table @asis
-@item @kbd{C-c C-n} (@code{org-next-visible-heading})
-@kindex C-c C-n
-@findex org-next-visible-heading
-Next heading.
-
-@item @kbd{C-c C-p} (@code{org-previous-visible-heading})
-@kindex C-c C-p
-@findex org-previous-visible-heading
-Previous heading.
-
-@item @kbd{C-c C-f} (@code{org-forward-heading-same-level})
-@kindex C-c C-f
-@findex org-forward-heading-same-level
-Next heading same level.
-
-@item @kbd{C-c C-b} (@code{org-backward-heading-same-level})
-@kindex C-c C-b
-@findex org-backward-heading-same-level
-Previous heading same level.
-
-@item @kbd{C-c C-u} (@code{outline-up-heading})
-@kindex C-c C-u
-@findex outline-up-heading
-Backward to higher level heading.
-
-@item @kbd{C-c C-j} (@code{org-goto})
-@kindex C-c C-j
-@findex org-goto
-@vindex org-goto-auto-isearch
-Jump to a different place without changing the current outline
-visibility. Shows the document structure in a temporary buffer,
-where you can use the following keys to find your destination:
-
-@multitable @columnfractions 0.3 0.7
-@item @kbd{@key{TAB}}
-@tab Cycle visibility.
-@item @kbd{@key{DOWN}} / @kbd{@key{UP}}
-@tab Next/previous visible headline.
-@item @kbd{@key{RET}}
-@tab Select this location.
-@item @kbd{/}
-@tab Do a Sparse-tree search
-@end multitable
-
-@noindent
-The following keys work if you turn off @code{org-goto-auto-isearch}
-
-@multitable @columnfractions 0.3 0.7
-@item @kbd{n} / @kbd{p}
-@tab Next/previous visible headline.
-@item @kbd{f} / @kbd{b}
-@tab Next/previous headline same level.
-@item @kbd{u}
-@tab One level up.
-@item @kbd{0} @dots{} @kbd{9}
-@tab Digit argument.
-@item @kbd{q}
-@tab Quit.
-@end multitable
-
-@vindex org-goto-interface
-@noindent
-See also the variable @code{org-goto-interface}.
-@end table
-
-@node Structure Editing
-@section Structure Editing
-
-@cindex structure editing
-@cindex headline, promotion and demotion
-@cindex promotion, of subtrees
-@cindex demotion, of subtrees
-@cindex subtree, cut and paste
-@cindex pasting, of subtrees
-@cindex cutting, of subtrees
-@cindex copying, of subtrees
-@cindex sorting, of subtrees
-@cindex subtrees, cut and paste
-
-@table @asis
-@item @kbd{M-@key{RET}} (@code{org-meta-return})
-@kindex M-RET
-@findex org-meta-return
-@vindex org-M-RET-may-split-line
-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 (see @ref{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.
-
-@item @kbd{C-@key{RET}} (@code{org-insert-heading-respect-content})
-@kindex C-RET
-@findex org-insert-heading-respect-content
-Insert a new heading at the end of the current subtree.
-
-@item @kbd{M-S-@key{RET}} (@code{org-insert-todo-heading})
-@kindex M-S-RET
-@findex 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 variable @code{org-treat-insert-todo-heading-as-state-change}.
-
-@item @kbd{C-S-@key{RET}} (@code{org-insert-todo-heading-respect-content})
-@kindex C-S-RET
-@findex org-insert-todo-heading-respect-content
-Insert new TODO entry with same level as current heading. Like
-@kbd{C-@key{RET}}, the new headline is inserted after the current
-subtree.
-
-@item @kbd{@key{TAB}} (@code{org-cycle})
-@kindex TAB
-@findex org-cycle
-In a new entry with no text yet, the first @kbd{@key{TAB}} demotes
-the entry to become a child of the previous one. The next
-@kbd{@key{TAB}} makes it a parent, and so on, all the way to top
-level. Yet another @kbd{@key{TAB}}, and you are back to the initial
-level.
-
-@item @kbd{M-@key{LEFT}} (@code{org-do-promote})
-@itemx @kbd{M-@key{RIGHT}} (@code{org-do-demote})
-@kindex M-LEFT
-@findex org-do-promote
-@kindex M-RIGHT
-@findex org-do-demote
-Promote or demote current heading by one level.
-
-@cindex region, active
-@cindex active region
-@cindex transient mark mode
-When there is an active region---i.e., when Transient Mark mode is
-active---promotion and demotion work on all headlines in the region.
-To select a region of headlines, it is best to place both point and
-mark at the beginning of a line, mark at the beginning of the first
-headline, and point at the line just after the last headline to
-change.
-
-@item @kbd{M-S-@key{LEFT}} (@code{org-promote-subtree})
-@kindex M-S-LEFT
-@findex org-promote-subtree
-Promote the current subtree by one level.
-
-@item @kbd{M-S-@key{RIGHT}} (@code{org-demote-subtree})
-@kindex M-S-RIGHT
-@findex org-demote-subtree
-Demote the current subtree by one level.
-
-@item @kbd{M-@key{UP}} (@code{org-move-subtree-up})
-@kindex M-UP
-@findex org-move-subtree-up
-Move subtree up, i.e., swap with previous subtree of same level.
-
-@item @kbd{M-@key{DOWN}} (@code{org-move-subtree-down})
-@kindex M-DOWN
-@findex org-move-subtree-down
-Move subtree down, i.e., swap with next subtree of same level.
-
-@item @kbd{C-c @@} (@code{org-mark-subtree})
-@kindex C-c @@
-@findex org-mark-subtree
-Mark the subtree at point. Hitting repeatedly marks subsequent
-subtrees of the same level as the marked subtree.
-
-@item @kbd{C-c C-x C-w} (@code{org-cut-subtree})
-@kindex C-c C-x C-w
-@findex org-cut-subtree
-Kill subtree, i.e., remove it from buffer but save in kill ring.
-With a numeric prefix argument N, kill N sequential subtrees.
-
-@item @kbd{C-c C-x M-w} (@code{org-copy-subtree})
-@kindex C-c C-x M-w
-@findex org-copy-subtree
-Copy subtree to kill ring. With a numeric prefix argument N, copy
-the N sequential subtrees.
-
-@item @kbd{C-c C-x C-y} (@code{org-paste-subtree})
-@kindex C-c C-x C-y
-@findex org-paste-subtree
-Yank subtree from kill ring. This does modify the level of the
-subtree to make sure the tree fits in nicely at the yank position.
-The yank level can also be specified with a numeric prefix argument,
-or by yanking after a headline marker like @samp{****}.
-
-@item @kbd{C-y} (@code{org-yank})
-@kindex C-y
-@findex org-yank
-@vindex org-yank-adjusted-subtrees
-@vindex org-yank-folded-subtrees
-Depending on the variables @code{org-yank-adjusted-subtrees} and
-@code{org-yank-folded-subtrees}, Org's internal @code{yank} command pastes
-subtrees folded and in a clever way, using the same command as
-@kbd{C-c C-x C-y}. With the default settings, no level
-adjustment takes place, but the yanked tree is folded unless doing
-so would swallow text previously visible. Any prefix argument to
-this command forces a normal @code{yank} to be executed, with the prefix
-passed along. A good way to force a normal yank is @kbd{C-u C-y}. If you use @code{yank-pop} after a yank, it yanks previous kill
-items plainly, without adjustment and folding.
-
-@item @kbd{C-c C-x c} (@code{org-clone-subtree-with-time-shift})
-@kindex C-c C-x c
-@findex org-clone-subtree-with-time-shift
-Clone a subtree by making a number of sibling copies of it. You are
-prompted for the number of copies to make, and you can also specify
-if any timestamps in the entry should be shifted. This can be
-useful, for example, to create a number of tasks related to a series
-of lectures to prepare. For more details, see the docstring of the
-command @code{org-clone-subtree-with-time-shift}.
-
-@item @kbd{C-c C-w} (@code{org-refile})
-@kindex C-c C-w
-@findex org-refile
-Refile entry or region to a different location. See @ref{Refile and Copy}.
-
-@item @kbd{C-c ^} (@code{org-sort})
-@kindex C-c ^
-@findex org-sort
-Sort same-level entries. When there is an active region, all
-entries in the region are sorted. Otherwise the children of the
-current headline are sorted. The command prompts for the sorting
-method, which can be alphabetically, numerically, by time---first
-timestamp with active preferred, creation time, scheduled time,
-deadline time---by priority, by TODO keyword---in the sequence the
-keywords have been defined in the setup---or by the value of
-a property. Reverse sorting is possible as well. You can also
-supply your own function to extract the sorting key. With
-a @kbd{C-u} prefix, sorting is case-sensitive.
-
-@item @kbd{C-x n s} (@code{org-narrow-to-subtree})
-@kindex C-x n s
-@findex org-narrow-to-subtree
-Narrow buffer to current subtree.
-
-@item @kbd{C-x n b} (@code{org-narrow-to-block})
-@kindex C-x n b
-@findex org-narrow-to-block
-Narrow buffer to current block.
-
-@item @kbd{C-x n w} (@code{widen})
-@kindex C-x n w
-@findex widen
-Widen buffer to remove narrowing.
-
-@item @kbd{C-c *} (@code{org-toggle-heading})
-@kindex C-c *
-@findex org-toggle-heading
-Turn a normal line or plain list item into a headline---so that it
-becomes a subheading at its location. Also turn a headline into
-a normal line by removing the stars. If there is an active region,
-turn all lines in the region into headlines. If the first line in
-the region was an item, turn only the item lines into headlines.
-Finally, if the first line is a headline, remove the stars from all
-headlines in the region.
-@end table
-
-Note that when point is inside a table (see @ref{Tables}), the Meta-Cursor
-keys have different functionality.
-
-@node Sparse Trees
-@section Sparse Trees
-
-@cindex sparse trees
-@cindex trees, sparse
-@cindex folding, sparse trees
-@cindex occur, command
-
-@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 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
-commands can be accessed through a dispatcher:
-
-@table @asis
-@item @kbd{C-c /} (@code{org-sparse-tree})
-@kindex C-c /
-@findex org-sparse-tree
-This prompts for an extra key to select a sparse-tree creating
-command.
-
-@item @kbd{C-c / r} or @kbd{C-c / /} (@code{org-occur})
-@kindex C-c / r
-@kindex C-c / /
-@findex 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 the body of an entry, headline and body are made
-visible. In order to provide minimal context, also the full
-hierarchy of headlines above the match is shown, as well as the
-headline following the match. Each match is also highlighted; the
-highlights disappear when the buffer is changed by an editing
-command, or by pressing @kbd{C-c C-c}@footnote{This depends on the option @code{org-remove-highlights-with-change}.}. When called with
-a @kbd{C-u} prefix argument, previous highlights are kept, so
-several calls to this command can be stacked.
-
-@item @kbd{M-g n} or @kbd{M-g M-n} (@code{next-error})
-@kindex M-g n
-@kindex M-g M-n
-@findex next-error
-Jump to the next sparse tree match in this buffer.
-
-@item @kbd{M-g p} or @kbd{M-g M-p} (@code{previous-error})
-@kindex M-g p
-@kindex M-g M-p
-@findex previous-error
-Jump to the previous sparse tree match in this buffer.
-@end table
-
-@vindex org-agenda-custom-commands
-For frequently used sparse trees of specific search strings, you can
-use the variable @code{org-agenda-custom-commands} to define fast keyboard
-access to specific sparse trees. These commands will then be
-accessible through the agenda dispatcher (see @ref{Agenda Dispatcher}).
-For example:
-
-@lisp
-(setq org-agenda-custom-commands
- '(("f" occur-tree "FIXME")))
-@end lisp
-
-@noindent
-defines the key @kbd{f} as a shortcut for creating a sparse tree
-matching the string @samp{FIXME}.
-
-The other sparse tree commands select headings based on TODO keywords,
-tags, or properties and are discussed later in this manual.
-
-@kindex C-c C-e C-v
-@cindex printing sparse trees
-@cindex visible text, printing
-To print a sparse tree, you can use the Emacs command
-@code{ps-print-buffer-with-faces} which does not print invisible parts of
-the document. Or you can use the command @kbd{C-c C-e C-v} to
-export only the visible part of the document and print the resulting
-file.
-
-@node Plain Lists
-@section Plain Lists
-
-@cindex plain lists
-@cindex lists, plain
-@cindex lists, ordered
-@cindex ordered lists
-
-Within an entry of the outline tree, hand-formatted lists can provide
-additional structure. They also provide a way to create lists of
-checkboxes (see @ref{Checkboxes}). Org supports editing such lists, and
-every exporter (see @ref{Exporting}) can parse and format them.
-
-Org knows ordered lists, unordered lists, and description lists.
-
-@itemize
-@item
-@emph{Unordered} list items start with @samp{-}, @samp{+}, or @samp{*}@footnote{When using @samp{*} as a bullet, lines must be indented so that they
-are not interpreted as headlines. Also, when you are hiding leading
-stars to get a clean outline view, plain list items starting with
-a star may be hard to distinguish from true headlines. In short: even
-though @samp{*} is supported, it may be better to not use it for plain list
-items.} as bullets.
-
-@item
-@vindex org-plain-list-ordered-item-terminator
-@vindex org-alphabetical-lists
-@emph{Ordered} list items start with a numeral followed by either
-a period or a right parenthesis@footnote{You can filter out any of them by configuring
-@code{org-plain-list-ordered-item-terminator}.}, such as @samp{1.} or @samp{1)}@footnote{You can also get @samp{a.}, @samp{A.}, @samp{a)} and @samp{A)} by configuring
-@code{org-list-allow-alphabetical}. To minimize confusion with normal
-text, those are limited to one character only. Beyond that limit,
-bullets automatically become numbers.}
-If you want a list to start with a different value---e.g.,
-20---start the text of the item with @samp{[@@20]}@footnote{If there's a checkbox in the item, the cookie must be put
-@emph{before} the checkbox. If you have activated alphabetical lists, you
-can also use counters like @samp{[@@b]}.}. Those
-constructs can be used in any item of the list in order to enforce
-a particular numbering.
-
-@item
-@emph{Description} list items are unordered list items, and contain the
-separator @samp{::} to distinguish the description @emph{term} from the
-description.
-@end itemize
-
-Items belonging to the same list must have the same indentation on the
-first line. In particular, if an ordered list reaches number @samp{10.},
-then the 2-digit numbers must be written left-aligned with the other
-numbers in the list. An item ends before the next line that is less
-or equally indented than its bullet/number.
-
-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. In that case, all items are closed. Here is an
-example:
-
-@example
-* Lord of the Rings
-My favorite scenes are (in this order)
-1. The attack of the Rohirrim
-2. Eowyn's fight with the witch king
- + this was already my favorite scene in the book
- + I really like Miranda Otto.
-3. Peter Jackson being shot by Legolas
- - on DVD only
- He makes a really funny face when it happens.
-But in the end, no individual scenes matter but the film as a whole.
-Important actors in this film are:
-- Elijah Wood :: He plays Frodo
-- Sean Astin :: He plays Sam, Frodo's friend. I still remember him
- very well from his role as Mikey Walsh in /The Goonies/.
-@end example
-
-Org supports these lists by tuning filling and wrapping commands to
-deal with them correctly, and by exporting them properly (see
-@ref{Exporting}). Since indentation is what governs the structure of these
-lists, many structural constructs like @samp{#+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
-@code{org-list-indent-offset}.
-
-@vindex org-list-automatic-rules
-The following commands act on items when point is in the first line of
-an item---the line with the bullet or number. Some of them imply the
-application of automatic rules to keep list structure intact. If some
-of these actions get in your way, configure @code{org-list-automatic-rules}
-to disable them individually.
-
-@table @asis
-@item @kbd{@key{TAB}} (@code{org-cycle})
-@cindex cycling, in plain lists
-@kindex TAB
-@findex org-cycle
-@vindex org-cycle-include-plain-lists
-Items can be folded just like headline levels. Normally this works
-only if point is on a plain list item. For more details, see the
-variable @code{org-cycle-include-plain-lists}. If this variable is set
-to @code{integrate}, plain list items are treated like low-level
-headlines. The level of an item is then given by the indentation of
-the bullet/number. Items are always subordinate to real headlines,
-however; the hierarchies remain completely separated. In a new item
-with no text yet, the first @kbd{@key{TAB}} demotes the item to
-become a child of the previous one. Subsequent @kbd{@key{TAB}}s move
-the item to meaningful levels in the list and eventually get it back
-to its initial position.
-
-@item @kbd{M-@key{RET}} (@code{org-insert-heading})
-@kindex M-RET
-@findex org-insert-heading
-@vindex org-M-RET-may-split-line
-Insert new item at current level. With a prefix argument, force
-a new heading (see @ref{Structure Editing}). If this command is used in
-the middle of an item, that item is @emph{split} in two, and the second
-part becomes the new item@footnote{If you do not want the item to be split, customize the
-variable @code{org-M-RET-may-split-line}.}. If this command is executed
-@emph{before item's body}, the new item is created @emph{before} the current
-one.
-
-@item @kbd{M-S-@key{RET}}
-@kindex M-S-RET
-Insert a new item with a checkbox (see @ref{Checkboxes}).
-
-@item @kbd{S-@key{UP}}
-@itemx @kbd{S-@key{DOWN}}
-@kindex S-UP
-@kindex S-DOWN
-@cindex shift-selection-mode
-@vindex org-support-shift-select
-@vindex org-list-use-circular-motion
-Jump to the previous/next item in the current list, but only if
-@code{org-support-shift-select} is off@footnote{If you want to cycle around items that way, you may customize
-@code{org-list-use-circular-motion}.}. If not, you can still use
-paragraph jumping commands like @kbd{C-@key{UP}} and
-@kbd{C-@key{DOWN}} to quite similar effect.
-
-@item @kbd{M-@key{UP}}
-@itemx @kbd{M-@key{DOWN}}
-@kindex M-UP
-@kindex M-DOWN
-Move the item including subitems up/down@footnote{See @code{org-list-use-circular-motion} for a cyclic behavior.}, i.e., swap with
-previous/next item of same indentation. If the list is ordered,
-renumbering is automatic.
-
-@item @kbd{M-@key{LEFT}}
-@itemx @kbd{M-@key{RIGHT}}
-@kindex M-LEFT
-@kindex M-RIGHT
-Decrease/increase the indentation of an item, leaving children
-alone.
-
-@item @kbd{M-S-@key{LEFT}}
-@itemx @kbd{M-S-@key{RIGHT}}
-@kindex M-S-LEFT
-@kindex M-S-RIGHT
-Decrease/increase the indentation of the item, including subitems.
-Initially, the item tree is selected based on current indentation.
-When these commands are executed several times in direct succession,
-the initially selected region is used, even if the new indentation
-would imply a different hierarchy. To use the new hierarchy, break
-the command chain by moving point.
-
-As a special case, using this command on the very first item of
-a list moves the whole list. This behavior can be disabled by
-configuring @code{org-list-automatic-rules}. The global indentation of
-a list has no influence on the text @emph{after} the list.
-
-@item @kbd{C-c C-c}
-@kindex C-c C-c
-If there is a checkbox (see @ref{Checkboxes}) in the item line, toggle
-the state of the checkbox. In any case, verify bullets and
-indentation consistency in the whole list.
-
-@item @kbd{C-c -}
-@kindex C-c -
-@vindex org-plain-list-ordered-item-terminator
-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, all lines are converted to list items. With a prefix
-argument, the selected text is changed into a single item. If the
-first line already was a list item, any item marker is removed from
-the list. Finally, even without an active region, a normal line is
-converted into a list item.
-
-@item @kbd{C-c *}
-@kindex C-c *
-Turn a plain list item into a headline---so that it becomes
-a subheading at its location. See @ref{Structure Editing}, for
-a detailed explanation.
-
-@item @kbd{C-c C-*}
-@kindex C-c C-*
-Turn the whole plain list into a subtree of the current heading.
-Checkboxes (see @ref{Checkboxes}) become @samp{TODO}, respectively @samp{DONE},
-keywords when unchecked, respectively checked.
-
-@item @kbd{S-@key{LEFT}}
-@itemx @kbd{S-@key{RIGHT}}
-@vindex org-support-shift-select
-@kindex S-LEFT
-@kindex S-RIGHT
-This command also cycles bullet styles when point is in on the
-bullet or anywhere in an item line, details depending on
-@code{org-support-shift-select}.
-
-@item @kbd{C-c ^}
-@kindex C-c ^
-@cindex sorting, of plain list
-Sort the plain list. Prompt for the sorting method: numerically,
-alphabetically, by time, or by custom function.
-@end table
-
-@node Drawers
-@section Drawers
-
-@cindex drawers
-@cindex visibility cycling, drawers
-
-Sometimes you want to keep information associated with an entry, but
-you normally do not 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
-Still outside the drawer
-:DRAWERNAME:
-This is inside the drawer.
-:END:
-After the drawer.
-@end example
-
-@kindex C-c C-x d
-@findex org-insert-drawer
-You can interactively insert a drawer at point by calling
-@code{org-insert-drawer}, which is bound to @kbd{C-c C-x d}. With an
-active region, this command puts the region inside the drawer. With
-a prefix argument, this command calls @code{org-insert-property-drawer},
-which creates a @samp{PROPERTIES} drawer right below the current headline.
-Org mode uses this special drawer for storing properties (see
-@ref{Properties and Columns}). You cannot use it for anything else.
-
-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.}.
-
-Visibility cycling (see @ref{Visibility Cycling}) on the headline hides and
-shows the entry, but keep the drawer collapsed to a single line. In
-order to look inside the drawer, you need to move point to the drawer
-line and press @kbd{@key{TAB}} there.
-
-You can also arrange for state change notes (see @ref{Tracking TODO state changes}) and clock times (see @ref{Clocking Work Time}) to be stored in
-a @samp{LOGBOOK} drawer. If you want to store a quick note there, in
-a similar way to state changes, use
-
-@table @asis
-@item @kbd{C-c C-z}
-@kindex C-c C-z
-Add a time-stamped note to the @samp{LOGBOOK} drawer.
-@end table
-
-@node Blocks
-@section Blocks
-
-@vindex org-hide-block-startup
-@cindex blocks, folding
-
-Org mode uses @samp{#+BEGIN} @dots{} @samp{#+END} blocks for various purposes from
-including source code examples (see @ref{Literal Examples}) to capturing
-time logging information (see @ref{Clocking Work Time}). These blocks can
-be folded and unfolded by pressing @kbd{@key{TAB}} in the @samp{#+BEGIN}
-line. You can also get all blocks folded at startup by configuring
-the variable @code{org-hide-block-startup} or on a per-file basis by using
-
-@cindex STARTUP, keyword
-@example
-#+STARTUP: hideblocks
-#+STARTUP: nohideblocks
-@end example
-
-@node Tables
-@chapter Tables
-
-@cindex tables
-@cindex editing tables
-
-Org comes with a fast and intuitive table editor. Spreadsheet-like
-calculations are supported using the Emacs Calc package (see @ref{Top,GNU Emacs
-Calculator Manual,,calc,}).
-
-@menu
-* Built-in Table Editor:: Simple tables.
-* Column Width and Alignment:: Overrule the automatic settings.
-* Column Groups:: Grouping to trigger vertical lines.
-* Orgtbl Mode:: The table editor as minor mode.
-* The Spreadsheet:: The table editor has spreadsheet capabilities.
-* Org Plot:: Plotting from Org tables.
-@end menu
-
-@node Built-in Table Editor
-@section Built-in Table Editor
-
-@cindex table editor, built-in
-
-@cindex header lines, in tables
-@cindex horizontal rule, in tables
-@cindex row separator, in tables
-@cindex table syntax
-Org makes it easy to format tables in plain ASCII@. Any line with @samp{|}
-as the first non-whitespace character is considered part of a table.
-@samp{|} is also the column separator@footnote{To insert a vertical bar into a table field, use @samp{\vert} or,
-inside a word @samp{abc\vert@{@}def}.}. Moreover, a line starting
-with @samp{|-} is a horizontal rule. It separates rows explicitly. Rows
-before the first horizontal rule are header lines. A table might look
-like this:
-
-@example
-| Name | Phone | Age |
-|-------+-------+-----|
-| Peter | 1234 | 17 |
-| Anna | 4321 | 25 |
-@end example
-
-A table is re-aligned automatically each time you press
-@kbd{@key{TAB}}, @kbd{@key{RET}} or @kbd{C-c C-c} inside the table.
-@kbd{@key{TAB}} also moves to the next field---@kbd{@key{RET}} to the
-next row---and creates new table rows at the end of the table or
-before horizontal lines. The indentation of the table is set by the
-first line. Horizontal rules are automatically expanded on every
-re-align to span the whole table width. So, to create the above
-table, you would only type
-
-@example
-|Name|Phone|Age|
-|-
-@end example
-
-@noindent
-and then press @kbd{@key{TAB}} to align the table and start filling in
-fields. Even faster would be to type @samp{|Name|Phone|Age} followed by
-@kbd{C-c @key{RET}}.
-
-When typing text into a field, Org treats @kbd{DEL},
-@kbd{Backspace}, and all character keys in a special way, so that
-inserting and deleting avoids shifting other fields. Also, when
-typing @emph{immediately} after point 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}.
-
-@anchor{Creation and conversion}
-@subheading Creation and conversion
-
-@table @asis
-@item @kbd{C-c |} (@code{org-table-create-or-convert-from-region})
-@kindex C-c |
-@findex org-table-create-or-convert-from-region
-Convert the active region to table. If every line contains at least
-one @kbd{@key{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
-@kbd{@key{TAB}}, @kbd{C-u C-u C-u} prompts for a regular
-expression to match the separator, and a numeric argument
-N indicates that at least N consecutive spaces, or alternatively
-a @kbd{@key{TAB}} will be the separator.
-
-If there is no active region, this command creates an empty Org
-table. But it is easier just to start typing, like @kbd{| N a m e | P h o n e | A g e @key{RET} | - @key{TAB}}.
-@end table
-
-@anchor{Re-aligning and field motion}
-@subheading Re-aligning and field motion
-
-@table @asis
-@item @kbd{C-c C-c} (@code{org-table-align})
-@kindex C-c C-c
-@findex org-table-align
-Re-align the table without moving point.
-
-@item @kbd{@key{TAB}} (@code{org-table-next-field})
-@kindex TAB
-@findex org-table-next-field
-Re-align the table, move to the next field. Creates a new row if
-necessary.
-
-@item @kbd{C-c @key{SPC}} (@code{org-table-blank-field})
-@kindex C-c SPC
-@findex org-table-blank-field
-Blank the field at point.
-
-@item @kbd{S-@key{TAB}} (@code{org-table-previous-field})
-@kindex S-TAB
-@findex org-table-previous-field
-Re-align, move to previous field.
-
-@item @kbd{@key{RET}} (@code{org-table-next-row})
-@kindex RET
-@findex org-table-next-row
-Re-align the table and move down to next row. Creates a new row if
-necessary. At the beginning or end of a line, @kbd{@key{RET}} still
-inserts a new line, so it can be used to split a table.
-
-@item @kbd{M-a} (@code{org-table-beginning-of-field})
-@kindex M-a
-@findex org-table-beginning-of-field
-Move to beginning of the current table field, or on to the previous
-field.
-
-@item @kbd{M-e} (@code{org-table-end-of-field})
-@kindex M-e
-@findex org-table-end-of-field
-Move to end of the current table field, or on to the next field.
-@end table
-
-@anchor{Column and row editing}
-@subheading Column and row editing
-
-@table @asis
-@item @kbd{M-@key{LEFT}} (@code{org-table-move-column-left})
-@kindex M-LEFT
-@findex org-table-move-column-left
-Move the current column left.
-
-@item @kbd{M-@key{RIGHT}} (@code{org-table-move-column-right})
-@kindex M-RIGHT
-@findex org-table-move-column-right
-Move the current column right.
-
-@item @kbd{M-S-@key{LEFT}} (@code{org-table-delete-column})
-@kindex M-S-LEFT
-@findex org-table-delete-column
-Kill the current column.
-
-@item @kbd{M-S-@key{RIGHT}} (@code{org-table-insert-column})
-@kindex M-S-RIGHT
-@findex org-table-insert-column
-Insert a new column at point position. Move the recent column and
-all cells to the right of this column to the right.
-
-@item @kbd{M-@key{UP}} (@code{org-table-move-row-up})
-@kindex M-UP
-@findex org-table-move-row-up
-Move the current row up.
-
-@item @kbd{M-@key{DOWN}} (@code{org-table-move-row-down})
-@kindex M-DOWN
-@findex org-table-move-row-down
-Move the current row down.
-
-@item @kbd{M-S-@key{UP}} (@code{org-table-kill-row})
-@kindex M-S-UP
-@findex org-table-kill-row
-Kill the current row or horizontal line.
-
-@item @kbd{S-@key{UP}} (@code{org-table-move-cell-up})
-@kindex S-UP
-@findex org-table-move-cell-up
-Move cell up by swapping with adjacent cell.
-
-@item @kbd{S-@key{DOWN}} (@code{org-table-move-cell-down})
-@kindex S-DOWN
-@findex org-table-move-cell-down
-Move cell down by swapping with adjacent cell.
-
-@item @kbd{S-@key{LEFT}} (@code{org-table-move-cell-left})
-@kindex S-LEFT
-@findex org-table-move-cell-left
-Move cell left by swapping with adjacent cell.
-
-@item @kbd{S-@key{RIGHT}} (@code{org-table-move-cell-right})
-@kindex S-RIGHT
-@findex org-table-move-cell-right
-Move cell right by swapping with adjacent cell.
-
-@item @kbd{M-S-@key{DOWN}} (@code{org-table-insert-row})
-@kindex M-S-DOWN
-@findex org-table-insert-row
-Insert a new row above the current row. With a prefix argument, the
-line is created below the current one.
-
-@item @kbd{C-c -} (@code{org-table-insert-hline})
-@kindex C-c -
-@findex org-table-insert-hline
-Insert a horizontal line below current row. With a prefix argument,
-the line is created above the current line.
-
-@item @kbd{C-c @key{RET}} (@code{org-table-hline-and-move})
-@kindex C-c RET
-@findex org-table-hline-and-move
-Insert a horizontal line below current row, and move point into the
-row below that line.
-
-@item @kbd{C-c ^} (@code{org-table-sort-lines})
-@kindex C-c ^
-@findex org-table-sort-lines
-Sort the table lines in the region. The position of point indicates
-the column to be used for sorting, and the range of lines is the
-range between the nearest horizontal separator lines, or the entire
-table. If point is before the first column, you are 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. 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 is case-sensitive.
-@end table
-
-@anchor{Regions}
-@subheading Regions
-
-@table @asis
-@item @kbd{C-c C-x M-w} (@code{org-table-copy-region})
-@kindex C-c C-x M-w
-@findex org-table-copy-region
-Copy a rectangular region from a table to a special clipboard.
-Point and mark determine edge fields of the rectangle. If there is
-no active region, copy just the current field. The process ignores
-horizontal separator lines.
-
-@item @kbd{C-c C-x C-w} (@code{org-table-cut-region})
-@kindex C-c C-x C-w
-@findex org-table-cut-region
-Copy a rectangular region from a table to a special clipboard, and
-blank all fields in the rectangle. So this is the ``cut'' operation.
-
-@item @kbd{C-c C-x C-y} (@code{org-table-paste-rectangle})
-@kindex C-c C-x C-y
-@findex org-table-paste-rectangle
-Paste a rectangular region into a table. The upper left corner ends
-up in the current field. All involved fields are overwritten. If
-the rectangle does not fit into the present table, the table is
-enlarged as needed. The process ignores horizontal separator lines.
-
-@item @kbd{M-@key{RET}} (@code{org-table-wrap-region})
-@kindex M-RET
-@findex org-table-wrap-region
-Split the current field at point position and move the rest to the
-line below. 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. A numeric prefix argument may
-be used to change the number of desired lines. If there is no
-region, but you specify a prefix argument, the current field is made
-blank, and the content is appended to the field above.
-@end table
-
-@anchor{Calculations}
-@subheading Calculations
-
-@cindex formula, in tables
-@cindex calculations, in tables
-
-@table @asis
-@item @kbd{C-c +} (@code{org-table-sum})
-@kindex C-c +
-@findex org-table-sum
-Sum the numbers in the current column, or in the rectangle defined
-by the active region. The result is shown in the echo area and can
-be inserted with @kbd{C-y}.
-
-@item @kbd{S-@key{RET}} (@code{org-table-copy-down})
-@kindex S-RET
-@findex org-table-copy-down
-@vindex org-table-copy-increment
-When current field is empty, copy from first non-empty field above.
-When not empty, copy current field down to next row and move point
-along with it.
-
-Depending on the variable @code{org-table-copy-increment}, integer and
-time stamp field values, and fields prefixed or suffixed with
-a whole number, can be incremented during copy. Also, a @code{0} prefix
-argument temporarily disables the increment.
-
-This key is also used by shift-selection and related modes (see
-@ref{Conflicts}).
-@end table
-
-@anchor{Miscellaneous (1)}
-@subheading Miscellaneous
-
-@table @asis
-@item @kbd{C-c `} (@code{org-table-edit-field})
-@kindex C-c `
-@findex org-table-edit-field
-Edit the current field in a separate window. This is useful for
-fields that are not fully visible (see @ref{Column Width and Alignment}).
-When called with a @kbd{C-u} prefix, just make the full field
-visible, so that it can be edited in place. When called with two
-@kbd{C-u} prefixes, make the editor window follow point through
-the table and always show the current field. The follow mode exits
-automatically when point leaves the table, or when you repeat this
-command with @kbd{C-u C-u C-c `}.
-
-@item @kbd{M-x org-table-import}
-@findex org-table-import
-Import a file as a table. The table should be TAB or whitespace
-separated. Use, for example, to import a spreadsheet table or data
-from a database, because these programs generally can write
-TAB-separated text files. This command works by inserting the file
-into the buffer and then converting the region to a table. Any
-prefix argument is passed on to the converter, which uses it to
-determine the separator.
-
-@item @kbd{C-c |} (@code{org-table-create-or-convert-from-region})
-@kindex C-c |
-@findex org-table-create-or-convert-from-region
-Tables can also be imported by pasting tabular text into the Org
-buffer, selecting the pasted text with @kbd{C-x C-x} and then
-using the @kbd{C-c |} command (see @ref{Creation and conversion}).
-
-@item @kbd{M-x org-table-export}
-@findex org-table-export
-@vindex org-table-export-default-format
-Export the table, by default as a TAB-separated file. Use for data
-exchange with, for example, spreadsheet or database programs. The
-format used to export the file can be configured in the variable
-@code{org-table-export-default-format}. You may also use properties
-@samp{TABLE_EXPORT_FILE} and @samp{TABLE_EXPORT_FORMAT} to specify the file
-name and the format for table export in a subtree. Org supports
-quite general formats for exported tables. The exporter format is
-the same as the format used by Orgtbl radio tables, see @ref{Translator functions}, for a detailed description.
-
-@item @kbd{M-x org-table-header-line-mode}
-@findex org-table-header-line-mode
-@vindex org-table-header-line-p
-Turn on the display of the first data row of the table at point in
-the window header line when this first row is not visible anymore in
-the buffer. You can activate this minor mode by default by setting
-the option @code{org-table-header-line-p} to @code{t}.
-
-@item @kbd{M-x org-table-transpose-table-at-point}
-@findex org-table-transpose-table-at-point
-Transpose the table at point and eliminate hlines.
-@end table
-
-@node Column Width and Alignment
-@section Column Width and Alignment
-
-@cindex narrow columns in tables
-@cindex alignment in tables
-
-The width of columns is automatically determined by the table editor.
-The alignment of a column is determined automatically from the
-fraction of number-like versus non-number fields in the column.
-
-@vindex org-table-automatic-realign
-Editing a field may modify alignment of the table. Moving
-a contiguous row or column---i.e., using @kbd{@key{TAB}} or
-@kbd{@key{RET}}---automatically re-aligns it. If you want to disable
-this behavior, set @code{org-table-automatic-realign} to @code{nil}. In any
-case, you can always align manually a table:
-
-@table @asis
-@item @kbd{C-c C-c} (@code{org-table-align})
-@kindex C-c C-c
-@findex org-table-align
-Align the current table.
-@end table
-
-@vindex org-startup-align-all-tables
-Setting the option @code{org-startup-align-all-tables} re-aligns all tables
-in a file upon visiting it. You can also set this option on
-a per-file basis with:
-
-@example
-#+STARTUP: align
-#+STARTUP: noalign
-@end example
-
-Sometimes a single field or a few fields need to carry more text,
-leading to inconveniently wide columns. Maybe you want to hide away
-several columns or display them with a fixed width, regardless of
-content, as shown in the following example.
-
-@example
-|---+---------------------+--------| |---+-------…+…|
-| | <6> | | | | <6> …|…|
-| 1 | one | some | ----\ | 1 | one …|…|
-| 2 | two | boring | ----/ | 2 | two …|…|
-| 3 | This is a long text | column | | 3 | This i…|…|
-|---+---------------------+--------| |---+-------…+…|
-@end example
-
-To set the width of a column, one field anywhere in the column may
-contain just the string @samp{<N>} where @var{N} specifies the width
-as a number of characters. You control displayed width of columns
-with the following tools:
-
-@table @asis
-@item @kbd{C-c @key{TAB}} (@code{org-table-toggle-column-width})
-@kindex C-c TAB
-@findex org-table-toggle-column-width
-Shrink or expand current column.
-
-If a width cookie specifies a width W for the column, shrinking it
-displays the first W visible characters only. Otherwise, the column
-is shrunk to a single character.
-
-When called before the first column or after the last one, ask for
-a list of column ranges to operate on.
-
-@item @kbd{C-u C-c @key{TAB}} (@code{org-table-shrink})
-@kindex C-u C-c TAB
-@findex org-table-shrink
-Shrink all columns with a column width. Expand the others.
-
-@item @kbd{C-u C-u C-c @key{TAB}} (@code{org-table-expand})
-@kindex C-u C-u C-c TAB
-@findex org-table-expand
-Expand all columns.
-@end table
-
-To see the full text of a shrunk field, hold the mouse over it:
-a tool-tip window then shows the full contents of the field.
-Alternatively, @kbd{C-h .} (@code{display-local-help}) reveals them,
-too. For convenience, any change near the shrunk part of a column
-expands it.
-
-@vindex org-startup-shrink-all-tables
-Setting the option @code{org-startup-shrink-all-tables} shrinks all columns
-containing a width cookie in a file the moment it is visited. You can
-also set this option on a per-file basis with:
-
-@example
-#+STARTUP: shrink
-@end example
-
-
-If you would like to overrule the automatic alignment of number-rich
-columns to the right and of string-rich columns to the left, you can
-use @samp{<r>}, @samp{<c>} or @samp{<l>} in a similar fashion. You may also combine
-alignment and field width like this: @samp{<r10>}.
-
-Lines which only contain these formatting cookies are removed
-automatically upon exporting the document.
-
-@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. Upon export, boundaries between column
-groups are 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
-
-It is also sufficient to just insert the column group starters after
-every vertical line you would like to have:
-
-@example
-| N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) |
-|---+-----+-----+-----+---------+------------|
-| / | < | | | < | |
-@end example
-
-@node Orgtbl Mode
-@section The Orgtbl Minor Mode
-
-@cindex Orgtbl mode
-@cindex minor mode for tables
-
-@findex orgtbl-mode
-If you like the intuitive way the Org table editor works, you might
-also want to use it in other modes like Text mode or Mail mode. The
-minor mode Orgtbl mode makes this possible. You can always toggle the
-mode with @kbd{M-x orgtbl-mode}. To turn it on by default, for
-example in Message mode, use
-
-@lisp
-(add-hook 'message-mode-hook 'turn-on-orgtbl)
-@end lisp
-
-Furthermore, with some special setup, it is possible to maintain
-tables in arbitrary syntax with Orgtbl mode. For example, it is
-possible to 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
-@section The Spreadsheet
-
-@cindex calculations, in tables
-@cindex spreadsheet capabilities
-@cindex Calc package
-
-The table editor makes use of the Emacs Calc package to implement
-spreadsheet-like capabilities. It can also evaluate Emacs Lisp forms
-to derive fields from other fields. While fully featured, Org's
-implementation is not identical to other spreadsheets. For example,
-Org knows the concept of a @emph{column formula} that will be applied to
-all non-header fields in a column without having to copy the formula
-to each relevant field. There is also a formula debugger, and a
-formula editor with features for highlighting fields in the table
-corresponding to the references at point in the formula, moving these
-references by arrow keys.
-
-@menu
-* References:: How to refer to another field or range.
-* Formula syntax for Calc:: Using Calc to compute stuff.
-* Formula syntax for Lisp:: Writing formulas in Emacs Lisp.
-* Durations and time values:: How to compute durations and time values.
-* Field and range formulas:: Formula for specific (ranges of) fields.
-* Column formulas:: Formulas valid for an entire column.
-* Lookup functions:: Lookup functions for searching tables.
-* Editing and debugging formulas:: Fixing formulas.
-* Updating the table:: Recomputing all dependent fields.
-* Advanced features:: Field and column names, automatic recalculation...
-@end menu
-
-@node References
-@subsection References
-
-@cindex references
-
-To compute fields in the table from other fields, formulas must
-reference other fields or ranges. In Org, fields can be referenced by
-name, by absolute coordinates, and by relative coordinates. To find
-out what the coordinates of a field are, press @kbd{C-c ?} in
-that field, or press @kbd{C-c @}} to toggle the display of a grid.
-
-@anchor{Field references}
-@subsubheading Field references
-
-@cindex field references
-@cindex references, to fields
-Formulas can reference the value of another field in two ways. Like
-in any other spreadsheet, you may reference fields with
-a letter/number combination like @samp{B3}, meaning the second field in the
-third row. However, Org prefers to use another, more general
-representation that looks like this:@footnote{Org understands references typed by the user as @samp{B4}, but it
-does not use this syntax when offering a formula for editing. You can
-customize this behavior using the variable
-@code{org-table-use-standard-references}.}
-
-@example
-@@ROW$COLUMN
-@end example
-
-
-Column specifications can be absolute like @samp{$1}, @samp{$2}, @dots{}, @samp{$N}, or
-relative to the current column, i.e., the column of the field which is
-being computed, like @samp{$+1} or @samp{$-2}. @samp{$<} and @samp{$>} are immutable
-references to the first and last column, respectively, and you can use
-@samp{$>>>} to indicate the third column from the right.
-
-The row specification only counts data lines and ignores horizontal
-separator lines, or ``hlines''. Like with columns, you can use absolute
-row numbers @samp{@@1}, @samp{@@2}, @dots{}, @samp{@@N}, and row numbers relative to the
-current row like @samp{@@+3} or @samp{@@-1}. @samp{@@<} and @samp{@@>} are immutable
-references the first and last row in the table, respectively. You may
-also specify the row relative to one of the hlines: @samp{@@I} refers to the
-first hline, @samp{@@II} to the second, etc. @samp{@@-I} refers to the first such
-line above the current line, @samp{@@+I} to the first such line below the
-current line. You can also write @samp{@@III+2} which is the second data
-line after the third hline in the table.
-
-@samp{@@0} and @samp{$0} refer to the current row and column, respectively, i.e.,
-to the row/column for the field being computed. Also, if you omit
-either the column or the row part of the reference, the current
-row/column is implied.
-
-Org's references with @emph{unsigned} numbers are fixed references in the
-sense that if you use the same reference in the formula for two
-different fields, the same field is referenced each time. Org's
-references with @emph{signed} numbers are floating references because the
-same reference operator can reference different fields depending on
-the field being calculated by the formula.
-
-Here are a few examples:
-
-@multitable @columnfractions 0.2 0.8
-@item @samp{@@2$3}
-@tab 2nd row, 3rd column (same as @samp{C2})
-@item @samp{$5}
-@tab column 5 in the current row (same as @samp{E&})
-@item @samp{@@2}
-@tab current column, row 2
-@item @samp{@@-1$-3}
-@tab field one row up, three columns to the left
-@item @samp{@@-I$2}
-@tab field just under hline above current row, column 2
-@item @samp{@@>$5}
-@tab field in the last row, in column 5
-@end multitable
-
-@anchor{Range references}
-@subsubheading Range references
-
-@cindex range references
-@cindex references, to ranges
-You may reference a rectangular range of fields by specifying two
-field references connected by two dots @samp{..}. The ends are included in
-the range. If both fields are in the current row, you may simply use
-@samp{$2..$7}, but if at least one field is in a different row, you need to
-use the general @samp{@@ROW$COLUMN} format at least for the first field,
-i.e., the reference must start with @samp{@@} in order to be interpreted
-correctly. Examples:
-
-@multitable @columnfractions 0.2 0.8
-@item @samp{$1..$3}
-@tab first three fields in the current row
-@item @samp{$P..$Q}
-@tab range, using column names (see @ref{Advanced features})
-@item @samp{$<<<..$>>}
-@tab start in third column, continue to the last but one
-@item @samp{@@2$1..@@4$3}
-@tab nine fields between these two fields (same as @samp{A2..C4})
-@item @samp{@@-1$-2..@@-1}
-@tab 3 fields in the row above, starting from 2 columns on the left
-@item @samp{@@I..II}
-@tab between first and second hline, short for @samp{@@I..@@II}
-@end multitable
-
-@noindent
-Range references return a vector of values that can be fed into Calc
-vector functions. Empty fields in ranges are normally suppressed, so
-that the vector contains only the non-empty fields. For other options
-with the mode switches @samp{E}, @samp{N} and examples, see @ref{Formula syntax for Calc}.
-
-@anchor{Field coordinates in formulas}
-@subsubheading Field coordinates in formulas
-
-@cindex field coordinates
-@cindex coordinates, of field
-@cindex row, of field coordinates
-@cindex column, of field coordinates
-@vindex org-table-current-column
-@vindex org-table-current-dline
-One of the very first actions during evaluation of Calc formulas and
-Lisp formulas is to substitute @samp{@@#} and @samp{$#} 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:
-
-@table @asis
-@item @samp{if(@@# % 2, $#, string(""))}
-Insert column number on odd rows, set field to empty on even rows.
-
-@item @samp{$2 = '(identity remote(FOO, @@@@#$1))}
-Copy text or values of each row of column 1 of the table named
-@var{FOO} into column 2 of the current table.
-
-@item @samp{@@3 = 2 * remote(FOO, @@1$$#)}
-Insert the doubled value of each column of row 1 of the table
-named @var{FOO} into row 3 of the current table.
-@end table
-
-@noindent
-For the second and third examples, table @var{FOO} must have at
-least as many rows or columns as the current table. Note that this is
-inefficient@footnote{The computation time scales as O(N^2) because table
-@var{FOO} is parsed for each field to be copied.} for large number of rows.
-
-@anchor{Named references}
-@subsubheading Named references
-
-@cindex named references
-@cindex references, named
-@cindex name, of column or field
-@cindex constants, in calculations
-@cindex @samp{CONSTANTS}, keyword
-@vindex org-table-formula-constants
-
-@samp{$name} is interpreted as the name of a column, parameter or constant.
-Constants are defined globally through the variable
-@code{org-table-formula-constants}, and locally---for the file---through
-a line like this example:
-
-@example
-#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6
-@end example
-
-
-@vindex constants-unit-system
-@pindex constants.el
-Also, properties (see @ref{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 @samp{constants.el}
-package, it will also be used to resolve constants, including natural
-constants like @samp{$h} for Planck's constant, and units like @samp{$km} for
-kilometers@footnote{The file @samp{constants.el} can supply the values of constants in
-two different unit systems, @samp{SI} and @samp{cgs}. Which one is used depends
-on the value of the variable @code{constants-unit-system}. You can use the
-@samp{STARTUP} options @samp{constSI} and @samp{constcgs} to set this value for the
-current buffer.}. Column names and parameters can be specified in
-special table lines. These are described below, see @ref{Advanced features}. All names must start with a letter, and further consist
-of letters and numbers.
-
-@anchor{Remote references}
-@subsubheading Remote references
-
-@cindex remote references
-@cindex references, remote
-@cindex references, to a different table
-@cindex name, of column or field
-@cindex @samp{NAME}, keyword
-You may also reference constants, fields and ranges from a different
-table, either in the current file or even in a different file. The
-syntax is
-
-@example
-remote(NAME,REF)
-@end example
-
-
-@noindent
-where @var{NAME} can be the name of a table in the current file
-as set by a @samp{#+NAME:} line before the table. It can also be the ID of
-an entry, even in a different file, and the reference then refers to
-the first table in that entry. @var{REF} is an absolute field or
-range reference as described above for example @samp{@@3$3} or @samp{$somename},
-valid in the referenced table.
-
-@cindex table indirection
-When @var{NAME} has the format @samp{@@ROW$COLUMN}, it is substituted
-with the name or ID found in this field of the current table. For
-example @samp{remote($1, @@@@>$2)} @result{} @samp{remote(year_2013, @@@@>$1)}. The format
-@samp{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
-
-A formula can be any algebraic expression understood by the Emacs Calc
-package. Note that Calc has the non-standard convention that @samp{/} has
-lower precedence than @samp{*}, so that @samp{a/b*c} is interpreted as
-@samp{(a/(b*c))}. Before evaluation by @code{calc-eval} (see @ref{Calling Calc from Your Programs,Calling Calc from
-Your Lisp Programs,,calc,}), variable substitution takes place according to
-the rules described above.
-
-@cindex vectors, in table calculations
-The range vectors can be directly fed into the Calc vector functions
-like @code{vmean} and @code{vsum}.
-
-@cindex format specifier, in spreadsheet
-@cindex mode, for Calc
-@vindex org-calc-default-modes
-A formula can contain an optional mode string after a semicolon. This
-string consists of flags to influence Calc and other modes during
-execution. By default, Org uses the standard Calc modes (precision
-12, angular units degrees, fraction and symbolic modes off). The
-display format, however, has been changed to @samp{(float 8)} to keep
-tables compact. The default settings can be configured using the
-variable @code{org-calc-default-modes}.
-
-@table @asis
-@item @samp{p20}
-Set the internal Calc calculation precision to 20 digits.
-
-@item @samp{n3}, @samp{s3}, @samp{e2}, @samp{f4}
-Normal, scientific, engineering or fixed format of the result of
-Calc passed back to Org. Calc formatting is unlimited in precision
-as long as the Calc calculation precision is greater.
-
-@item @samp{D}, @samp{R}
-Degree and radian angle modes of Calc.
-
-@item @samp{F}, @samp{S}
-Fraction and symbolic modes of Calc.
-
-@item @samp{T}, @samp{t}, @samp{U}
-Duration computations in Calc or Lisp, @ref{Durations and time values}.
-
-@item @samp{E}
-If and how to consider empty fields. Without @samp{E} empty fields in
-range references are suppressed so that the Calc vector or Lisp list
-contains only the non-empty fields. With @samp{E} the empty fields are
-kept. For empty fields in ranges or empty field references the
-value @samp{nan} (not a number) is used in Calc formulas and the empty
-string is used for Lisp formulas. Add @samp{N} to use 0 instead for both
-formula types. For the value of a field the mode @samp{N} has higher
-precedence than @samp{E}.
-
-@item @samp{N}
-Interpret all fields as numbers, use 0 for non-numbers. See the
-next section to see how this is essential for computations with Lisp
-formulas. In Calc formulas it is used only occasionally because
-there number strings are already interpreted as numbers without @samp{N}.
-
-@item @samp{L}
-Literal, for Lisp formulas only. See the next section.
-@end table
-
-Unless you use large integer numbers or high-precision calculation and
-display for floating point numbers you may alternatively provide
-a @code{printf} format specifier to reformat the Calc result after it has
-been passed back to Org instead of letting Calc already do the
-formatting@footnote{The printf reformatting is limited in precision because the
-value passed to it is converted into an ``integer'' or ``double''. The
-``integer'' is limited in size by truncating the signed value to 32
-bits. The ``double'' is limited in precision to 64 bits overall which
-leaves approximately 16 significant decimal digits.}. A few examples:
-
-@multitable {aaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{$1+$2}
-@tab Sum of first and second field
-@item @samp{$1+$2;%.2f}
-@tab Same, format result to two decimals
-@item @samp{exp($2)+exp($1)}
-@tab Math functions can be used
-@item @samp{$0;%.1f}
-@tab Reformat current cell to 1 decimal
-@item @samp{($3-32)*5/9}
-@tab Degrees F @arrow{} C conversion
-@item @samp{$c/$1/$cm}
-@tab Hz @arrow{} cm conversion, using @samp{constants.el}
-@item @samp{tan($1);Dp3s1}
-@tab Compute in degrees, precision 3, display SCI 1
-@item @samp{sin($1);Dp3%.1e}
-@tab Same, but use @code{printf} specifier for display
-@item @samp{vmean($2..$7)}
-@tab Compute column range mean, using vector function
-@item @samp{vmean($2..$7);EN}
-@tab Same, but treat empty fields as 0
-@item @samp{taylor($3,x=7,2)}
-@tab Taylor series of $3, at x=7, second degree
-@end multitable
-
-Calc also contains a complete set of logical operations (see @ref{Logical Operations,Logical
-Operations,,calc,}). For example
-
-@table @asis
-@item @samp{if($1 < 20, teen, string(""))}
-@samp{"teen"} if age @samp{$1} is less than 20, else the Org table result
-field is set to empty with the empty string.
-
-@item @samp{if("$1" =​= "nan" || "$2" =​= "nan", string(""), $1 + $2); E f-1}
-Sum of the first two columns. When at least one of the input fields
-is empty the Org table result field is set to empty. @samp{E} is
-required to not convert empty fields to 0. @samp{f-1} is an optional
-Calc format string similar to @samp{%.1f} but leaves empty results empty.
-
-@item @samp{if(typeof(vmean($1..$7)) =​= 12, string(""), vmean($1..$7); E}
-Mean value of a range unless there is any empty field. Every field
-in the range that is empty is replaced by @samp{nan} which lets @samp{vmean}
-result in @samp{nan}. Then @samp{typeof =} 12= detects the @samp{nan} from @code{vmean}
-and the Org table result field is set to empty. Use this when the
-sample set is expected to never have missing values.
-
-@item @samp{if("$1..$7" =​= "[]", string(""), vmean($1..$7))}
-Mean value of a range with empty fields skipped. Every field in the
-range that is empty is skipped. When all fields in the range are
-empty the mean value is not defined and the Org table result field
-is set to empty. Use this when the sample set can have a variable
-size.
-
-@item @samp{vmean($1..$7); EN}
-To complete the example before: Mean value of a range with empty
-fields counting as samples with value 0. Use this only when
-incomplete sample sets should be padded with 0 to the full size.
-@end table
-
-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
-@subsection Emacs Lisp forms as formulas
-
-@cindex Lisp forms, as table formulas
-
-It is also possible to write a formula in Emacs Lisp. This can be
-useful for string manipulation and control structures, if Calc's
-functionality is not enough.
-
-If a formula starts with a single-quote followed by an opening
-parenthesis, then it is evaluated as a Lisp form. The evaluation
-should return either a string or a number. Just as with Calc
-formulas, you can specify modes and a @code{printf} format after
-a semicolon.
-
-With Emacs Lisp forms, you need to be conscious about the way field
-references are interpolated into the form. By default, a reference is
-interpolated as a Lisp string (in double-quotes) containing the field.
-If you provide the @samp{N} mode switch, all referenced elements are
-numbers---non-number fields will be zero---and interpolated as Lisp
-numbers, without quotes. If you provide the @samp{L} flag, all fields are
-interpolated literally, without quotes. For example, if you want a
-reference to be interpreted as a string by the Lisp form, enclose the
-reference operator itself in double-quotes, like @samp{"$3"}. Ranges are
-inserted as space-separated fields, so you can embed them in list or
-vector syntax.
-
-Here are a few examples---note how the @samp{N} mode is used when we do
-computations in Lisp:
-
-@table @asis
-@item @samp{'(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2))}
-Swap the first two characters of the content of column 1.
-
-@item @samp{'(+ $1 $2);N}
-Add columns 1 and 2, equivalent to Calc's @samp{$1+$2}.
-
-@item @samp{'(apply '+ '($1..$4));N}
-Compute the sum of columns 1 to 4, like Calc's @samp{vsum($1..$4)}.
-@end table
-
-@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 @samp{T}, @samp{t}, or @samp{U} flag,
-either in Calc formulas or Elisp formulas:
-
-@example
-| 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;U::@@4$3=$1+$2;t
-@end example
-
-Input duration values must be of the form @samp{HH:MM[:SS]}, where seconds
-are optional. With the @samp{T} flag, computed durations are displayed as
-@samp{HH:MM:SS} (see the first formula above). With the @samp{U} flag, seconds
-are omitted so that the result is only @samp{HH:MM} (see second formula
-above). Zero-padding of the hours field depends upon the value of the
-variable @code{org-table-duration-hour-zero-padding}.
-
-With the @samp{t} flag, computed durations are displayed according to the
-value of the option @code{org-table-duration-custom-format}, which defaults
-to @code{hours} and displays 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 are
-considered as seconds in addition and subtraction.
-
-@node Field and range formulas
-@subsection Field and range formulas
-
-@cindex field formula
-@cindex range formula
-@cindex formula, for individual table field
-@cindex formula, for range of fields
-
-To assign a formula to a particular field, type it directly into the
-field, preceded by @samp{:=}, for example @samp{vsum(@@II..III)}. When you press
-@kbd{@key{TAB}} or @kbd{@key{RET}} or @kbd{C-c C-c} with point
-still in the field, the formula is stored as the formula for this
-field, evaluated, and the current field is replaced with the result.
-
-@cindex @samp{TBLFM}, keyword
-Formulas are stored in a special @samp{TBLFM} keyword located directly
-below the table. If you type the equation in the fourth field of the
-third data line in the table, the formula looks like @samp{@@3$4=$1+$2}.
-When inserting/deleting/swapping column and rows with the appropriate
-commands, @emph{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 @samp{@@<}, @samp{@@>}, @samp{$<}, @samp{$>}), or at
-hlines using the @samp{@@I} notation. Automatic adaptation of field
-references does not happen if you edit the table structure with normal
-editing commands---you must fix the formulas yourself.
-
-Instead of typing an equation into the field, you may also use the
-following command
-
-@table @asis
-@item @kbd{C-u C-c =} (@code{org-table-eval-formula})
-@kindex C-u C-c =
-@findex org-table-eval-formula
-Install a new formula for the current field. The command prompts
-for a formula with default taken from the @samp{TBLFM} keyword,
-applies it to the current field, and stores it.
-@end table
-
-The left-hand side of a formula can also be a special expression in
-order to assign the formula to a number of different fields. There is
-no keyboard shortcut to enter such range formulas. To add them, use
-the formula editor (see @ref{Editing and debugging formulas}) or edit
-the @samp{TBLFM} keyword directly.
-
-@table @asis
-@item @samp{$2=}
-Column formula, valid for the entire column. This is so common that
-Org treats these formulas in a special way, see @ref{Column formulas}.
-
-@item @samp{@@3=}
-Row formula, applies to all fields in the specified row. @samp{@@>=}
-means the last row.
-
-@item @samp{@@1$2..@@4$3=}
-Range formula, applies to all fields in the given rectangular range.
-This can also be used to assign a formula to some but not all fields
-in a row.
-
-@item @samp{$NAME=}
-Named field, see @ref{Advanced features}.
-@end table
-
-@node Column formulas
-@subsection Column formulas
-
-@cindex column formula
-@cindex formula, for table column
-
-When you assign a formula to a simple column reference like @samp{$3=}, the
-same formula is used in all fields of that column, with the following
-very convenient exceptions: (i) If the table contains horizontal
-separator hlines with rows above and below, everything before the
-first such hline is considered part of the table @emph{header} and is not
-modified by column formulas. Therefore a header is mandatory when you
-use column formulas and want to add hlines to group rows, like for
-example to separate a total row at the bottom from the summand rows
-above. (ii) Fields that already get a value from a field/range
-formula are left alone by column formulas. These conditions make
-column formulas very easy to use.
-
-To assign a formula to a column, type it directly into any field in
-the column, preceded by an equal sign, like @samp{=$1+$2}. When you press
-@kbd{@key{TAB}} or @kbd{@key{RET}} or @kbd{C-c C-c} with point
-still in the field, the formula is stored as the formula for the
-current column, evaluated 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 only remembers the most
-recently used formula. In the @samp{TBLFM} keyword, column formulas look
-like @samp{$4=$1+$2}. The left-hand side of a column formula can not be
-the name of column, it must be the numeric column reference or @samp{$>}.
-
-Instead of typing an equation into the field, you may also use the
-following command:
-
-@table @asis
-@item @kbd{C-c =} (@code{org-table-eval-formula})
-@kindex C-c =
-@findex org-table-eval-formula
-Install a new formula for the current column and replace current
-field with the result of the formula. The command prompts for
-a formula, with default taken from the @samp{TBLFM} keyword, applies it
-to the current field and stores it. With a numeric prefix argument,
-e.g., @kbd{C-5 C-c =}, the command applies it to that many
-consecutive fields in the current column.
-@end table
-
-@node Lookup functions
-@subsection Lookup functions
-
-@cindex lookup functions in tables
-@cindex table lookup functions
-
-Org has three predefined Emacs Lisp functions for lookups in tables.
-
-@table @asis
-@item @samp{(org-lookup-first VAL S-LIST R-LIST &optional PREDICATE)}
-@findex org-lookup-first
-Searches for the first element @var{S} in list
-@var{S-LIST} for which
-@lisp
-(PREDICATE VAL S)
-@end lisp
-is non-@code{nil}; returns the value from the corresponding position in
-list @var{R-LIST}. The default @var{PREDICATE} is
-@code{equal}. Note that the parameters @var{VAL} and @var{S}
-are passed to @var{PREDICATE} in the same order as the
-corresponding parameters are in the call to @code{org-lookup-first},
-where @var{VAL} precedes @var{S-LIST}. If
-@var{R-LIST} is @code{nil}, the matching element @var{S} of
-@var{S-LIST} is returned.
-
-@item @samp{(org-lookup-last VAL S-LIST R-LIST &optional PREDICATE)}
-@findex org-lookup-last
-Similar to @code{org-lookup-first} above, but searches for the @emph{last}
-element for which @var{PREDICATE} is non-@code{nil}.
-
-@item @samp{(org-lookup-all VAL S-LIST R-LIST &optional PREDICATE)}
-@findex org-lookup-all
-Similar to @code{org-lookup-first}, but searches for @emph{all} elements for
-which @var{PREDICATE} is non-@code{nil}, and returns @emph{all}
-corresponding values. This function can not be used by itself in
-a formula, because it returns a list of values. However, powerful
-lookups can be built when this function is combined with other Emacs
-Lisp functions.
-@end table
-
-If the ranges used in these functions contain empty fields, the @samp{E}
-mode for the formula should usually be specified: otherwise empty
-fields are not included in @var{S-LIST} and/or @var{R-LIST}
-which can, for example, result in an incorrect mapping from an element
-of @var{S-LIST} to the corresponding element of
-@var{R-LIST}.
-
-These three functions can be used to implement associative arrays,
-count matching cells, rank results, group data, etc. For practical
-examples see @uref{https://orgmode.org/worg/org-tutorials/org-lookups.html, this tutorial on Worg}.
-
-@node Editing and debugging formulas
-@subsection Editing and debugging formulas
-
-@cindex formula editing
-@cindex editing, of table formulas
-
-@vindex org-table-use-standard-references
-You can edit individual formulas in the minibuffer or directly in the
-field. Org can also prepare a special buffer with all active formulas
-of a table. When offering a formula for editing, Org converts
-references to the standard format (like @samp{B3} or @samp{D&}) if possible. If
-you prefer to only work with the internal format (like @samp{@@3$2} or
-@samp{$4}), configure the variable @code{org-table-use-standard-references}.
-
-@table @asis
-@item @kbd{C-c =} or @kbd{C-u C-c =} (@code{org-table-eval-formula})
-@kindex C-c =
-@kindex C-u C-c =
-@findex org-table-eval-formula
-Edit the formula associated with the current column/field in the
-minibuffer. See @ref{Column formulas}, and @ref{Field and range formulas}.
-
-@item @kbd{C-u C-u C-c =} (@code{org-table-eval-formula})
-@kindex C-u C-u C-c =
-@findex org-table-eval-formula
-Re-insert the active formula (either a field formula, or a column
-formula) into the current field, so that you can edit it directly in
-the field. The advantage over editing in the minibuffer is that you
-can use the command @kbd{C-c ?}.
-
-@item @kbd{C-c ?} (@code{org-table-field-info})
-@kindex C-c ?
-@findex org-table-field-info
-While editing a formula in a table field, highlight the field(s)
-referenced by the reference at point position in the formula.
-
-@item @kbd{C-c @}} (@code{org-table-toggle-coordinate-overlays})
-@kindex C-c @}
-@findex org-table-toggle-coordinate-overlays
-Toggle the display of row and column numbers for a table, using
-overlays. These are updated each time the table is aligned; you can
-force it with @kbd{C-c C-c}.
-
-@item @kbd{C-c @{} (@code{org-table-toggle-formula-debugger})
-@kindex C-c @{
-@findex org-table-toggle-formula-debugger
-Toggle the formula debugger on and off. See below.
-
-@item @kbd{C-c '} (@code{org-table-edit-formulas})
-@kindex C-c '
-@findex org-table-edit-formulas
-Edit all formulas for the current table in a special buffer, where
-the formulas are displayed one per line. If the current field has
-an active formula, point in the formula editor marks it. While
-inside the special buffer, Org automatically highlights any field or
-range reference at point position. You may edit, remove and add
-formulas, and use the following commands:
-
-@table @asis
-@item @kbd{C-c C-c} or @kbd{C-x C-s} (@code{org-table-fedit-finish})
-@kindex C-x C-s
-@kindex C-c C-c
-@findex org-table-fedit-finish
-Exit the formula editor and store the modified formulas. With
-@kbd{C-u} prefix, also apply the new formulas to the
-entire table.
-
-@item @kbd{C-c C-q} (@code{org-table-fedit-abort})
-@kindex C-c C-q
-@findex org-table-fedit-abort
-Exit the formula editor without installing changes.
-
-@item @kbd{C-c C-r} (@code{org-table-fedit-toggle-ref-type})
-@kindex C-c C-r
-@findex org-table-fedit-toggle-ref-type
-Toggle all references in the formula editor between standard (like
-@samp{B3}) and internal (like @samp{@@3$2}).
-
-@item @kbd{@key{TAB}} (@code{org-table-fedit-lisp-indent})
-@kindex TAB
-@findex org-table-fedit-lisp-indent
-Pretty-print or indent Lisp formula at point. When in a line
-containing a Lisp formula, format the formula according to Emacs
-Lisp rules. Another @kbd{@key{TAB}} collapses the formula back
-again. In the open formula, @kbd{@key{TAB}} re-indents just like
-in Emacs Lisp mode.
-
-@item @kbd{M-@key{TAB}} (@code{lisp-complete-symbol})
-@kindex M-TAB
-@findex lisp-complete-symbol
-Complete Lisp symbols, just like in Emacs Lisp mode.
-
-@item @kbd{S-@key{UP}}, @kbd{S-@key{DOWN}}, @kbd{S-@key{LEFT}}, @kbd{S-@key{RIGHT}}
-@kindex S-UP
-@kindex S-DOWN
-@kindex S-LEFT
-@kindex S-RIGHT
-@findex org-table-fedit-ref-up
-@findex org-table-fedit-ref-down
-@findex org-table-fedit-ref-left
-@findex org-table-fedit-ref-right
-Shift the reference at point. For example, if the reference is
-@samp{B3} and you press @kbd{S-@key{RIGHT}}, it becomes @samp{C3}. This also
-works for relative references and for hline references.
-
-@item @kbd{M-S-@key{UP}} (@code{org-table-fedit-line-up})
-@kindex M-S-UP
-@findex org-table-fedit-line-up
-Move the test line for column formulas up in the Org buffer.
-
-@item @kbd{M-S-@key{DOWN}} (@code{org-table-fedit-line-down})
-@kindex M-S-DOWN
-@findex org-table-fedit-line-down
-Move the test line for column formulas down in the Org buffer.
-
-@item @kbd{M-@key{UP}} (@code{org-table-fedit-scroll-up})
-@kindex M-UP
-@findex org-table-fedit-scroll-up
-Scroll up the window displaying the table.
-
-@item @kbd{M-@key{DOWN}} (@code{org-table-fedit-scroll-down})
-@kindex M-DOWN
-@findex org-table-fedit-scroll-down
-Scroll down the window displaying the table.
-
-@item @kbd{C-c @}}
-@kindex C-c @}
-@findex org-table-toggle-coordinate-overlays
-Turn the coordinate grid in the table on and off.
-@end table
-@end table
-
-Making a table field blank does not remove the formula associated with
-the field, because that is stored in a different line---the @samp{TBLFM}
-keyword line. During the next recalculation, the field will be filled
-again. To remove a formula from a field, you have to give an empty
-reply when prompted for the formula, or to edit the @samp{TBLFM} keyword.
-
-@kindex C-c C-c
-You may edit the @samp{TBLFM} keyword directly and re-apply the changed
-equations with @kbd{C-c C-c} in that line or with the normal
-recalculation commands in the table.
-
-@anchor{Using multiple @samp{TBLFM} lines}
-@subsubheading Using multiple @samp{TBLFM} lines
-
-@cindex multiple formula lines
-@cindex @samp{TBLFM} keywords, multiple
-@cindex @samp{TBLFM}, switching
-
-@kindex C-c C-c
-You may apply the formula temporarily. This is useful when you want
-to switch the formula applied to the table. Place multiple @samp{TBLFM}
-keywords right after the table, and then press @kbd{C-c C-c} on
-the formula to apply. Here is an example:
-
-@example
-| x | y |
-|---+---|
-| 1 | |
-| 2 | |
-#+TBLFM: $2=$1*1
-#+TBLFM: $2=$1*2
-@end example
-
-@noindent
-Pressing @kbd{C-c C-c} in the line of @samp{#+TBLFM: $2=$1*2} yields:
-
-@example
-| x | y |
-|---+---|
-| 1 | 2 |
-| 2 | 4 |
-#+TBLFM: $2=$1*1
-#+TBLFM: $2=$1*2
-@end example
-
-@noindent
-If you recalculate this table, with @kbd{C-u C-c *}, for example,
-you get the following result from applying only the first @samp{TBLFM}
-keyword.
-
-@example
-| x | y |
-|---+---|
-| 1 | 1 |
-| 2 | 2 |
-#+TBLFM: $2=$1*1
-#+TBLFM: $2=$1*2
-@end example
-
-@anchor{Debugging formulas}
-@subsubheading Debugging formulas
-
-@cindex formula debugging
-@cindex debugging, of table formulas
-
-When the evaluation of a formula leads to an error, the field content
-becomes the string @samp{#ERROR}. If you would like to see what is going
-on during variable substitution and calculation in order to find
-a bug, turn on formula debugging in the Tbl menu and repeat the
-calculation, for example by pressing @kbd{C-u C-u C-c = @key{RET}} in
-a field. Detailed information are displayed.
-
-@node Updating the table
-@subsection Updating the table
-
-@cindex recomputing table fields
-@cindex updating, table
-
-Recalculation of a table is normally not automatic, but needs to be
-triggered by a command. To make recalculation at least
-semi-automatic, see @ref{Advanced features}.
-
-In order to recalculate a line of a table or the entire table, use the
-following commands:
-
-@table @asis
-@item @kbd{C-c *} (@code{org-table-recalculate})
-@kindex C-c *
-@findex org-table-recalculate
-Recalculate the current row by first applying the stored column
-formulas from left to right, and all field/range formulas in the
-current row.
-
-@item @kbd{C-u C-c *} or @kbd{C-u C-c C-c}
-@kindex C-u C-c *
-@kindex C-u C-c C-c
-Recompute the entire table, line by line. Any lines before the
-first hline are left alone, assuming that these are part of the
-table header.
-
-@item @kbd{C-u C-u C-c *} or @kbd{C-u C-u C-c C-c} (@code{org-table-iterate})
-@kindex C-u C-u C-c *
-@kindex C-u C-u C-c C-c
-@findex org-table-iterate
-Iterate the table by recomputing it until no further changes occur.
-This may be necessary if some computed fields use the value of other
-fields that are computed @emph{later} in the calculation sequence.
-
-@item @kbd{M-x org-table-recalculate-buffer-tables}
-@findex org-table-recalculate-buffer-tables
-Recompute all tables in the current buffer.
-
-@item @kbd{M-x org-table-iterate-buffer-tables}
-@findex org-table-iterate-buffer-tables
-Iterate all tables in the current buffer, in order to converge
-table-to-table dependencies.
-@end table
-
-@node Advanced features
-@subsection Advanced features
-
-If you want the recalculation of fields to happen automatically, or if
-you want to be able to assign @emph{names}@footnote{Such names must start with an alphabetic character and use
-only alphanumeric/underscore characters.} to fields and columns,
-you need to reserve the first column of the table for special marking
-characters.
-
-@table @asis
-@item @kbd{C-#} (@code{org-table-rotate-recalc-marks})
-@kindex C-#
-@findex org-table-rotate-recalc-marks
-Rotate the calculation mark in first column through the states @samp{#},
-@samp{*}, @samp{!}, @samp{$}. When there is an active region, change all marks in
-the region.
-@end table
-
-Here is an example of a table that collects exam results of students
-and makes use of these features:
-
-@example
-|---+---------+--------+--------+--------+-------+------|
-| | Student | Prob 1 | Prob 2 | Prob 3 | Total | Note |
-|---+---------+--------+--------+--------+-------+------|
-| ! | | P1 | P2 | P3 | Tot | |
-| # | Maximum | 10 | 15 | 25 | 50 | 10.0 |
-| ^ | | m1 | m2 | m3 | mt | |
-|---+---------+--------+--------+--------+-------+------|
-| # | Peter | 10 | 8 | 23 | 41 | 8.2 |
-| # | Sam | 2 | 4 | 3 | 9 | 1.8 |
-|---+---------+--------+--------+--------+-------+------|
-| | Average | | | | 25.0 | |
-| ^ | | | | | at | |
-| $ | max=50 | | | | | |
-|---+---------+--------+--------+--------+-------+------|
-#+TBLFM: $6=vsum($P1..$P3)::$7=10*$Tot/$max;%.1f::$at=vmean(@@-II..@@-I);%.1f
-@end example
-
-@quotation Important
-Please note that for these special tables, recalculating the table
-with @kbd{C-u C-c *} only affects rows that are marked @samp{#} or
-@samp{*}, and fields that have a formula assigned to the field itself. The
-column formulas are not applied in rows with empty first field.
-
-@end quotation
-
-@cindex marking characters, tables
-The marking characters have the following meaning:
-
-@table @asis
-@item @samp{!}
-The fields in this line define names for the columns, so that you
-may refer to a column as @samp{$Tot} instead of @samp{$6}.
-
-@item @samp{^}
-This row defines names for the fields @emph{above} the row. With such
-a definition, any formula in the table may use @samp{$m1} to refer to the
-value @samp{10}. Also, if you assign a formula to a names field, it is
-stored as @samp{$name = ...}.
-
-@item @samp{_}
-Similar to @samp{^}, but defines names for the fields in the row @emph{below}.
-
-@item @samp{$}
-Fields in this row can define @emph{parameters} for formulas. For
-example, if a field in a @samp{$} row contains @samp{max=50}, then formulas in
-this table can refer to the value 50 using @samp{$max}. Parameters work
-exactly like constants, only that they can be defined on a per-table
-basis.
-
-@item @samp{#}
-Fields in this row are automatically recalculated when pressing
-@kbd{@key{TAB}} or @kbd{@key{RET}} or @kbd{S-@key{TAB}} in this row.
-Also, this row is selected for a global recalculation with
-@kbd{C-u C-c *}. Unmarked lines are left alone by this
-command.
-
-@item @samp{*}
-Selects this line for global recalculation with @kbd{C-u C-c *}, but not for automatic recalculation. Use this when automatic
-recalculation slows down editing too much.
-
-@item @samp{/}
-Do not export this line. Useful for lines that contain the
-narrowing @samp{<N>} markers or column group markers.
-@end table
-
-Finally, just to whet your appetite for what can be done with the
-fantastic Calc package, here is a table that computes the Taylor
-series of degree n at location x for a couple of functions.
-
-@example
-|---+-------------+---+-----+--------------------------------------|
-| | Func | n | x | Result |
-|---+-------------+---+-----+--------------------------------------|
-| # | exp(x) | 1 | x | 1 + x |
-| # | exp(x) | 2 | x | 1 + x + x^2 / 2 |
-| # | exp(x) | 3 | x | 1 + x + x^2 / 2 + x^3 / 6 |
-| # | x^2+sqrt(x) | 2 | x=0 | x*(0.5 / 0) + x^2 (2 - 0.25 / 0) / 2 |
-| # | x^2+sqrt(x) | 2 | x=1 | 2 + 2.5 x - 2.5 + 0.875 (x - 1)^2 |
-| * | tan(x) | 3 | x | 0.0175 x + 1.77e-6 x^3 |
-|---+-------------+---+-----+--------------------------------------|
-#+TBLFM: $5=taylor($2,$4,$3);n3
-@end example
-
-@node Org Plot
-@section Org Plot
-
-@cindex graph, in tables
-@cindex plot tables using Gnuplot
-
-Org Plot can produce graphs of information stored in Org tables,
-either graphically or in ASCII art.
-
-@anchor{Graphical plots using Gnuplot}
-@subheading Graphical plots using Gnuplot
-
-@cindex @samp{PLOT}, keyword
-Org Plot can produce 2D and 3D graphs of information stored in Org
-tables using @uref{http://www.gnuplot.info/, Gnuplot} and @uref{http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html, Gnuplot mode}. To see this in action, ensure
-that you have both Gnuplot and Gnuplot mode installed on your system,
-then call @kbd{C-c " g} or @kbd{M-x org-plot/gnuplot} on the
-following table.
-
-@example
-#+PLOT: title:"Citas" ind:1 deps:(3) type:2d with:histograms set:"yrange [0:]"
-| Sede | Max cites | H-index |
-|-----------+-----------+---------|
-| Chile | 257.72 | 21.39 |
-| Leeds | 165.77 | 19.68 |
-| Sao Paolo | 71.00 | 11.50 |
-| Stockholm | 134.19 | 14.33 |
-| Morelia | 257.56 | 17.67 |
-@end example
-
-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 @samp{PLOT} keyword
-preceding a table. See below for a complete list of Org Plot options.
-For more information and examples see the @uref{https://orgmode.org/worg/org-tutorials/org-plot.html, Org Plot tutorial}.
-
-@anchor{Plot options}
-@subsubheading Plot options
-
-@table @asis
-@item @samp{set}
-Specify any Gnuplot option to be set when graphing.
-
-@item @samp{title}
-Specify the title of the plot.
-
-@item @samp{ind}
-Specify which column of the table to use as the @samp{x} axis.
-
-@item @samp{deps}
-Specify the columns to graph as a Lisp style list, surrounded by
-parentheses and separated by spaces for example @samp{dep:(3 4)} to graph
-the third and fourth columns. Defaults to graphing all other
-columns aside from the @samp{ind} column.
-
-@item @samp{type}
-Specify whether the plot is @samp{2d}, @samp{3d}, or @samp{grid}.
-
-@item @samp{with}
-Specify a @samp{with} option to be inserted for every column being
-plotted, e.g., @samp{lines}, @samp{points}, @samp{boxes}, @samp{impulses}. Defaults to
-@samp{lines}.
-
-@item @samp{file}
-If you want to plot to a file, specify
-@samp{"path/to/desired/output-file"}.
-
-@item @samp{labels}
-List of labels to be used for the @samp{deps}. Defaults to the column
-headers if they exist.
-
-@item @samp{line}
-Specify an entire line to be inserted in the Gnuplot script.
-
-@item @samp{map}
-When plotting @samp{3d} or @samp{grid} types, set this to @samp{t} to graph a flat
-mapping rather than a @samp{3d} slope.
-
-@item @samp{timefmt}
-Specify format of Org mode timestamps as they will be parsed by
-Gnuplot. Defaults to @samp{%Y-%m-%d-%H:%M:%S}.
-
-@item @samp{script}
-If you want total control, you can specify a script file---place the
-file name between double-quotes---which will be used to plot.
-Before plotting, every instance of @samp{$datafile} in the specified
-script will be replaced with the path to the generated data file.
-Note: even if you set this option, you may still want to specify the
-plot type, as that can impact the content of the data file.
-@end table
-
-@anchor{ASCII bar plots}
-@subheading ASCII bar plots
-
-While point is on a column, typing @kbd{C-c `` a} or @kbd{M-x orgtbl-ascii-plot} 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
-| 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 example
-
-The formula is an Elisp call.
-
-@defun orgtbl-ascii-draw value min max &optional width
-Draw an ASCII bar in a table.
-
-@var{VALUE} is the value to plot.
-
-@var{MIN} is the value displayed as an empty bar. @var{MAX}
-is the value filling all the @var{WIDTH}. Sources values outside
-this range are displayed as @samp{too small} or @samp{too large}.
-
-@var{WIDTH} is the number of characters of the bar plot. It
-defaults to @samp{12}.
-@end defun
-
-@node Hyperlinks
-@chapter Hyperlinks
-
-@cindex hyperlinks
-
-Like HTML, Org provides support for links inside a file, external
-links to other files, Usenet articles, emails, and much more.
-
-@menu
-* Link Format:: How links in Org are formatted.
-* Internal Links:: Links to other places in the current file.
-* Radio Targets:: Make targets trigger links in plain text.
-* External Links:: URL-like links to the world.
-* Handling Links:: Creating, inserting and following.
-* Using Links Outside Org:: Linking from my C source code?
-* Link Abbreviations:: Shortcuts for writing complex links.
-* Search Options:: Linking to a specific location.
-* Custom Searches:: When the default search is not enough.
-@end menu
-
-@node Link Format
-@section Link Format
-
-@cindex link format
-@cindex format, of links
-
-@cindex angle bracket links
-@cindex plain links
-Org recognizes plain URIs, possibly wrapped within angle
-brackets@footnote{Plain URIs are recognized only for a well-defined set of
-schemes. See @ref{External Links}. Unlike URI syntax, they cannot contain
-parenthesis or white spaces, either. URIs within angle brackets have
-no such limitation.}, and activate them as clickable links.
-
-@cindex bracket links
-The general link format, however, looks like this:
-
-@example
-[[LINK][DESCRIPTION]]
-@end example
-
-
-@noindent
-or alternatively
-
-@example
-[[LINK]]
-@end example
-
-
-@cindex escape syntax, for links
-@cindex backslashes, in links
-Some @samp{\}, @samp{[} and @samp{]} characters in the @var{LINK} part need to
-be ``escaped'', i.e., preceded by another @samp{\} character. More
-specifically, the following characters, and only them, must be
-escaped:
-
-@enumerate
-@item
-all @samp{[} and @samp{]} characters,
-@item
-every @samp{\} character preceding either @samp{]} or @samp{[},
-@item
-every @samp{\} character at the end of the link.
-@end enumerate
-
-@findex org-link-escape
-Functions inserting links (see @ref{Handling Links}) properly escape
-ambiguous characters. You only need to bother about the rules above
-when inserting directly, or yanking, a URI within square brackets.
-When in doubt, you may use the function @code{org-link-escape}, which turns
-a link string into its escaped form.
-
-Once a link in the buffer is complete, with all brackets present, Org
-changes the display so that @samp{DESCRIPTION} is displayed instead of
-@samp{[[LINK][DESCRIPTION]]} and @samp{LINK} is displayed instead of @samp{[[LINK]]}.
-Links are highlighted in the @code{org-link} face, which, by default, is an
-underlined face.
-
-You can directly edit the visible part of a link. This can be either
-the @var{LINK} part, if there is no description, or the
-@var{DESCRIPTION} part otherwise. To also edit the invisible
-@var{LINK} part, use @kbd{C-c C-l} with point on the link
-(see @ref{Handling Links}).
-
-If you place point at the beginning or just behind the end of the
-displayed text and press @kbd{@key{BS}}, you remove
-the---invisible---bracket at that location@footnote{More accurately, the precise behavior depends on how point
-arrived there---see @ref{Invisible Text,Invisible Text,,elisp,}.}. This makes the link
-incomplete and the internals are again displayed as plain text.
-Inserting the missing bracket hides the link internals again. To show
-the internal structure of all links, use the menu: Org @arrow{} Hyperlinks @arrow{}
-Literal links.
-
-@node Internal Links
-@section Internal Links
-
-@cindex internal links
-@cindex links, internal
-
-A link that does not look like a URL---i.e., does not start with
-a known scheme or a file name---refers to the current document. You
-can follow it with @kbd{C-c C-o} when point is on the link, or
-with a mouse click (see @ref{Handling Links}).
-
-@cindex @samp{CUSTOM_ID}, property
-Org provides several refinements to internal navigation within
-a document. Most notably, a construct like @samp{[[#my-custom-id]]}
-specifically targets the entry with the @samp{CUSTOM_ID} property set to
-@samp{my-custom-id}. Also, an internal link looking like @samp{[[*Some
-section]]} points to a headline with the name @samp{Some section}@footnote{To insert a link targeting a headline, in-buffer completion
-can be used. Just type a star followed by a few optional letters into
-the buffer and press @kbd{M-@key{TAB}}. All headlines in the current
-buffer are offered as completions.}.
-
-@cindex targets, for links
-When the link does not belong to any of the cases above, Org looks for
-a @emph{dedicated target}: the same string in double angular brackets, like
-@samp{<<My Target>>}.
-
-@cindex @samp{NAME}, keyword
-If no dedicated target exists, the link tries to match the exact name
-of an element within the buffer. Naming is done, unsurprisingly, with
-the @samp{NAME} keyword, which has to be put in the line before the element
-it refers to, as in the following example
-
-@example
-#+NAME: My Target
-| a | table |
-|----+------------|
-| of | four cells |
-@end example
-
-@vindex org-link-search-must-match-exact-headline
-Ultimately, if none of the above succeeds, Org searches for a headline
-that is exactly the link text but may also include a TODO keyword and
-tags, or initiates a plain text search, according to the value of
-@code{org-link-search-must-match-exact-headline}.
-
-Note that you must make sure custom IDs, dedicated targets, and names
-are unique throughout the document. Org provides a linter to assist
-you in the process, if needed. See @ref{Org Syntax}.
-
-During export, internal links are used to mark objects and assign them
-a number. Marked objects are then referenced by links pointing to
-them. In particular, links without a description appear as the number
-assigned to the marked object@footnote{When targeting a @samp{NAME} keyword, the @samp{CAPTION} keyword is
-mandatory in order to get proper numbering (see @ref{Captions}).}. In the following excerpt from
-an Org buffer
-
-@example
-1. one item
-2. <<target>>another item
-Here we refer to item [[target]].
-@end example
-
-@noindent
-The last sentence will appear as @samp{Here we refer to item 2} when
-exported.
-
-In non-Org files, the search looks for the words in the link text. In
-the above example the search would be for @samp{target}.
-
-Following a link pushes a mark onto Org's own mark ring. You can
-return to the previous position with @kbd{C-c &}. Using this
-command several times in direct succession goes back to positions
-recorded earlier.
-
-@node Radio Targets
-@section Radio Targets
-
-@cindex radio targets
-@cindex targets, radio
-@cindex links, radio targets
-
-Org can automatically turn any occurrences of certain target names in
-normal text into a link. So without explicitly creating a link, the
-text connects to the target radioing its position. Radio targets are
-enclosed by triple angular brackets. For example, a target @samp{<<<My
-Target>>>} causes each occurrence of @samp{my target} in normal text to
-become activated as a link. The Org file is scanned automatically 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
-point on or at a target.
-
-@node External Links
-@section External Links
-
-@cindex links, external
-@cindex external links
-@cindex attachment links
-@cindex BBDB links
-@cindex Elisp links
-@cindex file links
-@cindex Gnus links
-@cindex Help links
-@cindex IRC links
-@cindex Info links
-@cindex MH-E links
-@cindex Rmail links
-@cindex shell links
-@cindex URL links
-@cindex Usenet links
-
-Org supports links to files, websites, Usenet and email messages, BBDB
-database entries and links to both IRC conversations and their logs.
-External links are URL-like locators. They start with a short
-identifying string followed by a colon. There can be no space after
-the colon.
-
-Here is the full set of built-in link types:
-
-@table @asis
-@item @samp{file}
-File links. File name may be remote, absolute, or relative.
-
-Additionally, you can specify a line number, or a text search.
-In Org files, you may link to a headline name, a custom ID, or a
-code reference instead.
-
-As a special case, ``file'' prefix may be omitted if the file name
-is complete, e.g., it starts with @samp{./}, or @samp{/}.
-
-@item @samp{attachment}
-Same as file links but for files and folders attached to the current
-node (see @ref{Attachments}). Attachment links are intended to behave
-exactly as file links but for files relative to the attachment
-directory.
-
-@item @samp{bbdb}
-Link to a BBDB record, with possible regexp completion.
-
-@item @samp{docview}
-Link to a document opened with DocView mode. You may specify a page
-number.
-
-@item @samp{doi}
-Link to an electronic resource, through its handle.
-
-@item @samp{elisp}
-Execute an Elisp command upon activation.
-
-@item @samp{gnus}, @samp{rmail}, @samp{mhe}
-Link to messages or folders from a given Emacs' MUA@.
-
-@item @samp{help}
-Display documentation of a symbol in @samp{*Help*} buffer.
-
-@item @samp{http}, @samp{https}
-Web links.
-
-@item @samp{id}
-Link to a specific headline by its ID property, in an Org file.
-
-@item @samp{info}
-Link to an Info manual, or to a specific node.
-
-@item @samp{irc}
-Link to an IRC channel.
-
-@item @samp{mailto}
-Link to message composition.
-
-@item @samp{news}
-Usenet links.
-
-@item @samp{shell}
-Execute a shell command upon activation.
-@end table
-
-The following table illustrates the link types above, along with their
-options:
-
-@multitable {aaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@headitem Link Type
-@tab Example
-@item http
-@tab @samp{http://staff.science.uva.nl/c.dominik/}
-@item https
-@tab @samp{https://orgmode.org/}
-@item doi
-@tab @samp{doi:10.1000/182}
-@item file
-@tab @samp{file:/home/dominik/images/jupiter.jpg}
-@item
-@tab @samp{/home/dominik/images/jupiter.jpg} (same as above)
-@item
-@tab @samp{file:papers/last.pdf}
-@item
-@tab @samp{./papers/last.pdf} (same as above)
-@item
-@tab @samp{file:/ssh:me@@some.where:papers/last.pdf} (remote)
-@item
-@tab @samp{/ssh:me@@some.where:papers/last.pdf} (same as above)
-@item
-@tab @samp{file:sometextfile::NNN} (jump to line number)
-@item
-@tab @samp{file:projects.org}
-@item
-@tab @samp{file:projects.org::some words} (text search)@footnote{The actual behavior of the search depends on the value of the
-variable @code{org-link-search-must-match-exact-headline}. If its value is
-@code{nil}, then a fuzzy text search is done. If it is @code{t}, then only the
-exact headline is matched, ignoring spaces and statistic cookies. If
-the value is @code{query-to-create}, then an exact headline is searched; if
-it is not found, then the user is queried to create it.}
-@item
-@tab @samp{file:projects.org::*task title} (headline search)
-@item
-@tab @samp{file:projects.org::#custom-id} (headline search)
-@item attachment
-@tab @samp{attachment:projects.org}
-@item
-@tab @samp{attachment:projects.org::some words} (text search)
-@item docview
-@tab @samp{docview:papers/last.pdf::NNN}
-@item id
-@tab @samp{id:B7423F4D-2E8A-471B-8810-C40F074717E9}
-@item news
-@tab @samp{news:comp.emacs}
-@item mailto
-@tab @samp{mailto:adent@@galaxy.net}
-@item mhe
-@tab @samp{mhe:folder} (folder link)
-@item
-@tab @samp{mhe:folder#id} (message link)
-@item rmail
-@tab @samp{rmail:folder} (folder link)
-@item
-@tab @samp{rmail:folder#id} (message link)
-@item gnus
-@tab @samp{gnus:group} (group link)
-@item
-@tab @samp{gnus:group#id} (article link)
-@item bbdb
-@tab @samp{bbdb:R.*Stallman} (record with regexp)
-@item irc
-@tab @samp{irc:/irc.com/#emacs/bob}
-@item help
-@tab @samp{help:org-store-link}
-@item info
-@tab @samp{info:org#External links}
-@item shell
-@tab @samp{shell:ls *.org}
-@item elisp
-@tab @samp{elisp:(find-file "Elisp.org")} (Elisp form to evaluate)
-@item
-@tab @samp{elisp:org-agenda} (interactive Elisp command)
-@end multitable
-
-@cindex VM links
-@cindex Wanderlust links
-On top of these built-in link types, additional ones are available
-through the @samp{contrib/} directory (see @ref{Installation}). For example,
-these links to VM or Wanderlust messages are available when you load
-the corresponding libraries from the @samp{contrib/} directory:
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{vm:folder}
-@tab VM folder link
-@item @samp{vm:folder#id}
-@tab VM message link
-@item @samp{vm://myself@@some.where.org/folder#id}
-@tab VM on remote machine
-@item @samp{vm-imap:account:folder}
-@tab VM IMAP folder link
-@item @samp{vm-imap:account:folder#id}
-@tab VM IMAP message link
-@item @samp{wl:folder}
-@tab Wanderlust folder link
-@item @samp{wl:folder#id}
-@tab Wanderlust message link
-@end multitable
-
-For information on customizing Org to add new link types, see @ref{Adding Hyperlink Types}.
-
-A link should be enclosed in double brackets and may contain
-descriptive text to be displayed instead of the URL (see @ref{Link Format}), for example:
-
-@example
-[[https://www.gnu.org/software/emacs/][GNU Emacs]]
-@end example
-
-
-If the description is a file name or URL that points to an image, HTML
-export (see @ref{HTML Export}) inlines the image as a clickable button. If
-there is no description at all and the link points to an image, that
-image is inlined into the exported HTML file.
-
-@cindex square brackets, around links
-@cindex angular brackets, around links
-@cindex plain text external links
-Org also recognizes external links amid normal text and activates them
-as links. If spaces must be part of the link (for example in
-@samp{bbdb:R.*Stallman}), or if you need to remove ambiguities about the
-end of the link, enclose the link in square or angular brackets.
-
-@node Handling Links
-@section Handling Links
-
-@cindex links, handling
-
-Org provides methods to create a link in the correct syntax, to insert
-it into an Org file, and to follow the link.
-
-@findex org-store-link
-@cindex storing links
-The main function is @code{org-store-link}, called with @kbd{M-x org-store-link}. Because of its importance, we suggest to bind it
-to a widely available key (see @ref{Activation}). It stores a link to the
-current location. The link is stored for later insertion into an Org
-buffer---see below. The kind of link that is created depends on the
-current buffer:
-
-@table @asis
-@item @emph{Org mode buffers}
-For Org files, if there is a @samp{<<target>>} at point, the link points
-to the target. Otherwise it points to the current headline, which
-is also the description@footnote{If the headline contains a timestamp, it is removed from the
-link, which results in a wrong link---you should avoid putting
-a timestamp in the headline.}.
-
-@vindex org-id-link-to-org-use-id
-@cindex @samp{CUSTOM_ID}, property
-@cindex @samp{ID}, property
-If the headline has a @samp{CUSTOM_ID} property, store a link to this
-custom ID@. In addition or alternatively, depending on the value of
-@code{org-id-link-to-org-use-id}, create and/or use a globally unique
-@samp{ID} property for the link@footnote{The Org Id library must first be loaded, either through
-@code{org-customize}, by enabling @code{id} in @code{org-modules}, or by adding
-@samp{(require 'org-id)} in your Emacs init file.}. So using this command in Org
-buffers potentially creates two links: a human-readable link 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.
-
-@item @emph{Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus}
-@vindex org-link-email-description-format
-Pretty much all Emacs mail clients are supported. The link points
-to the current article, or, in some Gnus buffers, to the group. The
-description is constructed according to the variable
-@code{org-link-email-description-format}. By default, it refers to the
-addressee and the subject.
-
-@item @emph{Web browsers: W3, W3M and EWW}
-Here the link is the current URL, with the page title as the
-description.
-
-@item @emph{Contacts: BBDB}
-Links created in a BBDB buffer point to the current entry.
-
-@item @emph{Chat: IRC}
-@vindex org-irc-links-to-logs
-For IRC links, if the variable @code{org-irc-link-to-logs} is non-@code{nil},
-create a @samp{file} style link to the relevant point in the logs for the
-current conversation. Otherwise store an @samp{irc} style link to the
-user/channel/server under the point.
-
-@item @emph{Other files}
-For any other file, the link points to the file, with a search
-string (see @ref{Search Options}) pointing to the contents
-of the current line. If there is an active region, the selected
-words form the basis of the search string. You can write custom Lisp
-functions to select the search string and perform the search for
-particular file types (see @ref{Custom Searches}).
-
-You can also define dedicated links to other files. See @ref{Adding Hyperlink Types}.
-
-@item @emph{Agenda view}
-When point is in an agenda view, the created link points to the
-entry referenced by the current line.
-@end table
-
-From an Org buffer, the following commands create, navigate or, more
-generally, act on links.
-
-@table @asis
-@item @kbd{C-c C-l} (@code{org-insert-link})
-@kindex C-c C-l
-@findex org-insert-link
-@cindex link completion
-@cindex completion, of links
-@cindex inserting links
-@vindex org-link-keep-stored-after-insertion
-Insert a link@footnote{Note that you do not 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 descriptive text.}. This prompts for a link to be inserted into
-the buffer. You can just type a link, using text for an internal
-link, or one of the link type prefixes mentioned in the examples
-above. The link is inserted into the buffer, along with
-a descriptive text@footnote{After insertion of a stored link, the link will be removed
-from the list of stored links. To keep it in the list for later use,
-use a triple @kbd{C-u} prefix argument to @kbd{C-c C-l}, or
-configure the option @code{org-link-keep-stored-after-insertion}.}. If some text was selected at this time,
-it becomes the default description.
-
-@table @asis
-@item @emph{Inserting stored links}
-All links stored during the current session are part of the
-history for this prompt, so you can access them with @kbd{@key{UP}}
-and @kbd{@key{DOWN}} (or @kbd{M-p}, @kbd{M-n}).
-
-@item @emph{Completion support}
-Completion with @kbd{@key{TAB}} helps you to insert valid link
-prefixes like @samp{http} or @samp{ftp}, including the prefixes defined
-through link abbreviations (see @ref{Link Abbreviations}). If you
-press @kbd{@key{RET}} after inserting only the prefix, Org offers
-specific completion support for some link types@footnote{This works if a function has been defined in the @code{:complete}
-property of a link in @code{org-link-parameters}.}. For
-example, if you type @kbd{f i l e @key{RET}}---alternative access:
-@kbd{C-u C-c C-l}, see below---Org offers file name
-completion, and after @kbd{b b d b @key{RET}} you can complete
-contact names.
-@end table
-
-@item @kbd{C-u C-c C-l}
-@cindex file name completion
-@cindex completion, of file names
-@kindex C-u C-c C-l
-When @kbd{C-c C-l} is called with a @kbd{C-u} prefix
-argument, insert a link to a file. You may use file name completion
-to select the name of the file. The path to the file is inserted
-relative to the directory of the current Org file, if the linked
-file is in the current directory or in a sub-directory of it, or if
-the path is written relative to the current directory using @samp{../}.
-Otherwise an absolute path is used, if possible with @samp{~/} for your
-home directory. You can force an absolute path with two
-@kbd{C-u} prefixes.
-
-@item @kbd{C-c C-l} (with point on existing link)
-@cindex following links
-When point is on an existing link, @kbd{C-c C-l} allows you to
-edit the link and description parts of the link.
-
-@item @kbd{C-c C-o} (@code{org-open-at-point})
-@kindex C-c C-o
-@findex org-open-at-point
-@vindex org-file-apps
-Open link at point. This launches a web browser for URL (using
-@code{browse-url-at-point}), run VM/MH-E/Wanderlust/Rmail/Gnus/BBDB for
-the corresponding links, and execute the command in a shell link.
-When point is on an internal link, this command runs the
-corresponding search. When point is on the tags part of a headline,
-it creates the corresponding tags view (see @ref{Matching tags and properties}). If point is on a timestamp, it compiles the agenda for
-that date. Furthermore, it visits text and remote files in @samp{file}
-links with Emacs and select a suitable application for local
-non-text files. Classification of files is based on file extension
-only. See option @code{org-file-apps}. If you want to override the
-default application and visit the file with Emacs, use
-a @kbd{C-u} prefix. If you want to avoid opening in Emacs, use
-a @kbd{C-u C-u} prefix.
-
-@vindex org-link-frame-setup
-If point is on a headline, but not on a link, offer all links in the
-headline and entry text. If you want to setup the frame
-configuration for following links, customize @code{org-link-frame-setup}.
-
-@item @kbd{@key{RET}}
-@vindex org-return-follows-link
-@kindex RET
-When @code{org-return-follows-link} is set, @kbd{@key{RET}} also follows
-the link at point.
-
-@item @kbd{mouse-2} or @kbd{mouse-1}
-@kindex mouse-2
-@kindex mouse-1
-On links, @kbd{mouse-1} and @kbd{mouse-2} opens the link
-just as @kbd{C-c C-o} does.
-
-@item @kbd{mouse-3}
-@vindex org-link-use-indirect-buffer-for-internals
-@kindex mouse-3
-Like @kbd{mouse-2}, but force file links to be opened with
-Emacs, and internal links to be displayed in another window@footnote{See the variable @code{org-link-use-indirect-buffer-for-internals}.}.
-
-@item @kbd{C-c %} (@code{org-mark-ring-push})
-@kindex C-c %
-@findex org-mark-ring-push
-@cindex mark ring
-Push the current position onto the Org mark ring, to be able to
-return easily. Commands following an internal link do this
-automatically.
-
-@item @kbd{C-c &} (@code{org-mark-ring-goto})
-@kindex C-c &
-@findex org-mark-ring-goto
-@cindex links, returning to
-Jump back to a recorded position. A position is recorded by the
-commands following internal links, and by @kbd{C-c %}. Using
-this command several times in direct succession moves through a ring
-of previously recorded positions.
-
-@item @kbd{C-c C-x C-n} (@code{org-next-link})
-@itemx @kbd{C-c C-x C-p} (@code{org-previous-link})
-@kindex C-c C-x C-p
-@findex org-previous-link
-@kindex C-c C-x C-n
-@findex org-next-link
-@cindex links, finding next/previous
-Move forward/backward to the next link in the buffer. At the limit
-of the buffer, the search fails once, and then wraps around. The
-key bindings for this are really too long; you might want to bind
-this also to @kbd{M-n} and @kbd{M-p}.
-
-@lisp
-(with-eval-after-load 'org
- (define-key org-mode-map (kbd "M-n") 'org-next-link)
- (define-key org-mode-map (kbd "M-p") 'org-previous-link))
-@end lisp
-@end table
-
-@node Using Links Outside Org
-@section Using Links Outside Org
-
-@findex org-insert-link-global
-@findex org-open-at-point-global
-You can insert and follow links that have Org syntax not only in Org,
-but in any Emacs buffer. For this, Org provides two functions:
-@code{org-insert-link-global} and @code{org-open-at-point-global}.
-
-You might want to bind them to globally available keys. See
-@ref{Activation} for some advice.
-
-@node Link Abbreviations
-@section Link Abbreviations
-
-@cindex link abbreviations
-@cindex abbreviation, links
-
-Long URL can be cumbersome to type, and often many similar links are
-needed in a document. For this you can use link abbreviations. An
-abbreviated link looks like this
-
-@example
-[[linkword:tag][description]]
-@end example
-
-
-@noindent
-@vindex org-link-abbrev-alist
-where the tag is optional. The @emph{linkword} must be a word, starting
-with a letter, followed by letters, numbers, @samp{-}, and @samp{_}.
-Abbreviations are resolved according to the information in the
-variable @code{org-link-abbrev-alist} that relates the linkwords to
-replacement text. Here is an example:
-
-@lisp
-(setq org-link-abbrev-alist
- '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=")
- ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h")
- ("duckduckgo" . "https://duckduckgo.com/?q=%s")
- ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1")
- ("ads" . "https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"")))
-@end lisp
-
-If the replacement text contains the string @samp{%s}, it is replaced with
-the tag. Using @samp{%h} instead of @samp{%s} percent-encodes the tag (see the
-example above, where we need to encode the URL parameter). Using
-@samp{%(my-function)} passes the tag to a custom Lisp function, and replace
-it by the resulting string.
-
-If the replacement text do not contain any specifier, it is simply
-appended to the string in order to create the link.
-
-Instead of a string, you may also specify a Lisp function to create
-the link. Such a function will be called with the tag as the only
-argument.
-
-With the above setting, you could link to a specific bug with
-@samp{[[bugzilla:129]]}, search the web for @samp{OrgMode} with @samp{[[duckduckgo:OrgMode]]},
-show the map location of the Free Software Foundation @samp{[[gmap:51
-Franklin Street, Boston]]} or of Carsten office @samp{[[omap:Science Park 904,
-Amsterdam, The Netherlands]]} and find out what the Org author is doing
-besides Emacs hacking with @samp{[[ads:Dominik,C]]}.
-
-If you need special abbreviations just for a single Org buffer, you
-can define them in the file with
-
-@cindex @samp{LINK}, keyword
-@example
-#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
-#+LINK: duckduckgo https://duckduckgo.com/?q=%s
-@end example
-
-In-buffer completion (see @ref{Completion}) can be used after @samp{[} to
-complete link abbreviations. You may also define a Lisp 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 should return the full link with a prefix. You can set
-the link completion function like this:
-
-@lisp
-(org-link-set-parameter "type" :complete #'some-completion-function)
-@end lisp
-
-@node Search Options
-@section Search Options in File Links
-
-@cindex search option in file links
-@cindex file links, searching
-@cindex attachment links, searching
-
-File links can contain additional information to make Emacs jump to a
-particular location in the file when following a link. This can be a
-line number or a search option after a double colon@footnote{For backward compatibility, line numbers can also follow a
-single colon.}. For
-example, when the command @code{org-store-link} creates a link (see
-@ref{Handling Links}) to a file, it encodes the words in the current line
-as a search string that can be used to find this line back later when
-following the link with @kbd{C-c C-o}.
-
-Note that all search options apply for Attachment links in the same
-way that they apply for File links.
-
-Here is the syntax of the different ways to attach a search to a file
-link, together with explanations for each:
-
-@example
-[[file:~/code/main.c::255]]
-[[file:~/xx.org::My Target]]
-[[file:~/xx.org::*My Target]]
-[[file:~/xx.org::#my-custom-id]]
-[[file:~/xx.org::/regexp/]]
-[[attachment:main.c::255]]
-@end example
-
-@table @asis
-@item @samp{255}
-Jump to line 255.
-
-@item @samp{My Target}
-Search for a link target @samp{<<My Target>>}, or do a text search for
-@samp{my target}, similar to the search in internal links, see @ref{Internal Links}. In HTML export (see @ref{HTML Export}), such a file link becomes
-a HTML reference to the corresponding named anchor in the linked
-file.
-
-@item @samp{*My Target}
-In an Org file, restrict search to headlines.
-
-@item @samp{#my-custom-id}
-Link to a heading with a @samp{CUSTOM_ID} property
-
-@item @samp{/REGEXP/}
-Do a regular expression search for @var{REGEXP}. This uses the
-Emacs command @code{occur} to list all matches in a separate window. If
-the target file is in Org mode, @code{org-occur} is used to create
-a sparse tree with the matches.
-@end table
-
-As a degenerate case, a file link with an empty file name can be used
-to search the current file. For example, @samp{[[file:::find me]]} does
-a search for @samp{find me} in the current file, just as @samp{[[find me]]}
-would.
-
-@node Custom Searches
-@section Custom Searches
-
-@cindex custom search strings
-@cindex search strings, custom
-
-The default mechanism for creating search strings and for doing the
-actual search related to a file link may not work correctly in all
-cases. For example, Bib@TeX{} database files have many entries like
-@code{year="1993"} which would not result in good search strings, because
-the only unique identification for a Bib@TeX{} entry is the citation key.
-
-@vindex org-create-file-search-functions
-@vindex org-execute-file-search-functions
-If you come across such a problem, you can write custom functions to
-set the right search string for a particular file type, and to do the
-search for the string in the file. Using @code{add-hook}, these functions
-need to be added to the hook variables
-@code{org-create-file-search-functions} and
-@code{org-execute-file-search-functions}. See the docstring for these
-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 @samp{ol-bibtex.el}.
-
-@node TODO Items
-@chapter TODO Items
-
-@cindex TODO items
-
-Org mode does not maintain TODO lists as separate documents@footnote{Of course, you can make a document that contains only long
-lists of TODO items, but this is not required.}.
-Instead, TODO items are an integral part of the notes file, because
-TODO items usually come up while taking notes! With Org mode, simply
-mark any entry in a tree as being a TODO item. In this way,
-information is not duplicated, and the entire context from which the
-TODO item emerged is always present.
-
-Of course, this technique for managing TODO items scatters them
-throughout your notes file. Org mode compensates for this by
-providing methods to give you an overview of all the things that you
-have to do.
-
-@menu
-* TODO Basics:: Marking and displaying TODO entries.
-* TODO Extensions:: Workflow and assignments.
-* Progress Logging:: Dates and notes for progress.
-* Priorities:: Some things are more important than others.
-* Breaking Down Tasks:: Splitting a task into manageable pieces.
-* Checkboxes:: Tick-off lists.
-@end menu
-
-@node TODO Basics
-@section Basic TODO Functionality
-
-Any headline becomes a TODO item when it starts with the word @samp{TODO},
-for example:
-
-@example
-*** TODO Write letter to Sam Fortune
-@end example
-
-
-The most important commands to work with TODO entries are:
-
-@table @asis
-@item @kbd{C-c C-t} (@code{org-todo})
-@kindex C-c C-t
-@cindex cycling, of TODO states
-Rotate the TODO state of the current item among
-
-@example
-,-> (unmarked) -> TODO -> DONE --.
-'--------------------------------'
-@end example
-
-If TODO keywords have fast access keys (see @ref{Fast access to TODO states}), prompt 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 state changing can also be done ``remotely'' from the agenda
-buffer with the @kbd{t} command key (see @ref{Agenda Commands}).
-
-@item @kbd{S-@key{RIGHT}} @kbd{S-@key{LEFT}}
-@kindex S-RIGHT
-@kindex S-LEFT
-@vindex org-treat-S-cursor-todo-selection-as-state-change
-Select the following/preceding TODO state, similar to cycling.
-Useful mostly if more than two TODO states are possible (see
-@ref{TODO Extensions}). See also @ref{Conflicts}, for a discussion of the interaction with
-shift-selection. See also the variable
-@code{org-treat-S-cursor-todo-selection-as-state-change}.
-
-@item @kbd{C-c / t} (@code{org-show-todo-tree})
-@kindex C-c / t
-@cindex sparse tree, for TODO
-@vindex org-todo-keywords
-@findex org-show-todo-tree
-View TODO items in a @emph{sparse tree} (see @ref{Sparse Trees}). Folds the
-entire buffer, but shows all TODO items---with not-DONE state---and
-the headings hierarchy above them. With a prefix argument, or by
-using @kbd{C-c / T}, search for a specific TODO@. You are
-prompted for the keyword, and you can also give a list of keywords
-like @samp{KWD1|KWD2|...} to list entries that match any one of these
-keywords. With a numeric prefix argument N, show the tree for the
-Nth keyword in the variable @code{org-todo-keywords}. With two prefix
-arguments, find all TODO states, both un-done and done.
-
-@item @kbd{M-x org-agenda t} (@code{org-todo-list})
-@kindex t @r{(Agenda dispatcher)}
-Show the global TODO list. Collects the TODO items (with not-DONE
-states) from all agenda files (see @ref{Agenda Views}) into a single
-buffer. The new buffer is in Org Agenda mode, which provides
-commands to examine and manipulate the TODO entries from the new
-buffer (see @ref{Agenda Commands}). See @ref{Global TODO list}, for more information.
-
-@item @kbd{S-M-@key{RET}} (@code{org-insert-todo-heading})
-@kindex S-M-RET
-@findex org-insert-todo-heading
-Insert a new TODO entry below the current one.
-@end table
-
-@vindex org-todo-state-tags-triggers
-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
-@section Extended Use of TODO Keywords
-
-@cindex extended TODO keywords
-
-@vindex org-todo-keywords
-By default, marked TODO entries have one of only two states: TODO and
-DONE@. Org mode allows you to classify TODO items in more complex ways
-with @emph{TODO keywords} (stored in @code{org-todo-keywords}). With special
-setup, the TODO keyword system can work differently in different
-files.
-
-Note that @emph{tags} are another way to classify headlines in general and
-TODO items in particular (see @ref{Tags}).
-
-@menu
-* Workflow states:: From TODO to DONE in steps.
-* TODO types:: I do this, Fred does the rest.
-* Multiple sets in one file:: Mixing it all, still finding your way.
-* Fast access to TODO states:: Single letter selection of state.
-* Per-file keywords:: Different files, different requirements.
-* Faces for TODO keywords:: Highlighting states.
-* TODO dependencies:: When one task needs to wait for others.
-@end menu
-
-@node Workflow states
-@subsection TODO keywords as workflow states
-
-@cindex TODO workflow
-@cindex workflow states as TODO keywords
-
-You can use TODO keywords to indicate different, possibly @emph{sequential}
-states in the process of working on an item, for example@footnote{Changing the variable @code{org-todo-keywords} only becomes
-effective after restarting Org mode in a buffer.}:
-
-@lisp
-(setq org-todo-keywords
- '((sequence "TODO" "FEEDBACK" "VERIFY" "|" "DONE" "DELEGATED")))
-@end lisp
-
-The vertical bar separates the TODO keywords (states that @emph{need
-action}) from the DONE states (which need @emph{no further action}). If
-you do not provide the separator bar, the last state is used as the
-DONE state.
-
-@cindex completion, of TODO keywords
-With this setup, the command @kbd{C-c C-t} cycles an entry from
-@samp{TODO} to @samp{FEEDBACK}, then to @samp{VERIFY}, and finally to @samp{DONE} and
-@samp{DELEGATED}. You may also use a numeric prefix argument to quickly
-select a specific state. For example @kbd{C-3 C-c C-t} changes
-the state immediately to @samp{VERIFY}. Or you can use @kbd{S-@key{RIGHT}}
-and @kbd{S-@key{LEFT}} to go forward and backward through the states.
-If you define many keywords, you can use in-buffer completion (see
-@ref{Completion}) or a special one-key selection scheme (see @ref{Fast access to TODO states}) to insert these words into the buffer.
-Changing a TODO state can be logged with a timestamp, see @ref{Tracking TODO state changes}, for more information.
-
-@node TODO types
-@subsection TODO keywords as types
-
-@cindex TODO types
-@cindex names as TODO keywords
-@cindex types as TODO keywords
-
-The second possibility is to use TODO keywords to indicate different
-@emph{types} of action items. For example, you might want to indicate that
-items are for ``work'' or ``home''. Or, when you work with several people
-on a single project, you might want to assign action items directly to
-persons, by using their names as TODO keywords. This type of
-functionality is actually much better served by using tags (see
-@ref{Tags}), so the TODO implementation is kept just for backward
-compatibility.
-
-Using TODO types, it would be set up like this:
-
-@lisp
-(setq org-todo-keywords '((type "Fred" "Sara" "Lucy" "|" "DONE")))
-@end lisp
-
-In this case, different keywords do not indicate states, 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 agenda
-buffer.}. When used several times in succession, it still
-cycles 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
-@samp{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 M-x org-agenda t}.
-
-@node Multiple sets in one file
-@subsection Multiple keyword sets in one file
-
-@cindex TODO keyword sets
-
-Sometimes you may want to use different sets of TODO keywords in
-parallel. For example, you may want to have the basic TODO/DONE, but
-also a workflow for bug fixing, and a separate state indicating that
-an item has been canceled---so it is not DONE, but also does not
-require action. Your setup would then look like this:
-
-@lisp
-(setq org-todo-keywords
- '((sequence "TODO" "|" "DONE")
- (sequence "REPORT" "BUG" "KNOWNCAUSE" "|" "FIXED")
- (sequence "|" "CANCELED")))
-@end lisp
-
-The keywords should all be different, this helps Org mode keep track
-of which subsequence should be used for a given entry. In this setup,
-@kbd{C-c C-t} only operates within a sub-sequence, so it switches
-from @samp{DONE} to (nothing) to @samp{TODO}, and from @samp{FIXED} to (nothing) to
-@samp{REPORT}. Therefore you need a mechanism to initially select the
-correct sequence. In addition to typing a keyword or using completion
-(see @ref{Completion}), you may also apply the following commands:
-
-@table @asis
-@item @kbd{C-u C-u C-c C-t}
-@itemx @kbd{C-S-@key{RIGHT}}
-@itemx @kbd{C-S-@key{LEFT}}
-@kindex C-S-RIGHT
-@kindex C-S-LEFT
-@kindex C-u C-u C-c C-t
-These keys jump from one TODO sub-sequence to the next. In the
-above example, @kbd{C-u C-u C-c C-t} or @kbd{C-S-@key{RIGHT}}
-would jump from @samp{TODO} or @samp{DONE} to @samp{REPORT}, and any of the words
-in the second row to @samp{CANCELED}. Note that the @kbd{C-S-} key
-binding conflict with shift-selection (see @ref{Conflicts}).
-
-@item @kbd{S-@key{RIGHT}}
-@itemx @kbd{S-@key{LEFT}}
-@kindex S-RIGHT
-@kindex S-LEFT
-@kbd{S-@key{LEFT}} and @kbd{S-@key{RIGHT}} walk through @emph{all} keywords
-from all sub-sequences, so for example @kbd{S-@key{RIGHT}} would
-switch from @samp{DONE} to @samp{REPORT} in the example above. For
-a discussion of the interaction with shift-selection, see @ref{Conflicts}.
-@end table
-
-@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 instead of cycling through the states, you can set up keys for
-single-letter access to the states. This is done by adding the
-selection character after each keyword, in parentheses@footnote{All characters are allowed except @samp{@@}, @samp{^} and @samp{!}, which have
-a special meaning here.}. For
-example:
-
-@lisp
-(setq org-todo-keywords
- '((sequence "TODO(t)" "|" "DONE(d)")
- (sequence "REPORT(r)" "BUG(b)" "KNOWNCAUSE(k)" "|" "FIXED(f)")
- (sequence "|" "CANCELED(c)")))
-@end lisp
-
-@vindex org-fast-tag-selection-include-todo
-If you then press @kbd{C-c C-t} followed by the selection key,
-the entry is switched to this state. @kbd{@key{SPC}} can be used to
-remove any TODO keyword from an entry@footnote{Check also the variable @code{org-fast-tag-selection-include-todo},
-it allows you to change the TODO state through the tags interface (see
-@ref{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
-@subsection Setting up keywords for individual files
-
-@cindex keyword options
-@cindex per-file keywords
-@cindex @samp{TODO}, keyword
-@cindex @samp{TYP_TODO}, keyword
-@cindex @samp{SEQ_TODO}, keyword
-
-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:
-
-@example
-#+TODO: TODO FEEDBACK VERIFY | DONE CANCELED
-@end example
-
-
-You may also write @samp{#+SEQ_TODO} to be explicit about the
-interpretation, but it means the same as @samp{#+TODO}, or
-
-@example
-#+TYP_TODO: Fred Sara Lucy Mike | DONE
-@end example
-
-
-A setup for using several sets in parallel would be:
-
-@example
-#+TODO: TODO | DONE
-#+TODO: REPORT BUG KNOWNCAUSE | FIXED
-#+TODO: | CANCELED
-@end example
-
-@cindex completion, of option keywords
-@kindex M-TAB
-To make sure you are using the correct keyword, type @samp{#+} into the
-buffer and then use @kbd{M-@key{TAB}} to complete it (see @ref{Completion}).
-
-@cindex DONE, final TODO keyword
-Remember that the keywords after the vertical bar---or the last
-keyword if no bar is there---must always mean that the item is DONE,
-although you may use a different word. After changing one of these
-lines, use @kbd{C-c C-c} with point still in the line to make the
-changes known to Org mode@footnote{Org mode parses these lines only when Org mode is activated
-after visiting a file. @kbd{C-c C-c} with point in a line
-starting with @samp{#+} is simply restarting Org mode for the current
-buffer.}.
-
-@node Faces for TODO keywords
-@subsection Faces for TODO keywords
-
-@cindex faces, for TODO keywords
-
-@vindex org-todo, face
-@vindex org-done, face
-@vindex org-todo-keyword-faces
-Org mode highlights TODO keywords with special faces: @code{org-todo} for
-keywords indicating that an item still has to be acted upon, and
-@code{org-done} for keywords indicating that an item is finished. If you
-are using more than two different states, you might want to use
-special faces for some of them. This can be done using the variable
-@code{org-todo-keyword-faces}. For example:
-
-@lisp
-(setq org-todo-keyword-faces
- '(("TODO" . org-warning) ("STARTED" . "yellow")
- ("CANCELED" . (:foreground "blue" :weight bold))))
-@end lisp
-
-@vindex org-faces-easy-properties
-While using a list with face properties as shown for @samp{CANCELED}
-@emph{should} work, this does not always seem to be the case. If
-necessary, define a special face and use that. A string is
-interpreted as a color. The variable @code{org-faces-easy-properties}
-determines if that color is interpreted as a foreground or
-a background color.
-
-@node TODO dependencies
-@subsection TODO dependencies
-
-@cindex TODO dependencies
-@cindex dependencies, of TODO states
-
-@vindex org-enforce-todo-dependencies
-@cindex @samp{ORDERED}, property
-The structure of Org files---hierarchy and lists---makes it easy to
-define TODO dependencies. Usually, a parent TODO task should not be
-marked as done until all TODO subtasks, or children tasks, are marked
-as done. Sometimes there is a logical sequence to (sub)tasks, so that
-one subtask cannot be acted upon before all siblings above it have
-been marked as done. If you customize the variable
-@code{org-enforce-todo-dependencies}, Org blocks entries from changing
-state to DONE while they have TODO children that are not DONE@.
-Furthermore, if an entry has a property @samp{ORDERED}, each of its TODO
-children is blocked until all earlier siblings are marked as done.
-Here is an example:
-
-@example
-* TODO Blocked until (two) is done
-** DONE one
-** TODO two
-
-* Parent
-:PROPERTIES:
-:ORDERED: t
-:END:
-** TODO a
-** TODO b, needs to wait for (a)
-** TODO c, needs to wait for (a) and (b)
-@end example
-
-@cindex TODO dependencies, @samp{NOBLOCKING}
-@cindex @samp{NOBLOCKING}, property
-You can ensure an entry is never blocked by using the @samp{NOBLOCKING}
-property (see @ref{Properties and Columns}):
-
-@example
-* This entry is never blocked
-:PROPERTIES:
-:NOBLOCKING: t
-:END:
-@end example
-
-@table @asis
-@item @kbd{C-c C-x o} (@code{org-toggle-ordered-property})
-@kindex C-c C-x o
-@findex org-toggle-ordered-property
-@vindex org-track-ordered-property-with-tag
-Toggle the @samp{ORDERED} property of the current entry. A property is
-used for this behavior because this should be local to the current
-entry, not inherited from entries above like a tag (see @ref{Tags}).
-However, if you would like to @emph{track} the value of this property
-with a tag for better visibility, customize the variable
-@code{org-track-ordered-property-with-tag}.
-
-@item @kbd{C-u C-u C-u C-c C-t}
-@kindex C-u C-u C-u C-u C-c C-t
-Change TODO state, regardless of any state blocking.
-@end table
-
-@vindex org-agenda-dim-blocked-tasks
-If you set the variable @code{org-agenda-dim-blocked-tasks}, TODO entries
-that cannot be marked as done because of unmarked children are shown
-in a dimmed font or even made invisible in agenda views (see @ref{Agenda Views}).
-
-@cindex checkboxes and TODO dependencies
-@vindex org-enforce-todo-dependencies
-You can also block changes of TODO states by using checkboxes (see
-@ref{Checkboxes}). If you set the variable
-@code{org-enforce-todo-checkbox-dependencies}, an entry that has unchecked
-checkboxes is blocked from switching to DONE@.
-
-If you need more complex dependency structures, for example
-dependencies between entries in different trees or files, check out
-the contributed module @samp{org-depend.el}.
-
-@node Progress Logging
-@section Progress Logging
-
-@cindex progress logging
-@cindex logging, of progress
-
-To record a timestamp and a note when changing a TODO state, call the
-command @code{org-todo} with a prefix argument.
-
-@table @asis
-@item @kbd{C-u C-c C-t} (@code{org-todo})
-@kindex C-u C-c C-t
-Prompt for a note and record a the time of the TODO state change.
-The note is inserted as a list item below the headline, but can also
-be placed into a drawer, see @ref{Tracking TODO state changes}.
-@end table
-
-If you want to be more systematic, Org mode can automatically record a
-timestamp and optionally a note when you mark a TODO item as DONE, or
-even each time you change the state of a TODO item. This system is
-highly configurable, settings can be on a per-keyword basis and can be
-localized to a file or even a subtree. For information on how to
-clock working time for a task, see @ref{Clocking Work Time}.
-
-@menu
-* Closing items:: When was this entry marked as done?
-* Tracking TODO state changes:: When did the status change?
-* Tracking your habits:: How consistent have you been?
-@end menu
-
-@node Closing items
-@subsection Closing items
-
-The most basic automatic logging is to keep track of @emph{when} a certain
-TODO item was marked as done. This can be achieved with@footnote{The corresponding in-buffer setting is: @samp{#+STARTUP: logdone}.}
-
-@lisp
-(setq org-log-done 'time)
-@end lisp
-
-@vindex org-closed-keep-when-no-todo
-@noindent
-Then each time you turn an entry from a TODO (not-done) state into any
-of the DONE states, a line @samp{CLOSED: [timestamp]} is inserted just
-after the headline. If you turn the entry back into a TODO item
-through further state cycling, that line is removed again. If you
-turn the entry back to a non-TODO state (by pressing @kbd{C-c C-t @key{SPC}} for example), that line is also removed, unless you set
-@code{org-closed-keep-when-no-todo} to non-@code{nil}. If you want to record
-a note along with the timestamp, use@footnote{The corresponding in-buffer setting is: @samp{#+STARTUP:
-lognotedone}.}
-
-@lisp
-(setq org-log-done 'note)
-@end lisp
-
-@noindent
-You are then prompted for a note, and that note is stored below the
-entry with a @samp{Closing Note} heading.
-
-@node Tracking TODO state changes
-@subsection Tracking TODO state changes
-
-@cindex drawer, for state change recording
-
-@vindex org-log-states-order-reversed
-@vindex org-log-into-drawer
-@cindex @samp{LOG_INTO_DRAWER}, property
-You might want to automatically keep track of when a state change
-occurred and maybe take a note about this change. You can either
-record just a timestamp, or a time-stamped note. These records are
-inserted after the headline as an itemized list, newest first@footnote{See the variable @code{org-log-states-order-reversed}.}.
-When taking a lot of notes, you might want to get the notes out of the
-way into a drawer (see @ref{Drawers}). Customize the variable
-@code{org-log-into-drawer} to get this behavior---the recommended drawer
-for this is called @samp{LOGBOOK}@footnote{Note that the @samp{LOGBOOK} drawer is unfolded when pressing
-@kbd{@key{SPC}} in the agenda to show an entry---use @kbd{C-u @key{SPC}} to keep it folded here.}. You can also overrule the
-setting of this variable for a subtree by setting a @samp{LOG_INTO_DRAWER}
-property.
-
-Since it is normally too much to record a note for every state, Org
-mode expects configuration on a per-keyword basis for this. This is
-achieved by adding special markers @samp{!} (for a timestamp) or @samp{@@} (for
-a note with timestamp) in parentheses after each keyword. For
-example, with the setting
-
-@lisp
-(setq org-todo-keywords
- '((sequence "TODO(t)" "WAIT(w@@/!)" "|" "DONE(d!)" "CANCELED(c@@)")))
-@end lisp
-
-@noindent
-To record a timestamp without a note for TODO keywords configured with
-@samp{@@}, just type @kbd{C-c C-c} to enter a blank note when prompted.
-
-@vindex org-log-done
-You not only define global TODO keywords and fast access keys, but
-also request that a time is recorded when the entry is set to @samp{DONE},
-and that a note is recorded when switching to @samp{WAIT} or
-@samp{CANCELED}@footnote{It is possible that Org mode records two timestamps when you
-are using both @code{org-log-done} and state change logging. However, it
-never prompts for two notes: if you have configured both, the state
-change recording note takes precedence and cancel the closing note.}. The setting for @samp{WAIT} is even more special: the
-@samp{!} after the slash means that in addition to the note taken when
-entering the state, a timestamp should be recorded when @emph{leaving} the
-@samp{WAIT} state, if and only if the @emph{target} state does not configure
-logging for entering it. So it has no effect when switching from
-@samp{WAIT} to @samp{DONE}, because @samp{DONE} is configured to record a timestamp
-only. But when switching from @samp{WAIT} back to @samp{TODO}, the @samp{/!} in the
-@samp{WAIT} setting now triggers a timestamp even though @samp{TODO} has no
-logging configured.
-
-You can use the exact same syntax for setting logging preferences local
-to a buffer:
-
-@example
-#+TODO: TODO(t) WAIT(w@@/!) | DONE(d!) CANCELED(c@@)
-@end example
-
-
-@cindex @samp{LOGGING}, property
-In order to define logging settings that are local to a subtree or
-a single item, define a @samp{LOGGING} property in this entry. Any
-non-empty @samp{LOGGING} property resets all logging settings to @code{nil}.
-You may then turn on logging for this specific tree using @samp{STARTUP}
-keywords like @samp{lognotedone} or @samp{logrepeat}, as well as adding state
-specific settings like @samp{TODO(!)}. For example:
-
-@example
-* TODO Log each state with only a time
- :PROPERTIES:
- :LOGGING: TODO(!) WAIT(!) DONE(!) CANCELED(!)
- :END:
-* TODO Only log when switching to WAIT, and when repeating
- :PROPERTIES:
- :LOGGING: WAIT(@@) logrepeat
- :END:
-* TODO No logging at all
- :PROPERTIES:
- :LOGGING: nil
- :END:
-@end example
-
-@node Tracking your habits
-@subsection Tracking your habits
-
-@cindex habits
-@cindex @samp{STYLE}, property
-
-Org has the ability to track the consistency of a special category of
-TODO, called ``habits.'' To use habits, you have to enable the @code{habits}
-module by customizing the variable @code{org-modules}.
-
-A habit has the following properties:
-
-@enumerate
-@item
-The habit is a TODO item, with a TODO keyword representing an open
-state.
-
-@item
-The property @samp{STYLE} is set to the value @samp{habit} (see @ref{Properties and Columns}).
-
-@item
-The TODO has a scheduled date, usually with a @samp{.+} style repeat
-interval. A @samp{++} style may be appropriate for habits with time
-constraints, e.g., must be done on weekends, or a @samp{+} style for an
-unusual habit that can have a backlog, e.g., weekly reports.
-
-@item
-The TODO may also have minimum and maximum ranges specified by
-using the syntax @samp{.+2d/3d}, which says that you want to do the task
-at least every three days, but at most every two days.
-
-@item
-State logging for the DONE state is enabled (see @ref{Tracking TODO state changes}), in order for historical data to be represented in
-the consistency graph. If it is not enabled it is not an error,
-but the consistency graphs are largely meaningless.
-@end enumerate
-
-To give you an idea of what the above rules look like in action, here's an
-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]
- - State "DONE" from "TODO" [2009-10-04 Sun]
- - State "DONE" from "TODO" [2009-10-02 Fri]
- - State "DONE" from "TODO" [2009-09-29 Tue]
- - State "DONE" from "TODO" [2009-09-25 Fri]
- - State "DONE" from "TODO" [2009-09-19 Sat]
- - State "DONE" from "TODO" [2009-09-16 Wed]
- - State "DONE" from "TODO" [2009-09-12 Sat]
-@end example
-
-What this habit says is: I want to shave at most every 2 days---given
-by the @samp{SCHEDULED} date and repeat interval---and at least every
-4 days. If today is the 15th, then the habit first appears in the
-agenda (see @ref{Agenda Views}) on Oct 17, after the minimum of 2 days has
-elapsed, and will appear overdue on Oct 19, after four days have
-elapsed.
-
-What's really useful about habits is that they are displayed along
-with a consistency graph, to show how consistent you've been at
-getting that task done in the past. This graph shows every day that
-the task was done over the past three weeks, with colors for each day.
-The colors used are:
-
-@table @asis
-@item Blue
-If the task was not to be done yet on that day.
-@item Green
-If the task could have been done on that day.
-@item Yellow
-If the task was going to be overdue the next day.
-@item Red
-If the task was overdue on that day.
-@end table
-
-In addition to coloring each day, the day is also marked with an
-asterisk if the task was actually done that day, and an exclamation
-mark to show where the current day falls in the graph.
-
-There are several configuration variables that can be used to change
-the way habits are displayed in the agenda.
-
-@table @asis
-@item @code{org-habit-graph-column}
-@vindex org-habit-graph-column
-The buffer column at which the consistency graph should be drawn.
-This overwrites any text in that column, so it is a good idea to
-keep your habits' titles brief and to the point.
-
-@item @code{org-habit-preceding-days}
-@vindex org-habit-preceding-days
-The amount of history, in days before today, to appear in
-consistency graphs.
-
-@item @code{org-habit-following-days}
-@vindex org-habit-following-days
-The number of days after today that appear in consistency graphs.
-
-@item @code{org-habit-show-habits-only-for-today}
-@vindex org-habit-show-habits-only-for-today
-If non-@code{nil}, only show habits in today's agenda view. The default
-value is @code{t}. Pressing @kbd{C-u K} in the agenda toggles this
-variable.
-@end table
-
-Lastly, pressing @kbd{K} in the agenda buffer causes habits to
-temporarily be disabled and do not 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
-@section Priorities
-
-@cindex priorities
-@cindex priority cookie
-
-If you use Org mode extensively, you may end up with enough TODO items
-that it starts to make sense to prioritize them. Prioritizing can be
-done by placing a @emph{priority cookie} into the headline of a TODO item
-right after the TODO keyword, like this:
-
-@example
-*** TODO [#A] Write letter to Sam Fortune
-@end example
-
-
-@vindex org-priority-faces
-By default, Org mode supports three priorities: @samp{A}, @samp{B}, and @samp{C}.
-@samp{A} is the highest priority. An entry without a cookie is treated as
-equivalent if it had priority @samp{B}. Priorities make a difference only
-for sorting in the agenda (see @ref{Weekly/daily agenda}). Outside the
-agenda, they have no inherent meaning to Org mode. The cookies are
-displayed with the face defined by the variable @code{org-priority-faces},
-which can be customized.
-
-You can also use numeric values for priorities, such as
-
-@example
-*** TODO [#1] Write letter to Sam Fortune
-@end example
-
-
-When using numeric priorities, you need to set @code{org-priority-highest},
-@code{org-priority-lowest} and @code{org-priority-default} to integers, which
-must all be strictly inferior to 65.
-
-Priorities can be attached to any outline node; they do not need to be
-TODO items.
-
-@table @asis
-@item @kbd{C-c ,} (@code{org-priority})
-@kindex C-c ,
-@findex org-priority
-Set the priority of the current headline. The command prompts for
-a priority character @samp{A}, @samp{B} or @samp{C}. When you press @kbd{@key{SPC}}
-instead, the priority cookie, if one is set, is removed from the
-headline. The priorities can also be changed ``remotely'' from the
-agenda buffer with the @kbd{,} command (see @ref{Agenda Commands}).
-
-@item @kbd{S-@key{UP}} (@code{org-priority-up})
-@itemx @kbd{S-@key{DOWN}} (@code{org-priority-down})
-@kindex S-UP
-@kindex S-DOWN
-@findex org-priority-up
-@findex org-priority-down
-@vindex org-priority-start-cycle-with-default
-Increase/decrease the priority of the current headline@footnote{See also the option @code{org-priority-start-cycle-with-default}.}. Note
-that these keys are also used to modify timestamps (see @ref{Creating Timestamps}). See also @ref{Conflicts}, for
-a discussion of the interaction with shift-selection.
-@end table
-
-@vindex org-priority-highest
-@vindex org-priority-lowest
-@vindex org-priority-default
-You can change the range of allowed priorities by setting the
-variables @code{org-priority-highest}, @code{org-priority-lowest}, and
-@code{org-priority-default}. For an individual buffer, you may set these
-values (highest, lowest, default) like this (please make sure that the
-highest priority is earlier in the alphabet than the lowest priority):
-
-@cindex @samp{PRIORITIES}, keyword
-@example
-#+PRIORITIES: A C B
-@end example
-
-
-Or, using numeric values:
-
-@example
-#+PRIORITIES: 1 10 5
-@end example
-
-@node Breaking Down Tasks
-@section Breaking Down Tasks into Subtasks
-
-@cindex tasks, breaking down
-@cindex statistics, for TODO items
-
-@vindex org-agenda-todo-list-sublevels
-It is often advisable to break down large tasks into smaller,
-manageable subtasks. You can do this by creating an outline tree
-below a TODO item, with detailed subtasks on the tree@footnote{To keep subtasks out of the global TODO list, see the option
-@code{org-agenda-todo-list-sublevels}.}. To keep
-an overview of the fraction of subtasks that have already been marked
-as done, insert either @samp{[/]} or @samp{[%]} anywhere in the headline. These
-cookies are updated each time the TODO status of a child changes, or
-when pressing @kbd{C-c C-c} on the cookie. For example:
-
-@example
-* Organize Party [33%]
-** TODO Call people [1/2]
-*** TODO Peter
-*** DONE Sarah
-** TODO Buy food
-** DONE Talk to neighbor
-@end example
-
-@cindex @samp{COOKIE_DATA}, property
-If a heading has both checkboxes and TODO children below it, the
-meaning of the statistics cookie become ambiguous. Set the property
-@samp{COOKIE_DATA} to either @samp{checkbox} or @samp{todo} to resolve this issue.
-
-@vindex org-hierarchical-todo-statistics
-If you would like to have the statistics cookie count any TODO entries
-in the subtree (not just direct children), configure the variable
-@code{org-hierarchical-todo-statistics}. To do this for a single subtree,
-include the word @samp{recursive} into the value of the @samp{COOKIE_DATA}
-property.
-
-@example
-* Parent capturing statistics [2/20]
- :PROPERTIES:
- :COOKIE_DATA: todo recursive
- :END:
-@end example
-
-If you would like a TODO entry to automatically change to DONE when
-all children are done, you can use the following setup:
-
-@lisp
-(defun org-summary-todo (n-done n-not-done)
- "Switch entry to DONE when all subentries are done, to TODO otherwise."
- (let (org-log-done org-log-states) ; turn off logging
- (org-todo (if (= n-not-done 0) "DONE" "TODO"))))
-
-(add-hook 'org-after-todo-statistics-hook 'org-summary-todo)
-@end lisp
-
-Another possibility is the use of checkboxes to identify (a hierarchy
-of) a large number of subtasks (see @ref{Checkboxes}).
-
-@node Checkboxes
-@section Checkboxes
-
-@cindex checkboxes
-
-@vindex org-list-automatic-rules
-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.} (see @ref{Plain Lists}) can be made into
-a checkbox by starting it with the string @samp{[ ]}. This feature is
-similar to TODO items (see @ref{TODO Items}), but is more lightweight.
-Checkboxes are not included into 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.
-
-Here is an example of a checkbox list.
-
-@example
-* TODO Organize party [2/4]
- - [-] call people [1/3]
- - [ ] Peter
- - [X] Sarah
- - [ ] Sam
- - [X] order food
- - [ ] think about what music to play
- - [X] talk to the neighbors
-@end example
-
-Checkboxes work hierarchically, so if a checkbox item has children
-that are checkboxes, toggling one of the children checkboxes makes the
-parent checkbox reflect if none, some, or all of the children are
-checked.
-
-@cindex statistics, for checkboxes
-@cindex checkbox statistics
-@cindex @samp{COOKIE_DATA}, property
-@vindex org-hierarchical-checkbox-statistics
-The @samp{[2/4]} and @samp{[1/3]} in the first and second line are cookies
-indicating how many checkboxes present in this entry have been checked
-off, and the total number of checkboxes present. This can give you an
-idea on how many checkboxes remain, even without opening a folded
-entry. The cookies can be placed into a headline or into (the first
-line of) a plain list item. Each cookie covers checkboxes of direct
-children structurally below the headline/item on which the cookie
-appears@footnote{Set the variable @code{org-hierarchical-checkbox-statistics} if you
-want such cookies to count all checkboxes below the cookie, not just
-those belonging to direct children.}. You have to insert the cookie yourself by typing
-either @samp{[/]} or @samp{[%]}. With @samp{[/]} you get an @samp{n out of m} result, as
-in the examples above. With @samp{[%]} you get information about the
-percentage of checkboxes checked (in the above example, this would be
-@samp{[50%]} and @samp{[33%]}, respectively). In a headline, a cookie can count
-either checkboxes below the heading or TODO states of children, and it
-displays whatever was changed last. Set the property @samp{COOKIE_DATA} to
-either @samp{checkbox} or @samp{todo} to resolve this issue.
-
-@cindex blocking, of checkboxes
-@cindex checkbox blocking
-@cindex @samp{ORDERED}, property
-If the current outline node has an @samp{ORDERED} property, checkboxes must
-be checked off in sequence, and an error is thrown if you try to check
-off a box while there are unchecked boxes above it.
-
-The following commands work with checkboxes:
-
-@table @asis
-@item @kbd{C-c C-c} (@code{org-toggle-checkbox})
-@kindex C-c C-c
-@findex org-toggle-checkbox
-Toggle checkbox status or---with prefix argument---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 adds checkboxes to the rest of the list.}. With a double prefix argument, set
-it to @samp{[-]}, which is considered to be an intermediate state.
-
-@item @kbd{C-c C-x C-b} (@code{org-toggle-checkbox})
-@kindex C-c C-x C-b
-Toggle checkbox status or---with prefix argument---checkbox presence
-at point. With double prefix argument, set it to @samp{[-]}, which is
-considered to be an intermediate state.
-
-@itemize
-@item
-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 argument, add or remove the checkbox for all
-items in the region.
-
-@item
-If point is in a headline, toggle checkboxes in the region between
-this headline and the next---so @emph{not} the entire subtree.
-
-@item
-If there is no active region, just toggle the checkbox at point.
-@end itemize
-
-@item @kbd{C-c C-x C-r} (@code{org-toggle-radio-button})
-@kindex C-c C-x C-r
-@findex org-toggle-radio-button
-@cindex radio button, checkbox as
-Toggle checkbox status by using the checkbox of the item at point as
-a radio button: when the checkbox is turned on, all other checkboxes
-on the same level will be turned off. With a universal prefix
-argument, toggle the presence of the checkbox. With a double prefix
-argument, set it to @samp{[-]}.
-
-@findex org-list-checkbox-radio-mode
-@kbd{C-c C-c} can be told to consider checkboxes as radio buttons by
-setting @samp{#+ATTR_ORG: :radio t} right before the list or by calling
-@kbd{M-x org-list-checkbox-radio-mode} to activate this minor mode.
-
-@item @kbd{M-S-@key{RET}} (@code{org-insert-todo-heading})
-@kindex M-S-RET
-@findex org-insert-todo-heading
-Insert a new item with a checkbox. This works only if point is
-already in a plain list item (see @ref{Plain Lists}).
-
-@item @kbd{C-c C-x o} (@code{org-toggle-ordered-property})
-@kindex C-c C-x o
-@findex org-toggle-ordered-property
-@vindex org-track-ordered-property-with-tag
-Toggle the @samp{ORDERED} property of the entry, to toggle if checkboxes
-must be checked off in sequence. A property is used for this
-behavior because this should be local to the current entry, not
-inherited like a tag. However, if you would like to @emph{track} the
-value of this property with a tag for better visibility, customize
-@code{org-track-ordered-property-with-tag}.
-
-@item @kbd{C-c #} (@code{org-update-statistics-cookies})
-@kindex C-c #
-@findex org-update-statistics-cookies
-Update the statistics cookie in the current outline entry. When
-called with a @kbd{C-u} prefix, update the entire file.
-Checkbox statistic cookies are updated automatically if you toggle
-checkboxes with @kbd{C-c C-c} and make new ones with
-@kbd{M-S-@key{RET}}. TODO statistics cookies update when 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
-@chapter Tags
-
-@cindex tags
-@cindex headline tagging
-@cindex matching, tags
-@cindex sparse tree, tag based
-
-An excellent way to implement labels and contexts for
-cross-correlating information is to assign @emph{tags} to headlines. Org
-mode has extensive support for tags.
-
-@vindex org-tag-faces
-Every headline can contain a list of tags; they occur at the end of
-the headline. Tags are normal words containing letters, numbers, @samp{_},
-and @samp{@@}. Tags must be preceded and followed by a single colon, e.g.,
-@samp{:work:}. Several tags can be specified, as in @samp{:work:urgent:}. Tags
-by default are in bold face with the same color as the headline. You
-may specify special faces for specific tags using the variable
-@code{org-tag-faces}, in much the same way as you can for TODO keywords
-(see @ref{Faces for TODO keywords}).
-
-@menu
-* Tag Inheritance:: Tags use the tree structure of an outline.
-* Setting Tags:: How to assign tags to a headline.
-* Tag Hierarchy:: Create a hierarchy of tags.
-* Tag Searches:: Searching for combinations of tags.
-@end menu
-
-@node Tag Inheritance
-@section Tag Inheritance
-
-@cindex tag inheritance
-@cindex inheritance, of tags
-@cindex sublevels, inclusion into tags match
-
-@emph{Tags} make use of the hierarchical structure of outline trees. If
-a heading has a certain tag, all subheadings inherit the tag as well.
-For example, in the list
-
-@example
-* Meeting with the French group :work:
-** Summary by Frank :boss:notes:
-*** TODO Prepare slides for him :action:
-@end example
-
-@noindent
-the final heading has 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.}
-
-@cindex @samp{FILETAGS}, keyword
-@example
-#+FILETAGS: :Peter:Boss:Secret:
-@end example
-
-
-@vindex org-use-tag-inheritance
-@vindex org-tags-exclude-from-inheritance
-To limit tag inheritance to specific tags, or to turn it off entirely,
-use the variables @code{org-use-tag-inheritance} and
-@code{org-tags-exclude-from-inheritance}.
-
-@vindex org-tags-match-list-sublevels
-When a headline matches during a tags search while tag inheritance is
-turned on, all the sublevels in the same tree---for a simple match
-form---match as well@footnote{This is only true if the search does not involve more complex
-tests including properties (see @ref{Property Searches}).}. The list of matches may then become
-very long. If you only want to see the first tags match in a subtree,
-configure the variable @code{org-tags-match-list-sublevels} (not
-recommended).
-
-@vindex org-agenda-use-tag-inheritance
-Tag inheritance is relevant when the agenda search tries to match
-a tag, either in the @code{tags} or @code{tags-todo} agenda types. In other
-agenda types, @code{org-use-tag-inheritance} has no effect. Still, you may
-want to have your tags correctly set in the agenda, so that tag
-filtering works fine, 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
-@section Setting Tags
-
-@cindex setting tags
-@cindex tags, setting
-
-@kindex M-TAB
-Tags can simply be typed into the buffer at the end of a headline.
-After a colon, @kbd{M-@key{TAB}} offers completion on tags. There is
-also a special command for inserting tags:
-
-@table @asis
-@item @kbd{C-c C-q} (@code{org-set-tags-command})
-@kindex C-c C-q
-@findex org-set-tags-command
-@cindex completion, of tags
-@vindex org-tags-column
-Enter new tags for the current headline. Org mode either offers
-completion or a special single-key interface for setting tags, see
-below. After pressing @kbd{@key{RET}}, the tags are inserted and
-aligned to @code{org-tags-column}. When called with a @kbd{C-u}
-prefix, all tags in the current buffer are aligned to that column,
-just to make things look nice. Tags are automatically realigned
-after promotion, demotion, and TODO state changes (see @ref{TODO Basics}).
-
-@item @kbd{C-c C-c} (@code{org-set-tags-command})
-@kindex C-c C-c
-When point is in a headline, this does the same as @kbd{C-c C-q}.
-@end table
-
-@vindex org-complete-tags-always-offer-all-agenda-tags
-@vindex org-tag-alist
-@cindex @samp{TAGS}, keyword
-Org supports tag insertion based on a @emph{list of tags}. By default this
-list is constructed dynamically, containing all tags currently used in
-the buffer@footnote{To extend this default list to all tags used in all agenda
-files (see @ref{Agenda Views}), customize the variable
-@code{org-complete-tags-always-offer-all-agenda-tags}.}. You may also globally specify a hard list of tags
-with the variable @code{org-tag-alist}. Finally you can set the default
-tags for a given file using the @samp{TAGS} keyword, like
-
-@example
-#+TAGS: @@work @@home @@tennisclub
-#+TAGS: laptop car pc sailboat
-@end example
-
-If you have globally defined your preferred set of tags using the
-variable @code{org-tag-alist}, but would like to use a dynamic tag list in
-a specific file, add an empty @samp{TAGS} keyword to that file:
-
-@example
-#+TAGS:
-@end example
-
-
-@vindex org-tag-persistent-alist
-If you have a preferred set of tags that you would like to use in
-every file, in addition to those defined on a per-file basis by @samp{TAGS}
-keyword, then you may specify a list of tags with the variable
-@code{org-tag-persistent-alist}. You may turn this off on a per-file basis
-by adding a @samp{STARTUP} keyword to that file:
-
-@example
-#+STARTUP: noptag
-@end example
-
-
-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 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
-(setq org-tag-alist '(("@@work" . ?w) ("@@home" . ?h) ("laptop" . ?l)))
-@end lisp
-
-If the tag is only relevant to the file you are working on, then you
-can instead set the @samp{TAGS} keyword as:
-
-@example
-#+TAGS: @@work(w) @@home(h) @@tennisclub(t) laptop(l) pc(p)
-@end example
-
-
-The tags interface shows the available tags in a splash window. If
-you want to start a new line after a specific tag, insert @samp{\n} into
-the tag list
-
-@example
-#+TAGS: @@work(w) @@home(h) @@tennisclub(t) \n laptop(l) pc(p)
-@end example
-
-
-@noindent
-or write them in two lines:
-
-@example
-#+TAGS: @@work(w) @@home(h) @@tennisclub(t)
-#+TAGS: laptop(l) pc(p)
-@end example
-
-You can also group together tags that are mutually exclusive by using
-braces, as in:
-
-@example
-#+TAGS: @{ @@work(w) @@home(h) @@tennisclub(t) @} laptop(l) pc(p)
-@end example
-
-
-@noindent
-you indicate that at most one of @samp{@@work}, @samp{@@home}, and @samp{@@tennisclub}
-should be selected. Multiple such groups are allowed.
-
-Do not forget to press @kbd{C-c C-c} with point in one of these
-lines to activate any changes.
-
-To set these mutually exclusive groups in the variable
-@code{org-tags-alist}, you must use the dummy tags @code{:startgroup} and
-@code{:endgroup} instead of the braces. Similarly, you can use @code{:newline}
-to indicate a line break. The previous example would be set globally
-by the following configuration:
-
-@lisp
-(setq org-tag-alist '((:startgroup . nil)
- ("@@work" . ?w) ("@@home" . ?h)
- ("@@tennisclub" . ?t)
- (:endgroup . nil)
- ("laptop" . ?l) ("pc" . ?p)))
-@end lisp
-
-If at least one tag has a selection key then pressing @kbd{C-c C-c} automatically presents 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 are automatically assigned to tags that have no
-configured keys.}.
-
-Pressing keys assigned to tags adds or removes them from the list of
-tags in the current line. Selecting a tag in a group of mutually
-exclusive tags turns off any other tag from that group.
-
-In this interface, you can also use the following special keys:
-
-@table @asis
-@item @kbd{@key{TAB}}
-@kindex TAB
-Enter a tag in the minibuffer, even if the tag is not in the
-predefined list. You can complete on all tags present in the
-buffer. You can also add several tags: just separate them with
-a comma.
-
-@item @kbd{@key{SPC}}
-@kindex SPC
-Clear all tags for this line.
-
-@item @kbd{@key{RET}}
-@kindex RET
-Accept the modified set.
-
-@item @kbd{C-g}
-@kindex C-g
-Abort without installing changes.
-
-@item @kbd{q}
-@kindex q
-If @kbd{q} is not assigned to a tag, it aborts like
-@kbd{C-g}.
-
-@item @kbd{!}
-@kindex !
-Turn off groups of mutually exclusive tags. Use this to (as an
-exception) assign several tags from such a group.
-
-@item @kbd{C-c}
-@kindex C-c C-c
-Toggle auto-exit after the next change (see below). If you are
-using expert mode, the first @kbd{C-c} displays the selection
-window.
-@end table
-
-This method lets you assign tags to a headline with very few keys.
-With the above setup, you could clear the current tags and set
-@samp{@@home}, @samp{laptop} and @samp{pc} tags with just the following keys:
-@kbd{C-c C-c @key{SPC} h l p @key{RET}}. Switching from @samp{@@home} to @samp{@@work}
-would be done with @kbd{C-c C-c w @key{RET}} or alternatively with
-@kbd{C-c C-c C-c w}. Adding the non-predefined tag @samp{sarah} could
-be done with @kbd{C-c C-c @key{TAB} s a r a h @key{RET}}.
-
-@vindex org-fast-tag-selection-single-key
-If you find that most of the time you need only a single key press to
-modify your list of tags, set the variable
-@code{org-fast-tag-selection-single-key}. Then you no longer have to press
-@kbd{@key{RET}} to exit fast tag selection---it exits after the first
-change. If you then occasionally need more keys, press @kbd{C-c}
-to turn off auto-exit for the current tag selection process (in
-effect: start selection with @kbd{C-c C-c C-c} 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 Hierarchy
-@section Tag Hierarchy
-
-@cindex group tags
-@cindex tags, groups
-@cindex tags 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 group tags and
-nesting them creates a tag hierarchy.
-
-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 return matches for all members in
-the group and its subgroups. In an agenda view, filtering by a group
-tag displays 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 group tag and it is related to two other
-tags: @samp{Control}, @samp{Persp}. Defining @samp{Control} and @samp{Persp} as group
-tags creates a hierarchy of tags:
-
-@example
-#+TAGS: [ Control : Context Task ]
-#+TAGS: [ Persp : Vision Goal AOF Project ]
-@end example
-
-That can conceptually be seen as a hierarchy of tags:
-
-@itemize
-@item
-@samp{GTD}
-@itemize
-@item
-@samp{Persp}
-@itemize
-@item
-@samp{Vision}
-@item
-@samp{Goal}
-@item
-@samp{AOF}
-@item
-@samp{Project}
-@end itemize
-@item
-@samp{Control}
-@itemize
-@item
-@samp{Context}
-@item
-@samp{Task}
-@end itemize
-@end itemize
-@end itemize
-
-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 '((:startgrouptag)
- ("GTD")
- (:grouptags)
- ("Control")
- ("Persp")
- (:endgrouptag)
- (:startgrouptag)
- ("Control")
- (:grouptags)
- ("Context")
- ("Task")
- (:endgrouptag)))
-@end lisp
-
-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} and @code{:endgroup}
-instead of @code{:startgrouptag} and @code{:endgrouptag} to make the tags
-mutually exclusive.
-
-Furthermore, the members of a 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 curly brackets. 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} now lists 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
-@findex org-toggle-tags-groups
-@vindex org-group-tags
-If you want to ignore group tags temporarily, toggle group tags
-support with @code{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
-@section Tag Searches
-
-@cindex tag searches
-@cindex searching for tags
-
-Once a system of tags has been set up, it can be used to collect
-related information into special lists.
-
-@table @asis
-@item @kbd{C-c / m} or @kbd{C-c \} (@code{org-match-sparse-tree})
-@kindex C-c / m
-@kindex C-c \
-@findex org-match-sparse-tree
-Create a sparse tree with all headlines matching a tags search.
-With a @kbd{C-u} prefix argument, ignore headlines that are not
-a TODO line.
-
-@item @kbd{M-x org-agenda m} (@code{org-tags-view})
-@kindex m @r{(Agenda dispatcher)}
-@findex org-tags-view
-Create a global list of tag matches from all agenda files. See
-@ref{Matching tags and properties}.
-
-@item @kbd{M-x org-agenda M} (@code{org-tags-view})
-@kindex M @r{(Agenda dispatcher)}
-@vindex org-tags-match-list-sublevels
-Create a global list of tag matches from all agenda files, but check
-only TODO items and force checking subitems (see the option
-@code{org-tags-match-list-sublevels}).
-@end table
-
-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}.
-
-@node Properties and Columns
-@chapter Properties and Columns
-
-@cindex properties
-
-A property is a key-value pair associated with an entry. Properties
-can be set so they are associated with a single entry, with every
-entry in a tree, or with the whole buffer.
-
-There are two main applications for properties in Org mode. First,
-properties are like tags, but with a value. Imagine maintaining
-a file where you document bugs and plan releases for a piece of
-software. Instead of using tags like @samp{release_1}, @samp{release_2}, you
-can use a property, say @samp{Release}, that in different subtrees has
-different values, such as @samp{1.0} or @samp{2.0}. Second, you can use
-properties to implement (very basic) database capabilities in an Org
-buffer. Imagine keeping track of your music CDs, where properties
-could be things such as the album, artist, date of release, number of
-tracks, and so on.
-
-Properties can be conveniently edited and viewed in column view (see
-@ref{Column View}).
-
-@menu
-* Property Syntax:: How properties are spelled out.
-* Special Properties:: Access to other Org mode features.
-* Property Searches:: Matching property values.
-* Property Inheritance:: Passing values down a tree.
-* Column View:: Tabular viewing and editing.
-@end menu
-
-@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 (see @ref{Drawers}) with the name @samp{PROPERTIES}, which has to be
-located right below a headline, and its planning line (see @ref{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
-** Classic
-*** Goldberg Variations
- :PROPERTIES:
- :Title: Goldberg Variations
- :Composer: J.S. Bach
- :Artist: Glenn Gould
- :Publisher: Deutsche Grammophon
- :NDisks: 1
- :END:
-@end example
-
-Depending on the value of @code{org-use-property-inheritance}, a property
-set this way is associated either with a single entry, or with the
-sub-tree defined by the entry, see @ref{Property Inheritance}.
-
-You may define the allowed values for a particular property @samp{Xyz} by
-setting a property @samp{Xyz_ALL}. This special property is @emph{inherited},
-so if you set it in a level 1 entry, it applies to the entire tree.
-When allowed values are defined, setting the corresponding property
-becomes easier and is less prone to typing errors. For the example
-with the CD collection, we can pre-define publishers and the number of
-disks in a box like this:
-
-@example
-* CD collection
- :PROPERTIES:
- :NDisks_ALL: 1 2 3 4
- :Publisher_ALL: "Deutsche Grammophon" Philips EMI
- :END:
-@end example
-
-Properties can be inserted on buffer level. That means they apply
-before the first headline and can be inherited by all entries in a
-file. Property blocks defined before first headline needs to be
-located at the top of the buffer, allowing only comments above.
-
-Properties can also be defined using lines like:
-
-@cindex @samp{_ALL} suffix, in properties
-@cindex @samp{PROPERTY}, keyword
-@example
-#+PROPERTY: NDisks_ALL 1 2 3 4
-@end example
-
-
-@cindex @samp{+} suffix, in properties
-If you want to add to the value of an existing property, append a @samp{+}
-to the property name. The following results in the property @samp{var}
-having the value @samp{foo=1 bar=2}.
-
-@example
-#+PROPERTY: var foo=1
-#+PROPERTY: var+ bar=2
-@end example
-
-It is also possible to add to the values of inherited properties. The
-following results in the @samp{Genres} property having the value @samp{Classic
-Baroque} under the @samp{Goldberg Variations} subtree.
-
-@example
-* CD collection
-** Classic
- :PROPERTIES:
- :Genres: Classic
- :END:
-*** Goldberg Variations
- :PROPERTIES:
- :Title: Goldberg Variations
- :Composer: J.S. Bach
- :Artist: Glenn Gould
- :Publisher: Deutsche Grammophon
- :NDisks: 1
- :Genres+: Baroque
- :END:
-@end example
-
-Note that a property can only have one entry per drawer.
-
-@vindex org-global-properties
-Property values set with the global variable @code{org-global-properties}
-can be inherited by all entries in all Org files.
-
-The following commands help to work with properties:
-
-@table @asis
-@item @kbd{M-@key{TAB}} (@code{pcomplete})
-@kindex M-TAB
-@findex pcomplete
-After an initial colon in a line, complete property keys. All keys
-used in the current file are offered as possible completions.
-
-@item @kbd{C-c C-x p} (@code{org-set-property})
-@kindex C-c C-x p
-@findex org-set-property
-Set a property. This prompts for a property name and a value. If
-necessary, the property drawer is created as well.
-
-@item @kbd{C-u M-x org-insert-drawer}
-@findex org-insert-drawer
-Insert a property drawer into the current entry. The drawer is
-inserted early in the entry, but after the lines with planning
-information like deadlines. If before first headline the drawer is
-inserted at the top of the drawer after any potential comments.
-
-@item @kbd{C-c C-c} (@code{org-property-action})
-@kindex C-c C-c
-@findex org-property-action
-With point in a property drawer, this executes property commands.
-
-@item @kbd{C-c C-c s} (@code{org-set-property})
-@kindex C-c C-c s
-@findex org-set-property
-Set a property in the current entry. Both the property and the
-value can be inserted using completion.
-
-@item @kbd{S-@key{RIGHT}} (@code{org-property-next-allowed-values})
-@itemx @kbd{S-@key{LEFT}} (@code{org-property-previous-allowed-value})
-@kindex S-RIGHT
-@kindex S-LEFT
-Switch property at point to the next/previous allowed value.
-
-@item @kbd{C-c C-c d} (@code{org-delete-property})
-@kindex C-c C-c d
-@findex org-delete-property
-Remove a property from the current entry.
-
-@item @kbd{C-c C-c D} (@code{org-delete-property-globally})
-@kindex C-c C-c D
-@findex org-delete-property-globally
-Globally remove a property, from all entries in the current file.
-
-@item @kbd{C-c C-c c} (@code{org-compute-property-at-point})
-@kindex C-c C-c c
-@findex org-compute-property-at-point
-Compute the property at point, using the operator and scope from the
-nearest column format definition.
-@end table
-
-@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 (see @ref{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 @samp{ALLTAGS}, special property
-@cindex @samp{BLOCKED}, special property
-@cindex @samp{CLOCKSUM}, special property
-@cindex @samp{CLOCKSUM_T}, special property
-@cindex @samp{CLOSED}, special property
-@cindex @samp{DEADLINE}, special property
-@cindex @samp{FILE}, special property
-@cindex @samp{ITEM}, special property
-@cindex @samp{PRIORITY}, special property
-@cindex @samp{SCHEDULED}, special property
-@cindex @samp{TAGS}, special property
-@cindex @samp{TIMESTAMP}, special property
-@cindex @samp{TIMESTAMP_IA}, special property
-@cindex @samp{TODO}, special property
-@multitable {aaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{ALLTAGS}
-@tab All tags, including inherited ones.
-@item @samp{BLOCKED}
-@tab @code{t} if task is currently blocked by children or siblings.
-@item @samp{CATEGORY}
-@tab The category of an entry.
-@item @samp{CLOCKSUM}
-@tab The sum of CLOCK intervals in the subtree. @code{org-clock-sum}
-@item
-@tab must be run first to compute the values in the current buffer.
-@item @samp{CLOCKSUM_T}
-@tab The sum of CLOCK intervals in the subtree for today.
-@item
-@tab @code{org-clock-sum-today} must be run first to compute the
-@item
-@tab values in the current buffer.
-@item @samp{CLOSED}
-@tab When was this entry closed?
-@item @samp{DEADLINE}
-@tab The deadline timestamp.
-@item @samp{FILE}
-@tab The filename the entry is located in.
-@item @samp{ITEM}
-@tab The headline of the entry.
-@item @samp{PRIORITY}
-@tab The priority of the entry, a string with a single letter.
-@item @samp{SCHEDULED}
-@tab The scheduling timestamp.
-@item @samp{TAGS}
-@tab The tags defined directly in the headline.
-@item @samp{TIMESTAMP}
-@tab The first keyword-less timestamp in the entry.
-@item @samp{TIMESTAMP_IA}
-@tab The first inactive timestamp in the entry.
-@item @samp{TODO}
-@tab The TODO keyword of the entry.
-@end multitable
-
-@node Property Searches
-@section Property Searches
-
-@cindex properties, searching
-@cindex searching, of properties
-
-To create sparse trees and special lists with selection based on
-properties, the same commands are used as for tag searches (see @ref{Tag Searches}).
-
-@table @asis
-@item @kbd{C-c / m} or @kbd{C-c \} (@code{org-match-sparse-tree})
-@kindex C-c / m
-@kindex C-c \
-@findex org-match-sparse-tree
-Create a sparse tree with all matching entries. With
-a @kbd{C-u} prefix argument, ignore headlines that are not
-a TODO line.
-
-@item @kbd{M-x org-agenda m} (@code{org-tags-view})
-@kindex m @r{(Agenda dispatcher)}
-@findex org-tags-view
-Create a global list of tag/property matches from all agenda files.
-
-@item @kbd{M-x org-agenda M} (@code{org-tags-view})
-@kindex M @r{(Agenda dispatcher)}
-@vindex org-tags-match-list-sublevels
-Create a global list of tag matches from all agenda files, but check
-only TODO items and force checking of subitems (see the option
-@code{org-tags-match-list-sublevels}).
-@end table
-
-The syntax for the search string is described in @ref{Matching tags and properties}.
-
-There is also a special command for creating sparse trees based on a
-single property:
-
-@table @asis
-@item @kbd{C-c / p}
-@kindex C-c / p
-Create a sparse tree based on the value of a property. This first
-prompts for the name of a property, and then for a value. A sparse
-tree is created with all entries that define this property with the
-given 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
-@section Property Inheritance
-
-@cindex properties, inheritance
-@cindex inheritance, of properties
-
-@vindex org-use-property-inheritance
-The outline structure of Org documents lends itself to an inheritance
-model of properties: if the parent in a tree has a certain property,
-the children can inherit this property. Org mode does not turn this
-on by default, because it can slow down property searches
-significantly and is often not needed. However, if you find
-inheritance useful, you can turn it on by setting the variable
-@code{org-use-property-inheritance}. It may be set to @code{t} to make all
-properties inherited from the parent, to a list of properties that
-should be inherited, or to a regular expression that matches inherited
-properties. If a property has the value @code{nil}, this is interpreted as
-an explicit un-define of the property, so that inheritance search
-stops at this value and returns @code{nil}.
-
-Org mode has a few properties for which inheritance is hard-coded, at
-least for the special applications for which they are used:
-
-@table @asis
-@item @code{COLUMNS}
-@cindex @samp{COLUMNS}, property
-The @samp{COLUMNS} property defines the format of column view (see
-@ref{Column View}). It is inherited in the sense that the level where
-a @samp{COLUMNS} property is defined is used as the starting point for
-a column view table, independently of the location in the subtree
-from where columns view is turned on.
-
-@item @code{CATEGORY}
-@cindex @samp{CATEGORY}, property
-For agenda view, a category set through a @samp{CATEGORY} property
-applies to the entire subtree.
-
-@item @code{ARCHIVE}
-@cindex @samp{ARCHIVE}, property
-For archiving, the @samp{ARCHIVE} property may define the archive
-location for the entire subtree (see @ref{Moving subtrees}).
-
-@item @code{LOGGING}
-@cindex @samp{LOGGING}, property
-The @samp{LOGGING} property may define logging settings for an entry or
-a subtree (see @ref{Tracking TODO state changes}).
-@end table
-
-@node Column View
-@section Column View
-
-A great way to view and edit properties in an outline tree is @emph{column
-view}. In column view, each outline node is turned into a table row.
-Columns in this table provide access to properties of the entries.
-Org mode implements columns by overlaying a tabular structure over the
-headline of each item. While the headlines have been turned into
-a table row, you can still change the visibility of the outline tree.
-For example, you get a compact table by switching to ``contents''
-view---@kbd{S-@key{TAB}} @kbd{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 (see
-@ref{Agenda Views}) where queries have collected selected items, possibly
-from a number of files.
-
-@menu
-* Defining columns:: The COLUMNS format property.
-* Using column view:: How to create and use column view.
-* Capturing column view:: A dynamic block for column view.
-@end menu
-
-@node Defining columns
-@subsection Defining columns
-
-@cindex column view, for properties
-@cindex properties, column view
-
-Setting up a column view first requires defining the columns. This is
-done by defining a column format line.
-
-@menu
-* Scope of column definitions:: Where defined, where valid?
-* Column attributes:: Appearance and content of a column.
-@end menu
-
-@node Scope of column definitions
-@subsubsection Scope of column definitions
-
-To specify a format that only applies to a specific tree, add
-a @samp{COLUMNS} property to the top node of that tree, for example:
-
-@example
-** Top node for columns view
- :PROPERTIES:
- :COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
- :END:
-@end example
-
-A @samp{COLUMNS} property within a property drawer before first headline
-will apply to the entire file. As an addition to property drawers,
-keywords can also be defined for an entire file using a line like:
-
-@cindex @samp{COLUMNS}, keyword
-@example
-#+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO
-@end example
-
-
-If a @samp{COLUMNS} property is present in an entry, it defines columns for
-the entry itself, and for the entire subtree below it. Since the
-column definition is part of the hierarchical structure of the
-document, 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
-@subsubsection Column attributes
-
-A column definition sets the attributes of a column. The general
-definition looks like this:
-
-@example
-%[WIDTH]PROPERTY[(TITLE)][@{SUMMARY-TYPE@}]
-@end example
-
-
-@noindent
-Except for the percent sign and the property name, all items are
-optional. The individual parts have the following meaning:
-
-@table @asis
-@item @var{WIDTH}
-An integer specifying the width of the column in characters. If
-omitted, the width is determined automatically.
-
-@item @var{PROPERTY}
-The property that should be edited in this column. Special
-properties representing meta data are allowed here as well (see
-@ref{Special Properties}).
-
-@item @var{TITLE}
-The header text for the column. If omitted, the property name is
-used.
-
-@item @var{SUMMARY-TYPE}
-The summary type. If specified, the column values for parent nodes
-are computed from the children@footnote{If more than one summary type applies to the same property,
-the parent values are computed according to the first of them.}.
-
-Supported summary types are:
-
-@multitable {aaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{+}
-@tab Sum numbers in this column.
-@item @samp{+;%.1f}
-@tab Like @samp{+}, but format result with @samp{%.1f}.
-@item @samp{$}
-@tab Currency, short for @samp{+;%.2f}.
-@item @samp{min}
-@tab Smallest number in column.
-@item @samp{max}
-@tab Largest number.
-@item @samp{mean}
-@tab Arithmetic mean of numbers.
-@item @samp{X}
-@tab Checkbox status, @samp{[X]} if all children are @samp{[X]}.
-@item @samp{X/}
-@tab Checkbox status, @samp{[n/m]}.
-@item @samp{X%}
-@tab Checkbox status, @samp{[n%]}.
-@item @samp{:}
-@tab Sum times, HH:MM, plain numbers are minutes.
-@item @samp{:min}
-@tab Smallest time value in column.
-@item @samp{:max}
-@tab Largest time value.
-@item @samp{:mean}
-@tab Arithmetic mean of time values.
-@item @samp{@@min}
-@tab Minimum age@footnote{An age can be defined as a duration, using units defined in
-@code{org-duration-units}, e.g., @samp{3d 1h}. If any value in the column is as
-such, the summary is also expressed as a duration.} (in days/hours/mins/seconds).
-@item @samp{@@max}
-@tab Maximum age (in days/hours/mins/seconds).
-@item @samp{@@mean}
-@tab Arithmetic mean of ages (in days/hours/mins/seconds).
-@item @samp{est+}
-@tab Add low-high estimates.
-@end multitable
-
-@vindex org-columns-summary-types
-You can also define custom summary types by setting
-@code{org-columns-summary-types}.
-@end table
-
-The @samp{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 do not 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, @samp{est+} adds
-the statistical mean and variance of the subtasks, generating a final
-estimate from the sum. For example, suppose you had ten tasks, each
-of which was estimated at 0.5 to 2 days of work. Straight addition
-produces an estimate of 5 to 20 days, representing what to expect if
-everything goes either extremely well or extremely poorly. In
-contrast, @samp{est+} estimates the full job more realistically, at 10--15
-days.
-
-Here is an example for a complete columns definition, along with
-allowed values@footnote{Please note that the @samp{COLUMNS} definition must be on a single
-line; it is wrapped here only because of formatting constraints.}.
-
-@example
-:COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \
- %10Time_Estimate@{:@} %CLOCKSUM %CLOCKSUM_T
-:Owner_ALL: Tammy Mark Karl Lisa Don
-:Status_ALL: "In progress" "Not started yet" "Finished" ""
-:Approved_ALL: "[ ]" "[X]"
-@end example
-
-@noindent
-The first column, @samp{%25ITEM}, means the first 25 characters of the item
-itself, i.e., of the headline. You probably always should start the
-column definition with the @samp{ITEM} specifier. The other specifiers
-create columns @samp{Owner} with a list of names as allowed values, for
-@samp{Status} with four different possible values, and for a checkbox field
-@samp{Approved}. When no width is given after the @samp{%} character, the
-column is exactly as wide as it needs to be in order to fully display
-all values. The @samp{Approved} column does have a modified title
-(@samp{Approved?}, with a question mark). Summaries are created for the
-@samp{Time_Estimate} column by adding time duration expressions like HH:MM,
-and for the @samp{Approved} column, by providing an @samp{[X]} status if all
-children have been checked. The @samp{CLOCKSUM} and @samp{CLOCKSUM_T} columns
-are special, they lists the sums of CLOCK intervals in the subtree,
-either for all clocks or just for today.
-
-@node Using column view
-@subsection Using column view
-
-
-
-@anchor{Turning column view on or off}
-@subsubheading Turning column view on or off
-
-@table @asis
-@item @kbd{C-c C-x C-c} (@code{org-columns})
-@kindex C-c C-x C-c
-@vindex org-columns
-@vindex org-columns-default-format
-Turn on column view. If point is before the first headline in the
-file, column view is turned on for the entire file, using the
-@samp{#+COLUMNS} definition. If point is somewhere inside the outline,
-this command searches the hierarchy, up from point, for a @samp{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 @samp{COLUMNS} property. If no such property is found, the
-format is taken from the @samp{#+COLUMNS} line or from the variable
-@code{org-columns-default-format}, and column view is established for the
-current entry and its subtree.
-
-@item @kbd{r} or @kbd{g} on a columns view line (@code{org-columns-redo})
-@kindex r
-@kindex g
-@findex org-columns-redo
-Recreate the column view, to include recent changes made in the
-buffer.
-
-@item @kbd{C-c C-c} or @kbd{q} on a columns view line (@code{org-columns-quit})
-@kindex q
-@kindex C-c C-c
-@findex org-columns-quit
-Exit column view.
-@end table
-
-@anchor{Editing values}
-@subsubheading Editing values
-
-@table @asis
-@item @kbd{@key{LEFT}}, @kbd{@key{RIGHT}}, @kbd{@key{UP}}, @kbd{@key{DOWN}}
-Move through the column view from field to field.
-
-@item @kbd{1..9,0}
-@kindex 1..9,0
-Directly select the Nth allowed value, @kbd{0} selects the
-10th value.
-
-@item @kbd{n} or @kbd{S-@key{RIGHT}} (@code{org-columns-next-allowed-value})
-@itemx @kbd{p} or @kbd{S-@key{LEFT}} (@code{org-columns-previous-allowed-value})
-@kindex n
-@kindex S-RIGHT
-@kindex p
-@kindex S-LEFT
-@findex org-columns-next-allowed-value
-@findex org-columns-previous-allowed-value
-Switch to the next/previous allowed value of the field. For this,
-you have to have specified allowed values for a property.
-
-@item @kbd{e} (@code{org-columns-edit-value})
-@kindex e
-@findex org-columns-edit-value
-Edit the property at point. For the special properties, this
-invokes the same interface that you normally use to change that
-property. For example, the tag completion or fast selection
-interface pops up when editing a @samp{TAGS} property.
-
-@item @kbd{C-c C-c} (@code{org-columns-toggle-or-columns-quit})
-@kindex C-c C-c
-@findex org-columns-toggle-or-columns-quit
-When there is a checkbox at point, toggle it. Else exit column
-view.
-
-@item @kbd{v} (@code{org-columns-show-value})
-@kindex v
-@findex org-columns-show-value
-View the full value of this property. This is useful if the width
-of the column is smaller than that of the value.
-
-@item @kbd{a} (@code{org-columns-edit-allowed})
-@kindex a
-@findex 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 found, the new value is stored in the first entry that is
-part of the current column view.
-@end table
-
-@anchor{Modifying column view on-the-fly}
-@subsubheading Modifying column view on-the-fly
-
-@table @asis
-@item @kbd{<} (@code{org-columns-narrow})
-@itemx @kbd{>} (@code{org-columns-widen})
-@kindex <
-@kindex >
-@findex org-columns-narrow
-@findex org-columns-widen
-Make the column narrower/wider by one character.
-
-@item @kbd{S-M-@key{RIGHT}} (@code{org-columns-new})
-@kindex S-M-RIGHT
-@findex org-columns-new
-Insert a new column, to the left of the current column.
-
-@item @kbd{S-M-@key{LEFT}} (@code{org-columns-delete})
-@kindex S-M-LEFT
-@findex org-columns-delete
-Delete the current column.
-@end table
-
-@node Capturing column view
-@subsection Capturing column view
-
-Since column view is just an overlay over a buffer, it cannot be
-exported or printed directly. If you want to capture a column view,
-use a @samp{columnview} dynamic block (see @ref{Dynamic Blocks}). The frame of
-this block looks like this:
-
-@cindex @samp{BEGIN columnview}
-@example
-* The column view
-#+BEGIN: columnview :hlines 1 :id "label"
-
-#+END:
-@end example
-
-This dynamic block has the following parameters:
-
-@table @asis
-@item @samp{:id}
-This is the most important parameter. Column view is a feature that
-is often localized to a certain (sub)tree, and the capture block
-might be at a different location in the file. To identify the tree
-whose view to capture, you can use four values:
-
-@table @asis
-@item @samp{local}
-Use the tree in which the capture block is located.
-
-@item @samp{global}
-Make a global view, including all headings in the file.
-
-@item @samp{file:FILENAME}
-Run column view at the top of the @var{FILENAME} file.
-
-@item @samp{LABEL}
-@cindex @samp{ID}, property
-Call column view in the tree that has an @samp{ID} property with the
-value @var{LABEL}. You can use @kbd{M-x org-id-copy} to
-create a globally unique ID for the current entry and copy it to
-the kill-ring.
-@end table
-
-@item @samp{:match}
-When set to a string, use this as a tags/property match filter to
-select only a subset of the headlines in the scope set by the @code{:id}
-parameter.
-@end table
-
-
-@table @asis
-@item @samp{:hlines}
-When @code{t}, insert an hline after every line. When a number N, insert
-an hline before each headline with level @code{<= N}.
-
-@item @samp{:vlines}
-When non-@code{nil}, force column groups to get vertical lines.
-
-@item @samp{:maxlevel}
-When set to a number, do not capture entries below this level.
-
-@item @samp{:skip-empty-rows}
-When non-@code{nil}, skip rows where the only non-empty specifier of
-the column view is @samp{ITEM}.
-
-@item @samp{:exclude-tags}
-List of tags to exclude from column view table: entries with these
-tags will be excluded from the column view.
-
-@item @samp{:indent}
-When non-@code{nil}, indent each @samp{ITEM} field according to its level.
-
-@item @samp{:format}
-Specify a column attribute (see @ref{Column attributes}) for the dynamic
-block.
-@end table
-
-The following commands insert or update the dynamic block:
-
-@table @asis
-@item @code{org-columns-insert-dblock}
-@kindex C-c C-x x
-@findex org-columns-insert-dblock
-Insert a dynamic block capturing a column view. Prompt for the
-scope or ID of the view.
-
-This command can be invoked by calling
-@code{org-dynamic-block-insert-dblock} (@kbd{C-c C-x x}) and
-selecting ``columnview'' (see @ref{Dynamic Blocks}).
-
-@item @kbd{C-c C-c} @kbd{C-c C-x C-u} (@code{org-dblock-update})
-@kindex C-c C-c
-@kindex C-c C-x C-u
-@findex org-dblock-update
-Update dynamic block at point. point needs to be in the @samp{#+BEGIN}
-line of the dynamic block.
-
-@item @kbd{C-u C-c C-x C-u} (@code{org-update-all-dblocks})
-@kindex C-u C-c C-x C-u
-Update all dynamic blocks (see @ref{Dynamic Blocks}). This is useful if
-you have several clock table blocks, column-capturing blocks or
-other dynamic blocks in a buffer.
-@end table
-
-You can add formulas to the column view table and you may add plotting
-instructions in front of the table---these survive an update of the
-block. If there is a @samp{TBLFM} keyword after the table, the table is
-recalculated automatically after an update.
-
-An alternative way to capture and process property values into a table
-is provided by Eric Schulte's @samp{org-collector.el}, which is
-a contributed package@footnote{Contributed packages are not part of Emacs, but are
-distributed with the main distribution of Org---visit
-@uref{https://orgmode.org}.}. It provides a general API to collect
-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 Dates and Times
-@chapter Dates and Times
-
-@cindex dates
-@cindex times
-@cindex timestamp
-@cindex date stamp
-
-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
-something was created or last changed. However, in Org mode this term
-is used in a much wider sense.
-
-@menu
-* Timestamps:: Assigning a time to a tree entry.
-* Creating Timestamps:: Commands to insert timestamps.
-* Deadlines and Scheduling:: Planning your work.
-* Clocking Work Time:: Tracking how long you spend on a task.
-* Effort Estimates:: Planning work effort in advance.
-* Timers:: Notes with a running timer.
-@end menu
-
-@node Timestamps
-@section Timestamps
-
-@cindex timestamps
-@cindex ranges, time
-@cindex date stamps
-@cindex deadlines
-@cindex scheduling
-
-A timestamp is a specification of a date (possibly with a time or
-a range of times) in a special format, either @samp{<2003-09-16 Tue>} or
-@samp{<2003-09-16 Tue 09:39>} or @samp{<2003-09-16 Tue 12:00-12:30>}@footnote{The Org date format is inspired by the standard ISO 8601
-date/time format. To use an alternative format, see @ref{Custom time format}. The day name is optional when you type the date yourself.
-However, any date inserted or modified by Org adds that day name, for
-reading convenience.}.
-A timestamp can appear anywhere in the headline or body of an Org tree
-entry. Its presence causes entries to be shown on specific dates in
-the agenda (see @ref{Weekly/daily agenda}). We distinguish:
-
-@table @asis
-@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 agenda display, the headline of an entry associated with
-a plain timestamp is shown exactly on that date.
-
-@example
-* Meet Peter at the movies
- <2006-11-01 Wed 19:15>
-* Discussion on climate change
- <2006-11-02 Thu 20:00-22:00>
-@end example
-
-@item Timestamp with repeater interval
-@cindex timestamp, with repeater interval
-A timestamp may contain a @emph{repeater interval}, indicating that it
-applies not only on the given date, but again and again after
-a certain interval of N days (d), weeks (w), months (m), or years
-(y). The following shows up in the agenda every Wednesday:
-
-@example
-* Pick up Sam at school
- <2007-05-16 Wed 12:30 +1w>
-@end example
-
-@item Diary-style expression entries
-@cindex diary style timestamps
-@cindex sexp timestamps
-For more complex date specifications, Org mode supports using the
-special expression diary entries implemented in the Emacs Calendar
-package@footnote{When working with the standard diary expression functions, you
-need to be very careful with the order of the arguments. That order
-depends evilly on the variable @code{calendar-date-style}. For example, to
-specify a date December 12, 2005, the call might look like
-@samp{(diary-date 12 1 2005)} or @samp{(diary-date 1 12 2005)} or @samp{(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 @code{org-anniversary}. These work just
-like the corresponding @code{diary-} functions, but with stable ISO order
-of arguments (year, month, day) wherever applicable, independent of
-the value of @code{calendar-date-style}.}. For example, with optional time:
-
-@example
-* 22:00-23:00 The nerd meeting on every 2nd Thursday of the month
- <%%(diary-float t 4 2)>
-@end example
-
-@item Time/Date range
-@cindex timerange
-@cindex date range
-Two timestamps connected by @samp{--} denote a range. The headline is
-shown on the first and last day of the range, and on any dates that
-are displayed and fall in the range. Here is an example:
-
-@example
-** Meeting in Amsterdam
- <2004-08-23 Mon>--<2004-08-26 Thu>
-@end example
-
-@item Inactive timestamp
-@cindex timestamp, inactive
-@cindex inactive timestamp
-Just like a plain timestamp, but with square brackets instead of
-angular ones. These timestamps are inactive in the sense that they
-do @emph{not} trigger an entry to show up in the agenda.
-
-@example
-* Gillian comes late for the fifth time
- [2006-11-01 Wed]
-@end example
-@end table
-
-@node Creating Timestamps
-@section Creating Timestamps
-
-For Org mode to recognize timestamps, they need to be in the specific
-format. All commands listed below produce timestamps in the correct
-format.
-
-@table @asis
-@item @kbd{C-c .} (@code{org-time-stamp})
-@kindex C-c .
-@findex org-time-stamp
-Prompt for a date and insert a corresponding timestamp. When point
-is at an existing timestamp in the buffer, the command is used to
-modify this timestamp instead of inserting a new one. When this
-command is used twice in succession, a time range is inserted.
-
-@kindex C-u C-c .
-@vindex org-time-stamp-rounding-minutes
-When called with a prefix argument, use the alternative format which
-contains date and time. The default time can be rounded to
-multiples of 5 minutes. See the option
-@code{org-time-stamp-rounding-minutes}.
-
-@kindex C-u C-u C-c .
-With two prefix arguments, insert an active timestamp with the
-current time without prompting.
-
-@item @kbd{C-c !} (@code{org-time-stamp-inactive})
-@kindex C-c !
-@kindex C-u C-c !
-@kindex C-u C-u C-c !
-@findex org-time-stamp-inactive
-Like @kbd{C-c .}, but insert an inactive timestamp that does
-not cause an agenda entry.
-
-@item @kbd{C-c C-c}
-@kindex C-c C-c
-Normalize timestamp, insert or fix day name if missing or wrong.
-
-@item @kbd{C-c <} (@code{org-date-from-calendar})
-@kindex C-c <
-@findex org-date-from-calendar
-Insert a timestamp corresponding to point date in the calendar.
-
-@item @kbd{C-c >} (@code{org-goto-calendar})
-@kindex C-c >
-@findex org-goto-calendar
-Access the Emacs calendar for the current date. If there is
-a timestamp in the current line, go to the corresponding date
-instead.
-
-@item @kbd{C-c C-o} (@code{org-open-at-point})
-@kindex C-c C-o
-@findex org-open-at-point
-Access the agenda for the date given by the timestamp or -range at
-point (see @ref{Weekly/daily agenda}).
-
-@item @kbd{S-@key{LEFT}} (@code{org-timestamp-down-day})
-@itemx @kbd{S-@key{RIGHT}} (@code{org-timestamp-up-day})
-@kindex S-LEFT
-@kindex S-RIGHT
-@findex org-timestamp-down-day
-@findex org-timestamp-up-day
-Change date at point by one day. These key bindings conflict with
-shift-selection and related modes (see @ref{Conflicts}).
-
-@item @kbd{S-@key{UP}} (@code{org-timestamp-up})
-@itemx @kbd{S-@key{DOWN}} (@code{org-timestamp-down})
-@kindex S-UP
-@kindex S-DOWN
-On the beginning or enclosing bracket of a timestamp, change its
-type. Within a timestamp, change the item under point. Point can
-be on a year, month, day, hour or minute. When the timestamp
-contains a time range like @samp{15:30-16:30}, modifying the first time
-also shifts the second, shifting the time block with constant
-length. To change the length, modify the second time. Note that if
-point is in a headline and not at a timestamp, these same keys
-modify the priority of an item (see @ref{Priorities}). The key bindings
-also conflict with shift-selection and related modes (see @ref{Conflicts}).
-
-@item @kbd{C-c C-y} (@code{org-evaluate-time-range})
-@kindex C-c C-y
-@findex org-evaluate-time-range
-@cindex evaluate time range
-Evaluate a time range by computing the difference between start and
-end. With a prefix argument, insert result after the time range (in
-a table: into the following column).
-@end table
-
-@menu
-* The date/time prompt:: How Org mode helps you enter dates and times.
-* Custom time format:: Making dates look different.
-@end menu
-
-@node The date/time prompt
-@subsection The date/time prompt
-
-@cindex date, reading in minibuffer
-@cindex time, reading in minibuffer
-
-@vindex org-read-date-prefer-future
-When Org mode prompts for a date/time, the default is shown in default
-date/time format, and the prompt therefore seems to ask for a specific
-format. But it in fact accepts date/time information in a variety of
-formats. Generally, the information should start at the beginning of
-the string. Org mode finds whatever information is in there and
-derives anything you have not specified from the @emph{default date and
-time}. The default is usually the current date and time, but when
-modifying an existing timestamp, or when entering the second stamp of
-a range, it is taken from the stamp in the buffer. When filling in
-information, Org mode assumes that most of the time you want to enter
-a date in the future: if you omit the month/year and the given
-day/month is @emph{before} today, it assumes that you mean a future
-date@footnote{See the variable @code{org-read-date-prefer-future}. You may set
-that variable to the symbol @code{time} to even make a time before now
-shift the date to tomorrow.}. If the date has been automatically shifted into the
-future, the time prompt shows this with @samp{(=>F)}.
-
-For example, let's assume that today is @strong{June 13, 2006}. Here is how
-various inputs are interpreted, the items filled in by Org mode are in
-@strong{bold}.
-
-@multitable {aaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{3-2-5}
-@tab @result{} 2003-02-05
-@item @samp{2/5/3}
-@tab @result{} 2003-02-05
-@item @samp{14}
-@tab @result{} @strong{2006}-@strong{06}-14
-@item @samp{12}
-@tab @result{} @strong{2006}-@strong{07}-12
-@item @samp{2/5}
-@tab @result{} @strong{2007}-02-05
-@item @samp{Fri}
-@tab @result{} nearest Friday (default date or later)
-@item @samp{sep 15}
-@tab @result{} @strong{2006}-09-15
-@item @samp{feb 15}
-@tab @result{} @strong{2007}-02-15
-@item @samp{sep 12 9}
-@tab @result{} 2009-09-12
-@item @samp{12:45}
-@tab @result{} @strong{2006}-@strong{06}-@strong{13} 12:45
-@item @samp{22 sept 0:34}
-@tab @result{} @strong{2006}-09-22 0:34
-@item @samp{w4}
-@tab @result{} ISO week for of the current year @strong{2006}
-@item @samp{2012 w4 fri}
-@tab @result{} Friday of ISO week 4 in 2012
-@item @samp{2012-w04-5}
-@tab @result{} Same as above
-@end multitable
-
-Furthermore you can specify a relative date by giving, as the @emph{first}
-thing in the input: a plus/minus sign, a number and a letter---@samp{d},
-@samp{w}, @samp{m} or @samp{y}---to indicate change in days, weeks, months, or
-years. With a single plus or minus, the date is always relative to
-today. With a double plus or minus, it is relative to the default
-date. If instead of a single letter, you use the abbreviation of day
-name, the date is the Nth such day, e.g.:
-
-@multitable {aaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{+0}
-@tab @result{} today
-@item @samp{.}
-@tab @result{} today
-@item @samp{+4d}
-@tab @result{} four days from today
-@item @samp{+4}
-@tab @result{} same as +4d
-@item @samp{+2w}
-@tab @result{} two weeks from today
-@item @samp{++5}
-@tab @result{} five days from default date
-@item @samp{+2tue}
-@tab @result{} second Tuesday from now
-@end multitable
-
-@vindex parse-time-months
-@vindex parse-time-weekdays
-The function understands English month and weekday abbreviations. If
-you want to use un-abbreviated names and/or other languages, configure
-the variables @code{parse-time-months} and @code{parse-time-weekdays}.
-
-@vindex org-read-date-force-compatible-dates
-Not all dates can be represented in a given Emacs implementation. By
-default Org mode forces dates into the compatibility range 1970--2037
-which works on all Emacs implementations. If you want to use dates
-outside of this range, read the docstring of the variable
-@code{org-read-date-force-compatible-dates}.
-
-You can specify a time range by giving start and end times or by
-giving a start time and a duration (in HH:MM format). Use one or two
-dash(es) as the separator in the former case and use @samp{+} as the
-separator in the latter case, e.g.:
-
-@multitable {aaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaa}
-@item @samp{11am-1:15pm}
-@tab @result{} 11:00-13:15
-@item @samp{11am--1:15pm}
-@tab @result{} same as above
-@item @samp{11am+2:15}
-@tab @result{} same as above
-@end multitable
-
-@cindex calendar, for selecting date
-@vindex org-popup-calendar-for-date-prompt
-Parallel to the minibuffer prompt, a calendar is popped up@footnote{If you do not need/want the calendar, configure the variable
-@code{org-popup-calendar-for-date-prompt}.}.
-When you exit the date prompt, either by clicking on a date in the
-calendar, or by pressing @kbd{@key{RET}}, the date selected in the
-calendar is combined with the information entered at the prompt. You
-can control the calendar fully from the minibuffer:
-
-@kindex <
-@kindex >
-@kindex M-v
-@kindex C-v
-@kindex mouse-1
-@kindex S-RIGHT
-@kindex S-LEFT
-@kindex S-DOWN
-@kindex S-UP
-@kindex M-S-RIGHT
-@kindex M-S-LEFT
-@kindex RET
-@kindex .
-@kindex C-.
-@multitable @columnfractions 0.25 0.55
-@item @kbd{@key{RET}}
-@tab Choose date at point in calendar.
-@item @kbd{mouse-1}
-@tab Select date by clicking on it.
-@item @kbd{S-@key{RIGHT}}
-@tab One day forward.
-@item @kbd{S-@key{LEFT}}
-@tab One day backward.
-@item @kbd{S-@key{DOWN}}
-@tab One week forward.
-@item @kbd{S-@key{UP}}
-@tab One week backward.
-@item @kbd{M-S-@key{RIGHT}}
-@tab One month forward.
-@item @kbd{M-S-@key{LEFT}}
-@tab One month backward.
-@item @kbd{>}
-@tab Scroll calendar forward by one month.
-@item @kbd{<}
-@tab Scroll calendar backward by one month.
-@item @kbd{M-v}
-@tab Scroll calendar forward by 3 months.
-@item @kbd{C-v}
-@tab Scroll calendar backward by 3 months.
-@item @kbd{C-.}
-@tab Select today's date@footnote{You can also use the calendar command @kbd{.} to jump to
-today's date, but if you are inserting an hour specification for your
-timestamp, @kbd{.} will then insert a dot after the hour. By contrast,
-@kbd{C-.} will always jump to today's date.}
-@end multitable
-
-@vindex org-read-date-display-live
-The actions of the date/time prompt may seem complex, but I assure you
-they will grow on you, and you will start getting annoyed by pretty
-much any other way of entering a date/time out there. To help you
-understand what is going on, the current interpretation of your input
-is displayed live in the minibuffer@footnote{If you find this distracting, turn off the display with
-@code{org-read-date-display-live}.}.
-
-@node Custom time format
-@subsection Custom time format
-
-@cindex custom date/time format
-@cindex time format, custom
-@cindex date format, custom
-
-@vindex org-display-custom-times
-@vindex org-time-stamp-custom-formats
-Org mode uses the standard ISO notation for dates and times as it is
-defined in ISO 8601. If you cannot get used to this and require
-another representation of date and time to keep you happy, you can get
-it by customizing the variables @code{org-display-custom-times} and
-@code{org-time-stamp-custom-formats}.
-
-@table @asis
-@item @kbd{C-c C-x C-t} (@code{org-toggle-time-stamp-overlays})
-@kindex C-c C-x C-t
-@findex org-toggle-time-stamp-overlays
-Toggle the display of custom formats for dates and times.
-@end table
-
-Org mode needs the default format for scanning, so the custom
-date/time format does not @emph{replace} the default format. Instead, it
-is put @emph{over} the default format using text properties. This has the
-following consequences:
-
-@itemize
-@item
-You cannot place point onto a timestamp anymore, only before or
-after.
-
-@item
-The @kbd{S-@key{UP}} and @kbd{S-@key{DOWN}} keys can no longer be used
-to adjust each component of a timestamp. If point is at the
-beginning of the stamp, @kbd{S-@key{UP}} and @kbd{S-@key{DOWN}} change
-the stamp by one day, just like @kbd{S-@key{LEFT}}
-@kbd{S-@key{RIGHT}}. At the end of the stamp, change the time by one
-minute.
-
-@item
-If the timestamp contains a range of clock times or a repeater,
-these are not overlaid, but remain in the buffer as they were.
-
-@item
-When you delete a timestamp character-by-character, it only
-disappears from the buffer after @emph{all} (invisible) characters
-belonging to the ISO timestamp have been removed.
-
-@item
-If the custom timestamp format is longer than the default and you
-are using dates in tables, table alignment will be messed up. If
-the custom format is shorter, things do work as expected.
-@end itemize
-
-@node Deadlines and Scheduling
-@section Deadlines and Scheduling
-
-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 @asis
-@item @samp{DEADLINE}
-@cindex @samp{DEADLINE} marker
-Meaning: the task---most likely a TODO item, though not
-necessarily---is supposed to be finished on that date.
-
-@vindex org-deadline-warning-days
-On the deadline date, the task is listed in the agenda. In
-addition, the agenda for @emph{today} carries a warning about the
-approaching or missed deadline, starting @code{org-deadline-warning-days}
-before the due date, and continuing until the entry is marked as
-done. An example:
-
-@example
-*** TODO write article about the Earth for the Guide
- DEADLINE: <2004-02-29 Sun>
- The editor in charge is [[bbdb:Ford Prefect]]
-@end example
-
-@vindex org-agenda-skip-deadline-prewarning-if-scheduled
-You can specify a different lead time for warnings for a specific
-deadlines using the following syntax. Here is an example with
-a warning period of 5 days @samp{DEADLINE: <2004-02-29 Sun -5d>}. This
-warning is deactivated if the task gets scheduled and you set
-@code{org-agenda-skip-deadline-prewarning-if-scheduled} to @code{t}.
-
-@item @samp{SCHEDULED}
-@cindex @samp{SCHEDULED} marker
-Meaning: you are planning to start working on that task on the given
-date.
-
-@vindex org-agenda-skip-scheduled-if-done
-The headline is listed under the given date@footnote{It will still be listed on that date after it has been marked
-as done. If you do not like this, set the variable
-@code{org-agenda-skip-scheduled-if-done}.}. In addition,
-a reminder that the scheduled date has passed is present in the
-compilation for @emph{today}, until the entry is marked as done, i.e.,
-the task is automatically forwarded until completed.
-
-@example
-*** TODO Call Trillian for a date on New Years Eve.
- SCHEDULED: <2004-12-25 Sat>
-@end example
-
-@vindex org-scheduled-delay-days
-@vindex org-agenda-skip-scheduled-delay-if-deadline
-If you want to @emph{delay} the display of this task in the agenda, use
-@samp{SCHEDULED: <2004-12-25 Sat -2d>}: the task is still scheduled on
-the 25th but will appear two days later. In case the task contains
-a repeater, the delay is considered to affect all occurrences; if
-you want the delay to only affect the first scheduled occurrence of
-the task, use @samp{--2d} instead. See @code{org-scheduled-delay-days} and
-@code{org-agenda-skip-scheduled-delay-if-deadline} for details on how to
-control this globally or per agenda.
-
-@quotation Important
-Scheduling an item in Org mode should @emph{not} be understood in the
-same way that we understand @emph{scheduling a meeting}. Setting a date
-for a meeting is just a simple appointment, you should mark this
-entry with a simple plain timestamp, to get this item shown on the
-date where it applies. This is a frequent misunderstanding by Org
-users. In Org mode, @emph{scheduling} means setting a date when you want
-to start working on an action item.
-
-@end quotation
-@end table
-
-You may use timestamps with repeaters in scheduling and deadline
-entries. Org mode issues early and late warnings based on the
-assumption that the timestamp represents the @emph{nearest instance} of the
-repeater. However, the use of diary expression entries like
-
-@example
-<%%(diary-float t 42)>
-@end example
-
-
-@noindent
-in scheduling and deadline timestamps is limited. Org mode does not
-know enough about the internals of each function to issue early and
-late warnings. However, it shows the item on each day where the
-expression entry matches.
-
-@menu
-* Inserting deadline/schedule:: Planning items.
-* Repeated tasks:: Items that show up again and again.
-@end menu
-
-@node Inserting deadline/schedule
-@subsection Inserting deadlines or schedules
-
-The following commands allow you to quickly insert a deadline or to
-schedule an item:@footnote{The @samp{SCHEDULED} and @samp{DEADLINE} dates are inserted on the line
-right below the headline. Do not put any text between this line and
-the headline.}
-
-@table @asis
-@item @kbd{C-c C-d} (@code{org-deadline})
-@kindex C-c C-d
-@findex org-deadline
-@vindex org-log-redeadline
-Insert @samp{DEADLINE} keyword along with a stamp. The insertion happens
-in the line directly following the headline. Remove any @samp{CLOSED}
-timestamp . When called with a prefix argument, also remove any
-existing deadline from the entry. Depending on the variable
-@code{org-log-redeadline}, take a note when changing an existing
-deadline@footnote{Note the corresponding @samp{STARTUP} options @samp{logredeadline},
-@samp{lognoteredeadline}, and @samp{nologredeadline}.}.
-
-@item @kbd{C-c C-s} (@code{org-schedule})
-@kindex C-c C-s
-@findex org-schedule
-@vindex org-log-reschedule
-Insert @samp{SCHEDULED} keyword along with a stamp. The insertion
-happens in the line directly following the headline. Remove any
-@samp{CLOSED} timestamp. When called with a prefix argument, also remove
-the scheduling date from the entry. Depending on the variable
-@code{org-log-reschedule}, take a note when changing an existing
-scheduling time@footnote{Note the corresponding @samp{STARTUP} options @samp{logreschedule},
-@samp{lognotereschedule}, and @samp{nologreschedule}.}.
-
-@item @kbd{C-c / d} (@code{org-check-deadlines})
-@kindex C-c / d
-@findex org-check-deadlines
-@cindex sparse tree, for deadlines
-@vindex org-deadline-warning-days
-Create a sparse tree with all deadlines that are either past-due, or
-which will become due within @code{org-deadline-warning-days}. With
-@kbd{C-u} prefix, show all deadlines in the file. With
-a numeric prefix, check that many days. For example, @kbd{C-1 C-c / d} shows all deadlines due tomorrow.
-
-@item @kbd{C-c / b} (@code{org-check-before-date})
-@kindex C-c / b
-@findex org-check-before-date
-Sparse tree for deadlines and scheduled items before a given date.
-
-@item @kbd{C-c / a} (@code{org-check-after-date})
-@kindex C-c / a
-@findex org-check-after-date
-Sparse tree for deadlines and scheduled items after a given date.
-@end table
-
-Note that @code{org-schedule} and @code{org-deadline} supports setting the date
-by indicating a relative time e.g., @samp{+1d} sets the date to the next
-day after today, and @samp{--1w} sets the date to the previous week before
-any current timestamp.
-
-@node Repeated tasks
-@subsection Repeated tasks
-
-@cindex tasks, repeated
-@cindex repeated tasks
-
-Some tasks need to be repeated again and again. Org mode helps to
-organize such tasks using a so-called repeater in a @samp{DEADLINE},
-@samp{SCHEDULED}, or plain timestamps@footnote{Org does not repeat inactive timestamps, however. See
-@ref{Timestamps}.}. In the following example:
-
-@example
-** TODO Pay the rent
- DEADLINE: <2005-10-01 Sat +1m>
-@end example
-
-@noindent
-the @samp{+1m} is a repeater; the intended interpretation is that the task
-has a deadline on @samp{<2005-10-01>} and repeats itself every (one) month
-starting from that time. You can use yearly, monthly, weekly, daily
-and hourly repeat cookies by using the @samp{y}, @samp{m}, @samp{w}, @samp{d} and @samp{h}
-letters. If you need both a repeater and a special warning period in
-a deadline entry, the repeater should come first and the warning
-period last
-
-@example
-DEADLINE: <2005-10-01 Sat +1m -3d>
-@end example
-
-
-@vindex org-todo-repeat-to-state
-Deadlines and scheduled items produce entries in the agenda when they
-are over-due, so it is important to be able to mark such an entry as
-done once you have done so. When you mark a @samp{DEADLINE} or
-a @samp{SCHEDULED} with the TODO keyword @samp{DONE}, it no longer produces
-entries in the agenda. The problem with this is, however, is that
-then also the @emph{next} instance of the repeated entry will not be
-active. Org mode deals with this in the following way: when you try
-to mark such an entry as done, using @kbd{C-c C-t}, it shifts the
-base date of the repeating timestamp by the repeater interval, and
-immediately sets the entry state back to TODO@footnote{In fact, the target state is taken from, in this sequence, the
-@samp{REPEAT_TO_STATE} property, the variable @code{org-todo-repeat-to-state} if
-it is a string, the previous TODO state if @code{org-todo-repeat-to-state}
-is @code{t}, or the first state of the TODO state sequence.}. In the example
-above, setting the state to @samp{DONE} would actually switch the date like
-this:
-
-@example
-** TODO Pay the rent
- DEADLINE: <2005-11-01 Tue +1m>
-@end example
-
-To mark a task with a repeater as DONE, use @kbd{C-- 1 C-c C-t},
-i.e., @code{org-todo} with a numeric prefix argument of @samp{-1}.
-
-@vindex org-log-repeat
-A timestamp@footnote{You can change this using the option @code{org-log-repeat}, or the
-@samp{STARTUP} options @samp{logrepeat}, @samp{lognoterepeat}, and @samp{nologrepeat}.
-With @samp{lognoterepeat}, you will also be prompted for a note.} is added under the deadline, to keep a record that
-you actually acted on the previous instance of this deadline.
-
-As a consequence of shifting the base date, this entry is no longer
-visible in the agenda when checking past dates, but all future
-instances will be visible.
-
-With the @samp{+1m} cookie, the date shift is always exactly one month. So
-if you have not paid the rent for three months, marking this entry
-DONE still keeps it as an overdue deadline. Depending on the task,
-this may not be the best way to handle it. For example, if you forgot
-to call your father for 3 weeks, it does not make sense to call him
-3 times in a single day to make up for it. Finally, there are tasks,
-like changing batteries, which should always repeat a certain time
-@emph{after} the last time you did it. For these tasks, Org mode has
-special repeaters @samp{++} and @samp{.+}. For example:
-
-@example
-** TODO Call Father
- DEADLINE: <2008-02-10 Sun ++1w>
- Marking this DONE shifts the date by at least one week, 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 shifts 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 shifts the date to one month after today.
-
-** TODO Wash my hands
- DEADLINE: <2019-04-05 08:00 Sun .+1h>
- Marking this DONE shifts the date to exactly one hour from now.
-@end example
-
-@vindex org-agenda-skip-scheduled-if-deadline-is-shown
-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}. 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.
-
-An alternative to using a repeater is to create a number of copies of
-a task 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
-@section Clocking Work Time
-
-@cindex clocking time
-@cindex time clocking
-
-Org mode allows you to clock the time you spend on specific tasks in
-a project. When you start working on an item, you can start the
-clock. When 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 hard-coded 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
-(setq org-clock-persist 'history)
-(org-clock-persistence-insinuate)
-@end lisp
-
-@vindex org-clock-persist
-When you clock into a new task after resuming Emacs, the incomplete
-clock@footnote{To resume the clock under the assumption that you have worked
-on this task while outside Emacs, use @samp{(setq org-clock-persist t)}.} is retrieved (see @ref{Resolving idle time (1)}) and you are
-prompted about what to do with it.
-
-@menu
-* Clocking commands:: Starting and stopping a clock.
-* The clock table:: Detailed reports.
-* Resolving idle time:: Resolving time when you've been idle.
-@end menu
-
-@node Clocking commands
-@subsection Clocking commands
-
-@table @asis
-@item @kbd{C-c C-x C-i} (@code{org-clock-in})
-@kindex C-c C-x C-i
-@findex org-clock-in
-@vindex org-clock-into-drawer
-@vindex org-clock-continuously
-@cindex @samp{LOG_INTO_DRAWER}, property
-Start the clock on the current item (clock-in). This inserts the
-@samp{CLOCK} keyword together with a timestamp. If this is not the first
-clocking of this item, the multiple @samp{CLOCK} lines are wrapped into
-a @samp{LOGBOOK} drawer (see also the variable @code{org-clock-into-drawer}).
-You can also overrule the setting of this variable for a subtree by
-setting a @samp{CLOCK_INTO_DRAWER} or @samp{LOG_INTO_DRAWER} property. When
-called with a @kbd{C-u} prefix argument, select the task from
-a list of recently clocked tasks. With two @kbd{C-u C-u}
-prefixes, clock into the task at point and mark it as the default
-task; the default task is always be available with letter
-@kbd{d} when selecting a clocking task. With three @kbd{C-u C-u C-u} prefixes, force continuous clocking by starting the
-clock when the last clock stopped.
-
-@cindex @samp{CLOCK_MODELINE_TOTAL}, property
-@cindex @samp{LAST_REPEAT}, property
-@vindex org-clock-mode-line-total
-@vindex org-clock-in-prepare-hook
-While the clock is running, Org shows the current clocking time in
-the mode line, along with the title of the task. The clock time
-shown is all time ever clocked for this task and its children. If
-the task has an effort estimate (see @ref{Effort Estimates}), the mode
-line displays the current clocking time against it@footnote{To add an effort estimate ``on the fly'', hook a function doing
-this to @code{org-clock-in-prepare-hook}.}. If the
-task is a repeating one (see @ref{Repeated tasks}), show only the time
-since the last reset of the task@footnote{The last reset of the task is recorded by the @samp{LAST_REPEAT}
-property.}. You can exercise more
-control over show time with the @samp{CLOCK_MODELINE_TOTAL} property. It
-may have the values @samp{current} to show only the current clocking
-instance, @samp{today} to show all time clocked on this tasks 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-mode-line-total}.}. Clicking with
-@kbd{mouse-1} onto the mode line entry pops up a menu with
-clocking options.
-
-@item @kbd{C-c C-x C-o} (@code{org-clock-out})
-@kindex C-c C-x C-o
-@findex org-clock-out
-@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{=>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: @samp{#+STARTUP:
-lognoteclock-out}.}.
-
-@item @kbd{C-c C-x C-x} (@code{org-clock-in-last})
-@kindex C-c C-x C-x
-@findex org-clock-in-last
-@vindex org-clock-continuously
-Re-clock the last clocked task. With one @kbd{C-u} prefix
-argument, select the task from the clock history. With two
-@kbd{C-u} prefixes, force continuous clocking by starting the
-clock when the last clock stopped.
-
-@item @kbd{C-c C-x C-e} (@code{org-clock-modify-effort-estimate})
-@kindex C-c C-x C-e
-@findex org-clock-modify-effort-estimate
-Update the effort estimate for the current clock task.
-
-@item @kbd{C-c C-c} or @kbd{C-c C-y} (@code{org-evaluate-time-range})
-@kindex C-c C-c
-@kindex C-c C-y
-@findex org-evaluate-time-range
-Recompute the time interval after changing one of the timestamps.
-This is only necessary if you edit the timestamps directly. If you
-change them with @kbd{S-<cursor>} keys, the update is
-automatic.
-
-@item @kbd{C-S-@key{UP}} (@code{org-clock-timestamps-up})
-@itemx @kbd{C-S-@key{DOWN}} (@code{org-clock-timestamps-down})
-@kindex C-S-UP
-@findex org-clock-timestamps-up
-@kindex C-S-DOWN
-@findex org-clock-timestamps-down
-On CLOCK log lines, increase/decrease both timestamps so that the
-clock duration keeps the same value.
-
-@item @kbd{S-M-@key{UP}} (@code{org-timestamp-up})
-@itemx @kbd{S-M-@key{DOWN}} (@code{org-timestamp-down})
-@kindex S-M-UP
-@findex org-clock-timestamp-up
-@kindex S-M-DOWN
-@findex org-clock-timestamp-down
-On @samp{CLOCK} log lines, increase/decrease the timestamp at point and
-the one of the previous, or the next, clock timestamp by the same
-duration. For example, if you hit @kbd{S-M-@key{UP}} to increase
-a clocked-out timestamp by five minutes, then the clocked-in
-timestamp of the next clock is increased by five minutes.
-
-@item @kbd{C-c C-t} (@code{org-todo})
-@kindex C-c C-t
-@findex org-todo
-Changing the TODO state of an item to DONE automatically stops the
-clock if it is running in this same item.
-
-@item @kbd{C-c C-x C-q} (@code{org-clock-cancel})
-@kindex C-c C-x C-q
-@findex org-clock-cancel
-Cancel the current clock. This is useful if a clock was started by
-mistake, or if you ended up working on something else.
-
-@item @kbd{C-c C-x C-j} (@code{org-clock-goto})
-@kindex C-c C-x C-j
-@findex or-clock-goto
-Jump to the headline of the currently clocked in task. With
-a @kbd{C-u} prefix argument, select the target task from a list
-of recently clocked tasks.
-
-@item @kbd{C-c C-x C-d} (@code{org-clock-display})
-@kindex C-c C-x C-d
-@findex org-clock-display
-@vindex org-remove-highlights-with-change
-Display time summaries for each subtree in the current buffer. This
-puts overlays at the end of each headline, showing the total time
-recorded under that heading, including the time of any subheadings.
-You can use visibility cycling to study the tree, but the overlays
-disappear when you change the 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 agenda (see @ref{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 do not modify the window disposition.
-
-@node The clock table
-@subsection The clock table
-
-@cindex clocktable, dynamic block
-@cindex report, of clocked time
-
-Org mode can produce quite complex reports based on the time clocking
-information. Such a report is called a @emph{clock table}, because it is
-formatted as one or several Org tables.
-
-@table @asis
-@item @code{org-clock-report}
-@kindex C-c C-x x
-@findex org-clock-report
-Insert or update a clock table. When called with a prefix argument,
-jump to the first clock table in the current document and update it.
-The clock table includes archived trees.
-
-This command can be invoked by calling
-@code{org-dynamic-block-insert-dblock} (@kbd{C-c C-x x}) and
-selecting ``clocktable'' (see @ref{Dynamic Blocks}).
-
-@item @kbd{C-c C-c} or @kbd{C-c C-x C-u} (@code{org-dblock-update})
-@kindex C-c C-c
-@kindex C-c C-x C-u
-@findex org-dblock-update
-Update dynamic block at point. Point needs to be in the @samp{BEGIN}
-line of the dynamic block.
-
-@item @kbd{C-u C-c C-x C-u}
-@kindex C-u C-c C-x C-u
-Update all dynamic blocks (see @ref{Dynamic Blocks}). This is useful if
-you have several clock table blocks in a buffer.
-
-@item @kbd{S-@key{LEFT}}
-@itemx @kbd{S-@key{RIGHT}} (@code{org-clocktable-try-shift})
-@kindex S-LEFT
-@kindex S-RIGHT
-@findex org-clocktable-try-shift
-Shift the current @samp{:block} interval and update the table. Point
-needs to be in the @samp{#+BEGIN: clocktable} line for this command. If
-@samp{:block} is @samp{today}, it is shifted to @samp{today-1}, etc.
-@end table
-
-Here is an example of the frame for a clock table as it is inserted
-into the buffer by @code{org-clock-report}:
-
-@cindex @samp{BEGIN clocktable}
-@example
-#+BEGIN: clocktable :maxlevel 2 :emphasize nil :scope file
-#+END: clocktable
-@end example
-
-@vindex org-clocktable-defaults
-The @samp{#+BEGIN} line contains options to define the scope, structure,
-and formatting of the report. Defaults for all these options can be
-configured in the variable @code{org-clocktable-defaults}.
-
-First there are options that determine which clock entries are to
-be selected:
-
-@table @asis
-@item @samp{:maxlevel}
-Maximum level depth to which times are listed in the table. Clocks
-at deeper levels are summed into the upper level.
-
-@item @samp{:scope}
-The scope to consider. This can be any of the following:
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{nil}
-@tab the current buffer or narrowed region
-@item @samp{file}
-@tab the full current buffer
-@item @samp{subtree}
-@tab the subtree where the clocktable is located
-@item @samp{treeN}
-@tab the surrounding level N tree, for example @samp{tree3}
-@item @samp{tree}
-@tab the surrounding level 1 tree
-@item @samp{agenda}
-@tab all agenda files
-@item @samp{("file" ...)}
-@tab scan these files
-@item @samp{FUNCTION}
-@tab scan files returned by calling @var{FUNCTION} with no argument
-@item @samp{file-with-archives}
-@tab current file and its archives
-@item @samp{agenda-with-archives}
-@tab all agenda files, including archives
-@end multitable
-
-@item @samp{:block}
-The time block to consider. This block is specified either
-absolutely, or relative to the current time and may be any of these
-formats:
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaa}
-@item @samp{2007-12-31}
-@tab New year eve 2007
-@item @samp{2007-12}
-@tab December 2007
-@item @samp{2007-W50}
-@tab ISO-week 50 in 2007
-@item @samp{2007-Q2}
-@tab 2nd quarter in 2007
-@item @samp{2007}
-@tab the year 2007
-@item @samp{today}, @samp{yesterday}, @samp{today-N}
-@tab a relative day
-@item @samp{thisweek}, @samp{lastweek}, @samp{thisweek-N}
-@tab a relative week
-@item @samp{thismonth}, @samp{lastmonth}, @samp{thismonth-N}
-@tab a relative month
-@item @samp{thisyear}, @samp{lastyear}, @samp{thisyear-N}
-@tab a relative year
-@item @samp{untilnow}@footnote{When using @code{:step}, @code{untilnow} starts from the beginning of
-2003, not the beginning of time.}
-@tab all clocked time ever
-@end multitable
-
-@vindex org-clock-display-default-range
-When this option is not set, Org falls back to the value in
-@code{org-clock-display-default-range}, which defaults to the current
-year.
-
-Use @kbd{S-@key{LEFT}} or @kbd{S-@key{RIGHT}} to shift the time
-interval.
-
-@item @samp{:tstart}
-A time string specifying when to start considering times. Relative
-times like @samp{"<-2w>"} can also be used. See @ref{Matching tags and properties} for relative time syntax.
-
-@item @samp{:tend}
-A time string specifying when to stop considering times. Relative
-times like @samp{"<now>"} can also be used. See @ref{Matching tags and properties} for relative time syntax.
-
-@item @samp{:wstart}
-The starting day of the week. The default is 1 for Monday.
-
-@item @samp{:mstart}
-The starting day of the month. The default is 1 for the first.
-
-@item @samp{:step}
-Set to @samp{day}, @samp{week}, @samp{semimonth}, @samp{month}, or @samp{year} to split the
-table into chunks. To use this, either @samp{:block}, or @samp{:tstart} and
-@samp{:tend} are required.
-
-@item @samp{:stepskip0}
-When non-@code{nil}, do not show steps that have zero time.
-
-@item @samp{:fileskip0}
-When non-@code{nil}, do not show table sections from files which did not
-contribute.
-
-@item @samp{:match}
-A tags match to select entries that should contribute. See
-@ref{Matching tags and properties} for the match syntax.
-@end table
-
-@findex org-clocktable-write-default
-Then there are options that determine the formatting of the table.
-There options are interpreted by the function
-@code{org-clocktable-write-default}, but you can specify your own function
-using the @samp{:formatter} parameter.
-
-@table @asis
-@item @samp{:emphasize}
-When non-@code{nil}, emphasize level one and level two items.
-
-@item @samp{:lang}
-Language@footnote{Language terms can be set through the variable
-@code{org-clock-clocktable-language-setup}.} to use for descriptive cells like ``Task''.
-
-@item @samp{:link}
-Link the item headlines in the table to their origins.
-
-@item @samp{:narrow}
-An integer to limit the width of the headline column in the Org
-table. If you write it like @samp{50!}, then the headline is also
-shortened in export.
-
-@item @samp{:indent}
-Indent each headline field according to its level.
-
-@item @samp{:hidefiles}
-Hide the file column when multiple files are used to produce the
-table.
-
-@item @samp{:tcolumns}
-Number of columns to be used for times. If this is smaller than
-@samp{:maxlevel}, lower levels are lumped into one column.
-
-@item @samp{:level}
-Should a level number column be included?
-
-@item @samp{:sort}
-A cons cell containing the column to sort and a sorting type. E.g.,
-@samp{:sort (1 . ?a)} sorts the first column alphabetically.
-
-@item @samp{:compact}
-Abbreviation for @samp{:level nil :indent t :narrow 40! :tcolumns 1}.
-All are overwritten except if there is an explicit @samp{:narrow}.
-
-@item @samp{:timestamp}
-A timestamp for the entry, when available. Look for @samp{SCHEDULED},
-@samp{DEADLINE}, @samp{TIMESTAMP} and @samp{TIMESTAMP_IA} special properties (see
-@ref{Special Properties}), in this order.
-
-@item @samp{:tags}
-When this flag is non-@code{nil}, show the headline's tags.
-
-@item @samp{:properties}
-List of properties shown in the table. Each property gets its own
-column.
-
-@item @samp{:inherit-props}
-When this flag is non-@code{nil}, the values for @samp{:properties} are
-inherited.
-
-@item @samp{:formula}
-Content of a @samp{TBLFM} keyword to be added and evaluated. As
-a special case, @samp{:formula %} adds a column with % time. If you do
-not specify a formula here, any existing formula below the clock
-table survives updates and is evaluated.
-
-@item @samp{:formatter}
-A function to format clock data and insert it into the buffer.
-@end table
-
-To get a clock summary of the current level 1 tree, for the current
-day, you could write:
-
-@example
-#+BEGIN: clocktable :maxlevel 2 :block today :scope tree1 :link t
-#+END: clocktable
-@end example
-
-@noindent
-To use a specific time range you could write@footnote{Note that all parameters must be specified in a single
-line---the line is broken here only to fit it into the manual.}
-
-@example
-#+BEGIN: clocktable :tstart "<2006-08-10 Thu 10:00>"
- :tend "<2006-08-10 Thu 12:00>"
-#+END: clocktable
-@end example
-
-@noindent
-A range starting a week ago and ending right now could be written as
-
-@example
-#+BEGIN: clocktable :tstart "<-1w>" :tend "<now>"
-#+END: clocktable
-@end example
-
-@noindent
-A summary of the current subtree with % times would be
-
-@example
-#+BEGIN: clocktable :scope subtree :link t :formula %
-#+END: clocktable
-@end example
-
-@noindent
-A horizontally compact representation of everything clocked during
-last week would be
-
-@example
-#+BEGIN: clocktable :scope agenda :block lastweek :compact t
-#+END: clocktable
-@end example
-
-@node Resolving idle time
-@subsection Resolving idle time and continuous clocking
-
-
-
-@anchor{Resolving idle time (1)}
-@subsubheading Resolving idle time
-
-@cindex resolve idle time
-@cindex idle, resolve, dangling
-
-If you clock in on a work item, and then walk away from your
-computer---perhaps to take a phone call---you often need to
-``resolve'' the time you were away by either subtracting it from the
-current clock, or applying it to another one.
-
-@vindex org-clock-idle-time
-@vindex org-clock-x11idle-program-name
-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, idleness is based on actual user
-idleness, not just Emacs' idle time. For X11, you can install
-a utility program @samp{x11idle.c}, available in the @samp{contrib/scripts/}
-directory of the Org Git distribution, or install the xprintidle
-package and set it to the variable @code{org-clock-x11idle-program-name} if
-you are running Debian, to get the same general treatment of idleness.
-On other systems, idle time refers to Emacs idle time only.}, and ask what
-you want to do with the idle time. There will be a question waiting
-for you when you get back, indicating how much idle time has passed
-constantly updated with the current amount, as well as a set of
-choices to correct the discrepancy:
-
-@table @asis
-@item @kbd{k}
-@kindex k
-To keep some or all of the minutes and stay clocked in, press
-@kbd{k}. Org asks how many of the minutes to keep. Press
-@kbd{@key{RET}} to keep them all, effectively changing nothing, or
-enter a number to keep that many minutes.
-
-@item @kbd{K}
-@kindex K
-If you use the shift key and press @kbd{K}, it keeps however
-many minutes you request and then immediately clock out of that
-task. If you keep all of the minutes, this is the same as just
-clocking out of the current task.
-
-@item @kbd{s}
-@kindex s
-To keep none of the minutes, use @kbd{s} to subtract all the
-away time from the clock, and then check back in from the moment you
-returned.
-
-@item @kbd{S}
-@kindex S
-To keep none of the minutes and just clock out at the start of the
-away time, use the shift key and press @kbd{S}. Remember that
-using shift always leave you clocked out, no matter which option you
-choose.
-
-@item @kbd{C}
-@kindex C
-To cancel the clock altogether, use @kbd{C}. Note that if
-instead of canceling you subtract the away time, and the resulting
-clock amount is less than a minute, the clock is still canceled
-rather than cluttering up the log with an empty entry.
-@end table
-
-What if you subtracted those away minutes from the current clock, and
-now want to apply them to a new clock? Simply clock in to any task
-immediately after the subtraction. Org will notice that you have
-subtracted time ``on the books'', so to speak, and will ask if you want
-to apply those minutes to the next task you clock in on.
-
-There is one other instance when this clock resolution magic occurs.
-Say you were clocked in and hacking away, and suddenly your cat chased
-a mouse who scared a hamster that crashed into your UPS's power
-button! You suddenly lose all your buffers, but thanks to auto-save
-you still have your recent Org mode changes, including your last clock
-in.
-
-If you restart Emacs and clock into any task, Org will notice that you
-have a dangling clock which was never clocked out from your last
-session. Using that clock's starting time as the beginning of the
-unaccounted-for period, Org will ask how you want to resolve that
-time. The logic and behavior is identical to dealing with away time
-due to idleness; it is just happening due to a recovery event rather
-than a set amount of idle time.
-
-You can also check all the files visited by your Org agenda for
-dangling clocks at any time using @kbd{M-x org-resolve-clocks @key{RET}} (or @kbd{C-c C-x C-z}).
-
-@anchor{Continuous clocking}
-@subsubheading Continuous clocking
-
-@cindex continuous clocking
-
-@vindex org-clock-continuously
-You may want to start clocking from the time when you clocked out the
-previous task. To enable this systematically, set
-@code{org-clock-continuously} to non-@code{nil}. Each time you clock in, Org
-retrieves the clock-out time of the 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}.
-
-@anchor{Clocking out automatically after some idle time}
-@subsubheading Clocking out automatically after some idle time
-
-@cindex auto clocking out after idle time
-
-@vindex org-clock-auto-clockout-timer
-When you often forget to clock out before being idle and you don't
-want to manually set the clocking time to take into account, you can
-set @code{org-clock-auto-clockout-timer} to a number of seconds and add
-@samp{(org-clock-auto-clockout-insinuate)} to your @samp{.emacs} file.
-
-When the clock is running and Emacs is idle for more than this number
-of seconds, the clock will be clocked out automatically.
-
-Use @samp{M-x org-clock-toggle-auto-clockout RET} to temporarily turn this
-on or off.
-
-@node Effort Estimates
-@section Effort Estimates
-
-@cindex effort estimates
-@cindex @samp{EFFORT}, property
-@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}. Multiple
-formats are supported, such as @samp{3:12}, @samp{1:23:45}, or @samp{1d3h5min}; see
-the file @samp{org-duration.el} for more detailed information about the
-format.
-
-You can set the effort for an entry with the following commands:
-
-@table @asis
-@item @kbd{C-c C-x e} (@code{org-set-effort})
-@kindex C-c C-x e
-@findex org-set-effort
-Set the effort estimate for the current entry. With a prefix
-argument, set it to the next allowed value---see below. This
-command is also accessible from the agenda with the @kbd{e}
-key.
-
-@item @kbd{C-c C-x C-e} (@code{org-clock-modify-effort-estimate})
-@kindex C-c C-x C-e
-@findex org-clock-modify-effort-estimate
-Modify the effort estimate of the item currently being clocked.
-@end table
-
-Clearly the best way to work with effort estimates is through column
-view (see @ref{Column View}). You should start by setting up discrete
-values for effort estimates, and a @samp{COLUMNS} format that displays
-these values together with clock sums---if you want to clock your
-time. For a specific buffer you can use:
-
-@example
-#+PROPERTY: Effort_ALL 0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00
-#+COLUMNS: %40ITEM(Task) %17Effort(Estimated Effort)@{:@} %CLOCKSUM
-@end example
-
-@noindent
-@vindex org-global-properties
-@vindex org-columns-default-format
-or, even better, you can set up these values globally by customizing
-the variables @code{org-global-properties} and
-@code{org-columns-default-format}. In particular if you want to use this
-setup also in the agenda, a global setup may be advised.
-
-The way to assign estimates to individual items is then to switch to
-column mode, and to use @kbd{S-@key{RIGHT}} and @kbd{S-@key{LEFT}} to
-change the value. The values you enter are immediately summed up in
-the hierarchy. In the column next to it, any clocked time is
-displayed.
-
-@vindex org-agenda-columns-add-appointments-to-effort-sum
-If you switch to column view in the daily/weekly agenda, the effort
-column summarizes the estimated work effort for each day@footnote{Please note the pitfalls of summing hierarchical data in
-a flat list (see @ref{Agenda Column View}).}, and
-you can use this to find space in your schedule. To get an overview
-of the entire part of the day that is committed, you can set the
-option @code{org-agenda-columns-add-appointments-to-effort-sum}. The
-appointments on a day that take place over a specified time interval
-are then also added to the load estimate of the day.
-
-Effort estimates can be used in secondary agenda filtering that is
-triggered with the @kbd{/} key in the agenda (see @ref{Agenda Commands}). If you have these estimates defined consistently,
-two or three key presses narrow down the list to stuff that fits into
-an available time slot.
-
-@node Timers
-@section Taking Notes with a Relative Timer
-
-@cindex relative timer
-@cindex countdown timer
-
-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 @asis
-@item @kbd{C-c C-x 0} (@code{org-timer-start})
-@kindex C-c C-x 0
-@findex 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.
-
-@item @kbd{C-c C-x ;} (@code{org-timer-set-timer})
-@kindex C-c C-x ;
-@findex org-timer-set-timer
-@vindex org-timer-default-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
-
-Once started, relative and countdown timers are controlled with the
-same commands.
-
-@table @asis
-@item @kbd{C-c C-x .} (@code{org-timer})
-@kindex C-c C-x .
-@findex org-timer
-Insert a relative time into the buffer. The first time you use
-this, the timer starts. Using a prefix argument restarts it.
-
-@item @kbd{C-c C-x -} (@code{org-timer-item})
-@kindex C-c C-x -
-@findex org-timer-item
-Insert a description list item with the current relative time. With
-a prefix argument, first reset the timer to 0.
-
-@item @kbd{M-@key{RET}} (@code{org-insert-heading})
-@kindex M-RET
-@findex org-insert-heading
-Once the timer list is started, you can also use @kbd{M-@key{RET}} to
-insert new timer items.
-
-@item @kbd{C-c C-x ,} (@code{org-timer-pause-or-continue})
-@kindex C-c C-x ,
-@findex org-timer-pause-or-continue
-Pause the timer, or continue it if it is already paused.
-
-@item @kbd{C-c C-x _} (@code{org-timer-stop})
-@kindex C-c C-x _
-@findex 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.
-@end table
-
-@node Refiling and Archiving
-@chapter Refiling and Archiving
-
-@cindex refiling notes
-@cindex copying notes
-@cindex archiving
-
-Once information is in the system, it may need to be moved around.
-Org provides Refile, Copy and Archive commands for this. Refile and
-Copy helps with moving and copying outlines. Archiving helps to keep
-the system compact and fast.
-
-@menu
-* Refile and Copy:: Moving/copying a tree from one place to another.
-* Archiving:: What to do with finished products.
-@end menu
-
-@node Refile and Copy
-@section Refile and Copy
-
-@cindex refiling notes
-@cindex copying notes
-
-When reviewing the captured data, you may want to refile or to copy
-some of the entries into a different list, for example into a project.
-Cutting, finding the right location, and then pasting the note is
-cumbersome. To simplify this process, you can use the following
-special command:
-
-@table @asis
-@item @kbd{C-c C-w} (@code{org-refile})
-@kindex C-c C-w
-@findex org-refile
-@vindex org-reverse-note-order
-@vindex org-refile-targets
-@vindex org-refile-use-outline-path
-@vindex org-outline-path-complete-in-steps
-@vindex org-refile-allow-creating-parent-nodes
-@vindex org-log-refile
-Refile the entry or region at point. This command offers possible
-locations for refiling the entry and lets you select one with
-completion. The item (or all items in the region) is filed below
-the target heading as a subitem. Depending on
-@code{org-reverse-note-order}, it is either the first or last subitem.
-
-By default, all level 1 headlines in the current buffer are
-considered to be targets, but you can have more complex definitions
-across a number of files. See the variable @code{org-refile-targets} for
-details. If you would like to select a location via
-a file-path-like completion along the outline path, see the
-variables @code{org-refile-use-outline-path} and
-@code{org-outline-path-complete-in-steps}. If you would like to be able
-to create new nodes as new parents for refiling on the fly, check
-the variable @code{org-refile-allow-creating-parent-nodes}. When the
-variable @code{org-log-refile}@footnote{Note the corresponding @samp{STARTUP} options @samp{logrefile},
-@samp{lognoterefile}, and @samp{nologrefile}.} is set, a timestamp or a note is
-recorded whenever an entry is refiled.
-
-@item @kbd{C-u C-c C-w}
-@kindex C-u C-c C-w
-Use the refile interface to jump to a heading.
-
-@item @kbd{C-u C-u C-c C-w} (@code{org-refile-goto-last-stored})
-@kindex C-u C-u C-c C-w
-@findex org-refile-goto-last-stored
-Jump to the location where @code{org-refile} last moved a tree to.
-
-@item @kbd{C-2 C-c C-w}
-@kindex C-2 C-c C-w
-Refile as the child of the item currently being clocked.
-
-@item @kbd{C-3 C-c C-w}
-@kindex C-3 C-c C-w
-@vindex org-refile-keep
-Refile and keep the entry in place. Also see @code{org-refile-keep} to
-make this the default behavior, and beware that this may result in
-duplicated @samp{ID} properties.
-
-@item @kbd{C-0 C-c C-w} or @kbd{C-u C-u C-u C-c C-w} (@code{org-refile-cache-clear})
-@kindex C-u C-u C-u C-c C-w
-@kindex C-0 C-c C-w
-@findex org-refile-cache-clear
-@vindex org-refile-use-cache
-Clear the target cache. Caching of refile targets can be turned on
-by setting @code{org-refile-use-cache}. To make the command see new
-possible targets, you have to clear the cache with this command.
-
-@item @kbd{C-c M-w} (@code{org-refile-copy})
-@kindex C-c M-w
-@findex org-refile-copy
-Copying works like refiling, except that the original note is not
-deleted.
-@end table
-
-@node Archiving
-@section Archiving
-
-@cindex archiving
-
-When a project represented by a (sub)tree is finished, you may want to
-move the tree out of the way and to stop it from contributing to the
-agenda. Archiving is important to keep your working files compact and
-global searches like the construction of agenda views fast.
-
-@table @asis
-@item @kbd{C-c C-x C-a} (@code{org-archive-subtree-default})
-@kindex C-c C-x C-a
-@findex org-archive-subtree-default
-@vindex org-archive-default-command
-Archive the current entry using the command specified in the
-variable @code{org-archive-default-command}.
-@end table
-
-@menu
-* Moving subtrees:: Moving a tree to an archive file.
-* Internal archiving:: Switch off a tree but keep it in the file.
-@end menu
-
-@node Moving subtrees
-@subsection Moving a tree to an archive file
-
-@cindex external archiving
-
-The most common archiving action is to move a project tree to another
-file, the archive file.
-
-@table @asis
-@item @kbd{C-c C-x C-s} or short @kbd{C-c $} (@code{org-archive-subtree})
-@kindex C-c C-x C-s
-@kindex C-c $
-@findex org-archive-subtree
-@vindex org-archive-location
-Archive the subtree starting at point position to the location given
-by @code{org-archive-location}.
-
-@item @kbd{C-u C-c C-x C-s}
-@kindex C-u C-c C-x C-s
-Check if any direct children of the current headline could be moved
-to the archive. To do this, check each subtree for open TODO
-entries. If none is found, the command offers to move it to the
-archive location. If point is @emph{not} on a headline when this command
-is invoked, check level 1 trees.
-
-@item @kbd{C-u C-u C-c C-x C-s}
-@kindex C-u C-u C-c C-x C-s
-As above, but check subtree for timestamps instead of TODO entries.
-The command offers to archive the subtree if it @emph{does} contain
-a timestamp, and that timestamp is in the past.
-@end table
-
-@cindex archive locations
-The default archive location is a file in the same directory as the
-current file, with the name derived by appending @samp{_archive} to the
-current file name. You can also choose what heading to file archived
-items under, with the possibility to add them to a datetree in a file.
-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:
-
-@cindex @samp{ARCHIVE}, keyword
-@example
-#+ARCHIVE: %s_done::
-@end example
-
-
-@cindex ARCHIVE, property
-If you would like to have a special archive location for a single
-entry or a (sub)tree, give the entry an @samp{ARCHIVE} property with the
-location as the value (see @ref{Properties and Columns}).
-
-@vindex org-archive-save-context-info
-When a subtree is moved, it receives a number of special properties
-that record context information like the file from where the entry
-came, its outline path the archiving time etc. Configure the variable
-@code{org-archive-save-context-info} to adjust the amount of information
-added.
-
-@vindex org-archive-subtree-save-file-p
-When @code{org-archive-subtree-save-file-p} is non-@code{nil}, save the target
-archive buffer.
-
-@node Internal archiving
-@subsection Internal archiving
-
-@cindex @samp{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 @samp{ARCHIVE}
-tag.
-
-A headline that is marked with the @samp{ARCHIVE} tag (see @ref{Tags}) stays at
-its location in the outline tree, but behaves in the following way:
-
-@itemize
-@item
-@vindex org-cycle-open-archived-trees
-It does not open when you attempt to do so with a visibility cycling
-command (see @ref{Visibility Cycling}). You can force cycling archived
-subtrees with @kbd{C-@key{TAB}}, or by setting the option
-@code{org-cycle-open-archived-trees}. Also normal outline commands, like
-@code{outline-show-all}, open archived subtrees.
-
-@item
-@vindex org-sparse-tree-open-archived-trees
-During sparse tree construction (see @ref{Sparse Trees}), matches in
-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 (see @ref{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 are
-always included. In the agenda you can press @kbd{v a} to get
-archives temporarily included.
-
-@item
-@vindex org-export-with-archived-trees
-Archived trees are not exported (see @ref{Exporting}), only the headline
-is. Configure the details using the variable
-@code{org-export-with-archived-trees}.
-
-@item
-@vindex org-columns-skip-archived-trees
-Archived trees are excluded from column view unless the variable
-@code{org-columns-skip-archived-trees} is configured to @code{nil}.
-@end itemize
-
-The following commands help manage the @samp{ARCHIVE} tag:
-
-@table @asis
-@item @kbd{C-c C-x a} (@code{org-toggle-archive-tag})
-@kindex C-c C-x a
-@findex org-toggle-archive-tag
-Toggle the archive tag for the current headline. When the tag is
-set, the headline changes to a shadowed face, and the subtree below
-it is hidden.
-
-@item @kbd{C-u C-c C-x a}
-@kindex C-u C-c C-x a
-Check if any direct children of the current headline should be
-archived. To do this, check each subtree for open TODO entries. If
-none is found, the command offers to set the @samp{ARCHIVE} tag for the
-child. If point is @emph{not} on a headline when this command is
-invoked, check the level 1 trees.
-
-@item @kbd{C-c C-@key{TAB}} (@code{org-force-cycle-archived})
-@kindex C-TAB
-Cycle a tree even if it is tagged with @samp{ARCHIVE}.
-
-@item @kbd{C-c C-x A} (@code{org-archive-to-archive-sibling})
-@kindex C-c C-x A
-@findex org-archive-to-archive-sibling
-Move the current entry to the @emph{Archive Sibling}. This is a sibling
-of the entry with the heading @samp{Archive} and the archive tag. The
-entry becomes a child of that sibling and in this way retains a lot
-of its original context, including inherited tags and approximate
-position in the outline.
-@end table
-
-@node Capture and Attachments
-@chapter Capture and Attachments
-
-@cindex capture
-@cindex attachments
-@cindex RSS feeds
-@cindex Atom feeds
-@cindex protocols, for external access
-
-An important part of any organization system is the ability to quickly
-capture new ideas and tasks, and to associate reference material with
-them. Org does this using a process called @emph{capture}. It also can
-store files related to a task (@emph{attachments}) in a special directory.
-Finally, it can parse RSS feeds for information. To learn how to let
-external programs (for example a web browser) trigger Org to capture
-material, see @ref{Protocols}.
-
-@menu
-* Capture:: Capturing new stuff.
-* Attachments:: Attach files to outlines.
-* RSS Feeds:: Getting input from RSS feeds.
-@end menu
-
-@node Capture
-@section Capture
-
-@cindex capture
-
-Capture lets you quickly store notes with little interruption of your
-work flow. Org's method for capturing new items is heavily inspired
-by John Wiegley's excellent Remember package.
-
-@menu
-* Setting up capture:: Where notes will be stored.
-* Using capture:: Commands to invoke and terminate capture.
-* Capture templates:: Define the outline of different note types.
-@end menu
-
-@node Setting up capture
-@subsection Setting up capture
-
-The following customization sets a default target file for notes.
-
-@vindex org-default-notes-file
-@lisp
-(setq org-default-notes-file (concat org-directory "/notes.org"))
-@end lisp
-
-You may also define a global key for capturing new material (see
-@ref{Activation}).
-
-@node Using capture
-@subsection Using capture
-
-@table @asis
-@item @kbd{M-x org-capture} (@code{org-capture})
-@findex org-capture
-@cindex date tree
-Display the capture templates menu. If you have templates defined
-(see @ref{Capture templates}), it offers these templates for selection or
-use a new Org outline node as the default template. It inserts the
-template into the target file and switch to an indirect buffer
-narrowed to this new node. You may then insert the information you
-want.
-
-@item @kbd{C-c C-c} (@code{org-capture-finalize})
-@kindex C-c C-c @r{(Capture buffer)}
-@findex org-capture-finalize
-Once you have finished entering information into the capture buffer,
-@kbd{C-c C-c} returns you to the window configuration before
-the capture process, so that you can resume your work without
-further distraction. When called with a prefix argument, finalize
-and then jump to the captured item.
-
-@item @kbd{C-c C-w} (@code{org-capture-refile})
-@kindex C-c C-w @r{(Capture buffer)}
-@findex org-capture-refile
-Finalize the capture process by refiling the note to a different
-place (see @ref{Refile and Copy}). Please realize that this is a normal
-refiling command that will be executed---so point position at the
-moment you run this command is important. If you have inserted
-a tree with a parent and children, first move point back to the
-parent. Any prefix argument given to this command is passed on to
-the @code{org-refile} command.
-
-@item @kbd{C-c C-k} (@code{org-capture-kill})
-@kindex C-c C-k @r{(Capture buffer)}
-@findex org-capture-kill
-Abort the capture process and return to the previous state.
-@end table
-
-@kindex k c @r{(Agenda)}
-You can also call @code{org-capture} in a special way from the agenda,
-using the @kbd{k c} key combination. With this access, any
-timestamps inserted by the selected capture template defaults to the
-date at point in the agenda, rather than to the current date.
-
-To find the locations of the last stored capture, use @code{org-capture}
-with prefix commands:
-
-@table @asis
-@item @kbd{C-u M-x org-capture}
-Visit the target location of a capture template. You get to select
-the template in the usual way.
-
-@item @kbd{C-u C-u M-x org-capture}
-Visit the last stored capture item in its buffer.
-@end table
-
-@vindex org-capture-bookmark
-@vindex org-capture-last-stored
-You can also jump to the bookmark @code{org-capture-last-stored}, which is
-automatically created unless you set @code{org-capture-bookmark} to @code{nil}.
-
-To insert the capture at point in an Org buffer, call @code{org-capture}
-with a @kbd{C-0} prefix argument.
-
-@node Capture templates
-@subsection Capture templates
-
-@cindex templates, for Capture
-
-You can use templates for different types of capture items, and for
-different target locations. The easiest way to create such templates
-is through the customize interface.
-
-@table @asis
-@item @kbd{C}
-@kindex C @r{(Capture menu}
-@vindex org-capture-templates
-Customize the variable @code{org-capture-templates}.
-@end table
-
-Before we give the formal description of template definitions, let's
-look at an example. Say you would like to use one template to create
-general TODO entries, and you want to put these entries under the
-heading @samp{Tasks} in your file @samp{~/org/gtd.org}. Also, a date tree in
-the file @samp{journal.org} should capture journal entries. A possible
-configuration would look like:
-
-@lisp
-(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")
- "* %?\nEntered on %U\n %i\n %a")))
-@end lisp
-
-If you then press @kbd{t} from the capture menu, Org will prepare
-the template for you like this:
-
-@example
-* TODO
- [[file:LINK TO WHERE YOU INITIATED CAPTURE]]
-@end example
-
-@noindent
-During expansion of the template, @samp{%a} has been replaced by a link to
-the location from where you called the capture command. This can be
-extremely useful for deriving tasks from emails, for example. You
-fill in the task definition, press @kbd{C-c C-c} and Org returns
-you to the same place where you started the capture process.
-
-To define special keys to capture to a particular template without
-going through the interactive template selection, you can create your
-key binding like this:
-
-@lisp
-(define-key global-map (kbd "C-c x")
- (lambda () (interactive) (org-capture nil "x")))
-@end lisp
-
-@menu
-* Template elements:: What is needed for a complete template entry.
-* Template expansion:: Filling in information about time and context.
-* Templates in contexts:: Only show a template in a specific context.
-@end menu
-
-@node Template elements
-@subsubsection Template elements
-
-Now lets look at the elements of a template definition. Each entry in
-@code{org-capture-templates} is a list with the following items:
-
-@table @asis
-@item keys
-The keys that selects the template, as a string, characters only,
-for example @samp{"a"}, for a template to be selected with a single key,
-or @samp{"bt"} for selection with two keys. When using several keys,
-keys using the same prefix key must be sequential in the list and
-preceded by a 2-element entry explaining the prefix key, for
-example:
-
-@lisp
-("b" "Templates for marking stuff to buy")
-@end lisp
-
-If you do not define a template for the @kbd{C} key, this key
-opens the Customize buffer for this complex variable.
-
-@item description
-A short string describing the template, shown during selection.
-
-@item type
-The type of entry, a symbol. Valid values are:
-
-@table @asis
-@item @code{entry}
-An Org mode node, with a headline. Will be filed as the child of
-the target entry or as a top-level entry. The target file should
-be an Org file.
-
-@item @code{item}
-A plain list item, placed in the first plain list at the target
-location. Again the target file should be an Org file.
-
-@item @code{checkitem}
-A checkbox item. This only differs from the plain list item by
-the default template.
-
-@item @code{table-line}
-A new line in the first table at the target location. Where
-exactly the line will be inserted depends on the properties
-@code{:prepend} and @code{:table-line-pos} (see below).
-
-@item @code{plain}
-Text to be inserted as it is.
-@end table
-
-@item target
-@vindex org-default-notes-file
-@vindex org-directory
-Specification of where the captured item should be placed. 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
-@code{org-default-notes-file}. 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 @code{org-directory}.
-
-Valid values are:
-
-@table @asis
-@item @samp{(file "path/to/file")}
-Text will be placed at the beginning or end of that file.
-
-@item @samp{(id "id of existing org entry")}
-Filing as child of this entry, or in the body of the entry.
-
-@item @samp{(file+headline "filename" "node headline")}
-Fast configuration if the target heading is unique in the file.
-
-@item @samp{(file+olp "filename" "Level 1 heading" "Level 2" ...)}
-For non-unique headings, the full path is safer.
-
-@item @samp{(file+regexp "filename" "regexp to find location")}
-Use a regular expression to position point.
-
-@item @samp{(file+olp+datetree "filename" [ "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.} creates 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 @samp{(file+function "filename" function-finding-location)}
-A function to find the right location in the file.
-
-@item @samp{(clock)}
-File to the entry that is currently being clocked.
-
-@item @samp{(function function-finding-location)}
-Most general way: write your own function which both visits the
-file and moves point to the right location.
-@end table
-
-@item template
-The template for creating the capture item. If you leave this
-empty, an appropriate default template will be used. Otherwise this
-is a string with escape codes, which will be replaced depending on
-time and context of the capture call. You may also get this
-template string from a file@footnote{When the file name is not absolute, Org assumes it is relative
-to @code{org-directory}.}, or dynamically, from a function
-using either syntax:
-
-@example
-(file "/path/to/template-file")
-(function FUNCTION-RETURNING-THE-TEMPLATE)
-@end example
-
-@item properties
-The rest of the entry is a property list of additional options.
-Recognized properties are:
-
-@table @asis
-@item @code{:prepend}
-Normally new captured information will be appended at the target
-location (last child, last table line, last list item, @dots{}).
-Setting this property changes that.
-
-@item @code{:immediate-finish}
-When set, do not offer to edit the information, just file it away
-immediately. This makes sense if the template only needs
-information that can be added automatically.
-
-@item @code{:jump-to-captured}
-When set, jump to the captured entry when finished.
-
-@item @code{:empty-lines}
-Set this to the number of lines to insert before and after the new
-item. Default 0, and the only other common value is 1.
-
-@item @code{:empty-lines-after}
-Set this to the number of lines that should be inserted after the
-new item. Overrides @code{:empty-lines} for the number of lines
-inserted after.
-
-@item @code{:empty-lines-before}
-Set this to the number of lines that should be inserted before the
-new item. Overrides @code{:empty-lines} for the number lines inserted
-before.
-
-@item @code{:clock-in}
-Start the clock in this item.
-
-@item @code{:clock-keep}
-Keep the clock running when filing the captured entry.
-
-@item @code{:clock-resume}
-If starting the capture interrupted a clock, restart that clock
-when finished with the capture. Note that @code{:clock-keep} has
-precedence over @code{:clock-resume}. When setting both to non-@code{nil},
-the current clock will run and the previous one will not be
-resumed.
-
-@item @code{: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 @code{:tree-type}
-Use @code{week} to make a week tree instead of the month-day tree,
-i.e., place the headings for each day under a heading with the
-current ISO week. Use @code{month} to group entries by month
-only. Default is to group entries by day.
-
-@item @code{:unnarrowed}
-Do not narrow the target buffer, simply show the full buffer.
-Default is to narrow it so that you only see the new material.
-
-@item @code{:table-line-pos}
-Specification of the location in the table where the new line
-should be inserted. It should be a string like @samp{II-3} meaning
-that the new line should become the third line before the second
-horizontal separator line.
-
-@item @code{:kill-buffer}
-If the target file was not yet visited when capture was invoked,
-kill the buffer again after capture is completed.
-
-@item @code{:no-save}
-Do not save the target file after finishing the capture.
-@end table
-@end table
-
-@node Template expansion
-@subsubsection Template expansion
-
-In the template itself, special ``%-escapes''@footnote{If you need one of these sequences literally, escape the @samp{%}
-with a backslash.} allow dynamic
-insertion of content. The templates are expanded in the order given
-here:
-
-@table @asis
-@item @samp{%[FILE]}
-Insert the contents of the file given by @var{FILE}.
-
-@item @samp{%(EXP)}
-Evaluate Elisp expression @var{EXP} and replace it with the
-result. The @var{EXP} form must return a string. Only
-placeholders pre-existing within the template, or introduced with
-@samp{%[file]}, are expanded this way. Since this happens after
-expanding non-interactive ``%-escapes'', those can be used to fill the
-expression.
-
-@item @samp{%<FORMAT>}
-The result of format-time-string on the @var{FORMAT}
-specification.
-
-@item @samp{%t}
-Timestamp, date only.
-
-@item @samp{%T}
-Timestamp, with date and time.
-
-@item @samp{%u}, @samp{%U}
-Like @samp{%t}, @samp{%T} above, but inactive timestamps.
-
-@item @samp{%i}
-Initial content, the region when capture is called while the region
-is active. If there is text before @samp{%i} on the same line, such as
-indentation, and @samp{%i} is not inside a @samp{%(exp)} form, that prefix is
-added before every line in the inserted text.
-
-@item @samp{%a}
-Annotation, normally the link created with @code{org-store-link}.
-
-@item @samp{%A}
-Like @samp{%a}, but prompt for the description part.
-
-@item @samp{%l}
-Like @samp{%a}, but only insert the literal link.
-
-@item @samp{%c}
-Current kill ring head.
-
-@item @samp{%x}
-Content of the X clipboard.
-
-@item @samp{%k}
-Title of the currently clocked task.
-
-@item @samp{%K}
-Link to the currently clocked task.
-
-@item @samp{%n}
-User name (taken from @code{user-full-name}).
-
-@item @samp{%f}
-File visited by current buffer when org-capture was called.
-
-@item @samp{%F}
-Full path of the file or directory visited by current buffer.
-
-@item @samp{%:keyword}
-Specific information for certain link types, see below.
-
-@item @samp{%^g}
-Prompt for tags, with completion on tags in target file.
-
-@item @samp{%^G}
-Prompt for tags, with completion all tags in all agenda files.
-
-@item @samp{%^t}
-Like @samp{%t}, but prompt for date. Similarly @samp{%^T}, @samp{%^u}, @samp{%^U}. You
-may define a prompt like @samp{%^@{Birthday@}t}.
-
-@item @samp{%^C}
-Interactive selection of which kill or clip to use.
-
-@item @samp{%^L}
-Like @samp{%^C}, but insert as link.
-
-@item @samp{%^@{PROP@}p}
-Prompt the user for a value for property @var{PROP}.
-
-@item @samp{%^@{PROMPT@}}
-Prompt the user for a string and replace this sequence with it. You
-may specify a default value and a completion table with
-@samp{%^@{prompt|default|completion2|completion3...@}}. The arrow keys
-access a prompt-specific history.
-
-@item @samp{%\N}
-Insert the text entered at the @var{N}th @samp{%^@{PROMPT@}}, where
-@var{N} is a number, starting from 1.
-
-@item @samp{%?}
-After completing the template, position point here.
-@end table
-
-@vindex org-store-link-props
-For specific link types, the following keywords are defined@footnote{If you define your own link types (see @ref{Adding Hyperlink Types}), any property you store with @code{org-store-link-props} can be
-accessed in capture templates in a similar way.}:
-
-@vindex org-link-from-user-regexp
-@multitable {aaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@headitem Link type
-@tab Available keywords
-@item bbdb
-@tab @samp{%:name}, @samp{%:company}
-@item irc
-@tab @samp{%:server}, @samp{%:port}, @samp{%:nick}
-@item mh, rmail
-@tab @samp{%:type}, @samp{%:subject}, @samp{%:message-id}
-@item
-@tab @samp{%:from}, @samp{%:fromname}, @samp{%:fromaddress}
-@item
-@tab @samp{%:to}, @samp{%:toname}, @samp{%:toaddress}
-@item
-@tab @samp{%:date} (message date header field)
-@item
-@tab @samp{%:date-timestamp} (date as active timestamp)
-@item
-@tab @samp{%:date-timestamp-inactive} (date as inactive timestamp)
-@item
-@tab @samp{%:fromto} (either ``to NAME'' or ``from NAME'')@footnote{This is always the other, not the user. See the variable
-@code{org-link-from-user-regexp}.}
-@item gnus
-@tab @samp{%:group}, for messages also all email fields
-@item w3, w3m
-@tab @samp{%:url}
-@item info
-@tab @samp{%:file}, @samp{%:node}
-@item calendar
-@tab @samp{%:date}
-@item org-protocol
-@tab @samp{%:link}, @samp{%:description}, @samp{%:annotation}
-@end multitable
-
-@node Templates in contexts
-@subsubsection Templates in contexts
-
-@vindex org-capture-templates-contexts
-To control whether a capture template should be accessible from
-a specific context, you can customize
-@code{org-capture-templates-contexts}. Let's say, for example, that you
-have a capture template ``p'' for storing Gnus emails containing
-patches. Then you would configure this option like this:
-
-@lisp
-(setq org-capture-templates-contexts
- '(("p" (in-mode . "message-mode"))))
-@end lisp
-
-You can also tell that the command key @kbd{p} should refer to
-another template. In that case, add this command key like this:
-
-@lisp
-(setq org-capture-templates-contexts
- '(("p" "q" (in-mode . "message-mode"))))
-@end lisp
-
-See the docstring of the variable for more information.
-
-@node Attachments
-@section Attachments
-
-@cindex attachments
-
-It is often useful to associate reference material with an outline
-node. Small chunks of plain text can simply be stored in the subtree
-of a project. Hyperlinks (see @ref{Hyperlinks}) can establish associations
-with files that live elsewhere on a local, or even remote, computer,
-like emails or source code files belonging to a project.
-
-Another method is @emph{attachments}, which are files located in a
-directory belonging to an outline node. Org uses directories either
-named by a unique ID of each entry, or by a @samp{DIR} property.
-
-@menu
-* Attachment defaults and dispatcher:: How to access attachment commands
-* Attachment options:: Configuring the attachment system
-* Attachment links:: Hyperlink access to attachments
-* Automatic version-control with Git:: Everything safely stored away
-* Attach from Dired:: Using dired to select an attachment
-@end menu
-
-@node Attachment defaults and dispatcher
-@subsection Attachment defaults and dispatcher
-
-By default, Org attach uses ID properties when adding attachments to
-outline nodes. This makes working with attachments fully automated.
-There is no decision needed for folder-name or location. ID-based
-directories are by default located in the @samp{data/} directory, which
-lives in the same directory where your Org file lives@footnote{If you move entries or Org files from one directory to
-another, you may want to configure @code{org-attach-id-dir} to contain
-an absolute path.}.
-
-When attachments are made using @code{org-attach} a default tag @samp{ATTACH} is
-added to the node that gets the attachments.
-
-For more control over the setup, see @ref{Attachment options}.
-
-The following commands deal with attachments:
-
-@table @asis
-@item @kbd{C-c C-a} (@code{org-attach})
-@kindex C-c C-a
-@findex org-attach
-The dispatcher for commands related to the attachment system. After
-these keys, a list of commands is displayed and you must press an
-additional key to select a command:
-
-@table @asis
-@item @kbd{a} (@code{org-attach-attach})
-@kindex C-c C-a a
-@findex org-attach-attach
-@vindex org-attach-method
-Select a file and move it into the task's attachment directory.
-The file is copied, moved, or linked, depending on
-@code{org-attach-method}. Note that hard links are not supported on
-all systems.
-
-@item @kbd{c}/@kbd{m}/@kbd{l}
-@kindex C-c C-a c
-@kindex C-c C-a m
-@kindex C-c C-a l
-Attach a file using the copy/move/link method. Note that hard
-links are not supported on all systems.
-
-@item @kbd{b} (@code{org-attach-buffer})
-@kindex C-c C-a b
-@findex org-attach-buffer
-Select a buffer and save it as a file in the task's attachment
-directory.
-
-@item @kbd{n} (@code{org-attach-new})
-@kindex C-c C-a n
-@findex org-attach-new
-Create a new attachment as an Emacs buffer.
-
-@item @kbd{z} (@code{org-attach-sync})
-@kindex C-c C-a z
-@findex org-attach-sync
-Synchronize the current task with its attachment directory, in
-case you added attachments yourself.
-
-@item @kbd{o} (@code{org-attach-open})
-@kindex C-c C-a o
-@findex org-attach-open
-@vindex org-file-apps
-Open current task's attachment. If there is more than one, prompt
-for a file name first. Opening follows the rules set by
-@code{org-file-apps}. For more details, see the information on
-following hyperlinks (see @ref{Handling Links}).
-
-@item @kbd{O} (@code{org-attach-open-in-emacs})
-@kindex C-c C-a O
-@findex org-attach-open-in-emacs
-Also open the attachment, but force opening the file in Emacs.
-
-@item @kbd{f} (@code{org-attach-reveal})
-@kindex C-c C-a f
-@findex org-attach-reveal
-Open the current task's attachment directory.
-
-@item @kbd{F} (@code{org-attach-reveal-in-emacs})
-@kindex C-c C-a F
-@findex org-attach-reveal-in-emacs
-Also open the directory, but force using Dired in Emacs.
-
-@item @kbd{d} (@code{org-attach-delete-one})
-@kindex C-c C-a d
-Select and delete a single attachment.
-
-@item @kbd{D} (@code{org-attach-delete-all})
-@kindex C-c C-a D
-Delete all of a task's attachments. A safer way is to open the
-directory in Dired and delete from there.
-
-@item @kbd{s} (@code{org-attach-set-directory})
-@kindex C-c C-a s
-@cindex @samp{DIR}, property
-Set a specific directory as the entry's attachment directory.
-This works by putting the directory path into the @samp{DIR}
-property.
-
-@item @kbd{S} (@code{org-attach-unset-directory})
-@kindex C-c C-a S
-@cindex @samp{DIR}, property
-Remove the attachment directory. This command removes the @samp{DIR}
-property and asks the user to either move content inside that
-folder, if an @samp{ID} property is set, delete the content, or to
-leave the attachment directory as is but no longer attached to the
-outline node.
-@end table
-@end table
-
-@node Attachment options
-@subsection Attachment options
-
-There are a couple of options for attachments that are worth
-mentioning.
-
-@table @asis
-@item @code{org-attach-id-dir}
-@vindex org-attach-id-dir
-The directory where attachments are stored when @samp{ID} is used as
-method.
-
-@item @code{org-attach-dir-relative}
-@vindex org-attach-dir-relative
-When setting the @samp{DIR} property on a node using @kbd{C-c C-a s}
-(@code{org-attach-set-directory}), absolute links are entered by default.
-This option changes that to relative links.
-
-@item @code{org-attach-use-inheritance}
-@vindex org-attach-use-inheritance
-By default folders attached to an outline node are inherited from
-parents according to @code{org-use-property-inheritance}. If one instead
-want to set inheritance specifically for Org attach that can be done
-using @code{org-attach-use-inheritance}. Inheriting documents through
-the node hierarchy makes a lot of sense in most cases. Especially
-when using attachment links (see @ref{Attachment links}). The following
-example shows one use case for attachment inheritance:
-
-@example
-* Chapter A ...
- :PROPERTIES:
- :DIR: Chapter A/
- :END:
-** Introduction
-Some text
-
-#+NAME: Image 1
-[[attachment:image 1.jpg]]
-@end example
-
-Without inheritance one would not be able to resolve the link to
-@samp{image 1.jpg}, since the link is inside a sub-heading to @samp{Chapter
- A}.
-
-Inheritance works the same way for both @samp{ID} and @samp{DIR} property. If
-both properties are defined on the same headline then @samp{DIR} takes
-precedence. This is also true if inheritance is enabled. If @samp{DIR}
-is inherited from a parent node in the outline, that property still
-takes precedence over an @samp{ID} property defined on the node itself.
-
-@item @code{org-attach-method}
-@vindex org-attach-method
-When attaching files using the dispatcher @kbd{C-c C-a} it
-defaults to copying files. The behavior can be changed by
-customizing @code{org-attach-method}. Options are Copy, Move/Rename,
-Hard link or Symbolic link.
-
-@item @code{org-attach-preferred-new-method}
-@vindex org-attach-preferred-new-method
-This customization lets you choose the default way to attach to
-nodes without existing @samp{ID} and @samp{DIR} property. It defaults to @code{id}
-but can also be set to @code{dir}, @code{ask} or @code{nil}.
-
-@item @code{org-attach-archive-delete}
-@vindex org-attach-archive-delete
-Configure this to determine if attachments should be deleted or not
-when a subtree that has attachments is archived.
-
-@item @code{org-attach-auto-tag}
-@vindex org-attach-auto-tag
-When attaching files to a heading it will be assigned a tag
-according to what is set here.
-
-@item @code{org-attach-id-to-path-function-list}
-@vindex org-attach-id-to-path-function-list
-When @samp{ID} is used for attachments, the ID is parsed into a part of a
-directory-path. See @code{org-attach-id-uuid-folder-format} for the
-default function. Define a new one and add it as first element in
-@code{org-attach-id-to-path-function-list} if you want the folder
-structure in any other way. All functions in this list will be
-tried when resolving existing ID's into paths, to maintain backward
-compatibility with existing folders in your system.
-
-@item @code{org-attach-store-link-p}
-@vindex org-attach-store-link-p
-Stores a link to the file that is being attached. The link is
-stored in @code{org-stored-links} for later insertion with @kbd{C-c C-l} (see @ref{Handling Links}). Depending on what option is set in
-@code{org-attach-store-link-p}, the link is stored to either the original
-location as a file link, the attachment location as an attachment
-link or to the attachment location as a file link.
-
-@item @code{org-attach-commands}
-@vindex org-attach-commands
-List of all commands used in the attach dispatcher.
-
-@item @code{org-attach-expert}
-@vindex org-attach-expert
-Do not show the splash buffer with the attach dispatcher when
-@code{org-attach-expert} is set to non-@code{nil}.
-@end table
-
-See customization group @samp{Org Attach} if you want to change the
-default settings.
-
-@node Attachment links
-@subsection Attachment links
-
-Attached files and folders can be referenced using attachment links.
-This makes it easy to refer to the material added to an outline node.
-Especially if it was attached using the unique ID of the entry!
-
-@example
-* TODO Some task
- :PROPERTIES:
- :ID: 95d50008-c12e-479f-a4f2-cc0238205319
- :END:
-See attached document for more information: [[attachment:info.org]]
-@end example
-
-See @ref{External Links} for more information about these links.
-
-@node Automatic version-control with Git
-@subsection Automatic version-control with Git
-
-If the directory attached to an outline node is a Git repository, Org
-can be configured to automatically commit changes to that repository
-when it sees them.
-
-To make Org mode take care of versioning of attachments for you, add
-the following to your Emacs config:
-
-@lisp
-(require 'org-attach-git)
-@end lisp
-
-@node Attach from Dired
-@subsection Attach from Dired
-
-@cindex attach from Dired
-@findex org-attach-dired-to-subtree
-
-It is possible to attach files to a subtree from a Dired buffer. To
-use this feature, have one window in Dired mode containing the file(s)
-to be attached and another window with point in the subtree that shall
-get the attachments. In the Dired window, with point on a file,
-@kbd{M-x org-attach-dired-to-subtree} attaches the file to the
-subtree using the attachment method set by variable
-@code{org-attach-method}. When files are marked in the Dired window then
-all marked files get attached.
-
-Add the following lines to the Emacs init file to have @kbd{C-c C-x a} attach files in Dired buffers.
-
-@lisp
-(add-hook 'dired-mode-hook
- (lambda ()
- (define-key dired-mode-map
- (kbd "C-c C-x a")
- #'org-attach-dired-to-subtree)))
-@end lisp
-
-The following code shows how to bind the previous command with
-a specific attachment method.
-
-@lisp
-(add-hook 'dired-mode-hook
- (lambda ()
- (define-key dired-mode-map (kbd "C-c C-x c")
- (lambda ()
- (interactive)
- (let ((org-attach-method 'cp))
- (call-interactively #'org-attach-dired-to-subtree))))))
-@end lisp
-
-@node RSS Feeds
-@section RSS Feeds
-
-@cindex RSS feeds
-@cindex Atom feeds
-
-Org can add and change entries based on information found in RSS feeds
-and Atom feeds. You could use this to make a task out of each new
-podcast in a podcast feed. Or you could use a phone-based
-note-creating service on the web to import tasks into Org. To access
-feeds, configure the variable @code{org-feed-alist}. The docstring of this
-variable has detailed information. With the following
-
-@lisp
-(setq org-feed-alist
- '(("Slashdot"
- "http://rss.slashdot.org/Slashdot/slashdot"
- "~/txt/org/feeds.org" "Slashdot Entries")))
-@end lisp
-
-@noindent
-new items from the feed provided by @samp{rss.slashdot.org} result in new
-entries in the file @samp{~/org/feeds.org} under the heading @samp{Slashdot
-Entries}, whenever the following command is used:
-
-@table @asis
-@item @kbd{C-c C-x g} (@code{org-feed-update-all})
-@kindex C-c C-x g
-Collect items from the feeds configured in @code{org-feed-alist} and act
-upon them.
-
-@item @kbd{C-c C-x G} (@code{org-feed-goto-inbox})
-@kindex C-c C-x G
-Prompt for a feed name and go to the inbox configured for this feed.
-@end table
-
-Under the same headline, Org creates a drawer @samp{FEEDSTATUS} in which it
-stores information about the status of items in the feed, to avoid
-adding the same item several times.
-
-For more information, including how to read atom feeds, see
-@samp{org-feed.el} and the docstring of @code{org-feed-alist}.
-
-@node Agenda Views
-@chapter Agenda Views
-
-@cindex agenda views
-
-Due to the way Org works, TODO items, time-stamped items, and tagged
-headlines can be scattered throughout a file or even a number of
-files. To get an overview of open action items, or of events that are
-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. Six different view types are provided:
-
-@itemize
-@item
-an @emph{agenda} that is like a calendar and shows information for
-specific dates,
-
-@item
-a @emph{TODO list} that covers all unfinished action items,
-
-@item
-a @emph{match view}, showings headlines based on the tags, properties,
-and TODO state associated with them,
-
-@item
-a @emph{text search view} that shows all entries from multiple files that
-contain specified keywords,
-
-@item
-a @emph{stuck projects view} showing projects that currently do not move
-along, and
-
-@item
-@emph{custom views} that are special searches and combinations of
-different views.
-@end itemize
-
-The extracted information is displayed in a special @emph{agenda 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 (see @ref{Comment Lines}) and
-archived (see @ref{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 window configuration is restored when the agenda exits:
-@code{org-agenda-window-setup} and @code{org-agenda-restore-windows-after-quit}.
-
-@menu
-* Agenda Files:: Files being searched for agenda information.
-* Agenda Dispatcher:: Keyboard access to agenda views.
-* Built-in Agenda Views:: What is available out of the box?
-* 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.
-* Agenda Column View:: Using column view for collected entries.
-@end menu
-
-@node Agenda Files
-@section Agenda Files
-
-@cindex agenda files
-@cindex files for agenda
-
-@vindex org-agenda-files
-The information to be shown is normally collected from all @emph{agenda
-files}, the files listed in the variable @code{org-agenda-files}@footnote{If the value of that variable is not a list, but a single file
-name, then the list of agenda files in maintained in that external
-file.}.
-If a directory is part of this list, all files with the extension
-@samp{.org} in this directory are part of the list.
-
-Thus, even if you only work with a single Org file, that file should
-be put into the list@footnote{When using the dispatcher, pressing @kbd{<} before
-selecting a command actually limits the command to the current file,
-and ignores @code{org-agenda-files} until the next dispatcher command.}. You can customize @code{org-agenda-files},
-but the easiest way to maintain it is through the following commands
-
-@table @asis
-@item @kbd{C-c [} (@code{org-agenda-file-to-front})
-@kindex C-c [
-@findex org-agenda-file-to-front
-@cindex files, adding to agenda list
-Add current file to the list of agenda files. The file is added to
-the front of the list. If it was already in the list, it is moved
-to the front. With a prefix argument, file is added/moved to the
-end.
-
-@item @kbd{C-c ]} (@code{org-remove-file})
-@kindex C-c ]
-@findex org-remove-file
-Remove current file from the list of agenda files.
-
-@item @kbd{C-'}
-@itemx @kbd{C-,} (@code{org-cycle-agenda-files})
-@kindex C-'
-@kindex C-,
-@findex org-cycle-agenda-files
-@cindex cycling, of agenda files
-Cycle through agenda file list, visiting one file after the other.
-
-@item @kbd{M-x org-switchb}
-@findex org-switchb
-Command to use an Iswitchb-like interface to switch to and between
-Org buffers.
-@end table
-
-@noindent
-The Org menu contains the current list of files and can be used to
-visit any of them.
-
-If you would like to focus the agenda temporarily on a file not in
-this list, or on just one file in the list, or even on only a subtree
-in a file, then this can be done in different ways. For a single
-agenda command, you may press @kbd{<} once or several times in
-the dispatcher (see @ref{Agenda Dispatcher}). To restrict the agenda
-scope for an extended period, use the following commands:
-
-@table @asis
-@item @kbd{C-c C-x <} (@code{org-agenda-set-restriction-lock})
-@kindex C-c C-x <
-@findex org-agenda-set-restriction-lock
-Restrict the agenda to the current subtree. If there already is
-a restriction at point, remove it. When called with a universal
-prefix argument or with point before the first headline in a file,
-set the agenda scope to the entire file. This restriction remains
-in effect until removed with @kbd{C-c C-x >}, or by typing
-either @kbd{<} or @kbd{>} in the agenda dispatcher. If
-there is a window displaying an agenda view, the new restriction
-takes effect immediately.
-
-@item @kbd{C-c C-x >} (@code{org-agenda-remove-restriction-lock})
-@kindex C-c C-x >
-@findex org-agenda-remove-restriction-lock
-Remove the restriction created by @kbd{C-c C-x <}.
-@end table
-
-When working with Speedbar, you can use the following commands in the
-Speedbar frame:
-
-@table @asis
-@item @kbd{<} (@code{org-speedbar-set-agenda-restriction})
-@findex org-speedbar-set-agenda-restriction
-Restrict the agenda to the item---either an Org file or a subtree in
-such a file---at point in the Speedbar frame. If agenda is already
-restricted there, remove the restriction. If there is a window
-displaying an agenda view, the new restriction takes effect
-immediately.
-
-@item @kbd{>} (@code{org-agenda-remove-restriction-lock})
-@findex org-agenda-remove-restriction-lock
-Remove the restriction.
-@end table
-
-@node Agenda Dispatcher
-@section The Agenda Dispatcher
-
-@cindex agenda dispatcher
-@cindex dispatching agenda commands
-
-The views are created through a dispatcher, accessible with @kbd{M-x org-agenda}, or, better, bound to a global key (see @ref{Activation}).
-It displays a menu from which an additional letter is required to
-execute a command. The dispatcher offers the following default
-commands:
-
-@table @asis
-@item @kbd{a}
-Create the calendar-like agenda (see @ref{Weekly/daily agenda}).
-
-@item @kbd{t}
-@itemx @kbd{T}
-Create a list of all TODO items (see @ref{Global TODO list}).
-
-@item @kbd{m}
-@itemx @kbd{M}
-Create a list of headlines matching a given expression (see
-@ref{Matching tags and properties}).
-
-@item @kbd{s}
-@kindex s @r{(Agenda dispatcher)}
-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.
-
-@item @kbd{/}
-@kindex / @r{(Agenda dispatcher)}
-@vindex org-agenda-text-search-extra-files
-Search for a regular expression in all agenda files and additionally
-in the files listed in @code{org-agenda-text-search-extra-files}. This
-uses the Emacs command @code{multi-occur}. A prefix argument can be used
-to specify the number of context lines for each match, default is
-@enumerate
-@item
-@end enumerate
-
-@item @kbd{#}
-Create a list of stuck projects (see @ref{Stuck projects}).
-
-@item @kbd{!}
-Configure the list of stuck projects (see @ref{Stuck projects}).
-
-@item @kbd{<}
-@kindex < @r{(Agenda dispatcher)}
-Restrict an agenda command to the current buffer@footnote{For backward compatibility, you can also press @kbd{1} to
-restrict to the current buffer.}. If
-narrowing is in effect restrict to the narrowed part of the buffer.
-After pressing @kbd{<}, you still need to press the character
-selecting the command.
-
-@item @kbd{< <}
-@kindex < < @r{(Agenda dispatcher)}
-If there is an active region, restrict the following agenda command
-to the region. Otherwise, restrict it to the current
-subtree@footnote{For backward compatibility, you can also press @kbd{0} to
-restrict to the current region/subtree.}. After pressing @kbd{< <}, you still need to
-press the character selecting the command.
-
-@item @kbd{*}
-@kindex * @r{(Agenda dispatcher)}
-@vindex org-agenda-sticky
-@findex org-toggle-sticky-agenda
-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}.
-@end table
-
-You can also define custom commands that are accessible through the
-dispatcher, just like the default commands. This includes the
-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. See @ref{Custom Agenda Views}.
-
-@node Built-in Agenda Views
-@section The Built-in Agenda Views
-
-In this section we describe the built-in views.
-
-@menu
-* 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.
-* Search view:: Find entries by searching for text.
-* Stuck projects:: Find projects you need to review.
-@end menu
-
-@node Weekly/daily agenda
-@subsection Weekly/daily agenda
-
-@cindex agenda
-@cindex weekly agenda
-@cindex daily agenda
-
-The purpose of the weekly/daily @emph{agenda} is to act like a page of
-a paper agenda, showing all the tasks for the current week or day.
-
-@table @asis
-@item @kbd{M-x org-agenda a} (@code{org-agenda-list})
-@kindex a @r{(Agenda dispatcher)}
-@findex org-agenda-list
-@cindex org-agenda, command
-Compile an agenda for the current week from a list of Org files.
-The agenda shows the entries for each day. With a numeric prefix
-argument@footnote{For backward compatibility, the universal prefix argument
-@kbd{C-u} causes all TODO entries to be listed before the agenda.
-This feature is deprecated, use the dedicated TODO list, or a block
-agenda instead (see @ref{Block agenda}).}---like @kbd{C-u 2 1 M-x org-agenda a}---you may
-set the number of days to be displayed.
-@end table
-
-@vindex org-agenda-span
-@vindex org-agenda-start-day
-@vindex org-agenda-start-on-weekday
-The default number of days displayed in the agenda is set by the
-variable @code{org-agenda-span}. This variable can be set to any number of
-days you want to see by default in the agenda, or to a span name, such
-a @code{day}, @code{week}, @code{month} or @code{year}. For weekly agendas, the default
-is to start on the previous Monday (see
-@code{org-agenda-start-on-weekday}). You can also set the start date using
-a date shift: @samp{(setq org-agenda-start-day "+10d")} starts the agenda
-ten days from today in the future.
-
-Remote editing from the agenda buffer means, for example, that you can
-change the dates of deadlines and appointments from the agenda buffer.
-The commands available in the Agenda buffer are listed in @ref{Agenda Commands}.
-
-@anchor{Calendar/Diary integration}
-@subsubheading Calendar/Diary integration
-
-@cindex calendar integration
-@cindex diary integration
-
-Emacs contains the calendar and diary by Edward@tie{}M@.@tie{}Reingold. The
-calendar displays a three-month calendar with holidays from different
-countries and cultures. The diary allows you to keep track of
-anniversaries, lunar phases, sunrise/set, recurrent appointments
-(weekly, monthly) and more. In this way, it is quite complementary to
-Org. It can be very useful to combine output from Org with the diary.
-
-In order to include entries from the Emacs diary into Org mode's
-agenda, you only need to customize the variable
-
-@lisp
-(setq org-agenda-include-diary t)
-@end lisp
-
-@noindent
-After that, everything happens automatically. All diary entries
-including holidays, anniversaries, etc., are included in the agenda
-buffer created by Org mode. @kbd{@key{SPC}}, @kbd{@key{TAB}}, and
-@kbd{@key{RET}} can be used from the agenda buffer to jump to the diary
-file in order to edit existing diary entries. The @kbd{i}
-command to insert new entries for the current date works in the agenda
-buffer, as well as the commands @kbd{S}, @kbd{M}, and
-@kbd{C} to display Sunrise/Sunset times, show lunar phases and to
-convert to other calendars, respectively. @kbd{c} can be used to
-switch back and forth between calendar and agenda.
-
-If you are using the diary only for expression entries and holidays,
-it is faster to not use the above setting, but instead to copy or even
-move the entries into an Org file. Org mode evaluates diary-style
-expression entries, and does it faster because there is no overhead
-for first creating the diary display. Note that the expression
-entries must start at the left margin, no whitespace is allowed before
-them, as seen in the following segment of an Org file:@footnote{The variable @code{org-anniversary} used in the example 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}.}
-
-@example
-* Holidays
- :PROPERTIES:
- :CATEGORY: Holiday
- :END:
-%%(org-calendar-holiday) ; special function for holiday names
-
-* Birthdays
- :PROPERTIES:
- :CATEGORY: Ann
- :END:
-%%(org-anniversary 1956 5 14) Arthur Dent is %d years old
-%%(org-anniversary 1869 10 2) Mahatma Gandhi would be %d years old
-@end example
-
-@anchor{Anniversaries from BBDB}
-@subsubheading Anniversaries from BBDB
-
-@cindex BBDB, anniversaries
-@cindex anniversaries, from BBDB
-
-@findex org-bbdb-anniversaries
-If you are using the Insidious Big Brother Database to store your
-contacts, you very likely prefer to store anniversaries in BBDB rather
-than in a separate Org or diary file. Org supports this and can show
-BBDB anniversaries as part of the agenda. All you need to do is to
-add the following to one of your agenda files:
-
-@example
-* Anniversaries
- :PROPERTIES:
- :CATEGORY: Anniv
- :END:
-%%(org-bbdb-anniversaries)
-@end example
-
-You can then go ahead and define anniversaries for a BBDB record.
-Basically, you need a field named @samp{anniversary} for the BBDB record
-which contains the date in the format @samp{YYYY-MM-DD} or @samp{MM-DD},
-followed by a space and the class of the anniversary (@samp{birthday},
-@samp{wedding}, or a format string). If you omit the class, it defaults to
-@samp{birthday}. Here are a few examples, the header for the file
-@samp{ol-bbdb.el} contains more detailed information.
-
-@example
-1973-06-22
-06-22
-1955-08-02 wedding
-2008-04-14 %s released version 6.01 of Org mode, %d years ago
-@end example
-
-After a change to BBDB, or for the first agenda display during an
-Emacs session, the agenda display suffers a short delay as Org updates
-its 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.
-
-@findex org-bbdb-anniversaries-future
-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.
-
-@anchor{Appointment reminders}
-@subsubheading Appointment reminders
-
-@cindex @file{appt.el}
-@cindex appointment reminders
-@cindex appointment
-@cindex reminders
-
-@cindex APPT_WARNTIME, keyword
-Org can interact with Emacs appointments notification facility. To
-add the appointments of your agenda files, use the command
-@code{org-agenda-to-appt}. This command lets you filter through the list
-of your appointments and add only those belonging to a specific
-category or matching a regular expression. It also reads
-a @samp{APPT_WARNTIME} property which overrides the value of
-@code{appt-message-warning-time} for this appointment. See the docstring
-for details.
-
-@node Global TODO list
-@subsection The global TODO list
-
-@cindex global TODO list
-@cindex TODO list, global
-
-The global TODO list contains all unfinished TODO items formatted and
-collected into a single place.
-
-@table @asis
-@item @kbd{M-x org-agenda t} (@code{org-todo-list})
-@kindex t @r{(Agenda dispatcher)}
-@findex org-todo-list
-Show the global TODO list. This collects the TODO items from all
-agenda files (see @ref{Agenda Views}) into a single buffer. By default,
-this lists items with a state the is not a DONE state. The buffer
-is in Agenda mode, so there are commands to examine and manipulate
-the TODO entries directly from that buffer (see @ref{Agenda Commands}).
-
-@item @kbd{M-x org-agenda T} (@code{org-todo-list})
-@kindex T @r{(Agenda dispatcher)}
-@findex org-todo-list
-@cindex TODO keyword matching
-@vindex org-todo-keywords
-Like the above, but allows selection of a specific TODO keyword.
-You can also do this by specifying a prefix argument to
-@kbd{t}. You are prompted for a keyword, and you may also
-specify several keywords by separating them with @samp{|} as the boolean
-OR operator. With a numeric prefix, the Nth keyword in
-@code{org-todo-keywords} is selected.
-
-@kindex r
-The @kbd{r} key in the agenda buffer regenerates it, and you
-can give a prefix argument to this command to change the selected
-TODO keyword, for example @kbd{3 r}. If you often need
-a search for a specific keyword, define a custom command for it (see
-@ref{Agenda Dispatcher}).
-
-Matching specific TODO keywords can also be done as part of a tags
-search (see @ref{Tag Searches}).
-@end table
-
-Remote editing of TODO items means that you can change the state of
-a TODO entry with a single key press. The commands available in the
-TODO list are described in @ref{Agenda Commands}.
-
-@cindex sublevels, inclusion into TODO list
-Normally the global TODO list simply shows all headlines with TODO
-keywords. This list can become very long. There are two ways to keep
-it more compact:
-
-@itemize
-@item
-@vindex org-agenda-todo-ignore-scheduled
-@vindex org-agenda-todo-ignore-deadlines
-@vindex org-agenda-todo-ignore-timestamp
-@vindex org-agenda-todo-ignore-with-date
-Some people view a TODO item that has been @emph{scheduled} for execution
-or have a @emph{deadline} (see @ref{Timestamps}) as no longer @emph{open}.
-Configure the variables @code{org-agenda-todo-ignore-scheduled} to
-exclude some or all scheduled items from the global TODO list,
-@code{org-agenda-todo-ignore-deadlines} to exclude some or all items with
-a deadline set, @code{org-agenda-todo-ignore-timestamp} to exclude some
-or all items with an active timestamp other than a DEADLINE or
-a SCHEDULED timestamp and/or @code{org-agenda-todo-ignore-with-date} to
-exclude items with at least one active timestamp.
-
-@item
-@vindex org-agenda-todo-list-sublevels
-TODO items may have sublevels to break up the task into subtasks.
-In such cases it may be enough to list only the highest level TODO
-headline 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
-@subsection Matching tags and properties
-
-@cindex matching, of tags
-@cindex matching, of properties
-@cindex tags view
-@cindex match view
-
-If headlines in the agenda files are marked with @emph{tags} (see @ref{Tags}),
-or have properties (see @ref{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}.
-
-@table @asis
-@item @kbd{M-x org-agenda m} (@code{org-tags-view})
-@kindex m @r{(Agenda dispatcher)}
-@findex org-tags-view
-Produce a list of all headlines that match a given set of tags. The
-command prompts for a selection criterion, which is a boolean logic
-expression with tags, like @samp{+work+urgent-withboss} or @samp{work|home}
-(see @ref{Tags}). If you often need a specific search, define a custom
-command for it (see @ref{Agenda Dispatcher}).
-
-@item @kbd{M-x org-agenda M} (@code{org-tags-view})
-@kindex M @r{(Agenda dispatcher)}
-@findex org-tags-view
-@vindex org-tags-match-list-sublevels
-@vindex org-agenda-tags-todo-honor-ignore-options
-Like @kbd{m}, but only select headlines that are also TODO
-items and force checking subitems (see the variable
-@code{org-tags-match-list-sublevels}). To exclude scheduled/deadline
-items, see the variable @code{org-agenda-tags-todo-honor-ignore-options}.
-Matching specific TODO keywords together with a tags match is also
-possible, see @ref{Tag Searches}.
-@end table
-
-The commands available in the tags list are described in @ref{Agenda Commands}.
-
-@cindex boolean logic, for agenda searches
-A search string can use Boolean operators @samp{&} for AND and @samp{|} for OR@.
-@samp{&} binds more strongly than @samp{|}. Parentheses are currently not
-implemented. Each element in the search is either a tag, a regular
-expression matching tags, or an expression like @samp{PROPERTY OPERATOR
-VALUE} with a comparison operator, accessing a property value. Each
-element may be preceded by @samp{-} to select against it, and @samp{+} is
-syntactic sugar for positive selection. The AND operator @samp{&} is
-optional when @samp{+} or @samp{-} is present. Here are some examples, using
-only tags.
-
-@table @asis
-@item @samp{+work-boss}
-Select headlines tagged @samp{work}, but discard those also tagged
-@samp{boss}.
-
-@item @samp{work|laptop}
-Selects lines tagged @samp{work} or @samp{laptop}.
-
-@item @samp{work|laptop+night}
-Like before, but require the @samp{laptop} lines to be tagged also
-@samp{night}.
-@end table
-
-@cindex regular expressions, with tags search
-Instead of a tag, you may also specify a regular expression enclosed
-in curly braces. For example, @samp{work+@{^boss.*@}} matches headlines that
-contain the tag @samp{:work:} and any tag @emph{starting} with @samp{boss}.
-
-@cindex group tags, as regular expressions
-Group tags (see @ref{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} also searches for @samp{@{\(?:work\|lab\|conf\)@}} and
-searching for @samp{-work} searches for all headlines but those with one of
-the tags in the group (i.e., @samp{-@{\(?:work\|lab\|conf\)@}}).
-
-@cindex TODO keyword matching, with tags search
-@cindex level, for tags/property match
-@cindex category, for tags/property match
-@vindex org-odd-levels-only
-You may also test for properties (see @ref{Properties and Columns}) at the
-same time as matching tags. The properties may be real properties, or
-special properties that represent other metadata (see @ref{Special Properties}). For example, the property @samp{TODO} represents the TODO
-keyword of the entry. Or, the property @samp{LEVEL} represents the level
-of an entry. So searching @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 @samp{DONE}. In buffers with @code{org-odd-levels-only} set,
-@samp{LEVEL} does not count the number of stars, but @samp{LEVEL=2} corresponds
-to 3 stars etc.
-
-Here are more examples:
-
-@table @asis
-@item @samp{work+TODO​="WAITING"}
-Select @samp{work}-tagged TODO lines with the specific TODO keyword
-@samp{WAITING}.
-
-@item @samp{work+TODO​="WAITING"|home+TODO​="WAITING"}
-Waiting tasks both at work and at home.
-@end table
-
-When matching properties, a number of different operators can be used
-to test the value of a property. Here is a complex example:
-
-@example
-+work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2
- +With=@{Sarah|Denny@}+SCHEDULED>="<2008-10-11>"
-@end example
-
-@noindent
-The type of comparison depends on how the comparison value is written:
-
-@itemize
-@item
-If the comparison value is a plain number, a numerical comparison is
-done, and the allowed operators are @samp{<}, @samp{=}, @samp{>}, @samp{<=}, @samp{>=}, and
-@samp{<>}.
-
-@item
-If the comparison value is enclosed in double-quotes, a string
-comparison is done, and the same operators are allowed.
-
-@item
-If the comparison value is enclosed in double-quotes @emph{and} angular
-brackets (like @samp{DEADLINE<​="<2008-12-24 18:30>"}), both values are
-assumed to be date/time specifications in the standard Org way, and
-the comparison is done accordingly. Valid values also include
-@samp{"<now>"} for now (including time), @samp{"<today>"}, and @samp{"<tomorrow>"}
-for these days at 0:00 hours, i.e., without a time specification.
-You can also use strings like @samp{"<+5d>"} or @samp{"<-2m>"} with units @samp{d},
-@samp{w}, @samp{m}, and @samp{y} for day, week, month, and year, respectively.
-
-@item
-If the comparison value is enclosed in curly braces, a regexp match
-is performed, with @samp{=} meaning that the regexp matches the property
-value, and @samp{<>} meaning that it does not match.
-@end itemize
-
-So the search string in the example finds entries tagged @samp{work} but
-not @samp{boss}, which also have a priority value @samp{A}, a @samp{Coffee} property
-with the value @samp{unlimited}, an @samp{EFFORT} 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.
-
-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.
-
-For backward compatibility, and also for typing speed, there is also
-a different way to test TODO states in a search. For this, terminate
-the tags/property part of the search string (which may include several
-terms connected with @samp{|}) with a @samp{/} and then specify a Boolean
-expression just for TODO keywords. The syntax is then similar to that
-for tags, but should be applied with care: for example, a positive
-selection on several TODO keywords cannot meaningfully be combined
-with boolean AND@. However, @emph{negative selection} combined with AND can
-be meaningful. To make sure that only lines are checked that actually
-have any TODO keyword (resulting in a speed-up), use @kbd{M-x org-agenda M}, or equivalently start the TODO part after the slash
-with @samp{!}. Using @kbd{M-x org-agenda M} or @samp{/!} does not match
-TODO keywords in a DONE state. Examples:
-
-@table @asis
-@item @samp{work/WAITING}
-Same as @samp{work+TODO​="WAITING"}.
-
-@item @samp{work/!-WAITING-NEXT}
-Select @samp{work}-tagged TODO lines that are neither @samp{WAITING} nor
-@samp{NEXT}.
-
-@item @samp{work/!+WAITING|+NEXT}
-Select @samp{work}-tagged TODO lines that are either @samp{WAITING} or @samp{NEXT}.
-@end table
-
-@node Search view
-@subsection Search view
-
-@cindex search view
-@cindex text search
-@cindex searching, for text
-
-This agenda view is a general text search facility for Org mode
-entries. It is particularly useful to find notes.
-
-@table @asis
-@item @kbd{M-x org-agenda s} (@code{org-search-view})
-@kindex s @r{(Agenda dispatcher)}
-@findex org-search-view
-This is a special search that lets you select entries by matching
-a substring or specific words using a boolean logic.
-@end table
-
-For example, the search string @samp{computer equipment} matches entries
-that contain @samp{computer equipment} as a substring, even if the two
-words are separated by more space or a line break.
-
-Search view can also search for specific keywords in the entry, using
-Boolean logic. The search string @samp{+computer
-+wifi -ethernet -@{8\.11[bg]@}} matches note entries that contain the
-keywords @samp{computer} and @samp{wifi}, but not the keyword @samp{ethernet}, and
-which are also not matched by the regular expression @samp{8\.11[bg]},
-meaning to exclude both @samp{8.11b} and @samp{8.11g}. The first @samp{+} is
-necessary to turn on boolean search, other @samp{+} characters are
-optional. For more details, see the docstring of the command
-@code{org-search-view}.
-
-You can incrementally and conveniently adjust a boolean search from
-the agenda search view with the following keys
-
-@multitable @columnfractions 0.1 0.6
-@item @kbd{[}
-@tab Add a positive search word
-@item @kbd{]}
-@tab Add a negative search word
-@item @kbd{@{}
-@tab Add a positive regular expression
-@item @kbd{@}}
-@tab Add a negative regular expression
-@end multitable
-
-@vindex org-agenda-text-search-extra-files
-Note that in addition to the agenda files, this command also searches
-the files listed in @code{org-agenda-text-search-extra-files}.
-
-@node Stuck projects
-@subsection Stuck projects
-
-@pindex GTD, Getting Things Done
-
-If you are following a system like David Allen's GTD to organize your
-work, one of the ``duties'' you have is a regular review to make sure
-that all projects move along. A @emph{stuck} project is a project that has
-no defined next actions, so it never shows up in the TODO lists Org
-mode produces. During the review, you need to identify such projects
-and define next actions for them.
-
-@table @asis
-@item @kbd{M-x org-agenda #} (@code{org-agenda-list-stuck-projects})
-@kindex # @r{(Agenda dispatcher)}
-@findex org-agenda-list-stuck-projects
-List projects that are stuck.
-
-@item @kbd{M-x org-agenda !}
-@kindex ! @r{(Agenda dispatcher)}
-@vindex org-stuck-projects
-Customize the variable @code{org-stuck-projects} to define what a stuck
-project is and how to find it.
-@end table
-
-You almost certainly need to configure this view before it works for
-you. The built-in default assumes that all your projects are level-2
-headlines, and that a project is not stuck if it has at least one
-entry marked with a TODO keyword @samp{TODO} or @samp{NEXT} or @samp{NEXTACTION}.
-
-Let's assume that you, in your own way of using Org mode, identify
-projects with a tag @samp{:PROJECT:}, and that you use a TODO keyword
-@samp{MAYBE} to indicate a project that should not be considered yet.
-Let's further assume that the TODO keyword @samp{DONE} marks finished
-projects, and that @samp{NEXT} and @samp{TODO} indicate next actions. The tag
-@samp{:@@shop:} indicates shopping and is a next action even without the
-NEXT tag. Finally, if the project contains the special word @samp{IGNORE}
-anywhere, it should not be listed either. In this case you would
-start by identifying eligible projects with a tags/TODO match (see
-@ref{Tag Searches}) @samp{+PROJECT/-MAYBE-DONE}, and then check for @samp{TODO},
-@samp{NEXT}, @samp{@@shop}, and @samp{IGNORE} in the subtree to identify projects that
-are not stuck. The correct customization for this is:
-
-@lisp
-(setq org-stuck-projects
- '("+PROJECT/-MAYBE-DONE" ("NEXT" "TODO") ("@@shop")
- "\\<IGNORE\\>"))
-@end lisp
-
-Note that if a project is identified as non-stuck, the subtree of this
-entry is searched for stuck projects.
-
-@node Presentation and Sorting
-@section Presentation and Sorting
-
-@cindex presentation, of agenda items
-
-@vindex org-agenda-prefix-format
-@vindex org-agenda-tags-column
-Before displaying items in an agenda view, Org mode visually prepares
-the items and sorts them. Each item occupies a single line. The line
-starts with a @emph{prefix} that contains the @emph{category} (see @ref{Categories})
-of the item and other important information. You can customize in
-which column tags are displayed through @code{org-agenda-tags-column}. You
-can also customize the prefix using the option
-@code{org-agenda-prefix-format}. This prefix is followed by a cleaned-up
-version of the outline headline associated with the item.
-
-@menu
-* Categories:: Not all tasks are equal.
-* Time-of-day specifications:: How the agenda knows the time.
-* Sorting of agenda items:: The order of things.
-* Filtering/limiting agenda items:: Dynamically narrow the agenda.
-@end menu
-
-@node Categories
-@subsection Categories
-
-@cindex category
-@cindex @samp{CATEGORY}, keyword
-
-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
-@end example
-
-
-@cindex @samp{CATEGORY}, property
-If you would like to have a special category for a single entry or
-a (sub)tree, give the entry a @samp{CATEGORY} property with the special
-category you want to apply as the value.
-
-@vindex org-agenda-category-icon-alist
-The display in the agenda buffer looks best if the category is not
-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
-@subsection Time-of-day specifications
-
-@cindex time-of-day specification
-
-Org mode checks each agenda item for a time-of-day specification. The
-time can be part of the timestamp that triggered inclusion into the
-agenda, for example
-
-@example
-<2005-05-10 Tue 19:00>
-@end example
-
-
-@noindent
-Time ranges can be specified with two timestamps:
-
-@example
-<2005-05-10 Tue 20:30>--<2005-05-10 Tue 22:15>
-@end example
-
-
-@vindex org-agenda-search-headline-for-time
-In the headline of the entry itself, a time(range)---like @samp{12:45} or
-a @samp{8:30-1pm}---may also appear as plain text@footnote{You can, however, disable this by setting
-@code{org-agenda-search-headline-for-time} variable to a @code{nil} value.}.
-
-If the agenda integrates the Emacs diary (see @ref{Weekly/daily agenda}),
-time specifications in diary entries are recognized as well.
-
-For agenda display, Org mode extracts the time and displays it in
-a standard 24 hour format as part of the prefix. The example times in
-the previous paragraphs would end up in the agenda like this:
-
-@example
- 8:30-13:00 Arthur Dent lies in front of the bulldozer
-12:45...... Ford Prefect arrives and takes Arthur to the pub
-19:00...... The Vogon reads his poem
-20:30-22:15 Marvin escorts the Hitchhikers to the bridge
-@end example
-
-@cindex time grid
-If the agenda is in single-day mode, or for the display of today, the
-timed entries are embedded in a time grid, like
-
-@example
- 8:00...... ------------------
- 8:30-13:00 Arthur Dent lies in front of the bulldozer
-10:00...... ------------------
-12:00...... ------------------
-12:45...... Ford Prefect arrives and takes Arthur to the pub
-14:00...... ------------------
-16:00...... ------------------
-18:00...... ------------------
-19:00...... The Vogon reads his poem
-20:00...... ------------------
-20:30-22:15 Marvin escorts the Hitchhikers to the bridge
-@end example
-
-@vindex org-agenda-use-time-grid
-@vindex org-agenda-time-grid
-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 of agenda items
-@subsection Sorting of agenda items
-
-@cindex sorting, of agenda items
-@cindex priorities, of agenda items
-
-Before being inserted into a view, the items are sorted. How this is
-done depends on the type of view.
-
-@itemize
-@item
-@vindex org-agenda-files
-For the daily/weekly agenda, the items for each day are sorted. The
-default order is to first collect all items containing an explicit
-time-of-day specification. These entries are shown at the beginning
-of the list, as a @emph{schedule} for the day. After that, items remain
-grouped in categories, in the sequence given by @code{org-agenda-files}.
-Within each category, items are sorted by priority (see
-@ref{Priorities}), which is composed of the base priority (2000 for
-priority @samp{A}, 1000 for @samp{B}, and 0 for @samp{C}), plus additional
-increments for overdue scheduled or deadline items.
-
-@item
-For the TODO list, items remain in the order of categories, but
-within each category, sorting takes place according to priority (see
-@ref{Priorities}). The priority used for sorting derives from the
-priority cookie, with additions depending on how close an item is to
-its due or scheduled date.
-
-@item
-For tags matches, items are not sorted at all, but just appear in
-the sequence in which they are found in the agenda files.
-@end itemize
-
-@vindex org-agenda-sorting-strategy
-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 (see @ref{Effort Estimates}).
-
-@node Filtering/limiting agenda items
-@subsection Filtering/limiting agenda items
-
-@vindex org-agenda-category-filter-preset
-@vindex org-agenda-tag-filter-preset
-@vindex org-agenda-effort-filter-preset
-@vindex org-agenda-regexp-filter-preset
-Agenda built-in or custom commands are statically defined. Agenda
-filters and limits allow to flexibly narrow down the list of agenda
-entries.
-
-@emph{Filters} only change the visibility of items, are very fast and are
-mostly used interactively@footnote{Custom agenda commands can preset a filter by binding one of
-the variables @code{org-agenda-tag-filter-preset},
-@code{org-agenda-category-filter-preset}, @code{org-agenda-effort-filter-preset}
-or @code{org-agenda-regexp-filter-preset} as an option. This filter is
-then applied to the view and persists as a basic filter through
-refreshes and more secondary filtering. The filter is a global
-property of the entire agenda view---in a block agenda, you should
-only set this in the global options section, not in the section of an
-individual block.}. You can switch quickly between
-different filters without having to recreate the agenda. @emph{Limits} on
-the other hand take effect before the agenda buffer is populated, so
-they are mostly useful when defined as local variables within custom
-agenda commands.
-
-@anchor{Filtering in the agenda}
-@subsubheading Filtering in the agenda
-
-@cindex agenda filtering
-@cindex filtering entries, in agenda
-@cindex tag filtering, in agenda
-@cindex category filtering, in agenda
-@cindex top headline filtering, in agenda
-@cindex effort filtering, in agenda
-@cindex query editing, in agenda
-
-The general filtering command is @code{org-agenda-filter}, bound to
-@kbd{/}. Before we introduce it, we describe commands for
-individual filter types. All filtering commands handle prefix
-arguments in the same way: A single @kbd{C-u} prefix negates the
-filter, so it removes lines selected by the filter. A double prefix
-adds the new filter condition to the one(s) already in place, so
-filter elements are accumulated.
-
-@table @asis
-@item @kbd{\} (@code{org-agenda-filter-by-tag})
-@findex org-agenda-filter-by-tag
-Filter the agenda view with respect to a tag. You are prompted for
-a tag selection letter; @kbd{@key{SPC}} means any tag at all.
-Pressing @kbd{@key{TAB}} at that prompt offers 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. Pressing @kbd{+} or @kbd{-} at the prompt switches
-between filtering for and against the next tag. To clear the
-filter, press @kbd{\} twice (once to call the command again,
-and once at the prompt).
-
-@item @kbd{<} (@code{org-agenda-filter-by-category})
-@findex org-agenda-filter-by-category
-Filter by category of the line at point, and show only entries with
-this category. When called with a prefix argument, hide all entries
-with the category at point. To clear the filter, call this command
-again by pressing @kbd{<}.
-
-@item @kbd{=} (@code{org-agenda-filter-by-regexp})
-@findex org-agenda-filter-by-regexp
-Filter the agenda view by a regular expression: only show agenda
-entries matching the regular expression the user entered. To clear
-the filter, call the command again by pressing @kbd{=}.
-
-@item @kbd{_} (@code{org-agenda-filter-by-effort})
-@findex org-agenda-filter-by-effort
-Filter the agenda view with respect to effort estimates, so select
-tasks that take the right amount of time. You first need to set up
-a list of 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
-
-@vindex org-sort-agenda-noeffort-is-high
-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 then
-restricts 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 are treated according to
-the value of @code{org-sort-agenda-noeffort-is-high}. To clear the
-filter, press @kbd{_} twice (once to call the command again,
-and once at the first prompt).
-
-@item @kbd{^} (@code{org-agenda-filter-by-top-headline})
-@findex org-agenda-filter-by-top-headline
-Filter the current agenda view and only display items that fall
-under the same top-level headline as the current entry. To clear
-the filter, call this command again by pressing @kbd{^}.
-
-@item @kbd{/} (@code{org-agenda-filter})
-@findex org-agenda-filter
-This is the unified interface to four of the five filter methods
-described above. At the prompt, specify different filter elements
-in a single string, with full completion support. For example,
-
-@example
-+work-John+<0:10-/plot/
-@end example
-
-
-selects entries with category @samp{work} and effort estimates below 10
-minutes, and deselects entries with tag @samp{John} or matching the
-regexp @samp{plot}. You can leave @samp{+} out if that does not lead to
-ambiguities. The sequence of elements is arbitrary. The filter
-syntax assumes that there is no overlap between categories and tags.
-Otherwise, tags take priority. If you reply to the prompt with the
-empty string, all filtering is removed. If a filter is specified,
-it replaces all current filters. But if you call the command with
-a double prefix argument, or if you add an additional @samp{+} (e.g.,
-@samp{++work}) to the front of the string, the new filter elements are
-added to the active ones. A single prefix argument applies the
-entire filter in a negative sense.
-
-@item @kbd{|} (@code{org-agenda-filter-remove-all})
-Remove all filters in the current agenda view.
-@end table
-
-@anchor{Computed tag filtering}
-@subsubheading Computed tag filtering
-
-@vindex org-agenda-auto-exclude-function
-If the variable @code{org-agenda-auto-exclude-function} is set to
-a user-defined function, that function can select tags that should be
-used as a tag filter when requested. The function will be called with
-lower-case versions of all tags represented in the current view. The
-function should return @samp{"-tag"} if the filter should remove
-entries with that tag, @samp{"+tag"} if only entries with this tag should
-be kept, or @samp{nil} if that tag is irrelevant. For example, let's say
-you use a @samp{Net} tag to identify tasks which need network access, an
-@samp{Errand} tag for errands in town, and a @samp{Call} tag for making phone
-calls. You could auto-exclude these tags based on the availability of
-the Internet, and outside of business hours, with something like this:
-
-@lisp
-(defun my-auto-exclude-fn (tag)
- (when (cond ((string= tag "net")
- (/= 0 (call-process "/sbin/ping" nil nil nil
- "-c1" "-q" "-t1" "mail.gnu.org")))
- ((member tag '("errand" "call"))
- (let ((hr (nth 2 (decode-time))))
- (or (< hr 8) (> hr 21)))))
- (concat "-" tag)))
-
-(setq org-agenda-auto-exclude-function #'my-auto-exclude-fn)
-@end lisp
-
-You can apply this self-adapting filter by using a triple prefix
-argument to @code{org-agenda-filter}, i.e.@tie{}press @kbd{C-u C-u C-u /},
-or by pressing @kbd{@key{RET}} in @code{org-agenda-filter-by-tag}.
-
-@anchor{Setting limits for the agenda}
-@subsubheading Setting limits for the agenda
-
-@cindex limits, in agenda
-
-Here is a list of options that you can set, either globally, or
-locally in your custom agenda views (see @ref{Custom Agenda Views}).
-
-@table @asis
-@item @code{org-agenda-max-entries}
-@vindex org-agenda-max-entries
-Limit the number of entries.
-
-@item @code{org-agenda-max-effort}
-@vindex org-agenda-max-effort
-Limit the duration of accumulated efforts (as minutes).
-
-@item @code{org-agenda-max-todos}
-@vindex org-agenda-max-todos
-Limit the number of entries with TODO keywords.
-
-@item @code{org-agenda-max-tags}
-@vindex org-agenda-max-tags
-Limit the number of tagged entries.
-@end table
-
-When set to a positive integer, each option excludes entries from
-other categories: for example, @samp{(setq org-agenda-max-effort 100)}
-limits 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}. One
-useful setup is to use @code{org-agenda-max-entries} locally in a custom
-command. For example, this custom command displays the next five
-entries with a @samp{NEXT} TODO keyword.
-
-@lisp
-(setq org-agenda-custom-commands
- '(("n" todo "NEXT"
- ((org-agenda-max-entries 5)))))
-@end lisp
-
-Once you mark one of these five entry as 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, which are lost when
-rebuilding the agenda:
-
-@table @asis
-@item @kbd{~} (@code{org-agenda-limit-interactively})
-@findex org-agenda-limit-interactively
-This prompts for the type of limit to apply and its value.
-@end table
-
-@node Agenda Commands
-@section Commands in the Agenda Buffer
-
-@cindex commands, in agenda buffer
-
-Entries in the agenda buffer are linked back to the Org file or diary
-file where they originate. You are not allowed to edit the agenda
-buffer itself, but commands are provided to show and jump to the
-original entry location, and to edit the Org files ``remotely'' from the
-agenda buffer. In this way, all information is stored only once,
-removing the risk that your agenda and note files may diverge.
-
-Some commands can be executed with mouse clicks on agenda lines. For
-the other commands, point needs to be in the desired line.
-
-@anchor{Motion (1)}
-@subheading Motion
-
-@cindex motion commands in agenda
-
-@table @asis
-@item @kbd{n} (@code{org-agenda-next-line})
-@kindex n
-@findex org-agenda-next-line
-Next line (same as @kbd{@key{DOWN}} and @kbd{C-n}).
-
-@item @kbd{p} (@code{org-agenda-previous-line})
-@kindex p
-@findex org-agenda-previous-line
-Previous line (same as @kbd{@key{UP}} and @kbd{C-p}).
-@end table
-
-@anchor{View/Go to Org file}
-@subheading View/Go to Org file
-
-@cindex view file commands in agenda
-
-@table @asis
-@item @kbd{@key{SPC}} or @kbd{mouse-3} (@code{org-agenda-show-and-scroll-up})
-@kindex SPC
-@kindex mouse-3
-@findex org-agenda-show-and-scroll-up
-Display the original location of the item in another window.
-With a prefix argument, make sure that drawers stay folded.
-
-@item @kbd{L} (@code{org-agenda-recenter})
-@findex org-agenda-recenter
-Display original location and recenter that window.
-
-@item @kbd{@key{TAB}} or @kbd{mouse-2} (@code{org-agenda-goto})
-@kindex TAB
-@kindex mouse-2
-@findex org-agenda-goto
-Go to the original location of the item in another window.
-
-@item @kbd{@key{RET}} (@code{org-agenda-switch-to})
-@kindex RET
-@findex org-agenda-switch-to
-Go to the original location of the item and delete other windows.
-
-@item @kbd{F} (@code{org-agenda-follow-mode})
-@kindex F
-@findex org-agenda-follow-mode
-@vindex org-agenda-start-with-follow-mode
-Toggle Follow mode. In Follow mode, as you move point through the
-agenda buffer, the other window always shows the corresponding
-location in the Org file. The initial setting for this mode in new
-agenda buffers can be set with the variable
-@code{org-agenda-start-with-follow-mode}.
-
-@item @kbd{C-c C-x b} (@code{org-agenda-tree-to-indirect-buffer})
-@kindex C-c C-x b
-@findex org-agenda-tree-to-indirect-buffer
-Display the entire subtree of the current item in an indirect
-buffer. With a numeric prefix argument N, go up to level N and then
-take that tree. If N is negative, go up that many levels. With
-a @kbd{C-u} prefix, do not remove the previously used indirect
-buffer.
-
-@item @kbd{C-c C-o} (@code{org-agenda-open-link})
-@kindex C-c C-o
-@findex org-agenda-open-link
-Follow a link in the entry. This offers a selection of any links in
-the text belonging to the referenced Org node. If there is only one
-link, follow it without a selection prompt.
-@end table
-
-@anchor{Change display}
-@subheading Change display
-
-@cindex change agenda display
-@cindex display changing, in agenda
-
-@table @asis
-@item @kbd{A}
-@kindex A
-Interactively select another agenda view and append it to the
-current view.
-
-@item @kbd{o}
-@kindex o
-Delete other windows.
-
-@item @kbd{v d} or short @kbd{d} (@code{org-agenda-day-view})
-@kindex v d
-@kindex d
-@findex org-agenda-day-view
-Switch to day view. When switching to day view, this setting
-becomes the default for subsequent agenda refreshes. A numeric
-prefix argument may be used to jump directly to a specific day of
-the year. For example, @kbd{32 d} jumps to February 1st. When
-setting day view, a year may be encoded in the prefix argument as
-well. For example, @kbd{200712 d} jumps to January 12, 2007.
-If such a year specification has only one or two digits, it is
-expanded into one of the 30 next years or the last 69 years.
-
-@item @kbd{v w} or short @kbd{w} (@code{org-agenda-week-view})
-@kindex v w
-@kindex w
-@findex org-agenda-week-view
-Switch to week view. When switching week view, this setting becomes
-the default for subsequent agenda refreshes. A numeric prefix
-argument may be used to jump directly to a specific day of the ISO
-week. For example @kbd{9 w} to ISO week number 9. When
-setting week view, a year may be encoded in the prefix argument as
-well. For example, @kbd{200712 w} jumps to week 12 in 2007.
-If such a year specification has only one or two digits, it is
-expanded into one of the 30 next years or the last 69 years.
-
-@item @kbd{v m} (@code{org-agenda-month-view})
-@kindex v m
-@findex org-agenda-month-view
-Switch to month view. Because month views are slow to create, they
-do not become the default for subsequent agenda refreshes.
-A numeric prefix argument may be used to jump directly to a specific
-day of the month. When setting month view, a year may be encoded in
-the prefix argument as well. For example, @kbd{200712 m} jumps
-to December, 2007. If such a year specification has only one or two
-digits, it is expanded into one of the 30 next years or the last 69
-years.
-
-@item @kbd{v y} (@code{org-agenda-year-view})
-@kindex v y
-@findex org-agenda-year-view
-Switch to year view. Because year views are slow to create, they do
-not become the default for subsequent agenda refreshes. A numeric
-prefix argument may be used to jump directly to a specific day of
-the year.
-
-@item @kbd{v @key{SPC}} (@code{org-agenda-reset-view})
-@kindex v SPC
-@findex org-agenda-reset-view
-@vindex org-agenda-span
-Reset the current view to @code{org-agenda-span}.
-
-@item @kbd{f} (@code{org-agenda-later})
-@kindex f
-@findex org-agenda-later
-Go forward in time to display the span following the current one.
-For example, if the display covers a week, switch to the following
-week. With a prefix argument, repeat that many times.
-
-@item @kbd{b} (@code{org-agenda-earlier})
-@kindex b
-@findex org-agenda-earlier
-Go backward in time to display earlier dates.
-
-@item @kbd{.} (@code{org-agenda-goto-today})
-@kindex .
-@findex org-agenda-goto-today
-Go to today.
-
-@item @kbd{j} (@code{org-agenda-goto-date})
-@kindex j
-@findex org-agenda-goto-date
-Prompt for a date and go there.
-
-@item @kbd{J} (@code{org-agenda-clock-goto})
-@kindex J
-@findex org-agenda-clock-goto
-Go to the currently clocked-in task @emph{in the agenda buffer}.
-
-@item @kbd{D} (@code{org-agenda-toggle-diary})
-@kindex D
-@findex org-agenda-toggle-diary
-Toggle the inclusion of diary entries. See @ref{Weekly/daily agenda}.
-
-@item @kbd{v l} or @kbd{v L} or short @kbd{l} (@code{org-agenda-log-mode})
-@kindex v l
-@kindex l
-@kindex v L
-@findex org-agenda-log-mode
-@vindex org-log-done
-@vindex org-agenda-log-mode-items
-Toggle Logbook mode. In Logbook mode, entries that were marked as
-done while logging was on (see the variable @code{org-log-done}) are
-shown in the agenda, as are entries that have been clocked on that
-day. You can configure the entry types that should be included in
-log mode using the variable @code{org-agenda-log-mode-items}. When
-called with a @kbd{C-u} prefix argument, show all possible
-logbook entries, including state changes. When called with two
-prefix arguments @kbd{C-u C-u}, show only logging information,
-nothing else. @kbd{v L} is equivalent to @kbd{C-u v l}.
-
-@item @kbd{v [} or short @kbd{[} (@code{org-agenda-manipulate-query-add})
-@kindex v [
-@kindex [
-@findex org-agenda-manipulate-query-add
-Include inactive timestamps into the current view. Only for
-weekly/daily agenda.
-
-@item @kbd{v a} (@code{org-agenda-archives-mode})
-@kindex v a
-@findex org-agenda-archives-mode
-Toggle Archives mode. In Archives mode, trees that are archived
-(see @ref{Internal archiving}) are also scanned when producing the
-agenda. To exit archives mode, press @kbd{v a} again.
-
-@item @kbd{v A}
-@kindex v A
-Toggle Archives mode. Include all archive files as well.
-
-@item @kbd{v R} or short @kbd{R} (@code{org-agenda-clockreport-mode})
-@kindex v R
-@kindex R
-@findex org-agenda-clockreport-mode
-@vindex org-agenda-start-with-clockreport-mode
-@vindex org-clock-report-include-clocking-task
-Toggle Clockreport mode. In Clockreport mode, the daily/weekly
-agenda always shows a table with the clocked times for the time span
-and file scope covered by the current agenda view. The initial
-setting for this mode in new agenda buffers can be set with the
-variable @code{org-agenda-start-with-clockreport-mode}. By using
-a prefix argument when toggling this mode (i.e., @kbd{C-u R}),
-the clock table does not show contributions from entries that are
-hidden by agenda filtering@footnote{Only tags filtering is respected here, effort filtering is
-ignored.}. See also the variable
-@code{org-clock-report-include-clocking-task}.
-
-@item @kbd{v c}
-@kindex v c
-@vindex org-agenda-clock-consistency-checks
-Show overlapping clock entries, clocking gaps, and other clocking
-problems in the current agenda range. You can then visit clocking
-lines and fix them manually. See the variable
-@code{org-agenda-clock-consistency-checks} for information on how to
-customize the definition of what constituted a clocking problem. To
-return to normal agenda display, press @kbd{l} to exit Logbook
-mode.
-
-@item @kbd{v E} or short @kbd{E} (@code{org-agenda-entry-text-mode})
-@kindex v E
-@kindex E
-@findex org-agenda-entry-text-mode
-@vindex org-agenda-start-with-entry-text-mode
-@vindex org-agenda-entry-text-maxlines
-Toggle entry text mode. In entry text mode, a number of lines from
-the Org outline node referenced by an agenda line are displayed
-below the line. The maximum number of lines is given by the
-variable @code{org-agenda-entry-text-maxlines}. Calling this command
-with a numeric prefix argument temporarily modifies that number to
-the prefix value.
-
-@item @kbd{G} (@code{org-agenda-toggle-time-grid})
-@kindex G
-@vindex org-agenda-use-time-grid
-@vindex org-agenda-time-grid
-Toggle the time grid on and off. See also the variables
-@code{org-agenda-use-time-grid} and @code{org-agenda-time-grid}.
-
-@item @kbd{r} (@code{org-agenda-redo})
-@itemx @kbd{g}
-@kindex r
-@kindex g
-@findex org-agenda-redo
-Recreate the agenda buffer, for example to reflect the changes after
-modification of the timestamps of items with @kbd{S-@key{LEFT}} and
-@kbd{S-@key{RIGHT}}. When the buffer is the global TODO list,
-a prefix argument is interpreted to create a selective list for
-a specific TODO keyword.
-
-@item @kbd{C-x C-s} or short @kbd{s} (@code{org-save-all-org-buffers})
-@kindex C-x C-s
-@findex org-save-all-org-buffers
-@kindex s
-Save all Org buffers in the current Emacs session, and also the
-locations of IDs.
-
-@item @kbd{C-c C-x C-c} (@code{org-agenda-columns})
-@kindex C-c C-x C-c
-@findex org-agenda-columns
-@vindex org-columns-default-format
-Invoke column view (see @ref{Column View}) in the agenda buffer. The
-column view format is taken from the entry at point, or, if there is
-no entry at point, from the first entry in the agenda view. So
-whatever the format for that entry would be in the original buffer
-(taken from a property, from a @samp{COLUMNS} keyword, or from the
-default variable @code{org-columns-default-format}) is used in the
-agenda.
-
-@item @kbd{C-c C-x >} (@code{org-agenda-remove-restriction-lock})
-@kindex C-c C-x >
-@findex org-agenda-remove-restriction-lock
-Remove the restriction lock on the agenda, if it is currently
-restricted to a file or subtree (see @ref{Agenda Files}).
-
-@item @kbd{M-@key{UP}} (@code{org-agenda-drag-line-backward})
-@kindex M-UP
-@findex org-agenda-drag-line-backward
-Drag the line at point backward one line. With a numeric prefix
-argument, drag backward by that many lines.
-
-Moving agenda lines does not persist after an agenda refresh and
-does not modify the contributing Org files.
-
-@item @kbd{M-@key{DOWN}} (@code{org-agenda-drag-line-forward})
-@kindex M-DOWN
-@findex org-agenda-drag-line-forward
-Drag the line at point forward one line. With a numeric prefix
-argument, drag forward by that many lines.
-@end table
-
-@anchor{Remote editing}
-@subheading Remote editing
-
-@cindex remote editing, from agenda
-
-@table @asis
-@item @kbd{0--9}
-Digit argument.
-
-@item @kbd{C-_} (@code{org-agenda-undo})
-@kindex C-_
-@findex org-agenda-undo
-@cindex undoing remote-editing events
-@cindex remote editing, undo
-Undo a change due to a remote editing command. The change is undone
-both in the agenda buffer and in the remote buffer.
-
-@item @kbd{t} (@code{org-agenda-todo})
-@kindex t
-@findex org-agenda-todo
-Change the TODO state of the item, both in the agenda and in the
-original Org file. A prefix arg is passed through to the @code{org-todo}
-command, so for example a @kbd{C-u} prefix are will trigger
-taking a note to document the state change.
-
-@item @kbd{C-S-@key{RIGHT}} (@code{org-agenda-todo-nextset})
-@kindex C-S-RIGHT
-@findex org-agenda-todo-nextset
-Switch to the next set of TODO keywords.
-
-@item @kbd{C-S-@key{LEFT}}, @code{org-agenda-todo-previousset}
-@kindex C-S-LEFT
-Switch to the previous set of TODO keywords.
-
-@item @kbd{C-k} (@code{org-agenda-kill})
-@kindex C-k
-@findex org-agenda-kill
-@vindex org-agenda-confirm-kill
-Delete the current agenda item along with the entire subtree
-belonging to it in the original Org file. If the text to be deleted
-remotely is longer than one line, the kill needs to be confirmed by
-the user. See variable @code{org-agenda-confirm-kill}.
-
-@item @kbd{C-c C-w} (@code{org-agenda-refile})
-@kindex C-c C-w
-@findex org-agenda-refile
-Refile the entry at point.
-
-@item @kbd{C-c C-x C-a} or short @kbd{a} (@code{org-agenda-archive-default-with-confirmation})
-@kindex C-c C-x C-a
-@kindex a
-@findex org-agenda-archive-default-with-confirmation
-@vindex org-archive-default-command
-Archive the subtree corresponding to the entry at point using the
-default archiving command set in @code{org-archive-default-command}.
-When using the @kbd{a} key, confirmation is required.
-
-@item @kbd{C-c C-x a} (@code{org-agenda-toggle-archive-tag})
-@kindex C-c C-x a
-@findex org-agenda-toggle-archive-tag
-Toggle the archive tag (see @ref{Internal archiving}) for the current
-headline.
-
-@item @kbd{C-c C-x A} (@code{org-agenda-archive-to-archive-sibling})
-@kindex C-c C-x A
-@findex org-agenda-archive-to-archive-sibling
-Move the subtree corresponding to the current entry to its @emph{archive
-sibling}.
-
-@item @kbd{C-c C-x C-s} or short @kbd{$} (@code{org-agenda-archive})
-@kindex C-c C-x C-s
-@kindex $
-@findex org-agenda-archive
-Archive the subtree corresponding to the current headline. This
-means the entry is moved to the configured archive location, most
-likely a different file.
-
-@item @kbd{T} (@code{org-agenda-show-tags})
-@kindex T
-@findex org-agenda-show-tags
-@vindex org-agenda-show-inherited-tags
-Show all tags associated with the current item. This is useful if
-you have turned off @code{org-agenda-show-inherited-tags}, but still want
-to see all tags of a headline occasionally.
-
-@item @kbd{:} (@code{org-agenda-set-tags})
-@kindex :
-@findex org-agenda-set-tags
-Set tags for the current headline. If there is an active region in
-the agenda, change a tag for all headings in the region.
-
-@item @kbd{,} (@code{org-agenda-priority})
-@kindex ,
-@findex org-agenda-priority
-Set the priority for the current item. Org mode prompts for the
-priority character. If you reply with @kbd{@key{SPC}}, the priority
-cookie is removed from the entry.
-
-@item @kbd{+} or @kbd{S-@key{UP}} (@code{org-agenda-priority-up})
-@kindex +
-@kindex S-UP
-@findex org-agenda-priority-up
-Increase the priority of the current item. The priority is changed
-in the original buffer, but the agenda is not resorted. Use the
-@kbd{r} key for this.
-
-@item @kbd{-} or @kbd{S-@key{DOWN}} (@code{org-agenda-priority-down})
-@kindex -
-@kindex S-DOWN
-@findex org-agenda-priority-down
-Decrease the priority of the current item.
-
-@item @kbd{C-c C-x e} or short @kbd{e} (@code{org-agenda-set-effort})
-@kindex e
-@kindex C-c C-x e
-@findex org-agenda-set-effort
-Set the effort property for the current item.
-
-@item @kbd{C-c C-z} or short @kbd{z} (@code{org-agenda-add-note})
-@kindex z
-@kindex C-c C-z
-@findex org-agenda-add-note
-@vindex org-log-into-drawer
-Add a note to the entry. This note is recorded, and then filed to
-the same location where state change notes are put. Depending on
-@code{org-log-into-drawer}, this may be inside a drawer.
-
-@item @kbd{C-c C-a} (@code{org-attach})
-@kindex C-c C-a
-@findex org-attach
-Dispatcher for all command related to attachments.
-
-@item @kbd{C-c C-s} (@code{org-agenda-schedule})
-@kindex C-c C-s
-@findex org-agenda-schedule
-Schedule this item. With a prefix argument, remove the
-scheduling timestamp
-
-@item @kbd{C-c C-d} (@code{org-agenda-deadline})
-@kindex C-c C-d
-@findex org-agenda-deadline
-Set a deadline for this item. With a prefix argument, remove the
-deadline.
-
-@item @kbd{S-@key{RIGHT}} (@code{org-agenda-do-date-later})
-@kindex S-RIGHT
-@findex org-agenda-do-date-later
-Change the timestamp associated with the current line by one day
-into the future. If the date is in the past, the first call to this
-command moves it to today. With a numeric prefix argument, change
-it by that many days. For example, @kbd{3 6 5 S-@key{RIGHT}} changes
-it by a year. With a @kbd{C-u} prefix, change the time by one
-hour. If you immediately repeat the command, it will continue to
-change hours even without the prefix argument. With a double
-@kbd{C-u C-u} prefix, do the same for changing minutes. The
-stamp is changed in the original Org file, but the change is not
-directly reflected in the agenda buffer. Use @kbd{r} or
-@kbd{g} to update the buffer.
-
-@item @kbd{S-@key{LEFT}} (@code{org-agenda-do-date-earlier})
-@kindex S-LEFT
-@findex org-agenda-do-date-earlier
-Change the timestamp associated with the current line by one day
-into the past.
-
-@item @kbd{>} (@code{org-agenda-date-prompt})
-@kindex >
-@findex org-agenda-date-prompt
-Change the timestamp associated with the current line. The key
-@kbd{>} has been chosen, because it is the same as
-@kbd{S-.} on my keyboard.
-
-@item @kbd{I} (@code{org-agenda-clock-in})
-@kindex I
-@findex org-agenda-clock-in
-Start the clock on the current item. If a clock is running already,
-it is stopped first.
-
-@item @kbd{O} (@code{org-agenda-clock-out})
-@kindex O
-@findex org-agenda-clock-out
-Stop the previously started clock.
-
-@item @kbd{X} (@code{org-agenda-clock-cancel})
-@kindex X
-@findex org-agenda-clock-cancel
-Cancel the currently running clock.
-
-@item @kbd{J} (@code{org-agenda-clock-goto})
-@kindex J
-@findex org-agenda-clock-goto
-Jump to the running clock in another window.
-
-@item @kbd{k} (@code{org-agenda-capture})
-@kindex k
-@findex org-agenda-capture
-@cindex capturing, from agenda
-@vindex org-capture-use-agenda-date
-Like @code{org-capture}, but use the date at point as the default date
-for the capture template. See @code{org-capture-use-agenda-date} to make
-this the default behavior of @code{org-capture}.
-@end table
-
-@anchor{Bulk remote editing selected entries}
-@subheading Bulk remote editing selected entries
-
-@cindex remote editing, bulk, from agenda
-@vindex org-agenda-bulk-custom-functions
-
-@table @asis
-@item @kbd{m} (@code{org-agenda-bulk-mark})
-@kindex m
-@findex org-agenda-bulk-mark
-
-Mark the entry at point for bulk action. If there is an active
-region in the agenda, mark the entries in the region. With numeric
-prefix argument, mark that many successive entries.
-
-@item @kbd{*} (@code{org-agenda-bulk-mark-all})
-@kindex *
-@findex org-agenda-bulk-mark-all
-
-Mark all visible agenda entries for bulk action.
-
-@item @kbd{u} (@code{org-agenda-bulk-unmark})
-@kindex u
-@findex org-agenda-bulk-unmark
-
-Unmark entry for bulk action.
-
-@item @kbd{U} (@code{org-agenda-bulk-remove-all-marks})
-@kindex U
-@findex org-agenda-bulk-remove-all-marks
-
-Unmark all marked entries for bulk action.
-
-@item @kbd{M-m} (@code{org-agenda-bulk-toggle})
-@kindex M-m
-@findex org-agenda-bulk-toggle
-
-Toggle mark of the entry at point for bulk action.
-
-@item @kbd{M-*} (@code{org-agenda-bulk-toggle-all})
-@kindex M-*
-@findex org-agenda-bulk-toggle-all
-
-Toggle mark of every entry for bulk action.
-
-@item @kbd{%} (@code{org-agenda-bulk-mark-regexp})
-@kindex %
-@findex org-agenda-bulk-mark-regexp
-
-Mark entries matching a regular expression for bulk action.
-
-@item @kbd{B} (@code{org-agenda-bulk-action})
-@kindex B
-@findex org-agenda-bulk-action
-@vindex org-agenda-bulk-persistent-marks
-
-Bulk action: act on all marked entries in the agenda. This prompts
-for another key to select the action to be applied. The prefix
-argument to @kbd{B} is 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.
-
-@table @asis
-@item @kbd{p}
-Toggle persistent marks.
-
-@item @kbd{$}
-Archive all selected entries.
-
-@item @kbd{A}
-Archive entries by moving them to their respective archive
-siblings.
-
-@item @kbd{t}
-Change TODO state. This prompts for a single TODO keyword and
-changes the state of all selected entries, bypassing blocking and
-suppressing logging notes---but not timestamps.
-
-@item @kbd{+}
-Add a tag to all selected entries.
-
-@item @kbd{-}
-Remove a tag from all selected entries.
-
-@item @kbd{s}
-Schedule all items to a new date. To shift existing schedule
-dates by a fixed number of days, use something starting with
-double plus at the prompt, for example @samp{++8d} or @samp{++2w}.
-
-@item @kbd{d}
-Set deadline to a specific date.
-
-@item @kbd{r}
-Prompt for a single refile target and move all entries. The
-entries are no longer in the agenda; refresh (@kbd{g}) to
-bring them back.
-
-@item @kbd{S}
-Reschedule randomly into the coming N days. N is prompted for.
-With a prefix argument (@kbd{C-u B S}), scatter only across
-weekdays.
-
-@item @kbd{f}
-@vindex org-agenda-bulk-custom-functions
-Apply a function@footnote{You can also create persistent custom functions through
-@code{org-agenda-bulk-custom-functions}.} to marked entries. For example, the
-function below sets the @samp{CATEGORY} property of the entries to
-@samp{web}.
-
-@lisp
-(defun set-category ()
- (interactive "P")
- (let ((marker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error))))
- (org-with-point-at marker
- (org-back-to-heading t)
- (org-set-property "CATEGORY" "web"))))
-@end lisp
-@end table
-@end table
-
-@anchor{Calendar commands}
-@subheading Calendar commands
-
-@cindex calendar commands, from agenda
-
-@table @asis
-@item @kbd{c} (@code{org-agenda-goto-calendar})
-@kindex c
-@findex org-agenda-goto-calendar
-Open the Emacs calendar and go to the date at point in the agenda.
-
-@item @kbd{c} (@code{org-calendar-goto-agenda})
-@kindex c
-@findex org-calendar-goto-agenda
-When in the calendar, compute and show the Org agenda for the date
-at point.
-
-@item @kbd{i} (@code{org-agenda-diary-entry})
-@kindex i
-@findex org-agenda-diary-entry
-
-@cindex diary entries, creating from agenda
-Insert a new entry into the diary, using the date at point and (for
-block entries) the date at the mark. This adds to the Emacs diary
-file@footnote{This file is parsed for the agenda when
-@code{org-agenda-include-diary} is set.}, in a way similar to the @kbd{i} command in the
-calendar. The diary file pops up in another window, where you can
-add the entry.
-
-@vindex org-agenda-diary-file
-If you configure @code{org-agenda-diary-file} to point to an Org file,
-Org creates entries in that file instead. Most entries are stored
-in a date-based outline tree that will later make it easy to archive
-appointments from previous months/years. The tree is built under an
-entry with a @samp{DATE_TREE} property, or else with years as top-level
-entries. Emacs prompts you for the entry text---if you specify it,
-the entry is created in @code{org-agenda-diary-file} without further
-interaction. If you directly press @kbd{@key{RET}} at the prompt
-without typing text, the target file is shown in another window for
-you to finish the entry there. See also the @kbd{k r} command.
-
-@item @kbd{M} (@code{org-agenda-phases-of-moon})
-@kindex M
-@findex org-agenda-phases-of-moon
-Show the phases of the moon for the three months around current
-date.
-
-@item @kbd{S} (@code{org-agenda-sunrise-sunset})
-@kindex S
-@findex org-agenda-sunrise-sunset
-Show sunrise and sunset times. The geographical location must be
-set with calendar variables, see the documentation for the Emacs
-calendar.
-
-@item @kbd{C} (@code{org-agenda-convert-date})
-@kindex C
-@findex org-agenda-convert-date
-Convert the date at point into many other cultural and historic
-calendars.
-
-@item @kbd{H} (@code{org-agenda-holidays})
-@kindex H
-@findex org-agenda-holidays
-Show holidays for three months around point date.
-@end table
-
-@anchor{Quit and exit}
-@subheading Quit and exit
-
-@table @asis
-@item @kbd{q} (@code{org-agenda-quit})
-@kindex q
-@findex org-agenda-quit
-
-Quit agenda, remove the agenda buffer.
-
-@item @kbd{x} (@code{org-agenda-exit})
-@kindex x
-@findex org-agenda-exit
-
-@cindex agenda files, removing buffers
-Exit agenda, remove the agenda buffer and all buffers loaded by
-Emacs for the compilation of the agenda. Buffers created by the
-user to visit Org files are not removed.
-@end table
-
-@node Custom Agenda Views
-@section Custom Agenda Views
-
-@cindex custom agenda views
-@cindex agenda views, custom
-
-Custom agenda commands serve two purposes: to store and quickly access
-frequently used TODO and tags searches, and to create special
-composite agenda buffers. Custom agenda commands are accessible
-through the dispatcher (see @ref{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.
-@end menu
-
-@node Storing searches
-@subsection Storing searches
-
-The first application of custom searches is the definition of keyboard
-shortcuts for frequently used searches, either creating an agenda
-buffer, or a sparse tree (the latter covering of course only the
-current buffer).
-
-@kindex C @r{(Agenda dispatcher)}
-@vindex org-agenda-custom-commands
-@cindex agenda views, main example
-@cindex agenda, as an agenda views
-@cindex agenda*, as an agenda views
-@cindex tags, as an agenda view
-@cindex todo, as an agenda view
-@cindex tags-todo
-@cindex todo-tree
-@cindex occur-tree
-@cindex tags-tree
-Custom commands are configured in the variable
-@code{org-agenda-custom-commands}. You can customize this variable, for
-example by pressing @kbd{C} from the agenda dispatcher (see @ref{Agenda Dispatcher}). You can also directly set it with Emacs Lisp in
-the Emacs init file. The following example contains all valid agenda
-views:
-
-@lisp
-(setq org-agenda-custom-commands
- '(("x" agenda)
- ("y" agenda*)
- ("w" todo "WAITING")
- ("W" todo-tree "WAITING")
- ("u" tags "+boss-urgent")
- ("v" tags-todo "+boss-urgent")
- ("U" tags-tree "+boss-urgent")
- ("f" occur-tree "\\<FIXME\\>")
- ("h" . "HOME+Name tags searches") ;description for "h" prefix
- ("hl" tags "+home+Lisa")
- ("hp" tags "+home+Peter")
- ("hk" tags "+home+Kim")))
-@end lisp
-
-The initial string in each entry defines the keys you have to press
-after the dispatcher command in order to access the command. Usually
-this is just a single character, but if you have many similar
-commands, you can also define two-letter combinations where the first
-character is the same in several combinations and serves as a prefix
-key@footnote{You can provide a description for a prefix key by inserting
-a cons cell with the prefix and the description.}. The second parameter is the search type, followed by the
-string or regular expression to be used for the matching. The example
-above will therefore define:
-
-@table @asis
-@item @kbd{x}
-as a global search for agenda entries planned@footnote{@emph{Planned} means here that these entries have some planning
-information attached to them, like a time-stamp, a scheduled or
-a deadline string. See @code{org-agenda-entry-types} on how to set what
-planning information is taken into account.} this week/day.
-
-@item @kbd{y}
-as the same search, but only for entries with an hour specification
-like @samp{[h]h:mm}---think of them as appointments.
-
-@item @kbd{w}
-as a global search for TODO entries with @samp{WAITING} as the TODO
-keyword.
-
-@item @kbd{W}
-as the same search, but only in the current buffer and displaying
-the results as a sparse tree.
-
-@item @kbd{u}
-as a global tags search for headlines tagged @samp{boss} but not
-@samp{urgent}.
-
-@item @kbd{v}
-The same search, but limiting it to headlines that are also TODO
-items.
-
-@item @kbd{U}
-as the same search, but only in the current buffer and displaying
-the result as a sparse tree.
-
-@item @kbd{f}
-to create a sparse tree (again, current buffer only) with all
-entries containing the word @samp{FIXME}.
-
-@item @kbd{h}
-as a prefix command for a @samp{HOME} tags search where you have to press
-an additional key (@kbd{l}, @kbd{p} or @kbd{k}) to
-select a name (Lisa, Peter, or Kim) as additional tag to match.
-@end table
-
-Note that @code{*-tree} agenda views need to be called from an Org buffer
-as they operate on the current buffer only.
-
-@node Block agenda
-@subsection Block agenda
-
-@cindex block agenda
-@cindex agenda, with block views
-
-Another possibility is the construction of agenda views that comprise
-the results of @emph{several} commands, each of which creates a block in
-the agenda buffer. The available commands include @code{agenda} for the
-daily or weekly agenda (as created with @kbd{a}) , @code{alltodo} for
-the global TODO list (as constructed with @kbd{t}), @code{stuck} for
-the list of stuck projects (as obtained with @kbd{#}) and the
-matching commands discussed above: @code{todo}, @code{tags}, and @code{tags-todo}.
-
-Here are two examples:
-
-@lisp
-(setq org-agenda-custom-commands
- '(("h" "Agenda and Home-related tasks"
- ((agenda "")
- (tags-todo "home")
- (tags "garden")))
- ("o" "Agenda and Office-related tasks"
- ((agenda "")
- (tags-todo "work")
- (tags "office")))))
-@end lisp
-
-@noindent
-This defines @kbd{h} to create a multi-block view for stuff you
-need to attend to at home. The resulting agenda buffer contains 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{o} provides a similar view for office tasks.
-
-@node Setting options
-@subsection Setting options for custom commands
-
-@cindex options, for custom agenda views
-
-@vindex org-agenda-custom-commands
-Org mode contains a number of variables regulating agenda construction
-and display. The global variables define the behavior for all agenda
-commands, including the custom commands. However, if you want to
-change some settings just for a single custom view, you can do so.
-Setting options requires inserting a list of variable names and values
-at the right spot in @code{org-agenda-custom-commands}. For example:
-
-@lisp
-(setq org-agenda-custom-commands
- '(("w" todo "WAITING"
- ((org-agenda-sorting-strategy '(priority-down))
- (org-agenda-prefix-format " Mixed: ")))
- ("U" tags-tree "+boss-urgent"
- ((org-show-context-detail 'minimal)))
- ("N" search ""
- ((org-agenda-files '("~org/notes.org"))
- (org-agenda-text-search-extra-files nil)))))
-@end lisp
-
-@noindent
-Now the @kbd{w} command sorts the collected entries only by
-priority, and the prefix format is modified to just say @samp{Mixed:}
-instead of giving the category of the entry. The sparse tags tree of
-@kbd{U} now turns out ultra-compact, because neither the headline
-hierarchy above the match, nor the headline following the match are
-shown. The command @kbd{N} does a text search limited to only
-a single file.
-
-For command sets creating a block agenda, @code{org-agenda-custom-commands}
-has two separate spots for setting options. You can add options that
-should be valid for just a single command in the set, and options that
-should be valid for all commands in the set. The former are just
-added to the command entry; the latter must come after the list of
-command entries. Going back to the block agenda example (see @ref{Block agenda}), let's change the sorting strategy for the @kbd{h}
-commands to @code{priority-down}, but let's sort the results for @samp{garden}
-tags query in the opposite order, @code{priority-up}. This would look like
-this:
-
-@lisp
-(setq org-agenda-custom-commands
- '(("h" "Agenda and Home-related tasks"
- ((agenda)
- (tags-todo "home")
- (tags "garden"
- ((org-agenda-sorting-strategy '(priority-up)))))
- ((org-agenda-sorting-strategy '(priority-down))))
- ("o" "Agenda and Office-related tasks"
- ((agenda)
- (tags-todo "work")
- (tags "office")))))
-@end lisp
-
-As you see, the values and parentheses setting is a little complex.
-When in doubt, use the customize interface to set this variable---it
-fully supports its structure. Just one caveat: when setting options
-in this interface, the @emph{values} are just Lisp expressions. So if the
-value is a string, you need to add the double-quotes around the value
-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 command @kbd{o} displaying a view that you only
-need when reading emails. Then you would configure this option like
-this:
-
-@lisp
-(setq org-agenda-custom-commands-contexts
- '(("o" (in-mode . "message-mode"))))
-@end lisp
-
-You can also tell that the command key @kbd{o} should refer to
-another command key @kbd{r}. In that case, add this command key
-like this:
-
-@lisp
-(setq org-agenda-custom-commands-contexts
- '(("o" "r" (in-mode . "message-mode"))))
-@end lisp
-
-See the docstring of the variable for more information.
-
-@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{For HTML you need to install Hrvoje Nikšić's @samp{htmlize.el}
-as an Emacs package from MELPA or from @uref{https://github.com/hniksic/emacs-htmlize, Hrvoje Nikšić's repository}.}, Postscript,
-PDF@footnote{To create PDF output, the Ghostscript ps2pdf utility must be
-installed on the system. Selecting a PDF file also creates the
-postscript file.}, and iCalendar files. If you want to do this only
-occasionally, use the following command:
-
-@table @asis
-@item @kbd{C-x C-w} (@code{org-agenda-write})
-@kindex C-x C-w
-@findex org-agenda-write
-@cindex exporting agenda views
-@cindex agenda views, exporting
-
-@vindex org-agenda-exporter-settings
-Write the agenda view to a file.
-@end table
-
-If you need to export certain agenda views frequently, you can
-associate any custom agenda command with a list of output file
-names@footnote{If you want to store standard views like the weekly agenda or
-the global TODO list as well, you need to define custom commands for
-them in order to be able to specify file names.}. Here is an example that first defines custom commands
-for the agenda and the global TODO list, together with a number of
-files to which to export them. Then we define two block agenda
-commands and specify file names for them as well. File names can be
-relative to the current working directory, or absolute.
-
-@lisp
-(setq org-agenda-custom-commands
- '(("X" agenda "" nil ("agenda.html" "agenda.ps"))
- ("Y" alltodo "" nil ("todo.html" "todo.txt" "todo.ps"))
- ("h" "Agenda and Home-related tasks"
- ((agenda "")
- (tags-todo "home")
- (tags "garden"))
- nil
- ("~/views/home.html"))
- ("o" "Agenda and Office-related tasks"
- ((agenda)
- (tags-todo "work")
- (tags "office"))
- nil
- ("~/views/office.ps" "~/calendars/office.ics"))))
-@end lisp
-
-The extension of the file name determines the type of export. If it
-is @samp{.html}, Org mode uses the htmlize package to convert the buffer to
-HTML and save it to this file name. If the extension is @samp{.ps},
-@code{ps-print-buffer-with-faces} is used to produce Postscript output. If
-the extension is @samp{.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.
-Instead, there is a special command to produce @emph{all} specified
-files in one step:
-
-@table @asis
-@item @kbd{e} (@code{org-store-agenda-views})
-@kindex e @r{(Agenda dispatcher)}
-@findex org-store-agenda-views
-Export all agenda views that have export file names associated with
-them.
-@end table
-
-You can use the options section of the custom agenda commands to also
-set options for the export commands. For example:
-
-@lisp
-(setq org-agenda-custom-commands
- '(("X" agenda ""
- ((ps-number-of-columns 2)
- (ps-landscape-mode t)
- (org-agenda-prefix-format " [ ] ")
- (org-agenda-with-colors nil)
- (org-agenda-remove-tags t))
- ("theagenda.ps"))))
-@end lisp
-
-@noindent
-@vindex org-agenda-exporter-settings
-This command sets two options for the Postscript exporter, to make it
-print in two columns in landscape format---the resulting page can be
-cut in two and then used in a paper agenda. The remaining settings
-modify the agenda prefix to omit category and scheduling information,
-and instead include a checkbox to check off items. We also remove the
-tags to make the lines compact, and we do not want to use colors for
-the black-and-white printer. Settings specified in
-@code{org-agenda-exporter-settings} also apply, e.g.,
-
-@lisp
-(setq org-agenda-exporter-settings
- '((ps-number-of-columns 2)
- (ps-landscape-mode t)
- (org-agenda-add-entry-text-maxlines 5)
- (htmlize-output-type 'css)))
-@end lisp
-
-@noindent
-but the settings in @code{org-agenda-custom-commands} take precedence.
-
-From the command line you may also use:
-
-@example
-emacs -eval (org-batch-store-agenda-views) -kill
-@end example
-
-@noindent
-or, if you need to modify some parameters@footnote{Quoting depends on the system you use, please check the FAQ
-for examples.}
-
-@example
-emacs -eval '(org-batch-store-agenda-views \
- org-agenda-span (quote month) \
- org-agenda-start-day "2007-11-01" \
- org-agenda-include-diary nil \
- org-agenda-files (quote ("~/org/project.org")))' \
- -kill
-@end example
-
-@noindent
-which creates the agenda views restricted to the file
-@samp{~/org/project.org}, without diary entries and with a 30-day extent.
-
-You can also extract agenda information in a way that allows further
-processing by other programs. See @ref{Extracting Agenda Information}, for
-more information.
-
-@node Agenda Column View
-@section Using Column View in the Agenda
-
-@cindex column view, in agenda
-@cindex agenda, column view
-
-Column view (see @ref{Column View}) is normally used to view and edit
-properties embedded in the hierarchical structure of an Org file. It
-can be quite useful to use column view also from the agenda, where
-entries are collected by certain criteria.
-
-@table @asis
-@item @kbd{C-c C-x C-c} (@code{org-agenda-columns})
-@kindex C-c C-x C-c
-@findex org-agenda-columns
-
-Turn on column view in the agenda.
-@end table
-
-To understand how to use this properly, it is important to realize
-that the entries in the agenda are no longer in their proper outline
-environment. This causes the following issues:
-
-@enumerate
-@item
-@vindex org-columns-default-format-for-agenda
-@vindex org-columns-default-format
-Org needs to make a decision which columns format to use. Since
-the entries in the agenda are collected from different files, and
-different files may have different columns formats, this is a
-non-trivial problem. Org first checks if
-@code{org-overriding-columns-format} is currently set, and if so, takes
-the format from there. You should set this variable only in the
-@emph{local settings section} of a custom agenda command (see @ref{Custom Agenda Views}) to make it valid for that specific agenda view. If
-no such binding exists, it checks, in sequence,
-@code{org-columns-default-format-for-agenda}, the format associated with
-the first item in the agenda (through a property or a @samp{#+COLUMNS}
-setting in that buffer) and finally @code{org-columns-default-format}.
-
-@item
-@cindex @samp{CLOCKSUM}, special property
-If any of the columns has a summary type defined (see @ref{Column attributes}), turning on column view in the agenda visits all
-relevant agenda files and make sure that the computations of this
-property are up to date. This is also true for the special
-@samp{CLOCKSUM} property. Org then sums the values displayed in the
-agenda. In the daily/weekly agenda, the sums cover a single day;
-in all other views they cover the entire block.
-
-It is important 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
-leads to incorrect results because some values count double.
-
-@item
-When the column view in the agenda shows the @samp{CLOCKSUM} property,
-that is always the entire clocked time for this item. So even in
-the daily/weekly agenda, the clocksum listed in column view may
-originate from times outside the current view. This has the
-advantage that you can compare these values with a column listing
-the planned total effort for a task---one of the major
-applications for column view in the agenda. If you want
-information about clocked time in the displayed period use clock
-table mode (press @kbd{R} in the agenda).
-
-@item
-@cindex @samp{CLOCKSUM_T}, special property
-When the column view in the agenda shows the @samp{CLOCKSUM_T} property,
-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 @samp{CLOCKSUM}---and with
-the planned total effort for it.
-@end enumerate
-
-@node Markup for Rich Contents
-@chapter Markup for Rich Contents
-
-Org is primarily about organizing and searching through your
-plain-text notes. However, it also provides a lightweight yet robust
-markup language for rich text formatting and more. For instance, you
-may want to center or emphasize text. Or you may need to insert
-a formula or image in your writing. Org offers syntax for all of this
-and more. Used in conjunction with the export framework (see
-@ref{Exporting}), you can author beautiful documents in Org---like the fine
-manual you are currently reading.
-
-@menu
-* Paragraphs:: The basic unit of text.
-* Emphasis and Monospace:: Bold, italic, etc.
-* Subscripts and Superscripts:: Simple syntax for raising/lowering text.
-* Special Symbols:: Greek letters and other symbols.
-* Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents.
-* Literal Examples:: Source code examples with special formatting.
-* Images:: Display an image.
-* Captions:: Describe tables, images...
-* Horizontal Rules:: Make a line.
-* Creating Footnotes:: Edit and read footnotes.
-@end menu
-
-@node Paragraphs
-@section Paragraphs
-
-@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.
-
-@cindex line breaks, markup rules
-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 @samp{BEGIN_VERSE}
-@cindex verse blocks
-@example
-#+BEGIN_VERSE
- Great clouds overhead
- Tiny black birds rise and fall
- Snow covers Emacs
-
- ---AlexSchroeder
-#+END_VERSE
-@end example
-
-When quoting a passage from another document, it is customary to
-format this as a paragraph that is indented on both the left and the
-right margin. You can include quotations in Org documents like this:
-
-@cindex @samp{BEGIN_QUOTE}
-@cindex quote blocks
-@example
-#+BEGIN_QUOTE
-Everything should be made as simple as possible,
-but not any simpler ---Albert Einstein
-#+END_QUOTE
-@end example
-
-If you would like to center some text, do it like this:
-
-@cindex @samp{BEGIN_CENTER}
-@cindex center blocks
-@example
-#+BEGIN_CENTER
-Everything should be made as simple as possible, \\
-but not any simpler
-#+END_CENTER
-@end example
-
-@node Emphasis and Monospace
-@section Emphasis and Monospace
-
-@cindex underlined text, markup rules
-@cindex bold text, markup rules
-@cindex italic text, markup rules
-@cindex verbatim text, markup rules
-@cindex code text, markup rules
-@cindex strike-through text, markup rules
-
-You can make words @samp{*bold*}, @samp{/italic/}, @samp{_underlined_}, @samp{=verbatim=}
-and @samp{~code~}, and, if you must, @samp{+strike-through+}. Text in the code
-and verbatim string is not processed for Org specific syntax; it is
-exported verbatim.
-
-@vindex org-fontify-emphasized-text
-To turn off fontification for marked up text, you can set
-@code{org-fontify-emphasized-text} to @code{nil}. To narrow down the list of
-available markup syntax, you can customize @code{org-emphasis-alist}.
-
-@node Subscripts and Superscripts
-@section Subscripts and Superscripts
-
-@cindex subscript
-@cindex superscript
-
-@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. For
-example
-
-@example
-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
-If you write a text where the underscore is often used in a different
-context, Org's convention to always interpret these as subscripts can
-get in your way. Configure the variable @code{org-use-sub-superscripts} to
-change this convention. For example, when setting this variable to
-@code{@{@}}, @samp{a_b} is not interpreted as a subscript, but @samp{a_@{b@}} is.
-
-You can set @code{org-use-sub-superscripts} in a file using the export
-option @samp{^:} (see @ref{Export Settings}). For example, @samp{#+OPTIONS: ^:@{@}}
-sets @code{org-use-sub-superscripts} to @code{@{@}} and limits super- and
-subscripts to the curly bracket notation.
-
-You can also toggle the visual display of super- and subscripts:
-
-@table @asis
-@item @kbd{C-c C-x \} (@code{org-toggle-pretty-entities})
-@kindex C-c C-x \
-@findex org-toggle-pretty-entities
-This command formats sub- and superscripts in a WYSIWYM way.
-@end table
-
-@vindex org-pretty-entities
-@vindex org-pretty-entities-include-sub-superscripts
-Set both @code{org-pretty-entities} and
-@code{org-pretty-entities-include-sub-superscripts} to @code{t} to start with
-super- and subscripts @emph{visually} interpreted as specified by the
-option @code{org-use-sub-superscripts}.
-
-@node Special Symbols
-@section Special Symbols
-
-@cindex math symbols
-@cindex special symbols
-@cindex entities
-
-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
-Pro tip: Given a circle \Gamma of diameter d, the length of its
-circumference is \pi@{@}d.
-@end example
-
-@findex org-entities-help
-@vindex org-entities-user
-A large number of entities is provided, with names taken from both
-HTML and @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 @samp{\alpha} are exported as @samp{&alpha;} in
-the HTML output, and as @samp{\(\alpha\)} in the @LaTeX{} output. Similarly, @samp{\nbsp}
-becomes @samp{&nbsp;} in HTML and @samp{~} in @LaTeX{}.
-
-@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 @samp{STARTUP} option
-@samp{entitiespretty}.}:
-
-@table @asis
-@item @kbd{C-c C-x \} (@code{org-toggle-pretty-entities})
-@kindex C-c C-x \
-@findex org-toggle-pretty-entities
-
-Toggle display of entities as UTF-8 characters. This does not
-change the buffer content which remains plain ASCII, but it overlays
-the UTF-8 character for display purposes only.
-@end table
-
-@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 behavior can be disabled with @samp{-} export setting (see
-@ref{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 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@tie{}E@.@tie{}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?
-* CD@LaTeX{} mode:: Speed up entering of formulas.
-@end menu
-
-@node @LaTeX{} fragments
-@subsection @LaTeX{} fragments
-
-@cindex @LaTeX{} fragments
-
-@vindex org-format-latex-header
-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} (see @ref{Math formatting in HTML export}) or transcode the math
-into images (see @ref{Previewing @LaTeX{} fragments}).
-
-@LaTeX{} fragments do not need any special marking at all. The following
-snippets are identified as @LaTeX{} source code:
-
-@itemize
-@item
-Environments of any kind@footnote{When MathJax is used, only the environments recognized by
-MathJax are processed. When dvipng, dvisvgm, or ImageMagick suite is
-used to create images, any @LaTeX{} environment is handled.}. The only requirement is that the
-@samp{\begin} statement appears on a new line, preceded by only
-whitespace.
-
-@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.
-@end itemize
-
-@noindent
-For example:
-
-@example
-\begin@{equation@} % arbitrary environments,
-x=\sqrt@{b@} % even tables, figures
-\end@{equation@} % etc
-
-If $a^2=b$ and \( b=2 \), then the solution must be
-either $$ a=+\sqrt@{2@} $$ or \[ a=-\sqrt@{2@} \].
-@end example
-
-@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
-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:
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{#+OPTIONS: tex:t}
-@tab Do the right thing automatically (MathJax)
-@item @samp{#+OPTIONS: tex:nil}
-@tab Do not process @LaTeX{} fragments at all
-@item @samp{#+OPTIONS: tex:verbatim}
-@tab Verbatim export, for jsMath or so
-@end multitable
-
-@node Previewing @LaTeX{} fragments
-@subsection Previewing @LaTeX{} fragments
-
-@cindex @LaTeX{} fragments, preview
-
-@vindex org-preview-latex-default-process
-If you have a working @LaTeX{} installation and @samp{dvipng}, @samp{dvisvgm} or
-@samp{convert} installed@footnote{These are respectively available at
-@uref{http://sourceforge.net/projects/dvipng/}, @uref{http://dvisvgm.bplaced.net/}
-and from the 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 @ref{@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 @asis
-@item @kbd{C-c C-x C-l} (@code{org-latex-preview})
-@kindex C-c C-x C-l
-@findex org-latex-preview
-
-Produce a preview image of the @LaTeX{} fragment at point and overlay
-it over the source code. If there is no fragment at point, process
-all fragments in the current entry---between two headlines.
-
-When called with a single prefix argument, clear all images in the
-current entry. Two prefix arguments produce a preview image for all
-fragments in the buffer, while three of them clear all the images in
-that buffer.
-@end table
-
-@vindex org-startup-with-latex-preview
-You can turn on the previewing of all @LaTeX{} fragments in a file with
-
-@example
-#+STARTUP: latexpreview
-@end example
-
-
-To disable it, simply use
-
-@example
-#+STARTUP: nolatexpreview
-@end example
-
-@node CD@LaTeX{} mode
-@subsection Using CD@LaTeX{} to enter math
-
-@cindex CD@LaTeX{}
-
-CD@LaTeX{} mode is a minor mode that is normally used in combination with
-a 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
-@samp{cdlatex.el} and @samp{texmathp.el} (the latter comes also with AUC@TeX{})
-using @uref{https://melpa.org/, MELPA} with the @uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Package-Installation.html, Emacs packaging system} or alternatively from
-@uref{https://staff.fnwi.uva.nl/c.dominik/Tools/cdlatex/}. Do not use
-CD@LaTeX{} mode itself under Org mode, but use the special version Org
-CD@LaTeX{} minor mode that comes as part of Org. Turn it on for the
-current buffer with @kbd{M-x org-cdlatex-mode}, or for all Org
-files with
-
-@lisp
-(add-hook 'org-mode-hook 'turn-on-org-cdlatex)
-@end lisp
-
-When this mode is enabled, the following features are present (for
-more details see the documentation of CD@LaTeX{} mode):
-
-@table @asis
-@item @kbd{C-c @{}
-@kindex C-c @{
-
-Insert an environment template.
-
-@item @kbd{@key{TAB}}
-@kindex TAB
-
-The @kbd{@key{TAB}} key expands the template if point is inside
-a @LaTeX{} fragment@footnote{Org mode has a method to test if point is inside such
-a fragment, see the documentation of the function
-@code{org-inside-LaTeX-fragment-p}.}. For example, @kbd{@key{TAB}} expands @samp{fr}
-to @samp{\frac@{@}@{@}} and position point correctly inside the first brace.
-Another @kbd{@key{TAB}} gets you into the second brace.
-
-Even outside fragments, @kbd{@key{TAB}} expands environment
-abbreviations at the beginning of a line. For example, if you write
-@samp{equ} at the beginning of a line and press @kbd{@key{TAB}}, this
-abbreviation is expanded to an @samp{equation} environment. To get
-a list of all abbreviations, type @kbd{M-x cdlatex-command-help}.
-
-@item @kbd{^}
-@itemx @kbd{_}
-@kindex _
-@kindex ^
-@vindex cdlatex-simplify-sub-super-scripts
-
-Pressing @kbd{_} and @kbd{^} inside a @LaTeX{} fragment
-inserts these characters together with a pair of braces. If you use
-@kbd{@key{TAB}} to move out of the braces, and if the braces surround
-only a single character or macro, they are removed again (depending
-on the variable @code{cdlatex-simplify-sub-super-scripts}).
-
-@item @kbd{`}
-@kindex `
-
-Pressing the backquote followed by a character inserts math macros,
-also outside @LaTeX{} fragments. If you wait more than 1.5 seconds
-after the backquote, a help window pops up.
-
-@item @kbd{'}
-@kindex '
-
-Pressing the single-quote followed by another character modifies the
-symbol before point with an accent or a font. If you wait more than
-1.5 seconds after the single-quote, a help window pops up.
-Character modification works only inside @LaTeX{} fragments; outside
-the quote is normal.
-@end table
-
-@node Literal Examples
-@section Literal Examples
-
-@cindex literal examples, markup rules
-@cindex code line references, markup rules
-
-You can include literal examples that should not be subjected to
-markup. Such examples are typeset in monospace, so this is well
-suited for source code and similar examples.
-
-@cindex @samp{BEGIN_EXAMPLE}
-@cindex example block
-@example
-#+BEGIN_EXAMPLE
- Some example from a text file.
-#+END_EXAMPLE
-@end example
-
-@cindex comma escape, in literal examples
-There is one limitation, however. You must insert a comma right
-before lines starting with either @samp{*}, @samp{,*}, @samp{#+} or @samp{,#+}, as those
-may be interpreted as outlines nodes or some other special syntax.
-Org transparently strips these additional commas whenever it accesses
-the contents of the block.
-
-@example
-#+BEGIN_EXAMPLE
-,* I am no real headline
-#+END_EXAMPLE
-@end example
-
-For simplicity when using small examples, you can also start the
-example lines with a colon followed by a space. There may also be
-additional whitespace before the colon:
-
-@example
-Here is an example
- : Some example from a text file.
-@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 backend (it requires
-version 1.34 of the @samp{htmlize.el} package, which you need to install).
-Fontified code chunks in @LaTeX{} can be achieved using either the
-@uref{https://www.ctan.org/pkg/listings, listings} package or the @uref{https://www.ctan.org/pkg/minted, minted} package. Refer to
-@code{org-export-latex-listings} for details.}. This
-is done with the code block, where you also need to specify the name
-of the major mode that should be used to fontify the example@footnote{Source code in code blocks may also be evaluated either
-interactively or on export. See @ref{Working with Source Code} for more
-information on evaluating code blocks.},
-see @ref{Structure Templates} for shortcuts to easily insert code blocks.
-
-@cindex @samp{BEGIN_SRC}
-@cindex source block
-@example
-#+BEGIN_SRC emacs-lisp
- (defun org-xor (a b)
- "Exclusive or."
- (if a (not b) b))
- #+END_SRC
-@end example
-
-Both in @samp{example} and in @samp{src} snippets, you can add a @samp{-n} switch to
-the end of the @samp{#+BEGIN} line, to get the lines of the example
-numbered. The @samp{-n} takes an optional numeric argument specifying the
-starting line number of the block. If you use a @samp{+n} switch, the
-numbering from the previous numbered snippet is continued in the
-current one. The @samp{+n} switch can also take a numeric argument. This
-adds the value of the argument to the last line of the previous block
-to determine the starting line number.
-
-@example
-#+BEGIN_SRC emacs-lisp -n 20
- ;; This exports with line number 20.
- (message "This is line 21")
-#+END_SRC
-
-#+BEGIN_SRC emacs-lisp +n 10
- ;; This is listed as line 31.
- (message "This is line 32")
-#+END_SRC
-@end example
-
-In literal examples, Org interprets strings like @samp{(ref:name)} as
-labels, and use them as targets for special hyperlinks like
-@samp{[[(name)]]}---i.e., the reference name enclosed in single parenthesis.
-In HTML, hovering the mouse over such a link remote-highlights the
-corresponding code line, which is kind of cool.
-
-You can also add a @samp{-r} switch which @emph{removes} the labels from the
-source code@footnote{Adding @samp{-k} to @samp{-n -r} @emph{keeps} the labels in the source code
-while using line numbers for the links, which might be useful to
-explain those in an Org mode example code.}. With the @samp{-n} switch, links to these references
-are labeled by the line numbers from the code listing. Otherwise
-links use the labels with no parentheses. Here is an example:
-
-@example
-#+BEGIN_SRC emacs-lisp -n -r
- (save-excursion (ref:sc)
- (goto-char (point-min)) (ref:jump)
-#+END_SRC
-In line [[(sc)]] we remember the current position. [[(jump)][Line (jump)]]
-jumps to point-min.
-@end example
-
-@cindex indentation, in source blocks
-Source code and examples may be @emph{indented} in order to align nicely
-with the surrounding text, and in particular with plain list structure
-(see @ref{Plain Lists}). By default, Org only retains the relative
-indentation between lines, e.g., when exporting the contents of the
-block. However, you can use the @samp{-i} switch to also preserve the
-global indentation, if it does matter. See @ref{Editing Source Code}.
-
-@vindex org-coderef-label-format
-If the syntax for the label format conflicts with the language syntax,
-use a @samp{-l} switch to change the format, for example
-
-@example
-#+BEGIN_SRC pascal -n -r -l "((%s))"
-@end example
-
-
-@noindent
-See also the variable @code{org-coderef-label-format}.
-
-HTML export also allows examples to be published as text areas (see
-@ref{Text areas in HTML export}).
-
-Because the @samp{#+BEGIN} @dots{} @samp{#+END} patterns need to be added so often,
-a shortcut is provided (see @ref{Structure Templates}).
-
-@table @asis
-@item @kbd{C-c '} (@code{org-edit-special})
-@kindex C-c '
-@findex org-edit-special
-Edit the source code example at point in its native mode. This
-works by switching to a temporary buffer with the source code. You
-need to exit by pressing @kbd{C-c '} again. The edited version
-then replaces the old version in the Org buffer. Fixed-width
-regions---where each line starts with a colon followed by
-a space---are edited using Artist mode@footnote{You may select a different mode with the variable
-@code{org-edit-fixed-width-region-mode}.} to allow creating
-ASCII drawings easily. Using this command in an empty line creates
-a new fixed-width region.
-@end table
-
-@cindex storing link, in a source code buffer
-Calling @code{org-store-link} (see @ref{Handling Links}) while editing a source
-code example in a temporary buffer created with @kbd{C-c '}
-prompts for a label. Make sure that it is unique in the current
-buffer, and insert it with the proper 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}.
-
-@node Images
-@section Images
-
-@cindex inlining images
-@cindex images, markup rules
-An image is a link to an image file@footnote{What Emacs considers to be an image depends on
-@code{image-file-name-extensions} and @code{image-file-name-regexps}.} that does not have
-a description part, for example
-
-@example
-./img/cat.jpg
-@end example
-
-
-If you wish to define a caption for the image (see @ref{Captions}) and
-maybe a label for internal cross references (see @ref{Internal Links}),
-make sure that the link is on a line by itself and precede it with
-@samp{CAPTION} and @samp{NAME} keywords as follows:
-
-@example
-#+CAPTION: This is the caption for the next figure link (or table)
-#+NAME: fig:SED-HR4049
-[[./img/a.jpg]]
-@end example
-
-Such images can be displayed within the buffer with the following
-command:
-
-@table @asis
-@item @kbd{C-c C-x C-v} (@code{org-toggle-inline-images})
-@kindex C-c C-x C-v
-@findex org-toggle-inline-images
-@vindex org-startup-with-inline-images
-Toggle the inline display of linked images. When called with
-a prefix argument, also display images that do have a link
-description. You can ask for inline images to be displayed at
-startup by configuring the variable
-@code{org-startup-with-inline-images}@footnote{The variable @code{org-startup-with-inline-images} can be set
-within a buffer with the @samp{STARTUP} options @samp{inlineimages} and
-@samp{noinlineimages}.}.
-@end table
-
-@node Captions
-@section Captions
-
-@cindex captions, markup rules
-@cindex @samp{CAPTION}, keyword
-
-You can assign a caption to a specific part of a document by inserting
-a @samp{CAPTION} keyword immediately before it:
-
-@example
-#+CAPTION: This is the caption for the next table (or link)
-| ... | ... |
-|-----+-----|
-@end example
-
-Optionally, the caption can take the form:
-
-@example
-#+CAPTION[Short caption]: Longer caption.
-@end example
-
-
-Even though images and tables are prominent examples of captioned
-structures, 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 Horizontal Rules
-@section Horizontal Rules
-
-@cindex horizontal rules, markup rules
-A line consisting of only dashes, and at least 5 of them, is exported
-as a horizontal line.
-
-@node Creating Footnotes
-@section Creating Footnotes
-
-@cindex 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. Markers always start with @samp{fn:}. For example:
-
-@example
-The Org homepage[fn:1] now looks a lot better than it used to.
-...
-[fn:1] The link is: https://orgmode.org
-@end example
-
-Org mode extends the number-based syntax to @emph{named} footnotes and
-optional inline definition. Here are the valid references:
-
-@table @asis
-@item @samp{[fn:NAME]}
-A named footnote reference, where @var{NAME} is a unique
-label word, or, for simplicity of automatic creation, a number.
-
-@item @samp{[fn:: This is the inline definition of this footnote]}
-An anonymous footnote where the definition is given directly at the
-reference point.
-
-@item @samp{[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 @samp{[fn:NAME]} to create additional references.
-@end table
-
-@vindex org-footnote-auto-label
-Footnote labels can be created automatically, or you can create names
-yourself. This is handled by the variable @code{org-footnote-auto-label}
-and its corresponding @samp{STARTUP} keywords. See the docstring of that
-variable for details.
-
-The following command handles footnotes:
-
-@table @asis
-@item @kbd{C-c C-x f}
-The footnote action command.
-
-@kindex C-c C-x f
-When point is on a footnote reference, jump to the definition. When
-it is at a definition, jump to the---first---reference.
-
-@vindex org-footnote-define-inline
-@vindex org-footnote-section
-Otherwise, create a new footnote. Depending on the variable
-@code{org-footnote-define-inline}@footnote{The corresponding in-buffer setting is: @samp{#+STARTUP: fninline}
-or @samp{#+STARTUP: nofninline}.}, the definition is placed right
-into the text as part of the reference, or separately into the
-location determined by the variable @code{org-footnote-section}.
-
-When this command is called with a prefix argument, a menu of
-additional options is offered:
-
-@multitable @columnfractions 0.1 0.9
-@item @kbd{s}
-@tab Sort the footnote definitions by reference sequence.
-@item @kbd{r}
-@tab Renumber the simple @samp{fn:N} footnotes.
-@item @kbd{S}
-@tab Short for first @kbd{r}, then @kbd{s} action.
-@item @kbd{n}
-@tab Rename all footnotes into a @samp{fn:1} @dots{} @samp{fn:n} sequence.
-@item @kbd{d}
-@tab Delete the footnote at point, including definition and references.
-@end multitable
-
-@vindex org-footnote-auto-adjust
-Depending on the variable @code{org-footnote-auto-adjust}@footnote{The corresponding in-buffer options are @samp{#+STARTUP: fnadjust}
-and @samp{#+STARTUP: nofnadjust}.},
-renumbering and sorting footnotes can be automatic after each
-insertion or deletion.
-
-@item @kbd{C-c C-c}
-@kindex C-c C-c
-If point is on a footnote reference, jump to the definition. If it
-is at the definition, jump back to the reference. When called at
-a footnote location with a prefix argument, offer the same menu as
-@kbd{C-c C-x f}.
-
-@item @kbd{C-c C-o} or @kbd{mouse-1/2}
-@kindex C-c C-o
-@kindex mouse-1
-@kindex mouse-2
-Footnote labels are also links to the corresponding definition or
-reference, and you can use the usual commands to follow these links.
-@end table
-
-@node Exporting
-@chapter Exporting
-
-@cindex exporting
-
-At some point you might want to print your notes, publish them on the
-web, or share them with people not using Org. Org can convert and
-export documents to a variety of other formats while retaining as much
-structure (see @ref{Document Structure}) and markup (see @ref{Markup for Rich Contents}) as possible.
-
-@cindex export back-end
-The libraries responsible for translating Org files to other formats
-are called @emph{back-ends}. Org ships with support for the following
-back-ends:
-
-@itemize
-@item
-@emph{ascii} (ASCII format)
-@item
-@emph{beamer} (@LaTeX{} Beamer format)
-@item
-@emph{html} (HTML format)
-@item
-@emph{icalendar} (iCalendar format)
-@item
-@emph{latex} (@LaTeX{} format)
-@item
-@emph{md} (Markdown format)
-@item
-@emph{odt} (OpenDocument Text format)
-@item
-@emph{org} (Org format)
-@item
-@emph{texinfo} (Texinfo format)
-@item
-@emph{man} (Man page format)
-@end itemize
-
-Users can install libraries for additional formats from the Emacs
-packaging system. For easy discovery, these packages have a common
-naming scheme: @code{ox-NAME}, where @var{NAME} is a format. For
-example, @code{ox-koma-letter} for @emph{koma-letter} back-end. More libraries
-can be found in the @samp{contrib/} directory (see @ref{Installation}).
-
-@vindex org-export-backends
-Org only loads back-ends for the following formats by default: ASCII,
-HTML, iCalendar, @LaTeX{}, and ODT@. Additional back-ends can be loaded
-in either of two ways: by configuring the @code{org-export-backends}
-variable, or by requiring libraries in the Emacs init file. For
-example, to load the Markdown back-end, add this to your Emacs config:
-
-@lisp
-(require 'ox-md)
-@end lisp
-
-@menu
-* 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:: Producing presentations and slides.
-* HTML Export:: Exporting to HTML.
-* @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.
-* Advanced Export Configuration:: Fine-tuning the export output.
-* Export in Foreign Buffers:: Author tables and lists in Org syntax.
-@end menu
-
-@node The Export Dispatcher
-@section The Export Dispatcher
-
-@cindex dispatcher, for export commands
-@cindex export, dispatcher
-
-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.
-
-@vindex org-export-dispatch-use-expert-ui
-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 @kbd{?}.
-
-@table @asis
-@item @kbd{C-c C-e} (@code{org-export})
-@kindex C-c C-e
-@findex org-export
-
-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
-
-Org exports the entire buffer by default. If the Org buffer has an
-active region, then Org exports just that region.
-
-Within the dispatcher interface, the following key combinations can
-further alter what is exported, and how.
-
-@table @asis
-@item @kbd{C-a}
-@kindex C-c C-e C-a
-
-Toggle asynchronous export. Asynchronous export uses an external
-Emacs process with a specially configured initialization file to
-complete the exporting process in the background, without tying-up
-Emacs. This is particularly useful when exporting long documents.
-
-Output from an asynchronous export is saved on the @emph{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
-You can make asynchronous export the default by setting
-@code{org-export-in-background}.
-
-@vindex org-export-async-init-file
-You can set the initialization file used by the background process
-by setting @code{org-export-async-init-file}.
-
-@item @kbd{C-b}
-@kindex C-c C-e C-b
-
-Toggle body-only export. Useful for excluding headers and footers
-in the export. Affects only those back-end formats that have
-sections like @samp{<head>...</head>} in HTML@.
-
-@item @kbd{C-s}
-@kindex C-c C-e C-s
-
-Toggle sub-tree export. When turned on, Org exports only the
-sub-tree starting from point position at the time the export
-dispatcher was invoked. Org uses the top heading of this sub-tree
-as the document's title. If point is not on a heading, Org uses the
-nearest enclosing header. If point is in the document preamble, Org
-signals an error and aborts export.
-
-@vindex org-export-initial-scope
-To make sub-tree export the default, customize the variable
-@code{org-export-initial-scope}.
-
-@item @kbd{C-v}
-@kindex C-c C-e C-v
-
-Toggle visible-only export. This is useful for exporting only
-certain parts of an Org document by adjusting the visibility of
-particular headings.
-@end table
-
-@node Export Settings
-@section Export Settings
-
-@cindex options, for export
-@cindex Export, settings
-
-@cindex @samp{OPTIONS}, keyword
-Export options can be set: globally with variables; for an individual
-file by making variables buffer-local with in-buffer settings (see
-@ref{In-buffer Settings}); by setting individual keywords or
-specifying them in compact form with the @samp{OPTIONS} keyword; or for
-a tree by setting properties (see @ref{Properties and Columns}). Options
-set at a specific level override options set at a more general level.
-
-@cindex @samp{SETUPFILE}, keyword
-In-buffer settings may appear anywhere in the file, either directly or
-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 (see @ref{The Export Dispatcher}) using the @samp{Insert template} command by pressing
-@kbd{#}. To insert keywords individually, a good way to make
-sure the keyword is correct is to type @samp{#+} and then to use
-@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.
-
-The export keywords available for every back-end, and their equivalent
-global variables, include:
-
-@table @asis
-@item @samp{AUTHOR}
-@cindex @samp{AUTHOR}, keyword
-@vindex user-full-name
-The document author (@code{user-full-name}).
-
-@item @samp{CREATOR}
-@cindex @samp{CREATOR}, keyword
-@vindex org-expot-creator-string
-Entity responsible for output generation
-(@code{org-export-creator-string}).
-
-@item @samp{DATE}
-@cindex @samp{DATE}, keyword
-@vindex org-export-date-timestamp-format
-A date or a time-stamp@footnote{The variable @code{org-export-date-timestamp-format} defines how
-this timestamp are exported.}.
-
-@item @samp{EMAIL}
-@cindex @samp{EMAIL}, keyword
-@vindex user-mail-address
-The email address (@code{user-mail-address}).
-
-@item @samp{LANGUAGE}
-@cindex @samp{LANGUAGE}, keyword
-@vindex org-export-default-language
-Language to use for translating certain strings
-(@code{org-export-default-language}). With @samp{#+LANGUAGE: fr}, for
-example, Org translates @samp{Table of contents} to the French @samp{Table des
- matières}@footnote{DEFINITION NOT FOUND@.}.
-
-@item @samp{SELECT_TAGS}
-@cindex @samp{SELECT_TAGS}, keyword
-@vindex org-export-select-tags
-The default value is @samp{("export")}. When a tree is tagged with
-@samp{export} (@code{org-export-select-tags}), Org selects that tree and its
-sub-trees for export. Org excludes trees with @samp{noexport} tags, see
-below. When selectively exporting files with @samp{export} tags set, Org
-does not export any text that appears before the first headline.
-
-@item @samp{EXCLUDE_TAGS}
-@cindex @samp{EXCLUDE_TAGS}, keyword
-@vindex org-export-exclude-tags
-The default value is @samp{("noexport")}. When a tree is tagged with
-@samp{noexport} (@code{org-export-exclude-tags}), Org excludes that tree and
-its sub-trees from export. Entries tagged with @samp{noexport} are
-unconditionally excluded from the export, even if they have an
-@samp{export} tag. Even if a sub-tree is not exported, Org executes any
-code blocks contained there.
-
-@item @samp{TITLE}
-@cindex @samp{TITLE}, keyword
-@cindex document title
-Org displays this title. For long titles, use multiple @samp{#+TITLE}
-lines.
-
-@item @samp{EXPORT_FILE_NAME}
-@cindex @samp{EXPORT_FILE_NAME}, keyword
-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 @samp{OPTIONS} keyword is a compact form. To configure multiple
-options, use several @samp{OPTIONS} lines. @samp{OPTIONS} recognizes the
-following arguments.
-
-@table @asis
-@item @code{'}
-@vindex 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 @code{*}
-@vindex org-export-with-emphasize
-Toggle emphasized text (@code{org-export-with-emphasize}).
-
-@item @code{-}
-@vindex org-export-with-special-strings
-Toggle conversion of special strings
-(@code{org-export-with-special-strings}).
-
-@item @code{:}
-@vindex org-export-with-fixed-width
-Toggle fixed-width sections (@code{org-export-with-fixed-width}).
-
-@item @code{<}
-@vindex org-export-with-timestamps
-Toggle inclusion of time/date active/inactive stamps
-(@code{org-export-with-timestamps}).
-
-@item @code{\n}
-@vindex org-export-preserve-breaks
-Toggles whether to preserve line breaks
-(@code{org-export-preserve-breaks}).
-
-@item @code{^}
-@vindex org-export-with-sub-superscripts
-Toggle @TeX{}-like syntax for sub- and superscripts. If you write
-@samp{^:@{@}}, @samp{a_@{b@}} is interpreted, but the simple @samp{a_b} is left as it
-is (@code{org-export-with-sub-superscripts}).
-
-@item @code{arch}
-@vindex org-export-with-archived-trees
-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 @code{author}
-@vindex org-export-with-author
-Toggle inclusion of author name into exported file
-(@code{org-export-with-author}).
-
-@item @code{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 @code{c}
-@vindex org-export-with-clocks
-Toggle inclusion of @samp{CLOCK} keywords (@code{org-export-with-clocks}).
-
-@item @code{creator}
-@vindex org-export-with-creator
-Toggle inclusion of creator information in the exported file
-(@code{org-export-with-creator}).
-
-@item @code{d}
-@vindex 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 @code{date}
-@vindex org-export-with-date
-Toggle inclusion of a date into exported file
-(@code{org-export-with-date}).
-
-@item @code{e}
-@vindex org-export-with-entities
-Toggle inclusion of entities (@code{org-export-with-entities}).
-
-@item @code{email}
-@vindex org-export-with-email
-Toggle inclusion of the author's e-mail into exported file
-(@code{org-export-with-email}).
-
-@item @code{f}
-@vindex org-export-with-footnotes
-Toggle the inclusion of footnotes (@code{org-export-with-footnotes}).
-
-@item @code{H}
-@vindex org-export-headline-levels
-Set the number of headline levels for export
-(@code{org-export-headline-levels}). Below that level, headlines are
-treated differently. In most back-ends, they become list items.
-
-@item @code{inline}
-@vindex org-export-with-inlinetasks
-Toggle inclusion of inlinetasks (@code{org-export-with-inlinetasks}).
-
-@item @code{num}
-@vindex org-export-with-section-numbers
-@cindex @samp{UNNUMBERED}, property
-Toggle section-numbers (@code{org-export-with-section-numbers}). When
-set to number N, Org numbers only those headlines at level N or
-above. Set @samp{UNNUMBERED} property to non-@code{nil} to disable numbering
-of heading and subheadings entirely. Moreover, when the value is
-@samp{notoc} the headline, and all its children, do not appear in the
-table of contents either (see @ref{Table of Contents}).
-
-@item @code{p}
-@vindex org-export-with-planning
-Toggle export of planning information (@code{org-export-with-planning}).
-``Planning information'' comes from lines located right after the
-headline and contain any combination of these cookies: @samp{SCHEDULED},
-@samp{DEADLINE}, or @samp{CLOSED}.
-
-@item @code{pri}
-@vindex org-export-with-priority
-Toggle inclusion of priority cookies
-(@code{org-export-with-priority}).
-
-@item @code{prop}
-@vindex org-export-with-properties
-Toggle inclusion of property drawers, or list the properties to
-include (@code{org-export-with-properties}).
-
-@item @code{stat}
-@vindex org-export-with-statistics-cookies
-Toggle inclusion of statistics cookies
-(@code{org-export-with-statistics-cookies}).
-
-@item @code{tags}
-@vindex org-export-with-tags
-Toggle inclusion of tags, may also be @code{not-in-toc}
-(@code{org-export-with-tags}).
-
-@item @code{tasks}
-@vindex org-export-with-tasks
-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 @code{tex}
-@vindex org-export-with-latex
-@code{nil} does not export; @code{t} exports; @code{verbatim} keeps everything in
-verbatim (@code{org-export-with-latex}).
-
-@item @code{timestamp}
-@vindex org-export-time-stamp-file
-Toggle inclusion of the creation time in the exported file
-(@code{org-export-time-stamp-file}).
-
-@item @code{title}
-@vindex org-export-with-title
-Toggle inclusion of title (@code{org-export-with-title}).
-
-@item @code{toc}
-@vindex org-export-with-toc
-Toggle inclusion of the table of contents, or set the level limit
-(@code{org-export-with-toc}).
-
-@item @code{todo}
-@vindex org-export-with-todo-keywords
-Toggle inclusion of TODO keywords into exported text
-(@code{org-export-with-todo-keywords}).
-
-@item @code{|}
-@vindex org-export-with-tables
-Toggle inclusion of tables (@code{org-export-with-tables}).
-@end table
-
-When exporting sub-trees, special node properties can override the
-above keywords. These properties have an @samp{EXPORT_} prefix. For
-example, @samp{DATE} becomes, @samp{EXPORT_DATE} when used for a specific
-sub-tree. Except for @samp{SETUPFILE}, all other keywords listed above
-have an @samp{EXPORT_} equivalent.
-
-@cindex @samp{BIND}, keyword
-@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 @samp{BIND} keyword. Its
-syntax is @samp{#+BIND: variable value}. This is particularly useful for
-in-buffer settings that cannot be changed using keywords.
-
-@node Table of Contents
-@section Table of Contents
-
-@cindex table of contents
-@cindex list of tables
-@cindex list of listings
-
-@cindex @samp{toc}, in @samp{OPTIONS} keyword
-@vindex org-export-with-toc
-The table of contents includes all headlines in the document. Its
-depth is therefore the same as the headline levels in the file. If
-you need to use a different depth, or turn it off entirely, set the
-@code{org-export-with-toc} variable accordingly. You can achieve the same
-on a per file basis, using the following @samp{toc} item in @samp{OPTIONS}
-keyword:
-
-@example
-#+OPTIONS: toc:2 (only include two levels in TOC)
-#+OPTIONS: toc:nil (no default TOC at all)
-@end example
-
-@cindex excluding entries from table of contents
-@cindex table of contents, exclude entries
-Org includes both numbered and unnumbered headlines in the table of
-contents@footnote{At the moment, some export back-ends do not obey this
-specification. For example, @LaTeX{} export excludes every unnumbered
-headline from the table of contents.}. If you need to exclude an unnumbered headline,
-along with all its children, set the @samp{UNNUMBERED} property to @samp{notoc}
-value.
-
-@example
-* Subtree not numbered, not in table of contents either
- :PROPERTIES:
- :UNNUMBERED: notoc
- :END:
-@end example
-
-@cindex @samp{TOC}, keyword
-Org normally inserts the table of contents directly before the first
-headline of the file. To move the table of contents to a different
-location, first turn off the default with @code{org-export-with-toc}
-variable or with @samp{#+OPTIONS: toc:nil}. Then insert @samp{#+TOC: headlines
-N} at the desired location(s).
-
-@example
-#+OPTIONS: toc:nil
-...
-#+TOC: headlines 2
-@end example
-
-To adjust the table of contents 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. The following example
-inserts a local table of contents, with direct children only.
-
-@example
-* Section
-#+TOC: headlines 1 local
-@end example
-
-Note that for this feature to work properly in @LaTeX{} export, the Org
-file requires the inclusion of the titletoc package. Because of
-compatibility issues, titletoc has to be loaded @emph{before} hyperref.
-Customize the @code{org-latex-default-packages-alist} variable.
-
-The following example inserts a table of contents that links to the
-children of the specified target.
-
-@example
-* Target
- :PROPERTIES:
- :CUSTOM_ID: TargetSection
- :END:
-** Heading A
-** Heading B
-* Another section
-#+TOC: headlines 1 :target #TargetSection
-@end example
-
-The @samp{:target} attribute is supported in HTML, Markdown, ODT, and ASCII export.
-
-Use the @samp{TOC} keyword to generate list of tables---respectively, all
-listings---with captions.
-
-@example
-#+TOC: listings
-#+TOC: tables
-@end example
-
-@cindex @samp{ALT_TITLE}, property
-Normally Org uses the headline for its entry in the table of contents.
-But with @samp{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
-@cindex export, include files
-@cindex @samp{INCLUDE}, keyword
-
-During export, you can include the content of another file. For
-example, to include your @samp{.emacs} file, you could use:
-
-@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 included file is specified as having a markup language, Org
-neither checks for valid syntax nor changes the contents in any way.
-For example and source blocks, Org code-escapes the contents before
-inclusion.
-
-@cindex @samp{minlevel}, include
-If an included 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 (see @ref{Creating Footnotes})
-in the included file local to that file. The contents of the included
-file belong to the same structure---headline, item---containing the
-@samp{INCLUDE} keyword. In particular, headlines within the file become
-children of the current section. That behavior can be changed by
-providing an additional keyword parameter, @samp{: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
-
-
-@cindex @samp{lines}, include
-Inclusion of only portions of files are specified using ranges
-parameter with @samp{: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.
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{#+INCLUDE: "~/.emacs" :lines "5-10"}
-@tab Include lines 5 to 10, 10 excluded
-@item @samp{#+INCLUDE: "~/.emacs" :lines "-10"}
-@tab Include lines 1 to 10, 10 excluded
-@item @samp{#+INCLUDE: "~/.emacs" :lines "10-"}
-@tab Include lines from 10 to EOF
-@end multitable
-
-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.} (see @ref{Search Options}). The
-ranges for @samp{:lines} keyword are relative to the requested element.
-Therefore,
-
-@example
-#+INCLUDE: "./paper.org::*conclusion" :lines 1-20
-@end example
-
-
-@noindent
-includes the first 20 lines of the headline named @samp{conclusion}.
-
-@cindex @samp{only-contents}, include
-To extract only the contents of the matched object, set
-@samp{:only-contents} property to non-@code{nil}. This omits any planning lines
-or property drawers. For example, to include the body of the heading
-with the custom ID @samp{theory}, you can use
-
-@example
-#+INCLUDE: "./paper.org::#theory" :only-contents t
-@end example
-
-
-The following command allows navigating to the included document:
-
-@table @asis
-@item @kbd{C-c '} (@code{org-edit~special})
-@kindex C-c '
-@findex org-edit-special
-
-Visit the included file at point.
-@end table
-
-@node Macro Replacement
-@section Macro Replacement
-
-@cindex macro replacement, during export
-@cindex @samp{MACRO}, keyword
-
-@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 @samp{@{@{@{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.}. For
-example
-
-@example
-#+MACRO: poem Rose is $1, violet's $2. Life's ordered: Org assists you.
-@{@{@{poem(red,blue)@}@}@}
-@end example
-
-@noindent
-becomes
-
-@example
-Rose is red, violet's blue. Life's ordered: Org assists you.
-@end example
-
-
-As a special case, Org parses any replacement text starting with
-@samp{(eval} as an Emacs Lisp expression and evaluates it accordingly.
-Within such templates, arguments become strings. Thus, the following
-macro
-
-@example
-#+MACRO: gnustamp (eval (concat "GNU/" (capitalize $1)))
-@end example
-
-
-@noindent
-turns @samp{@{@{@{gnustamp(linux)@}@}@}} into @samp{GNU/Linux} during export.
-
-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 @samp{CAPTION}, @samp{TITLE},
-@samp{AUTHOR}, @samp{DATE}, and for some back-end specific export options.
-
-Org comes with following pre-defined macros:
-
-@table @asis
-@item @samp{@{@{@{keyword(NAME)@}@}@}}
-@itemx @samp{@{@{@{title@}@}@}}
-@itemx @samp{@{@{@{author@}@}@}}
-@itemx @samp{@{@{@{email@}@}@}}
-@cindex @samp{keyword}, macro
-@cindex @samp{title}, macro
-@cindex @samp{author}, macro
-@cindex @samp{email}, macro
-The @samp{keyword} macro collects all values from @var{NAME}
-keywords throughout the buffer, separated with white space.
-@samp{title}, @samp{author} and @samp{email} macros are shortcuts for,
-respectively, @samp{@{@{@{keyword(TITLE)@}@}@}}, @samp{@{@{@{keyword(AUTHOR)@}@}@}} and
-@samp{@{@{@{keyword(EMAIL)@}@}@}}.
-
-@item @samp{@{@{@{date@}@}@}}
-@itemx @samp{@{@{@{date(FORMAT)@}@}@}}
-@cindex @samp{date}, macro
-This macro refers to the @samp{DATE} keyword. @var{FORMAT} is an
-optional argument to the @samp{date} macro that is used only if @samp{DATE} is
-a single timestamp. @var{FORMAT} should be a format string
-understood by @code{format-time-string}.
-
-@item @samp{@{@{@{time(FORMAT)@}@}@}}
-@itemx @samp{@{@{@{modification-time(FORMAT, VC)@}@}@}}
-@cindex @samp{time}, macro
-@cindex @samp{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 @samp{vc.el} to retrieve
-the document's modification time from the version control system.
-Otherwise Org reads the file attributes.
-
-@item @samp{@{@{@{input-file@}@}@}}
-@cindex @samp{input-file}, macro
-This macro refers to the filename of the exported file.
-
-@item @samp{@{@{@{property(PROPERTY-NAME)@}@}@}}
-@itemx @samp{@{@{@{property(PROPERTY-NAME, SEARCH OPTION)@}@}@}}
-@cindex @samp{property}, macro
-This macro returns the value of property @var{PROPERTY-NAME} in
-the current entry. If @var{SEARCH-OPTION} (see @ref{Search Options}) refers to a remote entry, use it instead.
-
-@item @samp{@{@{@{n@}@}@}}
-@itemx @samp{@{@{@{n(NAME)@}@}@}}
-@itemx @samp{@{@{@{n(NAME, ACTION)@}@}@}}
-@cindex @samp{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 @samp{-}, 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
-
-@cindex @samp{results}, macro
-Moreover, inline source blocks (see @ref{Structure of Code Blocks}) use the
-special @samp{results} macro to mark their output. As such, you are
-advised against re-defining it, unless you know what you are doing.
-
-@vindex org-hide-macro-markers
-The surrounding brackets can be made invisible by setting
-@code{org-hide-macro-markers} to a non-@code{nil} value.
-
-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 @samp{BEGIN_COMMENT}
-@cindex comment block
-Likewise, regions surrounded by @samp{#+BEGIN_COMMENT} @dots{} @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 (see
-@ref{Export Settings}) instead.}. The command below helps changing the
-comment status of a headline.
-
-@table @asis
-@item @kbd{C-c ;} (@code{org-toggle-comment})
-@kindex C-c ;
-@findex org-toggle-comment
-
-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 an output file containing only plain ASCII
-characters. This is the simplest and most direct text output. It
-does not contain any Org markup. 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
-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.
-
-@anchor{ASCII export commands}
-@subheading ASCII export commands
-
-@table @asis
-@item @kbd{C-c C-e t a} (@code{org-ascii-export-to-ascii})
-@itemx @kbd{C-c C-e t l}
-@itemx @kbd{C-c C-e t u}
-@kindex C-c C-e t a
-@kindex C-c C-e t l
-@kindex C-c C-e t u
-@findex org-ascii-export-to-ascii
-
-Export as an ASCII file with a @samp{.txt} extension. For @samp{myfile.org},
-Org exports to @samp{myfile.txt}, overwriting without warning. For
-@samp{myfile.txt}, Org exports to @samp{myfile.txt.txt} in order to prevent
-data loss.
-
-@item @kbd{C-c C-e t A} (@code{org-ascii-export-to-ascii})
-@itemx @kbd{C-c C-e t L}
-@itemx @kbd{C-c C-e t U}
-@kindex C-c C-e t A
-@kindex C-c C-e t L
-@kindex C-c C-e t U
-@findex org-ascii-export-as-ascii
-
-Export to a temporary buffer. Does not create a file.
-@end table
-
-@anchor{ASCII specific export settings}
-@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
-(see @ref{Export Settings}).
-
-@table @asis
-@item @samp{SUBTITLE}
-@cindex @samp{SUBTITLE}, keyword
-The document subtitle. For long subtitles, use multiple
-@samp{#+SUBTITLE} lines in the Org file. Org prints them on one
-continuous line, wrapping into multiple lines if necessary.
-@end table
-
-@anchor{Header and sectioning structure}
-@subheading Header and sectioning structure
-
-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, see @ref{Export Settings}.
-
-@anchor{Quoting ASCII text}
-@subheading Quoting ASCII text
-
-To insert text within the Org file by the ASCII back-end, use one the
-following constructs, inline, keyword, or export block:
-
-@cindex @samp{ASCII}, keyword
-@cindex @samp{BEGIN_EXPORT ascii}
-@example
-Inline text @@@@ascii:and additional text@@@@ within a paragraph.
-
-#+ASCII: Some text
-
-#+BEGIN_EXPORT ascii
-Org exports text in this block only when using ASCII back-end.
-#+END_EXPORT
-@end example
-
-@anchor{ASCII specific attributes}
-@subheading ASCII specific attributes
-
-@cindex @samp{ATTR_ASCII}, keyword
-@cindex horizontal rules, in ASCII export
-
-ASCII back-end recognizes only one attribute, @samp{:width}, which
-specifies the width of a horizontal rule in number of characters. The
-keyword and syntax for specifying widths is:
-
-@example
-#+ATTR_ASCII: :width 10
------
-@end example
-
-@anchor{ASCII special blocks}
-@subheading ASCII special blocks
-
-@cindex special blocks, in ASCII export
-@cindex @samp{BEGIN_JUSTIFYLEFT}
-@cindex @samp{BEGIN_JUSTIFYRIGHT}
-
-Besides @samp{#+BEGIN_CENTER} blocks (see @ref{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
-
-Org uses Beamer export to convert an Org file tree structure into
-high-quality interactive slides for presentations. Beamer is a @LaTeX{}
-document class for creating presentations in PDF, HTML, and other
-popular display formats.
-
-@menu
-* Beamer export commands:: For creating Beamer documents.
-* Beamer specific export settings:: For customizing Beamer export.
-* Frames and Blocks in Beamer:: For composing Beamer slides.
-* Beamer specific syntax:: For using in Org documents.
-* Editing support:: Editing support.
-* A Beamer example:: A complete presentation.
-@end menu
-
-@node Beamer export commands
-@subsection Beamer export commands
-
-@table @asis
-@item @kbd{C-c C-e l b} (@code{org-beamer-export-to-latex})
-@kindex C-c C-e l b
-@findex org-beamer-export-to-latex
-
-Export as @LaTeX{} file with a @samp{.tex} extension. For @samp{myfile.org}, Org
-exports to @samp{myfile.tex}, overwriting without warning.
-
-@item @kbd{C-c C-e l B} (@code{org-beamer-export-as-latex})
-@kindex C-c C-e l B
-@findex org-beamer-export-as-latex
-
-Export to a temporary buffer. Does not create a file.
-
-@item @kbd{C-c C-e l P} (@code{org-beamer-export-to-pdf})
-@kindex C-c C-e l P
-@findex org-beamer-export-to-pdf
-
-Export as @LaTeX{} file and then convert it to PDF format.
-
-@item @kbd{C-c C-e l O}
-@kindex C-c C-e l O
-
-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 (see @ref{Export Settings}).
-
-@table @asis
-@item @samp{BEAMER_THEME}
-@cindex @samp{BEAMER_THEME}, keyword
-@vindex org-beamer-theme
-The Beamer layout theme (@code{org-beamer-theme}). Use square brackets
-for options. For example:
-
-@example
-#+BEAMER_THEME: Rochester [height=20pt]
-@end example
-
-@item @samp{BEAMER_FONT_THEME}
-@cindex @samp{BEAMER_FONT_THEME}, keyword
-The Beamer font theme.
-
-@item @samp{BEAMER_INNER_THEME}
-@cindex @samp{BEAMER_INNER_THEME}, keyword
-The Beamer inner theme.
-
-@item @samp{BEAMER_OUTER_THEME}
-@cindex @samp{BEAMER_OUTER_THEME}, keyword
-The Beamer outer theme.
-
-@item @samp{BEAMER_HEADER}
-@cindex @samp{BEAMER_HEADER}, keyword
-Arbitrary lines inserted in the preamble, just before the @samp{hyperref}
-settings.
-
-@item @samp{DESCRIPTION}
-@cindex @samp{DESCRIPTION}, keyword
-The document description. For long descriptions, use multiple
-@samp{DESCRIPTION} keywords. By default, @samp{hyperref} inserts
-@samp{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 @samp{KEYWORDS}
-@cindex @samp{KEYWORDS}, keyword
-The keywords for defining the contents of the document. Use
-multiple @samp{KEYWORDS} lines if necessary. By default, @samp{hyperref}
-inserts @samp{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 @samp{SUBTITLE}
-@cindex @samp{SUBTITLE}, keyword
-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
-
-@node Frames and Blocks in Beamer
-@subsection Frames and Blocks in Beamer
-
-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
-@item
-@vindex org-beamer-frame-level
-Org headlines become Beamer frames when the heading level in Org is
-equal to @code{org-beamer-frame-level} or @samp{H} value in a @samp{OPTIONS} line
-(see @ref{Export Settings}).
-
-@cindex @samp{BEAMER_ENV}, property
-Org overrides headlines to frames conversion for the current tree of
-an Org file if it encounters the @samp{BEAMER_ENV} property set to
-@samp{frame} or @samp{fullframe}. Org ignores whatever
-@code{org-beamer-frame-level} happens to be for that headline level in
-the Org tree. In Beamer terminology, a full frame is a frame
-without its title.
-
-@item
-Org exports a Beamer frame's objects as block environments. Org can
-enforce wrapping in special block types when @samp{BEAMER_ENV} property
-is set@footnote{If @samp{BEAMER_ENV} is set, Org export adds @samp{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}.
-@vindex org-beamer-environments-default
-@vindex org-beamer-environments-extra
-
-@item
-@cindex @samp{BEAMER_REF}, property
-If @samp{BEAMER_ENV} is set to @samp{appendix}, Org exports the entry as an
-appendix. When set to @samp{note}, Org exports the entry as a note
-within the frame or between frames, depending on the entry's heading
-level. When set to @samp{noteNH}, Org exports the entry as a note
-without its title. When set to @samp{againframe}, Org exports the entry
-with @samp{\againframe} command, which makes setting the @samp{BEAMER_REF}
-property mandatory because @samp{\againframe} needs frame to resume.
-
-When @samp{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 @samp{column}
-environment. @@end itemize
-
-@cindex @samp{BEAMER_ACT}, property
-@cindex @samp{BEAMER_OPT}, property
-When @samp{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 @samp{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
-@samp{fragile} option for any code that may require a verbatim block.
-
-@cindex @samp{BEAMER_COL}, property
-To create a column on the Beamer slide, use the @samp{BEAMER_COL}
-property for its headline in the Org file. Set the value of
-@samp{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 @samp{BEAMER_ENV} property.
-@end itemize
-
-@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:}. See @ref{@LaTeX{} Export}, for details.
-
-Beamer export wraps the table of contents generated with @samp{toc:t}
-@samp{OPTION} keyword in a @samp{frame} environment. Beamer export does not
-wrap the table of contents generated with @samp{TOC} keyword (see @ref{Table of Contents}). Use square brackets for specifying options.
-
-@example
-#+TOC: headlines [currentsection]
-@end example
-
-
-Insert Beamer-specific code using the following constructs:
-
-@cindex @samp{BEAMER}, keyword
-@cindex @samp{BEGIN_EXPORT beamer}
-@example
-#+BEAMER: \pause
-
-#+BEGIN_EXPORT beamer
- Only Beamer export back-end exports this.
-#+END_BEAMER
-
-Text @@@@beamer:some code@@@@ within a paragraph.
-@end example
-
-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 of the object as
-shown in this example:
-
-@example
-A *@@@@beamer:<2->@@@@useful* feature
-@end example
-
-
-@cindex @samp{ATTR_BEAMER}, keyword
-Beamer export recognizes the @samp{ATTR_BEAMER} keyword with the following
-attributes from Beamer configurations: @samp{:environment} for changing
-local Beamer environment, @samp{:overlay} for specifying Beamer overlays in
-angular or square brackets, and @samp{:options} for inserting optional
-arguments.
-
-@example
-#+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
-
-@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
-
-Org Beamer mode is a special minor mode for faster editing of Beamer
-documents.
-
-@example
-#+STARTUP: beamer
-@end example
-
-
-@table @asis
-@item @kbd{C-c C-b} (@code{org-beamer-select-environment})
-@kindex C-c C-b
-@findex org-beamer-select-environment
-
-Org Beamer mode provides this key for quicker selections in Beamer
-normal environments, and for selecting the @samp{BEAMER_COL} property.
-@end table
-
-@node A Beamer example
-@subsection A Beamer example
-
-Here is an example of an Org document ready for Beamer export.
-
-@example
-#+TITLE: Example Presentation
-#+AUTHOR: Carsten Dominik
-#+OPTIONS: H:2 toc:t num:t
-#+LATEX_CLASS: beamer
-#+LATEX_CLASS_OPTIONS: [presentation]
-#+BEAMER_THEME: Madrid
-#+COLUMNS: %45ITEM %10BEAMER_ENV(Env) %10BEAMER_ACT(Act) %4BEAMER_COL(Col)
-
-* This is the first structural section
-
-** Frame 1
-*** 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:
- :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:
- :PROPERTIES:
- :BEAMER_env: note
- :END:
-** Frame 2 (where we will not use columns)
-*** Request
- Please test this stuff!
-@end example
-
-@node HTML Export
-@section HTML Export
-
-@cindex HTML export
-
-Org mode contains an HTML exporter with extensive HTML formatting
-compatible with XHTML 1.0 strict standard.
-
-@menu
-* 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.
-* Headlines in HTML export:: Formatting headlines.
-* Links in HTML export:: Inserting and formatting links.
-* 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 alternate way to show an example.
-* CSS support:: Changing the appearance of the output.
-* JavaScript support:: Info and folding in a web browser.
-@end menu
-
-@node HTML export commands
-@subsection HTML export commands
-
-@table @asis
-@item @kbd{C-c C-e h h} (@code{org-html-export-to-html})
-@kindex C-c C-e h h
-@kindex C-c C-e h o
-@findex org-html-export-to-html
-
-Export as HTML file with a @samp{.html} extension. For @samp{myfile.org}, Org
-exports to @samp{myfile.html}, overwriting without warning. @{@{@{kbd@{C-c
-C-e h o)@}@}@} exports to HTML and opens it in a web browser.
-
-@item @kbd{C-c C-e h H} (@code{org-html-export-as-html})
-@kindex C-c C-e h H
-@findex org-html-export-as-html
-
-Exports to a temporary buffer. Does not create a file.
-@end table
-
-@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}.
-
-@table @asis
-@item @samp{DESCRIPTION}
-@cindex @samp{DESCRIPTION}, keyword
-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 @samp{DESCRIPTION} lines. The exporter takes care of wrapping
-the lines properly.
-
-@item @samp{HTML_DOCTYPE}
-@cindex @samp{HTML_DOCTYPE}, keyword
-@vindex org-html-doctype
-Specify the document type, for example: HTML5 (@code{org-html-doctype}).
-
-@item @samp{HTML_CONTAINER}
-@cindex @samp{HTML_CONTAINER}, keyword
-@vindex org-html-container-element
-Specify the HTML container, such as @samp{div}, for wrapping sections and
-elements (@code{org-html-container-element}).
-
-@item @samp{HTML_LINK_HOME}
-@cindex @samp{HTML_LINK_HOME}, keyword
-@vindex org-html-link-home
-The URL for home link (@code{org-html-link-home}).
-
-@item @samp{HTML_LINK_UP}
-@cindex @samp{HTML_LINK_UP}, keyword
-@vindex org-html-link-up
-The URL for the up link of exported HTML pages (@code{org-html-link-up}).
-
-@item @samp{HTML_MATHJAX}
-@cindex @samp{HTML_MATHJAX}, keyword
-@vindex org-html-mathjax-options
-Options for MathJax (@code{org-html-mathjax-options}). MathJax is used
-to typeset @LaTeX{} math in HTML documents. See @ref{Math formatting in HTML export}, for an example.
-
-@item @samp{HTML_HEAD}
-@cindex @samp{HTML_HEAD}, keyword
-@vindex org-html-head
-Arbitrary lines for appending to the HTML document's head
-(@code{org-html-head}).
-
-@item @samp{HTML_HEAD_EXTRA}
-@cindex @samp{HTML_HEAD_EXTRA}, keyword
-@vindex org-html-head-extra
-More arbitrary lines for appending to the HTML document's head
-(@code{org-html-head-extra}).
-
-@item @samp{KEYWORDS}
-@cindex @samp{KEYWORDS}, keyword
-Keywords to describe the document's content. HTML exporter inserts
-these keywords as HTML meta tags. For long keywords, use multiple
-@samp{KEYWORDS} lines.
-
-@item @samp{LATEX_HEADER}
-@cindex @samp{LATEX_HEADER}, keyword
-Arbitrary lines for appending to the preamble; HTML exporter appends
-when transcoding @LaTeX{} fragments to images (see @ref{Math formatting in HTML export}).
-
-@item @samp{SUBTITLE}
-@cindex @samp{SUBTITLE}, keyword
-The document's subtitle. HTML exporter formats subtitle if document
-type is @samp{HTML5} and the CSS has a @samp{subtitle} class.
-@end table
-
-Some of these keywords are explained in more detail in the following
-sections of the manual.
-
-@node HTML doctypes
-@subsection HTML doctypes
-
-Org can export to various (X)HTML flavors.
-
-@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
-@code{"html4-strict"}
-@item
-@code{"html4-transitional"}
-@item
-@code{"html4-frameset"}
-@item
-@code{"xhtml-strict"}
-@item
-@code{"xhtml-transitional"}
-@item
-@code{"xhtml-frameset"}
-@item
-@code{"xhtml-11"}
-@item
-@code{"html5"}
-@item
-@code{"xhtml5"}
-@end itemize
-
-@noindent
-See the variable @code{org-html-doctype-alist} for details. The default is
-@code{"xhtml-strict"}.
-
-@vindex org-html-html5-fancy
-@cindex @samp{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 @samp{OPTIONS} line in the
-file to set @samp{html5-fancy}.
-
-HTML5 documents can now have arbitrary @samp{#+BEGIN} @dots{} @samp{#+END} blocks.
-For example:
-
-@example
-#+BEGIN_aside
- Lorem ipsum
-#+END_aside
-@end example
-
-@noindent
-exports to:
-
-@example
-<aside>
- <p>Lorem ipsum</p>
-</aside>
-@end example
-
-@noindent
-while this:
-
-@example
-#+ATTR_HTML: :controls controls :width 350
-#+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 example
-
-@noindent
-exports to:
-
-@example
-<video controls="controls" width="350">
- <source src="movie.mp4" type="video/mp4">
- <source src="movie.ogg" type="video/ogg">
- <p>Your browser does not support the video tag.</p>
-</video>
-@end example
-
-@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, @samp{#+BEGIN_lederhosen} exports
-to @code{<div class="lederhosen">}.
-
-Special blocks cannot have headlines. For the HTML exporter to wrap
-the headline and its contents in @code{<section>} or @code{<article>} tags, set
-the @samp{HTML_CONTAINER} property for the headline.
-
-@node HTML preamble and postamble
-@subsection HTML preamble and postamble
-
-@vindex org-html-preamble
-@vindex org-html-postamble
-@vindex org-html-preamble-format
-@vindex org-html-postamble-format
-@vindex org-html-validation-link
-@vindex org-export-creator-string
-@vindex org-export-time-stamp-file
-
-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 does 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 does not
-insert a postamble if @code{org-html-postamble} is set to @code{nil}.
-
-@node Quoting HTML tags
-@subsection Quoting HTML tags
-
-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:
-
-@example
-@@@@html:<b>@@@@bold text@@@@html:</b>@@@@
-@end example
-
-
-@cindex @samp{HTML}, keyword
-@cindex @samp{BEGIN_EXPORT html}
-For larger raw HTML code blocks, use these HTML export code blocks:
-
-@example
-#+HTML: Literal HTML code for export
-
-#+BEGIN_EXPORT html
- All lines between these markers are exported literally
-#+END_EXPORT
-@end example
-
-@node Headlines in HTML export
-@subsection Headlines in HTML export
-
-@cindex headlines, in HTML export
-
-Headlines are exported to @samp{<h1>}, @samp{<h2>}, etc. Each headline gets the
-@samp{id} attribute from @samp{CUSTOM_ID} property, or a unique generated value,
-see @ref{Internal Links}.
-
-@vindex org-html-self-link-headlines
-When @code{org-html-self-link-headlines} is set to a non-@code{nil} value, the
-text of the headlines is also wrapped in @samp{<a>} tags. These tags have
-a @samp{href} attribute making the headlines link to themselves.
-
-@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
-
-The HTML export back-end transforms Org's internal links (see
-@ref{Internal Links}) to equivalent HTML links in the output. The back-end
-similarly handles Org's automatic links created by radio targets (see
-@ref{Radio Targets}) similarly. For Org links to external files, the
-back-end transforms the links to @emph{relative} paths.
-
-@vindex org-html-link-org-files-as-html
-For Org links to other @samp{.org} files, the back-end automatically
-changes the file extension to @samp{.html} and makes file paths relative.
-If the @samp{.org} files have an equivalent @samp{.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 ID-based links in
-the HTML output. For more about linking files when publishing to
-a directory, see @ref{Publishing links}.
-
-Org files can also have special directives to the HTML export
-back-end. For example, by using @samp{#+ATTR_HTML} lines to specify new
-format attributes to @code{<a>} or @code{<img>} tags. This example shows
-changing the link's title and style:
-
-@cindex @samp{ATTR_HTML}, keyword
-@example
-#+ATTR_HTML: :title The Org mode homepage :style color:red;
-[[https://orgmode.org]]
-@end example
-
-@node Tables in HTML export
-@subsection Tables in HTML export
-
-@cindex tables, in HTML
-@vindex org-export-html-table-tag
-
-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 @samp{CAPTION}, keyword
-@cindex @samp{ATTR_HTML}, keyword
-@example
-#+CAPTION: This is a table with lines around and between cells
-#+ATTR_HTML: :border 2 :rules all :frame border
-@end example
-
-The HTML export back-end preserves column groupings in Org tables (see
-@ref{Column Groups}) when exporting to HTML@.
-
-Additional options for customizing tables for HTML export.
-
-@table @asis
-@item @code{org-html-table-align-individual-fields}
-@vindex org-html-table-align-individual-fields
-Non-@code{nil} attaches style attributes for alignment to each table
-field.
-
-@item @code{org-html-table-caption-above}
-@vindex org-html-table-caption-above
-Non-@code{nil} places caption string at the beginning of the table.
-
-@item @code{org-html-table-data-tags}
-@vindex org-html-table-data-tags
-Opening and ending tags for table data fields.
-
-@item @code{org-html-table-default-attributes}
-@vindex org-html-table-default-attributes
-Default attributes and values for table tags.
-
-@item @code{org-html-table-header-tags}
-@vindex org-html-table-header-tags
-Opening and ending tags for table's header fields.
-
-@item @code{org-html-table-row-tags}
-@vindex org-html-table-row-tags
-Opening and ending tags for table rows.
-
-@item @code{org-html-table-use-header-tags-for-first-column}
-@vindex 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
-@subsection Images in HTML export
-
-@cindex images, inline in HTML
-@cindex inlining images in HTML
-
-The HTML export back-end has features to convert Org image links to
-HTML inline images and HTML clickable image links.
-
-@vindex org-html-inline-images
-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 @samp{file:} or @samp{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
-
-
-To change attributes of in-lined images, use @samp{#+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 @samp{CAPTION}, keyword
-@cindex @samp{ATTR_HTML}, keyword
-@example
-#+CAPTION: A black cat stalking a spider
-#+ATTR_HTML: :alt cat/spider image :title Action! :align right
-[[./img/a.jpg]]
-@end example
-
-The HTML export back-end copies the @samp{http} links from the Org file
-as-is.
-
-@node Math formatting in HTML export
-@subsection Math formatting in HTML export
-
-@cindex MathJax
-@cindex dvipng
-@cindex dvisvgm
-@cindex ImageMagick
-
-@vindex org-html-mathjax-options~
-@LaTeX{} math snippets (see @ref{@LaTeX{} fragments}) can be displayed in two
-different ways on HTML pages. The default is to use the @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}.}@footnote{Please note that exported formulas are part of an HTML
-document, and that signs such as @samp{<}, @samp{>}, or @samp{&} have special
-meanings. See @uref{http://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents, MathJax @TeX{} and @LaTeX{} support}.}. Some MathJax
-display options can be configured via @code{org-html-mathjax-options}, or
-in the buffer. For example, with the following settings,
-
-@example
-#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
-#+HTML_MATHJAX: cancel.js noErrors.js
-@end example
-
-@noindent
-equation labels are displayed on the left margin and equations are
-five em from the left margin. In addition, it loads the two MathJax
-extensions @samp{cancel.js} and @samp{noErrors.js}@footnote{See @uref{http://docs.mathjax.org/en/latest/tex.html#tex-extensions, @TeX{} and @LaTeX{} extensions} in the @uref{http://docs.mathjax.org, MathJax manual} to learn
-about extensions.}.
-
-@vindex org-html-mathjax-template
-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 dvipng program, dvisvgm or
-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
-
-
-@noindent
-or
-
-@example
-#+OPTIONS: tex:imagemagick
-@end example
-
-@node Text areas in HTML export
-@subsection Text areas in HTML export
-
-@cindex text areas, in HTML
-Before Org mode's Babel, one popular approach to publishing code in
-HTML was by using @samp{: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
-@samp{#+ATTR_HTML} line as shown in the example below with the @samp{:textarea}
-option. This must be followed by either an example or a source code
-block. Other Org block types do not honor the @samp{:textarea} option.
-
-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 @samp{:width} and @samp{:height} options on the @samp{#+ATTR_HTML}
-line.
-
-@example
-#+ATTR_HTML: :textarea t :width 40
-#+BEGIN_EXAMPLE
- (defun org-xor (a b)
- "Exclusive or."
- (if a (not b) b))
-#+END_EXAMPLE
-@end example
-
-@node CSS support
-@subsection CSS support
-
-@cindex CSS, for HTML export
-@cindex HTML export, CSS
-
-@vindex org-export-html-todo-kwd-class-prefix
-@vindex org-export-html-tag-class-prefix
-You can modify the CSS style definitions for the exported file. The
-HTML exporter assigns the following special CSS classes@footnote{If the classes on TODO keywords and tags lead to conflicts,
-use the variables @code{org-html-todo-kwd-class-prefix} and
-@code{org-html-tag-class-prefix} to make them unique.} to
-appropriate parts of the document---your style specifications may
-change these, in addition to any of the standard classes like for
-headlines, tables, etc.
-
-@multitable {aaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @code{p.author}
-@tab author information, including email
-@item @code{p.date}
-@tab publishing date
-@item @code{p.creator}
-@tab creator info, about org mode version
-@item @code{.title}
-@tab document title
-@item @code{.subtitle}
-@tab document subtitle
-@item @code{.todo}
-@tab TODO keywords, all not-done states
-@item @code{.done}
-@tab the DONE keywords, all states that count as done
-@item @code{.WAITING}
-@tab each TODO keyword also uses a class named after itself
-@item @code{.timestamp}
-@tab timestamp
-@item @code{.timestamp-kwd}
-@tab keyword associated with a timestamp, like @samp{SCHEDULED}
-@item @code{.timestamp-wrapper}
-@tab span around keyword plus timestamp
-@item @code{.tag}
-@tab tag in a headline
-@item @code{._HOME}
-@tab each tag uses itself as a class, ``@@'' replaced by ``_''
-@item @code{.target}
-@tab target for links
-@item @code{.linenr}
-@tab the line number in a code example
-@item @code{.code-highlighted}
-@tab for highlighting referenced code lines
-@item @code{div.outline-N}
-@tab div for outline level N (headline plus text)
-@item @code{div.outline-text-N}
-@tab extra div for text at outline level N
-@item @code{.section-number-N}
-@tab section number in headlines, different for each level
-@item @code{.figure-number}
-@tab label like ``Figure 1:''
-@item @code{.table-number}
-@tab label like ``Table 1:''
-@item @code{.listing-number}
-@tab label like ``Listing 1:''
-@item @code{div.figure}
-@tab how to format an in-lined image
-@item @code{pre.src}
-@tab formatted source code
-@item @code{pre.example}
-@tab normal example
-@item @code{p.verse}
-@tab verse paragraph
-@item @code{div.footnotes}
-@tab footnote section headline
-@item @code{p.footnote}
-@tab footnote definition paragraph, containing a footnote
-@item @code{.footref}
-@tab a footnote reference number (always a <sup>)
-@item @code{.footnum}
-@tab footnote number in footnote definition (always <sup>)
-@item @code{.org-svg}
-@tab default class for a linked @samp{.svg} image
-@end multitable
-
-@vindex org-html-style-default
-@vindex org-html-head
-@vindex org-html-head-extra
-@cindex @samp{HTML_INCLUDE_STYLE}, keyword
-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 @samp{HTML_HEAD}, keyword
-@cindex @samp{HTML_HEAD_EXTRA}, keyword
-@example
-#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="style1.css" />
-#+HTML_HEAD_EXTRA: <link rel="alternate stylesheet" type="text/css" href="style2.css" />
-@end example
-
-@vindex org-html-head-include-default-style
-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.
-
-@cindex @samp{html-style}, @samp{OPTIONS} item
-@example
-#+OPTIONS: html-style:nil
-@end example
-
-
-For longer style definitions, either use several @samp{HTML_HEAD} and
-@samp{HTML_HEAD_EXTRA} keywords, or use @code{<style> ... </style>} blocks
-around them. Both of these approaches can avoid referring to an
-external file.
-
-@cindex @samp{HTML_CONTAINER_CLASS}, property
-@cindex @samp{HTML_HEADLINE_CLASS}, property
-In order to add styles to a sub-tree, use the @samp{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 @samp{CUSTOM_ID} property. You can also assign a specific class to
-a headline with the @samp{HTML_HEADLINE_CLASS} property.
-
-Never change the @code{org-html-style-default} constant. Instead use other
-simpler ways of customizing as described above.
-
-@node JavaScript support
-@subsection JavaScript supported display of web pages
-
-Sebastian Rose has written a JavaScript program especially designed to
-allow two different ways of viewing HTML files created with Org. One
-is an @emph{Info}-like mode where each section is displayed separately and
-navigation can be done with the @kbd{n} and @kbd{p} keys, and some other
-keys as well, press @kbd{?} for an overview of the available keys. The
-second one has a @emph{folding} view, much like Org provides inside Emacs.
-The script is available at @uref{https://orgmode.org/org-info.js} and the
-documentation at @uref{https://orgmode.org/worg/code/org-info-js/}. The
-script is hosted on @uref{https://orgmode.org}, but for reliability, prefer
-installing it on your own web server.
-
-To use this program, just add this line to the Org file:
-
-@cindex @samp{INFOJS_OPT}, keyword
-@example
-#+INFOJS_OPT: view:info toc:nil
-@end example
-
-
-@noindent
-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:
-
-@table @asis
-@item @samp{path:}
-The path to the script. The default is to grab the script from
-@uref{https://orgmode.org/org-info.js}, but you might want to have a local
-copy and use a path like @samp{../scripts/org-info.js}.
-
-@item @samp{view:}
-Initial view when the website is first shown. Possible values are:
-
-@multitable {aaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{info}
-@tab Info-like interface with one section per page
-@item @samp{overview}
-@tab Folding interface, initially showing only top-level
-@item @samp{content}
-@tab Folding interface, starting with all headlines visible
-@item @samp{showall}
-@tab Folding interface, all headlines and text visible
-@end multitable
-
-@item @samp{sdepth:}
-Maximum headline level still considered as an independent section
-for info and folding modes. The default is taken from
-@code{org-export-headline-levels}, i.e., the @samp{H} switch in @samp{OPTIONS}. If
-this is smaller than in @code{org-export-headline-levels}, each
-info/folding section can still contain child headlines.
-
-@item @samp{toc:}
-Should the table of contents @emph{initially} be visible? Even when
-@samp{nil}, you can always get to the ``toc'' with @kbd{i}.
-
-@item @samp{tdepth:}
-The depth of the table of contents. The defaults are taken from the
-variables @code{org-export-headline-levels} and @code{org-export-with-toc}.
-
-@item @samp{ftoc:}
-Does the CSS of the page specify a fixed position for the ``toc''? If
-yes, the toc is displayed as a section.
-
-@item @samp{ltoc:}
-Should there be short contents (children) in each section? Make
-this @samp{above} if the section should be above initial text.
-
-@item @samp{mouse:}
-Headings are highlighted when the mouse is over them. Should be
-@samp{underline} (default) or a background color like @samp{#cccccc}.
-
-@item @samp{buttons:}
-Should view-toggle buttons be everywhere? When @samp{nil} (the default),
-only one such button is present.
-@end table
-
-@vindex org-infojs-options
-@vindex org-export-html-use-infojs
-You can choose default values for these options by customizing the
-variable @code{org-infojs-options}. If you always want to apply the script
-to your pages, configure the variable @code{org-export-html-use-infojs}.
-
-@node @LaTeX{} Export
-@section @LaTeX{} Export
-
-@cindex @LaTeX{} export
-@cindex PDF export
-
-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{}/PDF export commands:: For producing @LaTeX{} and PDF documents.
-* @LaTeX{} specific export settings:: Unique to this @LaTeX{} back-end.
-* @LaTeX{} header and sectioning:: Setting up the export file structure.
-* Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code.
-* Tables in @LaTeX{} export:: Options for exporting tables to @LaTeX{}.
-* Images in @LaTeX{} export:: How to insert figures into @LaTeX{} output.
-* 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{}/PDF export commands
-@subsection @LaTeX{}/PDF export commands
-
-@table @asis
-@item @kbd{C-c C-e l l} (@code{org-latex-export-to-latex})
-@kindex C-c C-e l l
-@findex org-latex-export-to-latex~
-Export to a @LaTeX{} file with a @samp{.tex} extension. For @samp{myfile.org},
-Org exports to @samp{myfile.tex}, overwriting without warning.
-
-@item @kbd{C-c C-e l L} (@code{org-latex-export-as-latex})
-@kindex C-c C-e l L
-@findex org-latex-export-as-latex
-Export to a temporary buffer. Do not create a file.
-
-@item @kbd{C-c C-e l p} (@code{org-latex-export-to-pdf})
-@kindex C-c C-e l p
-@findex org-latex-export-to-pdf
-Export as @LaTeX{} file and convert it to PDF file.
-
-@item @kbd{C-c C-e l o}
-@kindex C-c C-e l o
-Export as @LaTeX{} file and convert it to PDF, then open the PDF using
-the default viewer.
-
-@item @kbd{M-x org-export-region-as-latex}
-Convert the region to @LaTeX{} under the assumption that it was in Org
-mode syntax before. This is a global command that can be invoked in
-any buffer.
-@end table
-
-@vindex org-latex-compiler
-@vindex org-latex-bibtex-compiler
-@vindex org-latex-default-packages-alist
-@cindex pdflatex
-@cindex xelatex
-@cindex lualatex
-@cindex @samp{LATEX_COMPILER}, keyword
-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 @samp{#+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 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 (see @ref{Export Settings}).
-
-@table @asis
-@item @samp{DESCRIPTION}
-@cindex @samp{DESCRIPTION}, keyword
-@vindex org-latex-hyperref-template
-@vindex org-latex-title-command
-The document's description. The description along with author name,
-keywords, and related file metadata are inserted in the output file
-by the 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 @samp{DESCRIPTION} keywords for long descriptions.
-
-@item @samp{LANGUAGE}
-@cindex @samp{LANGUAGE}, keyword
-@vindex org-latex-packages-alist
-In order to be effective, the @samp{babel} or @samp{polyglossia}
-packages---according to the @LaTeX{} compiler used---must be loaded
-with the appropriate language as argument. This can be accomplished
-by modifying the @code{org-latex-packages-alist} variable, e.g., with the
-following snippet:
-
-@lisp
-(add-to-list 'org-latex-packages-alist
- '("AUTO" "babel" t ("pdflatex")))
-(add-to-list 'org-latex-packages-alist
- '("AUTO" "polyglossia" t ("xelatex" "lualatex")))
-@end lisp
-
-@item @samp{LATEX_CLASS}
-@cindex @samp{LATEX_CLASS}, keyword
-@vindex org-latex-default-class
-@vindex org-latex-classes
-This is @LaTeX{} document class, such as @emph{article}, @emph{report}, @emph{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 @emph{article} as the default class. A valid default class must
-be an element of @code{org-latex-classes}.
-
-@item @samp{LATEX_CLASS_OPTIONS}
-@cindex @samp{LATEX_CLASS_OPTIONS}, keyword
-Options the @LaTeX{} export back-end uses when calling the @LaTeX{}
-document class.
-
-@item @samp{LATEX_COMPILER}
-@cindex @samp{LATEX_COMPILER}, keyword
-@vindex org-latex-compiler
-The compiler, such as @samp{pdflatex}, @samp{xelatex}, @samp{lualatex}, for
-producing the PDF@. See @code{org-latex-compiler}.
-
-@item @samp{LATEX_HEADER}
-@itemx @samp{LATEX_HEADER_EXTRA}
-@cindex @samp{LATEX_HEADER}, keyword
-@cindex @samp{LATEX_HEADER_EXTRA}, keyword
-@vindex org-latex-classes
-Arbitrary lines to add to the document's preamble, before the
-hyperref settings. See @code{org-latex-classes} for adjusting the
-structure and order of the @LaTeX{} headers.
-
-@item @samp{KEYWORDS}
-@cindex @samp{KEYWORDS}, keyword
-@vindex org-latex-hyperref-template
-@vindex org-latex-title-command
-The keywords for the document. The description along with author
-name, keywords, and related file metadata are inserted in the output
-file by the 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 @samp{KEYWORDS} lines if necessary.
-
-@item @samp{SUBTITLE}
-@cindex @samp{SUBTITLE}, keyword
-@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 outside of the @code{\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
-
-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
-
-The @LaTeX{} export back-end converts the first three of Org's outline
-levels into @LaTeX{} headlines. The remaining Org levels are exported as
-lists. To change this globally for the cut-off point between levels
-and lists, (see @ref{Export Settings}).
-
-By default, the @LaTeX{} export back-end uses the @emph{article} class.
-
-@vindex org-latex-default-class
-@vindex org-latex-classes
-@vindex org-latex-default-packages-alist
-@vindex org-latex-packages-alist
-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
-@samp{#+LATEX_CLASS: myclass}. To change the default class for just a part
-of the Org file, set a sub-tree property, @samp{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 @samp{LATEX_CLASS}, keyword
-@cindex @samp{LATEX_CLASS_OPTIONS}, keyword
-@cindex @samp{EXPORT_LATEX_CLASS}, property
-@cindex @samp{EXPORT_LATEX_CLASS_OPTIONS}, property
-The @LaTeX{} export back-end sends the @samp{LATEX_CLASS_OPTIONS} keyword and
-@samp{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 @samp{LATEX_HEADER}, keyword
-@cindex @samp{LATEX_HEADER_EXTRA}, keyword
-The @LaTeX{} export back-end appends values from @samp{LATEX_HEADER} and
-@samp{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 @samp{LATEX_HEADER_EXTRA} to the header
-when previewing @LaTeX{} snippets (see @ref{Previewing @LaTeX{} fragments}).
-
-A sample Org file with the above headers:
-
-@example
-#+LATEX_CLASS: article
-#+LATEX_CLASS_OPTIONS: [a4paper]
-#+LATEX_HEADER: \usepackage@{xyz@}
-
-* Headline 1
- some text
-* Headline 2
- some more text
-@end example
-
-@node Quoting @LaTeX{} code
-@subsection Quoting @LaTeX{} code
-
-The @LaTeX{} export back-end can insert any arbitrary @LaTeX{} code, see
-@ref{Embedded @LaTeX{}}. There are three ways to embed such code in the Org
-file and they all use different quoting syntax.
-
-@cindex inline, in @LaTeX{} export
-Inserting in-line quoted with @@ symbols:
-
-@example
-Code embedded in-line @@@@latex:any arbitrary LaTeX code@@@@ in a paragraph.
-@end example
-
-
-@cindex @samp{LATEX}, keyword
-Inserting as one or more keyword lines in the Org file:
-
-@example
-#+LATEX: any arbitrary LaTeX code
-@end example
-
-
-@cindex @samp{BEGIN_EXPORT latex}
-Inserting as an export block in the Org file, where the back-end
-exports any code between begin and end markers:
-
-@example
-#+BEGIN_EXPORT latex
- any arbitrary LaTeX code
-#+END_EXPORT
-@end example
-
-@node Tables in @LaTeX{} export
-@subsection Tables in @LaTeX{} export
-
-@cindex tables, in @LaTeX{} export
-
-The @LaTeX{} export back-end can pass several @LaTeX{} attributes for table
-contents and layout. Besides specifying a label (see @ref{Internal Links})
-and a caption (see @ref{Captions}), the other valid @LaTeX{} attributes
-include:
-
-@table @asis
-@item @samp{:mode}
-@vindex 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
-@samp{table}, @samp{math}, @samp{inline-math} or @samp{verbatim}.
-
-For @samp{math} or @samp{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}. The @LaTeX{} export back-end merges
-contiguous tables in the same mode into a single environment.
-
-@item @samp{:environment}
-@vindex org-latex-default-table-environment
-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: tabularx, longtable,
-array, tabu, and bmatrix. For packages, such as tabularx and 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 @samp{:caption}
-Use @samp{CAPTION} keyword to set a simple caption for a table (see
-@ref{Captions}). For custom captions, use @samp{:caption} attribute, which
-accepts raw @LaTeX{} code. @samp{:caption} value overrides @samp{CAPTION} value.
-
-@item @samp{:float}
-@itemx @samp{:placement}
-The table environments by default are not floats in @LaTeX{}. To make
-them floating objects use @samp{:float} with one of the following
-options: @samp{sideways}, @samp{multicolumn}, @samp{t}, and @samp{nil}.
-
-@LaTeX{} floats can also have additional layout @samp{:placement}
-attributes. These are the usual @samp{[h t b p ! H]} permissions
-specified in square brackets. Note that for @samp{:float sideways}
-tables, the @LaTeX{} export back-end ignores @samp{:placement} attributes.
-
-@item @samp{:align}
-@itemx @samp{:font}
-@itemx @samp{:width}
-The @LaTeX{} export back-end uses these attributes for regular tables
-to set their alignments, fonts, and widths.
-
-@item @samp{:spread}
-When @samp{:spread} is non-@code{nil}, the @LaTeX{} export back-end spreads or
-shrinks the table by the @samp{:width} for tabu and longtabu
-environments. @samp{:spread} has no effect if @samp{:width} is not set.
-
-@item @samp{:booktabs}
-@itemx @samp{:center}
-@itemx @samp{:rmlines}
-@vindex org-latex-tables-booktabs
-@vindex org-latex-tables-centered
-All three commands are toggles. @samp{:booktabs} brings in modern
-typesetting enhancements to regular tables. The booktabs package
-has to be loaded through @code{org-latex-packages-alist}. @samp{:center} is
-for centering the table. @samp{:rmlines} removes all but the very first
-horizontal line made of ASCII characters from ``table.el'' tables
-only.
-
-@item @samp{:math-prefix}
-@itemx @samp{:math-suffix}
-@itemx @samp{:math-arguments}
-The @LaTeX{} export back-end inserts @samp{:math-prefix} string value in
-a math environment before the table. The @LaTeX{} export back-end
-inserts @samp{:math-suffix} string value in a math environment after the
-table. The @LaTeX{} export back-end inserts @samp{:math-arguments} string
-value between the macro name and the table's contents.
-@samp{:math-arguments} comes in use for matrix macros that require more
-than one argument, such as @samp{qbordermatrix}.
-@end table
-
-@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
-| ... | ... |
-| ... | ... |
-
-#+ATTR_LATEX: :mode math :environment bmatrix :math-suffix \times
-| a | b |
-| c | d |
-#+ATTR_LATEX: :mode math :environment bmatrix
-| 1 | 2 |
-| 3 | 4 |
-@end example
-
-Set the caption with the @LaTeX{} command
-@samp{\bicaption@{HeadingA@}@{HeadingB@}}:
-
-@example
-#+ATTR_LATEX: :caption \bicaption@{HeadingA@}@{HeadingB@}
-| ... | ... |
-| ... | ... |
-@end example
-
-@node Images in @LaTeX{} export
-@subsection Images in @LaTeX{} export
-
-@cindex images, inline in LaTeX
-@cindex inlining images in LaTeX
-@cindex @samp{ATTR_LATEX}, keyword
-
-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 @samp{\includegraphics} macro to
-insert the image. But for TikZ (@uref{http://sourceforge.net/projects/pgf/})
-images, the back-end uses an @code{\input} macro wrapped within
-a @code{tikzpicture} environment.
-
-For specifying image @samp{:width}, @samp{:height}, @samp{:scale} and other @samp{:options},
-use this syntax:
-
-@example
-#+ATTR_LATEX: :width 5cm :options angle=90
-[[./img/sed-hr4049.pdf]]
-@end example
-
-A @samp{:scale} attribute overrides both @samp{:width} and @samp{:height} attributes.
-
-For custom commands for captions, use the @samp{:caption} attribute. It
-overrides the default @samp{#+CAPTION} value:
-
-@example
-#+ATTR_LATEX: :caption \bicaption@{HeadingA@}@{HeadingB@}
-[[./img/sed-hr4049.pdf]]
-@end example
-
-When captions follow the method as described in @ref{Captions}, the @LaTeX{}
-export back-end wraps the picture in a floating @samp{figure} environment.
-To float an image without specifying a caption, set the @samp{:float}
-attribute to one of the following:
-
-@table @asis
-@item @samp{t}
-For a standard @samp{figure} environment; used by default whenever an
-image has a caption.
-
-@item @samp{multicolumn}
-To span the image across multiple columns of a page; the back-end
-wraps the image in a @samp{figure*} environment.
-
-@item @samp{wrap}
-For text to flow around the image on the right; the figure occupies
-the left half of the page.
-
-@item @samp{sideways}
-For a new page with the image sideways, rotated ninety degrees, in
-a @samp{sidewaysfigure} environment; overrides @samp{:placement} setting.
-
-@item @samp{nil}
-To avoid a @samp{:float} even if using a caption.
-@end table
-
-Use the @samp{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]]
-@end example
-
-@vindex org-latex-images-centered
-@cindex center image in LaTeX export
-@cindex image, centering in LaTeX export
-The @LaTeX{} export back-end centers all images by default. Setting
-@samp{:center} to @samp{nil} disables centering. To disable centering globally,
-set @code{org-latex-images-centered} to @samp{t}.
-
-Set the @samp{:comment-include} attribute to non-@code{nil} value for the @LaTeX{}
-export back-end to comment out the @samp{\includegraphics} macro.
-
-@node Plain lists in @LaTeX{} export
-@subsection Plain lists in @LaTeX{} export
-
-@cindex plain lists, in @LaTeX{} export
-@cindex @samp{ATTR_LATEX}, keyword
-The @LaTeX{} export back-end accepts the @samp{environment} and @samp{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
-
-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
-#+LATEX_HEADER: \usepackage@{enumitem@}
-#+LATEX_HEADER: \renewlist@{itemize@}@{itemize@}@{9@}
-#+LATEX_HEADER: \setlist[itemize]@{label=$\circ$@}
-- One
- - Two
- - Three
- - Four
- - Five
-@end example
-
-@node Source blocks in @LaTeX{} export
-@subsection Source blocks in @LaTeX{} export
-
-@cindex source blocks, in @LaTeX{} export
-@cindex @samp{ATTR_LATEX}, keyword
-
-The @LaTeX{} export back-end can make source code blocks into floating
-objects through the attributes @samp{:float} and @samp{:options}. For @samp{:float}:
-
-@table @asis
-@item @samp{t}
-Makes a source block float; by default floats any source block with
-a caption.
-
-@item @samp{multicolumn}
-Spans the source block across multiple columns of a page.
-
-@item @samp{nil}
-Avoids a @samp{:float} even if using a caption; useful for source code
-blocks that may not fit on a page.
-@end table
-
-@example
-#+ATTR_LATEX: :float nil
-#+BEGIN_SRC emacs-lisp
- 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 @samp{:options} to @LaTeX{}
-packages for customization of that specific source block. In the
-example below, the @samp{: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
-
-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 @samp{ATTR_LATEX}, keyword
-
-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 (see
-@ref{Advanced Export Configuration}). To change this behavior to use
-another environment for each block, use the @samp{: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 @samp{ATTR_LATEX}, keyword
-
-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
-@samp{:options}, if any, and appends as-is to that environment's opening
-string. For example:
-
-@example
-#+BEGIN_abstract
- We demonstrate how to solve the Syracuse problem.
-#+END_abstract
-
-#+ATTR_LATEX: :options [Proof of important theorem]
-#+BEGIN_proof
- ...
- Therefore, any even number greater than 2 is the sum of two primes.
-#+END_proof
-@end example
-
-@noindent
-exports to
-
-@example
-\begin@{abstract@}
- We demonstrate how to solve the Syracuse problem.
-\end@{abstract@}
-
-\begin@{proof@}[Proof of important theorem]
- ...
- Therefore, any even number greater than 2 is the sum of two primes.
-\end@{proof@}
-@end example
-
-If you need to insert a specific caption command, use @samp{:caption}
-attribute. It overrides standard @samp{CAPTION} value, if any. For
-example:
-
-@example
-#+ATTR_LATEX: :caption \MyCaption@{HeadingA@}
-#+BEGIN_proof
- ...
-#+END_proof
-@end example
-
-@node Horizontal rules in @LaTeX{} export
-@subsection Horizontal rules in @LaTeX{} export
-
-@cindex horizontal rules, in @LaTeX{} export
-@cindex @samp{ATTR_LATEX}, keyword
-
-The @LaTeX{} export back-end converts horizontal rules by the specified
-@samp{:width} and @samp{:thickness} attributes. For example:
-
-@example
-#+ATTR_LATEX: :width .6\textwidth :thickness 0.8pt
------
-@end example
-
-@node Markdown Export
-@section Markdown Export
-
-@cindex Markdown export
-
-The Markdown export back-end, ``md'', converts an Org file to Markdown
-format, as defined at @uref{http://daringfireball.net/projects/markdown/}.
-
-Since it is built on top of the HTML back-end (see @ref{HTML Export}), it
-converts every Org construct not defined in Markdown syntax, such as
-tables, to HTML@.
-
-@anchor{Markdown export commands}
-@subheading Markdown export commands
-
-@table @asis
-@item @kbd{C-c C-e m m} (@code{org-md-export-to-markdown})
-@kindex C-c C-c m m
-@findex org-md-export-to-markdown
-Export to a text file with Markdown syntax. For @samp{myfile.org}, Org
-exports to @samp{myfile.md}, overwritten without warning.
-
-@item @kbd{C-c C-e m M} (@code{org-md-export-as-markdown})
-@kindex C-c C-c m M
-@findex org-md-export-as-markdown
-Export to a temporary buffer. Does not create a file.
-
-@item @kbd{C-c C-e m o}
-@kindex C-c C-e m o
-Export as a text file with Markdown syntax, then open it.
-@end table
-
-@anchor{Header and sectioning structure (1)}
-@subheading Header and sectioning structure
-
-@vindex org-md-headline-style
-Based on @code{org-md-headline-style}, Markdown export can generate
-headlines of both @emph{atx} and @emph{setext} types. @emph{atx} limits headline
-levels to two whereas @emph{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 (see @ref{Export Settings}).
-
-@node OpenDocument Text Export
-@section OpenDocument Text Export
-
-@cindex ODT
-@cindex OpenDocument
-@cindex export, OpenDocument
-@cindex LibreOffice
-
-The ODT export back-end handles creating of OpenDocument Text (ODT)
-format. Documents created by this exporter use the
-@cite{OpenDocument-v1.2 specification}@footnote{See @uref{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.
-
-@menu
-* Pre-requisites for ODT export:: Required packages.
-* ODT export commands:: Invoking export.
-* ODT specific export settings:: Configuration options.
-* Extending ODT export:: Producing DOC, PDF files.
-* Applying custom styles:: Styling the output.
-* Links in ODT export:: Handling and formatting links.
-* Tables in ODT export:: Org tables 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
-@subsection Pre-requisites for ODT export
-
-@cindex zip
-
-The ODT export back-end relies on the zip program to create the final
-compressed ODT output. Check if @samp{zip} is locally available and
-executable. Without it, export cannot finish.
-
-@node ODT export commands
-@subsection ODT export commands
-
-@table @asis
-@item @kbd{C-c C-e o o} (@code{org-export-to-odt})
-@kindex C-c C-e o o
-@findex org-export-to-odt
-Export as OpenDocument Text file.
-
-@cindex @samp{EXPORT_FILE_NAME}, property
-@vindex org-odt-preferred-output-format
-
-If @code{org-odt-preferred-output-format} is specified, the ODT export
-back-end automatically converts the exported file to that format.
-
-For @samp{myfile.org}, Org exports to @samp{myfile.odt}, overwriting without
-warning. The ODT export back-end exports a region only if a region
-was active.
-
-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 @samp{EXPORT_FILE_NAME} property, the ODT export back-end
-uses that for file name.
-
-@item @kbd{C-c C-e o O}
-@kindex C-c C-e o O
-Export as an OpenDocument Text file and open the resulting file.
-
-@vindex org-export-odt-preferred-output-format
-If @code{org-export-odt-preferred-output-format} is specified, open the
-converted file instead. See @ref{Automatically exporting to other formats}.
-@end table
-
-@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 (see @ref{Export Settings}).
-
-@table @asis
-@item @samp{DESCRIPTION}
-@cindex @samp{DESCRIPTION}, keyword
-This is the document's description, which the ODT export back-end
-inserts as document metadata. For long descriptions, use multiple
-lines, prefixed with @samp{DESCRIPTION}.
-
-@item @samp{KEYWORDS}
-@cindex @samp{KEYWORDS}, keyword
-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 @samp{KEYWORDS} if
-necessary.
-
-@item @samp{ODT_STYLES_FILE}
-@cindex @samp{ODT_STYLES_FILE}, keyword
-@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 @samp{SUBTITLE}
-@cindex @samp{SUBTITLE}, keyword
-The document subtitle.
-@end table
-
-@node Extending ODT export
-@subsection Extending ODT export
-
-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}
-@vindex org-odt-convert-process
-Customize @code{org-odt-convert-process} variable to point to @samp{unoconv},
-which is the ODT's preferred converter. Working installations of
-LibreOffice would already have @samp{unoconv} installed. Alternatively,
-other converters may be substituted here. See @ref{Configuring a document converter}.
-
-@anchor{Automatically exporting to other formats}
-@subsubheading Automatically exporting to other formats
-
-@vindex org-odt-preferred-output-format
-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 (see @ref{ODT export commands}).
-
-@anchor{Converting between document formats}
-@subsubheading Converting between document formats
-
-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:
-
-@table @asis
-@item @kbd{M-x org-odt-convert}
-@findex org-odt-convert
-Convert an existing document from one format to another. With
-a prefix argument, opens the newly produced file.
-@end table
-
-@node Applying custom styles
-@subsection Applying custom styles
-
-@cindex styles, custom
-@cindex template, custom
-
-The ODT export back-end comes with many OpenDocument styles (see
-@ref{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.
-
-@anchor{Applying custom styles the easy way}
-@subsubheading Applying custom styles: the easy way
-
-@enumerate
-@item
-Create a sample @samp{example.org} file with settings as shown below,
-and export it to ODT format.
-
-@example
-#+OPTIONS: H:10 num:t
-@end example
-
-@item
-Open the above @samp{example.odt} using LibreOffice. Use the @emph{Stylist}
-to locate the target styles, which typically have the ``Org'' prefix.
-Open one, modify, and save as either OpenDocument Text (ODT) or
-OpenDocument Template (OTT) file.
-
-@item
-@vindex org-odt-styles-file
-Customize the variable @code{org-odt-styles-file} and point it to the
-newly created file. For additional configuration options, see
-@ref{x-overriding-factory-styles, , Overriding factory styles}.
-
-@cindex @samp{ODT_STYLES_FILE}, keyword
-To apply an ODT style to a particular file, use the
-@samp{ODT_STYLES_FILE} keyword as shown in the example below:
-
-@example
-#+ODT_STYLES_FILE: "/path/to/example.ott"
-@end example
-
-
-@noindent
-or
-
-@example
-#+ODT_STYLES_FILE: ("/path/to/file.ott" ("styles.xml" "image/hdr.png"))
-@end example
-@end enumerate
-
-@anchor{Using third-party styles and templates}
-@subsubheading Using third-party styles and templates
-
-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
-@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.
-
-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. See
-@ref{Labels and captions in ODT export}.
-
-@node Tables in ODT export
-@subsection Tables in ODT export
-
-@cindex tables, in ODT export
-
-The ODT export back-end handles native Org mode tables (see @ref{Tables})
-and simple @samp{table.el} tables. Complex @samp{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
-(see @ref{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 (see @ref{Column Width and Alignment}).
-
-Note that the ODT export back-end interprets column widths as weighted
-ratios, the default weight being 1.
-
-@cindex @samp{ATTR_ODT}, keyword
-Specifying @samp{:rel-width} property on an @samp{ATTR_ODT} line controls the
-width of the table. For example:
-
-@example
-#+ATTR_ODT: :rel-width 50
-| Area/Month | Jan | Feb | Mar | Sum |
-|---------------+-------+-------+-------+-------|
-| / | < | | | < |
-| <l13> | <r5> | <r5> | <r5> | <r6> |
-| North America | 1 | 21 | 926 | 948 |
-| Middle East | 6 | 75 | 844 | 925 |
-| Asia Pacific | 9 | 27 | 790 | 826 |
-|---------------+-------+-------+-------+-------|
-| Sum | 16 | 123 | 2560 | 2699 |
-@end example
-
-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.
-
-For even more customization, create custom table styles and associate
-them with a table using the @samp{ATTR_ODT} keyword. See @ref{Customizing tables in ODT export}.
-
-@node Images in ODT export
-@subsection Images in ODT export
-
-@cindex images, embedding in ODT
-@cindex embedding images in ODT
-
-@anchor{Embedding images}
-@subsubheading Embedding images
-
-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]]
-@end example
-
-
-@example
-[[./img.png]]
-@end example
-
-@anchor{Embedding clickable images}
-@subsubheading Embedding clickable images
-
-For clickable images, provide a link whose description is another link
-to an image file. For example, to embed an image
-@samp{org-mode-unicorn.png} which when clicked jumps to @uref{https://orgmode.org}
-website, do the following
-
-@example
-[[https://orgmode.org][./org-mode-unicorn.png]]
-@end example
-
-@anchor{Sizing and scaling of embedded images}
-@subsubheading Sizing and scaling of embedded images
-
-@cindex @samp{ATTR_ODT}, keyword
-
-Control the size and scale of the embedded images with the @samp{ATTR_ODT}
-attribute.
-
-@cindex identify, ImageMagick
-@vindex org-odt-pixels-per-inch
-The ODT export back-end starts with establishing the size of the image
-in the final document. The dimensions of this size are 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 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
-To embed @samp{img.png} as a 10 cm x 10 cm image, do the following:
-
-@example
-#+ATTR_ODT: :width 10 :height 10
-[[./img.png]]
-@end example
-
-@item Scale the image
-To embed @samp{img.png} at half its size, do the following:
-
-@example
-#+ATTR_ODT: :scale 0.5
-[[./img.png]]
-@end example
-
-@item Scale the image to a specific width
-To embed @samp{img.png} with a width of 10 cm while retaining the
-original height:width ratio, do the following:
-
-@example
-#+ATTR_ODT: :width 10
-[[./img.png]]
-@end example
-
-@item Scale the image to a specific height
-To embed @samp{img.png} with a height of 10 cm while retaining the
-original height:width ratio, do the following:
-
-@example
-#+ATTR_ODT: :height 10
-[[./img.png]]
-@end example
-@end table
-
-@anchor{Anchoring of images}
-@subsubheading Anchoring of images
-
-@cindex @samp{ATTR_ODT}, keyword
-The ODT export back-end can anchor images to @samp{as-char}, @samp{paragraph},
-or @samp{page}. Set the preferred anchor using the @samp{:anchor} property of
-the @samp{ATTR_ODT} line.
-
-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
-@subsection Math formatting in ODT export
-
-The ODT exporter has special support for handling math.
-
-@menu
-* @LaTeX{} math snippets:: Embedding in @LaTeX{} format.
-* MathML and OpenDocument formula files:: Embedding in native format.
-@end menu
-
-@node @LaTeX{} math snippets
-@subsubsection @LaTeX{} math snippets
-
-@LaTeX{} math snippets (see @ref{@LaTeX{} fragments}) can be embedded in the ODT
-document in one of the following ways:
-
-@table @asis
-@item MathML
-@cindex MathML
-Add this line to the Org file. This option is activated on
-a per-file basis.
-
-@example
-#+OPTIONS: tex:t
-@end example
-
-
-With this option, @LaTeX{} fragments are first converted into MathML
-fragments using an external @LaTeX{}-to-MathML converter program. The
-resulting MathML fragments are then embedded as an OpenDocument
-Formula in 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 @code{org-latex-to-mathml-convert-command} and
-@code{org-latex-to-mathml-jar-file}.
-
-If you prefer to use 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.
-
-@lisp
-(setq org-latex-to-mathml-convert-command
- "java -jar %j -unicode -force -df %o %I"
- org-latex-to-mathml-jar-file
- "/path/to/mathtoweb.jar")
-@end lisp
-
-@noindent
-or, to use @LaTeX{}​ML@footnote{See @uref{http://dlmf.nist.gov/LaTeXML/}.} instead,
-
-@lisp
-(setq org-latex-to-mathml-convert-command
- "latexmlmath \"%i\" --presentationmathml=%o")
-@end lisp
-
-To quickly verify the reliability of the @LaTeX{}-to-MathML
-converter, use the following commands:
-
-@table @asis
-@item @kbd{M-x org-export-as-odf}
-Convert a @LaTeX{} math snippet to an OpenDocument formula (@samp{.odf})
-file.
-
-@item @kbd{M-x org-export-as-odf-and-open}
-Convert a @LaTeX{} math snippet to an OpenDocument formula (@samp{.odf})
-file and open the formula file with the system-registered
-application.
-@end table
-
-@item PNG images
-@cindex dvipng
-@cindex dvisvgm
-@cindex ImageMagick
-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
-
-
-@noindent
-or
-
-@example
-#+OPTIONS: tex:imagemagick
-@end example
-
-
-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 dvipng program, dvisvgm or
-ImageMagick programs.
-@end table
-
-@node MathML and OpenDocument formula files
-@subsubsection MathML and OpenDocument formula files
-
-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 (@samp{.mml}) source or its OpenDocument formula (@samp{.odf}) file as
-shown below:
-
-@example
-[[./equation.mml]]
-@end example
-
-
-@noindent
-or
-
-@example
-[[./equation.odf]]
-@end example
-
-@node Labels and captions in ODT export
-@subsection Labels and captions in ODT export
-
-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
-#+NAME: fig:SED-HR4049
-[[./img/a.png]]
-@end example
-
-When rendered, it may show as follows in the exported document:
-
-@example
-Figure 2: Bell curve
-@end example
-
-
-@vindex org-odt-category-map-alist
-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 ``Illustration'' instead of the default string ``Figure'',
-use the following setting:
-
-@lisp
-(setq org-odt-category-map-alist
- '(("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)))
-@end lisp
-
-With the above modification, the previous example changes to:
-
-@example
-Illustration 2: Bell curve
-@end example
-
-@node Literal examples in ODT export
-@subsection Literal examples in ODT export
-
-The ODT export back-end supports literal examples (see @ref{Literal Examples}) with full fontification. Internally, the ODT export
-back-end relies on @samp{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 Font Lock
-library for that source language.
-
-@vindex org-odt-fontify-srcblocks
-For custom fontification styles, customize the
-@code{org-odt-create-custom-styles-for-srcblocks} option.
-
-@vindex org-odt-create-custom-styles-for-srcblocks
-To turn off fontification of literal examples, customize the
-@code{org-odt-fontify-srcblocks} option.
-
-@node Advanced topics in ODT export
-@subsection Advanced topics in ODT export
-
-The ODT export back-end has extensive features useful for power users
-and frequent uses of ODT formats.
-
-@anchor{Configuring a document converter}
-@subsubheading Configuring a document converter
-
-@cindex convert
-@cindex doc, docx, rtf
-@cindex converter
-
-The ODT export back-end works with popular converters with little or
-no extra configuration. See @ref{Extending ODT export}. The following is
-for unsupported converters or tweaking existing defaults.
-
-@table @asis
-@item Register the converter
-@vindex org-export-odt-convert-processes
-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-export-odt-convert-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
-@vindex org-export-odt-convert-process
-Select the newly added converter as the preferred one by customizing
-the option @code{org-odt-convert-process}.
-@end table
-
-@anchor{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; the means by which
-it produces styled documents; the use of automatic and custom OpenDocument
-styles.
-
-The ODT exporter relies on two files for generating its output. These
-files are bundled with the distribution under the directory pointed to
-by the variable @code{org-odt-styles-dir}. The two files are:
-
-@table @asis
-@item @samp{OrgOdtStyles.xml} @anchor{x-orgodtstyles-xml}
-This file contributes to the @samp{styles.xml} file of the final ODT
-document. This file gets modified for the following purposes:
-
-@enumerate
-@item
-To control outline numbering based on user settings;
-
-@item
-To add styles generated by @samp{htmlfontify.el} for fontification of
-code blocks.
-@end enumerate
-
-@item @samp{OrgOdtContentTemplate.xml} @anchor{x-orgodtcontenttemplate-xml}
-This file contributes to the @samp{content.xml} file of the final ODT
-document. The contents of the Org outline are inserted between the
-@samp{<office:text>} @dots{} @samp{</office:text>} elements of this file.
-
-Apart from serving as a template file for the final @samp{content.xml},
-the file serves the following purposes:
-
-@enumerate
-@item
-It contains automatic styles for formatting of tables which are
-referenced by the exporter;
-
-@item
-It contains @samp{<text:sequence-decl>} @dots{} @samp{</text:sequence-decl>}
-elements that control numbering of tables, images, equations, and
-similar entities.
-@end enumerate
-@end table
-
-@anchor{x-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.
-
-@table @asis
-@item @code{org-odt-styles-file}
-The ODT export back-end uses the file pointed to by this variable,
-such as @samp{styles.xml}, for the final output. It can take one of the
-following values:
-
-@table @asis
-@item @samp{FILE.xml}
-Use this file instead of the default @samp{styles.xml}
-
-@item @samp{FILE.odt} or @samp{FILE.ott}
-Use the @samp{styles.xml} contained in the specified OpenDocument
-Text or Template file
-
-@item @samp{FILE.odt} or @samp{FILE.ott} and a subset of included files
-Use the @samp{styles.xml} contained in the specified OpenDocument Text
-or Template file. Additionally extract the specified member files
-and embed those within the final ODT document.
-
-Use this option if the @samp{styles.xml} file references additional
-files like header and footer images.
-
-@item @code{nil}
-Use the default @samp{styles.xml}.
-@end table
-
-@item @code{org-odt-content-template-file}
-Use this variable to specify the blank @samp{content.xml} used in the
-final output.
-@end table
-
-@anchor{Creating one-off styles}
-@subsubheading Creating one-off styles
-
-The ODT export back-end can read embedded raw OpenDocument XML from
-the Org file. Such direct formatting is useful for one-off instances.
-
-@table @asis
-@item Embedding ODT tags as part of regular text
-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 highlighted
-text</text:span>@@@@. But this is regular text.
-@end example
-
-@strong{Hint:} To see the above example in action, edit the @samp{styles.xml}
-(see @ref{x-orgodtstyles-xml, , Factory styles}) and add a custom @emph{Highlight} style as shown
-below:
-
-@example
-<style:style style:name="Highlight" style:family="text">
- <style:text-properties fo:background-color="#ff0000"/>
-</style:style>
-@end example
-
-@item Embedding a one-line OpenDocument XML
-@cindex @samp{ODT}, keyword
-The ODT export back-end can read one-liner options with @samp{#+ODT:} in
-the Org file. For example, to force a page break:
-
-@example
-#+ODT: <text:p text:style-name="PageBreak"/>
-@end example
-
-@strong{Hint:} To see the above example in action, edit your
-@samp{styles.xml} (see @ref{x-orgodtstyles-xml, , Factory styles}) and add a custom @samp{PageBreak}
-style as shown below.
-
-@example
-<style:style style:name="PageBreak" style:family="paragraph"
- style:parent-style-name="Text_20_body">
- <style:paragraph-properties fo:break-before="page"/>
-</style:style>
-@end example
-
-@item Embedding a block of OpenDocument XML
-The ODT export back-end can also read ODT export blocks for
-OpenDocument XML@. Such blocks use the @samp{#+BEGIN_EXPORT odt}
-@dots{} @samp{#+END_EXPORT} constructs.
-
-For example, to create a one-off paragraph that uses bold text, do
-the following:
-
-@example
-#+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_EXPORT
-@end example
-@end table
-
-@anchor{Customizing tables in ODT export}
-@subsubheading Customizing tables in ODT export
-
-@cindex tables, in ODT export
-@cindex @samp{ATTR_ODT}, keyword
-
-Override the default table format by specifying a custom table style
-with the @samp{#+ATTR_ODT} line. For a discussion on default formatting of
-tables, see @ref{Tables in ODT export}.
-
-This feature closely mimics the way table templates are defined in the
-OpenDocument-v1.2 specification@footnote{@uref{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html, OpenDocument-v1.2 Specification}}.
-
-@vindex org-odt-table-styles
-For quick preview of this feature, install the settings below and export the
-table that follows:
-
-@lisp
-(setq org-export-odt-table-styles
- (append org-export-odt-table-styles
- '(("TableWithHeaderRowAndColumn" "Custom"
- ((use-first-row-styles . t)
- (use-first-column-styles . t)))
- ("TableWithFirstRowandLastRow" "Custom"
- ((use-first-row-styles . t)
- (use-last-row-styles . t))))))
-@end lisp
-
-@example
-#+ATTR_ODT: :style TableWithHeaderRowAndColumn
-| Name | Phone | Age |
-| Peter | 1234 | 17 |
-| Anna | 4321 | 25 |
-@end example
-
-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
-@samp{OrgOdtContentTemplate.xml} (see @ref{x-orgodtcontenttemplate-xml, , Factory styles}). For adding new
-templates, define new styles there.
-
-To use this feature proceed as follows:
-
-@enumerate
-@item
-Create a table template@footnote{See the @samp{<table:table-template>} element of the
-OpenDocument-v1.2 specification.}.
-
-A table template is set of @samp{table-cell} and @samp{paragraph} styles for
-each of the following table cell categories:
-
-@itemize
-@item
-Body
-@item
-First column
-@item
-Last column
-@item
-First row
-@item
-Last row
-@item
-Even row
-@item
-Odd row
-@item
-Even column
-@item
-Odd Column
-@end itemize
-
-The names for the above styles must be chosen based on the name of
-the table template using a well-defined convention.
-
-The naming convention is better illustrated with an example. For
-a table template with the name @samp{Custom}, the needed style names are
-listed in the following table.
-
-@multitable {aaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@headitem Cell type
-@tab Cell style
-@tab Paragraph style
-@item Body
-@tab @samp{CustomTableCell}
-@tab @samp{CustomTableParagraph}
-@item First column
-@tab @samp{CustomFirstColumnTableCell}
-@tab @samp{CustomFirstColumnTableParagraph}
-@item Last column
-@tab @samp{CustomLastColumnTableCell}
-@tab @samp{CustomLastColumnTableParagraph}
-@item First row
-@tab @samp{CustomFirstRowTableCell}
-@tab @samp{CustomFirstRowTableParagraph}
-@item Last row
-@tab @samp{CustomLastRowTableCell}
-@tab @samp{CustomLastRowTableParagraph}
-@item Even row
-@tab @samp{CustomEvenRowTableCell}
-@tab @samp{CustomEvenRowTableParagraph}
-@item Odd row
-@tab @samp{CustomOddRowTableCell}
-@tab @samp{CustomOddRowTableParagraph}
-@item Even column
-@tab @samp{CustomEvenColumnTableCell}
-@tab @samp{CustomEvenColumnTableParagraph}
-@item Odd column
-@tab @samp{CustomOddColumnTableCell}
-@tab @samp{CustomOddColumnTableParagraph}
-@end multitable
-
-To create a table template with the name @samp{Custom}, define the above
-styles in the @samp{<office:automatic-styles>} @dots{}
-@samp{</office:automatic-styles>} element of the content template file
-(see @ref{x-orgodtcontenttemplate-xml, , Factory styles}).
-
-@item
-Define a table style@footnote{See the attributes @samp{table:template-name},
-@samp{table:use-first-row-styles}, @samp{table:use-last-row-styles},
-@samp{table:use-first-column-styles}, @samp{table:use-last-column-styles},
-@samp{table:use-banding-rows-styles}, and @samp{table:use-banding-column-styles}
-of the @samp{<table:table>} element in the OpenDocument-v1.2 specification.}.
-
-@vindex org-odt-table-styles
-To define a table style, create an entry for the style in the
-variable @code{org-odt-table-styles} and specify the following:
-
-@itemize
-@item
-the name of the table template created in step (1),
-@item
-the set of cell styles in that template that are to be activated.
-@end itemize
-
-For example, the entry below defines two different table styles
-@samp{TableWithHeaderRowAndColumn} and @samp{TableWithFirstRowandLastRow}
-based on the same template @samp{Custom}. The styles achieve their
-intended effect by selectively activating the individual cell
-styles in that template.
-
-@lisp
-(setq org-export-odt-table-styles
- (append org-export-odt-table-styles
- '(("TableWithHeaderRowAndColumn" "Custom"
- ((use-first-row-styles . t)
- (use-first-column-styles . t)))
- ("TableWithFirstRowandLastRow" "Custom"
- ((use-first-row-styles . t)
- (use-last-row-styles . t))))))
-@end lisp
-
-@item
-Associate a table with the table style.
-
-To do this, specify the table style created in step (2) as part of
-the @samp{ATTR_ODT} line as shown below.
-
-@example
-#+ATTR_ODT: :style TableWithHeaderRowAndColumn
-| Name | Phone | Age |
-| Peter | 1234 | 17 |
-| Anna | 4321 | 25 |
-@end example
-@end enumerate
-
-@anchor{Validating OpenDocument XML}
-@subsubheading Validating OpenDocument XML
-
-Sometimes ODT format files may not open due to @samp{.odt} file corruption.
-To verify if such a file is corrupt, validate it against the
-OpenDocument Relax NG Compact (RNC) syntax schema. But first the
-@samp{.odt} files have to be decompressed using @samp{zip}. Note that @samp{.odt}
-files are ZIP archives: @ref{File Archives,,,emacs,}. The contents of
-ODT files are in XML@. For general help with validation---and
-schema-sensitive editing---of XML files: @ref{Introduction,,,nxml-mode,}.
-
-@vindex org-export-odt-schema-dir
-Customize @code{org-odt-schema-dir} to point to a directory with
-OpenDocument RNC files and the needed schema-locating rules. The ODT
-export back-end takes care of updating the
-@code{rng-schema-locating-files}.
-
-@node Org Export
-@section Org Export
-
-@cindex Org export
-@emph{org} export back-end creates a normalized version of the Org document
-in current buffer. The exporter evaluates Babel code (see @ref{Evaluating Code Blocks}) and removes content specific to other back-ends.
-
-@anchor{Org export commands}
-@subheading Org export commands
-
-@table @asis
-@item @kbd{C-c C-e O o} (@code{org-org-export-to-org})
-@kindex C-c C-e O o
-@findex org-org-export-to-org
-Export as an Org file with a @samp{.org} extension. For @samp{myfile.org},
-Org exports to @samp{myfile.org.org}, overwriting without warning.
-
-@item @kbd{C-c C-e O v} (~~)
-@kindex C-c C-e O v
-Export to an Org file, then open it.
-@end table
-
-@node Texinfo Export
-@section Texinfo Export
-
-@menu
-* 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.
-* Quotations in Texinfo export:: Quote block attributes.
-* Special blocks in Texinfo export:: Special block attributes.
-* A Texinfo example:: Processing Org to Texinfo.
-@end menu
-
-@node Texinfo export commands
-@subsection Texinfo export commands
-
-@table @asis
-@item @kbd{C-c C-e i t} (@code{org-texinfo-export-to-texinfo})
-@kindex C-c C-e i t
-@findex org-texinfo-export-to-texinfo
-Export as a Texinfo file with @samp{.texi} extension. For @samp{myfile.org},
-Org exports to @samp{myfile.texi}, overwriting without warning.
-
-@item @kbd{C-c C-e i i} (@code{org-texinfo-export-to-info})
-@kindex C-c C-e i i
-@findex org-texinfo-export-to-info
-@vindex org-texinfo-info-process
-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 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 (see @ref{Export Settings}).
-
-@table @asis
-@item @samp{SUBTITLE}
-@cindex @samp{SUBTITLE}, keyword
-The document subtitle.
-
-@item @samp{SUBAUTHOR}
-@cindex @samp{SUBAUTHOR}, keyword
-Additional authors for the document.
-
-@item @samp{TEXINFO_FILENAME}
-@cindex @samp{TEXINFO_FILENAME}, keyword
-The Texinfo filename.
-
-@item @samp{TEXINFO_CLASS}
-@cindex @samp{TEXINFO_CLASS}, keyword
-@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 @samp{TEXINFO_HEADER}
-@cindex @samp{TEXINFO_HEADER}, keyword
-Arbitrary lines inserted at the end of the header.
-
-@item @samp{TEXINFO_POST_HEADER}
-@cindex @samp{TEXINFO_POST_HEADER}, keyword
-Arbitrary lines inserted after the end of the header.
-
-@item @samp{TEXINFO_DIR_CATEGORY}
-@cindex @samp{TEXINFO_DIR_CATEGORY}, keyword
-The directory category of the document.
-
-@item @samp{TEXINFO_DIR_TITLE}
-@cindex @samp{TEXINFO_DIR_TITLE}, keyword
-The directory title of the document.
-
-@item @samp{TEXINFO_DIR_DESC}
-@cindex @samp{TEXINFO_DIR_DESC}, keyword
-The directory description of the document.
-
-@item @samp{TEXINFO_PRINTED_TITLE}
-@cindex @samp{TEXINFO_PRINTED_TITLE}, keyword
-The printed title of the document.
-@end table
-
-@node Texinfo file header
-@subsection Texinfo file header
-
-@cindex @samp{TEXINFO_FILENAME}, keyword
-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 @samp{TEXINFO_FILENAME} keyword.
-
-@vindex org-texinfo-coding-system
-@cindex @samp{TEXINFO_HEADER}, keyword
-Along with the output's file name, the Texinfo header also contains
-language details (see @ref{Export Settings}) and encoding system as set in
-the @code{org-texinfo-coding-system} variable. Insert @samp{TEXINFO_HEADER}
-keywords for each additional command in the header, for example:
-
-@example
-#+TEXINFO_HEADER: @@synindex
-@end example
-
-
-@cindex @samp{TEXINFO_CLASS}, keyword
-@vindex org-texinfo-classes
-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 @samp{TEXINFO_CLASS} keyword to that class.
-
-@node Texinfo title and copyright page
-@subsection Texinfo title and copyright page
-
-@cindex @samp{TEXINFO_PRINTED_TITLE}, keyword
-The default template for hard copy output has a title page with
-@samp{TITLE} and @samp{AUTHOR} keywords (see @ref{Export Settings}). To replace the
-regular title with something different for the printed version, use
-the @samp{TEXINFO_PRINTED_TITLE} and @samp{SUBTITLE} keywords. Both expect raw
-Texinfo code for setting their values.
-
-@cindex @samp{SUBAUTHOR}, keyword
-If one @samp{AUTHOR} line is not sufficient, add multiple @samp{SUBAUTHOR}
-keywords. They have to be set in raw Texinfo code.
-
-@example
-#+AUTHOR: Jane Smith
-#+SUBAUTHOR: John Doe
-#+TEXINFO_PRINTED_TITLE: This Long Title@@@@inlinefmt@{tex,@@*@} Is Broken in @@TeX@{@}
-@end example
-
-@cindex @samp{COPYING}, property
-Copying material is defined in a dedicated headline with a non-@code{nil}
-@samp{COPYING} property. The back-end inserts the contents within
-a @samp{@@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
-* Legalese
- :PROPERTIES:
- :COPYING: t
- :END:
-
- This is a short example of a complete Texinfo file, version 1.0.
-
- Copyright \copy 2016 Free Software Foundation, Inc.
-@end example
-
-@node Info directory file
-@subsection Info directory file
-
-@cindex @samp{dir} file, in Texinfo export
-@cindex Info directory file, in Texinfo export
-@cindex @code{install-info}, in Texinfo export
-
-@cindex @samp{TEXINFO_DIR_CATEGORY}, keyword
-@cindex @samp{TEXINFO_DIR_TITLE}, keyword
-@cindex @samp{TEXINFO_DIR_DESC}, keyword
-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: @samp{TEXINFO_DIR_CATEGORY}, @samp{TEXINFO_DIR_TITLE},
-and @samp{TEXINFO_DIR_DESC} keywords 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
-#+TEXINFO_DIR_TITLE: Org Mode: (org)
-#+TEXINFO_DIR_DESC: Outline-based notes management and organizer
-@end example
-
-@node Headings and sectioning structure
-@subsection Headings and sectioning structure
-
-@vindex org-texinfo-classes
-@vindex org-texinfo-default-class
-@cindex @samp{TEXINFO_CLASS}, keyword
-The Texinfo export back-end uses a pre-defined scheme to convert Org
-headlines to 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
-@samp{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 (see @ref{Export Settings}), then
-the Texinfo export back-end makes it into a list item.
-
-@cindex @samp{APPENDIX}, property
-The Texinfo export back-end makes any headline with a non-@code{nil}
-@samp{APPENDIX} property into an appendix. This happens independent of the
-Org headline level or the @samp{TEXINFO_CLASS} keyword.
-
-@cindex @samp{ALT_TITLE}, property
-@cindex @samp{DESCRIPTION}, property
-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 @samp{ALT_TITLE} property (see @ref{Table of Contents}). Texinfo menu entries also have an option for a longer
-@samp{DESCRIPTION} property. Here's an example that uses both to override
-the default menu entry:
-
-@example
-* Controlling Screen Display
- :PROPERTIES:
- :ALT_TITLE: Display
- :DESCRIPTION: Controlling Screen Display
- :END:
-@end example
-
-@cindex Top node, in Texinfo export
-The text before the first headline belongs to the @emph{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 @samp{.texi}
-file. See @ref{The Top Node,,,texinfo,}, for more information.
-
-@node Indices
-@subsection Indices
-
-@cindex @samp{CINDEX}, keyword
-@cindex concept index, in Texinfo export
-@cindex @samp{FINDEX}, keyword
-@cindex function index, in Texinfo export
-@cindex @samp{KINDEX}, keyword
-@cindex keystroke index, in Texinfo export
-@cindex @samp{PINDEX}, keyword
-@cindex program index, in Texinfo export
-@cindex @samp{TINDEX}, keyword
-@cindex data type index, in Texinfo export
-@cindex @samp{VINDEX}, keyword
-@cindex variable index, in Texinfo export
-The Texinfo export back-end recognizes these indexing keywords if used
-in the Org file: @samp{CINDEX}, @samp{FINDEX}, @samp{KINDEX}, @samp{PINDEX}, @samp{TINDEX} and
-@samp{VINDEX}. Write their value as verbatim Texinfo code; in particular,
-@samp{@{}, @samp{@}} and @samp{@@} characters need to be escaped with @samp{@@} if they do not
-belong to a Texinfo command.
-
-@example
-#+CINDEX: Defining indexing entries
-@end example
-
-
-@cindex @samp{INDEX}, property
-For the back-end to generate an index entry for a headline, set the
-@samp{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
- :PROPERTIES:
- :INDEX: cp
- :END:
-@end example
-
-@node Quoting Texinfo code
-@subsection Quoting Texinfo code
-
-Use any of the following three methods to insert or escape raw Texinfo
-code:
-
-@cindex @samp{TEXINFO}, keyword
-@cindex @samp{BEGIN_EXPORT texinfo}
-@example
-Richard @@@@texinfo:@@sc@{@@@@Stallman@@@@texinfo:@}@@@@ commence' GNU.
-
-#+TEXINFO: @@need800
-This paragraph is preceded by...
-
-#+BEGIN_EXPORT texinfo
- @@auindex Johnson, Mark
- @@auindex Lakoff, George
-#+END_EXPORT
-@end example
-
-@node Plain lists in Texinfo export
-@subsection Plain lists in Texinfo export
-
-@cindex @samp{ATTR_TEXINFO}, keyword
-@cindex two-column tables, in Texinfo export
-@cindex table-type, Texinfo attribute
-The Texinfo export back-end by default converts description lists in
-the Org file using the default command @samp{@@table}, which results in
-a table with two columns. To change this behavior, set @samp{:table-type}
-attribute to either @samp{ftable} or @samp{vtable} value. For more information,
-see @ref{Two-column Tables,,,texinfo,}.
-
-@vindex org-texinfo-table-default-markup
-@cindex indic, Texinfo attribute
-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 @samp{:indic} attribute.
-
-@cindex multiple items in Texinfo lists
-@cindex sep, Texinfo attribute
-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 @samp{:sep} attribute. Each part then becomes a new
-entry in the first column of the table.
-
-The following example illustrates all the attributes above:
-
-@example
-#+ATTR_TEXINFO: :table-type vtable :sep , :indic asis
-- foo, bar :: This is the common text for variables foo and bar.
-@end example
-
-@noindent
-becomes
-
-@example
-@@vtable @@asis
-@@item foo
-@@itemx bar
-This is the common text for variables foo and bar.
-@@end table
-@end example
-
-@cindex lettered lists, in Texinfo export
-@cindex enum, Texinfo attribute
-Ordered lists are numbered when exported to Texinfo format. Such
-numbering obeys any counter (see @ref{Plain Lists}) in the first item of
-the list. The @samp{:enum} attribute also let you start the list at
-a specific number, or switch to a lettered list, as illustrated here
-
-@example
-#+ATTR_TEXINFO: :enum A
-1. Alpha
-2. Bravo
-3. Charlie
-@end example
-
-@node Tables in Texinfo export
-@subsection Tables in Texinfo export
-
-@cindex @samp{ATTR_TEXINFO}, keyword
-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 @samp{:columns} attribute. See example
-below.
-
-@example
-#+ATTR_TEXINFO: :columns .5 .5
-| a cell | another cell |
-@end example
-
-@node Images in Texinfo export
-@subsection Images in Texinfo export
-
-@cindex @samp{ATTR_TEXINFO}, keyword
-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 @samp{:width} and @samp{:height} attributes. For alternate text, use @samp{:alt}
-and specify the text using Texinfo code, as shown in the example:
-
-@example
-#+ATTR_TEXINFO: :width 1in :alt Alternate @@i@{text@}
-[[ridt.pdf]]
-@end example
-
-@node Quotations in Texinfo export
-@subsection Quotations in Texinfo export
-
-@cindex @samp{ATTR_TEXINFO}, keyword
-You can write the text of a quotation within a quote block (see
-@ref{Paragraphs}). You may also emphasize some text at the beginning of
-the quotation with the @samp{:tag} attribute.
-
-@example
-#+ATTR_TEXINFO: :tag Warning
-#+BEGIN_QUOTE
-Striking your thumb with a hammer may cause severe pain and discomfort.
-#+END_QUOTE
-@end example
-
-To specify the author of the quotation, use the @samp{:author} attribute.
-
-@example
-#+ATTR_TEXINFO: :author King Arthur
-#+BEGIN_QUOTE
-The Lady of the Lake, her arm clad in the purest shimmering samite,
-held aloft Excalibur from the bosom of the water, signifying by divine
-providence that I, Arthur, was to carry Excalibur. That is why I am
-your king.
-#+END_QUOTE
-@end example
-
-@node Special blocks in Texinfo export
-@subsection Special blocks in Texinfo export
-
-@cindex @samp{ATTR_TEXINFO}, keyword
-
-The Texinfo export back-end converts special blocks to commands with
-the same name. It also adds any @samp{: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 name.
-#+END_defun
-@end example
-
-@noindent
-becomes
-
-@example
-@@defun org-org-export-to-org ...
- A somewhat obsessive function name.
-@@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,} 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
-
-#+TEXINFO_DIR_CATEGORY: Texinfo documentation system
-#+TEXINFO_DIR_TITLE: sample: (sample)
-#+TEXINFO_DIR_DESC: Invoking sample
-
-#+TEXINFO_PRINTED_TITLE: GNU Sample
-
-This manual is for GNU Sample (version @{@{@{version@}@}@},
-@{@{@{updated@}@}@}).
-
-* Copying
- :PROPERTIES:
- :COPYING: t
- :END:
-
- This manual is for GNU Sample (version @{@{@{version@}@}@},
- @{@{@{updated@}@}@}), which is an example in the Texinfo documentation.
-
- Copyright \copy 2016 Free Software Foundation, Inc.
-
- #+BEGIN_QUOTE
- Permission is granted to copy, distribute and/or modify this
- document under the terms of the GNU Free Documentation License,
- Version 1.3 or any later version published by the Free Software
- Foundation; with no Invariant Sections, with no Front-Cover Texts,
- and with no Back-Cover Texts. A copy of the license is included in
- the section entitled "GNU Free Documentation License".
- #+END_QUOTE
-
-* Invoking sample
-
- #+PINDEX: sample
- #+CINDEX: invoking @@command@{sample@}
-
- This is a sample manual. There is no sample program to invoke, but
- if there were, you could see its basic usage and command line
- options here.
-
-* GNU Free Documentation License
- :PROPERTIES:
- :APPENDIX: t
- :END:
-
- #+INCLUDE: fdl.org
-
-* Index
- :PROPERTIES:
- :INDEX: cp
- :END:
-@end example
-
-@node iCalendar Export
-@section iCalendar Export
-
-@cindex iCalendar export
-
-A large part of Org mode's interoperability 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.
-
-@vindex org-icalendar-include-todo
-@vindex org-icalendar-use-deadline
-@vindex org-icalendar-use-scheduled
-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 @samp{VEVENT}, TODO items as
-@samp{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.
-
-@vindex org-icalendar-categories
-@vindex org-icalendar-alarm-time
-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 @samp{ID}, property
-The iCalendar format standard requires globally unique identifier---or
-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 @samp{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---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 @asis
-@item @kbd{C-c C-e c f} (@code{org-icalendar-export-to-ics})
-@kindex C-c C-e c f
-@findex org-icalendar-export-to-ics
-Create iCalendar entries from the current Org buffer and store them
-in the same directory, using a file extension @samp{.ics}.
-
-@item @kbd{C-c C-e c a} (@code{org-icalendar-export-agenda-files})
-@kindex C-c C-e c a
-@findex org-icalendar-export-agenda-files
-Create iCalendar entries from Org files in @code{org-agenda-files} and
-store in a separate iCalendar file for each Org file.
-
-@item @kbd{C-c C-e c c} (@code{org-icalendar-combine-agenda-files})
-@kindex C-c C-e c c
-@findex org-icalendar-combine-agenda-files
-@vindex 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
-
-@cindex @samp{SUMMARY}, property
-@cindex @samp{DESCRIPTION}, property
-@cindex @samp{LOCATION}, property
-@cindex @samp{TIMEZONE}, property
-@cindex @samp{CLASS}, property
-The iCalendar export back-end includes @samp{SUMMARY}, @samp{DESCRIPTION},
-@samp{LOCATION}, @samp{TIMEZONE} and @samp{CLASS} properties from the Org entries
-when exporting. To force the back-end to inherit the @samp{LOCATION},
-@samp{TIMEZONE} and @samp{CLASS} properties, configure the
-@code{org-use-property-inheritance} variable.
-
-@vindex org-icalendar-include-body
-When Org entries do not have @samp{SUMMARY}, @samp{DESCRIPTION}, @samp{LOCATION} and
-@samp{CLASS} 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 @samp{TIMEZONE} property can be used to specify a per-entry time zone,
-and is applied to any entry with timestamp information. Time zones
-should be specified as per the IANA time zone database format, e.g.,
-@samp{Asia/Almaty}. Alternately, the property value can be @samp{UTC}, to force
-UTC time for this entry only.
-
-The @samp{CLASS} property can be used to specify a per-entry visibility
-class or access restrictions, and is applied to any entry with class
-information. The iCalendar standard defines three visibility classes:
-@table @asis
-@item @samp{PUBLIC}
-The entry is publicly visible (this is the default).
-@item @samp{CONFIDENTIAL}
-Only a limited group of clients get access to the
-event.
-@item @samp{PRIVATE}
-The entry can be retrieved only by its owner.
-@end table
-The server should treat unknown class properties the same as
-@samp{PRIVATE}.
-
-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
-
-Other export back-ends included with Org are:
-
-@itemize
-@item
-@samp{ox-man.el}: Export to a man page.
-@end itemize
-
-To activate such back-ends, either customize @code{org-export-backends} or
-load directly with @samp{(require 'ox-man)}. On successful load, the
-back-end adds new keys in the export dispatcher (see @ref{The Export Dispatcher}).
-
-Follow the comment section of such files, for example, @samp{ox-man.el},
-for usage and configuration details.
-
-@node Advanced Export Configuration
-@section Advanced Export Configuration
-
-
-
-@anchor{Hooks}
-@subheading Hooks
-
-@vindex org-export-before-processing-hook
-@vindex org-export-before-parsing-hook
-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.
-
-Functions added to these hooks are called with a single argument: the
-export back-end actually used, as a symbol. You may use them for
-heavy duty structural modifications of the document. For example, you
-can remove every headline in the buffer during export like this:
-
-@lisp
-(defun my-headline-removal (backend)
- "Remove all headlines in the current buffer.
-BACKEND is the export back-end being used, as a symbol."
- (org-map-entries
- (lambda () (delete-region (point) (line-beginning-position 2)))))
-
-(add-hook 'org-export-before-parsing-hook 'my-headline-removal)
-@end lisp
-
-@anchor{Filters}
-@subheading Filters
-
-@cindex Filters, exporting
-Filters are 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 @var{TYPE}
-is the type targeted by the filter. Valid types are:
-
-@multitable @columnfractions 0.33 0.33 0.33
-@item body
-@tab bold
-@tab babel-call
-@item center-block
-@tab clock
-@tab code
-@item diary-sexp
-@tab drawer
-@tab dynamic-block
-@item entity
-@tab example-block
-@tab export-block
-@item export-snippet
-@tab final-output
-@tab fixed-width
-@item footnote-definition
-@tab footnote-reference
-@tab headline
-@item horizontal-rule
-@tab inline-babel-call
-@tab inline-src-block
-@item inlinetask
-@tab italic
-@tab item
-@item keyword
-@tab latex-environment
-@tab latex-fragment
-@item line-break
-@tab link
-@tab node-property
-@item options
-@tab paragraph
-@tab parse-tree
-@item plain-list
-@tab plain-text
-@tab planning
-@item property-drawer
-@tab quote-block
-@tab radio-target
-@item section
-@tab special-block
-@tab src-block
-@item statistics-cookie
-@tab strike-through
-@tab subscript
-@item superscript
-@tab table
-@tab table-cell
-@item table-row
-@tab target
-@tab timestamp
-@item underline
-@tab verbatim
-@tab verse-block
-@end multitable
-
-Here is an example filter that replaces non-breaking spaces @code{ } in the
-Org buffer with @samp{~} for the @LaTeX{} back-end.
-
-@lisp
-(defun my-latex-filter-nobreaks (text backend info)
- "Ensure \" \" are properly handled in LaTeX export."
- (when (org-export-derived-backend-p backend 'latex)
- (replace-regexp-in-string " " "~" text)))
-
-(add-to-list 'org-export-filter-plain-text-functions
- 'my-latex-filter-nobreaks)
-@end lisp
-
-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 @emph{latex}
-back-end or any other back-end, such as @emph{beamer}, derived from
-@emph{latex}.
-
-@anchor{Defining filters for individual files}
-@subheading Defining filters for individual files
-
-The Org export can filter not just for back-ends, but also for
-specific files through the @samp{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 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
-
-@anchor{Extending an existing back-end}
-@subheading Extending an existing back-end
-
-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.
-
-For this example, make the @emph{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
-
-
-Then extend ASCII back-end with a custom ``my-ascii'' back-end.
-
-@lisp
-(defun my-ascii-src-block (src-block contents info)
- "Transcode a SRC-BLOCK element from Org to ASCII.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (if (not (org-export-read-attribute :attr_ascii src-block :language))
- (org-export-with-backend 'ascii src-block contents info)
- (concat
- (format ",--[ %s ]--\n%s`----"
- (org-element-property :language src-block)
- (replace-regexp-in-string
- "^" "| "
- (org-element-normalize-string
- (org-export-format-code-default src-block info)))))))
-
-(org-export-define-derived-backend 'my-ascii 'ascii
- :translate-alist '((src-block . my-ascii-src-block)))
-@end lisp
-
-The @code{my-ascii-src-block} function looks at the attribute above the
-current element. If not true, hands over to @emph{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, evaluate the following from an Org
-buffer:
-
-@lisp
-(org-export-to-buffer 'my-ascii "*Org MY-ASCII Export*")
-@end lisp
-
-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 @asis
-@item @code{org-ascii-convert-region-to-ascii}
-@findex org-ascii-convert-region-to-ascii
-Convert the selected region into ASCII@.
-
-@item @code{org-ascii-convert-region-to-utf8}
-@findex org-ascii-convert-region-to-utf8
-Convert the selected region into UTF-8.
-
-@item @code{org-html-convert-region-to-html}
-@findex org-html-convert-region-to-html
-Convert the selected region into HTML@.
-
-@item @code{org-latex-convert-region-to-latex}
-@findex org-latex-convert-region-to-latex
-Convert the selected region into @LaTeX{}.
-
-@item @code{org-texinfo-convert-region-to-texinfo}
-@findex org-texinfo-convert-region-to-texinfo
-Convert the selected region into Texinfo.
-
-@item @code{org-md-convert-region-to-md}
-@findex org-md-convert-region-to-md
-Convert the selected region into Markdown.
-@end table
-
-In-place conversions are particularly handy for quick conversion of
-tables and lists in foreign buffers. For example, in an HTML buffer,
-write a list in Org syntax, select it, and convert it to HTML with
-@kbd{M-x org-html-convert-region-to-html}.
-
-@menu
-* Bare HTML:: Exporting HTML without CSS, Javascript, etc.
-@end menu
-
-@node Bare HTML
-@subsection Exporting to minimal HTML
-
-If you want to output a minimal HTML file, with no CSS, no Javascript,
-no preamble or postamble, here are the variable you would need to set:
-
-@vindex org-html-head
-@vindex org-html-head-extra
-@vindex org-html-head-include-default-style
-@vindex org-html-head-include-scripts
-@vindex org-html-preamble
-@vindex org-html-postamble
-@vindex org-html-use-infojs
-@lisp
-(setq org-html-head ""
- org-html-head-extra ""
- org-html-head-include-default-style nil
- org-html-head-include-scripts nil
- org-html-preamble nil
- org-html-postamble nil
- org-html-use-infojs nil)
-@end lisp
-
-@node Publishing
-@chapter Publishing
-
-@cindex publishing
-
-Org includes a publishing management system that allows you to
-configure automatic HTML conversion of @emph{projects} composed of
-interlinked Org files. You can also configure Org to automatically
-upload your exported HTML pages and related attachments, such as
-images and source code files, to a web server.
-
-You can also use Org to convert files into PDF, or even combine HTML
-and PDF conversion so that files are available in both formats on the
-server.
-
-Publishing has been contributed to Org by David O'Toole.
-
-@menu
-* Configuration:: Defining projects.
-* Uploading Files:: How to get files up on the server.
-* Sample Configuration:: Example projects.
-* Triggering Publication:: Publication commands.
-@end menu
-
-@node Configuration
-@section Configuration
-
-Publishing needs significant configuration to specify files,
-destination and many other properties of a project.
-
-@menu
-* Project alist:: The central configuration variable.
-* Sources and destinations:: From here to there.
-* Selecting files:: What files are part of the project?
-* Publishing action:: Setting the function doing the publishing.
-* Publishing options:: Tweaking HTML/@LaTeX{} export.
-* Publishing links:: Which links keep working after publishing?
-* Site map:: Generating a list of all pages.
-* Generating an index:: An index that reaches across pages.
-@end menu
-
-@node Project alist
-@subsection The variable @code{org-publish-project-alist}
-
-@cindex projects, for publishing
-
-@vindex org-publish-project-alist
-Publishing is configured almost entirely through setting the value of
-one variable, called @code{org-publish-project-alist}. Each element of the
-list configures one project, and may be in one of the two following
-forms:
-
-@lisp
-("project-name" :property value :property value ...)
-@end lisp
-
-@noindent
-i.e., a well-formed property list with alternating keys and values,
-or:
-
-@lisp
-("project-name" :components ("project-name" "project-name" ...))
-@end lisp
-
-In both cases, projects are configured by specifying property values.
-A project defines the set of files that are to be published, as well
-as the publishing configuration to use when publishing those files.
-When a project takes the second form listed above, the individual
-members of the @code{:components} property are taken to be sub-projects,
-which group together files requiring different publishing options.
-When you publish such a ``meta-project'', all the components are also
-published, in the sequence given.
-
-@node Sources and destinations
-@subsection Sources and destinations for files
-
-@cindex directories, for publishing
-
-Most properties are optional, but some should always be set. In
-particular, Org needs to know where to look for source files, and
-where to put published files.
-
-@table @asis
-@item @code{:base-directory}
-Directory containing publishing source files.
-
-@item @code{:publishing-directory}
-Directory where output files are published. You can directly
-publish to a webserver using a file name syntax appropriate for the
-Emacs tramp package. Or you can publish to a local directory and
-use external tools to upload your website (see @ref{Uploading Files}).
-
-@item @code{:preparation-function}
-Function or list of functions to be called before starting the
-publishing process, for example, to run @samp{make} for updating files to
-be published. Each preparation function is called with a single
-argument, the project property list.
-
-@item @code{:completion-function}
-Function or list of functions called after finishing the publishing
-process, for example, to change permissions of the resulting files.
-Each completion function is called with a single argument, the
-project property list.
-@end table
-
-@node Selecting files
-@subsection Selecting files
-
-@cindex files, selecting for publishing
-
-By default, all files with extension @samp{.org} in the base directory are
-considered part of the project. This can be modified by setting the
-following properties
-
-@table @asis
-@item @code{:base-extension}
-Extension---without the dot---of source files. This actually is
-a regular expression. Set this to the symbol @code{any} if you want to
-get all files in @code{:base-directory}, even without extension.
-
-@item @code{:exclude}
-Regular expression to match file names that should not be published,
-even though they have been selected on the basis of their extension.
-
-@item @code{:include}
-List of files to be included regardless of @code{:base-extension} and
-@code{:exclude}.
-
-@item @code{:recursive}
-Non-@code{nil} means, check base-directory recursively for files to
-publish.
-@end table
-
-@node Publishing action
-@subsection Publishing action
-
-@cindex action, for publishing
-
-Publishing means that a file is copied to the destination directory
-and possibly transformed in the process. The default transformation
-is to export Org files as HTML files, and this is done by the function
-@code{org-publish-org-to-html} which calls the HTML exporter (see @ref{HTML Export}). But you can also publish your content as PDF files using
-@code{org-publish-org-to-pdf}, or as ASCII, Texinfo, etc., using the
-corresponding functions.
-
-If you want to publish the Org file as an @samp{.org} file but with
-@emph{archived}, @emph{commented}, and @emph{tag-excluded} trees removed, use
-@code{org-publish-org-to-org}. This produces @samp{file.org} and put it in the
-publishing directory. If you want a htmlized version of this file,
-set the parameter @code{:htmlized-source} to @code{t}. It produces
-@samp{file.org.html} in the publishing directory@footnote{If the publishing directory is the same as the source
-directory, @samp{file.org} is exported as @samp{file.org.org}, so you probably
-do not want to do this.}.
-
-Other files like images only need to be copied to the publishing
-destination; for this you can use @code{org-publish-attachment}. For
-non-Org files, you always need to specify the publishing function:
-
-@table @asis
-@item @code{:publishing-function}
-Function executing the publication of a file. This may also be
-a list of functions, which are all called in turn.
-
-@item @code{:htmlized-source}
-Non-@code{nil} means, publish htmlized source.
-@end table
-
-The function must accept three arguments: a property list containing
-at least a @code{:publishing-directory} property, the name of the file to
-be published, 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
-@subsection Options for the exporters
-
-@cindex options, for publishing
-@cindex publishing options
-
-The property list can be used to set many export options for the HTML
-and @LaTeX{} exporters. In most cases, these properties correspond to
-user variables in Org. The table below lists these properties along
-with the variable they belong to. See the documentation string for
-the respective variable for details.
-
-@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 (see @ref{Export Settings}), however, override everything.
-
-@anchor{Generic properties}
-@subsubheading Generic properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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}
-@item @code{:language}
-@tab @code{org-export-default-language}
-@item @code{:preserve-breaks}
-@tab @code{org-export-preserve-breaks}
-@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}
-@item @code{:with-fixed-width}
-@tab @code{org-export-with-fixed-width}
-@item @code{:with-footnotes}
-@tab @code{org-export-with-footnotes}
-@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
-
-@anchor{ASCII specific properties}
-@subsubheading ASCII specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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
-
-@anchor{Beamer specific properties}
-@subsubheading Beamer specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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
-
-@anchor{HTML specific properties}
-@subsubheading HTML specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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}
-@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-equation-reference-format}
-@tab @code{org-html-equation-reference-format}
-@item @code{:html-metadata-timestamp-format}
-@tab @code{org-html-metadata-timestamp-format}
-@item @code{:html-postamble-format}
-@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-self-link-headlines}
-@tab @code{org-html-self-link-headlines}
-@item @code{:html-table-align-individual-field}
-@tab @code{de@{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-wrap-src-lines}
-@tab @code{org-html-wrap-src-lines}
-@item @code{:html-xml-declaration}
-@tab @code{org-html-xml-declaration}
-@end multitable
-
-@anchor{@LaTeX{} specific properties}
-@subsubheading @LaTeX{} specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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
-
-@anchor{Markdown specific properties}
-@subsubheading Markdown specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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
-
-@anchor{ODT specific properties}
-@subsubheading ODT specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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
-
-@anchor{Texinfo specific properties}
-@subsubheading Texinfo specific properties
-
-@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@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 Publishing links
-
-@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]]} (see @ref{External Links}). When
-published, this link becomes a link to @samp{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 @samp{http} link instead of
-a @samp{file:} link, because @samp{file} links are converted to link to the
-corresponding @samp{.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.
-
-Eventually, links between published documents can contain some search
-options (see @ref{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 @samp{foo.html}.
-
-@example
-[[file:foo.org::*heading]]
-[[file:foo.org::#custom-id]]
-[[file:foo.org::target]]
-@end example
-
-@node Site map
-@subsection Generating a sitemap
-
-@cindex sitemap, of published pages
-
-The following properties may be used to control publishing of
-a map of files for a given project.
-
-@table @asis
-@item @code{:auto-sitemap}
-When non-@code{nil}, publish a sitemap during
-@code{org-publish-current-project} or @code{org-publish-all}.
-
-@item @code{:sitemap-filename}
-Filename for output of sitemap. Defaults to @samp{sitemap.org}, which
-becomes @samp{sitemap.html}.
-
-@item @code{:sitemap-title}
-Title of sitemap page. Defaults to name of file.
-
-@item @code{:sitemap-format-entry}
-@findex org-publish-find-date
-@findex org-publish-find-property
-@findex org-publish-find-title
-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}
-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 nested
-list, which 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}
-Where folders should appear in the sitemap. Set this to @code{first}
-(default) or @code{last} to display folders first or last, respectively.
-When set to @code{ignore}, folders are ignored altogether. Any other
-value mixes files and folders. This variable has no effect when
-site-map style is @code{tree}.
-
-@item @code{:sitemap-sort-files}
-How the files are sorted in the site map. Set this to
-@code{alphabetically} (default), @code{chronologically} or
-@code{anti-chronologically}. @code{chronologically} sorts the files with
-older date first while @code{anti-chronologically} sorts the files with
-newer date first. @code{alphabetically} sorts the files alphabetically.
-The date of a file is retrieved with @code{org-publish-find-date}.
-
-@item @code{:sitemap-ignore-case}
-Should sorting be case-sensitive? Default @code{nil}.
-
-@item @code{:sitemap-file-entry-format}
-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}
-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}.
-@end table
-
-@node Generating an index
-@subsection Generating an index
-
-@cindex index, in a publishing project
-
-Org mode can generate an index across the files of a publishing project.
-
-@table @asis
-@item @code{:makeindex}
-When non-@code{nil}, generate in index in the file @samp{theindex.org} and
-publish it as @samp{theindex.html}.
-@end table
-
-The file is created when first publishing a project with the
-@code{:makeindex} set. The file only contains a statement @samp{#+INCLUDE:
-"theindex.inc"}. You can then build around this include statement by
-adding a title, style information, etc.
-
-@cindex @samp{INDEX}, keyword
-Index entries are specified with @samp{INDEX} keyword. An entry that
-contains an exclamation mark creates a sub item.
-
-@example
-*** Curriculum Vitae
-#+INDEX: CV
-#+INDEX: Application!CV
-@end example
-
-@node Uploading Files
-@section Uploading Files
-
-@cindex rsync
-@cindex unison
-
-For those people already utilizing third party sync tools such as
-Rsync or Unison, it might be preferable not to use the built-in remote
-publishing facilities of Org mode which rely heavily on Tramp. Tramp,
-while very useful and powerful, tends not to be so efficient for
-multiple file transfer and has been known to cause problems under
-heavy usage.
-
-Specialized synchronization utilities offer several advantages. In
-addition to timestamp comparison, they also do content and
-permissions/attribute checks. For this reason you might prefer to
-publish your web to a local directory---possibly even @emph{in place} with
-your Org files---and then use Unison or Rsync to do the
-synchronization with the remote host.
-
-Since Unison, for example, can be configured as to which files to
-transfer to a certain remote destination, it can greatly simplify the
-project publishing definition. Simply keep all files in the correct
-location, process your Org files with @code{org-publish} and let the
-synchronization tool do the rest. You do not need, in this scenario,
-to include attachments such as JPG, CSS or PNG files in the project
-definition since the third-party tool syncs them.
-
-Publishing to a local directory is also much faster than to a remote
-one, so that you can afford more easily to republish entire projects.
-If you set @code{org-publish-use-timestamps-flag} to @code{nil}, you gain the
-main benefit of re-including any changed external files such as source
-example files you might include with @samp{INCLUDE} keyword. The timestamp
-mechanism in Org is not smart enough to detect if included files have
-been modified.
-
-@node Sample Configuration
-@section Sample Configuration
-
-Below we provide two example configurations. The first one is
-a simple project publishing only a set of Org files. The second
-example is more complex, with a multi-component project.
-
-@menu
-* Simple example:: One-component publishing.
-* Complex example:: A multi-component publishing example.
-@end menu
-
-@node Simple example
-@subsection Example: simple publishing configuration
-
-This example publishes a set of Org files to the @samp{public_html}
-directory on the local machine.
-
-@lisp
-(setq org-publish-project-alist
- '(("org"
- :base-directory "~/org/"
- :publishing-directory "~/public_html"
- :section-numbers nil
- :table-of-contents nil
- :style "<link rel=\"stylesheet\"
- href=\"../other/mystyle.css\"
- type=\"text/css\"/>")))
-@end lisp
-
-@node Complex example
-@subsection Example: complex publishing configuration
-
-This more complicated example publishes an entire website, including
-Org files converted to HTML, image files, Emacs Lisp source code, and
-style sheets. The publishing directory is remote and private files
-are excluded.
-
-To ensure that links are preserved, care should be taken to replicate
-your directory structure on the web server, and to use relative file
-paths. For example, if your Org files are kept in @samp{~/org/} and your
-publishable images in @samp{~/images/}, you would link to an image with
-
-@example
-file:../images/myimage.png
-@end example
-
-
-On the web server, the relative path to the image should be the same.
-You can accomplish this by setting up an @samp{images/} folder in the right
-place on the web server, and publishing images to it.
-
-@lisp
-(setq org-publish-project-alist
- '(("orgfiles"
- :base-directory "~/org/"
- :base-extension "org"
- :publishing-directory "/ssh:user@@host:~/html/notebook/"
- :publishing-function org-html-publish-to-html
- :exclude "PrivatePage.org" ;; regexp
- :headline-levels 3
- :section-numbers nil
- :with-toc nil
- :html-head "<link rel=\"stylesheet\"
- href=\"../other/mystyle.css\" type=\"text/css\"/>"
- :html-preamble t)
-
- ("images"
- :base-directory "~/images/"
- :base-extension "jpg\\|gif\\|png"
- :publishing-directory "/ssh:user@@host:~/html/images/"
- :publishing-function org-publish-attachment)
-
- ("other"
- :base-directory "~/other/"
- :base-extension "css\\|el"
- :publishing-directory "/ssh:user@@host:~/html/other/"
- :publishing-function org-publish-attachment)
- ("website" :components ("orgfiles" "images" "other"))))
-@end lisp
-
-@node Triggering Publication
-@section Triggering Publication
-
-Once properly configured, Org can publish with the following commands:
-
-@table @asis
-@item @kbd{C-c C-e P x} (@code{org-publish})
-@kindex C-c C-e P x
-@findex org-publish
-Prompt for a specific project and publish all files that belong to
-it.
-
-@item @kbd{C-c C-e P p} (@code{org-publish-current-project})
-@kindex C-c C-e P p
-@findex org-publish-current-project
-Publish the project containing the current file.
-
-@item @kbd{C-c C-e P f} (@code{org-publish-current-file})
-@kindex C-c C-e P f
-@findex org-publish-current-file
-Publish only the current file.
-
-@item @kbd{C-c C-e P a} (@code{org-publish-all})
-@kindex C-c C-e P a
-@findex org-publish-all
-Publish every project.
-@end table
-
-@vindex org-publish-use-timestamps-flag
-Org uses timestamps to track when a file has changed. The above
-functions normally only publish changed files. You can override this
-and force publishing of all files by giving a prefix argument to any
-of the commands above, or by customizing the variable
-@code{org-publish-use-timestamps-flag}. This may be necessary in
-particular if files include other files via @samp{SETUPFILE} or @samp{INCLUDE}
-keywords.
-
-@node Working with Source Code
-@chapter Working with Source Code
-
-@cindex source code, working with
-
-Source code here refers to any plain text collection of computer
-instructions, possibly with comments, written using a human-readable
-programming language. Org can manage source code in an Org document
-when the source code is identified with begin and end markers.
-Working with source code begins with identifying source code blocks.
-A source code block can be placed almost anywhere in an Org document;
-it is not restricted to the preamble or the end of the document.
-However, Org cannot manage a source code block if it is placed inside
-an Org comment or within a fixed width section.
-
-Here is an example source code block in the Emacs Lisp language:
-
-@example
-#+BEGIN_SRC emacs-lisp
- (defun org-xor (a b)
- "Exclusive or."
- (if a (not b) b))
-#+END_SRC
-@end example
-
-Source code blocks are one of many Org block types, which also include
-``center'', ``comment'', ``dynamic'', ``example'', ``export'', ``quote'',
-``special'', and ``verse''. This section pertains to blocks between
-@samp{#+BEGIN_SRC} and @samp{#+END_SRC}.
-
-Details of Org's facilities for working with source code are described
-in the following sections.
-
-@menu
-* Features Overview:: Enjoy the versatility of source blocks.
-* Structure of Code Blocks:: Code block syntax described.
-* Using Header Arguments:: Different ways to set header arguments.
-* Environment of a Code Block:: Arguments, sessions, working directory...
-* Evaluating Code Blocks:: Place results of evaluation in the Org buffer.
-* Results of Evaluation:: Choosing a results type, post-processing...
-* Exporting Code Blocks:: Export contents and/or results.
-* Extracting Source Code:: Create pure source code files.
-* Languages:: List of supported code block languages.
-* Editing Source Code:: Language major-mode editing.
-* Noweb Reference Syntax:: Literate programming in Org mode.
-* Library of Babel:: Use and contribute to a library of useful code blocks.
-* Key bindings and Useful Functions:: Work quickly with code blocks.
-* Batch Execution:: Call functions from the command line.
-@end menu
-
-@node Features Overview
-@section Features Overview
-
-Org can manage the source code in the block delimited by @samp{#+BEGIN_SRC}
-@dots{} @samp{#+END_SRC} in several ways that can simplify housekeeping tasks
-essential to modern source code maintenance. Org can edit, format,
-extract, export, and publish source code blocks. Org can also compile
-and execute a source code block, then capture the results. The Org
-mode literature sometimes refers to source code blocks as @emph{live code}
-blocks because they can alter the content of the Org document or the
-material that it exports. Users can control how live they want each
-source code block by tweaking the header arguments (see @ref{Using Header Arguments}) for compiling, execution, extraction, and exporting.
-
-For editing and formatting a source code block, Org uses an
-appropriate Emacs major mode that includes features specifically
-designed for source code in that language.
-
-Org can extract one or more source code blocks and write them to one
-or more source files---a process known as @emph{tangling} in literate
-programming terminology.
-
-For exporting and publishing, Org's back-ends can format a source code
-block appropriately, often with native syntax highlighting.
-
-For executing and compiling a source code block, the user can
-configure Org to select the appropriate compiler. Org provides
-facilities to collect the result of the execution or compiler output,
-insert it into the Org document, and/or export it. In addition to
-text results, Org can insert links to other data types, including
-audio, video, and graphics. Org can also link a compiler error
-message to the appropriate line in the source code block.
-
-An important feature of Org's management of source code blocks is the
-ability to pass variables, functions, and results to one another using
-a common syntax for source code blocks in any language. Although most
-literate programming facilities are restricted to one language or
-another, Org's language-agnostic approach lets the literate programmer
-match each programming task with the appropriate computer language and
-to mix them all together in a single Org document. This
-interoperability among languages explains why Org's source code
-management facility was named @emph{Org Babel} by its originators, Eric
-Schulte and Dan Davison.
-
-Org mode fulfills the promise of easy verification and maintenance of
-publishing reproducible research by keeping text, data, code,
-configuration settings of the execution environment, the results of
-the execution, and associated narratives, claims, references, and
-internal and external links in a single Org document.
-
-@node Structure of Code Blocks
-@section Structure of Code Blocks
-
-@cindex code block, structure
-@cindex source code, block structure
-@cindex @samp{NAME} keyword, in source blocks
-@cindex @samp{BEGIN_SRC}
-
-Org offers two ways to structure source code in Org documents: in
-a source code block, and directly inline. Both specifications are
-shown below.
-
-A source code block conforms to this structure:
-
-@example
-#+NAME: <name>
-#+BEGIN_SRC <language> <switches> <header arguments>
- <body>
-#+END_SRC
-@end example
-
-Do not be put-off by having to remember the source block syntax. Org
-mode offers a command for wrapping existing text in a block (see
-@ref{Structure Templates}). 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.
-
-@cindex source code, inline
-An inline code block conforms to this structure:
-
-@example
-src_<language>@{<body>@}
-@end example
-
-
-@noindent
-or
-
-@example
-src_<language>[<header arguments>]@{<body>@}
-@end example
-
-
-@table @asis
-@item @samp{#+NAME: <name>}
-Optional. Names the source block so it can be called, like
-a function, from other source blocks or inline code to evaluate or
-to capture the results. Code from other blocks, other files, and
-from table formulas (see @ref{The Spreadsheet}) can use the name to
-reference a source 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.
-
-@item @samp{#+BEGIN_SRC} @dots{} @samp{#+END_SRC}
-Mandatory. They mark the start and end of a block that Org
-requires. The @samp{#+BEGIN_SRC} line takes additional arguments, as
-described next.
-
-@item @samp{<language>}
-@cindex language, in code blocks
-Mandatory. It is the identifier of the source code language in the
-block. See @ref{Languages}, for identifiers of supported languages.
-
-@item @samp{<switches>}
-@cindex switches, in code blocks
-Optional. Switches provide finer control of the code execution,
-export, and format (see the discussion of switches in @ref{Literal Examples}).
-
-@item @samp{<header arguments>}
-@cindex header arguments, in code blocks
-Optional. Heading arguments control many aspects of evaluation,
-export and tangling of code blocks (see @ref{Using 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 @samp{<body>}
-Source code in the dialect of the specified language identifier.
-@end table
-
-@node Using Header Arguments
-@section Using Header Arguments
-
-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 source code blocks. A header argument is
-specified with an initial colon followed by the argument's name in
-lowercase.
-
-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.
-
-@anchor{System-wide header arguments}
-@subheading System-wide header arguments
-
-@vindex org-babel-default-header-args
-
-@vindex org-babel-default-header-args
-System-wide values of header arguments can be specified by customizing
-the @code{org-babel-default-header-args} variable, which defaults to the
-following values:
-
-@example
-:session => "none"
-:results => "replace"
-:exports => "code"
-:cache => "no"
-:noweb => "no"
-@end example
-
-The example below sets @samp{:noweb} header arguments to @samp{yes}, which makes
-Org expand @samp{:noweb} references by default.
-
-@lisp
-(setq org-babel-default-header-args
- (cons '(:noweb . "yes")
- (assq-delete-all :noweb org-babel-default-header-args)))
-@end lisp
-
-@cindex language specific default header arguments
-@cindex default header arguments per language
-Each language can have separate default header arguments by
-customizing the variable @code{org-babel-default-header-args:<LANG>}, where
-@var{<LANG>} is the name of the language. For details, see the
-language-specific online documentation at
-@uref{https://orgmode.org/worg/org-contrib/babel/}.
-
-@anchor{Header arguments in Org mode properties}
-@subheading Header arguments in Org mode properties
-
-For header arguments applicable to the buffer, use @samp{PROPERTY} keyword
-anywhere in the Org file (see @ref{Property Syntax}).
-
-The following example makes all the R code blocks execute in the same
-session. Setting @samp{:results} to @samp{silent} ignores the results of
-executions for all blocks, not just R code blocks; no results inserted
-for any block.
-
-@example
-#+PROPERTY: header-args:R :session *R*
-#+PROPERTY: header-args :results silent
-@end example
-
-@vindex org-use-property-inheritance
-Header arguments set through Org's property drawers (see @ref{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 this example, @samp{:cache} defaults to @samp{yes} for all code blocks in the
-sub-tree.
-
-@example
-* sample header
- :PROPERTIES:
- :header-args: :cache yes
- :END:
-@end example
-
-@kindex C-c C-x p
-@findex org-set-property
-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}.
-
-@cindex language specific header arguments properties
-@cindex header arguments per language
-Language-specific header arguments are also read from properties
-@samp{header-args:<LANG>} where @var{<LANG>} is the language
-identifier. For example,
-
-@example
-* Heading
- :PROPERTIES:
- :header-args:clojure: :session *clojure-1*
- :header-args:R: :session *R*
- :END:
-** Subheading
- :PROPERTIES:
- :header-args:clojure: :session *clojure-2*
- :END:
-@end example
-
-@noindent
-would force separate sessions for Clojure blocks in @samp{Heading} and
-@samp{Subheading}, but use the same session for all R blocks. Blocks in
-@samp{Subheading} inherit settings from @samp{Heading}.
-
-@anchor{Code block specific header arguments}
-@subheading Code block specific header arguments
-
-Header arguments are most commonly set at the source code block level,
-on the @samp{#+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 @samp{:results} to @samp{silent} makes it
-ignore results of the code execution. Setting @samp{:exports} to @samp{code}
-exports only the body of the code block to HTML or @LaTeX{}.
-
-@example
-#+NAME: factorial
-#+BEGIN_SRC haskell :results silent :exports code :var n=0
- fac 0 = 1
- fac n = n * fac (n-1)
-#+END_SRC
-@end example
-
-The same header arguments in an inline code block:
-
-@example
-src_haskell[:exports both]@{fac 5@}
-@end example
-
-
-@cindex @samp{HEADER}, keyword
-Code block header arguments can span multiple lines using @samp{#+HEADER:}
-on each line. Note that Org currently accepts the plural spelling of
-@samp{#+HEADER:} only as a convenience for backward-compatibility. It may
-be removed at some point.
-
-Multi-line header arguments on an unnamed code block:
-
-@example
-#+HEADER: :var data1=1
-#+BEGIN_SRC emacs-lisp :var data2=2
- (message "data1:%S, data2:%S" data1 data2)
-#+END_SRC
-
-#+RESULTS:
-: data1:1, data2:2
-@end example
-
-Multi-line header arguments on a named code block:
-
-@example
-#+NAME: named-block
-#+HEADER: :var data=2
-#+BEGIN_SRC emacs-lisp
- (message "data:%S" data)
-#+END_SRC
-
-#+RESULTS: named-block
- : data:2
-@end example
-
-@anchor{Header arguments in function calls}
-@subheading Header arguments in function calls
-
-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 @samp{#+CALL:} examples are shown below. For the complete
-syntax of @samp{CALL} keyword, see @ref{Evaluating Code Blocks}.
-
-In this example, @samp{:exports results} header argument is applied to the
-evaluation of the @samp{#+CALL:} line.
-
-@example
-#+CALL: factorial(n=5) :exports results
-@end example
-
-
-In this example, @samp{:session special} header argument is applied to the
-evaluation of @samp{factorial} code block.
-
-@example
-#+CALL: factorial[:session special](n=5)
-@end example
-
-@node Environment of a Code Block
-@section Environment of a Code Block
-
-
-
-@anchor{Passing arguments}
-@subheading Passing arguments
-
-@cindex passing arguments to code blocks
-@cindex arguments, in code blocks
-@cindex @samp{var}, header argument
-Use @samp{var} for passing arguments to source code blocks. The specifics
-of variables in code blocks vary by the source language and are
-covered in the language-specific documentation. The syntax for @samp{var},
-however, is the same for all languages. This includes declaring
-a variable, and assigning a default value.
-
-The following syntax is used to pass arguments to code blocks using
-the @samp{var} header argument.
-
-@example
-:var NAME=ASSIGN
-@end example
-
-
-@noindent
-@var{NAME} is the name of the variable bound in the code block
-body. @var{ASSIGN} is a literal value, such as a string,
-a number, a reference to a table, a list, a literal example, another
-code block---with or without arguments---or the results of evaluating
-a code block.
-
-Here are examples of passing values by reference:
-
-@table @asis
-@item table
-A table named with a @samp{NAME} keyword.
-
-@example
-#+NAME: example-table
-| 1 |
-| 2 |
-| 3 |
-| 4 |
-
-#+NAME: table-length
-#+BEGIN_SRC emacs-lisp :var table=example-table
- (length table)
-#+END_SRC
-
-#+RESULTS: table-length
-: 4
-@end example
-
-When passing a table, you can treat specially the row, or the
-column, containing labels for the columns, or the rows, in the
-table.
-
-@cindex @samp{colnames}, header argument
-The @samp{colnames} header argument accepts @samp{yes}, @samp{no}, or @samp{nil} values.
-The default value is @samp{nil}: if an input table has column
-names---because the second row is a horizontal rule---then Org
-removes the column names, processes the table, puts back the column
-names, and then writes the table to the results block. Using @samp{yes},
-Org does the same to the first row, even if the initial table does
-not contain any horizontal rule. When set to @samp{no}, Org does not
-pre-process column names at all.
-
-@example
-#+NAME: less-cols
-| a |
-|---|
-| b |
-| c |
-
-#+BEGIN_SRC python :var tab=less-cols :colnames nil
- return [[val + '*' for val in row] for row in tab]
-#+END_SRC
-
-#+RESULTS:
-| a |
-|----|
-| b* |
-| c* |
-@end example
-
-@cindex @samp{rownames}, header argument
-Similarly, the @samp{rownames} header argument can take two values: @samp{yes}
-or @samp{no}. When set to @samp{yes}, Org removes the first column, processes
-the table, puts back the first column, and then writes the table to
-the results block. The default is @samp{no}, which means Org does not
-pre-process the first column. Note that Emacs Lisp code blocks
-ignore @samp{rownames} header argument because of the ease of
-table-handling in Emacs.
-
-@example
-#+NAME: with-rownames
-| one | 1 | 2 | 3 | 4 | 5 |
-| two | 6 | 7 | 8 | 9 | 10 |
-
-#+BEGIN_SRC python :var tab=with-rownames :rownames yes
- return [[val + 10 for val in row] for row in tab]
-#+END_SRC
-
-#+RESULTS:
-| one | 11 | 12 | 13 | 14 | 15 |
-| two | 16 | 17 | 18 | 19 | 20 |
-@end example
-
-@item list
-A simple named list.
-
-@example
-#+NAME: example-list
-- simple
- - not
- - nested
-- list
-
-#+BEGIN_SRC emacs-lisp :var x=example-list
- (print x)
-#+END_SRC
-
-#+RESULTS:
-| simple | list |
-@end example
-
-Note that only the top level list items are passed along. Nested
-list items are ignored.
-
-@item code block without arguments
-A code block name, as assigned by @samp{NAME} keyword from the example
-above, optionally followed by parentheses.
-
-@example
-#+BEGIN_SRC emacs-lisp :var length=table-length()
- (* 2 length)
-#+END_SRC
-
-#+RESULTS:
-: 8
-@end example
-
-@item code block with arguments
-A code block name, as assigned by @samp{NAME} keyword, followed by
-parentheses and optional arguments passed within the parentheses.
-
-@example
-#+NAME: double
-#+BEGIN_SRC emacs-lisp :var input=8
- (* 2 input)
-#+END_SRC
-
-#+RESULTS: double
-: 16
-
-#+NAME: squared
-#+BEGIN_SRC emacs-lisp :var input=double(input=1)
- (* input input)
-#+END_SRC
-
-#+RESULTS: squared
-: 4
-@end example
-
-@item literal example
-A literal example block named with a @samp{NAME} keyword.
-
-@example
-#+NAME: literal-example
-#+BEGIN_EXAMPLE
- A literal example
- on two lines
-#+END_EXAMPLE
-
-#+NAME: read-literal-example
-#+BEGIN_SRC emacs-lisp :var x=literal-example
- (concatenate #'string x " for you.")
-#+END_SRC
-
-#+RESULTS: read-literal-example
-: A literal example
-: on two lines for you.
-@end example
-@end table
-
-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 commas then each subsequent section
-indexes as the next dimension. Note that this indexing occurs
-@emph{before} other table-related header arguments are applied, such as
-@samp{hlines}, @samp{colnames} and @samp{rownames}. The following example assigns
-the last cell of the first row the table @samp{example-table} to the
-variable @samp{data}:
-
-@example
-#+NAME: example-table
-| 1 | a |
-| 2 | b |
-| 3 | c |
-| 4 | d |
-
-#+BEGIN_SRC emacs-lisp :var data=example-table[0,-1]
- data
-#+END_SRC
-
-#+RESULTS:
-: a
-@end example
-
-Two integers separated by a colon reference a range of variable
-values. In that case the entire inclusive range is referenced. For
-example the following assigns the middle three rows of @samp{example-table}
-to @samp{data}.
-
-@example
-#+NAME: example-table
-| 1 | a |
-| 2 | b |
-| 3 | c |
-| 4 | d |
-| 5 | 3 |
-
-#+BEGIN_SRC emacs-lisp :var data=example-table[1:3]
- data
-#+END_SRC
-
-#+RESULTS:
-| 2 | b |
-| 3 | c |
-| 4 | d |
-@end example
-
-To pick the entire range, use an empty index, or the single character
-@samp{*}. @samp{0:-1} does the same thing. Example below shows how to
-reference the first column only.
-
-@example
-#+NAME: example-table
-| 1 | a |
-| 2 | b |
-| 3 | c |
-| 4 | d |
-
-#+BEGIN_SRC emacs-lisp :var data=example-table[,0]
- data
-#+END_SRC
-
-#+RESULTS:
-| 1 | 2 | 3 | 4 |
-@end 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
-#+BEGIN_SRC emacs-lisp
- '(((1 2 3) (4 5 6) (7 8 9))
- ((10 11 12) (13 14 15) (16 17 18))
- ((19 20 21) (22 23 24) (25 26 27)))
-#+END_SRC
-
-#+BEGIN_SRC emacs-lisp :var data=3D[1,,1]
- data
-#+END_SRC
-
-#+RESULTS:
-| 11 | 14 | 17 |
-@end example
-
-Note that row names and column names are not removed prior to variable
-indexing. You need to take them into account, even when @samp{colnames} or
-@samp{rownames} header arguments remove them.
-
-Emacs lisp code can also set the values for variables. To
-differentiate a value from Lisp code, Org interprets any value
-starting with @samp{(}, @samp{[}, @samp{'} or @samp{`} 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 the 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
- wc -w $filename
-#+END_SRC
-@end example
-
-Note that values read from tables and lists are not mistakenly
-evaluated as Emacs Lisp code, as illustrated in the following example.
-
-@example
-#+NAME: table
-| (a b c) |
-
-#+HEADER: :var data=table[0,0]
-#+BEGIN_SRC perl
- $data
-#+END_SRC
-
-#+RESULTS:
-: (a b c)
-@end example
-
-@anchor{Using sessions}
-@subheading Using sessions
-
-@cindex using sessions in code blocks
-@cindex @samp{session}, header argument
-Two code blocks can share the same environment. The @samp{session} header
-argument is for running multiple source code blocks under one session.
-Org runs code blocks with the same session name in the same
-interpreter process.
-
-@table @asis
-@item @samp{none}
-Default. Each code block gets a new interpreter process to execute.
-The process terminates once the block is evaluated.
-
-@item @var{STRING}
-Any string besides @samp{none} turns that string into the name of that
-session. For example, @samp{:session STRING} names it @samp{STRING}. If
-@samp{session} has no value, 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 table
-
-Only languages that provide interactive evaluation can have session
-support. Not all languages provide this support, such as C and ditaa.
-Even languages, such as Python and Haskell, that do support
-interactive evaluation impose limitations on allowable language
-constructs that can run interactively. Org inherits those limitations
-for those code blocks running in a session.
-
-@anchor{Choosing a working directory}
-@subheading Choosing a working directory
-
-@cindex working directory, in a code block
-@cindex @samp{dir}, header argument
-@cindex @samp{mkdirp}, header argument
-The @samp{dir} header argument 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 @samp{:dir
-DIRECTORY} temporarily has the same effect as changing the current
-directory with @kbd{M-x cd @key{RET} DIRECTORY}, and then not setting
-@samp{dir}. Under the surface, @samp{dir} simply sets the value of the Emacs
-variable @code{default-directory}. Setting @samp{mkdirp} header argument to
-a non-@code{nil} value creates the directory, if necessary.
-
-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
- matplot(matrix(rnorm(100), 10), type="l")
-#+END_SRC
-@end example
-
-To evaluate the code block on a remote machine, supply a remote
-directory name using Tramp syntax. For example:
-
-@example
-#+BEGIN_SRC R :file plot.png :dir /scp:dand@@yakuba.princeton.edu:
- plot(1:10, main=system("hostname", intern=TRUE))
-#+END_SRC
-@end example
-
-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 Tramp. Org constructs the remote path to the file name from
-@samp{dir} and @code{default-directory}, as illustrated here:
-
-@example
-[[file:/scp:dand@@yakuba.princeton.edu:/home/dand/plot.png][plot.png]]
-@end example
-
-
-When @samp{dir} is used with @samp{session}, Org sets the starting directory for
-a new session. But Org does not alter the directory of an already
-existing session.
-
-Do not use @samp{dir} with @samp{:exports results} or with @samp{: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.
-
-@anchor{Inserting headers and footers}
-@subheading Inserting headers and footers
-
-@cindex headers, in code blocks
-@cindex footers, in code blocks
-@cindex @samp{prologue}, header argument
-The @samp{prologue} header argument is for appending to the top of the code
-block for execution, like a reset instruction. For example, you may
-use @samp{:prologue "reset"} in a Gnuplot code block or, for every such
-block:
-
-@lisp
-(add-to-list 'org-babel-default-header-args:gnuplot
- '((:prologue . "reset")))
-
-@end lisp
-
-@cindex @samp{epilogue}, header argument
-Likewise, the value of the @samp{epilogue} header argument is for appending
-to the end of the code block for execution.
-
-@node Evaluating Code Blocks
-@section Evaluating Code Blocks
-
-@cindex code block, evaluating
-@cindex source code, evaluating
-@cindex @samp{RESULTS}, keyword
-
-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}.
-
-@anchor{How to evaluate source code}
-@subheading How to evaluate source code
-
-Org captures the results of the code block evaluation and inserts them
-in the Org file, right after the code block. The insertion point is
-after a newline and the @samp{RESULTS} keyword. Org creates the @samp{RESULTS}
-keyword if one is not already there.
-
-By default, Org enables only Emacs Lisp code blocks for execution.
-See @ref{Languages} to enable other languages.
-
-@kindex C-c C-c
-@kindex C-c C-v e
-@findex org-babel-execute-src-block
-Org provides many ways to execute code blocks. @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.} 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.
-
-@cindex @samp{CALL}, keyword
-@vindex org-babel-inline-result-wrap
-By calling a named code block@footnote{Actually, the constructs @samp{call_<name>()} and @samp{src_<lang>@{@}}
-are not evaluated when they appear in a keyword (see @ref{In-buffer Settings}).} from an Org mode buffer or
-a table. Org can call the named code blocks from the current Org mode
-buffer or from the ``Library of Babel'' (see @ref{Library of Babel}).
-
-The syntax for @samp{CALL} keyword is:
-
-@example
-#+CALL: <name>(<arguments>)
-#+CALL: <name>[<inside header arguments>](<arguments>) <end header arguments>
-@end example
-
-The syntax for inline named code blocks is:
-
-@example
-... call_<name>(<arguments>) ...
-... call_<name>[<inside header arguments>](<arguments>)[<end header arguments>] ...
-@end example
-
-When inline 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.
-
-@table @asis
-@item @samp{<name>}
-This is the name of the code block (see @ref{Structure of Code Blocks})
-to be evaluated in the current document. If the block is located in
-another file, start @samp{<name>} with the file name followed by
-a colon. For example, in order to execute a block named @samp{clear-data}
-in @samp{file.org}, you can write the following:
-
-@example
-#+CALL: file.org:clear-data()
-@end example
-
-@item @samp{<arguments>}
-Org passes arguments to the code block using standard function call
-syntax. For example, a @samp{#+CALL:} line that passes @samp{4} to a code
-block named @samp{double}, which declares the header argument @samp{:var n=2},
-would be written as:
-
-@example
-#+CALL: double(n=4)
-@end example
-
-
-@noindent
-Note how this function call syntax is different from the header
-argument syntax.
-
-@item @samp{<inside header arguments>}
-Org passes inside header arguments to the named code block using the
-header argument syntax. Inside header arguments apply to code block
-evaluation. For example, @samp{[:results output]} collects results
-printed to stdout during code execution of that block. Note how
-this header argument syntax is different from the function call
-syntax.
-
-@item @samp{<end header arguments>}
-End header arguments affect the results returned by the code block.
-For example, @samp{:results html} wraps the results in a @samp{#+BEGIN_EXPORT
- html} block before inserting the results in the Org buffer.
-@end table
-
-@anchor{Limit code block evaluation}
-@subheading Limit code block evaluation
-
-@cindex @samp{eval}, header argument
-@cindex control code block evaluation
-The @samp{eval} header argument can limit evaluation of specific code
-blocks and @samp{CALL} keyword. It is useful for protection against
-evaluating untrusted code blocks by prompting for a confirmation.
-
-@table @asis
-@item @samp{never} or @samp{no}
-Org never evaluates the source code.
-
-@item @samp{query}
-Org prompts the user for permission to evaluate the source code.
-
-@item @samp{never-export} or @samp{no-export}
-Org does not evaluate the source code when exporting, yet the user
-can evaluate it interactively.
-
-@item @samp{query-export}
-Org prompts the user for permission to evaluate the source code
-during export.
-@end table
-
-If @samp{eval} header argument is not set, then Org determines whether to
-evaluate the source code from the @code{org-confirm-babel-evaluate}
-variable (see @ref{Code Evaluation Security}).
-
-@anchor{Cache results of evaluation}
-@subheading Cache results of evaluation
-
-@cindex @samp{cache}, header argument
-@cindex cache results of code evaluation
-The @samp{cache} header argument is for caching results of evaluating code
-blocks. Caching results can avoid re-evaluating a code block 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 @samp{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 code blocks are pure functions,
-that is functions that return the same value for the same input
-arguments (see @ref{Environment of a Code Block}), 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 @samp{cache} is used in a session, caching may
-cause unexpected results.
-
-When the caching mechanism tests for any source code changes, it does
-not expand noweb style references (see @ref{Noweb Reference Syntax}).
-
-The @samp{cache} header argument can have one of two values: @samp{yes} or @samp{no}.
-
-@table @asis
-@item @samp{no}
-Default. No caching of results; code block evaluated every time.
-
-@item @samp{yes}
-Whether to run the code or return the cached results is determined
-by comparing the SHA1 hash value of the combined code block and
-arguments passed to it. This hash value is packed on the
-@samp{#+RESULTS:} line from previous evaluation. When hash values match,
-Org does not evaluate the code block. When hash values mismatch,
-Org evaluates the code block, inserts the results, recalculates the
-hash value, and updates @samp{#+RESULTS:} line.
-@end table
-
-In this example, both functions are cached. But @samp{caller} runs only if
-the result from @samp{random} has changed since the last run.
-
-@example
-#+NAME: random
-#+BEGIN_SRC R :cache yes
- runif(1)
-#+END_SRC
-
-#+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random
-0.4659510825295
-
-#+NAME: caller
-#+BEGIN_SRC emacs-lisp :var x=random :cache yes
- x
-#+END_SRC
-
-#+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller
-0.254227238707244
-@end example
-
-@node Results of Evaluation
-@section Results of Evaluation
-
-@cindex code block, results of evaluation
-@cindex source code, results of evaluation
-
-@cindex @samp{results}, header argument
-How Org handles results of a code block execution depends on many
-header arguments working together. The primary determinant, however,
-is the @samp{results} header argument. It accepts four classes of options.
-Each code block can take only one option per class:
-
-@table @asis
-@item Collection
-For how the results should be collected from the code block;
-
-@item Type
-For which type of result the code block will return; affects how Org
-processes and inserts results in the Org buffer;
-
-@item Format
-For the result; affects how Org processes results;
-
-@item Handling
-For inserting results once they are properly formatted.
-@end table
-
-@anchor{Collection}
-@subheading Collection
-
-Collection options specify the results. Choose one of the options;
-they are mutually exclusive.
-
-@table @asis
-@item @samp{value}
-Default for most Babel libraries@footnote{Actually, the constructs @samp{call_<name>()} and @samp{src_<lang>@{@}}
-are not evaluated when they appear in a keyword (see @ref{In-buffer Settings}).}. Functional mode. Org
-gets the value by wrapping the code in a function definition in the
-language of the source block. That is why when using @samp{:results
- value}, code should execute like a function and return a value. For
-languages like Python, an explicit @code{return} statement is mandatory
-when using @samp{:results value}. Result is the value returned by the
-last statement in the code block.
-
-When evaluating the code block in a session (see @ref{Environment of a Code Block}), Org passes the code to an interpreter running as an
-interactive Emacs inferior process. Org gets the value from the
-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 Ruby, and the value of @code{.Last.value} in R@.
-
-@item @samp{output}
-Scripting mode. Org passes the code to an external process running
-the interpreter. Org returns the contents of the standard output
-stream as text results.
-
-When using a session, Org passes the code to the interpreter running
-as an interactive Emacs inferior process. Org concatenates any text
-output from the interpreter and returns the collection as a result.
-@end table
-
-@anchor{Type}
-@subheading Type
-
-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.
-
-@table @asis
-@item @samp{table}
-@itemx @samp{vector}
-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:
-@samp{:results value table}.
-
-@cindex @samp{hlines}, header argument
-In-between each table row or below the table headings, sometimes
-results have horizontal lines, which are also known as ``hlines''.
-The @samp{hlines} argument with the default @samp{no} value strips such lines
-from the input table. For most code, this is desirable, or else
-those @samp{hline} symbols raise unbound variable errors. A @samp{yes}
-accepts such lines, as demonstrated in the following example.
-
-@example
-#+NAME: many-cols
-| a | b | c |
-|---+---+---|
-| d | e | f |
-|---+---+---|
-| g | h | i |
-
-#+NAME: no-hline
-#+BEGIN_SRC python :var tab=many-cols :hlines no
- return tab
-#+END_SRC
-
-#+RESULTS: no-hline
-| a | b | c |
-| d | e | f |
-| g | h | i |
-
-#+NAME: hlines
-#+BEGIN_SRC python :var tab=many-cols :hlines yes
- return tab
-#+END_SRC
-
-#+RESULTS: hlines
-| a | b | c |
-|---+---+---|
-| d | e | f |
-|---+---+---|
-| g | h | i |
-@end example
-
-@item @samp{list}
-Interpret the results as an Org list. If the result is a single
-value, create a list of one element.
-
-@item @samp{scalar}
-@itemx @samp{verbatim}
-Interpret literally and insert as quoted text. Do not create
-a table. Usage example: @samp{:results value verbatim}.
-
-@item @samp{file}
-Interpret as a filename. Save the results of execution of the code
-block to that file, then insert a link to it. You can control both
-the filename and the description associated to the link.
-
-@cindex @samp{file}, header argument
-@cindex @samp{output-dir}, header argument
-Org first tries to generate the filename from the value of the
-@samp{file} header argument and the directory specified using the
-@samp{output-dir} header arguments. If @samp{output-dir} is not specified,
-Org assumes it is the current directory.
-
-@example
-#+BEGIN_SRC asymptote :results value file :file circle.pdf :output-dir img/
- size(2cm);
- draw(unitcircle);
-#+END_SRC
-@end example
-
-@cindex @samp{file-ext}, header argument
-If @samp{file} header argument is missing, Org generates the base name of
-the output file from the name of the code block, and its extension
-from the @samp{file-ext} header argument. In that case, both the name
-and the extension are mandatory.
-
-@example
-#+name: circle
-#+BEGIN_SRC asymptote :results value file :file-ext pdf
- size(2cm);
- draw(unitcircle);
-#+END_SRC
-@end example
-
-@cindex @samp{file-desc}, header argument
-The @samp{file-desc} header argument defines the description (see
-@ref{Link Format}) for the link. If @samp{file-desc} is present but has no value,
-the @samp{file} value is used as the link description. When this
-argument is not present, the description is omitted.
-
-@cindex @samp{sep}, header argument
-By default, Org assumes that a table written to a file has
-TAB-delimited output. You can choose a different separator with
-the @samp{sep} header argument.
-
-@cindex @samp{file-mode}, header argument
-The @samp{file-mode} header argument defines the file permissions. To
-make it executable, use @samp{:file-mode (identity #o755)}.
-
-@example
-#+BEGIN_SRC shell :results file :file script.sh :file-mode (identity #o755)
- echo "#!/bin/bash"
- echo "echo Hello World"
-#+END_SRC
-@end example
-@end table
-
-@anchor{Format}
-@subheading Format
-
-Format pertains to the type of the result returned by the code block.
-Choose one of the options; they are mutually exclusive. The default
-follows from the type specified above.
-
-@table @asis
-@item @samp{code}
-Result enclosed in a code block. Useful for parsing. Usage
-example: @samp{:results value code}.
-
-@item @samp{drawer}
-Result wrapped in a @samp{RESULTS} drawer. Useful for containing @samp{raw}
-or @samp{org} results for later scripting and automated processing.
-Usage example: @samp{:results value drawer}.
-
-@item @samp{html}
-Results enclosed in a @samp{BEGIN_EXPORT html} block. Usage example:
-@samp{:results value html}.
-
-@item @samp{latex}
-Results enclosed in a @samp{BEGIN_EXPORT latex} block. Usage example:
-@samp{:results value latex}.
-
-@item @samp{link}
-@itemx @samp{graphics}
-When used along with @samp{file} type, the result is a link to the file
-specified in @samp{:file} header argument. However, unlike plain @samp{file}
-type, nothing is written to the disk. The block is used for its
-side-effects only, as in the following example:
-
-@example
-#+begin_src shell :results file link :file "download.tar.gz"
-wget -c "http://example.com/download.tar.gz"
-#+end_src
-@end example
-
-@item @samp{org}
-Results enclosed in a @samp{BEGIN_SRC org} block. For comma-escape,
-either @kbd{@key{TAB}} in the block, or export the file. Usage
-example: @samp{:results value org}.
-
-@item @samp{pp}
-Result converted to pretty-print source code. Enclosed in a code
-block. Languages supported: Emacs Lisp, Python, and Ruby. Usage
-example: @samp{:results value pp}.
-
-@item @samp{raw}
-Interpreted as raw Org mode. Inserted directly into the buffer.
-Aligned if it is a table. Usage example: @samp{:results value raw}.
-@end table
-
-@cindex @samp{wrap}, header argument
-The @samp{wrap} header argument unconditionally marks the results block by
-appending strings to @samp{#+BEGIN_} and @samp{#+END_}. If no string is
-specified, Org wraps the results in a @samp{#+BEGIN_results}
-@dots{} @samp{#+END_results} block. It takes precedent over the @samp{results}
-value listed above. E.g.,
-
-@example
-#+BEGIN_SRC emacs-lisp :results html :wrap EXPORT markdown
-"<blink>Welcome back to the 90's</blink>"
-#+END_SRC
-
-#+RESULTS:
-#+BEGIN_EXPORT markdown
-<blink>Welcome back to the 90's</blink>
-#+END_EXPORT
-@end example
-
-@anchor{Handling}
-@subheading Handling
-
-Handling options after collecting the results.
-
-@table @asis
-@item @samp{silent}
-Do not insert results in the Org mode buffer, but echo them in the
-minibuffer. Usage example: @samp{:results output silent}.
-
-@item @samp{replace}
-Default. Insert results in the Org buffer. Remove previous
-results. Usage example: @samp{:results output replace}.
-
-@item @samp{append}
-Append results to the Org buffer. Latest results are at the bottom.
-Does not remove previous results. Usage example: @samp{:results output
- append}.
-
-@item @samp{prepend}
-Prepend results to the Org buffer. Latest results are at the top.
-Does not remove previous results. Usage example: @samp{:results output
- prepend}.
-@end table
-
-@anchor{Post-processing}
-@subheading Post-processing
-
-@cindex @samp{post}, header argument
-@cindex @samp{*this*}, in @samp{post} header argument
-The @samp{post} header argument is for post-processing results from block
-evaluation. When @samp{post} has any value, Org binds the results to
-@code{*this*} variable for easy passing to @samp{var} header argument
-specifications (see @ref{Environment of a Code Block}). That makes results
-available to other code blocks, or even for direct Emacs Lisp code
-execution.
-
-The following two examples illustrate @samp{post} header argument in
-action. The first one shows how to attach an @samp{ATTR_LATEX} keyword
-using @samp{post}.
-
-@example
-#+NAME: attr_wrap
-#+BEGIN_SRC sh :var data="" :var width="\\textwidth" :results output
- echo "#+ATTR_LATEX: :width $width"
- echo "$data"
-#+END_SRC
-
-#+HEADER: :file /tmp/it.png
-#+BEGIN_SRC dot :post attr_wrap(width="5cm", data=*this*) :results drawer
- digraph@{
- a -> b;
- b -> c;
- c -> a;
- @}
-#+end_src
-
-#+RESULTS:
-:RESULTS:
-#+ATTR_LATEX :width 5cm
-[[file:/tmp/it.png]]
-:END:
-@end example
-
-The second example shows use of @samp{colnames} header argument in @samp{post}
-to pass data between 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 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}. Org defaults to exporting @emph{code} for most
-languages. For some languages, such as ditaa, Org defaults to
-@emph{results}. To export just the body of code blocks, see @ref{Literal Examples}. To selectively export sub-trees of an Org document, see
-@ref{Exporting}.
-
-@cindex @samp{exports}, header argument
-The @samp{exports} header argument is to specify if that part of the Org
-file is exported to, say, HTML or @LaTeX{} formats.
-
-@table @asis
-@item @samp{code}
-The default. The body of code is included into the exported file.
-Example: @samp{:exports code}.
-
-@item @samp{results}
-The results of evaluation of the code is included in the exported
-file. Example: @samp{:exports results}.
-
-@item @samp{both}
-Both the code and results of evaluation are included in the exported
-file. Example: @samp{:exports both}.
-
-@item @samp{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: @samp{:exports none}.
-@end table
-
-@vindex org-export-use-babel
-To stop Org from evaluating code blocks to speed exports, use the
-header argument @samp{:eval never-export} (see @ref{Evaluating Code Blocks}).
-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 @samp{:eval never-export} (see @ref{Evaluating Code Blocks}).
-
-Org never evaluates code blocks in commented sub-trees when exporting
-(see @ref{Comment Lines}). On the other hand, Org does evaluate code
-blocks in sub-trees excluded from export (see @ref{Export Settings}).
-
-@node Extracting Source Code
-@section Extracting Source Code
-
-@cindex tangling
-@cindex source code, extracting
-@cindex code block, extracting source code
-
-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 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 code blocks, it expands, merges, and transforms them.
-Then Org recomposes them into one or more separate files, as
-configured through the options. During this tangling process, Org
-expands variables in the source code, and resolves any noweb style
-references (see @ref{Noweb Reference Syntax}).
-
-@anchor{Header arguments}
-@subheading Header arguments
-
-@cindex @samp{tangle}, header argument
-The @samp{tangle} header argument specifies if the code block is exported
-to source file(s).
-
-@table @asis
-@item @samp{yes}
-Export the 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: @samp{:tangle yes}.
-
-@item @samp{no}
-The default. Do not extract the code in a source code file.
-Example: @samp{:tangle no}.
-
-@item @var{FILENAME}
-Export the code block to source file whose file name is derived from
-any string passed to the @samp{tangle} header argument. Org derives the
-file name as being relative to the directory of the Org file's
-location. Example: @samp{:tangle FILENAME}.
-@end table
-
-@cindex @samp{mkdirp}, header argument
-The @samp{mkdirp} header argument creates parent directories for tangled
-files if the directory does not exist. A @samp{yes} value enables
-directory creation whereas @samp{no} inhibits it.
-
-@cindex @samp{comments}, header argument
-The @samp{comments} header argument controls inserting comments into
-tangled files. These are above and beyond whatever comments may
-already exist in the code block.
-
-@table @asis
-@item @samp{no}
-The default. Do not insert any extra comments during tangling.
-
-@item @samp{link}
-Wrap the code block in comments. Include links pointing back to the
-place in the Org file from where the code was tangled.
-
-@item @samp{yes}
-Kept for backward compatibility; same as @samp{link}.
-
-@item @samp{org}
-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 @samp{both}
-Includes both @samp{link} and @samp{org} options.
-
-@item @samp{noweb}
-Includes @samp{link} option, expands noweb references (see @ref{Noweb Reference Syntax}), and wraps them in link comments inside the body
-of the code block.
-@end table
-
-@cindex @samp{padline}, header argument
-The @samp{padline} header argument controls insertion of newlines to pad
-source code in the tangled file.
-
-@table @asis
-@item @samp{yes}
-Default. Insert a newline before and after each code block in the
-tangled file.
-
-@item @samp{no}
-Do not insert newlines to pad the tangled code blocks.
-@end table
-
-@cindex @samp{shebang}, header argument
-The @samp{shebang} header argument can turn results into executable script
-files. By setting it to a string value---for example, @samp{:shebang
-"#!/bin/bash"}---Org inserts that string as the first line of the
-tangled file that the code block is extracted to. Org then turns on
-the tangled file's executable permission.
-
-@cindex @samp{tangle-mode}, header argument
-The @samp{tangle-mode} header argument specifies what permissions to set
-for tangled files by @code{set-file-modes}. For example, to make
-a read-only tangled file, use @samp{:tangle-mode (identity #o444)}. To
-make it executable, use @samp{:tangle-mode (identity #o755)}. It also
-overrides executable permission granted by @samp{shebang}. When multiple
-source code blocks tangle to a single file with different and
-conflicting @samp{tangle-mode} header arguments, Org's behavior is
-undefined.
-
-@cindex @samp{no-expand}, header argument
-By default Org expands code blocks during tangling. The @samp{no-expand}
-header argument turns off such expansions. Note that one side-effect
-of expansion by @code{org-babel-expand-src-block} also assigns values (see
-@ref{Environment of a Code Block}) to variables. Expansions also replace
-noweb references with their targets (see @ref{Noweb Reference Syntax}).
-Some of these expansions may cause premature assignment, hence this
-option. This option makes a difference only for tangling. It has no
-effect when exporting since code blocks for execution have to be
-expanded anyway.
-
-@anchor{Functions}
-@subheading Functions
-
-@table @asis
-@item @code{org-babel-tangle}
-@findex org-babel-tangle
-@kindex C-c C-v t
-Tangle the current file. Bound to @kbd{C-c C-v t}.
-
-With prefix argument only tangle the current code block.
-
-@item @code{org-babel-tangle-file}
-@findex org-babel-tangle-file
-@kindex C-c C-v f
-Choose a file to tangle. Bound to @kbd{C-c C-v f}.
-@end table
-
-@anchor{Hooks (1)}
-@subheading Hooks
-
-@table @asis
-@item @code{org-babel-post-tangle-hook}
-@vindex org-babel-post-tangle-hook
-This hook is run from within code files tangled by
-@code{org-babel-tangle}, making it suitable for post-processing,
-compilation, and evaluation of code in the tangled files.
-@end table
-
-@anchor{Jumping between code and Org}
-@subheading Jumping between code and Org
-
-@findex org-babel-tangle-jump-to-org
-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:
-
-@enumerate
-@item
-Set @samp{padline} to true---this is the default setting.
-@item
-Set @samp{comments} to @samp{link}, which makes Org insert links to the Org
-file.
-@end enumerate
-
-@node Languages
-@section Languages
-
-@cindex babel, languages
-@cindex source code, languages
-@cindex code block, languages
-
-Code blocks in the following languages are supported.
-
-@multitable @columnfractions 0.25 0.25 0.25 0.20
-@headitem Language
-@tab Identifier
-@tab Language
-@tab Identifier
-@item Asymptote
-@tab @samp{asymptote}
-@tab Lisp
-@tab @samp{lisp}
-@item Awk
-@tab @samp{awk}
-@tab Lua
-@tab @samp{lua}
-@item C
-@tab @samp{C}
-@tab MATLAB
-@tab @samp{matlab}
-@item C++
-@tab @samp{C++}@footnote{C++ language is handled in @samp{ob-C.el}. Even though the
-identifier for such source blocks is @samp{C++}, you activate it by loading
-the C language.}
-@tab Mscgen
-@tab @samp{mscgen}
-@item Clojure
-@tab @samp{clojure}
-@tab Objective Caml
-@tab @samp{ocaml}
-@item CSS
-@tab @samp{css}
-@tab Octave
-@tab @samp{octave}
-@item D
-@tab @samp{D}@footnote{D language is handled in @samp{ob-C.el}. Even though the
-identifier for such source blocks is @samp{D}, you activate it by loading
-the C language.}
-@tab Org mode
-@tab @samp{org}
-@item ditaa
-@tab @samp{ditaa}
-@tab Oz
-@tab @samp{oz}
-@item Emacs Calc
-@tab @samp{calc}
-@tab Perl
-@tab @samp{perl}
-@item Emacs Lisp
-@tab @samp{emacs-lisp}
-@tab Plantuml
-@tab @samp{plantuml}
-@item Eshell
-@tab @samp{eshell}
-@tab Processing.js
-@tab @samp{processing}
-@item Fortran
-@tab @samp{fortran}
-@tab Python
-@tab @samp{python}
-@item Gnuplot
-@tab @samp{gnuplot}
-@tab R
-@tab @samp{R}
-@item GNU Screen
-@tab @samp{screen}
-@tab Ruby
-@tab @samp{ruby}
-@item Graphviz
-@tab @samp{dot}
-@tab Sass
-@tab @samp{sass}
-@item Haskell
-@tab @samp{haskell}
-@tab Scheme
-@tab @samp{scheme}
-@item Java
-@tab @samp{java}
-@tab Sed
-@tab @samp{sed}
-@item Javascript
-@tab @samp{js}
-@tab shell
-@tab @samp{sh}
-@item @LaTeX{}
-@tab @samp{latex}
-@tab SQL
-@tab @samp{sql}
-@item Ledger
-@tab @samp{ledger}
-@tab SQLite
-@tab @samp{sqlite}
-@item Lilypond
-@tab @samp{lilypond}
-@tab Vala
-@tab @samp{vala}
-@end multitable
-
-Additional documentation for some languages is at
-@uref{https://orgmode.org/worg/org-contrib/babel/languages.html}.
-
-@vindex org-babel-load-languages
-By default, only 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.
-
-In this example, evaluation is disabled for Emacs Lisp, and enabled
-for R@.
-
-@lisp
-(org-babel-do-load-languages
- 'org-babel-load-languages
- '((emacs-lisp . nil)
- (R . t)))
-@end lisp
-
-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 Clojure code blocks:
-
-@lisp
-(require 'ob-clojure)
-@end lisp
-
-@node Editing Source Code
-@section Editing Source Code
-
-@cindex code block, editing
-@cindex source code, editing
-
-@kindex C-c '
-Use @kbd{C-c '} to edit the current code block. It opens a new
-major mode edit buffer containing the body of the source code block,
-ready for any edits. Use @kbd{C-c '} again to close the buffer
-and return to the Org buffer.
-
-@kindex C-x C-s
-@vindex org-edit-src-auto-save-idle-delay
-@cindex auto-save, in code block editing
-@kbd{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 Auto-save mode.
-
-While editing the source code in the major mode, the Org Src 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 @asis
-@item @code{org-src-lang-modes}
-@vindex org-src-lang-modes
-If an Emacs major-mode named @code{<LANG>-mode} exists, where
-@var{<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 @code{org-src-window-setup}
-@vindex org-src-window-setup
-For specifying Emacs window arrangement when the new edit buffer is
-created.
-
-@item @code{org-src-preserve-indentation}
-@cindex indentation, in code blocks
-@vindex org-src-preserve-indentation
-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 @code{org-src-ask-before-returning-to-edit-buffer}
-@vindex org-src-ask-before-returning-to-edit-buffer
-When @code{nil}, Org returns to the edit buffer without further prompts.
-The default prompts for a confirmation.
-@end table
-
-@vindex org-src-fontify-natively
-@vindex org-src-block-faces
-Set @code{org-src-fontify-natively} to non-@code{nil} to turn on native code
-fontification in the @emph{Org} buffer. Fontification of 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))
-
-(setq org-src-block-faces '(("emacs-lisp" (:background "#EEE2FF"))
- ("python" (:background "#E5FFB8"))))
-@end lisp
-
-@node Noweb Reference Syntax
-@section Noweb Reference Syntax
-
-@cindex code block, noweb reference
-@cindex syntax, noweb
-@cindex source code, noweb reference
-
-@cindex @samp{noweb-ref}, header argument
-Source code blocks can include references to other source code blocks,
-using a noweb@footnote{For noweb literate programming details, see
-@uref{http://www.cs.tufts.edu/~nr/noweb/}.} style syntax:
-
-@example
-<<CODE-BLOCK-ID>>
-@end example
-
-
-@noindent
-where @var{CODE-BLOCK-ID} refers to either the @samp{NAME} of a single
-source code block, or a collection of one or more source code blocks
-sharing the same @samp{noweb-ref} header argument (see @ref{Using Header Arguments}). Org can replace such references with the source code of
-the block or blocks being referenced, or, in the case of a single
-source code block named with @samp{NAME}, with the results of an evaluation
-of that block.
-
-@cindex @samp{noweb}, header argument
-The @samp{noweb} header argument controls expansion of noweb syntax
-references. Expansions occur when source code blocks are evaluated,
-tangled, or exported.
-
-@table @asis
-@item @samp{no}
-Default. No expansion of noweb syntax references in the body of the
-code when evaluating, tangling, or exporting.
-
-@item @samp{yes}
-Expansion of noweb syntax references in the body of the code block
-when evaluating, tangling, or exporting.
-
-@item @samp{tangle}
-Expansion of noweb syntax references in the body of the code block
-when tangling. No expansion when evaluating or exporting.
-
-@item @samp{no-export}
-Expansion of noweb syntax references in the body of the code block
-when evaluating or tangling. No expansion when exporting.
-
-@item @samp{strip-export}
-Expansion of noweb syntax references in the body of the code block
-when expanding prior to evaluating or tangling. Removes noweb
-syntax references when exporting.
-
-@item @samp{eval}
-Expansion of noweb syntax references in the body of the code block
-only before evaluating.
-@end table
-
-In the most simple case, the contents of a single source block is
-inserted within other blocks. Thus, in following example,
-
-@example
-#+NAME: initialization
-#+BEGIN_SRC emacs-lisp
- (setq sentence "Never a foot too far, even.")
-#+END_SRC
-
-#+BEGIN_SRC emacs-lisp :noweb yes
- <<initialization>>
- (reverse sentence)
-#+END_SRC
-@end example
-
-@noindent
-the second code block is expanded as
-
-@example
-#+BEGIN_SRC emacs-lisp :noweb yes
- (setq sentence "Never a foot too far, even.")
- (reverse sentence)
-#+END_SRC
-@end example
-
-You may also include the contents of multiple blocks sharing a common
-@samp{noweb-ref} header argument, which can be set at the file, sub-tree,
-or code block level. In the example Org file shown next, the body of
-the source code in each block is extracted for concatenation to a pure
-code file when tangled.
-
-@example
-#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh
- <<fullest-disk>>
-#+END_SRC
-* the mount point of the fullest disk
- :PROPERTIES:
- :header-args: :noweb-ref fullest-disk
- :END:
-
-** query all mounted disks
-#+BEGIN_SRC sh
- df \
-#+END_SRC
-
-** strip the header row
-#+BEGIN_SRC sh
- |sed '1d' \
-#+END_SRC
-
-** output mount point of fullest disk
-#+BEGIN_SRC sh
- |awk '@{if (u < +$5) @{u = +$5; m = $6@}@} END @{print m@}'
-#+END_SRC
-@end example
-
-@cindex @samp{noweb-sep}, header argument
-By default a newline separates each noweb reference concatenation. To
-use a different separator, edit the @samp{noweb-sep} header argument.
-
-Alternatively, Org can include the results of evaluation of a single
-code block rather than its body. Evaluation occurs when parentheses,
-possibly including arguments, are appended to the code block name, as
-shown below.
-
-@example
-<<NAME(optional arguments)>>
-@end example
-
-
-Note that in this case, a code block name set by @samp{NAME} keyword is
-required; the reference set by @samp{noweb-ref} will not work when
-evaluation is desired.
-
-Here is an example that demonstrates how the exported content changes
-when noweb style references are used with parentheses versus without.
-Given:
-
-@example
-#+NAME: some-code
-#+BEGIN_SRC python :var num=0 :results output :exports none
- print(num*10)
-#+END_SRC
-@end example
-
-@noindent
-this code block:
-
-@example
-#+BEGIN_SRC text :noweb yes
- <<some-code>>
-#+END_SRC
-@end example
-
-@noindent
-expands to:
-
-@example
-print(num*10)
-@end example
-
-
-Below, a similar noweb style reference is used, but with parentheses,
-while setting a variable @samp{num} to 10:
-
-@example
-#+BEGIN_SRC text :noweb yes
- <<some-code(num=10)>>
-#+END_SRC
-@end example
-
-@noindent
-Note that the expansion now contains the results of the code block
-@samp{some-code}, not the code block itself:
-
-@example
-100
-@end example
-
-
-Noweb insertions honor prefix characters that appear before the noweb
-syntax reference. This behavior is illustrated in the following
-example. Because the @samp{<<example>>} noweb reference appears behind the
-SQL comment syntax, each line of the expanded noweb reference is
-commented. With:
-
-@example
-#+NAME: example
-#+BEGIN_SRC text
- this is the
- multi-line body of example
-#+END_SRC
-@end example
-
-@noindent
-this code block:
-
-@example
-#+BEGIN_SRC sql :noweb yes
- ---<<example>>
-#+END_SRC
-@end example
-
-@noindent
-expands to:
-
-@example
-#+BEGIN_SRC sql :noweb yes
- ---this is the
- ---multi-line body of example
-#+END_SRC
-@end example
-
-Since this change does not affect noweb replacement text without
-newlines in them, inline noweb references are acceptable.
-
-This feature can also be used for management of indentation in
-exported code snippets. With:
-
-@example
-#+NAME: if-true
-#+BEGIN_SRC python :exports none
- print('do things when true')
-#+end_src
-
-#+name: if-false
-#+begin_src python :exports none
- print('do things when false')
-#+end_src
-@end example
-
-@noindent
-this code block:
-
-@example
-#+begin_src python :noweb yes :results output
- if true:
- <<if-true>>
- else:
- <<if-false>>
-#+end_src
-@end example
-
-@noindent
-expands to:
-
-@example
-if true:
- print('do things when true')
-else:
- print('do things when false')
-@end example
-
-When in doubt about the outcome of a source code block expansion, you
-can preview the results with the following command:
-
-@table @asis
-@item @kbd{C-c C-v v} or @kbd{C-c C-v C-v} (@code{org-babel-expand-src-block})
-@findex org-babel-expand-src-block
-@kindex C-c C-v v
-@kindex C-c C-v C-v
-Expand the current source code block according to its header
-arguments and pop open the results in a preview buffer.
-@end table
-
-@node Library of Babel
-@section Library of Babel
-
-@cindex babel, library of
-@cindex source code, library
-@cindex code block, library
-
-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{https://orgmode.org/worg/library-of-babel.html, Worg}. For
-remote code block evaluation syntax, see @ref{Evaluating Code Blocks}.
-
-@kindex C-c C-v i
-@findex org-babel-lob-ingest
-For any user to add code to the library, first save the code in
-regular 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 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.
-
-Active key bindings in code blocks:
-
-@kindex C-c C-c
-@findex org-babel-execute-src-block
-@kindex C-c C-o
-@findex org-babel-open-src-block-result
-@kindex M-UP
-@findex org-babel-load-in-session
-@kindex M-DOWN
-@findex org-babel-pop-to-session
-@multitable @columnfractions 0.2 0.55
-@headitem Key binding
-@tab Function
-@item @kbd{C-c C-c}
-@tab @code{org-babel-execute-src-block}
-@item @kbd{C-c C-o}
-@tab @code{org-babel-open-src-block-result}
-@item @kbd{M-@key{UP}}
-@tab @code{org-babel-load-in-session}
-@item @kbd{M-@key{DOWN}}
-@tab @code{org-babel-pop-to-session}
-@end multitable
-
-Active key bindings in Org mode buffer:
-
-@kindex C-c C-v p
-@kindex C-c C-v C-p
-@kindex C-c C-v n
-@kindex C-c C-v C-n
-@kindex C-c C-v e
-@kindex C-c C-v C-e
-@kindex C-c C-v o
-@kindex C-c C-v C-o
-@kindex C-c C-v v
-@kindex C-c C-v C-v
-@kindex C-c C-v u
-@kindex C-c C-v C-u
-@kindex C-c C-v g
-@kindex C-c C-v C-g
-@kindex C-c C-v r
-@kindex C-c C-v C-r
-@kindex C-c C-v b
-@kindex C-c C-v C-b
-@kindex C-c C-v s
-@kindex C-c C-v C-s
-@kindex C-c C-v d
-@kindex C-c C-v C-d
-@kindex C-c C-v t
-@kindex C-c C-v C-t
-@kindex C-c C-v f
-@kindex C-c C-v C-f
-@kindex C-c C-v c
-@kindex C-c C-v C-c
-@kindex C-c C-v j
-@kindex C-c C-v C-j
-@kindex C-c C-v l
-@kindex C-c C-v C-l
-@kindex C-c C-v i
-@kindex C-c C-v C-i
-@kindex C-c C-v I
-@kindex C-c C-v C-I
-@kindex C-c C-v z
-@kindex C-c C-v C-z
-@kindex C-c C-v a
-@kindex C-c C-v C-a
-@kindex C-c C-v h
-@kindex C-c C-v C-h
-@kindex C-c C-v x
-@kindex C-c C-v C-x
-@findex org-babel-previous-src-block
-@findex org-babel-next-src-block
-@findex org-babel-execute-maybe
-@findex org-babel-open-src-block-result
-@findex org-babel-expand-src-block
-@findex org-babel-goto-src-block-head
-@findex org-babel-goto-named-src-block
-@findex org-babel-goto-named-result
-@findex org-babel-execute-buffer
-@findex org-babel-execute-subtree
-@findex org-babel-demarcate-block
-@findex org-babel-tangle
-@findex org-babel-tangle-file
-@findex org-babel-check-src-block
-@findex org-babel-insert-header-arg
-@findex org-babel-load-in-session
-@findex org-babel-lob-ingest
-@findex org-babel-view-src-block-info
-@findex org-babel-switch-to-session-with-code
-@findex org-babel-sha1-hash
-@findex org-babel-describe-bindings
-@findex org-babel-do-key-sequence-in-edit-buffer
-@multitable @columnfractions 0.45 0.55
-@headitem Key binding
-@tab Function
-@item @kbd{C-c C-v p} or @kbd{C-c C-v C-p}
-@tab @code{org-babel-previous-src-block}
-@item @kbd{C-c C-v n} or @kbd{C-c C-v C-n}
-@tab @code{org-babel-next-src-block}
-@item @kbd{C-c C-v e} or @kbd{C-c C-v C-e}
-@tab @code{org-babel-execute-maybe}
-@item @kbd{C-c C-v o} or @kbd{C-c C-v C-o}
-@tab @code{org-babel-open-src-block-result}
-@item @kbd{C-c C-v v} or @kbd{C-c C-v C-v}
-@tab @code{org-babel-expand-src-block}
-@item @kbd{C-c C-v u} or @kbd{C-c C-v C-u}
-@tab @code{org-babel-goto-src-block-head}
-@item @kbd{C-c C-v g} or @kbd{C-c C-v C-g}
-@tab @code{org-babel-goto-named-src-block}
-@item @kbd{C-c C-v r} or @kbd{C-c C-v C-r}
-@tab @code{org-babel-goto-named-result}
-@item @kbd{C-c C-v b} or @kbd{C-c C-v C-b}
-@tab @code{org-babel-execute-buffer}
-@item @kbd{C-c C-v s} or @kbd{C-c C-v C-s}
-@tab @code{org-babel-execute-subtree}
-@item @kbd{C-c C-v d} or @kbd{C-c C-v C-d}
-@tab @code{org-babel-demarcate-block}
-@item @kbd{C-c C-v t} or @kbd{C-c C-v C-t}
-@tab @code{org-babel-tangle}
-@item @kbd{C-c C-v f} or @kbd{C-c C-v C-f}
-@tab @code{org-babel-tangle-file}
-@item @kbd{C-c C-v c} or @kbd{C-c C-v C-c}
-@tab @code{org-babel-check-src-block}
-@item @kbd{C-c C-v j} or @kbd{C-c C-v C-j}
-@tab @code{org-babel-insert-header-arg}
-@item @kbd{C-c C-v l} or @kbd{C-c C-v C-l}
-@tab @code{org-babel-load-in-session}
-@item @kbd{C-c C-v i} or @kbd{C-c C-v C-i}
-@tab @code{org-babel-lob-ingest}
-@item @kbd{C-c C-v I} or @kbd{C-c C-v C-I}
-@tab @code{org-babel-view-src-block-info}
-@item @kbd{C-c C-v z} or @kbd{C-c C-v C-z}
-@tab @code{org-babel-switch-to-session-with-code}
-@item @kbd{C-c C-v a} or @kbd{C-c C-v C-a}
-@tab @code{org-babel-sha1-hash}
-@item @kbd{C-c C-v h} or @kbd{C-c C-v C-h}
-@tab @code{org-babel-describe-bindings}
-@item @kbd{C-c C-v x} or @kbd{C-c C-v C-x}
-@tab @code{org-babel-do-key-sequence-in-edit-buffer}
-@end multitable
-
-@node Batch Execution
-@section Batch Execution
-
-@cindex code block, batch execution
-@cindex source code, batch execution
-
-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.
-
-The sample script shows batch processing of multiple files using
-@code{org-babel-tangle}.
-
-@example
-#!/bin/sh
-# Tangle files with Org mode
-#
-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:: @kbd{M-@key{TAB}} guesses completions.
-* Structure Templates:: Quick insertion of structural elements.
-* Speed Keys:: Electric commands at the beginning of a headline.
-* Clean View:: Getting rid of leading stars in the outline.
-* Execute commands in the active region:: Execute commands on multiple items in Org or agenda view.
-* Dynamic Headline Numbering:: Display and update outline numbering.
-* The Very Busy @kbd{C-c C-c} Key:: When in doubt, press @kbd{C-c C-c}.
-* In-buffer Settings:: Overview of keywords.
-* Org Syntax:: Formal description of Org's syntax.
-* Documentation Access:: Read documentation about current syntax.
-* Escape Character:: Prevent Org from interpreting your writing.
-* Code Evaluation Security:: Org files evaluate in-line code.
-* Interaction:: With other Emacs packages.
-* TTY Keys:: Using Org on a tty.
-* Protocols:: External access to Emacs and Org.
-* Org Crypt:: Encrypting Org files.
-* Org Mobile:: Viewing and capture on a mobile device.
-@end menu
-
-@node Completion
-@section Completion
-
-@cindex completion, of @TeX{} symbols
-@cindex completion, of TODO keywords
-@cindex completion, of dictionary words
-@cindex completion, of option keywords
-@cindex completion, of tags
-@cindex completion, of property keys
-@cindex completion, of link abbreviations
-@cindex @TeX{} symbol completion
-@cindex TODO keywords completion
-@cindex dictionary word completion
-@cindex option keyword completion
-@cindex tag completion
-@cindex link abbreviations, completion of
-
-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 offers 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 @asis
-@item @kbd{M-@key{TAB}}
-@kindex M-TAB
-
-Complete word at point.
-
-@itemize
-@item
-At the beginning of an empty headline, complete TODO keywords.
-
-@item
-After @samp{\}, complete @TeX{} symbols supported by the exporter.
-
-@item
-After @samp{:} in a headline, complete tags. Org deduces the list of
-tags from the @samp{TAGS} in-buffer option (see @ref{Setting Tags}), the
-variable @code{org-tag-alist}, or from all tags used in the current
-buffer.
-
-@item
-After @samp{:} and not in a headline, complete property keys. The list
-of keys is constructed dynamically from all keys used in the
-current buffer.
-
-@item
-After @samp{[[}, complete link abbreviations (see @ref{Link Abbreviations}).
-
-@item
-After @samp{[[*}, complete headlines in the current buffer so that they
-can be used in search links like: @samp{[[*find this headline]]}
-
-@item
-After @samp{#+}, complete the special keywords like @samp{TYP_TODO} or
-file-specific @samp{OPTIONS}. After option keyword is complete,
-pressing @kbd{M-@key{TAB}} again inserts example settings for this
-keyword.
-
-@item
-After @samp{STARTUP} keyword, complete startup items.
-
-@item
-When point is anywhere else, complete dictionary words using
-Ispell.
-@end itemize
-@end table
-
-@node Structure Templates
-@section Structure Templates
-
-@cindex template insertion
-@cindex insertion, of templates
-
-With just a few keystrokes, it is possible to insert empty structural
-blocks, such as @samp{#+BEGIN_SRC} @dots{} @samp{#+END_SRC}, or to wrap existing
-text in such a block.
-
-@table @asis
-@item @kbd{C-c C-,} (@code{org-insert-structure-template})
-@findex org-insert-structure-template
-@kindex C-c C-,
-Prompt for a type of block structure, and insert the block at point.
-If the region is active, it is wrapped in the block. First prompts
-the user for keys, which are used to look up a structure type from
-the variable below. If the key is @kbd{@key{TAB}}, @kbd{@key{RET}},
-or @kbd{@key{SPC}}, the user is prompted to enter a block type.
-@end table
-
-@vindex org-structure-template-alist
-Available structure types are defined in
-@code{org-structure-template-alist}, see the docstring for adding or
-changing values.
-
-@cindex Tempo
-@cindex template expansion
-@cindex insertion, of templates
-@vindex org-tempo-keywords-alist
-Org Tempo expands snippets to structures defined in
-@code{org-structure-template-alist} and @code{org-tempo-keywords-alist}. For
-example, @kbd{< s @key{TAB}} creates a code block. Enable it by
-customizing @code{org-modules} or add @samp{(require 'org-tempo)} to your Emacs
-init file@footnote{For more information, please refer to the commentary section
-in @samp{org-tempo.el}.}.
-
-@multitable @columnfractions 0.1 0.9
-@item @kbd{a}
-@tab @samp{#+BEGIN_EXPORT ascii} @dots{} @samp{#+END_EXPORT}
-@item @kbd{c}
-@tab @samp{#+BEGIN_CENTER} @dots{} @samp{#+END_CENTER}
-@item @kbd{C}
-@tab @samp{#+BEGIN_COMMENT} @dots{} @samp{#+END_COMMENT}
-@item @kbd{e}
-@tab @samp{#+BEGIN_EXAMPLE} @dots{} @samp{#+END_EXAMPLE}
-@item @kbd{E}
-@tab @samp{#+BEGIN_EXPORT} @dots{} @samp{#+END_EXPORT}
-@item @kbd{h}
-@tab @samp{#+BEGIN_EXPORT html} @dots{} @samp{#+END_EXPORT}
-@item @kbd{l}
-@tab @samp{#+BEGIN_EXPORT latex} @dots{} @samp{#+END_EXPORT}
-@item @kbd{q}
-@tab @samp{#+BEGIN_QUOTE} @dots{} @samp{#+END_QUOTE}
-@item @kbd{s}
-@tab @samp{#+BEGIN_SRC} @dots{} @samp{#+END_SRC}
-@item @kbd{v}
-@tab @samp{#+BEGIN_VERSE} @dots{} @samp{#+END_VERSE}
-@end multitable
-
-@node Speed Keys
-@section Speed Keys
-
-@cindex speed keys
-
-Single keystrokes can execute custom commands in an Org file when
-point 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
-key chords.
-
-@vindex org-use-speed-commands
-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, point must be at the beginning of an Org
-headline, before any of the stars.
-
-@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
-point is at the beginning of an Org headline, shows currently active
-Speed Keys, including the user-defined ones.
-
-@node Clean View
-@section A Cleaner Outline View
-
-@cindex hiding leading stars
-@cindex dynamic indentation
-@cindex odd-levels-only outlines
-@cindex clean outline view
-
-Org's outline with stars and no indents can look 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 displays only one
-star and indents text to line up with the heading:
-
-@example
-* Top level headline | * Top level headline
-** Second level | * Second level
-*** Third level | * Third level
-some text | some text
-*** Third level | * Third level
-more text | more text
-* Another top level headline | * Another top level headline
-@end example
-
-Org can achieve this in two ways, (1) by just displaying the buffer in
-this way without changing it, or (2) by actually indenting every line
-in the desired amount with hard spaces and hiding leading stars.
-
-@menu
-* Org Indent Mode::
-* Hard indentation::
-@end menu
-
-@node Org Indent Mode
-@subsection Org Indent Mode
-
-@cindex Indent mode
-@findex org-indent-mode
-To display the buffer in the indented view, activate Org Indent minor
-mode, using @kbd{M-x org-indent-mode}. Text lines that are not
-headlines are prefixed with virtual spaces to vertically align with
-the headline text@footnote{Org Indent mode also sets @code{wrap-prefix} correctly for
-indenting and wrapping long lines of headlines or text. This minor
-mode also handles Visual Line mode and directly applied settings
-through @code{word-wrap}.}.
-
-@vindex org-indent-indentation-per-level
-To make more horizontal space, the headlines are shifted by two
-characters. Configure @code{org-indent-indentation-per-level} variable for
-a different number.
-
-@vindex org-indent-mode-turns-on-hiding-stars
-@vindex org-indent-mode-turns-off-org-adapt-indentation
-By default, Org Indent mode turns off @code{org-adapt-indentation} and does
-hide leading stars by locally setting @code{org-hide-leading-stars} to @code{t}:
-only one star on each headline is visible, the rest are masked with
-the same font color as the background. If you want to customize this
-default behavior, see @code{org-indent-mode-turns-on-hiding-stars} and
-@code{org-indent-mode-turns-off-org-adapt-indentation}.
-
-@vindex org-startup-indented
-To globally turn on Org Indent mode for all files, customize the
-variable @code{org-startup-indented}. To control it for individual files,
-use @samp{STARTUP} keyword as follows:
-
-@example
-#+STARTUP: indent
-#+STARTUP: noindent
-@end example
-
-@node Hard indentation
-@subsection Hard indentation
-
-It is possible to use hard spaces to achieve the indentation instead,
-if the bare ASCII file should have the indented look also outside
-Emacs@footnote{This works, but requires extra effort. Org Indent mode is
-more convenient for most applications.}. With Org's support, you have to indent all lines to
-line up with the outline headers. You would use these
-settings@footnote{@code{org-adapt-indentation} can also be set to @samp{'headline-data},
-in which case only data lines below the headline will be indented.}:
-
-@lisp
-(setq org-adapt-indentation t
- org-hide-leading-stars t
- org-odd-levels-only t)
-@end lisp
-
-@table @asis
-@item @emph{Indentation of text below headlines} (@code{org-adapt-indentation})
-@vindex org-adapt-indentation
-The first setting modifies paragraph filling, line wrapping, and
-structure editing commands to preserving or adapting the indentation
-as appropriate.
-
-@item @emph{Hiding leading stars} (@code{org-hide-leading-stars})
-@vindex org-hide-leading-stars
-@vindex org-hide, face
-The second setting makes leading stars invisible by applying the
-face @code{org-hide} to them. For per-file preference, use these file
-@samp{STARTUP} options:
-
-@example
-#+STARTUP: hidestars
-#+STARTUP: showstars
-@end example
-
-@item @emph{Odd levels} (@code{org-odd-levels-only})
-@vindex org-odd-levels-only
-The third setting makes Org use only odd levels, 1, 3, 5, @dots{}, in
-the outline to create more indentation. On a per-file level,
-control this with:
-
-@example
-#+STARTUP: odd
-#+STARTUP: oddeven
-@end example
-
-To convert a file between single and double stars layouts, use
-@kbd{M-x org-convert-to-odd-levels} and @kbd{M-x org-convert-to-oddeven-levels}.
-@end table
-
-@node Execute commands in the active region
-@section Execute commands in the active region
-
-@vindex org-loop-over-headlines-in-active-region
-When in an Org buffer and the region is active, some commands will
-apply to all the subtrees in the active region. For example, hitting
-@kbd{C-c C-s} when multiple headlines are within the active region will
-successively prompt you for a new schedule date and time. To disable
-this, set the option @code{org-loop-over-headlines-in-active-region} to
-non-@code{t}, activate the region and run the command normally.
-
-@vindex org-agenda-loop-over-headlines-in-active-region
-@code{org-agenda-loop-over-headlines-in-active-region} is the equivalent
-option of the agenda buffer, where you can also use @ref{Bulk remote editing selected entries, , bulk editing of
-selected entries}.
-
-Not all commands can loop in the active region and what subtrees or
-headlines are considered can be refined: see the docstrings of these
-options for more details.
-
-@node Dynamic Headline Numbering
-@section Dynamic Headline Numbering
-
-@cindex Org Num mode
-@cindex number headlines
-The Org Num minor mode, toggled with @kbd{M-x org-num-mode},
-displays outline numbering on top of headlines. It also updates it
-automatically upon changes to the structure of the document.
-
-@vindex org-num-max-level
-@vindex org-num-skip-tags
-@vindex org-num-skip-commented
-@vindex org-num-skip-unnumbered
-By default, all headlines are numbered. You can limit numbering to
-specific headlines according to their level, tags, @samp{COMMENT} keyword,
-or @samp{UNNUMBERED} property. Set @code{org-num-max-level},
-@code{org-num-skip-tags}, @code{org-num-skip-commented},
-@code{org-num-skip-unnumbered}, or @code{org-num-skip-footnotes} accordingly.
-
-@vindex org-num-skip-footnotes
-If @code{org-num-skip-footnotes} is non-@code{nil}, footnotes sections (see
-@ref{Creating Footnotes}) are not numbered either.
-
-@vindex org-num-face
-@vindex org-num-format-function
-You can control how the numbering is displayed by setting
-@code{org-num-face} and @code{org-num-format-function}.
-
-@vindex org-startup-numerated
-You can also turn this mode globally for all Org files by setting the
-option @code{org-startup-numerated} to @samp{t}, or locally on a file by using
-@samp{#+startup: num}.
-
-@node The Very Busy @kbd{C-c C-c} Key
-@section The Very Busy @kbd{C-c C-c} Key
-
-@kindex C-c C-c
-@cindex @kbd{C-c C-c}, overview
-
-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 throughout this
-manual, but here is a consolidated list for easy reference.
-
-@itemize
-@item
-If column view (see @ref{Column View}) is on, exit column view.
-
-@item
-If any highlights shown in the buffer from the creation of a sparse
-tree, or from clock display, remove such highlights.
-
-@item
-If point is in one of the special @samp{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 @samp{SETUPFILE}.
-
-@item
-If point is inside a table, realign the table.
-
-@item
-If point is on a @samp{TBLFM} keyword, 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, also jump to the target location after
-saving the note.
-
-@item
-If point is on a @samp{<<<target>>>}, update radio targets and
-corresponding links in this buffer.
-
-@item
-If point is on a property line or at the start or end of a property
-drawer, offer property commands.
-
-@item
-If point is at a footnote reference, go to the corresponding
-definition, and @emph{vice versa}.
-
-@item
-If point is on a statistics cookie, update it.
-
-@item
-If point is in a plain list item with a checkbox, toggle the status
-of the checkbox.
-
-@item
-If point is on a numbered item in a plain list, renumber the ordered
-list.
-
-@item
-If point is on the @samp{#+BEGIN} line of a dynamic block, the block is
-updated.
-
-@item
-If point is at a timestamp, fix the day name in the timestamp.
-@end itemize
-
-@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.
-
-@cindex refresh set-up
-@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.
-
-@table @asis
-@item @samp{#+ARCHIVE: %s_done::}
-@cindex @samp{ARCHIVE}, keyword
-@vindex org-archive-location
-Sets the archive location of the agenda file. The corresponding
-variable is @code{org-archive-location}.
-
-@item @samp{#+CATEGORY}
-@cindex @samp{CATEGORY}, keyword
-Sets the category of the agenda file, which applies to the entire
-document.
-
-@item @samp{#+COLUMNS: %25ITEM ...}
-@cindex @samp{COLUMNS}, property
-Set the default format for columns view. This format applies when
-columns view is invoked in locations where no @samp{COLUMNS} property
-applies.
-
-@item @samp{#+CONSTANTS: name1=value1 ...}
-@cindex @samp{CONSTANTS}, keyword
-@vindex org-table-formula-constants
-@vindex org-table-formula
-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 @samp{#+FILETAGS: :tag1:tag2:tag3:}
-@cindex @samp{FILETAGS}, keyword
-Set tags that all entries in the file inherit from, including the
-top-level entries.
-
-@item @samp{#+LINK: linkword replace}
-@cindex @samp{LINK}, keyword
-@vindex org-link-abbrev-alist
-Each line specifies one abbreviation for one link. Use multiple
-@samp{LINK} keywords for more, see @ref{Link Abbreviations}. The
-corresponding variable is @code{org-link-abbrev-alist}.
-
-@item @samp{#+PRIORITIES: highest lowest default}
-@cindex @samp{PRIORITIES}, keyword
-@vindex org-priority-highest
-@vindex org-priority-lowest
-@vindex org-priority-default
-This line sets the limits and the default for the priorities. All
-three must be either letters A--Z or numbers 0--9. The highest
-priority must have a lower ASCII number than the lowest priority.
-
-@item @samp{#+PROPERTY: Property_Name Value}
-@cindex @samp{PROPERTY}, keyword
-This line sets a default inheritance value for entries in the
-current buffer, most useful for specifying the allowed values of
-a property.
-
-@item @samp{#+SETUPFILE: file}
-@cindex @samp{SETUPFILE}, keyword
-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 parses and
-loads the file, and also resets 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---use @kbd{C-c '} while point is on the line with the
-file name.
-
-@item @samp{#+STARTUP:}
-@cindex @samp{STARTUP}, keyword
-Startup options Org uses when first visiting a file.
-
-@vindex org-startup-folded
-The first set of options deals with the initial visibility of the
-outline tree. The corresponding variable for global default
-settings is @code{org-startup-folded} with a default value of
-@code{showeverything}.
-
-@multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{overview}
-@tab Top-level headlines only.
-@item @samp{content}
-@tab All headlines.
-@item @samp{showall}
-@tab No folding on any entry.
-@item @samp{showeverything}
-@tab Show even drawer contents.
-@end multitable
-
-@vindex org-startup-indented
-Dynamic virtual indentation is controlled by the variable
-@code{org-startup-indented}@footnote{Note that Org Indent mode also sets the @code{wrap-prefix}
-property, such that Visual Line mode (or purely setting @code{word-wrap})
-wraps long lines, including headlines, correctly indented.}.
-
-@multitable {aaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{indent}
-@tab Start with Org Indent mode turned on.
-@item @samp{noindent}
-@tab Start with Org Indent mode turned off.
-@end multitable
-
-@vindex org-startup-numerated
-Dynamic virtual numeration of headlines is controlled by the variable
-@code{org-startup-numerated}.
-
-@multitable {aaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{num}
-@tab Start with Org num mode turned on.
-@item @samp{nonum}
-@tab Start with Org num mode turned off.
-@end multitable
-
-@vindex org-startup-align-all-tables
-Aligns tables consistently upon visiting a file. The
-corresponding variable is @code{org-startup-align-all-tables} with
-@code{nil} as default value.
-
-@multitable {aaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{align}
-@tab Align all tables.
-@item @samp{noalign}
-@tab Do not align tables on startup.
-@end multitable
-
-@vindex org-startup-shrink-all-tables
-Shrink table columns with a width cookie. The corresponding
-variable is @code{org-startup-shrink-all-tables} with @code{nil} as
-default value.
-
-@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.
-
-@multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{inlineimages}
-@tab Show inline images.
-@item @samp{noinlineimages}
-@tab Do not show inline images on startup.
-@end multitable
-
-@vindex org-log-done
-@vindex org-log-note-clock-out
-@vindex org-log-repeat
-Logging the closing and reopening of TODO items and clock
-intervals can be configured using these options (see variables
-@code{org-log-done}, @code{org-log-note-clock-out}, and @code{org-log-repeat}).
-
-@multitable {aaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{logdone}
-@tab Record a timestamp when an item is marked as done.
-@item @samp{lognotedone}
-@tab Record timestamp and a note when DONE@.
-@item @samp{nologdone}
-@tab Do not record when items are marked as done.
-@item @samp{logrepeat}
-@tab Record a time when reinstating a repeating item.
-@item @samp{lognoterepeat}
-@tab Record a note when reinstating a repeating item.
-@item @samp{nologrepeat}
-@tab Do not record when reinstating repeating item.
-@item @samp{lognoteclock-out}
-@tab Record a note when clocking out.
-@item @samp{nolognoteclock-out}
-@tab Do not record a note when clocking out.
-@item @samp{logreschedule}
-@tab Record a timestamp when scheduling time changes.
-@item @samp{lognotereschedule}
-@tab Record a note when scheduling time changes.
-@item @samp{nologreschedule}
-@tab Do not record when a scheduling date changes.
-@item @samp{logredeadline}
-@tab Record a timestamp when deadline changes.
-@item @samp{lognoteredeadline}
-@tab Record a note when deadline changes.
-@item @samp{nologredeadline}
-@tab Do not record when a deadline date changes.
-@item @samp{logrefile}
-@tab Record a timestamp when refiling.
-@item @samp{lognoterefile}
-@tab Record a note when refiling.
-@item @samp{nologrefile}
-@tab Do not record when refiling.
-@end multitable
-
-@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 @samp{showstars} and @samp{oddeven}).
-
-@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{hidestars}
-@tab Make all but one of the stars starting a headline invisible.
-@item @samp{showstars}
-@tab Show all stars starting a headline.
-@item @samp{indent}
-@tab Virtual indentation according to outline level.
-@item @samp{noindent}
-@tab No virtual indentation according to outline level.
-@item @samp{odd}
-@tab Allow only odd outline levels (1, 3, @dots{}).
-@item @samp{oddeven}
-@tab Allow all outline levels.
-@end multitable
-
-@vindex org-put-time-stamp-overlays
-@vindex org-time-stamp-overlay-formats
-To turn on custom format overlays over timestamps (variables
-@code{org-put-time-stamp-overlays} and
-@code{org-time-stamp-overlay-formats}), use:
-
-@multitable {aaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{customtime}
-@tab Overlay custom time format.
-@end multitable
-
-@vindex constants-unit-system
-The following options influence the table spreadsheet (variable
-@code{constants-unit-system}).
-
-@multitable {aaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{constcgs}
-@tab @samp{constants.el} should use the c-g-s unit system.
-@item @samp{constSI}
-@tab @samp{constants.el} should use the SI unit system.
-@end multitable
-
-@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},
-@code{org-footnote-auto-label}, and @code{org-footnote-auto-adjust}.
-
-@multitable {aaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{fninline}
-@tab Define footnotes inline.
-@item @samp{fnnoinline}
-@tab Define footnotes in separate section.
-@item @samp{fnlocal}
-@tab Define footnotes near first reference, but not inline.
-@item @samp{fnprompt}
-@tab Prompt for footnote labels.
-@item @samp{fnauto}
-@tab Create @samp{[fn:1]}-like labels automatically (default).
-@item @samp{fnconfirm}
-@tab Offer automatic label for editing or confirmation.
-@item @samp{fnadjust}
-@tab Automatically renumber and sort footnotes.
-@item @samp{nofnadjust}
-@tab Do not renumber and sort automatically.
-@end multitable
-
-@vindex org-hide-block-startup
-To hide blocks on startup, use these keywords. The
-corresponding variable is @code{org-hide-block-startup}.
-
-@multitable {aaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{hideblocks}
-@tab Hide all begin/end blocks on startup.
-@item @samp{nohideblocks}
-@tab Do not hide blocks on startup.
-@end multitable
-
-@vindex org-pretty-entities
-The display of entities as UTF-8 characters is governed by the
-variable @code{org-pretty-entities} and the keywords
-
-@multitable {aaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @samp{entitiespretty}
-@tab Show entities as UTF-8 characters where possible.
-@item @samp{entitiesplain}
-@tab Leave entities plain.
-@end multitable
-
-@item @samp{#+TAGS: TAG1(c1) TAG2(c2)}
-@cindex @samp{TAGS}, keyword
-@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}.
-
-@item @samp{#+TODO:}
-@itemx @samp{#+SEQ_TODO:}
-@itemx @samp{#+TYP_TODO:}
-@cindex @samp{SEQ_TODO}, keyword
-@cindex @samp{TODO}, keyword
-@cindex @samp{TYP_TODO}, keyword
-@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}.
-@end table
-
-@node Org Syntax
-@section Org Syntax
-
-A reference document providing a formal description of Org's syntax is
-available as @uref{https://orgmode.org/worg/dev/org-syntax.html, a draft on Worg}, written and maintained by Nicolas
-Goaziou. It defines Org's core internal concepts such as ``headlines'',
-``sections'', ``affiliated keywords'', ``(greater) elements'' and ``objects''.
-Each part of an Org document belongs to one of the previous
-categories.
-
-To explore the abstract structure of an Org buffer, run this in
-a buffer:
-
-@example
-M-: (org-element-parse-buffer) <RET>
-@end example
-
-
-@noindent
-It outputs a list containing the buffer's content represented as an
-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.
-
-@cindex syntax checker
-@cindex linter
-@findex org-lint
-You can probe the syntax of your documents with the command
-
-@example
-M-x org-lint <RET>
-@end example
-
-
-@noindent
-It runs a number of checks to find common mistakes. It then displays
-their location in a dedicated buffer, along with a description and
-a ``trust level'', since false-positive are possible. From there, you
-can operate on the reports with the following keys:
-
-@multitable @columnfractions 0.22 0.78
-@item @kbd{C-j}, @kbd{@key{TAB}}
-@tab Display the offending line
-@item @kbd{@key{RET}}
-@tab Move point to the offending line
-@item @kbd{g}
-@tab Check the document again
-@item @kbd{h}
-@tab Hide all reports from the same checker
-@item @kbd{i}
-@tab Also remove them from all subsequent checks
-@item @kbd{S}
-@tab Sort reports by the column at point
-@end multitable
-
-@node Documentation Access
-@section Context Dependent Documentation
-
-@cindex documentation
-@cindex Info
-
-@findex org-info-find-node
-@kindex C-c C-x I
-@kbd{C-c C-x I} in an Org file tries to open a suitable section
-of the Org manual depending on the syntax at point. For example,
-using it on a headline displays ``Document Structure'' section.
-
-@kbd{q} closes the Info window.
-
-@node Escape Character
-@section Escape Character
-
-@cindex escape character
-@cindex zero width space
-You may sometimes want to write text that looks like Org syntax, but
-should really read as plain text. Org may use a specific escape
-character in some situations, i.e., a backslash in macros (see @ref{Macro Replacement}) and links (see @ref{Link Format}), or a comma in source and
-example blocks (see @ref{Literal Examples}). In the general case, however,
-we suggest to use the zero width space. You can insert one with any
-of the following:
-
-@example
-C-x 8 <RET> zero width space <RET>
-C-x 8 <RET> 200B <RET>
-@end example
-
-
-For example, in order to write @samp{[[1,2]]} as-is in your document, you
-may write instead
-
-@example
-[X[1,2]]
-@end example
-
-
-where @samp{X} denotes the zero width space character.
-
-@node Code Evaluation Security
-@section Code Evaluation and Security Issues
-
-Unlike plain text, running code comes with risk. Each source 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 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.
-
-Org evaluates code in the following circumstances:
-
-@table @asis
-@item @emph{Source code blocks}
-Org evaluates source code blocks in an Org file during export. Org
-also evaluates a source 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 @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 blocks without
-prompting:
-
-@lisp
-(defun my-org-confirm-babel-evaluate (lang body)
- (not (string= lang "ditaa"))) ;don't ask for ditaa
-(setq org-confirm-babel-evaluate #'my-org-confirm-babel-evaluate)
-@end lisp
-
-@item @emph{Following @samp{shell} and @samp{elisp} links}
-Org has two link types that can directly evaluate code (see
-@ref{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-link-shell-confirm-function
-Function that prompts the user before executing a shell link.
-@end defopt
-
-@defopt org-link-elisp-confirm-function
-Function that prompts the user before executing an Emacs Lisp link.
-@end defopt
-
-@item @emph{Formulas in tables}
-Formulas in tables (see @ref{The Spreadsheet}) are code that is evaluated
-either by the Calc interpreter, or by the Emacs Lisp interpreter.
-@end table
-
-@node Interaction
-@section Interaction with Other Packages
-
-@cindex packages, interaction with other
-
-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
-@subsection Packages that Org cooperates with
-
-@table @asis
-@item @samp{calc.el} by Dave Gillespie
-@cindex @file{calc.el}
-
-Org uses the Calc package for implementing spreadsheet functionality
-in its tables (see @ref{The Spreadsheet}). Org also uses Calc for
-embedded calculations. See @ref{Embedded Mode,GNU Emacs Calc Manual,,calc,}.
-
-@item @samp{constants.el} by Carsten Dominik
-@cindex @file{constants.el}
-@vindex org-table-formula-constants
-
-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 @samp{constants}
-package. Install version 2.0 of this package, available at
-@uref{http://www.astro.uva.nl/~dominik/Tools}. Org checks if the function
-@code{constants-get} has been autoloaded. Installation instructions are
-in the file @samp{constants.el}.
-
-@item @samp{cdlatex.el} by Carsten Dominik
-@cindex @file{cdlatex.el}
-
-Org mode can make use of the CD@LaTeX{} package to efficiently enter
-@LaTeX{} fragments into Org files. See @ref{CD@LaTeX{} mode}.
-
-@item @samp{imenu.el} by Ake Stenhoff and Lars Lindberg
-@cindex @file{imenu.el}
-
-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 @samp{speedbar.el} by Eric@tie{}M@.@tie{}Ludlam
-@cindex @file{speedbar.el}
-
-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.
-
-@item @samp{table.el} by Takaaki Ota
-@cindex table editor, @file{table.el}
-@cindex @file{table.el}
-
-Complex ASCII tables with automatic line wrapping, column- and
-row-spanning, and alignment can be created using the Emacs table
-package by Takaaki Ota. Org mode recognizes such tables and exports
-them properly. @kbd{C-c '} to edit these tables in a special
-buffer, much like Org's code blocks. Because of interference with
-other Org mode functionality, Takaaki Ota tables cannot be edited
-directly in the Org buffer.
-
-@table @asis
-@item @kbd{C-c '} (@code{org-edit-special})
-@kindex C-c '
-@findex org-edit-special
-Edit a @samp{table.el} table. Works when point is in a @samp{table.el}
-table.
-
-@item @kbd{C-c ~​} (@code{org-table-create-with-table.el})
-@kindex C-c ~
-@findex org-table-create-with-table.el
-Insert a @samp{table.el} table. If there is already a table at point,
-this command converts it between the @samp{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.
-@end table
-@end table
-
-@node Conflicts
-@subsection Packages that conflict with Org mode
-
-@cindex shift-selection
-@vindex org-support-shift-select
-In Emacs, shift-selection combines motions of point with shift key to
-enlarge regions. Emacs sets this mode by default. This conflicts
-with Org's use of @kbd{S-<cursor>} commands to change timestamps,
-TODO keywords, priorities, and item bullet types, etc. Since
-@kbd{S-<cursor>} commands outside of specific contexts do not 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 point
-moves across a special context.
-
-@table @asis
-@item @samp{cua.el} by Kim@tie{}F@.@tie{}Storm
-@cindex @file{cua.el}
-@vindex org-replace-disputed-keys
-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.
-
-@multitable @columnfractions 0.4 0.4
-@item @kbd{S-@key{UP}} @result{} @kbd{M-p}
-@tab @kbd{S-@key{DOWN}} @result{} @kbd{M-n}
-@item @kbd{S-@key{LEFT}} @result{} @kbd{M--}
-@tab @kbd{S-@key{RIGHT}} @result{} @kbd{M-+}
-@item @kbd{C-S-@key{LEFT}} @result{} @kbd{M-S--}
-@tab @kbd{C-S-@key{RIGHT}} @result{} @kbd{M-S-+}
-@end multitable
-
-@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}.
-
-@item @samp{ecomplete.el} by Lars Magne Ingebrigtsen
-@cindex @file{ecomplete.el}
-Ecomplete provides ``electric'' address completion in address header
-lines in message buffers. Sadly Orgtbl mode cuts Ecomplete's power
-supply: no completion happens when Orgtbl mode is enabled in message
-buffers while entering text in address header lines. If one wants
-to use ecomplete one should @emph{not} follow the advice to automagically
-turn on Orgtbl mode in message buffers (see @ref{Orgtbl Mode}),
-but instead---after filling in the message headers---turn on Orgtbl
-mode manually when needed in the messages body.
-
-@item @samp{filladapt.el} by Kyle Jones
-@cindex @file{filladapt.el}
-Org mode tries to do the right thing when filling paragraphs, list
-items and other elements. Many users reported problems using both
-@samp{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)
-@end lisp
-
-@item @samp{viper.el} by Michael Kifer
-@cindex @file{viper.el}
-@kindex C-c /
-
-Viper uses @kbd{C-c /} and therefore makes this key not access
-the corresponding Org mode command @code{org-sparse-tree}. You need to
-find another key for this command, or override the key in
-@code{viper-vi-global-user-map} with
-
-@lisp
-(define-key viper-vi-global-user-map "C-c /" 'org-sparse-tree)
-@end lisp
-
-@item @samp{windmove.el} by Hovav Shacham
-@cindex @file{windmove.el}
-
-This package also uses the @kbd{S-<cursor>} keys, so everything
-written in the paragraph above about CUA mode also applies here. If
-you want to make the windmove function active in locations where Org
-mode does not have special functionality on @kbd{S-<cursor>},
-add this to your configuration:
-
-@lisp
-;; Make windmove work in Org mode:
-(add-hook 'org-shiftup-final-hook 'windmove-up)
-(add-hook 'org-shiftleft-final-hook 'windmove-left)
-(add-hook 'org-shiftdown-final-hook 'windmove-down)
-(add-hook 'org-shiftright-final-hook 'windmove-right)
-@end lisp
-
-@item @samp{yasnippet.el}
-@cindex @file{yasnippet.el}
-The way Org mode binds the @kbd{@key{TAB}} key (binding to @code{[tab]}
-instead of @code{"\t"}) overrules YASnippet's access to this key. The
-following code fixed this problem:
-
-@lisp
-(add-hook 'org-mode-hook
- (lambda ()
- (setq-local yas/trigger-key [tab])
- (define-key yas/keymap [tab] 'yas/next-field-or-maybe-expand)))
-@end lisp
-
-The latest version of YASnippet does not play well with Org mode.
-If the above code does not fix the conflict, start by defining
-the following function:
-
-@lisp
-(defun yas/org-very-safe-expand ()
- (let ((yas/fallback-behavior 'return-nil)) (yas/expand)))
-@end lisp
-
-Then, tell Org mode to use that function:
-
-@lisp
-(add-hook 'org-mode-hook
- (lambda ()
- (make-variable-buffer-local 'yas/trigger-key)
- (setq yas/trigger-key [tab])
- (add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand)
- (define-key yas/keymap [tab] 'yas/next-field)))
-@end lisp
-@end table
-
-@node TTY Keys
-@section Using Org on a TTY
-
-@cindex tty key bindings
-
-Org provides alternative key bindings for TTY and modern mobile
-devices that cannot perform movement commands on point and key
-bindings with modifier keys. 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-<cursor>} for editing timestamp might be better with
-@kbd{C-c .} chord.
-
-@multitable @columnfractions 0.2 0.28 0.15 0.21
-@headitem Default
-@tab Alternative 1
-@tab Speed key
-@tab Alternative 2
-@item @kbd{S-@key{TAB}}
-@tab @kbd{C-u @key{TAB}}
-@tab @kbd{C}
-@tab
-@item @kbd{M-@key{LEFT}}
-@tab @kbd{C-c C-x l}
-@tab @kbd{l}
-@tab @kbd{Esc @key{LEFT}}
-@item @kbd{M-S-@key{LEFT}}
-@tab @kbd{C-c C-x L}
-@tab @kbd{L}
-@tab
-@item @kbd{M-@key{RIGHT}}
-@tab @kbd{C-c C-x r}
-@tab @kbd{r}
-@tab @kbd{Esc @key{RIGHT}}
-@item @kbd{M-S-@key{RIGHT}}
-@tab @kbd{C-c C-x R}
-@tab @kbd{R}
-@tab
-@item @kbd{M-@key{UP}}
-@tab @kbd{C-c C-x u}
-@tab
-@tab @kbd{Esc @key{UP}}
-@item @kbd{M-S-@key{UP}}
-@tab @kbd{C-c C-x U}
-@tab @kbd{U}
-@tab
-@item @kbd{M-@key{DOWN}}
-@tab @kbd{C-c C-x d}
-@tab
-@tab @kbd{Esc @key{DOWN}}
-@item @kbd{M-S-@key{DOWN}}
-@tab @kbd{C-c C-x D}
-@tab @kbd{D}
-@tab
-@item @kbd{S-@key{RET}}
-@tab @kbd{C-c C-x c}
-@tab
-@tab
-@item @kbd{M-@key{RET}}
-@tab @kbd{C-c C-x m}
-@tab
-@tab @kbd{Esc @key{RET}}
-@item @kbd{M-S-@key{RET}}
-@tab @kbd{C-c C-x M}
-@tab
-@tab
-@item @kbd{S-@key{LEFT}}
-@tab @kbd{C-c @key{LEFT}}
-@tab
-@tab
-@item @kbd{S-@key{RIGHT}}
-@tab @kbd{C-c @key{RIGHT}}
-@tab
-@tab
-@item @kbd{S-@key{UP}}
-@tab @kbd{C-c @key{UP}}
-@tab
-@tab
-@item @kbd{S-@key{DOWN}}
-@tab @kbd{C-c @key{DOWN}}
-@tab
-@tab
-@item @kbd{C-S-@key{LEFT}}
-@tab @kbd{C-c C-x @key{LEFT}}
-@tab
-@tab
-@item @kbd{C-S-@key{RIGHT}}
-@tab @kbd{C-c C-x @key{RIGHT}}
-@tab
-@tab
-@end multitable
-
-@node Protocols
-@section Protocols for External Access
-
-@cindex protocols, for external access
-
-Org protocol is a tool 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 (see @ref{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 @samp{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 @var{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
-* The @code{store-link} protocol:: Store a link, push URL to kill-ring.
-* The @code{capture} protocol:: Fill a buffer with external information.
-* The @code{open-source} protocol:: Edit published contents.
-@end menu
-
-@node The @code{store-link} protocol
-@subsection The @code{store-link} protocol
-
-@cindex store-link protocol
-@cindex protocol, store-link
-
-Using the @code{store-link} handler, you can copy links, to that they can
-be inserted using @kbd{M-x org-insert-link} or yanking. 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, @var{URL} is pushed on the kill-ring for yanking.
-You need to encode @var{URL} and @var{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 The @code{capture} protocol
-@subsection The @code{capture} protocol
-
-@cindex capture protocol
-@cindex protocol, capture
-
-Activating the ``capture'' handler pops up a @samp{Capture} buffer in Emacs,
-using acapture template.
-
-@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}:
-
-@example
-javascript:location.href='org-protocol://capture?template=x'+
- '&url='+encodeURIComponent(window.location.href)+
- '&title='+encodeURIComponent(document.title)+
- '&body='+encodeURIComponent(window.getSelection());
-@end example
-
-@vindex org-protocol-default-template-key
-The capture template to be used can be specified in the bookmark (like
-@samp{X} above). If unspecified, the template key is set in the variable
-@code{org-protocol-default-template-key}. The following template
-placeholders are available:
-
-@example
-%:link The URL
-%:description The webpage title
-%:annotation Equivalent to [[%:link][%:description]]
-%i The selected text
-@end example
-
-@node The @code{open-source} protocol
-@subsection The @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
-
-@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
-@samp{https://orgmode.org/worg/} contents at @samp{/home/user/worg}, you can set
-@code{org-protocol-project-alist} to the following
-
-@lisp
-(setq org-protocol-project-alist
- '(("Worg"
- :base-url "https://orgmode.org/worg/"
- :working-directory "/home/user/worg/"
- :online-suffix ".html"
- :working-suffix ".org")))
-@end lisp
-
-@noindent
-If you are now browsing
-@samp{https://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 rewritten URL in open-source protocol
-@cindex protocol, open-source rewritten URL
-However, such mapping may not always yield the desired results.
-Suppose you maintain an online store located at @samp{http://example.com/}.
-The local sources reside in @samp{/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 @samp{http://example.com/print/posters.html} might be
-rewritten on the server to something like
-@samp{http://example.com/shop/products.php/posters.html.php}. The
-@code{open-source} handler probably cannot find a file named
-@samp{/home/user/example/print/posters.html.php} and fails.
-
-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 @samp{/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
-@samp{http://example.com/}, @samp{https://example.com},
-@samp{http://www.example.com/} and similar to
-@samp{/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 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 Org Crypt
-@section Org Crypt
-
-Org Crypt encrypts the text of an entry, but not the headline, or
-properties. Behind the scene, it uses the Emacs EasyPG library to
-encrypt and decrypt files.
-
-@vindex org-crypt-tag-matcher
-Any text below a headline that has a @samp{crypt} tag is automatically
-encrypted when the file is saved. To use a different tag, customize
-the @code{org-crypt-tag-matcher} setting.
-
-Here is a suggestion for Org Crypt settings in Emacs init file:
-
-@lisp
-(require 'org-crypt)
-(org-crypt-use-before-save-magic)
-(setq org-tags-exclude-from-inheritance '("crypt"))
-
-(setq org-crypt-key nil)
-;; GPG key to use for encryption
-;; Either the Key ID or set to nil to use symmetric encryption.
-
-(setq auto-save-default nil)
-;; Auto-saving does not cooperate with org-crypt.el: so you need to
-;; turn it off if you plan to use org-crypt.el quite often. Otherwise,
-;; you'll get an (annoying) message each time you start Org.
-
-;; To turn it off only locally, you can insert this:
-;;
-;; # -*- buffer-auto-save-file-name: nil; -*-
-@end lisp
-
-It's possible to use different keys for different headings by
-specifying the respective key as property @samp{CRYPTKEY}, e.g.:
-
-@example
-* Totally secret :crypt:
- :PROPERTIES:
- :CRYPTKEY: 0x0123456789012345678901234567890123456789
- :END:
-@end example
-
-Excluding the @samp{crypt} tag from inheritance prevents already encrypted
-text from being encrypted again.
-
-@node Org Mobile
-@section Org Mobile
-
-@cindex smartphone
-
-Org Mobile is a protocol for synchronizing Org files between Emacs and
-other applications, e.g., on mobile devices. It enables offline-views
-and capture support for an Org mode system that is rooted on a ``real''
-computer. The external application can also record changes to
-existing entries.
-
-This appendix describes Org's support for agenda view formats
-compatible with Org Mobile. It also describes synchronizing changes,
-such as to notes, between the mobile application and the computer.
-
-To change tags and TODO states in the mobile application, first
-customize the variables @code{org-todo-keywords}, @code{org-tag-alist} and
-@code{org-tag-persistent-alist}. These should cover all the important tags
-and TODO keywords, even if Org files use only some of them. Though
-the mobile application is expected to support in-buffer settings, it
-is required to understand TODO states @emph{sets} (see @ref{Per-file keywords}) and @emph{mutually exclusive} tags (see @ref{Setting Tags}) only for those set in these variables.
-
-@menu
-* Setting up the staging area:: For the mobile device.
-* Pushing to the mobile application:: Uploading Org files and agendas.
-* Pulling from the mobile application:: Integrating captured and flagged items.
-@end menu
-
-@node Setting up the staging area
-@subsection Setting up the staging area
-
-@vindex org-mobile-directory
-The mobile application needs access to a file directory on
-a server@footnote{For a server to host files, consider using a WebDAV server,
-such as @uref{https://nextcloud.com, Nextcloud}. Additional help is at this @uref{https://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.} to interact with Emacs. Pass its location through
-the @code{org-mobile-directory} variable. If you can mount that directory
-locally just set the variable to point to that directory:
-
-@lisp
-(setq org-mobile-directory "~/orgmobile/")
-@end lisp
-
-Alternatively, by using TRAMP (see @ref{Top,TRAMP User Manual,,tramp,}),
-@code{org-mobile-directory} may point to a remote directory accessible
-through, for example, SSH, SCP, or DAVS:
-
-@lisp
-(setq org-mobile-directory "/davs:user@@remote.host:/org/webdav/")
-@end lisp
-
-@vindex org-mobile-encryption
-With a public server, consider encrypting the files. Org also
-requires OpenSSL installed on the local computer. To turn on
-encryption, set the same password in the mobile application 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 the mobile
-application encrypts the file contents, the file name remains visible
-on the file systems of the local computer, the server, and the mobile
-device.
-
-@node Pushing to the mobile application
-@subsection Pushing to the mobile application
-
-@findex org-mobile-push
-@vindex org-mobile-files
-The command @code{org-mobile-push} copies files listed in
-@code{org-mobile-files} into the staging area. Files include agenda files
-(as listed in @code{org-agenda-files}). Customize @code{org-mobile-files} to
-add other files. File names are 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
-as their targets.}.
-
-Push creates a special Org file @samp{agendas.org} with custom agenda views
-defined by the user@footnote{While creating the agendas, Org mode forces @samp{ID} properties
-on all referenced entries, so that these entries can be uniquely
-identified if Org Mobile 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 then relies
-on outline paths, assuming they are unique.}.
-
-Finally, Org writes the file @samp{index.org}, containing links to other
-files. The mobile application reads this file first from the server
-to determine what other files to download for agendas. For faster
-downloads, it is expected to only read files whose checksums@footnote{Checksums are stored automatically in the file
-@samp{checksums.dat}.}
-have changed.
-
-@node Pulling from the mobile application
-@subsection Pulling from the mobile application
-
-@findex org-mobile-pull
-The command @code{org-mobile-pull} synchronizes changes with the server.
-More specifically, it first pulls the Org files for viewing. It then
-appends captured entries and pointers to flagged or changed entries to
-the file @samp{mobileorg.org} on the server. Org ultimately integrates its
-data in an inbox file format, through the following steps:
-
-@enumerate
-@item
-@vindex org-mobile-inbox-for-pull
-Org moves all entries found in @samp{mobileorg.org}@footnote{The file will be empty after this operation.} and appends
-them to the file pointed to by the variable
-@code{org-mobile-inbox-for-pull}. It should reside neither in the
-staging area nor on the server. Each captured entry and each
-editing event is a top-level entry in the inbox file.
-
-@item
-@cindex @samp{FLAGGED}, tag
-After moving the entries, Org processes changes to the shared
-files. Some of them are applied directly and without user
-interaction. Examples include changes to tags, TODO state,
-headline and body text. Entries requiring further action are
-tagged as @samp{FLAGGED}. Org marks entries with problems with an error
-message in the inbox. They have to be resolved manually.
-
-@item
-Org generates an agenda view for flagged entries for user
-intervention to clean up. For notes stored in flagged entries, Org
-displays them in the echo area when point is on the corresponding
-agenda item.
-
-@table @asis
-@item @kbd{?}
-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
-@samp{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 ? @r{(Agenda dispatcher)}
-From the agenda dispatcher, @kbd{?} returns to the view to finish
-processing flagged entries. Note that these entries may not be the
-most recent since the mobile application searches files that were last
-pulled. To get an updated agenda view with changes since the last
-pull, pull again.
-
-@node Hacking
-@appendix Hacking
-
-@cindex hacking
-
-This appendix describes some ways a user can extend the functionality
-of Org.
-
-@menu
-* Hooks: Hooks (2). How to reach into Org's internals.
-* Add-on Packages:: Available extensions.
-* Adding Hyperlink Types:: New custom link types.
-* Adding Export Back-ends:: How to write new export back-ends.
-* Tables in Arbitrary Syntax:: Orgtbl for LaTeX and other programs.
-* Dynamic Blocks:: Automatically filled blocks.
-* Special Agenda Views:: Customized views.
-* Speeding Up Your Agendas:: Tips on how to speed up your agendas.
-* Extracting Agenda Information:: Post-processing agenda information.
-* Using the Property API:: Writing programs that use entry properties.
-* Using the Mapping API:: Mapping over all or selected entries.
-@end menu
-
-@node Hooks (2)
-@appendixsec Hooks
-
-@cindex hooks
-
-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{https://orgmode.org/worg/doc.html#hooks}.
-
-@node Add-on Packages
-@appendixsec Add-on Packages
-
-@cindex add-on packages
-
-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{https://orgmode.org}. See the @samp{contrib/README} file in the source code
-directory for a list of contributed files. Worg page with more
-information is at: @uref{https://orgmode.org/worg/org-contrib/}.
-
-@node Adding Hyperlink Types
-@appendixsec Adding Hyperlink Types
-
-@cindex hyperlinks, adding new types
-
-Org has many built-in hyperlink types (see @ref{Hyperlinks}), and an
-interface for adding new link types. The following example shows the
-process of adding Org links to Unix man pages, which look like this
-
-@example
-[[man:printf][The printf manual]]
-@end example
-
-
-@noindent
-The following @samp{ol-man.el} file implements it
-
-@lisp
-;;; ol-man.el - Support for links to man pages in Org mode
-(require 'ol)
-
-(org-link-set-parameters "man"
- :follow #'org-man-open
- :export #'org-man-export
- :store #'org-man-store-link)
-
-(defcustom org-man-command 'man
- "The Emacs command to be used to display a man page."
- :group 'org-link
- :type '(choice (const man) (const woman)))
-
-(defun org-man-open (path _)
- "Visit the manpage on PATH.
-PATH should be a topic that can be thrown at the man command."
- (funcall org-man-command path))
-
-(defun org-man-store-link ()
- "Store a link to a man page."
- (when (memq major-mode '(Man-mode woman-mode))
- ;; This is a man page, we do make this link.
- (let* ((page (org-man-get-page-name))
- (link (concat "man:" page))
- (description (format "Man page for %s" page)))
- (org-link-store-props
- :type "man"
- :link link
- :description description))))
-
-(defun org-man-get-page-name ()
- "Extract the page name from the buffer name."
- ;; This works for both `Man-mode' and `woman-mode'.
- (if (string-match " \\(\\S-+\\)\\*" (buffer-name))
- (match-string 1 (buffer-name))
- (error "Cannot create link to this man page")))
-
-(defun org-man-export (link description format _)
- "Export a man page link from Org files."
- (let ((path (format "http://man.he.net/?topic=%s&section=all" link))
- (desc (or description link)))
- (pcase format
- (`html (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
- (`latex (format "\\href@{%s@}@{%s@}" path desc))
- (`texinfo (format "@@uref@{%s,%s@}" path desc))
- (`ascii (format "%s (%s)" desc path))
- (t path))))
-
-(provide ol-man)
-;;; ol-man.el ends here
-@end lisp
-
-@noindent
-To activate links to man pages in Org, enter this in the Emacs init
-file:
-
-@lisp
-(require 'ol-man)
-@end lisp
-
-@noindent
-A review of @samp{ol-man.el}:
-
-@enumerate
-@item
-First, @samp{(require 'ol)} ensures that @samp{ol.el} is loaded.
-
-@item
-@findex org-link-set-parameters
-@vindex org-link-parameters
-Then @code{org-link-set-parameters} defines a new link type with @samp{man}
-prefix and associates functions for following, exporting and
-storing such links. See the variable @code{org-link-parameters} for
-a complete list of possible associations.
-
-@item
-The rest of the file implements necessary variables and functions.
-
-For example, @code{org-man-store-link} is responsible for storing a link
-when @code{org-store-link} (see @ref{Handling Links}) is called from a buffer
-displaying a man page. It first checks if the major mode is
-appropriate. If check fails, the function returns @code{nil}, which
-means it isn't responsible for creating a link to the current
-buffer. Otherwise the function makes a link string by combining
-the @samp{man:} prefix with the man topic. It also provides a default
-description. The function @code{org-insert-link} can insert it back
-into an Org buffer later on.
-@end enumerate
-
-@node Adding Export Back-ends
-@appendixsec Adding Export Back-ends
-
-@cindex Export, writing back-ends
-
-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.
-
-@findex org-export-define-backend
-@findex org-export-define-derived-backend
-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 @samp{ox-latex.el} for an example of defining
-a new back-end from scratch, and @samp{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 @uref{https://orgmode.org/worg/dev/org-export-reference.html, the Org Export Reference on Worg}.
-
-@node Tables in Arbitrary Syntax
-@appendixsec Tables in Arbitrary Syntax
-
-@cindex tables, in other modes
-@cindex lists, in other modes
-@cindex Orgtbl mode
-
-Due to Org's success in handling tables with Orgtbl, a frequently
-requested feature is the use of Org's table functions in other modes,
-e.g., @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 is in the hands of those who know those formats
-best.
-
-@menu
-* Radio tables:: Sending and receiving radio tables.
-* A @LaTeX{} example:: Step by step, almost a tutorial.
-* Translator functions:: Copy and modify.
-@end menu
-
-@node Radio tables
-@appendixsubsec Radio tables
-
-@cindex radio tables
-
-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 is the magic words @samp{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 */
-/* END RECEIVE ORGTBL table_name */
-@end example
-
-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 @samp{ORGTBL}, keyword
-@example
-#+ORGTBL: SEND table_name translation_function arguments ...
-@end example
-
-
-@noindent
-@samp{table_name} is the table's reference name, which is also used in the
-receiver lines, and the @samp{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 @asis
-@item @samp{:skip N}
-Skip the first N lines of the table. Hlines do count; include them
-if they are to be skipped.
-
-@item @samp{:skipcols (n1 n2 ...)}
-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
-
-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
-@item
-Place the table in a block comment. For example, in C mode you
-could wrap the table between @samp{/*} and @samp{*/} lines.
-
-@item
-Put the table after an ``end'' statement. For example @code{\bye} in @TeX{}
-and @code{\end@{document@}} in @LaTeX{}.
-
-@item
-Comment and un-comment each line of the table during edits. The
-@kbd{M-x orgtbl-toggle-comment} command makes toggling easy.
-@end itemize
-
-@node A @LaTeX{} example
-@appendixsubsec A @LaTeX{} example of radio tables
-
-@cindex @LaTeX{}, and Orgtbl mode
-
-To wrap a source table in @LaTeX{}, use the @samp{comment} environment
-provided by @samp{comment.sty}@footnote{@uref{https://www.ctan.org/pkg/comment}}. 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 modes.} with the command @kbd{M-x orgtbl-insert-radio-table}, which prompts for a table name. For
-example, if @samp{salesfigures} is the name, the template inserts:
-
-@example
-% BEGIN RECEIVE ORGTBL salesfigures
-% END RECEIVE ORGTBL salesfigures
-\begin@{comment@}
-#+ORGTBL: SEND salesfigures orgtbl-to-latex
-| | |
-\end@{comment@}
-@end example
-
-@vindex LaTeX-verbatim-environments
-@noindent
-The line @samp{#+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 @samp{salesfigures}. Now
-the table is ready for data entry. It can even use spreadsheet
-features@footnote{If the @samp{TBLFM} keyword 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 @samp{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 @samp{comment} environment to the
-variable @code{LaTeX-verbatim-environments}.}:
-
-@example
-% BEGIN RECEIVE ORGTBL salesfigures
-% END RECEIVE ORGTBL salesfigures
-\begin@{comment@}
-#+ORGTBL: SEND salesfigures orgtbl-to-latex
-| Month | Days | Nr sold | per day |
-|-------+------+---------+---------|
-| Jan | 23 | 55 | 2.4 |
-| Feb | 21 | 16 | 0.8 |
-| March | 22 | 278 | 12.6 |
-#+TBLFM: $4=$3/$2;%.1f
-% $ (optional extra dollar to keep Font Lock happy, see footnote)
-\end@{comment@}
-@end example
-
-After editing, @kbd{C-c C-c} inserts the translated table at the
-target location, between the two marker lines.
-
-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@}
-Month & \multicolumn@{1@}@{c@}@{Days@} & Nr.\ sold & per day\\
-% BEGIN RECEIVE ORGTBL salesfigures
-% END RECEIVE ORGTBL salesfigures
-\end@{tabular@}
-%
-\begin@{comment@}
-#+ORGTBL: SEND salesfigures orgtbl-to-latex :splice t :skip 2
-| Month | Days | Nr sold | per day |
-|-------+------+---------+---------|
-| Jan | 23 | 55 | 2.4 |
-| Feb | 21 | 16 | 0.8 |
-| March | 22 | 278 | 12.6 |
-#+TBLFM: $4=$3/$2;%.1f
-\end@{comment@}
-@end example
-
-The @LaTeX{} translator function @code{orgtbl-to-latex} is already part of
-Orgtbl mode and uses a @samp{tabular} environment to typeset the table and
-marks horizontal lines with @code{\hline}. For additional parameters to
-control output, see @ref{Translator functions}:
-
-@table @asis
-@item @samp{:splice BOOLEAN}
-When @{@{@{var(BOOLEAN@}@}@} is non-@code{nil}, return only table body lines;
-i.e., not wrapped in @samp{tabular} environment. Default is @code{nil}.
-
-@item @samp{:fmt FMT}
-Format string to warp each field. It should contain @samp{%s} for the
-original field value. For example, to wrap each field value in
-dollar symbol, you could use @samp{:fmt "$%s$"}. Format can also wrap
-a property list with column numbers and formats, for example @samp{:fmt
- (2 "$%s$" 4 "%s\\%%")}. In place of a string, a function of one
-argument can be used; the function must return a formatted string.
-
-@item @samp{:efmt EFMT}
-Format numbers as exponentials. The spec should have @samp{%s} twice for
-inserting mantissa and exponent, for example @samp{"%s\\times10^@{%s@}"}. This
-may also be a property list with column numbers and formats, for
-example @samp{:efmt (2 "$%s\\times10^@{%s@}$" 4 "$%s\\cdot10^@{%s@}$")}. After
-@var{EFMT} has been applied to a value, @var{FMT}---see
-above---is also applied. Functions with two arguments can be
-supplied instead of strings. By default, no special formatting is
-applied.
-@end table
-
-@node Translator functions
-@appendixsubsec Translator functions
-
-@cindex HTML, and Orgtbl mode
-@cindex translator function
-
-@findex orgtbl-to-csv
-@findex orgtbl-to-tsv
-@findex orgtbl-to-latex
-@findex orgtbl-to-html
-@findex orgtbl-to-texinfo
-@findex orgtbl-to-unicode
-@findex orgtbl-to-orgtbl
-@findex orgtbl-to-generic
-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.
-
-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, @code{\\}, with @code{\\[2mm]}:
-
-@example
-#+ORGTBL: SEND test orgtbl-to-latex :lend " \\\\[2mm]"
-@end example
-
-
-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:
-
-@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
-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
-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, at @email{emacs-orgmode@@gnu.org}.
-
-@node Dynamic Blocks
-@appendixsec Dynamic Blocks
-
-@cindex dynamic blocks
-
-Org supports @emph{dynamic blocks} in Org documents. They are inserted
-with begin and end markers like any other code block, but the contents
-are updated automatically by a user function.
-
-@kindex C-c C-x x
-@findex org-dynamic-block-insert-dblock
-You can insert a dynamic block with @code{org-dynamic-block-insert-dblock},
-which is bound to @kbd{C-c C-x x} by default. For example,
-@kbd{C-c C-x x c l o c k t a b l e @key{RET}} inserts a table that
-updates the work time (see @ref{Clocking Work Time}).
-
-Dynamic blocks can have names and function parameters. The syntax is
-similar to source code block specifications:
-
-@example
-#+BEGIN: myblock :parameter1 value1 :parameter2 value2 ...
- ...
-#+END:
-@end example
-
-These commands update dynamic blocks:
-
-@table @asis
-@item @kbd{C-c C-x C-u} (@code{org-dblock-update})
-@kindex C-c C-x C-u
-@findex org-dblock-update
-Update dynamic block at point.
-
-@item @kbd{C-u C-c C-x C-u}
-@kindex C-u C-c C-x C-u
-Update all dynamic blocks in the current file.
-@end table
-
-Before updating a dynamic block, Org removes content between the
-@samp{BEGIN} and @samp{END} markers. Org then reads the parameters on the
-@samp{BEGIN} line for passing to the writer function as a plist. The
-previous content of the dynamic block becomes erased from the buffer
-and appended to the plist under @code{:content}.
-
-The syntax for naming a writer function with a dynamic block labeled
-@samp{myblock} is: @code{org-dblock-write:myblock}.
-
-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"
- ...
-#+END:
-@end example
-
-@noindent
-The dynamic block's writer function:
-
-@lisp
-(defun org-dblock-write:block-update-time (params)
- (let ((fmt (or (plist-get params :format) "%d. %m. %Y")))
- (insert "Last block update at: "
- (format-time-string fmt))))
-@end lisp
-
-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.
-
-@findex org-narrow-to-block
-Dynamic blocks, like any other block, can be narrowed with
-@code{org-narrow-to-block}.
-
-@node Special Agenda Views
-@appendixsec Special Agenda Views
-
-@cindex agenda views, user-defined
-
-@vindex org-agenda-skip-function
-@vindex org-agenda-skip-function-global
-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 @samp{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 @samp{waiting} tag and
-returns @code{nil} on match. Otherwise it gives the location from where
-the search continues.
-
-@lisp
-(defun my-skip-unless-waiting ()
- "Skip trees that are not waiting"
- (let ((subtree-end (save-excursion (org-end-of-subtree t))))
- (if (re-search-forward ":waiting:" subtree-end t)
- nil ; tag found, do not skip
- subtree-end))) ; tag not found, continue after end of subtree
-@end lisp
-
-To use this custom function in a custom agenda command:
-
-@lisp
-(org-add-agenda-custom-command
- '("b" todo "PROJECT"
- ((org-agenda-skip-function 'my-skip-unless-waiting)
- (org-agenda-overriding-header "Projects waiting for something: "))))
-@end lisp
-
-@vindex org-agenda-overriding-header
-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
-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 @asis
-@item @samp{(org-agenda-skip-entry-if 'scheduled)}
-Skip current entry if it has been scheduled.
-
-@item @samp{(org-agenda-skip-entry-if 'notscheduled)}
-Skip current entry if it has not been scheduled.
-
-@item @samp{(org-agenda-skip-entry-if 'deadline)}
-Skip current entry if it has a deadline.
-
-@item @samp{(org-agenda-skip-entry-if 'scheduled 'deadline)}
-Skip current entry if it has a deadline, or if it is scheduled.
-
-@item @samp{(org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))}
-Skip current entry if the TODO keyword is TODO or WAITING@.
-
-@item @samp{(org-agenda-skip-entry-if 'todo 'done)}
-Skip current entry if the TODO keyword marks a DONE state.
-
-@item @samp{(org-agenda-skip-entry-if 'timestamp)}
-Skip current entry if it has any timestamp, may also be deadline or
-scheduled.
-
-@item @samp{(org-agenda-skip-entry-if 'regexp "regular expression")}
-Skip current entry if the regular expression matches in the entry.
-
-@item @samp{(org-agenda-skip-entry-if 'notregexp "regular expression")}
-Skip current entry unless the regular expression matches.
-
-@item @samp{(org-agenda-skip-subtree-if 'regexp "regular expression")}
-Same as above, but check and skip the entire subtree.
-@end table
-
-The following is an example of a search for @samp{waiting} without the
-special function:
-
-@lisp
-(org-add-agenda-custom-command
- '("b" todo "PROJECT"
- ((org-agenda-skip-function '(org-agenda-skip-subtree-if
- 'regexp ":waiting:"))
- (org-agenda-overriding-header "Projects waiting for something: "))))
-@end lisp
-
-@node Speeding Up Your Agendas
-@appendixsec Speeding Up Your Agendas
-
-@cindex agenda views, optimization
-
-Some agenda commands slow down when the Org files grow in size or
-number. Here are tips to speed up:
-
-@itemize
-@item
-Reduce the number of Org agenda files to avoid slowdowns due to hard drive
-accesses.
-
-@item
-Reduce the number of DONE and archived headlines so agenda
-operations that skip over these can finish faster.
-
-@item
-Do not dim blocked tasks:
-@vindex org-agenda-dim-blocked-tasks
-
-@lisp
-(setq org-agenda-dim-blocked-tasks nil)
-@end lisp
-
-@item
-Stop preparing agenda buffers on startup:
-@vindex org-startup-folded
-@vindex org-agenda-inhibit-startup
-
-@lisp
-(setq org-agenda-inhibit-startup t)
-@end lisp
-
-@item
-Disable tag inheritance for agendas:
-@vindex org-agenda-show-inherited-tags
-@vindex org-agenda-use-tag-inheritance
-
-@lisp
-(setq org-agenda-use-tag-inheritance nil)
-@end lisp
-@end itemize
-
-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{https://orgmode.org/worg/agenda-optimization.html, dedicated Worg page} for agenda
-optimization.
-
-@node Extracting Agenda Information
-@appendixsec Extracting Agenda Information
-
-@cindex agenda, pipe
-@cindex scripts, for agenda processing
-
-Org provides commands to access agendas through Emacs batch mode.
-Through this command-line interface, agendas are automated for further
-processing or printing.
-
-@vindex org-agenda-custom-commands
-@findex org-batch-agenda
-@code{org-batch-agenda} creates an agenda view in ASCII and outputs to
-standard output. This command takes one string parameter. When
-string consists of a single character, Org uses it as a key to
-@code{org-agenda-custom-commands}. These are the same ones available
-through the agenda dispatcher (see @ref{Agenda Dispatcher}).
-
-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
-
-
-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 \
- -eval '(org-batch-agenda "+shop-NewYork")' | lpr
-@end example
-
-@noindent
-An example showing on-the-fly parameter modifications:
-
-@example
-emacs -batch -l ~/.emacs \
- -eval '(org-batch-agenda "a" \
- org-agenda-span (quote month) \
- org-agenda-include-diary nil \
- org-agenda-files (quote ("~/org/project.org")))' \
- | lpr
-@end example
-
-@noindent
-which produces an agenda for the next 30 days from just the
-@samp{~/org/projects.org} file.
-
-@findex org-batch-agenda-csv
-For structured processing of agenda output, use @code{org-batch-agenda-csv}
-with the following fields:
-
-@table @asis
-@item category
-The category of the item
-@item head
-The headline, without TODO keyword, TAGS and PRIORITY
-@item type
-The type of the agenda entry, can be
-
-@multitable {aaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa}
-@item @code{todo}
-@tab selected in TODO match
-@item @code{tagsmatch}
-@tab selected in tags match
-@item @code{diary}
-@tab imported from diary
-@item @code{deadline}
-@tab a deadline
-@item @code{scheduled}
-@tab scheduled
-@item @code{timestamp}
-@tab appointment, selected by timestamp
-@item @code{closed}
-@tab entry was closed on date
-@item @code{upcoming-deadline}
-@tab warning about nearing deadline
-@item @code{past-scheduled}
-@tab forwarded scheduled item
-@item @code{block}
-@tab entry has date block including date
-@end multitable
-
-@item todo
-The TODO keyword, if any
-@item tags
-All tags including inherited ones, separated by colons
-@item date
-The relevant date, like @samp{2007-2-14}
-@item time
-The time, like @samp{15:00-16:50}
-@item extra
-String with extra planning info
-@item priority-l
-The priority letter if any was given
-@item priority-n
-The computed numerical priority
-@end table
-
-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.
-
-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
-
-# define the Emacs command to run
-$cmd = "emacs -batch -l ~/.emacs -eval '(org-batch-agenda-csv \"t\")'";
-
-# run it and capture the output
-$agenda = qx@{$cmd 2>/dev/null@};
-
-# loop over all lines
-foreach $line (split(/\n/,$agenda)) @{
- # get the individual values
- ($category,$head,$type,$todo,$tags,$date,$time,$extra,
- $priority_l,$priority_n) = split(/,/,$line);
- # process and print
- print "[ ] $head\n";
-@}
-@end example
-
-@node Using the Property API
-@appendixsec 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.
-
-@defun org-entry-properties &optional pom which
-Get all properties of the entry at point-or-marker @var{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. @var{POM} may also
-be @code{nil}, in which case the current entry is used. If
-@var{WHICH} is @code{nil} or @code{all}, get all properties. If
-@var{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 @var{PROPERTY} for entry at point-or-marker
-@var{POM}. By default, this only looks at properties defined
-locally in the entry. If @var{INHERIT} is non-@code{nil} and the
-entry does not have the property, then also check higher levels of the
-hierarchy. If @var{INHERIT} is the symbol @code{selective}, use
-inheritance if and only if the setting of
-@code{org-use-property-inheritance} selects @var{PROPERTY} for
-inheritance.
-@end defun
-
-@defun org-entry-delete pom property
-Delete the property @var{PROPERTY} from entry at point-or-marker
-@var{POM}.
-@end defun
-
-@defun org-entry-put pom property value
-Set @var{PROPERTY} to @var{VALUES} for entry at
-point-or-marker POM@.
-@end defun
-
-@defun org-buffer-property-keys &optional include-specials
-Get all property keys in the current buffer.
-@end defun
-
-@defun org-insert-property-drawer
-Insert a property drawer for the current entry. Also
-@end defun
-
-@defun org-entry-put-multivalued-property pom property &rest values
-Set @var{PROPERTY} at point-or-marker @var{POM} to
-@var{VALUES}. @var{VALUES} should be a list of strings.
-They are concatenated, with spaces as separators.
-@end defun
-
-@defun org-entry-get-multivalued-property pom property
-Treat the value of the property @var{PROPERTY} as
-a whitespace-separated list of values and return the values as a list
-of strings.
-@end defun
-
-@defun org-entry-add-to-multivalued-property pom property value
-Treat the value of the property @var{PROPERTY} as
-a whitespace-separated list of values and make sure that
-@var{VALUE} is in this list.
-@end defun
-
-@defun org-entry-remove-from-multivalued-property pom property value
-Treat the value of the property @var{PROPERTY} as
-a whitespace-separated list of values and make sure that
-@var{VALUE} is @emph{not} in this list.
-@end defun
-
-@defun org-entry-member-in-multivalued-property pom property value
-Treat the value of the property @var{PROPERTY} as
-a whitespace-separated list of values and check if @var{VALUE} is
-in this list.
-@end defun
-
-@defopt org-property-allowed-value-functions
-Hook for functions supplying allowed values for a specific property.
-The functions must take a single argument, the name of the property,
-and return a flat list of allowed values. If @samp{:ETC} is one of the
-values, use the values as completion help, but allow also other values
-to be entered. The functions must return @code{nil} if they are not
-responsible for this property.
-@end defopt
-
-@node Using the Mapping API
-@appendixsec 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:
-
-@defun org-map-entries func &optional match scope &rest skip
-Call @var{FUNC} at each headline selected by @var{MATCH} in
-@var{SCOPE}.
-
-@var{FUNC} is a function or a Lisp form. With point positioned
-at the beginning of the headline, call the function without arguments.
-Org returns an alist of return values of calls to the function.
-
-To avoid preserving point, Org wraps the call to @var{FUNC} in
-@code{save-excursion} form. After evaluation, Org moves point 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
-@var{FUNC} set the variable @code{org-map-continue-from} to a specific
-buffer position.
-
-@var{MATCH} is a tags/property/TODO match. Org iterates only
-matched headlines. Org iterates over all headlines when
-@var{MATCH} is @code{nil} or @code{t}.
-
-@var{SCOPE} determines the scope of this command. It can be any
-of:
-
-@table @asis
-@item @code{nil}
-The current buffer, respecting the restriction, if any.
-
-@item @code{tree}
-The subtree started with the entry at point.
-
-@item @code{region}
-The entries within the active region, if any.
-
-@item @code{file}
-The current buffer, without restriction.
-
-@item @code{file-with-archives}
-The current buffer, and any archives associated with it.
-
-@item @code{agenda}
-All agenda files.
-
-@item @code{agenda-with-archives}
-All agenda files with any archive files associated with them.
-
-@item list of filenames
-If this is a list, all files in the list are scanned.
-@end table
-
-@noindent
-The remaining arguments are treated as settings for the scanner's
-skipping facilities. Valid arguments are:
-
-@table @asis
-@item @code{archive}
-Skip trees with the @samp{ARCHIVE} tag.
-
-@item @code{comment}
-Skip trees with the COMMENT keyword.
-
-@item function or Lisp form
-@vindex org-agenda-skip-function
-Used as value for @code{org-agenda-skip-function}, so whenever the
-function returns @code{t}, @var{FUNC} is called for that entry and
-search continues from the point where the function leaves it.
-@end table
-@end defun
-
-The mapping routine can call any arbitrary function, even functions
-that change meta data or query the property API (see @ref{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 the many possible values for the argument
-@var{ARG}.
-@end defun
-
-@defun org-priority &optional action
-Change the priority of the entry. See the docstring of this function
-for the possible values for @var{ACTION}.
-@end defun
-
-@defun org-toggle-tag tag &optional onoff
-Toggle the tag @var{TAG} in the current entry. Setting
-@var{ONOFF} to either @code{on} or @code{off} does not toggle tag, but
-ensure that it is either on or off.
-@end defun
-
-@defun org-promote
-Promote the current entry.
-@end defun
-
-@defun org-demote
-Demote the current entry.
-@end defun
-
-This example turns all entries tagged with @samp{TOMORROW} into TODO
-entries with keyword @samp{UPCOMING}. Org ignores entries in comment trees
-and archive trees.
-
-@lisp
-(org-map-entries '(org-todo "UPCOMING")
- "+TOMORROW" 'file 'archive 'comment)
-@end lisp
-
-The following example counts the number of entries with TODO keyword
-@samp{WAITING}, in all agenda files.
-
-@lisp
-(length (org-map-entries t "/+WAITING" 'agenda))
-@end lisp
-
-@node History and Acknowledgments
-@appendix History and Acknowledgments
-
-
-
-@anchor{From Carsten}
-@appendixsec From Carsten
-
-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
-@samp{outline-magic.el}, but quickly moved to the more general @samp{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 the
-@email{emacs-orgmode@@gnu.org, mailing list} have provided a constant stream of bug reports, feedback,
-new ideas, and sometimes patches and add-on code. Many thanks to
-everyone who has helped to improve this package. I am trying to keep
-here a list of the people who had significant influence in shaping one
-or more aspects of Org. The list may not be complete, if I have
-forgotten someone, please accept my apologies and let me know.
-
-Before I get to this list, a few special mentions are in order:
-
-@table @asis
-@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 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. 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 (@samp{org-attach.el}), integration
-with Apple Mail (@samp{org-mac-message.el}), hierarchical dependencies of
-TODO items, habit tracking (@samp{org-habits.el}), and encryption
-(@samp{org-crypt.el}). Also, the capture system is really an extended
-copy of his great @samp{remember.el}.
-
-@item Sebastian Rose
-Without Sebastian, the HTML/XHTML publishing of Org would be the
-pitiful work of an ignorant amateur. Sebastian has pushed this part
-of Org onto a much higher level. He also wrote @samp{org-info.js},
-a JavaScript program for displaying webpages derived from Org using
-an Info-like or a folding interface with single-key navigation.
-@end table
-
-See below for the full list of contributions! Again, please let me
-know what I am missing here!
-
-@anchor{From Bastien}
-@appendixsec From Bastien
-
-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 getting more confident over time, with both the community and the
-code.
-
-When I took over maintainership, I knew I would have to make Org more
-collaborative than ever, as I would have to rely on people that are
-more knowledgeable than I am on many parts of the code. Here is
-a list of the persons I could rely on, they should really be
-considered co-maintainers, either of the code or the community:
-
-@table @asis
-@item Eric Schulte
-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 @samp{org-element.el} and @samp{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 into a flexible and conceptually clean process. He patiently
-coped with the many hiccups that such a change can create for users.
-
-@item Nick Dokos
-The Org mode mailing list would not be such a nice place without
-Nick, who patiently helped users so many times. It is impossible to
-overestimate such a great help, and the list would not be so active
-without him.
-@end table
-
-I received support from so many users that it is clearly impossible to
-be fair when shortlisting a few of them, but Org's history would not
-be complete if the ones above were not mentioned in this manual.
-
-@anchor{List of Contributions}
-@appendixsec List of Contributions
-
-@itemize
-@item
-Russell Adams came up with the idea for drawers.
-
-@item
-Thomas Baumann wrote @samp{ol-bbdb.el} and @samp{ol-mhe.el}.
-
-@item
-Christophe Bataillon created the great unicorn logo that we use on
-the Org mode website.
-
-@item
-Alex Bochannek provided a patch for rounding timestamps.
-
-@item
-Jan Böcker wrote @samp{ol-docview.el}.
-
-@item
-Brad Bozarth showed how to pull RSS feed data into Org files.
-
-@item
-Tom Breton wrote @samp{org-choose.el}.
-
-@item
-Charles Cave's suggestion sparked the implementation of templates
-for Remember, which are now templates for capture.
-
-@item
-Pavel Chalmoviansky influenced the agenda treatment of items with
-specified time.
-
-@item
-Gregory Chernov patched support for Lisp forms into table
-calculations and improved XEmacs compatibility, in particular by
-porting @samp{nouline.el} to XEmacs.
-
-@item
-Sacha Chua suggested copying some linking code from Planner.
-
-@item
-Baoqiu Cui contributed the DocBook exporter.
-
-@item
-Eddward DeVilla proposed and tested checkbox statistics. He also
-came up with the idea of properties, and that there should be an API
-for them.
-
-@item
-Nick Dokos tracked down several nasty bugs.
-
-@item
-Kees Dullemond used to edit projects lists directly in HTML and so
-inspired some of the early development, including HTML export. He
-also asked for a way to narrow wide table columns.
-
-@item
-Thomas@tie{}S@.@tie{}Dye contributed documentation on Worg and helped
-integrating the Org Babel documentation into the manual.
-
-@item
-Christian Egli converted the documentation into Texinfo format,
-inspired the agenda, patched CSS formatting into the HTML exporter,
-and wrote @samp{org-taskjuggler.el}.
-
-@item
-David Emery provided a patch for custom CSS support in exported HTML
-agendas.
-
-@item
-Nic Ferrier contributed mailcap and XOXO support.
-
-@item
-Miguel@tie{}A@.@tie{}Figueroa-Villanueva implemented hierarchical checkboxes.
-
-@item
-John Foerch figured out how to make incremental search show context
-around a match in a hidden outline tree.
-
-@item
-Raimar Finken wrote @samp{org-git-line.el}.
-
-@item
-Mikael Fornius works as a mailing list moderator.
-
-@item
-Austin Frank works as a mailing list moderator.
-
-@item
-Eric Fraga drove the development of Beamer export with ideas and
-testing.
-
-@item
-Barry Gidden did proofreading the manual in preparation for the book
-publication through Network Theory Ltd.
-
-@item
-Niels Giesen had the idea to automatically archive DONE trees.
-
-@item
-Nicolas Goaziou rewrote much of the plain list code.
-
-@item
-Kai Grossjohann pointed out key-binding conflicts with other
-packages.
-
-@item
-Brian Gough of Network Theory Ltd publishes the Org mode manual as
-a book.
-
-@item
-Bernt Hansen has driven much of the support for auto-repeating
-tasks, task state change logging, and the clocktable. His clear
-explanations have been critical when we started to adopt the Git
-version control system.
-
-@item
-Manuel Hermenegildo has contributed various ideas, small fixes and
-patches.
-
-@item
-Phil Jackson wrote @samp{ol-irc.el}.
-
-@item
-Scott Jaderholm proposed footnotes, control over whitespace between
-folded entries, and column view for properties.
-
-@item
-Matt Jones wrote MobileOrg Android.
-
-@item
-Tokuya Kameshima wrote @samp{org-wl.el} and @samp{org-mew.el}.
-
-@item
-Shidai Liu (``Leo'') asked for embedded @LaTeX{} and tested it. He also
-provided frequent feedback and some patches.
-
-@item
-Matt Lundin has proposed last-row references for table formulas and
-named invisible anchors. He has also worked a lot on the FAQ@.
-
-@item
-David Maus wrote @samp{org-atom.el}, maintains the issues file for Org,
-and is a prolific contributor on the mailing list with competent
-replies, small fixes and patches.
-
-@item
-Jason@tie{}F@.@tie{}McBrayer suggested agenda export to CSV format.
-
-@item
-Max Mikhanosha came up with the idea of refiling.
-
-@item
-Dmitri Minaev sent a patch to set priority limits on a per-file
-basis.
-
-@item
-Stefan Monnier provided a patch to keep the Emacs Lisp compiler
-happy.
-
-@item
-Richard Moreland wrote MobileOrg for the iPhone.
-
-@item
-Rick Moynihan proposed allowing multiple TODO sequences in a file
-and being able to quickly restrict the agenda to a subtree.
-
-@item
-Todd Neal provided patches for links to Info files and Elisp forms.
-
-@item
-Greg Newman refreshed the unicorn logo into its current form.
-
-@item
-Tim O'Callaghan suggested in-file links, search options for general
-file links, and tags.
-
-@item
-Osamu Okano wrote @samp{orgcard2ref.pl}, a Perl program to create a text
-version of the reference card.
-
-@item
-Takeshi Okano translated the manual and David O'Toole's tutorial
-into Japanese.
-
-@item
-Oliver Oppitz suggested multi-state TODO items.
-
-@item
-Scott Otterson sparked the introduction of descriptive text for
-links, among other things.
-
-@item
-Pete Phillips helped during the development of the TAGS feature,
-and provided frequent feedback.
-
-@item
-Martin Pohlack provided the code snippet to bundle character
-insertion into bundles of 20 for undo.
-
-@item
-T@.@tie{}V@.@tie{}Raman reported bugs and suggested improvements.
-
-@item
-Matthias Rempe (Oelde) provided ideas, Windows support, and quality
-control.
-
-@item
-Paul Rivier provided the basic implementation of named footnotes.
-He also acted as mailing list moderator for some time.
-
-@item
-Kevin Rogers contributed code to access VM files on remote hosts.
-
-@item
-Frank Ruell solved the mystery of the @samp{keymapp nil} bug, a conflict
-with @samp{allout.el}.
-
-@item
-Jason Riedy generalized the send-receive mechanism for Orgtbl
-tables with extensive patches.
-
-@item
-Philip Rooke created the Org reference card, provided lots of
-feedback, developed and applied standards to the Org documentation.
-
-@item
-Christian Schlauer proposed angular brackets around links, among
-other things.
-
-@item
-Paul Sexton wrote @samp{org-ctags.el}.
-
-@item
-Tom Shannon's @samp{organizer-mode.el} inspired linking to VM/BBDB/Gnus.
-
-@item
-Ilya Shlyakhter proposed the Archive Sibling, line numbering in
-literal examples, and remote highlighting for referenced code lines.
-
-@item
-Stathis Sideris wrote the @samp{ditaa.jar} ASCII to PNG converter that is
-now packaged into Org's @samp{contrib/} directory.
-
-@item
-Daniel Sinder came up with the idea of internal archiving by locking
-subtrees.
-
-@item
-Dale Smith proposed link abbreviations.
-
-@item
-James TD Smith has contributed a large number of patches for
-useful tweaks and features.
-
-@item
-Adam Spiers asked for global linking commands, inspired the link
-extension system, added support for Mairix, and proposed the mapping
-API@.
-
-@item
-Ulf Stegemann created the table to translate special symbols to
-HTML, @LaTeX{}, UTF-8, Latin-1 and ASCII@.
-
-@item
-Andy Stewart contributed code to @samp{ol-w3m.el}, to copy
-HTML content with links transformation to Org syntax.
-
-@item
-David O'Toole wrote @samp{org-publish.el} and drafted the
-manual chapter about publishing.
-
-@item
-Jambunathan@tie{}K@.@tie{}contributed the ODT exporter.
-
-@item
-Sebastien Vauban reported many issues with @LaTeX{} and Beamer export
-and enabled source code highlighting in Gnus.
-
-@item
-Stefan Vollmar organized a video-recorded talk at the
-Max-Planck-Institute for Neurology. He also inspired the creation
-of a concept index for HTML export.
-
-@item
-Jürgen Vollmer contributed code generating the table of contents in
-HTML output.
-
-@item
-Samuel Wales has provided important feedback and bug reports.
-
-@item
-Chris Wallace provided a patch implementing the @samp{QUOTE} block.
-
-@item
-David Wainberg suggested archiving, and improvements to the
-linking system.
-
-@item
-Carsten Wimmer suggested some changes and helped fix a bug in
-linking to Gnus.
-
-@item
-Roland Winkler requested additional key bindings to make Org work on
-a TTY@.
-
-@item
-Piotr Zielinski wrote @samp{org-mouse.el}, proposed agenda
-blocks and contributed various ideas and code snippets.
-
-@item
-Marco Wahl wrote @samp{ol-eww.el}.
-@end itemize
-
-@node GNU Free Documentation License
-@appendix GNU Free Documentation License
-
-@center Version 1.3, 3 November 2008
-
-@display
-Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
-@uref{https://fsf.org/}
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@enumerate 0
-@item
-PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-functional and useful document @dfn{free}
-in the sense of freedom: to assure everyone the effective freedom
-to copy and redistribute it, with or without modifying it, either
-commercially or noncommercially. Secondarily, this License
-preserves for the author and publisher a way to get credit for
-their work, while not being considered responsible for
-modifications made by others.
-
-This License is a kind of ``copyleft'', which means that derivative
-works of the document must themselves be free in the same sense.
-It complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for
-free software, because free software needs free documentation:
-a free program should come with manuals providing the same freedoms
-that the software does. But this License is not limited to
-software manuals; it can be used for any textual work, regardless
-of subject matter or whether it is published as a printed book. We
-recommend this License principally for works whose purpose is
-instruction or reference.
-
-@item
-APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work, in any medium,
-that contains a notice placed by the copyright holder saying it can
-be distributed under the terms of this License. Such a notice
-grants a world-wide, royalty-free license, unlimited in duration,
-to use that work under the conditions stated herein. The
-``Document'', below, refers to any such manual or work. Any member
-of the public is a licensee, and is addressed as ``you''. You accept
-the license if you copy, modify or distribute the work in a way
-requiring permission under copyright law.
-
-A ``Modified Version'' of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A ``Secondary Section'' is a named appendix or a front-matter section
-of the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall
-subject (or to related matters) and contains nothing that could
-fall directly within that overall subject. (Thus, if the Document
-is in part a textbook of mathematics, a Secondary Section may not
-explain any mathematics.) The relationship could be a matter of
-historical connection with the subject or with related matters, or
-of legal, commercial, philosophical, ethical or political position
-regarding them.
-
-The ``Invariant Sections'' are certain Secondary Sections whose
-titles are designated, as being those of Invariant Sections, in the
-notice that says that the Document is released under this License.
-If a section does not fit the above definition of Secondary then it
-is not allowed to be designated as Invariant. The Document may
-contain zero Invariant Sections. If the Document does not identify
-any Invariant Sections then there are none.
-
-The ``Cover Texts'' are certain short passages of text that are
-listed, as Front-Cover Texts or Back-Cover Texts, in the notice
-that says that the Document is released under this License.
-A Front-Cover Text may be at most 5 words, and a Back-Cover Text
-may be at most 25 words.
-
-A ``Transparent'' copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, that is suitable for revising the document
-straightforwardly with generic text editors or (for images composed
-of pixels) generic paint programs or (for drawings) some widely
-available drawing editor, and that is suitable for input to text
-formatters or for automatic translation to a variety of formats
-suitable for input to text formatters. A copy made in an otherwise
-Transparent file format whose markup, or absence of markup, has
-been arranged to thwart or discourage subsequent modification by
-readers is not Transparent. An image format is not Transparent if
-used for any substantial amount of text. A copy that is not
-``Transparent'' is called ``Opaque''.
-
-Examples of suitable formats for Transparent copies include plain
-ASCII without markup, Texinfo input format, @LaTeX{} input format,
-SGML or XML using a publicly available DTD, and standard-conforming
-simple HTML, PostScript or PDF designed for human modification.
-Examples of transparent image formats include PNG, XCF and JPG@.
-Opaque formats include proprietary formats that can be read and
-edited only by proprietary word processors, SGML or XML for which
-the DTD and/or processing tools are not generally available, and
-the machine-generated HTML, PostScript or PDF produced by some word
-processors for output purposes only.
-
-The ``Title Page'' means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the
-material this License requires to appear in the title page. For
-works in formats which do not have any title page as such, ``Title
-Page'' means the text near the most prominent appearance of the
-work's title, preceding the beginning of the body of the text.
-
-The ``publisher'' means any person or entity that distributes copies
-of the Document to the public.
-
-A section ``Entitled XYZ'' means a named subunit of the Document
-whose title either is precisely XYZ or contains XYZ in parentheses
-following text that translates XYZ in another language. (Here XYZ
-stands for a specific section name mentioned below, such as
-``Acknowledgements'', ``Dedications'', ``Endorsements'', or ``History''.)
-To ``Preserve the Title'' of such a section when you modify the
-Document means that it remains a section ``Entitled XYZ'' according
-to this definition.
-
-The Document may include Warranty Disclaimers next to the notice
-which states that this License applies to the Document. These
-Warranty Disclaimers are considered to be included by reference in
-this License, but only as regards disclaiming warranties: any other
-implication that these Warranty Disclaimers may have is void and
-has no effect on the meaning of this License.
-
-@item
-VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License
-applies to the Document are reproduced in all copies, and that you
-add no other conditions whatsoever to those of this License. You
-may not use technical measures to obstruct or control the reading
-or further copying of the copies you make or distribute. However,
-you may accept compensation in exchange for copies. If you
-distribute a large enough number of copies you must also follow the
-conditions in section 3.
-
-You may also lend copies, under the same conditions stated above,
-and you may publicly display copies.
-
-@item
-COPYING IN QUANTITY
-
-If you publish printed copies (or copies in media that commonly
-have printed covers) of the Document, numbering more than 100, and
-the Document's license notice requires Cover Texts, you must
-enclose the copies in covers that carry, clearly and legibly, all
-these Cover Texts: Front-Cover Texts on the front cover, and
-Back-Cover Texts on the back cover. Both covers must also clearly
-and legibly identify you as the publisher of these copies. The
-front cover must present the full title with all words of the title
-equally prominent and visible. You may add other material on the
-covers in addition. Copying with changes limited to the covers, as
-long as they preserve the title of the Document and satisfy these
-conditions, can be treated as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto
-adjacent pages.
-
-If you publish or distribute Opaque copies of the Document
-numbering more than 100, you must either include a machine-readable
-Transparent copy along with each Opaque copy, or state in or with
-each Opaque copy a computer-network location from which the general
-network-using public has access to download using public-standard
-network protocols a complete Transparent copy of the Document, free
-of added material. If you use the latter option, you must take
-reasonably prudent steps, when you begin distribution of Opaque
-copies in quantity, to ensure that this Transparent copy will
-remain thus accessible at the stated location until at least one
-year after the last time you distribute an Opaque copy (directly or
-through your agents or retailers) of that edition to the public.
-
-It is requested, but not required, that you contact the authors of
-the Document well before redistributing any large number of copies,
-to give them a chance to provide you with an updated version of the
-Document.
-
-@item
-MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document
-under the conditions of sections 2 and 3 above, provided that you
-release the Modified Version under precisely this License, with the
-Modified Version filling the role of the Document, thus licensing
-distribution and modification of the Modified Version to whoever
-possesses a copy of it. In addition, you must do these things in
-the Modified Version:
-
-@enumerate A
-@item
-Use in the Title Page (and on the covers, if any) a title
-distinct from that of the Document, and from those of previous
-versions (which should, if there were any, be listed in the
-History section of the Document). You may use the same title as
-a previous version if the original publisher of that version
-gives permission.
-
-@item
-List on the Title Page, as authors, one or more persons or
-entities responsible for authorship of the modifications in the
-Modified Version, together with at least five of the principal
-authors of the Document (all of its principal authors, if it has
-fewer than five), unless they release you from this requirement.
-
-@item
-State on the Title page the name of the publisher of the
-Modified Version, as the publisher.
-
-@item
-Preserve all the copyright notices of the Document.
-
-@item
-Add an appropriate copyright notice for your modifications
-adjacent to the other copyright notices.
-
-@item
-Include, immediately after the copyright notices, a license
-notice giving the public permission to use the Modified Version
-under the terms of this License, in the form shown in the
-Addendum below.
-
-@item
-Preserve in that license notice the full lists of Invariant
-Sections and required Cover Texts given in the Document's
-license notice.
-
-@item
-Include an unaltered copy of this License.
-
-@item
-Preserve the section Entitled ``History'', Preserve its Title, and
-add to it an item stating at least the title, year, new authors,
-and publisher of the Modified Version as given on the Title
-Page. If there is no section Entitled ``History'' in the Document,
-create one stating the title, year, authors, and publisher of
-the Document as given on its Title Page, then add an item
-describing the Modified Version as stated in the previous
-sentence.
-
-@item
-Preserve the network location, if any, given in the Document
-for public access to a Transparent copy of the Document, and
-likewise the network locations given in the Document for
-previous versions it was based on. These may be placed in the
-``History'' section. You may omit a network location for a work
-that was published at least four years before the Document
-itself, or if the original publisher of the version it refers
-to gives permission.
-
-@item
-For any section Entitled ``Acknowledgements'' or ``Dedications'',
-Preserve the Title of the section, and preserve in the section
-all the substance and tone of each of the contributor
-acknowledgements and/or dedications given therein.
-
-@item
-Preserve all the Invariant Sections of the Document, unaltered
-in their text and in their titles. Section numbers or the
-equivalent are not considered part of the section titles.
-
-@item
-Delete any section Entitled ``Endorsements''. Such a section may
-not be included in the Modified Version.
-
-@item
-Do not retitle any existing section to be Entitled
-``Endorsements'' or to conflict in title with any Invariant
-Section.
-
-@item
-Preserve any Warranty Disclaimers.
-@end enumerate
-
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section Entitled ``Endorsements'', provided it contains
-nothing but endorsements of your Modified Version by various
-parties---for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-
-@item
-COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under
-this License, under the terms defined in section 4 above for
-modified versions, provided that you include in the combination all
-of the Invariant Sections of all of the original documents,
-unmodified, and list them all as Invariant Sections of your
-combined work in its license notice, and that you preserve all
-their Warranty Disclaimers.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name
-but different contents, make the title of each such section unique
-by adding at the end of it, in parentheses, the name of the
-original author or publisher of that section if known, or else
-a unique number. Make the same adjustment to the section titles in
-the list of Invariant Sections in the license notice of the
-combined work.
-
-In the combination, you must combine any sections Entitled
-``History'' in the various original documents, forming one section
-Entitled ``History''; likewise combine any sections Entitled
-``Acknowledgements'', and any sections Entitled ``Dedications''. You
-must delete all sections Entitled ``Endorsements.''
-
-@item
-COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other
-documents released under this License, and replace the individual
-copies of this License in the various documents with a single copy
-that is included in the collection, provided that you follow the
-rules of this License for verbatim copying of each of the documents
-in all other respects.
-
-You may extract a single document from such a collection, and
-distribute it individually under this License, provided you insert
-a copy of this License into the extracted document, and follow this
-License in all other respects regarding verbatim copying of that
-document.
-
-@item
-AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other
-separate and independent documents or works, in or on a volume of
-a storage or distribution medium, is called an ``aggregate'' if the
-copyright resulting from the compilation is not used to limit the
-legal rights of the compilation's users beyond what the individual
-works permit. When the Document is included in an aggregate, this
-License does not apply to the other works in the aggregate which
-are not themselves derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one half
-of the entire aggregate, the Document's Cover Texts may be placed
-on covers that bracket the Document within the aggregate, or the
-electronic equivalent of covers if the Document is in electronic
-form. Otherwise they must appear on printed covers that bracket
-the whole aggregate.
-
-@item
-TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of
-section 4. Replacing Invariant Sections with translations requires
-special permission from their copyright holders, but you may
-include translations of some or all Invariant Sections in addition
-to the original versions of these Invariant Sections. You may
-include a translation of this License, and all the license notices
-in the Document, and any Warranty Disclaimers, provided that you
-also include the original English version of this License and the
-original versions of those notices and disclaimers. In case of
-a disagreement between the translation and the original version of
-this License or a notice or disclaimer, the original version will
-prevail.
-
-If a section in the Document is Entitled ``Acknowledgements'',
-``Dedications'', or ``History'', the requirement (section 4) to
-Preserve its Title (section 1) will typically require changing the
-actual title.
-
-@item
-TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense, or distribute it is void,
-and will automatically terminate your rights under this License.
-
-However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the
-copyright holder fails to notify you of the violation by some
-reasonable means prior to 60 days after the cessation.
-
-Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from
-that copyright holder, and you cure the violation prior to 30 days
-after your receipt of the notice.
-
-Termination of your rights under this section does not terminate
-the licenses of parties who have received copies or rights from you
-under this License. If your rights have been terminated and not
-permanently reinstated, receipt of a copy of some or all of the
-same material does not give you any rights to use it.
-
-@item
-FUTURE REVISIONS OF THIS LICENSE
-
-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{https://www.gnu.org/copyleft/}.
-
-Each version of the License is given a distinguishing version
-number. If the Document specifies that a particular numbered
-version of this License ``or any later version'' applies to it, you
-have the option of following the terms and conditions either of
-that specified version or of any later version that has been
-published (not as a draft) by the Free Software Foundation. If
-the Document does not specify a version number of this License,
-you may choose any version ever published (not as a draft) by the
-Free Software Foundation. If the Document specifies that a proxy
-can decide which future versions of this License can be used, that
-proxy's public statement of acceptance of a version permanently
-authorizes you to choose that version for the Document.
-
-@item
-RELICENSING
-
-``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any
-World Wide Web server that publishes copyrightable works and also
-provides prominent facilities for anybody to edit those works.
-A public wiki that anybody can edit is an example of such
-a server. A ``Massive Multiauthor Collaboration'' (or ``MMC'')
-contained in the site means any set of copyrightable works thus
-published on the MMC site.
-
-``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0
-license published by Creative Commons Corporation,
-a not-for-profit corporation with a principal place of business in
-San Francisco, California, as well as future copyleft versions of
-that license published by that same organization.
-
-``Incorporate'' means to publish or republish a Document, in whole
-or in part, as part of another Document.
-
-An MMC is ``eligible for relicensing'' if it is licensed under this
-License, and if all works that were first published under this
-License somewhere other than this MMC, and subsequently
-incorporated in whole or in part into the MMC, (1) had no cover
-texts or invariant sections, and (2) were thus incorporated prior
-to November 1, 2008.
-
-The operator of an MMC Site may republish an MMC contained in the
-site under CC-BY-SA on the same site at any time before August 1,
-2009, provided the MMC is eligible for relicensing.
-@end enumerate
-
-@page
-
-@anchor{ADDENDUM How to use this License for your documents}
-@appendixsec ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
-@example
-Copyright (C) YEAR YOUR NAME.
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.3
-or any later version published by the Free Software Foundation;
-with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
-Texts. A copy of the license is included in the section entitled ``GNU
-Free Documentation License''.
-@end example
-
-If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with@dots{}Texts.''@tie{}line with this:
-
-@example
-with the Invariant Sections being LIST THEIR TITLES, with
-the Front-Cover Texts being LIST, and with the Back-Cover Texts
-being LIST.
-@end example
-
-If you have Invariant Sections without Cover Texts, or some other
-combination of the three, merge those two alternatives to suit the
-situation.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License, to
-permit their use in free software.
-
-@node Main Index
-@chapter Main Index
-
-@printindex cp
-
-@node Key Index
-@chapter Key Index
-
-@printindex ky
-
-@node Command and Function Index
-@chapter Command and Function Index
-
-@printindex fn
-
-@node Variable Index
-@chapter 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} and then click yourself through the tree.
-
-@printindex vr
-
-@bye
diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi
index 0d4f9769115..4ba067fd81f 100644
--- a/doc/misc/pcl-cvs.texi
+++ b/doc/misc/pcl-cvs.texi
@@ -839,7 +839,7 @@ files.
@item f
Find the file that the cursor points to (@code{cvs-mode-find-file}). If
the cursor points to a directory, run @code{dired} on that directory;
-@inforef{Dired, , emacs}.
+@pxref{Dired, Emacs Manual, , emacs}.
@item o
Like @kbd{f}, but use another window
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index ff8133b2a1f..ae3a3b13e62 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -124,10 +124,11 @@ server in a network, and servers relay messages from one to the next.
Here's a typical example:
@cindex redirection to random servers
-When you connect to the Freenode network
-(@code{http://freenode.net/}), you point your IRC client at the
-server @code{chat.freenode.net}. That server will redirect your client
-to a random server on the network, such as @code{zelazny.freenode.net}.
+When you connect to the Libera.Chat network
+(@code{https://libera.chat}), you point your IRC client at the
+server @code{irc.libera.chat}. That server will redirect your client
+to a random server on the network, such as
+@code{zirconium.libera.chat}.
@cindex channel name
@cindex # starts a channel name
@@ -171,15 +172,23 @@ using a different nick. This will prompt you for four things:
@table @asis
@cindex server, connecting
-@cindex Freenode network
+@cindex Libera.Chat network
@item IRC Server
What server do you want to connect to? All the servers in a particular
-network are equivalent. Some networks use a round-robin system where a
-single server redirects new connections to a random server in the
-network. @code{chat.freenode.net} is such a server for the Freenode
-network. Freenode provides the network ``for the Free and Open Source
-Software communities, for not-for-profit organizations and for related
-communities and organizations.''
+network are equivalent. Some networks use a round-robin system where
+a single server redirects new connections to a random server in the
+network. @code{irc.libera.chat} is such a server for the Libera.Chat
+network. Libera.Chat's purpose is ``to provide services such as a
+community platform for free open-source software and peer directed
+projects on a volunteer basis,'' and was chosen as the official home
+of the GNU Project and the Free Software Foundation's IRC channels in
+June 2021 in the aftermath of the changes in governance and policies
+of the Freenode IRC network. GNU and FSF's announcements about this
+are at
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html},
+@uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html},
+and
+@uref{https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html}.
@cindex port, connecting
@cindex 6667, default IRC port
@@ -205,13 +214,13 @@ in use, you might for example get assigned the nick @code{alex`}.
A space separated list of channels you want to join when connecting.
You don't need to join any channels, if you just want to have one-to-one
conversations with friends on the same network. If you're new to the
-Freenode network, join @code{#emacs}, the channel about all things
+Libera.Chat network, join @code{#emacs}, the channel about all things
Emacs, or join @code{#rcirc}, the channel about @code{rcirc}.
@end table
@cindex server buffer
When you have answered these questions, @code{rcirc} will create a server
-buffer, which will be named something like @file{*chat.freenode.net*},
+buffer, which will be named something like @file{*irc.libera.chat*},
and a channel buffer for each of the channels you wanted to join.
@kindex RET
@@ -482,7 +491,7 @@ Here's an example of how to set it:
@end example
By default you will be connected to the @code{rcirc} support channel:
-@code{#rcirc} on @code{chat.freenode.net}.
+@code{#rcirc} on @code{irc.libera.chat}.
@table @code
@item :nick
@@ -554,8 +563,8 @@ Here is an example to illustrate how you would set it:
@example
(setq rcirc-authinfo
- '(("freenode" nickserv "bob" "p455w0rd")
- ("freenode" chanserv "bob" "#bobland" "passwd99")
+ '(("Libera.Chat" nickserv "bob" "p455w0rd")
+ ("Libera.Chat" chanserv "bob" "#bobland" "passwd99")
("bitlbee" bitlbee "robert" "sekrit")))
@end example
@@ -590,6 +599,12 @@ Use this symbol if you need to identify yourself in the Bitlbee channel
as follows: @code{identify secret}. The necessary arguments are the
nickname you want to use this for, and the password to use.
+@item sasl
+@cindex sasl authentication
+Use this symbol if you want to use @acronym{SASL} authentication. The
+necessary arguments are the nickname you want to use this for, and the
+password to use.
+
@cindex gateway to other IM services
@cindex instant messaging, other services
@cindex Jabber
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index 599252fabf7..88ca4450d59 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -254,73 +254,6 @@ version 20.2. It has also been bundled and pre-installed with XEmacs
plug-in package which is available from the @value{XEMACSFTP}. See the
XEmacs 21.x documentation on package installation for details.
-Users of earlier Emacs distributions (including Emacs 19) or people
-craving for new features and bugs can get a copy of the @RefTeX{}
-distribution from the maintainer's web page. @xref{Imprint}, for more
-information. The following instructions will guide you through the
-process of installing such a distribution.
-
-@subsection Building and Installing
-
-Note: Currently installation is supported for Emacs only. XEmacs users
-might want to refer to the @RefTeX{} package available through the
-package system of XEmacs.
-
-@subsubheading Installation with make
-
-In order to install RefTeX, unpack the distribution and edit the header
-of the Makefile. Basically, you need to change the path specifications
-for Emacs Lisp files and info files. Also, enter the name of your Emacs
-executable (usually either @samp{emacs} or @samp{xemacs}).
-
-Then, type
-
-@example
-make
-make install
-@end example
-
-to compile and install the code and documentation.
-
-Per default @RefTeX{} is installed in its own subdirectory which might
-not be on your load path. In this case, add it to load path with a
-command like the following, replacing the sample directory with the one
-where @RefTeX{} is installed in your case.
-
-@example
-(add-to-list 'load-path "/path/to/reftex")
-@end example
-
-Put this command into your init file before other @RefTeX{}-related
-settings.
-
-@subsubheading Installation by Hand
-
-If you want to get your hands dirty, there is also the possibility to
-install by manually copying files.
-
-@enumerate a
-@item
-Copy the reftex*.el lisp files to a directory on your load path. Make
-sure that no old copy of @RefTeX{} shadows these files.
-@item
-Byte compile the files. The sequence of compiling should be:
-reftex-var.el, reftex.el, and then all the others.
-@item
-Copy the info file reftex.info to the info directory.
-@end enumerate
-
-@subsection Loading @RefTeX{}
-
-In order to make the most important functions for entering @RefTeX{}
-mode available add the following line to your init file.
-
-@example
-(require 'reftex)
-@end example
-
-@subsection Entering @RefTeX{} Mode
-
@findex turn-on-reftex
@findex reftex-mode
@vindex LaTeX-mode-hook
@@ -3259,9 +3192,9 @@ with the @kbd{g} key. To get this behavior, use instead
@AUCTeX{} is without doubt the best major mode for editing @TeX{} and @LaTeX{}
files with Emacs (@pxref{Top,AUCTeX,,auctex, The AUCTeX User Manual}).
-If @AUCTeX{} is not part of your Emacs distribution, you can get
-it@footnote{XEmacs 21.x users may want to install the corresponding
-XEmacs package.} by FTP from the @value{AUCTEXSITE}.
+You can get it from its home page at @value{AUCTEXSITE}, but since
+it is available from GNU ELPA, you can simply install it from @kbd{M-x
+list-packages}.
@menu
* AUCTeX-RefTeX Interface:: How both packages work together
@@ -3611,18 +3544,6 @@ after the @samp{@{step+@}}, also when specifying how to get
context.
@item
-@b{Idle timers in XEmacs}@*
-@cindex Idle timer restart
-@vindex reftex-use-itimer-in-xemacs
-In XEmacs, idle timer restart does not work reliably after fast
-keystrokes. Therefore @RefTeX{} currently uses the post command
-hook to start the timer used for automatic crossref information. When
-this bug gets fixed, a real idle timer can be requested with
-@lisp
-(setq reftex-use-itimer-in-xemacs t)
-@end lisp
-
-@item
@b{Viper mode}@*
@cindex Viper mode
@cindex Key bindings, problems with Viper mode
@@ -4688,7 +4609,7 @@ Footer to insert in BibTeX files generated by
@end defopt
-@node Options - Index Support, Options - Viewing Cross-References, Options - Creating Citations, Options
+@node Options - Index Support
@section Index Support
@cindex Options, Index support
@cindex Index support, options
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index 80065be0a16..91e67a8798b 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -3,11 +3,12 @@
@setfilename ../../info/remember.info
@settitle Remember Manual
@include docstyle.texi
+@include emacsver.texi
@syncodeindex fn cp
@c %**end of header
@copying
-This manual is for Remember Mode, version 2.0
+This manual is for Remember Mode, as distributed with Emacs @value{EMACSVER}.
Copyright @copyright{} 2001, 2004--2005, 2007--2021 Free Software
Foundation, Inc.
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index c37291ac143..70a19484e8a 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -142,7 +142,7 @@ Move point ``up'' one reference (@code{senator-go-to-up-reference}).
The meaning of ``up'' is language-dependent; in C++, for instance,
this means moving to the parent of the current tag.
-@item C-c, @key{SPC}
+@item C-c , @key{SPC}
Display a list of possible completions for the symbol at point
(@code{semantic-complete-analyze-inline}). This also activates a
special set of keybindings for choosing a completion: @key{RET}
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index dd481d2101e..f5d567533b6 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -264,12 +264,14 @@ file, @pxref{Top,,auth-source, auth, Emacs auth-source Library}.
@cindex CRAM-MD5
@cindex PLAIN
@cindex LOGIN
-The process by which the SMTP library authenticates you to the server
-is known as ``Simple Authentication and Security Layer'' (SASL).
-There are various SASL mechanisms, and this library supports three of
-them: CRAM-MD5, PLAIN, and LOGIN, where the first uses a form of
+The process by which the @acronym{SMTP} library authenticates you to
+the server is known as ``Simple Authentication and Security Layer''
+(@acronym{SASL}). There are various @acronym{SASL} mechanisms, and
+this library supports three of them: @code{cram-md5}, @code{plain},
+@code{login} and @code{xoauth2}, where the first uses a form of
encryption to obscure your password, while the other two do not. It
-tries each of them, in that order, until one succeeds. You can
+tries each of them, in that order, until one succeeds.
+(@code{xoauth2} requires using the @file{oauth2.el} library. You can
override this by assigning a specific authentication mechanism to a
server by including a key @code{smtp-auth} with the value of your
preferred mechanism in the appropriate @file{~/.authinfo} entry.
@@ -338,6 +340,16 @@ not sent immediately but rather queued in the directory
@code{smtpmail-send-queued-mail} (typically when you connect to the
internet).
+@item smtpmail-store-queue-variables
+@vindex smtpmail-store-queue-variables
+ Normally the queue will be dispatched with the values of the
+@acronym{SMTP} variables that are in effect when @kbd{M-x
+smtpmail-send-queued-mail} is executed, but if
+@code{smtpmail-store-queue-variables} is non-@code{nil}, the values
+for @code{smtpmail-smtp-server} (etc.@:) will be stored when the mail is
+queued, and then used when actually sending the mail. This can be
+useful if you have a complex outgoing mail setup.
+
@item smtpmail-queue-dir
@vindex smtpmail-queue-dir
The variable @code{smtpmail-queue-dir} specifies the name of the
diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi
index a0e999b6812..1f7473c151a 100644
--- a/doc/misc/srecode.texi
+++ b/doc/misc/srecode.texi
@@ -259,7 +259,7 @@ contexts to have the same name. Some standard contexts are
@code{file}, @code{declaration}, and @code{classdecl}.
A context can be automatically derived as well based on the parsing
-state from @i{Semantic}. @inforef{Top, Semantic Manual, semantic}.
+state from @i{Semantic}. @xref{Top, Semantic Manual,, semantic}.
@section Applications
Commands that do a particular user task which involves also writing
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index dac7ae3d199..a91181b116e 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -1181,7 +1181,7 @@ where each line of input produces a line of output.}
% double any backslashes. Otherwise, a name like "\node" will be
% interpreted as a newline (\n), followed by o, d, e. Not good.
%
-% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and
+% See https://mailman.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and
% related messages. The final outcome is that it is up to the TeX user
% to double the backslashes and otherwise make the string valid, so
% that's what we do. pdftex 1.30.0 (ca.2005) introduced a primitive to
@@ -3539,7 +3539,7 @@ $$%
% We use the free feym* fonts from the eurosym package by Henrik
% Theiling, which support regular, slanted, bold and bold slanted (and
% "outlined" (blackboard board, sort of) versions, which we don't need).
-% It is available from http://www.ctan.org/tex-archive/fonts/eurosym.
+% It is available from https://www.ctan.org/tex-archive/fonts/eurosym.
%
% Although only regular is the truly official Euro symbol, we ignore
% that. The Euro is designed to be slightly taller than the regular
diff --git a/doc/misc/todo-mode.texi b/doc/misc/todo-mode.texi
index dbd7f3d02f7..b3ea652a7ec 100644
--- a/doc/misc/todo-mode.texi
+++ b/doc/misc/todo-mode.texi
@@ -122,7 +122,7 @@ Todo Display Features
@end detailmenu
@end menu
-@node Overview, Todo Mode Entry Points, Top, Top
+@node Overview
@chapter Overview
The Todo mode package provides facilities for making and maintaining
@@ -146,7 +146,7 @@ most important differences, @ref{Legacy Todo Mode Files}.
* Todo Items as Diary Entries::
@end menu
-@node Levels of Organization, Todo Items as Diary Entries, , Overview
+@node Levels of Organization
@section Levels of Organization
In Todo mode each todo list is identified with a named category, so you
@@ -184,7 +184,7 @@ associating various kinds of metadata with it, e.g., the category it
belongs to, its priority, whether it is to be included in the Emacs
diary, date and time stamps, whether it is done or still to do.
-@node Todo Items as Diary Entries, , Levels of Organization, Overview
+@node Todo Items as Diary Entries
@section Todo Items as Diary Entries
You can have todo items show up in the Emacs Fancy Diary display by
@@ -213,7 +213,7 @@ from a Todo mode file, clicking or typing @key{RET} on this item will
switch to the buffer visiting that file and properly display the item's
category, with point on the item.
-@node Todo Mode Entry Points, Key Binding Conventions, Overview, Top
+@node Todo Mode Entry Points
@chapter Todo Mode Entry Points
To initialize your first todo file, invoke the command @code{todo-show}.
@@ -275,7 +275,7 @@ that was displayed on quitting current for subsequent Todo mode commands
category in Todo mode, in which case the latter become current for Todo
mode commands).
-@node Key Binding Conventions, Navigation, Todo Mode Entry Points, Top
+@node Key Binding Conventions
@chapter Key Binding Conventions
For Todo mode commands to function properly, it is essential to maintain
@@ -301,7 +301,7 @@ those beginning with @kbd{A} apply to archives (a special type of Todo
file; @ref{Todo Archive Mode}). Todo commands applying to items,
which constitute the majority, are bound to lower case key sequences.
-@node Navigation, Editing, Key Binding Conventions, Top
+@node Navigation
@chapter Navigation
The navigation commands are for making another todo file, category, or
@@ -389,7 +389,7 @@ or higher than the current one.
Navigation to other types of Todo files is discussed in the relevant
sections below.
-@node Editing, Todo Archives, Navigation, Top
+@node Editing
@chapter Editing
Editing in Todo mode means making structural or textual changes at one
@@ -412,7 +412,7 @@ Todo mode with @kbd{q}.
* Item Editing::
@end menu
-@node File Editing, Category Editing, , Editing
+@node File Editing
@section File Editing and Todo Edit Mode
There are four file-level editing commands:
@@ -470,7 +470,7 @@ containing inconsistent information (see the cautionary note in
displays a warning to this effect.
@end table
-@node Category Editing, Item Editing, File Editing, Editing
+@node Category Editing
@section Category Editing
The following commands are available for editing specifically at the
@@ -520,7 +520,7 @@ i.e., typing @kbd{C-u C g}, prompts for a file and confines merging to a
category in that file.
@end table
-@node Item Editing, , Category Editing, Editing
+@node Item Editing
@section Item Editing
Todo mode provides commands for adding new items as well as textually
@@ -534,7 +534,7 @@ you a lot of flexibility to fine-tune these operations to your needs.
* Relocating and Removing Items::
@end menu
-@node Inserting New Items, Editing Item Headers and Text, , Item Editing
+@node Inserting New Items
@subsection Inserting New Items
To add a new todo item to a category, type @kbd{i}, which is bound to
@@ -761,7 +761,7 @@ calendar after you have entered the item's text, and then you can
choose a date from the calendar.)
-@node Editing Item Headers and Text, Relocating and Removing Items, Inserting New Items, Item Editing
+@node Editing Item Headers and Text
@subsection Editing Item Headers and Text
To make changes to an existing item's content or header, type @kbd{e},
@@ -945,7 +945,7 @@ really want to toggle the diary-inclusion and calendar-marking status
of all items in the category, you can do this by marking all the items
and then invoking @kbd{e y} or @kbd{e k}, @pxref{Marked Items}).
-@node Relocating and Removing Items, , Editing Item Headers and Text, Item Editing
+@node Relocating and Removing Items
@subsection Relocating and Removing Items
In addition to inserting a new todo item and changing the text or header
@@ -960,7 +960,7 @@ removes it from the todo list but does not delete it.
* Done Items::
@end menu
-@node Reprioritizing Items, Moving and Deleting Items, , Relocating and Removing Items
+@node Reprioritizing Items
@subsubsection Reprioritizing Items
There are three ways to change a todo item's priority:
@@ -986,7 +986,7 @@ highest priority without prompting. (Prefix arguments have no effect
with @kbd{r} or @kbd{l}.)
@end table
-@node Moving and Deleting Items, Done Items, Reprioritizing Items, Relocating and Removing Items
+@node Moving and Deleting Items
@subsubsection Moving and Deleting Items
You can move an item to another category, thereby recategorizing it:
@@ -1032,7 +1032,7 @@ Todo command to undo a deletion. If you want to be able to use @key{SPC} for
confirmation, enable the option @code{todo-y-with-space}.
@end quotation
-@node Done Items, , Moving and Deleting Items, Relocating and Removing Items
+@node Done Items
@subsubsection Done Items
When the activity or thing that a todo item is about has been done, it
@@ -1118,7 +1118,7 @@ item has a comment, you are asked whether to delete it from the restored
item.
@end table
-@node Todo Archives, Marked Items, Editing, Top
+@node Todo Archives
@chapter Todo Archives
When the done items section of a category itself starts to become
@@ -1134,7 +1134,7 @@ the extension @samp{.toda} instead of @samp{.todo}.
* Todo Archive Mode::
@end menu
-@node Creating and Visiting Archives, Todo Archive Mode, , Todo Archives
+@node Creating and Visiting Archives
@section Creating and Visiting Archives
Todo mode provides the following command for archiving items:
@@ -1207,7 +1207,7 @@ As with todo files, you can also visit a Todo archive by invoking a
standard Emacs file-visiting command; this displays the first (on the
initial invocation) or current category of the archive.
-@node Todo Archive Mode, , Creating and Visiting Archives, Todo Archives
+@node Todo Archive Mode
@section Todo Archive Mode
When you visit a Todo archive, the buffer is in Todo Archive mode. It
@@ -1264,7 +1264,7 @@ The command @kbd{F k} (@pxref{File Editing}) is also available in Todo
Archive mode. It deletes the current archive file and prompts you
whether to delete the corresponding todo file.
-@node Marked Items, Todo Categories Mode, Todo Archives, Top
+@node Marked Items
@chapter Marked Items
For many item editing commands it can make sense and be convenient to
@@ -1329,7 +1329,7 @@ todo or marked done items, so if both types of items are marked,
invoking these commands has no effect and informs you of your
erroneous attempt.
-@node Todo Categories Mode, Searching for Items, Marked Items, Top
+@node Todo Categories Mode
@chapter Todo Categories Mode
It can be helpful to have a compact overview of the categories in a
@@ -1367,7 +1367,7 @@ to visit another todo file). To do this customize the option
* Reordering Categories::
@end menu
-@node Table of Item Counts, Reordering Categories, , Todo Categories Mode
+@node Table of Item Counts
@section Table of Item Counts
Above each column of the table is a labeled button you can press by
@@ -1428,7 +1428,7 @@ Typing @kbd{q} exits Todo Categories mode, killing the buffer and returning
to the current category in the Todo mode or Todo Archive mode buffer
from which you had invoked @kbd{F c}.
-@node Reordering Categories, , Table of Item Counts, Todo Categories Mode
+@node Reordering Categories
@section Reordering Categories
Todo Categories mode provide commands with which you can change the
@@ -1479,7 +1479,7 @@ have to renumber them again. This is one reason why you should
exercise caution when using @kbd{F e}.
@end quotation
-@node Searching for Items, Todo Filtered Items Mode, Todo Categories Mode, Top
+@node Searching for Items
@chapter Searching for Items
It can be useful to be able to locate and examine all todo items that
@@ -1506,7 +1506,7 @@ search and remove the highlighting later.
These commands are also available in Todo Archive mode.
-@node Todo Filtered Items Mode, Todo Display Features, Searching for Items, Top
+@node Todo Filtered Items Mode
@chapter Todo Filtered Items Mode
A more powerful alternative to sequential searching is item filtering,
@@ -1520,7 +1520,7 @@ category in a distinct mode, Todo Filtered Items mode.
* Files of Filtered Items::
@end menu
-@node Filtering Items, Todo Filtered Items Mode Commands, , Todo Filtered Items Mode
+@node Filtering Items
@section Filtering Items
Todo mode provides three ways to filter items: a general filter for
@@ -1593,7 +1593,7 @@ this invocation, overriding both @code{todo-top-priorities-overrides} and
@code{todo-top-priorities}.
@end itemize
-@node Todo Filtered Items Mode Commands, Files of Filtered Items, Filtering Items, Todo Filtered Items Mode
+@node Todo Filtered Items Mode Commands
@section Todo Filtered Items Mode Commands
The output of the item filtering commands looks similar to a regular
@@ -1650,7 +1650,7 @@ change the relative priorities of items from the same real category,
since that would make the filtered list inconsistent with the source
todo list.
-@node Files of Filtered Items, , Todo Filtered Items Mode Commands, Todo Filtered Items Mode
+@node Files of Filtered Items
@section Files of Filtered Items
Typing @kbd{s} in Todo Filtered Items mode saves the buffer of filtered
@@ -1701,7 +1701,7 @@ displaying its first category, as usual.
The command @kbd{F k} (@pxref{File Editing}) is also available in Todo
Filtered Items mode. It deletes the current filtered items file.
-@node Todo Display Features, Printing Todo Buffers, Todo Filtered Items Mode, Top
+@node Todo Display Features
@chapter Todo Display Features
You can change the appearance of Todo mode buffers in a variety of ways.
@@ -1712,7 +1712,7 @@ You can change the appearance of Todo mode buffers in a variety of ways.
* Other Display Commands and Options::
@end menu
-@node Faces, Item Prefix, , Todo Display Features
+@node Faces
@section Faces
Each of the Todo modes uses faces to distinguish various aspects of
@@ -1737,7 +1737,7 @@ The @code{todo-faces} customization group contains a complete list of
Todo mode faces and brief descriptions of their use.
-@node Item Prefix, Other Display Commands and Options, Faces, Todo Display Features
+@node Item Prefix
@section Item Prefix
In the default display of (real or virtual) categories in Todo mode,
@@ -1776,7 +1776,7 @@ displayed in a face (@code{todo-top-priority}) different from the face
of the prefix of non-top-priority items, so you see at a glance how
many items in the category are top priorities.
-@node Other Display Commands and Options, , Item Prefix, Todo Display Features
+@node Other Display Commands and Options
@section Other Display Commands and Options
There are two additional toggle commands that affect display in the
@@ -1842,7 +1842,7 @@ Categories mode and Todo Filtered Items mode, beyond those mentioned
above in the sections on these modes; see the customization groups
@code{todo-categories} and @code{todo-filtered} for details.
-@node Printing Todo Buffers, Legacy Todo Mode Files, Todo Display Features, Top
+@node Printing Todo Buffers
@chapter Printing Todo Buffers
If you print a Todo buffer using one of the standard Emacs printing
@@ -1865,7 +1865,7 @@ By default, Todo uses @code{ps-print-buffer-with-faces} to make the
printable version; you can change this by setting the option
@code{todo-print-function}.
-@node Legacy Todo Mode Files, GNU Free Documentation License, Printing Todo Buffers, Top
+@node Legacy Todo Mode Files
@chapter Legacy Todo Mode Files
Users of the original version of Todo mode will recognize from the
@@ -1912,7 +1912,7 @@ it often). (A delicate part of the conversion concerns the customizable
format of item date/time headers in the old-style; see the documentation
string of @code{todo-legacy-date-time-regexp} for details.)
-@node GNU Free Documentation License, , Legacy Todo Mode Files, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index c2e9fe66dfd..bd9bd998dfb 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -126,6 +126,7 @@ Configuring @value{tramp} for use
* Inline methods:: Inline methods.
* External methods:: External methods.
* GVFS-based methods:: @acronym{GVFS}-based external methods.
+* FUSE-based methods:: @acronym{FUSE}-based external methods.
* Default Method:: Selecting a default method.
* Default User:: Selecting a default user.
* Default Host:: Selecting a default host.
@@ -139,8 +140,10 @@ Configuring @value{tramp} for use
Setting own connection related information.
* Remote programs:: How @value{tramp} finds and uses programs on the remote host.
* Remote shell setup:: Remote shell setup hints.
+* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
-* Auto-save and Backup:: Auto-save and Backup.
+* Auto-save File Lock and Backup::
+ Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@@ -223,7 +226,7 @@ presented here to illustrate the steps involved:
@kbd{C-x C-f} to initiate find-file, enter part of the @value{tramp}
file name, then hit @kbd{@key{TAB}} for completion. If this is the
-first time connection to that host, here's what happens:
+first time connecting to that host, here's what happens:
@itemize
@item
@@ -250,17 +253,17 @@ message.
If @value{tramp} does not receive any messages within a timeout period
(a minute, for example), then @value{tramp} responds with an error
-message about not finding the remote shell prompt. If any messages
-from the remote host, @value{tramp} displays them in the buffer.
+message about not finding the remote shell prompt. If there are any
+messages from the remote host, @value{tramp} displays them in the
+buffer.
For any @samp{login failed} message from the remote host,
-@value{tramp} aborts the login attempt, and repeats the login steps
-again.
+@value{tramp} aborts the login attempt, and repeats the login steps.
@item
-Upon successful login and @value{tramp} recognizes the shell prompt
+Upon successful login, if @value{tramp} recognizes the shell prompt
from the remote host, @value{tramp} prepares the shell environment by
-turning off echoing, setting shell prompt, and other housekeeping
+turning off echoing, setting the shell prompt, and other housekeeping
chores.
@strong{Note} that for the remote shell, @value{tramp} invokes
@@ -282,8 +285,8 @@ contents from the remote host.
For inline transfers, @value{tramp} sends a command, such as
@samp{mimencode -b /path/to/remote/file}, waits until the output has
-accumulated in the buffer, decodes that output to produce the file's
-contents.
+accumulated in the buffer, then decodes that output to produce the
+file's contents.
For external transfers, @value{tramp} sends a command as follows:
@example
@@ -335,7 +338,7 @@ versions packaged with Emacs can be retrieved by
@end lisp
@value{tramp} is also available as @uref{https://elpa.gnu.org, GNU
-ELPA} package. Besides the standalone releases, further minor version
+ELPA} package. Besides the standalone releases, further minor versions
of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
release appears. These minor versions have a four-number string, like
``2.4.5.1''.
@@ -345,7 +348,7 @@ Development versions contain new and incomplete features. The
development version of @value{tramp} is always the version number of
the next release, plus the suffix ``-pre'', like ``2.4.4-pre''.
-One way to obtain @value{tramp} from Git server is to visit the
+One way to obtain @value{tramp} from the Git server is to visit the
Savannah project page at the following URL and then clicking on the
Git link in the navigation bar at the top.
@@ -363,7 +366,7 @@ $ git clone git://git.savannah.gnu.org/tramp.git
@end example
@noindent
-From behind a firewall:
+From behind a proxy:
@example
@group
@@ -411,7 +414,7 @@ $ autoconf
@end ifset
@ifclear installchapter
See the file @file{INSTALL} in that directory for further information
-how to install @value{tramp}.
+on how to install @value{tramp}.
@end ifclear
@@ -419,47 +422,47 @@ how to install @value{tramp}.
@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
+@value{tramp} extends the Emacs file name syntax by adding a remote
+component. A remote file name always looks 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
+can 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
+@code{rename-file}. And finally, you can even run 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}
+@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 method is used for syntactical reasons, @ref{Default Method}.
+Remote file names have @code{method}, @code{user} and @code{host}
+parts prepended. 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 thus
+@file{@trampfn{-,,}}. The @samp{-} notation for the default method is
+used for syntactical reasons, @ref{Default Method}.
The @code{method} part describes the connection method used to reach
the remote host, see below.
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}.
+which case it is written as @code{user%domain}.
-The @code{host} part must be a host name which could be resolved on
+The @code{host} part must be a host name which can 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}.
+connection methods also support a notation for the port to be used, in
+which case it is written as @code{host#port}.
-@anchor{Quick Start Guide: @option{ssh} and @option{plink} methods}
+@anchor{Quick Start Guide ssh and plink methods}
@section Using @option{ssh} and @option{plink}
@cindex method @option{ssh}
@cindex @option{ssh} method
@@ -470,36 +473,39 @@ If your local host runs an SSH client, and the remote host runs an SSH
server, the simplest 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}.
+local host, and is often used for testing @value{tramp}.
-On MS Windows, PuTTY is often used as SSH client. Its @command{plink}
+On MS Windows, PuTTY is often used as the 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}
+@anchor{Quick Start Guide su, sudo, doas and sg methods}
+@section Using @option{su}, @option{sudo}, @option{doas} and @option{sg}
@cindex method @option{su}
@cindex @option{su} method
@cindex method @option{sudo}
@cindex @option{sudo} method
+@cindex method @option{doas}
+@cindex @option{doas} method
@cindex method @option{sg}
@cindex @option{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
+permissions. For this, you can use the @option{su} or @option{sudo}
+connection method. On OpenBSD systems, the @option{doas} connection
+method offers the same functionality. These 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.
+The method @option{sg} stands for ``switch group''; here the user name
+is used as the group to change to. The default host name is the same.
-@anchor{Quick Start Guide: @option{ssh}, @option{plink}, @option{su}, @option{sudo} and @option{sg} methods}
-@section Combining @option{ssh} or @option{plink} with @option{su} or @option{sudo}
+@anchor{Quick Start Guide Combining ssh, plink, su, sudo and doas methods}
+@section Combining @option{ssh} or @option{plink} with @option{su}, @option{sudo} or @option{doas}
@cindex method @option{ssh}
@cindex @option{ssh} method
@cindex method @option{plink}
@@ -508,18 +514,20 @@ must be used here as user name. The default host name is the same.
@cindex @option{su} method
@cindex method @option{sudo}
@cindex @option{sudo} method
+@cindex method @option{doas}
+@cindex @option{doas} method
-If the @option{su} or @option{sudo} option shall be performed on
-another host, it could be comnbined with a leading @option{ssh} or
-@option{plink} option. That means, @value{tramp} connects first to
-the other host with non-administrative credentials, and changes to
-administrative credentials on that host afterwards. In a simple case,
-the syntax looks like
+If the @option{su}, @option{sudo} or @option{doas} option should be
+performed on another host, it can be comnbined with a leading
+@option{ssh} or @option{plink} option. That means that @value{tramp}
+connects first to the other host with non-administrative credentials,
+and changes to administrative credentials on that host afterwards. In
+a simple case, the syntax looks like
@file{@value{prefix}ssh@value{postfixhop}user@@host|sudo@value{postfixhop}@value{postfix}/path/to/file}.
@xref{Ad-hoc multi-hops}.
-@anchor{Quick Start Guide: @option{sudoedit} method}
+@anchor{Quick Start Guide sudoedit method}
@section Using @command{sudoedit}
@cindex method @option{sudoedit}
@cindex @option{sudoedit} method
@@ -527,12 +535,12 @@ the syntax looks like
The @option{sudoedit} method is similar to the @option{sudo} method.
However, it is a different implementation: it does not keep an open
session running in the background. This is for security reasons; on
-the backside this method is less performant than the @option{sudo}
-method, it is restricted to the @samp{localhost} only, and it does not
+the backside this method has worse performance than the @option{sudo}
+method, it is restricted to @samp{localhost} only, and it does not
support external processes.
-@anchor{Quick Start Guide: @option{smb} method}
+@anchor{Quick Start Guide smb method}
@section Using @command{smbclient}
@cindex method @option{smb}
@cindex @option{smb} method
@@ -546,7 +554,7 @@ 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}
+@anchor{Quick Start Guide GVFS-based methods}
@section Using @acronym{GVFS}-based methods
@cindex methods, gvfs
@cindex gvfs-based methods
@@ -561,16 +569,16 @@ of the local file name is the share exported by the remote host,
@cindex method @option{mtp}
@cindex @option{mtp} method
-On systems, which have installed @acronym{GVFS, the GNOME Virtual File
-System}, its offered methods could be used by @value{tramp}. Examples
-are @file{@trampfn{sftp,user@@host,/path/to/file}},
+On systems which have @acronym{GVFS, the GNOME Virtual File System}
+installed, its offered methods can 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}},
@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares) and
@file{@trampfn{mtp,device,/path/to/file}} (for media devices).
-@anchor{Quick Start Guide: GNOME Online Accounts based methods}
+@anchor{Quick Start Guide GNOME Online Accounts based methods}
@section Using @acronym{GNOME} Online Accounts based methods
@cindex @acronym{GNOME} Online Accounts
@cindex method @option{gdrive}
@@ -580,17 +588,44 @@ file system), @file{@trampfn{dav,user@@host,/path/to/file}},
@cindex @option{nextcloud} method
@cindex nextcloud
-@acronym{GVFS}-based methods include also @acronym{GNOME} Online
+@acronym{GVFS}-based methods also include @acronym{GNOME} Online
Accounts, which support the @option{Files} service. These are the
Google Drive file system, and the OwnCloud/NextCloud file system. The
-file name syntax is here always
+file name syntax here is always
@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}
(@samp{john.doe@@gmail.com} stands here for your Google Drive
account), or @file{@trampfn{nextcloud,user@@host#8081,/path/to/file}}
(@samp{8081} stands for the port number) for OwnCloud/NextCloud files.
-@anchor{Quick Start Guide: Android}
+@anchor{Quick Start Guide FUSE-based methods}
+@section Using @acronym{FUSE}-based methods
+@cindex methods, fuse
+@cindex fuse-based methods
+@cindex method @option{rclone}
+@cindex @option{rclone} method
+@cindex method @option{sshfs}
+@cindex @option{sshfs} method
+
+@acronym{FUSE, Filesystem in Userspace} allows users to mount a
+virtual file system. It is also used by @acronym{GVFS} internally,
+but here we discuss methods which do not use the @acronym{GVFS} API.
+
+A convenient way to access system storages is the @command{rclone}
+program. If you have configured a storage in @command{rclone} under a
+name @samp{storage} (for example), you can access it via the remote
+file name syntax @file{@trampfn{rclone,storage,/path/to/file}}. User
+names are not needed.
+
+On local hosts which have installed the @command{sshfs} client for
+mounting a file system based on @command{sftp}, this method can be
+used. All remote files are available via the local mount point.
+@value{tramp} aids in mounting the file system if it isn't mounted
+yet, and it supports the access with the usual file name syntax
+@file{@trampfn{sshfs,user@@host,/path/to/file}}.
+
+
+@anchor{Quick Start Guide Android}
@section Using Android
@cindex method @option{adb}
@cindex @option{adb} method
@@ -601,18 +636,6 @@ 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}}.
-@anchor{Quick Start Guide: @option{rclone} method}
-@section Using @command{rclone}
-@cindex method @option{rclone}
-@cindex @option{rclone} method
-
-A convenient way to access system storages is the @command{rclone}
-program. If you have configured a storage in @command{rclone} under a
-name @samp{storage} (for example), you could access it via the remote
-file name syntax @file{@trampfn{rclone,storage,/path/to/file}}. User
-names are not needed.
-
-
@node Configuration
@chapter Configuring @value{tramp}
@cindex configuration
@@ -630,7 +653,7 @@ For changing the connection type and file access method from the
defaults to one of several other options, @xref{Connection types}.
@strong{Note} that some user options described in these examples are
-not auto loaded by Emacs. All examples require @value{tramp} is
+not auto loaded by Emacs. All examples require @value{tramp} to be
installed and loaded:
@lisp
@@ -638,7 +661,7 @@ installed and loaded:
@end lisp
For functions used to configure @value{tramp}, the following clause
-might be used in your init file:
+may be used in your init file:
@lisp
(with-eval-after-load 'tramp (tramp-change-syntax 'simplified))
@@ -650,6 +673,7 @@ might be used in your init file:
* Inline methods:: Inline methods.
* External methods:: External methods.
* GVFS-based methods:: @acronym{GVFS}-based external methods.
+* FUSE-based methods:: @acronym{FUSE}-based external methods.
* Default Method:: Selecting a default method.
Here we also try to help those who
don't have the foggiest which method
@@ -666,8 +690,10 @@ might be used in your init file:
Setting own connection related information.
* Remote programs:: How @value{tramp} finds and uses programs on the remote host.
* Remote shell setup:: Remote shell setup hints.
+* FUSE setup:: @acronym{FUSE} setup hints.
* Android shell setup:: Android shell setup hints.
-* Auto-save and Backup:: Auto-save and Backup.
+* Auto-save File Lock and Backup::
+ Auto-save, File Lock and Backup.
* Keeping files encrypted:: Protect remote files by encryption.
* Windows setup hints:: Issues with Cygwin ssh.
@end menu
@@ -693,13 +719,13 @@ methods. While these methods do see better performance when actually
transferring files, the overhead of the cryptographic negotiation at
startup may drown out the improvement in file transfer times.
-External methods should be configured such a way that they don't
-require a password (with @command{ssh-agent}, or such alike). Modern
+External methods should be configured in such a way that they don't
+require a password (with @command{ssh-agent}, or similar). Modern
@command{scp} implementations offer options to reuse existing
-@command{ssh} connections, which will be enabled by default if
-available. If it isn't possible, you should consider @ref{Password
-handling}, otherwise you will be prompted for a password every copy
-action.
+@command{ssh} connections, which @value{tramp} enables by default if
+available. If that is not possible, you should consider @ref{Password
+handling}, otherwise you will be prompted for a password for every
+copy action.
@node Inline methods
@@ -727,17 +753,17 @@ usability of one of the commands defined in
reliable command it finds. @value{tramp}'s search path can be
customized, see @ref{Remote programs}.
-In case none of the commands are unavailable, @value{tramp} first
-transfers a small Perl program to the remote host, and then tries that
-program for encoding and decoding.
+In case none of the commands are available, @value{tramp} first
+transfers a small Perl program to the remote host, and then tries to
+use that program for encoding and decoding.
@vindex tramp-inline-compress-start-size
@vindex tramp-inline-compress-commands
-To increase transfer speeds for large text files, use compression
-before encoding. The user option
-@code{tramp-inline-compress-start-size} specifies the file size for
-such optimization. This feature depends on the availability and
-usability of one of the commands defined in
+To increase transfer speeds for large text files, @value{tramp} can
+use compression before encoding. The user option
+@code{tramp-inline-compress-start-size} specifies the file size above
+which to use this optimization. This feature depends on the
+availability and usability of one of the commands defined in
@code{tramp-inline-compress-commands}.
@table @asis
@@ -747,6 +773,8 @@ usability of one of the commands defined in
@command{rsh} is an option for connecting to hosts within local
networks since @command{rsh} is not as secure as other methods.
+There should be no reason to use it, as @command{ssh} is a both a
+complete replacement and ubiquitous.
@item @option{ssh}
@cindex method @option{ssh}
@@ -784,7 +812,7 @@ Similar to @option{su} method, @option{sudo} uses @command{sudo}.
@command{sudo} must have sufficient rights to start a shell.
For security reasons, a @option{sudo} connection is disabled after a
-predefined timeout (5 minutes per default). This can be changed, see
+predefined timeout (5 minutes by default). This can be changed, see
@ref{Predefined connection information}.
@item @option{doas}
@@ -1108,7 +1136,6 @@ UNC file name specification does not allow the specification of a
different user name for authentication like the @command{smbclient}
can.
-
@item @option{adb}
@cindex method @option{adb}
@cindex @option{adb} method
@@ -1148,45 +1175,6 @@ specified using @file{device#42} host name syntax or @value{tramp} can
use the default value as declared in @command{adb} command. Port
numbers are not applicable to Android devices connected through USB@.
-
-@item @option{rclone}
-@cindex method @option{rclone}
-@cindex @option{rclone} method
-
-@vindex tramp-rclone-program
-The program @command{rclone} allows to access different system
-storages in the cloud, see @url{https://rclone.org/} for a list of
-supported systems. If the @command{rclone} program isn't found in
-your @env{PATH} environment variable, you can tell @value{tramp} its
-absolute path via the user option @code{tramp-rclone-program}.
-
-A system storage must be configured via the @command{rclone config}
-command, outside Emacs. If you have configured a storage in
-@command{rclone} under a name @samp{storage} (for example), you could
-access it via the remote file name
-
-@example
-@trampfn{rclone,storage,/path/to/file}
-@end example
-
-User names are part of the @command{rclone} configuration, and not
-needed in the remote file name. If a user name is contained in the
-remote file name, it is ignored.
-
-Internally, @value{tramp} mounts the remote system storage at location
-@file{/tmp/tramp.rclone.storage}, with @file{storage} being the name
-of the configured system storage.
-
-Optional flags to the different @option{rclone} operations could be
-passed as connection property, @xref{Predefined connection
-information}. Supported properties are @t{"mount-args"},
-@t{"copyto-args"} and @t{"moveto-args"}.
-
-Access via @option{rclone} is slow. If you have an alternative method
-for accessing the system storage, you shall prefer this.
-@ref{GVFS-based methods} for example, methods @option{gdrive} and
-@option{nextcloud}.
-
@end table
@@ -1198,8 +1186,8 @@ for accessing the system storage, you shall prefer this.
@acronym{GVFS} is the virtual file system for the @acronym{GNOME}
Desktop, @uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on
-@acronym{GVFS} are mounted locally through FUSE and @value{tramp} uses
-this locally mounted directory internally.
+@acronym{GVFS} are mounted locally through @acronym{FUSE} and
+@value{tramp} uses this locally mounted directory internally.
Emacs uses the D-Bus mechanism to communicate with @acronym{GVFS}@.
Emacs must have the message bus system, D-Bus integration active,
@@ -1275,7 +1263,7 @@ uses @file{@trampfn{mtp,,}} as the default name.
As the name indicates, the method @option{nextcloud} allows you to
access OwnCloud or NextCloud hosted files and directories. Like the
@option{gdrive} method, your credentials must be populated in your
-@command{Online Accounts} application outside Emacs. The method
+@command{Online Accounts} application outside Emacs. The method
supports port numbers.
@item @option{sftp}
@@ -1302,7 +1290,7 @@ they are added here for the benefit of @ref{Archive file names}.
If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb}
methods, you must add them to @code{tramp-gvfs-methods}, and you must
-disable the corresponding Tramp package by setting
+disable the corresponding @value{tramp} package by setting
@code{tramp-ftp-method} or @code{tramp-smb-method} to @code{nil},
respectively:
@@ -1315,6 +1303,88 @@ respectively:
@end defopt
+@node FUSE-based methods
+@section @acronym{FUSE}-based external methods
+@cindex methods, fuse
+@cindex fuse-based methods
+
+Besides @acronym{GVFS}, there are other virtual file systems using the
+@acronym{FUSE} interface. Remote files are mounted locally through
+@acronym{FUSE} and @value{tramp} uses this locally mounted directory
+internally. When possible, @value{tramp} maps the remote file names
+to their respective local file name, and applies the file name
+operation on them. For some of the file name operations this is not
+possible, @value{tramp} emulates those operations otherwise.
+
+@table @asis
+@item @option{rclone}
+@cindex method @option{rclone}
+@cindex @option{rclone} method
+
+@vindex tramp-rclone-program
+The program @command{rclone} allows to access different system
+storages in the cloud, see @url{https://rclone.org/} for a list of
+supported systems. If the @command{rclone} program isn't found in
+your @env{PATH} environment variable, you can tell @value{tramp} its
+absolute path via the user option @code{tramp-rclone-program}.
+
+A system storage must be configured via the @command{rclone config}
+command, outside Emacs. If you have configured a storage in
+@command{rclone} under a name @samp{storage} (for example), you could
+access it via the remote file name
+
+@example
+@trampfn{rclone,storage,/path/to/file}
+@end example
+
+User names are part of the @command{rclone} configuration, and not
+needed in the remote file name. If a user name is contained in the
+remote file name, it is ignored.
+
+Internally, @value{tramp} mounts the remote system storage at location
+@file{/tmp/tramp.rclone.storage}, with @file{storage} being the name
+of the configured system storage.
+
+The mount point and optional flags to the different @option{rclone}
+operations could be passed as connection properties, @xref{Setup of
+rclone method}.
+
+Access via @option{rclone} is slow. If you have an alternative method
+for accessing the system storage, you should use it.
+@ref{GVFS-based methods} for example, methods @option{gdrive} and
+@option{nextcloud}.
+
+@item @option{sshfs}
+@cindex method @option{sshfs}
+@cindex @option{sshfs} method
+
+@vindex tramp-sshfs-program
+On local hosts which have installed the @command{sshfs} client for
+mounting a file system based on @command{sftp}, this method can be
+used, see
+@url{https://github.com/libfuse/sshfs/blob/master/README.rst/}. If
+the @command{sshfs} program isn't found in your @env{PATH} environment
+variable, you can tell @value{tramp} its absolute path via the user
+option @code{tramp-sshfs-program}.
+
+All remote files are available via the local mount point.
+@value{tramp} aids in mounting the file system if it isn't mounted
+yet. The remote file name syntax is
+
+@example
+@trampfn{sshfs,user@@host#port,/path/to/file}
+@end example
+
+User name and port number are optional. This method does not support
+password handling, the file system must either be mounted already, or
+the connection must be established passwordless via ssh keys.
+
+The mount point and mount arguments could be passed as connection
+properties, @xref{Setup of sshfs method}.
+
+@end table
+
+
@node Default Method
@section Selecting a default method
@cindex default method
@@ -1908,10 +1978,10 @@ machine melancholia#4711 port davs login daniel%BIZARRE password geheim
@end example
@vindex auth-source-save-behavior
-If there doesn't exist a proper entry, the password is read
+If no proper entry exists, the password is read
interactively. After successful login (verification of the password),
-it is offered to save a corresponding entry for further use by
-@code{auth-source} backends which support this. This could be changed
+Emacs offers to save a corresponding entry for further use by
+@code{auth-source} backends which support this. This can be changed
by setting the user option @code{auth-source-save-behavior} to @code{nil}.
@vindex auth-source-debug
@@ -1927,6 +1997,25 @@ file, you must customize @code{ange-ftp-netrc-filename}:
(customize-set-variable 'ange-ftp-netrc-filename "~/.authinfo.gpg")
@end lisp
+In case you do not want to use an authentication file for
+@value{tramp} passwords, use connection-local variables
+@ifinfo
+(@pxref{Connection Variables, , , emacs})
+@end ifinfo
+like this:
+
+@lisp
+@group
+(connection-local-set-profile-variables
+ 'remote-without-auth-sources '((auth-sources . nil)))
+@end group
+
+@group
+(connection-local-set-profiles
+ '(:application tramp) 'remote-without-auth-sources)
+@end group
+@end lisp
+
@anchor{Caching passwords}
@subsection Caching passwords
@@ -2018,10 +2107,10 @@ properties are listed here:
@itemize
@item @t{"login-program"}
-The property @t{"login-program"} keeps the program to be called in
-order to connect the remote host. Sometimes, the program might have
-another name on your host, or it is located on another path. In this
-case, you can overwrite the default value, which is special for every
+The property @t{"login-program"} stores the program to be used to
+connect to the remote host. Sometimes, the program might have another
+name on your host, or it might be located in another path. In this case,
+you can overwrite the default value, which is special for every
connection method. It is used in all connection methods of
@file{tramp-sh.el}.
@@ -2033,9 +2122,9 @@ to construct these lists.
@item @t{"remote-shell"}
-This property tells Tramp which remote shell to apply on the remote
-host. It is used in all connection methods of @file{tramp-sh.el}.
-The default value is @t{"/bin/sh"}.
+This property tells @value{tramp} which remote shell to apply on the
+remote host. It is used in all connection methods of
+@file{tramp-sh.el}. The default value is @t{"/bin/sh"}.
@item @t{"remote-shell-login"}
@@ -2074,19 +2163,28 @@ Connections using the @option{smb} method check, whether the remote
host supports posix commands. If the remote host runs Samba, it
confirms this capability. However, some very old Samba versions have
errors in their implementation. In order to suppress the posix
-commands for those hosts, the property @t{"posix"} shall be set to
+commands for those hosts, the property @t{"posix"} should be set to
@code{nil}.
The default value of this property is @code{t} (not specified in
@code{tramp-methods}). If the remote host runs native MS Windows,
-there is no effect of this property.
+this property has no effect.
+
+@item @t{"mount-point"}
+
+The directory file name an @acronym{FUSE}-based file system is mounted
+on. The default value of this property is
+@t{"/tmp/tramp.method.user@@host#port"} (not specified in
+@code{tramp-methods}).
@item @t{"mount-args"}@*
@t{"copyto-args"}@*
-@t{"moveto-args"}
+@t{"moveto-args"}@*
+@t{"about-args"}
These properties keep optional flags to the different @option{rclone}
-operations. Their default value is @code{nil}.
+operations. See their default values in @code{tramp-methods} if you
+want to change their values.
@end itemize
@@ -2186,16 +2284,16 @@ be recomputed. To force @value{tramp} to recompute afresh, call
@subsection Changing the default remote or local shell
@cindex zsh setup
-Per default, @value{tramp} uses the command @command{/bin/sh} for
+By default, @value{tramp} uses the command @command{/bin/sh} for
starting a shell on the remote host. This can be changed by setting
-the connection property @t{"remote-shell"}; see @pxref{Predefined
+the connection property @t{"remote-shell"}; see @ref{Predefined
connection information}. If you want, for example, use
@command{/usr/bin/zsh} on a remote host, you might apply
@lisp
@group
(add-to-list 'tramp-connection-properties
- (list (regexp-quote "@trampfn{ssh,user@@host,}")
+ (list (regexp-quote "@trampfn{sshx,user@@host,}")
"remote-shell" "/usr/bin/zsh"))
@end group
@end lisp
@@ -2209,10 +2307,12 @@ which support this.
This approach has also the advantage, that settings in
@code{tramp-sh-extra-args} will be applied. For @command{zsh}, the
trouble with the shell prompt due to set zle options will be avoided.
+For @command{bash}, loading @file{~/.editrc} or @file{~/.inputrc} is
+suppressed.
-Similar problems can happen with the local shell Tramp uses to create
-a process. Per default, it uses the command @command{/bin/sh} for
-this, which could also be a link to another shell. In order to
+Similar problems can happen with the local shell @value{tramp} uses to
+create a process. By default, it uses the command @command{/bin/sh}
+for this, which could also be a link to another shell. In order to
overwrite this, you might apply
@vindex tramp-encoding-shell
@@ -2311,7 +2411,7 @@ prompts, for which @value{tramp} uses @code{tramp-wrong-passwd-regexp}.
@value{tramp} uses the user option @code{tramp-terminal-type} to set
the remote environment variable @env{TERM} for the shells it runs.
-Per default, it is @t{"dumb"}, but this could be changed. A dumb
+By default, it is @t{"dumb"}, but this could be changed. A dumb
terminal is best suited to run the background sessions of
@value{tramp}. However, running interactive remote shells might
require a different setting. This could be achieved by tweaking the
@@ -2343,10 +2443,16 @@ fi
Another possibility is to check the environment variable
@env{INSIDE_EMACS}. Like for all subprocesses of Emacs, this is set
-to the version of the parent Emacs process, @xref{Interactive Shell, ,
-, emacs}. @value{tramp} adds its own package version to this string,
-which could be used for further tests in an inferior shell. The
-string of that environment variable looks always like
+to the version of the parent Emacs
+@ifinfo
+process, @xref{Interactive Shell, , , emacs}.
+@end ifinfo
+@ifnotinfo
+process.
+@end ifnotinfo
+@value{tramp} adds its own package version to this string, which could
+be used for further tests in an inferior shell. The string of that
+environment variable looks always like
@example
@group
@@ -2401,7 +2507,6 @@ match the end of the connection buffer. Due to performance reasons,
this search starts at the end of the buffer, and it is limited to 256
characters backwards.
-
@item Conflicting names for users and variables in @file{.profile}
When a user name is the same as a variable name in a local file, such
@@ -2411,7 +2516,6 @@ variable name to something different from the user name. For example,
if the user name is @env{FRUMPLE}, then change the variable name to
@env{FRUMPLE_DIR}.
-
@item Non-Bourne commands in @file{.profile}
When the remote host's @file{.profile} is also used for shells other
@@ -2436,7 +2540,6 @@ To accommodate using non-Bourne shells on that remote, use other
shell-specific config files. For example, bash can use
@file{~/.bash_profile} and ignore @file{.profile}.
-
@item Interactive shell prompt
@vindex INSIDE_EMACS@r{, environment variable}
@@ -2504,6 +2607,60 @@ where @samp{192.168.0.1} is the remote host IP address
@end table
+@node FUSE setup
+@section @acronym{FUSE} setup hints
+
+The @acronym{FUSE} file systems are mounted per default at
+@file{/tmp/tramp.method.user@@host#port}. The user name and port
+number are optional. If the file system is already mounted, it will
+be used as it is. If the mount point does not exist yet,
+@value{tramp} creates this directory.
+
+The mount point can be overwritten by the connection property
+@t{"mount-point"}, @ref{Predefined connection information}.
+Example:
+
+@lisp
+@group
+(add-to-list 'tramp-connection-properties
+ `(,(regexp-quote "@trampfn{sshfs,user@@host,}")
+ "mount-point"
+ ,(expand-file-name "sshfs.user@@host" user-emacs-directory)))
+@end group
+@end lisp
+
+
+@anchor{Setup of rclone method}
+@subsection @option{rclone} setup
+@cindex rclone setup
+
+The default arguments of the @command{rclone} operations
+@command{mount}, @command{coopyto}, @command{moveto} and
+@command{about} are declared in the variable @code{tramp-methods} as
+method specific parameters. Usually, they don't need to be overwritten.
+
+If needed, these parameters can be overwritten as connection
+properties @t{"mount-args"}, @t{"copyto-args"}, @t{"moveto-args"} and
+@t{"about-args"}, @xref{Predefined connection information}. All of
+them are list of strings.
+
+Be careful changing @t{"--dir-cache-time"}, this could delay
+visibility of files.
+
+
+@anchor{Setup of sshfs method}
+@subsection @option{sshfs} setup
+@cindex sshfs setup
+
+The method @option{sshfs} declares the mount arguments in the variable
+@code{tramp-methods}, passed to the @command{sshfs} command. This is
+a list of list of strings, and can be overwritten by the connection
+property @t{"mount-args"}, @xref{Predefined connection information}.
+
+Additionally, it declares also the arguments for running remote
+processes, using the @command{ssh} command. These don't need to be
+changed.
+
@node Android shell setup
@section Android shell setup hints
@cindex android shell setup for ssh
@@ -2590,9 +2747,10 @@ Open a remote connection with a more concise command @kbd{C-x C-f
@end itemize
-@node Auto-save and Backup
-@section Auto-save and Backup configuration
+@node Auto-save File Lock and Backup
+@section Auto-save, File Lock and Backup configuration
@cindex auto-save
+@cindex file-lock
@cindex backup
@vindex backup-directory-alist
@@ -2687,6 +2845,30 @@ auto-saved files to the same directory as the original file.
Alternatively, set the user option @code{tramp-auto-save-directory}
to direct all auto saves to that location.
+@vindex lock-file-name-transforms
+And still more issues to handle. Since @w{Emacs 28}, file locks use a
+similar user option as auto-save files, called
+@code{lock-file-name-transforms}. By default this user option is
+@code{nil}, meaning to keep file locks in the same directory as the
+original file.
+
+If you change @code{lock-file-name-transforms} in order to keep file
+locks for remote files somewhere else, you will loose Emacs' feature
+to warn you, if a file is changed in parallel from different Emacs
+sessions, or via different remote connections. Be careful with such
+settings.
+
+@vindex remote-file-name-inhibit-locks
+Setting @code{remote-file-name-inhibit-locks} to non-@code{nil}
+prevents the creation of remote lock files at all.
+
+@vindex tramp-allow-unsafe-temporary-files
+Per default, @value{tramp} asks for confirmation if a
+@samp{root}-owned remote backup, auto-save or lock file has to be
+written to your local temporary directory. If you want to suppress
+this confirmation question, set user option
+@code{tramp-allow-unsafe-temporary-files} to @code{t}.
+
@node Keeping files encrypted
@section Protect remote files by encryption
@@ -3154,12 +3336,12 @@ For ad-hoc definitions to be saved automatically in
Ad-hoc proxies can take patterns @code{%h} or @code{%u} like in
@code{tramp-default-proxies-alist}. The following file name expands
-to user @code{root} on host @code{remotehost}, starting with an
-@option{ssh} session on host @code{remotehost}:
+to user @samp{root} on host @samp{remotehost}, starting with an
+@option{ssh} session on host @samp{remotehost}:
@samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}.
On the other hand, if a trailing hop does not specify a host name,
-the host name of the previous hop is reused. Therefore, the following
+the host name of the previous hop is reused. Therefore, the following
file name is equivalent to the previous example:
@samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}.
@@ -3189,19 +3371,19 @@ host when the variable @code{default-directory} is remote:
@end lisp
@vindex process-file-return-signal-string
-@code{process-file} shall return either the exit code of the process,
-or a string describing the signal, when the process has been
-interrupted. Since it cannot be determined reliably whether a remote
-process has been interrupted, @code{process-file} returns always the
-exit code. When the user option
+For a local process, @code{process-file} returns either the exit code
+of the process, or a string describing a signal, when the process has
+been interrupted. Since it cannot be determined reliably whether a
+remote process has been interrupted, @code{process-file} will always
+returns the exit code for it. When the user option
@code{process-file-return-signal-string} is non-@code{nil},
-@code{process-file} regards all exit codes greater than 128 as an
+@code{process-file} treats all exit codes greater than 128 as an
indication that the process has been interrupted, and returns a
-respective string.
+corresponding string.
-Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based
-methods}) because the remote file system is mounted on the local host
-and @value{tramp} just accesses by changing the
+This remote process handling does not apply to @acronym{GVFS} (see
+@ref{GVFS-based methods}) because the remote file system is mounted on
+the local host and @value{tramp} accesses it by changing the
@code{default-directory}.
@value{tramp} starts a remote process when a command is executed in a
@@ -3212,7 +3394,7 @@ integrated to work with @value{tramp}: @file{shell.el},
@vindex INSIDE_EMACS@r{, environment variable}
@value{tramp} always modifies the @env{INSIDE_EMACS} environment
-variable for remote processes. Per default, this environment variable
+variable for remote processes. By default, this environment variable
shows the Emacs version. @value{tramp} adds its own version string,
so it looks like @samp{27.2,tramp:2.4.5.1}. However, other packages
might also add their name to this environment variable, like
@@ -3267,8 +3449,8 @@ local @file{.emacs} file:
@vindex ENV@r{, environment variable}
Setting the @env{ENV} environment variable instructs some shells to
-read an initialization file. Per default, @value{tramp} has disabled
-this. You could overwrite this behavior by evaluating
+read an initialization file. By default, @value{tramp} disables
+this. You can override this behavior by evaluating
@lisp
@group
@@ -3471,10 +3653,13 @@ uid=0(root) gid=0(root) groups=0(root)
@cindex @code{gdb}
@cindex @code{perldb}
-@file{gud.el} provides a unified interface to symbolic debuggers
+@file{gud.el} provides a unified interface to symbolic
@ifinfo
-(@ref{Debuggers, , , emacs}).
+debuggers (@pxref{Debuggers, , , emacs}).
@end ifinfo
+@ifnotinfo
+debuggers.
+@end ifnotinfo
@value{tramp} can run debug on remote hosts by calling @code{gdb}
with a remote file name:
@@ -3549,6 +3734,32 @@ To open @command{powershell} as a remote shell, use this:
@end lisp
+@subsection Remote process connection type
+@vindex process-connection-type
+@cindex tramp-process-connection-type
+
+Asynchronous processes differ in the way, whether they use a pseudo
+tty, or not. This is controlled by the variable
+@code{process-connection-type}, which can be @code{t} or @code{pty}
+(use a pseudo tty), or @code{nil} or @code{pipe} (don't use it).
+@value{tramp} is based on running shells on the remote host, which
+require a pseudo tty. Therefore, it declares the variable
+@code{tramp-process-connection-type}, which carries this information
+for remote processes. Per default, its value is @code{t}. The name
+of the remote pseudo tty is returned by the function
+@code{process-tty-name}.
+
+If a remote process, started by @code{start-file-process}, shouldn't
+use a pseudo tty, this is emulated by let-binding this variable to
+@code{nil} or @code{pipe}. There is still a pseudo tty for the
+started process, but some terminal properties are changed, like
+suppressing translation of carriage return characters into newline.
+
+The function @code{make-process} allows an explicit setting by the
+@code{:connection-type} keyword. If this keyword is not used, the
+value of @code{tramp-process-connection-type} is applied instead.
+
+
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
@@ -3635,9 +3846,15 @@ minibuffer. Each connection is of the format
Flushing remote connections also cleans the password cache
(@pxref{Password handling}), file cache, connection cache
-(@pxref{Connection caching}), and recentf cache (@pxref{File
-Conveniences, , , emacs}). It also deletes session timers
-(@pxref{Predefined connection information}) and connection buffers.
+(@pxref{Connection caching}), and recentf
+@ifinfo
+cache (@pxref{File Conveniences, , , emacs}).
+@end ifinfo
+@ifnotinfo
+cache.
+@end ifnotinfo
+It also deletes session timers (@pxref{Predefined connection
+information}) and connection buffers.
If @var{keep-debug} is non-@code{nil}, the debug buffer is kept. A
non-@code{nil} @var{keep-password} preserves the password cache.
@@ -4064,7 +4281,9 @@ test, @ref{Cleanup remote connections}. Alternatively, and often
better for analysis, reproduce the problem in a clean Emacs session
started with @command{emacs -Q}. Then, @value{tramp} does not load
the persistency file (@pxref{Connection caching}), and it does not use
-passwords from @file{auth-source.el} (@pxref{Password handling}).
+passwords from @file{auth-source.el} (@pxref{Password handling}). The
+latter does not happen for the @option{sudoedit} method, otherwise it
+would be unusable.
When including @value{tramp}'s messages in the bug report, increase
the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the
@@ -4159,6 +4378,7 @@ Disable excessive traces. Set @code{tramp-verbose} to 3 or lower,
default being 3. Increase trace levels temporarily when hunting for
bugs.
+
@item
@value{tramp} does not connect to the remote host
@@ -4339,9 +4559,9 @@ Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as
@samp{%%r}, @samp{%%h} and @samp{%%p}.
@vindex tramp-use-ssh-controlmaster-options
-If the @file{~/.ssh/config} is configured appropriately for the above
-behavior, then any changes to @command{ssh} can be suppressed with
-this @code{nil} setting:
+If the @file{~/.ssh/config} file is configured appropriately for the
+above behavior, then any changes to @command{ssh} can be suppressed
+with this @code{nil} setting:
@lisp
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@@ -4349,10 +4569,14 @@ this @code{nil} setting:
@vindex ProxyCommand@r{, ssh option}
@vindex ProxyJump@r{, ssh option}
-This shall also be set to @code{nil} if you use the
+This should also be set to @code{nil} if you use the
@option{ProxyCommand} or @option{ProxyJump} options in your
@command{ssh} configuration.
+On MS Windows, @code{tramp-use-ssh-controlmaster-options} is set to
+@code{nil} by default, because the MS Windows and MSYS2
+implementations of @command{OpenSSH} do not support this option properly.
+
@item
On multi-hop connections, @value{tramp} does not use @command{ssh}
@@ -4380,6 +4604,16 @@ supported on your proxy host.
@item
+Does @value{tramp} support @acronym{SSH} security keys?
+
+Yes. @command{OpenSSH} has added support for @acronym{FIDO} hardware
+devices via special key types @option{*-sk}. @value{tramp} supports
+the additional handshaking messages for them. This requires at least
+@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
+security key, like yubikey, solokey, or nitrokey.
+
+
+@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol
@@ -4410,6 +4644,7 @@ disable @samp{--color=yes} or @samp{--color=auto} in the remote host's
@file{.bashrc} or @file{.profile}. Turn this alias on and off to see
if file name completion works.
+
@item
File name completion does not work in directories with large number of
files
@@ -4542,10 +4777,16 @@ HISTFILE=/dev/null
@item
Where are remote files trashed to?
-Emacs can trash file instead of deleting them, @ref{Misc File Ops,
-Trashing , , emacs}. Remote files are always trashed to the local
-trash, except remote encrypted files (@pxref{Keeping files
-encrypted}), which are deleted anyway.
+Emacs can trash file instead of deleting
+@ifinfo
+them, @ref{Misc File Ops, Trashing , , emacs}.
+@end ifinfo
+@ifnotinfo
+them.
+@end ifnotinfo
+Remote files are always trashed to the local trash, except remote
+encrypted files (@pxref{Keeping files encrypted}), which are deleted
+anyway.
If Emacs is configured to use the XDG conventions for the trash
directory, remote files cannot be restored with the respective tools,
@@ -4802,6 +5043,7 @@ In BBDB buffer, access an entry by pressing the key @kbd{F}.
Thanks to @value{tramp} users for contributing to these recipes.
+
@item
Why saved multi-hop file names do not work in a new Emacs session?
@@ -4894,14 +5136,45 @@ remote files}.
@item
+How to prevent @value{tramp} from clearing the @code{recentf-list}?
+
+When @value{tramp} cleans a connection, it removes the respective
+remote file name(s) from @code{recentf-list}. This is needed, because
+an unresponsive remote host could trigger @code{recentf} to connect
+that host again and again.
+
+If you find the cleanup disturbing, because the file names in
+@code{recentf-list} are precious to you, you could add the following
+two forms in your @file{~/.emacs} after loading the @code{tramp} and
+@code{recentf} packages:
+
+@lisp
+@group
+(remove-hook
+ 'tramp-cleanup-connection-hook
+ #'tramp-recentf-cleanup)
+@end group
+@group
+(remove-hook
+ 'tramp-cleanup-all-connections-hook
+ #'tramp-recentf-cleanup-all)
+@end group
+@end lisp
+
+
+@item
I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d}
+@item
+I get an error @samp{tramp-file-name-handler: Invalid function:
+tramp-compat-with-mutex}
@value{tramp} comes with compatibility code for different Emacs
-versions. When you see this warning, you don't use the Emacs built-in
-version of @value{tramp}. In case you have installed @value{tramp}
-from GNU ELPA, you must delete and reinstall it.
+versions. When you see such a message (the text might differ), you
+don't use the Emacs built-in version of @value{tramp}. In case you
+have installed @value{tramp} from GNU ELPA, see the package README
+file for instructions how to recompile it.
@ifset installchapter
-In case you have installed it from its Git repository, @ref{Recompilation}.
+@xref{Recompilation}.
@end ifset
@@ -4913,9 +5186,9 @@ I get an error @samp{Remote file error: Forbidden reentrant call of Tramp}
Timers, process filters and sentinels, and other event based functions
can run at any time, when a remote file operation is still running.
This can cause @value{tramp} to block. When such a situation is
-detected, this error is triggered. It shall be fixed in the
-respective function (an error report will help), but for the time
-being you can suppress this error by the following code in your
+detected, this error is triggered. It should be fixed in the
+respective function (sending an error report will help), but for the
+time being you can suppress this error by the following code in your
@file{~/.emacs}:
@lisp
@@ -5086,7 +5359,7 @@ attributes cache in its process sentinel with this code:
@end lisp
Since @value{tramp} traverses subdirectories starting with the
-root-directory, it is most likely sufficient to make the
+root directory, it is most likely sufficient to make the
@code{default-directory} of the process buffer as the root directory.
@@ -5098,9 +5371,9 @@ sending a string to a process, or waiting for process output. They
can run any remote file operation, which would conflict with the
already running remote file operation, if the same connection is
affected. @value{tramp} detects this situation, and raises the
-@code{remote-file-error} error. A timer function shall avoid this
-situation. At least, it shall protect itself against this error, by
-wrapping the timer function body with
+@code{remote-file-error} error. A timer function should avoid this
+situation. As a minimum, it should protect itself against this error, by
+wrapping the timer function body as follows:
@lisp
@group
@@ -5132,6 +5405,7 @@ The verbosity levels are
@*@indent @w{ 8} connection properties
@*@indent @w{ 9} test commands
@*@indent @w{10} traces (huge)
+@*@indent @w{11} call traces (maintainer only)
With @code{tramp-verbose} greater than or equal to 4, messages are
also written to a @value{tramp} debug buffer. Such debug buffers are
@@ -5152,8 +5426,8 @@ Other navigation keys are described in
@ref{Outline Visibility, , , emacs}.
@end ifinfo
-@value{tramp} handles errors internally. But to get a Lisp backtrace,
-both the error and the signal have to be set as follows:
+@value{tramp} handles errors internally. Hence, to get a Lisp backtrace,
+the following settings are required:
@lisp
@group
@@ -5167,34 +5441,21 @@ backtraces are also added to the @value{tramp} debug buffer in case of
errors.
In very rare cases it could happen, that @value{tramp} blocks Emacs.
-Killing Emacs does not allow to inspect the debug buffer. In that
-case, you might instruct @value{tramp} to mirror the debug buffer to
-file:
+Killing Emacs does not allow inspecting the debug buffer. In that
+case, you can instruct @value{tramp} to mirror the debug buffer to
+a file:
@lisp
(customize-set-variable 'tramp-debug-to-file t)
@end lisp
-The debug buffer is written as file in your
+The debug buffer is written as a file in your
@code{temporary-file-directory}, which is usually @file{/tmp/}. Use
this option with care, because it could decrease the performance of
@value{tramp} actions.
-To enable stepping through @value{tramp} function call traces, they
-have to be specifically enabled as shown in this code:
-
-@lisp
-@group
-(require 'trace)
-(dolist (elt (all-completions "tramp-" obarray 'functionp))
- (trace-function-background (intern elt)))
-(untrace-function 'tramp-read-passwd)
-@end group
-@end lisp
-
-The buffer @file{*trace-output*} contains the output from the function
-call traces. Disable @code{tramp-read-passwd} to stop password
-strings from being written to @file{*trace-output*}.
+If @code{tramp-verbose} is greater than or equal to 11, @value{tramp}
+function call traces are written to the buffer @file{*trace-output*}.
@node GNU Free Documentation License
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 827c4773285..b11ee39f884 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
-@set trampver 2.5.1-pre
+@set trampver 2.5.2-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 25.1
diff --git a/doc/misc/wisent.texi b/doc/misc/wisent.texi
index dc5b8e4d205..c0bb7b10a46 100644
--- a/doc/misc/wisent.texi
+++ b/doc/misc/wisent.texi
@@ -1575,7 +1575,7 @@ To use the Wisent parser with @semantic{} you have to define
your grammar in @dfn{WY} form, a grammar format very close
to the one used by Bison.
-Please @inforef{top, Semantic Grammar Framework Manual, grammar-fw}
+Please see @ref{top, Semantic Grammar Framework Manual,, grammar-fw},
for more information on @semantic{} grammars.
@menu
@@ -1962,8 +1962,8 @@ See implementation of the function @code{wisent-skip-token} in
@findex semantic-lex
The lexical analysis step of @semantic{} is performed by the general
-function @code{semantic-lex}. For more information, @inforef{Writing
-Lexers, ,semantic-langdev}.
+function @code{semantic-lex}. For more information, see @ref{Writing
+Lexers, Semantic Language Development,,semantic-langdev}.
@code{semantic-lex} produces lexical tokens of the form:
diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi
index 4470afcad20..33b3a33f0f4 100644
--- a/doc/misc/woman.texi
+++ b/doc/misc/woman.texi
@@ -105,11 +105,9 @@ Mile End Road, London E1 4NS, UK
@chapter Introduction
@cindex introduction
-This version of WoMan should run with GNU Emacs 20.3 or later on any
-platform. It has not been tested, and may not run, with any other
-version of Emacs. It was developed primarily on various versions of
-Microsoft Windows, but has also been tested on MS-DOS, and various
-versions of UNIX and GNU/Linux.
+WoMan was developed primarily on various versions of Microsoft
+Windows, but has also been tested on MS-DOS, and various versions of
+UNIX and GNU/Linux.
WoMan is distributed with GNU Emacs.
diff --git a/etc/HELLO b/etc/HELLO
index 0cebb2bb7c2..577c2828ded 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -59,6 +59,7 @@ Italian (italiano) Ciao / Buon giorno
Javanese (ꦧꦱꦗꦮꦶ) console.log("ꦲꦭꦺꦴ");
Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ
Khmer (ភាសាខ្មែរ) ជំរាបសួរ
+Lakota (Lakȟotiyapi) Taŋyáŋ yahí!
Lao (ພາສາລາວ) ສະບາຍດີ / ຂໍໃຫ້ໂຊກດີ
Malayalam (മലയാളം) നമസ്കാരം
Maldivian (ދިވެހި) އައްސަލާމު ޢަލައިކުމް / ކިހިނެހް؟
diff --git a/etc/HISTORY b/etc/HISTORY
index a6b9f57814f..1d6425e9380 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -222,6 +222,8 @@ GNU Emacs 26.3 (2019-08-28) emacs-26.3
GNU Emacs 27.1 (2020-08-10) emacs-27.1
+GNU Emacs 27.2 (2021-03-25) emacs-27.2
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
diff --git a/etc/NEWS b/etc/NEWS
index 40fe2156006..b221f136241 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -24,7 +24,17 @@ applies, and please also update docstrings as needed.
* Installation Changes in Emacs 28.1
-** Cairo graphics library is now used by default if found.
+** Emacs now optionally supports native compilation of Lisp files.
+To enable this, configure Emacs with the '--with-native-compilation' option.
+This requires the libgccjit library to be installed and functional,
+and also requires GCC and Binutils to be available when Lisp code is
+natively compiled. See the Info node "(elisp) Native Compilation" for
+more details.
+
+---
+** Support for building with Motif has been removed.
+
+** The Cairo graphics library is now used by default if present.
'--with-cairo' is now the default, if the appropriate development files
are found by 'configure'. Note that building with Cairo means using
Pango instead of libXFT for font support. Since Pango 1.44 has
@@ -64,6 +74,11 @@ shaping, so 'configure' now recommends that combination.
It was declared obsolete in Emacs 27.1.
---
+** The configure option '--without-makeinfo' has been removed.
+This was only ever relevant when building from a repository checkout.
+This now requires makeinfo, which is part of the texinfo package.
+
+---
** Support for building with '-fcheck-pointer-bounds' has been removed.
GCC has withdrawn the '-fcheck-pointer-bounds' option and support for
its implementation has been removed from the Linux kernel.
@@ -76,15 +91,82 @@ proper pty support that Emacs needs.
* Startup Changes in Emacs 28.1
+---
+** File names given on the command line will now be pushed onto
+'file-name-history'.
+
+---
+** In GTK builds, Emacs now supports startup notification.
+This means that Emacs won't steal keyboard focus upon startup
+(when started via the Desktop) if the user is typing into another
+application.
+
** Emacs can support 24-bit color TTY without terminfo database.
If your text-mode terminal supports 24-bit true color, but your system
lacks the terminfo database, you can instruct Emacs to support 24-bit
true color by setting 'COLORTERM=truecolor' in the environment. This is
useful on systems such as FreeBSD which ships only with "etc/termcap".
+** Emacs now supports loading a Secure Computing filter.
+This is supported only on capable GNU/Linux systems. To activate,
+invoke Emacs with the '--seccomp=FILE' command-line option. FILE must
+name a binary file containing an array of 'struct sock_filter'
+structures. Emacs will then install that list of Secure Computing
+filters into its own process early during the startup process. You
+can use this functionality to put an Emacs process in a sandbox to
+avoid security issues when executing untrusted code. See the manual
+page for 'seccomp' system call, for details about Secure Computing
+filters.
+
+** Setting 'fill-column' to nil is obsolete.
+This undocumented use of 'fill-column' is now obsolete. To disable
+auto filling, turn off 'auto-fill-mode' instead.
+
+For instance, you could add something like the following to your init
+file:
+
+ (add-hook 'foo-mode-hook (lambda () (auto-fill-mode -1))
+
* Changes in Emacs 28.1
+** 'blink-cursor-mode' is now enabled by default regardless of the UI.
+It used to be enabled when Emacs is started in GUI mode but not when started
+in text mode. The cursor still only actually blinks in GUI frames.
+
+---
+** 'auto-composition-mode' can now be selectively disabled on some TTYs.
+Some text-mode terminals produce display glitches trying to compose
+characters. The 'auto-composition-mode' can now have a string value
+that names a terminal type; if the value returned by the 'tty-type'
+function compares equal with that string, automatic composition will
+be disabled in windows shown on that terminal. The Linux terminal
+sets this up by default.
+
++++
+** Etags now supports the Mercury programming language.
+See https://mercurylang.org.
+
++++
+** Etags command line option '--declarations' now has Mercury-specific behavior.
+All Mercury declarations are tagged by default. However, for
+compatibility with 'etags' support for Prolog, predicates and
+functions appearing first in clauses will also be tagged if 'etags' is
+invoked with the '--declarations' command-line option.
+
++++
+** New command 'font-lock-update', bound to 'C-x x f'.
+This command updates the syntax highlighting in this buffer.
+
++++
+** A new standard face 'font-lock-doc-markup-face'.
+Intended for documentation mark-up syntax and tags inside text that
+uses 'font-lock-doc-face', with which it should harmonise. It would
+typically be used in structured documentation comments in program
+source code by language-specific modes, for mark-up conventions like
+Haddock, Javadoc or Doxygen. By default this face inherits from
+'font-lock-constant-face'.
+
** The new NonGNU ELPA archive is enabled by default alongside GNU ELPA.
+++
@@ -115,6 +197,12 @@ behavior, which mixed these two, can be approximated by customizing
nor t.
+++
+** New user option 'read-minibuffer-restore-windows'.
+When customized to nil, it uses 'minibuffer-restore-windows' in
+'minibuffer-exit-hook' to remove only the window showing the
+"*Completions*" buffer.
+
++++
** New system for displaying documentation for groups of functions.
This can either be used by saying 'M-x shortdoc-display-group' and
choosing a group, or clicking a button in the "*Help*" buffers when
@@ -122,7 +210,7 @@ looking at the doc string of a function that belongs to one of these
groups.
---
-** Improved "find definition" feature of *Help* buffers.
+** Improved "find definition" feature of "*Help*" buffers.
Now clicking on the link to find the definition of functions generated
by 'cl-defstruct', or variables generated by 'define-derived-mode',
for example, will go to the exact place where they are defined.
@@ -154,7 +242,7 @@ commands.
** Support for '(box . SIZE)' 'cursor-type'.
By default, 'box' cursor always has a filled box shape. But if you
specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow
-box if the point is on an image larger than 'SIZE' pixels in any
+box if the point is on an image larger than SIZE pixels in any
dimension.
+++
@@ -185,6 +273,12 @@ This works in text buffers and over images. Typing a numeric prefix arg
The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'.
---
+** New choice 'permanent' for 'shift-select-mode'.
+When the mark was activated by shifted motion keys,
+non-shifted motion keys don't deactivate the mark
+after customizing 'shift-select-mode' to 'permanent'.
+
+---
** The default value of 'frame-title-format' and 'icon-title-format' has changed.
These variables are used to display the title bar of visible frames
and the title bar of an iconified frame. They now show the name of
@@ -240,14 +334,90 @@ search buffer due to too many matches being highlighted.
+++
** A new keymap for buffer actions has been added.
The 'C-x x' keymap now holds keystrokes for various buffer-oriented
-commands. The new keystrokes are 'C-x x g' ('revert-buffer'),
+commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'),
'C-x x r' ('rename-buffer'), 'C-x x u' ('rename-uniquely'), 'C-x x n'
-('clone-buffer'), 'C-x x i' ('insert-buffer') and 'C-x x t'
-('toggle-truncate-lines').
+('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t'
+('toggle-truncate-lines') and 'C-x x f' ('font-lock-update').
+
+---
+** Commands 'set-frame-width' and 'set-frame-height' can now get their
+input using the minibuffer.
+
+---
+** New help window when Emacs prompts before opening a large file.
+Commands like 'find-file' or 'visit-tags-table' ask to visit a file
+normally or literally when the file is larger than a certain size (by
+default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more
+about the different options to visit a file, how you can disable the
+prompt, and how you can tweak the file size threshold.
+
++++
+** New user option 'query-about-changed-file'.
+If non-nil (the default), users are prompted as before when
+re-visiting a file that has changed externally after it was visited
+the first time. If nil, the user is not prompted, but instead the
+buffer is opened with its contents before the change, and the user is
+given instructions how to revert the buffer.
+
++++
+** Improved support for terminal emulators that encode the Meta flag.
+Some terminal emulators set the 8th bit of Meta characters, and then
+encode the resulting character code as if it were non-ASCII character
+above codepoint 127. Previously, the only way of using these in Emacs
+was to set up the terminal emulator to use the 'ESC' characters to send
+Meta characters to Emacs, e.g., send "ESC x" when the user types
+'M-x'. You can now avoid the need for this setup of such terminal
+emulators by using the new input-meta-mode with the special value
+'encoded' with these terminal emulators.
+
++++
+** New frame parameter 'drag-with-tab-line'.
+This parameter, similar to 'drag-with-header-line', allows moving frames
+by dragging the tab lines of their topmost windows with the mouse.
* Editing Changes in Emacs 28.1
+** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'.
+It allows to ask about saving only files under the project root
+or in subdirectories of the directory that was default during
+command invocation.
+
+---
+** Dragging a file to Emacs will now also push the name of the file
+onto 'file-name-history'.
+
++++
+** A prefix arg now causes 'delete-other-frames' to only iconify frames.
+
+** Menus
+
++++
+*** New minor mode 'context-menu-mode' for context menus popped by 'mouse-3'.
+When this mode is enabled, clicking 'down-mouse-3' anywhere in the buffer
+pops up a menu whose contents depends on surrounding context near the
+mouse click. You can change the order of the default sub-menus in the
+context menu by customizing the user option 'context-menu-functions'.
+
++++
+*** The "Edit => Clear" menu item now obeys a rectangular region.
+
++++
+** New command 'execute-extended-command-for-buffer'.
+This new command, bound to 'M-S-x', works like
+'execute-extended-command', but limits the set of commands to the
+commands that have been determined to be particularly useful with the
+current mode.
+
++++
+** New user option 'read-extended-command-predicate'.
+This user option controls how 'M-x' performs completion of commands when
+you type 'TAB'. By default, any command that matches what you have
+typed is considered a completion candidate, but you can customize this
+option to exclude commands that are not applicable to the current
+buffer's major and minor modes, and respect the command's completion
+predicate (if any).
+
---
** 'eval-expression' now no longer signals an error on incomplete expressions.
Previously, typing 'M-: ( RET' would result in Emacs saying "End of
@@ -262,12 +432,14 @@ forms, but this command has now been changed to work more like
'eval-defun', and reset the values as specified.
+++
-** Standalone 'M-y' uses the minibuffer to complete previous kills.
-When 'M-y' is typed not after a yank command, it activates the minibuffer
-where you can browse previous kills using the minibuffer history or
-completion. In Isearch, you can bind 'C-s M-y' to the command
-'isearch-yank-pop' that uses the minibuffer with completion on
-previous kills to read a string and append it to the search string.
+** Standalone 'M-y' allows interactive selection from previous kills.
+'M-y' can now be typed after a command that is not a yank command.
+When invoked like that, it prompts in the minibuffer for one of the
+previous kills, offering completion and minibuffer-history navigation
+through previous kills recorded in the kill ring. A similar feature
+in Isearch can be invoked if you bind 'C-s M-y' to the command
+'isearch-yank-pop'. When the user option 'yank-from-kill-ring-rotate'
+is nil the kill ring is not rotated after 'yank-from-kill-ring'.
---
** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'.
@@ -286,10 +458,12 @@ Additionally, the function now accepts a HIST argument which can be
used to specify a custom history variable.
+++
-** Input history for 'goto-line' is now local to every buffer.
-Each buffer will keep a separate history of line numbers used with
-'goto-line'. This should help making faster the process of finding
-line numbers that were previously jumped to.
+** Input history for 'goto-line' can now be made local to every buffer.
+In any event, line numbers used with 'goto-line' are kept in their own
+history list. This should help make faster the process of finding
+line numbers that were previously jumped to. By default, all buffers
+share a single history list. To make every buffer have its own
+history list, customize the user option 'goto-line-history-local'.
+++
** New command 'goto-line-relative' to use in a narrowed buffer.
@@ -315,9 +489,10 @@ setting the variable 'auto-save-visited-mode' buffer-locally to nil.
description of the properties. Likewise 'button-describe' does the
same for a button.
-** Obsolete commands are no longer hidden from command completion.
+** Obsolete aliases are no longer hidden from command completion.
Completion of command names now considers obsolete aliases as
-candidates. Invoking a command via an obsolete alias now mentions the
+candidates, if they were marked obsolete in the current major version
+of Emacs. Invoking a command via an obsolete alias now mentions the
obsolescence fact and shows the new name of the command.
+++
@@ -333,29 +508,99 @@ trying to be non-destructive.
This command opens a new buffer called "*Memory Report*" and gives a
summary of where Emacs is using memory currently.
++++
+** New user option 'isearch-repeat-on-direction-change'.
+When this option is set, direction changes in Isearch move to another
+search match, if there is one, instead of moving point to the other
+end of the current match.
+
** Outline
+++
*** New commands to cycle heading visibility.
-Typing 'TAB' on a heading cycles the current section between "hide
-all", "subheadings", and "show all" state. Typing 'S-TAB' anywhere in
-the buffer cycles the whole buffer between "only top-level headings",
-"all headings and subheadings", and "show all" states.
+Typing 'TAB' on a heading line cycles the current section between
+"hide all", "subheadings", and "show all" states. Typing 'S-TAB'
+anywhere in the buffer cycles the whole buffer between "only top-level
+headings", "all headings and subheadings", and "show all" states.
+
++++
+*** New user option 'outline-minor-mode-cycle'.
+This user option customizes 'outline-minor-mode', with the difference
+that 'TAB' and 'S-TAB' on heading lines cycle heading visibility.
+Typing 'TAB' on a heading line cycles the current section between
+"hide all", "subheadings", and "show all" states. Typing 'S-TAB' on a
+heading line cycles the whole buffer between "only top-level
+headings", "all headings and subheadings", and "show all" states.
+
+---
+*** New user option 'outline-minor-mode-highlight'.
+This user option customizes 'outline-minor-mode'. It puts
+highlighting on heading lines using standard outline faces. This
+works well only when there are no conflicts with faces used by the
+major mode.
+
++++
+** New commands 'copy-matching-lines' and 'kill-matching-lines'.
+These commands are similar to the command 'flush-lines',
+but add the matching lines to the kill ring as a single string,
+including the newlines that separate the lines.
* Changes in Specialized Modes and Packages in Emacs 28.1
-** 'blink-cursor-mode' is now enabled by default regardless of the UI.
-It used to be enabled when Emacs is started in GUI mode but not when started
-in text mode. The cursor still only actually blinks in GUI frames.
+** Completion List Mode
+New key bindings have been added: 'n' and 'p' to navigate completions,
+and 'M-g M-c' to switch to the minibuffer, and you can also switch back
+to the completion list buffer with 'M-g M-c'.
+
+** Benchmark
+*** New function 'benchmark-call' to measure the execution time of a function.
+Additionally, the number of repetitions can be expressed as a minimal duration
+in seconds.
+
+** Macroexp
+---
+*** New function 'macroexp-file-name' to know the name of the current file.
+---
+*** New function 'macroexp-compiling-p' to know if we're compiling.
+---
+*** New function 'macroexp-warn-and-return' to help emit warnings.
+This used to be named 'macroexp--warn-and-return' and has proved useful
+and well-behaved enough to lose the "internal" marker.
+
+** Bindat
+
++++
+*** New 'Bindat type expression' description language.
+This new system is provided by the new macro 'bindat-type' and
+obsoletes the old data layout specifications. It supports
+arbitrary-size integers, recursive types, and more. See the Info node
+"(elisp) Byte Packing" in the ELisp manual for more details.
** pcase
+++
+*** The 'or' pattern now binds the union of the vars of its sub-patterns.
+If a variable is not bound by the subpattern that matched, it gets bound
+to nil. This was already sometimes the case, but it is now guaranteed.
+
++++
*** The 'pred' pattern can now take the form '(pred (not FUN))'.
This is like '(pred (lambda (x) (not (FUN x))))' but results
in better code.
+---
+*** New function 'pcase-compile-patterns' to write other macros.
+
+*** Added 'cl-type' pattern.
+The new 'cl-type' pattern compares types using 'cl-typep', which allows
+comparing simple types like '(cl-type integer)', as well as forms like
+'(cl-type (integer 0 10))'.
+
+*** New macro 'pcase-setq'
+This macro is the 'setq' equivalent of 'pcase-let', which allows for
+destructuring patterns in a 'setq' form.
+
+++
** profiler.el
The results displayed by 'profiler-report' now have the usage figures
@@ -376,6 +621,21 @@ When emacsclient connects, Emacs will (by default) output a message
about how to exit the client frame. If 'server-client-instructions'
is set to nil, this message is inhibited.
++++
+*** New command 'server-edit-abort'.
+This command (not bound to any key by default) can be used to abort
+an edit instead of marking it as "Done" (which the 'C-x #' command
+does). The 'emacsclient' program exits with an abnormal status as
+result of this command.
+
++++
+*** New desktop integration for connecting to the server.
+If your operating system’s desktop environment is
+freedesktop.org-compatible (which is true of most GNU/Linux and other
+recent Unix-like GUIs), you may use the new "Emacs (Client)" desktop
+menu entry to open files in an existing Emacs instance rather than
+starting a new one. The daemon starts if not already running.
+
** Perl mode
---
@@ -384,8 +644,15 @@ This is used to fontify non-scalar variables.
** Python mode
+---
+*** New user option 'python-forward-sexp-function'.
+This allows the user to easier customize whether to use block-based
+navigation or not.
+
+---
*** 'python-shell-interpreter' now defaults to python3 on systems with python3.
+---
*** 'C-c C-r' can now be used on arbitrary regions.
The command previously extended the start of the region to the start
of the line, but will now actually send the marked region, as
@@ -393,10 +660,40 @@ documented.
** Ruby mode
+---
*** 'ruby-use-smie' is declared obsolete.
SMIE is now always enabled and 'ruby-use-smie' only controls whether
indentation is done using SMIE or with the old ad-hoc code.
+** Icomplete
+
+---
+*** New user option 'icomplete-matches-format'.
+This allows controlling the current/total number of matches for the
+prompt prefix.
+
++++
+*** New minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'
+These modes modify Icomplete ('M-x icomplete-mode') and Fido ('M-x
+fido-mode'), to display completions candidates vertically instead of
+horizontally. In Icomplete, completions are rotated and selection
+kept at the top. In Fido, completions scroll like a typical dropdown
+widget. Both these new minor modes will first turn on their
+non-vertical counterparts first, if they are not on already.
+
+---
+*** Default value of 'icomplete-compute-delay' has been changed to 0.15 s.
+
+---
+*** Default value of 'icomplete-max-delay-chars' has been changed to 2.
+
+---
+*** Reduced blinking while completing the next completions set.
+Icomplete doesn't hide the hint with the previously computed
+completions anymore when compute delay is in effect, or the previous
+computation has been aborted by input. Instead it shows the previous
+completions until the new ones are ready.
+
---
** Specific warnings can now be disabled from the warning buffer.
When a warning is displayed to the user, the resulting buffer now has
@@ -410,9 +707,29 @@ disabled entirely.
---
*** Autoload the main entry point 'mspool-show'.
+** Windmove
+
++++
+*** New user options to customize windmove keybindings.
+These options include 'windmove-default-keybindings',
+'windmove-display-default-keybindings',
+'windmove-delete-default-keybindings',
+'windmove-swap-states-default-keybindings'.
+
** Windows
+++
+*** New user option 'delete-window-choose-selected'.
+This allows to choose a frame's selected window after deleting the
+previously selected one.
+
++++
+*** New argument NO-OTHER for some window functions.
+'get-lru-window', ‘get-mru-window’ and 'get-largest-window' now accept a
+new optional argument NO-OTHER which, if non-nil, avoids returning a
+window whose 'no-other-window' parameter is non-nil.
+
++++
*** New 'display-buffer' function 'display-buffer-use-least-recent-window'.
This is like 'display-buffer-use-some-window', but won't reuse the
current window, and when called repeatedly will try not to reuse a
@@ -431,6 +748,7 @@ of the next command to be displayed in a new window.
** Frames
++++
*** The key prefix 'C-x 5 5' displays next command buffer in a new frame.
It's bound to the command 'other-frame-prefix' that requests the buffer
of the next command to be displayed in a new frame.
@@ -455,9 +773,44 @@ It can be used to enable/disable the tab bar individually on each frame
independently from the value of 'tab-bar-mode' and 'tab-bar-show'.
---
+*** New user option 'tab-bar-format' defines a list of tab bar items.
+When it contains 'tab-bar-format-global' (possibly appended after
+'tab-bar-format-align-right'), then after enabling 'display-time-mode'
+(or any other mode that uses 'global-mode-string') it displays time
+aligned to the right on the tab bar instead of the mode line.
+When 'tab-bar-format-tabs' is replaced with 'tab-bar-format-tabs-groups',
+then the tab bar displays tab groups.
+
+---
+*** 'Mod-9' bound to 'tab-last' now switches to the last tab.
+It also supports a negative argument.
+
+---
+*** New command 'tab-duplicate' bound to 'C-x t n'.
+
+---
+*** 'C-x t N' creates a new tab at the specified absolute position.
+It also supports a negative argument.
+
+---
+*** 'C-x t M' moves the current tab to the specified absolute position.
+It also supports a negative argument.
+
+---
+*** 'C-x t G' assigns a group name to the tab.
+'tab-close-group' can close all tabs that belong to the selected group.
+The user option 'tab-bar-new-tab-group' defines the default group of a
+new tab. After customizing 'tab-bar-tab-post-change-group-functions'
+to 'tab-bar-move-tab-to-group', changing the tab group will also move it
+closer to other tabs in the same group.
+
+---
*** New user option 'tab-bar-tab-name-format-function'.
---
+*** New user option 'tab-line-tab-name-format-function'.
+
+---
*** The tabs in the tab line can now be scrolled using horizontal scroll.
If your mouse or trackpad supports it, you can now scroll tabs when
the mouse pointer is in the tab line by scrolling left or right.
@@ -482,6 +835,22 @@ faces in other ways.
*** The new command 'recenter-current-error', bound to 'l' in Occur or
compilation buffers, recenters the current displayed occurrence/error.
+*** Matches in target buffers are now highlighted as in 'compilation-mode'.
+The method of highlighting is specified by the user options
+'next-error-highlight' and 'next-error-highlight-no-select'.
+
+---
+*** A fringe arrow in the "*Occur*" buffer indicates the selected match.
+
+---
+*** Occur mode may use a different type for 'occur-target' property values.
+The value was previously always a marker set to the start of the first
+match on the line but can now also be a list of '(BEGIN . END)' pairs
+of markers delimiting each match on the line.
+This is a fully compatible change to the internal occur-mode
+implementation, and code creating their own occur-mode buffers will
+work as before.
+
** EIEIO
+++
@@ -489,6 +858,11 @@ compilation buffers, recenters the current displayed occurrence/error.
It is now defined as a generalized variable that can be used with
'setf' to modify the value stored in a given class slot.
+---
+*** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated.
+This corresponds to the behavior of defmethod in Common Lisp Object System.
+For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now.
+
** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
The mode provides refined highlighting of built-in functions, types,
and variables.
@@ -529,6 +903,11 @@ time zones will use a form like "+0100" instead of "CET".
** Dired
++++
+*** New user option 'dired-kill-when-opening-new-dired-buffer'.
+If non-nil, Dired will kill the current buffer when selecting a new
+directory to display.
+
---
*** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'.
Previously, if 'dired-clean-up-buffers-too' was non-nil, and
@@ -542,6 +921,18 @@ line, and allows truncating them (to preserve space on the mode line)
or showing them literally, either instead of, or in addition to,
displaying "by name" or "by date" sort order.
++++
+*** New user option 'dired-compress-directory-default-suffix'.
+This user option controls default suffix for compressing a directory.
+If it's nil, ".tar.gz" will be used. Refer to
+'dired-compress-files-alist' for a list of supported suffixes.
+
++++
+*** New user option 'dired-compress-file-default-suffix'.
+This user option controls the default suffix for compressing files.
+If it's nil, ".gz" will be used. Refer to 'dired-compress-file-alist'
+for a list of supported suffixes.
+
---
*** Broken and circular links are shown with the 'dired-broken-symlink' face.
@@ -565,6 +956,11 @@ If set to non-nil, Dired will dereference symbolic links when copying.
This can be switched off on a per-usage basis by providing
'dired-do-copy' with a 'C-u' prefix.
+*** New user option 'dired-do-revert-buffer'.
+Non-nil reverts the destination Dired buffer after performing one
+of these operations: 'dired-do-copy', 'dired-do-rename',
+'dired-do-symlink', 'dired-do-hardlink'.
+
*** New user option 'dired-mark-region' affects all Dired commands
that mark files. When non-nil and the region is active in Transient
Mark mode, then Dired commands operate only on files in the active
@@ -602,10 +998,11 @@ This is used when expanding commit messages from 'vc-print-root-log'
and similar commands.
---
-*** New faces for 'vc-dir' buffers and their Git VC backend.
+*** New faces for 'vc-dir' buffers.
Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory',
'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning',
-'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-ignored'.
+'vc-dir-status-edited', 'vc-dir-status-up-to-date',
+'vc-dir-status-ignored'.
---
*** The responsible VC backend is now the most specific one.
@@ -635,9 +1032,36 @@ If non-nil, only branches and remotes are considered when doing
completion over Git branch names. The default is nil, which causes
tags to be considered as well.
+---
+*** New user option 'vc-git-log-switches'.
+String or list of strings specifying switches for Git log under VC.
+
** Gnus
+++
+*** New user option 'gnus-topic-display-predicate'.
+This can be used to inhibit the display of some topics completely.
+
++++
+*** nnimap now supports the oauth2.el library.
+
++++
+*** New Summary buffer sort options for extra headers.
+The extra header sort option ('C-c C-s C-x') prompts for a header
+and fails if no sort function has been defined. Sorting by
+Newsgroups ('C-c C-s C-u') has been pre-defined.
+
++++
+*** The '#' command in the Group and Summary buffer now toggles,
+instead of sets, the process mark.
+
++++
+*** New user option 'gnus-process-mark-toggle'.
+If non-nil (the default), the '#' command in the Group and Summary
+buffers will toggle, instead of set, the process mark.
+
+
++++
*** New user option 'gnus-registry-register-all'.
If non-nil (the default), create registry entries for all messages.
If nil, don't automatically create entries, they must be created
@@ -785,10 +1209,13 @@ instances.
Emacs can be defined as a handler for the "x-scheme-handler/mailto"
MIME type with the following command: "emacs -f message-mailto %u".
An "emacs-mail.desktop" file has been included, suitable for
-installing in desktop directories like "/usr/share/applications".
+installing in desktop directories like "/usr/share/applications" or
+"~/.local/share/applications".
Clicking on a 'mailto:' link in other applications will then open
Emacs with headers filled out according to the link, e.g.
-"mailto:larsi@gnus.org?subject=This+is+a+test".
+"mailto:larsi@gnus.org?subject=This+is+a+test". If you prefer
+emacsclient, use "emacsclient -e '(message-mailto "%u")'"
+or "emacsclient-mail.desktop".
---
*** Change to default value of 'message-draft-headers' user option.
@@ -807,10 +1234,34 @@ take the actual screenshot, and defaults to "ImageMagick import".
** Smtpmail
+++
+*** smtpmail now supports using the oauth2.el library.
+
++++
+*** New user option 'smtpmail-store-queue-variables'.
+If non-nil, SMTP variables will be stored together with the queued
+messages, and will then be used when sending with
+'M-x smtpmail-send-queued-mail'.
+
++++
*** Allow direct selection of smtp authentication mechanism.
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
+** Search and Replace
+
+*** New key 'M-s M-.' starts isearch with the thing found at point.
+This key is bound to the new command 'isearch-forward-thing-at-point'.
+The new user option 'isearch-forward-thing-at-point' defines
+a list of symbols to try to get the "thing" at point. By default,
+the first element of the list is 'region' that tries to yank
+the currently active region to the search string.
+
+*** New user option 'isearch-wrap-pause' defines how to wrap the search.
+There are choices to disable wrapping completely and to wrap immediately.
+When wrapping immediately, it consistently handles the numeric arguments
+of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'),
+continuing with the remaining count after wrapping.
+
** Grep
+++
@@ -826,17 +1277,76 @@ grep-like tools.
On systems where the grep command supports it, directories will be
skipped.
+*** Commands that use 'grep-find' now follow symlinks for command-line args.
+This is because the default value of 'grep-find-template' now includes
+the 'find' option '-H'. Commands that use that variable, including
+indirectly via a call to 'xref-matches-in-directory', might be
+affected. In particular, there should be no need anymore to ensure
+any directory names on the 'find' command lines end in a slash.
+This change is for better compatibility with old versions of non-GNU
+'find', such as the one used on macOS.
+
+---
+*** New utility function 'grep-file-at-point'.
+This returns the name of the file at point (if any) in 'grep-mode'
+buffers.
+
** Help
++++
+*** New convenience commands with short keys in the Help buffer.
+New command 'help-view-source' ('s') will view the source file (if
+any) of the current help topic. New command 'help-goto-info' ('i')
+will look up the current symbol (if any) in Info. New command
+'help-customize' ('c') will customize the variable or the face
+(if any) whose doc string is being shown in the Help buffer.
+
+---
+*** The 'help-for-help' ('C-h C-h') screen has been redesigned.
+
+---
+*** Keybindings in 'help-mode' use the new 'help-key-binding' face.
+This face is added by 'substitute-command-keys' to any "\[command]"
+substitution. The return value of that function should consequently
+be assumed to be a propertized string.
+
+Note that the new face will also be used in tooltips. When using the
+GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t.
+
---
*** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation.
+++
+*** New command 'describe-command' shows help for a command.
+This can be used instead of 'describe-function' for interactive
+commands and is globally bound to 'C-h x'.
+
++++
*** New command 'describe-keymap' describes keybindings in a keymap.
---
+*** New user option 'describe-bindings-outline'.
+It enables outlines in the output buffer of 'describe-bindings' that
+can provide a better overview in a long list of available bindings.
+
+---
*** New keybinding 'C-h R' prompts for a manual to display and displays it.
+---
+*** Closing the "*Help*" buffer from the toolbar now buries the buffer.
+In previous Emacs versions, the "*Help*" buffer was killed instead when
+clicking the "X" icon in the tool bar.
+
+** Info
+
+---
+*** New user option 'Info-warn-on-index-alternatives-wrap'.
+This option affects what happens when using the ',' command after
+looking up an entry with 'i' in info buffers. If non-nil (the
+default), the ',' command will now warn you when proceeding beyond the
+final entry, and tapping ',' once more will then take you to the
+first entry.
+
+++
** New command 'lossage-size'.
It allows users to set the maximum number of keystrokes and commands
@@ -872,6 +1382,13 @@ so e.g. like 'C-x 8 [' inserts a left single quotation mark,
'C-x \ [' does the same.
---
+*** New user option 'read-char-by-name-sort'.
+It defines the sorting order of characters for completion of 'C-x 8 RET TAB'
+and can be customized to sort them by codepoints instead of character names.
+Additionally, you can group characters by Unicode blocks after customizing
+'completions-group' and 'completions-group-sort'.
+
+---
*** Improved language transliteration in Malayalam input methods.
Added a new Mozhi scheme. The inapplicable ITRANS scheme is now
deprecated. Errors in the Inscript method were corrected.
@@ -880,6 +1397,14 @@ deprecated. Errors in the Inscript method were corrected.
*** New input method 'cham'.
There's also a Cham greeting in "etc/HELLO".
+---
+*** New input methods for Lakota language orthographies.
+Two orthographies are represented here, the Suggested Lakota
+Orthography and what is known as the White Hat Orthography. Input
+methods 'lakota-slo-prefix', 'lakota-slo-postfix', and
+'lakota-white-hat-postfix' have been added. There is also a Lakota
+greeting in "etc/HELLO".
+
** Ispell
+++
@@ -893,16 +1418,6 @@ defaulting to active region when used interactively.
** The old non-SMIE indentation of 'sh-mode' has been removed.
---
-** The 'list-bookmark' menu is now based on 'tabulated-list-mode'.
-The interactive bookmark list will now benefit from features in
-'tabulated-list-mode' like sorting columns or changing column width.
-
-Support for the optional "inline" header line, allowing for a header
-without using 'header-line-format', has been dropped. Consequently,
-the variables 'bookmark-bmenu-use-header-line' and
-'bookmark-bmenu-inline-header-height' are now declared obsolete.
-
----
** The sb-image.el library is now marked obsolete.
This file was a compatibility kludge which is no longer needed.
@@ -913,31 +1428,87 @@ To revert to the previous behavior,
** Customize
+---
+*** Customize buffers can now be reverted with 'C-x x g'.
+
*** Most customize commands now hide obsolete user options.
Obsolete user options are no longer shown in the listings produced by
the commands 'customize', 'customize-group', 'customize-apropos' and
-'customize-changed-options'.
+'customize-changed'.
To customize obsolete user options, use 'customize-option' or
'customize-saved'.
+*** New SVG icons for checkboxes and arrows.
+They will be used automatically instead of the old icons. If Emacs is
+built without SVG support, the old icons will be used instead.
+
+** Bookmarks
+
+*** Bookmarks can now be targets for new tabs.
+When the bookmark.el library is loaded, a customize choice is added
+to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list.
+
+---
+*** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'.
+The interactive bookmark list will now benefit from features in
+'tabulated-list-mode' like sorting columns or changing column width.
+
+Support for the optional "inline" header line, allowing for a header
+without using 'header-line-format', has been dropped. Consequently,
+the variables 'bookmark-bmenu-use-header-line' and
+'bookmark-bmenu-inline-header-height' are now declared obsolete.
+
+---
+*** New user option 'bookmark-fontify'.
+If non-nil, setting a bookmark will colorize the current line with
+'bookmark-face'.
+
+---
+*** New user option 'bookmark-menu-confirm-deletion'.
+In Bookmark Menu mode, Emacs by default does not prompt for
+confirmation when you type 'x' to execute the deletion of bookmarks
+that have been marked for deletion. However, if this new option is
+non-nil then Emacs will require confirmation with 'yes-or-no-p' before
+deleting.
+
** Edebug
+*** Obsoletions
+---
+**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
++++
+**** The spec operator ':name NAME' is obsolete, use '&name' instead.
++++
+**** The spec element 'function-form' is obsolete, use 'form' instead.
+
+++
-*** Edebug specification lists can use the new keyword '&error', which
-unconditionally aborts the current edebug instrumentation with the
-supplied error message.
+*** New function 'def-edebug-elem-spec' to define Edebug spec elements.
+These used to be defined with 'def-edebug-spec' thus conflating the
+two name spaces, which lead to name collisions.
+The use of 'def-edebug-spec' to define Edebug spec elements is
+declared obsolete.
-*** Edebug specification lists can use the new keyword ':unique',
-which appends a unique suffix to the Edebug name of the current
-definition.
+*** Edebug specification lists can use some new keywords:
+
++++
+**** '&interpose SPEC FUN ARGS..' lets FUN control parsing after SPEC.
+More specifically, FUN is called with 'HEAD PF ARGS..' where
+PF is a parsing function that expects a single argument (the specs to
+use) and HEAD is the code that matched SPEC.
+
++++
+**** '&error MSG' unconditionally aborts the current edebug instrumentation.
+
++++
+**** '&name SPEC FUN' extracts the current name from the code matching SPEC.
** ElDoc
+++
*** New user option 'eldoc-echo-area-display-truncation-message'.
If non-nil (the default), eldoc will display a message saying
-something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
+something like "(Documentation truncated. Use `M-x eldoc-doc-buffer'
to see rest)" when a message has been truncated. If nil, truncated
messages will be marked with just "..." at the end.
@@ -960,7 +1531,7 @@ separate buffer, or a tooltip.
*** New user option 'eldoc-documentation-strategy'.
The built-in choices available for this user option let users compose
the results of 'eldoc-documentation-functions' in various ways, even
-if some of those functions are sychronous and some asynchchronous.
+if some of those functions are synchronous and some asynchronous.
The user option replaces 'eldoc-documentation-function', which is now
obsolete.
@@ -977,6 +1548,16 @@ it when producing a doc string.
This is bound to 'C-x n d' in 'shell-mode' buffers, and narrows to the
command line under point (and any following output).
+---
+*** New user option 'shell-has-auto-cd'.
+If non-nil, 'shell-mode' handles implicit "cd" commands, changing the
+directory if the command is a directory. Useful for shells like "zsh"
+that has this feature.
+
++++
+*** 'comint-delete-output' can now save deleted text in the kill-ring.
+Interactively, 'C-u C-c C-o' triggers this new optional behavior.
+
** Eshell
---
@@ -984,7 +1565,8 @@ command line under point (and any following output).
---
*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
-Its value equals the result of evaluating '(format "%s,eshell" emacs-version)'.
+Its value contains the result of evaluating '(format "%s,eshell"
+emacs-version)'. Other package names, like "tramp", could also be included.
---
*** Eshell no longer re-initializes its keymap every call.
@@ -1006,6 +1588,15 @@ preferred over the eudcb-mab.el backend.
like cell phones, tablets or cameras.
+++
+*** New connection method "sshfs", which allows accessing remote files
+via a file system mounted with 'sshfs'.
+
++++
+*** Tramp supports SSH authentication via a hardware security key now.
+This requires at least OpenSSH 8.2, and a FIDO U2F compatible
+security key, like yubikey, solokey, or nitrokey.
+
++++
*** Trashed remote files are moved to the local trash directory.
All remote files, which are trashed, are moved to the local trash
directory. Except remote encrypted files, which are always deleted.
@@ -1032,6 +1623,17 @@ When non-nil, this user option instructs Tramp to mirror the debug
buffer to a file under the "/tmp/" directory. This is useful, if (in
rare cases) Tramp blocks Emacs, and we need further debug information.
++++
+*** Tramp supports lock files now.
+In order to deactivate this, set user option
+'remote-file-name-inhibit-locks' to t.
+
++++
+*** Writing sensitive auto-save, backup or lock files to the local
+temporary directory must be confirmed. In order to suppress this
+confirmation, set user option 'tramp-allow-unsafe-temporary-files' to
+t.
+
** Tempo
---
@@ -1045,8 +1647,34 @@ effect.
A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
equivalent to '(map (:sym sym))'.
+---
+*** The function 'map-copy' now uses 'copy-alist' on alists.
+This is a slightly deeper copy than the previous 'copy-sequence'.
+
+---
+*** The function 'map-contains-key' now supports plists.
+
+---
+*** More consistent duplicate key handling in 'map-merge-with'.
+Until now, 'map-merge-with' promised to call its function argument
+whenever multiple maps contained 'eql' keys. However, this did not
+always coincide with the keys that were actually merged, which could
+be 'equal' instead. The function argument is now called whenever keys
+are merged, for greater consistency with 'map-merge' and 'map-elt'.
+
** Package
+---
+*** '/ s' ('package-menu-filter-by-status') changes parameter handling.
+The command was documented to take a comma-separated list of statuses
+to filter by, but instead it used the parameter as a regexp. The
+command has been changed so that it now works as documented, and
+checks statuses not as a regexp, but instead an exact match from the
+comma-separated list.
+
++++
+*** New command 'package-browse-url' and keystroke 'w'.
+
+++
*** New commands to filter the package list.
The filter commands are bound to the following keys:
@@ -1064,6 +1692,14 @@ key binding
/ u package-menu-filter-upgradable
/ / package-menu-filter-clear
+*** Option to automatically native-compile packages upon installation.
+Customize the user option 'package-native-compile' to enable automatic
+native compilation of packages when they are installed. That option
+is nil by default; if set non-nil, and if your Emacs was built with
+native-compilation support, each package will be natively compiled
+when it is installed, by invoking an asynchronous Emacs subprocess to
+run the native-compilation of the package files.
+
---
*** Column widths in 'list-packages' display can now be customized.
See the new user options 'package-name-column-width',
@@ -1072,20 +1708,24 @@ See the new user options 'package-name-column-width',
** gdb-mi
+*** New user option 'gdb-registers-enable-filter'.
+If non-nil, apply a register filter based on
+'gdb-registers-filter-pattern-list'.
+
+++
*** gdb-mi can now store and restore window configurations.
Use 'gdb-save-window-configuration' to save window configuration to a
file and 'gdb-load-window-configuration' to load from a file. These
-commands can also be accessed through the menu bar under 'Gud --
-GDB-Windows'. 'gdb-default-window-configuration-file', when non-nil,
+commands can also be accessed through the menu bar under "Gud =>
+GDB-Windows". 'gdb-default-window-configuration-file', when non-nil,
is loaded when GDB starts up.
+++
*** gdb-mi can now restore window configuration after quit.
Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs
will remember the window configuration before GDB started and restore
-it after GDB quits. A toggle button is also provided under 'Gud --
-GDB-Windows'.
+it after GDB quits. A toggle button is also provided under "Gud =>
+GDB-Windows".
+++
*** gdb-mi now has a better logic for displaying source buffers.
@@ -1106,6 +1746,14 @@ Defaults to 'libravatar', with 'unicornify' and 'gravatar' as options.
** Compilation mode
+---
+*** New function 'ansi-color-compilation-filter'.
+This function is meant to be used in 'compilation-filter-hook'.
+
+---
+*** New user option 'ansi-color-for-compilation-mode'.
+This controls what 'ansi-color-compilation-filter' does.
+
*** Regexp matching of messages is now case-sensitive by default.
The variable 'compilation-error-case-fold-search' can be set for
case-insensitive matching of messages when the old behavior is
@@ -1113,6 +1761,14 @@ required, but the recommended solution is to use a correctly matching
regexp instead.
---
+*** New user option 'compilation-search-all-directories'.
+When doing parallel builds, directories and compilation errors may
+arrive in the "*compilation*" buffer out-of-order. If this variable is
+non-nil (the default), Emacs will now search backwards in the buffer
+for any directory the file with errors may be in. If nil, this won't
+be done (and this restores how this previously worked).
+
+---
*** Messages from ShellCheck are now recognized.
---
@@ -1177,6 +1833,40 @@ t, which preserves the original behavior.
If set non-nil, showing an unseen message will set the Rmail buffer's
modified flag.
+---
+*** New faces for heading elements.
+Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
+
+** MH-E mail handler for Emacs
+
+Functions and variables related to handling junk mail have been
+renamed to not associate color with sender quality.
+
++++
+*** New names for mh-junk interactive functions.
+Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'.
+Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'.
+
++++
+*** New binding for 'mh-junk-allowlist'.
+The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'.
+The old binding is supported but warns that it is obsolete.
+
++++
+*** New names for some hooks.
+'mh-whitelist-msg-hook' is renamed 'mh-allowlist-msg-hook'.
+'mh-blacklist-msg-hook' is renamed 'mh-blocklist-msg-hook'.
+
++++
+*** New names for some variables.
+Variable 'mh-whitelist-preserves-sequences-flag' is renamed
+'mh-allowlist-preserves-sequences-flag'.
+
++++
+*** New names for some faces.
+Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'.
+Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'.
+
** Apropos
*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
@@ -1186,6 +1876,9 @@ These new navigation commands are bound to 'n' and 'p' in
*** New command 'apropos-function'.
This works like 'C-u M-x apropos-command' but is more discoverable.
+*** New face 'apropos-button'.
+Applies to buttons that indicate a face.
+
** CC Mode
*** Added support for Doxygen documentation style.
@@ -1243,6 +1936,11 @@ symbol property to the browsing commands. With a new command
'browse-url-with-browser-kind', an URL can explicitly be browsed with
either an internal or external browser.
+---
+*** Support for browsing of remote files.
+If a remote file is taken, a local temporary copy of that file is
+passed to the browser.
+
*** Support for the conkeror browser is now obsolete.
*** Support for the Mosaic browser has been removed.
@@ -1294,9 +1992,9 @@ decaying average of delays, and if this number gets too high, the
animation is stopped.
+++
-*** The 'n' and 'p' commands (next/previous image) now respects dired order.
+*** The 'n' and 'p' commands (next/previous image) now respect Dired order.
These commands would previously display the next/previous image in
-alphabetical order, but will now find the "parent" dired buffer and
+lexicographic order, but will now find the "parent" Dired buffer and
select the next/previous image file according to how the files are
sorted there. The commands have also been extended to work when the
"parent" buffer is an archive mode (i.e., zip file or the like) or tar
@@ -1326,6 +2024,38 @@ To load images with the default frame colors use the ':foreground' and
This change only affects image types that support foreground and
background colors or transparency, such as xbm, pbm, svg, png and gif.
++++
+*** Image smoothing can now be explicitly enabled or disabled.
+Smoothing applies a bilinear filter while scaling or rotating an image
+to prevent aliasing and other unwanted effects. The new image
+property ':transform-smoothing' can be set to t to force smoothing
+and nil to disable smoothing.
+
+The default behavior of smoothing on down-scaling and not smoothing
+on up-scaling remains unchanged.
+
++++
+*** New user option 'image-transform-smoothing'.
+This controls whether to use smoothing or not for an image. Values
+include nil (no smoothing), t (do smoothing) or a predicate function
+that's called with the image object and should return nil/t.
+
++++
+*** SVG images now support user stylesheets.
+The ':css' image attribute can be used to override the default CSS
+stylesheet for an image. The default sets 'font-family' and
+'font-size' to match the current face, so an image with 'height="1em"'
+will match the font size in use where it is embedded.
+
+This feature relies on librsvg 2.48 or above being available.
+
++++
+*** Image properties support 'em' sizes.
+Size image properties, for example ':height', ':max-height', etc., can
+be given a cons of the form '(SIZE . em)', where SIZE is an integer or
+float which is multiplied by the font size to calculate the image
+size, and 'em' is a symbol.
+
** EWW
+++
@@ -1390,6 +2120,18 @@ project's root directory, respectively.
+++
*** New user option 'project-list-file'.
++++
+*** New command 'project-remove-known-project'.
+This command lets you interactively remove an entry from the list of projects
+in 'project-list-file'.
+
+*** 'project-find-file' now accepts non-existent file names.
+This is to allow easy creation of files inside some nested
+sub-directory.
+
+*** 'project-find-file' doesn't use the string at point as default input.
+Now it's only suggested as part of the "future history".
+
** xref
---
@@ -1416,7 +2158,7 @@ have been renamed to have "proper" public names and documented
'xref-show-definitions-buffer-at-bottom').
*** New command 'xref-quit-and-pop-marker-stack' and a binding for it
-in "*xref*" buffers ('M-,'). This combination is easy to press
+in "*xref*" buffers ('M-,'). This combination is easy to press
semi-accidentally if the user wants to go back in the middle of
choosing the exact definition to go to, and this should do TRT.
@@ -1425,6 +2167,13 @@ choosing the exact definition to go to, and this should do TRT.
If chosen, file names in "*xref*" buffers will be displayed relative
to the 'project-root' of the current project, when available.
++++
+*** The 'TAB' key binding in "*xref*" buffers is obsolete.
+Use 'C-u RET' instead. The 'TAB' binding in "*xref*" buffers is still
+supported, but we plan on removing it in a future version; at that
+time, the command 'xref-quit-and-goto-xref' will no longer have a key
+binding in 'xref--xref-buffer-mode-map'.
+
** json.el
---
@@ -1434,6 +2183,37 @@ component are now rejected by 'json-read' and friends. This makes
them more compliant with the JSON specification and consistent with
the native JSON parsing functions.
+---
+*** Some JSON encoding functions are now obsolete.
+The functions 'json-encode-number', 'json-encode-hash-table',
+'json-encode-key', and 'json-encode-list' are now obsolete.
+
+The first two are kept as aliases of 'json-encode', which should be
+used instead. Uses of 'json-encode-list' should be changed to call
+one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or
+'json-encode-array' instead.
+
+** json.c
+
++++
+*** New function 'json-available-p'.
+This predicate returns non-nil if Emacs is built with libjansson
+support, and it is available on the current system.
+
++++
+*** Native JSON functions now signal an error if libjansson is unavailable.
+This affects 'json-serialize', 'json-insert', 'json-parse-string',
+and 'json-parse-buffer'. This can happen if Emacs was compiled with
+libjansson, but the DLL cannot be found and/or loaded by Emacs at run
+time. Previously, Emacs would display a message and return nil in
+these cases.
+
+*** The JSON functions 'json-serialize', 'json-insert',
+'json-parse-string', and 'json-parse-buffer' now implement some of the
+semantics of RFC 8259 instead of the earlier RFC 4627. In particular,
+these functions now accept top-level JSON values that are neither
+arrays nor objects.
+
** xml.el
*** XML serialization functions now reject invalid characters.
@@ -1476,6 +2256,16 @@ type for highlighting the entire message but not the sender's nick.
The 'erc-status-sidebar' package which provides a HexChat-like
activity overview sidebar for joined IRC channels is now part of ERC.
++++
+*** erc-tls now supports specifying a TLS client certificate.
+The 'erc-tls' function has been updated to allow specifying a TLS
+client certificate for authentication, as an alternative to NickServ
+password-based authentication. This is referred to as "CertFP" (short
+for Certificate Fingerprint) by several IRC networks. See the Info
+node "(erc) Connecting" in the ERC manual for more details and
+examples on how to specify and use TLS client certificates with
+'erc-tls'.
+
** Battery
---
@@ -1585,6 +2375,11 @@ a list.
** Diff
---
+*** New face 'diff-changed-unspecified'.
+This is used to highlight "changed" lines (those marked with '!') in
+context diffs, when 'diff-use-changed-face' is non-nil.
+
+---
*** New 'diff-mode' font locking face 'diff-error'.
This face is used for error messages from 'diff'.
@@ -1620,9 +2415,152 @@ that makes it a valid button.
*** New variable 'thing-at-point-provider-alist'.
This allows mode-specific alterations to how 'thing-at-point' works.
+** Enriched mode
+
+---
+*** 'C-a' is by default no longer bound to 'beginning-of-line-text'.
+This is so 'C-a' works as in other modes, and in particular holding
+Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text.
+
+** ERT
+
++++
+*** ERT can now output more verbose test failure reports.
+If the 'EMACS_TEST_VERBOSE' environment variable is set, failure
+summaries will include the failing condition.
+
+** File Locks
+
++++
+*** New user option 'lock-file-name-transforms'.
+This option allows controlling where lock files are written. It uses
+the same syntax as 'auto-save-file-name-transforms'.
+
++++
+*** New user option 'remote-file-name-inhibit-locks'.
+When non-nil, this option suppresses lock files for remote files.
+
++++
+*** New minor mode 'lock-file-mode'.
+This command, called interactively, toggles the local value of
+'create-lockfiles' in the current buffer.
+
+** image-dired
+
+---
+*** 'image-dired-mouse-toggle-mark' now toggles files in the active region.
+
++++
+*** New user option 'image-dired-thumb-visible-marks'.
+If non-nil (the default), use 'image-dired-thumb-mark' to say what
+images are marked.
+
+---
+*** New command 'image-dired-delete-marked'.
+
** Miscellaneous
+++
+*** New function 'replace-regexp-in-region'.
+
++++
+*** New function 'replace-string-in-region'.
+
+---
+*** New function 'mail-header-parse-addresses-lax'.
+This takes a comma-separated string and returns a list of mail/name
+pairs.
+
+---
+*** New function 'mail-header-parse-address-lax'.
+Parse a string as a mail address-like string.
+
+---
+*** 'shell-script-mode' now supports 'outline-minor-mode'.
+The outline headings have lines that start with "###".
+
++++
+*** New command 'revert-buffer-quick'.
+This is bound to 'C-x x g' and is like `revert-buffer', but prompts
+less.
+
++++
+*** New user option 'revert-buffer-quick-short-answers'. This
+controls how the new 'revert-buffer-quick' (`C-x x g') command
+prompts.
+
+---
+*** fileloop will now skip missing files instead of signalling an error.
+
++++
+*** ".dir-locals.el" now supports setting 'auto-mode-alist'.
+The new 'auto-mode-alist' specification in ".dir-locals.el" files can
+now be used to override the global 'auto-mode-alist' in the current
+directory tree.
+
+---
+*** New utility function 'make-separator-line'.
+
+---
+*** New face 'separator-line'.
+This is used by 'make-separator-line'.
+
++++
+*** New user option 'ignored-local-variable-values'.
+This is the opposite of 'safe-local-variable-values' -- it's an alist
+of variable-value pairs that are to be ignored when reading a
+local-variables section of a file.
+
+---
+*** 'indent-tabs-mode' is now a global minor mode instead of just a variable.
+
+---
+*** New user option 'save-place-abbreviate-file-names'.
+
+---
+*** 'tabulated-list-mode' can now restore original display order.
+Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
+and that mode allows the user to sort on any column. There was
+previously no easy way to get back to the original displayed order
+after sorting, but giving a -1 numerical prefix to the sorting command
+will now restore the original order.
+
+---
+*** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'.
+
++++
+*** New utility function 'insert-into-buffer'.
+This is like 'insert-buffer-substring', but works in the opposite
+direction.
+
++++
+*** New user option 'kill-transform-function'.
+This can be used to transform (and suppress) strings from entering the
+kill ring.
+
+---
+*** 'C-u M-x dig' will now prompt for a query type to use.
+
++++
+*** rcirc now supports SASL authentication.
+
++++
+*** 'save-interprogram-paste-before-kill' can now be a number.
+In that case, it's interpreted as a limit on the size of the clipboard
+data that will be saved to the 'kill-ring' prior to killing text: if
+the size of the clipboard data is greater than or equal to the limit,
+it will not be saved.
+
+---
+*** New variable 'hl-line-overlay-priority'.
+This can be used to change the priority of the hl-line overlays.
+
++++
+*** New command 'mailcap-view-file'.
+This command will open a viewer based on the file type, as determined
+by "~/.mailcap" and related files and variables.
+
++++
*** New command 'C-x C-k Q' to force redisplay in keyboard macros.
---
@@ -1648,6 +2586,10 @@ If this is bound to something non-nil, functions like
This is a plain 2D button, but uses the background color instead of
the foreground color.
+---
+*** New face 'shortdoc-heading'.
+Applies to headings of shortdoc sections.
+
+++
*** New predicate functions 'length<', 'length>' and 'length='.
Using these functions may be more efficient than using 'length' (if
@@ -1718,14 +2660,6 @@ doesn't turn on 'display-fill-column-indicator-mode' in special-mode
buffers. This can be controlled by customizing the variable
'global-display-fill-column-indicator-modes'.
----
-*** New user option 'compilation-search-all-directories'.
-When doing parallel builds, directories and compilation errors may
-arrive in the "*compilation*" buffer out-of-order. If this variable is
-non-nil (the default), Emacs will now search backwards in the buffer
-for any directory the file with errors may be in. If nil, this won't
-be done (and this restores how this previously worked).
-
+++
*** New user option 'next-error-message-highlight'.
In addition to a fringe arrow, 'next-error' error may now optionally
@@ -1733,6 +2667,12 @@ highlight the current error message in the 'next-error' buffer.
This user option can be also customized to keep highlighting on all
visited errors, so you can have an overview what errors were already visited.
+---
+*** New choice 'next-error-quit-window' for 'next-error-found-function'.
+When 'next-error-found-function' is customized to 'next-error-quit-window',
+then typing the numeric prefix argument 0 before the command 'next-error'
+will quit the source window after visiting the next occurrence.
+
+++
*** New user option 'tab-first-completion'.
If 'tab-always-indent' is 'complete', this new user option can be used to
@@ -1774,20 +2714,6 @@ point leaves the text. If nil, the text is not hidden again. Instead
'M-x reveal-hide-revealed' can be used to hide all the revealed text.
+++
-*** New user options to control the look of line/column numbers in the mode line.
-'mode-line-position-line-format' is the line number format (when
-'line-number-mode' is on), 'mode-line-position-column-format' is
-the column number format (when 'column-number-mode' is on), and
-'mode-line-position-column-line-format' is the combined format (when
-both modes are on).
-
-+++
-*** New user option 'mode-line-compact'.
-If non-nil, repeating spaces are compressed into a single space. If
-'long', this is only done when the mode line is longer than the
-current window width (in characters).
-
-+++
*** New command 'submit-emacs-patch'.
This works like 'report-emacs-bug', but is more geared towards sending
patches to the Emacs issue tracker.
@@ -1822,16 +2748,15 @@ leak information from the reporting user.
The semantics are as with 'walk-windows'.
---
-*** Killing virtual ido buffers interactively will make them go away.
-Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
-do anything. This has now been changed, and killing virtual buffers
-with that command will remove the buffer from recentf.
-
----
*** New variable 'ffap-file-name-with-spaces'.
If non-nil, 'find-file-at-point' and friends will try to guess more
expansively to identify a file name with spaces.
++++
+*** New 'thing-at-point' target: 'existing-filename'.
+This is like 'filename', but is a full path, and is nil if the file
+doesn't exist.
+
---
*** Two new commands for centering in 'doc-view-mode'.
The new commands 'doc-view-center-page-horizontally' (bound to 'c h')
@@ -1852,10 +2777,6 @@ The width now depends of the width of the window, but will never be
wider than the length of the longest buffer name, except that it will
never be narrower than 19 characters.
-*** Bookmarks can now be targets for new tabs.
-When the bookmark.el library is loaded, a customize choice is added
-to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list.
-
---
*** Movement commands in 'gomoku-mode' are fixed.
'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and
@@ -1905,6 +2826,17 @@ height of lines or width of chars.
When non-nil, use a new xwidget webkit session after bookmark jump.
Otherwise, it will use 'xwidget-webkit-last-session'.
+** ido
+
+---
+*** Switching on 'ido-mode' now also overrides 'ffap-file-finder'.
+
+---
+*** Killing virtual ido buffers interactively will make them go away.
+Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
+do anything. This has now been changed, and killing virtual buffers
+with that command will remove the buffer from recentf.
+
** Flymake mode
+++
@@ -1955,6 +2887,10 @@ The following user options have been renamed:
The old names are now obsolete.
+---
+*** 'world-clock-mode' can no longer be turned on interactively.
+Use 'world-clock' to turn on that mode.
+
** D-Bus
+++
@@ -1978,7 +2914,7 @@ messages, contain the error name of that message now.
+++
*** D-Bus events have changed their internal structure.
They carry now the destination and the error-name of an event. They
-also keep the type information of their arguments. Use the
+also keep the type information of their arguments. Use the
'dbus-event-*' accessor functions.
** CPerl Mode
@@ -1986,6 +2922,15 @@ also keep the type information of their arguments. Use the
---
*** New face 'perl-heredoc', used for heredoc elements.
++++
+** A function can now be thrown to the 'exit' label in addition to t or nil.
+The command loop will call it with zero arguments before returning.
+
++++
+** New error symbol 'minibuffer-quit'.
+Signaling it has almost the same effect as 'quit' except that it
+doesn't cause keyboard macro termination.
+
---
*** The command 'cperl-set-style' offers the new value "PBP".
This value customizes Emacs to use the style recommended in Damian
@@ -2002,6 +2947,67 @@ could have saved enough typing by using an abbrev, a hint will be
displayed in the echo area, mentioning the abbrev that could have been
used instead.
+** Octave Mode
+
++++
+*** Line continuations in double-quoted strings now use a backslash.
+Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows
+the behavior introduced in Octave 3.8 of using a backslash as a line
+continuation marker within double-quoted strings, and an ellipsis
+everywhere else.
+
+** Repeat
+
++++
+*** New transient mode 'repeat-mode' to allow shorter key sequences.
+You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes,
+'C-x o o' instead of 'C-x o C-x o' to switch several windows,
+'C-x { { } } ^ ^ v v' to resize the selected window interactively,
+'M-g n n p p' to navigate next-error matches. Any other key exits
+transient mode and then is executed normally. 'repeat-exit-key'
+defines an additional key to exit mode like 'isearch-exit' ('RET').
+The user option 'repeat-exit-timeout' specifies the number of
+seconds of idle time to break the repetition chain automatically.
+With 'repeat-keep-prefix' you can keep the prefix arg of the previous
+command. For example, this can help to reverse the window navigation
+direction with e.g. 'C-x o M-- o o'. Also it can help to set a new
+step with e.g. 'C-x { C-5 { { {', which will set the window resizing
+step to 5 columns.
+
++++
+** EasyPG
+GPG key servers can now be queried for keys with the
+'M-x epa-search-keys' command. Keys can then be added to your
+personal key ring.
+
+** So Long
+
+---
+*** New 'so-long-predicate' function 'so-long-statistics-excessive-p'
+efficiently detects the presence of a long line anywhere in the buffer
+using 'buffer-line-statistics' (see above). This is now the default
+predicate (replacing 'so-long-detected-long-line-p').
+
+---
+*** 'so-long-threshold' and 'so-long-max-lines' have been raised to
+10000 bytes and 500 lines respectively, to reduce the likelihood of
+false-positives when 'global-so-long-mode' is enabled. The latter
+value is now only used by the old predicate, as the new predicate
+knows the longest line in the entire buffer.
+
+---
+*** 'so-long-target-modes' now includes 'fundamental-mode' by default,
+meaning that 'global-so-long-mode' will also process files which were
+not recognised. (This only has an effect if 'set-auto-mode' chooses
+'fundamental-mode'; buffers which are simply in 'fundamental-mode' by
+default are unaffected.)
+
+---
+*** New user options 'so-long-mode-preserved-minor-modes' and
+'so-long-mode-preserved-variables' allow specified mode and variable
+states to be maintained if 'so-long-mode' replaces the original major
+mode. By default, these new options support 'view-mode'.
+
* New Modes and Packages in Emacs 28.1
@@ -2029,12 +3035,50 @@ This is a mode for searching a RFC 2229 dictionary server.
the mouse in 'dictionary-tooltip-dictionary' (which must be customized
first).
+** transient.el
+
+This library implements support for powerful keyboard-driven menus.
+Such menus can be used as simple visual command dispatchers. More
+complex menus take advantage of infix arguments, which are somewhat
+similar to prefix arguments, but are more flexible and discoverable.
+
* Incompatible Editing Changes in Emacs 28.1
+** 'electric-indent-mode' now also indents inside strings and comments,
+(unless the indentation function doesn't, of course).
+To recover the previous behavior you can use:
+
+ (add-hook 'electric-indent-functions
+ (lambda (_) (if (nth 8 (syntax-ppss)) 'no-indent)))
+
+** The 'M-o' ('facemenu-keymap') global binding has been removed.
+To restore the old binding, say something like:
+
+ (require 'facemenu)
+ (define-key global-map "\M-o" 'facemenu-keymap)
+ (define-key facemenu-keymap "\es" 'center-line)
+ (define-key facemenu-keymap "\eS" 'center-paragraph)
+
+The last two lines are not strictly necessary if you don't care about
+having those two commands on the 'M-o' keymap; see the next section.
+
+** The 'M-o M-s' and 'M-o M-S' global bindings have been removed.
+Use 'M-x center-line' and 'M-x center-paragraph' instead. See the
+previous section for how to get back the old bindings. Alternatively,
+if you only want these two commands to have global bindings they had
+before, you can add the following to your init file:
+
+ (define-key global-map "\M-o\M-s" 'center-line)
+ (define-key global-map "\M-o\M-S" 'center-paragraph)
+
+** The 'M-o M-o' global binding has been removed.
+Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f'
+command, which updates the syntax highlighting in the current buffer.
+
** In 'f90-mode', the backslash character ('\') no longer escapes.
For about a decade, the backslash character has no longer had a
-special escape syntax in Fortran F90. To get the old behaviour back,
+special escape syntax in Fortran F90. To get the old behavior back,
say something like:
(modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)
@@ -2046,9 +3090,71 @@ since the latter uses 'M-s' as a prefix key of the search prefix map.
** 'vc-print-branch-log' shows the change log for BRANCH from its root
directory instead of the default directory.
+---
+** 'project-shell' and 'shell' now use 'pop-to-buffer-same-window'.
+This is to keep the same behavior as Eshell.
+
* Incompatible Lisp Changes in Emacs 28.1
++++
+** 'overlays-in' now handles zero-length overlays slightly differently.
+Previosly, zero-length overlays at the end of the buffer were included
+in the result (if the region queried for stopped at that position).
+The same was not the case if the buffer had been narrowed to exclude
+the real end of the buffer. This has now been changed, and
+zero-length overlays at `point-max' are always included in the results.
+
+---
+** 'replace-match' now runs modification hooks slightly later.
+The function is documented to leave point after the replacement text,
+but this was not always the case if a modification hook inserted text
+in front of the replaced text -- 'replace-match' would instead leave
+point where the end of the inserted text would have been before the
+hook ran. 'replace-match' now always leaves point after the
+replacement text.
+
+---
+** 'kill-all-local-variables' has changed how it handles non-symbol hooks.
+The function is documented to eliminate all buffer-local bindings
+except variables with a 'permanent-local' property, or hooks that
+have elements with a 'permanent-local-hook' property. In addition, it
+would also keep lambda expressions in hooks sometimes. The latter has
+now been changed: The function will now also remove these.
+
+---
+** Some floating-point numbers are now handled differently by the Lisp reader.
+In previous versions of Emacs, numbers with a trailing dot and an exponent
+were read as integers and the exponent ignored: 2.e6 was interpreted as the
+integer 2. Such numerals are now read as floats with the exponent included:
+2.e6 is now read as the floating-point value 2000000.0.
+That is, '(read-from-string "1.e3")' => '(1000.0 . 4)' now.
+
++++
+** The 'lexical-binding' local variable is always enabled.
+Previously, if 'enable-local-variables' was nil, a 'lexical-binding'
+local variable would not be heeded. This has now changed, and a file
+with a 'lexical-binding' cookie is always heeded. To revert to the
+old behavior, set 'permanently-enabled-local-variables' to nil.
+
++++
+** 'completing-read-default' sets completion variables buffer-locally.
+'minibuffer-completion-table' and related variables are now set buffer-locally
+in the minibuffer instead of being set via a global let-binding.
+
++++
+** The use of positional arguments in 'define-minor-mode' is obsolete.
+These were actually rendered obsolete in Emacs 21 but were never
+marked as such.
+
+** 'facemenu-color-alist' is now obsolete, and is not used.
+
+** 'facemenu.el' is no longer preloaded.
+To use functions/variables from the package, you now have to say
+'(require 'facemenu)' or similar.
+
+** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'.
+
** 'completions-annotations' face is not used when the caller puts own face.
This affects the suffix specified by completion 'annotation-function'.
@@ -2056,6 +3162,10 @@ This affects the suffix specified by completion 'annotation-function'.
The mark will be set to point to the end of the new buffer.
+++
+** An active minibuffer now has major mode 'minibuffer-mode', not the
+erroneous 'minibuffer-inactive-mode' it formerly had.
+
++++
** Some properties from completion tables are now preserved.
If 'minibuffer-allow-text-properties' is non-nil, doing completion
over a table of strings with properties will no longer remove all the
@@ -2115,7 +3225,10 @@ This is no longer supported, and setting this variable has no effect.
Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
---
-** The metamail.el library is now marked obsolete.
+** The inversion.el library is now obsolete.
+
+---
+** The metamail.el library is now obsolete.
---
** Some obsolete variable and function aliases in dbus.el have been removed.
@@ -2145,24 +3258,27 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'dirtrack-debug-toggle', 'dynamic-completion-table',
'easy-menu-precalculate-equivalent-keybindings',
'epa-display-verify-result', 'epg-passphrase-callback-function',
-'eshell-report-bug', 'eval-next-after-load', 'exchange-dot-and-mark',
-'ffap-bug', 'ffap-submit-bug', 'ffap-version',
-'file-cache-choose-completion', 'forward-point', 'generic-char-p',
-'global-highlight-changes', 'hi-lock-face-history',
-'hi-lock-regexp-history', 'highlight-changes-active-string',
-'highlight-changes-initial-state', 'highlight-changes-passive-string',
-'image-mode-maybe', 'imenu-example--name-and-position',
-'ispell-aspell-supports-utf8', 'lisp-mode-auto-fill',
-'locate-file-completion', 'make-coding-system',
-'minibuffer-local-must-match-filename-map', 'mouse-choose-completion',
-'mouse-major-mode-menu', 'mouse-popup-menubar',
-'mouse-popup-menubar-stuff', 'newsticker-groups-filename',
-'non-iso-charset-alist', 'nonascii-insert-offset',
-'nonascii-translation-table', 'password-read-and-add',
-'pre-abbrev-expand-hook', 'princ-list', 'print-help-return-message',
-'process-filter-multibyte-p', 'read-file-name-predicate',
-'remember-buffer', 'rmail-highlight-face', 'rmail-message-filter',
-'semantic-after-idle-scheduler-reparse-hooks',
+'erc-announced-server-name', 'erc-default-coding-system',
+'erc-process', 'erc-send-command', 'eshell-report-bug',
+'eval-next-after-load', 'exchange-dot-and-mark', 'ffap-bug',
+'ffap-submit-bug', 'ffap-version', 'file-cache-mouse-choose-completion',
+'forward-point', 'generic-char-p', 'global-highlight-changes',
+'hi-lock-face-history', 'hi-lock-regexp-history',
+'highlight-changes-active-string', 'highlight-changes-initial-state',
+'highlight-changes-passive-string',
+'icalendar--datetime-to-noneuropean-date', 'image-mode-maybe',
+'imenu-example--name-and-position', 'ispell-aspell-supports-utf8',
+'lisp-mode-auto-fill', 'locate-file-completion', 'make-coding-system',
+'menu-bar-files-menu', 'minibuffer-local-must-match-filename-map',
+'mouse-choose-completion', 'mouse-major-mode-menu',
+'mouse-popup-menubar', 'mouse-popup-menubar-stuff',
+'newsticker-groups-filename', 'nnir-swish-e-index-file',
+'nnmail-fix-eudora-headers', 'non-iso-charset-alist',
+'nonascii-insert-offset', 'nonascii-translation-table',
+'password-read-and-add', 'pre-abbrev-expand-hook', 'princ-list',
+'print-help-return-message', 'process-filter-multibyte-p',
+'read-file-name-predicate', 'remember-buffer', 'rmail-highlight-face',
+'rmail-message-filter', 'semantic-after-idle-scheduler-reparse-hooks',
'semantic-after-toplevel-bovinate-hook',
'semantic-before-idle-scheduler-reparse-hooks',
'semantic-before-toplevel-bovination-hook',
@@ -2189,7 +3305,8 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'semantic-token-type-parent', 'semantic-toplevel-bovine-cache',
'semantic-toplevel-bovine-table', 'semanticdb-mode-hooks',
'set-coding-priority', 'set-process-filter-multibyte',
-'shadows-compare-text-p', 'shell-dirtrack-toggle', 't-mouse-mode',
+'shadows-compare-text-p', 'shell-dirtrack-toggle',
+'speedbar-navigating-speed', 'speedbar-update-speed', 't-mouse-mode',
'term-dynamic-simple-complete', 'tooltip-hook', 'tpu-have-ispell',
'url-generate-unique-filename', 'url-temporary-directory',
'vc-arch-command', 'vc-default-working-revision' (variable),
@@ -2197,6 +3314,12 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font',
'wisent-lex-make-token-table'.
+---
+** Some functions and variables obsolete since Emacs 22 have been removed:
+'gnus-article-hide-pgp-hook', 'gnus-inews-mark-gcc-as-read',
+'gnus-treat-display-xface', 'gnus-treat-strip-pgp',
+'nnmail-spool-file'.
+
** The WHEN argument of 'make-obsolete' and related functions is mandatory.
The use of those functions without a WHEN argument was marked obsolete
back in Emacs 23.1. The affected functions are: 'make-obsolete',
@@ -2205,9 +3328,118 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete',
** The variable 'keyboard-type' is obsolete and not dynamically scoped any more.
+** The 'values' variable is now obsolete.
+
++++
+** The '&define' keyword in an Edebug specification now disables backtracking.
+The implementation was buggy, and multiple '&define' forms in an '&or'
+form should be exceedingly rare. See the Info node "(elisp) Backtracking" in
+the Emacs Lisp reference manual for background.
+
+---
+** 'sql-*-statement-starters' are no longer user options.
+These variables describe facts about the SQL standard and
+product-specific additions. There should be no need for users to
+customize them.
+
+---
+** Function 'lm-maintainer' is replaced with 'lm-maintainers'.
+The former is now declared obsolete.
+
* Lisp Changes in Emacs 28.1
++++
+*** New function 'file-name-concat'.
+This appends file name components to a directory name and returns the
+result.
+
++++
+*** New function 'split-string-shell-command'.
+This splits a shell command string into separate components,
+respecting quoting with single ('like this') and double ("like this")
+quotes, as well as backslash quoting (like\ this).
+
+---
+*** ':safe' settings in 'defcustom' are now propagated to the loaddefs files.
+
++++
+** New function 'syntax-class-to-char'.
+This does almost the opposite of 'string-to-syntax' -- it returns the
+syntax descriptor (a character) given a raw syntax descriptor (an
+integer).
+
++++
+** New function 'buffer-local-boundp'.
+This predicate says whether a symbol is bound in a specific buffer.
+
+---
+** Emacs now attempts to test for high-rate subprocess output more fairly.
+When several subprocesses produce output simultaneously at high rate,
+Emacs will now by default attempt to service them all in a round-robin
+fashion. Set the new variable 'process-prioritize-lower-fds' to a
+non-nil value to get back the old behavior, whereby after reading
+from a subprocess, Emacs would check for output of other subprocesses
+in a way that is likely to read from the same process again.
+
++++
+** New function 'sxhash-equal-including-properties'.
+This is identical to 'sxhash-equal' but accounting also for string
+properties.
+
++++
+** 'unlock-buffer' displays warnings instead of signaling.
+Instead of signaling 'file-error' conditions for file system level
+errors, the function now calls 'display-warning' and continues as if
+the error did not occur.
+
++++
+** New function 'always'.
+This is identical to 'ignore', but returns t instead.
+
++++
+** New forms to declare how completion should happen has been added.
+'(declare (completion PREDICATE))' can be used as a general predicate
+to say whether the command should be present when completing with
+'M-x TAB'. '(declare (modes MODE...))' can be used as a short-hand
+way of saying that the command should be present when completing from
+buffers in major modes derived from MODE..., or, if it's a minor mode,
+whether that minor mode is enabled in the current buffer.
+
++++
+** The 'interactive' syntax has been extended to allow listing applicable modes.
+Forms like '(interactive "p" dired-mode)' can be used to annotate the
+commands as being applicable for modes derived from 'dired-mode',
+or if the mode is a minor mode, that the current buffer has that
+minor mode activated. Note that using this form will create byte code
+that is not compatible with byte code in previous Emacs versions.
+
++++
+** New buffer-local variable 'local-minor-modes'.
+This permanently buffer-local variable holds a list of currently
+enabled non-global minor modes in the current buffer (as a list of
+symbols).
+
++++
+** New variable 'global-minor-modes'.
+This variable holds a list of currently enabled global minor modes (as
+a list of symbols).
+
++++
+** 'define-minor-mode' now takes an ':interactive' argument.
+This can be used for specifying which modes this minor mode is meant
+for, or to make the new minor mode non-interactive. The default value
+is t.
+
++++
+** 'define-derived-mode' now takes an ':interactive' argument.
+This can be used to control whether the defined mode is a command
+or not, and is useful when defining commands that aren't meant to be
+used by users directly.
+
+---
+** The 'easymenu' library is now preloaded.
+
---
** New variable 'indent-line-ignored-functions'.
This allows modes to cycle through a set of indentation functions
@@ -2227,6 +3459,10 @@ each element is a list with three elements: a completion,
a prefix string, and a suffix string.
+++
+** New completion function 'group-function' for grouping candidates.
+It takes two arguments: a completion candidate and a 'transform' flag.
+
++++
** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'.
If you bind 'help-form' to a non-nil value while calling these functions,
then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form'
@@ -2237,10 +3473,19 @@ and display the result.
When non-nil, then functions 'read-char-choice' and 'y-or-n-p' (respectively)
use the function 'read-key' to read a character instead of using the minibuffer.
+---
+** New user option 'use-short-answers'.
+When non-nil, the function 'y-or-n-p' is used instead of
+'yes-or-no-p'. This eliminates the need to define an alias that maps
+one to another in the init file. The same user option also controls
+whether the function 'read-answer' accepts short answers.
+
+++
-** 'set-window-configuration' now takes an optional 'dont-set-frame'
-parameter which, when non-nil, instructs the function not to select
-the frame recorded in the configuration.
+** 'set-window-configuration' now takes two optional parameters,
+'dont-set-frame' and 'dont-set-miniwindow'. The first of these, when
+non-nil, instructs the function not to select the frame recorded in
+the configuration. The second prevents the current minibuffer being
+replaced by the one stored in the configuration.
+++
** 'define-globalized-minor-mode' now takes a ':predicate' parameter.
@@ -2254,6 +3499,11 @@ argument ELLIPSIS, will now indicate truncation using '…' when
the selected frame can display it, and using "..." otherwise.
+++
+** 'string-width' now accepts two optional arguments FROM and TO.
+This allows calculating the width of a substring without consing a
+new string.
+
++++
** New command 'make-directory-autoloads'.
This does the same as the old command 'update-directory-autoloads',
but has different semantics: Instead of passing in the output file via
@@ -2281,6 +3531,11 @@ been added, and takes a callback to handle the return status.
** 'ascii' is now a coding system alias for 'us-ascii'.
+++
+** New function 'file-name-with-extension'.
+This function allows a canonical way to set/replace the extension of a
+file name.
+
++++
** New function 'file-backup-file-names'.
This function returns the list of file names of all the backup files
of its file argument.
@@ -2313,6 +3568,12 @@ This function can be used by modes to add elements to the
'choice' customization type of a variable.
+++
+** New function 'require-theme'.
+This function is like 'require', but searches 'custom-theme-load-path'
+instead of 'load-path'. It can be used by Custom themes to load
+supporting Lisp files when 'require' is unsuitable.
+
++++
** New function 'file-modes-number-to-symbolic' to convert a numeric
file mode specification into symbolic form.
@@ -2321,6 +3582,27 @@ file mode specification into symbolic form.
** The variable 'force-new-style-backquotes' has been removed.
This removes the final remaining trace of old-style backquotes.
+** Mode Lines
+
++++
+*** New user options to control the line/column numbers in the mode line.
+'mode-line-position-line-format' is the line number format (when
+'line-number-mode' is on), 'mode-line-position-column-format' is
+the column number format (when 'column-number-mode' is on), and
+'mode-line-position-column-line-format' is the combined format (when
+both modes are on).
+
++++
+*** New user option 'mode-line-compact'.
+If non-nil, repeating spaces are compressed into a single space. If
+'long', this is only done when the mode line is longer than the
+current window width (in characters).
+
++++
+*** 'global-mode-string' constructs should end with a space.
+This was previously not formalized, which led to combinations of modes
+displaying data "smushed together" on the mode line.
+
** Changes in handling dynamic modules
*** The module header 'emacs-module.h' now contains type aliases
@@ -2431,7 +3713,7 @@ menu handling.
It is meant as an (experimental) aid for converting Emacs Lisp code
to lexical binding, where dynamic (special) variables bound in one
file can affect code in another. For details, see the manual section
-"(Elisp) Converting to Lexical Binding".
+"(elisp) Converting to Lexical Binding".
+++
*** 'byte-recompile-directory' can now compile symlinked ".el" files.
@@ -2502,6 +3784,29 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g.,
'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to
support these coding-systems.
+---
+** 'while-no-input-ignore-events' accepts more special events.
+The special events 'dbus-event' and 'file-notify' are now ignored in
+'while-no-input' when added to this variable.
+
++++
+** 'condition-case' now allows for a success handler.
+It is written as '(:success BODY...)' where BODY is executed
+whenever the protected form terminates without error, with the
+specified variable bound to the the value of the protected form.
+
++++
+** 'The 'uniquify' argument in 'auto-save-file-name-transforms' can be a symbol.
+If this symbol is one of the members of 'secure-hash-algorithms',
+Emacs constructs the nondirectory part of the auto-save file name by
+applying that 'secure-hash' to the buffer file name. This avoids any
+risk of excessively long file names.
+
+---
+** New user option 'etags-xref-prefer-current-file'.
+When non-nil, matches for identifiers in the file visited by the
+current buffer will be shown first in the "*xref*" buffer.
+
* Changes in Emacs 28.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.19 b/etc/NEWS.19
index f2cef62971b..fd91c0842f7 100644
--- a/etc/NEWS.19
+++ b/etc/NEWS.19
@@ -4011,6 +4011,7 @@ The third component is now determined on the basis of the names of the
existing executable files. This means that version.el is not altered
by building Emacs.
+** New macro 'easy-menu-define'
* Changes in 19.22.
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 9232a308c57..e47f408be98 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -15,18 +15,6 @@ 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 relevant manuals in doc/ have been updated.
---- means no change in the manuals is needed.
-When you add a new item, use the appropriate mark if you are sure it
-applies, and please also update docstrings as needed.
-
-
-* Installation Changes in Emacs 27.2
-
-
-* Startup Changes in Emacs 27.2
-
* Changes in Emacs 27.2
@@ -40,24 +28,35 @@ If set to a non-nil value which isn't a function, resize the mini
frame using the new function 'fit-mini-frame-to-buffer' which won't
skip leading or trailing empty lines of the buffer.
-
-* Editing Changes in Emacs 27.2
++++
+** Update IRC-related references to point to Libera.Chat.
+In June 2021, the Free Software Foundation and the GNU Project moved
+their official IRC channels from the Freenode network to Libera.Chat
+in the aftermath of the changes in Freenode's governance structure and
+policies in May and June 2021. The decision-making process took into
+account the feedback received from the community against a set of
+criteria devised by a working group drawn from both GNU and the FSF
+to gauge a chat network's acceptability to software freedom activists.
-
-* Changes in Specialized Modes and Packages in Emacs 27.2
+For the original announcement and the follow-up update, including more
+details, see:
-** Tramp
+https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html
+https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html
-*** The user option 'tramp-completion-reread-directory-timeout' is now obsolete.
+Given the relocation of GNU and FSF's official IRC channels, as well
+as #emacs and various other Emacs-themed channels (see the link below)
+to Libera.Chat, IRC-related references in the Emacs repository have
+now been updated to point to Libera.Chat.
-
-* New Modes and Packages in Emacs 27.2
+https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html
-* Incompatible Lisp Changes in Emacs 27.2
+* Changes in Specialized Modes and Packages in Emacs 27.2
-
-* Lisp Changes in Emacs 27.2
+** Tramp
+
+*** The user option 'tramp-completion-reread-directory-timeout' is now obsolete.
* Changes in Emacs 27.2 on Non-Free Operating Systems
@@ -990,7 +989,6 @@ the entire list as before. An integer value limits the list length
*** 'vc-git-stash' is now bound to 'C' in the stash headers.
---
*** Some stash keybindings are now available in the stash button.
'vc-git-stash' and 'vc-git-stash-snapshot' can now be run using 'C'
and 'S' respectively, including when there are no stashes.
@@ -2726,7 +2724,7 @@ days there are in a month in a specific year), 'date-ordinal-to-time'
(that computes the date of an ordinal day), 'decoded-time-add' (for
doing computations on a decoded time structure), 'make-decoded-time'
(for making a decoded time structure with only the given keywords
-filled out), and 'encoded-time-set-defaults' (which fills in nil
+filled out), and 'decoded-time-set-defaults' (which fills in nil
elements as if it's midnight January 1st, 1970) have been added.
*** In the DST slot, 'encode-time' and 'parse-time-string' now return -1
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 2cae8b92ace..2b9cbf37c45 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -747,7 +747,7 @@ removed.
For those who hate breaking changes, even though the changes are made
to clean things up; fear not. ATTACH_DIR will still continue to work.
It's just not documented any longer. When you get the chance, run the
-code above to clean things up anyways!
+code above to clean things up anyway!
**** New hooks
Two hooks are added to org-attach:
diff --git a/etc/TODO b/etc/TODO
index 9448617626d..1d6824c470a 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -500,6 +500,13 @@ access in cases which need more than Lisp.
** Fix portable dumping so that you can redump without using -batch
+*** Redumps and native compiler "preloaded" sub-folder.
+In order to depose new .eln files being compiled into the "preloaded"
+sub-folder the native compiler needs to know in advance if this file
+will be preloaded or not. As .eln files are not moved afterwards
+subsequent redumps might refer to .eln file out of the "preloaded"
+sub-folder.
+
** Imenu could be extended into a file-structure browsing mechanism
This could use code like that of customize-groups.
@@ -1756,8 +1763,17 @@ apparently loses under Solaris, at least. [fx has mostly done this.]
(Obsolete, since gmalloc.c is nowadays only used on MS-DOS.)
** Rewrite make-docfile to be clean and maintainable
-It might be better to replace it with Lisp, using the byte compiler.
+It might be better to replace with Lisp the part of make-docfile that
+produces the etc/DOC file by scanning *.el files, for example by
+reusing the code in the byte compiler or in autoload.el that already
+scans *.el files.
https://lists.gnu.org/r/emacs-devel/2012-06/msg00037.html
+https://lists.gnu.org/r/emacs-devel/2021-05/msg00235.html
+
+** Eliminate the etc/DOC file altogether
+As an alternative to the previous item, we could try and eliminate the
+DOC file altogether. See
+https://lists.gnu.org/r/emacs-devel/2021-05/msg00237.html
** Add an inferior-comint-minor-mode
The purpose is to have a mode to capture the common set of operations
diff --git a/etc/compilation.txt b/etc/compilation.txt
index e56d3b68476..01d4df1b09d 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -692,3 +692,11 @@ COPYING PERMISSIONS:
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+
+;;; Local Variables:
+;;; outline-regexp: "\\*\\_>"
+;;; outline-minor-mode-cycle: t
+;;; outline-minor-mode-highlight: t
+;;; eval: (outline-minor-mode 1)
+;;; End:
diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop
index 3a96b9ec8c7..34680335848 100644
--- a/etc/emacs-mail.desktop
+++ b/etc/emacs-mail.desktop
@@ -5,6 +5,6 @@ Exec=emacs -f message-mailto %u
Icon=emacs
Name=Emacs (Mail)
MimeType=x-scheme-handler/mailto;
-NoDisplay=false
+NoDisplay=true
Terminal=false
Type=Application
diff --git a/etc/emacs.desktop b/etc/emacs.desktop
index 2e6496e58c9..0d7cac14da5 100644
--- a/etc/emacs.desktop
+++ b/etc/emacs.desktop
@@ -8,5 +8,5 @@ Icon=emacs
Type=Application
Terminal=false
Categories=Development;TextEditor;
+StartupNotify=true
StartupWMClass=Emacs
-Keywords=Text;Editor;
diff --git a/etc/emacs.appdata.xml b/etc/emacs.metainfo.xml
index ca6233a59ae..7467b88e736 100644
--- a/etc/emacs.appdata.xml
+++ b/etc/emacs.metainfo.xml
@@ -3,9 +3,9 @@
<component type="desktop-application">
<id>org.gnu.emacs</id>
<metadata_license>GFDL-1.3+</metadata_license>
- <project_license>GPL-3.0+ and GFDL-1.3+</project_license>
<name>GNU Emacs</name>
<summary>An extensible text editor</summary>
+ <icon type="remote" width="128" height="128">https://www.gnu.org/software/emacs/images/emacs.png</icon>
<description>
<p>
GNU Emacs is an extensible, customizable text editor - and more.
@@ -23,13 +23,26 @@
interface, calendar, and more</li>
</ul>
</description>
+ <categories>
+ <category>Development</category>
+ <category>TextEditor</category>
+ </categories>
+ <url type="homepage">https://www.gnu.org/software/emacs</url>
+ <url type="bugtracker">https://debbugs.gnu.org/</url>
+ <url type="faq">https://www.gnu.org/software/emacs/manual/html_mono/efaq.html</url>
+ <url type="help">https://www.gnu.org/software/emacs/documentation.html</url>
+ <url type="donation">https://my.fsf.org/donate/</url>
+ <url type="contact">https://lists.gnu.org/mailman/listinfo/emacs-devel/</url>
+ <launchable type="desktop-id">emacs.desktop</launchable>
+ <launchable type="service">emacs.service</launchable>
+ <project_group>GNU</project_group>
+ <project_license>GPL-3.0+ and GFDL-1.3+</project_license>
+ <developer_name>Free Software Foundation</developer_name>
<screenshots>
<screenshot type="default">
- <image type="source" width="632" height="354">https://www.gnu.org/software/emacs/images/appdata-26.png</image>
- </screenshot>
+ <image type="source" width="632" height="354">https://www.gnu.org/software/emacs/images/appdata-26.png</image>
+ <caption>Editing a Lisp program whilst viewing the Emacs manual.</caption>
+ </screenshot>
</screenshots>
- <launchable type="desktop-id">emacs</launchable>
- <url type="homepage">https://www.gnu.org/software/emacs</url>
<update_contact>emacs-devel_AT_gnu.org</update_contact>
- <project_group>GNU</project_group>
</component>
diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop
new file mode 100644
index 00000000000..b575a41758a
--- /dev/null
+++ b/etc/emacsclient-mail.desktop
@@ -0,0 +1,20 @@
+[Desktop Entry]
+Categories=Network;Email;
+Comment=GNU Emacs is an extensible, customizable text editor - and more
+Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" --eval \\\\(message-mailto\\\\ \\\\\\"%u\\\\\\"\\\\)"
+Icon=emacs
+Name=Emacs (Mail, Client)
+MimeType=x-scheme-handler/mailto;
+NoDisplay=true
+Terminal=false
+Type=Application
+Keywords=emacsclient;
+Actions=new-window;new-instance;
+
+[Desktop Action new-window]
+Name=New Window
+Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto \\"%u\\")"
+
+[Desktop Action new-instance]
+Name=New Instance
+Exec=emacs -f message-mailto %u
diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop
index 3feb83c7290..1ecdecffafd 100644
--- a/etc/emacsclient.desktop
+++ b/etc/emacsclient.desktop
@@ -3,10 +3,20 @@ Name=Emacs (Client)
GenericName=Text Editor
Comment=Edit text
MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++;
-Exec=emacsclient -c %F
+Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient --alternate-editor= --create-frame; fi" placeholder %F
Icon=emacs
Type=Application
Terminal=false
Categories=Development;TextEditor;
-StartupWMClass=Emacsd
-Keywords=Text;Editor;
+StartupNotify=true
+StartupWMClass=Emacs
+Keywords=emacsclient;
+Actions=new-window;new-instance;
+
+[Desktop Action new-window]
+Name=New Window
+Exec=emacsclient --alternate-editor= --create-frame %F
+
+[Desktop Action new-instance]
+Name=New Instance
+Exec=emacs %F
diff --git a/etc/grep.txt b/etc/grep.txt
index b5b78459b5c..0370ae4e2c2 100644
--- a/etc/grep.txt
+++ b/etc/grep.txt
@@ -102,6 +102,7 @@ grep -nH -e "xyzxyz" ../info/*
../info/emacs-2 1205 inserts `xyzxyzxyzxyz' in the current buffer.
+* Miscellaneous
Copyright (C) 2005-2021 Free Software Foundation, Inc.
@@ -124,4 +125,7 @@ COPYING PERMISSIONS:
;;; Local Variables:
;;; eval: (let ((inhibit-read-only t) (compilation-filter-start (point-min))) (save-excursion (goto-char (point-max)) (grep-filter) (set-buffer-modified-p nil)))
;;; buffer-read-only: t
+;;; outline-minor-mode-cycle: t
+;;; outline-minor-mode-highlight: t
+;;; eval: (outline-minor-mode 1)
;;; End:
diff --git a/etc/images/README b/etc/images/README
index 00aac4f510a..9bbe796cc95 100644
--- a/etc/images/README
+++ b/etc/images/README
@@ -104,3 +104,30 @@ same conditions.
The *.pbm files were generally converted from *.xpm by running GIMP or
ImageMagick's 'convert'.
+
+
+* The following icons are from the Adwaita Icon Theme (made by the
+GNOME project). They are not part of Emacs, but are distributed and
+used by Emacs. They are licensed under either the GNU LGPL v3 or the
+Creative Commons Attribution-Share Alike 3.0 United States License.
+
+To view a copy of the CC-BY-SA licence, visit
+http://creativecommons.org/licenses/by-sa/3.0/ or send a letter to Creative
+Commons, 171 Second Street, Suite 300, San Francisco, California 94105, USA.
+
+For more information see the adwaita-icon-theme repository at:
+
+ https://gitlab.gnome.org/GNOME/adwaita-icon-theme
+
+Emacs images and their source in the Adwaita/scalable directory:
+
+ checked.svg ui/checkbox-checked-symbolic.svg
+ unchecked.svg ui/checkbox-symbolic.svg
+ checkbox-mixed.svg ui/checkbox-mixed-symbolic.svg
+ radio.svg ui/radio-symbolic.svg
+ radio-mixed.svg ui/radio-mixed-symbolic.svg
+ radio-checked.svg ui/radio-checked-symbolic.svg
+ down.svg ui/pan-down-symbolic.svg
+ left.svg ui/pan-start-symbolic.svg
+ right.svg ui/pan-end-symbolic.svg
+ up.svg ui/pan-up-symbolic.svg
diff --git a/etc/images/checkbox-mixed.svg b/etc/images/checkbox-mixed.svg
new file mode 100644
index 00000000000..6e46b803c81
--- /dev/null
+++ b/etc/images/checkbox-mixed.svg
@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="1em" viewBox="0 0 16 16">
+ <g>
+ <path d="M3.5 1A2.506 2.506 0 0 0 1 3.5v9C1 13.876 2.124 15 3.5 15h9c1.376 0 2.5-1.124 2.5-2.5v-9C15 2.124 13.876 1 12.5 1zm0 1h9c.84 0 1.5 .66 1.5 1.5v9c0 .84-.66 1.5-1.5 1.5h-9c-.84 0-1.5-.66-1.5-1.5v-9C2 2.66 2.66 2 3.5 2z" overflow="visible" />
+ <path d="M5 6a2 2 0 1 0 0 4h6a2 2 0 1 0 0 -4z" overflow="visible" />
+ </g>
+</svg>
diff --git a/etc/images/checked.svg b/etc/images/checked.svg
new file mode 100644
index 00000000000..4cbdef04f25
--- /dev/null
+++ b/etc/images/checked.svg
@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="1em" viewBox="0 0 16 16">
+ <g>
+ <path d="M3.5 1A2.506 2.506 0 0 0 1 3.5v9C1 13.876 2.124 15 3.5 15h9c1.376 0 2.5-1.124 2.5-2.5v-9C15 2.124 13.876 1 12.5 1zm0 1h9c.84 0 1.5 .66 1.5 1.5v9c0 .84-.66 1.5-1.5 1.5h-9c-.84 0-1.5-.66-1.5-1.5v-9C2 2.66 2.66 2 3.5 2z" overflow="visible" />
+ <path d="M14.5 3l-.5-.5L7.5 9 5 6.5l-2 2L7.5 13l7-7z" overflow="visible" />
+ </g>
+</svg>
diff --git a/etc/images/down.svg b/etc/images/down.svg
new file mode 100644
index 00000000000..e2760427d73
--- /dev/null
+++ b/etc/images/down.svg
@@ -0,0 +1,40 @@
+<?xml version='1.0' encoding='UTF-8' standalone='no'?>
+<svg xmlns:cc='http://creativecommons.org/ns#' xmlns:dc='http://purl.org/dc/elements/1.1/' sodipodi:docname='pan-down-symbolic.svg' inkscape:export-filename='/home/sam/source-symbolic.png' inkscape:export-xdpi='270' inkscape:export-ydpi='270' height='16' id='svg7384' xmlns:inkscape='http://www.inkscape.org/namespaces/inkscape' xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#' xmlns:sodipodi='http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd' style='enable-background:new' xmlns:svg='http://www.w3.org/2000/svg' version='1.1' inkscape:version='1.0 (4035a4fb49, 2020-05-01)' width='16' xmlns='http://www.w3.org/2000/svg'>
+ <sodipodi:namedview inkscape:bbox-nodes='true' inkscape:bbox-paths='false' bordercolor='#000000' borderlayer='false' borderopacity='0.50196078' inkscape:current-layer='layer10' inkscape:cx='-8.85234' inkscape:cy='7.9624984' inkscape:document-rotation='0' gridtolerance='10' inkscape:guide-bbox='true' guidetolerance='10' id='namedview88' inkscape:measure-end='0,0' inkscape:measure-start='0,0' inkscape:object-nodes='true' inkscape:object-paths='true' objecttolerance='10' pagecolor='#e2e2e2' inkscape:pageopacity='0' inkscape:pageshadow='2' showborder='false' showgrid='true' showguides='false' inkscape:showpageshadow='false' inkscape:snap-bbox='true' inkscape:snap-bbox-edge-midpoints='false' inkscape:snap-bbox-midpoints='true' inkscape:snap-center='false' inkscape:snap-global='true' inkscape:snap-grids='true' inkscape:snap-intersection-paths='false' inkscape:snap-midpoints='true' inkscape:snap-nodes='true' inkscape:snap-object-midpoints='true' inkscape:snap-others='true' inkscape:snap-page='false' inkscape:snap-smooth-nodes='true' inkscape:snap-to-guides='true' inkscape:window-height='1205' inkscape:window-maximized='0' inkscape:window-width='1553' inkscape:window-x='26' inkscape:window-y='23' inkscape:zoom='1'>
+ <inkscape:grid color='#000000' dotted='false' empcolor='#0800ff' empopacity='0.4627451' empspacing='4' enabled='true' id='grid4866' opacity='0.16470588' originx='-152.00586' originy='-952' snapvisiblegridlinesonly='true' spacingx='1' spacingy='1' type='xygrid' visible='true'/>
+ <inkscape:grid dotted='true' empcolor='#3f3fff' empopacity='0' empspacing='4' id='grid3540' originx='-152.00586' originy='-952' spacingx='0.5' spacingy='0.5' type='xygrid'/>
+ </sodipodi:namedview>
+ <metadata id='metadata90'>
+ <rdf:RDF>
+ <cc:Work rdf:about=''>
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type rdf:resource='http://purl.org/dc/dcmitype/StillImage'/>
+ <dc:title>Gnome Symbolic Icons</dc:title>
+ <cc:license rdf:resource='http://creativecommons.org/licenses/by-sa/4.0/'/>
+ </cc:Work>
+ <cc:License rdf:about='http://creativecommons.org/licenses/by-sa/4.0/'>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Reproduction'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Distribution'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Notice'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Attribution'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#DerivativeWorks'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#ShareAlike'/>
+ </cc:License>
+ </rdf:RDF>
+ </metadata>
+ <title id='title8473'>Gnome Symbolic Icons</title>
+ <defs id='defs7386'/>
+ <g inkscape:groupmode='layer' id='layer10' inkscape:label='ui' transform='translate(-152.00586,-952)'>
+ <path inkscape:connector-curvature='0' d='m 166,957 -5.99414,5.99999 L 154,957 Z' id='path6424' sodipodi:nodetypes='cccc' style='fill:#2e3436;fill-opacity:1;stroke:none'/>
+ </g>
+ <g inkscape:groupmode='layer' id='layer1' inkscape:label='status' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer11' inkscape:label='legacy' transform='translate(-152.00586,-952)'/>
+ <g inkscape:groupmode='layer' id='layer7' inkscape:label='places' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer6' inkscape:label='mimetypes' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer5' inkscape:label='emotes' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer9' inkscape:label='emblems' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer2' inkscape:label='devices' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer8' inkscape:label='categories' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer3' inkscape:label='apps' transform='translate(-152.00586,-888)'/>
+ <g inkscape:groupmode='layer' id='layer4' inkscape:label='actions' transform='translate(-152.00586,-888)'/>
+</svg>
diff --git a/etc/images/left.svg b/etc/images/left.svg
new file mode 100644
index 00000000000..d6429bc4109
--- /dev/null
+++ b/etc/images/left.svg
@@ -0,0 +1,40 @@
+<?xml version='1.0' encoding='UTF-8' standalone='no'?>
+<svg xmlns:cc='http://creativecommons.org/ns#' xmlns:dc='http://purl.org/dc/elements/1.1/' sodipodi:docname='pan-start-symbolic.svg' inkscape:export-filename='/home/sam/source-symbolic.png' inkscape:export-xdpi='270' inkscape:export-ydpi='270' height='16' id='svg7384' xmlns:inkscape='http://www.inkscape.org/namespaces/inkscape' xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#' xmlns:sodipodi='http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd' style='enable-background:new' xmlns:svg='http://www.w3.org/2000/svg' version='1.1' inkscape:version='1.0 (4035a4fb49, 2020-05-01)' width='16' xmlns='http://www.w3.org/2000/svg'>
+ <sodipodi:namedview inkscape:bbox-nodes='true' inkscape:bbox-paths='false' bordercolor='#000000' borderlayer='false' borderopacity='0.50196078' inkscape:current-layer='layer10' inkscape:cx='51.147672' inkscape:cy='7.96251' inkscape:document-rotation='0' gridtolerance='10' inkscape:guide-bbox='true' guidetolerance='10' id='namedview88' inkscape:measure-end='0,0' inkscape:measure-start='0,0' inkscape:object-nodes='true' inkscape:object-paths='true' objecttolerance='10' pagecolor='#e2e2e2' inkscape:pageopacity='0' inkscape:pageshadow='2' showborder='false' showgrid='true' showguides='false' inkscape:showpageshadow='false' inkscape:snap-bbox='true' inkscape:snap-bbox-edge-midpoints='false' inkscape:snap-bbox-midpoints='true' inkscape:snap-center='false' inkscape:snap-global='true' inkscape:snap-grids='true' inkscape:snap-intersection-paths='false' inkscape:snap-midpoints='true' inkscape:snap-nodes='true' inkscape:snap-object-midpoints='true' inkscape:snap-others='true' inkscape:snap-page='false' inkscape:snap-smooth-nodes='true' inkscape:snap-to-guides='true' inkscape:window-height='1205' inkscape:window-maximized='0' inkscape:window-width='1553' inkscape:window-x='26' inkscape:window-y='23' inkscape:zoom='1'>
+ <inkscape:grid color='#000000' dotted='false' empcolor='#0800ff' empopacity='0.4627451' empspacing='4' enabled='true' id='grid4866' opacity='0.16470588' originx='-92.005848' originy='-951.99999' snapvisiblegridlinesonly='true' spacingx='1' spacingy='1' type='xygrid' visible='true'/>
+ <inkscape:grid dotted='true' empcolor='#3f3fff' empopacity='0' empspacing='4' id='grid3540' originx='-92.005848' originy='-951.99999' spacingx='0.5' spacingy='0.5' type='xygrid'/>
+ </sodipodi:namedview>
+ <metadata id='metadata90'>
+ <rdf:RDF>
+ <cc:Work rdf:about=''>
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type rdf:resource='http://purl.org/dc/dcmitype/StillImage'/>
+ <dc:title>Gnome Symbolic Icons</dc:title>
+ <cc:license rdf:resource='http://creativecommons.org/licenses/by-sa/4.0/'/>
+ </cc:Work>
+ <cc:License rdf:about='http://creativecommons.org/licenses/by-sa/4.0/'>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Reproduction'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Distribution'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Notice'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Attribution'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#DerivativeWorks'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#ShareAlike'/>
+ </cc:License>
+ </rdf:RDF>
+ </metadata>
+ <title id='title8473'>Gnome Symbolic Icons</title>
+ <defs id='defs7386'/>
+ <g inkscape:groupmode='layer' id='layer10' inkscape:label='ui' transform='translate(-92.005848,-951.99999)'>
+ <path inkscape:connector-curvature='0' d='M 103,966 97.00585,959.99999 103,954 Z' id='path6400' sodipodi:nodetypes='cccc' style='fill:#2e3436;fill-opacity:1;stroke:none'/>
+ </g>
+ <g inkscape:groupmode='layer' id='layer1' inkscape:label='status' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer11' inkscape:label='legacy' transform='translate(-92.005848,-951.99999)'/>
+ <g inkscape:groupmode='layer' id='layer7' inkscape:label='places' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer6' inkscape:label='mimetypes' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer5' inkscape:label='emotes' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer9' inkscape:label='emblems' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer2' inkscape:label='devices' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer8' inkscape:label='categories' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer3' inkscape:label='apps' transform='translate(-92.005848,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer4' inkscape:label='actions' transform='translate(-92.005848,-887.99999)'/>
+</svg>
diff --git a/etc/images/radio-checked.svg b/etc/images/radio-checked.svg
new file mode 100644
index 00000000000..8950b447a0b
--- /dev/null
+++ b/etc/images/radio-checked.svg
@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="1em" viewBox="0 0 16 16">
+ <g>
+ <path d="M8 5a3.001 3.001 0 0 0 0 6 3.001 3.001 0 0 0 0 -6z" overflow="visible"/>
+ <path d="M8.004 1C4.144 1 1 4.144 1 8.004c0 3.86 3.144 7.006 7.004 7.006 3.86 0 7.006-3.146 7.006-7.006C15.01 4.144 11.864 1 8.004 1zm0 1a6.002 6.002 0 0 1 6.006 6.004 6.004 6.004 0 0 1 -6.006 6.006A6.002 6.002 0 0 1 2 8.004 6 6 0 0 1 8.004 2z" overflow="visible"/>
+ </g>
+</svg>
diff --git a/etc/images/radio-mixed.svg b/etc/images/radio-mixed.svg
new file mode 100644
index 00000000000..1b3bfa78e9d
--- /dev/null
+++ b/etc/images/radio-mixed.svg
@@ -0,0 +1,6 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="1em" viewBox="0 0 16 16">
+ <g>
+ <path d="M8 1C4.142 1 1 4.142 1 8s3.142 7 7 7 7-3.142 7-7-3.142-7-7-7zm0 1c3.316 0 6 2.684 6 6s-2.684 6-6 6-6-2.684-6-6 2.684-6 6-6z" overflow="visible" />
+ <path d="M5 6a2 2 0 1 0 0 4h6a2 2 0 1 0 0 -4z" overflow="visible" />
+ </g>
+</svg>
diff --git a/etc/images/radio.svg b/etc/images/radio.svg
new file mode 100644
index 00000000000..2593a78610e
--- /dev/null
+++ b/etc/images/radio.svg
@@ -0,0 +1,3 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="1em" viewBox="0 0 16 16">
+ <path d="M8 1C4.142 1 1 4.142 1 8s3.142 7 7 7 7-3.142 7-7-3.142-7-7-7zm0 1c3.316 0 6 2.684 6 6s-2.684 6-6 6-6-2.684-6-6 2.684-6 6-6z" overflow="visible" />
+</svg>
diff --git a/etc/images/right.svg b/etc/images/right.svg
new file mode 100644
index 00000000000..d58cd364359
--- /dev/null
+++ b/etc/images/right.svg
@@ -0,0 +1,40 @@
+<?xml version='1.0' encoding='UTF-8' standalone='no'?>
+<svg xmlns:cc='http://creativecommons.org/ns#' xmlns:dc='http://purl.org/dc/elements/1.1/' sodipodi:docname='pan-end-symbolic.svg' inkscape:export-filename='/home/sam/source-symbolic.png' inkscape:export-xdpi='270' inkscape:export-ydpi='270' height='16' id='svg7384' xmlns:inkscape='http://www.inkscape.org/namespaces/inkscape' xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#' xmlns:sodipodi='http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd' style='enable-background:new' xmlns:svg='http://www.w3.org/2000/svg' version='1.1' inkscape:version='1.0 (4035a4fb49, 2020-05-01)' width='16' xmlns='http://www.w3.org/2000/svg'>
+ <sodipodi:namedview inkscape:bbox-nodes='true' inkscape:bbox-paths='false' bordercolor='#000000' borderlayer='false' borderopacity='0.50196078' inkscape:current-layer='layer10' inkscape:cx='31.147668' inkscape:cy='7.96251' inkscape:document-rotation='0' gridtolerance='10' inkscape:guide-bbox='true' guidetolerance='10' id='namedview88' inkscape:measure-end='0,0' inkscape:measure-start='0,0' inkscape:object-nodes='true' inkscape:object-paths='true' objecttolerance='10' pagecolor='#e2e2e2' inkscape:pageopacity='0' inkscape:pageshadow='2' showborder='false' showgrid='true' showguides='false' inkscape:showpageshadow='false' inkscape:snap-bbox='true' inkscape:snap-bbox-edge-midpoints='false' inkscape:snap-bbox-midpoints='true' inkscape:snap-center='false' inkscape:snap-global='true' inkscape:snap-grids='true' inkscape:snap-intersection-paths='false' inkscape:snap-midpoints='true' inkscape:snap-nodes='true' inkscape:snap-object-midpoints='true' inkscape:snap-others='true' inkscape:snap-page='false' inkscape:snap-smooth-nodes='true' inkscape:snap-to-guides='true' inkscape:window-height='1205' inkscape:window-maximized='0' inkscape:window-width='1553' inkscape:window-x='26' inkscape:window-y='23' inkscape:zoom='1'>
+ <inkscape:grid color='#000000' dotted='false' empcolor='#0800ff' empopacity='0.4627451' empspacing='4' enabled='true' id='grid4866' opacity='0.16470588' originx='-112.00585' originy='-951.99999' snapvisiblegridlinesonly='true' spacingx='1' spacingy='1' type='xygrid' visible='true'/>
+ <inkscape:grid dotted='true' empcolor='#3f3fff' empopacity='0' empspacing='4' id='grid3540' originx='-112.00585' originy='-951.99999' spacingx='0.5' spacingy='0.5' type='xygrid'/>
+ </sodipodi:namedview>
+ <metadata id='metadata90'>
+ <rdf:RDF>
+ <cc:Work rdf:about=''>
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type rdf:resource='http://purl.org/dc/dcmitype/StillImage'/>
+ <dc:title>Gnome Symbolic Icons</dc:title>
+ <cc:license rdf:resource='http://creativecommons.org/licenses/by-sa/4.0/'/>
+ </cc:Work>
+ <cc:License rdf:about='http://creativecommons.org/licenses/by-sa/4.0/'>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Reproduction'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Distribution'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Notice'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Attribution'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#DerivativeWorks'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#ShareAlike'/>
+ </cc:License>
+ </rdf:RDF>
+ </metadata>
+ <title id='title8473'>Gnome Symbolic Icons</title>
+ <defs id='defs7386'/>
+ <g inkscape:groupmode='layer' id='layer10' inkscape:label='ui' transform='translate(-112.00585,-951.99999)'>
+ <path inkscape:connector-curvature='0' d='m 117,966 6.00585,-6.00001 L 117,954 Z' id='path6412' sodipodi:nodetypes='cccc' style='fill:#2e3436;fill-opacity:1;stroke:none'/>
+ </g>
+ <g inkscape:groupmode='layer' id='layer1' inkscape:label='status' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer11' inkscape:label='legacy' transform='translate(-112.00585,-951.99999)'/>
+ <g inkscape:groupmode='layer' id='layer7' inkscape:label='places' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer6' inkscape:label='mimetypes' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer5' inkscape:label='emotes' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer9' inkscape:label='emblems' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer2' inkscape:label='devices' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer8' inkscape:label='categories' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer3' inkscape:label='apps' transform='translate(-112.00585,-887.99999)'/>
+ <g inkscape:groupmode='layer' id='layer4' inkscape:label='actions' transform='translate(-112.00585,-887.99999)'/>
+</svg>
diff --git a/etc/images/unchecked.svg b/etc/images/unchecked.svg
new file mode 100644
index 00000000000..09bab8de95b
--- /dev/null
+++ b/etc/images/unchecked.svg
@@ -0,0 +1,3 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="1em" viewBox="0 0 16 16">
+ <path d="M3.5 1A2.506 2.506 0 0 0 1 3.5v9C1 13.876 2.124 15 3.5 15h9c1.376 0 2.5-1.124 2.5-2.5v-9C15 2.124 13.876 1 12.5 1zm0 1h9c.84 0 1.5 .66 1.5 1.5v9c0 .84-.66 1.5-1.5 1.5h-9c-.84 0-1.5-.66-1.5-1.5v-9C2 2.66 2.66 2 3.5 2z" overflow="visible" />
+</svg>
diff --git a/etc/images/up.svg b/etc/images/up.svg
new file mode 100644
index 00000000000..9e1a245be74
--- /dev/null
+++ b/etc/images/up.svg
@@ -0,0 +1,40 @@
+<?xml version='1.0' encoding='UTF-8' standalone='no'?>
+<svg xmlns:cc='http://creativecommons.org/ns#' xmlns:dc='http://purl.org/dc/elements/1.1/' sodipodi:docname='pan-up-symbolic.svg' inkscape:export-filename='/home/sam/source-symbolic.png' inkscape:export-xdpi='270' inkscape:export-ydpi='270' height='16' id='svg7384' xmlns:inkscape='http://www.inkscape.org/namespaces/inkscape' xmlns:rdf='http://www.w3.org/1999/02/22-rdf-syntax-ns#' xmlns:sodipodi='http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd' style='enable-background:new' xmlns:svg='http://www.w3.org/2000/svg' version='1.1' inkscape:version='1.0 (4035a4fb49, 2020-05-01)' width='16' xmlns='http://www.w3.org/2000/svg'>
+ <sodipodi:namedview inkscape:bbox-nodes='true' inkscape:bbox-paths='false' bordercolor='#000000' borderlayer='false' borderopacity='0.50196078' inkscape:current-layer='layer10' inkscape:cx='11.14767' inkscape:cy='7.9625016' inkscape:document-rotation='0' gridtolerance='10' inkscape:guide-bbox='true' guidetolerance='10' id='namedview88' inkscape:measure-end='0,0' inkscape:measure-start='0,0' inkscape:object-nodes='true' inkscape:object-paths='true' objecttolerance='10' pagecolor='#e2e2e2' inkscape:pageopacity='0' inkscape:pageshadow='2' showborder='false' showgrid='true' showguides='false' inkscape:showpageshadow='false' inkscape:snap-bbox='true' inkscape:snap-bbox-edge-midpoints='false' inkscape:snap-bbox-midpoints='true' inkscape:snap-center='false' inkscape:snap-global='true' inkscape:snap-grids='true' inkscape:snap-intersection-paths='false' inkscape:snap-midpoints='true' inkscape:snap-nodes='true' inkscape:snap-object-midpoints='true' inkscape:snap-others='true' inkscape:snap-page='false' inkscape:snap-smooth-nodes='true' inkscape:snap-to-guides='true' inkscape:window-height='1205' inkscape:window-maximized='0' inkscape:window-width='1553' inkscape:window-x='26' inkscape:window-y='23' inkscape:zoom='1'>
+ <inkscape:grid color='#000000' dotted='false' empcolor='#0800ff' empopacity='0.4627451' empspacing='4' enabled='true' id='grid4866' opacity='0.16470588' originx='-132.00585' originy='-952' snapvisiblegridlinesonly='true' spacingx='1' spacingy='1' type='xygrid' visible='true'/>
+ <inkscape:grid dotted='true' empcolor='#3f3fff' empopacity='0' empspacing='4' id='grid3540' originx='-132.00585' originy='-952' spacingx='0.5' spacingy='0.5' type='xygrid'/>
+ </sodipodi:namedview>
+ <metadata id='metadata90'>
+ <rdf:RDF>
+ <cc:Work rdf:about=''>
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type rdf:resource='http://purl.org/dc/dcmitype/StillImage'/>
+ <dc:title>Gnome Symbolic Icons</dc:title>
+ <cc:license rdf:resource='http://creativecommons.org/licenses/by-sa/4.0/'/>
+ </cc:Work>
+ <cc:License rdf:about='http://creativecommons.org/licenses/by-sa/4.0/'>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Reproduction'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#Distribution'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Notice'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#Attribution'/>
+ <cc:permits rdf:resource='http://creativecommons.org/ns#DerivativeWorks'/>
+ <cc:requires rdf:resource='http://creativecommons.org/ns#ShareAlike'/>
+ </cc:License>
+ </rdf:RDF>
+ </metadata>
+ <title id='title8473'>Gnome Symbolic Icons</title>
+ <defs id='defs7386'/>
+ <g inkscape:groupmode='layer' id='layer10' inkscape:label='ui' transform='translate(-132.00585,-952)'>
+ <path inkscape:connector-curvature='0' d='M 146,963 140.00585,956.99999 134,963 Z' id='path6418' sodipodi:nodetypes='cccc' style='fill:#2e3436;fill-opacity:1;stroke:none'/>
+ </g>
+ <g inkscape:groupmode='layer' id='layer1' inkscape:label='status' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer11' inkscape:label='legacy' transform='translate(-132.00585,-952)'/>
+ <g inkscape:groupmode='layer' id='layer7' inkscape:label='places' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer6' inkscape:label='mimetypes' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer5' inkscape:label='emotes' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer9' inkscape:label='emblems' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer2' inkscape:label='devices' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer8' inkscape:label='categories' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer3' inkscape:label='apps' transform='translate(-132.00585,-888)'/>
+ <g inkscape:groupmode='layer' id='layer4' inkscape:label='actions' transform='translate(-132.00585,-888)'/>
+</svg>
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index c890acb69f4..9cd0df7a5ed 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -443,8 +443,6 @@ einen Rahmen statt eines Fensters.
\key{Spalte f\"ur Umbruch auf {\it Argument\/} setzen}{C-x f}
\key{Pr\"afix f\"ur jede Zeile setzen}{C-x .}
-\key{Face setzen}{M-o}
-
\section{Gro\ss{}- und Kleinschreibung}
\key{Wort in Gro\ss{}buchstaben}{M-u}
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index 34d7ebda19e..ad6db6340d4 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -446,8 +446,6 @@ pas les fen\^etres mais les cadres.
\key{Placer la marge droite \`a {\it arg\/} colonnes}{C-u {\it arg\/} C-x f}
\key{D\'efinir le pr\'efixe des lignes}{C-x .}
-\key{D\'efinir la fonte}{M-o}
-
\section{Modifier la casse}
\key{Mettre le mot en capitales}{M-u}
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index b31b4270ab4..c9d96788c5d 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -394,7 +394,7 @@ po polsku.
\key{szukaj wstecz tekstu zgodnego z~wpisywanym wyra/zeniem regularnym}{C-M-r}
%\key{select previous search string}{M-p}
-%\key{select next later search string}{M-n}
+%\key{select next search string}{M-n}
%\key{exit incremental search}{RET}
%\key{undo effect of last character}{DEL}
%\key{abort current search}{C-g}
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index 2d6680f7931..9226a6d8fba 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -452,8 +452,6 @@ para frame.
\key{define a coluna limite de preenchimento}{C-x f}
\key{define um prefixo para cada linha}{C-x .}
-\key{formata fonte}{M-o}
-
\section{Mai{\'u}sculas e Min{\'u}sculas}
\key{Palavra para mai{\'u}sculas}{M-u}
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index f7b5da40b05..ae39a4e9f76 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -322,7 +322,7 @@ the directions. If you are a first-time user, type \kbd{C-h t} for a
\key{reverse regular expression search}{C-M-r}
\key{select previous search string}{M-p}
-\key{select next later search string}{M-n}
+\key{select next search string}{M-n}
\key{exit incremental search}{RET}
\key{undo effect of last character}{DEL}
\key{abort current search}{C-g}
@@ -457,8 +457,6 @@ frame instead of a window.
\key{set fill column to {\it arg}}{C-x f}
\key{set prefix each line starts with}{C-x .}
-\key{set face}{M-o}
-
\section{Case Change}
\key{uppercase word}{M-u}
diff --git a/etc/schema/OpenDocument-schema-v1.3+libreoffice.rnc b/etc/schema/OpenDocument-schema-v1.3+libreoffice.rnc
new file mode 100644
index 00000000000..5239c84cb50
--- /dev/null
+++ b/etc/schema/OpenDocument-schema-v1.3+libreoffice.rnc
@@ -0,0 +1,892 @@
+# Open Document Format for Office Applications (OpenDocument) Version 1.3
+# OASIS Standard, In progress
+# Relax-NG Schema
+# Source: https://tools.oasis-open.org/version-control/svn/office/
+# Copyright (c) OASIS Open 2002-2015. 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 calcext =
+ "urn:org:documentfoundation:names:experimental:calc:xmlns:calcext:1.0"
+namespace chart = "urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
+namespace chartooo = "http://openoffice.org/2010/chart"
+namespace config = "urn:oasis:names:tc:opendocument:xmlns:config:1.0"
+namespace css3t = "http://www.w3.org/TR/css3-text/"
+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 drawooo = "http://openoffice.org/2010/draw"
+namespace field =
+ "urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field: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 loext =
+ "urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0"
+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 officeooo = "http://openoffice.org/2009/office"
+namespace presentation =
+ "urn:oasis:names:tc:opendocument:xmlns:presentation:1.0"
+namespace rng = "http://relaxng.org/ns/structure/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 tableooo = "http://openoffice.org/2009/table"
+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"
+
+include "OpenDocument-schema-v1.3.rnc" {
+ office-document-common-attrs =
+ attribute office:version {
+ # FIXME remove this hack once we write 1.3
+ "1.3" | "1.2"
+ }
+ & attribute grddl:transformation {
+ list { anyIRI* }
+ }?
+ 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 }?
+ & # FIXME remove this once the export bug is fixed
+ attribute draw:fit-to-size {
+ "true" | "false" | "all" | "shrink-to-fit"
+ }?
+ & 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 { signedZeroToHundredPercent }
+ # https://issues.oasis-open.org/browse/OFFICE-3821
+ ?
+ & 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 }?
+ & # TODO: no proposal for loext:shadow-blur
+ attribute loext:shadow-blur { length }?
+ & 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 }?
+ & # https://issues.oasis-open.org/browse/OFFICE-4047
+ attribute loext:allow-overlap { boolean }?
+ & # TODO: no proposal for loext:glow*
+ attribute loext:glow-radius { length }?
+ & attribute loext:glow-color { color }?
+ & attribute loext:glow-transparency { zeroToHundredPercent }?
+ & # TODO: no proposal for loext:softedge-radius
+ attribute loext:softedge-radius { length }?
+ draw-text =
+ (text-p
+ | text-list
+ | # https://issues.oasis-open.org/browse/OFFICE-3761
+ loext-table)*
+ office-annotation-attlist &=
+ attribute office:display { boolean }?
+ & common-office-annotation-name-attlist?
+ & attribute loext:resolved { boolean }?
+ style-style-content =
+ (attribute style:family { "text" },
+ style-text-properties?)
+ | (attribute style:family { "paragraph" },
+ # TODO no proposal
+ loext-graphic-properties?,
+ 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" },
+ # TODO no proposal
+ loext-graphic-properties?,
+ 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?)
+ 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?,
+ # TODO no proposal
+ table-first-row-even-column?,
+ table-last-row-even-column?,
+ table-first-row-end-column?,
+ table-first-row-start-column?,
+ table-last-row-end-column?,
+ table-last-row-start-column?
+ }
+ 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)?,
+ # TODO no proposal
+ loext-signatureline?,
+ loext-qrcode?
+ }
+ common-value-and-type-attlist =
+ (attribute office:value-type { "float" },
+ attribute calcext:value-type { "float" }?,
+ attribute office:value { double })
+ | (attribute office:value-type { "percentage" },
+ attribute calcext:value-type { "percentage" }?,
+ attribute office:value { double })
+ | (attribute office:value-type { "currency" },
+ attribute calcext:value-type { "currency" }?,
+ attribute office:value { double },
+ attribute office:currency { \string }?)
+ | (attribute office:value-type { "date" },
+ attribute calcext:value-type { "date" }?,
+ attribute office:date-value { dateOrDateTime })
+ | (attribute office:value-type { "time" },
+ attribute calcext:value-type { "time" }?,
+ attribute office:time-value { duration })
+ | (attribute office:value-type { "boolean" },
+ attribute calcext:value-type { "boolean" }?,
+ attribute office:boolean-value { boolean })
+ | (attribute office:value-type { "string" },
+ # OFFICE-3759
+ attribute calcext:value-type { "string" | "error" }?,
+ attribute office:string-value { \string }?)
+ chart-axis =
+ element chart:axis {
+ chart-axis-attlist,
+ # OFFICE-2119
+ ((attribute chartooo:axis-type { "auto" },
+ chartooo-date-scale?)
+ | (attribute chartooo:axis-type { "date" },
+ chartooo-date-scale)
+ | attribute chartooo:axis-type { "text" })?,
+ chart-title?,
+ chart-categories?,
+ chart-grid*
+ }
+ table-table =
+ element table:table {
+ table-table-attlist,
+ table-title?,
+ table-desc?,
+ # TODO add to proposal, OFFICE-2112
+ table-table-protection?,
+ table-table-source?,
+ office-dde-source?,
+ table-scenario?,
+ office-forms?,
+ table-shapes?,
+ table-columns-and-groups,
+ table-rows-and-groups,
+ table-named-expressions?,
+ # TODO no proposal, this is wild guessing, OFFICE-3785
+ element calcext:conditional-formats {
+ element calcext:conditional-format {
+ attribute calcext:target-range-address { cellRangeAddress },
+ (element calcext:condition {
+ attribute calcext:apply-style-name { styleNameRef },
+ attribute calcext:value { \string },
+ attribute calcext:base-cell-address { cellAddress }
+ }+
+ | element calcext:data-bar {
+ attribute calcext:max-length { \string },
+ attribute calcext:negative-color { color },
+ attribute calcext:positive-color { color },
+ attribute calcext:axis-color { color },
+ attribute calcext:axis-position { "middle" }?,
+ element calcext:formatting-entry {
+ attribute calcext:value { \string },
+ attribute calcext:type {
+ "auto-minimum"
+ | "auto-maximum"
+ | "minimum"
+ | "maximum"
+ | "percent"
+ | "percentile"
+ | "number"
+ | "formula"
+ }
+ },
+ element calcext:formatting-entry {
+ attribute calcext:value { \string },
+ attribute calcext:type {
+ "auto-minimum"
+ | "auto-maximum"
+ | "minimum"
+ | "maximum"
+ | "percent"
+ | "percentile"
+ | "number"
+ | "formula"
+ }
+ }
+ }
+ | element calcext:color-scale {
+ element calcext:color-scale-entry {
+ attribute calcext:value { \string },
+ attribute calcext:type {
+ "minimum"
+ | "maximum"
+ | "percent"
+ | "percentile"
+ | "number"
+ | "formula"
+ },
+ attribute calcext:color { color }
+ },
+ element calcext:color-scale-entry {
+ attribute calcext:value { \string },
+ attribute calcext:type {
+ "minimum"
+ | "maximum"
+ | "percent"
+ | "percentile"
+ | "number"
+ | "formula"
+ },
+ attribute calcext:color { color }
+ },
+ element calcext:color-scale-entry {
+ attribute calcext:value { \string },
+ attribute calcext:type {
+ "minimum"
+ | "maximum"
+ | "percent"
+ | "percentile"
+ | "number"
+ | "formula"
+ },
+ attribute calcext:color { color }
+ }?
+ })
+ }+
+ }?
+ }
+ # TODO no proposal
+ draw-object =
+ element draw:object {
+ draw-object-attlist,
+ loext-text,
+ (common-draw-data-attlist | office-document | math-math)
+ }
+ draw-object-ole =
+ element draw:object-ole {
+ draw-object-ole-attlist,
+ loext-text,
+ (common-draw-data-attlist | office-binary-data)
+ }
+ # FIXME: one test exports 250 here, which is probably a bug
+ fontWeight =
+ "normal"
+ | "bold"
+ | "100"
+ | "200"
+ | "250"
+ | "300"
+ | "400"
+ | "500"
+ | "600"
+ | "700"
+ | "800"
+ | "900"
+}
+# TODO no proposal
+loext-p =
+ element loext:p { paragraph-attrs, paragraph-content-or-hyperlink* }
+loext-text = (loext-p | text-list | loext-table)*
+# OFFICE-2119
+chartooo-date-scale =
+ element chartooo:date-scale {
+ attribute chart:base-time-unit { chart-time-unit }?
+ & (attribute chart:major-interval-value { positiveInteger },
+ attribute chart:major-interval-unit { chart-time-unit })?
+ & (attribute chart:minor-interval-value { positiveInteger },
+ attribute chart:minor-interval-unit { chart-time-unit })?
+ }
+chart-time-unit = "days" | "months" | "years"
+# TODO no proposal
+loext-signatureline =
+ element loext:signatureline {
+ attribute loext:id { \string },
+ attribute loext:suggested-signer-name { \string },
+ attribute loext:suggested-signer-title { \string },
+ attribute loext:suggested-signer-email { \string },
+ attribute loext:signing-instructions { \string },
+ attribute loext:show-sign-date { boolean },
+ attribute loext:can-add-comment { boolean }
+ }
+loext-qrcode =
+ element loext:qrcode {
+ attribute office:string-value { \string },
+ attribute loext:qrcode-errorcorrection {
+ "low" | "medium" | "quartile" | "high"
+ },
+ attribute loext:qrcode-border { nonNegativeInteger }
+ }
+# https://issues.oasis-open.org/browse/OFFICE-3761
+loext-table =
+ element loext:table {
+ table-table-attlist,
+ table-title?,
+ table-desc?,
+ table-table-source?,
+ office-dde-source?,
+ table-scenario?,
+ office-forms?,
+ table-shapes?,
+ loext-columns-and-groups,
+ loext-rows-and-groups,
+ table-named-expressions?
+ }
+loext-rows-and-groups = (table-table-row-group | loext-rows-no-group)+
+loext-rows-no-group =
+ (loext-rows, (table-table-header-rows, loext-rows?)?)
+ | (table-table-header-rows, loext-rows?)
+loext-rows =
+ table-table-rows | (text-soft-page-break?, loext-table-row)+
+loext-table-row =
+ element loext:table-row {
+ table-table-row-attlist,
+ (loext-table-cell | loext-covered-table-cell)+
+ }
+loext-table-cell =
+ element loext:table-cell {
+ table-table-cell-attlist,
+ table-table-cell-attlist-extra,
+ table-table-cell-content
+ }
+loext-covered-table-cell =
+ element loext:covered-table-cell {
+ table-table-cell-attlist, table-table-cell-content
+ }
+loext-columns-and-groups =
+ (table-table-column-group | loext-columns-no-group)+
+loext-columns-no-group =
+ (loext-columns, (table-table-header-columns, loext-columns?)?)
+ | (table-table-header-columns, loext-columns?)
+loext-columns = loext-table-columns | loext-table-column+
+loext-table-columns =
+ element loext:table-columns { loext-table-column+ }
+loext-table-column =
+ element loext:table-column { table-table-column-attlist, empty }
+loext-graphic-properties =
+ element loext:graphic-properties {
+ style-graphic-properties-content-strict
+ }
+table-first-row-even-column =
+ element loext:first-row-even-column {
+ common-table-template-attlist, empty
+ }
+table-last-row-even-column =
+ element loext:last-row-even-column {
+ common-table-template-attlist, empty
+ }
+table-first-row-end-column =
+ element loext:first-row-end-column {
+ common-table-template-attlist, empty
+ }
+table-first-row-start-column =
+ element loext:first-row-start-column {
+ common-table-template-attlist, empty
+ }
+table-last-row-end-column =
+ element loext:last-row-end-column {
+ common-table-template-attlist, empty
+ }
+table-last-row-start-column =
+ element loext:last-row-start-column {
+ common-table-template-attlist, empty
+ }
+common-draw-rel-size-attlist &=
+ # OFFICE-3854
+ attribute loext:rel-width-rel {
+ "page"
+ | [
+ # TODO layout-environment ?
+
+ ]
+ "paragraph"
+ }?,
+ attribute loext:rel-height-rel { "page" | "paragraph" }?
+common-svg-font-face-xlink-attlist &=
+ # TODO no proposal
+ attribute loext:font-style { fontStyle }?,
+ attribute loext:font-weight { fontWeight }?
+# TODO no proposal
+
+# there's no ref-attrs so add it here
+text-common-ref-content &=
+ attribute loext:reference-language { language }?
+style-list-level-label-alignment-attlist &=
+ # TODO no proposal
+ attribute loext:label-followed-by {
+ "listtab" | "space" | "nothing" | "newline"
+ }?
+style-ruby-properties-attlist &=
+ # TODO proposal, OFFICE-3944
+ attribute loext:ruby-position {
+ "above" | "below" | "inter-character"
+ }?
+style-text-properties-attlist &=
+ # TODO no proposal
+ attribute officeooo:rsid { \string }?,
+ attribute officeooo:paragraph-rsid { \string }?,
+ # https://issues.oasis-open.org/browse/OFFICE-4049
+ attribute loext:opacity { zeroToHundredPercent }?
+style-text-properties-attlist &=
+ # OFFICE-3843
+ attribute loext:padding { nonNegativeLength }?,
+ attribute loext:padding-left { nonNegativeLength }?,
+ attribute loext:padding-right { nonNegativeLength }?,
+ attribute loext:padding-top { nonNegativeLength }?,
+ attribute loext:padding-bottom { nonNegativeLength }?,
+ attribute loext:border { \string }?,
+ attribute loext:border-left { \string }?,
+ attribute loext:border-right { \string }?,
+ attribute loext:border-top { \string }?,
+ attribute loext:border-bottom { \string }?,
+ attribute loext:shadow { shadowType }?
+# TODO no proposal
+style-chart-properties-attlist &=
+ attribute loext:try-staggering-first { boolean }?
+# TODO no proposal
+style-chart-properties-attlist &=
+ attribute loext:std-weight { \string }?
+# TODO no proposal
+chart-series-attlist &= attribute loext:label-string { \string }?
+# OFFICE-1148
+style-chart-properties-attlist &=
+ attribute loext:regression-max-degree { positiveInteger }?,
+ attribute loext:regression-force-intercept { boolean }?,
+ attribute loext:regression-intercept-value { double }?,
+ attribute loext:regression-name { \string }?,
+ attribute loext:regression-period { \string }?,
+ attribute loext:regression-extrapolate-forward { \string }?,
+ attribute loext:regression-extrapolate-backward { \string }?
+# TODO no proposal
+table-data-pilot-field-attlist &=
+ attribute tableooo:display-name { \string }?
+# TODO no proposal, 9009663d
+chart-chart-attlist &= attribute loext:data-pilot-source { \string }?
+# OFFICE-2112, TODO half of this missing in proposal
+table-table-protection =
+ element loext:table-protection {
+ attribute loext:select-protected-cells { boolean }?,
+ attribute loext:select-unprotected-cells { boolean }?,
+ attribute loext:insert-columns { boolean }?,
+ attribute loext:insert-rows { boolean }?,
+ attribute loext:delete-columns { boolean }?,
+ attribute loext:delete-rows { boolean }?
+ }
+office-spreadsheet-attlist &=
+ attribute loext:protection-key-digest-algorithm-2 { anyURI }?
+table-table-attlist &=
+ attribute loext:protection-key-digest-algorithm-2 { anyURI }?
+# https://issues.oasis-open.org/browse/OFFICE-2317
+vertJustifyValues = "auto" | "distribute"
+common-text-justify =
+ attribute css3t:text-justify { vertJustifyValues }?
+style-vertical-justify =
+ attribute loext:vertical-justify { vertJustifyValues }?,
+ attribute style:vertical-justify { vertJustifyValues }?
+style-paragraph-properties-attlist &=
+ (common-text-justify, style-vertical-justify)?
+style-table-cell-properties-attlist &=
+ (common-text-justify, style-vertical-justify)?
+number-fraction-attlist &=
+ # OFFICE-3695
+
+ # TODO no proposal, 1544a26ac9f7dd60605dd21e9cbe29d490aafdce
+ attribute loext:max-numerator-digits { positiveInteger }?
+# TODO no proposal
+table-data-pilot-level-attlist &=
+ attribute calcext:repeat-item-labels { boolean }?
+# TODO no proposal
+draw-enhanced-geometry-attlist &=
+ attribute drawooo:sub-view-size { \string }?,
+ attribute drawooo:enhanced-path { \string }?
+# TODO no proposal
+draw-custom-shape-attlist &= common-draw-rel-size-attlist
+# TODO no proposal
+style-page-layout-properties-attlist &=
+ style-graphic-fill-properties-attlist
+style-header-footer-properties-attlist &=
+ style-graphic-fill-properties-attlist
+# TODO no proposal
+text-index-entry-tab-stop-attrs &= attribute style:with-tab { boolean }?
+# TODO no proposal
+style-text-properties-attlist &=
+ attribute loext:char-shading-value { \string }?
+# TODO no proposal
+text-bookmark-start-attlist &=
+ (attribute loext:hidden { boolean },
+ attribute loext:condition { \string }?)?
+# TODO no proposal; see 7a5d79f2297a43d0a854e304b0792164272edfe0
+
+# FIXME this is almost certainly incomplete: need to figure out which elements can have this and which named pattern can be extended with it to get exactly these elements
+form-checkbox-attlist &= attribute form:input-required { boolean }?
+# https://issues.oasis-open.org/browse/OFFICE-4030
+common-writing-mode-attlist &= attribute loext:writing-mode { "bt-lr" }?
+# https://issues.oasis-open.org/browse/OFFICE-4073
+common-vertical-rel-attlist &=
+ attribute loext:vertical-rel {
+ "page-content-top" | "page-content-bottom"
+ }?
+# https://issues.oasis-open.org/browse/OFFICE-4105
+style-page-layout-properties-attlist &=
+ attribute loext:margin-gutter { length }?
+# just a test-case for user-defined attributes, move along, nothing to see here...
+style-table-cell-properties-attlist &= attribute proName { \string }?
+# TODO no proposal
+chart-data-point-attlist &=
+ attribute loext:custom-label-field { \string }?
+# TODO no proposal
+style-text-properties-attlist &=
+ attribute loext:hyphenation-no-caps { boolean }?
+# TODO no proposal
+chart-data-point-attlist &=
+ (attribute loext:custom-label-pos-x { double },
+ attribute loext:custom-label-pos-y { double })?
+# TODO no proposal
+chart-legend-attlist &= attribute loext:overlay { boolean }?
+# https://issues.oasis-open.org/browse/OFFICE-3936
+style-chart-properties-attlist &=
+ attribute loext:major-origin { double }?
+# TODO no proposal
+text-index-entry-chapter-attrs &=
+ attribute loext:outline-content-visible { boolean }?
+# https://issues.oasis-open.org/browse/OFFICE-2096
+paragraph-content |=
+ element field:fieldmark-start {
+ attribute text:name { \string },
+ attribute field:type {
+ # TODO <rng:ref name="namespacedToken"/>
+ \string
+ },
+ element field:param {
+ attribute field:name { \string },
+ attribute field:value { \string }
+ }*
+ }
+paragraph-content |= element field:fieldmark-end { empty }
+paragraph-content |=
+ element field:fieldmark {
+ attribute text:name { \string },
+ attribute field:type {
+ # TODO <rng:ref name="namespacedToken"/>
+ \string
+ },
+ element field:param {
+ attribute field:name { \string },
+ attribute field:value { \string }
+ }*
+ }
+# TODO no proposal
+animation-element |=
+ element loext:animatePhysics {
+ common-anim-target-attlist,
+ common-timing-attlist,
+ animate-physics-attlist
+ }
+animate-physics-attlist =
+ # default value: 0
+ attribute loext:velocity-x { double }?,
+ # default value: 0
+ attribute loext:velocity-y { double }?,
+ # default value: 0.1
+ attribute loext:bounciness {
+ xsd:double { minInclusive = "0" maxInclusive = "1" }
+ }?,
+ # default value: 1
+ attribute loext:density {
+ xsd:double { minInclusive = "0" }
+ }?
+# TODO no proposal
+style-chart-properties-attlist &=
+ attribute loext:custom-leader-lines { boolean }?
+# TODO no proposal
+style-chart-properties-attlist &=
+ attribute loext:external-data { \string }?
diff --git a/etc/schema/od-schema-v1.2-os.rnc b/etc/schema/OpenDocument-schema-v1.3.rnc
index 8d679d62e4e..2a7867998f1 100644
--- a/etc/schema/od-schema-v1.2-os.rnc
+++ b/etc/schema/OpenDocument-schema-v1.3.rnc
@@ -1,33 +1,16 @@
-# 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.
+# Open Document Format for Office Applications (OpenDocument) Version 1.3
+# Committee Specification 02
+# 30 October 2020
+# Copyright (c) OASIS Open 2020. All Rights Reserved.
+# Source: https://docs.oasis-open.org/office/OpenDocument/v1.3/cs02/schemas/
+# Latest stage of specification: https://docs.oasis-open.org/office/OpenDocument/v1.3/OpenDocument-v1.3-part1-introduction.html
+# TC IPR Statement: https://www.oasis-open.org/committees/office/ipr.php
#
-# 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.
+# Open Document Format for Office Applications (OpenDocument) Version 1.3
+# Relax-NG Schema
+# OpenDocument-v1.3-schema.rng
+
+# https://issues.oasis-open.org/browse/OFFICE-2153
namespace anim = "urn:oasis:names:tc:opendocument:xmlns:animation:1.0"
namespace chart = "urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
@@ -46,6 +29,7 @@ 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 rng = "http://relaxng.org/ns/structure/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"
@@ -58,58 +42,2667 @@ 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
+CURIE =
+ xsd:string { pattern = "(([\i-[:]][\c-[:]]*)?:)?.+" minLength = "1" }
+CURIEs = list { CURIE+ }
+ID = xsd:ID
+IDREF = xsd:IDREF
+IDREFS = xsd:IDREFS
+NCName = xsd:NCName
+SafeCURIE =
+ xsd:string {
+ pattern = "\[(([\i-[:]][\c-[:]]*)?:)?.+\]"
+ minLength = "3"
}
-office-document-content =
- element office:document-content {
- office-document-common-attrs,
- office-scripts,
- office-font-face-decls,
- office-automatic-styles,
- office-body
+URIorSafeCURIE = anyURI | SafeCURIE
+angle = xsd:string
+anim-animate-color-attlist =
+ attribute anim:color-interpolation { "rgb" | "hsl" }?
+ & attribute anim:color-interpolation-direction {
+ "clockwise" | "counter-clockwise"
+ }?
+anim-animate-motion-attlist =
+ attribute svg:path { pathData }?
+ & attribute svg:origin { \string }?
+ & attribute smil:calcMode {
+ "discrete" | "linear" | "paced" | "spline"
+ }?
+anim-animate-transform-attlist =
+ attribute svg:type {
+ "translate" | "scale" | "rotate" | "skewX" | "skewY"
}
-office-document-styles =
- element office:document-styles {
- office-document-common-attrs,
- office-font-face-decls,
- office-styles,
- office-automatic-styles,
- office-master-styles
+anim-audio-attlist =
+ attribute xlink:href { anyIRI }?
+ & attribute anim:audio-level { double }?
+anim-command-attlist = attribute anim:command { \string }
+anim-iterate-attlist =
+ common-anim-target-attlist
+ & attribute anim:iterate-type { \string }?
+ & attribute anim:iterate-interval { duration }?
+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" }?
+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
}
-office-document-meta =
- element office:document-meta {
- office-document-common-attrs, office-meta
+ | 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 }
+ }*
+ }
+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
+any-number = number-number | number-scientific-number | number-fraction
+any-time = number-hours | number-am-pm | number-minutes | number-seconds
+anyAttListOrElements =
+ attribute * { text }*,
+ anyElements
+anyElements =
+ element * {
+ mixed { anyAttListOrElements }
+ }*
+anyIRI =
+ xsd:anyURI
+ >> dc:description [
+ "An IRI-reference as defined in [RFC3987]. See ODF 1.3 Part 3 section 18.3."
+ ]
+anyURI = xsd:anyURI
+base64Binary = xsd:base64Binary
+boolean = "true" | "false"
+borderWidths = list { positiveLength, positiveLength, positiveLength }
+bound-column = attribute form:bound-column { \string }?
+button-type = attribute form:button-type { types }?
+cellAddress =
+ xsd:string {
+ pattern = "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+"
}
-office-document-settings =
- element office:document-settings {
- office-document-common-attrs, office-settings
+cellRangeAddress =
+ xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+(:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+)?"
}
-office-document-common-attrs =
- attribute office:version { "1.2" }
- & attribute grddl:transformation {
- list { anyIRI* }
+ | 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'
+ ]
+change-mark-attr = attribute text:change-id { IDREF }
+change-marks =
+ element text:change { change-mark-attr }
+ | element text:change-start { change-mark-attr }
+ | element text:change-end { change-mark-attr }
+character = xsd:string { length = "1" }
+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-categories =
+ element chart:categories {
+ attribute table:cell-range-address { cellRangeAddressList }?
+ }
+chart-chart =
+ element chart:chart {
+ chart-chart-attlist,
+ chart-title?,
+ chart-subtitle?,
+ chart-footer?,
+ chart-legend?,
+ chart-plot-area,
+ shape*,
+ # https://issues.oasis-open.org/browse/OFFICE-2123
+ 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-coordinate-region =
+ element chart:coordinate-region {
+ chart-coordinate-region-attlist, empty
+ }
+chart-coordinate-region-attlist =
+ common-draw-position-attlist, common-draw-size-attlist
+# https://issues.oasis-open.org/browse/OFFICE-3928
+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-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-dimension = "x" | "y" | "z"
+chart-domain =
+ element chart:domain {
+ attribute table:cell-range-address { cellRangeAddressList }?
+ }
+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-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-floor = element chart:floor { chart-floor-attlist, empty }
+chart-floor-attlist =
+ attribute svg:width { length }?
+ & attribute chart:style-name { styleNameRef }?
+chart-footer = element chart:footer { chart-title-attlist, text-p? }
+chart-grid = element chart:grid { chart-grid-attlist }
+chart-grid-attlist =
+ attribute chart:class { "major" | "minor" }?
+ & attribute chart:style-name { styleNameRef }?
+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 },
+ common-draw-size-attlist
+ # https://issues.oasis-open.org/browse/OFFICE-3883
+ )
+ | empty)
+ & 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-plot-area =
+ element chart:plot-area {
+ chart-plot-area-attlist,
+ # https://issues.oasis-open.org/browse/OFFICE-3928
+ chart-coordinate-region?,
+ 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"
}?
-office-document-attrs = attribute office:mimetype { \string }
-office-meta = element office:meta { office-meta-content-strict }?
-office-meta-content-strict = office-meta-data*
+ & dr3d-scene-attlist
+ & common-dr3d-transform-attlist
+ & xml-id?
+chart-regression-curve =
+ element chart:regression-curve {
+ chart-regression-curve-attlist, chart-equation?
+ }
+chart-regression-curve-attlist =
+ 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-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 }
+chart-subtitle = element chart:subtitle { chart-title-attlist, text-p? }
+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-wall = element chart:wall { chart-wall-attlist, empty }
+chart-wall-attlist =
+ attribute svg:width { length }?
+ & attribute chart:style-name { styleNameRef }?
+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}[ ]*\)"
+ }
+color = xsd:string { pattern = "#[0-9a-fA-F]{6}" }
+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
+ }
+common-anim-add-accum-attlist =
+ attribute smil:accumulate { "none" | "sum" }?
+ & attribute smil:additive { "replace" | "sum" }?
+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 }?)?
+common-anim-named-target-attlist =
+ attribute smil:attributeName { \string }
+common-anim-set-values-attlist = attribute smil:to { \string }?
+common-anim-spline-mode-attlist =
+ attribute smil:calcMode {
+ "discrete" | "linear" | "paced" | "spline"
+ }?
+common-anim-target-attlist =
+ attribute smil:targetElement { IDREF }?
+ & attribute anim:sub-item { \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-auto-reorder-attlist =
+ attribute number:automatic-order { boolean }?
+common-background-color-attlist =
+ attribute fo:background-color { "transparent" | color }?
+common-background-transparency-attlist =
+ attribute style:background-transparency { zeroToHundredPercent }?
+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-begin-end-timing-attlist =
+ attribute smil:begin { \string }?
+ & attribute smil:end { \string }?
+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 }?
+common-break-attlist =
+ attribute fo:break-before { "auto" | "column" | "page" }?,
+ attribute fo:break-after { "auto" | "column" | "page" }?
+common-calendar-attlist =
+ attribute number:calendar {
+ "gregorian"
+ | "gengou"
+ | "ROC"
+ | "hanja_yoil"
+ | "hanja"
+ | "hijri"
+ | "jewish"
+ | "buddhist"
+ | \string
+ }?
+common-contour-attlist = attribute draw:recreate-on-edit { boolean }
+common-control-id-attlist =
+ xml-id,
+ attribute form:id { NCName }?
+common-convert-empty-attlist =
+ attribute form:convert-empty-to-null { boolean }?
+common-current-value-attlist = attribute form:current-value { \string }?
+common-data-field-attlist = attribute form:data-field { \string }?
+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-db-default-value = common-value-and-type-attlist?
+common-db-object-description = attribute db:description { \string }?
+common-db-object-name = attribute db:name { \string }
+common-db-object-title = attribute db:title { \string }?
+common-db-table-name-attlist =
+ attribute db:name { \string }
+ & attribute db:catalog-name { \string }?
+ & attribute db:schema-name { \string }?
+common-db-table-style-name =
+ attribute db:style-name { styleNameRef }?
+ & attribute db:default-row-style-name { styleNameRef }?
+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 }?
+common-decimal-places-attlist =
+ attribute number:decimal-places { integer }?,
+ (attribute number:min-decimal-places { integer }?)
+ # https://issues.oasis-open.org/browse/OFFICE-3860 added number:min-decimal-places
+
+common-delay-for-repeat = attribute form:delay-for-repeat { duration }?
+common-disabled-attlist = attribute form:disabled { boolean }?
+common-dr3d-transform-attlist = attribute dr3d:transform { \string }?
+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" }?
+common-draw-caption-id-attlist = attribute draw:caption-id { IDREF }?
+common-draw-circle-ellipse-attlist =
+ attribute draw:kind { "full" | "section" | "cut" | "arc" }?
+ & attribute draw:start-angle { angle }?
+ & attribute draw:end-angle { angle }?
+common-draw-circle-ellipse-pos-attlist =
+ attribute svg:cx { coordinate },
+ attribute svg:cy { coordinate }
+common-draw-data-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onLoad" }?
+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 }?
+common-draw-id-attlist =
+ (xml-id,
+ attribute draw:id { NCName }?)?
+common-draw-layer-name-attlist = attribute draw:layer { \string }?
+common-draw-mime-type-attlist = attribute draw:mime-type { \string }?
+# https://issues.oasis-open.org/browse/OFFICE-3943
+common-draw-name-attlist = attribute draw:name { \string }?
+common-draw-path-data-attlist = attribute svg:d { pathData }
+common-draw-points-attlist = attribute draw:points { points }
+common-draw-position-attlist =
+ attribute svg:x { coordinate }?,
+ attribute svg:y { coordinate }?
+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" }?
+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
+common-draw-size-attlist =
+ attribute svg:width { length }?,
+ attribute svg:height { length }?
+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-transform-attlist = attribute draw:transform { \string }?
+common-draw-viewbox-attlist =
+ attribute svg:viewBox {
+ list { integer, integer, integer, integer }
+ }
+common-draw-z-index-attlist =
+ attribute draw:z-index { nonNegativeInteger }?
+common-dur-timing-attlist = attribute smil:dur { \string }?
+common-editable-attlist = attribute style:editable { boolean }?
+common-endsync-timing-attlist =
+ attribute smil:endsync { "first" | "last" | "all" | "media" | IDREF }?
+common-field-data-style-name-attlist =
+ attribute style:data-style-name { styleNameRef }?
+common-field-database-name =
+ attribute text:database-name { \string }?
+ | form-connection-resource
+common-field-database-table =
+ common-field-database-table-attlist, common-field-database-name
+common-field-database-table-attlist =
+ attribute text:table-name { \string }
+ & attribute text:table-type { "table" | "query" | "command" }?
+common-field-description-attlist =
+ attribute text:description { \string }?
+common-field-display-value-formula-attlist =
+ attribute text:display { "value" | "formula" }?
+common-field-display-value-formula-none-attlist =
+ attribute text:display { "value" | "formula" | "none" }?
+common-field-display-value-none-attlist =
+ attribute text:display { "value" | "none" }?
+common-field-fixed-attlist = attribute text:fixed { boolean }?
+common-field-formula-attlist = attribute text:formula { \string }?
+common-field-name-attlist = attribute text:name { variableName }
+common-field-num-format-attlist = common-num-format-attlist?
+common-fill-default-attlist =
+ attribute smil:fillDefault {
+ "remove" | "freeze" | "hold" | "transition" | "auto" | "inherit"
+ }?
+common-fill-timing-attlist =
+ attribute smil:fill {
+ "remove" | "freeze" | "hold" | "auto" | "default" | "transition"
+ }?
+common-form-control-attlist =
+ attribute form:name { \string }?
+ & attribute form:control-implementation { namespacedToken }?
+common-form-control-content = form-properties?, office-event-listeners?
+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" }?)
+common-form-visual-effect-attlist =
+ attribute form:visual-effect { "flat" | "3d" }?
+common-format-source-attlist =
+ attribute number:format-source { "fixed" | "language" }?
+common-horizontal-margin-attlist =
+ attribute fo:margin-left { length | percent }?,
+ attribute fo:margin-right { length | percent }?
+common-in-content-meta-attlist =
+ attribute xhtml:about { URIorSafeCURIE },
+ attribute xhtml:property { CURIEs },
+ common-meta-literal-attlist
+common-keep-with-next-attlist =
+ attribute fo:keep-with-next { "auto" | "always" }?
+common-linked-cell =
+ attribute form:linked-cell { cellAddress | \string }?
+common-margin-attlist =
+ attribute fo:margin { nonNegativeLength | percent }?
+common-maxlength-attlist =
+ attribute form:max-length { nonNegativeInteger }?
+common-meta-literal-attlist =
+ attribute xhtml:datatype { CURIE }?,
+ attribute xhtml:content { \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
+common-num-format-prefix-suffix-attlist =
+ attribute style:num-prefix { \string }?,
+ attribute style:num-suffix { \string }?
+common-number-attlist =
+ attribute number:min-integer-digits { integer }?
+ & attribute number:grouping { 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
+common-office-annotation-name-attlist =
+ attribute office:name { \string }
+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-page-number-attlist =
+ attribute style:page-number {
+ (nonNegativeInteger | "auto")
+ # https://issues.oasis-open.org/browse/OFFICE-3923
+
+ }?
+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 }?
+common-presentation-header-footer-attlist =
+ attribute presentation:use-header-name { \string }?
+ & attribute presentation:use-footer-name { \string }?
+ & attribute presentation:use-date-time-name { \string }?
+common-printable-attlist = attribute form:printable { boolean }?
+common-readonly-attlist = attribute form:readonly { boolean }?
+common-ref-format-values = "page" | "chapter" | "direction" | "text"
+common-repeat = attribute form:repeat { boolean }?
+common-repeat-timing-attlist =
+ attribute smil:repeatDur { \string }?,
+ attribute smil:repeatCount { nonNegativeDecimal | "indefinite" }?
+common-restart-default-attlist =
+ attribute smil:restartDefault {
+ "never" | "always" | "whenNotActive" | "inherit"
+ }?
+common-restart-timing-attlist =
+ attribute smil:restart {
+ "never" | "always" | "whenNotActive" | "default"
+ }?
+common-rotation-angle-attlist =
+ attribute style:rotation-angle { angle }?
+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?
+common-shadow-attlist = attribute style:shadow { shadowType }?
+common-source-cell-range =
+ attribute form:source-cell-range { cellRangeAddress | \string }?
+common-spin-button = attribute form:spin-button { boolean }?
+common-spline-anim-value-attlist =
+ attribute smil:keyTimes { \string }?
+ & attribute smil:keySplines { \string }?
+common-stock-marker-attlist =
+ attribute chart:style-name { styleNameRef }?
+common-style-direction-attlist =
+ attribute style:direction { "ltr" | "ttb" }?
+common-style-header-footer-attlist =
+ attribute style:display { boolean }?
+common-svg-font-face-xlink-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?
+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 }?
+common-tab-attlist =
+ attribute form:tab-index { nonNegativeInteger }?
+ & attribute form:tab-stop { boolean }?
+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 }
+common-table-change-attlist =
+ attribute table:id { \string }
+ & attribute table:acceptance-state {
+ "accepted" | "rejected" | "pending"
+ }?
+ & attribute table:rejecting-change-id { \string }?
+common-table-range-attlist =
+ common-table-cell-address-attlist
+ | common-table-cell-range-address-attlist
+common-table-template-attlist =
+ attribute table:style-name { styleNameRef },
+ attribute table:paragraph-style-name { styleNameRef }?
+common-text-align =
+ attribute fo:text-align {
+ "start" | "end" | "left" | "right" | "center" | "justify"
+ }?
+common-text-anchor-attlist =
+ attribute text:anchor-type {
+ "page" | "frame" | "paragraph" | "char" | "as-char"
+ }?
+ & attribute text:anchor-page-number { positiveInteger }?
+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-time-manip-attlist =
+ attribute smil:accelerate { zeroToOneDecimal }?
+ & attribute smil:decelerate { zeroToOneDecimal }?
+ & attribute smil:autoReverse { boolean }?
+common-timing-attlist =
+ common-basic-timing-attlist, common-time-manip-attlist
+common-title-attlist = attribute form:title { \string }?
+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-value-attlist = attribute form:value { \string }?
+common-value-type-attlist = attribute office:value-type { valueType }
+common-vertical-margin-attlist =
+ attribute fo:margin-top { nonNegativeLength | percent }?,
+ attribute fo:margin-bottom { nonNegativeLength | percent }?
+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-writing-mode-attlist =
+ attribute style:writing-mode {
+ "lr-tb" | "rl-tb" | "tb-rl" | "tb-lr" | "lr" | "rl" | "tb" | "page"
+ }?
+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-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-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-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 }
+config-config-item-set =
+ element config:config-item-set {
+ config-config-item-set-attlist, config-items
+ }
+config-config-item-set-attlist = attribute config:name { \string }
+config-items =
+ (config-config-item
+ | config-config-item-set
+ | config-config-item-map-named
+ | config-config-item-map-indexed)+
+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
+ }
+coordinate = length
+countryCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" }
+currency-symbol-and-text =
+ number-currency-symbol,
+ number-text-with-fillchar
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ ?
+current-selected = attribute form:current-selected { boolean }?
+custom-shape-type = "non-primitive" | \string
+date = xsd:date
+dateOrDateTime = xsd:date | xsd:dateTime
+dateTime = xsd:dateTime
+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-apply-command = attribute db:apply-command { 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-character-set =
+ element db:character-set { db-character-set-attlist, empty }
+db-character-set-attlist = attribute db:encoding { textEncoding }?
+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-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-column-definitions =
+ element db:column-definitions {
+ db-column-definitions-attlist, db-column-definition+
+ }
+db-column-definitions-attlist = empty
+db-columns = element db:columns { db-columns-attlist, db-column+ }
+db-columns-attlist = empty
+db-command = attribute db:command { \string }
+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-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-connection-data =
+ element db:connection-data {
+ db-connection-data-attlist,
+ (db-database-description | db-connection-resource),
+ db-login?
+ }
+db-connection-data-attlist = empty
+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-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-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-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-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-database-description =
+ element db:database-description {
+ db-database-description-attlist,
+ (db-file-based-database | db-server-database)
+ }
+db-database-description-attlist = empty
+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-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-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-filter-statement =
+ element db:filter-statement { db-command, db-apply-command, empty }
+db-forms =
+ element db:forms {
+ db-forms-attlist, (db-component | db-component-collection)*
+ }
+db-forms-attlist = empty
+db-host-and-port =
+ attribute db:hostname { \string },
+ attribute db:port { positiveInteger }?
+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-column =
+ element db:index-column { db-index-column-attlist, empty }
+db-index-column-attlist =
+ attribute db:name { \string }
+ & attribute db:is-ascending { boolean }?
+db-index-columns = element db:index-columns { db-index-column+ }
+db-indices = element db:indices { db-indices-attlist, db-index+ }
+db-indices-attlist = empty
+db-is-first-row-header-line =
+ attribute db:is-first-row-header-line { boolean }?
+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-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-key-columns =
+ element db:key-columns { db-key-columns-attlist, db-key-column+ }
+db-key-columns-attlist = empty
+db-keys = element db:keys { db-keys-attlist, db-key+ }
+db-keys-attlist = empty
+db-local-socket-name = attribute db:local-socket { \string }?
+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-order-statement =
+ element db:order-statement { db-command, db-apply-command, empty }
+db-queries =
+ element db:queries {
+ db-queries-attlist, (db-query | db-query-collection)*
+ }
+db-queries-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-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-reports =
+ element db:reports {
+ db-reports-attlist, (db-component | db-component-collection)*
+ }
+db-reports-attlist = empty
+db-schema-definition =
+ element db:schema-definition {
+ db-schema-definition-attlist, db-table-definitions
+ }
+db-schema-definition-attlist = empty
+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-show-deleted = attribute db:show-deleted { boolean }?
+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-table-definitions =
+ element db:table-definitions {
+ db-table-definitions-attlist, db-table-definition*
+ }
+db-table-definitions-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 =
+ element db:table-filter {
+ db-table-filter-attlist,
+ db-table-include-filter?,
+ db-table-exclude-filter?
+ }
+db-table-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-include-filter =
+ element db:table-include-filter {
+ db-table-include-filter-attlist, db-table-filter-pattern+
+ }
+db-table-include-filter-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-table-presentations =
+ element db:table-representations {
+ db-table-presentations-attlist, db-table-presentation*
+ }
+db-table-presentations-attlist = empty
+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-table-settings = element db:table-settings { db-table-setting* }
+db-table-type = element db:table-type { db-table-type-attlist, \string }
+db-table-type-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-update-table =
+ element db:update-table { common-db-table-name-attlist }
+dc-creator = element dc:creator { \string }
+dc-date = element dc:date { dateTime }
+distance = length
+double = xsd:double
+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-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-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-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
+ }
+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*
+ }
+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 }?
+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 }?
+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-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-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?
+ }
+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-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-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
+ }
+draw-circle-attlist = attribute svg:r { 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-contour-path =
+ element draw:contour-path {
+ common-contour-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ empty
+ }
+draw-contour-polygon =
+ element draw:contour-polygon {
+ common-contour-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-points-attlist,
+ empty
+ }
+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-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-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-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 }?
+draw-equation = element draw:equation { draw-equation-attlist, empty }
+draw-equation-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:formula { \string }?
+draw-fill-image =
+ element draw:fill-image {
+ draw-fill-image-attlist,
+ # XLink duplicate declaration removed. see common-draw-data-attlist
+ ((common-draw-data-attlist, empty) | office-binary-data)
+ # https://issues.oasis-open.org/browse/OFFICE-3933
+
+ }
+draw-fill-image-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute svg:width { length }?
+ & attribute svg:height { length }?
+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-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)?
+ }
+draw-frame-attlist = attribute draw:copy-of { \string }?
+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 }?
+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"
+ }
+draw-gradient =
+ element draw:gradient {
+ common-draw-gradient-attlist, draw-gradient-attlist, empty
+ }
+draw-gradient-attlist =
+ attribute draw:start-color { color }?
+ & attribute draw:end-color { color }?
+ & attribute draw:start-intensity { zeroToHundredPercent }?
+ & attribute draw:end-intensity { zeroToHundredPercent }?
+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 }?
+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-image =
+ element draw:image {
+ draw-image-attlist,
+ (common-draw-data-attlist | office-binary-data),
+ draw-text
+ }
+draw-image-attlist =
+ attribute draw:filter-name { \string }?
+ & common-draw-mime-type-attlist
+ & # https://issues.oasis-open.org/browse/OFFICE-3943
+ xml-id?
+draw-image-map =
+ element draw:image-map {
+ (draw-area-rectangle | draw-area-circle | draw-area-polygon)*
+ }
+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-layer-set = element draw:layer-set { draw-layer* }
+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-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-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-object =
+ element draw:object {
+ draw-object-attlist,
+ (common-draw-data-attlist | office-document | math-math)
+ }
+draw-object-attlist =
+ attribute draw:notify-on-update-of-ranges {
+ cellRangeAddressList | \string
+ }?
+ & xml-id?
+draw-object-ole =
+ element draw:object-ole {
+ draw-object-ole-attlist,
+ (common-draw-data-attlist | office-binary-data)
+ }
+draw-object-ole-attlist =
+ attribute draw:class-id { \string }?
+ & xml-id?
+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-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 }?
+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-param = element draw:param { draw-param-attlist, empty }
+draw-param-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:value { \string }?
+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
+ }
+draw-plugin =
+ element draw:plugin {
+ draw-plugin-attlist, common-draw-data-attlist, draw-param*
+ }
+draw-plugin-attlist = common-draw-mime-type-attlist & xml-id?
+# https://issues.oasis-open.org/browse/OFFICE-3943
+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-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
+ }
+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-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-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 }?
+draw-text = (text-p | text-list)*
+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 }?)?
+dropdown = attribute form:dropdown { boolean }?
+duration = xsd:duration
+extrusionOrigin =
+ xsd:double { minInclusive = "-0.5" maxInclusive = "0.5" }
+fontFamilyGeneric =
+ "roman" | "swiss" | "modern" | "decorative" | "script" | "system"
+fontPitch = "fixed" | "variable"
+fontStyle = "normal" | "italic" | "oblique"
+fontVariant = "normal" | "small-caps"
+fontWeight =
+ "normal"
+ | "bold"
+ | "100"
+ | "200"
+ | "300"
+ | "400"
+ | "500"
+ | "600"
+ | "700"
+ | "800"
+ | "900"
+for = attribute form:for { \string }?
+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-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 }?
+form-column =
+ element form:column { form-column-attlist, column-controls+ }
+form-column-attlist =
+ common-form-control-attlist, label, text-style-name
+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-connection-resource =
+ element form:connection-resource {
+ attribute xlink:href { anyIRI },
+ empty
+ }
+form-control-attlist =
+ common-form-control-attlist,
+ common-control-id-attlist,
+ xforms-bind-attlist
+form-date-attlist =
+ attribute form:value { date }?
+ & attribute form:current-value { date }?
+ & attribute form:min-value { date }?
+ & attribute form:max-value { date }?
+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-fixed-text-attlist =
+ form-control-attlist
+ & for
+ & common-disabled-attlist
+ & label
+ & common-printable-attlist
+ & common-title-attlist
+ & attribute form:multi-line { 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 }?
+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 }?
+form-frame-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ for,
+ label,
+ common-printable-attlist,
+ common-title-attlist
+form-generic-control-attlist = form-control-attlist
+form-grid-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ common-printable-attlist,
+ common-tab-attlist,
+ common-title-attlist
+form-hidden-attlist = form-control-attlist, common-value-attlist
+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-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-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 }?
+form-number-attlist =
+ attribute form:value { double }?
+ & attribute form:current-value { double }?
+ & attribute form:min-value { double }?
+ & attribute form:max-value { double }?
+form-option = element form:option { form-option-attlist, text }
+form-option-attlist =
+ current-selected, selected, label, common-value-attlist
+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-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-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" }
+form-property-value-and-type-attlist =
+ common-value-and-type-attlist
+ | attribute office:value-type { "void" }
+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-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-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-time-attlist =
+ attribute form:value { time }?
+ & attribute form:current-value { time }?
+ & attribute form:min-value { time }?
+ & attribute form:max-value { time }?
+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" }?
+gradient-style =
+ "linear" | "axial" | "radial" | "ellipsoid" | "square" | "rectangular"
+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?)
+heading-attrs =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:restart-numbering { boolean }?
+ & attribute text:start-value { nonNegativeInteger }?
+ & attribute text:is-list-header { boolean }?
+horiBackPos = "left" | "center" | "right"
+horizontal-mirror =
+ "horizontal" | "horizontal-on-odd" | "horizontal-on-even"
+image-data = attribute form:image-data { anyIRI }?
+index-content-main = text-content | text-index-title
+integer = xsd:integer
+label = attribute form:label { \string }?
+labelPositions =
+ "avoid-overlap"
+ | "center"
+ | "top"
+ | "top-right"
+ | "right"
+ | "bottom-right"
+ | "bottom"
+ | "bottom-left"
+ | "left"
+ | "top-left"
+ | "inside"
+ | "outside"
+ | "near-origin"
+language = xsd:language
+languageCode = xsd:token { pattern = "[A-Za-z]{1,8}" }
+length =
+ xsd:string {
+ pattern =
+ "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+lineMode = "continuous" | "skip-white-space"
+lineStyle =
+ "none"
+ | "solid"
+ | "dotted"
+ | "dash"
+ | "long-dash"
+ | "dot-dash"
+ | "dot-dot-dash"
+ | "wave"
+lineType = "none" | "single" | "double"
+lineWidth =
+ "auto"
+ | "normal"
+ | "bold"
+ | "thin"
+ | "medium"
+ | "thick"
+ | positiveInteger
+ | percent
+ | positiveLength
+list-linkage-type =
+ attribute form:list-linkage-type {
+ "selection" | "selection-indices"
+ }?
+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"
+ }?
+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 })*
+meta-date-string = element meta:date-string { \string }
+namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" }
+navigation = "none" | "current" | "parent"
+nonNegativeDecimal = xsd:decimal { minInclusive = "0.0" }
+nonNegativeInteger = xsd:nonNegativeInteger
+nonNegativeLength =
+ xsd:string {
+ pattern =
+ "([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+nonNegativePixelLength =
+ xsd:string { pattern = "([0-9]+(\.[0-9]*)?|\.[0-9]+)(px)" }
+number-am-pm = element number:am-pm { empty }
+number-and-text =
+ number-number,
+ (number-text-with-fillchar?)
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+
+number-boolean = element number:boolean { empty }
+number-boolean-style =
+ element number:boolean-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (number-boolean, number-text?)?,
+ style-map*
+ }
+number-currency-style =
+ element number:currency-style {
+ common-data-style-attlist,
+ common-auto-reorder-attlist,
+ style-text-properties?,
+ number-text-with-fillchar?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ ((number-and-text, currency-symbol-and-text?)
+ | (currency-symbol-and-text, number-and-text?))?,
+ style-map*
+ }
+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-date-style =
+ element number:date-style {
+ common-data-style-attlist,
+ common-auto-reorder-attlist,
+ common-format-source-attlist,
+ style-text-properties?,
+ number-text-with-fillchar?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ (any-date,
+ (number-text-with-fillchar?)
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ )+,
+ style-map*
+ }
+number-day =
+ element number:day {
+ number-day-attlist, common-calendar-attlist, empty
+ }
+number-day-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-embedded-text =
+ element number:embedded-text { number-embedded-text-attlist, text }
+number-embedded-text-attlist = attribute number:position { integer }
+number-era =
+ element number:era {
+ number-era-attlist, common-calendar-attlist, empty
+ }
+number-era-attlist = attribute number:style { "short" | "long" }?
+number-fill-character = element number:fill-character { text }
+# https://issues.oasis-open.org/browse/OFFICE-3765
+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 }?
+ & (attribute number:max-denominator-value { positiveInteger }?)
+ # https://issues.oasis-open.org/browse/OFFICE-3695 max-denominator-value
+
+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-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-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-number-style =
+ element number:number-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text-with-fillchar?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ (any-number, number-text-with-fillchar?)?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ style-map*
+ }
+number-percentage-style =
+ element number:percentage-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text-with-fillchar?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ number-and-text?,
+ style-map*
+ }
+number-quarter =
+ element number:quarter {
+ number-quarter-attlist, common-calendar-attlist, empty
+ }
+number-quarter-attlist = attribute number:style { "short" | "long" }?
+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 }?
+ & attribute number:exponent-interval { positiveInteger }?
+ & # https://issues.oasis-open.org/browse/OFFICE-1828 exponent-interval
+ attribute number:forced-exponent-sign { boolean }
+ # https://issues.oasis-open.org/browse/OFFICE-3860 added number:forced-exponent-sign
+ ?
+number-seconds =
+ element number:seconds { number-seconds-attlist, empty }
+number-seconds-attlist =
+ attribute number:style { "short" | "long" }?
+ & attribute number:decimal-places { integer }?
+number-text = element number:text { text }
+number-text-content = element number:text-content { empty }
+number-text-style =
+ element number:text-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text-with-fillchar?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ (number-text-content,
+ (number-text-with-fillchar?)
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ )*,
+ style-map*
+ }
+number-text-with-fillchar =
+ number-text?, (number-fill-character, number-text?)?
+# https://issues.oasis-open.org/browse/OFFICE-3765
+number-time-style =
+ element number:time-style {
+ number-time-style-attlist,
+ common-data-style-attlist,
+ common-format-source-attlist,
+ style-text-properties?,
+ number-text-with-fillchar?,
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ (any-time,
+ (number-text-with-fillchar?)
+ # https://issues.oasis-open.org/browse/OFFICE-3765
+ )+,
+ style-map*
+ }
+number-time-style-attlist =
+ attribute number:truncate-on-overflow { boolean }?
+number-week-of-year =
+ element number:week-of-year { common-calendar-attlist, empty }
+number-year =
+ element number:year {
+ number-year-attlist, common-calendar-attlist, empty
+ }
+number-year-attlist = attribute number:style { "short" | "long" }?
+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?,
+ element meta:creator-initials { text }?,
+ # https://issues.oasis-open.org/browse/OFFICE-3776
+ (text-p | text-list)*
+ }
+office-annotation-attlist =
+ attribute office:display { boolean }?
+ & common-office-annotation-name-attlist?
+office-annotation-end =
+ element office:annotation-end { office-annotation-end-attlist }
+office-annotation-end-attlist = common-office-annotation-name-attlist
+office-automatic-styles =
+ element office:automatic-styles { styles & style-page-layout* }?
+office-binary-data = element office:binary-data { base64Binary }
office-body = element office:body { office-body-content }
office-body-content =
element office:text {
@@ -149,153 +2742,102 @@ office-body-content =
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-change-info =
+ element office:change-info { dc-creator, dc-date, text-p* }
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
+office-chart-content-main = chart-chart
+office-chart-content-prelude = text-decls, table-decls
+office-database =
+ element office:database {
+ db-data-source,
+ db-forms?,
+ db-reports?,
+ db-queries?,
+ db-table-presentations?,
+ db-schema-definition?
}
-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+
+office-dde-source =
+ element office:dde-source {
+ office-dde-source-attlist, common-dde-connection-decl-attlist
}
-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
+office-dde-source-attlist =
+ attribute office:name { \string }?
+ & attribute office:conversion-mode {
+ "into-default-style-data-style"
+ | "into-english-number"
+ | "keep-text"
+ }?
+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
}
-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+
+office-document-attrs = attribute office:mimetype { \string }
+office-document-common-attrs =
+ attribute office:version { "1.3" }
+ & attribute grddl:transformation {
+ list { anyIRI* }
+ }?
+office-document-content =
+ element office:document-content {
+ office-document-common-attrs,
+ office-scripts,
+ office-font-face-decls,
+ office-automatic-styles,
+ office-body
}
-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-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-styles =
+ element office:document-styles {
+ office-document-common-attrs,
+ office-font-face-decls,
+ office-styles,
+ office-automatic-styles,
+ office-master-styles
+ }
+office-drawing-attlist = empty
+office-drawing-content-epilogue = table-functions
+office-drawing-content-main = draw-page*
+office-drawing-content-prelude = text-decls, table-decls
+office-event-listeners =
+ element office:event-listeners {
+ (script-event-listener | presentation-event-listener)*
}
-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-forms =
+ element office:forms {
+ office-forms-attlist, (form-form | xforms-model)*
}?
-office-automatic-styles =
- element office:automatic-styles { styles & style-page-layout* }?
+office-forms-attlist =
+ attribute form:automatic-focus { boolean }?
+ & attribute form:apply-design-mode { boolean }?
+office-image-attlist = empty
+office-image-content-epilogue = empty
+office-image-content-main = draw-frame
+office-image-content-prelude = empty
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 = element office:meta { office-meta-content-strict }?
+office-meta-content-strict = office-meta-data*
office-meta-data =
element meta:generator { \string }
| element dc:title { \string }
@@ -362,23 +2904,66 @@ office-meta-data =
\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*
+office-presentation-attlist = empty
+office-presentation-content-epilogue =
+ presentation-settings, table-functions
+office-presentation-content-main = draw-page*
+office-presentation-content-prelude =
+ text-decls, table-decls, presentation-decls
+# removed from text as well
+# <rng:define name="office-process-content">
+# <rng:optional>
+# <rng:attribute name="office:process-content">
+# <rng:ref name="boolean"/>
+# </rng:attribute>
+# </rng:optional>
+# </rng:define>
+office-script =
+ element office:script {
+ office-script-attlist,
+ mixed { anyElements }
}
-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* }
+office-script-attlist = attribute script:language { \string }
+office-scripts =
+ element office:scripts { office-script*, office-event-listeners? }?
+office-settings = element office:settings { config-config-item-set+ }?
+office-spreadsheet-attlist =
+ attribute table:structure-protected { boolean }?,
+ attribute table:protection-key { \string }?,
+ attribute table:protection-key-digest-algorithm { anyIRI }?
+office-spreadsheet-content-epilogue = table-functions
+office-spreadsheet-content-main = table-table*
+office-spreadsheet-content-prelude =
+ table-tracked-changes?, text-decls, table-decls
+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-text-attlist =
+ attribute text:global { boolean }?
+ & attribute text:use-soft-page-breaks { boolean }?
+office-text-content-epilogue = table-functions
+office-text-content-main =
+ text-content*
+ | (text-page-sequence, (shape)*)
+office-text-content-prelude =
+ office-forms, text-tracked-changes, text-decls, table-decls
paragraph-attrs =
attribute text:style-name { styleNameRef }?
& attribute text:class-names { styleNameRefs }?
@@ -386,99 +2971,6 @@ paragraph-attrs =
& (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 {
@@ -605,7 +3097,9 @@ paragraph-content =
text
}
| element text:text-input { common-field-description-attlist, text }
- | element text:initial-creator { common-field-fixed-attlist, text }
+ | text-drop-down
+ | # OFFICE-3881
+ element text:initial-creator { common-field-fixed-attlist, text }
| element text:creation-date {
(common-field-fixed-attlist
& common-field-data-style-name-attlist
@@ -801,2062 +3295,37 @@ paragraph-content =
| 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 =
+paragraph-content-or-hyperlink = paragraph-content | text-a
+pathData = xsd:string
+percent = xsd:string { pattern = "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)%" }
+point3D =
xsd:string {
- pattern = "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+"
+ pattern =
+ "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))){2}[ ]*\)"
}
-cellRangeAddress =
+points =
+ xsd:string { pattern = "-?[0-9]+,-?[0-9]+([ ]+-?[0-9]+,-?[0-9]+)*" }
+positiveInteger = xsd:positiveInteger
+positiveLength =
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?
+ "([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))"
}
-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*
+presentation-animation-elements =
+ presentation-show-shape
+ | presentation-show-text
+ | presentation-hide-shape
+ | presentation-hide-text
+ | presentation-dim
+ | presentation-play
+presentation-animation-group =
+ element presentation:animation-group {
+ presentation-animation-elements*
}
-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}[ ]*\)"
+presentation-animations =
+ element presentation:animations {
+ (presentation-animation-elements | presentation-animation-group)*
}
-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"
@@ -2874,101 +3343,21 @@ presentation-classes =
| "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-date-time-decl-attlist =
+ attribute presentation:name { \string }
+ & attribute presentation:source { "fixed" | "current-date" }
+ & attribute style:data-style-name { styleNameRef }?
+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-decls = presentation-decl*
presentation-dim =
element presentation:dim {
presentation-dim-attlist, presentation-sound?
@@ -2976,40 +3365,6 @@ presentation-dim =
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?
@@ -3040,25 +3395,42 @@ presentation-event-listener-attlist =
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 =
+presentation-header-decl-attlist =
attribute presentation:name { \string }
- & attribute presentation:source { "fixed" | "current-date" }
- & attribute style:data-style-name { styleNameRef }?
+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-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 }?
+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
+ }
+presentation-play =
+ element presentation:play { presentation-play-attlist, empty }
+presentation-play-attlist =
+ attribute draw:shape-id { IDREF },
+ attribute presentation:speed { presentationSpeeds }?
presentation-settings =
element presentation:settings {
presentation-settings-attlist, presentation-show*
@@ -3080,1066 +3452,86 @@ presentation-settings-attlist =
}?
& attribute presentation:stay-on-top { boolean }?
& attribute presentation:show-end-of-presentation-slide { boolean }?
+presentation-shape-attlist =
+ attribute presentation:class { presentation-classes }?
+ & attribute presentation:placeholder { boolean }?
+ & attribute presentation:user-transformed { 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
+presentation-show-shape =
+ element presentation:show-shape {
+ common-presentation-effect-attlist, presentation-sound?
}
-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?
+presentation-show-text =
+ element presentation:show-text {
+ common-presentation-effect-attlist, presentation-sound?
}
-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 {
+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
}
-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)*
- }
+presentation-sound-attlist =
+ attribute presentation:play-full { boolean }?
+ & xml-id?
+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"
+presentationEffects =
+ "none"
+ | "fade"
+ | "move"
+ | "stripes"
+ | "open"
+ | "close"
+ | "dissolve"
+ | "wavyline"
+ | "random"
+ | "lines"
+ | "laser"
+ | "appear"
+ | "hide"
+ | "move-short"
+ | "checkerboard"
+ | "rotate"
+ | "stretch"
+presentationSpeeds = "slow" | "medium" | "fast"
+region-content = text-p*
+relativeLength = xsd:string { pattern = "[0-9]+\*" }
+rowOrCol = "row" | "column"
script-event-listener =
element script:event-listener { script-event-listener-attlist, empty }
script-event-listener-attlist =
@@ -4149,379 +3541,336 @@ script-event-listener-attlist =
| (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
+scriptCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" }
+selected = attribute form:selected { boolean }?
+shadowType = "none" | \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
+shapes3d =
+ dr3d-scene | dr3d-extrude | dr3d-sphere | dr3d-rotate | dr3d-cube
+signedZeroToHundredPercent =
+ xsd:string {
+ pattern = "-?([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
}
-office-dde-source-attlist =
- attribute office:name { \string }?
- & attribute office:conversion-mode {
- "into-default-style-data-style"
- | "into-english-number"
- | "keep-text"
+size = attribute form:size { nonNegativeInteger }?
+states = "unchecked" | "checked" | "unknown"
+\string = xsd:string
+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 }
}?
-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
+ & attribute style:filter-name { \string }?
+ & attribute draw:opacity { zeroToHundredPercent }?
+style-chart-properties =
+ element style:chart-properties {
+ style-chart-properties-content-strict
}
- | 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"
+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"
+ | "step-start"
+ | "step-end"
+ | "step-center-x"
+ | "step-center-y"
}?
-anim-animate-color-attlist =
- attribute anim:color-interpolation { "rgb" | "hsl" }?
- & attribute anim:color-interpolation-direction {
- "clockwise" | "counter-clockwise"
+ & 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"
}?
-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"
+ & 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"
+ | "moving-average"
+ | "exponential"
+ | "power"
+ | "polynomial"
+ }?
+ & attribute chart:regression-max-degree { positiveInteger }?
+ & attribute chart:regression-force-intercept { boolean }?
+ & attribute chart:regression-intercept-value { double }?
+ & attribute chart:regression-name { \string }?
+ & # https://issues.oasis-open.org/browse/OFFICE-3958
+ attribute chart:regression-period { positiveInteger }?
+ & attribute chart:regression-moving-type {
+ "prior" | "central" | "averaged-abscissa"
+ }?
+ & # https://issues.oasis-open.org/browse/OFFICE-3959
+ 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 }?
+ & (attribute chart:data-label-series { boolean }?)
+ # https://issues.oasis-open.org/browse/OFFICE-2117
+
+style-chart-properties-content-strict =
+ style-chart-properties-attlist, style-chart-properties-elements
+style-chart-properties-elements = empty
+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"
}?
-common-restart-default-attlist =
- attribute smil:restartDefault {
- "never" | "always" | "whenNotActive" | "inherit"
+ & attribute style:width { length }
+ & attribute style:height { zeroToHundredPercent }?
+ & attribute style:vertical-align { "top" | "middle" | "bottom" }?
+ & attribute style:color { color }?
+style-columns =
+ element style:columns {
+ style-columns-attlist, style-column-sep?, style-column*
}?
-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-columns-attlist =
+ attribute fo:column-count { positiveInteger }
+ & attribute fo:column-gap { length }?
+style-default-page-layout =
+ element style:default-page-layout { style-page-layout-content }
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-drawing-page-properties =
+ element style:drawing-page-properties {
+ style-drawing-page-properties-content-strict
}
-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-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"
}?
-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 }
+ & 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-content-strict =
+ style-graphic-fill-properties-attlist,
+ style-drawing-page-properties-attlist,
+ style-drawing-page-properties-elements
+style-drawing-page-properties-elements = presentation-sound?
+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 }?
style-font-face =
element style:font-face {
style-font-face-attlist, svg-font-face-src?, svg-definition-src?
@@ -4575,606 +3924,23 @@ style-font-face-attlist =
& 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*
+style-footer =
+ element style:footer {
+ common-style-header-footer-attlist, header-footer-content
}
-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-footer-first =
+ element style:footer-first {
+ common-style-header-footer-attlist,
+ header-footer-content
+ # https://issues.oasis-open.org/browse/OFFICE-3789
+
}
-style-page-layout-properties =
- element style:page-layout-properties {
- style-page-layout-properties-content-strict
+style-footer-left =
+ element style:footer-left {
+ common-style-header-footer-attlist, header-footer-content
}
-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-footer-style =
+ element style:footer-style { style-header-footer-properties? }
style-footnote-sep =
element style:footnote-sep { style-footnote-sep-attlist, empty }?
style-footnote-sep-attlist =
@@ -5185,490 +3951,43 @@ style-footnote-sep-attlist =
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-graphic-fill-properties-attlist =
+ attribute draw:fill {
+ "none" | "solid" | "bitmap" | "gradient" | "hatch"
}?
-style-background-image-attlist =
- attribute style:repeat { "no-repeat" | "repeat" | "stretch" }?
- & attribute style:position {
- "left"
- | "center"
- | "right"
+ & 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"
- | "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"
+ | "top-right"
+ | "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"
+ | "bottom-left"
+ | "bottom"
+ | "bottom-right"
}?
- & attribute style:cell-protect {
- "none"
- | "hidden-and-protected"
- | list { ("protected" | "formula-hidden")+ }
+ & attribute draw:tile-repeat-offset {
+ list { zeroToHundredPercent, ("horizontal" | "vertical") }
}?
- & 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
+ & attribute draw:opacity { zeroToHundredPercent }?
+ & attribute draw:opacity-name { styleNameRef }?
+ & attribute svg:fill-rule { "nonzero" | "evenodd" }?
+style-graphic-properties =
+ element style:graphic-properties {
+ style-graphic-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 }?
@@ -5717,7 +4036,9 @@ style-graphic-properties-attlist =
"greyscale" | "mono" | "watermark" | "standard"
}?
& attribute draw:color-inversion { boolean }?
- & attribute draw:luminance { zeroToHundredPercent }?
+ & attribute draw:luminance { signedZeroToHundredPercent }
+ # https://issues.oasis-open.org/browse/OFFICE-3821
+ ?
& attribute draw:contrast { percent }?
& attribute draw:gamma { percent }?
& attribute draw:red { signedZeroToHundredPercent }?
@@ -5892,363 +4213,2182 @@ style-graphic-properties-attlist =
"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-content-strict =
+ style-graphic-properties-attlist,
+ style-graphic-fill-properties-attlist,
+ style-graphic-properties-elements
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"
+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 }?
+style-header =
+ element style:header {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-header-first =
+ element style:header-first {
+ common-style-header-footer-attlist,
+ header-footer-content
+ # https://issues.oasis-open.org/browse/OFFICE-3789
+
+ }
+style-header-footer-properties =
+ element style:header-footer-properties {
+ style-header-footer-properties-content-strict
+ }
+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-content-strict =
+ style-header-footer-properties-attlist,
+ style-header-footer-properties-elements
+style-header-footer-properties-elements = style-background-image
+style-header-left =
+ element style:header-left {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-header-style =
+ element style:header-style { style-header-footer-properties? }
+style-list-level-label-alignment =
+ element style:list-level-label-alignment {
+ style-list-level-label-alignment-attlist, empty
}?
-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}[ ]*\)"
+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-list-level-properties =
+ element style:list-level-properties {
+ style-list-level-properties-content-strict
}
-nonNegativePixelLength =
- xsd:string { pattern = "([0-9]+(\.[0-9]*)?|\.[0-9]+)(px)" }
-style-chart-properties =
- element style:chart-properties {
- style-chart-properties-content-strict
+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-content-strict =
+ style-list-level-properties-attlist,
+ style-list-level-properties-elements
+style-list-level-properties-elements = style-list-level-label-alignment
+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-master-page =
+ element style:master-page {
+ style-master-page-attlist,
+ (style-header,
+ style-header-left?,
+ (style-header-first?)
+ # https://issues.oasis-open.org/browse/OFFICE-3789
+ )?,
+ (style-footer,
+ style-footer-left?,
+ (style-footer-first?)
+ # https://issues.oasis-open.org/browse/OFFICE-3789
+ )?,
+ draw-layer-set?,
+ office-forms?,
+ shape*,
+ animation-element?,
+ presentation-notes?
}
-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"
+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-num-letter-sync-attlist =
+ attribute style:num-letter-sync { boolean }?
+style-page-layout =
+ element style:page-layout {
+ style-page-layout-attlist, style-page-layout-content
+ }
+style-page-layout-attlist =
+ attribute style:name { styleName }
+ & attribute style:page-usage {
+ "all" | "left" | "right" | "mirrored"
}?
- & 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"
+style-page-layout-content =
+ style-page-layout-properties?,
+ style-header-style?,
+ style-footer-style?
+style-page-layout-properties =
+ element style:page-layout-properties {
+ style-page-layout-properties-content-strict
+ }
+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 chart:stacked { boolean }?
- & attribute chart:percentage { boolean }?
- & attribute chart:treat-empty-cells {
- "use-zero" | "leave-gap" | "ignore"
+ & 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:scale-to-X { positiveInteger }?,
+ attribute style:scale-to-Y { positiveInteger }?))
+ & # https://issues.oasis-open.org/browse/OFFICE-3857
+ attribute style:table-centering {
+ "horizontal" | "vertical" | "both" | "none"
}?
- & 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"
+ & 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-content-strict =
+ style-page-layout-properties-attlist,
+ style-page-layout-properties-elements
+style-page-layout-properties-elements =
+ style-background-image & style-columns & style-footnote-sep
+style-paragraph-properties =
+ element style:paragraph-properties {
+ style-paragraph-properties-content-strict
+ }
+style-paragraph-properties-attlist =
+ attribute style:contextual-spacing { boolean }?
+ & # https://issues.oasis-open.org/browse/OFFICE-3767
+ 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
+style-paragraph-properties-content-strict =
+ style-paragraph-properties-attlist,
+ style-paragraph-properties-elements
+style-paragraph-properties-elements =
+ style-tab-stops & style-drop-cap & style-background-image
+style-presentation-page-layout =
+ element style:presentation-page-layout {
+ attribute style:name { styleName },
+ attribute style:display-name { \string }?,
+ presentation-placeholder*
+ }
+style-region-center = element style:region-center { region-content }
+style-region-left = element style:region-left { region-content }
+style-region-right = element style:region-right { region-content }
+style-ruby-properties =
+ element style:ruby-properties { style-ruby-properties-content-strict }
+style-ruby-properties-attlist =
+ attribute style:ruby-position { "above" | "below" }?
+ & attribute style:ruby-align {
+ "left"
+ | "center"
+ | "right"
+ | "distribute-letter"
+ | "distribute-space"
+ }?
+style-ruby-properties-content-strict =
+ style-ruby-properties-attlist, style-ruby-properties-elements
+style-ruby-properties-elements = empty
+style-section-properties =
+ element style:section-properties {
+ style-section-properties-content-strict
+ }
+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-content-strict =
+ style-section-properties-attlist, style-section-properties-elements
+style-section-properties-elements =
+ style-background-image & style-columns & text-notes-configuration*
+style-style =
+ element style:style {
+ style-style-attlist, style-style-content, style-map*
+ }
+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-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?)
+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-tab-stops = element style:tab-stops { style-tab-stop* }?
+style-table-cell-properties =
+ element style:table-cell-properties {
+ style-table-cell-properties-content-strict
+ }
+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 chart:data-label-number {
- "none" | "value" | "percentage" | "value-and-percentage"
+ & attribute style:rotation-align {
+ "none" | "bottom" | "top" | "center"
}?
- & 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 {
+ & attribute style:cell-protect {
"none"
- | "variance"
- | "standard-deviation"
- | "percentage"
- | "error-margin"
- | "constant"
- | "standard-error"
- | "cell-range"
+ | "hidden-and-protected"
+ | list { ("protected" | "formula-hidden")+ }
}?
- & 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 style:print-content { boolean }?
+ & attribute style:decimal-places { nonNegativeInteger }?
+ & attribute style:repeat-content { boolean }?
+ & attribute style:shrink-to-fit { boolean }?
+style-table-cell-properties-content-strict =
+ style-table-cell-properties-attlist,
+ style-table-cell-properties-elements
+style-table-cell-properties-elements = style-background-image
+style-table-column-properties =
+ element style:table-column-properties {
+ style-table-column-properties-content-strict
+ }
+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-column-properties-content-strict =
+ style-table-column-properties-attlist,
+ style-table-column-properties-elements
+style-table-column-properties-elements = empty
+style-table-properties =
+ element style:table-properties {
+ style-table-properties-content-strict
+ }
+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 }?
+ & (attribute table:tab-color { color }?)
+ # https://issues.oasis-open.org/browse/OFFICE-2173
+
+style-table-properties-content-strict =
+ style-table-properties-attlist, style-table-properties-elements
+style-table-properties-elements = style-background-image
+style-table-row-properties =
+ element style:table-row-properties {
+ style-table-row-properties-content-strict
+ }
+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-content-strict =
+ style-table-row-properties-attlist,
+ style-table-row-properties-elements
+style-table-row-properties-elements = style-background-image
+style-text-properties =
+ element style:text-properties { style-text-properties-content-strict }
+style-text-properties-attlist =
+ attribute fo:font-variant { fontVariant }?
+ & attribute fo:text-transform {
+ "none" | "lowercase" | "uppercase" | "capitalize"
}?
- & attribute chart:axis-position { "start" | "end" | double }?
- & attribute chart:axis-label-position {
- "near-axis"
- | "near-axis-other-side"
- | "outside-start"
- | "outside-end"
+ & 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 chart:tick-mark-position {
- "at-labels" | "at-axis" | "at-labels-and-axis"
+ & 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 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 {
+ & 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"
- | "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"
+ | list {
+ ("none" | "accent" | "dot" | "circle" | "disc"),
+ ("above" | "below")
+ }
}?
- & 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))"
+ & 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)
+style-text-properties-content-strict =
+ style-text-properties-attlist, style-text-properties-elements
+style-text-properties-elements = empty
+styleName = xsd:NCName
+styleNameRef = xsd:NCName | empty
+styleNameRefs = list { xsd:NCName* }
+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*
+svg-definition-src =
+ element svg:definition-src {
+ common-svg-font-face-xlink-attlist, empty
}
-nonNegativeLength =
- xsd:string {
- pattern =
- "([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+svg-desc = element svg:desc { text }
+svg-font-face-format =
+ element svg:font-face-format {
+ attribute svg:string { \string }?,
+ empty
}
-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))"
+svg-font-face-name =
+ element svg:font-face-name {
+ attribute svg:name { \string }?,
+ empty
}
-percent = xsd:string { pattern = "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)%" }
-zeroToHundredPercent =
- xsd:string {
- pattern = "([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+svg-font-face-src =
+ element svg:font-face-src {
+ (svg-font-face-uri | svg-font-face-name)+
}
-signedZeroToHundredPercent =
- xsd:string {
- pattern = "-?([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+svg-font-face-uri =
+ element svg:font-face-uri {
+ common-svg-font-face-xlink-attlist, svg-font-face-format*
}
-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"
+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*
}
-URIorSafeCURIE = anyURI | SafeCURIE
-styleName = xsd:NCName
-styleNameRef = xsd:NCName | empty
-styleNameRefs = list { xsd:NCName* }
-variableName = xsd:string
+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 }?
+ }
+svg-title = element svg:title { text }
+tab-cycles = "records" | "current" | "page"
+table-background =
+ element table:background { table-background-attlist, empty }
+table-background-attlist = attribute table:style-name { styleNameRef }
+table-body = element table:body { common-table-template-attlist, empty }
+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-calculation-settings =
+ element table:calculation-settings {
+ table-calculation-setting-attlist,
+ table-null-date?,
+ table-iteration?
+ }
+table-cell-address =
+ element table:cell-address {
+ common-table-cell-address-attlist, empty
+ }
+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-content-deletion =
+ element table:cell-content-deletion {
+ attribute table:id { \string }?,
+ table-cell-address?,
+ table-change-track-table-cell?
+ }
+table-cell-range-source =
+ element table:cell-range-source {
+ table-table-cell-range-source-attlist,
+ table-linked-source-attlist,
+ empty
+ }
+table-change-deletion =
+ element table:change-deletion {
+ attribute table:id { \string }?,
+ empty
+ }
+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-columns = table-table-columns | table-table-column+
+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-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-content-validation =
+ element table:content-validation {
+ table-validation-attlist,
+ table-help-message?,
+ (table-error-message | (table-error-macro, office-event-listeners))?
+ }
+table-content-validations =
+ element table:content-validations { table-content-validation+ }
+table-covered-table-cell =
+ element table:covered-table-cell {
+ table-table-cell-attlist, table-table-cell-content
+ }
+table-cut-offs =
+ element table:cut-offs {
+ table-movement-cut-off+
+ | (table-insertion-cut-off, table-movement-cut-off*)
+ }
+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-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-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-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-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"
+ }?
+# https://issues.oasis-open.org/browse/OFFICE-2118
+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-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-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-members =
+ element table:data-pilot-members { table-data-pilot-member* }
+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-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-subtotals =
+ element table:data-pilot-subtotals { table-data-pilot-subtotal* }
+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-data-pilot-tables =
+ element table:data-pilot-tables { table-data-pilot-table* }
+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-ranges =
+ element table:database-ranges { table-database-range* }
+table-database-source-query =
+ element table:database-source-table {
+ table-database-source-table-attlist, empty
+ }
+table-database-source-query-attlist =
+ attribute table:database-name { \string }
+ & attribute table:query-name { \string }
+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-table =
+ element table:database-source-query {
+ table-database-source-query-attlist, empty
+ }
+table-database-source-table-attlist =
+ attribute table:database-name { \string }
+ & attribute table:database-table-name { \string }
+table-dde-link =
+ element table:dde-link { office-dde-source, table-table }
+table-dde-links = element table:dde-links { table-dde-link+ }
+table-decls =
+ table-calculation-settings?,
+ table-content-validations?,
+ table-label-ranges?
+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-deletions =
+ element table:deletions {
+ (table-cell-content-deletion | table-change-deletion)+
+ }
+table-dependencies = element table:dependencies { table-dependency+ }
+table-dependency =
+ element table:dependency {
+ attribute table:id { \string },
+ empty
+ }
+table-desc = element table:desc { text }
+table-detective =
+ element table:detective { table-highlighted-range*, table-operation* }
+table-error-macro =
+ element table:error-macro {
+ attribute table:execute { boolean }?
+ }
+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-even-columns =
+ element table:even-columns { common-table-template-attlist, empty }
+table-even-rows =
+ element table:even-rows { common-table-template-attlist, empty }
+table-filter =
+ element table:filter {
+ table-filter-attlist,
+ (table-filter-condition | table-filter-and | table-filter-or)
+ }
+table-filter-and =
+ element table:filter-and {
+ (table-filter-or | table-filter-condition)+
+ }
+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-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-or =
+ element table:filter-or {
+ (table-filter-and | table-filter-condition)+
+ }
+table-filter-set-item =
+ element table:filter-set-item {
+ attribute table:value { \string },
+ empty
+ }
+table-first-column =
+ element table:first-column { common-table-template-attlist, empty }
+table-first-row =
+ element table:first-row { common-table-template-attlist, empty }
+table-functions =
+ table-named-expressions?,
+ table-database-ranges?,
+ table-data-pilot-tables?,
+ table-consolidation?,
+ table-dde-links?
+table-help-message =
+ element table:help-message {
+ attribute table:title { \string }?,
+ attribute table:display { boolean }?,
+ text-p*
+ }
+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 }
+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-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-iteration =
+ element table:iteration {
+ attribute table:status { "enable" | "disable" }?,
+ attribute table:steps { positiveInteger }?,
+ attribute table:maximum-difference { double }?,
+ empty
+ }
+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-label-ranges = element table:label-ranges { table-label-range* }
+table-last-column =
+ element table:last-column { common-table-template-attlist, empty }
+table-last-row =
+ element table:last-row { common-table-template-attlist, empty }
+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-movement =
+ element table:movement {
+ common-table-change-attlist,
+ table-source-range-address,
+ table-target-range-address,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?
+ }
+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-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-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-null-date =
+ element table:null-date {
+ attribute table:value-type { "date" }?,
+ attribute table:date-value { date }?,
+ empty
+ }
+table-odd-columns =
+ element table:odd-columns { common-table-template-attlist, empty }
+table-odd-rows =
+ element table:odd-rows { common-table-template-attlist, empty }
+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-previous =
+ element table:previous {
+ attribute table:id { \string }?,
+ table-change-track-table-cell
+ }
+table-rows =
+ table-table-rows | (text-soft-page-break?, table-table-row)+
+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-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-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-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-source-cell-range =
+ element table:source-cell-range {
+ table-source-cell-range-attlist, table-filter?
+ }
+table-source-cell-range-attlist =
+ # OFFICE-3665
+ (attribute table:cell-range-address { cellRangeAddress }
+ | (attribute table:name { \string },
+ attribute table:cell-range-address { cellRangeAddress }?))
+table-source-range-address =
+ element table:source-range-address {
+ common-table-range-attlist, empty
+ }
+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-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-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-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-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-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-table-cell =
+ element table:table-cell {
+ table-table-cell-attlist,
+ table-table-cell-attlist-extra,
+ table-table-cell-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-cell-content =
+ table-cell-range-source?,
+ office-annotation?,
+ table-detective?,
+ text-content*
+table-table-cell-range-source-attlist =
+ attribute table:name { \string }
+ & attribute table:last-column-spanned { positiveInteger }
+ & attribute table:last-row-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-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-columns =
+ element table:table-columns { table-table-column+ }
+table-table-header-columns =
+ element table:table-header-columns { table-table-column+ }
+table-table-header-rows =
+ element table:table-header-rows {
+ (text-soft-page-break?, table-table-row)+
+ }
+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-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 }?
+table-table-rows =
+ element table:table-rows { (text-soft-page-break?, table-table-row)+ }
+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-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 }
+table-target-range-address =
+ element table:target-range-address {
+ common-table-range-attlist, empty
+ }
+table-title = element table:title { text }
+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-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-visibility-value = "visible" | "collapse" | "filter"
+target-frame = attribute office:target-frame { targetFrameName }?
+target-location = attribute xlink:href { anyIRI }?
targetFrameName = "_self" | "_blank" | "_parent" | "_top" | \string
+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-alphabetical-index =
+ element text:alphabetical-index {
+ common-section-attlist,
+ text-alphabetical-index-source,
+ text-index-body
+ }
+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-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-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-bibliography =
+ element text:bibliography {
+ common-section-attlist, text-bibliography-source, text-index-body
+ }
+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-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-bibliography-source =
+ element text:bibliography-source {
+ text-index-title-template?, text-bibliography-entry-template*
+ }
+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-bookmark = element text:bookmark { text-bookmark-attlist, empty }
+text-bookmark-attlist =
+ attribute text:name { \string }
+ & xml-id?
+text-bookmark-end =
+ element text:bookmark-end { text-bookmark-end-attlist, empty }
+text-bookmark-end-attlist = attribute text:name { \string }
+text-bookmark-ref-content =
+ attribute text:reference-format {
+ common-ref-format-values
+ | "number-no-superior"
+ | "number-all-superior"
+ | "number"
+ }?
+text-bookmark-start =
+ element text:bookmark-start { text-bookmark-start-attlist, empty }
+text-bookmark-start-attlist =
+ attribute text:name { \string }
+ & xml-id?
+ & common-in-content-meta-attlist?
+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 }
+text-chapter-attlist =
+ attribute text:display {
+ "name"
+ | "number"
+ | "number-and-name"
+ | "plain-number-and-name"
+ | "plain-number"
+ }
+ & attribute text:outline-level { nonNegativeInteger }
+text-common-ref-content =
+ text
+ & attribute text:ref-name { \string }?
+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-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
+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-date-attlist =
+ (common-field-fixed-attlist & common-field-data-style-name-attlist)
+ & attribute text:date-value { dateOrDateTime }?
+ & attribute text:date-adjust { duration }?
+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 }
+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?
+text-drop-down =
+ element text:drop-down {
+ attribute text:name { \string },
+ element text:label {
+ attribute text:value { \string }?,
+ attribute text:current-selected { boolean }?
+ }*,
+ text
+ }
+text-file-name-attlist =
+ attribute text:display {
+ "full" | "path" | "name" | "name-and-extension"
+ }?
+ & common-field-fixed-attlist
+text-get-page-variable-attlist = common-field-num-format-attlist
+text-h =
+ element text:h {
+ heading-attrs,
+ paragraph-attrs,
+ text-number?,
+ paragraph-content-or-hyperlink*
+ }
+text-hidden-paragraph-attlist =
+ attribute text:condition { \string }
+ & attribute text:is-hidden { boolean }?
+text-hidden-text-attlist =
+ attribute text:condition { \string }
+ & attribute text:string-value { \string }
+ & attribute text:is-hidden { boolean }?
+text-id = attribute text:id { \string }
+text-illustration-index =
+ element text:illustration-index {
+ common-section-attlist,
+ text-illustration-index-source,
+ text-index-body
+ }
+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-index-entry-link-start
+ | text-index-entry-link-end
+ # https://issues.oasis-open.org/browse/OFFICE-3941
+ )*
+text-illustration-index-entry-template =
+ element text:illustration-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-illustration-index-entry-template-attrs =
+ attribute text:style-name { styleNameRef }
+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-body = element text:index-body { index-content-main* }
+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-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-link-end =
+ element text:index-entry-link-end {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-link-start =
+ element text:index-entry-link-start {
+ 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-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-text =
+ element text:index-entry-text {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-name = attribute text:index-name { \string }
+text-index-scope-attr =
+ attribute text:index-scope { "document" | "chapter" }?
+text-index-source-style =
+ element text:index-source-style {
+ attribute text:style-name { styleNameRef },
+ empty
+ }
+# https://issues.oasis-open.org/browse/OFFICE-3675
+text-index-source-styles =
+ element text:index-source-styles {
+ attribute text:outline-level { positiveInteger },
+ text-index-source-style*
+ }
+text-index-title =
+ element text:index-title {
+ common-section-attlist, index-content-main*
+ }
+text-index-title-template =
+ element text:index-title-template {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+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-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-header =
+ element text:list-header {
+ text-list-header-attr, text-list-item-content
+ }
+text-list-header-attr = xml-id?
+text-list-item =
+ element text:list-item { text-list-item-attr, text-list-item-content }
+text-list-item-attr =
+ attribute text:start-value { nonNegativeInteger }?
+ & attribute text:style-override { styleNameRef }?
+ & xml-id?
+text-list-item-content =
+ text-number?, (text-p | text-h | text-list | text-soft-page-break)*
+text-list-level-style-attr = attribute text:level { 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-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-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-meta-attlist = common-in-content-meta-attlist? & xml-id?
+text-meta-field-attlist = xml-id & common-field-data-style-name-attlist
+text-note-class = attribute text:note-class { "footnote" | "endnote" }
+text-note-ref-content =
+ attribute text:reference-format { common-ref-format-values }?
+ & text-note-class
+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-number = element text:number { \string }
+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-object-index =
+ element text:object-index {
+ common-section-attlist, text-object-index-source, text-index-body
+ }
+text-object-index-entry-template =
+ element text:object-index-entry-template {
+ text-illustration-index-entry-content
+ }
+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-outline-level = attribute text:outline-level { positiveInteger }?
+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 }?
+text-outline-style =
+ element text:outline-style {
+ text-outline-style-attr, text-outline-level-style+
+ }
+text-outline-style-attr = attribute style:name { styleName }
+text-p =
+ element text:p { paragraph-attrs, paragraph-content-or-hyperlink* }
+text-page = element text:page { text-page-attlist, empty }
+text-page-attlist = attribute text:master-page-name { styleNameRef }
+text-page-continuation-attlist =
+ attribute text:select-page { "previous" | "next" }
+ & attribute text:string-value { \string }?
+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-sequence = element text:page-sequence { text-page+ }
+text-placeholder-attlist =
+ attribute text:placeholder-type {
+ "text" | "table" | "text-box" | "image" | "object"
+ }
+ & common-field-description-attlist
+text-relative-tab-stop-position-attr =
+ attribute text:relative-tab-stop-position { boolean }?
+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)
+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-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-content =
+ attribute text:reference-format {
+ common-ref-format-values
+ | "category-and-value"
+ | "caption"
+ | "value"
+ }?
+text-sequence-ref-name = attribute text:ref-name { \string }?
+text-set-page-variable-attlist =
+ attribute text:active { boolean }?
+ & attribute text:page-adjust { integer }?
+text-soft-page-break = element text:soft-page-break { empty }
+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-style-name = attribute form:text-style-name { styleNameRef }?
+text-tab-attr = attribute text:tab-ref { nonNegativeInteger }?
+text-table-index =
+ element text:table-index {
+ common-section-attlist, text-table-index-source, text-index-body
+ }
+text-table-index-entry-template =
+ element text:table-index-entry-template {
+ text-illustration-index-entry-content
+ }
+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-of-content =
+ element text:table-of-content {
+ common-section-attlist,
+ text-table-of-content-source,
+ text-index-body
+ }
+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 =
+ element text:table-of-content-entry-template {
+ text-table-of-content-entry-template-attlist,
+ text-table-of-content-children*
+ }
+text-table-of-content-entry-template-attlist =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:style-name { styleNameRef }
+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-template-name-attlist =
+ attribute text:display {
+ "full" | "path" | "name" | "name-and-extension" | "area" | "title"
+ }?
+text-time-attlist =
+ (common-field-fixed-attlist & common-field-data-style-name-attlist)
+ & attribute text:time-value { timeOrDateTime }?
+ & attribute text:time-adjust { duration }?
+text-toc-mark-start-attrs = text-id, text-outline-level
+text-tracked-changes =
+ element text:tracked-changes {
+ text-tracked-changes-attr, text-changed-region*
+ }?
+text-tracked-changes-attr = attribute text:track-changes { boolean }?
+text-user-field-decl =
+ element text:user-field-decl {
+ common-field-name-attlist,
+ common-field-formula-attlist?,
+ common-value-and-type-attlist
+ }
+text-user-index =
+ element text:user-index {
+ common-section-attlist, text-user-index-source, text-index-body
+ }
+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-index-entry-link-start
+ | text-index-entry-link-end
+ # https://issues.oasis-open.org/browse/OFFICE-3941
+ )*
+ }
+text-user-index-entry-template-attrs =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:style-name { styleNameRef }
+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-variable-decl =
+ element text:variable-decl {
+ common-field-name-attlist, common-value-type-attlist
+ }
+textEncoding = xsd:string { pattern = "[A-Za-z][A-Za-z0-9._\-]*" }
+time = xsd:time
+timeOrDateTime = xsd:time | xsd:dateTime
+types = "submit" | "reset" | "push" | "url"
valueType =
"float"
| "time"
@@ -6257,24 +6397,18 @@ valueType =
| "currency"
| "boolean"
| "string"
-points =
- xsd:string { pattern = "-?[0-9]+,-?[0-9]+([ ]+-?[0-9]+,-?[0-9]+)*" }
-pathData = xsd:string
+variableName = 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 }
- }*
+vertBackPos = "top" | "center" | "bottom"
+xforms-bind-attlist = attribute xforms:bind { \string }?
+xforms-model = element xforms:model { anyAttListOrElements }
+xml-id = attribute xml:id { ID }
+zeroToHundredPercent =
+ xsd:string {
+ pattern = "([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+ }
+zeroToOneDecimal = xsd:decimal { minInclusive = "0" maxInclusive = "1" }
diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml
index 7fd91b8c72e..f8acb0d40ca 100644
--- a/etc/schema/schemas.xml
+++ b/etc/schema/schemas.xml
@@ -31,6 +31,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
<namespace ns="http://relaxng.org/ns/structure/1.0" typeId="RELAX NG"/>
<namespace ns="http://thaiopensource.com/ns/locating-rules/1.0"
uri="locate.rnc"/>
+ <namespace ns="urn:oasis:names:tc:opendocument:xmlns:office:1.0" typeId="LibreOffice"/>
+ <namespace ns="urn:org:documentfoundation:names:experimental:office:xmlns:loext:1.0" typeId="LibreOffice"/>
+ <namespace ns="urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0" typeId="LibreOffice"/>
+ <namespace ns="urn:oasis:names:tc:opendocument:xmlns:manifest:1.0" typeId="OpenDocument Manifest"/>
<documentElement localName="stylesheet" typeId="XSLT"/>
<documentElement prefix="xsl" localName="transform" typeId="XSLT"/>
@@ -59,7 +63,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
<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="LibreOffice" uri="OpenDocument-schema-v1.3+libreoffice.rnc"/>
<typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/>
</locatingRules>
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index 1f4891c3168..5a527111d35 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -1,4 +1,4 @@
-;;; manoj-dark.el --- A dark theme from Manoj -*- lexical-binding:t -*-
+;;; manoj-dark-theme.el --- A dark theme from Manoj -*- lexical-binding:t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
diff --git a/etc/themes/modus-operandi-theme.el b/etc/themes/modus-operandi-theme.el
index c7a0f72c103..a946d747e8e 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -1,4666 +1,72 @@
;;; modus-operandi-theme.el --- Accessible light theme (WCAG AAA) -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
-;; Version: 0.13.0
+;; Version: 1.5.0
;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or
+;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
+;; the 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.
+;; 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 theme is designed for colour-contrast accessibility.
+;; Modus Operandi is the light variant of the Modus themes (Modus
+;; Vivendi is the dark one). The themes are designed for color-contrast
+;; accessibility. More specifically:
;;
-;; 1. Provide a consistent minimum contrast ratio between background and
-;; foreground values of 7:1 or higher. This meets the highest such
-;; accessibility criterion per the guidelines of the Worldwide Web
-;; Consortium's Working Group on Accessibility (WCAG AAA standard).
+;; 1. Provide a consistent minimum contrast ratio between background
+;; and foreground values of 7:1 or higher. This meets the highest
+;; such accessibility criterion per the guidelines of the Worldwide
+;; Web Consortium's Working Group on Accessibility (WCAG AAA
+;; standard).
;;
-;; 2. Offer as close to full face coverage as possible. The list is
-;; already quite long (see further below), with more additions to follow
-;; as part of the ongoing development process.
+;; 2. Offer as close to full face coverage as possible. The list is
+;; already quite long, with more additions to follow as part of the
+;; ongoing development process.
;;
-;; The theme provides the following customisation options, all of which
-;; are disabled by default:
+;; For a complete view of the project, also refer to the following files
+;; (should be distributed in the same repository/directory as the
+;; current item):
;;
-;; modus-operandi-theme-slanted-constructs (boolean)
-;; modus-operandi-theme-bold-constructs (boolean)
-;; modus-operandi-theme-variable-pitch-headings (boolean)
-;; modus-operandi-theme-no-mixed-fonts (boolean)
-;; modus-operandi-theme-headings (alist)
-;; modus-operandi-theme-scale-headings (boolean)
-;; modus-operandi-theme-fringes (choice)
-;; modus-operandi-theme-org-blocks (choice)
-;; modus-operandi-theme-prompts (choice)
-;; modus-operandi-theme-mode-line (choice)
-;; modus-operandi-theme-diffs (choice)
-;; modus-operandi-theme-faint-syntax (boolean)
-;; modus-operandi-theme-intense-hl-line (boolean)
-;; modus-operandi-theme-intense-paren-match (boolean)
-;; modus-operandi-theme-no-link-underline (boolean)
-;; modus-operandi-theme-completions (choice)
-;; modus-operandi-theme-override-colors-alist (alist)
-;;
-;; The default scale is as follows (it can be customised as well):
-;;
-;; modus-operandi-theme-scale-1 1.05
-;; modus-operandi-theme-scale-2 1.1
-;; modus-operandi-theme-scale-3 1.15
-;; modus-operandi-theme-scale-4 1.2
-;; modus-operandi-theme-scale-5 1.3
-;;
-;; What follows is the list of explicitly supported packages or face
-;; groups (there are implicitly supported packages as well, which
-;; inherit from font-lock or some basic group). You are encouraged to
-;; notify me of any missing package or change you would like to see.
-;;
-;; ace-window
-;; ag
-;; alert
-;; all-the-icons
-;; annotate
-;; anzu
-;; apropos
-;; apt-sources-list
-;; artbollocks-mode
-;; auctex and TeX
-;; auto-dim-other-buffers
-;; avy
-;; awesome-tray
-;; binder
-;; bm
-;; bongo
-;; boon
-;; breakpoint (provided by built-in gdb-mi.el)
-;; buffer-expose
-;; calendar and diary
-;; calfw
-;; centaur-tabs
-;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
-;; cider
-;; circe
-;; color-rg
-;; column-enforce-mode
-;; company-mode
-;; company-posframe
-;; compilation-mode
-;; completions
-;; counsel
-;; counsel-css
-;; counsel-notmuch
-;; counsel-org-capture-string
-;; cov
-;; cperl-mode
-;; csv-mode
-;; ctrlf
-;; custom (M-x customize)
-;; dap-mode
-;; dashboard (emacs-dashboard)
-;; deadgrep
-;; debbugs
-;; define-word
-;; deft
-;; dictionary
-;; diff-hl
-;; diff-mode
-;; dim-autoload
-;; dir-treeview
-;; dired
-;; dired-async
-;; dired-git
-;; dired-git-info
-;; dired-narrow
-;; dired-subtree
-;; diredfl
-;; disk-usage
-;; doom-modeline
-;; dynamic-ruler
-;; easy-jekyll
-;; easy-kill
-;; ebdb
-;; ediff
-;; eglot
-;; el-search
-;; eldoc
-;; eldoc-box
-;; elfeed
-;; elfeed-score
-;; emms
-;; enhanced-ruby-mode
-;; epa
-;; equake
-;; erc
-;; eros
-;; ert
-;; eshell
-;; eshell-fringe-status
-;; eshell-git-prompt
-;; eshell-prompt-extras (epe)
-;; eshell-syntax-highlighting
-;; evil (evil-mode)
-;; evil-goggles
-;; evil-visual-mark-mode
-;; eww
-;; eyebrowse
-;; fancy-dabbrev
-;; flycheck
-;; flycheck-color-mode-line
-;; flycheck-indicator
-;; flycheck-posframe
-;; flymake
-;; flyspell
-;; flyspell-correct
-;; flx
-;; freeze-it
-;; frog-menu
-;; focus
-;; fold-this
-;; font-lock (generic syntax highlighting)
-;; forge
-;; fountain (fountain-mode)
-;; geiser
-;; git-commit
-;; git-gutter (and variants)
-;; git-lens
-;; git-rebase
-;; git-timemachine
-;; git-walktree
-;; gnus
-;; golden-ratio-scroll-screen
-;; helm
-;; helm-ls-git
-;; helm-switch-shell
-;; helm-xref
-;; helpful
-;; highlight-blocks
-;; highlight-defined
-;; highlight-escape-sequences (`hes-mode')
-;; highlight-indentation
-;; highlight-numbers
-;; highlight-symbol
-;; highlight-tail
-;; highlight-thing
-;; hl-defined
-;; hl-fill-column
-;; hl-line-mode
-;; hl-todo
-;; hydra
-;; hyperlist
-;; ibuffer
-;; icomplete
-;; ido-mode
-;; iedit
-;; iflipb
-;; imenu-list
-;; indium
-;; info
-;; info-colors
-;; interaction-log
-;; ioccur
-;; isearch, occur, etc.
-;; ivy
-;; ivy-posframe
-;; jira (org-jira)
-;; journalctl-mode
-;; js2-mode
-;; julia
-;; jupyter
-;; kaocha-runner
-;; keycast
-;; line numbers (`display-line-numbers-mode' and global variant)
-;; lsp-mode
-;; lsp-ui
-;; magit
-;; magit-imerge
-;; man
-;; markdown-mode
-;; markup-faces (`adoc-mode')
-;; mentor
-;; messages
-;; minibuffer-line
-;; minimap
-;; modeline
-;; mood-line
-;; mpdel
-;; mu4e
-;; mu4e-conversation
-;; multiple-cursors
-;; neotree
-;; no-emoji
-;; notmuch
-;; num3-mode
-;; nxml-mode
-;; objed
-;; orderless
-;; org
-;; org-journal
-;; org-noter
-;; org-pomodoro
-;; org-recur
-;; org-roam
-;; org-superstar
-;; org-table-sticky-header
-;; org-treescope
-;; origami
-;; outline-mode
-;; outline-minor-faces
-;; package (M-x list-packages)
-;; page-break-lines
-;; paradox
-;; paren-face
-;; parrot
-;; pass
-;; persp-mode
-;; perspective
-;; phi-grep
-;; phi-search
-;; pkgbuild-mode
-;; pomidor
-;; powerline
-;; powerline-evil
-;; proced
-;; prodigy
-;; racket-mode
-;; rainbow-blocks
-;; rainbow-identifiers
-;; rainbow-delimiters
-;; rcirc
-;; regexp-builder (also known as `re-builder')
-;; rg
-;; ripgrep
-;; rmail
-;; ruler-mode
-;; sallet
-;; selectrum
-;; semantic
-;; sesman
-;; shell-script-mode
-;; show-paren-mode
-;; side-notes
-;; skewer-mode
-;; smart-mode-line
-;; smartparens
-;; smerge
-;; spaceline
-;; speedbar
-;; spell-fu
-;; stripes
-;; suggest
-;; switch-window
-;; swiper
-;; swoop
-;; sx
-;; symbol-overlay
-;; tab-bar-mode
-;; tab-line-mode
-;; syslog-mode
-;; table (built-in table.el)
-;; telephone-line
-;; term
-;; tomatinho
-;; transient (pop-up windows like Magit's)
-;; trashed
-;; treemacs
-;; tty-menu
-;; tuareg
-;; typescript
-;; undo-tree
-;; vc (built-in mode line status for version control)
-;; vc-annotate (C-x v g)
-;; vdiff
-;; vimish-fold
-;; visible-mark
-;; visual-regexp
-;; volatile-highlights
-;; vterm
-;; wcheck-mode
-;; web-mode
-;; wgrep
-;; which-function-mode
-;; which-key
-;; whitespace-mode
-;; window-divider-mode
-;; winum
-;; writegood-mode
-;; woman
-;; xah-elisp-mode
-;; xref
-;; xterm-color (and ansi-colors)
-;; yaml-mode
-;; yasnippet
-;; ztree
+;; - modus-themes.el (Main code shared between the themes)
+;; - modus-vivendi-theme.el (Dark theme)
;;; Code:
-(deftheme modus-operandi
- "Light theme that conforms with the highest accessibility
- standard for colour contrast between background and
- foreground elements (WCAG AAA).")
-
-;;; Custom faces
-
-;; These faces will be inherited by actual constructs. They are meant
-;; for those cases where a face needs to distinguish its output from
-;; the rest of the text, such as `isearch' and `occur'… We define
-;; these separately in order to combine each colour with its
-;; appropriate foreground value. This is to ensure a consistent
-;; contrast ratio of >= 7:1.
-(defgroup modus-theme ()
- "Theme that ensures WCAG AAA accessibility (contrast ratio
-between foreground and background is >= 7:1)."
- :group 'faces
- :prefix "modus-theme-"
- :link '(url-link :tag "GitLab" "https://gitlab.com/protesilaos/modus-themes")
- :tag "Modus Operandi")
-
-(defface modus-theme-subtle-red nil nil)
-(defface modus-theme-subtle-green nil nil)
-(defface modus-theme-subtle-yellow nil nil)
-(defface modus-theme-subtle-blue nil nil)
-(defface modus-theme-subtle-magenta nil nil)
-(defface modus-theme-subtle-cyan nil nil)
-(defface modus-theme-subtle-neutral nil nil)
-(defface modus-theme-intense-red nil nil)
-(defface modus-theme-intense-green nil nil)
-(defface modus-theme-intense-yellow nil nil)
-(defface modus-theme-intense-blue nil nil)
-(defface modus-theme-intense-magenta nil nil)
-(defface modus-theme-intense-cyan nil nil)
-(defface modus-theme-intense-neutral nil nil)
-(defface modus-theme-refine-red nil nil)
-(defface modus-theme-refine-green nil nil)
-(defface modus-theme-refine-yellow nil nil)
-(defface modus-theme-refine-blue nil nil)
-(defface modus-theme-refine-magenta nil nil)
-(defface modus-theme-refine-cyan nil nil)
-(defface modus-theme-active-red nil nil)
-(defface modus-theme-active-green nil nil)
-(defface modus-theme-active-yellow nil nil)
-(defface modus-theme-active-blue nil nil)
-(defface modus-theme-active-magenta nil nil)
-(defface modus-theme-active-cyan nil nil)
-(defface modus-theme-fringe-red nil nil)
-(defface modus-theme-fringe-green nil nil)
-(defface modus-theme-fringe-yellow nil nil)
-(defface modus-theme-fringe-blue nil nil)
-(defface modus-theme-fringe-magenta nil nil)
-(defface modus-theme-fringe-cyan nil nil)
-(defface modus-theme-nuanced-red nil nil)
-(defface modus-theme-nuanced-green nil nil)
-(defface modus-theme-nuanced-yellow nil nil)
-(defface modus-theme-nuanced-blue nil nil)
-(defface modus-theme-nuanced-magenta nil nil)
-(defface modus-theme-nuanced-cyan nil nil)
-(defface modus-theme-special-cold nil nil)
-(defface modus-theme-special-mild nil nil)
-(defface modus-theme-special-warm nil nil)
-(defface modus-theme-special-calm nil nil)
-(defface modus-theme-diff-added nil nil)
-(defface modus-theme-diff-changed nil nil)
-(defface modus-theme-diff-removed nil nil)
-(defface modus-theme-diff-refine-added nil nil)
-(defface modus-theme-diff-refine-changed nil nil)
-(defface modus-theme-diff-refine-removed nil nil)
-(defface modus-theme-diff-focus-added nil nil)
-(defface modus-theme-diff-focus-changed nil nil)
-(defface modus-theme-diff-focus-removed nil nil)
-(defface modus-theme-diff-heading nil nil)
-(defface modus-theme-pseudo-header nil nil)
-(defface modus-theme-mark-alt nil nil)
-(defface modus-theme-mark-del nil nil)
-(defface modus-theme-mark-sel nil nil)
-(defface modus-theme-mark-symbol nil nil)
-(defface modus-theme-heading-1 nil nil)
-(defface modus-theme-heading-2 nil nil)
-(defface modus-theme-heading-3 nil nil)
-(defface modus-theme-heading-4 nil nil)
-(defface modus-theme-heading-5 nil nil)
-(defface modus-theme-heading-6 nil nil)
-(defface modus-theme-heading-7 nil nil)
-(defface modus-theme-heading-8 nil nil)
-(defface modus-theme-hl-line nil nil)
-
-;;; Customisation options
-
-;; User-facing customisation options. They are all deactivated by
-;; default (users must opt in).
-(defcustom modus-operandi-theme-slanted-constructs nil
- "Use slanted text in more code constructs (italics or oblique)."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-bold-constructs nil
- "Use bold text in more code constructs."
- :type 'boolean)
-
-(define-obsolete-variable-alias 'modus-operandi-theme-proportional-fonts
- 'modus-operandi-theme-variable-pitch-headings "`modus-operandi-theme' 0.11.0")
-
-(defcustom modus-operandi-theme-proportional-fonts nil
- "Use proportional fonts (variable-pitch) in headings."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-variable-pitch-headings nil
- "Use proportional fonts (variable-pitch) in headings."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-no-mixed-fonts nil
- "Disable inheritance from `fixed-pitch' in some faces.
-
-This is done by default to allow spacing-sensitive constructs,
-such as Org tables and code blocks, to remain monospaced when
-users opt for something like the command `variable-pitch-mode'.
-The downside with the default is that users need to explicitly
-configure the font family of `fixed-pitch' in order to get a
-consistent experience. That may be something they do not want to
-do. Hence this option to disable any kind of technique for
-mixing fonts."
- :type 'boolean)
-
-(make-obsolete 'modus-operandi-theme-rainbow-headings
- 'modus-operandi-theme-headings
- "`modus-operandi-theme' 0.13.0")
-
-(defcustom modus-operandi-theme-rainbow-headings nil
- "Use more saturated colours for headings."
- :type 'boolean)
-
-(make-obsolete 'modus-operandi-theme-section-headings
- 'modus-operandi-theme-headings
- "`modus-operandi-theme' 0.13.0")
-
-(defcustom modus-operandi-theme-section-headings nil
- "Use a background and an overline in headings."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-headings
- '((t . nil))
- "Alist of styles for headings, with optional value per level.
-
-To control faces per level from 1-8, use something like this:
-
- (setq modus-operandi-theme-headings
- '((1 . highlight)
- (2 . line)
- (t . rainbow-line-no-bold)))
-
-To set a uniform value for all heading levels, use this pattern:
-
- (setq modus-operandi-theme-headings
- '((t . rainbow-line-no-bold)))
-
-The default uses a fairly desaturated foreground value in
-combination with a bold typographic weight. To specify this
-style for a given level N (assuming you wish to have another
-fallback option), just specify the value t like this:
-
- (setq modus-operandi-theme-headings
- '((1 . t)
- (2 . line)
- (t . rainbow-line-no-bold)))
-
-A description of all possible values:
-
-+ `no-bold' retains the default text colour while removing
- the typographic weight.
-
-+ `line' is the same as the default plus an overline over the
- heading.
-
-+ `line-no-bold' is the same as `line' without bold weight.
-
-+ `rainbow' uses a more colourful foreground in combination
- with bold weight.
-
-+ `rainbow-line' is the same as `rainbow' plus an overline.
-
-+ `rainbow-line-no-bold' is the same as `rainbow-line' without
- the bold weight.
-
-+ `highlight' retains the default style of a fairly desaturated
- foreground combined with a bold weight and add to it a subtle
- accented background.
-
-+ `highlight-no-bold' is the same as `highlight' without a bold
- weight.
-
-+ `rainbow-highlight' is the same as `highlight' but with a more
- colourful foreground.
-
-+ `rainbow-highlight-no-bold' is the same as `rainbow-highlight'
- without a bold weight.
-
-+ `section' retains the default looks and adds to them both an
- overline and a slightly accented background. It is, in effect,
- a combination of the `line' and `highlight' values.
-
-+ `section-no-bold' is the same as `section' without a bold
- weight.
-
-+ `rainbow-section' is the same as `section' but with a more
- colourful foreground.
-
-+ `rainbow-section-no-bold' is the same as `rainbow-section'
- without a bold weight."
- :type
- '(alist
- :key-type symbol
- :value-type
- (choice (const :tag "Fairly desaturated foreground with bold weight (default)" t)
- (const :tag "Like the default without bold weight" no-bold)
- (const :tag "Like the default plus overline" line)
- (const :tag "Like `line' without bold weight" line-no-bold)
- (const :tag "Like the default but with more colourful foreground" rainbow)
- (const :tag "Like `rainbow' plus overline" rainbow-line)
- (const :tag "Like `rainbow' without bold weight" rainbow-no-bold)
- (const :tag "Like `rainbow-line' without bold weight" rainbow-line-no-bold)
- (const :tag "Like the default plus subtle background" highlight)
- (const :tag "Like `highlight' without bold weight" highlight-no-bold)
- (const :tag "Like `highlight' with more colourful foreground" rainbow-highlight)
- (const :tag "Like `rainbow-highlight' without bold weight" rainbow-highlight-no-bold)
- (const :tag "Like `highlight' plus overline" section)
- (const :tag "Like `section' without bold weight" section-no-bold)
- (const :tag "Like `section' with more colourful foreground" rainbow-section)
- (const :tag "Like `rainbow-section' without bold weight" rainbow-section-no-bold))))
-
-(defcustom modus-operandi-theme-scale-headings nil
- "Use font scaling for headings."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-scale-1 1.05
- "Font size that is slightly larger than the base value.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-operandi-theme-scale-2 1.1
- "Font size slightly larger than `modus-operandi-theme-scale-1'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-operandi-theme-scale-3 1.15
- "Font size slightly larger than `modus-operandi-theme-scale-2'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-operandi-theme-scale-4 1.2
- "Font size slightly larger than `modus-operandi-theme-scale-3'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-operandi-theme-scale-5 1.3
- "Font size slightly larger than `modus-operandi-theme-scale-4'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(make-obsolete 'modus-operandi-theme-visible-fringes
- 'modus-operandi-theme-fringes
- "`modus-operandi-theme' 0.12.0")
-
-(defcustom modus-operandi-theme-visible-fringes nil
- "Use a visible style for fringes."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-fringes nil
- "Define the visibility of fringes.
-
-Nil means the fringes have no background colour. Option `subtle'
-will apply a greyscale value that is visible yet close to the
-main buffer background colour. Option `intense' will use a more
-pronounced greyscale value."
- :type '(choice
- (const :tag "No visible fringes (default)" nil)
- (const :tag "Subtle greyscale background" subtle)
- (const :tag "Intense greyscale background" intense)))
-
-(make-obsolete 'modus-operandi-theme-distinct-org-blocks
- 'modus-operandi-theme-org-blocks
- "`modus-operandi-theme' 0.11.0")
-
-(defcustom modus-operandi-theme-distinct-org-blocks nil
- "Use a distinct neutral background for `org-mode' blocks."
- :type 'boolean)
-
-(make-obsolete 'modus-operandi-theme-rainbow-org-src-blocks
- 'modus-operandi-theme-org-blocks
- "`modus-operandi-theme' 0.11.0")
-
-(defcustom modus-operandi-theme-rainbow-org-src-blocks nil
- "Use colour-coded backgrounds for `org-mode' source blocks.
-The colour in use depends on the language (send feedback to
-include more languages)."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-org-blocks nil
- "Use a subtle grey or colour-coded background for Org blocks.
-
-Nil means that the block will have no background of its own and
-will use the default that applies to the rest of the buffer.
-
-Option `greyscale' will apply a subtle neutral grey background to
-the block's contents. It also affects the begin and end lines of
-the block: their background will be extended to the edge of the
-window for Emacs version >= 27 where the ':extend' keyword is
-recognised by `set-face-attribute'.
-
-Option `rainbow' will use an accented background for the contents
-of the block. The exact colour will depend on the programming
-language and is controlled by the `org-src-block-faces'
-variable (refer to the theme's source code for the current
-association list)."
- :type '(choice
- (const :tag "No Org block background (default)" nil)
- (const :tag "Subtle grey block background" greyscale)
- (const :tag "Colour-coded background per programming language" rainbow)))
-
-(make-obsolete 'modus-operandi-theme-3d-modeline
- 'modus-operandi-theme-mode-line
- "`modus-operandi-theme' 0.13.0")
-
-(defcustom modus-operandi-theme-3d-modeline nil
- "Use a three-dimensional style for the active mode line."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-mode-line nil
- "Adjust the overall style of the mode line.
-
-Nil is a two-dimensional rectangle with a border around it. The
-active and the inactive modelines use different shades of
-greyscale values for the background and foreground.
-
-A `3d' value will apply a three-dimensional effect to the active
-modeline. The inactive modelines remain two-dimensional and are
-toned down a bit, relative to the nil value.
-
-The `moody' option is meant to optimise the modeline for use with
-the library of the same name. This practically means to remove
-the box effect and rely on underline and overline properties
-instead. It also tones down the inactive modelines. Despite its
-intended purpose, this option can also be used without the
-`moody' library."
- :type '(choice
- (const :tag "Two-dimensional box (default)" nil)
- (const :tag "Three-dimensional style for the active mode line" 3d)
- (const :tag "No box effects, which are optimal for use with the `moody' library" moody)))
-
-(make-obsolete 'modus-operandi-theme-subtle-diffs
- 'modus-operandi-theme-diffs
- "`modus-operandi-theme' 0.13.0")
-
-(defcustom modus-operandi-theme-subtle-diffs nil
- "Use fewer/dim backgrounds in `diff-mode', `ediff',`magit'."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-diffs nil
- "Adjust the overall styles of diffs.
-
-Nil means to use fairly intense colour combinations for diffs.
-For example, you get a rich green background with a green
-foreground for added lines. Word-wise or 'refined' diffs follow
-the same pattern but use different shades of those colours to
-remain distinct.
-
-A `desaturated' value follows the same principles as with the nil
-option, while it tones down all relevant colours.
-
-Option `fg-only' will remove all accented backgrounds, except
-from word-wise changes. It instead uses colour-coded foreground
-values to differentiate between added/removed/changed lines. If
-a background is necessary, such as with `ediff', then a subtle
-greyscale value is used."
- :type '(choice
- (const :tag "Intensely coloured backgrounds (default)" nil)
- (const :tag "Slightly accented backgrounds with tinted text" desaturated)
- (const :tag "No backgrounds, except for refined diffs" fg-only)))
-
-(make-obsolete 'modus-operandi-theme-intense-standard-completions
- 'modus-operandi-theme-completions
- "`modus-operandi-theme' 0.12.0")
-
-(defcustom modus-operandi-theme-intense-standard-completions nil
- "Use prominent backgrounds for Icomplete, Ido, or similar."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-completions nil
- "Apply special styles to the UI of completion frameworks.
-
-This concerns Icomplete, Ivy, Helm, Selectrum, Ido, as well as
-any other tool meant to enhance their experience. The effect
-will vary depending on the completion framework.
-
-Nil means to remain faithful to the metaphors that each UI
-establishes. For example, Icomplete and Ido only use foreground
-colours to style their matches, whereas Ivy or Helm rely on an
-aesthetic that combines coloured backgrounds with appropriate
-text colour.
-
-Option `moderate' will apply a combination of background and
-foreground that is fairly subtle. For Icomplete and the like,
-this constitutes a departure from their standard style. While
-Ivy, Helm, and the others, will use less pronounced colours for
-applicable contexts.
-
-Option `opinionated' will apply colour combinations that
-refashion the completion UI. So Icomplete et al will now use
-styles that resemble the defaults of Ivy and co., while the
-latter group will revert to an even more nuanced aesthetic."
- :type '(choice
- (const :tag "Respect the framework's established aesthetic (default)" nil)
- (const :tag "Subtle backgrounds for various elements" moderate)
- (const :tag "Radical alternative to the framework's looks" opinionated)))
-
-(defcustom modus-operandi-theme-prompts nil
- "Use subtle or intense styles for minibuffer and REPL prompts.
-
-Nil means to only use an accented foreground colour.
-
-Options `subtle' and `intense' will change both the background
-and the foreground values. The latter has a more pronounced
-effect than the former."
- :type '(choice
- (const :tag "No prompt background (default)" nil)
- (const :tag "Subtle accented background for the prompt" subtle)
- (const :tag "Intense background and foreground for the prompt" intense)))
-
-(defcustom modus-operandi-theme-intense-hl-line nil
- "Use more prominent background for command `hl-line-mode'."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-intense-paren-match nil
- "Use more prominent colour for parenthesis matching."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-faint-syntax nil
- "Use less saturated colours for code syntax highlighting."
- :type 'boolean)
-
-(defcustom modus-operandi-theme-no-link-underline nil
- "Do not underline links."
- :type 'boolean)
-
-;;; Internal functions
-
-;; Helper functions that are meant to ease the implementation of the
-;; above customisation options.
-(defun modus-operandi-theme-bold-weight ()
- "Conditional use of a heavier text weight."
- (when modus-operandi-theme-bold-constructs
- (list :inherit 'bold)))
-
-(defun modus-operandi-theme-mixed-fonts ()
- "Conditional application of `fixed-pitch' inheritance."
- (unless modus-operandi-theme-no-mixed-fonts
- (list :inherit 'fixed-pitch)))
-
-(defun modus-operandi-theme-fringe (subtlebg intensebg)
- "Conditional use of background colours for fringes.
-SUBTLEBG should be a subtle greyscale value. INTENSEBG must be a
-more pronounced greyscale colour."
- (pcase modus-operandi-theme-fringes
- ('intense (list :background intensebg))
- ('subtle (list :background subtlebg))
- (_ (list :background nil))))
-
-(defun modus-operandi-theme-prompt (mainfg subtlebg subtlefg intensebg intensefg)
- "Conditional use of background colours for prompts.
-MAINFG is the prompt's standard foreground. SUBTLEBG should be a
-subtle accented background that works with SUBTLEFG. INTENSEBG
-must be a more pronounced accented colour that should be
-combinable with INTENSEFG."
- (pcase modus-operandi-theme-prompts
- ('intense (list :background intensebg :foreground intensefg))
- ('subtle (list :background subtlebg :foreground subtlefg))
- (_ (list :background nil :foreground mainfg))))
-
-(defun modus-operandi-theme-paren (normalbg intensebg)
- "Conditional use of intense colours for matching parentheses.
-NORMALBG should the special palette colour 'bg-paren-match' or
-something similar. INTENSEBG must be easier to discern next to
-other backgrounds, such as the special palette colour
-'bg-paren-match-intense'."
- (if modus-operandi-theme-intense-paren-match
- (list :background intensebg)
- (list :background normalbg)))
-
-(defun modus-operandi-theme-syntax-foreground (normal faint)
- "Apply foreground value to code syntax.
-NORMAL is the more saturated colour, which should be the default.
-FAINT is the less saturated colour."
- (if modus-operandi-theme-faint-syntax
- (list :foreground faint)
- (list :foreground normal)))
-
-(defun modus-operandi-theme-heading-p (key)
- "Query style of KEY in `modus-operandi-theme-headings'."
- (cdr (assoc key modus-operandi-theme-headings)))
-
-(defun modus-operandi-theme-heading (level fg fg-alt bg border)
- "Conditional styles for `modus-operandi-theme-headings'.
-
-LEVEL is the heading's position in their order. FG is the
-default text colour. FG-ALT is an accented, more saturated value
-than the default. BG is a nuanced, typically accented,
-background that can work well with either of the foreground
-values. BORDER is a colour value that combines well with the
-background and alternative foreground."
- (let* ((key (modus-operandi-theme-heading-p `,level))
- (style (or key (modus-operandi-theme-heading-p t)))
- (var (if modus-operandi-theme-variable-pitch-headings
- 'variable-pitch
- 'default)))
- (pcase style
- ('no-bold
- (list :inherit `,var :foreground fg))
- ('line
- (list :inherit `(bold ,var) :foreground fg :overline border))
- ('line-no-bold
- (list :inherit `,var :foreground fg :overline border))
- ('rainbow
- (list :inherit `(bold ,var) :foreground fg-alt))
- ('rainbow-no-bold
- (list :inherit `,var :foreground fg-alt))
- ('rainbow-line
- (list :inherit `(bold ,var) :foreground fg-alt :overline border))
- ('rainbow-line-no-bold
- (list :inherit `,var :foreground fg-alt :overline border))
- ('highlight
- (list :inherit `(bold ,var) :background bg :foreground fg))
- ('highlight-no-bold
- (list :inherit `,var :background bg :foreground fg))
- ('rainbow-highlight
- (list :inherit `(bold ,var) :background bg :foreground fg-alt))
- ('rainbow-highlight-no-bold
- (list :inherit `,var :background bg :foreground fg-alt))
- ('section
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `(bold ,var) :background bg :foreground fg :overline border)))
- ('section-no-bold
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `,var :background bg :foreground fg :overline border)))
- ('rainbow-section
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `(bold ,var) :background bg :foreground fg-alt :overline border)))
- ('rainbow-section-no-bold
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `,var :background bg :foreground fg-alt :overline border)))
- (_
- (list :inherit `(bold ,var) :foreground fg)))))
-
-(defun modus-operandi-theme-org-block (bgblk)
- "Conditionally set the background of Org blocks.
-BGBLK applies to a distinct neutral background. Else blocks have
-no background of their own (the default), so they look the same
-as the rest of the buffer.
-
-`modus-operandi-theme-org-blocks' also accepts a `rainbow' option
-which is applied conditionally to `org-src-block-faces' (see the
-theme's source code)."
- (if (eq modus-operandi-theme-org-blocks 'greyscale)
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :background bgblk))
- (list :background nil)))
-
-(defun modus-operandi-theme-org-block-delim (bgaccent fgaccent bg fg)
- "Conditionally set the styles of Org block delimiters.
-BG, FG, BGACCENT, FGACCENT apply a background and foreground
-colour respectively.
-
-The former pair is a greyscale combination that should be more
-distinct than the background of the block. It is applied to the
-default styles or when `modus-operandi-theme-org-blocks' is set
-to `greyscale'.
-
-The latter pair should be more subtle than the background of the
-block, as it is used when `modus-operandi-theme-org-blocks' is
-set to `rainbow'."
- (pcase modus-operandi-theme-org-blocks
- ('greyscale (append (and (>= emacs-major-version 27) '(:extend t))
- (list :background bg :foreground fg)))
- ('rainbow (list :background bgaccent :foreground fgaccent))
- (_ (list :background bg :foreground fg))))
-
-(defun modus-operandi-theme-mode-line-attrs
- (fg bg fg-alt bg-alt border border-3d &optional alt-style border-width fg-distant)
- "Colour combinations for `modus-operandi-theme-mode-line'.
-
-FG and BG are the default colours. FG-ALT and BG-ALT are meant
-to accommodate the options for a 3D modeline or a `moody'
-compliant one. BORDER applies to all permutations of the
-modeline, except the three-dimensional effect, where BORDER-3D is
-used instead.
-
-Optional ALT-STYLE applies an appropriate style to the mode
-line's box property.
-
-Optional BORDER-WIDTH specifies an integer for the width of the
-rectangle that produces the box effect.
-
-Optional FG-DISTANT should be close to the main background
-values. It is intended to be used as a distant-foreground
-property."
- (pcase modus-operandi-theme-mode-line
- ('3d
- `(:background ,bg-alt :foreground ,fg-alt
- :box (:line-width ,(or border-width 1)
- :color ,border-3d
- :style ,(and alt-style 'released-button))))
- ('moody
- `(:background ,bg-alt :foreground ,fg-alt :underline ,border :overline ,border
- :distant-foreground ,fg-distant))
- (_
- `(:foreground ,fg :background ,bg :box ,border))))
-
-(defun modus-operandi-theme-diff (fg-only-bg fg-only-fg mainbg mainfg altbg altfg)
- "Colour combinations for `modus-operandi-theme-diffs'.
-
-FG-ONLY-BG should be similar or the same as the main background.
-FG-ONLY-FG should be a saturated accent value that can be
-combined with the former.
-
-MAINBG must be one of the dedicated backgrounds for diffs while
-MAINFG must be the same for the foreground.
-
-ALTBG needs to be a slightly accented background that is meant to
-be combined with ALTFG. Both must be less intense than MAINBG
-and MAINFG respectively."
- (pcase modus-operandi-theme-diffs
- ('fg-only (list :background fg-only-bg :foreground fg-only-fg))
- ('desaturated (list :background altbg :foreground altfg))
- (_ (list :background mainbg :foreground mainfg))))
-
-(defun modus-operandi-theme-standard-completions (mainfg subtlebg intensebg intensefg)
- "Combinations for `modus-operandi-theme-completions'.
-
-MAINFG is an accented foreground value. SUBTLEBG is an accented
-background value that can be combined with MAINFG. INTENSEBG and
-INTENSEFG are accented colours that are designed to be used in
-tandem.
-
-These are intended for Icomplete, Ido, and related."
- (pcase modus-operandi-theme-completions
- ('opinionated (list :background intensebg :foreground intensefg))
- ('moderate (list :background subtlebg :foreground mainfg))
- (_ (list :foreground mainfg))))
-
-(defun modus-operandi-theme-extra-completions (subtleface intenseface altface &optional altfg bold)
- "Combinations for `modus-operandi-theme-completions'.
-
-SUBTLEFACE and INTENSEFACE are custom theme faces that combine a
-background and foreground value. The difference between the two
-is a matter of degree.
-
-ALTFACE is a combination of colours that represents a departure
-from the UI's default aesthetics. Optional ALTFG is meant to be
-used in tandem with it.
-
-Optional BOLD will apply a heavier weight to the text.
-
-These are intended for Helm, Ivy, etc."
- (pcase modus-operandi-theme-completions
- ('opinionated (list :inherit (list altface bold)
- :foreground (or altfg 'unspecified)))
- ('moderate (list :inherit (list subtleface bold)))
- (_ (list :inherit (list intenseface bold)))))
-
-(defun modus-operandi-theme-scale (amount)
- "Scale heading by AMOUNT.
-
-AMOUNT is a customisation option."
- (when modus-operandi-theme-scale-headings
- (list :height amount)))
-
-;;; Colour palette
-
-;; Define colour palette. Each colour must have a >= 7:1 contrast
-;; ratio relative to the foreground/background colour it is rendered
-;; against.
-;;
-;; The design of the colour palette as a macro that maps it to faces is
-;; adapted from zenbern-theme.el, last seen at commit 7dd7968:
-;; https://github.com/bbatsov/zenburn-emacs
(eval-and-compile
- (defconst modus-operandi-theme-default-colors-alist
- '(;; base values
- ("bg-main" . "#ffffff") ("fg-main" . "#000000")
- ("bg-alt" . "#f0f0f0") ("fg-alt" . "#505050")
- ("bg-dim" . "#f8f8f8") ("fg-dim" . "#282828")
- ;; specifically for on/off states (e.g. `mode-line')
- ;;
- ;; must be combined with themselves
- ("bg-active" . "#d7d7d7") ("fg-active" . "#0a0a0a")
- ("bg-inactive" . "#efefef") ("fg-inactive" . "#404148")
- ;; special base values, used only for cases where the above
- ;; fg-* or bg-* cannot or should not be used (to avoid confusion)
- ;; must be combined with: {fg,bg}-{main,alt,dim}
- ("bg-special-cold" . "#dde3f4") ("fg-special-cold" . "#093060")
- ("bg-special-mild" . "#c4ede0") ("fg-special-mild" . "#184034")
- ("bg-special-warm" . "#f0e0d4") ("fg-special-warm" . "#5d3026")
- ("bg-special-calm" . "#f8ddea") ("fg-special-calm" . "#61284f")
- ;; styles for the main constructs
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red" . "#a60000") ("green" . "#005e00")
- ("yellow" . "#813e00") ("blue" . "#0031a9")
- ("magenta" . "#721045") ("cyan" . "#00538b")
- ;; styles for common, but still specialised constructs
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red-alt" . "#972500") ("green-alt" . "#315b00")
- ("yellow-alt" . "#70480f") ("blue-alt" . "#2544bb")
- ("magenta-alt" . "#8f0075") ("cyan-alt" . "#30517f")
- ;; same purpose as above, just slight differences
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red-alt-other" . "#a0132f") ("green-alt-other" . "#145c33")
- ("yellow-alt-other" . "#863927") ("blue-alt-other" . "#0000c0")
- ("magenta-alt-other" . "#5317ac") ("cyan-alt-other" . "#005a5f")
- ;; styles for desaturated foreground text, intended for use with
- ;; the `modus-operandi-theme-faint-syntax' option
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red-faint" . "#7f1010") ("green-faint" . "#104410")
- ("yellow-faint" . "#5f4400") ("blue-faint" . "#002f88")
- ("magenta-faint" . "#752f50") ("cyan-faint" . "#12506f")
-
- ("red-alt-faint" . "#702f00") ("green-alt-faint" . "#30440f")
- ("yellow-alt-faint" . "#5d5000") ("blue-alt-faint" . "#003f78")
- ("magenta-alt-faint" . "#702565") ("cyan-alt-faint" . "#354f6f")
-
- ("red-alt-other-faint" . "#7f002f") ("green-alt-other-faint" . "#0f443f")
- ("yellow-alt-other-faint" . "#5e3a20") ("blue-alt-other-faint" . "#1f2f6f")
- ("magenta-alt-other-faint" . "#5f3f7f") ("cyan-alt-other-faint" . "#2e584f")
- ;; styles for elements that should be very subtle, yet accented
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim' or any of
- ;; the "nuanced" backgrounds
- ("red-nuanced" . "#5f0000") ("green-nuanced" . "#004000")
- ("yellow-nuanced" . "#3f3000") ("blue-nuanced" . "#201f55")
- ("magenta-nuanced" . "#541f4f") ("cyan-nuanced" . "#0f3360")
- ;; styles for slightly accented background
- ;;
- ;; must be combined with any of the above foreground values
- ("red-nuanced-bg" . "#fff1f0") ("green-nuanced-bg" . "#ecf7ed")
- ("yellow-nuanced-bg" . "#fff3da") ("blue-nuanced-bg" . "#f3f3ff")
- ("magenta-nuanced-bg" . "#fdf0ff") ("cyan-nuanced-bg" . "#ebf6fa")
- ;; styles for elements that should draw attention to themselves
- ;;
- ;; must be combined with: `bg-main'
- ("red-intense" . "#b60000") ("green-intense" . "#006800")
- ("yellow-intense" . "#904200") ("blue-intense" . "#1111ee")
- ("magenta-intense" . "#7000e0") ("cyan-intense" . "#205b93")
- ;; styles for background elements that should be visible yet
- ;; subtle
- ;;
- ;; must be combined with: `fg-dim'
- ("red-subtle-bg" . "#f2b0a2") ("green-subtle-bg" . "#aecf90")
- ("yellow-subtle-bg" . "#e4c340") ("blue-subtle-bg" . "#b5d0ff")
- ("magenta-subtle-bg" . "#f0d3ff") ("cyan-subtle-bg" . "#c0efff")
- ;; styles for background elements that should be visible and
- ;; distinguishable
- ;;
- ;; must be combined with: `fg-main'
- ("red-intense-bg" . "#ff8892") ("green-intense-bg" . "#5ada88")
- ("yellow-intense-bg" . "#f5df23") ("blue-intense-bg" . "#6aaeff")
- ("magenta-intense-bg" . "#d5baff") ("cyan-intense-bg" . "#42cbd4")
- ;; styles for refined contexts where both the foreground and the
- ;; background need to have the same/similar hue
- ;;
- ;; must be combined with themselves OR the foregrounds can be
- ;; combined with any of the base backgrounds
- ("red-refine-bg" . "#ffcccc") ("red-refine-fg" . "#780000")
- ("green-refine-bg" . "#aceaac") ("green-refine-fg" . "#004c00")
- ("yellow-refine-bg" . "#fff29a") ("yellow-refine-fg" . "#604000")
- ("blue-refine-bg" . "#8ac7ff") ("blue-refine-fg" . "#002288")
- ("magenta-refine-bg" . "#ffccff") ("magenta-refine-fg" . "#770077")
- ("cyan-refine-bg" . "#8eecf4") ("cyan-refine-fg" . "#004850")
- ;; styles that are meant exclusively for the mode line
- ;;
- ;; must be combined with: `bg-active', `bg-inactive'
- ("red-active" . "#8a0000") ("green-active" . "#004c2e")
- ("yellow-active" . "#702d1f") ("blue-active" . "#0030b4")
- ("magenta-active" . "#5c2092") ("cyan-active" . "#003f8a")
- ;; styles that are meant exclusively for the fringes
- ;;
- ;; must be combined with `fg-main'
- ("red-fringe-bg" . "#f08290") ("green-fringe-bg" . "#62c86a")
- ("yellow-fringe-bg" . "#dbba3f") ("blue-fringe-bg" . "#82afff")
- ("magenta-fringe-bg" . "#e0a3ff") ("cyan-fringe-bg" . "#2fcddf")
- ;; styles reserved for specific faces
- ;;
- ;; `bg-hl-line' is between `bg-dim' and `bg-alt', so it should
- ;; work with all accents that cover those two, plus `bg-main'
- ;;
- ;; `bg-hl-alt' and `bg-hl-alt-intense' should only be used when no
- ;; other greyscale or fairly neutral background is available to
- ;; properly draw attention to a given construct
- ;;
- ;; `bg-header' is between `bg-active' and `bg-inactive', so it
- ;; can be combined with any of the "active" values, plus the
- ;; "special" and base foreground colours
- ;;
- ;; `bg-paren-match', `bg-paren-match-intense', `bg-region' and
- ;; `bg-tab-active' must be combined with `fg-main', while
- ;; `bg-tab-inactive' should be combined with `fg-dim'
- ;;
- ;; `bg-tab-bar' is only intended for the bar that holds the tabs and
- ;; can only be combined with `fg-main'
- ;;
- ;; `fg-tab-active' is meant to be combined with `bg-tab-active',
- ;; though only for styling special elements, such as underlining
- ;; the current tab
- ;;
- ;; `fg-escape-char-construct' and `fg-escape-char-backslash' can
- ;; be combined `bg-main', `bg-dim', `bg-alt'
- ;;
- ;; `fg-lang-error', `fg-lang-warning', `fg-lang-note' can be
- ;; combined with `bg-main', `bg-dim', `bg-alt'
- ;;
- ;; `fg-mark-sel', `fg-mark-del', `fg-mark-alt' can be combined
- ;; with `bg-main', `bg-dim', `bg-alt', `bg-hl-line'
- ;;
- ;; `fg-unfocused' must be combined with `fg-main'
- ;;
- ;; the window divider colours apply to faces with just an fg value
- ;;
- ;; all pairs are combinable with themselves
- ("bg-hl-line" . "#f2eff3")
- ("bg-hl-line-intense" . "#e0e0e0")
- ("bg-hl-alt" . "#fbeee0")
- ("bg-hl-alt-intense" . "#e8dfd1")
- ("bg-paren-match" . "#e0af82")
- ("bg-paren-match-intense" . "#c488ff")
- ("bg-region" . "#bcbcbc")
-
- ("bg-tab-bar" . "#d5d5d5")
- ("bg-tab-active" . "#f6f6f6")
- ("bg-tab-inactive" . "#bdbdbd")
- ("fg-tab-active" . "#30169e")
-
- ("fg-escape-char-construct" . "#8b1030")
- ("fg-escape-char-backslash" . "#654d0f")
+ (unless (and (fboundp 'require-theme)
+ load-file-name
+ (equal (file-name-directory load-file-name)
+ (expand-file-name "themes/" data-directory))
+ (require-theme 'modus-themes t))
+ (require 'modus-themes)))
- ("fg-lang-error" . "#9f004f")
- ("fg-lang-warning" . "#604f0f")
- ("fg-lang-note" . "#4040ae")
-
- ("fg-window-divider-inner" . "#888888")
- ("fg-window-divider-outer" . "#585858")
-
- ("fg-unfocused" . "#56576d")
-
- ("bg-header" . "#e5e5e5") ("fg-header" . "#2a2a2a")
-
- ("bg-whitespace" . "#fff8fc") ("fg-whitespace" . "#645060")
-
- ("bg-diff-heading" . "#b7c2dd") ("fg-diff-heading" . "#043355")
- ("bg-diff-added" . "#d4fad4") ("fg-diff-added" . "#004500")
- ("bg-diff-changed" . "#fcefcf") ("fg-diff-changed" . "#524200")
- ("bg-diff-removed" . "#ffe8ef") ("fg-diff-removed" . "#691616")
-
- ("bg-diff-refine-added" . "#94cf94") ("fg-diff-refine-added" . "#002a00")
- ("bg-diff-refine-changed" . "#cccf8f") ("fg-diff-refine-changed" . "#302010")
- ("bg-diff-refine-removed" . "#daa2b0") ("fg-diff-refine-removed" . "#400000")
-
- ("bg-diff-focus-added" . "#bbeabb") ("fg-diff-focus-added" . "#002c00")
- ("bg-diff-focus-changed" . "#ecdfbf") ("fg-diff-focus-changed" . "#392900")
- ("bg-diff-focus-removed" . "#efcbcf") ("fg-diff-focus-removed" . "#4a0000")
-
- ("bg-diff-neutral-0" . "#979797") ("fg-diff-neutral-0" . "#040404")
- ("bg-diff-neutral-1" . "#b0b0b0") ("fg-diff-neutral-1" . "#252525")
- ("bg-diff-neutral-2" . "#cccccc") ("fg-diff-neutral-2" . "#3a3a3a")
-
- ("bg-mark-sel" . "#a0f0cf") ("fg-mark-sel" . "#005040")
- ("bg-mark-del" . "#ffccbb") ("fg-mark-del" . "#840040")
- ("bg-mark-alt" . "#f5d88f") ("fg-mark-alt" . "#782900"))
- "The entire palette of `modus-operandi-theme'.
-Each element has the form (NAME . HEX).")
-
- (defcustom modus-operandi-theme-override-colors-alist '()
- "Association list of palette colour overrides.
-Values can be mapped to variables, using the same syntax as the
-one present in `modus-operandi-theme-default-colors-alist'.
-
-This is only meant for do-it-yourself usage, with the
-understanding that the user is responsible for the resulting
-contrast ratio between new and existing colours."
- :type '(alist
- :key-type (string :tag "Name")
- :value-type (string :tag " Hex")))
-
- (defmacro modus-operandi-theme-with-color-variables (&rest body)
- "`let' bind all colours around BODY.
-Also bind `class' to ((class color) (min-colors 89))."
- (declare (indent 0))
- `(let ((class '((class color) (min-colors 89)))
- ,@(mapcar (lambda (cons)
- (list (intern (car cons)) (cdr cons)))
- (append modus-operandi-theme-default-colors-alist
- modus-operandi-theme-override-colors-alist))
- ;; simple conditional styles that evaluate user-facing
- ;; customisation options
- (modus-theme-slant
- (if modus-operandi-theme-slanted-constructs 'italic 'normal))
- (modus-theme-variable-pitch
- (if modus-operandi-theme-variable-pitch-headings 'variable-pitch 'default)))
- ,@body)))
-
-
-
-;;; Faces
-
-(modus-operandi-theme-with-color-variables
- (custom-theme-set-faces
- 'modus-operandi
-;;;; custom faces
- ;; these bespoke faces are inherited by other constructs below
-;;;;; subtle coloured backgrounds
- `(modus-theme-subtle-red ((,class :background ,red-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-green ((,class :background ,green-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-blue ((,class :background ,blue-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-magenta ((,class :background ,magenta-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-cyan ((,class :background ,cyan-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-neutral ((,class :background ,bg-inactive :foreground ,fg-inactive)))
-;;;;; intense coloured backgrounds
- `(modus-theme-intense-red ((,class :background ,red-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-green ((,class :background ,green-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-yellow ((,class :background ,yellow-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-blue ((,class :background ,blue-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-magenta ((,class :background ,magenta-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-cyan ((,class :background ,cyan-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-neutral ((,class :background ,bg-active :foreground ,fg-main)))
-;;;;; refined background and foreground combinations
- ;; general purpose styles that use an accented foreground against an
- ;; accented background
- `(modus-theme-refine-red ((,class :background ,red-refine-bg :foreground ,red-refine-fg)))
- `(modus-theme-refine-green ((,class :background ,green-refine-bg :foreground ,green-refine-fg)))
- `(modus-theme-refine-yellow ((,class :background ,yellow-refine-bg :foreground ,yellow-refine-fg)))
- `(modus-theme-refine-blue ((,class :background ,blue-refine-bg :foreground ,blue-refine-fg)))
- `(modus-theme-refine-magenta ((,class :background ,magenta-refine-bg :foreground ,magenta-refine-fg)))
- `(modus-theme-refine-cyan ((,class :background ,cyan-refine-bg :foreground ,cyan-refine-fg)))
-;;;;; "active" combinations, mostly for use on the mode line
- `(modus-theme-active-red ((,class :background ,red-active :foreground ,bg-active)))
- `(modus-theme-active-green ((,class :background ,green-active :foreground ,bg-active)))
- `(modus-theme-active-yellow ((,class :background ,yellow-active :foreground ,bg-active)))
- `(modus-theme-active-blue ((,class :background ,blue-active :foreground ,bg-active)))
- `(modus-theme-active-magenta ((,class :background ,magenta-active :foreground ,bg-active)))
- `(modus-theme-active-cyan ((,class :background ,cyan-active :foreground ,bg-active)))
-;;;;; nuanced backgrounds
- ;; useful for adding an accented background that is suitable for all
- ;; main foreground colours (intended for use in Org source blocks)
- `(modus-theme-nuanced-red ((,class :background ,red-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-green ((,class :background ,green-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-yellow ((,class :background ,yellow-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-blue ((,class :background ,blue-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-magenta ((,class :background ,magenta-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-cyan ((,class :background ,cyan-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
-;;;;; fringe-specific combinations
- `(modus-theme-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-main)))
-;;;;; special base values
- ;; these are closer to the grayscale than the accents defined above
- ;; and should only be used when the next closest alternative would be
- ;; a greyscale value than an accented one
- `(modus-theme-special-cold ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
- `(modus-theme-special-mild ((,class :background ,bg-special-mild :foreground ,fg-special-mild)))
- `(modus-theme-special-warm ((,class :background ,bg-special-warm :foreground ,fg-special-warm)))
- `(modus-theme-special-calm ((,class :background ,bg-special-calm :foreground ,fg-special-calm)))
-;;;;; diff-specific combinations
- ;; intended for `diff-mode' or equivalent
- `(modus-theme-diff-added
- ((,class ,@(modus-operandi-theme-diff
- bg-main green
- bg-diff-focus-added fg-diff-focus-added
- green-nuanced-bg fg-diff-added))))
- `(modus-theme-diff-changed
- ((,class ,@(modus-operandi-theme-diff
- bg-main yellow
- bg-diff-focus-changed fg-diff-focus-changed
- yellow-nuanced-bg fg-diff-changed))))
- `(modus-theme-diff-removed
- ((,class ,@(modus-operandi-theme-diff
- bg-main red
- bg-diff-focus-removed fg-diff-focus-removed
- red-nuanced-bg fg-diff-removed))))
- `(modus-theme-diff-refine-added
- ((,class ,@(modus-operandi-theme-diff
- bg-diff-added fg-diff-added
- bg-diff-refine-added fg-diff-refine-added
- bg-diff-focus-added fg-diff-focus-added))))
- `(modus-theme-diff-refine-changed
- ((,class ,@(modus-operandi-theme-diff
- bg-diff-changed fg-diff-changed
- bg-diff-refine-changed fg-diff-refine-changed
- bg-diff-focus-changed fg-diff-focus-changed))))
- `(modus-theme-diff-refine-removed
- ((,class ,@(modus-operandi-theme-diff
- bg-diff-removed fg-diff-removed
- bg-diff-refine-removed fg-diff-refine-removed
- bg-diff-focus-removed fg-diff-focus-removed))))
- `(modus-theme-diff-focus-added
- ((,class ,@(modus-operandi-theme-diff
- bg-dim green
- bg-diff-focus-added fg-diff-focus-added
- bg-diff-added fg-diff-added))))
- `(modus-theme-diff-focus-changed
- ((,class ,@(modus-operandi-theme-diff
- bg-dim yellow
- bg-diff-focus-changed fg-diff-focus-changed
- bg-diff-changed fg-diff-changed))))
- `(modus-theme-diff-focus-removed
- ((,class ,@(modus-operandi-theme-diff
- bg-dim red
- bg-diff-focus-removed fg-diff-focus-removed
- bg-diff-removed fg-diff-removed))))
- `(modus-theme-diff-heading
- ((,class ,@(modus-operandi-theme-diff
- bg-alt blue-alt
- bg-diff-heading fg-diff-heading
- blue-nuanced-bg blue))))
-;;;;; mark indicators
- ;; colour combinations intended for Dired, Ibuffer, or equivalent
- `(modus-theme-pseudo-header ((,class :inherit bold :foreground ,fg-main)))
- `(modus-theme-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt)))
- `(modus-theme-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del)))
- `(modus-theme-mark-sel ((,class :inherit bold :background ,bg-mark-sel :foreground ,fg-mark-sel)))
- `(modus-theme-mark-symbol ((,class :inherit bold :foreground ,blue-alt)))
-;;;;; heading levels
- ;; styles for regular headings used in Org, Markdown, Info, etc.
- `(modus-theme-heading-1
- ((,class ,@(modus-operandi-theme-heading
- 1 fg-main magenta-alt-other magenta-nuanced-bg bg-region)
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(modus-theme-heading-2
- ((,class ,@(modus-operandi-theme-heading
- 2 fg-special-warm magenta-alt red-nuanced-bg bg-region)
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3))))
- `(modus-theme-heading-3
- ((,class ,@(modus-operandi-theme-heading
- 3 fg-special-cold blue blue-nuanced-bg bg-region)
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2))))
- `(modus-theme-heading-4
- ((,class ,@(modus-operandi-theme-heading
- 4 fg-special-mild cyan cyan-nuanced-bg bg-region)
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1))))
- `(modus-theme-heading-5
- ((,class ,@(modus-operandi-theme-heading
- 5 fg-special-calm green-alt-other green-nuanced-bg bg-region))))
- `(modus-theme-heading-6
- ((,class ,@(modus-operandi-theme-heading
- 6 yellow-nuanced yellow-alt-other yellow-nuanced-bg bg-region))))
- `(modus-theme-heading-7
- ((,class ,@(modus-operandi-theme-heading
- 7 red-nuanced red-alt red-nuanced-bg bg-region))))
- `(modus-theme-heading-8
- ((,class ,@(modus-operandi-theme-heading
- 8 fg-dim magenta bg-alt bg-region))))
-;;;;; other custom faces
- `(modus-theme-hl-line ((,class :background ,(if modus-operandi-theme-intense-hl-line
- bg-hl-line-intense bg-hl-line)
- (and (>= emacs-major-version 27) '(:extend t)))))
-;;;; standard faces
-;;;;; absolute essentials
- `(default ((,class :background ,bg-main :foreground ,fg-main)))
- `(cursor ((,class :background ,fg-main)))
- `(fringe ((,class ,@(modus-operandi-theme-fringe bg-inactive bg-active)
- :foreground ,fg-main)))
- `(vertical-border ((,class :foreground ,fg-window-divider-inner)))
-;;;;; basic and/or ungrouped styles
- ;; Modify the `bold' face to change the weight of all "bold" elements
- ;; defined by the theme. You need a typeface that supports a
- ;; multitude of heavier weights than the regular one and then you
- ;; must specify the exact name of the one you wish to apply. Example
- ;; for your init.el:
- ;;
- ;; (set-face-attribute 'bold nil :weight 'semibold)
- `(bold ((,class :weight bold)))
- `(comint-highlight-input ((,class :inherit bold)))
- `(comint-highlight-prompt ((,class ,@(modus-operandi-theme-bold-weight)
- ,@(modus-operandi-theme-prompt
- cyan
- blue-nuanced-bg blue-alt
- blue-refine-bg fg-main))))
- `(error ((,class :inherit bold :foreground ,red)))
- `(escape-glyph ((,class :foreground ,fg-escape-char-construct)))
- `(file-name-shadow ((,class :foreground ,fg-unfocused)))
- `(header-line ((,class :background ,bg-header :foreground ,fg-header)))
- `(header-line-highlight ((,class :inherit modus-theme-active-blue)))
- `(help-argument-name ((,class :foreground ,cyan :slant ,modus-theme-slant)))
- `(homoglyph ((,class :foreground ,fg-escape-char-construct)))
- `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other)))
- `(italic ((,class :slant italic)))
- `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct)))
- `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t)))
- `(minibuffer-prompt ((,class ,@(modus-operandi-theme-prompt
- cyan-alt-other
- cyan-nuanced-bg cyan
- cyan-refine-bg fg-main))))
- `(mm-command-output ((,class :foreground ,red-alt-other)))
- `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(next-error ((,class :inherit modus-theme-subtle-red)))
- `(rectangle-preview ((,class :inherit modus-theme-special-mild)))
- `(region ((,class :background ,bg-region :foreground ,fg-main)))
- `(secondary-selection ((,class :inherit modus-theme-special-cold)))
- `(shadow ((,class :foreground ,fg-alt)))
- `(success ((,class :inherit bold :foreground ,green)))
- `(trailing-whitespace ((,class :background ,red-intense-bg)))
- `(warning ((,class :inherit bold :foreground ,yellow)))
-;;;;; buttons, links, widgets
- `(button ((,class :foreground ,blue-alt-other
- ,@(unless modus-operandi-theme-no-link-underline
- (list :underline t)))))
- `(link ((,class :inherit button)))
- `(link-visited ((,class :inherit link :foreground ,magenta-alt-other)))
- `(tooltip ((,class :background ,bg-special-cold :foreground ,fg-main)))
- `(widget-button ((,class :inherit button)))
- `(widget-button-pressed ((,class :inherit button :foreground ,magenta)))
- `(widget-documentation ((,class :foreground ,green)))
- `(widget-field ((,class :background ,bg-alt :foreground ,fg-dim)))
- `(widget-inactive ((,class :background ,bg-inactive :foreground ,fg-inactive)))
- `(widget-single-line-field ((,class :inherit widget-field)))
-;;;;; ag
- `(ag-hit-face ((,class :foreground ,fg-special-cold)))
- `(ag-match-face ((,class :inherit modus-theme-special-calm)))
-;;;;; alert
- `(alert-high-face ((,class :inherit bold :foreground ,red-alt)))
- `(alert-low-face ((,class :foreground ,fg-special-mild)))
- `(alert-moderate-face ((,class :inherit bold :foreground ,yellow)))
- `(alert-trivial-face ((,class :foreground ,fg-special-calm)))
- `(alert-urgent-face ((,class :inherit bold :foreground ,red-intense)))
-;;;;; all-the-icons
- `(all-the-icons-blue ((,class :foreground ,blue)))
- `(all-the-icons-blue-alt ((,class :foreground ,blue-alt)))
- `(all-the-icons-cyan ((,class :foreground ,cyan)))
- `(all-the-icons-cyan-alt ((,class :foreground ,cyan-alt)))
- `(all-the-icons-dblue ((,class :foreground ,blue-alt-other)))
- `(all-the-icons-dcyan ((,class :foreground ,cyan-alt-other)))
- `(all-the-icons-dgreen ((,class :foreground ,green-alt-other)))
- `(all-the-icons-dired-dir-face ((,class :foreground ,blue)))
- `(all-the-icons-dmaroon ((,class :foreground ,magenta-alt-other)))
- `(all-the-icons-dorange ((,class :foreground ,red-alt-other)))
- `(all-the-icons-dpink ((,class :foreground ,magenta)))
- `(all-the-icons-dpurple ((,class :foreground ,magenta-alt)))
- `(all-the-icons-dred ((,class :foreground ,red)))
- `(all-the-icons-dsilver ((,class :foreground ,fg-special-cold)))
- `(all-the-icons-dyellow ((,class :foreground ,yellow)))
- `(all-the-icons-green ((,class :foreground ,green)))
- `(all-the-icons-lblue ((,class :foreground ,blue-refine-fg)))
- `(all-the-icons-lcyan ((,class :foreground ,cyan-refine-fg)))
- `(all-the-icons-lgreen ((,class :foreground ,green-refine-fg)))
- `(all-the-icons-lmaroon ((,class :foreground ,magenta-refine-fg)))
- `(all-the-icons-lorange ((,class :foreground ,red-refine-fg)))
- `(all-the-icons-lpink ((,class :foreground ,magenta-refine-fg)))
- `(all-the-icons-lpurple ((,class :foreground ,magenta-refine-fg)))
- `(all-the-icons-lred ((,class :foreground ,red-refine-fg)))
- `(all-the-icons-lsilver ((,class :foreground ,fg-special-cold)))
- `(all-the-icons-lyellow ((,class :foreground ,yellow-refine-fg)))
- `(all-the-icons-maroon ((,class :foreground ,magenta)))
- `(all-the-icons-orange ((,class :foreground ,red-alt)))
- `(all-the-icons-pink ((,class :foreground ,magenta)))
- `(all-the-icons-purple ((,class :foreground ,magenta-alt)))
- `(all-the-icons-purple-alt ((,class :foreground ,magenta-alt-other)))
- `(all-the-icons-red ((,class :foreground ,red)))
- `(all-the-icons-red-alt ((,class :foreground ,red-alt)))
- `(all-the-icons-silver ((,class :foreground ,fg-special-cold)))
- `(all-the-icons-yellow ((,class :foreground ,yellow)))
-;;;;; annotate
- `(annotate-annotation ((,class :inherit modus-theme-subtle-blue)))
- `(annotate-annotation-secondary ((,class :inherit modus-theme-subtle-green)))
- `(annotate-highlight ((,class :background ,blue-nuanced-bg :underline ,blue-intense)))
- `(annotate-highlight-secondary ((,class :background ,green-nuanced-bg :underline ,green-intense)))
-;;;;; anzu
- `(anzu-match-1 ((,class :inherit modus-theme-subtle-cyan)))
- `(anzu-match-2 ((,class :inherit modus-theme-subtle-green)))
- `(anzu-match-3 ((,class :inherit modus-theme-subtle-yellow)))
- `(anzu-mode-line ((,class :inherit bold :foreground ,green-active)))
- `(anzu-mode-line-no-match ((,class :inherit bold :foreground ,red-active)))
- `(anzu-replace-highlight ((,class :inherit modus-theme-refine-yellow :underline t)))
- `(anzu-replace-to ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; apropos
- `(apropos-function-button ((,class :inherit button :foreground ,magenta-alt-other)))
- `(apropos-keybinding ((,class :inherit bold :foreground ,cyan)))
- `(apropos-misc-button ((,class :inherit button :foreground ,cyan-alt-other)))
- `(apropos-property ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt)))
- `(apropos-symbol ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-alt-other)))
- `(apropos-user-option-button ((,class :inherit button :foreground ,green-alt-other)))
- `(apropos-variable-button ((,class :inherit button :foreground ,blue)))
-;;;;; apt-sources-list
- `(apt-sources-list-components ((,class :foreground ,cyan)))
- `(apt-sources-list-options ((,class :foreground ,yellow)))
- `(apt-sources-list-suite ((,class :foreground ,green)))
- `(apt-sources-list-type ((,class :foreground ,magenta)))
- `(apt-sources-list-uri ((,class :foreground ,blue)))
-;;;;; artbollocks-mode
- `(artbollocks-face ((,class :foreground ,cyan-nuanced :underline ,fg-lang-note)))
- `(artbollocks-lexical-illusions-face ((,class :background ,bg-alt :foreground ,red-alt :underline t)))
- `(artbollocks-passive-voice-face ((,class :foreground ,yellow-nuanced :underline ,fg-lang-warning)))
- `(artbollocks-weasel-words-face ((,class :foreground ,red-nuanced :underline ,fg-lang-error)))
-;;;;; auctex and Tex
- `(font-latex-bold-face ((,class :inherit bold :foreground ,fg-special-calm)))
- `(font-latex-doctex-documentation-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(font-latex-doctex-preprocessor-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-alt-other)))
- `(font-latex-italic-face ((,class :foreground ,fg-special-calm :slant italic)))
- `(font-latex-math-face ((,class :foreground ,cyan-alt-other)))
- `(font-latex-script-char-face ((,class :foreground ,cyan-alt-other)))
- `(font-latex-sectioning-0-face ((,class :inherit ,modus-theme-variable-pitch :foreground ,blue-nuanced)))
- `(font-latex-sectioning-1-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-2-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-3-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-4-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-5-face ((,class :inherit ,modus-theme-variable-pitch :foreground ,blue-nuanced)))
- `(font-latex-sedate-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt-other)))
- `(font-latex-slide-title-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,cyan-nuanced
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(font-latex-string-face ((,class :foreground ,blue-alt)))
- `(font-latex-subscript-face ((,class :height 0.95)))
- `(font-latex-superscript-face ((,class :height 0.95)))
- `(font-latex-verbatim-face ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(font-latex-warning-face ((,class :foreground ,yellow-alt-other)))
- `(tex-match ((,class :foreground ,blue-alt-other)))
- `(tex-verbatim ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(texinfo-heading ((,class :foreground ,magenta)))
- `(TeX-error-description-error ((,class :inherit bold :foreground ,red)))
- `(TeX-error-description-help ((,class :foreground ,blue)))
- `(TeX-error-description-tex-said ((,class :foreground ,blue)))
- `(TeX-error-description-warning ((,class :inherit bold :foreground ,yellow)))
-;;;;; auto-dim-other-buffers
- `(auto-dim-other-buffers-face ((,class :background ,bg-alt)))
-;;;;; avy
- `(avy-background-face ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(avy-goto-char-timer-face ((,class :inherit (modus-theme-intense-yellow bold))))
- `(avy-lead-face ((,class :inherit (modus-theme-intense-magenta bold))))
- `(avy-lead-face-0 ((,class :inherit (modus-theme-intense-blue bold))))
- `(avy-lead-face-1 ((,class :inherit (modus-theme-intense-red bold))))
- `(avy-lead-face-2 ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; aw (ace-window)
- `(aw-background-face ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(aw-key-face ((,class :inherit bold :foreground ,blue-intense)))
- `(aw-leading-char-face ((,class :inherit bold :height 1.5 :background ,bg-main :foreground ,red-intense)))
- `(aw-minibuffer-leading-char-face ((,class :foreground ,magenta-active)))
- `(aw-mode-line-face ((,class :inherit bold)))
-;;;;; awesome-tray
- `(awesome-tray-module-awesome-tab-face ((,class :inherit bold :foreground ,red-alt-other)))
- `(awesome-tray-module-battery-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(awesome-tray-module-buffer-name-face ((,class :inherit bold :foreground ,yellow-alt-other)))
- `(awesome-tray-module-circe-face ((,class :inherit bold :foreground ,blue-alt)))
- `(awesome-tray-module-date-face ((,class :inherit bold :foreground ,fg-dim)))
- `(awesome-tray-module-evil-face ((,class :inherit bold :foreground ,green-alt)))
- `(awesome-tray-module-git-face ((,class :inherit bold :foreground ,magenta)))
- `(awesome-tray-module-last-command-face ((,class :inherit bold :foreground ,blue-alt-other)))
- `(awesome-tray-module-location-face ((,class :inherit bold :foreground ,yellow)))
- `(awesome-tray-module-mode-name-face ((,class :inherit bold :foreground ,green)))
- `(awesome-tray-module-parent-dir-face ((,class :inherit bold :foreground ,cyan)))
- `(awesome-tray-module-rvm-face ((,class :inherit bold :foreground ,magenta-alt-other)))
-;;;;; binder
- `(binder-sidebar-highlight ((,class :inherit modus-theme-subtle-cyan)))
- `(binder-sidebar-marked ((,class :inherit modus-theme-mark-sel)))
- `(binder-sidebar-missing ((,class :inherit modus-theme-subtle-red)))
- `(binder-sidebar-tags ((,class :foreground ,cyan)))
-;;;;; bm
- `(bm-face ((,class :inherit modus-theme-subtle-yellow
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(bm-fringe-face ((,class :inherit modus-theme-fringe-yellow)))
- `(bm-fringe-persistent-face ((,class :inherit modus-theme-fringe-blue)))
- `(bm-persistent-face ((,class :inherit modus-theme-intense-blue
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
-;;;;; bongo
- `(bongo-album-title ((,class :foreground ,cyan-active)))
- `(bongo-artist ((,class :foreground ,magenta-active)))
- `(bongo-currently-playing-track ((,class :inherit bold)))
- `(bongo-elapsed-track-part ((,class :inherit modus-theme-subtle-magenta :underline t)))
- `(bongo-filled-seek-bar ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
- `(bongo-marked-track ((,class :foreground ,fg-mark-alt)))
- `(bongo-marked-track-line ((,class :background ,bg-mark-alt)))
- `(bongo-played-track ((,class :foreground ,fg-unfocused :strike-through t)))
- `(bongo-track-length ((,class :foreground ,blue-alt-other)))
- `(bongo-track-title ((,class :foreground ,blue-active)))
- `(bongo-unfilled-seek-bar ((,class :background ,blue-nuanced-bg :foreground ,fg-main)))
-;;;;; boon
- `(boon-modeline-cmd ((,class :inherit modus-theme-active-blue)))
- `(boon-modeline-ins ((,class :inherit modus-theme-active-red)))
- `(boon-modeline-off ((,class :inherit modus-theme-active-yellow)))
- `(boon-modeline-spc ((,class :inherit modus-theme-active-green)))
-;;;;; breakpoint (built-in gdb-mi.el)
- `(breakpoint-disabled ((,class :foreground ,fg-alt)))
- `(breakpoint-enabled ((,class :inherit bold :foreground ,red)))
-;;;;; buffer-expose
- `(buffer-expose-ace-char-face ((,class :inherit bold :foreground ,red-active)))
- `(buffer-expose-mode-line-face ((,class :foreground ,cyan-active)))
- `(buffer-expose-selected-face ((,class :inherit modus-theme-special-mild)))
-;;;;; calendar and diary
- `(calendar-month-header ((,class :inherit bold :foreground ,fg-main)))
- `(calendar-today ((,class :underline t)))
- `(calendar-weekday-header ((,class :foreground ,fg-dim)))
- `(calendar-weekend-header ((,class :foreground ,fg-alt)))
- `(diary ((,class :foreground ,cyan-alt-other)))
- `(diary-anniversary ((,class :foreground ,red-alt-other)))
- `(diary-time ((,class :foreground ,blue-alt)))
- `(holiday ((,class :foreground ,magenta-alt)))
-;;;;; calfw
- `(cfw:face-annotation ((,class :foreground ,fg-special-warm)))
- `(cfw:face-day-title ((,class :foreground ,fg-main)))
- `(cfw:face-default-content ((,class :foreground ,green-alt)))
- `(cfw:face-default-day ((,class :inherit (cfw:face-day-title bold))))
- `(cfw:face-disable ((,class :foreground ,fg-unfocused)))
- `(cfw:face-grid ((,class :foreground ,fg-window-divider-outer)))
- `(cfw:face-header ((,class :inherit bold :foreground ,fg-main)))
- `(cfw:face-holiday ((,class :foreground ,magenta-alt-other)))
- `(cfw:face-periods ((,class :foreground ,cyan-alt-other)))
- `(cfw:face-saturday ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(cfw:face-select ((,class :inherit modus-theme-intense-blue)))
- `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(cfw:face-title ((,class :inherit ,modus-theme-variable-pitch
- :foreground ,fg-special-cold
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-5))))
- `(cfw:face-today ((,class :background ,bg-inactive)))
- `(cfw:face-today-title ((,class :background ,bg-active)))
- `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt)))
- `(cfw:face-toolbar-button-off ((,class :foreground ,fg-alt)))
- `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg
- :foreground ,blue-alt)))
-;;;;; centaur-tabs
- `(centaur-tabs-active-bar-face ((,class :background ,fg-tab-active)))
- `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t)))
- `(centaur-tabs-close-selected ((,class :inherit centaur-tabs-selected)))
- `(centaur-tabs-close-unselected ((,class :inherit centaur-tabs-unselected)))
- `(centaur-tabs-modified-marker-selected ((,class :inherit centaur-tabs-selected)))
- `(centaur-tabs-modified-marker-unselected ((,class :inherit centaur-tabs-unselected)))
- `(centaur-tabs-default ((,class :background ,bg-main :foreground ,bg-main)))
- `(centaur-tabs-selected ((,class :inherit bold :background ,bg-tab-active :foreground ,fg-main)))
- `(centaur-tabs-selected-modified ((,class :background ,bg-tab-active :foreground ,fg-main :slant italic)))
- `(centaur-tabs-unselected ((,class :background ,bg-tab-inactive :foreground ,fg-dim)))
- `(centaur-tabs-unselected-modified ((,class :background ,bg-tab-inactive :foreground ,fg-dim :slant italic)))
-;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
- `(change-log-acknowledgment ((,class :foreground ,fg-alt)))
- `(change-log-conditionals ((,class :foreground ,magenta-alt)))
- `(change-log-date ((,class :foreground ,cyan-alt-other)))
- `(change-log-email ((,class :foreground ,cyan)))
- `(change-log-file ((,class :foreground ,blue)))
- `(change-log-function ((,class :foreground ,green-alt-other)))
- `(change-log-list ((,class :foreground ,magenta-alt-other)))
- `(change-log-name ((,class :foreground ,cyan)))
- `(log-edit-header ((,class :foreground ,fg-special-warm)))
- `(log-edit-summary ((,class :inherit bold :foreground ,cyan)))
- `(log-edit-unknown-header ((,class :foreground ,fg-alt)))
- `(log-view-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(log-view-message ((,class :foreground ,fg-alt)))
-;;;;; cider
- `(cider-debug-code-overlay-face ((,class :background ,bg-alt)))
- `(cider-debug-prompt-face ((,class :foreground ,magenta-alt :underline t)))
- `(cider-deprecated-face ((,class :inherit modus-theme-refine-yellow)))
- `(cider-docview-emphasis-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(cider-docview-literal-face ((,class :foreground ,blue-alt)))
- `(cider-docview-strong-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(cider-docview-table-border-face ((,class :foreground ,fg-alt)))
- `(cider-enlightened-face ((,class :box (:line-width -1 :color ,yellow-alt :style nil) :background ,bg-dim)))
- `(cider-enlightened-local-face ((,class :inherit bold :foreground ,yellow-alt-other)))
- `(cider-error-highlight-face ((,class :foreground ,red :underline t)))
- `(cider-fragile-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,yellow)))
- `(cider-fringe-good-face ((,class :foreground ,green-active)))
- `(cider-instrumented-face ((,class :box (:line-width -1 :color ,red :style nil) :background ,bg-dim)))
- `(cider-reader-conditional-face ((,class :foreground ,fg-special-warm :slant italic)))
- `(cider-repl-input-face ((,class :inherit bold)))
- `(cider-repl-prompt-face ((,class :foreground ,cyan-alt-other)))
- `(cider-repl-stderr-face ((,class :inherit bold :foreground ,red)))
- `(cider-repl-stdout-face ((,class :foreground ,blue)))
- `(cider-result-overlay-face ((,class :box (:line-width -1 :color ,blue :style nil) :background ,bg-dim)))
- `(cider-stacktrace-error-class-face ((,class :inherit bold :foreground ,red)))
- `(cider-stacktrace-error-message-face ((,class :foreground ,red-alt-other :slant italic)))
- `(cider-stacktrace-face ((,class :foreground ,fg-main)))
- `(cider-stacktrace-filter-active-face ((,class :foreground ,cyan-alt :underline t)))
- `(cider-stacktrace-filter-inactive-face ((,class :foreground ,cyan-alt)))
- `(cider-stacktrace-fn-face ((,class :inherit bold :foreground ,fg-main)))
- `(cider-stacktrace-ns-face ((,class :foreground ,fg-alt :slant italic)))
- `(cider-stacktrace-promoted-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,red)))
- `(cider-stacktrace-suppressed-button-face ((,class :box (:line-width 3 :color ,fg-alt :style pressed-button)
- :background ,bg-alt :foreground ,fg-alt)))
- `(cider-test-error-face ((,class :inherit modus-theme-subtle-red)))
- `(cider-test-failure-face ((,class :inherit (modus-theme-intense-red bold))))
- `(cider-test-success-face ((,class :inherit modus-theme-intense-green)))
- `(cider-traced-face ((,class :box (:line-width -1 :color ,cyan :style nil) :background ,bg-dim)))
- `(cider-warning-highlight-face ((,class :foreground ,yellow :underline t)))
-;;;;; circe (and lui)
- `(circe-fool-face ((,class :foreground ,fg-alt)))
- `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue)))
- `(circe-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(circe-server-face ((,class :foreground ,fg-unfocused)))
- `(lui-button-face ((,class :inherit button :foreground ,blue)))
- `(lui-highlight-face ((,class :foreground ,magenta-alt)))
- `(lui-time-stamp-face ((,class :foreground ,blue-nuanced)))
-;;;;; color-rg
- `(color-rg-font-lock-column-number ((,class :foreground ,magenta-alt-other)))
- `(color-rg-font-lock-command ((,class :inherit bold :foreground ,fg-main)))
- `(color-rg-font-lock-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(color-rg-font-lock-flash ((,class :inherit modus-theme-intense-blue)))
- `(color-rg-font-lock-function-location ((,class :inherit modus-theme-special-calm)))
- `(color-rg-font-lock-header-line-directory ((,class :foreground ,blue-active)))
- `(color-rg-font-lock-header-line-edit-mode ((,class :foreground ,magenta-active)))
- `(color-rg-font-lock-header-line-keyword ((,class :foreground ,green-active)))
- `(color-rg-font-lock-header-line-text ((,class :foreground ,fg-active)))
- `(color-rg-font-lock-line-number ((,class :foreground ,fg-special-warm)))
- `(color-rg-font-lock-mark-changed ((,class :inherit bold :foreground ,blue)))
- `(color-rg-font-lock-mark-deleted ((,class :inherit bold :foreground ,red)))
- `(color-rg-font-lock-match ((,class :inherit modus-theme-special-calm)))
- `(color-rg-font-lock-position-splitter ((,class :foreground ,fg-alt)))
-;;;;; column-enforce-mode
- `(column-enforce-face ((,class :inherit modus-theme-refine-yellow)))
-;;;;; company-mode
- `(company-echo-common ((,class :foreground ,magenta-alt-other)))
- `(company-preview ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(company-preview-common ((,class :foreground ,blue-alt)))
- `(company-preview-search ((,class :inherit modus-theme-special-calm)))
- `(company-scrollbar-bg ((,class :background ,bg-active)))
- `(company-scrollbar-fg ((,class :background ,fg-active)))
- `(company-template-field ((,class :inherit modus-theme-intense-magenta)))
- `(company-tooltip ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(company-tooltip-annotation ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(company-tooltip-annotation-selection ((,class :inherit bold :foreground ,fg-main)))
- `(company-tooltip-common ((,class :inherit bold :foreground ,blue-alt)))
- `(company-tooltip-common-selection ((,class :foreground ,fg-main)))
- `(company-tooltip-mouse ((,class :inherit modus-theme-intense-blue)))
- `(company-tooltip-search ((,class :inherit (modus-theme-refine-cyan bold))))
- `(company-tooltip-search-selection ((,class :inherit (modus-theme-intense-green bold) :underline t)))
- `(company-tooltip-selection ((,class :inherit (modus-theme-subtle-cyan bold))))
-;;;;; company-posframe
- `(company-posframe-active-backend-name ((,class :inherit bold :background ,bg-active :foreground ,blue-active)))
- `(company-posframe-inactive-backend-name ((,class :background ,bg-active :foreground ,fg-active)))
- `(company-posframe-metadata ((,class :background ,bg-inactive :foreground ,fg-inactive)))
-;;;;; compilation feedback
- `(compilation-column-number ((,class :foreground ,magenta-alt-other)))
- `(compilation-error ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red)))
- `(compilation-info ((,class :foreground ,fg-special-cold)))
- `(compilation-line-number ((,class :foreground ,fg-special-warm)))
- `(compilation-mode-line-exit ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-active)))
- `(compilation-mode-line-fail ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active)))
- `(compilation-mode-line-run ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-active)))
- `(compilation-warning ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,yellow)))
-;;;;; completions
- `(completions-annotations ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(completions-common-part ((,class ,@(modus-operandi-theme-standard-completions
- blue-alt blue-nuanced-bg
- cyan-refine-bg cyan-refine-fg))))
- `(completions-first-difference ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- magenta-alt blue-nuanced-bg
- magenta-intense-bg fg-main))))
-;;;;; counsel
- `(counsel-active-mode ((,class :foreground ,magenta-alt-other)))
- `(counsel-application-name ((,class :foreground ,red-alt-other)))
- `(counsel-key-binding ((,class :inherit bold :foreground ,blue-alt-other)))
- `(counsel-outline-1 ((,class :inherit outline-1)))
- `(counsel-outline-2 ((,class :inherit outline-2)))
- `(counsel-outline-3 ((,class :inherit outline-3)))
- `(counsel-outline-4 ((,class :inherit outline-4)))
- `(counsel-outline-5 ((,class :inherit outline-5)))
- `(counsel-outline-6 ((,class :inherit outline-6)))
- `(counsel-outline-7 ((,class :inherit outline-7)))
- `(counsel-outline-8 ((,class :inherit outline-8)))
- `(counsel-outline-default ((,class :inherit bold :foreground ,green-alt-other)))
- `(counsel-variable-documentation ((,class :foreground ,yellow-alt-other :slant ,modus-theme-slant)))
-;;;;; counsel-css
- `(counsel-css-selector-depth-face-1 ((,class :foreground ,blue)))
- `(counsel-css-selector-depth-face-2 ((,class :foreground ,cyan)))
- `(counsel-css-selector-depth-face-3 ((,class :foreground ,green)))
- `(counsel-css-selector-depth-face-4 ((,class :foreground ,yellow)))
- `(counsel-css-selector-depth-face-5 ((,class :foreground ,magenta)))
- `(counsel-css-selector-depth-face-6 ((,class :foreground ,red)))
-;;;;; counsel-notmuch
- `(counsel-notmuch-count-face ((,class :foreground ,cyan)))
- `(counsel-notmuch-date-face ((,class :foreground ,blue)))
- `(counsel-notmuch-people-face ((,class :foreground ,magenta)))
- `(counsel-notmuch-subject-face ((,class :foreground ,magenta-alt-other)))
-;;;;; counsel-org-capture-string
- `(counsel-org-capture-string-template-body-face ((,class :foreground ,fg-special-cold)))
-;;;;; cov
- `(cov-coverage-not-run-face ((,class :foreground ,red-intense)))
- `(cov-coverage-run-face ((,class :foreground ,green-intense)))
- `(cov-heavy-face ((,class :foreground ,magenta-intense)))
- `(cov-light-face ((,class :foreground ,blue-intense)))
- `(cov-med-face ((,class :foreground ,yellow-intense)))
- `(cov-none-face ((,class :foreground ,cyan-intense)))
-;;;;; cperl-mode
- `(cperl-nonoverridable-face ((,class :foreground ,yellow-alt-other)))
- `(cperl-array-face ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt)))
- `(cperl-hash-face ((,class :inherit bold :background ,bg-alt :foreground ,red-alt :slant ,modus-theme-slant)))
-;;;;; csv-mode
- `(csv-separator-face ((,class :background ,bg-special-cold :foreground ,fg-main)))
-;;;;; ctrlf
- `(ctrlf-highlight-active ((,class :inherit (modus-theme-intense-green bold))))
- `(ctrlf-highlight-line ((,class :inherit modus-theme-hl-line)))
- `(ctrlf-highlight-passive ((,class :inherit modus-theme-refine-cyan)))
-;;;;; custom (M-x customize)
- `(custom-button ((,class :box (:line-width 2 :color nil :style released-button)
- :background ,bg-active :foreground ,fg-main)))
- `(custom-button-mouse ((,class :box (:line-width 2 :color nil :style released-button)
- :background ,bg-active :foreground ,fg-active)))
- `(custom-button-pressed ((,class :box (:line-width 2 :color nil :style pressed-button)
- :background ,bg-active :foreground ,fg-main)))
- `(custom-changed ((,class :inherit modus-theme-subtle-cyan)))
- `(custom-comment ((,class :foreground ,fg-alt)))
- `(custom-comment-tag ((,class :background ,bg-alt :foreground ,yellow-alt-other)))
- `(custom-face-tag ((,class :inherit bold :foreground ,blue-intense)))
- `(custom-group-tag ((,class :inherit bold :foreground ,green-intense)))
- `(custom-group-tag-1 ((,class :inherit modus-theme-special-warm)))
- `(custom-invalid ((,class :inherit (modus-theme-intense-red bold))))
- `(custom-modified ((,class :inherit modus-theme-subtle-cyan)))
- `(custom-rogue ((,class :inherit modus-theme-refine-magenta)))
- `(custom-set ((,class :foreground ,blue-alt)))
- `(custom-state ((,class :foreground ,cyan-alt-other)))
- `(custom-themed ((,class :inherit modus-theme-subtle-blue)))
- `(custom-variable-tag ((,class :inherit bold :foreground ,cyan)))
-;;;;; dap-mode
- `(dap-mouse-eval-thing-face ((,class :box (:line-width -1 :color ,blue-active :style nil)
- :background ,bg-active :foreground ,fg-main)))
- `(dap-result-overlay-face ((,class :box (:line-width -1 :color ,bg-active :style nil)
- :background ,bg-active :foreground ,fg-main)))
- `(dap-ui-breakpoint-verified-fringe ((,class :inherit bold :foreground ,green-active)))
- `(dap-ui-compile-errline ((,class :inherit bold :foreground ,red-intense)))
- `(dap-ui-locals-scope-face ((,class :inherit bold :foreground ,magenta :underline t)))
- `(dap-ui-locals-variable-face ((,class :inherit bold :foreground ,cyan)))
- `(dap-ui-locals-variable-leaf-face ((,class :foreground ,cyan-alt-other :slant italic)))
- `(dap-ui-marker-face ((,class :inherit modus-theme-subtle-blue)))
- `(dap-ui-sessions-stack-frame-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(dap-ui-sessions-terminated-active-face ((,class :inherit bold :foreground ,fg-alt)))
- `(dap-ui-sessions-terminated-face ((,class :foreground ,fg-alt)))
-;;;;; dashboard (emacs-dashboard)
- `(dashboard-banner-logo-title ((,class :inherit bold :foreground ,fg-special-cold)))
- `(dashboard-footer ((,class :inherit bold :foreground ,fg-special-mild)))
- `(dashboard-heading ((,class :inherit bold :foreground ,fg-special-warm)))
- `(dashboard-navigator ((,class :foreground ,cyan-alt-other)))
- `(dashboard-text-banner ((,class :foreground ,fg-dim)))
-;;;;; deadgrep
- `(deadgrep-filename-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(deadgrep-match-face ((,class :inherit modus-theme-special-calm)))
- `(deadgrep-meta-face ((,class :foreground ,fg-alt)))
- `(deadgrep-regexp-metachar-face ((,class :inherit bold :foreground ,yellow-intense)))
- `(deadgrep-search-term-face ((,class :inherit bold :foreground ,green-intense)))
-;;;;; debbugs
- `(debbugs-gnu-archived ((,class :inverse-video t)))
- `(debbugs-gnu-done ((,class :foreground ,fg-alt)))
- `(debbugs-gnu-forwarded ((,class :foreground ,fg-special-warm)))
- `(debbugs-gnu-handled ((,class :foreground ,green)))
- `(debbugs-gnu-new ((,class :foreground ,red)))
- `(debbugs-gnu-pending ((,class :foreground ,cyan)))
- `(debbugs-gnu-stale-1 ((,class :foreground ,yellow-nuanced)))
- `(debbugs-gnu-stale-2 ((,class :foreground ,yellow)))
- `(debbugs-gnu-stale-3 ((,class :foreground ,yellow-alt)))
- `(debbugs-gnu-stale-4 ((,class :foreground ,yellow-alt-other)))
- `(debbugs-gnu-stale-5 ((,class :foreground ,red-alt)))
- `(debbugs-gnu-tagged ((,class :foreground ,magenta-alt)))
-;;;;; define-word
- `(define-word-face-1 ((,class :foreground ,yellow)))
- `(define-word-face-2 ((,class :foreground ,fg-main)))
-;;;;; deft
- `(deft-filter-string-error-face ((,class :inherit modus-theme-refine-red)))
- `(deft-filter-string-face ((,class :foreground ,green-intense)))
- `(deft-header-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(deft-separator-face ((,class :foreground ,fg-alt)))
- `(deft-summary-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(deft-time-face ((,class :foreground ,fg-special-cold)))
- `(deft-title-face ((,class :inherit bold :foreground ,fg-main)))
-;;;;; dictionary
- `(dictionary-button-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(dictionary-reference-face ((,class :inherit :foreground ,blue-alt-other)))
- `(dictionary-word-definition-face ((,class :foreground ,fg-main)))
- `(dictionary-word-entry-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
-;;;;; diff-hl
- `(diff-hl-change ((,class :inherit modus-theme-fringe-yellow)))
- `(diff-hl-delete ((,class :inherit modus-theme-fringe-red)))
- `(diff-hl-dired-change ((,class :inherit diff-hl-change)))
- `(diff-hl-dired-delete ((,class :inherit diff-hl-delete)))
- `(diff-hl-dired-ignored ((,class :inherit dired-ignored)))
- `(diff-hl-dired-insert ((,class :inherit diff-hl-insert)))
- `(diff-hl-dired-unknown ((,class :inherit dired-ignored)))
- `(diff-hl-insert ((,class :inherit modus-theme-fringe-green)))
- `(diff-hl-reverted-hunk-highlight ((,class :inherit (modus-theme-active-magenta bold))))
-;;;;; diff-mode
- `(diff-added ((,class :inherit modus-theme-diff-added)))
- `(diff-changed ((,class :inherit modus-theme-diff-changed)))
- `(diff-context ((,class :foreground ,fg-unfocused)))
- `(diff-file-header ((,class :inherit bold :foreground ,blue)))
- `(diff-function ((,class :foreground ,fg-special-cold)))
- `(diff-header ((,class :foreground ,blue-nuanced)))
- `(diff-hunk-header ((,class :inherit modus-theme-diff-heading)))
- `(diff-index ((,class :inherit bold :foreground ,blue-alt)))
- `(diff-indicator-added ((,class :inherit diff-added)))
- `(diff-indicator-changed ((,class :inherit diff-changed)))
- `(diff-indicator-removed ((,class :inherit diff-removed)))
- `(diff-nonexistent ((,class :inherit (modus-theme-neutral bold))))
- `(diff-refine-added ((,class :inherit modus-theme-diff-refine-added)))
- `(diff-refine-changed ((,class :inherit modus-theme-diff-refine-changed)))
- `(diff-refine-removed ((,class :inherit modus-theme-diff-refine-removed)))
- `(diff-removed ((,class :inherit modus-theme-diff-removed)))
-;;;;; dim-autoload
- `(dim-autoload-cookie-line ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
-;;;;; dir-treeview
- `(dir-treeview-archive-face ((,class :foreground ,fg-special-warm)))
- `(dir-treeview-archive-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,yellow)))
- `(dir-treeview-audio-face ((,class :foreground ,magenta)))
- `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt)))
- `(dir-treeview-control-face ((,class :foreground ,fg-alt)))
- `(dir-treeview-control-mouse-face ((,class :inherit highlight)))
- `(dir-treeview-default-icon-face ((,class :inherit bold :family "Font Awesome" :foreground ,fg-alt)))
- `(dir-treeview-default-filename-face ((,class :foreground ,fg-main)))
- `(dir-treeview-directory-face ((,class :foreground ,blue)))
- `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt)))
- `(dir-treeview-executable-face ((,class :foreground ,red-alt)))
- `(dir-treeview-executable-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,red-alt-other)))
- `(dir-treeview-image-face ((,class :foreground ,green-alt-other)))
- `(dir-treeview-image-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,green-alt)))
- `(dir-treeview-indent-face ((,class :foreground ,fg-alt)))
- `(dir-treeview-label-mouse-face ((,class :inherit highlight)))
- `(dir-treeview-start-dir-face ((,class :inherit modus-theme-pseudo-header)))
- `(dir-treeview-symlink-face ((,class :inherit button :foreground ,cyan)))
- `(dir-treeview-video-face ((,class :foreground ,magenta-alt-other)))
- `(dir-treeview-video-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt-other)))
-;;;;; dired
- `(dired-directory ((,class :foreground ,blue)))
- `(dired-flagged ((,class :inherit modus-theme-mark-del)))
- `(dired-header ((,class :inherit modus-theme-pseudo-header)))
- `(dired-ignored ((,class :foreground ,fg-alt)))
- `(dired-mark ((,class :inherit modus-theme-mark-symbol)))
- `(dired-marked ((,class :inherit modus-theme-mark-sel)))
- `(dired-perm-write ((,class :foreground ,fg-special-warm)))
- `(dired-symlink ((,class :inherit button :foreground ,cyan-alt)))
- `(dired-warning ((,class :inherit bold :foreground ,yellow)))
-;;;;; dired-async
- `(dired-async-failures ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active)))
- `(dired-async-message ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,green-active)))
- `(dired-async-mode-message ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,cyan-active)))
-;;;;; dired-git
- `(dired-git-branch-else ((,class :inherit bold :foreground ,magenta-alt)))
- `(dired-git-branch-master ((,class :inherit bold :foreground ,magenta-alt-other)))
-;;;;; dired-git-info
- `(dgi-commit-message-face ((,class :foreground ,fg-special-mild)))
-;;;;; dired-narrow
- `(dired-narrow-blink ((,class :inherit (modus-theme-subtle-cyan bold))))
-;;;;; dired-subtree
- ;; remove background from dired-subtree, else it breaks
- ;; dired-{flagged,marked} and any other face that sets a background
- ;; such as hl-line
- `(dired-subtree-depth-1-face ((,class :background nil)))
- `(dired-subtree-depth-2-face ((,class :background nil)))
- `(dired-subtree-depth-3-face ((,class :background nil)))
- `(dired-subtree-depth-4-face ((,class :background nil)))
- `(dired-subtree-depth-5-face ((,class :background nil)))
- `(dired-subtree-depth-6-face ((,class :background nil)))
-;;;;; diredfl
- `(diredfl-autofile-name ((,class :inherit modus-theme-special-cold)))
- `(diredfl-compressed-file-name ((,class :foreground ,fg-special-warm)))
- `(diredfl-compressed-file-suffix ((,class :foreground ,red-alt)))
- `(diredfl-date-time ((,class :foreground ,cyan-alt-other)))
- `(diredfl-deletion ((,class :inherit modus-theme-mark-del)))
- `(diredfl-deletion-file-name ((,class :inherit modus-theme-mark-del)))
- `(diredfl-dir-heading ((,class :inherit modus-theme-pseudo-header)))
- `(diredfl-dir-name ((,class :inherit dired-directory)))
- `(diredfl-dir-priv ((,class :foreground ,blue-alt)))
- `(diredfl-exec-priv ((,class :foreground ,magenta)))
- `(diredfl-executable-tag ((,class :foreground ,magenta-alt)))
- `(diredfl-file-name ((,class :foreground ,fg-main)))
- `(diredfl-file-suffix ((,class :foreground ,cyan)))
- `(diredfl-flag-mark ((,class :inherit modus-theme-mark-sel)))
- `(diredfl-flag-mark-line ((,class :inherit modus-theme-mark-sel)))
- `(diredfl-ignored-file-name ((,class :foreground ,fg-alt)))
- `(diredfl-link-priv ((,class :foreground ,blue-alt-other)))
- `(diredfl-no-priv ((,class :foreground ,fg-alt)))
- `(diredfl-number ((,class :foreground ,cyan-alt)))
- `(diredfl-other-priv ((,class :foreground ,yellow)))
- `(diredfl-rare-priv ((,class :foreground ,red-alt)))
- `(diredfl-read-priv ((,class :foreground ,fg-main)))
- `(diredfl-symlink ((,class :inherit dired-symlink)))
- `(diredfl-tagged-autofile-name ((,class :inherit modus-theme-refine-magenta)))
- `(diredfl-write-priv ((,class :foreground ,cyan)))
-;;;;; disk-usage
- `(disk-usage-children ((,class :foreground ,yellow)))
- `(disk-usage-inaccessible ((,class :inherit bold :foreground ,red)))
- `(disk-usage-percent ((,class :foreground ,green)))
- `(disk-usage-size ((,class :foreground ,cyan)))
- `(disk-usage-symlink ((,class :inherit button :foreground ,blue)))
- `(disk-usage-symlink-directory ((,class :inherit bold :foreground ,blue-alt)))
-;;;;; doom-modeline
- `(doom-modeline-bar ((,class :inherit modus-theme-active-blue)))
- `(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground ,bg-main)))
- `(doom-modeline-battery-charging ((,class :foreground ,green-active)))
- `(doom-modeline-battery-critical ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-battery-error ((,class :inherit bold :box (:line-width -2)
- :foreground ,red-active)))
- `(doom-modeline-battery-full ((,class :foreground ,blue-active)))
- `(doom-modeline-battery-normal ((,class :foreground ,fg-active)))
- `(doom-modeline-battery-warning ((,class :inherit bold :foreground ,yellow-active)))
- `(doom-modeline-buffer-file ((,class :inherit bold :foreground ,fg-active)))
- `(doom-modeline-buffer-major-mode ((,class :inherit bold :foreground ,cyan-active)))
- `(doom-modeline-buffer-minor-mode ((,class :foreground ,fg-inactive)))
- `(doom-modeline-buffer-modified ((,class :inherit bold :foreground ,magenta-active)))
- `(doom-modeline-buffer-path ((,class :inherit bold :foreground ,fg-active)))
- `(doom-modeline-debug ((,class :inherit bold :foreground ,yellow-active)))
- `(doom-modeline-debug-visual ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-evil-emacs-state ((,class :inherit bold :foreground ,magenta-active)))
- `(doom-modeline-evil-insert-state ((,class :inherit bold :foreground ,green-active)))
- `(doom-modeline-evil-motion-state ((,class :inherit bold :foreground ,fg-inactive)))
- `(doom-modeline-evil-normal-state ((,class :inherit bold :foreground ,fg-active)))
- `(doom-modeline-evil-operator-state ((,class :inherit bold :foreground ,blue-active)))
- `(doom-modeline-evil-replace-state ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-evil-visual-state ((,class :inherit bold :foreground ,cyan-active)))
- `(doom-modeline-highlight ((,class :inherit bold :foreground ,blue-active)))
- `(doom-modeline-host ((,class :slant italic)))
- `(doom-modeline-info ((,class :foreground ,green-active)))
- `(doom-modeline-lsp-error ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-lsp-success ((,class :inherit bold :foreground ,green-active)))
- `(doom-modeline-lsp-warning ((,class :inherit bold :foreground ,yellow-active)))
- `(doom-modeline-panel ((,class :inherit modus-theme-active-blue)))
- `(doom-modeline-persp-buffer-not-in-persp ((,class :foreground ,yellow-active :slant italic)))
- `(doom-modeline-persp-name ((,class :foreground ,fg-active)))
- `(doom-modeline-project-dir ((,class :inherit bold :foreground ,blue-active)))
- `(doom-modeline-project-parent-dir ((,class :foreground ,blue-active)))
- `(doom-modeline-project-root-dir ((,class :foreground ,fg-active)))
- `(doom-modeline-unread-number ((,class :foreground ,fg-active :slant italic)))
- `(doom-modeline-urgent ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-warning ((,class :inherit bold :foreground ,yellow-active)))
-;;;;; dynamic-ruler
- `(dynamic-ruler-negative-face ((,class :inherit modus-theme-intense-neutral)))
- `(dynamic-ruler-positive-face ((,class :inherit modus-theme-intense-yellow)))
-;;;;; easy-jekyll
- `(easy-jekyll-help-face ((,class :background ,bg-dim :foreground ,cyan-alt-other)))
-;;;;; easy-kill
- `(easy-kill-origin ((,class :inherit modus-theme-subtle-red)))
- `(easy-kill-selection ((,class :inherit modus-theme-subtle-yellow)))
-;;;;; ebdb
- `(ebdb-address-default ((,class :foreground ,fg-main)))
- `(ebdb-db-char ((,class :foreground ,fg-special-cold)))
- `(ebdb-defunct ((,class :foreground ,fg-alt)))
- `(ebdb-field-hidden ((,class :foreground ,magenta)))
- `(ebdb-field-url ((,class :foreground ,blue)))
- `(ebdb-label ((,class :foreground ,cyan-alt-other)))
- `(ebdb-mail-default ((,class :foreground ,fg-main)))
- `(ebdb-mail-primary ((,class :foreground ,blue-alt)))
- `(ebdb-marked ((,class :background ,cyan-intense-bg)))
- `(ebdb-organization-name ((,class :foreground ,fg-special-calm)))
- `(ebdb-person-name ((,class :foreground ,magenta-alt-other)))
- `(ebdb-phone-default ((,class :foreground ,fg-special-warm)))
- `(ebdb-role-defunct ((,class :foreground ,fg-alt)))
- `(eieio-custom-slot-tag-face ((,class :foreground ,red-alt)))
-;;;;; ediff
- ;; NOTE: here we break from the pattern of inheriting from the
- ;; modus-theme-diff-* faces.
- `(ediff-current-diff-A ((,class ,@(modus-operandi-theme-diff
- bg-dim red
- bg-diff-removed fg-diff-removed
- red-nuanced-bg red-faint))))
- `(ediff-current-diff-Ancestor ((,class ,@(modus-operandi-theme-diff
- bg-dim fg-special-cold
- bg-special-cold fg-special-cold
- blue-nuanced-bg blue))))
- `(ediff-current-diff-B ((,class ,@(modus-operandi-theme-diff
- bg-dim green
- bg-diff-added fg-diff-added
- green-nuanced-bg green-faint))))
- `(ediff-current-diff-C ((,class ,@(modus-operandi-theme-diff
- bg-dim yellow
- bg-diff-changed fg-diff-changed
- yellow-nuanced-bg yellow-faint))))
- `(ediff-even-diff-A ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
- `(ediff-even-diff-Ancestor ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-1)))
- `(ediff-even-diff-B ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
- `(ediff-even-diff-C ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(ediff-fine-diff-A ((,class :background ,bg-diff-focus-removed :foreground ,fg-diff-focus-removed)))
- `(ediff-fine-diff-Ancestor ((,class :inherit modus-theme-refine-cyan)))
- `(ediff-fine-diff-B ((,class :background ,bg-diff-focus-added :foreground ,fg-diff-focus-added)))
- `(ediff-fine-diff-C ((,class :background ,bg-diff-focus-changed :foreground ,fg-diff-focus-changed)))
- `(ediff-odd-diff-A ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(ediff-odd-diff-Ancestor ((,class :background ,bg-diff-neutral-0 :foreground ,fg-diff-neutral-0)))
- `(ediff-odd-diff-B ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(ediff-odd-diff-C ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
-;;;;; eglot
- `(eglot-mode-line ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-active)))
-;;;;; el-search
- `(el-search-highlight-in-prompt-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(el-search-match ((,class :inherit modus-theme-intense-green)))
- `(el-search-other-match ((,class :inherit modus-theme-special-mild)))
- `(el-search-occur-match ((,class :inherit modus-theme-special-calm)))
-;;;;; eldoc
- ;; NOTE: see https://github.com/purcell/package-lint/issues/187
- (list 'eldoc-highlight-function-argument `((,class :inherit bold :foreground ,blue-alt-other)))
-;;;;; eldoc-box
- `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main)))
- `(eldoc-box-border ((,class :background ,fg-alt)))
-;;;;; elfeed
- `(elfeed-log-date-face ((,class :foreground ,cyan-alt)))
- `(elfeed-log-debug-level-face ((,class :foreground ,magenta)))
- `(elfeed-log-error-level-face ((,class :foreground ,red)))
- `(elfeed-log-info-level-face ((,class :foreground ,green)))
- `(elfeed-log-warn-level-face ((,class :foreground ,yellow)))
- `(elfeed-search-date-face ((,class :foreground ,blue-nuanced)))
- `(elfeed-search-feed-face ((,class :foreground ,cyan)))
- `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active)))
- `(elfeed-search-last-update-face ((,class :foreground ,cyan-active)))
- `(elfeed-search-tag-face ((,class :foreground ,blue-nuanced)))
- `(elfeed-search-title-face ((,class :foreground ,fg-dim)))
- `(elfeed-search-unread-count-face ((,class :foreground ,green-active)))
- `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main)))
-;;;;; elfeed-score
- `(elfeed-score-date-face ((,class :foreground ,blue)))
- `(elfeed-score-debug-level-face ((,class :foreground ,magenta-alt-other)))
- `(elfeed-score-error-level-face ((,class :foreground ,red)))
- `(elfeed-score-info-level-face ((,class :foreground ,cyan)))
- `(elfeed-score-warn-level-face ((,class :foreground ,yellow)))
-;;;;; emms
- `(emms-playlist-track-face ((,class :foreground ,blue)))
- `(emms-playlist-selected-face ((,class :inherit bold :foreground ,magenta)))
-;;;;; enhanced-ruby-mode
- `(enh-ruby-heredoc-delimiter-face ((,class :foreground ,blue-alt-other)))
- `(enh-ruby-op-face ((,class :foreground ,fg-main)))
- `(enh-ruby-regexp-delimiter-face ((,class :foreground ,green)))
- `(enh-ruby-regexp-face ((,class :foreground ,magenta)))
- `(enh-ruby-string-delimiter-face ((,class :foreground ,blue-alt)))
- `(erm-syn-errline ((,class :foreground ,red :underline t)))
- `(erm-syn-warnline ((,class :foreground ,yellow :underline t)))
-;;;;; epa
- `(epa-field-body ((,class :foreground ,fg-main)))
- `(epa-field-name ((,class :inherit bold :foreground ,fg-dim)))
- `(epa-mark ((,class :inherit bold :foreground ,magenta)))
- `(epa-string ((,class :foreground ,blue-alt)))
- `(epa-validity-disabled ((,class :inherit modus-theme-refine-red)))
- `(epa-validity-high ((,class :inherit bold :foreground ,green-alt-other)))
- `(epa-validity-low ((,class :foreground ,fg-alt)))
- `(epa-validity-medium ((,class :foreground ,green-alt)))
-;;;;; equake
- `(equake-buffer-face ((,class :background ,bg-main :foreground ,fg-main)))
- `(equake-shell-type-eshell ((,class :background ,bg-inactive :foreground ,green-active)))
- `(equake-shell-type-rash ((,class :background ,bg-inactive :foreground ,red-active)))
- `(equake-shell-type-shell ((,class :background ,bg-inactive :foreground ,cyan-active)))
- `(equake-shell-type-term ((,class :background ,bg-inactive :foreground ,yellow-active)))
- `(equake-shell-type-vterm ((,class :background ,bg-inactive :foreground ,magenta-active)))
- `(equake-tab-active ((,class :background ,fg-alt :foreground ,bg-alt)))
- `(equake-tab-inactive ((,class :foreground ,fg-inactive)))
-;;;;; erc
- `(erc-action-face ((,class :inherit bold :foreground ,cyan)))
- `(erc-bold-face ((,class :inherit bold)))
- `(erc-button ((,class :inherit button)))
- `(erc-command-indicator-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(erc-current-nick-face ((,class :foreground ,magenta-alt-other)))
- `(erc-dangerous-host-face ((,class :inherit modus-theme-intense-red)))
- `(erc-direct-msg-face ((,class :foreground ,magenta)))
- `(erc-error-face ((,class :inherit bold :foreground ,red)))
- `(erc-fool-face ((,class :foreground ,fg-inactive)))
- `(erc-header-line ((,class :background ,bg-header :foreground ,fg-header)))
- `(erc-input-face ((,class :foreground ,fg-special-calm)))
- `(erc-inverse-face ((,class :inherit erc-default-face :inverse-video t)))
- `(erc-keyword-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(erc-my-nick-face ((,class :inherit bold :foreground ,magenta)))
- `(erc-my-nick-prefix-face ((,class :inherit erc-my-nick-face)))
- `(erc-nick-default-face ((,class :inherit bold :foreground ,blue)))
- `(erc-nick-msg-face ((,class :inherit bold :foreground ,green)))
- `(erc-nick-prefix-face ((,class :inherit erc-nick-default-face)))
- `(erc-notice-face ((,class :foreground ,fg-unfocused)))
- `(erc-pal-face ((,class :inherit bold :foreground ,red-alt)))
- `(erc-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(erc-timestamp-face ((,class :foreground ,blue-nuanced)))
- `(erc-underline-face ((,class :underline t)))
- `(bg:erc-color-face0 ((,class :background "white")))
- `(bg:erc-color-face1 ((,class :background "black")))
- `(bg:erc-color-face10 ((,class :background ,cyan-subtle-bg)))
- `(bg:erc-color-face11 ((,class :background ,cyan-intense-bg)))
- `(bg:erc-color-face12 ((,class :background ,blue-subtle-bg)))
- `(bg:erc-color-face13 ((,class :background ,magenta-subtle-bg)))
- `(bg:erc-color-face14 ((,class :background "gray60")))
- `(bg:erc-color-face15 ((,class :background "gray80")))
- `(bg:erc-color-face2 ((,class :background ,blue-intense-bg)))
- `(bg:erc-color-face3 ((,class :background ,green-intense-bg)))
- `(bg:erc-color-face4 ((,class :background ,red-subtle-bg)))
- `(bg:erc-color-face5 ((,class :background ,red-intense-bg)))
- `(bg:erc-color-face6 ((,class :background ,magenta-refine-bg)))
- `(bg:erc-color-face7 ((,class :background ,yellow-subtle-bg)))
- `(bg:erc-color-face8 ((,class :background ,yellow-refine-bg)))
- `(bg:erc-color-face9 ((,class :background ,green-subtle-bg)))
- `(fg:erc-color-face0 ((,class :foreground "white")))
- `(fg:erc-color-face1 ((,class :foreground "black")))
- `(fg:erc-color-face10 ((,class :foreground ,cyan)))
- `(fg:erc-color-face11 ((,class :foreground ,cyan-alt-other)))
- `(fg:erc-color-face12 ((,class :foreground ,blue)))
- `(fg:erc-color-face13 ((,class :foreground ,magenta-alt)))
- `(fg:erc-color-face14 ((,class :foreground "gray60")))
- `(fg:erc-color-face15 ((,class :foreground "gray80")))
- `(fg:erc-color-face2 ((,class :foreground ,blue-alt-other)))
- `(fg:erc-color-face3 ((,class :foreground ,green)))
- `(fg:erc-color-face4 ((,class :foreground ,red)))
- `(fg:erc-color-face5 ((,class :foreground ,red-alt)))
- `(fg:erc-color-face6 ((,class :foreground ,magenta-alt-other)))
- `(fg:erc-color-face7 ((,class :foreground ,yellow-alt-other)))
- `(fg:erc-color-face8 ((,class :foreground ,yellow-alt)))
- `(fg:erc-color-face9 ((,class :foreground ,green-alt-other)))
-;;;;; eros
- `(eros-result-overlay-face ((,class :box (:line-width -1 :color ,blue)
- :background ,bg-dim :foreground ,fg-dim)))
-;;;;; ert
- `(ert-test-result-expected ((,class :inherit modus-theme-intense-green)))
- `(ert-test-result-unexpected ((,class :inherit modus-theme-intense-red)))
-;;;;; eshell
- `(eshell-ls-archive ((,class :inherit bold :foreground ,cyan-alt)))
- `(eshell-ls-backup ((,class :foreground ,yellow-alt)))
- `(eshell-ls-clutter ((,class :foreground ,red-alt)))
- `(eshell-ls-directory ((,class :inherit bold :foreground ,blue-alt)))
- `(eshell-ls-executable ((,class :foreground ,magenta-alt)))
- `(eshell-ls-missing ((,class :inherit modus-theme-intense-red)))
- `(eshell-ls-product ((,class :foreground ,fg-special-warm)))
- `(eshell-ls-readonly ((,class :foreground ,fg-special-cold)))
- `(eshell-ls-special ((,class :inherit bold :foreground ,magenta)))
- `(eshell-ls-symlink ((,class :inherit button :foreground ,cyan)))
- `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive)))
- `(eshell-prompt ((,class ,@(modus-operandi-theme-bold-weight)
- ,@(modus-operandi-theme-prompt
- green-alt-other
- green-nuanced-bg green-alt
- green-refine-bg fg-main))))
-;;;;; eshell-fringe-status
- `(eshell-fringe-status-failure ((,class :foreground ,red)))
- `(eshell-fringe-status-success ((,class :foreground ,green)))
-;;;;; eshell-git-prompt
- `(eshell-git-prompt-add-face ((,class :foreground ,fg-alt)))
- `(eshell-git-prompt-branch-face ((,class :foreground ,fg-alt)))
- `(eshell-git-prompt-directory-face ((,class :foreground ,cyan)))
- `(eshell-git-prompt-exit-fail-face ((,class :foreground ,red)))
- `(eshell-git-prompt-exit-success-face ((,class :foreground ,green)))
- `(eshell-git-prompt-modified-face ((,class :foreground ,yellow)))
- `(eshell-git-prompt-powerline-clean-face ((,class :background ,green-refine-bg)))
- `(eshell-git-prompt-powerline-dir-face ((,class :background ,blue-refine-bg)))
- `(eshell-git-prompt-powerline-not-clean-face ((,class :background ,magenta-refine-bg)))
- `(eshell-git-prompt-robyrussell-branch-face ((,class :foreground ,red)))
- `(eshell-git-prompt-robyrussell-git-dirty-face ((,class :foreground ,yellow)))
- `(eshell-git-prompt-robyrussell-git-face ((,class :foreground ,blue)))
-;;;;; eshell-prompt-extras (epe)
- `(epe-dir-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue)))
- `(epe-git-dir-face ((,class :foreground ,red-alt-other)))
- `(epe-git-face ((,class :foreground ,cyan-alt)))
- `(epe-pipeline-delimiter-face ((,class :foreground ,green-alt)))
- `(epe-pipeline-host-face ((,class :foreground ,blue)))
- `(epe-pipeline-time-face ((,class :foreground ,fg-special-warm)))
- `(epe-pipeline-user-face ((,class :foreground ,magenta)))
- `(epe-remote-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(epe-status-face ((,class :foreground ,magenta-alt-other)))
- `(epe-venv-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
-;;;;; eshell-syntax-highlighting
- `(eshell-syntax-highlighting-alias-face ((,class :foreground ,cyan)))
- `(eshell-syntax-highlighting-comment-face ((,class :foreground ,fg-alt)))
- `(eshell-syntax-highlighting-directory-face ((,class :foreground ,blue)))
- `(eshell-syntax-highlighting-envvar-face ((,class :foreground ,magenta-alt)))
- `(eshell-syntax-highlighting-invalid-face ((,class :foreground ,red)))
- `(eshell-syntax-highlighting-lisp-function-face ((,class :foreground ,magenta)))
- `(eshell-syntax-highlighting-shell-command-face ((,class :foreground ,cyan-alt-other)))
- `(eshell-syntax-highlighting-string-face ((,class :foreground ,blue-alt)))
-;;;;; evil-mode
- `(evil-ex-commands ((,class :foreground ,magenta-alt-other)))
- `(evil-ex-info ((,class :foreground ,cyan-alt-other)))
- `(evil-ex-lazy-highlight ((,class :inherit modus-theme-refine-cyan)))
- `(evil-ex-search ((,class :inherit modus-theme-intense-green)))
- `(evil-ex-substitute-matches ((,class :inherit modus-theme-refine-yellow :underline t)))
- `(evil-ex-substitute-replacement ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; evil-goggles
- `(evil-goggles-change-face ((,class :inherit modus-theme-refine-yellow)))
- `(evil-goggles-commentary-face ((,class :inherit modus-theme-subtle-neutral :slant ,modus-theme-slant)))
- `(evil-goggles-default-face ((,class :inherit modus-theme-subtle-neutral)))
- `(evil-goggles-delete-face ((,class :inherit modus-theme-refine-red)))
- `(evil-goggles-fill-and-move-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-indent-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-join-face ((,class :inherit modus-theme-subtle-green)))
- `(evil-goggles-nerd-commenter-face ((,class :inherit evil-goggles-commentary-face)))
- `(evil-goggles-paste-face ((,class :inherit modus-theme-subtle-cyan)))
- `(evil-goggles-record-macro-face ((,class :inherit modus-theme-special-cold)))
- `(evil-goggles-replace-with-register-face ((,class :inherit modus-theme-refine-magenta)))
- `(evil-goggles-set-marker-face ((,class :inherit modus-theme-intense-magenta)))
- `(evil-goggles-shift-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-surround-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-yank-face ((,class :inherit modus-theme-subtle-blue)))
-;;;;; evil-visual-mark-mode
- `(evil-visual-mark-face ((,class :inherit modus-theme-intense-magenta)))
-;;;;; eww
- `(eww-invalid-certificate ((,class :foreground ,red-active)))
- `(eww-valid-certificate ((,class :foreground ,green-active)))
- `(eww-form-checkbox ((,class :box (:line-width 1 :color ,fg-inactive :style released-button) :background ,bg-inactive :foreground ,fg-main)))
- `(eww-form-file ((,class :box (:line-width 1 :color ,fg-inactive :style released-button) :background ,bg-active :foreground ,fg-main)))
- `(eww-form-select ((,class :inherit eww-form-checkbox)))
- `(eww-form-submit ((,class :inherit eww-form-file)))
- `(eww-form-text ((,class :box (:line-width 1 :color ,fg-inactive :style none) :background ,bg-active :foreground ,fg-active)))
- `(eww-form-textarea ((,class :background ,bg-alt :foreground ,fg-main)))
-;;;;; eyebrowse
- `(eyebrowse-mode-line-active ((,class :inherit bold :foreground ,blue-active)))
-;;;;; fancy-dabbrev
- `(fancy-dabbrev-menu-face ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(fancy-dabbrev-preview-face ((,class :foreground ,fg-alt :underline t)))
- `(fancy-dabbrev-selection-face ((,class :inherit (modus-theme-intense-cyan bold))))
-;;;;; flycheck
- `(flycheck-error
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
- `(flycheck-error-list-checker-name ((,class :foreground ,magenta-active)))
- `(flycheck-error-list-column-number ((,class :foreground ,fg-special-cold)))
- `(flycheck-error-list-error ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red)))
- `(flycheck-error-list-filename ((,class :foreground ,blue)))
- `(flycheck-error-list-highlight ((,class :inherit modus-theme-hl-line)))
- `(flycheck-error-list-id ((,class :foreground ,magenta-alt-other)))
- `(flycheck-error-list-id-with-explainer ((,class :inherit flycheck-error-list-id :box t)))
- `(flycheck-error-list-info ((,class :foreground ,cyan)))
- `(flycheck-error-list-line-number ((,class :foreground ,fg-special-warm)))
- `(flycheck-error-list-warning ((,class :foreground ,yellow)))
- `(flycheck-fringe-error ((,class :inherit modus-theme-fringe-red)))
- `(flycheck-fringe-info ((,class :inherit modus-theme-fringe-cyan)))
- `(flycheck-fringe-warning ((,class :inherit modus-theme-fringe-yellow)))
- `(flycheck-info
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-note :style wave))
- (,class :foreground ,fg-lang-note :underline t)))
- `(flycheck-verify-select-checker ((,class :box (:line-width 1 :color nil :style released-button))))
- `(flycheck-warning
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-warning :style wave))
- (,class :foreground ,fg-lang-warning :underline t)))
-;;;;; flycheck-color-mode-line
- `(flycheck-color-mode-line-error-face ((,class :inherit flycheck-fringe-error)))
- `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-info)))
- `(flycheck-color-mode-line-running-face ((,class :foreground ,fg-inactive :slant italic)))
- `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-warning)))
-;;;;; flycheck-indicator
- `(flycheck-indicator-disabled ((,class :foreground ,fg-inactive :slant ,modus-theme-slant)))
- `(flycheck-indicator-error ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,red-active)))
- `(flycheck-indicator-info ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-active)))
- `(flycheck-indicator-running ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-active)))
- `(flycheck-indicator-success ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,green-active)))
- `(flycheck-indicator-warning ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,yellow-active)))
-;;;;; flycheck-posframe
- `(flycheck-posframe-background-face ((,class :background ,bg-alt)))
- `(flycheck-posframe-border-face ((,class :foreground ,fg-alt)))
- `(flycheck-posframe-error-face ((,class :inherit bold :foreground ,red)))
- `(flycheck-posframe-face ((,class :foreground ,fg-main :slant ,modus-theme-slant)))
- `(flycheck-posframe-info-face ((,class :inherit bold :foreground ,cyan)))
- `(flycheck-posframe-warning-face ((,class :inherit bold :foreground ,yellow)))
-;;;;; flymake
- `(flymake-error
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
- `(flymake-note
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-note :style wave))
- (,class :foreground ,fg-lang-note :underline t)))
- `(flymake-warning
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-warning :style wave))
- (,class :foreground ,fg-lang-warning :underline t)))
-;;;;; flyspell
- `(flyspell-duplicate
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-warning :style wave))
- (,class :foreground ,fg-lang-warning :underline t)))
- `(flyspell-incorrect
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
-;;;;; flyspell-correct
- `(flyspell-correct-highlight-face ((,class :inherit modus-theme-refine-green)))
-;;;;; flx
- `(flx-highlight-face ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-intense-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt
- 'bold))))
-;;;;; freeze-it
- `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm)))
-;;;;; frog-menu
- `(frog-menu-action-keybinding-face ((,class :foreground ,blue-alt-other)))
- `(frog-menu-actions-face ((,class :foreground ,magenta)))
- `(frog-menu-border ((,class :background ,bg-active)))
- `(frog-menu-candidates-face ((,class :foreground ,fg-main)))
- `(frog-menu-posframe-background-face ((,class :background ,bg-dim)))
- `(frog-menu-prompt-face ((,class :foreground ,cyan)))
-;;;;; focus
- `(focus-unfocused ((,class :foreground ,fg-unfocused)))
-;;;;; fold-this
- `(fold-this-overlay ((,class :inherit modus-theme-special-mild)))
-;;;;; font-lock
- `(font-lock-builtin-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(font-lock-comment-delimiter-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(font-lock-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(font-lock-constant-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(font-lock-doc-face ((,class ,@(modus-operandi-theme-syntax-foreground
- fg-special-cold cyan-alt-other-faint)
- :slant ,modus-theme-slant)))
- `(font-lock-function-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(font-lock-keyword-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(font-lock-negation-char-face ((,class ,@(modus-operandi-theme-syntax-foreground
- yellow yellow-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(font-lock-preprocessor-face ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt-other red-alt-other-faint))))
- `(font-lock-regexp-grouping-backslash ((,class :inherit bold :foreground ,fg-escape-char-backslash)))
- `(font-lock-regexp-grouping-construct ((,class :inherit bold :foreground ,fg-escape-char-construct)))
- `(font-lock-string-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt blue-alt-faint))))
- `(font-lock-type-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(font-lock-variable-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint))))
- `(font-lock-warning-face ((,class ,@(modus-operandi-theme-syntax-foreground
- yellow-active yellow-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
-;;;;; forge
- `(forge-post-author ((,class :inherit bold :foreground ,fg-main)))
- `(forge-post-date ((,class :foreground ,fg-special-cold)))
- `(forge-topic-closed ((,class :foreground ,fg-alt)))
- `(forge-topic-merged ((,class :foreground ,fg-alt)))
- `(forge-topic-open ((,class :foreground ,fg-special-mild)))
- `(forge-topic-unmerged ((,class :foreground ,magenta :slant ,modus-theme-slant)))
- `(forge-topic-unread ((,class :inherit bold :foreground ,fg-main)))
-;;;;; fountain-mode
- `(fountain-character ((,class :foreground ,blue-alt-other)))
- `(fountain-comment ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(fountain-dialog ((,class :foreground ,blue-alt)))
- `(fountain-metadata-key ((,class :foreground ,green-alt-other)))
- `(fountain-metadata-value ((,class :foreground ,blue)))
- `(fountain-non-printing ((,class :foreground ,fg-alt)))
- `(fountain-note ((,class :foreground ,yellow :slant ,modus-theme-slant)))
- `(fountain-page-break ((,class :inherit bold :foreground ,red-alt)))
- `(fountain-page-number ((,class :inherit bold :foreground ,red-alt-other)))
- `(fountain-paren ((,class :foreground ,cyan)))
- `(fountain-scene-heading ((,class :inherit bold :foreground ,blue-nuanced)))
- `(fountain-section-heading ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(fountain-section-heading-1 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(fountain-section-heading-2 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-warm
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3))))
- `(fountain-section-heading-3 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-mild
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-2))))
- `(fountain-section-heading-4 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-calm
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-1))))
- `(fountain-section-heading-5 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-calm)))
- `(fountain-synopsis ((,class :foreground ,cyan-alt)))
- `(fountain-trans ((,class :foreground ,yellow-alt-other)))
-;;;;; geiser
- `(geiser-font-lock-autodoc-current-arg ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(geiser-font-lock-autodoc-identifier ((,class ,@(modus-operandi-theme-syntax-foreground
- blue blue-faint))))
- `(geiser-font-lock-doc-button ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt cyan-alt-faint)
- :underline t)))
- `(geiser-font-lock-doc-link ((,class :inherit link)))
- `(geiser-font-lock-error-link ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt red-alt-faint)
- :underline t)))
- `(geiser-font-lock-image-button ((,class ,@(modus-operandi-theme-syntax-foreground
- green-alt green-alt-faint)
- :underline t)))
- `(geiser-font-lock-repl-input ((,class :inherit bold)))
- `(geiser-font-lock-repl-output ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint))))
- `(geiser-font-lock-repl-prompt ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(geiser-font-lock-xref-header ((,class :inherit bold)))
- `(geiser-font-lock-xref-link ((,class :inherit link)))
-;;;;; git-commit
- `(git-commit-comment-action ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-branch-local ((,class :foreground ,blue-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-branch-remote ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-detached ((,class :foreground ,cyan-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-file ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(git-commit-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant)))
- `(git-commit-keyword ((,class :foreground ,magenta)))
- `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other)))
- `(git-commit-nonempty-second-line ((,class :inherit modus-theme-refine-yellow)))
- `(git-commit-overlong-summary ((,class :inherit modus-theme-refine-yellow)))
- `(git-commit-pseudo-header ((,class :foreground ,blue)))
- `(git-commit-summary ((,class :inherit bold :foreground ,cyan)))
-;;;;; git-gutter
- `(git-gutter:added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter:deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter:modified ((,class :inherit modus-theme-fringe-yellow)))
- `(git-gutter:separator ((,class :inherit modus-theme-fringe-cyan)))
- `(git-gutter:unchanged ((,class :inherit modus-theme-fringe-magenta)))
-;;;;; git-gutter-fr
- `(git-gutter-fr:added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter-fr:deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter-fr:modified ((,class :inherit modus-theme-fringe-yellow)))
-;;;;; git-{gutter,fringe}+
- `(git-gutter+-added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter+-deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter+-modified ((,class :inherit modus-theme-fringe-yellow)))
- `(git-gutter+-separator ((,class :inherit modus-theme-fringe-cyan)))
- `(git-gutter+-unchanged ((,class :inherit modus-theme-fringe-magenta)))
- `(git-gutter-fr+-added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter-fr+-deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter-fr+-modified ((,class :inherit modus-theme-fringe-yellow)))
-;;;;; git-lens
- `(git-lens-added ((,class :inherit bold :foreground ,green)))
- `(git-lens-deleted ((,class :inherit bold :foreground ,red)))
- `(git-lens-header ((,class :inherit bold :height 1.1 :foreground ,cyan)))
- `(git-lens-modified ((,class :inherit bold :foreground ,yellow)))
- `(git-lens-renamed ((,class :inherit bold :foreground ,magenta)))
-;;;;; git-rebase
- `(git-rebase-comment-hash ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(git-rebase-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant)))
- `(git-rebase-description ((,class :foreground ,fg-main)))
- `(git-rebase-hash ((,class :foreground ,cyan-alt-other)))
-;;;;; git-timemachine
- `(git-timemachine-commit ((,class :inherit bold :foreground ,yellow-active)))
- `(git-timemachine-minibuffer-author-face ((,class :foreground ,fg-special-warm)))
- `(git-timemachine-minibuffer-detail-face ((,class :foreground ,red-alt)))
-;;;;; git-walktree
- `(git-walktree-commit-face ((,class :foreground ,yellow)))
- `(git-walktree-symlink-face ((,class :inherit button :foreground ,cyan)))
- `(git-walktree-tree-face ((,class :foreground ,magenta)))
-;;;;; gnus
- `(gnus-button ((,class :inherit button)))
- `(gnus-cite-1 ((,class :foreground ,blue-alt)))
- `(gnus-cite-10 ((,class :foreground ,magenta-alt-other)))
- `(gnus-cite-11 ((,class :foreground ,yellow-alt-other)))
- `(gnus-cite-2 ((,class :foreground ,red-alt)))
- `(gnus-cite-3 ((,class :foreground ,green-alt)))
- `(gnus-cite-4 ((,class :foreground ,magenta-alt)))
- `(gnus-cite-5 ((,class :foreground ,yellow-alt)))
- `(gnus-cite-6 ((,class :foreground ,cyan-alt)))
- `(gnus-cite-7 ((,class :foreground ,blue-alt-other)))
- `(gnus-cite-8 ((,class :foreground ,red-alt-other)))
- `(gnus-cite-9 ((,class :foreground ,green-alt-other)))
- `(gnus-cite-attribution ((,class :foreground ,fg-main :slant italic)))
- `(gnus-emphasis-highlight-words ((,class :inherit modus-theme-refine-yellow)))
- `(gnus-group-mail-1 ((,class :inherit bold :foreground ,magenta-alt)))
- `(gnus-group-mail-1-empty ((,class :foreground ,magenta-alt)))
- `(gnus-group-mail-2 ((,class :inherit bold :foreground ,magenta)))
- `(gnus-group-mail-2-empty ((,class :foreground ,magenta)))
- `(gnus-group-mail-3 ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(gnus-group-mail-3-empty ((,class :foreground ,magenta-alt-other)))
- `(gnus-group-mail-low ((,class :inherit bold :foreground ,magenta-nuanced)))
- `(gnus-group-mail-low-empty ((,class :foreground ,magenta-nuanced)))
- `(gnus-group-news-1 ((,class :inherit bold :foreground ,green)))
- `(gnus-group-news-1-empty ((,class :foreground ,green)))
- `(gnus-group-news-2 ((,class :inherit bold :foreground ,cyan)))
- `(gnus-group-news-2-empty ((,class :foreground ,cyan)))
- `(gnus-group-news-3 ((,class :inherit bold :foreground ,yellow-nuanced)))
- `(gnus-group-news-3-empty ((,class :foreground ,yellow-nuanced)))
- `(gnus-group-news-4 ((,class :inherit bold :foreground ,cyan-nuanced)))
- `(gnus-group-news-4-empty ((,class :foreground ,cyan-nuanced)))
- `(gnus-group-news-5 ((,class :inherit bold :foreground ,red-nuanced)))
- `(gnus-group-news-5-empty ((,class :foreground ,red-nuanced)))
- `(gnus-group-news-6 ((,class :inherit bold :foreground ,fg-alt)))
- `(gnus-group-news-6-empty ((,class :foreground ,fg-alt)))
- `(gnus-group-news-low ((,class :inherit bold :foreground ,green-nuanced)))
- `(gnus-group-news-low-empty ((,class :foreground ,green-nuanced)))
- `(gnus-header-content ((,class :foreground ,cyan)))
- `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt-other :underline nil)))
- `(gnus-header-name ((,class :foreground ,green)))
- `(gnus-header-newsgroups ((,class :inherit bold :foreground ,blue-alt)))
- `(gnus-header-subject ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(gnus-server-agent ((,class :inherit bold :foreground ,cyan)))
- `(gnus-server-closed ((,class :inherit bold :foreground ,magenta)))
- `(gnus-server-cloud ((,class :inherit bold :foreground ,cyan-alt)))
- `(gnus-server-cloud-host ((,class :inherit modus-theme-refine-cyan)))
- `(gnus-server-denied ((,class :inherit bold :foreground ,red)))
- `(gnus-server-offline ((,class :inherit bold :foreground ,yellow)))
- `(gnus-server-opened ((,class :inherit bold :foreground ,green)))
- `(gnus-signature ((,class :foreground ,fg-special-cold :slant italic)))
- `(gnus-splash ((,class :foreground ,fg-alt)))
- `(gnus-summary-cancelled ((,class :inherit modus-theme-mark-alt)))
- `(gnus-summary-high-ancient ((,class :inherit bold :foreground ,fg-alt)))
- `(gnus-summary-high-read ((,class :inherit bold :foreground ,fg-special-cold)))
- `(gnus-summary-high-ticked ((,class :inherit bold :foreground ,red-alt-other)))
- `(gnus-summary-high-undownloaded ((,class :inherit bold :foreground ,yellow)))
- `(gnus-summary-high-unread ((,class :inherit bold :foreground ,fg-main)))
- `(gnus-summary-low-ancient ((,class :foreground ,fg-alt :slant italic)))
- `(gnus-summary-low-read ((,class :foreground ,fg-alt :slant italic)))
- `(gnus-summary-low-ticked ((,class :foreground ,red-refine-fg :slant italic)))
- `(gnus-summary-low-undownloaded ((,class :foreground ,yellow-refine-fg :slant italic)))
- `(gnus-summary-low-unread ((,class :inherit bold :foreground ,fg-special-cold)))
- `(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm)))
- `(gnus-summary-normal-read ((,class :foreground ,fg-alt)))
- `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other)))
- `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow)))
- `(gnus-summary-normal-unread ((,class :foreground ,fg-main)))
- `(gnus-summary-selected ((,class :inherit modus-theme-subtle-blue)))
-;;;;; golden-ratio-scroll-screen
- `(golden-ratio-scroll-highlight-line-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
-;;;;; helm
- `(helm-M-x-key ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(helm-action ((,class :underline t)))
- `(helm-bookmark-addressbook ((,class :foreground ,green-alt)))
- `(helm-bookmark-directory ((,class :inherit bold :foreground ,blue)))
- `(helm-bookmark-file ((,class :foreground ,fg-main)))
- `(helm-bookmark-file-not-found ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(helm-bookmark-gnus ((,class :foreground ,magenta)))
- `(helm-bookmark-info ((,class :foreground ,cyan-alt)))
- `(helm-bookmark-man ((,class :foreground ,yellow-alt)))
- `(helm-bookmark-w3m ((,class :foreground ,blue-alt)))
- `(helm-buffer-archive ((,class :inherit bold :foreground ,cyan)))
- `(helm-buffer-directory ((,class :inherit bold :foreground ,blue)))
- `(helm-buffer-file ((,class :foreground ,fg-main)))
- `(helm-buffer-modified ((,class :foreground ,yellow-alt)))
- `(helm-buffer-not-saved ((,class :foreground ,red-alt)))
- `(helm-buffer-process ((,class :foreground ,magenta)))
- `(helm-buffer-saved-out ((,class :inherit bold :background ,bg-alt :foreground ,red)))
- `(helm-buffer-size ((,class :foreground ,fg-alt)))
- `(helm-candidate-number ((,class :foreground ,cyan-active)))
- `(helm-candidate-number-suspended ((,class :foreground ,yellow-active)))
- `(helm-comint-prompts-buffer-name ((,class :foreground ,green-active)))
- `(helm-comint-prompts-promptidx ((,class :foreground ,cyan-active)))
- `(helm-delete-async-message ((,class :inherit bold :foreground ,magenta-active)))
- `(helm-eob-line ((,class :background ,bg-main :foreground ,fg-main)))
- `(helm-eshell-prompts-buffer-name ((,class :foreground ,green-active)))
- `(helm-eshell-prompts-promptidx ((,class :foreground ,cyan-active)))
- `(helm-etags-file ((,class :foreground ,fg-dim :underline t)))
- `(helm-ff-backup-file ((,class :foreground ,fg-alt)))
- `(helm-ff-denied ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-red
- 'modus-theme-intense-red
- 'modus-theme-nuanced-red
- red))))
- `(helm-ff-directory ((,class :inherit helm-buffer-directory)))
- `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other)))
- `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt)))
- `(helm-ff-dotted-symlink-directory ((,class :inherit (button helm-ff-dotted-directory))))
- `(helm-ff-executable ((,class :foreground ,magenta-alt)))
- `(helm-ff-file ((,class :foreground ,fg-main)))
- `(helm-ff-file-extension ((,class :foreground ,fg-special-warm)))
- `(helm-ff-invalid-symlink ((,class :inherit button :foreground ,red)))
- `(helm-ff-pipe ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-refine-magenta
- 'modus-theme-subtle-magenta
- 'modus-theme-nuanced-magenta
- magenta))))
- `(helm-ff-prefix ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-refine-yellow
- 'modus-theme-subtle-yellow
- 'modus-theme-nuanced-yellow
- yellow-alt-other))))
- `(helm-ff-socket ((,class :foreground ,red-alt-other)))
- `(helm-ff-suid ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-red
- 'modus-theme-refine-red
- 'modus-theme-nuanced-yellow
- red-alt))))
- `(helm-ff-symlink ((,class :inherit button :foreground ,cyan)))
- `(helm-ff-truename ((,class :foreground ,blue-alt-other)))
- `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other)))
- `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(helm-grep-finish ((,class :foreground ,green-active)))
- `(helm-grep-lineno ((,class :foreground ,fg-special-warm)))
- `(helm-grep-match ((,class :inherit modus-theme-special-calm)))
- `(helm-header ((,class :inherit bold :foreground ,fg-special-cold)))
- `(helm-header-line-left-margin ((,class :inherit bold :foreground ,yellow-intense)))
- `(helm-history-deleted ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-red
- 'modus-theme-intense-red
- 'modus-theme-nuanced-red
- red
- 'bold))))
- `(helm-history-remote ((,class :foreground ,red-alt-other)))
- `(helm-lisp-completion-info ((,class :foreground ,fg-special-warm)))
- `(helm-lisp-show-completion ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-yellow
- 'modus-theme-refine-yellow
- 'modus-theme-nuanced-yellow
- yellow
- 'bold))))
- `(helm-locate-finish ((,class :foreground ,green-active)))
- `(helm-match ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-cyan
- 'modus-theme-refine-cyan
- 'modus-theme-nuanced-cyan
- cyan
- 'bold))))
- `(helm-match-item ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-neutral
- 'modus-theme-subtle-cyan
- 'modus-theme-nuanced-cyan
- cyan-alt-other))))
- `(helm-minibuffer-prompt ((,class :inherit minibuffer-prompt)))
- `(helm-moccur-buffer ((,class :inherit button :foreground ,cyan-alt-other)))
- `(helm-mode-prefix ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-intense-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt
- 'bold))))
- `(helm-non-file-buffer ((,class :foreground ,fg-alt)))
- `(helm-prefarg ((,class :foreground ,red-active)))
- `(helm-resume-need-update ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other))))
- `(helm-selection ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-refine-blue
- 'modus-theme-special-cold
- nil
- 'bold))))
- `(helm-selection-line ((,class :inherit modus-theme-special-cold)))
- `(helm-separator ((,class :foreground ,fg-special-mild)))
- `(helm-time-zone-current ((,class :foreground ,green)))
- `(helm-time-zone-home ((,class :foreground ,magenta)))
- `(helm-source-header ((,class :inherit bold :foreground ,red-alt
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(helm-top-columns ((,class :inherit helm-header)))
- `(helm-ucs-char ((,class :foreground ,yellow-alt-other)))
- `(helm-visible-mark ((,class :inherit modus-theme-subtle-cyan)))
-;;;;; helm-ls-git
- `(helm-ls-git-added-copied-face ((,class :foreground ,green-intense)))
- `(helm-ls-git-added-modified-face ((,class :foreground ,yellow-intense)))
- `(helm-ls-git-conflict-face ((,class :inherit bold :foreground ,red-intense)))
- `(helm-ls-git-deleted-and-staged-face ((,class :foreground ,red-nuanced)))
- `(helm-ls-git-deleted-not-staged-face ((,class :foreground ,red)))
- `(helm-ls-git-modified-and-staged-face ((,class :foreground ,yellow-nuanced)))
- `(helm-ls-git-modified-not-staged-face ((,class :foreground ,yellow)))
- `(helm-ls-git-renamed-modified-face ((,class :foreground ,magenta)))
- `(helm-ls-git-untracked-face ((,class :foreground ,fg-special-cold)))
-;;;;; helm-switch-shell
- `(helm-switch-shell-new-shell-face ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other
- 'bold))))
-;;;;; helm-xref
- `(helm-xref-file-name ((,class :inherit bold :foreground ,fg-special-cold)))
- `(helm-xref-file-name ((,class :foreground ,fg-special-warm)))
-;;;;; helpful
- `(helpful-heading ((,class :inherit modus-theme-heading-1)))
-;;;;; highlight region or ad-hoc regexp
- `(hi-black-b ((,class :background ,fg-main :foreground ,bg-main)))
- `(hi-blue ((,class :background ,bg-alt :foreground ,blue :underline t)))
- `(hi-blue-b ((,class :inherit modus-theme-intense-blue)))
- `(hi-green ((,class :background ,bg-alt :foreground ,green :underline t)))
- `(hi-green-b ((,class :inherit modus-theme-intense-green)))
- `(hi-pink ((,class :background ,bg-alt :foreground ,magenta :underline t)))
- `(hi-red-b ((,class :inherit modus-theme-intense-red)))
- `(hi-yellow ((,class :background ,bg-alt :foreground ,yellow :underline t)))
- `(highlight ((,class :inherit modus-theme-subtle-blue)))
- `(highlight-changes ((,class :foreground ,yellow-alt-other)))
- `(highlight-changes-delete ((,class :foreground ,red-alt-other :underline t)))
- `(hl-line ((,class :inherit modus-theme-hl-line)))
-;;;;; highlight-blocks
- `(highlight-blocks-depth-1-face ((,class :background ,bg-dim :foreground ,fg-main)))
- `(highlight-blocks-depth-2-face ((,class :background ,bg-alt :foreground ,fg-main)))
- `(highlight-blocks-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-main)))
- `(highlight-blocks-depth-4-face ((,class :background ,bg-special-calm :foreground ,fg-main)))
- `(highlight-blocks-depth-5-face ((,class :background ,bg-special-warm :foreground ,fg-main)))
- `(highlight-blocks-depth-6-face ((,class :background ,bg-special-mild :foreground ,fg-main)))
- `(highlight-blocks-depth-7-face ((,class :background ,bg-inactive :foreground ,fg-main)))
- `(highlight-blocks-depth-8-face ((,class :background ,bg-active :foreground ,fg-main)))
- `(highlight-blocks-depth-9-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
-;;;;; highlight-defined
- `(highlight-defined-builtin-function-name-face ((,class :foreground ,magenta)))
- `(highlight-defined-face-name-face ((,class :foreground ,fg-main)))
- `(highlight-defined-function-name-face ((,class :foreground ,magenta)))
- `(highlight-defined-macro-name-face ((,class :foreground ,magenta-alt)))
- `(highlight-defined-special-form-name-face ((,class :foreground ,magenta-alt-other)))
- `(highlight-defined-variable-name-face ((,class :foreground ,cyan)))
-;;;;; highlight-escape-sequences (`hes-mode')
- `(hes-escape-backslash-face ((,class :inherit bold :foreground ,fg-escape-char-construct)))
- `(hes-escape-sequence-face ((,class :inherit bold :foreground ,fg-escape-char-backslash)))
-;;;;; highlight-indentation
- `(highlight-indentation-face ((,class :inherit modus-theme-hl-line)))
- `(highlight-indentation-current-column-face ((,class :background ,bg-active)))
-;;;;; highlight-numbers
- `(highlight-numbers-number ((,class :foreground ,blue-alt-other)))
-;;;;; highlight-symbol
- `(highlight-symbol-face ((,class :inherit modus-theme-special-mild)))
-;;;;; highlight-thing
- `(highlight-thing ((,class :background ,bg-alt :foreground ,cyan)))
-;;;;; hl-defined
- `(hdefd-functions ((,class :foreground ,blue)))
- `(hdefd-undefined ((,class :foreground ,red-alt)))
- `(hdefd-variables ((,class :foreground ,cyan-alt)))
-;;;;; hl-fill-column
- `(hl-fill-column-face ((,class :background ,bg-active :foreground ,fg-active)))
-;;;;; hl-todo
- `(hl-todo ((,class :inherit bold :foreground ,red-alt-other :slant ,modus-theme-slant)))
-;;;;; hydra
- `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow)))
- `(hydra-face-blue ((,class :inherit bold :foreground ,blue-alt)))
- `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt)))
- `(hydra-face-red ((,class :inherit bold :foreground ,red)))
- `(hydra-face-teal ((,class :inherit bold :foreground ,cyan)))
-;;;;; hyperlist
- `(hyperlist-condition ((,class :foreground ,green)))
- `(hyperlist-hashtag ((,class :foreground ,yellow)))
- `(hyperlist-operator ((,class :foreground ,blue-alt)))
- `(hyperlist-paren ((,class :foreground ,cyan-alt-other)))
- `(hyperlist-quote ((,class :foreground ,cyan-alt)))
- `(hyperlist-ref ((,class :foreground ,magenta-alt-other)))
- `(hyperlist-stars ((,class :foreground ,fg-alt)))
- `(hyperlist-tag ((,class :foreground ,red)))
- `(hyperlist-toplevel ((,class :inherit bold :foreground ,fg-main)))
-;;;;; icomplete
- `(icomplete-first-match ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- magenta bg-alt
- bg-active fg-main))))
-;;;;; icomplete-vertical
- `(icomplete-vertical-separator ((,class :foreground ,fg-alt)))
-;;;;; ido-mode
- `(ido-first-match ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- magenta bg-alt
- bg-active fg-main))))
- `(ido-incomplete-regexp ((,class :inherit error)))
- `(ido-indicator ((,class :inherit modus-theme-subtle-yellow)))
- `(ido-only-match ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- green green-nuanced-bg
- green-intense-bg fg-main))))
- `(ido-subdir ((,class :foreground ,blue)))
- `(ido-virtual ((,class :foreground ,fg-special-warm)))
-;;;;; iedit
- `(iedit-occurrence ((,class :inherit modus-theme-refine-blue)))
- `(iedit-read-only-occurrence ((,class :inherit modus-theme-intense-yellow)))
-;;;;; iflipb
- `(iflipb-current-buffer-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(iflipb-other-buffer-face ((,class :foreground ,fg-alt)))
-;;;;; imenu-list
- `(imenu-list-entry-face-0 ((,class :foreground ,cyan)))
- `(imenu-list-entry-face-1 ((,class :foreground ,blue)))
- `(imenu-list-entry-face-2 ((,class :foreground ,cyan-alt-other)))
- `(imenu-list-entry-face-3 ((,class :foreground ,blue-alt)))
- `(imenu-list-entry-subalist-face-0 ((,class :inherit bold :foreground ,magenta-alt-other :underline t)))
- `(imenu-list-entry-subalist-face-1 ((,class :inherit bold :foreground ,magenta :underline t)))
- `(imenu-list-entry-subalist-face-2 ((,class :inherit bold :foreground ,green-alt-other :underline t)))
- `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t)))
-;;;;; indium
- `(indium-breakpoint-face ((,class :foreground ,red-active)))
- `(indium-frame-url-face ((,class :inherit button :foreground ,fg-alt)))
- `(indium-keyword-face ((,class :foreground ,magenta-alt-other)))
- `(indium-litable-face ((,class :foreground ,fg-special-warm :slant ,modus-theme-slant)))
- `(indium-repl-error-face ((,class :inherit bold :foreground ,red)))
- `(indium-repl-prompt-face ((,class :foreground ,cyan-alt-other)))
- `(indium-repl-stdout-face ((,class :foreground ,fg-main)))
-;;;;; info
- `(Info-quoted ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,magenta))) ; the capitalisation is canonical
- `(info-header-node ((,class :inherit bold :foreground ,fg-alt)))
- `(info-header-xref ((,class :foreground ,blue-active)))
- `(info-index-match ((,class :inherit match)))
- `(info-menu-header ((,class :inherit modus-theme-heading-3)))
- `(info-menu-star ((,class :foreground ,red)))
- `(info-node ((,class :inherit bold)))
- `(info-title-1 ((,class :inherit modus-theme-heading-1)))
- `(info-title-2 ((,class :inherit modus-theme-heading-2)))
- `(info-title-3 ((,class :inherit modus-theme-heading-3)))
- `(info-title-4 ((,class :inherit modus-theme-heading-4)))
-;;;;; info-colors
- `(info-colors-lisp-code-block ((,class :inherit fixed-pitch)))
- `(info-colors-ref-item-command ((,class :foreground ,magenta)))
- `(info-colors-ref-item-constant ((,class :foreground ,blue-alt-other)))
- `(info-colors-ref-item-function ((,class :foreground ,magenta)))
- `(info-colors-ref-item-macro ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt-other)))
- `(info-colors-ref-item-other ((,class :foreground ,cyan)))
- `(info-colors-ref-item-special-form ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt-other)))
- `(info-colors-ref-item-syntax-class ((,class :foreground ,magenta)))
- `(info-colors-ref-item-type ((,class :foreground ,magenta-alt)))
- `(info-colors-ref-item-user-option ((,class :foreground ,cyan)))
- `(info-colors-ref-item-variable ((,class :foreground ,cyan)))
-;;;;; interaction-log
- `(ilog-buffer-face ((,class :foreground ,magenta-alt-other)))
- `(ilog-change-face ((,class :foreground ,magenta-alt)))
- `(ilog-echo-face ((,class :foreground ,yellow-alt-other)))
- `(ilog-load-face ((,class :foreground ,green)))
- `(ilog-message-face ((,class :foreground ,fg-alt)))
- `(ilog-non-change-face ((,class :foreground ,blue)))
-;;;;; ioccur
- `(ioccur-cursor ((,class :foreground ,fg-main)))
- `(ioccur-invalid-regexp ((,class :foreground ,red)))
- `(ioccur-match-face ((,class :inherit modus-theme-special-calm)))
- `(ioccur-match-overlay-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :inherit modus-theme-special-cold)))
- `(ioccur-num-line-face ((,class :foreground ,fg-special-warm)))
- `(ioccur-overlay-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :inherit modus-theme-refine-blue)))
- `(ioccur-regexp-face ((,class :inherit (modus-theme-intense-magenta bold))))
- `(ioccur-title-face ((,class :inherit bold :foreground ,red-alt
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
-;;;;; isearch, occur, and the like
- `(isearch ((,class :inherit (modus-theme-intense-green bold))))
- `(isearch-fail ((,class :inherit modus-theme-refine-red)))
- `(lazy-highlight ((,class :inherit modus-theme-refine-cyan)))
- `(match ((,class :inherit modus-theme-special-calm)))
- `(query-replace ((,class :inherit (modus-theme-intense-yellow bold))))
-;;;;; ivy
- `(ivy-action ((,class :inherit bold :foreground ,red-alt)))
- `(ivy-completions-annotations ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(ivy-confirm-face ((,class :foreground ,cyan)))
- `(ivy-current-match ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-refine-cyan
- 'modus-theme-intense-cyan
- 'modus-theme-special-warm
- nil
- 'bold))))
- `(ivy-cursor ((,class :background ,fg-main :foreground ,bg-main)))
- `(ivy-grep-info ((,class :foreground ,cyan-alt)))
- `(ivy-grep-line-number ((,class :foreground ,fg-special-warm)))
- `(ivy-highlight-face ((,class :foreground ,magenta)))
- `(ivy-match-required-face ((,class :inherit error)))
- `(ivy-minibuffer-match-face-1 ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-neutral
- 'modus-theme-intense-neutral
- 'modus-theme-subtle-neutral
- fg-alt))))
- `(ivy-minibuffer-match-face-2 ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-green
- 'modus-theme-refine-green
- 'modus-theme-nuanced-green
- green-alt-other
- 'bold))))
- `(ivy-minibuffer-match-face-3 ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-cyan
- 'modus-theme-refine-cyan
- 'modus-theme-nuanced-cyan
- cyan-alt-other
- 'bold))))
- `(ivy-minibuffer-match-face-4 ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other
- 'bold))))
- `(ivy-minibuffer-match-highlight ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-intense-blue
- 'modus-theme-nuanced-blue
- blue-alt-other
- 'bold))))
- `(ivy-modified-buffer ((,class :foreground ,yellow :slant ,modus-theme-slant)))
- `(ivy-modified-outside-buffer ((,class :foreground ,yellow-alt :slant ,modus-theme-slant)))
- `(ivy-org ((,class :foreground ,cyan-alt-other)))
- `(ivy-prompt-match ((,class :inherit ivy-current-match)))
- `(ivy-remote ((,class :foreground ,magenta)))
- `(ivy-separator ((,class :foreground ,fg-alt)))
- `(ivy-subdir ((,class :foreground ,blue-alt-other)))
- `(ivy-virtual ((,class :foreground ,magenta-alt-other)))
- `(ivy-yanked-word ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-refine-blue
- 'modus-theme-nuanced-blue
- blue-alt))))
-;;;;; ivy-posframe
- `(ivy-posframe ((,class :background ,bg-dim :foreground ,fg-main)))
- `(ivy-posframe-border ((,class :background ,bg-active)))
- `(ivy-posframe-cursor ((,class :background ,fg-main :foreground ,bg-main)))
-;;;;; jira (org-jira)
- `(jiralib-comment-face ((,class :background ,bg-alt)))
- `(jiralib-comment-header-face ((,class :inherit bold)))
- `(jiralib-issue-info-face ((,class :inherit modus-theme-special-warm)))
- `(jiralib-issue-info-header-face ((,class :inherit (modus-theme-special-warm bold))))
- `(jiralib-issue-summary-face ((,class :inherit bold)))
- `(jiralib-link-filter-face ((,class :underline t)))
- `(jiralib-link-issue-face ((,class :underline t)))
- `(jiralib-link-project-face ((,class :underline t)))
-;;;;; journalctl-mode
- `(journalctl-error-face ((,class :inherit bold :foreground ,red)))
- `(journalctl-finished-face ((,class :inherit bold :foreground ,green)))
- `(journalctl-host-face ((,class :foreground ,blue)))
- `(journalctl-process-face ((,class :foreground ,cyan-alt-other)))
- `(journalctl-starting-face ((,class :foreground ,green)))
- `(journalctl-timestamp-face ((,class :foreground ,fg-special-cold)))
- `(journalctl-warning-face ((,class :inherit bold :foreground ,yellow)))
-;;;;; js2-mode
- `(js2-error ((,class :foreground ,red)))
- `(js2-external-variable ((,class :foreground ,cyan-alt-other)))
- `(js2-function-call ((,class :foreground ,magenta)))
- `(js2-function-param ((,class :foreground ,blue)))
- `(js2-instance-member ((,class :foreground ,magenta-alt-other)))
- `(js2-jsdoc-html-tag-delimiter ((,class :foreground ,fg-main)))
- `(js2-jsdoc-html-tag-name ((,class :foreground ,cyan)))
- `(js2-jsdoc-tag ((,class :foreground ,fg-special-calm)))
- `(js2-jsdoc-type ((,class :foreground ,fg-special-cold)))
- `(js2-jsdoc-value ((,class :foreground ,fg-special-warm)))
- `(js2-object-property ((,class :foreground ,fg-main)))
- `(js2-object-property-access ((,class :foreground ,fg-main)))
- `(js2-private-function-call ((,class :foreground ,green-alt-other)))
- `(js2-private-member ((,class :foreground ,fg-special-mild)))
- `(js2-warning ((,class :foreground ,yellow-alt :underline t)))
-;;;;; julia
- `(julia-macro-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta)))
- `(julia-quoted-symbol-face ((,class :foreground ,blue-alt-other)))
-;;;;; jupyter
- `(jupyter-eval-overlay ((,class :inherit bold :foreground ,blue)))
- `(jupyter-repl-input-prompt ((,class :foreground ,cyan-alt-other)))
- `(jupyter-repl-output-prompt ((,class :foreground ,magenta-alt-other)))
- `(jupyter-repl-traceback ((,class :inherit modus-theme-intense-red)))
-;;;;; kaocha-runner
- `(kaocha-runner-error-face ((,class :foreground ,red)))
- `(kaocha-runner-success-face ((,class :foreground ,green)))
- `(kaocha-runner-warning-face ((,class :foreground ,yellow)))
-;;;;; keycast
- `(keycast-command ((,class :inherit bold :foreground ,blue-active)))
- `(keycast-key ((,class ,@(modus-operandi-theme-mode-line-attrs
- bg-main blue-active
- bg-main blue-active
- blue-active blue-intense
- 'alt-style -3))))
-;;;;; line numbers (display-line-numbers-mode and global variant)
- `(line-number ((,class :inherit default :background ,bg-dim :foreground ,fg-alt)))
- `(line-number-current-line ((,class :inherit default :background ,bg-active :foreground ,fg-main)))
-;;;;; lsp-mode
- `(lsp-face-highlight-read ((,class :inherit modus-theme-subtle-blue :underline t)))
- `(lsp-face-highlight-textual ((,class :inherit modus-theme-subtle-blue)))
- `(lsp-face-highlight-write ((,class :inherit (modus-theme-refine-blue bold))))
- `(lsp-face-semhl-constant ((,class :foreground ,blue-alt-other)))
- `(lsp-face-semhl-deprecated
- ((,(append '((supports :underline (:style wave))) class)
- :foreground ,yellow :underline (:style wave))
- (,class :foreground ,yellow :underline t)))
- `(lsp-face-semhl-enummember ((,class :foreground ,blue-alt-other)))
- `(lsp-face-semhl-field ((,class :foreground ,cyan-alt)))
- `(lsp-face-semhl-field-static ((,class :foreground ,cyan-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-function ((,class :foreground ,magenta)))
- `(lsp-face-semhl-method ((,class :foreground ,magenta)))
- `(lsp-face-semhl-namespace ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt)))
- `(lsp-face-semhl-preprocessor ((,class :foreground ,red-alt-other)))
- `(lsp-face-semhl-static-method ((,class :foreground ,magenta :slant ,modus-theme-slant)))
- `(lsp-face-semhl-type-class ((,class :foreground ,magenta-alt)))
- `(lsp-face-semhl-type-enum ((,class :foreground ,magenta-alt)))
- `(lsp-face-semhl-type-primitive ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-type-template ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-type-typedef ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-variable ((,class :foreground ,cyan)))
- `(lsp-face-semhl-variable-local ((,class :foreground ,cyan)))
- `(lsp-face-semhl-variable-parameter ((,class :foreground ,cyan-alt-other)))
- `(lsp-lens-face ((,class :height 0.8 :foreground ,fg-alt)))
- `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t)))
- `(lsp-ui-doc-background ((,class :background ,bg-alt)))
- `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header)))
- `(lsp-ui-doc-url ((,class :inherit button :foreground ,blue-alt-other)))
- `(lsp-ui-peek-filename ((,class :foreground ,fg-special-warm)))
- `(lsp-ui-peek-footer ((,class :background ,bg-header :foreground ,fg-header)))
- `(lsp-ui-peek-header ((,class :background ,bg-header :foreground ,fg-header)))
- `(lsp-ui-peek-highlight ((,class :inherit modus-theme-subtle-blue)))
- `(lsp-ui-peek-line-number ((,class :foreground ,fg-alt)))
- `(lsp-ui-peek-list ((,class :background ,bg-dim)))
- `(lsp-ui-peek-peek ((,class :background ,bg-alt)))
- `(lsp-ui-peek-selection ((,class :inherit modus-theme-subtle-cyan)))
- `(lsp-ui-sideline-code-action ((,class :foreground ,yellow)))
- `(lsp-ui-sideline-current-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-main)))
- `(lsp-ui-sideline-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-alt)))
- `(lsp-ui-sideline-symbol-info ((,class :height 0.99 :slant italic)))
-;;;;; magit
- `(magit-bisect-bad ((,class :foreground ,red-alt-other)))
- `(magit-bisect-good ((,class :foreground ,green-alt-other)))
- `(magit-bisect-skip ((,class :foreground ,yellow-alt-other)))
- `(magit-blame-date ((,class :foreground ,blue)))
- `(magit-blame-dimmed ((,class :foreground ,fg-alt)))
- `(magit-blame-hash ((,class :foreground ,fg-special-warm)))
- `(magit-blame-heading ((,class :background ,bg-alt)))
- `(magit-blame-highlight ((,class :inherit modus-theme-nuanced-cyan)))
- `(magit-blame-margin ((,class :inherit magit-blame-highlight)))
- `(magit-blame-name ((,class :foreground ,magenta-alt-other)))
- `(magit-blame-summary ((,class :foreground ,cyan-alt-other)))
- `(magit-branch-current ((,class :foreground ,blue-alt-other :box t)))
- `(magit-branch-local ((,class :foreground ,blue-alt)))
- `(magit-branch-remote ((,class :foreground ,magenta-alt)))
- `(magit-branch-remote-head ((,class :foreground ,magenta-alt-other :box t)))
- `(magit-branch-upstream ((,class :slant italic)))
- `(magit-cherry-equivalent ((,class :background ,bg-main :foreground ,magenta-intense)))
- `(magit-cherry-unmatched ((,class :background ,bg-main :foreground ,cyan-intense)))
- ;; NOTE: here we break from the pattern of inheriting from the
- ;; modus-theme-diff-* faces, though only for the standard actions,
- ;; not the highlighted ones. This is because Magit's interaction
- ;; model relies on highlighting the current diff hunk.
- `(magit-diff-added ((,class ,@(modus-operandi-theme-diff
- bg-main green
- bg-diff-added fg-diff-added
- green-nuanced-bg fg-diff-added))))
- `(magit-diff-added-highlight ((,class :inherit modus-theme-diff-focus-added)))
- `(magit-diff-base ((,class ,@(modus-operandi-theme-diff
- bg-main yellow
- bg-diff-changed fg-diff-changed
- yellow-nuanced-bg fg-diff-changed))))
- `(magit-diff-base-highlight ((,class :inherit modus-theme-diff-focus-changed)))
- `(magit-diff-context ((,class :foreground ,fg-unfocused)))
- `(magit-diff-context-highlight ((,class ,@(modus-operandi-theme-diff
- bg-dim fg-dim
- bg-inactive fg-inactive
- bg-dim fg-alt))))
- `(magit-diff-file-heading ((,class :inherit bold :foreground ,fg-special-cold)))
- `(magit-diff-file-heading-highlight ((,class :inherit (modus-theme-special-cold bold))))
- `(magit-diff-file-heading-selection ((,class :inherit modus-theme-refine-cyan)))
- ;; NOTE: here we break from the pattern of inheriting from the
- ;; modus-theme-diff-* faces.
- `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active
- :foreground ,fg-inactive)))
- `(magit-diff-hunk-heading-highlight ((,class :inherit bold :background ,bg-diff-heading
- :foreground ,fg-diff-heading)))
- `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-refine-blue)))
- `(magit-diff-hunk-region ((,class :inherit bold)))
- `(magit-diff-lines-boundary ((,class :background ,fg-main)))
- `(magit-diff-lines-heading ((,class :inherit modus-theme-refine-magenta)))
- `(magit-diff-removed ((,class ,@(modus-operandi-theme-diff
- bg-main red
- bg-diff-removed fg-diff-removed
- red-nuanced-bg fg-diff-removed))))
- `(magit-diff-removed-highlight ((,class :inherit modus-theme-diff-focus-removed)))
- `(magit-diffstat-added ((,class :foreground ,green)))
- `(magit-diffstat-removed ((,class :foreground ,red)))
- `(magit-dimmed ((,class :foreground ,fg-unfocused)))
- `(magit-filename ((,class :foreground ,fg-special-cold)))
- `(magit-hash ((,class :foreground ,fg-alt)))
- `(magit-head ((,class :inherit magit-branch-local)))
- `(magit-header-line ((,class :inherit bold :foreground ,magenta-active)))
- `(magit-header-line-key ((,class :inherit bold :foreground ,red-active)))
- `(magit-header-line-log-select ((,class :inherit bold :foreground ,fg-main)))
- `(magit-keyword ((,class :foreground ,magenta)))
- `(magit-keyword-squash ((,class :inherit bold :foreground ,yellow-alt-other)))
- `(magit-log-author ((,class :foreground ,cyan)))
- `(magit-log-date ((,class :foreground ,fg-alt)))
- `(magit-log-graph ((,class :foreground ,fg-dim)))
- `(magit-mode-line-process ((,class :inherit bold :foreground ,blue-active)))
- `(magit-mode-line-process-error ((,class :inherit bold :foreground ,red-active)))
- `(magit-process-ng ((,class :inherit error)))
- `(magit-process-ok ((,class :inherit success)))
- `(magit-reflog-amend ((,class :background ,bg-main :foreground ,magenta-intense)))
- `(magit-reflog-checkout ((,class :background ,bg-main :foreground ,blue-intense)))
- `(magit-reflog-cherry-pick ((,class :background ,bg-main :foreground ,green-intense)))
- `(magit-reflog-commit ((,class :background ,bg-main :foreground ,green-intense)))
- `(magit-reflog-merge ((,class :background ,bg-main :foreground ,green-intense)))
- `(magit-reflog-other ((,class :background ,bg-main :foreground ,cyan-intense)))
- `(magit-reflog-rebase ((,class :background ,bg-main :foreground ,magenta-intense)))
- `(magit-reflog-remote ((,class :background ,bg-main :foreground ,cyan-intense)))
- `(magit-reflog-reset ((,class :background ,bg-main :foreground ,red-intense)))
- `(magit-refname ((,class :foreground ,fg-alt)))
- `(magit-refname-pullreq ((,class :foreground ,fg-alt)))
- `(magit-refname-stash ((,class :foreground ,fg-alt)))
- `(magit-refname-wip ((,class :foreground ,fg-alt)))
- `(magit-section ((,class :background ,bg-dim :foreground ,fg-main)))
- `(magit-section-heading ((,class :inherit bold :foreground ,cyan)))
- `(magit-section-heading-selection ((,class :inherit (modus-theme-refine-cyan bold))))
- `(magit-section-highlight ((,class :background ,bg-alt)))
- `(magit-sequence-done ((,class :foreground ,green-alt)))
- `(magit-sequence-drop ((,class :foreground ,red-alt)))
- `(magit-sequence-exec ((,class :foreground ,magenta-alt)))
- `(magit-sequence-head ((,class :foreground ,cyan-alt)))
- `(magit-sequence-onto ((,class :foreground ,fg-alt)))
- `(magit-sequence-part ((,class :foreground ,yellow-alt)))
- `(magit-sequence-pick ((,class :foreground ,blue-alt)))
- `(magit-sequence-stop ((,class :foreground ,red)))
- `(magit-signature-bad ((,class :inherit bold :foreground ,red)))
- `(magit-signature-error ((,class :foreground ,red-alt)))
- `(magit-signature-expired ((,class :foreground ,yellow)))
- `(magit-signature-expired-key ((,class :foreground ,yellow)))
- `(magit-signature-good ((,class :foreground ,green)))
- `(magit-signature-revoked ((,class :foreground ,magenta)))
- `(magit-signature-untrusted ((,class :foreground ,cyan)))
- `(magit-tag ((,class :foreground ,yellow-alt-other)))
-;;;;; magit-imerge
- `(magit-imerge-overriding-value ((,class :inherit bold :foreground ,red-alt)))
-;;;;; man
- `(Man-overstrike ((,class :inherit bold :foreground ,magenta)))
- `(Man-reverse ((,class :inherit modus-theme-subtle-magenta)))
- `(Man-underline ((,class :foreground ,cyan :underline t)))
-;;;;; markdown-mode
- `(markdown-blockquote-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(markdown-bold-face ((,class :inherit bold)))
- `(markdown-code-face ((,class ,@(modus-operandi-theme-mixed-fonts))))
- `(markdown-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(markdown-footnote-text-face ((,class :foreground ,fg-main :slant ,modus-theme-slant)))
- `(markdown-gfm-checkbox-face ((,class :foreground ,cyan-alt-other)))
- `(markdown-header-delimiter-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,fg-dim)))
- `(markdown-header-face ((t nil)))
- `(markdown-header-face-1 ((,class :inherit modus-theme-heading-1)))
- `(markdown-header-face-2 ((,class :inherit modus-theme-heading-2)))
- `(markdown-header-face-3 ((,class :inherit modus-theme-heading-3)))
- `(markdown-header-face-4 ((,class :inherit modus-theme-heading-4)))
- `(markdown-header-face-5 ((,class :inherit modus-theme-heading-5)))
- `(markdown-header-face-6 ((,class :inherit modus-theme-heading-6)))
- `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(markdown-html-attr-name-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,cyan)))
- `(markdown-html-attr-value-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,blue)))
- `(markdown-html-entity-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,cyan)))
- `(markdown-html-tag-delimiter-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,fg-special-mild)))
- `(markdown-html-tag-name-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,magenta-alt)))
- `(markdown-inline-code-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,magenta)))
- `(markdown-italic-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(markdown-language-info-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,fg-special-cold)))
- `(markdown-language-keyword-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,green-alt-other)))
- `(markdown-line-break-face ((,class :inherit modus-theme-refine-cyan :underline t)))
- `(markdown-link-face ((,class :inherit link)))
- `(markdown-link-title-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(markdown-list-face ((,class :foreground ,fg-dim)))
- `(markdown-markup-face ((,class :foreground ,fg-alt)))
- `(markdown-math-face ((,class :foreground ,magenta-alt-other)))
- `(markdown-metadata-key-face ((,class :foreground ,cyan-alt-other)))
- `(markdown-metadata-value-face ((,class :foreground ,blue-alt)))
- `(markdown-missing-link-face ((,class :inherit bold :foreground ,yellow)))
- `(markdown-plain-url-face ((,class :inherit markdown-link-face)))
- `(markdown-pre-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- ,@(modus-operandi-theme-mixed-fonts)
- :background ,bg-dim
- :foreground ,fg-special-mild)))
- `(markdown-reference-face ((,class :inherit markdown-markup-face)))
- `(markdown-strike-through-face ((,class :strike-through t)))
- `(markdown-table-face ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,fg-special-cold)))
- `(markdown-url-face ((,class :foreground ,blue-alt)))
-;;;;; markup-faces (`adoc-mode')
- `(markup-anchor-face ((,class :foreground ,fg-inactive)))
- `(markup-attribute-face ((,class :foreground ,fg-inactive :slant italic)))
- `(markup-big-face ((,class :height 1.3 :foreground ,blue-nuanced)))
- `(markup-bold-face ((,class :inherit bold :foreground ,red-nuanced)))
- `(markup-code-face ((,class :inherit fixed-pitch :foreground ,magenta)))
- `(markup-command-face ((,class :foreground ,fg-inactive)))
- `(markup-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(markup-complex-replacement-face ((,class :box (:line-width 2 :color nil :style released-button)
- :inherit modus-theme-refine-magenta)))
- `(markup-emphasis-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(markup-error-face ((,class :inherit bold :foreground ,red)))
- `(markup-gen-face ((,class :foreground ,magenta-alt)))
- `(markup-internal-reference-face ((,class :inherit button :foreground ,fg-inactive)))
- `(markup-italic-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(markup-list-face ((,class :inherit modus-theme-special-calm)))
- `(markup-meta-face ((,class :foreground ,fg-inactive)))
- `(markup-meta-hide-face ((,class :foreground ,fg-alt)))
- `(markup-passthrough-face ((,class :inherit fixed-pitch :foreground ,cyan)))
- `(markup-preprocessor-face ((,class :foreground ,red-alt-other)))
- `(markup-replacement-face ((,class :foreground ,yellow-alt-other)))
- `(markup-secondary-text-face ((,class :height 0.8 :foreground ,magenta-nuanced)))
- `(markup-small-face ((,class :height 0.8 :foreground ,fg-main)))
- `(markup-strong-face ((,class :inherit bold :foreground ,red-nuanced)))
- `(markup-subscript-face ((,class :height 0.8 :foreground ,fg-special-cold)))
- `(markup-superscript-face ((,class :height 0.8 :foreground ,fg-special-cold)))
- `(markup-table-cell-face ((,class :inherit modus-theme-special-cold)))
- `(markup-table-face ((,class :inherit modus-theme-subtle-cyan)))
- `(markup-table-row-face ((,class :inherit modus-theme-subtle-cyan)))
- `(markup-title-0-face ((,class :height 3.0 :foreground ,blue-nuanced)))
- `(markup-title-1-face ((,class :height 2.4 :foreground ,blue-nuanced)))
- `(markup-title-2-face ((,class :height 1.8 :foreground ,blue-nuanced)))
- `(markup-title-3-face ((,class :height 1.4 :foreground ,blue-nuanced)))
- `(markup-title-4-face ((,class :height 1.2 :foreground ,blue-nuanced)))
- `(markup-title-5-face ((,class :height 1.2 :foreground ,blue-nuanced :underline t)))
- `(markup-value-face ((,class :foreground ,fg-inactive)))
- `(markup-verbatim-face ((,class :inherit modus-theme-special-mild)))
-;;;;; mentor
- `(mentor-download-message ((,class :foreground ,fg-special-warm)))
- `(mentor-download-name ((,class :foreground ,fg-special-cold)))
- `(mentor-download-progress ((,class :foreground ,blue-alt-other)))
- `(mentor-download-size ((,class :foreground ,magenta-alt-other)))
- `(mentor-download-speed-down ((,class :foreground ,cyan-alt)))
- `(mentor-download-speed-up ((,class :foreground ,red-alt)))
- `(mentor-download-state ((,class :foreground ,yellow-alt)))
- `(mentor-highlight-face ((,class :inherit modus-theme-subtle-blue)))
- `(mentor-tracker-name ((,class :foreground ,magenta-alt)))
-;;;;; messages
- `(message-cited-text-1 ((,class :foreground ,blue-alt)))
- `(message-cited-text-2 ((,class :foreground ,red-alt)))
- `(message-cited-text-3 ((,class :foreground ,green-alt)))
- `(message-cited-text-4 ((,class :foreground ,magenta-alt)))
- `(message-header-cc ((,class :inherit bold :foreground ,cyan-alt)))
- `(message-header-name ((,class :foreground ,green-alt-other)))
- `(message-header-newsgroups ((,class :inherit bold :foreground ,green-alt)))
- `(message-header-other ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(message-header-subject ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(message-header-to ((,class :inherit bold :foreground ,blue)))
- `(message-header-xheader ((,class :foreground ,cyan)))
- `(message-mml ((,class :foreground ,fg-special-warm)))
- `(message-separator ((,class :inherit modus-theme-intense-neutral)))
-;;;;; minibuffer-line
- `(minibuffer-line ((,class :foreground ,fg-main)))
-;;;;; minimap
- `(minimap-active-region-background ((,class :background ,bg-active)))
- `(minimap-current-line-face ((,class :background ,cyan-intense-bg :foreground ,fg-main)))
-;;;;; modeline
- `(mode-line ((,class ,@(modus-operandi-theme-mode-line-attrs
- fg-active bg-active fg-dim bg-active
- fg-alt bg-active 'alt-style nil bg-main))))
- `(mode-line-buffer-id ((,class :inherit bold)))
- `(mode-line-emphasis ((,class :inherit bold :foreground ,blue-active)))
- `(mode-line-highlight ((,class :inherit modus-theme-active-blue :box (:line-width -1 :style pressed-button))))
- `(mode-line-inactive ((,class ,@(modus-operandi-theme-mode-line-attrs
- fg-inactive bg-inactive fg-alt bg-dim
- bg-region bg-active))))
-;;;;; mood-line
- `(mood-line-modified ((,class :foreground ,magenta-active)))
- `(mood-line-status-error ((,class :inherit bold :foreground ,red-active)))
- `(mood-line-status-info ((,class :foreground ,cyan-active)))
- `(mood-line-status-neutral ((,class :foreground ,blue-active)))
- `(mood-line-status-success ((,class :foreground ,green-active)))
- `(mood-line-status-warning ((,class :inherit bold :foreground ,yellow-active)))
- `(mood-line-unimportant ((,class :foreground ,fg-inactive)))
-;;;;; mpdel
- `(mpdel-browser-directory-face ((,class :foreground ,blue)))
- `(mpdel-playlist-current-song-face ((,class :inherit bold :foreground ,blue-alt-other)))
-;;;;; mu4e
- `(mu4e-attach-number-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(mu4e-cited-1-face ((,class :foreground ,blue-alt)))
- `(mu4e-cited-2-face ((,class :foreground ,red-alt)))
- `(mu4e-cited-3-face ((,class :foreground ,green-alt)))
- `(mu4e-cited-4-face ((,class :foreground ,magenta-alt)))
- `(mu4e-cited-5-face ((,class :foreground ,yellow-alt)))
- `(mu4e-cited-6-face ((,class :foreground ,cyan-alt)))
- `(mu4e-cited-7-face ((,class :foreground ,magenta)))
- `(mu4e-compose-header-face ((,class :inherit mu4e-compose-separator-face)))
- `(mu4e-compose-separator-face ((,class :inherit modus-theme-intense-neutral)))
- `(mu4e-contact-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(mu4e-context-face ((,class :foreground ,blue-active)))
- `(mu4e-draft-face ((,class :foreground ,magenta-alt)))
- `(mu4e-flagged-face ((,class :foreground ,red-alt)))
- `(mu4e-footer-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(mu4e-forwarded-face ((,class :foreground ,magenta-alt-other)))
- `(mu4e-header-face ((,class :foreground ,fg-alt)))
- `(mu4e-header-highlight-face ((,class :inherit modus-theme-hl-line)))
- `(mu4e-header-key-face ((,class :foreground ,cyan)))
- `(mu4e-header-marks-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(mu4e-header-title-face ((,class :foreground ,fg-special-mild)))
- `(mu4e-header-value-face ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(mu4e-highlight-face ((,class :inherit bold :foreground ,blue-alt-other)))
- `(mu4e-link-face ((,class :inherit link)))
- `(mu4e-modeline-face ((,class :foreground ,magenta-active)))
- `(mu4e-moved-face ((,class :foreground ,yellow :slant ,modus-theme-slant)))
- `(mu4e-ok-face ((,class :inherit bold :foreground ,green)))
- `(mu4e-region-code ((,class :inherit modus-theme-special-calm)))
- `(mu4e-replied-face ((,class :foreground ,blue-faint)))
- `(mu4e-special-header-value-face ((,class :inherit bold :foreground ,blue-alt-other)))
- `(mu4e-system-face ((,class :foreground ,fg-mark-del :slant ,modus-theme-slant)))
- `(mu4e-title-face ((,class :foreground ,fg-main)))
- `(mu4e-trashed-face ((,class :foreground ,red)))
- `(mu4e-unread-face ((,class :inherit bold :foreground ,fg-main)))
- `(mu4e-url-number-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(mu4e-view-body-face ((,class :foreground ,fg-main)))
- `(mu4e-warning-face ((,class :inherit warning)))
-;;;;; mu4e-conversation
- `(mu4e-conversation-header ((,class :inherit modus-theme-special-cold)))
- `(mu4e-conversation-sender-1 ((,class :foreground ,fg-special-warm)))
- `(mu4e-conversation-sender-2 ((,class :foreground ,fg-special-cold)))
- `(mu4e-conversation-sender-3 ((,class :foreground ,fg-special-mild)))
- `(mu4e-conversation-sender-4 ((,class :foreground ,fg-alt)))
- `(mu4e-conversation-sender-5 ((,class :foreground ,yellow-refine-fg)))
- `(mu4e-conversation-sender-6 ((,class :foreground ,cyan-refine-fg)))
- `(mu4e-conversation-sender-7 ((,class :foreground ,green-refine-fg)))
- `(mu4e-conversation-sender-8 ((,class :foreground ,blue-refine-fg)))
- `(mu4e-conversation-sender-me ((,class :foreground ,fg-main)))
- `(mu4e-conversation-unread ((,class :inherit bold)))
-;;;;; multiple-cursors
- `(mc/cursor-bar-face ((,class :height 1 :background ,fg-main)))
- `(mc/cursor-face ((,class :inverse-video t)))
- `(mc/region-face ((,class :inherit region)))
-;;;;; neotree
- `(neo-banner-face ((,class :foreground ,magenta)))
- `(neo-button-face ((,class :inherit button)))
- `(neo-dir-link-face ((,class :inherit bold :foreground ,blue)))
- `(neo-expand-btn-face ((,class :foreground ,cyan)))
- `(neo-file-link-face ((,class :foreground ,fg-main)))
- `(neo-header-face ((,class :inherit bold :foreground ,fg-main)))
- `(neo-root-dir-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(neo-vc-added-face ((,class :foreground ,green)))
- `(neo-vc-conflict-face ((,class :inherit bold :foreground ,red)))
- `(neo-vc-default-face ((,class :foreground ,fg-main)))
- `(neo-vc-edited-face ((,class :foreground ,yellow)))
- `(neo-vc-ignored-face ((,class :foreground ,fg-inactive)))
- `(neo-vc-missing-face ((,class :foreground ,red-alt)))
- `(neo-vc-needs-merge-face ((,class :foreground ,magenta-alt)))
- `(neo-vc-needs-update-face ((,class :underline t)))
- `(neo-vc-removed-face ((,class :strike-through t)))
- `(neo-vc-unlocked-changes-face ((,class :inherit modus-theme-refine-blue)))
- `(neo-vc-up-to-date-face ((,class :foreground ,fg-alt)))
- `(neo-vc-user-face ((,class :foreground ,magenta)))
-;;;;; no-emoji
- `(no-emoji ((,class :foreground ,cyan)))
-;;;;; notmuch
- `(notmuch-crypto-decryption ((,class :inherit modus-theme-refine-magenta)))
- `(notmuch-crypto-part-header ((,class :foreground ,magenta-alt-other)))
- `(notmuch-crypto-signature-bad ((,class :inherit modus-theme-intense-red)))
- `(notmuch-crypto-signature-good ((,class :inherit modus-theme-refine-green)))
- `(notmuch-crypto-signature-good-key ((,class :inherit modus-theme-refine-yellow)))
- `(notmuch-crypto-signature-unknown ((,class :inherit modus-theme-refine-red)))
- `(notmuch-hello-logo-background ((,class :background ,bg-main)))
- `(notmuch-message-summary-face ((,class :inherit modus-theme-nuanced-cyan)))
- `(notmuch-search-flagged-face ((,class :foreground ,red-alt)))
- `(notmuch-search-matching-authors ((,class :foreground ,fg-main)))
- `(notmuch-search-non-matching-authors ((,class :foreground ,fg-alt)))
- `(notmuch-search-unread-face ((,class :inherit bold)))
- `(notmuch-tag-added
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,green :style wave))
- (,class :foreground ,green :underline t)))
- `(notmuch-tag-deleted
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,red :style wave))
- (,class :foreground ,red :underline t)))
- `(notmuch-tag-face ((,class :inherit bold :foreground ,blue-alt)))
- `(notmuch-tag-flagged ((,class :foreground ,red-alt)))
- `(notmuch-tag-unread ((,class :foreground ,magenta-alt)))
- `(notmuch-tree-match-author-face ((,class :foreground ,fg-special-cold)))
- `(notmuch-tree-match-face ((,class :foreground ,fg-main)))
- `(notmuch-tree-match-tag-face ((,class :inherit bold :foreground ,blue-alt)))
- `(notmuch-tree-no-match-face ((,class :foreground ,fg-alt)))
- `(notmuch-wash-cited-text ((,class :foreground ,cyan)))
- `(notmuch-wash-toggle-button ((,class :background ,bg-alt :foreground ,fg-alt)))
-;;;;; num3-mode
- `(num3-face-even ((,class :inherit bold :background ,bg-alt)))
-;;;;; nxml-mode
- `(nxml-attribute-colon ((,class :foreground ,fg-main)))
- `(nxml-attribute-local-name ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt cyan-alt-faint))))
- `(nxml-attribute-prefix ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-attribute-value ((,class ,@(modus-operandi-theme-syntax-foreground
- blue blue-faint))))
- `(nxml-cdata-section-CDATA ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt red-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-cdata-section-delimiter ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(nxml-char-ref-delimiter ((,class ,@(modus-operandi-theme-syntax-foreground
- green-alt-other green-alt-other-faint))))
- `(nxml-char-ref-number ((,class ,@(modus-operandi-theme-syntax-foreground
- green-alt-other green-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-delimited-data ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(nxml-delimiter ((,class :foreground ,fg-dim)))
- `(nxml-element-colon ((,class :foreground ,fg-main)))
- `(nxml-element-local-name ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(nxml-element-prefix ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-entity-ref-delimiter ((,class ,@(modus-operandi-theme-syntax-foreground
- green-alt-other green-alt-other-faint))))
- `(nxml-entity-ref-name ((,class ,@(modus-operandi-theme-syntax-foreground
- green-alt-other green-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-glyph ((,class :inherit modus-theme-intense-neutral)))
- `(nxml-hash ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt blue-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-heading ((,class :inherit bold)))
- `(nxml-name ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-namespace-attribute-colon ((,class :foreground ,fg-main)))
- `(nxml-namespace-attribute-prefix ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint))))
- `(nxml-processing-instruction-target ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-prolog-keyword ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(nxml-ref ((,class ,@(modus-operandi-theme-syntax-foreground
- green-alt-other green-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
-;;;;; objed
- `(objed-hl ((,class :background ,(if modus-operandi-theme-intense-hl-line
- bg-hl-alt-intense bg-hl-alt))))
- `(objed-mark ((,class :background ,bg-active)))
- `(objed-mode-line ((,class :foreground ,cyan-active)))
-;;;;; orderless
- `(orderless-match-face-0 ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- blue-alt-other blue-nuanced-bg
- blue-refine-bg blue-refine-fg))))
- `(orderless-match-face-1 ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- magenta-alt magenta-nuanced-bg
- magenta-refine-bg magenta-refine-fg))))
- `(orderless-match-face-2 ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- green green-nuanced-bg
- green-refine-bg green-refine-fg))))
- `(orderless-match-face-3 ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- yellow yellow-nuanced-bg
- yellow-refine-bg yellow-refine-fg))))
-;;;;; org
- `(org-agenda-calendar-event ((,class :foreground ,fg-main)))
- `(org-agenda-calendar-sexp ((,class :foreground ,cyan-alt)))
- `(org-agenda-clocking ((,class :inherit modus-theme-special-cold
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(org-agenda-column-dateline ((,class :background ,bg-alt)))
- `(org-agenda-current-time ((,class :inherit bold :foreground ,blue-alt-other)))
- `(org-agenda-date ((,class :foreground ,cyan)))
- `(org-agenda-date-today ((,class :inherit bold :foreground ,fg-main :underline t)))
- `(org-agenda-date-weekend ((,class :foreground ,cyan-alt-other)))
- `(org-agenda-diary ((,class :foreground ,fg-main)))
- `(org-agenda-dimmed-todo-face ((,class :inherit bold :foreground ,fg-alt)))
- `(org-agenda-done ((,class :foreground ,green-alt)))
- `(org-agenda-filter-category ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-filter-effort ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-filter-tags ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(org-agenda-structure ((,class :foreground ,blue-alt)))
- `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(org-block ((,class ,@(modus-operandi-theme-mixed-fonts)
- ,@(modus-operandi-theme-org-block bg-dim)
- :foreground ,fg-main)))
- `(org-block-begin-line ((,class ,@(modus-operandi-theme-mixed-fonts)
- ,@(modus-operandi-theme-org-block-delim
- bg-dim fg-special-cold
- bg-alt fg-special-mild))))
- `(org-block-end-line ((,class :inherit org-block-begin-line)))
- `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active)
- :background ,bg-inactive :foreground ,fg-active)))
- `(org-checkbox-statistics-done ((,class :inherit org-done)))
- `(org-checkbox-statistics-todo ((,class :inherit org-todo)))
- `(org-clock-overlay ((,class :inherit modus-theme-special-cold)))
- `(org-code ((,class ,@(modus-operandi-theme-mixed-fonts) :foreground ,magenta)))
- `(org-column ((,class :background ,bg-alt)))
- `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt)))
- `(org-date ((,class :inherit (button fixed-pitch) :foreground ,cyan-alt-other)))
- `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t)))
- `(org-document-info ((,class :foreground ,fg-special-cold)))
- `(org-document-info-keyword ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,fg-alt)))
- `(org-document-title ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-5))))
- `(org-done ((,class :box ,bg-region :background ,bg-dim :foreground ,green)))
- `(org-drawer ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,cyan)))
- `(org-ellipsis ((,class :foreground nil))) ; inherits from the heading's colour
- `(org-footnote ((,class :inherit button :foreground ,blue-alt)))
- `(org-formula ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,red-alt)))
- `(org-habit-alert-face ((,class :inherit modus-theme-intense-yellow)))
- `(org-habit-alert-future-face ((,class :inherit modus-theme-refine-yellow)))
- `(org-habit-clear-face ((,class :inherit modus-theme-intense-magenta)))
- `(org-habit-clear-future-face ((,class :inherit modus-theme-refine-magenta)))
- `(org-habit-overdue-face ((,class :inherit modus-theme-intense-red)))
- `(org-habit-overdue-future-face ((,class :inherit modus-theme-refine-red)))
- `(org-habit-ready-face ((,class :inherit modus-theme-intense-blue)))
- `(org-habit-ready-future-face ((,class :inherit modus-theme-refine-blue)))
- `(org-headline-done ((,class :inherit ,modus-theme-variable-pitch :foreground ,green-nuanced)))
- `(org-headline-todo ((,class :inherit ,modus-theme-variable-pitch :foreground ,red-nuanced)))
- `(org-hide ((,class :foreground ,bg-main)))
- `(org-indent ((,class :inherit (fixed-pitch org-hide))))
- `(org-latex-and-related ((,class :foreground ,magenta-refine-fg)))
- `(org-level-1 ((,class :inherit modus-theme-heading-1)))
- `(org-level-2 ((,class :inherit modus-theme-heading-2)))
- `(org-level-3 ((,class :inherit modus-theme-heading-3)))
- `(org-level-4 ((,class :inherit modus-theme-heading-4)))
- `(org-level-5 ((,class :inherit modus-theme-heading-5)))
- `(org-level-6 ((,class :inherit modus-theme-heading-6)))
- `(org-level-7 ((,class :inherit modus-theme-heading-7)))
- `(org-level-8 ((,class :inherit modus-theme-heading-8)))
- `(org-link ((,class :inherit link)))
- `(org-list-dt ((,class :inherit bold)))
- `(org-macro ((,class :background ,blue-nuanced-bg :foreground ,magenta-alt-other)))
- `(org-meta-line ((,class ,@(modus-operandi-theme-mixed-fonts) :foreground ,fg-alt)))
- `(org-mode-line-clock ((,class :foreground ,fg-main)))
- `(org-mode-line-clock-overrun ((,class :inherit modus-theme-active-red)))
- `(org-priority ((,class :box ,bg-region :background ,bg-dim :foreground ,magenta)))
- `(org-property-value ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,cyan-alt-other)))
- `(org-quote ((,class ,@(modus-operandi-theme-org-block bg-dim)
- :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(org-scheduled ((,class :foreground ,fg-special-warm)))
- `(org-scheduled-previously ((,class :foreground ,yellow-alt-other)))
- `(org-scheduled-today ((,class :foreground ,magenta-alt-other)))
- `(org-sexp-date ((,class :inherit org-date)))
- `(org-special-keyword ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,blue-nuanced)))
- `(org-table ((,class ,@(modus-operandi-theme-mixed-fonts)
- :foreground ,fg-special-cold)))
- `(org-table-header ((,class :inherit (fixed-pitch modus-theme-intense-neutral))))
- `(org-tag ((,class :foreground ,magenta-nuanced)))
- `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced)))
- `(org-target ((,class :underline t)))
- `(org-time-grid ((,class :foreground ,fg-unfocused)))
- `(org-todo ((,class :box ,bg-region :background ,bg-dim :foreground ,red-alt)))
- `(org-upcoming-deadline ((,class :foreground ,red-alt-other)))
- `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced)))
- `(org-verbatim ((,class ,@(modus-operandi-theme-mixed-fonts)
- :background ,bg-alt :foreground ,fg-special-calm)))
- `(org-verse ((,class :inherit org-quote)))
- `(org-warning ((,class :inherit bold :foreground ,red-alt-other)))
-;;;;; org-journal
- `(org-journal-calendar-entry-face ((,class :foreground ,yellow-alt-other :slant ,modus-theme-slant)))
- `(org-journal-calendar-scheduled-face ((,class :foreground ,red-alt-other :slant ,modus-theme-slant)))
- `(org-journal-highlight ((,class :foreground ,magenta-alt)))
-;;;;; org-noter
- `(org-noter-no-notes-exist-face ((,class :inherit bold :foreground ,red-active)))
- `(org-noter-notes-exist-face ((,class :inherit bold :foreground ,green-active)))
-;;;;; org-pomodoro
- `(org-pomodoro-mode-line ((,class :foreground ,red-active)))
- `(org-pomodoro-mode-line-break ((,class :foreground ,cyan-active)))
- `(org-pomodoro-mode-line-overtime ((,class :inherit bold :foreground ,red-active)))
-;;;;; org-recur
- `(org-recur ((,class :foreground ,magenta-active)))
-;;;;; org-roam
- `(org-roam-link ((,class :inherit button :foreground ,green)))
- `(org-roam-link-current ((,class :inherit button :foreground ,green-alt)))
- `(org-roam-link-invalid ((,class :inherit button :foreground ,red)))
- `(org-roam-link-shielded ((,class :inherit button :foreground ,yellow)))
- `(org-roam-tag ((,class :foreground ,fg-alt :slant italic)))
-;;;;; org-superstar
- `(org-superstar-item ((,class :foreground ,fg-main)))
- `(org-superstar-leading ((,class :foreground ,fg-whitespace)))
-;;;;; org-table-sticky-header
- `(org-table-sticky-header-face ((,class :inherit modus-theme-intense-neutral)))
-;;;;; org-treescope
- `(org-treescope-faces--markerinternal-midday ((,class :inherit modus-theme-intense-blue)))
- `(org-treescope-faces--markerinternal-range ((,class :inherit modus-theme-special-mild)))
-;;;;; origami
- `(origami-fold-header-face ((,class :background ,bg-dim :foreground ,fg-dim :box t)))
- `(origami-fold-replacement-face ((,class :background ,bg-alt :foreground ,fg-alt)))
-;;;;; outline-mode
- `(outline-1 ((,class :inherit modus-theme-heading-1)))
- `(outline-2 ((,class :inherit modus-theme-heading-2)))
- `(outline-3 ((,class :inherit modus-theme-heading-3)))
- `(outline-4 ((,class :inherit modus-theme-heading-4)))
- `(outline-5 ((,class :inherit modus-theme-heading-5)))
- `(outline-6 ((,class :inherit modus-theme-heading-6)))
- `(outline-7 ((,class :inherit modus-theme-heading-7)))
- `(outline-8 ((,class :inherit modus-theme-heading-8)))
-;;;;; outline-minor-faces
- `(outline-minor-0 ((,class nil)))
-;;;;; package (M-x list-packages)
- `(package-description ((,class :foreground ,fg-special-cold)))
- `(package-help-section-name ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(package-name ((,class :inherit link)))
- `(package-status-avail-obso ((,class :inherit bold :foreground ,red)))
- `(package-status-available ((,class :foreground ,fg-special-mild)))
- `(package-status-built-in ((,class :foreground ,magenta)))
- `(package-status-dependency ((,class :foreground ,magenta-alt-other)))
- `(package-status-disabled ((,class :inherit modus-theme-subtle-red)))
- `(package-status-external ((,class :foreground ,cyan-alt-other)))
- `(package-status-held ((,class :foreground ,yellow-alt)))
- `(package-status-incompat ((,class :inherit bold :foreground ,yellow)))
- `(package-status-installed ((,class :foreground ,fg-special-warm)))
- `(package-status-new ((,class :inherit bold :foreground ,green)))
- `(package-status-unsigned ((,class :inherit bold :foreground ,red-alt)))
-;;;;; page-break-lines
- `(page-break-lines ((,class :inherit default :foreground ,fg-window-divider-outer)))
-;;;;; paradox
- `(paradox-archive-face ((,class :foreground ,fg-special-mild)))
- `(paradox-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(paradox-commit-tag-face ((,class :inherit modus-theme-refine-magenta :box t)))
- `(paradox-description-face ((,class :foreground ,fg-special-cold)))
- `(paradox-description-face-multiline ((,class :foreground ,fg-special-cold)))
- `(paradox-download-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,blue-alt-other)))
- `(paradox-highlight-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,cyan-alt-other)))
- `(paradox-homepage-button-face ((,class :foreground ,magenta-alt-other :underline t)))
- `(paradox-mode-line-face ((,class :inherit bold :foreground ,cyan-active)))
- `(paradox-name-face ((,class :foreground ,blue :underline t)))
- `(paradox-star-face ((,class :foreground ,magenta)))
- `(paradox-starred-face ((,class :foreground ,magenta-alt)))
-;;;;; paren-face
- `(parenthesis ((,class :foreground ,fg-unfocused)))
-;;;;; parrot
- `(parrot-rotate-rotation-highlight-face ((,class :inherit modus-theme-refine-magenta)))
-;;;;; pass
- `(pass-mode-directory-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(pass-mode-entry-face ((,class :background ,bg-main :foreground ,fg-main)))
- `(pass-mode-header-face ((,class :foreground ,fg-special-warm)))
-;;;;; persp-mode
- `(persp-face-lighter-buffer-not-in-persp ((,class :inherit modus-theme-intense-red)))
- `(persp-face-lighter-default ((,class :inherit bold :foreground ,blue-active)))
- `(persp-face-lighter-nil-persp ((,class :inherit bold :foreground ,fg-active)))
-;;;;; perspective
- `(persp-selected-face ((,class :inherit bold :foreground ,blue-active)))
-;;;;; phi-grep
- `(phi-grep-heading-face ((,class :inherit bold :foreground ,red-alt
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(phi-grep-line-number-face ((,class :foreground ,fg-special-warm)))
- `(phi-grep-match-face ((,class :inherit modus-theme-special-calm)))
- `(phi-grep-modified-face ((,class :inherit modus-theme-refine-yellow)))
- `(phi-grep-overlay-face ((,class :inherit modus-theme-refine-blue)))
-;;;;; phi-search
- `(phi-replace-preview-face ((,class :inherit modus-theme-intense-magenta)))
- `(phi-search-failpart-face ((,class :inherit modus-theme-refine-red)))
- `(phi-search-match-face ((,class :inherit modus-theme-refine-cyan)))
- `(phi-search-selection-face ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; pkgbuild-mode
- `(pkgbuild-error-face ((,class :underline ,fg-lang-error)))
-;;;;; pomidor
- `(pomidor-break-face ((,class :foreground ,blue-alt-other)))
- `(pomidor-overwork-face ((,class :foreground ,red-alt-other)))
- `(pomidor-skip-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(pomidor-work-face ((,class :foreground ,green-alt-other)))
-;;;;; powerline
- `(powerline-active0 ((,class :background ,bg-main :foreground ,blue-faint :inverse-video t)))
- `(powerline-active1 ((,class :background ,blue-nuanced-bg :foreground ,blue-nuanced)))
- `(powerline-active2 ((,class :background ,bg-active :foreground ,fg-active)))
- `(powerline-inactive0 ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
- `(powerline-inactive1 ((,class :background ,bg-dim :foreground ,fg-inactive)))
- `(powerline-inactive2 ((,class :background ,bg-inactive :foreground ,fg-inactive)))
-;;;;; powerline-evil
- `(powerline-evil-base-face ((,class :background ,fg-main :foreground ,bg-main)))
- `(powerline-evil-emacs-face ((,class :inherit modus-theme-active-magenta)))
- `(powerline-evil-insert-face ((,class :inherit modus-theme-active-green)))
- `(powerline-evil-motion-face ((,class :inherit modus-theme-active-blue)))
- `(powerline-evil-normal-face ((,class :background ,fg-alt :foreground ,bg-main)))
- `(powerline-evil-operator-face ((,class :inherit modus-theme-active-yellow)))
- `(powerline-evil-replace-face ((,class :inherit modus-theme-active-red)))
- `(powerline-evil-visual-face ((,class :inherit modus-theme-active-cyan)))
-;;;;; proced
- `(proced-mark ((,class :inherit modus-theme-mark-symbol)))
- `(proced-marked ((,class :inherit modus-theme-mark-alt)))
- `(proced-sort-header ((,class :inherit bold :foreground ,fg-special-calm :underline t)))
-;;;;; prodigy
- `(prodigy-green-face ((,class :foreground ,green)))
- `(prodigy-red-face ((,class :foreground ,red)))
- `(prodigy-yellow-face ((,class :foreground ,yellow)))
-;;;;; racket-mode
- `(racket-debug-break-face ((,class :inherit modus-theme-intense-red)))
- `(racket-debug-locals-face ((,class :box (:line-width -1 :color nil)
- :foreground ,green-alt-other)))
- `(racket-debug-result-face ((,class :inherit bold :box (:line-width -1 :color nil)
- :foreground ,green)))
- `(racket-here-string-face ((,class :foreground ,blue-alt)))
- `(racket-keyword-argument-face ((,class :foreground ,red-alt)))
- `(racket-logger-config-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(racket-logger-debug-face ((,class :foreground ,blue-alt-other)))
- `(racket-logger-info-face ((,class :foreground ,fg-lang-note)))
- `(racket-logger-topic-face ((,class :foreground ,magenta :slant ,modus-theme-slant)))
- `(racket-selfeval-face ((,class :foreground ,green-alt)))
- `(racket-xp-error-face
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
-;;;;; rainbow-blocks
- `(rainbow-blocks-depth-1-face ((,class :foreground ,magenta-alt-other)))
- `(rainbow-blocks-depth-2-face ((,class :foreground ,blue)))
- `(rainbow-blocks-depth-3-face ((,class :foreground ,magenta-alt)))
- `(rainbow-blocks-depth-4-face ((,class :foreground ,green)))
- `(rainbow-blocks-depth-5-face ((,class :foreground ,magenta)))
- `(rainbow-blocks-depth-6-face ((,class :foreground ,cyan)))
- `(rainbow-blocks-depth-7-face ((,class :foreground ,yellow)))
- `(rainbow-blocks-depth-8-face ((,class :foreground ,cyan-alt)))
- `(rainbow-blocks-depth-9-face ((,class :foreground ,red-alt)))
- `(rainbow-blocks-unmatched-face ((,class :foreground ,red)))
-;;;;; rainbow-identifiers
- `(rainbow-identifiers-identifier-1 ((,class :foreground ,green-alt-other)))
- `(rainbow-identifiers-identifier-2 ((,class :foreground ,magenta-alt-other)))
- `(rainbow-identifiers-identifier-3 ((,class :foreground ,cyan-alt-other)))
- `(rainbow-identifiers-identifier-4 ((,class :foreground ,yellow-alt-other)))
- `(rainbow-identifiers-identifier-5 ((,class :foreground ,blue-alt-other)))
- `(rainbow-identifiers-identifier-6 ((,class :foreground ,green-alt)))
- `(rainbow-identifiers-identifier-7 ((,class :foreground ,magenta-alt)))
- `(rainbow-identifiers-identifier-8 ((,class :foreground ,cyan-alt)))
- `(rainbow-identifiers-identifier-9 ((,class :foreground ,yellow-alt)))
- `(rainbow-identifiers-identifier-10 ((,class :foreground ,green)))
- `(rainbow-identifiers-identifier-11 ((,class :foreground ,magenta)))
- `(rainbow-identifiers-identifier-12 ((,class :foreground ,cyan)))
- `(rainbow-identifiers-identifier-13 ((,class :foreground ,yellow)))
- `(rainbow-identifiers-identifier-14 ((,class :foreground ,blue-alt)))
- `(rainbow-identifiers-identifier-15 ((,class :foreground ,red-alt)))
-;;;;; rainbow-delimiters
- `(rainbow-delimiters-base-face-error ((,class :foreground ,red)))
- `(rainbow-delimiters-base-face ((,class :foreground ,fg-main)))
- `(rainbow-delimiters-depth-1-face ((,class :foreground ,green-alt-other)))
- `(rainbow-delimiters-depth-2-face ((,class :foreground ,magenta-alt-other)))
- `(rainbow-delimiters-depth-3-face ((,class :foreground ,cyan-alt-other)))
- `(rainbow-delimiters-depth-4-face ((,class :foreground ,yellow-alt-other)))
- `(rainbow-delimiters-depth-5-face ((,class :foreground ,blue-alt-other)))
- `(rainbow-delimiters-depth-6-face ((,class :foreground ,green-alt)))
- `(rainbow-delimiters-depth-7-face ((,class :foreground ,magenta-alt)))
- `(rainbow-delimiters-depth-8-face ((,class :foreground ,cyan-alt)))
- `(rainbow-delimiters-depth-9-face ((,class :foreground ,yellow-alt)))
- `(rainbow-delimiters-mismatched-face ((,class :inherit bold :foreground ,red-alt)))
- `(rainbow-delimiters-unmatched-face ((,class :inherit bold :foreground ,red)))
-;;;;; rcirc
- `(rcirc-bright-nick ((,class :inherit bold :foreground ,magenta-alt)))
- `(rcirc-dim-nick ((,class :foreground ,fg-alt)))
- `(rcirc-my-nick ((,class :inherit bold :foreground ,magenta)))
- `(rcirc-nick-in-message ((,class :foreground ,magenta-alt-other)))
- `(rcirc-nick-in-message-full-line ((,class :inherit bold :foreground ,fg-special-mild)))
- `(rcirc-other-nick ((,class :inherit bold :foreground ,fg-special-cold)))
- `(rcirc-prompt ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(rcirc-server ((,class :foreground ,fg-unfocused)))
- `(rcirc-timestamp ((,class :foreground ,blue-nuanced)))
- `(rcirc-url ((,class :foreground ,blue :underline t)))
-;;;;; regexp-builder (re-builder)
- `(reb-match-0 ((,class :inherit modus-theme-intense-blue)))
- `(reb-match-1 ((,class :inherit modus-theme-intense-magenta)))
- `(reb-match-2 ((,class :inherit modus-theme-intense-green)))
- `(reb-match-3 ((,class :inherit modus-theme-intense-red)))
- `(reb-regexp-grouping-backslash ((,class :inherit bold :foreground ,fg-escape-char-backslash)))
- `(reb-regexp-grouping-construct ((,class :inherit bold :foreground ,fg-escape-char-construct)))
-;;;;; rg (rg.el)
- `(rg-column-number-face ((,class :foreground ,magenta-alt-other)))
- `(rg-context-face ((,class :foreground ,fg-unfocused)))
- `(rg-error-face ((,class :inherit bold :foreground ,red)))
- `(rg-file-tag-face ((,class :foreground ,fg-special-cold)))
- `(rg-filename-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(rg-line-number-face ((,class :foreground ,fg-special-warm)))
- `(rg-literal-face ((,class :foreground ,blue-alt)))
- `(rg-match-face ((,class :inherit modus-theme-special-calm)))
- `(rg-regexp-face ((,class :foreground ,magenta-active)))
- `(rg-toggle-off-face ((,class :inherit bold :foreground ,fg-inactive)))
- `(rg-toggle-on-face ((,class :inherit bold :foreground ,cyan-active)))
- `(rg-warning-face ((,class :inherit bold :foreground ,yellow)))
-;;;;; ripgrep
- `(ripgrep-context-face ((,class :foreground ,fg-unfocused)))
- `(ripgrep-error-face ((,class :inherit bold :foreground ,red)))
- `(ripgrep-hit-face ((,class :foreground ,cyan)))
- `(ripgrep-match-face ((,class :inherit modus-theme-special-calm)))
-;;;;; rmail
- `(rmail-header-name ((,class :foreground ,cyan-alt-other)))
- `(rmail-highlight ((,class :inherit bold :foreground ,magenta-alt)))
-;;;;; ruler-mode
- `(ruler-mode-column-number ((,class :inherit (ruler-mode-default bold) :foreground ,fg-main)))
- `(ruler-mode-comment-column ((,class :inherit ruler-mode-default :foreground ,red-active)))
- `(ruler-mode-current-column ((,class :inherit ruler-mode-default :foreground ,cyan-active :box t)))
- `(ruler-mode-default ((,class :background ,bg-inactive :foreground ,fg-inactive)))
- `(ruler-mode-fill-column ((,class :inherit ruler-mode-default :foreground ,green-active)))
- `(ruler-mode-fringes ((,class :inherit ruler-mode-default :foreground ,blue-active)))
- `(ruler-mode-goal-column ((,class :inherit ruler-mode-default :foreground ,magenta-active)))
- `(ruler-mode-margins ((,class :inherit ruler-mode-default :foreground ,bg-main)))
- `(ruler-mode-pad ((,class :background ,bg-active :foreground ,fg-inactive)))
- `(ruler-mode-tab-stop ((,class :inherit ruler-mode-default :foreground ,yellow-active)))
-;;;;; sallet
- `(sallet-buffer-compressed ((,class :foreground ,yellow-nuanced :slant italic)))
- `(sallet-buffer-default-directory ((,class :foreground ,cyan-nuanced)))
- `(sallet-buffer-directory ((,class :foreground ,blue-nuanced)))
- `(sallet-buffer-help ((,class :foreground ,fg-special-cold)))
- `(sallet-buffer-modified ((,class :foreground ,yellow-alt-other :slant italic)))
- `(sallet-buffer-ordinary ((,class :foreground ,fg-main)))
- `(sallet-buffer-read-only ((,class :foreground ,yellow-alt)))
- `(sallet-buffer-size ((,class :foreground ,fg-special-calm)))
- `(sallet-buffer-special ((,class :foreground ,magenta-alt-other)))
- `(sallet-flx-match ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-cyan
- 'modus-theme-refine-cyan
- 'modus-theme-nuanced-cyan
- cyan-alt-other))))
- `(sallet-recentf-buffer-name ((,class :foreground ,blue-nuanced)))
- `(sallet-recentf-file-path ((,class :foreground ,fg-special-mild)))
- `(sallet-regexp-match ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other))))
- `(sallet-source-header ((,class :inherit bold :foreground ,red-alt
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(sallet-substring-match ((,class ,@(modus-operandi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-refine-blue
- 'modus-theme-nuanced-blue
- blue-alt-other))))
-;;;;; selectrum
- `(selectrum-current-candidate
- ((,class :inherit bold :foreground ,fg-main :underline ,fg-main
- :background ,@(pcase modus-operandi-theme-completions
- ('opinionated (list bg-active))
- (_ (list bg-inactive))))))
- `(selectrum-primary-highlight ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- magenta-alt magenta-nuanced-bg
- magenta-refine-bg magenta-refine-fg))))
- `(selectrum-secondary-highlight ((,class :inherit bold
- ,@(modus-operandi-theme-standard-completions
- cyan-alt-other cyan-nuanced-bg
- cyan-refine-bg cyan-refine-fg))))
-;;;;; semantic
- `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t)))
- `(semantic-decoration-on-private-members-face ((,class :inherit modus-theme-refine-cyan)))
- `(semantic-decoration-on-protected-members-face ((,class :background ,bg-dim)))
- `(semantic-highlight-edits-face ((,class :background ,bg-alt)))
- `(semantic-highlight-func-current-tag-face ((,class :background ,bg-alt)))
- `(semantic-idle-symbol-highlight ((,class :inherit modus-theme-special-mild)))
- `(semantic-tag-boundary-face ((,class :overline ,blue-intense)))
- `(semantic-unmatched-syntax-face ((,class :underline ,fg-lang-error)))
-;;;;; sesman
- `(sesman-browser-button-face ((,class :foreground ,blue-alt-other :underline t)))
- `(sesman-browser-highligh-face ((,class :inherit modus-theme-subtle-blue)))
- `(sesman-buffer-face ((,class :foreground ,magenta)))
- `(sesman-directory-face ((,class :inherit bold :foreground ,blue)))
- `(sesman-project-face ((,class :inherit bold :foreground ,magenta-alt-other)))
-;;;;; shell-script-mode
- `(sh-heredoc ((,class :foreground ,blue-alt)))
- `(sh-quoted-exec ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt)))
-;;;;; show-paren-mode
- `(show-paren-match ((,class ,@(modus-operandi-theme-paren bg-paren-match
- bg-paren-match-intense)
- :foreground ,fg-main)))
- `(show-paren-match-expression ((,class :inherit modus-theme-special-calm)))
- `(show-paren-mismatch ((,class :inherit modus-theme-intense-red)))
-;;;;; side-notes
- `(side-notes ((,class :background ,bg-dim :foreground ,fg-dim)))
-;;;;; skewer-mode
- `(skewer-error-face ((,class :foreground ,red :underline t)))
-;;;;; smart-mode-line
- `(sml/charging ((,class :foreground ,green-active)))
- `(sml/discharging ((,class :foreground ,red-active)))
- `(sml/filename ((,class :inherit bold :foreground ,blue-active)))
- `(sml/folder ((,class :foreground ,fg-active)))
- `(sml/git ((,class :inherit bold :foreground ,green-active)))
- `(sml/global ((,class :foreground ,fg-active)))
- `(sml/line-number ((,class :inherit sml/global)))
- `(sml/minor-modes ((,class :inherit sml/global)))
- `(sml/modes ((,class :inherit bold :foreground ,fg-active)))
- `(sml/modified ((,class :inherit bold :foreground ,magenta-active)))
- `(sml/mule-info ((,class :inherit sml/global)))
- `(sml/name-filling ((,class :foreground ,yellow-active)))
- `(sml/not-modified ((,class :inherit sml/global)))
- `(sml/numbers-separator ((,class :inherit sml/global)))
- `(sml/outside-modified ((,class :inherit modus-theme-intense-red)))
- `(sml/position-percentage ((,class :inherit sml/global)))
- `(sml/prefix ((,class :foreground ,green-active)))
- `(sml/process ((,class :inherit sml/prefix)))
- `(sml/projectile ((,class :inherit sml/git)))
- `(sml/read-only ((,class :inherit bold :foreground ,cyan-active)))
- `(sml/remote ((,class :inherit sml/global)))
- `(sml/sudo ((,class :inherit modus-theme-subtle-red)))
- `(sml/time ((,class :inherit sml/global)))
- `(sml/vc ((,class :inherit sml/git)))
- `(sml/vc-edited ((,class :inherit bold :foreground ,yellow-active)))
-;;;;; smartparens
- `(sp-pair-overlay-face ((,class :inherit modus-theme-special-warm)))
- `(sp-show-pair-enclosing ((,class :inherit modus-theme-special-mild)))
- `(sp-show-pair-match-face ((,class ,@(modus-operandi-theme-paren bg-paren-match
- bg-paren-match-intense)
- :foreground ,fg-main)))
- `(sp-show-pair-mismatch-face ((,class :inherit modus-theme-intense-red)))
- `(sp-wrap-overlay-closing-pair ((,class :inherit sp-pair-overlay-face)))
- `(sp-wrap-overlay-face ((,class :inherit sp-pair-overlay-face)))
- `(sp-wrap-overlay-opening-pair ((,class :inherit sp-pair-overlay-face)))
- `(sp-wrap-tag-overlay-face ((,class :inherit sp-pair-overlay-face)))
-;;;;; smerge
- `(smerge-base ((,class :inherit modus-theme-diff-changed)))
- `(smerge-lower ((,class :inherit modus-theme-diff-added)))
- `(smerge-markers ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(smerge-refined-added ((,class :inherit modus-theme-diff-refine-added)))
- `(smerge-refined-changed ((,class)))
- `(smerge-refined-removed ((,class :inherit modus-theme-diff-refine-removed)))
- `(smerge-upper ((,class :inherit modus-theme-diff-removed)))
-;;;;; spaceline
- `(spaceline-evil-emacs ((,class :inherit modus-theme-active-magenta)))
- `(spaceline-evil-insert ((,class :inherit modus-theme-active-green)))
- `(spaceline-evil-motion ((,class :inherit modus-theme-active-blue)))
- `(spaceline-evil-normal ((,class :background ,fg-alt :foreground ,bg-alt)))
- `(spaceline-evil-replace ((,class :inherit modus-theme-active-red)))
- `(spaceline-evil-visual ((,class :inherit modus-theme-active-cyan)))
- `(spaceline-flycheck-error ((,class :foreground ,red-active)))
- `(spaceline-flycheck-info ((,class :foreground ,cyan-active)))
- `(spaceline-flycheck-warning ((,class :foreground ,yellow-active)))
- `(spaceline-highlight-face ((,class :inherit modus-theme-fringe-blue)))
- `(spaceline-modified ((,class :inherit modus-theme-fringe-magenta)))
- `(spaceline-python-venv ((,class :foreground ,magenta-active)))
- `(spaceline-read-only ((,class :inherit modus-theme-fringe-red)))
- `(spaceline-unmodified ((,class :inherit modus-theme-fringe-cyan)))
-;;;;; speedbar
- `(speedbar-button-face ((,class :inherit link)))
- `(speedbar-directory-face ((,class :inherit bold :foreground ,blue)))
- `(speedbar-file-face ((,class :foreground ,fg-main)))
- `(speedbar-highlight-face ((,class :inherit modus-theme-subtle-blue)))
- `(speedbar-selected-face ((,class :inherit bold :foreground ,cyan)))
- `(speedbar-separator-face ((,class :inherit modus-theme-intense-neutral)))
- `(speedbar-tag-face ((,class :foreground ,yellow-alt-other)))
-;;;;; spell-fu
- `(spell-fu-incorrect-face
- ((,(append '((supports :underline (:style wave))) class)
- :foreground ,fg-lang-error :underline (:style wave))
- (,class :foreground ,fg-lang-error :underline t)))
-;;;;; stripes
- `(stripes ((,class :inherit modus-theme-hl-line)))
-;;;;; success
- `(suggest-heading ((,class :inherit bold :foreground ,yellow-alt-other)))
-;;;;; switch-window
- `(switch-window-background ((,class :background ,bg-dim)))
- `(switch-window-label ((,class :height 3.0 :foreground ,blue-intense)))
-;;;;; swiper
- `(swiper-background-match-face-1 ((,class :inherit modus-theme-subtle-neutral)))
- `(swiper-background-match-face-2 ((,class :inherit modus-theme-subtle-cyan)))
- `(swiper-background-match-face-3 ((,class :inherit modus-theme-subtle-magenta)))
- `(swiper-background-match-face-4 ((,class :inherit modus-theme-subtle-green)))
- `(swiper-line-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :inherit modus-theme-special-cold)))
- `(swiper-match-face-1 ((,class :inherit swiper-line-face)))
- `(swiper-match-face-2 ((,class :inherit swiper-line-face)))
- `(swiper-match-face-3 ((,class :inherit swiper-line-face)))
- `(swiper-match-face-4 ((,class :inherit swiper-line-face)))
-;;;;; swoop
- `(swoop-face-header-format-line ((,class :inherit bold :foreground ,red-alt
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-3))))
- `(swoop-face-line-buffer-name ((,class :inherit bold :foreground ,blue-alt
- ,@(modus-operandi-theme-scale modus-operandi-theme-scale-4))))
- `(swoop-face-line-number ((,class :foreground ,fg-special-warm)))
- `(swoop-face-target-line ((,class :inherit modus-theme-intense-blue
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(swoop-face-target-words ((,class :inherit modus-theme-refine-cyan)))
-;;;;; sx
- `(sx-inbox-item-type ((,class :foreground ,magenta-alt-other)))
- `(sx-inbox-item-type-unread ((,class :inherit (sx-inbox-item-type bold))))
- `(sx-question-list-answers ((,class :foreground ,green)))
- `(sx-question-list-answers-accepted ((,class :box t :foreground ,green)))
- `(sx-question-list-bounty ((,class :inherit bold :background ,bg-alt :foreground ,yellow)))
- `(sx-question-list-date ((,class :foreground ,fg-special-cold)))
- `(sx-question-list-favorite ((,class :inherit bold :foreground ,fg-special-warm)))
- `(sx-question-list-parent ((,class :foreground ,fg-main)))
- `(sx-question-list-read-question ((,class :foreground ,fg-alt)))
- `(sx-question-list-score ((,class :foreground ,fg-special-mild)))
- `(sx-question-list-score-upvoted ((,class :inherit (sx-question-list-score bold))))
- `(sx-question-list-unread-question ((,class :inherit bold :foreground ,fg-main)))
- `(sx-question-mode-accepted ((,class :inherit bold :height 1.3 :foreground ,green)))
- `(sx-question-mode-closed ((,class :inherit modus-theme-active-yellow :box (:line-width 2 :color nil))))
- `(sx-question-mode-closed-reason ((,class :box (:line-width 2 :color nil) :foreground ,fg-main)))
- `(sx-question-mode-content-face ((,class :background ,bg-dim)))
- `(sx-question-mode-date ((,class :foreground ,blue)))
- `(sx-question-mode-header ((,class :inherit bold :foreground ,cyan)))
- `(sx-question-mode-kbd-tag ((,class :inherit bold :height 0.9 :box (:line-width 3 :color ,fg-main :style released-button) :foreground ,fg-main)))
- `(sx-question-mode-score ((,class :foreground ,fg-dim)))
- `(sx-question-mode-score-downvoted ((,class :foreground ,yellow)))
- `(sx-question-mode-score-upvoted ((,class :inherit bold :foreground ,magenta)))
- `(sx-question-mode-title ((,class :inherit bold :foreground ,fg-main)))
- `(sx-question-mode-title-comments ((,class :inherit bold :foreground ,fg-alt)))
- `(sx-tag ((,class :foreground ,magenta-alt)))
- `(sx-user-name ((,class :foreground ,blue-alt)))
- `(sx-user-reputation ((,class :foreground ,fg-alt)))
-;;;;; symbol-overlay
- `(symbol-overlay-default-face ((,class :inherit modus-theme-special-warm)))
- `(symbol-overlay-face-1 ((,class :inherit modus-theme-intense-blue)))
- `(symbol-overlay-face-2 ((,class :inherit modus-theme-refine-magenta)))
- `(symbol-overlay-face-3 ((,class :inherit modus-theme-intense-yellow)))
- `(symbol-overlay-face-4 ((,class :inherit modus-theme-intense-magenta)))
- `(symbol-overlay-face-5 ((,class :inherit modus-theme-intense-red)))
- `(symbol-overlay-face-6 ((,class :inherit modus-theme-refine-red)))
- `(symbol-overlay-face-7 ((,class :inherit modus-theme-intense-cyan)))
- `(symbol-overlay-face-8 ((,class :inherit modus-theme-refine-cyan)))
-;;;;; syslog-mode
- `(syslog-debug ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(syslog-error ((,class :inherit bold :foreground ,red)))
- `(syslog-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(syslog-hide ((,class :background ,bg-main :foreground ,fg-main)))
- `(syslog-hour ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(syslog-info ((,class :inherit bold :foreground ,blue-alt-other)))
- `(syslog-ip ((,class :inherit bold :foreground ,fg-special-mild :underline t)))
- `(syslog-su ((,class :inherit bold :foreground ,red-alt)))
- `(syslog-warn ((,class :inherit bold :foreground ,yellow)))
-;;;;; table (built-in table.el)
- `(table-cell ((,class :background ,blue-nuanced-bg)))
-;;;;; telephone-line
- `(telephone-line-accent-active ((,class :background ,fg-inactive :foreground ,bg-inactive)))
- `(telephone-line-accent-inactive ((,class :background ,bg-active :foreground ,fg-active)))
- `(telephone-line-error ((,class :inherit bold :foreground ,red-active)))
- `(telephone-line-evil ((,class :foreground ,fg-main)))
- `(telephone-line-evil-emacs ((,class :inherit telephone-line-evil :background ,magenta-intense-bg)))
- `(telephone-line-evil-insert ((,class :inherit telephone-line-evil :background ,green-intense-bg)))
- `(telephone-line-evil-motion ((,class :inherit telephone-line-evil :background ,yellow-intense-bg)))
- `(telephone-line-evil-normal ((,class :inherit telephone-line-evil :background ,bg-alt)))
- `(telephone-line-evil-operator ((,class :inherit telephone-line-evil :background ,yellow-subtle-bg)))
- `(telephone-line-evil-replace ((,class :inherit telephone-line-evil :background ,red-intense-bg)))
- `(telephone-line-evil-visual ((,class :inherit telephone-line-evil :background ,cyan-intense-bg)))
- `(telephone-line-projectile ((,class :foreground ,cyan-active)))
- `(telephone-line-unimportant ((,class :foreground ,fg-inactive)))
- `(telephone-line-warning ((,class :inherit bold :foreground ,yellow-active)))
-;;;;; term
- `(term ((,class :background ,bg-main :foreground ,fg-main)))
- `(term-bold ((,class :inherit bold)))
- `(term-color-blue ((,class :background ,blue :foreground ,blue)))
- `(term-color-cyan ((,class :background ,cyan :foreground ,cyan)))
- `(term-color-green ((,class :background ,green :foreground ,green)))
- `(term-color-magenta ((,class :background ,magenta :foreground ,magenta)))
- `(term-color-red ((,class :background ,red :foreground ,red)))
- `(term-color-yellow ((,class :background ,yellow :foreground ,yellow)))
- `(term-underline ((,class :underline t)))
-;;;;; tomatinho
- `(tomatinho-ok-face ((,class :foreground ,blue-intense)))
- `(tomatinho-pause-face ((,class :foreground ,yellow-intense)))
- `(tomatinho-reset-face ((,class :foreground ,fg-alt)))
-;;;;; transient
- `(transient-active-infix ((,class :inherit modus-theme-special-mild)))
- `(transient-amaranth ((,class :inherit bold :foreground ,yellow)))
- `(transient-argument ((,class :inherit bold :foreground ,red-alt)))
- `(transient-blue ((,class :inherit bold :foreground ,blue)))
- `(transient-disabled-suffix ((,class :inherit modus-theme-intense-red)))
- `(transient-enabled-suffix ((,class :inherit modus-theme-intense-green)))
- `(transient-heading ((,class :inherit bold :foreground ,fg-main)))
- `(transient-inactive-argument ((,class :foreground ,fg-alt)))
- `(transient-inactive-value ((,class :foreground ,fg-alt)))
- `(transient-key ((,class :inherit bold :foreground ,blue)))
- `(transient-mismatched-key ((,class :underline t)))
- `(transient-nonstandard-key ((,class :underline t)))
- `(transient-pink ((,class :inherit bold :foreground ,magenta)))
- `(transient-red ((,class :inherit bold :foreground ,red-intense)))
- `(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(transient-unreachable ((,class :foreground ,fg-unfocused)))
- `(transient-unreachable-key ((,class :foreground ,fg-unfocused)))
- `(transient-value ((,class :foreground ,magenta-alt)))
-;;;;; trashed
- `(trashed-deleted ((,class :inherit modus-theme-mark-del)))
- `(trashed-directory ((,class :foreground ,blue)))
- `(trashed-mark ((,class :inherit modus-theme-mark-symbol)))
- `(trashed-marked ((,class :inherit modus-theme-mark-alt)))
- `(trashed-restored ((,class :inherit modus-theme-mark-sel)))
- `(trashed-symlink ((,class :inherit button :foreground ,cyan-alt)))
-;;;;; treemacs
- `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt)))
- `(treemacs-directory-face ((,class :inherit dired-directory)))
- `(treemacs-file-face ((,class :foreground ,fg-main)))
- `(treemacs-fringe-indicator-face ((,class :foreground ,fg-main)))
- `(treemacs-git-added-face ((,class :foreground ,green-intense)))
- `(treemacs-git-conflict-face ((,class :inherit (modus-theme-intense-red bold))))
- `(treemacs-git-ignored-face ((,class :foreground ,fg-alt)))
- `(treemacs-git-modified-face ((,class :foreground ,yellow-alt-other)))
- `(treemacs-git-renamed-face ((,class :foreground ,cyan-alt-other)))
- `(treemacs-git-unmodified-face ((,class :foreground ,fg-main)))
- `(treemacs-git-untracked-face ((,class :foreground ,red-alt-other)))
- `(treemacs-help-column-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,magenta-alt-other :underline t)))
- `(treemacs-help-title-face ((,class :foreground ,blue-alt-other)))
- `(treemacs-on-failure-pulse-face ((,class :inherit modus-theme-intense-red)))
- `(treemacs-on-success-pulse-face ((,class :inherit modus-theme-intense-green)))
- `(treemacs-root-face ((,class :inherit bold :foreground ,blue-alt-other :height 1.2 :underline t)))
- `(treemacs-root-remote-disconnected-face ((,class :inherit treemacs-root-remote-face :foreground ,yellow)))
- `(treemacs-root-remote-face ((,class :inherit treemacs-root-face :foreground ,magenta)))
- `(treemacs-root-remote-unreadable-face ((,class :inherit treemacs-root-unreadable-face)))
- `(treemacs-root-unreadable-face ((,class :inherit treemacs-root-face :strike-through t)))
- `(treemacs-tags-face ((,class :foreground ,blue-alt)))
- `(treemacs-tags-face ((,class :foreground ,magenta-alt)))
-;;;;; tty-menu
- `(tty-menu-disabled-face ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(tty-menu-enabled-face ((,class :inherit bold :background ,bg-alt :foreground ,fg-main)))
- `(tty-menu-selected-face ((,class :inherit modus-theme-intense-blue)))
-;;;;; tuareg
- `(caml-types-def-face ((,class :inherit modus-theme-subtle-red)))
- `(caml-types-expr-face ((,class :inherit modus-theme-subtle-green)))
- `(caml-types-occ-face ((,class :inherit modus-theme-subtle-green)))
- `(caml-types-scope-face ((,class :inherit modus-theme-subtle-blue)))
- `(caml-types-typed-face ((,class :inherit modus-theme-subtle-magenta)))
- `(tuareg-font-double-semicolon-face ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(tuareg-font-lock-attribute-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(tuareg-font-lock-constructor-face ((,class :foreground ,fg-main)))
- `(tuareg-font-lock-error-face ((,class :inherit (modus-theme-intense-red bold))))
- `(tuareg-font-lock-extension-node-face ((,class :background ,bg-alt :foreground ,magenta)))
- `(tuareg-font-lock-governing-face ((,class :inherit bold :foreground ,fg-main)))
- `(tuareg-font-lock-infix-extension-node-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(tuareg-font-lock-interactive-directive-face ((,class :foreground ,fg-special-cold)))
- `(tuareg-font-lock-interactive-error-face ((,class :inherit bold
- ,@(modus-operandi-theme-syntax-foreground
- red red-faint))))
- `(tuareg-font-lock-interactive-output-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(tuareg-font-lock-label-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(tuareg-font-lock-line-number-face ((,class :foreground ,fg-special-warm)))
- `(tuareg-font-lock-module-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(tuareg-font-lock-multistage-face ((,class :inherit bold :background ,bg-alt
- ,@(modus-operandi-theme-syntax-foreground
- blue blue-faint))))
- `(tuareg-font-lock-operator-face ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(tuareg-opam-error-face ((,class :inherit bold
- ,@(modus-operandi-theme-syntax-foreground
- red red-faint))))
- `(tuareg-opam-pkg-variable-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint)
- :slant ,modus-theme-slant)))
-;;;;; typescript
- `(typescript-jsdoc-tag ((,class :foreground ,fg-special-mild :slant ,modus-theme-slant)))
- `(typescript-jsdoc-type ((,class :foreground ,fg-special-calm :slant ,modus-theme-slant)))
- `(typescript-jsdoc-value ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
-;;;;; undo-tree
- `(undo-tree-visualizer-active-branch-face ((,class :inherit bold :foreground ,fg-main)))
- `(undo-tree-visualizer-current-face ((,class :foreground ,blue-intense)))
- `(undo-tree-visualizer-default-face ((,class :foreground ,fg-alt)))
- `(undo-tree-visualizer-register-face ((,class :foreground ,magenta-intense)))
- `(undo-tree-visualizer-unmodified-face ((,class :foreground ,green-intense)))
-;;;;; vc (vc-hooks.el)
- `(vc-conflict-state ((,class :foreground ,red-active :slant ,modus-theme-slant)))
- `(vc-edited-state ((,class :foreground ,yellow-active)))
- `(vc-locally-added-state ((,class :foreground ,cyan-active)))
- `(vc-locked-state ((,class :foreground ,blue-active)))
- `(vc-missing-state ((,class :foreground ,magenta-active :slant ,modus-theme-slant)))
- `(vc-needs-update-state ((,class :foreground ,green-active :slant ,modus-theme-slant)))
- `(vc-removed-state ((,class :foreground ,red-active)))
- `(vc-state-base ((,class :foreground ,fg-active)))
- `(vc-up-to-date-state ((,class :foreground ,fg-special-cold)))
-;;;;; vdiff
- `(vdiff-addition-face ((,class :inherit modus-theme-diff-added)))
- `(vdiff-change-face ((,class :inherit modus-theme-diff-changed)))
- `(vdiff-closed-fold-face ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
- `(vdiff-refine-added ((,class :inherit modus-theme-diff-refine-added)))
- `(vdiff-refine-changed ((,class :inherit modus-theme-diff-refine-changed)))
- `(vdiff-subtraction-face ((,class :inherit modus-theme-diff-removed)))
- `(vdiff-target-face ((,class :inherit modus-theme-intense-blue)))
-;;;;; vimish-fold
- `(vimish-fold-fringe ((,class :foreground ,cyan-active)))
- `(vimish-fold-mouse-face ((,class :inherit modus-theme-intense-blue)))
- `(vimish-fold-overlay ((,class :background ,bg-alt :foreground ,fg-special-cold)))
-;;;;; visible-mark
- `(visible-mark-active ((,class :background ,blue-intense-bg)))
- `(visible-mark-face1 ((,class :background ,cyan-intense-bg)))
- `(visible-mark-face2 ((,class :background ,yellow-intense-bg)))
- `(visible-mark-forward-face1 ((,class :background ,magenta-intense-bg)))
- `(visible-mark-forward-face2 ((,class :background ,green-intense-bg)))
-;;;;; visual-regexp
- `(vr/group-0 ((,class :inherit modus-theme-intense-blue)))
- `(vr/group-1 ((,class :inherit modus-theme-intense-magenta)))
- `(vr/group-2 ((,class :inherit modus-theme-intense-green)))
- `(vr/match-0 ((,class :inherit modus-theme-refine-yellow)))
- `(vr/match-1 ((,class :inherit modus-theme-refine-yellow)))
- `(vr/match-separator-face ((,class :inherit (modus-theme-intense-neutral bold))))
-;;;;; volatile-highlights
- `(vhl/default-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :background ,bg-alt :foreground ,blue-nuanced)))
-;;;;; vterm
- `(vterm-color-black ((,class :background "gray35" :foreground "gray35")))
- `(vterm-color-blue ((,class :background ,blue :foreground ,blue)))
- `(vterm-color-cyan ((,class :background ,cyan :foreground ,cyan)))
- `(vterm-color-default ((,class :background ,bg-main :foreground ,fg-main)))
- `(vterm-color-green ((,class :background ,green :foreground ,green)))
- `(vterm-color-inverse-video ((,class :background ,bg-main :inverse-video t)))
- `(vterm-color-magenta ((,class :background ,magenta :foreground ,magenta)))
- `(vterm-color-red ((,class :background ,red :foreground ,red)))
- `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t)))
- `(vterm-color-white ((,class :background "gray65" :foreground "gray65")))
- `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow)))
-;;;;; wcheck-mode
- `(wcheck-default-face ((,class :foreground ,red :underline t)))
-;;;;; web-mode
- `(web-mode-annotation-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-annotation-html-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-annotation-tag-face ((,class :inherit web-mode-comment-face :underline t)))
- `(web-mode-block-attr-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue blue-faint))))
- `(web-mode-block-attr-value-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(web-mode-block-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-block-control-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-block-delimiter-face ((,class :foreground ,fg-main)))
- `(web-mode-block-face ((,class :background ,bg-dim)))
- `(web-mode-block-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-bold-face ((,class :inherit bold)))
- `(web-mode-builtin-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(web-mode-comment-keyword-face ((,class :inherit bold :background ,bg-dim
- ,@(modus-operandi-theme-syntax-foreground
- yellow yellow-faint))))
- `(web-mode-constant-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-css-at-rule-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-css-color-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-css-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-css-function-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-css-priority-face ((,class ,@(modus-operandi-theme-syntax-foreground
- yellow-alt yellow-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-css-property-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-css-pseudo-class-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(web-mode-css-selector-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-css-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-css-variable-face ((,class :foreground ,fg-special-warm)))
- `(web-mode-current-column-highlight-face ((,class :background ,bg-alt)))
- `(web-mode-current-element-highlight-face ((,class :inherit modus-theme-special-mild)))
- `(web-mode-doctype-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(web-mode-error-face ((,class :inherit modus-theme-intense-red)))
- `(web-mode-filter-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-folded-face ((,class :underline t)))
- `(web-mode-function-call-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-function-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-html-attr-custom-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-html-attr-engine-face ((,class :foreground ,fg-main)))
- `(web-mode-html-attr-equal-face ((,class :foreground ,fg-main)))
- `(web-mode-html-attr-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-html-attr-value-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-html-entity-face ((,class ,@(modus-operandi-theme-syntax-foreground
- yellow-alt-other yellow-alt-other-faint)
- :slant ,modus-theme-slant)))
- `(web-mode-html-tag-bracket-face ((,class :foreground ,fg-dim)))
- `(web-mode-html-tag-custom-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-html-tag-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-html-tag-namespaced-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-html-tag-unclosed-face ((,class ,@(modus-operandi-theme-syntax-foreground
- red red-faint)
- :underline t)))
- `(web-mode-inlay-face ((,class :background ,bg-alt)))
- `(web-mode-italic-face ((,class :slant italic)))
- `(web-mode-javascript-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-javascript-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-json-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-json-context-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(web-mode-json-key-face ((,class :foreground ,blue-nuanced)))
- `(web-mode-json-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-jsx-depth-1-face ((,class :background ,blue-intense-bg :foreground ,fg-main)))
- `(web-mode-jsx-depth-2-face ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
- `(web-mode-jsx-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
- `(web-mode-jsx-depth-4-face ((,class :background ,bg-alt :foreground ,blue-refine-fg)))
- `(web-mode-jsx-depth-5-face ((,class :background ,bg-alt :foreground ,blue-nuanced)))
- `(web-mode-keyword-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-operandi-theme-bold-weight))))
- `(web-mode-param-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-part-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-part-face ((,class :inherit web-mode-block-face)))
- `(web-mode-part-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-preprocessor-face ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt-other red-alt-other-faint))))
- `(web-mode-script-face ((,class :inherit web-mode-part-face)))
- `(web-mode-sql-keyword-face ((,class :inherit bold
- ,@(modus-operandi-theme-syntax-foreground
- yellow yellow-faint))))
- `(web-mode-string-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt blue-alt-faint))))
- `(web-mode-style-face ((,class :inherit web-mode-part-face)))
- `(web-mode-symbol-face ((,class ,@(modus-operandi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-type-face ((,class ,@(modus-operandi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(web-mode-underline-face ((,class :underline t)))
- `(web-mode-variable-name-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-warning-face ((,class :inherit bold :background ,bg-alt
- ,@(modus-operandi-theme-syntax-foreground
- yellow-alt-other yellow-alt-other-faint))))
- `(web-mode-whitespace-face ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
-;;;;; wgrep
- `(wgrep-delete-face ((,class :inherit modus-theme-refine-yellow)))
- `(wgrep-done-face ((,class :inherit modus-theme-refine-blue)))
- `(wgrep-face ((,class :inherit modus-theme-refine-green)))
- `(wgrep-file-face ((,class :foreground ,fg-special-warm)))
- `(wgrep-reject-face ((,class :inherit (modus-theme-intense-red bold))))
-;;;;; which-function-mode
- `(which-func ((,class :foreground ,magenta-active)))
-;;;;; which-key
- `(which-key-command-description-face ((,class :foreground ,cyan)))
- `(which-key-group-description-face ((,class :foreground ,magenta-alt)))
- `(which-key-highlighted-command-face ((,class :foreground ,cyan-alt :underline t)))
- `(which-key-key-face ((,class :inherit bold :foreground ,blue-intense)))
- `(which-key-local-map-description-face ((,class :foreground ,fg-main)))
- `(which-key-note-face ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(which-key-separator-face ((,class :foreground ,fg-alt)))
- `(which-key-special-key-face ((,class :inherit bold :foreground ,yellow-intense)))
-;;;;; whitespace-mode
- `(whitespace-big-indent ((,class :inherit modus-theme-subtle-red)))
- `(whitespace-empty ((,class :inherit modus-theme-intense-magenta)))
- `(whitespace-hspace ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-indentation ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-line ((,class :inherit modus-theme-special-warm)))
- `(whitespace-newline ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-space ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-space-after-tab ((,class :inherit modus-theme-subtle-magenta)))
- `(whitespace-space-before-tab ((,class :inherit modus-theme-subtle-cyan)))
- `(whitespace-tab ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-trailing ((,class :inherit modus-theme-intense-red)))
-;;;;; window-divider-mode
- `(window-divider ((,class :foreground ,fg-window-divider-inner)))
- `(window-divider-first-pixel ((,class :foreground ,fg-window-divider-outer)))
- `(window-divider-last-pixel ((,class :foreground ,fg-window-divider-outer)))
-;;;;; winum
- `(winum-face ((,class ,@(modus-operandi-theme-bold-weight) :foreground ,cyan-active)))
-;;;;; writegood-mode
- `(writegood-duplicates-face ((,class :background ,bg-alt :foreground ,red-alt :underline t)))
- `(writegood-passive-voice-face ((,class :foreground ,yellow-nuanced :underline ,fg-lang-warning)))
- `(writegood-weasels-face ((,class :foreground ,red-nuanced :underline ,fg-lang-error)))
-;;;;; woman
- `(woman-addition ((,class :foreground ,magenta-alt-other)))
- `(woman-bold ((,class :inherit bold :foreground ,magenta)))
- `(woman-italic ((,class :foreground ,cyan :slant italic)))
- `(woman-unknown ((,class :foreground ,yellow :slant italic)))
-;;;;; xah-elisp-mode
- `(xah-elisp-at-symbol ((,class :inherit bold
- ,@(modus-operandi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(xah-elisp-cap-variable ((,class ,@(modus-operandi-theme-syntax-foreground
- red-alt-other red-alt-other-faint))))
- `(xah-elisp-command-face ((,class ,@(modus-operandi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(xah-elisp-dollar-symbol ((,class ,@(modus-operandi-theme-syntax-foreground
- green green-faint))))
-;;;;; xref
- `(xref-file-header ((,class :inherit bold :foreground ,fg-special-cold)))
- `(xref-line-number ((,class :foreground ,fg-alt)))
- `(xref-match ((,class :inherit match)))
-;;;;; yaml-mode
- `(yaml-tab-face ((,class :inherit modus-theme-intense-red)))
-;;;;; yasnippet
- `(yas-field-highlight-face ((,class :background ,bg-alt :foreground ,fg-main)))
-;;;;; ztree
- `(ztreep-arrow-face ((,class :foreground ,fg-inactive)))
- `(ztreep-diff-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold)))
- `(ztreep-diff-header-small-face ((,class :inherit bold :foreground ,fg-special-mild)))
- `(ztreep-diff-model-add-face ((,class :foreground ,green)))
- `(ztreep-diff-model-diff-face ((,class :foreground ,red)))
- `(ztreep-diff-model-ignored-face ((,class :foreground ,fg-alt :strike-through t)))
- `(ztreep-diff-model-normal-face ((,class :foreground ,fg-alt)))
- `(ztreep-expand-sign-face ((,class :foreground ,blue)))
- `(ztreep-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold)))
- `(ztreep-leaf-face ((,class :foreground ,cyan)))
- `(ztreep-node-count-children-face ((,class :foreground ,fg-special-warm)))
- `(ztreep-node-face ((,class :foreground ,fg-main))))
-;;;; Emacs 27+
- (when (>= emacs-major-version 27)
- (custom-theme-set-faces
- 'modus-operandi
-;;;;; line numbers (`display-line-numbers-mode' and global variant)
- ;; NOTE that this is specifically for the faces that were
- ;; introduced in Emacs 27, as the other faces are already
- ;; supported.
- `(line-number-major-tick ((,class :inherit (bold default)
- :background ,yellow-nuanced-bg
- :foreground ,yellow-nuanced)))
- `(line-number-minor-tick ((,class :inherit (bold default)
- :background ,bg-inactive
- :foreground ,fg-inactive)))
-;;;;; tab-bar-mode
- `(tab-bar ((,class :background ,bg-tab-bar :foreground ,fg-main)))
- `(tab-bar-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active)
- :background ,bg-tab-active :foreground ,fg-main)))
- `(tab-bar-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive)
- :background ,bg-tab-inactive :foreground ,fg-dim)))
-;;;;; tab-line-mode
- `(tab-line ((,class :height 0.95 :background ,bg-tab-bar :foreground ,fg-main)))
- `(tab-line-close-highlight ((,class :foreground ,red)))
- `(tab-line-highlight ((,class :background ,blue-subtle-bg :foreground ,fg-dim)))
- `(tab-line-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active)
- :background ,bg-tab-active :foreground ,fg-main)))
- `(tab-line-tab-current ((,class :inherit tab-line-tab)))
- `(tab-line-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive)
- :background ,bg-tab-inactive :foreground ,fg-dim)))))
-;;;; Emacs 28+
- (when (>= emacs-major-version 28)
- (custom-theme-set-faces
- 'modus-operandi
-;;;;; isearch regexp groups
- `(isearch-group-1 ((,class :inherit modus-theme-intense-blue)))
- `(isearch-group-2 ((,class :inherit modus-theme-intense-magenta)))))
-;;; variables
- (custom-theme-set-variables
- 'modus-operandi
-;;;; ansi-colors
- `(ansi-color-faces-vector [default bold shadow italic underline success warning error])
- `(ansi-color-names-vector [,fg-main ,red ,green ,yellow ,blue ,magenta ,cyan ,bg-main])
-;;;; awesome-tray
- `(awesome-tray-mode-line-active-color ,blue)
- `(awesome-tray-mode-line-inactive-color ,bg-active)
-;;;; flymake fringe indicators
- `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-theme-fringe-red))
- `(flymake-warning-bitmap '(exclamation-mark modus-theme-fringe-yellow))
- `(flymake-note-bitmap '(exclamation-mark modus-theme-fringe-cyan))
-;;;; ibuffer
- `(ibuffer-deletion-face 'modus-theme-mark-del)
- `(ibuffer-filter-group-name-face 'modus-theme-mark-symbol)
- `(ibuffer-marked-face 'modus-theme-mark-sel)
- `(ibuffer-title-face 'modus-theme-pseudo-header)
-;;;; highlight-tail
- `(highlight-tail-colors
- '((,green-subtle-bg . 0)
- (,cyan-subtle-bg . 20)))
-;;;; hl-todo
- `(hl-todo-keyword-faces
- '(("HOLD" . ,yellow-alt)
- ("TODO" . ,magenta)
- ("NEXT" . ,magenta-alt-other)
- ("THEM" . ,magenta-alt)
- ("PROG" . ,cyan)
- ("OKAY" . ,cyan-alt)
- ("DONT" . ,green-alt)
- ("FAIL" . ,red)
- ("BUG" . ,red)
- ("DONE" . ,green)
- ("NOTE" . ,yellow-alt-other)
- ("KLUDGE" . ,yellow)
- ("HACK" . ,yellow)
- ("TEMP" . ,red-nuanced)
- ("FIXME" . ,red-alt-other)
- ("XXX+" . ,red-alt)
- ("REVIEW" . ,cyan-alt-other)
- ("DEPRECATED" . ,blue-nuanced)))
-;;;; vc-annotate (C-x v g)
- `(vc-annotate-background nil)
- `(vc-annotate-background-mode nil)
- `(vc-annotate-color-map
- '((20 . ,red)
- (40 . ,magenta)
- (60 . ,magenta-alt)
- (80 . ,red-alt)
- (100 . ,yellow)
- (120 . ,yellow-alt)
- (140 . ,fg-special-warm)
- (160 . ,fg-special-mild)
- (180 . ,green)
- (200 . ,green-alt)
- (220 . ,cyan-alt-other)
- (240 . ,cyan-alt)
- (260 . ,cyan)
- (280 . ,fg-special-cold)
- (300 . ,blue)
- (320 . ,blue-alt)
- (340 . ,blue-alt-other)
- (360 . ,magenta-alt-other)))
- `(vc-annotate-very-old-color nil)
-;;;; xterm-color
- `(xterm-color-names [,fg-main ,red ,green ,yellow ,blue ,magenta ,cyan ,bg-alt])
- `(xterm-color-names-bright [,fg-alt ,red-alt ,green-alt ,yellow-alt ,blue-alt ,magenta-alt ,cyan-alt ,bg-main]))
-;;; Conditional theme variables
-;;;; org-src-block-faces
- ;; this is a user option to add a colour-coded background to source
- ;; blocks for various programming languages
- (when (eq modus-operandi-theme-org-blocks 'rainbow)
- (custom-theme-set-variables
- 'modus-operandi
- `(org-src-block-faces ; TODO this list should be expanded
- `(("emacs-lisp" modus-theme-nuanced-magenta)
- ("elisp" modus-theme-nuanced-magenta)
- ("clojure" modus-theme-nuanced-magenta)
- ("clojurescript" modus-theme-nuanced-magenta)
- ("c" modus-theme-nuanced-blue)
- ("c++" modus-theme-nuanced-blue)
- ("sh" modus-theme-nuanced-green)
- ("shell" modus-theme-nuanced-green)
- ("html" modus-theme-nuanced-yellow)
- ("xml" modus-theme-nuanced-yellow)
- ("css" modus-theme-nuanced-red)
- ("scss" modus-theme-nuanced-red)
- ("python" modus-theme-nuanced-green)
- ("ipython" modus-theme-nuanced-magenta)
- ("r" modus-theme-nuanced-cyan)
- ("yaml" modus-theme-nuanced-cyan)
- ("conf" modus-theme-nuanced-cyan)
- ("docker" modus-theme-nuanced-cyan)
- ("json" modus-theme-nuanced-cyan))))))
+(deftheme modus-operandi
+ "Accessible and customizable light theme (WCAG AAA standard).
+Conforms with the highest legibility standard for color contrast
+between background and foreground in any given piece of text,
+which corresponds to a minimum contrast in relative luminance of
+7:1.")
-;;; library provides
-;;;###autoload
-(when load-file-name
- (add-to-list 'custom-theme-load-path
- (file-name-as-directory (file-name-directory load-file-name))))
+(modus-themes-theme modus-operandi)
(provide-theme 'modus-operandi)
-(provide 'modus-operandi-theme)
-
;;; modus-operandi-theme.el ends here
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
new file mode 100644
index 00000000000..b9fe4a32729
--- /dev/null
+++ b/etc/themes/modus-themes.el
@@ -0,0 +1,7598 @@
+;;; modus-themes.el --- Highly accessible themes (WCAG AAA) -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+;; Author: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://gitlab.com/protesilaos/modus-themes
+;; Version: 1.5.0
+;; Last-Modified: <2021-07-15 13:21:55 +0300>
+;; Package-Requires: ((emacs "26.1"))
+;; Keywords: faces, theme, accessibility
+
+;; 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:
+;;
+;; The Modus themes conform with the highest standard for color-contrast
+;; accessibility between background and foreground values (WCAG AAA).
+;; This file contains all customization variables, helper functions,
+;; interactive commands, and face specifications. Please refer to the
+;; official Info manual for further documentation (distributed with the
+;; themes, or available at: <https://protesilaos.com/modus-themes>).
+;;
+;; The themes share the following customization variables:
+;;
+;; modus-themes-inhibit-reload (boolean)
+;; modus-themes-italic-constructs (boolean)
+;; modus-themes-bold-constructs (boolean)
+;; modus-themes-variable-pitch-headings (boolean)
+;; modus-themes-variable-pitch-ui (boolean)
+;; modus-themes-scale-headings (boolean)
+;; modus-themes-subtle-line-numbers (boolean)
+;; modus-themes-success-deuteranopia (boolean)
+;; modus-themes-no-mixed-fonts (boolean)
+;; modus-themes-headings (alist)
+;; modus-themes-fringes (choice)
+;; modus-themes-lang-checkers (choice)
+;; modus-themes-org-agenda (alist)
+;; modus-themes-org-blocks (choice)
+;; modus-themes-prompts (choice)
+;; modus-themes-mode-line (choice)
+;; modus-themes-diffs (choice)
+;; modus-themes-syntax (choice)
+;; modus-themes-hl-line (choice)
+;; modus-themes-paren-match (choice)
+;; modus-themes-region (choice)
+;; modus-themes-links (choice)
+;; modus-themes-completions (choice)
+;; modus-themes-mail-citations (choice)
+;;
+;; The default scale for headings is as follows (it can be customized as
+;; well---remember, no scaling takes place by default):
+;;
+;; modus-themes-scale-1 1.05
+;; modus-themes-scale-2 1.1
+;; modus-themes-scale-3 1.15
+;; modus-themes-scale-4 1.2
+;; modus-themes-scale-title 1.3
+;;
+;; There also exist two unique customization variables for overriding
+;; color palette values. The specifics are documented in the manual.
+;; The symbols are:
+;;
+;; modus-themes-operandi-color-overrides (alist)
+;; modus-themes-vivendi-color-overrides (alist)
+;;
+;; Below is the list of explicitly supported packages or face groups
+;; (there are implicitly supported packages as well, which inherit from
+;; font-lock or some basic group). You are encouraged to report any
+;; missing package or change you would like to see.
+;;
+;; ace-window
+;; ag
+;; alert
+;; all-the-icons
+;; annotate
+;; anzu
+;; apropos
+;; apt-sources-list
+;; artbollocks-mode
+;; auctex and TeX
+;; auto-dim-other-buffers
+;; avy
+;; awesome-tray
+;; bbdb
+;; binder
+;; bm
+;; bongo
+;; boon
+;; bookmark
+;; breakpoint (provided by built-in gdb-mi.el)
+;; buffer-expose
+;; calendar and diary
+;; calfw
+;; centaur-tabs
+;; cfrs
+;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
+;; cider
+;; circe
+;; color-rg
+;; column-enforce-mode
+;; company-mode
+;; company-posframe
+;; compilation-mode
+;; completions
+;; consult
+;; corfu
+;; counsel
+;; counsel-css
+;; counsel-org-capture-string
+;; cov
+;; cperl-mode
+;; css-mode
+;; csv-mode
+;; ctrlf
+;; custom (M-x customize)
+;; dap-mode
+;; dashboard (emacs-dashboard)
+;; deadgrep
+;; debbugs
+;; define-word
+;; deft
+;; dictionary
+;; diff-hl
+;; diff-mode
+;; dim-autoload
+;; dir-treeview
+;; dired
+;; dired-async
+;; dired-git
+;; dired-git-info
+;; dired-narrow
+;; dired-subtree
+;; diredc
+;; diredfl
+;; diredp (dired+)
+;; disk-usage
+;; display-fill-column-indicator-mode
+;; doom-modeline
+;; dynamic-ruler
+;; easy-jekyll
+;; easy-kill
+;; ebdb
+;; ediff
+;; eglot
+;; el-search
+;; eldoc
+;; eldoc-box
+;; elfeed
+;; elfeed-score
+;; embark
+;; emms
+;; enh-ruby-mode (enhanced-ruby-mode)
+;; epa
+;; equake
+;; erc
+;; eros
+;; ert
+;; eshell
+;; eshell-fringe-status
+;; eshell-git-prompt
+;; eshell-prompt-extras (epe)
+;; eshell-syntax-highlighting
+;; evil (evil-mode)
+;; evil-goggles
+;; evil-snipe
+;; evil-visual-mark-mode
+;; eww
+;; exwm
+;; eyebrowse
+;; fancy-dabbrev
+;; flycheck
+;; flycheck-color-mode-line
+;; flycheck-indicator
+;; flycheck-posframe
+;; flymake
+;; flyspell
+;; flyspell-correct
+;; flx
+;; freeze-it
+;; frog-menu
+;; focus
+;; fold-this
+;; font-lock (generic syntax highlighting)
+;; forge
+;; fountain (fountain-mode)
+;; geiser
+;; git-commit
+;; git-gutter (and variants)
+;; git-lens
+;; git-rebase
+;; git-timemachine
+;; git-walktree
+;; gnus
+;; gotest
+;; golden-ratio-scroll-screen
+;; helm
+;; helm-ls-git
+;; helm-switch-shell
+;; helm-xref
+;; helpful
+;; highlight-blocks
+;; highlight-defined
+;; highlight-escape-sequences (`hes-mode')
+;; highlight-indentation
+;; highlight-numbers
+;; highlight-symbol
+;; highlight-tail
+;; highlight-thing
+;; hl-defined
+;; hl-fill-column
+;; hl-line-mode
+;; hl-todo
+;; hydra
+;; hyperlist
+;; ibuffer
+;; icomplete
+;; ido-mode
+;; iedit
+;; iflipb
+;; imenu-list
+;; indium
+;; info
+;; info-colors
+;; interaction-log
+;; ioccur
+;; isearch, occur, etc.
+;; isl (isearch-light)
+;; ivy
+;; ivy-posframe
+;; jira (org-jira)
+;; journalctl-mode
+;; js2-mode
+;; julia
+;; jupyter
+;; kaocha-runner
+;; keycast
+;; ledger-mode
+;; line numbers (`display-line-numbers-mode' and global variant)
+;; lsp-mode
+;; lsp-ui
+;; macrostep
+;; magit
+;; magit-imerge
+;; make-mode
+;; man
+;; marginalia
+;; markdown-mode
+;; markup-faces (`adoc-mode')
+;; mentor
+;; messages
+;; minibuffer-line
+;; minimap
+;; mmm-mode
+;; mode-line
+;; mood-line
+;; mpdel
+;; mu4e
+;; mu4e-conversation
+;; multiple-cursors
+;; neotree
+;; no-emoji
+;; notmuch
+;; num3-mode
+;; nxml-mode
+;; objed
+;; orderless
+;; org
+;; org-journal
+;; org-noter
+;; org-pomodoro
+;; org-recur
+;; org-roam
+;; org-superstar
+;; org-table-sticky-header
+;; org-tree-slide
+;; org-treescope
+;; origami
+;; outline-mode
+;; outline-minor-faces
+;; package (M-x list-packages)
+;; page-break-lines
+;; pandoc-mode
+;; paradox
+;; paren-face
+;; parrot
+;; pass
+;; pdf-tools
+;; persp-mode
+;; perspective
+;; phi-grep
+;; phi-search
+;; pkgbuild-mode
+;; pomidor
+;; popup
+;; powerline
+;; powerline-evil
+;; prism (see "Note for prism.el" in the manual)
+;; proced
+;; prodigy
+;; pulse
+;; quick-peek
+;; racket-mode
+;; rainbow-blocks
+;; rainbow-identifiers
+;; rainbow-delimiters
+;; rcirc
+;; recursion-indicator
+;; regexp-builder (also known as `re-builder')
+;; rg
+;; ripgrep
+;; rmail
+;; ruler-mode
+;; sallet
+;; selectrum
+;; selectrum-prescient
+;; semantic
+;; sesman
+;; shell-script-mode
+;; shortdoc
+;; show-paren-mode
+;; shr
+;; side-notes
+;; sieve-mode
+;; skewer-mode
+;; smart-mode-line
+;; smartparens
+;; smerge
+;; spaceline
+;; speedbar
+;; spell-fu
+;; spray
+;; stripes
+;; suggest
+;; switch-window
+;; swiper
+;; swoop
+;; sx
+;; symbol-overlay
+;; syslog-mode
+;; tab-bar-groups
+;; tab-bar-mode
+;; tab-line-mode
+;; table (built-in table.el)
+;; telega
+;; telephone-line
+;; terraform-mode
+;; term
+;; tomatinho
+;; transient (pop-up windows like Magit's)
+;; trashed
+;; treemacs
+;; tty-menu
+;; tuareg
+;; typescript
+;; undo-tree
+;; vc (vc-dir.el, vc-hooks.el)
+;; vc-annotate (C-x v g)
+;; vdiff
+;; vertico
+;; vimish-fold
+;; visible-mark
+;; visual-regexp
+;; volatile-highlights
+;; vterm
+;; wcheck-mode
+;; web-mode
+;; wgrep
+;; which-function-mode
+;; which-key
+;; whitespace-mode
+;; window-divider-mode
+;; winum
+;; writegood-mode
+;; woman
+;; xah-elisp-mode
+;; xref
+;; xterm-color (and ansi-colors)
+;; yaml-mode
+;; yasnippet
+;; ztree
+;;
+;; For a complete view of the project, also refer to the following files
+;; (should be distributed in the same repository/directory as the
+;; current item):
+;;
+;; - modus-operandi-theme.el (Light theme)
+;; - modus-vivendi-theme.el (Dark theme)
+
+;;; Code:
+
+
+
+(eval-when-compile (require 'cl-lib))
+
+(defgroup modus-themes ()
+ "Options for `modus-operandi', `modus-vivendi'.
+The Modus themes conform with the WCAG AAA standard for color
+contrast between background and foreground combinations (a
+minimum contrast of 7:1---the highest standard of its kind). The
+themes also strive to empower users with red-green color
+deficiency: this is achieved through customization variables that
+replace all relevant instances of green with blue, as well as the
+overall design of the themes which relies mostly on colors that
+cover the blue-cyan-magenta side of the spectrum."
+ :group 'faces
+ :link '(info-link "(modus-themes) Top")
+ :prefix "modus-themes-"
+ :tag "Modus Themes")
+
+(defgroup modus-themes-faces ()
+ "Faces defined my `modus-operandi' and `modus-vivendi'."
+ :group 'modus-themes
+ :link '(info-link "(modus-themes) Top")
+ :prefix "modus-themes-"
+ :tag "Modus Themes Faces")
+
+;;; Variables for each theme variant
+
+;;;; Modus Operandi
+
+(defconst modus-themes-operandi-colors
+ '(;; base values
+ (bg-main . "#ffffff") (fg-main . "#000000")
+ (bg-dim . "#f8f8f8") (fg-dim . "#282828")
+ (bg-alt . "#f0f0f0") (fg-alt . "#505050")
+ ;; specifically for on/off states and must be combined with
+ ;; themselves, though the backgrounds are also meant to be used with
+ ;; other "active" values, defined further below; bg-active-accent
+ ;; can work as a substitute for bg-active
+ (bg-active . "#d7d7d7") (fg-active . "#0a0a0a")
+ (bg-inactive . "#efefef") (fg-inactive . "#404148")
+ (bg-active-accent . "#d0d6ff")
+ ;; these special values are intended as alternatives to the base
+ ;; values for cases where we need to avoid confusion between the
+ ;; highlighted constructs; they must either be used as pairs based
+ ;; on their name or each can be combined with {fg,bg}-{main,alt,dim}
+ ;; always in accordance with their role as background or foreground
+ (bg-special-cold . "#dde3f4") (fg-special-cold . "#093060")
+ (bg-special-mild . "#c4ede0") (fg-special-mild . "#184034")
+ (bg-special-warm . "#f0e0d4") (fg-special-warm . "#5d3026")
+ (bg-special-calm . "#f8ddea") (fg-special-calm . "#61284f")
+ ;; foregrounds that can be combined with bg-main, bg-dim, bg-alt
+ (red . "#a60000")
+ (red-alt . "#972500")
+ (red-alt-other . "#a0132f")
+ (red-faint . "#7f1010")
+ (red-alt-faint . "#702f00")
+ (red-alt-other-faint . "#7f002f")
+ (green . "#005e00")
+ (green-alt . "#315b00")
+ (green-alt-other . "#145c33")
+ (green-faint . "#104410")
+ (green-alt-faint . "#30440f")
+ (green-alt-other-faint . "#0f443f")
+ (yellow . "#813e00")
+ (yellow-alt . "#70480f")
+ (yellow-alt-other . "#863927")
+ (yellow-faint . "#5f4400")
+ (yellow-alt-faint . "#5d5000")
+ (yellow-alt-other-faint . "#5e3a20")
+ (blue . "#0031a9")
+ (blue-alt . "#2544bb")
+ (blue-alt-other . "#0000c0")
+ (blue-faint . "#003497")
+ (blue-alt-faint . "#0f3d8c")
+ (blue-alt-other-faint . "#001087")
+ (magenta . "#721045")
+ (magenta-alt . "#8f0075")
+ (magenta-alt-other . "#5317ac")
+ (magenta-faint . "#752f50")
+ (magenta-alt-faint . "#7b206f")
+ (magenta-alt-other-faint . "#55348e")
+ (cyan . "#00538b")
+ (cyan-alt . "#30517f")
+ (cyan-alt-other . "#005a5f")
+ (cyan-faint . "#005077")
+ (cyan-alt-faint . "#354f6f")
+ (cyan-alt-other-faint . "#125458")
+ ;; these foreground values can only be combined with bg-main and are
+ ;; thus not suitable for general purpose highlighting
+ (red-intense . "#b60000")
+ (orange-intense . "#904200")
+ (green-intense . "#006800")
+ (yellow-intense . "#605b00")
+ (blue-intense . "#1f1fce")
+ (magenta-intense . "#a8007f")
+ (purple-intense . "#7f10d0")
+ (cyan-intense . "#005f88")
+ ;; those foregrounds are meant exclusively for bg-active, bg-inactive
+ (red-active . "#8a0000")
+ (green-active . "#004c2e")
+ (yellow-active . "#702f00")
+ (blue-active . "#0030b4")
+ (magenta-active . "#5c2092")
+ (cyan-active . "#003f8a")
+ ;; the "subtle" values below be combined with fg-dim, while the
+ ;; "intense" should be paired with fg-main
+ (red-subtle-bg . "#f2b0a2")
+ (red-intense-bg . "#ff9f9f")
+ (green-subtle-bg . "#aecf90")
+ (green-intense-bg . "#5ada88")
+ (yellow-subtle-bg . "#e4c340")
+ (yellow-intense-bg . "#f5df23")
+ (blue-subtle-bg . "#b5d0ff")
+ (blue-intense-bg . "#77baff")
+ (magenta-subtle-bg . "#f0d3ff")
+ (magenta-intense-bg . "#d5baff")
+ (cyan-subtle-bg . "#c0efff")
+ (cyan-intense-bg . "#42cbd4")
+ ;; those background values must be combined with fg-main and should
+ ;; only be used for indicators that are placed on the fringes
+ (red-fringe-bg . "#f08290")
+ (green-fringe-bg . "#62c86a")
+ (yellow-fringe-bg . "#dbba3f")
+ (blue-fringe-bg . "#82afff")
+ (magenta-fringe-bg . "#e0a3ff")
+ (cyan-fringe-bg . "#2fcddf")
+ ;; those background values should only be used for graphs or similar
+ ;; applications where colored blocks are expected to be positioned
+ ;; next to each other
+ (red-graph-0-bg . "#ef6f79")
+ (red-graph-1-bg . "#ff9f9f")
+ (green-graph-0-bg . "#49d239")
+ (green-graph-1-bg . "#6dec6d")
+ (yellow-graph-0-bg . "#efec08")
+ (yellow-graph-1-bg . "#dbff4e")
+ (blue-graph-0-bg . "#55a2f0")
+ (blue-graph-1-bg . "#7fcfff")
+ (magenta-graph-0-bg . "#ba86ef")
+ (magenta-graph-1-bg . "#e7afff")
+ (cyan-graph-0-bg . "#30d3f0")
+ (cyan-graph-1-bg . "#6fefff")
+ ;; the following are for cases where both the foreground and the
+ ;; background need to have a similar hue and so must be combined
+ ;; with themselves, even though the foregrounds can be paired with
+ ;; any of the base backgrounds
+ (red-refine-bg . "#ffcccc") (red-refine-fg . "#780000")
+ (green-refine-bg . "#aceaac") (green-refine-fg . "#004c00")
+ (yellow-refine-bg . "#fff29a") (yellow-refine-fg . "#604000")
+ (blue-refine-bg . "#8fcfff") (blue-refine-fg . "#002f88")
+ (magenta-refine-bg . "#ffccff") (magenta-refine-fg . "#770077")
+ (cyan-refine-bg . "#8eecf4") (cyan-refine-fg . "#004850")
+ ;; the "nuanced" backgrounds can be combined with all of the above
+ ;; foregrounds, as well as those included here, while the "nuanced"
+ ;; foregrounds can in turn also be combined with bg-main, bg-dim,
+ ;; bg-alt
+ (red-nuanced-bg . "#fff1f0") (red-nuanced-fg . "#5f0000")
+ (green-nuanced-bg . "#ecf7ed") (green-nuanced-fg . "#004000")
+ (yellow-nuanced-bg . "#fff3da") (yellow-nuanced-fg . "#3f3000")
+ (blue-nuanced-bg . "#f3f3ff") (blue-nuanced-fg . "#201f55")
+ (magenta-nuanced-bg . "#fdf0ff") (magenta-nuanced-fg . "#541f4f")
+ (cyan-nuanced-bg . "#ebf6fa") (cyan-nuanced-fg . "#0f3360")
+ ;; the following are reserved for specific cases
+ ;;
+ ;; bg-hl-line is between bg-dim and bg-alt, so it should
+ ;; work with all accents that cover those two, plus bg-main
+ ;;
+ ;; bg-hl-alt and bg-hl-alt-intense should only be used when no
+ ;; other grayscale or fairly neutral background is available to
+ ;; properly draw attention to a given construct
+ ;;
+ ;; bg-header is between bg-active and bg-inactive, so it
+ ;; can be combined with any of the "active" values, plus the
+ ;; "special" and base foreground colors
+ ;;
+ ;; bg-paren-match, bg-paren-match-intense, bg-region,
+ ;; bg-region-accent and bg-tab-active must be combined with fg-main,
+ ;; while bg-tab-inactive should be combined with fg-dim, whereas
+ ;; bg-tab-inactive-alt goes together with fg-main
+ ;;
+ ;; bg-tab-bar is only intended for the bar that holds the tabs and
+ ;; can only be combined with fg-main
+ ;;
+ ;; fg-escape-char-construct and fg-escape-char-backslash can
+ ;; be combined bg-main, bg-dim, bg-alt
+ ;;
+ ;; fg-lang-error, fg-lang-warning, fg-lang-note can be
+ ;; combined with bg-main, bg-dim, bg-alt
+ ;;
+ ;; fg-mark-sel, fg-mark-del, fg-mark-alt can be combined
+ ;; with bg-main, bg-dim, bg-alt, bg-hl-line
+ ;;
+ ;; fg-unfocused must be combined with bg-main
+ ;;
+ ;; fg-docstring, fg-comment-yellow can be combined with
+ ;; bg-main, bg-dim, bg-alt
+ ;;
+ ;; the window divider colors apply to faces with just an fg value
+ ;;
+ ;; all pairs are combinable with themselves
+ (bg-hl-line . "#f2eff3")
+ (bg-hl-line-intense . "#e0e0e0")
+ (bg-hl-line-intense-accent . "#b9e1ef")
+ (bg-hl-alt . "#fbeee0")
+ (bg-hl-alt-intense . "#e8dfd1")
+ (bg-paren-match . "#e0af82")
+ (bg-paren-match-intense . "#c488ff")
+ (bg-paren-expression . "#dff0ff")
+ (bg-region . "#bcbcbc")
+ (bg-region-accent . "#afafef")
+ (bg-region-accent-subtle . "#efdfff")
+
+ (bg-tab-bar . "#d5d5d5")
+ (bg-tab-active . "#f6f6f6")
+ (bg-tab-inactive . "#bdbdbd")
+ (bg-tab-inactive-alt . "#999999")
+
+ (red-tab . "#680000")
+ (green-tab . "#003900")
+ (yellow-tab . "#393000")
+ (orange-tab . "#502300")
+ (blue-tab . "#000080")
+ (cyan-tab . "#052f60")
+ (magenta-tab . "#5f004d")
+ (purple-tab . "#400487")
+
+ (fg-escape-char-construct . "#8b1030")
+ (fg-escape-char-backslash . "#654d0f")
+
+ (fg-lang-error . "#9f004f")
+ (fg-lang-warning . "#604f0f")
+ (fg-lang-note . "#4040ae")
+ (fg-lang-underline-error . "#ef4f54")
+ (fg-lang-underline-warning . "#cf9f00")
+ (fg-lang-underline-note . "#3f6fef")
+
+ (fg-window-divider-inner . "#888888")
+ (fg-window-divider-outer . "#585858")
+
+ (fg-unfocused . "#56576d")
+
+ (fg-docstring . "#2a486a")
+ (fg-comment-yellow . "#794319")
+
+ (bg-header . "#e5e5e5") (fg-header . "#2a2a2a")
+
+ (bg-whitespace . "#f5efef") (fg-whitespace . "#624956")
+
+ (bg-diff-heading . "#b7cfe0") (fg-diff-heading . "#041645")
+ (bg-diff-added . "#d4fad4") (fg-diff-added . "#004500")
+ (bg-diff-added-deuteran . "#daefff") (fg-diff-added-deuteran . "#002044")
+ (bg-diff-changed . "#fcefcf") (fg-diff-changed . "#524200")
+ (bg-diff-removed . "#ffe8ef") (fg-diff-removed . "#691616")
+
+ (bg-diff-refine-added . "#94cf94") (fg-diff-refine-added . "#002a00")
+ (bg-diff-refine-added-deuteran . "#77c0ef") (fg-diff-refine-added-deuteran . "#000035")
+ (bg-diff-refine-changed . "#cccf8f") (fg-diff-refine-changed . "#302010")
+ (bg-diff-refine-removed . "#daa2b0") (fg-diff-refine-removed . "#400000")
+
+ (bg-diff-focus-added . "#bbeabb") (fg-diff-focus-added . "#002c00")
+ (bg-diff-focus-added-deuteran . "#bacfff") (fg-diff-focus-added-deuteran . "#001755")
+ (bg-diff-focus-changed . "#ecdfbf") (fg-diff-focus-changed . "#392900")
+ (bg-diff-focus-removed . "#efcbcf") (fg-diff-focus-removed . "#4a0000")
+
+ (bg-mark-sel . "#a0f0cf") (fg-mark-sel . "#005040")
+ (bg-mark-del . "#ffccbb") (fg-mark-del . "#840040")
+ (bg-mark-alt . "#f5d88f") (fg-mark-alt . "#782900"))
+ "The entire palette of the `modus-operandi' theme.
+Each element has the form (NAME . HEX) with the former as a
+symbol and the latter as a string.")
+
+;;;; Modus Vivendi
+
+(defconst modus-themes-vivendi-colors
+ '(;; base values
+ (bg-main . "#000000") (fg-main . "#ffffff")
+ (bg-dim . "#100f10") (fg-dim . "#e0e6f0")
+ (bg-alt . "#191a1b") (fg-alt . "#a8a8a8")
+ ;; specifically for on/off states and must be combined with
+ ;; themselves, though the backgrounds are also meant to be used with
+ ;; other "active" values, defined further below; bg-active-accent
+ ;; can work as a substitute for bg-active
+ (bg-active . "#323232") (fg-active . "#f4f4f4")
+ (bg-inactive . "#1e1e1e") (fg-inactive . "#bfc0c4")
+ (bg-active-accent . "#2a2a66")
+ ;; these special values are intended as alternatives to the base
+ ;; values for cases where we need to avoid confusion between the
+ ;; highlighted constructs; they must either be used as pairs based
+ ;; on their name or each can be combined with {fg,bg}-{main,alt,dim}
+ ;; always in accordance with their role as background or foreground
+ (bg-special-cold . "#203448") (fg-special-cold . "#c6eaff")
+ (bg-special-mild . "#00322e") (fg-special-mild . "#bfebe0")
+ (bg-special-warm . "#382f27") (fg-special-warm . "#f8dec0")
+ (bg-special-calm . "#392a48") (fg-special-calm . "#fbd6f4")
+ ;; foregrounds that can be combined with bg-main, bg-dim, bg-alt
+ (red . "#ff8059")
+ (red-alt . "#ef8b50")
+ (red-alt-other . "#ff9077")
+ (red-faint . "#ffa0a0")
+ (red-alt-faint . "#f5aa80")
+ (red-alt-other-faint . "#ff9fbf")
+ (green . "#44bc44")
+ (green-alt . "#70b900")
+ (green-alt-other . "#00c06f")
+ (green-faint . "#78bf78")
+ (green-alt-faint . "#99b56f")
+ (green-alt-other-faint . "#88bf99")
+ (yellow . "#d0bc00")
+ (yellow-alt . "#c0c530")
+ (yellow-alt-other . "#d3b55f")
+ (yellow-faint . "#d2b580")
+ (yellow-alt-faint . "#cabf77")
+ (yellow-alt-other-faint . "#d0ba95")
+ (blue . "#2fafff")
+ (blue-alt . "#79a8ff" )
+ (blue-alt-other . "#00bcff")
+ (blue-faint . "#82b0ec")
+ (blue-alt-faint . "#a0acef")
+ (blue-alt-other-faint . "#80b2f0")
+ (magenta . "#feacd0")
+ (magenta-alt . "#f78fe7")
+ (magenta-alt-other . "#b6a0ff")
+ (magenta-faint . "#e0b2d6")
+ (magenta-alt-faint . "#ef9fe4")
+ (magenta-alt-other-faint . "#cfa6ff")
+ (cyan . "#00d3d0")
+ (cyan-alt . "#4ae2f0")
+ (cyan-alt-other . "#6ae4b9")
+ (cyan-faint . "#90c4ed")
+ (cyan-alt-faint . "#a0bfdf")
+ (cyan-alt-other-faint . "#a4d0bb")
+ ;; these foreground values can only be combined with bg-main and are
+ ;; thus not suitable for general purpose highlighting
+ (red-intense . "#fe6060")
+ (orange-intense . "#fba849")
+ (green-intense . "#4fe42f")
+ (yellow-intense . "#f0dd60")
+ (blue-intense . "#4fafff")
+ (magenta-intense . "#ff62d4")
+ (purple-intense . "#9f80ff")
+ (cyan-intense . "#3fdfd0")
+ ;; those foregrounds are meant exclusively for bg-active, bg-inactive
+ (red-active . "#ffa7ba")
+ (green-active . "#70d73f")
+ (yellow-active . "#dbbe5f")
+ (blue-active . "#34cfff")
+ (magenta-active . "#d5b1ff")
+ (cyan-active . "#00d8b4")
+ ;; the "subtle" values below be combined with fg-dim, while the
+ ;; "intense" should be paired with fg-main
+ (red-subtle-bg . "#762422")
+ (red-intense-bg . "#a4202a")
+ (green-subtle-bg . "#2f4a00")
+ (green-intense-bg . "#006800")
+ (yellow-subtle-bg . "#604200")
+ (yellow-intense-bg . "#874900")
+ (blue-subtle-bg . "#10387c")
+ (blue-intense-bg . "#2a40b8")
+ (magenta-subtle-bg . "#49366e")
+ (magenta-intense-bg . "#7042a2")
+ (cyan-subtle-bg . "#00415e")
+ (cyan-intense-bg . "#005f88")
+ ;; those background values must be combined with fg-main and should
+ ;; only be used for indicators that are placed on the fringes
+ (red-fringe-bg . "#8f1f4b")
+ (green-fringe-bg . "#006700")
+ (yellow-fringe-bg . "#6f4f00")
+ (blue-fringe-bg . "#3f33af")
+ (magenta-fringe-bg . "#6f2f89")
+ (cyan-fringe-bg . "#004f8f")
+ ;; those background values should only be used for graphs or similar
+ ;; applications where colored blocks are expected to be positioned
+ ;; next to each other
+ (red-graph-0-bg . "#af0404")
+ (red-graph-1-bg . "#801f2f")
+ (green-graph-0-bg . "#24ba2f")
+ (green-graph-1-bg . "#0f8f07")
+ (yellow-graph-0-bg . "#ffd03e")
+ (yellow-graph-1-bg . "#d7d800")
+ (blue-graph-0-bg . "#406fff")
+ (blue-graph-1-bg . "#2f50c8")
+ (magenta-graph-0-bg . "#af7bee")
+ (magenta-graph-1-bg . "#7f59cf")
+ (cyan-graph-0-bg . "#47dcfa")
+ (cyan-graph-1-bg . "#0bc0df")
+ ;; the following are for cases where both the foreground and the
+ ;; background need to have a similar hue and so must be combined
+ ;; with themselves, even though the foregrounds can be paired with
+ ;; any of the base backgrounds
+ (red-refine-bg . "#77002a") (red-refine-fg . "#ffb9ab")
+ (green-refine-bg . "#00422a") (green-refine-fg . "#9ff0cf")
+ (yellow-refine-bg . "#693200") (yellow-refine-fg . "#e2d980")
+ (blue-refine-bg . "#242679") (blue-refine-fg . "#8ecfff")
+ (magenta-refine-bg . "#71206a") (magenta-refine-fg . "#ffcaf0")
+ (cyan-refine-bg . "#004065") (cyan-refine-fg . "#8ae4f2")
+ ;; the "nuanced" backgrounds can be combined with all of the above
+ ;; foregrounds, as well as those included here, while the "nuanced"
+ ;; foregrounds can in turn also be combined with bg-main, bg-dim,
+ ;; bg-alt
+ (red-nuanced-bg . "#2c0614") (red-nuanced-fg . "#ffcccc")
+ (green-nuanced-bg . "#001904") (green-nuanced-fg . "#b8e2b8")
+ (yellow-nuanced-bg . "#221000") (yellow-nuanced-fg . "#dfdfb0")
+ (blue-nuanced-bg . "#0f0e39") (blue-nuanced-fg . "#bfd9ff")
+ (magenta-nuanced-bg . "#230631") (magenta-nuanced-fg . "#e5cfef")
+ (cyan-nuanced-bg . "#041529") (cyan-nuanced-fg . "#a8e5e5")
+ ;; the following are reserved for specific cases
+ ;;
+ ;; bg-hl-line is between bg-dim and bg-alt, so it should
+ ;; work with all accents that cover those two, plus bg-main
+ ;;
+ ;; bg-hl-alt and bg-hl-alt-intense should only be used when no
+ ;; other grayscale or fairly neutral background is available to
+ ;; properly draw attention to a given construct
+ ;;
+ ;; bg-header is between bg-active and bg-inactive, so it
+ ;; can be combined with any of the "active" values, plus the
+ ;; "special" and base foreground colors
+ ;;
+ ;; bg-paren-match, bg-paren-match-intense, bg-region,
+ ;; bg-region-accent and bg-tab-active must be combined with fg-main,
+ ;; while bg-tab-inactive should be combined with fg-dim, whereas
+ ;; bg-tab-inactive-alt goes together with fg-main
+ ;;
+ ;; bg-tab-bar is only intended for the bar that holds the tabs and
+ ;; can only be combined with fg-main
+ ;;
+ ;; fg-escape-char-construct and fg-escape-char-backslash can
+ ;; be combined bg-main, bg-dim, bg-alt
+ ;;
+ ;; fg-lang-error, fg-lang-warning, fg-lang-note can be
+ ;; combined with bg-main, bg-dim, bg-alt
+ ;;
+ ;; fg-mark-sel, fg-mark-del, fg-mark-alt can be combined
+ ;; with bg-main, bg-dim, bg-alt, bg-hl-line
+ ;;
+ ;; fg-unfocused must be combined with bg-main
+ ;;
+ ;; fg-docstring, fg-comment-yellow can be combined with
+ ;; bg-main, bg-dim, bg-alt
+ ;;
+ ;; the window divider colors apply to faces with just an fg value
+ ;;
+ ;; all pairs are combinable with themselves
+ (bg-hl-line . "#151823")
+ (bg-hl-line-intense . "#292929")
+ (bg-hl-line-intense-accent . "#00353f")
+ (bg-hl-alt . "#181732")
+ (bg-hl-alt-intense . "#282e46")
+ (bg-paren-match . "#5f362f")
+ (bg-paren-match-intense . "#7416b5")
+ (bg-paren-expression . "#221044")
+ (bg-region . "#3c3c3c")
+ (bg-region-accent . "#4f3d88")
+ (bg-region-accent-subtle . "#240f55")
+
+ (bg-tab-bar . "#2c2c2c")
+ (bg-tab-active . "#0e0e0e")
+ (bg-tab-inactive . "#3d3d3d")
+ (bg-tab-inactive-alt . "#595959")
+
+ (red-tab . "#ffc0bf")
+ (green-tab . "#88ef88")
+ (yellow-tab . "#d2e580")
+ (orange-tab . "#f5ca80")
+ (blue-tab . "#92d9ff")
+ (cyan-tab . "#60e7e0")
+ (magenta-tab . "#ffb8ff")
+ (purple-tab . "#cfcaff")
+
+ (fg-escape-char-construct . "#e7a59a")
+ (fg-escape-char-backslash . "#abab00")
+
+ (fg-lang-error . "#ef8690")
+ (fg-lang-warning . "#b0aa00")
+ (fg-lang-note . "#9d9def")
+ (fg-lang-underline-error . "#ff4a6f")
+ (fg-lang-underline-warning . "#d0de00")
+ (fg-lang-underline-note . "#5f6fff")
+
+ (fg-window-divider-inner . "#646464")
+ (fg-window-divider-outer . "#969696")
+
+ (fg-unfocused . "#93959b")
+
+ (fg-docstring . "#b0d6f5")
+ (fg-comment-yellow . "#d0a070")
+
+ (bg-header . "#212121") (fg-header . "#dddddd")
+
+ (bg-whitespace . "#101424") (fg-whitespace . "#aa9e9f")
+
+ (bg-diff-heading . "#304466") (fg-diff-heading . "#dae7ff")
+ (bg-diff-added . "#0a280a") (fg-diff-added . "#94ba94")
+ (bg-diff-added-deuteran . "#001a3f") (fg-diff-added-deuteran . "#c4cdf2")
+ (bg-diff-changed . "#2a2000") (fg-diff-changed . "#b0ba9f")
+ (bg-diff-removed . "#40160f") (fg-diff-removed . "#c6adaa")
+
+ (bg-diff-refine-added . "#005a36") (fg-diff-refine-added . "#e0f6e0")
+ (bg-diff-refine-added-deuteran . "#234f8f") (fg-diff-refine-added-deuteran . "#dde4ff")
+ (bg-diff-refine-changed . "#585800") (fg-diff-refine-changed . "#ffffcc")
+ (bg-diff-refine-removed . "#852828") (fg-diff-refine-removed . "#ffd9eb")
+
+ (bg-diff-focus-added . "#203d20") (fg-diff-focus-added . "#b4ddb4")
+ (bg-diff-focus-added-deuteran . "#00405f") (fg-diff-focus-added-deuteran . "#bfe4ff")
+ (bg-diff-focus-changed . "#4a3a10") (fg-diff-focus-changed . "#d0daaf")
+ (bg-diff-focus-removed . "#5e2526") (fg-diff-focus-removed . "#eebdba")
+
+ (bg-mark-sel . "#002f2f") (fg-mark-sel . "#60cfa2")
+ (bg-mark-del . "#5a0000") (fg-mark-del . "#ff99aa")
+ (bg-mark-alt . "#3f2210") (fg-mark-alt . "#f0aa20"))
+ "The entire palette of the `modus-vivendi' theme.
+Each element has the form (NAME . HEX) with the former as a
+symbol and the latter as a string.")
+
+
+
+;;; Custom faces
+
+;; These faces are used internally to ensure consistency between various
+;; groups and to streamline the evaluation of relevant customization
+;; options.
+(defface modus-themes-subtle-red nil
+ "Subtle red background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-subtle-green nil
+ "Subtle green background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-subtle-yellow nil
+ "Subtle yellow background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-subtle-blue nil
+ "Subtle blue background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-subtle-magenta nil
+ "Subtle magenta background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-subtle-cyan nil
+ "Subtle cyan background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-subtle-neutral nil
+ "Subtle gray background combined with a dimmed foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-red nil
+ "Intense red background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-green nil
+ "Intense green background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-yellow nil
+ "Intense yellow background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-blue nil
+ "Intense blue background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-magenta nil
+ "Intense magenta background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-cyan nil
+ "Intense cyan background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-intense-neutral nil
+ "Intense gray background combined with the main foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-refine-red nil
+ "Combination of accented red background and foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-refine-green nil
+ "Combination of accented green background and foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-refine-yellow nil
+ "Combination of accented yellow background and foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-refine-blue nil
+ "Combination of accented blue background and foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-refine-magenta nil
+ "Combination of accented magenta background and foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-refine-cyan nil
+ "Combination of accented cyan background and foreground.
+This is used for general purpose highlighting, mostly in buffers
+or for completion interfaces.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-active-red nil
+ "A red background meant for use on the mode line or similar.
+This is combined with the mode lines primary foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-active-green nil
+ "A green background meant for use on the mode line or similar.
+This is combined with the mode lines primary foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-active-yellow nil
+ "A yellow background meant for use on the mode line or similar.
+This is combined with the mode lines primary foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-active-blue nil
+ "A blue background meant for use on the mode line or similar.
+This is combined with the mode lines primary foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-active-magenta nil
+ "A magenta background meant for use on the mode line or similar.
+This is combined with the mode lines primary foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-active-cyan nil
+ "A cyan background meant for use on the mode line or similar.
+This is combined with the mode lines primary foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fringe-red nil
+ "A red background meant for use on the fringe or similar.
+This is combined with the main foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fringe-green nil
+ "A green background meant for use on the fringe or similar.
+This is combined with the main foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fringe-yellow nil
+ "A yellow background meant for use on the fringe or similar.
+This is combined with the main foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fringe-blue nil
+ "A blue background meant for use on the fringe or similar.
+This is combined with the main foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fringe-magenta nil
+ "A magenta background meant for use on the fringe or similar.
+This is combined with the main foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fringe-cyan nil
+ "A cyan background meant for use on the fringe or similar.
+This is combined with the main foreground value.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-nuanced-red nil
+ "A nuanced red background.
+This does not specify a foreground of its own. Instead it is
+meant to serve as the backdrop for elements such as Org blocks,
+headings, and any other surface that needs to retain the colors
+on display.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-nuanced-green nil
+ "A nuanced green background.
+This does not specify a foreground of its own. Instead it is
+meant to serve as the backdrop for elements such as Org blocks,
+headings, and any other surface that needs to retain the colors
+on display.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-nuanced-yellow nil
+ "A nuanced yellow background.
+This does not specify a foreground of its own. Instead it is
+meant to serve as the backdrop for elements such as Org blocks,
+headings, and any other surface that needs to retain the colors
+on display.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-nuanced-blue nil
+ "A nuanced blue background.
+This does not specify a foreground of its own. Instead it is
+meant to serve as the backdrop for elements such as Org blocks,
+headings, and any other surface that needs to retain the colors
+on display.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-nuanced-magenta nil
+ "A nuanced magenta background.
+This does not specify a foreground of its own. Instead it is
+meant to serve as the backdrop for elements such as Org blocks,
+headings, and any other surface that needs to retain the colors
+on display.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-nuanced-cyan nil
+ "A nuanced cyan background.
+This does not specify a foreground of its own. Instead it is
+meant to serve as the backdrop for elements such as Org blocks,
+headings, and any other surface that needs to retain the colors
+on display.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-special-cold nil
+ "Combines the 'special cold' background and foreground values.
+This is intended for cases when a neutral gray background is not
+suitable and where a combination of more saturated colors would
+not be appropriate.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-special-mild nil
+ "Combines the 'special mild' background and foreground values.
+This is intended for cases when a neutral gray background is not
+suitable and where a combination of more saturated colors would
+not be appropriate.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-special-warm nil
+ "Combines the 'special warm' background and foreground values.
+This is intended for cases when a neutral gray background is not
+suitable and where a combination of more saturated colors would
+not be appropriate.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-special-calm nil
+ "Combines the 'special calm' background and foreground values.
+This is intended for cases when a neutral gray background is not
+suitable and where a combination of more saturated colors would
+not be appropriate.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-added nil
+ "Combines green colors for the 'added' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-changed nil
+ "Combines yellow colors for the 'changed' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-removed nil
+ "Combines red colors for the 'removed' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-refine-added nil
+ "Combines green colors for word-wise 'added' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-refine-changed nil
+ "Combines yellow colors for word-wise 'changed' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-refine-removed nil
+ "Combines red colors for word-wise 'removed' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-focus-added nil
+ "Combines green colors for the focused 'added' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-focus-changed nil
+ "Combines yellow colors for the focused 'changed' state in.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-focus-removed nil
+ "Combines red colors for the focused 'removed' state in diffs.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-diff-heading nil
+ "Combines blue colors for the diff hunk heading.
+The applied colors are contingent on the value assigned to
+`modus-themes-diffs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-pseudo-header nil
+ "Generic style for some elements that function like headings.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-mark-alt nil
+ "Combines yellow colors for marking special lines.
+This is intended for use in modes such as Dired, Ibuffer, Proced.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-mark-del nil
+ "Combines red colors for marking deletable lines.
+This is intended for use in modes such as Dired, Ibuffer, Proced.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-mark-sel nil
+ "Combines green colors for marking lines.
+This is intended for use in modes such as Dired, Ibuffer, Proced.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-mark-symbol nil
+ "Applies a blue color and other styles for mark indicators.
+This is intended for use in modes such as Dired, Ibuffer, Proced.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-1 nil
+ "General purpose face for use in headings level 1.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-2 nil
+ "General purpose face for use in headings level 2.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-3 nil
+ "General purpose face for use in headings level 3.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-4 nil
+ "General purpose face for use in headings level 4.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-5 nil
+ "General purpose face for use in headings level 5.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-6 nil
+ "General purpose face for use in headings level 6.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-7 nil
+ "General purpose face for use in headings level 7.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-heading-8 nil
+ "General purpose face for use in headings level 8.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-headings' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-hl-line nil
+ "General purpose face for the current line.
+The exact attributes assigned to this face are contingent on the
+values assigned to the `modus-themes-hl-line' variable.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-bold nil
+ "Generic face for applying a conditional bold weight.
+This behaves in accordance with `modus-themes-bold-constructs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-slant nil
+ "Generic face for applying a conditional slant (italics).
+This behaves in accordance with `modus-themes-italic-constructs'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-variable-pitch nil
+ "Generic face for applying a conditional `variable-pitch'.
+This behaves in accordance with `modus-themes-no-mixed-fonts',
+`modus-themes-variable-pitch-headings' for all heading levels,
+and `modus-themes-variable-pitch-ui'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-fixed-pitch nil
+ "Generic face for applying a conditional `fixed-pitch'.
+This behaves in accordance with `modus-themes-no-mixed-fonts'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-red-0 nil
+ "Special subdued red face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-red-1 nil
+ "Special prominent red face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-green-0 nil
+ "Special subdued green face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-green-1 nil
+ "Special prominent green face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-yellow-0 nil
+ "Special subdued yellow face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-yellow-1 nil
+ "Special prominent yellow face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-blue-0 nil
+ "Special subdued blue face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-blue-1 nil
+ "Special prominent blue face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-magenta-0 nil
+ "Special subdued magenta face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-magenta-1 nil
+ "Special prominent magenta face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-cyan-0 nil
+ "Special subdued cyan face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-graph-cyan-1 nil
+ "Special prominent cyan face for use in graphs.
+This is intended to be applied in contexts such as the Org agenda
+habit graph where faithfulness to the semantics of a color value
+is of paramount importance.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-lang-note nil
+ "Generic face for linter or spell checker notes.
+The exact attributes and color combinations are controlled by
+`modus-themes-lang-checkers'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-lang-warning nil
+ "Generic face for linter or spell checker warnings.
+The exact attributes and color combinations are controlled by
+`modus-themes-lang-checkers'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-lang-error nil
+ "Generic face for linter or spell checker errors.
+The exact attributes and color combinations are controlled by
+`modus-themes-lang-checkers'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-reset-soft nil
+ "Generic face to set most face properties to nil.
+
+This is intended to be inherited by faces that should not retain
+properties from their context (e.g. an overlay over an underlined
+text should not be underlined as well) yet still blend in. Also
+see `modus-themes-reset-hard'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-reset-hard nil
+ "Generic face to set all face properties to nil.
+
+This is intended to be inherited by faces that should not retain
+properties from their context (e.g. an overlay over an underlined
+text should not be underlined as well) and not blend in. Also
+see `modus-themes-reset-soft'.
+
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-key-binding nil
+ "Generic face for key bindings.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-search-success nil
+ "Generic face for successful search.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-search-success-modeline nil
+ "Generic mode line indicator for successful search.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-search-success-lazy nil
+ "Generic face for successful, lazily highlighted search.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+(defface modus-themes-prompt nil
+ "Generic face for command prompts.
+The actual styling of the face is done by `modus-themes-faces'."
+ :group 'modus-theme-faces)
+
+
+
+;;; Customization variables
+
+(defcustom modus-themes-inhibit-reload t
+ "Control theme reload when setting options with Customize.
+
+By default, customizing a theme-related user option through the
+Custom interfaces or with `customize-set-variable' will not
+reload the currently active Modus theme.
+
+Enable this behaviour by setting this variable to nil."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type 'boolean
+ :link '(info-link "(modus-themes) Custom reload theme"))
+
+(defun modus-themes--set-option (sym val)
+ "Custom setter for theme related user options.
+Will set SYM to VAL, and reload the current theme, unless
+`modus-themes-inhibit-reload' is non-nil."
+ (set-default sym val)
+ (unless (or modus-themes-inhibit-reload
+ ;; Check if a theme is being loaded, in which case we
+ ;; don't want to reload a theme if the setter is
+ ;; invoked. `custom--inhibit-theme-enable' is set to nil
+ ;; by `enable-theme'.
+ (null (bound-and-true-p custom--inhibit-theme-enable)))
+ (let ((modus-themes-inhibit-reload t))
+ (pcase (modus-themes--current-theme)
+ ('modus-operandi (modus-themes-load-operandi))
+ ('modus-vivendi (modus-themes-load-vivendi))))))
+
+(defcustom modus-themes-operandi-color-overrides nil
+ "Override colors in the Modus Operandi palette.
+
+For form, see `modus-themes-operandi-colors'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.1.0")
+ :version "28.1"
+ :type '(alist :key-type symbol :value-type color)
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Override colors (DIY)"))
+
+(defcustom modus-themes-vivendi-color-overrides nil
+ "Override colors in the Modus Vivendi palette.
+
+For form, see `modus-themes-vivendi-colors'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.1.0")
+ :version "28.1"
+ :type '(alist :key-type symbol :value-type color)
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Override colors (DIY)"))
+
+;; The byte compiler complains when a defcustom isn't a top level form
+(let* ((names (mapcar (lambda (pair)
+ (symbol-name (car pair)))
+ modus-themes-operandi-colors))
+ (colors (mapcar #'intern (sort names #'string<))))
+ (put 'modus-themes-operandi-color-overrides
+ 'custom-options (copy-sequence colors))
+ (put 'modus-themes-vivendi-color-overrides
+ 'custom-options (copy-sequence colors)))
+
+(defcustom modus-themes-slanted-constructs nil
+ "Use slanted text in more code constructs (italics or oblique)."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Slanted constructs"))
+
+(define-obsolete-variable-alias
+ 'modus-themes-slanted-constructs
+ 'modus-themes-italic-constructs
+ "1.5.0")
+
+(defcustom modus-themes-italic-constructs nil
+ "Use italic font forms in more code constructs."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Italic constructs"))
+
+(defcustom modus-themes-bold-constructs nil
+ "Use bold text in more code constructs."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Bold constructs"))
+
+(defcustom modus-themes-variable-pitch-headings nil
+ "Use proportional fonts (variable-pitch) in headings."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Headings' typeface"))
+
+(defcustom modus-themes-variable-pitch-ui nil
+ "Use proportional fonts (variable-pitch) in UI elements.
+This includes the mode line, header line, tab bar, and tab line."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.1.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) UI typeface"))
+
+(defcustom modus-themes-no-mixed-fonts nil
+ "Disable inheritance from `fixed-pitch' in some faces.
+
+This is done by default to allow spacing-sensitive constructs,
+such as Org tables and code blocks, to remain monospaced when
+users opt for something like the command `variable-pitch-mode'.
+The downside with the default is that users need to explicitly
+configure the font family of `fixed-pitch' in order to get a
+consistent experience. That may be something they do not want to
+do. Hence this option to disable any kind of technique for
+mixing fonts."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) No mixed fonts"))
+
+(defconst modus-themes--headings-choice
+ '(set :tag "Properties" :greedy t
+ (const :tag "Background color" background)
+ (const :tag "Overline" overline)
+ (const :tag "No bold weight" no-bold)
+ (choice :tag "Colors"
+ (const :tag "Subtle colors" nil)
+ (const :tag "Rainbow colors" rainbow)
+ (const :tag "Monochrome" monochrome)))
+ "Refer to the doc string of `modus-themes-headings'.
+This is a helper variable intended for internal use.")
+
+(defcustom modus-themes-headings nil
+ "Heading styles with optional list of values for levels 1-8.
+
+This is an alist that accepts a (key . list-of-values)
+combination. The key is either a number, representing the
+heading's level or t, which pertains to the fallback style. The
+list of values covers symbols that refer to properties, as
+described below. Here is a sample, followed by a presentation of
+all available properties:
+
+ (setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (overline rainbow))
+ (t . (monochrome))))
+
+By default (a nil value for this variable), all headings have a
+bold typographic weight and use a desaturated text color.
+
+A `rainbow' property makes the text color more saturated.
+
+An `overline' property draws a line above the area of the
+heading.
+
+A `background' property adds a subtle tinted color to the
+background of the heading.
+
+A `no-bold' property removes the bold weight from the heading's
+text.
+
+A `monochrome' property makes all headings the same base color,
+which is that of the default for the active theme (black/white).
+When `background' is also set, `monochrome' changes its color to
+gray. If both `monochrome' and `rainbow' are set, the former
+takes precedence.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (no-bold)
+ (rainbow background)
+ (overline monochrome no-bold)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-headings
+ '((1 . (background overline rainbow))
+ (2 . (background overline))
+ (t . (overline no-bold))))
+
+When defining the styles per heading level, it is possible to
+pass a non-nil value (t) instead of a list of properties. This
+will retain the original aesthetic for that level. For example:
+
+ (setq modus-themes-headings
+ '((1 . t) ; keep the default style
+ (2 . (background overline))
+ (t . (rainbow)))) ; style for all other headings
+
+ (setq modus-themes-headings
+ '((1 . (background overline))
+ (2 . (rainbow no-bold))
+ (t . t))) ; default style for all other levels
+
+For Org users, the extent of the heading depends on the variable
+`org-fontify-whole-heading-line'. This affects the `overline'
+and `background' properties. Depending on the version of Org,
+there may be others, such as `org-fontify-done-headline'.
+
+Also read `modus-themes-scale-headings' to change the height of
+headings and `modus-themes-variable-pitch-headings' to make them
+use a proportionately spaced font."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type `(alist
+ :options ,(mapcar (lambda (el)
+ (list el modus-themes--headings-choice))
+ '(1 2 3 4 5 6 7 8 t))
+ :key-type symbol
+ :value-type ,modus-themes--headings-choice)
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Heading styles"))
+
+(defcustom modus-themes-org-agenda nil
+ "Control the style of individual Org agenda constructs.
+
+This is an alist that accepts a (key . value) combination. Here
+is a sample, followed by a description of all possible
+combinations:
+
+ (setq modus-themes-org-agenda
+ '((header-block . (variable-pitch scale-title))
+ (header-date . (grayscale workaholic bold-today))
+ (scheduled . uniform)
+ (habit . traffic-light)))
+
+A `header-block' key applies to elements that concern the
+headings which demarcate blocks in the structure of the agenda.
+By default (a nil value) those are rendered in a bold typographic
+weight, plus a height that is slightly taller than the default
+font size. Acceptable values come in the form of a list that can
+include either or both of those properties:
+
+- `variable-pitch' to use a proportionately spaced typeface;
+- `scale-title' to increase height to `modus-themes-scale-title'
+ OR `no-scale' to set the font to the same height as the rest of
+ the buffer.
+
+In case both `scale-title' and `no-scale' are in the list, the
+latter takes precedence.
+
+Example usage:
+
+ (header-block . nil)
+ (header-block . (scale-title))
+ (header-block . (no-scale))
+ (header-block . (variable-pitch scale-title))
+
+A `header-date' key covers date headings. Dates use only a
+foreground color by default (a nil value), with weekdays and
+weekends having a slight difference in hueness. The current date
+has an added gray background. This key accepts a list of values
+that can include any of the following properties:
+
+- `grayscale' to make weekdays use the main foreground color and
+ weekends a more subtle gray;
+- `workaholic' to make weekdays and weekends look the same in
+ terms of color;
+- `bold-today' to apply a bold typographic weight to the current
+ date;
+- `bold-all' to render all date headings in a bold weight.
+
+For example:
+
+ (header-date . nil)
+ (header-date . (workaholic))
+ (header-date . (grayscale bold-all))
+ (header-date . (grayscale workaholic))
+ (header-date . (grayscale workaholic bold-today))
+
+A `scheduled' key applies to tasks with a scheduled date. By
+default (a nil value), these use varying shades of yellow to
+denote (i) a past or current date and (ii) a future date. Valid
+values are symbols:
+
+- nil (default);
+- `uniform' to make all scheduled dates the same color;
+- `rainbow' to use contrasting colors for past, present, future
+ scheduled dates.
+
+For example:
+
+ (scheduled . nil)
+ (scheduled . uniform)
+ (scheduled . rainbow)
+
+A `habit' key applies to the `org-habit' graph. All possible
+value are passed as a symbol. Those are:
+
+- The default (nil) is meant to conform with the original
+ aesthetic of `org-habit'. It employs all four color codes that
+ correspond to the org-habit states---clear, ready, alert, and
+ overdue---while distinguishing between their present and future
+ variants. This results in a total of eight colors in use: red,
+ yellow, green, blue, in tinted and shaded versions. They cover
+ the full set of information provided by the `org-habit'
+ consistency graph.
+- `simplified' is like the default except that it removes the
+ dichotomy between current and future variants by applying
+ uniform color-coded values. It applies a total of four colors:
+ red, yellow, green, blue. They produce a simplified
+ consistency graph that is more legible (or less \"busy\") than
+ the default. The intent is to shift focus towards the
+ distinction between the four states of a habit task, rather
+ than each state's present/future outlook.
+- `traffic-light' further reduces the available colors to red,
+ yellow, and green. As in `simplified', present and future
+ variants appear uniformly, but differently from it, the 'clear'
+ state is rendered in a green hue, instead of the original blue.
+ This is meant to capture the use-case where a habit task being
+ \"too early\" is less important than it being \"too late\".
+ The difference between ready and clear states is attenuated by
+ painting both of them using shades of green. This option thus
+ highlights the alert and overdue states.
+- `traffic-light-deuteranopia' is like the `traffic-light' except
+ its three colors are red, yellow, and blue to be suitable for
+ users with red-green color deficiency (deuteranopia).
+
+For example:
+
+ (habit . nil)
+ (habit . simplified)
+ (habit . traffic-light)"
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set
+ (cons :tag "Block header"
+ (const header-block)
+ (set :tag "Header presentation" :greedy t
+ (choice :tag "Font style"
+ (const :tag "Use the original typeface (default)" nil)
+ (const :tag "Use `variable-pitch' font" variable-pitch))
+ (choice :tag "Scaling"
+ (const :tag "Slight increase in height (default)" nil)
+ (const :tag "Do not scale" no-scale)
+ (const :tag "Scale to match `modus-themes-scale-title'" scale-title))))
+ (cons :tag "Date header" :greedy t
+ (const header-date)
+ (set :tag "Header presentation" :greedy t
+ (const :tag "Use grayscale for date headers" grayscale)
+ (const :tag "Do not differentiate weekdays from weekends" workaholic)
+ (const :tag "Make today bold" bold-today)
+ (const :tag "Make all dates bold" bold-all)))
+ (cons :tag "Scheduled tasks"
+ (const scheduled)
+ (choice (const :tag "Yellow colors to distinguish current and future tasks (default)" nil)
+ (const :tag "Uniform subtle warm color for all scheduled tasks" uniform)
+ (const :tag "Rainbow-colored scheduled tasks" rainbow)))
+ (cons :tag "Habit graph"
+ (const habit)
+ (choice (const :tag "Follow the original design of `org-habit' (default)" nil)
+ (const :tag "Do not distinguish between present and future variants" simplified)
+ (const :tag "Use only red, yellow, green" traffic-light)
+ (const :tag "Use only red, yellow, blue" traffic-light-deuteranopia))))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Org agenda"))
+
+(defcustom modus-themes-scale-headings nil
+ "Use font scaling for headings.
+
+For regular headings the scale is controlled by the variables
+`modus-themes-scale-1' (smallest) and its variants all the way up
+to `modus-themes-scale-4' (larger).
+
+While `modus-themes-scale-title' is reserved for special headings
+that nominally are the largest on the scale (though that is not a
+requirement).
+
+A special heading is, in this context, one that does not fit into
+the syntax for heading levels that apply to the given mode. For
+example, Org's #+title keyword lies outside the normal eight
+levels of headings. Whereas, say, Markdown does not have such a
+special heading."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled headings"))
+
+(defcustom modus-themes-scale-1 1.05
+ "Font size that is slightly larger than the base value.
+
+This size is used for level 4 headings, such as in Org and
+Markdown files.
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(defcustom modus-themes-scale-2 1.1
+ "Font size slightly larger than `modus-themes-scale-1'.
+
+This size is used for level 3 headings, such as in Org and
+Markdown files.
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(defcustom modus-themes-scale-3 1.15
+ "Font size slightly larger than `modus-themes-scale-2'.
+
+This size is used for level 2 headings, such as in Org and
+Markdown files.
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(defcustom modus-themes-scale-4 1.2
+ "Font size slightly larger than `modus-themes-scale-3'.
+
+This size is used for level 1 headings, such as in Org and
+Markdown files.
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(defcustom modus-themes-scale-5 1.3
+ "Font size slightly larger than `modus-themes-scale-4'.
+
+This size is only used for 'special' top level headings, such as
+Org's file title heading, denoted by the #+title key word, and
+the Org agenda structure headers.
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(define-obsolete-variable-alias 'modus-themes-scale-5 'modus-themes-scale-title "1.5.0")
+
+(defcustom modus-themes-scale-title 1.3
+ "Font size slightly larger than `modus-themes-scale-4'.
+
+This size is only used for 'special' top level headings, such as
+Org's file title heading, denoted by the #+title key word, and
+the Org agenda structure headers (see `modus-themes-org-agenda').
+
+The default value is a floating point that is interpreted as a
+multiple of the base font size. It is recommended to use such a
+value.
+
+However, the variable also accepts an integer, understood as an
+absolute height that is 1/10 of the typeface's point size (e.g. a
+value of 140 is the same as setting the font at 14 point size).
+This will ignore the base font size and, thus, will not scale in
+accordance with it in cases where it changes, such as while using
+`text-scale-adjust'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type 'number
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Scaled heading sizes"))
+
+(defcustom modus-themes-fringes nil
+ "Define the visibility of fringes.
+
+Nil means the fringes have no background color. Option `subtle'
+will apply a grayscale value that is visible yet close to the
+main buffer background color. Option `intense' will use a more
+pronounced grayscale value."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type '(choice
+ (const :format "[%v] %t\n" :tag "No visible fringes (default)" nil)
+ (const :format "[%v] %t\n" :tag "Subtle grayscale background" subtle)
+ (const :format "[%v] %t\n" :tag "Intense grayscale background" intense))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Fringes"))
+
+(defcustom modus-themes-lang-checkers nil
+ "Control the style of spelling and code checkers/linters.
+
+The value is a list of properties, each designated by a symbol.
+The default (nil) applies a color-coded underline to the affected
+text, while it leaves the original foreground intact. If the
+display spec of Emacs has support for it, the underline's style
+is that of a wave, otherwise it is a straight line.
+
+The property `straight-underline' ensures that the underline
+under the affected text is always drawn as a straight line.
+
+The property `text-also' applies the same color of the underline
+to the affected text.
+
+The property `background' adds a color-coded background.
+
+The property `intense' amplifies the applicable colors if
+`background' and/or `text-only' are set. If `intense' is set on
+its own, then it implies `text-only'.
+
+To disable fringe indicators for Flymake or Flycheck, refer to
+variables `flymake-fringe-indicator-position' and
+`flycheck-indication-mode', respectively.
+
+Combinations of any of those properties can be expressed in a
+list, as in those examples:
+
+ (background)
+ (straight-underline intense)
+ (background text-also straight-underline)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-lang-checkers '(text-also background))
+
+NOTE: The placement of the straight underline, though not the
+wave style, is controlled by the built-in variables
+`underline-minimum-offset', `x-underline-at-descent-line',
+`x-use-underline-position-properties'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Straight underline" straight-underline)
+ (const :tag "Colorise text as well" text-also)
+ (const :tag "Increase color intensity" intense)
+ (const :tag "With background" background))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Language checkers"))
+
+(defcustom modus-themes-org-blocks nil
+ "Use a subtle gray or color-coded background for Org blocks.
+
+Nil (the default) means that the block has no distinct background
+of its own and uses the one that applies to the rest of the
+buffer.
+
+Option `gray-background' applies a subtle gray background to the
+block's contents. It also affects the begin and end lines of the
+block: their background extends to the edge of the window for
+Emacs version >= 27 where the ':extend' keyword is recognized by
+`set-face-attribute' (this is contingent on the variable
+`org-fontify-whole-block-delimiter-line').
+
+Option `tinted-background' uses a slightly colored background for
+the contents of the block. The exact color will depend on the
+programming language and is controlled by the variable
+`org-src-block-faces' (refer to the theme's source code for the
+current association list). For this to take effect, the Org
+buffer needs to be restarted with `org-mode-restart'.
+
+Code blocks use their major mode's colors only when the variable
+`org-src-fontify-natively' is non-nil. While quote/verse blocks
+require setting `org-fontify-quote-and-verse-blocks' to a non-nil
+value.
+
+Older versions of the themes provided options `grayscale' (or
+`greyscale') and `rainbow'. Those will continue to work as they
+are aliases for `gray-background' and `tinted-background',
+respectively."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.4.0")
+ :version "28.1"
+ :type '(choice
+ (const :format "[%v] %t\n" :tag "No Org block background (default)" nil)
+ (const :format "[%v] %t\n" :tag "Subtle gray block background" gray-background)
+ (const :format "[%v] %t\n" :tag "Alias for `gray-background'" grayscale) ; for backward compatibility
+ (const :format "[%v] %t\n" :tag "Alias for `gray-background'" greyscale)
+ (const :format "[%v] %t\n" :tag "Color-coded background per programming language" tinted-background)
+ (const :format "[%v] %t\n" :tag "Alias for `tinted-background'" rainbow)) ; back compat
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Org mode blocks"))
+
+(defcustom modus-themes-org-habit nil
+ "Deprecated in version 1.5.0 favor of `modus-themes-org-agenda'.
+
+Control the presentation of the `org-habit' graph.
+
+The default is meant to conform with the original aesthetic of
+`org-habit'. It employs all four color codes that correspond to
+the org-habit states---clear, ready, alert, and overdue---while
+distinguishing between their present and future variants. This
+results in a total of eight colors in use: red, yellow, green,
+blue, in tinted and shaded versions. They cover the full set of
+information provided by the `org-habit' consistency graph.
+
+Option `simplified' is like the default except that it removes
+the dichotomy between current and future variants by applying
+uniform color-coded values. It applies a total of four colors:
+red, yellow, green, blue. They produce a simplified consistency
+graph that is more legible (or less \"busy\") than the default.
+The intent is to shift focus towards the distinction between the
+four states of a habit task, rather than each state's
+present/future outlook.
+
+Option `traffic-light' further reduces the available colors to
+red, yellow, and green. As in `simplified', present and future
+variants appear uniformly, but differently from it, the 'clear'
+state is rendered in a green hue, instead of the original blue.
+This is meant to capture the use-case where a habit task being
+\"too early\" is less important than it being \"too late\". The
+difference between ready and clear states is attenuated by
+painting both of them using shades of green. This option thus
+highlights the alert and overdue states."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.1.0")
+ :version "28.1"
+ :type '(choice
+ (const :format "[%v] %t\n" :tag "Respect the original design of org-habit (default)" nil)
+ (const :format "[%v] %t\n" :tag "Like the default, but do not distinguish between present and future variants" simplified)
+ (const :format "[%v] %t\n" :tag "Like `simplified', but only use red, yellow, green" traffic-light))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Org agenda habits"))
+
+(make-obsolete 'modus-themes-org-habit 'modus-themes-org-agenda "1.5.0")
+
+(defcustom modus-themes-mode-line nil
+ "Control the overall style of the mode line.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a two-dimensional
+rectangle with a border around it. The active and the inactive
+mode lines use different shades of grayscale values for the
+background, foreground, border.
+
+The `3d' property applies a three-dimensional effect to the
+active mode line. The inactive mode lines remain two-dimensional
+and are toned down a bit, relative to the default style.
+
+The `moody' property optimizes the mode line for use with the
+library of the same name (hereinafter referred to as 'Moody').
+In practice, it removes the box effect and replaces it with
+underline and overline properties. It also tones down the
+inactive mode lines. Despite its intended purpose, this option
+can also be used without the Moody library (please consult the
+themes' manual on this point for more details). If both `3d' and
+`moody' properties are set, the latter takes precedence.
+
+The `borderless' property removes the color of the borders. It
+does not actually remove the borders, but only makes their color
+the same as the background, effectively creating some padding.
+
+The `accented' property ensures that the active mode line uses a
+colored background instead of the standard shade of gray.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (accented)
+ (borderless 3d)
+ (moody accented borderless)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-mode-line '(borderless accented))
+
+Note that Moody does not expose any faces that the themes could
+style directly. Instead it re-purposes existing ones to render
+its tabs and ribbons. As such, there may be cases where the
+contrast ratio falls below the 7:1 target that the themes conform
+with (WCAG AAA). To hedge against this, we configure a fallback
+foreground for the `moody' property, which will come into effect
+when the background of the mode line changes to something less
+accessible, such as Moody ribbons (read the doc string of
+`set-face-attribute', specifically `:distant-foreground'). This
+fallback is activated when Emacs determines that the background
+and foreground of the given construct are too close to each other
+in terms of color distance. In practice, users will need to
+experiment with the variable `face-near-same-color-threshold' to
+trigger the effect. We find that a value of 45000 shall suffice,
+contrary to the default 30000. Though for the combinations that
+involve the `accented' and `moody' properties, as mentioned
+above, that should be raised up to 70000. Do not set it too
+high, because it has the adverse effect of always overriding the
+default colors (which have been carefully designed to be highly
+accessible).
+
+Furthermore, because Moody expects an underline and overline
+instead of a box style, it is advised to set
+`x-underline-at-descent-line' to a non-nil value."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (choice :tag "Overall style"
+ (const :tag "Rectangular Border" nil)
+ (const :tag "3d borders" 3d)
+ (const :tag "No box effects (Moody-compatible)" moody))
+ (const :tag "Colored background" accented)
+ (const :tag "Without border color" borderless))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Mode line"))
+
+(defcustom modus-themes-diffs nil
+ "Adjust the overall style of diffs.
+
+The default (nil) uses fairly intense color combinations for
+diffs, by applying prominently colored backgrounds, with
+appropriate foregrounds.
+
+Option `desaturated' follows the same principles as with the
+default (nil), though it tones down all relevant colors.
+
+Option `bg-only' applies a background but does not override the
+text's foreground. This makes it suitable for a non-nil value
+passed to `diff-font-lock-syntax' (note: Magit does not support
+syntax highlighting in diffs---last checked on 2021-04-21).
+
+Option `deuteranopia' is like the default (nil) in terms of using
+prominently colored backgrounds, except that it also accounts for
+red-green color defficiency by replacing all instances of green
+with colors on the blue side of the spectrum. Other stylistic
+changes are made in the interest of optimizing for such a
+use-case.
+
+Option `fg-only-deuteranopia' removes all colored backgrounds,
+except from word-wise or refined changes. Instead, it only uses
+color-coded foreground values to differentiate between added,
+removed, and changed lines. If a background is necessary to
+denote context, a subtle grayscale value is applied. The color
+used for added lines is a variant of blue to account for
+red-green color defficiency but also because green text alone is
+hard to discern in the diff's context (hard for our accessibility
+purposes). The `fg-only' option that existed in older versions
+of the themes is now an alias of `fg-only-deuteranopia', in the
+interest of backward compatibility."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.4.0")
+ :version "28.1"
+ :type '(choice
+ (const :format "[%v] %t\n" :tag "Intensely colored backgrounds (default)" nil)
+ (const :format "[%v] %t\n" :tag "Slightly accented backgrounds with tinted text" desaturated)
+ (const :format "[%v] %t\n" :tag "Apply color-coded backgrounds; keep syntax colors intact" bg-only)
+ (const :format "[%v] %t\n" :tag "Like the default (nil), though optimized for red-green color defficiency" deuteranopia)
+ (const :format "[%v] %t\n" :tag "No backgrounds, except for refined diffs" fg-only-deuteranopia)
+ (const :format "[%v] %t\n" :tag "Alias of `fg-only-deuteranopia' for backward compatibility" fg-only))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Diffs"))
+
+(defcustom modus-themes-completions nil
+ "Control the style of the completion framework's interface.
+
+This is a special option that has different effects depending on
+the completion UI. The interfaces can be grouped in two
+categories, based on their default aesthetics: (i) those that
+only or mostly use foreground colors for their interaction model,
+and (ii) those that combine background and foreground values for
+some of their metaphors. The former category encompasses
+Icomplete, Ido, Selectrum, Vertico, as well as pattern matching
+styles like Orderless and Flx. The latter covers Helm, Ivy, and
+Sallet.
+
+A value of nil (the default) will simply respect the metaphors of
+each completion framework.
+
+Option `moderate' applies a combination of background and
+foreground that is fairly subtle. For Icomplete and friends this
+constitutes a departure from their default aesthetics, however
+the difference is small. While Helm, Ivy et al appear slightly
+different than their original looks, as they are toned down a
+bit.
+
+Option `opinionated' uses color combinations that refashion the
+completion UI. For the Icomplete camp this means that intense
+background and foreground combinations are used: in effect their
+looks emulate those of Helm, Ivy and company in their original
+style. Whereas the other group of packages will revert to an
+even more nuanced aesthetic with some additional changes to the
+choice of hues.
+
+To appreciate the scope of this customization option, you should
+spend some time with every one of the nil (default), `moderate',
+and `opinionated' possibilities."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type '(choice
+ (const :format "[%v] %t\n" :tag "Respect the framework's established aesthetic (default)" nil)
+ (const :format "[%v] %t\n" :tag "Subtle backgrounds for various elements" moderate)
+ (const :format "[%v] %t\n" :tag "Radical alternative to the framework's looks" opinionated))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Completion UIs"))
+
+(defcustom modus-themes-prompts nil
+ "Use subtle or intense styles for minibuffer and REPL prompts.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) means to only use a
+subtle accented foreground color.
+
+The property `background' applies a background color to the
+prompt's text. By default, this is a subtle accented value.
+
+The property `intense' makes the foreground color more prominent.
+If the `background' property is also set, it amplifies the value
+of the background as well.
+
+The property `gray' changes the prompt's colors to grayscale.
+This affects the foreground and, if the `background' property is
+also set, the background. Its effect is subtle, unless it is
+combined with the `intense' property.
+
+The property `bold' makes the text use a bold typographic weight.
+Similarly, `italic' adds a slant to the font's forms (italic or
+oblique forms, depending on the typeface).
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (intense)
+ (bold intense)
+ (intense bold gray)
+ (intense background gray bold)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-prompts '(background gray))"
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "With Background" background)
+ (const :tag "Intense" intense)
+ (const :tag "Grayscale" gray)
+ (const :tag "Bold font weight" bold)
+ (const :tag "Italic font slant" italic))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Command prompts"))
+
+(defcustom modus-themes-intense-hl-line nil
+ "Use a more prominent background for command `hl-line-mode'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.0.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Line highlighting"))
+
+(make-obsolete 'modus-themes-intense-hl-line 'modus-themes-hl-line "1.3.0")
+
+(defcustom modus-themes-hl-line nil
+ "Control the current line highlight of HL-line mode.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a subtle gray
+background color.
+
+The property `accented' changes the background to a colored
+variant.
+
+An `underline' property draws a line below the highlighted area.
+Its color is similar to the background, so gray by default or an
+accent color when `accented' is also set.
+
+An `intense' property amplifies the colors in use, which may be
+both the background and the underline.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (intense)
+ (underline intense)
+ (accented intense underline)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-hl-line '(underline accented))
+
+Set `x-underline-at-descent-line' to a non-nil value for better
+results with underlines."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Colored background" accented)
+ (const :tag "Underline" underline)
+ (const :tag "Intense style" intense))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Line highlighting"))
+
+(defcustom modus-themes-subtle-line-numbers nil
+ "Use more subtle style for command `display-line-numbers-mode'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.2.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Line numbers"))
+
+(defcustom modus-themes-paren-match nil
+ "Control the style of matching parentheses or delimiters.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a subtle background
+color.
+
+The `bold' property adds a bold weight to the characters of the
+matching delimiters.
+
+The `intense' property applies a more prominent background color
+to the delimiters.
+
+The `underline' property draws a straight line under the affected
+text.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (bold)
+ (underline intense)
+ (bold intense underline)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-paren-match '(bold intense))"
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Bold weight" bold)
+ (const :tag "Intense background color" intense)
+ (const :tag "Underline" underline))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Matching parentheses"))
+
+(defcustom modus-themes-syntax nil
+ "Control the overall style of code syntax highlighting.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is to use a balanced
+combination of colors on the cyan-blue-magenta side of the
+spectrum. There is little to no use of greens, yellows, and
+reds. Comments are gray, strings are blue colored, doc strings
+are a shade of cyan, while color combinations are designed to
+avoid exaggerations.
+
+The property `faint' fades the saturation of all applicable
+colors, where that is possible or appropriate.
+
+The property `yellow-comments' applies a yellow color to
+comments.
+
+The property `green-strings' applies a green color to strings and
+a green tint to doc strings.
+
+The property `alt-syntax' changes the combination of colors
+beyond strings and comments, so that the effective palette is
+broadened to provide greater variety relative to the default.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (faint)
+ (green-strings yellow-comments)
+ (alt-syntax green-strings yellow-comments)
+ (faint alt-syntax green-strings yellow-comments)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-syntax '(faint alt-syntax))
+
+Independent of this variable, users may also control the use of a
+bold weight or italic text: `modus-themes-bold-constructs' and
+`modus-themes-italic-constructs'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Faint colors" faint)
+ (const :tag "Yellow comments" yellow-comments)
+ (const :tag "Green strings" green-strings)
+ (const :tag "Alternative set of colors" alt-syntax))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Syntax styles"))
+
+(defcustom modus-themes-links nil
+ "Set the style of links.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a prominent text
+color, typically blue, with an underline of the same color.
+
+For the style of the underline, a `neutral-underline' property
+turns the color of the line into a subtle gray, while the
+`no-underline' property removes the line altogether. If both of
+those are set, the latter takes precedence.
+
+For text coloration, a `faint' property desaturates the color of
+the text and the underline, unless the underline is affected by
+the aforementioned properties. While a `no-color' property
+removes the color from the text. If both of those are set, the
+latter takes precedence.
+
+A `bold' property applies a heavy typographic weight to the text
+of the link.
+
+An `italic' property adds a slant to the link's text (italic or
+oblique forms, depending on the typeface).
+
+A `background' property applies a subtle tinted background color.
+
+In case both `no-underline' and `no-color' are set, then a subtle
+gray background is applied to all links. This can still be
+combined with the `bold' and `italic' properties.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (faint)
+ (no-underline faint)
+ (no-color no-underline bold)
+ (italic bold background no-color no-underline)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-links '(neutral-underline background))
+
+The placement of the underline, meaning its proximity to the
+text, is controlled by `x-use-underline-position-properties',
+`x-underline-at-descent-line', `underline-minimum-offset'.
+Please refer to their documentation strings."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (choice :tag "Text coloration"
+ (const :tag "Saturared color (default)" nil)
+ (const :tag "Faint coloration" faint)
+ (const :tag "No color (use main black/white)" no-color))
+ (choice :tag "Underline"
+ (const :tag "Same color as text (default)" nil)
+ (const :tag "Neutral (gray) underline color" neutral-underline)
+ (const :tag "No underline" no-underline))
+ (const :tag "Bold font weight" bold)
+ (const :tag "Italic font slant" italic)
+ (const :tag "Subtle background color" background))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Link styles"))
+
+(defcustom modus-themes-region nil
+ "Control the overall style of the active region.
+
+The value is a list of properties, each designated by a symbol.
+The default (a nil value or an empty list) is a prominent gray
+background that overrides all foreground colors in the area it
+encompasses. Its reach extends to the edge of the window.
+
+The `no-extend' property limits the region to the end of the
+line, so that it does not reach the edge of the window.
+
+The `bg-only' property makes the region's background color more
+subtle to allow the underlying text to retain its foreground
+colors.
+
+The `accented' property applies a more colorful background to the
+region.
+
+Combinations of any of those properties are expressed as a list,
+like in these examples:
+
+ (no-extend)
+ (bg-only accented)
+ (accented bg-only no-extend)
+
+The order in which the properties are set is not significant.
+
+In user configuration files the form may look like this:
+
+ (setq modus-themes-region '(bg-only no-extend))"
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.5.0")
+ :version "28.1"
+ :type '(set :tag "Properties" :greedy t
+ (const :tag "Do not extend to the edge of the window" no-extend)
+ (const :tag "Background only (preserve underlying colors)" bg-only)
+ (const :tag "Accented background" accented))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Active region"))
+
+(defcustom modus-themes-success-deuteranopia nil
+ "Color-code 'success' or 'done' as blue instead of green.
+
+This is to account for red-green color deficiency.
+
+The present customization option should apply to all contexts where
+there can be a color-coded distinction between success and failure,
+to-do and done, and so on.
+
+Diffs, which have a red/green dichotomy by default, can also be
+configured to conform with deuteranopia: `modus-themes-diffs'."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.4.0")
+ :version "28.1"
+ :type 'boolean
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Success' color-code"))
+
+(defcustom modus-themes-mail-citations nil
+ "Control the color of citations in messages or email clients.
+
+Nil (the default) means to use a variety of contrasting hues to
+denote depth in nested citations. Colors are fairly easy to tell
+apart.
+
+Option `faint' maintains a color-based distinction between
+citation levels but the colors it applies have very subtle
+differences between them.
+
+Option `monochrome' turns all citations that would otherwise be
+colored into a uniform shade of shade of gray."
+ :group 'modus-themes
+ :package-version '(modus-themes . "1.4.0")
+ :version "28.1"
+ :type '(choice
+ (const :format "[%v] %t\n" :tag "Colorful mail citations with contrasting hues (default)" nil)
+ (const :format "[%v] %t\n" :tag "Like the default, but with less saturated colors" faint)
+ (const :format "[%v] %t\n" :tag "Deprecated alias of `faint'" desaturated)
+ (const :format "[%v] %t\n" :tag "Uniformly gray mail citations" monochrome))
+ :set #'modus-themes--set-option
+ :initialize #'custom-initialize-default
+ :link '(info-link "(modus-themes) Mail citations"))
+
+
+
+;;; Internal functions
+
+(defun modus-themes--palette (theme)
+ "Return color palette for Modus theme THEME.
+THEME is a symbol, either `modus-operandi' or `modus-vivendi'."
+ (pcase theme
+ ('modus-operandi
+ (append modus-themes-operandi-color-overrides
+ modus-themes-operandi-colors))
+ ('modus-vivendi
+ (append modus-themes-vivendi-color-overrides
+ modus-themes-vivendi-colors))
+ (_theme
+ (error "'%s' is not a Modus theme" theme))))
+
+(defvar modus-themes-faces)
+(defvar modus-themes-custom-variables)
+
+(defmacro modus-themes-theme (name)
+ "Bind NAME's color palette around face specs and variables.
+
+NAME should be the proper name of a Modus theme, either
+`modus-operandi' or `modus-vivendi'.
+
+Face specifications are passed to `custom-theme-set-faces'.
+While variables are handled by `custom-theme-set-variables'.
+Those are stored in `modus-themes-faces' and
+`modus-themes-custom-variables' respectively."
+ (declare (indent 0))
+ (let ((palette-sym (gensym))
+ (colors (mapcar #'car modus-themes-operandi-colors)))
+ `(let* ((class '((class color) (min-colors 89)))
+ (,palette-sym (modus-themes--palette ',name))
+ ,@(mapcar (lambda (color)
+ (list color `(alist-get ',color ,palette-sym)))
+ colors))
+ (custom-theme-set-faces ',name ,@modus-themes-faces)
+ (custom-theme-set-variables ',name ,@modus-themes-custom-variables))))
+
+(defun modus-themes--current-theme ()
+ "Return current theme."
+ (car custom-enabled-themes))
+
+;; Helper functions that are meant to ease the implementation of the
+;; above customization variables.
+(defun modus-themes--bold-weight ()
+ "Conditional use of a heavier text weight."
+ (when modus-themes-bold-constructs
+ (list :inherit 'bold)))
+
+(defun modus-themes--slant ()
+ "Conditional use of italics for slant attribute."
+ (if modus-themes-italic-constructs
+ (list 'italic)
+ (list 'normal)))
+
+(defun modus-themes--fixed-pitch ()
+ "Conditional application of `fixed-pitch' inheritance."
+ (unless modus-themes-no-mixed-fonts
+ (list :inherit 'fixed-pitch)))
+
+(defun modus-themes--variable-pitch ()
+ "Conditional use of `variable-pitch' in headings."
+ (when modus-themes-variable-pitch-headings
+ (list :inherit 'variable-pitch)))
+
+(defun modus-themes--variable-pitch-ui ()
+ "Conditional use of `variable-pitch' in UI elements."
+ (when modus-themes-variable-pitch-ui
+ (list :inherit 'variable-pitch)))
+
+(defun modus-themes--fringe (mainbg subtlebg intensebg)
+ "Conditional use of background colors for fringes.
+MAINBG is the default. SUBTLEBG should be a subtle grayscale
+value. INTENSEBG must be a more pronounced grayscale color."
+ (pcase modus-themes-fringes
+ ('intense (list :background intensebg))
+ ('subtle (list :background subtlebg))
+ (_ (list :background mainbg))))
+
+(defun modus-themes--line-numbers (mainfg mainbg altfg &optional altbg)
+ "Conditional use of colors for line numbers.
+MAINBG and MAINFG are the default colors. ALTFG is a color that
+combines with the theme's primary background (white/black)."
+ (if modus-themes-subtle-line-numbers
+ (list :background (or altbg 'unspecified) :foreground altfg)
+ (list :background mainbg :foreground mainfg)))
+
+(defun modus-themes--lang-check (underline subtlefg intensefg intensefg-alt subtlebg intensebg)
+ "Conditional use of foreground colors for language checkers.
+UNDERLINE is a color-code value for the affected text's underline
+property. SUBTLEFG and INTENSEFG follow the same color-coding
+pattern and represent a value that is faint or vibrant
+respectively. INTENSEFG-ALT is used when the intensity is high.
+SUBTLEBG and INTENSEBG are color-coded background colors that
+differ in overall intensity."
+ (let ((modus-themes-lang-checkers
+ (if (listp modus-themes-lang-checkers)
+ modus-themes-lang-checkers
+ (pcase modus-themes-lang-checkers
+ ('colored-background '(background intense))
+ ('intense-foreground '(intense))
+ ('intense-foreground-straight-underline '(intense straight-underline))
+ ('subtle-foreground '(text-also))
+ ('subtle-foreground-straight-underline '(text-also straight-underline))
+ ('straight-underline '(straight-underline))))))
+ (list :underline
+ (list :color
+ underline
+ :style
+ (if (memq 'straight-underline modus-themes-lang-checkers)
+ 'line 'wave))
+ :background
+ (cond
+ ((and (memq 'background modus-themes-lang-checkers)
+ (memq 'intense modus-themes-lang-checkers))
+ intensebg)
+ ((memq 'background modus-themes-lang-checkers)
+ subtlebg))
+ :foreground
+ (cond
+ ((and (memq 'background modus-themes-lang-checkers)
+ (memq 'intense modus-themes-lang-checkers))
+ intensefg-alt)
+ ((memq 'intense modus-themes-lang-checkers)
+ intensefg)
+ ((memq 'text-also modus-themes-lang-checkers)
+ subtlefg)))))
+
+(defun modus-themes--prompt (mainfg intensefg grayfg subtlebg intensebg intensebg-fg subtlebggray intensebggray)
+ "Conditional use of colors for prompts.
+MAINFG is the prompt's standard foreground. INTENSEFG is a more
+prominent alternative to the main foreground, while GRAYFG is a
+less luminant shade of gray.
+
+SUBTLEBG is a subtle accented background that works with either
+MAINFG or INTENSEFG.
+
+INTENSEBG is a more pronounced accented background color that
+should be combinable with INTENSEBG-FG.
+
+SUBTLEBGGRAY and INTENSEBGGRAY are background values. The former
+can be combined with GRAYFG, while the latter only works with the
+theme's fallback text color."
+ (let ((modus-themes-prompts
+ (if (listp modus-themes-prompts)
+ modus-themes-prompts
+ ;; translation layer for legacy values
+ (pcase modus-themes-prompts
+ ;; `subtle' is the same as `subtle-accented', while `intense' is
+ ;; equal to `intense-accented' for backward compatibility
+ ('subtle '(background))
+ ('subtle-accented '(background))
+ ('subtle-gray '(background gray))
+ ('intense '(background intense))
+ ('intense-accented '(background intense))
+ ('intense-gray '(background intense gray))))))
+ (list :foreground
+ (cond
+ ((and (memq 'gray modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ 'unspecified)
+ ((memq 'gray modus-themes-prompts)
+ grayfg)
+ ((and (memq 'background modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ intensebg-fg)
+ ((memq 'intense modus-themes-prompts)
+ intensefg)
+ (mainfg))
+ :background
+ (cond
+ ((and (memq 'gray modus-themes-prompts)
+ (memq 'background modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ intensebggray)
+ ((and (memq 'gray modus-themes-prompts)
+ (memq 'background modus-themes-prompts))
+ subtlebggray)
+ ((and (memq 'background modus-themes-prompts)
+ (memq 'intense modus-themes-prompts))
+ intensebg)
+ ((memq 'background modus-themes-prompts)
+ subtlebg)
+ ('unspecified))
+ :inherit
+ (cond
+ ((and (memq 'bold modus-themes-prompts)
+ (memq 'italic modus-themes-prompts))
+ 'bold-italic)
+ ((memq 'italic modus-themes-prompts)
+ 'italic)
+ ((memq 'bold modus-themes-prompts)
+ 'bold)
+ ('unspecified)))))
+
+(defun modus-themes--paren (normalbg intensebg)
+ "Conditional use of intense colors for matching parentheses.
+NORMALBG should be the special palette color 'bg-paren-match' or
+something similar. INTENSEBG must be easier to discern next to
+other backgrounds, such as the special palette color
+'bg-paren-match-intense'."
+ (let ((modus-themes-paren-match
+ (if (listp modus-themes-paren-match)
+ modus-themes-paren-match
+ ;; translation layer for legacy values
+ (pcase modus-themes-paren-match
+ ;; `subtle' is the same as `subtle-accented', while `intense' is
+ ;; equal to `intense-accented' for backward compatibility
+ ('intense-bold '(intense bold))
+ ('subtle-bold '(bold))
+ ('intense '(intense))))))
+ (list :inherit
+ (if (memq 'bold modus-themes-paren-match)
+ 'bold
+ 'unspecified)
+ :background
+ (if (memq 'intense modus-themes-paren-match)
+ intensebg
+ normalbg)
+ :underline
+ (if (memq 'underline modus-themes-paren-match)
+ t
+ nil))))
+
+(defun modus-themes--syntax-foreground (fg faint)
+ "Apply foreground value to code syntax.
+FG is the default. FAINT is typically the same color in its
+desaturated version."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((memq 'faint modus-themes-syntax)
+ faint)
+ (fg)))))
+
+(defun modus-themes--syntax-extra (fg faint alt &optional faint-alt)
+ "Apply foreground value to code syntax.
+FG is the default. FAINT is typically the same color in its
+desaturated version. ALT is another hue while optional FAINT-ALT
+is its subtle alternative."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((and (memq 'alt-syntax modus-themes-syntax)
+ (memq 'faint modus-themes-syntax))
+ (or faint-alt alt))
+ ((memq 'faint modus-themes-syntax)
+ faint)
+ ((memq 'alt-syntax modus-themes-syntax)
+ alt)
+ (fg)))))
+
+(defun modus-themes--syntax-string (fg faint green alt &optional faint-green faint-alt)
+ "Apply foreground value to strings in code syntax.
+FG is the default. FAINT is typically the same color in its
+desaturated version. GREEN is a color variant in that side of
+the spectrum. ALT is another hue. Optional FAINT-GREEN is a
+subtle alternative to GREEN. Optional FAINT-ALT is a subtle
+alternative to ALT."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((and (memq 'faint modus-themes-syntax)
+ (memq 'green-strings modus-themes-syntax))
+ (or faint-green green))
+ ((and (memq 'alt-syntax modus-themes-syntax)
+ (memq 'faint modus-themes-syntax))
+ (or faint-alt faint))
+ ((memq 'faint modus-themes-syntax)
+ faint)
+ ((memq 'green-strings modus-themes-syntax)
+ green)
+ ((memq 'alt-syntax modus-themes-syntax)
+ alt)
+ (fg)))))
+
+(defun modus-themes--syntax-comment (fg yellow &optional faint-yellow faint)
+ "Apply foreground value to strings in code syntax.
+FG is the default. YELLOW is a color variant of that name while
+optional FAINT-YELLOW is its subtle variant. Optional FAINT is
+an alternative to the default value."
+ (let ((modus-themes-syntax
+ (if (listp modus-themes-syntax)
+ modus-themes-syntax
+ ;; translation layer for legacy values
+ (pcase modus-themes-syntax
+ ('faint '(faint))
+ ('faint-yellow-comments '(faint yellow-comments))
+ ('green-strings '(green-strings))
+ ('yellow-comments '(yellow-comments))
+ ('yellow-comments-green-strings '(green-strings yellow-comments))
+ ('alt-syntax '(alt-syntax))
+ ('alt-syntax-yellow-comments '(alt-syntax yellow-comments))))))
+ (list :foreground
+ (cond
+ ((and (memq 'faint modus-themes-syntax)
+ (memq 'yellow-comments modus-themes-syntax))
+ (or faint-yellow yellow))
+ ((and (memq 'alt-syntax modus-themes-syntax)
+ (memq 'yellow-comments modus-themes-syntax)
+ (not (memq 'green-strings modus-themes-syntax)))
+ (or faint-yellow yellow))
+ ((memq 'yellow-comments modus-themes-syntax)
+ yellow)
+ ((memq 'faint modus-themes-syntax)
+ (or faint fg))
+ (fg)))))
+
+(defun modus-themes--key-cdr (key alist)
+ "Get cdr of KEY in ALIST."
+ (cdr (assoc key alist)))
+
+(defun modus-themes--heading (level fg fg-alt bg bg-gray border)
+ "Conditional styles for `modus-themes-headings'.
+
+LEVEL is the heading's position in their order. FG is the
+default text color. FG-ALT is an accented, more saturated value
+than the default. BG is a nuanced, typically accented,
+background that can work well with either of the foreground
+values. BG-GRAY is a gray background. BORDER is a color value
+that combines well with the background and foreground."
+ (let* ((key (modus-themes--key-cdr level modus-themes-headings))
+ (style (or key (modus-themes--key-cdr t modus-themes-headings)))
+ (modus-themes-headings
+ (if (listp style)
+ style
+ ;; translation layer for legacy values
+ (pcase style
+ ('highlight '(background))
+ ('highlight-no-bold '(background no-bold))
+ ('line '(overline))
+ ('line-no-bold '(no-bold overline))
+ ('no-bold '(no-bold))
+ ('no-color '(monochrome))
+ ('no-color-no-bold '(no-bold monochrome))
+ ('rainbow '(rainbow))
+ ('rainbow-highlight '(rainbow background))
+ ('rainbow-highlight-no-bold '(no-bold rainbow background))
+ ('rainbow-line '(rainbow overline))
+ ('rainbow-no-bold '(no-bold rainbow))
+ ('rainbow-line-no-bold '(rainbow overline no-bold))
+ ('rainbow-section '(rainbow overline background))
+ ('rainbow-section-no-bold '(no-bold rainbow background overline))
+ ('section '(background overline))
+ ('section-no-bold '(background overline no-bold)))))
+ (var (if modus-themes-variable-pitch-headings
+ 'variable-pitch
+ 'unspecified))
+ (varbold (if var
+ (append (list 'bold) (list var))
+ 'bold)))
+ (list :inherit
+ (cond
+ ((memq 'no-bold modus-themes-headings)
+ var)
+ (varbold))
+ :background
+ (cond
+ ((and (memq 'monochrome modus-themes-headings)
+ (memq 'background modus-themes-headings))
+ bg-gray)
+ ((memq 'background modus-themes-headings)
+ bg)
+ ('unspecified))
+ :foreground
+ (cond
+ ((memq 'monochrome modus-themes-headings)
+ 'unspecified)
+ ((memq 'rainbow modus-themes-headings)
+ fg-alt)
+ (fg))
+ :overline
+ (if (memq 'overline modus-themes-headings)
+ border
+ 'unspecified))))
+
+(defun modus-themes--agenda-structure (fg)
+ "Control the style of the Org agenda structure.
+FG is the foreground color to use."
+ (let* ((properties (modus-themes--key-cdr 'header-block modus-themes-org-agenda))
+ (inherit (cond ((memq 'variable-pitch properties)
+ (list 'bold 'variable-pitch))
+ ('bold)))
+ (height (cond ((memq 'no-scale properties)
+ 1.0)
+ ((memq 'scale-title properties)
+ modus-themes-scale-title)
+ (1.15))))
+ (list :inherit inherit
+ :height height
+ :foreground fg)))
+
+(defun modus-themes--agenda-date (defaultfg grayscalefg &optional bold workaholicfg grayscaleworkaholicfg)
+ "Control the style of date headings in Org agenda buffers.
+DEFAULTFG is the original accent color for the foreground.
+GRAYSCALEFG is a neutral color. Optional BOLD applies a bold
+weight. Optional WORKAHOLICFG and GRAYSCALEWORKAHOLICFG are
+alternative foreground colors."
+ (let* ((properties (modus-themes--key-cdr 'header-date modus-themes-org-agenda))
+ (weight (cond ((memq 'bold-all properties)
+ 'bold)
+ ((and bold (memq 'bold-today properties))
+ 'bold)
+ (t
+ nil)))
+ (fg (cond ((and (memq 'grayscale properties)
+ (memq 'workaholic properties))
+ (or grayscaleworkaholicfg grayscalefg))
+ ((memq 'grayscale properties)
+ grayscalefg)
+ ((memq 'workaholic properties)
+ (or workaholicfg defaultfg))
+ (t
+ defaultfg))))
+ (list :inherit weight
+ :foreground fg)))
+
+(defun modus-themes--agenda-scheduled (defaultfg uniformfg rainbowfg)
+ "Control the style of the Org agenda scheduled tasks.
+DEFAULTFG is an accented foreground color that is meant to
+differentiate between past or present and future tasks.
+UNIFORMFG is a more subtle color that eliminates the color coding
+for scheduled tasks. RAINBOWFG is a prominent accent value that
+clearly distinguishes past, present, future tasks."
+ (pcase (modus-themes--key-cdr 'scheduled modus-themes-org-agenda)
+ ('uniform (list :foreground uniformfg))
+ ('rainbow (list :foreground rainbowfg))
+ (_ (list :foreground defaultfg))))
+
+(defun modus-themes--agenda-habit (default traffic simple &optional traffic-deuteran)
+ "Specify background values for `modus-themes-org-agenda' habits.
+DEFAULT is the original foregrounc color. TRAFFIC is to be used
+when the 'traffic-light' style is applied, while SIMPLE
+corresponds to the 'simplified style'. Optional TRAFFIC-DEUTERAN
+is an alternative to TRAFFIC, meant for deuteranopia."
+ (pcase (modus-themes--key-cdr 'habit modus-themes-org-agenda)
+ ('traffic-light (list :background traffic))
+ ('traffic-light-deuteranopia (list :background (or traffic-deuteran traffic)))
+ ('simplified (list :background simple))
+ (_ (list :background default))))
+
+(defun modus-themes--org-block (bgblk fgdefault &optional fgblk)
+ "Conditionally set the background of Org blocks.
+BGBLK applies to a distinct neutral background. Else blocks have
+no background of their own (the default), so they look the same
+as the rest of the buffer. FGDEFAULT is used when no distinct
+background is present. While optional FGBLK specifies a
+foreground value that can be combined with BGBLK.
+
+`modus-themes-org-blocks' also accepts `tinted-background' (alias
+`rainbow') as a value which applies to `org-src-block-faces' (see
+the theme's source code)."
+ (if (or (eq modus-themes-org-blocks 'gray-background)
+ (eq modus-themes-org-blocks 'grayscale)
+ (eq modus-themes-org-blocks 'greyscale))
+ (list :background bgblk :foreground (or fgblk fgdefault) :extend t)
+ (list :background 'unspecified :foreground fgdefault)))
+
+(defun modus-themes--org-block-delim (bgaccent fgaccent bg fg)
+ "Conditionally set the styles of Org block delimiters.
+BG, FG, BGACCENT, FGACCENT apply a background and foreground
+color respectively.
+
+The former pair is a grayscale combination that should be more
+distinct than the background of the block. It is applied to the
+default styles or when `modus-themes-org-blocks' is set
+to `grayscale' (or `greyscale').
+
+The latter pair should be more subtle than the background of the
+block, as it is used when `modus-themes-org-blocks' is
+set to `rainbow'."
+ (pcase modus-themes-org-blocks
+ ('gray-background (list :background bg :foreground fg :extend t))
+ ('grayscale (list :background bg :foreground fg :extend t))
+ ('greyscale (list :background bg :foreground fg :extend t))
+ ('rainbow (list :background bgaccent :foreground fgaccent))
+ (_ (list :background bg :foreground fg))))
+
+(defun modus-themes--mode-line-attrs
+ (fg bg fg-alt bg-alt fg-accent bg-accent border border-3d &optional alt-style border-width fg-distant)
+ "Color combinations for `modus-themes-mode-line'.
+
+FG and BG are the default colors. FG-ALT and BG-ALT are meant to
+accommodate the options for a 3D mode line or a `moody' compliant
+one. FG-ACCENT and BG-ACCENT are used for all variants. BORDER
+applies to all permutations of the mode line, except the
+three-dimensional effect, where BORDER-3D is used instead.
+
+Optional ALT-STYLE applies an appropriate style to the mode
+line's box property.
+
+Optional BORDER-WIDTH specifies an integer for the width of the
+rectangle that produces the box effect.
+
+Optional FG-DISTANT should be close to the main background
+values. It is intended to be used as a distant-foreground
+property."
+ (let ((modus-themes-mode-line
+ (if (listp modus-themes-mode-line)
+ modus-themes-mode-line
+ ;; translation layer for legacy values
+ (alist-get modus-themes-mode-line
+ '((3d . (3d))
+ (moody . (moody))
+ (borderless . (borderless))
+ (borderless-3d . (borderless 3d))
+ (borderless-moody . (borderless moody))
+ (accented . (accented))
+ (accented-3d . (accented 3d))
+ (accented-moody . (accented moody))
+ (borderless-accented . (borderless accented))
+ (borderless-accented-3d . (borderless accented 3d))
+ (borderless-accented-moody . (borderless accented moody)))))))
+ (let ((base (cond ((memq 'accented modus-themes-mode-line)
+ (cons fg-accent bg-accent))
+ ((and (or (memq 'moody modus-themes-mode-line)
+ (memq '3d modus-themes-mode-line))
+ (not (memq 'borderless modus-themes-mode-line)))
+ (cons fg-alt bg-alt))
+ ((cons fg bg))))
+ (box (cond ((memq 'moody modus-themes-mode-line)
+ nil)
+ ((memq '3d modus-themes-mode-line)
+ (list :line-width (or border-width 1)
+ :color
+ (cond ((and (memq 'accented modus-themes-mode-line)
+ (memq 'borderless modus-themes-mode-line))
+ bg-accent)
+ ((memq 'borderless modus-themes-mode-line) bg)
+ (border-3d))
+ :style (and alt-style 'released-button)))
+ ((or (memq 'borderless modus-themes-mode-line)
+ (memq 'moody modus-themes-mode-line))
+ bg)
+ (border)))
+ (line (cond ((not (memq 'moody modus-themes-mode-line))
+ nil)
+ ((and (memq 'borderless modus-themes-mode-line)
+ (memq 'accented modus-themes-mode-line))
+ bg-accent)
+ ((memq 'borderless modus-themes-mode-line)
+ bg)
+ (border))))
+ (list :foreground (car base)
+ :background (cdr base)
+ :box box
+ :overline line
+ :underline line
+ :distant-foreground
+ (and (memq 'moody modus-themes-mode-line)
+ fg-distant)))))
+
+(defun modus-themes--diff
+ (fg-only-bg fg-only-fg mainbg mainfg altbg altfg &optional deuteranbg deuteranfg bg-only-fg)
+ "Color combinations for `modus-themes-diffs'.
+
+FG-ONLY-BG should be similar or the same as the main background.
+FG-ONLY-FG should be a saturated accent value that can be
+combined with the former.
+
+MAINBG must be one of the dedicated backgrounds for diffs while
+MAINFG must be the same for the foreground.
+
+ALTBG needs to be a slightly accented background that is meant to
+be combined with ALTFG. Both must be less intense than MAINBG
+and MAINFG respectively.
+
+DEUTERANBG and DEUTERANFG must be combinations of colors that account
+for red-green color defficiency (deuteranopia).
+
+Optional BG-ONLY-FG applies ALTFG else leaves the foreground
+unspecified."
+ (pcase modus-themes-diffs
+ ('fg-only (list :background fg-only-bg :foreground fg-only-fg))
+ ('fg-only-deuteranopia (list :background fg-only-bg :foreground fg-only-fg))
+ ('desaturated (list :background altbg :foreground altfg))
+ ('deuteranopia (list :background (or deuteranbg mainbg) :foreground (or deuteranfg mainfg)))
+ ('bg-only (list :background altbg :foreground (if bg-only-fg altfg 'unspecified)))
+ (_ (list :background mainbg :foreground mainfg))))
+
+(defun modus-themes--diff-deuteran (deuteran main)
+ "Determine whether the DEUTERAN or MAIN color should be used.
+This is based on whether `modus-themes-diffs' has the value
+`deuteranopia'."
+ (if (or (eq modus-themes-diffs 'deuteranopia)
+ (eq modus-themes-diffs 'fg-only-deuteranopia)
+ (eq modus-themes-diffs 'fg-only))
+ (list deuteran)
+ (list main)))
+
+(defun modus-themes--success-deuteran (deuteran main)
+ "Determine whether to color-code success as DEUTERAN or MAIN."
+ (if modus-themes-success-deuteranopia
+ (list deuteran)
+ (list main)))
+
+(defun modus-themes--standard-completions (mainfg subtlebg intensebg intensefg)
+ "Combinations for `modus-themes-completions'.
+
+MAINFG is an accented foreground value. SUBTLEBG is an accented
+background value that can be combined with MAINFG. INTENSEBG and
+INTENSEFG are accented colors that are designed to be used in
+tandem.
+
+These are intended for Icomplete, Ido, and related."
+ (pcase modus-themes-completions
+ ('opinionated (list :background intensebg :foreground intensefg))
+ ('moderate (list :background subtlebg :foreground mainfg))
+ (_ (list :foreground mainfg))))
+
+(defun modus-themes--extra-completions (subtleface intenseface altface &optional altfg bold)
+ "Combinations for `modus-themes-completions'.
+
+SUBTLEFACE and INTENSEFACE are custom theme faces that combine a
+background and foreground value. The difference between the two
+is a matter of degree.
+
+ALTFACE is a combination of colors that represents a departure
+from the UI's default aesthetics. Optional ALTFG is meant to be
+used in tandem with it.
+
+Optional BOLD will apply a heavier weight to the text.
+
+These are intended for Helm, Ivy, etc."
+ (pcase modus-themes-completions
+ ('opinionated (list :inherit (list altface bold)
+ :foreground (or altfg 'unspecified)))
+ ('moderate (list :inherit (list subtleface bold)))
+ (_ (list :inherit (list intenseface bold)))))
+
+(defun modus-themes--link (fg fgfaint underline bg bgneutral)
+ "Conditional application of link styles.
+FG is the link's default color for its text and underline
+property. FGFAINT is a desaturated color for the text and
+underline. UNDERLINE is a gray color only for the undeline. BG
+is a background color and BGNEUTRAL is its fallback value."
+ (let ((modus-themes-links
+ (if (listp modus-themes-links)
+ modus-themes-links
+ ;; translation layer for legacy values
+ (pcase modus-themes-links
+ ('faint '(faint))
+ ('neutral-underline '(neutral-underline))
+ ('faint-neutral-underline '(neutral-underline faint))
+ ('no-underline '(no-underline))
+ ('underline-only '(no-color))
+ ('neutral-underline-only '(no-color neutral-underline))))))
+ (list :inherit
+ (cond
+ ((and (memq 'bold modus-themes-links)
+ (memq 'italic modus-themes-links))
+ 'bold-italic)
+ ((memq 'italic modus-themes-links)
+ 'italic)
+ ((memq 'bold modus-themes-links)
+ 'bold)
+ ('unspecified))
+ :background
+ (cond
+ ((and (memq 'no-color modus-themes-links)
+ (memq 'no-underline modus-themes-links))
+ bgneutral)
+ ((memq 'background modus-themes-links)
+ bg)
+ ('unspecified))
+ :foreground
+ (cond
+ ((memq 'no-color modus-themes-links)
+ 'unspecified)
+ ((memq 'faint modus-themes-links)
+ fgfaint)
+ (fg))
+ :underline
+ (cond
+ ((memq 'no-underline modus-themes-links)
+ 'unspecified)
+ ((memq 'neutral-underline modus-themes-links)
+ underline)
+ (t)))))
+
+(defun modus-themes--link-color (fg fgfaint &optional neutralfg)
+ "Extends `modus-themes--link'.
+FG is the main accented foreground. FGFAINT is also accented,
+yet desaturated. Optional NEUTRALFG is a gray value."
+ (let ((modus-themes-links
+ (if (listp modus-themes-links)
+ modus-themes-links
+ ;; translation layer for legacy values
+ (pcase modus-themes-links
+ ('faint '(faint))
+ ('neutral-underline '(neutral-underline))
+ ('faint-neutral-underline '(neutral-underline faint))
+ ('no-underline '(no-underline))
+ ('underline-only '(no-color))
+ ('neutral-underline-only '(no-color neutral-underline))))))
+ (list :foreground
+ (cond
+ ((memq 'no-color modus-themes-links)
+ (or neutralfg 'unspecified))
+ ((memq 'faint modus-themes-links)
+ fgfaint)
+ (fg))
+ :underline
+ (cond
+ ((memq 'no-underline modus-themes-links)
+ 'unspecified)
+ ((memq 'neutral-underline modus-themes-links)
+ (or neutralfg 'unspecified))
+ (t)))))
+
+(defun modus-themes--scale (amount)
+ "Scale heading by AMOUNT.
+AMOUNT is a customization option."
+ (when modus-themes-scale-headings
+ (list :height amount)))
+
+(defun modus-themes--region (bg fg bgsubtle bgaccent bgaccentsubtle)
+ "Apply `modus-themes-region' styles.
+
+BG and FG are the main values that are used by default. BGSUBTLE
+is a subtle background value that can be combined with all colors
+used to fontify text and code syntax. BGACCENT is a colored
+background that combines well with FG. BGACCENTSUBTLE can be
+combined with all colors used to fontify text."
+ (let ((modus-themes-region
+ (if (listp modus-themes-region)
+ modus-themes-region
+ ;; translation layer for legacy values
+ (pcase modus-themes-region
+ ('bg-only '(bg-only))
+ ('bg-only-no-extend '(bg-only no-extend))
+ ('accent '(accented))
+ ('accent-no-extend '(accented no-extend))
+ ('no-extend '(no-extend))))))
+ (list :background
+ (cond
+ ((and (memq 'accented modus-themes-region)
+ (memq 'bg-only modus-themes-region))
+ bgaccentsubtle)
+ ((memq 'accented modus-themes-region)
+ bgaccent)
+ ((memq 'bg-only modus-themes-region)
+ bgsubtle)
+ (bg))
+ :foreground
+ (cond
+ ((and (memq 'accented modus-themes-region)
+ (memq 'bg-only modus-themes-region))
+ 'unspecified)
+ ((memq 'bg-only modus-themes-region)
+ 'unspecified)
+ (fg))
+ :extend
+ (cond
+ ((memq 'no-extend modus-themes-region)
+ nil)
+ (t)))))
+
+(defun modus-themes--hl-line
+ (bgdefault bgintense bgaccent bgaccentsubtle lineneutral lineaccent lineneutralintense lineaccentintense)
+ "Apply `modus-themes-hl-line' styles.
+
+BGDEFAULT is a subtle neutral background. BGINTENSE is like the
+default, but more prominent. BGACCENT is a prominent accented
+background, while BGACCENTSUBTLE is more subtle. LINENEUTRAL and
+LINEACCENT are color values that can remain distinct against the
+buffer's possible backgrounds: the former is neutral, the latter
+is accented. LINENEUTRALINTENSE and LINEACCENTINTENSE are their
+more prominent alternatives."
+ (let ((modus-themes-hl-line
+ (if (listp modus-themes-hl-line)
+ modus-themes-hl-line
+ ;; translation layer for legacy values
+ (pcase modus-themes-hl-line
+ ('intense-background '(intense))
+ ('accented-background '(accented))
+ ('underline-neutral '(underline))
+ ('underline-accented '(underline accented))
+ ('underline-only-neutral '(underline)) ; only underline styles have been removed
+ ('underline-only-accented '(underline accented))))))
+ (list :background
+ (cond
+ ((and (memq 'intense modus-themes-hl-line)
+ (memq 'accented modus-themes-hl-line))
+ bgaccent)
+ ((memq 'accented modus-themes-hl-line)
+ bgaccentsubtle)
+ ((memq 'intense modus-themes-hl-line)
+ bgintense)
+ (bgdefault))
+ :underline
+ (cond
+ ((and (memq 'intense modus-themes-hl-line)
+ (memq 'accented modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineaccentintense)
+ ((and (memq 'accented modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineaccent)
+ ((and (memq 'intense modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineneutralintense)
+ ((or (memq 'no-background modus-themes-hl-line)
+ (memq 'underline modus-themes-hl-line))
+ lineneutral)
+ ('unspecified)))))
+
+(defun modus-themes--mail-cite (mainfg subtlefg)
+ "Combinations for `modus-themes-mail-citations'.
+
+MAINFG is an accented foreground value. SUBTLEFG is its
+desaturated counterpart."
+ (pcase modus-themes-mail-citations
+ ('monochrome (list :inherit 'shadow))
+ ('faint (list :foreground subtlefg))
+ ('desaturated (list :foreground subtlefg))
+ (_ (list :foreground mainfg))))
+
+
+
+;;;; Utilities for DIY users
+
+;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html
+(defun modus-themes-wcag-formula (hex)
+ "Get WCAG value of color value HEX.
+The value is defined in hexadecimal RGB notation, such as those in
+`modus-themes-operandi-colors' and `modus-themes-vivendi-colors'."
+ (cl-loop for k in '(0.2126 0.7152 0.0722)
+ for x in (color-name-to-rgb hex)
+ sum (* k (if (<= x 0.03928)
+ (/ x 12.92)
+ (expt (/ (+ x 0.055) 1.055) 2.4)))))
+
+;;;###autoload
+(defun modus-themes-contrast (c1 c2)
+ "Measure WCAG contrast ratio between C1 and C2.
+C1 and C2 are color values written in hexadecimal RGB."
+ (let ((ct (/ (+ (modus-themes-wcag-formula c1) 0.05)
+ (+ (modus-themes-wcag-formula c2) 0.05))))
+ (max ct (/ ct))))
+
+(defun modus-themes-current-palette ()
+ "Return current color palette."
+ (modus-themes--palette (modus-themes--current-theme)))
+
+;;;###autoload
+(defun modus-themes-color (color)
+ "Return color value for COLOR from current palette.
+COLOR is a key in `modus-themes-operandi-colors' or
+`modus-themes-vivendi-colors'."
+ (alist-get color (modus-themes-current-palette)))
+
+;;;###autoload
+(defun modus-themes-color-alts (light-color dark-color)
+ "Return color value from current palette.
+When Modus Operandi is enabled, return color value for color
+LIGHT-COLOR. When Modus Vivendi is enabled, return color value
+for DARK-COLOR. LIGHT-COLOR and DARK-COLOR are keys in
+`modus-themes-operandi-colors' or `modus-themes-vivendi-colors'."
+ (let* ((theme (modus-themes--current-theme))
+ (color (pcase theme
+ ('modus-operandi light-color)
+ ('modus-vivendi dark-color)
+ (_theme
+ (error "'%s' is not a Modus theme" theme)))))
+ (alist-get color (modus-themes--palette theme))))
+
+(defmacro modus-themes-with-colors (&rest body)
+ "Evaluate BODY with colors from current palette bound.
+For colors bound, see `modus-themes-operandi-colors' or
+`modus-themes-vivendi-colors'."
+ (declare (indent 0))
+ (let ((palette-sym (gensym))
+ (colors (mapcar #'car modus-themes-operandi-colors)))
+ `(let* ((class '((class color) (min-colors 89)))
+ (,palette-sym (modus-themes-current-palette))
+ ,@(mapcar (lambda (color)
+ (list color `(alist-get ',color ,palette-sym)))
+ colors))
+ (ignore class ,@colors) ; Silence unused variable warnings
+ ,@body)))
+
+
+
+;;;; Commands
+
+;;;###autoload
+(defun modus-themes-load-themes ()
+ "Ensure that the Modus themes are in `custom-enabled-themes'.
+
+This function is intended for use in package declarations such as
+those defined with the help of `use-package'. The idea is to add
+this function to the `:init' stage of the package's loading, so
+that subsequent calls that assume the presence of a loaded theme,
+like `modus-themes-toggle' or `modus-themes-load-operandi', will
+continue to work as intended even if they are lazy-loaded (such
+as when they are declared in the `:config' phase)."
+ (unless (or (custom-theme-p 'modus-operandi)
+ (custom-theme-p 'modus-vivendi))
+ (load-theme 'modus-operandi t t)
+ (load-theme 'modus-vivendi t t)))
+
+(defvar modus-themes-after-load-theme-hook nil
+ "Hook that runs after the `modus-themes-toggle' routines.")
+
+;; The reason we use `load-theme' instead of `enable-theme' is that the
+;; former does a kind of "reset" on the face specs. So it plays nicely
+;; with `custom-set-faces', as well as defcustom user customizations,
+;; including the likes of `modus-themes-operandi-color-overrides'.
+;;
+;; Tests show that `enable-theme' does not re-read those variables, so
+;; it might appear to the unsuspecting user that the themes are somehow
+;; broken.
+;;
+;; This "reset", however, comes at the cost of being a bit slower than
+;; `enable-theme'. User who have a stable setup and seldom update their
+;; variables during a given Emacs session, are better off using
+;; something like this:
+;;
+;; (defun modus-themes-toggle-enabled ()
+;; "Toggle between `modus-operandi' and `modus-vivendi' themes."
+;; (interactive)
+;; (pcase (modus-themes--current-theme)
+;; ('modus-operandi (progn (enable-theme 'modus-vivendi)
+;; (disable-theme 'modus-operandi)))
+;; ('modus-vivendi (progn (enable-theme 'modus-operandi)
+;; (disable-theme 'modus-vivendi)))
+;; (_ (error "No Modus theme is loaded; evaluate `modus-themes-load-themes' first"))))
+
+;;;###autoload
+(defun modus-themes-load-operandi ()
+ "Load `modus-operandi' and disable `modus-vivendi'.
+Also run `modus-themes-after-load-theme-hook'."
+ (disable-theme 'modus-vivendi)
+ (load-theme 'modus-operandi t)
+ (run-hooks 'modus-themes-after-load-theme-hook))
+
+;;;###autoload
+(defun modus-themes-load-vivendi ()
+ "Load `modus-vivendi' and disable `modus-operandi'.
+Also run `modus-themes-after-load-theme-hook'."
+ (disable-theme 'modus-operandi)
+ (load-theme 'modus-vivendi t)
+ (run-hooks 'modus-themes-after-load-theme-hook))
+
+(defun modus-themes--load-prompt ()
+ "Helper for `modus-themes-toggle'."
+ (let ((theme
+ (intern
+ (completing-read "Load Modus theme (will disable all others): "
+ '(modus-operandi modus-vivendi) nil t))))
+ (mapc #'disable-theme custom-enabled-themes)
+ (pcase theme
+ ('modus-operandi (modus-themes-load-operandi))
+ ('modus-vivendi (modus-themes-load-vivendi)))))
+
+;;;###autoload
+(defun modus-themes-toggle ()
+ "Toggle between `modus-operandi' and `modus-vivendi' themes.
+Also runs `modus-themes-after-load-theme-hook' at its last stage
+by virtue of calling either of `modus-themes-load-operandi' and
+`modus-themes-load-vivendi' functions."
+ (interactive)
+ (modus-themes-load-themes)
+ (pcase (modus-themes--current-theme)
+ ('modus-operandi (modus-themes-load-vivendi))
+ ('modus-vivendi (modus-themes-load-operandi))
+ (_ (modus-themes--load-prompt))))
+
+
+
+;;;; Face specifications
+
+(defconst modus-themes-faces
+ '(
+;;;; custom faces
+ ;; these bespoke faces are inherited by other constructs below
+;;;;; subtle colored backgrounds
+ `(modus-themes-subtle-red ((,class :background ,red-subtle-bg :foreground ,fg-dim)))
+ `(modus-themes-subtle-green ((,class :background ,green-subtle-bg :foreground ,fg-dim)))
+ `(modus-themes-subtle-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-dim)))
+ `(modus-themes-subtle-blue ((,class :background ,blue-subtle-bg :foreground ,fg-dim)))
+ `(modus-themes-subtle-magenta ((,class :background ,magenta-subtle-bg :foreground ,fg-dim)))
+ `(modus-themes-subtle-cyan ((,class :background ,cyan-subtle-bg :foreground ,fg-dim)))
+ `(modus-themes-subtle-neutral ((,class :background ,bg-inactive :foreground ,fg-inactive)))
+;;;;; intense colored backgrounds
+ `(modus-themes-intense-red ((,class :background ,red-intense-bg :foreground ,fg-main)))
+ `(modus-themes-intense-green ((,class :background ,green-intense-bg :foreground ,fg-main)))
+ `(modus-themes-intense-yellow ((,class :background ,yellow-intense-bg :foreground ,fg-main)))
+ `(modus-themes-intense-blue ((,class :background ,blue-intense-bg :foreground ,fg-main)))
+ `(modus-themes-intense-magenta ((,class :background ,magenta-intense-bg :foreground ,fg-main)))
+ `(modus-themes-intense-cyan ((,class :background ,cyan-intense-bg :foreground ,fg-main)))
+ `(modus-themes-intense-neutral ((,class :background ,bg-active :foreground ,fg-main)))
+;;;;; refined background and foreground combinations
+ ;; general purpose styles that use an accented foreground against an
+ ;; accented background
+ `(modus-themes-refine-red ((,class :background ,red-refine-bg :foreground ,red-refine-fg)))
+ `(modus-themes-refine-green ((,class :background ,green-refine-bg :foreground ,green-refine-fg)))
+ `(modus-themes-refine-yellow ((,class :background ,yellow-refine-bg :foreground ,yellow-refine-fg)))
+ `(modus-themes-refine-blue ((,class :background ,blue-refine-bg :foreground ,blue-refine-fg)))
+ `(modus-themes-refine-magenta ((,class :background ,magenta-refine-bg :foreground ,magenta-refine-fg)))
+ `(modus-themes-refine-cyan ((,class :background ,cyan-refine-bg :foreground ,cyan-refine-fg)))
+;;;;; "active" combinations, mostly for use on the mode line
+ `(modus-themes-active-red ((,class :background ,red-active :foreground ,bg-active)))
+ `(modus-themes-active-green ((,class :background ,green-active :foreground ,bg-active)))
+ `(modus-themes-active-yellow ((,class :background ,yellow-active :foreground ,bg-active)))
+ `(modus-themes-active-blue ((,class :background ,blue-active :foreground ,bg-active)))
+ `(modus-themes-active-magenta ((,class :background ,magenta-active :foreground ,bg-active)))
+ `(modus-themes-active-cyan ((,class :background ,cyan-active :foreground ,bg-active)))
+;;;;; nuanced backgrounds
+ ;; useful for adding an accented background that is suitable for all
+ ;; main foreground colors (intended for use in Org source blocks)
+ `(modus-themes-nuanced-red ((,class :background ,red-nuanced-bg :extend t)))
+ `(modus-themes-nuanced-green ((,class :background ,green-nuanced-bg :extend t)))
+ `(modus-themes-nuanced-yellow ((,class :background ,yellow-nuanced-bg :extend t)))
+ `(modus-themes-nuanced-blue ((,class :background ,blue-nuanced-bg :extend t)))
+ `(modus-themes-nuanced-magenta ((,class :background ,magenta-nuanced-bg :extend t)))
+ `(modus-themes-nuanced-cyan ((,class :background ,cyan-nuanced-bg :extend t)))
+;;;;; fringe-specific combinations
+ `(modus-themes-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-main)))
+ `(modus-themes-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-main)))
+ `(modus-themes-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-main)))
+ `(modus-themes-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-main)))
+ `(modus-themes-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-main)))
+ `(modus-themes-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-main)))
+;;;;; special base values
+ ;; these are closer to the grayscale than the accents defined above
+ ;; and should only be used when the next closest alternative would be
+ ;; a grayscale value than an accented one
+ `(modus-themes-special-cold ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
+ `(modus-themes-special-mild ((,class :background ,bg-special-mild :foreground ,fg-special-mild)))
+ `(modus-themes-special-warm ((,class :background ,bg-special-warm :foreground ,fg-special-warm)))
+ `(modus-themes-special-calm ((,class :background ,bg-special-calm :foreground ,fg-special-calm)))
+;;;;; diff-specific combinations
+ ;; intended for `diff-mode' or equivalent
+ `(modus-themes-diff-added
+ ((,class ,@(modus-themes--diff
+ bg-main blue-alt-other
+ bg-diff-focus-added fg-diff-focus-added
+ green-nuanced-bg fg-diff-added
+ bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran))))
+ `(modus-themes-diff-changed
+ ((,class ,@(modus-themes--diff
+ bg-main yellow
+ bg-diff-focus-changed fg-diff-focus-changed
+ yellow-nuanced-bg fg-diff-changed))))
+ `(modus-themes-diff-removed
+ ((,class ,@(modus-themes--diff
+ bg-main red
+ bg-diff-focus-removed fg-diff-focus-removed
+ red-nuanced-bg fg-diff-removed))))
+ `(modus-themes-diff-refine-added
+ ((,class ,@(modus-themes--diff
+ bg-diff-added-deuteran fg-diff-added-deuteran
+ bg-diff-refine-added fg-diff-refine-added
+ bg-diff-focus-added fg-diff-focus-added
+ bg-diff-refine-added-deuteran fg-diff-refine-added-deuteran))))
+ `(modus-themes-diff-refine-changed
+ ((,class ,@(modus-themes--diff
+ bg-diff-changed fg-diff-changed
+ bg-diff-refine-changed fg-diff-refine-changed
+ bg-diff-focus-changed fg-diff-focus-changed))))
+ `(modus-themes-diff-refine-removed
+ ((,class ,@(modus-themes--diff
+ bg-diff-removed fg-diff-removed
+ bg-diff-refine-removed fg-diff-refine-removed
+ bg-diff-focus-removed fg-diff-focus-removed))))
+ `(modus-themes-diff-focus-added
+ ((,class ,@(modus-themes--diff
+ bg-dim blue-alt-other
+ bg-diff-focus-added fg-diff-focus-added
+ bg-diff-added fg-diff-added
+ bg-diff-focus-added-deuteran fg-diff-focus-added-deuteran))))
+ `(modus-themes-diff-focus-changed
+ ((,class ,@(modus-themes--diff
+ bg-dim yellow
+ bg-diff-focus-changed fg-diff-focus-changed
+ bg-diff-changed fg-diff-changed))))
+ `(modus-themes-diff-focus-removed
+ ((,class ,@(modus-themes--diff
+ bg-dim red
+ bg-diff-focus-removed fg-diff-focus-removed
+ bg-diff-removed fg-diff-removed))))
+ `(modus-themes-diff-heading
+ ((,class ,@(modus-themes--diff
+ bg-alt fg-main
+ bg-diff-heading fg-diff-heading
+ cyan-nuanced-bg cyan-nuanced-fg
+ bg-header fg-main
+ t))))
+;;;;; mark indicators
+ ;; color combinations intended for Dired, Ibuffer, or equivalent
+ `(modus-themes-pseudo-header ((,class :inherit bold :foreground ,fg-main)))
+ `(modus-themes-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt)))
+ `(modus-themes-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del)))
+ `(modus-themes-mark-sel ((,class :inherit bold :background ,bg-mark-sel :foreground ,fg-mark-sel)))
+ `(modus-themes-mark-symbol ((,class :inherit bold :foreground ,blue-alt)))
+;;;;; heading levels
+ ;; styles for regular headings used in Org, Markdown, Info, etc.
+ `(modus-themes-heading-1
+ ((,class ,@(modus-themes--heading
+ 1 fg-main magenta-alt-other
+ magenta-nuanced-bg bg-alt bg-region)
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(modus-themes-heading-2
+ ((,class ,@(modus-themes--heading
+ 2 fg-special-warm magenta-alt
+ red-nuanced-bg bg-alt bg-region)
+ ,@(modus-themes--scale modus-themes-scale-3))))
+ `(modus-themes-heading-3
+ ((,class ,@(modus-themes--heading
+ 3 fg-special-cold blue
+ blue-nuanced-bg bg-alt bg-region)
+ ,@(modus-themes--scale modus-themes-scale-2))))
+ `(modus-themes-heading-4
+ ((,class ,@(modus-themes--heading
+ 4 fg-special-mild cyan
+ cyan-nuanced-bg bg-alt bg-region)
+ ,@(modus-themes--scale modus-themes-scale-1))))
+ `(modus-themes-heading-5
+ ((,class ,@(modus-themes--heading
+ 5 fg-special-calm green-alt-other
+ green-nuanced-bg bg-alt bg-region))))
+ `(modus-themes-heading-6
+ ((,class ,@(modus-themes--heading
+ 6 yellow-nuanced-fg yellow-alt-other
+ yellow-nuanced-bg bg-alt bg-region))))
+ `(modus-themes-heading-7
+ ((,class ,@(modus-themes--heading
+ 7 red-nuanced-fg red-alt
+ red-nuanced-bg bg-alt bg-region))))
+ `(modus-themes-heading-8
+ ((,class ,@(modus-themes--heading
+ 8 magenta-nuanced-fg magenta
+ bg-alt bg-alt bg-region))))
+;;;;; graph-specific faces
+ `(modus-themes-graph-red-0 ((,class :background ,red-graph-0-bg)))
+ `(modus-themes-graph-red-1 ((,class :background ,red-graph-1-bg)))
+ `(modus-themes-graph-green-0 ((,class :background ,green-graph-0-bg)))
+ `(modus-themes-graph-green-1 ((,class :background ,green-graph-1-bg)))
+ `(modus-themes-graph-yellow-0 ((,class :background ,yellow-graph-0-bg)))
+ `(modus-themes-graph-yellow-1 ((,class :background ,yellow-graph-1-bg)))
+ `(modus-themes-graph-blue-0 ((,class :background ,blue-graph-0-bg)))
+ `(modus-themes-graph-blue-1 ((,class :background ,blue-graph-1-bg)))
+ `(modus-themes-graph-magenta-0 ((,class :background ,magenta-graph-0-bg)))
+ `(modus-themes-graph-magenta-1 ((,class :background ,magenta-graph-1-bg)))
+ `(modus-themes-graph-cyan-0 ((,class :background ,cyan-graph-0-bg)))
+ `(modus-themes-graph-cyan-1 ((,class :background ,cyan-graph-1-bg)))
+;;;;; language checkers
+ `(modus-themes-lang-error ((,class ,@(modus-themes--lang-check
+ fg-lang-underline-error fg-lang-error
+ red red-refine-fg red-nuanced-bg red-refine-bg))))
+ `(modus-themes-lang-note ((,class ,@(modus-themes--lang-check
+ fg-lang-underline-note fg-lang-note
+ blue-alt blue-refine-fg blue-nuanced-bg blue-refine-bg))))
+ `(modus-themes-lang-warning ((,class ,@(modus-themes--lang-check
+ fg-lang-underline-warning fg-lang-warning
+ yellow yellow-refine-fg yellow-nuanced-bg yellow-refine-bg))))
+;;;;; other custom faces
+ `(modus-themes-bold ((,class ,@(modus-themes--bold-weight))))
+ `(modus-themes-hl-line ((,class ,@(modus-themes--hl-line
+ bg-hl-line bg-hl-line-intense
+ bg-hl-line-intense-accent blue-nuanced-bg
+ bg-region blue-intense-bg
+ fg-alt cyan-intense)
+ :extend t)))
+ `(modus-themes-key-binding ((,class :inherit bold :foreground ,blue-alt-other)))
+ `(modus-themes-prompt ((,class ,@(modus-themes--prompt
+ cyan-alt-other blue-alt-other fg-alt
+ cyan-nuanced-bg blue-refine-bg fg-main
+ bg-alt bg-active))))
+ `(modus-themes-reset-hard ((,class :inherit (fixed-pitch modus-themes-reset-soft))))
+ `(modus-themes-reset-soft ((,class :background ,bg-main :foreground ,fg-main
+ :weight normal :slant normal :strike-through nil
+ :box nil :underline nil :overline nil :extend nil)))
+ `(modus-themes-search-success ((,class :inherit ,@(modus-themes--success-deuteran
+ 'modus-themes-intense-blue
+ 'modus-themes-intense-green))))
+ `(modus-themes-search-success-lazy ((,class :inherit ,@(modus-themes--success-deuteran
+ 'modus-themes-special-mild
+ 'modus-themes-refine-cyan))))
+ `(modus-themes-search-success-modeline ((,class :foreground ,@(modus-themes--success-deuteran
+ blue-active
+ green-active))))
+ `(modus-themes-slant ((,class :inherit italic :slant ,@(modus-themes--slant))))
+ `(modus-themes-variable-pitch ((,class ,@(modus-themes--variable-pitch))))
+ `(modus-themes-fixed-pitch ((,class ,@(modus-themes--fixed-pitch))))
+;;;; standard faces
+;;;;; absolute essentials
+ `(default ((,class :background ,bg-main :foreground ,fg-main)))
+ `(cursor ((,class :background ,fg-main)))
+ `(fringe ((,class ,@(modus-themes--fringe bg-main bg-inactive bg-active)
+ :foreground ,fg-main)))
+ `(vertical-border ((,class :foreground ,fg-window-divider-inner)))
+;;;;; basic and/or ungrouped styles
+ `(bold ((,class :weight bold)))
+ `(bold-italic ((,class :inherit (bold italic))))
+ `(buffer-menu-buffer ((,class :inherit bold)))
+ `(comint-highlight-input ((,class :inherit bold)))
+ `(comint-highlight-prompt ((,class :inherit modus-themes-prompt)))
+ `(error ((,class :inherit bold :foreground ,red)))
+ `(escape-glyph ((,class :foreground ,fg-escape-char-construct)))
+ `(file-name-shadow ((,class :foreground ,fg-unfocused)))
+ `(header-line ((,class ,@(modus-themes--variable-pitch-ui)
+ :background ,bg-header :foreground ,fg-header)))
+ `(header-line-highlight ((,class :inherit modus-themes-active-blue)))
+ `(help-argument-name ((,class :inherit modus-themes-slant :foreground ,cyan)))
+ `(help-key-binding ((,class :box (:line-width (1 . -1) :color ,bg-region) ; NOTE: box syntax is for Emacs28
+ :background ,bg-inactive)))
+ `(homoglyph ((,class :foreground ,red-alt-faint)))
+ `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other-faint)))
+ `(italic ((,class :slant italic)))
+ `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct)))
+ `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t)))
+ `(minibuffer-prompt ((,class :inherit modus-themes-prompt)))
+ `(mm-command-output ((,class :foreground ,red-alt-other)))
+ `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild)))
+ `(next-error ((,class :inherit modus-themes-subtle-red :extend t)))
+ `(rectangle-preview ((,class :inherit modus-themes-special-mild)))
+ `(region ((,class ,@(modus-themes--region bg-region fg-main
+ bg-hl-alt-intense bg-region-accent
+ bg-region-accent-subtle))))
+ `(secondary-selection ((,class :inherit modus-themes-special-cold)))
+ `(shadow ((,class :foreground ,fg-alt)))
+ `(success ((,class :inherit bold :foreground ,@(modus-themes--success-deuteran blue green))))
+ `(trailing-whitespace ((,class :background ,red-intense-bg)))
+ `(warning ((,class :inherit bold :foreground ,yellow)))
+;;;;; buttons, links, widgets
+ `(button ((,class ,@(modus-themes--link
+ blue-alt-other blue-alt-other-faint
+ bg-region blue-nuanced-bg bg-alt))))
+ `(link ((,class :inherit button)))
+ `(link-visited ((,class :inherit button
+ ,@(modus-themes--link-color
+ magenta-alt-other magenta-alt-other-faint fg-alt))))
+ `(tooltip ((,class :background ,bg-special-cold :foreground ,fg-main)))
+ `(widget-button ((,class :inherit bold :foreground ,blue-alt)))
+ `(widget-button-pressed ((,class :inherit widget-button :foreground ,magenta)))
+ `(widget-documentation ((,class :foreground ,green)))
+ `(widget-field ((,class :background ,bg-alt :foreground ,fg-dim)))
+ `(widget-inactive ((,class :foreground ,fg-alt)))
+ `(widget-single-line-field ((,class :inherit widget-field)))
+;;;;; ag
+ `(ag-hit-face ((,class :foreground ,fg-special-cold)))
+ `(ag-match-face ((,class :inherit modus-themes-special-calm)))
+;;;;; alert
+ `(alert-high-face ((,class :inherit bold :foreground ,red-alt)))
+ `(alert-low-face ((,class :foreground ,fg-special-mild)))
+ `(alert-moderate-face ((,class :inherit bold :foreground ,yellow)))
+ `(alert-trivial-face ((,class :foreground ,fg-special-calm)))
+ `(alert-urgent-face ((,class :inherit bold :foreground ,red-intense)))
+;;;;; all-the-icons
+ `(all-the-icons-blue ((,class :foreground ,blue)))
+ `(all-the-icons-blue-alt ((,class :foreground ,blue-alt)))
+ `(all-the-icons-cyan ((,class :foreground ,cyan)))
+ `(all-the-icons-cyan-alt ((,class :foreground ,cyan-alt)))
+ `(all-the-icons-dblue ((,class :foreground ,blue-alt-other)))
+ `(all-the-icons-dcyan ((,class :foreground ,cyan-alt-other)))
+ `(all-the-icons-dgreen ((,class :foreground ,green-alt-other)))
+ `(all-the-icons-dired-dir-face ((,class :foreground ,blue)))
+ `(all-the-icons-dmaroon ((,class :foreground ,magenta-alt-other)))
+ `(all-the-icons-dorange ((,class :foreground ,red-alt-other)))
+ `(all-the-icons-dpink ((,class :foreground ,magenta)))
+ `(all-the-icons-dpurple ((,class :foreground ,magenta-alt)))
+ `(all-the-icons-dred ((,class :foreground ,red)))
+ `(all-the-icons-dsilver ((,class :foreground ,fg-special-cold)))
+ `(all-the-icons-dyellow ((,class :foreground ,yellow)))
+ `(all-the-icons-green ((,class :foreground ,green)))
+ `(all-the-icons-lblue ((,class :foreground ,blue-refine-fg)))
+ `(all-the-icons-lcyan ((,class :foreground ,cyan-refine-fg)))
+ `(all-the-icons-lgreen ((,class :foreground ,green-refine-fg)))
+ `(all-the-icons-lmaroon ((,class :foreground ,magenta-refine-fg)))
+ `(all-the-icons-lorange ((,class :foreground ,red-refine-fg)))
+ `(all-the-icons-lpink ((,class :foreground ,magenta-refine-fg)))
+ `(all-the-icons-lpurple ((,class :foreground ,magenta-refine-fg)))
+ `(all-the-icons-lred ((,class :foreground ,red-refine-fg)))
+ `(all-the-icons-lsilver ((,class :foreground ,fg-special-cold)))
+ `(all-the-icons-lyellow ((,class :foreground ,yellow-refine-fg)))
+ `(all-the-icons-maroon ((,class :foreground ,magenta)))
+ `(all-the-icons-orange ((,class :foreground ,red-alt)))
+ `(all-the-icons-pink ((,class :foreground ,magenta)))
+ `(all-the-icons-purple ((,class :foreground ,magenta-alt)))
+ `(all-the-icons-purple-alt ((,class :foreground ,magenta-alt-other)))
+ `(all-the-icons-red ((,class :foreground ,red)))
+ `(all-the-icons-red-alt ((,class :foreground ,red-alt)))
+ `(all-the-icons-silver ((,class :foreground ,fg-special-cold)))
+ `(all-the-icons-yellow ((,class :foreground ,yellow)))
+;;;;; annotate
+ `(annotate-annotation ((,class :inherit modus-themes-subtle-blue)))
+ `(annotate-annotation-secondary ((,class :inherit modus-themes-subtle-green)))
+ `(annotate-highlight ((,class :background ,blue-nuanced-bg :underline ,blue-intense)))
+ `(annotate-highlight-secondary ((,class :background ,green-nuanced-bg :underline ,green-intense)))
+;;;;; anzu
+ `(anzu-match-1 ((,class :inherit modus-themes-subtle-cyan)))
+ `(anzu-match-2 ((,class :inherit modus-themes-search-success)))
+ `(anzu-match-3 ((,class :inherit modus-themes-subtle-yellow)))
+ `(anzu-mode-line ((,class :inherit (bold modus-themes-search-success-modeline))))
+ `(anzu-mode-line-no-match ((,class :inherit bold :foreground ,red-active)))
+ `(anzu-replace-highlight ((,class :inherit modus-themes-refine-yellow :underline t)))
+ `(anzu-replace-to ((,class :inherit (modus-themes-search-success bold))))
+;;;;; apropos
+ `(apropos-button ((,class :inherit button
+ ,@(modus-themes--link-color
+ magenta-alt-other magenta-alt-other-faint))))
+ `(apropos-function-button ((,class :inherit button
+ ,@(modus-themes--link-color
+ magenta magenta-faint))))
+ `(apropos-keybinding ((,class :inherit modus-themes-key-binding)))
+ `(apropos-misc-button ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan-alt-other cyan-alt-other-faint))))
+ `(apropos-property ((,class :inherit modus-themes-bold :foreground ,magenta-alt)))
+ `(apropos-symbol ((,class :inherit modus-themes-pseudo-header)))
+ `(apropos-user-option-button ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan cyan-faint))))
+ `(apropos-variable-button ((,class :inherit button
+ ,@(modus-themes--link-color
+ blue-alt blue-alt-faint))))
+;;;;; apt-sources-list
+ `(apt-sources-list-components ((,class :foreground ,cyan)))
+ `(apt-sources-list-options ((,class :foreground ,yellow)))
+ `(apt-sources-list-suite ((,class :foreground ,green)))
+ `(apt-sources-list-type ((,class :foreground ,magenta)))
+ `(apt-sources-list-uri ((,class :foreground ,blue)))
+;;;;; artbollocks-mode
+ `(artbollocks-face ((,class :inherit modus-themes-lang-note)))
+ `(artbollocks-lexical-illusions-face ((,class :background ,bg-alt :foreground ,red-alt :underline t)))
+ `(artbollocks-passive-voice-face ((,class :inherit modus-themes-lang-warning)))
+ `(artbollocks-weasel-words-face ((,class :inherit modus-themes-lang-error)))
+;;;;; auctex and Tex
+ `(font-latex-bold-face ((,class :inherit bold :foreground ,fg-special-calm)))
+ `(font-latex-doctex-documentation-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(font-latex-doctex-preprocessor-face ((,class :inherit modus-themes-bold :foreground ,red-alt-other)))
+ `(font-latex-italic-face ((,class :inherit italic :foreground ,fg-special-calm)))
+ `(font-latex-math-face ((,class :foreground ,cyan-alt-other)))
+ `(font-latex-script-char-face ((,class :foreground ,cyan-alt-other)))
+ `(font-latex-sectioning-0-face ((,class :inherit modus-themes-variable-pitch :foreground ,blue-nuanced-fg)))
+ `(font-latex-sectioning-1-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,blue-nuanced-fg)))
+ `(font-latex-sectioning-2-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,blue-nuanced-fg)))
+ `(font-latex-sectioning-3-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,blue-nuanced-fg)))
+ `(font-latex-sectioning-4-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,blue-nuanced-fg)))
+ `(font-latex-sectioning-5-face ((,class :inherit modus-themes-variable-pitch :foreground ,blue-nuanced-fg)))
+ `(font-latex-sedate-face ((,class :inherit modus-themes-bold :foreground ,magenta-alt-other)))
+ `(font-latex-slide-title-face ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,cyan-nuanced-fg
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(font-latex-string-face ((,class :inherit font-lock-string-face)))
+ `(font-latex-subscript-face ((,class :height 0.95)))
+ `(font-latex-superscript-face ((,class :height 0.95)))
+ `(font-latex-verbatim-face ((,class :background ,bg-dim :foreground ,fg-special-mild)))
+ `(font-latex-warning-face ((,class :inherit font-lock-warning-face)))
+ `(tex-match ((,class :foreground ,blue-alt-other)))
+ `(tex-verbatim ((,class :background ,bg-dim :foreground ,fg-special-mild)))
+ `(texinfo-heading ((,class :foreground ,magenta)))
+ `(TeX-error-description-error ((,class :inherit error)))
+ `(TeX-error-description-help ((,class :foreground ,blue)))
+ `(TeX-error-description-tex-said ((,class :foreground ,blue)))
+ `(TeX-error-description-warning ((,class :inherit warning)))
+;;;;; auto-dim-other-buffers
+ `(auto-dim-other-buffers-face ((,class :background ,bg-alt)))
+;;;;; avy
+ `(avy-background-face ((,class :background ,bg-dim :foreground ,fg-dim :extend t)))
+ `(avy-goto-char-timer-face ((,class :inherit (modus-themes-intense-yellow bold))))
+ `(avy-lead-face ((,class :inherit (modus-themes-intense-magenta bold modus-themes-reset-soft))))
+ `(avy-lead-face-0 ((,class :inherit (modus-themes-refine-cyan bold modus-themes-reset-soft))))
+ `(avy-lead-face-1 ((,class :inherit (modus-themes-intense-neutral bold modus-themes-reset-soft))))
+ `(avy-lead-face-2 ((,class :inherit (modus-themes-refine-red bold modus-themes-reset-soft))))
+;;;;; aw (ace-window)
+ `(aw-background-face ((,class :foreground ,fg-unfocused)))
+ `(aw-key-face ((,class :inherit modus-themes-key-binding)))
+ `(aw-leading-char-face ((,class :inherit (bold modus-themes-reset-soft) :height 1.5
+ :foreground ,red-intense)))
+ `(aw-minibuffer-leading-char-face ((,class :inherit (modus-themes-intense-red bold))))
+ `(aw-mode-line-face ((,class :inherit bold)))
+;;;;; awesome-tray
+ `(awesome-tray-module-awesome-tab-face ((,class :inherit bold :foreground ,red-alt-other)))
+ `(awesome-tray-module-battery-face ((,class :inherit bold :foreground ,cyan-alt-other)))
+ `(awesome-tray-module-buffer-name-face ((,class :inherit bold :foreground ,yellow-alt-other)))
+ `(awesome-tray-module-circe-face ((,class :inherit bold :foreground ,blue-alt)))
+ `(awesome-tray-module-date-face ((,class :inherit bold :foreground ,fg-dim)))
+ `(awesome-tray-module-evil-face ((,class :inherit bold :foreground ,green-alt)))
+ `(awesome-tray-module-git-face ((,class :inherit bold :foreground ,magenta)))
+ `(awesome-tray-module-last-command-face ((,class :inherit bold :foreground ,blue-alt-other)))
+ `(awesome-tray-module-location-face ((,class :inherit bold :foreground ,yellow)))
+ `(awesome-tray-module-mode-name-face ((,class :inherit bold :foreground ,green)))
+ `(awesome-tray-module-parent-dir-face ((,class :inherit bold :foreground ,cyan)))
+ `(awesome-tray-module-rvm-face ((,class :inherit bold :foreground ,magenta-alt-other)))
+;;;;; bbdb
+ `(bbdb-name ((,class :foreground ,magenta-alt-other)))
+ `(bbdb-organization ((,class :foreground ,red-alt-other)))
+ `(bbdb-field-name ((,class :foreground ,cyan-alt-other)))
+;;;;; binder
+ `(binder-sidebar-highlight ((,class :inherit modus-themes-subtle-cyan)))
+ `(binder-sidebar-marked ((,class :inherit modus-themes-mark-sel)))
+ `(binder-sidebar-missing ((,class :inherit modus-themes-subtle-red)))
+ `(binder-sidebar-tags ((,class :foreground ,cyan)))
+;;;;; bm
+ `(bm-face ((,class :inherit modus-themes-subtle-yellow :extend t)))
+ `(bm-fringe-face ((,class :inherit modus-themes-fringe-yellow)))
+ `(bm-fringe-persistent-face ((,class :inherit modus-themes-fringe-blue)))
+ `(bm-persistent-face ((,class :inherit modus-themes-intense-blue :extend t)))
+;;;;; bongo
+ `(bongo-album-title ((,class :foreground ,fg-active)))
+ `(bongo-artist ((,class :foreground ,magenta-active)))
+ `(bongo-currently-playing-track ((,class :inherit bold)))
+ `(bongo-elapsed-track-part ((,class :inherit modus-themes-subtle-magenta :underline t)))
+ `(bongo-filled-seek-bar ((,class :background ,blue-intense-bg :foreground ,fg-main)))
+ `(bongo-marked-track ((,class :foreground ,fg-mark-alt)))
+ `(bongo-marked-track-line ((,class :background ,bg-mark-alt)))
+ `(bongo-played-track ((,class :foreground ,fg-unfocused :strike-through t)))
+ `(bongo-track-length ((,class :foreground ,fg-alt)))
+ `(bongo-track-title ((,class :foreground ,blue-active)))
+ `(bongo-unfilled-seek-bar ((,class :background ,bg-special-cold :foreground ,fg-main)))
+;;;;; boon
+ `(boon-modeline-cmd ((,class :inherit modus-themes-active-blue)))
+ `(boon-modeline-ins ((,class :inherit modus-themes-active-red)))
+ `(boon-modeline-off ((,class :inherit modus-themes-active-yellow)))
+ `(boon-modeline-spc ((,class :inherit modus-themes-active-green)))
+;;;;; bookmark
+ `(bookmark-face ((,class :inherit modus-themes-special-warm :extend t)))
+;;;;; breakpoint (built-in gdb-mi.el)
+ `(breakpoint-disabled ((,class :inherit shadow)))
+ `(breakpoint-enabled ((,class :inherit bold :foreground ,red)))
+;;;;; buffer-expose
+ `(buffer-expose-ace-char-face ((,class :inherit bold :foreground ,red-active)))
+ `(buffer-expose-mode-line-face ((,class :foreground ,cyan-active)))
+ `(buffer-expose-selected-face ((,class :inherit modus-themes-special-mild)))
+;;;;; calendar and diary
+ `(calendar-month-header ((,class :inherit modus-themes-pseudo-header)))
+ `(calendar-today ((,class :inherit bold :underline t)))
+ `(calendar-weekday-header ((,class :foreground ,fg-unfocused)))
+ `(calendar-weekend-header ((,class :foreground ,red-faint)))
+ `(diary ((,class :background ,blue-nuanced-bg :foreground ,blue-alt-other)))
+ `(diary-anniversary ((,class :foreground ,red-alt-other)))
+ `(diary-time ((,class :foreground ,cyan)))
+ `(holiday ((,class :background ,magenta-nuanced-bg :foreground ,magenta-alt)))
+;;;;; calfw
+ `(cfw:face-annotation ((,class :foreground ,fg-special-warm)))
+ `(cfw:face-day-title ((,class :foreground ,fg-main)))
+ `(cfw:face-default-content ((,class :foreground ,green-alt)))
+ `(cfw:face-default-day ((,class :inherit (cfw:face-day-title bold))))
+ `(cfw:face-disable ((,class :foreground ,fg-unfocused)))
+ `(cfw:face-grid ((,class :foreground ,fg-window-divider-outer)))
+ `(cfw:face-header ((,class :inherit bold :foreground ,fg-main)))
+ `(cfw:face-holiday ((,class :foreground ,magenta-alt-other)))
+ `(cfw:face-periods ((,class :foreground ,cyan-alt-other)))
+ `(cfw:face-saturday ((,class :inherit bold :foreground ,cyan-alt-other)))
+ `(cfw:face-select ((,class :inherit modus-themes-intense-blue)))
+ `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other)))
+ `(cfw:face-title ((,class :inherit modus-themes-variable-pitch
+ :foreground ,fg-special-cold
+ ,@(modus-themes--scale modus-themes-scale-title))))
+ `(cfw:face-today ((,class :background ,bg-inactive)))
+ `(cfw:face-today-title ((,class :background ,bg-active)))
+ `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt)))
+ `(cfw:face-toolbar-button-off ((,class :inherit shadow)))
+ `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg
+ :foreground ,blue-alt)))
+;;;;; centaur-tabs
+ `(centaur-tabs-active-bar-face ((,class :background ,blue-active)))
+ `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t)))
+ `(centaur-tabs-close-selected ((,class :inherit centaur-tabs-selected)))
+ `(centaur-tabs-close-unselected ((,class :inherit centaur-tabs-unselected)))
+ `(centaur-tabs-modified-marker-selected ((,class :inherit centaur-tabs-selected)))
+ `(centaur-tabs-modified-marker-unselected ((,class :inherit centaur-tabs-unselected)))
+ `(centaur-tabs-default ((,class :background ,bg-main :foreground ,bg-main)))
+ `(centaur-tabs-selected ((,class :inherit bold :background ,bg-tab-active :foreground ,fg-main)))
+ `(centaur-tabs-selected-modified ((,class :inherit italic :background ,bg-tab-active :foreground ,fg-main)))
+ `(centaur-tabs-unselected ((,class :background ,bg-tab-inactive :foreground ,fg-dim)))
+ `(centaur-tabs-unselected-modified ((,class :inherit italic :background ,bg-tab-inactive :foreground ,fg-dim)))
+;;;;; cfrs
+ `(cfrs-border-color ((,class :background ,fg-window-divider-inner)))
+;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
+ `(change-log-acknowledgment ((,class :foreground ,fg-alt)))
+ `(change-log-conditionals ((,class :foreground ,yellow)))
+ `(change-log-date ((,class :foreground ,cyan)))
+ `(change-log-email ((,class :foreground ,cyan-alt-other)))
+ `(change-log-file ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(change-log-function ((,class :foreground ,green-alt-other)))
+ `(change-log-list ((,class :foreground ,magenta-alt)))
+ `(change-log-name ((,class :foreground ,magenta-alt-other)))
+ `(log-edit-header ((,class :foreground ,fg-special-warm)))
+ `(log-edit-summary ((,class :inherit bold :foreground ,blue)))
+ `(log-edit-unknown-header ((,class :inherit shadow)))
+ `(log-view-commit-body ((,class :foreground ,blue-nuanced-fg)))
+ `(log-view-file ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(log-view-message ((,class :background ,bg-alt :foreground ,fg-alt)))
+;;;;; cider
+ `(cider-debug-code-overlay-face ((,class :background ,bg-alt)))
+ `(cider-debug-prompt-face ((,class :foreground ,magenta-alt :underline t)))
+ `(cider-deprecated-face ((,class :inherit modus-themes-refine-yellow)))
+ `(cider-docview-emphasis-face ((,class :inherit italic :foreground ,fg-special-cold)))
+ `(cider-docview-literal-face ((,class :foreground ,blue-alt)))
+ `(cider-docview-strong-face ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(cider-docview-table-border-face ((,class :inherit shadow)))
+ `(cider-enlightened-face ((,class :box (:line-width -1 :color ,yellow-alt :style nil) :background ,bg-dim)))
+ `(cider-enlightened-local-face ((,class :inherit bold :foreground ,yellow-alt-other)))
+ `(cider-error-highlight-face ((,class :foreground ,red :underline t)))
+ `(cider-fragile-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,yellow)))
+ `(cider-fringe-good-face ((,class :foreground ,green-active)))
+ `(cider-instrumented-face ((,class :box (:line-width -1 :color ,red :style nil) :background ,bg-dim)))
+ `(cider-reader-conditional-face ((,class :inherit italic :foreground ,fg-special-warm)))
+ `(cider-repl-input-face ((,class :inherit bold)))
+ `(cider-repl-prompt-face ((,class :inherit modus-themes-prompt)))
+ `(cider-repl-stderr-face ((,class :inherit bold :foreground ,red)))
+ `(cider-repl-stdout-face ((,class :foreground ,blue)))
+ `(cider-result-overlay-face ((,class :box (:line-width -1 :color ,blue :style nil) :background ,bg-dim)))
+ `(cider-stacktrace-error-class-face ((,class :inherit bold :foreground ,red)))
+ `(cider-stacktrace-error-message-face ((,class :inherit italic :foreground ,red-alt-other)))
+ `(cider-stacktrace-face ((,class :foreground ,fg-main)))
+ `(cider-stacktrace-filter-active-face ((,class :foreground ,cyan-alt :underline t)))
+ `(cider-stacktrace-filter-inactive-face ((,class :foreground ,cyan-alt)))
+ `(cider-stacktrace-fn-face ((,class :inherit bold :foreground ,fg-main)))
+ `(cider-stacktrace-ns-face ((,class :inherit italic :foreground ,fg-alt)))
+ `(cider-stacktrace-promoted-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,red)))
+ `(cider-stacktrace-suppressed-button-face ((,class :box (:line-width 3 :color ,fg-alt :style pressed-button)
+ :background ,bg-alt :foreground ,fg-alt)))
+ `(cider-test-error-face ((,class :inherit modus-themes-subtle-red)))
+ `(cider-test-failure-face ((,class :inherit (modus-themes-intense-red bold))))
+ `(cider-test-success-face ((,class :inherit ,@(modus-themes--success-deuteran
+ 'modus-themes-intense-blue
+ 'modus-themes-intense-green))))
+ `(cider-traced-face ((,class :box (:line-width -1 :color ,cyan :style nil) :background ,bg-dim)))
+ `(cider-warning-highlight-face ((,class :foreground ,yellow :underline t)))
+;;;;; circe (and lui)
+ `(circe-fool-face ((,class :inherit shadow)))
+ `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue)))
+ `(circe-prompt-face ((,class :inherit modus-themes-prompt)))
+ `(circe-server-face ((,class :foreground ,fg-unfocused)))
+ `(lui-button-face ((,class :inherit button)))
+ `(lui-highlight-face ((,class :foreground ,magenta-alt)))
+ `(lui-time-stamp-face ((,class :foreground ,blue-nuanced-fg)))
+;;;;; color-rg
+ `(color-rg-font-lock-column-number ((,class :foreground ,magenta-alt-other)))
+ `(color-rg-font-lock-command ((,class :inherit bold :foreground ,fg-main)))
+ `(color-rg-font-lock-file ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(color-rg-font-lock-flash ((,class :inherit modus-themes-intense-blue)))
+ `(color-rg-font-lock-function-location ((,class :inherit modus-themes-special-calm)))
+ `(color-rg-font-lock-header-line-directory ((,class :foreground ,blue-active)))
+ `(color-rg-font-lock-header-line-edit-mode ((,class :foreground ,magenta-active)))
+ `(color-rg-font-lock-header-line-keyword ((,class :foreground ,green-active)))
+ `(color-rg-font-lock-header-line-text ((,class :foreground ,fg-active)))
+ `(color-rg-font-lock-line-number ((,class :foreground ,fg-special-warm)))
+ `(color-rg-font-lock-mark-changed ((,class :inherit bold :foreground ,blue)))
+ `(color-rg-font-lock-mark-deleted ((,class :inherit bold :foreground ,red)))
+ `(color-rg-font-lock-match ((,class :inherit modus-themes-special-calm)))
+ `(color-rg-font-lock-position-splitter ((,class :inherit shadow)))
+;;;;; column-enforce-mode
+ `(column-enforce-face ((,class :inherit modus-themes-refine-yellow)))
+;;;;; company-mode
+ `(company-echo-common ((,class :foreground ,magenta-alt-other)))
+ `(company-preview ((,class :background ,bg-dim :foreground ,fg-dim)))
+ `(company-preview-common ((,class :foreground ,blue-alt)))
+ `(company-preview-search ((,class :inherit modus-themes-special-calm)))
+ `(company-scrollbar-bg ((,class :background ,bg-active)))
+ `(company-scrollbar-fg ((,class :background ,fg-active)))
+ `(company-template-field ((,class :inherit modus-themes-intense-magenta)))
+ `(company-tooltip ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(company-tooltip-annotation ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(company-tooltip-annotation-selection ((,class :inherit bold :foreground ,fg-main)))
+ `(company-tooltip-common ((,class :inherit bold :foreground ,blue-alt)))
+ `(company-tooltip-common-selection ((,class :foreground ,fg-main)))
+ `(company-tooltip-mouse ((,class :inherit modus-themes-intense-blue)))
+ `(company-tooltip-search ((,class :inherit (modus-themes-search-success-lazy bold))))
+ `(company-tooltip-search-selection ((,class :inherit (modus-themes-search-success bold) :underline t)))
+ `(company-tooltip-selection ((,class :inherit (modus-themes-subtle-cyan bold))))
+;;;;; company-posframe
+ `(company-posframe-active-backend-name ((,class :inherit bold :background ,bg-active :foreground ,blue-active)))
+ `(company-posframe-inactive-backend-name ((,class :background ,bg-active :foreground ,fg-active)))
+ `(company-posframe-metadata ((,class :background ,bg-inactive :foreground ,fg-inactive)))
+;;;;; compilation feedback
+ `(compilation-column-number ((,class :foreground ,magenta-alt-other)))
+ `(compilation-error ((,class :inherit modus-themes-bold :foreground ,red)))
+ `(compilation-info ((,class :inherit modus-themes-bold :foreground ,fg-special-cold)))
+ `(compilation-line-number ((,class :foreground ,fg-special-warm)))
+ `(compilation-mode-line-exit ((,class :inherit modus-themes-bold :foreground ,blue-active)))
+ `(compilation-mode-line-fail ((,class :inherit modus-themes-bold :foreground ,red-active)))
+ `(compilation-mode-line-run ((,class :inherit modus-themes-bold :foreground ,magenta-active)))
+ `(compilation-warning ((,class :inherit modus-themes-bold :foreground ,yellow)))
+;;;;; completions
+ `(completions-annotations ((,class :inherit modus-themes-slant :foreground ,cyan-faint)))
+ `(completions-common-part ((,class ,@(modus-themes--standard-completions
+ blue-alt blue-nuanced-bg
+ cyan-refine-bg cyan-refine-fg))))
+ `(completions-first-difference ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ magenta-alt blue-nuanced-bg
+ magenta-intense-bg fg-main))))
+;;;;; consult
+ `(consult-async-running ((,class :inherit bold :foreground ,blue)))
+ `(consult-async-split ((,class :foreground ,magenta-alt)))
+ `(consult-bookmark ((,class :foreground ,blue)))
+ `(consult-file ((,class :foreground ,fg-special-cold)))
+ `(consult-imenu-prefix ((,class :inherit shadow)))
+ `(consult-key ((,class :inherit modus-themes-key-binding)))
+ `(consult-line-number ((,class :foreground ,fg-special-warm)))
+ `(consult-line-number-prefix ((,class :foreground ,fg-unfocused)))
+ `(consult-narrow-indicator ((,class :foreground ,magenta-alt)))
+ `(consult-preview-cursor ((,class :inherit modus-themes-intense-blue)))
+ `(consult-preview-error ((,class :inherit modus-themes-intense-red)))
+ `(consult-preview-line ((,class :background ,bg-hl-alt-intense)))
+;;;;; corfu
+ `(corfu-background ((,class :background ,bg-alt)))
+ `(corfu-current ((,class :inherit bold :background ,cyan-subtle-bg)))
+ `(corfu-bar ((,class :background ,fg-alt)))
+ `(corfu-border ((,class :background ,bg-active)))
+;;;;; counsel
+ `(counsel-active-mode ((,class :foreground ,magenta-alt-other)))
+ `(counsel-application-name ((,class :foreground ,red-alt-other)))
+ `(counsel-key-binding ((,class :inherit modus-themes-key-binding)))
+ `(counsel-outline-1 ((,class :inherit org-level-1)))
+ `(counsel-outline-2 ((,class :inherit org-level-2)))
+ `(counsel-outline-3 ((,class :inherit org-level-3)))
+ `(counsel-outline-4 ((,class :inherit org-level-4)))
+ `(counsel-outline-5 ((,class :inherit org-level-5)))
+ `(counsel-outline-6 ((,class :inherit org-level-6)))
+ `(counsel-outline-7 ((,class :inherit org-level-7)))
+ `(counsel-outline-8 ((,class :inherit org-level-8)))
+ `(counsel-outline-default ((,class :foreground ,fg-main)))
+ `(counsel-variable-documentation ((,class :inherit modus-themes-slant :foreground ,yellow-alt-other)))
+;;;;; counsel-css
+ `(counsel-css-selector-depth-face-1 ((,class :foreground ,blue)))
+ `(counsel-css-selector-depth-face-2 ((,class :foreground ,cyan)))
+ `(counsel-css-selector-depth-face-3 ((,class :foreground ,green)))
+ `(counsel-css-selector-depth-face-4 ((,class :foreground ,yellow)))
+ `(counsel-css-selector-depth-face-5 ((,class :foreground ,magenta)))
+ `(counsel-css-selector-depth-face-6 ((,class :foreground ,red)))
+;;;;; counsel-org-capture-string
+ `(counsel-org-capture-string-template-body-face ((,class :foreground ,fg-special-cold)))
+;;;;; cov
+ `(cov-coverage-not-run-face ((,class :foreground ,red-intense)))
+ `(cov-coverage-run-face ((,class :foreground ,green-intense)))
+ `(cov-heavy-face ((,class :foreground ,magenta-intense)))
+ `(cov-light-face ((,class :foreground ,blue-intense)))
+ `(cov-med-face ((,class :foreground ,yellow-intense)))
+ `(cov-none-face ((,class :foreground ,cyan-intense)))
+;;;;; cperl-mode
+ `(cperl-nonoverridable-face ((,class :foreground unspecified)))
+ `(cperl-array-face ((,class :inherit font-lock-keyword-face)))
+ `(cperl-hash-face ((,class :inherit font-lock-variable-name-face)))
+;;;;; css-mode
+ `(css-property ((,class :inherit font-lock-type-face)))
+ `(css-selector ((,class :inherit font-lock-keyword-face)))
+;;;;; csv-mode
+ `(csv-separator-face ((,class :foreground ,red-intense)))
+;;;;; ctrlf
+ `(ctrlf-highlight-active ((,class :inherit (modus-themes-search-success bold))))
+ `(ctrlf-highlight-line ((,class :inherit modus-themes-hl-line)))
+ `(ctrlf-highlight-passive ((,class :inherit modus-themes-search-success-lazy)))
+;;;;; custom (M-x customize)
+ `(custom-button ((,class :box (:line-width 2 :color nil :style released-button)
+ :background ,bg-active :foreground ,fg-main)))
+ `(custom-button-mouse ((,class :box (:line-width 2 :color nil :style released-button)
+ :background ,bg-active :foreground ,fg-active)))
+ `(custom-button-pressed ((,class :box (:line-width 2 :color nil :style pressed-button)
+ :background ,bg-active :foreground ,fg-main)))
+ `(custom-changed ((,class :inherit modus-themes-subtle-cyan)))
+ `(custom-comment ((,class :inherit shadow)))
+ `(custom-comment-tag ((,class :background ,bg-alt :foreground ,yellow-alt-other)))
+ `(custom-face-tag ((,class :inherit bold :foreground ,blue-intense)))
+ `(custom-group-tag ((,class :inherit bold :foreground ,green-intense)))
+ `(custom-group-tag-1 ((,class :inherit modus-themes-special-warm)))
+ `(custom-invalid ((,class :inherit (modus-themes-intense-red bold))))
+ `(custom-modified ((,class :inherit modus-themes-subtle-cyan)))
+ `(custom-rogue ((,class :inherit modus-themes-refine-magenta)))
+ `(custom-set ((,class :foreground ,blue-alt)))
+ `(custom-state ((,class :foreground ,cyan-alt-other)))
+ `(custom-themed ((,class :inherit modus-themes-subtle-blue)))
+ `(custom-variable-tag ((,class :inherit bold :foreground ,cyan)))
+;;;;; dap-mode
+ `(dap-mouse-eval-thing-face ((,class :box (:line-width -1 :color ,blue-active :style nil)
+ :background ,bg-active :foreground ,fg-main)))
+ `(dap-result-overlay-face ((,class :box (:line-width -1 :color ,bg-active :style nil)
+ :background ,bg-active :foreground ,fg-main)))
+ `(dap-ui-breakpoint-verified-fringe ((,class :inherit bold :foreground ,green-active)))
+ `(dap-ui-compile-errline ((,class :inherit bold :foreground ,red-intense)))
+ `(dap-ui-locals-scope-face ((,class :inherit bold :foreground ,magenta :underline t)))
+ `(dap-ui-locals-variable-face ((,class :inherit bold :foreground ,cyan)))
+ `(dap-ui-locals-variable-leaf-face ((,class :inherit italic :foreground ,cyan-alt-other)))
+ `(dap-ui-marker-face ((,class :inherit modus-themes-subtle-blue)))
+ `(dap-ui-sessions-stack-frame-face ((,class :inherit bold :foreground ,magenta-alt)))
+ `(dap-ui-sessions-terminated-active-face ((,class :inherit bold :foreground ,fg-alt)))
+ `(dap-ui-sessions-terminated-face ((,class :inherit shadow)))
+;;;;; dashboard (emacs-dashboard)
+ `(dashboard-banner-logo-title ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(dashboard-footer ((,class :inherit bold :foreground ,fg-special-mild)))
+ `(dashboard-heading ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(dashboard-navigator ((,class :foreground ,cyan-alt-other)))
+ `(dashboard-text-banner ((,class :foreground ,fg-dim)))
+;;;;; deadgrep
+ `(deadgrep-filename-face ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(deadgrep-match-face ((,class :inherit modus-themes-special-calm)))
+ `(deadgrep-meta-face ((,class :inherit shadow)))
+ `(deadgrep-regexp-metachar-face ((,class :inherit bold :foreground ,yellow-intense)))
+ `(deadgrep-search-term-face ((,class :inherit bold :foreground ,green-intense)))
+;;;;; debbugs
+ `(debbugs-gnu-archived ((,class :inverse-video t)))
+ `(debbugs-gnu-done ((,class :inherit shadow)))
+ `(debbugs-gnu-forwarded ((,class :foreground ,fg-special-warm)))
+ `(debbugs-gnu-handled ((,class :foreground ,blue)))
+ `(debbugs-gnu-new ((,class :foreground ,red)))
+ `(debbugs-gnu-pending ((,class :foreground ,cyan)))
+ `(debbugs-gnu-stale-1 ((,class :foreground ,yellow-nuanced-fg)))
+ `(debbugs-gnu-stale-2 ((,class :foreground ,yellow)))
+ `(debbugs-gnu-stale-3 ((,class :foreground ,yellow-alt)))
+ `(debbugs-gnu-stale-4 ((,class :foreground ,yellow-alt-other)))
+ `(debbugs-gnu-stale-5 ((,class :foreground ,red-alt)))
+ `(debbugs-gnu-tagged ((,class :foreground ,magenta-alt)))
+;;;;; define-word
+ `(define-word-face-1 ((,class :foreground ,yellow)))
+ `(define-word-face-2 ((,class :foreground ,fg-main)))
+;;;;; deft
+ `(deft-filter-string-error-face ((,class :inherit modus-themes-refine-red)))
+ `(deft-filter-string-face ((,class :foreground ,green-intense)))
+ `(deft-header-face ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(deft-separator-face ((,class :inherit shadow)))
+ `(deft-summary-face ((,class :inherit modus-themes-slant :foreground ,fg-alt)))
+ `(deft-time-face ((,class :foreground ,fg-special-cold)))
+ `(deft-title-face ((,class :inherit bold :foreground ,fg-main)))
+;;;;; dictionary
+ `(dictionary-button-face ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(dictionary-reference-face ((,class :inherit button)))
+ `(dictionary-word-definition-face (()))
+ `(dictionary-word-entry-face ((,class :inherit font-lock-comment-face)))
+;;;;; diff-hl
+ `(diff-hl-change ((,class :inherit modus-themes-fringe-yellow)))
+ `(diff-hl-delete ((,class :inherit modus-themes-fringe-red)))
+ `(diff-hl-dired-change ((,class :inherit diff-hl-change)))
+ `(diff-hl-dired-delete ((,class :inherit diff-hl-delete)))
+ `(diff-hl-dired-ignored ((,class :inherit dired-ignored)))
+ `(diff-hl-dired-insert ((,class :inherit diff-hl-insert)))
+ `(diff-hl-dired-unknown ((,class :inherit dired-ignored)))
+ `(diff-hl-insert ((,class :inherit ,@(modus-themes--diff-deuteran
+ 'modus-themes-fringe-blue
+ 'modus-themes-fringe-green))))
+ `(diff-hl-reverted-hunk-highlight ((,class :background ,fg-main :foreground ,bg-main)))
+;;;;; diff-mode
+ `(diff-added ((,class :inherit modus-themes-diff-added)))
+ `(diff-changed ((,class :inherit modus-themes-diff-changed :extend t)))
+ `(diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list :foreground fg-unfocused)))))
+ `(diff-error ((,class :inherit modus-themes-intense-red)))
+ `(diff-file-header ((,class :inherit (bold diff-header))))
+ `(diff-function ((,class :inherit modus-themes-diff-heading)))
+ `(diff-header ((,class :foreground ,fg-main)))
+ `(diff-hunk-header ((,class :inherit (bold modus-themes-diff-heading))))
+ `(diff-index ((,class :inherit bold :foreground ,blue-alt)))
+ `(diff-indicator-added ((,class :inherit (diff-added bold)
+ :foreground ,@(modus-themes--diff-deuteran blue green))))
+ `(diff-indicator-changed ((,class :inherit (diff-changed bold) :foreground ,yellow)))
+ `(diff-indicator-removed ((,class :inherit (diff-removed bold) :foreground ,red)))
+ `(diff-nonexistent ((,class :inherit (modus-themes-neutral bold))))
+ `(diff-refine-added ((,class :inherit modus-themes-diff-refine-added)))
+ `(diff-refine-changed ((,class :inherit modus-themes-diff-refine-changed)))
+ `(diff-refine-removed ((,class :inherit modus-themes-diff-refine-removed)))
+ `(diff-removed ((,class :inherit modus-themes-diff-removed)))
+;;;;; dim-autoload
+ `(dim-autoload-cookie-line ((,class :inherit font-lock-comment-face)))
+;;;;; dir-treeview
+ `(dir-treeview-archive-face ((,class :foreground ,fg-special-warm)))
+ `(dir-treeview-archive-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,yellow)))
+ `(dir-treeview-audio-face ((,class :foreground ,magenta)))
+ `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt)))
+ `(dir-treeview-control-face ((,class :inherit shadow)))
+ `(dir-treeview-control-mouse-face ((,class :inherit highlight)))
+ `(dir-treeview-default-icon-face ((,class :inherit bold :family "Font Awesome" :foreground ,fg-alt)))
+ `(dir-treeview-default-filename-face ((,class :foreground ,fg-main)))
+ `(dir-treeview-directory-face ((,class :foreground ,blue)))
+ `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt)))
+ `(dir-treeview-executable-face ((,class :foreground ,red-alt)))
+ `(dir-treeview-executable-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,red-alt-other)))
+ `(dir-treeview-image-face ((,class :foreground ,green-alt-other)))
+ `(dir-treeview-image-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,green-alt)))
+ `(dir-treeview-indent-face ((,class :inherit shadow)))
+ `(dir-treeview-label-mouse-face ((,class :inherit highlight)))
+ `(dir-treeview-start-dir-face ((,class :inherit modus-themes-pseudo-header)))
+ `(dir-treeview-symlink-face ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan cyan-faint))))
+ `(dir-treeview-video-face ((,class :foreground ,magenta-alt-other)))
+ `(dir-treeview-video-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt-other)))
+;;;;; dired
+ `(dired-broken-symlink ((,class :inherit button :foreground ,red)))
+ `(dired-directory ((,class :foreground ,blue)))
+ `(dired-flagged ((,class :inherit modus-themes-mark-del)))
+ `(dired-header ((,class :inherit modus-themes-pseudo-header)))
+ `(dired-ignored ((,class :inherit shadow)))
+ `(dired-mark ((,class :inherit modus-themes-mark-symbol)))
+ `(dired-marked ((,class :inherit modus-themes-mark-sel)))
+ `(dired-perm-write ((,class :foreground ,fg-special-warm)))
+ `(dired-symlink ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan-alt cyan-alt-faint))))
+ `(dired-warning ((,class :inherit bold :foreground ,yellow)))
+;;;;; dired-async
+ `(dired-async-failures ((,class :inherit bold :foreground ,red-active)))
+ `(dired-async-message ((,class :inherit bold :foreground ,blue-active)))
+ `(dired-async-mode-message ((,class :inherit bold :foreground ,cyan-active)))
+;;;;; dired-git
+ `(dired-git-branch-else ((,class :inherit bold :foreground ,magenta-alt)))
+ `(dired-git-branch-master ((,class :inherit bold :foreground ,magenta-alt-other)))
+;;;;; dired-git-info
+ `(dgi-commit-message-face ((,class :foreground ,fg-special-mild)))
+;;;;; dired-narrow
+ `(dired-narrow-blink ((,class :inherit (modus-themes-subtle-cyan bold))))
+;;;;; dired-subtree
+ ;; remove backgrounds from dired-subtree faces, else they break
+ ;; dired-{flagged,marked} and any other face that sets a background
+ ;; such as hl-line. Also, denoting depth by varying shades of gray
+ ;; is not good for accessibility.
+ `(dired-subtree-depth-1-face (()))
+ `(dired-subtree-depth-2-face (()))
+ `(dired-subtree-depth-3-face (()))
+ `(dired-subtree-depth-4-face (()))
+ `(dired-subtree-depth-5-face (()))
+ `(dired-subtree-depth-6-face (()))
+;;;;; diredc
+ `(diredc-face-chmod-font-lock-dir ((,class :foreground ,blue-alt)))
+ `(diredc-face-chmod-font-lock-exec ((,class :foreground ,magenta)))
+ `(diredc-face-chmod-font-lock-read ((,class :foreground ,fg-main)))
+ `(diredc-face-chmod-font-lock-write ((,class :foreground ,cyan)))
+;;;;; diredfl
+ `(diredfl-autofile-name ((,class :inherit modus-themes-special-cold)))
+ `(diredfl-compressed-file-name ((,class :foreground ,fg-special-warm)))
+ `(diredfl-compressed-file-suffix ((,class :foreground ,red-alt)))
+ `(diredfl-date-time ((,class :foreground ,cyan-alt-other)))
+ `(diredfl-deletion ((,class :inherit modus-themes-mark-del)))
+ `(diredfl-deletion-file-name ((,class :inherit modus-themes-mark-del)))
+ `(diredfl-dir-heading ((,class :inherit modus-themes-pseudo-header)))
+ `(diredfl-dir-name ((,class :inherit dired-directory)))
+ `(diredfl-dir-priv ((,class :foreground ,blue-alt)))
+ `(diredfl-exec-priv ((,class :foreground ,magenta)))
+ `(diredfl-executable-tag ((,class :foreground ,magenta-alt)))
+ `(diredfl-file-name ((,class :foreground ,fg-main)))
+ `(diredfl-file-suffix ((,class :foreground ,cyan)))
+ `(diredfl-flag-mark ((,class :inherit modus-themes-mark-sel)))
+ `(diredfl-flag-mark-line ((,class :inherit modus-themes-mark-sel)))
+ `(diredfl-ignored-file-name ((,class :inherit shadow)))
+ `(diredfl-link-priv ((,class :foreground ,blue-alt-other)))
+ `(diredfl-no-priv ((,class :inherit shadow)))
+ `(diredfl-number ((,class :foreground ,cyan-alt)))
+ `(diredfl-other-priv ((,class :foreground ,yellow)))
+ `(diredfl-rare-priv ((,class :foreground ,red-alt)))
+ `(diredfl-read-priv ((,class :foreground ,fg-main)))
+ `(diredfl-symlink ((,class :inherit dired-symlink)))
+ `(diredfl-tagged-autofile-name ((,class :inherit modus-themes-refine-magenta)))
+ `(diredfl-write-priv ((,class :foreground ,cyan)))
+;;;;; dired+
+ `(diredp-autofile-name ((,class :inherit modus-themes-special-cold)))
+ `(diredp-compressed-file-name ((,class :foreground ,fg-special-warm)))
+ `(diredp-compressed-file-suffix ((,class :foreground ,red-alt)))
+ `(diredp-date-time ((,class :foreground ,cyan-alt-other)))
+ `(diredp-deletion ((,class :inherit modus-themes-mark-del)))
+ `(diredp-deletion-file-name ((,class :inherit modus-themes-mark-del)))
+ `(diredp-dir-heading ((,class :inherit modus-themes-pseudo-header)))
+ `(diredp-dir-name ((,class :inherit dired-directory)))
+ `(diredp-dir-priv ((,class :foreground ,blue-alt)))
+ `(diredp-exec-priv ((,class :foreground ,magenta)))
+ `(diredp-executable-tag ((,class :foreground ,magenta-alt)))
+ `(diredp-file-name ((,class :foreground ,fg-main)))
+ `(diredp-file-suffix ((,class :foreground ,cyan)))
+ `(diredp-flag-mark ((,class :inherit modus-themes-mark-sel)))
+ `(diredp-flag-mark-line ((,class :inherit modus-themes-mark-sel)))
+ `(diredp-ignored-file-name ((,class :inherit shadow)))
+ `(diredp-link-priv ((,class :foreground ,blue-alt-other)))
+ `(diredp-mode-line-flagged ((,class :foreground ,red-active)))
+ `(diredp-mode-line-marked ((,class :foreground ,green-active)))
+ `(diredp-no-priv ((,class :inherit shadow)))
+ `(diredp-number ((,class :foreground ,cyan-alt)))
+ `(diredp-omit-file-name ((,class :inherit shadow :strike-through t)))
+ `(diredp-other-priv ((,class :foreground ,yellow)))
+ `(diredp-rare-priv ((,class :foreground ,red-alt)))
+ `(diredp-read-priv ((,class :foreground ,fg-main)))
+ `(diredp-symlink ((,class :inherit dired-symlink)))
+ `(diredp-tagged-autofile-name ((,class :inherit modus-themes-refine-magenta)))
+ `(diredp-write-priv ((,class :foreground ,cyan)))
+;;;;; disk-usage
+ `(disk-usage-children ((,class :foreground ,yellow)))
+ `(disk-usage-inaccessible ((,class :inherit bold :foreground ,red)))
+ `(disk-usage-percent ((,class :foreground ,green)))
+ `(disk-usage-size ((,class :foreground ,cyan)))
+ `(disk-usage-symlink ((,class :inherit button)))
+ `(disk-usage-symlink-directory ((,class :inherit bold :foreground ,blue-alt)))
+;;;;; display-fill-column-indicator-mode
+ `(fill-column-indicator ((,class :foreground ,bg-active)))
+;;;;; doom-modeline
+ `(doom-modeline-bar ((,class :inherit modus-themes-active-blue)))
+ `(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground ,bg-main)))
+ `(doom-modeline-battery-charging ((,class :foreground ,green-active)))
+ `(doom-modeline-battery-critical ((,class :inherit bold :foreground ,red-active)))
+ `(doom-modeline-battery-error ((,class :inherit bold :box (:line-width -2)
+ :foreground ,red-active)))
+ `(doom-modeline-battery-full ((,class :foreground ,blue-active)))
+ `(doom-modeline-battery-normal ((,class :foreground ,fg-active)))
+ `(doom-modeline-battery-warning ((,class :inherit bold :foreground ,yellow-active)))
+ `(doom-modeline-buffer-file ((,class :inherit bold :foreground ,fg-active)))
+ `(doom-modeline-buffer-major-mode ((,class :inherit bold :foreground ,cyan-active)))
+ `(doom-modeline-buffer-minor-mode ((,class :foreground ,fg-inactive)))
+ `(doom-modeline-buffer-modified ((,class :inherit bold :foreground ,magenta-active)))
+ `(doom-modeline-buffer-path ((,class :inherit bold :foreground ,fg-active)))
+ `(doom-modeline-debug ((,class :inherit bold :foreground ,yellow-active)))
+ `(doom-modeline-debug-visual ((,class :inherit bold :foreground ,red-active)))
+ `(doom-modeline-evil-emacs-state ((,class :inherit bold :foreground ,magenta-active)))
+ `(doom-modeline-evil-insert-state ((,class :inherit bold :foreground ,green-active)))
+ `(doom-modeline-evil-motion-state ((,class :inherit bold :foreground ,fg-inactive)))
+ `(doom-modeline-evil-normal-state ((,class :inherit bold :foreground ,fg-active)))
+ `(doom-modeline-evil-operator-state ((,class :inherit bold :foreground ,blue-active)))
+ `(doom-modeline-evil-replace-state ((,class :inherit bold :foreground ,red-active)))
+ `(doom-modeline-evil-visual-state ((,class :inherit bold :foreground ,cyan-active)))
+ `(doom-modeline-highlight ((,class :inherit bold :foreground ,blue-active)))
+ `(doom-modeline-host ((,class :inherit italic)))
+ `(doom-modeline-info ((,class :foreground ,green-active)))
+ `(doom-modeline-lsp-error ((,class :inherit bold :foreground ,red-active)))
+ `(doom-modeline-lsp-success ((,class :inherit bold :foreground ,@(modus-themes--success-deuteran
+ blue-active
+ green-active))))
+ `(doom-modeline-lsp-warning ((,class :inherit bold :foreground ,yellow-active)))
+ `(doom-modeline-panel ((,class :inherit modus-themes-active-blue)))
+ `(doom-modeline-persp-buffer-not-in-persp ((,class :inherit italic :foreground ,yellow-active)))
+ `(doom-modeline-persp-name ((,class :foreground ,fg-active)))
+ `(doom-modeline-project-dir ((,class :inherit bold :foreground ,blue-active)))
+ `(doom-modeline-project-parent-dir ((,class :foreground ,blue-active)))
+ `(doom-modeline-project-root-dir ((,class :foreground ,fg-active)))
+ `(doom-modeline-unread-number ((,class :inherit italic :foreground ,fg-active)))
+ `(doom-modeline-urgent ((,class :inherit bold :foreground ,red-active)))
+ `(doom-modeline-warning ((,class :inherit bold :foreground ,yellow-active)))
+;;;;; dynamic-ruler
+ `(dynamic-ruler-negative-face ((,class :inherit modus-themes-intense-neutral)))
+ `(dynamic-ruler-positive-face ((,class :inherit modus-themes-intense-yellow)))
+;;;;; easy-jekyll
+ `(easy-jekyll-help-face ((,class :background ,bg-dim :foreground ,cyan-alt-other)))
+;;;;; easy-kill
+ `(easy-kill-origin ((,class :inherit modus-themes-subtle-red)))
+ `(easy-kill-selection ((,class :inherit modus-themes-subtle-yellow)))
+;;;;; ebdb
+ `(ebdb-address-default ((,class :foreground ,fg-special-calm)))
+ `(ebdb-defunct ((,class :inherit shadow)))
+ `(ebdb-field-hidden ((,class :foreground ,magenta)))
+ `(ebdb-label ((,class :foreground ,cyan-alt-other)))
+ `(ebdb-mail-default ((,class :foreground ,fg-main)))
+ `(ebdb-mail-primary ((,class :foreground ,magenta-alt)))
+ `(ebdb-marked ((,class :background ,cyan-intense-bg)))
+ `(ebdb-organization-name ((,class :foreground ,red-alt-other)))
+ `(ebdb-person-name ((,class :foreground ,magenta-alt-other)))
+ `(ebdb-phone-default ((,class :foreground ,cyan)))
+ `(eieio-custom-slot-tag-face ((,class :foreground ,red-alt)))
+;;;;; ediff
+ `(ediff-current-diff-A ((,class :inherit modus-themes-diff-focus-removed)))
+ `(ediff-current-diff-Ancestor ((,class ,@(modus-themes--diff
+ bg-alt fg-special-cold
+ bg-special-cold fg-special-cold
+ blue-nuanced-bg blue))))
+ `(ediff-current-diff-B ((,class :inherit modus-themes-diff-focus-added)))
+ `(ediff-current-diff-C ((,class :inherit modus-themes-diff-focus-changed)))
+ `(ediff-even-diff-A ((,class :background ,bg-alt)))
+ `(ediff-even-diff-Ancestor ((,class :background ,bg-alt)))
+ `(ediff-even-diff-B ((,class :background ,bg-alt)))
+ `(ediff-even-diff-C ((,class :background ,bg-alt)))
+ `(ediff-fine-diff-A ((,class :inherit modus-themes-diff-refine-removed)))
+ `(ediff-fine-diff-Ancestor ((,class :inherit modus-themes-refine-cyan)))
+ `(ediff-fine-diff-B ((,class :inherit modus-themes-diff-refine-added)))
+ `(ediff-fine-diff-C ((,class :inherit modus-themes-diff-refine-changed)))
+ `(ediff-odd-diff-A ((,class :inherit ediff-even-diff-A)))
+ `(ediff-odd-diff-Ancestor ((,class :inherit ediff-even-diff-Ancestor)))
+ `(ediff-odd-diff-B ((,class :inherit ediff-even-diff-B)))
+ `(ediff-odd-diff-C ((,class :inherit ediff-even-diff-C)))
+;;;;; eglot
+ `(eglot-mode-line ((,class :inherit modus-themes-bold :foreground ,magenta-active)))
+;;;;; el-search
+ `(el-search-highlight-in-prompt-face ((,class :inherit bold :foreground ,magenta-alt)))
+ `(el-search-match ((,class :inherit modus-themes-search-success)))
+ `(el-search-other-match ((,class :inherit modus-themes-special-mild)))
+ `(el-search-occur-match ((,class :inherit modus-themes-special-calm)))
+;;;;; eldoc
+ ;; NOTE: see https://github.com/purcell/package-lint/issues/187
+ (list 'eldoc-highlight-function-argument `((,class :inherit bold :foreground ,blue-alt-other)))
+;;;;; eldoc-box
+ `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main)))
+ `(eldoc-box-border ((,class :background ,fg-alt)))
+;;;;; elfeed
+ `(elfeed-log-date-face ((,class :inherit elfeed-search-date-face)))
+ `(elfeed-log-debug-level-face ((,class :inherit elfeed-search-filter-face)))
+ `(elfeed-log-error-level-face ((,class :inherit error)))
+ `(elfeed-log-info-level-face ((,class :inherit success)))
+ `(elfeed-log-warn-level-face ((,class :inherit warning)))
+ `(elfeed-search-date-face ((,class :foreground ,cyan)))
+ `(elfeed-search-feed-face ((,class :foreground ,blue-faint)))
+ `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active)))
+ `(elfeed-search-last-update-face ((,class :foreground ,cyan-active)))
+ `(elfeed-search-tag-face ((,class :foreground ,cyan-alt-other)))
+ `(elfeed-search-title-face ((,class :foreground ,fg-dim)))
+ `(elfeed-search-unread-count-face ((,class :foreground ,green-active)))
+ `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main)))
+;;;;; elfeed-score
+ `(elfeed-score-date-face ((,class :foreground ,blue)))
+ `(elfeed-score-debug-level-face ((,class :foreground ,magenta-alt-other)))
+ `(elfeed-score-error-level-face ((,class :foreground ,red)))
+ `(elfeed-score-info-level-face ((,class :foreground ,cyan)))
+ `(elfeed-score-warn-level-face ((,class :foreground ,yellow)))
+;;;;; embark
+ `(embark-keybinding ((,class :inherit modus-themes-key-binding)))
+;;;;; emms
+ `(emms-playlist-track-face ((,class :foreground ,blue-alt)))
+ `(emms-playlist-selected-face ((,class :inherit bold :foreground ,blue-alt-other)))
+ `(emms-metaplaylist-mode-current-face ((,class :inherit emms-playlist-selected-face)))
+ `(emms-metaplaylist-mode-face ((,class :foreground ,cyan)))
+;;;;; enh-ruby-mode (enhanced-ruby-mode)
+ `(enh-ruby-heredoc-delimiter-face ((,class :inherit font-lock-constant-face)))
+ `(enh-ruby-op-face ((,class :foreground ,fg-main)))
+ `(enh-ruby-regexp-delimiter-face ((,class :inherit font-lock-regexp-grouping-construct)))
+ `(enh-ruby-regexp-face ((,class :inherit font-lock-string-face)))
+ `(enh-ruby-string-delimiter-face ((,class :inherit font-lock-string-face)))
+ `(erm-syn-errline ((,class :inherit modus-themes-lang-error)))
+ `(erm-syn-warnline ((,class :inherit modus-themes-lang-warning)))
+;;;;; epa
+ `(epa-field-body ((,class :foreground ,fg-main)))
+ `(epa-field-name ((,class :inherit bold :foreground ,fg-dim)))
+ `(epa-mark ((,class :inherit bold :foreground ,magenta)))
+ `(epa-string ((,class :foreground ,blue-alt)))
+ `(epa-validity-disabled ((,class :foreground ,red)))
+ `(epa-validity-high ((,class :inherit bold :foreground ,cyan)))
+ `(epa-validity-low ((,class :inherit shadow)))
+ `(epa-validity-medium ((,class :foreground ,green-alt)))
+;;;;; equake
+ `(equake-buffer-face ((,class :background ,bg-main :foreground ,fg-main)))
+ `(equake-shell-type-eshell ((,class :background ,bg-inactive :foreground ,blue-active)))
+ `(equake-shell-type-rash ((,class :background ,bg-inactive :foreground ,red-active)))
+ `(equake-shell-type-shell ((,class :background ,bg-inactive :foreground ,cyan-active)))
+ `(equake-shell-type-term ((,class :background ,bg-inactive :foreground ,yellow-active)))
+ `(equake-shell-type-vterm ((,class :background ,bg-inactive :foreground ,magenta-active)))
+ `(equake-tab-active ((,class :background ,fg-alt :foreground ,bg-alt)))
+ `(equake-tab-inactive ((,class :foreground ,fg-inactive)))
+;;;;; erc
+ `(erc-action-face ((,class :inherit bold :foreground ,cyan)))
+ `(erc-bold-face ((,class :inherit bold)))
+ `(erc-button ((,class :inherit button)))
+ `(erc-command-indicator-face ((,class :inherit bold :foreground ,cyan-alt)))
+ `(erc-current-nick-face ((,class :foreground ,magenta-alt-other)))
+ `(erc-dangerous-host-face ((,class :inherit modus-themes-intense-red)))
+ `(erc-direct-msg-face ((,class :foreground ,magenta)))
+ `(erc-error-face ((,class :inherit bold :foreground ,red)))
+ `(erc-fool-face ((,class :foreground ,fg-inactive)))
+ `(erc-header-line ((,class :background ,bg-header :foreground ,fg-header)))
+ `(erc-input-face ((,class :foreground ,fg-special-calm)))
+ `(erc-inverse-face ((,class :inherit erc-default-face :inverse-video t)))
+ `(erc-keyword-face ((,class :inherit bold :foreground ,magenta-alt)))
+ `(erc-my-nick-face ((,class :inherit bold :foreground ,magenta)))
+ `(erc-my-nick-prefix-face ((,class :inherit erc-my-nick-face)))
+ `(erc-nick-default-face ((,class :inherit bold :foreground ,blue)))
+ `(erc-nick-msg-face ((,class :inherit bold :foreground ,green)))
+ `(erc-nick-prefix-face ((,class :inherit erc-nick-default-face)))
+ `(erc-notice-face ((,class :foreground ,fg-unfocused)))
+ `(erc-pal-face ((,class :inherit bold :foreground ,red-alt)))
+ `(erc-prompt-face ((,class :inherit modus-themes-prompt)))
+ `(erc-timestamp-face ((,class :foreground ,blue-nuanced-fg)))
+ `(erc-underline-face ((,class :underline t)))
+ `(bg:erc-color-face0 ((,class :background "white")))
+ `(bg:erc-color-face1 ((,class :background "black")))
+ `(bg:erc-color-face10 ((,class :background ,cyan-subtle-bg)))
+ `(bg:erc-color-face11 ((,class :background ,cyan-intense-bg)))
+ `(bg:erc-color-face12 ((,class :background ,blue-subtle-bg)))
+ `(bg:erc-color-face13 ((,class :background ,magenta-subtle-bg)))
+ `(bg:erc-color-face14 ((,class :background "gray60")))
+ `(bg:erc-color-face15 ((,class :background "gray80")))
+ `(bg:erc-color-face2 ((,class :background ,blue-intense-bg)))
+ `(bg:erc-color-face3 ((,class :background ,green-intense-bg)))
+ `(bg:erc-color-face4 ((,class :background ,red-subtle-bg)))
+ `(bg:erc-color-face5 ((,class :background ,red-intense-bg)))
+ `(bg:erc-color-face6 ((,class :background ,magenta-refine-bg)))
+ `(bg:erc-color-face7 ((,class :background ,yellow-subtle-bg)))
+ `(bg:erc-color-face8 ((,class :background ,yellow-refine-bg)))
+ `(bg:erc-color-face9 ((,class :background ,green-subtle-bg)))
+ `(fg:erc-color-face0 ((,class :foreground "white")))
+ `(fg:erc-color-face1 ((,class :foreground "black")))
+ `(fg:erc-color-face10 ((,class :foreground ,cyan)))
+ `(fg:erc-color-face11 ((,class :foreground ,cyan-alt-other)))
+ `(fg:erc-color-face12 ((,class :foreground ,blue)))
+ `(fg:erc-color-face13 ((,class :foreground ,magenta-alt)))
+ `(fg:erc-color-face14 ((,class :foreground "gray60")))
+ `(fg:erc-color-face15 ((,class :foreground "gray80")))
+ `(fg:erc-color-face2 ((,class :foreground ,blue-alt-other)))
+ `(fg:erc-color-face3 ((,class :foreground ,green)))
+ `(fg:erc-color-face4 ((,class :foreground ,red)))
+ `(fg:erc-color-face5 ((,class :foreground ,red-alt)))
+ `(fg:erc-color-face6 ((,class :foreground ,magenta-alt-other)))
+ `(fg:erc-color-face7 ((,class :foreground ,yellow-alt-other)))
+ `(fg:erc-color-face8 ((,class :foreground ,yellow-alt)))
+ `(fg:erc-color-face9 ((,class :foreground ,green-alt-other)))
+;;;;; eros
+ `(eros-result-overlay-face ((,class :box (:line-width -1 :color ,blue)
+ :background ,bg-dim :foreground ,fg-dim)))
+;;;;; ert
+ `(ert-test-result-expected ((,class :inherit modus-themes-intense-green)))
+ `(ert-test-result-unexpected ((,class :inherit modus-themes-intense-red)))
+;;;;; eshell
+ `(eshell-ls-archive ((,class :foreground ,cyan-alt)))
+ `(eshell-ls-backup ((,class :inherit shadow)))
+ `(eshell-ls-clutter ((,class :foreground ,red-alt)))
+ `(eshell-ls-directory ((,class :foreground ,blue-alt)))
+ `(eshell-ls-executable ((,class :foreground ,magenta-alt)))
+ `(eshell-ls-missing ((,class :inherit modus-themes-intense-red)))
+ `(eshell-ls-product ((,class :inherit shadow)))
+ `(eshell-ls-readonly ((,class :foreground ,yellow-faint)))
+ `(eshell-ls-special ((,class :foreground ,magenta)))
+ `(eshell-ls-symlink ((,class :foreground ,cyan)))
+ `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive)))
+ `(eshell-prompt ((,class :inherit modus-themes-prompt)))
+;;;;; eshell-fringe-status
+ `(eshell-fringe-status-failure ((,class :inherit error)))
+ `(eshell-fringe-status-success ((,class :inherit success)))
+;;;;; eshell-git-prompt
+ `(eshell-git-prompt-add-face ((,class :foreground ,magenta-alt-other)))
+ `(eshell-git-prompt-branch-face ((,class :foreground ,magenta-alt)))
+ `(eshell-git-prompt-directory-face ((,class :inherit bold :foreground ,blue)))
+ `(eshell-git-prompt-exit-fail-face ((,class :inherit error)))
+ `(eshell-git-prompt-exit-success-face ((,class :inherit success)))
+ `(eshell-git-prompt-modified-face ((,class :foreground ,yellow)))
+ `(eshell-git-prompt-powerline-clean-face ((,class :background ,green-refine-bg)))
+ `(eshell-git-prompt-powerline-dir-face ((,class :background ,blue-refine-bg)))
+ `(eshell-git-prompt-powerline-not-clean-face ((,class :background ,yellow-fringe-bg)))
+ `(eshell-git-prompt-robyrussell-branch-face ((,class :foreground ,magenta-alt)))
+ `(eshell-git-prompt-robyrussell-git-dirty-face ((,class :foreground ,yellow)))
+ `(eshell-git-prompt-robyrussell-git-face ((,class :foreground ,magenta-alt-other)))
+;;;;; eshell-prompt-extras (epe)
+ `(epe-dir-face ((,class :inherit bold :foreground ,blue)))
+ `(epe-git-dir-face ((,class :foreground ,red-alt-other)))
+ `(epe-git-face ((,class :foreground ,magenta-alt)))
+ `(epe-pipeline-delimiter-face ((,class :inherit shadow)))
+ `(epe-pipeline-host-face ((,class :foreground ,fg-main)))
+ `(epe-pipeline-time-face ((,class :foreground ,fg-main)))
+ `(epe-pipeline-user-face ((,class :foreground ,magenta-alt-other)))
+ `(epe-remote-face ((,class :inherit (shadow modus-themes-slant))))
+ `(epe-status-face ((,class :foreground ,magenta-alt-other)))
+ `(epe-venv-face ((,class :inherit (shadow modus-themes-slant))))
+;;;;; eshell-syntax-highlighting
+ `(eshell-syntax-highlighting-directory-face ((,class :inherit eshell-ls-directory)))
+ `(eshell-syntax-highlighting-invalid-face ((,class :foreground ,red)))
+ `(eshell-syntax-highlighting-shell-command-face ((,class :foreground ,fg-main)))
+;;;;; evil-mode
+ `(evil-ex-commands ((,class :foreground ,magenta-alt-other)))
+ `(evil-ex-info ((,class :foreground ,cyan-alt-other)))
+ `(evil-ex-lazy-highlight ((,class :inherit modus-themes-search-success-lazy)))
+ `(evil-ex-search ((,class :inherit modus-themes-search-success)))
+ `(evil-ex-substitute-matches ((,class :inherit modus-themes-refine-yellow :underline t)))
+ `(evil-ex-substitute-replacement ((,class :inherit (modus-themes-search-success bold))))
+;;;;; evil-goggles
+ `(evil-goggles-change-face ((,class :inherit modus-themes-refine-yellow)))
+ `(evil-goggles-commentary-face ((,class :inherit (modus-themes-subtle-neutral modus-themes-slant))))
+ `(evil-goggles-default-face ((,class :inherit modus-themes-subtle-neutral)))
+ `(evil-goggles-delete-face ((,class :inherit modus-themes-refine-red)))
+ `(evil-goggles-fill-and-move-face ((,class :inherit evil-goggles-default-face)))
+ `(evil-goggles-indent-face ((,class :inherit evil-goggles-default-face)))
+ `(evil-goggles-join-face ((,class :inherit modus-themes-subtle-green)))
+ `(evil-goggles-nerd-commenter-face ((,class :inherit evil-goggles-commentary-face)))
+ `(evil-goggles-paste-face ((,class :inherit modus-themes-subtle-cyan)))
+ `(evil-goggles-record-macro-face ((,class :inherit modus-themes-special-cold)))
+ `(evil-goggles-replace-with-register-face ((,class :inherit modus-themes-refine-magenta)))
+ `(evil-goggles-set-marker-face ((,class :inherit modus-themes-intense-magenta)))
+ `(evil-goggles-shift-face ((,class :inherit evil-goggles-default-face)))
+ `(evil-goggles-surround-face ((,class :inherit evil-goggles-default-face)))
+ `(evil-goggles-yank-face ((,class :inherit modus-themes-subtle-blue)))
+;;;;; evil-snipe
+ `(evil-snipe-first-match-face ((,class :inherit (bold modus-themes-intense-blue))))
+ `(evil-snipe-matches-face ((,class :inherit modus-themes-refine-magenta)))
+;;;;; evil-visual-mark-mode
+ `(evil-visual-mark-face ((,class :inherit modus-themes-intense-magenta)))
+;;;;; eww
+ `(eww-invalid-certificate ((,class :foreground ,red-faint)))
+ `(eww-valid-certificate ((,class :foreground ,blue-faint)))
+ `(eww-form-checkbox ((,class :inherit eww-form-text)))
+ `(eww-form-file ((,class :inherit eww-form-submit)))
+ `(eww-form-select ((,class :inherit eww-form-submit)))
+ `(eww-form-submit ((,class :box (:line-width 2 :style released-button)
+ :background ,bg-active)))
+ `(eww-form-text ((,class :box ,bg-active :background ,bg-alt)))
+ `(eww-form-textarea ((,class :background ,bg-alt)))
+;;;;; eyebrowse
+ `(eyebrowse-mode-line-active ((,class :inherit bold :foreground ,blue-active)))
+;;;;; fancy-dabbrev
+ `(fancy-dabbrev-menu-face ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(fancy-dabbrev-preview-face ((,class :inherit shadow :underline t)))
+ `(fancy-dabbrev-selection-face ((,class :inherit (modus-themes-intense-cyan bold))))
+;;;;; flycheck
+ `(flycheck-error ((,class :inherit modus-themes-lang-error)))
+ `(flycheck-error-list-checker-name ((,class :foreground ,magenta-active)))
+ `(flycheck-error-list-column-number ((,class :foreground ,fg-special-cold)))
+ `(flycheck-error-list-error ((,class :inherit modus-themes-bold :foreground ,red)))
+ `(flycheck-error-list-filename ((,class :foreground ,blue)))
+ `(flycheck-error-list-highlight ((,class :inherit modus-themes-hl-line)))
+ `(flycheck-error-list-id ((,class :foreground ,magenta-alt-other)))
+ `(flycheck-error-list-id-with-explainer ((,class :inherit flycheck-error-list-id :box t)))
+ `(flycheck-error-list-info ((,class :foreground ,cyan)))
+ `(flycheck-error-list-line-number ((,class :foreground ,fg-special-warm)))
+ `(flycheck-error-list-warning ((,class :foreground ,yellow)))
+ `(flycheck-fringe-error ((,class :inherit modus-themes-fringe-red)))
+ `(flycheck-fringe-info ((,class :inherit modus-themes-fringe-cyan)))
+ `(flycheck-fringe-warning ((,class :inherit modus-themes-fringe-yellow)))
+ `(flycheck-info ((,class :inherit modus-themes-lang-note)))
+ `(flycheck-verify-select-checker ((,class :box (:line-width 1 :color nil :style released-button))))
+ `(flycheck-warning ((,class :inherit modus-themes-lang-warning)))
+;;;;; flycheck-color-mode-line
+ `(flycheck-color-mode-line-error-face ((,class :inherit flycheck-fringe-error)))
+ `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-info)))
+ `(flycheck-color-mode-line-running-face ((,class :inherit italic :foreground ,fg-inactive)))
+ `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-warning)))
+;;;;; flycheck-indicator
+ `(flycheck-indicator-disabled ((,class :inherit modus-themes-slant :foreground ,fg-inactive)))
+ `(flycheck-indicator-error ((,class :inherit modus-themes-bold :foreground ,red-active)))
+ `(flycheck-indicator-info ((,class :inherit modus-themes-bold :foreground ,blue-active)))
+ `(flycheck-indicator-running ((,class :inherit modus-themes-bold :foreground ,magenta-active)))
+ `(flycheck-indicator-success ((,class :inherit modus-themes-bold
+ :foreground ,@(modus-themes--success-deuteran
+ blue-active
+ green-active))))
+ `(flycheck-indicator-warning ((,class :inherit modus-themes-bold :foreground ,yellow-active)))
+;;;;; flycheck-posframe
+ `(flycheck-posframe-background-face ((,class :background ,bg-alt)))
+ `(flycheck-posframe-border-face ((,class :inherit shadow)))
+ `(flycheck-posframe-error-face ((,class :inherit bold :foreground ,red)))
+ `(flycheck-posframe-face ((,class :inherit modus-themes-slant :foreground ,fg-main)))
+ `(flycheck-posframe-info-face ((,class :inherit bold :foreground ,cyan)))
+ `(flycheck-posframe-warning-face ((,class :inherit bold :foreground ,yellow)))
+;;;;; flymake
+ `(flymake-error ((,class :inherit modus-themes-lang-error)))
+ `(flymake-note ((,class :inherit modus-themes-lang-note)))
+ `(flymake-warning ((,class :inherit modus-themes-lang-warning)))
+;;;;; flyspell
+ `(flyspell-duplicate ((,class :inherit modus-themes-lang-warning)))
+ `(flyspell-incorrect ((,class :inherit modus-themes-lang-error)))
+;;;;; flyspell-correct
+ `(flyspell-correct-highlight-face ((,class :inherit modus-themes-refine-green)))
+;;;;; flx
+ `(flx-highlight-face ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-magenta
+ 'modus-themes-intense-magenta
+ 'modus-themes-nuanced-magenta
+ magenta-alt
+ 'bold))))
+;;;;; freeze-it
+ `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm)))
+;;;;; frog-menu
+ `(frog-menu-action-keybinding-face ((,class :inherit modus-themes-key-binding)))
+ `(frog-menu-actions-face ((,class :foreground ,magenta)))
+ `(frog-menu-border ((,class :background ,bg-active)))
+ `(frog-menu-candidates-face ((,class :foreground ,fg-main)))
+ `(frog-menu-posframe-background-face ((,class :background ,bg-dim)))
+ `(frog-menu-prompt-face ((,class :foreground ,cyan)))
+;;;;; focus
+ `(focus-unfocused ((,class :foreground ,fg-unfocused)))
+;;;;; fold-this
+ `(fold-this-overlay ((,class :inherit modus-themes-special-mild)))
+;;;;; font-lock
+ `(font-lock-builtin-face ((,class :inherit modus-themes-bold
+ ,@(modus-themes--syntax-extra
+ magenta-alt magenta-alt-faint
+ magenta magenta-faint))))
+ `(font-lock-comment-delimiter-face ((,class :inherit font-lock-comment-face)))
+ `(font-lock-comment-face ((,class :inherit modus-themes-slant
+ ,@(modus-themes--syntax-comment
+ fg-alt fg-comment-yellow yellow-alt-other-faint))))
+ `(font-lock-constant-face ((,class ,@(modus-themes--syntax-extra
+ blue-alt-other blue-alt-other-faint
+ magenta-alt-other magenta-alt-other-faint))))
+ `(font-lock-doc-face ((,class :inherit modus-themes-slant
+ ,@(modus-themes--syntax-string
+ fg-docstring fg-special-cold
+ fg-special-mild magenta-nuanced-fg
+ fg-special-mild magenta-nuanced-fg))))
+ `(font-lock-function-name-face ((,class ,@(modus-themes--syntax-extra
+ magenta magenta-faint
+ magenta-alt magenta-alt-faint))))
+ `(font-lock-keyword-face ((,class :inherit modus-themes-bold
+ ,@(modus-themes--syntax-extra
+ magenta-alt-other magenta-alt-other-faint
+ cyan cyan-faint))))
+ `(font-lock-negation-char-face ((,class :inherit modus-themes-bold
+ ,@(modus-themes--syntax-foreground
+ yellow yellow-faint))))
+ `(font-lock-preprocessor-face ((,class ,@(modus-themes--syntax-extra
+ red-alt-other red-alt-other-faint
+ blue-alt blue-alt-faint))))
+ `(font-lock-regexp-grouping-backslash ((,class :inherit bold
+ ,@(modus-themes--syntax-string
+ fg-escape-char-backslash yellow-alt-faint
+ yellow magenta-alt
+ yellow-faint red-faint))))
+ `(font-lock-regexp-grouping-construct ((,class :inherit bold
+ ,@(modus-themes--syntax-string
+ fg-escape-char-construct red-alt-other-faint
+ blue blue-alt-other
+ blue-faint blue-alt-other-faint))))
+ `(font-lock-string-face ((,class ,@(modus-themes--syntax-string
+ blue-alt blue-alt-faint
+ green red
+ green-faint red-faint))))
+ `(font-lock-type-face ((,class :inherit modus-themes-bold
+ ,@(modus-themes--syntax-foreground
+ cyan-alt-other cyan-alt-faint))))
+ `(font-lock-variable-name-face ((,class ,@(modus-themes--syntax-extra
+ cyan cyan-faint
+ blue-alt-other blue-alt-other-faint))))
+ `(font-lock-warning-face ((,class :inherit modus-themes-bold
+ ,@(modus-themes--syntax-comment
+ yellow-active red-active red-faint yellow-faint))))
+;;;;; forge
+ `(forge-post-author ((,class :inherit bold :foreground ,fg-main)))
+ `(forge-post-date ((,class :foreground ,fg-special-cold)))
+ `(forge-topic-closed ((,class :inherit shadow)))
+ `(forge-topic-merged ((,class :inherit shadow)))
+ `(forge-topic-open ((,class :foreground ,fg-special-mild)))
+ `(forge-topic-unmerged ((,class :inherit modus-themes-slant :foreground ,magenta)))
+ `(forge-topic-unread ((,class :inherit bold :foreground ,fg-main)))
+;;;;; fountain-mode
+ `(fountain-character ((,class :foreground ,blue-alt-other)))
+ `(fountain-comment ((,class :inherit modus-themes-slant :foreground ,fg-alt)))
+ `(fountain-dialog ((,class :foreground ,blue-alt)))
+ `(fountain-metadata-key ((,class :foreground ,green-alt-other)))
+ `(fountain-metadata-value ((,class :foreground ,blue)))
+ `(fountain-non-printing ((,class :inherit shadow)))
+ `(fountain-note ((,class :inherit modus-themes-slant :foreground ,yellow)))
+ `(fountain-page-break ((,class :inherit bold :foreground ,red-alt)))
+ `(fountain-page-number ((,class :inherit bold :foreground ,red-alt-other)))
+ `(fountain-paren ((,class :foreground ,cyan)))
+ `(fountain-scene-heading ((,class :inherit bold :foreground ,blue-nuanced-fg)))
+ `(fountain-section-heading ((,class :inherit modus-themes-heading-1)))
+ `(fountain-section-heading-1 ((,class :inherit modus-themes-heading-1)))
+ `(fountain-section-heading-2 ((,class :inherit modus-themes-heading-2)))
+ `(fountain-section-heading-3 ((,class :inherit modus-themes-heading-3)))
+ `(fountain-section-heading-4 ((,class :inherit modus-themes-heading-4)))
+ `(fountain-section-heading-5 ((,class :inherit modus-themes-heading-5)))
+ `(fountain-synopsis ((,class :foreground ,cyan-alt)))
+ `(fountain-trans ((,class :foreground ,yellow-alt-other)))
+;;;;; geiser
+ `(geiser-font-lock-autodoc-current-arg ((,class :inherit font-lock-function-name-face)))
+ `(geiser-font-lock-autodoc-identifier ((,class :inherit font-lock-constant-face)))
+ `(geiser-font-lock-doc-button ((,class :inherit button :foreground ,fg-docstring)))
+ `(geiser-font-lock-doc-link ((,class :inherit button)))
+ `(geiser-font-lock-error-link ((,class :inherit button :foreground ,red)))
+ `(geiser-font-lock-image-button ((,class :inherit button :foreground ,green-alt)))
+ `(geiser-font-lock-repl-input ((,class :inherit bold)))
+ `(geiser-font-lock-repl-output ((,class :inherit font-lock-keyword-face)))
+ `(geiser-font-lock-repl-prompt ((,class :inherit modus-themes-prompt)))
+ `(geiser-font-lock-xref-header ((,class :inherit bold)))
+ `(geiser-font-lock-xref-link ((,class :inherit button)))
+;;;;; git-commit
+ `(git-commit-comment-action ((,class :inherit font-lock-comment-face)))
+ `(git-commit-comment-branch-local ((,class :inherit modus-themes-slant :foreground ,blue-alt)))
+ `(git-commit-comment-branch-remote ((,class :inherit modus-themes-slant :foreground ,magenta-alt)))
+ `(git-commit-comment-detached ((,class :inherit modus-themes-slant :foreground ,cyan-alt)))
+ `(git-commit-comment-file ((,class :inherit modus-themes-slant
+ ,@(modus-themes--syntax-comment
+ fg-special-cold red-nuanced-fg))))
+ `(git-commit-comment-heading ((,class :inherit (bold modus-themes-slant)
+ ,@(modus-themes--syntax-comment
+ fg-dim fg-special-warm))))
+ `(git-commit-keyword ((,class :foreground ,magenta)))
+ `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other)))
+ `(git-commit-nonempty-second-line ((,class :inherit modus-themes-refine-yellow)))
+ `(git-commit-overlong-summary ((,class :inherit modus-themes-refine-yellow)))
+ `(git-commit-pseudo-header ((,class :foreground ,blue)))
+ `(git-commit-summary ((,class :inherit bold :foreground ,cyan)))
+;;;;; git-gutter
+ `(git-gutter:added ((,class :inherit ,@(modus-themes--diff-deuteran
+ 'modus-themes-fringe-blue
+ 'modus-themes-fringe-green))))
+ `(git-gutter:deleted ((,class :inherit modus-themes-fringe-red)))
+ `(git-gutter:modified ((,class :inherit modus-themes-fringe-yellow)))
+ `(git-gutter:separator ((,class :inherit modus-themes-fringe-cyan)))
+ `(git-gutter:unchanged ((,class :inherit modus-themes-fringe-magenta)))
+;;;;; git-gutter-fr
+ `(git-gutter-fr:added ((,class :inherit ,@(modus-themes--diff-deuteran
+ 'modus-themes-fringe-blue
+ 'modus-themes-fringe-green))))
+ `(git-gutter-fr:deleted ((,class :inherit modus-themes-fringe-red)))
+ `(git-gutter-fr:modified ((,class :inherit modus-themes-fringe-yellow)))
+;;;;; git-{gutter,fringe}+
+ `(git-gutter+-added ((,class :inherit ,@(modus-themes--diff-deuteran
+ 'modus-themes-fringe-blue
+ 'modus-themes-fringe-green))))
+ `(git-gutter+-deleted ((,class :inherit modus-themes-fringe-red)))
+ `(git-gutter+-modified ((,class :inherit modus-themes-fringe-yellow)))
+ `(git-gutter+-separator ((,class :inherit modus-themes-fringe-cyan)))
+ `(git-gutter+-unchanged ((,class :inherit modus-themes-fringe-magenta)))
+ `(git-gutter-fr+-added ((,class :inherit modus-themes-fringe-green)))
+ `(git-gutter-fr+-deleted ((,class :inherit modus-themes-fringe-red)))
+ `(git-gutter-fr+-modified ((,class :inherit modus-themes-fringe-yellow)))
+;;;;; git-lens
+ `(git-lens-added ((,class :inherit bold :foreground ,@(modus-themes--diff-deuteran blue green))))
+ `(git-lens-deleted ((,class :inherit bold :foreground ,red)))
+ `(git-lens-header ((,class :inherit bold :height 1.1 :foreground ,cyan)))
+ `(git-lens-modified ((,class :inherit bold :foreground ,yellow)))
+ `(git-lens-renamed ((,class :inherit bold :foreground ,magenta)))
+;;;;; git-rebase
+ `(git-rebase-comment-hash ((,class :inherit modus-themes-slant
+ ,@(modus-themes--syntax-comment
+ fg-special-cold red-nuanced-fg))))
+ `(git-rebase-comment-heading ((,class :inherit (bold modus-themes-slant)
+ ,@(modus-themes--syntax-comment
+ fg-dim fg-special-warm))))
+ `(git-rebase-description ((,class :foreground ,fg-main)))
+ `(git-rebase-hash ((,class :foreground ,cyan-alt-other)))
+;;;;; git-timemachine
+ `(git-timemachine-commit ((,class :inherit bold :foreground ,yellow-active)))
+ `(git-timemachine-minibuffer-author-face ((,class :foreground ,fg-special-warm)))
+ `(git-timemachine-minibuffer-detail-face ((,class :foreground ,red-alt)))
+;;;;; git-walktree
+ `(git-walktree-commit-face ((,class :foreground ,yellow)))
+ `(git-walktree-symlink-face ((,class :inherit button)))
+ `(git-walktree-tree-face ((,class :foreground ,magenta)))
+;;;;; gnus
+ `(gnus-button ((,class :inherit button)))
+ `(gnus-cite-1 ((,class :inherit message-cited-text-1)))
+ `(gnus-cite-2 ((,class :inherit message-cited-text-2)))
+ `(gnus-cite-3 ((,class :inherit message-cited-text-3)))
+ `(gnus-cite-4 ((,class :inherit message-cited-text-4)))
+ `(gnus-cite-5 ((,class :inherit gnus-cite-1)))
+ `(gnus-cite-6 ((,class :inherit gnus-cite-2)))
+ `(gnus-cite-7 ((,class :inherit gnus-cite-3)))
+ `(gnus-cite-8 ((,class :inherit gnus-cite-4)))
+ `(gnus-cite-9 ((,class :inherit gnus-cite-1)))
+ `(gnus-cite-10 ((,class :inherit gnus-cite-2)))
+ `(gnus-cite-11 ((,class :inherit gnus-cite-3)))
+ `(gnus-cite-attribution ((,class :inherit italic :foreground ,fg-main)))
+ `(gnus-emphasis-bold ((,class :inherit bold)))
+ `(gnus-emphasis-bold-italic ((,class :inherit bold-italic)))
+ `(gnus-emphasis-highlight-words ((,class :inherit modus-themes-refine-yellow)))
+ `(gnus-emphasis-italic ((,class :inherit italic)))
+ `(gnus-emphasis-underline-bold ((,class :inherit gnus-emphasis-bold :underline t)))
+ `(gnus-emphasis-underline-bold-italic ((,class :inherit gnus-emphasis-bold-italic :underline t)))
+ `(gnus-emphasis-underline-italic ((,class :inherit gnus-emphasis-italic :underline t)))
+ `(gnus-group-mail-1 ((,class :inherit bold :foreground ,magenta-alt)))
+ `(gnus-group-mail-1-empty ((,class :foreground ,magenta-alt)))
+ `(gnus-group-mail-2 ((,class :inherit bold :foreground ,magenta)))
+ `(gnus-group-mail-2-empty ((,class :foreground ,magenta)))
+ `(gnus-group-mail-3 ((,class :inherit bold :foreground ,magenta-alt-other)))
+ `(gnus-group-mail-3-empty ((,class :foreground ,magenta-alt-other)))
+ `(gnus-group-mail-low ((,class :inherit bold :foreground ,magenta-nuanced-fg)))
+ `(gnus-group-mail-low-empty ((,class :foreground ,magenta-nuanced-fg)))
+ `(gnus-group-news-1 ((,class :inherit bold :foreground ,green)))
+ `(gnus-group-news-1-empty ((,class :foreground ,green)))
+ `(gnus-group-news-2 ((,class :inherit bold :foreground ,cyan)))
+ `(gnus-group-news-2-empty ((,class :foreground ,cyan)))
+ `(gnus-group-news-3 ((,class :inherit bold :foreground ,yellow-nuanced-fg)))
+ `(gnus-group-news-3-empty ((,class :foreground ,yellow-nuanced-fg)))
+ `(gnus-group-news-4 ((,class :inherit bold :foreground ,cyan-nuanced-fg)))
+ `(gnus-group-news-4-empty ((,class :foreground ,cyan-nuanced-fg)))
+ `(gnus-group-news-5 ((,class :inherit bold :foreground ,red-nuanced-fg)))
+ `(gnus-group-news-5-empty ((,class :foreground ,red-nuanced-fg)))
+ `(gnus-group-news-6 ((,class :inherit bold :foreground ,fg-unfocused)))
+ `(gnus-group-news-6-empty ((,class :foreground ,fg-unfocused)))
+ `(gnus-group-news-low ((,class :inherit bold :foreground ,green-nuanced-fg)))
+ `(gnus-group-news-low-empty ((,class :foreground ,green-nuanced-fg)))
+ `(gnus-header-content ((,class :inherit message-header-other)))
+ `(gnus-header-from ((,class :inherit message-header-to :underline nil)))
+ `(gnus-header-name ((,class :inherit message-header-name)))
+ `(gnus-header-newsgroups ((,class :inherit message-header-newsgroups)))
+ `(gnus-header-subject ((,class :inherit message-header-subject)))
+ `(gnus-server-agent ((,class :inherit bold :foreground ,cyan)))
+ `(gnus-server-closed ((,class :inherit bold :foreground ,magenta)))
+ `(gnus-server-cloud ((,class :inherit bold :foreground ,cyan-alt)))
+ `(gnus-server-cloud-host ((,class :inherit modus-themes-refine-cyan)))
+ `(gnus-server-denied ((,class :inherit bold :foreground ,red)))
+ `(gnus-server-offline ((,class :inherit bold :foreground ,yellow)))
+ `(gnus-server-opened ((,class :inherit bold :foreground ,green)))
+ `(gnus-signature ((,class :inherit italic :foreground ,fg-special-cold)))
+ `(gnus-splash ((,class :inherit shadow)))
+ `(gnus-summary-cancelled ((,class :inherit modus-themes-mark-alt :extend t)))
+ `(gnus-summary-high-ancient ((,class :inherit bold :foreground ,fg-alt)))
+ `(gnus-summary-high-read ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(gnus-summary-high-ticked ((,class :inherit bold :foreground ,red-alt-other)))
+ `(gnus-summary-high-undownloaded ((,class :inherit bold :foreground ,yellow)))
+ `(gnus-summary-high-unread ((,class :inherit bold :foreground ,fg-main)))
+ `(gnus-summary-low-ancient ((,class :inherit italic :foreground ,fg-alt)))
+ `(gnus-summary-low-read ((,class :inherit italic :foreground ,fg-alt)))
+ `(gnus-summary-low-ticked ((,class :inherit italic :foreground ,red-refine-fg)))
+ `(gnus-summary-low-undownloaded ((,class :inherit italic :foreground ,yellow-refine-fg)))
+ `(gnus-summary-low-unread ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm)))
+ `(gnus-summary-normal-read ((,class :inherit shadow)))
+ `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other)))
+ `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow)))
+ `(gnus-summary-normal-unread ((,class :foreground ,fg-main)))
+ `(gnus-summary-selected ((,class :inherit highlight :extend t)))
+;;;;; gotest
+ `(go-test--ok-face ((,class :inherit success)))
+ `(go-test--error-face ((,class :inherit error)))
+ `(go-test--warning-face ((,class :inherit warning)))
+ `(go-test--pointer-face ((,class :foreground ,magenta-alt-other)))
+ `(go-test--standard-face ((,class :foreground ,fg-special-cold)))
+;;;;; golden-ratio-scroll-screen
+ `(golden-ratio-scroll-highlight-line-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
+;;;;; helm
+ `(helm-M-x-key ((,class :inherit modus-themes-key-binding)))
+ `(helm-action ((,class :underline t)))
+ `(helm-bookmark-addressbook ((,class :foreground ,green-alt)))
+ `(helm-bookmark-directory ((,class :inherit bold :foreground ,blue)))
+ `(helm-bookmark-file ((,class :foreground ,fg-main)))
+ `(helm-bookmark-file-not-found ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(helm-bookmark-gnus ((,class :foreground ,magenta)))
+ `(helm-bookmark-info ((,class :foreground ,cyan-alt)))
+ `(helm-bookmark-man ((,class :foreground ,yellow-alt)))
+ `(helm-bookmark-w3m ((,class :foreground ,blue-alt)))
+ `(helm-buffer-archive ((,class :inherit bold :foreground ,cyan)))
+ `(helm-buffer-directory ((,class :inherit bold :foreground ,blue)))
+ `(helm-buffer-file ((,class :foreground ,fg-main)))
+ `(helm-buffer-modified ((,class :foreground ,yellow-alt)))
+ `(helm-buffer-not-saved ((,class :foreground ,red-alt)))
+ `(helm-buffer-process ((,class :foreground ,magenta)))
+ `(helm-buffer-saved-out ((,class :inherit bold :background ,bg-alt :foreground ,red)))
+ `(helm-buffer-size ((,class :inherit shadow)))
+ `(helm-candidate-number ((,class :foreground ,cyan-active)))
+ `(helm-candidate-number-suspended ((,class :foreground ,yellow-active)))
+ `(helm-comint-prompts-buffer-name ((,class :foreground ,green-active)))
+ `(helm-comint-prompts-promptidx ((,class :foreground ,cyan-active)))
+ `(helm-delete-async-message ((,class :inherit bold :foreground ,magenta-active)))
+ `(helm-eob-line ((,class :background ,bg-main :foreground ,fg-main)))
+ `(helm-eshell-prompts-buffer-name ((,class :foreground ,green-active)))
+ `(helm-eshell-prompts-promptidx ((,class :foreground ,cyan-active)))
+ `(helm-etags-file ((,class :foreground ,fg-dim :underline t)))
+ `(helm-ff-backup-file ((,class :inherit shadow)))
+ `(helm-ff-denied ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-red
+ 'modus-themes-intense-red
+ 'modus-themes-nuanced-red
+ red))))
+ `(helm-ff-directory ((,class :inherit helm-buffer-directory)))
+ `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other)))
+ `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt)))
+ `(helm-ff-dotted-symlink-directory ((,class :inherit (button helm-ff-dotted-directory))))
+ `(helm-ff-executable ((,class :foreground ,magenta-alt)))
+ `(helm-ff-file ((,class :foreground ,fg-main)))
+ `(helm-ff-file-extension ((,class :foreground ,fg-special-warm)))
+ `(helm-ff-invalid-symlink ((,class :inherit button
+ ,@(modus-themes--link-color
+ red red-faint))))
+ `(helm-ff-pipe ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-refine-magenta
+ 'modus-themes-subtle-magenta
+ 'modus-themes-nuanced-magenta
+ magenta))))
+ `(helm-ff-prefix ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-refine-yellow
+ 'modus-themes-subtle-yellow
+ 'modus-themes-nuanced-yellow
+ yellow-alt-other))))
+ `(helm-ff-socket ((,class :foreground ,red-alt-other)))
+ `(helm-ff-suid ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-red
+ 'modus-themes-refine-red
+ 'modus-themes-nuanced-yellow
+ red-alt))))
+ `(helm-ff-symlink ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan cyan-faint))))
+ `(helm-ff-truename ((,class :foreground ,blue-alt-other)))
+ `(helm-fd-finish ((,class :foreground ,green-active)))
+ `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other)))
+ `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(helm-grep-finish ((,class :foreground ,green-active)))
+ `(helm-grep-lineno ((,class :foreground ,fg-special-warm)))
+ `(helm-grep-match ((,class :inherit modus-themes-special-calm)))
+ `(helm-header ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(helm-header-line-left-margin ((,class :inherit bold :foreground ,yellow-intense)))
+ `(helm-history-deleted ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-red
+ 'modus-themes-intense-red
+ 'modus-themes-nuanced-red
+ red
+ 'bold))))
+ `(helm-history-remote ((,class :foreground ,red-alt-other)))
+ `(helm-lisp-completion-info ((,class :foreground ,fg-special-warm)))
+ `(helm-lisp-show-completion ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-yellow
+ 'modus-themes-refine-yellow
+ 'modus-themes-nuanced-yellow
+ yellow
+ 'bold))))
+ `(helm-locate-finish ((,class :foreground ,green-active)))
+ `(helm-match ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-cyan
+ 'modus-themes-refine-cyan
+ 'modus-themes-nuanced-cyan
+ cyan
+ 'bold))))
+ `(helm-match-item ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-neutral
+ 'modus-themes-subtle-cyan
+ 'modus-themes-nuanced-cyan
+ cyan-alt-other))))
+ `(helm-minibuffer-prompt ((,class :inherit modus-themes-prompt)))
+ `(helm-moccur-buffer ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan-alt-other cyan-alt-other-faint))))
+ `(helm-mode-prefix ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-magenta
+ 'modus-themes-intense-magenta
+ 'modus-themes-nuanced-magenta
+ magenta-alt
+ 'bold))))
+ `(helm-non-file-buffer ((,class :inherit shadow)))
+ `(helm-prefarg ((,class :foreground ,red-active)))
+ `(helm-resume-need-update ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-magenta
+ 'modus-themes-refine-magenta
+ 'modus-themes-nuanced-magenta
+ magenta-alt-other))))
+ `(helm-selection ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-blue
+ 'modus-themes-refine-blue
+ 'modus-themes-special-cold
+ nil
+ 'bold))))
+ `(helm-selection-line ((,class :inherit modus-themes-special-cold)))
+ `(helm-separator ((,class :foreground ,fg-special-mild)))
+ `(helm-time-zone-current ((,class :foreground ,green)))
+ `(helm-time-zone-home ((,class :foreground ,magenta)))
+ `(helm-source-header ((,class :inherit bold :foreground ,red-alt
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(helm-top-columns ((,class :inherit helm-header)))
+ `(helm-ucs-char ((,class :foreground ,yellow-alt-other)))
+ `(helm-visible-mark ((,class :inherit modus-themes-subtle-cyan)))
+;;;;; helm-ls-git
+ `(helm-ls-git-added-copied-face ((,class :foreground ,green-intense)))
+ `(helm-ls-git-added-modified-face ((,class :foreground ,yellow-intense)))
+ `(helm-ls-git-conflict-face ((,class :inherit bold :foreground ,red-intense)))
+ `(helm-ls-git-deleted-and-staged-face ((,class :foreground ,red-nuanced-fg)))
+ `(helm-ls-git-deleted-not-staged-face ((,class :foreground ,red)))
+ `(helm-ls-git-modified-and-staged-face ((,class :foreground ,yellow-nuanced-fg)))
+ `(helm-ls-git-modified-not-staged-face ((,class :foreground ,yellow)))
+ `(helm-ls-git-renamed-modified-face ((,class :foreground ,magenta)))
+ `(helm-ls-git-untracked-face ((,class :foreground ,fg-special-cold)))
+;;;;; helm-switch-shell
+ `(helm-switch-shell-new-shell-face ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-magenta
+ 'modus-themes-refine-magenta
+ 'modus-themes-nuanced-magenta
+ magenta-alt-other
+ 'bold))))
+;;;;; helm-xref
+ `(helm-xref-file-name ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(helm-xref-file-name ((,class :foreground ,fg-special-warm)))
+;;;;; helpful
+ `(helpful-heading ((,class :inherit modus-themes-heading-1)))
+;;;;; highlight region or ad-hoc regexp
+ `(hi-aquamarine ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
+ `(hi-black-b ((,class :inherit bold :background ,fg-main :foreground ,bg-main)))
+ `(hi-black-hb ((,class :inherit bold :background ,fg-alt :foreground ,bg-main)))
+ `(hi-blue ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
+ `(hi-blue-b ((,class :inherit (bold hi-blue))))
+ `(hi-green ((,class :background ,green-subtle-bg :foreground ,fg-main)))
+ `(hi-green-b ((,class :inherit (bold hi-green))))
+ `(hi-pink ((,class :background ,magenta-subtle-bg :foreground ,fg-main)))
+ `(hi-pink-b ((,class :inherit (bold hi-pink))))
+ `(hi-red-b ((,class :inherit bold :background ,red-intense-bg :foreground ,fg-main)))
+ `(hi-salmon ((,class :background ,red-subtle-bg :foreground ,fg-main)))
+ `(hi-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-main)))
+ `(highlight ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
+ `(highlight-changes ((,class :foreground ,red-alt :underline nil)))
+ `(highlight-changes-delete ((,class :background ,red-nuanced-bg
+ :foreground ,red :underline t)))
+ `(hl-line ((,class :inherit modus-themes-hl-line)))
+;;;;; highlight-blocks
+ `(highlight-blocks-depth-1-face ((,class :background ,bg-dim :foreground ,fg-main)))
+ `(highlight-blocks-depth-2-face ((,class :background ,bg-alt :foreground ,fg-main)))
+ `(highlight-blocks-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-main)))
+ `(highlight-blocks-depth-4-face ((,class :background ,bg-special-calm :foreground ,fg-main)))
+ `(highlight-blocks-depth-5-face ((,class :background ,bg-special-warm :foreground ,fg-main)))
+ `(highlight-blocks-depth-6-face ((,class :background ,bg-special-mild :foreground ,fg-main)))
+ `(highlight-blocks-depth-7-face ((,class :background ,bg-inactive :foreground ,fg-main)))
+ `(highlight-blocks-depth-8-face ((,class :background ,bg-active :foreground ,fg-main)))
+ `(highlight-blocks-depth-9-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
+;;;;; highlight-defined
+ `(highlight-defined-builtin-function-name-face ((,class :foreground ,magenta)))
+ `(highlight-defined-face-name-face ((,class :foreground ,fg-main)))
+ `(highlight-defined-function-name-face ((,class :foreground ,magenta)))
+ `(highlight-defined-macro-name-face ((,class :foreground ,magenta-alt)))
+ `(highlight-defined-special-form-name-face ((,class :foreground ,magenta-alt-other)))
+ `(highlight-defined-variable-name-face ((,class :foreground ,cyan)))
+;;;;; highlight-escape-sequences (`hes-mode')
+ `(hes-escape-backslash-face ((,class :inherit font-lock-regexp-grouping-construct)))
+ `(hes-escape-sequence-face ((,class :inherit font-lock-regexp-grouping-backslash)))
+;;;;; highlight-indentation
+ `(highlight-indentation-face ((,class :inherit modus-themes-hl-line)))
+ `(highlight-indentation-current-column-face ((,class :background ,bg-active)))
+;;;;; highlight-numbers
+ `(highlight-numbers-number ((,class :foreground ,blue-alt-other)))
+;;;;; highlight-symbol
+ `(highlight-symbol-face ((,class :inherit modus-themes-special-mild)))
+;;;;; highlight-thing
+ `(highlight-thing ((,class :background ,bg-alt :foreground ,cyan)))
+;;;;; hl-defined
+ `(hdefd-functions ((,class :foreground ,blue)))
+ `(hdefd-undefined ((,class :foreground ,red-alt)))
+ `(hdefd-variables ((,class :foreground ,cyan-alt)))
+;;;;; hl-fill-column
+ `(hl-fill-column-face ((,class :background ,bg-active :foreground ,fg-active)))
+;;;;; hl-todo
+ `(hl-todo ((,class :inherit (bold modus-themes-slant) :foreground ,red-alt-other)))
+;;;;; hydra
+ `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow-alt)))
+ `(hydra-face-blue ((,class :inherit bold :foreground ,blue)))
+ `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt-faint)))
+ `(hydra-face-red ((,class :inherit bold :foreground ,red-faint)))
+ `(hydra-face-teal ((,class :inherit bold :foreground ,cyan-alt-other)))
+;;;;; hyperlist
+ `(hyperlist-condition ((,class :foreground ,green)))
+ `(hyperlist-hashtag ((,class :foreground ,yellow)))
+ `(hyperlist-operator ((,class :foreground ,blue-alt)))
+ `(hyperlist-paren ((,class :foreground ,cyan-alt-other)))
+ `(hyperlist-quote ((,class :foreground ,cyan-alt)))
+ `(hyperlist-ref ((,class :foreground ,magenta-alt-other)))
+ `(hyperlist-stars ((,class :inherit shadow)))
+ `(hyperlist-tag ((,class :foreground ,red)))
+ `(hyperlist-toplevel ((,class :inherit bold :foreground ,fg-main)))
+;;;;; icomplete
+ `(icomplete-first-match ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ magenta bg-alt
+ bg-active fg-main))))
+;;;;; icomplete-vertical
+ `(icomplete-vertical-separator ((,class :inherit shadow)))
+;;;;; ido-mode
+ `(ido-first-match ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ magenta bg-alt
+ bg-active fg-main))))
+ `(ido-incomplete-regexp ((,class :inherit error)))
+ `(ido-indicator ((,class :inherit modus-themes-subtle-yellow)))
+ `(ido-only-match ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ green green-nuanced-bg
+ green-intense-bg fg-main))))
+ `(ido-subdir ((,class :foreground ,blue)))
+ `(ido-virtual ((,class :foreground ,fg-special-warm)))
+;;;;; iedit
+ `(iedit-occurrence ((,class :inherit modus-themes-refine-blue)))
+ `(iedit-read-only-occurrence ((,class :inherit modus-themes-intense-yellow)))
+;;;;; iflipb
+ `(iflipb-current-buffer-face ((,class :inherit bold :foreground ,cyan-alt)))
+ `(iflipb-other-buffer-face ((,class :inherit shadow)))
+;;;;; imenu-list
+ `(imenu-list-entry-face-0 ((,class :foreground ,cyan)))
+ `(imenu-list-entry-face-1 ((,class :foreground ,blue)))
+ `(imenu-list-entry-face-2 ((,class :foreground ,cyan-alt-other)))
+ `(imenu-list-entry-face-3 ((,class :foreground ,blue-alt)))
+ `(imenu-list-entry-subalist-face-0 ((,class :inherit bold :foreground ,magenta-alt-other :underline t)))
+ `(imenu-list-entry-subalist-face-1 ((,class :inherit bold :foreground ,magenta :underline t)))
+ `(imenu-list-entry-subalist-face-2 ((,class :inherit bold :foreground ,green-alt-other :underline t)))
+ `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t)))
+;;;;; indium
+ `(indium-breakpoint-face ((,class :foreground ,red-active)))
+ `(indium-frame-url-face ((,class :inherit button :foreground ,fg-alt)))
+ `(indium-keyword-face ((,class :inherit font-lock-keyword-face)))
+ `(indium-litable-face ((,class :inherit modus-themes-slant :foreground ,fg-special-warm)))
+ `(indium-repl-error-face ((,class :inherit error)))
+ `(indium-repl-prompt-face ((,class :inherit modus-themes-prompt)))
+ `(indium-repl-stdout-face ((,class :foreground ,fg-main)))
+;;;;; info
+ `(Info-quoted ((,class :inherit modus-themes-fixed-pitch ; the capitalization is canonical
+ :background ,bg-alt :foreground ,fg-special-calm)))
+ `(info-header-node ((,class :inherit bold :foreground ,fg-alt)))
+ `(info-header-xref ((,class :foreground ,blue-active)))
+ `(info-index-match ((,class :inherit match)))
+ `(info-menu-header ((,class :inherit modus-themes-heading-3)))
+ `(info-menu-star ((,class :foreground ,red)))
+ `(info-node ((,class :inherit bold)))
+ `(info-title-1 ((,class :inherit modus-themes-heading-1)))
+ `(info-title-2 ((,class :inherit modus-themes-heading-2)))
+ `(info-title-3 ((,class :inherit modus-themes-heading-3)))
+ `(info-title-4 ((,class :inherit modus-themes-heading-4)))
+;;;;; info-colors
+ `(info-colors-lisp-code-block ((,class :inherit fixed-pitch)))
+ `(info-colors-ref-item-command ((,class :inherit font-lock-function-name-face)))
+ `(info-colors-ref-item-constant ((,class :inherit font-lock-constant-face)))
+ `(info-colors-ref-item-function ((,class :inherit font-lock-function-name-face)))
+ `(info-colors-ref-item-macro ((,class :inherit font-lock-keyword-face)))
+ `(info-colors-ref-item-other ((,class :inherit font-lock-doc-face)))
+ `(info-colors-ref-item-special-form ((,class :inherit font-lock-keyword-face)))
+ `(info-colors-ref-item-syntax-class ((,class :inherit font-lock-builtin-face)))
+ `(info-colors-ref-item-type ((,class :inherit font-lock-type-face)))
+ `(info-colors-ref-item-user-option ((,class :inherit font-lock-variable-name-face)))
+ `(info-colors-ref-item-variable ((,class :inherit font-lock-variable-name-face)))
+;;;;; interaction-log
+ `(ilog-buffer-face ((,class :foreground ,magenta-alt-other)))
+ `(ilog-change-face ((,class :foreground ,magenta-alt)))
+ `(ilog-echo-face ((,class :foreground ,yellow-alt-other)))
+ `(ilog-load-face ((,class :foreground ,green)))
+ `(ilog-message-face ((,class :inherit shadow)))
+ `(ilog-non-change-face ((,class :foreground ,blue)))
+;;;;; ioccur
+ `(ioccur-cursor ((,class :foreground ,fg-main)))
+ `(ioccur-invalid-regexp ((,class :foreground ,red)))
+ `(ioccur-match-face ((,class :inherit modus-themes-special-calm)))
+ `(ioccur-match-overlay-face ((,class :inherit modus-themes-special-cold :extend t)))
+ `(ioccur-num-line-face ((,class :foreground ,fg-special-warm)))
+ `(ioccur-overlay-face ((,class :inherit modus-themes-refine-blue :extend t)))
+ `(ioccur-regexp-face ((,class :inherit (modus-themes-intense-magenta bold))))
+ `(ioccur-title-face ((,class :inherit bold :foreground ,red-alt
+ ,@(modus-themes--scale modus-themes-scale-4))))
+;;;;; isearch, occur, and the like
+ `(isearch ((,class :inherit (modus-themes-search-success bold))))
+ `(isearch-fail ((,class :inherit modus-themes-refine-red)))
+ `(isearch-group-1 ((,class :inherit modus-themes-refine-blue)))
+ `(isearch-group-2 ((,class :inherit modus-themes-refine-magenta)))
+ `(lazy-highlight ((,class :inherit modus-themes-search-success-lazy)))
+ `(match ((,class :inherit modus-themes-special-calm)))
+ `(query-replace ((,class :inherit (modus-themes-intense-yellow bold))))
+;;;;; isl (isearch-light)
+ `(isl-line ((,class :inherit ,@(modus-themes--success-deuteran
+ 'modus-themes-subtle-blue
+ 'modus-themes-subtle-green))))
+ `(isl-match ((,class :inherit modus-themes-search-success-lazy)))
+ `(isl-number ((,class :inherit (modus-themes-bold modus-themes-search-success-modeline))))
+ `(isl-on ((,class :inherit (bold modus-themes-search-success))))
+ `(isl-string ((,class :inherit modus-themes-bold :foreground ,cyan-active)))
+;;;;; ivy
+ `(ivy-action ((,class :inherit bold :foreground ,red-alt)))
+ `(ivy-completions-annotations ((,class :inherit completions-annotations)))
+ `(ivy-confirm-face ((,class :foreground ,cyan)))
+ `(ivy-current-match ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-refine-cyan
+ 'modus-themes-intense-cyan
+ 'modus-themes-special-cold
+ nil
+ 'bold))))
+ `(ivy-cursor ((,class :background ,fg-main :foreground ,bg-main)))
+ `(ivy-grep-info ((,class :foreground ,cyan-alt)))
+ `(ivy-grep-line-number ((,class :foreground ,fg-special-warm)))
+ `(ivy-highlight-face ((,class :foreground ,magenta)))
+ `(ivy-match-required-face ((,class :inherit error)))
+ `(ivy-minibuffer-match-face-1 ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-neutral
+ 'modus-themes-intense-neutral
+ 'modus-themes-nuanced-cyan
+ fg-alt))))
+ `(ivy-minibuffer-match-face-2 ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-green
+ 'modus-themes-refine-green
+ 'modus-themes-nuanced-green
+ green-alt-other
+ 'bold))))
+ `(ivy-minibuffer-match-face-3 ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-blue
+ 'modus-themes-refine-blue
+ 'modus-themes-nuanced-blue
+ blue-alt-other
+ 'bold))))
+ `(ivy-minibuffer-match-face-4 ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-magenta
+ 'modus-themes-refine-magenta
+ 'modus-themes-nuanced-magenta
+ magenta-alt-other
+ 'bold))))
+ `(ivy-minibuffer-match-highlight ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-cyan
+ 'modus-themes-intense-cyan
+ 'modus-themes-nuanced-cyan
+ cyan-alt-other
+ 'bold))))
+ `(ivy-modified-buffer ((,class :inherit modus-themes-slant :foreground ,yellow)))
+ `(ivy-modified-outside-buffer ((,class :inherit modus-themes-slant :foreground ,yellow-alt)))
+ `(ivy-org ((,class :foreground ,cyan-alt-other)))
+ `(ivy-prompt-match ((,class :inherit ivy-current-match)))
+ `(ivy-remote ((,class :foreground ,magenta)))
+ `(ivy-separator ((,class :inherit shadow)))
+ `(ivy-subdir ((,class :foreground ,blue-alt-other)))
+ `(ivy-virtual ((,class :foreground ,magenta-alt-other)))
+ `(ivy-yanked-word ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-blue
+ 'modus-themes-refine-blue
+ 'modus-themes-nuanced-blue
+ blue-alt))))
+;;;;; ivy-posframe
+ `(ivy-posframe ((,class :background ,bg-dim :foreground ,fg-main)))
+ `(ivy-posframe-border ((,class :background ,fg-window-divider-inner)))
+ `(ivy-posframe-cursor ((,class :background ,fg-main :foreground ,bg-main)))
+;;;;; jira (org-jira)
+ `(jiralib-comment-face ((,class :background ,bg-alt)))
+ `(jiralib-comment-header-face ((,class :inherit bold)))
+ `(jiralib-issue-info-face ((,class :inherit modus-themes-special-warm)))
+ `(jiralib-issue-info-header-face ((,class :inherit (modus-themes-special-warm bold))))
+ `(jiralib-issue-summary-face ((,class :inherit bold)))
+ `(jiralib-link-filter-face ((,class :underline t)))
+ `(jiralib-link-issue-face ((,class :underline t)))
+ `(jiralib-link-project-face ((,class :underline t)))
+;;;;; journalctl-mode
+ `(journalctl-error-face ((,class :inherit error)))
+ `(journalctl-finished-face ((,class :inherit success)))
+ `(journalctl-host-face ((,class :foreground ,blue)))
+ `(journalctl-process-face ((,class :foreground ,cyan-alt-other)))
+ `(journalctl-starting-face ((,class :foreground ,green)))
+ `(journalctl-timestamp-face ((,class :foreground ,fg-special-cold)))
+ `(journalctl-warning-face ((,class :inherit warning)))
+;;;;; js2-mode
+ `(js2-error ((,class :inherit modus-themes-lang-error)))
+ `(js2-external-variable ((,class :inherit font-lock-variable-name-face)))
+ `(js2-function-call ((,class :inherit font-lock-function-name-face)))
+ `(js2-function-param ((,class :inherit font-lock-constant-face)))
+ `(js2-instance-member ((,class :inherit font-lock-keyword-face)))
+ `(js2-jsdoc-html-tag-delimiter ((,class :foreground ,fg-main)))
+ `(js2-jsdoc-html-tag-name ((,class :inherit font-lock-function-name-face)))
+ `(js2-jsdoc-tag ((,class :inherit (font-lock-builtin-face font-lock-comment-face) :weight normal)))
+ `(js2-jsdoc-type ((,class :inherit (font-lock-type-face font-lock-comment-face) :weight normal)))
+ `(js2-jsdoc-value ((,class :inherit (font-lock-constant-face font-lock-comment-face) :weight normal)))
+ `(js2-object-property ((,class :foreground ,fg-main)))
+ `(js2-object-property-access ((,class :foreground ,fg-main)))
+ `(js2-private-function-call ((,class :inherit font-lock-preprocessor-face)))
+ `(js2-private-member ((,class :inherit font-lock-warning-face)))
+ `(js2-warning ((,class :inherit modus-themes-lang-warning)))
+;;;;; julia
+ `(julia-macro-face ((,class :inherit font-lock-builtin-face)))
+ `(julia-quoted-symbol-face ((,class :inherit font-lock-constant-face)))
+;;;;; jupyter
+ `(jupyter-eval-overlay ((,class :inherit bold :foreground ,blue)))
+ `(jupyter-repl-input-prompt ((,class :foreground ,cyan-alt-other)))
+ `(jupyter-repl-output-prompt ((,class :foreground ,magenta-alt-other)))
+ `(jupyter-repl-traceback ((,class :inherit modus-themes-intense-red)))
+;;;;; kaocha-runner
+ `(kaocha-runner-error-face ((,class :inherit error)))
+ `(kaocha-runner-success-face ((,class :inherit success)))
+ `(kaocha-runner-warning-face ((,class :inherit warning)))
+;;;;; keycast
+ `(keycast-command ((,class :inherit bold :foreground ,blue-active)))
+ `(keycast-key ((,class :background ,blue-active :foreground ,bg-main)))
+;;;;; ledger-mode
+ `(ledger-font-auto-xact-face ((,class :foreground ,magenta)))
+ `(ledger-font-account-name-face ((,class :foreground ,fg-special-cold)))
+ `(ledger-font-directive-face ((,class :foreground ,magenta-alt-other)))
+ `(ledger-font-posting-date-face ((,class :inherit bold :foreground ,fg-main)))
+ `(ledger-font-periodic-xact-face ((,class :foreground ,cyan-alt-other)))
+ `(ledger-font-posting-amount-face ((,class :foreground ,fg-special-mild)))
+ `(ledger-font-payee-cleared-face ((,class :foreground ,blue-alt)))
+ `(ledger-font-payee-pending-face ((,class :foreground ,yellow)))
+ `(ledger-font-payee-uncleared-face ((,class :foreground ,red-alt-other)))
+ `(ledger-font-xact-highlight-face ((,class :background ,bg-hl-alt)))
+;;;;; line numbers (display-line-numbers-mode and global variant)
+ `(line-number
+ ((,class :inherit default
+ ,@(modus-themes--line-numbers
+ fg-alt bg-dim
+ fg-unfocused))))
+ `(line-number-current-line
+ ((,class :inherit (bold default)
+ ,@(modus-themes--line-numbers
+ fg-main bg-active
+ blue-alt-other))))
+ `(line-number-major-tick
+ ((,class :inherit (bold default)
+ ,@(modus-themes--line-numbers
+ yellow-nuanced-fg yellow-nuanced-bg
+ red-alt))))
+ `(line-number-minor-tick
+ ((,class :inherit (bold default)
+ ,@(modus-themes--line-numbers
+ fg-alt bg-inactive
+ fg-inactive))))
+;;;;; lsp-mode
+ `(lsp-face-highlight-read ((,class :inherit modus-themes-subtle-blue :underline t)))
+ `(lsp-face-highlight-textual ((,class :inherit modus-themes-subtle-blue)))
+ `(lsp-face-highlight-write ((,class :inherit (modus-themes-refine-blue bold))))
+ `(lsp-face-semhl-constant ((,class :foreground ,blue-alt-other)))
+ `(lsp-face-semhl-deprecated ((,class :inherit modus-themes-lang-warning)))
+ `(lsp-face-semhl-enummember ((,class :foreground ,blue-alt-other)))
+ `(lsp-face-semhl-field ((,class :foreground ,cyan-alt)))
+ `(lsp-face-semhl-field-static ((,class :inherit modus-themes-slant :foreground ,cyan-alt)))
+ `(lsp-face-semhl-function ((,class :foreground ,magenta)))
+ `(lsp-face-semhl-method ((,class :foreground ,magenta)))
+ `(lsp-face-semhl-namespace ((,class :inherit modus-themes-bold :foreground ,magenta-alt)))
+ `(lsp-face-semhl-preprocessor ((,class :foreground ,red-alt-other)))
+ `(lsp-face-semhl-static-method ((,class :inherit modus-themes-slant :foreground ,magenta)))
+ `(lsp-face-semhl-type-class ((,class :foreground ,magenta-alt)))
+ `(lsp-face-semhl-type-enum ((,class :foreground ,magenta-alt)))
+ `(lsp-face-semhl-type-primitive ((,class :inherit modus-themes-slant :foreground ,magenta-alt)))
+ `(lsp-face-semhl-type-template ((,class :inherit modus-themes-slant :foreground ,magenta-alt)))
+ `(lsp-face-semhl-type-typedef ((,class :inherit modus-themes-slant :foreground ,magenta-alt)))
+ `(lsp-face-semhl-variable ((,class :foreground ,cyan)))
+ `(lsp-face-semhl-variable-local ((,class :foreground ,cyan)))
+ `(lsp-face-semhl-variable-parameter ((,class :foreground ,cyan-alt-other)))
+ `(lsp-lens-face ((,class :height 0.8 :foreground ,fg-alt)))
+ `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t)))
+ `(lsp-ui-doc-background ((,class :background ,bg-alt)))
+ `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header)))
+ `(lsp-ui-doc-url ((,class :inherit button)))
+ `(lsp-ui-peek-filename ((,class :foreground ,fg-special-warm)))
+ `(lsp-ui-peek-footer ((,class :background ,bg-header :foreground ,fg-header)))
+ `(lsp-ui-peek-header ((,class :background ,bg-header :foreground ,fg-header)))
+ `(lsp-ui-peek-highlight ((,class :inherit modus-themes-subtle-blue)))
+ `(lsp-ui-peek-line-number ((,class :inherit shadow)))
+ `(lsp-ui-peek-list ((,class :background ,bg-dim)))
+ `(lsp-ui-peek-peek ((,class :background ,bg-alt)))
+ `(lsp-ui-peek-selection ((,class :inherit modus-themes-subtle-cyan)))
+ `(lsp-ui-sideline-code-action ((,class :foreground ,yellow)))
+ `(lsp-ui-sideline-current-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-main)))
+ `(lsp-ui-sideline-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-alt)))
+ `(lsp-ui-sideline-symbol-info ((,class :inherit italic :height 0.99)))
+;;;;; macrostep
+ `(macrostep-compiler-macro-face ((,class :inherit italic)))
+ `(macrostep-expansion-highlight-face ((,class :background ,blue-nuanced-bg)))
+ `(macrostep-gensym-1 ((,class :inherit bold :foreground ,blue :box t)))
+ `(macrostep-gensym-2 ((,class :inherit bold :foreground ,green :box t)))
+ `(macrostep-gensym-3 ((,class :inherit bold :foreground ,yellow :box t)))
+ `(macrostep-gensym-4 ((,class :inherit bold :foreground ,red :box t)))
+ `(macrostep-gensym-5 ((,class :inherit bold :foreground ,magenta :box t)))
+ `(macrostep-macro-face ((,class :inherit button :foreground ,green-alt)))
+;;;;; magit
+ `(magit-bisect-bad ((,class :foreground ,red-alt-other)))
+ `(magit-bisect-good ((,class :foreground ,green-alt-other)))
+ `(magit-bisect-skip ((,class :foreground ,yellow-alt-other)))
+ `(magit-blame-date ((,class :foreground ,blue)))
+ `(magit-blame-dimmed ((,class :inherit (shadow modus-themes-reset-hard))))
+ `(magit-blame-hash ((,class :foreground ,fg-special-warm)))
+ `(magit-blame-heading ((,class :inherit modus-themes-reset-hard :background ,bg-alt :extend t)))
+ `(magit-blame-highlight ((,class :inherit modus-themes-nuanced-cyan)))
+ `(magit-blame-margin ((,class :inherit (magit-blame-highlight modus-themes-reset-hard))))
+ `(magit-blame-name ((,class :foreground ,magenta-alt-other)))
+ `(magit-blame-summary ((,class :foreground ,cyan-alt-other)))
+ `(magit-branch-current ((,class :foreground ,blue-alt-other :box t)))
+ `(magit-branch-local ((,class :foreground ,blue-alt)))
+ `(magit-branch-remote ((,class :foreground ,magenta-alt)))
+ `(magit-branch-remote-head ((,class :foreground ,magenta-alt-other :box t)))
+ `(magit-branch-upstream ((,class :inherit italic)))
+ `(magit-cherry-equivalent ((,class :background ,bg-main :foreground ,magenta-intense)))
+ `(magit-cherry-unmatched ((,class :background ,bg-main :foreground ,cyan-intense)))
+ ;; NOTE: here we break from the pattern of inheriting from the
+ ;; modus-themes-diff-* faces, though only for the standard actions,
+ ;; not the highlighted ones. This is because Magit's interaction
+ ;; model relies on highlighting the current diff hunk.
+ `(magit-diff-added ((,class ,@(modus-themes--diff
+ bg-main blue-alt-other
+ bg-diff-added fg-diff-added
+ green-nuanced-bg fg-diff-added
+ bg-diff-added-deuteran fg-diff-added-deuteran))))
+ `(magit-diff-added-highlight ((,class :inherit modus-themes-diff-focus-added)))
+ `(magit-diff-base ((,class ,@(modus-themes--diff
+ bg-main yellow
+ bg-diff-changed fg-diff-changed
+ yellow-nuanced-bg fg-diff-changed))))
+ `(magit-diff-base-highlight ((,class :inherit modus-themes-diff-focus-changed)))
+ `(magit-diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list :foreground fg-unfocused)))))
+ `(magit-diff-context-highlight ((,class ,@(modus-themes--diff
+ bg-dim fg-dim
+ bg-inactive fg-inactive
+ bg-dim fg-alt
+ bg-dim fg-alt))))
+ `(magit-diff-file-heading ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(magit-diff-file-heading-highlight ((,class :inherit (modus-themes-special-cold bold))))
+ `(magit-diff-file-heading-selection ((,class :inherit modus-themes-refine-cyan)))
+ ;; NOTE: here we break from the pattern of inheriting from the
+ ;; modus-themes-diff-* faces.
+ `(magit-diff-hunk-heading ((,class :inherit bold
+ ,@(modus-themes--diff
+ bg-alt fg-alt
+ bg-active fg-inactive
+ bg-inactive fg-inactive
+ bg-inactive fg-inactive
+ t))))
+ `(magit-diff-hunk-heading-highlight
+ ((,class :inherit bold
+ :background ,@(modus-themes--diff-deuteran bg-active bg-diff-heading)
+ :foreground ,@(modus-themes--diff-deuteran fg-main fg-diff-heading))))
+ `(magit-diff-hunk-heading-selection ((,class :inherit modus-themes-refine-blue)))
+ `(magit-diff-hunk-region ((,class :inherit bold)))
+ `(magit-diff-lines-boundary ((,class :background ,fg-main)))
+ `(magit-diff-lines-heading ((,class :inherit modus-themes-refine-magenta)))
+ `(magit-diff-removed ((,class ,@(modus-themes--diff
+ bg-main red
+ bg-diff-removed fg-diff-removed
+ red-nuanced-bg fg-diff-removed))))
+ `(magit-diff-removed-highlight ((,class :inherit modus-themes-diff-focus-removed)))
+ `(magit-diffstat-added ((,class :foreground ,@(modus-themes--diff-deuteran blue green))))
+ `(magit-diffstat-removed ((,class :foreground ,red)))
+ `(magit-dimmed ((,class :foreground ,fg-unfocused)))
+ `(magit-filename ((,class :foreground ,fg-special-cold)))
+ `(magit-hash ((,class :inherit shadow)))
+ `(magit-head ((,class :inherit magit-branch-local)))
+ `(magit-header-line ((,class :inherit bold :foreground ,magenta-active)))
+ `(magit-header-line-key ((,class :inherit modus-themes-key-binding)))
+ `(magit-header-line-log-select ((,class :inherit bold :foreground ,fg-main)))
+ `(magit-keyword ((,class :foreground ,magenta)))
+ `(magit-keyword-squash ((,class :inherit bold :foreground ,yellow-alt-other)))
+ `(magit-log-author ((,class :foreground ,cyan)))
+ `(magit-log-date ((,class :inherit shadow)))
+ `(magit-log-graph ((,class :foreground ,fg-dim)))
+ `(magit-mode-line-process ((,class :inherit bold :foreground ,blue-active)))
+ `(magit-mode-line-process-error ((,class :inherit bold :foreground ,red-active)))
+ `(magit-process-ng ((,class :inherit error)))
+ `(magit-process-ok ((,class :inherit success)))
+ `(magit-reflog-amend ((,class :background ,bg-main :foreground ,magenta-intense)))
+ `(magit-reflog-checkout ((,class :background ,bg-main :foreground ,blue-intense)))
+ `(magit-reflog-cherry-pick ((,class :background ,bg-main :foreground ,green-intense)))
+ `(magit-reflog-commit ((,class :background ,bg-main :foreground ,green-intense)))
+ `(magit-reflog-merge ((,class :background ,bg-main :foreground ,green-intense)))
+ `(magit-reflog-other ((,class :background ,bg-main :foreground ,cyan-intense)))
+ `(magit-reflog-rebase ((,class :background ,bg-main :foreground ,magenta-intense)))
+ `(magit-reflog-remote ((,class :background ,bg-main :foreground ,cyan-intense)))
+ `(magit-reflog-reset ((,class :background ,bg-main :foreground ,red-intense)))
+ `(magit-refname ((,class :inherit shadow)))
+ `(magit-refname-pullreq ((,class :inherit shadow)))
+ `(magit-refname-stash ((,class :inherit shadow)))
+ `(magit-refname-wip ((,class :inherit shadow)))
+ `(magit-section ((,class :background ,bg-dim :foreground ,fg-main)))
+ `(magit-section-heading ((,class :inherit bold :foreground ,cyan)))
+ `(magit-section-heading-selection ((,class :inherit (modus-themes-refine-cyan bold))))
+ `(magit-section-highlight ((,class :background ,bg-alt)))
+ `(magit-sequence-done ((,class :foreground ,@(modus-themes--success-deuteran
+ blue
+ green))))
+ `(magit-sequence-drop ((,class :foreground ,red-alt)))
+ `(magit-sequence-exec ((,class :foreground ,magenta-alt)))
+ `(magit-sequence-head ((,class :foreground ,cyan-alt)))
+ `(magit-sequence-onto ((,class :inherit shadow)))
+ `(magit-sequence-part ((,class :foreground ,yellow-alt)))
+ `(magit-sequence-pick ((,class :foreground ,blue-alt)))
+ `(magit-sequence-stop ((,class :foreground ,red)))
+ `(magit-signature-bad ((,class :inherit bold :foreground ,red)))
+ `(magit-signature-error ((,class :foreground ,red-alt)))
+ `(magit-signature-expired ((,class :foreground ,yellow)))
+ `(magit-signature-expired-key ((,class :foreground ,yellow)))
+ `(magit-signature-good ((,class :foreground ,@(modus-themes--success-deuteran
+ blue
+ green))))
+ `(magit-signature-revoked ((,class :foreground ,magenta)))
+ `(magit-signature-untrusted ((,class :foreground ,cyan)))
+ `(magit-tag ((,class :foreground ,yellow-alt-other)))
+;;;;; magit-imerge
+ `(magit-imerge-overriding-value ((,class :inherit bold :foreground ,red-alt)))
+;;;;; make-mode (makefiles)
+ `(makefile-makepp-perl ((,class :background ,cyan-nuanced-bg)))
+ `(makefile-space ((,class :background ,magenta-nuanced-bg)))
+;;;;; man
+ `(Man-overstrike ((,class :inherit bold :foreground ,magenta)))
+ `(Man-reverse ((,class :inherit modus-themes-subtle-magenta)))
+ `(Man-underline ((,class :foreground ,cyan :underline t)))
+;;;;; marginalia
+ `(marginalia-archive ((,class :foreground ,green-nuanced-fg)))
+ `(marginalia-date ((,class :foreground ,blue-nuanced-fg)))
+ `(marginalia-char ((,class :foreground ,red-active)))
+ `(marginalia-documentation ((,class :foreground ,fg-special-cold :inherit modus-themes-slant)))
+ `(marginalia-file-modes ((,class :inherit shadow)))
+ `(marginalia-file-name ((,class :foreground ,fg-special-mild)))
+ `(marginalia-file-owner ((,class :foreground ,red-nuanced-fg)))
+ ;; Here we make an exception of not applying the bespoke
+ ;; `modus-themes-key-binding' for two reasons: (1) completion
+ ;; highlights can be fairly intense, so we do not want more
+ ;; components to compete with them for attention, (2) the
+ ;; `marginalia-key' may not be used for key bindings specifically,
+ ;; so we might end up applying styles in places we should not.
+ `(marginalia-key ((,class :foreground ,magenta-active)))
+ `(marginalia-mode ((,class :foreground ,cyan-active)))
+ `(marginalia-modified ((,class :foreground ,yellow-active)))
+ `(marginalia-number ((,class :foreground ,blue-active)))
+ `(marginalia-size ((,class :foreground ,green-active)))
+ `(marginalia-type ((,class :foreground ,fg-special-warm)))
+ `(marginalia-variable ((,class :foreground ,yellow-nuanced-fg)))
+ `(marginalia-version ((,class :foreground ,cyan-active)))
+;;;;; markdown-mode
+ `(markdown-blockquote-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(markdown-bold-face ((,class :inherit bold)))
+ `(markdown-code-face ((,class :inherit modus-themes-fixed-pitch :background ,bg-dim :extend t)))
+ `(markdown-comment-face ((,class :inherit font-lock-comment-face)))
+ `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt)))
+ `(markdown-footnote-text-face ((,class :inherit modus-themes-slant :foreground ,fg-main)))
+ `(markdown-gfm-checkbox-face ((,class :foreground ,cyan-alt-other)))
+ `(markdown-header-delimiter-face ((,class :inherit modus-themes-bold :foreground ,fg-dim)))
+ `(markdown-header-face ((t nil)))
+ `(markdown-header-face-1 ((,class :inherit modus-themes-heading-1)))
+ `(markdown-header-face-2 ((,class :inherit modus-themes-heading-2)))
+ `(markdown-header-face-3 ((,class :inherit modus-themes-heading-3)))
+ `(markdown-header-face-4 ((,class :inherit modus-themes-heading-4)))
+ `(markdown-header-face-5 ((,class :inherit modus-themes-heading-5)))
+ `(markdown-header-face-6 ((,class :inherit modus-themes-heading-6)))
+ `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(markdown-html-attr-name-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,cyan)))
+ `(markdown-html-attr-value-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,blue)))
+ `(markdown-html-entity-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,cyan)))
+ `(markdown-html-tag-delimiter-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,fg-special-mild)))
+ `(markdown-html-tag-name-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,magenta-alt)))
+ `(markdown-inline-code-face ((,class :inherit modus-themes-fixed-pitch
+ :background ,bg-alt :foreground ,fg-special-calm)))
+ `(markdown-italic-face ((,class :inherit italic :foreground ,fg-special-cold)))
+ `(markdown-language-info-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,fg-special-cold)))
+ `(markdown-language-keyword-face ((,class :inherit modus-themes-fixed-pitch
+ :background ,bg-alt
+ :foreground ,fg-alt)))
+ `(markdown-line-break-face ((,class :inherit modus-themes-refine-cyan :underline t)))
+ `(markdown-link-face ((,class :inherit button)))
+ `(markdown-link-title-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(markdown-list-face ((,class :foreground ,fg-dim)))
+ `(markdown-markup-face ((,class :inherit shadow)))
+ `(markdown-math-face ((,class :foreground ,magenta-alt-other)))
+ `(markdown-metadata-key-face ((,class :foreground ,cyan-alt-other)))
+ `(markdown-metadata-value-face ((,class :foreground ,blue-alt)))
+ `(markdown-missing-link-face ((,class :inherit bold :foreground ,yellow)))
+ `(markdown-plain-url-face ((,class :inherit markdown-link-face)))
+ `(markdown-pre-face ((,class :inherit markdown-code-face :foreground ,fg-special-mild)))
+ `(markdown-reference-face ((,class :inherit markdown-markup-face)))
+ `(markdown-strike-through-face ((,class :strike-through t)))
+ `(markdown-table-face ((,class :inherit modus-themes-fixed-pitch
+ :foreground ,fg-special-cold)))
+ `(markdown-url-face ((,class :foreground ,blue-alt)))
+;;;;; markup-faces (`adoc-mode')
+ `(markup-attribute-face ((,class :inherit (italic markup-meta-face))))
+ `(markup-bold-face ((,class :inherit bold :foreground ,red-nuanced-fg)))
+ `(markup-code-face ((,class :foreground ,magenta)))
+ `(markup-comment-face ((,class :inherit font-lock-comment-face)))
+ `(markup-complex-replacement-face ((,class :background ,magenta-nuanced-bg
+ :foreground ,magenta-alt-other
+ :underline ,magenta-alt-other)))
+ `(markup-emphasis-face ((,class :inherit markup-italic-face)))
+ `(markup-error-face ((,class :inherit error)))
+ `(markup-gen-face ((,class :foreground ,magenta-alt)))
+ `(markup-internal-reference-face ((,class :foreground ,fg-alt :underline ,bg-region)))
+ `(markup-italic-face ((,class :inherit italic :foreground ,fg-special-cold)))
+ `(markup-list-face ((,class :inherit modus-themes-special-cold)))
+ `(markup-meta-face ((,class :inherit shadow)))
+ `(markup-meta-hide-face ((,class :foreground "gray50")))
+ `(markup-reference-face ((,class :foreground ,blue-alt :underline ,bg-region)))
+ `(markup-replacement-face ((,class :inherit fixed-pitch :foreground ,red-alt)))
+ `(markup-secondary-text-face ((,class :height 0.9 :foreground ,cyan-alt-other)))
+ `(markup-small-face ((,class :inherit markup-gen-face :height 0.9)))
+ `(markup-strong-face ((,class :inherit markup-bold-face)))
+ `(markup-subscript-face ((,class :height 0.9 :foreground ,magenta-alt-other)))
+ `(markup-superscript-face ((,class :height 0.9 :foreground ,magenta-alt-other)))
+ `(markup-table-cell-face ((,class :inherit modus-themes-subtle-neutral)))
+ `(markup-table-face ((,class :inherit modus-themes-subtle-neutral)))
+ `(markup-table-row-face ((,class :inherit modus-themes-special-cold)))
+ `(markup-title-0-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale modus-themes-scale-title))))
+ `(markup-title-1-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale modus-themes-scale-1))))
+ `(markup-title-2-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale modus-themes-scale-2))))
+ `(markup-title-3-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale modus-themes-scale-3))))
+ `(markup-title-4-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(markup-title-5-face ((,class :inherit (bold modus-themes-variable-pitch)
+ :foreground ,blue-nuanced-fg)))
+ `(markup-verbatim-face ((,class :background ,bg-alt)))
+;;;;; mentor
+ `(mentor-download-message ((,class :foreground ,fg-special-warm)))
+ `(mentor-download-name ((,class :foreground ,fg-special-cold)))
+ `(mentor-download-progress ((,class :foreground ,blue-alt-other)))
+ `(mentor-download-size ((,class :foreground ,magenta-alt-other)))
+ `(mentor-download-speed-down ((,class :foreground ,cyan-alt)))
+ `(mentor-download-speed-up ((,class :foreground ,red-alt)))
+ `(mentor-download-state ((,class :foreground ,yellow-alt)))
+ `(mentor-highlight-face ((,class :inherit modus-themes-subtle-blue)))
+ `(mentor-tracker-name ((,class :foreground ,magenta-alt)))
+;;;;; messages
+ `(message-cited-text-1 ((,class ,@(modus-themes--mail-cite blue-faint fg-alt))))
+ `(message-cited-text-2 ((,class ,@(modus-themes--mail-cite green-faint fg-comment-yellow))))
+ `(message-cited-text-3 ((,class ,@(modus-themes--mail-cite red-faint fg-special-cold))))
+ `(message-cited-text-4 ((,class ,@(modus-themes--mail-cite yellow-faint fg-special-calm))))
+ `(message-header-cc ((,class :foreground ,blue-alt-other)))
+ `(message-header-name ((,class :inherit bold :foreground ,cyan)))
+ `(message-header-newsgroups ((,class :inherit message-header-other)))
+ `(message-header-other ((,class :foreground ,fg-special-calm)))
+ `(message-header-subject ((,class :inherit bold :foreground ,magenta-alt)))
+ `(message-header-to ((,class :inherit bold :foreground ,magenta-alt-other)))
+ `(message-header-xheader ((,class :foreground ,blue-alt)))
+ `(message-mml ((,class :foreground ,cyan-alt-other)))
+ `(message-separator ((,class :inherit modus-themes-intense-neutral)))
+;;;;; minibuffer-line
+ `(minibuffer-line ((,class :foreground ,fg-main)))
+;;;;; minimap
+ `(minimap-active-region-background ((,class :background ,bg-active)))
+ `(minimap-current-line-face ((,class :background ,cyan-intense-bg :foreground ,fg-main)))
+;;;;; mmm-mode
+ `(mmm-cleanup-submode-face ((,class :background ,yellow-nuanced-bg)))
+ `(mmm-code-submode-face ((,class :background ,bg-alt)))
+ `(mmm-comment-submode-face ((,class :background ,blue-nuanced-bg)))
+ `(mmm-declaration-submode-face ((,class :background ,cyan-nuanced-bg)))
+ `(mmm-default-submode-face ((,class :background ,bg-dim)))
+ `(mmm-init-submode-face ((,class :background ,magenta-nuanced-bg)))
+ `(mmm-output-submode-face ((,class :background ,red-nuanced-bg)))
+ `(mmm-special-submode-face ((,class :background ,green-nuanced-bg)))
+;;;;; mode-line
+ `(mode-line ((,class ,@(modus-themes--variable-pitch-ui)
+ ,@(modus-themes--mode-line-attrs
+ fg-active bg-active
+ fg-dim bg-active
+ fg-main bg-active-accent
+ fg-alt bg-active
+ 'alt-style nil bg-main))))
+ `(mode-line-buffer-id ((,class :inherit bold)))
+ `(mode-line-emphasis ((,class :inherit bold :foreground ,blue-active)))
+ `(mode-line-highlight ((,class :inherit modus-themes-active-blue :box (:line-width -1 :style pressed-button))))
+ `(mode-line-inactive ((,class ,@(modus-themes--variable-pitch-ui)
+ ,@(modus-themes--mode-line-attrs
+ fg-inactive bg-inactive
+ fg-alt bg-dim
+ fg-inactive bg-inactive
+ bg-region bg-active))))
+;;;;; mood-line
+ `(mood-line-modified ((,class :foreground ,magenta-active)))
+ `(mood-line-status-error ((,class :inherit bold :foreground ,red-active)))
+ `(mood-line-status-info ((,class :foreground ,cyan-active)))
+ `(mood-line-status-neutral ((,class :foreground ,blue-active)))
+ `(mood-line-status-success ((,class :foreground ,@(modus-themes--success-deuteran
+ blue-active
+ green-active))))
+ `(mood-line-status-warning ((,class :inherit bold :foreground ,yellow-active)))
+ `(mood-line-unimportant ((,class :foreground ,fg-inactive)))
+;;;;; mpdel
+ `(mpdel-browser-directory-face ((,class :foreground ,blue)))
+ `(mpdel-playlist-current-song-face ((,class :inherit bold :foreground ,blue-alt-other)))
+;;;;; mu4e
+ `(mu4e-attach-number-face ((,class :inherit bold :foreground ,fg-dim)))
+ `(mu4e-cited-1-face ((,class :inherit message-cited-text-1)))
+ `(mu4e-cited-2-face ((,class :inherit message-cited-text-2)))
+ `(mu4e-cited-3-face ((,class :inherit message-cited-text-3)))
+ `(mu4e-cited-4-face ((,class :inherit message-cited-text-4)))
+ `(mu4e-cited-5-face ((,class :inherit message-cited-text-1)))
+ `(mu4e-cited-6-face ((,class :inherit message-cited-text-2)))
+ `(mu4e-cited-7-face ((,class :inherit message-cited-text-3)))
+ `(mu4e-compose-header-face ((,class :inherit mu4e-compose-separator-face)))
+ `(mu4e-compose-separator-face ((,class :inherit modus-themes-intense-neutral)))
+ `(mu4e-contact-face ((,class :inherit message-header-to)))
+ `(mu4e-context-face ((,class :foreground ,blue-active)))
+ `(mu4e-draft-face ((,class :foreground ,magenta-alt)))
+ `(mu4e-flagged-face ((,class :foreground ,red-alt)))
+ `(mu4e-footer-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(mu4e-forwarded-face ((,class :foreground ,magenta-alt-other)))
+ `(mu4e-header-face ((,class :inherit shadow)))
+ `(mu4e-header-highlight-face ((,class :inherit modus-themes-hl-line)))
+ `(mu4e-header-key-face ((,class :inherit message-header-name)))
+ `(mu4e-header-marks-face ((,class :inherit mu4e-special-header-value-face)))
+ `(mu4e-header-title-face ((,class :foreground ,fg-special-mild)))
+ `(mu4e-header-value-face ((,class :inherit message-header-other)))
+ `(mu4e-highlight-face ((,class :inherit modus-themes-key-binding)))
+ `(mu4e-link-face ((,class :inherit button)))
+ `(mu4e-modeline-face ((,class :foreground ,magenta-active)))
+ `(mu4e-moved-face ((,class :inherit modus-themes-slant :foreground ,yellow)))
+ `(mu4e-ok-face ((,class :inherit bold :foreground ,green)))
+ `(mu4e-region-code ((,class :inherit modus-themes-special-calm)))
+ `(mu4e-replied-face ((,class :foreground ,blue)))
+ `(mu4e-special-header-value-face ((,class :inherit message-header-subject)))
+ `(mu4e-system-face ((,class :inherit modus-themes-slant :foreground ,fg-mark-del)))
+ `(mu4e-title-face ((,class :foreground ,fg-main)))
+ `(mu4e-trashed-face ((,class :foreground ,red)))
+ `(mu4e-unread-face ((,class :inherit bold)))
+ `(mu4e-url-number-face ((,class :foreground ,fg-alt)))
+ `(mu4e-view-body-face ((,class :foreground ,fg-main)))
+ `(mu4e-warning-face ((,class :inherit warning)))
+;;;;; mu4e-conversation
+ `(mu4e-conversation-header ((,class :inherit modus-themes-special-cold)))
+ `(mu4e-conversation-sender-1 ((,class :foreground ,fg-special-warm)))
+ `(mu4e-conversation-sender-2 ((,class :foreground ,fg-special-cold)))
+ `(mu4e-conversation-sender-3 ((,class :foreground ,fg-special-mild)))
+ `(mu4e-conversation-sender-4 ((,class :inherit shadow)))
+ `(mu4e-conversation-sender-5 ((,class :foreground ,yellow-refine-fg)))
+ `(mu4e-conversation-sender-6 ((,class :foreground ,cyan-refine-fg)))
+ `(mu4e-conversation-sender-7 ((,class :foreground ,green-refine-fg)))
+ `(mu4e-conversation-sender-8 ((,class :foreground ,blue-refine-fg)))
+ `(mu4e-conversation-sender-me ((,class :foreground ,fg-main)))
+ `(mu4e-conversation-unread ((,class :inherit bold)))
+;;;;; multiple-cursors
+ `(mc/cursor-bar-face ((,class :height 1 :background ,fg-main)))
+ `(mc/cursor-face ((,class :inverse-video t)))
+ `(mc/region-face ((,class :inherit region)))
+;;;;; neotree
+ `(neo-banner-face ((,class :foreground ,magenta)))
+ `(neo-button-face ((,class :inherit button)))
+ `(neo-dir-link-face ((,class :inherit bold :foreground ,blue)))
+ `(neo-expand-btn-face ((,class :foreground ,cyan)))
+ `(neo-file-link-face ((,class :foreground ,fg-main)))
+ `(neo-header-face ((,class :inherit bold :foreground ,fg-main)))
+ `(neo-root-dir-face ((,class :inherit bold :foreground ,cyan-alt)))
+ `(neo-vc-added-face ((,class :foreground ,@(modus-themes--diff-deuteran blue green))))
+ `(neo-vc-conflict-face ((,class :inherit bold :foreground ,red)))
+ `(neo-vc-default-face ((,class :foreground ,fg-main)))
+ `(neo-vc-edited-face ((,class :foreground ,yellow)))
+ `(neo-vc-ignored-face ((,class :foreground ,fg-inactive)))
+ `(neo-vc-missing-face ((,class :foreground ,red-alt)))
+ `(neo-vc-needs-merge-face ((,class :foreground ,magenta-alt)))
+ `(neo-vc-needs-update-face ((,class :underline t)))
+ `(neo-vc-removed-face ((,class :strike-through t)))
+ `(neo-vc-unlocked-changes-face ((,class :inherit modus-themes-refine-blue)))
+ `(neo-vc-up-to-date-face ((,class :inherit shadow)))
+ `(neo-vc-user-face ((,class :foreground ,magenta)))
+;;;;; no-emoji
+ `(no-emoji ((,class :foreground ,cyan)))
+;;;;; notmuch
+ `(notmuch-crypto-decryption ((,class :inherit (shadow bold))))
+ `(notmuch-crypto-part-header ((,class :foreground ,magenta-alt-other)))
+ `(notmuch-crypto-signature-bad ((,class :inherit error)))
+ `(notmuch-crypto-signature-good ((,class :inherit success)))
+ `(notmuch-crypto-signature-good-key ((,class :inherit bold :foreground ,cyan)))
+ `(notmuch-crypto-signature-unknown ((,class :inherit warning)))
+ `(notmuch-hello-logo-background ((,class :background "gray50")))
+ `(notmuch-message-summary-face ((,class :inherit (bold modus-themes-nuanced-cyan))))
+ `(notmuch-search-count ((,class :inherit shadow)))
+ `(notmuch-search-date ((,class :foreground ,cyan)))
+ `(notmuch-search-flagged-face ((,class :foreground ,red-alt)))
+ `(notmuch-search-matching-authors ((,class :foreground ,fg-special-cold)))
+ `(notmuch-search-non-matching-authors ((,class :inherit shadow)))
+ `(notmuch-search-subject ((,class :foreground ,fg-main)))
+ `(notmuch-search-unread-face ((,class :inherit bold)))
+ `(notmuch-tag-added ((,class :underline ,blue)))
+ `(notmuch-tag-deleted ((,class :strike-through ,red)))
+ `(notmuch-tag-face ((,class :foreground ,blue)))
+ `(notmuch-tag-flagged ((,class :foreground ,red-alt)))
+ `(notmuch-tag-unread ((,class :foreground ,magenta-alt)))
+ `(notmuch-tree-match-author-face ((,class :inherit notmuch-search-matching-authors)))
+ `(notmuch-tree-match-date-face ((,class :inherit notmuch-search-date)))
+ `(notmuch-tree-match-face ((,class :foreground ,fg-main)))
+ `(notmuch-tree-match-tag-face ((,class :inherit notmuch-tag-face)))
+ `(notmuch-tree-no-match-face ((,class :inherit shadow)))
+ `(notmuch-tree-no-match-date-face ((,class :inherit shadow)))
+ `(notmuch-wash-cited-text ((,class :inherit message-cited-text-1)))
+ `(notmuch-wash-toggle-button ((,class :background ,bg-alt :foreground ,fg-alt)))
+;;;;; num3-mode
+ `(num3-face-even ((,class :inherit bold :background ,bg-alt)))
+;;;;; nxml-mode
+ `(nxml-attribute-colon ((,class :foreground ,fg-main)))
+ `(nxml-attribute-local-name ((,class :inherit font-lock-variable-name-face)))
+ `(nxml-attribute-prefix ((,class :inherit font-lock-type-face)))
+ `(nxml-attribute-value ((,class :inherit font-lock-constant-face)))
+ `(nxml-cdata-section-CDATA ((,class :inherit error)))
+ `(nxml-cdata-section-delimiter ((,class :inherit error)))
+ `(nxml-char-ref-delimiter ((,class :foreground ,fg-special-mild)))
+ `(nxml-char-ref-number ((,class :inherit modus-themes-bold :foreground ,fg-special-mild)))
+ `(nxml-delimited-data ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(nxml-delimiter ((,class :foreground ,fg-dim)))
+ `(nxml-element-colon ((,class :foreground ,fg-main)))
+ `(nxml-element-local-name ((,class :inherit font-lock-function-name-face)))
+ `(nxml-element-prefix ((,class :inherit font-lock-builtin-face)))
+ `(nxml-entity-ref-delimiter ((,class :foreground ,fg-special-mild)))
+ `(nxml-entity-ref-name ((,class :inherit modus-themes-bold :foreground ,fg-special-mild)))
+ `(nxml-glyph ((,class :inherit modus-themes-intense-neutral)))
+ `(nxml-hash ((,class :inherit (bold font-lock-string-face))))
+ `(nxml-heading ((,class :inherit bold)))
+ `(nxml-name ((,class :inherit font-lock-builtin-face)))
+ `(nxml-namespace-attribute-colon ((,class :foreground ,fg-main)))
+ `(nxml-namespace-attribute-prefix ((,class :inherit font-lock-variable-name-face)))
+ `(nxml-processing-instruction-target ((,class :inherit font-lock-keyword-face)))
+ `(nxml-prolog-keyword ((,class :inherit font-lock-keyword-face)))
+ `(nxml-ref ((,class :inherit modus-themes-bold :foreground ,fg-special-mild)))
+ `(rng-error ((,class :inherit error)))
+;;;;; objed
+ `(objed-hl ((,class :background ,(if modus-themes-hl-line bg-hl-alt-intense bg-hl-alt))))
+ `(objed-mark ((,class :background ,bg-active)))
+ `(objed-mode-line ((,class :foreground ,cyan-active)))
+;;;;; orderless
+ `(orderless-match-face-0 ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ blue-alt-other blue-nuanced-bg
+ blue-refine-bg blue-refine-fg))))
+ `(orderless-match-face-1 ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ magenta-alt magenta-nuanced-bg
+ magenta-refine-bg magenta-refine-fg))))
+ `(orderless-match-face-2 ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ green green-nuanced-bg
+ green-refine-bg green-refine-fg))))
+ `(orderless-match-face-3 ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ yellow yellow-nuanced-bg
+ yellow-refine-bg yellow-refine-fg))))
+;;;;; org
+ `(org-agenda-calendar-event ((,class :inherit shadow)))
+ `(org-agenda-calendar-sexp ((,class :inherit (modus-themes-slant shadow))))
+ `(org-agenda-clocking ((,class :inherit modus-themes-special-cold :extend t)))
+ `(org-agenda-column-dateline ((,class :background ,bg-alt)))
+ `(org-agenda-current-time ((,class :foreground ,blue-alt-other-faint)))
+ `(org-agenda-date ((,class ,@(modus-themes--agenda-date cyan fg-main nil))))
+ `(org-agenda-date-today ((,class :background ,bg-active
+ ,@(modus-themes--agenda-date blue-active fg-main t cyan-active))))
+ `(org-agenda-date-weekend ((,class ,@(modus-themes--agenda-date cyan-alt-other fg-alt nil cyan fg-main))))
+ `(org-agenda-diary ((,class :inherit shadow)))
+ `(org-agenda-dimmed-todo-face ((,class :inherit shadow)))
+ `(org-agenda-done ((,class :foreground ,@(modus-themes--success-deuteran
+ blue-nuanced-fg
+ green-nuanced-fg))))
+ `(org-agenda-filter-category ((,class :inherit bold :foreground ,cyan-active)))
+ `(org-agenda-filter-effort ((,class :inherit bold :foreground ,cyan-active)))
+ `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,cyan-active)))
+ `(org-agenda-filter-tags ((,class :inherit bold :foreground ,cyan-active)))
+ `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim)))
+ `(org-agenda-structure ((,class ,@(modus-themes--agenda-structure blue-alt))))
+ `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(org-block ((,class :inherit modus-themes-fixed-pitch
+ ,@(modus-themes--org-block bg-dim fg-main))))
+ `(org-block-begin-line ((,class :inherit modus-themes-fixed-pitch
+ ,@(modus-themes--org-block-delim
+ bg-dim fg-special-cold
+ bg-alt fg-alt))))
+ `(org-block-end-line ((,class :inherit org-block-begin-line)))
+ `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active)
+ :background ,bg-inactive :foreground ,fg-active)))
+ `(org-checkbox-statistics-done ((,class :inherit org-done)))
+ `(org-checkbox-statistics-todo ((,class :inherit org-todo)))
+ `(org-clock-overlay ((,class :inherit modus-themes-special-cold)))
+ `(org-code ((,class :inherit modus-themes-fixed-pitch
+ :background ,bg-alt :foreground ,fg-special-mild)))
+ `(org-column ((,class :background ,bg-alt)))
+ `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt)))
+ `(org-date ((,class :inherit ,(if modus-themes-no-mixed-fonts
+ 'button
+ '(button fixed-pitch))
+ ,@(modus-themes--link-color
+ cyan cyan-faint))))
+ `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t)))
+ `(org-dispatcher-highlight ((,class :inherit (bold modus-themes-mark-alt))))
+ `(org-document-info ((,class :foreground ,fg-special-cold)))
+ `(org-document-info-keyword ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt)))
+ `(org-document-title ((,class :inherit (bold modus-themes-variable-pitch) :foreground ,fg-special-cold
+ ,@(modus-themes--scale modus-themes-scale-title))))
+ `(org-done ((,class :foreground ,@(modus-themes--success-deuteran blue green))))
+ `(org-drawer ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt)))
+ `(org-ellipsis (())) ; inherits from the heading's color
+ `(org-footnote ((,class :inherit button
+ ,@(modus-themes--link-color
+ blue-alt blue-alt-faint))))
+ `(org-formula ((,class :inherit modus-themes-fixed-pitch :foreground ,red-alt)))
+ `(org-habit-alert-face ((,class ,@(modus-themes--agenda-habit
+ yellow-graph-0-bg
+ yellow-graph-0-bg
+ yellow-graph-1-bg))))
+ `(org-habit-alert-future-face ((,class ,@(modus-themes--agenda-habit
+ yellow-graph-1-bg
+ yellow-graph-0-bg
+ yellow-graph-1-bg))))
+ `(org-habit-clear-face ((,class ,@(modus-themes--agenda-habit
+ blue-graph-0-bg
+ green-graph-1-bg
+ blue-graph-1-bg
+ blue-graph-1-bg))))
+ `(org-habit-clear-future-face ((,class ,@(modus-themes--agenda-habit
+ blue-graph-1-bg
+ green-graph-1-bg
+ blue-graph-1-bg
+ blue-graph-1-bg))))
+ `(org-habit-overdue-face ((,class ,@(modus-themes--agenda-habit
+ red-graph-0-bg
+ red-graph-0-bg
+ red-graph-1-bg))))
+ `(org-habit-overdue-future-face ((,class ,@(modus-themes--agenda-habit
+ red-graph-1-bg
+ red-graph-0-bg
+ red-graph-1-bg))))
+ `(org-habit-ready-face ((,class ,@(modus-themes--agenda-habit
+ green-graph-0-bg
+ green-graph-0-bg
+ green-graph-1-bg
+ blue-graph-0-bg))))
+ `(org-habit-ready-future-face ((,class ,@(modus-themes--agenda-habit
+ green-graph-1-bg
+ green-graph-0-bg
+ green-graph-1-bg
+ blue-graph-0-bg))))
+ `(org-headline-done ((,class :inherit modus-themes-variable-pitch
+ :foreground ,@(modus-themes--success-deuteran
+ blue-nuanced-fg
+ green-nuanced-fg))))
+ `(org-headline-todo ((,class :inherit modus-themes-variable-pitch :foreground ,red-nuanced-fg)))
+ `(org-hide ((,class :foreground ,bg-main)))
+ `(org-indent ((,class :inherit (fixed-pitch org-hide))))
+ `(org-latex-and-related ((,class :foreground ,magenta-refine-fg)))
+ `(org-level-1 ((,class :inherit modus-themes-heading-1)))
+ `(org-level-2 ((,class :inherit modus-themes-heading-2)))
+ `(org-level-3 ((,class :inherit modus-themes-heading-3)))
+ `(org-level-4 ((,class :inherit modus-themes-heading-4)))
+ `(org-level-5 ((,class :inherit modus-themes-heading-5)))
+ `(org-level-6 ((,class :inherit modus-themes-heading-6)))
+ `(org-level-7 ((,class :inherit modus-themes-heading-7)))
+ `(org-level-8 ((,class :inherit modus-themes-heading-8)))
+ `(org-link ((,class :inherit button)))
+ `(org-list-dt ((,class :inherit bold)))
+ `(org-macro ((,class :inherit modus-themes-fixed-pitch
+ :background ,cyan-nuanced-bg :foreground ,cyan-nuanced-fg)))
+ `(org-meta-line ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt)))
+ `(org-mode-line-clock ((,class :foreground ,fg-main)))
+ `(org-mode-line-clock-overrun ((,class :inherit bold :foreground ,red-active)))
+ `(org-priority ((,class :foreground ,magenta)))
+ `(org-property-value ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold)))
+ `(org-quote ((,class ,@(modus-themes--org-block bg-dim fg-special-cold fg-main))))
+ `(org-scheduled ((,class ,@(modus-themes--agenda-scheduled yellow-faint fg-special-warm magenta-alt))))
+ `(org-scheduled-previously ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm yellow-alt-other))))
+ `(org-scheduled-today ((,class ,@(modus-themes--agenda-scheduled yellow fg-special-warm magenta-alt-other))))
+ `(org-sexp-date ((,class :inherit org-date)))
+ `(org-special-keyword ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-alt)))
+ `(org-table ((,class :inherit modus-themes-fixed-pitch :foreground ,fg-special-cold)))
+ `(org-table-header ((,class :inherit (fixed-pitch modus-themes-intense-neutral))))
+ `(org-tag ((,class :foreground ,magenta-nuanced-fg)))
+ `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced-fg)))
+ `(org-target ((,class :underline t)))
+ `(org-time-grid ((,class :foreground ,fg-unfocused)))
+ `(org-todo ((,class :foreground ,red)))
+ `(org-upcoming-deadline ((,class :foreground ,red-alt-other)))
+ `(org-upcoming-distant-deadline ((,class :foreground ,red-faint)))
+ `(org-verbatim ((,class :inherit modus-themes-fixed-pitch
+ :background ,bg-alt :foreground ,fg-special-calm)))
+ `(org-verse ((,class :inherit org-quote)))
+ `(org-warning ((,class :inherit bold :foreground ,red-alt-other)))
+;;;;; org-journal
+ `(org-journal-calendar-entry-face ((,class :inherit modus-themes-slant :foreground ,yellow-alt-other)))
+ `(org-journal-calendar-scheduled-face ((,class :inherit modus-themes-slant :foreground ,red-alt-other)))
+ `(org-journal-highlight ((,class :foreground ,magenta-alt)))
+;;;;; org-noter
+ `(org-noter-no-notes-exist-face ((,class :inherit bold :foreground ,red-active)))
+ `(org-noter-notes-exist-face ((,class :inherit bold :foreground ,green-active)))
+;;;;; org-pomodoro
+ `(org-pomodoro-mode-line ((,class :foreground ,red-active)))
+ `(org-pomodoro-mode-line-break ((,class :foreground ,cyan-active)))
+ `(org-pomodoro-mode-line-overtime ((,class :inherit bold :foreground ,red-active)))
+;;;;; org-recur
+ `(org-recur ((,class :foreground ,magenta-active)))
+;;;;; org-roam
+ `(org-roam-link ((,class :inherit button
+ ,@(modus-themes--link-color
+ green green-faint))))
+ `(org-roam-link-current ((,class :inherit button
+ ,@(modus-themes--link-color
+ green-alt green-alt-faint))))
+ `(org-roam-link-invalid ((,class :inherit button
+ ,@(modus-themes--link-color
+ red red-faint))))
+ `(org-roam-link-shielded ((,class :inherit button
+ ,@(modus-themes--link-color
+ yellow yellow-faint))))
+ `(org-roam-tag ((,class :inherit italic :foreground ,fg-alt)))
+;;;;; org-superstar
+ `(org-superstar-item ((,class :foreground ,fg-main)))
+ `(org-superstar-leading ((,class :foreground ,fg-whitespace)))
+;;;;; org-table-sticky-header
+ `(org-table-sticky-header-face ((,class :inherit modus-themes-intense-neutral)))
+;;;;; org-tree-slide
+ `(org-tree-slide-header-overlay-face
+ ((,class :inherit (bold modus-themes-variable-pitch) :background ,bg-main
+ :foreground ,fg-special-cold :overline nil
+ ,@(modus-themes--scale modus-themes-scale-title))))
+;;;;; org-treescope
+ `(org-treescope-faces--markerinternal-midday ((,class :inherit modus-themes-intense-blue)))
+ `(org-treescope-faces--markerinternal-range ((,class :inherit modus-themes-special-mild)))
+;;;;; origami
+ `(origami-fold-header-face ((,class :background ,bg-dim :foreground ,fg-dim :box t)))
+ `(origami-fold-replacement-face ((,class :background ,bg-alt :foreground ,fg-alt)))
+;;;;; outline-mode
+ `(outline-1 ((,class :inherit modus-themes-heading-1)))
+ `(outline-2 ((,class :inherit modus-themes-heading-2)))
+ `(outline-3 ((,class :inherit modus-themes-heading-3)))
+ `(outline-4 ((,class :inherit modus-themes-heading-4)))
+ `(outline-5 ((,class :inherit modus-themes-heading-5)))
+ `(outline-6 ((,class :inherit modus-themes-heading-6)))
+ `(outline-7 ((,class :inherit modus-themes-heading-7)))
+ `(outline-8 ((,class :inherit modus-themes-heading-8)))
+;;;;; outline-minor-faces
+ `(outline-minor-0 (()))
+;;;;; package (M-x list-packages)
+ `(package-description ((,class :foreground ,fg-special-cold)))
+ `(package-help-section-name ((,class :inherit bold :foreground ,magenta-alt-other)))
+ `(package-name ((,class :inherit button)))
+ `(package-status-avail-obso ((,class :inherit bold :foreground ,red)))
+ `(package-status-available ((,class :foreground ,fg-special-mild)))
+ `(package-status-built-in ((,class :foreground ,magenta)))
+ `(package-status-dependency ((,class :foreground ,magenta-alt-other)))
+ `(package-status-disabled ((,class :inherit modus-themes-subtle-red)))
+ `(package-status-external ((,class :foreground ,cyan-alt-other)))
+ `(package-status-held ((,class :foreground ,yellow-alt)))
+ `(package-status-incompat ((,class :inherit bold :foreground ,yellow)))
+ `(package-status-installed ((,class :foreground ,fg-special-warm)))
+ `(package-status-new ((,class :inherit bold :foreground ,green)))
+ `(package-status-unsigned ((,class :inherit bold :foreground ,red-alt)))
+;;;;; page-break-lines
+ `(page-break-lines ((,class :inherit default :foreground ,fg-window-divider-outer)))
+;;;;; pandoc-mode
+ `(pandoc-citation-key-face ((,class :background ,bg-dim :foreground ,magenta-alt)))
+ `(pandoc-directive-@@-face ((,class :background ,bg-dim :foreground ,blue-alt-other)))
+ `(pandoc-directive-braces-face ((,class :foreground ,blue-alt-other)))
+ `(pandoc-directive-contents-face ((,class :foreground ,cyan-alt-other)))
+ `(pandoc-directive-type-face ((,class :foreground ,magenta)))
+;;;;; paradox
+ `(paradox-archive-face ((,class :foreground ,fg-special-mild)))
+ `(paradox-comment-face ((,class :inherit font-lock-comment-face)))
+ `(paradox-commit-tag-face ((,class :inherit modus-themes-refine-magenta :box t)))
+ `(paradox-description-face ((,class :foreground ,fg-special-cold)))
+ `(paradox-description-face-multiline ((,class :foreground ,fg-special-cold)))
+ `(paradox-download-face ((,class :inherit modus-themes-bold :foreground ,blue-alt-other)))
+ `(paradox-highlight-face ((,class :inherit modus-themes-bold :foreground ,cyan-alt-other)))
+ `(paradox-homepage-button-face ((,class :foreground ,magenta-alt-other :underline t)))
+ `(paradox-mode-line-face ((,class :inherit bold :foreground ,cyan-active)))
+ `(paradox-name-face ((,class :foreground ,blue :underline t)))
+ `(paradox-star-face ((,class :foreground ,magenta)))
+ `(paradox-starred-face ((,class :foreground ,magenta-alt)))
+;;;;; paren-face
+ `(parenthesis ((,class :foreground ,fg-unfocused)))
+;;;;; parrot
+ `(parrot-rotate-rotation-highlight-face ((,class :inherit modus-themes-refine-magenta)))
+;;;;; pass
+ `(pass-mode-directory-face ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(pass-mode-entry-face ((,class :background ,bg-main :foreground ,fg-main)))
+ `(pass-mode-header-face ((,class :foreground ,fg-special-warm)))
+;;;;; pdf-tools
+ `(pdf-links-read-link ((,class :background ,fg-main :foreground ,magenta-intense-bg :inherit bold))) ; Foreground is background and vice versa
+ `(pdf-occur-document-face ((,class :inherit shadow)))
+ `(pdf-occur-page-face ((,class :inherit shadow)))
+;;;;; persp-mode
+ `(persp-face-lighter-buffer-not-in-persp ((,class :inherit modus-themes-intense-red)))
+ `(persp-face-lighter-default ((,class :inherit bold :foreground ,blue-active)))
+ `(persp-face-lighter-nil-persp ((,class :inherit bold :foreground ,fg-active)))
+;;;;; perspective
+ `(persp-selected-face ((,class :inherit bold :foreground ,blue-active)))
+;;;;; phi-grep
+ `(phi-grep-heading-face ((,class :inherit bold :foreground ,red-alt
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(phi-grep-line-number-face ((,class :foreground ,fg-special-warm)))
+ `(phi-grep-match-face ((,class :inherit modus-themes-special-calm)))
+ `(phi-grep-modified-face ((,class :inherit modus-themes-refine-yellow)))
+ `(phi-grep-overlay-face ((,class :inherit modus-themes-refine-blue)))
+;;;;; phi-search
+ `(phi-replace-preview-face ((,class :inherit modus-themes-intense-magenta)))
+ `(phi-search-failpart-face ((,class :inherit modus-themes-refine-red)))
+ `(phi-search-match-face ((,class :inherit modus-themes-search-success-lazy)))
+ `(phi-search-selection-face ((,class :inherit (modus-themes-search-success bold))))
+;;;;; pkgbuild-mode
+ `(pkgbuild-error-face ((,class :inherit modus-themes-lang-error)))
+;;;;; pomidor
+ `(pomidor-break-face ((,class :foreground ,blue-alt-other)))
+ `(pomidor-overwork-face ((,class :foreground ,red-alt-other)))
+ `(pomidor-skip-face ((,class :inherit modus-themes-slant :foreground ,fg-alt)))
+ `(pomidor-work-face ((,class :foreground ,@(modus-themes--success-deuteran
+ blue-alt
+ green-alt-other))))
+;;;;; popup
+ `(popup-face ((,class :background ,bg-alt :foreground ,fg-main)))
+ `(popup-isearch-match ((,class :inherit (modus-themes-refine-cyan bold))))
+ `(popup-menu-mouse-face ((,class :inherit modus-themes-intense-blue)))
+ `(popup-menu-selection-face ((,class :inherit (modus-themes-subtle-cyan bold))))
+ `(popup-scroll-bar-background-face ((,class :background ,bg-active)))
+ `(popup-scroll-bar-foreground-face ((,class :foreground ,fg-active)))
+ `(popup-summary-face ((,class :background ,bg-active :foreground ,fg-inactive)))
+ `(popup-tip-face ((,class :inherit modus-themes-refine-yellow)))
+;;;;; powerline
+ `(powerline-active0 ((,class :background ,bg-main :foreground ,blue-faint :inverse-video t)))
+ `(powerline-active1 ((,class :background ,blue-nuanced-bg :foreground ,blue-nuanced-fg)))
+ `(powerline-active2 ((,class :background ,bg-active :foreground ,fg-active)))
+ `(powerline-inactive0 ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
+ `(powerline-inactive1 ((,class :background ,bg-dim :foreground ,fg-inactive)))
+ `(powerline-inactive2 ((,class :background ,bg-inactive :foreground ,fg-inactive)))
+;;;;; powerline-evil
+ `(powerline-evil-base-face ((,class :background ,fg-main :foreground ,bg-main)))
+ `(powerline-evil-emacs-face ((,class :inherit modus-themes-active-magenta)))
+ `(powerline-evil-insert-face ((,class :inherit modus-themes-active-green)))
+ `(powerline-evil-motion-face ((,class :inherit modus-themes-active-blue)))
+ `(powerline-evil-normal-face ((,class :background ,fg-alt :foreground ,bg-main)))
+ `(powerline-evil-operator-face ((,class :inherit modus-themes-active-yellow)))
+ `(powerline-evil-replace-face ((,class :inherit modus-themes-active-red)))
+ `(powerline-evil-visual-face ((,class :inherit modus-themes-active-cyan)))
+;;;;; proced
+ `(proced-mark ((,class :inherit modus-themes-mark-symbol)))
+ `(proced-marked ((,class :inherit modus-themes-mark-alt)))
+ `(proced-sort-header ((,class :inherit bold :foreground ,fg-special-calm :underline t)))
+;;;;; prodigy
+ `(prodigy-green-face ((,class :foreground ,green)))
+ `(prodigy-red-face ((,class :foreground ,red)))
+ `(prodigy-yellow-face ((,class :foreground ,yellow)))
+;;;;; pulse
+ `(pulse-highlight-start-face ((,class :background ,bg-active-accent :extend t)))
+;;;;; quick-peek
+ `(quick-peek-background-face ((,class :background ,bg-alt)))
+ `(quick-peek-border-face ((,class :background ,fg-window-divider-inner :height 1)))
+ `(quick-peek-padding-face ((,class :background ,bg-alt :height 0.15)))
+;;;;; racket-mode
+ `(racket-debug-break-face ((,class :inherit modus-themes-intense-red)))
+ `(racket-debug-locals-face ((,class :box (:line-width -1 :color nil)
+ :foreground ,green-alt-other)))
+ `(racket-debug-result-face ((,class :inherit bold :box (:line-width -1 :color nil)
+ :foreground ,green)))
+ `(racket-here-string-face ((,class :foreground ,blue-alt)))
+ `(racket-keyword-argument-face ((,class :foreground ,red-alt)))
+ `(racket-logger-config-face ((,class :inherit modus-themes-slant :foreground ,fg-alt)))
+ `(racket-logger-debug-face ((,class :foreground ,blue-alt-other)))
+ `(racket-logger-info-face ((,class :foreground ,fg-lang-note)))
+ `(racket-logger-topic-face ((,class :inherit modus-themes-slant :foreground ,magenta)))
+ `(racket-selfeval-face ((,class :foreground ,green-alt)))
+ `(racket-xp-error-face ((,class :inherit modus-themes-lang-error)))
+;;;;; rainbow-blocks
+ `(rainbow-blocks-depth-1-face ((,class :foreground ,magenta-alt-other)))
+ `(rainbow-blocks-depth-2-face ((,class :foreground ,blue)))
+ `(rainbow-blocks-depth-3-face ((,class :foreground ,magenta-alt)))
+ `(rainbow-blocks-depth-4-face ((,class :foreground ,green)))
+ `(rainbow-blocks-depth-5-face ((,class :foreground ,magenta)))
+ `(rainbow-blocks-depth-6-face ((,class :foreground ,cyan)))
+ `(rainbow-blocks-depth-7-face ((,class :foreground ,yellow)))
+ `(rainbow-blocks-depth-8-face ((,class :foreground ,cyan-alt)))
+ `(rainbow-blocks-depth-9-face ((,class :foreground ,red-alt)))
+ `(rainbow-blocks-unmatched-face ((,class :foreground ,red)))
+;;;;; rainbow-identifiers
+ `(rainbow-identifiers-identifier-1 ((,class :foreground ,green-alt-other)))
+ `(rainbow-identifiers-identifier-2 ((,class :foreground ,magenta-alt-other)))
+ `(rainbow-identifiers-identifier-3 ((,class :foreground ,cyan-alt-other)))
+ `(rainbow-identifiers-identifier-4 ((,class :foreground ,yellow-alt-other)))
+ `(rainbow-identifiers-identifier-5 ((,class :foreground ,blue-alt-other)))
+ `(rainbow-identifiers-identifier-6 ((,class :foreground ,green-alt)))
+ `(rainbow-identifiers-identifier-7 ((,class :foreground ,magenta-alt)))
+ `(rainbow-identifiers-identifier-8 ((,class :foreground ,cyan-alt)))
+ `(rainbow-identifiers-identifier-9 ((,class :foreground ,yellow-alt)))
+ `(rainbow-identifiers-identifier-10 ((,class :foreground ,green)))
+ `(rainbow-identifiers-identifier-11 ((,class :foreground ,magenta)))
+ `(rainbow-identifiers-identifier-12 ((,class :foreground ,cyan)))
+ `(rainbow-identifiers-identifier-13 ((,class :foreground ,yellow)))
+ `(rainbow-identifiers-identifier-14 ((,class :foreground ,blue-alt)))
+ `(rainbow-identifiers-identifier-15 ((,class :foreground ,red-alt)))
+;;;;; rainbow-delimiters
+ `(rainbow-delimiters-base-error-face ((,class :background ,red-subtle-bg :foreground ,fg-main)))
+ `(rainbow-delimiters-base-face ((,class :foreground ,fg-main)))
+ `(rainbow-delimiters-depth-1-face ((,class :foreground ,fg-main)))
+ `(rainbow-delimiters-depth-2-face ((,class :foreground ,magenta-intense)))
+ `(rainbow-delimiters-depth-3-face ((,class :foreground ,cyan-intense)))
+ `(rainbow-delimiters-depth-4-face ((,class :foreground ,orange-intense)))
+ `(rainbow-delimiters-depth-5-face ((,class :foreground ,purple-intense)))
+ `(rainbow-delimiters-depth-6-face ((,class :foreground ,green-intense)))
+ `(rainbow-delimiters-depth-7-face ((,class :foreground ,red-intense)))
+ `(rainbow-delimiters-depth-8-face ((,class :foreground ,blue-intense)))
+ `(rainbow-delimiters-depth-9-face ((,class :foreground ,yellow-intense)))
+ `(rainbow-delimiters-mismatched-face ((,class :inherit (bold modus-themes-refine-yellow))))
+ `(rainbow-delimiters-unmatched-face ((,class :inherit (bold modus-themes-refine-red))))
+;;;;; rcirc
+ `(rcirc-bright-nick ((,class :inherit bold :foreground ,magenta-alt)))
+ `(rcirc-dim-nick ((,class :inherit shadow)))
+ `(rcirc-my-nick ((,class :inherit bold :foreground ,magenta)))
+ `(rcirc-nick-in-message ((,class :foreground ,magenta-alt-other)))
+ `(rcirc-nick-in-message-full-line ((,class :inherit bold :foreground ,fg-special-mild)))
+ `(rcirc-other-nick ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(rcirc-prompt ((,class :inherit modus-themes-prompt)))
+ `(rcirc-server ((,class :foreground ,fg-unfocused)))
+ `(rcirc-timestamp ((,class :foreground ,blue-nuanced-fg)))
+ `(rcirc-url ((,class :foreground ,blue :underline t)))
+;;;;; recursion-indicator
+ `(recursion-indicator-general ((,class :foreground ,blue-active)))
+ `(recursion-indicator-minibuffer ((,class :foreground ,red-active)))
+;;;;; regexp-builder (re-builder)
+ `(reb-match-0 ((,class :inherit modus-themes-refine-cyan)))
+ `(reb-match-1 ((,class :inherit modus-themes-subtle-magenta)))
+ `(reb-match-2 ((,class :inherit modus-themes-subtle-green)))
+ `(reb-match-3 ((,class :inherit modus-themes-refine-yellow)))
+ `(reb-regexp-grouping-backslash ((,class :inherit font-lock-regexp-grouping-backslash)))
+ `(reb-regexp-grouping-construct ((,class :inherit font-lock-regexp-grouping-construct)))
+;;;;; rg (rg.el)
+ `(rg-column-number-face ((,class :foreground ,magenta-alt-other)))
+ `(rg-context-face ((,class :foreground ,fg-unfocused)))
+ `(rg-error-face ((,class :inherit bold :foreground ,red)))
+ `(rg-file-tag-face ((,class :foreground ,fg-special-cold)))
+ `(rg-filename-face ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(rg-line-number-face ((,class :foreground ,fg-special-warm)))
+ `(rg-literal-face ((,class :foreground ,blue-alt)))
+ `(rg-match-face ((,class :inherit modus-themes-special-calm)))
+ `(rg-regexp-face ((,class :foreground ,magenta-active)))
+ `(rg-toggle-off-face ((,class :inherit bold :foreground ,fg-inactive)))
+ `(rg-toggle-on-face ((,class :inherit bold :foreground ,cyan-active)))
+ `(rg-warning-face ((,class :inherit bold :foreground ,yellow)))
+;;;;; ripgrep
+ `(ripgrep-context-face ((,class :foreground ,fg-unfocused)))
+ `(ripgrep-error-face ((,class :inherit bold :foreground ,red)))
+ `(ripgrep-hit-face ((,class :foreground ,cyan)))
+ `(ripgrep-match-face ((,class :inherit modus-themes-special-calm)))
+;;;;; rmail
+ `(rmail-header-name ((,class :foreground ,cyan-alt-other)))
+ `(rmail-highlight ((,class :inherit bold :foreground ,magenta-alt)))
+;;;;; ruler-mode
+ `(ruler-mode-column-number ((,class :inherit ruler-mode-default :foreground ,fg-main)))
+ `(ruler-mode-comment-column ((,class :inherit ruler-mode-default :foreground ,red)))
+ `(ruler-mode-current-column ((,class :inherit ruler-mode-default :background ,blue-subtle-bg :foreground ,fg-main)))
+ `(ruler-mode-default ((,class :inherit default :background ,bg-alt :foreground ,fg-unfocused)))
+ `(ruler-mode-fill-column ((,class :inherit ruler-mode-default :foreground ,green)))
+ `(ruler-mode-fringes ((,class :inherit ruler-mode-default :foreground ,cyan)))
+ `(ruler-mode-goal-column ((,class :inherit ruler-mode-default :foreground ,blue)))
+ `(ruler-mode-margins ((,class :inherit ruler-mode-default :foreground ,bg-main)))
+ `(ruler-mode-pad ((,class :inherit ruler-mode-default :background ,bg-active :foreground ,fg-inactive)))
+ `(ruler-mode-tab-stop ((,class :inherit ruler-mode-default :foreground ,fg-special-warm)))
+;;;;; sallet
+ `(sallet-buffer-compressed ((,class :inherit italic :foreground ,yellow-nuanced-fg)))
+ `(sallet-buffer-default-directory ((,class :foreground ,cyan-nuanced-fg)))
+ `(sallet-buffer-directory ((,class :foreground ,blue-nuanced-fg)))
+ `(sallet-buffer-help ((,class :foreground ,fg-special-cold)))
+ `(sallet-buffer-modified ((,class :inherit italic :foreground ,yellow-alt-other)))
+ `(sallet-buffer-ordinary ((,class :foreground ,fg-main)))
+ `(sallet-buffer-read-only ((,class :foreground ,yellow-alt)))
+ `(sallet-buffer-size ((,class :foreground ,fg-special-calm)))
+ `(sallet-buffer-special ((,class :foreground ,magenta-alt-other)))
+ `(sallet-flx-match ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-cyan
+ 'modus-themes-refine-cyan
+ 'modus-themes-nuanced-cyan
+ cyan-alt-other))))
+ `(sallet-recentf-buffer-name ((,class :foreground ,blue-nuanced-fg)))
+ `(sallet-recentf-file-path ((,class :foreground ,fg-special-mild)))
+ `(sallet-regexp-match ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-magenta
+ 'modus-themes-refine-magenta
+ 'modus-themes-nuanced-magenta
+ magenta-alt-other))))
+ `(sallet-source-header ((,class :inherit bold :foreground ,red-alt
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(sallet-substring-match ((,class ,@(modus-themes--extra-completions
+ 'modus-themes-subtle-blue
+ 'modus-themes-refine-blue
+ 'modus-themes-nuanced-blue
+ blue-alt-other))))
+;;;;; selectrum
+ ;; NOTE 2021-02-22: The `selectrum-primary-highlight' and
+ ;; `selectrum-secondary-highlight' are deprecated upstream in favour
+ ;; of their selectrum-prescient counterparts. We shall remove those
+ ;; faces from the themes once we are certain that they are no longer
+ ;; relevant.
+ `(selectrum-current-candidate
+ ((,class :inherit bold :foreground ,fg-main
+ :background ,@(pcase modus-themes-completions
+ ('opinionated (list bg-active))
+ (_ (list bg-inactive))))))
+ `(selectrum-mouse-highlight ((,class :inherit highlight)))
+ `(selectrum-primary-highlight
+ ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ magenta-alt magenta-nuanced-bg
+ magenta-refine-bg magenta-refine-fg))))
+ `(selectrum-secondary-highlight
+ ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ cyan-alt-other cyan-nuanced-bg
+ cyan-refine-bg cyan-refine-fg))))
+ `(selectrum-quick-keys-highlight
+ ((,class :inherit modus-themes-refine-red)))
+ `(selectrum-quick-keys-match
+ ((,class :inherit (bold modus-themes-search-success))))
+;;;;; selectrum-prescient
+ `(selectrum-prescient-primary-highlight
+ ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ magenta-alt magenta-nuanced-bg
+ magenta-refine-bg magenta-refine-fg))))
+ `(selectrum-prescient-secondary-highlight
+ ((,class :inherit bold
+ ,@(modus-themes--standard-completions
+ cyan-alt-other cyan-nuanced-bg
+ cyan-refine-bg cyan-refine-fg))))
+;;;;; semantic
+ `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t)))
+ `(semantic-decoration-on-fileless-includes ((,class :inherit modus-themes-refine-green)))
+ `(semantic-decoration-on-private-members-face ((,class :inherit modus-themes-refine-cyan)))
+ `(semantic-decoration-on-protected-members-face ((,class :background ,bg-dim)))
+ `(semantic-decoration-on-unknown-includes ((,class :inherit modus-themes-refine-red)))
+ `(semantic-decoration-on-unparsed-includes ((,class :inherit modus-themes-refine-yellow)))
+ `(semantic-highlight-edits-face ((,class :background ,bg-alt)))
+ `(semantic-highlight-func-current-tag-face ((,class :background ,bg-alt)))
+ `(semantic-idle-symbol-highlight ((,class :inherit modus-themes-special-mild)))
+ `(semantic-tag-boundary-face ((,class :overline ,blue-intense)))
+ `(semantic-unmatched-syntax-face ((,class :underline ,fg-lang-error)))
+;;;;; sesman
+ `(sesman-browser-button-face ((,class :foreground ,blue-alt-other :underline t)))
+ `(sesman-browser-highligh-face ((,class :inherit modus-themes-subtle-blue)))
+ `(sesman-buffer-face ((,class :foreground ,magenta)))
+ `(sesman-directory-face ((,class :inherit bold :foreground ,blue)))
+ `(sesman-project-face ((,class :inherit bold :foreground ,magenta-alt-other)))
+;;;;; shell-script-mode
+ `(sh-heredoc ((,class :foreground ,blue-alt)))
+ `(sh-quoted-exec ((,class :inherit modus-themes-bold :foreground ,magenta-alt)))
+;;;;; shortdoc
+ `(shortdoc-heading ((,class :inherit modus-themes-pseudo-header)))
+ `(shortdoc-section (())) ; remove the default's variable-pitch style
+;;;;; show-paren-mode
+ `(show-paren-match ((,class ,@(modus-themes--paren bg-paren-match
+ bg-paren-match-intense)
+ :foreground ,fg-main)))
+ `(show-paren-match-expression ((,class :background ,bg-paren-expression)))
+ `(show-paren-mismatch ((,class :inherit modus-themes-intense-red)))
+;;;;; shr
+ `(shr-h1 ((,class :inherit modus-themes-heading-1)))
+ `(shr-h2 ((,class :inherit modus-themes-heading-2)))
+ `(shr-h3 ((,class :inherit modus-themes-heading-3)))
+ `(shr-h4 ((,class :inherit modus-themes-heading-4)))
+ `(shr-h5 ((,class :inherit modus-themes-heading-5)))
+ `(shr-h6 ((,class :inherit modus-themes-heading-6)))
+ `(shr-abbreviation ((,class :inherit modus-themes-lang-note)))
+ `(shr-selected-link ((,class :inherit modus-themes-subtle-red)))
+;;;;; side-notes
+ `(side-notes ((,class :background ,bg-dim :foreground ,fg-dim)))
+;;;;; sieve-mode
+ `(sieve-action-commands ((,class :inherit font-lock-builtin-face)))
+ `(sieve-control-commands ((,class :inherit font-lock-keyword-face)))
+ `(sieve-tagged-arguments ((,class :inherit font-lock-type-face)))
+ `(sieve-test-commands ((,class :inherit font-lock-function-name-face)))
+;;;;; skewer-mode
+ `(skewer-error-face ((,class :foreground ,red :underline t)))
+;;;;; smart-mode-line
+ `(sml/charging ((,class :foreground ,green-active)))
+ `(sml/discharging ((,class :foreground ,red-active)))
+ `(sml/filename ((,class :inherit bold :foreground ,blue-active)))
+ `(sml/folder ((,class :foreground ,fg-active)))
+ `(sml/git ((,class :inherit bold :foreground ,green-active)))
+ `(sml/global ((,class :foreground ,fg-active)))
+ `(sml/line-number ((,class :inherit sml/global)))
+ `(sml/minor-modes ((,class :inherit sml/global)))
+ `(sml/modes ((,class :inherit bold :foreground ,fg-active)))
+ `(sml/modified ((,class :inherit bold :foreground ,magenta-active)))
+ `(sml/mule-info ((,class :inherit sml/global)))
+ `(sml/name-filling ((,class :foreground ,yellow-active)))
+ `(sml/not-modified ((,class :inherit sml/global)))
+ `(sml/numbers-separator ((,class :inherit sml/global)))
+ `(sml/outside-modified ((,class :inherit modus-themes-intense-red)))
+ `(sml/position-percentage ((,class :inherit sml/global)))
+ `(sml/prefix ((,class :foreground ,green-active)))
+ `(sml/process ((,class :inherit sml/prefix)))
+ `(sml/projectile ((,class :inherit sml/git)))
+ `(sml/read-only ((,class :inherit bold :foreground ,cyan-active)))
+ `(sml/remote ((,class :inherit sml/global)))
+ `(sml/sudo ((,class :inherit modus-themes-subtle-red)))
+ `(sml/time ((,class :inherit sml/global)))
+ `(sml/vc ((,class :inherit sml/git)))
+ `(sml/vc-edited ((,class :inherit bold :foreground ,yellow-active)))
+;;;;; smartparens
+ `(sp-pair-overlay-face ((,class :inherit modus-themes-special-warm)))
+ `(sp-show-pair-enclosing ((,class :inherit modus-themes-special-mild)))
+ `(sp-show-pair-match-face ((,class ,@(modus-themes--paren bg-paren-match
+ bg-paren-match-intense)
+ :foreground ,fg-main)))
+ `(sp-show-pair-mismatch-face ((,class :inherit modus-themes-intense-red)))
+ `(sp-wrap-overlay-closing-pair ((,class :inherit sp-pair-overlay-face)))
+ `(sp-wrap-overlay-face ((,class :inherit sp-pair-overlay-face)))
+ `(sp-wrap-overlay-opening-pair ((,class :inherit sp-pair-overlay-face)))
+ `(sp-wrap-tag-overlay-face ((,class :inherit sp-pair-overlay-face)))
+;;;;; smerge
+ `(smerge-base ((,class :inherit modus-themes-diff-changed)))
+ `(smerge-lower ((,class :inherit modus-themes-diff-added)))
+ `(smerge-markers ((,class :inherit modus-themes-diff-heading)))
+ `(smerge-refined-added ((,class :inherit modus-themes-diff-refine-added)))
+ `(smerge-refined-changed (()))
+ `(smerge-refined-removed ((,class :inherit modus-themes-diff-refine-removed)))
+ `(smerge-upper ((,class :inherit modus-themes-diff-removed)))
+;;;;; solaire
+ `(solaire-default-face ((,class :inherit default :background ,bg-alt :foreground ,fg-dim)))
+ `(solaire-line-number-face ((,class :inherit solaire-default-face :foreground ,fg-unfocused)))
+ `(solaire-hl-line-face ((,class :background ,bg-active)))
+ `(solaire-org-hide-face ((,class :background ,bg-alt :foreground ,bg-alt)))
+;;;;; spaceline
+ `(spaceline-evil-emacs ((,class :inherit modus-themes-active-magenta)))
+ `(spaceline-evil-insert ((,class :inherit modus-themes-active-green)))
+ `(spaceline-evil-motion ((,class :inherit modus-themes-active-blue)))
+ `(spaceline-evil-normal ((,class :background ,fg-alt :foreground ,bg-alt)))
+ `(spaceline-evil-replace ((,class :inherit modus-themes-active-red)))
+ `(spaceline-evil-visual ((,class :inherit modus-themes-active-cyan)))
+ `(spaceline-flycheck-error ((,class :foreground ,red-active)))
+ `(spaceline-flycheck-info ((,class :foreground ,cyan-active)))
+ `(spaceline-flycheck-warning ((,class :foreground ,yellow-active)))
+ `(spaceline-highlight-face ((,class :inherit modus-themes-fringe-blue)))
+ `(spaceline-modified ((,class :inherit modus-themes-fringe-magenta)))
+ `(spaceline-python-venv ((,class :foreground ,magenta-active)))
+ `(spaceline-read-only ((,class :inherit modus-themes-fringe-red)))
+ `(spaceline-unmodified ((,class :inherit modus-themes-fringe-cyan)))
+;;;;; speedbar
+ `(speedbar-button-face ((,class :inherit button)))
+ `(speedbar-directory-face ((,class :inherit bold :foreground ,blue)))
+ `(speedbar-file-face ((,class :foreground ,fg-main)))
+ `(speedbar-highlight-face ((,class :inherit modus-themes-subtle-blue)))
+ `(speedbar-selected-face ((,class :inherit bold :foreground ,cyan)))
+ `(speedbar-separator-face ((,class :inherit modus-themes-intense-neutral)))
+ `(speedbar-tag-face ((,class :foreground ,yellow-alt-other)))
+;;;;; spell-fu
+ `(spell-fu-incorrect-face ((,class :inherit modus-themes-lang-error)))
+;;;;; spray
+ `(spray-accent-face ((,class :foreground ,red-intense)))
+ `(spray-base-face ((,class :inherit default :foreground ,fg-special-cold)))
+;;;;; stripes
+ `(stripes ((,class :inherit modus-themes-hl-line)))
+;;;;; success
+ `(suggest-heading ((,class :inherit bold :foreground ,yellow-alt-other)))
+;;;;; switch-window
+ `(switch-window-background ((,class :background ,bg-dim)))
+ `(switch-window-label ((,class :height 3.0 :foreground ,blue-intense)))
+;;;;; swiper
+ `(swiper-background-match-face-1 ((,class :inherit modus-themes-subtle-neutral)))
+ `(swiper-background-match-face-2 ((,class :inherit modus-themes-refine-cyan)))
+ `(swiper-background-match-face-3 ((,class :inherit modus-themes-refine-magenta)))
+ `(swiper-background-match-face-4 ((,class :inherit modus-themes-refine-yellow)))
+ `(swiper-line-face ((,class :inherit modus-themes-special-cold)))
+ `(swiper-match-face-1 ((,class :inherit (bold modus-themes-intense-neutral))))
+ `(swiper-match-face-2 ((,class :inherit (bold modus-themes-intense-green))))
+ `(swiper-match-face-3 ((,class :inherit (bold modus-themes-intense-blue))))
+ `(swiper-match-face-4 ((,class :inherit (bold modus-themes-intense-red))))
+;;;;; swoop
+ `(swoop-face-header-format-line ((,class :inherit bold :foreground ,red-alt
+ ,@(modus-themes--scale modus-themes-scale-3))))
+ `(swoop-face-line-buffer-name ((,class :inherit bold :foreground ,blue-alt
+ ,@(modus-themes--scale modus-themes-scale-4))))
+ `(swoop-face-line-number ((,class :foreground ,fg-special-warm)))
+ `(swoop-face-target-line ((,class :inherit modus-themes-intense-blue :extend t)))
+ `(swoop-face-target-words ((,class :inherit modus-themes-refine-cyan)))
+;;;;; sx
+ `(sx-inbox-item-type ((,class :foreground ,magenta-alt-other)))
+ `(sx-inbox-item-type-unread ((,class :inherit (sx-inbox-item-type bold))))
+ `(sx-question-list-answers ((,class :foreground ,green)))
+ `(sx-question-list-answers-accepted ((,class :box t :foreground ,green)))
+ `(sx-question-list-bounty ((,class :inherit bold :background ,bg-alt :foreground ,yellow)))
+ `(sx-question-list-date ((,class :foreground ,fg-special-cold)))
+ `(sx-question-list-favorite ((,class :inherit bold :foreground ,fg-special-warm)))
+ `(sx-question-list-parent ((,class :foreground ,fg-main)))
+ `(sx-question-list-read-question ((,class :inherit shadow)))
+ `(sx-question-list-score ((,class :foreground ,fg-special-mild)))
+ `(sx-question-list-score-upvoted ((,class :inherit (sx-question-list-score bold))))
+ `(sx-question-list-unread-question ((,class :inherit bold :foreground ,fg-main)))
+ `(sx-question-mode-accepted ((,class :inherit bold :height 1.3 :foreground ,green)))
+ `(sx-question-mode-closed ((,class :inherit modus-themes-active-yellow :box (:line-width 2 :color nil))))
+ `(sx-question-mode-closed-reason ((,class :box (:line-width 2 :color nil) :foreground ,fg-main)))
+ `(sx-question-mode-content-face ((,class :background ,bg-dim)))
+ `(sx-question-mode-date ((,class :foreground ,blue)))
+ `(sx-question-mode-header ((,class :inherit bold :foreground ,cyan)))
+ `(sx-question-mode-kbd-tag ((,class :inherit bold :height 0.9 :box (:line-width 3 :color ,fg-main :style released-button) :foreground ,fg-main)))
+ `(sx-question-mode-score ((,class :foreground ,fg-dim)))
+ `(sx-question-mode-score-downvoted ((,class :foreground ,yellow)))
+ `(sx-question-mode-score-upvoted ((,class :inherit bold :foreground ,magenta)))
+ `(sx-question-mode-title ((,class :inherit bold :foreground ,fg-main)))
+ `(sx-question-mode-title-comments ((,class :inherit bold :foreground ,fg-alt)))
+ `(sx-tag ((,class :foreground ,magenta-alt)))
+ `(sx-user-name ((,class :foreground ,blue-alt)))
+ `(sx-user-reputation ((,class :inherit shadow)))
+;;;;; symbol-overlay
+ `(symbol-overlay-default-face ((,class :inherit modus-themes-special-warm)))
+ `(symbol-overlay-face-1 ((,class :inherit modus-themes-intense-blue)))
+ `(symbol-overlay-face-2 ((,class :inherit modus-themes-refine-magenta)))
+ `(symbol-overlay-face-3 ((,class :inherit modus-themes-intense-yellow)))
+ `(symbol-overlay-face-4 ((,class :inherit modus-themes-intense-magenta)))
+ `(symbol-overlay-face-5 ((,class :inherit modus-themes-intense-red)))
+ `(symbol-overlay-face-6 ((,class :inherit modus-themes-refine-red)))
+ `(symbol-overlay-face-7 ((,class :inherit modus-themes-intense-cyan)))
+ `(symbol-overlay-face-8 ((,class :inherit modus-themes-refine-cyan)))
+;;;;; syslog-mode
+ `(syslog-debug ((,class :inherit bold :foreground ,cyan-alt-other)))
+ `(syslog-error ((,class :inherit bold :foreground ,red)))
+ `(syslog-file ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(syslog-hide ((,class :background ,bg-main :foreground ,fg-main)))
+ `(syslog-hour ((,class :inherit bold :foreground ,magenta-alt-other)))
+ `(syslog-info ((,class :inherit bold :foreground ,blue-alt-other)))
+ `(syslog-ip ((,class :inherit bold :foreground ,fg-special-mild :underline t)))
+ `(syslog-su ((,class :inherit bold :foreground ,red-alt)))
+ `(syslog-warn ((,class :inherit bold :foreground ,yellow)))
+;;;;; tab-bar-groups
+ `(tab-bar-groups-tab-1 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,blue-tab)))
+ `(tab-bar-groups-tab-2 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,red-tab)))
+ `(tab-bar-groups-tab-3 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,green-tab)))
+ `(tab-bar-groups-tab-4 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,orange-tab)))
+ `(tab-bar-groups-tab-5 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,purple-tab)))
+ `(tab-bar-groups-tab-6 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,cyan-tab)))
+ `(tab-bar-groups-tab-7 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,yellow-tab)))
+ `(tab-bar-groups-tab-8 ((,class ,@(modus-themes--variable-pitch-ui) :foreground ,magenta-tab)))
+;;;;; tab-bar-mode
+ `(tab-bar ((,class ,@(modus-themes--variable-pitch-ui)
+ :background ,bg-tab-bar :foreground ,fg-main)))
+ `(tab-bar-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active)
+ :background ,bg-tab-active :foreground ,fg-main)))
+ `(tab-bar-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive)
+ :background ,bg-tab-inactive :foreground ,fg-dim)))
+;;;;; tab-line-mode
+ `(tab-line ((,class ,@(modus-themes--variable-pitch-ui)
+ :height 0.95 :background ,bg-tab-bar :foreground ,fg-main)))
+ `(tab-line-close-highlight ((,class :foreground ,red)))
+ `(tab-line-highlight ((,class :background ,blue-subtle-bg :foreground ,fg-dim)))
+ `(tab-line-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active)
+ :background ,bg-tab-active :foreground ,fg-main)))
+ `(tab-line-tab-current ((,class :inherit tab-line-tab)))
+ `(tab-line-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive)
+ :background ,bg-tab-inactive :foreground ,fg-dim)))
+ `(tab-line-tab-inactive-alternate ((,class :box (:line-width 2 :color ,bg-tab-inactive-alt)
+ :background ,bg-tab-inactive-alt :foreground ,fg-main)))
+;;;;; table (built-in table.el)
+ `(table-cell ((,class :background ,blue-nuanced-bg)))
+;;;;; telega
+ ;; FIXME 2021-03-28: Some aspects of `telega' are not fully
+ ;; supported or have not been tested thoroughly. Please understand
+ ;; that I do not use that service because it requires a smartphone
+ ;; and I have none. Help with testing is appreciated.
+ `(telega-button ((,class :box t :foreground ,blue)))
+ `(telega-button-active ((,class :box ,blue-intense-bg :background ,blue-intense-bg :foreground ,fg-main)))
+ `(telega-button-highlight ((,class :inherit modus-themes-subtle-magenta)))
+ `(telega-chat-prompt ((,class :inherit bold)))
+ `(telega-entity-type-code ((,class :inherit fixed-pitch)))
+ `(telega-entity-type-mention ((,class :foreground ,cyan)))
+ `(telega-entity-type-pre ((,class :inherit fixed-pitch)))
+ `(telega-msg-heading ((,class :background ,bg-alt)))
+ `(telega-msg-self-title ((,class :inherit bold)))
+ `(telega-root-heading ((,class :inherit modus-themes-subtle-neutral)))
+ `(telega-secret-title ((,class :foreground ,magenta-alt)))
+ `(telega-unmuted-count ((,class :foreground ,blue-alt-other)))
+ `(telega-user-online-status ((,class :foreground ,cyan-active)))
+ `(telega-username ((,class :foreground ,cyan-alt-other)))
+ `(telega-webpage-chat-link ((,class :background ,bg-alt)))
+ `(telega-webpage-fixed ((,class :inherit fixed-pitch :height 0.85)))
+ `(telega-webpage-header ((,class :inherit modus-themes-variable-pitch :height 1.3)))
+ `(telega-webpage-preformatted ((,class :inherit fixed-pitch :background ,bg-alt)))
+ `(telega-webpage-subheader ((,class :inherit modus-themes-variable-pitch :height 1.15)))
+;;;;; telephone-line
+ `(telephone-line-accent-active ((,class :background ,fg-inactive :foreground ,bg-inactive)))
+ `(telephone-line-accent-inactive ((,class :background ,bg-active :foreground ,fg-active)))
+ `(telephone-line-error ((,class :inherit bold :foreground ,red-active)))
+ `(telephone-line-evil ((,class :foreground ,fg-main)))
+ `(telephone-line-evil-emacs ((,class :inherit telephone-line-evil :background ,magenta-intense-bg)))
+ `(telephone-line-evil-insert ((,class :inherit telephone-line-evil :background ,green-intense-bg)))
+ `(telephone-line-evil-motion ((,class :inherit telephone-line-evil :background ,yellow-intense-bg)))
+ `(telephone-line-evil-normal ((,class :inherit telephone-line-evil :background ,bg-alt)))
+ `(telephone-line-evil-operator ((,class :inherit telephone-line-evil :background ,yellow-subtle-bg)))
+ `(telephone-line-evil-replace ((,class :inherit telephone-line-evil :background ,red-intense-bg)))
+ `(telephone-line-evil-visual ((,class :inherit telephone-line-evil :background ,cyan-intense-bg)))
+ `(telephone-line-projectile ((,class :foreground ,cyan-active)))
+ `(telephone-line-unimportant ((,class :foreground ,fg-inactive)))
+ `(telephone-line-warning ((,class :inherit bold :foreground ,yellow-active)))
+;;;;; terraform-mode
+ `(terraform--resource-name-face ((,class ,@(modus-themes--syntax-string
+ magenta-alt-other magenta-alt-other-faint
+ red-alt red-alt))))
+ `(terraform--resource-type-face ((,class ,@(modus-themes--syntax-string
+ green green-faint
+ blue-alt magenta-alt))))
+;;;;; term
+ `(term ((,class :background ,bg-main :foreground ,fg-main)))
+ `(term-bold ((,class :inherit bold)))
+ `(term-color-black ((,class :background "gray35" :foreground "gray35")))
+ `(term-color-blue ((,class :background ,blue :foreground ,blue)))
+ `(term-color-cyan ((,class :background ,cyan :foreground ,cyan)))
+ `(term-color-green ((,class :background ,green :foreground ,green)))
+ `(term-color-magenta ((,class :background ,magenta :foreground ,magenta)))
+ `(term-color-red ((,class :background ,red :foreground ,red)))
+ `(term-color-white ((,class :background "gray65" :foreground "gray65")))
+ `(term-color-yellow ((,class :background ,yellow :foreground ,yellow)))
+ `(term-underline ((,class :underline t)))
+;;;;; tomatinho
+ `(tomatinho-ok-face ((,class :foreground ,blue-intense)))
+ `(tomatinho-pause-face ((,class :foreground ,yellow-intense)))
+ `(tomatinho-reset-face ((,class :inherit shadow)))
+;;;;; transient
+ `(transient-active-infix ((,class :inherit modus-themes-special-mild)))
+ `(transient-amaranth ((,class :inherit bold :foreground ,yellow-alt)))
+ `(transient-argument ((,class :inherit bold :foreground ,green)))
+ `(transient-blue ((,class :inherit bold :foreground ,blue)))
+ `(transient-disabled-suffix ((,class :inherit modus-themes-intense-red)))
+ `(transient-enabled-suffix ((,class :inherit ,@(modus-themes--success-deuteran
+ 'modus-themes-subtle-blue
+ 'modus-themes-subtle-green))))
+ `(transient-heading ((,class :inherit bold :foreground ,fg-main)))
+ `(transient-inactive-argument ((,class :inherit shadow)))
+ `(transient-inactive-value ((,class :inherit shadow)))
+ `(transient-key ((,class :inherit modus-themes-key-binding)))
+ `(transient-mismatched-key ((,class :underline t)))
+ `(transient-nonstandard-key ((,class :underline t)))
+ `(transient-pink ((,class :inherit bold :foreground ,magenta-alt-faint)))
+ `(transient-red ((,class :inherit bold :foreground ,red-faint)))
+ `(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other)))
+ `(transient-unreachable ((,class :foreground ,fg-unfocused)))
+ `(transient-unreachable-key ((,class :foreground ,fg-unfocused)))
+ `(transient-value ((,class :inherit bold :foreground ,magenta-alt-other)))
+;;;;; trashed
+ `(trashed-deleted ((,class :inherit modus-themes-mark-del)))
+ `(trashed-directory ((,class :foreground ,blue)))
+ `(trashed-mark ((,class :inherit modus-themes-mark-symbol)))
+ `(trashed-marked ((,class :inherit modus-themes-mark-alt)))
+ `(trashed-restored ((,class :inherit modus-themes-mark-sel)))
+ `(trashed-symlink ((,class :inherit button
+ ,@(modus-themes--link-color
+ cyan-alt cyan-alt-faint))))
+;;;;; treemacs
+ `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt)))
+ `(treemacs-directory-face ((,class :inherit dired-directory)))
+ `(treemacs-file-face ((,class :foreground ,fg-main)))
+ `(treemacs-fringe-indicator-face ((,class :foreground ,fg-main)))
+ `(treemacs-git-added-face ((,class :foreground ,green-intense)))
+ `(treemacs-git-conflict-face ((,class :inherit (modus-themes-intense-red bold))))
+ `(treemacs-git-ignored-face ((,class :inherit shadow)))
+ `(treemacs-git-modified-face ((,class :foreground ,yellow-alt-other)))
+ `(treemacs-git-renamed-face ((,class :foreground ,cyan-alt-other)))
+ `(treemacs-git-unmodified-face ((,class :foreground ,fg-main)))
+ `(treemacs-git-untracked-face ((,class :foreground ,red-alt-other)))
+ `(treemacs-help-column-face ((,class :inherit modus-themes-bold :foreground ,magenta-alt-other :underline t)))
+ `(treemacs-help-title-face ((,class :foreground ,blue-alt-other)))
+ `(treemacs-on-failure-pulse-face ((,class :inherit modus-themes-intense-red)))
+ `(treemacs-on-success-pulse-face ((,class :inherit ,@(modus-themes--success-deuteran
+ 'modus-themes-intense-blue
+ 'modus-themes-intense-green))))
+ `(treemacs-root-face ((,class :inherit bold :foreground ,blue-alt-other :height 1.2 :underline t)))
+ `(treemacs-root-remote-disconnected-face ((,class :inherit treemacs-root-remote-face :foreground ,yellow)))
+ `(treemacs-root-remote-face ((,class :inherit treemacs-root-face :foreground ,magenta)))
+ `(treemacs-root-remote-unreadable-face ((,class :inherit treemacs-root-unreadable-face)))
+ `(treemacs-root-unreadable-face ((,class :inherit treemacs-root-face :strike-through t)))
+ `(treemacs-tags-face ((,class :foreground ,blue-alt)))
+ `(treemacs-tags-face ((,class :foreground ,magenta-alt)))
+;;;;; tty-menu
+ `(tty-menu-disabled-face ((,class :background ,bg-alt :foreground ,fg-alt)))
+ `(tty-menu-enabled-face ((,class :inherit bold :background ,bg-alt :foreground ,fg-main)))
+ `(tty-menu-selected-face ((,class :inherit modus-themes-intense-blue)))
+;;;;; tuareg
+ `(caml-types-def-face ((,class :inherit modus-themes-subtle-red)))
+ `(caml-types-expr-face ((,class :inherit modus-themes-subtle-green)))
+ `(caml-types-occ-face ((,class :inherit modus-themes-subtle-green)))
+ `(caml-types-scope-face ((,class :inherit modus-themes-subtle-blue)))
+ `(caml-types-typed-face ((,class :inherit modus-themes-subtle-magenta)))
+ `(tuareg-font-double-semicolon-face ((,class :inherit font-lock-preprocessor-face)))
+ `(tuareg-font-lock-attribute-face ((,class :inherit font-lock-function-name-face)))
+ `(tuareg-font-lock-constructor-face ((,class :foreground ,fg-main)))
+ `(tuareg-font-lock-error-face ((,class :inherit (modus-themes-intense-red bold))))
+ `(tuareg-font-lock-extension-node-face ((,class :background ,bg-alt :foreground ,magenta)))
+ `(tuareg-font-lock-governing-face ((,class :inherit bold :foreground ,fg-main)))
+ `(tuareg-font-lock-infix-extension-node-face ((,class :inherit font-lock-function-name-face)))
+ `(tuareg-font-lock-interactive-directive-face ((,class :foreground ,fg-special-cold)))
+ `(tuareg-font-lock-interactive-error-face ((,class :inherit error)))
+ `(tuareg-font-lock-interactive-output-face ((,class :inherit font-lock-constant-face)))
+ `(tuareg-font-lock-label-face ((,class :inherit font-lock-type-face)))
+ `(tuareg-font-lock-line-number-face ((,class :foreground ,fg-special-warm)))
+ `(tuareg-font-lock-module-face ((,class :inherit font-lock-builtin-face)))
+ `(tuareg-font-lock-multistage-face ((,class :inherit bold :background ,bg-alt :foreground ,blue)))
+ `(tuareg-font-lock-operator-face ((,class :inherit font-lock-preprocessor-face)))
+ `(tuareg-opam-error-face ((,class :inherit error)))
+ `(tuareg-opam-pkg-variable-name-face ((,class :inherit font-lock-variable-name-face)))
+;;;;; typescript
+ `(typescript-jsdoc-tag ((,class :inherit (font-lock-builtin-face font-lock-comment-face) :weight normal)))
+ `(typescript-jsdoc-type ((,class :inherit (font-lock-type-face font-lock-comment-face) :weight normal)))
+ `(typescript-jsdoc-value ((,class :inherit (font-lock-constant-face font-lock-comment-face) :weight normal)))
+;;;;; undo-tree
+ `(undo-tree-visualizer-active-branch-face ((,class :inherit bold :foreground ,fg-main)))
+ `(undo-tree-visualizer-current-face ((,class :foreground ,blue-intense)))
+ `(undo-tree-visualizer-default-face ((,class :inherit shadow)))
+ `(undo-tree-visualizer-register-face ((,class :foreground ,magenta-intense)))
+ `(undo-tree-visualizer-unmodified-face ((,class :foreground ,green-intense)))
+;;;;; vc (vc-dir.el, vc-hooks.el)
+ `(vc-dir-directory ((,class :foreground ,blue)))
+ `(vc-dir-file ((,class :foreground ,fg-main)))
+ `(vc-dir-header ((,class :foreground ,cyan-alt-other)))
+ `(vc-dir-header-value ((,class :foreground ,magenta-alt-other)))
+ `(vc-dir-mark-indicator ((,class :foreground ,blue-alt-other)))
+ `(vc-dir-status-edited ((,class :foreground ,yellow)))
+ `(vc-dir-status-ignored ((,class :foreground ,fg-unfocused)))
+ `(vc-dir-status-up-to-date ((,class :foreground ,cyan)))
+ `(vc-dir-status-warning ((,class :foreground ,red)))
+ `(vc-conflict-state ((,class :inherit modus-themes-slant :foreground ,red-active)))
+ `(vc-edited-state ((,class :foreground ,yellow-active)))
+ `(vc-locally-added-state ((,class :foreground ,cyan-active)))
+ `(vc-locked-state ((,class :foreground ,blue-active)))
+ `(vc-missing-state ((,class :inherit modus-themes-slant :foreground ,magenta-active)))
+ `(vc-needs-update-state ((,class :inherit modus-themes-slant :foreground ,green-active)))
+ `(vc-removed-state ((,class :foreground ,red-active)))
+ `(vc-state-base ((,class :foreground ,fg-active)))
+ `(vc-up-to-date-state ((,class :foreground ,fg-special-cold)))
+;;;;; vdiff
+ `(vdiff-addition-face ((,class :inherit modus-themes-diff-added)))
+ `(vdiff-change-face ((,class :inherit modus-themes-diff-changed)))
+ `(vdiff-closed-fold-face ((,class :inherit modus-themes-diff-heading)))
+ `(vdiff-refine-added ((,class :inherit modus-themes-diff-refine-added)))
+ `(vdiff-refine-changed ((,class :inherit modus-themes-diff-refine-changed)))
+ `(vdiff-subtraction-face ((,class :inherit modus-themes-diff-removed)))
+ `(vdiff-target-face ((,class :inherit modus-themes-intense-blue)))
+;;;;; vertico
+ `(vertico-current ((,class :inherit bold :foreground ,fg-main
+ :background ,@(pcase modus-themes-completions
+ ('opinionated (list bg-active))
+ (_ (list bg-inactive))))))
+;;;;; vimish-fold
+ `(vimish-fold-fringe ((,class :foreground ,cyan-active)))
+ `(vimish-fold-mouse-face ((,class :inherit modus-themes-intense-blue)))
+ `(vimish-fold-overlay ((,class :background ,bg-alt :foreground ,fg-special-cold)))
+;;;;; visible-mark
+ `(visible-mark-active ((,class :background ,blue-intense-bg)))
+ `(visible-mark-face1 ((,class :background ,cyan-intense-bg)))
+ `(visible-mark-face2 ((,class :background ,yellow-intense-bg)))
+ `(visible-mark-forward-face1 ((,class :background ,magenta-intense-bg)))
+ `(visible-mark-forward-face2 ((,class :background ,green-intense-bg)))
+;;;;; visual-regexp
+ `(vr/group-0 ((,class :inherit modus-themes-intense-blue)))
+ `(vr/group-1 ((,class :inherit modus-themes-intense-magenta)))
+ `(vr/group-2 ((,class :inherit modus-themes-intense-green)))
+ `(vr/match-0 ((,class :inherit modus-themes-refine-yellow)))
+ `(vr/match-1 ((,class :inherit modus-themes-refine-yellow)))
+ `(vr/match-separator-face ((,class :inherit (modus-themes-intense-neutral bold))))
+;;;;; volatile-highlights
+ `(vhl/default-face ((,class :background ,bg-alt :foreground ,blue-nuanced-fg :extend t)))
+;;;;; vterm
+ `(vterm-color-black ((,class :background "gray35" :foreground "gray35")))
+ `(vterm-color-blue ((,class :background ,blue :foreground ,blue)))
+ `(vterm-color-cyan ((,class :background ,cyan :foreground ,cyan)))
+ `(vterm-color-default ((,class :background ,bg-main :foreground ,fg-main)))
+ `(vterm-color-green ((,class :background ,green :foreground ,green)))
+ `(vterm-color-inverse-video ((,class :background ,bg-main :inverse-video t)))
+ `(vterm-color-magenta ((,class :background ,magenta :foreground ,magenta)))
+ `(vterm-color-red ((,class :background ,red :foreground ,red)))
+ `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t)))
+ `(vterm-color-white ((,class :background "gray65" :foreground "gray65")))
+ `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow)))
+;;;;; wcheck-mode
+ `(wcheck-default-face ((,class :foreground ,red :underline t)))
+;;;;; web-mode
+ `(web-mode-annotation-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-annotation-html-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-annotation-tag-face ((,class :inherit web-mode-comment-face :underline t)))
+ `(web-mode-block-attr-name-face ((,class :inherit font-lock-constant-face)))
+ `(web-mode-block-attr-value-face ((,class :inherit font-lock-type-face)))
+ `(web-mode-block-comment-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-block-control-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-block-delimiter-face ((,class :foreground ,fg-main)))
+ `(web-mode-block-face ((,class :background ,bg-dim)))
+ `(web-mode-block-string-face ((,class :inherit web-mode-string-face)))
+ `(web-mode-bold-face ((,class :inherit bold)))
+ `(web-mode-builtin-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-comment-face ((,class :inherit font-lock-comment-face)))
+ `(web-mode-comment-keyword-face ((,class :inherit font-lock-warning-face)))
+ `(web-mode-constant-face ((,class :inherit font-lock-constant-face)))
+ `(web-mode-css-at-rule-face ((,class :inherit font-lock-constant-face)))
+ `(web-mode-css-color-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-css-comment-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-css-function-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-css-priority-face ((,class :inherit font-lock-warning-face)))
+ `(web-mode-css-property-name-face ((,class :inherit font-lock-keyword-face)))
+ `(web-mode-css-pseudo-class-face ((,class :inherit font-lock-doc-face)))
+ `(web-mode-css-selector-face ((,class :inherit font-lock-keyword-face)))
+ `(web-mode-css-string-face ((,class :inherit web-mode-string-face)))
+ `(web-mode-css-variable-face ((,class :foreground ,fg-special-warm)))
+ `(web-mode-current-column-highlight-face ((,class :background ,bg-alt)))
+ `(web-mode-current-element-highlight-face ((,class :inherit modus-themes-special-mild)))
+ `(web-mode-doctype-face ((,class :inherit modus-themes-slant :foreground ,fg-special-cold)))
+ `(web-mode-error-face ((,class :inherit modus-themes-intense-red)))
+ `(web-mode-filter-face ((,class :inherit font-lock-function-name-face)))
+ `(web-mode-folded-face ((,class :underline t)))
+ `(web-mode-function-call-face ((,class :inherit font-lock-function-name-face)))
+ `(web-mode-function-name-face ((,class :inherit font-lock-function-name-face)))
+ `(web-mode-html-attr-custom-face ((,class :inherit font-lock-variable-name-face)))
+ `(web-mode-html-attr-engine-face ((,class :foreground ,fg-main)))
+ `(web-mode-html-attr-equal-face ((,class :foreground ,fg-main)))
+ `(web-mode-html-attr-name-face ((,class :inherit font-lock-variable-name-face)))
+ `(web-mode-html-attr-value-face ((,class :inherit font-lock-constant-face)))
+ `(web-mode-html-entity-face ((,class :inherit font-lock-negation-char-face)))
+ `(web-mode-html-tag-bracket-face ((,class :foreground ,fg-dim)))
+ `(web-mode-html-tag-custom-face ((,class :inherit font-lock-function-name-face)))
+ `(web-mode-html-tag-face ((,class :inherit font-lock-function-name-face)))
+ `(web-mode-html-tag-namespaced-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-html-tag-unclosed-face ((,class :inherit error :underline t)))
+ `(web-mode-inlay-face ((,class :background ,bg-alt)))
+ `(web-mode-italic-face ((,class :inherit italic)))
+ `(web-mode-javascript-comment-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-javascript-string-face ((,class :inherit web-mode-string-face)))
+ `(web-mode-json-comment-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-json-context-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-json-key-face ((,class :foreground ,blue-nuanced-fg)))
+ `(web-mode-json-string-face ((,class :inherit web-mode-string-face)))
+ `(web-mode-jsx-depth-1-face ((,class :background ,blue-intense-bg :foreground ,fg-main)))
+ `(web-mode-jsx-depth-2-face ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
+ `(web-mode-jsx-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
+ `(web-mode-jsx-depth-4-face ((,class :background ,bg-alt :foreground ,blue-refine-fg)))
+ `(web-mode-jsx-depth-5-face ((,class :background ,bg-alt :foreground ,blue-nuanced-fg)))
+ `(web-mode-keyword-face ((,class :inherit :inherit font-lock-keyword-face)))
+ `(web-mode-param-name-face ((,class :inherit font-lock-function-name-face)))
+ `(web-mode-part-comment-face ((,class :inherit web-mode-comment-face)))
+ `(web-mode-part-face ((,class :inherit web-mode-block-face)))
+ `(web-mode-part-string-face ((,class :inherit web-mode-string-face)))
+ `(web-mode-preprocessor-face ((,class :inherit font-lock-preprocessor-face)))
+ `(web-mode-script-face ((,class :inherit web-mode-part-face)))
+ `(web-mode-sql-keyword-face ((,class :inherit font-lock-negation-char-face)))
+ `(web-mode-string-face ((,class :inherit font-lock-string-face)))
+ `(web-mode-style-face ((,class :inherit web-mode-part-face)))
+ `(web-mode-symbol-face ((,class :inherit font-lock-constant-face)))
+ `(web-mode-type-face ((,class :inherit font-lock-builtin-face)))
+ `(web-mode-underline-face ((,class :underline t)))
+ `(web-mode-variable-name-face ((,class :inherit font-lock-variable-name-face)))
+ `(web-mode-warning-face ((,class :inherit font-lock-warning-face)))
+ `(web-mode-whitespace-face ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
+;;;;; wgrep
+ `(wgrep-delete-face ((,class :inherit modus-themes-refine-yellow)))
+ `(wgrep-done-face ((,class :inherit modus-themes-refine-blue)))
+ `(wgrep-face ((,class :inherit modus-themes-refine-green)))
+ `(wgrep-file-face ((,class :foreground ,fg-special-warm)))
+ `(wgrep-reject-face ((,class :inherit (modus-themes-intense-red bold))))
+;;;;; which-function-mode
+ `(which-func ((,class :foreground ,magenta-active)))
+;;;;; which-key
+ `(which-key-command-description-face ((,class :foreground ,fg-main)))
+ `(which-key-group-description-face ((,class :foreground ,magenta-alt)))
+ `(which-key-highlighted-command-face ((,class :foreground ,yellow :underline t)))
+ `(which-key-key-face ((,class :inherit modus-themes-key-binding)))
+ `(which-key-local-map-description-face ((,class :foreground ,fg-main)))
+ `(which-key-note-face ((,class :foreground ,fg-special-warm)))
+ `(which-key-separator-face ((,class :inherit shadow)))
+ `(which-key-special-key-face ((,class :inherit bold :foreground ,orange-intense)))
+;;;;; whitespace-mode
+ `(whitespace-big-indent ((,class :inherit modus-themes-subtle-red)))
+ `(whitespace-empty ((,class :inherit modus-themes-intense-magenta)))
+ `(whitespace-hspace ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
+ `(whitespace-indentation ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
+ `(whitespace-line ((,class :inherit modus-themes-subtle-yellow)))
+ `(whitespace-newline ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
+ `(whitespace-space ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
+ `(whitespace-space-after-tab ((,class :inherit modus-themes-subtle-magenta)))
+ `(whitespace-space-before-tab ((,class :inherit modus-themes-subtle-cyan)))
+ `(whitespace-tab ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
+ `(whitespace-trailing ((,class :inherit modus-themes-intense-red)))
+;;;;; window-divider-mode
+ `(window-divider ((,class :foreground ,fg-window-divider-inner)))
+ `(window-divider-first-pixel ((,class :foreground ,fg-window-divider-outer)))
+ `(window-divider-last-pixel ((,class :foreground ,fg-window-divider-outer)))
+;;;;; winum
+ `(winum-face ((,class :inherit modus-themes-bold :foreground ,cyan-active)))
+;;;;; writegood-mode
+ `(writegood-duplicates-face ((,class :background ,bg-alt :foreground ,red-alt :underline t)))
+ `(writegood-passive-voice-face ((,class :inherit modus-themes-lang-warning)))
+ `(writegood-weasels-face ((,class :inherit modus-themes-lang-error)))
+;;;;; woman
+ `(woman-addition ((,class :foreground ,magenta-alt-other)))
+ `(woman-bold ((,class :inherit bold :foreground ,magenta)))
+ `(woman-italic ((,class :inherit italic :foreground ,cyan)))
+ `(woman-unknown ((,class :inherit italic :foreground ,yellow)))
+;;;;; xah-elisp-mode
+ `(xah-elisp-at-symbol ((,class :inherit font-lock-warning-face)))
+ `(xah-elisp-cap-variable ((,class :inherit font-lock-preprocessor-face)))
+ `(xah-elisp-command-face ((,class :inherit font-lock-type-face)))
+ `(xah-elisp-dollar-symbol ((,class :inherit font-lock-variable-name-face)))
+;;;;; xref
+ `(xref-file-header ((,class :inherit bold :foreground ,fg-special-cold)))
+ `(xref-line-number ((,class :inherit shadow)))
+ `(xref-match ((,class :inherit match)))
+;;;;; yaml-mode
+ `(yaml-tab-face ((,class :inherit modus-themes-intense-red)))
+;;;;; yasnippet
+ `(yas-field-highlight-face ((,class :background ,bg-hl-alt-intense)))
+;;;;; ztree
+ `(ztreep-arrow-face ((,class :foreground ,fg-inactive)))
+ `(ztreep-diff-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold)))
+ `(ztreep-diff-header-small-face ((,class :foreground ,fg-main)))
+ `(ztreep-diff-model-add-face ((,class :foreground ,@(modus-themes--diff-deuteran blue green))))
+ `(ztreep-diff-model-diff-face ((,class :foreground ,red)))
+ `(ztreep-diff-model-ignored-face ((,class :inherit shadow :strike-through t)))
+ `(ztreep-diff-model-normal-face ((,class :inherit shadow)))
+ `(ztreep-expand-sign-face ((,class :inherit ztreep-arrow-face)))
+ `(ztreep-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold)))
+ `(ztreep-leaf-face ((,class :foreground ,cyan)))
+ `(ztreep-node-count-children-face ((,class :foreground ,fg-special-warm)))
+ `(ztreep-node-face ((,class :foreground ,fg-main))))
+ "Face specs for use with `modus-themes-theme'.")
+
+(defconst modus-themes-custom-variables
+ '(
+;;;; ansi-colors
+ `(ansi-color-faces-vector [default bold shadow italic underline success warning error])
+ `(ansi-color-names-vector ["gray35" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"])
+;;;; awesome-tray
+ `(awesome-tray-mode-line-active-color ,blue)
+ `(awesome-tray-mode-line-inactive-color ,bg-active)
+;;;; exwm
+ `(exwm-floating-border-color ,fg-window-divider-inner)
+;;;; flymake fringe indicators
+ `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-themes-fringe-red))
+ `(flymake-warning-bitmap '(exclamation-mark modus-themes-fringe-yellow))
+ `(flymake-note-bitmap '(exclamation-mark modus-themes-fringe-cyan))
+;;;; ibuffer
+ `(ibuffer-deletion-face 'modus-themes-mark-del)
+ `(ibuffer-filter-group-name-face 'modus-themes-pseudo-header)
+ `(ibuffer-marked-face 'modus-themes-mark-sel)
+ `(ibuffer-title-face 'default)
+;;;; highlight-tail
+ `(highlight-tail-colors
+ '((,green-subtle-bg . 0)
+ (,cyan-subtle-bg . 20)))
+;;;; hl-todo
+ `(hl-todo-keyword-faces
+ '(("HOLD" . ,yellow-alt)
+ ("TODO" . ,magenta)
+ ("NEXT" . ,magenta-alt-other)
+ ("THEM" . ,magenta-alt)
+ ("PROG" . ,cyan)
+ ("OKAY" . ,cyan-alt)
+ ("DONT" . ,green-alt)
+ ("FAIL" . ,red)
+ ("BUG" . ,red)
+ ("DONE" . ,green)
+ ("NOTE" . ,yellow-alt-other)
+ ("KLUDGE" . ,yellow)
+ ("HACK" . ,yellow)
+ ("TEMP" . ,red-nuanced-fg)
+ ("FIXME" . ,red-alt-other)
+ ("XXX+" . ,red-alt)
+ ("REVIEW" . ,cyan-alt-other)
+ ("DEPRECATED" . ,blue-nuanced-fg)))
+;;;; pdf-tools
+ `(pdf-view-midnight-colors
+ '(,fg-main . ,bg-dim))
+;;;; vc-annotate (C-x v g)
+ `(vc-annotate-background nil)
+ `(vc-annotate-background-mode nil)
+ `(vc-annotate-color-map
+ '((20 . ,red)
+ (40 . ,magenta)
+ (60 . ,magenta-alt)
+ (80 . ,red-alt)
+ (100 . ,yellow)
+ (120 . ,yellow-alt)
+ (140 . ,fg-special-warm)
+ (160 . ,fg-special-mild)
+ (180 . ,green)
+ (200 . ,green-alt)
+ (220 . ,cyan-alt-other)
+ (240 . ,cyan-alt)
+ (260 . ,cyan)
+ (280 . ,fg-special-cold)
+ (300 . ,blue)
+ (320 . ,blue-alt)
+ (340 . ,blue-alt-other)
+ (360 . ,magenta-alt-other)))
+ `(vc-annotate-very-old-color nil)
+;;;; xterm-color
+ `(xterm-color-names ["black" ,red ,green ,yellow ,blue ,magenta ,cyan "gray65"])
+ `(xterm-color-names-bright ["gray35" ,red-alt ,green-alt ,yellow-alt ,blue-alt ,magenta-alt ,cyan-alt "white"])
+ (if (or (eq modus-themes-org-blocks 'tinted-background)
+ (eq modus-themes-org-blocks 'rainbow))
+ `(org-src-block-faces ; TODO this list should be expanded
+ `(("emacs-lisp" modus-themes-nuanced-magenta)
+ ("elisp" modus-themes-nuanced-magenta)
+ ("clojure" modus-themes-nuanced-magenta)
+ ("clojurescript" modus-themes-nuanced-magenta)
+ ("c" modus-themes-nuanced-blue)
+ ("c++" modus-themes-nuanced-blue)
+ ("sh" modus-themes-nuanced-green)
+ ("shell" modus-themes-nuanced-green)
+ ("html" modus-themes-nuanced-yellow)
+ ("xml" modus-themes-nuanced-yellow)
+ ("css" modus-themes-nuanced-red)
+ ("scss" modus-themes-nuanced-red)
+ ("python" modus-themes-nuanced-green)
+ ("ipython" modus-themes-nuanced-magenta)
+ ("r" modus-themes-nuanced-cyan)
+ ("yaml" modus-themes-nuanced-cyan)
+ ("conf" modus-themes-nuanced-cyan)
+ ("docker" modus-themes-nuanced-cyan)))
+ `(org-src-block-faces '())))
+ "Custom variables for `modus-themes-theme'.")
+
+;;;###autoload
+(when load-file-name
+ (let ((dir (file-name-directory load-file-name)))
+ (unless (equal dir (expand-file-name "themes/" data-directory))
+ (add-to-list 'custom-theme-load-path dir))))
+
+(provide 'modus-themes)
+
+;; Local Variables:
+;; time-stamp-start: "Last-Modified:[ \t]+\\\\?[\"<]"
+;; time-stamp-end: "\\\\?[\">]"
+;; time-stamp-format: "%Y-%02m-%02d %02H:%02M:%02S %5z"
+;; End:
+
+;;; modus-themes.el ends here
diff --git a/etc/themes/modus-vivendi-theme.el b/etc/themes/modus-vivendi-theme.el
index 6e71e8d8e3a..6ff359d341b 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -1,4666 +1,72 @@
;;; modus-vivendi-theme.el --- Accessible dark theme (WCAG AAA) -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
;; URL: https://gitlab.com/protesilaos/modus-themes
-;; Version: 0.13.0
+;; Version: 1.5.0
;; Package-Requires: ((emacs "26.1"))
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or
+;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
+;; the 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.
+;; 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 theme is designed for colour-contrast accessibility.
+;; Modus Vivendi is the dark variant of the Modus themes (Modus Operandi
+;; is the light one). The themes are designed for color-contrast
+;; accessibility. More specifically:
;;
-;; 1. Provide a consistent minimum contrast ratio between background and
-;; foreground values of 7:1 or higher. This meets the highest such
-;; accessibility criterion per the guidelines of the Worldwide Web
-;; Consortium's Working Group on Accessibility (WCAG AAA standard).
+;; 1. Provide a consistent minimum contrast ratio between background
+;; and foreground values of 7:1 or higher. This meets the highest
+;; such accessibility criterion per the guidelines of the Worldwide
+;; Web Consortium's Working Group on Accessibility (WCAG AAA
+;; standard).
;;
-;; 2. Offer as close to full face coverage as possible. The list is
-;; already quite long (see further below), with more additions to follow
-;; as part of the ongoing development process.
+;; 2. Offer as close to full face coverage as possible. The list is
+;; already quite long, with more additions to follow as part of the
+;; ongoing development process.
;;
-;; The theme provides the following customisation options, all of which
-;; are disabled by default:
+;; For a complete view of the project, also refer to the following files
+;; (should be distributed in the same repository/directory as the
+;; current item):
;;
-;; modus-vivendi-theme-slanted-constructs (boolean)
-;; modus-vivendi-theme-bold-constructs (boolean)
-;; modus-vivendi-theme-variable-pitch-headings (boolean)
-;; modus-vivendi-theme-no-mixed-fonts (boolean)
-;; modus-vivendi-theme-headings (alist)
-;; modus-vivendi-theme-scale-headings (boolean)
-;; modus-vivendi-theme-fringes (choice)
-;; modus-vivendi-theme-org-blocks (choice)
-;; modus-vivendi-theme-prompts (choice)
-;; modus-vivendi-theme-mode-line (choice)
-;; modus-vivendi-theme-diffs (choice)
-;; modus-vivendi-theme-faint-syntax (boolean)
-;; modus-vivendi-theme-intense-hl-line (boolean)
-;; modus-vivendi-theme-intense-paren-match (boolean)
-;; modus-vivendi-theme-no-link-underline (boolean)
-;; modus-vivendi-theme-completions (choice)
-;; modus-vivendi-theme-override-colors-alist (alist)
-;;
-;; The default scale is as follows (it can be customised as well):
-;;
-;; modus-vivendi-theme-scale-1 1.05
-;; modus-vivendi-theme-scale-2 1.1
-;; modus-vivendi-theme-scale-3 1.15
-;; modus-vivendi-theme-scale-4 1.2
-;; modus-vivendi-theme-scale-5 1.3
-;;
-;; What follows is the list of explicitly supported packages or face
-;; groups (there are implicitly supported packages as well, which
-;; inherit from font-lock or some basic group). You are encouraged to
-;; notify me of any missing package or change you would like to see.
-;;
-;; ace-window
-;; ag
-;; alert
-;; all-the-icons
-;; annotate
-;; anzu
-;; apropos
-;; apt-sources-list
-;; artbollocks-mode
-;; auctex and TeX
-;; auto-dim-other-buffers
-;; avy
-;; awesome-tray
-;; binder
-;; bm
-;; bongo
-;; boon
-;; breakpoint (provided by built-in gdb-mi.el)
-;; buffer-expose
-;; calendar and diary
-;; calfw
-;; centaur-tabs
-;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
-;; cider
-;; circe
-;; color-rg
-;; column-enforce-mode
-;; company-mode
-;; company-posframe
-;; compilation-mode
-;; completions
-;; counsel
-;; counsel-css
-;; counsel-notmuch
-;; counsel-org-capture-string
-;; cov
-;; cperl-mode
-;; csv-mode
-;; ctrlf
-;; custom (M-x customize)
-;; dap-mode
-;; dashboard (emacs-dashboard)
-;; deadgrep
-;; debbugs
-;; define-word
-;; deft
-;; dictionary
-;; diff-hl
-;; diff-mode
-;; dim-autoload
-;; dir-treeview
-;; dired
-;; dired-async
-;; dired-git
-;; dired-git-info
-;; dired-narrow
-;; dired-subtree
-;; diredfl
-;; disk-usage
-;; doom-modeline
-;; dynamic-ruler
-;; easy-jekyll
-;; easy-kill
-;; ebdb
-;; ediff
-;; eglot
-;; el-search
-;; eldoc
-;; eldoc-box
-;; elfeed
-;; elfeed-score
-;; emms
-;; enhanced-ruby-mode
-;; epa
-;; equake
-;; erc
-;; eros
-;; ert
-;; eshell
-;; eshell-fringe-status
-;; eshell-git-prompt
-;; eshell-prompt-extras (epe)
-;; eshell-syntax-highlighting
-;; evil (evil-mode)
-;; evil-goggles
-;; evil-visual-mark-mode
-;; eww
-;; eyebrowse
-;; fancy-dabbrev
-;; flycheck
-;; flycheck-color-mode-line
-;; flycheck-indicator
-;; flycheck-posframe
-;; flymake
-;; flyspell
-;; flyspell-correct
-;; flx
-;; freeze-it
-;; frog-menu
-;; focus
-;; fold-this
-;; font-lock (generic syntax highlighting)
-;; forge
-;; fountain (fountain-mode)
-;; geiser
-;; git-commit
-;; git-gutter (and variants)
-;; git-lens
-;; git-rebase
-;; git-timemachine
-;; git-walktree
-;; gnus
-;; golden-ratio-scroll-screen
-;; helm
-;; helm-ls-git
-;; helm-switch-shell
-;; helm-xref
-;; helpful
-;; highlight-blocks
-;; highlight-defined
-;; highlight-escape-sequences (`hes-mode')
-;; highlight-indentation
-;; highlight-numbers
-;; highlight-symbol
-;; highlight-tail
-;; highlight-thing
-;; hl-defined
-;; hl-fill-column
-;; hl-line-mode
-;; hl-todo
-;; hydra
-;; hyperlist
-;; ibuffer
-;; icomplete
-;; ido-mode
-;; iedit
-;; iflipb
-;; imenu-list
-;; indium
-;; info
-;; info-colors
-;; interaction-log
-;; ioccur
-;; isearch, occur, etc.
-;; ivy
-;; ivy-posframe
-;; jira (org-jira)
-;; journalctl-mode
-;; js2-mode
-;; julia
-;; jupyter
-;; kaocha-runner
-;; keycast
-;; line numbers (`display-line-numbers-mode' and global variant)
-;; lsp-mode
-;; lsp-ui
-;; magit
-;; magit-imerge
-;; man
-;; markdown-mode
-;; markup-faces (`adoc-mode')
-;; mentor
-;; messages
-;; minibuffer-line
-;; minimap
-;; modeline
-;; mood-line
-;; mpdel
-;; mu4e
-;; mu4e-conversation
-;; multiple-cursors
-;; neotree
-;; no-emoji
-;; notmuch
-;; num3-mode
-;; nxml-mode
-;; objed
-;; orderless
-;; org
-;; org-journal
-;; org-noter
-;; org-pomodoro
-;; org-recur
-;; org-roam
-;; org-superstar
-;; org-table-sticky-header
-;; org-treescope
-;; origami
-;; outline-mode
-;; outline-minor-faces
-;; package (M-x list-packages)
-;; page-break-lines
-;; paradox
-;; paren-face
-;; parrot
-;; pass
-;; persp-mode
-;; perspective
-;; phi-grep
-;; phi-search
-;; pkgbuild-mode
-;; pomidor
-;; powerline
-;; powerline-evil
-;; proced
-;; prodigy
-;; racket-mode
-;; rainbow-blocks
-;; rainbow-identifiers
-;; rainbow-delimiters
-;; rcirc
-;; regexp-builder (also known as `re-builder')
-;; rg
-;; ripgrep
-;; rmail
-;; ruler-mode
-;; sallet
-;; selectrum
-;; semantic
-;; sesman
-;; shell-script-mode
-;; show-paren-mode
-;; side-notes
-;; skewer-mode
-;; smart-mode-line
-;; smartparens
-;; smerge
-;; spaceline
-;; speedbar
-;; spell-fu
-;; stripes
-;; suggest
-;; switch-window
-;; swiper
-;; swoop
-;; sx
-;; symbol-overlay
-;; tab-bar-mode
-;; tab-line-mode
-;; syslog-mode
-;; table (built-in table.el)
-;; telephone-line
-;; term
-;; tomatinho
-;; transient (pop-up windows like Magit's)
-;; trashed
-;; treemacs
-;; tty-menu
-;; tuareg
-;; typescript
-;; undo-tree
-;; vc (built-in mode line status for version control)
-;; vc-annotate (C-x v g)
-;; vdiff
-;; vimish-fold
-;; visible-mark
-;; visual-regexp
-;; volatile-highlights
-;; vterm
-;; wcheck-mode
-;; web-mode
-;; wgrep
-;; which-function-mode
-;; which-key
-;; whitespace-mode
-;; window-divider-mode
-;; winum
-;; writegood-mode
-;; woman
-;; xah-elisp-mode
-;; xref
-;; xterm-color (and ansi-colors)
-;; yaml-mode
-;; yasnippet
-;; ztree
+;; - modus-themes.el (Main code shared between the themes)
+;; - modus-operandi-theme.el (Light theme)
;;; Code:
-(deftheme modus-vivendi
- "Dark theme that conforms with the highest accessibility
- standard for colour contrast between background and
- foreground elements (WCAG AAA).")
-
-;;; Custom faces
-
-;; These faces will be inherited by actual constructs. They are meant
-;; for those cases where a face needs to distinguish its output from
-;; the rest of the text, such as `isearch' and `occur'… We define
-;; these separately in order to combine each colour with its
-;; appropriate foreground value. This is to ensure a consistent
-;; contrast ratio of >= 7:1.
-(defgroup modus-theme ()
- "Theme that ensures WCAG AAA accessibility (contrast ratio
-between foreground and background is >= 7:1)."
- :group 'faces
- :prefix "modus-theme-"
- :link '(url-link :tag "GitLab" "https://gitlab.com/protesilaos/modus-themes")
- :tag "Modus Vivendi")
-
-(defface modus-theme-subtle-red nil nil)
-(defface modus-theme-subtle-green nil nil)
-(defface modus-theme-subtle-yellow nil nil)
-(defface modus-theme-subtle-blue nil nil)
-(defface modus-theme-subtle-magenta nil nil)
-(defface modus-theme-subtle-cyan nil nil)
-(defface modus-theme-subtle-neutral nil nil)
-(defface modus-theme-intense-red nil nil)
-(defface modus-theme-intense-green nil nil)
-(defface modus-theme-intense-yellow nil nil)
-(defface modus-theme-intense-blue nil nil)
-(defface modus-theme-intense-magenta nil nil)
-(defface modus-theme-intense-cyan nil nil)
-(defface modus-theme-intense-neutral nil nil)
-(defface modus-theme-refine-red nil nil)
-(defface modus-theme-refine-green nil nil)
-(defface modus-theme-refine-yellow nil nil)
-(defface modus-theme-refine-blue nil nil)
-(defface modus-theme-refine-magenta nil nil)
-(defface modus-theme-refine-cyan nil nil)
-(defface modus-theme-active-red nil nil)
-(defface modus-theme-active-green nil nil)
-(defface modus-theme-active-yellow nil nil)
-(defface modus-theme-active-blue nil nil)
-(defface modus-theme-active-magenta nil nil)
-(defface modus-theme-active-cyan nil nil)
-(defface modus-theme-fringe-red nil nil)
-(defface modus-theme-fringe-green nil nil)
-(defface modus-theme-fringe-yellow nil nil)
-(defface modus-theme-fringe-blue nil nil)
-(defface modus-theme-fringe-magenta nil nil)
-(defface modus-theme-fringe-cyan nil nil)
-(defface modus-theme-nuanced-red nil nil)
-(defface modus-theme-nuanced-green nil nil)
-(defface modus-theme-nuanced-yellow nil nil)
-(defface modus-theme-nuanced-blue nil nil)
-(defface modus-theme-nuanced-magenta nil nil)
-(defface modus-theme-nuanced-cyan nil nil)
-(defface modus-theme-special-cold nil nil)
-(defface modus-theme-special-mild nil nil)
-(defface modus-theme-special-warm nil nil)
-(defface modus-theme-special-calm nil nil)
-(defface modus-theme-diff-added nil nil)
-(defface modus-theme-diff-changed nil nil)
-(defface modus-theme-diff-removed nil nil)
-(defface modus-theme-diff-refine-added nil nil)
-(defface modus-theme-diff-refine-changed nil nil)
-(defface modus-theme-diff-refine-removed nil nil)
-(defface modus-theme-diff-focus-added nil nil)
-(defface modus-theme-diff-focus-changed nil nil)
-(defface modus-theme-diff-focus-removed nil nil)
-(defface modus-theme-diff-heading nil nil)
-(defface modus-theme-pseudo-header nil nil)
-(defface modus-theme-mark-alt nil nil)
-(defface modus-theme-mark-del nil nil)
-(defface modus-theme-mark-sel nil nil)
-(defface modus-theme-mark-symbol nil nil)
-(defface modus-theme-heading-1 nil nil)
-(defface modus-theme-heading-2 nil nil)
-(defface modus-theme-heading-3 nil nil)
-(defface modus-theme-heading-4 nil nil)
-(defface modus-theme-heading-5 nil nil)
-(defface modus-theme-heading-6 nil nil)
-(defface modus-theme-heading-7 nil nil)
-(defface modus-theme-heading-8 nil nil)
-(defface modus-theme-hl-line nil nil)
-
-;;; Customisation options
-
-;; User-facing customisation options. They are all deactivated by
-;; default (users must opt in).
-(defcustom modus-vivendi-theme-slanted-constructs nil
- "Use slanted text in more code constructs (italics or oblique)."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-bold-constructs nil
- "Use bold text in more code constructs."
- :type 'boolean)
-
-(define-obsolete-variable-alias 'modus-vivendi-theme-proportional-fonts
- 'modus-vivendi-theme-variable-pitch-headings "`modus-vivendi-theme' 0.11.0")
-
-(defcustom modus-vivendi-theme-proportional-fonts nil
- "Use proportional fonts (variable-pitch) in headings."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-variable-pitch-headings nil
- "Use proportional fonts (variable-pitch) in headings."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-no-mixed-fonts nil
- "Disable inheritance from `fixed-pitch' in some faces.
-
-This is done by default to allow spacing-sensitive constructs,
-such as Org tables and code blocks, to remain monospaced when
-users opt for something like the command `variable-pitch-mode'.
-The downside with the default is that users need to explicitly
-configure the font family of `fixed-pitch' in order to get a
-consistent experience. That may be something they do not want to
-do. Hence this option to disable any kind of technique for
-mixing fonts."
- :type 'boolean)
-
-(make-obsolete 'modus-vivendi-theme-rainbow-headings
- 'modus-vivendi-theme-headings
- "`modus-vivendi-theme' 0.13.0")
-
-(defcustom modus-vivendi-theme-rainbow-headings nil
- "Use more saturated colours for headings."
- :type 'boolean)
-
-(make-obsolete 'modus-vivendi-theme-section-headings
- 'modus-vivendi-theme-headings
- "`modus-vivendi-theme' 0.13.0")
-
-(defcustom modus-vivendi-theme-section-headings nil
- "Use a background and an overline in headings."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-headings
- '((t . nil))
- "Alist of styles for headings, with optional value per level.
-
-To control faces per level from 1-8, use something like this:
-
- (setq modus-vivendi-theme-headings
- '((1 . highlight)
- (2 . line)
- (t . rainbow-line-no-bold)))
-
-To set a uniform value for all heading levels, use this pattern:
-
- (setq modus-vivendi-theme-headings
- '((t . rainbow-line-no-bold)))
-
-The default uses a fairly desaturated foreground value in
-combination with a bold typographic weight. To specify this
-style for a given level N (assuming you wish to have another
-fallback option), just specify the value t like this:
-
- (setq modus-vivendi-theme-headings
- '((1 . t)
- (2 . line)
- (t . rainbow-line-no-bold)))
-
-A description of all possible values:
-
-+ `no-bold' retains the default text colour while removing
- the typographic weight.
-
-+ `line' is the same as the default plus an overline over the
- heading.
-
-+ `line-no-bold' is the same as `line' without bold weight.
-
-+ `rainbow' uses a more colourful foreground in combination
- with bold weight.
-
-+ `rainbow-line' is the same as `rainbow' plus an overline.
-
-+ `rainbow-line-no-bold' is the same as `rainbow-line' without
- the bold weight.
-
-+ `highlight' retains the default style of a fairly desaturated
- foreground combined with a bold weight and add to it a subtle
- accented background.
-
-+ `highlight-no-bold' is the same as `highlight' without a bold
- weight.
-
-+ `rainbow-highlight' is the same as `highlight' but with a more
- colourful foreground.
-
-+ `rainbow-highlight-no-bold' is the same as `rainbow-highlight'
- without a bold weight.
-
-+ `section' retains the default looks and adds to them both an
- overline and a slightly accented background. It is, in effect,
- a combination of the `line' and `highlight' values.
-
-+ `section-no-bold' is the same as `section' without a bold
- weight.
-
-+ `rainbow-section' is the same as `section' but with a more
- colourful foreground.
-
-+ `rainbow-section-no-bold' is the same as `rainbow-section'
- without a bold weight."
- :type
- '(alist
- :key-type symbol
- :value-type
- (choice (const :tag "Fairly desaturated foreground with bold weight (default)" t)
- (const :tag "Like the default without bold weight" no-bold)
- (const :tag "Like the default plus overline" line)
- (const :tag "Like `line' without bold weight" line-no-bold)
- (const :tag "Like the default but with more colourful foreground" rainbow)
- (const :tag "Like `rainbow' plus overline" rainbow-line)
- (const :tag "Like `rainbow' without bold weight" rainbow-no-bold)
- (const :tag "Like `rainbow-line' without bold weight" rainbow-line-no-bold)
- (const :tag "Like the default plus subtle background" highlight)
- (const :tag "Like `highlight' without bold weight" highlight-no-bold)
- (const :tag "Like `highlight' with more colourful foreground" rainbow-highlight)
- (const :tag "Like `rainbow-highlight' without bold weight" rainbow-highlight-no-bold)
- (const :tag "Like `highlight' plus overline" section)
- (const :tag "Like `section' without bold weight" section-no-bold)
- (const :tag "Like `section' with more colourful foreground" rainbow-section)
- (const :tag "Like `rainbow-section' without bold weight" rainbow-section-no-bold))))
-
-(defcustom modus-vivendi-theme-scale-headings nil
- "Use font scaling for headings."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-scale-1 1.05
- "Font size that is slightly larger than the base value.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-vivendi-theme-scale-2 1.1
- "Font size slightly larger than `modus-vivendi-theme-scale-1'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-vivendi-theme-scale-3 1.15
- "Font size slightly larger than `modus-vivendi-theme-scale-2'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-vivendi-theme-scale-4 1.2
- "Font size slightly larger than `modus-vivendi-theme-scale-3'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(defcustom modus-vivendi-theme-scale-5 1.3
- "Font size slightly larger than `modus-vivendi-theme-scale-4'.
-The default is a floating point that is interpreted as a multiple
-of the base font size. However, the variable also accepts an
-integer, understood as an absolute height (e.g. a value of 140 is
-the same as setting the font at 14 point size).
-
-For more on the matter, read the documentation of
-`set-face-attribute', specifically the ':height' section."
- :type 'number)
-
-(make-obsolete 'modus-vivendi-theme-visible-fringes
- 'modus-vivendi-theme-fringes
- "`modus-vivendi-theme' 0.12.0")
-
-(defcustom modus-vivendi-theme-visible-fringes nil
- "Use a visible style for fringes."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-fringes nil
- "Define the visibility of fringes.
-
-Nil means the fringes have no background colour. Option `subtle'
-will apply a greyscale value that is visible yet close to the
-main buffer background colour. Option `intense' will use a more
-pronounced greyscale value."
- :type '(choice
- (const :tag "No visible fringes (default)" nil)
- (const :tag "Subtle greyscale background" subtle)
- (const :tag "Intense greyscale background" intense)))
-
-(make-obsolete 'modus-vivendi-theme-distinct-org-blocks
- 'modus-vivendi-theme-org-blocks
- "`modus-vivendi-theme' 0.11.0")
-
-(defcustom modus-vivendi-theme-distinct-org-blocks nil
- "Use a distinct neutral background for `org-mode' blocks."
- :type 'boolean)
-
-(make-obsolete 'modus-vivendi-theme-rainbow-org-src-blocks
- 'modus-vivendi-theme-org-blocks
- "`modus-vivendi-theme' 0.11.0")
-
-(defcustom modus-vivendi-theme-rainbow-org-src-blocks nil
- "Use colour-coded backgrounds for `org-mode' source blocks.
-The colour in use depends on the language (send feedback to
-include more languages)."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-org-blocks nil
- "Use a subtle grey or colour-coded background for Org blocks.
-
-Nil means that the block will have no background of its own and
-will use the default that applies to the rest of the buffer.
-
-Option `greyscale' will apply a subtle neutral grey background to
-the block's contents. It also affects the begin and end lines of
-the block: their background will be extended to the edge of the
-window for Emacs version >= 27 where the ':extend' keyword is
-recognised by `set-face-attribute'.
-
-Option `rainbow' will use an accented background for the contents
-of the block. The exact colour will depend on the programming
-language and is controlled by the `org-src-block-faces'
-variable (refer to the theme's source code for the current
-association list)."
- :type '(choice
- (const :tag "No Org block background (default)" nil)
- (const :tag "Subtle grey block background" greyscale)
- (const :tag "Colour-coded background per programming language" rainbow)))
-
-(make-obsolete 'modus-vivendi-theme-3d-modeline
- 'modus-vivendi-theme-mode-line
- "`modus-vivendi-theme' 0.13.0")
-
-(defcustom modus-vivendi-theme-3d-modeline nil
- "Use a three-dimensional style for the active mode line."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-mode-line nil
- "Adjust the overall style of the mode line.
-
-Nil is a two-dimensional rectangle with a border around it. The
-active and the inactive modelines use different shades of
-greyscale values for the background and foreground.
-
-A `3d' value will apply a three-dimensional effect to the active
-modeline. The inactive modelines remain two-dimensional and are
-toned down a bit, relative to the nil value.
-
-The `moody' option is meant to optimise the modeline for use with
-the library of the same name. This practically means to remove
-the box effect and rely on underline and overline properties
-instead. It also tones down the inactive modelines. Despite its
-intended purpose, this option can also be used without the
-`moody' library."
- :type '(choice
- (const :tag "Two-dimensional box (default)" nil)
- (const :tag "Three-dimensional style for the active mode line" 3d)
- (const :tag "No box effects, which are optimal for use with the `moody' library" moody)))
-
-(make-obsolete 'modus-vivendi-theme-subtle-diffs
- 'modus-vivendi-theme-diffs
- "`modus-vivendi-theme' 0.13.0")
-
-(defcustom modus-vivendi-theme-subtle-diffs nil
- "Use fewer/dim backgrounds in `diff-mode', `ediff',`magit'."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-diffs nil
- "Adjust the overall styles of diffs.
-
-Nil means to use fairly intense colour combinations for diffs.
-For example, you get a rich green background with a green
-foreground for added lines. Word-wise or 'refined' diffs follow
-the same pattern but use different shades of those colours to
-remain distinct.
-
-A `desaturated' value follows the same principles as with the nil
-option, while it tones down all relevant colours.
-
-Option `fg-only' will remove all accented backgrounds, except
-from word-wise changes. It instead uses colour-coded foreground
-values to differentiate between added/removed/changed lines. If
-a background is necessary, such as with `ediff', then a subtle
-greyscale value is used."
- :type '(choice
- (const :tag "Intensely coloured backgrounds (default)" nil)
- (const :tag "Slightly accented backgrounds with tinted text" desaturated)
- (const :tag "No backgrounds, except for refined diffs" fg-only)))
-
-(make-obsolete 'modus-vivendi-theme-intense-standard-completions
- 'modus-vivendi-theme-completions
- "`modus-vivendi-theme' 0.12.0")
-
-(defcustom modus-vivendi-theme-intense-standard-completions nil
- "Use prominent backgrounds for Icomplete, Ido, or similar."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-completions nil
- "Apply special styles to the UI of completion frameworks.
-
-This concerns Icomplete, Ivy, Helm, Selectrum, Ido, as well as
-any other tool meant to enhance their experience. The effect
-will vary depending on the completion framework.
-
-Nil means to remain faithful to the metaphors that each UI
-establishes. For example, Icomplete and Ido only use foreground
-colours to style their matches, whereas Ivy or Helm rely on an
-aesthetic that combines coloured backgrounds with appropriate
-text colour.
-
-Option `moderate' will apply a combination of background and
-foreground that is fairly subtle. For Icomplete and the like,
-this constitutes a departure from their standard style. While
-Ivy, Helm, and the others, will use less pronounced colours for
-applicable contexts.
-
-Option `opinionated' will apply colour combinations that
-refashion the completion UI. So Icomplete et al will now use
-styles that resemble the defaults of Ivy and co., while the
-latter group will revert to an even more nuanced aesthetic."
- :type '(choice
- (const :tag "Respect the framework's established aesthetic (default)" nil)
- (const :tag "Subtle backgrounds for various elements" moderate)
- (const :tag "Radical alternative to the framework's looks" opinionated)))
-
-(defcustom modus-vivendi-theme-prompts nil
- "Use subtle or intense styles for minibuffer and REPL prompts.
-
-Nil means to only use an accented foreground colour.
-
-Options `subtle' and `intense' will change both the background
-and the foreground values. The latter has a more pronounced
-effect than the former."
- :type '(choice
- (const :tag "No prompt background (default)" nil)
- (const :tag "Subtle accented background for the prompt" subtle)
- (const :tag "Intense background and foreground for the prompt" intense)))
-
-(defcustom modus-vivendi-theme-intense-hl-line nil
- "Use more prominent background for command `hl-line-mode'."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-intense-paren-match nil
- "Use more prominent colour for parenthesis matching."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-faint-syntax nil
- "Use less saturated colours for code syntax highlighting."
- :type 'boolean)
-
-(defcustom modus-vivendi-theme-no-link-underline nil
- "Do not underline links."
- :type 'boolean)
-
-;;; Internal functions
-
-;; Helper functions that are meant to ease the implementation of the
-;; above customisation options.
-(defun modus-vivendi-theme-bold-weight ()
- "Conditional use of a heavier text weight."
- (when modus-vivendi-theme-bold-constructs
- (list :inherit 'bold)))
-
-(defun modus-vivendi-theme-mixed-fonts ()
- "Conditional application of `fixed-pitch' inheritance."
- (unless modus-vivendi-theme-no-mixed-fonts
- (list :inherit 'fixed-pitch)))
-
-(defun modus-vivendi-theme-fringe (subtlebg intensebg)
- "Conditional use of background colours for fringes.
-SUBTLEBG should be a subtle greyscale value. INTENSEBG must be a
-more pronounced greyscale colour."
- (pcase modus-vivendi-theme-fringes
- ('intense (list :background intensebg))
- ('subtle (list :background subtlebg))
- (_ (list :background nil))))
-
-(defun modus-vivendi-theme-prompt (mainfg subtlebg subtlefg intensebg intensefg)
- "Conditional use of background colours for prompts.
-MAINFG is the prompt's standard foreground. SUBTLEBG should be a
-subtle accented background that works with SUBTLEFG. INTENSEBG
-must be a more pronounced accented colour that should be
-combinable with INTENSEFG."
- (pcase modus-vivendi-theme-prompts
- ('intense (list :background intensebg :foreground intensefg))
- ('subtle (list :background subtlebg :foreground subtlefg))
- (_ (list :background nil :foreground mainfg))))
-
-(defun modus-vivendi-theme-paren (normalbg intensebg)
- "Conditional use of intense colours for matching parentheses.
-NORMALBG should the special palette colour 'bg-paren-match' or
-something similar. INTENSEBG must be easier to discern next to
-other backgrounds, such as the special palette colour
-'bg-paren-match-intense'."
- (if modus-vivendi-theme-intense-paren-match
- (list :background intensebg)
- (list :background normalbg)))
-
-(defun modus-vivendi-theme-syntax-foreground (normal faint)
- "Apply foreground value to code syntax.
-NORMAL is the more saturated colour, which should be the default.
-FAINT is the less saturated colour."
- (if modus-vivendi-theme-faint-syntax
- (list :foreground faint)
- (list :foreground normal)))
-
-(defun modus-vivendi-theme-heading-p (key)
- "Query style of KEY in `modus-vivendi-theme-headings'."
- (cdr (assoc key modus-vivendi-theme-headings)))
-
-(defun modus-vivendi-theme-heading (level fg fg-alt bg border)
- "Conditional styles for `modus-vivendi-theme-headings'.
-
-LEVEL is the heading's position in their order. FG is the
-default text colour. FG-ALT is an accented, more saturated value
-than the default. BG is a nuanced, typically accented,
-background that can work well with either of the foreground
-values. BORDER is a colour value that combines well with the
-background and alternative foreground."
- (let* ((key (modus-vivendi-theme-heading-p `,level))
- (style (or key (modus-vivendi-theme-heading-p t)))
- (var (if modus-vivendi-theme-variable-pitch-headings
- 'variable-pitch
- 'default)))
- (pcase style
- ('no-bold
- (list :inherit `,var :foreground fg))
- ('line
- (list :inherit `(bold ,var) :foreground fg :overline border))
- ('line-no-bold
- (list :inherit `,var :foreground fg :overline border))
- ('rainbow
- (list :inherit `(bold ,var) :foreground fg-alt))
- ('rainbow-no-bold
- (list :inherit `,var :foreground fg-alt))
- ('rainbow-line
- (list :inherit `(bold ,var) :foreground fg-alt :overline border))
- ('rainbow-line-no-bold
- (list :inherit `,var :foreground fg-alt :overline border))
- ('highlight
- (list :inherit `(bold ,var) :background bg :foreground fg))
- ('highlight-no-bold
- (list :inherit `,var :background bg :foreground fg))
- ('rainbow-highlight
- (list :inherit `(bold ,var) :background bg :foreground fg-alt))
- ('rainbow-highlight-no-bold
- (list :inherit `,var :background bg :foreground fg-alt))
- ('section
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `(bold ,var) :background bg :foreground fg :overline border)))
- ('section-no-bold
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `,var :background bg :foreground fg :overline border)))
- ('rainbow-section
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `(bold ,var) :background bg :foreground fg-alt :overline border)))
- ('rainbow-section-no-bold
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :inherit `,var :background bg :foreground fg-alt :overline border)))
- (_
- (list :inherit `(bold ,var) :foreground fg)))))
-
-(defun modus-vivendi-theme-org-block (bgblk)
- "Conditionally set the background of Org blocks.
-BGBLK applies to a distinct neutral background. Else blocks have
-no background of their own (the default), so they look the same
-as the rest of the buffer.
-
-`modus-vivendi-theme-org-blocks' also accepts a `rainbow' option
-which is applied conditionally to `org-src-block-faces' (see the
-theme's source code)."
- (if (eq modus-vivendi-theme-org-blocks 'greyscale)
- (append
- (and (>= emacs-major-version 27) '(:extend t))
- (list :background bgblk))
- (list :background nil)))
-
-(defun modus-vivendi-theme-org-block-delim (bgaccent fgaccent bg fg)
- "Conditionally set the styles of Org block delimiters.
-BG, FG, BGACCENT, FGACCENT apply a background and foreground
-colour respectively.
-
-The former pair is a greyscale combination that should be more
-distinct than the background of the block. It is applied to the
-default styles or when `modus-vivendi-theme-org-blocks' is set
-to `greyscale'.
-
-The latter pair should be more subtle than the background of the
-block, as it is used when `modus-vivendi-theme-org-blocks' is
-set to `rainbow'."
- (pcase modus-vivendi-theme-org-blocks
- ('greyscale (append (and (>= emacs-major-version 27) '(:extend t))
- (list :background bg :foreground fg)))
- ('rainbow (list :background bgaccent :foreground fgaccent))
- (_ (list :background bg :foreground fg))))
-
-(defun modus-vivendi-theme-mode-line-attrs
- (fg bg fg-alt bg-alt border border-3d &optional alt-style border-width fg-distant)
- "Colour combinations for `modus-vivendi-theme-mode-line'.
-
-FG and BG are the default colours. FG-ALT and BG-ALT are meant
-to accommodate the options for a 3D modeline or a `moody'
-compliant one. BORDER applies to all permutations of the
-modeline, except the three-dimensional effect, where BORDER-3D is
-used instead.
-
-Optional ALT-STYLE applies an appropriate style to the mode
-line's box property.
-
-Optional BORDER-WIDTH specifies an integer for the width of the
-rectangle that produces the box effect.
-
-Optional FG-DISTANT should be close to the main background
-values. It is intended to be used as a distant-foreground
-property."
- (pcase modus-vivendi-theme-mode-line
- ('3d
- `(:background ,bg-alt :foreground ,fg-alt
- :box (:line-width ,(or border-width 1)
- :color ,border-3d
- :style ,(and alt-style 'released-button))))
- ('moody
- `(:background ,bg-alt :foreground ,fg-alt :underline ,border :overline ,border
- :distant-foreground ,fg-distant))
- (_
- `(:foreground ,fg :background ,bg :box ,border))))
-
-(defun modus-vivendi-theme-diff (fg-only-bg fg-only-fg mainbg mainfg altbg altfg)
- "Colour combinations for `modus-vivendi-theme-diffs'.
-
-FG-ONLY-BG should be similar or the same as the main background.
-FG-ONLY-FG should be a saturated accent value that can be
-combined with the former.
-
-MAINBG must be one of the dedicated backgrounds for diffs while
-MAINFG must be the same for the foreground.
-
-ALTBG needs to be a slightly accented background that is meant to
-be combined with ALTFG. Both must be less intense than MAINBG
-and MAINFG respectively."
- (pcase modus-vivendi-theme-diffs
- ('fg-only (list :background fg-only-bg :foreground fg-only-fg))
- ('desaturated (list :background altbg :foreground altfg))
- (_ (list :background mainbg :foreground mainfg))))
-
-(defun modus-vivendi-theme-standard-completions (mainfg subtlebg intensebg intensefg)
- "Combinations for `modus-vivendi-theme-completions'.
-
-MAINFG is an accented foreground value. SUBTLEBG is an accented
-background value that can be combined with MAINFG. INTENSEBG and
-INTENSEFG are accented colours that are designed to be used in
-tandem.
-
-These are intended for Icomplete, Ido, and related."
- (pcase modus-vivendi-theme-completions
- ('opinionated (list :background intensebg :foreground intensefg))
- ('moderate (list :background subtlebg :foreground mainfg))
- (_ (list :foreground mainfg))))
-
-(defun modus-vivendi-theme-extra-completions (subtleface intenseface altface &optional altfg bold)
- "Combinations for `modus-vivendi-theme-completions'.
-
-SUBTLEFACE and INTENSEFACE are custom theme faces that combine a
-background and foreground value. The difference between the two
-is a matter of degree.
-
-ALTFACE is a combination of colours that represents a departure
-from the UI's default aesthetics. Optional ALTFG is meant to be
-used in tandem with it.
-
-Optional BOLD will apply a heavier weight to the text.
-
-These are intended for Helm, Ivy, etc."
- (pcase modus-vivendi-theme-completions
- ('opinionated (list :inherit (list altface bold)
- :foreground (or altfg 'unspecified)))
- ('moderate (list :inherit (list subtleface bold)))
- (_ (list :inherit (list intenseface bold)))))
-
-(defun modus-vivendi-theme-scale (amount)
- "Scale heading by AMOUNT.
-
-AMOUNT is a customisation option."
- (when modus-vivendi-theme-scale-headings
- (list :height amount)))
-
-;;; Colour palette
-
-;; Define colour palette. Each colour must have a >= 7:1 contrast
-;; ratio relative to the foreground/background colour it is rendered
-;; against.
-;;
-;; The design of the colour palette as a macro that maps it to faces is
-;; adapted from zenbern-theme.el, last seen at commit 7dd7968:
-;; https://github.com/bbatsov/zenburn-emacs
(eval-and-compile
- (defconst modus-vivendi-theme-default-colors-alist
- '(;; base values
- ("bg-main" . "#000000") ("fg-main" . "#ffffff")
- ("bg-alt" . "#181a20") ("fg-alt" . "#a8a8a8")
- ("bg-dim" . "#110b11") ("fg-dim" . "#e0e6f0")
- ;; specifically for on/off states (e.g. `mode-line')
- ;;
- ;; must be combined with themselves
- ("bg-active" . "#323232") ("fg-active" . "#f4f4f4")
- ("bg-inactive" . "#1e1e1e") ("fg-inactive" . "#bfc0c4")
- ;; special base values, used only for cases where the above
- ;; fg-* or bg-* cannot or should not be used (to avoid confusion)
- ;; must be combined with: {fg,bg}-{main,alt,dim}
- ("bg-special-cold" . "#203448") ("fg-special-cold" . "#c6eaff")
- ("bg-special-mild" . "#00322e") ("fg-special-mild" . "#bfebe0")
- ("bg-special-warm" . "#382f27") ("fg-special-warm" . "#f8dec0")
- ("bg-special-calm" . "#392a48") ("fg-special-calm" . "#fbd6f4")
- ;; styles for the main constructs
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red" . "#ff8059") ("green" . "#44bc44")
- ("yellow" . "#eecc00") ("blue" . "#2fafff")
- ("magenta" . "#feacd0") ("cyan" . "#00d3d0")
- ;; styles for common, but still specialised constructs
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red-alt" . "#f4923b") ("green-alt" . "#80d200")
- ("yellow-alt" . "#cfdf30") ("blue-alt" . "#79a8ff")
- ("magenta-alt" . "#f78fe7") ("cyan-alt" . "#4ae8fc")
- ;; same purpose as above, just slight differences
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red-alt-other" . "#ff9977") ("green-alt-other" . "#00cd68")
- ("yellow-alt-other" . "#f0ce43") ("blue-alt-other" . "#00bcff")
- ("magenta-alt-other" . "#b6a0ff") ("cyan-alt-other" . "#6ae4b9")
- ;; styles for desaturated foreground text, intended for use with
- ;; the `modus-vivendi-theme-faint-syntax' option
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim'
- ("red-faint" . "#ffa0a0") ("green-faint" . "#88cf88")
- ("yellow-faint" . "#d2b580") ("blue-faint" . "#92baff")
- ("magenta-faint" . "#e0b2d6") ("cyan-faint" . "#a0bfdf")
-
- ("red-alt-faint" . "#f5aa80") ("green-alt-faint" . "#a8cf88")
- ("yellow-alt-faint" . "#cabf77") ("blue-alt-faint" . "#a4b0ff")
- ("magenta-alt-faint" . "#ef9fe4") ("cyan-alt-faint" . "#90c4ed")
-
- ("red-alt-other-faint" . "#ff9fbf") ("green-alt-other-faint" . "#88cfaf")
- ("yellow-alt-other-faint" . "#d0ba95") ("blue-alt-other-faint" . "#8fc5ff")
- ("magenta-alt-other-faint" . "#d0b4ff") ("cyan-alt-other-faint" . "#a4d0bb")
- ;; styles for elements that should be very subtle, yet accented
- ;;
- ;; must be combined with: `bg-main', `bg-alt', `bg-dim' or any of
- ;; the "nuanced" backgrounds
- ("red-nuanced" . "#ffcccc") ("green-nuanced" . "#b8e2b8")
- ("yellow-nuanced" . "#dfdfb0") ("blue-nuanced" . "#bfd9ff")
- ("magenta-nuanced" . "#e5cfef") ("cyan-nuanced" . "#a8e5e5")
- ;; styles for slightly accented background
- ;;
- ;; must be combined with any of the above foreground values
- ("red-nuanced-bg" . "#2c0614") ("green-nuanced-bg" . "#001904")
- ("yellow-nuanced-bg" . "#221000") ("blue-nuanced-bg" . "#0f0e39")
- ("magenta-nuanced-bg" . "#230631") ("cyan-nuanced-bg" . "#041529")
- ;; styles for elements that should draw attention to themselves
- ;;
- ;; must be combined with: `bg-main'
- ("red-intense" . "#fb6859") ("green-intense" . "#00fc50")
- ("yellow-intense" . "#ffdd00") ("blue-intense" . "#00a2ff")
- ("magenta-intense" . "#ff8bd4") ("cyan-intense" . "#30ffc0")
- ;; styles for background elements that should be visible yet
- ;; subtle
- ;;
- ;; must be combined with: `fg-dim'
- ("red-subtle-bg" . "#762422") ("green-subtle-bg" . "#2f4a00")
- ("yellow-subtle-bg" . "#604200") ("blue-subtle-bg" . "#10387c")
- ("magenta-subtle-bg" . "#49366e") ("cyan-subtle-bg" . "#00415e")
- ;; styles for background elements that should be visible and
- ;; distinguishable
- ;;
- ;; must be combined with: `fg-main'
- ("red-intense-bg" . "#a4202a") ("green-intense-bg" . "#006800")
- ("yellow-intense-bg" . "#874900") ("blue-intense-bg" . "#2a40b8")
- ("magenta-intense-bg" . "#7042a2") ("cyan-intense-bg" . "#005f88")
- ;; styles for refined contexts where both the foreground and the
- ;; background need to have the same/similar hue
- ;;
- ;; must be combined with themselves OR the foregrounds can be
- ;; combined with any of the base backgrounds
- ("red-refine-bg" . "#77002a") ("red-refine-fg" . "#ffb9ab")
- ("green-refine-bg" . "#00422a") ("green-refine-fg" . "#9ff0cf")
- ("yellow-refine-bg" . "#693200") ("yellow-refine-fg" . "#e2d980")
- ("blue-refine-bg" . "#242679") ("blue-refine-fg" . "#8ec6ff")
- ("magenta-refine-bg" . "#71206a") ("magenta-refine-fg" . "#ffcaf0")
- ("cyan-refine-bg" . "#004065") ("cyan-refine-fg" . "#8ae4f2")
- ;; styles that are meant exclusively for the mode line
- ;;
- ;; must be combined with: `bg-active', `bg-inactive'
- ("red-active" . "#ffa7ba") ("green-active" . "#70d73f")
- ("yellow-active" . "#dbbe5f") ("blue-active" . "#34cfff")
- ("magenta-active" . "#d5b1ff") ("cyan-active" . "#00d8b4")
- ;; styles that are meant exclusively for the fringes
- ;;
- ;; must be combined with `fg-main'
- ("red-fringe-bg" . "#8f1f4b") ("green-fringe-bg" . "#006700")
- ("yellow-fringe-bg" . "#6f4f00") ("blue-fringe-bg" . "#3f33af")
- ("magenta-fringe-bg" . "#6f2f89") ("cyan-fringe-bg" . "#004f8f")
- ;; styles reserved for specific faces
- ;;
- ;; `bg-hl-line' is between `bg-dim' and `bg-alt', so it should
- ;; work with all accents that cover those two, plus `bg-main'
- ;;
- ;; `bg-hl-alt' and `bg-hl-alt-intense' should only be used when no
- ;; other greyscale or fairly neutral background is available to
- ;; properly draw attention to a given construct
- ;;
- ;; `bg-header' is between `bg-active' and `bg-inactive', so it
- ;; can be combined with any of the "active" values, plus the
- ;; "special" and base foreground colours
- ;;
- ;; `bg-paren-match', `bg-paren-match-intense', `bg-region' and
- ;; `bg-tab-active' must be combined with `fg-main', while
- ;; `bg-tab-inactive' should be combined with `fg-dim'
- ;;
- ;; `bg-tab-bar' is only intended for the bar that holds the tabs and
- ;; can only be combined with `fg-main'
- ;;
- ;; `fg-tab-active' is meant to be combined with `bg-tab-active',
- ;; though only for styling special elements, such as underlining
- ;; the current tab
- ;;
- ;; `fg-escape-char-construct' and `fg-escape-char-backslash' can
- ;; be combined `bg-main', `bg-dim', `bg-alt'
- ;;
- ;; `fg-lang-error', `fg-lang-warning', `fg-lang-note' can be
- ;; combined with `bg-main', `bg-dim', `bg-alt'
- ;;
- ;; `fg-mark-sel', `fg-mark-del', `fg-mark-alt' can be combined
- ;; with `bg-main', `bg-dim', `bg-alt', `bg-hl-line'
- ;;
- ;; `fg-unfocused' must be combined with `fg-main'
- ;;
- ;; the window divider colours apply to faces with just an fg value
- ;;
- ;; all pairs are combinable with themselves
- ("bg-hl-line" . "#151823")
- ("bg-hl-line-intense" . "#2f2f2f")
- ("bg-hl-alt" . "#181732")
- ("bg-hl-alt-intense" . "#282e46")
- ("bg-paren-match" . "#5f362f")
- ("bg-paren-match-intense" . "#7416b5")
- ("bg-region" . "#3c3c3c")
-
- ("bg-tab-bar" . "#2c2c2c")
- ("bg-tab-active" . "#0e0e0e")
- ("bg-tab-inactive" . "#3d3d3d")
- ("fg-tab-active" . "#5ac3cf")
-
- ("fg-escape-char-construct" . "#e7a59a")
- ("fg-escape-char-backslash" . "#abab00")
+ (unless (and (fboundp 'require-theme)
+ load-file-name
+ (equal (file-name-directory load-file-name)
+ (expand-file-name "themes/" data-directory))
+ (require-theme 'modus-themes t))
+ (require 'modus-themes)))
- ("fg-lang-error" . "#ef8690")
- ("fg-lang-warning" . "#b0aa00")
- ("fg-lang-note" . "#9d9def")
-
- ("fg-window-divider-inner" . "#646464")
- ("fg-window-divider-outer" . "#969696")
-
- ("fg-unfocused" . "#93959b")
-
- ("bg-header" . "#212121") ("fg-header" . "#dddddd")
-
- ("bg-whitespace" . "#170016") ("fg-whitespace" . "#a4959f")
-
- ("bg-diff-heading" . "#304466") ("fg-diff-heading" . "#dadffe")
- ("bg-diff-added" . "#0a280a") ("fg-diff-added" . "#94ba94")
- ("bg-diff-changed" . "#2a2000") ("fg-diff-changed" . "#b0ba9f")
- ("bg-diff-removed" . "#40160f") ("fg-diff-removed" . "#c6adaa")
-
- ("bg-diff-refine-added" . "#005a36") ("fg-diff-refine-added" . "#e0f6e0")
- ("bg-diff-refine-changed" . "#585800") ("fg-diff-refine-changed" . "#ffffcc")
- ("bg-diff-refine-removed" . "#852828") ("fg-diff-refine-removed" . "#ffd9eb")
-
- ("bg-diff-focus-added" . "#203d20") ("fg-diff-focus-added" . "#b4ddb4")
- ("bg-diff-focus-changed" . "#4a3a10") ("fg-diff-focus-changed" . "#d0daaf")
- ("bg-diff-focus-removed" . "#5e2526") ("fg-diff-focus-removed" . "#eebdba")
-
- ("bg-diff-neutral-0" . "#575757") ("fg-diff-neutral-0" . "#fcfcfc")
- ("bg-diff-neutral-1" . "#454545") ("fg-diff-neutral-1" . "#dddddd")
- ("bg-diff-neutral-2" . "#313131") ("fg-diff-neutral-2" . "#bfbfbf")
-
- ("bg-mark-sel" . "#002f2f") ("fg-mark-sel" . "#60cfa2")
- ("bg-mark-del" . "#5a0000") ("fg-mark-del" . "#ff99aa")
- ("bg-mark-alt" . "#3f2210") ("fg-mark-alt" . "#f0aa20"))
- "The entire palette of `modus-vivendi-theme'.
-Each element has the form (NAME . HEX).")
-
- (defcustom modus-vivendi-theme-override-colors-alist '()
- "Association list of palette colour overrides.
-Values can be mapped to variables, using the same syntax as the
-one present in `modus-vivendi-theme-default-colors-alist'.
-
-This is only meant for do-it-yourself usage, with the
-understanding that the user is responsible for the resulting
-contrast ratio between new and existing colours."
- :type '(alist
- :key-type (string :tag "Name")
- :value-type (string :tag " Hex")))
-
- (defmacro modus-vivendi-theme-with-color-variables (&rest body)
- "`let' bind all colours around BODY.
-Also bind `class' to ((class color) (min-colors 89))."
- (declare (indent 0))
- `(let ((class '((class color) (min-colors 89)))
- ,@(mapcar (lambda (cons)
- (list (intern (car cons)) (cdr cons)))
- (append modus-vivendi-theme-default-colors-alist
- modus-vivendi-theme-override-colors-alist))
- ;; simple conditional styles that evaluate user-facing
- ;; customisation options
- (modus-theme-slant
- (if modus-vivendi-theme-slanted-constructs 'italic 'normal))
- (modus-theme-variable-pitch
- (if modus-vivendi-theme-variable-pitch-headings 'variable-pitch 'default)))
- ,@body)))
-
-
-
-;;; Faces
-
-(modus-vivendi-theme-with-color-variables
- (custom-theme-set-faces
- 'modus-vivendi
-;;;; custom faces
- ;; these bespoke faces are inherited by other constructs below
-;;;;; subtle coloured backgrounds
- `(modus-theme-subtle-red ((,class :background ,red-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-green ((,class :background ,green-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-yellow ((,class :background ,yellow-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-blue ((,class :background ,blue-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-magenta ((,class :background ,magenta-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-cyan ((,class :background ,cyan-subtle-bg :foreground ,fg-dim)))
- `(modus-theme-subtle-neutral ((,class :background ,bg-inactive :foreground ,fg-inactive)))
-;;;;; intense coloured backgrounds
- `(modus-theme-intense-red ((,class :background ,red-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-green ((,class :background ,green-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-yellow ((,class :background ,yellow-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-blue ((,class :background ,blue-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-magenta ((,class :background ,magenta-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-cyan ((,class :background ,cyan-intense-bg :foreground ,fg-main)))
- `(modus-theme-intense-neutral ((,class :background ,bg-active :foreground ,fg-main)))
-;;;;; refined background and foreground combinations
- ;; general purpose styles that use an accented foreground against an
- ;; accented background
- `(modus-theme-refine-red ((,class :background ,red-refine-bg :foreground ,red-refine-fg)))
- `(modus-theme-refine-green ((,class :background ,green-refine-bg :foreground ,green-refine-fg)))
- `(modus-theme-refine-yellow ((,class :background ,yellow-refine-bg :foreground ,yellow-refine-fg)))
- `(modus-theme-refine-blue ((,class :background ,blue-refine-bg :foreground ,blue-refine-fg)))
- `(modus-theme-refine-magenta ((,class :background ,magenta-refine-bg :foreground ,magenta-refine-fg)))
- `(modus-theme-refine-cyan ((,class :background ,cyan-refine-bg :foreground ,cyan-refine-fg)))
-;;;;; "active" combinations, mostly for use on the mode line
- `(modus-theme-active-red ((,class :background ,red-active :foreground ,bg-active)))
- `(modus-theme-active-green ((,class :background ,green-active :foreground ,bg-active)))
- `(modus-theme-active-yellow ((,class :background ,yellow-active :foreground ,bg-active)))
- `(modus-theme-active-blue ((,class :background ,blue-active :foreground ,bg-active)))
- `(modus-theme-active-magenta ((,class :background ,magenta-active :foreground ,bg-active)))
- `(modus-theme-active-cyan ((,class :background ,cyan-active :foreground ,bg-active)))
-;;;;; nuanced backgrounds
- ;; useful for adding an accented background that is suitable for all
- ;; main foreground colours (intended for use in Org source blocks)
- `(modus-theme-nuanced-red ((,class :background ,red-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-green ((,class :background ,green-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-yellow ((,class :background ,yellow-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-blue ((,class :background ,blue-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-magenta ((,class :background ,magenta-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(modus-theme-nuanced-cyan ((,class :background ,cyan-nuanced-bg
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
-;;;;; fringe-specific combinations
- `(modus-theme-fringe-red ((,class :background ,red-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-green ((,class :background ,green-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-yellow ((,class :background ,yellow-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-blue ((,class :background ,blue-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-magenta ((,class :background ,magenta-fringe-bg :foreground ,fg-main)))
- `(modus-theme-fringe-cyan ((,class :background ,cyan-fringe-bg :foreground ,fg-main)))
-;;;;; special base values
- ;; these are closer to the grayscale than the accents defined above
- ;; and should only be used when the next closest alternative would be
- ;; a greyscale value than an accented one
- `(modus-theme-special-cold ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
- `(modus-theme-special-mild ((,class :background ,bg-special-mild :foreground ,fg-special-mild)))
- `(modus-theme-special-warm ((,class :background ,bg-special-warm :foreground ,fg-special-warm)))
- `(modus-theme-special-calm ((,class :background ,bg-special-calm :foreground ,fg-special-calm)))
-;;;;; diff-specific combinations
- ;; intended for `diff-mode' or equivalent
- `(modus-theme-diff-added
- ((,class ,@(modus-vivendi-theme-diff
- bg-main green
- bg-diff-focus-added fg-diff-focus-added
- green-nuanced-bg fg-diff-added))))
- `(modus-theme-diff-changed
- ((,class ,@(modus-vivendi-theme-diff
- bg-main yellow
- bg-diff-focus-changed fg-diff-focus-changed
- yellow-nuanced-bg fg-diff-changed))))
- `(modus-theme-diff-removed
- ((,class ,@(modus-vivendi-theme-diff
- bg-main red
- bg-diff-focus-removed fg-diff-focus-removed
- red-nuanced-bg fg-diff-removed))))
- `(modus-theme-diff-refine-added
- ((,class ,@(modus-vivendi-theme-diff
- bg-diff-added fg-diff-added
- bg-diff-refine-added fg-diff-refine-added
- bg-diff-focus-added fg-diff-focus-added))))
- `(modus-theme-diff-refine-changed
- ((,class ,@(modus-vivendi-theme-diff
- bg-diff-changed fg-diff-changed
- bg-diff-refine-changed fg-diff-refine-changed
- bg-diff-focus-changed fg-diff-focus-changed))))
- `(modus-theme-diff-refine-removed
- ((,class ,@(modus-vivendi-theme-diff
- bg-diff-removed fg-diff-removed
- bg-diff-refine-removed fg-diff-refine-removed
- bg-diff-focus-removed fg-diff-focus-removed))))
- `(modus-theme-diff-focus-added
- ((,class ,@(modus-vivendi-theme-diff
- bg-dim green
- bg-diff-focus-added fg-diff-focus-added
- bg-diff-added fg-diff-added))))
- `(modus-theme-diff-focus-changed
- ((,class ,@(modus-vivendi-theme-diff
- bg-dim yellow
- bg-diff-focus-changed fg-diff-focus-changed
- bg-diff-changed fg-diff-changed))))
- `(modus-theme-diff-focus-removed
- ((,class ,@(modus-vivendi-theme-diff
- bg-dim red
- bg-diff-focus-removed fg-diff-focus-removed
- bg-diff-removed fg-diff-removed))))
- `(modus-theme-diff-heading
- ((,class ,@(modus-vivendi-theme-diff
- bg-alt blue-alt
- bg-diff-heading fg-diff-heading
- blue-nuanced-bg blue))))
-;;;;; mark indicators
- ;; colour combinations intended for Dired, Ibuffer, or equivalent
- `(modus-theme-pseudo-header ((,class :inherit bold :foreground ,fg-main)))
- `(modus-theme-mark-alt ((,class :inherit bold :background ,bg-mark-alt :foreground ,fg-mark-alt)))
- `(modus-theme-mark-del ((,class :inherit bold :background ,bg-mark-del :foreground ,fg-mark-del)))
- `(modus-theme-mark-sel ((,class :inherit bold :background ,bg-mark-sel :foreground ,fg-mark-sel)))
- `(modus-theme-mark-symbol ((,class :inherit bold :foreground ,blue-alt)))
-;;;;; heading levels
- ;; styles for regular headings used in Org, Markdown, Info, etc.
- `(modus-theme-heading-1
- ((,class ,@(modus-vivendi-theme-heading
- 1 fg-main magenta-alt-other magenta-nuanced-bg bg-region)
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(modus-theme-heading-2
- ((,class ,@(modus-vivendi-theme-heading
- 2 fg-special-warm magenta-alt red-nuanced-bg bg-region)
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3))))
- `(modus-theme-heading-3
- ((,class ,@(modus-vivendi-theme-heading
- 3 fg-special-cold blue blue-nuanced-bg bg-region)
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2))))
- `(modus-theme-heading-4
- ((,class ,@(modus-vivendi-theme-heading
- 4 fg-special-mild cyan cyan-nuanced-bg bg-region)
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1))))
- `(modus-theme-heading-5
- ((,class ,@(modus-vivendi-theme-heading
- 5 fg-special-calm green-alt-other green-nuanced-bg bg-region))))
- `(modus-theme-heading-6
- ((,class ,@(modus-vivendi-theme-heading
- 6 yellow-nuanced yellow-alt-other yellow-nuanced-bg bg-region))))
- `(modus-theme-heading-7
- ((,class ,@(modus-vivendi-theme-heading
- 7 red-nuanced red-alt red-nuanced-bg bg-region))))
- `(modus-theme-heading-8
- ((,class ,@(modus-vivendi-theme-heading
- 8 fg-dim magenta bg-alt bg-region))))
-;;;;; other custom faces
- `(modus-theme-hl-line ((,class :background ,(if modus-vivendi-theme-intense-hl-line
- bg-hl-line-intense bg-hl-line)
- (and (>= emacs-major-version 27) '(:extend t)))))
-;;;; standard faces
-;;;;; absolute essentials
- `(default ((,class :background ,bg-main :foreground ,fg-main)))
- `(cursor ((,class :background ,fg-main)))
- `(fringe ((,class ,@(modus-vivendi-theme-fringe bg-inactive bg-active)
- :foreground ,fg-main)))
- `(vertical-border ((,class :foreground ,fg-window-divider-inner)))
-;;;;; basic and/or ungrouped styles
- ;; Modify the `bold' face to change the weight of all "bold" elements
- ;; defined by the theme. You need a typeface that supports a
- ;; multitude of heavier weights than the regular one and then you
- ;; must specify the exact name of the one you wish to apply. Example
- ;; for your init.el:
- ;;
- ;; (set-face-attribute 'bold nil :weight 'semibold)
- `(bold ((,class :weight bold)))
- `(comint-highlight-input ((,class :inherit bold)))
- `(comint-highlight-prompt ((,class ,@(modus-vivendi-theme-bold-weight)
- ,@(modus-vivendi-theme-prompt
- cyan
- blue-nuanced-bg blue-alt
- blue-refine-bg fg-main))))
- `(error ((,class :inherit bold :foreground ,red)))
- `(escape-glyph ((,class :foreground ,fg-escape-char-construct)))
- `(file-name-shadow ((,class :foreground ,fg-unfocused)))
- `(header-line ((,class :background ,bg-header :foreground ,fg-header)))
- `(header-line-highlight ((,class :inherit modus-theme-active-blue)))
- `(help-argument-name ((,class :foreground ,cyan :slant ,modus-theme-slant)))
- `(homoglyph ((,class :foreground ,fg-escape-char-construct)))
- `(ibuffer-locked-buffer ((,class :foreground ,yellow-alt-other)))
- `(italic ((,class :slant italic)))
- `(nobreak-hyphen ((,class :foreground ,fg-escape-char-construct)))
- `(nobreak-space ((,class :foreground ,fg-escape-char-construct :underline t)))
- `(minibuffer-prompt ((,class ,@(modus-vivendi-theme-prompt
- cyan-alt-other
- cyan-nuanced-bg cyan
- cyan-refine-bg fg-main))))
- `(mm-command-output ((,class :foreground ,red-alt-other)))
- `(mm-uu-extract ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(next-error ((,class :inherit modus-theme-subtle-red)))
- `(rectangle-preview ((,class :inherit modus-theme-special-mild)))
- `(region ((,class :background ,bg-region :foreground ,fg-main)))
- `(secondary-selection ((,class :inherit modus-theme-special-cold)))
- `(shadow ((,class :foreground ,fg-alt)))
- `(success ((,class :inherit bold :foreground ,green)))
- `(trailing-whitespace ((,class :background ,red-intense-bg)))
- `(warning ((,class :inherit bold :foreground ,yellow)))
-;;;;; buttons, links, widgets
- `(button ((,class :foreground ,blue-alt-other
- ,@(unless modus-vivendi-theme-no-link-underline
- (list :underline t)))))
- `(link ((,class :inherit button)))
- `(link-visited ((,class :inherit link :foreground ,magenta-alt-other)))
- `(tooltip ((,class :background ,bg-special-cold :foreground ,fg-main)))
- `(widget-button ((,class :inherit button)))
- `(widget-button-pressed ((,class :inherit button :foreground ,magenta)))
- `(widget-documentation ((,class :foreground ,green)))
- `(widget-field ((,class :background ,bg-alt :foreground ,fg-dim)))
- `(widget-inactive ((,class :background ,bg-inactive :foreground ,fg-inactive)))
- `(widget-single-line-field ((,class :inherit widget-field)))
-;;;;; ag
- `(ag-hit-face ((,class :foreground ,fg-special-cold)))
- `(ag-match-face ((,class :inherit modus-theme-special-calm)))
-;;;;; alert
- `(alert-high-face ((,class :inherit bold :foreground ,red-alt)))
- `(alert-low-face ((,class :foreground ,fg-special-mild)))
- `(alert-moderate-face ((,class :inherit bold :foreground ,yellow)))
- `(alert-trivial-face ((,class :foreground ,fg-special-calm)))
- `(alert-urgent-face ((,class :inherit bold :foreground ,red-intense)))
-;;;;; all-the-icons
- `(all-the-icons-blue ((,class :foreground ,blue)))
- `(all-the-icons-blue-alt ((,class :foreground ,blue-alt)))
- `(all-the-icons-cyan ((,class :foreground ,cyan)))
- `(all-the-icons-cyan-alt ((,class :foreground ,cyan-alt)))
- `(all-the-icons-dblue ((,class :foreground ,blue-alt-other)))
- `(all-the-icons-dcyan ((,class :foreground ,cyan-alt-other)))
- `(all-the-icons-dgreen ((,class :foreground ,green-alt-other)))
- `(all-the-icons-dired-dir-face ((,class :foreground ,blue)))
- `(all-the-icons-dmaroon ((,class :foreground ,magenta-alt-other)))
- `(all-the-icons-dorange ((,class :foreground ,red-alt-other)))
- `(all-the-icons-dpink ((,class :foreground ,magenta)))
- `(all-the-icons-dpurple ((,class :foreground ,magenta-alt)))
- `(all-the-icons-dred ((,class :foreground ,red)))
- `(all-the-icons-dsilver ((,class :foreground ,fg-special-cold)))
- `(all-the-icons-dyellow ((,class :foreground ,yellow)))
- `(all-the-icons-green ((,class :foreground ,green)))
- `(all-the-icons-lblue ((,class :foreground ,blue-refine-fg)))
- `(all-the-icons-lcyan ((,class :foreground ,cyan-refine-fg)))
- `(all-the-icons-lgreen ((,class :foreground ,green-refine-fg)))
- `(all-the-icons-lmaroon ((,class :foreground ,magenta-refine-fg)))
- `(all-the-icons-lorange ((,class :foreground ,red-refine-fg)))
- `(all-the-icons-lpink ((,class :foreground ,magenta-refine-fg)))
- `(all-the-icons-lpurple ((,class :foreground ,magenta-refine-fg)))
- `(all-the-icons-lred ((,class :foreground ,red-refine-fg)))
- `(all-the-icons-lsilver ((,class :foreground ,fg-special-cold)))
- `(all-the-icons-lyellow ((,class :foreground ,yellow-refine-fg)))
- `(all-the-icons-maroon ((,class :foreground ,magenta)))
- `(all-the-icons-orange ((,class :foreground ,red-alt)))
- `(all-the-icons-pink ((,class :foreground ,magenta)))
- `(all-the-icons-purple ((,class :foreground ,magenta-alt)))
- `(all-the-icons-purple-alt ((,class :foreground ,magenta-alt-other)))
- `(all-the-icons-red ((,class :foreground ,red)))
- `(all-the-icons-red-alt ((,class :foreground ,red-alt)))
- `(all-the-icons-silver ((,class :foreground ,fg-special-cold)))
- `(all-the-icons-yellow ((,class :foreground ,yellow)))
-;;;;; annotate
- `(annotate-annotation ((,class :inherit modus-theme-subtle-blue)))
- `(annotate-annotation-secondary ((,class :inherit modus-theme-subtle-green)))
- `(annotate-highlight ((,class :background ,blue-nuanced-bg :underline ,blue-intense)))
- `(annotate-highlight-secondary ((,class :background ,green-nuanced-bg :underline ,green-intense)))
-;;;;; anzu
- `(anzu-match-1 ((,class :inherit modus-theme-subtle-cyan)))
- `(anzu-match-2 ((,class :inherit modus-theme-subtle-green)))
- `(anzu-match-3 ((,class :inherit modus-theme-subtle-yellow)))
- `(anzu-mode-line ((,class :inherit bold :foreground ,green-active)))
- `(anzu-mode-line-no-match ((,class :inherit bold :foreground ,red-active)))
- `(anzu-replace-highlight ((,class :inherit modus-theme-refine-yellow :underline t)))
- `(anzu-replace-to ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; apropos
- `(apropos-function-button ((,class :inherit button :foreground ,magenta-alt-other)))
- `(apropos-keybinding ((,class :inherit bold :foreground ,cyan)))
- `(apropos-misc-button ((,class :inherit button :foreground ,cyan-alt-other)))
- `(apropos-property ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt)))
- `(apropos-symbol ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-alt-other)))
- `(apropos-user-option-button ((,class :inherit button :foreground ,green-alt-other)))
- `(apropos-variable-button ((,class :inherit button :foreground ,blue)))
-;;;;; apt-sources-list
- `(apt-sources-list-components ((,class :foreground ,cyan)))
- `(apt-sources-list-options ((,class :foreground ,yellow)))
- `(apt-sources-list-suite ((,class :foreground ,green)))
- `(apt-sources-list-type ((,class :foreground ,magenta)))
- `(apt-sources-list-uri ((,class :foreground ,blue)))
-;;;;; artbollocks-mode
- `(artbollocks-face ((,class :foreground ,cyan-nuanced :underline ,fg-lang-note)))
- `(artbollocks-lexical-illusions-face ((,class :background ,bg-alt :foreground ,red-alt :underline t)))
- `(artbollocks-passive-voice-face ((,class :foreground ,yellow-nuanced :underline ,fg-lang-warning)))
- `(artbollocks-weasel-words-face ((,class :foreground ,red-nuanced :underline ,fg-lang-error)))
-;;;;; auctex and Tex
- `(font-latex-bold-face ((,class :inherit bold :foreground ,fg-special-calm)))
- `(font-latex-doctex-documentation-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(font-latex-doctex-preprocessor-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-alt-other)))
- `(font-latex-italic-face ((,class :foreground ,fg-special-calm :slant italic)))
- `(font-latex-math-face ((,class :foreground ,cyan-alt-other)))
- `(font-latex-script-char-face ((,class :foreground ,cyan-alt-other)))
- `(font-latex-sectioning-0-face ((,class :inherit ,modus-theme-variable-pitch :foreground ,blue-nuanced)))
- `(font-latex-sectioning-1-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-2-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-3-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-4-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,blue-nuanced)))
- `(font-latex-sectioning-5-face ((,class :inherit ,modus-theme-variable-pitch :foreground ,blue-nuanced)))
- `(font-latex-sedate-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt-other)))
- `(font-latex-slide-title-face ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,cyan-nuanced
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(font-latex-string-face ((,class :foreground ,blue-alt)))
- `(font-latex-subscript-face ((,class :height 0.95)))
- `(font-latex-superscript-face ((,class :height 0.95)))
- `(font-latex-verbatim-face ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(font-latex-warning-face ((,class :foreground ,yellow-alt-other)))
- `(tex-match ((,class :foreground ,blue-alt-other)))
- `(tex-verbatim ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(texinfo-heading ((,class :foreground ,magenta)))
- `(TeX-error-description-error ((,class :inherit bold :foreground ,red)))
- `(TeX-error-description-help ((,class :foreground ,blue)))
- `(TeX-error-description-tex-said ((,class :foreground ,blue)))
- `(TeX-error-description-warning ((,class :inherit bold :foreground ,yellow)))
-;;;;; auto-dim-other-buffers
- `(auto-dim-other-buffers-face ((,class :background ,bg-alt)))
-;;;;; avy
- `(avy-background-face ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(avy-goto-char-timer-face ((,class :inherit (modus-theme-intense-yellow bold))))
- `(avy-lead-face ((,class :inherit (modus-theme-intense-magenta bold))))
- `(avy-lead-face-0 ((,class :inherit (modus-theme-intense-blue bold))))
- `(avy-lead-face-1 ((,class :inherit (modus-theme-intense-red bold))))
- `(avy-lead-face-2 ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; aw (ace-window)
- `(aw-background-face ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(aw-key-face ((,class :inherit bold :foreground ,blue-intense)))
- `(aw-leading-char-face ((,class :inherit bold :height 1.5 :background ,bg-main :foreground ,red-intense)))
- `(aw-minibuffer-leading-char-face ((,class :foreground ,magenta-active)))
- `(aw-mode-line-face ((,class :inherit bold)))
-;;;;; awesome-tray
- `(awesome-tray-module-awesome-tab-face ((,class :inherit bold :foreground ,red-alt-other)))
- `(awesome-tray-module-battery-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(awesome-tray-module-buffer-name-face ((,class :inherit bold :foreground ,yellow-alt-other)))
- `(awesome-tray-module-circe-face ((,class :inherit bold :foreground ,blue-alt)))
- `(awesome-tray-module-date-face ((,class :inherit bold :foreground ,fg-dim)))
- `(awesome-tray-module-evil-face ((,class :inherit bold :foreground ,green-alt)))
- `(awesome-tray-module-git-face ((,class :inherit bold :foreground ,magenta)))
- `(awesome-tray-module-last-command-face ((,class :inherit bold :foreground ,blue-alt-other)))
- `(awesome-tray-module-location-face ((,class :inherit bold :foreground ,yellow)))
- `(awesome-tray-module-mode-name-face ((,class :inherit bold :foreground ,green)))
- `(awesome-tray-module-parent-dir-face ((,class :inherit bold :foreground ,cyan)))
- `(awesome-tray-module-rvm-face ((,class :inherit bold :foreground ,magenta-alt-other)))
-;;;;; binder
- `(binder-sidebar-highlight ((,class :inherit modus-theme-subtle-cyan)))
- `(binder-sidebar-marked ((,class :inherit modus-theme-mark-sel)))
- `(binder-sidebar-missing ((,class :inherit modus-theme-subtle-red)))
- `(binder-sidebar-tags ((,class :foreground ,cyan)))
-;;;;; bm
- `(bm-face ((,class :inherit modus-theme-subtle-yellow
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(bm-fringe-face ((,class :inherit modus-theme-fringe-yellow)))
- `(bm-fringe-persistent-face ((,class :inherit modus-theme-fringe-blue)))
- `(bm-persistent-face ((,class :inherit modus-theme-intense-blue
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
-;;;;; bongo
- `(bongo-album-title ((,class :foreground ,cyan-active)))
- `(bongo-artist ((,class :foreground ,magenta-active)))
- `(bongo-currently-playing-track ((,class :inherit bold)))
- `(bongo-elapsed-track-part ((,class :inherit modus-theme-subtle-magenta :underline t)))
- `(bongo-filled-seek-bar ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
- `(bongo-marked-track ((,class :foreground ,fg-mark-alt)))
- `(bongo-marked-track-line ((,class :background ,bg-mark-alt)))
- `(bongo-played-track ((,class :foreground ,fg-unfocused :strike-through t)))
- `(bongo-track-length ((,class :foreground ,blue-alt-other)))
- `(bongo-track-title ((,class :foreground ,blue-active)))
- `(bongo-unfilled-seek-bar ((,class :background ,blue-nuanced-bg :foreground ,fg-main)))
-;;;;; boon
- `(boon-modeline-cmd ((,class :inherit modus-theme-active-blue)))
- `(boon-modeline-ins ((,class :inherit modus-theme-active-red)))
- `(boon-modeline-off ((,class :inherit modus-theme-active-yellow)))
- `(boon-modeline-spc ((,class :inherit modus-theme-active-green)))
-;;;;; breakpoint (built-in gdb-mi.el)
- `(breakpoint-disabled ((,class :foreground ,fg-alt)))
- `(breakpoint-enabled ((,class :inherit bold :foreground ,red)))
-;;;;; buffer-expose
- `(buffer-expose-ace-char-face ((,class :inherit bold :foreground ,red-active)))
- `(buffer-expose-mode-line-face ((,class :foreground ,cyan-active)))
- `(buffer-expose-selected-face ((,class :inherit modus-theme-special-mild)))
-;;;;; calendar and diary
- `(calendar-month-header ((,class :inherit bold :foreground ,fg-main)))
- `(calendar-today ((,class :underline t)))
- `(calendar-weekday-header ((,class :foreground ,fg-dim)))
- `(calendar-weekend-header ((,class :foreground ,fg-alt)))
- `(diary ((,class :foreground ,cyan-alt-other)))
- `(diary-anniversary ((,class :foreground ,red-alt-other)))
- `(diary-time ((,class :foreground ,blue-alt)))
- `(holiday ((,class :foreground ,magenta-alt)))
-;;;;; calfw
- `(cfw:face-annotation ((,class :foreground ,fg-special-warm)))
- `(cfw:face-day-title ((,class :foreground ,fg-main)))
- `(cfw:face-default-content ((,class :foreground ,green-alt)))
- `(cfw:face-default-day ((,class :inherit (cfw:face-day-title bold))))
- `(cfw:face-disable ((,class :foreground ,fg-unfocused)))
- `(cfw:face-grid ((,class :foreground ,fg-window-divider-outer)))
- `(cfw:face-header ((,class :inherit bold :foreground ,fg-main)))
- `(cfw:face-holiday ((,class :foreground ,magenta-alt-other)))
- `(cfw:face-periods ((,class :foreground ,cyan-alt-other)))
- `(cfw:face-saturday ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(cfw:face-select ((,class :inherit modus-theme-intense-blue)))
- `(cfw:face-sunday ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(cfw:face-title ((,class :inherit ,modus-theme-variable-pitch
- :foreground ,fg-special-cold
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-5))))
- `(cfw:face-today ((,class :background ,bg-inactive)))
- `(cfw:face-today-title ((,class :background ,bg-active)))
- `(cfw:face-toolbar ((,class :background ,bg-alt :foreground ,bg-alt)))
- `(cfw:face-toolbar-button-off ((,class :foreground ,fg-alt)))
- `(cfw:face-toolbar-button-on ((,class :inherit bold :background ,blue-nuanced-bg
- :foreground ,blue-alt)))
-;;;;; centaur-tabs
- `(centaur-tabs-active-bar-face ((,class :background ,fg-tab-active)))
- `(centaur-tabs-close-mouse-face ((,class :inherit bold :foreground ,red-active :underline t)))
- `(centaur-tabs-close-selected ((,class :inherit centaur-tabs-selected)))
- `(centaur-tabs-close-unselected ((,class :inherit centaur-tabs-unselected)))
- `(centaur-tabs-modified-marker-selected ((,class :inherit centaur-tabs-selected)))
- `(centaur-tabs-modified-marker-unselected ((,class :inherit centaur-tabs-unselected)))
- `(centaur-tabs-default ((,class :background ,bg-main :foreground ,bg-main)))
- `(centaur-tabs-selected ((,class :inherit bold :background ,bg-tab-active :foreground ,fg-main)))
- `(centaur-tabs-selected-modified ((,class :background ,bg-tab-active :foreground ,fg-main :slant italic)))
- `(centaur-tabs-unselected ((,class :background ,bg-tab-inactive :foreground ,fg-dim)))
- `(centaur-tabs-unselected-modified ((,class :background ,bg-tab-inactive :foreground ,fg-dim :slant italic)))
-;;;;; change-log and log-view (`vc-print-log' and `vc-print-root-log')
- `(change-log-acknowledgment ((,class :foreground ,fg-alt)))
- `(change-log-conditionals ((,class :foreground ,magenta-alt)))
- `(change-log-date ((,class :foreground ,cyan-alt-other)))
- `(change-log-email ((,class :foreground ,cyan)))
- `(change-log-file ((,class :foreground ,blue)))
- `(change-log-function ((,class :foreground ,green-alt-other)))
- `(change-log-list ((,class :foreground ,magenta-alt-other)))
- `(change-log-name ((,class :foreground ,cyan)))
- `(log-edit-header ((,class :foreground ,fg-special-warm)))
- `(log-edit-summary ((,class :inherit bold :foreground ,cyan)))
- `(log-edit-unknown-header ((,class :foreground ,fg-alt)))
- `(log-view-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(log-view-message ((,class :foreground ,fg-alt)))
-;;;;; cider
- `(cider-debug-code-overlay-face ((,class :background ,bg-alt)))
- `(cider-debug-prompt-face ((,class :foreground ,magenta-alt :underline t)))
- `(cider-deprecated-face ((,class :inherit modus-theme-refine-yellow)))
- `(cider-docview-emphasis-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(cider-docview-literal-face ((,class :foreground ,blue-alt)))
- `(cider-docview-strong-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(cider-docview-table-border-face ((,class :foreground ,fg-alt)))
- `(cider-enlightened-face ((,class :box (:line-width -1 :color ,yellow-alt :style nil) :background ,bg-dim)))
- `(cider-enlightened-local-face ((,class :inherit bold :foreground ,yellow-alt-other)))
- `(cider-error-highlight-face ((,class :foreground ,red :underline t)))
- `(cider-fragile-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,yellow)))
- `(cider-fringe-good-face ((,class :foreground ,green-active)))
- `(cider-instrumented-face ((,class :box (:line-width -1 :color ,red :style nil) :background ,bg-dim)))
- `(cider-reader-conditional-face ((,class :foreground ,fg-special-warm :slant italic)))
- `(cider-repl-input-face ((,class :inherit bold)))
- `(cider-repl-prompt-face ((,class :foreground ,cyan-alt-other)))
- `(cider-repl-stderr-face ((,class :inherit bold :foreground ,red)))
- `(cider-repl-stdout-face ((,class :foreground ,blue)))
- `(cider-result-overlay-face ((,class :box (:line-width -1 :color ,blue :style nil) :background ,bg-dim)))
- `(cider-stacktrace-error-class-face ((,class :inherit bold :foreground ,red)))
- `(cider-stacktrace-error-message-face ((,class :foreground ,red-alt-other :slant italic)))
- `(cider-stacktrace-face ((,class :foreground ,fg-main)))
- `(cider-stacktrace-filter-active-face ((,class :foreground ,cyan-alt :underline t)))
- `(cider-stacktrace-filter-inactive-face ((,class :foreground ,cyan-alt)))
- `(cider-stacktrace-fn-face ((,class :inherit bold :foreground ,fg-main)))
- `(cider-stacktrace-ns-face ((,class :foreground ,fg-alt :slant italic)))
- `(cider-stacktrace-promoted-button-face ((,class :box (:line-width 3 :color ,fg-alt :style released-button) :foreground ,red)))
- `(cider-stacktrace-suppressed-button-face ((,class :box (:line-width 3 :color ,fg-alt :style pressed-button)
- :background ,bg-alt :foreground ,fg-alt)))
- `(cider-test-error-face ((,class :inherit modus-theme-subtle-red)))
- `(cider-test-failure-face ((,class :inherit (modus-theme-intense-red bold))))
- `(cider-test-success-face ((,class :inherit modus-theme-intense-green)))
- `(cider-traced-face ((,class :box (:line-width -1 :color ,cyan :style nil) :background ,bg-dim)))
- `(cider-warning-highlight-face ((,class :foreground ,yellow :underline t)))
-;;;;; circe (and lui)
- `(circe-fool-face ((,class :foreground ,fg-alt)))
- `(circe-highlight-nick-face ((,class :inherit bold :foreground ,blue)))
- `(circe-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(circe-server-face ((,class :foreground ,fg-unfocused)))
- `(lui-button-face ((,class :inherit button :foreground ,blue)))
- `(lui-highlight-face ((,class :foreground ,magenta-alt)))
- `(lui-time-stamp-face ((,class :foreground ,blue-nuanced)))
-;;;;; color-rg
- `(color-rg-font-lock-column-number ((,class :foreground ,magenta-alt-other)))
- `(color-rg-font-lock-command ((,class :inherit bold :foreground ,fg-main)))
- `(color-rg-font-lock-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(color-rg-font-lock-flash ((,class :inherit modus-theme-intense-blue)))
- `(color-rg-font-lock-function-location ((,class :inherit modus-theme-special-calm)))
- `(color-rg-font-lock-header-line-directory ((,class :foreground ,blue-active)))
- `(color-rg-font-lock-header-line-edit-mode ((,class :foreground ,magenta-active)))
- `(color-rg-font-lock-header-line-keyword ((,class :foreground ,green-active)))
- `(color-rg-font-lock-header-line-text ((,class :foreground ,fg-active)))
- `(color-rg-font-lock-line-number ((,class :foreground ,fg-special-warm)))
- `(color-rg-font-lock-mark-changed ((,class :inherit bold :foreground ,blue)))
- `(color-rg-font-lock-mark-deleted ((,class :inherit bold :foreground ,red)))
- `(color-rg-font-lock-match ((,class :inherit modus-theme-special-calm)))
- `(color-rg-font-lock-position-splitter ((,class :foreground ,fg-alt)))
-;;;;; column-enforce-mode
- `(column-enforce-face ((,class :inherit modus-theme-refine-yellow)))
-;;;;; company-mode
- `(company-echo-common ((,class :foreground ,magenta-alt-other)))
- `(company-preview ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(company-preview-common ((,class :foreground ,blue-alt)))
- `(company-preview-search ((,class :inherit modus-theme-special-calm)))
- `(company-scrollbar-bg ((,class :background ,bg-active)))
- `(company-scrollbar-fg ((,class :background ,fg-active)))
- `(company-template-field ((,class :inherit modus-theme-intense-magenta)))
- `(company-tooltip ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(company-tooltip-annotation ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(company-tooltip-annotation-selection ((,class :inherit bold :foreground ,fg-main)))
- `(company-tooltip-common ((,class :inherit bold :foreground ,blue-alt)))
- `(company-tooltip-common-selection ((,class :foreground ,fg-main)))
- `(company-tooltip-mouse ((,class :inherit modus-theme-intense-blue)))
- `(company-tooltip-search ((,class :inherit (modus-theme-refine-cyan bold))))
- `(company-tooltip-search-selection ((,class :inherit (modus-theme-intense-green bold) :underline t)))
- `(company-tooltip-selection ((,class :inherit (modus-theme-subtle-cyan bold))))
-;;;;; company-posframe
- `(company-posframe-active-backend-name ((,class :inherit bold :background ,bg-active :foreground ,blue-active)))
- `(company-posframe-inactive-backend-name ((,class :background ,bg-active :foreground ,fg-active)))
- `(company-posframe-metadata ((,class :background ,bg-inactive :foreground ,fg-inactive)))
-;;;;; compilation feedback
- `(compilation-column-number ((,class :foreground ,magenta-alt-other)))
- `(compilation-error ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red)))
- `(compilation-info ((,class :foreground ,fg-special-cold)))
- `(compilation-line-number ((,class :foreground ,fg-special-warm)))
- `(compilation-mode-line-exit ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-active)))
- `(compilation-mode-line-fail ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active)))
- `(compilation-mode-line-run ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-active)))
- `(compilation-warning ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,yellow)))
-;;;;; completions
- `(completions-annotations ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(completions-common-part ((,class ,@(modus-vivendi-theme-standard-completions
- blue-alt blue-nuanced-bg
- cyan-refine-bg cyan-refine-fg))))
- `(completions-first-difference ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- magenta-alt blue-nuanced-bg
- magenta-intense-bg fg-main))))
-;;;;; counsel
- `(counsel-active-mode ((,class :foreground ,magenta-alt-other)))
- `(counsel-application-name ((,class :foreground ,red-alt-other)))
- `(counsel-key-binding ((,class :inherit bold :foreground ,blue-alt-other)))
- `(counsel-outline-1 ((,class :inherit outline-1)))
- `(counsel-outline-2 ((,class :inherit outline-2)))
- `(counsel-outline-3 ((,class :inherit outline-3)))
- `(counsel-outline-4 ((,class :inherit outline-4)))
- `(counsel-outline-5 ((,class :inherit outline-5)))
- `(counsel-outline-6 ((,class :inherit outline-6)))
- `(counsel-outline-7 ((,class :inherit outline-7)))
- `(counsel-outline-8 ((,class :inherit outline-8)))
- `(counsel-outline-default ((,class :inherit bold :foreground ,green-alt-other)))
- `(counsel-variable-documentation ((,class :foreground ,yellow-alt-other :slant ,modus-theme-slant)))
-;;;;; counsel-css
- `(counsel-css-selector-depth-face-1 ((,class :foreground ,blue)))
- `(counsel-css-selector-depth-face-2 ((,class :foreground ,cyan)))
- `(counsel-css-selector-depth-face-3 ((,class :foreground ,green)))
- `(counsel-css-selector-depth-face-4 ((,class :foreground ,yellow)))
- `(counsel-css-selector-depth-face-5 ((,class :foreground ,magenta)))
- `(counsel-css-selector-depth-face-6 ((,class :foreground ,red)))
-;;;;; counsel-notmuch
- `(counsel-notmuch-count-face ((,class :foreground ,cyan)))
- `(counsel-notmuch-date-face ((,class :foreground ,blue)))
- `(counsel-notmuch-people-face ((,class :foreground ,magenta)))
- `(counsel-notmuch-subject-face ((,class :foreground ,magenta-alt-other)))
-;;;;; counsel-org-capture-string
- `(counsel-org-capture-string-template-body-face ((,class :foreground ,fg-special-cold)))
-;;;;; cov
- `(cov-coverage-not-run-face ((,class :foreground ,red-intense)))
- `(cov-coverage-run-face ((,class :foreground ,green-intense)))
- `(cov-heavy-face ((,class :foreground ,magenta-intense)))
- `(cov-light-face ((,class :foreground ,blue-intense)))
- `(cov-med-face ((,class :foreground ,yellow-intense)))
- `(cov-none-face ((,class :foreground ,cyan-intense)))
-;;;;; cperl-mode
- `(cperl-nonoverridable-face ((,class :foreground ,yellow-alt-other)))
- `(cperl-array-face ((,class :inherit bold :background ,bg-alt :foreground ,magenta-alt)))
- `(cperl-hash-face ((,class :inherit bold :background ,bg-alt :foreground ,red-alt :slant ,modus-theme-slant)))
-;;;;; csv-mode
- `(csv-separator-face ((,class :background ,bg-special-cold :foreground ,fg-main)))
-;;;;; ctrlf
- `(ctrlf-highlight-active ((,class :inherit (modus-theme-intense-green bold))))
- `(ctrlf-highlight-line ((,class :inherit modus-theme-hl-line)))
- `(ctrlf-highlight-passive ((,class :inherit modus-theme-refine-cyan)))
-;;;;; custom (M-x customize)
- `(custom-button ((,class :box (:line-width 2 :color nil :style released-button)
- :background ,bg-active :foreground ,fg-main)))
- `(custom-button-mouse ((,class :box (:line-width 2 :color nil :style released-button)
- :background ,bg-active :foreground ,fg-active)))
- `(custom-button-pressed ((,class :box (:line-width 2 :color nil :style pressed-button)
- :background ,bg-active :foreground ,fg-main)))
- `(custom-changed ((,class :inherit modus-theme-subtle-cyan)))
- `(custom-comment ((,class :foreground ,fg-alt)))
- `(custom-comment-tag ((,class :background ,bg-alt :foreground ,yellow-alt-other)))
- `(custom-face-tag ((,class :inherit bold :foreground ,blue-intense)))
- `(custom-group-tag ((,class :inherit bold :foreground ,green-intense)))
- `(custom-group-tag-1 ((,class :inherit modus-theme-special-warm)))
- `(custom-invalid ((,class :inherit (modus-theme-intense-red bold))))
- `(custom-modified ((,class :inherit modus-theme-subtle-cyan)))
- `(custom-rogue ((,class :inherit modus-theme-refine-magenta)))
- `(custom-set ((,class :foreground ,blue-alt)))
- `(custom-state ((,class :foreground ,cyan-alt-other)))
- `(custom-themed ((,class :inherit modus-theme-subtle-blue)))
- `(custom-variable-tag ((,class :inherit bold :foreground ,cyan)))
-;;;;; dap-mode
- `(dap-mouse-eval-thing-face ((,class :box (:line-width -1 :color ,blue-active :style nil)
- :background ,bg-active :foreground ,fg-main)))
- `(dap-result-overlay-face ((,class :box (:line-width -1 :color ,bg-active :style nil)
- :background ,bg-active :foreground ,fg-main)))
- `(dap-ui-breakpoint-verified-fringe ((,class :inherit bold :foreground ,green-active)))
- `(dap-ui-compile-errline ((,class :inherit bold :foreground ,red-intense)))
- `(dap-ui-locals-scope-face ((,class :inherit bold :foreground ,magenta :underline t)))
- `(dap-ui-locals-variable-face ((,class :inherit bold :foreground ,cyan)))
- `(dap-ui-locals-variable-leaf-face ((,class :foreground ,cyan-alt-other :slant italic)))
- `(dap-ui-marker-face ((,class :inherit modus-theme-subtle-blue)))
- `(dap-ui-sessions-stack-frame-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(dap-ui-sessions-terminated-active-face ((,class :inherit bold :foreground ,fg-alt)))
- `(dap-ui-sessions-terminated-face ((,class :foreground ,fg-alt)))
-;;;;; dashboard (emacs-dashboard)
- `(dashboard-banner-logo-title ((,class :inherit bold :foreground ,fg-special-cold)))
- `(dashboard-footer ((,class :inherit bold :foreground ,fg-special-mild)))
- `(dashboard-heading ((,class :inherit bold :foreground ,fg-special-warm)))
- `(dashboard-navigator ((,class :foreground ,cyan-alt-other)))
- `(dashboard-text-banner ((,class :foreground ,fg-dim)))
-;;;;; deadgrep
- `(deadgrep-filename-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(deadgrep-match-face ((,class :inherit modus-theme-special-calm)))
- `(deadgrep-meta-face ((,class :foreground ,fg-alt)))
- `(deadgrep-regexp-metachar-face ((,class :inherit bold :foreground ,yellow-intense)))
- `(deadgrep-search-term-face ((,class :inherit bold :foreground ,green-intense)))
-;;;;; debbugs
- `(debbugs-gnu-archived ((,class :inverse-video t)))
- `(debbugs-gnu-done ((,class :foreground ,fg-alt)))
- `(debbugs-gnu-forwarded ((,class :foreground ,fg-special-warm)))
- `(debbugs-gnu-handled ((,class :foreground ,green)))
- `(debbugs-gnu-new ((,class :foreground ,red)))
- `(debbugs-gnu-pending ((,class :foreground ,cyan)))
- `(debbugs-gnu-stale-1 ((,class :foreground ,yellow-nuanced)))
- `(debbugs-gnu-stale-2 ((,class :foreground ,yellow)))
- `(debbugs-gnu-stale-3 ((,class :foreground ,yellow-alt)))
- `(debbugs-gnu-stale-4 ((,class :foreground ,yellow-alt-other)))
- `(debbugs-gnu-stale-5 ((,class :foreground ,red-alt)))
- `(debbugs-gnu-tagged ((,class :foreground ,magenta-alt)))
-;;;;; define-word
- `(define-word-face-1 ((,class :foreground ,yellow)))
- `(define-word-face-2 ((,class :foreground ,fg-main)))
-;;;;; deft
- `(deft-filter-string-error-face ((,class :inherit modus-theme-refine-red)))
- `(deft-filter-string-face ((,class :foreground ,green-intense)))
- `(deft-header-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(deft-separator-face ((,class :foreground ,fg-alt)))
- `(deft-summary-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(deft-time-face ((,class :foreground ,fg-special-cold)))
- `(deft-title-face ((,class :inherit bold :foreground ,fg-main)))
-;;;;; dictionary
- `(dictionary-button-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(dictionary-reference-face ((,class :inherit button :foreground ,blue-alt-other)))
- `(dictionary-word-definition-face ((,class :foreground ,fg-main)))
- `(dictionary-word-entry-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
-;;;;; diff-hl
- `(diff-hl-change ((,class :inherit modus-theme-fringe-yellow)))
- `(diff-hl-delete ((,class :inherit modus-theme-fringe-red)))
- `(diff-hl-dired-change ((,class :inherit diff-hl-change)))
- `(diff-hl-dired-delete ((,class :inherit diff-hl-delete)))
- `(diff-hl-dired-ignored ((,class :inherit dired-ignored)))
- `(diff-hl-dired-insert ((,class :inherit diff-hl-insert)))
- `(diff-hl-dired-unknown ((,class :inherit dired-ignored)))
- `(diff-hl-insert ((,class :inherit modus-theme-fringe-green)))
- `(diff-hl-reverted-hunk-highlight ((,class :inherit (modus-theme-active-magenta bold))))
-;;;;; diff-mode
- `(diff-added ((,class :inherit modus-theme-diff-added)))
- `(diff-changed ((,class :inherit modus-theme-diff-changed)))
- `(diff-context ((,class :foreground ,fg-unfocused)))
- `(diff-file-header ((,class :inherit bold :foreground ,blue)))
- `(diff-function ((,class :foreground ,fg-special-cold)))
- `(diff-header ((,class :foreground ,blue-nuanced)))
- `(diff-hunk-header ((,class :inherit modus-theme-diff-heading)))
- `(diff-index ((,class :inherit bold :foreground ,blue-alt)))
- `(diff-indicator-added ((,class :inherit diff-added)))
- `(diff-indicator-changed ((,class :inherit diff-changed)))
- `(diff-indicator-removed ((,class :inherit diff-removed)))
- `(diff-nonexistent ((,class :inherit (modus-theme-neutral bold))))
- `(diff-refine-added ((,class :inherit modus-theme-diff-refine-added)))
- `(diff-refine-changed ((,class :inherit modus-theme-diff-refine-changed)))
- `(diff-refine-removed ((,class :inherit modus-theme-diff-refine-removed)))
- `(diff-removed ((,class :inherit modus-theme-diff-removed)))
-;;;;; dim-autoload
- `(dim-autoload-cookie-line ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
-;;;;; dir-treeview
- `(dir-treeview-archive-face ((,class :foreground ,fg-special-warm)))
- `(dir-treeview-archive-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,yellow)))
- `(dir-treeview-audio-face ((,class :foreground ,magenta)))
- `(dir-treeview-audio-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt)))
- `(dir-treeview-control-face ((,class :foreground ,fg-alt)))
- `(dir-treeview-control-mouse-face ((,class :inherit highlight)))
- `(dir-treeview-default-icon-face ((,class :inherit bold :family "Font Awesome" :foreground ,fg-alt)))
- `(dir-treeview-default-filename-face ((,class :foreground ,fg-main)))
- `(dir-treeview-directory-face ((,class :foreground ,blue)))
- `(dir-treeview-directory-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,blue-alt)))
- `(dir-treeview-executable-face ((,class :foreground ,red-alt)))
- `(dir-treeview-executable-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,red-alt-other)))
- `(dir-treeview-image-face ((,class :foreground ,green-alt-other)))
- `(dir-treeview-image-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,green-alt)))
- `(dir-treeview-indent-face ((,class :foreground ,fg-alt)))
- `(dir-treeview-label-mouse-face ((,class :inherit highlight)))
- `(dir-treeview-start-dir-face ((,class :inherit modus-theme-pseudo-header)))
- `(dir-treeview-symlink-face ((,class :inherit button :foreground ,cyan)))
- `(dir-treeview-video-face ((,class :foreground ,magenta-alt-other)))
- `(dir-treeview-video-icon-face ((,class :inherit dir-treeview-default-icon-face :foreground ,magenta-alt-other)))
-;;;;; dired
- `(dired-directory ((,class :foreground ,blue)))
- `(dired-flagged ((,class :inherit modus-theme-mark-del)))
- `(dired-header ((,class :inherit modus-theme-pseudo-header)))
- `(dired-ignored ((,class :foreground ,fg-alt)))
- `(dired-mark ((,class :inherit modus-theme-mark-symbol)))
- `(dired-marked ((,class :inherit modus-theme-mark-sel)))
- `(dired-perm-write ((,class :foreground ,fg-special-warm)))
- `(dired-symlink ((,class :inherit button :foreground ,cyan-alt)))
- `(dired-warning ((,class :inherit bold :foreground ,yellow)))
-;;;;; dired-async
- `(dired-async-failures ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active)))
- `(dired-async-message ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,green-active)))
- `(dired-async-mode-message ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,cyan-active)))
-;;;;; dired-git
- `(dired-git-branch-else ((,class :inherit bold :foreground ,magenta-alt)))
- `(dired-git-branch-master ((,class :inherit bold :foreground ,magenta-alt-other)))
-;;;;; dired-git-info
- `(dgi-commit-message-face ((,class :foreground ,fg-special-mild)))
-;;;;; dired-narrow
- `(dired-narrow-blink ((,class :inherit (modus-theme-subtle-cyan bold))))
-;;;;; dired-subtree
- ;; remove background from dired-subtree, else it breaks
- ;; dired-{flagged,marked} and any other face that sets a background
- ;; such as hl-line
- `(dired-subtree-depth-1-face ((,class :background nil)))
- `(dired-subtree-depth-2-face ((,class :background nil)))
- `(dired-subtree-depth-3-face ((,class :background nil)))
- `(dired-subtree-depth-4-face ((,class :background nil)))
- `(dired-subtree-depth-5-face ((,class :background nil)))
- `(dired-subtree-depth-6-face ((,class :background nil)))
-;;;;; diredfl
- `(diredfl-autofile-name ((,class :inherit modus-theme-special-cold)))
- `(diredfl-compressed-file-name ((,class :foreground ,fg-special-warm)))
- `(diredfl-compressed-file-suffix ((,class :foreground ,red-alt)))
- `(diredfl-date-time ((,class :foreground ,cyan-alt-other)))
- `(diredfl-deletion ((,class :inherit modus-theme-mark-del)))
- `(diredfl-deletion-file-name ((,class :inherit modus-theme-mark-del)))
- `(diredfl-dir-heading ((,class :inherit modus-theme-pseudo-header)))
- `(diredfl-dir-name ((,class :inherit dired-directory)))
- `(diredfl-dir-priv ((,class :foreground ,blue-alt)))
- `(diredfl-exec-priv ((,class :foreground ,magenta)))
- `(diredfl-executable-tag ((,class :foreground ,magenta-alt)))
- `(diredfl-file-name ((,class :foreground ,fg-main)))
- `(diredfl-file-suffix ((,class :foreground ,cyan)))
- `(diredfl-flag-mark ((,class :inherit modus-theme-mark-sel)))
- `(diredfl-flag-mark-line ((,class :inherit modus-theme-mark-sel)))
- `(diredfl-ignored-file-name ((,class :foreground ,fg-alt)))
- `(diredfl-link-priv ((,class :foreground ,blue-alt-other)))
- `(diredfl-no-priv ((,class :foreground ,fg-alt)))
- `(diredfl-number ((,class :foreground ,cyan-alt)))
- `(diredfl-other-priv ((,class :foreground ,yellow)))
- `(diredfl-rare-priv ((,class :foreground ,red-alt)))
- `(diredfl-read-priv ((,class :foreground ,fg-main)))
- `(diredfl-symlink ((,class :inherit dired-symlink)))
- `(diredfl-tagged-autofile-name ((,class :inherit modus-theme-refine-magenta)))
- `(diredfl-write-priv ((,class :foreground ,cyan)))
-;;;;; disk-usage
- `(disk-usage-children ((,class :foreground ,yellow)))
- `(disk-usage-inaccessible ((,class :inherit bold :foreground ,red)))
- `(disk-usage-percent ((,class :foreground ,green)))
- `(disk-usage-size ((,class :foreground ,cyan)))
- `(disk-usage-symlink ((,class :inherit button :foreground ,blue)))
- `(disk-usage-symlink-directory ((,class :inherit bold :foreground ,blue-alt)))
-;;;;; doom-modeline
- `(doom-modeline-bar ((,class :inherit modus-theme-active-blue)))
- `(doom-modeline-bar-inactive ((,class :background ,fg-inactive :foreground ,bg-main)))
- `(doom-modeline-battery-charging ((,class :foreground ,green-active)))
- `(doom-modeline-battery-critical ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-battery-error ((,class :inherit bold :box (:line-width -2)
- :foreground ,red-active)))
- `(doom-modeline-battery-full ((,class :foreground ,blue-active)))
- `(doom-modeline-battery-normal ((,class :foreground ,fg-active)))
- `(doom-modeline-battery-warning ((,class :inherit bold :foreground ,yellow-active)))
- `(doom-modeline-buffer-file ((,class :inherit bold :foreground ,fg-active)))
- `(doom-modeline-buffer-major-mode ((,class :inherit bold :foreground ,cyan-active)))
- `(doom-modeline-buffer-minor-mode ((,class :foreground ,fg-inactive)))
- `(doom-modeline-buffer-modified ((,class :inherit bold :foreground ,magenta-active)))
- `(doom-modeline-buffer-path ((,class :inherit bold :foreground ,fg-active)))
- `(doom-modeline-debug ((,class :inherit bold :foreground ,yellow-active)))
- `(doom-modeline-debug-visual ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-evil-emacs-state ((,class :inherit bold :foreground ,magenta-active)))
- `(doom-modeline-evil-insert-state ((,class :inherit bold :foreground ,green-active)))
- `(doom-modeline-evil-motion-state ((,class :inherit bold :foreground ,fg-inactive)))
- `(doom-modeline-evil-normal-state ((,class :inherit bold :foreground ,fg-active)))
- `(doom-modeline-evil-operator-state ((,class :inherit bold :foreground ,blue-active)))
- `(doom-modeline-evil-replace-state ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-evil-visual-state ((,class :inherit bold :foreground ,cyan-active)))
- `(doom-modeline-highlight ((,class :inherit bold :foreground ,blue-active)))
- `(doom-modeline-host ((,class :slant italic)))
- `(doom-modeline-info ((,class :foreground ,green-active)))
- `(doom-modeline-lsp-error ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-lsp-success ((,class :inherit bold :foreground ,green-active)))
- `(doom-modeline-lsp-warning ((,class :inherit bold :foreground ,yellow-active)))
- `(doom-modeline-panel ((,class :inherit modus-theme-active-blue)))
- `(doom-modeline-persp-buffer-not-in-persp ((,class :foreground ,yellow-active :slant italic)))
- `(doom-modeline-persp-name ((,class :foreground ,fg-active)))
- `(doom-modeline-project-dir ((,class :inherit bold :foreground ,blue-active)))
- `(doom-modeline-project-parent-dir ((,class :foreground ,blue-active)))
- `(doom-modeline-project-root-dir ((,class :foreground ,fg-active)))
- `(doom-modeline-unread-number ((,class :foreground ,fg-active :slant italic)))
- `(doom-modeline-urgent ((,class :inherit bold :foreground ,red-active)))
- `(doom-modeline-warning ((,class :inherit bold :foreground ,yellow-active)))
-;;;;; dynamic-ruler
- `(dynamic-ruler-negative-face ((,class :inherit modus-theme-intense-neutral)))
- `(dynamic-ruler-positive-face ((,class :inherit modus-theme-intense-yellow)))
-;;;;; easy-jekyll
- `(easy-jekyll-help-face ((,class :background ,bg-dim :foreground ,cyan-alt-other)))
-;;;;; easy-kill
- `(easy-kill-origin ((,class :inherit modus-theme-subtle-red)))
- `(easy-kill-selection ((,class :inherit modus-theme-subtle-yellow)))
-;;;;; ebdb
- `(ebdb-address-default ((,class :foreground ,fg-main)))
- `(ebdb-db-char ((,class :foreground ,fg-special-cold)))
- `(ebdb-defunct ((,class :foreground ,fg-alt)))
- `(ebdb-field-hidden ((,class :foreground ,magenta)))
- `(ebdb-field-url ((,class :foreground ,blue)))
- `(ebdb-label ((,class :foreground ,cyan-alt-other)))
- `(ebdb-mail-default ((,class :foreground ,fg-main)))
- `(ebdb-mail-primary ((,class :foreground ,blue-alt)))
- `(ebdb-marked ((,class :background ,cyan-intense-bg)))
- `(ebdb-organization-name ((,class :foreground ,fg-special-calm)))
- `(ebdb-person-name ((,class :foreground ,magenta-alt-other)))
- `(ebdb-phone-default ((,class :foreground ,fg-special-warm)))
- `(ebdb-role-defunct ((,class :foreground ,fg-alt)))
- `(eieio-custom-slot-tag-face ((,class :foreground ,red-alt)))
-;;;;; ediff
- ;; NOTE: here we break from the pattern of inheriting from the
- ;; modus-theme-diff-* faces.
- `(ediff-current-diff-A ((,class ,@(modus-vivendi-theme-diff
- bg-dim red
- bg-diff-removed fg-diff-removed
- red-nuanced-bg red-faint))))
- `(ediff-current-diff-Ancestor ((,class ,@(modus-vivendi-theme-diff
- bg-dim fg-special-cold
- bg-special-cold fg-special-cold
- blue-nuanced-bg blue))))
- `(ediff-current-diff-B ((,class ,@(modus-vivendi-theme-diff
- bg-dim green
- bg-diff-added fg-diff-added
- green-nuanced-bg green-faint))))
- `(ediff-current-diff-C ((,class ,@(modus-vivendi-theme-diff
- bg-dim yellow
- bg-diff-changed fg-diff-changed
- yellow-nuanced-bg yellow-faint))))
- `(ediff-even-diff-A ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
- `(ediff-even-diff-Ancestor ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-1)))
- `(ediff-even-diff-B ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
- `(ediff-even-diff-C ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(ediff-fine-diff-A ((,class :background ,bg-diff-focus-removed :foreground ,fg-diff-focus-removed)))
- `(ediff-fine-diff-Ancestor ((,class :inherit modus-theme-refine-cyan)))
- `(ediff-fine-diff-B ((,class :background ,bg-diff-focus-added :foreground ,fg-diff-focus-added)))
- `(ediff-fine-diff-C ((,class :background ,bg-diff-focus-changed :foreground ,fg-diff-focus-changed)))
- `(ediff-odd-diff-A ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(ediff-odd-diff-Ancestor ((,class :background ,bg-diff-neutral-0 :foreground ,fg-diff-neutral-0)))
- `(ediff-odd-diff-B ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(ediff-odd-diff-C ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
-;;;;; eglot
- `(eglot-mode-line ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-active)))
-;;;;; el-search
- `(el-search-highlight-in-prompt-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(el-search-match ((,class :inherit modus-theme-intense-green)))
- `(el-search-other-match ((,class :inherit modus-theme-special-mild)))
- `(el-search-occur-match ((,class :inherit modus-theme-special-calm)))
-;;;;; eldoc
- ;; NOTE: see https://github.com/purcell/package-lint/issues/187
- (list 'eldoc-highlight-function-argument `((,class :inherit bold :foreground ,blue-alt-other)))
-;;;;; eldoc-box
- `(eldoc-box-body ((,class :background ,bg-alt :foreground ,fg-main)))
- `(eldoc-box-border ((,class :background ,fg-alt)))
-;;;;; elfeed
- `(elfeed-log-date-face ((,class :foreground ,cyan-alt)))
- `(elfeed-log-debug-level-face ((,class :foreground ,magenta)))
- `(elfeed-log-error-level-face ((,class :foreground ,red)))
- `(elfeed-log-info-level-face ((,class :foreground ,green)))
- `(elfeed-log-warn-level-face ((,class :foreground ,yellow)))
- `(elfeed-search-date-face ((,class :foreground ,blue-nuanced)))
- `(elfeed-search-feed-face ((,class :foreground ,cyan)))
- `(elfeed-search-filter-face ((,class :inherit bold :foreground ,magenta-active)))
- `(elfeed-search-last-update-face ((,class :foreground ,cyan-active)))
- `(elfeed-search-tag-face ((,class :foreground ,blue-nuanced)))
- `(elfeed-search-title-face ((,class :foreground ,fg-dim)))
- `(elfeed-search-unread-count-face ((,class :foreground ,green-active)))
- `(elfeed-search-unread-title-face ((,class :inherit bold :foreground ,fg-main)))
-;;;;; elfeed-score
- `(elfeed-score-date-face ((,class :foreground ,blue)))
- `(elfeed-score-debug-level-face ((,class :foreground ,magenta-alt-other)))
- `(elfeed-score-error-level-face ((,class :foreground ,red)))
- `(elfeed-score-info-level-face ((,class :foreground ,cyan)))
- `(elfeed-score-warn-level-face ((,class :foreground ,yellow)))
-;;;;; emms
- `(emms-playlist-track-face ((,class :foreground ,blue)))
- `(emms-playlist-selected-face ((,class :inherit bold :foreground ,magenta)))
-;;;;; enhanced-ruby-mode
- `(enh-ruby-heredoc-delimiter-face ((,class :foreground ,blue-alt-other)))
- `(enh-ruby-op-face ((,class :foreground ,fg-main)))
- `(enh-ruby-regexp-delimiter-face ((,class :foreground ,green)))
- `(enh-ruby-regexp-face ((,class :foreground ,magenta)))
- `(enh-ruby-string-delimiter-face ((,class :foreground ,blue-alt)))
- `(erm-syn-errline ((,class :foreground ,red :underline t)))
- `(erm-syn-warnline ((,class :foreground ,yellow :underline t)))
-;;;;; epa
- `(epa-field-body ((,class :foreground ,fg-main)))
- `(epa-field-name ((,class :inherit bold :foreground ,fg-dim)))
- `(epa-mark ((,class :inherit bold :foreground ,magenta)))
- `(epa-string ((,class :foreground ,blue-alt)))
- `(epa-validity-disabled ((,class :inherit modus-theme-refine-red)))
- `(epa-validity-high ((,class :inherit bold :foreground ,green-alt-other)))
- `(epa-validity-low ((,class :foreground ,fg-alt)))
- `(epa-validity-medium ((,class :foreground ,green-alt)))
-;;;;; equake
- `(equake-buffer-face ((,class :background ,bg-main :foreground ,fg-main)))
- `(equake-shell-type-eshell ((,class :background ,bg-inactive :foreground ,green-active)))
- `(equake-shell-type-rash ((,class :background ,bg-inactive :foreground ,red-active)))
- `(equake-shell-type-shell ((,class :background ,bg-inactive :foreground ,cyan-active)))
- `(equake-shell-type-term ((,class :background ,bg-inactive :foreground ,yellow-active)))
- `(equake-shell-type-vterm ((,class :background ,bg-inactive :foreground ,magenta-active)))
- `(equake-tab-active ((,class :background ,fg-alt :foreground ,bg-alt)))
- `(equake-tab-inactive ((,class :foreground ,fg-inactive)))
-;;;;; erc
- `(erc-action-face ((,class :inherit bold :foreground ,cyan)))
- `(erc-bold-face ((,class :inherit bold)))
- `(erc-button ((,class :inherit button)))
- `(erc-command-indicator-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(erc-current-nick-face ((,class :foreground ,magenta-alt-other)))
- `(erc-dangerous-host-face ((,class :inherit modus-theme-intense-red)))
- `(erc-direct-msg-face ((,class :foreground ,magenta)))
- `(erc-error-face ((,class :inherit bold :foreground ,red)))
- `(erc-fool-face ((,class :foreground ,fg-inactive)))
- `(erc-header-line ((,class :background ,bg-header :foreground ,fg-header)))
- `(erc-input-face ((,class :foreground ,fg-special-calm)))
- `(erc-inverse-face ((,class :inherit erc-default-face :inverse-video t)))
- `(erc-keyword-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(erc-my-nick-face ((,class :inherit bold :foreground ,magenta)))
- `(erc-my-nick-prefix-face ((,class :inherit erc-my-nick-face)))
- `(erc-nick-default-face ((,class :inherit bold :foreground ,blue)))
- `(erc-nick-msg-face ((,class :inherit bold :foreground ,green)))
- `(erc-nick-prefix-face ((,class :inherit erc-nick-default-face)))
- `(erc-notice-face ((,class :foreground ,fg-unfocused)))
- `(erc-pal-face ((,class :inherit bold :foreground ,red-alt)))
- `(erc-prompt-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(erc-timestamp-face ((,class :foreground ,blue-nuanced)))
- `(erc-underline-face ((,class :underline t)))
- `(bg:erc-color-face0 ((,class :background "white")))
- `(bg:erc-color-face1 ((,class :background "black")))
- `(bg:erc-color-face10 ((,class :background ,cyan-subtle-bg)))
- `(bg:erc-color-face11 ((,class :background ,cyan-intense-bg)))
- `(bg:erc-color-face12 ((,class :background ,blue-subtle-bg)))
- `(bg:erc-color-face13 ((,class :background ,magenta-subtle-bg)))
- `(bg:erc-color-face14 ((,class :background "gray60")))
- `(bg:erc-color-face15 ((,class :background "gray80")))
- `(bg:erc-color-face2 ((,class :background ,blue-intense-bg)))
- `(bg:erc-color-face3 ((,class :background ,green-intense-bg)))
- `(bg:erc-color-face4 ((,class :background ,red-subtle-bg)))
- `(bg:erc-color-face5 ((,class :background ,red-intense-bg)))
- `(bg:erc-color-face6 ((,class :background ,magenta-refine-bg)))
- `(bg:erc-color-face7 ((,class :background ,yellow-subtle-bg)))
- `(bg:erc-color-face8 ((,class :background ,yellow-refine-bg)))
- `(bg:erc-color-face9 ((,class :background ,green-subtle-bg)))
- `(fg:erc-color-face0 ((,class :foreground "white")))
- `(fg:erc-color-face1 ((,class :foreground "black")))
- `(fg:erc-color-face10 ((,class :foreground ,cyan)))
- `(fg:erc-color-face11 ((,class :foreground ,cyan-alt-other)))
- `(fg:erc-color-face12 ((,class :foreground ,blue)))
- `(fg:erc-color-face13 ((,class :foreground ,magenta-alt)))
- `(fg:erc-color-face14 ((,class :foreground "gray60")))
- `(fg:erc-color-face15 ((,class :foreground "gray80")))
- `(fg:erc-color-face2 ((,class :foreground ,blue-alt-other)))
- `(fg:erc-color-face3 ((,class :foreground ,green)))
- `(fg:erc-color-face4 ((,class :foreground ,red)))
- `(fg:erc-color-face5 ((,class :foreground ,red-alt)))
- `(fg:erc-color-face6 ((,class :foreground ,magenta-alt-other)))
- `(fg:erc-color-face7 ((,class :foreground ,yellow-alt-other)))
- `(fg:erc-color-face8 ((,class :foreground ,yellow-alt)))
- `(fg:erc-color-face9 ((,class :foreground ,green-alt-other)))
-;;;;; eros
- `(eros-result-overlay-face ((,class :box (:line-width -1 :color ,blue)
- :background ,bg-dim :foreground ,fg-dim)))
-;;;;; ert
- `(ert-test-result-expected ((,class :inherit modus-theme-intense-green)))
- `(ert-test-result-unexpected ((,class :inherit modus-theme-intense-red)))
-;;;;; eshell
- `(eshell-ls-archive ((,class :inherit bold :foreground ,cyan-alt)))
- `(eshell-ls-backup ((,class :foreground ,yellow-alt)))
- `(eshell-ls-clutter ((,class :foreground ,red-alt)))
- `(eshell-ls-directory ((,class :inherit bold :foreground ,blue-alt)))
- `(eshell-ls-executable ((,class :foreground ,magenta-alt)))
- `(eshell-ls-missing ((,class :inherit modus-theme-intense-red)))
- `(eshell-ls-product ((,class :foreground ,fg-special-warm)))
- `(eshell-ls-readonly ((,class :foreground ,fg-special-cold)))
- `(eshell-ls-special ((,class :inherit bold :foreground ,magenta)))
- `(eshell-ls-symlink ((,class :inherit button :foreground ,cyan)))
- `(eshell-ls-unreadable ((,class :background ,bg-inactive :foreground ,fg-inactive)))
- `(eshell-prompt ((,class ,@(modus-vivendi-theme-bold-weight)
- ,@(modus-vivendi-theme-prompt
- green-alt-other
- green-nuanced-bg green-alt
- green-refine-bg fg-main))))
-;;;;; eshell-fringe-status
- `(eshell-fringe-status-failure ((,class :foreground ,red)))
- `(eshell-fringe-status-success ((,class :foreground ,green)))
-;;;;; eshell-git-prompt
- `(eshell-git-prompt-add-face ((,class :foreground ,fg-alt)))
- `(eshell-git-prompt-branch-face ((,class :foreground ,fg-alt)))
- `(eshell-git-prompt-directory-face ((,class :foreground ,cyan)))
- `(eshell-git-prompt-exit-fail-face ((,class :foreground ,red)))
- `(eshell-git-prompt-exit-success-face ((,class :foreground ,green)))
- `(eshell-git-prompt-modified-face ((,class :foreground ,yellow)))
- `(eshell-git-prompt-powerline-clean-face ((,class :background ,green-refine-bg)))
- `(eshell-git-prompt-powerline-dir-face ((,class :background ,blue-refine-bg)))
- `(eshell-git-prompt-powerline-not-clean-face ((,class :background ,magenta-refine-bg)))
- `(eshell-git-prompt-robyrussell-branch-face ((,class :foreground ,red)))
- `(eshell-git-prompt-robyrussell-git-dirty-face ((,class :foreground ,yellow)))
- `(eshell-git-prompt-robyrussell-git-face ((,class :foreground ,blue)))
-;;;;; eshell-prompt-extras (epe)
- `(epe-dir-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue)))
- `(epe-git-dir-face ((,class :foreground ,red-alt-other)))
- `(epe-git-face ((,class :foreground ,cyan-alt)))
- `(epe-pipeline-delimiter-face ((,class :foreground ,green-alt)))
- `(epe-pipeline-host-face ((,class :foreground ,blue)))
- `(epe-pipeline-time-face ((,class :foreground ,fg-special-warm)))
- `(epe-pipeline-user-face ((,class :foreground ,magenta)))
- `(epe-remote-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(epe-status-face ((,class :foreground ,magenta-alt-other)))
- `(epe-venv-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
-;;;;; eshell-syntax-highlighting
- `(eshell-syntax-highlighting-alias-face ((,class :foreground ,cyan)))
- `(eshell-syntax-highlighting-comment-face ((,class :foreground ,fg-alt)))
- `(eshell-syntax-highlighting-directory-face ((,class :foreground ,blue)))
- `(eshell-syntax-highlighting-envvar-face ((,class :foreground ,magenta-alt)))
- `(eshell-syntax-highlighting-invalid-face ((,class :foreground ,red)))
- `(eshell-syntax-highlighting-lisp-function-face ((,class :foreground ,magenta)))
- `(eshell-syntax-highlighting-shell-command-face ((,class :foreground ,cyan-alt-other)))
- `(eshell-syntax-highlighting-string-face ((,class :foreground ,blue-alt)))
-;;;;; evil-mode
- `(evil-ex-commands ((,class :foreground ,magenta-alt-other)))
- `(evil-ex-info ((,class :foreground ,cyan-alt-other)))
- `(evil-ex-lazy-highlight ((,class :inherit modus-theme-refine-cyan)))
- `(evil-ex-search ((,class :inherit modus-theme-intense-green)))
- `(evil-ex-substitute-matches ((,class :inherit modus-theme-refine-yellow :underline t)))
- `(evil-ex-substitute-replacement ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; evil-goggles
- `(evil-goggles-change-face ((,class :inherit modus-theme-refine-yellow)))
- `(evil-goggles-commentary-face ((,class :inherit modus-theme-subtle-neutral :slant ,modus-theme-slant)))
- `(evil-goggles-default-face ((,class :inherit modus-theme-subtle-neutral)))
- `(evil-goggles-delete-face ((,class :inherit modus-theme-refine-red)))
- `(evil-goggles-fill-and-move-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-indent-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-join-face ((,class :inherit modus-theme-subtle-green)))
- `(evil-goggles-nerd-commenter-face ((,class :inherit evil-goggles-commentary-face)))
- `(evil-goggles-paste-face ((,class :inherit modus-theme-subtle-cyan)))
- `(evil-goggles-record-macro-face ((,class :inherit modus-theme-special-cold)))
- `(evil-goggles-replace-with-register-face ((,class :inherit modus-theme-refine-magenta)))
- `(evil-goggles-set-marker-face ((,class :inherit modus-theme-intense-magenta)))
- `(evil-goggles-shift-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-surround-face ((,class :inherit evil-goggles-default-face)))
- `(evil-goggles-yank-face ((,class :inherit modus-theme-subtle-blue)))
-;;;;; evil-visual-mark-mode
- `(evil-visual-mark-face ((,class :inherit modus-theme-intense-magenta)))
-;;;;; eww
- `(eww-invalid-certificate ((,class :foreground ,red-active)))
- `(eww-valid-certificate ((,class :foreground ,green-active)))
- `(eww-form-checkbox ((,class :box (:line-width 1 :color ,fg-inactive :style released-button) :background ,bg-inactive :foreground ,fg-main)))
- `(eww-form-file ((,class :box (:line-width 1 :color ,fg-inactive :style released-button) :background ,bg-active :foreground ,fg-main)))
- `(eww-form-select ((,class :inherit eww-form-checkbox)))
- `(eww-form-submit ((,class :inherit eww-form-file)))
- `(eww-form-text ((,class :box (:line-width 1 :color ,fg-inactive :style none) :background ,bg-active :foreground ,fg-active)))
- `(eww-form-textarea ((,class :background ,bg-alt :foreground ,fg-main)))
-;;;;; eyebrowse
- `(eyebrowse-mode-line-active ((,class :inherit bold :foreground ,blue-active)))
-;;;;; fancy-dabbrev
- `(fancy-dabbrev-menu-face ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(fancy-dabbrev-preview-face ((,class :foreground ,fg-alt :underline t)))
- `(fancy-dabbrev-selection-face ((,class :inherit (modus-theme-intense-cyan bold))))
-;;;;; flycheck
- `(flycheck-error
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
- `(flycheck-error-list-checker-name ((,class :foreground ,magenta-active)))
- `(flycheck-error-list-column-number ((,class :foreground ,fg-special-cold)))
- `(flycheck-error-list-error ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red)))
- `(flycheck-error-list-filename ((,class :foreground ,blue)))
- `(flycheck-error-list-highlight ((,class :inherit modus-theme-hl-line)))
- `(flycheck-error-list-id ((,class :foreground ,magenta-alt-other)))
- `(flycheck-error-list-id-with-explainer ((,class :inherit flycheck-error-list-id :box t)))
- `(flycheck-error-list-info ((,class :foreground ,cyan)))
- `(flycheck-error-list-line-number ((,class :foreground ,fg-special-warm)))
- `(flycheck-error-list-warning ((,class :foreground ,yellow)))
- `(flycheck-fringe-error ((,class :inherit modus-theme-fringe-red)))
- `(flycheck-fringe-info ((,class :inherit modus-theme-fringe-cyan)))
- `(flycheck-fringe-warning ((,class :inherit modus-theme-fringe-yellow)))
- `(flycheck-info
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-note :style wave))
- (,class :foreground ,fg-lang-note :underline t)))
- `(flycheck-verify-select-checker ((,class :box (:line-width 1 :color nil :style released-button))))
- `(flycheck-warning
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-warning :style wave))
- (,class :foreground ,fg-lang-warning :underline t)))
-;;;;; flycheck-color-mode-line
- `(flycheck-color-mode-line-error-face ((,class :inherit flycheck-fringe-error)))
- `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-info)))
- `(flycheck-color-mode-line-running-face ((,class :foreground ,fg-inactive :slant italic)))
- `(flycheck-color-mode-line-info-face ((,class :inherit flycheck-fringe-warning)))
-;;;;; flycheck-indicator
- `(flycheck-indicator-disabled ((,class :foreground ,fg-inactive :slant ,modus-theme-slant)))
- `(flycheck-indicator-error ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,red-active)))
- `(flycheck-indicator-info ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-active)))
- `(flycheck-indicator-running ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-active)))
- `(flycheck-indicator-success ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,green-active)))
- `(flycheck-indicator-warning ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,yellow-active)))
-;;;;; flycheck-posframe
- `(flycheck-posframe-background-face ((,class :background ,bg-alt)))
- `(flycheck-posframe-border-face ((,class :foreground ,fg-alt)))
- `(flycheck-posframe-error-face ((,class :inherit bold :foreground ,red)))
- `(flycheck-posframe-face ((,class :foreground ,fg-main :slant ,modus-theme-slant)))
- `(flycheck-posframe-info-face ((,class :inherit bold :foreground ,cyan)))
- `(flycheck-posframe-warning-face ((,class :inherit bold :foreground ,yellow)))
-;;;;; flymake
- `(flymake-error
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
- `(flymake-note
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-note :style wave))
- (,class :foreground ,fg-lang-note :underline t)))
- `(flymake-warning
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-warning :style wave))
- (,class :foreground ,fg-lang-warning :underline t)))
-;;;;; flyspell
- `(flyspell-duplicate
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-warning :style wave))
- (,class :foreground ,fg-lang-warning :underline t)))
- `(flyspell-incorrect
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
-;;;;; flyspell-correct
- `(flyspell-correct-highlight-face ((,class :inherit modus-theme-refine-green)))
-;;;;; flx
- `(flx-highlight-face ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-intense-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt
- 'bold))))
-;;;;; freeze-it
- `(freeze-it-show ((,class :background ,bg-dim :foreground ,fg-special-warm)))
-;;;;; frog-menu
- `(frog-menu-action-keybinding-face ((,class :foreground ,blue-alt-other)))
- `(frog-menu-actions-face ((,class :foreground ,magenta)))
- `(frog-menu-border ((,class :background ,bg-active)))
- `(frog-menu-candidates-face ((,class :foreground ,fg-main)))
- `(frog-menu-posframe-background-face ((,class :background ,bg-dim)))
- `(frog-menu-prompt-face ((,class :foreground ,cyan)))
-;;;;; focus
- `(focus-unfocused ((,class :foreground ,fg-unfocused)))
-;;;;; fold-this
- `(fold-this-overlay ((,class :inherit modus-theme-special-mild)))
-;;;;; font-lock
- `(font-lock-builtin-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(font-lock-comment-delimiter-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(font-lock-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(font-lock-constant-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(font-lock-doc-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- fg-special-cold cyan-alt-other-faint)
- :slant ,modus-theme-slant)))
- `(font-lock-function-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(font-lock-keyword-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(font-lock-negation-char-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- yellow yellow-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(font-lock-preprocessor-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt-other red-alt-other-faint))))
- `(font-lock-regexp-grouping-backslash ((,class :inherit bold :foreground ,fg-escape-char-backslash)))
- `(font-lock-regexp-grouping-construct ((,class :inherit bold :foreground ,fg-escape-char-construct)))
- `(font-lock-string-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt blue-alt-faint))))
- `(font-lock-type-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(font-lock-variable-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint))))
- `(font-lock-warning-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- yellow-active yellow-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
-;;;;; forge
- `(forge-post-author ((,class :inherit bold :foreground ,fg-main)))
- `(forge-post-date ((,class :foreground ,fg-special-cold)))
- `(forge-topic-closed ((,class :foreground ,fg-alt)))
- `(forge-topic-merged ((,class :foreground ,fg-alt)))
- `(forge-topic-open ((,class :foreground ,fg-special-mild)))
- `(forge-topic-unmerged ((,class :foreground ,magenta :slant ,modus-theme-slant)))
- `(forge-topic-unread ((,class :inherit bold :foreground ,fg-main)))
-;;;;; fountain-mode
- `(fountain-character ((,class :foreground ,blue-alt-other)))
- `(fountain-comment ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(fountain-dialog ((,class :foreground ,blue-alt)))
- `(fountain-metadata-key ((,class :foreground ,green-alt-other)))
- `(fountain-metadata-value ((,class :foreground ,blue)))
- `(fountain-non-printing ((,class :foreground ,fg-alt)))
- `(fountain-note ((,class :foreground ,yellow :slant ,modus-theme-slant)))
- `(fountain-page-break ((,class :inherit bold :foreground ,red-alt)))
- `(fountain-page-number ((,class :inherit bold :foreground ,red-alt-other)))
- `(fountain-paren ((,class :foreground ,cyan)))
- `(fountain-scene-heading ((,class :inherit bold :foreground ,blue-nuanced)))
- `(fountain-section-heading ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(fountain-section-heading-1 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-main
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(fountain-section-heading-2 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-warm
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3))))
- `(fountain-section-heading-3 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-mild
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-2))))
- `(fountain-section-heading-4 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-calm
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-1))))
- `(fountain-section-heading-5 ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-calm)))
- `(fountain-synopsis ((,class :foreground ,cyan-alt)))
- `(fountain-trans ((,class :foreground ,yellow-alt-other)))
-;;;;; geiser
- `(geiser-font-lock-autodoc-current-arg ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(geiser-font-lock-autodoc-identifier ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue blue-faint))))
- `(geiser-font-lock-doc-button ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt cyan-alt-faint)
- :underline t)))
- `(geiser-font-lock-doc-link ((,class :inherit link)))
- `(geiser-font-lock-error-link ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt red-alt-faint)
- :underline t)))
- `(geiser-font-lock-image-button ((,class ,@(modus-vivendi-theme-syntax-foreground
- green-alt green-alt-faint)
- :underline t)))
- `(geiser-font-lock-repl-input ((,class :inherit bold)))
- `(geiser-font-lock-repl-output ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint))))
- `(geiser-font-lock-repl-prompt ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(geiser-font-lock-xref-header ((,class :inherit bold)))
- `(geiser-font-lock-xref-link ((,class :inherit link)))
-;;;;; git-commit
- `(git-commit-comment-action ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-branch-local ((,class :foreground ,blue-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-branch-remote ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-detached ((,class :foreground ,cyan-alt :slant ,modus-theme-slant)))
- `(git-commit-comment-file ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(git-commit-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant)))
- `(git-commit-keyword ((,class :foreground ,magenta)))
- `(git-commit-known-pseudo-header ((,class :foreground ,cyan-alt-other)))
- `(git-commit-nonempty-second-line ((,class :inherit modus-theme-refine-yellow)))
- `(git-commit-overlong-summary ((,class :inherit modus-theme-refine-yellow)))
- `(git-commit-pseudo-header ((,class :foreground ,blue)))
- `(git-commit-summary ((,class :inherit bold :foreground ,cyan)))
-;;;;; git-gutter
- `(git-gutter:added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter:deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter:modified ((,class :inherit modus-theme-fringe-yellow)))
- `(git-gutter:separator ((,class :inherit modus-theme-fringe-cyan)))
- `(git-gutter:unchanged ((,class :inherit modus-theme-fringe-magenta)))
-;;;;; git-gutter-fr
- `(git-gutter-fr:added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter-fr:deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter-fr:modified ((,class :inherit modus-theme-fringe-yellow)))
-;;;;; git-{gutter,fringe}+
- `(git-gutter+-added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter+-deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter+-modified ((,class :inherit modus-theme-fringe-yellow)))
- `(git-gutter+-separator ((,class :inherit modus-theme-fringe-cyan)))
- `(git-gutter+-unchanged ((,class :inherit modus-theme-fringe-magenta)))
- `(git-gutter-fr+-added ((,class :inherit modus-theme-fringe-green)))
- `(git-gutter-fr+-deleted ((,class :inherit modus-theme-fringe-red)))
- `(git-gutter-fr+-modified ((,class :inherit modus-theme-fringe-yellow)))
-;;;;; git-lens
- `(git-lens-added ((,class :inherit bold :foreground ,green)))
- `(git-lens-deleted ((,class :inherit bold :foreground ,red)))
- `(git-lens-header ((,class :inherit bold :height 1.1 :foreground ,cyan)))
- `(git-lens-modified ((,class :inherit bold :foreground ,yellow)))
- `(git-lens-renamed ((,class :inherit bold :foreground ,magenta)))
-;;;;; git-rebase
- `(git-rebase-comment-hash ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(git-rebase-comment-heading ((,class :inherit bold :foreground ,fg-dim :slant ,modus-theme-slant)))
- `(git-rebase-description ((,class :foreground ,fg-main)))
- `(git-rebase-hash ((,class :foreground ,cyan-alt-other)))
-;;;;; git-timemachine
- `(git-timemachine-commit ((,class :inherit bold :foreground ,yellow-active)))
- `(git-timemachine-minibuffer-author-face ((,class :foreground ,fg-special-warm)))
- `(git-timemachine-minibuffer-detail-face ((,class :foreground ,red-alt)))
-;;;;; git-walktree
- `(git-walktree-commit-face ((,class :foreground ,yellow)))
- `(git-walktree-symlink-face ((,class :inherit button :foreground ,cyan)))
- `(git-walktree-tree-face ((,class :foreground ,magenta)))
-;;;;; gnus
- `(gnus-button ((,class :inherit button)))
- `(gnus-cite-1 ((,class :foreground ,blue-alt)))
- `(gnus-cite-10 ((,class :foreground ,magenta-alt-other)))
- `(gnus-cite-11 ((,class :foreground ,yellow-alt-other)))
- `(gnus-cite-2 ((,class :foreground ,red-alt)))
- `(gnus-cite-3 ((,class :foreground ,green-alt)))
- `(gnus-cite-4 ((,class :foreground ,magenta-alt)))
- `(gnus-cite-5 ((,class :foreground ,yellow-alt)))
- `(gnus-cite-6 ((,class :foreground ,cyan-alt)))
- `(gnus-cite-7 ((,class :foreground ,blue-alt-other)))
- `(gnus-cite-8 ((,class :foreground ,red-alt-other)))
- `(gnus-cite-9 ((,class :foreground ,green-alt-other)))
- `(gnus-cite-attribution ((,class :foreground ,fg-main :slant italic)))
- `(gnus-emphasis-highlight-words ((,class :inherit modus-theme-refine-yellow)))
- `(gnus-group-mail-1 ((,class :inherit bold :foreground ,magenta-alt)))
- `(gnus-group-mail-1-empty ((,class :foreground ,magenta-alt)))
- `(gnus-group-mail-2 ((,class :inherit bold :foreground ,magenta)))
- `(gnus-group-mail-2-empty ((,class :foreground ,magenta)))
- `(gnus-group-mail-3 ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(gnus-group-mail-3-empty ((,class :foreground ,magenta-alt-other)))
- `(gnus-group-mail-low ((,class :inherit bold :foreground ,magenta-nuanced)))
- `(gnus-group-mail-low-empty ((,class :foreground ,magenta-nuanced)))
- `(gnus-group-news-1 ((,class :inherit bold :foreground ,green)))
- `(gnus-group-news-1-empty ((,class :foreground ,green)))
- `(gnus-group-news-2 ((,class :inherit bold :foreground ,cyan)))
- `(gnus-group-news-2-empty ((,class :foreground ,cyan)))
- `(gnus-group-news-3 ((,class :inherit bold :foreground ,yellow-nuanced)))
- `(gnus-group-news-3-empty ((,class :foreground ,yellow-nuanced)))
- `(gnus-group-news-4 ((,class :inherit bold :foreground ,cyan-nuanced)))
- `(gnus-group-news-4-empty ((,class :foreground ,cyan-nuanced)))
- `(gnus-group-news-5 ((,class :inherit bold :foreground ,red-nuanced)))
- `(gnus-group-news-5-empty ((,class :foreground ,red-nuanced)))
- `(gnus-group-news-6 ((,class :inherit bold :foreground ,fg-alt)))
- `(gnus-group-news-6-empty ((,class :foreground ,fg-alt)))
- `(gnus-group-news-low ((,class :inherit bold :foreground ,green-nuanced)))
- `(gnus-group-news-low-empty ((,class :foreground ,green-nuanced)))
- `(gnus-header-content ((,class :foreground ,cyan)))
- `(gnus-header-from ((,class :inherit bold :foreground ,cyan-alt-other :underline nil)))
- `(gnus-header-name ((,class :foreground ,green)))
- `(gnus-header-newsgroups ((,class :inherit bold :foreground ,blue-alt)))
- `(gnus-header-subject ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(gnus-server-agent ((,class :inherit bold :foreground ,cyan)))
- `(gnus-server-closed ((,class :inherit bold :foreground ,magenta)))
- `(gnus-server-cloud ((,class :inherit bold :foreground ,cyan-alt)))
- `(gnus-server-cloud-host ((,class :inherit modus-theme-refine-cyan)))
- `(gnus-server-denied ((,class :inherit bold :foreground ,red)))
- `(gnus-server-offline ((,class :inherit bold :foreground ,yellow)))
- `(gnus-server-opened ((,class :inherit bold :foreground ,green)))
- `(gnus-signature ((,class :foreground ,fg-special-cold :slant italic)))
- `(gnus-splash ((,class :foreground ,fg-alt)))
- `(gnus-summary-cancelled ((,class :inherit modus-theme-mark-alt)))
- `(gnus-summary-high-ancient ((,class :inherit bold :foreground ,fg-alt)))
- `(gnus-summary-high-read ((,class :inherit bold :foreground ,fg-special-cold)))
- `(gnus-summary-high-ticked ((,class :inherit bold :foreground ,red-alt-other)))
- `(gnus-summary-high-undownloaded ((,class :inherit bold :foreground ,yellow)))
- `(gnus-summary-high-unread ((,class :inherit bold :foreground ,fg-main)))
- `(gnus-summary-low-ancient ((,class :foreground ,fg-alt :slant italic)))
- `(gnus-summary-low-read ((,class :foreground ,fg-alt :slant italic)))
- `(gnus-summary-low-ticked ((,class :foreground ,red-refine-fg :slant italic)))
- `(gnus-summary-low-undownloaded ((,class :foreground ,yellow-refine-fg :slant italic)))
- `(gnus-summary-low-unread ((,class :inherit bold :foreground ,fg-special-cold)))
- `(gnus-summary-normal-ancient ((,class :foreground ,fg-special-calm)))
- `(gnus-summary-normal-read ((,class :foreground ,fg-alt)))
- `(gnus-summary-normal-ticked ((,class :foreground ,red-alt-other)))
- `(gnus-summary-normal-undownloaded ((,class :foreground ,yellow)))
- `(gnus-summary-normal-unread ((,class :foreground ,fg-main)))
- `(gnus-summary-selected ((,class :inherit modus-theme-subtle-blue)))
-;;;;; golden-ratio-scroll-screen
- `(golden-ratio-scroll-highlight-line-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
-;;;;; helm
- `(helm-M-x-key ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(helm-action ((,class :underline t)))
- `(helm-bookmark-addressbook ((,class :foreground ,green-alt)))
- `(helm-bookmark-directory ((,class :inherit bold :foreground ,blue)))
- `(helm-bookmark-file ((,class :foreground ,fg-main)))
- `(helm-bookmark-file-not-found ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(helm-bookmark-gnus ((,class :foreground ,magenta)))
- `(helm-bookmark-info ((,class :foreground ,cyan-alt)))
- `(helm-bookmark-man ((,class :foreground ,yellow-alt)))
- `(helm-bookmark-w3m ((,class :foreground ,blue-alt)))
- `(helm-buffer-archive ((,class :inherit bold :foreground ,cyan)))
- `(helm-buffer-directory ((,class :inherit bold :foreground ,blue)))
- `(helm-buffer-file ((,class :foreground ,fg-main)))
- `(helm-buffer-modified ((,class :foreground ,yellow-alt)))
- `(helm-buffer-not-saved ((,class :foreground ,red-alt)))
- `(helm-buffer-process ((,class :foreground ,magenta)))
- `(helm-buffer-saved-out ((,class :inherit bold :background ,bg-alt :foreground ,red)))
- `(helm-buffer-size ((,class :foreground ,fg-alt)))
- `(helm-candidate-number ((,class :foreground ,cyan-active)))
- `(helm-candidate-number-suspended ((,class :foreground ,yellow-active)))
- `(helm-comint-prompts-buffer-name ((,class :foreground ,green-active)))
- `(helm-comint-prompts-promptidx ((,class :foreground ,cyan-active)))
- `(helm-delete-async-message ((,class :inherit bold :foreground ,magenta-active)))
- `(helm-eob-line ((,class :background ,bg-main :foreground ,fg-main)))
- `(helm-eshell-prompts-buffer-name ((,class :foreground ,green-active)))
- `(helm-eshell-prompts-promptidx ((,class :foreground ,cyan-active)))
- `(helm-etags-file ((,class :foreground ,fg-dim :underline t)))
- `(helm-ff-backup-file ((,class :foreground ,fg-alt)))
- `(helm-ff-denied ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-red
- 'modus-theme-intense-red
- 'modus-theme-nuanced-red
- red))))
- `(helm-ff-directory ((,class :inherit helm-buffer-directory)))
- `(helm-ff-dirs ((,class :inherit bold :foreground ,blue-alt-other)))
- `(helm-ff-dotted-directory ((,class :inherit bold :background ,bg-alt :foreground ,fg-alt)))
- `(helm-ff-dotted-symlink-directory ((,class :inherit (button helm-ff-dotted-directory))))
- `(helm-ff-executable ((,class :foreground ,magenta-alt)))
- `(helm-ff-file ((,class :foreground ,fg-main)))
- `(helm-ff-file-extension ((,class :foreground ,fg-special-warm)))
- `(helm-ff-invalid-symlink ((,class :inherit button :foreground ,red)))
- `(helm-ff-pipe ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-refine-magenta
- 'modus-theme-subtle-magenta
- 'modus-theme-nuanced-magenta
- magenta))))
- `(helm-ff-prefix ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-refine-yellow
- 'modus-theme-subtle-yellow
- 'modus-theme-nuanced-yellow
- yellow-alt-other))))
- `(helm-ff-socket ((,class :foreground ,red-alt-other)))
- `(helm-ff-suid ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-red
- 'modus-theme-refine-red
- 'modus-theme-nuanced-yellow
- red-alt))))
- `(helm-ff-symlink ((,class :inherit button :foreground ,cyan)))
- `(helm-ff-truename ((,class :foreground ,blue-alt-other)))
- `(helm-grep-cmd-line ((,class :foreground ,yellow-alt-other)))
- `(helm-grep-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(helm-grep-finish ((,class :foreground ,green-active)))
- `(helm-grep-lineno ((,class :foreground ,fg-special-warm)))
- `(helm-grep-match ((,class :inherit modus-theme-special-calm)))
- `(helm-header ((,class :inherit bold :foreground ,fg-special-cold)))
- `(helm-header-line-left-margin ((,class :inherit bold :foreground ,yellow-intense)))
- `(helm-history-deleted ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-red
- 'modus-theme-intense-red
- 'modus-theme-nuanced-red
- red
- 'bold))))
- `(helm-history-remote ((,class :foreground ,red-alt-other)))
- `(helm-lisp-completion-info ((,class :foreground ,fg-special-warm)))
- `(helm-lisp-show-completion ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-yellow
- 'modus-theme-refine-yellow
- 'modus-theme-nuanced-yellow
- yellow
- 'bold))))
- `(helm-locate-finish ((,class :foreground ,green-active)))
- `(helm-match ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-cyan
- 'modus-theme-refine-cyan
- 'modus-theme-nuanced-cyan
- cyan
- 'bold))))
- `(helm-match-item ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-neutral
- 'modus-theme-subtle-cyan
- 'modus-theme-nuanced-cyan
- cyan-alt-other))))
- `(helm-minibuffer-prompt ((,class :inherit minibuffer-prompt)))
- `(helm-moccur-buffer ((,class :inherit button :foreground ,cyan-alt-other)))
- `(helm-mode-prefix ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-intense-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt
- 'bold))))
- `(helm-non-file-buffer ((,class :foreground ,fg-alt)))
- `(helm-prefarg ((,class :foreground ,red-active)))
- `(helm-resume-need-update ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other))))
- `(helm-selection ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-refine-blue
- 'modus-theme-special-cold
- nil
- 'bold))))
- `(helm-selection-line ((,class :inherit modus-theme-special-cold)))
- `(helm-separator ((,class :foreground ,fg-special-mild)))
- `(helm-time-zone-current ((,class :foreground ,green)))
- `(helm-time-zone-home ((,class :foreground ,magenta)))
- `(helm-source-header ((,class :inherit bold :foreground ,red-alt
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(helm-top-columns ((,class :inherit helm-header)))
- `(helm-ucs-char ((,class :foreground ,yellow-alt-other)))
- `(helm-visible-mark ((,class :inherit modus-theme-subtle-cyan)))
-;;;;; helm-ls-git
- `(helm-ls-git-added-copied-face ((,class :foreground ,green-intense)))
- `(helm-ls-git-added-modified-face ((,class :foreground ,yellow-intense)))
- `(helm-ls-git-conflict-face ((,class :inherit bold :foreground ,red-intense)))
- `(helm-ls-git-deleted-and-staged-face ((,class :foreground ,red-nuanced)))
- `(helm-ls-git-deleted-not-staged-face ((,class :foreground ,red)))
- `(helm-ls-git-modified-and-staged-face ((,class :foreground ,yellow-nuanced)))
- `(helm-ls-git-modified-not-staged-face ((,class :foreground ,yellow)))
- `(helm-ls-git-renamed-modified-face ((,class :foreground ,magenta)))
- `(helm-ls-git-untracked-face ((,class :foreground ,fg-special-cold)))
-;;;;; helm-switch-shell
- `(helm-switch-shell-new-shell-face ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other
- 'bold))))
-;;;;; helm-xref
- `(helm-xref-file-name ((,class :inherit bold :foreground ,fg-special-cold)))
- `(helm-xref-file-name ((,class :foreground ,fg-special-warm)))
-;;;;; helpful
- `(helpful-heading ((,class :inherit modus-theme-heading-1)))
-;;;;; highlight region or ad-hoc regexp
- `(hi-black-b ((,class :background ,fg-main :foreground ,bg-main)))
- `(hi-blue ((,class :background ,bg-alt :foreground ,blue :underline t)))
- `(hi-blue-b ((,class :inherit modus-theme-intense-blue)))
- `(hi-green ((,class :background ,bg-alt :foreground ,green :underline t)))
- `(hi-green-b ((,class :inherit modus-theme-intense-green)))
- `(hi-pink ((,class :background ,bg-alt :foreground ,magenta :underline t)))
- `(hi-red-b ((,class :inherit modus-theme-intense-red)))
- `(hi-yellow ((,class :background ,bg-alt :foreground ,yellow :underline t)))
- `(highlight ((,class :inherit modus-theme-subtle-blue)))
- `(highlight-changes ((,class :foreground ,yellow-alt-other)))
- `(highlight-changes-delete ((,class :foreground ,red-alt-other :underline t)))
- `(hl-line ((,class :inherit modus-theme-hl-line)))
-;;;;; highlight-blocks
- `(highlight-blocks-depth-1-face ((,class :background ,bg-dim :foreground ,fg-main)))
- `(highlight-blocks-depth-2-face ((,class :background ,bg-alt :foreground ,fg-main)))
- `(highlight-blocks-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-main)))
- `(highlight-blocks-depth-4-face ((,class :background ,bg-special-calm :foreground ,fg-main)))
- `(highlight-blocks-depth-5-face ((,class :background ,bg-special-warm :foreground ,fg-main)))
- `(highlight-blocks-depth-6-face ((,class :background ,bg-special-mild :foreground ,fg-main)))
- `(highlight-blocks-depth-7-face ((,class :background ,bg-inactive :foreground ,fg-main)))
- `(highlight-blocks-depth-8-face ((,class :background ,bg-active :foreground ,fg-main)))
- `(highlight-blocks-depth-9-face ((,class :background ,cyan-subtle-bg :foreground ,fg-main)))
-;;;;; highlight-defined
- `(highlight-defined-builtin-function-name-face ((,class :foreground ,magenta)))
- `(highlight-defined-face-name-face ((,class :foreground ,fg-main)))
- `(highlight-defined-function-name-face ((,class :foreground ,magenta)))
- `(highlight-defined-macro-name-face ((,class :foreground ,magenta-alt)))
- `(highlight-defined-special-form-name-face ((,class :foreground ,magenta-alt-other)))
- `(highlight-defined-variable-name-face ((,class :foreground ,cyan)))
-;;;;; highlight-escape-sequences (`hes-mode')
- `(hes-escape-backslash-face ((,class :inherit bold :foreground ,fg-escape-char-construct)))
- `(hes-escape-sequence-face ((,class :inherit bold :foreground ,fg-escape-char-backslash)))
-;;;;; highlight-indentation
- `(highlight-indentation-face ((,class :inherit modus-theme-hl-line)))
- `(highlight-indentation-current-column-face ((,class :background ,bg-active)))
-;;;;; highlight-numbers
- `(highlight-numbers-number ((,class :foreground ,blue-alt-other)))
-;;;;; highlight-symbol
- `(highlight-symbol-face ((,class :inherit modus-theme-special-mild)))
-;;;;; highlight-thing
- `(highlight-thing ((,class :background ,bg-alt :foreground ,cyan)))
-;;;;; hl-defined
- `(hdefd-functions ((,class :foreground ,blue)))
- `(hdefd-undefined ((,class :foreground ,red-alt)))
- `(hdefd-variables ((,class :foreground ,cyan-alt)))
-;;;;; hl-fill-column
- `(hl-fill-column-face ((,class :background ,bg-active :foreground ,fg-active)))
-;;;;; hl-todo
- `(hl-todo ((,class :inherit bold :foreground ,red-alt-other :slant ,modus-theme-slant)))
-;;;;; hydra
- `(hydra-face-amaranth ((,class :inherit bold :foreground ,yellow)))
- `(hydra-face-blue ((,class :inherit bold :foreground ,blue-alt)))
- `(hydra-face-pink ((,class :inherit bold :foreground ,magenta-alt)))
- `(hydra-face-red ((,class :inherit bold :foreground ,red)))
- `(hydra-face-teal ((,class :inherit bold :foreground ,cyan)))
-;;;;; hyperlist
- `(hyperlist-condition ((,class :foreground ,green)))
- `(hyperlist-hashtag ((,class :foreground ,yellow)))
- `(hyperlist-operator ((,class :foreground ,blue-alt)))
- `(hyperlist-paren ((,class :foreground ,cyan-alt-other)))
- `(hyperlist-quote ((,class :foreground ,cyan-alt)))
- `(hyperlist-ref ((,class :foreground ,magenta-alt-other)))
- `(hyperlist-stars ((,class :foreground ,fg-alt)))
- `(hyperlist-tag ((,class :foreground ,red)))
- `(hyperlist-toplevel ((,class :inherit bold :foreground ,fg-main)))
-;;;;; icomplete
- `(icomplete-first-match ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- magenta bg-alt
- bg-active fg-main))))
-;;;;; icomplete-vertical
- `(icomplete-vertical-separator ((,class :foreground ,fg-alt)))
-;;;;; ido-mode
- `(ido-first-match ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- magenta bg-alt
- bg-active fg-main))))
- `(ido-incomplete-regexp ((,class :inherit error)))
- `(ido-indicator ((,class :inherit modus-theme-subtle-yellow)))
- `(ido-only-match ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- green green-nuanced-bg
- green-intense-bg fg-main))))
- `(ido-subdir ((,class :foreground ,blue)))
- `(ido-virtual ((,class :foreground ,fg-special-warm)))
-;;;;; iedit
- `(iedit-occurrence ((,class :inherit modus-theme-refine-blue)))
- `(iedit-read-only-occurrence ((,class :inherit modus-theme-intense-yellow)))
-;;;;; iflipb
- `(iflipb-current-buffer-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(iflipb-other-buffer-face ((,class :foreground ,fg-alt)))
-;;;;; imenu-list
- `(imenu-list-entry-face-0 ((,class :foreground ,cyan)))
- `(imenu-list-entry-face-1 ((,class :foreground ,blue)))
- `(imenu-list-entry-face-2 ((,class :foreground ,cyan-alt-other)))
- `(imenu-list-entry-face-3 ((,class :foreground ,blue-alt)))
- `(imenu-list-entry-subalist-face-0 ((,class :inherit bold :foreground ,magenta-alt-other :underline t)))
- `(imenu-list-entry-subalist-face-1 ((,class :inherit bold :foreground ,magenta :underline t)))
- `(imenu-list-entry-subalist-face-2 ((,class :inherit bold :foreground ,green-alt-other :underline t)))
- `(imenu-list-entry-subalist-face-3 ((,class :inherit bold :foreground ,red-alt-other :underline t)))
-;;;;; indium
- `(indium-breakpoint-face ((,class :foreground ,red-active)))
- `(indium-frame-url-face ((,class :inherit button :foreground ,fg-alt)))
- `(indium-keyword-face ((,class :foreground ,magenta-alt-other)))
- `(indium-litable-face ((,class :foreground ,fg-special-warm :slant ,modus-theme-slant)))
- `(indium-repl-error-face ((,class :inherit bold :foreground ,red)))
- `(indium-repl-prompt-face ((,class :foreground ,cyan-alt-other)))
- `(indium-repl-stdout-face ((,class :foreground ,fg-main)))
-;;;;; info
- `(Info-quoted ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,magenta))) ; the capitalisation is canonical
- `(info-header-node ((,class :inherit bold :foreground ,fg-alt)))
- `(info-header-xref ((,class :foreground ,blue-active)))
- `(info-index-match ((,class :inherit match)))
- `(info-menu-header ((,class :inherit modus-theme-heading-3)))
- `(info-menu-star ((,class :foreground ,red)))
- `(info-node ((,class :inherit bold)))
- `(info-title-1 ((,class :inherit modus-theme-heading-1)))
- `(info-title-2 ((,class :inherit modus-theme-heading-2)))
- `(info-title-3 ((,class :inherit modus-theme-heading-3)))
- `(info-title-4 ((,class :inherit modus-theme-heading-4)))
-;;;;; info-colors
- `(info-colors-lisp-code-block ((,class :inherit fixed-pitch)))
- `(info-colors-ref-item-command ((,class :foreground ,magenta)))
- `(info-colors-ref-item-constant ((,class :foreground ,blue-alt-other)))
- `(info-colors-ref-item-function ((,class :foreground ,magenta)))
- `(info-colors-ref-item-macro ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt-other)))
- `(info-colors-ref-item-other ((,class :foreground ,cyan)))
- `(info-colors-ref-item-special-form ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt-other)))
- `(info-colors-ref-item-syntax-class ((,class :foreground ,magenta)))
- `(info-colors-ref-item-type ((,class :foreground ,magenta-alt)))
- `(info-colors-ref-item-user-option ((,class :foreground ,cyan)))
- `(info-colors-ref-item-variable ((,class :foreground ,cyan)))
-;;;;; interaction-log
- `(ilog-buffer-face ((,class :foreground ,magenta-alt-other)))
- `(ilog-change-face ((,class :foreground ,magenta-alt)))
- `(ilog-echo-face ((,class :foreground ,yellow-alt-other)))
- `(ilog-load-face ((,class :foreground ,green)))
- `(ilog-message-face ((,class :foreground ,fg-alt)))
- `(ilog-non-change-face ((,class :foreground ,blue)))
-;;;;; ioccur
- `(ioccur-cursor ((,class :foreground ,fg-main)))
- `(ioccur-invalid-regexp ((,class :foreground ,red)))
- `(ioccur-match-face ((,class :inherit modus-theme-special-calm)))
- `(ioccur-match-overlay-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :inherit modus-theme-special-cold)))
- `(ioccur-num-line-face ((,class :foreground ,fg-special-warm)))
- `(ioccur-overlay-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :inherit modus-theme-refine-blue)))
- `(ioccur-regexp-face ((,class :inherit (modus-theme-intense-magenta bold))))
- `(ioccur-title-face ((,class :inherit bold :foreground ,red-alt
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
-;;;;; isearch, occur, and the like
- `(isearch ((,class :inherit (modus-theme-intense-green bold))))
- `(isearch-fail ((,class :inherit modus-theme-refine-red)))
- `(lazy-highlight ((,class :inherit modus-theme-refine-cyan)))
- `(match ((,class :inherit modus-theme-special-calm)))
- `(query-replace ((,class :inherit (modus-theme-intense-yellow bold))))
-;;;;; ivy
- `(ivy-action ((,class :inherit bold :foreground ,red-alt)))
- `(ivy-completions-annotations ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(ivy-confirm-face ((,class :foreground ,cyan)))
- `(ivy-current-match ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-refine-cyan
- 'modus-theme-intense-cyan
- 'modus-theme-special-warm
- nil
- 'bold))))
- `(ivy-cursor ((,class :background ,fg-main :foreground ,bg-main)))
- `(ivy-grep-info ((,class :foreground ,cyan-alt)))
- `(ivy-grep-line-number ((,class :foreground ,fg-special-warm)))
- `(ivy-highlight-face ((,class :foreground ,magenta)))
- `(ivy-match-required-face ((,class :inherit error)))
- `(ivy-minibuffer-match-face-1 ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-neutral
- 'modus-theme-intense-neutral
- 'modus-theme-subtle-neutral
- fg-alt))))
- `(ivy-minibuffer-match-face-2 ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-green
- 'modus-theme-refine-green
- 'modus-theme-nuanced-green
- green-alt-other
- 'bold))))
- `(ivy-minibuffer-match-face-3 ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-cyan
- 'modus-theme-refine-cyan
- 'modus-theme-nuanced-cyan
- cyan-alt-other
- 'bold))))
- `(ivy-minibuffer-match-face-4 ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other
- 'bold))))
- `(ivy-minibuffer-match-highlight ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-intense-blue
- 'modus-theme-nuanced-blue
- blue-alt-other
- 'bold))))
- `(ivy-modified-buffer ((,class :foreground ,yellow :slant ,modus-theme-slant)))
- `(ivy-modified-outside-buffer ((,class :foreground ,yellow-alt :slant ,modus-theme-slant)))
- `(ivy-org ((,class :foreground ,cyan-alt-other)))
- `(ivy-prompt-match ((,class :inherit ivy-current-match)))
- `(ivy-remote ((,class :foreground ,magenta)))
- `(ivy-separator ((,class :foreground ,fg-alt)))
- `(ivy-subdir ((,class :foreground ,blue-alt-other)))
- `(ivy-virtual ((,class :foreground ,magenta-alt-other)))
- `(ivy-yanked-word ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-refine-blue
- 'modus-theme-nuanced-blue
- blue-alt))))
-;;;;; ivy-posframe
- `(ivy-posframe ((,class :background ,bg-dim :foreground ,fg-main)))
- `(ivy-posframe-border ((,class :background ,bg-active)))
- `(ivy-posframe-cursor ((,class :background ,fg-main :foreground ,bg-main)))
-;;;;; jira (org-jira)
- `(jiralib-comment-face ((,class :background ,bg-alt)))
- `(jiralib-comment-header-face ((,class :inherit bold)))
- `(jiralib-issue-info-face ((,class :inherit modus-theme-special-warm)))
- `(jiralib-issue-info-header-face ((,class :inherit (modus-theme-special-warm bold))))
- `(jiralib-issue-summary-face ((,class :inherit bold)))
- `(jiralib-link-filter-face ((,class :underline t)))
- `(jiralib-link-issue-face ((,class :underline t)))
- `(jiralib-link-project-face ((,class :underline t)))
-;;;;; journalctl-mode
- `(journalctl-error-face ((,class :inherit bold :foreground ,red)))
- `(journalctl-finished-face ((,class :inherit bold :foreground ,green)))
- `(journalctl-host-face ((,class :foreground ,blue)))
- `(journalctl-process-face ((,class :foreground ,cyan-alt-other)))
- `(journalctl-starting-face ((,class :foreground ,green)))
- `(journalctl-timestamp-face ((,class :foreground ,fg-special-cold)))
- `(journalctl-warning-face ((,class :inherit bold :foreground ,yellow)))
-;;;;; js2-mode
- `(js2-error ((,class :foreground ,red)))
- `(js2-external-variable ((,class :foreground ,cyan-alt-other)))
- `(js2-function-call ((,class :foreground ,magenta)))
- `(js2-function-param ((,class :foreground ,blue)))
- `(js2-instance-member ((,class :foreground ,magenta-alt-other)))
- `(js2-jsdoc-html-tag-delimiter ((,class :foreground ,fg-main)))
- `(js2-jsdoc-html-tag-name ((,class :foreground ,cyan)))
- `(js2-jsdoc-tag ((,class :foreground ,fg-special-calm)))
- `(js2-jsdoc-type ((,class :foreground ,fg-special-cold)))
- `(js2-jsdoc-value ((,class :foreground ,fg-special-warm)))
- `(js2-object-property ((,class :foreground ,fg-main)))
- `(js2-object-property-access ((,class :foreground ,fg-main)))
- `(js2-private-function-call ((,class :foreground ,green-alt-other)))
- `(js2-private-member ((,class :foreground ,fg-special-mild)))
- `(js2-warning ((,class :foreground ,yellow-alt :underline t)))
-;;;;; julia
- `(julia-macro-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta)))
- `(julia-quoted-symbol-face ((,class :foreground ,blue-alt-other)))
-;;;;; jupyter
- `(jupyter-eval-overlay ((,class :inherit bold :foreground ,blue)))
- `(jupyter-repl-input-prompt ((,class :foreground ,cyan-alt-other)))
- `(jupyter-repl-output-prompt ((,class :foreground ,magenta-alt-other)))
- `(jupyter-repl-traceback ((,class :inherit modus-theme-intense-red)))
-;;;;; kaocha-runner
- `(kaocha-runner-error-face ((,class :foreground ,red)))
- `(kaocha-runner-success-face ((,class :foreground ,green)))
- `(kaocha-runner-warning-face ((,class :foreground ,yellow)))
-;;;;; keycast
- `(keycast-command ((,class :inherit bold :foreground ,blue-active)))
- `(keycast-key ((,class ,@(modus-vivendi-theme-mode-line-attrs
- bg-main blue-active
- bg-main blue-active
- blue-active blue-intense
- 'alt-style -3))))
-;;;;; line numbers (display-line-numbers-mode and global variant)
- `(line-number ((,class :inherit default :background ,bg-dim :foreground ,fg-alt)))
- `(line-number-current-line ((,class :inherit default :background ,bg-active :foreground ,fg-main)))
-;;;;; lsp-mode
- `(lsp-face-highlight-read ((,class :inherit modus-theme-subtle-blue :underline t)))
- `(lsp-face-highlight-textual ((,class :inherit modus-theme-subtle-blue)))
- `(lsp-face-highlight-write ((,class :inherit (modus-theme-refine-blue bold))))
- `(lsp-face-semhl-constant ((,class :foreground ,blue-alt-other)))
- `(lsp-face-semhl-deprecated
- ((,(append '((supports :underline (:style wave))) class)
- :foreground ,yellow :underline (:style wave))
- (,class :foreground ,yellow :underline t)))
- `(lsp-face-semhl-enummember ((,class :foreground ,blue-alt-other)))
- `(lsp-face-semhl-field ((,class :foreground ,cyan-alt)))
- `(lsp-face-semhl-field-static ((,class :foreground ,cyan-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-function ((,class :foreground ,magenta)))
- `(lsp-face-semhl-method ((,class :foreground ,magenta)))
- `(lsp-face-semhl-namespace ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt)))
- `(lsp-face-semhl-preprocessor ((,class :foreground ,red-alt-other)))
- `(lsp-face-semhl-static-method ((,class :foreground ,magenta :slant ,modus-theme-slant)))
- `(lsp-face-semhl-type-class ((,class :foreground ,magenta-alt)))
- `(lsp-face-semhl-type-enum ((,class :foreground ,magenta-alt)))
- `(lsp-face-semhl-type-primitive ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-type-template ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-type-typedef ((,class :foreground ,magenta-alt :slant ,modus-theme-slant)))
- `(lsp-face-semhl-variable ((,class :foreground ,cyan)))
- `(lsp-face-semhl-variable-local ((,class :foreground ,cyan)))
- `(lsp-face-semhl-variable-parameter ((,class :foreground ,cyan-alt-other)))
- `(lsp-lens-face ((,class :height 0.8 :foreground ,fg-alt)))
- `(lsp-lens-mouse-face ((,class :height 0.8 :foreground ,blue-alt-other :underline t)))
- `(lsp-ui-doc-background ((,class :background ,bg-alt)))
- `(lsp-ui-doc-header ((,class :background ,bg-header :foreground ,fg-header)))
- `(lsp-ui-doc-url ((,class :inherit button :foreground ,blue-alt-other)))
- `(lsp-ui-peek-filename ((,class :foreground ,fg-special-warm)))
- `(lsp-ui-peek-footer ((,class :background ,bg-header :foreground ,fg-header)))
- `(lsp-ui-peek-header ((,class :background ,bg-header :foreground ,fg-header)))
- `(lsp-ui-peek-highlight ((,class :inherit modus-theme-subtle-blue)))
- `(lsp-ui-peek-line-number ((,class :foreground ,fg-alt)))
- `(lsp-ui-peek-list ((,class :background ,bg-dim)))
- `(lsp-ui-peek-peek ((,class :background ,bg-alt)))
- `(lsp-ui-peek-selection ((,class :inherit modus-theme-subtle-cyan)))
- `(lsp-ui-sideline-code-action ((,class :foreground ,yellow)))
- `(lsp-ui-sideline-current-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-main)))
- `(lsp-ui-sideline-symbol ((,class :inherit bold :height 0.99 :box (:line-width -1 :style nil) :foreground ,fg-alt)))
- `(lsp-ui-sideline-symbol-info ((,class :height 0.99 :slant italic)))
-;;;;; magit
- `(magit-bisect-bad ((,class :foreground ,red-alt-other)))
- `(magit-bisect-good ((,class :foreground ,green-alt-other)))
- `(magit-bisect-skip ((,class :foreground ,yellow-alt-other)))
- `(magit-blame-date ((,class :foreground ,blue)))
- `(magit-blame-dimmed ((,class :foreground ,fg-alt)))
- `(magit-blame-hash ((,class :foreground ,fg-special-warm)))
- `(magit-blame-heading ((,class :background ,bg-alt)))
- `(magit-blame-highlight ((,class :inherit modus-theme-nuanced-cyan)))
- `(magit-blame-margin ((,class :inherit magit-blame-highlight)))
- `(magit-blame-name ((,class :foreground ,magenta-alt-other)))
- `(magit-blame-summary ((,class :foreground ,cyan-alt-other)))
- `(magit-branch-current ((,class :foreground ,blue-alt-other :box t)))
- `(magit-branch-local ((,class :foreground ,blue-alt)))
- `(magit-branch-remote ((,class :foreground ,magenta-alt)))
- `(magit-branch-remote-head ((,class :foreground ,magenta-alt-other :box t)))
- `(magit-branch-upstream ((,class :slant italic)))
- `(magit-cherry-equivalent ((,class :background ,bg-main :foreground ,magenta-intense)))
- `(magit-cherry-unmatched ((,class :background ,bg-main :foreground ,cyan-intense)))
- ;; NOTE: here we break from the pattern of inheriting from the
- ;; modus-theme-diff-* faces, though only for the standard actions,
- ;; not the highlighted ones. This is because Magit's interaction
- ;; model relies on highlighting the current diff hunk.
- `(magit-diff-added ((,class ,@(modus-vivendi-theme-diff
- bg-main green
- bg-diff-added fg-diff-added
- green-nuanced-bg fg-diff-added))))
- `(magit-diff-added-highlight ((,class :inherit modus-theme-diff-focus-added)))
- `(magit-diff-base ((,class ,@(modus-vivendi-theme-diff
- bg-main yellow
- bg-diff-changed fg-diff-changed
- yellow-nuanced-bg fg-diff-changed))))
- `(magit-diff-base-highlight ((,class :inherit modus-theme-diff-focus-changed)))
- `(magit-diff-context ((,class :foreground ,fg-unfocused)))
- `(magit-diff-context-highlight ((,class ,@(modus-vivendi-theme-diff
- bg-dim fg-dim
- bg-inactive fg-inactive
- bg-dim fg-alt))))
- `(magit-diff-file-heading ((,class :inherit bold :foreground ,fg-special-cold)))
- `(magit-diff-file-heading-highlight ((,class :inherit (modus-theme-special-cold bold))))
- `(magit-diff-file-heading-selection ((,class :inherit modus-theme-refine-cyan)))
- ;; NOTE: here we break from the pattern of inheriting from the
- ;; modus-theme-diff-* faces.
- `(magit-diff-hunk-heading ((,class :inherit bold :background ,bg-active
- :foreground ,fg-inactive)))
- `(magit-diff-hunk-heading-highlight ((,class :inherit bold :background ,bg-diff-heading
- :foreground ,fg-diff-heading)))
- `(magit-diff-hunk-heading-selection ((,class :inherit modus-theme-refine-blue)))
- `(magit-diff-hunk-region ((,class :inherit bold)))
- `(magit-diff-lines-boundary ((,class :background ,fg-main)))
- `(magit-diff-lines-heading ((,class :inherit modus-theme-refine-magenta)))
- `(magit-diff-removed ((,class ,@(modus-vivendi-theme-diff
- bg-main red
- bg-diff-removed fg-diff-removed
- red-nuanced-bg fg-diff-removed))))
- `(magit-diff-removed-highlight ((,class :inherit modus-theme-diff-focus-removed)))
- `(magit-diffstat-added ((,class :foreground ,green)))
- `(magit-diffstat-removed ((,class :foreground ,red)))
- `(magit-dimmed ((,class :foreground ,fg-unfocused)))
- `(magit-filename ((,class :foreground ,fg-special-cold)))
- `(magit-hash ((,class :foreground ,fg-alt)))
- `(magit-head ((,class :inherit magit-branch-local)))
- `(magit-header-line ((,class :inherit bold :foreground ,magenta-active)))
- `(magit-header-line-key ((,class :inherit bold :foreground ,red-active)))
- `(magit-header-line-log-select ((,class :inherit bold :foreground ,fg-main)))
- `(magit-keyword ((,class :foreground ,magenta)))
- `(magit-keyword-squash ((,class :inherit bold :foreground ,yellow-alt-other)))
- `(magit-log-author ((,class :foreground ,cyan)))
- `(magit-log-date ((,class :foreground ,fg-alt)))
- `(magit-log-graph ((,class :foreground ,fg-dim)))
- `(magit-mode-line-process ((,class :inherit bold :foreground ,blue-active)))
- `(magit-mode-line-process-error ((,class :inherit bold :foreground ,red-active)))
- `(magit-process-ng ((,class :inherit error)))
- `(magit-process-ok ((,class :inherit success)))
- `(magit-reflog-amend ((,class :background ,bg-main :foreground ,magenta-intense)))
- `(magit-reflog-checkout ((,class :background ,bg-main :foreground ,blue-intense)))
- `(magit-reflog-cherry-pick ((,class :background ,bg-main :foreground ,green-intense)))
- `(magit-reflog-commit ((,class :background ,bg-main :foreground ,green-intense)))
- `(magit-reflog-merge ((,class :background ,bg-main :foreground ,green-intense)))
- `(magit-reflog-other ((,class :background ,bg-main :foreground ,cyan-intense)))
- `(magit-reflog-rebase ((,class :background ,bg-main :foreground ,magenta-intense)))
- `(magit-reflog-remote ((,class :background ,bg-main :foreground ,cyan-intense)))
- `(magit-reflog-reset ((,class :background ,bg-main :foreground ,red-intense)))
- `(magit-refname ((,class :foreground ,fg-alt)))
- `(magit-refname-pullreq ((,class :foreground ,fg-alt)))
- `(magit-refname-stash ((,class :foreground ,fg-alt)))
- `(magit-refname-wip ((,class :foreground ,fg-alt)))
- `(magit-section ((,class :background ,bg-dim :foreground ,fg-main)))
- `(magit-section-heading ((,class :inherit bold :foreground ,cyan)))
- `(magit-section-heading-selection ((,class :inherit (modus-theme-refine-cyan bold))))
- `(magit-section-highlight ((,class :background ,bg-alt)))
- `(magit-sequence-done ((,class :foreground ,green-alt)))
- `(magit-sequence-drop ((,class :foreground ,red-alt)))
- `(magit-sequence-exec ((,class :foreground ,magenta-alt)))
- `(magit-sequence-head ((,class :foreground ,cyan-alt)))
- `(magit-sequence-onto ((,class :foreground ,fg-alt)))
- `(magit-sequence-part ((,class :foreground ,yellow-alt)))
- `(magit-sequence-pick ((,class :foreground ,blue-alt)))
- `(magit-sequence-stop ((,class :foreground ,red)))
- `(magit-signature-bad ((,class :inherit bold :foreground ,red)))
- `(magit-signature-error ((,class :foreground ,red-alt)))
- `(magit-signature-expired ((,class :foreground ,yellow)))
- `(magit-signature-expired-key ((,class :foreground ,yellow)))
- `(magit-signature-good ((,class :foreground ,green)))
- `(magit-signature-revoked ((,class :foreground ,magenta)))
- `(magit-signature-untrusted ((,class :foreground ,cyan)))
- `(magit-tag ((,class :foreground ,yellow-alt-other)))
-;;;;; magit-imerge
- `(magit-imerge-overriding-value ((,class :inherit bold :foreground ,red-alt)))
-;;;;; man
- `(Man-overstrike ((,class :inherit bold :foreground ,magenta)))
- `(Man-reverse ((,class :inherit modus-theme-subtle-magenta)))
- `(Man-underline ((,class :foreground ,cyan :underline t)))
-;;;;; markdown-mode
- `(markdown-blockquote-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(markdown-bold-face ((,class :inherit bold)))
- `(markdown-code-face ((,class ,@(modus-vivendi-theme-mixed-fonts))))
- `(markdown-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(markdown-footnote-marker-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(markdown-footnote-text-face ((,class :foreground ,fg-main :slant ,modus-theme-slant)))
- `(markdown-gfm-checkbox-face ((,class :foreground ,cyan-alt-other)))
- `(markdown-header-delimiter-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,fg-dim)))
- `(markdown-header-face ((t nil)))
- `(markdown-header-face-1 ((,class :inherit modus-theme-heading-1)))
- `(markdown-header-face-2 ((,class :inherit modus-theme-heading-2)))
- `(markdown-header-face-3 ((,class :inherit modus-theme-heading-3)))
- `(markdown-header-face-4 ((,class :inherit modus-theme-heading-4)))
- `(markdown-header-face-5 ((,class :inherit modus-theme-heading-5)))
- `(markdown-header-face-6 ((,class :inherit modus-theme-heading-6)))
- `(markdown-header-rule-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(markdown-hr-face ((,class :inherit bold :foreground ,fg-special-warm)))
- `(markdown-html-attr-name-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,cyan)))
- `(markdown-html-attr-value-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,blue)))
- `(markdown-html-entity-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,cyan)))
- `(markdown-html-tag-delimiter-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,fg-special-mild)))
- `(markdown-html-tag-name-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,magenta-alt)))
- `(markdown-inline-code-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,magenta)))
- `(markdown-italic-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(markdown-language-info-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,fg-special-cold)))
- `(markdown-language-keyword-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,green-alt-other)))
- `(markdown-line-break-face ((,class :inherit modus-theme-refine-cyan :underline t)))
- `(markdown-link-face ((,class :inherit link)))
- `(markdown-link-title-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(markdown-list-face ((,class :foreground ,fg-dim)))
- `(markdown-markup-face ((,class :foreground ,fg-alt)))
- `(markdown-math-face ((,class :foreground ,magenta-alt-other)))
- `(markdown-metadata-key-face ((,class :foreground ,cyan-alt-other)))
- `(markdown-metadata-value-face ((,class :foreground ,blue-alt)))
- `(markdown-missing-link-face ((,class :inherit bold :foreground ,yellow)))
- `(markdown-plain-url-face ((,class :inherit markdown-link-face)))
- `(markdown-pre-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- ,@(modus-vivendi-theme-mixed-fonts)
- :background ,bg-dim
- :foreground ,fg-special-mild)))
- `(markdown-reference-face ((,class :inherit markdown-markup-face)))
- `(markdown-strike-through-face ((,class :strike-through t)))
- `(markdown-table-face ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,fg-special-cold)))
- `(markdown-url-face ((,class :foreground ,blue-alt)))
-;;;;; markup-faces (`adoc-mode')
- `(markup-anchor-face ((,class :foreground ,fg-inactive)))
- `(markup-attribute-face ((,class :foreground ,fg-inactive :slant italic)))
- `(markup-big-face ((,class :height 1.3 :foreground ,blue-nuanced)))
- `(markup-bold-face ((,class :inherit bold :foreground ,red-nuanced)))
- `(markup-code-face ((,class :inherit fixed-pitch :foreground ,magenta)))
- `(markup-command-face ((,class :foreground ,fg-inactive)))
- `(markup-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(markup-complex-replacement-face ((,class :box (:line-width 2 :color nil :style released-button)
- :inherit modus-theme-refine-magenta)))
- `(markup-emphasis-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(markup-error-face ((,class :inherit bold :foreground ,red)))
- `(markup-gen-face ((,class :foreground ,magenta-alt)))
- `(markup-internal-reference-face ((,class :inherit button :foreground ,fg-inactive)))
- `(markup-italic-face ((,class :foreground ,fg-special-cold :slant italic)))
- `(markup-list-face ((,class :inherit modus-theme-special-calm)))
- `(markup-meta-face ((,class :foreground ,fg-inactive)))
- `(markup-meta-hide-face ((,class :foreground ,fg-alt)))
- `(markup-passthrough-face ((,class :inherit fixed-pitch :foreground ,cyan)))
- `(markup-preprocessor-face ((,class :foreground ,red-alt-other)))
- `(markup-replacement-face ((,class :foreground ,yellow-alt-other)))
- `(markup-secondary-text-face ((,class :height 0.8 :foreground ,magenta-nuanced)))
- `(markup-small-face ((,class :height 0.8 :foreground ,fg-main)))
- `(markup-strong-face ((,class :inherit bold :foreground ,red-nuanced)))
- `(markup-subscript-face ((,class :height 0.8 :foreground ,fg-special-cold)))
- `(markup-superscript-face ((,class :height 0.8 :foreground ,fg-special-cold)))
- `(markup-table-cell-face ((,class :inherit modus-theme-special-cold)))
- `(markup-table-face ((,class :inherit modus-theme-subtle-cyan)))
- `(markup-table-row-face ((,class :inherit modus-theme-subtle-cyan)))
- `(markup-title-0-face ((,class :height 3.0 :foreground ,blue-nuanced)))
- `(markup-title-1-face ((,class :height 2.4 :foreground ,blue-nuanced)))
- `(markup-title-2-face ((,class :height 1.8 :foreground ,blue-nuanced)))
- `(markup-title-3-face ((,class :height 1.4 :foreground ,blue-nuanced)))
- `(markup-title-4-face ((,class :height 1.2 :foreground ,blue-nuanced)))
- `(markup-title-5-face ((,class :height 1.2 :foreground ,blue-nuanced :underline t)))
- `(markup-value-face ((,class :foreground ,fg-inactive)))
- `(markup-verbatim-face ((,class :inherit modus-theme-special-mild)))
-;;;;; mentor
- `(mentor-download-message ((,class :foreground ,fg-special-warm)))
- `(mentor-download-name ((,class :foreground ,fg-special-cold)))
- `(mentor-download-progress ((,class :foreground ,blue-alt-other)))
- `(mentor-download-size ((,class :foreground ,magenta-alt-other)))
- `(mentor-download-speed-down ((,class :foreground ,cyan-alt)))
- `(mentor-download-speed-up ((,class :foreground ,red-alt)))
- `(mentor-download-state ((,class :foreground ,yellow-alt)))
- `(mentor-highlight-face ((,class :inherit modus-theme-subtle-blue)))
- `(mentor-tracker-name ((,class :foreground ,magenta-alt)))
-;;;;; messages
- `(message-cited-text-1 ((,class :foreground ,blue-alt)))
- `(message-cited-text-2 ((,class :foreground ,red-alt)))
- `(message-cited-text-3 ((,class :foreground ,green-alt)))
- `(message-cited-text-4 ((,class :foreground ,magenta-alt)))
- `(message-header-cc ((,class :inherit bold :foreground ,cyan-alt)))
- `(message-header-name ((,class :foreground ,green-alt-other)))
- `(message-header-newsgroups ((,class :inherit bold :foreground ,green-alt)))
- `(message-header-other ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(message-header-subject ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(message-header-to ((,class :inherit bold :foreground ,blue)))
- `(message-header-xheader ((,class :foreground ,cyan)))
- `(message-mml ((,class :foreground ,fg-special-warm)))
- `(message-separator ((,class :inherit modus-theme-intense-neutral)))
-;;;;; minibuffer-line
- `(minibuffer-line ((,class :foreground ,fg-main)))
-;;;;; minimap
- `(minimap-active-region-background ((,class :background ,bg-active)))
- `(minimap-current-line-face ((,class :background ,cyan-intense-bg :foreground ,fg-main)))
-;;;;; modeline
- `(mode-line ((,class ,@(modus-vivendi-theme-mode-line-attrs
- fg-active bg-active fg-dim bg-active
- fg-alt bg-active 'alt-style nil bg-main))))
- `(mode-line-buffer-id ((,class :inherit bold)))
- `(mode-line-emphasis ((,class :inherit bold :foreground ,blue-active)))
- `(mode-line-highlight ((,class :inherit modus-theme-active-blue :box (:line-width -1 :style pressed-button))))
- `(mode-line-inactive ((,class ,@(modus-vivendi-theme-mode-line-attrs
- fg-inactive bg-inactive fg-alt bg-dim
- bg-region bg-active))))
-;;;;; mood-line
- `(mood-line-modified ((,class :foreground ,magenta-active)))
- `(mood-line-status-error ((,class :inherit bold :foreground ,red-active)))
- `(mood-line-status-info ((,class :foreground ,cyan-active)))
- `(mood-line-status-neutral ((,class :foreground ,blue-active)))
- `(mood-line-status-success ((,class :foreground ,green-active)))
- `(mood-line-status-warning ((,class :inherit bold :foreground ,yellow-active)))
- `(mood-line-unimportant ((,class :foreground ,fg-inactive)))
-;;;;; mpdel
- `(mpdel-browser-directory-face ((,class :foreground ,blue)))
- `(mpdel-playlist-current-song-face ((,class :inherit bold :foreground ,blue-alt-other)))
-;;;;; mu4e
- `(mu4e-attach-number-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(mu4e-cited-1-face ((,class :foreground ,blue-alt)))
- `(mu4e-cited-2-face ((,class :foreground ,red-alt)))
- `(mu4e-cited-3-face ((,class :foreground ,green-alt)))
- `(mu4e-cited-4-face ((,class :foreground ,magenta-alt)))
- `(mu4e-cited-5-face ((,class :foreground ,yellow-alt)))
- `(mu4e-cited-6-face ((,class :foreground ,cyan-alt)))
- `(mu4e-cited-7-face ((,class :foreground ,magenta)))
- `(mu4e-compose-header-face ((,class :inherit mu4e-compose-separator-face)))
- `(mu4e-compose-separator-face ((,class :inherit modus-theme-intense-neutral)))
- `(mu4e-contact-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(mu4e-context-face ((,class :foreground ,blue-active)))
- `(mu4e-draft-face ((,class :foreground ,magenta-alt)))
- `(mu4e-flagged-face ((,class :foreground ,red-alt)))
- `(mu4e-footer-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(mu4e-forwarded-face ((,class :foreground ,magenta-alt-other)))
- `(mu4e-header-face ((,class :foreground ,fg-alt)))
- `(mu4e-header-highlight-face ((,class :inherit modus-theme-hl-line)))
- `(mu4e-header-key-face ((,class :foreground ,cyan)))
- `(mu4e-header-marks-face ((,class :inherit bold :foreground ,magenta-alt)))
- `(mu4e-header-title-face ((,class :foreground ,fg-special-mild)))
- `(mu4e-header-value-face ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(mu4e-highlight-face ((,class :inherit bold :foreground ,blue-alt-other)))
- `(mu4e-link-face ((,class :inherit link)))
- `(mu4e-modeline-face ((,class :foreground ,magenta-active)))
- `(mu4e-moved-face ((,class :foreground ,yellow :slant ,modus-theme-slant)))
- `(mu4e-ok-face ((,class :inherit bold :foreground ,green)))
- `(mu4e-region-code ((,class :inherit modus-theme-special-calm)))
- `(mu4e-replied-face ((,class :foreground ,blue-faint)))
- `(mu4e-special-header-value-face ((,class :inherit bold :foreground ,blue-alt-other)))
- `(mu4e-system-face ((,class :foreground ,fg-mark-del :slant ,modus-theme-slant)))
- `(mu4e-title-face ((,class :foreground ,fg-main)))
- `(mu4e-trashed-face ((,class :foreground ,red)))
- `(mu4e-unread-face ((,class :inherit bold :foreground ,fg-main)))
- `(mu4e-url-number-face ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(mu4e-view-body-face ((,class :foreground ,fg-main)))
- `(mu4e-warning-face ((,class :inherit warning)))
-;;;;; mu4e-conversation
- `(mu4e-conversation-header ((,class :inherit modus-theme-special-cold)))
- `(mu4e-conversation-sender-1 ((,class :foreground ,fg-special-warm)))
- `(mu4e-conversation-sender-2 ((,class :foreground ,fg-special-cold)))
- `(mu4e-conversation-sender-3 ((,class :foreground ,fg-special-mild)))
- `(mu4e-conversation-sender-4 ((,class :foreground ,fg-alt)))
- `(mu4e-conversation-sender-5 ((,class :foreground ,yellow-refine-fg)))
- `(mu4e-conversation-sender-6 ((,class :foreground ,cyan-refine-fg)))
- `(mu4e-conversation-sender-7 ((,class :foreground ,green-refine-fg)))
- `(mu4e-conversation-sender-8 ((,class :foreground ,blue-refine-fg)))
- `(mu4e-conversation-sender-me ((,class :foreground ,fg-main)))
- `(mu4e-conversation-unread ((,class :inherit bold)))
-;;;;; multiple-cursors
- `(mc/cursor-bar-face ((,class :height 1 :background ,fg-main)))
- `(mc/cursor-face ((,class :inverse-video t)))
- `(mc/region-face ((,class :inherit region)))
-;;;;; neotree
- `(neo-banner-face ((,class :foreground ,magenta)))
- `(neo-button-face ((,class :inherit button)))
- `(neo-dir-link-face ((,class :inherit bold :foreground ,blue)))
- `(neo-expand-btn-face ((,class :foreground ,cyan)))
- `(neo-file-link-face ((,class :foreground ,fg-main)))
- `(neo-header-face ((,class :inherit bold :foreground ,fg-main)))
- `(neo-root-dir-face ((,class :inherit bold :foreground ,cyan-alt)))
- `(neo-vc-added-face ((,class :foreground ,green)))
- `(neo-vc-conflict-face ((,class :inherit bold :foreground ,red)))
- `(neo-vc-default-face ((,class :foreground ,fg-main)))
- `(neo-vc-edited-face ((,class :foreground ,yellow)))
- `(neo-vc-ignored-face ((,class :foreground ,fg-inactive)))
- `(neo-vc-missing-face ((,class :foreground ,red-alt)))
- `(neo-vc-needs-merge-face ((,class :foreground ,magenta-alt)))
- `(neo-vc-needs-update-face ((,class :underline t)))
- `(neo-vc-removed-face ((,class :strike-through t)))
- `(neo-vc-unlocked-changes-face ((,class :inherit modus-theme-refine-blue)))
- `(neo-vc-up-to-date-face ((,class :foreground ,fg-alt)))
- `(neo-vc-user-face ((,class :foreground ,magenta)))
-;;;;; no-emoji
- `(no-emoji ((,class :foreground ,cyan)))
-;;;;; notmuch
- `(notmuch-crypto-decryption ((,class :inherit modus-theme-refine-magenta)))
- `(notmuch-crypto-part-header ((,class :foreground ,magenta-alt-other)))
- `(notmuch-crypto-signature-bad ((,class :inherit modus-theme-intense-red)))
- `(notmuch-crypto-signature-good ((,class :inherit modus-theme-refine-green)))
- `(notmuch-crypto-signature-good-key ((,class :inherit modus-theme-refine-yellow)))
- `(notmuch-crypto-signature-unknown ((,class :inherit modus-theme-refine-red)))
- `(notmuch-hello-logo-background ((,class :background ,bg-main)))
- `(notmuch-message-summary-face ((,class :inherit modus-theme-nuanced-cyan)))
- `(notmuch-search-flagged-face ((,class :foreground ,red-alt)))
- `(notmuch-search-matching-authors ((,class :foreground ,fg-main)))
- `(notmuch-search-non-matching-authors ((,class :foreground ,fg-alt)))
- `(notmuch-search-unread-face ((,class :inherit bold)))
- `(notmuch-tag-added
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,green :style wave))
- (,class :foreground ,green :underline t)))
- `(notmuch-tag-deleted
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,red :style wave))
- (,class :foreground ,red :underline t)))
- `(notmuch-tag-face ((,class :inherit bold :foreground ,blue-alt)))
- `(notmuch-tag-flagged ((,class :foreground ,red-alt)))
- `(notmuch-tag-unread ((,class :foreground ,magenta-alt)))
- `(notmuch-tree-match-author-face ((,class :foreground ,fg-special-cold)))
- `(notmuch-tree-match-face ((,class :foreground ,fg-main)))
- `(notmuch-tree-match-tag-face ((,class :inherit bold :foreground ,blue-alt)))
- `(notmuch-tree-no-match-face ((,class :foreground ,fg-alt)))
- `(notmuch-wash-cited-text ((,class :foreground ,cyan)))
- `(notmuch-wash-toggle-button ((,class :background ,bg-alt :foreground ,fg-alt)))
-;;;;; num3-mode
- `(num3-face-even ((,class :inherit bold :background ,bg-alt)))
-;;;;; nxml-mode
- `(nxml-attribute-colon ((,class :foreground ,fg-main)))
- `(nxml-attribute-local-name ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt cyan-alt-faint))))
- `(nxml-attribute-prefix ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-attribute-value ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue blue-faint))))
- `(nxml-cdata-section-CDATA ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt red-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-cdata-section-delimiter ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(nxml-char-ref-delimiter ((,class ,@(modus-vivendi-theme-syntax-foreground
- green-alt-other green-alt-other-faint))))
- `(nxml-char-ref-number ((,class ,@(modus-vivendi-theme-syntax-foreground
- green-alt-other green-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-delimited-data ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(nxml-delimiter ((,class :foreground ,fg-dim)))
- `(nxml-element-colon ((,class :foreground ,fg-main)))
- `(nxml-element-local-name ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(nxml-element-prefix ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-entity-ref-delimiter ((,class ,@(modus-vivendi-theme-syntax-foreground
- green-alt-other green-alt-other-faint))))
- `(nxml-entity-ref-name ((,class ,@(modus-vivendi-theme-syntax-foreground
- green-alt-other green-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-glyph ((,class :inherit modus-theme-intense-neutral)))
- `(nxml-hash ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt blue-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-heading ((,class :inherit bold)))
- `(nxml-name ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-namespace-attribute-colon ((,class :foreground ,fg-main)))
- `(nxml-namespace-attribute-prefix ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint))))
- `(nxml-processing-instruction-target ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-prolog-keyword ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(nxml-ref ((,class ,@(modus-vivendi-theme-syntax-foreground
- green-alt-other green-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
-;;;;; objed
- `(objed-hl ((,class :background ,(if modus-vivendi-theme-intense-hl-line
- bg-hl-alt-intense bg-hl-alt))))
- `(objed-mark ((,class :background ,bg-active)))
- `(objed-mode-line ((,class :foreground ,cyan-active)))
-;;;;; orderless
- `(orderless-match-face-0 ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- blue-alt-other blue-nuanced-bg
- blue-refine-bg blue-refine-fg))))
- `(orderless-match-face-1 ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- magenta-alt magenta-nuanced-bg
- magenta-refine-bg magenta-refine-fg))))
- `(orderless-match-face-2 ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- green green-nuanced-bg
- green-refine-bg green-refine-fg))))
- `(orderless-match-face-3 ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- yellow yellow-nuanced-bg
- yellow-refine-bg yellow-refine-fg))))
-;;;;; org
- `(org-agenda-calendar-event ((,class :foreground ,fg-main)))
- `(org-agenda-calendar-sexp ((,class :foreground ,cyan-alt)))
- `(org-agenda-clocking ((,class :inherit modus-theme-special-cold
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(org-agenda-column-dateline ((,class :background ,bg-alt)))
- `(org-agenda-current-time ((,class :inherit bold :foreground ,blue-alt-other)))
- `(org-agenda-date ((,class :foreground ,cyan)))
- `(org-agenda-date-today ((,class :inherit bold :foreground ,fg-main :underline t)))
- `(org-agenda-date-weekend ((,class :foreground ,cyan-alt-other)))
- `(org-agenda-diary ((,class :foreground ,fg-main)))
- `(org-agenda-dimmed-todo-face ((,class :inherit bold :foreground ,fg-alt)))
- `(org-agenda-done ((,class :foreground ,green-alt)))
- `(org-agenda-filter-category ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-filter-effort ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-filter-regexp ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-filter-tags ((,class :inherit bold :foreground ,magenta-active)))
- `(org-agenda-restriction-lock ((,class :background ,bg-dim :foreground ,fg-dim)))
- `(org-agenda-structure ((,class :foreground ,blue-alt)))
- `(org-archived ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(org-block ((,class ,@(modus-vivendi-theme-mixed-fonts)
- ,@(modus-vivendi-theme-org-block bg-dim)
- :foreground ,fg-main)))
- `(org-block-begin-line ((,class ,@(modus-vivendi-theme-mixed-fonts)
- ,@(modus-vivendi-theme-org-block-delim
- bg-dim fg-special-cold
- bg-alt fg-special-mild))))
- `(org-block-end-line ((,class :inherit org-block-begin-line)))
- `(org-checkbox ((,class :box (:line-width 1 :color ,bg-active)
- :background ,bg-inactive :foreground ,fg-active)))
- `(org-checkbox-statistics-done ((,class :inherit org-done)))
- `(org-checkbox-statistics-todo ((,class :inherit org-todo)))
- `(org-clock-overlay ((,class :inherit modus-theme-special-cold)))
- `(org-code ((,class ,@(modus-vivendi-theme-mixed-fonts) :foreground ,magenta)))
- `(org-column ((,class :background ,bg-alt)))
- `(org-column-title ((,class :inherit bold :underline t :background ,bg-alt)))
- `(org-date ((,class :inherit (button fixed-pitch) :foreground ,cyan-alt-other)))
- `(org-date-selected ((,class :inherit bold :foreground ,blue-alt :inverse-video t)))
- `(org-document-info ((,class :foreground ,fg-special-cold)))
- `(org-document-info-keyword ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,fg-alt)))
- `(org-document-title ((,class :inherit (bold ,modus-theme-variable-pitch) :foreground ,fg-special-cold
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-5))))
- `(org-done ((,class :box ,bg-region :background ,bg-dim :foreground ,green)))
- `(org-drawer ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,cyan)))
- `(org-ellipsis ((,class :foreground nil))) ; inherits from the heading's colour
- `(org-footnote ((,class :inherit button :foreground ,blue-alt)))
- `(org-formula ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,red-alt)))
- `(org-habit-alert-face ((,class :inherit modus-theme-intense-yellow)))
- `(org-habit-alert-future-face ((,class :inherit modus-theme-refine-yellow)))
- `(org-habit-clear-face ((,class :inherit modus-theme-intense-magenta)))
- `(org-habit-clear-future-face ((,class :inherit modus-theme-refine-magenta)))
- `(org-habit-overdue-face ((,class :inherit modus-theme-intense-red)))
- `(org-habit-overdue-future-face ((,class :inherit modus-theme-refine-red)))
- `(org-habit-ready-face ((,class :inherit modus-theme-intense-blue)))
- `(org-habit-ready-future-face ((,class :inherit modus-theme-refine-blue)))
- `(org-headline-done ((,class :inherit ,modus-theme-variable-pitch :foreground ,green-nuanced)))
- `(org-headline-todo ((,class :inherit ,modus-theme-variable-pitch :foreground ,red-nuanced)))
- `(org-hide ((,class :foreground ,bg-main)))
- `(org-indent ((,class :inherit (fixed-pitch org-hide))))
- `(org-latex-and-related ((,class :foreground ,magenta-refine-fg)))
- `(org-level-1 ((,class :inherit modus-theme-heading-1)))
- `(org-level-2 ((,class :inherit modus-theme-heading-2)))
- `(org-level-3 ((,class :inherit modus-theme-heading-3)))
- `(org-level-4 ((,class :inherit modus-theme-heading-4)))
- `(org-level-5 ((,class :inherit modus-theme-heading-5)))
- `(org-level-6 ((,class :inherit modus-theme-heading-6)))
- `(org-level-7 ((,class :inherit modus-theme-heading-7)))
- `(org-level-8 ((,class :inherit modus-theme-heading-8)))
- `(org-link ((,class :inherit link)))
- `(org-list-dt ((,class :inherit bold)))
- `(org-macro ((,class :background ,blue-nuanced-bg :foreground ,magenta-alt-other)))
- `(org-meta-line ((,class ,@(modus-vivendi-theme-mixed-fonts) :foreground ,fg-alt)))
- `(org-mode-line-clock ((,class :foreground ,fg-main)))
- `(org-mode-line-clock-overrun ((,class :inherit modus-theme-active-red)))
- `(org-priority ((,class :box ,bg-region :background ,bg-dim :foreground ,magenta)))
- `(org-property-value ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,cyan-alt-other)))
- `(org-quote ((,class ,@(modus-vivendi-theme-org-block bg-dim)
- :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(org-scheduled ((,class :foreground ,fg-special-warm)))
- `(org-scheduled-previously ((,class :foreground ,yellow-alt-other)))
- `(org-scheduled-today ((,class :foreground ,magenta-alt-other)))
- `(org-sexp-date ((,class :inherit org-date)))
- `(org-special-keyword ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,blue-nuanced)))
- `(org-table ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :foreground ,fg-special-cold)))
- `(org-table-header ((,class :inherit (fixed-pitch modus-theme-intense-neutral))))
- `(org-tag ((,class :foreground ,magenta-nuanced)))
- `(org-tag-group ((,class :inherit bold :foreground ,cyan-nuanced)))
- `(org-target ((,class :underline t)))
- `(org-time-grid ((,class :foreground ,fg-unfocused)))
- `(org-todo ((,class :box ,bg-region :background ,bg-dim :foreground ,red-alt)))
- `(org-upcoming-deadline ((,class :foreground ,red-alt-other)))
- `(org-upcoming-distant-deadline ((,class :foreground ,red-nuanced)))
- `(org-verbatim ((,class ,@(modus-vivendi-theme-mixed-fonts)
- :background ,bg-alt :foreground ,fg-special-calm)))
- `(org-verse ((,class :inherit org-quote)))
- `(org-warning ((,class :inherit bold :foreground ,red-alt-other)))
-;;;;; org-journal
- `(org-journal-calendar-entry-face ((,class :foreground ,yellow-alt-other :slant ,modus-theme-slant)))
- `(org-journal-calendar-scheduled-face ((,class :foreground ,red-alt-other :slant ,modus-theme-slant)))
- `(org-journal-highlight ((,class :foreground ,magenta-alt)))
-;;;;; org-noter
- `(org-noter-no-notes-exist-face ((,class :inherit bold :foreground ,red-active)))
- `(org-noter-notes-exist-face ((,class :inherit bold :foreground ,green-active)))
-;;;;; org-pomodoro
- `(org-pomodoro-mode-line ((,class :foreground ,red-active)))
- `(org-pomodoro-mode-line-break ((,class :foreground ,cyan-active)))
- `(org-pomodoro-mode-line-overtime ((,class :inherit bold :foreground ,red-active)))
-;;;;; org-recur
- `(org-recur ((,class :foreground ,magenta-active)))
-;;;;; org-roam
- `(org-roam-link ((,class :inherit button :foreground ,green)))
- `(org-roam-link-current ((,class :inherit button :foreground ,green-alt)))
- `(org-roam-link-invalid ((,class :inherit button :foreground ,red)))
- `(org-roam-link-shielded ((,class :inherit button :foreground ,yellow)))
- `(org-roam-tag ((,class :foreground ,fg-alt :slant italic)))
-;;;;; org-superstar
- `(org-superstar-item ((,class :foreground ,fg-main)))
- `(org-superstar-leading ((,class :foreground ,fg-whitespace)))
-;;;;; org-table-sticky-header
- `(org-table-sticky-header-face ((,class :inherit modus-theme-intense-neutral)))
-;;;;; org-treescope
- `(org-treescope-faces--markerinternal-midday ((,class :inherit modus-theme-intense-blue)))
- `(org-treescope-faces--markerinternal-range ((,class :inherit modus-theme-special-mild)))
-;;;;; origami
- `(origami-fold-header-face ((,class :background ,bg-dim :foreground ,fg-dim :box t)))
- `(origami-fold-replacement-face ((,class :background ,bg-alt :foreground ,fg-alt)))
-;;;;; outline-mode
- `(outline-1 ((,class :inherit modus-theme-heading-1)))
- `(outline-2 ((,class :inherit modus-theme-heading-2)))
- `(outline-3 ((,class :inherit modus-theme-heading-3)))
- `(outline-4 ((,class :inherit modus-theme-heading-4)))
- `(outline-5 ((,class :inherit modus-theme-heading-5)))
- `(outline-6 ((,class :inherit modus-theme-heading-6)))
- `(outline-7 ((,class :inherit modus-theme-heading-7)))
- `(outline-8 ((,class :inherit modus-theme-heading-8)))
-;;;;; outline-minor-faces
- `(outline-minor-0 ((,class nil)))
-;;;;; package (M-x list-packages)
- `(package-description ((,class :foreground ,fg-special-cold)))
- `(package-help-section-name ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(package-name ((,class :inherit link)))
- `(package-status-avail-obso ((,class :inherit bold :foreground ,red)))
- `(package-status-available ((,class :foreground ,fg-special-mild)))
- `(package-status-built-in ((,class :foreground ,magenta)))
- `(package-status-dependency ((,class :foreground ,magenta-alt-other)))
- `(package-status-disabled ((,class :inherit modus-theme-subtle-red)))
- `(package-status-external ((,class :foreground ,cyan-alt-other)))
- `(package-status-held ((,class :foreground ,yellow-alt)))
- `(package-status-incompat ((,class :inherit bold :foreground ,yellow)))
- `(package-status-installed ((,class :foreground ,fg-special-warm)))
- `(package-status-new ((,class :inherit bold :foreground ,green)))
- `(package-status-unsigned ((,class :inherit bold :foreground ,red-alt)))
-;;;;; page-break-lines
- `(page-break-lines ((,class :inherit default :foreground ,fg-window-divider-outer)))
-;;;;; paradox
- `(paradox-archive-face ((,class :foreground ,fg-special-mild)))
- `(paradox-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(paradox-commit-tag-face ((,class :inherit modus-theme-refine-magenta :box t)))
- `(paradox-description-face ((,class :foreground ,fg-special-cold)))
- `(paradox-description-face-multiline ((,class :foreground ,fg-special-cold)))
- `(paradox-download-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,blue-alt-other)))
- `(paradox-highlight-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,cyan-alt-other)))
- `(paradox-homepage-button-face ((,class :foreground ,magenta-alt-other :underline t)))
- `(paradox-mode-line-face ((,class :inherit bold :foreground ,cyan-active)))
- `(paradox-name-face ((,class :foreground ,blue :underline t)))
- `(paradox-star-face ((,class :foreground ,magenta)))
- `(paradox-starred-face ((,class :foreground ,magenta-alt)))
-;;;;; paren-face
- `(parenthesis ((,class :foreground ,fg-unfocused)))
-;;;;; parrot
- `(parrot-rotate-rotation-highlight-face ((,class :inherit modus-theme-refine-magenta)))
-;;;;; pass
- `(pass-mode-directory-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(pass-mode-entry-face ((,class :background ,bg-main :foreground ,fg-main)))
- `(pass-mode-header-face ((,class :foreground ,fg-special-warm)))
-;;;;; persp-mode
- `(persp-face-lighter-buffer-not-in-persp ((,class :inherit modus-theme-intense-red)))
- `(persp-face-lighter-default ((,class :inherit bold :foreground ,blue-active)))
- `(persp-face-lighter-nil-persp ((,class :inherit bold :foreground ,fg-active)))
-;;;;; perspective
- `(persp-selected-face ((,class :inherit bold :foreground ,blue-active)))
-;;;;; phi-grep
- `(phi-grep-heading-face ((,class :inherit bold :foreground ,red-alt
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(phi-grep-line-number-face ((,class :foreground ,fg-special-warm)))
- `(phi-grep-match-face ((,class :inherit modus-theme-special-calm)))
- `(phi-grep-modified-face ((,class :inherit modus-theme-refine-yellow)))
- `(phi-grep-overlay-face ((,class :inherit modus-theme-refine-blue)))
-;;;;; phi-search
- `(phi-replace-preview-face ((,class :inherit modus-theme-intense-magenta)))
- `(phi-search-failpart-face ((,class :inherit modus-theme-refine-red)))
- `(phi-search-match-face ((,class :inherit modus-theme-refine-cyan)))
- `(phi-search-selection-face ((,class :inherit (modus-theme-intense-green bold))))
-;;;;; pkgbuild-mode
- `(pkgbuild-error-face ((,class :underline ,fg-lang-error)))
-;;;;; pomidor
- `(pomidor-break-face ((,class :foreground ,blue-alt-other)))
- `(pomidor-overwork-face ((,class :foreground ,red-alt-other)))
- `(pomidor-skip-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(pomidor-work-face ((,class :foreground ,green-alt-other)))
-;;;;; powerline
- `(powerline-active0 ((,class :background ,bg-main :foreground ,blue-faint :inverse-video t)))
- `(powerline-active1 ((,class :background ,blue-nuanced-bg :foreground ,blue-nuanced)))
- `(powerline-active2 ((,class :background ,bg-active :foreground ,fg-active)))
- `(powerline-inactive0 ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
- `(powerline-inactive1 ((,class :background ,bg-dim :foreground ,fg-inactive)))
- `(powerline-inactive2 ((,class :background ,bg-inactive :foreground ,fg-inactive)))
-;;;;; powerline-evil
- `(powerline-evil-base-face ((,class :background ,fg-main :foreground ,bg-main)))
- `(powerline-evil-emacs-face ((,class :inherit modus-theme-active-magenta)))
- `(powerline-evil-insert-face ((,class :inherit modus-theme-active-green)))
- `(powerline-evil-motion-face ((,class :inherit modus-theme-active-blue)))
- `(powerline-evil-normal-face ((,class :background ,fg-alt :foreground ,bg-main)))
- `(powerline-evil-operator-face ((,class :inherit modus-theme-active-yellow)))
- `(powerline-evil-replace-face ((,class :inherit modus-theme-active-red)))
- `(powerline-evil-visual-face ((,class :inherit modus-theme-active-cyan)))
-;;;;; proced
- `(proced-mark ((,class :inherit modus-theme-mark-symbol)))
- `(proced-marked ((,class :inherit modus-theme-mark-alt)))
- `(proced-sort-header ((,class :inherit bold :foreground ,fg-special-calm :underline t)))
-;;;;; prodigy
- `(prodigy-green-face ((,class :foreground ,green)))
- `(prodigy-red-face ((,class :foreground ,red)))
- `(prodigy-yellow-face ((,class :foreground ,yellow)))
-;;;;; racket-mode
- `(racket-debug-break-face ((,class :inherit modus-theme-intense-red)))
- `(racket-debug-locals-face ((,class :box (:line-width -1 :color nil)
- :foreground ,green-alt-other)))
- `(racket-debug-result-face ((,class :inherit bold :box (:line-width -1 :color nil)
- :foreground ,green)))
- `(racket-here-string-face ((,class :foreground ,blue-alt)))
- `(racket-keyword-argument-face ((,class :foreground ,red-alt)))
- `(racket-logger-config-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(racket-logger-debug-face ((,class :foreground ,blue-alt-other)))
- `(racket-logger-info-face ((,class :foreground ,fg-lang-note)))
- `(racket-logger-topic-face ((,class :foreground ,magenta :slant ,modus-theme-slant)))
- `(racket-selfeval-face ((,class :foreground ,green-alt)))
- `(racket-xp-error-face
- ((,(append '((supports :underline (:style wave))) class)
- :underline (:color ,fg-lang-error :style wave))
- (,class :foreground ,fg-lang-error :underline t)))
-;;;;; rainbow-blocks
- `(rainbow-blocks-depth-1-face ((,class :foreground ,magenta-alt-other)))
- `(rainbow-blocks-depth-2-face ((,class :foreground ,blue)))
- `(rainbow-blocks-depth-3-face ((,class :foreground ,magenta-alt)))
- `(rainbow-blocks-depth-4-face ((,class :foreground ,green)))
- `(rainbow-blocks-depth-5-face ((,class :foreground ,magenta)))
- `(rainbow-blocks-depth-6-face ((,class :foreground ,cyan)))
- `(rainbow-blocks-depth-7-face ((,class :foreground ,yellow)))
- `(rainbow-blocks-depth-8-face ((,class :foreground ,cyan-alt)))
- `(rainbow-blocks-depth-9-face ((,class :foreground ,red-alt)))
- `(rainbow-blocks-unmatched-face ((,class :foreground ,red)))
-;;;;; rainbow-identifiers
- `(rainbow-identifiers-identifier-1 ((,class :foreground ,green-alt-other)))
- `(rainbow-identifiers-identifier-2 ((,class :foreground ,magenta-alt-other)))
- `(rainbow-identifiers-identifier-3 ((,class :foreground ,cyan-alt-other)))
- `(rainbow-identifiers-identifier-4 ((,class :foreground ,yellow-alt-other)))
- `(rainbow-identifiers-identifier-5 ((,class :foreground ,blue-alt-other)))
- `(rainbow-identifiers-identifier-6 ((,class :foreground ,green-alt)))
- `(rainbow-identifiers-identifier-7 ((,class :foreground ,magenta-alt)))
- `(rainbow-identifiers-identifier-8 ((,class :foreground ,cyan-alt)))
- `(rainbow-identifiers-identifier-9 ((,class :foreground ,yellow-alt)))
- `(rainbow-identifiers-identifier-10 ((,class :foreground ,green)))
- `(rainbow-identifiers-identifier-11 ((,class :foreground ,magenta)))
- `(rainbow-identifiers-identifier-12 ((,class :foreground ,cyan)))
- `(rainbow-identifiers-identifier-13 ((,class :foreground ,yellow)))
- `(rainbow-identifiers-identifier-14 ((,class :foreground ,blue-alt)))
- `(rainbow-identifiers-identifier-15 ((,class :foreground ,red-alt)))
-;;;;; rainbow-delimiters
- `(rainbow-delimiters-base-face-error ((,class :foreground ,red)))
- `(rainbow-delimiters-base-face ((,class :foreground ,fg-main)))
- `(rainbow-delimiters-depth-1-face ((,class :foreground ,green-alt-other)))
- `(rainbow-delimiters-depth-2-face ((,class :foreground ,magenta-alt-other)))
- `(rainbow-delimiters-depth-3-face ((,class :foreground ,cyan-alt-other)))
- `(rainbow-delimiters-depth-4-face ((,class :foreground ,yellow-alt-other)))
- `(rainbow-delimiters-depth-5-face ((,class :foreground ,blue-alt-other)))
- `(rainbow-delimiters-depth-6-face ((,class :foreground ,green-alt)))
- `(rainbow-delimiters-depth-7-face ((,class :foreground ,magenta-alt)))
- `(rainbow-delimiters-depth-8-face ((,class :foreground ,cyan-alt)))
- `(rainbow-delimiters-depth-9-face ((,class :foreground ,yellow-alt)))
- `(rainbow-delimiters-mismatched-face ((,class :inherit bold :foreground ,red-alt)))
- `(rainbow-delimiters-unmatched-face ((,class :inherit bold :foreground ,red)))
-;;;;; rcirc
- `(rcirc-bright-nick ((,class :inherit bold :foreground ,magenta-alt)))
- `(rcirc-dim-nick ((,class :foreground ,fg-alt)))
- `(rcirc-my-nick ((,class :inherit bold :foreground ,magenta)))
- `(rcirc-nick-in-message ((,class :foreground ,magenta-alt-other)))
- `(rcirc-nick-in-message-full-line ((,class :inherit bold :foreground ,fg-special-mild)))
- `(rcirc-other-nick ((,class :inherit bold :foreground ,fg-special-cold)))
- `(rcirc-prompt ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(rcirc-server ((,class :foreground ,fg-unfocused)))
- `(rcirc-timestamp ((,class :foreground ,blue-nuanced)))
- `(rcirc-url ((,class :foreground ,blue :underline t)))
-;;;;; regexp-builder (re-builder)
- `(reb-match-0 ((,class :inherit modus-theme-intense-blue)))
- `(reb-match-1 ((,class :inherit modus-theme-intense-magenta)))
- `(reb-match-2 ((,class :inherit modus-theme-intense-green)))
- `(reb-match-3 ((,class :inherit modus-theme-intense-red)))
- `(reb-regexp-grouping-backslash ((,class :inherit bold :foreground ,fg-escape-char-backslash)))
- `(reb-regexp-grouping-construct ((,class :inherit bold :foreground ,fg-escape-char-construct)))
-;;;;; rg (rg.el)
- `(rg-column-number-face ((,class :foreground ,magenta-alt-other)))
- `(rg-context-face ((,class :foreground ,fg-unfocused)))
- `(rg-error-face ((,class :inherit bold :foreground ,red)))
- `(rg-file-tag-face ((,class :foreground ,fg-special-cold)))
- `(rg-filename-face ((,class :inherit bold :foreground ,fg-special-cold)))
- `(rg-line-number-face ((,class :foreground ,fg-special-warm)))
- `(rg-literal-face ((,class :foreground ,blue-alt)))
- `(rg-match-face ((,class :inherit modus-theme-special-calm)))
- `(rg-regexp-face ((,class :foreground ,magenta-active)))
- `(rg-toggle-off-face ((,class :inherit bold :foreground ,fg-inactive)))
- `(rg-toggle-on-face ((,class :inherit bold :foreground ,cyan-active)))
- `(rg-warning-face ((,class :inherit bold :foreground ,yellow)))
-;;;;; ripgrep
- `(ripgrep-context-face ((,class :foreground ,fg-unfocused)))
- `(ripgrep-error-face ((,class :inherit bold :foreground ,red)))
- `(ripgrep-hit-face ((,class :foreground ,cyan)))
- `(ripgrep-match-face ((,class :inherit modus-theme-special-calm)))
-;;;;; rmail
- `(rmail-header-name ((,class :foreground ,cyan-alt-other)))
- `(rmail-highlight ((,class :inherit bold :foreground ,magenta-alt)))
-;;;;; ruler-mode
- `(ruler-mode-column-number ((,class :inherit (ruler-mode-default bold) :foreground ,fg-main)))
- `(ruler-mode-comment-column ((,class :inherit ruler-mode-default :foreground ,red-active)))
- `(ruler-mode-current-column ((,class :inherit ruler-mode-default :foreground ,cyan-active :box t)))
- `(ruler-mode-default ((,class :background ,bg-inactive :foreground ,fg-inactive)))
- `(ruler-mode-fill-column ((,class :inherit ruler-mode-default :foreground ,green-active)))
- `(ruler-mode-fringes ((,class :inherit ruler-mode-default :foreground ,blue-active)))
- `(ruler-mode-goal-column ((,class :inherit ruler-mode-default :foreground ,magenta-active)))
- `(ruler-mode-margins ((,class :inherit ruler-mode-default :foreground ,bg-main)))
- `(ruler-mode-pad ((,class :background ,bg-active :foreground ,fg-inactive)))
- `(ruler-mode-tab-stop ((,class :inherit ruler-mode-default :foreground ,yellow-active)))
-;;;;; sallet
- `(sallet-buffer-compressed ((,class :foreground ,yellow-nuanced :slant italic)))
- `(sallet-buffer-default-directory ((,class :foreground ,cyan-nuanced)))
- `(sallet-buffer-directory ((,class :foreground ,blue-nuanced)))
- `(sallet-buffer-help ((,class :foreground ,fg-special-cold)))
- `(sallet-buffer-modified ((,class :foreground ,yellow-alt-other :slant italic)))
- `(sallet-buffer-ordinary ((,class :foreground ,fg-main)))
- `(sallet-buffer-read-only ((,class :foreground ,yellow-alt)))
- `(sallet-buffer-size ((,class :foreground ,fg-special-calm)))
- `(sallet-buffer-special ((,class :foreground ,magenta-alt-other)))
- `(sallet-flx-match ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-cyan
- 'modus-theme-refine-cyan
- 'modus-theme-nuanced-cyan
- cyan-alt-other))))
- `(sallet-recentf-buffer-name ((,class :foreground ,blue-nuanced)))
- `(sallet-recentf-file-path ((,class :foreground ,fg-special-mild)))
- `(sallet-regexp-match ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-magenta
- 'modus-theme-refine-magenta
- 'modus-theme-nuanced-magenta
- magenta-alt-other))))
- `(sallet-source-header ((,class :inherit bold :foreground ,red-alt
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(sallet-substring-match ((,class ,@(modus-vivendi-theme-extra-completions
- 'modus-theme-subtle-blue
- 'modus-theme-refine-blue
- 'modus-theme-nuanced-blue
- blue-alt-other))))
-;;;;; selectrum
- `(selectrum-current-candidate
- ((,class :inherit bold :foreground ,fg-main :underline ,fg-main
- :background ,@(pcase modus-vivendi-theme-completions
- ('opinionated (list bg-active))
- (_ (list bg-inactive))))))
- `(selectrum-primary-highlight ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- magenta-alt magenta-nuanced-bg
- magenta-refine-bg magenta-refine-fg))))
- `(selectrum-secondary-highlight ((,class :inherit bold
- ,@(modus-vivendi-theme-standard-completions
- cyan-alt-other cyan-nuanced-bg
- cyan-refine-bg cyan-refine-fg))))
-;;;;; semantic
- `(semantic-complete-inline-face ((,class :foreground ,fg-special-warm :underline t)))
- `(semantic-decoration-on-private-members-face ((,class :inherit modus-theme-refine-cyan)))
- `(semantic-decoration-on-protected-members-face ((,class :background ,bg-dim)))
- `(semantic-highlight-edits-face ((,class :background ,bg-alt)))
- `(semantic-highlight-func-current-tag-face ((,class :background ,bg-alt)))
- `(semantic-idle-symbol-highlight ((,class :inherit modus-theme-special-mild)))
- `(semantic-tag-boundary-face ((,class :overline ,blue-intense)))
- `(semantic-unmatched-syntax-face ((,class :underline ,fg-lang-error)))
-;;;;; sesman
- `(sesman-browser-button-face ((,class :foreground ,blue-alt-other :underline t)))
- `(sesman-browser-highligh-face ((,class :inherit modus-theme-subtle-blue)))
- `(sesman-buffer-face ((,class :foreground ,magenta)))
- `(sesman-directory-face ((,class :inherit bold :foreground ,blue)))
- `(sesman-project-face ((,class :inherit bold :foreground ,magenta-alt-other)))
-;;;;; shell-script-mode
- `(sh-heredoc ((,class :foreground ,blue-alt)))
- `(sh-quoted-exec ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt)))
-;;;;; show-paren-mode
- `(show-paren-match ((,class ,@(modus-vivendi-theme-paren bg-paren-match
- bg-paren-match-intense)
- :foreground ,fg-main)))
- `(show-paren-match-expression ((,class :inherit modus-theme-special-calm)))
- `(show-paren-mismatch ((,class :inherit modus-theme-intense-red)))
-;;;;; side-notes
- `(side-notes ((,class :background ,bg-dim :foreground ,fg-dim)))
-;;;;; skewer-mode
- `(skewer-error-face ((,class :foreground ,red :underline t)))
-;;;;; smart-mode-line
- `(sml/charging ((,class :foreground ,green-active)))
- `(sml/discharging ((,class :foreground ,red-active)))
- `(sml/filename ((,class :inherit bold :foreground ,blue-active)))
- `(sml/folder ((,class :foreground ,fg-active)))
- `(sml/git ((,class :inherit bold :foreground ,green-active)))
- `(sml/global ((,class :foreground ,fg-active)))
- `(sml/line-number ((,class :inherit sml/global)))
- `(sml/minor-modes ((,class :inherit sml/global)))
- `(sml/modes ((,class :inherit bold :foreground ,fg-active)))
- `(sml/modified ((,class :inherit bold :foreground ,magenta-active)))
- `(sml/mule-info ((,class :inherit sml/global)))
- `(sml/name-filling ((,class :foreground ,yellow-active)))
- `(sml/not-modified ((,class :inherit sml/global)))
- `(sml/numbers-separator ((,class :inherit sml/global)))
- `(sml/outside-modified ((,class :inherit modus-theme-intense-red)))
- `(sml/position-percentage ((,class :inherit sml/global)))
- `(sml/prefix ((,class :foreground ,green-active)))
- `(sml/process ((,class :inherit sml/prefix)))
- `(sml/projectile ((,class :inherit sml/git)))
- `(sml/read-only ((,class :inherit bold :foreground ,cyan-active)))
- `(sml/remote ((,class :inherit sml/global)))
- `(sml/sudo ((,class :inherit modus-theme-subtle-red)))
- `(sml/time ((,class :inherit sml/global)))
- `(sml/vc ((,class :inherit sml/git)))
- `(sml/vc-edited ((,class :inherit bold :foreground ,yellow-active)))
-;;;;; smartparens
- `(sp-pair-overlay-face ((,class :inherit modus-theme-special-warm)))
- `(sp-show-pair-enclosing ((,class :inherit modus-theme-special-mild)))
- `(sp-show-pair-match-face ((,class ,@(modus-vivendi-theme-paren bg-paren-match
- bg-paren-match-intense)
- :foreground ,fg-main)))
- `(sp-show-pair-mismatch-face ((,class :inherit modus-theme-intense-red)))
- `(sp-wrap-overlay-closing-pair ((,class :inherit sp-pair-overlay-face)))
- `(sp-wrap-overlay-face ((,class :inherit sp-pair-overlay-face)))
- `(sp-wrap-overlay-opening-pair ((,class :inherit sp-pair-overlay-face)))
- `(sp-wrap-tag-overlay-face ((,class :inherit sp-pair-overlay-face)))
-;;;;; smerge
- `(smerge-base ((,class :inherit modus-theme-diff-changed)))
- `(smerge-lower ((,class :inherit modus-theme-diff-added)))
- `(smerge-markers ((,class :background ,bg-diff-neutral-2 :foreground ,fg-diff-neutral-2)))
- `(smerge-refined-added ((,class :inherit modus-theme-diff-refine-added)))
- `(smerge-refined-changed ((,class)))
- `(smerge-refined-removed ((,class :inherit modus-theme-diff-refine-removed)))
- `(smerge-upper ((,class :inherit modus-theme-diff-removed)))
-;;;;; spaceline
- `(spaceline-evil-emacs ((,class :inherit modus-theme-active-magenta)))
- `(spaceline-evil-insert ((,class :inherit modus-theme-active-green)))
- `(spaceline-evil-motion ((,class :inherit modus-theme-active-blue)))
- `(spaceline-evil-normal ((,class :background ,fg-alt :foreground ,bg-alt)))
- `(spaceline-evil-replace ((,class :inherit modus-theme-active-red)))
- `(spaceline-evil-visual ((,class :inherit modus-theme-active-cyan)))
- `(spaceline-flycheck-error ((,class :foreground ,red-active)))
- `(spaceline-flycheck-info ((,class :foreground ,cyan-active)))
- `(spaceline-flycheck-warning ((,class :foreground ,yellow-active)))
- `(spaceline-highlight-face ((,class :inherit modus-theme-fringe-blue)))
- `(spaceline-modified ((,class :inherit modus-theme-fringe-magenta)))
- `(spaceline-python-venv ((,class :foreground ,magenta-active)))
- `(spaceline-read-only ((,class :inherit modus-theme-fringe-red)))
- `(spaceline-unmodified ((,class :inherit modus-theme-fringe-cyan)))
-;;;;; speedbar
- `(speedbar-button-face ((,class :inherit link)))
- `(speedbar-directory-face ((,class :inherit bold :foreground ,blue)))
- `(speedbar-file-face ((,class :foreground ,fg-main)))
- `(speedbar-highlight-face ((,class :inherit modus-theme-subtle-blue)))
- `(speedbar-selected-face ((,class :inherit bold :foreground ,cyan)))
- `(speedbar-separator-face ((,class :inherit modus-theme-intense-neutral)))
- `(speedbar-tag-face ((,class :foreground ,yellow-alt-other)))
-;;;;; spell-fu
- `(spell-fu-incorrect-face
- ((,(append '((supports :underline (:style wave))) class)
- :foreground ,fg-lang-error :underline (:style wave))
- (,class :foreground ,fg-lang-error :underline t)))
-;;;;; stripes
- `(stripes ((,class :inherit modus-theme-hl-line)))
-;;;;; success
- `(suggest-heading ((,class :inherit bold :foreground ,yellow-alt-other)))
-;;;;; switch-window
- `(switch-window-background ((,class :background ,bg-dim)))
- `(switch-window-label ((,class :height 3.0 :foreground ,blue-intense)))
-;;;;; swiper
- `(swiper-background-match-face-1 ((,class :inherit modus-theme-subtle-neutral)))
- `(swiper-background-match-face-2 ((,class :inherit modus-theme-subtle-cyan)))
- `(swiper-background-match-face-3 ((,class :inherit modus-theme-subtle-magenta)))
- `(swiper-background-match-face-4 ((,class :inherit modus-theme-subtle-green)))
- `(swiper-line-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :inherit modus-theme-special-cold)))
- `(swiper-match-face-1 ((,class :inherit swiper-line-face)))
- `(swiper-match-face-2 ((,class :inherit swiper-line-face)))
- `(swiper-match-face-3 ((,class :inherit swiper-line-face)))
- `(swiper-match-face-4 ((,class :inherit swiper-line-face)))
-;;;;; swoop
- `(swoop-face-header-format-line ((,class :inherit bold :foreground ,red-alt
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-3))))
- `(swoop-face-line-buffer-name ((,class :inherit bold :foreground ,blue-alt
- ,@(modus-vivendi-theme-scale modus-vivendi-theme-scale-4))))
- `(swoop-face-line-number ((,class :foreground ,fg-special-warm)))
- `(swoop-face-target-line ((,class :inherit modus-theme-intense-blue
- ,@(and (>= emacs-major-version 27) '(:extend t)))))
- `(swoop-face-target-words ((,class :inherit modus-theme-refine-cyan)))
-;;;;; sx
- `(sx-inbox-item-type ((,class :foreground ,magenta-alt-other)))
- `(sx-inbox-item-type-unread ((,class :inherit (sx-inbox-item-type bold))))
- `(sx-question-list-answers ((,class :foreground ,green)))
- `(sx-question-list-answers-accepted ((,class :box t :foreground ,green)))
- `(sx-question-list-bounty ((,class :inherit bold :background ,bg-alt :foreground ,yellow)))
- `(sx-question-list-date ((,class :foreground ,fg-special-cold)))
- `(sx-question-list-favorite ((,class :inherit bold :foreground ,fg-special-warm)))
- `(sx-question-list-parent ((,class :foreground ,fg-main)))
- `(sx-question-list-read-question ((,class :foreground ,fg-alt)))
- `(sx-question-list-score ((,class :foreground ,fg-special-mild)))
- `(sx-question-list-score-upvoted ((,class :inherit (sx-question-list-score bold))))
- `(sx-question-list-unread-question ((,class :inherit bold :foreground ,fg-main)))
- `(sx-question-mode-accepted ((,class :inherit bold :height 1.3 :foreground ,green)))
- `(sx-question-mode-closed ((,class :inherit modus-theme-active-yellow :box (:line-width 2 :color nil))))
- `(sx-question-mode-closed-reason ((,class :box (:line-width 2 :color nil) :foreground ,fg-main)))
- `(sx-question-mode-content-face ((,class :background ,bg-dim)))
- `(sx-question-mode-date ((,class :foreground ,blue)))
- `(sx-question-mode-header ((,class :inherit bold :foreground ,cyan)))
- `(sx-question-mode-kbd-tag ((,class :inherit bold :height 0.9 :box (:line-width 3 :color ,fg-main :style released-button) :foreground ,fg-main)))
- `(sx-question-mode-score ((,class :foreground ,fg-dim)))
- `(sx-question-mode-score-downvoted ((,class :foreground ,yellow)))
- `(sx-question-mode-score-upvoted ((,class :inherit bold :foreground ,magenta)))
- `(sx-question-mode-title ((,class :inherit bold :foreground ,fg-main)))
- `(sx-question-mode-title-comments ((,class :inherit bold :foreground ,fg-alt)))
- `(sx-tag ((,class :foreground ,magenta-alt)))
- `(sx-user-name ((,class :foreground ,blue-alt)))
- `(sx-user-reputation ((,class :foreground ,fg-alt)))
-;;;;; symbol-overlay
- `(symbol-overlay-default-face ((,class :inherit modus-theme-special-warm)))
- `(symbol-overlay-face-1 ((,class :inherit modus-theme-intense-blue)))
- `(symbol-overlay-face-2 ((,class :inherit modus-theme-refine-magenta)))
- `(symbol-overlay-face-3 ((,class :inherit modus-theme-intense-yellow)))
- `(symbol-overlay-face-4 ((,class :inherit modus-theme-intense-magenta)))
- `(symbol-overlay-face-5 ((,class :inherit modus-theme-intense-red)))
- `(symbol-overlay-face-6 ((,class :inherit modus-theme-refine-red)))
- `(symbol-overlay-face-7 ((,class :inherit modus-theme-intense-cyan)))
- `(symbol-overlay-face-8 ((,class :inherit modus-theme-refine-cyan)))
-;;;;; syslog-mode
- `(syslog-debug ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(syslog-error ((,class :inherit bold :foreground ,red)))
- `(syslog-file ((,class :inherit bold :foreground ,fg-special-cold)))
- `(syslog-hide ((,class :background ,bg-main :foreground ,fg-main)))
- `(syslog-hour ((,class :inherit bold :foreground ,magenta-alt-other)))
- `(syslog-info ((,class :inherit bold :foreground ,blue-alt-other)))
- `(syslog-ip ((,class :inherit bold :foreground ,fg-special-mild :underline t)))
- `(syslog-su ((,class :inherit bold :foreground ,red-alt)))
- `(syslog-warn ((,class :inherit bold :foreground ,yellow)))
-;;;;; table (built-in table.el)
- `(table-cell ((,class :background ,blue-nuanced-bg)))
-;;;;; telephone-line
- `(telephone-line-accent-active ((,class :background ,fg-inactive :foreground ,bg-inactive)))
- `(telephone-line-accent-inactive ((,class :background ,bg-active :foreground ,fg-active)))
- `(telephone-line-error ((,class :inherit bold :foreground ,red-active)))
- `(telephone-line-evil ((,class :foreground ,fg-main)))
- `(telephone-line-evil-emacs ((,class :inherit telephone-line-evil :background ,magenta-intense-bg)))
- `(telephone-line-evil-insert ((,class :inherit telephone-line-evil :background ,green-intense-bg)))
- `(telephone-line-evil-motion ((,class :inherit telephone-line-evil :background ,yellow-intense-bg)))
- `(telephone-line-evil-normal ((,class :inherit telephone-line-evil :background ,bg-alt)))
- `(telephone-line-evil-operator ((,class :inherit telephone-line-evil :background ,yellow-subtle-bg)))
- `(telephone-line-evil-replace ((,class :inherit telephone-line-evil :background ,red-intense-bg)))
- `(telephone-line-evil-visual ((,class :inherit telephone-line-evil :background ,cyan-intense-bg)))
- `(telephone-line-projectile ((,class :foreground ,cyan-active)))
- `(telephone-line-unimportant ((,class :foreground ,fg-inactive)))
- `(telephone-line-warning ((,class :inherit bold :foreground ,yellow-active)))
-;;;;; term
- `(term ((,class :background ,bg-main :foreground ,fg-main)))
- `(term-bold ((,class :inherit bold)))
- `(term-color-blue ((,class :background ,blue :foreground ,blue)))
- `(term-color-cyan ((,class :background ,cyan :foreground ,cyan)))
- `(term-color-green ((,class :background ,green :foreground ,green)))
- `(term-color-magenta ((,class :background ,magenta :foreground ,magenta)))
- `(term-color-red ((,class :background ,red :foreground ,red)))
- `(term-color-yellow ((,class :background ,yellow :foreground ,yellow)))
- `(term-underline ((,class :underline t)))
-;;;;; tomatinho
- `(tomatinho-ok-face ((,class :foreground ,blue-intense)))
- `(tomatinho-pause-face ((,class :foreground ,yellow-intense)))
- `(tomatinho-reset-face ((,class :foreground ,fg-alt)))
-;;;;; transient
- `(transient-active-infix ((,class :inherit modus-theme-special-mild)))
- `(transient-amaranth ((,class :inherit bold :foreground ,yellow)))
- `(transient-argument ((,class :inherit bold :foreground ,red-alt)))
- `(transient-blue ((,class :inherit bold :foreground ,blue)))
- `(transient-disabled-suffix ((,class :inherit modus-theme-intense-red)))
- `(transient-enabled-suffix ((,class :inherit modus-theme-intense-green)))
- `(transient-heading ((,class :inherit bold :foreground ,fg-main)))
- `(transient-inactive-argument ((,class :foreground ,fg-alt)))
- `(transient-inactive-value ((,class :foreground ,fg-alt)))
- `(transient-key ((,class :inherit bold :foreground ,blue)))
- `(transient-mismatched-key ((,class :underline t)))
- `(transient-nonstandard-key ((,class :underline t)))
- `(transient-pink ((,class :inherit bold :foreground ,magenta)))
- `(transient-red ((,class :inherit bold :foreground ,red-intense)))
- `(transient-teal ((,class :inherit bold :foreground ,cyan-alt-other)))
- `(transient-unreachable ((,class :foreground ,fg-unfocused)))
- `(transient-unreachable-key ((,class :foreground ,fg-unfocused)))
- `(transient-value ((,class :foreground ,magenta-alt)))
-;;;;; trashed
- `(trashed-deleted ((,class :inherit modus-theme-mark-del)))
- `(trashed-directory ((,class :foreground ,blue)))
- `(trashed-mark ((,class :inherit modus-theme-mark-symbol)))
- `(trashed-marked ((,class :inherit modus-theme-mark-alt)))
- `(trashed-restored ((,class :inherit modus-theme-mark-sel)))
- `(trashed-symlink ((,class :inherit button :foreground ,cyan-alt)))
-;;;;; treemacs
- `(treemacs-directory-collapsed-face ((,class :foreground ,magenta-alt)))
- `(treemacs-directory-face ((,class :inherit dired-directory)))
- `(treemacs-file-face ((,class :foreground ,fg-main)))
- `(treemacs-fringe-indicator-face ((,class :foreground ,fg-main)))
- `(treemacs-git-added-face ((,class :foreground ,green-intense)))
- `(treemacs-git-conflict-face ((,class :inherit (modus-theme-intense-red bold))))
- `(treemacs-git-ignored-face ((,class :foreground ,fg-alt)))
- `(treemacs-git-modified-face ((,class :foreground ,yellow-alt-other)))
- `(treemacs-git-renamed-face ((,class :foreground ,cyan-alt-other)))
- `(treemacs-git-unmodified-face ((,class :foreground ,fg-main)))
- `(treemacs-git-untracked-face ((,class :foreground ,red-alt-other)))
- `(treemacs-help-column-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,magenta-alt-other :underline t)))
- `(treemacs-help-title-face ((,class :foreground ,blue-alt-other)))
- `(treemacs-on-failure-pulse-face ((,class :inherit modus-theme-intense-red)))
- `(treemacs-on-success-pulse-face ((,class :inherit modus-theme-intense-green)))
- `(treemacs-root-face ((,class :inherit bold :foreground ,blue-alt-other :height 1.2 :underline t)))
- `(treemacs-root-remote-disconnected-face ((,class :inherit treemacs-root-remote-face :foreground ,yellow)))
- `(treemacs-root-remote-face ((,class :inherit treemacs-root-face :foreground ,magenta)))
- `(treemacs-root-remote-unreadable-face ((,class :inherit treemacs-root-unreadable-face)))
- `(treemacs-root-unreadable-face ((,class :inherit treemacs-root-face :strike-through t)))
- `(treemacs-tags-face ((,class :foreground ,blue-alt)))
- `(treemacs-tags-face ((,class :foreground ,magenta-alt)))
-;;;;; tty-menu
- `(tty-menu-disabled-face ((,class :background ,bg-alt :foreground ,fg-alt)))
- `(tty-menu-enabled-face ((,class :inherit bold :background ,bg-alt :foreground ,fg-main)))
- `(tty-menu-selected-face ((,class :inherit modus-theme-intense-blue)))
-;;;;; tuareg
- `(caml-types-def-face ((,class :inherit modus-theme-subtle-red)))
- `(caml-types-expr-face ((,class :inherit modus-theme-subtle-green)))
- `(caml-types-occ-face ((,class :inherit modus-theme-subtle-green)))
- `(caml-types-scope-face ((,class :inherit modus-theme-subtle-blue)))
- `(caml-types-typed-face ((,class :inherit modus-theme-subtle-magenta)))
- `(tuareg-font-double-semicolon-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(tuareg-font-lock-attribute-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(tuareg-font-lock-constructor-face ((,class :foreground ,fg-main)))
- `(tuareg-font-lock-error-face ((,class :inherit (modus-theme-intense-red bold))))
- `(tuareg-font-lock-extension-node-face ((,class :background ,bg-alt :foreground ,magenta)))
- `(tuareg-font-lock-governing-face ((,class :inherit bold :foreground ,fg-main)))
- `(tuareg-font-lock-infix-extension-node-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(tuareg-font-lock-interactive-directive-face ((,class :foreground ,fg-special-cold)))
- `(tuareg-font-lock-interactive-error-face ((,class :inherit bold
- ,@(modus-vivendi-theme-syntax-foreground
- red red-faint))))
- `(tuareg-font-lock-interactive-output-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(tuareg-font-lock-label-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(tuareg-font-lock-line-number-face ((,class :foreground ,fg-special-warm)))
- `(tuareg-font-lock-module-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(tuareg-font-lock-multistage-face ((,class :inherit bold :background ,bg-alt
- ,@(modus-vivendi-theme-syntax-foreground
- blue blue-faint))))
- `(tuareg-font-lock-operator-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(tuareg-opam-error-face ((,class :inherit bold
- ,@(modus-vivendi-theme-syntax-foreground
- red red-faint))))
- `(tuareg-opam-pkg-variable-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint)
- :slant ,modus-theme-slant)))
-;;;;; typescript
- `(typescript-jsdoc-tag ((,class :foreground ,fg-special-mild :slant ,modus-theme-slant)))
- `(typescript-jsdoc-type ((,class :foreground ,fg-special-calm :slant ,modus-theme-slant)))
- `(typescript-jsdoc-value ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
-;;;;; undo-tree
- `(undo-tree-visualizer-active-branch-face ((,class :inherit bold :foreground ,fg-main)))
- `(undo-tree-visualizer-current-face ((,class :foreground ,blue-intense)))
- `(undo-tree-visualizer-default-face ((,class :foreground ,fg-alt)))
- `(undo-tree-visualizer-register-face ((,class :foreground ,magenta-intense)))
- `(undo-tree-visualizer-unmodified-face ((,class :foreground ,green-intense)))
-;;;;; vc (vc-hooks.el)
- `(vc-conflict-state ((,class :foreground ,red-active :slant ,modus-theme-slant)))
- `(vc-edited-state ((,class :foreground ,yellow-active)))
- `(vc-locally-added-state ((,class :foreground ,cyan-active)))
- `(vc-locked-state ((,class :foreground ,blue-active)))
- `(vc-missing-state ((,class :foreground ,magenta-active :slant ,modus-theme-slant)))
- `(vc-needs-update-state ((,class :foreground ,green-active :slant ,modus-theme-slant)))
- `(vc-removed-state ((,class :foreground ,red-active)))
- `(vc-state-base ((,class :foreground ,fg-active)))
- `(vc-up-to-date-state ((,class :foreground ,fg-special-cold)))
-;;;;; vdiff
- `(vdiff-addition-face ((,class :inherit modus-theme-diff-added)))
- `(vdiff-change-face ((,class :inherit modus-theme-diff-changed)))
- `(vdiff-closed-fold-face ((,class :background ,bg-diff-neutral-1 :foreground ,fg-diff-neutral-1)))
- `(vdiff-refine-added ((,class :inherit modus-theme-diff-refine-added)))
- `(vdiff-refine-changed ((,class :inherit modus-theme-diff-refine-changed)))
- `(vdiff-subtraction-face ((,class :inherit modus-theme-diff-removed)))
- `(vdiff-target-face ((,class :inherit modus-theme-intense-blue)))
-;;;;; vimish-fold
- `(vimish-fold-fringe ((,class :foreground ,cyan-active)))
- `(vimish-fold-mouse-face ((,class :inherit modus-theme-intense-blue)))
- `(vimish-fold-overlay ((,class :background ,bg-alt :foreground ,fg-special-cold)))
-;;;;; visible-mark
- `(visible-mark-active ((,class :background ,blue-intense-bg)))
- `(visible-mark-face1 ((,class :background ,cyan-intense-bg)))
- `(visible-mark-face2 ((,class :background ,yellow-intense-bg)))
- `(visible-mark-forward-face1 ((,class :background ,magenta-intense-bg)))
- `(visible-mark-forward-face2 ((,class :background ,green-intense-bg)))
-;;;;; visual-regexp
- `(vr/group-0 ((,class :inherit modus-theme-intense-blue)))
- `(vr/group-1 ((,class :inherit modus-theme-intense-magenta)))
- `(vr/group-2 ((,class :inherit modus-theme-intense-green)))
- `(vr/match-0 ((,class :inherit modus-theme-refine-yellow)))
- `(vr/match-1 ((,class :inherit modus-theme-refine-yellow)))
- `(vr/match-separator-face ((,class :inherit (modus-theme-intense-neutral bold))))
-;;;;; volatile-highlights
- `(vhl/default-face ((,class ,@(and (>= emacs-major-version 27) '(:extend t))
- :background ,bg-alt :foreground ,blue-nuanced)))
-;;;;; vterm
- `(vterm-color-black ((,class :background "gray35" :foreground "gray35")))
- `(vterm-color-blue ((,class :background ,blue :foreground ,blue)))
- `(vterm-color-cyan ((,class :background ,cyan :foreground ,cyan)))
- `(vterm-color-default ((,class :background ,bg-main :foreground ,fg-main)))
- `(vterm-color-green ((,class :background ,green :foreground ,green)))
- `(vterm-color-inverse-video ((,class :background ,bg-main :inverse-video t)))
- `(vterm-color-magenta ((,class :background ,magenta :foreground ,magenta)))
- `(vterm-color-red ((,class :background ,red :foreground ,red)))
- `(vterm-color-underline ((,class :foreground ,fg-special-warm :underline t)))
- `(vterm-color-white ((,class :background "gray65" :foreground "gray65")))
- `(vterm-color-yellow ((,class :background ,yellow :foreground ,yellow)))
-;;;;; wcheck-mode
- `(wcheck-default-face ((,class :foreground ,red :underline t)))
-;;;;; web-mode
- `(web-mode-annotation-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-annotation-html-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-annotation-tag-face ((,class :inherit web-mode-comment-face :underline t)))
- `(web-mode-block-attr-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue blue-faint))))
- `(web-mode-block-attr-value-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(web-mode-block-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-block-control-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-block-delimiter-face ((,class :foreground ,fg-main)))
- `(web-mode-block-face ((,class :background ,bg-dim)))
- `(web-mode-block-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-bold-face ((,class :inherit bold)))
- `(web-mode-builtin-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-comment-face ((,class :foreground ,fg-alt :slant ,modus-theme-slant)))
- `(web-mode-comment-keyword-face ((,class :inherit bold :background ,bg-dim
- ,@(modus-vivendi-theme-syntax-foreground
- yellow yellow-faint))))
- `(web-mode-constant-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-css-at-rule-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-css-color-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-css-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-css-function-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-css-priority-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- yellow-alt yellow-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-css-property-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-css-pseudo-class-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(web-mode-css-selector-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-css-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-css-variable-face ((,class :foreground ,fg-special-warm)))
- `(web-mode-current-column-highlight-face ((,class :background ,bg-alt)))
- `(web-mode-current-element-highlight-face ((,class :inherit modus-theme-special-mild)))
- `(web-mode-doctype-face ((,class :foreground ,fg-special-cold :slant ,modus-theme-slant)))
- `(web-mode-error-face ((,class :inherit modus-theme-intense-red)))
- `(web-mode-filter-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-folded-face ((,class :underline t)))
- `(web-mode-function-call-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-function-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-html-attr-custom-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-html-attr-engine-face ((,class :foreground ,fg-main)))
- `(web-mode-html-attr-equal-face ((,class :foreground ,fg-main)))
- `(web-mode-html-attr-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-html-attr-value-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-html-entity-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- yellow-alt-other yellow-alt-other-faint)
- :slant ,modus-theme-slant)))
- `(web-mode-html-tag-bracket-face ((,class :foreground ,fg-dim)))
- `(web-mode-html-tag-custom-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-html-tag-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-html-tag-namespaced-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-html-tag-unclosed-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- red red-faint)
- :underline t)))
- `(web-mode-inlay-face ((,class :background ,bg-alt)))
- `(web-mode-italic-face ((,class :slant italic)))
- `(web-mode-javascript-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-javascript-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-json-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-json-context-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(web-mode-json-key-face ((,class :foreground ,blue-nuanced)))
- `(web-mode-json-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-jsx-depth-1-face ((,class :background ,blue-intense-bg :foreground ,fg-main)))
- `(web-mode-jsx-depth-2-face ((,class :background ,blue-subtle-bg :foreground ,fg-main)))
- `(web-mode-jsx-depth-3-face ((,class :background ,bg-special-cold :foreground ,fg-special-cold)))
- `(web-mode-jsx-depth-4-face ((,class :background ,bg-alt :foreground ,blue-refine-fg)))
- `(web-mode-jsx-depth-5-face ((,class :background ,bg-alt :foreground ,blue-nuanced)))
- `(web-mode-keyword-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt-other magenta-alt-other-faint)
- ,@(modus-vivendi-theme-bold-weight))))
- `(web-mode-param-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta magenta-faint))))
- `(web-mode-part-comment-face ((,class :inherit web-mode-comment-face)))
- `(web-mode-part-face ((,class :inherit web-mode-block-face)))
- `(web-mode-part-string-face ((,class :inherit web-mode-string-face)))
- `(web-mode-preprocessor-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt-other red-alt-other-faint))))
- `(web-mode-script-face ((,class :inherit web-mode-part-face)))
- `(web-mode-sql-keyword-face ((,class :inherit bold
- ,@(modus-vivendi-theme-syntax-foreground
- yellow yellow-faint))))
- `(web-mode-string-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt blue-alt-faint))))
- `(web-mode-style-face ((,class :inherit web-mode-part-face)))
- `(web-mode-symbol-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- blue-alt-other blue-alt-other-faint))))
- `(web-mode-type-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- magenta-alt magenta-alt-faint))))
- `(web-mode-underline-face ((,class :underline t)))
- `(web-mode-variable-name-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan cyan-faint))))
- `(web-mode-warning-face ((,class :inherit bold :background ,bg-alt
- ,@(modus-vivendi-theme-syntax-foreground
- yellow-alt-other yellow-alt-other-faint))))
- `(web-mode-whitespace-face ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
-;;;;; wgrep
- `(wgrep-delete-face ((,class :inherit modus-theme-refine-yellow)))
- `(wgrep-done-face ((,class :inherit modus-theme-refine-blue)))
- `(wgrep-face ((,class :inherit modus-theme-refine-green)))
- `(wgrep-file-face ((,class :foreground ,fg-special-warm)))
- `(wgrep-reject-face ((,class :inherit (modus-theme-intense-red bold))))
-;;;;; which-function-mode
- `(which-func ((,class :foreground ,magenta-active)))
-;;;;; which-key
- `(which-key-command-description-face ((,class :foreground ,cyan)))
- `(which-key-group-description-face ((,class :foreground ,magenta-alt)))
- `(which-key-highlighted-command-face ((,class :foreground ,cyan-alt :underline t)))
- `(which-key-key-face ((,class :inherit bold :foreground ,blue-intense)))
- `(which-key-local-map-description-face ((,class :foreground ,fg-main)))
- `(which-key-note-face ((,class :background ,bg-dim :foreground ,fg-special-mild)))
- `(which-key-separator-face ((,class :foreground ,fg-alt)))
- `(which-key-special-key-face ((,class :inherit bold :foreground ,yellow-intense)))
-;;;;; whitespace-mode
- `(whitespace-big-indent ((,class :inherit modus-theme-subtle-red)))
- `(whitespace-empty ((,class :inherit modus-theme-intense-magenta)))
- `(whitespace-hspace ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-indentation ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-line ((,class :inherit modus-theme-special-warm)))
- `(whitespace-newline ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-space ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-space-after-tab ((,class :inherit modus-theme-subtle-magenta)))
- `(whitespace-space-before-tab ((,class :inherit modus-theme-subtle-cyan)))
- `(whitespace-tab ((,class :background ,bg-whitespace :foreground ,fg-whitespace)))
- `(whitespace-trailing ((,class :inherit modus-theme-intense-red)))
-;;;;; window-divider-mode
- `(window-divider ((,class :foreground ,fg-window-divider-inner)))
- `(window-divider-first-pixel ((,class :foreground ,fg-window-divider-outer)))
- `(window-divider-last-pixel ((,class :foreground ,fg-window-divider-outer)))
-;;;;; winum
- `(winum-face ((,class ,@(modus-vivendi-theme-bold-weight) :foreground ,cyan-active)))
-;;;;; writegood-mode
- `(writegood-duplicates-face ((,class :background ,bg-alt :foreground ,red-alt :underline t)))
- `(writegood-passive-voice-face ((,class :foreground ,yellow-nuanced :underline ,fg-lang-warning)))
- `(writegood-weasels-face ((,class :foreground ,red-nuanced :underline ,fg-lang-error)))
-;;;;; woman
- `(woman-addition ((,class :foreground ,magenta-alt-other)))
- `(woman-bold ((,class :inherit bold :foreground ,magenta)))
- `(woman-italic ((,class :foreground ,cyan :slant italic)))
- `(woman-unknown ((,class :foreground ,yellow :slant italic)))
-;;;;; xah-elisp-mode
- `(xah-elisp-at-symbol ((,class :inherit bold
- ,@(modus-vivendi-theme-syntax-foreground
- red-alt red-alt-faint))))
- `(xah-elisp-cap-variable ((,class ,@(modus-vivendi-theme-syntax-foreground
- red-alt-other red-alt-other-faint))))
- `(xah-elisp-command-face ((,class ,@(modus-vivendi-theme-syntax-foreground
- cyan-alt-other cyan-alt-other-faint))))
- `(xah-elisp-dollar-symbol ((,class ,@(modus-vivendi-theme-syntax-foreground
- green green-faint))))
-;;;;; xref
- `(xref-file-header ((,class :inherit bold :foreground ,fg-special-cold)))
- `(xref-line-number ((,class :foreground ,fg-alt)))
- `(xref-match ((,class :inherit match)))
-;;;;; yaml-mode
- `(yaml-tab-face ((,class :inherit modus-theme-intense-red)))
-;;;;; yasnippet
- `(yas-field-highlight-face ((,class :background ,bg-alt :foreground ,fg-main)))
-;;;;; ztree
- `(ztreep-arrow-face ((,class :foreground ,fg-inactive)))
- `(ztreep-diff-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold)))
- `(ztreep-diff-header-small-face ((,class :inherit bold :foreground ,fg-special-mild)))
- `(ztreep-diff-model-add-face ((,class :foreground ,green)))
- `(ztreep-diff-model-diff-face ((,class :foreground ,red)))
- `(ztreep-diff-model-ignored-face ((,class :foreground ,fg-alt :strike-through t)))
- `(ztreep-diff-model-normal-face ((,class :foreground ,fg-alt)))
- `(ztreep-expand-sign-face ((,class :foreground ,blue)))
- `(ztreep-header-face ((,class :inherit bold :height 1.2 :foreground ,fg-special-cold)))
- `(ztreep-leaf-face ((,class :foreground ,cyan)))
- `(ztreep-node-count-children-face ((,class :foreground ,fg-special-warm)))
- `(ztreep-node-face ((,class :foreground ,fg-main))))
-;;;; Emacs 27+
- (when (>= emacs-major-version 27)
- (custom-theme-set-faces
- 'modus-vivendi
-;;;;; line numbers (`display-line-numbers-mode' and global variant)
- ;; NOTE that this is specifically for the faces that were
- ;; introduced in Emacs 27, as the other faces are already
- ;; supported.
- `(line-number-major-tick ((,class :inherit (bold default)
- :background ,yellow-nuanced-bg
- :foreground ,yellow-nuanced)))
- `(line-number-minor-tick ((,class :inherit (bold default)
- :background ,bg-inactive
- :foreground ,fg-inactive)))
-;;;;; tab-bar-mode
- `(tab-bar ((,class :background ,bg-tab-bar :foreground ,fg-main)))
- `(tab-bar-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active)
- :background ,bg-tab-active :foreground ,fg-main)))
- `(tab-bar-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive)
- :background ,bg-tab-inactive :foreground ,fg-dim)))
-;;;;; tab-line-mode
- `(tab-line ((,class :height 0.95 :background ,bg-tab-bar :foreground ,fg-main)))
- `(tab-line-close-highlight ((,class :foreground ,red)))
- `(tab-line-highlight ((,class :background ,blue-subtle-bg :foreground ,fg-dim)))
- `(tab-line-tab ((,class :inherit bold :box (:line-width 2 :color ,bg-tab-active)
- :background ,bg-tab-active :foreground ,fg-main)))
- `(tab-line-tab-current ((,class :inherit tab-line-tab)))
- `(tab-line-tab-inactive ((,class :box (:line-width 2 :color ,bg-tab-inactive)
- :background ,bg-tab-inactive :foreground ,fg-dim)))))
-;;;; Emacs 28+
- (when (>= emacs-major-version 28)
- (custom-theme-set-faces
- 'modus-vivendi
-;;;;; isearch regexp groups
- `(isearch-group-1 ((,class :inherit modus-theme-intense-blue)))
- `(isearch-group-2 ((,class :inherit modus-theme-intense-magenta)))))
-;;; variables
- (custom-theme-set-variables
- 'modus-vivendi
-;;;; ansi-colors
- `(ansi-color-faces-vector [default bold shadow italic underline success warning error])
- `(ansi-color-names-vector [,bg-main ,red ,green ,yellow ,blue ,magenta ,cyan ,fg-main])
-;;;; awesome-tray
- `(awesome-tray-mode-line-active-color ,blue)
- `(awesome-tray-mode-line-inactive-color ,bg-active)
-;;;; flymake fringe indicators
- `(flymake-error-bitmap '(flymake-double-exclamation-mark modus-theme-fringe-red))
- `(flymake-warning-bitmap '(exclamation-mark modus-theme-fringe-yellow))
- `(flymake-note-bitmap '(exclamation-mark modus-theme-fringe-cyan))
-;;;; ibuffer
- `(ibuffer-deletion-face 'modus-theme-mark-del)
- `(ibuffer-filter-group-name-face 'modus-theme-mark-symbol)
- `(ibuffer-marked-face 'modus-theme-mark-sel)
- `(ibuffer-title-face 'modus-theme-pseudo-header)
-;;;; highlight-tail
- `(highlight-tail-colors
- '((,green-subtle-bg . 0)
- (,cyan-subtle-bg . 20)))
-;;;; hl-todo
- `(hl-todo-keyword-faces
- '(("HOLD" . ,yellow-alt)
- ("TODO" . ,magenta)
- ("NEXT" . ,magenta-alt-other)
- ("THEM" . ,magenta-alt)
- ("PROG" . ,cyan)
- ("OKAY" . ,cyan-alt)
- ("DONT" . ,green-alt)
- ("FAIL" . ,red)
- ("BUG" . ,red)
- ("DONE" . ,green)
- ("NOTE" . ,yellow-alt-other)
- ("KLUDGE" . ,yellow)
- ("HACK" . ,yellow)
- ("TEMP" . ,red-nuanced)
- ("FIXME" . ,red-alt-other)
- ("XXX+" . ,red-alt)
- ("REVIEW" . ,cyan-alt-other)
- ("DEPRECATED" . ,blue-nuanced)))
-;;;; vc-annotate (C-x v g)
- `(vc-annotate-background nil)
- `(vc-annotate-background-mode nil)
- `(vc-annotate-color-map
- '((20 . ,red)
- (40 . ,magenta)
- (60 . ,magenta-alt)
- (80 . ,red-alt)
- (100 . ,yellow)
- (120 . ,yellow-alt)
- (140 . ,fg-special-warm)
- (160 . ,fg-special-mild)
- (180 . ,green)
- (200 . ,green-alt)
- (220 . ,cyan-alt-other)
- (240 . ,cyan-alt)
- (260 . ,cyan)
- (280 . ,fg-special-cold)
- (300 . ,blue)
- (320 . ,blue-alt)
- (340 . ,blue-alt-other)
- (360 . ,magenta-alt-other)))
- `(vc-annotate-very-old-color nil)
-;;;; xterm-color
- `(xterm-color-names [,bg-main ,red ,green ,yellow ,blue ,magenta ,cyan ,fg-alt])
- `(xterm-color-names-bright [,bg-alt ,red-alt ,green-alt ,yellow-alt ,blue-alt ,magenta-alt ,cyan-alt ,fg-main]))
-;;; Conditional theme variables
-;;;; org-src-block-faces
- ;; this is a user option to add a colour-coded background to source
- ;; blocks for various programming languages
- (when (eq modus-vivendi-theme-org-blocks 'rainbow)
- (custom-theme-set-variables
- 'modus-vivendi
- `(org-src-block-faces ; TODO this list should be expanded
- `(("emacs-lisp" modus-theme-nuanced-magenta)
- ("elisp" modus-theme-nuanced-magenta)
- ("clojure" modus-theme-nuanced-magenta)
- ("clojurescript" modus-theme-nuanced-magenta)
- ("c" modus-theme-nuanced-blue)
- ("c++" modus-theme-nuanced-blue)
- ("sh" modus-theme-nuanced-green)
- ("shell" modus-theme-nuanced-green)
- ("html" modus-theme-nuanced-yellow)
- ("xml" modus-theme-nuanced-yellow)
- ("css" modus-theme-nuanced-red)
- ("scss" modus-theme-nuanced-red)
- ("python" modus-theme-nuanced-green)
- ("ipython" modus-theme-nuanced-magenta)
- ("r" modus-theme-nuanced-cyan)
- ("yaml" modus-theme-nuanced-cyan)
- ("conf" modus-theme-nuanced-cyan)
- ("docker" modus-theme-nuanced-cyan)
- ("json" modus-theme-nuanced-cyan))))))
+(deftheme modus-vivendi
+ "Accessible and customizable dark theme (WCAG AAA standard).
+Conforms with the highest legibility standard for color contrast
+between background and foreground in any given piece of text,
+which corresponds to a minimum contrast in relative luminance of
+7:1.")
-;;; library provides
-;;;###autoload
-(when load-file-name
- (add-to-list 'custom-theme-load-path
- (file-name-as-directory (file-name-directory load-file-name))))
+(modus-themes-theme modus-vivendi)
(provide-theme 'modus-vivendi)
-(provide 'modus-vivendi-theme)
-
;;; modus-vivendi-theme.el ends here
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index aaa7cceaf68..922114fb64a 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -36,7 +36,7 @@ are included.")
`(fringe ((,class (:background "#303030"))))
`(highlight ((,class (:background "#454545" :foreground "#ffffff"
:underline t))))
- `(region ((,class (:background "#444444" :foreground "#f6f3e8"))))
+ `(region ((,class (:background "#444444"))))
`(secondary-selection ((,class (:background "#333366" :foreground "#f6f3e8"))))
`(isearch ((,class (:background "#343434" :foreground "#857b6f"))))
`(lazy-highlight ((,class (:background "#384048" :foreground "#a0a8b0"))))
@@ -57,6 +57,8 @@ are included.")
`(font-lock-type-face ((,class (:foreground "#92a65e" :weight bold))))
`(font-lock-variable-name-face ((,class (:foreground "#cae682"))))
`(font-lock-warning-face ((,class (:foreground "#ccaa8f"))))
+ ;; Help faces
+ `(help-key-binding ((,class (:background "#333333" :foreground "#f6f3e8"))))
;; Button and link faces
`(link ((,class (:foreground "#8ac6f2" :underline t))))
`(link-visited ((,class (:foreground "#e5786d" :underline t))))
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index 6194e55ea35..dcdb61f23ec 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -1038,10 +1038,10 @@ then type C-x 1.
Here are some other useful C-h options:
- C-h f Describe a function. You type in the name of the
- function.
+ C-h x Describe a command. You type in the name of the
+ command.
->> Try typing C-h f previous-line <Return>.
+>> Try typing C-h x previous-line <Return>.
This displays all the information Emacs has about the
function which implements the C-p command.
diff --git a/etc/tutorials/TUTORIAL.es b/etc/tutorials/TUTORIAL.es
index 786a9f4130d..a92604ccb9e 100644
--- a/etc/tutorials/TUTORIAL.es
+++ b/etc/tutorials/TUTORIAL.es
@@ -1091,10 +1091,10 @@ ayuda, y entonces teclear C-x 1.
Aquí hay algunas otras opciones útiles de C-h:
- C-h f Describe una función. Usted teclea el nombre de la
- función.
+ C-h x Describe un comando. Usted teclea el nombre del
+ comando.
->> Intente teclear C-h f previous-line <Return>.
+>> Intente teclear C-h x previous-line <Return>.
Esto muestra toda la información que Emacs tiene sobre la función
que implementa el comando C-p
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index 5cd1cac8fd1..2ee4f74c324 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -931,9 +931,9 @@ M-x help <Return>‎ כתחליף.)
הנה עוד כמה פקודות עזרה שימושיות:
- ‏C-h f תן הסבר על פונקציה. יש להקיש את שם הפונקציה.
+ ‏C-h x תן הסבר על פקודה. יש להקיש את שם הפקודה.
->> נסו להקיש C-h f previous-line <Return>‎.
+>> נסו להקיש C-h x previous-line <Return>‎.
כתוצאה, יוצג תיעוד מלא של הפונקציה המממשת את הפקודה C-p כפי שהוא
ידוע ל־Emacs.
diff --git a/etc/tutorials/TUTORIAL.it b/etc/tutorials/TUTORIAL.it
index ac5937930bf..68bf40332ef 100644
--- a/etc/tutorials/TUTORIAL.it
+++ b/etc/tutorials/TUTORIAL.it
@@ -578,7 +578,7 @@ originale in modo da conservarlo. Il nuovo nome è ottenuto
aggiungendo un carattere "~" alla fine del nome originale. Quando il
salvataggio termina, Emacs mostra il nome del file scritto.
->> Premi C-x C-s TUTORIAL<Invio>.
+>> Premi C-x C-s TUTORIAL <Invio>.
Questo dovrebbe salvare questa esercitazione in un file chiamato
“TUTORIAL” e mostrare “Wrote ...TUTORIAL nella parte bassa dello
schermo.
@@ -623,8 +623,8 @@ file, puoi farlo visitando di nuovo quel file usando C-x C-f. Ma c'è
un modo più semplice: usa il comando C-x b. Questo comando richiede
il nome del buffer.
->> Crea un file chiamato “pippo” con C-x C-f pippo<Invio>.
- Torna poi a questa esercitazione con C-x b TUTORIAL<Invio>.
+>> Crea un file chiamato “pippo” con C-x C-f pippo <Invio>.
+ Torna poi a questa esercitazione con C-x b TUTORIAL <Invio>.
La maggior parte delle volte, il nome del buffer corrisponde al nome
del file (senza la parte relativa alla directory). Questo non è
@@ -641,8 +641,8 @@ Anche il buffer chiamato “*Messages* non è associato ad alcun file.
Quel buffer contiene tutti i messaggi che sono apparsi nella parte
bassa dello schermo durante la sessione di Emacs.
->> Passa al buffer con i messaggi con C-x b *Messages*<Invio>.
- Torna poi a questa esercitazione con C-x b TUTORIAL<Invio>.
+>> Passa al buffer con i messaggi con C-x b *Messages* <Invio>.
+ Torna poi a questa esercitazione con C-x b TUTORIAL <Invio>.
Se si modifica in qualche modo il testo di un file e poi si visita un
altro file questo non comporta il salvataggio del primo. Le modifiche
@@ -752,7 +752,7 @@ salvataggio automatico.
Se il computer si blocca si può recuperare il file salvato
automaticamente aprendo il file in modo normale (il file che si stava
scrivendo, non quello di salvataggio automatico) e usando poi M-x
-recover-this-file<Invio>. Quando viene chiesta la conferma si risponda
+recover-this-file <Invio>. Quando viene chiesta la conferma si risponda
con yes<Invio> per procedere con il recupero dei dati salvati
automaticamente.
@@ -818,7 +818,7 @@ fundamental-mode è il comando per attivare la modalità primaria
Se si vuole inserire del testo in italiano, come questo file,
probabilmente è più adeguata la modalità testo.
->> Inserisci M-x text-mode<Invio>.
+>> Inserisci M-x text-mode <Invio>.
Non preoccuparti, nessuno dei comandi che hai imparato verrà
modificato in modo sostanziale. Tuttavia adesso puoi osservare come
@@ -853,14 +853,14 @@ testo, è la modalità “Auto Fill” (riempimento automatico). Quando
questa modalità è attiva, Emacs interrompe la riga tra due parole ogni
volta che, nel corso dell'inserimento, essa diventa troppo lunga.
-Si può attivare il modo “Auto Fill” con M-x auto-fill-mode<Invio>.
+Si può attivare il modo “Auto Fill” con M-x auto-fill-mode <Invio>.
Quando la modalità suddetta è attiva può essere disattivata eseguendo
-di nuovo M-x auto-fill-mode<Invio>. Se la modalità è disattivata
+di nuovo M-x auto-fill-mode <Invio>. Se la modalità è disattivata
questo comando la attiva, viceversa se è già attiva. Un comando che
funziona così si comporta come un interruttore, attiva o disattiva
qualcosa ogni volta che viene premuto.
->> Usa M-x auto fill mode<Invio> adesso. Inserisci una riga di “asdf ”
+>> Usa M-x auto fill mode <Invio> adesso. Inserisci una riga di “asdf ”
ripetuti fino a quando non la vedi dividersi in due righe. Devi
interporre degli spazi perché la modalità Auto Fill spezza le righe
solo in corrispondenza di uno spazio.
@@ -1021,13 +1021,13 @@ chiamano “finestra”, ed è possibile mostrarne più di uno
contemporaneamente. Su un terminale testuale, è possibile mostrare un
solo frame alla volta.
->> Usa M-x make-frame<Invio>.
+>> Usa M-x make-frame <Invio>.
Un nuovo frame dovrebbe apparire sullo schermo.
In questo nuovo frame puoi svolgere qualsiasi cosa come nel frame
originale. Non c'è nulla di speciale nel primo frame.
->> Usa M-x delete-frame<Invio>.
+>> Usa M-x delete-frame <Invio>.
Questo rimuove il frame selezionato.
Puoi anche eliminare un frame usando i metodi offerti dal sistema
@@ -1076,7 +1076,7 @@ aiuto che può fornire. Se si è attivato l'aiuto con C-h e si decide
che non serve più si può annullare la richiesta con C-g.
(Se C-h non mostra un messaggio relativo all'aiuto nella parte bassa
-dello schermo, prova ad usare il tasto F1 oppure con M-x help<Invio>.)
+dello schermo, prova ad usare il tasto F1 oppure con M-x help <Invio>.)
La forma base di aiuto è data da C-h c. Si inserisce C-h, il
carattere c e poi un carattere o una sequenza di caratteri; Emacs
@@ -1110,9 +1110,9 @@ mentre fai riferimento al testo di aiuto e poi usare un C-x 1.
Ecco altre utili opzioni di C-h:
- C-h f Descrive una funzione. Inserisci il nome della funzione.
+ C-h x Descrive un comando. Inserisci il nome della comando.
->> Prova con C-h f previous-line<Invio>.
+>> Prova con C-h x previous-line <Invio>.
Questo mostrerà tutte le informazioni che Emacs possiede sulla
funzione che implementa il comando C-p.
@@ -1128,7 +1128,7 @@ variabile quando Emacs lo richiede.
una sequenza di uno o due caratteri che serve a far
partire il comando senza doverlo inserire per esteso.
->> Prova C-h a file<Invio>
+>> Prova C-h a file <Invio>
Questo mostrerà in un'altra finestra una lista di tutti i comandi che
contengono la parola “file” nel nome. Nella lista si vedranno
@@ -1143,7 +1143,7 @@ esteso come find-file.
C-h i Leggi la documentazione. Questo comando apre un
buffer speciale chiamato “*info*” in cui puoi leggere
i manuali on-line dei pacchetti installati sul tuo
- sistema. Batti m emacs<Invio> per leggere il manuale
+ sistema. Batti m emacs <Invio> per leggere il manuale
di Emacs. Se non hai mai usato il sistema Info prima
d'ora premi ? ed Emacs ti guiderà nell'uso delle
opzioni del modo Info. Una volta terminata questa
diff --git a/etc/tutorials/TUTORIAL.sv b/etc/tutorials/TUTORIAL.sv
index 1eab2670795..dacc66d916f 100644
--- a/etc/tutorials/TUTORIAL.sv
+++ b/etc/tutorials/TUTORIAL.sv
@@ -1056,10 +1056,10 @@ att först senare ta bort fönstret med C-x 1.
Här är fler varianter på C-h:
- C-h f Beskriv en funktion. Du skriver in funktionsnamnet.
+ C-h x Beskriv ett kommando. Du skriver in kommandots namn.
->> Prova att skriva C-h f previous-line<Return>.
- Detta ger den information Emacs har om funktionen
+>> Prova att skriva C-h x previous-line <Return>.
+ Detta visar den information Emacs har om den funktion
som implementerar kommandot C-p.
Ett liknande kommando, C-h v, visar dokumentationen för de variabler
diff --git a/leim/Makefile.in b/leim/Makefile.in
index f3e530a11de..ce1029abcfa 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -25,24 +25,14 @@ SHELL = @SHELL@
# Here are the things that we expect ../configure to edit.
srcdir=@srcdir@
+top_builddir = @top_builddir@
# Where the generated files go.
leimdir = ${srcdir}/../lisp/leim
EXEEXT = @EXEEXT@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH
@@ -147,19 +137,21 @@ ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map
$(AM_V_GEN)${RUN_EMACS} -l titdic-cnv -f pinyin-convert $< $@
-.PHONY: bootstrap-clean distclean maintainer-clean extraclean
+.PHONY: bootstrap-clean distclean maintainer-clean gen-clean
+## Perhaps this should run gen-clean.
bootstrap-clean:
rm -f ${TIT_MISC} ${leimdir}/leim-list.el
distclean:
rm -f Makefile
-maintainer-clean: distclean bootstrap-clean
+maintainer-clean: gen-clean distclean
-## We do not delete ja-dic, even in a bootstrap, because it rarely
-## changes and is slow to regenerate.
-extraclean: bootstrap-clean
+## ja-dic rarely changes and is slow to regenerate, and tends to be a
+## bottleneck in parallel builds.
+gen-clean:
+ rm -f ${TIT_MISC} ${leimdir}/leim-list.el
rm -rf ${leimdir}/ja-dic
### Makefile.in ends here
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index 687379db9f0..904675c0c52 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -1,4 +1,4 @@
-;; leim-ext.el -- extra leim configuration -*- lexical-binding: t; -*-
+;;; leim-ext.el --- extra leim configuration -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 0a6dd826c10..7af89eb380d 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -44,33 +44,8 @@ WERROR_CFLAGS = @WERROR_CFLAGS@
# Program name transformation.
TRANSFORM = @program_transform_name@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_RC = $(am__v_RC_@AM_V@)
-am__v_RC_ = $(am__v_RC_@AM_DEFAULT_V@)
-am__v_RC_0 = @echo " RC " $@;
-am__v_RC_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+top_builddir = @top_builddir@
+-include ${top_builddir}/src/verbose.mk
# ==================== Where To Install Things ====================
@@ -214,6 +189,30 @@ LIB_WSOCK32=@LIB_WSOCK32@
## Extra libraries for etags
LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM)
+HAVE_SECCOMP=@HAVE_SECCOMP@
+HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@
+LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@
+LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@
+
+# Currently, we can only generate seccomp filter files for x86-64.
+ifeq ($(HAVE_SECCOMP),yes)
+ifeq ($(HAVE_LIBSECCOMP),yes)
+ifeq ($(shell uname -m),x86_64)
+# We require SECCOMP_RET_KILL_PROCESS, which is only available in
+# Linux 4.14 and later.
+ifeq ($(shell { echo 4.14; uname -r | cut -d . -f 1-2; } | \
+ sort -C -t . -n -k 1,1 -k 2,2 && \
+ echo 1),1)
+SECCOMP_FILTER=1
+endif
+endif
+endif
+endif
+
+ifeq ($(SECCOMP_FILTER),1)
+DONT_INSTALL += seccomp-filter$(EXEEXT)
+endif
+
## Extra libraries to use when linking movemail.
LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \
$(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS)
@@ -243,6 +242,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h
all: ${EXE_FILES} ${SCRIPTS}
+ifeq ($(SECCOMP_FILTER),1)
+all: seccomp-filter.bpf seccomp-filter-exec.bpf
+endif
+
.PHONY: all need-blessmail maybe-blessmail
LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM)
@@ -312,7 +315,7 @@ $(DESTDIR)${archlibdir}: all
fi
.PHONY: install uninstall mostlyclean clean distclean maintainer-clean
-.PHONY: bootstrap-clean extraclean check tags
+.PHONY: bootstrap-clean check tags
install: $(DESTDIR)${archlibdir}
@echo
@@ -340,6 +343,7 @@ mostlyclean:
rm -f core ./*.o ./*.res
clean: mostlyclean
+ -rm -f seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc
rm -f ${EXE_FILES}
distclean: clean
@@ -347,8 +351,6 @@ distclean: clean
bootstrap-clean maintainer-clean: distclean
-extraclean: maintainer-clean
- rm -f ./*~ \#*
## Test the contents of the directory.
check:
@@ -425,4 +427,15 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h)
emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico
$(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $<
+ifeq ($(SECCOMP_FILTER),1)
+seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h)
+ $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \
+ $(LIBSECCOMP_LIBS) -o $@
+
+seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT)
+ $(AM_V_GEN)./seccomp-filter$(EXEEXT) \
+ seccomp-filter.bpf seccomp-filter.pfc \
+ seccomp-filter-exec.bpf seccomp-filter-exec.pfc
+endif
+
## Makefile ends here.
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 12ced4aadbd..8346524a3eb 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -80,6 +80,9 @@ char *w32_getenv (const char *);
#include <sys/stat.h>
#include <unistd.h>
+#ifndef WINDOWSNT
+# include <acl.h>
+#endif
#include <filename.h>
#include <intprops.h>
#include <min-max.h>
@@ -91,6 +94,10 @@ char *w32_getenv (const char *);
# pragma GCC diagnostic ignored "-Wformat-truncation=2"
#endif
+#if !defined O_PATH && !defined WINDOWSNT
+# define O_PATH O_SEARCH
+#endif
+
/* Name used to invoke this program. */
static char const *progname;
@@ -1128,24 +1135,74 @@ process_grouping (void)
#ifdef SOCKETS_IN_FILE_SYSTEM
-/* Return the file status of NAME, ordinarily a socket.
- It should be owned by UID. Return one of the following:
- >0 - 'stat' failed with this errno value
- -1 - isn't owned by us
- 0 - success: none of the above */
+/* A local socket address. The union avoids the need to cast. */
+union local_sockaddr
+{
+ struct sockaddr_un un;
+ struct sockaddr sa;
+};
+
+/* Relative to the directory DIRFD, connect the socket file named ADDR
+ to the socket S. Return 0 if successful, -1 if DIRFD is not
+ AT_FDCWD and DIRFD's permissions would allow a symlink attack, an
+ errno otherwise. */
static int
-socket_status (const char *name, uid_t uid)
+connect_socket (int dirfd, char const *addr, int s, uid_t uid)
{
- struct stat statbfr;
+ int sock_status = 0;
- if (stat (name, &statbfr) != 0)
- return errno;
+ union local_sockaddr server;
+ if (sizeof server.un.sun_path <= strlen (addr))
+ return ENAMETOOLONG;
+ server.un.sun_family = AF_UNIX;
+ strcpy (server.un.sun_path, addr);
- if (statbfr.st_uid != uid)
- return -1;
+ /* If -1, WDFD is not set yet. If nonnegative, WDFD is a file
+ descriptor for the initial working directory. Otherwise -1 - WDFD is
+ the error number for the initial working directory. */
+ static int wdfd = -1;
- return 0;
+ if (dirfd != AT_FDCWD)
+ {
+ /* Fail if DIRFD's permissions are bogus. */
+ struct stat st;
+ if (fstat (dirfd, &st) != 0)
+ return errno;
+ if (st.st_uid != uid || (st.st_mode & (S_IWGRP | S_IWOTH)))
+ return -1;
+
+ if (wdfd == -1)
+ {
+ /* Save the initial working directory. */
+ wdfd = open (".", O_PATH | O_CLOEXEC);
+ if (wdfd < 0)
+ wdfd = -1 - errno;
+ }
+ if (wdfd < 0)
+ return -1 - wdfd;
+ if (fchdir (dirfd) != 0)
+ return errno;
+
+ /* Fail if DIRFD has an ACL, which means its permissions are
+ almost surely bogus. */
+ int has_acl = file_has_acl (".", &st);
+ if (has_acl)
+ sock_status = has_acl < 0 ? errno : -1;
+ }
+
+ if (!sock_status)
+ sock_status = connect (s, &server.sa, sizeof server.un) == 0 ? 0 : errno;
+
+ /* Fail immediately if we cannot change back to the initial working
+ directory, as that can mess up the rest of execution. */
+ if (dirfd != AT_FDCWD && fchdir (wdfd) != 0)
+ {
+ message (true, "%s: .: %s\n", progname, strerror (errno));
+ exit (EXIT_FAILURE);
+ }
+
+ return sock_status;
}
@@ -1322,32 +1379,49 @@ act_on_signals (HSOCKET emacs_socket)
}
}
-/* Create in SOCKNAME (of size SOCKNAMESIZE) a name for a local socket.
- The first TMPDIRLEN bytes of SOCKNAME are already initialized to be
- the name of a temporary directory. Use UID and SERVER_NAME to
- concoct the name. Return the total length of the name if successful,
- -1 if it does not fit (and store a truncated name in that case).
- Fail if TMPDIRLEN is out of range. */
+enum { socknamesize = sizeof ((struct sockaddr_un *) NULL)->sun_path };
+
+/* Given a local socket S, create in *SOCKNAME a name for a local socket
+ and connect to that socket. The first TMPDIRLEN bytes of *SOCKNAME are
+ already initialized to be the name of a temporary directory.
+ Use UID and SERVER_NAME to concoct the name. Return 0 if
+ successful, -1 if the socket's parent directory is not safe, and an
+ errno if there is some other problem. */
static int
-local_sockname (char *sockname, int socknamesize, int tmpdirlen,
- uintmax_t uid, char const *server_name)
+local_sockname (int s, char sockname[socknamesize], int tmpdirlen,
+ uid_t uid, char const *server_name)
{
/* If ! (0 <= TMPDIRLEN && TMPDIRLEN < SOCKNAMESIZE) the truncated
temporary directory name is already in SOCKNAME, so nothing more
need be stored. */
- if (0 <= tmpdirlen)
- {
- int remaining = socknamesize - tmpdirlen;
- if (0 < remaining)
- {
- int suffixlen = snprintf (&sockname[tmpdirlen], remaining,
- "/emacs%"PRIuMAX"/%s", uid, server_name);
- if (0 <= suffixlen && suffixlen < remaining)
- return tmpdirlen + suffixlen;
- }
- }
- return -1;
+ if (! (0 <= tmpdirlen && tmpdirlen < socknamesize))
+ return ENAMETOOLONG;
+
+ /* Put the full address name into the buffer, since the caller might
+ need it for diagnostics. But don't overrun the buffer. */
+ uintmax_t uidmax = uid;
+ int emacsdirlen;
+ int suffixlen = snprintf (sockname + tmpdirlen, socknamesize - tmpdirlen,
+ "/emacs%"PRIuMAX"%n/%s", uidmax, &emacsdirlen,
+ server_name);
+ if (! (0 <= suffixlen && suffixlen < socknamesize - tmpdirlen))
+ return ENAMETOOLONG;
+
+ /* Make sure the address's parent directory is not a symlink and is
+ this user's directory and does not let others write to it; this
+ fends off some symlink attacks. To avoid races, keep the parent
+ directory open while checking. */
+ char *emacsdirend = sockname + tmpdirlen + emacsdirlen;
+ *emacsdirend = '\0';
+ int dir = openat (AT_FDCWD, sockname,
+ O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC);
+ *emacsdirend = '/';
+ if (dir < 0)
+ return errno;
+ int sock_status = connect_socket (dir, server_name, s, uid);
+ close (dir);
+ return sock_status;
}
/* Create a local socket for SERVER_NAME and connect it to Emacs. If
@@ -1358,28 +1432,43 @@ local_sockname (char *sockname, int socknamesize, int tmpdirlen,
static HSOCKET
set_local_socket (char const *server_name)
{
- union {
- struct sockaddr_un un;
- struct sockaddr sa;
- } server = {{ .sun_family = AF_UNIX }};
+ union local_sockaddr server;
+ int sock_status;
char *sockname = server.un.sun_path;
- enum { socknamesize = sizeof server.un.sun_path };
int tmpdirlen = -1;
int socknamelen = -1;
uid_t uid = geteuid ();
bool tmpdir_used = false;
+ int s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0);
+ if (s < 0)
+ {
+ message (true, "%s: can't create socket: %s\n",
+ progname, strerror (errno));
+ fail ();
+ }
if (strchr (server_name, '/')
|| (ISSLASH ('\\') && strchr (server_name, '\\')))
- socknamelen = snprintf (sockname, socknamesize, "%s", server_name);
+ {
+ socknamelen = snprintf (sockname, socknamesize, "%s", server_name);
+ sock_status = (0 <= socknamelen && socknamelen < socknamesize
+ ? connect_socket (AT_FDCWD, sockname, s, 0)
+ : ENAMETOOLONG);
+ }
else
{
/* socket_name is a file name component. */
+ sock_status = ENOENT;
char const *xdg_runtime_dir = egetenv ("XDG_RUNTIME_DIR");
if (xdg_runtime_dir)
- socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s",
- xdg_runtime_dir, server_name);
- else
+ {
+ socknamelen = snprintf (sockname, socknamesize, "%s/emacs/%s",
+ xdg_runtime_dir, server_name);
+ sock_status = (0 <= socknamelen && socknamelen < socknamesize
+ ? connect_socket (AT_FDCWD, sockname, s, 0)
+ : ENAMETOOLONG);
+ }
+ if (sock_status == ENOENT)
{
char const *tmpdir = egetenv ("TMPDIR");
if (tmpdir)
@@ -1398,23 +1487,24 @@ set_local_socket (char const *server_name)
if (tmpdirlen < 0)
tmpdirlen = snprintf (sockname, socknamesize, "/tmp");
}
- socknamelen = local_sockname (sockname, socknamesize, tmpdirlen,
+ sock_status = local_sockname (s, sockname, tmpdirlen,
uid, server_name);
tmpdir_used = true;
}
}
- if (! (0 <= socknamelen && socknamelen < socknamesize))
+ if (sock_status == 0)
+ return s;
+
+ if (sock_status == ENAMETOOLONG)
{
message (true, "%s: socket-name %s... too long\n", progname, sockname);
fail ();
}
- /* See if the socket exists, and if it's owned by us. */
- int sock_status = socket_status (sockname, uid);
- if (sock_status)
+ if (tmpdir_used)
{
- /* Failing that, see if LOGNAME or USER exist and differ from
+ /* See whether LOGNAME or USER exist and differ from
our euid. If so, look for a socket based on the UID
associated with the name. This is reminiscent of the logic
that init_editfns uses to set the global Vuser_full_name. */
@@ -1431,48 +1521,26 @@ set_local_socket (char const *server_name)
if (pw && pw->pw_uid != uid)
{
/* We're running under su, apparently. */
- socknamelen = local_sockname (sockname, socknamesize, tmpdirlen,
+ sock_status = local_sockname (s, sockname, tmpdirlen,
pw->pw_uid, server_name);
- if (socknamelen < 0)
+ if (sock_status == 0)
+ return s;
+ if (sock_status == ENAMETOOLONG)
{
message (true, "%s: socket-name %s... too long\n",
progname, sockname);
exit (EXIT_FAILURE);
}
-
- sock_status = socket_status (sockname, uid);
}
}
}
- if (sock_status == 0)
- {
- HSOCKET s = cloexec_socket (AF_UNIX, SOCK_STREAM, 0);
- if (s < 0)
- {
- message (true, "%s: socket: %s\n", progname, strerror (errno));
- return INVALID_SOCKET;
- }
- if (connect (s, &server.sa, sizeof server.un) != 0)
- {
- message (true, "%s: connect: %s\n", progname, strerror (errno));
- CLOSE_SOCKET (s);
- return INVALID_SOCKET;
- }
+ close (s);
- struct stat connect_stat;
- if (fstat (s, &connect_stat) != 0)
- sock_status = errno;
- else if (connect_stat.st_uid == uid)
- return s;
- else
- sock_status = -1;
-
- CLOSE_SOCKET (s);
- }
-
- if (sock_status < 0)
- message (true, "%s: Invalid socket owner\n", progname);
+ if (sock_status == -1)
+ message (true,
+ "%s: Invalid permissions on parent directory of socket: %s\n",
+ progname, sockname);
else if (sock_status == ENOENT)
{
if (tmpdir_used)
@@ -1502,7 +1570,7 @@ set_local_socket (char const *server_name)
}
}
else
- message (true, "%s: can't stat %s: %s\n",
+ message (true, "%s: can't connect to %s: %s\n",
progname, sockname, strerror (sock_status));
return INVALID_SOCKET;
diff --git a/lib-src/etags.c b/lib-src/etags.c
index b5c18e0e019..88b49f803e9 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -142,7 +142,14 @@ University of California, as described above. */
# define CTAGS false
#endif
-/* Copy to DEST from SRC (containing LEN bytes), and append a NUL byte. */
+/* Define MERCURY_HEURISTICS_RATIO as it was necessary to disambiguate
+ Mercury from Objective C, which have same file extensions .m
+ See comments before function test_objc_is_mercury for details. */
+#ifndef MERCURY_HEURISTICS_RATIO
+# define MERCURY_HEURISTICS_RATIO 0.5
+#endif
+
+/* COPY to DEST from SRC (containing LEN bytes), and append a NUL byte. */
static void
memcpyz (void *dest, void const *src, ptrdiff_t len)
{
@@ -333,7 +340,6 @@ typedef struct regexp
struct re_pattern_buffer *pat; /* the compiled pattern */
struct re_registers regs; /* re registers */
bool error_signaled; /* already signaled for this regexp */
- bool force_explicit_name; /* do not allow implicit tag name */
bool ignore_case; /* ignore case when matching */
bool multi_line; /* do a multi-line match on the whole file */
} regexp;
@@ -359,6 +365,7 @@ static void HTML_labels (FILE *);
static void Lisp_functions (FILE *);
static void Lua_functions (FILE *);
static void Makefile_targets (FILE *);
+static void Mercury_functions (FILE *);
static void Pascal_functions (FILE *);
static void Perl_functions (FILE *);
static void PHP_functions (FILE *);
@@ -366,6 +373,7 @@ static void PS_functions (FILE *);
static void Prolog_functions (FILE *);
static void Python_functions (FILE *);
static void Ruby_functions (FILE *);
+static void Rust_entries (FILE *);
static void Scheme_functions (FILE *);
static void TeX_commands (FILE *);
static void Texinfo_nodes (FILE *);
@@ -378,6 +386,7 @@ static ptrdiff_t 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 test_objc_is_mercury (char *, language **);
static void analyze_regex (char *);
static void free_regexps (void);
@@ -683,10 +692,22 @@ static const char Makefile_help [] =
"In makefiles, targets are tags; additionally, variables are tags\n\
unless you specify '--no-globals'.";
+/* Mercury and Objective C share the same .m file extensions. */
+static const char *Mercury_suffixes [] =
+ {"m",
+ NULL};
+static const char Mercury_help [] =
+ "In Mercury code, tags are all declarations beginning a line with ':-'\n\
+and optionally Prolog-like definitions (first rule for a predicate or \
+function).\n\
+To enable this behavior, run etags using --declarations.";
+static bool with_mercury_definitions = false;
+float mercury_heuristics_ratio = MERCURY_HEURISTICS_RATIO;
+
static const char *Objc_suffixes [] =
- { "lm", /* Objective lex file */
- "m", /* Objective C file */
- NULL };
+ { "lm", /* Objective lex file */
+ "m", /* By default, Objective C file will be assumed. */
+ NULL};
static const char Objc_help [] =
"In Objective C code, tags include Objective C definitions for classes,\n\
class categories, methods and protocols. Tags for variables and\n\
@@ -752,6 +773,12 @@ a line generate a tag. Constants also generate a tag.";
static const char *Ruby_interpreters [] =
{ "ruby", NULL };
+static const char *Rust_suffixes [] =
+ { "rs", NULL };
+static const char Rust_help [] =
+ "In Rust code, tags anything defined with 'fn', 'enum', \n\
+'struct' or 'macro_rules!'.";
+
/* Can't do the `SCM' or `scm' prefix with a version number. */
static const char *Scheme_suffixes [] =
{ "oak", "sch", "scheme", "SCM", "scm", "SM", "sm", "ss", "t", NULL };
@@ -824,7 +851,9 @@ static language lang_names [] =
{ "lisp", Lisp_help, Lisp_functions, Lisp_suffixes },
{ "lua", Lua_help,Lua_functions,Lua_suffixes,NULL,Lua_interpreters},
{ "makefile", Makefile_help,Makefile_targets,NULL,Makefile_filenames},
+ /* objc listed before mercury as it is a better default for .m extensions. */
{ "objc", Objc_help, plain_C_entries, Objc_suffixes },
+ { "mercury", Mercury_help, Mercury_functions, Mercury_suffixes },
{ "pascal", Pascal_help, Pascal_functions, Pascal_suffixes },
{ "perl",Perl_help,Perl_functions,Perl_suffixes,NULL,Perl_interpreters},
{ "php", PHP_help, PHP_functions, PHP_suffixes },
@@ -836,6 +865,7 @@ static language lang_names [] =
NULL, Python_interpreters },
{ "ruby", Ruby_help, Ruby_functions, Ruby_suffixes,
Ruby_filenames, Ruby_interpreters },
+ { "rust", Rust_help, Rust_entries, Rust_suffixes },
{ "scheme", Scheme_help, Scheme_functions, Scheme_suffixes },
{ "tex", TeX_help, TeX_commands, TeX_suffixes },
{ "texinfo", Texinfo_help, Texinfo_nodes, Texinfo_suffixes },
@@ -950,6 +980,9 @@ Relative ones are stored relative to the output file's directory.\n");
puts
("\tand create tags for extern variables unless --no-globals is used.");
+ puts ("In Mercury, tag both declarations starting a line with ':-' and first\n\
+ predicates or functions in clauses.");
+
if (CTAGS)
puts ("-d, --defines\n\
Create tag entries for C #define constants and enum constants, too.");
@@ -1775,6 +1808,11 @@ find_entries (FILE *inf)
if (parser == NULL)
{
lang = get_language_from_filename (curfdp->infname, true);
+
+ /* Disambiguate file names between Objc and Mercury. */
+ if (lang != NULL && strcmp (lang->name, "objc") == 0)
+ test_objc_is_mercury (curfdp->infname, &lang);
+
if (lang != NULL && lang->function != NULL)
{
curfdp->lang = lang;
@@ -5021,6 +5059,49 @@ Ruby_functions (FILE *inf)
/*
+ * Rust support
+ * Look for:
+ * - fn: Function
+ * - struct: Structure
+ * - enum: Enumeration
+ * - macro_rules!: Macro
+ */
+static void
+Rust_entries (FILE *inf)
+{
+ char *cp, *name;
+ bool is_func = false;
+
+ LOOP_ON_INPUT_LINES(inf, lb, cp)
+ {
+ cp = skip_spaces(cp);
+ name = cp;
+
+ // Skip 'pub' keyworld
+ (void)LOOKING_AT (cp, "pub");
+
+ // Look for define
+ if ((is_func = LOOKING_AT (cp, "fn"))
+ || LOOKING_AT (cp, "enum")
+ || LOOKING_AT (cp, "struct")
+ || (is_func = LOOKING_AT (cp, "macro_rules!")))
+ {
+ cp = skip_spaces (cp);
+ name = cp;
+
+ while (!notinname (*cp))
+ cp++;
+
+ make_tag (name, cp - name, is_func,
+ lb.buffer, cp - lb.buffer + 1,
+ lineno, linecharno);
+ is_func = false;
+ }
+ }
+}
+
+
+/*
* PHP support
* Look for:
* - /^[ \t]*function[ \t\n]+[^ \t\n(]+/
@@ -5999,10 +6080,10 @@ prolog_atom (char *s, size_t pos)
pos++;
if (s[pos] != '\'')
break;
- pos++; /* A double quote */
+ pos++; /* A double quote */
}
else if (s[pos] == '\0')
- /* Multiline quoted atoms are ignored. */
+ /* Multiline quoted atoms are ignored. */
return 0;
else if (s[pos] == '\\')
{
@@ -6021,6 +6102,510 @@ prolog_atom (char *s, size_t pos)
/*
+ * Support for Mercury
+ *
+ * Assumes that the declarations start at column 0.
+ * Original code by Sunichirou Sugou (1989) for Prolog.
+ * Rewritten by Anders Lindgren (1996) for Prolog.
+ * Adapted by Fabrice Nicol (2021) for Mercury.
+ * Note: Prolog-support behavior is preserved if
+ * --declarations is used, corresponding to
+ * with_mercury_definitions=true.
+ */
+
+static ptrdiff_t mercury_pr (char *, char *, ptrdiff_t);
+static void mercury_skip_comment (linebuffer *, FILE *);
+static bool is_mercury_type = false;
+static bool is_mercury_quantifier = false;
+static bool is_mercury_declaration = false;
+typedef struct
+{
+ size_t pos; /* Position reached in parsing tag name. */
+ size_t namelength; /* Length of tag name */
+ size_t totlength; /* Total length of parsed tag: this field is currently
+ reserved for control and debugging. */
+} mercury_pos_t;
+
+/*
+ * Objective-C and Mercury have identical file extension .m.
+ * To disambiguate between Objective C and Mercury, parse file
+ * with the following heuristics hook:
+ * - if line starts with :-, choose Mercury unconditionally;
+ * - if line starts with #, @, choose Objective-C;
+ * - otherwise compute the following ratio:
+ *
+ * r = (number of lines with :-
+ * or % in non-commented parts or . at trimmed EOL)
+ * / (number of lines - number of lines starting by any amount
+ * of whitespace, optionally followed by comment(s))
+ *
+ * Note: strings are neglected in counts.
+ *
+ * If r > mercury_heuristics_ratio, choose Mercury.
+ * Experimental tests show that a possibly optimal default value for
+ * this floor value is around 0.5. This is the default value for
+ * MERCURY_HEURISTICS_RATIO, defined in the first lines of this file.
+ * The closer r is to 0.5, the closer the source code to pure Prolog.
+ * Idiomatic Mercury is scored either with r = 1.0 or higher.
+ * Objective-C is scored with r = 0.0. When this fails, the r-score
+ * never rose above 0.1 in Objective-C tests.
+ */
+
+static void
+test_objc_is_mercury (char *this_file, language **lang)
+{
+ if (this_file == NULL) return;
+ FILE* fp = fopen (this_file, "r");
+ if (fp == NULL)
+ pfatal (this_file);
+
+ bool blank_line = false; /* Line starting with any amount of white space
+ followed by optional comment(s). */
+ bool commented_line = false;
+ bool found_dot = false;
+ bool only_space_before = true;
+ bool start_of_line = true;
+ int c;
+ intmax_t lines = 1;
+ intmax_t mercury_dots = 0;
+ intmax_t percentage_signs = 0;
+ intmax_t rule_signs = 0;
+ float ratio = 0;
+
+ while ((c = fgetc (fp)) != EOF)
+ {
+ switch (c)
+ {
+ case '\n':
+ if (! blank_line) ++lines;
+ blank_line = true;
+ commented_line = false;
+ start_of_line = true;
+ if (found_dot) ++mercury_dots;
+ found_dot = false;
+ only_space_before = true;
+ break;
+ case '.':
+ found_dot = ! commented_line;
+ only_space_before = false;
+ break;
+ case '%': /* More frequent in Mercury. May be modulo in Obj.-C. */
+ if (! commented_line)
+ {
+ ++percentage_signs;
+ /* Cannot tell if it is a comment or modulo yet for sure.
+ Yet works for heuristic purposes. */
+ commented_line = true;
+ }
+ found_dot = false;
+ start_of_line = false;
+ only_space_before = false;
+ break;
+ case '/':
+ {
+ int d = fgetc (fp);
+ found_dot = false;
+ only_space_before = false;
+ if (! commented_line)
+ {
+ if (d == '*')
+ commented_line = true;
+ else
+ /* If d == '/', cannot tell if it is an Obj.-C comment:
+ may be Mercury integ. division. */
+ blank_line = false;
+ }
+ }
+ FALLTHROUGH;
+ case ' ':
+ case '\t':
+ start_of_line = false;
+ break;
+ case ':':
+ c = fgetc (fp);
+ if (start_of_line)
+ {
+ if (c == '-')
+ {
+ ratio = 1.0; /* Failsafe, not an operator in Obj.-C. */
+ goto out;
+ }
+ start_of_line = false;
+ }
+ else
+ {
+ /* p :- q. Frequent in Mercury.
+ Rare or in quoted exprs in Obj.-C. */
+ if (c == '-' && ! commented_line)
+ ++rule_signs;
+ }
+ blank_line = false;
+ found_dot = false;
+ only_space_before = false;
+ break;
+ case '@':
+ case '#':
+ if (start_of_line || only_space_before)
+ {
+ ratio = 0.0;
+ goto out;
+ }
+ FALLTHROUGH;
+ default:
+ start_of_line = false;
+ blank_line = false;
+ found_dot = false;
+ only_space_before = false;
+ }
+ }
+
+ /* Fallback heuristic test. Not failsafe but errless in pratice. */
+ ratio = ((float) rule_signs + percentage_signs + mercury_dots) / lines;
+
+ out:
+ if (fclose (fp) == EOF)
+ pfatal (this_file);
+
+ if (ratio > mercury_heuristics_ratio)
+ {
+ /* Change the language from Objective-C to Mercury. */
+ static language lang0 = { "mercury", Mercury_help, Mercury_functions,
+ Mercury_suffixes };
+ *lang = &lang0;
+ }
+}
+
+static void
+Mercury_functions (FILE *inf)
+{
+ char *cp, *last = NULL;
+ ptrdiff_t lastlen = 0, allocated = 0;
+ if (declarations) with_mercury_definitions = true;
+
+ LOOP_ON_INPUT_LINES (inf, lb, cp)
+ {
+ if (cp[0] == '\0') /* Empty line. */
+ continue;
+ else if (c_isspace (cp[0]) || cp[0] == '%')
+ /* A Prolog-type comment or anything other than a declaration. */
+ continue;
+ else if (cp[0] == '/' && cp[1] == '*') /* Mercury C-type comment. */
+ mercury_skip_comment (&lb, inf);
+ else
+ {
+ is_mercury_declaration = (cp[0] == ':' && cp[1] == '-');
+
+ if (is_mercury_declaration
+ || with_mercury_definitions)
+ {
+ ptrdiff_t len = mercury_pr (cp, last, lastlen);
+ if (0 < len)
+ {
+ /* Store the declaration to avoid generating duplicate
+ tags later. */
+ if (allocated <= len)
+ {
+ xrnew (last, len + 1, 1);
+ allocated = len + 1;
+ }
+ memcpyz (last, cp, len);
+ lastlen = len;
+ }
+ }
+ }
+ }
+ free (last);
+}
+
+static void
+mercury_skip_comment (linebuffer *plb, FILE *inf)
+{
+ char *cp;
+
+ do
+ {
+ for (cp = plb->buffer; *cp != '\0'; ++cp)
+ if (cp[0] == '*' && cp[1] == '/')
+ return;
+ readline (plb, inf);
+ }
+ while (perhaps_more_input (inf));
+}
+
+/*
+ * A declaration is added if it matches:
+ * <beginning of line>:-<whitespace><Mercury Term><whitespace>(
+ * If with_mercury_definitions == true, we also add:
+ * <beginning of line><Mercury item><whitespace>(
+ * or <beginning of line><Mercury item><whitespace>:-
+ * As for Prolog support, different arities and types are not taken into
+ * consideration.
+ * Item is added to the tags database if it doesn't match the
+ * name of the previous declaration.
+ *
+ * Consume a Mercury declaration.
+ * Return the number of bytes consumed, or 0 if there was an error.
+ *
+ * A Mercury declaration must be one of:
+ * :- type
+ * :- solver type
+ * :- pred
+ * :- func
+ * :- inst
+ * :- mode
+ * :- typeclass
+ * :- instance
+ * :- pragma
+ * :- promise
+ * :- initialise
+ * :- finalise
+ * :- mutable
+ * :- module
+ * :- interface
+ * :- implementation
+ * :- import_module
+ * :- use_module
+ * :- include_module
+ * :- end_module
+ * followed on the same line by an alphanumeric sequence, starting with a lower
+ * case letter or by a single-quoted arbitrary string.
+ * Single quotes can escape themselves. Backslash quotes everything.
+ *
+ * Return the size of the name of the declaration or 0 if no header was found.
+ * As quantifiers may precede functions or predicates, we must list them too.
+ */
+
+static const char *Mercury_decl_tags[] = {"type", "solver type", "pred",
+ "func", "inst", "mode", "typeclass", "instance", "pragma", "promise",
+ "initialise", "finalise", "mutable", "module", "interface", "implementation",
+ "import_module", "use_module", "include_module", "end_module", "some", "all"};
+
+static mercury_pos_t
+mercury_decl (char *s, size_t pos)
+{
+ mercury_pos_t null_pos = {0, 0, 0};
+
+ if (s == NULL) return null_pos;
+
+ size_t origpos;
+ origpos = pos;
+
+ while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_')) ++pos;
+
+ unsigned char decl_type_length = pos - origpos;
+ char buf[decl_type_length + 1];
+ memset (buf, 0, decl_type_length + 1);
+
+ /* Mercury declaration tags. Consume them, then check the declaration item
+ following :- is legitimate, then go on as in the prolog case. */
+
+ memcpy (buf, &s[origpos], decl_type_length);
+
+ bool found_decl_tag = false;
+
+ if (is_mercury_quantifier)
+ {
+ if (strcmp (buf, "pred") != 0 && strcmp (buf, "func") != 0) /* Bad syntax. */
+ return null_pos;
+
+ is_mercury_quantifier = false; /* Reset to base value. */
+ found_decl_tag = true;
+ }
+ else
+ {
+ for (int j = 0; j < sizeof (Mercury_decl_tags) / sizeof (char*); ++j)
+ {
+ if (strcmp (buf, Mercury_decl_tags[j]) == 0)
+ {
+ found_decl_tag = true;
+ if (strcmp (buf, "type") == 0)
+ is_mercury_type = true;
+
+ if (strcmp (buf, "some") == 0
+ || strcmp (buf, "all") == 0)
+ {
+ is_mercury_quantifier = true;
+ }
+
+ break; /* Found declaration tag of rank j. */
+ }
+ else
+ /* 'solver type' has a blank in the middle,
+ so this is the hard case. */
+ if (strcmp (buf, "solver") == 0)
+ {
+ ++pos;
+ while (s + pos != NULL && (c_isalnum (s[pos]) || s[pos] == '_'))
+ ++pos;
+
+ decl_type_length = pos - origpos;
+ char buf2[decl_type_length + 1];
+ memset (buf2, 0, decl_type_length + 1);
+ memcpy (buf2, &s[origpos], decl_type_length);
+
+ if (strcmp (buf2, "solver type") == 0)
+ {
+ found_decl_tag = false;
+ break; /* Found declaration tag of rank j. */
+ }
+ }
+ }
+ }
+
+ /* If with_mercury_definitions == false
+ * this is a Mercury syntax error, ignoring... */
+
+ if (with_mercury_definitions)
+ {
+ if (found_decl_tag)
+ pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */
+ else
+ /* Prolog-like behavior
+ * we have parsed the predicate once, yet inappropriately
+ * so restarting again the parsing step. */
+ pos = 0;
+ }
+ else
+ {
+ if (found_decl_tag)
+ pos = skip_spaces (s + pos) - s; /* Skip len blanks again. */
+ else
+ return null_pos;
+ }
+
+ /* From now on it is the same as for Prolog except for module dots. */
+
+ size_t start_of_name = pos;
+
+ if (c_islower (s[pos]) || s[pos] == '_' )
+ {
+ /* The name is unquoted.
+ Do not confuse module dots with end-of-declaration dots. */
+ int module_dot_pos = 0;
+
+ while (c_isalnum (s[pos])
+ || s[pos] == '_'
+ || (s[pos] == '.' /* A module dot. */
+ && s + pos + 1 != NULL
+ && (c_isalnum (s[pos + 1]) || s[pos + 1] == '_')
+ && (module_dot_pos = pos))) /* Record module dot position.
+ Erase module from name. */
+ ++pos;
+
+ if (module_dot_pos)
+ {
+ start_of_name = module_dot_pos + 2;
+ ++pos;
+ }
+
+ mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos};
+ return position;
+ }
+ else if (s[pos] == '\'')
+ {
+ ++pos;
+ for (;;)
+ {
+ if (s[pos] == '\'')
+ {
+ ++pos;
+ if (s[pos] != '\'')
+ break;
+ ++pos; /* A double quote. */
+ }
+ else if (s[pos] == '\0') /* Multiline quoted atoms are ignored. */
+ return null_pos;
+ else if (s[pos] == '\\')
+ {
+ if (s[pos+1] == '\0')
+ return null_pos;
+ pos += 2;
+ }
+ else
+ ++pos;
+ }
+
+ mercury_pos_t position = {pos, pos - start_of_name + 1, pos - origpos};
+ return position;
+ }
+ else if (is_mercury_quantifier && s[pos] == '[') /* :- some [T] pred/func. */
+ {
+ for (++pos; s + pos != NULL && s[pos] != ']'; ++pos) {}
+ if (s + pos == NULL) return null_pos;
+ ++pos;
+ pos = skip_spaces (s + pos) - s;
+ mercury_pos_t position = mercury_decl (s, pos);
+ position.totlength += pos - origpos;
+ return position;
+ }
+ else if (s[pos] == '.') /* as in ':- interface.' */
+ {
+ mercury_pos_t position = {pos, pos - origpos + 1, pos - origpos};
+ return position;
+ }
+ else
+ return null_pos;
+}
+
+static ptrdiff_t
+mercury_pr (char *s, char *last, ptrdiff_t lastlen)
+{
+ size_t len0 = 0;
+ is_mercury_type = false;
+ is_mercury_quantifier = false;
+ bool stop_at_rule = false;
+
+ if (is_mercury_declaration)
+ {
+ /* Skip len0 blanks only for declarations. */
+ len0 = skip_spaces (s + 2) - s;
+ }
+
+ mercury_pos_t position = mercury_decl (s, len0);
+ size_t pos = position.pos;
+ int offset = 0; /* may be < 0 */
+ if (pos == 0) return 0;
+
+ /* Skip white space for:
+ a. rules in definitions before :-
+ b. 0-arity predicates with inlined modes.
+ c. possibly multiline type definitions */
+
+ while (c_isspace (s[pos])) { ++pos; ++offset; }
+
+ if (( ((s[pos] == '.' && (pos += 1)) /* case 1
+ This is a statement dot,
+ not a module dot. */
+ || c_isalnum(s[pos]) /* 0-arity procedures */
+ || (s[pos] == '(' && (pos += 1)) /* case 2: arity > 0 */
+ || ((s[pos] == ':') /* case 3: rules */
+ && s[pos + 1] == '-' && (stop_at_rule = true)))
+ && (lastlen != pos || memcmp (s, last, pos) != 0)
+ )
+ /* Types are often declared on several lines so keeping just
+ the first line. */
+
+ || is_mercury_type) /* When types are implemented. */
+ {
+ size_t namelength = position.namelength;
+ if (stop_at_rule && offset) --offset;
+
+ /* Left-trim type definitions. */
+
+ while (pos > namelength + offset
+ && c_isspace (s[pos - namelength - offset]))
+ --offset;
+
+ make_tag (s + pos - namelength - offset, namelength - 1, true,
+ s, pos - offset - 1, lineno, linecharno);
+ return pos;
+ }
+
+ return 0;
+}
+
+
+/*
* Support for Erlang
*
* Generates tags for functions, defines, and records.
@@ -6324,7 +6909,6 @@ add_regex (char *regexp_pattern, language *lang)
struct re_pattern_buffer *patbuf;
regexp *rp;
bool
- force_explicit_name = true, /* do not use implicit tag names */
ignore_case = false, /* case is significant */
multi_line = false, /* matches are done one line at a time */
single_line = false; /* dot does not match newline */
@@ -6363,7 +6947,8 @@ add_regex (char *regexp_pattern, language *lang)
case 'N':
if (modifiers == name)
error ("forcing explicit tag name but no name, ignoring");
- force_explicit_name = true;
+ /* This option has no effect and is present only for backward
+ compatibility. */
break;
case 'i':
ignore_case = true;
@@ -6418,7 +7003,6 @@ add_regex (char *regexp_pattern, language *lang)
p_head->pat = patbuf;
p_head->name = savestr (name);
p_head->error_signaled = false;
- p_head->force_explicit_name = force_explicit_name;
p_head->ignore_case = ignore_case;
p_head->multi_line = multi_line;
}
@@ -6558,20 +7142,15 @@ regex_tag_multiline (void)
name = NULL;
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);
-
- if (debug)
- fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
- name ? name : "(unnamed)", curfdp->taggedfname,
- lineno, buffer + linecharno);
- }
- else
- make_tag (name, strlen (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:%"PRIdMAX": %s\n",
+ name ? name : "(unnamed)", curfdp->taggedfname,
+ lineno, buffer + linecharno);
break;
}
}
@@ -6885,18 +7464,14 @@ readline (linebuffer *lbp, FILE *stream)
name = NULL;
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);
- if (debug)
- fprintf (stderr, "%s on %s:%"PRIdMAX": %s\n",
- name ? name : "(unnamed)", curfdp->taggedfname,
- lineno, lbp->buffer);
- }
- else
- make_tag (name, strlen (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:%"PRIdMAX": %s\n",
+ name ? name : "(unnamed)", curfdp->taggedfname,
+ lineno, lbp->buffer);
break;
}
}
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index cfdebccb8d0..e683da179df 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -270,6 +270,7 @@ main (int argc, char **argv)
You might also wish to verify that your system is one which
uses lock files for this purpose. Some systems use other methods. */
+ bool lockname_unlinked = false;
inname_len = strlen (inname);
lockname = xmalloc (inname_len + sizeof ".lock");
strcpy (lockname, inname);
@@ -312,15 +313,10 @@ main (int argc, char **argv)
Five minutes should be good enough to cope with crashes
and wedgitude, and long enough to avoid being fooled
by time differences between machines. */
- if (stat (lockname, &st) >= 0)
- {
- time_t now = time (0);
- if (st.st_ctime < now - 300)
- {
- unlink (lockname);
- lockname = 0;
- }
- }
+ if (!lockname_unlinked
+ && stat (lockname, &st) == 0
+ && st.st_ctime < time (0) - 300)
+ lockname_unlinked = unlink (lockname) == 0 || errno == ENOENT;
}
delete_lockname = lockname;
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
new file mode 100644
index 00000000000..dc568e035b5
--- /dev/null
+++ b/lib-src/seccomp-filter.c
@@ -0,0 +1,370 @@
+/* Generate a Secure Computing filter definition file.
+
+Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation, either version 3 of the License, or (at your
+option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see
+<https://www.gnu.org/licenses/>. */
+
+/* This program creates a small Secure Computing filter usable for a
+typical minimal Emacs sandbox. See the man page for `seccomp' for
+details about Secure Computing filters. This program requires the
+`libseccomp' library. However, the resulting filter file requires
+only a Linux kernel supporting the Secure Computing extension.
+
+Usage:
+
+ seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc
+
+This writes the raw `struct sock_filter' array to out.bpf and a
+human-readable representation to out.pfc. Additionally, it writes
+variants of those files that can be used to sandbox Emacs before
+'execve' to out-exec.bpf and out-exec.pfc. */
+
+#include "config.h"
+
+#include <assert.h>
+#include <errno.h>
+#include <limits.h>
+#include <stdarg.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <time.h>
+
+#include <asm/prctl.h>
+#include <sys/ioctl.h>
+#include <sys/mman.h>
+#include <sys/prctl.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <linux/futex.h>
+#include <linux/filter.h>
+#include <linux/seccomp.h>
+#include <fcntl.h>
+#include <sched.h>
+#include <seccomp.h>
+#include <unistd.h>
+
+#include "verify.h"
+
+#ifndef ARCH_CET_STATUS
+#define ARCH_CET_STATUS 0x3001
+#endif
+
+static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void
+fail (int error, const char *format, ...)
+{
+ va_list ap;
+ va_start (ap, format);
+ if (error == 0)
+ {
+ vfprintf (stderr, format, ap);
+ fputc ('\n', stderr);
+ }
+ else
+ {
+ char buffer[1000];
+ vsnprintf (buffer, sizeof buffer, format, ap);
+ errno = error;
+ perror (buffer);
+ }
+ va_end (ap);
+ fflush (NULL);
+ exit (EXIT_FAILURE);
+}
+
+/* This binary is trivial, so we use a single global filter context
+ object that we release using `atexit'. */
+
+static scmp_filter_ctx ctx;
+
+static void
+release_context (void)
+{
+ seccomp_release (ctx);
+}
+
+/* Wrapper functions and macros for libseccomp functions. We exit
+ immediately upon any error to avoid error checking noise. */
+
+static void
+set_attribute (enum scmp_filter_attr attr, uint32_t value)
+{
+ int status = seccomp_attr_set (ctx, attr, value);
+ if (status < 0)
+ fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value);
+}
+
+/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you
+ don't have to specify the number of comparator arguments, and any
+ failure will exit the process. */
+
+#define RULE(action, syscall, ...) \
+ do \
+ { \
+ const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \
+ enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \
+ int status = seccomp_rule_add_array (ctx, (action), (syscall), \
+ arg_cnt, arg_array); \
+ if (status < 0) \
+ fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \
+ #action, #syscall, arg_cnt, #__VA_ARGS__); \
+ } \
+ while (false)
+
+static void
+export_filter (const char *file,
+ int (*function) (const scmp_filter_ctx, int),
+ const char *name)
+{
+ int fd = TEMP_FAILURE_RETRY (
+ open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC,
+ 0644));
+ if (fd < 0)
+ fail (errno, "open %s", file);
+ int status = function (ctx, fd);
+ if (status < 0)
+ fail (-status, "%s", name);
+ if (close (fd) != 0)
+ fail (errno, "close");
+}
+
+#define EXPORT_FILTER(file, function) \
+ export_filter ((file), (function), #function)
+
+int
+main (int argc, char **argv)
+{
+ if (argc != 5)
+ fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc",
+ argv[0]);
+
+ /* Any unhandled syscall should abort the Emacs process. */
+ ctx = seccomp_init (SCMP_ACT_KILL_PROCESS);
+ if (ctx == NULL)
+ fail (0, "seccomp_init");
+ atexit (release_context);
+
+ /* We want to abort immediately if the architecture is unknown. */
+ set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS);
+ set_attribute (SCMP_FLTATR_CTL_NNP, 1);
+ set_attribute (SCMP_FLTATR_CTL_TSYNC, 1);
+
+ verify (CHAR_BIT == 8);
+ verify (sizeof (int) == 4 && INT_MIN == INT32_MIN
+ && INT_MAX == INT32_MAX);
+ verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN
+ && LONG_MAX == INT64_MAX);
+ verify (sizeof (void *) == 8);
+ assert ((uintptr_t) NULL == 0);
+
+ /* Allow a clean exit. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group));
+
+ /* Allow `mmap' and friends. This is necessary for dynamic loading,
+ reading the portable dump file, and thread creation. We don't
+ allow pages to be both writable and executable. */
+ verify (MAP_PRIVATE != 0);
+ verify (MAP_SHARED != 0);
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(PROT_NONE | PROT_READ | PROT_WRITE)),
+ /* Only support known flags. MAP_DENYWRITE is ignored, but
+ some versions of the dynamic loader still use it. Also
+ allow allocating thread stacks. */
+ SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
+ ~(MAP_SHARED | MAP_PRIVATE | MAP_FILE
+ | MAP_ANONYMOUS | MAP_FIXED | MAP_DENYWRITE
+ | MAP_STACK | MAP_NORESERVE),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap),
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(PROT_NONE | PROT_READ | PROT_EXEC)),
+ /* Only support known flags. MAP_DENYWRITE is ignored, but
+ some versions of the dynamic loader still use it. */
+ SCMP_A3_32 (SCMP_CMP_MASKED_EQ,
+ ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED
+ | MAP_DENYWRITE),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect),
+ /* Don't allow making pages executable. */
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(PROT_NONE | PROT_READ | PROT_WRITE), 0));
+
+ /* Futexes are used everywhere. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex),
+ SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE));
+
+ /* Allow basic dynamic memory management. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk));
+
+ /* Allow some status inquiries. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp));
+
+ /* Allow operations on open file descriptors. File descriptors are
+ capabilities, and operating on them shouldn't cause security
+ issues. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (read));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (write));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (close));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat));
+
+ /* Allow read operations on the filesystem. If necessary, these
+ should be further restricted using mount namespaces. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (access));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd));
+
+ /* Allow opening files, assuming they are only opened for
+ reading. */
+ verify (O_WRONLY != 0);
+ verify (O_RDWR != 0);
+ verify (O_CREAT != 0);
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (open),
+ SCMP_A1_32 (SCMP_CMP_MASKED_EQ,
+ ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
+ | O_DIRECTORY | O_NOFOLLOW),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat),
+ SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
+ ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH
+ | O_DIRECTORY | O_NOFOLLOW),
+ 0));
+
+ /* Allow `tcgetpgrp'. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO),
+ SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP));
+
+ /* Allow reading (but not setting) file flags. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl),
+ SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64),
+ SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL));
+
+ /* Allow reading random numbers from the kernel. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom));
+
+ /* Changing the umask is uncritical. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask));
+
+ /* Allow creation of pipes. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2));
+
+ /* Allow reading (but not changing) resource limits. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64),
+ SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
+ SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */);
+
+ /* Block changing resource limits, but don't crash. */
+ RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64),
+ SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */,
+ SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */);
+
+ /* Emacs installs signal handlers, which is harmless. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask));
+
+ /* Allow reading the current time. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime),
+ SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (time));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday));
+
+ /* Allow timer support. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create));
+
+ /* Allow thread creation. See the NOTES section in the manual page
+ for the `clone' function. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone),
+ SCMP_A0_64 (SCMP_CMP_MASKED_EQ,
+ /* Flags needed to create threads. See
+ create_thread in libc. */
+ ~(CLONE_VM | CLONE_FS | CLONE_FILES
+ | CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD
+ | CLONE_SETTLS | CLONE_PARENT_SETTID
+ | CLONE_CHILD_CLEARTID),
+ 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list));
+
+ /* Allow setting the process name for new threads. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME));
+
+ /* Allow some event handling functions used by glib. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll));
+
+ /* Don't allow creating sockets (network access would be extremely
+ dangerous), but also don't crash. */
+ RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket));
+
+ EXPORT_FILTER (argv[1], seccomp_export_bpf);
+ EXPORT_FILTER (argv[2], seccomp_export_pfc);
+
+ /* When applying a Seccomp filter before executing the Emacs binary
+ (e.g. using the `bwrap' program), we need to allow further system
+ calls. Firstly, the wrapper binary will need to `execve' the
+ Emacs binary. Furthermore, the C library requires some system
+ calls at startup time to set up thread-local storage. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS));
+ RULE (SCMP_ACT_ERRNO (EINVAL), SCMP_SYS (arch_prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, ARCH_CET_STATUS));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs));
+
+ /* We want to allow starting the Emacs binary itself with the
+ --seccomp flag, so we need to allow the `prctl' and `seccomp'
+ system calls. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl),
+ SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS),
+ SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0),
+ SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp),
+ SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER),
+ SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC));
+
+ EXPORT_FILTER (argv[3], seccomp_export_bpf);
+ EXPORT_FILTER (argv[4], seccomp_export_pfc);
+}
diff --git a/lib/Makefile.in b/lib/Makefile.in
index 91a6b5ff3f1..ccb90c3d1b3 100644
--- a/lib/Makefile.in
+++ b/lib/Makefile.in
@@ -29,26 +29,9 @@ top_srcdir = @top_srcdir@
all:
.PHONY: all
-# 'make' verbosity.
-AM_V_AR = $(am__v_AR_@AM_V@)
-am__v_AR_ = $(am__v_AR_@AM_DEFAULT_V@)
-am__v_AR_0 = @echo " AR " $@;
-am__v_AR_1 =
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
+
+HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
ALL_CFLAGS= \
$(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) $(DEPFLAGS) \
@@ -56,6 +39,10 @@ ALL_CFLAGS= \
-I. -I../src -I$(srcdir) -I$(srcdir)/../src \
$(if $(patsubst e-%,,$(notdir $<)),,-Demacs)
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ALL_CFLAGS += -DGL_COMPILE_CRYPTO_STREAM
+endif
+
SYSTEM_TYPE = @SYSTEM_TYPE@
ifeq ($(SYSTEM_TYPE),windows-nt)
include $(srcdir)/../nt/gnulib-cfg.mk
@@ -77,12 +64,14 @@ endif
../config.status: $(top_srcdir)/configure.ac $(top_srcdir)/m4/*.m4
$(MAKE) -C .. $(notdir $@)
Makefile: ../config.status $(srcdir)/Makefile.in
- $(MAKE) -C .. src/$@
+ $(MAKE) -C .. lib/$@
# Object modules that need not be built for Emacs.
# Emacs does not need e-regex.o (it has its own regex-emacs.c),
# and building it would just waste time.
-not_emacs_OBJECTS = regex.o
+# Emacs also doesn't need the dynarray-related files in malloc/ and
+# the replacement 'free'.
+not_emacs_OBJECTS = regex.o malloc/%.o free.o
libgnu_a_OBJECTS = fingerprint.o $(gl_LIBOBJS) \
$(patsubst %.c,%.o,$(filter %.c,$(libgnu_a_SOURCES)))
@@ -126,8 +115,7 @@ distclean bootstrap-clean: mostlyclean
rm -fr $(DEPDIR)
maintainer-clean: distclean
rm -f TAGS gnulib.mk
-extraclean: distclean
- -rmdir malloc sys 2>/dev/null
+ -rmdir malloc sys 2>/dev/null || true
.PHONY: mostlyclean clean distclean bootstrap-clean maintainer-clean
diff --git a/lib/af_alg.h b/lib/af_alg.h
new file mode 100644
index 00000000000..4c5854cc99b
--- /dev/null
+++ b/lib/af_alg.h
@@ -0,0 +1,115 @@
+/* af_alg.h - Compute message digests from file streams and buffers.
+ Copyright (C) 2018-2020 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 2, 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 Matteo Croce <mcroce@redhat.com>, 2018.
+ Documentation by Bruno Haible <bruno@clisp.org>, 2018. */
+
+/* Declare specific functions for computing message digests
+ using the Linux kernel crypto API, if available. This kernel API gives
+ access to specialized crypto instructions (that would also be available
+ in user space) or to crypto devices (not directly available in user space).
+
+ For a more complete set of facilities that use the Linux kernel crypto API,
+ look at libkcapi. */
+
+#ifndef AF_ALG_H
+# define AF_ALG_H 1
+
+# include <stdio.h>
+# include <errno.h>
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+# if USE_LINUX_CRYPTO_API
+
+/* Compute a message digest of a memory region.
+
+ The memory region starts at BUFFER and is LEN bytes long.
+
+ ALG is the message digest algorithm; see the file /proc/crypto.
+
+ RESBLOCK points to a block of HASHLEN bytes, for the result.
+ HASHLEN must be the length of the message digest, in bytes, in particular:
+
+ alg | hashlen
+ -------+--------
+ md5 | 16
+ sha1 | 20
+ sha224 | 28
+ sha256 | 32
+ sha384 | 48
+ sha512 | 64
+
+ If successful, fill RESBLOCK and return 0.
+ Upon failure, return a negated error number. */
+int
+afalg_buffer (const char *buffer, size_t len, const char *alg,
+ void *resblock, ssize_t hashlen);
+
+/* Compute a message digest of data read from STREAM.
+
+ STREAM is an open file stream. The last operation on STREAM should
+ not be 'ungetc', and if STREAM is also open for writing it should
+ have been fflushed since its last write. Read from the current
+ position to the end of STREAM. Handle regular files efficiently.
+
+ ALG is the message digest algorithm; see the file /proc/crypto.
+
+ RESBLOCK points to a block of HASHLEN bytes, for the result.
+ HASHLEN must be the length of the message digest, in bytes, in particular:
+
+ alg | hashlen
+ -------+--------
+ md5 | 16
+ sha1 | 20
+ sha224 | 28
+ sha256 | 32
+ sha384 | 48
+ sha512 | 64
+
+ If successful, fill RESBLOCK and return 0.
+ Upon failure, return a negated error number.
+ Unless returning 0 or -EIO, restore STREAM's file position so that
+ the caller can fall back on some other method. */
+int
+afalg_stream (FILE *stream, const char *alg,
+ void *resblock, ssize_t hashlen);
+
+# else
+
+static inline int
+afalg_buffer (const char *buffer, size_t len, const char *alg,
+ void *resblock, ssize_t hashlen)
+{
+ return -EAFNOSUPPORT;
+}
+
+static inline int
+afalg_stream (FILE *stream, const char *alg,
+ void *resblock, ssize_t hashlen)
+{
+ return -EAFNOSUPPORT;
+}
+
+# endif
+
+# ifdef __cplusplus
+}
+# endif
+
+#endif /* AF_ALG_H */
diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c
new file mode 100644
index 00000000000..c667ae9d24a
--- /dev/null
+++ b/lib/file-has-acl.c
@@ -0,0 +1,510 @@
+/* Test whether a file has a nontrivial ACL. -*- coding: utf-8 -*-
+
+ Copyright (C) 2002-2003, 2005-2020 Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+ Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
+
+/* Without this pragma, gcc 4.7.0 20120126 may suggest that the
+ file_has_acl function might be candidate for attribute 'const' */
+#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__
+# pragma GCC diagnostic ignored "-Wsuggest-attribute=const"
+#endif
+
+#include <config.h>
+
+#include "acl.h"
+
+#include "acl-internal.h"
+
+#if GETXATTR_WITH_POSIX_ACLS
+# include <sys/xattr.h>
+# include <linux/xattr.h>
+#endif
+
+/* Return 1 if NAME has a nontrivial access control list,
+ 0 if ACLs are not supported, or if NAME has no or only a base ACL,
+ and -1 (setting errno) on error. Note callers can determine
+ if ACLs are not supported as errno is set in that case also.
+ SB must be set to the stat buffer of NAME,
+ obtained through stat() or lstat(). */
+
+int
+file_has_acl (char const *name, struct stat const *sb)
+{
+#if USE_ACL
+ if (! S_ISLNK (sb->st_mode))
+ {
+
+# if GETXATTR_WITH_POSIX_ACLS
+
+ ssize_t ret;
+
+ ret = getxattr (name, XATTR_NAME_POSIX_ACL_ACCESS, NULL, 0);
+ if (ret < 0 && errno == ENODATA)
+ ret = 0;
+ else if (ret > 0)
+ return 1;
+
+ if (ret == 0 && S_ISDIR (sb->st_mode))
+ {
+ ret = getxattr (name, XATTR_NAME_POSIX_ACL_DEFAULT, NULL, 0);
+ if (ret < 0 && errno == ENODATA)
+ ret = 0;
+ else if (ret > 0)
+ return 1;
+ }
+
+ if (ret < 0)
+ return - acl_errno_valid (errno);
+ return ret;
+
+# elif HAVE_ACL_GET_FILE
+
+ /* POSIX 1003.1e (draft 17 -- abandoned) specific version. */
+ /* Linux, FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
+ int ret;
+
+ if (HAVE_ACL_EXTENDED_FILE) /* Linux */
+ {
+ /* On Linux, acl_extended_file is an optimized function: It only
+ makes two calls to getxattr(), one for ACL_TYPE_ACCESS, one for
+ ACL_TYPE_DEFAULT. */
+ ret = acl_extended_file (name);
+ }
+ else /* FreeBSD, Mac OS X, IRIX, Tru64, Cygwin >= 2.5 */
+ {
+# if HAVE_ACL_TYPE_EXTENDED /* Mac OS X */
+ /* On Mac OS X, acl_get_file (name, ACL_TYPE_ACCESS)
+ and acl_get_file (name, ACL_TYPE_DEFAULT)
+ always return NULL / EINVAL. There is no point in making
+ these two useless calls. The real ACL is retrieved through
+ acl_get_file (name, ACL_TYPE_EXTENDED). */
+ acl_t acl = acl_get_file (name, ACL_TYPE_EXTENDED);
+ if (acl)
+ {
+ ret = acl_extended_nontrivial (acl);
+ acl_free (acl);
+ }
+ else
+ ret = -1;
+# else /* FreeBSD, IRIX, Tru64, Cygwin >= 2.5 */
+ acl_t acl = acl_get_file (name, ACL_TYPE_ACCESS);
+ if (acl)
+ {
+ int saved_errno;
+
+ ret = acl_access_nontrivial (acl);
+ saved_errno = errno;
+ acl_free (acl);
+ errno = saved_errno;
+# if HAVE_ACL_FREE_TEXT /* Tru64 */
+ /* On OSF/1, acl_get_file (name, ACL_TYPE_DEFAULT) always
+ returns NULL with errno not set. There is no point in
+ making this call. */
+# else /* FreeBSD, IRIX, Cygwin >= 2.5 */
+ /* On Linux, FreeBSD, IRIX, acl_get_file (name, ACL_TYPE_ACCESS)
+ and acl_get_file (name, ACL_TYPE_DEFAULT) on a directory
+ either both succeed or both fail; it depends on the
+ file system. Therefore there is no point in making the second
+ call if the first one already failed. */
+ if (ret == 0 && S_ISDIR (sb->st_mode))
+ {
+ acl = acl_get_file (name, ACL_TYPE_DEFAULT);
+ if (acl)
+ {
+# ifdef __CYGWIN__ /* Cygwin >= 2.5 */
+ ret = acl_access_nontrivial (acl);
+ saved_errno = errno;
+ acl_free (acl);
+ errno = saved_errno;
+# else
+ ret = (0 < acl_entries (acl));
+ acl_free (acl);
+# endif
+ }
+ else
+ ret = -1;
+ }
+# endif
+ }
+ else
+ ret = -1;
+# endif
+ }
+ if (ret < 0)
+ return - acl_errno_valid (errno);
+ return ret;
+
+# elif HAVE_FACL && defined GETACL /* Solaris, Cygwin < 2.5, not HP-UX */
+
+# if defined ACL_NO_TRIVIAL
+
+ /* Solaris 10 (newer version), which has additional API declared in
+ <sys/acl.h> (acl_t) and implemented in libsec (acl_set, acl_trivial,
+ acl_fromtext, ...). */
+ return acl_trivial (name);
+
+# else /* Solaris, Cygwin, general case */
+
+ /* Solaris 2.5 through Solaris 10, Cygwin, and contemporaneous versions
+ of Unixware. The acl() call returns the access and default ACL both
+ at once. */
+ {
+ /* Initially, try to read the entries into a stack-allocated buffer.
+ Use malloc if it does not fit. */
+ enum
+ {
+ alloc_init = 4000 / sizeof (aclent_t), /* >= 3 */
+ alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (aclent_t))
+ };
+ aclent_t buf[alloc_init];
+ size_t alloc = alloc_init;
+ aclent_t *entries = buf;
+ aclent_t *malloced = NULL;
+ int count;
+
+ for (;;)
+ {
+ count = acl (name, GETACL, alloc, entries);
+ if (count < 0 && errno == ENOSPC)
+ {
+ /* Increase the size of the buffer. */
+ free (malloced);
+ if (alloc > alloc_max / 2)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ alloc = 2 * alloc; /* <= alloc_max */
+ entries = malloced =
+ (aclent_t *) malloc (alloc * sizeof (aclent_t));
+ if (entries == NULL)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ continue;
+ }
+ break;
+ }
+ if (count < 0)
+ {
+ if (errno == ENOSYS || errno == ENOTSUP)
+ ;
+ else
+ {
+ int saved_errno = errno;
+ free (malloced);
+ errno = saved_errno;
+ return -1;
+ }
+ }
+ else if (count == 0)
+ ;
+ else
+ {
+ /* Don't use MIN_ACL_ENTRIES: It's set to 4 on Cygwin, but Cygwin
+ returns only 3 entries for files with no ACL. But this is safe:
+ If there are more than 4 entries, there cannot be only the
+ "user::", "group::", "other:", and "mask:" entries. */
+ if (count > 4)
+ {
+ free (malloced);
+ return 1;
+ }
+
+ if (acl_nontrivial (count, entries))
+ {
+ free (malloced);
+ return 1;
+ }
+ }
+ free (malloced);
+ }
+
+# ifdef ACE_GETACL
+ /* Solaris also has a different variant of ACLs, used in ZFS and NFSv4
+ file systems (whereas the other ones are used in UFS file systems). */
+ {
+ /* Initially, try to read the entries into a stack-allocated buffer.
+ Use malloc if it does not fit. */
+ enum
+ {
+ alloc_init = 4000 / sizeof (ace_t), /* >= 3 */
+ alloc_max = MIN (INT_MAX, SIZE_MAX / sizeof (ace_t))
+ };
+ ace_t buf[alloc_init];
+ size_t alloc = alloc_init;
+ ace_t *entries = buf;
+ ace_t *malloced = NULL;
+ int count;
+
+ for (;;)
+ {
+ count = acl (name, ACE_GETACL, alloc, entries);
+ if (count < 0 && errno == ENOSPC)
+ {
+ /* Increase the size of the buffer. */
+ free (malloced);
+ if (alloc > alloc_max / 2)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ alloc = 2 * alloc; /* <= alloc_max */
+ entries = malloced = (ace_t *) malloc (alloc * sizeof (ace_t));
+ if (entries == NULL)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ continue;
+ }
+ break;
+ }
+ if (count < 0)
+ {
+ if (errno == ENOSYS || errno == EINVAL)
+ ;
+ else
+ {
+ int saved_errno = errno;
+ free (malloced);
+ errno = saved_errno;
+ return -1;
+ }
+ }
+ else if (count == 0)
+ ;
+ else
+ {
+ /* In the old (original Solaris 10) convention:
+ If there are more than 3 entries, there cannot be only the
+ ACE_OWNER, ACE_GROUP, ACE_OTHER entries.
+ In the newer Solaris 10 and Solaris 11 convention:
+ If there are more than 6 entries, there cannot be only the
+ ACE_OWNER, ACE_GROUP, ACE_EVERYONE entries, each once with
+ NEW_ACE_ACCESS_ALLOWED_ACE_TYPE and once with
+ NEW_ACE_ACCESS_DENIED_ACE_TYPE. */
+ if (count > 6)
+ {
+ free (malloced);
+ return 1;
+ }
+
+ if (acl_ace_nontrivial (count, entries))
+ {
+ free (malloced);
+ return 1;
+ }
+ }
+ free (malloced);
+ }
+# endif
+
+ return 0;
+# endif
+
+# elif HAVE_GETACL /* HP-UX */
+
+ {
+ struct acl_entry entries[NACLENTRIES];
+ int count;
+
+ count = getacl (name, NACLENTRIES, entries);
+
+ if (count < 0)
+ {
+ /* ENOSYS is seen on newer HP-UX versions.
+ EOPNOTSUPP is typically seen on NFS mounts.
+ ENOTSUP was seen on Quantum StorNext file systems (cvfs). */
+ if (errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP)
+ ;
+ else
+ return -1;
+ }
+ else if (count == 0)
+ return 0;
+ else /* count > 0 */
+ {
+ if (count > NACLENTRIES)
+ /* If NACLENTRIES cannot be trusted, use dynamic memory
+ allocation. */
+ abort ();
+
+ /* If there are more than 3 entries, there cannot be only the
+ (uid,%), (%,gid), (%,%) entries. */
+ if (count > 3)
+ return 1;
+
+ {
+ struct stat statbuf;
+
+ if (stat (name, &statbuf) < 0)
+ return -1;
+
+ return acl_nontrivial (count, entries);
+ }
+ }
+ }
+
+# if HAVE_ACLV_H /* HP-UX >= 11.11 */
+
+ {
+ struct acl entries[NACLVENTRIES];
+ int count;
+
+ count = acl ((char *) name, ACL_GET, NACLVENTRIES, entries);
+
+ if (count < 0)
+ {
+ /* EOPNOTSUPP is seen on NFS in HP-UX 11.11, 11.23.
+ EINVAL is seen on NFS in HP-UX 11.31. */
+ if (errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL)
+ ;
+ else
+ return -1;
+ }
+ else if (count == 0)
+ return 0;
+ else /* count > 0 */
+ {
+ if (count > NACLVENTRIES)
+ /* If NACLVENTRIES cannot be trusted, use dynamic memory
+ allocation. */
+ abort ();
+
+ /* If there are more than 4 entries, there cannot be only the
+ four base ACL entries. */
+ if (count > 4)
+ return 1;
+
+ return aclv_nontrivial (count, entries);
+ }
+ }
+
+# endif
+
+# elif HAVE_ACLX_GET && defined ACL_AIX_WIP /* AIX */
+
+ acl_type_t type;
+ char aclbuf[1024];
+ void *acl = aclbuf;
+ size_t aclsize = sizeof (aclbuf);
+ mode_t mode;
+
+ for (;;)
+ {
+ /* The docs say that type being 0 is equivalent to ACL_ANY, but it
+ is not true, in AIX 5.3. */
+ type.u64 = ACL_ANY;
+ if (aclx_get (name, 0, &type, aclbuf, &aclsize, &mode) >= 0)
+ break;
+ if (errno == ENOSYS)
+ return 0;
+ if (errno != ENOSPC)
+ {
+ if (acl != aclbuf)
+ {
+ int saved_errno = errno;
+ free (acl);
+ errno = saved_errno;
+ }
+ return -1;
+ }
+ aclsize = 2 * aclsize;
+ if (acl != aclbuf)
+ free (acl);
+ acl = malloc (aclsize);
+ if (acl == NULL)
+ {
+ errno = ENOMEM;
+ return -1;
+ }
+ }
+
+ if (type.u64 == ACL_AIXC)
+ {
+ int result = acl_nontrivial ((struct acl *) acl);
+ if (acl != aclbuf)
+ free (acl);
+ return result;
+ }
+ else if (type.u64 == ACL_NFS4)
+ {
+ int result = acl_nfs4_nontrivial ((nfs4_acl_int_t *) acl);
+ if (acl != aclbuf)
+ free (acl);
+ return result;
+ }
+ else
+ {
+ /* A newer type of ACL has been introduced in the system.
+ We should better support it. */
+ if (acl != aclbuf)
+ free (acl);
+ errno = EINVAL;
+ return -1;
+ }
+
+# elif HAVE_STATACL /* older AIX */
+
+ union { struct acl a; char room[4096]; } u;
+
+ if (statacl ((char *) name, STX_NORMAL, &u.a, sizeof (u)) < 0)
+ return -1;
+
+ return acl_nontrivial (&u.a);
+
+# elif HAVE_ACLSORT /* NonStop Kernel */
+
+ {
+ struct acl entries[NACLENTRIES];
+ int count;
+
+ count = acl ((char *) name, ACL_GET, NACLENTRIES, entries);
+
+ if (count < 0)
+ {
+ if (errno == ENOSYS || errno == ENOTSUP)
+ ;
+ else
+ return -1;
+ }
+ else if (count == 0)
+ return 0;
+ else /* count > 0 */
+ {
+ if (count > NACLENTRIES)
+ /* If NACLENTRIES cannot be trusted, use dynamic memory
+ allocation. */
+ abort ();
+
+ /* If there are more than 4 entries, there cannot be only the
+ four base ACL entries. */
+ if (count > 4)
+ return 1;
+
+ return acl_nontrivial (count, entries);
+ }
+ }
+
+# endif
+ }
+#endif
+
+ return 0;
+}
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 07736f9b8bc..0b9aaf6d9ea 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -98,6 +98,7 @@
# fcntl \
# fcntl-h \
# fdopendir \
+# file-has-acl \
# filemode \
# filename \
# filevercmp \
@@ -1788,6 +1789,16 @@ EXTRA_libgnu_a_SOURCES += fdopendir.c
endif
## end gnulib module fdopendir
+## begin gnulib module file-has-acl
+ifeq (,$(OMIT_GNULIB_MODULE_file-has-acl))
+
+libgnu_a_SOURCES += file-has-acl.c
+
+EXTRA_DIST += acl-internal.h
+
+endif
+## end gnulib module file-has-acl
+
## begin gnulib module filemode
ifeq (,$(OMIT_GNULIB_MODULE_filemode))
diff --git a/lib/pipe2.c b/lib/pipe2.c
index 41493aa4307..adbaa4a1021 100644
--- a/lib/pipe2.c
+++ b/lib/pipe2.c
@@ -41,7 +41,7 @@ pipe2 (int fd[2], int flags)
{
/* Mingw _pipe() corrupts fd on failure; also, if we succeed at
creating the pipe but later fail at changing fcntl, we want
- to leave fd unchanged: http://austingroupbugs.net/view.php?id=467 */
+ to leave fd unchanged: https://austingroupbugs.net/view.php?id=467 */
int tmp[2];
tmp[0] = fd[0];
tmp[1] = fd[1];
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 72f7f1676b7..431217a9dac 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -21,6 +21,7 @@ SHELL = @SHELL@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
lisp = $(srcdir)
VPATH = $(srcdir)
EXEEXT = @EXEEXT@
@@ -29,24 +30,14 @@ EXEEXT = @EXEEXT@
# limitation.
XARGS_LIMIT = @XARGS_LIMIT@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_ELC = $(am__v_ELC_@AM_V@)
-am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
-am__v_ELC_0 = @echo " ELC " $@;
-am__v_ELC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ifndef NATIVE_FULL_AOT
+NATIVE_SKIP_NONDUMP = 1
+endif
+endif
+-include ${top_builddir}/src/verbose.mk
FIND_DELETE = @FIND_DELETE@
@@ -98,8 +89,12 @@ COMPILE_FIRST = \
$(lisp)/emacs-lisp/macroexp.elc \
$(lisp)/emacs-lisp/cconv.elc \
$(lisp)/emacs-lisp/byte-opt.elc \
- $(lisp)/emacs-lisp/bytecomp.elc \
- $(lisp)/emacs-lisp/autoload.elc
+ $(lisp)/emacs-lisp/bytecomp.elc
+ifeq ($(HAVE_NATIVE_COMP),yes)
+COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc
+COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc
+endif
+COMPILE_FIRST += $(lisp)/emacs-lisp/autoload.elc
# Files to compile early in compile-main. Works around bug#25556.
MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \
@@ -207,7 +202,7 @@ $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS)
# regeneration of all these files.
.PHONY: autoloads-force
autoloads-force:
- rm loaddefs.el
+ rm -f $(lisp)/loaddefs.el
$(MAKE) autoloads
# This is required by the bootstrap-emacs target in ../src/Makefile, so
@@ -276,9 +271,15 @@ TAGS: ${ETAGS} ${tagsfiles}
THEFILE = no-such-file
.PHONY: $(THEFILE)c
$(THEFILE)c:
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
+ -l comp -f byte-compile-refresh-preloaded \
+ -f batch-byte+native-compile $(THEFILE)
+else
$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
-l bytecomp -f byte-compile-refresh-preloaded \
-f batch-byte-compile $(THEFILE)
+endif
# Files MUST be compiled one by one. If we compile several files in a
# row (i.e., in the same instance of Emacs) we can't make sure that
@@ -291,8 +292,14 @@ $(THEFILE)c:
# An old-fashioned suffix rule, which, according to the GNU Make manual,
# cannot have prerequisites.
+ifeq ($(HAVE_NATIVE_COMP),yes)
+.el.elc:
+ $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
+ -l comp -f batch-byte+native-compile $<
+else
.el.elc:
$(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $<
+endif
.PHONY: compile-first compile-main compile compile-always
@@ -310,7 +317,13 @@ compile-first: $(COMPILE_FIRST)
.PHONY: compile-targets
# TARGETS is set dynamically in the recursive call from 'compile-main'.
+# Do not build comp.el unless necessary not to exceed max-specpdl-size and
+# max-lisp-eval-depth in normal builds.
+ifneq ($(HAVE_NATIVE_COMP),yes)
+compile-targets: $(filter-out ./emacs-lisp/comp-cstr.elc,$(filter-out ./emacs-lisp/comp.elc,$(TARGETS)))
+else
compile-targets: $(TARGETS)
+endif
# Compile all the Elisp files that need it. Beware: it approximates
# 'no-byte-compile', so watch out for false-positives!
@@ -323,9 +336,11 @@ compile-main: gen-lisp compile-clean
GREP_OPTIONS= grep '^;.*[^a-zA-Z]no-byte-compile: *t' $$el > /dev/null && \
continue; \
echo "$${el}c"; \
- done | xargs $(XARGS_LIMIT) echo) | \
- while read chunk; do \
- $(MAKE) compile-targets TARGETS="$$chunk"; \
+ done | xargs $(XARGS_LIMIT) echo) | \
+ while read chunk; do \
+ $(MAKE) compile-targets \
+ NATIVE_DISABLED=$(NATIVE_SKIP_NONDUMP) \
+ TARGETS="$$chunk"; \
done
.PHONY: compile-clean
@@ -452,7 +467,7 @@ $(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el
--eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
-f batch-update-autoloads $(CAL_DIR)
-.PHONY: bootstrap-clean distclean maintainer-clean extraclean
+.PHONY: bootstrap-clean distclean maintainer-clean
bootstrap-clean:
find $(lisp) -name '*.elc' $(FIND_DELETE)
@@ -464,10 +479,6 @@ distclean:
maintainer-clean: distclean bootstrap-clean
rm -f TAGS
-extraclean: bootstrap-clean distclean
- -for file in $(LOADDEFS); do rm -f $${file}~; done
- -rm -f $(lisp)/loaddefs.el~
-
.PHONY: check-declare
check-declare:
diff --git a/lisp/align.el b/lisp/align.el
index 1a1d3dd7ec1..a0b626a5c43 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1310,7 +1310,7 @@ aligner would have dealt with are."
(thissep (if rulesep (cdr rulesep) separate))
same (eol 0)
search-start
- groups group-c
+ groups ;; group-c
spacing spacing-c
tab-stop tab-stop-c
repeat repeat-c
@@ -1434,7 +1434,7 @@ aligner would have dealt with are."
;; lookup the `group' attribute the first time
;; that we need it
- (unless group-c
+ (unless nil ;; group-c
(setq groups (or (cdr (assq 'group rule)) 1))
(unless (listp groups)
(setq groups (list groups)))
@@ -1587,8 +1587,6 @@ aligner would have dealt with are."
(if report
(message "Aligning...done"))))
-;; Provide:
-
(provide 'align)
(run-hooks 'align-load-hook)
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index f251be8dfb9..0e127040886 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -1,4 +1,4 @@
-;; allout-widgets.el --- Visually highlight allout outline structure.
+;;; allout-widgets.el --- Visually highlight allout outline structure. -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@@ -6,7 +6,7 @@
;; Version: 1.0
;; Created: Dec 2005
;; Keywords: outlines
-;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout
+;; Website: https://myriadicity.net/software-and-systems/craft/emacs-allout
;; This file is part of GNU Emacs.
@@ -38,7 +38,7 @@
;; See the `allout-widgets-mode' docstring for more details.
;;
;; Info about allout and allout-widgets development are available at
-;; http://myriadicity.net/Sundry/EmacsAllout
+;; https://myriadicity.net/software-and-systems/craft/emacs-allout
;;
;; The graphics include:
;;
@@ -72,11 +72,11 @@
(eval-when-compile (require 'cl-lib))
;;;_ : internal variables needed before user-customization variables
-;;; In order to enable activation of allout-widgets-mode via customization,
-;;; allout-widgets-auto-activation uses a setting function. That function
-;;; is invoked when the customization variable definition is evaluated,
-;;; during file load, so the involved code must reside above that
-;;; definition in the file.
+;; In order to enable activation of allout-widgets-mode via customization,
+;; allout-widgets-auto-activation uses a setting function. That function
+;; is invoked when the customization variable definition is evaluated,
+;; during file load, so the involved code must reside above that
+;; definition in the file.
;;;_ = allout-widgets-mode
(defvar-local allout-widgets-mode nil
"Allout mode enhanced with graphical widgets.")
@@ -100,8 +100,8 @@ with allout-mode."
See `allout-widgets-mode-inhibit' for per-file/per-buffer
inhibition of allout-widgets-mode."
- (add-hook 'allout-mode-off-hook 'allout-widgets-mode-off)
- (add-hook 'allout-mode-on-hook 'allout-widgets-mode-on)
+ (add-hook 'allout-mode-off-hook #'allout-widgets-mode-off)
+ (add-hook 'allout-mode-on-hook #'allout-widgets-mode-on)
t)
;;;_ > allout-widgets-mode-disable
(defun allout-widgets-mode-disable ()
@@ -109,8 +109,8 @@ inhibition of allout-widgets-mode."
See `allout-widgets-mode-inhibit' for per-file/per-buffer
inhibition of allout-widgets-mode."
- (remove-hook 'allout-mode-off-hook 'allout-widgets-mode-off)
- (remove-hook 'allout-mode-on-hook 'allout-widgets-mode-on)
+ (remove-hook 'allout-mode-off-hook #'allout-widgets-mode-off)
+ (remove-hook 'allout-mode-on-hook #'allout-widgets-mode-on)
t)
;;;_ > allout-widgets-setup (varname value)
;;;###autoload
@@ -141,7 +141,7 @@ See `allout-widgets-mode' for allout widgets mode features."
:version "24.1"
:type 'boolean
:group 'allout-widgets
- :set 'allout-widgets-setup
+ :set #'allout-widgets-setup
)
;; ;;;_ = allout-widgets-allow-unruly-edits
;; (defcustom allout-widgets-allow-unruly-edits nil
@@ -307,7 +307,7 @@ In addition, you can invoked `allout-widgets-mode' allout-mode
buffers where this is set to enable and disable widget
enhancements, directly.")
;;;###autoload
-(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
+(put 'allout-widgets-mode-inhibit 'safe-local-variable #'booleanp)
;;;_ = allout-inhibit-body-modification-hook
(defvar-local allout-inhibit-body-modification-hook nil
"Override de-escaping of text-prefixes in item bodies during specific changes.
@@ -402,14 +402,14 @@ not altered with an escape sequence.")
(set-keymap-parent km as-parent)
(dolist (digit '("0" "1" "2" "3"
"4" "5" "6" "7" "8" "9"))
- (define-key km digit 'digit-argument))
- (define-key km "-" 'negative-argument)
+ (define-key km digit #'digit-argument))
+ (define-key km "-" #'negative-argument)
;; Override underlying mouse-1 and mouse-2 bindings in icon territory:
- (define-key km [(mouse-1)] (lambda () (interactive) nil))
- (define-key km [(mouse-2)] (lambda () (interactive) nil))
+ (define-key km [(mouse-1)] #'ignore)
+ (define-key km [(mouse-2)] #'ignore)
;; Catchall, handles actual keybindings, dynamically doing keymap lookups:
- (define-key km [t] 'allout-item-icon-key-handler)
+ (define-key km [t] #'allout-item-icon-key-handler)
km)
"General tree-node key bindings.")
@@ -535,7 +535,7 @@ outline hot-spot navigation (see `allout-mode')."
"\\1\\3"))
)
- (add-hook 'after-change-functions 'allout-widgets-after-change-handler
+ (add-hook 'after-change-functions #'allout-widgets-after-change-handler
nil t)
(allout-setup-text-properties)
@@ -551,23 +551,23 @@ outline hot-spot navigation (see `allout-mode')."
(set-keymap-parent allout-item-icon-keymap as-parent))
(add-hook 'allout-exposure-change-functions
- 'allout-widgets-exposure-change-recorder nil 'local)
+ #'allout-widgets-exposure-change-recorder nil 'local)
(add-hook 'allout-structure-added-functions
- 'allout-widgets-additions-recorder nil 'local)
+ #'allout-widgets-additions-recorder nil 'local)
(add-hook 'allout-structure-deleted-functions
- 'allout-widgets-deletions-recorder nil 'local)
+ #'allout-widgets-deletions-recorder nil 'local)
(add-hook 'allout-structure-shifted-functions
- 'allout-widgets-shifts-recorder nil 'local)
+ #'allout-widgets-shifts-recorder nil 'local)
(add-hook 'allout-after-copy-or-kill-hook
- 'allout-widgets-after-copy-or-kill-function nil 'local)
+ #'allout-widgets-after-copy-or-kill-function nil 'local)
(add-hook 'allout-post-undo-hook
- 'allout-widgets-after-undo-function nil 'local)
+ #'allout-widgets-after-undo-function nil 'local)
- (add-hook 'before-change-functions 'allout-widgets-before-change-handler
+ (add-hook 'before-change-functions
+ #'allout-widgets-before-change-handler nil 'local)
+ (add-hook 'post-command-hook #'allout-widgets-post-command-business
nil 'local)
- (add-hook 'post-command-hook 'allout-widgets-post-command-business
- nil 'local)
- (add-hook 'pre-command-hook 'allout-widgets-pre-command-business
+ (add-hook 'pre-command-hook #'allout-widgets-pre-command-business
nil 'local)
;; init the widgets tally for debugging:
@@ -596,23 +596,23 @@ outline hot-spot navigation (see `allout-mode')."
(remove-from-invisibility-spec 'allout-escapes)
(remove-hook 'after-change-functions
- 'allout-widgets-after-change-handler 'local)
+ #'allout-widgets-after-change-handler 'local)
(remove-hook 'allout-exposure-change-functions
- 'allout-widgets-exposure-change-recorder 'local)
+ #'allout-widgets-exposure-change-recorder 'local)
(remove-hook 'allout-structure-added-functions
- 'allout-widgets-additions-recorder 'local)
+ #'allout-widgets-additions-recorder 'local)
(remove-hook 'allout-structure-deleted-functions
- 'allout-widgets-deletions-recorder 'local)
+ #'allout-widgets-deletions-recorder 'local)
(remove-hook 'allout-structure-shifted-functions
- 'allout-widgets-shifts-recorder 'local)
+ #'allout-widgets-shifts-recorder 'local)
(remove-hook 'allout-after-copy-or-kill-hook
- 'allout-widgets-after-copy-or-kill-function 'local)
+ #'allout-widgets-after-copy-or-kill-function 'local)
(remove-hook 'before-change-functions
- 'allout-widgets-before-change-handler 'local)
+ #'allout-widgets-before-change-handler 'local)
(remove-hook 'post-command-hook
- 'allout-widgets-post-command-business 'local)
+ #'allout-widgets-post-command-business 'local)
(remove-hook 'pre-command-hook
- 'allout-widgets-pre-command-business 'local)
+ #'allout-widgets-pre-command-business 'local)
(assq-delete-all 'allout-widgets-mode-inhibit minor-mode-alist)
(set-buffer-modified-p was-modified))))
;;;_ > allout-widgets-mode-off
@@ -710,7 +710,7 @@ Optional RECURSING is for internal use, to limit recursion."
(when allout-widgets-reenable-before-change-handler
(add-hook 'before-change-functions
- 'allout-widgets-before-change-handler
+ #'allout-widgets-before-change-handler
nil 'local)
(setq allout-widgets-reenable-before-change-handler nil))
@@ -879,7 +879,7 @@ encompassing condition-case."
(message header) (sit-for allout-widgets-hook-error-post-time)
;; reraise the error, or one concerning this function if unexpected:
(if (equal mode 'error)
- (apply 'signal args)
+ (apply #'signal args)
(error "%s: unexpected mode, %s %s" this mode args))))
;;;_ > allout-widgets-changes-exceed-threshold-p ()
(defun allout-widgets-adjusting-message (message)
@@ -973,9 +973,8 @@ Generally invoked via `allout-exposure-change-functions'."
deactivate-mark)
(dolist (change changes)
- (let (handling
- (from (cadr change))
- bucket got
+ (let ((from (cadr change))
+ bucket
(to (caddr change))
(flag (cadddr change))
parent)
@@ -986,10 +985,11 @@ Generally invoked via `allout-exposure-change-functions'."
from bucket))
;; have we already handled exposure changes in this region?
- (setq handling (if flag 'handled-conceal 'handled-expose)
- got (allout-range-overlaps from to (symbol-value handling))
- covered (car got))
- (set handling (cadr got))
+ (cl-callf (lambda (x)
+ (let ((got (allout-range-overlaps from to x)))
+ (setq covered (car got))
+ (cadr got)))
+ (if flag handled-conceal handled-expose))
(when (not covered)
(save-excursion
@@ -1825,7 +1825,7 @@ reapplying this method will rectify the glyphs."
(if (> increment 1) (setq increment 1))
(when extenders
;; paint extenders after a connector, else leave spaces.
- (dotimes (i extenders)
+ (dotimes (_ extenders)
(put-text-property
position (setq position (1+ position))
'display (allout-fetch-icon-image
@@ -2290,10 +2290,11 @@ The elements of LIST are not copied, just the list structure itself."
(define-obsolete-function-alias 'allout-frame-property #'frame-parameter "28.1")
-;;;_ : provide
(provide 'allout-widgets)
;;;_ . Local emacs vars.
;;;_ , Local variables:
;;;_ , allout-layout: (-1 : 0)
;;;_ , End:
+
+;;; allout-widgets.el ends here
diff --git a/lisp/allout.el b/lisp/allout.el
index ff0b67556e0..0625ea68abe 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1,12 +1,12 @@
-;;; allout.el --- extensive outline mode for use alone and with other modes
+;;; allout.el --- extensive outline mode for use alone and with other modes -*- lexical-binding: t; -*-
-;; Copyright (C) 1992-1994, 2001-2021 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Created: Dec 1991 -- first release to usenet
;; Version: 2.3
;; Keywords: outlines, wp, languages, PGP, GnuPG
-;; Website: http://myriadicity.net/software-and-systems/craft/emacs-allout
+;; Website: https://myriadicity.net/software-and-systems/craft/emacs-allout
;; This file is part of GNU Emacs.
@@ -57,7 +57,7 @@
;; mode.
;;
;; Directions to the latest development version and helpful notes are
-;; available at http://myriadicity.net/Sundry/EmacsAllout .
+;; available at https://myriadicity.net/software-and-systems/craft/emacs-allout .
;;
;; The outline menubar additions provide quick reference to many of the
;; features. See the docstring of the variables `allout-layout' and
@@ -75,9 +75,6 @@
(declare-function epa-passphrase-callback-function
"epa" (context key-id handback))
-;;;_* Dependency loads
-(require 'overlay)
-
;;;_* USER CUSTOMIZATION VARIABLES:
;;;_ > defgroup allout, allout-keybindings
@@ -136,13 +133,14 @@ respective allout-mode keybinding variables, `allout-command-prefix',
(when (boundp 'allout-unprefixed-keybindings)
(dolist (entry allout-unprefixed-keybindings)
(define-key map (car (read-from-string (car entry))) (cadr entry))))
- (substitute-key-definition 'beginning-of-line 'allout-beginning-of-line
+ (substitute-key-definition #'beginning-of-line #'allout-beginning-of-line
map global-map)
- (substitute-key-definition 'move-beginning-of-line 'allout-beginning-of-line
+ (substitute-key-definition #'move-beginning-of-line
+ #'allout-beginning-of-line
map global-map)
- (substitute-key-definition 'end-of-line 'allout-end-of-line
+ (substitute-key-definition #'end-of-line #'allout-end-of-line
map global-map)
- (substitute-key-definition 'move-end-of-line 'allout-end-of-line
+ (substitute-key-definition #'move-end-of-line #'allout-end-of-line
map global-map)
(allout-institute-keymap map)))
;;;_ > allout-institute-keymap (map)
@@ -172,7 +170,7 @@ Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're
willing to let allout use a bunch of \C-c keybindings."
:type 'string
:group 'allout-keybindings
- :set 'allout-compose-and-institute-keymap)
+ :set #'allout-compose-and-institute-keymap)
;;;_ = allout-keybindings-binding
(define-widget 'allout-keybindings-binding 'lazy
"Structure of allout keybindings customization items."
@@ -233,7 +231,7 @@ prevails."
:version "24.1"
:type 'allout-keybindings-binding
:group 'allout-keybindings
- :set 'allout-compose-and-institute-keymap
+ :set #'allout-compose-and-institute-keymap
)
;;;_ = allout-unprefixed-keybindings
(defcustom allout-unprefixed-keybindings
@@ -257,7 +255,7 @@ See the existing keys for examples."
:version "24.1"
:type 'allout-keybindings-binding
:group 'allout-keybindings
- :set 'allout-compose-and-institute-keymap
+ :set #'allout-compose-and-institute-keymap
)
;;;_ > allout-auto-activation-helper (var value)
@@ -279,8 +277,8 @@ Establishes allout processing as part of visiting a file if
The proper way to use this is through customizing the setting of
`allout-auto-activation'."
(if (not allout-auto-activation)
- (remove-hook 'find-file-hook 'allout-find-file-hook)
- (add-hook 'find-file-hook 'allout-find-file-hook)))
+ (remove-hook 'find-file-hook #'allout-find-file-hook)
+ (add-hook 'find-file-hook #'allout-find-file-hook)))
;;;_ = allout-auto-activation
;;;###autoload
(defcustom allout-auto-activation nil
@@ -301,7 +299,7 @@ With value \"activate\", only auto-mode-activation is enabled.
Auto-layout is not.
With value nil, inhibit any automatic allout-mode activation."
- :set 'allout-auto-activation-helper
+ :set #'allout-auto-activation-helper
;; FIXME: Using strings here is unusual and less efficient than symbols.
:type '(choice (const :tag "On" t)
(const :tag "Ask about layout" "ask")
@@ -408,7 +406,7 @@ where auto-fill occurs."
:group 'allout)
(make-variable-buffer-local 'allout-use-hanging-indents)
;;;###autoload
-(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
+(put 'allout-use-hanging-indents 'safe-local-variable #'booleanp)
;;;_ = allout-reindent-bodies
(defcustom allout-reindent-bodies (if allout-use-hanging-indents
'text)
@@ -437,7 +435,7 @@ just the header."
:group 'allout)
(make-variable-buffer-local 'allout-show-bodies)
;;;###autoload
-(put 'allout-show-bodies 'safe-local-variable 'booleanp)
+(put 'allout-show-bodies 'safe-local-variable #'booleanp)
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
@@ -510,7 +508,7 @@ character, which is typically set to the `allout-primary-bullet'."
:group 'allout)
(make-variable-buffer-local 'allout-header-prefix)
;;;###autoload
-(put 'allout-header-prefix 'safe-local-variable 'stringp)
+(put 'allout-header-prefix 'safe-local-variable #'stringp)
;;;_ = allout-primary-bullet
(defcustom allout-primary-bullet "*"
"Bullet used for top-level outline topics.
@@ -527,7 +525,7 @@ bullets."
:group 'allout)
(make-variable-buffer-local 'allout-primary-bullet)
;;;###autoload
-(put 'allout-primary-bullet 'safe-local-variable 'stringp)
+(put 'allout-primary-bullet 'safe-local-variable #'stringp)
;;;_ = allout-plain-bullets-string
(defcustom allout-plain-bullets-string ".,"
"The bullets normally used in outline topic prefixes.
@@ -543,7 +541,7 @@ of this var to take effect."
:group 'allout)
(make-variable-buffer-local 'allout-plain-bullets-string)
;;;###autoload
-(put 'allout-plain-bullets-string 'safe-local-variable 'stringp)
+(put 'allout-plain-bullets-string 'safe-local-variable #'stringp)
;;;_ = allout-distinctive-bullets-string
(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
"Persistent outline header bullets used to distinguish special topics.
@@ -591,7 +589,7 @@ strings."
:group 'allout)
(make-variable-buffer-local 'allout-distinctive-bullets-string)
;;;###autoload
-(put 'allout-distinctive-bullets-string 'safe-local-variable 'stringp)
+(put 'allout-distinctive-bullets-string 'safe-local-variable #'stringp)
;;;_ = allout-use-mode-specific-leader
(defcustom allout-use-mode-specific-leader t
@@ -658,7 +656,7 @@ are always respected by the topic maneuvering functions."
:group 'allout)
(make-variable-buffer-local 'allout-old-style-prefixes)
;;;###autoload
-(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
+(put 'allout-old-style-prefixes 'safe-local-variable #'booleanp)
;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
"Do fancy stuff with topic prefix bullets according to level, etc.
@@ -706,7 +704,7 @@ is non-nil."
:group 'allout)
(make-variable-buffer-local 'allout-stylish-prefixes)
;;;###autoload
-(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
+(put 'allout-stylish-prefixes 'safe-local-variable #'booleanp)
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
@@ -720,7 +718,7 @@ disables numbering maintenance."
:group 'allout)
(make-variable-buffer-local 'allout-numbered-bullet)
;;;###autoload
-(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
+(put 'allout-numbered-bullet 'safe-local-variable #'string-or-null-p)
;;;_ = allout-file-xref-bullet
(defcustom allout-file-xref-bullet "@"
"Bullet signifying file cross-references, for `allout-resolve-xref'.
@@ -729,7 +727,7 @@ Set this var to the bullet you want to use for file cross-references."
:type '(choice (const nil) string)
:group 'allout)
;;;###autoload
-(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
+(put 'allout-file-xref-bullet 'safe-local-variable #'string-or-null-p)
;;;_ = allout-presentation-padding
(defcustom allout-presentation-padding 2
"Presentation-format white-space padding factor, for greater indent."
@@ -738,7 +736,7 @@ Set this var to the bullet you want to use for file cross-references."
(make-variable-buffer-local 'allout-presentation-padding)
;;;###autoload
-(put 'allout-presentation-padding 'safe-local-variable 'integerp)
+(put 'allout-presentation-padding 'safe-local-variable #'integerp)
;;;_ = allout-flattened-numbering-abbreviation
(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering
@@ -1059,7 +1057,7 @@ invoking it directly."
(setq allout-primary-bullet leader))
allout-header-prefix)))
(defalias 'allout-infer-header-lead
- 'allout-infer-header-lead-and-primary-bullet)
+ #'allout-infer-header-lead-and-primary-bullet)
;;;_ > allout-infer-body-reindent ()
(defun allout-infer-body-reindent ()
"Determine proper setting for `allout-reindent-bodies'.
@@ -1199,14 +1197,13 @@ Also refresh various data structures that hinge on the regexp."
"[^" allout-primary-bullet "]"))
"\\)"
))))
-(define-obsolete-function-alias 'set-allout-regexp 'allout-set-regexp "26.1")
+(define-obsolete-function-alias 'set-allout-regexp #'allout-set-regexp "26.1")
;;;_ : Menu bar
(defvar allout-mode-exposure-menu)
(defvar allout-mode-editing-menu)
(defvar allout-mode-navigation-menu)
(defvar allout-mode-misc-menu)
(defun allout-produce-mode-menubar-entries ()
- (require 'easymenu)
(easy-menu-define allout-mode-exposure-menu
allout-mode-map-value
"Allout outline exposure menu."
@@ -1593,17 +1590,6 @@ non-nil in a lasting way.")
(defvar-local allout-explicitly-deactivated nil
"If t, `allout-mode's last deactivation was deliberate.
So `allout-post-command-business' should not reactivate it...")
-;;;_ > allout-setup-menubar ()
-(defun allout-setup-menubar ()
- "Populate the current buffer's menubar with `allout-mode' stuff."
- (let ((menus (list allout-mode-exposure-menu
- allout-mode-editing-menu
- allout-mode-navigation-menu
- allout-mode-misc-menu))
- cur)
- (while menus
- (setq cur (car menus)
- menus (cdr menus)))))
;;;_ > allout-overlay-preparations
(defun allout-overlay-preparations ()
"Set the properties of the allout invisible-text overlay and others."
@@ -1617,7 +1603,7 @@ So `allout-post-command-business' should not reactivate it...")
;; property controls the isearch _arrival_ behavior. This is the case at
;; least in emacs 21, 22.1, and xemacs 21.4.
(put 'allout-exposure-category 'isearch-open-invisible
- 'allout-isearch-end-handler)
+ #'allout-isearch-end-handler)
(put 'allout-exposure-category 'insert-in-front-hooks
'(allout-overlay-insert-in-front-handler))
(put 'allout-exposure-category 'modification-hooks
@@ -1907,12 +1893,12 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(allout-do-resumptions)
(remove-from-invisibility-spec '(allout . t))
- (remove-hook 'pre-command-hook 'allout-pre-command-business t)
- (remove-hook 'post-command-hook 'allout-post-command-business t)
- (remove-hook 'before-change-functions 'allout-before-change-handler t)
- (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
+ (remove-hook 'pre-command-hook #'allout-pre-command-business t)
+ (remove-hook 'post-command-hook #'allout-post-command-business t)
+ (remove-hook 'before-change-functions #'allout-before-change-handler t)
+ (remove-hook 'isearch-mode-end-hook #'allout-isearch-end-handler t)
(remove-hook 'write-contents-functions
- 'allout-write-contents-hook-handler t)
+ #'allout-write-contents-hook-handler t)
(remove-overlays (point-min) (point-max)
'category 'allout-exposure-category))
@@ -1941,11 +1927,11 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(add-to-invisibility-spec '(allout . t))
(allout-add-resumptions '(line-move-ignore-invisible t))
- (add-hook 'pre-command-hook 'allout-pre-command-business nil t)
- (add-hook 'post-command-hook 'allout-post-command-business nil t)
- (add-hook 'before-change-functions 'allout-before-change-handler nil t)
- (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
- (add-hook 'write-contents-functions 'allout-write-contents-hook-handler
+ (add-hook 'pre-command-hook #'allout-pre-command-business nil t)
+ (add-hook 'post-command-hook #'allout-post-command-business nil t)
+ (add-hook 'before-change-functions #'allout-before-change-handler nil t)
+ (add-hook 'isearch-mode-end-hook #'allout-isearch-end-handler nil t)
+ (add-hook 'write-contents-functions #'allout-write-contents-hook-handler
nil t)
;; Stash auto-fill settings and adjust so custom allout auto-fill
@@ -1970,8 +1956,6 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
;; allout-auto-fill will use the stashed values and so forth.
(allout-add-resumptions '(auto-fill-function allout-auto-fill)))
- (allout-setup-menubar)
-
;; Do auto layout if warranted:
(when (and allout-layout
allout-auto-activation
@@ -1991,7 +1975,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
(allout-this-or-next-heading)
(condition-case err
(progn
- (apply 'allout-expose-topic (list use-layout))
+ (apply #'allout-expose-topic (list use-layout))
(message "Adjusting `%s' exposure... done."
(buffer-name)))
;; Problem applying exposure -- notify user, but don't
@@ -2003,7 +1987,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
) ; let (())
) ; define-minor-mode
;;;_ > allout-minor-mode alias
-(defalias 'allout-minor-mode 'allout-mode)
+(defalias 'allout-minor-mode #'allout-mode)
;;;_ > allout-unload-function
(defun allout-unload-function ()
"Unload the allout outline library."
@@ -2072,7 +2056,7 @@ internal functions use this feature cohesively bunch changes."
(error "Concealed-text change abandoned, text reconcealed"))))
(goto-char start))))
;;;_ > allout-before-change-handler (beg end)
-(defun allout-before-change-handler (beg end)
+(defun allout-before-change-handler (_beg _end)
"Protect against changes to invisible text.
See `allout-overlay-interior-modification-handler' for details."
@@ -2236,7 +2220,7 @@ Actually, returns prefix beginning point."
(or (not (allout-do-doublecheck))
(not (allout-aberrant-container-p)))))))
;;;_ > allout-on-heading-p ()
-(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
+(defalias 'allout-on-heading-p #'allout-on-current-heading-p)
;;;_ > allout-e-o-prefix-p ()
(defun allout-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
@@ -2506,10 +2490,10 @@ We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
;;;_ - Subtree Charting
;;;_ " These routines either produce or assess charts, which are
-;;; nested lists of the locations of topics within a subtree.
-;;;
-;;; Charts enable efficient subtree navigation by providing a reusable basis
-;;; for elaborate, compound assessment and adjustment of a subtree.
+;; nested lists of the locations of topics within a subtree.
+;;
+;; Charts enable efficient subtree navigation by providing a reusable basis
+;; for elaborate, compound assessment and adjustment of a subtree.
;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
@@ -2772,7 +2756,7 @@ of (before any) topics, in which case we return nil."
(goto-char (point-min))
nil))))
;;;_ > allout-back-to-heading ()
-(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
+(defalias 'allout-back-to-heading #'allout-back-to-current-heading)
;;;_ > allout-pre-next-prefix ()
(defun allout-pre-next-prefix ()
"Skip forward to just before the next heading line.
@@ -2854,7 +2838,7 @@ collapsed."
(allout-beginning-of-current-entry)
(search-forward "\n" nil t)
(forward-char -1))
-(defalias 'allout-end-of-heading 'allout-end-of-current-heading)
+(defalias 'allout-end-of-heading #'allout-end-of-current-heading)
;;;_ > allout-get-body-text ()
(defun allout-get-body-text ()
"Return the unmangled body text of the topic immediately containing point."
@@ -3293,10 +3277,6 @@ Returns the qualifying command, if any, else nil."
(interactive)
(let* ((modified (event-modifiers last-command-event))
(key-num (cond ((numberp last-command-event) last-command-event)
- ;; for XEmacs character type:
- ((and (fboundp 'characterp)
- (apply 'characterp (list last-command-event)))
- (apply 'char-to-int (list last-command-event)))
(t 0)))
mapped-binding)
@@ -5141,7 +5121,7 @@ Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
(if (and spec
(allout-descend-to-depth new-depth)
(not (allout-hidden-p)))
- (progn (setq got (apply 'allout-old-expose-topic spec))
+ (progn (setq got (apply #'allout-old-expose-topic spec))
(if (and got (or (not max-pos) (> got max-pos)))
(setq max-pos got)))))))
(while (and followers
@@ -5219,7 +5199,7 @@ Optional arg CONTEXT indicates interior levels to include."
(setq flat-index (cdr flat-index)))
;; Dispose of single extra delim:
(setq result (cdr result))))
- (apply 'concat result)))
+ (apply #'concat result)))
;;;_ > allout-stringify-flat-index-plain (flat-index)
(defun allout-stringify-flat-index-plain (flat-index)
"Convert list representing section/subsection/... to document string."
@@ -5230,7 +5210,7 @@ Optional arg CONTEXT indicates interior levels to include."
(if result
(cons delim result))))
(setq flat-index (cdr flat-index)))
- (apply 'concat result)))
+ (apply #'concat result)))
;;;_ > allout-stringify-flat-index-indented (flat-index)
(defun allout-stringify-flat-index-indented (flat-index)
"Convert list representing section/subsection/... to document string."
@@ -5259,7 +5239,7 @@ Optional arg CONTEXT indicates interior levels to include."
(setq flat-index (cdr flat-index)))
;; Dispose of single extra delim:
(setq result (cdr result))))
- (apply 'concat result)))
+ (apply #'concat result)))
;;;_ > allout-listify-exposed (&optional start end format)
(defun allout-listify-exposed (&optional start end format)
@@ -5385,7 +5365,7 @@ header and body. The elements of that list are:
;; Put the list with first at front, to last at back:
(nreverse result))))
-(define-obsolete-function-alias 'allout-region-active-p 'region-active-p "28.1")
+(define-obsolete-function-alias 'allout-region-active-p #'region-active-p "28.1")
;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
@@ -5502,7 +5482,7 @@ alternate presentation format for the outline:
(beg (if arg (allout-back-to-current-heading) (point-min)))
(end (if arg (allout-end-of-current-subtree) (point-max)))
(buf (current-buffer))
- (start-list ()))
+ ) ;; (start-list ())
(if (eq format 'flat)
(setq format (if arg (save-excursion
(goto-char beg)
@@ -5514,7 +5494,7 @@ alternate presentation format for the outline:
end
(current-buffer)
tobuf
- format start-list)
+ format nil) ;; start-list
(goto-char (point-min))
(pop-to-buffer buf)
(goto-char start-pt)))
@@ -5626,11 +5606,12 @@ environment. Leaves point at the end of the line."
(begindoc "\\begin{document}\n\\begin{center}\n")
(title (format "%s%s%s%s"
"\\titlecmd{"
- (allout-latex-verb-quote (if allout-title
- (condition-case nil
- (eval allout-title)
- (error "<unnamed buffer>"))
- "Unnamed Outline"))
+ (allout-latex-verb-quote
+ (if allout-title
+ (condition-case nil
+ (eval allout-title t)
+ (error "<unnamed buffer>"))
+ "Unnamed Outline"))
"}\n"
"\\end{center}\n\n"))
(hsize "\\hsize = 7.5 true in\n")
@@ -6223,7 +6204,7 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info."
;;;_ > outlineify-sticky ()
;; outlinify-sticky is correct spelling; provide this alias for sticklers:
;;;###autoload
-(defalias 'outlinify-sticky 'outlineify-sticky)
+(defalias 'outlinify-sticky #'outlineify-sticky)
;;;###autoload
(defun outlineify-sticky (&optional _arg)
"Activate outline mode and establish file var so it is started subsequently.
@@ -6445,7 +6426,7 @@ If BEG is bigger than END we return 0."
;;;_ > allout-format-quote (string)
(defun allout-format-quote (string)
"Return a copy of string with all \"%\" characters doubled."
- (apply 'concat
+ (apply #'concat
(mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
string)))
(define-obsolete-function-alias 'allout-flatten #'flatten-tree "27.1")
@@ -6476,7 +6457,6 @@ If BEG is bigger than END we return 0."
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index e5bfccdb8ba..79dc821ea19 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -75,6 +75,7 @@
;;; Code:
(defvar comint-last-output-start)
+(defvar compilation-filter-start)
;; Customization
@@ -181,6 +182,24 @@ in shell buffers. You set this variable by calling one of:
:group 'ansi-colors
:version "23.2")
+(defcustom ansi-color-for-compilation-mode t
+ "Determines what to do with compilation output.
+If nil, do nothing.
+
+If the symbol `filter', then filter all ANSI graphical control
+sequences.
+
+If anything else (such as t), then translate ANSI graphical
+control sequences into text properties.
+
+In order for this to have any effect, `ansi-color-compilation-filter'
+must be in `compilation-filter-hook'."
+ :type '(choice (const :tag "Do nothing" nil)
+ (const :tag "Filter" filter)
+ (other :tag "Translate" t))
+ :group 'ansi-colors
+ :version "28.1")
+
(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,
@@ -228,6 +247,19 @@ This is a good function to put in `comint-output-filter-functions'."
(t
(ansi-color-apply-on-region start-marker end-marker)))))
+;;;###autoload
+(defun ansi-color-compilation-filter ()
+ "Maybe translate SGR control sequences into text properties.
+This function depends on the `ansi-color-for-compilation-mode'
+variable, and is meant to be used in `compilation-filter-hook'."
+ (let ((inhibit-read-only t))
+ (pcase ansi-color-for-compilation-mode
+ ('nil nil)
+ ('filter
+ (ansi-color-filter-region compilation-filter-start (point)))
+ (_
+ (ansi-color-apply-on-region compilation-filter-start (point))))))
+
(define-obsolete-function-alias 'ansi-color-unfontify-region
'font-lock-default-unfontify-region "24.1")
@@ -429,7 +461,8 @@ being deleted."
;; positions that overlap regions previously colored; these
;; `codes' should not be applied to that overlap, so we need
;; to know where they should really start.
- (setq ansi-color-context-region (if codes (list codes end-marker)))))
+ (setq ansi-color-context-region
+ (if codes (list codes (copy-marker (point)))))))
;; Clean up our temporary markers.
(unless (eq start-marker (cadr ansi-color-context-region))
(set-marker start-marker nil))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 86cdf233be6..a1470537d9a 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -96,6 +96,11 @@ include key-binding information in its output."
"Face for property name in Apropos output, or nil for none."
:version "24.3")
+(defface apropos-button
+ '((t (:inherit (font-lock-variable-name-face button))))
+ "Face for buttons that indicate a face in Apropos."
+ :version "28.1")
+
(defface apropos-function-button
'((t (:inherit (font-lock-function-name-face button))))
"Button face indicating a function, macro, or command in Apropos."
@@ -145,11 +150,11 @@ If value is `verbose', the computed score is shown for each match."
;; Use `apropos-follow' instead of just using the button
;; definition of RET, so that users can use it anywhere in an
;; apropos item, not just on top of a button.
- (define-key map "\C-m" 'apropos-follow)
+ (define-key map "\C-m" #'apropos-follow)
;; Movement keys
- (define-key map "n" 'apropos-next-symbol)
- (define-key map "p" 'apropos-previous-symbol)
+ (define-key map "n" #'apropos-next-symbol)
+ (define-key map "p" #'apropos-previous-symbol)
map)
"Keymap used in Apropos mode.")
@@ -276,7 +281,7 @@ before `apropos-mode' makes it buffer-local.")
(define-button-type 'apropos-face
'apropos-label "Face"
'apropos-short-label "F"
- 'face '(font-lock-variable-name-face button)
+ 'face 'apropos-button
'help-echo "mouse-2, RET: Display more help on this face"
'follow-link t
'action (lambda (button)
@@ -347,7 +352,7 @@ WILD should be a subexpression matching wildcards between matches."
(lambda (w)
(concat "\\(?:" w "\\)" ;; parens for synonyms
wild "\\(?:"
- (mapconcat 'identity
+ (mapconcat #'identity
(delq w (copy-sequence words))
"\\|")
"\\)"))
@@ -389,14 +394,14 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted',
;; use a trick that would find a match even if the words are
;; on different lines.
(let ((words pattern))
- (setq apropos-pattern (mapconcat 'identity pattern " ")
+ (setq apropos-pattern (mapconcat #'identity pattern " ")
apropos-pattern-quoted (regexp-quote apropos-pattern))
(dolist (word words)
(let ((syn apropos-synonyms) (s word) (a word))
(while syn
(if (member word (car syn))
(progn
- (setq a (mapconcat 'identity (car syn) "\\|"))
+ (setq a (mapconcat #'identity (car syn) "\\|"))
(if (member word (cdr (car syn)))
(setq s a))
(setq syn nil))
@@ -513,7 +518,7 @@ variables, not just user options."
#'(lambda (symbol)
(and (boundp symbol)
(get symbol 'variable-documentation)))
- 'custom-variable-p)))
+ #'custom-variable-p)))
;;;###autoload
(defun apropos-variable (pattern &optional do-not-all)
@@ -556,7 +561,7 @@ or a non-nil `apropos-do-all' argument."
;; For auld lang syne:
;;;###autoload
-(defalias 'command-apropos 'apropos-command)
+(defalias 'command-apropos #'apropos-command)
;;;###autoload
(defun apropos-command (pattern &optional do-all var-predicate)
"Show commands (interactively callable functions) that match PATTERN.
@@ -611,7 +616,7 @@ while a list of strings is used as a word list."
(if (eq doc 'error)
"(documentation error)"
(setq score (+ score (apropos-score-doc doc)))
- (substring doc 0 (string-match "\n" doc)))
+ (substring doc 0 (string-search "\n" doc)))
"(not documented)")))
(and var-predicate
(funcall var-predicate symbol)
@@ -620,7 +625,7 @@ while a list of strings is used as a word list."
(progn
(setq score (+ score (apropos-score-doc doc)))
(substring doc 0
- (string-match "\n" doc)))))))
+ (string-search "\n" doc)))))))
(setcar (cdr (car p)) score)
(setq p (cdr p))))
(and (let ((apropos-multi-type do-all))
@@ -634,7 +639,7 @@ while a list of strings is used as a word list."
"Like (documentation-property SYMBOL PROPERTY RAW) but handle errors."
(condition-case ()
(let ((doc (documentation-property symbol property raw)))
- (if doc (substring doc 0 (string-match "\n" doc))
+ (if doc (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(error "(error retrieving documentation)")))
@@ -685,7 +690,7 @@ FILE should be one of the libraries currently loaded and should
thus be found in `load-history'. If `apropos-do-all' is non-nil,
the output includes key-bindings of commands."
(interactive
- (let* ((libs (delq nil (mapcar 'car load-history)))
+ (let* ((libs (delq nil (mapcar #'car load-history)))
(libs
(nconc (delq nil
(mapcar
@@ -719,22 +724,27 @@ the output includes key-bindings of commands."
;; (autoload (push (cdr x) autoloads))
('require (push (cdr x) requires))
('provide (push (cdr x) provides))
- ('t nil) ; Skip "was an autoload" entries.
+ ('t nil) ; Skip "was an autoload" entries.
;; FIXME: Print information about each individual method: both
;; its docstring and specializers (bug#21422).
('cl-defmethod (push (cadr x) provides))
(_ (push (or (cdr-safe x) x) symbols))))
- (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal.
- (apropos-symbols-internal
- symbols apropos-do-all
- (concat
- (format-message
- "Library `%s' provides: %s\nand requires: %s"
- file
- (mapconcat 'apropos-library-button
- (or provides '(nil)) " and ")
- (mapconcat 'apropos-library-button
- (or requires '(nil)) " and ")))))))
+ (let ((apropos-pattern "") ;Dummy binding for apropos-symbols-internal.
+ (text
+ (concat
+ (format-message
+ "Library `%s' provides: %s\nand requires: %s"
+ file
+ (mapconcat #'apropos-library-button
+ (or provides '(nil)) " and ")
+ (mapconcat #'apropos-library-button
+ (or requires '(nil)) " and ")))))
+ (if (null symbols)
+ (with-output-to-temp-buffer "*Apropos*"
+ (with-current-buffer standard-output
+ (apropos-mode)
+ (apropos--preamble text)))
+ (apropos-symbols-internal symbols apropos-do-all text)))))
(defun apropos-symbols-internal (symbols keys &optional text)
;; Filter out entries that are marked as apropos-inhibit.
@@ -757,7 +767,7 @@ the output includes key-bindings of commands."
"(alias for undefined function)")
(error
"(can't retrieve function documentation)")))
- (substring doc 0 (string-match "\n" doc))
+ (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(when (boundp symbol)
(apropos-documentation-property
@@ -809,34 +819,34 @@ Returns list of symbols and values found."
(apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator ())
- (let (f v p)
- (mapatoms
- (lambda (symbol)
- (setq f nil v nil p nil)
- (or (memq symbol '(apropos-regexp
- apropos-pattern apropos-all-words-regexp
- apropos-words apropos-all-words
- do-all apropos-accumulator
- symbol f v p))
- (setq v (apropos-value-internal 'boundp symbol 'symbol-value)))
- (if do-all
- (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
- p (apropos-format-plist symbol "\n " t)))
- (if (apropos-false-hit-str v)
- (setq v nil))
- (if (apropos-false-hit-str f)
- (setq f nil))
- (if (apropos-false-hit-str p)
- (setq p nil))
- (if (or f v p)
- (setq apropos-accumulator (cons (list symbol
- (+ (apropos-score-str f)
- (apropos-score-str v)
- (apropos-score-str p))
- f v p)
- apropos-accumulator))))))
- (let ((apropos-multi-type do-all))
- (apropos-print nil "\n----------------\n")))
+ (let (f v p)
+ (mapatoms
+ (lambda (symbol)
+ (setq f nil v nil p nil)
+ (or (memq symbol '(apropos-regexp
+ apropos--current apropos-pattern-quoted pattern
+ apropos-pattern apropos-all-words-regexp
+ apropos-words apropos-all-words
+ apropos-accumulator))
+ (setq v (apropos-value-internal #'boundp symbol #'symbol-value)))
+ (if do-all
+ (setq f (apropos-value-internal #'fboundp symbol #'symbol-function)
+ p (apropos-format-plist symbol "\n " t)))
+ (if (apropos-false-hit-str v)
+ (setq v nil))
+ (if (apropos-false-hit-str f)
+ (setq f nil))
+ (if (apropos-false-hit-str p)
+ (setq p nil))
+ (if (or f v p)
+ (setq apropos-accumulator (cons (list symbol
+ (+ (apropos-score-str f)
+ (apropos-score-str v)
+ (apropos-score-str p))
+ f v p)
+ apropos-accumulator))))))
+ (let ((apropos-multi-type do-all))
+ (apropos-print nil "\n----------------\n")))
;;;###autoload
(defun apropos-local-value (pattern &optional buffer)
@@ -851,9 +861,11 @@ Optional arg BUFFER (default: current buffer) is the buffer to check."
(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)))
+ (unless (memq symb '(apropos-regexp apropos-pattern
+ apropos-all-words-regexp apropos-words
+ apropos-all-words apropos-accumulator))
+ (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
@@ -928,7 +940,13 @@ Returns list of symbols and documentation found."
(defun apropos-value-internal (predicate symbol function)
(when (funcall predicate symbol)
- (setq symbol (prin1-to-string (funcall function symbol)))
+ (setq symbol (prin1-to-string
+ (if (memq symbol '(command-history minibuffer-history))
+ ;; The value we're looking for will always be in
+ ;; the first element of these two lists, so skip
+ ;; that value.
+ (cdr (funcall function symbol))
+ (funcall function symbol))))
(when (string-match apropos-regexp symbol)
(if apropos-match-face
(put-text-property (match-beginning 0) (match-end 0)
@@ -1141,10 +1159,7 @@ as a heading."
symbol item)
(set-buffer standard-output)
(apropos-mode)
- (insert (substitute-command-keys "Type \\[apropos-follow] on ")
- (if apropos-multi-type "a type label" "an entry")
- " to view its full documentation.\n\n")
- (if text (insert text "\n\n"))
+ (apropos--preamble text)
(dolist (apropos-item p)
(when (and spacing (not (bobp)))
(princ spacing))
@@ -1274,6 +1289,14 @@ as a heading."
(fill-region opoint (point) nil t)))
(or (bolp) (terpri)))))
+(defun apropos--preamble (text)
+ (let ((inhibit-read-only t))
+ (insert (substitute-command-keys "Type \\[apropos-follow] on ")
+ (if apropos-multi-type "a type label" "an entry")
+ " to view its full documentation.\n\n")
+ (when text
+ (insert text "\n\n"))))
+
(defun apropos-follow ()
"Invokes any button at point, otherwise invokes the nearest label button."
(interactive)
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 6c9ceb0b5a8..71ad7bd0c5d 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -660,11 +660,11 @@ Does not signal an error if optional argument NOERROR is non-nil."
(defun archive-mode (&optional force)
"Major mode for viewing an archive file in a dired-like way.
You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the archive and into its own buffer;
+Letters no longer insert themselves.\\<archive-mode-map>
+Type \\[archive-extract] to pull a file out of the archive and into its own buffer;
or click mouse-2 on the file's line in the archive mode buffer.
-If you edit a sub-file of this archive (as with the `e' command) and
+If you edit a sub-file of this archive (as with the \\[archive-extract] command) and
save it, the contents of that buffer will be saved back into the
archive.
@@ -1707,7 +1707,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(= (get-byte p) ?\C-z)
(> (get-byte (1+ p)) 0))
(let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
- (fnlen (or (string-match "\0" namefld) 13))
+ (fnlen (or (string-search "\0" namefld) 13))
(efnname (decode-coding-string (substring namefld 0 fnlen)
archive-file-name-coding-system))
(csize (archive-l-e (+ p 15) 4))
@@ -2089,7 +2089,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(dirtype (get-byte (+ p 4)))
(lfnlen (if (= dirtype 2) (get-byte (+ p 56)) 0))
(ldirlen (if (= dirtype 2) (get-byte (+ p 57)) 0))
- (fnlen (or (string-match "\0" namefld) 13))
+ (fnlen (or (string-search "\0" namefld) 13))
(efnname (let ((str
(concat
(if (> ldirlen 0)
diff --git a/lisp/array.el b/lisp/array.el
index cd8971bd266..6632da55dd4 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -1,4 +1,4 @@
-;;; array.el --- array editing commands for GNU Emacs
+;;; array.el --- array editing commands for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc.
@@ -769,25 +769,25 @@ Return COLUMN."
(defvar array-mode-map
(let ((map (make-keymap)))
- (define-key map "\M-ad" 'array-display-local-variables)
- (define-key map "\M-am" 'array-make-template)
- (define-key map "\M-ae" 'array-expand-rows)
- (define-key map "\M-ar" 'array-reconfigure-rows)
- (define-key map "\M-a=" 'array-what-position)
- (define-key map "\M-ag" 'array-goto-cell)
- (define-key map "\M-af" 'array-fill-rectangle)
- (define-key map "\C-n" 'array-next-row)
- (define-key map "\C-p" 'array-previous-row)
- (define-key map "\C-f" 'array-forward-column)
- (define-key map "\C-b" 'array-backward-column)
- (define-key map "\M-n" 'array-copy-down)
- (define-key map "\M-p" 'array-copy-up)
- (define-key map "\M-f" 'array-copy-forward)
- (define-key map "\M-b" 'array-copy-backward)
- (define-key map "\M-\C-n" 'array-copy-row-down)
- (define-key map "\M-\C-p" 'array-copy-row-up)
- (define-key map "\M-\C-f" 'array-copy-column-forward)
- (define-key map "\M-\C-b" 'array-copy-column-backward)
+ (define-key map "\M-ad" #'array-display-local-variables)
+ (define-key map "\M-am" #'array-make-template)
+ (define-key map "\M-ae" #'array-expand-rows)
+ (define-key map "\M-ar" #'array-reconfigure-rows)
+ (define-key map "\M-a=" #'array-what-position)
+ (define-key map "\M-ag" #'array-goto-cell)
+ (define-key map "\M-af" #'array-fill-rectangle)
+ (define-key map "\C-n" #'array-next-row)
+ (define-key map "\C-p" #'array-previous-row)
+ (define-key map "\C-f" #'array-forward-column)
+ (define-key map "\C-b" #'array-backward-column)
+ (define-key map "\M-n" #'array-copy-down)
+ (define-key map "\M-p" #'array-copy-up)
+ (define-key map "\M-f" #'array-copy-forward)
+ (define-key map "\M-b" #'array-copy-backward)
+ (define-key map "\M-\C-n" #'array-copy-row-down)
+ (define-key map "\M-\C-p" #'array-copy-row-up)
+ (define-key map "\M-\C-f" #'array-copy-column-forward)
+ (define-key map "\M-\C-b" #'array-copy-column-backward)
map)
"Keymap used in array mode.")
@@ -815,17 +815,17 @@ in array mode may have different values assigned to the variables.
The variables are:
Variables you assign:
- array-max-row: The number of rows in the array.
- array-max-column: The number of columns in the array.
- array-columns-per-line: The number of columns in the array
+ `array-max-row': The number of rows in the array.
+ `array-max-column': The number of columns in the array.
+ `array-columns-per-line': The number of columns in the array
per line of buffer.
- array-field-width: The width of each field, in characters.
- array-rows-numbered: A logical variable describing whether to ignore
+ `array-field-width': The width of each field, in characters.
+ `array-rows-numbered': A logical variable describing whether to ignore
row numbers in the buffer.
Variables which are calculated:
- array-line-length: The number of characters in a buffer line.
- array-lines-per-row: The number of buffer lines used to
+ `array-line-length': The number of characters in a buffer line.
+ `array-lines-per-row': The number of buffer lines used to
display each row.
The following commands are available (an asterisk indicates it may
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 39db1a710bd..914f8d2f1bf 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -6,8 +6,6 @@
;; Nicolas Petton <nicolas@petton.fr>
;; Keith Amidon <camalot@picnicpark.org>
;; Version: 5.0.0
-;; Package-Requires: ((emacs "25"))
-;; Url: https://github.com/DamienCassou/auth-password-store
;; Created: 07 Jun 2015
;; This file is part of GNU Emacs.
@@ -27,16 +25,18 @@
;;; Commentary:
-;; Integrates password-store (http://passwordstore.org/) within
+;; Integrates password-store (https://passwordstore.org/) within
;; auth-source.
;;; Code:
(require 'seq)
-(eval-when-compile (require 'subr-x))
(require 'cl-lib)
(require 'auth-source)
(require 'url-parse)
+;; Use `eval-when-compile' after the other `require's to avoid spurious
+;; "might not be defined at runtime" warnings.
+(eval-when-compile (require 'subr-x))
(defgroup auth-source-pass nil
"password-store integration within auth-source."
@@ -58,14 +58,12 @@
(cl-defun auth-source-pass-search (&rest spec
&key backend type host user port
&allow-other-keys)
- "Given a property list SPEC, return search matches from the :backend.
-See `auth-source-search' for details on SPEC."
+ "Given some search query, return matching credentials.
+
+See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE,
+HOST, USER and PORT."
(cl-assert (or (null type) (eq type (oref backend type)))
t "Invalid password-store search: %s %s")
- (when (consp host)
- (warn "auth-source-pass ignores all but first host in spec.")
- ;; Take the first non-nil item of the list of hosts
- (setq host (seq-find #'identity host)))
(cond ((eq host t)
(warn "auth-source-pass does not handle host wildcards.")
nil)
@@ -76,12 +74,14 @@ See `auth-source-search' for details on SPEC."
(when-let ((result (auth-source-pass--build-result host port user)))
(list result)))))
-(defun auth-source-pass--build-result (host port user)
- "Build auth-source-pass entry matching HOST, PORT and USER."
- (let ((entry-data (auth-source-pass--find-match host user port)))
+(defun auth-source-pass--build-result (hosts port user)
+ "Build auth-source-pass entry matching HOSTS, PORT and USER.
+
+HOSTS can be a string or a list of strings."
+ (let ((entry-data (auth-source-pass--find-match hosts user port)))
(when entry-data
(let ((retval (list
- :host host
+ :host (auth-source-pass--get-attr "host" entry-data)
:port (or (auth-source-pass--get-attr "port" entry-data) port)
:user (or (auth-source-pass--get-attr "user" entry-data) user)
:secret (lambda () (auth-source-pass--get-attr 'secret entry-data)))))
@@ -123,7 +123,7 @@ ENTRY is the name of a password-store entry.
The key used to retrieve the password is the symbol `secret'.
The convention used as the format for a password-store file is
-the following (see http://www.passwordstore.org/#organization):
+the following (see URL `https://www.passwordstore.org/#organization'):
secret
key1: value1
@@ -167,15 +167,13 @@ The secret is the first line of CONTENTS."
(defun auth-source-pass--parse-data (contents)
"Parse the password-store data in the string CONTENTS and return an alist.
CONTENTS is the contents of a password-store formatted file."
- (let ((lines (split-string contents "\n" t "[ \t]+")))
+ (let ((lines (cdr (split-string contents "\n" t "[ \t]+"))))
(seq-remove #'null
(mapcar (lambda (line)
- (let ((pair (mapcar (lambda (s) (string-trim s))
- (split-string line ":"))))
- (when (> (length pair) 1)
- (cons (car pair)
- (mapconcat #'identity (cdr pair) ":")))))
- (cdr lines)))))
+ (when-let ((pos (seq-position line ?:)))
+ (cons (string-trim (substring line 0 pos))
+ (string-trim (substring line (1+ pos))))))
+ lines))))
(defun auth-source-pass--do-debug (&rest msg)
"Call `auth-source-do-debug` with MSG and a prefix."
@@ -192,12 +190,21 @@ CONTENTS is the contents of a password-store formatted file."
(lambda (file) (file-name-sans-extension (file-relative-name file store-dir)))
(directory-files-recursively store-dir "\\.gpg\\'"))))
-(defun auth-source-pass--find-match (host user port)
- "Return password-store entry data matching HOST, USER and PORT.
-
-Disambiguate between user provided inside HOST (e.g., user@server.com) and
-inside USER by giving priority to USER. Same for PORT."
- (apply #'auth-source-pass--find-match-unambiguous (auth-source-pass--disambiguate host user port)))
+(defun auth-source-pass--find-match (hosts user port)
+ "Return password-store entry data matching HOSTS, USER and PORT.
+
+Disambiguate between user provided inside HOSTS (e.g., user@server.com) and
+inside USER by giving priority to USER. Same for PORT.
+HOSTS can be a string or a list of strings."
+ (seq-some (lambda (host)
+ (let ((entry (apply #'auth-source-pass--find-match-unambiguous
+ (auth-source-pass--disambiguate host user port))))
+ (if (or (null entry) (assoc "host" entry))
+ entry
+ (cons (cons "host" host) entry))))
+ (if (listp hosts)
+ hosts
+ (list hosts))))
(defun auth-source-pass--disambiguate (host &optional user port)
"Return (HOST USER PORT) after disambiguation.
@@ -266,7 +273,7 @@ If ENTRIES is nil, use the result of calling `auth-source-pass-entries' instead.
(defun auth-source-pass--generate-entry-suffixes (hostname user port)
"Return a list of possible entry path suffixes in the password-store.
-Based on the supported pathname patterns for HOSTNAME, USER, &
+Based on the supported filename patterns for HOSTNAME, USER, &
PORT, return a list of possible suffixes for matching entries in
the password-store.
@@ -314,3 +321,5 @@ then NAME & USER, then NAME & PORT, then just NAME."
(provide 'auth-source-pass)
;;; auth-source-pass.el ends here
+
+;; LocalWords: backend hostname
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 14cae8a52c7..69197383982 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -121,12 +121,12 @@ let-binding."
:initform nil
:documentation "Internal backend data.")
(create-function :initarg :create-function
- :initform ignore
+ :initform #'ignore
:type function
:custom function
:documentation "The create function.")
(search-function :initarg :search-function
- :initform ignore
+ :initform #'ignore
:type function
:custom function
:documentation "The search function.")))
@@ -162,7 +162,7 @@ let-binding."
(defvar auth-source-creation-prompts nil
"Default prompts for token values. Usually let-bound.")
-(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
+(make-obsolete 'auth-source-hide-passwords nil "24.1")
(defcustom auth-source-save-behavior 'ask
"If set, auth-source will respect it for save behavior."
@@ -1270,7 +1270,7 @@ See `auth-source-search' for details on SPEC."
;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B)))
(cl-defun auth-source-netrc-create (&rest spec
- &key backend host port create
+ &key backend host port create user
&allow-other-keys)
(let* ((base-required '(host user port secret))
;; we know (because of an assertion in auth-source-search) that the
@@ -1278,6 +1278,7 @@ See `auth-source-search' for details on SPEC."
(create-extra (if (eq t create) nil create))
(current-data (car (auth-source-search :max 1
:host host
+ :user user
:port port)))
(required (append base-required create-extra))
(file (oref backend source))
@@ -2307,9 +2308,9 @@ See `auth-source-search' for details on SPEC."
;; deprecate the old interface
(make-obsolete 'auth-source-user-or-password
- 'auth-source-search "Emacs 24.1")
+ 'auth-source-search "24.1")
(make-obsolete 'auth-source-forget-user-or-password
- 'auth-source-forget "Emacs 24.1")
+ 'auth-source-forget "24.1")
(defun auth-source-user-or-password
(mode host port &optional username create-missing delete-existing)
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index c2cb0c7051c..7c2c6f1030d 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -107,7 +107,7 @@ then invokes the normal binding of \\[autoarg-terminate].
`C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times.
\\{autoarg-mode-map}"
- nil " Aarg" autoarg-mode-map :global t :group 'keyboard)
+ :lighter" Aarg" :global t :group 'keyboard)
;;;###autoload
(define-minor-mode autoarg-kp-mode
@@ -118,7 +118,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
`kp-1' etc. to supply digit arguments.
\\{autoarg-kp-mode-map}"
- nil " Aakp" autoarg-kp-mode-map :global t :group 'keyboard
+ :lighter " Aakp" :global t :group 'keyboard
(if autoarg-kp-mode
(dotimes (i 10)
(let ((sym (intern (format "kp-%d" i))))
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 0392903c332..995d9e2e0fe 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -93,8 +93,8 @@ If this contains a %s, that will be replaced by the matching rule."
'((("\\.\\([Hh]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'" . "C / C++ header")
(replace-regexp-in-string
"[^A-Z0-9]" "_"
- (replace-regexp-in-string
- "\\+" "P"
+ (string-replace
+ "+" "P"
(upcase (file-name-nondirectory buffer-file-name))))
"#ifndef " str \n
"#define " str "\n\n"
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 57258f9c833..9197eadf225 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -227,10 +227,10 @@ modes, etc., of files. You may still sometimes want to revert
them manually.
Use this option with care since it could lead to excessive auto-reverts.
-For more information, see Info node `(emacs)Autorevert'."
+For more information, see Info node `(emacs)Auto Revert'."
:group 'auto-revert
:type 'boolean
- :link '(info-link "(emacs)Autorevert"))
+ :link '(info-link "(emacs)Auto Revert"))
(defcustom global-auto-revert-ignore-modes ()
"List of major modes Global Auto-Revert Mode should not check."
@@ -391,6 +391,10 @@ disk changes.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
+Reverting can sometimes fail to preserve all the markers in the buffer.
+To avoid that, set `revert-buffer-insert-file-contents-function' to
+the slower function `revert-buffer-insert-file-contents-delicately'.
+
Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer."
@@ -937,7 +941,6 @@ the timer when no buffers need to be checked."
(cancel-timer auto-revert-timer))
(setq auto-revert-timer nil)))))
-;; The end:
(provide 'autorevert)
(run-hooks 'auto-revert-load-hook)
diff --git a/lisp/avoid.el b/lisp/avoid.el
index b53584ba9c5..d3afecf8cc2 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -1,4 +1,4 @@
-;;; avoid.el --- make mouse pointer stay out of the way of editing
+;;; avoid.el --- make mouse pointer stay out of the way of editing -*- lexical-binding: t -*-
;; Copyright (C) 1993-1994, 2000-2021 Free Software Foundation, Inc.
@@ -25,8 +25,10 @@
;; For those who are annoyed by the mouse pointer obscuring text,
;; this mode moves the mouse pointer - either just a little out of
;; the way, or all the way to the corner of the frame.
-;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
-;; To set up permanently, put the following in your .emacs:
+;;
+;; To use, type `M-x mouse-avoidance-mode'.
+;;
+;; To set up permanently, put this in your .emacs:
;;
;; (if (display-mouse-p) (mouse-avoidance-mode 'animate))
;;
@@ -47,11 +49,6 @@
;;
;; For completely random pointer shape, replace the setq above with:
;; (setq x-pointer-shape (mouse-avoidance-random-shape))
-;;
-;; Bugs / Warnings / To-Do:
-;;
-;; - Using this code does slow Emacs down. "banish" mode shouldn't
-;; be too bad, and on my workstation even "animate" is reasonable.
;; Credits:
;; This code was helped by all those who contributed suggestions,
@@ -76,14 +73,13 @@
"Activate Mouse Avoidance mode.
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `mouse-avoidance-mode'."
+use either \\[customize] or \\[mouse-avoidance-mode]."
:set (lambda (_symbol value)
;; 'none below prevents toggling when value is nil.
(mouse-avoidance-mode (or value 'none)))
:initialize 'custom-initialize-default
:type '(choice (const :tag "none" nil) (const banish) (const jump)
(const animate) (const exile) (const proteus))
- :group 'avoid
:require 'avoid
:version "20.3")
@@ -92,25 +88,21 @@ use either \\[customize] or the function `mouse-avoidance-mode'."
"Average distance that mouse will be moved when approached by cursor.
Only applies in Mouse Avoidance mode `jump' and its derivatives.
For best results make this larger than `mouse-avoidance-threshold'."
- :type 'integer
- :group 'avoid)
+ :type 'integer)
(defcustom mouse-avoidance-nudge-var 10
"Variability of `mouse-avoidance-nudge-dist' (which see)."
- :type 'integer
- :group 'avoid)
+ :type 'integer)
(defcustom mouse-avoidance-animation-delay .01
"Delay between animation steps, in seconds."
- :type 'number
- :group 'avoid)
+ :type 'number)
(defcustom mouse-avoidance-threshold 5
"Mouse-pointer's flight distance.
If the cursor gets closer than this, the mouse pointer will move away.
Only applies in Mouse Avoidance modes `animate' and `jump'."
- :type 'integer
- :group 'avoid)
+ :type 'integer)
(defcustom mouse-avoidance-banish-position '((frame-or-window . frame)
(side . right)
@@ -261,9 +253,9 @@ If you want the mouse banished to a different corner set
(t 0))))
(defun mouse-avoidance-nudge-mouse ()
- ;; Push the mouse a little way away, possibly animating the move.
- ;; For these modes, state keeps track of the total offset that we've
- ;; accumulated, and tries to keep it close to zero.
+ "Push the mouse a little way away, possibly animating the move.
+For these modes, state keeps track of the total offset that we've
+accumulated, and tries to keep it close to zero."
(let* ((cur (mouse-position))
(cur-pos (cdr cur))
(pos (window-edges))
@@ -375,7 +367,7 @@ redefine this function to suit your own tastes."
(setq mouse-avoidance-state nil))))))
(defun mouse-avoidance-fancy ()
- ;; Used for the "fancy" modes, ie jump et al.
+ ;; Used for the "fancy" modes, i.e. jump et al.
(if (and (not mouse-avoidance-animating-pointer)
(not (mouse-avoidance-ignore-p))
(mouse-avoidance-too-close-p (mouse-position)))
@@ -383,7 +375,7 @@ redefine this function to suit your own tastes."
(mouse-avoidance-nudge-mouse)
(if (not (eq (selected-frame) (car old-pos)))
;; This should never happen.
- (apply 'set-mouse-position old-pos)))))
+ (apply #'set-mouse-position old-pos)))))
;;;###autoload
(defun mouse-avoidance-mode (&optional mode)
diff --git a/lisp/battery.el b/lisp/battery.el
index 77ad73d15d7..bf864c2bd4a 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -161,9 +161,9 @@ The full `format-spec' formatting syntax is supported."
(defcustom battery-mode-line-format
(cond ((eq battery-status-function #'battery-linux-proc-acpi)
- "[%b%p%%,%d°C]")
+ "[%b%p%%,%d°C] ")
(battery-status-function
- "[%b%p%%]"))
+ "[%b%p%%] "))
"Control string formatting the string to display in the mode line.
Ordinary characters in the control string are printed as-is, while
conversion specifications introduced by a `%' character in the control
@@ -246,7 +246,7 @@ seconds."
(add-to-list 'global-mode-string 'battery-mode-line-string t)
(and (eq battery-status-function #'battery-upower)
battery-upower-subscribe
- (battery--upower-subsribe))
+ (battery--upower-subscribe))
(setq battery-update-timer (run-at-time nil battery-update-interval
#'battery-update-handler))
(battery-update))
@@ -634,7 +634,7 @@ Intended as a UPower PropertiesChanged signal handler."
(mapc #'dbus-unregister-object battery--upower-signals)
(setq battery--upower-signals ()))
-(defun battery--upower-subsribe ()
+(defun battery--upower-subscribe ()
"Subscribe to UPower device change signals."
(push (dbus-register-signal :system battery-upower-service
battery-upower-path
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2f4bab11cf5..03459448943 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -330,22 +330,53 @@ of the menu's data."
(defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\
Menu of mode operations in the mode line.")
+(defun bindings--menu-item-string (item)
+ "Return the menu-item string for ITEM, or nil if not a menu-item."
+ (pcase item
+ (`(menu-item ,name . ,_) (eval name t))
+ (`(,(and (pred stringp) name) . ,_) name)))
+
+(defun bindings--sort-menu-keymap (map)
+ "Sort the bindings in MAP in alphabetical order by menu-item string.
+The order of bindings in a keymap matters only when it is used as
+a menu, so this function is not useful for non-menu keymaps."
+ (let ((bindings nil)
+ (prompt (keymap-prompt map)))
+ (while (keymapp map)
+ (setq map (map-keymap
+ (lambda (key item)
+ ;; FIXME: Handle char-ranges here?
+ (push (cons key item) bindings))
+ map)))
+ ;; Sort the bindings and make a new keymap from them.
+ (setq bindings
+ (sort bindings
+ (lambda (a b)
+ (string< (bindings--menu-item-string (cdr-safe a))
+ (bindings--menu-item-string (cdr-safe b))))))
+ (nconc (make-sparse-keymap prompt) bindings)))
+
(defvar mode-line-major-mode-keymap
(let ((map (make-sparse-keymap)))
(bindings--define-key map [mode-line down-mouse-1]
`(menu-item "Menu Bar" ignore
:filter ,(lambda (_) (mouse-menu-major-mode-map))))
(define-key map [mode-line mouse-2] 'describe-mode)
- (define-key map [mode-line down-mouse-3] mode-line-mode-menu)
+ (bindings--define-key map [mode-line down-mouse-3]
+ `(menu-item "Minor Modes" ,mode-line-mode-menu
+ :filter bindings--sort-menu-keymap))
map) "\
Keymap to display on major mode.")
(defvar mode-line-minor-mode-keymap
- (let ((map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap))
+ (mode-menu-binding
+ `(menu-item "Menu Bar" ,mode-line-mode-menu
+ :filter bindings--sort-menu-keymap)))
(define-key map [mode-line down-mouse-1] 'mouse-minor-mode-menu)
(define-key map [mode-line mouse-2] 'mode-line-minor-mode-help)
- (define-key map [mode-line down-mouse-3] mode-line-mode-menu)
- (define-key map [header-line down-mouse-3] mode-line-mode-menu)
+ (define-key map [mode-line down-mouse-3] mode-menu-binding)
+ (define-key map [header-line down-mouse-3] mode-menu-binding)
map) "\
Keymap to display on minor modes.")
@@ -432,7 +463,9 @@ displayed in `mode-line-position', a component of the default
(defcustom mode-line-position-line-format '(" L%l")
"Format used to display line numbers in the mode line.
This is used when `line-number-mode' is switched on. The \"%l\"
-format spec will be replaced by the line number."
+format spec will be replaced by the line number.
+
+Also see `mode-line-position-column-line-format'."
:type '(list string)
:version "28.1"
:group 'mode-line)
@@ -440,9 +473,10 @@ format spec will be replaced by the line number."
(defcustom mode-line-position-column-format '(" C%c")
"Format used to display column numbers in the mode line.
This is used when `column-number-mode' is switched on. The
-\"%c\" format spec will be replaced by the column number, which
-is zero-based if `column-number-indicator-zero-based' is non-nil,
-and one-based if `column-number-indicator-zero-based' is nil."
+\"%c\" format spec is replaced by the zero-based column number,
+and \"%C\" is replaced by the one-based column number.
+
+Also see `mode-line-position-column-line-format'."
:type '(list string)
:version "28.1"
:group 'mode-line)
@@ -549,7 +583,7 @@ Major modes that edit things other than ordinary files may change this
(put 'mode-line-buffer-identification 'risky-local-variable t)
(defvar mode-line-misc-info
- '((global-mode-string ("" global-mode-string " ")))
+ '((global-mode-string ("" global-mode-string)))
"Mode line construct for miscellaneous information.
By default, this shows the information specified by `global-mode-string'.")
(put 'mode-line-misc-info 'risky-local-variable t)
@@ -610,7 +644,9 @@ Switch to the most recently selected buffer other than the current one."
(previous-buffer)))
(defmacro bound-and-true-p (var)
- "Return the value of symbol VAR if it is bound, else nil."
+ "Return the value of symbol VAR if it is bound, else nil.
+Note that if `lexical-binding' is in effect, this function isn't
+meaningful if it refers to a lexically bound variable."
`(and (boundp (quote ,var)) ,var))
;; Use mode-line-mode-menu for local minor-modes only.
@@ -950,6 +986,12 @@ if `inhibit-field-text-motion' is non-nil."
;; Richard said that we should not use C-x <uppercase letter> and I have
;; no idea whereas to bind it. Any suggestion welcome. -stef
;; (define-key ctl-x-map "U" 'undo-only)
+(defvar undo-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "u" 'undo)
+ map)
+ "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.")
+(put 'undo 'repeat-map 'undo-repeat-map)
(define-key esc-map "!" 'shell-command)
(define-key esc-map "|" 'shell-command-on-region)
@@ -1036,6 +1078,17 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "`" 'next-error)
+(defvar next-error-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "n" 'next-error)
+ (define-key map "\M-n" 'next-error)
+ (define-key map "p" 'previous-error)
+ (define-key map "\M-p" 'previous-error)
+ map)
+ "Keymap to repeat next-error key sequences. Used in `repeat-mode'.")
+(put 'next-error 'repeat-map 'next-error-repeat-map)
+(put 'previous-error 'repeat-map 'next-error-repeat-map)
+
(defvar goto-map (make-sparse-keymap)
"Keymap for navigation commands.")
(define-key esc-map "g" goto-map)
@@ -1194,7 +1247,7 @@ if `inhibit-field-text-motion' is non-nil."
;; (define-key global-map [kp-9] 'function-key-error)
;; (define-key global-map [kp-equal] 'function-key-error)
-;; X11R6 distinguishes these keys from the non-kp keys.
+;; X11 distinguishes these keys from the non-kp keys.
;; Make them behave like the non-kp keys unless otherwise bound.
;; FIXME: rather than list such mappings for every modifier-combination,
;; we should come up with a way to do it generically, something like
@@ -1415,7 +1468,8 @@ if `inhibit-field-text-motion' is non-nil."
(defvar ctl-x-x-map
(let ((map (make-sparse-keymap)))
- (define-key map "g" #'revert-buffer)
+ (define-key map "f" #'font-lock-update)
+ (define-key map "g" #'revert-buffer-quick)
(define-key map "r" #'rename-buffer)
(define-key map "u" #'rename-uniquely)
(define-key map "n" #'clone-buffer)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index dcf8ff0d0af..ff9b8ab1388 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -121,6 +121,12 @@ recently set ones come first, oldest ones come last)."
:type 'boolean)
+(defcustom bookmark-menu-confirm-deletion nil
+ "Non-nil means confirm before deleting bookmarks in a bookmark menu buffer.
+Nil means don't prompt for confirmation."
+ :version "28.1"
+ :type 'boolean)
+
(defcustom bookmark-automatically-show-annotations t
"Non-nil means show annotations when jumping to a bookmark."
:type 'boolean)
@@ -167,12 +173,34 @@ A non-nil value may result in truncated bookmark names."
"Time before `bookmark-bmenu-search' updates the display."
:type 'number)
+(defcustom bookmark-fontify t
+ "Whether to colorize a bookmarked line.
+If non-nil, setting a bookmark will colorize the current line with
+`bookmark-face'."
+ :type 'boolean
+ :version "28.1")
+
;; FIXME: No longer used. Should be declared obsolete or removed.
(defface bookmark-menu-heading
'((t (:inherit font-lock-type-face)))
"Face used to highlight the heading in bookmark menu buffers."
:version "22.1")
+(defface bookmark-face
+ '((((class grayscale)
+ (background light))
+ :background "DimGray")
+ (((class grayscale)
+ (background dark))
+ :background "LightGray")
+ (((class color)
+ (background light))
+ :foreground "White" :background "DarkOrange1")
+ (((class color)
+ (background dark))
+ :foreground "Black" :background "DarkOrange1"))
+ "Face used to highlight current line."
+ :version "28.1")
;;; No user-serviceable parts beyond this point.
@@ -427,6 +455,30 @@ In other words, return all information but the name."
(defvar bookmark-history nil
"The history list for bookmark functions.")
+(defun bookmark--fontify ()
+ "Apply a colorized overlay to the bookmarked location.
+See user option `bookmark-fontify'."
+ (let ((bm (make-overlay (point-at-bol)
+ (min (point-max) (1+ (point-at-eol))))))
+ (overlay-put bm 'category 'bookmark)
+ (overlay-put bm 'face 'bookmark-face)))
+
+(defun bookmark--unfontify (bm)
+ "Remove a bookmark's colorized overlay.
+BM is a bookmark as returned from function `bookmark-get-bookmark'.
+See user option `bookmark-fontify'."
+ (let ((filename (cdr (assq 'filename bm)))
+ (pos (cdr (assq 'position bm)))
+ overlays found temp)
+ (when (and pos filename)
+ (setq filename (expand-file-name filename))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (equal filename buffer-file-name)
+ (setq overlays (overlays-at pos))
+ (while (and (not found) (setq temp (pop overlays)))
+ (when (eq 'bookmark (overlay-get temp 'category))
+ (delete-overlay (setq found temp))))))))))
(defun bookmark-completing-read (prompt &optional default)
"Prompting with PROMPT, read a bookmark name in completion.
@@ -509,10 +561,14 @@ old one."
(set-text-properties 0 (length stripped-name) nil stripped-name)
(if (and (not no-overwrite)
(bookmark-get-bookmark stripped-name 'noerror))
- ;; already existing bookmark under that name and
- ;; no prefix arg means just overwrite old bookmark
- ;; Use the new (NAME . ALIST) format.
- (setcdr (bookmark-get-bookmark stripped-name) alist)
+ ;; Already existing bookmark under that name and
+ ;; no prefix arg means just overwrite old bookmark.
+ (let ((bm (bookmark-get-bookmark stripped-name)))
+ ;; First clean up if previously location was fontified.
+ (when bookmark-fontify
+ (bookmark--unfontify bm))
+ ;; Modify using the new (NAME . ALIST) format.
+ (setcdr bm alist))
;; otherwise just cons it onto the front (either the bookmark
;; doesn't exist already, or there is no prefix arg. In either
@@ -825,7 +881,9 @@ still there, in order, if the topmost one is ever deleted."
;; Ask for an annotation buffer for this bookmark
(when bookmark-use-annotations
- (bookmark-edit-annotation str))))
+ (bookmark-edit-annotation str))
+ (when bookmark-fontify
+ (bookmark--fontify))))
(setq bookmark-yank-point nil)
(setq bookmark-current-buffer nil)))
@@ -953,7 +1011,7 @@ When you have finished composing, type \\[bookmark-send-edited-annotation].
(defun bookmark-send-edited-annotation ()
"Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
- (interactive)
+ (interactive nil bookmark-edit-annotation-mode)
(if (not (derived-mode-p 'bookmark-edit-annotation-mode))
(error "Not in bookmark-edit-annotation-mode"))
(goto-char (point-min))
@@ -1040,6 +1098,14 @@ it to the name of the bookmark currently being set, advancing
(car dired-directory)))
(t (error "Buffer not visiting a file or directory")))))
+(defvar bookmark--watch-already-asked-mtime nil
+ "Mtime for which we already queried about reloading.")
+
+(defun bookmark--watch-file-already-queried-p (new-mtime)
+ ;; Don't ask repeatedly if user already said "no" to reloading a
+ ;; file with this mtime:
+ (prog1 (equal new-mtime bookmark--watch-already-asked-mtime)
+ (setq bookmark--watch-already-asked-mtime new-mtime)))
(defun bookmark-maybe-load-default-file ()
"If bookmarks have not been loaded from the default place, load them."
@@ -1048,13 +1114,15 @@ it to the name of the bookmark currently being set, advancing
(file-readable-p bookmark-default-file)
(bookmark-load bookmark-default-file t t)))
((and bookmark-watch-bookmark-file
- (not (equal (nth 5 (file-attributes
- (car bookmark-bookmarks-timestamp)))
- (cdr bookmark-bookmarks-timestamp)))
- (or (eq 'silent bookmark-watch-bookmark-file)
- (yes-or-no-p
- (format "Bookmarks %s changed on disk. Reload? "
- (car bookmark-bookmarks-timestamp)))))
+ (let ((new-mtime (nth 5 (file-attributes
+ (car bookmark-bookmarks-timestamp))))
+ (old-mtime (cdr bookmark-bookmarks-timestamp)))
+ (and (not (equal new-mtime old-mtime))
+ (not (bookmark--watch-file-already-queried-p new-mtime))
+ (or (eq 'silent bookmark-watch-bookmark-file)
+ (yes-or-no-p
+ (format "Bookmarks %s changed on disk. Reload? "
+ (car bookmark-bookmarks-timestamp)))))))
(bookmark-load (car bookmark-bookmarks-timestamp) t t))))
(defun bookmark-maybe-sort-alist ()
@@ -1084,6 +1152,14 @@ and then show any annotations for this bookmark."
(if win (set-window-point win (point))))
;; FIXME: we used to only run bookmark-after-jump-hook in
;; `bookmark-jump' itself, but in none of the other commands.
+ (when bookmark-fontify
+ (let ((overlays (overlays-at (point)))
+ temp found)
+ (while (and (not found) (setq temp (pop overlays)))
+ (when (eq 'bookmark (overlay-get temp 'category))
+ (setq found t)))
+ (unless found
+ (bookmark--fontify))))
(run-hooks 'bookmark-after-jump-hook)
(if bookmark-automatically-show-annotations
;; if there is an annotation for this bookmark,
@@ -1347,6 +1423,7 @@ probably because we were called from there."
(bookmark-maybe-historicize-string bookmark-name)
(bookmark-maybe-load-default-file)
(let ((will-go (bookmark-get-bookmark bookmark-name 'noerror)))
+ (bookmark--unfontify will-go)
(setq bookmark-alist (delq will-go bookmark-alist))
;; Added by db, nil bookmark-current-bookmark if the last
;; occurrence has been deleted
@@ -1366,6 +1443,13 @@ probably because we were called from there."
If optional argument NO-CONFIRM is non-nil, don't ask for
confirmation."
(interactive "P")
+ ;; We don't use `bookmark-menu-confirm-deletion' here because that
+ ;; variable is specifically to control confirmation prompting in a
+ ;; bookmark menu buffer, where the user has the marked-for-deletion
+ ;; bookmarks arrayed in front of them and might have accidentally
+ ;; hit the key that executes the deletions. The UI situation here
+ ;; is quite different, by contrast: the user got to this point by a
+ ;; sequence of keystrokes unlikely to be typed by chance.
(when (or no-confirm
(yes-or-no-p "Permanently delete all bookmarks? "))
(bookmark-maybe-load-default-file)
@@ -1827,7 +1911,7 @@ This is used for `tabulated-list-format' in `bookmark-bmenu-mode'."
(defun bookmark-bmenu-toggle-filenames (&optional show)
"Toggle whether filenames are shown in the bookmark list.
Optional argument SHOW means show them unconditionally."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(cond
(show
(setq bookmark-bmenu-toggle-filenames t))
@@ -1912,14 +1996,14 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(tabulated-list-put-tag ">" t))
(defun bookmark-bmenu-mark-all ()
"Mark all listed bookmarks to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@@ -1930,7 +2014,7 @@ If the annotation does not exist, do nothing."
(defun bookmark-bmenu-select ()
"Select this line's bookmark; also display bookmarks marked with `>'.
You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] or \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark-all] commands."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(others ())
@@ -1974,8 +2058,11 @@ You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mar
(defun bookmark-bmenu-save ()
"Save the current list into a bookmark file.
-With a prefix arg, prompts for a file to save them in."
- (interactive)
+With a prefix arg, prompts for a file to save them in.
+
+See also the related behaviors of `bookmark-load' and
+`bookmark-bmenu-load'."
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(save-window-excursion
(call-interactively 'bookmark-save)
@@ -1983,8 +2070,20 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-load ()
- "Load the bookmark file and rebuild the bookmark menu-buffer."
- (interactive)
+ "Load bookmarks from a file and rebuild the bookmark menu-buffer.
+Prompt for a file, with the default choice being the value of
+`bookmark-default-file'.
+
+With a prefix argument, replace the current ambient bookmarks
+(i.e., the ones in `bookmark-alist') with the ones from the selected
+file and make that file be the new value of `bookmark-default-file'.
+In other words, a prefix argument means \"switch over to the bookmark
+universe defined in the loaded file\". Without a prefix argument,
+just add the loaded bookmarks into the current ambient set.
+
+See the documentation for `bookmark-load' for more details; see also
+the related behaviors of `bookmark-save' and `bookmark-bmenu-save'."
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(save-excursion
(save-window-excursion
@@ -1994,7 +2093,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-1-window ()
"Select this line's bookmark, alone, in full frame."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-jump (bookmark-bmenu-bookmark))
(bury-buffer (other-buffer))
(delete-other-windows))
@@ -2002,7 +2101,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-2-window ()
"Select this line's bookmark, with previous buffer in second window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(pop-up-windows t))
@@ -2014,20 +2113,20 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-this-window ()
"Select this line's bookmark in this window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-jump (bookmark-bmenu-bookmark)))
(defun bookmark-bmenu-other-window ()
"Select this line's bookmark in other window, leaving bookmark menu visible."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark--jump-via bookmark 'switch-to-buffer-other-window)))
(defun bookmark-bmenu-other-frame ()
"Select this line's bookmark in other frame."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark))
(pop-up-frames t))
(bookmark-jump-other-window bookmark)))
@@ -2035,7 +2134,7 @@ With a prefix arg, prompts for a file to save them in."
(defun bookmark-bmenu-switch-other-window ()
"Make the other window select this line's bookmark.
The current window remains selected."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark))
(fun (lambda (b) (display-buffer b t))))
(bookmark--jump-via bookmark fun)))
@@ -2044,7 +2143,7 @@ The current window remains selected."
"Jump to bookmark at mouse EVENT position in other window.
Move point in menu buffer to the position of EVENT and leave
bookmark menu visible."
- (interactive "e")
+ (interactive "e" bookmark-bmenu-mode)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
@@ -2053,20 +2152,20 @@ bookmark menu visible."
(defun bookmark-bmenu-show-annotation ()
"Show the annotation for the current bookmark in another window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark-show-annotation bookmark)))
(defun bookmark-bmenu-show-all-annotations ()
"Show the annotation for all bookmarks in another window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-show-all-annotations))
(defun bookmark-bmenu-edit-annotation ()
"Edit the annotation for the current bookmark in another window."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bookmark (bookmark-bmenu-bookmark)))
(bookmark-edit-annotation bookmark t)))
@@ -2074,7 +2173,7 @@ bookmark menu visible."
(defun bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
- (interactive "P")
+ (interactive "P" bookmark-bmenu-mode)
;; any flags to reset according to circumstances? How about a
;; flag indicating whether this bookmark is being visited?
;; well, we don't have this now, so maybe later.
@@ -2085,7 +2184,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-backup-unmark ()
"Move up and cancel all requested operations on bookmark on line above."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(forward-line -1)
(bookmark-bmenu-ensure-position)
(bookmark-bmenu-unmark)
@@ -2095,7 +2194,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-unmark-all ()
"Cancel all requested operations on all listed bookmarks."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@@ -2106,7 +2205,7 @@ Optional BACKUP means move up."
(defun bookmark-bmenu-delete ()
"Mark bookmark on this line to be deleted.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-ensure-position)
(tabulated-list-put-tag "D" t))
@@ -2114,7 +2213,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-delete-backwards ()
"Mark bookmark on this line to be deleted, then move up one line.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(bookmark-bmenu-delete)
(forward-line -2))
@@ -2123,7 +2222,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
"Mark all listed bookmarks as to be deleted.
To remove all deletion marks, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-unmark-all].
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(save-excursion
(goto-char (point-min))
(bookmark-bmenu-ensure-position)
@@ -2132,35 +2231,40 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-execute-deletions ()
- "Delete bookmarks flagged `D'."
- (interactive)
- (let ((reporter (make-progress-reporter "Deleting bookmarks..."))
- (o-point (point))
- (o-str (save-excursion
- (beginning-of-line)
- (unless (= (following-char) ?D)
- (buffer-substring
- (point)
- (progn (end-of-line) (point))))))
- (o-col (current-column)))
- (goto-char (point-min))
- (while (re-search-forward "^D" (point-max) t)
- (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
- (bookmark-bmenu-list)
- (if o-str
- (progn
- (goto-char (point-min))
- (search-forward o-str)
- (beginning-of-line)
- (forward-char o-col))
- (goto-char o-point))
- (beginning-of-line)
- (progress-reporter-done reporter)))
+ "Delete bookmarks flagged `D'.
+If `bookmark-menu-confirm-deletion' is non-nil, prompt for
+confirmation first."
+ (interactive nil bookmark-bmenu-mode)
+ (if (and bookmark-menu-confirm-deletion
+ (not (yes-or-no-p "Delete selected bookmarks? ")))
+ (message "Bookmarks not deleted.")
+ (let ((reporter (make-progress-reporter "Deleting bookmarks..."))
+ (o-point (point))
+ (o-str (save-excursion
+ (beginning-of-line)
+ (unless (= (following-char) ?D)
+ (buffer-substring
+ (point)
+ (progn (end-of-line) (point))))))
+ (o-col (current-column)))
+ (goto-char (point-min))
+ (while (re-search-forward "^D" (point-max) t)
+ (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
+ (bookmark-bmenu-list)
+ (if o-str
+ (progn
+ (goto-char (point-min))
+ (search-forward o-str)
+ (beginning-of-line)
+ (forward-char o-col))
+ (goto-char o-point))
+ (beginning-of-line)
+ (progress-reporter-done reporter))))
(defun bookmark-bmenu-rename ()
"Rename bookmark on current line. Prompts for a new name."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-rename bmrk)
@@ -2169,14 +2273,14 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-locate ()
"Display location of this bookmark. Displays in the minibuffer."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark)))
(message "%s" (bookmark-location bmrk))))
(defun bookmark-bmenu-relocate ()
"Change the absolute file name of the bookmark on the current line.
Prompt with completion for the new path."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-relocate bmrk)
@@ -2196,7 +2300,7 @@ Prompt with completion for the new path."
;;;###autoload
(defun bookmark-bmenu-search ()
"Incremental search of bookmarks, hiding the non-matches as we go."
- (interactive)
+ (interactive nil bookmark-bmenu-mode)
(let ((bmk (bookmark-bmenu-bookmark))
(timer nil))
(unwind-protect
diff --git a/lisp/bs.el b/lisp/bs.el
index 9ed0ee5f0ae..494bc426188 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -120,8 +120,6 @@
;; can cycle through all file buffers and *scratch* although your current
;; configuration perhaps is "files" which ignores buffer *scratch*.
-;;; History:
-
;;; Code:
;; ----------------------------------------------------------------------
@@ -1506,7 +1504,6 @@ name of buffer configuration."
;; continue standard unloading
nil)
-;; Now provide feature bs
(provide 'bs)
;;; bs.el ends here
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index bb39e1f5795..340c926f8d6 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -117,8 +117,7 @@ This is set by the prefix argument to `buffer-menu' and related
commands.")
(defvar Buffer-menu-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "v" 'Buffer-menu-select)
(define-key map "2" 'Buffer-menu-2-window)
@@ -152,82 +151,63 @@ commands.")
(define-key map [mouse-2] 'Buffer-menu-mouse-select)
(define-key map [follow-link] 'mouse-face)
-
- (define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map))
- (bindings--define-key menu-map [quit]
- '(menu-item "Quit" quit-window
- :help "Remove the buffer menu from the display"))
- (bindings--define-key menu-map [rev]
- '(menu-item "Refresh" revert-buffer
- :help "Refresh the *Buffer List* buffer contents"))
- (bindings--define-key menu-map [s0] menu-bar-separator)
- (bindings--define-key menu-map [tf]
- '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only
- :button (:toggle . Buffer-menu-files-only)
- :help "Toggle whether the current buffer-menu displays only file buffers"))
- (bindings--define-key menu-map [s1] menu-bar-separator)
- ;; FIXME: The "Select" entries could use better names...
- (bindings--define-key menu-map [sel]
- '(menu-item "Select Marked" Buffer-menu-select
- :help "Select this line's buffer; also display buffers marked with `>'"))
- (bindings--define-key menu-map [bm2]
- '(menu-item "Select Two" Buffer-menu-2-window
- :help "Select this line's buffer, with previous buffer in second window"))
- (bindings--define-key menu-map [bm1]
- '(menu-item "Select Current" Buffer-menu-1-window
- :help "Select this line's buffer, alone, in full frame"))
- (bindings--define-key menu-map [ow]
- '(menu-item "Select in Other Window" Buffer-menu-other-window
- :help "Select this line's buffer in other window, leaving buffer menu visible"))
- (bindings--define-key menu-map [tw]
- '(menu-item "Select in Current Window" Buffer-menu-this-window
- :help "Select this line's buffer in this window"))
- (bindings--define-key menu-map [s2] menu-bar-separator)
- (bindings--define-key menu-map [is]
- '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
- :help "Search for a regexp through all marked buffers using Isearch"))
- (bindings--define-key menu-map [ir]
- '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers
- :help "Search for a string through all marked buffers using Isearch"))
- (bindings--define-key menu-map [mo]
- '(menu-item "Multi Occur Marked Buffers..." Buffer-menu-multi-occur
- :help "Show lines matching a regexp in marked buffers using Occur"))
- (bindings--define-key menu-map [s3] menu-bar-separator)
- (bindings--define-key menu-map [by]
- '(menu-item "Bury" Buffer-menu-bury
- :help "Bury the buffer listed on this line"))
- (bindings--define-key menu-map [vt]
- '(menu-item "Set Unmodified" Buffer-menu-not-modified
- :help "Mark buffer on this line as unmodified (no changes to save)"))
- (bindings--define-key menu-map [ex]
- '(menu-item "Execute" Buffer-menu-execute
- :help "Save and/or delete buffers marked with s or k commands"))
- (bindings--define-key menu-map [s4] menu-bar-separator)
- (bindings--define-key menu-map [delb]
- '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
- :help "Mark buffer on this line to be deleted by x command and move up one line"))
- (bindings--define-key menu-map [del]
- '(menu-item "Mark for Delete" Buffer-menu-delete
- :help "Mark buffer on this line to be deleted by x command"))
-
- (bindings--define-key menu-map [sv]
- '(menu-item "Mark for Save" Buffer-menu-save
- :help "Mark buffer on this line to be saved by x command"))
- (bindings--define-key menu-map [umk]
- '(menu-item "Unmark" Buffer-menu-unmark
- :help "Cancel all requested operations on buffer on this line and move down"))
- (bindings--define-key menu-map [umkab]
- '(menu-item "Remove marks..." Buffer-menu-unmark-all-buffers
- :help "Cancel a requested operation on all buffers"))
- (bindings--define-key menu-map [umka]
- '(menu-item "Unmark all" Buffer-menu-unmark-all
- :help "Cancel all requested operations on buffers"))
- (bindings--define-key menu-map [mk]
- '(menu-item "Mark" Buffer-menu-mark
- :help "Mark buffer on this line for being displayed by v command"))
map)
"Local keymap for `Buffer-menu-mode' buffers.")
+(easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map
+ "Menu for `Buffer-menu-mode' buffers."
+ '("Buffer-Menu"
+ ["Mark" Buffer-menu-mark
+ :help "Mark buffer on this line for being displayed by v command"]
+ ["Unmark all" Buffer-menu-unmark-all
+ :help "Cancel all requested operations on buffers"]
+ ["Remove marks..." Buffer-menu-unmark-all-buffers
+ :help "Cancel a requested operation on all buffers"]
+ ["Unmark" Buffer-menu-unmark
+ :help "Cancel all requested operations on buffer on this line and move down"]
+ ["Mark for Save" Buffer-menu-save
+ :help "Mark buffer on this line to be saved by x command"]
+ ["Mark for Delete" Buffer-menu-delete
+ :help "Mark buffer on this line to be deleted by x command"]
+ ["Mark for Delete and Move Backwards" Buffer-menu-delete-backwards
+ :help "Mark buffer on this line to be deleted by x command and move up one line"]
+ "---"
+ ["Execute" Buffer-menu-execute
+ :help "Save and/or delete buffers marked with s or k commands"]
+ ["Set Unmodified" Buffer-menu-not-modified
+ :help "Mark buffer on this line as unmodified (no changes to save)"]
+ ["Bury" Buffer-menu-bury
+ :help "Bury the buffer listed on this line"]
+ "---"
+ ["Multi Occur Marked Buffers..." Buffer-menu-multi-occur
+ :help "Show lines matching a regexp in marked buffers using Occur"]
+ ["Isearch Marked Buffers..." Buffer-menu-isearch-buffers
+ :help "Search for a string through all marked buffers using Isearch"]
+ ["Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp
+ :help "Search for a regexp through all marked buffers using Isearch"]
+ "---"
+ ;; FIXME: The "Select" entries could use better names...
+ ["Select in Current Window" Buffer-menu-this-window
+ :help "Select this line's buffer in this window"]
+ ["Select in Other Window" Buffer-menu-other-window
+ :help "Select this line's buffer in other window, leaving buffer menu visible"]
+ ["Select Current" Buffer-menu-1-window
+ :help "Select this line's buffer, alone, in full frame"]
+ ["Select Two" Buffer-menu-2-window
+ :help "Select this line's buffer, with previous buffer in second window"]
+ ["Select Marked" Buffer-menu-select
+ :help "Select this line's buffer; also display buffers marked with `>'"]
+ "---"
+ ["Show Only File Buffers" Buffer-menu-toggle-files-only
+ :help "Toggle whether the current buffer-menu displays only file buffers"
+ :style toggle
+ :selected Buffer-menu-files-only]
+ "---"
+ ["Refresh" revert-buffer
+ :help "Refresh the *Buffer List* buffer contents"]
+ ["Quit" quit-window
+ :help "Remove the buffer menu from the display"]))
+
(define-derived-mode Buffer-menu-mode tabulated-list-mode "Buffer Menu"
"Major mode for Buffer Menu buffers.
The Buffer Menu is invoked by the commands \\[list-buffers],
@@ -268,6 +248,7 @@ In Buffer Menu mode, the following commands are defined:
\\[revert-buffer] Update the list of buffers.
\\[Buffer-menu-toggle-files-only] Toggle whether the menu displays only file buffers.
\\[Buffer-menu-bury] Bury the buffer listed on this line."
+ :interactive nil
(setq-local buffer-stale-function
(lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
@@ -328,7 +309,7 @@ ARG, show only buffers that are visiting files."
"Toggle whether the current buffer-menu displays only file buffers.
With a positive ARG, display only file buffers. With zero or
negative ARG, display other buffers as well."
- (interactive "P")
+ (interactive "P" Buffer-menu-mode)
(setq Buffer-menu-files-only
(cond ((not arg) (not Buffer-menu-files-only))
((> (prefix-numeric-value arg) 0) t)))
@@ -337,7 +318,8 @@ negative ARG, display other buffers as well."
"Showing all non-internal buffers."))
(revert-buffer))
-(defalias 'Buffer-menu-sort 'tabulated-list-sort)
+(define-obsolete-function-alias 'Buffer-menu-sort 'tabulated-list-sort
+ "28.1")
(defun Buffer-menu-buffer (&optional error-if-non-existent-p)
@@ -373,14 +355,14 @@ is nil or omitted, and signal an error otherwise."
(defun Buffer-menu-mark ()
"Mark the Buffer menu entry at point for later display.
It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(tabulated-list-set-col 0 (char-to-string Buffer-menu-marker-char) t)
(forward-line))
(defun Buffer-menu-unmark (&optional backup)
"Cancel all requested operations on buffer on this line and move down.
Optional prefix arg means move up."
- (interactive "P")
+ (interactive "P" Buffer-menu-mode)
(Buffer-menu--unmark)
(forward-line (if backup -1 1)))
@@ -388,7 +370,7 @@ Optional prefix arg means move up."
"Cancel a requested operation on all buffers.
MARK is the character to flag the operation on the buffers.
When called interactively prompt for MARK; RET remove all marks."
- (interactive "cRemove marks (RET means all):")
+ (interactive "cRemove marks (RET means all):" Buffer-menu-mode)
(save-excursion
(goto-char (point-min))
(when (tabulated-list-header-overlay-p)
@@ -403,12 +385,12 @@ When called interactively prompt for MARK; RET remove all marks."
(defun Buffer-menu-unmark-all ()
"Cancel all requested operations on buffers."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(Buffer-menu-unmark-all-buffers ?\r))
(defun Buffer-menu-backup-unmark ()
"Move up and cancel all requested operations on buffer on line above."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(forward-line -1)
(Buffer-menu--unmark))
@@ -427,7 +409,7 @@ will delete it.
If prefix argument ARG is non-nil, it specifies the number of
buffers to delete; a negative ARG means to delete backwards."
- (interactive "p")
+ (interactive "p" Buffer-menu-mode)
(if (or (null arg) (= arg 0))
(setq arg 1))
(while (> arg 0)
@@ -446,14 +428,14 @@ buffers to delete; a negative ARG means to delete backwards."
A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]'
command will delete the marked buffer. Prefix ARG means move
that many lines."
- (interactive "p")
+ (interactive "p" Buffer-menu-mode)
(Buffer-menu-delete (- (or arg 1))))
(defun Buffer-menu-save ()
"Mark the buffer on this Buffer Menu line for saving.
A subsequent \\<Buffer-menu-mode-map>`\\[Buffer-menu-execute]' command
will save it."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(when (Buffer-menu-buffer)
(tabulated-list-set-col 2 "S" t)
(forward-line 1)))
@@ -462,7 +444,7 @@ will save it."
"Mark the buffer on this line as unmodified (no changes to save).
If ARG is non-nil (interactively, with a prefix argument), mark
it as modified."
- (interactive "P")
+ (interactive "P" Buffer-menu-mode)
(with-current-buffer (Buffer-menu-buffer t)
(set-buffer-modified-p arg))
(tabulated-list-set-col 2 (if arg "*" " ") t))
@@ -471,7 +453,7 @@ it as modified."
"Save and/or delete marked buffers in the Buffer Menu.
Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-save]' are saved.
Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
@@ -502,7 +484,7 @@ You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' com
This command deletes and replaces all the previously existing windows
in the selected frame, and will remove any marks."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let* ((this-buffer (Buffer-menu-buffer t))
(menu-buffer (current-buffer))
(others (delq this-buffer (Buffer-menu-marked-buffers t)))
@@ -533,23 +515,23 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-isearch-buffers ()
"Search for a string through all marked buffers using Isearch."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(multi-isearch-buffers (Buffer-menu-marked-buffers)))
(defun Buffer-menu-isearch-buffers-regexp ()
"Search for a regexp through all marked buffers using Isearch."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(multi-isearch-buffers-regexp (Buffer-menu-marked-buffers)))
(defun Buffer-menu-multi-occur (regexp &optional nlines)
"Show all lines in marked buffers containing a match for a regexp."
- (interactive (occur-read-primary-args))
+ (interactive (occur-read-primary-args) Buffer-menu-mode)
(multi-occur (Buffer-menu-marked-buffers) regexp nlines))
(defun Buffer-menu-visit-tags-table ()
"Visit the tags table in the buffer on this line. See `visit-tags-table'."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((file (buffer-file-name (Buffer-menu-buffer t))))
(if file
(visit-tags-table file)
@@ -557,30 +539,30 @@ If UNMARK is non-nil, unmark them."
(defun Buffer-menu-1-window ()
"Select this line's buffer, alone, in full frame."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(switch-to-buffer (Buffer-menu-buffer t))
(bury-buffer (other-buffer))
(delete-other-windows))
(defun Buffer-menu-this-window ()
"Select this line's buffer in this window."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(switch-to-buffer (Buffer-menu-buffer t)))
(defun Buffer-menu-other-window ()
"Select this line's buffer in other window, leaving buffer menu visible."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(switch-to-buffer-other-window (Buffer-menu-buffer t)))
(defun Buffer-menu-switch-other-window ()
"Make the other window select this line's buffer.
The current window remains selected."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(display-buffer (Buffer-menu-buffer t) t))
(defun Buffer-menu-2-window ()
"Select this line's buffer, with previous buffer in second window."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((buff (Buffer-menu-buffer t))
(menu (current-buffer)))
(delete-other-windows)
@@ -591,7 +573,7 @@ The current window remains selected."
(defun Buffer-menu-toggle-read-only ()
"Toggle read-only status of buffer on this line.
This behaves like invoking \\[read-only-mode] in that buffer."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((read-only
(with-current-buffer (Buffer-menu-buffer t)
(read-only-mode 'toggle)
@@ -600,7 +582,7 @@ This behaves like invoking \\[read-only-mode] in that buffer."
(defun Buffer-menu-bury ()
"Bury the buffer listed on this line."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(let ((buffer (tabulated-list-get-id)))
(cond ((null buffer))
((buffer-live-p buffer)
@@ -616,12 +598,12 @@ This behaves like invoking \\[read-only-mode] in that buffer."
(defun Buffer-menu-view ()
"View this line's buffer in View mode."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(view-buffer (Buffer-menu-buffer t)))
(defun Buffer-menu-view-other-window ()
"View this line's buffer in View mode in another window."
- (interactive)
+ (interactive nil Buffer-menu-mode)
(view-buffer-other-window (Buffer-menu-buffer t)))
;;; Functions for populating the Buffer Menu.
@@ -646,7 +628,7 @@ means list those buffers and no others."
(defun Buffer-menu-mouse-select (event)
"Select the buffer whose line you click on."
- (interactive "e")
+ (interactive "e" Buffer-menu-mode)
(select-window (posn-window (event-end event)))
(let ((buffer (tabulated-list-get-id (posn-point (event-end event)))))
(when (buffer-live-p buffer)
diff --git a/lisp/button.el b/lisp/button.el
index 043de8eeb7b..74dfb5d5419 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -61,6 +61,7 @@
;; might get converted to ^M when building loaddefs.el
(define-key map [(control ?m)] 'push-button)
(define-key map [mouse-2] 'push-button)
+ (define-key map [follow-link] 'mouse-face)
;; FIXME: You'd think that for keymaps coming from text-properties on the
;; mode-line or header-line, the `mode-line' or `header-line' prefix
;; shouldn't be necessary!
@@ -472,8 +473,8 @@ mouse event is used.
If there's no button at POS, do nothing and return nil, otherwise
return t.
-To get a description of what function will called when pushing a
-butting, use the `button-describe' command."
+To get a description of the function that will be invoked when
+pushing a button, use the `button-describe' command."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
(if (and (not (integerp pos)) (eventp pos))
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 1e31c3cadc0..db4751a9fbb 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1139,7 +1139,7 @@ If the current Calc language does not use placeholders, return nil."
0)
(setq sym (intern (substring (symbol-name sym)
1))))
- (or (string-match "-" (symbol-name sym))
+ (or (string-search "-" (symbol-name sym))
(setq sym (intern
(concat "calcFunc-"
(symbol-name sym))))))
@@ -1149,7 +1149,7 @@ If the current Calc language does not use placeholders, return nil."
(let ((val (list 'var
(intern (math-remove-dashes
(symbol-name sym)))
- (if (string-match "-" (symbol-name sym))
+ (if (string-search "-" (symbol-name sym))
sym
(intern (concat "var-"
(symbol-name sym)))))))
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 1327cf0a39b..162026d092b 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -444,12 +444,12 @@ Code can refer to the expression to simplify via lexical variable `expr'
and should return the simplified expression to use (or nil)."
(declare (indent 1) (debug (sexp body)))
(cons 'progn
- (mapcar #'(lambda (func)
- `(put ',func 'math-simplify
- (nconc
- (get ',func 'math-simplify)
- (list
- #'(lambda (expr) ,@code)))))
+ (mapcar (lambda (func)
+ `(put ',func 'math-simplify
+ (nconc
+ (get ',func 'math-simplify)
+ (list
+ (lambda (expr) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(math-defsimplify (+ -)
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index f4ddb840b50..45337e187be 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -2565,9 +2565,9 @@ If X is not an error form, return 1."
;;; True if A is numerically equal to the integer B. [P N S] [Public]
;;; B must not be a multiple of 10.
(defun math-equal-int (a b)
- (or (eq a b)
+ (or (eql a b)
(and (eq (car-safe a) 'float)
- (eq (nth 1 a) b)
+ (eql (nth 1 a) b)
(= (nth 2 a) 0))))
@@ -2784,23 +2784,23 @@ If X is not an error form, return 1."
(declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
- (mapcar #'(lambda (func)
- `(put ',func 'math-integral
- (nconc
- (get ',func 'math-integral)
- (list
- #'(lambda (u) ,@code)))))
+ (mapcar (lambda (func)
+ `(put ',func 'math-integral
+ (nconc
+ (get ',func 'math-integral)
+ (list
+ (lambda (u) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(defmacro math-defintegral-2 (funcs &rest code)
(declare (indent 1) (debug (sexp body)))
(setq math-integral-cache nil)
(cons 'progn
- (mapcar #'(lambda (func)
- `(put ',func 'math-integral-2
- (nconc
- (get ',func 'math-integral-2)
- (list #'(lambda (u v) ,@code)))))
+ (mapcar (lambda (func)
+ `(put ',func 'math-integral-2
+ (nconc
+ (get ',func 'math-integral-2)
+ (list (lambda (u v) ,@code)))))
(if (symbolp funcs) (list funcs) funcs))))
(defvar var-IntegAfterRules 'calc-IntegAfterRules)
@@ -3088,7 +3088,7 @@ If X is not an error form, return 1."
(math-read-big-err-msg nil)
math-read-big-baseline math-read-big-h2
new-pos p)
- (while (setq new-pos (string-match "\n" str pos))
+ (while (setq new-pos (string-search "\n" str pos))
(setq math-read-big-lines
(cons (substring str pos new-pos) math-read-big-lines)
pos (1+ new-pos)))
@@ -3249,7 +3249,7 @@ If X is not an error form, return 1."
(t
(let ((str (math-format-flat-expr x 0))
(pos 0) p)
- (or (string-match "\"" str)
+ (or (string-search "\"" str)
(while (<= (setq p (+ pos w)) (length str))
(while (and (> (setq p (1- p)) pos)
(not (= (aref str p) ? ))))
@@ -3278,7 +3278,7 @@ If X is not an error form, return 1."
(math-format-radix-float a prec))
(format "%d#%s" calc-number-radix
(math-format-radix-float a prec)))))
- (if (and prec (> prec 191) (string-match "\\*" str))
+ (if (and prec (> prec 191) (string-search "*" str))
(concat "(" str ")")
str))))
((eq (car a) 'frac)
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index ee53b94cd64..ac57011da04 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -2238,7 +2238,7 @@ and ends on the last Sunday of October at 2 a.m."
(if (eq (car-safe str2) 'error)
str2
(append '(calcFunc-lambda) (cdr str1) (list str2)))))
- (if (string-match "#" str)
+ (if (string-search "#" str)
(let ((calc-hashes-used 0))
(and (setq str (math-read-expr str))
(if (eq (car-safe str) 'error)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 423d1e64126..9ac24bf1889 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1025,7 +1025,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(calc-pop-stack 1))))
(if (string-match "\\[.+\\]" range)
(setq range (substring range 1 -1)))
- (if (and (not (string-match ":" range))
+ (if (and (not (string-search ":" range))
(or (string-match "," range)
(string-match " " range)))
(aset range (match-beginning 0) ?\:))
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index 1902a4f3f29..acbef27a1da 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -481,7 +481,7 @@
":"
(if (and (equal cmd "e")
(or (not input)
- (string-match
+ (string-search
"#" input))
(> radix 14))
(format "*%d.^" radix)
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 0117f449dd5..aef3173f5c0 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -660,7 +660,7 @@
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
- (let ((right (string-match "}" math-exp-str math-exp-pos)))
+ (let ((right (string-search "}" math-exp-str math-exp-pos)))
(and right
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
@@ -899,7 +899,7 @@
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
- (let ((right (string-match "}" math-exp-str math-exp-pos)))
+ (let ((right (string-search "}" math-exp-str math-exp-pos)))
(and right
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
@@ -2342,7 +2342,7 @@ order to Calc's."
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
(if (= (math-read-big-char widest v) ?\()
(progn
- (setq line (if (string-match "-" p)
+ (setq line (if (string-search "-" p)
(intern p)
(intern (concat "calcFunc-" p)))
h (1+ widest)
@@ -2362,7 +2362,7 @@ order to Calc's."
(setq p (cons line (nreverse p))))
(setq p (list 'var
(intern (math-remove-dashes p))
- (if (string-match "-" p)
+ (if (string-search "-" p)
(intern p)
(intern (concat "var-" p)))))))
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index 16cca055330..516f62d7b63 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -781,7 +781,7 @@
:active (>= (calc-stack-size) 2)
:help "The cross product in R^3"]
["(2:) dot (1:)"
- calc-mult
+ calc-times
:keys "*"
:active (>= (calc-stack-size) 2)
:help "The dot product"]
@@ -1669,3 +1669,5 @@
["Quit" calc-quit]))
(provide 'calc-menu)
+
+;;; calc-menu.el ends here
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index 11867f15e5b..f676b098e58 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -819,3 +819,5 @@
(calc-record traillist "parm")))))
(provide 'calc-nlfit)
+
+;;; calc-nlfit.el ends here
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 3097b09b013..f9dd9eb98a9 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -604,7 +604,7 @@
((equal name "#")
(search-backward "#")
(error "Token `#' is reserved"))
- ((and unquoted (string-match "#" name))
+ ((and unquoted (string-search "#" name))
(error "Tokens containing `#' must be quoted"))
((not (string-match "[^ ]" name))
(search-backward "\"" nil t)
@@ -802,8 +802,8 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string "SPC" " SPC "
- (replace-regexp-in-string " " "" line)))
+ (setq line (string-replace "SPC" " SPC "
+ (string-replace " " "" line)))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
@@ -830,7 +830,7 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string " " "" line))
+ (setq line (string-replace " " "" line))
(insert cmdbeg " " line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
@@ -857,7 +857,7 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string " " "" line))
+ (setq line (string-replace " " "" line))
(insert line "\t\t\t")
(if (> (current-column) 24)
(delete-char -1))
@@ -1068,7 +1068,7 @@ Redefine the corresponding command."
(insert (setq str (prin1-to-string
(cons 'defun (cons cmd (cdr fcmd)))))
"\n")
- (or (and (string-match "\"" str) (not q-ok))
+ (or (and (string-search "\"" str) (not q-ok))
(fill-region pt (point)))
(indent-rigidly pt (point) 2)
(delete-region pt (1+ pt))
@@ -1087,7 +1087,7 @@ Redefine the corresponding command."
(cons 'defun (cons func
(cdr ffunc)))))
"\n")
- (or (and (string-match "\"" str) (not q-ok))
+ (or (and (string-search "\"" str) (not q-ok))
(fill-region pt (point)))
(indent-rigidly pt (point) 2)
(delete-region pt (1+ pt))
@@ -1881,9 +1881,9 @@ Redefine the corresponding command."
(if (fboundp (setq chk (intern (concat "math-" qual-name))))
(append rest
(if is-rest
- `((mapcar #'(lambda (x)
- (or (,chk x)
- (math-reject-arg x ',qual)))
+ `((mapcar (lambda (x)
+ (or (,chk x)
+ (math-reject-arg x ',qual)))
,var))
`((or (,chk ,var)
(math-reject-arg ,var ',qual)))))
@@ -1894,9 +1894,9 @@ Redefine the corresponding command."
qual-name 1))))))
(append rest
(if is-rest
- `((mapcar #'(lambda (x)
- (and (,chk x)
- (math-reject-arg x ',qual)))
+ `((mapcar (lambda (x)
+ (and (,chk x)
+ (math-reject-arg x ',qual)))
,var))
`((and
(,chk ,var)
@@ -1985,22 +1985,37 @@ Redefine the corresponding command."
(cons 'quote
(math-define-lambda (nth 1 exp) math-exp-env))
exp))
- ((memq func '(let let* for foreach))
- (let ((head (nth 1 exp))
- (body (cdr (cdr exp))))
- (if (memq func '(let let*))
- ()
- (setq func (cdr (assq func '((for . math-for)
- (foreach . math-foreach)))))
- (if (not (listp (car head)))
- (setq head (list head))))
- (macroexpand
- (cons func
- (cons (math-define-let head)
- (math-define-body body
- (nconc
- (math-define-let-env head)
- math-exp-env)))))))
+ ((eq func 'let)
+ (let ((bindings (nth 1 exp))
+ (body (cddr exp)))
+ `(let ,(math-define-let bindings)
+ ,@(math-define-body
+ body (append (math-define-let-env bindings)
+ math-exp-env)))))
+ ((eq func 'let*)
+ ;; Rewrite in terms of `let'.
+ (let ((bindings (nth 1 exp))
+ (body (cddr exp)))
+ (math-define-exp
+ (if (> (length bindings) 1)
+ `(let ,(list (car bindings))
+ (let* ,(cdr bindings) ,@body))
+ `(let ,bindings ,@body)))))
+ ((memq func '(for foreach))
+ (let ((bindings (nth 1 exp))
+ (body (cddr exp)))
+ (if (> (length bindings) 1)
+ ;; Rewrite as nested loops.
+ (math-define-exp
+ `(,func ,(list (car bindings))
+ (,func ,(cdr bindings) ,@body)))
+ (let ((mac (cdr (assq func '((for . math-for)
+ (foreach . math-foreach))))))
+ (macroexpand
+ `(,mac ,(math-define-let bindings)
+ ,@(math-define-body
+ body (append (math-define-let-env bindings)
+ math-exp-env))))))))
((and (memq func '(setq setf))
(math-complicated-lhs (cdr exp)))
(if (> (length exp) 3)
@@ -2017,7 +2032,7 @@ Redefine the corresponding command."
(math-define-cond (cdr exp))))
((and (consp func) ; ('spam a b) == force use of plain spam
(eq (car func) 'quote))
- (cons func (math-define-list (cdr exp))))
+ (cons (cadr func) (math-define-list (cdr exp))))
((symbolp func)
(let ((args (math-define-list (cdr exp)))
(prim (assq func math-prim-funcs)))
@@ -2117,7 +2132,7 @@ Redefine the corresponding command."
(cdr prim))
((memq exp math-exp-env)
exp)
- ((string-match "-" name)
+ ((string-search "-" name)
exp)
(t
(intern (concat "var-" name))))))
@@ -2276,20 +2291,16 @@ Redefine the corresponding command."
(defun math-handle-foreach (head body)
(let ((var (nth 0 (car head)))
+ (loop-var (gensym "foreach"))
(data (nth 1 (car head)))
(body (if (cdr head)
(list (math-handle-foreach (cdr head) body))
body)))
- (cons 'let
- (cons (list (list var data))
- (list
- (cons 'while
- (cons var
- (append body
- (list (list 'setq
- var
- (list 'cdr var)))))))))))
-
+ `(let ((,loop-var ,data))
+ (while ,loop-var
+ (let ((,var (car ,loop-var)))
+ ,@(append body
+ `((setq ,loop-var (cdr ,loop-var)))))))))
(defun math-body-refers-to (body thing)
(or (equal body thing)
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index 2b317ac3696..18fd483bafe 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -486,8 +486,8 @@
(defun calc-replace-sub-formula (expr rsf-old rsf-new)
(let ((calc-rsf-old rsf-old)
- (calc-rsf-new (calc-encase-atoms rsf-new))))
- (calc-replace-sub-formula-rec expr))
+ (calc-rsf-new (calc-encase-atoms rsf-new)))
+ (calc-replace-sub-formula-rec expr)))
(defun calc-replace-sub-formula-rec (expr)
(cond ((eq expr calc-rsf-old) calc-rsf-new)
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index c3adc3db02a..8b6f0637035 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -406,7 +406,7 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
If EXPR is nil, return nil."
(if expr
(let ((cexpr (math-compose-expr expr 0)))
- (replace-regexp-in-string
+ (string-replace
" / " "/"
(if (stringp cexpr)
cexpr
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index e5f05236f3a..762adbd407e 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -639,7 +639,7 @@ Interactively, reads the register using `register-read-with-preview'."
(calc-slow-wrapper
(when (eq n 0)
(setq n (calc-stack-size)))
- (let* ((flag nil)
+ (let* (;; (flag nil)
(allow-ret (> n 1))
(list (math-showing-full-precision
(mapcar (if (> n 1)
@@ -651,7 +651,8 @@ Interactively, reads the register using `register-read-with-preview'."
(if (> n 0)
(calc-top-list n)
(calc-top-list 1 (- n)))))))
- (calc--edit-mode (lambda () (calc-finish-stack-edit (or flag n))) allow-ret)
+ (calc--edit-mode (lambda () (calc-finish-stack-edit n)) ;; (or flag n)
+ allow-ret)
(while list
(insert (car list) "\n")
(setq list (cdr list)))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index ec09abb34c4..a10b3178302 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -483,6 +483,11 @@ current precision are displayed in scientific notation in calc-mode.")
"Floating-point numbers with this negative exponent or lower are displayed
scientific notation in calc-mode.")
+(defvar calc-digit-after-point nil
+ "If t, display at least one digit after the decimal point, as in `12.0'.
+If nil, the decimal point may come last in a number, as in `12.'.
+This setting only applies to floats in normal display mode.")
+
(defvar calc-other-modes nil
"List of used-defined strings to append to Calculator mode line.")
@@ -2121,7 +2126,7 @@ the United States."
(goto-char (point-max))
(cond ((null prefix) (insert " "))
((and (> (length prefix) 4)
- (string-match " " prefix 4))
+ (string-search " " prefix 4))
(insert (substring prefix 0 4) " "))
(t (insert (format "%4s " prefix))))
(insert fval "\n")
@@ -2464,7 +2469,7 @@ the United States."
(calc-minibuffer-contains
"[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9]+\\.?0*[@oh] *\\)?\\([0-9]+\\.?0*['m] *\\)?[0-9]*\\(\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\\)?\\|[0-9]:\\([0-9]+:\\)?[0-9]*\\)?[\"s]?\\'"))
(if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
- (string-match " " calc-hms-format))
+ (string-search " " calc-hms-format))
(insert " "))
(if (and (memq last-command '(calcDigit-start calcDigit-key))
(eq last-command-event ?.))
@@ -3054,7 +3059,7 @@ the United States."
(defun calc-count-lines (s)
(let ((pos 0)
(num 1))
- (while (setq pos (string-match "\n" s pos))
+ (while (setq pos (string-search "\n" s pos))
(setq pos (1+ pos)
num (1+ num)))
num))
@@ -3184,7 +3189,8 @@ the United States."
exp (- exp adj)))))
(setq str (int-to-string mant))
(let* ((len (length str))
- (dpos (+ exp len)))
+ (dpos (+ exp len))
+ (trailing-0 (and calc-digit-after-point "0")))
(if (and (eq fmt 'float)
(<= dpos (+ calc-internal-prec calc-display-sci-high))
(>= dpos (+ calc-display-sci-low 2)))
@@ -3194,9 +3200,11 @@ the United States."
(setq str (concat "0" point str)))
((and (<= exp 0) (> dpos 0))
(setq str (concat (substring str 0 dpos) point
- (substring str dpos))))
+ (substring str dpos)
+ (and (>= dpos len) trailing-0))))
((> exp 0)
- (setq str (concat str (make-string exp ?0) point)))
+ (setq str (concat str (make-string exp ?0)
+ point trailing-0)))
(t ; (< dpos 0)
(setq str (concat "0" point
(make-string (- dpos) ?0) str))))
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 94b99aa29d8..8d93ae987a1 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -158,7 +158,7 @@
(calc-top-n 2)
(calc-top-n 1)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -175,7 +175,7 @@
(calc-top-n 2)
(calc-top-n 1)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -1028,7 +1028,7 @@
(fset 'calcFunc-integ math-old-integ))))
;; See if the function is a symbolic derivative.
- (and (string-match "'" (symbol-name (car expr)))
+ (and (string-search "'" (symbol-name (car expr)))
(let ((name (symbol-name (car expr)))
(p expr) (n 0) (which nil) (bad nil))
(while (setq n (1+ n) p (cdr p))
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index ee3ae0a4c1f..3cb1886f3bd 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -56,7 +56,7 @@
(calc-top-n 1)
(calc-top-n 2)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -81,7 +81,7 @@
(calc-top-n 1)
(calc-top-n 2)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -490,7 +490,7 @@
defc)
",")))))
(coefs nil))
- (setq vars (if (string-match "\\[" vars)
+ (setq vars (if (string-search "[" vars)
(math-read-expr vars)
(math-read-expr (concat "[" vars "]"))))
(if (eq (car-safe vars) 'error)
diff --git a/lisp/calculator.el b/lisp/calculator.el
index b4c00753e91..99c9b6290c4 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -20,23 +20,18 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;;=====================================================================
;;; Commentary:
-;;
+
;; A calculator for Emacs.
;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or
;; whatever), when you have Emacs running already?
;;
-;; If this is not part of your Emacs distribution, then simply bind
-;; `calculator' to a key and make it an autoloaded function, e.g.:
-;; (autoload 'calculator "calculator"
-;; "Run the Emacs calculator." t)
+;; You can bind this to a key by adding this to your Init file:
+;;
;; (global-set-key [(control return)] 'calculator)
;;
;; Written by Eli Barzilay, eli@barzilay.org
-;;
-;;;=====================================================================
;;; Customization:
(defgroup calculator nil
@@ -50,19 +45,16 @@
"Run `calculator' electrically, in the echo area.
Electric mode saves some place but changes the way you interact with the
calculator."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-use-menu t
"Make `calculator' create a menu.
Note that this requires easymenu. Must be set before loading."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-bind-escape nil
"If non-nil, set escape to exit the calculator."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-unary-style 'postfix
"Value is either `prefix' or `postfix'.
@@ -75,44 +67,38 @@ This determines the default behavior of unary operators."
It should contain a \"%s\" somewhere that will indicate the i/o radixes;
this will be a two-character string as described in the documentation
for `calculator-mode'."
- :type 'string
- :group 'calculator)
+ :type 'string)
(defcustom calculator-number-digits 3
"The calculator's number of digits used for standard display.
Used by the `calculator-standard-display' function - it will use the
format string \"%.NC\" where this number is N and C is a character given
at runtime."
- :type 'integer
- :group 'calculator)
+ :type 'integer)
(defcustom calculator-radix-grouping-mode t
"Use digit grouping in radix output mode.
If this is set, chunks of `calculator-radix-grouping-digits' characters
will be separated by `calculator-radix-grouping-separator' when in radix
output mode is active (determined by `calculator-output-radix')."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-radix-grouping-digits 4
"The number of digits used for grouping display in radix modes.
See `calculator-radix-grouping-mode'."
- :type 'integer
- :group 'calculator)
+ :type 'integer)
(defcustom calculator-radix-grouping-separator "'"
"The separator used in radix grouping display.
See `calculator-radix-grouping-mode'."
- :type 'string
- :group 'calculator)
+ :type 'string)
(defcustom calculator-remove-zeros t
"Non-nil value means delete all redundant zero decimal digits.
If this value is not t and not nil, redundant zeros are removed except
for one.
Used by the `calculator-remove-zeros' function."
- :type '(choice (const t) (const leave-decimal) (const nil))
- :group 'calculator)
+ :type '(choice (const t) (const leave-decimal) (const nil)))
(defcustom calculator-displayer '(std ?n)
"A displayer specification for numerical values.
@@ -135,8 +121,7 @@ a character and G is an optional boolean, in this case the
arguments."
:type '(choice (function) (string) (sexp)
(list (const std) character)
- (list (const std) character boolean))
- :group 'calculator)
+ (list (const std) character boolean)))
(defcustom calculator-displayers
'(((std ?n) "Standard display, decimal point or scientific")
@@ -152,15 +137,13 @@ specification is the same as the values that can be stored in
`calculator-displayer'.
`calculator-rotate-displayer' rotates this list."
- :type 'sexp
- :group 'calculator)
+ :type 'sexp)
(defcustom calculator-paste-decimals t
"If non-nil, convert pasted integers so they have a decimal point.
This makes it possible to paste big integers since they will be read as
floats, otherwise the Emacs reader will fail on them."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(make-obsolete-variable 'calculator-paste-decimals
"it is no longer used." "26.1")
@@ -169,14 +152,12 @@ floats, otherwise the Emacs reader will fail on them."
`calculator-displayer', to format a string before copying it with
`calculator-copy'. If nil, then `calculator-displayer's normal value is
used."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-2s-complement nil
"If non-nil, show negative numbers in 2s complement in radix modes.
Otherwise show as a negative number."
- :type 'boolean
- :group 'calculator)
+ :type 'boolean)
(defcustom calculator-mode-hook nil
"List of hook functions for `calculator-mode' to run.
@@ -184,8 +165,7 @@ Note: if `calculator-electric-mode' is on, then this hook will get
activated in the minibuffer -- in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
- :type 'hook
- :group 'calculator)
+ :type 'hook)
(defcustom calculator-user-registers nil
"An association list of user-defined register bindings.
@@ -200,8 +180,7 @@ before you load calculator."
(when (boundp 'calculator-registers)
(setq calculator-registers
(append val calculator-registers)))
- (setq calculator-user-registers val))
- :group 'calculator)
+ (setq calculator-user-registers val)))
(defcustom calculator-user-operators nil
"A list of additional operators.
@@ -234,8 +213,7 @@ Examples:
Note that this will be either postfix or prefix, according to
`calculator-unary-style'."
- :type '(repeat (list string symbol sexp integer integer))
- :group 'calculator)
+ :type '(repeat (list string symbol sexp integer integer)))
;;;=====================================================================
;;; Code:
@@ -313,7 +291,7 @@ user-defined operators, use `calculator-user-operators' instead.")
5. The function's precedence -- should be in the range of 1 (lowest) to
9 (highest) (optional, defaults to 1);
-It it possible have a unary prefix version of a binary operator if it
+It is possible have a unary prefix version of a binary operator if it
comes later in this list. If the list begins with the symbol `nobind',
then no key binding will take place -- this is only used for predefined
keys.
@@ -858,10 +836,11 @@ The result should not exceed the screen width."
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
- (string-to-number str (cadr (assq calculator-input-radix
- '((bin 2) (oct 8) (hex 16)))))
- ;; Allow entry of "1.e3".
- (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str)))
+ (string-to-number str (cadr (assq calculator-input-radix
+ '((bin 2) (oct 8) (hex 16)))))
+ ;; parse numbers similarly to calculators
+ ;; (see tests in test/lisp/calculator-tests.el)
+ (let ((str (replace-regexp-in-string "\\.\\([^0-9].*\\)?$" ".0\\1" str)))
(float (string-to-number str)))))
(defun calculator-push-curnum ()
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 281b89e088f..f523863440f 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -402,11 +402,12 @@ displayed in a window:
(appt-display-message string-list min-list))
(when appt-display-mode-line
(setq appt-mode-string
- (concat " " (propertize
- (appt-mode-line (mapcar #'number-to-string
- min-list)
- t)
- 'face 'mode-line-emphasis))))
+ (concat (propertize
+ (appt-mode-line (mapcar #'number-to-string
+ min-list)
+ t)
+ 'face 'mode-line-emphasis)
+ " ")))
;; Reset count to 0 in case we display another appt on the next cycle.
(setq appt-display-count (if (eq '(0) min-list) 0
(1+ prev-appt-display-count))))
@@ -700,7 +701,7 @@ ARG is positive, otherwise off."
(let ((appt-active appt-timer))
(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
(not appt-active)))
- (remove-hook 'write-file-functions #'appt-update-list 'local)
+ (remove-hook 'write-file-functions #'appt-update-list)
(or global-mode-string (setq global-mode-string '("")))
(delq 'appt-mode-string global-mode-string)
(when appt-timer
@@ -708,7 +709,7 @@ ARG is positive, otherwise off."
(setq appt-timer nil))
(if appt-active
(progn
- (add-hook 'write-file-functions #'appt-update-list nil t)
+ (add-hook 'write-file-functions #'appt-update-list)
(setq appt-timer (run-at-time t 60 #'appt-check)
global-mode-string
(append global-mode-string '(appt-mode-string)))
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index c2e4205c0bc..350b7e51cb1 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -27,7 +27,7 @@
;; This collection of functions implements the features of calendar.el
;; and diary-lib.el that deal with the Bahá’í calendar.
-;; The Bahá’í (http://www.bahai.org) calendar system is based on a
+;; The Bahá’í (https://www.bahai.org) calendar system is based on a
;; solar cycle of 19 months with 19 days each. The four remaining
;; "intercalary" days are called the Ayyám-i-Há (days of Há), and are
;; placed between the 18th and 19th months. They are meant as a time
@@ -126,7 +126,7 @@ Defaults to today's date if DATE is not given."
"" ; pre-Bahai
(let ((m (calendar-extract-month bahai-date))
(d (calendar-extract-day bahai-date)))
- (calendar-dlet*
+ (calendar-dlet
((monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 346585e1817..11785c48f10 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -116,7 +116,7 @@ Defaults to today's date if DATE is not given."
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
- (calendar-dlet*
+ (calendar-dlet
((monthname (aref calendar-coptic-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day coptic-date)))
(dayname nil)
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 9e6c2959286..29864110a3e 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -200,7 +200,7 @@ The result has the proper form for `calendar-daylight-savings-starts'."
(calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
(prevday-sec (- -1 utc-diff)) ; last sec of previous local day
new-rules)
- (calendar-dlet* ((year (1+ y)))
+ (calendar-dlet ((year (1+ y)))
;; Scan through the next few years until only one rule remains.
(while (cdr candidate-rules)
(dolist (rule candidate-rules)
@@ -397,7 +397,7 @@ 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))))
- (calendar-dlet* ((year year))
+ (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))
@@ -409,7 +409,7 @@ 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))))
- (calendar-dlet* ((year year))
+ (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))
@@ -419,7 +419,7 @@ 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."
- (calendar-dlet* ((year (calendar-extract-year
+ (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))
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index 639bae700cc..1789f16445f 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -40,12 +40,13 @@
(defconst calendar-french-month-name-array
["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
- "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
+ "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"
+ "jour complémentaire"]
"Array of month names in the French calendar.")
(defconst calendar-french-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
- "Octidi" "Nonidi" "Decadi"]
+ "Octidi" "Nonidi" "Décadi"]
"Array of day names in the French calendar.")
(define-obsolete-variable-alias 'calendar-french-multibyte-special-days-array
@@ -56,6 +57,144 @@
"de la Révolution"]
"Array of special day names in the French calendar.")
+(defconst calendar-french-feasts-array
+ [;; Vendémiaire
+ "du Raisin" "du Safran" "de la Châtaigne"
+ "de la Colchique" "du Cheval" "de la Balsamine"
+ "de la Carotte" "de l'Amarante" "du Panais"
+ "de la Cuve" "de la Pomme de terre" "de l'Immortelle"
+ "du Potiron" "du Réséda" "de l'Âne"
+ "de la Belle de nuit" "de la Citrouille" "du Sarrasin"
+ "du Tournesol" "du Pressoir" "du Chanvre"
+ "de la Pêche" "du Navet" "de l'Amaryllis"
+ "du Bœuf" "de l'Aubergine" "du Piment"
+ "de la Tomate" "de l'Orge" "du Tonneau"
+ ;; Brumaire
+ "de la Pomme" "du Céleri" "de la Poire"
+ "de la Betterave" "de l'Oie" "de l'Héliotrope"
+ "de la Figue" "de la Scorsonère" "de l'Alisier"
+ "de la Charrue" "du Salsifis" "de la Macre"
+ "du Topinambour" "de l'Endive" "du Dindon"
+ "du Chervis" "du Cresson" "de la Dentelaire"
+ "de la Grenade" "de la Herse" "de la Bacchante"
+ "de l'Azerole" "de la Garance" "de l'Orange"
+ "du Faisan" "de la Pistache" "du Macjon"
+ "du Coing" "du Cormier" "du Rouleau"
+ ;; Frimaire
+ "de la Raiponce" "du Turneps" "de la Chicorée"
+ "de la Nèfle" "du Cochon" "de la Mâche"
+ "du Chou-fleur" "du Miel" "du Genièvre"
+ "de la Pioche" "de la Cire" "du Raifort"
+ "du Cèdre" "du Sapin" "du Chevreuil"
+ "de l'Ajonc" "du Cyprès" "du Lierre"
+ "de la Sabine" "du Hoyau" "de l'Érable-sucre"
+ "de la Bruyère" "du Roseau" "de l'Oseille"
+ "du Grillon" "du Pignon" "du Liège"
+ "de la Truffe" "de l'Olive" "de la Pelle"
+ ;; Nivôse
+ "de la Tourbe" "de la Houille" "du Bitume"
+ "du Soufre" "du Chien" "de la Lave"
+ "de la Terre végétale" "du Fumier" "du Salpêtre"
+ "du Fléau" "du Granit" "de l'Argile"
+ "de l'Ardoise" "du Grès" "du Lapin"
+ "du Silex" "de la Marne" "de la Pierre à chaux"
+ "du Marbre" "du Van" "de la Pierre à plâtre"
+ "du Sel" "du Fer" "du Cuivre"
+ "du Chat" "de l'Étain" "du Plomb"
+ "du Zinc" "du Mercure" "du Crible"
+ ;; Pluviôse
+ "de la Lauréole" "de la Mousse" "du Fragon"
+ "du Perce-neige" "du Taureau" "du Laurier-thym"
+ "de l'Amadouvier" "du Mézéréon" "du Peuplier"
+ "de la Cognée" "de l'Ellébore" "du Brocoli"
+ "du Laurier" "de l'Avelinier" "de la Vache"
+ "du Buis" "du Lichen" "de l'If"
+ "de la Pulmonaire" "de la Serpette" "du Thlaspi"
+ "du Thymelé" "du Chiendent" "de la Traînasse"
+ "du Lièvre" "de la Guède" "du Noisetier"
+ "du Cyclamen" "de la Chélidoine" "du Traîneau"
+ ;; Ventôse
+ "du Tussilage" "du Cornouiller" "du Violier"
+ "du Troène" "du Bouc" "de l'Asaret"
+ "de l'Alaterne" "de la Violette" "du Marsault"
+ "de la Bêche" "du Narcisse" "de l'Orme"
+ "de la Fumeterre" "du Vélar" "de la Chèvre"
+ "de l'Épinard" "du Doronic" "du Mouron"
+ "du Cerfeuil" "du Cordeau" "de la Mandragore"
+ "du Persil" "du Cochléaria" "de la Pâquerette"
+ "du Thon" "du Pissenlit" "de la Sylvie"
+ "du Capillaire" "du Frêne" "du Plantoir"
+ ;; Germinal
+ "de la Primevère" "du Platane" "de l'Asperge"
+ "de la Tulipe" "de la Poule" "de la Blette"
+ "du Bouleau" "de la Jonquille" "de l'Aulne"
+ "du Couvoir" "de la Pervenche" "du Charme"
+ "de la Morille" "du Hêtre" "de l'Abeille"
+ "de la Laitue" "du Mélèze" "de la Ciguë"
+ "du Radis" "de la Ruche" "du Gainier"
+ "de la Romaine" "du Marronnier" "de la Roquette"
+ "du Pigeon" "du Lilas" "de l'Anémone"
+ "de la Pensée" "de la Myrtille" "du Greffoir"
+ ;; Floréal
+ "de la Rose" "du Chêne" "de la Fougère"
+ "de l'Aubépine" "du Rossignol" "de l'Ancolie"
+ "du Muguet" "du Champignon" "de la Jacinthe"
+ "du Rateau" "de la Rhubarbe" "du Sainfoin"
+ "du Bâton-d'or" "du Chamérisier" "du Ver à soie"
+ "de la Consoude" "de la Pimprenelle" "de la Corbeille-d'or"
+ "de l'Arroche" "du Sarcloir" "du Statice"
+ "de la Fritillaire" "de la Bourrache" "de la Valériane"
+ "de la Carpe" "du Fusain" "de la Civette"
+ "de la Buglosse" "du Sénevé" "de la Houlette"
+ ;; Prairial
+ "de la Luzerne" "de l'Hémérocalle" "du Trèfle"
+ "de l'Angélique" "du Canard" "de la Mélisse"
+ "du Fromental" "du Martagon" "du Serpolet"
+ "de la Faux" "de la Fraise" "de la Bétoine"
+ "du Pois" "de l'Acacia" "de la Caille"
+ "de l'Œillet" "du Sureau" "du Pavot"
+ "du Tilleul" "de la Fourche" "du Barbeau"
+ "de la Camomille" "du Chèvrefeuille" "du Caille-lait"
+ "de la Tanche" "du Jasmin" "de la Verveine"
+ "du Thym" "de la Pivoine" "du Chariot"
+ ;; Messidor
+ "du Seigle" "de l'Avoine" "de l'Oignon"
+ "de la Véronique" "du Mulet" "du Romarin"
+ "du Concombre" "de l'Échalotte" "de l'Absinthe"
+ "de la Faucille" "de la Coriandre" "de l'Artichaut"
+ "de la Giroflée" "de la Lavande" "du Chamois"
+ "du Tabac" "de la Groseille" "de la Gesse"
+ "de la Cerise" "du Parc" "de la Menthe"
+ "du Cumin" "du Haricot" "de l'Orcanète"
+ "de la Pintade" "de la Sauge" "de l'Ail"
+ "de la Vesce" "du Blé" "de la Chalémie"
+ ;; Thermidor
+ "de l'Épautre" "du Bouillon-blanc" "du Melon"
+ "de l'Ivraie" "du Bélier" "de la Prèle"
+ "de l'Armoise" "du Carthame" "de la Mûre"
+ "de l'Arrosoir" "du Panis" "du Salicor"
+ "de l'Abricot" "du Basilic" "de la Brebis"
+ "de la Guimauve" "du Lin" "de l'Amande"
+ "de la Gentiane" "de l'Écluse" "de la Carline"
+ "du Câprier" "de la Lentille" "de l'Aunée"
+ "de la Loutre" "de la Myrte" "du Colza"
+ "du Lupin" "du Coton" "du Moulin"
+ ;; Fructidor
+ "de la Prune" "du Millet" "du Lycoperdon"
+ "de l'Escourgeon" "du Saumon" "de la Tubéreuse"
+ "du Sucrion" "de l'Apocyn" "de la Réglisse"
+ "de l'Échelle" "de la Pastèque" "du Fenouil"
+ "de l'Épine-vinette" "de la Noix" "de la Truite"
+ "du Citron" "de la Cardère" "du Nerprun"
+ "du Tagette" "de la Hotte" "de l'Églantier"
+ "de la Noisette" "du Houblon" "du Sorgho"
+ "de l'Écrevisse" "de la Bagarade" "de la Verge-d'or"
+ "du Maïs" "du Marron" "du Panier"
+ ;; jour complémentaire
+ "de la Vertu" "du Génie" "du Travail"
+ "de la Raison" "des Récompenses" "de la Révolution"]
+ "Array of day feasts in the French calendar.")
+
(defun calendar-french-accents-p ()
(declare (obsolete nil "28.1"))
t)
@@ -75,6 +214,16 @@
(declare (obsolete "use the variable of the same name instead" "28.1"))
calendar-french-special-days-array)
+(defun calendar-french-trim-feast (feast)
+ "Remove the article from the FEAST.
+E.g. \"du Raisin\" -> \"Raisin\" or \"de la Vertu\" -> \"Vertu\"."
+ (cond
+ ((equal (substring feast 0 3) "du ") (substring feast 3))
+ ((equal (substring feast 0 6) "de la ") (substring feast 6))
+ ((equal (substring feast 0 5) "de l'") (substring feast 5))
+ ((equal (substring feast 0 4) "des ") (substring feast 4))
+ (t feast)))
+
(defun calendar-french-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
For Gregorian years 1793 to 1805, the years of actual operation of the
@@ -162,14 +311,13 @@ Defaults to today's date if DATE is not given."
(d (calendar-extract-day french-date)))
(cond
((< y 1) "")
- ((= m 13) (format "Jour %s de l'Année %d de la Révolution"
- (aref calendar-french-special-days-array (1- d))
- y))
(t (format
- "%d %s an %d de la Révolution"
+ "%s %d %s an %d de la Révolution, jour %s"
+ (aref calendar-french-day-name-array (% (1- d) 10))
d
(aref calendar-french-month-name-array (1- m))
- y)))))
+ y
+ (aref calendar-french-feasts-array (+ -31 (* 30 m) d)))))))
;;;###cal-autoload
(defun calendar-french-print-date ()
@@ -186,7 +334,7 @@ Defaults to today's date if DATE is not given."
Echo French Revolutionary date unless NOECHO is non-nil."
(interactive
(let* ((months calendar-french-month-name-array)
- (special-days calendar-french-special-days-array)
+ (feasts calendar-french-feasts-array)
(year (progn
(calendar-read-sexp
"Année de la Révolution (>0)"
@@ -199,29 +347,31 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(mapcar 'list
(append months
(if (calendar-french-leap-year-p year)
- (mapcar
- (lambda (x) (concat "Jour " x))
- calendar-french-special-days-array)
+ (mapcar #'calendar-french-trim-feast feasts)
(reverse
(cdr ; we don't want rev. day in a non-leap yr
(reverse
- (mapcar
- (lambda (x)
- (concat "Jour " x))
- special-days))))))))
+ (mapcar #'calendar-french-trim-feast
+ feasts))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
(completing-read
- "Mois ou Sansculottide: "
+ "Mois ou \"jour complémentaire\" ou fête: "
month-list
nil t)
(calendar-make-alist month-list 1 'car) t)))
- (day (if (> month 12)
- (- month 12)
+ (last-day (calendar-french-last-day-of-month (min month 13) year))
+ (day (if (> month 13)
+ (- month 13)
(calendar-read-sexp
- "Jour (1-30)"
- (lambda (x) (and (<= 1 x) (<= x 30))))))
- (month (if (> month 12) 13 month)))
+ (format "Jour (1-%d): " last-day)
+ (lambda (x) (<= 1 x last-day)))))
+ ;; All days in Vendémiaire and numbered 1 to 365 e.g., "Pomme"
+ ;; gives 31 Vendémiaire automatically normalized to 1 Brumaire
+ ;; "Céleri" gives 32 Vnd normalized to 2 Bru, "Raiponce" gives
+ ;; 61 Vnd normalized to 1 Frimaire, etc until "Récompences" which
+ ;; gives 365 Vnd normalized to 5 jour complémentaire.
+ (month (if (> month 13) 1 month)))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-french-to-absolute date)))
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index e5810c3f027..58a5a0f83a5 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -151,7 +151,7 @@
(defun cal-html-comment (string)
"Return STRING as html comment."
(format "<!-- ====== %s ====== -->\n"
- (replace-regexp-in-string "--" "++" string)))
+ (string-replace "--" "++" string)))
(defun cal-html-href (link string)
"Return a hyperlink to url LINK with text STRING."
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index 497f3329055..ef84bfadd31 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -104,9 +104,9 @@
;; The bug has since been fixed.
(dotimes (i 11)
(push (vector (format "hol-year-%d" i)
- `(lambda ()
- (interactive)
- (holiday-list (+ displayed-year ,(- i 5))))
+ (lambda ()
+ (interactive)
+ (holiday-list (+ displayed-year (- i 5))))
:label `(format "For Year %d"
(+ displayed-year ,(- i 5))))
l))
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index ca37d803224..dd005e86608 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -140,7 +140,7 @@ Gregorian date Sunday, December 31, 1 BC."
(or date (calendar-current-date)))))
(y (calendar-extract-year persian-date))
(m (calendar-extract-month persian-date)))
- (calendar-dlet*
+ (calendar-dlet
((monthname (aref calendar-persian-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day persian-date)))
(year (number-to-string y))
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index f5932014dd9..7b55d420c3b 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -974,11 +974,11 @@ Uses the 24-hour clock if `cal-tex-24' is non-nil. Note that the hours
shown are hard-coded to 8-12, 13-17."
(with-suppressed-warnings ((lexical date))
(defvar date)) ;For `cal-tex-daily-string'.
- (let ((date thedate)
- (month (calendar-extract-month date))
- (day (calendar-extract-day date))
- ;; (year (calendar-extract-year date))
- morning afternoon s)
+ (let* ((date thedate)
+ (month (calendar-extract-month date))
+ (day (calendar-extract-day date))
+ ;; (year (calendar-extract-year date))
+ morning afternoon s)
(cal-tex-comment "begin cal-tex-week-hours")
(cal-tex-cmd "\\ \\\\[-.2cm]")
(cal-tex-cmd "\\noindent")
@@ -1465,10 +1465,10 @@ hourly sections for the period specified by `cal-tex-daily-start'
and `cal-tex-daily-end'."
(with-suppressed-warnings ((lexical date))
(defvar date)) ;For `cal-tex-daily-string'.
- (let ((date thedate)
- (month-name (cal-tex-month-name (calendar-extract-month date)))
- (i (1- cal-tex-daily-start))
- hour)
+ (let* ((date thedate)
+ (month-name (cal-tex-month-name (calendar-extract-month date)))
+ (i (1- cal-tex-daily-start))
+ hour)
(cal-tex-banner "cal-tex-daily-page")
(cal-tex-b-makebox "4cm" "l")
(cal-tex-b-parbox "b" "3.8cm")
@@ -1755,7 +1755,7 @@ current contents."
COMMENT may contain newlines, which are prefixed by \"% \" in the output."
(insert (format "%% %s\n"
(if comment
- (replace-regexp-in-string "\n" "\n% " comment)
+ (string-replace "\n" "\n% " comment)
""))))
(defun cal-tex-banner (comment)
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 3f9fe1c9d8f..76d6132eae1 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -137,7 +137,7 @@
;; - whatever is passed to diary-sexp-entry
;; - whatever is passed to diary-remind
-(defmacro calendar-dlet* (binders &rest body)
+(defmacro calendar-dlet (binders &rest body)
"Like `dlet' but without warnings about non-prefixed var names."
(declare (indent 1) (debug let))
(let ((vars (mapcar (lambda (binder)
@@ -1499,7 +1499,7 @@ first INDENT characters on the line."
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
- (calendar-dlet* ((month month) (year year))
+ (calendar-dlet ((month month) (year year))
(calendar-string-spread (list calendar-month-header)
?\s calendar-month-digit-width)))
(calendar-ensure-newline)
@@ -1516,7 +1516,7 @@ first INDENT characters on the line."
calendar-day-header-width nil ?\s)
(make-string (- calendar-column-width calendar-day-header-width) ?\s)))
(calendar-ensure-newline)
- (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-dlet ((day day) (month month) (year year))
(calendar-insert-at-column indent calendar-intermonth-text trunc))
;; Add blank days before the first of the month.
(insert (make-string (* blank-days calendar-column-width) ?\s))
@@ -1527,7 +1527,7 @@ first INDENT characters on the line."
(insert (propertize
(format (format "%%%dd" calendar-day-digit-width) day)
'mouse-face 'highlight
- 'help-echo (calendar-dlet* ((day day) (month month) (year year))
+ 'help-echo (calendar-dlet ((day day) (month month) (year year))
(eval calendar-date-echo-text t))
;; 'date property prevents intermonth text confusing re-searches.
;; (Tried intangible, it did not really work.)
@@ -1538,7 +1538,7 @@ first INDENT characters on the line."
(/= day last))
(calendar-ensure-newline)
(setq day (1+ day)) ; first day of next week
- (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-dlet ((day day) (month month) (year year))
(calendar-insert-at-column indent calendar-intermonth-text trunc))))))
(defun calendar-redraw ()
@@ -1833,7 +1833,7 @@ concatenated and the result truncated."
(bufferp (get-buffer calendar-buffer)))
(with-current-buffer calendar-buffer
(let ((start (- calendar-left-margin 2)))
- (calendar-dlet* ((date (condition-case nil
+ (calendar-dlet ((date (condition-case nil
(calendar-cursor-to-nearest-date)
(error (calendar-current-date)))))
(setq mode-line-format
@@ -2561,7 +2561,7 @@ and day names to be abbreviated as specified by
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
(let ((month (calendar-extract-month date)))
- (calendar-dlet*
+ (calendar-dlet
((dayname (unless nodayname (calendar-day-name date abbreviate)))
(monthname (calendar-month-name month abbreviate))
(day (number-to-string (calendar-extract-day date)))
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 4efa3669967..f57fe26058f 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -663,7 +663,7 @@ any entries were found."
(calendar-month-name-array (or months calendar-month-name-array))
(case-fold-search t)
entry-found)
- (calendar-dlet*
+ (calendar-dlet
((dayname (format "%s\\|%s\\.?" (calendar-day-name date)
(calendar-day-name date 'abbrev)))
(monthname (format "\\*\\|%s%s" (calendar-month-name month)
@@ -858,7 +858,7 @@ 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.
- (calendar-dlet* ((number number)
+ (calendar-dlet ((number number)
(list-only list-only))
(run-hooks 'diary-nongregorian-listing-hook
'diary-list-entries-hook))
@@ -877,7 +877,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(copy-sequence
(car display-buffer-fallback-action))))))
(funcall diary-display-function)))
- (calendar-dlet* ((number number)
+ (calendar-dlet ((number number)
(original-date original-date))
(run-hooks 'diary-hook))))))
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
@@ -1266,7 +1266,7 @@ 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."
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array))
(monthname (format "%s\\|\\*"
@@ -1435,7 +1435,7 @@ 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
- (calendar-dlet* ((date date)
+ (calendar-dlet ((date date)
(entry entry))
(if calendar-debug-sexp
(let ((debug-on-error t))
@@ -2043,7 +2043,7 @@ calendar."
(and (integerp days)
(< days 0)
(setq days (number-sequence 1 (- days))))
- (calendar-dlet* ((diary-entry (eval sexp)))
+ (calendar-dlet ((diary-entry (eval sexp)))
(cond
;; Diary entry applies on date.
((and diary-entry
@@ -2059,7 +2059,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)))
- (calendar-dlet* ((days days))
+ (calendar-dlet ((days days))
(mapconcat #'eval diary-remind-message "")))))
;; Diary entry may apply to one of a list of days before date.
((and (listp days) days)
@@ -2264,7 +2264,7 @@ 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."
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array
calendar-day-abbrev-array t))
(monthname (format "\\(%s\\|\\*\\)"
@@ -2400,7 +2400,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
This depends on the calendar date style."
(declare (obsolete nil "28.1"))
(concat
- (calendar-dlet*
+ (calendar-dlet
((dayname (diary-name-pattern calendar-day-name-array nil t))
(monthname (diary-name-pattern calendar-month-name-array nil t))
(day "1")
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 4bc17de3067..3eae2dcc7f1 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -683,7 +683,7 @@ nil, or if the date is not visible, there is no holiday."
(y displayed-year))
(calendar-increment-month m y -1)
(holiday-filter-visible-calendar
- (calendar-dlet* (year date)
+ (calendar-dlet (year date)
(list
(progn
(setq year y
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 1d7de4a0c5d..eaee2e9d951 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -66,7 +66,7 @@
;; 0.02:
;; - Should work in XEmacs now. Thanks to Len Trigg for the XEmacs patches!
;; - Added exporting from Emacs diary to ical.
-;; - Some bugfixes, after testing with calendars from http://icalshare.com.
+;; - Some bugfixes, after testing with calendars from https://icalshare.com.
;; - Tested with Emacs 21.3.2 and XEmacs 21.4.12
;; 0.01: (2003-03-21)
@@ -105,10 +105,6 @@
;;; Code:
-(defconst icalendar-version "0.19"
- "Version number of icalendar.el.")
-(make-obsolete-variable 'icalendar-version nil "28.1")
-
;; ======================================================================
;; Customizables
;; ======================================================================
@@ -585,19 +581,19 @@ ALIST is a VTIMEZONE potentially containing historical records."
(list
(car
(sort components
- #'(lambda (a b)
- (let* ((get-recent (lambda (n)
- (car
- (sort
- (delq nil
- (mapcar (lambda (p)
- (and (memq (car p) '(DTSTART RDATE))
- (car (cddr p))))
- n))
- 'string-greaterp))))
- (a-recent (funcall get-recent (car (cddr a))))
- (b-recent (funcall get-recent (car (cddr b)))))
- (string-greaterp a-recent b-recent))))))))
+ (lambda (a b)
+ (let* ((get-recent (lambda (n)
+ (car
+ (sort
+ (delq nil
+ (mapcar (lambda (p)
+ (and (memq (car p) '(DTSTART RDATE))
+ (car (cddr p))))
+ n))
+ 'string-greaterp))))
+ (a-recent (funcall get-recent (car (cddr a))))
+ (b-recent (funcall get-recent (car (cddr b)))))
+ (string-greaterp a-recent b-recent))))))))
(defun icalendar--convert-all-timezones (icalendar)
"Convert all timezones in the ICALENDAR into an alist.
@@ -773,9 +769,6 @@ American format: \"month day year\"."
;; datetime == nil
nil))
-(define-obsolete-function-alias 'icalendar--datetime-to-noneuropean-date
- 'icalendar--datetime-to-american-date "icalendar 0.19")
-
(defun icalendar--datetime-to-european-date (datetime &optional separator)
"Convert the decoded DATETIME to European format.
Optional argument SEPARATOR gives the separator between month,
@@ -889,12 +882,14 @@ If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days."
(format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))))
-(defun icalendar--datestring-to-isodate (datestring &optional day-shift)
+(defun icalendar--datestring-to-isodate (datestring &optional day-shift year-shift)
"Convert diary-style DATESTRING to iso-style date.
If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days
--- DAY-SHIFT must be either nil or an integer. This function
-tries to figure the date style from DATESTRING itself. If that
-is not possible it uses the current calendar date style."
+-- DAY-SHIFT must be either nil or an integer. If YEAR-SHIFT is
+non-nil, the result is shifted by YEAR-SHIFT years -- YEAR-SHIFT
+must be either nil or an integer. This function tries to figure
+the date style from DATESTRING itself. If that is not possible
+it uses the current calendar date style."
(let ((day -1) month year)
(save-match-data
(cond ( ;; iso-style numeric date
@@ -904,7 +899,7 @@ is not possible it uses the current calendar date style."
"0?\\([1-9][0-9]?\\)")
datestring)
(setq year (read (substring datestring (match-beginning 1)
- (match-end 1))))
+ (match-end 1))))
(setq month (read (substring datestring (match-beginning 2)
(match-end 2))))
(setq day (read (substring datestring (match-beginning 3)
@@ -967,6 +962,9 @@ is not possible it uses the current calendar date style."
(match-end 3)))))
(t
nil)))
+ (when year-shift
+ (setq year (+ year year-shift)))
+
(if (> day 0)
(let ((mdy (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian (list month day
@@ -1000,15 +998,15 @@ TIMESTRING and has the same result as \"9:00\"."
(defun icalendar--convert-string-for-export (string)
"Escape comma and other critical characters in STRING."
- (replace-regexp-in-string "," "\\\\," string))
+ (string-replace "," "\\," string))
(defun icalendar--convert-string-for-import (string)
"Remove escape chars for comma, semicolon etc. from STRING."
- (replace-regexp-in-string
- "\\\\n" "\n " (replace-regexp-in-string
- "\\\\\"" "\"" (replace-regexp-in-string
- "\\\\;" ";" (replace-regexp-in-string
- "\\\\," "," string)))))
+ (string-replace
+ "\\n" "\n " (string-replace
+ "\\\"" "\"" (string-replace
+ "\\;" ";" (string-replace
+ "\\," "," string)))))
;; ======================================================================
;; Export -- convert emacs-diary to iCalendar
@@ -1275,7 +1273,7 @@ Returns an alist."
(concat "\\(" icalendar-import-format-uid "\\)??"))))
;; Need the \' regexp in order to detect multi-line items
(setq s (concat "\\`"
- (replace-regexp-in-string "%s" "\\(.*?\\)" s nil t)
+ (replace-regexp-in-string "%s" "\\([^z-a]*?\\)" s nil t)
"\\'"))
(if (string-match s summary-and-rest)
(let (cla des loc org sta url uid) ;; sum
@@ -1785,8 +1783,8 @@ entries. ENTRY-MAIN is the first line of the diary entry."
;;BUT remove today if `diary-float'
;;expression does not hold true for today:
(when
- (null (calendar-dlet* ((date (calendar-current-date))
- (entry entry-main))
+ (null (calendar-dlet ((date (calendar-current-date))
+ (entry entry-main))
(diary-float month dayname n)))
(concat
"\nEXDATE;VALUE=DATE:"
@@ -1916,9 +1914,9 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(let* ((datetime (substring entry-main (match-beginning 1)
(match-end 1)))
(startisostring (icalendar--datestring-to-isodate
- datetime))
+ datetime nil 1))
(endisostring (icalendar--datestring-to-isodate
- datetime 1))
+ datetime 1 1))
(starttimestring (icalendar--diarytime-to-isotime
(if (match-beginning 3)
(substring entry-main
@@ -1987,9 +1985,7 @@ Argument ICAL-FILENAME output iCalendar file.
Argument DIARY-FILENAME input `diary-file'.
Optional argument NON-MARKING determines whether events are created as
non-marking or not."
- (interactive "fImport iCalendar data from file: \n\
-Finto diary file:
-P")
+ (interactive "fImport iCalendar data from file: \nFInto diary file: \nP")
;; clean up the diary file
(save-current-buffer
;; now load and convert from the ical file
@@ -2402,8 +2398,11 @@ END-T is the event's end time in diary format."
(if end-t "-" "")
(or end-t ""))))
(setq result (format
- "%%%%(and (diary-anniversary %s)) %s%s%s"
- dtstart-conv
+ "%%%%(diary-anniversary %s) %s%s%s"
+ (let* ((year (nth 5 dtstart-dec))
+ (dtstart-1y-dec (copy-sequence dtstart-dec)))
+ (setf (nth 5 dtstart-1y-dec) (1- year))
+ (icalendar--datetime-to-diary-date dtstart-1y-dec))
(or start-t "")
(if end-t "-" "") (or end-t "")))))
;; monthly
@@ -2552,6 +2551,11 @@ the entry."
(or (icalendar--get-event-property event 'URL) "")
(or (icalendar--get-event-property event 'CLASS) "")))
+;; Obsolete
+
+(defconst icalendar-version "0.19" "Version number of icalendar.el.")
+(make-obsolete-variable 'icalendar-version 'emacs-version "28.1")
+
(provide 'icalendar)
;;; icalendar.el ends here
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index 5a109a73cd9..1de1796a054 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -41,7 +41,7 @@
;;
;; The standard can be found at:
;;
-;; http://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf
+;; https://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf
;;
;; The Wikipedia page on the standard is also informative:
;;
@@ -57,7 +57,7 @@
(defun iso8601--concat-regexps (regexps)
(mapconcat (lambda (regexp)
(concat "\\(?:"
- (replace-regexp-in-string "(" "(?:" regexp)
+ (string-replace "(" "(?:" regexp)
"\\)"))
regexps "\\|"))
@@ -92,13 +92,13 @@
"\\(Z\\|\\([+-]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)")
(defconst iso8601--full-time-match
- (concat "\\(" (replace-regexp-in-string "(" "(?:" iso8601--time-match) "\\)"
+ (concat "\\(" (string-replace "(" "(?:" iso8601--time-match) "\\)"
"\\(" iso8601--zone-match "\\)?"))
(defconst iso8601--combined-match
(concat "\\(" iso8601--date-match "\\)"
"\\(?:T\\("
- (replace-regexp-in-string "(" "(?:" iso8601--time-match)
+ (string-replace "(" "(?:" iso8601--time-match)
"\\)"
"\\(" iso8601--zone-match "\\)?\\)?"))
@@ -231,17 +231,22 @@ See `decode-time' for the meaning of FORM."
(string-to-number (match-string 2 time))))
(second (and (match-string 3 time)
(string-to-number (match-string 3 time))))
- (fraction (and (not (zerop (length (match-string 4 time))))
- (string-to-number (match-string 4 time)))))
+ (frac-string (match-string 4 time))
+ fraction fraction-precision)
+ (when frac-string
+ ;; Remove trailing zeroes.
+ (setq frac-string (replace-regexp-in-string "0+\\'" "" frac-string))
+ (when (length> frac-string 0)
+ (setq fraction (string-to-number frac-string)
+ fraction-precision (length frac-string))))
(when (and fraction
(eq form t))
(cond
;; Sub-second time.
(second
- (let ((digits (1+ (truncate (log fraction 10)))))
- (setq second (cons (+ (* second (expt 10 digits))
- fraction)
- (expt 10 digits)))))
+ (setq second (cons (+ (* second (expt 10 fraction-precision))
+ fraction)
+ (expt 10 fraction-precision))))
;; Fractional minute.
(minute
(setq second (iso8601--decimalize fraction 60)))
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index ba7418faf78..5a3d2706afd 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -29,7 +29,7 @@
;; `parse-time-string' parses a time in a string and returns a list of
;; values, just like `decode-time', where unspecified elements in the
-;; string are returned as nil (except unspecfied DST is returned as -1).
+;; string are returned as nil (except unspecified DST is returned as -1).
;; `encode-time' may be applied on these values to obtain an internal
;; time value.
@@ -103,46 +103,46 @@ letters, digits, plus or minus signs or colons."
((4) parse-time-months)
((5) (100))
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 8)
- (= (aref parse-time-elt 2) ?:)
- (= (aref parse-time-elt 5) ?:)))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 8)
+ (= (aref parse-time-elt 2) ?:)
+ (= (aref parse-time-elt 5) ?:)))
[0 2] [3 5] [6 8])
((8 7) parse-time-zoneinfo
- ,#'(lambda () (car parse-time-val))
- ,#'(lambda () (cadr parse-time-val)))
+ ,(lambda () (car parse-time-val))
+ ,(lambda () (cadr parse-time-val)))
((8)
- ,#'(lambda ()
- (and (stringp parse-time-elt)
- (= 5 (length parse-time-elt))
- (or (= (aref parse-time-elt 0) ?+)
- (= (aref parse-time-elt 0) ?-))))
- ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
- (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
- (if (= (aref parse-time-elt 0) ?-) -1 1))))
+ ,(lambda ()
+ (and (stringp parse-time-elt)
+ (= 5 (length parse-time-elt))
+ (or (= (aref parse-time-elt 0) ?+)
+ (= (aref parse-time-elt 0) ?-))))
+ ,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
+ (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
+ (if (= (aref parse-time-elt 0) ?-) -1 1))))
((5 4 3)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 10)
- (= (aref parse-time-elt 4) ?-)
- (= (aref parse-time-elt 7) ?-)))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 10)
+ (= (aref parse-time-elt 4) ?-)
+ (= (aref parse-time-elt 7) ?-)))
[0 4] [5 7] [8 10])
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 5)
- (= (aref parse-time-elt 2) ?:)))
- [0 2] [3 5] ,#'(lambda () 0))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 5)
+ (= (aref parse-time-elt 2) ?:)))
+ [0 2] [3 5] ,(lambda () 0))
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 4)
- (= (aref parse-time-elt 1) ?:)))
- [0 1] [2 4] ,#'(lambda () 0))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 4)
+ (= (aref parse-time-elt 1) ?:)))
+ [0 1] [2 4] ,(lambda () 0))
((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 7)
- (= (aref parse-time-elt 1) ?:)))
+ ,(lambda () (and (stringp parse-time-elt)
+ (= (length parse-time-elt) 7)
+ (= (aref parse-time-elt 1) ?:)))
[0 1] [2 4] [5 7])
- ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
- ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
+ ((5) (50 110) ,(lambda () (+ 1900 parse-time-elt)))
+ ((5) (0 49) ,(lambda () (+ 2000 parse-time-elt))))
"(slots predicate extractor...)")
;;;###autoload(put 'parse-time-rules 'risky-local-variable t)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 372490db9ec..b5f2f454aea 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -552,7 +552,7 @@ degrees to find out if polar regions have 24 hours of sun or only night."
Format used is given by `calendar-time-display-form'."
(let* ((time (round (* 60 time)))
(24-hours (/ time 60)))
- (calendar-dlet*
+ (calendar-dlet
((time-zone time-zone)
(minutes (format "%02d" (% time 60)))
(12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 2df57a3c33d..0aa38166bc1 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -357,7 +357,7 @@ is output until the first non-zero unit is encountered."
(format " %s%s" name
(if (= num 1) "" "s"))))
t t string))))))
- (replace-regexp-in-string "%%" "%" string))
+ (string-replace "%%" "%" string))
(defvar seconds-to-string
(list (list 1 "ms" 0.001)
@@ -525,6 +525,8 @@ changes in daylight saving time are not taken into account."
(defun decoded-time-set-defaults (time &optional default-zone)
"Set any nil values in `decoded-time' TIME to default values.
The default value is based on January 1st, 1970 at midnight.
+This year is used to guarantee portability; see Info
+node `(elisp) Time of Day'.
TIME is modified and returned."
(unless (decoded-time-second time)
@@ -539,7 +541,7 @@ TIME is modified and returned."
(unless (decoded-time-month time)
(setf (decoded-time-month time) 1))
(unless (decoded-time-year time)
- (setf (decoded-time-year time) 0))
+ (setf (decoded-time-year time) 1970))
;; When we don't have a time zone, default to DEFAULT-ZONE without
;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise.
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 0bbaa1e1ed6..4a4b65d3745 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -69,8 +69,6 @@
;; your average working time, and will make sure that the various
;; display functions return the correct value.
-;;; History:
-
;;; Code:
(require 'cl-lib)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 0daa1530109..371d10631c5 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -191,7 +191,7 @@ 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 "\\)\\|"
- (calendar-dlet*
+ (calendar-dlet
((dayname)
(monthname (format "\\(?6:%s\\)" (diary-name-pattern
todo-month-name-array
@@ -2279,7 +2279,7 @@ made in the number or names of categories."
(inc (prefix-numeric-value inc))
(buffer-read-only nil)
ndate ntime
- year monthname month day dayname)
+ 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))
@@ -2431,13 +2431,13 @@ made in the number or names of categories."
;; changed, rebuild the date string.
(when (memq what '(year month day))
(setq ndate
- (calendar-dlet*
+ (calendar-dlet
;; Needed by calendar-date-display-form.
((year year)
(monthname monthname)
(month month)
(day day)
- (dayname dayname))
+ (dayname nil)) ;; 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.
@@ -3450,8 +3450,8 @@ containing only archived items, provided user option
are shown in `todo-archived-only' face."
(interactive)
(todo-display-categories)
- (let (sortkey)
- (todo-update-categories-display sortkey)))
+ ;; (let (sortkey)
+ (todo-update-categories-display nil)) ;; sortkey
(defun todo-next-button (n)
"Move point to the Nth next button in the table of categories."
@@ -4546,7 +4546,7 @@ its priority has changed, and `same' otherwise."
(let ((bufname (buffer-name)))
(string-match "\"\\([^\"]+\\)\"" bufname)
(let* ((filename-str (substring bufname (match-beginning 1) (match-end 1)))
- (filename-base (replace-regexp-in-string ", " "-" filename-str))
+ (filename-base (string-replace ", " "-" filename-str))
(top-priorities (string-match "top priorities" bufname))
(diary-items (string-match "diary items" bufname))
(regexp-items (string-match "regexp items" bufname)))
@@ -4658,7 +4658,7 @@ 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'."
- (calendar-dlet*
+ (calendar-dlet
((year (match-string 1))
(month (match-string 2))
(monthname (calendar-month-name (string-to-number month) t))
@@ -6036,7 +6036,7 @@ 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."
- (calendar-dlet*
+ (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 '*)))
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index 75a69db0a8c..6ffc2765d68 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -1,6 +1,6 @@
-;;; cedet-cscope.el --- CScope support for CEDET
+;;; cedet-cscope.el --- CScope support for CEDET -*- lexical-binding: t; -*-
-;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
@@ -26,8 +26,6 @@
;;; Code:
-(declare-function inversion-check-version "inversion")
-
(defvar cedet-cscope-min-version "15.7"
"Minimum version of CScope required.")
@@ -36,7 +34,7 @@
:type 'string
:group 'cedet)
-(defun cedet-cscope-search (searchtext texttype type scope)
+(defun cedet-cscope-search (searchtext texttype type _scope)
"Perform a search with CScope, return the created buffer.
SEARCHTEXT is text to find.
TEXTTYPE is the type of text, such as `regexp', `string', `tagname',
@@ -87,7 +85,7 @@ options -cR."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process cedet-cscope-command
+ (apply #'call-process cedet-cscope-command
nil b nil
flags)
b))
@@ -139,7 +137,6 @@ If optional programmatic argument NOERROR is non-nil,
then instead of throwing an error if CScope isn't available,
return nil."
(interactive)
- (require 'inversion)
(let ((b (condition-case nil
(cedet-cscope-call (list "-V"))
(error nil)))
@@ -153,7 +150,7 @@ return nil."
(goto-char (point-min))
(re-search-forward "cscope: version \\([0-9.]+\\)" nil t)
(setq rev (match-string 1))
- (if (inversion-check-version rev nil cedet-cscope-min-version)
+ (if (version< rev cedet-cscope-min-version)
(if noerror
nil
(error "Version of CScope is %s. Need at least %s"
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index 31608159cc1..f540fb5540f 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -1,4 +1,4 @@
-;;; cedet-files.el --- Common routines dealing with file names.
+;;; cedet-files.el --- Common routines dealing with file names. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -59,7 +59,7 @@ to the file's truename, and dodging platform tricks."
;; doubling `!'s in the original name...
(setq file (subst-char-in-string
?/ ?!
- (replace-regexp-in-string "!" "!!" file)))
+ (string-replace "!" "!!" file)))
file))
(defun cedet-file-name-to-directory-name (referencefile &optional testmode)
@@ -71,7 +71,7 @@ specific conversions during tests."
;; Replace the ! with /
(setq file (subst-char-in-string ?! ?/ file))
;; Occurrences of // meant there was once a single !.
- (setq file (replace-regexp-in-string "//" "!" file))
+ (setq file (string-replace "//" "!" file))
;; Handle Windows special cases
(when (or (memq system-type '(windows-nt ms-dos)) testmode)
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index 5878ec1f485..227ebd54b86 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -1,4 +1,4 @@
-;;; cedet-global.el --- GNU Global support for CEDET.
+;;; cedet-global.el --- GNU Global support for CEDET. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;
;; Basic support for calling GNU Global, and testing version numbers.
-(declare-function inversion-check-version "inversion")
-
(defvar cedet-global-min-version "5.0"
"Minimum version of GNU Global required.")
@@ -77,7 +75,7 @@ SCOPE is the scope of the search, such as `project' or `subdirs'."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process cedet-global-command
+ (apply #'call-process cedet-global-command
nil b nil
flags)
b))
@@ -90,7 +88,7 @@ SCOPE is the scope of the search, such as `project' or `subdirs'."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process cedet-global-gtags-command
+ (apply #'call-process cedet-global-gtags-command
nil b nil
flags)
@@ -143,7 +141,6 @@ If optional programmatic argument NOERROR is non-nil,
then instead of throwing an error if Global isn't available,
return nil."
(interactive)
- (require 'inversion)
(let ((b (condition-case nil
(cedet-gnu-global-call (list "--version"))
(error nil)))
@@ -157,7 +154,7 @@ return nil."
(goto-char (point-min))
(re-search-forward "(?GNU GLOBAL)? \\([0-9.]+\\)" nil t)
(setq rev (match-string 1))
- (if (inversion-check-version rev nil cedet-global-min-version)
+ (if (version< rev cedet-global-min-version)
(if noerror
nil
(error "Version of GNU Global is %s. Need at least %s"
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index fc5e05af88e..a2b8cb35240 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -1,4 +1,4 @@
-;;; cedet-idutils.el --- ID Utils support for CEDET.
+;;; cedet-idutils.el --- ID Utils support for CEDET. -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -29,8 +29,6 @@
;;; Code:
-(declare-function inversion-check-version "inversion")
-
(defvar cedet-idutils-min-version "4.0"
"Minimum version of ID Utils required.")
@@ -49,7 +47,7 @@
:type 'string
:group 'cedet)
-(defun cedet-idutils-search (searchtext texttype type scope)
+(defun cedet-idutils-search (searchtext texttype type _scope)
"Perform a search with ID Utils, return the created buffer.
SEARCHTEXT is text to find.
TEXTTYPE is the type of text, such as `regexp', `string', `tagname',
@@ -66,7 +64,7 @@ Note: Scope is not yet supported."
(let* ((resultflg (if (eq texttype 'tagcompletions)
(list "--key=token")
(list "--result=grep")))
- (scopeflgs nil) ; (cond ((eq scope 'project) "" ) ((eq scope 'target) "l")))
+ ;; (scopeflgs (cond ((eq scope 'project) "" ) ((eq scope 'target) "l")))
(stflag (cond ((or (eq texttype 'tagname)
(eq texttype 'tagregexp))
(list "-r" "-w"))
@@ -79,7 +77,7 @@ Note: Scope is not yet supported."
;; t means 'symbol
(t (list "-l" "-w"))))
)
- (cedet-idutils-lid-call (append resultflg scopeflgs stflag
+ (cedet-idutils-lid-call (append resultflg nil stflag ;; scopeflgs
(list searchtext))))))
(defun cedet-idutils-fnid-call (flags)
@@ -91,7 +89,7 @@ Return the created buffer with program output."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process cedet-idutils-file-command
+ (apply #'call-process cedet-idutils-file-command
nil b nil
flags)
b))
@@ -105,7 +103,7 @@ Return the created buffer with program output."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process cedet-idutils-token-command
+ (apply #'call-process cedet-idutils-token-command
nil b nil
flags)
b))
@@ -119,7 +117,7 @@ Return the created buffer with program output."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process cedet-idutils-make-command
+ (apply #'call-process cedet-idutils-make-command
nil b nil
flags)
b))
@@ -135,7 +133,7 @@ Return a filename relative to the default directory."
(if (looking-at "[^ \n]*fnid: ")
(error "ID Utils not available")
(split-string (buffer-string) "\n" t)))))
- (setq ans (mapcar 'expand-file-name ans))
+ (setq ans (mapcar #'expand-file-name ans))
(when (called-interactively-p 'interactive)
(if ans
(if (= (length ans) 1)
@@ -167,7 +165,6 @@ If optional programmatic argument NOERROR is non-nil,
then instead of throwing an error if Global isn't available,
return nil."
(interactive)
- (require 'inversion)
(let ((b (condition-case nil
(cedet-idutils-fnid-call (list "--version"))
(error nil)))
@@ -182,7 +179,7 @@ return nil."
(if (re-search-forward "fnid - \\([0-9.]+\\)" nil t)
(setq rev (match-string 1))
(setq rev "0"))
- (if (inversion-check-version rev nil cedet-idutils-min-version)
+ (if (version< rev cedet-idutils-min-version)
(if noerror
nil
(error "Version of ID Utils is %s. Need at least %s"
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index caaec473a2c..b6043f1403e 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -1,4 +1,4 @@
-;;; cedet.el --- Setup CEDET environment
+;;; cedet.el --- Setup CEDET environment -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -48,25 +48,25 @@
(defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu")
(let ((map (make-sparse-keymap "CEDET menu")))
- (define-key map [semantic-force-refresh] 'undefined)
- (define-key map [semantic-edit-menu] 'undefined)
- (define-key map [navigate-menu] 'undefined)
- (define-key map [semantic-options-separator] 'undefined)
- (define-key map [global-semantic-highlight-func-mode] 'undefined)
- (define-key map [global-semantic-stickyfunc-mode] 'undefined)
- (define-key map [global-semantic-decoration-mode] 'undefined)
- (define-key map [global-semantic-idle-completions-mode] 'undefined)
- (define-key map [global-semantic-idle-summary-mode] 'undefined)
- (define-key map [global-semantic-idle-scheduler-mode] 'undefined)
- (define-key map [global-semanticdb-minor-mode] 'undefined)
- (define-key map [cedet-menu-separator] 'undefined)
- (define-key map [ede-find-file] 'undefined)
- (define-key map [ede-speedbar] 'undefined)
- (define-key map [ede] 'undefined)
- (define-key map [ede-new] 'undefined)
- (define-key map [ede-target-options] 'undefined)
- (define-key map [ede-project-options] 'undefined)
- (define-key map [ede-build-forms-menu] 'undefined)
+ (define-key map [semantic-force-refresh] #'undefined)
+ (define-key map [semantic-edit-menu] #'undefined)
+ (define-key map [navigate-menu] #'undefined)
+ (define-key map [semantic-options-separator] #'undefined)
+ (define-key map [global-semantic-highlight-func-mode] #'undefined)
+ (define-key map [global-semantic-stickyfunc-mode] #'undefined)
+ (define-key map [global-semantic-decoration-mode] #'undefined)
+ (define-key map [global-semantic-idle-completions-mode] #'undefined)
+ (define-key map [global-semantic-idle-summary-mode] #'undefined)
+ (define-key map [global-semantic-idle-scheduler-mode] #'undefined)
+ (define-key map [global-semanticdb-minor-mode] #'undefined)
+ (define-key map [cedet-menu-separator] #'undefined)
+ (define-key map [ede-find-file] #'undefined)
+ (define-key map [ede-speedbar] #'undefined)
+ (define-key map [ede] #'undefined)
+ (define-key map [ede-new] #'undefined)
+ (define-key map [ede-target-options] #'undefined)
+ (define-key map [ede-project-options] #'undefined)
+ (define-key map [ede-build-forms-menu] #'undefined)
map)
"Menu keymap for the CEDET package.
This is used by `semantic-mode' and `global-ede-mode'.")
@@ -85,6 +85,7 @@ for the specified PACKAGE.
LOADED VERSION is the version of PACKAGE currently loaded in Emacs
memory and (presumably) running in this Emacs instance. Value is X
if the package has not been loaded."
+ (declare (obsolete emacs-version "28.1"))
(interactive)
(require 'inversion)
(with-output-to-temp-buffer "*CEDET*"
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index a062a5a5853..428848be04d 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1,4 +1,4 @@
-;;; data-debug.el --- Data structure debugger
+;;; data-debug.el --- Data structure debugger -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -48,9 +48,9 @@
;;; Compatibility
;;
-(define-obsolete-function-alias 'data-debug-overlay-properties 'overlay-properties "28.1")
-(define-obsolete-function-alias 'data-debug-overlay-p 'overlayp "28.1")
-(define-obsolete-function-alias 'dd-propertize 'propertize "28.1")
+(define-obsolete-function-alias 'data-debug-overlay-properties #'overlay-properties "28.1")
+(define-obsolete-function-alias 'data-debug-overlay-p #'overlayp "28.1")
+(define-obsolete-function-alias 'dd-propertize #'propertize "28.1")
;;; GENERIC STUFF
;;
@@ -100,14 +100,14 @@ PREBUTTONTEXT is some text between prefix and the overlay button."
(let ((start (point))
(end nil)
(str (format "%s" overlay))
- (tip nil))
+ ) ;; (tip nil)
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-comment-face)
(put-text-property start end 'ddebug overlay)
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
- (put-text-property start end 'help-echo tip)
+ ;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-overlay-from-point)
(insert "\n")
@@ -149,14 +149,14 @@ PREBUTTONTEXT is some text between prefix and the overlay list button."
(let ((start (point))
(end nil)
(str (format "#<overlay list: %d entries>" (length overlaylist)))
- (tip nil))
+ ) ;; (tip nil)
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-comment-face)
(put-text-property start end 'ddebug overlaylist)
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
- (put-text-property start end 'help-echo tip)
+ ;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-overlay-list-from-point)
(insert "\n")
@@ -204,14 +204,14 @@ PREBUTTONTEXT is some text between prefix and the buffer button."
(let ((start (point))
(end nil)
(str (format "%S" buffer))
- (tip nil))
+ ) ;; (tip nil)
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-comment-face)
(put-text-property start end 'ddebug buffer)
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
- (put-text-property start end 'help-echo tip)
+ ;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-buffer-from-point)
(insert "\n")
@@ -253,14 +253,14 @@ PREBUTTONTEXT is some text between prefix and the buffer list button."
(let ((start (point))
(end nil)
(str (format "#<buffer list: %d entries>" (length bufferlist)))
- (tip nil))
+ ) ;; (tip nil)
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-comment-face)
(put-text-property start end 'ddebug bufferlist)
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
- (put-text-property start end 'help-echo tip)
+ ;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-buffer-list-from-point)
(insert "\n")
@@ -309,14 +309,14 @@ PREBUTTONTEXT is some text between prefix and the process button."
(let ((start (point))
(end nil)
(str (format "%S : %s" process (process-status process)))
- (tip nil))
+ ) ;; (tip nil)
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-comment-face)
(put-text-property start end 'ddebug process)
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
- (put-text-property start end 'help-echo tip)
+ ;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-process-from-point)
(insert "\n")
@@ -363,8 +363,8 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(str (format "#<RING: %d, %d max>"
(ring-length ring)
(ring-size ring)))
- (ringthing
- (if (= (ring-length ring) 0) nil (ring-ref ring 0)))
+ ;; (ringthing
+ ;; (if (= (ring-length ring) 0) nil (ring-ref ring 0)))
(tip (format "Ring max-size %d, length %d."
(ring-size ring)
(ring-length ring)))
@@ -437,7 +437,7 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
;; Widgets have a long list of properties
(defun data-debug-insert-widget-properties (widget prefix)
"Insert the contents of WIDGET inserting PREFIX before each element."
- (let ((type (car widget))
+ (let (;; (type (car widget))
(rest (cdr widget)))
(while rest
(data-debug-insert-thing (car (cdr rest))
@@ -683,7 +683,7 @@ PREBUTTONTEXT is some text between prefix and the thing."
)
;;; nil thing
-(defun data-debug-insert-nil (thing prefix prebuttontext)
+(defun data-debug-insert-nil (_thing prefix prebuttontext)
"Insert one simple THING with a face.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing.
@@ -856,19 +856,18 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
(defvar data-debug-mode-map
(let ((km (make-sparse-keymap)))
(suppress-keymap km)
- (define-key km [mouse-2] 'data-debug-expand-or-contract-mouse)
- (define-key km " " 'data-debug-expand-or-contract)
- (define-key km "\C-m" 'data-debug-expand-or-contract)
- (define-key km "n" 'data-debug-next)
- (define-key km "p" 'data-debug-prev)
- (define-key km "N" 'data-debug-next-expando)
- (define-key km "P" 'data-debug-prev-expando)
+ (define-key km [mouse-2] #'data-debug-expand-or-contract-mouse)
+ (define-key km " " #'data-debug-expand-or-contract)
+ (define-key km "\C-m" #'data-debug-expand-or-contract)
+ (define-key km "n" #'data-debug-next)
+ (define-key km "p" #'data-debug-prev)
+ (define-key km "N" #'data-debug-next-expando)
+ (define-key km "P" #'data-debug-prev-expando)
km)
"Keymap used in data-debug.")
(defcustom data-debug-mode-hook nil
"Hook run when data-debug starts."
- :group 'data-debug
:type 'hook)
(define-derived-mode data-debug-mode fundamental-mode "DATA-DEBUG"
@@ -1032,7 +1031,7 @@ Do nothing if already contracted."
nil read-expression-map t
'read-expression-history))
))
- (let ((v (eval expr)))
+ (let ((v (eval expr t)))
(if (not v)
(message "Expression %s is nil." expr)
(data-debug-show-stuff v "expression"))))
@@ -1045,30 +1044,30 @@ If the result is a list or vector, then use the data debugger to display it."
(list (let ((minibuffer-completing-symbol t))
(read-from-minibuffer "Eval: "
nil read-expression-map t
- 'read-expression-history))
- ))
-
- (if (null eval-expression-debug-on-error)
- (setq values (cons (eval expr) values))
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (setq values (cons (eval expr) values))
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
-
- (if (or (consp (car values)) (vectorp (car values)))
- (let ((v (car values)))
- (data-debug-show-stuff v "Expression"))
- ;; Old style
- (prog1
- (prin1 (car values) t)
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str t))))))
+ 'read-expression-history))))
+
+ (let (result)
+ (if (null eval-expression-debug-on-error)
+ (setq result (values--store-value (eval expr t)))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (setq result (values--store-value (eval expr t)))
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (if (or (consp result) (vectorp result))
+ (let ((v result))
+ (data-debug-show-stuff v "Expression"))
+ ;; Old style
+ (prog1
+ (prin1 result t)
+ (let ((str (eval-expression-print-format result)))
+ (if str (princ str t)))))))
(provide 'data-debug)
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index e3cc9062ed4..2ec9f5d9d67 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,4 +1,4 @@
-;;; ede.el --- Emacs Development Environment gloss
+;;; ede.el --- Emacs Development Environment gloss -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
@@ -87,7 +87,6 @@ target wants the file, the user is asked. If only one target wants
the file, then it is automatically added to that target. If the
value is `ask', then the user is always asked, unless there is no
target willing to take the file. `never' means never perform the check."
- :group 'ede
:type '(choice (const always)
(const multi-ask)
(const ask)
@@ -95,7 +94,6 @@ target willing to take the file. `never' means never perform the check."
(defcustom ede-debug-program-function 'gdb
"Default Emacs command used to debug a target."
- :group 'ede
:type 'function) ; make this be a list of options some day
(defcustom ede-project-directories nil
@@ -112,7 +110,6 @@ If you invoke the commands \\[ede] or \\[ede-new] on a directory
that is not listed, Emacs will offer to add it to the list.
Any other value disables searching for EDE project files."
- :group 'ede
:type '(choice (const :tag "Any directory" t)
(repeat :tag "List of directories"
(directory))
@@ -186,21 +183,23 @@ Argument LIST-O-O is the list of objects to choose from."
;;; Menu and Keymap
+(declare-function ede-speedbar "ede/speedbar" ())
+
(defvar ede-minor-mode-map
(let ((map (make-sparse-keymap))
(pmap (make-sparse-keymap)))
- (define-key pmap "e" 'ede-edit-file-target)
- (define-key pmap "a" 'ede-add-file)
- (define-key pmap "d" 'ede-remove-file)
- (define-key pmap "t" 'ede-new-target)
- (define-key pmap "g" 'ede-rescan-toplevel)
- (define-key pmap "s" 'ede-speedbar)
- (define-key pmap "f" 'ede-find-file)
- (define-key pmap "C" 'ede-compile-project)
- (define-key pmap "c" 'ede-compile-target)
- (define-key pmap "\C-c" 'ede-compile-selected)
- (define-key pmap "D" 'ede-debug-target)
- (define-key pmap "R" 'ede-run-target)
+ (define-key pmap "e" #'ede-edit-file-target)
+ (define-key pmap "a" #'ede-add-file)
+ (define-key pmap "d" #'ede-remove-file)
+ (define-key pmap "t" #'ede-new-target)
+ (define-key pmap "g" #'ede-rescan-toplevel)
+ (define-key pmap "s" #'ede-speedbar)
+ (define-key pmap "f" #'ede-find-file)
+ (define-key pmap "C" #'ede-compile-project)
+ (define-key pmap "c" #'ede-compile-target)
+ (define-key pmap "\C-c" #'ede-compile-selected)
+ (define-key pmap "D" #'ede-debug-target)
+ (define-key pmap "R" #'ede-run-target)
;; bind our submap into map
(define-key map "\C-c." pmap)
map)
@@ -476,7 +475,7 @@ To be used in hook functions."
If this file is contained, or could be contained in an EDE
controlled project, then this mode is activated automatically
provided `global-ede-mode' is enabled."
- :group 'ede
+ :global nil
(cond ((or (eq major-mode 'dired-mode)
(eq major-mode 'vc-dir-mode))
(ede-dired-minor-mode (if ede-minor-mode 1 -1)))
@@ -486,6 +485,9 @@ provided `global-ede-mode' is enabled."
;; If we fail to have a project here, turn it back off.
(ede-minor-mode -1)))))
+(declare-function ede-directory-project-cons "ede/files" (dir &optional force))
+(declare-function ede-toplevel-project-or-nil "ede/files" (dir))
+
(defun ede-initialize-state-current-buffer ()
"Initialize the current buffer's state for EDE.
Sets buffer local variables for EDE."
@@ -496,7 +498,7 @@ Sets buffer local variables for EDE."
;; Init the buffer.
(let* ((ROOT nil)
(proj (ede-directory-get-open-project default-directory
- 'ROOT)))
+ (gv-ref ROOT))))
(when (not proj)
;; If there is no open project, look up the project
@@ -517,7 +519,8 @@ Sets buffer local variables for EDE."
(ede-directory-safe-p top)))
;; The project is safe, so load it in.
- (setq proj (ede-load-project-file default-directory projdetect 'ROOT))))))
+ (setq proj (ede-load-project-file default-directory projdetect
+ (gv-ref ROOT)))))))
;; If PROJ is now loaded in, we can initialize our buffer to it.
(when proj
@@ -561,30 +564,29 @@ Sets buffer local variables for EDE."
This global minor mode enables `ede-minor-mode' in all buffers in
an EDE controlled project."
:global t
- :group 'ede
(if global-ede-mode
;; Turn on global-ede-mode
(progn
(if semantic-mode
(define-key cedet-menu-map [cedet-menu-separator] '("--")))
- (add-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
- (add-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
- (add-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
+ (add-hook 'semanticdb-project-predicate-functions #'ede-directory-project-p)
+ (add-hook 'semanticdb-project-root-functions #'ede-toplevel-project-or-nil)
+ (add-hook 'ecb-source-path-functions #'ede-ecb-project-paths)
;; Append our hook to the end. This allows mode-local to finish
;; it's stuff before we start doing misc file loads, etc.
- (add-hook 'find-file-hook 'ede-turn-on-hook t)
- (add-hook 'dired-mode-hook 'ede-turn-on-hook)
- (add-hook 'kill-emacs-hook 'ede-save-cache)
+ (add-hook 'find-file-hook #'ede-turn-on-hook t)
+ (add-hook 'dired-mode-hook #'ede-turn-on-hook)
+ (add-hook 'kill-emacs-hook #'ede-save-cache)
(ede-load-cache)
(ede-reset-all-buffers))
;; Turn off global-ede-mode
(define-key cedet-menu-map [cedet-menu-separator] nil)
- (remove-hook 'semanticdb-project-predicate-functions 'ede-directory-project-p)
- (remove-hook 'semanticdb-project-root-functions 'ede-toplevel-project-or-nil)
- (remove-hook 'ecb-source-path-functions 'ede-ecb-project-paths)
- (remove-hook 'find-file-hook 'ede-turn-on-hook)
- (remove-hook 'dired-mode-hook 'ede-turn-on-hook)
- (remove-hook 'kill-emacs-hook 'ede-save-cache)
+ (remove-hook 'semanticdb-project-predicate-functions #'ede-directory-project-p)
+ (remove-hook 'semanticdb-project-root-functions #'ede-toplevel-project-or-nil)
+ (remove-hook 'ecb-source-path-functions #'ede-ecb-project-paths)
+ (remove-hook 'find-file-hook #'ede-turn-on-hook)
+ (remove-hook 'dired-mode-hook #'ede-turn-on-hook)
+ (remove-hook 'kill-emacs-hook #'ede-save-cache)
(ede-save-cache)
(ede-reset-all-buffers)))
@@ -1080,7 +1082,7 @@ Flush the dead projects from the project cache."
(let ((dead nil))
(dolist (P ede-projects)
(when (not (file-exists-p (oref P file)))
- (add-to-list 'dead P)))
+ (cl-pushnew P dead :test #'equal)))
(dolist (D dead)
(ede-delete-project-from-global-list D))
))
@@ -1108,7 +1110,7 @@ Flush the dead projects from the project cache."
"Project file independent way to read a project in from DIR.
Optional DETECTIN is an autoload cons from `ede-detect-directory-for-project'
which can be passed in to save time.
-Optional ROOTRETURN will return the root project for DIR."
+Optional ROOTRETURN reference will return the root project for DIR."
;; Don't do anything if we are in the process of
;; constructing an EDE object.
;;
@@ -1147,7 +1149,8 @@ Optional ROOTRETURN will return the root project for DIR."
(setq o (ede-auto-load-project autoloader toppath))))
;; Return the found root project.
- (when rootreturn (set rootreturn o))
+ (when rootreturn (if (symbolp rootreturn) (set rootreturn o)
+ (setf (gv-deref rootreturn) o)))
;; The project has been found (in the global list) or loaded from
;; disk (via autoloader.) We can now search for the project asked
@@ -1504,6 +1507,8 @@ It does not apply the value to buffers."
;;; Integration with project.el
(defun project-try-ede (dir)
+ ;; FIXME: This passes the `ROOT' dynbound variable, but I don't know
+ ;; where it comes from!
(let ((project-dir
(locate-dominating-file
dir
@@ -1518,12 +1523,12 @@ It does not apply the value to buffers."
;;; FIXME: Could someone look into implementing `project-ignores' for
;;; EDE and/or a faster `project-files'?
-(add-hook 'project-find-functions #'project-try-ede)
+(add-hook 'project-find-functions #'project-try-ede 50)
(provide 'ede)
;; Include this last because it depends on ede.
-(require 'ede/files)
+(if t (require 'ede/files)) ;; Don't bother loading it at compile-time.
;; If this does not occur after the provide, we can get a recursive
;; load. Yuck!
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index e1417d7806c..ee9d0116af3 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -1,4 +1,4 @@
-;;; ede/auto.el --- Autoload features for EDE
+;;; ede/auto.el --- Autoload features for EDE -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -325,13 +325,13 @@ NOTE: Do not call this - it should only be called from `ede-load-project-file'."
;; See if we can do without them.
;; @FIXME - delete from loaddefs to remove this.
-(cl-defmethod ede-project-root ((this ede-project-autoload))
+(cl-defmethod ede-project-root ((_this ede-project-autoload))
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems."
nil)
;; @FIXME - delete from loaddefs to remove this.
-(cl-defmethod ede-project-root-directory ((this ede-project-autoload) &optional file)
+(cl-defmethod ede-project-root-directory ((_this ede-project-autoload) &optional _file)
"" nil)
(provide 'ede/auto)
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index ca8535fdf23..d6f0a86f9ad 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -1,4 +1,4 @@
-;;; ede/autoconf-edit.el --- Keymap for autoconf
+;;; ede/autoconf-edit.el --- Keymap for autoconf -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 810d6ef3bd4..103a37045cc 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,4 +1,4 @@
-;;; ede/base.el --- Baseclasses for EDE.
+;;; ede/base.el --- Baseclasses for EDE -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -47,7 +47,7 @@
;; and features of those files.
(defclass ede-target (eieio-speedbar-directory-button eieio-named)
- ((buttonface :initform speedbar-file-face) ;override for superclass
+ ((buttonface :initform 'speedbar-file-face) ;override for superclass
(name :initarg :name
:type string
:custom string
@@ -91,16 +91,16 @@ This is used to match target objects with the compilers they can use, and
which files this object is interested in."
:accessor ede-object-sourcecode)
(keybindings :allocation :class
- :initform (("D" . ede-debug-target))
+ :initform '(("D" . ede-debug-target))
:documentation
"Keybindings specialized to this type of target."
:accessor ede-object-keybindings)
(menu :allocation :class
- :initform ( [ "Debug target" ede-debug-target
- (ede-buffer-belongs-to-target-p) ]
- [ "Run target" ede-run-target
- (ede-buffer-belongs-to-target-p) ]
- )
+ :initform '( [ "Debug target" ede-debug-target
+ (ede-buffer-belongs-to-target-p) ]
+ [ "Run target" ede-run-target
+ (ede-buffer-belongs-to-target-p) ]
+ )
:documentation "Menu specialized to this type of target."
:accessor ede-object-menu)
)
@@ -236,7 +236,7 @@ also be of a form used by TRAMP for use with scp, or rcp.")
This FTP site should be in Emacs form as needed by `ange-ftp'.
If this slot is nil, then use `ftp-site' instead.")
(configurations :initarg :configurations
- :initform ("debug" "release")
+ :initform '("debug" "release")
:type list
:custom (repeat string)
:label "Configuration Options"
@@ -258,25 +258,25 @@ and target specific elements such as build variables.")
:group (settings)
:documentation "Project local variables")
(keybindings :allocation :class
- :initform (("D" . ede-debug-target)
- ("R" . ede-run-target))
+ :initform '(("D" . ede-debug-target)
+ ("R" . ede-run-target))
:documentation "Keybindings specialized to this type of target."
:accessor ede-object-keybindings)
(menu :allocation :class
:initform
- (
- [ "Update Version" ede-update-version ede-object ]
- [ "Version Control Status" ede-vc-project-directory ede-object ]
- [ "Edit Project Homepage" ede-edit-web-page
- (and ede-object (oref (ede-toplevel) web-site-file)) ]
- [ "Browse Project URL" ede-web-browse-home
- (and ede-object
- (not (string= "" (oref (ede-toplevel) web-site-url)))) ]
- "--"
- [ "Rescan Project Files" ede-rescan-toplevel t ]
- [ "Edit Projectfile" ede-edit-file-target
- (ede-buffer-belongs-to-project-p) ]
- )
+ '(
+ [ "Update Version" ede-update-version ede-object ]
+ [ "Version Control Status" ede-vc-project-directory ede-object ]
+ [ "Edit Project Homepage" ede-edit-web-page
+ (and ede-object (oref (ede-toplevel) web-site-file)) ]
+ [ "Browse Project URL" ede-web-browse-home
+ (and ede-object
+ (not (string= "" (oref (ede-toplevel) web-site-url)))) ]
+ "--"
+ [ "Rescan Project Files" ede-rescan-toplevel t ]
+ [ "Edit Projectfile" ede-edit-file-target
+ (ede-buffer-belongs-to-project-p) ]
+ )
:documentation "Menu specialized to this type of target."
:accessor ede-object-menu)
)
@@ -288,7 +288,7 @@ All specific project types must derive from this project."
;;
(defmacro ede-with-projectfile (obj &rest forms)
"For the project in which OBJ resides, execute FORMS."
- (declare (indent 1))
+ (declare (indent 1) (debug t))
(unless (symbolp obj)
(message "Beware! ede-with-projectfile's first arg is copied: %S" obj))
`(let* ((pf (if (obj-of-class-p ,obj 'ede-target)
@@ -317,13 +317,15 @@ If set to nil, then the cache is not saved."
(defvar ede-project-cache-files nil
"List of project files EDE has seen before.")
+(defvar recentf-exclude)
+
(defun ede-save-cache ()
"Save a cache of EDE objects that Emacs has seen before."
(interactive)
(when ede-project-placeholder-cache-file
(let ((p ede-projects)
(c ede-project-cache-files)
- (recentf-exclude '( (lambda (f) t) ))
+ (recentf-exclude `( ,(lambda (_) t) ))
)
(condition-case nil
(progn
@@ -461,7 +463,7 @@ Not all buffers need headers, so return nil if no applicable."
(ede-buffer-header-file ede-object (current-buffer))
nil))
-(cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
+(cl-defmethod ede-buffer-header-file ((_this ede-project) _buffer)
"Return nil, projects don't have header files."
nil)
@@ -487,12 +489,12 @@ Some projects may have multiple documentation files, so return a list."
(ede-buffer-documentation-files ede-object (current-buffer))
nil))
-(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-project) _buffer)
"Return all documentation in project THIS based on BUFFER."
;; Find the info node.
(ede-documentation this))
-(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
+(cl-defmethod ede-buffer-documentation-files ((_this ede-target) buffer)
"Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
@@ -518,7 +520,7 @@ files in the project."
proj (cdr proj)))
found))
-(cl-defmethod ede-documentation ((this ede-target))
+(cl-defmethod ede-documentation ((_this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -529,7 +531,7 @@ files in the project."
(ede-html-documentation (ede-toplevel))
)
-(cl-defmethod ede-html-documentation ((this ede-project))
+(cl-defmethod ede-html-documentation ((_this ede-project))
"Return a list of HTML files provided by project THIS."
)
@@ -636,18 +638,7 @@ PROJECT-FILE-NAME is a name of project file (short name, like `pom.xml', etc."
(oset this directory (file-name-directory (oref this file))))
)
-
-
-;;; Hooks & Autoloads
-;;
-;; These let us watch various activities, and respond appropriately.
-
-;; (add-hook 'edebug-setup-hook
-;; (lambda ()
-;; (def-edebug-spec ede-with-projectfile
-;; (form def-body))))
-
(provide 'ede/base)
;; Local variables:
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
index 19686216cd5..98a0419e8bf 100644
--- a/lisp/cedet/ede/config.el
+++ b/lisp/cedet/ede/config.el
@@ -1,4 +1,4 @@
-;;; ede/config.el --- Configuration Handler baseclass
+;;; ede/config.el --- Configuration Handler baseclass -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
@@ -96,7 +96,7 @@ and also want to save some extra level of configuration.")
This filename excludes the directory name and is used to
initialize the :file slot of the persistent baseclass.")
(config-class
- :initform ede-extra-config
+ :initform 'ede-extra-config
:allocation :class
:type class
:documentation
@@ -171,7 +171,7 @@ the directory isn't on the `safe' list, ask to add it to the safe list."
(oset config project proj)))
config))
-(cl-defmethod ede-config-setup-configuration ((proj ede-project-with-config) config)
+(cl-defmethod ede-config-setup-configuration ((_proj ede-project-with-config) _config)
"Default configuration setup method."
nil)
@@ -187,7 +187,7 @@ the directory isn't on the `safe' list, ask to add it to the safe list."
(let ((config (ede-config-get-configuration proj t)))
(eieio-customize-object config)))
-(cl-defmethod ede-customize ((target ede-target-with-config))
+(cl-defmethod ede-customize ((_target ede-target-with-config))
"Customize the EDE TARGET by actually configuring the config object."
;; Nothing unique for the targets, use the project.
(ede-customize-project))
@@ -302,14 +302,14 @@ This class brings in method overloads for building.")
"Class to mix into a project with configuration for builds.
This class brings in method overloads for building.")
-(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional command)
+(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional _command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
(let* ((config (ede-config-get-configuration proj t))
(comp (oref config build-command)))
(compile comp)))
-(cl-defmethod project-compile-target ((obj ede-target-with-config-build) &optional command)
+(cl-defmethod project-compile-target ((_obj ede-target-with-config-build) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index 41f0c682892..652d6476f02 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -1,4 +1,4 @@
-;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root
+;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -275,7 +275,7 @@ Each directory needs a project file to control it.")
;; objects is deleted.
(cl-defmethod initialize-instance ((this ede-cpp-root-project)
- &rest fields)
+ &rest _fields)
"Make sure the :file is fully expanded."
;; Add ourselves to the master list
(cl-call-next-method)
@@ -310,7 +310,7 @@ Each directory needs a project file to control it.")
;; project, simplifying authoring new single-point projects.
(cl-defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
- dir)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -319,7 +319,7 @@ Each directory needs a project file to control it.")
;; Creating new targets on a per directory basis is a good way to keep
;; files organized. See ede-emacs for an example with multiple file
;; types.
-(cl-defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-cpp-root-project) _buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((targets (oref proj targets))
@@ -451,7 +451,7 @@ This is for project include paths and spp source files."
"Get the pre-processor map for project THIS."
(ede-preprocessor-map (ede-target-parent this)))
-(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional _command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
;; we need to be in the proj root dir for this to work
@@ -474,7 +474,7 @@ Argument COMMAND is the command to use for compiling the target."
(project-compile-project (oref obj project) command)))
-(cl-defmethod project-rescan ((this ede-cpp-root-project))
+(cl-defmethod project-rescan ((_this ede-cpp-root-project))
"Don't rescan this project from the sources."
(message "cpp-root has nothing to rescan."))
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el
index aada872cd0a..ac4f9f66846 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -1,4 +1,4 @@
-;;; ede/custom.el --- customization of EDE projects.
+;;; ede/custom.el --- customization of EDE projects. -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -53,7 +53,7 @@
(setq-local eieio-ede-old-variables ov)))
;;;###autoload
-(defalias 'customize-project 'ede-customize-project)
+(defalias 'customize-project #'ede-customize-project)
;;;###autoload
(defun ede-customize-current-target()
@@ -65,7 +65,7 @@
(ede-customize-target ede-object))
;;;###autoload
-(defalias 'customize-target 'ede-customize-current-target)
+(defalias 'customize-target #'ede-customize-current-target)
(defun ede-customize-target (obj)
"Edit fields of the current target through EIEIO & Custom.
@@ -97,13 +97,13 @@ OBJ is the target object to customize."
"Create a custom-like buffer for sorting targets of current project."
(interactive)
(let ((proj (ede-current-project))
- (count 1)
- current order)
+ ;; (count 1)
+ ) ;; current order
(switch-to-buffer (get-buffer-create "*EDE sort targets*"))
(erase-buffer)
(setq ede-object-project proj)
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(let ((targets (oref ede-object-project targets))
cur newtargets)
(while (setq cur (pop ede-project-sort-targets-order))
@@ -115,7 +115,7 @@ OBJ is the target object to customize."
" Accept ")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(kill-buffer))
" Cancel ")
(widget-insert "\n\n")
@@ -133,45 +133,45 @@ OBJ is the target object to customize."
(defun ede-project-sort-targets-list ()
"Sort the target list while using `ede-project-sort-targets'."
(save-excursion
- (let ((count 0)
- (targets (oref ede-object-project targets))
+ (let ((targets (oref ede-object-project targets))
(inhibit-read-only t)
(inhibit-modification-hooks t))
(goto-char (point-min))
(forward-line 2)
(delete-region (point) (point-max))
- (while (< count (length targets))
+ (dotimes (count (length targets))
(if (> count 0)
(widget-create 'push-button
- :notify `(lambda (&rest ignore)
- (let ((cur ede-project-sort-targets-order))
- (add-to-ordered-list
- 'ede-project-sort-targets-order
- (nth ,count cur)
- (1- ,count))
- (add-to-ordered-list
- 'ede-project-sort-targets-order
- (nth (1- ,count) cur) ,count))
- (ede-project-sort-targets-list))
+ :notify (lambda (&rest _ignore)
+ (let ((cur ede-project-sort-targets-order))
+ (add-to-ordered-list
+ 'ede-project-sort-targets-order
+ (nth count cur)
+ (1- count))
+ (add-to-ordered-list
+ 'ede-project-sort-targets-order
+ (nth (1- count) cur) count))
+ (ede-project-sort-targets-list))
" Up ")
(widget-insert " "))
(if (< count (1- (length targets)))
(widget-create 'push-button
- :notify `(lambda (&rest ignore)
- (let ((cur ede-project-sort-targets-order))
- (add-to-ordered-list
- 'ede-project-sort-targets-order
- (nth ,count cur) (1+ ,count))
- (add-to-ordered-list
- 'ede-project-sort-targets-order
- (nth (1+ ,count) cur) ,count))
- (ede-project-sort-targets-list))
+ :notify (lambda (&rest _ignore)
+ (let ((cur ede-project-sort-targets-order))
+ (add-to-ordered-list
+ 'ede-project-sort-targets-order
+ (nth count cur) (1+ count))
+ (add-to-ordered-list
+ 'ede-project-sort-targets-order
+ (nth (1+ count) cur) count))
+ (ede-project-sort-targets-list))
" Down ")
(widget-insert " "))
(widget-insert (concat " " (number-to-string (1+ count)) ".: "
(oref (nth (nth count ede-project-sort-targets-order)
- targets) name) "\n"))
- (setq count (1+ count))))))
+ targets)
+ name)
+ "\n"))))))
;;; Customization hooks
;;
@@ -195,11 +195,11 @@ OBJ is the target object to customize."
;; These two methods should be implemented by subclasses of
;; project and targets in order to account for user specified
;; changes.
-(cl-defmethod eieio-done-customizing ((target ede-target))
+(cl-defmethod eieio-done-customizing ((_target ede-target))
"Call this when a user finishes customizing TARGET."
nil)
-(cl-defmethod ede-commit-project ((proj ede-project))
+(cl-defmethod ede-commit-project ((_proj ede-project))
"Commit any change to PROJ to its file."
nil
)
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
index 027d008ea38..c933fc4515e 100644
--- a/lisp/cedet/ede/detect.el
+++ b/lisp/cedet/ede/detect.el
@@ -1,4 +1,4 @@
-;;; ede/detect.el --- EDE project detection and file associations
+;;; ede/detect.el --- EDE project detection and file associations -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index c85d4ee7924..27735176c2a 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -1,4 +1,4 @@
-;;; ede/dired.el --- EDE extensions to dired.
+;;; ede/dired.el --- EDE extensions to dired. -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2003, 2009-2021 Free Software Foundation,
;; Inc.
@@ -30,17 +30,16 @@
;;; Code:
-(require 'easymenu)
(require 'dired)
(require 'ede)
(defvar ede-dired-keymap
(let ((map (make-sparse-keymap)))
- (define-key map ".a" 'ede-dired-add-to-target)
- (define-key map ".t" 'ede-new-target)
- (define-key map ".s" 'ede-speedbar)
- (define-key map ".C" 'ede-compile-project)
- (define-key map ".d" 'ede-make-dist)
+ (define-key map ".a" #'ede-dired-add-to-target)
+ (define-key map ".t" #'ede-new-target)
+ (define-key map ".s" #'ede-speedbar)
+ (define-key map ".C" #'ede-compile-project)
+ (define-key map ".d" #'ede-make-dist)
(easy-menu-define
ede-dired-menu map "EDE Dired Minor Mode Menu"
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index 1eb4c6395a4..00496ace16f 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -1,4 +1,4 @@
-;;; ede/emacs.el --- Special project for Emacs
+;;; ede/emacs.el --- Special project for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -54,31 +54,6 @@ Return a tuple of ( EMACSNAME . VERSION )."
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
(cond
- ;; Maybe XEmacs?
- ((file-exists-p "version.sh")
- (setq emacs "XEmacs")
- (insert-file-contents "version.sh")
- (goto-char (point-min))
- (re-search-forward "emacs_major_version=\\([0-9]+\\)
-emacs_minor_version=\\([0-9]+\\)
-emacs_beta_version=\\([0-9]+\\)")
- (setq ver (concat (match-string 1) "."
- (match-string 2) "."
- (match-string 3)))
- )
- ((file-exists-p "sxemacs.pc.in")
- (setq emacs "SXEmacs")
- (insert-file-contents "sxemacs_version.m4")
- (goto-char (point-min))
- (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\])
-m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\])
-m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
- (setq ver (concat (match-string 1) "."
- (match-string 2) "."
- (match-string 3)))
- )
- ;; Insert other Emacs here...
-
;; Vaguely recent version of GNU Emacs?
((or (file-exists-p configure_ac)
(file-exists-p (setq configure_ac "configure.in")))
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index cf5396ad00e..6b7e1595646 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -1,4 +1,4 @@
-;;; ede/files.el --- Associate projects with files and directories.
+;;; ede/files.el --- Associate projects with files and directories. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -33,6 +33,7 @@
;; till no ede-project-autoload structure matches.
;;
+(require 'eieio)
(require 'ede)
(declare-function ede-locate-file-in-hash "ede/locate")
@@ -75,13 +76,13 @@ Allows for one-project-object-for-a-tree type systems."
(oref this rootproject))
(cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
- &optional file)
+ &optional _file)
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems.
Optional FILE is the file to test. It is ignored in preference
of the anchor file for the project."
- (let ((root (or (ede-project-root this) this)))
- (file-name-directory (expand-file-name (oref this file)))))
+ ;; (let ((root (or (ede-project-root this) this)))
+ (file-name-directory (expand-file-name (oref this file)))) ;; )
;; Why INODEs?
@@ -141,7 +142,7 @@ Does not check subprojects."
(defun ede-directory-get-open-project (dir &optional rootreturn)
"Return an already open project that is managing DIR.
-Optional ROOTRETURN specifies a symbol to set to the root project.
+Optional ROOTRETURN specifies a `gv-ref' to set to the root project.
If DIR is the root project, then it is the same."
(let* ((inode (ede--inode-for-dir dir))
(ft (file-name-as-directory (expand-file-name dir)))
@@ -153,7 +154,8 @@ If DIR is the root project, then it is the same."
;; Default answer is this project
(setq ans proj)
;; Save.
- (when rootreturn (set rootreturn proj))
+ (when rootreturn (if (symbolp rootreturn) (set rootreturn proj)
+ (setf (gv-deref rootreturn) proj)))
;; Find subprojects.
(when (and proj (if ede--disable-inode
(not (string= ft (expand-file-name
@@ -272,7 +274,7 @@ Do this whenever a new project is created, as opposed to loaded."
(remhash (file-name-as-directory dir) ede-project-directory-hash)
;; Look for all subdirs of D, and remove them.
(let ((match (concat "^" (regexp-quote dir))))
- (maphash (lambda (K O)
+ (maphash (lambda (K _O)
(when (string-match match K)
(remhash K ede-project-directory-hash)))
ede-project-directory-hash)))
@@ -363,7 +365,7 @@ If DIR is not part of a project, return nil."
(t nil))))
-(defalias 'ede-toplevel-project-or-nil 'ede-toplevel-project)
+(defalias 'ede-toplevel-project-or-nil #'ede-toplevel-project)
;;; DIRECTORY CONVERSION STUFF
;;
@@ -469,15 +471,15 @@ is returned."
ans))
-(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional _force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
Optional argument FORCE forces the default filename to be provided even if it
doesn't exist."
(let ((loc (ede-get-locator-object this))
- (path (ede-project-root-directory this))
- (proj (oref this subproj))
+ ;; (path (ede-project-root-directory this))
+ ;; (proj (oref this subproj))
(found nil))
;; find it Locally.
(setq found (or (ede-expand-filename-local this filename)
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index 3d1e1c5818e..4537f59ac9d 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -1,4 +1,4 @@
-;;; ede/generic.el --- Base Support for generic build systems
+;;; ede/generic.el --- Base Support for generic build systems -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -93,7 +93,7 @@
)
"User Configuration object for a generic project.")
-(defun ede-generic-load (dir &optional rootproj)
+(defun ede-generic-load (dir &optional _rootproj)
"Return a Generic Project object if there is a match.
Return nil if there isn't one.
Argument DIR is the directory it is created for.
@@ -137,7 +137,7 @@ subclasses of this base target will override the default value.")
ede-project-with-config-program
ede-project-with-config-c
ede-project-with-config-java)
- ((config-class :initform ede-generic-config)
+ ((config-class :initform 'ede-generic-config)
(config-file-basename :initform "EDEConfig.el")
(buildfile :initform ""
:type string
@@ -149,7 +149,7 @@ The class allocated value is replace by different sub classes.")
:abstract t)
(cl-defmethod initialize-instance ((this ede-generic-project)
- &rest fields)
+ &rest _fields)
"Make sure the targets slot is bound."
(cl-call-next-method)
(unless (slot-boundp this 'targets)
@@ -161,7 +161,7 @@ The class allocated value is replace by different sub classes.")
this)
(cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
- dir)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -324,7 +324,7 @@ CLASS is the EIEIO class that is used to track this project. It should subclass
)
"Generic Project for makefiles.")
-(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
+(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-makefile-project) config)
"Setup a configuration for Make."
(oset config build-command "make -k")
(oset config debug-command "gdb ")
@@ -337,7 +337,7 @@ CLASS is the EIEIO class that is used to track this project. It should subclass
)
"Generic Project for scons.")
-(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
+(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-scons-project) config)
"Setup a configuration for SCONS."
(oset config build-command "scons")
(oset config debug-command "gdb ")
@@ -350,7 +350,7 @@ CLASS is the EIEIO class that is used to track this project. It should subclass
)
"Generic Project for cmake.")
-(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
+(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-cmake-project) config)
"Setup a configuration for CMake."
(oset config build-command "cmake")
(oset config debug-command "gdb ")
@@ -361,9 +361,9 @@ CLASS is the EIEIO class that is used to track this project. It should subclass
()
"Generic project found via Version Control files.")
-(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config)
+(cl-defmethod ede-generic-setup-configuration ((_proj ede-generic-vc-project) _config)
"Setup a configuration for projects identified by revision control."
- )
+ nil)
(provide 'ede/generic)
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el
index 7a1c4c9e262..4b5530d6aca 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -1,4 +1,4 @@
-;;; ede/linux.el --- Special project for Linux
+;;; ede/linux.el --- Special project for Linux -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -47,26 +47,22 @@
(defcustom project-linux-build-directory-default 'ask
"Build directory."
:version "24.4"
- :group 'project-linux
:type '(choice (const :tag "Same as source directory" same)
(const :tag "Ask the user" ask)))
(defcustom project-linux-architecture-default 'ask
"Target architecture to assume when not auto-detected."
:version "24.4"
- :group 'project-linux
:type '(choice (string :tag "Architecture name")
(const :tag "Ask the user" ask)))
(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
"Default command used to compile a target."
- :group 'project-linux
:type 'string)
(defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s")
"Default command used to compile a project."
- :group 'project-linux
:type 'string)
(defun ede-linux-version (dir)
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index e6a89533cca..016092cd8bf 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -1,4 +1,4 @@
-;;; ede/locate.el --- Locate support
+;;; ede/locate.el --- Locate support -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -110,7 +110,7 @@ based on `ede-locate-setup-options'."
)
"Baseclass for LOCATE feature in EDE.")
-(cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields)
+(cl-defmethod initialize-instance ((loc ede-locate-base) &rest _fields)
"Make sure we have a hash table."
;; Basic setup.
(cl-call-next-method)
@@ -118,8 +118,8 @@ based on `ede-locate-setup-options'."
(ede-locate-flush-hash loc)
)
-(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base))
- root)
+(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-base))
+ _root)
"Is it ok to use this project type under ROOT."
t)
@@ -149,17 +149,15 @@ that created this EDE locate object."
(oset loc lastanswer ans)
ans))
-(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
- filesubstring
- )
+(cl-defmethod ede-locate-file-in-project-impl ((_loc ede-locate-base)
+ _filesubstring)
"Locate with LOC occurrences of FILESUBSTRING.
Searches are done under the current root of the EDE project
that created this EDE locate object."
- nil
- )
+ nil)
(cl-defmethod ede-locate-create/update-root-database
- ((loc (subclass ede-locate-base)) root)
+ ((loc (subclass ede-locate-base)) _root)
"Create or update the database for the current project.
You cannot create projects for the baseclass."
(error "Cannot create/update a database of type %S"
@@ -177,8 +175,8 @@ You cannot create projects for the baseclass."
Configure the Emacs `locate-program' variable to also
configure the use of EDE locate.")
-(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate))
- root)
+(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-locate))
+ _root)
"Is it ok to use this project type under ROOT."
(or (featurep 'locate) (locate-library "locate"))
)
@@ -198,7 +196,7 @@ that created this EDE locate object."
(with-current-buffer b
(setq default-directory cd)
(erase-buffer))
- (apply 'call-process locate-command
+ (apply #'call-process locate-command
nil b nil
searchstr nil)
(with-current-buffer b
@@ -221,7 +219,7 @@ Configure EDE's use of GNU Global through the cedet-global.el
variable `cedet-global-command'.")
(cl-defmethod initialize-instance ((loc ede-locate-global)
- &rest slots)
+ &rest _slots)
"Make sure that we can use GNU Global."
(require 'cedet-global)
;; Get ourselves initialized.
@@ -235,8 +233,8 @@ variable `cedet-global-command'.")
(oref loc root))))
)
-(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global))
- root)
+(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-global))
+ root)
"Is it ok to use this project type under ROOT."
(require 'cedet-global)
(cedet-gnu-global-version-check)
@@ -252,7 +250,7 @@ variable `cedet-global-command'.")
(cedet-gnu-global-expand-filename filesubstring)))
(cl-defmethod ede-locate-create/update-root-database
- ((loc (subclass ede-locate-global)) root)
+ ((_loc (subclass ede-locate-global)) root)
"Create or update the GNU Global database for the current project."
(cedet-gnu-global-create/update-database root))
@@ -271,7 +269,7 @@ Configure EDE's use of IDUtils through the cedet-idutils.el
file name searching variable `cedet-idutils-file-command'.")
(cl-defmethod initialize-instance ((loc ede-locate-idutils)
- &rest slots)
+ &rest _slots)
"Make sure that we can use IDUtils."
;; Get ourselves initialized.
(cl-call-next-method)
@@ -283,8 +281,8 @@ file name searching variable `cedet-idutils-file-command'.")
(oref loc root)))
)
-(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils))
- root)
+(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-idutils))
+ root)
"Is it ok to use this project type under ROOT."
(require 'cedet-idutils)
(cedet-idutils-version-check)
@@ -301,7 +299,7 @@ that created this EDE locate object."
(cedet-idutils-expand-filename filesubstring)))
(cl-defmethod ede-locate-create/update-root-database
- ((loc (subclass ede-locate-idutils)) root)
+ ((_loc (subclass ede-locate-idutils)) root)
"Create or update the GNU Global database for the current project."
(cedet-idutils-create/update-database root))
@@ -320,7 +318,7 @@ Configure EDE's use of Cscope through the cedet-cscope.el
file name searching variable `cedet-cscope-file-command'.")
(cl-defmethod initialize-instance ((loc ede-locate-cscope)
- &rest slots)
+ &rest _slots)
"Make sure that we can use Cscope."
;; Get ourselves initialized.
(cl-call-next-method)
@@ -332,8 +330,8 @@ file name searching variable `cedet-cscope-file-command'.")
(oref loc root)))
)
-(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope))
- root)
+(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-cscope))
+ root)
"Is it ok to use this project type under ROOT."
(require 'cedet-cscope)
(cedet-cscope-version-check)
@@ -350,7 +348,7 @@ that created this EDE locate object."
(cedet-cscope-expand-filename filesubstring)))
(cl-defmethod ede-locate-create/update-root-database
- ((loc (subclass ede-locate-cscope)) root)
+ ((_loc (subclass ede-locate-cscope)) root)
"Create or update the Cscope database for the current project."
(require 'cedet-cscope)
(cedet-cscope-create/update-database root))
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index 863d715e4f1..3402020fc4a 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -1,6 +1,6 @@
-;;; ede/make.el --- General information about "make"
+;;; ede/make.el --- General information about "make" -*- lexical-binding: t -*-
-;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -30,8 +30,6 @@
;;; Code:
-(declare-function inversion-check-version "inversion")
-
(defsubst ede--find-executable (exec)
"Return an expanded file name for a program EXEC on the exec path."
(declare (obsolete locate-file "28.1"))
@@ -60,8 +58,7 @@ If NOERROR is nil, then throw an error on failure. Return t otherwise."
(let ((b (get-buffer-create "*EDE Make Version*"))
(cd default-directory)
(rev nil)
- (ans nil)
- )
+ (ans nil))
(with-current-buffer b
;; Setup, and execute make.
(setq default-directory cd)
@@ -70,18 +67,18 @@ If NOERROR is nil, then throw an error on failure. Return t otherwise."
"--version")
;; Check the buffer for the string
(goto-char (point-min))
- (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,]+\\),")
+ (when (looking-at "GNU Make\\(?: version\\)? \\([0-9][^,[:space:]]+\\),?")
(setq rev (match-string 1))
- (require 'inversion)
- (setq ans (not (inversion-check-version rev nil ede-make-min-version))))
+ (setq ans (not (version< rev ede-make-min-version))))
;; Answer reporting.
(when (and (called-interactively-p 'interactive) ans)
(message "GNU Make version %s. Good enough for CEDET." rev))
(when (and (not noerror) (not ans))
- (error "EDE requires GNU Make version %s or later. Configure `ede-make-command' to fix"
- ede-make-min-version))
+ (error "EDE requires GNU Make version %s or later (found %s). Configure `ede-make-command' to fix"
+ ede-make-min-version
+ rev))
ans)))
(provide 'ede/make)
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index 43655a5d1e3..d6965945494 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -1,4 +1,4 @@
-;;; makefile-edit.el --- Makefile editing/scanning commands.
+;;; makefile-edit.el --- Makefile editing/scanning commands. -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index 5bed32ff058..c5b2ea4cb60 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -1,7 +1,6 @@
-;;; ede/pconf.el --- configure.ac maintenance for EDE
+;;; ede/pconf.el --- configure.ac maintenance for EDE -*- lexical-binding: t; -*-
-;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation,
-;;; Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project
@@ -67,7 +66,7 @@ don't do it. A value of nil means to just do it.")
;;(td (file-name-directory (ede-proj-configure-file this)))
(targs (oref this targets))
(postcmd "")
- (add-missing nil))
+ ) ;; (add-missing nil)
;; First, make sure we have a file.
(if (not (file-exists-p (ede-proj-configure-file this)))
(autoconf-new-program b (oref this name) "Project.ede"))
@@ -97,7 +96,7 @@ don't do it. A value of nil means to just do it.")
(ede-map-targets sp #'ede-proj-flush-autoconf)))
(ede-map-all-subprojects
this
- (lambda (sp)
+ (lambda (_sp)
(ede-map-targets this #'ede-proj-tweak-autoconf)))
;; Now save
(save-buffer)
@@ -109,14 +108,15 @@ don't do it. A value of nil means to just do it.")
(ede-proj-configure-test-required-file this "README")
(ede-proj-configure-test-required-file this "ChangeLog")
;; Let specific targets get missing files.
- (mapc 'ede-proj-configure-create-missing targs)
+ (mapc #'ede-proj-configure-create-missing targs)
;; Verify that we have a make system.
(if (or (not (ede-expand-filename (ede-toplevel this) "Makefile"))
;; Now is this one of our old Makefiles?
(with-current-buffer
(find-file-noselect
(ede-expand-filename (ede-toplevel this)
- "Makefile" t) t)
+ "Makefile" t)
+ t)
(goto-char (point-min))
;; Here is the unique piece for our makefiles.
(re-search-forward "For use with: make" nil t)))
@@ -166,11 +166,11 @@ don't do it. A value of nil means to just do it.")
"Tweak the configure file (current buffer) to accommodate THIS."
;; Check the compilers belonging to THIS, and call the autoconf
;; setup for those compilers.
- (mapc 'ede-proj-tweak-autoconf (ede-proj-compilers this))
- (mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this))
+ (mapc #'ede-proj-tweak-autoconf (ede-proj-compilers this))
+ (mapc #'ede-proj-tweak-autoconf (ede-proj-linkers this))
)
-(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-flush-autoconf ((_this ede-proj-target))
"Flush the configure file (current buffer) to accommodate THIS.
By flushing, remove any cruft that may be in the file. Subsequent
calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
@@ -178,13 +178,13 @@ calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
;; @TODO - No-one calls this ???
-(cl-defmethod ede-proj-configure-add-missing ((this ede-proj-target))
+(cl-defmethod ede-proj-configure-add-missing ((_this ede-proj-target))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
nil)
;; @TODO - No-one implements this yet.
-(cl-defmethod ede-proj-configure-create-missing ((this ede-proj-target))
+(cl-defmethod ede-proj-configure-create-missing ((_this ede-proj-target))
"Add any missing files for THIS by creating them."
nil)
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 4c948df4102..fd6918c4e81 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -1,4 +1,4 @@
-;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
+;;; ede-pmake.el --- EDE Generic Project Makefile code generator -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
@@ -46,6 +46,7 @@
(require 'ede/proj)
(require 'ede/proj-obj)
(require 'ede/proj-comp)
+(require 'seq)
(declare-function ede-srecode-setup "ede/srecode")
(declare-function ede-srecode-insert "ede/srecode")
@@ -111,13 +112,13 @@ MFILENAME is the makefile to generate."
(let* ((targ (if isdist (oref this targets) mt))
(sp (oref this subproj))
- (df (apply 'append
+ (df (apply #'append
(mapcar (lambda (tg)
(ede-proj-makefile-dependency-files tg))
targ))))
;; Distribution variables
(ede-compiler-begin-unique
- (mapc 'ede-proj-makefile-insert-variables targ))
+ (mapc #'ede-proj-makefile-insert-variables targ))
;; Only add the distribution stuff in when depth != 0
(let ((top (ede-toplevel this))
(tmp this)
@@ -153,7 +154,8 @@ MFILENAME is the makefile to generate."
(concat ".deps/"
(file-name-nondirectory
(file-name-sans-extension
- f)) ".P"))
+ f))
+ ".P"))
df " "))))
;;
;; Insert ALL Rule
@@ -188,11 +190,11 @@ MFILENAME is the makefile to generate."
;;
(ede-compiler-begin-unique
(ede-proj-makefile-insert-rules this)
- (mapc 'ede-proj-makefile-insert-rules targ))
+ (mapc #'ede-proj-makefile-insert-rules targ))
;;
;; phony targets for sub projects
;;
- (mapc 'ede-proj-makefile-insert-subproj-rules sp)
+ (mapc #'ede-proj-makefile-insert-subproj-rules sp)
;;
;; Distribution rules such as CLEAN and DIST
;;
@@ -210,11 +212,11 @@ MFILENAME is the makefile to generate."
;; Distribution variables
(let ((targ (if isdist (oref this targets) mt)))
(ede-compiler-begin-unique
- (mapc 'ede-proj-makefile-insert-automake-pre-variables targ))
+ (mapc #'ede-proj-makefile-insert-automake-pre-variables targ))
(ede-compiler-begin-unique
- (mapc 'ede-proj-makefile-insert-source-variables targ))
+ (mapc #'ede-proj-makefile-insert-source-variables targ))
(ede-compiler-begin-unique
- (mapc 'ede-proj-makefile-insert-automake-post-variables targ))
+ (mapc #'ede-proj-makefile-insert-automake-post-variables targ))
(ede-compiler-begin-unique
(ede-proj-makefile-insert-user-rules this))
(insert "\n# End of Makefile.am\n")
@@ -241,6 +243,7 @@ MFILENAME is the makefile to generate."
(defmacro ede-pmake-insert-variable-shared (varname &rest body)
"Add VARNAME into the current Makefile.
Execute BODY in a location where a value can be placed."
+ (declare (debug t) (indent 1))
`(let ((addcr t) (v ,varname))
(if (save-excursion
(goto-char (point-max))
@@ -258,20 +261,19 @@ Execute BODY in a location where a value can be placed."
,@body
(if addcr (insert "\n"))
(goto-char (point-max))))
-(put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1)
(defmacro ede-pmake-insert-variable-once (varname &rest body)
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
- `(let ((addcr t) (v ,varname))
- (unless
- (save-excursion
- (re-search-backward (concat "^" v "\\s-*=") nil t))
- (insert v "=")
- ,@body
- (when addcr (insert "\n"))
- (goto-char (point-max)))))
-(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1)
+ (declare (debug t) (indent 1))
+ `(let ((v ,varname))
+ (unless
+ (save-excursion
+ (re-search-backward (concat "^" v "\\s-*=") nil t))
+ (insert v "=")
+ ,@body
+ (insert "\n")
+ (goto-char (point-max)))))
;;; SOURCE VARIABLE NAME CONSTRUCTION
@@ -289,7 +291,7 @@ Change . to _ in the variable name."
;;; DEPENDENCY FILE GENERATOR LISTS
;;
-(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-dependency-files ((_this ede-proj-target))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
nil)
@@ -302,7 +304,7 @@ Argument THIS is the target to get sources from."
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables-new ((_this ede-proj-project))
"Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of
@@ -420,7 +422,7 @@ Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
- &optional moresource)
+ &optional _moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
@@ -428,11 +430,11 @@ sources variable."
(let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default)))
- (conf-done nil)
+ ;; (conf-done nil)
)
;; Add in all variables from the configuration not already covered.
(mapc (lambda (c)
- (if (member (car c) conf-done)
+ (if nil ;; (member (car c) conf-done)
nil
(insert (car c) "=" (cdr c) "\n")))
conf-table))
@@ -449,12 +451,12 @@ sources variable."
(ede-proj-makefile-insert-variables linker)))))
(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
- ((this ede-proj-target))
+ ((_this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
(cl-defmethod ede-proj-makefile-insert-automake-post-variables
- ((this ede-proj-target))
+ ((_this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
@@ -464,9 +466,9 @@ sources variable."
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
(let ((mc (ede-map-targets
- this (lambda (c) (ede-proj-makefile-garbage-patterns c))))
+ this #'ede-proj-makefile-garbage-patterns))
(uniq nil))
- (setq mc (sort (apply 'append mc) 'string<))
+ (setq mc (sort (apply #'append mc) #'string<))
;; Filter out duplicates from the targets.
(while mc
(if (and (car uniq) (string= (car uniq) (car mc)))
@@ -502,16 +504,16 @@ These are removed with make clean."
(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
"Insert rules needed by THIS target."
- (mapc 'ede-proj-makefile-insert-rules (oref this inference-rules))
+ (mapc #'ede-proj-makefile-insert-rules (oref this inference-rules))
)
(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the project that should insert stuff."
- (mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
+ (mapc #'ede-proj-makefile-insert-dist-dependencies (oref this targets))
)
-(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((_this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
nil)
@@ -530,7 +532,7 @@ Argument THIS is the target that should insert stuff."
(insert " " (ede-subproject-relative-path sproj))
))))
-(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-extradist ((_this ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
@@ -602,16 +604,16 @@ Argument THIS is the target that should insert stuff."
"\t@false\n\n"
"\n\n# End of Makefile\n")))
-(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-rules ((_this ede-proj-target))
"Insert rules needed by THIS target."
nil)
(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
"Insert rules needed by THIS target."
- (mapc 'ede-proj-makefile-insert-rules (oref this rules))
+ (mapc #'ede-proj-makefile-insert-rules (oref this rules))
(let ((c (ede-proj-compilers this)))
(when c
- (mapc 'ede-proj-makefile-insert-rules c)
+ (mapc #'ede-proj-makefile-insert-rules c)
(if (oref this phony)
(insert ".PHONY: " (ede-proj-makefile-target-name this) "\n"))
(insert (ede-proj-makefile-target-name this) ": "
@@ -622,9 +624,9 @@ Argument THIS is the target that should insert stuff."
(cl-defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
"Insert the commands needed by target THIS.
For targets, insert the commands needed by the chosen compiler."
- (mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this))
+ (mapc #'ede-proj-makefile-insert-commands (ede-proj-compilers this))
(when (object-assoc t :uselinker (ede-proj-compilers this))
- (mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this))))
+ (mapc #'ede-proj-makefile-insert-commands (ede-proj-linkers this))))
(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
@@ -632,11 +634,11 @@ For targets, insert the commands needed by the chosen compiler."
This is different from `ede-proj-makefile-insert-rules' in that this
function won't create the building rules which are auto created with
automake."
- (mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules)))
+ (mapc #'ede-proj-makefile-insert-user-rules (oref this inference-rules)))
(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
"Insert user specified rules needed by THIS target."
- (mapc 'ede-proj-makefile-insert-rules (oref this rules)))
+ (mapc #'ede-proj-makefile-insert-rules (oref this rules)))
(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
"Return a string representing the dependencies for THIS.
@@ -644,7 +646,7 @@ Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
This allows customization of how these elements appear."
(let* ((c (ede-proj-compilers this))
- (io (eval (cons 'or (mapcar 'ede-compiler-intermediate-objects-p c))))
+ (io (seq-some #'ede-compiler-intermediate-objects-p c))
(out nil))
(if io
(progn
@@ -652,7 +654,8 @@ This allows customization of how these elements appear."
(setq out
(concat out "$(" (ede-compiler-intermediate-object-variable
(car c)
- (ede-proj-makefile-target-name this)) ")")
+ (ede-proj-makefile-target-name this))
+ ")")
c (cdr c)))
out)
(let ((sv (ede-proj-makefile-sourcevar this))
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 2b1e50dcea3..9da6374d09c 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,10 +1,12 @@
-;;; ede/proj-archive.el --- EDE Generic Project archive support
+;;; ede/proj-archive.el --- EDE Generic Project archive support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2001, 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
@@ -43,7 +45,7 @@
"Linker object for creating an archive.")
(cl-defmethod ede-proj-makefile-insert-source-variables :before
- ((this ede-proj-target-makefile-archive) &optional moresource)
+ ((this ede-proj-target-makefile-archive) &optional _moresource)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
Makefile.am generator, so use it to add this important bin program."
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index f5bcebdd4cf..73259558a62 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -1,4 +1,4 @@
-;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
+;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2007, 2009-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index 26aa66873a3..0d797aa5fb9 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -1,4 +1,4 @@
-;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
+;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2021 Free Software
;; Foundation, Inc.
@@ -172,12 +172,12 @@ Adds this rule to a .PHONY list."))
This is used when creating a Makefile to prevent duplicate variables and
rules from being created.")
-(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-compiler) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(add-to-list 'ede-compiler-list this))
-(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-linker) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
@@ -185,11 +185,13 @@ rules from being created.")
(defmacro ede-compiler-begin-unique (&rest body)
"Execute BODY, making sure that `ede-current-build-list' is maintained.
This will prevent rules from creating duplicate variables or rules."
+ (declare (indent 0) (debug t))
`(let ((ede-current-build-list nil))
,@body))
(defmacro ede-compiler-only-once (object &rest body)
"Using OBJECT, execute BODY only once per Makefile generation."
+ (declare (indent 1) (debug t))
`(if (not (member ,object ede-current-build-list))
(progn
(add-to-list 'ede-current-build-list ,object)
@@ -198,25 +200,18 @@ This will prevent rules from creating duplicate variables or rules."
(defmacro ede-linker-begin-unique (&rest body)
"Execute BODY, making sure that `ede-current-build-list' is maintained.
This will prevent rules from creating duplicate variables or rules."
+ (declare (indent 0) (debug t))
`(let ((ede-current-build-list nil))
,@body))
(defmacro ede-linker-only-once (object &rest body)
"Using OBJECT, execute BODY only once per Makefile generation."
+ (declare (indent 1) (debug t))
`(if (not (member ,object ede-current-build-list))
(progn
(add-to-list 'ede-current-build-list ,object)
,@body)))
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec ede-compiler-begin-unique def-body)
- (def-edebug-spec ede-compiler-only-once (form def-body))
- (def-edebug-spec ede-linker-begin-unique def-body)
- (def-edebug-spec ede-linker-only-once (form def-body))
- (def-edebug-spec ede-pmake-insert-variable-shared (form def-body))
- ))
-
;;; Queries
(defun ede-proj-find-compiler (compilers sourcetype)
"Return a compiler from the list COMPILERS that will compile SOURCETYPE."
@@ -246,21 +241,20 @@ This will prevent rules from creating duplicate variables or rules."
)
(oref this autoconf)))
-(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-flush-autoconf ((_this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
(defmacro proj-comp-insert-variable-once (varname &rest body)
"Add VARNAME into the current Makefile if it doesn't exist.
Execute BODY in a location where a value can be placed."
- `(let ((addcr t) (v ,varname))
+ (declare (indent 1) (debug (sexp body)))
+ `(let ((v ,varname))
(unless (re-search-backward (concat "^" v "\\s-*=") nil t)
(insert v "=")
,@body
- (if addcr (insert "\n"))
- (goto-char (point-max)))
- ))
-(put 'proj-comp-insert-variable-once 'lisp-indent-function 1)
+ (insert "\n")
+ (goto-char (point-max)))))
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS."
@@ -281,8 +275,8 @@ If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
-(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
- targetname)
+(cl-defmethod ede-compiler-intermediate-object-variable ((_this ede-compiler)
+ targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ"))
@@ -314,7 +308,7 @@ Not all compilers do this."
(cl-defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
"Insert rules needed for THIS compiler object."
(ede-compiler-only-once this
- (mapc 'ede-proj-makefile-insert-rules (oref this rules))))
+ (mapc #'ede-proj-makefile-insert-rules (oref this rules))))
(cl-defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
"Insert rules needed for THIS rule object."
@@ -343,16 +337,6 @@ compiler it decides to use after inserting in the rule."
commands))
(insert "\n")))
-;;; Some details about our new macro
-;;
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec ede-compiler-begin-unique def-body)))
-(put 'ede-compiler-begin-unique 'lisp-indent-function 0)
-(put 'ede-compiler-only-once 'lisp-indent-function 1)
-(put 'ede-linker-begin-unique 'lisp-indent-function 0)
-(put 'ede-linker-only-once 'lisp-indent-function 1)
-
(provide 'ede/proj-comp)
;;; ede/proj-comp.el ends here
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index 9ec96945c10..7e0f5a89346 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -1,4 +1,4 @@
-;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support
+;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2005, 2007-2021 Free Software Foundation, Inc.
@@ -64,7 +64,7 @@ This inserts the PRELOADS target-local variable."
(when preloads
(insert (format "%s: PRELOADS=%s\n"
(oref this name)
- (mapconcat 'identity preloads " ")))))
+ (mapconcat #'identity preloads " ")))))
(insert "\n"))
(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
@@ -152,7 +152,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(utd 0))
(mapc (lambda (src)
(let* ((fsrc (expand-file-name src dir))
- (elc (concat (file-name-sans-extension fsrc) ".elc")))
+ ) ;; (elc (concat (file-name-sans-extension fsrc) ".elc"))
(with-no-warnings
(if (eq (byte-recompile-file fsrc nil 0) t)
(setq comp (1+ comp))
@@ -169,7 +169,7 @@ is found, such as a `-version' variable, or the standard header."
(if (and (slot-boundp this 'versionsource)
(oref this versionsource))
(let ((vs (oref this versionsource))
- (match nil))
+ ) ;; (match nil)
(while vs
(with-current-buffer (find-file-noselect
(ede-expand-filename this (car vs)))
@@ -177,7 +177,7 @@ is found, such as a `-version' variable, or the standard header."
(let ((case-fold-search t))
(if (re-search-forward "-version\\s-+\"\\([^\"]+\\)\"" nil t)
(progn
- (setq match t)
+ ;; (setq match t)
(delete-region (match-beginning 1)
(match-end 1))
(goto-char (match-beginning 1))
@@ -331,27 +331,27 @@ Lays claim to all .elc files that match .el files in this target."
If the `compiler' slot is empty, get the car of the compilers list."
(let ((comp (oref obj compiler)))
(if comp
- (if (listp comp)
- (setq comp (mapcar 'symbol-value comp))
- (setq comp (list (symbol-value comp))))
+ (setq comp (if (listp comp)
+ (mapcar #'symbol-value comp)
+ (list (symbol-value comp))))
;; Get the first element from our list of compilers.
- (let ((avail (mapcar 'symbol-value (oref obj availablecompilers))))
+ (let ((avail (mapcar #'symbol-value (oref obj availablecompilers))))
(setq comp (list (car avail)))))
comp))
-(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
- &optional
- moresource)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((_this ede-proj-target-elisp-autoloads)
+ &optional
+ _moresource)
"Insert the source variables needed by THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
nil)
-(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-sourcevar ((_this ede-proj-target-elisp-autoloads))
"Return the variable name for THIS's sources."
nil) ; "LOADDEFS")
-(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-dependencies ((_this ede-proj-target-elisp-autoloads))
"Return a string representing the dependencies for THIS.
Always return an empty string for an autoloads generator."
"")
@@ -361,21 +361,22 @@ Always return an empty string for an autoloads generator."
(ede-pmake-insert-variable-shared "LOADDEFS"
(insert (oref this autoload-file)))
(ede-pmake-insert-variable-shared "LOADDIRS"
- (insert (mapconcat 'identity
+ (insert (mapconcat #'identity
(or (oref this autoload-dirs) '("."))
" ")))
)
(cl-defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
"Create or update the autoload target."
- (require 'cedet-autogen)
+ (require 'cedet-autogen) ;FIXME: We don't have this file!
+ (declare-function cedet-update-autoloads "cedet-autogen")
(let ((default-directory (ede-expand-filename obj ".")))
- (apply 'cedet-update-autoloads
+ (apply #'cedet-update-autoloads
(oref obj autoload-file)
(oref obj autoload-dirs))
))
-(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
+(cl-defmethod ede-update-version-in-source ((_this ede-proj-target-elisp-autoloads) _version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
@@ -397,11 +398,11 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (oref this autoload-file))
)
-(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-elisp-autoloads))
"Tweak the configure file (current buffer) to accommodate THIS."
(error "Autoloads not supported in autoconf yet"))
-(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-flush-autoconf ((_this ede-proj-target-elisp-autoloads))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el
index 3d437016e93..dbb86edb217 100644
--- a/lisp/cedet/ede/proj-info.el
+++ b/lisp/cedet/ede/proj-info.el
@@ -1,7 +1,6 @@
-;;; ede-proj-info.el --- EDE Generic Project texinfo support
+;;; ede-proj-info.el --- EDE Generic Project texinfo support -*- lexical-binding: t; -*-
-;;; Copyright (C) 1998-2001, 2004, 2007-2021 Free Software Foundation,
-;;; Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -70,7 +69,7 @@ All other sources should be included independently."))
;;; Makefile generation
;;
(cl-defmethod ede-proj-configure-add-missing
- ((this ede-proj-target-makefile-info))
+ ((_this ede-proj-target-makefile-info))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (ede-expand-filename (ede-toplevel) "texinfo.tex")))
@@ -97,7 +96,7 @@ when working in Automake mode."
(insert menu))
;; Now insert the rest of the source elsewhere
(ede-pmake-insert-variable-shared sv
- (insert (mapconcat 'identity src " ")))
+ (insert (mapconcat #'identity src " ")))
(if moresource
(error "Texinfo files should not have moresource")))))
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index 70132aff6c3..068e998d1a1 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -1,4 +1,4 @@
-;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
+;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2001, 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index 3aa4497f932..1b96376d3eb 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -1,7 +1,6 @@
-;;; ede/proj-obj.el --- EDE Generic Project Object code generation support
+;;; ede/proj-obj.el --- EDE Generic Project Object code generation support -*- lexical-binding: t; -*-
-;;; Copyright (C) 1998-2000, 2005, 2008-2021 Free Software Foundation,
-;;; Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -35,8 +34,8 @@
;;; Code:
(defclass ede-proj-target-makefile-objectcode (ede-proj-target-makefile)
(;; Give this a new default
- (configuration-variables :initform ("debug" . (("CFLAGS" . "-g")
- ("LDFLAGS" . "-g"))))
+ (configuration-variables :initform '("debug" . (("CFLAGS" . "-g")
+ ("LDFLAGS" . "-g"))))
;; @TODO - add an include path.
(availablecompilers :initform '(ede-gcc-compiler
ede-g++-compiler
@@ -282,15 +281,15 @@ Argument THIS is the target to get sources from."
(append (oref this source) (oref this auxsource)))
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
- &optional moresource)
+ &optional _moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is not used."
(let ((ede-proj-objectcode-dodependencies
(oref (ede-target-parent this) automatic-dependencies)))
(cl-call-next-method)))
-(cl-defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
- buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-proj-target-makefile-objectcode)
+ _buffer)
"There are no default header files."
(or (cl-call-next-method)
;; Ok, nothing obvious. Try looking in ourselves.
diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el
index 3817cd7d40e..87b2ff7a551 100644
--- a/lisp/cedet/ede/proj-prog.el
+++ b/lisp/cedet/ede/proj-prog.el
@@ -1,4 +1,4 @@
-;;; ede-proj-prog.el --- EDE Generic Project program support
+;;; ede-proj-prog.el --- EDE Generic Project program support -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2001, 2005, 2008-2021 Free Software Foundation,
;; Inc.
@@ -90,11 +90,11 @@ Note: Currently only used for Automake projects."
(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
"Insert variables needed by the compiler THIS."
(cl-call-next-method)
- (let ((lf (mapconcat 'identity (oref this ldflags) " ")))
+ (let ((lf (mapconcat #'identity (oref this ldflags) " ")))
(with-slots (ldlibs) this
(if ldlibs
(setq lf
- (concat lf " -l" (mapconcat 'identity ldlibs " -l")))))
+ (concat lf " -l" (mapconcat #'identity ldlibs " -l")))))
;; LDFLAGS as needed.
(when (and lf (not (string= "" lf)))
(ede-pmake-insert-variable-once "LDDEPS" (insert lf)))))
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 51844af5361..b0e287895f3 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -1,4 +1,4 @@
-;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
+;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support -*- lexical-binding: t -*-
;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
@@ -40,7 +40,7 @@
)
"This target consists of scheme files.")
-(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
+(cl-defmethod ede-proj-tweak-autoconf ((_this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))
diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el
index 130d7b897aa..01f19bc6572 100644
--- a/lisp/cedet/ede/proj-shared.el
+++ b/lisp/cedet/ede/proj-shared.el
@@ -1,6 +1,6 @@
-;;; ede-proj-shared.el --- EDE Generic Project shared library support
+;;; ede-proj-shared.el --- EDE Generic Project shared library support -*- lexical-binding: t; -*-
-;;; Copyright (C) 1998-2000, 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -170,7 +170,7 @@ Use ldlibs to add addition libraries.")
)
(cl-defmethod ede-proj-configure-add-missing
- ((this ede-proj-target-makefile-shared-object))
+ ((_this ede-proj-target-makefile-shared-object))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (and (ede-expand-filename (ede-toplevel) "ltconfig")
@@ -185,7 +185,7 @@ Makefile.am generator, so use it to add this important bin program."
(insert (concat "lib" (ede-name this) ".la"))))
(cl-defmethod ede-proj-makefile-insert-automake-post-variables
- ((this ede-proj-target-makefile-shared-object))
+ ((_this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We need to override -program which has an LDADD element."
nil)
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 4af8b4104f5..c8c34d092f1 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -1,4 +1,4 @@
-;;; ede/proj.el --- EDE Generic Project file driver
+;;; ede/proj.el --- EDE Generic Project file driver -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2003, 2007-2021 Free Software Foundation, Inc.
@@ -220,7 +220,7 @@ This enables the creation of your target type."
((extension :initform ".ede")
(file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit")
(makefile-type :initarg :makefile-type
- :initform Makefile
+ :initform 'Makefile
:type symbol
:custom (choice (const Makefile)
;(const Makefile.in)
@@ -240,7 +240,7 @@ in targets.")
:documentation "Variables to set in this Makefile.")
(configuration-variables
:initarg :configuration-variables
- :initform ("debug" (("DEBUG" . "1")))
+ :initform '("debug" (("DEBUG" . "1")))
:type list
:custom (repeat (cons (string :tag "Configuration")
(repeat
@@ -269,10 +269,10 @@ These files can contain additional rules, variables, and customizations.")
:documentation
"Non-nil to do implement automatic dependencies in the Makefile.")
(menu :initform
- (
- [ "Regenerate Makefiles" ede-proj-regenerate t ]
- [ "Upload Distribution" ede-upload-distribution t ]
- )
+ '(
+ [ "Regenerate Makefiles" ede-proj-regenerate t ]
+ [ "Upload Distribution" ede-upload-distribution t ]
+ )
)
(metasubproject
:initarg :metasubproject
@@ -339,7 +339,7 @@ Argument PROJ is the project to save."
(cl-call-next-method)
(ede-proj-save proj))
-(cl-defmethod eieio-done-customizing ((target ede-proj-target))
+(cl-defmethod eieio-done-customizing ((_target ede-proj-target))
"Call this when a user finishes customizing this object.
Argument TARGET is the project we are completing customization on."
(cl-call-next-method)
@@ -462,7 +462,7 @@ FILE must be massaged by `ede-convert-path'."
(object-remove-from-list target 'auxsource (ede-convert-path target file))
(ede-proj-save))
-(cl-defmethod project-update-version ((this ede-proj-project))
+(cl-defmethod project-update-version ((_this ede-proj-project))
"The :version of project THIS has changed."
(ede-proj-save))
@@ -486,7 +486,7 @@ FILE must be massaged by `ede-convert-path'."
(concat (oref this name) "-" (oref this version) ".tar.gz")
))
-(cl-defmethod project-compile-project ((proj ede-proj-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-proj-project) &optional _command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
(let ((pm (ede-proj-dist-makefile proj))
@@ -499,13 +499,13 @@ Argument COMMAND is the command to use when compiling."
;;; Target type specific compilations/debug
;;
-(cl-defmethod project-compile-target ((obj ede-proj-target) &optional command)
+(cl-defmethod project-compile-target ((_obj ede-proj-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
(cl-defmethod project-compile-target ((obj ede-proj-target-makefile)
- &optional command)
+ &optional _command)
"Compile the current target program OBJ.
Optional argument COMMAND is the s the alternate command to use."
(ede-proj-setup-buildenvironment (ede-current-project))
@@ -545,11 +545,11 @@ Converts all symbols into the objects to be used."
(if comp
;; Now that we have a pre-set compilers to use, convert tye symbols
;; into objects for ease of use
- (if (listp comp)
- (setq comp (mapcar 'symbol-value comp))
- (setq comp (list (symbol-value comp))))
+ (setq comp (if (listp comp)
+ (mapcar #'symbol-value comp)
+ (list (symbol-value comp))))
(let* ((acomp (oref obj availablecompilers))
- (avail (mapcar 'symbol-value acomp))
+ (avail (mapcar #'symbol-value acomp))
(st (oref obj sourcetype))
(sources (oref obj source)))
;; COMP is not specified, so generate a list from the available
@@ -585,7 +585,7 @@ Converts all symbols into the objects to be used."
(setq link (list (symbol-value link)))
(error ":linker is not a symbol. Howd you do that?"))
(let* ((alink (oref obj availablelinkers))
- (avail (mapcar 'symbol-value alink))
+ (avail (mapcar #'symbol-value alink))
(st (oref obj sourcetype))
(sources (oref obj source)))
;; LINKER is not specified, so generate a list from the available
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 061d1b540b0..258917f01b9 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,4 +1,4 @@
-;;; project-am.el --- A project management scheme based on automake files.
+;;; project-am.el --- A project management scheme based on automake files. -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
@@ -54,17 +54,14 @@
(defcustom project-am-compile-project-command nil
"Default command used to compile a project."
- :group 'project-am
:type '(choice (const nil) string))
(defcustom project-am-compile-target-command (concat ede-make-command " -k %s")
"Default command used to compile a project."
- :group 'project-am
:type 'string)
(defcustom project-am-debug-target-function 'gdb
"Default Emacs command used to debug a target."
- :group 'project-am
:type 'function) ; make this be a list some day
(defconst project-am-type-alist
@@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
-(cl-defmethod project-new-target ((proj project-am-makefile)
- &optional name type)
+(cl-defmethod project-new-target ((_proj project-am-makefile)
+ &optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
matching something in `project-am-type-alist' or type class symbol.
@@ -300,7 +297,7 @@ buffer being in order to provide a smart default target type."
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
-(cl-defmethod project-compile-project ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-project ((_obj project-am-target) &optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
@@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(cl-defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((_obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(cl-defmethod project-compile-target ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-target ((_obj project-am-target) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
@@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the target."
;;; Project loading and saving
;;
-(defun project-am-load (directory &optional rootproj)
+(defun project-am-load (directory &optional _rootproj)
"Read an automakefile DIRECTORY into our data structure.
If a given set of projects has already been loaded, then do nothing
but return the project for the directory given.
@@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project."
(file-name-directory (directory-file-name newdir))))
(expand-file-name dir)))
+(defvar recentf-exclude)
+
(defmacro project-am-with-makefile-current (dir &rest forms)
"Set the Makefile.am in DIR to be the current buffer.
-Run FORMS while the makefile is current.
-Kill the makefile if it was not loaded before the load."
- `(let* ((fn (expand-file-name "Makefile.am" ,dir))
- (fb nil)
- (kb (get-file-buffer fn)))
- (if (not (file-exists-p fn))
- nil
- (save-excursion
- (if kb (setq fb kb)
- ;; We need to find-file this thing, but don't use
- ;; any semantic features.
- (let ((semantic-init-hook nil)
- (recentf-exclude '( (lambda (f) t) ))
- )
- (setq fb (find-file-noselect fn)))
- )
- (set-buffer fb)
- (prog1 ,@forms
- (if (not kb) (kill-buffer (current-buffer))))))))
-(put 'project-am-with-makefile-current 'lisp-indent-function 1)
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec project-am-with-makefile-current
- (form def-body))))
-
+Run FORMS while the makefile is current."
+ (declare (indent 1) (debug (form def-body)))
+ `(project-am--with-makefile-current ,dir (lambda () ,@forms)))
+
+(defun project-am--with-makefile-current (dir fun)
+ (let* ((fn (expand-file-name "Makefile.am" dir))
+ (kb (get-file-buffer fn)))
+ (if (not (file-exists-p fn))
+ nil
+ (with-current-buffer
+ (or kb
+ ;; We need to find-file this thing, but don't use
+ ;; any semantic features.
+ (let ((semantic-init-hook nil)
+ (recentf-exclude `(,(lambda (_f) t))))
+ (find-file-noselect fn)))
+ (unwind-protect (funcall fun)
+ (if (not kb) (kill-buffer (current-buffer))))))))
(defun project-am-load-makefile (path &optional suggestedname)
"Convert PATH into a project Makefile, and return its project object.
@@ -480,6 +471,7 @@ This is used when subprojects are made in named subdirectories."
(if (and ede-object (project-am-makefile-p ede-object))
ede-object
(let* ((pi (project-am-package-info path))
+ (fn buffer-file-name)
(sfn (when suggestedname
(project-am-last-dir suggestedname)))
(pn (or sfn (nth 0 pi) (project-am-last-dir fn)))
@@ -604,10 +596,8 @@ Strip out duplicates, and recurse on variables."
(project-am-expand-subdirlist
place (makefile-macro-file-list var))
;; Else, add SP in if it isn't a dup.
- (if (member sp (symbol-value place))
- nil ; don't do it twice.
- (set place (cons sp (symbol-value place))) ;; add
- ))))
+ (cl-pushnew sp (gv-deref place) :test #'equal) ;; add
+ )))
subdirs)
)
@@ -653,7 +643,7 @@ Strip out duplicates, and recurse on variables."
;; We still have a list of targets. For all buffers, make sure
;; their object still exists!
;; FIGURE THIS OUT
- (project-am-expand-subdirlist 'csubprojexpanded csubproj)
+ (project-am-expand-subdirlist (gv-ref csubprojexpanded) csubproj)
;; Ok, now let's look at all our sub-projects.
(mapc (lambda (sp)
(let* ((subdir (file-name-as-directory
@@ -734,19 +724,19 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES"))
-(cl-defmethod project-am-macro ((this project-am-header-noinst))
+(cl-defmethod project-am-macro ((_this project-am-header-noinst))
"Return the default macro to `edit' for this object."
"noinst_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-inst))
+(cl-defmethod project-am-macro ((_this project-am-header-inst))
"Return the default macro to `edit' for this object."
"include_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-pkg))
+(cl-defmethod project-am-macro ((_this project-am-header-pkg))
"Return the default macro to `edit' for this object."
"pkginclude_HEADERS")
-(cl-defmethod project-am-macro ((this project-am-header-chk))
+(cl-defmethod project-am-macro ((_this project-am-header-chk))
"Return the default macro to `edit' for this object."
"check_HEADERS")
@@ -758,7 +748,7 @@ Strip out duplicates, and recurse on variables."
"Return the default macro to `edit' for this object type."
(oref this name))
-(cl-defmethod project-am-macro ((this project-am-lisp))
+(cl-defmethod project-am-macro ((_this project-am-lisp))
"Return the default macro to `edit' for this object."
"lisp_LISP")
@@ -785,13 +775,11 @@ nil means that this buffer belongs to no-one."
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this file) efn)
- (string-match "/configure\\.ac$" efn)
- (string-match "/configure\\.in$" efn)
- (string-match "/configure$" efn)
+ (string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn)
;; Search output files.
(let ((ans nil))
(dolist (f (oref this configureoutputfiles))
- (when (string-match (concat (regexp-quote f) "$") efn)
+ (when (string-match (concat (regexp-quote f) "\\'") efn)
(setq ans t)))
ans)
)))
@@ -822,7 +810,7 @@ nil means that this buffer belongs to no-one."
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
-(cl-defmethod project-compile-target-command ((this project-am-target))
+(cl-defmethod project-compile-target-command ((_this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
@@ -861,7 +849,7 @@ Argument FILE is the file to extract the end directory name from."
(t
'project-am-program)))
-(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer)
"There are no default header files."
(or (cl-call-next-method)
(let ((s (oref this source))
@@ -910,22 +898,13 @@ files in the project."
"Set the Configure FILE in the top most directory above DIR as current.
Run FORMS in the configure file.
Kill the Configure buffer if it was not already in a buffer."
- `(save-excursion
- (let ((fb (generate-new-buffer ,file)))
- (set-buffer fb)
- (erase-buffer)
- (insert-file-contents ,file)
- (prog1 ,@forms
- (kill-buffer fb)))))
-
-(put 'project-am-with-config-current 'lisp-indent-function 1)
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec project-am-with-config-current
- (form def-body))))
-
-(defmacro project-am-extract-shell-variable (var)
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (erase-buffer)
+ (insert-file-contents ,file)
+ ,@forms))
+
+(defun project-am-extract-shell-variable (var)
"Extract the value of the shell variable VAR from a shell script."
(save-excursion
(goto-char (point-min))
@@ -997,12 +976,12 @@ Calculates the info with `project-am-extract-package-info'."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
-(cl-defmethod ede-system-include-path ((this project-am-makefile))
+(cl-defmethod ede-system-include-path ((_this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
-(cl-defmethod ede-system-include-path ((this project-am-target))
+(cl-defmethod ede-system-include-path ((_this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el
index ba36fccd0ba..371b04f9d29 100644
--- a/lisp/cedet/ede/shell.el
+++ b/lisp/cedet/ede/shell.el
@@ -1,4 +1,4 @@
-;;; ede/shell.el --- A shell controlled by EDE.
+;;; ede/shell.el --- A shell controlled by EDE. -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el
index ea6162ef94f..aaeb3f713c9 100644
--- a/lisp/cedet/ede/simple.el
+++ b/lisp/cedet/ede/simple.el
@@ -1,4 +1,4 @@
-;;; ede/simple.el --- Overlay an EDE structure on an existing project
+;;; ede/simple.el --- Overlay an EDE structure on an existing project -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -78,7 +78,7 @@ The directory has three parts:
ede-simple-save-file-name)
))
-(defun ede-simple-load (dir &optional rootproj)
+(defun ede-simple-load (dir &optional _rootproj)
"Load a project of type `Simple' for the directory DIR.
Return nil if there isn't one.
ROOTPROJ is nil, since we will only create a single EDE project here."
@@ -112,7 +112,7 @@ Each directory needs a project file to control it.")
(eieio-persistent-save proj))
(cl-defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
- dir)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el
index abdb07f2d73..5dbad4fcc00 100644
--- a/lisp/cedet/ede/source.el
+++ b/lisp/cedet/ede/source.el
@@ -1,4 +1,4 @@
-;; ede/source.el --- EDE source code object
+;; ede/source.el --- EDE source code object -*- lexical-binding: t; -*-
;; Copyright (C) 2000, 2008-2021 Free Software Foundation, Inc.
@@ -72,7 +72,7 @@ that they are willing to use.")
;;; Methods
;;
-(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest _fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(let ((lst ede-sourcecode-list))
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index 48c4a89c440..b321cb637bc 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -1,4 +1,4 @@
-;;; ede/speedbar.el --- Speedbar viewing of EDE projects
+;;; ede/speedbar.el --- Speedbar viewing of EDE projects -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2001, 2003, 2005, 2007-2021 Free Software
;; Foundation, Inc.
@@ -42,21 +42,21 @@
(setq ede-speedbar-key-map (speedbar-make-specialized-keymap))
;; General viewing things
- (define-key ede-speedbar-key-map "\C-m" 'speedbar-edit-line)
- (define-key ede-speedbar-key-map "+" 'speedbar-expand-line)
- (define-key ede-speedbar-key-map "=" 'speedbar-expand-line)
- (define-key ede-speedbar-key-map "-" 'speedbar-contract-line)
- (define-key ede-speedbar-key-map " " 'speedbar-toggle-line-expansion)
+ (define-key ede-speedbar-key-map "\C-m" #'speedbar-edit-line)
+ (define-key ede-speedbar-key-map "+" #'speedbar-expand-line)
+ (define-key ede-speedbar-key-map "=" #'speedbar-expand-line)
+ (define-key ede-speedbar-key-map "-" #'speedbar-contract-line)
+ (define-key ede-speedbar-key-map " " #'speedbar-toggle-line-expansion)
;; Some object based things
- (define-key ede-speedbar-key-map "C" 'eieio-speedbar-customize-line)
+ (define-key ede-speedbar-key-map "C" #'eieio-speedbar-customize-line)
;; Some project based things
- (define-key ede-speedbar-key-map "R" 'ede-speedbar-remove-file-from-target)
- (define-key ede-speedbar-key-map "b" 'ede-speedbar-compile-line)
- (define-key ede-speedbar-key-map "B" 'ede-speedbar-compile-project)
- (define-key ede-speedbar-key-map "D" 'ede-speedbar-make-distribution)
- (define-key ede-speedbar-key-map "E" 'ede-speedbar-edit-projectfile)
+ (define-key ede-speedbar-key-map "R" #'ede-speedbar-remove-file-from-target)
+ (define-key ede-speedbar-key-map "b" #'ede-speedbar-compile-line)
+ (define-key ede-speedbar-key-map "B" #'ede-speedbar-compile-project)
+ (define-key ede-speedbar-key-map "D" #'ede-speedbar-make-distribution)
+ (define-key ede-speedbar-key-map "E" #'ede-speedbar-edit-projectfile)
)
(defvar ede-speedbar-menu
@@ -98,7 +98,7 @@
(speedbar-get-focus)
)
-(defun ede-speedbar-toplevel-buttons (dir)
+(defun ede-speedbar-toplevel-buttons (_dir)
"Return a list of objects to display in speedbar.
Argument DIR is the directory from which to derive the list of objects."
ede-projects
@@ -180,13 +180,13 @@ Argument DIR is the directory from which to derive the list of objects."
(setq depth (1- depth)))
(speedbar-line-token))))
-(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional _depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(file-name-directory (oref obj file))
)
-(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional _depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(let ((proj (ede-target-parent obj)))
@@ -208,7 +208,7 @@ Optional DEPTH is the depth we start at."
"Provide a speedbar description for OBJ."
(ede-description obj))
-(cl-defmethod eieio-speedbar-child-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-child-description ((_obj ede-target))
"Provide a speedbar description for a plain-child of OBJ.
A plain child is a child element which is not an EIEIO object."
(or (speedbar-item-info-file-helper)
@@ -251,7 +251,7 @@ It has depth DEPTH."
;;; Generic file management for TARGETS
;;
-(defun ede-file-find (text token indent)
+(defun ede-file-find (_text token indent)
"Find the file TEXT at path TOKEN.
INDENT is the current indentation level."
(speedbar-find-file-in-frame
@@ -276,7 +276,7 @@ INDENT is the current indentation level."
Etags does not support this feature. TEXT will be the button
string. TOKEN will be the list, and INDENT is the current indentation
level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -284,13 +284,13 @@ level."
(speedbar-insert-generic-list indent token
'ede-tag-expand
'ede-tag-find))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defun ede-tag-find (text token indent)
+(defun ede-tag-find (_text token _indent)
"For the tag TEXT in a file TOKEN, goto that position.
INDENT is the current indentation level."
(let ((file (ede-find-nearest-file-line)))
@@ -314,21 +314,21 @@ INDENT is the current indentation level."
(defvar ede-speedbar-file-menu-additions
'("----"
["Create EDE Target" ede-new-target (ede-current-project) ]
- ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ]
+ ;; ["Add to project" ede-speedbar-file-add-to-project (ede-current-project) ]
["Compile project" ede-speedbar-compile-project (ede-current-project) ]
- ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ]
+ ;; ["Compile file target" ede-speedbar-compile-file-target (ede-current-project) ]
["Make distribution" ede-make-dist (ede-current-project) ]
)
"Set of menu items to splice into the speedbar menu.")
(defvar ede-speedbar-file-keymap
(let ((km (make-sparse-keymap)))
- (define-key km "a" 'ede-speedbar-file-add-to-project)
- (define-key km "t" 'ede-new-target)
- (define-key km "s" 'ede-speedbar)
- (define-key km "C" 'ede-speedbar-compile-project)
- (define-key km "c" 'ede-speedbar-compile-file-target)
- (define-key km "d" 'ede-make-dist)
+ ;; (define-key km "a" #'ede-speedbar-file-add-to-project)
+ (define-key km "t" #'ede-new-target)
+ (define-key km "s" #'ede-speedbar)
+ (define-key km "C" #'ede-speedbar-compile-project)
+ ;; (define-key km "c" #'ede-speedbar-compile-file-target)
+ (define-key km "d" #'ede-make-dist)
km)
"Keymap spliced into the speedbar keymap.")
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index 5dd0a7ec614..dd009bfb31a 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -1,4 +1,4 @@
-;;; ede/srecode.el --- EDE utilities on top of SRecoder
+;;; ede/srecode.el --- EDE utilities on top of SRecoder -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -86,7 +86,6 @@ Note: Just like `srecode-insert', but templates found in `ede' app."
(car (cdr dictionary-entries)))
(setq dictionary-entries
(cdr (cdr dictionary-entries))))
-
))
(provide 'ede/srecode)
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index d83d6d1cc69..8ef38f0d33e 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -1,4 +1,4 @@
-;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
+;;; ede-system.el --- EDE working with the system (VC, FTP, ETC) -*- lexical-binding: t -*-
;; Copyright (C) 2001-2003, 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index 80cbc211fc2..2b2402c6425 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -1,4 +1,4 @@
-;;; ede/util.el --- EDE utilities
+;;; ede/util.el --- EDE utilities -*- lexical-binding: t; -*-
;; Copyright (C) 2000, 2005, 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 63e0cef61a3..247f78ecff7 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -91,13 +91,13 @@ MODES can be a symbol or a list of symbols.
FUNCTION does not have arguments."
(or (listp modes) (setq modes (list modes)))
(mode-local-map-file-buffers
- function #'(lambda ()
- (let ((mm (mode-local-equivalent-mode-p major-mode))
- (ans nil))
- (while (and (not ans) mm)
- (setq ans (memq (car mm) modes)
- mm (cdr mm)) )
- ans))))
+ function (lambda ()
+ (let ((mm (mode-local-equivalent-mode-p major-mode))
+ (ans nil))
+ (while (and (not ans) mm)
+ (setq ans (memq (car mm) modes)
+ mm (cdr mm)) )
+ ans))))
;;; Hook machinery
;;
@@ -323,14 +323,14 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one variable."
(dolist (mode modes)
(when (setq table (get mode 'mode-local-symbol-table))
(mapatoms
- #'(lambda (var)
- (when (get var 'mode-variable-flag)
- (let ((v (intern (symbol-name var))))
- ;; Save the current buffer-local value of the
- ;; mode-local variable.
- (and (local-variable-p v (current-buffer))
- (push (cons v (symbol-value v)) old-locals))
- (set (make-local-variable v) (symbol-value var)))))
+ (lambda (var)
+ (when (get var 'mode-variable-flag)
+ (let ((v (intern (symbol-name var))))
+ ;; Save the current buffer-local value of the
+ ;; mode-local variable.
+ (and (local-variable-p v (current-buffer))
+ (push (cons v (symbol-value v)) old-locals))
+ (set (make-local-variable v) (symbol-value var)))))
table)))
old-locals)))
@@ -348,9 +348,9 @@ If MODE is not specified it defaults to current `major-mode'."
(while mode
(when (setq table (get mode 'mode-local-symbol-table))
(mapatoms
- #'(lambda (var)
- (when (get var 'mode-variable-flag)
- (kill-local-variable (intern (symbol-name var)))))
+ (lambda (var)
+ (when (get var 'mode-variable-flag)
+ (kill-local-variable (intern (symbol-name var)))))
table))
(setq mode (get-mode-local-parent mode)))))
@@ -428,7 +428,7 @@ Return the value of the last VAL."
;; Save mode bindings
(mode-local-bind (list ,@bl) '(mode-variable-flag t) ',mode)
;; Assign to local variables in all existing buffers in MODE
- (mode-local-map-mode-buffers #'(lambda () ,@sl) ',mode)
+ (mode-local-map-mode-buffers (lambda () ,@sl) ',mode)
;; Return the last value
,tmp)
)))
@@ -576,7 +576,7 @@ OVERARGS is a list of arguments passed to the override and
(put :override-with-args 'lisp-indent-function 1)
(define-obsolete-function-alias 'define-overload
- 'define-overloadable-function "27.1")
+ #'define-overloadable-function "27.1")
(define-obsolete-function-alias 'function-overload-p
#'mode-local--function-overload-p "27.1")
@@ -893,7 +893,7 @@ invoked interactively."
(interactive
(list (completing-read
"Mode: " obarray
- #'(lambda (s) (get s 'mode-local-symbol-table))
+ (lambda (s) (get s 'mode-local-symbol-table))
t (symbol-name major-mode))))
(when (setq mode (intern-soft mode))
(mode-local-describe-bindings-1 mode (called-interactively-p 'any))))
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index aef4fc89057..7928fa1bf42 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
-;;; pulse.el --- Pulsing Overlays
+;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*-
-;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.0
@@ -30,10 +30,9 @@
;;
;; The following are useful entry points:
;;
-;; `pulse' - Cause `pulse-highlight-face' to shift toward background color.
+;; `pulse-tick' - Cause `pulse-highlight-face' to shift toward background color.
;; Assumes you are using a version of Emacs that supports pulsing.
;;
-;;
;; `pulse-momentary-highlight-one-line' - Pulse a single line at POINT.
;; `pulse-momentary-highlight-region' - Pulse a region.
;; `pulse-momentary-highlight-overlay' - Pulse an overlay.
@@ -50,7 +49,9 @@
;;
;; Pulse is a part of CEDET. http://cedet.sf.net
-(defun pulse-available-p ()
+(require 'color)
+
+(defun pulse-available-p ()
"Return non-nil if pulsing is available on the current frame."
(condition-case nil
(let ((v (color-values (face-background 'default))))
@@ -90,69 +91,27 @@ Face used for temporary highlighting of tags for effect."
:group 'pulse)
;;; Code:
-;;
-(defun pulse-int-to-hex (int &optional nb-digits)
- "Convert integer argument INT to a #XXXXXXXXXXXX format hex string.
-Each X in the output string is a hexadecimal digit.
-NB-DIGITS is the number of hex digits. If INT is too large to be
-represented with NB-DIGITS, then the result is truncated from the
-left. So, for example, INT=256 and NB-DIGITS=2 returns \"00\", since
-the hex equivalent of 256 decimal is 100, which is more than 2 digits.
-
-This function was blindly copied from hexrgb.el by Drew Adams.
-https://www.emacswiki.org/emacs/hexrgb.el"
- (setq nb-digits (or nb-digits 4))
- (substring (format (concat "%0" (int-to-string nb-digits) "X") int) (- nb-digits)))
-
-(defun pulse-color-values-to-hex (values)
- "Convert list of rgb color VALUES to a hex string, #XXXXXXXXXXXX.
-Each X in the string is a hexadecimal digit.
-Input VALUES is as for the output of `x-color-values'.
-
-This function was blindly copied from hexrgb.el by Drew Adams.
-https://www.emacswiki.org/emacs/hexrgb.el"
- (concat "#"
- (pulse-int-to-hex (nth 0 values) 4) ; red
- (pulse-int-to-hex (nth 1 values) 4) ; green
- (pulse-int-to-hex (nth 2 values) 4))) ; blue
(defcustom pulse-iterations 10
"Number of iterations in a pulse operation."
:group 'pulse
:type 'number)
+
(defcustom pulse-delay .03
"Delay between face lightening iterations."
:group 'pulse
:type 'number)
-(defun pulse-lighten-highlight ()
- "Lighten the face by 1/`pulse-iterations' toward the background color.
-Return t if there is more drift to do, nil if completed."
- (if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
- nil
- (let* ((frame (color-values (face-background 'default)))
- (pulse-background (face-background
- (get 'pulse-highlight-face
- :startface)
- nil t)));; can be nil
- (when pulse-background
- (let* ((start (color-values pulse-background))
- (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
- (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
- (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
- (it (get 'pulse-highlight-face :iteration))
- )
- (set-face-background 'pulse-highlight-face
- (pulse-color-values-to-hex
- (list
- (+ (nth 0 start) (* (nth 0 frac) it))
- (+ (nth 1 start) (* (nth 1 frac) it))
- (+ (nth 2 start) (* (nth 2 frac) it)))))
- (put 'pulse-highlight-face :iteration (1+ it))
- (if (>= (1+ it) pulse-iterations)
- nil
- t)))
- )))
+;;; Convenience Functions
+;;
+(defvar pulse-momentary-overlay nil
+ "The current pulsing overlay.")
+
+(defvar pulse-momentary-timer nil
+ "The current pulsing timer.")
+
+(defvar pulse-momentary-iteration 0
+ "The current pulsing iteration.")
(defun pulse-reset-face (&optional face)
"Reset the pulse highlighting FACE."
@@ -161,20 +120,12 @@ Return t if there is more drift to do, nil if completed."
(face-background face nil t)
(face-background 'pulse-highlight-start-face)
))
- (and face
- (set-face-extend 'pulse-highlight-face
- (face-extend-p face nil t)))
+ (set-face-extend 'pulse-highlight-face
+ (face-extend-p (or face 'pulse-highlight-start-face)
+ nil t))
(put 'pulse-highlight-face :startface (or face
'pulse-highlight-start-face))
- (put 'pulse-highlight-face :iteration 0))
-
-;;; Convenience Functions
-;;
-(defvar pulse-momentary-overlay nil
- "The current pulsing overlay.")
-
-(defvar pulse-momentary-timer nil
- "The current pulsing timer.")
+ (setq pulse-momentary-iteration 0))
(defun pulse-momentary-highlight-overlay (o &optional face)
"Pulse the overlay O, unhighlighting before next command.
@@ -194,21 +145,29 @@ Optional argument FACE specifies the face to do the highlighting."
(progn
(overlay-put o 'face (or face 'pulse-highlight-start-face))
(add-hook 'pre-command-hook
- 'pulse-momentary-unhighlight))
+ #'pulse-momentary-unhighlight))
;; Pulse it.
(overlay-put o 'face 'pulse-highlight-face)
;; The pulse function puts FACE onto 'pulse-highlight-face.
;; Thus above we put our face on the overlay, but pulse
;; with a reference face needed for the color.
(pulse-reset-face face)
- (setq pulse-momentary-timer
- (run-with-timer 0 pulse-delay #'pulse-tick
- (time-add nil
- (* pulse-delay pulse-iterations)))))))
-
-(defun pulse-tick (stop-time)
+ (let* ((start (color-name-to-rgb
+ (face-background 'pulse-highlight-face nil 'default)))
+ (stop (color-name-to-rgb (face-background 'default)))
+ (colors (mapcar (apply-partially 'apply 'color-rgb-to-hex)
+ (color-gradient start stop pulse-iterations))))
+ (setq pulse-momentary-timer
+ (run-with-timer 0 pulse-delay #'pulse-tick
+ colors
+ (time-add nil
+ (* pulse-delay pulse-iterations))))))))
+
+(defun pulse-tick (colors stop-time)
(if (time-less-p nil stop-time)
- (pulse-lighten-highlight)
+ (when-let (color (elt colors pulse-momentary-iteration))
+ (set-face-background 'pulse-highlight-face color)
+ (setq pulse-momentary-iteration (1+ pulse-momentary-iteration)))
(pulse-momentary-unhighlight)))
(defun pulse-momentary-unhighlight ()
@@ -233,7 +192,7 @@ Optional argument FACE specifies the face to do the highlighting."
(cancel-timer pulse-momentary-timer))
;; Remove this hook.
- (remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))
+ (remove-hook 'pre-command-hook #'pulse-momentary-unhighlight))
;;;###autoload
(defun pulse-momentary-highlight-one-line (point &optional face)
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 44bd4b0cd82..fb443fa4a32 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -1,4 +1,4 @@
-;;; semantic.el --- Semantic buffer evaluator.
+;;; semantic.el --- Semantic buffer evaluator. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -57,6 +57,7 @@ excluded if a released version is required.
It is assumed that if the current version is newer than that specified,
everything passes. Exceptions occur when known incompatibilities are
introduced."
+ (declare (obsolete emacs-version "28.1"))
(require 'inversion)
(inversion-test 'semantic
(concat major "." minor
@@ -296,7 +297,7 @@ to use Semantic, and `semantic-init-hook' is run."
'semantic-inhibit-functions)))
;; Make sure that if this buffer is cloned, our tags and overlays
;; don't go along for the ride.
- (add-hook 'clone-indirect-buffer-hook 'semantic-clear-toplevel-cache
+ (add-hook 'clone-indirect-buffer-hook #'semantic-clear-toplevel-cache
nil t)
;; Specify that this function has done its work. At this point
;; we can consider that semantic is active in this buffer.
@@ -465,12 +466,12 @@ is requested."
;; Nuke all semantic overlays. This is faster than deleting based
;; on our data structure.
(let ((l (overlay-lists)))
- (mapc 'semantic-delete-overlay-maybe (car l))
- (mapc 'semantic-delete-overlay-maybe (cdr l))
+ (mapc #'semantic-delete-overlay-maybe (car l))
+ (mapc #'semantic-delete-overlay-maybe (cdr l))
)
(semantic-parse-tree-set-needs-rebuild)
;; Remove this hook which tracks if a buffer is up to date or not.
- (remove-hook 'after-change-functions 'semantic-change-function t)
+ (remove-hook 'after-change-functions #'semantic-change-function t)
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
semantic--buffer-cache)
@@ -486,7 +487,7 @@ is requested."
;; This is specific to the bovine parser.
(setq-local semantic-bovinate-nonterminal-check-obarray nil)
(semantic-parse-tree-set-up-to-date)
- (add-hook 'after-change-functions 'semantic-change-function nil t)
+ (add-hook 'after-change-functions #'semantic-change-function nil t)
(run-hook-with-args 'semantic-after-toplevel-cache-change-hook
semantic--buffer-cache)
(setq semantic--completion-cache nil)
@@ -677,15 +678,15 @@ This function returns semantic tags without overlays."
(if tag
(if (car tag)
(setq tag (mapcar
- #'(lambda (tag)
- ;; Set the 'reparse-symbol property to
- ;; NONTERM unless it was already setup
- ;; by a tag expander
- (or (semantic--tag-get-property
- tag 'reparse-symbol)
- (semantic--tag-put-property
- tag 'reparse-symbol nonterm))
- tag)
+ (lambda (tag)
+ ;; Set the 'reparse-symbol property to
+ ;; NONTERM unless it was already setup
+ ;; by a tag expander
+ (or (semantic--tag-get-property
+ tag 'reparse-symbol)
+ (semantic--tag-put-property
+ tag 'reparse-symbol nonterm))
+ tag)
(semantic--tag-expand tag))
result (append result tag))
;; No error in this case, a purposeful nil means don't
@@ -778,25 +779,25 @@ Throw away all the old tags, and recreate the tag database."
(defvar semantic-mode-map
(let ((map (make-sparse-keymap)))
;; Key bindings:
- ;; (define-key km "f" 'senator-search-set-tag-class-filter)
- ;; (define-key km "i" 'senator-isearch-toggle-semantic-mode)
- (define-key map "\C-c,j" 'semantic-complete-jump-local)
- (define-key map "\C-c,J" 'semantic-complete-jump)
- (define-key map "\C-c,m" 'semantic-complete-jump-local-members)
- (define-key map "\C-c,g" 'semantic-symref-symbol)
- (define-key map "\C-c,G" 'semantic-symref)
- (define-key map "\C-c,p" 'senator-previous-tag)
- (define-key map "\C-c,n" 'senator-next-tag)
- (define-key map "\C-c,u" 'senator-go-to-up-reference)
- (define-key map "\C-c, " 'semantic-complete-analyze-inline)
- (define-key map "\C-c,\C-w" 'senator-kill-tag)
- (define-key map "\C-c,\M-w" 'senator-copy-tag)
- (define-key map "\C-c,\C-y" 'senator-yank-tag)
- (define-key map "\C-c,r" 'senator-copy-tag-to-register)
- (define-key map "\C-c,," 'semantic-force-refresh)
- (define-key map [?\C-c ?, up] 'senator-transpose-tags-up)
- (define-key map [?\C-c ?, down] 'senator-transpose-tags-down)
- (define-key map "\C-c,l" 'semantic-analyze-possible-completions)
+ ;; (define-key km "f" #'senator-search-set-tag-class-filter)
+ ;; (define-key km "i" #'senator-isearch-toggle-semantic-mode)
+ (define-key map "\C-c,j" #'semantic-complete-jump-local)
+ (define-key map "\C-c,J" #'semantic-complete-jump)
+ (define-key map "\C-c,m" #'semantic-complete-jump-local-members)
+ (define-key map "\C-c,g" #'semantic-symref-symbol)
+ (define-key map "\C-c,G" #'semantic-symref)
+ (define-key map "\C-c,p" #'senator-previous-tag)
+ (define-key map "\C-c,n" #'senator-next-tag)
+ (define-key map "\C-c,u" #'senator-go-to-up-reference)
+ (define-key map "\C-c, " #'semantic-complete-analyze-inline)
+ (define-key map "\C-c,\C-w" #'senator-kill-tag)
+ (define-key map "\C-c,\M-w" #'senator-copy-tag)
+ (define-key map "\C-c,\C-y" #'senator-yank-tag)
+ (define-key map "\C-c,r" #'senator-copy-tag-to-register)
+ (define-key map "\C-c,," #'semantic-force-refresh)
+ (define-key map [?\C-c ?, up] #'senator-transpose-tags-up)
+ (define-key map [?\C-c ?, down] #'senator-transpose-tags-down)
+ (define-key map "\C-c,l" #'semantic-analyze-possible-completions)
;; This hack avoids showing the CEDET menu twice if ede-minor-mode
;; and Semantic are both enabled. Is there a better way?
(define-key map [menu-bar cedet-menu]
@@ -1028,7 +1029,7 @@ Semantic mode.
(file-exists-p semanticdb-default-system-save-directory))
(require 'semantic/db-ebrowse)
(semanticdb-load-ebrowse-caches)))
- (add-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
+ (add-hook 'mode-local-init-hook #'semantic-new-buffer-fcn)
;; Add semantic-ia-complete-symbol to
;; completion-at-point-functions, so that it is run from
;; M-TAB.
@@ -1036,11 +1037,11 @@ Semantic mode.
;; Note: The first entry added is the last entry run, so the
;; most specific entry should be last.
(add-hook 'completion-at-point-functions
- 'semantic-analyze-nolongprefix-completion-at-point-function)
+ #'semantic-analyze-nolongprefix-completion-at-point-function)
(add-hook 'completion-at-point-functions
- 'semantic-analyze-notc-completion-at-point-function)
+ #'semantic-analyze-notc-completion-at-point-function)
(add-hook 'completion-at-point-functions
- 'semantic-analyze-completion-at-point-function)
+ #'semantic-analyze-completion-at-point-function)
(if (bound-and-true-p global-ede-mode)
(define-key cedet-menu-map [cedet-menu-separator] '("--")))
@@ -1051,21 +1052,21 @@ Semantic mode.
;; introduced in the buffer is pretty much futile, but we have to
;; clean the hooks and delete Semantic-related overlays, so that
;; Semantic can be re-activated cleanly.
- (remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
+ (remove-hook 'mode-local-init-hook #'semantic-new-buffer-fcn)
(remove-hook 'completion-at-point-functions
- 'semantic-analyze-completion-at-point-function)
+ #'semantic-analyze-completion-at-point-function)
(remove-hook 'completion-at-point-functions
- 'semantic-analyze-notc-completion-at-point-function)
+ #'semantic-analyze-notc-completion-at-point-function)
(remove-hook 'completion-at-point-functions
- 'semantic-analyze-nolongprefix-completion-at-point-function)
+ #'semantic-analyze-nolongprefix-completion-at-point-function)
(remove-hook 'after-change-functions
- 'semantic-change-function)
+ #'semantic-change-function)
(define-key cedet-menu-map [cedet-menu-separator] nil)
(define-key cedet-menu-map [semantic-options-separator] nil)
;; FIXME: handle semanticdb-load-ebrowse-caches
(dolist (mode semantic-submode-list)
- (if (and (boundp mode) (eval mode))
+ (if (and (boundp mode) (symbol-value mode))
(funcall mode -1)))
;; Unlink buffer and clear cache
(semantic--tag-unlink-cache-from-buffer)
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index c0a054dafc3..1a4be11c789 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -1,4 +1,4 @@
-;;; semantic/analyze.el --- Analyze semantic tags against local context
+;;; semantic/analyze.el --- Analyze semantic tags against local context -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
@@ -167,7 +167,7 @@ of the parent function.")
;; Simple methods against the context classes.
;;
(cl-defmethod semantic-analyze-type-constraint
- ((context semantic-analyze-context) &optional desired-type)
+ ((_context semantic-analyze-context) &optional desired-type)
"Return a type constraint for completing :prefix in CONTEXT.
Optional argument DESIRED-TYPE may be a non-type tag to analyze."
(when (semantic-tag-p desired-type)
@@ -344,8 +344,8 @@ This function knows of flags:
(setq tagtype (cons tmptype tagtype))
(when miniscope
(let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members tagtype))))
+ (apply #'append
+ (mapcar #'semantic-tag-type-members tagtype))))
(oset miniscope fullscope rawscope)))
)
(setq s (cdr s)))
@@ -437,6 +437,8 @@ to provide a large number of non-cached analysis for filtering symbols."
(:override)))
)
+(defvar semantic--prefixtypes)
+
(defun semantic-analyze-current-symbol-default (analyzehookfcn position)
"Call ANALYZEHOOKFCN on the analyzed symbol at POSITION."
(let* ((semantic-analyze-error-stack nil)
@@ -453,14 +455,14 @@ to provide a large number of non-cached analysis for filtering symbols."
(catch 'unfindable
;; If debug on error is on, allow debugging in this fcn.
(setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes 'unfindable)))
+ prefix scope 'semantic--prefixtypes 'unfindable)))
;; Debug on error is off. Capture errors and move on
(condition-case err
;; NOTE: This line is duplicated in
;; semantic-analyzer-debug-global-symbol
;; You will need to update both places.
(setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes))
+ prefix scope 'semantic--prefixtypes))
(error (semantic-analyze-push-error err))))
;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart nil))
@@ -531,7 +533,7 @@ Returns an object based on symbol `semantic-analyze-context'."
(bounds (nth 2 prefixandbounds))
;; @todo - vv too early to really know this answer! vv
(prefixclass (semantic-ctxt-current-class-list))
- (prefixtypes nil)
+ (semantic--prefixtypes nil)
(scope (semantic-calculate-scope position))
(function nil)
(fntag nil)
@@ -611,13 +613,13 @@ Returns an object based on symbol `semantic-analyze-context'."
(if debug-on-error
(catch 'unfindable
(setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes 'unfindable))
+ prefix scope 'semantic--prefixtypes 'unfindable))
;; If there's an alias, dereference it and analyze
;; sequence again.
(when (setq newseq
(semantic-analyze-dereference-alias prefix))
(setq prefix (semantic-analyze-find-tag-sequence
- newseq scope 'prefixtypes 'unfindable))))
+ newseq scope 'semantic--prefixtypes 'unfindable))))
;; Debug on error is off. Capture errors and move on
(condition-case err
;; NOTE: This line is duplicated in
@@ -625,11 +627,11 @@ Returns an object based on symbol `semantic-analyze-context'."
;; You will need to update both places.
(progn
(setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes))
+ prefix scope 'semantic--prefixtypes))
(when (setq newseq
(semantic-analyze-dereference-alias prefix))
(setq prefix (semantic-analyze-find-tag-sequence
- newseq scope 'prefixtypes))))
+ newseq scope 'semantic--prefixtypes))))
(error (semantic-analyze-push-error err))))
)
@@ -650,7 +652,7 @@ Returns an object based on symbol `semantic-analyze-context'."
:prefix prefix
:prefixclass prefixclass
:bounds bounds
- :prefixtypes prefixtypes
+ :prefixtypes semantic--prefixtypes
:errors semantic-analyze-error-stack)))
;; No function, try assignment
@@ -670,7 +672,7 @@ Returns an object based on symbol `semantic-analyze-context'."
:bounds bounds
:prefix prefix
:prefixclass prefixclass
- :prefixtypes prefixtypes
+ :prefixtypes semantic--prefixtypes
:errors semantic-analyze-error-stack)))
;; TODO: Identify return value condition.
@@ -686,7 +688,7 @@ Returns an object based on symbol `semantic-analyze-context'."
:bounds bounds
:prefix prefix
:prefixclass prefixclass
- :prefixtypes prefixtypes
+ :prefixtypes semantic--prefixtypes
:errors semantic-analyze-error-stack)))
(t (setq context-return nil))
@@ -750,7 +752,7 @@ Some useful functions are found in `semantic-format-tag-functions'."
:group 'semantic
:type semantic-format-tag-custom-list)
-(defun semantic-analyze-princ-sequence (sequence &optional prefix buff)
+(defun semantic-analyze-princ-sequence (sequence &optional prefix _buff)
"Send the tag SEQUENCE to standard out.
Use PREFIX as a label.
Use BUFF as a source of override methods."
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index e8139ab1aea..ccf405d62e2 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -1,4 +1,4 @@
-;;; semantic/analyze/complete.el --- Smart Completions
+;;; semantic/analyze/complete.el --- Smart Completions -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -45,7 +45,7 @@
"For the tag TYPE, return any constant symbols of TYPE.
Used as options when completing.")
-(defun semantic-analyze-type-constants-default (type)
+(defun semantic-analyze-type-constants-default (_type)
"Do nothing with TYPE."
nil)
@@ -54,7 +54,7 @@ Used as options when completing.")
(let ((origc tags))
;; Accept only tags that are of the datatype specified by
;; the desired classes.
- (setq tags (apply 'nconc ;; All input lists are permutable.
+ (setq tags (apply #'nconc ;; All input lists are permutable.
(mapcar (lambda (class)
(semantic-find-tags-by-class class origc))
classlist)))
@@ -109,6 +109,8 @@ in a buffer."
(when (called-interactively-p 'any)
(error "Buffer was not parsed by Semantic."))))
+(defvar semantic--prefixtypes)
+
(defun semantic-analyze-possible-completions-default (context &optional flags)
"Default method for producing smart completions.
Argument CONTEXT is an object specifying the locally derived context.
@@ -121,14 +123,14 @@ FLAGS can be any number of:
(desired-type (semantic-analyze-type-constraint a))
(desired-class (oref a prefixclass))
(prefix (oref a prefix))
- (prefixtypes (oref a prefixtypes))
+ (semantic--prefixtypes (oref a prefixtypes))
(completetext nil)
(completetexttype nil)
(scope (oref a scope))
(localvar (when scope (oref scope localvar)))
(origc nil)
(c nil)
- (any nil)
+ ;; (any nil)
(do-typeconstraint (not (memq 'no-tc flags)))
(do-longprefix (not (memq 'no-longprefix flags)))
(do-unique (not (memq 'no-unique flags)))
@@ -138,7 +140,7 @@ FLAGS can be any number of:
;; If we are not doing the long prefix, shorten all the key
;; elements.
(setq prefix (list (car (reverse prefix)))
- prefixtypes nil))
+ semantic--prefixtypes nil))
;; Calculate what our prefix string is so that we can
;; find all our matching text.
@@ -155,7 +157,7 @@ FLAGS can be any number of:
;; The prefixtypes should always be at least 1 less than
;; the prefix since the type is never looked up for the last
;; item when calculating a sequence.
- (setq completetexttype (car (reverse prefixtypes)))
+ (setq completetexttype (car (reverse semantic--prefixtypes)))
(when (or (not completetexttype)
(not (and (semantic-tag-p completetexttype)
(eq (semantic-tag-class completetexttype) 'type))))
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index 4947368757e..69b3b9c8328 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -1,6 +1,6 @@
-;;; semantic/analyze/debug.el --- Debug the analyzer
+;;; semantic/analyze/debug.el --- Debug the analyzer -*- lexical-binding: t; -*-
-;;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -109,11 +109,11 @@ Argument COMP are possible completions here."
(condition-case err
(with-current-buffer origbuf
(let* ((position (or (cdr-safe (oref ctxt bounds)) (point)))
- (prefixtypes nil) ; Used as type return
+ ;; (semantic--prefixtypes nil) ; Used as type return
(scope (semantic-calculate-scope position))
)
(semantic-analyze-find-tag-sequence
- (list prefix "") scope 'prefixtypes)
+ (list prefix "") scope) ;; 'semantic--prefixtypes
)
)
(error (setq finderr err)))
@@ -149,7 +149,7 @@ path was setup incorrectly.\n")
(semantic-analyzer-debug-add-buttons)
))
-(defun semantic-analyzer-debug-missing-datatype (ctxt idx comp)
+(defun semantic-analyzer-debug-missing-datatype (ctxt idx _comp)
"Debug why we can't find a datatype entry for CTXT prefix at IDX.
Argument COMP are possible completions here."
(let* ((prefixitem (nth idx (oref ctxt prefix)))
@@ -593,19 +593,20 @@ Look for key expressions, and add push-buttons near them."
(setq-local semantic-analyzer-debug-orig orig-buffer)
;; First, add do-in buttons to recommendations.
(while (re-search-forward "^\\s-*M-x \\(\\(\\w\\|\\s_\\)+\\) " nil t)
- (let ((fcn (match-string 1)))
- (when (not (fboundp (intern-soft fcn)))
+ (let* ((fcn (match-string 1))
+ (fsym (intern-soft fcn)))
+ (when (not (fboundp fsym))
(error "Help Err: Can't find %s" fcn))
(end-of-line)
(insert " ")
(insert-button "[ Do It ]"
'mouse-face 'custom-button-pressed-face
'do-fcn fcn
- 'action `(lambda (arg)
- (let ((M semantic-analyzer-debug-orig))
- (set-buffer (marker-buffer M))
- (goto-char M))
- (call-interactively (quote ,(intern-soft fcn))))))))
+ 'action (lambda (_arg)
+ (let ((M semantic-analyzer-debug-orig))
+ (set-buffer (marker-buffer M))
+ (goto-char M))
+ (call-interactively fsym))))))
;; Do something else?
;; Clean up the mess
(set-buffer-modified-p nil))))
diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el
index 10d11c33ebb..d47e8976e58 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -1,4 +1,4 @@
-;;; semantic/analyze/fcn.el --- Analyzer support functions.
+;;; semantic/analyze/fcn.el --- Analyzer support functions. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -55,7 +55,7 @@ Return the string representing the compound name.")
(defun semantic-analyze-unsplit-name-default (namelist)
"Concatenate the names in NAMELIST with a . between."
- (mapconcat 'identity namelist "."))
+ (mapconcat #'identity namelist "."))
;;; SELECTING
;;
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index a39ff6f6736..31cbb9e1173 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -1,4 +1,4 @@
-;;; semantic/analyze/refs.el --- Analysis of the references between tags.
+;;; semantic/analyze/refs.el --- Analysis of the references between tags. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -296,7 +296,7 @@ Only works for tags in the global namespace."
(let* ((classmatch (semantic-tag-class tag))
(RES
(semanticdb-find-tags-collector
- (lambda (table tags)
+ (lambda (_table tags)
(semantic-find-tags-by-class classmatch tags)
;; @todo - Add parent check also.
)
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index 3bc0e4dd618..6be6dfd8dfd 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine.el --- LL Parser/Analyzer core.
+;;; semantic/bovine.el --- LL Parser/Analyzer core -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2004, 2006-2007, 2009-2021 Free Software
;; Foundation, Inc.
@@ -41,7 +41,7 @@
;;; Variables
;;
-(defvar-local semantic-bovinate-nonterminal-check-obarray nil
+(defvar-local semantic-bovinate-nonterminal-check-map nil
"Obarray of streams already parsed for nonterminal symbols.
Use this to detect infinite recursion during a parse.")
@@ -54,6 +54,7 @@ Use this to detect infinite recursion during a parse.")
"Create a lambda expression to return a list including RETURN-VAL.
The return list is a lambda expression to be used in a bovine table."
`(lambda (vals start end)
+ (ignore vals)
(append ,@return-val (list start end))))
;;; Semantic Bovination
@@ -78,21 +79,18 @@ environment of `semantic-bovinate-stream'."
(defun semantic-bovinate-nonterminal-check (stream nonterminal)
"Check if STREAM not already parsed for NONTERMINAL.
If so abort because an infinite recursive parse is suspected."
- (or (vectorp semantic-bovinate-nonterminal-check-obarray)
- (setq semantic-bovinate-nonterminal-check-obarray
- (make-vector 13 nil)))
- (let* ((nt (symbol-name nonterminal))
- (vs (symbol-value
- (intern-soft
- nt semantic-bovinate-nonterminal-check-obarray))))
+ (or (hash-table-p semantic-bovinate-nonterminal-check-map)
+ (setq semantic-bovinate-nonterminal-check-map
+ (make-hash-table :test #'eq)))
+ (let* ((vs (gethash nonterminal semantic-bovinate-nonterminal-check-map)))
(if (memq stream vs)
;; Always enter debugger to see the backtrace
(let ((debug-on-signal t)
(debug-on-error t))
- (setq semantic-bovinate-nonterminal-check-obarray nil)
- (error "Infinite recursive parse suspected on %s" nt))
- (set (intern nt semantic-bovinate-nonterminal-check-obarray)
- (cons stream vs)))))
+ (setq semantic-bovinate-nonterminal-check-map nil)
+ (error "Infinite recursive parse suspected on %s" nonterminal))
+ (push stream
+ (gethash nonterminal semantic-bovinate-nonterminal-check-map)))))
;;;###autoload
(defun semantic-bovinate-stream (stream &optional nonterminal)
@@ -109,6 +107,9 @@ list of semantic tokens found."
(or semantic--buffer-cache
(semantic-bovinate-nonterminal-check stream nonterminal))
+ ;; FIXME: `semantic-parse-region-c-mode' inspects `lse' to try and
+ ;; detect a recursive call (used with macroexpansion, to avoid inf-loops).
+ (with-suppressed-warnings ((lexical lse)) (defvar lse))
(let* ((table semantic--parse-table)
(matchlist (cdr (assq nonterminal table)))
(starting-stream stream)
@@ -215,7 +216,8 @@ list of semantic tokens found."
(setq cvl (cons
(if (memq (semantic-lex-token-class lse)
'(comment semantic-list))
- valdot val) cvl))) ;append unchecked value.
+ valdot val)
+ cvl))) ;append unchecked value.
(setq end (semantic-lex-token-end lse))
)
(setq lte nil cvl nil)) ;No more matches, exit
@@ -283,7 +285,7 @@ list of semantic tokens found."
;; Make it the default parser
;;;###autoload
-(defalias 'semantic-parse-stream-default 'semantic-bovinate-stream)
+(defalias 'semantic-parse-stream-default #'semantic-bovinate-stream)
(provide 'semantic/bovine)
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index fb551397381..e7ecb61513f 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/c.el --- Semantic details for C
+;;; semantic/bovine/c.el --- Semantic details for C -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -114,7 +114,8 @@ part of the preprocessor map.")
"Reset the C preprocessor symbol map based on all input variables."
(when (and semantic-mode
(featurep 'semantic/bovine/c))
- (remove-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map)
+ (remove-hook 'mode-local-init-hook
+ #'semantic-c-reset-preprocessor-symbol-map)
;; Initialize semantic-lex-spp-macro-symbol-obarray with symbols.
(setq-mode-local c-mode
semantic-lex-spp-macro-symbol-obarray
@@ -154,7 +155,7 @@ part of the preprocessor map.")
;; Make sure the preprocessor symbols are set up when mode-local kicks
;; in.
-(add-hook 'mode-local-init-hook 'semantic-c-reset-preprocessor-symbol-map)
+(add-hook 'mode-local-init-hook #'semantic-c-reset-preprocessor-symbol-map)
(defcustom semantic-lex-c-preprocessor-symbol-map nil
"Table of C Preprocessor keywords used by the Semantic C lexer.
@@ -237,8 +238,8 @@ Return the defined symbol as a special spp lex token."
(skip-chars-forward " \t")
(if (eolp)
nil
- (let* ((name (buffer-substring-no-properties
- (match-beginning 1) (match-end 1)))
+ (let* (;; (name (buffer-substring-no-properties
+ ;; (match-beginning 1) (match-end 1)))
(beginning-of-define (match-end 1))
(with-args (save-excursion
(goto-char (match-end 0))
@@ -488,7 +489,7 @@ code to parse."
(error nil))))
(let ((eval-form (condition-case err
- (eval parsedtokelist)
+ (eval parsedtokelist t)
(error
(semantic-push-parser-warning
(format "Hideif forms produced an error. Assuming false.\n%S" err)
@@ -499,11 +500,11 @@ code to parse."
(equal eval-form 0)));; ifdef line resulted in false
;; The if indicates to skip this preprocessor section
- (let ((pt nil))
+ (let () ;; (pt nil)
(semantic-push-parser-warning (format "Skip %s" (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
(point-at-bol) (point-at-eol))
(beginning-of-line)
- (setq pt (point))
+ ;; (setq pt (point))
;; This skips only a section of a conditional. Once that section
;; is opened, encountering any new #else or related conditional
;; should be skipped.
@@ -818,7 +819,9 @@ MACRO expansion mode is handled through the nature of Emacs's non-lexical
binding of variables.
START, END, NONTERMINAL, DEPTH, and RETURNONERRORS are the same
as for the parent."
- (if (and (boundp 'lse) (or (/= start 1) (/= end (point-max))))
+ ;; FIXME: We shouldn't depend on the internals of `semantic-bovinate-stream'.
+ (with-suppressed-warnings ((lexical lse)) (defvar lse))
+ (if (and (boundp 'lse) (or (/= start (point-min)) (/= end (point-max))))
(let* ((last-lexical-token lse)
(llt-class (semantic-lex-token-class last-lexical-token))
(llt-fakebits (car (cdr last-lexical-token)))
@@ -926,7 +929,7 @@ the regular parser."
(semantic-lex-init)
(semantic-clear-toplevel-cache)
(remove-hook 'semantic-lex-reset-functions
- 'semantic-lex-spp-reset-hook t)
+ #'semantic-lex-spp-reset-hook t)
)
;; Get the macro symbol table right.
(setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms)
@@ -970,7 +973,7 @@ the regular parser."
;; Notify about the debug
(setq semantic-c-debug-mode-init-last-mode mm)
- (add-hook 'post-command-hook 'semantic-c-debug-mode-init-pch)))
+ (add-hook 'post-command-hook #'semantic-c-debug-mode-init-pch)))
(defun semantic-c-debug-mode-init-pch ()
"Notify user about needing to debug their major mode hooks."
@@ -987,7 +990,7 @@ M-x semantic-c-debug-mode-init
now.
")
- (remove-hook 'post-command-hook 'semantic-c-debug-mode-init-pch)))
+ (remove-hook 'post-command-hook #'semantic-c-debug-mode-init-pch)))
(defun semantic-expand-c-tag (tag)
"Expand TAG into a list of equivalent tags, or nil."
@@ -1228,7 +1231,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
(when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list 'semantic-tag-p tag)))
(let ((allhits nil)
(scope nil)
- (refs nil))
+ ) ;; (refs nil)
(save-excursion
(semantic-go-to-tag tag db)
(setq scope (semantic-calculate-scope))
@@ -1250,11 +1253,12 @@ Use `semantic-analyze-current-tag' to debug this fcn."
(reverse newparents)))
(setq allhits (semantic--analyze-refs-full-lookup tag scope t)))
- (setq refs (semantic-analyze-references (semantic-tag-name tag)
- :tag tag
- :tagdb db
- :scope scope
- :rawsearchdata allhits)))))
+ ;; (setq refs
+ (semantic-analyze-references (semantic-tag-name tag)
+ :tag tag
+ :tagdb db
+ :scope scope
+ :rawsearchdata allhits)))) ;;)
(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
"Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
@@ -1540,9 +1544,9 @@ This might be a string, or a list of tokens."
((semantic-tag-p templatespec)
(semantic-format-tag-abbreviate templatespec))
((listp templatespec)
- (mapconcat 'semantic-format-tag-abbreviate templatespec ", "))))
+ (mapconcat #'semantic-format-tag-abbreviate templatespec ", "))))
-(defun semantic-c-template-string (token &optional parent color)
+(defun semantic-c-template-string (token &optional parent _color)
"Return a string representing the TEMPLATE attribute of TOKEN.
This string is prefixed with a space, or is the empty string.
Argument PARENT specifies a parent type.
@@ -1550,8 +1554,8 @@ Argument COLOR specifies that the string should be colorized."
(let ((t2 (semantic-c-tag-template-specifier token))
(t1 (semantic-c-tag-template token))
;; @todo - Need to account for a parent that is a template
- (pt1 (if parent (semantic-c-tag-template parent)))
- (pt2 (if parent (semantic-c-tag-template-specifier parent)))
+ (_pt1 (if parent (semantic-c-tag-template parent)))
+ (_pt2 (if parent (semantic-c-tag-template-specifier parent)))
)
(cond (t2 ;; we have a template with specifier
(concat " <"
@@ -1610,7 +1614,7 @@ handled. A class is abstract only if its destructor is virtual."
(member "virtual" (semantic-tag-modifiers tag))))
(t (semantic-tag-abstract-p-default tag parent))))
-(defun semantic-c-dereference-typedef (type scope &optional type-declaration)
+(defun semantic-c-dereference-typedef (type _scope &optional type-declaration)
"If TYPE is a typedef, get TYPE's type by name or tag, and return.
SCOPE is not used, and TYPE-DECLARATION is used only if TYPE is not a typedef."
(if (and (eq (semantic-tag-class type) 'type)
@@ -1655,7 +1659,7 @@ return `ref<Foo,Bar>'."
(concat (semantic-tag-name type)
"<" (semantic-c--template-name-1 (cdr spec-list)) ">"))
-(defun semantic-c-dereference-template (type scope &optional type-declaration)
+(defun semantic-c-dereference-template (type _scope &optional type-declaration)
"Dereference any template specifiers in TYPE within SCOPE.
If TYPE is a template, return a TYPE copy with the templates types
instantiated as specified in TYPE-DECLARATION."
@@ -1677,7 +1681,7 @@ instantiated as specified in TYPE-DECLARATION."
(list type type-declaration))
;;; Patch here by "Raf" for instantiating templates.
-(defun semantic-c-dereference-member-of (type scope &optional type-declaration)
+(defun semantic-c-dereference-member-of (type _scope &optional type-declaration)
"Dereference through the `->' operator of TYPE.
Uses the return type of the `->' operator if it is contained in TYPE.
SCOPE is the current local scope to perform searches in.
@@ -1700,7 +1704,7 @@ Such an alias can be created through `using' statements in a
namespace declaration. This function checks the namespaces in
SCOPE for such statements."
(let ((scopetypes (oref scope scopetypes))
- typename currentns tmp usingname result namespaces)
+ typename currentns result namespaces) ;; usingname tmp
(when (and (semantic-tag-p type-declaration)
(or (null type) (semantic-tag-prototype-p type)))
(setq typename (semantic-analyze-split-name (semantic-tag-name type-declaration)))
@@ -1739,11 +1743,11 @@ with a fully qualified name in the original namespace. Returns
nil if NAMESPACE is not an alias."
(when (eq (semantic-tag-get-attribute namespace :kind) 'alias)
(let ((typename (semantic-analyze-split-name (semantic-tag-name type)))
- ns nstype originaltype newtype)
+ ns nstype originaltype) ;; newtype
;; Make typename unqualified
- (if (listp typename)
- (setq typename (last typename))
- (setq typename (list typename)))
+ (setq typename (if (listp typename)
+ (last typename)
+ (list typename)))
(when
(and
;; Get original namespace and make sure TYPE exists there.
@@ -1755,13 +1759,13 @@ nil if NAMESPACE is not an alias."
(semantic-tag-get-attribute nstype :members))))
;; Construct new type with name in original namespace.
(setq ns (semantic-analyze-split-name ns))
- (setq newtype
- (semantic-tag-clone
- (car originaltype)
- (semantic-analyze-unsplit-name
- (if (listp ns)
- (append ns typename)
- (append (list ns) typename)))))))))
+ ;; (setq newtype
+ (semantic-tag-clone
+ (car originaltype)
+ (semantic-analyze-unsplit-name
+ (if (listp ns)
+ (append ns typename)
+ (append (list ns) typename)))))))) ;; )
;; This searches a type in a namespace, following through all using
;; statements.
@@ -1769,7 +1773,7 @@ nil if NAMESPACE is not an alias."
"Check if TYPE is accessible in NAMESPACE through a using statement.
Returns the original type from the namespace where it is defined,
or nil if it cannot be found."
- (let (usings result usingname usingtype unqualifiedname members shortname tmp)
+ (let (usings result usingname usingtype unqualifiedname members) ;; shortname tmp
;; Get all using statements from NAMESPACE.
(when (and (setq usings (semantic-tag-get-attribute namespace :members))
(setq usings (semantic-find-tags-by-class 'using usings)))
@@ -1842,7 +1846,7 @@ These are constants which are of type TYPE."
(define-mode-local-override semantic-analyze-unsplit-name c-mode (namelist)
"Assemble the list of names NAMELIST into a namespace name."
- (mapconcat 'identity namelist "::"))
+ (mapconcat #'identity namelist "::"))
(define-mode-local-override semantic-ctxt-scoped-types c++-mode (&optional point)
"Return a list of tags of CLASS type based on POINT.
@@ -1885,7 +1889,7 @@ DO NOT return the list of tags encompassing point."
(semantic-get-local-variables))))
(setq tagreturn
(append tagreturn
- (mapcar 'semantic-tag-type tmp))))))
+ (mapcar #'semantic-tag-type tmp))))))
;; Return the stuff
tagreturn))
@@ -1943,7 +1947,7 @@ namespace, since this means all tags inside this include will
have to be wrapped in that namespace."
(let ((inctable (semanticdb-find-table-for-include-default includetag table))
(inside-ns (semantic-tag-get-attribute includetag :inside-ns))
- tags newtags namespaces prefix parenttable newtable)
+ tags newtags namespaces parenttable newtable) ;; prefix
(if (or (null inside-ns)
(not inctable)
(not (slot-boundp inctable 'tags)))
@@ -2111,13 +2115,11 @@ actually in their parent which is not accessible.")
"Set up a buffer for semantic parsing of the C language."
(semantic-c-by--install-parser)
(setq semantic-lex-syntax-modifications '((?> ".")
- (?< ".")
- )
- )
+ (?< ".")))
(setq semantic-lex-analyzer #'semantic-c-lexer)
- (add-hook 'semantic-lex-reset-functions 'semantic-lex-spp-reset-hook nil t)
- (when (eq major-mode 'c++-mode)
+ (add-hook 'semantic-lex-reset-functions #'semantic-lex-spp-reset-hook nil t)
+ (when (derived-mode-p 'c++-mode)
(add-to-list 'semantic-lex-c-preprocessor-symbol-map '("__cplusplus" . "")))
)
@@ -2142,7 +2144,7 @@ actually in their parent which is not accessible.")
(defun semantic-c-describe-environment ()
"Describe the Semantic features of the current C environment."
(interactive)
- (if (not (member 'c-mode (mode-local-equivalent-mode-p major-mode)))
+ (if (not (derived-mode-p 'c-mode))
(error "Not useful to query C mode in %s mode" major-mode))
(let ((gcc (when (boundp 'semantic-gcc-setup-data)
semantic-gcc-setup-data))
@@ -2242,8 +2244,8 @@ actually in their parent which is not accessible.")
(if (obarrayp semantic-lex-spp-project-macro-symbol-obarray)
(let ((macros nil))
(mapatoms
- #'(lambda (symbol)
- (setq macros (cons symbol macros)))
+ (lambda (symbol)
+ (setq macros (cons symbol macros)))
semantic-lex-spp-project-macro-symbol-obarray)
(dolist (S macros)
(princ " ")
diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el
index 8ea9ac24423..47850a5d1f4 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/debug.el --- Debugger support for bovinator
+;;; semantic/bovine/debug.el --- Debugger support for bovinator -*- lexical-binding: t; -*-
;; Copyright (C) 2003, 2009-2021 Free Software Foundation, Inc.
@@ -123,7 +123,7 @@ Argument CONDITION is the thrown error condition."
frame)
frame))
-(cl-defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-highlight ((_frame semantic-bovine-debug-error-frame))
"Highlight a frame from an action."
;; How do I get the location of the action in the source buffer?
)
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index dc617349021..ebb20448ed5 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
+;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@@ -169,10 +169,10 @@ where:
- FORM is an Elisp form read from the current buffer.
- START and END are the beginning and end location of the
corresponding data in the current buffer."
+ (declare (indent 1))
(let ((sym (make-symbol "sym")))
`(dolist (,sym ',symbols)
(put ,sym 'semantic-elisp-form-parser #',parser))))
-(put 'semantic-elisp-setup-form-parser 'lisp-indent-function 1)
(defmacro semantic-elisp-reuse-form-parser (symbol &rest symbols)
"Reuse the form parser of SYMBOL for forms identified by SYMBOLS.
@@ -210,7 +210,7 @@ Return a bovination list to use."
;;; Form parsers
;;
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 2 form))
nil
@@ -234,7 +234,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil
@@ -256,7 +256,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag-new-variable
(symbol-name (nth 1 form))
@@ -274,7 +274,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag-new-variable
(symbol-name (nth 1 form))
@@ -290,7 +290,7 @@ Return a bovination list to use."
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag-new-variable
(symbol-name (nth 1 form))
@@ -307,7 +307,7 @@ Return a bovination list to use."
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((doc (semantic-elisp-form-to-doc-string (nth 3 form))))
(semantic-tag
(symbol-name (nth 1 form))
@@ -321,7 +321,7 @@ Return a bovination list to use."
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (cadr (cadr form)))
nil nil
@@ -333,7 +333,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let* ((a2 (nth 2 form))
(a3 (nth 3 form))
(args (if (listp a2) a2 a3))
@@ -353,7 +353,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil
@@ -363,7 +363,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((docpart (nthcdr 4 form)))
(semantic-tag-new-type
(symbol-name (nth 1 form))
@@ -381,7 +381,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((slots (nthcdr 2 form)))
;; Skip doc string if present.
(and (stringp (car slots))
@@ -399,7 +399,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-function
(symbol-name (nth 1 form))
nil nil
@@ -410,7 +410,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((args (nth 3 form)))
(semantic-tag-new-function
(symbol-name (nth 1 form))
@@ -424,7 +424,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(semantic-tag-new-variable
(symbol-name (nth 2 form))
nil
@@ -437,7 +437,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((name (nth 1 form)))
(semantic-tag-new-include
(symbol-name (if (eq (car-safe name) 'quote)
@@ -449,7 +449,7 @@ Return a bovination list to use."
)
(semantic-elisp-setup-form-parser
- (lambda (form start end)
+ (lambda (form _start _end)
(let ((name (nth 1 form)))
(semantic-tag-new-package
(symbol-name (if (eq (car-safe name) 'quote)
@@ -500,7 +500,7 @@ into Emacs Lisp's memory."
""))))
(define-mode-local-override semantic-documentation-for-tag
- emacs-lisp-mode (tag &optional nosnarf)
+ emacs-lisp-mode (tag &optional _nosnarf)
"Return the documentation string for TAG.
Optional argument NOSNARF is ignored."
(let ((d (semantic-tag-docstring tag)))
@@ -577,7 +577,7 @@ Override function for `semantic-tag-protection'."
((string= prot "protected") 'protected))))
(define-mode-local-override semantic-tag-static-p
- emacs-lisp-mode (tag &optional parent)
+ emacs-lisp-mode (tag &optional _parent)
"Return non-nil if TAG is static in PARENT class.
Overrides `semantic-nonterminal-static'."
;; This can only be true (theoretically) in a class where it is assigned.
@@ -585,10 +585,10 @@ Overrides `semantic-nonterminal-static'."
;;; Context parsing
;;
-;; Emacs lisp is very different from C,C++ which most context parsing
+;; Emacs Lisp is very different from C,C++ which most context parsing
;; functions are written. Support them here.
(define-mode-local-override semantic-up-context emacs-lisp-mode
- (&optional point bounds-type)
+ (&optional _point _bounds-type)
"Move up one context in an Emacs Lisp function.
A Context in many languages is a block with its own local variables.
In Emacs, we will move up lists and stop when one starts with one of
@@ -652,7 +652,7 @@ define-mode-overload\\)\
(define-mode-local-override semantic-get-local-variables emacs-lisp-mode
- (&optional point)
+ (&optional _point)
"Return a list of local variables for POINT.
Scan backwards from point at each successive function. For all occurrences
of `let' or `let*', grab those variable names."
@@ -940,7 +940,7 @@ ELisp variables can be pretty long, so track this one too.")
;; loaded into Emacs.
)
-(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup)
+(add-hook 'emacs-lisp-mode-hook #'semantic-default-elisp-setup)
;;; LISP MODE
;;
@@ -950,7 +950,7 @@ ELisp variables can be pretty long, so track this one too.")
;; See this syntax:
;; (defun foo () /#A)
;;
-(add-hook 'lisp-mode-hook 'semantic-default-elisp-setup)
+(add-hook 'lisp-mode-hook #'semantic-default-elisp-setup)
(eval-after-load "semantic/db"
'(require 'semantic/db-el)
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index 1cfe5a3bac1..02bd0defef5 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
+;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -25,6 +25,7 @@
;; GCC, and set up the preprocessor and include paths.
(require 'semantic/dep)
+(require 'cl-lib)
(defvar semantic-lex-c-preprocessor-symbol-file)
(defvar semantic-lex-c-preprocessor-symbol-map)
@@ -46,11 +47,11 @@ to give to the program."
(erase-buffer)
(setenv "LC_ALL" "C")
(condition-case nil
- (setq err (apply 'call-process gcc-cmd options))
+ (setq err (apply #'call-process gcc-cmd options))
(error ;; Some bogus directory for the first time perhaps?
(let ((default-directory (expand-file-name "~/")))
(condition-case nil
- (setq err (apply 'call-process gcc-cmd options))
+ (setq err (apply #'call-process gcc-cmd options))
(error ;; gcc doesn't exist???
nil)))))
(setenv "LC_ALL" old-lc-messages)
@@ -88,10 +89,9 @@ to give to the program."
(let ((path (substring line 1)))
(when (and (file-accessible-directory-p path)
(file-name-absolute-p path))
- (add-to-list 'inc-path
- (expand-file-name path)
- t))))))))
- inc-path))
+ (cl-pushnew (expand-file-name path) inc-path
+ :test #'equal))))))))
+ (nreverse inc-path)))
(defun semantic-cpp-defs (str)
@@ -101,7 +101,7 @@ to give to the program."
(dolist (L lines)
(let ((dat (split-string L)))
(when (= (length dat) 3)
- (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
+ (push (cons (nth 1 dat) (nth 2 dat)) lst))))
lst))
(defun semantic-gcc-fields (str)
@@ -142,6 +142,8 @@ This is an alist, and should include keys of:
`--prefix' - where GCC was installed.
It should also include other symbols GCC was compiled with.")
+(defvar c++-include-path)
+
;;;###autoload
(defun semantic-gcc-setup ()
"Setup Semantic C/C++ parsing based on GCC output."
@@ -149,12 +151,12 @@ It should also include other symbols GCC was compiled with.")
(let* ((fields (or semantic-gcc-setup-data
(semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
(cpp-options `("-E" "-dM" "-x" "c++" ,null-device))
- (query (let ((q (apply 'semantic-gcc-query "cpp" cpp-options)))
+ (query (let ((q (apply #'semantic-gcc-query "cpp" cpp-options)))
(if (stringp q)
q
;; `cpp' command in `semantic-gcc-setup' doesn't work on
;; Mac, try `gcc'.
- (apply 'semantic-gcc-query "gcc" cpp-options))))
+ (apply #'semantic-gcc-query "gcc" cpp-options))))
(defines (if (stringp query)
(semantic-cpp-defs query)
(message (concat "Could not query gcc for defines. "
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 4914ec9b124..a2717d711fe 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
+;;; semantic/bovine/grammar.el --- Bovine's input grammar mode -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;
@@ -25,9 +25,8 @@
;;
;; Major mode for editing Bovine's input grammar (.by) files.
-;;; History:
-
;;; Code:
+
(require 'semantic)
(require 'semantic/grammar)
(require 'semantic/find)
@@ -243,7 +242,8 @@ QUOTEMODE is the mode in which quoted symbols are slurred."
(insert "\n")
(cond
((eq (car sexp) 'EXPAND)
- (insert ",(lambda (vals start end)")
+ (insert ",(lambda (vals start end)"
+ "\n(ignore vals start end)")
;; The EXPAND macro definition is mandatory
(bovine-grammar-expand-form
(apply (cdr (assq 'EXPAND bovine--grammar-macros)) (cdr sexp))
@@ -475,7 +475,7 @@ Menu items are appended to the common grammar menu.")
(with-current-buffer (find-file-noselect infile)
(setq infile buffer-file-name)
(if outdir (setq default-directory outdir))
- (semantic-grammar-create-package nil t))
+ (semantic-grammar-create-package t t))
(error (message "%s" (error-message-string err)) nil)))
lang filename copyright-end)
(when (and packagename
@@ -520,7 +520,8 @@ Menu items are appended to the common grammar menu.")
(goto-char (point-min))
(delete-region (point-min) (line-end-position))
(insert ";;; " packagename
- " --- Generated parser support file")
+ " --- Generated parser support file "
+ "-*- lexical-binding:t -*-")
(delete-trailing-whitespace)
(re-search-forward ";;; \\(.*\\) ends here")
(replace-match packagename nil nil nil 1)))))
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 80895565274..bb579cfde3f 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,4 +1,4 @@
-;;; semantic/bovine/make.el --- Makefile parsing rules.
+;;; semantic/bovine/make.el --- Makefile parsing rules. -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2004, 2008-2021 Free Software Foundation, Inc.
@@ -103,13 +103,13 @@ Ignore them."
xpand))
(define-mode-local-override semantic-get-local-variables
- makefile-mode (&optional point)
+ makefile-mode (&optional _point)
"Override `semantic-get-local-variables' so it does not throw an error.
We never have local variables in Makefiles."
nil)
(define-mode-local-override semantic-ctxt-current-class-list
- makefile-mode (&optional point)
+ makefile-mode (&optional _point)
"List of classes that are valid to place at point."
(let ((tag (semantic-current-tag)))
(when tag
@@ -176,7 +176,7 @@ This is the same as a regular prototype."
(semantic-format-tag-prototype tag parent color))
(define-mode-local-override semantic-analyze-possible-completions
- makefile-mode (context &rest flags)
+ makefile-mode (context &rest _flags)
"Return a list of possible completions in a Makefile.
Uses default implementation, and also gets a list of filenames."
(require 'semantic/analyze/complete)
@@ -218,7 +218,7 @@ Uses default implementation, and also gets a list of filenames."
;; but not actually parsed.
(file . "File"))
semantic-case-fold t
- semantic-tag-expand-function 'semantic-make-expand-tag
+ semantic-tag-expand-function #'semantic-make-expand-tag
semantic-lex-syntax-modifications '((?. "_")
(?= ".")
(?/ "_")
@@ -226,7 +226,7 @@ Uses default implementation, and also gets a list of filenames."
(?+ ".")
(?\\ ".")
)
- imenu-create-index-function 'semantic-create-imenu-index
+ imenu-create-index-function #'semantic-create-imenu-index
)
(setq semantic-lex-analyzer #'semantic-make-lexer)
)
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index aaa86a1e36c..0395412069b 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -1,6 +1,6 @@
-;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
+;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile) -*- lexical-binding: t; -*-
-;;; Copyright (C) 2001-2004, 2008-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -49,7 +49,7 @@ actually on the local machine.")
")")
(semantic-format-tag-prototype-default tag parent color))))
-(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional nosnarf)
+(define-mode-local-override semantic-documentation-for-tag scheme-mode (tag &optional _nosnarf)
"Return the documentation string for TAG.
Optional argument NOSNARF is ignored."
(let ((d (semantic-tag-docstring tag)))
@@ -57,7 +57,7 @@ Optional argument NOSNARF is ignored."
(substring d 1)
d)))
-(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag tagfile)
+(define-mode-local-override semantic-insert-foreign-tag scheme-mode (tag _tagfile)
"Insert TAG from TAGFILE at point.
Attempts a simple prototype for calling or using TAG."
(cond ((eq (semantic-tag-class tag) 'function)
@@ -102,8 +102,7 @@ syntax as specified by the syntax table."
(function . "Functions")
(include . "Loads")
(package . "DefineModule"))
- imenu-create-index-function 'semantic-create-imenu-index
- imenu-create-index-function 'semantic-create-imenu-index
+ imenu-create-index-function #'semantic-create-imenu-index
)
(setq semantic-lex-analyzer #'semantic-scheme-lexer)
)
diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el
index e7848faf741..0abbe458647 100644
--- a/lisp/cedet/semantic/chart.el
+++ b/lisp/cedet/semantic/chart.el
@@ -1,4 +1,4 @@
-;;; semantic/chart.el --- Utilities for use with semantic tag tables
+;;; semantic/chart.el --- Utilities for use with semantic tag tables -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2001, 2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
@@ -43,7 +43,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
(interactive)
(let* ((stream (semantic-something-to-tag-table
(or tagtable (current-buffer))))
- (names (mapcar 'cdr semantic-symbol->name-assoc-list))
+ (names (mapcar #'cdr semantic-symbol->name-assoc-list))
(nums (mapcar
(lambda (symname)
(length
@@ -57,7 +57,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
nums "Volume")
))
-(defun semantic-chart-database-size (&optional tagtable)
+(defun semantic-chart-database-size (&optional _tagtable)
"Create a bar chart representing the size of each file in semanticdb.
Each bar represents how many toplevel tags in TAGTABLE
exist in each database entry.
@@ -68,7 +68,7 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
(error "Semanticdb is not enabled"))
(let* ((db semanticdb-current-database)
(dbt (semanticdb-get-database-tables db))
- (names (mapcar 'car
+ (names (mapcar #'car
(object-assoc-list
'file
dbt)))
@@ -84,8 +84,8 @@ TAGTABLE is passed to `semantic-something-to-tag-table'."
(nums nil)
(fh (/ (- (frame-height) 7) 4)))
(setq numnuts (sort numnuts (lambda (a b) (> (car a) (car b)))))
- (setq names (mapcar 'cdr numnuts)
- nums (mapcar 'car numnuts))
+ (setq names (mapcar #'cdr numnuts)
+ nums (mapcar #'car numnuts))
(if (> (length names) fh)
(progn
(setcdr (nthcdr fh names) nil)
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index c83505818f5..d6ef7960473 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1,4 +1,4 @@
-;;; semantic/complete.el --- Routines for performing tag completion
+;;; semantic/complete.el --- Routines for performing tag completion -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2005, 2007-2021 Free Software Foundation, Inc.
@@ -154,8 +154,8 @@ Presumably if you call this you will insert something new there."
(defun semantic-completion-message (fmt &rest args)
"Display the string FMT formatted with ARGS at the end of the minibuffer."
(if semantic-complete-inline-overlay
- (apply 'message fmt args)
- (apply 'message (concat "%s" fmt) (buffer-string) args)))
+ (apply #'message fmt args)
+ (apply #'message (concat "%s" fmt) (buffer-string) args)))
;;; ------------------------------------------------------------
;;; MINIBUFFER: Option Selection harnesses
@@ -171,14 +171,14 @@ Value should be a ... what?")
(defvar semantic-complete-key-map
(let ((km (make-sparse-keymap)))
- (define-key km " " 'semantic-complete-complete-space)
- (define-key km "\t" 'semantic-complete-complete-tab)
- (define-key km "\C-m" 'semantic-complete-done)
- (define-key km "\C-g" 'abort-recursive-edit)
- (define-key km "\M-n" 'next-history-element)
- (define-key km "\M-p" 'previous-history-element)
- (define-key km "\C-n" 'next-history-element)
- (define-key km "\C-p" 'previous-history-element)
+ (define-key km " " #'semantic-complete-complete-space)
+ (define-key km "\t" #'semantic-complete-complete-tab)
+ (define-key km "\C-m" #'semantic-complete-done)
+ (define-key km "\C-g" #'abort-recursive-edit)
+ (define-key km "\M-n" #'next-history-element)
+ (define-key km "\M-p" #'previous-history-element)
+ (define-key km "\C-n" #'next-history-element)
+ (define-key km "\C-p" #'previous-history-element)
;; Add history navigation
km)
"Keymap used while completing across a list of tags.")
@@ -488,7 +488,7 @@ If PARTIAL, do partial completion stopping at spaces."
)
(t nil))))
-(defun semantic-complete-do-completion (&optional partial inline)
+(defun semantic-complete-do-completion (&optional partial _inline)
"Do a completion for the current minibuffer.
If PARTIAL, do partial completion stopping at spaces.
if INLINE, then completion is happening inline in a buffer."
@@ -550,12 +550,12 @@ if INLINE, then completion is happening inline in a buffer."
;; push ourselves out of this mode on alternate keypresses.
(defvar semantic-complete-inline-map
(let ((km (make-sparse-keymap)))
- (define-key km "\C-i" 'semantic-complete-inline-TAB)
- (define-key km "\M-p" 'semantic-complete-inline-up)
- (define-key km "\M-n" 'semantic-complete-inline-down)
- (define-key km "\C-m" 'semantic-complete-inline-done)
- (define-key km "\C-\M-c" 'semantic-complete-inline-exit)
- (define-key km "\C-g" 'semantic-complete-inline-quit)
+ (define-key km "\C-i" #'semantic-complete-inline-TAB)
+ (define-key km "\M-p" #'semantic-complete-inline-up)
+ (define-key km "\M-n" #'semantic-complete-inline-down)
+ (define-key km "\C-m" #'semantic-complete-inline-done)
+ (define-key km "\C-\M-c" #'semantic-complete-inline-exit)
+ (define-key km "\C-g" #'semantic-complete-inline-quit)
(define-key km "?"
(lambda () (interactive)
(describe-variable 'semantic-complete-inline-map)))
@@ -620,7 +620,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer."
"Exit inline completion mode."
(interactive)
;; Remove this hook FIRST!
- (remove-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
+ (remove-hook 'pre-command-hook #'semantic-complete-pre-command-hook)
(condition-case nil
(progn
@@ -649,7 +649,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer."
;; Remove this hook LAST!!!
;; This will force us back through this function if there was
;; some sort of error above.
- (remove-hook 'post-command-hook 'semantic-complete-post-command-hook)
+ (remove-hook 'post-command-hook #'semantic-complete-post-command-hook)
;;(message "Exiting inline completion.")
)
@@ -770,8 +770,8 @@ END is at the end of the current symbol being completed."
(overlay-put semantic-complete-inline-overlay
'semantic-original-start start)
;; Install our command hooks
- (add-hook 'pre-command-hook 'semantic-complete-pre-command-hook)
- (add-hook 'post-command-hook 'semantic-complete-post-command-hook)
+ (add-hook 'pre-command-hook #'semantic-complete-pre-command-hook)
+ (add-hook 'post-command-hook #'semantic-complete-post-command-hook)
;; Go!
(semantic-complete-inline-force-display)
)
@@ -929,8 +929,8 @@ The only options available for completion are those which can be logically
inserted into the current context.")
(cl-defmethod semantic-collector-calculate-completions-raw
- ((obj semantic-collector-analyze-completions) prefix completionlist)
- "calculate the completions for prefix from completionlist."
+ ((obj semantic-collector-analyze-completions) prefix _completionlist)
+ "calculate the completions for prefix from COMPLETIONLIST."
;; if there are no completions yet, calculate them.
(if (not (slot-boundp obj 'first-pass-completions))
(oset obj first-pass-completions
@@ -943,7 +943,7 @@ inserted into the current context.")
prefix
(oref obj first-pass-completions)))))
-(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-cleanup ((_obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
@@ -1004,7 +1004,7 @@ Output must be in semanticdb Find result format."
(list (cons table result)))))
(cl-defmethod semantic-collector-calculate-completions
- ((obj semantic-collector-abstract) prefix partial)
+ ((obj semantic-collector-abstract) prefix _partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
(same-prefix-p (semantic-collector-last-prefix= obj prefix))
@@ -1014,7 +1014,8 @@ Output must be in semanticdb Find result format."
(cond ((or same-prefix-p
(and last-prefix (eq (compare-strings
last-prefix 0 nil
- prefix 0 (length last-prefix)) t)))
+ prefix 0 (length last-prefix))
+ t)))
;; We have the same prefix, or last-prefix is a
;; substring of the of new prefix, in which case we are
;; refining our symbol so just re-use cache.
@@ -1023,7 +1024,8 @@ Output must be in semanticdb Find result format."
(> (length prefix) 1)
(eq (compare-strings
prefix 0 nil
- last-prefix 0 (length prefix)) t))
+ last-prefix 0 (length prefix))
+ t))
;; The new prefix is a substring of the old
;; prefix, and it's longer than one character.
;; Perform a full search to pull in additional
@@ -1134,7 +1136,7 @@ into a buffer."
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
(cl-defmethod semantic-collector-all-completions
- ((obj semantic-collector-abstract) prefix)
+ ((obj semantic-collector-abstract) _prefix)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
matching PREFIX."
@@ -1142,7 +1144,7 @@ matching PREFIX."
(oref obj last-all-completions)))
(cl-defmethod semantic-collector-try-completion
- ((obj semantic-collector-abstract) prefix)
+ ((obj semantic-collector-abstract) _prefix)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
Return nil for no match.
@@ -1153,7 +1155,7 @@ with that name."
(oref obj last-completion)))
(cl-defmethod semantic-collector-calculate-cache
- ((obj semantic-collector-abstract))
+ ((_obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
nil
)
@@ -1176,7 +1178,7 @@ These collectors track themselves on a per-buffer basis."
:abstract t)
(cl-defmethod make-instance ((this (subclass semantic-collector-buffer-abstract))
- &rest args)
+ &rest _args)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
(bl semantic-collector-per-buffer-list))
@@ -1193,7 +1195,7 @@ These collectors track themselves on a per-buffer basis."
old))
;; Buffer specific collectors should flush themselves
-(defun semantic-collector-buffer-flush (newcache)
+(defun semantic-collector-buffer-flush (_newcache)
"Flush all buffer collector objects.
NEWCACHE is the new tag table, but we ignore it."
(condition-case nil
@@ -1204,7 +1206,7 @@ NEWCACHE is the new tag table, but we ignore it."
(error nil)))
(add-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-collector-buffer-flush)
+ #'semantic-collector-buffer-flush)
;;; DEEP BUFFER SPECIFIC COMPLETION
;;
@@ -1246,8 +1248,8 @@ Uses semanticdb for searching all tags in the current project."
(cl-defmethod semantic-collector-calculate-completions-raw
- ((obj semantic-collector-project) prefix completionlist)
- "Calculate the completions for prefix from completionlist."
+ ((obj semantic-collector-project) prefix _completionlist)
+ "Calculate the completions for prefix from COMPLETIONLIST."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
;;; Brutish Project search
@@ -1259,8 +1261,8 @@ Uses semanticdb for searching all tags in the current project."
"semantic/db-find")
(cl-defmethod semantic-collector-calculate-completions-raw
- ((obj semantic-collector-project-brutish) prefix completionlist)
- "Calculate the completions for prefix from completionlist."
+ ((obj semantic-collector-project-brutish) prefix _completionlist)
+ "Calculate the completions for prefix from COMPLETIONLIST."
(require 'semantic/db-find)
(semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))
@@ -1273,8 +1275,8 @@ Uses semanticdb for searching all tags in the current project."
"Completion engine for tags in a project.")
(cl-defmethod semantic-collector-calculate-completions-raw
- ((obj semantic-collector-local-members) prefix completionlist)
- "Calculate the completions for prefix from completionlist."
+ ((obj semantic-collector-local-members) prefix _completionlist)
+ "Calculate the completions for prefix from COMPLETIONLIST."
(let* ((scope (or (oref obj scope)
(oset obj scope (semantic-calculate-scope))))
(localstuff (oref scope scope)))
@@ -1323,7 +1325,7 @@ a collector, and tracking tables of completion to display."
(define-obsolete-function-alias 'semantic-displayor-cleanup
#'semantic-displayer-cleanup "27.1")
-(cl-defmethod semantic-displayer-cleanup ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-cleanup ((_obj semantic-displayer-abstract))
"Clean up any mess this displayer may have."
nil)
@@ -1348,37 +1350,37 @@ a collector, and tracking tables of completion to display."
(define-obsolete-function-alias 'semantic-displayor-show-request
#'semantic-displayer-show-request "27.1")
-(cl-defmethod semantic-displayer-show-request ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-show-request ((_obj semantic-displayer-abstract))
"A request to show the current tags table."
(ding))
(define-obsolete-function-alias 'semantic-displayor-focus-request
#'semantic-displayer-focus-request "27.1")
-(cl-defmethod semantic-displayer-focus-request ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-focus-request ((_obj semantic-displayer-abstract))
"A request to for the displayer to focus on some tag option."
(ding))
(define-obsolete-function-alias 'semantic-displayor-scroll-request
#'semantic-displayer-scroll-request "27.1")
-(cl-defmethod semantic-displayer-scroll-request ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-scroll-request ((_obj semantic-displayer-abstract))
"A request to for the displayer to scroll the completion list (if needed)."
(scroll-other-window))
(define-obsolete-function-alias 'semantic-displayor-focus-previous
#'semantic-displayer-focus-previous "27.1")
-(cl-defmethod semantic-displayer-focus-previous ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-focus-previous ((_obj semantic-displayer-abstract))
"Set the current focus to the previous item."
nil)
(define-obsolete-function-alias 'semantic-displayor-focus-next
#'semantic-displayer-focus-next "27.1")
-(cl-defmethod semantic-displayer-focus-next ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-focus-next ((_obj semantic-displayer-abstract))
"Set the current focus to the next item."
nil)
(define-obsolete-function-alias 'semantic-displayor-current-focus
#'semantic-displayer-current-focus "27.1")
-(cl-defmethod semantic-displayer-current-focus ((obj semantic-displayer-abstract))
+(cl-defmethod semantic-displayer-current-focus ((_obj semantic-displayer-abstract))
"Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object."
nil)
@@ -1452,7 +1454,7 @@ which have the same name."
(define-obsolete-function-alias 'semantic-displayor-set-completions
#'semantic-displayer-set-completions "27.1")
(cl-defmethod semantic-displayer-set-completions ((obj semantic-displayer-focus-abstract)
- table prefix)
+ _table _prefix)
"Set the list of tags to be completed over to TABLE."
(cl-call-next-method)
(slot-makeunbound obj 'focus))
@@ -1663,7 +1665,7 @@ This will not happen if you directly set this variable via `setq'."
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
-(cl-defmethod initialize-instance :after ((obj semantic-displayer-tooltip) &rest args)
+(cl-defmethod initialize-instance :after ((_obj semantic-displayer-tooltip) &rest _args)
"Make sure we have tooltips required."
(require 'tooltip))
@@ -1681,16 +1683,16 @@ Display mechanism using tooltip for a list of possible completions.")
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayer-format-tag-function table))
(numcompl (length completions))
- (typing-count (oref obj typing-count))
+ ;; (typing-count (oref obj typing-count))
(mode (oref obj mode))
(max-tags (oref obj max-tags-initial))
(matchtxt (semantic-completion-text))
msg msg-tail)
;; Keep a count of the consecutive completion commands entered by the user.
- (if (and (stringp (this-command-keys))
- (string= (this-command-keys) "\C-i"))
- (oset obj typing-count (1+ (oref obj typing-count)))
- (oset obj typing-count 0))
+ (oset obj typing-count
+ (if (equal (this-command-keys) "\C-i")
+ (1+ (oref obj typing-count))
+ 0))
(cond
((eq mode 'quiet)
;; Switch back to standard mode if user presses key more than 5 times.
@@ -1730,7 +1732,7 @@ Display mechanism using tooltip for a list of possible completions.")
(when semantic-idle-scheduler-verbose-flag
(setq msg "[NO MATCH]"))))
;; Create the tooltip text.
- (setq msg (concat msg (mapconcat 'identity completions "\n"))))
+ (setq msg (concat msg (mapconcat #'identity completions "\n"))))
;; Add any tail info.
(setq msg (concat msg msg-tail))
;; Display tooltip.
@@ -1828,12 +1830,10 @@ text using overlay options.")
(define-obsolete-function-alias 'semantic-displayor-set-completions
#'semantic-displayer-set-completions "27.1")
(cl-defmethod semantic-displayer-set-completions ((obj semantic-displayer-ghost)
- table prefix)
+ _table _prefix)
"Set the list of tags to be completed over to TABLE."
(cl-call-next-method)
-
- (semantic-displayer-cleanup obj)
- )
+ (semantic-displayer-cleanup obj))
(define-obsolete-function-alias 'semantic-displayor-show-request
@@ -2058,9 +2058,8 @@ prompts. these are calculated from the CONTEXT variable passed in."
(semantic-displayer-traditional-with-focus-highlight)
(with-current-buffer (oref context buffer)
(goto-char (cdr (oref context bounds)))
- (concat prompt (mapconcat 'identity syms ".")
- (if syms "." "")
- ))
+ (concat prompt (mapconcat #'identity syms ".")
+ (if syms "." "")))
nil
inp
history)))
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index 8d5b5dcdbdf..17ffaeff5e4 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -1,4 +1,4 @@
-;;; semantic/ctxt.el --- Context calculations for Semantic tools.
+;;; semantic/ctxt.el --- Context calculations for Semantic tools -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -137,18 +137,16 @@ Return non-nil if there is no upper context."
(defmacro semantic-with-buffer-narrowed-to-context (&rest body)
"Execute BODY with the buffer narrowed to the current context."
+ (declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-context)
,@body))
-(put 'semantic-with-buffer-narrowed-to-context 'lisp-indent-function 0)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-context
- (def-body))))
;;; Local Variables
;;
-;;
+
+(defvar semantic--progress-reporter)
+
(define-overloadable-function semantic-get-local-variables (&optional point)
"Get the local variables based on POINT's context.
Local variables are returned in Semantic tag format.
@@ -345,14 +343,10 @@ beginning and end of a command."
(defmacro semantic-with-buffer-narrowed-to-command (&rest body)
"Execute BODY with the buffer narrowed to the current command."
+ (declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-command)
,@body))
-(put 'semantic-with-buffer-narrowed-to-command 'lisp-indent-function 0)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-command
- (def-body))))
(define-overloadable-function semantic-ctxt-end-of-symbol (&optional point)
"Move point to the end of the current symbol under POINT.
@@ -374,7 +368,7 @@ work on C like languages."
;; NOTE: The [ \n] expression below should used \\s-, but that
;; doesn't work in C since \n means end-of-comment, and isn't
;; really whitespace.
- (fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)"))
+ ;;(fieldsep (concat "[ \t\n\r]*\\(" fieldsep1 "\\)[ \t\n\r]*\\(\\w\\|\\s_\\)"))
(case-fold-search semantic-case-fold)
(continuesearch t)
(end nil)
@@ -655,7 +649,7 @@ POINT defaults to the value of point in current buffer.
You should override this function in multiple mode buffers to
determine which major mode apply at point.")
-(defun semantic-ctxt-current-mode-default (&optional point)
+(defun semantic-ctxt-current-mode-default (&optional _point)
"Return the major mode active at POINT.
POINT defaults to the value of point in current buffer.
This default implementation returns the current major mode."
@@ -671,7 +665,7 @@ The return value can be a mixed list of either strings (names of
types that are in scope) or actual tags (type declared locally
that may or may not have a name.)")
-(defun semantic-ctxt-scoped-types-default (&optional point)
+(defun semantic-ctxt-scoped-types-default (&optional _point)
"Return a list of scoped types by name for the current context at POINT.
This is very different for various languages, and does nothing unless
overridden."
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
index c553ab499ae..d8f7034f03a 100644
--- a/lisp/cedet/semantic/db-debug.el
+++ b/lisp/cedet/semantic/db-debug.el
@@ -1,6 +1,6 @@
-;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
+;;; semantic/db-debug.el --- Extra level debugging routines for Semantic -*- lexical-binding: t; -*-
-;;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -38,7 +38,7 @@
(data-debug-new-buffer "*SEMANTICDB*")
(data-debug-insert-stuff-list db "*")))
-(defalias 'semanticdb-adebug-database-list 'semanticdb-dump-all-table-summary)
+(defalias 'semanticdb-adebug-database-list #'semanticdb-dump-all-table-summary)
(defun semanticdb-adebug-current-database ()
"Run ADEBUG on the current database."
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index 946f9ef6326..8bc3b810a65 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -1,4 +1,4 @@
-;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
+;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse. -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@@ -79,7 +79,7 @@ be searched."
;;; SEMANTIC Database related Code
;;; Classes:
(defclass semanticdb-table-ebrowse (semanticdb-table)
- ((major-mode :initform c++-mode)
+ ((major-mode :initform #'c++-mode)
(ebrowse-tree :initform nil
:initarg :ebrowse-tree
:documentation
@@ -95,7 +95,7 @@ This table is composited from the ebrowse *Globals* section.")
(defclass semanticdb-project-database-ebrowse
(semanticdb-project-database)
- ((new-table-class :initform semanticdb-table-ebrowse
+ ((new-table-class :initform 'semanticdb-table-ebrowse
:type class
:documentation
"New tables created for this database are of this class.")
@@ -135,8 +135,8 @@ is specified by `semanticdb-default-save-directory'."
(let* ((savein (semanticdb-ebrowse-file-for-directory dir))
(filebuff (get-buffer-create "*SEMANTICDB EBROWSE TMP*"))
(files (directory-files (expand-file-name dir) t))
- (mma auto-mode-alist)
- (regexp nil)
+ ;; (mma auto-mode-alist)
+ ;; (regexp nil)
)
;; Create the input to the ebrowse command
(with-current-buffer filebuff
@@ -222,12 +222,12 @@ warn instead."
;JAVE this just instantiates a default empty ebrowse struct?
; how would new instances wind up here?
-; the ebrowse class isn't singleton, unlike the emacs lisp one
+; the ebrowse class isn't singleton, unlike the Emacs Lisp one
(defvar-mode-local c++-mode semanticdb-project-system-databases
()
"Search Ebrowse for symbols.")
-(cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
+(cl-defmethod semanticdb-needs-refresh-p ((_table semanticdb-table-ebrowse))
"EBROWSE database do not need to be refreshed.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files
@@ -274,7 +274,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
(insert-file-contents B)
(let ((ans nil)
(efcn (symbol-function 'ebrowse-show-progress)))
- (fset 'ebrowse-show-progress #'(lambda (&rest junk) nil))
+ (fset 'ebrowse-show-progress (lambda (&rest _junk) nil))
(unwind-protect ;; Protect against errors w/ ebrowse
(setq ans (list B (ebrowse-read)))
;; These items must always happen
@@ -341,10 +341,10 @@ If there is no database for DIRECTORY available, then
(while T
(let* ((tree (car T))
- (class (ebrowse-ts-class tree)); root class of tree
+ ;;(class (ebrowse-ts-class tree)); root class of tree
;; Something funny going on with this file thing...
- (filename (or (ebrowse-cs-source-file class)
- (ebrowse-cs-file class)))
+ ;; (filename (or (ebrowse-cs-source-file class)
+ ;; (ebrowse-cs-file class)))
)
(cond
((ebrowse-globals-tree-p tree)
@@ -363,18 +363,18 @@ If there is no database for DIRECTORY available, then
;;; Filename based methods
;;
-(defun semanticdb-ebrowse-add-globals-to-table (dbe tree)
+(defun semanticdb-ebrowse-add-globals-to-table (_dbe tree)
"For database DBE, add the ebrowse TREE into the table."
(if (or (not (ebrowse-ts-p tree))
(not (ebrowse-globals-tree-p tree)))
(signal 'wrong-type-argument (list 'ebrowse-ts-p tree)))
(let* ((class (ebrowse-ts-class tree))
- (fname (or (ebrowse-cs-source-file class)
- (ebrowse-cs-file class)
- ;; Not def'd here, assume our current
- ;; file
- (concat default-directory "/unknown-proxy.hh")))
+ ;; (fname (or (ebrowse-cs-source-file class)
+ ;; (ebrowse-cs-file class)
+ ;; ;; Not def'd here, assume our current
+ ;; ;; file
+ ;; (concat default-directory "/unknown-proxy.hh")))
(vars (ebrowse-ts-member-functions tree))
(fns (ebrowse-ts-member-variables tree))
(toks nil)
@@ -573,7 +573,7 @@ return that."
;; how your new search routines are implemented.
;;
(cl-defmethod semanticdb-find-tags-by-name-method
- ((table semanticdb-table-ebrowse) name &optional tags)
+ ((_table semanticdb-table-ebrowse) _name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
@@ -588,7 +588,7 @@ Return a list of tags."
)
(cl-defmethod semanticdb-find-tags-by-name-regexp-method
- ((table semanticdb-table-ebrowse) regex &optional tags)
+ ((_table semanticdb-table-ebrowse) _regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
@@ -598,7 +598,7 @@ Return a list of tags."
))
(cl-defmethod semanticdb-find-tags-for-completion-method
- ((table semanticdb-table-ebrowse) prefix &optional tags)
+ ((_table semanticdb-table-ebrowse) _prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -608,7 +608,7 @@ Returns a table of all matching tags."
))
(cl-defmethod semanticdb-find-tags-by-class-method
- ((table semanticdb-table-ebrowse) class &optional tags)
+ ((_table semanticdb-table-ebrowse) _class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -625,7 +625,7 @@ Returns a table of all matching tags."
;;
(cl-defmethod semanticdb-deep-find-tags-by-name-method
- ((table semanticdb-table-ebrowse) name &optional tags)
+ ((_table semanticdb-table-ebrowse) _name &optional _tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
@@ -633,7 +633,7 @@ Like `semanticdb-find-tags-by-name-method' for ebrowse."
(cl-call-next-method))
(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
- ((table semanticdb-table-ebrowse) regex &optional tags)
+ ((_table semanticdb-table-ebrowse) _regex &optional _tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
@@ -641,7 +641,7 @@ Like `semanticdb-find-tags-by-name-method' for ebrowse."
(cl-call-next-method))
(cl-defmethod semanticdb-deep-find-tags-for-completion-method
- ((table semanticdb-table-ebrowse) prefix &optional tags)
+ ((_table semanticdb-table-ebrowse) _prefix &optional _tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse."
@@ -651,7 +651,7 @@ Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;; Advanced Searches
;;
(cl-defmethod semanticdb-find-tags-external-children-of-type-method
- ((table semanticdb-table-ebrowse) type &optional tags)
+ ((_table semanticdb-table-ebrowse) _type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 4699e722c1a..41e48b0bc30 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -1,6 +1,6 @@
-;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
+;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp -*- lexical-binding: t; -*-
-;;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -40,7 +40,7 @@
;;; Classes:
(defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table)
- ((major-mode :initform emacs-lisp-mode)
+ ((major-mode :initform #'emacs-lisp-mode)
)
"A table for returning search results from Emacs.")
@@ -53,7 +53,7 @@ It does not need refreshing."
"Return nil, we never need a refresh."
nil)
-(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-debug-info ((_obj semanticdb-table-emacs-lisp))
(list "(proxy)"))
(cl-defmethod cl-print-object ((obj semanticdb-table-emacs-lisp) stream)
@@ -63,7 +63,7 @@ It does not need refreshing."
(defclass semanticdb-project-database-emacs-lisp
(semanticdb-project-database eieio-singleton)
- ((new-table-class :initform semanticdb-table-emacs-lisp
+ ((new-table-class :initform 'semanticdb-table-emacs-lisp
:type class
:documentation
"New tables created for this database are of this class.")
@@ -195,9 +195,6 @@ If Emacs cannot resolve this symbol to a particular file, then return nil."
(when tab (cons tab match))))))
(autoload 'help-function-arglist "help-fns")
-(defalias 'semanticdb-elisp-sym-function-arglist 'help-function-arglist)
-(make-obsolete 'semanticdb-elisp-sym-function-arglist
- 'help-function-arglist "CEDET 1.1")
(defun semanticdb-elisp-sym->tag (sym &optional toktype)
"Convert SYM into a semantic tag.
@@ -347,6 +344,9 @@ Return a list of tags."
)
taglst))))
+(define-obsolete-function-alias 'semanticdb-elisp-sym-function-arglist
+ #'help-function-arglist "24.3")
+
(provide 'semantic/db-el)
;;; semantic/db-el.el ends here
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index 59e9db9cc0a..c9007ac7a02 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -1,6 +1,6 @@
-;;; semantic/db-file.el --- Save a semanticdb to a cache file.
+;;; semantic/db-file.el --- Save a semanticdb to a cache file. -*- lexical-binding: t; -*-
-;;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -154,8 +154,6 @@ If DIRECTORY doesn't exist, create a new one."
;;; File IO
-(declare-function inversion-test "inversion")
-
(defun semanticdb-load-database (filename)
"Load the database FILENAME."
(condition-case foo
@@ -163,32 +161,19 @@ If DIRECTORY doesn't exist, create a new one."
'semanticdb-project-database-file))
(c (semanticdb-get-database-tables r))
(tv (oref r semantic-tag-version))
- (fv (oref r semanticdb-version))
- )
+ (fv (oref r semanticdb-version)))
;; Restore the parent-db connection
(while c
(oset (car c) parent-db r)
(setq c (cdr c)))
(unless (and (equal semanticdb-file-version fv)
(equal semantic-tag-version tv))
- ;; Try not to load inversion unless we need it:
- (require 'inversion)
- (if (not (inversion-test 'semanticdb-file fv))
- (when (inversion-test 'semantic-tag tv)
- ;; Incompatible version. Flush tables.
- (semanticdb-flush-database-tables r)
- ;; Reset the version to new version.
- (oset r semantic-tag-version semantic-tag-version)
- ;; Warn user
- (message "Semanticdb file is old. Starting over for %s"
- filename))
- ;; Version is not ok. Flush whole system
- (message "semanticdb file is old. Starting over for %s"
- filename)
- ;; This database is so old, we need to replace it.
- ;; We also need to delete it from the instance tracker.
- (delete-instance r)
- (setq r nil)))
+ ;; Version is not ok. Flush whole system
+ (message "semanticdb file is old. Starting over for %s" filename)
+ ;; This database is so old, we need to replace it.
+ ;; We also need to delete it from the instance tracker.
+ (delete-instance r)
+ (setq r nil))
r)
(error (message "Cache Error: [%s] %s, Restart"
filename foo)
@@ -373,13 +358,13 @@ Uses `semanticdb-persistent-path' to determine the return value."
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
(cl-defmethod semanticdb-file-name-non-directory
- ((dbclass (subclass semanticdb-project-database-file)))
+ ((_dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use.
File name excludes any directory part."
semanticdb-default-file-name)
(cl-defmethod semanticdb-file-name-directory
- ((dbclass (subclass semanticdb-project-database-file)) directory)
+ ((_dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index db88463bfd1..c96a426280e 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1,4 +1,4 @@
-;;; semantic/db-find.el --- Searching through semantic databases.
+;;; semantic/db-find.el --- Searching through semantic databases. -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -209,14 +209,14 @@ This class will cache data derived during various searches.")
)
(cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
- new-tags)
+ _new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts.
(semantic-reset idx)
;; Notify dependants by clearing their indices.
(semanticdb-notify-references
(oref idx table)
- (lambda (tab me)
+ (lambda (tab _me)
(semantic-reset (semanticdb-get-table-index tab))))
)
@@ -230,7 +230,7 @@ This class will cache data derived during various searches.")
;; Notify dependants by clearing their indices.
(semanticdb-notify-references
(oref idx table)
- (lambda (tab me)
+ (lambda (tab _me)
(semantic-reset (semanticdb-get-table-index tab))))
)
;; Else, not an include, by just a type.
@@ -240,7 +240,7 @@ This class will cache data derived during various searches.")
;; Notify dependants by clearing their indices.
(semanticdb-notify-references
(oref idx table)
- (lambda (tab me)
+ (lambda (tab _me)
(let ((tab-idx (semanticdb-get-table-index tab)))
;; Not a full reset?
(when (oref tab-idx type-cache)
@@ -791,7 +791,8 @@ PREBUTTONTEXT is some text between prefix and the overlay button."
(file (semantic-tag-file-name tag))
(str1 (format "%S %s" mode name))
(str2 (format " : %s" file))
- (tip nil))
+ ;; (tip nil)
+ )
(insert prefix prebuttontext str1)
(setq end (point))
(insert str2)
@@ -807,7 +808,7 @@ PREBUTTONTEXT is some text between prefix and the overlay button."
(put-text-property start end 'ddebug (cdr consdata))
(put-text-property start end 'ddebug-indent(length prefix))
(put-text-property start end 'ddebug-prefix prefix)
- (put-text-property start end 'help-echo tip)
+ ;; (put-text-property start end 'help-echo tip)
(put-text-property start end 'ddebug-function
'data-debug-insert-tag-parts-from-point)
(insert "\n")
@@ -1009,7 +1010,7 @@ is still made current."
(when norm
;; The normalized tags can now be found based on that
;; tags table.
- (condition-case foo
+ (condition-case nil
(progn
(semanticdb-set-buffer (car norm))
;; Now reset ans
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index 2f40082d53c..fad24485ed2 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -1,4 +1,4 @@
-;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
+;;; semantic/db-global.el --- Semantic database extensions for GLOBAL -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2006, 2008-2021 Free Software Foundation, Inc.
@@ -56,7 +56,7 @@ values."
(interactive
(list (completing-read
"Enable in Mode: " obarray
- #'(lambda (s) (get s 'mode-local-symbol-table))
+ (lambda (s) (get s 'mode-local-symbol-table))
t (symbol-name major-mode))))
;; First, make sure the version is ok.
@@ -69,7 +69,8 @@ values."
(let ((semanticdb--ih (mode-local-value mode 'semantic-init-mode-hook)))
(eval `(setq-mode-local
,mode semantic-init-mode-hook
- (cons 'semanticdb-enable-gnu-global-hook semanticdb--ih))))
+ (cons 'semanticdb-enable-gnu-global-hook ',semanticdb--ih))
+ t))
t
)
)
@@ -114,7 +115,7 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
)
"A table for returning search results from GNU Global.")
-(cl-defmethod semanticdb-debug-info ((obj semanticdb-table-global))
+(cl-defmethod semanticdb-debug-info ((_obj semanticdb-table-global))
(list "(proxy)"))
(cl-defmethod cl-print-object ((obj semanticdb-table-global) stream)
@@ -123,7 +124,7 @@ Adds the number of tags in this file to the object print name."
(princ (eieio-object-name obj (semanticdb-debug-info obj))
stream))
-(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-global) &optional _buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@@ -146,7 +147,7 @@ For each file hit, get the traditional semantic table from that file."
(cl-call-next-method))
-(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) _filename)
"From OBJ, return FILENAME's associated table object."
;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj))
@@ -157,7 +158,7 @@ For each file hit, get the traditional semantic table from that file."
;; Only NAME based searches work with GLOBAL as that is all it tracks.
;;
(cl-defmethod semanticdb-find-tags-by-name-method
- ((table semanticdb-table-global) name &optional tags)
+ ((_table semanticdb-table-global) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
@@ -174,7 +175,7 @@ Return a list of tags."
)))
(cl-defmethod semanticdb-find-tags-by-name-regexp-method
- ((table semanticdb-table-global) regex &optional tags)
+ ((_table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
@@ -187,7 +188,7 @@ Return a list of tags."
)))
(cl-defmethod semanticdb-find-tags-for-completion-method
- ((table semanticdb-table-global) prefix &optional tags)
+ ((_table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
index 2b138866215..bf3d6122954 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -1,4 +1,4 @@
-;;; semantic/db-javascript.el --- Semantic database extensions for javascript
+;;; semantic/db-javascript.el --- Semantic database extensions for javascript -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -80,7 +80,7 @@ See bottom of this file for instructions on managing this list.")
;;; Classes:
(defclass semanticdb-table-javascript (semanticdb-search-results-table)
- ((major-mode :initform javascript-mode)
+ ((major-mode :initform #'javascript-mode)
)
"A table for returning search results from javascript.")
@@ -88,7 +88,7 @@ See bottom of this file for instructions on managing this list.")
(semanticdb-project-database
eieio-singleton ;this db is for js globals, so singleton is appropriate
)
- ((new-table-class :initform semanticdb-table-javascript
+ ((new-table-class :initform 'semanticdb-table-javascript
:type class
:documentation
"New tables created for this database are of this class.")
@@ -129,20 +129,20 @@ Create one of our special tables that can act as an intermediary."
(cl-call-next-method)
)
-(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) _filename)
"From OBJ, return FILENAME's associated table object."
;; NOTE: See not for `semanticdb-get-database-tables'.
(car (semanticdb-get-database-tables obj))
)
-(cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
+(cl-defmethod semanticdb-get-tags ((_table semanticdb-table-javascript ))
"Return the list of tags belonging to TABLE."
;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something.
semanticdb-javascript-tags)
-(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((_table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@@ -193,7 +193,7 @@ database (if available.)"
result))
(cl-defmethod semanticdb-find-tags-by-name-method
- ((table semanticdb-table-javascript) name &optional tags)
+ ((_table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
@@ -203,7 +203,7 @@ Return a list of tags."
))
(cl-defmethod semanticdb-find-tags-by-name-regexp-method
- ((table semanticdb-table-javascript) regex &optional tags)
+ ((_table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
@@ -214,7 +214,7 @@ Return a list of tags."
))
(cl-defmethod semanticdb-find-tags-for-completion-method
- ((table semanticdb-table-javascript) prefix &optional tags)
+ ((_table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -224,7 +224,7 @@ Returns a table of all matching tags."
))
(cl-defmethod semanticdb-find-tags-by-class-method
- ((table semanticdb-table-javascript) class &optional tags)
+ ((_table semanticdb-table-javascript) _class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -268,7 +268,7 @@ Like `semanticdb-find-tags-for-completion-method' for javascript."
;;; Advanced Searches
;;
(cl-defmethod semanticdb-find-tags-external-children-of-type-method
- ((table semanticdb-table-javascript) type &optional tags)
+ ((_table semanticdb-table-javascript) _type &optional tags)
"Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index aa4634faa98..839dcb8172d 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -1,4 +1,4 @@
-;;; semantic/db-mode.el --- Semanticdb Minor Mode
+;;; semantic/db-mode.el --- Semanticdb Minor Mode -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index da09f9830a7..10108d39772 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -1,6 +1,6 @@
-;;; semantic/db-ref.el --- Handle cross-db file references
+;;; semantic/db-ref.el --- Handle cross-db file references -*- lexical-binding: t; -*-
-;;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -67,7 +67,7 @@ will be added to the database that INCLUDE-TAG refers to."
(object-add-to-list refdbt 'db-refs dbt)
t)))
-(cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-check-references ((_dbt semanticdb-abstract-table))
"Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references.
@@ -109,7 +109,7 @@ refers to DBT will be removed."
))
(setq refs (cdr refs)))))
-(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-refresh-references ((_dbt semanticdb-abstract-table))
"Refresh references to DBT in other files."
;; alternate tables can't be edited, so can't be changed.
nil
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index 8c394cd7fa9..c0fee3b2bd9 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -1,4 +1,4 @@
-;;; semantic/db-typecache.el --- Manage Datatypes
+;;; semantic/db-typecache.el --- Manage Datatypes -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -74,14 +74,14 @@ Said object must support `semantic-reset' methods.")
(oset tc stream nil)
- (mapc 'semantic-reset (oref tc dependants))
+ (mapc #'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
(cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
"Do a reset from a notify from a table we depend on."
(oset tc includestream nil)
- (mapc 'semantic-reset (oref tc dependants))
+ (mapc #'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
@@ -90,7 +90,7 @@ Said object must support `semantic-reset' methods.")
"Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags)
(oset tc includestream nil)
- (mapc 'semantic-reset (oref tc dependants))
+ (mapc #'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
@@ -167,15 +167,15 @@ If there is no table, create one, and fill it in."
(oset tc stream nil)
)
-(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
- new-tags)
+(cl-defmethod semanticdb-synchronize ((_cache semanticdb-database-typecache)
+ _new-tags)
"Synchronize a CACHE with some NEW-TAGS."
- )
+ nil)
-(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
- new-tags)
+(cl-defmethod semanticdb-partial-synchronize ((_cache semanticdb-database-typecache)
+ _new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
- )
+ nil)
(cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database))
"Retrieve the typecache from the semantic database DB.
@@ -312,7 +312,7 @@ If TAG has fully qualified names, expand it to a series of nested
namespaces instead."
tag)
-(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-file-tags ((_table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
@@ -338,7 +338,7 @@ all included files."
(oref cache filestream)
))
-(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-include-tags ((_table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
@@ -611,7 +611,7 @@ If there isn't one, create it.
(require 'data-debug)
(let* ((tab semanticdb-current-table)
(idx (semanticdb-get-table-index tab))
- (junk (oset idx type-cache nil)) ;; flush!
+ (_ (oset idx type-cache nil)) ;; flush!
(start (current-time))
(tc (semanticdb-typecache-for-database (oref tab parent-db)))
(end (current-time))
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 8f9eceea554..38e2b34b0db 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -321,12 +321,12 @@ Adds the number of tags in this file to the object print name."
'(list-of semanticdb-abstract-table))
(defclass semanticdb-project-database (eieio-instance-tracker)
- ((tracking-symbol :initform semanticdb-database-list)
+ ((tracking-symbol :initform 'semanticdb-database-list)
(reference-directory :type string
:documentation "Directory this database refers to.
When a cache directory is specified, then this refers to the directory
this database contains symbols for.")
- (new-table-class :initform semanticdb-table
+ (new-table-class :initform 'semanticdb-table
:type class
:documentation
"New tables created for this database are of this class.")
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index ce4afbbf26d..4f96746166b 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -1,4 +1,4 @@
-;;; semantic/debug.el --- Language Debugger framework
+;;; semantic/debug.el --- Language Debugger framework -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2005, 2008-2021 Free Software Foundation, Inc.
@@ -265,12 +265,12 @@ on different types of return values."
)
"One frame representation.")
-(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((_frame semantic-debug-frame))
"Highlight one parser frame."
)
-(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((_frame semantic-debug-frame))
"Display info about this one parser frame."
)
@@ -279,21 +279,21 @@ on different types of return values."
;;
(defvar semantic-debug-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "n" 'semantic-debug-next)
- (define-key km " " 'semantic-debug-next)
- (define-key km "s" 'semantic-debug-step)
- (define-key km "u" 'semantic-debug-up)
- (define-key km "d" 'semantic-debug-down)
- (define-key km "f" 'semantic-debug-fail-match)
- (define-key km "h" 'semantic-debug-print-state)
- (define-key km "s" 'semantic-debug-jump-to-source)
- (define-key km "p" 'semantic-debug-jump-to-parser)
- (define-key km "q" 'semantic-debug-quit)
- (define-key km "a" 'semantic-debug-abort)
- (define-key km "g" 'semantic-debug-go)
- (define-key km "b" 'semantic-debug-set-breakpoint)
+ (define-key km "n" #'semantic-debug-next)
+ (define-key km " " #'semantic-debug-next)
+ (define-key km "s" #'semantic-debug-step)
+ (define-key km "u" #'semantic-debug-up)
+ (define-key km "d" #'semantic-debug-down)
+ (define-key km "f" #'semantic-debug-fail-match)
+ (define-key km "h" #'semantic-debug-print-state)
+ (define-key km "s" #'semantic-debug-jump-to-source)
+ (define-key km "p" #'semantic-debug-jump-to-parser)
+ (define-key km "q" #'semantic-debug-quit)
+ (define-key km "a" #'semantic-debug-abort)
+ (define-key km "g" #'semantic-debug-go)
+ (define-key km "b" #'semantic-debug-set-breakpoint)
;; Some boring bindings.
- (define-key km "e" 'eval-expression)
+ (define-key km "e" #'eval-expression)
km)
"Keymap used when in semantic-debug-node.")
@@ -514,49 +514,49 @@ by overriding one of the command methods. Be sure to use
down to your parser later."
:abstract t)
-(cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-next ((_parser semantic-debug-parser))
"Execute next for this PARSER."
(setq semantic-debug-user-command 'next)
)
-(cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-step ((_parser semantic-debug-parser))
"Execute a step for this PARSER."
(setq semantic-debug-user-command 'step)
)
-(cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-go ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'go)
)
-(cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-fail ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'fail)
)
-(cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-quit ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'quit)
)
-(cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-abort ((_parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'abort)
)
-(cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-print-state ((_parser semantic-debug-parser))
"Print state for this PARSER at the current breakpoint."
(with-slots (current-frame) semantic-debug-current-interface
(when current-frame
(semantic-debug-frame-info current-frame)
)))
-(cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-break ((_parser semantic-debug-parser))
"Set a breakpoint for this PARSER."
)
;; Stack stuff
-(cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-frames ((_parser semantic-debug-parser))
"Return a list of frames for the current parser.
A frame is of the form:
( .. .what ? .. )
diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el
index 53c54ab4cc8..3e6651df152 100644
--- a/lisp/cedet/semantic/decorate.el
+++ b/lisp/cedet/semantic/decorate.el
@@ -1,7 +1,6 @@
-;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens.
+;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens. -*- lexical-binding: t; -*-
-;;; Copyright (C) 1999-2003, 2005-2007, 2009-2021 Free Software
-;;; Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -51,7 +50,7 @@ Optional FACE specifies the face to use."
))
;;; Momentary Highlighting - One line
-(defun semantic-momentary-highlight-one-tag-line (tag &optional face)
+(defun semantic-momentary-highlight-one-tag-line (tag &optional _face)
"Highlight the first line of TAG, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting."
(save-excursion
@@ -88,7 +87,7 @@ If VISIBLE is non-nil, make the text visible."
(overlay-get (semantic-tag-overlay tag) 'invisible))
(defun semantic-overlay-signal-read-only
- (overlay after start end &optional len)
+ (overlay after start end &optional _len)
"Hook used in modification hooks to prevent modification.
Allows deletion of the entire text.
Argument OVERLAY, AFTER, START, END, and LEN are passed in by the system."
@@ -261,7 +260,7 @@ nil implies the tag should be fully shown."
(declare-function semantic-current-tag "semantic/find")
-(defun semantic-set-tag-folded-isearch (overlay)
+(defun semantic-set-tag-folded-isearch (_overlay)
"Called by isearch if it discovers text in the folded region.
OVERLAY is passed in by isearch."
(semantic-set-tag-folded (semantic-current-tag) nil)
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index ee7fad1fc5f..a3bf4e252f7 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -1,4 +1,4 @@
-;;; semantic/decorate/include.el --- Decoration modes for include statements
+;;; semantic/decorate/include.el --- Decoration modes for include statements -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -55,7 +55,7 @@ Used by the decoration style: `semantic-decoration-on-includes'."
(defvar semantic-decoration-on-include-map
(let ((km (make-sparse-keymap)))
- (define-key km semantic-decoration-mouse-3 'semantic-decoration-include-menu)
+ (define-key km semantic-decoration-mouse-3 #'semantic-decoration-include-menu)
km)
"Keymap used on includes.")
@@ -114,7 +114,7 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'."
(defvar semantic-decoration-on-unknown-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
- (define-key km semantic-decoration-mouse-3 'semantic-decoration-unknown-include-menu)
+ (define-key km semantic-decoration-mouse-3 #'semantic-decoration-unknown-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -169,7 +169,7 @@ Used by the decoration style: `semantic-decoration-on-fileless-includes'."
(defvar semantic-decoration-on-fileless-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
- (define-key km semantic-decoration-mouse-3 'semantic-decoration-fileless-include-menu)
+ (define-key km semantic-decoration-mouse-3 #'semantic-decoration-fileless-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -223,7 +223,7 @@ Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
(defvar semantic-decoration-on-unparsed-include-map
(let ((km (make-sparse-keymap)))
- (define-key km semantic-decoration-mouse-3 'semantic-decoration-unparsed-include-menu)
+ (define-key km semantic-decoration-mouse-3 #'semantic-decoration-unparsed-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -535,7 +535,7 @@ Argument EVENT is the mouse clicked event."
(interactive)
(let* ((tag (semantic-current-tag))
(table (semanticdb-find-table-for-include tag (current-buffer)))
- (mm major-mode))
+ ) ;; (mm major-mode)
(with-output-to-temp-buffer (help-buffer) ; "*Help*"
(help-setup-xref (list #'semantic-decoration-fileless-include-describe)
(called-interactively-p 'interactive))
@@ -793,7 +793,7 @@ any decorated referring includes.")
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
(semanticdb-notify-references
- table (lambda (tab me)
+ table (lambda (tab _me)
(semantic-decoration-unparsed-include-refrence-reset tab)
))
))
@@ -805,7 +805,7 @@ any decorated referring includes.")
(semantic-reset cache)))
(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
- new-tags)
+ _new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index 884b066d77f..c6bf15205fd 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -1,4 +1,4 @@
-;;; semantic/decorate/mode.el --- Minor mode for decorating tags
+;;; semantic/decorate/mode.el --- Minor mode for decorating tags -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
@@ -254,7 +254,7 @@ available and the current buffer was set up for parsing. Return
non-nil if the minor mode is enabled."
;;
;;\\{semantic-decoration-map}"
- nil nil nil
+ :lighter nil
(if semantic-decoration-mode
(if (not (and (featurep 'semantic) (semantic-active-p)))
(progn
@@ -264,9 +264,9 @@ non-nil if the minor mode is enabled."
(buffer-name)))
;; Add hooks
(add-hook 'semantic-after-partial-cache-change-hook
- 'semantic-decorate-tags-after-partial-reparse nil t)
+ #'semantic-decorate-tags-after-partial-reparse nil t)
(add-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-decorate-tags-after-full-reparse nil t)
+ #'semantic-decorate-tags-after-full-reparse nil t)
;; Add decorations to available tags. The above hooks ensure
;; that new tags will be decorated when they become available.
;; However, don't do this immediately, because EDE will be
@@ -282,9 +282,9 @@ non-nil if the minor mode is enabled."
(semantic-decorate-flush-decorations)
;; Remove hooks
(remove-hook 'semantic-after-partial-cache-change-hook
- 'semantic-decorate-tags-after-partial-reparse t)
+ #'semantic-decorate-tags-after-partial-reparse t)
(remove-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-decorate-tags-after-full-reparse t)))
+ #'semantic-decorate-tags-after-full-reparse t)))
(semantic-add-minor-mode 'semantic-decoration-mode
"")
@@ -350,20 +350,18 @@ Return non-nil if the decoration style is enabled."
(defun semantic-decoration-build-style-menu (style)
"Build a menu item for controlling a specific decoration STYLE."
- (vector (car style)
- `(lambda () (interactive)
- (semantic-toggle-decoration-style
- ,(car style)))
- :style 'toggle
- :selected `(semantic-decoration-style-enabled-p ,(car style))
- ))
-
-(defun semantic-build-decoration-mode-menu (&rest ignore)
+ (let ((s (car style)))
+ (vector s
+ (lambda () (interactive) (semantic-toggle-decoration-style s))
+ :style 'toggle
+ :selected `(semantic-decoration-style-enabled-p ',s))))
+
+(defun semantic-build-decoration-mode-menu (&rest _ignore)
"Create a menu listing all the known decorations for toggling.
IGNORE any input arguments."
(or semantic-decoration-menu-cache
(setq semantic-decoration-menu-cache
- (mapcar 'semantic-decoration-build-style-menu
+ (mapcar #'semantic-decoration-build-style-menu
(reverse semantic-decoration-styles))
)))
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index db8be5ecf47..efebe21a945 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -1,4 +1,4 @@
-;;; semantic/dep.el --- Methods for tracking dependencies (include files)
+;;; semantic/dep.el --- Methods for tracking dependencies (include files) -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -123,12 +123,12 @@ Changes made by this function are not persistent."
(if (not mode) (setq mode major-mode))
(let ((dirtmp (file-name-as-directory dir))
(value
- (mode-local-value mode 'semantic-dependency-system-include-path))
- )
- (add-to-list 'value dirtmp t)
+ (mode-local-value mode 'semantic-dependency-system-include-path)))
(eval `(setq-mode-local ,mode
- semantic-dependency-system-include-path value))
- ))
+ semantic-dependency-system-include-path
+ ',(if (member dirtmp value) value
+ (append value (list dirtmp))))
+ t)))
;;;###autoload
(defun semantic-remove-system-include (dir &optional mode)
@@ -146,10 +146,10 @@ Changes made by this function are not persistent."
(value
(mode-local-value mode 'semantic-dependency-system-include-path))
)
- (setq value (delete dirtmp value))
+ (setq value (remove dirtmp value))
(eval `(setq-mode-local ,mode semantic-dependency-system-include-path
- value))
- ))
+ ',value)
+ t)))
;;;###autoload
(defun semantic-reset-system-include (&optional mode)
@@ -157,10 +157,10 @@ Changes made by this function are not persistent."
Modifies a mode-local version of
`semantic-dependency-system-include-path'."
(interactive)
- (if (not mode) (setq mode major-mode))
- (eval `(setq-mode-local ,mode semantic-dependency-system-include-path
- nil))
- )
+ (eval `(setq-mode-local ,(or mode major-mode)
+ semantic-dependency-system-include-path
+ nil)
+ t))
;;;###autoload
(defun semantic-customize-system-include-path (&optional mode)
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index d4dd9286421..413ed83a154 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -1,4 +1,4 @@
-;;; semantic/doc.el --- Routines for documentation strings
+;;; semantic/doc.el --- Routines for documentation strings -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2003, 2005, 2008-2021 Free Software Foundation,
;; Inc.
@@ -85,7 +85,7 @@ just the lexical token and not the string."
))
(define-obsolete-function-alias
'semantic-documentation-comment-preceeding-tag
- 'semantic-documentation-comment-preceding-tag
+ #'semantic-documentation-comment-preceding-tag
"25.1")
(defun semantic-doc-snarf-comment-for-tag (nosnarf)
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index bd0795acbd6..19d4184fa45 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,4 +1,4 @@
-;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
+;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
@@ -30,6 +30,7 @@
(require 'ede/pconf)
(require 'ede/proj-elisp)
(require 'semantic/grammar)
+(eval-when-compile (require 'cl-lib))
;;; Code:
(defclass semantic-ede-proj-target-grammar (ede-proj-target-elisp)
@@ -37,13 +38,13 @@
(keybindings :initform nil)
(phony :initform t)
(sourcetype :initform
- (semantic-ede-source-grammar-wisent
- semantic-ede-source-grammar-bovine
- ))
+ '(semantic-ede-source-grammar-wisent
+ semantic-ede-source-grammar-bovine
+ ))
(availablecompilers :initform
- (semantic-ede-grammar-compiler-wisent
- semantic-ede-grammar-compiler-bovine
- ))
+ '(semantic-ede-grammar-compiler-wisent
+ semantic-ede-grammar-compiler-bovine
+ ))
(aux-packages :initform '("semantic" "cedet-compat"))
(pre-load-packages :initform '("cedet-compat" "semantic/grammar" "semantic/bovine/grammar" "semantic/wisent/grammar"))
)
@@ -118,7 +119,7 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs.")
;;; Target options.
-(cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
+(cl-defmethod ede-buffer-mine ((_this semantic-ede-proj-target-grammar) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all -by.el, and -wy.el files."
;; We need to be a little more careful than this, but at the moment it
@@ -130,7 +131,7 @@ Lays claim to all -by.el, and -wy.el files."
(cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
"Compile all sources in a Lisp target OBJ."
- (let* ((cb (current-buffer))
+ (let* (;; (cb (current-buffer))
(proj (ede-target-parent obj))
(default-directory (oref proj directory))
(comp 0)
@@ -141,11 +142,10 @@ Lays claim to all -by.el, and -wy.el files."
(fname (progn (string-match ".*/\\(.+\\.el\\)" package)
(match-string 1 package)))
(src (ede-expand-filename obj fname))
- (csrc (concat (file-name-sans-extension src) ".elc")))
- (with-no-warnings
- (if (eq (byte-recompile-file src nil 0) t)
- (setq comp (1+ comp))
- (setq utd (1+ utd)))))))
+ ;; (csrc (concat (file-name-sans-extension src) ".elc"))
+ )
+ (cl-incf (if (eq (byte-recompile-file src nil 0) t)
+ comp utd)))))
(oref obj source))
(message "All Semantic Grammar sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
@@ -162,10 +162,9 @@ Lays claim to all -by.el, and -wy.el files."
"Insert variables needed by target THIS."
(ede-proj-makefile-insert-loadpath-items
(ede-proj-elisp-packages-to-loadpath
- (list "eieio" "semantic" "inversion" "ede")))
+ (list "eieio" "semantic" "ede")))
;; eieio for object system needed in ede
;; semantic because it is
- ;; Inversion for versioning system.
;; ede for project regeneration
(ede-pmake-insert-variable-shared
(concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL")
@@ -174,8 +173,7 @@ Lays claim to all -by.el, and -wy.el files."
(with-current-buffer (find-file-noselect src)
(concat (semantic-grammar-package) ".el")))
(oref this source)
- " ")))
- )
+ " "))))
(cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
"Insert rules needed by THIS target.
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index f39cc093cc9..b2e56360cf7 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -1,4 +1,4 @@
-;;; semantic/edit.el --- Edit Management for Semantic
+;;; semantic/edit.el --- Edit Management for Semantic -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -154,10 +154,10 @@ Optional argument BUFFER is the buffer to search for changes in."
(when (overlay-get (car ol) 'semantic-change)
(setq ret (cons (car ol) ret)))
(setq ol (cdr ol)))
- (sort ret #'(lambda (a b) (< (overlay-start a)
- (overlay-start b)))))))
+ (sort ret (lambda (a b) (< (overlay-start a)
+ (overlay-start b)))))))
-(defun semantic-edits-change-function-handle-changes (start end length)
+(defun semantic-edits-change-function-handle-changes (start end _length)
"Run whenever a buffer controlled by `semantic-mode' change.
Tracks when and how the buffer is re-parsed.
Argument START, END, and LENGTH specify the bounds of the change."
@@ -356,7 +356,7 @@ See `semantic-edits-change-leaf-tag' for details on parents."
start end)))
(parent nil)
(overlapped-tags nil)
- inner-start inner-end
+ inner-end ;; inner-start
(list-to-search nil))
;; By the time this is already called, we know that it is
;; not a leaf change, nor a between tag change. That leaves
@@ -370,7 +370,7 @@ See `semantic-edits-change-leaf-tag' for details on parents."
(progn
;; We encompass one whole change.
(setq overlapped-tags (list (car tags))
- inner-start (semantic-tag-start (car tags))
+ ;; inner-start (semantic-tag-start (car tags))
inner-end (semantic-tag-end (car tags))
tags (cdr tags))
;; Keep looping while tags are inside the change.
@@ -386,13 +386,14 @@ See `semantic-edits-change-leaf-tag' for details on parents."
;; This is a parent. Drop the children found
;; so far.
(setq overlapped-tags (list (car tags))
- inner-start (semantic-tag-start (car tags))
+ ;; inner-start (semantic-tag-start (car tags))
inner-end (semantic-tag-end (car tags))
)
;; It is not a parent encompassing tag
(setq overlapped-tags (cons (car tags)
overlapped-tags)
- inner-start (semantic-tag-start (car tags))))
+ ;; inner-start (semantic-tag-start (car tags))
+ ))
(setq tags (cdr tags)))
(if (not tags)
;; There are no tags left, and all tags originally
@@ -533,6 +534,7 @@ This function is for internal use by `semantic-edits-incremental-parser'."
;query this when debugging to find
;source of bugs.
)
+ (ignore last-cond) ;; Don't warn about the var not being used.
(or changes
;; If we were called, and there are no changes, then we
;; don't know what to do. Force a full reparse.
@@ -828,8 +830,7 @@ This function is for internal use by `semantic-edits-incremental-parser'."
;; Make it the default changes parser
;;;###autoload
-(defalias 'semantic-parse-changes-default
- 'semantic-edits-incremental-parser)
+(defalias 'semantic-parse-changes-default #'semantic-edits-incremental-parser)
;;; Cache Splicing
;;
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index 706892b4861..17fb20fa0a0 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -1,4 +1,4 @@
-;;; semantic/find.el --- Search routines for Semantic
+;;; semantic/find.el --- Search routines for Semantic -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2008-2021 Free Software Foundation, Inc.
@@ -583,7 +583,7 @@ Optional argument SEARCH-PARTS and SEARCH-INCLUDES are passed to
)
(defun semantic-brute-find-tag-by-function
- (function streamorbuffer &optional search-parts search-includes)
+ (function streamorbuffer &optional search-parts _search-includes)
"Find all tags for which FUNCTION's value is non-nil within STREAMORBUFFER.
FUNCTION must return non-nil if an element of STREAM will be included
in the new list.
@@ -620,7 +620,7 @@ This parameter hasn't be active for a while and is obsolete."
nl))
(defun semantic-brute-find-first-tag-by-function
- (function streamorbuffer &optional search-parts search-includes)
+ (function streamorbuffer &optional _search-parts _search-includes)
"Find the first tag which FUNCTION match within STREAMORBUFFER.
FUNCTION must return non-nil if an element of STREAM will be included
in the new list.
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index 8927ccde843..a68ef8064d1 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -1,4 +1,4 @@
-;;; semantic/format.el --- Routines for formatting tags
+;;; semantic/format.el --- Routines for formatting tags -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@@ -162,7 +162,7 @@ COLOR specifies if color should be used."
(car args) nil color 'variable))
out)
(setq args (cdr args)))
- (mapconcat 'identity (nreverse out) semantic-function-argument-separator)
+ (mapconcat #'identity (nreverse out) semantic-function-argument-separator)
))
;;; Data Type
@@ -200,7 +200,7 @@ Argument COLOR specifies to colorize the text."
;;; Abstract formatting functions
;;
-(defun semantic-format-tag-prin1 (tag &optional parent color)
+(defun semantic-format-tag-prin1 (tag &optional _parent _color)
"Convert TAG to a string that is the print name for TAG.
PARENT and COLOR are ignored."
(format "%S" tag))
@@ -237,7 +237,7 @@ The name is the shortest possible representation.
Optional argument PARENT is the parent type if TAG is a detail.
Optional argument COLOR means highlight the prototype with font-lock colors.")
-(defun semantic-format-tag-name-default (tag &optional parent color)
+(defun semantic-format-tag-name-default (tag &optional _parent color)
"Return an abbreviated string describing TAG.
Optional argument PARENT is the parent type if TAG is a detail.
Optional argument COLOR means highlight the prototype with font-lock colors."
@@ -500,7 +500,7 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
args
(if (eq class 'type) "}" ")"))))
(when mods
- (setq mods (concat (mapconcat 'identity mods " ") " ")))
+ (setq mods (concat (mapconcat #'identity mods " ") " ")))
(concat (or mods "")
(if type (concat type " "))
name
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 91944c44f5e..4ad70ff7c64 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -1,6 +1,6 @@
-;;; semantic/fw.el --- Framework for Semantic
+;;; semantic/fw.el --- Framework for Semantic -*- lexical-binding: t; -*-
-;;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -34,29 +34,29 @@
;;; Compatibility
;;
-(define-obsolete-function-alias 'semantic-overlay-live-p 'overlay-buffer "27.1")
-(define-obsolete-function-alias 'semantic-make-overlay 'make-overlay "27.1")
-(define-obsolete-function-alias 'semantic-overlay-put 'overlay-put "27.1")
-(define-obsolete-function-alias 'semantic-overlay-get 'overlay-get "27.1")
+(define-obsolete-function-alias 'semantic-overlay-live-p #'overlay-buffer "27.1")
+(define-obsolete-function-alias 'semantic-make-overlay #'make-overlay "27.1")
+(define-obsolete-function-alias 'semantic-overlay-put #'overlay-put "27.1")
+(define-obsolete-function-alias 'semantic-overlay-get #'overlay-get "27.1")
(define-obsolete-function-alias 'semantic-overlay-properties
- 'overlay-properties "27.1")
-(define-obsolete-function-alias 'semantic-overlay-move 'move-overlay "27.1")
-(define-obsolete-function-alias 'semantic-overlay-delete 'delete-overlay "27.1")
-(define-obsolete-function-alias 'semantic-overlays-at 'overlays-at "27.1")
-(define-obsolete-function-alias 'semantic-overlays-in 'overlays-in "27.1")
-(define-obsolete-function-alias 'semantic-overlay-buffer 'overlay-buffer "27.1")
-(define-obsolete-function-alias 'semantic-overlay-start 'overlay-start "27.1")
-(define-obsolete-function-alias 'semantic-overlay-end 'overlay-end "27.1")
+ #'overlay-properties "27.1")
+(define-obsolete-function-alias 'semantic-overlay-move #'move-overlay "27.1")
+(define-obsolete-function-alias 'semantic-overlay-delete #'delete-overlay "27.1")
+(define-obsolete-function-alias 'semantic-overlays-at #'overlays-at "27.1")
+(define-obsolete-function-alias 'semantic-overlays-in #'overlays-in "27.1")
+(define-obsolete-function-alias 'semantic-overlay-buffer #'overlay-buffer "27.1")
+(define-obsolete-function-alias 'semantic-overlay-start #'overlay-start "27.1")
+(define-obsolete-function-alias 'semantic-overlay-end #'overlay-end "27.1")
(define-obsolete-function-alias 'semantic-overlay-next-change
- 'next-overlay-change "27.1")
+ #'next-overlay-change "27.1")
(define-obsolete-function-alias 'semantic-overlay-previous-change
- 'previous-overlay-change "27.1")
-(define-obsolete-function-alias 'semantic-overlay-lists 'overlay-lists "27.1")
-(define-obsolete-function-alias 'semantic-overlay-p 'overlayp "27.1")
-(define-obsolete-function-alias 'semantic-read-event 'read-event "27.1")
-(define-obsolete-function-alias 'semantic-popup-menu 'popup-menu "27.1")
+ #'previous-overlay-change "27.1")
+(define-obsolete-function-alias 'semantic-overlay-lists #'overlay-lists "27.1")
+(define-obsolete-function-alias 'semantic-overlay-p #'overlayp "27.1")
+(define-obsolete-function-alias 'semantic-read-event #'read-event "27.1")
+(define-obsolete-function-alias 'semantic-popup-menu #'popup-menu "27.1")
(define-obsolete-function-alias 'semantic-buffer-local-value
- 'buffer-local-value "27.1")
+ #'buffer-local-value "27.1")
(defun semantic-event-window (event)
"Extract the window from EVENT."
@@ -68,11 +68,11 @@
;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
;; run major mode hooks.
-(define-obsolete-function-alias 'semantic-run-mode-hooks 'run-mode-hooks "28.1")
+(define-obsolete-function-alias 'semantic-run-mode-hooks #'run-mode-hooks "28.1")
;; Fancy compat usage now handled in cedet-compat
(define-obsolete-function-alias 'semantic-subst-char-in-string
- 'subst-char-in-string "28.1")
+ #'subst-char-in-string "28.1")
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
@@ -111,7 +111,7 @@ Possible Lifespans are:
(setq semantic-cache-data-overlays
(cons o semantic-cache-data-overlays))
;;(message "Adding to cache: %s" o)
- (add-hook 'post-command-hook 'semantic-cache-data-post-command-hook)
+ (add-hook 'post-command-hook #'semantic-cache-data-post-command-hook)
))
(defun semantic-cache-data-post-command-hook ()
@@ -137,7 +137,7 @@ Remove self from `post-command-hook' if it is empty."
;; Remove ourselves if we have removed all overlays.
(unless semantic-cache-data-overlays
(remove-hook 'post-command-hook
- 'semantic-cache-data-post-command-hook)))
+ #'semantic-cache-data-post-command-hook)))
(defun semantic-get-cache-data (name &optional point)
"Get cached data with NAME from optional POINT."
@@ -189,14 +189,13 @@ will throw a warning when it encounters this symbol."
(when (and (mode-local--function-overload-p newfn)
(not (mode-local--overload-obsoleted-by newfn))
;; Only throw this warning when byte compiling things.
- (boundp 'byte-compile-current-file)
- byte-compile-current-file
- (not (string-match "cedet" byte-compile-current-file))
+ (macroexp-compiling-p)
+ (not (string-match "cedet" (macroexp-file-name)))
)
(make-obsolete-overload oldfnalias newfn when)
(byte-compile-warn
"%s: `%s' obsoletes overload `%s'"
- byte-compile-current-file
+ (macroexp-file-name)
newfn
(with-suppressed-warnings ((obsolete semantic-overload-symbol-from-function))
(semantic-overload-symbol-from-function oldfnalias)))))
@@ -211,8 +210,7 @@ will throw a warning when it encounters this symbol."
(defvaralias oldvaralias newvar)
(error
;; Only throw this warning when byte compiling things.
- (when (and (boundp 'byte-compile-current-file)
- byte-compile-current-file)
+ (when (macroexp-compiling-p)
(byte-compile-warn
"variable `%s' obsoletes, but isn't alias of `%s'"
newvar oldvaralias)
@@ -256,7 +254,7 @@ FUNCTION does not have arguments. When FUNCTION is entered
`current-buffer' is a selected Semantic enabled buffer."
(mode-local-map-file-buffers function #'semantic-active-p))
-(defalias 'semantic-map-mode-buffers 'mode-local-map-mode-buffers)
+(defalias 'semantic-map-mode-buffers #'mode-local-map-mode-buffers)
(defun semantic-install-function-overrides (overrides &optional transient)
"Install the function OVERRIDES in the specified environment.
@@ -272,11 +270,11 @@ later installation should be done in MODE hook."
(mode-local-bind
;; Add the semantic- prefix to OVERLOAD short names.
(mapcar
- #'(lambda (e)
- (let ((name (symbol-name (car e))))
- (if (string-match "^semantic-" name)
- e
- (cons (intern (format "semantic-%s" name)) (cdr e)))))
+ (lambda (e)
+ (let ((name (symbol-name (car e))))
+ (if (string-match "^semantic-" name)
+ e
+ (cons (intern (format "semantic-%s" name)) (cdr e)))))
overrides)
(list 'constant-flag (not transient)
'override-flag t)))
@@ -320,21 +318,17 @@ calling this one."
;;; Special versions of Find File
;;
+(defvar recentf-exclude)
+(defvar semantic-init-hook)
+(defvar ede-auto-add-method)
+(defvar flymake-start-syntax-check-on-find-file)
+(defvar auto-insert)
+
(defun semantic-find-file-noselect (file &optional nowarn rawfile wildcards)
"Call `find-file-noselect' with various features turned off.
Use this when referencing a file that will be soon deleted.
FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'."
- ;; Hack -
- ;; Check if we are in set-auto-mode, and if so, warn about this.
- (when (boundp 'keep-mode-if-same)
- (let ((filename (or (and (boundp 'filename) filename)
- "(unknown)")))
- (message "WARNING: semantic-find-file-noselect called for \
-%s while in set-auto-mode for %s. You should call the responsible function \
-into `mode-local-init-hook'." file filename)
- (sit-for 1)))
-
- (let* ((recentf-exclude '( (lambda (f) t) ))
+ (let* ((recentf-exclude #'always)
;; This is a brave statement. Don't waste time loading in
;; lots of modes. Especially decoration mode can waste a lot
;; of time for a buffer we intend to kill.
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
deleted file mode 100644
index 12c9c047fc5..00000000000
--- a/lisp/cedet/semantic/grammar-wy.el
+++ /dev/null
@@ -1,496 +0,0 @@
-;;; semantic/grammar-wy.el --- Generated parser support file
-
-;; Copyright (C) 2002-2004, 2009-2021 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/grammar.wy.
-
-;;; Code:
-
-(require 'semantic)
-
-;;; Prologue
-;;
-(defvar semantic-grammar-lex-c-char-re)
-
-;; Current parsed nonterminal name.
-(defvar semantic-grammar-wy--nterm nil)
-;; Index of rule in a nonterminal clause.
-(defvar semantic-grammar-wy--rindx nil)
-
-;;; Declarations
-;;
-(defconst semantic-grammar-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("%default-prec" . DEFAULT-PREC)
- ("%no-default-prec" . NO-DEFAULT-PREC)
- ("%keyword" . KEYWORD)
- ("%expectedconflicts" . EXPECTEDCONFLICTS)
- ("%languagemode" . LANGUAGEMODE)
- ("%left" . LEFT)
- ("%nonassoc" . NONASSOC)
- ("%package" . PACKAGE)
- ("%provide" . PROVIDE)
- ("%prec" . PREC)
- ("%put" . PUT)
- ("%quotemode" . QUOTEMODE)
- ("%right" . RIGHT)
- ("%scopestart" . SCOPESTART)
- ("%start" . START)
- ("%token" . TOKEN)
- ("%type" . TYPE)
- ("%use-macros" . USE-MACROS))
- 'nil)
- "Table of language keywords.")
-
-(defconst semantic-grammar-wy--token-table
- (semantic-lex-make-type-table
- '(("punctuation"
- (GT . ">")
- (LT . "<")
- (OR . "|")
- (SEMI . ";")
- (COLON . ":"))
- ("close-paren"
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACE . "{")
- (LPAREN . "("))
- ("block"
- (BRACE_BLOCK . "(LBRACE RBRACE)")
- (PAREN_BLOCK . "(LPAREN RPAREN)"))
- ("code"
- (EPILOGUE . "%%...EOF")
- (PROLOGUE . "%{...%}"))
- ("sexp"
- (SEXP))
- ("qlist"
- (PREFIXED_LIST))
- ("char"
- (CHARACTER))
- ("symbol"
- (PERCENT_PERCENT . "\\`%%\\'")
- (SYMBOL))
- ("string"
- (STRING)))
- '(("punctuation" :declared t)
- ("block" :declared t)
- ("sexp" matchdatatype sexp)
- ("sexp" syntax "\\=")
- ("sexp" :declared t)
- ("qlist" matchdatatype sexp)
- ("qlist" syntax "\\s'\\s-*(")
- ("qlist" :declared t)
- ("char" syntax semantic-grammar-lex-c-char-re)
- ("char" :declared t)
- ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+")
- ("symbol" :declared t)
- ("string" :declared t)
- ("keyword" :declared t)))
- "Table of lexical tokens.")
-
-(defconst semantic-grammar-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE EXPECTEDCONFLICTS LEFT NONASSOC PACKAGE PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
- nil
- (grammar
- ((prologue))
- ((epilogue))
- ((declaration))
- ((nonterminal))
- ((PERCENT_PERCENT)))
- (prologue
- ((PROLOGUE)
- (wisent-raw-tag
- (semantic-tag-new-code "prologue" nil))))
- (epilogue
- ((EPILOGUE)
- (wisent-raw-tag
- (semantic-tag-new-code "epilogue" nil))))
- (declaration
- ((decl)
- (eval $1)))
- (decl
- ((default_prec_decl))
- ((no_default_prec_decl))
- ((languagemode_decl))
- ((expectedconflicts_decl))
- ((package_decl))
- ((provide_decl))
- ((precedence_decl))
- ((put_decl))
- ((quotemode_decl))
- ((scopestart_decl))
- ((start_decl))
- ((keyword_decl))
- ((token_decl))
- ((type_decl))
- ((use_macros_decl)))
- (default_prec_decl
- ((DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("t")))))
- (no_default_prec_decl
- ((NO-DEFAULT-PREC)
- `(wisent-raw-tag
- (semantic-tag "default-prec" 'assoc :value
- '("nil")))))
- (languagemode_decl
- ((LANGUAGEMODE symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'languagemode :rest ',(cdr $2)))))
- (expectedconflicts_decl
- ((EXPECTEDCONFLICTS symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'expectedconflicts :rest ',(cdr $2)))))
- (package_decl
- ((PACKAGE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag-new-package ',$2 nil))))
- (provide_decl
- ((PROVIDE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'provide))))
- (precedence_decl
- ((associativity token_type_opt items)
- `(wisent-raw-tag
- (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
- (associativity
- ((LEFT)
- (progn "left"))
- ((RIGHT)
- (progn "right"))
- ((NONASSOC)
- (progn "nonassoc")))
- (put_decl
- ((PUT put_name put_value)
- `(wisent-raw-tag
- (semantic-tag ',$2 'put :value ',(list $3))))
- ((PUT put_name put_value_list)
- `(wisent-raw-tag
- (semantic-tag ',$2 'put :value ',$3)))
- ((PUT put_name_list put_value)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'put :rest ',(cdr $2)
- :value ',(list $3))))
- ((PUT put_name_list put_value_list)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'put :rest ',(cdr $2)
- :value ',$3))))
- (put_name_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'put_names 1))))
- (put_names
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((put_name)
- (wisent-raw-tag
- (semantic-tag $1 'put-name))))
- (put_name
- ((SYMBOL))
- ((token_type)))
- (put_value_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-code-detail
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'put_values 1))))
- (put_values
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((put_value)
- (wisent-raw-tag
- (semantic-tag-new-code "put-value" $1))))
- (put_value
- ((SYMBOL any_value)
- (cons $1 $2)))
- (scopestart_decl
- ((SCOPESTART SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'scopestart))))
- (quotemode_decl
- ((QUOTEMODE SYMBOL)
- `(wisent-raw-tag
- (semantic-tag ',$2 'quotemode))))
- (start_decl
- ((START symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $2)
- 'start :rest ',(cdr $2)))))
- (keyword_decl
- ((KEYWORD SYMBOL string_value)
- `(wisent-raw-tag
- (semantic-tag ',$2 'keyword :value ',$3))))
- (token_decl
- ((TOKEN token_type_opt SYMBOL string_value)
- `(wisent-raw-tag
- (semantic-tag ',$3 ',(if $2 'token 'keyword)
- :type ',$2 :value ',$4)))
- ((TOKEN token_type_opt symbols)
- `(wisent-raw-tag
- (semantic-tag ',(car $3)
- 'token :type ',$2 :rest ',(cdr $3)))))
- (token_type_opt
- (nil)
- ((token_type)))
- (token_type
- ((LT SYMBOL GT)
- (progn $2)))
- (type_decl
- ((TYPE token_type plist_opt)
- `(wisent-raw-tag
- (semantic-tag ',$2 'type :value ',$3))))
- (plist_opt
- (nil)
- ((plist)))
- (plist
- ((plist put_value)
- (append
- (list $2)
- $1))
- ((put_value)
- (list $1)))
- (use_name_list
- ((BRACE_BLOCK)
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'use_names 1))))
- (use_names
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((SYMBOL)
- (wisent-raw-tag
- (semantic-tag $1 'use-name))))
- (use_macros_decl
- ((USE-MACROS SYMBOL use_name_list)
- `(wisent-raw-tag
- (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
- (string_value
- ((STRING)
- (read $1)))
- (any_value
- ((SYMBOL))
- ((STRING))
- ((PAREN_BLOCK))
- ((PREFIXED_LIST))
- ((SEXP)))
- (symbols
- ((lifo_symbols)
- (nreverse $1)))
- (lifo_symbols
- ((lifo_symbols SYMBOL)
- (cons $2 $1))
- ((SYMBOL)
- (list $1)))
- (nonterminal
- ((SYMBOL
- (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
- COLON rules SEMI)
- (wisent-raw-tag
- (semantic-tag $1 'nonterminal :children $4))))
- (rules
- ((lifo_rules)
- (apply 'nconc
- (nreverse $1))))
- (lifo_rules
- ((lifo_rules OR rule)
- (cons $3 $1))
- ((rule)
- (list $1)))
- (rule
- ((rhs)
- (let*
- ((nterm semantic-grammar-wy--nterm)
- (rindx semantic-grammar-wy--rindx)
- (rhs $1)
- comps prec action elt)
- (setq semantic-grammar-wy--rindx
- (1+ semantic-grammar-wy--rindx))
- (while rhs
- (setq elt
- (car rhs)
- rhs
- (cdr rhs))
- (cond
- ((vectorp elt)
- (if prec
- (error "Duplicate %%prec in `%s:%d' rule" nterm rindx))
- (setq prec
- (aref elt 0)))
- ((consp elt)
- (if
- (or action comps)
- (setq comps
- (cons elt comps)
- semantic-grammar-wy--rindx
- (1+ semantic-grammar-wy--rindx))
- (setq action
- (car elt))))
- (t
- (setq comps
- (cons elt comps)))))
- (wisent-cook-tag
- (wisent-raw-tag
- (semantic-tag
- (format "%s:%d" nterm rindx)
- 'rule :type
- (if comps "group" "empty")
- :value comps :prec prec :expr action))))))
- (rhs
- (nil)
- ((rhs item)
- (cons $2 $1))
- ((rhs action)
- (cons
- (list $2)
- $1))
- ((rhs PREC item)
- (cons
- (vector $3)
- $1)))
- (action
- ((PAREN_BLOCK))
- ((PREFIXED_LIST))
- ((BRACE_BLOCK)
- (format "(progn\n%s)"
- (let
- ((s $1))
- (if
- (string-match "^{[\r\n\t ]*" s)
- (setq s
- (substring s
- (match-end 0))))
- (if
- (string-match "[\r\n\t ]*}$" s)
- (setq s
- (substring s 0
- (match-beginning 0))))
- s))))
- (items
- ((lifo_items)
- (nreverse $1)))
- (lifo_items
- ((lifo_items item)
- (cons $2 $1))
- ((item)
- (list $1)))
- (item
- ((SYMBOL))
- ((CHARACTER))))
- '(grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)))
- "Parser table.")
-
-(defun semantic-grammar-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((semantic-parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table semantic-grammar-wy--parse-table
- semantic-debug-parser-source "grammar.wy"
- semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table
- semantic-lex-types-obarray semantic-grammar-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" LPAREN PAREN_BLOCK)
- ("{" LBRACE BRACE_BLOCK))
- (")" RPAREN)
- ("}" RBRACE))
- )
-
-(define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer
- "regexp analyzer for <char> tokens."
- semantic-grammar-lex-c-char-re
- nil
- 'CHARACTER)
-
-(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- ":?\\(\\sw\\|\\s_\\)+"
- '((PERCENT_PERCENT . "\\`%%\\'"))
- 'SYMBOL)
-
-(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer
- "sexp analyzer for <qlist> tokens."
- "\\s'\\s-*("
- 'PREFIXED_LIST)
-
-(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'STRING)
-
-(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((GT . ">")
- (LT . "<")
- (OR . "|")
- (SEMI . ";")
- (COLON . ":"))
- 'punctuation)
-
-(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer
- "sexp analyzer for <sexp> tokens."
- "\\="
- 'SEXP)
-
-
-;;; Epilogue
-;;
-
-
-
-
-(provide 'semantic/grammar-wy)
-
-;;; semantic/grammar-wy.el ends here
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 4551811c235..4c3bb6c238b 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,4 +1,4 @@
-;;; semantic/grammar.el --- Major mode framework for Semantic grammars
+;;; semantic/grammar.el --- Major mode framework for Semantic grammars -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2005, 2007-2021 Free Software Foundation, Inc.
@@ -23,9 +23,6 @@
;;
;; Major mode framework for editing Semantic's input grammar files.
-;;; History:
-;;
-
;;; Code:
(require 'semantic)
@@ -34,7 +31,12 @@
(require 'semantic/format)
;; FIXME this is a generated file, but we need to load this file to
;; generate it!
-(require 'semantic/grammar-wy)
+;; We need `semantic/grammar-wy.el' but we're also needed to generate
+;; that file from `grammar.wy', so to break the dependency, we keep
+;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008.
+(eval-and-compile
+ (unless (require 'semantic/grammar-wy nil t)
+ (load "semantic/grm-wy-boot")))
(require 'semantic/idle)
(require 'help-fns)
(require 'semantic/analyze)
@@ -143,12 +145,12 @@ It ignores whitespaces, newlines and comments."
ARGS are ASSOC's key value list."
(let ((key t))
`(semantic-tag-make-plist
- ,@(mapcar #'(lambda (i)
- (prog1
- (if key
- (list 'quote i)
- i)
- (setq key (not key))))
+ ,@(mapcar (lambda (i)
+ (prog1
+ (if key
+ (list 'quote i)
+ i)
+ (setq key (not key))))
args))))
(defsubst semantic-grammar-quote-p (sym)
@@ -191,13 +193,13 @@ Warn if other tags of class CLASS exist."
That is tag names plus names defined in tag attribute `:rest'."
(let* ((tags (semantic-find-tags-by-class
class (current-buffer))))
- (apply 'append
+ (apply #'append
(mapcar
- #'(lambda (tag)
- (mapcar
- 'intern
- (cons (semantic-tag-name tag)
- (semantic-tag-get-attribute tag :rest))))
+ (lambda (tag)
+ (mapcar
+ #'intern
+ (cons (semantic-tag-name tag)
+ (semantic-tag-get-attribute tag :rest))))
tags))))
(defsubst semantic-grammar-item-text (item)
@@ -298,9 +300,9 @@ foo.by it is foo-by."
That is an alist of (VALUE . TOKEN) where VALUE is the string value of
the keyword and TOKEN is the terminal symbol identifying the keyword."
(mapcar
- #'(lambda (key)
- (cons (semantic-tag-get-attribute key :value)
- (intern (semantic-tag-name key))))
+ (lambda (key)
+ (cons (semantic-tag-get-attribute key :value)
+ (intern (semantic-tag-name key))))
(semantic-find-tags-by-class 'keyword (current-buffer))))
(defun semantic-grammar-keyword-properties (keywords)
@@ -312,7 +314,7 @@ the keyword and TOKEN is the terminal symbol identifying the keyword."
(setq put (car puts)
puts (cdr puts)
keys (mapcar
- 'intern
+ #'intern
(cons (semantic-tag-name put)
(semantic-tag-get-attribute put :rest))))
(while keys
@@ -565,6 +567,10 @@ Typically a DEFINE expression should look like this:
(goto-char start)
(indent-sexp))))
+(defvar semantic-grammar-require-form
+ '(eval-when-compile (require 'semantic/bovine))
+ "The form to use to load the parser engine.")
+
(defconst semantic-grammar-header-template
'("\
;;; " file " --- Generated parser support file
@@ -596,13 +602,10 @@ Typically a DEFINE expression should look like this:
;; PLEASE DO NOT MANUALLY EDIT THIS FILE! It is automatically
;; generated from the grammar file " gram ".
-;;; History:
-;;
-
;;; Code:
(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
+" require-form "
")
"Generated header template.
The symbols in the template are local variables in
@@ -651,6 +654,7 @@ The symbols in the list are local variables in
semantic--grammar-output-buffer))
(gram . ,(semantic-grammar-buffer-file))
(date . ,(format-time-string "%Y-%m-%d %T%z"))
+ (require-form . ,(format "%S" semantic-grammar-require-form))
(vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
;; Try to get the copyright from the input grammar, or
;; generate a new one if not found.
@@ -818,7 +822,7 @@ Block definitions are read from the current table of lexical types."
(let ((semantic-lex-types-obarray
(semantic-lex-make-type-table tokens props))
semantic-grammar--lex-block-specs)
- (mapatoms 'semantic-grammar-insert-defanalyzer
+ (mapatoms #'semantic-grammar-insert-defanalyzer
semantic-lex-types-obarray))))
;;; Generation of the grammar support file.
@@ -846,7 +850,8 @@ Lisp code."
(semantic--grammar-package (semantic-grammar-package))
(semantic--grammar-provide (semantic-grammar-first-tag-name 'provide))
(output (concat (or semantic--grammar-provide
- semantic--grammar-package) ".el"))
+ semantic--grammar-package)
+ ".el"))
(semantic--grammar-input-buffer (current-buffer))
(semantic--grammar-output-buffer
(find-file-noselect
@@ -1063,7 +1068,7 @@ See also the variable `semantic-grammar-file-regexp'."
(setq semantic--grammar-macros-regexp-1
(concat "(\\s-*"
(regexp-opt
- (mapcar #'(lambda (e) (symbol-name (car e)))
+ (mapcar (lambda (e) (symbol-name (car e)))
semantic-grammar-macros)
t)
"\\>"))
@@ -1197,20 +1202,20 @@ END is the limit of the search."
(defvar semantic-grammar-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "|" 'semantic-grammar-electric-punctuation)
- (define-key km ";" 'semantic-grammar-electric-punctuation)
- (define-key km "%" 'semantic-grammar-electric-punctuation)
- (define-key km "(" 'semantic-grammar-electric-punctuation)
- (define-key km ")" 'semantic-grammar-electric-punctuation)
- (define-key km ":" 'semantic-grammar-electric-punctuation)
-
- (define-key km "\t" 'semantic-grammar-indent)
- (define-key km "\M-\t" 'semantic-grammar-complete)
- (define-key km "\C-c\C-c" 'semantic-grammar-create-package)
- (define-key km "\C-cm" 'semantic-grammar-find-macro-expander)
- (define-key km "\C-cik" 'semantic-grammar-insert-keyword)
-;; (define-key km "\C-cc" 'semantic-grammar-generate-and-load)
-;; (define-key km "\C-cr" 'semantic-grammar-generate-one-rule)
+ (define-key km "|" #'semantic-grammar-electric-punctuation)
+ (define-key km ";" #'semantic-grammar-electric-punctuation)
+ (define-key km "%" #'semantic-grammar-electric-punctuation)
+ (define-key km "(" #'semantic-grammar-electric-punctuation)
+ (define-key km ")" #'semantic-grammar-electric-punctuation)
+ (define-key km ":" #'semantic-grammar-electric-punctuation)
+
+ (define-key km "\t" #'semantic-grammar-indent)
+ (define-key km "\M-\t" #'semantic-grammar-complete)
+ (define-key km "\C-c\C-c" #'semantic-grammar-create-package)
+ (define-key km "\C-cm" #'semantic-grammar-find-macro-expander)
+ (define-key km "\C-cik" #'semantic-grammar-insert-keyword)
+;; (define-key km "\C-cc" #'semantic-grammar-generate-and-load)
+;; (define-key km "\C-cr" #'semantic-grammar-generate-one-rule)
km)
"Keymap used in `semantic-grammar-mode'.")
@@ -1322,7 +1327,7 @@ the change bounds to encompass the whole nonterminal tag."
;; Setup Semantic to parse grammar
(semantic-grammar-wy--install-parser)
(setq semantic-lex-comment-regex ";;"
- semantic-lex-analyzer 'semantic-grammar-lexer
+ semantic-lex-analyzer #'semantic-grammar-lexer
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list
'(
@@ -1343,10 +1348,10 @@ the change bounds to encompass the whole nonterminal tag."
;; Before each change, clear the cached regexp used to highlight
;; macros local in this grammar.
(add-hook 'before-change-functions
- 'semantic--grammar-clear-macros-regexp-2 nil t)
+ #'semantic--grammar-clear-macros-regexp-2 nil t)
;; Handle safe re-parse of grammar rules.
(add-hook 'semantic-edits-new-change-functions
- 'semantic-grammar-edits-new-change-hook-fcn
+ #'semantic-grammar-edits-new-change-hook-fcn
nil t))
;;;;
@@ -1734,7 +1739,7 @@ If it is a macro name, return a description of the associated expander
function parameter list.
If it is a function name, return a description of this function
parameter list.
-It it is a variable name, return a brief (one-line) documentation
+If it is a variable name, return a brief (one-line) documentation
string for the variable.
If a default description of the current context can be obtained,
return it.
@@ -1856,11 +1861,11 @@ Optional argument COLOR determines if color is added to the text."
(setq label "Keyword: ")
(let (summary)
(semantic--find-tags-by-function
- #'(lambda (put)
- (unless summary
- (setq summary (cdr (assoc "summary"
- (semantic-tag-get-attribute
- put :value))))))
+ (lambda (put)
+ (unless summary
+ (setq summary (cdr (assoc "summary"
+ (semantic-tag-get-attribute
+ put :value))))))
;; Get `put' tag with TAG name.
(semantic-find-tags-by-name-regexp
(regexp-quote (semantic-tag-name tag))
@@ -1876,7 +1881,7 @@ Optional argument COLOR determines if color is added to the text."
(names (semantic-tag-get-attribute tag :rest))
(type (semantic-tag-type tag)))
(if names
- (setq name (mapconcat 'identity (cons name names) " ")))
+ (setq name (mapconcat #'identity (cons name names) " ")))
(setq desc (concat
(if type
(format " <%s>" type)
@@ -1893,7 +1898,7 @@ Optional argument COLOR determines if color is added to the text."
(format " <%s>" type)
"")
(if val
- (concat " " (mapconcat 'identity val " "))
+ (concat " " (mapconcat #'identity val " "))
"")))))
(t
(setq desc (semantic-format-tag-abbreviate tag parent color))))
@@ -1944,7 +1949,7 @@ Optional argument COLOR determines if color is added to the text."
context-return)))
(define-mode-local-override semantic-analyze-possible-completions
- semantic-grammar-mode (context &rest flags)
+ semantic-grammar-mode (context &rest _flags)
"Return a list of possible completions based on CONTEXT."
(require 'semantic/analyze/complete)
(if (semantic-grammar-in-lisp-p)
diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el
new file mode 100644
index 00000000000..a6bf211713a
--- /dev/null
+++ b/lisp/cedet/semantic/grm-wy-boot.el
@@ -0,0 +1,503 @@
+;;; semantic/grammar-wy.el --- Generated parser support file -*- lexical-binding:t -*-
+
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This file was generated from admin/grammars/grammar.wy.
+
+;;; Code:
+
+(require 'semantic/lex)
+(require 'semantic/wisent)
+
+;;; Prologue
+;;
+(defvar semantic-grammar-lex-c-char-re)
+
+;; Current parsed nonterminal name.
+(defvar semantic-grammar-wy--nterm nil)
+;; Index of rule in a nonterminal clause.
+(defvar semantic-grammar-wy--rindx nil)
+
+;;; Declarations
+;;
+(eval-and-compile (defconst semantic-grammar-wy--expected-conflicts
+ nil
+ "The number of expected shift/reduce conflicts in this grammar."))
+
+(defconst semantic-grammar-wy--keyword-table
+ (semantic-lex-make-keyword-table
+ '(("%default-prec" . DEFAULT-PREC)
+ ("%no-default-prec" . NO-DEFAULT-PREC)
+ ("%keyword" . KEYWORD)
+ ("%languagemode" . LANGUAGEMODE)
+ ("%left" . LEFT)
+ ("%nonassoc" . NONASSOC)
+ ("%package" . PACKAGE)
+ ("%expectedconflicts" . EXPECTEDCONFLICTS)
+ ("%provide" . PROVIDE)
+ ("%prec" . PREC)
+ ("%put" . PUT)
+ ("%quotemode" . QUOTEMODE)
+ ("%right" . RIGHT)
+ ("%scopestart" . SCOPESTART)
+ ("%start" . START)
+ ("%token" . TOKEN)
+ ("%type" . TYPE)
+ ("%use-macros" . USE-MACROS))
+ 'nil)
+ "Table of language keywords.")
+
+(defconst semantic-grammar-wy--token-table
+ (semantic-lex-make-type-table
+ '(("punctuation"
+ (GT . ">")
+ (LT . "<")
+ (OR . "|")
+ (SEMI . ";")
+ (COLON . ":"))
+ ("close-paren"
+ (RBRACE . "}")
+ (RPAREN . ")"))
+ ("open-paren"
+ (LBRACE . "{")
+ (LPAREN . "("))
+ ("block"
+ (BRACE_BLOCK . "(LBRACE RBRACE)")
+ (PAREN_BLOCK . "(LPAREN RPAREN)"))
+ ("code"
+ (EPILOGUE . "%%...EOF")
+ (PROLOGUE . "%{...%}"))
+ ("sexp"
+ (SEXP))
+ ("qlist"
+ (PREFIXED_LIST))
+ ("char"
+ (CHARACTER))
+ ("symbol"
+ (PERCENT_PERCENT . "\\`%%\\'")
+ (SYMBOL))
+ ("string"
+ (STRING)))
+ '(("punctuation" :declared t)
+ ("block" :declared t)
+ ("sexp" matchdatatype sexp)
+ ("sexp" syntax "\\=")
+ ("sexp" :declared t)
+ ("qlist" matchdatatype sexp)
+ ("qlist" syntax "\\s'\\s-*(")
+ ("qlist" :declared t)
+ ("char" syntax semantic-grammar-lex-c-char-re)
+ ("char" :declared t)
+ ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+")
+ ("symbol" :declared t)
+ ("string" :declared t)
+ ("keyword" :declared t)))
+ "Table of lexical tokens.")
+
+(defconst semantic-grammar-wy--parse-table
+ (wisent-compiled-grammar
+ ((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
+ nil
+ (grammar
+ ((prologue))
+ ((epilogue))
+ ((declaration))
+ ((nonterminal))
+ ((PERCENT_PERCENT)))
+ (prologue
+ ((PROLOGUE)
+ (wisent-raw-tag
+ (semantic-tag-new-code "prologue" nil))))
+ (epilogue
+ ((EPILOGUE)
+ (wisent-raw-tag
+ (semantic-tag-new-code "epilogue" nil))))
+ (declaration
+ ((decl)
+ (eval $1 t)))
+ (decl
+ ((default_prec_decl))
+ ((no_default_prec_decl))
+ ((languagemode_decl))
+ ((package_decl))
+ ((expectedconflicts_decl))
+ ((provide_decl))
+ ((precedence_decl))
+ ((put_decl))
+ ((quotemode_decl))
+ ((scopestart_decl))
+ ((start_decl))
+ ((keyword_decl))
+ ((token_decl))
+ ((type_decl))
+ ((use_macros_decl)))
+ (default_prec_decl
+ ((DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("t")))))
+ (no_default_prec_decl
+ ((NO-DEFAULT-PREC)
+ `(wisent-raw-tag
+ (semantic-tag "default-prec" 'assoc :value
+ '("nil")))))
+ (languagemode_decl
+ ((LANGUAGEMODE symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'languagemode :rest ',(cdr $2)))))
+ (package_decl
+ ((PACKAGE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag-new-package ',$2 nil))))
+ (expectedconflicts_decl
+ ((EXPECTEDCONFLICTS symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'expectedconflicts :rest ',(cdr $2)))))
+ (provide_decl
+ ((PROVIDE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'provide))))
+ (precedence_decl
+ ((associativity token_type_opt items)
+ `(wisent-raw-tag
+ (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
+ (associativity
+ ((LEFT)
+ (progn "left"))
+ ((RIGHT)
+ (progn "right"))
+ ((NONASSOC)
+ (progn "nonassoc")))
+ (put_decl
+ ((PUT put_name put_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'put :value ',(list $3))))
+ ((PUT put_name put_value_list)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'put :value ',$3)))
+ ((PUT put_name_list put_value)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'put :rest ',(cdr $2)
+ :value ',(list $3))))
+ ((PUT put_name_list put_value_list)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'put :rest ',(cdr $2)
+ :value ',$3))))
+ (put_name_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-name
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'put_names 1))))
+ (put_names
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((put_name)
+ (wisent-raw-tag
+ (semantic-tag $1 'put-name))))
+ (put_name
+ ((SYMBOL))
+ ((token_type)))
+ (put_value_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-code-detail
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'put_values 1))))
+ (put_values
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((put_value)
+ (wisent-raw-tag
+ (semantic-tag-new-code "put-value" $1))))
+ (put_value
+ ((SYMBOL any_value)
+ (cons $1 $2)))
+ (scopestart_decl
+ ((SCOPESTART SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'scopestart))))
+ (quotemode_decl
+ ((QUOTEMODE SYMBOL)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'quotemode))))
+ (start_decl
+ ((START symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $2)
+ 'start :rest ',(cdr $2)))))
+ (keyword_decl
+ ((KEYWORD SYMBOL string_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'keyword :value ',$3))))
+ (token_decl
+ ((TOKEN token_type_opt SYMBOL string_value)
+ `(wisent-raw-tag
+ (semantic-tag ',$3 ',(if $2 'token 'keyword)
+ :type ',$2 :value ',$4)))
+ ((TOKEN token_type_opt symbols)
+ `(wisent-raw-tag
+ (semantic-tag ',(car $3)
+ 'token :type ',$2 :rest ',(cdr $3)))))
+ (token_type_opt
+ (nil)
+ ((token_type)))
+ (token_type
+ ((LT SYMBOL GT)
+ (progn $2)))
+ (type_decl
+ ((TYPE token_type plist_opt)
+ `(wisent-raw-tag
+ (semantic-tag ',$2 'type :value ',$3))))
+ (plist_opt
+ (nil)
+ ((plist)))
+ (plist
+ ((plist put_value)
+ (append
+ (list $2)
+ $1))
+ ((put_value)
+ (list $1)))
+ (use_name_list
+ ((BRACE_BLOCK)
+ (mapcar #'semantic-tag-name
+ (semantic-parse-region
+ (car $region1)
+ (cdr $region1)
+ 'use_names 1))))
+ (use_names
+ ((LBRACE)
+ nil)
+ ((RBRACE)
+ nil)
+ ((SYMBOL)
+ (wisent-raw-tag
+ (semantic-tag $1 'use-name))))
+ (use_macros_decl
+ ((USE-MACROS SYMBOL use_name_list)
+ `(wisent-raw-tag
+ (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
+ (string_value
+ ((STRING)
+ (read $1)))
+ (any_value
+ ((SYMBOL))
+ ((STRING))
+ ((PAREN_BLOCK))
+ ((PREFIXED_LIST))
+ ((SEXP)))
+ (symbols
+ ((lifo_symbols)
+ (nreverse $1)))
+ (lifo_symbols
+ ((lifo_symbols SYMBOL)
+ (cons $2 $1))
+ ((SYMBOL)
+ (list $1)))
+ (nonterminal
+ ((SYMBOL
+ (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
+ COLON rules SEMI)
+ (wisent-raw-tag
+ (semantic-tag $1 'nonterminal :children $4))))
+ (rules
+ ((lifo_rules)
+ (apply #'nconc
+ (nreverse $1))))
+ (lifo_rules
+ ((lifo_rules OR rule)
+ (cons $3 $1))
+ ((rule)
+ (list $1)))
+ (rule
+ ((rhs)
+ (let*
+ ((nterm semantic-grammar-wy--nterm)
+ (rindx semantic-grammar-wy--rindx)
+ (rhs $1)
+ comps prec action elt)
+ (setq semantic-grammar-wy--rindx
+ (1+ semantic-grammar-wy--rindx))
+ (while rhs
+ (setq elt
+ (car rhs)
+ rhs
+ (cdr rhs))
+ (cond
+ ((vectorp elt)
+ (if prec
+ (error "Duplicate %%prec in `%s:%d' rule" nterm rindx))
+ (setq prec
+ (aref elt 0)))
+ ((consp elt)
+ (if
+ (or action comps)
+ (setq comps
+ (cons elt comps)
+ semantic-grammar-wy--rindx
+ (1+ semantic-grammar-wy--rindx))
+ (setq action
+ (car elt))))
+ (t
+ (setq comps
+ (cons elt comps)))))
+ (wisent-cook-tag
+ (wisent-raw-tag
+ (semantic-tag
+ (format "%s:%d" nterm rindx)
+ 'rule :type
+ (if comps "group" "empty")
+ :value comps :prec prec :expr action))))))
+ (rhs
+ (nil)
+ ((rhs item)
+ (cons $2 $1))
+ ((rhs action)
+ (cons
+ (list $2)
+ $1))
+ ((rhs PREC item)
+ (cons
+ (vector $3)
+ $1)))
+ (action
+ ((PAREN_BLOCK))
+ ((PREFIXED_LIST))
+ ((BRACE_BLOCK)
+ (format "(progn\n%s)"
+ (let
+ ((s $1))
+ (if
+ (string-match "^{[ \n ]*" s)
+ (setq s
+ (substring s
+ (match-end 0))))
+ (if
+ (string-match "[ \n ]*}$" s)
+ (setq s
+ (substring s 0
+ (match-beginning 0))))
+ s))))
+ (items
+ ((lifo_items)
+ (nreverse $1)))
+ (lifo_items
+ ((lifo_items item)
+ (cons $2 $1))
+ ((item)
+ (list $1)))
+ (item
+ ((SYMBOL))
+ ((CHARACTER))))
+ (grammar prologue epilogue declaration nonterminal rule put_names put_values use_names))
+ "Parser table.")
+
+(defun semantic-grammar-wy--install-parser ()
+ "Setup the Semantic Parser."
+ (semantic-install-function-overrides
+ '((semantic-parse-stream . wisent-parse-stream)))
+ (setq semantic-parser-name "LALR"
+ semantic--parse-table semantic-grammar-wy--parse-table
+ semantic-debug-parser-source "grammar.wy"
+ semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table
+ semantic-lex-types-obarray semantic-grammar-wy--token-table)
+ ;; Collect unmatched syntax lexical tokens
+ (add-hook 'wisent-discarding-token-functions
+ #'wisent-collect-unmatched-syntax nil t))
+
+
+;;; Analyzers
+;;
+(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer
+ "keyword analyzer for <keyword> tokens."
+ "\\(\\sw\\|\\s_\\)+")
+
+(define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer
+ "regexp analyzer for <char> tokens."
+ semantic-grammar-lex-c-char-re
+ nil
+ 'CHARACTER)
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer
+ "sexp analyzer for <string> tokens."
+ "\\s\""
+ 'STRING)
+
+(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer
+ "block analyzer for <block> tokens."
+ "\\s(\\|\\s)"
+ '((("(" LPAREN PAREN_BLOCK)
+ ("{" LBRACE BRACE_BLOCK))
+ (")" RPAREN)
+ ("}" RBRACE))
+ )
+
+(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer
+ "string analyzer for <punctuation> tokens."
+ "\\(\\s.\\|\\s$\\|\\s'\\)+"
+ '((GT . ">")
+ (LT . "<")
+ (OR . "|")
+ (SEMI . ";")
+ (COLON . ":"))
+ 'punctuation)
+
+(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer
+ "regexp analyzer for <symbol> tokens."
+ ":?\\(\\sw\\|\\s_\\)+"
+ '((PERCENT_PERCENT . "\\`%%\\'"))
+ 'SYMBOL)
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer
+ "sexp analyzer for <qlist> tokens."
+ "\\s'\\s-*("
+ 'PREFIXED_LIST)
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer
+ "sexp analyzer for <sexp> tokens."
+ "\\="
+ 'SEXP)
+
+
+;;; Epilogue
+;;
+
+
+
+
+(provide 'semantic/grammar-wy)
+
+;; Local Variables:
+;; version-control: never
+;; no-update-autoloads: t
+;; End:
+
+;;; semantic/grammar-wy.el ends here
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index 658d218a4a3..ad5d2c798fb 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -1,4 +1,4 @@
-;;; semantic/html.el --- Semantic details for html files
+;;; semantic/html.el --- Semantic details for html files -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2005, 2007-2021 Free Software Foundation, Inc.
@@ -59,14 +59,14 @@
"Alist of sectioning commands and their relative level.")
(define-mode-local-override semantic-parse-region
- html-mode (&rest ignore)
+ html-mode (&rest _ignore)
"Parse the current html buffer for semantic tags.
IGNORE any arguments. Always parse the whole buffer.
Each tag returned is of the form:
(\"NAME\" section (:members CHILDREN))
or
(\"NAME\" anchor)"
- (mapcar 'semantic-html-expand-tag
+ (mapcar #'semantic-html-expand-tag
(semantic-html-parse-headings)))
(define-mode-local-override semantic-parse-changes
@@ -79,7 +79,7 @@ or
(let ((chil (semantic-html-components tag)))
(if chil
(semantic-tag-put-attribute
- tag :members (mapcar 'semantic-html-expand-tag chil)))
+ tag :members (mapcar #'semantic-html-expand-tag chil)))
(car (semantic--tag-expand tag))))
(defun semantic-html-components (tag)
@@ -233,7 +233,7 @@ tag with greater section value than LEVEL is found."
;; This will use our parser.
(setq semantic-parser-name "HTML"
semantic--parse-table t
- imenu-create-index-function 'semantic-create-imenu-index
+ imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character ">"
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list '((section . "Section")
diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el
index b132d41cd4a..12a2f1db92a 100644
--- a/lisp/cedet/semantic/ia-sb.el
+++ b/lisp/cedet/semantic/ia-sb.el
@@ -1,7 +1,6 @@
-;;; semantic/ia-sb.el --- Speedbar analysis display interactor
+;;; semantic/ia-sb.el --- Speedbar analysis display interactor -*- lexical-binding: t; -*-
-;;; Copyright (C) 2002-2004, 2006, 2008-2021 Free Software Foundation,
-;;; Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -30,18 +29,14 @@
(require 'speedbar)
;;; Code:
-(defvar semantic-ia-sb-key-map nil
+(defvar semantic-ia-sb-key-map
+ (let ((map (speedbar-make-specialized-keymap)))
+ ;; Basic features.
+ (define-key map "\C-m" #'speedbar-edit-line)
+ (define-key map "I" #'semantic-ia-sb-show-tag-info)
+ map)
"Keymap used when in semantic analysis display mode.")
-(if semantic-ia-sb-key-map
- nil
- (setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap))
-
- ;; Basic features.
- (define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line)
- (define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info)
- )
-
(defvar semantic-ia-sb-easymenu-definition
'( "---"
; [ "Expand" speedbar-expand-line nil ]
@@ -75,7 +70,7 @@ list of possible completions."
(speedbar-change-initial-expansion-list "Analyze")
)
-(defun semantic-ia-speedbar (directory zero)
+(defun semantic-ia-speedbar (_directory _zero)
"Create buttons in speedbar which define the current analysis at POINT.
DIRECTORY is the current directory, which is ignored, and ZERO is 0."
(let ((analysis nil)
@@ -195,7 +190,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
;; An index for the argument the prefix is in:
(let ((arg (oref context argument))
(args (semantic-tag-function-arguments (car func)))
- (idx 0)
+ ;; (idx 0)
)
(speedbar-insert-separator
(format "Argument #%d" (oref context index)))
@@ -275,7 +270,7 @@ See `semantic-ia-sb-tag-info' for more."
(setq tok (get-text-property (point) 'speedbar-token)))
(semantic-ia-sb-tag-info nil tok 0)))
-(defun semantic-ia-sb-tag-info (text tag indent)
+(defun semantic-ia-sb-tag-info (_text tag _indent)
"Display as much information as we can about tag.
Show the information in a shrunk split-buffer and expand
out as many details as possible.
@@ -322,16 +317,15 @@ TEXT, TAG, and INDENT are speedbar function arguments."
(get-buffer-window "*Tag Information*")))
(select-frame speedbar-frame))))
-(defun semantic-ia-sb-line-path (&optional depth)
+(defun semantic-ia-sb-line-path (&optional _depth)
"Return the file name associated with DEPTH."
(save-match-data
(let* ((tok (speedbar-line-token))
- (buff (if (semantic-tag-buffer tok)
- (semantic-tag-buffer tok)
- (current-buffer))))
+ (buff (or (semantic-tag-buffer tok)
+ (current-buffer))))
(buffer-file-name buff))))
-(defun semantic-ia-sb-complete (text tag indent)
+(defun semantic-ia-sb-complete (_text tag _indent)
"At point in the attached buffer, complete the symbol clicked on.
TEXT TAG and INDENT are the details."
;; Find the specified bounds from the current analysis.
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 6d3ec7570b5..7186a781235 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -1,6 +1,6 @@
-;;; semantic/ia.el --- Interactive Analysis functions
+;;; semantic/ia.el --- Interactive Analysis functions -*- lexical-binding: t; -*-
-;;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -79,13 +79,8 @@
(insert "("))
(t nil))))
-(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated)
-(make-obsolete 'semantic-ia-get-completions
- #'semantic-analyze-possible-completions "28.1")
-
-(defun semantic-ia-get-completions-deprecated (context point)
- "A function to help transition away from `semantic-ia-get-completions'.
-Return completions based on CONTEXT at POINT."
+(defun semantic-ia-get-completions (context _point)
+ "Fetch the completion of CONTEXT at POINT."
(declare (obsolete semantic-analyze-possible-completions "28.1"))
(semantic-analyze-possible-completions context))
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 9f1bcfa6916..b883573a30f 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,4 +1,4 @@
-;;; idle.el --- Schedule parsing tasks in idle time
+;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc.
@@ -47,8 +47,6 @@
;; For the semantic-find-tags-by-name macro.
(eval-when-compile (require 'semantic/find))
-(defvar eldoc-last-message)
-(declare-function eldoc-message "eldoc")
(declare-function semantic-analyze-unsplit-name "semantic/analyze/fcn")
(declare-function semantic-complete-analyze-inline-idle "semantic/complete")
(declare-function semanticdb-deep-find-tags-by-name "semantic/db-find")
@@ -173,7 +171,8 @@ date, and reparses while the user is idle (not typing.)
The minor mode can be turned on only if semantic feature is
available and the current buffer was set up for parsing. Return
-non-nil if the minor mode is enabled." nil nil nil
+non-nil if the minor mode is enabled."
+ :lighter nil
(if semantic-idle-scheduler-mode
(if (not (and (featurep 'semantic) (semantic-active-p)))
(progn
@@ -218,22 +217,22 @@ And also manages services that depend on tag values."
(let* ((inhibit-quit nil)
(buffers (delq (current-buffer)
(delq nil
- (mapcar #'(lambda (b)
- (and (buffer-file-name b)
- b))
+ (mapcar (lambda (b)
+ (and (buffer-file-name b)
+ b))
(buffer-list)))))
- safe ;; This safe is not used, but could be.
+ ;; safe ;; This safe is not used, but could be.
others
mode)
(when (semantic-idle-scheduler-enabled-p)
(save-excursion
;; First, reparse the current buffer.
- (setq mode major-mode
- safe (semantic-safe "Idle Parse Error: %S"
- ;(error "Goofy error 1")
- (semantic-idle-scheduler-refresh-tags)
- )
- )
+ (setq mode major-mode)
+ ;; (setq safe
+ (semantic-safe "Idle Parse Error: %S"
+ ;(error "Goofy error 1")
+ (semantic-idle-scheduler-refresh-tags))
+
;; Now loop over other buffers with same major mode, trying to
;; update them as well. Stop on keypress.
(dolist (b buffers)
@@ -350,54 +349,56 @@ Returns t if all processing succeeded."
Visits Semantic controlled buffers, and makes sure all needed
include files have been parsed, and that the typecache is up to date.
Uses `semantic-idle-work-for-on-buffer' to do the work."
- (let ((errbuf nil)
- (interrupted
- (semantic-exit-on-input 'idle-work-timer
- (let* ((inhibit-quit nil)
- (cb (current-buffer))
- (buffers (delq (current-buffer)
- (delq nil
- (mapcar #'(lambda (b)
- (and (buffer-file-name b)
- b))
- (buffer-list)))))
- safe errbuf)
- ;; First, handle long tasks in the current buffer.
- (when (semantic-idle-scheduler-enabled-p)
- (save-excursion
- (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
- )))
- (when (not safe) (push (current-buffer) errbuf))
-
- ;; Now loop over other buffers with same major mode, trying to
- ;; update them as well. Stop on keypress.
- (dolist (b buffers)
- (semantic-throw-on-input 'parsing-mode-buffers)
- (with-current-buffer b
- (when (semantic-idle-scheduler-enabled-p)
- (and (semantic-idle-scheduler-enabled-p)
- (unless (semantic-idle-work-for-one-buffer (current-buffer))
- (push (current-buffer) errbuf)))
- ))
- )
-
- (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
- ;; Save everything.
- (semanticdb-save-all-db-idle)
-
- ;; Parse up files near our active buffer
- (when semantic-idle-work-parse-neighboring-files-flag
- (semantic-safe "Idle Work Parse Neighboring Files: %S"
- (set-buffer cb)
- (semantic-idle-scheduler-work-parse-neighboring-files))
- t)
+ (let*
+ ((errbuf nil)
+ (interrupted
+ (semantic-exit-on-input 'idle-work-timer
+ (let* ((inhibit-quit nil)
+ (cb (current-buffer))
+ (buffers (delq (current-buffer)
+ (delq nil
+ (mapcar (lambda (b)
+ (and (buffer-file-name b)
+ b))
+ (buffer-list)))))
+ safe) ;; errbuf
+ ;; First, handle long tasks in the current buffer.
+ (when (semantic-idle-scheduler-enabled-p)
+ (save-excursion
+ (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
+ )))
+ (when (not safe) (push (current-buffer) errbuf))
+
+ ;; Now loop over other buffers with same major mode, trying to
+ ;; update them as well. Stop on keypress.
+ (dolist (b buffers)
+ (semantic-throw-on-input 'parsing-mode-buffers)
+ (with-current-buffer b
+ (when (semantic-idle-scheduler-enabled-p)
+ (and (semantic-idle-scheduler-enabled-p)
+ (unless (semantic-idle-work-for-one-buffer
+ (current-buffer))
+ (push (current-buffer) errbuf)))
+ ))
+ )
- ;; Save everything... again
- (semanticdb-save-all-db-idle)
- )
+ (when (and (featurep 'semantic/db) (semanticdb-minor-mode-p))
+ ;; Save everything.
+ (semanticdb-save-all-db-idle)
+
+ ;; Parse up files near our active buffer
+ (when semantic-idle-work-parse-neighboring-files-flag
+ (semantic-safe "Idle Work Parse Neighboring Files: %S"
+ (set-buffer cb)
+ (semantic-idle-scheduler-work-parse-neighboring-files))
+ t)
+
+ ;; Save everything... again
+ (semanticdb-save-all-db-idle)
+ )
- ;; Done w/ processing
- nil))))
+ ;; Done w/ processing
+ nil))))
;; Done
(if interrupted
@@ -430,6 +431,8 @@ datasets."
(message "Long Work Idle Timer...%s" exit-type)))
)
+(defvar ede-auto-add-method)
+
(defun semantic-idle-scheduler-work-parse-neighboring-files ()
"Parse all the files in similar directories to buffers being edited."
;; Let's tell EDE to ignore all the files we're about to load
@@ -564,11 +567,12 @@ DOC will be a documentation string describing FORMS.
FORMS will be called during idle time after the current buffer's
semantic tag information has been updated.
This routine creates the following functions and variables:"
+ (declare (indent 1) (debug (&define name stringp def-body)))
(let ((global (intern (concat "global-" (symbol-name name) "-mode")))
(mode (intern (concat (symbol-name name) "-mode")))
(hook (intern (concat (symbol-name name) "-mode-hook")))
(map (intern (concat (symbol-name name) "-mode-map")))
- (setup (intern (concat (symbol-name name) "-mode-setup")))
+ ;; (setup (intern (concat (symbol-name name) "-mode-setup")))
(func (intern (concat (symbol-name name) "-idle-function"))))
`(progn
@@ -618,11 +622,6 @@ turned on in every Semantic-supported buffer.")
,(concat "Perform idle activity for the minor mode `"
(symbol-name mode) "'.")
,@forms))))
-(put 'define-semantic-idle-service 'lisp-indent-function 1)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec define-semantic-idle-service
- (&define name stringp def-body))))
;;; SUMMARY MODE
;;
@@ -732,32 +731,19 @@ specific to a major mode. For example, in jde mode:
:group 'semantic
:type 'hook)
-(defun semantic-idle-summary-idle-function ()
- "Display a tag summary of the lexical token under the cursor.
+(defun semantic--eldoc-info (_callback &rest _)
+ "Return the eldoc info for the current symbol.
Call `semantic-idle-summary-current-symbol-info' for getting the
current tag to display information."
(or (eq major-mode 'emacs-lisp-mode)
(not (semantic-idle-summary-useful-context-p))
- (let* ((found (semantic-idle-summary-current-symbol-info))
+ (let* ((found (save-excursion
+ (semantic-idle-summary-current-symbol-info)))
(str (cond ((stringp found) found)
((semantic-tag-p found)
(funcall semantic-idle-summary-function
found nil t)))))
- ;; Show the message with eldoc functions
- (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
- eldoc-echo-area-use-multiline-p)
- (let ((w (1- (window-width (minibuffer-window)))))
- (if (> (length str) w)
- (setq str (substring str 0 w)))))
- ;; I borrowed some bits from eldoc to shorten the
- ;; message.
- (when semantic-idle-truncate-long-summaries
- (let ((ea-width (1- (window-width (minibuffer-window))))
- (strlen (length str)))
- (when (> strlen ea-width)
- (setq str (substring str 0 ea-width)))))
- ;; Display it
- (eldoc-message str))))
+ str)))
(define-minor-mode semantic-idle-summary-mode
"Toggle Semantic Idle Summary mode.
@@ -766,30 +752,16 @@ When this minor mode is enabled, the echo area displays a summary
of the lexical token at point whenever Emacs is idle."
:group 'semantic
:group 'semantic-modes
- (if semantic-idle-summary-mode
- ;; Enable the mode
- (progn
- (unless (and (featurep 'semantic) (semantic-active-p))
- ;; Disable minor mode if semantic stuff not available
- (setq semantic-idle-summary-mode nil)
- (error "Buffer %s was not set up for parsing"
- (buffer-name)))
- (require 'eldoc)
- (semantic-idle-scheduler-add 'semantic-idle-summary-idle-function)
- (add-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t))
- ;; Disable the mode
- (semantic-idle-scheduler-remove 'semantic-idle-summary-idle-function)
- (remove-hook 'pre-command-hook 'semantic-idle-summary-refresh-echo-area t)))
-
-(defun semantic-idle-summary-refresh-echo-area ()
- (and semantic-idle-summary-mode
- eldoc-last-message
- (if (and (not executing-kbd-macro)
- (not (and (boundp 'edebug-active) edebug-active))
- (not cursor-in-echo-area)
- (not (eq (selected-window) (minibuffer-window))))
- (eldoc-message eldoc-last-message)
- (setq eldoc-last-message nil))))
+ (remove-hook 'eldoc-documentation-functions #'semantic--eldoc-info t)
+ (when semantic-idle-summary-mode
+ ;; Enable the mode
+ (unless (and (featurep 'semantic) (semantic-active-p))
+ ;; Disable minor mode if semantic stuff not available
+ (setq semantic-idle-summary-mode nil)
+ (error "Buffer %s was not set up for parsing"
+ (buffer-name)))
+ (add-hook 'eldoc-documentation-functions #'semantic--eldoc-info nil t)
+ (eldoc-mode 1)))
(semantic-add-minor-mode 'semantic-idle-summary-mode "")
@@ -821,6 +793,8 @@ turned on in every Semantic-supported buffer."
(make-obsolete-variable 'semantic-idle-symbol-highlight-face
"customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
+(defvar pulse-flag)
+
(defun semantic-idle-symbol-maybe-highlight (tag)
"Perhaps add highlighting to the symbol represented by TAG.
TAG was found as the symbol under point. If it happens to be
@@ -898,7 +872,7 @@ Call `semantic-symref-hits-in-region' to identify local references."
(when (semantic-tag-p target)
(require 'semantic/symref/filter)
(semantic-symref-hits-in-region
- target (lambda (start end prefix)
+ target (lambda (start end _prefix)
(when (/= start (car Hbounds))
(pulse-momentary-highlight-region
start end semantic-idle-symbol-highlight-face))
@@ -1065,21 +1039,20 @@ be called."
(popup-menu semantic-idle-breadcrumbs-popup-menu)
(select-window old-window)))
-(defmacro semantic-idle-breadcrumbs--tag-function (function)
+(defun semantic-idle-breadcrumbs--tag-function (function)
"Return lambda expression calling FUNCTION when called from a popup."
- `(lambda (event)
- (interactive "e")
- (let* ((old-window (selected-window))
- (window (semantic-event-window event))
- (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
- (tag (progn
- (select-window window t)
- (plist-get
- (text-properties-at column header-line-format)
- 'tag))))
- (,function tag)
- (select-window old-window)))
- )
+ (lambda (event)
+ (interactive "e")
+ (let* ((old-window (selected-window))
+ (window (semantic-event-window event))
+ (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
+ (tag (progn
+ (select-window window t)
+ (plist-get
+ (text-properties-at column header-line-format)
+ 'tag))))
+ (funcall function tag)
+ (select-window old-window))))
;; TODO does this work for mode-line case?
(defvar semantic-idle-breadcrumbs-popup-map
@@ -1087,12 +1060,11 @@ be called."
;; mouse-1 goes to clicked tag
(define-key map
[ header-line mouse-1 ]
- (semantic-idle-breadcrumbs--tag-function
- semantic-go-to-tag))
+ (semantic-idle-breadcrumbs--tag-function #'semantic-go-to-tag))
;; mouse-3 pops up a context menu
(define-key map
[ header-line mouse-3 ]
- 'semantic-idle-breadcrumbs--popup-menu)
+ #'semantic-idle-breadcrumbs--popup-menu)
map)
"Keymap for semantic idle breadcrumbs minor mode.")
@@ -1104,8 +1076,7 @@ be called."
"Breadcrumb Tag"
(vector
"Go to Tag"
- (semantic-idle-breadcrumbs--tag-function
- semantic-go-to-tag)
+ (semantic-idle-breadcrumbs--tag-function #'semantic-go-to-tag)
:active t
:help "Jump to this tag")
;; TODO these entries need minor changes (optional tag argument) in
@@ -1113,37 +1084,32 @@ be called."
;; (semantic-menu-item
;; (vector
;; "Copy Tag"
- ;; (semantic-idle-breadcrumbs--tag-function
- ;; senator-copy-tag)
+ ;; (semantic-idle-breadcrumbs--tag-function #'senator-copy-tag)
;; :active t
;; :help "Copy this tag"))
;; (semantic-menu-item
;; (vector
;; "Kill Tag"
- ;; (semantic-idle-breadcrumbs--tag-function
- ;; senator-kill-tag)
+ ;; (semantic-idle-breadcrumbs--tag-function #'senator-kill-tag)
;; :active t
;; :help "Kill tag text to the kill ring, and copy the tag to
;; the tag ring"))
;; (semantic-menu-item
;; (vector
;; "Copy Tag to Register"
- ;; (semantic-idle-breadcrumbs--tag-function
- ;; senator-copy-tag-to-register)
+ ;; (semantic-idle-breadcrumbs--tag-function #'senator-copy-tag-to-register)
;; :active t
;; :help "Copy this tag"))
;; (semantic-menu-item
;; (vector
;; "Narrow to Tag"
- ;; (semantic-idle-breadcrumbs--tag-function
- ;; senator-narrow-to-defun)
+ ;; (semantic-idle-breadcrumbs--tag-function #'senator-narrow-to-defun)
;; :active t
;; :help "Narrow to the bounds of the current tag"))
;; (semantic-menu-item
;; (vector
;; "Fold Tag"
- ;; (semantic-idle-breadcrumbs--tag-function
- ;; senator-fold-tag-toggle)
+ ;; (semantic-idle-breadcrumbs--tag-function #'senator-fold-tag-toggle)
;; :active t
;; :style 'toggle
;; :selected '(let ((tag (semantic-current-tag)))
@@ -1231,7 +1197,7 @@ shortened at the beginning."
)
(defun semantic-idle-breadcrumbs--format-linear
- (tag-list &optional max-length)
+ (tag-list &optional _max-length)
"Format TAG-LIST as a linear list, starting with the outermost tag.
MAX-LENGTH is not used."
(require 'semantic/analyze/fcn)
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 4c13959ba1d..a5db85bb512 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -1,4 +1,4 @@
-;;; semantic/imenu.el --- Use Semantic as an imenu tag generator
+;;; semantic/imenu.el --- Use Semantic as an imenu tag generator -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2008, 2010-2021 Free Software
;; Foundation, Inc.
@@ -57,14 +57,12 @@
(defcustom semantic-imenu-summary-function 'semantic-format-tag-abbreviate
"Function to use when creating items in Imenu.
Some useful functions are found in `semantic-format-tag-functions'."
- :group 'semantic-imenu
:type semantic-format-tag-custom-list)
(make-variable-buffer-local 'semantic-imenu-summary-function)
;;;###autoload
(defcustom semantic-imenu-bucketize-file t
"Non-nil if tags in a file are to be grouped into buckets."
- :group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-file)
@@ -72,20 +70,17 @@ Some useful functions are found in `semantic-format-tag-functions'."
"Non-nil if types in a file should adopt externally defined members.
C++ and CLOS can define methods that are not in the body of a class
definition."
- :group 'semantic-imenu
:type 'boolean)
(defcustom semantic-imenu-buckets-to-submenu t
"Non-nil if buckets of tags are to be turned into submenus.
This option is ignored if `semantic-imenu-bucketize-file' is nil."
- :group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-buckets-to-submenu)
;;;###autoload
(defcustom semantic-imenu-expand-type-members t
"Non-nil if types should have submenus with members in them."
- :group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-expand-type-members)
@@ -93,7 +88,6 @@ This option is ignored if `semantic-imenu-bucketize-file' is nil."
"Non-nil if members of a type should be grouped into buckets.
A nil value means to keep them in the same order.
Overridden to nil if `semantic-imenu-bucketize-file' is nil."
- :group 'semantic-imenu
:type 'boolean)
(make-variable-buffer-local 'semantic-imenu-bucketize-type-members)
@@ -101,7 +95,6 @@ Overridden to nil if `semantic-imenu-bucketize-file' is nil."
"Function to use when sorting tags in the buckets of functions.
See `semantic-bucketize' and the FILTER argument for more details
on this function."
- :group 'semantic-imenu
:type '(radio (const :tag "No Sorting" nil)
(const semantic-sort-tags-by-name-increasing)
(const semantic-sort-tags-by-name-decreasing)
@@ -119,14 +112,12 @@ on this function."
Doesn't actually parse the entire directory, but displays tags for all files
currently listed in the current Semantic database.
This variable has no meaning if semanticdb is not active."
- :group 'semantic-imenu
:type 'boolean)
(defcustom semantic-imenu-auto-rebuild-directory-indexes nil
"If non-nil automatically rebuild directory index imenus.
That is when a directory index imenu is updated, automatically rebuild
other buffer local ones based on the same semanticdb."
- :group 'semantic-imenu
:type 'boolean)
(defvar semantic-imenu-directory-current-file nil
@@ -206,7 +197,7 @@ Optional argument REST is some extra stuff."
(setq imenu--index-alist nil)))))
))
-(defun semantic-imenu-flush-fcn (&optional ignore)
+(defun semantic-imenu-flush-fcn (&optional _ignore)
"This function is called as a hook to clear the imenu cache.
It is cleared after any parsing.
IGNORE arguments."
@@ -214,9 +205,9 @@ IGNORE arguments."
(setq imenu--index-alist nil
imenu-menubar-modified-tick 0))
(remove-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-imenu-flush-fcn t)
+ #'semantic-imenu-flush-fcn t)
(remove-hook 'semantic-after-partial-cache-change-hook
- 'semantic-imenu-flush-fcn t)
+ #'semantic-imenu-flush-fcn t)
)
;;;###autoload
@@ -224,7 +215,7 @@ IGNORE arguments."
"Create an imenu index for any buffer which supports Semantic.
Uses the output of the Semantic parser to create the index.
Optional argument STREAM is an optional stream of tags used to create menus."
- (setq imenu-default-goto-function 'semantic-imenu-goto-function)
+ (setq imenu-default-goto-function #'semantic-imenu-goto-function)
(prog1
(if (and semantic-imenu-index-directory
(featurep 'semantic/db)
@@ -234,9 +225,9 @@ Optional argument STREAM is an optional stream of tags used to create menus."
(semantic-create-imenu-index-1
(or stream (semantic-fetch-tags-fast)) nil))
(add-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-imenu-flush-fcn nil t)
+ #'semantic-imenu-flush-fcn nil t)
(add-hook 'semantic-after-partial-cache-change-hook
- 'semantic-imenu-flush-fcn nil t)))
+ #'semantic-imenu-flush-fcn nil t)))
(defun semantic-create-imenu-directory-index (&optional stream)
"Create an imenu tag index based on all files active in semanticdb.
@@ -438,14 +429,14 @@ Optional argument PARENT is a tag parent of STREAM."
Clears all imenu menus that may be depending on the database."
(require 'semantic/db-mode)
(semantic-map-buffers
- #'(lambda ()
- ;; Set up semanticdb environment if enabled.
- (if (semanticdb-minor-mode-p)
- (semanticdb-semantic-init-hook-fcn))
- ;; Clear imenu cache to redraw the imenu.
- (semantic-imenu-flush-fcn))))
+ (lambda ()
+ ;; Set up semanticdb environment if enabled.
+ (if (semanticdb-minor-mode-p)
+ (semanticdb-semantic-init-hook-fcn))
+ ;; Clear imenu cache to redraw the imenu.
+ (semantic-imenu-flush-fcn))))
-(add-hook 'semanticdb-mode-hook 'semantic-imenu-semanticdb-hook)
+(add-hook 'semanticdb-mode-hook #'semantic-imenu-semanticdb-hook)
;;; Interactive Utilities
;;
@@ -484,7 +475,6 @@ Clears all imenu menus that may be depending on the database."
(defcustom semantic-which-function-use-color nil
"Use color when displaying the current function with `which-function'."
- :group 'semantic-imenu
:type 'boolean)
(defun semantic-default-which-function (taglist)
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index f60f6e87ab7..0c2fb843f0b 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -1,6 +1,6 @@
-;;; semantic/java.el --- Semantic functions for Java
+;;; semantic/java.el --- Semantic functions for Java -*- lexical-binding: t; -*-
-;;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -141,14 +141,14 @@ corresponding compound declaration."
(semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
(semantic-tag-set-bounds clone start end)))
- ((and (eq class 'type) (string-match "\\." (semantic-tag-name tag)))
+ ((and (eq class 'type) (string-search "." (semantic-tag-name tag)))
;; javap outputs files where the package name is stuck onto the class or interface
;; name. To make this more regular, we extract the package name into a package statement,
;; then make the class name regular.
(let* ((name (semantic-tag-name tag))
(rsplit (nreverse (split-string name "\\." t)))
(newclassname (car rsplit))
- (newpkg (mapconcat 'identity (reverse (cdr rsplit)) ".")))
+ (newpkg (mapconcat #'identity (reverse (cdr rsplit)) ".")))
(semantic-tag-set-name tag newclassname)
(setq xpand
(list tag
@@ -169,7 +169,7 @@ corresponding compound declaration."
(define-mode-local-override semantic-ctxt-scoped-types
java-mode (&optional point)
"Return a list of type names currently in scope at POINT."
- (mapcar 'semantic-tag-name
+ (mapcar #'semantic-tag-name
(semantic-find-tags-by-class
'type (semantic-find-tag-by-overlay point))))
@@ -184,7 +184,7 @@ Override function for `semantic-tag-protection'."
;; Prototype handler
;;
-(defun semantic-java-prototype-function (tag &optional parent color)
+(defun semantic-java-prototype-function (tag &optional _parent color)
"Return a function (method) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
@@ -212,7 +212,7 @@ See also `semantic-format-tag-prototype'."
(or type "") (if type " " "")
name "(" argp ")")))
-(defun semantic-java-prototype-variable (tag &optional parent color)
+(defun semantic-java-prototype-variable (tag &optional _parent color)
"Return a variable (field) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
@@ -227,7 +227,7 @@ See also `semantic-format-tag-prototype'."
(semantic--format-colorize-text name 'variable)
name))))
-(defun semantic-java-prototype-type (tag &optional parent color)
+(defun semantic-java-prototype-type (tag &optional _parent color)
"Return a type (class/interface) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
@@ -260,7 +260,7 @@ Optional argument COLOR indicates that color should be mixed in."
(define-mode-local-override semantic-tag-include-filename java-mode (tag)
"Return a suitable path for (some) Java imports."
(let ((name (semantic-tag-name tag)))
- (concat (mapconcat 'identity (split-string name "\\.") "/") ".java")))
+ (concat (mapconcat #'identity (split-string name "\\.") "/") ".java")))
;; Documentation handler
;;
@@ -395,11 +395,11 @@ receives two arguments: the javadoc keyword and its associated
removed from the result list."
(delq nil
(mapcar
- #'(lambda (k)
- (let* ((tag (semantic-java-doc-tag k))
- (plist (semantic-lex-keyword-get tag 'javadoc)))
- (if (or (not property) (plist-get plist property))
- (funcall fun k plist))))
+ (lambda (k)
+ (let* ((tag (semantic-java-doc-tag k))
+ (plist (semantic-lex-keyword-get tag 'javadoc)))
+ (if (or (not property) (plist-get plist property))
+ (funcall fun k plist))))
semantic-java-doc-line-tags)))
@@ -417,61 +417,59 @@ removed from the result list."
(or semantic-java-doc-with-name-tags
(setq semantic-java-doc-with-name-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- k)
+ (lambda (k _p) k)
'with-name)))
(or semantic-java-doc-with-ref-tags
(setq semantic-java-doc-with-ref-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- k)
+ (lambda (k _p) k)
'with-ref)))
(or semantic-java-doc-extra-type-tags
(setq semantic-java-doc-extra-type-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- (if (memq 'type (plist-get p 'usage))
- k))
+ (lambda (k p)
+ (if (memq 'type (plist-get p 'usage))
+ k))
'opt)))
(or semantic-java-doc-extra-function-tags
(setq semantic-java-doc-extra-function-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- (if (memq 'function (plist-get p 'usage))
- k))
+ (lambda (k p)
+ (if (memq 'function (plist-get p 'usage))
+ k))
'opt)))
(or semantic-java-doc-extra-variable-tags
(setq semantic-java-doc-extra-variable-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- (if (memq 'variable (plist-get p 'usage))
- k))
+ (lambda (k p)
+ (if (memq 'variable (plist-get p 'usage))
+ k))
'opt)))
(or semantic-java-doc-type-tags
(setq semantic-java-doc-type-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- (if (memq 'type (plist-get p 'usage))
- k)))))
+ (lambda (k p)
+ (if (memq 'type (plist-get p 'usage))
+ k)))))
(or semantic-java-doc-function-tags
(setq semantic-java-doc-function-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- (if (memq 'function (plist-get p 'usage))
- k)))))
+ (lambda (k p)
+ (if (memq 'function (plist-get p 'usage))
+ k)))))
(or semantic-java-doc-variable-tags
(setq semantic-java-doc-variable-tags
(semantic-java-doc-keywords-map
- #'(lambda (k p)
- (if (memq 'variable (plist-get p 'usage))
- k)))))
+ (lambda (k p)
+ (if (memq 'variable (plist-get p 'usage))
+ k)))))
)
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 408011c6286..8073640a8bd 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1,4 +1,4 @@
-;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
+;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -106,22 +106,12 @@ added and removed from this symbol table.")
Pushes NAME into the macro stack. The above stack is checked
by `semantic-lex-spp-symbol' to not return true for any symbol
currently being expanded."
+ (declare (indent 1) (debug (symbolp def-body)))
`(unwind-protect
(progn
(push ,name semantic-lex-spp-expanded-macro-stack)
,@body)
(pop semantic-lex-spp-expanded-macro-stack)))
-(put 'semantic-lex-with-macro-used 'lisp-indent-function 1)
-
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec semantic-lex-with-macro-used
- (symbolp def-body)
- )
-
- ))
;;; MACRO TABLE UTILS
;;
@@ -190,7 +180,7 @@ Disable debugging by entering nothing."
(setq semantic-lex-spp-debug-symbol nil)
(setq semantic-lex-spp-debug-symbol sym)))
-(defmacro semantic-lex-spp-validate-value (name value)
+(defmacro semantic-lex-spp-validate-value (_name _value)
"Validate the NAME and VALUE of a macro before it is set."
; `(progn
; (when (not (semantic-lex-spp-value-valid-p ,value))
@@ -212,12 +202,11 @@ the dynamic map."
(semantic-lex-spp-dynamic-map)))
value))
-(defsubst semantic-lex-spp-symbol-remove (name &optional obarray)
+(defsubst semantic-lex-spp-symbol-remove (name &optional map)
"Remove the spp symbol with NAME.
-If optional OBARRAY is non-nil, then use that obarray instead of
+If optional obarray MAP is non-nil, then use that obarray instead of
the dynamic map."
- (unintern name (or obarray
- (semantic-lex-spp-dynamic-map))))
+ (unintern name (or map (semantic-lex-spp-dynamic-map))))
(defun semantic-lex-spp-symbol-push (name value)
"Push macro NAME with VALUE into the map.
@@ -246,7 +235,7 @@ Reverse with `semantic-lex-spp-symbol-pop'."
(stack (semantic-lex-spp-dynamic-map-stack))
(mapsym (intern name map))
(stacksym (intern name stack))
- (oldvalue nil)
+ ;; (oldvalue nil)
)
(if (or (not (boundp stacksym) )
(= (length (symbol-value stacksym)) 0))
@@ -289,10 +278,10 @@ The return list is meant to be saved in a semanticdb table."
(let (macros)
(when (obarrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
(mapatoms
- #'(lambda (symbol)
- (setq macros (cons (cons (symbol-name symbol)
- (symbol-value symbol))
- macros)))
+ (lambda (symbol)
+ (setq macros (cons (cons (symbol-name symbol)
+ (symbol-value symbol))
+ macros)))
semantic-lex-spp-dynamic-macro-symbol-obarray))
macros))
@@ -302,18 +291,18 @@ The value of each symbol is the replacement stream."
(let (macros)
(when (obarrayp semantic-lex-spp-macro-symbol-obarray)
(mapatoms
- #'(lambda (symbol)
- (setq macros (cons symbol macros)))
+ (lambda (symbol)
+ (setq macros (cons symbol macros)))
semantic-lex-spp-macro-symbol-obarray))
(when (obarrayp semantic-lex-spp-project-macro-symbol-obarray)
(mapatoms
- #'(lambda (symbol)
- (setq macros (cons symbol macros)))
+ (lambda (symbol)
+ (setq macros (cons symbol macros)))
semantic-lex-spp-project-macro-symbol-obarray))
(when (obarrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
(mapatoms
- #'(lambda (symbol)
- (setq macros (cons symbol macros)))
+ (lambda (symbol)
+ (setq macros (cons symbol macros)))
semantic-lex-spp-dynamic-macro-symbol-obarray))
macros))
@@ -324,7 +313,7 @@ For use with semanticdb restoration of state."
;; Default obarray for below is the dynamic map.
(semantic-lex-spp-symbol-set (car e) (cdr e))))
-(defun semantic-lex-spp-reset-hook (start end)
+(defun semantic-lex-spp-reset-hook (start _end)
"Reset anything needed by SPP for parsing.
In this case, reset the dynamic macro symbol table if
START is (point-min).
@@ -354,7 +343,7 @@ Return non-nil if it matches"
(string-match regex value))
))
-(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues)
+(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end _argvalues)
"Convert lexical macro contents VAL into a macro expansion stream.
These are for simple macro expansions that a user may have typed in directly.
As such, we need to analyze the input text, to figure out what kind of real
@@ -819,7 +808,7 @@ ARGVALUES are values for any arg list, or nil."
;; An analyzer that will push tokens from a macro in place
;; of the macro symbol.
;;
-(defun semantic-lex-spp-analyzer-do-replace (sym val beg end)
+(defun semantic-lex-spp-analyzer-do-replace (_sym val beg end)
"Do the lexical replacement for SYM with VAL.
Argument BEG and END specify the bounds of SYM in the buffer."
(if (not val)
@@ -861,7 +850,7 @@ Argument BEG and END specify the bounds of SYM in the buffer."
))
(define-obsolete-function-alias
'semantic-lex-spp-anlyzer-do-replace
- 'semantic-lex-spp-analyzer-do-replace "25.1")
+ #'semantic-lex-spp-analyzer-do-replace "25.1")
(defvar semantic-lex-spp-replacements-enabled t
"Non-nil means do replacements when finding keywords.
@@ -1045,7 +1034,7 @@ and variable state from the current buffer."
(fresh-toks nil)
(toks nil)
(origbuff (current-buffer))
- (analyzer semantic-lex-analyzer)
+ ;; (analyzer semantic-lex-analyzer)
(important-vars '(semantic-lex-spp-macro-symbol-obarray
semantic-lex-spp-project-macro-symbol-obarray
semantic-lex-spp-dynamic-macro-symbol-obarray
@@ -1081,7 +1070,7 @@ and variable state from the current buffer."
(semantic-lex-init)
(semantic-clear-toplevel-cache)
(remove-hook 'semantic-lex-reset-functions
- 'semantic-lex-spp-reset-hook t)
+ #'semantic-lex-spp-reset-hook t)
))
;; Second Cheat: copy key variables regarding macro state from the
@@ -1176,6 +1165,7 @@ of type `spp-macro-def' is to be created.
VALFORM are forms that return the value to be saved for this macro, or nil.
When implementing a macro, you can use `semantic-lex-spp-stream-for-macro'
to convert text into a lexical stream for storage in the macro."
+ (declare (debug (&define name stringp stringp form def-body)))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@@ -1209,6 +1199,7 @@ REGEXP is a regular expression for the analyzer to match.
See `define-lex-regex-analyzer' for more on regexp.
TOKIDX is an index into REGEXP for which a new lexical token
of type `spp-macro-undef' is to be created."
+ (declare (debug (&define name stringp stringp form)))
(let ((start (make-symbol "start"))
(end (make-symbol "end")))
`(define-lex-regex-analyzer ,name
@@ -1244,7 +1235,7 @@ Note: Not implemented yet."
:group 'semantic
:type 'boolean)
-(defun semantic-lex-spp-merge-header (name)
+(defun semantic-lex-spp-merge-header (_name)
"Extract and merge any macros from the header with NAME.
Finds the header file belonging to NAME, gets the macros
from that file, and then merge the macros with our current
@@ -1269,6 +1260,7 @@ type of include. The return value should be of the form:
(NAME . TYPE)
where NAME is the name of the include, and TYPE is the type of the include,
where a valid symbol is `system', or nil."
+ (declare (debug (&define name stringp stringp form def-body)))
(let ((start (make-symbol "start"))
(end (make-symbol "end"))
(val (make-symbol "val"))
@@ -1369,23 +1361,6 @@ If BUFFER is not provided, use the current buffer."
(princ "\n")
))))
-;;; EDEBUG Handlers
-;;
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec define-lex-spp-macro-declaration-analyzer
- (&define name stringp stringp form def-body)
- )
-
- (def-edebug-spec define-lex-spp-macro-undeclaration-analyzer
- (&define name stringp stringp form)
- )
-
- (def-edebug-spec define-lex-spp-include-analyzer
- (&define name stringp stringp form def-body))))
-
(provide 'semantic/lex-spp)
;; Local variables:
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 4cafc7d4fe7..69f20deeb76 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -192,9 +192,9 @@ If optional PROPERTY is non-nil, call FUN only on every symbol which
as a PROPERTY value. FUN receives a symbol as argument."
(if (obarrayp table)
(mapatoms
- #'(lambda (symbol)
- (if (or (null property) (get symbol property))
- (funcall fun symbol)))
+ (lambda (symbol)
+ (if (or (null property) (get symbol property))
+ (funcall fun symbol)))
table)))
;;; Lexical keyword table handling.
@@ -286,7 +286,7 @@ If optional PROPERTY is non-nil, return only keywords which have a
PROPERTY set."
(let (keywords)
(semantic-lex-map-keywords
- #'(lambda (symbol) (setq keywords (cons symbol keywords)))
+ (lambda (symbol) (setq keywords (cons symbol keywords)))
property)
keywords))
@@ -462,18 +462,16 @@ If optional PROPERTY is non-nil, return only type symbols which have
PROPERTY set."
(let (types)
(semantic-lex-map-types
- #'(lambda (symbol) (setq types (cons symbol types)))
+ (lambda (symbol) (setq types (cons symbol types)))
property)
types))
;;; Lexical Analyzer framework settings
;;
-;; FIXME change to non-obsolete default.
-(defvar-local semantic-lex-analyzer 'semantic-flex
+(defvar-local semantic-lex-analyzer #'semantic-lex
"The lexical analyzer used for a given buffer.
-See `semantic-lex' for documentation.
-For compatibility with Semantic 1.x it defaults to `semantic-flex'.")
+See `semantic-lex' for documentation.")
(defvar semantic-lex-tokens
'(
@@ -762,6 +760,7 @@ If two analyzers can match the same text, it is important to order the
analyzers so that the one you want to match first occurs first. For
example, it is good to put a number analyzer in front of a symbol
analyzer which might mistake a number for a symbol."
+ (declare (debug (&define name stringp (&rest symbolp))))
`(defun ,name (start end &optional depth length)
,(concat doc "\nSee `semantic-lex' for more information.")
;; Make sure the state of block parsing starts over.
@@ -1066,14 +1065,13 @@ the desired syntax, and a position returned.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
Avoid using a large FORMS since it is duplicated."
+ (declare (indent 1) (debug t))
`(if (and debug-on-error semantic-lex-debug-analyzers)
(progn ,@forms)
(condition-case nil
(progn ,@forms)
(error
(semantic-lex-unterminated-syntax-detected ,syntax)))))
-(put 'semantic-lex-unterminated-syntax-protection
- 'lisp-indent-function 1)
(defmacro define-lex-analyzer (name doc condition &rest forms)
"Create a single lexical analyzer NAME with DOC.
@@ -1098,32 +1096,29 @@ Proper action in FORMS is to move the value of `semantic-lex-end-point' to
after the location of the analyzed entry, and to add any discovered tokens
at the beginning of `semantic-lex-token-stream'.
This can be done by using `semantic-lex-push-token'."
+ (declare (debug (&define name stringp form def-body)))
`(eval-and-compile
- (defvar ,name nil ,doc)
- (defun ,name nil)
- ;; Do this part separately so that re-evaluation rebuilds this code.
- (setq ,name '(,condition ,@forms))
+ ;; This is the real info used by `define-lex' (via semantic-lex-one-token).
+ (defconst ,name '(,condition ,@forms) ,doc)
;; Build a single lexical analyzer function, so the doc for
;; function help is automatically provided, and perhaps the
;; function could be useful for testing and debugging one
;; analyzer.
- (fset ',name (lambda () ,doc
- (let ((semantic-lex-token-stream nil)
- (semantic-lex-end-point (point))
- (semantic-lex-analysis-bounds
- (cons (point) (point-max)))
- (semantic-lex-current-depth 0)
- (semantic-lex-maximum-depth
- semantic-lex-depth)
- )
- (when ,condition ,@forms)
- semantic-lex-token-stream)))
- ))
+ (defun ,name ()
+ ,doc
+ (let ((semantic-lex-token-stream nil)
+ (semantic-lex-end-point (point))
+ (semantic-lex-analysis-bounds (cons (point) (point-max)))
+ (semantic-lex-current-depth 0)
+ (semantic-lex-maximum-depth semantic-lex-depth))
+ (when ,condition ,@forms)
+ semantic-lex-token-stream))))
(defmacro define-lex-regex-analyzer (name doc regexp &rest forms)
"Create a lexical analyzer with NAME and DOC that will match REGEXP.
FORMS are evaluated upon a successful match.
See `define-lex-analyzer' for more about analyzers."
+ (declare (debug (&define name stringp form def-body)))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@@ -1141,6 +1136,8 @@ expression.
FORMS are evaluated upon a successful match BEFORE the new token is
created. It is valid to ignore FORMS.
See `define-lex-analyzer' for more about analyzers."
+ (declare (debug
+ (&define name stringp form symbolp [ &optional form ] def-body)))
`(define-lex-analyzer ,name
,doc
(looking-at ,regexp)
@@ -1165,6 +1162,7 @@ where BLOCK-SYM is the symbol returned in a block token. OPEN-DELIM
and CLOSE-DELIM are respectively the open and close delimiters
identifying a block. OPEN-SYM and CLOSE-SYM are respectively the
symbols returned in open and close tokens."
+ (declare (debug (&define name stringp form (&rest form))))
(let ((specs (cons spec1 specs))
spec open olist clist)
(while specs
@@ -1686,6 +1684,7 @@ the error will be caught here without the buffer's cache being thrown
out of date.
If there is an error, the syntax that failed is returned.
If there is no error, then the last value of FORMS is returned."
+ (declare (indent 1) (debug (symbolp def-body)))
(let ((ret (make-symbol "ret"))
(syntax (make-symbol "syntax"))
(start (make-symbol "start"))
@@ -1709,35 +1708,7 @@ If there is no error, then the last value of FORMS is returned."
;;(message "Buffer not currently parsable (%S)." ,ret)
(semantic-parse-tree-unparseable))
,ret)))
-(put 'semantic-lex-catch-errors 'lisp-indent-function 1)
-
-
-;;; Interfacing with edebug
-;;
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec define-lex
- (&define name stringp (&rest symbolp))
- )
- (def-edebug-spec define-lex-analyzer
- (&define name stringp form def-body)
- )
- (def-edebug-spec define-lex-regex-analyzer
- (&define name stringp form def-body)
- )
- (def-edebug-spec define-lex-simple-regex-analyzer
- (&define name stringp form symbolp [ &optional form ] def-body)
- )
- (def-edebug-spec define-lex-block-analyzer
- (&define name stringp form (&rest form))
- )
- (def-edebug-spec semantic-lex-catch-errors
- (symbolp def-body)
- )
- ))
;;; Compatibility with Semantic 1.x lexical analysis
diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el
index 956eb681f2c..2e77e6b75fb 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -1,4 +1,4 @@
-;;; semantic/mru-bookmark.el --- Automatic bookmark tracking
+;;; semantic/mru-bookmark.el --- Automatic bookmark tracking -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -85,7 +85,7 @@ Nice values include the following:
)
"A single bookmark.")
-(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields)
+(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest _fields)
"Initialize the bookmark SBM with details about :tag."
(condition-case nil
(save-excursion
@@ -216,7 +216,7 @@ Cause tags in the ring to become unlinked."
(setq idx (1+ idx)))))
(add-hook 'semantic-before-toplevel-cache-flush-hook
- 'semantic-mrub-cache-flush-fcn)
+ #'semantic-mrub-cache-flush-fcn)
;;; EDIT tracker
;;
@@ -246,8 +246,8 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]."
:group 'semantic-modes
:type 'boolean
:require 'semantic/util-modes
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
+ :initialize #'custom-initialize-default
+ :set (lambda (_sym val)
(global-semantic-mru-bookmark-mode (if val 1 -1))))
;;;###autoload
@@ -266,7 +266,7 @@ been edited, and you can re-visit them with \\[semantic-mrub-switch-tags]."
(defvar semantic-mru-bookmark-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "\C-xB" 'semantic-mrub-switch-tags)
+ (define-key km "\C-xB" #'semantic-mrub-switch-tags)
km)
"Keymap for mru-bookmark minor mode.")
@@ -289,14 +289,14 @@ non-nil if the minor mode is enabled."
(error "Buffer %s was not set up for parsing"
(buffer-name)))
(add-hook 'semantic-edits-new-change-functions
- 'semantic-mru-bookmark-change-hook-fcn nil t)
+ #'semantic-mru-bookmark-change-hook-fcn nil t)
(add-hook 'semantic-edits-move-change-hooks
- 'semantic-mru-bookmark-change-hook-fcn nil t))
+ #'semantic-mru-bookmark-change-hook-fcn nil t))
;; Remove hooks
(remove-hook 'semantic-edits-new-change-functions
- 'semantic-mru-bookmark-change-hook-fcn t)
+ #'semantic-mru-bookmark-change-hook-fcn t)
(remove-hook 'semantic-edits-move-change-hooks
- 'semantic-mru-bookmark-change-hook-fcn t)))
+ #'semantic-mru-bookmark-change-hook-fcn t)))
(semantic-add-minor-mode 'semantic-mru-bookmark-mode
"k")
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index d7cd8e1940c..fe981d34fb7 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -1,4 +1,4 @@
-;;; semantic/sb.el --- Semantic tag display for speedbar
+;;; semantic/sb.el --- Semantic tag display for speedbar -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -73,10 +73,10 @@ use the `speedbar-line-file' to get this info if needed."
(defmacro semantic-sb-with-tag-buffer (tag &rest forms)
"Set the current buffer to the origin of TAG and execute FORMS.
Restore the old current buffer when completed."
+ (declare (indent 1) (debug t))
`(save-excursion
(semantic-sb-tag-set-buffer ,tag)
,@forms))
-(put 'semantic-sb-with-tag-buffer 'lisp-indent-function 1)
;;; Button Generation
;;
@@ -279,7 +279,7 @@ Optional MODIFIERS is additional text needed for variables."
(defun semantic-sb-show-extra (text token indent)
"Display additional information about the token as an expansion.
TEXT TOKEN and INDENT are the details."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -288,13 +288,13 @@ TEXT TOKEN and INDENT are the details."
(narrow-to-region (point) (point))
;; Add in stuff specific to this type of token.
(semantic-sb-insert-details token (1+ indent))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defun semantic-sb-token-jump (text token indent)
+(defun semantic-sb-token-jump (_text token indent)
"Jump to the location specified in token.
TEXT TOKEN and INDENT are the details."
(let ((file
@@ -325,7 +325,7 @@ TEXT TOKEN and INDENT are the details."
(defun semantic-sb-expand-group (text token indent)
"Expand a group which has semantic tokens.
TEXT TOKEN and INDENT are the details."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -333,7 +333,7 @@ TEXT TOKEN and INDENT are the details."
(save-restriction
(narrow-to-region (point-min) (point))
(semantic-sb-buttons-plain (1+ indent) token)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 31576d29bc6..2d806e58eeb 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,4 +1,4 @@
-;;; semantic/scope.el --- Analyzer Scope Calculations
+;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.")
)
(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
- new-tags)
+ _new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
@@ -262,7 +262,7 @@ are from nesting data types."
(semantic-go-to-tag pparent)
(setq stack (semantic-find-tag-by-overlay (point)))
;; Step one, find the merged version of stack in the typecache.
- (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack)))
+ (let* ((stacknames (reverse (mapcar #'semantic-tag-name stack)))
(tc nil)
)
;; @todo - can we use the typecache ability to
@@ -317,7 +317,7 @@ are from nesting data types."
;; returnlist is empty.
(while snlist
(setq fullsearchname
- (append (mapcar 'semantic-tag-name returnlist)
+ (append (mapcar #'semantic-tag-name returnlist)
(list (car snlist)))) ;; Next one
(setq ptag
(semanticdb-typecache-find fullsearchname))
@@ -325,8 +325,8 @@ are from nesting data types."
(when (or (not ptag)
(not (semantic-tag-of-class-p ptag 'type)))
(let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
+ (apply #'append
+ (mapcar #'semantic-tag-type-members
(cons (car returnlist) scopetypes)
)))
)
@@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE."
(setq leftover (cons S leftover)))))
(nreverse leftover)))
-(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
+(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit _protection)
"Return all parts of TYPE, a tag representing a TYPE declaration.
SCOPE is the scope object.
NOINHERIT turns off searching of inherited tags.
@@ -562,7 +562,7 @@ such as `public' or `private'."
;; @TODO - is this line needed?? Try w/out for a while
;; @note - I think C++ says no. elisp might, but methods
;; look like defuns, so it makes no difference.
- (extmeth nil) ; (semantic-tag-external-member-children type t))
+ ;;(extmeth nil) ; (semantic-tag-external-member-children type t))
;; INHERITED are tags found in classes that our TYPE tag
;; inherits from. Do not do this if it was not requested.
@@ -584,7 +584,7 @@ such as `public' or `private'."
(setq slots (nreverse copyslots))
))
;; Flatten the database output.
- (append slots extmeth inherited)
+ (append slots nil inherited) ;; extmeth
)))
(defun semantic-analyze-scoped-inherited-tags (type scope access)
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
index f33356a170c..19530094fbe 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -1,4 +1,4 @@
-;;; semantic/senator.el --- SEmantic NAvigaTOR
+;;; semantic/senator.el --- SEmantic NAvigaTOR -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -60,7 +60,6 @@ A tag class is a symbol, such as `variable', `function', or `type'.
As a special exception, if the value is nil, Senator's navigation
commands recognize all tag classes."
- :group 'senator
:type '(repeat (symbol)))
;;;###autoload
(make-variable-buffer-local 'senator-step-at-tag-classes)
@@ -78,7 +77,6 @@ commands stop at the beginning of every tag.
If t, the navigation commands stop at the start and end of any
tag, where possible."
- :group 'senator
:type '(choice :tag "Identifiers"
(repeat :menu-tag "Symbols" (symbol))
(const :tag "All" t)))
@@ -87,7 +85,6 @@ tag, where possible."
(defcustom senator-highlight-found nil
"If non-nil, Senator commands momentarily highlight found tags."
- :group 'senator
:type 'boolean)
(make-variable-buffer-local 'senator-highlight-found)
@@ -193,7 +190,6 @@ source."
'(code block)
"List of ignored tag classes.
Tags of those classes are excluded from search."
- :group 'senator
:type '(repeat (symbol :tag "class")))
(defun senator-search-default-tag-filter (tag)
@@ -461,7 +457,7 @@ filters in `senator-search-tag-filter-functions' remain active."
((symbolp classes)
(list classes))
((stringp classes)
- (mapcar 'read (split-string classes)))
+ (mapcar #'read (split-string classes)))
(t
(signal 'wrong-type-argument (list classes)))
))
@@ -470,11 +466,10 @@ filters in `senator-search-tag-filter-functions' remain active."
senator--search-filter t)
(kill-local-variable 'senator--search-filter)
(if classes
- (let ((tag (make-symbol "tag"))
- (names (mapconcat 'symbol-name classes "', `")))
+ (let ((names (mapconcat #'symbol-name classes "', `")))
(setq-local senator--search-filter
- `(lambda (,tag)
- (memq (semantic-tag-class ,tag) ',classes)))
+ (lambda (tag)
+ (memq (semantic-tag-class tag) classes)))
(add-hook 'senator-search-tag-filter-functions
senator--search-filter nil t)
(message "Limit search to `%s' tags" names))
@@ -605,7 +600,7 @@ Makes C/C++ language like assumptions."
"Non-nil if isearch does semantic search.
This is a buffer local variable.")
-(defun senator-beginning-of-defun (&optional arg)
+(defun senator-beginning-of-defun (&optional _arg)
"Move backward to the beginning of a defun.
Use semantic tags to navigate.
ARG is the number of tags to navigate (not yet implemented)."
@@ -620,7 +615,7 @@ ARG is the number of tags to navigate (not yet implemented)."
(goto-char (semantic-tag-start tag)))
(beginning-of-line))))
-(defun senator-end-of-defun (&optional arg)
+(defun senator-end-of-defun (&optional _arg)
"Move forward to next end of defun.
Use semantic tags to navigate.
ARG is the number of tags to navigate (not yet implemented)."
@@ -859,7 +854,7 @@ Use a senator search function when semantic isearch mode is enabled."
(setq-local senator-old-isearch-search-fun
isearch-search-fun-function))
(setq-local isearch-search-fun-function
- 'senator-isearch-search-fun))
+ #'senator-isearch-search-fun))
;; When `senator-isearch-semantic-mode' is off restore the
;; previous `isearch-search-fun-function'.
(when (eq isearch-search-fun-function 'senator-isearch-search-fun)
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index 19f46ff7f15..b4b09dc02c8 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -1,6 +1,6 @@
-;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables.
+;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables. -*- lexical-binding: t; -*-
-;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -233,8 +233,7 @@ unmodified as components of their parent tags."
(semantic-flatten-tags-table components)
lists)))))
table)
- (apply 'append (nreverse lists))
- ))
+ (apply #'append (nreverse lists))))
;;; Buckets:
@@ -520,12 +519,11 @@ See `semantic-tag-external-member-children' for details."
(semantic-tag-name tag) tag)))
(if m (apply #'append (mapcar #'cdr m))))
(semantic--find-tags-by-function
- `(lambda (tok)
- ;; This bit of annoying backquote forces the contents of
- ;; tag into the generated lambda.
- (semantic-tag-external-member-p ',tag tok))
- (current-buffer))
- ))
+ (lambda (tok)
+ ;; This bit of annoying backquote forces the contents of
+ ;; tag into the generated lambda.
+ (semantic-tag-external-member-p tag tok))
+ (current-buffer))))
(define-overloadable-function semantic-tag-external-class (tag)
"Return a list of real tags that faux TAG might represent.
@@ -540,6 +538,8 @@ likely derived, then this function is needed."
(:override)
)
+(defvar semanticdb-search-system-databases)
+
(defun semantic-tag-external-class-default (tag)
"Return a list of real tags that faux TAG might represent.
See `semantic-tag-external-class' for details."
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index d7f91573d3d..701f9ad3e03 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -1,4 +1,4 @@
-;;; semantic/symref.el --- Symbol Reference API
+;;; semantic/symref.el --- Symbol Reference API -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -144,7 +144,7 @@ ARGS are the initialization arguments to pass to the created class."
)
(when (not (class-p class))
(error "Unknown symref tool %s" semantic-symref-tool))
- (setq inst (apply 'make-instance class args))
+ (setq inst (apply #'make-instance class args))
inst))
(defvar semantic-symref-last-result nil
@@ -427,7 +427,7 @@ until the next command is executed."
(kill-buffer buff)))
semantic-symref-recently-opened-buffers)
(setq semantic-symref-recently-opened-buffers nil)
- (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ (remove-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn)
)
(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
@@ -453,7 +453,7 @@ already."
lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
(if (not open-buffers)
- (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ (add-hook 'post-command-hook #'semantic-symref-cleanup-recent-buffers-fcn)
;; Else, just clear the saved buffers so they aren't deleted later.
(setq semantic-symref-recently-opened-buffers nil)
)
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index 3686e519460..e63b7a7e914 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -1,6 +1,6 @@
-;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
+;;; semantic/symref/cscope.el --- Semantic-symref support via cscope -*- lexical-binding: t; -*-
-;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index a40ce13f3d6..7ef3cd90d67 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
+;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -48,7 +48,7 @@
"Determine if the tag TARGET is used at POSITION in the current buffer.
Return non-nil for a match."
(semantic-analyze-current-symbol
- (lambda (start end prefix)
+ (lambda (_start _end prefix)
(let ((tag (car (nreverse prefix))))
(and (semantic-tag-p tag)
(semantic-equivalent-tag-p target tag))))
@@ -97,7 +97,7 @@ tag that contains point, and return that."
(Lcount 0))
(when (semantic-tag-p target)
(semantic-symref-hits-in-region
- target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
+ target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount)))
(semantic-tag-start tag)
(semantic-tag-end tag))
(when (called-interactively-p 'interactive)
@@ -106,6 +106,8 @@ tag that contains point, and return that."
(semantic-elapsed-time start nil)))
Lcount)))
+(defvar srecode-field-archive)
+
(defun semantic-symref-rename-local-variable ()
"Fancy way to rename the local variable under point.
Depends on the SRecode Field editing API."
@@ -140,7 +142,7 @@ Depends on the SRecode Field editing API."
(region nil)
)
(semantic-symref-hits-in-region
- target (lambda (start end prefix)
+ target (lambda (start end _prefix)
;; For every valid hit, create one field.
(srecode-field "LOCAL" :name "LOCAL" :start start :end end))
(semantic-tag-start tag) (semantic-tag-end tag))
diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el
index 7f63e4ddbc0..23e40349a6b 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/global.el --- Use GNU Global for symbol references
+;;; semantic/symref/global.el --- Use GNU Global for symbol references -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index 9f0ac38ec75..180d779a780 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/grep.el --- Symref implementation using find/grep
+;;; semantic/symref/grep.el --- Symref implementation using find/grep -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -168,7 +168,7 @@ This shell should support pipe redirect syntax."
(erase-buffer)
(setq default-directory rootdir)
(let ((cmd (semantic-symref-grep-use-template
- (file-name-as-directory (file-local-name rootdir))
+ (directory-file-name (file-local-name rootdir))
filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)))
diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el
index 4a41355dd69..3e3e3b0a940 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -1,6 +1,6 @@
-;;; semantic/symref/idutils.el --- Symref implementation for idutils
+;;; semantic/symref/idutils.el --- Symref implementation for idutils -*- lexical-binding: t; -*-
-;;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index 7d3a5ddc2dc..2e447bbc582 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -1,4 +1,4 @@
-;;; semantic/symref/list.el --- Symref Output List UI.
+;;; semantic/symref/list.el --- Symref Output List UI -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -108,20 +108,20 @@ Display the references in `semantic-symref-results-mode'."
(defvar semantic-symref-results-mode-map
(let ((km (make-sparse-keymap)))
(suppress-keymap km)
- (define-key km "\C-i" 'forward-button)
- (define-key km "\M-C-i" 'backward-button)
- (define-key km " " 'push-button)
- (define-key km "-" 'semantic-symref-list-toggle-showing)
- (define-key km "=" 'semantic-symref-list-toggle-showing)
- (define-key km "+" 'semantic-symref-list-toggle-showing)
- (define-key km "n" 'semantic-symref-list-next-line)
- (define-key km "p" 'semantic-symref-list-prev-line)
- (define-key km "q" 'quit-window)
- (define-key km "\C-c\C-e" 'semantic-symref-list-expand-all)
- (define-key km "\C-c\C-r" 'semantic-symref-list-contract-all)
- (define-key km "R" 'semantic-symref-list-rename-open-hits)
- (define-key km "(" 'semantic-symref-list-create-macro-on-open-hit)
- (define-key km "E" 'semantic-symref-list-call-macro-on-open-hits)
+ (define-key km "\C-i" #'forward-button)
+ (define-key km "\M-C-i" #'backward-button)
+ (define-key km " " #'push-button)
+ (define-key km "-" #'semantic-symref-list-toggle-showing)
+ (define-key km "=" #'semantic-symref-list-toggle-showing)
+ (define-key km "+" #'semantic-symref-list-toggle-showing)
+ (define-key km "n" #'semantic-symref-list-next-line)
+ (define-key km "p" #'semantic-symref-list-prev-line)
+ (define-key km "q" #'quit-window)
+ (define-key km "\C-c\C-e" #'semantic-symref-list-expand-all)
+ (define-key km "\C-c\C-r" #'semantic-symref-list-contract-all)
+ (define-key km "R" #'semantic-symref-list-rename-open-hits)
+ (define-key km "(" #'semantic-symref-list-create-macro-on-open-hit)
+ (define-key km "E" #'semantic-symref-list-call-macro-on-open-hits)
km)
"Keymap used in `semantic-symref-results-mode'.")
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index fc5c27752a0..06dd274b323 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -1,4 +1,4 @@
-;;; semantic/tag-file.el --- Routines that find files based on tags.
+;;; semantic/tag-file.el --- Routines that find files based on tags. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 6cef603af35..3aa1a62901c 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -1,4 +1,4 @@
-;;; semantic/tag-ls.el --- Language Specific override functions for tags
+;;; semantic/tag-ls.el --- Language Specific override functions for tags -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2004, 2006-2021 Free Software Foundation, Inc.
@@ -97,7 +97,7 @@ Modes that override this function can call
`semantic--tag-attribute-similar-p-default' to do the default equality tests if
ATTR is not special for that mode.")
-(defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes)
+(defun semantic--tag-attribute-similar-p-default (_attr value1 value2 ignorable-attributes)
"For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity."
(cond
;; Tag sublists require special testing.
@@ -109,7 +109,7 @@ ATTR is not special for that mode.")
(when (not (eq (length taglist1) (length taglist2)))
(setq ans nil))
(while (and ans taglist1 taglist2)
- (setq ans (apply 'semantic-tag-similar-p
+ (setq ans (apply #'semantic-tag-similar-p
(car taglist1) (car taglist2)
ignorable-attributes)
taglist1 (cdr taglist1)
@@ -205,7 +205,7 @@ stream for a tag of class `package', and return that."
(or stream-or-buffer tag))))
(:override-with-args (tag stream))))
-(defun semantic-tag-full-package-default (tag stream)
+(defun semantic-tag-full-package-default (_tag stream)
"Default method for `semantic-tag-full-package' for TAG.
Return the name of the first tag of class `package' in STREAM."
(let ((pack (car-safe (semantic-find-tags-by-class 'package stream))))
@@ -285,7 +285,7 @@ is to return a symbol based on type modifiers."
(setq parent (semantic-tag-calculate-parent tag)))
(:override))
-(defun semantic-tag-protection-default (tag &optional parent)
+(defun semantic-tag-protection-default (tag &optional _parent)
"Return the protection of TAG as a child of PARENT default action.
See `semantic-tag-protection'."
(let ((mods (semantic-tag-modifiers tag))
@@ -295,9 +295,7 @@ See `semantic-tag-protection'."
(let ((s (car mods)))
(setq prot
;; A few silly defaults to get things started.
- (cond ((or (string= s "public")
- (string= s "extern")
- (string= s "export"))
+ (cond ((member s '("public" "extern" "export"))
'public)
((string= s "private")
'private)
@@ -372,15 +370,14 @@ in how methods are overridden. In UML, abstract methods are italicized.
The default behavior (if not overridden with `tag-abstract-p'
is to return true if `abstract' is in the type modifiers.")
-(defun semantic-tag-abstract-p-default (tag &optional parent)
+(defun semantic-tag-abstract-p-default (tag &optional _parent)
"Return non-nil if TAG is abstract as a child of PARENT default action.
See `semantic-tag-abstract-p'."
(let ((mods (semantic-tag-modifiers tag))
(abs nil))
(while (and (not abs) mods)
(if (stringp (car mods))
- (setq abs (or (string= (car mods) "abstract")
- (string= (car mods) "virtual"))))
+ (setq abs (member (car mods) '("abstract" "virtual"))))
(setq mods (cdr mods)))
abs))
@@ -392,7 +389,7 @@ In UML, leaf methods and classes have special meaning and behavior.
The default behavior (if not overridden with `tag-leaf-p'
is to return true if `leaf' is in the type modifiers.")
-(defun semantic-tag-leaf-p-default (tag &optional parent)
+(defun semantic-tag-leaf-p-default (tag &optional _parent)
"Return non-nil if TAG is leaf as a child of PARENT default action.
See `semantic-tag-leaf-p'."
(let ((mods (semantic-tag-modifiers tag))
@@ -412,7 +409,7 @@ In UML, static methods and attributes mean that they are allocated
in the parent class, and are not instance specific.
UML notation specifies that STATIC entries are underlined.")
-(defun semantic-tag-static-p-default (tag &optional parent)
+(defun semantic-tag-static-p-default (tag &optional _parent)
"Return non-nil if TAG is static as a child of PARENT default action.
See `semantic-tag-static-p'."
(let ((mods (semantic-tag-modifiers tag))
diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el
index f705c89c904..9d5aeea098b 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -1,4 +1,4 @@
-;;; semantic/tag-write.el --- Write tags to a text stream
+;;; semantic/tag-write.el --- Write tags to a text stream -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -88,7 +88,7 @@ INDENT is the amount of indentation to use for this tag."
(if (semantic-tag-with-position-p tag)
(let ((bounds (semantic-tag-bounds tag)))
(princ " ")
- (prin1 (apply 'vector bounds))
+ (prin1 (apply #'vector bounds))
)
(princ " nil"))
;; End it.
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 85defe4f2c0..b6386d71db0 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1,4 +1,4 @@
-;;; semantic/tag.el --- tag creation and access
+;;; semantic/tag.el --- Tag creation and access -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
@@ -229,6 +229,28 @@ See also the function `semantic-ctxt-current-mode'."
(require 'semantic/ctxt)
(semantic-ctxt-current-mode)))))
+;; Is this function still necessary?
+(defun semantic-tag-make-plist (args)
+ "Create a property list with ARGS.
+Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN).
+Where KEY is a symbol, and VALUE is the value for that symbol.
+The return value will be a new property list, with these KEY/VALUE
+pairs eliminated:
+
+ - KEY associated to nil VALUE.
+ - KEY associated to an empty string VALUE.
+ - KEY associated to a zero VALUE."
+ (let (plist key val)
+ (while args
+ (setq key (car args)
+ val (nth 1 args)
+ args (nthcdr 2 args))
+ (or (member val '("" nil))
+ (and (numberp val) (zerop val))
+ (setq plist (cons key (cons val plist)))))
+ ;; It is not useful to reverse the new plist.
+ plist))
+
(defsubst semantic--tag-attributes-cdr (tag)
"Return the cons cell whose car is the ATTRIBUTES part of TAG.
That function is for internal use only."
@@ -441,28 +463,6 @@ class to store those methods."
;;; Tag creation
;;
-;; Is this function still necessary?
-(defun semantic-tag-make-plist (args)
- "Create a property list with ARGS.
-Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN).
-Where KEY is a symbol, and VALUE is the value for that symbol.
-The return value will be a new property list, with these KEY/VALUE
-pairs eliminated:
-
- - KEY associated to nil VALUE.
- - KEY associated to an empty string VALUE.
- - KEY associated to a zero VALUE."
- (let (plist key val)
- (while args
- (setq key (car args)
- val (nth 1 args)
- args (nthcdr 2 args))
- (or (member val '("" nil))
- (and (numberp val) (zerop val))
- (setq plist (cons key (cons val plist)))))
- ;; It is not useful to reverse the new plist.
- plist))
-
(defsubst semantic-tag (name class &rest attributes)
"Create a generic semantic tag.
NAME is a string representing the name of this tag.
@@ -478,7 +478,7 @@ TYPE is a string or semantic tag representing the type of this variable.
Optional DEFAULT-VALUE is a string representing the default value of this
variable.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'variable
+ (apply #'semantic-tag name 'variable
:type type
:default-value default-value
attributes))
@@ -490,7 +490,7 @@ TYPE is a string or semantic tag representing the type of this function.
ARG-LIST is a list of strings or semantic tags representing the
arguments of this function.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'function
+ (apply #'semantic-tag name 'function
:type type
:arguments arg-list
attributes))
@@ -513,7 +513,7 @@ This slot can be interesting because the form:
is a valid parent where there is no explicit parent, and only an
interface.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'type
+ (apply #'semantic-tag name 'type
:type type
:members members
:superclasses (car parents)
@@ -526,7 +526,7 @@ NAME is the name of this include.
SYSTEM-FLAG represents that we were able to identify this include as
belonging to the system, as opposed to belonging to the local project.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'include
+ (apply #'semantic-tag name 'include
:system-flag system-flag
attributes))
@@ -536,7 +536,7 @@ NAME is the name of this package.
DETAIL is extra information about this package, such as a location
where it can be found.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'package
+ (apply #'semantic-tag name 'package
:detail detail
attributes))
@@ -545,7 +545,7 @@ ATTRIBUTES is a list of additional attributes belonging to this tag."
NAME is a name for this code.
DETAIL is extra information about the code.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'code
+ (apply #'semantic-tag name 'code
:detail detail
attributes))
@@ -685,7 +685,7 @@ FILTER takes TAG as an argument, and should return a `semantic-tag'.
It is safe for FILTER to modify the input tag and return it."
(when (not filter) (setq filter 'identity))
(when (not (semantic-tag-p tag))
- (signal 'wrong-type-argument (list tag 'semantic-tag-p)))
+ (signal 'wrong-type-argument (list tag #'semantic-tag-p)))
(let ((ol (semantic-tag-overlay tag))
(fn (semantic-tag-file-name tag)))
(funcall filter (list (semantic-tag-name tag)
@@ -937,7 +937,7 @@ NAME is a name for this alias.
META-TAG-CLASS is the class of the tag this tag is an alias.
VALUE is the aliased definition.
ATTRIBUTES is a list of additional attributes belonging to this tag."
- (apply 'semantic-tag name 'alias
+ (apply #'semantic-tag name 'alias
:aliasclass meta-tag-class
:definition value
attributes))
@@ -1038,25 +1038,17 @@ See `semantic-tag-bounds'."
(defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body)
"Execute BODY with the buffer narrowed to the current tag."
+ (declare (indent 0) (debug t))
`(save-restriction
(semantic-narrow-to-tag (semantic-current-tag))
,@body))
-(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
- (def-body))))
(defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body)
"Narrow to TAG, and execute BODY."
+ (declare (indent 1) (debug t))
`(save-restriction
(semantic-narrow-to-tag ,tag)
,@body))
-(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1)
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec semantic-with-buffer-narrowed-to-tag
- (def-body))))
;;; Tag Hooks
;;
@@ -1101,7 +1093,7 @@ For any given situation, additional ARGS may be passed."
(condition-case err
;; If a hook bombs, ignore it! Usually this is tied into
;; some sort of critical system.
- (apply 'run-hook-with-args 'semantic--tag-hook-value arglist)
+ (apply #'run-hook-with-args 'semantic--tag-hook-value arglist)
(error (message "Error: %S" err)))))
;;; Tags and Overlays
@@ -1112,7 +1104,7 @@ For any given situation, additional ARGS may be passed."
(defsubst semantic--tag-unlink-list-from-buffer (tags)
"Convert TAGS from using an overlay to using an overlay proxy.
This function is for internal use only."
- (mapcar 'semantic--tag-unlink-from-buffer tags))
+ (mapcar #'semantic--tag-unlink-from-buffer tags))
(defun semantic--tag-unlink-from-buffer (tag)
"Convert TAG from using an overlay to using an overlay proxy.
@@ -1133,7 +1125,7 @@ This function is for internal use only."
(defsubst semantic--tag-link-list-to-buffer (tags)
"Convert TAGS from using an overlay proxy to using an overlay.
This function is for internal use only."
- (mapc 'semantic--tag-link-to-buffer tags))
+ (mapc #'semantic--tag-link-to-buffer tags))
(defun semantic--tag-link-to-buffer (tag)
"Convert TAG from using an overlay proxy to using an overlay.
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 377cec5455d..5a38280d2a2 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -1,4 +1,4 @@
-;;; semantic/texi.el --- Semantic details for Texinfo files
+;;; semantic/texi.el --- Semantic details for Texinfo files -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2005, 2007-2021 Free Software Foundation, Inc.
@@ -55,7 +55,7 @@ The field position is the field number (based at 1) where the
name of this section is.")
;;; Code:
-(defun semantic-texi-parse-region (&rest ignore)
+(defun semantic-texi-parse-region (&rest _ignore)
"Parse the current texinfo buffer for semantic tags.
IGNORE any arguments, always parse the whole buffer.
Each tag returned is of the form:
@@ -79,7 +79,7 @@ function `semantic-install-function-overrides'."
(let ((chil (semantic-tag-components tag)))
(if chil
(semantic-tag-put-attribute
- tag :members (mapcar 'semantic-texi-expand-tag chil)))
+ tag :members (mapcar #'semantic-texi-expand-tag chil)))
(car (semantic--tag-expand tag))))
(defun semantic-texi-parse-headings ()
@@ -297,7 +297,7 @@ can handle the @menu environment.")
nil))
(define-mode-local-override semantic-ctxt-current-class-list
- texinfo-mode (&optional point)
+ texinfo-mode (&optional _point)
"Determine the class of tags that can be used at POINT.
For texinfo, there two possibilities returned.
1) `function' - for a call to a texinfo function
@@ -368,7 +368,7 @@ Optional argument POINT is where to look for the environment."
(declare-function semantic-analyze-context "semantic/analyze")
(define-mode-local-override semantic-analyze-current-context
- texinfo-mode (point)
+ texinfo-mode (_point)
"Analysis context makes no sense for texinfo. Return nil."
(let* ((prefixandbounds (semantic-ctxt-current-symbol-and-bounds (point)))
(prefix (car prefixandbounds))
@@ -408,7 +408,7 @@ Optional argument POINT is where to look for the environment."
"List of commands that we might bother completing.")
(define-mode-local-override semantic-analyze-possible-completions
- texinfo-mode (context &rest flags)
+ texinfo-mode (context &rest _flags)
"List smart completions at point.
Since texinfo is not a programming language the default version is not
useful. Instead, look at the current symbol. If it is a command
@@ -451,7 +451,7 @@ that start with that symbol."
(setq semantic-parser-name "TEXI"
;; Setup a dummy parser table to enable parsing!
semantic--parse-table t
- imenu-create-index-function 'semantic-create-imenu-index
+ imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character "@"
semantic-type-relation-separator-character '(":")
semantic-symbol->name-assoc-list '((section . "Section")
@@ -466,7 +466,7 @@ that start with that symbol."
;; (local-set-key [(f9)] 'semantic-texi-update-doc-from-texi)
)
-(add-hook 'texinfo-mode-hook 'semantic-default-texi-setup)
+(add-hook 'texinfo-mode-hook #'semantic-default-texi-setup)
;;; Special features of Texinfo tag streams
@@ -500,7 +500,7 @@ that start with that symbol."
;; Turns out this might not be useful.
;; Delete later if that is true.
-(defun semantic-texi-find-documentation (name &optional type)
+(defun semantic-texi-find-documentation (name &optional _type)
"Find the function or variable NAME of TYPE in the texinfo source.
NAME is a string representing some functional symbol.
TYPE is a string, such as \"variable\" or \"Command\" used to find
diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el
index 0de66d29e3e..106862837a1 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -1,4 +1,4 @@
-;;; semantic/util-modes.el --- Semantic minor modes
+;;; semantic/util-modes.el --- Semantic minor modes -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2005, 2007-2021 Free Software Foundation, Inc.
@@ -48,7 +48,7 @@ line."
:group 'semantic
:type 'boolean
:require 'semantic/util-modes
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
;; Update status of all Semantic enabled buffers
@@ -60,7 +60,7 @@ line."
:group 'semantic
:type 'string
:require 'semantic/util-modes
- :initialize 'custom-initialize-default)
+ :initialize #'custom-initialize-default)
(defvar semantic-minor-modes-format nil
"Mode line format showing Semantic minor modes which are locally enabled.
@@ -93,7 +93,7 @@ Only minor modes that are locally enabled are shown in the mode line."
(match-string 1 semantic-mode-line-prefix)
"S")))
(setq semantic-minor-modes-format
- `((:eval (if (or ,@(mapcar 'car locals))
+ `((:eval (if (or ,@(mapcar #'car locals))
,(concat " " prefix)))))
;; It would be easier to just put `locals' inside
;; semantic-minor-modes-format, but then things like
@@ -111,7 +111,7 @@ Only minor modes that are locally enabled are shown in the mode line."
(cons elem minor-mode-alist)))))
(setcdr tail (nconc locals (cdr tail)))))))))
-(defun semantic-desktop-ignore-this-minor-mode (buffer)
+(defun semantic-desktop-ignore-this-minor-mode (_buffer)
"Installed as a minor-mode initializer for Desktop mode.
BUFFER is the buffer to not initialize a Semantic minor mode in."
nil)
@@ -162,7 +162,7 @@ too an interactive function used to toggle the mode."
;; Update the minor mode format.
(semantic-mode-line-update)
;; Then turn MODE on or off in every Semantic enabled buffer.
- (semantic-map-buffers #'(lambda () (funcall mode arg))))
+ (semantic-map-buffers (lambda () (funcall mode arg))))
;;;;
;;;; Minor mode to highlight areas that a user edits.
@@ -221,10 +221,10 @@ non-nil if the minor mode is enabled."
(error "Buffer %s was not set up for parsing"
(buffer-name)))
(add-hook 'semantic-edits-new-change-functions
- 'semantic-highlight-edits-new-change-hook-fcn nil t))
+ #'semantic-highlight-edits-new-change-hook-fcn nil t))
;; Remove hooks
(remove-hook 'semantic-edits-new-change-functions
- 'semantic-highlight-edits-new-change-hook-fcn t)))
+ #'semantic-highlight-edits-new-change-hook-fcn t)))
(semantic-add-minor-mode 'semantic-highlight-edits-mode
"e")
@@ -345,7 +345,7 @@ Do not search past BOUND if non-nil."
(defvar semantic-show-unmatched-syntax-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "\C-c,`" 'semantic-show-unmatched-syntax-next)
+ (define-key km "\C-c,`" #'semantic-show-unmatched-syntax-next)
km)
"Keymap for command `semantic-show-unmatched-syntax-mode'.")
@@ -372,18 +372,18 @@ non-nil if the minor mode is enabled.
(buffer-name)))
;; Add hooks
(add-hook 'semantic-unmatched-syntax-hook
- 'semantic-show-unmatched-syntax nil t)
+ #'semantic-show-unmatched-syntax nil t)
(add-hook 'semantic-pre-clean-token-hooks
- 'semantic-clean-token-of-unmatched-syntax nil t)
+ #'semantic-clean-token-of-unmatched-syntax nil t)
;; Show unmatched syntax elements
(if (not (semantic--umatched-syntax-needs-refresh-p))
(semantic-show-unmatched-syntax
(semantic-unmatched-syntax-tokens))))
;; Remove hooks
(remove-hook 'semantic-unmatched-syntax-hook
- 'semantic-show-unmatched-syntax t)
+ #'semantic-show-unmatched-syntax t)
(remove-hook 'semantic-pre-clean-token-hooks
- 'semantic-clean-token-of-unmatched-syntax t)
+ #'semantic-clean-token-of-unmatched-syntax t)
;; Cleanup unmatched-syntax highlighting
(semantic-clean-unmatched-syntax-in-buffer)))
@@ -454,46 +454,46 @@ non-nil if the minor mode is enabled."
'(semantic-show-parser-state-string))))
;; Add hooks
(add-hook 'semantic-edits-new-change-functions
- 'semantic-show-parser-state-marker nil t)
+ #'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-edits-incremental-reparse-failed-hook
- 'semantic-show-parser-state-marker nil t)
+ #'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-after-partial-cache-change-hook
- 'semantic-show-parser-state-marker nil t)
+ #'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-show-parser-state-marker nil t)
+ #'semantic-show-parser-state-marker nil t)
(semantic-show-parser-state-marker)
(add-hook 'semantic-before-auto-parse-hooks
- 'semantic-show-parser-state-auto-marker nil t)
+ #'semantic-show-parser-state-auto-marker nil t)
(add-hook 'semantic-after-auto-parse-hooks
- 'semantic-show-parser-state-marker nil t)
+ #'semantic-show-parser-state-marker nil t)
(add-hook 'semantic-before-idle-scheduler-reparse-hook
- 'semantic-show-parser-state-auto-marker nil t)
+ #'semantic-show-parser-state-auto-marker nil t)
(add-hook 'semantic-after-idle-scheduler-reparse-hook
- 'semantic-show-parser-state-marker nil t))
+ #'semantic-show-parser-state-marker nil t))
;; Remove parts of mode line
(setq mode-line-modified
(delq 'semantic-show-parser-state-string mode-line-modified))
;; Remove hooks
(remove-hook 'semantic-edits-new-change-functions
- 'semantic-show-parser-state-marker t)
+ #'semantic-show-parser-state-marker t)
(remove-hook 'semantic-edits-incremental-reparse-failed-hook
- 'semantic-show-parser-state-marker t)
+ #'semantic-show-parser-state-marker t)
(remove-hook 'semantic-after-partial-cache-change-hook
- 'semantic-show-parser-state-marker t)
+ #'semantic-show-parser-state-marker t)
(remove-hook 'semantic-after-toplevel-cache-change-hook
- 'semantic-show-parser-state-marker t)
+ #'semantic-show-parser-state-marker t)
(remove-hook 'semantic-before-auto-parse-hooks
- 'semantic-show-parser-state-auto-marker t)
+ #'semantic-show-parser-state-auto-marker t)
(remove-hook 'semantic-after-auto-parse-hooks
- 'semantic-show-parser-state-marker t)
+ #'semantic-show-parser-state-marker t)
(remove-hook 'semantic-before-idle-scheduler-reparse-hook
- 'semantic-show-parser-state-auto-marker t)
+ #'semantic-show-parser-state-auto-marker t)
(remove-hook 'semantic-after-idle-scheduler-reparse-hook
- 'semantic-show-parser-state-marker t)))
+ #'semantic-show-parser-state-marker t)))
(semantic-add-minor-mode 'semantic-show-parser-state-mode
"")
@@ -502,7 +502,7 @@ non-nil if the minor mode is enabled."
"String showing the parser state for this buffer.
See `semantic-show-parser-state-marker' for details.")
-(defun semantic-show-parser-state-marker (&rest ignore)
+(defun semantic-show-parser-state-marker (&rest _ignore)
"Set `semantic-show-parser-state-string' to indicate parser state.
This marker is one of the following:
`-' -> The cache is up to date.
@@ -555,7 +555,7 @@ to indicate a parse in progress."
(defvar semantic-stickyfunc-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km [ header-line down-mouse-1 ] 'semantic-stickyfunc-menu)
+ (define-key km [ header-line down-mouse-1 ] #'semantic-stickyfunc-menu)
km)
"Keymap for stickyfunc minor mode.")
@@ -826,7 +826,7 @@ Argument EVENT describes the event that caused this function to be called."
(defvar semantic-highlight-func-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km [mouse-3] 'semantic-highlight-func-menu)
+ (define-key km [mouse-3] #'semantic-highlight-func-menu)
km)
"Keymap for highlight-func minor mode.")
@@ -916,10 +916,10 @@ non-nil if the minor mode is enabled."
(error "Buffer %s was not set up for parsing" (buffer-name)))
;; Setup our hook
(add-hook 'post-command-hook
- 'semantic-highlight-func-highlight-current-tag nil t))
+ #'semantic-highlight-func-highlight-current-tag nil t))
;; Disable highlight func mode
(remove-hook 'post-command-hook
- 'semantic-highlight-func-highlight-current-tag t)
+ #'semantic-highlight-func-highlight-current-tag t)
(semantic-highlight-func-highlight-current-tag t)))
(defun semantic-highlight-func-highlight-current-tag (&optional disable)
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 8c487e14ed5..bfc923c75b4 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -1,6 +1,6 @@
-;;; semantic/util.el --- Utilities for use with semantic tag tables
+;;; semantic/util.el --- Utilities for use with semantic tag tables -*- lexical-binding: t; -*-
-;;; Copyright (C) 1999-2005, 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -114,7 +114,10 @@ buffer, or a filename. If SOMETHING is nil return nil."
((and (featurep 'semantic/db)
(require 'semantic/db-mode)
(semanticdb-minor-mode-p)
- (cl-typep something 'semanticdb-abstract-table))
+ (progn
+ (declare-function semanticdb-abstract-table--eieio-childp
+ "semantic/db")
+ (cl-typep something 'semanticdb-abstract-table)))
(semanticdb-refresh-table something)
(semanticdb-get-tags something))
;; Semanticdb find-results
@@ -427,7 +430,7 @@ determining which symbols are considered."
(setq completion (try-completion pattern collection predicate))
(if (string= pattern completion)
(let ((list (all-completions pattern collection predicate)))
- (setq list (sort list 'string<))
+ (setq list (sort list #'string<))
(if (> (length list) 1)
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index d5b73244a08..f5f381d4079 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent.el --- Wisent - Semantic gateway
+;;; semantic/wisent.el --- Wisent - Semantic gateway -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2007, 2009-2021 Free Software Foundation, Inc.
@@ -22,13 +22,10 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; Here are functions necessary to use the Wisent LALR parser from
;; Semantic environment.
-;;; History:
-;;
-
;;; Code:
(require 'semantic)
@@ -69,6 +66,7 @@ Returned tokens must have the form:
(TOKSYM VALUE START . END)
where VALUE is the buffer substring between START and END positions."
+ (declare (debug (&define name stringp def-body)))
`(defun
,name () ,doc
(cond
@@ -223,7 +221,7 @@ the standard function `semantic-parse-stream'."
(error-message-string error-to-filter))
(message "wisent-parse-max-stack-size \
might need to be increased"))
- (apply 'signal error-to-filter))))))
+ (apply #'signal error-to-filter))))))
;; Manage returned lookahead token
(if wisent-lookahead
(if (eq (caar la-elt) wisent-lookahead)
@@ -251,6 +249,17 @@ might need to be increased"))
(if (consp cache) cache '(nil))
)))
+(defmacro wisent-compiled-grammar (grammar &optional start-list)
+ "Return a compiled form of the LALR(1) Wisent GRAMMAR.
+See `wisent--compile-grammar' for a description of the arguments
+and return value."
+ ;; Ensure that the grammar compiler is available.
+ (require 'semantic/wisent/comp)
+ (declare-function wisent-automaton-lisp-form "semantic/wisent/comp" (x))
+ (declare-function wisent--compile-grammar "semantic/wisent/comp" (grm st))
+ (wisent-automaton-lisp-form
+ (wisent--compile-grammar grammar start-list)))
+
(defun wisent-parse-region (start end &optional goal depth returnonerror)
"Parse the area between START and END using the Wisent LALR parser.
Return the list of semantic tags found.
@@ -319,18 +328,6 @@ the standard function `semantic-parse-region'."
(point-max))))))
;; Return parse tree
(nreverse ptree)))
-
-;;; Interfacing with edebug
-;;
-(add-hook
- 'edebug-setup-hook
- #'(lambda ()
-
- (def-edebug-spec define-wisent-lexer
- (&define name stringp def-body)
- )
-
- ))
(provide 'semantic/wisent)
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 755d30a371b..a87ed518909 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
+;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler -*- lexical-binding: t; -*-
;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2021 Free
;; Software Foundation, Inc.
@@ -35,9 +35,6 @@
;;
;; For more details on Wisent itself read the Wisent manual.
-;;; History:
-;;
-
;;; Code:
(require 'semantic/wisent)
(eval-when-compile (require 'cl-lib))
@@ -54,21 +51,22 @@
;; bound locally, without all these "reference to free variable"
;; compiler warnings!
-(defmacro wisent-context-name (name)
- "Return the context name from NAME."
- `(if (and ,name (symbolp ,name))
- (intern (format "wisent-context-%s" ,name))
- (error "Invalid context name: %S" ,name)))
+(eval-when-compile
+ (defun wisent-context-name (name)
+ "Return the context name from NAME."
+ (if (and name (symbolp name))
+ (intern (format "wisent-context-%s" name))
+ (error "Invalid context name: %S" name)))
-(defmacro wisent-context-bindings (name)
- "Return the variables in context NAME."
- `(symbol-value (wisent-context-name ,name)))
+ (defun wisent-context-bindings (name)
+ "Return the variables in context NAME."
+ (symbol-value (wisent-context-name name))))
(defmacro wisent-defcontext (name &rest vars)
"Define a context NAME that will bind variables VARS."
(declare (indent 1))
(let* ((context (wisent-context-name name))
- (declarations (mapcar #'(lambda (v) (list 'defvar v)) vars)))
+ (declarations (mapcar (lambda (v) (list 'defvar v)) vars)))
`(progn
,@declarations
(eval-when-compile
@@ -77,12 +75,8 @@
(defmacro wisent-with-context (name &rest body)
"Bind variables in context NAME then eval BODY."
(declare (indent 1))
- (let ((bindings (wisent-context-bindings name)))
- `(progn
- ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding)))
- bindings)
- (let* ,bindings
- ,@body))))
+ `(dlet ,(wisent-context-bindings name)
+ ,@body))
;; Other utilities
@@ -101,6 +95,8 @@ If optional LEFT is non-nil insert spaces on left."
;;;; Environment dependencies
;;;; ------------------------
+;; FIXME: Use bignums or bool-vectors?
+
(defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum))
(defsubst wisent-WORDSIZE (n)
@@ -159,13 +155,9 @@ Its name is defined in constant `wisent-log-buffer-name'."
'(with-current-buffer (wisent-log-buffer)
(erase-buffer)))
-(defvar byte-compile-current-file)
-
(defun wisent-source ()
"Return the current source file name or nil."
- (let ((source (or (and (boundp 'byte-compile-current-file)
- byte-compile-current-file)
- load-file-name (buffer-file-name))))
+ (let ((source (macroexp-file-name)))
(if source
(file-relative-name source))))
@@ -2241,7 +2233,7 @@ there are any reduce/reduce conflicts."
;; output warnings.
(and src
(intern (format "wisent-%s--expected-conflicts"
- (replace-regexp-in-string "\\.el$" "" src))))))
+ (replace-regexp-in-string "\\.el\\'" "" src))))))
(when (or (not (zerop rrc-total))
(and (not (zerop src-total))
(not (= src-total (or wisent-expected-conflicts 0)))
@@ -2778,7 +2770,7 @@ that likes a token gets to handle it."
"Figure out the actions for every state.
Return the action table."
;; Store the semantic action obarray in (unused) RCODE[0].
- (aset rcode 0 (make-vector 13 0))
+ (aset rcode 0 (obarray-make 13))
(let (i j action-table actrow action)
(setq action-table (make-vector nstates nil)
actrow (make-vector ntokens nil)
@@ -3392,7 +3384,7 @@ NONTERMS is the list of non terminal definitions (see function
;;;; Compile input grammar
;;;; ---------------------
-(defun wisent-compile-grammar (grammar &optional start-list)
+(defun wisent--compile-grammar (grammar start-list)
"Compile the LALR(1) GRAMMAR.
GRAMMAR is a list (TOKENS ASSOCS . NONTERMS) where:
@@ -3435,7 +3427,7 @@ where:
(if (wisent-automaton-p grammar)
grammar ;; Grammar already compiled just return it
(wisent-with-context compile-grammar
- (let* ((gc-cons-threshold 1000000))
+ (let* ((gc-cons-threshold (max gc-cons-threshold 1000000)))
(garbage-collect)
(setq wisent-new-log-flag t)
;; Parse input grammar
@@ -3444,7 +3436,7 @@ where:
(wisent-parser-automaton)))))
;;;; --------------------------
-;;;; Byte compile input grammar
+;;;; Obsolete byte compile support
;;;; --------------------------
(require 'bytecomp)
@@ -3453,25 +3445,32 @@ where:
"Byte compile the `wisent-compile-grammar' FORM.
Automatically called by the Emacs Lisp byte compiler as a
`byte-compile' handler."
- ;; Eval the `wisent-compile-grammar' form to obtain an LALR
- ;; automaton internal data structure. Then, because the internal
- ;; data structure contains an obarray, convert it to a lisp form so
- ;; it can be byte-compiled.
(byte-compile-form
- ;; FIXME: we macroexpand here since `byte-compile-form' expects
- ;; macroexpanded code, but that's just a workaround: for lexical-binding
- ;; the lisp form should have to pass through closure-conversion and
- ;; `wisent-byte-compile-grammar' is called much too late for that.
- ;; Why isn't this `wisent-automaton-lisp-form' performed at
- ;; macroexpansion time? --Stef
(macroexpand-all
- (wisent-automaton-lisp-form (eval form)))))
+ (wisent-automaton-lisp-form (eval form t)))))
-;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table
-;; instead of an obarray would work around the problem that obarrays
-;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t).
-(put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar)
+(defun wisent-compile-grammar (grammar &optional start-list)
+ ;; This is kept for compatibility with FOO-wy.el files generated
+ ;; with older Emacsen.
+ (declare (obsolete wisent-compiled-grammar "Mar 2021"))
+ (wisent--compile-grammar grammar start-list))
+
+(put 'wisent-compile-grammar 'byte-compile #'wisent-byte-compile-grammar)
+
+;;;; --------------------------
+;;;; Byte compile input grammar
+;;;; --------------------------
+;; `wisent--compile-grammar' generates the actual parse table
+;; we need at run-time, but in order to be able to compile the code it
+;; contains, we need to "reify" it back into a piece of ELisp code
+;; which (re)builds it.
+;; This is needed for 2 reasons:
+;; - The parse tables include an obarray and these don't survive the print+read
+;; steps involved in generating a `.elc' file and reading it back in.
+;; - Within the parse table vectors/obarrays we have ELisp functions which
+;; we want to byte-compile, but if we were to just `quote' the table
+;; we'd get them with the same non-compiled functions.
(defun wisent-automaton-lisp-form (automaton)
"Return a Lisp form that produces AUTOMATON.
See also `wisent-compile-grammar' for more details on AUTOMATON."
@@ -3481,16 +3480,16 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
(let ((obn (make-symbol "ob")) ; Generated obarray name
(obv (aref automaton 3)) ; Semantic actions obarray
)
- `(let ((,obn (make-vector 13 0)))
+ `(let ((,obn (obarray-make 13)))
;; Generate code to initialize the semantic actions obarray,
;; in local variable OBN.
,@(let (obcode)
(mapatoms
- #'(lambda (s)
- (setq obcode
- (cons `(fset (intern ,(symbol-name s) ,obn)
- #',(symbol-function s))
- obcode)))
+ (lambda (s)
+ (setq obcode
+ (cons `(fset (intern ,(symbol-name s) ,obn)
+ #',(symbol-function s))
+ obcode)))
obv)
obcode)
;; Generate code to create the automaton.
@@ -3500,18 +3499,20 @@ See also `wisent-compile-grammar' for more details on AUTOMATON."
;; obarray.
(vector
,@(mapcar
- #'(lambda (state) ;; for each state
- `(list
- ,@(mapcar
- #'(lambda (tr) ;; for each transition
- (let ((k (car tr)) ; token
- (a (cdr tr))) ; action
- (if (and (symbolp a)
- (intern-soft (symbol-name a) obv))
- `(cons ,(if (symbolp k) `(quote ,k) k)
- (intern-soft ,(symbol-name a) ,obn))
- `(quote ,tr))))
- state)))
+ ;; Use name `st' rather than `state' since `state' is
+ ;; defined as dynbound in `semantic-actions' context above :-( !
+ (lambda (st) ;; for each state
+ `(list
+ ,@(mapcar
+ (lambda (tr) ;; for each transition
+ (let ((k (car tr)) ; token
+ (a (cdr tr))) ; action
+ (if (and (symbolp a)
+ (intern-soft (symbol-name a) obv))
+ `(cons ,(if (symbolp k) `(quote ,k) k)
+ (intern-soft ,(symbol-name a) ,obn))
+ `(quote ,tr))))
+ st)))
(aref automaton 0)))
;; The code of the goto table is unchanged.
,(aref automaton 1)
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index cfd4899186b..c5e4554082e 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
+;;; semantic/wisent/grammar.el --- Wisent's input grammar mode -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;;
@@ -198,10 +198,10 @@ See also the function `wisent-skip-token'."
(defun wisent-grammar-assocs ()
"Return associativity and precedence level definitions."
(mapcar
- #'(lambda (tag)
- (cons (intern (semantic-tag-name tag))
- (mapcar #'semantic-grammar-item-value
- (semantic-tag-get-attribute tag :value))))
+ (lambda (tag)
+ (cons (intern (semantic-tag-name tag))
+ (mapcar #'semantic-grammar-item-value
+ (semantic-tag-get-attribute tag :value))))
(semantic-find-tags-by-class 'assoc (current-buffer))))
(defun wisent-grammar-terminals ()
@@ -209,14 +209,14 @@ See also the function `wisent-skip-token'."
Keep order of declaration in the WY file without duplicates."
(let (terms)
(mapc
- #'(lambda (tag)
- (mapcar #'(lambda (name)
- (add-to-list 'terms (intern name)))
- (cons (semantic-tag-name tag)
- (semantic-tag-get-attribute tag :rest))))
+ (lambda (tag)
+ (mapcar (lambda (name)
+ (add-to-list 'terms (intern name)))
+ (cons (semantic-tag-name tag)
+ (semantic-tag-get-attribute tag :rest))))
(semantic--find-tags-by-function
- #'(lambda (tag)
- (memq (semantic-tag-class tag) '(token keyword)))
+ (lambda (tag)
+ (memq (semantic-tag-class tag) '(token keyword)))
(current-buffer)))
(nreverse terms)))
@@ -228,7 +228,7 @@ Keep order of declaration in the WY file without duplicates."
Return the expanded expression."
(if (or (atom expr) (semantic-grammar-quote-p (car expr)))
expr ;; Just return atom or quoted expression.
- (let* ((expr (mapcar 'wisent-grammar-expand-macros expr))
+ (let* ((expr (mapcar #'wisent-grammar-expand-macros expr))
(macro (assq (car expr) wisent--grammar-macros)))
(if macro ;; Expand Semantic built-in.
(apply (cdr macro) (cdr expr))
@@ -286,12 +286,9 @@ Return the expanded expression."
(defun wisent-grammar-parsetable-builder ()
"Return the value of the parser table."
- `(progn
- ;; Ensure that the grammar [byte-]compiler is available.
- (eval-when-compile (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- ',(wisent-grammar-grammar)
- ',(semantic-grammar-start))))
+ `(wisent-compiled-grammar
+ ,(wisent-grammar-grammar)
+ ,(semantic-grammar-start)))
(defun wisent-grammar-setupcode-builder ()
"Return the parser setup code."
@@ -305,7 +302,7 @@ Return the expanded expression."
semantic-lex-types-obarray %s)\n\
;; Collect unmatched syntax lexical tokens\n\
(add-hook 'wisent-discarding-token-functions\n\
- 'wisent-collect-unmatched-syntax nil t)"
+ #'wisent-collect-unmatched-syntax nil t)"
(semantic-grammar-parsetable)
(buffer-name)
(semantic-grammar-keywordtable)
@@ -325,6 +322,7 @@ Menu items are appended to the common grammar menu.")
(define-derived-mode wisent-grammar-mode semantic-grammar-mode "WY"
"Major mode for editing Wisent grammars."
(semantic-grammar-setup-menu wisent-grammar-menu)
+ (setq-local semantic-grammar-require-form '(require 'semantic/wisent))
(semantic-install-function-overrides
'((semantic-grammar-parsetable-builder . wisent-grammar-parsetable-builder)
(semantic-grammar-setupcode-builder . wisent-grammar-setupcode-builder))))
@@ -479,7 +477,7 @@ Menu items are appended to the common grammar menu.")
(condition-case err
(with-current-buffer (find-file-noselect infile)
(if outdir (setq default-directory outdir))
- (semantic-grammar-create-package nil t))
+ (semantic-grammar-create-package t t))
(error (message "%s" (error-message-string err)) nil)))
output-data)
(when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
@@ -514,7 +512,8 @@ Menu items are appended to the common grammar menu.")
(goto-char (point-min))
(delete-region (point-min) (line-end-position))
(insert ";;; " packagename
- " --- Generated parser support file")
+ " --- Generated parser support file "
+ "-*- lexical-binding:t -*-")
(re-search-forward ";;; \\(.*\\) ends here")
(replace-match packagename nil nil nil 1)
(delete-trailing-whitespace))))))
diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el
index d455c02d1b5..90dd40c51a0 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
+;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2006, 2009-2021 Free Software Foundation, Inc.
@@ -24,9 +24,6 @@
;;; Commentary:
;;
-;;; History:
-;;
-
;;; Code:
(require 'semantic/wisent)
@@ -92,7 +89,7 @@ This function override `get-local-variables'."
(define-mode-local-override semantic-analyze-unsplit-name java-mode (namelist)
"Assemble the list of names NAMELIST into a namespace name."
- (mapconcat 'identity namelist "."))
+ (mapconcat #'identity namelist "."))
@@ -111,12 +108,12 @@ Use the alternate LALR(1) parser."
(setq
;; Lexical analysis
semantic-lex-number-expression semantic-java-number-regexp
- semantic-lex-analyzer 'wisent-java-tags-lexer
+ semantic-lex-analyzer #'wisent-java-tags-lexer
;; Parsing
- semantic-tag-expand-function 'semantic-java-expand-tag
+ semantic-tag-expand-function #'semantic-java-expand-tag
;; Environment
- semantic-imenu-summary-function 'semantic-format-tag-prototype
- imenu-create-index-function 'semantic-create-imenu-index
+ semantic-imenu-summary-function #'semantic-format-tag-prototype
+ imenu-create-index-function #'semantic-create-imenu-index
semantic-type-relation-separator-character '(".")
semantic-command-separation-character ";"
;; speedbar and imenu buckets name
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index 684eea1d93d..1932f205ee0 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -1,4 +1,4 @@
-;;; semantic/wisent/javascript.el --- javascript parser support
+;;; semantic/wisent/javascript.el --- javascript parser support -*- lexical-binding: t; -*-
;; Copyright (C) 2005, 2009-2021 Free Software Foundation, Inc.
@@ -70,7 +70,7 @@ This function overrides `get-local-variables'."
;; Does javascript have identifiable local variables?
nil)
-(define-mode-local-override semantic-tag-protection js-mode (tag &optional parent)
+(define-mode-local-override semantic-tag-protection js-mode (_tag &optional _parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
nil - No special protection. Language dependent.
@@ -85,7 +85,7 @@ The default behavior (if not overridden with `tag-protection'
is to return a symbol based on type modifiers."
nil)
-(define-mode-local-override semantic-analyze-scope-calculate-access js-mode (type scope)
+(define-mode-local-override semantic-analyze-scope-calculate-access js-mode (_type _scope)
"Calculate the access class for TYPE as defined by the current SCOPE.
Access is related to the :parents in SCOPE. If type is a member of SCOPE
then access would be `private'. If TYPE is inherited by a member of SCOPE,
@@ -101,7 +101,7 @@ This is currently needed for the mozrepl omniscient database."
(save-excursion
(if point (goto-char point))
(let* ((case-fold-search semantic-case-fold)
- symlist tmp end)
+ tmp end) ;; symlist
(with-syntax-table semantic-lex-syntax-table
(save-excursion
(when (looking-at "\\w\\|\\s_")
@@ -110,10 +110,11 @@ This is currently needed for the mozrepl omniscient database."
(unless (re-search-backward "\\s-" (point-at-bol) t)
(beginning-of-line))
(setq tmp (buffer-substring-no-properties (point) end))
+ ;; (setq symlist
(if (string-match "\\(.+\\)\\." tmp)
- (setq symlist (list (match-string 1 tmp)
- (substring tmp (1+ (match-end 1)) (length tmp))))
- (setq symlist (list tmp))))))))
+ (list (match-string 1 tmp)
+ (substring tmp (1+ (match-end 1)) (length tmp)))
+ (list tmp)))))));; )
;;; Setup Function
;;
@@ -127,14 +128,14 @@ This is currently needed for the mozrepl omniscient database."
(wisent-javascript-jv-wy--install-parser)
(setq
;; Lexical Analysis
- semantic-lex-analyzer 'javascript-lexer-jv
+ semantic-lex-analyzer #'javascript-lexer-jv
semantic-lex-number-expression semantic-java-number-regexp
;; semantic-lex-depth nil ;; Full lexical analysis
;; Parsing
- semantic-tag-expand-function 'wisent-javascript-jv-expand-tag
+ semantic-tag-expand-function #'wisent-javascript-jv-expand-tag
;; Environment
- semantic-imenu-summary-function 'semantic-format-tag-name
- imenu-create-index-function 'semantic-create-imenu-index
+ semantic-imenu-summary-function #'semantic-format-tag-name
+ imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character ";"
))
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 7769ad1961b..fb878dde712 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,4 +1,4 @@
-;;; wisent-python.el --- Semantic support for Python
+;;; wisent-python.el --- Semantic support for Python -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@@ -27,8 +27,6 @@
;;; Code:
-(require 'rx)
-
;; Try to load python support, but fail silently since it is only used
;; for optional functionality
(require 'python nil t)
@@ -464,19 +462,19 @@ To be implemented for Python! For now just return nil."
(define-mode-local-override semantic-tag-include-filename python-mode (tag)
"Return a suitable path for (some) Python imports."
(let ((name (semantic-tag-name tag)))
- (concat (mapconcat 'identity (split-string name "\\.") "/") ".py")))
+ (concat (mapconcat #'identity (split-string name "\\.") "/") ".py")))
;; Override ctxt-current-function/assignment defaults, since they do
;; not work properly with Python code, even leading to endless loops
;; (see bug #xxxxx).
-(define-mode-local-override semantic-ctxt-current-function python-mode (&optional point)
+(define-mode-local-override semantic-ctxt-current-function python-mode (&optional _point)
"Return the current function call the cursor is in at POINT.
The function returned is the one accepting the arguments that
the cursor is currently in. It will not return function symbol if the
cursor is on the text representing that function."
nil)
-(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional point)
+(define-mode-local-override semantic-ctxt-current-assignment python-mode (&optional _point)
"Return the current assignment near the cursor at POINT.
Return a list as per `semantic-ctxt-current-symbol'.
Return nil if there is nothing relevant."
@@ -512,12 +510,12 @@ Shortens `code' tags, but passes through for others."
semantic-type-relation-separator-character '(".")
semantic-command-separation-character ";"
;; Parsing
- semantic-tag-expand-function 'semantic-python-expand-tag
+ semantic-tag-expand-function #'semantic-python-expand-tag
;; Semantic to take over from the one provided by python.
;; The python one, if it uses the senator advice, will hang
;; Emacs unrecoverably.
- imenu-create-index-function 'semantic-create-imenu-index
+ imenu-create-index-function #'semantic-create-imenu-index
;; I need a python guru to update this list:
semantic-symbol->name-assoc-list-for-type-parts '((variable . "Variables")
@@ -557,7 +555,7 @@ SELF or the instance name \"self\" if SELF is nil."
(rx-to-string
`(seq string-start ,(or self "self") "."))
name)
- (not (string-match "\\." (substring name 5)))))))
+ (not (string-search "." (substring name 5)))))))
(defun semantic-python-docstring-p (tag)
"Return non-nil, when TAG is a Python documentation string."
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index 26cf87f8425..62d99ef6972 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -1,6 +1,6 @@
-;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
+;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime -*- lexical-binding: t; -*-
-;;; Copyright (C) 2002-2007, 2009-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: 30 January 2002
@@ -34,9 +34,6 @@
;;
;; For more details on Wisent itself read the Wisent manual.
-;;; History:
-;;
-
;;; Code:
(defgroup wisent nil
@@ -139,7 +136,7 @@ POSITIONS are available."
"Print a one-line message if `wisent-parse-verbose-flag' is set.
Pass STRING and ARGS arguments to `message'."
(and wisent-parse-verbose-flag
- (apply 'message string args)))
+ (apply #'message string args)))
;;;; --------------------
;;;; The LR parser engine
@@ -147,13 +144,11 @@ Pass STRING and ARGS arguments to `message'."
(defcustom wisent-parse-max-stack-size 500
"The parser stack size."
- :type 'integer
- :group 'wisent)
+ :type 'integer)
(defcustom wisent-parse-max-recover 3
"Number of tokens to shift before turning off error status."
- :type 'integer
- :group 'wisent)
+ :type 'integer)
(defvar wisent-discarding-token-functions nil
"List of functions to be called when discarding a lexical token.
@@ -397,9 +392,9 @@ automaton has only one entry point."
(wisent-error
(format "Syntax error, unexpected %s, expecting %s"
(wisent-token-to-string wisent-input)
- (mapconcat 'wisent-item-to-string
+ (mapconcat #'wisent-item-to-string
(delq wisent-error-term
- (mapcar 'car (cdr choices)))
+ (mapcar #'car (cdr choices)))
", "))))
;; Increment the error counter
(setq wisent-nerrs (1+ wisent-nerrs))
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index aa4aa812e02..83e9754a608 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -1,6 +1,6 @@
;;; srecode.el --- Semantic buffer evaluator. -*- lexical-binding: t -*-
-;;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el
index 24c5f22f2e7..79d2700c5d9 100644
--- a/lisp/cedet/srecode/args.el
+++ b/lisp/cedet/srecode/args.el
@@ -1,4 +1,4 @@
-;;; srecode/args.el --- Provide some simple template arguments
+;;; srecode/args.el --- Provide some simple template arguments -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 7146b643836..15107ef1e43 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -1,4 +1,4 @@
-;;; srecode/compile --- Compilation of srecode template files.
+;;; srecode/compile --- Compilation of srecode template files. -*- lexical-binding: t; -*-
;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
@@ -110,7 +110,12 @@ stack is broken."
:type (or null string)
:documentation
"If there is a colon in the inserter's name, it represents
-additional static argument data."))
+additional static argument data.")
+ (key :initform nil :allocation :class
+ :documentation
+ "The character code used to identify inserters of this style.
+All children of this class should specify `key' slot with appropriate
+:initform value."))
"This represents an item to be inserted via a template macro.
Plain text strings are not handled via this baseclass."
:abstract t)
@@ -499,7 +504,7 @@ PROPS are additional properties that might need to be passed
to the inserter constructor."
;;(message "Compile: %s %S" name props)
(if (not key)
- (apply 'srecode-template-inserter-variable name props)
+ (apply #'make-instance 'srecode-template-inserter-variable name props)
(let ((classes (eieio-class-children 'srecode-template-inserter))
(new nil))
;; Loop over the various subclasses and
@@ -510,7 +515,7 @@ to the inserter constructor."
(when (and (not (class-abstract-p (car classes)))
(equal (oref-default (car classes) key) key))
;; Create the new class, and apply state.
- (setq new (apply (car classes) name props))
+ (setq new (apply #'make-instance (car classes) name props))
(srecode-inserter-apply-state new STATE)
)
(setq classes (cdr classes)))
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index 1b9610f3f1b..dc5e8da5cdb 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -1,4 +1,4 @@
-;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder
+;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder -*- lexical-binding: t; -*-
;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc.
@@ -44,7 +44,6 @@
A dictionary entry of the named PREFIX_NAMESPACE with the value
NAMESPACE:: is created for each namespace unless the current
buffer contains a using NAMESPACE; statement."
- :group 'srecode-cpp
:type '(repeat string))
;;; :c ARGUMENT HANDLING
@@ -165,7 +164,7 @@ specified in a C file."
;; when they make sense. My best bet would be
;; (semantic-tag-function-parent tag), but it is not there, when
;; the function is defined in the scope of a class.
- (let ((member t)
+ (let (;; (member t)
(templates (semantic-tag-get-attribute tag :template))
(modifiers (semantic-tag-modifiers tag)))
@@ -186,7 +185,7 @@ specified in a C file."
;; When the function is a member function, it can have
;; additional modifiers.
- (when member
+ (when t ;; member
;; For member functions, constness is called
;; 'methodconst-flag'.
diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el
index 20334f95838..c49237b94cf 100644
--- a/lisp/cedet/srecode/ctxt.el
+++ b/lisp/cedet/srecode/ctxt.el
@@ -1,4 +1,4 @@
-;;; srecode/ctxt.el --- Derive a context from the source buffer.
+;;; srecode/ctxt.el --- Derive a context from the source buffer. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index c1fe4b2c34e..5da045e17f1 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -1,4 +1,4 @@
-;;; srecode/dictionary.el --- Dictionary code for the semantic recoder.
+;;; srecode/dictionary.el --- Dictionary code for the semantic recoder. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -443,8 +443,8 @@ The root dictionary is usually for a current or active insertion."
;; for use in converting the compound value into something insertable.
(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
- function
- dictionary)
+ _function
+ _dictionary)
"Convert the compound dictionary value CP to a string.
If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect
of the compound value. The FUNCTION could be a fraction
@@ -457,14 +457,15 @@ standard out is a buffer, and using `insert'."
(eieio-object-name cp))
(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value)
- &optional indent)
+ &optional _indent)
"Display information about this compound value."
(princ (eieio-object-name cp))
)
-(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
- function
- dictionary)
+(cl-defmethod srecode-compound-toString
+ ((cp srecode-dictionary-compound-variable)
+ _function
+ dictionary)
"Convert the compound dictionary variable value CP into a string.
FUNCTION and DICTIONARY are as for the baseclass."
(require 'srecode/insert)
@@ -606,9 +607,9 @@ STATE is the current compiler state."
(require 'srecode/find)
(let* ((modesym major-mode)
(start (current-time))
- (junk (or (progn (srecode-load-tables-for-mode modesym)
- (srecode-get-mode-table modesym))
- (error "No table found for mode %S" modesym)))
+ (_ (or (progn (srecode-load-tables-for-mode modesym)
+ (srecode-get-mode-table modesym))
+ (error "No table found for mode %S" modesym)))
(dict (srecode-create-dictionary (current-buffer)))
)
(message "Creating a dictionary took %.2f seconds."
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index 0d1a4c01d3c..270b80d9013 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -1,4 +1,4 @@
-;;; srecode/document.el --- Documentation (comment) generation
+;;; srecode/document.el --- Documentation (comment) generation -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -88,7 +88,6 @@ versions of names. This is an alist with each element of the form:
(MATCH . RESULT)
MATCH is a regexp to match in the type field.
RESULT is a string."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -144,7 +143,6 @@ A string may end in a space, in which case, last-alist is searched to
see how best to describe what can be returned.
Doesn't always work correctly, but that is just because English
doesn't always work correctly."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -175,7 +173,6 @@ versions of names. This is an alist with each element of the form:
(MATCH . RESULT)
MATCH is a regexp to match in the type field.
RESULT is a string."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -192,7 +189,6 @@ This is an alist with each element of the form:
(MATCH . RESULT)
MATCH is a regexp to match in the type field.
RESULT is a string."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -213,7 +209,6 @@ This is an alist with each element of the form:
MATCH is a regexp to match in the type field.
RESULT is a string, which can contain %s, which is replaced with
`match-string' 1."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -233,7 +228,6 @@ MATCH is a regexp to match in the type field.
RESULT is a string of text to use to describe MATCH.
When one is encountered, document-insert-parameters will automatically
place this comment after the parameter name."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -258,7 +252,6 @@ This is an alist with each element of the form:
(MATCH . RESULT)
MATCH is a regexp to match in the type field.
RESULT is a string."
- :group 'document
:type '(repeat (cons (regexp :tag "Regexp")
(string :tag "Doc Text"))))
@@ -716,7 +709,7 @@ allocating something based on its type."
(setq al (cdr al)))))
news))
-(defun srecode-document-parameter-comment (param &optional commentlist)
+(defun srecode-document-parameter-comment (param &optional _commentlist)
"Convert tag or string PARAM into a name,comment pair.
Optional COMMENTLIST is list of previously existing comments to
use instead in alist form. If the name doesn't appear in the list of
diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el
index 7e9dd10fd42..974a4fac727 100644
--- a/lisp/cedet/srecode/el.el
+++ b/lisp/cedet/srecode/el.el
@@ -1,4 +1,4 @@
-;;; srecode/el.el --- Emacs Lisp specific arguments
+;;; srecode/el.el --- Emacs Lisp specific arguments -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el
index cdb29d16b71..a40d5aec24d 100644
--- a/lisp/cedet/srecode/expandproto.el
+++ b/lisp/cedet/srecode/expandproto.el
@@ -1,4 +1,4 @@
-;;; srecode/expandproto.el --- Expanding prototypes.
+;;; srecode/expandproto.el --- Expanding prototypes. -*- lexical-binding: t; -*-
;; Copyright (C) 2007, 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 625b854b776..9e6a98fd769 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -1,4 +1,4 @@
-;;; srecode/extract.el --- Extract content from previously inserted macro.
+;;; srecode/extract.el --- Extract content from previously inserted macro. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -139,24 +139,24 @@ Uses STATE to maintain the current extraction state."
;;; Inserter Base Extractors
;;
-(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
+(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter))
"Return non-nil if this inserter can extract values."
nil)
-(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
- start end dict state)
+(cl-defmethod srecode-inserter-extract ((_ins srecode-template-inserter)
+ _start _end _dict _state)
"Extract text from START/END and store in DICT.
Return nil as this inserter will extract nothing."
nil)
;;; Variable extractor is simple and can extract later.
;;
-(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
+(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-variable))
"Return non-nil if this inserter can extract values."
'later)
(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
- start end vdict state)
+ start end vdict _state)
"Extract text from START/END and store in VDICT.
Return t if something was extracted.
Return nil if this inserter doesn't need to extract anything."
@@ -168,12 +168,12 @@ Return nil if this inserter doesn't need to extract anything."
;;; Section Inserter
;;
-(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
+(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-section-start))
"Return non-nil if this inserter can extract values."
'now)
(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
- start end indict state)
+ _start _end indict state)
"Extract text from START/END and store in INDICT.
Return the starting location of the first plain-text match.
Return nil if nothing was extracted."
@@ -201,12 +201,12 @@ Return nil if nothing was extracted."
;;; Include Extractor must extract now.
;;
-(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
+(cl-defmethod srecode-inserter-do-extract-p ((_ins srecode-template-inserter-include))
"Return non-nil if this inserter can extract values."
'now)
(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
- start end dict state)
+ start _end dict state)
"Extract text from START/END and store in DICT.
Return the starting location of the first plain-text match.
Return nil if nothing was extracted."
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 71613bcc2a3..e65e3194320 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -1,4 +1,4 @@
-;;; srecode/fields.el --- Handling type-in fields in a buffer.
+;;; srecode/fields.el --- Handling type-in fields in a buffer. -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
@@ -193,7 +193,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO."
"Manage a buffer region in which fields exist.")
(cl-defmethod initialize-instance ((ir srecode-template-inserted-region)
- &rest args)
+ &rest _args)
"Initialize IR, capturing the active fields, and creating the overlay."
;; Fill in the fields
(oset ir fields srecode-field-archive)
@@ -221,7 +221,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO."
(oset ir active-region ir)
;; Setup the post command hook.
- (add-hook 'post-command-hook 'srecode-field-post-command t t)
+ (add-hook 'post-command-hook #'srecode-field-post-command t t)
)
(cl-defmethod srecode-delete ((ir srecode-template-inserted-region))
@@ -229,12 +229,11 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO."
;; Clear us out of the baseclass.
(oset ir active-region nil)
;; Clear our fields.
- (mapc 'srecode-delete (oref ir fields))
+ (mapc #'srecode-delete (oref ir fields))
;; Call to our base
(cl-call-next-method)
;; Clear our hook.
- (remove-hook 'post-command-hook 'srecode-field-post-command t)
- )
+ (remove-hook 'post-command-hook #'srecode-field-post-command t))
(defsubst srecode-active-template-region ()
"Return the active region for template fields."
@@ -246,7 +245,7 @@ If SET-TO is a string, then replace the text of OLAID with SET-TO."
)
(if (not ar)
;; Find a bug and fix it.
- (remove-hook 'post-command-hook 'srecode-field-post-command t)
+ (remove-hook 'post-command-hook #'srecode-field-post-command t)
(if (srecode-point-in-region-p ar)
nil ;; Keep going
;; We moved out of the template. Cancel the edits.
@@ -277,16 +276,16 @@ Try to use this to provide useful completion when available.")
(defvar srecode-field-keymap
(let ((km (make-sparse-keymap)))
- (define-key km "\C-i" 'srecode-field-next)
- (define-key km "\M-\C-i" 'srecode-field-prev)
- (define-key km "\C-e" 'srecode-field-end)
- (define-key km "\C-a" 'srecode-field-start)
- (define-key km "\M-m" 'srecode-field-start)
- (define-key km "\C-c\C-c" 'srecode-field-exit-ask)
+ (define-key km "\C-i" #'srecode-field-next)
+ (define-key km "\M-\C-i" #'srecode-field-prev)
+ (define-key km "\C-e" #'srecode-field-end)
+ (define-key km "\C-a" #'srecode-field-start)
+ (define-key km "\M-m" #'srecode-field-start)
+ (define-key km "\C-c\C-c" #'srecode-field-exit-ask)
km)
"Keymap applied to field overlays.")
-(cl-defmethod initialize-instance ((field srecode-field) &optional args)
+(cl-defmethod initialize-instance ((field srecode-field) &optional _args)
"Initialize FIELD, being sure it archived."
(add-to-list 'srecode-field-archive field t)
(cl-call-next-method)
@@ -327,7 +326,7 @@ Try to use this to provide useful completion when available.")
(defvar srecode-field-replication-max-size 100
"Maximum size of a field before canceling replication.")
-(defun srecode-field-mod-hook (ol after start end &optional pre-len)
+(defun srecode-field-mod-hook (ol after _start _end &optional _pre-len)
"Modification hook for the field overlay.
OL is the overlay.
AFTER is non-nil if it is called after the change.
@@ -374,7 +373,7 @@ AFTER is non-nil if it is called after the change.
START and END are the bounds of the change.
PRE-LEN is used in the after mode for the length of the changed text."
(when after
- (let* ((field (overlay-get ol 'srecode))
+ (let* (;; (field (overlay-get ol 'srecode))
)
(move-overlay ol (overlay-start ol) end)
(srecode-field-mod-hook ol after start end pre-len))
diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el
index 4a996cf6f12..b76ce2c94bf 100644
--- a/lisp/cedet/srecode/filters.el
+++ b/lisp/cedet/srecode/filters.el
@@ -1,4 +1,4 @@
-;;; srecode/filters.el --- Filters for use in template variables.
+;;; srecode/filters.el --- Filters for use in template variables. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index aec73dce5a5..1c208d0f328 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -1,4 +1,4 @@
-;;;; srecode/find.el --- Tools for finding templates in the database.
+;;;; srecode/find.el --- Tools for finding templates in the database. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -58,17 +58,14 @@ See `srecode-get-maps' for more.
APPNAME is the name of an application. In this case,
all template files for that application will be loaded."
(let ((files
- (if appname
- (apply 'append
- (mapcar
+ (apply #'append
+ (mapcar
+ (if appname
(lambda (map)
(srecode-map-entries-for-app-and-mode map appname mmode))
- (srecode-get-maps)))
- (apply 'append
- (mapcar
(lambda (map)
- (srecode-map-entries-for-mode map mmode))
- (srecode-get-maps)))))
+ (srecode-map-entries-for-mode map mmode)))
+ (srecode-get-maps))))
)
;; Don't recurse if we are already the 'default state.
(when (not (eq mmode 'default))
@@ -112,8 +109,8 @@ If TAB is nil, then always return t."
;; Find a given template based on name, and features of the current
;; buffer.
(cl-defmethod srecode-template-get-table ((tab srecode-template-table)
- template-name &optional
- context application)
+ template-name &optional
+ context _application)
"Find in the template in table TAB, the template with TEMPLATE-NAME.
Optional argument CONTEXT specifies that the template should part
of a particular context.
@@ -218,7 +215,7 @@ tables that do not belong to an application will be searched."
(defvar srecode-read-template-name-history nil
"History for completing reads for template names.")
-(defun srecode-user-template-p (template)
+(defun srecode-user-template-p (_template)
"Non-nil if TEMPLATE is intended for user insertion.
Templates not matching this predicate are used for code
generation or other internal purposes."
@@ -264,7 +261,7 @@ with `srecode-calculate-context'."
;; the prefix for the completing read
(concat (nth 0 ctxt) ":"))))
-(defun srecode-read-template-name (prompt &optional initial hist default)
+(defun srecode-read-template-name (prompt &optional initial hist _default)
"Completing read for Semantic Recoder template names.
PROMPT is used to query for the name of the template desired.
INITIAL is the initial string to use.
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 1e4888655f9..ce4c818c709 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -1,4 +1,4 @@
-;;; srecode/getset.el --- Package for inserting new get/set methods.
+;;; srecode/getset.el --- Package for inserting new get/set methods. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -33,6 +33,8 @@
(defvar srecode-insert-getset-fully-automatic-flag nil
"Non-nil means accept choices srecode comes up with without asking.")
+(defvar srecode-semantic-selected-tag)
+
;;;###autoload
(defun srecode-insert-getset (&optional class-in field-in)
"Insert get/set methods for the current class.
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index ab0503c8d36..f20842b1d8a 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -89,6 +89,8 @@ DICT-ENTRIES are additional dictionary values to add."
;; for this insertion step.
))
+(eieio-declare-slots (point :allocation :class))
+
(defun srecode-insert-fcn (template dictionary &optional stream skipresolver)
"Insert TEMPLATE using DICTIONARY into STREAM.
Optional SKIPRESOLVER means to avoid refreshing the tag list,
@@ -134,13 +136,13 @@ has set everything up already."
)
(srecode-insert-method template dictionary))
;; Handle specialization of the POINT inserter.
- (when (and (bufferp standard-output)
- (slot-boundp 'srecode-template-inserter-point 'point)
- )
- (set-buffer standard-output)
- (setq end-mark (point-marker))
- (goto-char (oref-default 'srecode-template-inserter-point point)))
- (oset-default 'srecode-template-inserter-point point eieio-unbound)
+ (when (bufferp standard-output)
+ (let ((point (oref-default 'srecode-template-inserter-point point)))
+ (when point
+ (set-buffer standard-output)
+ (setq end-mark (point-marker))
+ (goto-char point))))
+ (oset-default 'srecode-template-inserter-point point nil)
;; Return the end-mark.
(or end-mark (point)))
@@ -733,6 +735,7 @@ DEPTH.")
"The character code used to identify inserters of this style.")
(point :type (or null marker)
:allocation :class
+ :initform nil
:documentation
"Record the value of (point) in this class slot.
It is the responsibility of the inserter algorithm to clear this
diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el
index 768d48a7c5b..0f0a80ee299 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -1,4 +1,4 @@
-;;; srecode/java.el --- Srecode Java support
+;;; srecode/java.el --- Srecode Java support -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index a94db0bb8d9..254b15e6e04 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -1,4 +1,4 @@
-;;; srecode/map.el --- Manage a template file map
+;;; srecode/map.el --- Manage a template file map -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -245,7 +245,7 @@ Optional argument RESET forces a reset of the current map."
(princ "\n")
))
-(defun srecode-map-file-still-valid-p (filename map)
+(defun srecode-map-file-still-valid-p (filename _map)
"Return t if FILENAME should be in MAP still."
(let ((valid nil))
(and (file-exists-p filename)
@@ -407,7 +407,7 @@ Return non-nil if the map changed."
"Global load path for SRecode template files."
:group 'srecode
:type '(repeat file)
- :set 'srecode-map-load-path-set)
+ :set #'srecode-map-load-path-set)
(provide 'srecode/map)
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index 159dc7a999b..9b1c8491a12 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -1,4 +1,4 @@
-;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
+;;; srecode/mode.el --- Minor mode for managing and using SRecode templates -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -54,14 +54,14 @@
(defvar srecode-prefix-map
(let ((km (make-sparse-keymap)))
;; Basic template codes
- (define-key km "/" 'srecode-insert)
- (define-key km [insert] 'srecode-insert)
- (define-key km "." 'srecode-insert-again)
- (define-key km "E" 'srecode-edit)
+ (define-key km "/" #'srecode-insert)
+ (define-key km [insert] #'srecode-insert)
+ (define-key km "." #'srecode-insert-again)
+ (define-key km "E" #'srecode-edit)
;; Template indirect binding
(let ((k ?a))
(while (<= k ?z)
- (define-key km (format "%c" k) 'srecode-bind-insert)
+ (define-key km (format "%c" k) #'srecode-bind-insert)
(setq k (1+ k))))
km)
"Keymap used behind the srecode prefix key in srecode minor mode.")
@@ -141,16 +141,17 @@ non-nil if the minor mode is enabled.
;; this mode first.
(if srecode-minor-mode
(if (not (apply
- 'append
+ #'append
(mapcar (lambda (map)
(srecode-map-entries-for-mode map major-mode))
(srecode-get-maps))))
(setq srecode-minor-mode nil)
;; Else, we have success, do stuff
- (add-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items nil t)
- )
- (remove-hook 'cedet-m3-menu-do-hooks 'srecode-m3-items t)
- )
+ ;; FIXME: Where are `cedet-m3-menu-do-hooks' nor `srecode-m3-items'?
+ (when (fboundp 'srecode-m3-items)
+ (add-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items nil t)))
+ (when (fboundp 'srecode-m3-items)
+ (remove-hook 'cedet-m3-menu-do-hooks #'srecode-m3-items t)))
;; Run hooks if we are turning this on.
(when srecode-minor-mode
(run-hooks 'srecode-minor-mode-hook))
@@ -170,7 +171,7 @@ non-nil if the minor mode is enabled.
;;; Menu Filters
;;
-(defun srecode-minor-mode-templates-menu (menu-def)
+(defun srecode-minor-mode-templates-menu (_menu-def)
"Create a menu item of cascading filters active for this mode.
MENU-DEF is the menu to bind this into."
;; Doing this SEGVs Emacs on windows.
@@ -223,13 +224,11 @@ MENU-DEF is the menu to bind this into."
(if bind
(concat name " (" bind ")")
name)
- `(lambda () (interactive)
- (srecode-insert (concat ,ctxt ":" ,name)))
+ (lambda () (interactive)
+ (srecode-insert (concat ctxt ":" name)))
t)))
- (setcdr ctxtcons (cons
- new
- (cdr ctxtcons)))))
+ (push new (cdr ctxtcons))))
(setq ltab (cdr ltab))))
(setq subtab (cdr subtab)))
@@ -246,7 +245,7 @@ MENU-DEF is the menu to bind this into."
(defvar srecode-minor-mode-generators nil
"List of code generators to be displayed in the srecoder menu.")
-(defun srecode-minor-mode-generate-menu (menu-def)
+(defun srecode-minor-mode-generate-menu (_menu-def)
"Create a menu item of cascading filters active for this mode.
MENU-DEF is the menu to bind this into."
;; Doing this SEGVs Emacs on windows.
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index bbe1e5e469c..71579158494 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -1,4 +1,4 @@
-;;; srecode/srt-mode.el --- Major mode for writing screcode macros
+;;; srecode/srt-mode.el --- Major mode for writing screcode macros -*- lexical-binding: t; -*-
;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
@@ -181,9 +181,9 @@ we can tell font lock about them.")
(defvar srecode-template-mode-map
(let ((km (make-sparse-keymap)))
- (define-key km "\C-c\C-c" 'srecode-compile-templates)
- (define-key km "\C-c\C-m" 'srecode-macro-help)
- (define-key km "/" 'srecode-self-insert-complete-end-macro)
+ (define-key km "\C-c\C-c" #'srecode-compile-templates)
+ (define-key km "\C-c\C-m" #'srecode-macro-help)
+ (define-key km "/" #'srecode-self-insert-complete-end-macro)
km)
"Keymap used in srecode mode.")
@@ -205,7 +205,7 @@ we can tell font lock about them.")
((?_ . "w") (?- . "w")))))
;;;###autoload
-(defalias 'srt-mode 'srecode-template-mode)
+(defalias 'srt-mode #'srecode-template-mode)
;;; Template Commands
;;
@@ -436,7 +436,7 @@ Moves to the end of one named section."
(when point (goto-char (point)))
(let* ((tag (semantic-current-tag))
(args (semantic-tag-function-arguments tag))
- (argsym (mapcar 'intern args))
+ (argsym (mapcar #'intern args))
(argvars nil)
;; Create a temporary dictionary in which the
;; arguments can be resolved so we can extract
@@ -475,7 +475,7 @@ section or ? for an ask variable."
(ee (regexp-quote (srecode-template-get-escape-end)))
(start (point))
(macrostart nil)
- (raw nil)
+ ;; (raw nil)
)
(when (and tag (semantic-tag-of-class-p tag 'function)
(srecode-in-macro-p point)
@@ -627,7 +627,7 @@ section or ? for an ask variable."
context-return)))
(define-mode-local-override semantic-analyze-possible-completions
- srecode-template-mode (context &rest flags)
+ srecode-template-mode (context &rest _flags)
"Return a list of possible completions based on NONTEXT."
(with-current-buffer (oref context buffer)
(let* ((prefix (car (last (oref context prefix))))
diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el
index e222997708b..161b5105b51 100644
--- a/lisp/cedet/srecode/srt.el
+++ b/lisp/cedet/srecode/srt.el
@@ -1,4 +1,4 @@
-;;; srecode/srt.el --- argument handlers for SRT files
+;;; srecode/srt.el --- argument handlers for SRT files -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -43,7 +43,7 @@ DEFAULT is the default if RET is hit."
(currfcn (semantic-current-tag))
)
(srecode-resolve-argument-list
- (mapcar 'read
+ (mapcar #'read
(semantic-tag-get-attribute currfcn :arguments))
newdict)
@@ -56,7 +56,7 @@ DEFAULT is the default if RET is hit."
(defvar srecode-read-major-mode-history nil
"History for `srecode-read-variable-name'.")
-(defun srecode-read-major-mode-name (prompt &optional initial hist default)
+(defun srecode-read-major-mode-name (prompt &optional initial hist _default)
"Read in the name of a desired `major-mode'.
PROMPT is the prompt to use.
INITIAL is the initial string.
@@ -64,7 +64,7 @@ HIST is the history value, otherwise `srecode-read-variable-name-history'
is used.
DEFAULT is the default if RET is hit."
(completing-read prompt obarray
- (lambda (s) (string-match "-mode$" (symbol-name s)))
+ (lambda (s) (string-match "-mode\\'" (symbol-name s)))
nil initial (or hist 'srecode-read-major-mode-history))
)
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 60a466f89d9..7ce5cc73b61 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -1,4 +1,4 @@
-;;; srecode/table.el --- Tables of Semantic Recoders
+;;; srecode/table.el --- Tables of Semantic Recoders -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -169,7 +169,7 @@ calculate all inherited templates from parent modes."
:modetables nil
:tables nil)))
;; Save this new mode table in that mode's variable.
- (eval `(setq-mode-local ,mode srecode-table ,new))
+ (eval `(setq-mode-local ,mode srecode-table ,new) t)
new))))
@@ -184,7 +184,7 @@ INIT are the initialization parameters for the new template table."
(let* ((mt (srecode-make-mode-table mode))
(old (srecode-mode-table-find mt file))
(attr (file-attributes file))
- (new (apply 'srecode-template-table
+ (new (apply #'srecode-template-table
(file-name-nondirectory file)
:file file
:filesize (file-attribute-size attr)
diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el
index e9e5115128f..1f6f0d345da 100644
--- a/lisp/cedet/srecode/template.el
+++ b/lisp/cedet/srecode/template.el
@@ -1,4 +1,4 @@
-;;; srecode/template.el --- SRecoder template language parser support.
+;;; srecode/template.el --- SRecoder template language parser support. -*- lexical-binding: t; -*-
;; Copyright (C) 2005, 2007-2021 Free Software Foundation, Inc.
@@ -49,11 +49,11 @@
(setq
;; Lexical Analysis
- semantic-lex-analyzer 'wisent-srecode-template-lexer
+ semantic-lex-analyzer #'wisent-srecode-template-lexer
;; Parsing
;; Environment
- semantic-imenu-summary-function 'semantic-format-tag-name
- imenu-create-index-function 'semantic-create-imenu-index
+ semantic-imenu-summary-function #'semantic-format-tag-name
+ imenu-create-index-function #'semantic-create-imenu-index
semantic-command-separation-character "\n"
semantic-lex-comment-regex ";;"
;; Speedbar
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 892ae4e2e31..1312a55a898 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -1,4 +1,4 @@
-;;; srecode/texi.el --- Srecode texinfo support.
+;;; srecode/texi.el --- Srecode texinfo support. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -224,7 +224,7 @@ Takes a few very generic guesses as to what the formatting is."
;; Return our modified doc string.
docstring))
-(defun srecode-texi-massage-to-texinfo (tag buffer string)
+(defun srecode-texi-massage-to-texinfo (_tag buffer string)
"Massage TAG's documentation from BUFFER as STRING.
This is to take advantage of TeXinfo's markup symbols."
(save-excursion
diff --git a/lisp/chistory.el b/lisp/chistory.el
index 589b5b5feb9..95c1b49cd8b 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -1,4 +1,4 @@
-;;; chistory.el --- list command history
+;;; chistory.el --- list command history -*- lexical-binding: t -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -71,8 +71,7 @@ If that function is given a list whose car is an element of this list,
then it will return non-nil (indicating the list should be discarded from
the history).
Initially, all commands related to the command history are discarded."
- :type '(repeat symbol)
- :group 'chistory)
+ :type '(repeat symbol))
(defvar list-command-history-filter 'default-command-history-filter
"Predicate to test which commands should be excluded from the history listing.
@@ -90,8 +89,7 @@ from the command history."
(defcustom list-command-history-max 32
"If non-nil, maximum length of the listing produced by `list-command-history'."
- :type '(choice integer (const nil))
- :group 'chistory)
+ :type '(choice integer (const nil)))
;;;###autoload
(defun list-command-history ()
@@ -127,10 +125,10 @@ The buffer is left in Command History mode."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap lisp-mode-shared-map
special-mode-map))
- (define-key map "x" 'command-history-repeat)
- (define-key map "\n" 'next-line)
- (define-key map "\r" 'next-line)
- (define-key map "\177" 'previous-line)
+ (define-key map "x" #'command-history-repeat)
+ (define-key map "\n" #'next-line)
+ (define-key map "\r" #'next-line)
+ (define-key map "\177" #'previous-line)
map)
"Keymap for `command-history-mode'.")
@@ -145,8 +143,7 @@ Keybindings:
(defcustom command-history-hook nil
"If non-nil, its value is called on entry to `command-history-mode'."
- :type 'hook
- :group 'chistory)
+ :type 'hook)
(defun command-history-revert (_ignore-auto _noconfirm)
(list-command-history))
@@ -165,7 +162,7 @@ The buffer for that command is the previous current buffer."
;;;###autoload
(defun command-history ()
- "Examine commands from `command-history' in a buffer.
+ "Examine commands from variable `command-history' in a buffer.
The number of commands listed is controlled by `list-command-history-max'.
The command history is filtered by `list-command-history-filter' if non-nil.
Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line.
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index 772891d5d31..18087da9ac9 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -1,7 +1,6 @@
-;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
+;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1988-2021 Free Software Foundation, Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -26,20 +25,18 @@
;; This is a customization of comint-mode (see comint.el)
;;
-;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
+;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
;; 8/88
;;
;; Please send me bug reports, bug fixes, and extensions, so that I can
;; merge them into the master source.
;;
-;; The changelog is at the end of this file.
-;;
;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
;; interface that communicates process state back to the superior emacs by
-;; outputting special control sequences. The Emacs package, xscheme.el, has
+;; outputting special control sequences. The Emacs package, xscheme.el, has
;; lots and lots of special purpose code to read these control sequences, and
-;; so is very tightly integrated with the cscheme process. The cscheme
+;; so is very tightly integrated with the cscheme process. The cscheme
;; interrupt handler and debugger read single character commands in cbreak
;; mode; when this happens, xscheme.el switches to special keymaps that bind
;; the single letter command keys to emacs functions that directly send the
@@ -49,18 +46,18 @@
;;
;; Here's a summary of the pros and cons, as I see them.
;; xscheme: Tightly integrated with inferior cscheme process! A few commands
-;; not in cmuscheme. But. Integration is a bit of a hack. Input
-;; history only keeps the immediately prior input. Bizarre
+;; not in cmuscheme. But. Integration is a bit of a hack. Input
+;; history only keeps the immediately prior input. Bizarre
;; keybindings.
;;
;; cmuscheme: Not tightly integrated with inferior cscheme process. But.
;; Carefully integrated functionality with the entire suite of
-;; comint-derived CMU process modes. Keybindings reminiscent of
-;; Zwei and Hemlock. Good input history. A few commands not in
+;; comint-derived CMU process modes. Keybindings reminiscent of
+;; Zwei and Hemlock. Good input history. A few commands not in
;; xscheme.
;;
-;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
-;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
+;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
+;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
;; Cscheme-specific; you must use cmuscheme.el. Interested parties are
;; invited to port xscheme functionality on top of comint mode...
@@ -70,18 +67,18 @@
;; Created.
;;
;; 2/15/89 Olin
-;; Removed -emacs flag from process invocation. It's only useful for
+;; Removed -emacs flag from process invocation. It's only useful for
;; cscheme, and makes cscheme assume it's running under xscheme.el,
-;; which messes things up royally. A bug.
+;; which messes things up royally. A bug.
;;
;; 5/22/90 Olin
;; - Upgraded to use comint-send-string and comint-send-region.
;; - run-scheme now offers to let you edit the command line if
-;; you invoke it with a prefix-arg. M-x scheme is redundant, and
+;; you invoke it with a prefix-arg. M-x scheme is redundant, and
;; has been removed.
;; - Explicit references to process "scheme" have been replaced with
-;; (scheme-proc). This allows better handling of multiple process bufs.
-;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
+;; (scheme-proc). This allows better handling of multiple process bufs.
+;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
;; and friends, but interested hackers might find a useful application
;; of this facility.
@@ -95,42 +92,37 @@
(require 'scheme)
(require 'comint)
-
(defgroup cmuscheme nil
"Run a scheme process in a buffer."
:group 'scheme)
-;;; INFERIOR SCHEME MODE STUFF
-;;;============================================================================
-
(defcustom inferior-scheme-mode-hook nil
"Hook for customizing inferior-scheme mode."
- :type 'hook
- :group 'cmuscheme)
+ :type 'hook)
(defvar inferior-scheme-mode-map
(let ((m (make-sparse-keymap)))
- (define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention
- (define-key m "\C-x\C-e" 'scheme-send-last-sexp)
- (define-key m "\C-c\C-l" 'scheme-load-file)
- (define-key m "\C-c\C-k" 'scheme-compile-file)
+ (define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention
+ (define-key m "\C-x\C-e" #'scheme-send-last-sexp)
+ (define-key m "\C-c\C-l" #'scheme-load-file)
+ (define-key m "\C-c\C-k" #'scheme-compile-file)
(scheme-mode-commands m)
m))
;; Install the process communication commands in the scheme-mode keymap.
-(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention
-(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention
-(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition)
-(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go)
-(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region)
-(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
-(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
-(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
-(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure)
-(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form)
-(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
-(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
-(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
+(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention
+(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention
+(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition)
+(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region)
+(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go)
+(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition)
+(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go)
+(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure)
+(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form)
+(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme)
+(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file)
+(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile"
(let ((map (lookup-key scheme-mode-map [menu-bar scheme])))
(define-key map [separator-eval] '("--"))
@@ -157,8 +149,7 @@
(define-key map [send-region]
'("Evaluate Region" . scheme-send-region))
(define-key map [send-sexp]
- '("Evaluate Last S-expression" . scheme-send-last-sexp))
- )
+ '("Evaluate Last S-expression" . scheme-send-last-sexp)))
(defvar scheme-buffer)
@@ -209,8 +200,7 @@ to continue it."
(defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
"Input matching this regexp are not saved on the history list.
Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
- :type 'regexp
- :group 'cmuscheme)
+ :type 'regexp)
(defun scheme-input-filter (str)
"Don't save anything matching `inferior-scheme-filter-regexp'."
@@ -242,7 +232,7 @@ is run).
scheme-program-name)))
(if (not (comint-check-proc "*scheme*"))
(let ((cmdlist (split-string-and-unquote cmd)))
- (set-buffer (apply 'make-comint "scheme" (car cmdlist)
+ (set-buffer (apply #'make-comint "scheme" (car cmdlist)
(scheme-start-file (car cmdlist)) (cdr cmdlist)))
(inferior-scheme-mode)))
(setq scheme-program-name cmd)
@@ -282,8 +272,7 @@ in this order. Return nil if no start file found."
(defcustom scheme-compile-exp-command "(compile '%s)"
"Template for issuing commands to compile arbitrary Scheme expressions."
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defun scheme-compile-region (start end)
"Compile the current region in the inferior Scheme process.
@@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use
(setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\")
For Scheme 48 and Scsh use \",trace %s\"."
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defcustom scheme-untrace-command "(untrace %s)"
"Template for switching off tracing of a Scheme procedure.
Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
-
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defun scheme-trace-procedure (proc &optional untrace)
"Trace procedure PROC in the inferior Scheme process.
@@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure PROC."
(defcustom scheme-macro-expand-command "(expand %s)"
"Template for macro-expanding a Scheme form.
For Scheme 48 and Scsh use \",expand %s\"."
- :type 'string
- :group 'cmuscheme)
+ :type 'string)
(defun scheme-expand-current-form ()
"Macro-expand the form at point in the inferior Scheme process."
@@ -410,8 +395,7 @@ Then switch to the process buffer."
If it's loaded into a buffer that is in one of these major modes, it's
considered a scheme source file by `scheme-load-file' and `scheme-compile-file'.
Used by these commands to determine defaults."
- :type '(repeat function)
- :group 'cmuscheme)
+ :type '(repeat function))
(defvar scheme-prev-l/c-dir/file nil
"Caches the last (directory . file) pair.
@@ -421,7 +405,7 @@ in the next one.")
(defun scheme-load-file (file-name)
"Load a Scheme file FILE-NAME into the inferior Scheme process."
- (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file
+ (interactive (comint-get-source "Load Scheme file" scheme-prev-l/c-dir/file
scheme-source-modes t)) ; t because `load'
; needs an exact name
(comint-check-source file-name) ; Check to see if buffer needs saved.
@@ -433,7 +417,7 @@ in the next one.")
(defun scheme-compile-file (file-name)
"Compile a Scheme file FILE-NAME in the inferior Scheme process."
- (interactive (comint-get-source "Compile Scheme file: "
+ (interactive (comint-get-source "Compile Scheme file"
scheme-prev-l/c-dir/file
scheme-source-modes
nil)) ; nil because COMPILE doesn't
@@ -514,8 +498,7 @@ command to run."
(defcustom cmuscheme-load-hook nil
"This hook is run when cmuscheme is loaded in.
This is a good place to put keybindings."
- :type 'hook
- :group 'cmuscheme)
+ :type 'hook)
(make-obsolete-variable 'cmuscheme-load-hook
"use `with-eval-after-load' instead." "28.1")
diff --git a/lisp/comint.el b/lisp/comint.el
index 57df6bfb19f..7af8e8fd2a5 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -54,7 +54,7 @@
;; instead of shell-mode, see the notes at the end of this file.
-;; Brief Command Documentation:
+;;; Brief Command Documentation:
;;============================================================================
;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp
;; mode)
@@ -104,8 +104,9 @@
(require 'ring)
(require 'ansi-color)
(require 'regexp-opt) ;For regexp-opt-charset.
+(eval-when-compile (require 'subr-x))
-;; Buffer Local Variables:
+;;; Buffer Local Variables:
;;============================================================================
;; Comint mode buffer local variables:
;; comint-prompt-regexp string comint-bol uses to match prompt
@@ -149,10 +150,10 @@
:group 'comint)
;; Unused.
-;;; (defgroup comint-source nil
-;;; "Source finding facilities in comint."
-;;; :prefix "comint-"
-;;; :group 'comint)
+;; (defgroup comint-source nil
+;; "Source finding facilities in comint."
+;; :prefix "comint-"
+;; :group 'comint)
(defvar comint-prompt-regexp "^"
"Regexp to recognize prompts in the inferior process.
@@ -365,23 +366,25 @@ This variable is buffer-local."
;; OpenBSD doas prints "doas (user@host) password:".
;; See ert test `comint-test-password-regexp'.
(defcustom comint-password-prompt-regexp
+ ;; When extending this, please also add a corresponding test where
+ ;; possible (see `comint-testsuite-password-strings').
(concat
"\\(^ *\\|"
(regexp-opt
'("Enter" "enter" "Enter same" "enter same" "Enter the" "enter the"
"Enter Auth" "enter auth" "Old" "old" "New" "new" "'s" "login"
"Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO"
- "[sudo]" "doas" "Repeat" "Bad" "Retype")
+ "[sudo]" "doas" "Repeat" "Bad" "Retype" "Verify")
t)
;; Allow for user name to precede password equivalent (Bug#31075).
" +.*\\)"
"\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
;; "[[:alpha:]]" used to be "for", which fails to match non-English.
- "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[::៖][[:blank:]]*\\'")
+ "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[::៖][[:space:]]*\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
- :version "27.1"
+ :version "28.1"
:type 'regexp
:group 'comint)
@@ -921,8 +924,8 @@ by the global keymap (usually `mouse-yank-at-click')."
;; Insert the input at point
(insert input)))))
-;; Input history processing in a buffer
-;; ===========================================================================
+;;; Input history processing in a buffer
+;;============================================================================
;; Useful input history functions, courtesy of the Ergo group.
;; Eleven commands:
@@ -1624,7 +1627,6 @@ or to the last history element for a backward search."
(if isearch-forward
(comint-goto-input (1- (ring-length comint-input-ring)))
(comint-goto-input nil))
- (setq isearch-success t)
(goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
@@ -1795,6 +1797,10 @@ Ignore duplicates if `comint-input-ignoredups' is non-nil."
(min size (- comint-input-ring-size size)))))
(ring-insert comint-input-ring cmd)))
+(defconst comint--prompt-rear-nonsticky
+ '(field inhibit-line-move-field-capture read-only font-lock-face)
+ "Text properties we set on the prompt and don't want to leak past it.")
+
(defun comint-send-input (&optional no-newline artificial)
"Send input to process.
After the process output mark, sends all text from the process mark to
@@ -1914,7 +1920,8 @@ Similarly for Soar, Scheme, etc."
(unless (or no-newline comint-use-prompt-regexp)
;; Cover the terminating newline
(add-text-properties end (1+ end)
- '(rear-nonsticky t
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky
field boundary
inhibit-line-move-field-capture t)))))
@@ -2121,9 +2128,10 @@ Make backspaces delete the previous character."
(unless comint-use-prompt-regexp
(with-silent-modifications
(add-text-properties comint-last-output-start (point)
- '(front-sticky
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky
+ front-sticky
(field inhibit-line-move-field-capture)
- rear-nonsticky t
field output
inhibit-line-move-field-capture t))))
@@ -2149,10 +2157,12 @@ Make backspaces delete the previous character."
'comint-highlight-prompt))
(setq comint-last-prompt
(cons (copy-marker prompt-start) (point-marker)))
- (font-lock-prepend-text-property prompt-start (point)
- 'font-lock-face
- 'comint-highlight-prompt)
- (add-text-properties prompt-start (point) '(rear-nonsticky t)))
+ (font-lock-append-text-property prompt-start (point)
+ 'font-lock-face
+ 'comint-highlight-prompt)
+ (add-text-properties prompt-start (point)
+ `(rear-nonsticky
+ ,comint--prompt-rear-nonsticky)))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
@@ -2248,23 +2258,23 @@ This function could be on `comint-output-filter-functions' or bound to a key."
(let ((inhibit-read-only t))
(delete-region (point-min) (point)))))
-(defun comint-strip-ctrl-m (&optional _string)
+(defun comint-strip-ctrl-m (&optional _string interactive)
"Strip trailing `^M' characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
- (interactive)
+ (interactive (list nil t))
(let ((process (get-buffer-process (current-buffer))))
(if (not process)
;; This function may be used in
;; `comint-output-filter-functions', and in that case, if
;; there's no process, then we should do nothing. If
;; interactive, report an error.
- (when (called-interactively-p 'interactive)
+ (when interactive
(error "No process in the current buffer"))
(let ((pmark (process-mark process)))
(save-excursion
(condition-case nil
(goto-char
- (if (called-interactively-p 'interactive)
+ (if interactive
comint-last-input-end comint-last-output-start))
(error nil))
(while (re-search-forward "\r+$" pmark t)
@@ -2429,13 +2439,12 @@ carriage returns (\\r) in STRING.
This function could be in the list `comint-output-filter-functions'."
(when (let ((case-fold-search t))
(string-match comint-password-prompt-regexp
- (replace-regexp-in-string "\r" "" string)))
- (when (string-match "^[ \n\r\t\v\f\b\a]+" string)
- (setq string (replace-match "" t t string)))
+ (string-replace "\r" "" string)))
(let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth)))
(if (> comint--prompt-recursion-depth 10)
(message "Password prompt recursion too deep")
- (comint-send-invisible string)))))
+ (comint-send-invisible
+ (string-trim string "[ \n\r\t\v\f\b\a]+" "\n+"))))))
;; Low-level process communication
@@ -2462,10 +2471,13 @@ This function could be in the list `comint-output-filter-functions'."
;; Random input hackage
-(defun comint-delete-output ()
+(defun comint-delete-output (&optional kill)
"Delete all output from interpreter since last input.
-Does not delete the prompt."
- (interactive)
+If KILL (interactively, the prefix), save the killed text in the
+kill ring.
+
+This command does not delete the prompt."
+ (interactive "P")
(let ((proc (get-buffer-process (current-buffer)))
(replacement nil)
(inhibit-read-only t))
@@ -2473,6 +2485,8 @@ Does not delete the prompt."
(let ((pmark (progn (goto-char (process-mark proc))
(forward-line 0)
(point-marker))))
+ (when kill
+ (copy-region-as-kill comint-last-input-end pmark))
(delete-region comint-last-input-end pmark)
(goto-char (process-mark proc))
(setq replacement (concat "*** output flushed ***\n"
@@ -2838,7 +2852,7 @@ updated using `comint-update-fence', if necessary."
(kill-region beg end)
(comint-update-fence))))))
-;; Support for source-file processing commands.
+;;; Support for source-file processing commands.
;;============================================================================
;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
;; commands that process files of source text (e.g. loading or compiling
@@ -2944,7 +2958,7 @@ two arguments are used for determining defaults.) If MUSTMATCH-P is true,
then the filename reader will only accept a file that exists.
A typical use:
- (interactive (comint-get-source \"Compile file: \" prev-lisp-dir/file
+ (interactive (comint-get-source \"Compile file\" prev-lisp-dir/file
\\='(lisp-mode) t))"
(let* ((def (comint-source-default prev-dir/file source-modes))
(stringfile (comint-extract-string))
@@ -2957,9 +2971,7 @@ A typical use:
(car def)))
(deffile (if sfile-p (file-name-nondirectory stringfile)
(cdr def)))
- (ans (read-file-name (if deffile (format "%s(default %s) "
- prompt deffile)
- prompt)
+ (ans (read-file-name (format-prompt prompt deffile)
defdir
(concat defdir deffile)
mustmatch-p)))
@@ -2974,8 +2986,8 @@ A typical use:
;; -Olin
-;; Simple process query facility.
-;; ===========================================================================
+;;; Simple process query facility.
+;;============================================================================
;; This function is for commands that want to send a query to the process
;; and show the response to the user. For example, a command to get the
;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
@@ -3011,8 +3023,8 @@ its response can be seen."
(set-window-point proc-win opoint)))))))
-;; Filename/command/history completion in a buffer
-;; ===========================================================================
+;;; Filename/command/history completion in a buffer
+;;============================================================================
;; Useful completion functions, courtesy of the Ergo group.
;; Six commands:
@@ -3876,8 +3888,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
(forward-line 1)))
(nreverse results))))
-;; Converting process modes to use comint mode
-;; ===========================================================================
+;;; Converting process modes to use comint mode
+;;============================================================================
;; The code in the Emacs 19 distribution has all been modified to use comint
;; where needed. However, there are `third-party' packages out there that
;; still use the old shell mode. Here's a guide to conversion.
diff --git a/lisp/completion.el b/lisp/completion.el
index da2fb38febc..93a869e86f4 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1,7 +1,6 @@
-;;; completion.el --- dynamic word-completion code
+;;; completion.el --- dynamic word-completion code -*- lexical-binding: t; -*-
-;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2021 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1990-2021 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev convenience
@@ -286,62 +285,52 @@
(defcustom enable-completion t
"Non-nil means enable recording and saving of completions.
If nil, no new words are added to the database or saved to the init file."
- :type 'boolean
- :group 'completion)
+ :type 'boolean)
(defcustom save-completions-flag t
"Non-nil means save most-used completions when exiting Emacs.
See also `save-completions-retention-time'."
- :type 'boolean
- :group 'completion)
+ :type 'boolean)
(defcustom save-completions-file-name
(locate-user-emacs-file "completions" ".completions")
"The filename to save completions to."
- :type 'file
- :group 'completion)
+ :type 'file)
(defcustom save-completions-retention-time 336
"Discard a completion if unused for this many hours.
\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
will not be saved unless these are used. Default is two weeks."
- :type 'integer
- :group 'completion)
+ :type 'integer)
(defcustom completion-on-separator-character nil
"Non-nil means separator characters mark previous word as used.
This means the word will be saved as a completion."
- :type 'boolean
- :group 'completion)
+ :type 'boolean)
(defcustom completions-file-versions-kept kept-new-versions
"Number of versions to keep for the saved completions file."
- :type 'integer
- :group 'completion)
+ :type 'integer)
(defcustom completion-prompt-speed-threshold 4800
"Minimum output speed at which to display next potential completion."
- :type 'integer
- :group 'completion)
+ :type 'integer)
(defcustom completion-cdabbrev-prompt-flag nil
"If non-nil, the next completion prompt does a cdabbrev search.
This can be time consuming."
- :type 'boolean
- :group 'completion)
+ :type 'boolean)
(defcustom completion-search-distance 15000
"How far to search in the buffer when looking for completions.
In number of characters. If nil, search the whole buffer."
- :type 'integer
- :group 'completion)
+ :type 'integer)
(defcustom completions-merging-modes '(lisp c)
"List of modes {`c' or `lisp'} for automatic completions merging.
Definitions from visited files which have these modes
are automatically added to the completion database."
- :type '(set (const lisp) (const c))
- :group 'completion)
+ :type '(set (const lisp) (const c)))
;;(defvar *completion-auto-save-period* 1800
;; "The period in seconds to wait for emacs to be idle before autosaving
@@ -950,9 +939,9 @@ Each symbol is bound to a single completion entry.")
;; READER Macros
-(defalias 'cmpl-prefix-entry-head 'car)
+(defalias 'cmpl-prefix-entry-head #'car)
-(defalias 'cmpl-prefix-entry-tail 'cdr)
+(defalias 'cmpl-prefix-entry-tail #'cdr)
;; WRITER Macros
@@ -978,31 +967,27 @@ Each symbol is bound to a single completion entry.")
(setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
(setq cmpl-obarray (make-vector cmpl-obarray-length 0)))
-(defvar completions-list-return-value)
-
(defun list-all-completions ()
"Return a list of all the known completion entries."
- (let ((completions-list-return-value nil))
- (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
- completions-list-return-value))
-
-(defun list-all-completions-1 (prefix-symbol)
- (if (boundp prefix-symbol)
- (setq completions-list-return-value
- (append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
- completions-list-return-value))))
-
-(defun list-all-completions-by-hash-bucket ()
+ (let ((return-value nil))
+ (mapatoms (lambda (prefix-symbol)
+ (if (boundp prefix-symbol)
+ (setq return-value
+ (append (cmpl-prefix-entry-head
+ (symbol-value prefix-symbol))
+ return-value))))
+ cmpl-prefix-obarray)
+ return-value))
+
+(defun list-all-completions-by-hash-bucket () ;FIXME: Unused!
"Return list of lists of known completion entries, organized by hash bucket."
- (let ((completions-list-return-value nil))
- (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
- completions-list-return-value))
-
-(defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
- (if (boundp prefix-symbol)
- (setq completions-list-return-value
- (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
- completions-list-return-value))))
+ (let ((return-value nil))
+ (mapatoms (lambda (prefix-symbol)
+ (if (boundp prefix-symbol)
+ (push (cmpl-prefix-entry-head (symbol-value prefix-symbol))
+ return-value)))
+ cmpl-prefix-obarray)
+ return-value))
;;-----------------------------------------------
@@ -1932,68 +1917,64 @@ If file is not specified, then use `save-completions-file-name'."
(clear-visited-file-modtime)
(erase-buffer)
- (let ((insert-okay-p nil)
- (buffer (current-buffer))
+ (let ((buffer (current-buffer))
string entry last-use-time
cmpl-entry cmpl-last-use-time
(current-completion-source cmpl-source-init-file)
(total-in-file 0) (total-perm 0))
;; insert the file into a buffer
(condition-case nil
- (progn (insert-file-contents filename t)
- (setq insert-okay-p t))
-
+ (insert-file-contents filename t)
(file-error
(message "File error trying to load completion file %s."
- filename)))
- ;; parse it
- (if insert-okay-p
- (progn
- (goto-char (point-min))
-
- (condition-case nil
- (while t
- (setq entry (read buffer))
- (setq total-in-file (1+ total-in-file))
- (cond
- ((and (consp entry)
- (stringp (setq string (car entry)))
- (cond
- ((eq (setq last-use-time (cdr entry)) 'T)
- ;; handle case sensitivity
- (setq total-perm (1+ total-perm))
- (setq last-use-time t))
- ((eq last-use-time t)
- (setq total-perm (1+ total-perm)))
- ((integerp last-use-time))))
- ;; Valid entry
- ;; add it in
- (setq cmpl-last-use-time
- (completion-last-use-time
- (setq cmpl-entry
- (add-completion-to-tail-if-new string))))
- (if (or (eq last-use-time t)
- (and (> last-use-time 1000);;backcompatibility
- (not (eq cmpl-last-use-time t))
- (or (not cmpl-last-use-time)
- ;; more recent
- (> last-use-time cmpl-last-use-time))))
- ;; update last-use-time
- (set-completion-last-use-time cmpl-entry last-use-time)))
- (t
- ;; Bad format
- (message "Error: invalid saved completion - %s"
- (prin1-to-string entry))
- ;; try to get back in sync
- (search-forward "\n("))))
- (search-failed
- (message "End of file while reading completions."))
- (end-of-file
- (if (= (point) (point-max))
- (if (not no-message-p)
- (message "Loading completions from file %s . . . Done."
- filename))
- (message "End of file while reading completions."))))))
+ filename))
+ (:success
+ ;; parse it
+ (goto-char (point-min))
+
+ (condition-case nil
+ (while t
+ (setq entry (read buffer))
+ (setq total-in-file (1+ total-in-file))
+ (cond
+ ((and (consp entry)
+ (stringp (setq string (car entry)))
+ (cond
+ ((eq (setq last-use-time (cdr entry)) 'T)
+ ;; handle case sensitivity
+ (setq total-perm (1+ total-perm))
+ (setq last-use-time t))
+ ((eq last-use-time t)
+ (setq total-perm (1+ total-perm)))
+ ((integerp last-use-time))))
+ ;; Valid entry
+ ;; add it in
+ (setq cmpl-last-use-time
+ (completion-last-use-time
+ (setq cmpl-entry
+ (add-completion-to-tail-if-new string))))
+ (if (or (eq last-use-time t)
+ (and (> last-use-time 1000);;backcompatibility
+ (not (eq cmpl-last-use-time t))
+ (or (not cmpl-last-use-time)
+ ;; more recent
+ (> last-use-time cmpl-last-use-time))))
+ ;; update last-use-time
+ (set-completion-last-use-time cmpl-entry last-use-time)))
+ (t
+ ;; Bad format
+ (message "Error: invalid saved completion - %s"
+ (prin1-to-string entry))
+ ;; try to get back in sync
+ (search-forward "\n("))))
+ (search-failed
+ (message "End of file while reading completions."))
+ (end-of-file
+ (if (= (point) (point-max))
+ (if (not no-message-p)
+ (message "Loading completions from file %s . . . Done."
+ filename))
+ (message "End of file while reading completions."))))))
))))))
(defun completion-initialize ()
@@ -2155,7 +2136,6 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(define-minor-mode dynamic-completion-mode
"Toggle dynamic word-completion on or off."
:global t
- :group 'completion
;; This is always good, not specific to dynamic-completion-mode.
(define-key function-key-map [C-return] [?\C-\r])
@@ -2239,7 +2219,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(completion-def-wrapper 'delete-backward-char-untabify :backward)
;; Old name, non-namespace-clean.
-(defalias 'initialize-completions 'completion-initialize)
+(defalias 'initialize-completions #'completion-initialize)
(provide 'completion)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index a52d08266c1..31a896088a5 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -1,4 +1,4 @@
-;;; cus-dep.el --- find customization dependencies
+;;; cus-dep.el --- find customization dependencies -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;;
@@ -109,6 +109,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(string-match "\\`\\(.*\\)\\.el\\'" file)
(let ((name (or generated-autoload-load-name ; see bug#5277
(file-name-nondirectory (match-string 1 file))))
+ (load-true-file-name file)
(load-file-name file))
(if (save-excursion
(re-search-forward
@@ -131,7 +132,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
'custom-where name)
;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties.
- (eval expr))
+ (eval expr t))
;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier
;; in the file (we haven't loaded the file).
@@ -163,7 +164,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(let ((members (get symbol 'custom-group))
where found)
(when members
- (dolist (member (mapcar 'car members))
+ (dolist (member (mapcar #'car members))
(setq where (get member 'custom-where))
(unless (or (null where)
(member where found))
@@ -178,7 +179,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(insert "\
;; The remainder of this file is for handling :version.
-;; We provide a minimum of information so that `customize-changed-options'
+;; We provide a minimum of information so that `customize-changed'
;; can do its job.
;; For groups we set `custom-version', `group-documentation' and
@@ -239,7 +240,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
This is an alist whose members have as car a version string, and as
elements the files that have variables or faces that contain that
version. These files should be loaded before showing the customization
-buffer that `customize-changed-options' generates.\")\n\n"))
+buffer that `customize-changed' generates.\")\n\n"))
(save-buffer)
(byte-compile-info
(format "Generating %s...done" generated-custom-dependencies-file) t))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index cd1ae964eb9..7eae2e416bb 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1206,7 +1206,7 @@ Show the buffer in another window, but don't select it."
(message "`%s' is an alias for `%s'" symbol basevar))))
(defvar customize-changed-options-previous-release "26.3"
- "Version for `customize-changed-options' to refer back to by default.")
+ "Version for `customize-changed' to refer back to by default.")
;; Packages will update this variable, so make it available.
;;;###autoload
@@ -1665,8 +1665,11 @@ Otherwise use brackets."
'custom-button-pressed
'custom-button-pressed-unraised))))
+(defvar custom--invocation-options nil)
+
(defun custom-buffer-create-internal (options &optional _description)
(Custom-mode)
+ (setq custom--invocation-options options)
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
@@ -1907,7 +1910,7 @@ item in another window.\n\n"))
(widget-put (get 'editable-field 'widget-type)
:custom-show (lambda (_widget value)
(let ((pp (pp-to-string value)))
- (cond ((string-match-p "\n" pp)
+ (cond ((string-search "\n" pp)
nil)
((> (length pp) 40)
nil)
@@ -2821,7 +2824,7 @@ the present value is saved to its :shown-value property instead."
(list (widget-value
(car-safe
(widget-get widget :children)))))
- (error "There are unsaved changes")))
+ (message "Note: There are unsaved changes")))
(widget-put widget :documentation-shown nil)
(widget-put widget :custom-state 'hidden))
(custom-redraw widget)
@@ -5148,14 +5151,20 @@ if that value is non-nil."
:label (nth 5 arg)))
custom-commands)
(setq custom-tool-bar-map map))))
+ (setq-local custom--invocation-options nil)
+ (setq-local revert-buffer-function #'custom--revert-buffer)
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(custom--initialize-widget-variables)
(add-hook 'widget-edit-functions 'custom-state-buffer-message nil t))
-(put 'Custom-mode 'mode-class 'special)
+(defun custom--revert-buffer (_ignore-auto _noconfirm)
+ (unless custom--invocation-options
+ (error "Insufficient data to revert"))
+ (custom-buffer-create custom--invocation-options
+ (buffer-name)))
-;;; The End.
+(put 'Custom-mode 'mode-class 'special)
(provide 'cus-edit)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 21fe89c6214..6c0052bf860 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -395,8 +395,6 @@ This means reset FACE to its value in FROM-THEME."
(define-obsolete-function-alias 'custom-facep #'facep "28.1")
-;;; The End.
-
(provide 'cus-face)
;;; cus-face.el ends here
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index c0a4a6dda06..19975307894 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -36,7 +36,7 @@
(defun minibuffer-prompt-properties--setter (symbol value)
(set-default symbol value)
(if (memq 'cursor-intangible value)
- (add-hook 'minibuffer-setup-hook 'cursor-intangible-mode)
+ (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
;; Removing it is a bit trickier since it could have been added by someone
;; else as well, so let's just not bother.
))
@@ -285,6 +285,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
;; See bug#7135.
(let* (file-name-handler-alist
+ (default-directory "/")
(tmp (ignore-errors
(shell-command-to-string
"getconf DARWIN_USER_TEMP_DIR"))))
@@ -302,10 +303,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; fns.c
(use-dialog-box menu boolean "21.1")
(use-file-dialog menu boolean "22.1")
+ (use-short-answers menu boolean "28.1")
(focus-follows-mouse
frames (choice
- (const :tag "Off (nil)" :value nil)
- (const :tag "On (t)" :value t)
+ (const :tag "Off" :value nil)
+ (const :tag "On" :value t)
(const :tag "Auto-raise" :value auto-raise)) "26.1")
;; fontset.c
;; FIXME nil is the initial value, fontset.el setqs it.
@@ -429,6 +431,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
"21.1"
:set minibuffer-prompt-properties--setter)
(minibuffer-auto-raise minibuffer boolean)
+ (read-minibuffer-restore-windows minibuffer boolean "28.1")
;; options property set at end
(read-buffer-function minibuffer
(choice (const nil)
@@ -601,27 +604,29 @@ since it could result in memory overflow and make Emacs crash."
(next-screen-context-lines windows integer)
(scroll-preserve-screen-position
windows (choice
- (const :tag "Off (nil)" :value nil)
- (const :tag "Full screen (t)" :value t)
- (other :tag "Always" 1)) "22.1")
+ (const :tag "Off" :value nil)
+ (const :tag "Full screen" :value t)
+ (other :tag "Always" 1))
+ "22.1")
(recenter-redisplay
windows (choice
- (const :tag "Never (nil)" :value nil)
+ (const :tag "Never" :value nil)
(const :tag "Only on ttys" :value tty)
- (other :tag "Always" t)) "23.1")
+ (other :tag "Always" t))
+ "23.1")
(window-combination-resize windows boolean "24.1")
(window-combination-limit
windows (choice
- (const :tag "Never (nil)" :value nil)
- (const :tag "If requested via buffer display alist (window-size)"
+ (const :tag "Never" :value nil)
+ (const :tag "If requested via buffer display alist"
:value window-size)
- (const :tag "With Temp Buffer Resize mode (temp-buffer-resize)"
+ (const :tag "With Temp Buffer Resize mode"
:value temp-buffer-resize)
- (const :tag "For temporary buffers (temp-buffer)"
+ (const :tag "For temporary buffers"
:value temp-buffer)
- (const :tag "For buffer display (display-buffer)"
+ (const :tag "For buffer display"
:value display-buffer)
- (other :tag "Always (t)" :value t))
+ (other :tag "Always" :value t))
"26.1")
(fast-but-imprecise-scrolling scrolling boolean "25.1")
(window-resize-pixelwise windows boolean "24.4")
@@ -629,6 +634,12 @@ since it could result in memory overflow and make Emacs crash."
;; The whitespace group is for whitespace.el.
(show-trailing-whitespace editing-basics boolean nil
:safe booleanp)
+ (mode-line-compact
+ mode-line
+ (choice (const :tag "Never" :value nil)
+ (const :tag "Only if wider than window" :value long)
+ (const :tag "Always" :value t))
+ "28.1")
(scroll-step windows integer)
(scroll-conservatively windows integer)
(scroll-margin windows integer)
@@ -666,7 +677,7 @@ since it could result in memory overflow and make Emacs crash."
(underline-minimum-offset display integer "23.1")
(mouse-autoselect-window
display (choice
- (const :tag "Off (nil)" :value nil)
+ (const :tag "Off" :value nil)
(const :tag "Immediate" :value t)
(number :tag "Delay by secs" :value 0.5)) "22.1")
(tool-bar-style
@@ -711,15 +722,15 @@ since it could result in memory overflow and make Emacs crash."
(hourglass-delay cursor number)
(resize-mini-windows
windows (choice
- (const :tag "Off (nil)" :value nil)
- (const :tag "Fit (t)" :value t)
+ (const :tag "Off" :value nil)
+ (const :tag "Fit" :value t)
(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 "Off" :value nil)
(const :tag "Absolute line numbers"
:value t)
(const :tag "Relative line numbers"
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index a702fedd245..7457d9e3236 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -1,7 +1,7 @@
-;;; cus-theme.el -- custom theme creation user interface -*- lexical-binding: t -*-
-;;
+;;; cus-theme.el --- custom theme creation user interface -*- lexical-binding: t -*-
+
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
-;;
+
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
@@ -66,7 +66,7 @@ Do not call this mode function yourself. It is meant for internal use."
shadow secondary-selection trailing-whitespace
font-lock-builtin-face font-lock-comment-delimiter-face
font-lock-comment-face font-lock-constant-face
- font-lock-doc-face font-lock-function-name-face
+ font-lock-doc-face font-lock-doc-markup-face font-lock-function-name-face
font-lock-keyword-face font-lock-negation-char-face
font-lock-preprocessor-face font-lock-regexp-grouping-backslash
font-lock-regexp-grouping-construct font-lock-string-face
@@ -108,60 +108,16 @@ named *Custom Theme*."
(unless (y-or-n-p "Include basic face customizations in this theme? ")
(setq custom-theme--listed-faces nil)))
- (if (eq theme 'user)
- (widget-insert "This buffer contains all the Custom settings you have made.
-You can convert them into a new custom theme, and optionally
-remove them from your saved Custom file.\n\n"))
-
- (widget-create 'push-button
- :tag " Visit Theme "
- :help-echo "Insert the settings of a pre-defined theme."
- :action (lambda (_widget &optional _event)
- (call-interactively #'custom-theme-visit-theme)))
- (widget-insert " ")
- (widget-create 'push-button
- :tag " Merge Theme "
- :help-echo "Merge in the settings of a pre-defined theme."
- :action (lambda (_widget &optional _event)
- (call-interactively #'custom-theme-merge-theme)))
- (widget-insert " ")
- (widget-create 'push-button
- :tag " Revert "
- :help-echo "Revert this buffer to its original state."
- :action (lambda (&rest ignored) (revert-buffer)))
-
- (widget-insert "\n\nTheme name : ")
- (setq custom-theme-name
- (widget-create 'editable-field
- :value (if (and theme (not (eq theme 'user)))
- (symbol-name theme)
- "")))
- (widget-insert "Description: ")
- (setq custom-theme-description
- (widget-create 'text
- :value (format-time-string "Created %Y-%m-%d.")))
- (widget-create 'push-button
- :notify #'custom-theme-write
- " Save Theme ")
- (when (eq theme 'user)
- (setq custom-theme--migrate-settings t)
- (widget-insert " ")
- (widget-create 'checkbox
- :value custom-theme--migrate-settings
- :action (lambda (widget &optional event)
- (when (widget-value widget)
- (widget-toggle-action widget event)
- (setq custom-theme--migrate-settings
- (widget-value widget)))))
- (widget-insert (propertize " Remove saved theme settings from Custom save file."
- 'face '(variable-pitch (:height 0.9)))))
-
(let (vars values faces face-specs)
;; Load the theme settings.
(when theme
- (unless (eq theme 'user)
- (load-theme theme nil t))
+ (if (eq theme 'user)
+ (widget-insert "This buffer contains all the Custom settings you have made.
+You can convert them into a new custom theme, and optionally
+remove them from your saved Custom file.\n\n")
+ (load-theme theme nil t))
+
(dolist (setting (get theme 'theme-settings))
(if (eq (car setting) 'theme-value)
(progn (push (nth 1 setting) vars)
@@ -169,6 +125,50 @@ remove them from your saved Custom file.\n\n"))
(push (nth 1 setting) faces)
(push (nth 3 setting) face-specs))))
+ (widget-create 'push-button
+ :tag " Visit Theme "
+ :help-echo "Insert the settings of a pre-defined theme."
+ :action (lambda (_widget &optional _event)
+ (call-interactively #'custom-theme-visit-theme)))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag " Merge Theme "
+ :help-echo "Merge in the settings of a pre-defined theme."
+ :action (lambda (_widget &optional _event)
+ (call-interactively #'custom-theme-merge-theme)))
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag " Revert "
+ :help-echo "Revert this buffer to its original state."
+ :action (lambda (&rest ignored) (revert-buffer)))
+
+ (widget-insert "\n\nTheme name : ")
+ (setq custom-theme-name
+ (widget-create 'editable-field
+ :value (if (and theme (not (eq theme 'user)))
+ (symbol-name theme)
+ "")))
+ (widget-insert "Description: ")
+ (setq custom-theme-description
+ (widget-create 'text :format "%v"
+ :value (or (get theme 'theme-documentation)
+ (format-time-string "Created %Y-%m-%d."))))
+ (widget-create 'push-button
+ :notify #'custom-theme-write
+ " Save Theme ")
+ (when (eq theme 'user)
+ (setq custom-theme--migrate-settings t)
+ (widget-insert " ")
+ (widget-create 'checkbox
+ :value custom-theme--migrate-settings
+ :action (lambda (widget &optional event)
+ (when (widget-value widget)
+ (widget-toggle-action widget event)
+ (setq custom-theme--migrate-settings
+ (widget-value widget)))))
+ (widget-insert (propertize " Remove saved theme settings from Custom save file."
+ 'face '(variable-pitch (:height 0.9)))))
+
;; If THEME is non-nil, insert all of that theme's faces.
;; Otherwise, insert those in `custom-theme--listed-faces'.
(widget-insert "\n\n Theme faces:\n ")
@@ -657,10 +657,12 @@ Theme files are named *-theme.el in `"))
(insert-file-contents fn)
(let ((sexp (let ((read-circle nil))
(condition-case nil
- (read (current-buffer))
- (end-of-file nil)))))
- (and (eq (car-safe sexp) 'deftheme)
- (setq doc (nth 2 sexp))))))))
+ (progn
+ (re-search-forward "^(deftheme")
+ (beginning-of-line)
+ (read (current-buffer)))
+ (error nil)))))
+ (setq doc (nth 2 sexp)))))))
(cond ((null doc)
"(no documentation available)")
((string-match ".*" doc)
diff --git a/lisp/custom.el b/lisp/custom.el
index 833810718b7..f392bd8d369 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -117,9 +117,10 @@ For the standard setting, use `set-default'."
(set-default symbol (eval exp)))))))
(defvar custom-delayed-init-variables nil
- "List of variables whose initialization is pending.")
+ "List of variables whose initialization is pending until startup.
+Once this list has been processed, this var is set to a non-list value.")
-(defun custom-initialize-delay (symbol _value)
+(defun custom-initialize-delay (symbol value)
"Delay initialization of SYMBOL to the next Emacs start.
This is used in files that are preloaded (or for autoloaded
variables), so that the initialization is done in the run-time
@@ -133,7 +134,11 @@ the :set function."
;; This seemed to be at least as good as setting it to an arbitrary
;; value like nil (evaluating `value' is not an option because it
;; may have undesirable side-effects).
- (push symbol custom-delayed-init-variables))
+ (if (listp custom-delayed-init-variables)
+ (push symbol custom-delayed-init-variables)
+ ;; In case this is called after startup, there is no "later" to which to
+ ;; delay it, so initialize it "normally" (bug#47072).
+ (custom-initialize-reset symbol value)))
(defun custom-declare-variable (symbol default doc &rest args)
"Like `defcustom', but SYMBOL and DEFAULT are evaluated as normal arguments.
@@ -202,7 +207,22 @@ set to nil, as the value is no longer rogue."
(put symbol 'custom-requests requests)
;; Do the actual initialization.
(unless custom-dont-initialize
- (funcall initialize symbol default))
+ (funcall initialize symbol default)
+ ;; If there is a value under saved-value that wasn't saved by the user,
+ ;; reset it: we used that property to stash the value, but we don't need
+ ;; it anymore.
+ ;; This can happen given the following:
+ ;; 1. The user loaded a theme that had a setting for an unbound
+ ;; variable, so we stashed the theme setting under the saved-value
+ ;; property in `custom-theme-recalc-variable'.
+ ;; 2. Then, Emacs evaluated the defcustom for the option
+ ;; (e.g., something required the file where the option is defined).
+ ;; If we don't reset it and the user later sets this variable via
+ ;; Customize, we might end up saving the theme setting in the custom-file.
+ ;; See the test `custom-test-no-saved-value-after-customizing-option'.
+ (let ((theme (caar (get symbol 'theme-value))))
+ (when (and theme (not (eq theme 'user)) (get symbol 'saved-value))
+ (put symbol 'saved-value nil))))
(when buffer-local
(make-variable-buffer-local symbol)))
(run-hooks 'custom-define-hook)
@@ -906,7 +926,7 @@ See `custom-known-themes' for a list of known themes."
;; the value to a fake theme, `changed'. If the theme is
;; later disabled, we use this to bring back the old value.
;;
- ;; For faces, we just use `face-new-frame-defaults' to
+ ;; For faces, we just use `face--new-frame-defaults' to
;; recompute when the theme is disabled.
(when (and (eq prop 'theme-value)
(boundp symbol))
@@ -1200,6 +1220,32 @@ property `theme-feature' (which is usually a symbol created by
(custom-check-theme theme)
(provide (get theme 'theme-feature)))
+(defun require-theme (feature &optional noerror)
+ "Load FEATURE from a file along `custom-theme-load-path'.
+
+This function is like `require', but searches along
+`custom-theme-load-path' instead of `load-path'. It can be used
+by Custom themes to load supporting Lisp files when `require' is
+unsuitable.
+
+If FEATURE is not already loaded, search for a file named FEATURE
+with an added `.elc' or `.el' suffix, in that order, in the
+directories specified by `custom-theme-load-path'.
+
+Return FEATURE if the file is successfully found and loaded, or
+if FEATURE was already loaded. If the file fails to load, signal
+an error. If optional argument NOERROR is non-nil, return nil
+instead of signaling an error. If the file loads but does not
+provide FEATURE, signal an error. This cannot be suppressed."
+ (cond
+ ((featurep feature) feature)
+ ((let* ((path (custom-theme--load-path))
+ (file (locate-file (symbol-name feature) path '(".elc" ".el"))))
+ (and file (require feature (file-name-sans-extension file) noerror))))
+ ((not noerror)
+ (signal 'file-missing `("Cannot open load file" "No such file or directory"
+ ,(symbol-name feature))))))
+
(defcustom custom-safe-themes '(default)
"Themes that are considered safe to load.
If the value is a list, each element should be either the SHA-256
@@ -1482,10 +1528,18 @@ See `custom-enabled-themes' for a list of enabled themes."
(let* ((prop (car s))
(symbol (cadr s))
(val (assq-delete-all theme (get symbol prop))))
- (custom-push-theme prop symbol theme 'reset)
+ (put symbol prop val)
(cond
((eq prop 'theme-value)
- (custom-theme-recalc-variable symbol))
+ (custom-theme-recalc-variable symbol)
+ ;; We might have to reset the stashed value of the variable, if
+ ;; no other theme is customizing it. Without this, loading a theme
+ ;; that has a setting for an unbound user option and then disabling
+ ;; it will leave this lingering setting for the option, and if then
+ ;; Emacs evaluates the defcustom the saved-value might be used to
+ ;; set the variable. (Bug#20766)
+ (unless (get symbol 'theme-value)
+ (put symbol 'saved-value nil)))
((eq prop 'theme-face)
;; If the face spec specified by this theme is in the
;; saved-face property, reset that property.
@@ -1534,8 +1588,16 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
(defun custom-theme-recalc-variable (variable)
"Set VARIABLE according to currently enabled custom themes."
(let ((valspec (custom-variable-theme-value variable)))
- (if valspec
- (put variable 'saved-value valspec)
+ ;; We used to save VALSPEC under the saved-value property unconditionally,
+ ;; but that is a recipe for trouble because we might end up saving session
+ ;; customizations if the user loads a theme. (Bug#21355)
+ ;; It's better to only use the saved-value property to stash the value only
+ ;; if we really need to stash it (i.e., VARIABLE is void).
+ (condition-case nil
+ (default-toplevel-value variable) ; See if it doesn't fail.
+ (void-variable (when valspec
+ (put variable 'saved-value valspec))))
+ (unless valspec
(setq valspec (get variable 'standard-value)))
(if (and valspec
(or (get variable 'force-value)
@@ -1597,8 +1659,6 @@ If a choice with the same tag already exists, no action is taken."
(put variable 'custom-type
(append choices (list choice))))))
-;;; The End.
-
(provide 'custom)
;;; custom.el ends here
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 982320340d8..93fdc6a8863 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -84,9 +84,12 @@ information on adapting behavior of commands in Delete Selection mode."
(defvar delsel--replace-text-or-position nil)
+;;;###autoload
(defun delete-active-region (&optional killp)
"Delete the active region.
-If KILLP in not-nil, the active region is killed instead of deleted."
+If KILLP is non-nil, or if called interactively with a prefix argument,
+the active region is killed instead of deleted."
+ (interactive "P")
(cond
(killp
;; Don't allow `kill-region' to change the value of `this-command'.
@@ -105,7 +108,7 @@ If KILLP in not-nil, the active region is killed instead of deleted."
"Repeat replacing text of highlighted region with typed text.
Search for the next stretch of text identical to the region last replaced
by typing text over it and replaces it with the same stretch of text.
-With ARG, repeat that many times. `C-u' means until end of buffer."
+With ARG, repeat that many times. `\\[universal-argument]' means until end of buffer."
(interactive "P")
(let ((old-text (and delete-selection-save-to-register
(get-register delete-selection-save-to-register)))
@@ -297,7 +300,7 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer."
(interactive)
(if (and delete-selection-mode (region-active-p))
(setq deactivate-mark t)
- (abort-recursive-edit)))
+ (abort-minibuffers)))
(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 85017de5d5e..f5e467d37e7 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -50,7 +50,7 @@
(when (string-match-p "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
- (if (and (not (string-match-p "\n" pp))
+ (if (and (not (string-search "\n" pp))
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
diff --git a/lisp/desktop.el b/lisp/desktop.el
index fb7c6c79a1a..3b257132163 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -706,8 +706,9 @@ if different)."
"\\)\\'")))
(dolist (buffer (buffer-list))
(let ((bufname (buffer-name buffer)))
- (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
- (string-match-p preserve-regexp bufname))
+ (unless (or (null bufname)
+ (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
+ (string-match-p preserve-regexp bufname))
(kill-buffer buffer)))))
(delete-other-windows)
(when (and desktop-restore-frames
@@ -731,7 +732,7 @@ if different)."
;; ----------------------------------------------------------------------------
(unless noninteractive
- (add-hook 'kill-emacs-hook #'desktop-kill))
+ (add-hook 'kill-emacs-query-functions #'desktop-kill))
(defun desktop-kill ()
"If `desktop-save-mode' is non-nil, do what `desktop-save' says to do.
@@ -759,7 +760,11 @@ is nil, ask the user where to save the desktop."
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
(signal (car err) (cdr err))))))
;; If we own it, we don't anymore.
- (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)))
+ (when (eq (emacs-pid) (desktop-owner))
+ ;; Allow exiting Emacs even if we can't delete the desktop file.
+ (ignore-error 'file-error
+ (desktop-release-lock)))
+ t)
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
diff --git a/lisp/dframe.el b/lisp/dframe.el
index e61d2ea0581..1ddf11a8aac 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -1,4 +1,4 @@
-;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*-
+;;; dframe.el --- dedicate frame support modes -*- lexical-binding:t -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -828,7 +828,7 @@ the mode-line."
(defvar dframe-version "1.3"
"The current version of the dedicated frame library.")
-(make-obsolete-variable 'dframe-version nil "28.1")
+(make-obsolete-variable 'dframe-version 'emacs-version "28.1")
(provide 'dframe)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index a94bdf5b42e..0b8c693b29f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -33,6 +33,7 @@
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Finished up by rms in 1992.
+
;;; Code:
(require 'cl-lib)
@@ -45,9 +46,8 @@
Functions that operate recursively can store additional names
into this list; they also should call `dired-log' to log the errors.")
-;;; 15K
-;;;###begin dired-cmd.el
-;; Diffing and compressing
+
+;;; Diffing and compressing
(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
@@ -135,7 +135,7 @@ substituted, and will be passed through normally to the shell.
%s
-(Press ^ to %s markers below these occurrences.)
+\(Press ^ to %s markers below these occurrences.)
"
"`"
(string (aref command (car char-positions)))
@@ -288,12 +288,12 @@ If this file is a backup, diff it with its original.
The backup file is the first file given to `diff'.
With prefix arg, prompt for argument SWITCHES which is options for `diff'."
(interactive
- (if current-prefix-arg
- (list (read-string "Options for diff: "
- (if (stringp diff-switches)
- diff-switches
- (mapconcat #'identity diff-switches " "))))
- nil))
+ (if current-prefix-arg
+ (list (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat #'identity diff-switches " "))))
+ nil))
(diff-backup (dired-get-filename) switches))
;;;###autoload
@@ -418,6 +418,7 @@ List has a form of (file-name full-file-name (attribute-list))."
full-file-name
(file-attributes full-file-name))))
(directory-files dir)))
+
;;; Change file attributes
@@ -507,7 +508,7 @@ has no effect on MS-Windows."
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
- (replace-regexp-in-string
+ (string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
@@ -636,7 +637,7 @@ Uses the shell command coming from variables `lpr-command' and
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(defun dired-mark-read-string (prompt initial op-symbol arg files
- &optional default-value collection)
+ &optional default-value collection)
"Read args for a Dired marked-files command, prompting with PROMPT.
Return the user input (a string).
@@ -655,8 +656,9 @@ passed as the second arg to `completing-read'."
'completing-read
(format prompt (dired-mark-prompt arg files))
collection nil nil initial nil default-value nil))
+
-;;; Cleaning a directory: flagging some backups for deletion.
+;;; Cleaning a directory: flagging some backups for deletion
(defvar dired-file-version-alist)
@@ -699,7 +701,8 @@ with a prefix argument."
(dired-map-dired-file-lines #'dired-trample-file-versions)
(message "Cleaning numerical backups...done")))
-;;; Subroutines of dired-clean-directory.
+
+;;; Subroutines of dired-clean-directory
(defun dired-map-dired-file-lines (fun)
;; Perform FUN with point at the end of each non-directory line.
@@ -750,6 +753,7 @@ with a prefix argument."
(progn (beginning-of-line)
(delete-char 1)
(insert dired-del-marker)))))
+
;;; Shell commands
@@ -871,8 +875,8 @@ can be produced by `dired-get-marked-files', for example.
`dired-guess-shell-alist-default' and
`dired-guess-shell-alist-user' are consulted when the user is
prompted for the shell command to use interactively."
-;;Functions dired-run-shell-command and dired-shell-stuff-it do the
-;;actual work and can be redefined for customization.
+ ;; Functions dired-run-shell-command and dired-shell-stuff-it do the
+ ;; actual work and can be redefined for customization.
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
@@ -914,13 +918,13 @@ prompted for the shell command to use interactively."
"Separates marked files in dired shell commands.")
(defun dired-shell-stuff-it (command file-list on-each &optional _raw-arg)
-;; "Make up a shell command line from COMMAND and FILE-LIST.
-;; If ON-EACH is t, COMMAND should be applied to each file, else
-;; simply concat all files and apply COMMAND to this.
-;; FILE-LIST's elements will be quoted for the shell."
-;; Might be redefined for smarter things and could then use RAW-ARG
-;; (coming from interactive P and currently ignored) to decide what to do.
-;; Smart would be a way to access basename or extension of file names.
+ ;; "Make up a shell command line from COMMAND and FILE-LIST.
+ ;; If ON-EACH is t, COMMAND should be applied to each file, else
+ ;; simply concat all files and apply COMMAND to this.
+ ;; FILE-LIST's elements will be quoted for the shell."
+ ;; Might be redefined for smarter things and could then use RAW-ARG
+ ;; (coming from interactive P and currently ignored) to decide what to do.
+ ;; Smart would be a way to access basename or extension of file names.
(let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
(command (if in-background
(substring command 0 (match-beginning 0))
@@ -986,8 +990,8 @@ prompted for the shell command to use interactively."
(shell-command command)))
;; Return nil for sake of nconc in dired-bunch-files.
nil)
-
+
(defun dired-check-process (msg program &rest arguments)
"Display MSG while running PROGRAM, and check for output.
Remaining arguments are strings passed as command arguments to PROGRAM.
@@ -1032,8 +1036,9 @@ Return the result of `process-file' - zero for success."
(unless (zerop res)
(pop-to-buffer out-buffer))
res))))
+
-;; Commands that delete or redisplay part of the dired buffer.
+;;; Commands that delete or redisplay part of the dired buffer
(defun dired-kill-line (&optional arg)
"Kill the current line (not the files).
@@ -1072,8 +1077,13 @@ To kill an entire subdirectory \(without killing its line in the
parent directory), go to its directory header line and use this
command with a prefix argument (the value does not matter).
-To undo the killing, the undo command can be used as normally."
- ;; Returns count of killed lines. FMT="" suppresses message.
+To undo the killing, the undo command can be used as normally.
+
+This function returns the number of killed lines.
+
+FMT is a format string used for messaging the user about the
+killed lines, and defaults to \"Killed %d line%s.\" if not
+present. A FMT of \"\" will suppress the messaging."
(interactive "P")
(if arg
(if (dired-get-subdir)
@@ -1093,10 +1103,8 @@ To undo the killing, the undo command can be used as normally."
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
count))))
-;;;###end dired-cmd.el
-;;; 30K
-;;;###begin dired-cp.el
+;;; Compression
(defun dired-compress ()
;; Compress or uncompress the current file.
@@ -1127,6 +1135,7 @@ To undo the killing, the undo command can be used as normally."
;; Solaris 10 version of tar (obsolete in 2024?).
;; Same thing on AIX 7.1 (obsolete 2023?) and 7.2 (obsolete 2022?).
("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
+ ("\\.tar\\.xz\\'" "" "xz -dc %i | tar -xf -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
("\\.gz\\'" "" "gunzip")
("\\.lz\\'" "" "lzip -d")
@@ -1144,10 +1153,7 @@ To undo the killing, the undo command can be used as normally."
("\\.zst\\'" "" "unzstd --rm")
("\\.7z\\'" "" "7z x -aoa -o%o %i")
;; This item controls naming for compression.
- ("\\.tar\\'" ".tgz" nil)
- ;; This item controls the compression of directories. Its REGEXP
- ;; element should never match any valid file name.
- ("\000" ".tar.gz" "tar -cf - %i | gzip -c9 > %o"))
+ ("\\.tar\\'" ".tgz" nil))
"Control changes in file name suffixes for compression and uncompression.
Each element specifies one transformation rule, and has the form:
(REGEXP NEW-SUFFIX PROGRAM)
@@ -1163,6 +1169,34 @@ output file.
Otherwise, the rule is a compression rule, and compression is done with gzip.
ARGS are command switches passed to PROGRAM.")
+(defcustom dired-compress-file-default-suffix nil
+ "Default suffix for compressing a single file.
+If nil, \".gz\" will be used."
+ :type '(choice (const :tag ".gz" nil) string)
+ :group 'dired
+ :version "28.1")
+
+(defvar dired-compress-file-alist
+ '(("\\.gz\\'" . "gzip -9f %i")
+ ("\\.bz2\\'" . "bzip2 -9f %i")
+ ("\\.xz\\'" . "xz -9f %i")
+ ("\\.zst\\'" . "zstd -qf -19 --rm -o %o %i"))
+ "Controls 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 is the
+corresponding command.
+
+Within CMD, %i denotes the input file(s), and %o denotes the
+output file. %i path(s) are relative, while %o is absolute.")
+
+(defcustom dired-compress-directory-default-suffix nil
+ "Default suffix for compressing a directory.
+If nil, \".tar.gz\" will be used."
+ :type '(choice (const :tag ".tar.gz" nil) string)
+ :group 'dired
+ :version "28.1")
+
(defvar dired-compress-files-alist
'(("\\.tar\\.gz\\'" . "tar -cf - %i | gzip -c9 > %o")
("\\.tar\\.bz2\\'" . "tar -cf - %i | bzip2 -c9 > %o")
@@ -1172,7 +1206,7 @@ ARGS are command switches passed to PROGRAM.")
("\\.tar\\.lzo\\'" . "tar -cf - %i | lzop -c9 > %o")
("\\.zip\\'" . "zip %o -r --filesync %i")
("\\.pax\\'" . "pax -wf %o %i"))
- "Control the compression shell command for `dired-do-compress-to'.
+ "Controls 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 is the
@@ -1254,7 +1288,7 @@ Return nil if no change in files."
nil t)
nil t)))
;; We found an uncompression rule.
- (let ((match (string-match " " command))
+ (let ((match (string-search " " command))
(msg (concat "Uncompressing " file)))
(unless (if match
(dired-check-process msg
@@ -1270,37 +1304,62 @@ Return nil if no change in files."
;; Try gzip; if we don't have that, use compress.
(condition-case nil
(if (file-directory-p file)
- (progn
- (setq suffix (cdr (assoc "\000" dired-compress-file-suffixes)))
- (when suffix
- (let ((out-name (concat file (car suffix)))
- (default-directory (file-name-directory file)))
- (dired-shell-command
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-name)
+ (let* ((suffix
+ (or dired-compress-directory-default-suffix
+ ".tar.gz"))
+ (rule (cl-find-if
+ (lambda (x) (string-match-p (car x) suffix))
+ dired-compress-files-alist)))
+ (if rule
+ (let ((out-name (concat file suffix))
+ (default-directory (file-name-directory file)))
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-name)
+ (replace-regexp-in-string
+ "%i" (shell-quote-argument
+ (file-name-nondirectory file))
+ (cdr rule)
+ nil t)
+ nil t))
+ out-name)
+ (user-error
+ "No compression rule found for \
+`dired-compress-directory-default-suffix' %s, see `dired-compress-files-alist' for\
+ the supported suffixes list."
+ dired-compress-directory-default-suffix)))
+ (let* ((suffix (or dired-compress-file-default-suffix ".gz"))
+ (out-name (concat file suffix))
+ (rule (cl-find-if
+ (lambda (x) (string-match-p (car x) suffix))
+ dired-compress-file-alist)))
+ (if (not rule)
+ (user-error "No compression rule found for suffix %s, \
+see `dired-compress-file-alist' for the supported suffixes list."
+ dired-compress-file-default-suffix)
+ (and (file-exists-p file)
+ (or (not (file-exists-p out-name))
+ (y-or-n-p
+ (format
+ "File %s already exists. Really compress? "
+ out-name)))
+ (dired-shell-command
(replace-regexp-in-string
- "%i" (shell-quote-argument (file-name-nondirectory file))
- (cadr suffix)
- nil t)
- nil t))
- out-name)))
- (let ((out-name (concat file ".gz")))
- (and (or (not (file-exists-p out-name))
- (y-or-n-p
- (format "File %s already exists. Really compress? "
- out-name)))
- (not
- (dired-check-process (concat "Compressing " file)
- "gzip" "-f" file))
- (or (file-exists-p out-name)
- (setq out-name (concat file ".z")))
- ;; Rename the compressed file to NEWNAME
- ;; if it hasn't got that name already.
- (if (and newname (not (equal newname out-name)))
- (progn
- (rename-file out-name newname t)
- newname)
- out-name))))
+ "%o" (shell-quote-argument out-name)
+ (replace-regexp-in-string
+ "%i" (shell-quote-argument file)
+ (cdr rule)
+ nil t)
+ nil t))
+ (or (file-exists-p out-name)
+ (setq out-name (concat file ".z")))
+ ;; Rename the compressed file to NEWNAME
+ ;; if it hasn't got that name already.
+ (if (and newname (not (equal newname out-name)))
+ (progn
+ (rename-file out-name newname t)
+ newname)
+ out-name)))))
(file-error
(if (not (dired-check-process (concat "Compressing " file)
"compress" "-f" file))
@@ -1326,19 +1385,19 @@ Return nil if no change in files."
(dired-mark-prompt arg files) "? ")))))
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
-; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
-; and display failures.
+ ;; "Map FUN over marked files (with second ARG like in dired-map-over-marks)
+ ;; and display failures.
-; FUN takes zero args. It returns non-nil (the offending object, e.g.
-; the short form of the filename) for a failure and probably logs a
-; detailed error explanation using function `dired-log'.
+ ;; FUN takes zero args. It returns non-nil (the offending object, e.g.
+ ;; the short form of the filename) for a failure and probably logs a
+ ;; detailed error explanation using function `dired-log'.
-; OP-SYMBOL is a symbol describing the operation performed (e.g.
-; `compress'). It is used with `dired-mark-pop-up' to prompt the user
-; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
-; `Failed to compress 1 of 2 files - type W to see why ("foo")')
+ ;; OP-SYMBOL is a symbol describing the operation performed (e.g.
+ ;; `compress'). It is used with `dired-mark-pop-up' to prompt the user
+ ;; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
+ ;; `Failed to compress 1 of 2 files - type W to see why ("foo")')
-; SHOW-PROGRESS if non-nil means redisplay dired after each file."
+ ;; SHOW-PROGRESS if non-nil means redisplay dired after each file."
(if (dired-mark-confirm op-symbol arg)
(let* ((total-list;; all of FUN's return values
(dired-map-over-marks (funcall fun) arg show-progress))
@@ -1398,7 +1457,8 @@ uncompress and unpack all the files in the archive."
(interactive "P")
(dired-map-over-marks-check #'dired-compress arg 'compress t))
-;; Commands for Emacs Lisp files - load and byte compile
+
+;;; Commands for Emacs Lisp files - load and byte compile
(defun dired-byte-compile ()
;; Return nil for success, offending file name else.
@@ -1430,7 +1490,7 @@ uncompress and unpack all the files in the archive."
;; Return nil for success, offending file name else.
(let ((file (dired-get-filename)) failure)
(condition-case err
- (load file nil nil t)
+ (load file nil nil t)
(error (setq failure err)))
(if (not failure)
nil
@@ -1490,6 +1550,7 @@ See Info node `(emacs)Subdir switches' for more details."
(interactive)
(setq dired-switches-alist nil)
(revert-buffer))
+
(defun dired-update-file-line (file)
;; Delete the current line, and insert an entry for FILE.
@@ -1644,7 +1705,7 @@ files matching `dired-omit-regexp'."
(forward-line 1)
(while (and (not (eolp)) ; don't cross subdir boundary
(not (dired-move-to-filename)))
- (forward-line 1))
+ (forward-line 1))
(point)))
;;;###autoload
@@ -1678,6 +1739,7 @@ See `dired-delete-file' in case you wish that."
(line-beginning-position 2)))
(setq file (directory-file-name file))
(dired-add-entry file (if (eq ?\s marker) nil marker)))))
+
;;; Copy, move/rename, making hard and symbolic links
@@ -1803,7 +1865,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil."
(while blist
(with-current-buffer (car blist)
(if (and buffer-file-name
- (dired-in-this-tree-p buffer-file-name expanded-from-dir))
+ (file-in-directory-p buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
(to-file (replace-regexp-in-string
(concat "^" (regexp-quote from-dir))
@@ -1822,7 +1884,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil."
(while alist
(setq elt (car alist)
alist (cdr alist))
- (if (dired-in-this-tree-p (car elt) expanded-dir)
+ (if (file-in-directory-p (car elt) expanded-dir)
;; ELT's subdir is affected by the rename
(dired-rename-subdir-2 elt dir to)))
(if (equal dir default-directory)
@@ -1877,7 +1939,9 @@ unless OK-IF-ALREADY-EXISTS is non-nil."
(defvar overwrite-query)
(defvar overwrite-backup-query)
-;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
+
+;;; The basic function for half a dozen variations on cp/mv/ln/ln -s
+
(defun dired-create-files (file-creator operation fn-list name-constructor
&optional marker-char)
"Create one or more new files from a list of existing files FN-LIST.
@@ -1907,6 +1971,9 @@ or with the current marker character if MARKER-CHAR is t."
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list)
+ ;; Position point on the current file -- this is useful if
+ ;; handling a number of files to show where we're working at.
+ (dired-goto-file from)
(setq to (funcall name-constructor from))
(if (equal to from)
(progn
@@ -1957,6 +2024,11 @@ ESC or `q' to not overwrite any of the remaining files,
(file-in-directory-p destname from)
(error "Cannot copy `%s' into its subdirectory `%s'"
from to)))
+ ;; Check, that `dired-do-symlink' does not create symlinks
+ ;; on different hosts.
+ (when (and (eq file-creator 'make-symbolic-link)
+ (not (equal (file-remote-p from) (file-remote-p to))))
+ (error "Cannot symlink `%s' to `%s' on another host" from to))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
@@ -2003,7 +2075,27 @@ ESC or `q' to not overwrite any of the remaining files,
success-count)
operation success-count))))
(dired-move-to-filename))
+
+(defcustom dired-do-revert-buffer nil
+ "Automatically revert Dired buffers after `dired-do' operations.
+This option controls whether to refresh the directory listing in a
+Dired buffer that is the destination of one of these operations:
+`dired-do-copy', `dired-do-rename', `dired-do-symlink', `dired-do-hardlink'.
+If the value is t, always revert the Dired buffer updated in the result
+of these operations.
+If the value is a function, it is called with the destination directory name
+as a single argument, and the buffer is reverted after Dired operations
+if the function returns non-nil."
+ :type '(choice
+ (const :tag "Don't revert" nil)
+ (const :tag "Always revert destination directory" t)
+ (const :tag "Revert only local Dired buffers"
+ (lambda (dir) (not (file-remote-p dir))))
+ (function :tag "Predicate function"))
+ :group 'dired
+ :version "28.1")
+
(defun dired-do-create-files (op-symbol file-creator operation arg
&optional marker-char op1
how-to)
@@ -2099,15 +2191,21 @@ Optional arg HOW-TO determines how to treat the target.
(error "%s: Target directory does not exist: %s" operation target))
;; rename-file bombs when moving directories unless we do this:
(or into-dir (setq target (directory-file-name target)))
- (dired-create-files
- file-creator operation fn-list
- (if into-dir ; target is a directory
- ;; This function uses fluid variable target when called
- ;; inside dired-create-files:
- (lambda (from)
- (expand-file-name (file-name-nondirectory from) target))
- (lambda (_from) target))
- marker-char))))
+ (prog1
+ (dired-create-files
+ file-creator operation fn-list
+ (if into-dir ; target is a directory
+ ;; This function uses fluid variable target when called
+ ;; inside dired-create-files:
+ (lambda (from)
+ (expand-file-name (file-name-nondirectory from) target))
+ (lambda (_from) target))
+ marker-char)
+ (when (or (eq dired-do-revert-buffer t)
+ (and (functionp dired-do-revert-buffer)
+ (funcall dired-do-revert-buffer target)))
+ (dired-fun-in-all-buffers (file-name-directory target) nil
+ #'revert-buffer))))))
;; Read arguments for a marked-files command that wants a file name,
;; perhaps popping up the list of marked files.
@@ -2210,7 +2308,6 @@ Optional arg HOW-TO determines how to treat the target.
dired-dirs)))
-
;; We use this function in `dired-create-directory' and
;; `dired-create-empty-file'; the return value is the new entry
;; in the updated Dired buffer.
@@ -2326,7 +2423,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 #'make-symbolic-link
- "Symlink" arg dired-keep-marker-symlink))
+ "Symlink" arg dired-keep-marker-symlink))
;;;###autoload
(defun dired-do-hardlink (&optional arg)
@@ -2339,7 +2436,7 @@ suggested for the target directory depends on the value of
`dired-dwim-target', which see."
(interactive "P")
(dired-do-create-files 'hardlink #'dired-hardlink
- "Hardlink" arg dired-keep-marker-hardlink))
+ "Hardlink" arg dired-keep-marker-hardlink))
(defun dired-hardlink (file newname &optional ok-if-already-exists)
(dired-handle-overwrite newname)
@@ -2359,14 +2456,14 @@ of `dired-dwim-target', which see."
(interactive "P")
(dired-do-create-files 'move #'dired-rename-file
"Move" arg dired-keep-marker-rename "Rename"))
-;;;###end dired-cp.el
+
-;;; 5K
-;;;###begin dired-re.el
+;;; Operate on files matched by regexp
+
(defvar rename-regexp-query)
(defun dired-do-create-files-regexp
- (file-creator operation arg regexp newname &optional whole-name marker-char)
+ (file-creator operation arg regexp newname &optional whole-name marker-char)
;; Create a new file for each marked file using regexps.
;; FILE-CREATOR and OPERATION as in dired-create-files.
;; ARG as in dired-get-marked-files.
@@ -2483,10 +2580,13 @@ See function `dired-do-rename-regexp' for more info."
#'make-symbolic-link
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
+
+;;; Change case of file names
+
(defvar rename-non-directory-query)
(defun dired-create-files-non-directory
- (file-creator basename-constructor operation arg)
+ (file-creator basename-constructor operation arg)
;; Perform FILE-CREATOR on the non-directory part of marked files
;; using function BASENAME-CONSTRUCTOR, with query for each file.
;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
@@ -2528,10 +2628,8 @@ Type SPC or `y' to %s one file, DEL or `n' to skip to next,
(interactive "P")
(dired-rename-non-directory #'downcase "Rename downcase" arg))
-;;;###end dired-re.el
-;;; 13K
-;;;###begin dired-ins.el
+;;; Insert subdirectory
;;;###autoload
(defun dired-maybe-insert-subdir (dirname &optional
@@ -2618,7 +2716,7 @@ This function takes some pains to conform to `ls -lR' output."
(setq switches (string-replace "R" "" switches))
(dolist (cur-ass dired-subdir-alist)
(let ((cur-dir (car cur-ass)))
- (and (dired-in-this-tree-p cur-dir dirname)
+ (and (file-in-directory-p cur-dir dirname)
(let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
(if cur-cons
(setcdr cur-cons switches)
@@ -2630,7 +2728,7 @@ This function takes some pains to conform to `ls -lR' output."
(defun dired-insert-subdir-validate (dirname &optional switches)
;; Check that it is valid to insert DIRNAME with SWITCHES.
;; Signal an error if invalid (e.g. user typed `i' on `..').
- (or (dired-in-this-tree-p dirname (expand-file-name default-directory))
+ (or (file-in-directory-p dirname (expand-file-name default-directory))
(error "%s: not in this directory tree" dirname))
(let ((real-switches (or switches dired-subdir-switches)))
(when real-switches
@@ -2805,8 +2903,9 @@ is always equal to STRING."
(setq result
(cons (substring str end) result)))
(nreverse result)))
+
-;;; moving by subdirectories
+;;; Moving by subdirectories
;;;###autoload
(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
@@ -2909,8 +3008,9 @@ Lower levels are unaffected."
(if pos
(goto-char pos)
(error "At the bottom"))))
+
-;;; hiding
+;;; Hiding
;;;###autoload
(defun dired-hide-subdir (arg)
@@ -2954,10 +3054,8 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
(dired--hide start end))
(setq pos (cdr subdir))))))) ; prev dir gets current dir
-;;;###end dired-ins.el
-
-;; Search only in file names in the Dired buffer.
+;;; Search only in file names in the Dired buffer
(defcustom dired-isearch-filenames nil
"Non-nil to Isearch in file names only.
@@ -2975,7 +3073,7 @@ a file name. Otherwise, it searches the whole buffer without restrictions."
When on, Isearch skips matches outside file names using the predicate
`dired-isearch-filter-filenames' that matches only at file names.
When off, it uses the original predicate."
- nil nil nil
+ :lighter nil
(if dired-isearch-filenames-mode
(add-function :before-while (local 'isearch-filter-predicate)
#'dired-isearch-filter-filenames
@@ -3027,7 +3125,7 @@ is part of a file name (i.e., has the text property `dired-filename')."
(isearch-forward-regexp nil t))
-;; Functions for searching in tags style among marked files.
+;;; Functions for searching in tags style among marked files
;;;###autoload
(defun dired-do-isearch ()
@@ -3119,10 +3217,12 @@ REGEXP should use constructs supported by your local `grep' command."
files))
(push mark files)))
(nreverse marks))
+ (message "Searching...")
(setq xrefs
(xref-matches-in-files regexp files))
(unless xrefs
(user-error "No matches for: %s" regexp))
+ (message "Searching...done")
xrefs))))
(xref--show-xrefs fetcher nil)))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 5a52eccbbe3..380e47786fc 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -44,7 +44,8 @@
;; but maybe not if a dired-x function is being autoloaded.
(require 'dired)
-;;; User-defined variables.
+
+;;; User-defined variables
(defgroup dired-x nil
"Extended directory editing (dired-x)."
@@ -217,7 +218,9 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
:type 'boolean
:group 'dired-x)
-;;; KEY BINDINGS.
+
+;;; Key bindings
+
(when (keymapp (lookup-key dired-mode-map "*"))
(define-key dired-mode-map "*(" 'dired-mark-sexp)
(define-key dired-mode-map "*O" 'dired-mark-omitted)
@@ -234,9 +237,8 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
(define-key dired-mode-map "Y" 'dired-do-relsymlink)
(define-key dired-mode-map "V" 'dired-do-run-mail)
-;;; MENU BINDINGS
-
-(require 'easymenu)
+
+;;; Menu bindings
(when-let ((menu (lookup-key dired-mode-map [menu-bar])))
(easy-menu-add-item menu '("Operate")
@@ -276,7 +278,7 @@ files"]
"Refresh"))
-;; Install into appropriate hooks.
+;;; Install into appropriate hooks
(add-hook 'dired-mode-hook 'dired-extra-startup)
(add-hook 'dired-after-readin-hook 'dired-omit-expunge)
@@ -305,7 +307,7 @@ See also the functions:
(dired-omit-startup))
-;;; EXTENSION MARKING FUNCTIONS.
+;;; Extension marking functions
(defun dired--mark-suffix-interactive-spec ()
(let* ((default
@@ -434,7 +436,7 @@ See variables `dired-texinfo-unclean-extensions',
(list ".dvi"))))
-;;; OMITTING.
+;;; Omitting
;; Enhanced omitting of lines from directory listings.
;; Marked files are never omitted.
@@ -447,7 +449,7 @@ If it is `no-dir', omitting is much faster, but you can only match
against the non-directory part of the file name. Set it to nil if you
need to match the entire file name.")
-;; \017=^O for Omit - other packages can chose other control characters.
+;; \017=^O for Omit - other packages can choose other control characters.
(defvar dired-omit-marker-char ?\017
"Temporary marker used by Dired-Omit.
Should never be used as marker by the user or other packages.")
@@ -572,13 +574,13 @@ files in the active region if `dired-mark-region' is non-nil."
msg)))
-;;; VIRTUAL DIRED MODE.
+;;; Virtual dired mode
;; For browsing `ls -lR' listings in a dired-like fashion.
(defalias 'virtual-dired 'dired-virtual)
(defun dired-virtual (dirname &optional switches)
- "Put this buffer into Virtual Dired mode.
+ "Put this Dired buffer into Virtual Dired mode.
In Virtual Dired mode, all commands that do not actually consult the
filesystem will work.
@@ -610,7 +612,8 @@ you can relist single subdirs using \\[dired-do-redisplay]."
;; hand if you want them.
(interactive
- (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir))))
+ (list (read-directory-name "Virtual Dired directory: "
+ nil (dired-virtual-guess-dir))))
(goto-char (point-min))
(or (looking-at-p " ")
;; if not already indented, do it now:
@@ -624,7 +627,7 @@ you can relist single subdirs using \\[dired-do-redisplay]."
(and (looking-at "^ wildcard ")
(buffer-substring (match-end 0)
(line-end-position))))))
- (if wildcard
+ (if wildcard
(setq dirname (expand-file-name wildcard default-directory))))
;; If raw ls listing (not a saved old dired buffer), give it a
;; decent subdir headerline:
@@ -694,7 +697,7 @@ Also useful for `auto-mode-alist' like this:
(dired-virtual (dired-virtual-guess-dir)))
-;;; SMART SHELL.
+;;; Smart shell
;; An Emacs buffer can have but one working directory, stored in the
;; buffer-local variable `default-directory'. A Dired buffer may have
@@ -721,30 +724,30 @@ Also useful for `auto-mode-alist' like this:
(shell-command command output-buffer error-buffer)))
-;;; GUESS SHELL COMMAND.
+;;; Guess shell command
;; Brief Description:
-;;;
+;;
;; * `dired-do-shell-command' is bound to `!' by dired.el.
-;;;
+;;
;; * `dired-guess-shell-command' provides smarter defaults for
-;;; dired-aux.el's `dired-read-shell-command'.
-;;;
+;; dired-aux.el's `dired-read-shell-command'.
+;;
;; * `dired-guess-shell-command' calls `dired-guess-default' with list of
-;;; marked files.
-;;;
+;; marked files.
+;;
;; * Parse `dired-guess-shell-alist-user' and
-;;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP
-;;; that matches the first file in the file list.
-;;;
+;; `dired-guess-shell-alist-default' (in that order) for the first REGEXP
+;; that matches the first file in the file list.
+;;
;; * If the REGEXP matches all the entries of the file list then evaluate
-;;; COMMAND, which is either a string or a Lisp expression returning a
-;;; string. COMMAND may be a list of commands.
-;;;
+;; COMMAND, which is either a string or a Lisp expression returning a
+;; string. COMMAND may be a list of commands.
+;;
;; * Return this command to `dired-guess-shell-command' which prompts user
-;;; with it. The list of commands is put into the list of default values.
-;;; If a command is used successfully then it is stored permanently in
-;;; `dired-shell-command-history'.
+;; with it. The list of commands is put into the list of default values.
+;; If a command is used successfully then it is stored permanently in
+;; `dired-shell-command-history'.
;; Guess what shell command to apply to a file.
(defvar dired-shell-command-history nil
@@ -942,10 +945,15 @@ Each element of this list looks like
(REGEXP COMMAND...)
-where each COMMAND can either be a string or a Lisp expression that evaluates
+COMMAND will be used if REGEXP matches the file to be processed.
+If several files are to be processed, REGEXP has to match all the
+files.
+
+Each COMMAND can either be a string or a Lisp expression that evaluates
to a string. If this expression needs to consult the name of the file for
which the shell commands are being requested, it can access that file name
as the variable `file'.
+
If several COMMANDs are given, the first one will be the default
and the rest will be added temporarily to the history and can be retrieved
with \\[previous-history-element] (M-p) .
@@ -964,38 +972,26 @@ REGEXP is matched case-sensitively."
(defun dired-guess-default (files)
"Return a shell command, or a list of commands, appropriate for FILES.
See `dired-guess-shell-alist-user'."
-
(let* ((case-fold-search dired-guess-shell-case-fold-search)
- ;; Prepend the user's alist to the default alist.
- (alist (append dired-guess-shell-alist-user
- dired-guess-shell-alist-default))
- (file (car files))
- (flist (cdr files))
- elt regexp cmds)
-
- ;; Find the first match in the alist for first file in FILES.
- (while alist
- (setq elt (car alist)
- regexp (car elt)
- alist (cdr alist))
- (if (string-match-p regexp file)
- (setq cmds (cdr elt)
- alist nil)))
-
- ;; If more than one file, see if all of FILES match regular expression.
- (while (and flist
- (string-match-p regexp (car flist)))
- (setq flist (cdr flist)))
-
- ;; If flist is still non-nil, then do not guess since this means that not
- ;; all the files in FILES were matched by the regexp.
- (setq cmds (and (not flist) cmds))
-
- ;; Return commands or nil if flist is still non-nil.
- ;; Evaluate the commands in order that any logical testing will be done.
- (if (cdr cmds)
- (delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds))
- (eval (car cmds) `((file . ,file)))))) ; single command
+ (programs
+ (delete-dups
+ (mapcar
+ (lambda (command)
+ (eval command `((file . ,(car files)))))
+ (seq-reduce
+ #'append
+ (mapcar #'cdr
+ (seq-filter (lambda (elem)
+ (seq-every-p
+ (lambda (file)
+ (string-match-p (car elem) file))
+ files))
+ (append dired-guess-shell-alist-user
+ dired-guess-shell-alist-default)))
+ nil)))))
+ (if (length= programs 1)
+ (car programs)
+ programs)))
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."
@@ -1024,7 +1020,7 @@ See `dired-guess-shell-alist-user'."
(if (equal val "") default val))))
-;;; RELATIVE SYMBOLIC LINKS.
+;;; Relative symbolic links
(declare-function make-symbolic-link "fileio.c")
@@ -1048,11 +1044,11 @@ results in
len2 (length file2))
;; Find common initial file name components:
(let (next)
- (while (and (setq next (string-match "/" file1 index))
+ (while (and (setq next (string-search "/" file1 index))
(< (setq next (1+ next)) (min len1 len2))
;; For the comparison, both substrings must end in
;; `/', so NEXT is *one plus* the result of the
- ;; string-match.
+ ;; string-search.
;; E.g., consider the case of linking "/tmp/a/abc"
;; to "/tmp/abc" erroneously giving "/tmp/a" instead
;; of "/tmp/" as common initial component
@@ -1070,7 +1066,7 @@ results in
(start 0)
(count 0))
;; Count number of slashes we must compensate for ...
- (while (setq start (string-match "/" tem start))
+ (while (setq start (string-search "/" tem start))
(setq count (1+ count)
start (1+ start)))
;; ... and prepend a "../" for each slash found:
@@ -1085,7 +1081,7 @@ results in
;;;###autoload
(defun dired-do-relsymlink (&optional arg)
- "Relative symlink all marked (or next ARG) files into a directory.
+ "Relative symlink all marked (or next ARG) files into a directory.
Otherwise make a relative symbolic link to the current file.
This creates relative symbolic links like
@@ -1098,7 +1094,7 @@ not absolute ones like
For absolute symlinks, use \\[dired-do-symlink]."
(interactive "P")
(dired-do-create-files 'relsymlink #'dired-make-relative-symlink
- "RelSymLink" arg dired-keep-marker-relsymlink))
+ "RelSymLink" arg dired-keep-marker-relsymlink))
(autoload 'dired-mark-read-regexp "dired-aux")
(autoload 'dired-do-create-files-regexp "dired-aux")
@@ -1113,30 +1109,30 @@ for more info."
"RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink))
-;;; VISIT ALL MARKED FILES SIMULTANEOUSLY.
+;;; Visit all marked files simultaneously
;; Brief Description:
-;;;
+;;
;; `dired-do-find-marked-files' is bound to `F' by dired-x.el.
-;;;
+;;
;; * Use `dired-get-marked-files' to collect the marked files in the current
-;;; Dired Buffer into a list of filenames `FILE-LIST'.
-;;;
+;; Dired Buffer into a list of filenames `FILE-LIST'.
+;;
;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with
-;;; `dired-do-find-marked-files''s prefix argument NOSELECT.
-;;;
+;; `dired-do-find-marked-files''s prefix argument NOSELECT.
+;;
;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the
-;;; list each time.
-;;;
+;; list each time.
+;;
;; * If NOSELECT is non-nil then just run `find-file-noselect' on each
-;;; element of FILE-LIST.
-;;;
+;; element of FILE-LIST.
+;;
;; * If NOSELECT is nil then calculate the `size' of the window for each file
-;;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is
-;;; cognizant of the window-configuration.
-;;;
+;; by dividing the `window-height' by length of FILE-LIST. Thus, `size' is
+;; cognizant of the window-configuration.
+;;
;; * If `size' is too small abort, otherwise run `find-file' on each element
-;;; of FILE-LIST giving each a window of height `size'.
+;; of FILE-LIST giving each a window of height `size'.
(defun dired-do-find-marked-files (&optional noselect)
"Find all marked files displaying all of them simultaneously.
@@ -1182,7 +1178,7 @@ NOSELECT the files are merely found but not selected."
(find-file file)))))
-;;; MISCELLANEOUS COMMANDS.
+;;; Miscellaneous commands
;; Run man on files.
@@ -1192,12 +1188,12 @@ NOSELECT the files are merely found but not selected."
(defun dired-man ()
"Run `man' on this file."
-;; Used also to say: "Display old buffer if buffer name matches filename."
-;; but I have no idea what that means.
+ ;; Used also to say: "Display old buffer if buffer name matches filename."
+ ;; but I have no idea what that means.
(interactive)
(require 'man)
(let* ((file (dired-get-filename))
- (manual-program (replace-regexp-in-string "\\*" "%s"
+ (manual-program (string-replace "*" "%s"
(dired-guess-shell-command
"Man command: " (list file)))))
(Man-getpage-in-background file)))
@@ -1250,7 +1246,7 @@ otherwise."
(dired-rmail)))))
-;;; MISCELLANEOUS INTERNAL FUNCTIONS.
+;;; Miscellaneous internal functions
;; This should be a builtin
(defun dired-buffer-more-recently-used-p (buffer1 buffer2)
@@ -1260,7 +1256,6 @@ Considers buffers closer to the car of `buffer-list' to be more recent."
(memq buffer1 (buffer-list))
(not (memq buffer1 (memq buffer2 (buffer-list))))))
-
;; Needed if ls -lh is supported and also for GNU ls -ls.
(defun dired-x--string-to-number (str)
"Like `string-to-number' but recognize a trailing unit prefix.
@@ -1433,7 +1428,7 @@ only in the active region if `dired-mark-region' is non-nil."
(format "'%s file" predicate))))
-;;; FIND FILE AT POINT.
+;;; Find file at point
(defcustom dired-x-hands-off-my-keys t
"Non-nil means don't remap `find-file' to `dired-x-find-file'.
@@ -1480,7 +1475,8 @@ a prefix argument, when it offers the filename near point as a default."
(interactive (list (dired-x-read-filename-at-point "Find file: ")))
(find-file-other-window filename))
-;;; Internal functions.
+
+;;; Internal functions
;; Fixme: This should probably use `thing-at-point'. -- fx
(define-obsolete-function-alias 'dired-filename-at-point
@@ -1528,8 +1524,9 @@ If `current-prefix-arg' is non-nil, uses name at point as guess."
(define-obsolete-function-alias 'read-filename-at-point
'dired-x-read-filename-at-point "24.1") ; is this even needed?
+
-;;; BUG REPORTS
+;;; Epilog
(define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1")
diff --git a/lisp/dired.el b/lisp/dired.el
index 553fb64da05..0add0ab3887 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -41,6 +41,7 @@
(declare-function dired-buffer-more-recently-used-p
"dired-x" (buffer1 buffer2))
+
;;; Customizable variables
(defgroup dired nil
@@ -53,17 +54,21 @@
:prefix "dired-"
:group 'dired)
-
;;;###autoload
(defcustom dired-listing-switches (purecopy "-al")
"Switches passed to `ls' for Dired. MUST contain the `l' option.
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.
+
+If you have files with names with embedded newline characters, adding
+`b' to the switches will allow Dired to handle those files better.
+
Options that include embedded whitespace must be quoted
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,
some of the `ls' switches are not supported; see the doc string of
`insert-directory' in `ls-lisp.el' for more details."
@@ -73,9 +78,9 @@ some of the `ls' switches are not supported; see the doc string of
(defcustom dired-subdir-switches nil
"If non-nil, switches passed to `ls' for inserting subdirectories.
If nil, `dired-listing-switches' is used."
- :group 'dired
- :type '(choice (const :tag "Use dired-listing-switches" nil)
- (string :tag "Switches")))
+ :group 'dired
+ :type '(choice (const :tag "Use dired-listing-switches" nil)
+ (string :tag "Switches")))
(defcustom dired-maybe-use-globstar nil
"If non-nil, enable globstar if the shell supports it.
@@ -139,8 +144,8 @@ For more details, see Info node `(emacs)ls in Lisp'."
(defcustom dired-touch-program "touch"
"Name of touch command (usually `touch')."
- :group 'dired
- :type 'file)
+ :group 'dired
+ :type 'file)
(defcustom dired-ls-F-marks-symlinks nil
"Informs Dired about how `ls -lF' marks symbolic links.
@@ -158,7 +163,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."
@@ -215,7 +220,7 @@ or the most recently used window with a Dired buffer, or to use any other
function. When the value is a function, it will be called with no
arguments and is expected to return a list of directories which will
be used as defaults (i.e. default target and \"future history\")
-(though, `dired-dwim-target-defaults' might modify it a bit).
+\(though, `dired-dwim-target-defaults' might modify it a bit).
The value t prefers the next windows on the same frame.
The target is used in the prompt for file copy, rename etc."
@@ -242,16 +247,14 @@ The target is used in the prompt for file copy, rename etc."
This is similar to the \"-L\" option for the \"cp\" shell command."
:type 'boolean
:group 'dired)
- ;
-; These variables were deleted and the replacements are on files.el.
-; We leave aliases behind for back-compatibility.
+
+;; These variables were deleted and the replacements are on files.el.
+;; We leave aliases behind for back-compatibility.
(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
-
(defcustom dired-load-hook nil
"Run after loading Dired.
You can customize key bindings or load extensions with this."
@@ -353,7 +356,13 @@ is anywhere on its Dired line, except the beginning of the line."
:group 'dired
:version "28.1")
-;; Internal variables
+(defcustom dired-kill-when-opening-new-dired-buffer nil
+ "If non-nil, kill the current buffer when selecting a new directory."
+ :type 'boolean
+ :version "28.1")
+
+
+;;; Internal variables
(defvar dired-marker-char ?* ; the answer is 42
;; so that you can write things like
@@ -371,8 +380,8 @@ This is what the do-commands look for, and what the mark-commands store.")
"Character used to flag files for deletion.")
(defvar dired-shrink-to-fit t
-;; I see no reason ever to make this nil -- rms.
-;; (> baud-rate search-slow-speed)
+ ;; I see no reason ever to make this nil -- rms.
+ ;; (> baud-rate search-slow-speed)
"Non-nil means Dired shrinks the display buffer to fit the marked files.")
(make-obsolete-variable 'dired-shrink-to-fit
"use the Customization interface to add a new rule
@@ -420,7 +429,7 @@ The directory name must be absolute, but need not be fully expanded.")
"[bcsp][^:]"))
(defvar dired-re-exe;; match ls permission string of an executable file
(mapconcat (lambda (x)
- (concat dired-re-maybe-mark dired-re-inode-size 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]")
@@ -453,6 +462,9 @@ The match starts at the beginning of the line and ends after the end
of the line.
Subexpression 2 must end right before the \\n.")
+
+;;; Faces
+
(defgroup dired-faces nil
"Faces used by Dired."
:group 'dired
@@ -556,6 +568,9 @@ Subexpression 2 must end right before the \\n.")
(defvar dired-ignored-face 'dired-ignored
"Face name used for files suffixed with `completion-ignored-extensions'.")
+
+;;; Font-lock
+
(defvar dired-font-lock-keywords
(list
;;
@@ -605,6 +620,31 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-dir
'(".+" (dired-move-to-filename) nil (0 dired-directory-face)))
;;
+ ;; Files suffixed with `completion-ignored-extensions'.
+ '(eval .
+ ;; It is quicker to first find just an extension, then go back to the
+ ;; start of that file name. So we do this complex MATCH-ANCHORED form.
+ (list (concat
+ "\\(" (regexp-opt completion-ignored-extensions)
+ "\\|#\\|\\.#.+\\)$")
+ '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
+ ;;
+ ;; Files suffixed with `completion-ignored-extensions'
+ ;; plus a character put in by -F.
+ '(eval .
+ (list (concat "\\(" (regexp-opt completion-ignored-extensions)
+ "\\|#\\|\\.#.+\\)[*=|]$")
+ '(".+" (progn
+ (end-of-line)
+ ;; If the last character is not part of the filename,
+ ;; move back to the start of the filename
+ ;; so it can be fontified.
+ ;; Otherwise, leave point at the end of the line;
+ ;; that way, nothing is fontified.
+ (unless (get-text-property (1- (point)) 'mouse-face)
+ (dired-move-to-filename)))
+ nil (0 dired-ignored-face))))
+ ;;
;; Broken Symbolic link.
(list dired-re-sym
(list (lambda (end)
@@ -649,29 +689,6 @@ Subexpression 2 must end right before the \\n.")
(list dired-re-special
'(".+" (dired-move-to-filename) nil (0 'dired-special)))
;;
- ;; Files suffixed with `completion-ignored-extensions'.
- '(eval .
- ;; It is quicker to first find just an extension, then go back to the
- ;; start of that file name. So we do this complex MATCH-ANCHORED form.
- (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
- '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
- ;;
- ;; Files suffixed with `completion-ignored-extensions'
- ;; plus a character put in by -F.
- '(eval .
- (list (concat "\\(" (regexp-opt completion-ignored-extensions)
- "\\|#\\)[*=|]$")
- '(".+" (progn
- (end-of-line)
- ;; If the last character is not part of the filename,
- ;; move back to the start of the filename
- ;; so it can be fontified.
- ;; Otherwise, leave point at the end of the line;
- ;; that way, nothing is fontified.
- (unless (get-text-property (1- (point)) 'mouse-face)
- (dired-move-to-filename)))
- nil (0 dired-ignored-face))))
- ;;
;; Explicitly put the default face on file names ending in a colon to
;; avoid fontifying them as directory header.
(list (concat dired-re-maybe-mark dired-re-inode-size dired-re-perms ".*:$")
@@ -679,12 +696,15 @@ Subexpression 2 must end right before the \\n.")
;;
;; Directory headers.
(list dired-subdir-regexp '(1 dired-header-face))
-)
+ )
"Additional expressions to highlight in Dired mode.")
(defvar dnd-protocol-alist)
+
-;;; Macros must be defined before they are used, for the byte compiler.
+;;; Macros
+
+;; Macros must be defined before they are used, for the byte compiler.
(defmacro dired-mark-if (predicate msg)
"Mark files for PREDICATE, according to `dired-marker-char'.
@@ -879,7 +899,7 @@ ERROR can be a string with the error message."
(point-max)))
-;; The dired command
+;;; The dired command
(defun dired-read-dir-and-switches (str)
;; For use in interactive.
@@ -1259,7 +1279,7 @@ The return value is the target column for the file names."
found)))
-;; Read in a new dired buffer
+;;; Read in a new dired buffer
(defun dired-readin ()
"Read in a new Dired buffer.
@@ -1567,8 +1587,8 @@ see `dired-use-ls-dired' for more details.")
;; because newlines in dirnames are uncommon, and people may
;; have gotten used to seeing unescaped "\" in the headers.
;; Note: adjust dired-build-subdir-alist if you change this.
- (setq dir (replace-regexp-in-string "\\\\" "\\\\" dir nil t)
- dir (replace-regexp-in-string "\n" "\\n" dir nil t)))
+ (setq dir (string-replace "\\" "\\\\" dir)
+ dir (string-replace "\n" "\\n" dir)))
;; If we used --dired and it worked, the lines are already indented.
;; Otherwise, indent them.
(unless (save-excursion
@@ -1623,8 +1643,9 @@ see `dired-use-ls-dired' for more details.")
(put-text-property (+ (point) 4) (line-end-position)
'invisible 'dired-hide-details-link))))
(forward-line 1))))
+
-;; Reverting a dired buffer
+;;; Reverting a dired buffer
(defun dired-revert (&optional _arg _noconfirm)
"Reread the Dired buffer.
@@ -1811,8 +1832,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(let ((handler (find-file-name-handler dir 'dired-uncache)))
(if handler
(funcall handler 'dired-uncache dir))))
+
-;; dired mode key bindings and initialization
+;;; Dired mode key bindings and menus
(defvar dired-mode-map
;; This looks ugly when substitute-command-keys uses C-d instead d:
@@ -1961,329 +1983,235 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map ":s" 'epa-dired-do-sign)
(define-key map ":e" 'epa-dired-do-encrypt)
- ;; Make menu bar items.
-
;; No need to do this, now that top-level items are fewer.
;;;;
;; Get rid of the Edit menu bar item to save space.
- ;(define-key map [menu-bar edit] 'undefined)
-
- (define-key map [menu-bar subdir]
- (cons "Subdir" (make-sparse-keymap "Subdir")))
-
- (define-key map [menu-bar subdir hide-all]
- '(menu-item "Hide All" dired-hide-all
- :help "Hide all subdirectories, leave only header lines"))
- (define-key map [menu-bar subdir hide-subdir]
- '(menu-item "Hide/UnHide Subdir" dired-hide-subdir
- :help "Hide or unhide current directory listing"))
- (define-key map [menu-bar subdir tree-down]
- '(menu-item "Tree Down" dired-tree-down
- :help "Go to first subdirectory header down the tree"))
- (define-key map [menu-bar subdir tree-up]
- '(menu-item "Tree Up" dired-tree-up
- :help "Go to first subdirectory header up the tree"))
- (define-key map [menu-bar subdir up]
- '(menu-item "Up Directory" dired-up-directory
- :help "Edit the parent directory"))
- (define-key map [menu-bar subdir prev-subdir]
- '(menu-item "Prev Subdir" dired-prev-subdir
- :help "Go to previous subdirectory header line"))
- (define-key map [menu-bar subdir next-subdir]
- '(menu-item "Next Subdir" dired-next-subdir
- :help "Go to next subdirectory header line"))
- (define-key map [menu-bar subdir prev-dirline]
- '(menu-item "Prev Dirline" dired-prev-dirline
- :help "Move to next directory-file line"))
- (define-key map [menu-bar subdir next-dirline]
- '(menu-item "Next Dirline" dired-next-dirline
- :help "Move to previous directory-file line"))
- (define-key map [menu-bar subdir insert]
- '(menu-item "Insert This Subdir" dired-maybe-insert-subdir
- :help "Insert contents of subdirectory"
- :enable (let ((f (dired-get-filename nil t)))
- (and f (file-directory-p f)))))
- (define-key map [menu-bar immediate]
- (cons "Immediate" (make-sparse-keymap "Immediate")))
-
- (define-key map
- [menu-bar immediate image-dired-dired-display-external]
- '(menu-item "Display Image Externally" image-dired-dired-display-external
- :help "Display image in external viewer"))
- (define-key map
- [menu-bar immediate image-dired-dired-display-image]
- '(menu-item "Display Image" image-dired-dired-display-image
- :help "Display sized image in a separate window"))
- (define-key map
- [menu-bar immediate image-dired-dired-toggle-marked-thumbs]
- '(menu-item "Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs
- :help "Add or remove image thumbnails in front of marked file names"))
-
- (define-key map [menu-bar immediate hide-details]
- '(menu-item "Hide Details" dired-hide-details-mode
- :help "Hide details in buffer"
- :button (:toggle . dired-hide-details-mode)))
- (define-key map [menu-bar immediate revert-buffer]
- '(menu-item "Refresh" revert-buffer
- :help "Update contents of shown directories"))
- (define-key map [menu-bar immediate dired-number-of-marked-files]
- '(menu-item "#Marked Files" dired-number-of-marked-files
- :help "Display the number and size of the marked files"))
-
- (define-key map [menu-bar immediate dashes]
- '("--"))
-
- (define-key map [menu-bar immediate isearch-filenames-regexp]
- '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp
- :help "Incrementally search for regexp in file names only"))
- (define-key map [menu-bar immediate isearch-filenames]
- '(menu-item "Isearch in File Names..." dired-isearch-filenames
- :help "Incrementally search for string in file names only."))
- (define-key map [menu-bar immediate compare-directories]
- '(menu-item "Compare Directories..." dired-compare-directories
- :help "Mark files with different attributes in two Dired buffers"))
- (define-key map [menu-bar immediate backup-diff]
- '(menu-item "Compare with Backup" dired-backup-diff
- :help "Diff file at cursor with its latest backup"))
- (define-key map [menu-bar immediate diff]
- '(menu-item "Diff..." dired-diff
- :help "Compare file at cursor with another file"))
- (define-key map [menu-bar immediate view]
- '(menu-item "View This File" dired-view-file
- :help "Examine file at cursor in read-only mode"))
- (define-key map [menu-bar immediate display]
- '(menu-item "Display in Other Window" dired-display-file
- :help "Display file at cursor in other window"))
- (define-key map [menu-bar immediate find-file-other-window]
- '(menu-item "Find in Other Window" dired-find-file-other-window
- :help "Edit file at cursor in other window"))
- (define-key map [menu-bar immediate find-file]
- '(menu-item "Find This File" dired-find-file
- :help "Edit file at cursor"))
- (define-key map [menu-bar immediate create-directory]
- '(menu-item "Create Directory..." dired-create-directory
- :help "Create a directory"))
- (define-key map [menu-bar immediate create-empty-file]
- '(menu-item "Create Empty file..." dired-create-empty-file
- :help "Create an empty file"))
- (define-key map [menu-bar immediate wdired-mode]
- '(menu-item "Edit File Names" wdired-change-to-wdired-mode
- :help "Put a Dired buffer in a mode in which filenames are editable"
- :keys "C-x C-q"
- :filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
-
- (define-key map [menu-bar regexp]
- (cons "Regexp" (make-sparse-keymap "Regexp")))
-
- (define-key map
- [menu-bar regexp image-dired-mark-tagged-files]
- '(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files
- :help "Mark files whose image tags matches regexp"))
-
- (define-key map [menu-bar regexp dashes-1]
- '("--"))
-
- (define-key map [menu-bar regexp downcase]
- '(menu-item "Downcase" dired-downcase
- ;; When running on plain MS-DOS, there's only one
- ;; letter-case for file names.
- :enable (or (not (fboundp 'msdos-long-file-names))
- (msdos-long-file-names))
- :help "Rename marked files to lower-case name"))
- (define-key map [menu-bar regexp upcase]
- '(menu-item "Upcase" dired-upcase
- :enable (or (not (fboundp 'msdos-long-file-names))
- (msdos-long-file-names))
- :help "Rename marked files to upper-case name"))
- (define-key map [menu-bar regexp hardlink]
- '(menu-item "Hardlink..." dired-do-hardlink-regexp
- :help "Make hard links for files matching regexp"))
- (define-key map [menu-bar regexp symlink]
- '(menu-item "Symlink..." dired-do-symlink-regexp
- :visible (fboundp 'make-symbolic-link)
- :help "Make symbolic links for files matching regexp"))
- (define-key map [menu-bar regexp rename]
- '(menu-item "Rename..." dired-do-rename-regexp
- :help "Rename marked files matching regexp"))
- (define-key map [menu-bar regexp copy]
- '(menu-item "Copy..." dired-do-copy-regexp
- :help "Copy marked files matching regexp"))
- (define-key map [menu-bar regexp flag]
- '(menu-item "Flag..." dired-flag-files-regexp
- :help "Flag files matching regexp for deletion"))
- (define-key map [menu-bar regexp mark]
- '(menu-item "Mark..." dired-mark-files-regexp
- :help "Mark files matching regexp for future operations"))
- (define-key map [menu-bar regexp mark-cont]
- '(menu-item "Mark Containing..." dired-mark-files-containing-regexp
- :help "Mark files whose contents matches regexp"))
-
- (define-key map [menu-bar mark]
- (cons "Mark" (make-sparse-keymap "Mark")))
-
- (define-key map [menu-bar mark prev]
- '(menu-item "Previous Marked" dired-prev-marked-file
- :help "Move to previous marked file"))
- (define-key map [menu-bar mark next]
- '(menu-item "Next Marked" dired-next-marked-file
- :help "Move to next marked file"))
- (define-key map [menu-bar mark marks]
- '(menu-item "Change Marks..." dired-change-marks
- :help "Replace marker with another character"))
- (define-key map [menu-bar mark unmark-all]
- '(menu-item "Unmark All" dired-unmark-all-marks))
- (define-key map [menu-bar mark symlinks]
- '(menu-item "Mark Symlinks" dired-mark-symlinks
- :visible (fboundp 'make-symbolic-link)
- :help "Mark all symbolic links"))
- (define-key map [menu-bar mark directories]
- '(menu-item "Mark Directories" dired-mark-directories
- :help "Mark all directories except `.' and `..'"))
- (define-key map [menu-bar mark directory]
- '(menu-item "Mark Old Backups" dired-clean-directory
- :help "Flag old numbered backups for deletion"))
- (define-key map [menu-bar mark executables]
- '(menu-item "Mark Executables" dired-mark-executables
- :help "Mark all executable files"))
- (define-key map [menu-bar mark garbage-files]
- '(menu-item "Flag Garbage Files" dired-flag-garbage-files
- :help "Flag unneeded files for deletion"))
- (define-key map [menu-bar mark backup-files]
- '(menu-item "Flag Backup Files" dired-flag-backup-files
- :help "Flag all backup files for deletion"))
- (define-key map [menu-bar mark auto-save-files]
- '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
- :help "Flag auto-save files for deletion"))
- (define-key map [menu-bar mark deletion]
- '(menu-item "Flag" dired-flag-file-deletion
- :help "Flag current line's file for deletion"))
- (define-key map [menu-bar mark unmark]
- '(menu-item "Unmark" dired-unmark
- :help "Unmark or unflag current line's file"))
- (define-key map [menu-bar mark mark]
- '(menu-item "Mark" dired-mark
- :help "Mark current line's file for future operations"))
- (define-key map [menu-bar mark toggle-marks]
- '(menu-item "Toggle Marks" dired-toggle-marks
- :help "Mark unmarked files, unmark marked ones"))
-
- (define-key map [menu-bar operate]
- (cons "Operate" (make-sparse-keymap "Operate")))
-
- (define-key map
- [menu-bar operate image-dired-delete-tag]
- '(menu-item "Delete Image Tag..." image-dired-delete-tag
- :help "Delete image tag from current or marked files"))
- (define-key map
- [menu-bar operate image-dired-tag-files]
- '(menu-item "Add Image Tags..." image-dired-tag-files
- :help "Add image tags to current or marked files"))
- (define-key map
- [menu-bar operate image-dired-dired-comment-files]
- '(menu-item "Add Image Comment..." image-dired-dired-comment-files
- :help "Add image comment to current or marked files"))
- (define-key map
- [menu-bar operate image-dired-display-thumbs]
- '(menu-item "Display Image Thumbnails" image-dired-display-thumbs
- :help "Display image thumbnails for current or marked image files"))
-
- (define-key map [menu-bar operate dashes-4]
- '("--"))
-
- (define-key map
- [menu-bar operate epa-dired-do-decrypt]
- '(menu-item "Decrypt..." epa-dired-do-decrypt
- :help "Decrypt current or marked files"))
-
- (define-key map
- [menu-bar operate epa-dired-do-verify]
- '(menu-item "Verify" epa-dired-do-verify
- :help "Verify digital signature of current or marked files"))
-
- (define-key map
- [menu-bar operate epa-dired-do-sign]
- '(menu-item "Sign..." epa-dired-do-sign
- :help "Create digital signature of current or marked files"))
-
- (define-key map
- [menu-bar operate epa-dired-do-encrypt]
- '(menu-item "Encrypt..." epa-dired-do-encrypt
- :help "Encrypt current or marked files"))
-
- (define-key map [menu-bar operate dashes-3]
- '("--"))
-
- (define-key map [menu-bar operate query-replace]
- '(menu-item "Query Replace in Files..." dired-do-find-regexp-and-replace
- :help "Replace regexp matches in marked files"))
- (define-key map [menu-bar operate search]
- '(menu-item "Search Files..." dired-do-find-regexp
- :help "Search marked files for matches of regexp"))
- (define-key map [menu-bar operate isearch-regexp]
- '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp
- :help "Incrementally search marked files for regexp"))
- (define-key map [menu-bar operate isearch]
- '(menu-item "Isearch Files..." dired-do-isearch
- :help "Incrementally search marked files for string"))
- (define-key map [menu-bar operate chown]
- '(menu-item "Change Owner..." dired-do-chown
- :visible (not (memq system-type '(ms-dos windows-nt)))
- :help "Change the owner of marked files"))
- (define-key map [menu-bar operate chgrp]
- '(menu-item "Change Group..." dired-do-chgrp
- :visible (not (memq system-type '(ms-dos windows-nt)))
- :help "Change the group of marked files"))
- (define-key map [menu-bar operate chmod]
- '(menu-item "Change Mode..." dired-do-chmod
- :help "Change mode (attributes) of marked files"))
- (define-key map [menu-bar operate touch]
- '(menu-item "Change Timestamp..." dired-do-touch
- :help "Change timestamp of marked files"))
- (define-key map [menu-bar operate load]
- '(menu-item "Load" dired-do-load
- :help "Load marked Emacs Lisp files"))
- (define-key map [menu-bar operate compile]
- '(menu-item "Byte-compile" dired-do-byte-compile
- :help "Byte-compile marked Emacs Lisp files"))
- (define-key map [menu-bar operate compress]
- '(menu-item "Compress" dired-do-compress
- :help "Compress/uncompress marked files"))
- (define-key map [menu-bar operate print]
- '(menu-item "Print..." dired-do-print
- :help "Ask for print command and print marked files"))
- (define-key map [menu-bar operate hardlink]
- '(menu-item "Hardlink to..." dired-do-hardlink
- :help "Make hard links for current or marked files"))
- (define-key map [menu-bar operate symlink]
- '(menu-item "Symlink to..." dired-do-symlink
- :visible (fboundp 'make-symbolic-link)
- :help "Make symbolic links for current or marked files"))
- (define-key map [menu-bar operate async-command]
- '(menu-item "Asynchronous Shell Command..." dired-do-async-shell-command
- :help "Run a shell command asynchronously on current or marked files"))
- (define-key map [menu-bar operate command]
- '(menu-item "Shell Command..." dired-do-shell-command
- :help "Run a shell command on current or marked files"))
- (define-key map [menu-bar operate delete]
- `(menu-item "Delete"
- ,(let ((menu (make-sparse-keymap "Delete")))
- (define-key menu [delete-flagged]
- '(menu-item "Delete Flagged Files" dired-do-flagged-delete
- :help "Delete all files flagged for deletion (D)"))
- (define-key menu [delete-marked]
- '(menu-item "Delete Marked (Not Flagged) Files" dired-do-delete
- :help "Delete current file or all marked files (excluding flagged files)"))
- menu)))
- (define-key map [menu-bar operate rename]
- '(menu-item "Rename to..." dired-do-rename
- :help "Rename current file or move marked files"))
- (define-key map [menu-bar operate copy]
- '(menu-item "Copy to..." dired-do-copy
- :help "Copy current file or all marked files"))
+ ;;(define-key map [menu-bar edit] 'undefined)
map)
"Local keymap for Dired mode buffers.")
+
+(easy-menu-define dired-mode-subdir-menu dired-mode-map
+ "Subdir menu for Dired mode."
+ '("Subdir"
+ ["Insert This Subdir" dired-maybe-insert-subdir
+ :help "Insert contents of subdirectory"
+ :enable (let ((f (dired-get-filename nil t)))
+ (and f (file-directory-p f)))]
+ ["Next Dirline" dired-next-dirline
+ :help "Move to previous directory-file line"]
+ ["Prev Dirline" dired-prev-dirline
+ :help "Move to next directory-file line"]
+ ["Next Subdir" dired-next-subdir
+ :help "Go to next subdirectory header line"]
+ ["Prev Subdir" dired-prev-subdir
+ :help "Go to previous subdirectory header line"]
+ ["Up Directory" dired-up-directory
+ :help "Edit the parent directory"]
+ ["Tree Up" dired-tree-up
+ :help "Go to first subdirectory header up the tree"]
+ ["Tree Down" dired-tree-down
+ :help "Go to first subdirectory header down the tree"]
+ ["Hide/UnHide Subdir" dired-hide-subdir
+ :help "Hide or unhide current directory listing"]
+ ["Hide All" dired-hide-all
+ :help "Hide all subdirectories, leave only header lines"]))
+
+(easy-menu-define dired-mode-immediate-menu dired-mode-map
+ "Immediate menu for Dired mode."
+ '("Immediate"
+ ["Edit File Names" wdired-change-to-wdired-mode
+ :help "Put a Dired buffer in a mode in which filenames are editable"
+ :keys "C-x C-q"
+ :filter (lambda (x) (if (eq major-mode 'dired-mode) x))]
+ ["Create Empty file..." dired-create-empty-file
+ :help "Create an empty file"]
+ ["Create Directory..." dired-create-directory
+ :help "Create a directory"]
+ ["Find This File" dired-find-file
+ :help "Edit file at cursor"]
+ ["Find in Other Window" dired-find-file-other-window
+ :help "Edit file at cursor in other window"]
+ ["Display in Other Window" dired-display-file
+ :help "Display file at cursor in other window"]
+ ["View This File" dired-view-file
+ :help "Examine file at cursor in read-only mode"]
+ ["Diff..." dired-diff
+ :help "Compare file at cursor with another file"]
+ ["Compare with Backup" dired-backup-diff
+ :help "Diff file at cursor with its latest backup"]
+ ["Compare Directories..." dired-compare-directories
+ :help "Mark files with different attributes in two Dired buffers"]
+ ["Isearch in File Names..." dired-isearch-filenames
+ :help "Incrementally search for string in file names only."]
+ ["Isearch Regexp in File Names..." dired-isearch-filenames-regexp
+ :help "Incrementally search for regexp in file names only"]
+ "---"
+ ["#Marked Files" dired-number-of-marked-files
+ :help "Display the number and size of the marked files"]
+ ["Refresh" revert-buffer
+ :help "Update contents of shown directories"]
+ ["Hide Details" dired-hide-details-mode
+ :help "Hide details in buffer"
+ :style toggle
+ :selected dired-hide-details-mode]
+ ["Toggle Image Thumbnails in This Buffer" image-dired-dired-toggle-marked-thumbs
+ :help "Add or remove image thumbnails in front of marked file names"]
+ ["Display Image" image-dired-dired-display-image
+ :help "Display sized image in a separate window"]
+ ["Display Image Externally" image-dired-dired-display-external
+ :help "Display image in external viewer"]))
+
+(easy-menu-define dired-mode-regexp-menu dired-mode-map
+ "Regexp menu for Dired mode."
+ '("Regexp"
+ ["Mark Containing..." dired-mark-files-containing-regexp
+ :help "Mark files whose contents matches regexp"]
+ ["Mark..." dired-mark-files-regexp
+ :help "Mark files matching regexp for future operations"]
+ ["Flag..." dired-flag-files-regexp
+ :help "Flag files matching regexp for deletion"]
+ ["Copy..." dired-do-copy-regexp
+ :help "Copy marked files matching regexp"]
+ ["Rename..." dired-do-rename-regexp
+ :help "Rename marked files matching regexp"]
+ ["Symlink..." dired-do-symlink-regexp
+ :visible (fboundp 'make-symbolic-link)
+ :help "Make symbolic links for files matching regexp"]
+ ["Hardlink..." dired-do-hardlink-regexp
+ :help "Make hard links for files matching regexp"]
+ ["Upcase" dired-upcase
+ :enable (or (not (fboundp 'msdos-long-file-names))
+ (msdos-long-file-names))
+ :help "Rename marked files to upper-case name"]
+ ["Downcase" dired-downcase
+ ;; When running on plain MS-DOS, there's only one
+ ;; letter-case for file names.
+ :enable (or (not (fboundp 'msdos-long-file-names))
+ (msdos-long-file-names))
+ :help "Rename marked files to lower-case name"]
+ "---"
+ ["Mark From Image Tag..." image-dired-mark-tagged-files
+ :help "Mark files whose image tags matches regexp"]))
+
+(easy-menu-define dired-mode-mark-menu dired-mode-map
+ "Mark menu for Dired mode."
+ '("Mark"
+ ["Toggle Marks" dired-toggle-marks
+ :help "Mark unmarked files, unmark marked ones"]
+ ["Mark" dired-mark
+ :help "Mark current line's file for future operations"]
+ ["Unmark" dired-unmark
+ :help "Unmark or unflag current line's file"]
+ ["Flag" dired-flag-file-deletion
+ :help "Flag current line's file for deletion"]
+ ["Flag Auto-save Files" dired-flag-auto-save-files
+ :help "Flag auto-save files for deletion"]
+ ["Flag Backup Files" dired-flag-backup-files
+ :help "Flag all backup files for deletion"]
+ ["Flag Garbage Files" dired-flag-garbage-files
+ :help "Flag unneeded files for deletion"]
+ ["Mark Executables" dired-mark-executables
+ :help "Mark all executable files"]
+ ["Mark Old Backups" dired-clean-directory
+ :help "Flag old numbered backups for deletion"]
+ ["Mark Directories" dired-mark-directories
+ :help "Mark all directories except `.' and `..'"]
+ ["Mark Symlinks" dired-mark-symlinks
+ :visible (fboundp 'make-symbolic-link)
+ :help "Mark all symbolic links"]
+ ["Unmark All" dired-unmark-all-marks]
+ ["Change Marks..." dired-change-marks
+ :help "Replace marker with another character"]
+ ["Next Marked" dired-next-marked-file
+ :help "Move to next marked file"]
+ ["Previous Marked" dired-prev-marked-file
+ :help "Move to previous marked file"]))
+
+(easy-menu-define dired-mode-operate-menu dired-mode-map
+ "Operate menu for Dired mode."
+ '("Operate"
+ ["Copy to..." dired-do-copy
+ :help "Copy current file or all marked files"]
+ ["Rename to..." dired-do-rename
+ :help "Rename current file or move marked files"]
+ ("Delete"
+ ["Delete Flagged Files" dired-do-flagged-delete
+ :help "Delete all files flagged for deletion (D)"]
+ ["Delete Marked (Not Flagged) Files" dired-do-delete
+ :help "Delete current file or all marked files (excluding flagged files)"])
+ ["Shell Command..." dired-do-shell-command
+ :help "Run a shell command on current or marked files"]
+ ["Asynchronous Shell Command..." dired-do-async-shell-command
+ :help "Run a shell command asynchronously on current or marked files"]
+ ["Symlink to..." dired-do-symlink
+ :visible (fboundp 'make-symbolic-link)
+ :help "Make symbolic links for current or marked files"]
+ ["Hardlink to..." dired-do-hardlink
+ :help "Make hard links for current or marked files"]
+ ["Print..." dired-do-print
+ :help "Ask for print command and print marked files"]
+ ["Compress" dired-do-compress
+ :help "Compress/uncompress marked files"]
+ ["Byte-compile" dired-do-byte-compile
+ :help "Byte-compile marked Emacs Lisp files"]
+ ["Load" dired-do-load
+ :help "Load marked Emacs Lisp files"]
+ ["Change Timestamp..." dired-do-touch
+ :help "Change timestamp of marked files"]
+ ["Change Mode..." dired-do-chmod
+ :help "Change mode (attributes) of marked files"]
+ ["Change Group..." dired-do-chgrp
+ :visible (not (memq system-type '(ms-dos windows-nt)))
+ :help "Change the group of marked files"]
+ ["Change Owner..." dired-do-chown
+ :visible (not (memq system-type '(ms-dos windows-nt)))
+ :help "Change the owner of marked files"]
+ ["Isearch Files..." dired-do-isearch
+ :help "Incrementally search marked files for string"]
+ ["Isearch Regexp Files..." dired-do-isearch-regexp
+ :help "Incrementally search marked files for regexp"]
+ ["Search Files..." dired-do-find-regexp
+ :help "Search marked files for matches of regexp"]
+ ["Query Replace in Files..." dired-do-find-regexp-and-replace
+ :help "Replace regexp matches in marked files"]
+ "---"
+ ["Encrypt..." epa-dired-do-encrypt
+ :help "Encrypt current or marked files"]
+ ["Sign..." epa-dired-do-sign
+ :help "Create digital signature of current or marked files"]
+ ["Verify" epa-dired-do-verify
+ :help "Verify digital signature of current or marked files"]
+ ["Decrypt..." epa-dired-do-decrypt
+ :help "Decrypt current or marked files"]
+ "---"
+ ["Display Image Thumbnails" image-dired-display-thumbs
+ :help "Display image thumbnails for current or marked image files"]
+ ["Add Image Comment..." image-dired-dired-comment-files
+ :help "Add image comment to current or marked files"]
+ ["Add Image Tags..." image-dired-tag-files
+ :help "Add image tags to current or marked files"]
+ ["Delete Image Tag..." image-dired-delete-tag
+ :help "Delete image tag from current or marked files"]))
+
+(defun dired-context-menu (menu)
+ (when (mouse-posn-property (event-start last-input-event) 'dired-filename)
+ (define-key menu [dired-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Immediate")))
+ (easy-menu-define nil easy-menu nil
+ '("Immediate"
+ ["Find This File" dired-mouse-find-file
+ :help "Edit file at mouse click"]
+ ["Find in Other Window" dired-mouse-find-file-other-window
+ :help "Edit file at mouse click in other window"]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar immediate])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item))))))
+ menu)
+
+;;; Dired mode
+
;; Dired mode is suitable only for specially formatted data.
(put 'dired-mode 'mode-class 'special)
@@ -2380,15 +2308,18 @@ Keybindings:
(append dired-dnd-protocol-alist dnd-protocol-alist)))
(add-hook 'file-name-at-point-functions #'dired-file-name-at-point nil t)
(add-hook 'isearch-mode-hook #'dired-isearch-filenames-setup nil t)
+ (add-hook 'context-menu-functions 'dired-context-menu 5 t)
(run-mode-hooks 'dired-mode-hook))
+
-;; Idiosyncratic dired commands that don't deal with marks.
+;;; Idiosyncratic dired commands that don't deal with marks
(defun dired-summary ()
"Summarize basic Dired commands and show recent Dired errors."
(interactive)
(dired-why)
- ;>> this should check the key-bindings and use substitute-command-keys if non-standard
+ ;; FIXME this should check the key-bindings and use
+ ;; substitute-command-keys if non-standard
(message
"d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
@@ -2469,7 +2400,7 @@ directory in another window."
(progn
(if other-window
(dired-other-window up)
- (dired up))
+ (dired--find-possibly-alternative-file up))
(dired-goto-file dir)))))
(defun dired-get-file-for-visit ()
@@ -2493,7 +2424,16 @@ directory in another window."
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
(interactive)
- (dired--find-file #'find-file (dired-get-file-for-visit)))
+ (dired--find-possibly-alternative-file (dired-get-file-for-visit)))
+
+(defun dired--find-possibly-alternative-file (file)
+ "Find FILE, but respect `dired-kill-when-opening-new-dired-buffer'."
+ (if (and dired-kill-when-opening-new-dired-buffer
+ (file-directory-p file))
+ (progn
+ (set-buffer-modified-p nil)
+ (dired--find-file #'find-alternate-file file))
+ (dired--find-file #'find-file file)))
(defun dired--find-file (find-file-function file)
"Call FIND-FILE-FUNCTION on FILE, but bind some relevant variables."
@@ -2579,8 +2519,9 @@ Otherwise, display it in another buffer."
(interactive)
(display-buffer (find-file-noselect (dired-get-file-for-visit))
t))
+
-;;; Functions for extracting and manipulating file names in Dired buffers.
+;;; Functions for extracting and manipulating file names in Dired buffers
(defun dired-unhide-subdir ()
(with-silent-modifications
@@ -2687,7 +2628,7 @@ Otherwise, an error occurs in these cases."
(concat (dired-current-directory localp) file)))))
(defun dired-string-replace-match (regexp string newtext
- &optional literal global)
+ &optional literal global)
"Replace first match of REGEXP in STRING with NEWTEXT.
If it does not match, nil is returned instead of the new string.
Optional arg LITERAL means to take NEWTEXT literally.
@@ -2698,7 +2639,7 @@ Optional arg GLOBAL means to replace all matches."
(let ((from-end (- (length string) (match-end 0))))
(setq ret (setq string (replace-match newtext t literal string)))
(setq start (- (length string) from-end))))
- ret)
+ ret)
(if (not (string-match regexp string 0))
nil
(replace-match newtext t literal string))))
@@ -2725,7 +2666,10 @@ unchanged."
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
file))
+
+;;; Mode to hide details
+
(define-minor-mode dired-hide-details-mode
"Toggle visibility of detailed information in current Dired buffer.
When this minor mode is enabled, details such as file ownership and
@@ -2762,6 +2706,7 @@ See options: `dired-hide-details-hide-symlink-targets' and
'add-to-invisibility-spec
'remove-from-invisibility-spec)
'dired-hide-details-link))
+
;;; Functions to hide/unhide text
@@ -2791,7 +2736,7 @@ See options: `dired-hide-details-hide-symlink-targets' and
(progn (goto-char end) (line-end-position))
'(invisible))))
-;;; Functions for finding the file name in a dired buffer line.
+;;; Functions for finding the file name in a dired buffer line
(defvar dired-permission-flags-regexp
"\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
@@ -2882,15 +2827,15 @@ If EOL, it should be an position to use instead of
(or no-error
(not (eq opoint (point)))
(error "%s" (if hidden
- (substitute-command-keys
- "File line is hidden, type \\[dired-hide-subdir] to unhide")
- "No file on this line")))
+ (substitute-command-keys
+ "File line is hidden, type \\[dired-hide-subdir] to unhide")
+ "No file on this line")))
(if (eq opoint (point))
nil
(point)))))
-;;; COPY NAMES OF MARKED FILES INTO KILL-RING.
+;;; Copy names of marked files into kill-ring
(defun dired-copy-filename-as-kill (&optional arg)
"Copy names of marked (or next ARG) files into the kill ring.
@@ -2924,12 +2869,14 @@ You can then feed the file name(s) to other commands with \\[yank]."
(message "%s" string))))
-;; Keeping Dired buffers in sync with the filesystem and with each other
+;;; Keeping Dired buffers in sync with the filesystem and with each other
-(defun dired-buffers-for-dir (dir &optional file)
+(defun dired-buffers-for-dir (dir &optional file subdirs)
"Return a list of buffers for DIR (top level or in-situ subdir).
If FILE is non-nil, include only those whose wildcard pattern (if any)
matches FILE.
+If SUBDIRS is non-nil, also include the dired buffers of
+directories below DIR.
The list is in reverse order of buffer creation, most recent last.
As a side effect, killed dired buffers for DIR are removed from
dired-buffers."
@@ -2941,19 +2888,20 @@ dired-buffers."
((null (buffer-name buf))
;; Buffer is killed - clean up:
(setq dired-buffers (delq elt dired-buffers)))
- ((dired-in-this-tree-p dir (car elt))
+ ((dired-in-this-tree-p (car elt) dir)
(with-current-buffer buf
- (and (assoc dir dired-subdir-alist)
- (or (null file)
- (if (stringp dired-directory)
- (let ((wildcards (file-name-nondirectory
- dired-directory)))
- (or (zerop (length wildcards))
- (string-match-p (dired-glob-regexp wildcards)
- file)))
- (member (expand-file-name file dir)
- (cdr dired-directory))))
- (setq result (cons buf result)))))))
+ (when (and (or subdirs
+ (assoc dir dired-subdir-alist))
+ (or (null file)
+ (if (stringp dired-directory)
+ (let ((wildcards (file-name-nondirectory
+ dired-directory)))
+ (or (zerop (length wildcards))
+ (string-match-p (dired-glob-regexp wildcards)
+ file)))
+ (member (expand-file-name file dir)
+ (cdr dired-directory)))))
+ (setq result (cons buf result)))))))
result))
(defun dired-glob-regexp (pattern)
@@ -2977,7 +2925,7 @@ dired-buffers."
(if (= (aref pattern (1+ set-start)) ?^)
(+ 3 set-start)
(+ 2 set-start)))
- (set-end (string-match-p "]" pattern set-cont))
+ (set-end (string-search "]" pattern set-cont))
(set (substring pattern set-start (1+ set-end))))
(setq regexp (concat regexp set))
(setq matched-in-pattern (1+ set-end))))
@@ -2990,8 +2938,6 @@ dired-buffers."
(substring pattern matched-in-pattern))
"\\'")))
-
-
(defun dired-advertise ()
;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
;; With wildcards we actually advertise too much.
@@ -3009,15 +2955,15 @@ dired-buffers."
;; Removing is also done as a side-effect in dired-buffer-for-dir.
(setq dired-buffers
(delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
-
-;; Tree Dired
-;;; utility functions
+
+;;; Utility functions
(defun dired-in-this-tree-p (file dir)
;;"Is FILE part of the directory tree starting at DIR?"
(let (case-fold-search)
(string-match-p (concat "^" (regexp-quote dir)) file)))
+
(define-obsolete-function-alias 'dired-in-this-tree
'dired-in-this-tree-p "27.1")
@@ -3038,8 +2984,8 @@ dired-buffers."
(beginning-of-line) ; alist stores b-o-l positions
(and (zerop (- (point)
(cdr (assoc cur-dir
- dired-subdir-alist))))
- cur-dir))))
+ dired-subdir-alist))))
+ cur-dir))))
(define-obsolete-function-alias 'dired-get-subdir-min 'cdr "27.1")
@@ -3148,11 +3094,11 @@ instead of `dired-actual-switches'."
new-dir-name)
(setq new-dir-name res)))
(dired-alist-add-1 new-dir-name
- ;; Place a sub directory boundary between lines.
- (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- (point-marker)))))
+ ;; Place a sub directory boundary between lines.
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (point-marker)))))
(if (and (> count 1) (called-interactively-p 'interactive))
(message "Buffer includes %d directories" count)))
;; We don't need to sort it because it is in buffer order per
@@ -3237,15 +3183,15 @@ the quoted forms of those characters.
FULL-NAME specifies the actual file name the listing must have,
as returned by `dired-get-filename'. LIMIT is the search limit."
(let (str)
- (setq str (replace-regexp-in-string "\^m" "\\^m" file nil t))
- (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t))
+ (setq str (string-replace "\^m" "\\^m" file))
+ (setq str (string-replace "\\" "\\\\" str))
(and (dired-switches-escape-p dired-actual-switches)
(string-match-p "[ \t\n]" str)
;; FIXME: to fix this for embedded control characters etc, we
;; should escape everything that `ls -b' does.
- (setq str (replace-regexp-in-string " " "\\ " str nil t)
- str (replace-regexp-in-string "\t" "\\t" str nil t)
- str (replace-regexp-in-string "\n" "\\n" str nil t)))
+ (setq str (string-replace " " "\\ " str)
+ str (string-replace "\t" "\\t" str)
+ str (string-replace "\n" "\\n" str)))
(let ((found nil)
;; filenames are preceded by SPC, this makes the search faster
;; (e.g. for the filename "-").
@@ -3271,7 +3217,7 @@ It runs the hook `dired-initial-position-hook'."
(dired-goto-subdir dirname))
(if dired-trivial-filenames (dired-goto-next-nontrivial-file))
(run-hooks 'dired-initial-position-hook))
-
+
;; These are hooks which make tree dired work.
;; They are in this file because other parts of dired need to call them.
;; But they don't call the rest of tree dired unless there are subdirs loaded.
@@ -3310,8 +3256,9 @@ is the directory where the file on this line resides."
(if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
(point-max)
(point))))
+
-;; Deleting files
+;;; Deleting files
(defcustom dired-recursive-deletes 'top
"Whether Dired deletes directories recursively.
@@ -3386,15 +3333,19 @@ non-empty directories is allowed."
(interactive)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
- case-fold-search)
+ case-fold-search markers)
(if (save-excursion (goto-char (point-min))
(re-search-forward regexp nil t))
(dired-internal-do-deletions
(nreverse
;; this can't move point since ARG is nil
- (dired-map-over-marks (cons (dired-get-filename) (point))
+ (dired-map-over-marks (cons (dired-get-filename)
+ (let ((m (point-marker)))
+ (push m markers)
+ m))
nil))
nil t)
+ (dolist (m markers) (set-marker m nil))
(or nomessage
(message "(No deletions requested)")))))
@@ -3405,12 +3356,17 @@ non-empty directories is allowed."
;; This is more consistent with the file marking feature than
;; dired-do-flagged-delete.
(interactive "P")
- (dired-internal-do-deletions
- (nreverse
- ;; this may move point if ARG is an integer
- (dired-map-over-marks (cons (dired-get-filename) (point))
- arg))
- arg t))
+ (let (markers)
+ (dired-internal-do-deletions
+ (nreverse
+ ;; this may move point if ARG is an integer
+ (dired-map-over-marks (cons (dired-get-filename)
+ (let ((m (point-marker)))
+ (push m markers)
+ m))
+ arg))
+ arg t)
+ (dolist (m markers) (set-marker m nil))))
(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
@@ -3418,11 +3374,6 @@ non-empty directories is allowed."
;; L is an alist of files to delete, with their buffer positions.
;; ARG is the prefix arg.
;; Filenames are absolute.
- ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
- ;; That way as changes are made in the buffer they do not shift the
- ;; 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 #'car l))
(count (length l))
(succ 0)
@@ -3443,9 +3394,10 @@ non-empty directories is allowed."
(make-progress-reporter
(if trashing "Trashing..." "Deleting...")
succ count))
- failures) ;; files better be in reverse order for this loop!
+ failures)
(while l
- (goto-char (cdr (car l)))
+ (goto-char (marker-position (cdr (car l))))
+ (dired-move-to-filename)
(let ((inhibit-read-only t))
(condition-case err
(let ((fn (car (car l))))
@@ -3475,7 +3427,7 @@ non-empty directories is allowed."
(defun dired-fun-in-all-buffers (directory file fun &rest args)
"In all buffers dired'ing DIRECTORY, run FUN with ARGS.
If the buffer has a wildcard pattern, check that it matches FILE.
-(FILE does not include a directory component.)
+\(FILE does not include a directory component.)
FILE may be nil, in which case ignore it.
Return list of buffers where FUN succeeded (i.e., returned non-nil)."
(let (success-list)
@@ -3528,20 +3480,26 @@ confirmation. To disable the confirmation, see
(file-name-nondirectory fn))))
(not dired-clean-confirm-killing-deleted-buffers))
(kill-buffer buf)))
- (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
+ (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)
+ nil 'subdirs)))
(and buf-list
(or (and dired-clean-confirm-killing-deleted-buffers
- (y-or-n-p (format
- (ngettext "Kill Dired buffer of %s, too? "
- "Kill Dired buffers of %s, too? "
- (length buf-list))
- (file-name-nondirectory fn))))
+ (y-or-n-p
+ (format
+ (ngettext "Kill Dired buffer of %s, too? "
+ "Kill Dired buffers of %s, too? "
+ (length buf-list))
+ (file-name-nondirectory
+ ;; FN may end in a / if `dired-listing-switches'
+ ;; contains -p, so we need to strip that
+ ;; (bug#48301).
+ (directory-file-name fn)))))
(not dired-clean-confirm-killing-deleted-buffers))
(dolist (buf buf-list)
(kill-buffer buf))))))
-;; Confirmation
+;;; Confirmation
(defun dired-marker-regexp ()
(concat "^" (regexp-quote (char-to-string dired-marker-char))))
@@ -3660,8 +3618,9 @@ argument or confirmation)."
(let ((beg (point)))
(completion--insert-strings files)
(put-text-property beg (point) 'mouse-face nil)))
+
-;; Commands to mark or flag file(s) at or near current line.
+;;; Commands to mark or flag file(s) at or near current line
(defun dired-repeat-over-lines (arg function)
;; This version skips non-file lines.
@@ -3849,8 +3808,9 @@ on the whole buffer."
(list ?\s dired-marker-char)
(list dired-marker-char ?\s))))
(forward-line 1)))))
+
-;;; Commands to mark or flag files based on their characteristics or names.
+;;; Commands to mark or flag files based on their characteristics or names
(defvar dired-regexp-history nil
"History list of regular expressions used in Dired commands.")
@@ -3906,13 +3866,13 @@ object files--just `.o' will mark more than you might think."
when (stringp file)
sum (file-attribute-size (file-attributes file)))))
(if (zerop nmarked)
- (message "No marked files"))
- (message "%d marked file%s (%s total size)"
- nmarked
- (if (= nmarked 1)
- ""
- "s")
- (funcall byte-count-to-string-function size))))
+ (message "No marked files")
+ (message "%d marked file%s (%s total size)"
+ nmarked
+ (if (= nmarked 1)
+ ""
+ "s")
+ (funcall byte-count-to-string-function size)))))
(defun dired-mark-files-containing-regexp (regexp &optional marker-char)
"Mark all files with contents containing REGEXP for use in later commands.
@@ -3951,8 +3911,7 @@ since it was last visited."
(with-temp-buffer
(insert-file-contents fn)
(goto-char (point-min))
- (re-search-forward regexp nil t))))
- )))
+ (re-search-forward regexp nil t)))))))
"matching file")))
(defun dired-flag-files-regexp (regexp)
@@ -4127,8 +4086,9 @@ Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
(message (if (= count 1) "1 mark removed"
"%d marks removed")
count))))
+
-;; Logging failures operating on files, and showing the results.
+;;; Logging failures operating on files, and showing the results
(defvar dired-log-buffer "*Dired log*")
@@ -4193,6 +4153,7 @@ or nil if file names are not applicable."
;; Log a summary describing a bunch of errors.
(dired-log (concat "\n" string "\n"))
(dired-log t))
+
;;; Sorting
@@ -4235,7 +4196,8 @@ Possible values:
* `as-is': Show full switches.
* Integer: Show only the first N chars of full switches.
* Function: Pass `dired-actual-switches' as arg and show result."
- :group 'Dired-Plus
+ :group 'dired
+ :version "28.1"
:type '(choice
(const :tag "Indicate by name or date, else full" nil)
(const :tag "Show full switches" as-is)
@@ -4373,9 +4335,9 @@ To be called first in body of `dired-sort-other', etc."
;; No pre-R subdir alist, so revert to main directory
;; listing:
(list (car (reverse dired-subdir-alist))))))))
-
-;;;; Drag and drop support
+
+;;; Drag and drop support
(defcustom dired-recursive-copies 'top
"Whether Dired copies directories recursively.
@@ -4477,9 +4439,9 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(let ((local-file (dnd-get-local-file-uri uri)))
(if local-file (dired-dnd-handle-local-file local-file action)
nil)))
-
-;;;; Desktop support
+
+;;; Desktop support
(eval-when-compile (require 'desktop))
(declare-function desktop-file-name "desktop" (filename dirname))
@@ -4496,10 +4458,10 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(desktop-file-name dired-directory dirname))
;; Subdirectories in `dired-subdir-alist'.
(cdr
- (nreverse
- (mapcar
- (lambda (f) (desktop-file-name (car f) dirname))
- dired-subdir-alist)))))
+ (nreverse
+ (mapcar
+ (lambda (f) (desktop-file-name (car f) dirname))
+ dired-subdir-alist)))))
(defun dired-restore-desktop-buffer (_file-name
_buffer-name
@@ -4525,7 +4487,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
'(dired-mode . dired-restore-desktop-buffer))
-;;;; Jump to Dired
+;;; Jump to Dired
(defvar archive-superior-buffer)
(defvar tar-superior-buffer)
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 795f1dd6602..be8db75c967 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -1,4 +1,4 @@
-;;; dirtrack.el --- Directory Tracking by watching the prompt
+;;; dirtrack.el --- Directory Tracking by watching the prompt -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -77,7 +77,7 @@
;; Running under tcsh:
;; (setq-default dirtrack-list '("^%E \\([^ ]+\\)" 1))
;;
-;; It might be worth mentioning in your file that emacs sources start up
+;; It might be worth mentioning in your file that Emacs sources start up
;; files of the form: ~/.emacs_<SHELL> where <SHELL> is the name of the
;; shell. So for example, I have the following in ~/.emacs_tcsh:
;;
@@ -123,7 +123,6 @@
"List for directory tracking.
First item is a regexp that describes where to find the path in a prompt.
Second is a number, the regexp group to match."
- :group 'dirtrack
:type '(sexp (regexp :tag "Prompt Expression")
(integer :tag "Regexp Group"))
:version "24.1")
@@ -132,12 +131,10 @@ Second is a number, the regexp group to match."
(defcustom dirtrack-debug nil
"If non-nil, the function `dirtrack' will report debugging info."
- :group 'dirtrack
:type 'boolean)
(defcustom dirtrack-debug-buffer "*Directory Tracking Log*"
"Buffer in which to write directory tracking debug information."
- :group 'dirtrack
:type 'string)
(defcustom dirtrack-directory-function
@@ -145,19 +142,16 @@ Second is a number, the regexp group to match."
'dirtrack-windows-directory-function
'file-name-as-directory)
"Function to apply to the prompt directory for comparison purposes."
- :group 'dirtrack
:type 'function)
(defcustom dirtrack-canonicalize-function
(if (memq system-type '(ms-dos windows-nt cygwin))
'downcase 'identity)
"Function to apply to the default directory for comparison purposes."
- :group 'dirtrack
:type 'function)
(defcustom dirtrack-directory-change-hook nil
"Hook that is called when a directory change is made."
- :group 'dirtrack
:type 'hook)
@@ -190,7 +184,7 @@ working directory at all times, and that you set the variable
This is an alternative to `shell-dirtrack-mode', which works by
tracking `cd' and similar commands which change the shell working
directory."
- nil nil nil
+ :lighter nil
(if dirtrack-mode
(add-hook 'comint-preoutput-filter-functions 'dirtrack nil t)
(remove-hook 'comint-preoutput-filter-functions 'dirtrack t)))
@@ -198,7 +192,7 @@ directory."
(define-minor-mode dirtrack-debug-mode
"Toggle Dirtrack debugging."
- nil nil nil
+ :lighter nil
(if dirtrack-debug-mode
(display-buffer (get-buffer-create dirtrack-debug-buffer))))
diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el
index a6fa813afe7..72928492bb2 100644
--- a/lisp/display-line-numbers.el
+++ b/lisp/display-line-numbers.el
@@ -56,12 +56,17 @@ See `display-line-numbers' for value options."
(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."
+When `display-line-numbers-mode' is turned on, if this option is
+non-nil, `display-line-numbers-width' is set up front to a width
+necessary to display all line numbers in the buffer. If the value
+is a positive number, it is interpreted as extra lines to account
+for when computing the required width; this should be set to the
+number of lines in the tallest window in which you want to prevent
+the line-number width from changing."
:group 'display-line-numbers
- :type 'boolean
- :version "26.1")
+ :type '(choice (boolean :tag "Minimum width for buffer's line count")
+ (integer :tag "Number of extra lines to account for"))
+ :version "28.1")
(defun display-line-numbers-update-width ()
"Prevent the line number width from shrinking."
@@ -83,7 +88,11 @@ the mode is on, set `display-line-numbers' directly."
(when display-line-numbers-width-start
(setq display-line-numbers-width
(length (number-to-string
- (count-lines (point-min) (point-max))))))
+ (+ (count-lines (point-min) (point-max))
+ (if (and (numberp display-line-numbers-width-start)
+ (> display-line-numbers-width-start 0))
+ display-line-numbers-width-start
+ 0))))))
(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))
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 7319a27d190..e641b2843a9 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -180,6 +180,7 @@ An alternative for systems that do not support unc file names is
(if dnd-open-file-other-window
(find-file-other-window f)
(find-file f))
+ (file-name-history--add f)
'private)
(error "Can not read %s" uri))))
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index f6fcfae453e..a0ffcac9f80 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1439,6 +1439,8 @@ ARGS is a list of image descriptors."
(apply #'create-image file doc-view--image-type nil args)
(unless (member :width args)
(setq args `(,@args :width ,doc-view-image-width)))
+ (unless (member :transform-smoothing args)
+ (setq args `(,@args :transform-smoothing t)))
(apply #'create-image file doc-view--image-type nil args))))
(slice (doc-view-current-slice))
(img-width (and image (car (image-size image))))
@@ -1800,11 +1802,6 @@ If BACKWARD is non-nil, jump to the previous match."
(remove-overlays (point-min) (point-max) 'doc-view t)
(if (consp image-mode-winprops-alist) (setq image-mode-winprops-alist nil)))
-(defun doc-view-intersection (l1 l2)
- (let ((l ()))
- (dolist (x l1) (if (memq x l2) (push x l)))
- l))
-
(defun doc-view-set-doc-type ()
"Figure out the current document type (`doc-view-doc-type')."
(let ((name-types
@@ -1839,7 +1836,7 @@ If BACKWARD is non-nil, jump to the previous match."
((looking-at "AT&TFORM") '(djvu))))))
(setq-local
doc-view-doc-type
- (car (or (doc-view-intersection name-types content-types)
+ (car (or (nreverse (seq-intersection name-types content-types #'eq))
(when (and name-types content-types)
(error "Conflicting types: name says %s but content says %s"
name-types content-types))
@@ -1916,6 +1913,11 @@ toggle between displaying the document or editing it as text.
(unless (memq doc-view-doc-type '(ps))
(setq-local require-final-newline nil))
+ ;; These modes will just display "1", so they're not very useful
+ ;; in this mode.
+ (setq-local global-linum-mode nil
+ display-line-numbers-mode nil)
+
(doc-view-make-safe-dir doc-view-cache-directory)
;; Handle compressed files, remote files, files inside archives
(setq-local doc-view--buffer-file-name
@@ -2144,6 +2146,12 @@ See the command `doc-view-mode' for more information on this mode."
(add-hook 'bookmark-after-jump-hook show-fn-sym)
(bookmark-default-handler bmk)))
+;; Obsolete.
+
+(defun doc-view-intersection (l1 l2)
+ (declare (obsolete seq-intersection "28.1"))
+ (nreverse (seq-intersection l1 l2 #'eq)))
+
(provide 'doc-view)
;; Local Variables:
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 255edd0f371..e0a533c637a 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -86,7 +86,7 @@ sure to obey the 8.3 limitations."
;; close to the beginning, change that to a period. This
;; is so we could salvage more characters of the original
;; name by pushing them into the extension.
- (if (and (not (string-match "\\." string))
+ (if (and (not (string-search "." string))
(> (length string) 8)
;; We don't gain anything if we put the period closer
;; than 5 chars from the beginning (5 + 3 = 8).
@@ -100,21 +100,21 @@ sure to obey the 8.3 limitations."
;; If we don't have a period in the first 8 chars, insert one.
;; This enables having 3 more characters from the original
;; name in the extension.
- (if (> (or (string-match "\\." string) (length string))
+ (if (> (or (string-search "." string) (length string))
8)
(setq string
(concat (substring string 0 8)
"."
(substring string 8))))
- (setq firstdot (or (string-match "\\." string)
+ (setq firstdot (or (string-search "." string)
(1- (length string))))
;; Truncate to 3 chars after the first period.
(if (> (length string) (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
;; Change all periods except the first one into underscores.
;; (DOS doesn't allow more than one period.)
- (while (string-match "\\." string (1+ firstdot))
- (setq i (string-match "\\." string (1+ firstdot)))
+ (while (string-search "." string (1+ firstdot))
+ (setq i (string-search "." string (1+ firstdot)))
(aset string i ?_))
;; If the last character of the original filename was `~' or `#',
;; make sure the munged name ends with it also. This is so that
@@ -160,7 +160,7 @@ sure to obey the 8.3 limitations."
(strlen (length string))
(lastchar (aref string (1- strlen)))
firstdot)
- (setq firstdot (string-match "\\." string))
+ (setq firstdot (string-search "." string))
(cond
(firstdot
;; Truncate the extension to 3 characters.
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index cf753214624..45daaad8eff 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,4 +1,4 @@
-;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*- lexical-binding: t; -*-
+;;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/double.el b/lisp/double.el
index 7bc8d92e600..f9227a8bbd9 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -1,4 +1,4 @@
-;;; double.el --- support for keyboard remapping with double clicking
+;;; double.el --- support for keyboard remapping with double clicking -*- lexical-binding: t -*-
;; Copyright (C) 1994, 1997-1998, 2001-2021 Free Software Foundation,
;; Inc.
@@ -67,7 +67,6 @@ Each entry is a list with three elements:
1. The key activating the translation.
2. The string to be inserted when the key is pressed once.
3. The string to be inserted when the key is pressed twice."
- :group 'double
:type '(repeat (list (character :tag "Key")
(string :tag "Once")
(string :tag "Twice"))))
@@ -76,7 +75,6 @@ Each entry is a list with three elements:
"Non-nil means that Double mode mapping only works for prefix keys.
That is, for any key `X' in `double-map', `X' alone will be mapped
but not `C-u X' or `ESC X' since the X is not the prefix key."
- :group 'double
:type 'boolean)
;;; Read Event
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index d6952ed59f3..6b037aa2a6c 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -1,4 +1,4 @@
-;;; dynamic-setting.el --- Support dynamic changes
+;;; dynamic-setting.el --- Support dynamic changes -*- lexical-binding: t -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -24,8 +24,8 @@
;;; Commentary:
-;; This file provides the lisp part of the GConf and XSetting code in
-;; xsetting.c. But it is nothing that prevents it from being used by
+;; This file provides the Lisp part of the GConf and XSetting code in
+;; xsetting.c. But there is nothing that prevents it from being used by
;; other configuration schemes.
;;; Code:
@@ -91,4 +91,7 @@ Changes can be
((eq type 'tool-bar-style) (force-mode-line-update t)))))
(define-key special-event-map [config-changed-event]
- 'dynamic-setting-handle-config-changed-event)
+ #'dynamic-setting-handle-config-changed-event)
+
+(provide 'dynamic-setting)
+;;; dynamic-setting.el ends here
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index fb73b2d1786..7fecf1a5045 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -1,4 +1,4 @@
-;;; ebuff-menu.el --- electric-buffer-list mode
+;;; ebuff-menu.el --- electric-buffer-list mode -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -34,55 +34,53 @@
(defvar electric-buffer-menu-mode-map
(let ((map (make-keymap)))
- (fillarray (car (cdr map)) 'Electric-buffer-menu-undefined)
+ (fillarray (car (cdr map)) #'Electric-buffer-menu-undefined)
(define-key map "\e" nil)
- (define-key map "\C-z" 'suspend-frame)
- (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
- (define-key map (char-to-string help-char) 'Helper-help)
- (define-key map "?" 'Helper-describe-bindings)
+ (define-key map "\C-z" #'suspend-frame)
+ (define-key map "v" #'Electric-buffer-menu-mode-view-buffer)
+ (define-key map (char-to-string help-char) #'Helper-help)
+ (define-key map "?" #'Helper-describe-bindings)
(define-key map "\C-c" nil)
- (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
- (define-key map "\C-]" 'Electric-buffer-menu-quit)
- (define-key map "q" 'Electric-buffer-menu-quit)
- (define-key map " " 'Electric-buffer-menu-select)
- (define-key map "\C-m" 'Electric-buffer-menu-select)
- (define-key map "\C-l" 'recenter)
- (define-key map "s" 'Buffer-menu-save)
- (define-key map "d" 'Buffer-menu-delete)
- (define-key map "k" 'Buffer-menu-delete)
- (define-key map "\C-d" 'Buffer-menu-delete-backwards)
- ;; (define-key map "\C-k" 'Buffer-menu-delete)
- (define-key map "\177" 'Buffer-menu-backup-unmark)
- (define-key map "~" 'Buffer-menu-not-modified)
- (define-key map "u" 'Buffer-menu-unmark)
- (define-key map "\M-\177" 'Buffer-menu-unmark-all-buffers)
- (define-key map "U" 'Buffer-menu-unmark-all)
- (let ((i ?0))
- (while (<= i ?9)
- (define-key map (char-to-string i) 'digit-argument)
- (define-key map (concat "\e" (char-to-string i)) 'digit-argument)
- (setq i (1+ i))))
- (define-key map "-" 'negative-argument)
- (define-key map "\e-" 'negative-argument)
- (define-key map "m" 'Buffer-menu-mark)
- (define-key map "\C-u" 'universal-argument)
- (define-key map "\C-p" 'previous-line)
- (define-key map "\C-n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "n" 'next-line)
- (define-key map "\C-v" 'scroll-up-command)
- (define-key map "\ev" 'scroll-down-command)
- (define-key map ">" 'scroll-right)
- (define-key map "<" 'scroll-left)
- (define-key map "\e\C-v" 'scroll-other-window)
- (define-key map "\e>" 'end-of-buffer)
- (define-key map "\e<" 'beginning-of-buffer)
+ (define-key map "\C-c\C-c" #'Electric-buffer-menu-quit)
+ (define-key map "\C-]" #'Electric-buffer-menu-quit)
+ (define-key map "q" #'Electric-buffer-menu-quit)
+ (define-key map " " #'Electric-buffer-menu-select)
+ (define-key map "\C-m" #'Electric-buffer-menu-select)
+ (define-key map "\C-l" #'recenter)
+ (define-key map "s" #'Buffer-menu-save)
+ (define-key map "d" #'Buffer-menu-delete)
+ (define-key map "k" #'Buffer-menu-delete)
+ (define-key map "\C-d" #'Buffer-menu-delete-backwards)
+ ;; (define-key map "\C-k" #'Buffer-menu-delete)
+ (define-key map "\177" #'Buffer-menu-backup-unmark)
+ (define-key map "~" #'Buffer-menu-not-modified)
+ (define-key map "u" #'Buffer-menu-unmark)
+ (define-key map "\M-\177" #'Buffer-menu-unmark-all-buffers)
+ (define-key map "U" #'Buffer-menu-unmark-all)
+ (dotimes (i 10)
+ (define-key map (char-to-string i) #'digit-argument)
+ (define-key map (concat "\e" (char-to-string i)) #'digit-argument))
+ (define-key map "-" #'negative-argument)
+ (define-key map "\e-" #'negative-argument)
+ (define-key map "m" #'Buffer-menu-mark)
+ (define-key map "\C-u" #'universal-argument)
+ (define-key map "\C-p" #'previous-line)
+ (define-key map "\C-n" #'next-line)
+ (define-key map "p" #'previous-line)
+ (define-key map "n" #'next-line)
+ (define-key map "\C-v" #'scroll-up-command)
+ (define-key map "\ev" #'scroll-down-command)
+ (define-key map ">" #'scroll-right)
+ (define-key map "<" #'scroll-left)
+ (define-key map "\e\C-v" #'scroll-other-window)
+ (define-key map "\e>" #'end-of-buffer)
+ (define-key map "\e<" #'beginning-of-buffer)
(define-key map "\e\e" nil)
- (define-key map "\e\e\e" 'Electric-buffer-menu-quit)
+ (define-key map "\e\e\e" #'Electric-buffer-menu-quit)
;; This binding prevents the "escape => ESC" function-key-map mapping from
;; kicking in!
- ;; (define-key map [escape escape escape] 'Electric-buffer-menu-quit)
- (define-key map [mouse-2] 'Electric-buffer-menu-mouse-select)
+ ;; (define-key map [escape escape escape] #'Electric-buffer-menu-quit)
+ (define-key map [mouse-2] #'Electric-buffer-menu-mouse-select)
map))
(put 'Electric-buffer-menu-quit :advertised-binding "\C-c\C-c")
@@ -205,7 +203,7 @@ See the documentation of `electric-buffer-list' for details."
(setq-local Helper-return-blurb "return to buffer editing"))
(define-obsolete-function-alias 'Electric-buffer-menu-mode
- 'electric-buffer-menu-mode "24.3")
+ #'electric-buffer-menu-mode "24.3")
;; generally the same as Buffer-menu-mode-map
;; (except we don't indirect to global-map)
diff --git a/lisp/echistory.el b/lisp/echistory.el
index 8f787e7fa1c..15679b13d5c 100644
--- a/lisp/echistory.el
+++ b/lisp/echistory.el
@@ -1,4 +1,4 @@
-;;; echistory.el --- Electric Command History Mode
+;;; echistory.el --- Electric Command History Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -44,44 +44,43 @@ With prefix arg NOCONFIRM, execute current line as-is without editing."
(defvar electric-history-map
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'Electric-history-undefined)
+ (define-key map [t] #'Electric-history-undefined)
(define-key map "\e" (make-sparse-keymap))
- (define-key map [?\e t] 'Electric-history-undefined)
- (define-key map "\C-u" 'universal-argument)
- (define-key map " " 'Electric-command-history-redo-expression)
- (define-key map "!" 'Electric-command-history-redo-expression)
- (define-key map "\e\C-x" 'eval-sexp)
- (define-key map "\e\C-d" 'down-list)
- (define-key map "\e\C-u" 'backward-up-list)
- (define-key map "\e\C-b" 'backward-sexp)
- (define-key map "\e\C-f" 'forward-sexp)
- (define-key map "\e\C-a" 'beginning-of-defun)
- (define-key map "\e\C-e" 'end-of-defun)
- (define-key map "\e\C-n" 'forward-list)
- (define-key map "\e\C-p" 'backward-list)
- (define-key map "q" 'Electric-history-quit)
+ (define-key map [?\e t] #'Electric-history-undefined)
+ (define-key map "\C-u" #'universal-argument)
+ (define-key map " " #'Electric-command-history-redo-expression)
+ (define-key map "!" #'Electric-command-history-redo-expression)
+ (define-key map "\e\C-d" #'down-list)
+ (define-key map "\e\C-u" #'backward-up-list)
+ (define-key map "\e\C-b" #'backward-sexp)
+ (define-key map "\e\C-f" #'forward-sexp)
+ (define-key map "\e\C-a" #'beginning-of-defun)
+ (define-key map "\e\C-e" #'end-of-defun)
+ (define-key map "\e\C-n" #'forward-list)
+ (define-key map "\e\C-p" #'backward-list)
+ (define-key map "q" #'Electric-history-quit)
(define-key map "\C-c" nil)
- (define-key map "\C-c\C-c" 'Electric-history-quit)
- (define-key map "\C-]" 'Electric-history-quit)
- (define-key map "\C-z" 'suspend-frame)
- (define-key map (char-to-string help-char) 'Helper-help)
- (define-key map "?" 'Helper-describe-bindings)
- (define-key map "\e>" 'end-of-buffer)
- (define-key map "\e<" 'beginning-of-buffer)
- (define-key map "\n" 'next-line)
- (define-key map "\r" 'next-line)
- (define-key map "\177" 'previous-line)
- (define-key map "\C-n" 'next-line)
- (define-key map "\C-p" 'previous-line)
- (define-key map "\ev" 'scroll-down)
- (define-key map "\C-v" 'scroll-up)
- (define-key map [home] 'beginning-of-buffer)
- (define-key map [down] 'next-line)
- (define-key map [up] 'previous-line)
- (define-key map [prior] 'scroll-down)
- (define-key map [next] 'scroll-up)
- (define-key map "\C-l" 'recenter)
- (define-key map "\e\C-v" 'scroll-other-window)
+ (define-key map "\C-c\C-c" #'Electric-history-quit)
+ (define-key map "\C-]" #'Electric-history-quit)
+ (define-key map "\C-z" #'suspend-frame)
+ (define-key map (char-to-string help-char) #'Helper-help)
+ (define-key map "?" #'Helper-describe-bindings)
+ (define-key map "\e>" #'end-of-buffer)
+ (define-key map "\e<" #'beginning-of-buffer)
+ (define-key map "\n" #'next-line)
+ (define-key map "\r" #'next-line)
+ (define-key map "\177" #'previous-line)
+ (define-key map "\C-n" #'next-line)
+ (define-key map "\C-p" #'previous-line)
+ (define-key map "\ev" #'scroll-down)
+ (define-key map "\C-v" #'scroll-up)
+ (define-key map [home] #'beginning-of-buffer)
+ (define-key map [down] #'next-line)
+ (define-key map [up] #'previous-line)
+ (define-key map [prior] #'scroll-down)
+ (define-key map [next] #'scroll-up)
+ (define-key map "\C-l" #'recenter)
+ (define-key map "\e\C-v" #'scroll-other-window)
map)
"Keymap for Electric Command History mode.")
@@ -141,7 +140,9 @@ The Command History listing is recomputed each time this mode is invoked."
(defun Electric-history-undefined ()
(interactive)
(ding)
- (message "%s" (substitute-command-keys "Type \\[Helper-help] for help, ? for commands, C-c C-c to quit, Space to execute"))
+ (message "%s" (substitute-command-keys "Type \\[Helper-help] for help, \
+\\[Helper-describe-bindings] for commands, \\[Electric-history-quit] to quit, \
+\\[Electric-command-history-redo-expression] to execute"))
(sit-for 4))
(defun Electric-history-quit ()
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 3d7db44a86d..9e4a71c336e 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,4 +1,4 @@
-;;; edmacro.el --- keyboard macro editor
+;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal notation."
(defvar edmacro-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'edmacro-finish-edit)
- (define-key map "\C-c\C-q" 'edmacro-insert-key)
+ (define-key map "\C-c\C-c" #'edmacro-finish-edit)
+ (define-key map "\C-c\C-q" #'edmacro-insert-key)
map))
(defvar edmacro-store-hook)
@@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise way."
(set-buffer-modified-p nil))
(run-hooks 'edmacro-format-hook)))))
-;;; The next two commands are provided for convenience and backward
-;;; compatibility.
+;; The next two commands are provided for convenience and backward
+;; compatibility.
;;;###autoload
(defun edit-last-kbd-macro (&optional prefix)
@@ -237,8 +237,7 @@ or nil, use a compact 80-column format."
((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
(when edmacro-store-hook
(error "\"Command\" line not allowed in this context"))
- (let ((str (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (let ((str (match-string 1)))
(unless (equal str "")
(setq cmd (and (not (equal str "none"))
(intern str)))
@@ -253,8 +252,7 @@ or nil, use a compact 80-column format."
(when edmacro-store-hook
(error "\"Key\" line not allowed in this context"))
(let ((key (edmacro-parse-keys
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
+ (match-string 1))))
(unless (equal key "")
(if (equal key "none")
(setq no-keys t)
@@ -274,16 +272,14 @@ or nil, use a compact 80-column format."
((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
(when edmacro-store-hook
(error "\"Counter\" line not allowed in this context"))
- (let ((str (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (let ((str (match-string 1)))
(unless (equal str "")
(setq mac-counter (string-to-number str))))
t)
((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$")
(when edmacro-store-hook
(error "\"Format\" line not allowed in this context"))
- (let ((str (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (let ((str (match-string 1)))
(unless (equal str "")
(setq mac-format str)))
t)
@@ -475,7 +471,7 @@ doubt, use whitespace."
(and (not (memq (aref rest-mac i) pkeys))
(prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ")
(cl-callf cl-subseq rest-mac i)))))))
- (bind-len (apply 'max 1
+ (bind-len (apply #'max 1
(cl-loop for map in maps
for b = (lookup-key map rest-mac)
when b collect b)))
@@ -506,7 +502,7 @@ doubt, use whitespace."
finally return i))
desc)
(if (stringp bind) (setq bind nil))
- (cond ((and (eq bind 'self-insert-command) (not prefix)
+ (cond ((and (eq bind #'self-insert-command) (not prefix)
(> text 1) (integerp first)
(> first 32) (<= first maxkey) (/= first 92)
(progn
@@ -520,11 +516,11 @@ doubt, use whitespace."
desc))))
(when (or (string-match "^\\^.$" desc)
(member desc res-words))
- (setq desc (mapconcat 'char-to-string desc " ")))
+ (setq desc (mapconcat #'char-to-string desc " ")))
(when verbose
(setq bind (format "%s * %d" bind text)))
(setq bind-len text))
- ((and (eq bind 'execute-extended-command)
+ ((and (eq bind #'execute-extended-command)
(> text bind-len)
(memq (aref rest-mac text) '(return 13))
(progn
@@ -563,7 +559,7 @@ doubt, use whitespace."
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
- (unless (string-match " " desc)
+ (unless (string-search " " desc)
(let ((times 1) (pos bind-len))
(while (not (cl-mismatch rest-mac rest-mac
:start1 0 :end1 bind-len
@@ -667,10 +663,8 @@ This function assumes that the events can be stored in a string."
(substring word 2 -2) "\r")))
((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
(progn
- (setq word (concat (substring word (match-beginning 1)
- (match-end 1))
- (substring word (match-beginning 3)
- (match-end 3))))
+ (setq word (concat (match-string 1 word)
+ (match-string 3 word)))
(not (string-match
"\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
word))))
diff --git a/lisp/electric.el b/lisp/electric.el
index 6701a36d8bb..4394fae4366 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -245,10 +245,7 @@ or comment."
'electric-indent-functions
last-command-event)
(memq last-command-event electric-indent-chars))))
- (not
- (or (memq act '(nil no-indent))
- ;; In a string or comment.
- (unless (eq act 'do-indent) (nth 8 (syntax-ppss))))))))
+ (not (memq act '(nil no-indent))))))
;; If we error during indent, silently give up since this is an
;; automatic action that the user didn't explicitly request.
;; But we don't want to suppress errors from elsewhere in *this*
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index b9a3a32a9b6..8e8d0e22651 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2051,6 +2051,8 @@ in that CLASS."
function class name)))
(error "ad-remove-advice: `%s' is not advised" function)))
+(declare-function comp-subr-trampoline-install "comp")
+
;;;###autoload
(defun ad-add-advice (function advice class position)
"Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
@@ -2074,6 +2076,9 @@ mapped to the closest extremal position).
If FUNCTION was not advised already, its advice info will be
initialized. Redefining a piece of advice whose name is part of
the cache-id will clear the cache."
+ (when (and (featurep 'native-compile)
+ (subr-primitive-p (symbol-function function)))
+ (comp-subr-trampoline-install function))
(cond ((not (ad-is-advised function))
(ad-initialize-advice-info function)
(ad-set-advice-info-field
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index ec7492dd4b1..e9a20634af8 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -141,9 +141,12 @@ expression, in which case we want to handle forms differently."
((stringp (car-safe rest)) (car rest))))
;; Look for an interactive spec.
(interactive (pcase body
- ((or `((interactive . ,_) . ,_)
- `(,_ (interactive . ,_) . ,_))
- t))))
+ ((or `((interactive . ,iargs) . ,_)
+ `(,_ (interactive . ,iargs) . ,_))
+ ;; List of modes or just t.
+ (if (nthcdr 1 iargs)
+ (list 'quote (nthcdr 1 iargs))
+ t)))))
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (consp args) (setq doc (help-add-fundoc-usage doc args)))
@@ -167,7 +170,9 @@ expression, in which case we want to handle forms differently."
define-inline cl-defun cl-defmacro cl-defgeneric
cl-defstruct pcase-defmacro))
(macrop car)
- (setq expand (let ((load-file-name file)) (macroexpand form)))
+ (setq expand (let ((load-true-file-name file)
+ (load-file-name file))
+ (macroexpand form)))
(memq (car expand) '(progn prog1 defalias)))
(make-autoload expand file 'expansion)) ;Recurse on the expansion.
@@ -207,7 +212,11 @@ expression, in which case we want to handle forms differently."
easy-mmode-define-minor-mode
define-minor-mode))
t)
- (eq (car-safe (car body)) 'interactive))
+ (and (eq (car-safe (car body)) 'interactive)
+ ;; List of modes or just t.
+ (or (if (nthcdr 1 (car body))
+ (list 'quote (nthcdr 1 (car body)))
+ t))))
,(if macrop ''macro nil))))
;; For defclass forms, use `eieio-defclass-autoload'.
@@ -241,7 +250,10 @@ expression, in which case we want to handle forms differently."
(custom-autoload ',varname ,file
,(condition-case nil
(null (plist-get props :set))
- (error nil))))))
+ (error nil)))
+ ;; Propagate the :safe property to the loaddefs file.
+ ,@(when-let ((safe (plist-get props :safe)))
+ `((put ',varname 'safe-local-variable ,safe))))))
((eq car 'defgroup)
;; In Emacs this is normally handled separately by cus-dep.el, but for
@@ -614,8 +626,8 @@ Don't try to split prefixes that are already longer than that.")
(radix-tree-iter-mappings
(cdr x) (lambda (s _)
(push (concat prefix s) dropped)))
- (message "Not registering prefix \"%s\" from %s. Affects: %S"
- prefix file dropped)
+ (message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S"
+ file prefix dropped)
nil))))
prefixes)))
`(register-definition-prefixes ,file ',(sort (delq nil strings)
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 75c732269e2..4382985eb85 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -74,7 +74,7 @@
cmpfun)
(defmacro avl-tree--root (tree)
- ;; Return the root node for an AVL tree. INTERNAL USE ONLY.
+ "Return the root node for an AVL TREE. INTERNAL USE ONLY."
`(avl-tree--node-left (avl-tree--dummyroot ,tree)))
;; ----------------------------------------------------------------
@@ -117,11 +117,11 @@ NODE is the node, and BRANCH is the branch.
`(- 1 ,dir))
(defmacro avl-tree--dir-to-sign (dir)
- "Convert direction (0,1) to sign factor (-1,+1)."
+ "Convert direction DIR (0,1) to sign factor (-1,+1)."
`(1- (* 2 ,dir)))
(defmacro avl-tree--sign-to-dir (dir)
- "Convert sign factor (-x,+x) to direction (0,1)."
+ "Convert sign factor in DIR (-x,+x) to direction (0,1)."
`(if (< ,dir 0) 0 1))
@@ -129,7 +129,7 @@ NODE is the node, and BRANCH is the branch.
;; Deleting data
(defun avl-tree--del-balance (node branch dir)
- "Rebalance a tree after deleting a node.
+ "Rebalance a tree after deleting a NODE.
The deletion was done from the left (DIR=0) or right (DIR=1) sub-tree
of the left (BRANCH=0) or right (BRANCH=1) child of NODE.
Return t if the height of the tree has shrunk."
@@ -247,9 +247,9 @@ the related data."
;; Entering data
(defun avl-tree--enter-balance (node branch dir)
- "Rebalance tree after an insertion
-into the left (DIR=0) or right (DIR=1) sub-tree of the
-left (BRANCH=0) or right (BRANCH=1) child of NODE.
+ "Rebalance tree after insertion of NODE.
+NODE was inserted into the left (DIR=0) or right (DIR=1) sub-tree
+of the left (BRANCH=0) or right (BRANCH=1) child of NODE.
Return t if the height of the tree has grown."
(let ((br (avl-tree--node-branch node branch))
;; opposite direction: 0,1 -> 1,0
@@ -337,7 +337,7 @@ inserted data."
))))
(defun avl-tree--check (tree)
- "Check the tree's balance."
+ "Check the balance of TREE."
(avl-tree--check-node (avl-tree--root tree)))
(defun avl-tree--check-node (node)
(if (null node) 0
@@ -379,7 +379,8 @@ itself."
;;; INTERNAL USE ONLY
(defun avl-tree--do-copy (root)
- "Copy the AVL tree with ROOT as root. Highly recursive."
+ "Copy the AVL tree wiath ROOT as root.
+This function is highly recursive."
(if (null root)
nil
(avl-tree--node-create
@@ -405,8 +406,9 @@ itself."
\n(fn OBJ)")
(defun avl-tree--stack-repopulate (stack)
- ;; Recursively push children of the node at the head of STACK onto the
- ;; front of the STACK, until a leaf is reached.
+ "Recursively push children of STACK onto the front.
+This pushes the children of the node at the head of STACK onto
+the front of STACK, until a leaf node is reached."
(let ((node (car (avl-tree--stack-store stack)))
(dir (if (avl-tree--stack-reverse stack) 1 0)))
(when node ; check for empty stack
@@ -429,7 +431,7 @@ and returns non-nil if A is less than B, and nil otherwise.
\n(fn TREE)")
(defun avl-tree-empty (tree)
- "Return t if AVL tree TREE is empty, otherwise return nil."
+ "Return t if AVL TREE is empty, otherwise return nil."
(null (avl-tree--root tree)))
(defun avl-tree-enter (tree data &optional updatefun)
@@ -451,7 +453,7 @@ Returns the new data."
0 data updatefun)))
(defun avl-tree-delete (tree data &optional test nilflag)
- "Delete the element matching DATA from the AVL tree TREE.
+ "Delete the element matching DATA from the AVL TREE.
Matching uses the comparison function previously specified in
`avl-tree-create' when TREE was created.
@@ -473,7 +475,7 @@ value is non-nil."
(defun avl-tree-member (tree data &optional nilflag)
- "Return the element in the AVL tree TREE which matches DATA.
+ "Return the element in the AVL TREE which matches DATA.
Matching uses the comparison function previously specified in
`avl-tree-create' when TREE was created.
@@ -496,7 +498,7 @@ for you.)"
(defun avl-tree-member-p (tree data)
- "Return t if an element matching DATA exists in the AVL tree TREE.
+ "Return t if an element matching DATA exists in the AVL TREE.
Otherwise return nil. Matching uses the comparison function
previously specified in `avl-tree-create' when TREE was created."
(let ((flag '(nil)))
@@ -504,13 +506,13 @@ previously specified in `avl-tree-create' when TREE was created."
(defun avl-tree-map (fun tree &optional reverse)
- "Modify all elements in the AVL tree TREE by applying FUNCTION.
+ "Modify all elements in the AVL TREE by applying function FUN.
-Each element is replaced by the return value of FUNCTION applied
-to that element.
+Each element is replaced by the return value of FUN applied to
+that element.
-FUNCTION is applied to the elements in ascending order, or
-descending order if REVERSE is non-nil."
+FUN is applied to the elements in ascending order, or descending
+order if REVERSE is non-nil."
(avl-tree--mapc
(lambda (node)
(setf (avl-tree--node-data node)
@@ -520,8 +522,7 @@ descending order if REVERSE is non-nil."
(defun avl-tree-mapc (fun tree &optional reverse)
- "Apply FUNCTION to all elements in AVL tree TREE,
-for side-effect only.
+ "Apply function FUN to all elements in AVL TREE, for side-effect only.
FUNCTION is applied to the elements in ascending order, or
descending order if REVERSE is non-nil."
@@ -534,8 +535,7 @@ descending order if REVERSE is non-nil."
(defun avl-tree-mapf
(fun combinator tree &optional reverse)
- "Apply FUNCTION to all elements in AVL tree TREE,
-and combine the results using COMBINATOR.
+ "Apply FUN to all elements in AVL TREE, combine results using COMBINATOR.
The FUNCTION is applied and the results are combined in ascending
order, or descending order if REVERSE is non-nil."
@@ -553,8 +553,7 @@ order, or descending order if REVERSE is non-nil."
(defun avl-tree-mapcar (fun tree &optional reverse)
- "Apply function FUN to all elements in AVL tree TREE,
-and make a list of the results.
+ "Apply FUN to all elements in AVL TREE, and make a list of the results.
The function is applied and the list constructed in ascending
order, or descending order if REVERSE is non-nil.
@@ -586,7 +585,7 @@ is more efficient."
(avl-tree--node-data node))))
(defun avl-tree-copy (tree)
- "Return a copy of the AVL tree TREE."
+ "Return a copy of the AVL TREE."
(let ((new-tree (avl-tree-create (avl-tree--cmpfun tree))))
(setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree)))
new-tree))
@@ -608,13 +607,12 @@ is more efficient."
treesize))
(defun avl-tree-clear (tree)
- "Clear the AVL tree TREE."
+ "Clear the AVL TREE."
(setf (avl-tree--root tree) nil))
(defun avl-tree-stack (tree &optional reverse)
- "Return an object that behaves like a sorted stack
-of all elements of TREE.
+ "Return an object that behaves like a sorted stack of all elements of TREE.
If REVERSE is non-nil, the stack is sorted in reverse order.
\(See also `avl-tree-stack-pop').
@@ -655,8 +653,7 @@ a null element stored in the AVL tree.)"
(defun avl-tree-stack-first (avl-tree-stack &optional nilflag)
- "Return the first element of AVL-TREE-STACK, without removing it
-from the stack.
+ "Return the first element of AVL-TREE-STACK, without removing it from stack.
Returns nil if the stack is empty, or NILFLAG if specified.
\(The latter allows an empty stack to be distinguished from
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 3e1c3292650..ea70baa9532 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -190,7 +190,7 @@ This is commonly used to recompute `backtrace-frames'.")
(defvar-local backtrace-print-function #'cl-prin1
"Function used to print values in the current Backtrace buffer.")
-(defvar-local backtrace-goto-source-functions nil
+(defvar backtrace-goto-source-functions nil
"Abnormal hook used to jump to the source code for the current frame.
Each hook function is called with no argument, and should return
non-nil if it is able to switch to the buffer containing the
@@ -638,10 +638,8 @@ content of the sexp."
(source-available (plist-get (backtrace-frame-flags frame)
:source-available)))
(unless (and source-available
- (catch 'done
- (dolist (func backtrace-goto-source-functions)
- (when (funcall func)
- (throw 'done t)))))
+ (run-hook-with-args-until-success
+ 'backtrace-goto-source-functions))
(user-error "Source code location not known"))))
(defun backtrace-help-follow-symbol (&optional pos)
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 14bc2817390..64c628822df 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -31,16 +31,72 @@
;;; Code:
+(eval-when-compile (require 'subr-x)) ;For `named-let'.
+
(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")))
- `(let (,t1)
- (setq ,t1 (current-time))
+ `(let ((,t1 (current-time)))
,@forms
(float-time (time-since ,t1)))))
;;;###autoload
+(defun benchmark-call (func &optional repetitions)
+ "Measure the run time of calling FUNC a number REPETITIONS of times.
+The result is a list (TIME GC GCTIME)
+where TIME is the total time it took, in seconds.
+GCTIME is the amount of time that was spent in the GC
+and GC is the number of times the GC was called.
+
+REPETITIONS can also be a floating point number, in which case it
+specifies a minimum number of seconds that the benchmark execution
+should take. In that case the return value is prepended with the
+number of repetitions actually used."
+ (if (floatp repetitions)
+ (benchmark--adaptive func repetitions)
+ (unless repetitions (setq repetitions 1))
+ (let ((gc gc-elapsed)
+ (gcs gcs-done)
+ (empty-func (lambda () 'empty-func)))
+ (list
+ (if (> repetitions 1)
+ (- (benchmark-elapse (dotimes (_ repetitions) (funcall func)))
+ (benchmark-elapse (dotimes (_ repetitions) (funcall empty-func))))
+ (- (benchmark-elapse (funcall func))
+ (benchmark-elapse (funcall empty-func))))
+ (- gcs-done gcs)
+ (- gc-elapsed gc)))))
+
+(defun benchmark--adaptive (func time)
+ "Measure the run time of FUNC, calling it enough times to last TIME seconds.
+Result is (REPETITIONS . DATA) where DATA is as returned by `branchmark-call'."
+ (named-let loop ((repetitions 1)
+ (data (let ((x (list 0))) (setcdr x x) x)))
+ ;; (message "Running %d iteration" repetitions)
+ (let ((newdata (benchmark-call func repetitions)))
+ (if (<= (car newdata) 0)
+ ;; This can happen if we're unlucky, e.g. the process got preempted
+ ;; (or the GC ran) just during the empty-func loop.
+ ;; Just try again, hopefully this won't repeat itself.
+ (progn
+ ;; (message "Ignoring the %d iterations" repetitions)
+ (loop (* 2 repetitions) data))
+ (let* ((sum (cl-mapcar #'+ data (cons repetitions newdata)))
+ (totaltime (nth 1 sum)))
+ (if (>= totaltime time)
+ sum
+ (let* ((iter-time (/ totaltime (car sum)))
+ (missing-time (- time totaltime))
+ (missing-iter (/ missing-time iter-time)))
+ ;; `iter-time' is approximate because of effects like the GC,
+ ;; so multiply at most by 10, in case we are wildly off the mark.
+ (loop (max repetitions
+ (min (ceiling missing-iter)
+ (* 10 repetitions)))
+ sum))))))))
+
+;;;###autoload
(defmacro benchmark-run (&optional repetitions &rest forms)
"Time execution of FORMS.
If REPETITIONS is supplied as a number, run FORMS that many times,
@@ -53,19 +109,7 @@ See also `benchmark-run-compiled'."
(unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
(setq forms (cons repetitions forms)
repetitions 1))
- (let ((i (make-symbol "i"))
- (gcs (make-symbol "gcs"))
- (gc (make-symbol "gc")))
- `(let ((,gc gc-elapsed)
- (,gcs gcs-done))
- (list ,(if (or (symbolp repetitions) (> repetitions 1))
- ;; Take account of the loop overhead.
- `(- (benchmark-elapse (dotimes (,i ,repetitions)
- ,@forms))
- (benchmark-elapse (dotimes (,i ,repetitions))))
- `(benchmark-elapse ,@forms))
- (- gcs-done ,gcs)
- (- gc-elapsed ,gc)))))
+ `(benchmark-call (lambda () ,@forms) ,repetitions))
;;;###autoload
(defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@@ -77,21 +121,7 @@ result. The overhead of the `lambda's is accounted for."
(unless (or (natnump repetitions) (and repetitions (symbolp repetitions)))
(setq forms (cons repetitions forms)
repetitions 1))
- (let ((i (make-symbol "i"))
- (gcs (make-symbol "gcs"))
- (gc (make-symbol "gc"))
- (code (byte-compile `(lambda () ,@forms)))
- (lambda-code (byte-compile '(lambda ()))))
- `(let ((,gc gc-elapsed)
- (,gcs gcs-done))
- (list ,(if (or (symbolp repetitions) (> repetitions 1))
- ;; Take account of the loop overhead.
- `(- (benchmark-elapse (dotimes (,i ,repetitions)
- (funcall ,code)))
- (benchmark-elapse (dotimes (,i ,repetitions)
- (funcall ,lambda-code))))
- `(benchmark-elapse (funcall ,code)))
- (- gcs-done ,gcs) (- gc-elapsed ,gc)))))
+ `(benchmark-call (byte-compile '(lambda () ,@forms)) ,repetitions))
;;;###autoload
(defun benchmark (repetitions form)
@@ -99,9 +129,15 @@ result. The overhead of the `lambda's is accounted for."
Interactively, REPETITIONS is taken from the prefix arg, and
the command prompts for the form to benchmark.
For non-interactive use see also `benchmark-run' and
-`benchmark-run-compiled'."
+`benchmark-run-compiled'.
+FORM can also be a function in which case we measure the time it takes
+to call it without any argument."
(interactive "p\nxForm: ")
- (let ((result (eval `(benchmark-run ,repetitions ,form) t)))
+ (let ((result (benchmark-call (eval (pcase form
+ ((or `#',_ `(lambda . ,_)) form)
+ (_ `(lambda () ,form)))
+ t)
+ repetitions)))
(if (zerop (nth 1 result))
(message "Elapsed time: %fs" (car result))
(message "Elapsed time: %fs (%fs in %d GCs)" (car result)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0d9ba57d663..76c2e80fda8 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -26,7 +26,7 @@
;; Packing and unpacking of (binary) data structures.
;;
;; The data formats used in binary files and network protocols are
-;; often structed data which can be described by a C-style structure
+;; often structured data which can be described by a C-style structure
;; such as the one shown below. Using the bindat package, decoding
;; and encoding binary data formats like these is made simple using a
;; structure specification which closely resembles the C style
@@ -41,57 +41,61 @@
;; Consider the following C structures:
;;
;; struct header {
-;; unsigned long dest_ip;
-;; unsigned long src_ip;
-;; unsigned short dest_port;
-;; unsigned short src_port;
+;; uint32_t dest_ip;
+;; uint32_t src_ip;
+;; uint16_t dest_port;
+;; uint16_t src_port;
;; };
;;
;; struct data {
-;; unsigned char type;
-;; unsigned char opcode;
-;; unsigned long length; /* In little endian order */
+;; uint8_t type;
+;; uint8_t opcode;
+;; uint32_t length; /* In little endian order */
;; unsigned char id[8]; /* nul-terminated string */
;; unsigned char data[/* (length + 3) & ~3 */];
;; };
;;
;; struct packet {
;; struct header header;
-;; unsigned char items;
+;; uint8_t items;
;; unsigned char filler[3];
;; struct data item[/* items */];
;; };
;;
-;; The corresponding Lisp bindat specification looks like this:
+;; The corresponding Lisp bindat specification could look like this:
+;;
+;; (bindat-defmacro ip () '(vec 4 byte))
;;
;; (setq header-bindat-spec
-;; '((dest-ip ip)
+;; (bindat-type
+;; (dest-ip ip)
;; (src-ip ip)
-;; (dest-port u16)
-;; (src-port u16)))
+;; (dest-port uint 16)
+;; (src-port uint 16)))
;;
;; (setq data-bindat-spec
-;; '((type u8)
+;; (bindat-type
+;; (type u8)
;; (opcode u8)
-;; (length u16r) ;; little endian order
+;; (length uintr 32) ;; little endian order
;; (id strz 8)
-;; (data vec (length))
-;; (align 4)))
+;; (data vec length)
+;; (_ align 4)))
;;
;; (setq packet-bindat-spec
-;; '((header struct header-bindat-spec)
-;; (items u8)
-;; (fill 3)
-;; (item repeat (items)
-;; (struct data-bindat-spec))))
-;;
+;; (bindat-type
+;; (header type header-bindat-spec)
+;; (nitems u8)
+;; (_ fill 3)
+;; (items repeat nitems type data-bindat-spec)))
;;
;; A binary data representation may look like
;; [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0
;; 2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0
;; 1 4 7 0 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ]
;;
-;; The corresponding decoded structure looks like
+;; The corresponding decoded structure returned by `bindat-unpack' (or taken
+;; by `bindat-pack') looks like:
;;
;; ((header
;; (dest-ip . [192 168 1 100])
@@ -111,92 +115,28 @@
;; (type . 1))))
;;
;; To access a specific value in this structure, use the function
-;; bindat-get-field with the structure as first arg followed by a list
+;; `bindat-get-field' with the structure as first arg followed by a list
;; of field names and array indexes, e.g. using the data above,
;; (bindat-get-field decoded-structure 'item 1 'id)
;; returns "BCDEFG".
-;; Binary Data Structure Specification Format
-;; ------------------------------------------
-
-;; We recommend using names that end in `-bindat-spec'; such names
-;; are recognized automatically as "risky" variables.
-
-;; The data specification is formatted as follows:
-
-;; SPEC ::= ( ITEM... )
-
-;; ITEM ::= ( [FIELD] TYPE )
-;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only
-;; | ( [FIELD] fill LEN ) -- skip LEN bytes
-;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes
-;; | ( [FIELD] struct SPEC_NAME )
-;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] )
-;; | ( [FIELD] repeat COUNT ITEM... )
-
-;; -- In (eval EXPR), the value of the last field is available in
-;; the dynamically bound variable `last'.
-
-;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE
-;; | u8 | byte -- length 1
-;; | u16 | word | short -- length 2, network byte order
-;; | u24 -- 3-byte value
-;; | u32 | dword | long -- length 4, network byte order
-;; | u16r | u24r | u32r -- little endian byte order.
-;; | str LEN -- LEN byte string
-;; | strz LEN -- LEN byte (zero-terminated) string
-;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8)
-;; | ip -- 4 byte vector
-;; | bits LEN -- List with bits set in LEN bytes.
-;;
-;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
-;; and 0x1c 0x28 to (3 5 10 11 12).
-
-;; FIELD ::= ( eval EXPR ) -- use result as NAME
-;; | NAME
-
-;; LEN ::= ARG
-;; | <omitted> | nil -- LEN = 1
-
-
-;; TAG_VAL ::= ARG
-
-;; TAG ::= LISP_CONSTANT
-;; | ( eval EXPR ) -- return non-nil if tag match;
-;; current TAG_VAL in `tag'.
-
-;; ARG ::= ( eval EXPR ) -- interpret result as ARG
-;; | INTEGER_CONSTANT
-;; | DEREF
-
-;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative
-;; to current structure spec.
-;; -- see bindat-get-field
-
-;; A `union' specification
-;; ([FIELD] union TAG_VAL (TAG SPEC) ... [(t SPEC)])
-;; is interpreted by evalling TAG_VAL and then comparing that to
-;; each TAG using equal; if a match is found, the corresponding SPEC
-;; is used.
-;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
-;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil.
-;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
-;;
-;; An `eval' specification
-;; ([FIELD] eval FORM)
-;; is interpreted by evalling FORM for its side effects only.
-;; If FIELD is specified, the value is bound to that field.
-;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack').
-
;;; Code:
;; Helper functions for structure unpacking.
-;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
+;; Relies on dynamic binding of `bindat-raw' and `bindat-idx'.
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x)) ;For `named-let'.
+
+(cl-defstruct (bindat--type
+ (:predicate nil)
+ (:constructor bindat--make))
+ le ue pe)
(defvar bindat-raw)
(defvar bindat-idx)
-(defun bindat--unpack-u8 ()
+(defsubst bindat--unpack-u8 ()
(prog1
(aref bindat-raw bindat-idx)
(setq bindat-idx (1+ bindat-idx))))
@@ -219,77 +159,79 @@
(defun bindat--unpack-u32r ()
(logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16)))
+(defun bindat--unpack-str (len)
+ (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
+ (setq bindat-idx (+ bindat-idx len))
+ (if (stringp s) s
+ (apply #'unibyte-string s))))
+
+(defun bindat--unpack-strz (len)
+ (let ((i 0) s)
+ (while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0))
+ (setq i (1+ i)))
+ (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
+ (setq bindat-idx (+ bindat-idx len))
+ (if (stringp s) s
+ (apply #'unibyte-string s))))
+
+(defun bindat--unpack-bits (len)
+ (let ((bits nil) (bnum (1- (* 8 len))) j m)
+ (while (>= bnum 0)
+ (if (= (setq m (bindat--unpack-u8)) 0)
+ (setq bnum (- bnum 8))
+ (setq j 128)
+ (while (> j 0)
+ (if (/= 0 (logand m j))
+ (setq bits (cons bnum bits)))
+ (setq bnum (1- bnum)
+ j (ash j -1)))))
+ bits))
+
(defun bindat--unpack-item (type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
- (cond
- ((memq type '(u8 byte))
- (bindat--unpack-u8))
- ((memq type '(u16 word short))
- (bindat--unpack-u16))
- ((eq type 'u24)
- (bindat--unpack-u24))
- ((memq type '(u32 dword long))
- (bindat--unpack-u32))
- ((eq type 'u16r)
- (bindat--unpack-u16r))
- ((eq type 'u24r)
- (bindat--unpack-u24r))
- ((eq type 'u32r)
- (bindat--unpack-u32r))
- ((eq type 'bits)
- (let ((bits nil) (bnum (1- (* 8 len))) j m)
- (while (>= bnum 0)
- (if (= (setq m (bindat--unpack-u8)) 0)
- (setq bnum (- bnum 8))
- (setq j 128)
- (while (> j 0)
- (if (/= 0 (logand m j))
- (setq bits (cons bnum bits)))
- (setq bnum (1- bnum)
- j (ash j -1)))))
- bits))
- ((eq type 'str)
- (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
- (setq bindat-idx (+ bindat-idx len))
- (if (stringp s) s
- (apply #'unibyte-string s))))
- ((eq type 'strz)
- (let ((i 0) s)
- (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
- (setq i (1+ i)))
- (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
- (setq bindat-idx (+ bindat-idx len))
- (if (stringp s) s
- (apply #'unibyte-string s))))
- ((eq type 'vec)
- (let ((v (make-vector len 0)) (i 0) (vlen 1))
+ (pcase type
+ ((or 'u8 'byte) (bindat--unpack-u8))
+ ((or 'u16 'word 'short) (bindat--unpack-u16))
+ ('u24 (bindat--unpack-u24))
+ ((or 'u32 'dword 'long) (bindat--unpack-u32))
+ ('u16r (bindat--unpack-u16r))
+ ('u24r (bindat--unpack-u24r))
+ ('u32r (bindat--unpack-u32r))
+ ('bits (bindat--unpack-bits len))
+ ('str (bindat--unpack-str len))
+ ('strz (bindat--unpack-strz len))
+ ('vec
+ (let ((v (make-vector len 0)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
vectype (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))
- (while (< i len)
- (aset v i (bindat--unpack-item type vlen vectype))
- (setq i (1+ i)))
+ (dotimes (i len)
+ (aset v i (bindat--unpack-item type vlen vectype)))
v))
- (t nil)))
+ (_ nil)))
+
+(defsubst bindat--align (n len)
+ (* len (/ (+ n (1- len)) len))) ;Isn't there a simpler way?
(defun bindat--unpack-group (spec)
- (with-suppressed-warnings ((lexical last))
- (defvar last))
+ ;; FIXME: Introduce a new primitive so we can mark `bindat-unpack'
+ ;; as obsolete (maybe that primitive should be a macro which takes
+ ;; a bindat type *expression* as argument).
+ (if (cl-typep spec 'bindat--type)
+ (funcall (bindat--type-ue spec))
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
(let (struct last)
- (while spec
- (let* ((item (car spec))
- (field (car item))
+ (dolist (item spec)
+ (let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3)
data)
- (setq spec (cdr spec))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@@ -299,29 +241,28 @@
len type
type field
field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
- (cond
- ((eq type 'eval)
+ (pcase type
+ ('eval
(if field
(setq data (eval len t))
(eval len t)))
- ((eq type 'fill)
+ ('fill
(setq bindat-idx (+ bindat-idx len)))
- ((eq type 'align)
- (while (/= (% bindat-idx len) 0)
- (setq bindat-idx (1+ bindat-idx))))
- ((eq type 'struct)
+ ('align
+ (setq bindat-idx (bindat--align bindat-idx len)))
+ ('struct
(setq data (bindat--unpack-group (eval len t))))
- ((eq type 'repeat)
- (let ((index 0) (count len))
- (while (< index count)
- (push (bindat--unpack-group (nthcdr tail item)) data)
- (setq index (1+ index)))
- (setq data (nreverse data))))
- ((eq type 'union)
+ ('repeat
+ (dotimes (_ len)
+ (push (bindat--unpack-group (nthcdr tail item)) data))
+ (setq data (nreverse data)))
+ ('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -333,14 +274,15 @@
(and (consp cc) (eval cc t)))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
- (t
+ ((pred integerp) (debug t))
+ (_
(setq data (bindat--unpack-item type len vectype)
last data)))
(if data
(setq struct (if field
(cons (cons field data) struct)
(append data struct))))))
- struct))
+ struct)))
(defun bindat-unpack (spec raw &optional idx)
"Return structured data according to SPEC for binary data in RAW.
@@ -361,14 +303,12 @@ An integer value in the field list is taken as an array index,
e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(while (and struct field)
(setq struct (if (integerp (car field))
- (nth (car field) struct)
- (let ((val (assq (car field) struct)))
- (if (consp val) (cdr val)))))
+ (elt struct (car field))
+ (cdr (assq (car field) struct))))
(setq field (cdr field)))
struct)
-
-;; Calculate bindat-raw length of structured data
+;;;; Calculate bindat-raw length of structured data
(defvar bindat--fixed-length-alist
'((u8 . 1) (byte . 1)
@@ -378,19 +318,17 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(ip . 4)))
(defun bindat--length-group (struct spec)
- (with-suppressed-warnings ((lexical last))
- (defvar last))
- (let (last)
- (while spec
- (let* ((item (car spec))
- (field (car item))
+ (if (cl-typep spec 'bindat--type)
+ (funcall (bindat--type-le spec) struct)
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
+ (let ((struct struct) last)
+ (dolist (item spec)
+ (let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
- (setq spec (cdr spec))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@@ -400,6 +338,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
len type
type field
field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
@@ -410,27 +350,24 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil)))
- (cond
- ((eq type 'eval)
+ (pcase type
+ ('eval
(if field
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
- ((eq type 'fill)
+ ('fill
(setq bindat-idx (+ bindat-idx len)))
- ((eq type 'align)
- (while (/= (% bindat-idx len) 0)
- (setq bindat-idx (1+ bindat-idx))))
- ((eq type 'struct)
+ ('align
+ (setq bindat-idx (bindat--align bindat-idx len)))
+ ('struct
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len t)))
- ((eq type 'repeat)
- (let ((index 0) (count len))
- (while (< index count)
- (bindat--length-group
- (nth index (bindat-get-field struct field))
- (nthcdr tail item))
- (setq index (1+ index)))))
- ((eq type 'union)
+ ('repeat
+ (dotimes (index len)
+ (bindat--length-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))))
+ ('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -443,23 +380,23 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
- (t
+ (_
(if (setq type (assq type bindat--fixed-length-alist))
(setq len (* len (cdr type))))
(if field
(setq last (bindat-get-field struct field)))
- (setq bindat-idx (+ bindat-idx len))))))))
+ (setq bindat-idx (+ bindat-idx len)))))))))
(defun bindat-length (spec struct)
- "Calculate bindat-raw length for STRUCT according to bindat SPEC."
+ "Calculate `bindat-raw' length for STRUCT according to bindat SPEC."
(let ((bindat-idx 0))
(bindat--length-group struct spec)
bindat-idx))
-;; Pack structured data into bindat-raw
+;;;; Pack structured data into bindat-raw
-(defun bindat--pack-u8 (v)
+(defsubst bindat--pack-u8 (v)
(aset bindat-raw bindat-idx (logand v 255))
(setq bindat-idx (1+ bindat-idx)))
@@ -476,6 +413,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u16 (ash v -16))
(bindat--pack-u16 v))
+(defun bindat--pack-u64 (v)
+ (bindat--pack-u32 (ash v -32))
+ (bindat--pack-u32 v))
+
(defun bindat--pack-u16r (v)
(aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255))
(aset bindat-raw bindat-idx (logand v 255))
@@ -489,74 +430,74 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-u16r v)
(bindat--pack-u16r (ash v -16)))
+(defun bindat--pack-u64r (v)
+ (bindat--pack-u32r v)
+ (bindat--pack-u32r (ash v -32)))
+
+(defun bindat--pack-str (len v)
+ (dotimes (i (min len (length v)))
+ (aset bindat-raw (+ bindat-idx i) (aref v i)))
+ (setq bindat-idx (+ bindat-idx len)))
+
+(defun bindat--pack-strz (v)
+ (let ((len (length v)))
+ (dotimes (i len)
+ (aset bindat-raw (+ bindat-idx i) (aref v i)))
+ (setq bindat-idx (+ bindat-idx len 1))))
+
+(defun bindat--pack-bits (len v)
+ (let ((bnum (1- (* 8 len))) j m)
+ (while (>= bnum 0)
+ (setq m 0)
+ (if (null v)
+ (setq bnum (- bnum 8))
+ (setq j 128)
+ (while (> j 0)
+ (if (memq bnum v)
+ (setq m (logior m j)))
+ (setq bnum (1- bnum)
+ j (ash j -1))))
+ (bindat--pack-u8 m))))
+
(defun bindat--pack-item (v type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
- (cond
- ((null v)
- (setq bindat-idx (+ bindat-idx len)))
- ((memq type '(u8 byte))
- (bindat--pack-u8 v))
- ((memq type '(u16 word short))
- (bindat--pack-u16 v))
- ((eq type 'u24)
- (bindat--pack-u24 v))
- ((memq type '(u32 dword long))
- (bindat--pack-u32 v))
- ((eq type 'u16r)
- (bindat--pack-u16r v))
- ((eq type 'u24r)
- (bindat--pack-u24r v))
- ((eq type 'u32r)
- (bindat--pack-u32r v))
- ((eq type 'bits)
- (let ((bnum (1- (* 8 len))) j m)
- (while (>= bnum 0)
- (setq m 0)
- (if (null v)
- (setq bnum (- bnum 8))
- (setq j 128)
- (while (> j 0)
- (if (memq bnum v)
- (setq m (logior m j)))
- (setq bnum (1- bnum)
- j (ash j -1))))
- (bindat--pack-u8 m))))
- ((memq type '(str strz))
- (let ((l (length v)) (i 0))
- (if (> l len) (setq l len))
- (while (< i l)
- (aset bindat-raw (+ bindat-idx i) (aref v i))
- (setq i (1+ i)))
- (setq bindat-idx (+ bindat-idx len))))
- ((eq type 'vec)
- (let ((l (length v)) (i 0) (vlen 1))
+ (pcase type
+ ((guard (null v)) (setq bindat-idx (+ bindat-idx len)))
+ ((or 'u8 'byte) (bindat--pack-u8 v))
+ ((or 'u16 'word 'short) (bindat--pack-u16 v))
+ ('u24 (bindat--pack-u24 v))
+ ((or 'u32 'dword 'long) (bindat--pack-u32 v))
+ ('u16r (bindat--pack-u16r v))
+ ('u24r (bindat--pack-u24r v))
+ ('u32r (bindat--pack-u32r v))
+ ('bits (bindat--pack-bits len v))
+ ((or 'str 'strz) (bindat--pack-str len v))
+ ('vec
+ (let ((l (length v)) (vlen 1))
(if (consp vectype)
(setq vlen (nth 1 vectype)
vectype (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))
(if (> l len) (setq l len))
- (while (< i l)
- (bindat--pack-item (aref v i) type vlen vectype)
- (setq i (1+ i)))))
- (t
+ (dotimes (i l)
+ (bindat--pack-item (aref v i) type vlen vectype))))
+ (_
(setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
- (with-suppressed-warnings ((lexical last))
- (defvar last))
- (let (last)
- (while spec
- (let* ((item (car spec))
- (field (car item))
+ (if (cl-typep spec 'bindat--type)
+ (funcall (bindat--type-pe spec) struct)
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
+ (let ((struct struct) last)
+ (dolist (item spec)
+ (let* ((field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
- (setq spec (cdr spec))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)) t)))
(if (and len (consp len) (eq (car len) 'eval))
@@ -566,31 +507,30 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
len type
type field
field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
- (cond
- ((eq type 'eval)
+ (pcase type
+ ('eval
(if field
(setq struct (cons (cons field (eval len t)) struct))
(eval len t)))
- ((eq type 'fill)
+ ('fill
(setq bindat-idx (+ bindat-idx len)))
- ((eq type 'align)
- (while (/= (% bindat-idx len) 0)
- (setq bindat-idx (1+ bindat-idx))))
- ((eq type 'struct)
+ ('align
+ (setq bindat-idx (bindat--align bindat-idx len)))
+ ('struct
(bindat--pack-group
(if field (bindat-get-field struct field) struct) (eval len t)))
- ((eq type 'repeat)
- (let ((index 0) (count len))
- (while (< index count)
- (bindat--pack-group
- (nth index (bindat-get-field struct field))
- (nthcdr tail item))
- (setq index (1+ index)))))
- ((eq type 'union)
+ ('repeat
+ (dotimes (index len)
+ (bindat--pack-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))))
+ ('union
(with-suppressed-warnings ((lexical tag))
(defvar tag))
(let ((tag len) (cases (nthcdr tail item)) case cc)
@@ -603,10 +543,10 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(progn
(bindat--pack-group struct (cdr case))
(setq cases nil))))))
- (t
+ (_
(setq last (bindat-get-field struct field))
(bindat--pack-item last type len vectype)
- ))))))
+ )))))))
(defun bindat-pack (spec struct &optional raw idx)
"Return binary data packed according to SPEC for structured data STRUCT.
@@ -622,21 +562,15 @@ Optional fourth arg IDX is the starting offset into RAW."
(bindat--pack-group struct spec)
(if raw nil bindat-raw)))
-
-;; Misc. format conversions
+;;;; Misc. format conversions
(defun bindat-format-vector (vect fmt sep &optional len)
"Format vector VECT using element format FMT and separator SEP.
Result is a string with each element of VECT formatted using FMT and
separated by the string SEP. If optional fourth arg LEN is given, use
only that many elements from VECT."
- (unless len
- (setq len (length vect)))
- (let ((i len) (fmt2 (concat sep fmt)) (s nil))
- (while (> i 0)
- (setq i (1- i)
- s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
- (apply #'concat s)))
+ (when len (setq vect (substring vect 0 len)))
+ (mapconcat (lambda (x) (format fmt x)) vect sep))
(defun bindat-vector-to-dec (vect &optional sep)
"Format vector VECT in decimal format separated by dots.
@@ -656,6 +590,393 @@ The port (if any) is omitted. IP can be a string, as well."
(format "%d.%d.%d.%d"
(aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))))
+;;;; New approach based on macro-expansion
+
+;; Further improvements suggested by reading websocket.el:
+;; - Support for bit-sized fields?
+;;
+;; - Add some way to verify redundant/checksum fields's contents without
+;; having to provide a complete `:unpack-val' expression.
+;; The `:pack-val' thingy can work nicely to compute checksum fields
+;; based on previous fields's contents (without impacting or being impacted
+;; by the unpacked representation), but if we want to verify
+;; those checksums when unpacking, we have to use the :unpack-val
+;; and build the whole object by hand instead of being able to focus
+;; just on the checksum field.
+;; Maybe this could be related to `unit' type fields where we might like
+;; to make sure that the "value" we write into it is the same as the
+;; value it holds (tho those checks don't happen at the same time (pack
+;; vs unpack).
+;;
+;; - Support for packing/unpacking to/from something else than
+;; a unibyte string, e.g. from a buffer. Problems to do that are:
+;; - the `str' and `strz' types which use `substring' rather than reading
+;; one byte at a time.
+;; - the `align' and `fill' which just want to skip without reading/writing
+;; - the `pack-uint' case, which would prefer writing the LSB first.
+;; - the `align' case needs to now the current position in order to know
+;; how far to advance
+;;
+;; - Don't write triple code when the type is only ever used at a single place
+;; (e.g. to unpack).
+
+(defun bindat--unpack-uint (bitlen)
+ (let ((v 0) (bitsdone 0))
+ (while (< bitsdone bitlen)
+ (setq v (logior (ash v 8) (bindat--unpack-u8)))
+ (setq bitsdone (+ bitsdone 8)))
+ v))
+
+(defun bindat--unpack-uintr (bitlen)
+ (let ((v 0) (bitsdone 0))
+ (while (< bitsdone bitlen)
+ (setq v (logior v (ash (bindat--unpack-u8) bitsdone)))
+ (setq bitsdone (+ bitsdone 8)))
+ v))
+
+(defun bindat--pack-uint (bitlen v)
+ (let* ((len (/ bitlen 8))
+ (shift (- (* 8 (1- len)))))
+ (dotimes (_ len)
+ (bindat--pack-u8 (logand 255 (ash v shift)))
+ (setq shift (+ 8 shift)))))
+
+(defun bindat--pack-uintr (bitlen v)
+ (let* ((len (/ bitlen 8)))
+ (dotimes (_ len)
+ (bindat--pack-u8 (logand v 255))
+ (setq v (ash v -8)))))
+
+(defmacro bindat--pcase (&rest args)
+ "Like `pcase' but optimize the code under the assumption that it's exhaustive."
+ (declare (indent 1) (debug pcase))
+ `(pcase ,@args (pcase--dontcare nil)))
+
+(cl-defgeneric bindat--type (op head &rest args)
+ "Return the code for the operation OP of the Bindat type (HEAD . ARGS).
+OP can be one of: unpack', (pack VAL), or (length VAL) where VAL
+is the name of a variable that will hold the value we need to pack.")
+
+(cl-defmethod bindat--type (op (_ (eql 'byte)))
+ (bindat--pcase op
+ ('unpack `(bindat--unpack-u8))
+ (`(length . ,_) `(cl-incf bindat-idx 1))
+ (`(pack . ,args) `(bindat--pack-u8 . ,args))))
+
+(cl-defmethod bindat--type (op (_ (eql 'uint)) n)
+ (if (eq n 8) (bindat--type op 'byte)
+ (bindat--pcase op
+ ('unpack `(bindat--unpack-uint ,n))
+ (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
+ (`(pack . ,args) `(bindat--pack-uint ,n . ,args)))))
+
+(cl-defmethod bindat--type (op (_ (eql 'uintr)) n)
+ (if (eq n 8) (bindat--type op 'byte)
+ (bindat--pcase op
+ ('unpack `(bindat--unpack-uintr ,n))
+ (`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
+ (`(pack . ,args) `(bindat--pack-uintr ,n . ,args)))))
+
+(cl-defmethod bindat--type (op (_ (eql 'str)) len)
+ (bindat--pcase op
+ ('unpack `(bindat--unpack-str ,len))
+ (`(length . ,_) `(cl-incf bindat-idx ,len))
+ (`(pack . ,args) `(bindat--pack-str ,len . ,args))))
+
+(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
+ (bindat--pcase op
+ ('unpack `(bindat--unpack-strz ,len))
+ (`(length ,val)
+ `(cl-incf bindat-idx ,(cond
+ ((null len) `(length ,val))
+ ((numberp len) len)
+ (t `(or ,len (length ,val))))))
+ (`(pack . ,args)
+ (macroexp-let2 nil len len
+ `(if ,len
+ ;; Same as non-zero terminated strings since we don't actually add
+ ;; the terminating zero anyway (because we rely on the fact that
+ ;; `bindat-raw' was presumably initialized with all-zeroes before
+ ;; we started).
+ (bindat--pack-str ,len . ,args)
+ (bindat--pack-strz . ,args))))))
+
+(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
+ (bindat--pcase op
+ ('unpack `(bindat--unpack-bits ,len))
+ (`(length . ,_) `(cl-incf bindat-idx ,len))
+ (`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
+
+(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
+ `(progn (cl-incf bindat-idx ,len) nil))
+
+(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
+ `(progn (cl-callf bindat--align bindat-idx ,len) nil))
+
+(cl-defmethod bindat--type (op (_ (eql 'type)) exp)
+ (bindat--pcase op
+ ('unpack `(funcall (bindat--type-ue ,exp)))
+ (`(length . ,args) `(funcall (bindat--type-le ,exp) . ,args))
+ (`(pack . ,args) `(funcall (bindat--type-pe ,exp) . ,args))))
+
+(cl-defmethod bindat--type (op (_ (eql 'vec)) count &rest type)
+ (unless type (setq type '(byte)))
+ (let ((fun (macroexpand-all (bindat--fun type) macroexpand-all-environment)))
+ (bindat--pcase op
+ ('unpack
+ `(let* ((bindat--len ,count)
+ (bindat--v (make-vector bindat--len 0)))
+ (dotimes (bindat--i bindat--len)
+ (aset bindat--v bindat--i (funcall ,fun)))
+ bindat--v))
+ ((and `(length . ,_)
+ ;; FIXME: Improve the pattern match to recognize more complex
+ ;; "constant" functions?
+ (let `#'(lambda (,val) (setq bindat-idx (+ bindat-idx ,len))) fun)
+ (guard (not (macroexp--fgrep `((,val)) len))))
+ ;; Optimize the case where the size of each element is constant.
+ `(cl-incf bindat-idx (* ,count ,len)))
+ ;; FIXME: It's tempting to use `(mapc (lambda (,val) ,exp) ,val)'
+ ;; which would be more efficient when `val' is a list,
+ ;; but that's only right if length of `val' is indeed `count'.
+ (`(,_ ,val)
+ `(dotimes (bindat--i ,count)
+ (funcall ,fun (elt ,val bindat--i)))))))
+
+(cl-defmethod bindat--type (op (_ (eql 'unit)) val)
+ (pcase op ('unpack val) (_ nil)))
+
+(cl-defmethod bindat--type (op (_ (eql 'struct)) &rest args)
+ (apply #'bindat--type op args))
+
+(cl-defmethod bindat--type (op (_ (eql :pack-var)) var &rest fields)
+ (unless (consp (cdr fields))
+ (error "`:pack-var VAR' needs to be followed by fields"))
+ (bindat--pcase op
+ ((or 'unpack (guard (null var)))
+ (apply #'bindat--type op fields))
+ (`(,_ ,val)
+ `(let ((,var ,val)) ,(apply #'bindat--type op fields)))))
+
+(cl-defmethod bindat--type (op (field cons) &rest fields)
+ (named-let loop
+ ((fields (cons field fields))
+ (labels ()))
+ (bindat--pcase fields
+ ('nil
+ (bindat--pcase op
+ ('unpack
+ (let ((exp ()))
+ (pcase-dolist (`(,label . ,labelvar) labels)
+ (setq exp
+ (if (eq label '_)
+ (if exp `(nconc ,labelvar ,exp) labelvar)
+ `(cons (cons ',label ,labelvar) ,exp))))
+ exp))
+ (_ nil)))
+ (`(:unpack-val ,exp)
+ ;; Make it so `:kwd nil' is the same as the absence of the keyword arg.
+ (if exp (pcase op ('unpack exp)) (loop nil labels)))
+
+ (`((,label . ,type) . ,fields)
+ (let* ((get-field-val
+ (let ((tail (memq :pack-val type)))
+ ;; FIXME: This `TYPE.. :pack EXP' syntax doesn't work well
+ ;; when TYPE is a struct (a list of fields) or with extensions
+ ;; such as allowing TYPE to be `if ...'.
+ (if tail
+ (prog1 (cadr tail)
+ (setq type (butlast type (length tail)))))))
+ (fieldvar (make-symbol (format "field%d" (length fields))))
+ (labelvar
+ (cond
+ ((eq label '_) fieldvar)
+ ((keywordp label)
+ (intern (substring (symbol-name label) 1)))
+ (t label)))
+ (field-fun (bindat--fun type))
+ (rest-exp (loop fields `((,label . ,labelvar) . ,labels))))
+ (bindat--pcase op
+ ('unpack
+ (let ((code
+ `(let ((,labelvar (funcall ,field-fun)))
+ ,rest-exp)))
+ (if (or (eq label '_) (not (assq label labels)))
+ code
+ (macroexp-warn-and-return
+ (format "Duplicate label: %S" label)
+ code))))
+ (`(,_ ,val)
+ ;; `cdr-safe' is easier to optimize (can't signal an error).
+ `(let ((,fieldvar ,(or get-field-val
+ (if (eq label '_) val
+ `(cdr-safe (assq ',label ,val))))))
+ (funcall ,field-fun ,fieldvar)
+ ,@(when rest-exp
+ `((let ,(unless (eq labelvar fieldvar)
+ `((,labelvar ,fieldvar)))
+ (ignore ,labelvar)
+ ,rest-exp))))))))
+ (_ (error "Unrecognized format in bindat fields: %S" fields)))))
+
+(def-edebug-elem-spec 'bindat-struct
+ '([&rest (symbolp bindat-type &optional ":pack-val" def-form)]
+ &optional ":unpack-val" def-form))
+
+(def-edebug-elem-spec 'bindat-type
+ '(&or ["uint" def-form]
+ ["uintr" def-form]
+ ["str" def-form]
+ ["strz" &optional def-form]
+ ["bits" def-form]
+ ["fill" def-form]
+ ["align" def-form]
+ ["vec" def-form bindat-type]
+ ["repeat" def-form bindat-type]
+ ["type" def-form]
+ ["struct" bindat-struct]
+ ["unit" def-form]
+ [":pack-var" symbolp bindat-type]
+ symbolp ;; u8, u16, etc...
+ bindat-struct))
+
+(defmacro bindat-type (&rest type)
+ "Return the Bindat type value to pack&unpack TYPE.
+TYPE is a Bindat type expression. It can take the following forms:
+
+ uint BITLEN - Big-endian unsigned integer
+ uintr BITLEN - Little-endian unsigned integer
+ str LEN - Byte string
+ strz [LEN] - Zero-terminated byte-string
+ bits LEN - Bit vector (LEN is counted in bytes)
+ fill LEN - Just a filler
+ align LEN - Fill up to the next multiple of LEN bytes
+ vec COUNT TYPE - COUNT repetitions of TYPE
+ type EXP - Indirection; EXP should return a Bindat type value
+ unit EXP - 0-width type holding the value returned by EXP
+ struct FIELDS... - A composite type
+
+When the context makes it clear, the symbol `struct' can be omitted.
+A composite type is a list of FIELDS where each FIELD is of the form
+
+ (LABEL TYPE)
+
+where LABEL can be `_' if the field should not deserve a name.
+
+Composite types get normally packed/unpacked to/from alists, but this can be
+controlled in the following way:
+- If the list of fields ends with `:unpack-val EXP', then unpacking will
+ return the value of EXP (which has the previous fields in its scope).
+- If a field's TYPE is followed by `:pack-val EXP', then the value placed
+ into this field will be that returned by EXP instead of looking up the alist.
+- If the list of fields is preceded with `:pack-var VAR' then the object to
+ be packed is bound to VAR when evaluating the EXPs of `:pack-val'.
+
+All the above BITLEN, LEN, COUNT, and EXP are ELisp expressions evaluated
+in the current lexical context extended with the previous fields.
+
+TYPE can additionally be one of the Bindat type macros defined with
+`bindat-defmacro' (and listed below) or an ELisp expression which returns
+a bindat type expression."
+ (declare (indent 0) (debug (bindat-type)))
+ `(progn
+ (defvar bindat-idx)
+ (bindat--make :ue ,(bindat--toplevel 'unpack type)
+ :le ,(bindat--toplevel 'length type)
+ :pe ,(bindat--toplevel 'pack type))))
+
+(eval-and-compile
+ (defconst bindat--primitives '(byte uint uintr str strz bits fill align
+ struct type vec unit)))
+
+(eval-and-compile
+ (defvar bindat--macroenv
+ (mapcar (lambda (s) (cons s (lambda (&rest args)
+ (bindat--makefun (cons s args)))))
+ bindat--primitives)))
+
+(defmacro bindat-defmacro (name args &rest body)
+ "Define a new Bindat type as a macro."
+ (declare (indent 2) (doc-string 3) (debug (&define name sexp def-body)))
+ (let ((leaders ()))
+ (while (and (cdr body)
+ (or (stringp (car body))
+ (memq (car-safe (car body)) '(:documentation declare))))
+ (push (pop body) leaders))
+ ;; FIXME: Add support for Edebug decls to those macros.
+ `(eval-and-compile ;; Yuck! But needed to define types where you use them!
+ (setf (alist-get ',name bindat--macroenv)
+ (lambda ,args ,@(nreverse leaders)
+ (bindat--fun ,(macroexp-progn body)))))))
+
+(put 'bindat-type 'function-documentation '(bindat--make-docstring))
+(defun bindat--make-docstring ()
+ ;; Largely inspired from `pcase--make-docstring'.
+ (let* ((main (documentation (symbol-function 'bindat-type) 'raw))
+ (ud (help-split-fundoc main 'bindat-type)))
+ (require 'help-fns)
+ (declare-function help-fns--signature "help-fns")
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (pcase-dolist (`(,name . ,me) (reverse bindat--macroenv))
+ (unless (memq name bindat--primitives)
+ (let ((doc (documentation me 'raw)))
+ (insert "\n\n-- ")
+ (setq doc (help-fns--signature name doc me
+ (indirect-function me)
+ nil))
+ (insert "\n" (or doc "Not documented.")))))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+
+(bindat-defmacro u8 () "Unsigned 8bit integer." '(byte))
+(bindat-defmacro sint (bitlen r)
+ "Signed integer of size BITLEN.
+Bigendian if R is nil and little endian if not."
+ (let ((bl (make-symbol "bitlen"))
+ (max (make-symbol "max"))
+ (wrap (make-symbol "wrap")))
+ `(let* ((,bl ,bitlen)
+ (,max (ash 1 (1- ,bl)))
+ (,wrap (+ ,max ,max)))
+ (struct :pack-var v
+ (n if ,r (uintr ,bl) (uint ,bl)
+ :pack-val (if (< v 0) (+ v ,wrap) v))
+ :unpack-val (if (>= n ,max) (- n ,wrap) n)))))
+
+(bindat-defmacro repeat (count &rest type)
+ "Like `vec', but unpacks to a list rather than a vector."
+ `(:pack-var v
+ (v vec ,count ,@type :pack-val v)
+ :unpack-val (append v nil)))
+
+(defvar bindat--op nil
+ "The operation we're currently building.
+This is a simple symbol and can be one of: `unpack', `pack', or `length'.
+This is used during macroexpansion of `bindat-type' so that the
+macros know which code to generate.
+FIXME: this is closely related and very similar to the `op' argument passed
+to `bindat--type', yet it's annoyingly different.")
+
+(defun bindat--fun (type)
+ (if (or (keywordp (car type)) (consp (car type))) (cons 'struct type)
+ type))
+
+(defun bindat--makefun (type)
+ (let* ((v (make-symbol "v"))
+ (args (pcase bindat--op ('unpack ()) (_ (list v)))))
+ (pcase (apply #'bindat--type
+ (pcase bindat--op ('unpack 'unpack) (op `(,op . ,args)))
+ type)
+ (`(funcall ,f . ,(pred (equal args))) f) ;η-reduce.
+ (exp `(lambda ,args ,exp)))))
+
+(defun bindat--toplevel (op type)
+ (let* ((bindat--op op)
+ (env `(,@bindat--macroenv
+ ,@macroexpand-all-environment)))
+ (macroexpand-all (bindat--fun type) env)))
+
(provide 'bindat)
;;; bindat.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index abbe2a2e63f..6475f69eded 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -225,6 +225,14 @@
(byte-compile-log-lap-1 ,format-string ,@args)))
+(defvar byte-optimize--lexvars nil
+ "Lexical variables in scope, in reverse order of declaration.
+Each element is on the form (NAME KEEP [VALUE]), where:
+ NAME is the variable name,
+ KEEP is a boolean indicating whether the binding must be retained,
+ VALUE, if present, is a substitutable expression.
+Earlier variables shadow later ones with the same name.")
+
;;; byte-compile optimizers to support inlining
(put 'inline 'byte-optimizer #'byte-optimize-inline-handler)
@@ -266,124 +274,42 @@
((pred byte-code-function-p)
;; (message "Inlining byte-code for %S!" name)
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
+ (byte-compile--check-arity-bytecode form fn)
`(,fn ,@(cdr form)))
((or `(lambda . ,_) `(closure . ,_))
- (if (not (or (eq fn localfn) ;From the same file => same mode.
- (eq (car fn) ;Same mode.
- (if lexical-binding 'closure 'lambda))))
- ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
- ;; letbind byte-code (or any other combination for that matter), we
- ;; can only inline dynbind source into dynbind source or letbind
- ;; source into letbind source.
- (progn
- ;; We can of course byte-compile the inlined function
- ;; first, and then inline its byte-code.
- (byte-compile name)
- `(,(symbol-function name) ,@(cdr form)))
- (let ((newfn (if (eq fn localfn)
- ;; If `fn' is from the same file, it has already
- ;; been preprocessed!
- `(function ,fn)
- ;; Try and process it "in its original environment".
- (let ((byte-compile-bound-variables nil))
- (byte-compile-preprocess
- (byte-compile--reify-function fn))))))
- (if (eq (car-safe newfn) 'function)
- (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
- ;; This can happen because of macroexp-warn-and-return &co.
- (byte-compile-warn
- "Inlining closure %S failed" name)
- form))))
+ ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
+ ;; letbind byte-code (or any other combination for that matter), we
+ ;; can only inline dynbind source into dynbind source or letbind
+ ;; source into letbind source.
+ ;; When the function comes from another file, we byte-compile
+ ;; the inlined function first, and then inline its byte-code.
+ ;; This also has the advantage that the final code does not
+ ;; depend on the order of compilation of ELisp files, making
+ ;; the build more reproducible.
+ (if (eq fn localfn)
+ ;; From the same file => same mode.
+ (macroexp--unfold-lambda `(,fn ,@(cdr form)))
+ ;; Since we are called from inside the optimiser, we need to make
+ ;; sure not to propagate lexvar values.
+ (let ((byte-optimize--lexvars nil)
+ ;; Silence all compilation warnings: the useful ones should
+ ;; be displayed when the function's source file will be
+ ;; compiled anyway, but more importantly we would otherwise
+ ;; emit spurious warnings here because we don't have the full
+ ;; context, such as `declare-functions' placed earlier in the
+ ;; source file's code or `with-suppressed-warnings' that
+ ;; surrounded the `defsubst'.
+ (byte-compile-warnings nil))
+ (byte-compile name))
+ (let ((bc (symbol-function name)))
+ (byte-compile--check-arity-bytecode form bc)
+ `(,bc ,@(cdr form)))))
(_ ;; Give up on inlining.
form))))
-
-;; ((lambda ...) ...)
-(defun byte-compile-unfold-lambda (form &optional name)
- ;; In lexical-binding mode, let and functions don't bind vars in the same way
- ;; (let obey special-variable-p, but functions don't). But luckily, this
- ;; doesn't matter here, because function's behavior is underspecified so it
- ;; can safely be turned into a `let', even though the reverse is not true.
- (or name (setq name "anonymous lambda"))
- (let* ((lambda (car form))
- (values (cdr form))
- (arglist (nth 1 lambda))
- (body (cdr (cdr lambda)))
- optionalp restp
- bindings)
- (if (and (stringp (car body)) (cdr body))
- (setq body (cdr body)))
- (if (and (consp (car body)) (eq 'interactive (car (car body))))
- (setq body (cdr body)))
- ;; FIXME: The checks below do not belong in an optimization phase.
- (while arglist
- (cond ((eq (car arglist) '&optional)
- ;; ok, I'll let this slide because funcall_lambda() does...
- ;; (if optionalp (error "multiple &optional keywords in %s" name))
- (if restp (error "&optional found after &rest in %s" name))
- (if (null (cdr arglist))
- (error "nothing after &optional in %s" name))
- (setq optionalp t))
- ((eq (car arglist) '&rest)
- ;; ...but it is by no stretch of the imagination a reasonable
- ;; thing that funcall_lambda() allows (&rest x y) and
- ;; (&rest x &optional y) in arglists.
- (if (null (cdr arglist))
- (error "nothing after &rest in %s" name))
- (if (cdr (cdr arglist))
- (error "multiple vars after &rest in %s" name))
- (setq restp t))
- (restp
- (setq bindings (cons (list (car arglist)
- (and values (cons 'list values)))
- bindings)
- values nil))
- ((and (not optionalp) (null values))
- (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
- (setq arglist nil values 'too-few))
- (t
- (setq bindings (cons (list (car arglist) (car values))
- bindings)
- values (cdr values))))
- (setq arglist (cdr arglist)))
- (if values
- (progn
- (or (eq values 'too-few)
- (byte-compile-warn
- "attempt to open-code `%s' with too many arguments" name))
- form)
-
- ;; The following leads to infinite recursion when loading a
- ;; file containing `(defsubst f () (f))', and then trying to
- ;; byte-compile that file.
- ;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
- (if bindings
- (cons 'let (cons (nreverse bindings) body))
- (cons 'progn body))))
- (byte-compile-log " %s\t==>\t%s" form newform)
- newform))))
-
;;; implementing source-level optimizers
-(defconst byte-optimize-enable-variable-constprop t
- "If non-nil, enable constant propagation through local variables.")
-
-(defconst byte-optimize-warn-eliminated-variable nil
- "Whether to warn when a variable is optimised away entirely.
-This does usually not indicate a problem and makes the compiler
-very chatty, but can be useful for debugging.")
-
-(defvar byte-optimize--lexvars nil
- "Lexical variables in scope, in reverse order of declaration.
-Each element is on the form (NAME KEEP [VALUE]), where:
- NAME is the variable name,
- KEEP is a boolean indicating whether the binding must be retained,
- VALUE, if present, is a substitutable expression.
-Earlier variables shadow later ones with the same name.")
-
(defvar byte-optimize--vars-outside-condition nil
"Alist of variables lexically bound outside conditionally executed code.
Variables here are sensitive to mutation inside the conditional code,
@@ -412,10 +338,44 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(numberp expr)
(stringp expr)
(and (consp expr)
- (eq (car expr) 'quote)
+ (memq (car expr) '(quote function))
(symbolp (cadr expr)))
(keywordp expr)))
+(defmacro byte-optimize--pcase (exp &rest cases)
+ ;; When we do
+ ;;
+ ;; (pcase EXP
+ ;; (`(if ,exp ,then ,else) (DO-TEST))
+ ;; (`(plus ,e2 ,e2) (DO-ADD))
+ ;; (`(times ,e2 ,e2) (DO-MULT))
+ ;; ...)
+ ;;
+ ;; we usually don't want to fall back to the default case if
+ ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)'
+ ;; or `(times E1 E2 E3)', instead we either want to signal an error
+ ;; that EXP has an unexpected shape, or we want to carry on as if
+ ;; it had the right shape (ignore the extra data and pretend the missing
+ ;; data is nil) because it should simply never happen.
+ ;;
+ ;; The macro below implements the second option by rewriting patterns
+ ;; like `(if ,exp ,then ,else)'
+ ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'.
+ ;;
+ ;; The resulting macroexpansion is also significantly cleaner/smaller/faster.
+ (declare (indent 1) (debug pcase))
+ `(pcase ,exp
+ . ,(mapcar (lambda (case)
+ `(,(pcase (car case)
+ ((and `(,'\` (,_ . (,'\, ,_))) pat) pat)
+ (`(,'\` (,head . ,tail))
+ (list '\`
+ (cons head
+ (list '\, `(or ,(list '\` tail) pcase--dontcare)))))
+ (pat pat))
+ . ,(cdr case)))
+ cases)))
+
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@@ -428,28 +388,33 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
;; have no place in an optimizer: the corresponding tests should be
;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
(let ((fn (car-safe form)))
- (pcase form
+ (byte-optimize--pcase form
((pred (not consp))
(cond
((and for-effect
(or byte-compile-delete-errors
(not (symbolp form))
- (eq form t)))
+ (eq form t)
+ (keywordp form)))
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
- (if (cddr lexvar) ; Value available?
- (if (assq form byte-optimize--vars-outside-loop)
- ;; Cannot substitute; mark for retention to avoid the
- ;; variable being eliminated.
- (progn
- (setcar (cdr lexvar) t)
- form)
- (caddr lexvar)) ; variable value to use
- form)))
+ (cond
+ ((not lexvar) form)
+ (for-effect nil)
+ ((cddr lexvar) ; Value available?
+ (if (assq form byte-optimize--vars-outside-loop)
+ ;; Cannot substitute; mark for retention to avoid the
+ ;; variable being eliminated.
+ (progn
+ (setcar (cdr lexvar) t)
+ form)
+ ;; variable value to use
+ (caddr lexvar)))
+ (t form))))
(t form)))
(`(quote . ,v)
- (if (cdr v)
+ (if (or (not v) (cdr v))
(byte-compile-warn "malformed quote form: `%s'"
(prin1-to-string form)))
;; Map (quote nil) to nil to simplify optimizer logic.
@@ -458,31 +423,34 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(not for-effect)
form))
(`(,(or 'let 'let*) . ,rest)
- (cons fn (byte-optimize-let-form fn rest for-effect)))
+ (cons fn (byte-optimize-let-form fn rest for-effect)))
(`(cond . ,clauses)
;; The condition in the first clause is always executed, but
;; right now we treat all of them as conditional for simplicity.
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
(cons fn
(mapcar (lambda (clause)
- (if (consp clause)
- (cons
- (byte-optimize-form (car clause) nil)
- (byte-optimize-body (cdr clause) for-effect))
- (byte-compile-warn "malformed cond form: `%s'"
- (prin1-to-string clause))
- clause))
- clauses))))
+ (if (consp clause)
+ (cons
+ (byte-optimize-form (car clause) nil)
+ (byte-optimize-body (cdr clause) for-effect))
+ (byte-compile-warn "malformed cond form: `%s'"
+ (prin1-to-string clause))
+ clause))
+ clauses))))
(`(progn . ,exps)
;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
- (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare))
- (if exps
- `(prog1 ,(byte-optimize-form exp for-effect)
- . ,(byte-optimize-body exps t))
- (byte-optimize-form exp for-effect)))
+ (`(prog1 ,exp . ,exps)
+ (let ((exp-opt (byte-optimize-form exp for-effect)))
+ (if exps
+ (let ((exps-opt (byte-optimize-body exps t)))
+ (if (macroexp-const-p exp-opt)
+ `(progn ,@exps-opt ,exp-opt)
+ `(prog1 ,exp-opt ,@exps-opt)))
+ exp-opt)))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
;; Those subrs which have an implicit progn; it's not quite good
@@ -492,19 +460,23 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(cons fn (byte-optimize-body exps for-effect)))
(`(if ,test ,then . ,else)
+ ;; FIXME: We are conservative here: any variable changed in the
+ ;; THEN branch will be barred from substitution in the ELSE
+ ;; branch, despite the branches being mutually exclusive.
+
;; The test is always executed.
(let* ((test-opt (byte-optimize-form test nil))
- ;; The THEN and ELSE branches are executed conditionally.
- ;;
- ;; FIXME: We are conservative here: any variable changed in the
- ;; THEN branch will be barred from substitution in the ELSE
- ;; branch, despite the branches being mutually exclusive.
- (byte-optimize--vars-outside-condition byte-optimize--lexvars)
- (then-opt (byte-optimize-form then for-effect))
- (else-opt (byte-optimize-body else for-effect)))
+ (const (macroexp-const-p test-opt))
+ ;; The branches are traversed unconditionally when possible.
+ (byte-optimize--vars-outside-condition
+ (if const
+ byte-optimize--vars-outside-condition
+ byte-optimize--lexvars))
+ ;; Avoid traversing dead branches.
+ (then-opt (and test-opt (byte-optimize-form then for-effect)))
+ (else-opt (and (not (and test-opt const))
+ (byte-optimize-body else for-effect))))
`(if ,test-opt ,then-opt . ,else-opt)))
- (`(if . ,_)
- (byte-compile-warn "too few arguments for `if'"))
(`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures.
;; FIXME: We have to traverse the expressions in left-to-right
@@ -542,8 +514,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(body (byte-optimize-body exps t)))
`(while ,condition . ,body)))
- (`(while . ,_)
- (byte-compile-warn "too few arguments for `while'"))
(`(interactive . ,_)
(byte-compile-warn "misplaced interactive spec: `%s'"
@@ -555,13 +525,19 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
;; all the subexpressions and compiling them separately.
form)
- (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare))
+ (`(condition-case ,var ,exp . ,clauses)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
- `(condition-case ,var ;Not evaluated.
+ `(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp for-effect)
,@(mapcar (lambda (clause)
- `(,(car clause)
- ,@(byte-optimize-body (cdr clause) for-effect)))
+ (let ((byte-optimize--lexvars
+ (and lexical-binding
+ (if var
+ (cons (list var t)
+ byte-optimize--lexvars)
+ byte-optimize--lexvars))))
+ (cons (car clause)
+ (byte-optimize-body (cdr clause) for-effect))))
clauses))))
(`(unwind-protect ,exp . ,exps)
@@ -581,7 +557,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
`(unwind-protect ,bodyform
. ,(byte-optimize-body exps t))))))
- (`(catch . ,(or `(,tag . ,exps) pcase--dontcare))
+ (`(catch ,tag . ,exps)
(let ((byte-optimize--vars-outside-condition byte-optimize--lexvars))
`(catch ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect))))
@@ -591,7 +567,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
;; computed for effect. We want to avoid the warnings
;; that might occur if they were treated that way.
;; However, don't actually bother calling `ignore'.
- `(prog1 nil . ,(mapcar #'byte-optimize-form exps)))
+ `(progn ,@(mapcar #'byte-optimize-form exps) nil))
;; Needed as long as we run byte-optimize-form after cconv.
(`(internal-make-closure . ,_)
@@ -604,7 +580,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
form)
(`((lambda . ,_) . ,_)
- (let ((newform (byte-compile-unfold-lambda form)))
+ (let ((newform (macroexp--unfold-lambda form)))
(if (eq newform form)
;; Some error occurred, avoid infinite recursion.
form
@@ -625,24 +601,20 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
- ;; If it's bound outside conditional, invalidate.
- (if (assq var byte-optimize--vars-outside-condition)
- ;; We are in conditional code and the variable was
- ;; bound outside: cancel substitutions.
- (setcdr (cdr lexvar) nil)
- ;; Set a new value (if substitutable).
- (setcdr (cdr lexvar)
- (and (byte-optimize--substitutable-p value)
- (list value))))
- (setcar (cdr lexvar) t)) ; Mark variable to be kept.
+ (setcar (cdr lexvar) t) ; Mark variable to be kept.
+ (setcdr (cdr lexvar) nil)) ; Inhibit further substitution.
+
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
(cons fn (nreverse var-expr-list))))
- (`(defvar ,(and (pred symbolp) name) . ,_)
- (push name byte-optimize--dynamic-vars)
- form)
+ (`(defvar ,(and (pred symbolp) name) . ,rest)
+ (let ((optimized-rest (and rest
+ (cons (byte-optimize-form (car rest) nil)
+ (cdr rest)))))
+ (push name byte-optimize--dynamic-vars)
+ `(defvar ,name . ,optimized-rest)))
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
@@ -674,76 +646,66 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(byte-optimize-constant-args form)
form))))))
-(defun byte-optimize-form (form &optional for-effect)
+(defun byte-optimize-one-form (form &optional for-effect)
"The source-level pass of the optimizer."
- ;;
- ;; First, optimize all sub-forms of this one.
- (setq form (byte-optimize-form-code-walker form for-effect))
- ;;
- ;; after optimizing all subforms, optimize this form until it doesn't
- ;; optimize any further. This means that some forms will be passed through
- ;; the optimizer many times, but that's necessary to make the for-effect
- ;; processing do as much as possible.
- ;;
- (let (opt new)
- (if (and (consp form)
- (symbolp (car form))
- (or ;; (and for-effect
- ;; ;; We don't have any of these yet, but we might.
- ;; (setq opt (get (car form)
- ;; 'byte-for-effect-optimizer)))
- (setq opt (function-get (car form) 'byte-optimizer)))
- (not (eq form (setq new (funcall opt form)))))
- (progn
-;; (if (equal form new) (error "bogus optimizer -- %s" opt))
- (byte-compile-log " %s\t==>\t%s" form new)
- (setq new (byte-optimize-form new for-effect))
- new)
- form)))
+ ;; Make optimiser aware of lexical arguments.
+ (let ((byte-optimize--lexvars
+ (mapcar (lambda (v) (list (car v) t))
+ byte-compile--lexical-environment)))
+ (byte-optimize-form form for-effect)))
+
+(defun byte-optimize-form (form &optional for-effect)
+ (while
+ (progn
+ ;; First, optimize all sub-forms of this one.
+ (setq form (byte-optimize-form-code-walker form for-effect))
+
+ ;; If a form-specific optimiser is available, run it and start over
+ ;; until a fixpoint has been reached.
+ (and (consp form)
+ (symbolp (car form))
+ (let ((opt (function-get (car form) 'byte-optimizer)))
+ (and opt
+ (let ((old form)
+ (new (funcall opt form)))
+ (byte-compile-log " %s\t==>\t%s" old new)
+ (setq form new)
+ (not (eq new old))))))))
+ form)
(defun byte-optimize-let-form (head form for-effect)
;; Recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
;; are more deeply nested are optimized first.
- (if (and lexical-binding byte-optimize-enable-variable-constprop)
+ (if lexical-binding
(let* ((byte-optimize--lexvars byte-optimize--lexvars)
(new-lexvars nil)
(let-vars nil))
(dolist (binding (car form))
- (let (name expr)
- (cond ((consp binding)
- (setq name (car binding))
- (unless (symbolp name)
- (byte-compile-warn "let-bind nonvariable: `%S'" name))
- (setq expr (byte-optimize-form (cadr binding) nil)))
- ((symbolp binding)
- (setq name binding))
- (t (byte-compile-warn "malformed let binding: `%S'" binding)))
- (let* (
- (value (and (byte-optimize--substitutable-p expr)
- (list expr)))
- (lexical (not (or (and (symbolp name)
- (special-variable-p name))
- (memq name byte-compile-bound-variables)
- (memq name byte-optimize--dynamic-vars))))
- (lexinfo (and lexical (cons name (cons nil value)))))
- (push (cons name (cons expr (cdr lexinfo))) let-vars)
- (when lexinfo
- (push lexinfo (if (eq head 'let*)
- byte-optimize--lexvars
- new-lexvars))))))
+ (let* ((name (car binding))
+ (expr (byte-optimize-form (cadr binding) nil))
+ (value (and (byte-optimize--substitutable-p expr)
+ (list expr)))
+ (lexical (not (or (special-variable-p name)
+ (memq name byte-compile-bound-variables)
+ (memq name byte-optimize--dynamic-vars))))
+ (lexinfo (and lexical (cons name (cons nil value)))))
+ (push (cons name (cons expr (cdr lexinfo))) let-vars)
+ (when lexinfo
+ (push lexinfo (if (eq head 'let*)
+ byte-optimize--lexvars
+ new-lexvars)))))
(setq byte-optimize--lexvars
(append new-lexvars byte-optimize--lexvars))
;; Walk the body expressions, which may mutate some of the records,
;; and generate new bindings that exclude unused variables.
- (let* ((opt-body (byte-optimize-body (cdr form) for-effect))
+ (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars)
+ (opt-body (byte-optimize-body (cdr form) for-effect))
(bindings nil))
(dolist (var let-vars)
;; VAR is (NAME EXPR [KEEP [VALUE]])
- (if (and (nthcdr 3 var) (not (nth 2 var)))
- ;; Value present and not marked to be kept: eliminate.
- (when byte-optimize-warn-eliminated-variable
- (byte-compile-warn "eliminating local variable %S" (car var)))
+ (when (or (not (nthcdr 3 var)) (nth 2 var))
+ ;; Value not present, or variable marked to be kept.
(push (list (nth 0 var) (nth 1 var)) bindings)))
(cons bindings opt-body)))
@@ -768,7 +730,6 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
;; all-for-effect is true. returns a new list of forms.
(let ((rest forms)
(result nil)
- (byte-optimize--dynamic-vars byte-optimize--dynamic-vars)
fe new)
(while rest
(setq fe (or all-for-effect (cdr rest)))
@@ -981,27 +942,45 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
"Whether EXPR is a constant symbol."
(and (macroexp-const-p expr) (symbolp (eval expr))))
+(defun byte-optimize--fixnump (o)
+ "Return whether O is guaranteed to be a fixnum in all Emacsen.
+See Info node `(elisp) Integer Basics'."
+ (and (fixnump o) (<= -536870912 o 536870911)))
+
(defun byte-optimize-equal (form)
- ;; Replace `equal' or `eql' with `eq' if at least one arg is a symbol.
+ ;; Replace `equal' or `eql' with `eq' if at least one arg is a
+ ;; symbol or fixnum.
(byte-optimize-binary-predicate
(if (= (length (cdr form)) 2)
(if (or (byte-optimize--constant-symbol-p (nth 1 form))
- (byte-optimize--constant-symbol-p (nth 2 form)))
+ (byte-optimize--constant-symbol-p (nth 2 form))
+ (byte-optimize--fixnump (nth 1 form))
+ (byte-optimize--fixnump (nth 2 form)))
(cons 'eq (cdr form))
form)
;; Arity errors reported elsewhere.
form)))
+(defun byte-optimize-eq (form)
+ (pcase (cdr form)
+ ((or `(,x nil) `(nil ,x)) `(not ,x))
+ (_ (byte-optimize-binary-predicate form))))
+
(defun byte-optimize-member (form)
;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
- ;; or the second arg is a list of symbols.
+ ;; or the second arg is a list of symbols. Same with fixnums.
(if (= (length (cdr form)) 2)
(if (or (byte-optimize--constant-symbol-p (nth 1 form))
+ (byte-optimize--fixnump (nth 1 form))
(let ((arg2 (nth 2 form)))
(and (macroexp-const-p arg2)
(let ((listval (eval arg2)))
(and (listp listval)
- (not (memq nil (mapcar #'symbolp listval))))))))
+ (not (memq nil (mapcar
+ (lambda (o)
+ (or (symbolp o)
+ (byte-optimize--fixnump o)))
+ listval))))))))
(cons 'memq (cdr form))
form)
;; Arity errors reported elsewhere.
@@ -1009,11 +988,12 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(defun byte-optimize-assoc (form)
;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq',
- ;; if the first arg is a symbol.
+ ;; if the first arg is a symbol or fixnum.
(cond
((/= (length form) 3)
form)
- ((byte-optimize--constant-symbol-p (nth 1 form))
+ ((or (byte-optimize--constant-symbol-p (nth 1 form))
+ (byte-optimize--fixnump (nth 1 form)))
(cons (if (eq (car form) 'assoc) 'assq 'rassq)
(cdr form)))
(t (byte-optimize-constant-args form))))
@@ -1073,7 +1053,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(put 'min 'byte-optimizer #'byte-optimize-min-max)
(put '= 'byte-optimizer #'byte-optimize-binary-predicate)
-(put 'eq 'byte-optimizer #'byte-optimize-binary-predicate)
+(put 'eq 'byte-optimizer #'byte-optimize-eq)
(put 'eql 'byte-optimizer #'byte-optimize-equal)
(put 'equal 'byte-optimizer #'byte-optimize-equal)
(put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
@@ -1089,7 +1069,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(defun byte-optimize-quote (form)
(if (or (consp (nth 1 form))
(and (symbolp (nth 1 form))
- (not (macroexp--const-symbol-p form))))
+ (not (macroexp--const-symbol-p (nth 1 form)))))
form
(nth 1 form)))
@@ -1250,18 +1230,31 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
(put 'let 'byte-optimizer #'byte-optimize-letX)
(put 'let* 'byte-optimizer #'byte-optimize-letX)
(defun byte-optimize-letX (form)
- (cond ((null (nth 1 form))
- ;; No bindings
- (cons 'progn (cdr (cdr form))))
- ((or (nth 2 form) (nthcdr 3 form))
- form)
- ;; The body is nil
- ((eq (car form) 'let)
- (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
- '(nil)))
- (t
- (let ((binds (reverse (nth 1 form))))
- (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
+ (pcase form
+ ;; No bindings.
+ (`(,_ () . ,body)
+ `(progn . ,body))
+
+ ;; Body is empty or just contains a constant.
+ (`(,head ,bindings . ,(or '() `(,(and const (pred macroexp-const-p)))))
+ (if (eq head 'let)
+ `(progn ,@(mapcar (lambda (binding)
+ (and (consp binding) (cadr binding)))
+ bindings)
+ ,const)
+ `(let* ,(butlast bindings) ,(cadar (last bindings)) ,const)))
+
+ ;; Body is last variable.
+ (`(,head ,bindings ,(and var (pred symbolp) (pred (not keywordp))
+ (pred (not booleanp))
+ (guard (eq var (caar (last bindings))))))
+ (if (eq head 'let)
+ `(progn ,@(mapcar (lambda (binding)
+ (and (consp binding) (cadr binding)))
+ bindings))
+ `(let* ,(butlast bindings) ,(cadar (last bindings)))))
+
+ (_ form)))
(put 'nth 'byte-optimizer #'byte-optimize-nth)
@@ -1286,6 +1279,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
form)
form))
+(put 'cons 'byte-optimizer #'byte-optimize-cons)
+(defun byte-optimize-cons (form)
+ ;; (cons X nil) => (list X)
+ (if (and (= (safe-length form) 3)
+ (null (nth 2 form)))
+ `(list ,(nth 1 form))
+ form))
+
;; Fixme: delete-char -> delete-region (byte-coded)
;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
;; string-make-multibyte for constant args.
@@ -1341,6 +1342,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
elt encode-char exp expt encode-time error-message-string
fboundp fceiling featurep ffloor
file-directory-p file-exists-p file-locked-p file-name-absolute-p
+ file-name-concat
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
float float-time floor format format-time-string frame-first-window
frame-root-window frame-selected-window
@@ -1354,7 +1356,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
line-beginning-position line-end-position
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
- make-byte-code make-list make-string make-symbol marker-buffer max
+ make-byte-code make-list make-string make-symbol mark marker-buffer max
+ match-beginning match-end
member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
@@ -1363,6 +1366,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
radians-to-degrees rassq rassoc read-from-string regexp-opt
regexp-quote region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp
+ string> string-greaterp string-empty-p
+ string-prefix-p string-suffix-p string-blank-p
string-search string-to-char
string-to-number string-to-syntax substring
sxhash sxhash-equal sxhash-eq sxhash-eql
@@ -1387,7 +1392,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
window-total-height window-total-width window-use-time window-vscroll
window-width zerop))
(side-effect-and-error-free-fns
- '(arrayp atom
+ '(always arrayp atom
bignump bobp bolp bool-vector-p
buffer-end buffer-list buffer-size buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p characterp
@@ -1402,7 +1407,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
invocation-directory invocation-name
keymapp keywordp
list listp
- make-marker mark mark-marker markerp max-char
+ make-marker mark-marker markerp max-char
memory-limit
mouse-movement-p
natnump nlistp not null number-or-marker-p numberp
@@ -1452,7 +1457,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
copysign isnan ldexp float logb
floor ceiling round truncate
ffloor fceiling fround ftruncate
- string= string-equal string< string-lessp
+ string= string-equal string< string-lessp string> string-greaterp
+ string-empty-p string-blank-p string-prefix-p string-suffix-p
string-search
consp atom listp nlistp proper-list-p
sequencep arrayp vectorp stringp bool-vector-p hash-table-p
@@ -1601,10 +1607,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
;; so we create a copy of it, and replace the addresses with
;; TAGs.
(let ((orig-table last-constant))
- (cl-loop for e across constvec
- when (eq e last-constant)
- do (setq last-constant (copy-hash-table e))
- and return nil)
+ (setq last-constant (copy-hash-table last-constant))
;; Replace all addresses with TAGs.
(maphash #'(lambda (value offset)
(let ((match (assq offset tags)))
@@ -2386,6 +2389,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
;;
(eval-when-compile
(or (byte-code-function-p (symbol-function 'byte-optimize-form))
+ (subr-native-elisp-p (symbol-function 'byte-optimize-form))
(assq 'byte-code (symbol-function 'byte-optimize-form))
(let ((byte-optimize nil)
(byte-compile-warnings nil))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 88f362d24f0..aca5dcba62c 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -113,6 +113,9 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''side-effect-free (list 'quote val))))
+(put 'compiler-macro 'edebug-declaration-spec
+ '(&or symbolp ("lambda" &define lambda-list lambda-doc def-body)))
+
(defalias 'byte-run--set-compiler-macro
#'(lambda (f args compiler-function)
(if (not (eq (car-safe compiler-function) 'lambda))
@@ -143,6 +146,21 @@ The return value of this function is not used."
(list 'function-put (list 'quote f)
''lisp-indent-function (list 'quote val))))
+(defalias 'byte-run--set-speed
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''speed (list 'quote val))))
+
+(defalias 'byte-run--set-completion
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''completion-predicate (list 'function val))))
+
+(defalias 'byte-run--set-modes
+ #'(lambda (f _args &rest val)
+ (list 'function-put (list 'quote f)
+ ''command-modes (list 'quote val))))
+
;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist
(list
@@ -159,7 +177,10 @@ This may shift errors from run-time to compile-time.")
If `error-free', drop calls even if `byte-compile-delete-errors' is nil.")
(list 'compiler-macro #'byte-run--set-compiler-macro)
(list 'doc-string #'byte-run--set-doc-string)
- (list 'indent #'byte-run--set-indent))
+ (list 'indent #'byte-run--set-indent)
+ (list 'speed #'byte-run--set-speed)
+ (list 'completion #'byte-run--set-completion)
+ (list 'modes #'byte-run--set-modes))
"List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration,
@@ -232,7 +253,7 @@ The return value is undefined.
#'(lambda (x)
(let ((f (cdr (assq (car x) macro-declarations-alist))))
(if f (apply (car f) name arglist (cdr x))
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(format-message
"Unknown macro property %S in %S"
(car x) name)
@@ -305,7 +326,7 @@ The return value is undefined.
body)))
nil)
(t
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(format-message "Unknown defun property `%S' in %S"
(car x) name)
nil)))))
@@ -366,6 +387,10 @@ You don't need this. (See bytecomp.el commentary for more details.)
`(prog1
(defun ,name ,arglist ,@body)
(eval-and-compile
+ ;; Never native-compile defsubsts as we need the byte
+ ;; definition in `byte-compile-unfold-bcf' to perform the
+ ;; inlining (Bug#42664, Bug#43280, Bug#44209).
+ ,(byte-run--set-speed name nil -1)
(put ',name 'byte-optimizer 'byte-compile-inline-expand))))
(defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9429d6a0d5d..7bd642d2b23 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -192,10 +192,9 @@ otherwise adds \".elc\"."
(autoload 'byte-compile-inline-expand "byte-opt")
;; This is the entry point to the lapcode optimizer pass1.
-(autoload 'byte-optimize-form "byte-opt")
+(autoload 'byte-optimize-one-form "byte-opt")
;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
-(autoload 'byte-compile-unfold-lambda "byte-opt")
;; This is the entry point to the decompiler, which is used by the
;; disassembler. The disassembler just requires 'byte-compile, but
@@ -549,6 +548,10 @@ has the form (autoload . FILENAME).")
(defvar byte-compile-unresolved-functions nil
"Alist of undefined functions to which calls have been compiled.
+Each element in the list has the form (FUNCTION POSITION . CALLS)
+where CALLS is a list whose elements are integers (indicating the
+number of arguments passed in the function call) or the constant `t'
+if the function is called indirectly.
This variable is only significant whilst compiling an entire buffer.
Used for warnings when a function is not known to be defined or is later
defined with incorrect args.")
@@ -574,6 +577,46 @@ Each element is (INDEX . VALUE)")
(defvar byte-compile-depth 0 "Current depth of execution stack.")
(defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
+;; The following is used by comp.el to spill data out of here.
+;;
+;; Spilling is done in 3 places:
+;;
+;; - `byte-compile-lapcode' to obtain the map bytecode -> LAP for any
+;; code assembled.
+;;
+;; - `byte-compile-lambda' to obtain arglist doc and interactive spec
+;; af any lambda compiled (including anonymous).
+;;
+;; - `byte-compile-file-form-defmumble' to obtain the list of
+;; top-level forms as they would be outputted in the .elc file.
+;;
+
+(cl-defstruct byte-to-native-lambda
+ byte-func lap)
+
+;; Top level forms:
+(cl-defstruct byte-to-native-func-def
+ "Named function defined at top-level."
+ name c-name byte-func)
+(cl-defstruct byte-to-native-top-level
+ "All other top-level forms."
+ form lexical)
+
+(defvar byte-native-compiling nil
+ "Non-nil while native compiling.")
+(defvar byte-native-qualities nil
+ "To spill default qualities from the compiled file.")
+(defvar byte+native-compile nil
+ "Non-nil while producing at the same time byte and native code.")
+(defvar byte-to-native-lambdas-h nil
+ "Hash byte-code -> byte-to-native-lambda.")
+(defvar byte-to-native-top-level-forms nil
+ "List of top level forms.")
+(defvar byte-to-native-output-file nil
+ "Temporary file containing the byte-compilation output.")
+(defvar byte-to-native-plist-environment nil
+ "To spill `overriding-plist-environment'.")
+
;;; The byte codes; this information is duplicated in bytecomp.c
@@ -970,7 +1013,12 @@ CONST2 may be evaluated multiple times."
;; it within 2 bytes in the byte string).
(puthash value pc hash-table))
hash-table))
- (apply 'unibyte-string (nreverse bytes))))
+ (let ((bytecode (apply 'unibyte-string (nreverse bytes))))
+ (when byte-native-compiling
+ ;; Spill LAP for the native compiler here.
+ (puthash bytecode (make-byte-to-native-lambda :lap lap)
+ byte-to-native-lambdas-h))
+ bytecode)))
;;; compile-time evaluation
@@ -1424,11 +1472,35 @@ when printing the error message."
;; Remember number of args in call.
(let ((cons (assq f byte-compile-unresolved-functions)))
(if cons
- (or (memq nargs (cdr cons))
- (push nargs (cdr cons)))
- (push (list f nargs)
+ (or (memq nargs (cddr cons))
+ (push nargs (cddr cons)))
+ (push (list f byte-compile-last-position nargs)
byte-compile-unresolved-functions)))))
+(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
+ (byte-compile-set-symbol-position name)
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ name actual-args
+ (if (= 1 actual-args) "" "s")
+ (if (< actual-args min-args)
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string (cons min-args max-args))))
+
+(defun byte-compile--check-arity-bytecode (form bytecode)
+ "Check that the call in FORM matches that allowed by BYTECODE."
+ (when (and (byte-code-function-p bytecode)
+ (byte-compile-warning-enabled-p 'callargs))
+ (let* ((actual-args (length (cdr form)))
+ (arity (func-arity bytecode))
+ (min-args (car arity))
+ (max-args (and (numberp (cdr arity)) (cdr arity))))
+ (when (or (< actual-args min-args)
+ (and max-args (> actual-args max-args)))
+ (byte-compile-emit-callargs-warn
+ (car form) actual-args min-args max-args)))))
+
;; Warn if the form is calling a function with the wrong number of arguments.
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
@@ -1443,16 +1515,9 @@ when printing the error message."
(setcdr sig nil))
(if sig
(when (or (< ncall (car sig))
- (and (cdr sig) (> ncall (cdr sig))))
- (byte-compile-set-symbol-position (car form))
- (byte-compile-warn
- "%s called with %d argument%s, but %s %s"
- (car form) ncall
- (if (= 1 ncall) "" "s")
- (if (< ncall (car sig))
- "requires"
- "accepts only")
- (byte-compile-arglist-signature-string sig))))
+ (and (cdr sig) (> ncall (cdr sig))))
+ (byte-compile-emit-callargs-warn
+ (car form) ncall (car sig) (cdr sig))))
(byte-compile-format-warn form)
(byte-compile-function-warn (car form) (length (cdr form)) def)))
@@ -1526,14 +1591,14 @@ extra args."
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions))
(setq calls (delq t calls)) ;Ignore higher-order uses of the function.
- (when (cdr calls)
+ (when (cddr calls)
(when (and (symbolp name)
(eq (function-get name 'byte-optimizer)
'byte-compile-inline-expand))
(byte-compile-warn "defsubst `%s' was used before it was defined"
name))
(setq sig (byte-compile-arglist-signature arglist)
- nums (sort (copy-sequence (cdr calls)) (function <))
+ nums (sort (copy-sequence (cddr calls)) (function <))
min (car nums)
max (car (nreverse nums)))
(when (or (< min (car sig))
@@ -1579,7 +1644,7 @@ the `\\\\=[command]' ones that are assumed to be of length
`byte-compile--wide-docstring-substitution-len'. Also ignore
URLs."
(string-match
- (format "^.\\{%s,\\}$" (int-to-string (1+ col)))
+ (format "^.\\{%d,\\}$" (min (1+ col) #xffff)) ; Heed RE_DUP_MAX.
(replace-regexp-in-string
(rx (or
;; Ignore some URLs.
@@ -1587,7 +1652,10 @@ URLs."
;; Ignore these `substitute-command-keys' substitutions.
(seq "\\" (or "="
(seq "<" (* (not ">")) ">")
- (seq "{" (* (not "}")) "}")))))
+ (seq "{" (* (not "}")) "}")))
+ ;; Ignore the function signature that's stashed at the end of
+ ;; the doc string (in some circumstances).
+ (seq bol "(fn (" (* nonl))))
""
;; Heuristic: assume these substitutions are of some length N.
(replace-regexp-in-string
@@ -1641,56 +1709,21 @@ It is too wide if it has any lines longer than the largest of
kind name col))))
form)
-(defun byte-compile-print-syms (str1 strn syms)
- (when syms
- (byte-compile-set-symbol-position (car syms) t))
- (cond ((and (cdr syms) (not noninteractive))
- (let* ((str strn)
- (L (length str))
- s)
- (while syms
- (setq s (symbol-name (pop syms))
- L (+ L (length s) 2))
- (if (< L (1- (buffer-local-value 'fill-column
- (or (get-buffer
- byte-compile-log-buffer)
- (current-buffer)))))
- (setq str (concat str " " s (and syms ",")))
- (setq str (concat str "\n " s (and syms ","))
- L (+ (length s) 4))))
- (byte-compile-warn "%s" str)))
- ((cdr syms)
- (byte-compile-warn "%s %s"
- strn
- (mapconcat #'symbol-name syms ", ")))
-
- (syms
- (byte-compile-warn str1 (car syms)))))
-
;; If we have compiled any calls to functions which are not known to be
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
(when (byte-compile-warning-enabled-p 'unresolved)
- (let ((byte-compile-current-form :end)
- (noruntime nil)
- (unresolved nil))
+ (let ((byte-compile-current-form :end))
;; Separate the functions that will not be available at runtime
;; from the truly unresolved ones.
- (dolist (f byte-compile-unresolved-functions)
- (setq f (car f))
- (when (not (memq f byte-compile-new-defuns))
- (if (fboundp f) (push f noruntime) (push f unresolved))))
- ;; Complain about the no-run-time functions
- (byte-compile-print-syms
- "the function `%s' might not be defined at runtime."
- "the following functions might not be defined at runtime:"
- noruntime)
- ;; Complain about the unresolved functions
- (byte-compile-print-syms
- "the function `%s' is not known to be defined."
- "the following functions are not known to be defined:"
- unresolved)))
+ (dolist (urf byte-compile-unresolved-functions)
+ (let ((f (car urf)))
+ (when (not (memq f byte-compile-new-defuns))
+ (let ((byte-compile-last-position (cadr urf)))
+ (byte-compile-warn
+ (if (fboundp f) "the function `%s' might not be defined at runtime." "the function `%s' is not known to be defined.")
+ (car urf))))))))
nil)
@@ -1728,11 +1761,20 @@ It is too wide if it has any lines longer than the largest of
;; (byte-compile-generate-emacs19-bytecodes
;; byte-compile-generate-emacs19-bytecodes)
(byte-compile-warnings byte-compile-warnings)
+ ;; Indicate that we're not currently loading some file.
+ ;; This is used in `macroexp-file-name' to make sure that
+ ;; loading file A which does (byte-compile-file B) won't
+ ;; cause macro calls in B to think they come from A.
+ (current-load-list (list nil))
)
- ,@body))
+ (prog1
+ (progn ,@body)
+ (when byte-native-compiling
+ (setq byte-to-native-plist-environment
+ overriding-plist-environment)))))
(defmacro displaying-byte-compile-warnings (&rest body)
- (declare (debug t))
+ (declare (debug (def-body)))
`(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
(warning-series-started
(and (markerp warning-series)
@@ -1815,8 +1857,8 @@ also be compiled."
(while directories
(setq directory (car directories))
(message "Checking %s..." directory)
- (dolist (file (directory-files directory))
- (let ((source (expand-file-name file directory)))
+ (dolist (source (directory-files directory t))
+ (let ((file (file-name-nondirectory source)))
(if (file-directory-p source)
(and (not (member file '("RCS" "CVS")))
(not (eq ?\. (aref file 0)))
@@ -1832,8 +1874,7 @@ also be compiled."
(file-readable-p source)
(not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source))
- (not (string-equal dir-locals-file
- (file-name-nondirectory source))))
+ (not (member source (dir-locals--all-files directory))))
(progn (cl-incf
(pcase (byte-recompile-file source force arg)
('no-byte-compile skip-count)
@@ -2041,64 +2082,73 @@ See also `emacs-lisp-byte-compile-and-load'."
(message "Compiling %s...done" filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
- (goto-char (point-max))
- (insert "\n") ; aaah, unix.
- (cond
- ((null target-file) nil) ;We only wanted the warnings!
- ((and (file-writable-p target-file)
- ;; We attempt to create a temporary file in the
- ;; target directory, so the target directory must be
- ;; writable.
- (file-writable-p
- (file-name-directory
- ;; Need to expand in case TARGET-FILE doesn't
- ;; include a directory (Bug#45287).
- (expand-file-name target-file))))
- ;; We must disable any code conversion here.
- (let* ((coding-system-for-write 'no-conversion)
- ;; Write to a tempfile so that if another Emacs
- ;; process is trying to load target-file (eg in a
- ;; parallel bootstrap), it does not risk getting a
- ;; half-finished file. (Bug#4196)
- (tempfile
- (make-temp-file (expand-file-name target-file)))
- (default-modes (default-file-modes))
- (temp-modes (logand default-modes #o600))
- (desired-modes (logand default-modes #o666))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors
- (delete-file tempfile)))
- kill-emacs-hook)))
- (unless (= temp-modes desired-modes)
- (set-file-modes tempfile desired-modes 'nofollow))
- (write-region (point-min) (point-max) tempfile nil 1)
- ;; This has the intentional side effect that any
- ;; hard-links to target-file continue to
- ;; point to the old file (this makes it possible
- ;; for installed files to share disk space with
- ;; the build tree, without causing problems when
- ;; emacs-lisp files in the build tree are
- ;; recompiled). Previously this was accomplished by
- ;; deleting target-file before writing it.
- (rename-file tempfile target-file t))
- (or noninteractive (message "Wrote %s" target-file)))
- ((file-writable-p target-file)
- ;; In case the target directory isn't writable (see e.g. Bug#44631),
- ;; try writing to the output file directly. We must disable any
- ;; code conversion here.
- (let ((coding-system-for-write 'no-conversion))
- (with-file-modes (logand (default-file-modes) #o666)
- (write-region (point-min) (point-max) target-file nil 1)))
- (or noninteractive (message "Wrote %s" target-file)))
- (t
- ;; This is just to give a better error message than write-region
- (let ((exists (file-exists-p target-file)))
- (signal (if exists 'file-error 'file-missing)
- (list "Opening output file"
- (if exists
- "Cannot overwrite file"
- "Directory not writable or nonexistent")
- target-file)))))
+ (when (and target-file
+ (or (not byte-native-compiling)
+ (and byte-native-compiling byte+native-compile)))
+ (goto-char (point-max))
+ (insert "\n") ; aaah, unix.
+ (cond
+ ((and (file-writable-p target-file)
+ ;; We attempt to create a temporary file in the
+ ;; target directory, so the target directory must be
+ ;; writable.
+ (file-writable-p
+ (file-name-directory
+ ;; Need to expand in case TARGET-FILE doesn't
+ ;; include a directory (Bug#45287).
+ (expand-file-name target-file))))
+ ;; We must disable any code conversion here.
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile
+ (make-temp-file (when (file-writable-p target-file)
+ (expand-file-name target-file))))
+ (default-modes (default-file-modes))
+ (temp-modes (logand default-modes #o600))
+ (desired-modes (logand default-modes #o666))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors
+ (delete-file tempfile)))
+ kill-emacs-hook)))
+ (unless (= temp-modes desired-modes)
+ (set-file-modes tempfile desired-modes 'nofollow))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (if byte-native-compiling
+ ;; Defer elc final renaming.
+ (setf byte-to-native-output-file
+ (cons tempfile target-file))
+ (rename-file tempfile target-file t)))
+ (or noninteractive
+ byte-native-compiling
+ (message "Wrote %s" target-file)))
+ ((file-writable-p target-file)
+ ;; In case the target directory isn't writable (see e.g. Bug#44631),
+ ;; try writing to the output file directly. We must disable any
+ ;; code conversion here.
+ (let ((coding-system-for-write 'no-conversion))
+ (with-file-modes (logand (default-file-modes) #o666)
+ (write-region (point-min) (point-max) target-file nil 1)))
+ (or noninteractive (message "Wrote %s" target-file)))
+ (t
+ ;; This is just to give a better error message than write-region
+ (let ((exists (file-exists-p target-file)))
+ (signal (if exists 'file-error 'file-missing)
+ (list "Opening output file"
+ (if exists
+ "Cannot overwrite file"
+ "Directory not writable or nonexistent")
+ target-file))))))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
@@ -2201,6 +2251,17 @@ With argument ARG, insert value in current buffer after the form."
(setq byte-compile-unresolved-functions nil)
(setq byte-compile-noruntime-functions nil)
(setq byte-compile-new-defuns nil)
+ (when byte-native-compiling
+ (defvar native-comp-speed)
+ (push `(native-comp-speed . ,native-comp-speed) byte-native-qualities)
+ (defvar native-comp-debug)
+ (push `(native-comp-debug . ,native-comp-debug) byte-native-qualities)
+ (defvar native-comp-driver-options)
+ (push `(native-comp-driver-options . ,native-comp-driver-options)
+ byte-native-qualities)
+ (defvar no-native-compile)
+ (push `(no-native-compile . ,no-native-compile)
+ byte-native-qualities))
;; Compile the forms from the input buffer.
(while (progn
@@ -2273,6 +2334,10 @@ Call from the source buffer."
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
+ (when byte-native-compiling
+ ;; Spill output for the native compiler here
+ (push (make-byte-to-native-top-level :form form :lexical lexical-binding)
+ byte-to-native-top-level-forms))
(let ((print-escape-newlines t)
(print-length nil)
(print-level nil)
@@ -2390,7 +2455,7 @@ list that represents a doc string reference.
(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form t)))
+ (setq form (byte-optimize-one-form form t)))
(if handler
(let ((byte-compile--for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
@@ -2418,8 +2483,6 @@ list that represents a doc string reference.
byte-compile-output nil
byte-compile-jump-tables nil))))
-(defvar byte-compile-force-lexical-warnings nil)
-
(defun byte-compile-preprocess (form &optional _for-effect)
(setq form (macroexpand-all form byte-compile-macro-environment))
;; FIXME: We should run byte-optimize-form here, but it currently does not
@@ -2430,7 +2493,6 @@ list that represents a doc string reference.
;; (setq form (byte-optimize-form form for-effect)))
(cond
(lexical-binding (cconv-closure-convert form))
- (byte-compile-force-lexical-warnings (cconv-warnings-only form))
(t form)))
;; byte-hunk-handlers cannot call this!
@@ -2496,12 +2558,14 @@ list that represents a doc string reference.
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile--declare-var (sym)
+(defun byte-compile--check-prefixed-var (sym)
(when (and (symbolp sym)
(not (string-match "[-*/:$]" (symbol-name sym)))
(byte-compile-warning-enabled-p 'lexical sym))
- (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
- sym))
+ (byte-compile-warn "global/dynamic var `%s' lacks a prefix" sym)))
+
+(defun byte-compile--declare-var (sym)
+ (byte-compile--check-prefixed-var sym)
(when (memq sym byte-compile-lexical-variables)
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
@@ -2717,6 +2781,15 @@ not to take responsibility for the actual compilation of the code."
;; 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 (documentation code t))) -1 4)))
+ (when byte-native-compiling
+ ;; Spill output for the native compiler here.
+ (push (if macro
+ (make-byte-to-native-top-level
+ :form `(defalias ',name '(macro . ,code) nil)
+ :lexical lexical-binding)
+ (make-byte-to-native-func-def :name name
+ :byte-func code))
+ byte-to-native-top-level-forms))
;; Output the form by hand, that's much simpler than having
;; b-c-output-file-form analyze the defalias.
(byte-compile-output-docform
@@ -2784,16 +2857,12 @@ FUN should be either a `lambda' value or a `closure' value."
(dolist (binding env)
(cond
((consp binding)
- ;; We check shadowing by the args, so that the `let' can be moved
- ;; within the lambda, which can then be unfolded. FIXME: Some of those
- ;; bindings might be unused in `body'.
- (unless (memq (car binding) args) ;Shadowed.
- (push `(,(car binding) ',(cdr binding)) renv)))
+ (push `(,(car binding) ',(cdr binding)) renv))
((eq binding t))
(t (push `(defvar ,binding) body))))
(if (null renv)
`(lambda ,args ,@preamble ,@body)
- `(lambda ,args ,@preamble (let ,(nreverse renv) ,@body)))))
+ `(let ,renv (lambda ,args ,@preamble ,@body)))))
;;;###autoload
(defun byte-compile (form)
@@ -2818,23 +2887,27 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (symbolp form) form "provided"))
fun)
(t
- (when (or (symbolp form) (eq (car-safe fun) 'closure))
- ;; `fun' is a function *value*, so try to recover its corresponding
- ;; source code.
- (setq lexical-binding (eq (car fun) 'closure))
- (setq fun (byte-compile--reify-function fun)))
- ;; Expand macros.
- (setq fun (byte-compile-preprocess fun))
- (setq fun (byte-compile-top-level fun nil 'eval))
- (if (symbolp form)
- ;; byte-compile-top-level returns an *expression* equivalent to the
- ;; `fun' expression, so we need to evaluate it, tho normally
- ;; this is not needed because the expression is just a constant
- ;; byte-code object, which is self-evaluating.
- (setq fun (eval fun t)))
- (if macro (push 'macro fun))
- (if (symbolp form) (fset form fun))
- fun))))))
+ (let (final-eval)
+ (when (or (symbolp form) (eq (car-safe fun) 'closure))
+ ;; `fun' is a function *value*, so try to recover its corresponding
+ ;; source code.
+ (setq lexical-binding (eq (car fun) 'closure))
+ (setq fun (byte-compile--reify-function fun))
+ (setq final-eval t))
+ ;; Expand macros.
+ (setq fun (byte-compile-preprocess fun))
+ (setq fun (byte-compile-top-level fun nil 'eval))
+ (if (symbolp form)
+ ;; byte-compile-top-level returns an *expression* equivalent to the
+ ;; `fun' expression, so we need to evaluate it, tho normally
+ ;; this is not needed because the expression is just a constant
+ ;; byte-code object, which is self-evaluating.
+ (setq fun (eval fun t)))
+ (if final-eval
+ (setq fun (eval fun t)))
+ (if macro (push 'macro fun))
+ (if (symbolp form) (fset form fun))
+ fun)))))))
(defun byte-compile-sexp (sexp)
"Compile and return SEXP."
@@ -2860,7 +2933,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
((eq arg '&optional)
(when (memq '&optional (cdr list))
(error "Duplicate &optional")))
- ((memq arg vars)
+ ((and (memq arg vars)
+ ;; Allow repetitions for unused args.
+ (not (string-match "\\`_" (symbol-name arg))))
(byte-compile-warn "repeated variable %s in lambda-list" arg))
(t
(push arg vars))))
@@ -2940,7 +3015,8 @@ for symbols generated by the byte compiler itself."
;; unless it is the last element of the body.
(if (cdr body)
(setq body (cdr body))))))
- (int (assq 'interactive body)))
+ (int (assq 'interactive body))
+ command-modes)
(when lexical-binding
(dolist (var arglistvars)
(when (assq var byte-compile--known-dynamic-vars)
@@ -2951,10 +3027,13 @@ for symbols generated by the byte compiler itself."
;; Skip (interactive) if it is in front (the most usual location).
(if (eq int (car body))
(setq body (cdr body)))
- (cond ((consp (cdr int))
- (if (cdr (cdr int))
- (byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))
+ (cond ((consp (cdr int)) ; There is an `interactive' spec.
+ ;; Check that the bit after the `interactive' spec is
+ ;; just a list of symbols (i.e., modes).
+ (unless (seq-every-p #'symbolp (cdr (cdr int)))
+ (byte-compile-warn "malformed interactive specc: %s"
+ (prin1-to-string int)))
+ (setq command-modes (cdr (cdr int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
@@ -2965,15 +3044,14 @@ for symbols generated by the byte compiler itself."
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
- (if (and (eq (car-safe form) 'list)
- ;; For code using lexical-binding, form is not
- ;; valid lisp, but rather an intermediate form
- ;; which may include "calls" to
- ;; internal-make-closure (Bug#29988).
- (not lexical-binding))
- nil
- (setq int `(interactive ,newform)))))
- ((cdr int)
+ (when (or (not (eq (car-safe form) 'list))
+ ;; For code using lexical-binding, form is not
+ ;; valid lisp, but rather an intermediate form
+ ;; which may include "calls" to
+ ;; internal-make-closure (Bug#29988).
+ lexical-binding)
+ (setq int `(interactive ,newform)))))
+ ((cdr int) ; Invalid (interactive . something).
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int)))))
;; Process the body.
@@ -2989,23 +3067,37 @@ for symbols generated by the byte compiler itself."
reserved-csts)))
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
- (apply #'make-byte-code
- (if lexical-binding
- (byte-compile-make-args-desc arglist)
- arglist)
- (append
- ;; byte-string, constants-vector, stack depth
- (cdr compiled)
- ;; optionally, the doc string.
- (cond ((and lexical-binding arglist)
- ;; byte-compile-make-args-desc lost the args's names,
- ;; so preserve them in the docstring.
- (list (help-add-fundoc-usage doc arglist)))
- ((or doc int)
- (list doc)))
- ;; optionally, the interactive spec.
- (if int
- (list (nth 1 int))))))))
+ (let ((out
+ (apply #'make-byte-code
+ (if lexical-binding
+ (byte-compile-make-args-desc arglist)
+ arglist)
+ (append
+ ;; byte-string, constants-vector, stack depth
+ (cdr compiled)
+ ;; optionally, the doc string.
+ (cond ((and lexical-binding arglist)
+ ;; byte-compile-make-args-desc lost the args's names,
+ ;; so preserve them in the docstring.
+ (list (help-add-fundoc-usage doc arglist)))
+ ((or doc int)
+ (list doc)))
+ ;; optionally, the interactive spec (and the modes the
+ ;; command applies to).
+ (cond
+ ;; We have some command modes, so use the vector form.
+ (command-modes
+ (list (vector (nth 1 int) command-modes)))
+ ;; No command modes, use the simple form with just the
+ ;; interactive spec.
+ (int
+ (list (nth 1 int))))))))
+ (when byte-native-compiling
+ (setf (byte-to-native-lambda-byte-func
+ (gethash (cadr compiled)
+ byte-to-native-lambdas-h))
+ out))
+ out))))
(defvar byte-compile-reserved-constants 0)
@@ -3063,7 +3155,7 @@ for symbols generated by the byte compiler itself."
(byte-compile-output nil)
(byte-compile-jump-tables nil))
(if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form byte-compile--for-effect)))
+ (setq form (byte-optimize-one-form form byte-compile--for-effect)))
(while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
(setq form (nth 1 form)))
;; Set up things for a lexically-bound function.
@@ -3277,7 +3369,7 @@ for symbols generated by the byte compiler itself."
((and (eq (car-safe (car form)) 'lambda)
;; if the form comes out the same way it went in, that's
;; because it was malformed, and we couldn't unfold it.
- (not (eq form (setq form (byte-compile-unfold-lambda form)))))
+ (not (eq form (setq form (macroexp--unfold-lambda form)))))
(byte-compile-form form byte-compile--for-effect)
(setq byte-compile--for-effect nil))
((byte-compile-normal-call form)))
@@ -3806,15 +3898,38 @@ discarding."
(cl-assert (or (> (length env) 0)
docstring-exp)) ;Otherwise, we don't need a closure.
(cl-assert (byte-code-function-p fun))
- (byte-compile-form `(make-byte-code
- ',(aref fun 0) ',(aref fun 1)
- (vconcat (vector . ,env) ',(aref fun 2))
- ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
- (if docstring-exp
- `(,(car rest)
- ,docstring-exp
- ,@(cddr rest))
- rest)))))))
+ (byte-compile-form
+ (if (or (not docstring-exp) (stringp docstring-exp))
+ ;; Use symbols V0, V1 ... as placeholders for closure variables:
+ ;; they should be short (to save space in the .elc file), yet
+ ;; distinct when disassembled.
+ (let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i)))
+ (number-sequence 0 (1- (length env)))))
+ (opt-args (mapcar (lambda (i) (aref fun i))
+ (number-sequence 4 (1- (length fun)))))
+ (proto-fun
+ (apply #'make-byte-code
+ (aref fun 0) (aref fun 1)
+ ;; Prepend dummy cells to the constant vector,
+ ;; to get the indices right when disassembling.
+ (vconcat dummy-vars (aref fun 2))
+ (aref fun 3)
+ (if docstring-exp
+ (cons docstring-exp (cdr opt-args))
+ opt-args))))
+ `(make-closure ,proto-fun ,@env))
+ ;; Nontrivial doc string expression: create a bytecode object
+ ;; from small pieces at run time.
+ `(make-byte-code
+ ',(aref fun 0) ',(aref fun 1)
+ (vconcat (vector . ,env) ',(aref fun 2))
+ ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
+ (if docstring-exp
+ `(,(car rest)
+ ,docstring-exp
+ ,@(cddr rest))
+ rest))))
+ ))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."
@@ -4148,9 +4263,15 @@ that suppresses all warnings during execution of BODY."
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
,condition '(boundp default-boundp local-variable-p)))
+ (new-bound-list
+ ;; (seq-difference byte-compile-bound-variables))
+ (delq nil (mapcar (lambda (s)
+ (if (memq s byte-compile-bound-variables) nil s))
+ bound-list)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
- (append bound-list byte-compile-bound-variables)))
+ (append new-bound-list byte-compile-bound-variables)))
+ (mapc #'byte-compile--check-prefixed-var new-bound-list)
(unwind-protect
;; If things not being bound at all is ok, so must them being
;; obsolete. Note that we add to the existing lists since Tramp
@@ -4236,6 +4357,17 @@ Return (TAIL VAR TEST CASES), where:
(push value keys)
(push (cons (list value) (or body '(t))) cases))
t))))
+ ;; Treat (not X) as (eq X nil).
+ (`((,(or 'not 'null) ,(and var (pred symbolp))) . ,body)
+ (and (or (eq var switch-var) (not switch-var))
+ (progn
+ (setq switch-var var)
+ (setq switch-test
+ (byte-compile--common-test switch-test 'eq))
+ (unless (memq nil keys)
+ (push nil keys)
+ (push (cons (list nil) (or body '(t))) cases))
+ t)))
(`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body)
(and (symbolp var)
(or (eq var switch-var) (not switch-var))
@@ -4608,10 +4740,15 @@ binding slots have been popped."
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
+ (handlers (nthcdr 3 form))
(depth byte-compile-depth)
+ (success-handler (assq :success handlers))
+ (failure-handlers (if success-handler
+ (remq success-handler handlers)
+ handlers))
(clauses (mapcar (lambda (clause)
(cons (byte-compile-make-tag) clause))
- (nthcdr 3 form)))
+ failure-handlers))
(endtag (byte-compile-make-tag)))
(byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
@@ -4637,30 +4774,40 @@ binding slots have been popped."
(byte-compile-form body) ;; byte-compile--for-effect
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
- (byte-compile-goto 'byte-goto endtag)
- (while clauses
- (let ((clause (pop clauses))
- (byte-compile-bound-variables byte-compile-bound-variables)
- (byte-compile--lexical-environment
- byte-compile--lexical-environment))
- (setq byte-compile-depth (1+ depth))
- (byte-compile-out-tag (pop clause))
- (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
- (cond
- ((null var) (byte-compile-discard))
- (lexical-binding
- (push (cons var (1- byte-compile-depth))
- byte-compile--lexical-environment))
- (t (byte-compile-dynamic-variable-bind var)))
- (byte-compile-body (cdr clause)) ;; byte-compile--for-effect
- (cond
- ((null var) nil)
- (lexical-binding (byte-compile-discard 1 'preserve-tos))
- (t (byte-compile-out 'byte-unbind 1)))
- (byte-compile-goto 'byte-goto endtag)))
+ (let ((compile-handler-body
+ (lambda (body)
+ (let ((byte-compile-bound-variables byte-compile-bound-variables)
+ (byte-compile--lexical-environment
+ byte-compile--lexical-environment))
+ (cond
+ ((null var) (byte-compile-discard))
+ (lexical-binding
+ (push (cons var (1- byte-compile-depth))
+ byte-compile--lexical-environment))
+ (t (byte-compile-dynamic-variable-bind var)))
- (byte-compile-out-tag endtag)))
+ (byte-compile-body body) ;; byte-compile--for-effect
+
+ (cond
+ ((null var))
+ (lexical-binding (byte-compile-discard 1 'preserve-tos))
+ (t (byte-compile-out 'byte-unbind 1)))))))
+
+ (when success-handler
+ (funcall compile-handler-body (cdr success-handler)))
+
+ (byte-compile-goto 'byte-goto endtag)
+
+ (while clauses
+ (let ((clause (pop clauses)))
+ (setq byte-compile-depth (1+ depth))
+ (byte-compile-out-tag (pop clause))
+ (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+ (funcall compile-handler-body (cdr clause))
+ (byte-compile-goto 'byte-goto endtag)))
+
+ (byte-compile-out-tag endtag))))
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
@@ -4868,10 +5015,10 @@ binding slots have been popped."
(byte-compile-push-constant op)
(byte-compile-form fun)
(byte-compile-form prop)
- (let* ((fun (eval fun))
- (prop (eval prop))
+ (let* ((fun (eval fun t))
+ (prop (eval prop t))
(val (if (macroexp-const-p val)
- (eval val)
+ (eval val t)
(byte-compile-lambda (cadr val)))))
(push `(,fun
. (,prop ,val ,@(alist-get fun overriding-plist-environment)))
@@ -5189,8 +5336,10 @@ already up-to-date."
"Reload any Lisp file that was changed since Emacs was dumped.
Use with caution."
(let* ((argv0 (car command-line-args))
- (emacs-file (executable-find argv0)))
- (if (not (and emacs-file (file-executable-p emacs-file)))
+ (emacs-file (or (and (fboundp 'pdumper-stats)
+ (cdr (nth 2 (pdumper-stats))))
+ (executable-find argv0))))
+ (if (not (and emacs-file (file-exists-p emacs-file)))
(message "Can't find %s to refresh preloaded Lisp files" argv0)
(dolist (f (reverse load-history))
(setq f (car f))
@@ -5203,7 +5352,7 @@ Use with caution."
;; so it can cause recompilation to fail.
(not (member (file-name-nondirectory f)
'("pcase.el" "bytecomp.el" "macroexp.el"
- "cconv.el" "byte-opt.el"))))
+ "cconv.el" "byte-opt.el" "comp.el"))))
(message "Reloading stale %s" (file-name-nondirectory f))
(condition-case nil
(load f 'noerror nil 'nosuffix)
@@ -5284,13 +5433,15 @@ and corresponding effects."
;;
(eval-when-compile
(or (byte-code-function-p (symbol-function 'byte-compile-form))
+ (subr-native-elisp-p (symbol-function 'byte-compile-form))
(assq 'byte-code (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
(mapc (lambda (x)
- (or noninteractive (message "compiling %s..." x))
- (byte-compile x)
- (or noninteractive (message "compiling %s...done" x)))
+ (unless (subr-native-elisp-p x)
+ (or noninteractive (message "compiling %s..." x))
+ (byte-compile x)
+ (or noninteractive (message "compiling %s...done" x))))
'(byte-compile-normal-call
byte-compile-form
byte-compile-body
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e79583974a8..3abbf716875 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,4 +1,4 @@
-;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
+;;; cconv.el --- Closure conversion for statically scoped Emacs Lisp. -*- lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -121,19 +121,22 @@
(defconst cconv-liftwhen 6
"Try to do lambda lifting if the number of arguments + free variables
is less than this number.")
-;; List of all the variables that are both captured by a closure
-;; and mutated. Each entry in the list takes the form
-;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the
-;; variable (or is just (VAR) for variables not introduced by let).
-(defvar cconv-captured+mutated)
-
-;; List of candidates for lambda lifting.
-;; Each candidate has the form (BINDER . PARENTFORM). A candidate
-;; is a variable that is only passed to `funcall' or `apply'.
-(defvar cconv-lambda-candidates)
-
-;; Alist associating to each function body the list of its free variables.
-(defvar cconv-freevars-alist)
+(defvar cconv-var-classification
+ ;; Alist mapping variables to a given class.
+ ;; The keys are of the form (BINDER . PARENTFORM) where BINDER
+ ;; is the (VAR VAL) that introduces it (or is just (VAR) for variables
+ ;; not introduced by let).
+ ;; The class can be one of:
+ ;; - :unused
+ ;; - :lambda-candidate
+ ;; - :captured+mutated
+ ;; - nil for "normal" variables, which would then just not appear
+ ;; in the alist at all.
+ )
+
+(defvar cconv-freevars-alist
+ ;; Alist associating to each function body the list of its free variables.
+ )
;;;###autoload
(defun cconv-closure-convert (form)
@@ -144,25 +147,13 @@ is less than this number.")
Returns a form where all lambdas don't have any free variables."
;; (message "Entering cconv-closure-convert...")
(let ((cconv-freevars-alist '())
- (cconv-lambda-candidates '())
- (cconv-captured+mutated '()))
+ (cconv-var-classification '()))
;; Analyze form - fill these variables with new information.
(cconv-analyze-form form '())
(setq cconv-freevars-alist (nreverse cconv-freevars-alist))
(prog1 (cconv-convert form nil nil) ; Env initially empty.
(cl-assert (null cconv-freevars-alist)))))
-;;;###autoload
-(defun cconv-warnings-only (form)
- "Add the warnings that closure conversion would encounter."
- (let ((cconv-freevars-alist '())
- (cconv-lambda-candidates '())
- (cconv-captured+mutated '()))
- ;; Analyze form - fill these variables with new information.
- (cconv-analyze-form form '())
- ;; But don't perform the closure conversion.
- form))
-
(defconst cconv--dummy-var (make-symbol "ignored"))
(defun cconv--set-diff (s1 s2)
@@ -261,28 +252,56 @@ Returns a form where all lambdas don't have any free variables."
(nthcdr 3 mapping)))))
new-env))
+(defun cconv--warn-unused-msg (var varkind)
+ (unless (or ;; Uninterned symbols typically come from macro-expansion, so
+ ;; it is often non-trivial for the programmer to avoid such
+ ;; unused vars.
+ (not (intern-soft var))
+ (eq ?_ (aref (symbol-name var) 0))
+ ;; As a special exception, ignore "ignore".
+ (eq var 'ignored))
+ (let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
+ (format "Unused lexical %s `%S'%s"
+ varkind var
+ (if suggestions (concat "\n " suggestions) "")))))
+
+(define-inline cconv--var-classification (binder form)
+ (inline-quote
+ (alist-get (cons ,binder ,form) cconv-var-classification
+ nil nil #'equal)))
+
(defun cconv--convert-funcbody (funargs funcbody env parentform)
"Run `cconv-convert' on FUNCBODY, the forms of a lambda expression.
PARENTFORM is the form containing the lambda expression. ENV is a
lexical environment (same format as for `cconv-convert'), not
including FUNARGS, the function's argument list. Return a list
of converted forms."
- (let ((letbind ()))
+ (let ((wrappers ()))
(dolist (arg funargs)
- (if (not (member (cons (list arg) parentform) cconv-captured+mutated))
- (if (assq arg env) (push `(,arg . nil) env))
- (push `(,arg . (car-safe ,arg)) env)
- (push `(,arg (list ,arg)) letbind)))
+ (pcase (cconv--var-classification (list arg) parentform)
+ (:captured+mutated
+ (push `(,arg . (car-safe ,arg)) env)
+ (push (lambda (body) `(let ((,arg (list ,arg))) ,body)) wrappers))
+ ((and :unused
+ (let (and (pred stringp) msg)
+ (cconv--warn-unused-msg arg "argument")))
+ (if (assq arg env) (push `(,arg . nil) env)) ;FIXME: Is it needed?
+ (push (lambda (body) (macroexp--warn-wrap msg body 'lexical)) wrappers))
+ (_
+ (if (assq arg env) (push `(,arg . nil) env)))))
(setq funcbody (mapcar (lambda (form)
(cconv-convert form env nil))
funcbody))
- (if letbind
+ (if wrappers
(let ((special-forms '()))
;; Keep special forms at the beginning of the body.
- (while (or (stringp (car funcbody)) ;docstring.
- (memq (car-safe (car funcbody)) '(interactive declare)))
+ (while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring.
+ (memq (car-safe (car funcbody))
+ '(interactive declare :documentation)))
(push (pop funcbody) special-forms))
- `(,@(nreverse special-forms) (let ,letbind . ,funcbody)))
+ (let ((body (macroexp-progn funcbody)))
+ (dolist (wrapper wrappers) (setq body (funcall wrapper body)))
+ `(,@(nreverse special-forms) ,@(macroexp-unprogn body))))
funcbody)))
(defun cconv-convert (form env extend)
@@ -338,69 +357,91 @@ places where they originally did not directly appear."
"Malformed `%S' binding: %S"
letsym binder))
(setq value (cadr binder))
- (car binder)))
- (new-val
- (cond
- ;; Check if var is a candidate for lambda lifting.
- ((and (member (cons binder form) cconv-lambda-candidates)
- (progn
- (cl-assert (and (eq (car value) 'function)
- (eq (car (cadr value)) 'lambda)))
- (cl-assert (equal (cddr (cadr value))
- (caar cconv-freevars-alist)))
- ;; Peek at the freevars to decide whether to λ-lift.
- (let* ((fvs (cdr (car cconv-freevars-alist)))
- (fun (cadr value))
- (funargs (cadr fun))
- (funcvars (append fvs funargs)))
+ (car binder))))
+ (cond
+ ;; Ignore bindings without a valid name.
+ ((not (symbolp var))
+ (byte-compile-warn "attempt to let-bind nonvariable `%S'" var))
+ ((or (booleanp var) (keywordp var))
+ (byte-compile-warn "attempt to let-bind constant `%S'" var))
+ (t
+ (let ((new-val
+ (pcase (cconv--var-classification binder form)
+ ;; Check if var is a candidate for lambda lifting.
+ ((and :lambda-candidate
+ (guard
+ (progn
+ (cl-assert (and (eq (car value) 'function)
+ (eq (car (cadr value)) 'lambda)))
+ (cl-assert (equal (cddr (cadr value))
+ (caar cconv-freevars-alist)))
+ ;; Peek at the freevars to decide whether
+ ;; to λ-lift.
+ (let* ((fvs (cdr (car cconv-freevars-alist)))
+ (fun (cadr value))
+ (funargs (cadr fun))
+ (funcvars (append fvs funargs)))
; lambda lifting condition
- (and fvs (>= cconv-liftwhen (length funcvars))))))
+ (and fvs (>= cconv-liftwhen
+ (length funcvars)))))))
; Lift.
- (let* ((fvs (cdr (pop cconv-freevars-alist)))
- (fun (cadr value))
- (funargs (cadr fun))
- (funcvars (append fvs funargs))
- (funcbody (cddr fun))
- (funcbody-env ()))
- (push `(,var . (apply-partially ,var . ,fvs)) new-env)
- (dolist (fv fvs)
- (cl-pushnew fv new-extend)
- (if (and (eq 'car-safe (car-safe (cdr (assq fv env))))
- (not (memq fv funargs)))
- (push `(,fv . (car-safe ,fv)) funcbody-env)))
- `(function (lambda ,funcvars .
- ,(cconv--convert-funcbody
- funargs funcbody funcbody-env value)))))
-
- ;; Check if it needs to be turned into a "ref-cell".
- ((member (cons binder form) cconv-captured+mutated)
- ;; Declared variable is mutated and captured.
- (push `(,var . (car-safe ,var)) new-env)
- `(list ,(cconv-convert value env extend)))
-
- ;; Normal default case.
- (t
- (if (assq var new-env) (push `(,var) new-env))
- (cconv-convert value env extend)))))
-
- (when (and (eq letsym 'let*) (memq var new-extend))
- ;; One of the lambda-lifted vars is shadowed, so add
- ;; a reference to the outside binding and arrange to use
- ;; that reference.
- (let ((closedsym (make-symbol (format "closed-%s" var))))
- (setq new-env (cconv--remap-llv new-env var closedsym))
- (setq new-extend (cons closedsym (remq var new-extend)))
- (push `(,closedsym ,var) binders-new)))
-
- ;; We push the element after redefined free variables are
- ;; processed. This is important to avoid the bug when free
- ;; variable and the function have the same name.
- (push (list var new-val) binders-new)
-
- (when (eq letsym 'let*)
- (setq env new-env)
- (setq extend new-extend))
- )) ; end of dolist over binders
+ (let* ((fvs (cdr (pop cconv-freevars-alist)))
+ (fun (cadr value))
+ (funargs (cadr fun))
+ (funcvars (append fvs funargs))
+ (funcbody (cddr fun))
+ (funcbody-env ()))
+ (push `(,var . (apply-partially ,var . ,fvs)) new-env)
+ (dolist (fv fvs)
+ (cl-pushnew fv new-extend)
+ (if (and (eq 'car-safe (car-safe
+ (cdr (assq fv env))))
+ (not (memq fv funargs)))
+ (push `(,fv . (car-safe ,fv)) funcbody-env)))
+ `(function (lambda ,funcvars .
+ ,(cconv--convert-funcbody
+ funargs funcbody funcbody-env value)))))
+
+ ;; Check if it needs to be turned into a "ref-cell".
+ (:captured+mutated
+ ;; Declared variable is mutated and captured.
+ (push `(,var . (car-safe ,var)) new-env)
+ `(list ,(cconv-convert value env extend)))
+
+ ;; Check if it needs to be turned into a "ref-cell".
+ (:unused
+ ;; Declared variable is unused.
+ (if (assq var new-env)
+ (push `(,var) new-env)) ;FIXME:Needed?
+ (let ((newval
+ `(ignore ,(cconv-convert value env extend)))
+ (msg (cconv--warn-unused-msg var "variable")))
+ (if (null msg) newval
+ (macroexp--warn-wrap msg newval 'lexical))))
+
+ ;; Normal default case.
+ (_
+ (if (assq var new-env) (push `(,var) new-env))
+ (cconv-convert value env extend)))))
+
+ (when (and (eq letsym 'let*) (memq var new-extend))
+ ;; One of the lambda-lifted vars is shadowed, so add
+ ;; a reference to the outside binding and arrange to use
+ ;; that reference.
+ (let ((closedsym (make-symbol (format "closed-%s" var))))
+ (setq new-env (cconv--remap-llv new-env var closedsym))
+ (setq new-extend (cons closedsym (remq var new-extend)))
+ (push `(,closedsym ,var) binders-new)))
+
+ ;; We push the element after redefined free variables are
+ ;; processed. This is important to avoid the bug when free
+ ;; variable and the function have the same name.
+ (push (list var new-val) binders-new)
+
+ (when (eq letsym 'let*)
+ (setq env new-env)
+ (setq extend new-extend))))))
+ ) ; end of dolist over binders
(when (not (eq letsym 'let*))
;; We can't do the cconv--remap-llv at the same place for let and
@@ -464,22 +505,28 @@ places where they originally did not directly appear."
; condition-case
(`(condition-case ,var ,protected-form . ,handlers)
- `(condition-case ,var
- ,(cconv-convert protected-form env extend)
- ,@(let* ((cm (and var (member (cons (list var) form)
- cconv-captured+mutated)))
- (newenv
- (cond (cm (cons `(,var . (car-save ,var)) env))
- ((assq var env) (cons `(,var) env))
- (t env))))
- (mapcar
+ (let* ((class (and var (cconv--var-classification (list var) form)))
+ (newenv
+ (cond ((eq class :captured+mutated)
+ (cons `(,var . (car-safe ,var)) env))
+ ((assq var env) (cons `(,var) env))
+ (t env)))
+ (msg (when (eq class :unused)
+ (cconv--warn-unused-msg var "variable")))
+ (newprotform (cconv-convert protected-form env extend)))
+ `(condition-case ,var
+ ,(if msg
+ (macroexp--warn-wrap msg newprotform 'lexical)
+ newprotform)
+ ,@(mapcar
(lambda (handler)
`(,(car handler)
,@(let ((body
(mapcar (lambda (form)
(cconv-convert form newenv extend))
(cdr handler))))
- (if (not cm) body
+ (if (not (eq class :captured+mutated))
+ body
`((let ((,var (list ,var))) ,@body))))))
handlers))))
@@ -548,9 +595,6 @@ places where they originally did not directly appear."
(_ (or (cdr (assq form env)) form))))
-(unless (fboundp 'byte-compile-not-lexical-var-p)
- ;; Only used to test the code in non-lexbind Emacs.
- (defalias 'byte-compile-not-lexical-var-p 'boundp))
(defvar byte-compile-lexical-variables)
(defun cconv--analyze-use (vardata form varkind)
@@ -563,29 +607,30 @@ FORM is the parent form that binds this var."
(`(,_ nil nil nil nil) nil)
(`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
+ ;; FIXME: Convert this warning to use `macroexp--warn-wrap'
+ ;; so as to give better position information and obey
+ ;; `byte-compile-warnings'.
(byte-compile-warn
- "%s `%S' not left unused" varkind var)))
+ "%s `%S' not left unused" varkind var))
+ ((and (let (or 'let* 'let) (car form))
+ `((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
+ t nil ,_ ,_))
+ ;; FIXME: Convert this warning to use `macroexp--warn-wrap'
+ ;; so as to give better position information and obey
+ ;; `byte-compile-warnings'.
+ (unless (not (intern-soft var))
+ (byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata
- (`((,var . ,_) nil ,_ ,_ nil)
- ;; FIXME: This gives warnings in the wrong order, with imprecise line
- ;; numbers and without function name info.
- (unless (or ;; Uninterned symbols typically come from macro-expansion, so
- ;; it is often non-trivial for the programmer to avoid such
- ;; unused vars.
- (not (intern-soft var))
- (eq ?_ (aref (symbol-name var) 0))
- ;; As a special exception, ignore "ignore".
- (eq var 'ignored))
- (let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
- (byte-compile-warn "Unused lexical %s `%S'%s"
- varkind var
- (if suggestions (concat "\n " suggestions) "")))))
+ (`(,binder nil ,_ ,_ nil)
+ (push (cons (cons binder form) :unused) cconv-var-classification))
;; If it's unused, there's no point converting it into a cons-cell, even if
;; it's captured and mutated.
(`(,binder ,_ t t ,_)
- (push (cons binder form) cconv-captured+mutated))
+ (push (cons (cons binder form) :captured+mutated)
+ cconv-var-classification))
(`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
- (push (cons binder form) cconv-lambda-candidates))))
+ (push (cons (cons binder form) :lambda-candidate)
+ cconv-var-classification))))
(defun cconv--analyze-function (args body env parentform)
(let* ((newvars nil)
@@ -638,8 +683,7 @@ Analyze lambdas if they are suitable for lambda lifting.
- ENV is an alist mapping each enclosing lexical variable to its info.
I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
This function does not return anything but instead fills the
-`cconv-captured+mutated' and `cconv-lambda-candidates' variables
-and updates the data stored in ENV."
+`cconv-var-classification' variable and updates the data stored in ENV."
(pcase form
; let special form
(`(,(and (or 'let* 'let) letsym) ,binders . ,body-forms)
@@ -756,7 +800,7 @@ and updates the data stored in ENV."
(let ((dv (assq form env))) ; dv = declared and visible
(when dv
(setf (nth 1 dv) t))))))
-(define-obsolete-function-alias 'cconv-analyse-form 'cconv-analyze-form "25.1")
+(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1")
(provide 'cconv)
;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 7d760ffc57f..0494497feaf 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -89,33 +89,39 @@ Useful if new Emacs is used on B&W display.")
(declare-function x-display-color-cells "xfns.c" (&optional terminal))
-(defvar chart-face-list
- (if (display-color-p)
- (let ((cl chart-face-color-list)
- (pl chart-face-pixmap-list)
- (faces ())
- nf)
- (while cl
- (setq nf (make-face
- (intern (concat "chart-" (car cl) "-" (car pl)))))
- (set-face-background nf (if (condition-case nil
- (> (x-display-color-cells) 4)
- (error t))
- (car cl)
- "white"))
- (set-face-foreground nf "black")
- (if (and chart-face-use-pixmaps pl)
- (condition-case nil
- (set-face-background-pixmap nf (car pl))
- (error (message "Cannot set background pixmap %s" (car pl)))))
- (push nf faces)
- (setq cl (cdr cl)
- pl (cdr pl)))
- faces))
+(defvar chart-face-list #'chart--face-list
"Faces used to colorize charts.
+This should either be a list of faces, or a function that returns
+a list of faces.
+
List is limited currently, which is ok since you really can't display
too much in text characters anyways.")
+(defun chart--face-list ()
+ (and
+ (display-color-p)
+ (let ((cl chart-face-color-list)
+ (pl chart-face-pixmap-list)
+ (faces ())
+ nf)
+ (while cl
+ (setq nf (make-face
+ (intern (concat "chart-" (car cl) "-" (car pl)))))
+ (set-face-background nf (if (condition-case nil
+ (> (x-display-color-cells) 4)
+ (error t))
+ (car cl)
+ "white"))
+ (set-face-foreground nf "black")
+ (if (and chart-face-use-pixmaps pl)
+ (condition-case nil
+ (set-face-background-pixmap nf (car pl))
+ (error (message "Cannot set background pixmap %s" (car pl)))))
+ (push nf faces)
+ (setq cl (cdr cl)
+ pl (cdr pl)))
+ faces)))
+
(define-derived-mode chart-mode special-mode "Chart"
"Define a mode in Emacs for displaying a chart."
(buffer-disable-undo)
@@ -187,7 +193,7 @@ Make sure the width/height is correct."
)
"Class used to display an axis which represents different named items.")
-(defclass chart-sequece ()
+(defclass chart-sequence ()
((data :initarg :data
:initform nil)
(name :initarg :name
@@ -197,7 +203,7 @@ Make sure the width/height is correct."
(defclass chart-bar (chart)
((direction :initarg :direction
- :initform vertical))
+ :initform 'vertical))
"Subclass for bar charts (vertical or horizontal).")
(cl-defmethod chart-draw ((c chart) &optional buff)
@@ -374,7 +380,10 @@ of the drawing."
(let* ((data (oref c sequences))
(dir (oref c direction))
(odir (if (eq dir 'vertical) 'horizontal 'vertical))
- )
+ (faces
+ (if (functionp chart-face-list)
+ (funcall chart-face-list)
+ chart-face-list)))
(while data
(if (stringp (car (oref (car data) data)))
;; skip string lists...
@@ -390,10 +399,9 @@ of the drawing."
(zp (if (eq dir 'vertical)
(chart-translate-ypos c 0)
(chart-translate-xpos c 0)))
- (fc (if chart-face-list
- (nth (% i (length chart-face-list)) chart-face-list)
- 'default))
- )
+ (fc (if faces
+ (nth (% i (length faces)) faces)
+ 'default)))
(if (< dp zp)
(progn
(chart-draw-line dir (car rng) dp zp)
@@ -583,12 +591,12 @@ SORT-PRED if desired."
))
(iv (eq dir 'vertical)))
(chart-add-sequence nc
- (make-instance 'chart-sequece
+ (make-instance 'chart-sequence
:data namelst
:name nametitle)
(if iv 'x-axis 'y-axis))
(chart-add-sequence nc
- (make-instance 'chart-sequece
+ (make-instance 'chart-sequence
:data numlst
:name numtitle)
(if iv 'y-axis 'x-axis))
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 7c2b23b4ec4..bec4ad92503 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -328,4 +328,4 @@ Returns non-nil if any false statements are found."
(provide 'check-declare)
-;;; check-declare.el ends here.
+;;; check-declare.el ends here
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 75aefdc7ba0..00cc7777e1a 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -160,9 +160,6 @@
;; not specifically docstring related. Would this even be useful?
;;; Code:
-(defvar checkdoc-version "0.6.2"
- "Release version of checkdoc you are currently running.")
-(make-obsolete-variable 'checkdoc-version nil "28.1")
(require 'cl-lib)
(require 'help-mode) ;; for help-xref-info-regexp
@@ -931,16 +928,20 @@ don't move point."
;; Don't bug out if the file is empty (or a
;; definition ends prematurely.
(end-of-file)))
- (`(,(or 'defun 'defvar 'defcustom 'defmacro 'defconst 'defsubst 'defadvice
- 'cl-defun 'cl-defgeneric 'cl-defmethod 'cl-defmacro)
+ (`(,(and (pred symbolp) def
+ (let (and doc (guard doc)) (function-get def 'doc-string-elt)))
,(pred symbolp)
;; Require an initializer, i.e. ignore single-argument `defvar'
;; forms, which never have a doc string.
,_ . ,_)
(down-list)
- ;; Skip over function or macro name, symbol to be defined, and
- ;; initializer or argument list.
- (forward-sexp 3)
+ ;; Skip over function or macro name.
+ (forward-sexp 1)
+ ;; And now skip until the docstring.
+ (forward-sexp (1- ; We already skipped the function or macro name.
+ (cond
+ ((numberp doc) doc)
+ ((functionp doc) (funcall doc)))))
(skip-chars-forward " \n\t")
t)))
@@ -1241,7 +1242,7 @@ bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-c
checking of documentation strings.
\\{checkdoc-minor-mode-map}"
- nil checkdoc-minor-mode-string nil
+ :lighter checkdoc-minor-mode-string
:group 'checkdoc)
;;; Subst utils
@@ -2130,8 +2131,8 @@ buffer, otherwise stop after the first error."
(user-error "No spellchecker installed: check the variable `ispell-program-name'"))
(save-excursion
(skip-chars-forward "^a-zA-Z")
- (let (word sym case-fold-search err word-beginning word-end)
- (while (and (not err) (< (point) end))
+ (let (word sym case-fold-search word-beginning word-end) ;; err
+ (while (and (< (point) end)) ;; (not err)
(if (save-excursion (forward-char -1) (looking-at "[('`]"))
;; Skip lists describing meta-syntax, or bound variables
(forward-sexp 1)
@@ -2163,7 +2164,7 @@ buffer, otherwise stop after the first error."
(sit-for 0)
(message "Continuing..."))))))))
(skip-chars-forward "^a-zA-Z"))
- err))))
+ nil)))) ;; err
;;; Rogue space checking engine
;;
@@ -2705,6 +2706,12 @@ function called to create the messages."
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
+;; Obsolete
+
+(defvar checkdoc-version "0.6.2"
+ "Release version of checkdoc you are currently running.")
+(make-obsolete-variable 'checkdoc-version 'emacs-version "28.1")
+
(provide 'checkdoc)
;;; checkdoc.el ends here
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 28ce6b115a4..3840d13ecff 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -94,7 +94,7 @@ strings case-insensitively."
(defun cl--mapcar-many (cl-func cl-seqs &optional acc)
(if (cdr (cdr cl-seqs))
(let* ((cl-res nil)
- (cl-n (apply 'min (mapcar 'length cl-seqs)))
+ (cl-n (apply #'min (mapcar #'length cl-seqs)))
(cl-i 0)
(cl-args (copy-sequence cl-seqs))
cl-p1 cl-p2)
@@ -131,7 +131,7 @@ strings case-insensitively."
"Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
TYPE is the sequence type to return.
\n(fn TYPE FUNCTION SEQUENCE...)"
- (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest)))
+ (let ((cl-res (apply #'cl-mapcar cl-func cl-seq cl-rest)))
(and cl-type (cl-coerce cl-res cl-type))))
;;;###autoload
@@ -190,14 +190,14 @@ the elements themselves.
"Like `cl-mapcar', but nconc's together the values returned by the function.
\n(fn FUNCTION SEQUENCE...)"
(if cl-rest
- (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest))
+ (apply #'nconc (apply #'cl-mapcar cl-func cl-seq cl-rest))
(mapcan cl-func cl-seq)))
;;;###autoload
(defun cl-mapcon (cl-func cl-list &rest cl-rest)
"Like `cl-maplist', but nconc's together the values returned by the function.
\n(fn FUNCTION LIST...)"
- (apply 'nconc (apply 'cl-maplist cl-func cl-list cl-rest)))
+ (apply #'nconc (apply #'cl-maplist cl-func cl-list cl-rest)))
;;;###autoload
(defun cl-some (cl-pred cl-seq &rest cl-rest)
@@ -236,13 +236,13 @@ non-nil value.
(defun cl-notany (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of every element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
- (not (apply 'cl-some cl-pred cl-seq cl-rest)))
+ (not (apply #'cl-some cl-pred cl-seq cl-rest)))
;;;###autoload
(defun cl-notevery (cl-pred cl-seq &rest cl-rest)
"Return true if PREDICATE is false of some element of SEQ or SEQs.
\n(fn PREDICATE SEQ...)"
- (not (apply 'cl-every cl-pred cl-seq cl-rest)))
+ (not (apply #'cl-every cl-pred cl-seq cl-rest)))
;;;###autoload
(defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
@@ -693,12 +693,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
"Expand macros in FORM and insert the pretty-printed result."
(declare (advertised-calling-convention (form) "27.1"))
(message "Expanding...")
- (let ((byte-compile-macro-environment nil))
- (setq form (macroexpand-all form))
- (message "Formatting...")
- (prog1
- (cl-prettyprint form)
- (message ""))))
+ (setq form (macroexpand-all form))
+ (message "Formatting...")
+ (prog1
+ (cl-prettyprint form)
+ (message "")))
;;; Integration into the online help system.
@@ -848,7 +847,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
"\n")))
"\n"))
-(defun cl--print-table (header rows)
+(defun cl--print-table (header rows &optional last-slot-on-next-line)
;; FIXME: Isn't this functionality already implemented elsewhere?
(let ((cols (apply #'vector (mapcar #'string-width header)))
(col-space 2))
@@ -878,7 +877,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
header))
"\n")
(dolist (row rows)
- (insert (apply #'format format row) "\n"))))))
+ (insert (apply #'format format row) "\n")
+ (when last-slot-on-next-line
+ (dolist (line (string-lines (car (last row))))
+ (insert " " line "\n"))
+ (insert "\n")))))))
(defun cl--describe-class-slots (class)
"Print help description for the slots in CLASS.
@@ -904,8 +907,7 @@ Outputs to the current buffer."
(setq has-doc t)
(substitute-command-keys doc)))))
slots)))
- (cl--print-table `("Name" "Type" "Default" . ,(if has-doc '("Doc")))
- slots-strings))
+ (cl--print-table `("Name" "Type" "Default") slots-strings has-doc))
(insert "\n")
(when (> (length cslots) 0)
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8e36dbe4a36..4a69df15bc8 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -189,6 +189,32 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
(setf (cl--generic name) (setq generic (cl--generic-make name))))
generic))
+(defvar cl--generic-edebug-name nil)
+
+(defun cl--generic-edebug-remember-name (name pf &rest specs)
+ ;; Remember the name in `cl-defgeneric' so we can use it when building
+ ;; the names of its `:methods'.
+ (let ((cl--generic-edebug-name (car name)))
+ (funcall pf specs)))
+
+(defun cl--generic-edebug-make-name (in:method _oldname &rest quals-and-args)
+ ;; The name to use in Edebug for a method: use the generic
+ ;; function's name plus all its qualifiers and finish with
+ ;; its specializers.
+ (pcase-let*
+ ((basename (if in:method cl--generic-edebug-name (pop quals-and-args)))
+ (args (car (last quals-and-args)))
+ (`(,spec-args . ,_) (cl--generic-split-args args))
+ (specializers (mapcar (lambda (spec-arg)
+ (if (eq '&context (car-safe (car spec-arg)))
+ spec-arg (cdr spec-arg)))
+ spec-args)))
+ (format "%s %s"
+ (mapconcat (lambda (sexp) (format "%s" sexp))
+ (cons basename (butlast quals-and-args))
+ " ")
+ specializers)))
+
;;;###autoload
(defmacro cl-defgeneric (name args &rest options-and-methods)
"Create a generic function NAME.
@@ -206,24 +232,22 @@ DEFAULT-BODY, if present, is used as the body of a default method.
\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
(declare (indent 2) (doc-string 3)
(debug
- (&define [&or name ("setf" name :name setf)] listp
- lambda-doc
- [&rest [&or
- ("declare" &rest sexp)
- (":argument-precedence-order" &rest sexp)
- (&define ":method"
- ;; FIXME: The `:unique'
- ;; construct works around
- ;; Bug#42672. We'd rather want
- ;; names like those generated by
- ;; `cl-defmethod', but that
- ;; requires larger changes to
- ;; Edebug.
- :unique "cl-generic-:method@"
- [&rest cl-generic-method-qualifier]
- cl-generic-method-args lambda-doc
- def-body)]]
- def-body)))
+ (&define
+ &interpose
+ [&name sexp] ;Allow (setf ...) additionally to symbols.
+ cl--generic-edebug-remember-name
+ listp lambda-doc
+ [&rest [&or
+ ("declare" &rest sexp)
+ (":argument-precedence-order" &rest sexp)
+ (&define ":method"
+ [&name
+ [[&rest cl-generic--method-qualifier-p]
+ listp] ;Formal args
+ cl--generic-edebug-make-name in:method]
+ lambda-doc
+ def-body)]]
+ def-body)))
(let* ((doc (if (stringp (car-safe options-and-methods))
(pop options-and-methods)))
(declarations nil)
@@ -398,10 +422,23 @@ the specializer used will be the one returned by BODY."
(let ((combined-doc (buffer-string)))
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+(defun cl-generic--method-qualifier-p (x)
+ (not (listp x)))
+
+(defun cl--defmethod-doc-pos ()
+ "Return the index of the docstring for a `cl-defmethod'.
+Presumes point is at the end of the `cl-defmethod' symbol."
+ (save-excursion
+ (let ((n 2))
+ (while (and (ignore-errors (forward-sexp 1) t)
+ (not (eq (char-before) ?\))))
+ (cl-incf n))
+ n)))
+
;;;###autoload
(defmacro cl-defmethod (name args &rest body)
"Define a new method for generic function NAME.
-This it defines an implementation of NAME to use for invocations
+This defines an implementation of NAME to use for invocations
of specific types of arguments.
ARGS is a list of dispatch arguments (see `cl-defun'), but where
@@ -418,8 +455,12 @@ all methods of NAME have to use the same set of arguments for dispatch.
Each dispatch argument and TYPE are specified in ARGS where the corresponding
formal argument appears as (VAR TYPE) rather than just VAR.
-The optional second argument QUALIFIER is a specifier that
-modifies how the method is combined with other methods, including:
+The optional EXTRA element, on the form `:extra STRING', allows
+you to add more methods for the same specializers and qualifiers.
+These are distinguished by STRING.
+
+The optional argument QUALIFIER is a specifier that modifies how
+the method is combined with other methods, including:
:before - Method will be called before the primary
:after - Method will be called after the primary
:around - Method will be called around everything else
@@ -436,19 +477,18 @@ method to be applicable.
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 defun)
+\(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
+ (declare (doc-string cl--defmethod-doc-pos) (indent defun)
(debug
(&define ; this means we are defining something
- [&or name ("setf" name :name setf)]
- ;; ^^ This is the methods symbol
- [ &rest cl-generic-method-qualifier ]
- ;; Multiple qualifiers are allowed.
- cl-generic-method-args ; arguments
+ [&name [sexp ;Allow (setf ...) additionally to symbols.
+ [&rest cl-generic--method-qualifier-p] ;qualifiers
+ listp] ; arguments
+ cl--generic-edebug-make-name nil]
lambda-doc ; documentation string
def-body))) ; part to be debugged
(let ((qualifiers nil))
- (while (not (listp args))
+ (while (cl-generic--method-qualifier-p args)
(push args qualifiers)
(setq args (pop body)))
(when (eq 'setf (car-safe name))
@@ -461,7 +501,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p 'obsolete name))
(let* ((obsolete (get name 'byte-obsolete-info)))
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(macroexp--obsolete-warning name obsolete "generic function")
nil)))
;; You could argue that `defmethod' modifies rather than defines the
@@ -528,17 +568,17 @@ 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)))
- (let ((sym (cl--generic-name generic))) ; Actual name (for aliases).
+ (let ((sym (cl--generic-name generic)) ; Actual name (for aliases).
+ ;; FIXME: Try to avoid re-constructing a new function if the old one
+ ;; is still valid (e.g. still empty method cache)?
+ (gfun (cl--generic-make-function generic)))
(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
+ (let (;; 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
@@ -1113,12 +1153,27 @@ These match if the argument is a cons cell whose car is `eql' to VAL."
(cl-generic-define-generalizer cl--generic-eql-generalizer
100 (lambda (name &rest _) `(gethash ,name cl--generic-eql-used))
- (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag))))
+ (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (cdr tag))))
(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
"Support for (eql VAL) specializers.
These match if the argument is `eql' to VAL."
- (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (let* ((form (cadr specializer))
+ (val (if (or (not (symbolp form)) (macroexp-const-p form))
+ (eval form t)
+ ;; FIXME: Compatibility with Emacs<28. For now emitting
+ ;; a warning would be annoying for third party packages
+ ;; which can't use the new form without breaking compatibility
+ ;; with older Emacsen, but in the future we should emit
+ ;; a warning.
+ ;; (message "Quoting obsolete `eql' form: %S" specializer)
+ form))
+ (specializers (cdr (gethash val cl--generic-eql-used))))
+ ;; The `specializers-function' needs to return all the (eql EXP) that
+ ;; were used for the same VALue (bug#49866).
+ ;; So we keep this info in `cl--generic-eql-used'.
+ (cl-pushnew specializer specializers :test #'equal)
+ (puthash val `(eql . ,specializers) cl--generic-eql-used))
(list cl--generic-eql-generalizer))
(cl--generic-prefill-dispatchers 0 (eql nil))
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 7d0bfc88b15..c88e15d5a8b 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -27,7 +27,7 @@
;; This package supplies a single entry point, common-lisp-indent-function,
;; which performs indentation in the preferred style for Common Lisp code.
-;; It is also a suitable function for indenting Emacs lisp code.
+;; It is also a suitable function for indenting Emacs Lisp code.
;;
;; To enable it:
;;
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 3bf3fd21ded..317a4c62309 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -140,7 +140,7 @@ to an element already in the list stored in PLACE.
\n(fn X PLACE [KEYWORD VALUE]...)"
(declare (debug
(form place &rest
- &or [[&or ":test" ":test-not" ":key"] function-form]
+ &or [[&or ":test" ":test-not" ":key"] form]
[keywordp form])))
(if (symbolp place)
(if (null keys)
@@ -232,13 +232,8 @@ one value.
;;; Declarations.
-(defvar cl--compiling-file nil)
-(defun cl--compiling-file ()
- (or cl--compiling-file
- (and (boundp 'byte-compile--outbuffer)
- (bufferp (symbol-value 'byte-compile--outbuffer))
- (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
- " *Compiler Output*"))))
+(define-obsolete-function-alias 'cl--compiling-file
+ #'macroexp-compiling-p "28.1")
(defvar cl--proclaims-deferred nil)
@@ -253,7 +248,7 @@ one value.
Puts `(cl-eval-when (compile load eval) ...)' around the declarations
so that they are registered at compile-time as well as run-time."
(let ((body (mapcar (lambda (x) `(cl-proclaim ',x)) specs)))
- (if (cl--compiling-file) `(cl-eval-when (compile load eval) ,@body)
+ (if (macroexp-compiling-p) `(cl-eval-when (compile load eval) ,@body)
`(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when.
@@ -520,111 +515,6 @@ the process stops as soon as KEYS or VALUES run out.
If ALIST is non-nil, the new pairs are prepended to it."
(nconc (cl-mapcar 'cons keys values) alist))
-;;; Generalized variables.
-
-;; These used to be in cl-macs.el since all macros that use them (like setf)
-;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in
-;; core Elisp, they need to either be right here or be autoloaded via
-;; cl-loaddefs.el, which is more trouble than it is worth.
-
-;; Some more Emacs-related place types.
-(gv-define-simple-setter buffer-file-name set-visited-file-name t)
-(gv-define-setter buffer-modified-p (flag &optional buf)
- (macroexp-let2 nil buffer `(or ,buf (current-buffer))
- `(with-current-buffer ,buffer
- (set-buffer-modified-p ,flag))))
-(gv-define-simple-setter buffer-name rename-buffer t)
-(gv-define-setter buffer-string (store)
- `(insert (prog1 ,store (erase-buffer))))
-(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
-(gv-define-simple-setter current-buffer set-buffer)
-(gv-define-simple-setter current-column move-to-column t)
-(gv-define-simple-setter current-global-map use-global-map t)
-(gv-define-setter current-input-mode (store)
- `(progn (apply #'set-input-mode ,store) ,store))
-(gv-define-simple-setter current-local-map use-local-map t)
-(gv-define-simple-setter current-window-configuration
- set-window-configuration t)
-(gv-define-simple-setter default-file-modes set-default-file-modes t)
-(gv-define-simple-setter documentation-property put)
-(gv-define-setter face-background (x f &optional s)
- `(set-face-background ,f ,x ,s))
-(gv-define-setter face-background-pixmap (x f &optional s)
- `(set-face-background-pixmap ,f ,x ,s))
-(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
-(gv-define-setter face-foreground (x f &optional s)
- `(set-face-foreground ,f ,x ,s))
-(gv-define-setter face-underline-p (x f &optional s)
- `(set-face-underline ,f ,x ,s))
-(gv-define-simple-setter file-modes set-file-modes t)
-(gv-define-setter frame-height (x &optional frame)
- `(set-frame-height (or ,frame (selected-frame)) ,x))
-(gv-define-simple-setter frame-parameters modify-frame-parameters t)
-(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
-(gv-define-setter frame-width (x &optional frame)
- `(set-frame-width (or ,frame (selected-frame)) ,x))
-(gv-define-simple-setter getenv setenv t)
-(gv-define-simple-setter get-register set-register)
-(gv-define-simple-setter global-key-binding global-set-key)
-(gv-define-simple-setter local-key-binding local-set-key)
-(gv-define-simple-setter mark set-mark t)
-(gv-define-simple-setter mark-marker set-mark t)
-(gv-define-simple-setter marker-position set-marker t)
-(gv-define-setter mouse-position (store scr)
- `(set-mouse-position ,scr (car ,store) (cadr ,store)
- (cddr ,store)))
-(gv-define-simple-setter point goto-char)
-(gv-define-simple-setter point-marker goto-char t)
-(gv-define-setter point-max (store)
- `(progn (narrow-to-region (point-min) ,store) ,store))
-(gv-define-setter point-min (store)
- `(progn (narrow-to-region ,store (point-max)) ,store))
-(gv-define-setter read-mouse-position (store scr)
- `(set-mouse-position ,scr (car ,store) (cdr ,store)))
-(gv-define-simple-setter screen-height set-screen-height t)
-(gv-define-simple-setter screen-width set-screen-width t)
-(gv-define-simple-setter selected-window select-window)
-(gv-define-simple-setter selected-screen select-screen)
-(gv-define-simple-setter selected-frame select-frame)
-(gv-define-simple-setter standard-case-table set-standard-case-table)
-(gv-define-simple-setter syntax-table set-syntax-table)
-(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
-(gv-define-setter window-height (store)
- `(progn (enlarge-window (- ,store (window-height))) ,store))
-(gv-define-setter window-width (store)
- `(progn (enlarge-window (- ,store (window-width)) t) ,store))
-(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
-
-;; More complex setf-methods.
-
-;; This is a hack that allows (setf (eq a 7) B) to mean either
-;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
-;; This is useful when you have control over the PLACE but not over
-;; the VALUE, as is the case in define-minor-mode's :variable.
-;; It turned out that :variable needed more flexibility anyway, so
-;; this doesn't seem too useful now.
-(gv-define-expander eq
- (lambda (do place val)
- (gv-letplace (getter setter) place
- (macroexp-let2 nil val val
- (funcall do `(eq ,getter ,val)
- (lambda (v)
- `(cond
- (,v ,(funcall setter val))
- ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
-
-(gv-define-expander substring
- (lambda (do place from &optional to)
- (gv-letplace (getter setter) place
- (macroexp-let2* nil ((start from) (end to))
- (funcall do `(substring ,getter ,start ,end)
- (lambda (v)
- (macroexp-let2 nil v v
- `(progn
- ,(funcall setter `(cl--set-substring
- ,getter ,start ,end ,v))
- ,v))))))))
-
;;; Miscellaneous.
(provide 'cl-lib)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index c2bf02ccece..4ef1948b0fe 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -186,14 +186,14 @@ The name is made by appending a number to PREFIX, default \"T\"."
;;; Program structure.
-(def-edebug-spec cl-declarations
- (&rest ("cl-declare" &rest sexp)))
+(def-edebug-elem-spec 'cl-declarations
+ '(&rest ("cl-declare" &rest sexp)))
-(def-edebug-spec cl-declarations-or-string
- (&or lambda-doc cl-declarations))
+(def-edebug-elem-spec 'cl-declarations-or-string
+ '(lambda-doc &or ("declare" def-declarations) cl-declarations))
-(def-edebug-spec cl-lambda-list
- (([&rest cl-lambda-arg]
+(def-edebug-elem-spec 'cl-lambda-list
+ '(([&rest cl-lambda-arg]
[&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
[&optional ["&rest" cl-lambda-arg]]
[&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
@@ -202,27 +202,27 @@ The name is made by appending a number to PREFIX, default \"T\"."
&or (cl-lambda-arg &optional def-form) arg]]
. [&or arg nil])))
-(def-edebug-spec cl-&optional-arg
- (&or (cl-lambda-arg &optional def-form arg) arg))
+(def-edebug-elem-spec 'cl-&optional-arg
+ '(&or (cl-lambda-arg &optional def-form arg) arg))
-(def-edebug-spec cl-&key-arg
- (&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg))
+(def-edebug-elem-spec 'cl-&key-arg
+ '(&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg))
-(def-edebug-spec cl-lambda-arg
- (&or arg cl-lambda-list1))
+(def-edebug-elem-spec 'cl-lambda-arg
+ '(&or arg cl-lambda-list1))
-(def-edebug-spec cl-lambda-list1
- (([&optional ["&whole" arg]] ;; only allowed at lower levels
- [&rest cl-lambda-arg]
- [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" cl-lambda-arg]]
- [&optional ["&key" cl-&key-arg &rest cl-&key-arg
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-lambda-arg &optional def-form) arg]]
- . [&or arg nil])))
+(def-edebug-elem-spec 'cl-lambda-list1
+ '(([&optional ["&whole" arg]] ;; only allowed at lower levels
+ [&rest cl-lambda-arg]
+ [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+ [&optional ["&rest" cl-lambda-arg]]
+ [&optional ["&key" cl-&key-arg &rest cl-&key-arg
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (cl-lambda-arg &optional def-form) arg]]
+ . [&or arg nil])))
-(def-edebug-spec cl-type-spec sexp)
+(def-edebug-elem-spec 'cl-type-spec '(sexp))
(defconst cl--lambda-list-keywords
'(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
@@ -358,7 +358,7 @@ more details.
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(declare (debug
;; Same as defun but use cl-lambda-list.
- (&define [&or name ("setf" :name setf name)]
+ (&define [&name sexp] ;Allow (setf ...) additionally to symbols.
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
@@ -376,7 +376,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
(declare (debug
;; Same as iter-defun but use cl-lambda-list.
- (&define [&or name ("setf" :name setf name)]
+ (&define [&name sexp] ;Allow (setf ...) additionally to symbols.
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
@@ -390,39 +390,39 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
;; Note that &environment is only allowed as first or last items in the
;; top level list.
-(def-edebug-spec cl-macro-list
- (([&optional "&environment" arg]
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-macro-arg &optional def-form) arg]]
- [&optional "&environment" arg]
- )))
-
-(def-edebug-spec cl-macro-arg
- (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
- (([&optional "&whole" arg] ;; only allowed at lower levels
- [&rest cl-macro-arg]
- [&optional ["&optional" &rest
- &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
- [&optional [[&or "&rest" "&body"] cl-macro-arg]]
- [&optional ["&key" [&rest
- [&or ([&or (symbolp cl-macro-arg) arg]
- &optional def-form cl-macro-arg)
- arg]]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (cl-macro-arg &optional def-form) arg]]
- . [&or arg nil])))
+(def-edebug-elem-spec 'cl-macro-list
+ '(([&optional "&environment" arg]
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (cl-macro-arg &optional def-form) arg]]
+ [&optional "&environment" arg]
+ )))
+
+(def-edebug-elem-spec 'cl-macro-arg
+ '(&or arg cl-macro-list1))
+
+(def-edebug-elem-spec 'cl-macro-list1
+ '(([&optional "&whole" arg] ;; only allowed at lower levels
+ [&rest cl-macro-arg]
+ [&optional ["&optional" &rest
+ &or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+ [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+ [&optional ["&key" [&rest
+ [&or ([&or (symbolp cl-macro-arg) arg]
+ &optional def-form cl-macro-arg)
+ arg]]
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (cl-macro-arg &optional def-form) arg]]
+ . [&or arg nil])))
;;;###autoload
(defmacro cl-defmacro (name args &rest body)
@@ -452,19 +452,19 @@ more details.
(indent 2))
`(defmacro ,name ,@(cl--transform-lambda (cons args body) name)))
-(def-edebug-spec cl-lambda-expr
- (&define ("lambda" cl-lambda-list
- cl-declarations-or-string
- [&optional ("interactive" interactive)]
- def-body)))
+(def-edebug-elem-spec 'cl-lambda-expr
+ '(&define ("lambda" cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body)))
;; Redefine function-form to also match cl-function
-(def-edebug-spec function-form
+(def-edebug-elem-spec 'function-form
;; form at the end could also handle "function",
;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr)
- ("cl-function" cl-function)
- form))
+ '(&or ([&or "quote" "function"] &or symbolp lambda-expr)
+ ("cl-function" cl-function)
+ form))
;;;###autoload
(defmacro cl-function (func)
@@ -545,7 +545,7 @@ its argument list allows full Common Lisp conventions."
(let ((p (memq '&body args))) (if p (setcar p '&rest)))
(if (memq '&environment args) (error "&environment used incorrectly"))
(let ((restarg (memq '&rest args))
- (safety (if (cl--compiling-file) cl--optimize-safety 3))
+ (safety (if (macroexp-compiling-p) cl--optimize-safety 3))
(keys t)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
@@ -565,7 +565,7 @@ its argument list allows full Common Lisp conventions."
,(length (cl-ldiff args p)))
exactarg (not (eq args p)))))
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
- (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
+ (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car-safe)
restarg)))
(cl--do-arglist
(pop args)
@@ -709,7 +709,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
\(fn (WHEN...) BODY...)"
(declare (indent 1) (debug (sexp body)))
- (if (and (fboundp 'cl--compiling-file) (cl--compiling-file)
+ (if (and (macroexp-compiling-p)
(not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge.
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(cl--not-toplevel t))
@@ -723,7 +723,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
(defun cl--compile-time-too (form)
(or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
(setq form (macroexpand
- form (cons '(cl-eval-when) byte-compile-macro-environment))))
+ form (cons '(cl-eval-when) macroexpand-all-environment))))
(cond ((eq (car-safe form) 'progn)
(cons 'progn (mapcar #'cl--compile-time-too (cdr form))))
((eq (car-safe form) 'cl-eval-when)
@@ -738,7 +738,7 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
"Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
(declare (debug (form &optional sexp)))
- (if (cl--compiling-file)
+ (if (macroexp-compiling-p)
(let* ((temp (cl-gentemp "--cl-load-time--"))
(set `(setq ,temp ,form)))
(if (and (fboundp 'byte-compile-file-form-defmumble)
@@ -941,7 +941,8 @@ For more details, see Info node `(cl)Loop Facility'.
"above" "below" "by" "in" "on" "=" "across"
"repeat" "while" "until" "always" "never"
"thereis" "collect" "append" "nconc" "sum"
- "count" "maximize" "minimize" "if" "unless"
+ "count" "maximize" "minimize"
+ "if" "when" "unless"
"return"]
form]
["using" (symbolp symbolp)]
@@ -1051,20 +1052,20 @@ For more details, see Info node `(cl)Loop Facility'.
;; [&rest loop-clause]
;; ))
-;; (def-edebug-spec loop-with
-;; ("with" loop-var
+;; (def-edebug-elem-spec 'loop-with
+;; '("with" loop-var
;; loop-type-spec
;; [&optional ["=" form]]
;; &rest ["and" loop-var
;; loop-type-spec
;; [&optional ["=" form]]]))
-;; (def-edebug-spec loop-for-as
-;; ([&or "for" "as"] loop-for-as-subclause
+;; (def-edebug-elem-spec 'loop-for-as
+;; '([&or "for" "as"] loop-for-as-subclause
;; &rest ["and" loop-for-as-subclause]))
-;; (def-edebug-spec loop-for-as-subclause
-;; (loop-var
+;; (def-edebug-elem-spec 'loop-for-as-subclause
+;; '(loop-var
;; loop-type-spec
;; &or
;; [[&or "in" "on" "in-ref" "across-ref"]
@@ -1124,19 +1125,19 @@ For more details, see Info node `(cl)Loop Facility'.
;; [&optional ["by" form]]
;; ]))
-;; (def-edebug-spec loop-initial-final
-;; (&or ["initially"
+;; (def-edebug-elem-spec 'loop-initial-final
+;; '(&or ["initially"
;; ;; [&optional &or "do" "doing"] ;; CLtL2 doesn't allow this.
;; &rest loop-non-atomic-expr]
;; ["finally" &or
;; [[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
;; ["return" form]]))
-;; (def-edebug-spec loop-and-clause
-;; (loop-clause &rest ["and" loop-clause]))
+;; (def-edebug-elem-spec 'loop-and-clause
+;; '(loop-clause &rest ["and" loop-clause]))
-;; (def-edebug-spec loop-clause
-;; (&or
+;; (def-edebug-elem-spec 'loop-clause
+;; '(&or
;; [[&or "while" "until" "always" "never" "thereis"] form]
;; [[&or "collect" "collecting"
@@ -1163,10 +1164,10 @@ For more details, see Info node `(cl)Loop Facility'.
;; loop-initial-final
;; ))
-;; (def-edebug-spec loop-non-atomic-expr
-;; ([&not atom] form))
+;; (def-edebug-elem-spec 'loop-non-atomic-expr
+;; '([&not atom] form))
-;; (def-edebug-spec loop-var
+;; (def-edebug-elem-spec 'loop-var
;; ;; The symbolp must be last alternative to recognize e.g. (a b . c)
;; ;; loop-var =>
;; ;; (loop-var . [&or nil loop-var])
@@ -1175,13 +1176,13 @@ For more details, see Info node `(cl)Loop Facility'.
;; ;; (symbolp . (symbolp . [&or nil loop-var]))
;; ;; (symbolp . (symbolp . loop-var))
;; ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
-;; (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
+;; '(&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-;; (def-edebug-spec loop-type-spec
-;; (&optional ["of-type" loop-d-type-spec]))
+;; (def-edebug-elem-spec 'loop-type-spec
+;; '(&optional ["of-type" loop-d-type-spec]))
-;; (def-edebug-spec loop-d-type-spec
-;; (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+;; (def-edebug-elem-spec 'loop-d-type-spec
+;; '(&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
(defun cl--parse-loop-clause () ; uses loop-*
(let ((word (pop cl--loop-args))
@@ -1924,7 +1925,8 @@ from OBARRAY.
\(fn (VAR [OBARRAY [RESULT]]) BODY...)"
(declare (indent 1)
- (debug ((symbolp &optional form form) cl-declarations body)))
+ (debug ((symbolp &optional form form) cl-declarations
+ def-body)))
;; Apparently this doesn't have an implicit block.
`(cl-block nil
(let (,(car spec))
@@ -1964,7 +1966,7 @@ Each symbol in the first list is bound to the corresponding value in the
second list (or to nil if VALUES is shorter than SYMBOLS); then the
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time."
- (declare (indent 2) (debug (form form body)))
+ (declare (indent 2) (debug (form form def-body)))
(let ((bodyfun (make-symbol "body"))
(binds (make-symbol "binds"))
(syms (make-symbol "syms"))
@@ -1976,7 +1978,8 @@ a `let' form, except that the list of symbols can be computed at run-time."
(,binds ()))
(while ,syms
(push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
- (eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun))))))))
+ (eval (list 'let (nreverse ,binds)
+ (list 'funcall (list 'quote ,bodyfun))))))))
(defconst cl--labels-magic (make-symbol "cl--labels-magic"))
@@ -2016,8 +2019,9 @@ info node `(cl) Function Bindings' for details.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug ((&rest [&or (&define name :unique "cl-flet@" function-form)
- (&define name :unique "cl-flet@"
+ (debug ((&rest [&or (symbolp form)
+ (&define [&name symbolp "@cl-flet@"]
+ [&name [] gensym] ;Make it unique!
cl-lambda-list
cl-declarations-or-string
[&optional ("interactive" interactive)]
@@ -2067,6 +2071,8 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; even handle mutually recursive functions.
(letrec
((done nil) ;; Non-nil if some TCO happened.
+ ;; This var always holds the value `nil' until (just before) we
+ ;; exit the loop.
(retvar (make-symbol "retval"))
(ofargs (mapcar (lambda (s) (if (memq s cl--lambda-list-keywords) s
(make-symbol (symbol-name s))))
@@ -2099,6 +2105,12 @@ Like `cl-flet' but the definitions can refer to previous ones.
(`(progn . ,exps) `(progn . ,(funcall opt-exps exps)))
(`(if ,cond ,then . ,else)
`(if ,cond ,(funcall opt then) . ,(funcall opt-exps else)))
+ (`(and . ,exps) `(and . ,(funcall opt-exps exps)))
+ (`(or ,arg) (funcall opt arg))
+ (`(or ,arg . ,args)
+ (let ((val (make-symbol "val")))
+ `(let ((,val ,arg))
+ (if ,val ,(funcall opt val) ,(funcall opt `(or . ,args))))))
(`(cond . ,conds)
(let ((cs '()))
(while conds
@@ -2108,14 +2120,18 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; This returns the value of `exp' but it's
;; only in tail position if it's the
;; last condition.
+ ;; Note: This may set the var before we
+ ;; actually exit the loop, but luckily it's
+ ;; only the case if we set the var to nil,
+ ;; so it does preserve the invariant that
+ ;; the var is nil until we exit the loop.
`((setq ,retvar ,exp) nil)
`(,(funcall opt exp)))
cs))
(exps
(push (funcall opt-exps exps) cs))))
- (if (eq t (caar cs))
- `(cond . ,(nreverse cs))
- `(cond ,@(nreverse cs) (t (setq ,retvar nil))))))
+ ;; No need to set `retvar' to return nil.
+ `(cond . ,(nreverse cs))))
((and `(,(or 'let 'let*) ,bindings . ,exps)
(guard
;; Note: it's OK for this `let' to shadow any
@@ -2127,8 +2143,17 @@ Like `cl-flet' but the definitions can refer to previous ones.
;; tail-called any more.
(not (memq var shadowings)))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
- (_
- `(progn (setq ,retvar ,exp) nil))))))
+ ((and `(condition-case ,err-var ,bodyform . ,handlers)
+ (guard (not (eq err-var var))))
+ `(condition-case ,err-var
+ ,(if (assq :success handlers)
+ bodyform
+ `(progn (setq ,retvar ,bodyform) nil))
+ . ,(mapcar (lambda (h)
+ (cons (car h) (funcall opt-exps (cdr h))))
+ handlers)))
+ ('nil nil) ;No need to set `retvar' to return nil.
+ (_ `(progn (setq ,retvar ,exp) nil))))))
(let ((optimized-body (funcall opt-exps body)))
(if (not done)
@@ -2192,6 +2217,20 @@ details.
(macroexp-progn body)
newenv)))))
+(defvar edebug-lexical-macro-ctx)
+
+(defun cl--edebug-macrolet-interposer (bindings pf &rest specs)
+ ;; (cl-assert (null (cdr bindings)))
+ (setq bindings (car bindings))
+ (let ((edebug-lexical-macro-ctx
+ (nconc (mapcar (lambda (binding)
+ (cons (car binding)
+ (when (eq 'declare (car-safe (nth 2 binding)))
+ (nth 1 (assq 'debug (cdr (nth 2 binding)))))))
+ bindings)
+ edebug-lexical-macro-ctx)))
+ (funcall pf specs)))
+
;; The following ought to have a better definition for use with newer
;; byte compilers.
;;;###autoload
@@ -2201,7 +2240,13 @@ This is like `cl-flet', but for macros instead of functions.
\(fn ((NAME ARGLIST BODY...) ...) FORM...)"
(declare (indent 1)
- (debug (cl-macrolet-expr)))
+ (debug (&interpose (&rest (&define [&name symbolp "@cl-macrolet@"]
+ [&name [] gensym] ;Make it unique!
+ cl-macro-list
+ cl-declarations-or-string
+ def-body))
+ cl--edebug-macrolet-interposer
+ cl-declarations body)))
(if (cdr bindings)
`(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
(if (null bindings) (macroexp-progn body)
@@ -2254,7 +2299,7 @@ of `cl-symbol-macrolet' to additionally expand symbol macros."
;; 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))
+ ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) pcase--dontcare))
;; (let ((letf nil) (found nil) (nbs ()))
;; (dolist (binding bindings)
;; (let* ((var (if (symbolp binding) binding (car binding)))
@@ -2277,7 +2322,7 @@ of `cl-symbol-macrolet' to additionally expand symbol macros."
;; 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))
+ (`(,(or 'let 'let*) . ,(or `(,bindings . ,body) pcase--dontcare))
(let ((nbs ()) (found nil))
(dolist (binding bindings)
(let* ((var (if (symbolp binding) binding (car binding)))
@@ -2372,7 +2417,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(append bindings venv))
macroexpand-all-environment))))
(if malformed-bindings
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(format-message "Malformed `cl-symbol-macrolet' binding(s): %S"
(nreverse malformed-bindings))
expansion)
@@ -2434,7 +2479,15 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
(defmacro cl-the (type form)
"Return FORM. If type-checking is enabled, assert that it is of TYPE."
(declare (indent 1) (debug (cl-type-spec form)))
- (if (not (or (not (cl--compiling-file))
+ ;; When native compiling possibly add the appropriate type hint.
+ (when (and (boundp 'byte-native-compiling)
+ byte-native-compiling)
+ (setf form
+ (cl-case type
+ (fixnum `(comp-hint-fixnum ,form))
+ (cons `(comp-hint-cons ,form))
+ (otherwise form))))
+ (if (not (or (not (macroexp-compiling-p))
(< cl--optimize-speed 3)
(= cl--optimize-safety 3)))
form
@@ -2444,6 +2497,28 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
(list ',type ,temp ',form)))
,temp))))
+;;;###autoload
+(or (assq 'cl-optimize defun-declarations-alist)
+ (let ((x (list 'cl-optimize #'cl--optimize)))
+ (push x macro-declarations-alist)
+ (push x defun-declarations-alist)))
+
+(defun cl--optimize (f _args &rest qualities)
+ "Serve 'cl-optimize' in function declarations.
+Example:
+(defun foo (x)
+ (declare (cl-optimize (speed 3) (safety 0)))
+ x)"
+ ;; FIXME this should make use of `cl--declare-stack' but I suspect
+ ;; this mechanism should be reviewed first.
+ (cl-loop for (qly val) in qualities
+ do (cl-ecase qly
+ (speed
+ (setf cl--optimize-speed val)
+ (byte-run--set-speed f nil val))
+ (safety
+ (setf cl--optimize-safety val)))))
+
(defvar cl--proclaim-history t) ; for future compilers
(defvar cl--declare-stack t) ; for future compilers
@@ -2460,12 +2535,12 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
'(nil byte-compile-inline-expand))
(error "%s already has a byte-optimizer, can't make it inline"
(car spec)))
- (put (car spec) 'byte-optimizer 'byte-compile-inline-expand)))
+ (put (car spec) 'byte-optimizer #'byte-compile-inline-expand)))
((eq (car-safe spec) 'notinline)
(while (setq spec (cdr spec))
(if (eq (get (car spec) 'byte-optimizer)
- 'byte-compile-inline-expand)
+ #'byte-compile-inline-expand)
(put (car spec) 'byte-optimizer nil))))
((eq (car-safe spec) 'optimize)
@@ -2501,7 +2576,7 @@ For instance
will turn off byte-compile warnings in the function.
See Info node `(cl)Declarations' for details."
- (if (cl--compiling-file)
+ (if (macroexp-compiling-p)
(while specs
(if (listp cl--declare-stack) (push (car specs) cl--declare-stack))
(cl--do-proclaim (pop specs) nil)))
@@ -2838,7 +2913,7 @@ Supported keywords for slots are:
(copier (intern (format "copy-%s" name)))
(predicate (intern (format "%s-p" name)))
(print-func nil) (print-auto nil)
- (safety (if (cl--compiling-file) cl--optimize-safety 3))
+ (safety (if (macroexp-compiling-p) cl--optimize-safety 3))
(include nil)
;; There are 4 types of structs:
;; - `vector' type: means we should use a vector, which can come
@@ -3011,7 +3086,7 @@ Supported keywords for slots are:
forms)
(when (cl-oddp (length desc))
(push
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(format "Missing value for option `%S' of slot `%s' in struct %s!"
(car (last desc)) slot name)
'nil)
@@ -3020,7 +3095,7 @@ Supported keywords for slots are:
(not (keywordp (car desc))))
(let ((kw (car defaults)))
(push
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(format " I'll take `%s' to be an option rather than a default value."
kw)
'nil)
@@ -3201,6 +3276,13 @@ STRUCT-TYPE is a symbol naming a struct type. Return `record',
(declare (side-effect-free t) (pure t))
(cl--struct-class-type (cl--struct-get-class struct-type)))
+(defun cl--alist-to-plist (alist)
+ (let ((res '()))
+ (dolist (x alist)
+ (push (car x) res)
+ (push (cdr x) res))
+ (nreverse res)))
+
(defun cl-struct-slot-info (struct-type)
"Return a list of slot names of struct STRUCT-TYPE.
Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a
@@ -3218,7 +3300,7 @@ slots skipped by :initial-offset may appear in the list."
,(cl--slot-descriptor-initform slot)
,@(if (not (eq (cl--slot-descriptor-type slot) t))
`(:type ,(cl--slot-descriptor-type slot)))
- ,@(cl--slot-descriptor-props slot))
+ ,@(cl--alist-to-plist (cl--slot-descriptor-props slot)))
descs)))
(nreverse descs)))
@@ -3236,29 +3318,30 @@ does not contain SLOT-NAME."
(signal 'cl-struct-unknown-slot (list struct-type slot-name))))
(defvar byte-compile-function-environment)
-(defvar byte-compile-macro-environment)
(defun cl--macroexp-fboundp (sym)
"Return non-nil if SYM will be bound when we run the code.
Of course, we really can't know that for sure, so it's just a heuristic."
(or (fboundp sym)
- (and (cl--compiling-file)
+ (and (macroexp-compiling-p)
(or (cdr (assq sym byte-compile-function-environment))
- (cdr (assq sym byte-compile-macro-environment))))))
+ (cdr (assq sym macroexpand-all-environment))))))
(pcase-dolist (`(,type . ,pred)
;; Mostly kept in alphabetical order.
'((array . arrayp)
(atom . atom)
(base-char . characterp)
+ (bignum . bignump)
(boolean . booleanp)
(bool-vector . bool-vector-p)
(buffer . bufferp)
(character . natnump)
(char-table . char-table-p)
+ (command . commandp)
(hash-table . hash-table-p)
(cons . consp)
- (fixnum . integerp)
+ (fixnum . fixnump)
(float . floatp)
(function . functionp)
(integer . integerp)
@@ -3338,7 +3421,7 @@ Of course, we really can't know that for sure, so it's just a heuristic."
"Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type."
(declare (debug (place cl-type-spec &optional stringp)))
- (and (or (not (cl--compiling-file))
+ (and (or (not (macroexp-compiling-p))
(< cl--optimize-speed 3) (= cl--optimize-safety 3))
(macroexp-let2 macroexp-copyable-p temp form
`(progn (or (cl-typep ,temp ',type)
@@ -3358,7 +3441,7 @@ Other args STRING and ARGS... are arguments to be passed to `error'.
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used."
(declare (debug (form &rest form)))
- (and (or (not (cl--compiling-file))
+ (and (or (not (macroexp-compiling-p))
(< cl--optimize-speed 3) (= cl--optimize-safety 3))
(let ((sargs (and show-args
(delq nil (mapcar (lambda (x)
@@ -3514,6 +3597,8 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc."
(cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body)))))
(cl-deftype extended-char () '(and character (not base-char)))
+;; Define fixnum so `cl-typep' recognize it and the type check emitted
+;; by `cl-the' is effective.
;;; Additional functions that we can now define because we've defined
;;; `cl-defsubst' and `cl-typep'.
@@ -3538,6 +3623,14 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance."
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-macs-load-hook)
+;;; Pcase type pattern.
+
+;;;###autoload
+(pcase-defmacro cl-type (type)
+ "Pcase pattern that matches objects of TYPE.
+TYPE is a type descriptor as accepted by `cl-typep', which see."
+ `(pred (pcase--flip cl-typep ',type)))
+
;; Local variables:
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 7365e23186a..ef60b266f9e 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -124,12 +124,11 @@ supertypes from the most specific to least specific.")
(get name 'cl-struct-print))
(cl--find-class name)))))
-(defun cl--plist-remove (plist member)
- (cond
- ((null plist) nil)
- ((null member) plist)
- ((eq plist member) (cddr plist))
- (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member)))))
+(defun cl--plist-to-alist (plist)
+ (let ((res '()))
+ (while plist
+ (push (cons (pop plist) (pop plist)) res))
+ (nreverse res)))
(defun cl--struct-register-child (parent tag)
;; Can't use (cl-typep parent 'cl-structure-class) at this stage
@@ -164,12 +163,14 @@ supertypes from the most specific to least specific.")
(i 0)
(offset (if type 0 1)))
(dolist (slot slots)
- (let* ((props (cddr slot))
- (typep (plist-member props :type))
- (type (if typep (cadr typep) t)))
+ (let* ((props (cl--plist-to-alist (cddr slot)))
+ (typep (assq :type props))
+ (type (if (null typep) t
+ (setq props (delq typep props))
+ (cdr typep))))
(aset v i (cl--make-slot-desc
(car slot) (nth 1 slot)
- type (cl--plist-remove props typep))))
+ type props)))
(puthash (car slot) (+ i offset) index-table)
(cl-incf i))
v))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
new file mode 100644
index 00000000000..3c5578217aa
--- /dev/null
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -0,0 +1,1197 @@
+;;; comp-cstr.el --- native compiler constraint library -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.com>
+;; Keywords: lisp
+;; Package: emacs
+
+;; 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:
+
+;; Constraint library in use by the native compiler.
+
+;; In LIMPLE each non immediate value is represented by a `comp-mvar'.
+;; The part concerning the set of all values the `comp-mvar' can
+;; assume is described into its constraint `comp-cstr'. Each
+;; constraint consists in a triplet: type-set, value-set, range-set.
+;; This file provide set operations between constraints (union
+;; intersection and negation) plus routines to convert from and to a
+;; CL like type specifier.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defconst comp--typeof-types (mapcar (lambda (x)
+ (append x '(t)))
+ cl--typeof-types)
+ ;; TODO can we just add t in `cl--typeof-types'?
+ "Like `cl--typeof-types' but with t as common supertype.")
+
+(defconst comp--all-builtin-types
+ (append cl--all-builtin-types '(t))
+ "Likewise like `cl--all-builtin-types' but with t as common supertype.")
+
+(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr
+ (type &aux
+ (null (eq type 'null))
+ (integer (eq type 'integer))
+ (typeset (if (or null integer)
+ nil
+ (list type)))
+ (valset (when null
+ '(nil)))
+ (range (when integer
+ '((- . +))))))
+ (:constructor comp-value-to-cstr
+ (value &aux
+ (integer (integerp value))
+ (valset (unless integer
+ (list value)))
+ (range (when integer
+ `((,value . ,value))))
+ (typeset ())))
+ (:constructor comp-irange-to-cstr
+ (irange &aux
+ (range (list irange))
+ (typeset ())))
+ (:copier comp-cstr-shallow-copy))
+ "Internal representation of a type/value constraint."
+ (typeset '(t) :type list
+ :documentation "List of possible types the mvar can assume.
+Each element cannot be a subtype of any other element of this slot.")
+ (valset () :type list
+ :documentation "List of possible values the mvar can assume.
+Integer values are handled in the `range' slot.")
+ (range () :type list
+ :documentation "Integer interval.")
+ (neg nil :type boolean
+ :documentation "Non-nil if the constraint is negated"))
+
+(cl-defstruct comp-cstr-f
+ "Internal constraint representation for a function."
+ (args () :type list
+ :documentation "List of `comp-cstr' for its arguments.")
+ (ret nil :type (or comp-cstr comp-cstr-f)
+ :documentation "Returned value."))
+
+(cl-defstruct comp-cstr-ctxt
+ (union-typesets-mem (make-hash-table :test #'equal) :type hash-table
+ :documentation "Serve memoization for
+`comp-union-typesets'.")
+ ;; TODO we should be able to just cons hash this.
+ (common-supertype-mem (make-hash-table :test #'equal) :type hash-table
+ :documentation "Serve memoization for
+`comp-common-supertype'.")
+ (subtype-p-mem (make-hash-table :test #'equal) :type hash-table
+ :documentation "Serve memoization for
+`comp-subtype-p-mem'.")
+ (union-1-mem-no-range (make-hash-table :test #'equal) :type hash-table
+ :documentation "Serve memoization for
+`comp-cstr-union-1'.")
+ (union-1-mem-range (make-hash-table :test #'equal) :type hash-table
+ :documentation "Serve memoization for
+`comp-cstr-union-1'.")
+ (intersection-mem (make-hash-table :test #'equal) :type hash-table
+ :documentation "Serve memoization for
+`intersection-mem'."))
+
+(defmacro with-comp-cstr-accessors (&rest body)
+ "Define some quick accessor to reduce code vergosity in BODY."
+ (declare (debug (form body))
+ (indent defun))
+ `(cl-macrolet ((typeset (x)
+ `(comp-cstr-typeset ,x))
+ (valset (x)
+ `(comp-cstr-valset ,x))
+ (range (x)
+ `(comp-cstr-range ,x))
+ (neg (x)
+ `(comp-cstr-neg ,x)))
+ ,@body))
+
+(defun comp-cstr-copy (cstr)
+ "Return a deep copy of CSTR."
+ (with-comp-cstr-accessors
+ (make-comp-cstr :typeset (copy-sequence (typeset cstr))
+ :valset (copy-sequence (valset cstr))
+ :range (copy-tree (range cstr))
+ :neg (neg cstr))))
+
+(defsubst comp-cstr-empty-p (cstr)
+ "Return t if CSTR is equivalent to the `nil' type specifier or nil otherwise."
+ (with-comp-cstr-accessors
+ (and (null (typeset cstr))
+ (null (valset cstr))
+ (null (range cstr))
+ (null (neg cstr)))))
+
+(defsubst comp-cstr-null-p (cstr)
+ "Return t if CSTR is equivalent to the `null' type specifier, nil otherwise."
+ (with-comp-cstr-accessors
+ (and (null (typeset cstr))
+ (null (range cstr))
+ (null (neg cstr))
+ (equal (valset cstr) '(nil)))))
+
+(defun comp-cstrs-homogeneous (cstrs)
+ "Check if constraints CSTRS are all homogeneously negated or non-negated.
+Return `pos' if they are all positive, `neg' if they are all
+negated or nil othewise."
+ (cl-loop
+ for cstr in cstrs
+ unless (comp-cstr-neg cstr)
+ count t into n-pos
+ else
+ count t into n-neg
+ finally
+ (cond
+ ((zerop n-neg) (cl-return 'pos))
+ ((zerop n-pos) (cl-return 'neg)))))
+
+(defun comp-split-pos-neg (cstrs)
+ "Split constraints CSTRS into non-negated and negated.
+Return them as multiple value."
+ (cl-loop
+ for cstr in cstrs
+ if (comp-cstr-neg cstr)
+ collect cstr into negatives
+ else
+ collect cstr into positives
+ finally return (cl-values positives negatives)))
+
+;; So we can load comp-cstr.el and comp.el in non native compiled
+;; builds.
+(defvar comp-ctxt nil)
+
+(defvar comp-cstr-one (comp-value-to-cstr 1)
+ "Represent the integer immediate one.")
+
+(defvar comp-cstr-t (comp-type-to-cstr t)
+ "Represent the superclass t.")
+
+
+;;; Value handling.
+
+(defun comp-normalize-valset (valset)
+ "Sort and remove duplicates from VALSET then return it."
+ (cl-sort (cl-remove-duplicates valset :test #'eq)
+ (lambda (x y)
+ (cond
+ ((and (symbolp x) (symbolp y))
+ (string< x y))
+ ((and (symbolp x) (not (symbolp y)))
+ t)
+ ((and (not (symbolp x)) (symbolp y))
+ nil)
+ (t
+ (< (sxhash-equal x)
+ (sxhash-equal y)))))))
+
+(defun comp-union-valsets (&rest valsets)
+ "Union values present into VALSETS."
+ (comp-normalize-valset (cl-reduce #'cl-union valsets)))
+
+(defun comp-intersection-valsets (&rest valsets)
+ "Union values present into VALSETS."
+ (comp-normalize-valset (cl-reduce #'cl-intersection valsets)))
+
+
+;;; Type handling.
+
+(defun comp-normalize-typeset (typeset)
+ "Sort TYPESET and return it."
+ (cl-sort (cl-remove-duplicates typeset)
+ (lambda (x y)
+ (string-lessp (symbol-name x)
+ (symbol-name y)))))
+
+(defun comp-supertypes (type)
+ "Return a list of pairs (supertype . hierarchy-level) for TYPE."
+ (cl-loop
+ named outer
+ with found = nil
+ for l in comp--typeof-types
+ do (cl-loop
+ for x in l
+ for i from (length l) downto 0
+ when (eq type x)
+ do (setf found t)
+ when found
+ collect `(,x . ,i) into res
+ finally (when found
+ (cl-return-from outer res)))))
+
+(defun comp-common-supertype-2 (type1 type2)
+ "Return the first common supertype of TYPE1 TYPE2."
+ (when-let ((types (cl-intersection
+ (comp-supertypes type1)
+ (comp-supertypes type2)
+ :key #'car)))
+ (car (cl-reduce (lambda (x y)
+ (if (> (cdr x) (cdr y)) x y))
+ types))))
+
+(defun comp-common-supertype (&rest types)
+ "Return the first common supertype of TYPES."
+ (or (gethash types (comp-cstr-ctxt-common-supertype-mem comp-ctxt))
+ (puthash types
+ (cl-reduce #'comp-common-supertype-2 types)
+ (comp-cstr-ctxt-common-supertype-mem comp-ctxt))))
+
+(defsubst comp-subtype-p (type1 type2)
+ "Return t if TYPE1 is a subtype of TYPE2 or nil otherwise."
+ (let ((types (cons type1 type2)))
+ (or (gethash types (comp-cstr-ctxt-subtype-p-mem comp-ctxt))
+ (puthash types
+ (eq (comp-common-supertype-2 type1 type2) type2)
+ (comp-cstr-ctxt-subtype-p-mem comp-ctxt)))))
+
+(defun comp-union-typesets (&rest typesets)
+ "Union types present into TYPESETS."
+ (or (gethash typesets (comp-cstr-ctxt-union-typesets-mem comp-ctxt))
+ (puthash typesets
+ (cl-loop
+ with types = (apply #'append typesets)
+ with res = '()
+ for lane in comp--typeof-types
+ do (cl-loop
+ with last = nil
+ for x in lane
+ when (memq x types)
+ do (setf last x)
+ finally (when last
+ (push last res)))
+ finally return (comp-normalize-typeset res))
+ (comp-cstr-ctxt-union-typesets-mem comp-ctxt))))
+
+(defun comp-intersect-two-typesets (t1 t2)
+ "Intersect typesets T1 and T2."
+ (with-comp-cstr-accessors
+ (cl-loop
+ for types in (list t1 t2)
+ for other-types in (list t2 t1)
+ append
+ (cl-loop
+ for type in types
+ when (cl-some (lambda (x)
+ (comp-subtype-p type x))
+ other-types)
+ collect type))))
+
+(defun comp-intersect-typesets (&rest typesets)
+ "Intersect types present into TYPESETS."
+ (unless (cl-some #'null typesets)
+ (if (length= typesets 1)
+ (car typesets)
+ (comp-normalize-typeset
+ (cl-reduce #'comp-intersect-two-typesets typesets)))))
+
+
+;;; Integer range handling
+
+(defsubst comp-star-or-num-p (x)
+ (or (numberp x) (eq '* x)))
+
+(defsubst comp-range-1+ (x)
+ (if (symbolp x)
+ x
+ (1+ x)))
+
+(defsubst comp-range-1- (x)
+ (if (symbolp x)
+ x
+ (1- x)))
+
+(defsubst comp-range-+ (x y)
+ (pcase (cons x y)
+ ((or '(+ . -) '(- . +)) '??)
+ ((or `(- . ,_) `(,_ . -)) '-)
+ ((or `(+ . ,_) `(,_ . +)) '+)
+ (_ (+ x y))))
+
+(defsubst comp-range-- (x y)
+ (pcase (cons x y)
+ ((or '(+ . +) '(- . -)) '??)
+ ('(+ . -) '+)
+ ('(- . +) '-)
+ ((or `(+ . ,_) `(,_ . -)) '+)
+ ((or `(- . ,_) `(,_ . +)) '-)
+ (_ (- x y))))
+
+(defsubst comp-range-< (x y)
+ (cond
+ ((eq x '+) nil)
+ ((eq x '-) t)
+ ((eq y '+) t)
+ ((eq y '-) nil)
+ (t (< x y))))
+
+(defsubst comp-cstr-smallest-in-range (range)
+ "Smallest entry in RANGE."
+ (caar range))
+
+(defsubst comp-cstr-greatest-in-range (range)
+ "Greater entry in RANGE."
+ (cdar (last range)))
+
+(defun comp-range-union (&rest ranges)
+ "Combine integer intervals RANGES by union set operation."
+ (cl-loop
+ with all-ranges = (apply #'append ranges)
+ with lows = (mapcar (lambda (x)
+ (cons (comp-range-1- (car x)) 'l))
+ all-ranges)
+ with highs = (mapcar (lambda (x)
+ (cons (cdr x) 'h))
+ all-ranges)
+ with nest = 0
+ with low = nil
+ with res = ()
+ for (i . x) in (cl-sort (nconc lows highs) #'comp-range-< :key #'car)
+ if (eq x 'l)
+ do
+ (when (zerop nest)
+ (setf low i))
+ (cl-incf nest)
+ else
+ do
+ (when (= nest 1)
+ (push `(,(comp-range-1+ low) . ,i) res))
+ (cl-decf nest)
+ finally return (reverse res)))
+
+(defun comp-range-intersection (&rest ranges)
+ "Combine integer intervals RANGES by intersecting."
+ (cl-loop
+ with all-ranges = (apply #'append ranges)
+ with n-ranges = (length ranges)
+ with lows = (mapcar (lambda (x)
+ (cons (car x) 'l))
+ all-ranges)
+ with highs = (mapcar (lambda (x)
+ (cons (cdr x) 'h))
+ all-ranges)
+ with nest = 0
+ with low = nil
+ with res = ()
+ for (i . x) in (cl-sort (nconc lows highs) #'comp-range-< :key #'car)
+ initially (when (cl-some #'null ranges)
+ ;; Intersecting with a null range always results in a
+ ;; null range.
+ (cl-return '()))
+ if (eq x 'l)
+ do
+ (cl-incf nest)
+ (when (= nest n-ranges)
+ (setf low i))
+ else
+ do
+ (when (= nest n-ranges)
+ (push `(,low . ,i)
+ res))
+ (cl-decf nest)
+ finally return (reverse res)))
+
+(defun comp-range-negation (range)
+ "Negate range RANGE."
+ (if (null range)
+ '((- . +))
+ (cl-loop
+ with res = ()
+ with last-h = '-
+ for (l . h) in range
+ unless (eq l '-)
+ do (push `(,(comp-range-1+ last-h) . ,(1- l)) res)
+ do (setf last-h h)
+ finally
+ (unless (eq '+ last-h)
+ (push `(,(1+ last-h) . +) res))
+ (cl-return (reverse res)))))
+
+(defsubst comp-cstr-set-cmp-range (dst old-dst ext-range)
+ "Support range comparison functions."
+ (with-comp-cstr-accessors
+ (if ext-range
+ (setf (typeset dst) (when (cl-some (lambda (x)
+ (comp-subtype-p 'float x))
+ (typeset old-dst))
+ '(float))
+ (valset dst) ()
+ (range dst) (if (range old-dst)
+ (comp-range-intersection (range old-dst)
+ ext-range)
+ ext-range)
+ (neg dst) nil)
+ (setf (typeset dst) (typeset old-dst)
+ (valset dst) (valset old-dst)
+ (range dst) (range old-dst)
+ (neg dst) (neg old-dst)))))
+
+(defmacro comp-cstr-set-range-for-arithm (dst src1 src2 &rest range-body)
+ ;; Prevent some code duplication for `comp-cstr-add-2'
+ ;; `comp-cstr-sub-2'.
+ (declare (debug (range-body))
+ (indent defun))
+ `(with-comp-cstr-accessors
+ (when-let ((r1 (range ,src1))
+ (r2 (range ,src2)))
+ (let* ((l1 (comp-cstr-smallest-in-range r1))
+ (l2 (comp-cstr-smallest-in-range r2))
+ (h1 (comp-cstr-greatest-in-range r1))
+ (h2 (comp-cstr-greatest-in-range r2)))
+ (setf (typeset ,dst) (when (cl-some (lambda (x)
+ (comp-subtype-p 'float x))
+ (append (typeset src1)
+ (typeset src2)))
+ '(float))
+ (range ,dst) ,@range-body)))))
+
+(defun comp-cstr-add-2 (dst src1 src2)
+ "Sum SRC1 and SRC2 into DST."
+ (comp-cstr-set-range-for-arithm dst src1 src2
+ `((,(comp-range-+ l1 l2) . ,(comp-range-+ h1 h2)))))
+
+(defun comp-cstr-sub-2 (dst src1 src2)
+ "Subtract SRC1 and SRC2 into DST."
+ (comp-cstr-set-range-for-arithm dst src1 src2
+ (let ((l (comp-range-- l1 h2))
+ (h (comp-range-- h1 l2)))
+ (if (or (eq l '??) (eq h '??))
+ '((- . +))
+ `((,l . ,h))))))
+
+
+;;; Union specific code.
+
+(defun comp-cstr-union-homogeneous-no-range (dst &rest srcs)
+ "As `comp-cstr-union' but escluding the irange component.
+All SRCS constraints must be homogeneously negated or non-negated."
+
+ ;; Type propagation.
+ (setf (comp-cstr-typeset dst)
+ (apply #'comp-union-typesets (mapcar #'comp-cstr-typeset srcs)))
+
+ ;; Value propagation.
+ (setf (comp-cstr-valset dst)
+ (comp-normalize-valset
+ (cl-loop
+ with values = (mapcar #'comp-cstr-valset srcs)
+ ;; TODO sort.
+ for v in (cl-remove-duplicates (apply #'append values)
+ :test #'equal)
+ ;; We propagate only values those types are not already
+ ;; into typeset.
+ when (cl-notany (lambda (x)
+ (comp-subtype-p (type-of v) x))
+ (comp-cstr-typeset dst))
+ collect v)))
+
+ dst)
+
+(defun comp-cstr-union-homogeneous (range dst &rest srcs)
+ "Combine SRCS by union set operation setting the result in DST.
+Do range propagation when RANGE is non-nil.
+All SRCS constraints must be homogeneously negated or non-negated.
+DST is returned."
+ (apply #'comp-cstr-union-homogeneous-no-range dst srcs)
+ ;; Range propagation.
+ (setf (comp-cstr-neg dst)
+ (when srcs
+ (comp-cstr-neg (car srcs)))
+
+ (comp-cstr-range dst)
+ (when (cl-notany (lambda (x)
+ (comp-subtype-p 'integer x))
+ (comp-cstr-typeset dst))
+ (if range
+ (apply #'comp-range-union
+ (mapcar #'comp-cstr-range srcs))
+ '((- . +)))))
+ dst)
+
+(cl-defun comp-cstr-union-1-no-mem (range &rest srcs)
+ "Combine SRCS by union set operation setting the result in DST.
+Do range propagation when RANGE is non-nil.
+Non memoized version of `comp-cstr-union-1'.
+DST is returned."
+ (with-comp-cstr-accessors
+ (let ((dst (make-comp-cstr)))
+ (cl-flet ((give-up ()
+ (setf (typeset dst) '(t)
+ (valset dst) ()
+ (range dst) ()
+ (neg dst) nil)
+ (cl-return-from comp-cstr-union-1-no-mem dst)))
+
+ ;; Check first if we are in the simple case of all input non-negate
+ ;; or negated so we don't have to cons.
+ (when-let ((res (comp-cstrs-homogeneous srcs)))
+ (apply #'comp-cstr-union-homogeneous range dst srcs)
+ (cl-return-from comp-cstr-union-1-no-mem dst))
+
+ ;; Some are negated and some are not
+ (cl-multiple-value-bind (positives negatives) (comp-split-pos-neg srcs)
+ (let* ((pos (apply #'comp-cstr-union-homogeneous range
+ (make-comp-cstr) positives))
+ ;; We'll always use neg as result as this is almost
+ ;; always necessary for describing open intervals
+ ;; resulting from negated constraints.
+ (neg (apply #'comp-cstr-union-homogeneous range
+ (make-comp-cstr :neg t) negatives)))
+ ;; Type propagation.
+ (when (and (typeset pos)
+ ;; When every pos type is a subtype of some neg ones.
+ (cl-every (lambda (x)
+ (cl-some (lambda (y)
+ (comp-subtype-p x y))
+ (append (typeset neg)
+ (when (range neg)
+ '(integer)))))
+ (typeset pos)))
+ ;; This is a conservative choice, ATM we can't represent such
+ ;; a disjoint set of types unless we decide to add a new slot
+ ;; into `comp-cstr' or adopt something like
+ ;; `intersection-type' `union-type' in SBCL. Keep it
+ ;; "simple" for now.
+ (give-up))
+
+ ;; When every neg type is a subtype of some pos one.
+ ;; In case return pos.
+ (when (and (typeset neg)
+ (cl-every (lambda (x)
+ (cl-some (lambda (y)
+ (comp-subtype-p x y))
+ (append (typeset pos)
+ (when (range pos)
+ '(integer)))))
+ (typeset neg)))
+ (setf (typeset dst) (typeset pos)
+ (valset dst) (valset pos)
+ (range dst) (range pos)
+ (neg dst) nil)
+ (cl-return-from comp-cstr-union-1-no-mem dst))
+
+ ;; Verify disjoint condition between positive types and
+ ;; negative types coming from values, in case give-up.
+ (let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
+ (when (range neg)
+ '(integer)))))
+ (when (cl-some (lambda (x)
+ (cl-some (lambda (y)
+ (and (not (eq y x))
+ (comp-subtype-p y x)))
+ neg-value-types))
+ (typeset pos))
+ (give-up)))
+
+ ;; Value propagation.
+ (cond
+ ((and (valset pos) (valset neg)
+ (equal (comp-union-valsets (valset pos) (valset neg))
+ (valset pos)))
+ ;; Pos is a superset of neg.
+ (give-up))
+ ((cl-some (lambda (x)
+ (cl-some (lambda (y)
+ (comp-subtype-p y x))
+ (mapcar #'type-of (valset pos))))
+ (typeset neg))
+ (give-up))
+ (t
+ ;; pos is a subset or eq to neg
+ (setf (valset neg)
+ (cl-nset-difference (valset neg) (valset pos)))))
+
+ ;; Range propagation
+ (when range
+ ;; Handle apart (or (integer 1 1) (not (integer 1 1)))
+ ;; like cases.
+ (if (and (range pos) (range neg)
+ (equal (range pos) (range neg)))
+ (give-up)
+ (setf (range neg)
+ (comp-range-negation
+ (comp-range-union
+ (comp-range-negation (range neg))
+ (range pos))))))
+
+ (if (comp-cstr-empty-p neg)
+ (setf (typeset dst) (typeset pos)
+ (valset dst) (valset pos)
+ (range dst) (range pos)
+ (neg dst) nil)
+ (setf (typeset dst) (typeset neg)
+ (valset dst) (valset neg)
+ (range dst) (range neg)
+ (neg dst) (neg neg)))))
+
+ ;; (not null) => t
+ (when (and (neg dst)
+ (null (typeset dst))
+ (null (valset dst))
+ (null (range dst)))
+ (give-up)))
+
+ dst)))
+
+(defun comp-cstr-union-1 (range dst &rest srcs)
+ "Combine SRCS by union set operation setting the result in DST.
+Do range propagation when RANGE is non-nil.
+DST is returned."
+ (with-comp-cstr-accessors
+ (let* ((mem-h (if range
+ (comp-cstr-ctxt-union-1-mem-range comp-ctxt)
+ (comp-cstr-ctxt-union-1-mem-no-range comp-ctxt)))
+ (res (or (gethash srcs mem-h)
+ (puthash
+ (mapcar #'comp-cstr-copy srcs)
+ (apply #'comp-cstr-union-1-no-mem range srcs)
+ mem-h))))
+ (setf (typeset dst) (typeset res)
+ (valset dst) (valset res)
+ (range dst) (range res)
+ (neg dst) (neg res))
+ res)))
+
+(cl-defun comp-cstr-intersection-homogeneous (dst &rest srcs)
+ "Combine SRCS by intersection set operation setting the result in DST.
+All SRCS constraints must be homogeneously negated or non-negated.
+DST is returned."
+
+ (with-comp-cstr-accessors
+ (when (cl-some #'comp-cstr-empty-p srcs)
+ (setf (valset dst) nil
+ (range dst) nil
+ (typeset dst) nil)
+ (cl-return-from comp-cstr-intersection-homogeneous dst))
+
+ (setf (neg dst) (when srcs
+ (neg (car srcs))))
+
+ ;; Type propagation.
+ (setf (typeset dst)
+ (apply #'comp-intersect-typesets
+ (mapcar #'comp-cstr-typeset srcs)))
+
+ ;; Value propagation.
+ (setf (valset dst)
+ (comp-normalize-valset
+ (cl-loop
+ for src in srcs
+ append
+ (cl-loop
+ for val in (valset src)
+ ;; If (member value) is subtypep of all other sources then
+ ;; is good to be colleted.
+ when (cl-every (lambda (s)
+ (or (memql val (valset s))
+ (cl-some (lambda (type)
+ (cl-typep val type))
+ (typeset s))))
+ (remq src srcs))
+ collect val))))
+
+ ;; Range propagation.
+ (setf (range dst)
+ ;; Do range propagation only if the destination typeset
+ ;; doesn't cover it already.
+ (unless (cl-some (lambda (type)
+ (comp-subtype-p 'integer type))
+ (typeset dst))
+ (apply #'comp-range-intersection
+ (cl-loop
+ for src in srcs
+ ;; Collect effective ranges.
+ collect (or (range src)
+ (when (cl-some (lambda (s)
+ (comp-subtype-p 'integer s))
+ (typeset src))
+ '((- . +))))))))
+
+ dst))
+
+(cl-defun comp-cstr-intersection-no-mem (&rest srcs)
+ "Combine SRCS by intersection set operation.
+Non memoized version of `comp-cstr-intersection-no-mem'."
+ (let ((dst (make-comp-cstr)))
+ (with-comp-cstr-accessors
+ (cl-flet ((return-empty ()
+ (setf (typeset dst) ()
+ (valset dst) ()
+ (range dst) ()
+ (neg dst) nil)
+ (cl-return-from comp-cstr-intersection-no-mem dst)))
+ (when-let ((res (comp-cstrs-homogeneous srcs)))
+ (if (eq res 'neg)
+ (apply #'comp-cstr-union-homogeneous t dst srcs)
+ (apply #'comp-cstr-intersection-homogeneous dst srcs))
+ (cl-return-from comp-cstr-intersection-no-mem dst))
+
+ ;; Some are negated and some are not
+ (cl-multiple-value-bind (positives negatives) (comp-split-pos-neg srcs)
+ (let* ((pos (apply #'comp-cstr-intersection-homogeneous
+ (make-comp-cstr) positives))
+ (neg (apply #'comp-cstr-intersection-homogeneous
+ (make-comp-cstr) negatives)))
+
+ ;; In case pos is not relevant return directly the content
+ ;; of neg.
+ (when (equal (typeset pos) '(t))
+ (setf (typeset dst) (typeset neg)
+ (valset dst) (valset neg)
+ (range dst) (range neg)
+ (neg dst) t)
+
+ ;; (not t) => nil
+ (when (and (null (valset dst))
+ (null (range dst))
+ (neg dst)
+ (equal '(t) (typeset dst)))
+ (setf (typeset dst) ()
+ (neg dst) nil))
+
+ (cl-return-from comp-cstr-intersection-no-mem dst))
+
+ (when (cl-some
+ (lambda (ty)
+ (memq ty (typeset neg)))
+ (typeset pos))
+ (return-empty))
+
+ ;; Some negated types are subtypes of some non-negated one.
+ ;; Transform the corresponding set of types from neg to pos.
+ (cl-loop
+ for neg-type in (typeset neg)
+ do (cl-loop
+ for pos-type in (copy-sequence (typeset pos))
+ when (and (not (eq neg-type pos-type))
+ (comp-subtype-p neg-type pos-type))
+ do (cl-loop
+ with found
+ for (type . _) in (comp-supertypes neg-type)
+ when found
+ collect type into res
+ when (eq type pos-type)
+ do (setf (typeset pos) (cl-union (typeset pos) res))
+ (cl-return)
+ when (eq type neg-type)
+ do (setf found t))))
+
+ (setf (range pos)
+ (comp-range-intersection (range pos)
+ (comp-range-negation (range neg)))
+ (valset pos)
+ (cl-set-difference (valset pos) (valset neg)))
+
+ ;; Return a non negated form.
+ (setf (typeset dst) (typeset pos)
+ (valset dst) (valset pos)
+ (range dst) (range pos)
+ (neg dst) nil)))
+ dst))))
+
+
+;;; Entry points.
+
+(defun comp-cstr-imm-vld-p (cstr)
+ "Return t if one and only one immediate value can be extracted from CSTR."
+ (with-comp-cstr-accessors
+ (when (and (null (typeset cstr))
+ (null (neg cstr)))
+ (let* ((v (valset cstr))
+ (r (range cstr))
+ (valset-len (length v))
+ (range-len (length r)))
+ (if (and (= valset-len 1)
+ (= range-len 0))
+ t
+ (when (and (= valset-len 0)
+ (= range-len 1))
+ (let* ((low (caar r))
+ (high (cdar r)))
+ (and (integerp low)
+ (integerp high)
+ (= low high)))))))))
+
+(defun comp-cstr-imm (cstr)
+ "Return the immediate value of CSTR.
+`comp-cstr-imm-vld-p' *must* be satisfied before calling
+`comp-cstr-imm'."
+ (declare (gv-setter
+ (lambda (val)
+ `(with-comp-cstr-accessors
+ (if (integerp ,val)
+ (setf (typeset ,cstr) nil
+ (range ,cstr) (list (cons ,val ,val)))
+ (setf (typeset ,cstr) nil
+ (valset ,cstr) (list ,val)))))))
+ (with-comp-cstr-accessors
+ (let ((v (valset cstr)))
+ (if (length= v 1)
+ (car v)
+ (caar (range cstr))))))
+
+(defun comp-cstr-fixnum-p (cstr)
+ "Return t if CSTR is certainly a fixnum."
+ (with-comp-cstr-accessors
+ (when (null (neg cstr))
+ (when-let (range (range cstr))
+ (let* ((low (caar range))
+ (high (cdar (last range))))
+ (unless (or (eq low '-)
+ (< low most-negative-fixnum)
+ (eq high '+)
+ (> high most-positive-fixnum))
+ t))))))
+
+(defun comp-cstr-symbol-p (cstr)
+ "Return t if CSTR is certainly a symbol."
+ (with-comp-cstr-accessors
+ (and (null (range cstr))
+ (null (neg cstr))
+ (or (and (null (valset cstr))
+ (equal (typeset cstr) '(symbol)))
+ (and (or (null (typeset cstr))
+ (equal (typeset cstr) '(symbol)))
+ (cl-every #'symbolp (valset cstr)))))))
+
+(defsubst comp-cstr-cons-p (cstr)
+ "Return t if CSTR is certainly a cons."
+ (with-comp-cstr-accessors
+ (and (null (valset cstr))
+ (null (range cstr))
+ (null (neg cstr))
+ (equal (typeset cstr) '(cons)))))
+
+(defun comp-cstr-= (dst op1 op2)
+ "Constraint OP1 being = OP2 setting the result into DST."
+ (with-comp-cstr-accessors
+ (cl-flet ((relax-cstr (cstr)
+ (setf cstr (comp-cstr-shallow-copy cstr))
+ ;; If can be any float extend it to all integers.
+ (when (memq 'float (typeset cstr))
+ (setf (range cstr) '((- . +))))
+ ;; For each float value that can be represented
+ ;; precisely as an integer add the integer as well.
+ (cl-loop
+ for v in (valset cstr)
+ do
+ (when-let* ((ok (floatp v))
+ (truncated (ignore-error overflow-error
+ (truncate v)))
+ (ok (= v truncated)))
+ (push (cons truncated truncated) (range cstr))))
+ (cl-loop
+ with vals-to-add
+ for (l . h) in (range cstr)
+ ;; If an integer range reduces to single value add
+ ;; its float value too.
+ if (eql l h)
+ do (push (float l) vals-to-add)
+ ;; Otherwise can be any float.
+ else
+ do (cl-pushnew 'float (typeset cstr))
+ (cl-return cstr)
+ finally (setf (valset cstr)
+ (append vals-to-add (valset cstr))))
+ (when (memql 0.0 (valset cstr))
+ (cl-pushnew -0.0 (valset cstr)))
+ (when (memql -0.0 (valset cstr))
+ (cl-pushnew 0.0 (valset cstr)))
+ cstr))
+ (comp-cstr-intersection dst (relax-cstr op1) (relax-cstr op2)))))
+
+(defun comp-cstr-> (dst old-dst src)
+ "Constraint DST being > than SRC.
+SRC can be either a comp-cstr or an integer."
+ (with-comp-cstr-accessors
+ (let ((ext-range
+ (if (integerp src)
+ `((,(1+ src) . +))
+ (when-let* ((range (range src))
+ (low (comp-cstr-smallest-in-range range))
+ (okay (integerp low)))
+ `((,(1+ low) . +))))))
+ (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr->= (dst old-dst src)
+ "Constraint DST being >= than SRC.
+SRC can be either a comp-cstr or an integer."
+ (with-comp-cstr-accessors
+ (let ((ext-range
+ (if (integerp src)
+ `((,src . +))
+ (when-let* ((range (range src))
+ (low (comp-cstr-smallest-in-range range))
+ (okay (integerp low)))
+ `((,low . +))))))
+ (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr-< (dst old-dst src)
+ "Constraint DST being < than SRC.
+SRC can be either a comp-cstr or an integer."
+ (with-comp-cstr-accessors
+ (let ((ext-range
+ (if (integerp src)
+ `((- . ,(1- src)))
+ (when-let* ((range (range src))
+ (low (comp-cstr-greatest-in-range range))
+ (okay (integerp low)))
+ `((- . ,(1- low)))))))
+ (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr-<= (dst old-dst src)
+ "Constraint DST being > than SRC.
+SRC can be either a comp-cstr or an integer."
+ (with-comp-cstr-accessors
+ (let ((ext-range
+ (if (integerp src)
+ `((- . ,src))
+ (when-let* ((range (range src))
+ (low (comp-cstr-greatest-in-range range))
+ (okay (integerp low)))
+ `((- . ,low))))))
+ (comp-cstr-set-cmp-range dst old-dst ext-range))))
+
+(defun comp-cstr-add (dst srcs)
+ "Sum SRCS into DST."
+ (comp-cstr-add-2 dst (cl-first srcs) (cl-second srcs))
+ (cl-loop
+ for src in (nthcdr 2 srcs)
+ do (comp-cstr-add-2 dst dst src)))
+
+(defun comp-cstr-sub (dst srcs)
+ "Subtract SRCS into DST."
+ (comp-cstr-sub-2 dst (cl-first srcs) (cl-second srcs))
+ (cl-loop
+ for src in (nthcdr 2 srcs)
+ do (comp-cstr-sub-2 dst dst src)))
+
+(defun comp-cstr-union-no-range (dst &rest srcs)
+ "Combine SRCS by union set operation setting the result in DST.
+Do not propagate the range component.
+DST is returned."
+ (apply #'comp-cstr-union-1 nil dst srcs))
+
+(defun comp-cstr-union (dst &rest srcs)
+ "Combine SRCS by union set operation setting the result in DST.
+DST is returned."
+ (apply #'comp-cstr-union-1 t dst srcs))
+
+(defun comp-cstr-union-make (&rest srcs)
+ "Combine SRCS by union set operation and return a new constraint."
+ (apply #'comp-cstr-union (make-comp-cstr) srcs))
+
+(defun comp-cstr-intersection (dst &rest srcs)
+ "Combine SRCS by intersection set operation setting the result in DST.
+DST is returned."
+ (with-comp-cstr-accessors
+ (let* ((mem-h (comp-cstr-ctxt-intersection-mem comp-ctxt))
+ (res (or (gethash srcs mem-h)
+ (puthash
+ (mapcar #'comp-cstr-copy srcs)
+ (apply #'comp-cstr-intersection-no-mem srcs)
+ mem-h))))
+ (setf (typeset dst) (typeset res)
+ (valset dst) (valset res)
+ (range dst) (range res)
+ (neg dst) (neg res))
+ res)))
+
+(defun comp-cstr-intersection-no-hashcons (dst &rest srcs)
+ "Combine SRCS by intersection set operation setting the result in DST.
+Non hash consed values are not propagated as values but rather
+promoted to their types.
+DST is returned."
+ (with-comp-cstr-accessors
+ (apply #'comp-cstr-intersection dst srcs)
+ (if (and (neg dst)
+ (valset dst)
+ (cl-notevery #'symbolp (valset dst)))
+ (setf (valset dst) ()
+ (typeset dst) '(t)
+ (range dst) ()
+ (neg dst) nil)
+ (let (strip-values strip-types)
+ (cl-loop for v in (valset dst)
+ unless (symbolp v)
+ do (push v strip-values)
+ (push (type-of v) strip-types))
+ (when strip-values
+ (setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
+ (valset dst) (cl-set-difference (valset dst) strip-values)))
+ (cl-loop for (l . h) in (range dst)
+ when (or (bignump l) (bignump h))
+ do (setf (range dst) '((- . +)))
+ (cl-return))))
+ dst))
+
+(defun comp-cstr-intersection-make (&rest srcs)
+ "Combine SRCS by intersection set operation and return a new constraint."
+ (apply #'comp-cstr-intersection (make-comp-cstr) srcs))
+
+(defun comp-cstr-negation (dst src)
+ "Negate SRC setting the result in DST.
+DST is returned."
+ (with-comp-cstr-accessors
+ (cond
+ ((and (null (valset src))
+ (null (range src))
+ (null (neg src))
+ (equal (typeset src) '(t)))
+ (setf (typeset dst) ()
+ (valset dst) ()
+ (range dst) nil
+ (neg dst) nil))
+ ((and (null (valset src))
+ (null (range src))
+ (null (neg src))
+ (null (typeset src)))
+ (setf (typeset dst) '(t)
+ (valset dst) ()
+ (range dst) nil
+ (neg dst) nil))
+ (t (setf (typeset dst) (typeset src)
+ (valset dst) (valset src)
+ (range dst) (range src)
+ (neg dst) (not (neg src)))))
+ dst))
+
+(defun comp-cstr-value-negation (dst src)
+ "Negate values in SRC setting the result in DST.
+DST is returned."
+ (with-comp-cstr-accessors
+ (if (or (valset src) (range src))
+ (setf (typeset dst) ()
+ (valset dst) (valset src)
+ (range dst) (range src)
+ (neg dst) (not (neg src)))
+ (setf (typeset dst) (typeset src)
+ (valset dst) ()
+ (range dst) ()))
+ dst))
+
+(defun comp-cstr-negation-make (src)
+ "Negate SRC and return a new constraint."
+ (comp-cstr-negation (make-comp-cstr) src))
+
+(defun comp-type-spec-to-cstr (type-spec &optional fn)
+ "Convert a type specifier TYPE-SPEC into a `comp-cstr'.
+FN non-nil indicates we are parsing a function lambda list."
+ (pcase type-spec
+ ((and (or '&optional '&rest) x)
+ (if fn
+ x
+ (error "Invalid `%s` in type specifier" x)))
+ ('nil
+ (make-comp-cstr :typeset ()))
+ ('fixnum
+ (comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
+ ('boolean
+ (comp-type-spec-to-cstr '(member t nil)))
+ ('integer
+ (comp-irange-to-cstr '(- . +)))
+ ('null (comp-value-to-cstr nil))
+ ((pred atom)
+ (comp-type-to-cstr type-spec))
+ (`(or . ,rest)
+ (apply #'comp-cstr-union-make
+ (mapcar #'comp-type-spec-to-cstr rest)))
+ (`(and . ,rest)
+ (apply #'comp-cstr-intersection-make
+ (mapcar #'comp-type-spec-to-cstr rest)))
+ (`(not ,cstr)
+ (comp-cstr-negation-make (comp-type-spec-to-cstr cstr)))
+ (`(integer ,(and (pred integerp) l) ,(and (pred integerp) h))
+ (comp-irange-to-cstr `(,l . ,h)))
+ (`(integer * ,(and (pred integerp) h))
+ (comp-irange-to-cstr `(- . ,h)))
+ (`(integer ,(and (pred integerp) l) *)
+ (comp-irange-to-cstr `(,l . +)))
+ (`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p))
+ ;; No float range support :/
+ (comp-type-to-cstr 'float))
+ (`(member . ,rest)
+ (apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest)))
+ (`(function ,args ,ret)
+ (make-comp-cstr-f
+ :args (mapcar (lambda (x)
+ (comp-type-spec-to-cstr x t))
+ args)
+ :ret (comp-type-spec-to-cstr ret)))
+ (_ (error "Invalid type specifier"))))
+
+(defun comp-cstr-to-type-spec (cstr)
+ "Given CSTR return its type specifier."
+ (let ((valset (comp-cstr-valset cstr))
+ (typeset (comp-cstr-typeset cstr))
+ (range (comp-cstr-range cstr))
+ (negated (comp-cstr-neg cstr)))
+
+ (when valset
+ (when (memq nil valset)
+ (if (memq t valset)
+ (progn
+ ;; t and nil are values, convert into `boolean'.
+ (push 'boolean typeset)
+ (setf valset (remove t (remove nil valset))))
+ ;; Only nil is a value, convert it into a `null' type specifier.
+ (setf valset (remove nil valset))
+ (push 'null typeset))))
+
+ ;; Form proper integer type specifiers.
+ (setf range (cl-loop for (l . h) in range
+ for low = (if (integerp l) l '*)
+ for high = (if (integerp h) h '*)
+ if (and (eq low '*) (eq high '*))
+ collect 'integer
+ else
+ collect `(integer ,low , high))
+ valset (cl-remove-duplicates valset))
+
+ ;; Form the final type specifier.
+ (let* ((types-ints (append typeset range))
+ (res (cond
+ ((and types-ints valset)
+ `((member ,@valset) ,@types-ints))
+ (types-ints types-ints)
+ (valset `(member ,@valset))
+ (t
+ ;; Empty type specifier
+ nil)))
+ (final
+ (pcase res
+ ((or `(member . ,rest)
+ `(integer ,(pred comp-star-or-num-p)
+ ,(pred comp-star-or-num-p)))
+ (if rest
+ res
+ (car res)))
+ ((pred atom) res)
+ (`(,_first . ,rest)
+ (if rest
+ `(or ,@res)
+ (car res))))))
+ (if negated
+ `(not ,final)
+ final))))
+
+(provide 'comp-cstr)
+
+;;; comp-cstr.el ends here
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
new file mode 100644
index 00000000000..7bbe63c3e15
--- /dev/null
+++ b/lisp/emacs-lisp/comp.el
@@ -0,0 +1,4234 @@
+;;; comp.el --- compilation of Lisp code into native code -*- lexical-binding: t -*-
+
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.com>
+;; Keywords: lisp
+;; Package: emacs
+
+;; 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 code is an attempt to make the pig fly.
+;; Or, to put it another way to make a 911 out of a turbocharged VW Bug.
+
+;;; Code:
+
+(require 'bytecomp)
+(require 'cl-extra)
+(require 'cl-lib)
+(require 'cl-macs)
+(require 'cl-seq)
+(require 'gv)
+(require 'rx)
+(require 'subr-x)
+(require 'warnings)
+(require 'comp-cstr)
+
+(defgroup comp nil
+ "Emacs Lisp native compiler."
+ :group 'lisp)
+
+(defcustom native-comp-speed 2
+ "Optimization level for native compilation, a number between -1 and 3.
+ -1 functions are kept in bytecode form and no native compilation is performed.
+ 0 native compilation is performed with no optimizations.
+ 1 light optimizations.
+ 2 max optimization level fully adherent to the language semantic.
+ 3 max optimization level, to be used only when necessary.
+ Warning: with 3, the compiler is free to perform dangerous optimizations."
+ :type 'integer
+ :safe #'integerp
+ :version "28.1")
+
+(defcustom native-comp-debug (if (eq 'windows-nt system-type) 1 0)
+ "Debug level for native compilation, a number between 0 and 3.
+This is intended for debugging the compiler itself.
+ 0 no debug output.
+ 1 emit debug symbols.
+ 2 emit debug symbols and dump pseudo C code.
+ 3 emit debug symbols and dump: pseudo C code, GCC intermediate
+ passes and libgccjit log file."
+ :type 'integer
+ :safe #'natnump
+ :version "28.1")
+
+(defcustom native-comp-verbose 0
+ "Compiler verbosity for native compilation, a number between 0 and 3.
+This is intended for debugging the compiler itself.
+ 0 no logging.
+ 1 final LIMPLE is logged.
+ 2 LAP, final LIMPLE, and some pass info are logged.
+ 3 max verbosity."
+ :type 'integer
+ :risky t
+ :version "28.1")
+
+(defcustom native-comp-always-compile nil
+ "Non-nil means unconditionally (re-)compile all files."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom native-comp-deferred-compilation-deny-list
+ '()
+ "List of regexps to exclude matching files from deferred native compilation.
+Files whose names match any regexp are excluded from native compilation."
+ :type '(repeat regexp)
+ :version "28.1")
+
+(defcustom native-comp-bootstrap-deny-list
+ '()
+ "List of regexps to exclude files from native compilation during bootstrap.
+Files whose names match any regexp are excluded from native compilation
+during bootstrap."
+ :type '(repeat regexp)
+ :version "28.1")
+
+(defcustom native-comp-never-optimize-functions
+ '(;; The following two are mandatory for Emacs to be working
+ ;; correctly (see comment in `advice--add-function'). DO NOT
+ ;; REMOVE.
+ macroexpand rename-buffer)
+ "Primitive functions to exclude from trampoline optimization."
+ :type '(repeat symbol)
+ :version "28.1")
+
+(defcustom native-comp-async-jobs-number 0
+ "Default number of subprocesses used for async native compilation.
+Value of zero means to use half the number of the CPU's execution units,
+or one if there's just one execution unit."
+ :type 'integer
+ :risky t
+ :version "28.1")
+
+(defcustom native-comp-async-cu-done-functions nil
+ "List of functions to call after asynchronously compiling one compilation unit.
+Called with one argument FILE, the filename used as input to
+compilation."
+ :type 'hook
+ :version "28.1")
+
+(defcustom native-comp-async-all-done-hook nil
+ "Hook run after completing asynchronous compilation of all input files."
+ :type 'hook
+ :version "28.1")
+
+(defcustom native-comp-async-env-modifier-form nil
+ "Form evaluated before compilation by each asynchronous compilation subprocess.
+Used to modify the compiler environment."
+ :type 'sexp
+ :risky t
+ :version "28.1")
+
+(defcustom native-comp-async-report-warnings-errors t
+ "Whether to report warnings and errors from asynchronous native compilation.
+
+When native compilation happens asynchronously, it can produce
+warnings and errors, some of which might not be emitted by a
+byte-compilation. The typical case for that is native-compiling
+a file that is missing some `require' of a necessary feature,
+while having it already loaded into the environment when
+byte-compiling.
+
+As asynchronous native compilation always starts from a pristine
+environment, it is more sensitive to such omissions, and might be
+unable to compile such Lisp source files correctly.
+
+Set this variable to nil to suppress warnings altogether, or to
+the symbol `silent' to log warnings but not pop up the *Warnings*
+buffer."
+ :type '(choice
+ (const :tag "Do not report warnings" nil)
+ (const :tag "Report and display warnings" t)
+ (const :tag "Report but do not display warnings" silent))
+ :version "28.1")
+
+(defcustom native-comp-async-query-on-exit nil
+ "Whether to query the user about killing async compilations when exiting.
+If this is non-nil, Emacs will ask for confirmation to exit and kill the
+asynchronous native compilations if any are running. If nil, when you
+exit Emacs, it will silently kill those asynchronous compilations even
+if `confirm-kill-processes' is non-nil."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom native-comp-driver-options nil
+ "Options passed verbatim to the native compiler's back-end driver.
+Note that not all options are meaningful; typically only the options
+affecting the assembler and linker are likely to be useful.
+
+Passing these options is only available in libgccjit version 9
+and above."
+ :type '(repeat string) ; FIXME is this right?
+ :version "28.1")
+
+(defcustom comp-libgccjit-reproducer nil
+ "When non-nil produce a libgccjit reproducer.
+The reproducer is a file ELNFILENAME_libgccjit_repro.c deposed in
+the .eln output directory."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom native-comp-warning-on-missing-source t
+ "Emit a warning if a byte-code file being loaded has no corresponding source.
+The source file is necessary for native code file look-up and deferred
+compilation mechanism."
+ :type 'boolean
+ :version "28.1")
+
+(defvar no-native-compile nil
+ "Non-nil to prevent native-compiling of Emacs Lisp code.
+Note that when `no-byte-compile' is set to non-nil it overrides the value of
+`no-native-compile'.
+This is normally set in local file variables at the end of the
+Emacs Lisp file:
+
+\;; Local Variables:\n;; no-native-compile: t\n;; End:")
+;;;###autoload(put 'no-native-compile 'safe-local-variable 'booleanp)
+
+(defvar native-compile-target-directory nil
+ "When non-nil force the target directory for the eln files being compiled.")
+
+(defvar comp-log-time-report nil
+ "If non-nil, log a time report for each pass.")
+
+(defvar comp-dry-run nil
+ "If non-nil, run everything but the C back-end.")
+
+(defconst comp-valid-source-re (rx ".el" (? ".gz") eos)
+ "Regexp to match filename of valid input source files.")
+
+(defconst comp-log-buffer-name "*Native-compile-Log*"
+ "Name of the native-compiler log buffer.")
+
+(defconst comp-async-buffer-name "*Async-native-compile-log*"
+ "Name of the async compilation buffer log.")
+
+(defvar comp-native-compiling nil
+ "This gets bound to t during native compilation.
+Intended to be used by code that needs to work differently when
+native compilation runs.")
+
+(defvar comp-pass nil
+ "Every native-compilation pass can bind this to whatever it likes.")
+
+(defvar comp-curr-allocation-class 'd-default
+ "Current allocation class.
+Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.")
+
+(defconst comp-passes '(comp-spill-lap
+ comp-limplify
+ comp-fwprop
+ comp-call-optim
+ comp-ipa-pure
+ comp-add-cstrs
+ comp-fwprop
+ comp-tco
+ comp-fwprop
+ comp-remove-type-hints
+ comp-final)
+ "Passes to be executed in order.")
+
+(defvar comp-disabled-passes '()
+ "List of disabled passes.
+For internal use by the test suite only.")
+
+(defvar comp-post-pass-hooks '()
+ "Alist whose elements are of the form (PASS FUNCTIONS...).
+Each function in FUNCTIONS is run after PASS.
+Useful to hook into pass checkers.")
+
+;; FIXME this probably should not be here but... good for now.
+(defconst comp-known-type-specifiers
+ `(
+ ;; Functions we can trust not to be or if redefined should expose
+ ;; the same type. Vast majority of these is either pure or
+ ;; primitive, the original list is the union of pure +
+ ;; side-effect-free-fns + side-effect-and-error-free-fns:
+ (% (function ((or number marker) (or number marker)) number))
+ (* (function (&rest (or number marker)) number))
+ (+ (function (&rest (or number marker)) number))
+ (- (function (&rest (or number marker)) number))
+ (/ (function ((or number marker) &rest (or number marker)) number))
+ (/= (function ((or number marker) (or number marker)) boolean))
+ (1+ (function ((or number marker)) number))
+ (1- (function ((or number marker)) number))
+ (< (function ((or number marker) &rest (or number marker)) boolean))
+ (<= (function ((or number marker) &rest (or number marker)) boolean))
+ (= (function ((or number marker) &rest (or number marker)) boolean))
+ (> (function ((or number marker) &rest (or number marker)) boolean))
+ (>= (function ((or number marker) &rest (or number marker)) boolean))
+ (abs (function (number) number))
+ (acos (function (number) float))
+ (append (function (&rest t) t))
+ (aref (function (t fixnum) t))
+ (arrayp (function (t) boolean))
+ (ash (function (integer integer) integer))
+ (asin (function (number) float))
+ (assq (function (t list) list))
+ (atan (function (number &optional number) float))
+ (atom (function (t) boolean))
+ (bignump (function (t) boolean))
+ (bobp (function () boolean))
+ (bolp (function () boolean))
+ (bool-vector-count-consecutive (function (bool-vector boolean integer) fixnum))
+ (bool-vector-count-population (function (bool-vector) fixnum))
+ (bool-vector-not (function (bool-vector &optional bool-vector) bool-vector))
+ (bool-vector-p (function (t) boolean))
+ (bool-vector-subsetp (function (bool-vector bool-vector) boolean))
+ (boundp (function (symbol) boolean))
+ (buffer-end (function ((or number marker)) integer))
+ (buffer-file-name (function (&optional buffer) string))
+ (buffer-list (function (&optional frame) list))
+ (buffer-local-variables (function (&optional buffer) list))
+ (buffer-modified-p (function (&optional buffer) boolean))
+ (buffer-size (function (&optional buffer) integer))
+ (buffer-string (function () string))
+ (buffer-substring (function ((or integer marker) (or integer marker)) string))
+ (bufferp (function (t) boolean))
+ (byte-code-function-p (function (t) boolean))
+ (capitalize (function (or integer string) (or integer string)))
+ (car (function (list) t))
+ (car-less-than-car (function (list list) boolean))
+ (car-safe (function (t) t))
+ (case-table-p (function (t) boolean))
+ (cdr (function (list) t))
+ (cdr-safe (function (t) t))
+ (ceiling (function (number &optional number) integer))
+ (char-after (function (&optional (or marker integer)) fixnum))
+ (char-before (function (&optional (or marker integer)) fixnum))
+ (char-equal (function (integer integer) boolean))
+ (char-or-string-p (function (t) boolean))
+ (char-to-string (function (fixnum) string))
+ (char-width (function (fixnum) fixnum))
+ (characterp (function (t &optional t) boolean))
+ (charsetp (function (t) boolean))
+ (commandp (function (t &optional t) boolean))
+ (compare-strings (function (string (or integer marker null) (or integer marker null) string (or integer marker null) (or integer marker null) &optional t) (or (member t) fixnum)))
+ (concat (function (&rest sequence) string))
+ (cons (function (t t) cons))
+ (consp (function (t) boolean))
+ (coordinates-in-window-p (function (cons window) boolean))
+ (copy-alist (function (list) list))
+ (copy-marker (function (&optional (or integer marker) boolean) marker))
+ (copy-sequence (function (sequence) sequence))
+ (copysign (function (float float) float))
+ (cos (function (number) float))
+ (count-lines (function ((or integer marker) (or integer marker) &optional t) integer))
+ (current-buffer (function () buffer))
+ (current-global-map (function () cons))
+ (current-indentation (function () integer))
+ (current-local-map (function () cons))
+ (current-minor-mode-maps (function () cons))
+ (current-time (function () cons))
+ (current-time-string (function (&optional string boolean) string))
+ (current-time-zone (function (&optional string boolean) cons))
+ (custom-variable-p (function (symbol) boolean))
+ (decode-char (function (cons t) (or fixnum null)))
+ (decode-time (function (&optional string symbol symbol) cons))
+ (default-boundp (function (symbol) boolean))
+ (default-value (function (symbol) t))
+ (degrees-to-radians (function (number) float))
+ (documentation (function ((or function symbol subr) &optional t) (or null string)))
+ (downcase (function ((or fixnum string)) (or fixnum string)))
+ (elt (function (sequence integer) t))
+ (encode-char (function (fixnum symbol) (or fixnum null)))
+ (encode-time (function (cons &rest t) cons))
+ (eobp (function () boolean))
+ (eolp (function () boolean))
+ (eq (function (t t) boolean))
+ (eql (function (t t) boolean))
+ (equal (function (t t) boolean))
+ (error-message-string (function (list) string))
+ (eventp (function (t) boolean))
+ (exp (function (number) float))
+ (expt (function (number number) float))
+ (fboundp (function (symbol) boolean))
+ (fceiling (function (float) float))
+ (featurep (function (symbol &optional symbol) boolean))
+ (ffloor (function (float) float))
+ (file-directory-p (function (string) boolean))
+ (file-exists-p (function (string) boolean))
+ (file-locked-p (function (string) boolean))
+ (file-name-absolute-p (function (string) boolean))
+ (file-newer-than-file-p (function (string string) boolean))
+ (file-readable-p (function (string) boolean))
+ (file-symlink-p (function (string) boolean))
+ (file-writable-p (function (string) boolean))
+ (fixnump (function (t) boolean))
+ (float (function (number) float))
+ (float-time (function (&optional cons) float))
+ (floatp (function (t) boolean))
+ (floor (function (number &optional number) integer))
+ (following-char (function () fixnum))
+ (format (function (string &rest t) string))
+ (format-time-string (function (string &optional cons symbol) string))
+ (frame-first-window (function ((or frame window)) window))
+ (frame-root-window (function (&optional (or frame window)) window))
+ (frame-selected-window (function (&optional (or frame window)) window))
+ (frame-visible-p (function (frame) boolean))
+ (framep (function (t) boolean))
+ (fround (function (float) float))
+ (ftruncate (function (float) float))
+ (get (function (symbol symbol) t))
+ (get-buffer (function ((or buffer string)) (or buffer null)))
+ (get-buffer-window (function (&optional (or buffer string) (or symbol (integer 0 0))) (or null window)))
+ (get-file-buffer (function (string) (or null buffer)))
+ (get-largest-window (function (&optional t t t) window))
+ (get-lru-window (function (&optional t t t) window))
+ (getenv (function (string &optional frame) (or null string)))
+ (gethash (function (t hash-table &optional t) t))
+ (hash-table-count (function (hash-table) integer))
+ (hash-table-p (function (t) boolean))
+ (identity (function (t) t))
+ (ignore (function (&rest t) null))
+ (int-to-string (function (number) string))
+ (integer-or-marker-p (function (t) boolean))
+ (integerp (function (t) boolean))
+ (interactive-p (function () boolean))
+ (intern-soft (function ((or string symbol) &optional vector) symbol))
+ (invocation-directory (function () string))
+ (invocation-name (function () string))
+ (isnan (function (float) boolean))
+ (keymap-parent (function (cons) (or cons null)))
+ (keymapp (function (t) boolean))
+ (keywordp (function (t) boolean))
+ (last (function (list &optional integer) list))
+ (lax-plist-get (function (list t) t))
+ (ldexp (function (number integer) float))
+ (length (function (t) (integer 0 *)))
+ (length< (function (sequence fixnum) boolean))
+ (length= (function (sequence fixnum) boolean))
+ (length> (function (sequence fixnum) boolean))
+ (line-beginning-position (function (&optional integer) integer))
+ (line-end-position (function (&optional integer) integer))
+ (list (function (&rest t) list))
+ (listp (function (t) boolean))
+ (local-variable-if-set-p (function (symbol &optional buffer) boolean))
+ (local-variable-p (function (symbol &optional buffer) boolean))
+ (locale-info (function ((member codeset days months paper)) (or null string)))
+ (log (function (number number) float))
+ (log10 (function (number) float))
+ (logand (function (&rest (or integer marker)) integer))
+ (logb (function (number) integer))
+ (logcount (function (integer) integer))
+ (logior (function (&rest (or integer marker)) integer))
+ (lognot (function (integer) integer))
+ (logxor (function (&rest (or integer marker)) integer))
+ ;; (lsh (function ((integer ,most-negative-fixnum *) integer) integer)) ?
+ (lsh (function (integer integer) integer))
+ (make-byte-code (function ((or fixnum list) string vector integer &optional string t &rest t) vector))
+ (make-list (function (integer t) list))
+ (make-marker (function () marker))
+ (make-string (function (integer fixnum &optional t) string))
+ (make-symbol (function (string) symbol))
+ (mark (function (&optional t) (or integer null)))
+ (mark-marker (function () marker))
+ (marker-buffer (function (marker) buffer))
+ (markerp (function (t) boolean))
+ (max (function ((or number marker) &rest (or number marker)) number))
+ (max-char (function () fixnum))
+ (member (function (t list) list))
+ (memory-limit (function () integer))
+ (memq (function (t list) list))
+ (memql (function (t list) list))
+ (min (function ((or number marker) &rest (or number marker)) number))
+ (minibuffer-selected-window (function () window))
+ (minibuffer-window (function (&optional frame) window))
+ (mod (function ((or number marker) (or number marker)) (or (integer 0 *) (float 0 *))))
+ (mouse-movement-p (function (t) boolean))
+ (multibyte-char-to-unibyte (function (fixnum) fixnum))
+ (natnump (function (t) boolean))
+ (next-window (function (&optional window t t) window))
+ (nlistp (function (t) boolean))
+ (not (function (t) boolean))
+ (nth (function (integer list) t))
+ (nthcdr (function (integer t) t))
+ (null (function (t) boolean))
+ (number-or-marker-p (function (t) boolean))
+ (number-to-string (function (number) string))
+ (numberp (function (t) boolean))
+ (one-window-p (function (&optional t t) boolean))
+ (overlayp (function (t) boolean))
+ (parse-colon-path (function (string) cons))
+ (plist-get (function (list t) t))
+ (plist-member (function (list t) list))
+ (point (function () integer))
+ (point-marker (function () marker))
+ (point-max (function () integer))
+ (point-min (function () integer))
+ (preceding-char (function () fixnum))
+ (previous-window (function (&optional window t t) window))
+ (prin1-to-string (function (t &optional t) string))
+ (processp (function (t) boolean))
+ (proper-list-p (function (t) integer))
+ (propertize (function (string &rest t) string))
+ (radians-to-degrees (function (number) float))
+ (rassoc (function (t list) list))
+ (rassq (function (t list) list))
+ (read-from-string (function (string &optional integer integer) cons))
+ (recent-keys (function (&optional (or cons null)) vector))
+ (recursion-depth (function () integer))
+ (regexp-opt (function (list) string))
+ (regexp-quote (function (string) string))
+ (region-beginning (function () integer))
+ (region-end (function () integer))
+ (reverse (function (sequence) sequence))
+ (round (function (number &optional number) integer))
+ (safe-length (function (t) integer))
+ (selected-frame (function () frame))
+ (selected-window (function () window))
+ (sequencep (function (t) boolean))
+ (sin (function (number) float))
+ (sqrt (function (number) float))
+ (standard-case-table (function () char-table))
+ (standard-syntax-table (function () char-table))
+ (string (function (&rest fixnum) string))
+ (string-as-multibyte (function (string) string))
+ (string-as-unibyte (function (string) string))
+ (string-equal (function ((or string symbol) (or string symbol)) boolean))
+ (string-lessp (function ((or string symbol) (or string symbol)) boolean))
+ (string-make-multibyte (function (string) string))
+ (string-make-unibyte (function (string) string))
+ (string-search (function (string string &optional integer) (or integer null)))
+ (string-to-char (function (string) fixnum))
+ (string-to-multibyte (function (string) string))
+ (string-to-number (function (string &optional integer) number))
+ (string-to-syntax (function (string) cons))
+ (string< (function ((or string symbol) (or string symbol)) boolean))
+ (string= (function ((or string symbol) (or string symbol)) boolean))
+ (stringp (function (t) boolean))
+ (subrp (function (t) boolean))
+ (substring (function ((or string vector) &optional integer integer) (or string vector)))
+ (sxhash (function (t) integer))
+ (sxhash-eq (function (t) integer))
+ (sxhash-eql (function (t) integer))
+ (sxhash-equal (function (t) integer))
+ (symbol-function (function (symbol) t))
+ (symbol-name (function (symbol) string))
+ (symbol-plist (function (symbol) list))
+ (symbol-value (function (symbol) t))
+ (symbolp (function (t) boolean))
+ (syntax-table (function () char-table))
+ (syntax-table-p (function (t) boolean))
+ (tan (function (number) float))
+ (this-command-keys (function () string))
+ (this-command-keys-vector (function () vector))
+ (this-single-command-keys (function () vector))
+ (this-single-command-raw-keys (function () vector))
+ (time-convert (function (t &optional (or boolean integer)) cons))
+ (truncate (function (number &optional number) integer))
+ (type-of (function (t) symbol))
+ (unibyte-char-to-multibyte (function (fixnum) fixnum)) ;; byte is fixnum
+ (upcase (function ((or fixnum string)) (or fixnum string)))
+ (user-full-name (function (&optional integer) (or string null)))
+ (user-login-name (function (&optional integer) (or string null)))
+ (user-original-login-name (function (&optional integer) (or string null)))
+ (user-real-login-name (function () string))
+ (user-real-uid (function () integer))
+ (user-uid (function () integer))
+ (vconcat (function (&rest sequence) vector))
+ (vector (function (&rest t) vector))
+ (vectorp (function (t) boolean))
+ (visible-frame-list (function () list))
+ (wholenump (function (t) boolean))
+ (window-configuration-p (function (t) boolean))
+ (window-live-p (function (t) boolean))
+ (window-valid-p (function (t) boolean))
+ (windowp (function (t) boolean))
+ (zerop (function (number) boolean))
+ ;; Type hints
+ (comp-hint-fixnum (function (t) fixnum))
+ (comp-hint-cons (function (t) cons))
+ ;; Non returning functions
+ (throw (function (t t) nil))
+ (error (function (string &rest t) nil))
+ (signal (function (symbol t) nil)))
+ "Alist used for type propagation.")
+
+(defconst comp-known-func-cstr-h
+ (cl-loop
+ with comp-ctxt = (make-comp-cstr-ctxt)
+ with h = (make-hash-table :test #'eq)
+ for (f type-spec) in comp-known-type-specifiers
+ for cstr = (comp-type-spec-to-cstr type-spec)
+ do (puthash f cstr h)
+ finally return h)
+ "Hash table function -> `comp-constraint'.")
+
+(defconst comp-known-predicates
+ '((arrayp . array)
+ (atom . atom)
+ (characterp . fixnum)
+ (booleanp . boolean)
+ (bool-vector-p . bool-vector)
+ (bufferp . buffer)
+ (natnump . (integer 0 *))
+ (char-table-p . char-table)
+ (hash-table-p . hash-table)
+ (consp . cons)
+ (integerp . integer)
+ (floatp . float)
+ (functionp . (or function symbol))
+ (integerp . integer)
+ (keywordp . keyword)
+ (listp . list)
+ (numberp . number)
+ (null . null)
+ (numberp . number)
+ (sequencep . sequence)
+ (stringp . string)
+ (symbolp . symbol)
+ (vectorp . vector)
+ (integer-or-marker-p . integer-or-marker))
+ "Alist predicate -> matched type specifier.")
+
+(defconst comp-known-predicates-h
+ (cl-loop
+ with comp-ctxt = (make-comp-cstr-ctxt)
+ with h = (make-hash-table :test #'eq)
+ for (pred . type-spec) in comp-known-predicates
+ for cstr = (comp-type-spec-to-cstr type-spec)
+ do (puthash pred cstr h)
+ finally return h)
+ "Hash table function -> `comp-constraint'.")
+
+(defun comp-known-predicate-p (predicate)
+ "Return t if PREDICATE is known."
+ (when (gethash predicate comp-known-predicates-h) t))
+
+(defun comp-pred-to-cstr (predicate)
+ "Given PREDICATE, return the corresponding constraint."
+ (gethash predicate comp-known-predicates-h))
+
+(defconst comp-symbol-values-optimizable '(most-positive-fixnum
+ most-negative-fixnum)
+ "Symbol values we can resolve at compile-time.")
+
+(defconst comp-type-hints '(comp-hint-fixnum
+ comp-hint-cons)
+ "List of fake functions used to give compiler hints.")
+
+(defconst comp-limple-sets '(set
+ setimm
+ set-par-to-local
+ set-args-to-local
+ set-rest-args-to-local)
+ "Limple set operators.")
+
+(defconst comp-limple-assignments `(assume
+ fetch-handler
+ ,@comp-limple-sets)
+ "Limple operators that clobber the first m-var argument.")
+
+(defconst comp-limple-calls '(call
+ callref
+ direct-call
+ direct-callref)
+ "Limple operators used to call subrs.")
+
+(defconst comp-limple-branches '(jump cond-jump)
+ "Limple operators used for conditional and unconditional branches.")
+
+(defconst comp-limple-ops `(,@comp-limple-calls
+ ,@comp-limple-assignments
+ ,@comp-limple-branches
+ return)
+ "All Limple operators.")
+
+(defvar comp-func nil
+ "Bound to the current function by most passes.")
+
+(defvar comp-block nil
+ "Bound to the current basic block by some passes.")
+
+(define-error 'native-compiler-error-dyn-func
+ "can't native compile a non-lexically-scoped function"
+ 'native-compiler-error)
+(define-error 'native-compiler-error-empty-byte
+ "empty byte compiler output"
+ 'native-compiler-error)
+
+
+;; Moved early to avoid circularity when comp.el is loaded and
+;; `macroexpand' needs to be advised (bug#47049).
+;;;###autoload
+(defun comp-subr-trampoline-install (subr-name)
+ "Make SUBR-NAME effectively advice-able when called from native code."
+ (unless (or (null comp-enable-subr-trampolines)
+ (memq subr-name native-comp-never-optimize-functions)
+ (gethash subr-name comp-installed-trampolines-h))
+ (cl-assert (subr-primitive-p (symbol-function subr-name)))
+ (comp--install-trampoline
+ subr-name
+ (or (comp-trampoline-search subr-name)
+ (comp-trampoline-compile subr-name)
+ ;; Should never happen.
+ (cl-assert nil)))))
+
+
+(cl-defstruct (comp-vec (:copier nil))
+ "A re-sizable vector like object."
+ (data (make-hash-table :test #'eql) :type hash-table
+ :documentation "Payload data.")
+ (beg 0 :type integer)
+ (end 0 :type natnum))
+
+(defsubst comp-vec-copy (vec)
+ "Return a copy of VEC."
+ (make-comp-vec :data (copy-hash-table (comp-vec-data vec))
+ :beg (comp-vec-beg vec)
+ :end (comp-vec-end vec)))
+
+(defsubst comp-vec-length (vec)
+ "Return the number of elements of VEC."
+ (- (comp-vec-end vec) (comp-vec-beg vec)))
+
+(defsubst comp-vec--verify-idx (vec idx)
+ "Check whether IDX is in bounds for VEC."
+ (cl-assert (and (< idx (comp-vec-end vec))
+ (>= idx (comp-vec-beg vec)))))
+
+(defsubst comp-vec-aref (vec idx)
+ "Return the element of VEC whose index is IDX."
+ (declare (gv-setter (lambda (val)
+ `(comp-vec--verify-idx ,vec ,idx)
+ `(puthash ,idx ,val (comp-vec-data ,vec)))))
+ (comp-vec--verify-idx vec idx)
+ (gethash idx (comp-vec-data vec)))
+
+(defsubst comp-vec-append (vec elt)
+ "Append ELT into VEC.
+Returns ELT."
+ (puthash (comp-vec-end vec) elt (comp-vec-data vec))
+ (cl-incf (comp-vec-end vec))
+ elt)
+
+(defsubst comp-vec-prepend (vec elt)
+ "Prepend ELT into VEC.
+Returns ELT."
+ (puthash (1- (comp-vec-beg vec)) elt (comp-vec-data vec))
+ (cl-decf (comp-vec-beg vec))
+ elt)
+
+
+
+(eval-when-compile
+ (defconst comp-op-stack-info
+ (cl-loop with h = (make-hash-table)
+ for k across byte-code-vector
+ for v across byte-stack+-info
+ when k
+ do (puthash k v h)
+ finally return h)
+ "Hash table lap-op -> stack adjustment."))
+
+(define-hash-table-test 'comp-imm-equal-test #'equal-including-properties
+ #'sxhash-equal-including-properties)
+
+(cl-defstruct comp-data-container
+ "Data relocation container structure."
+ (l () :type list
+ :documentation "Constant objects used by functions.")
+ (idx (make-hash-table :test 'comp-imm-equal-test) :type hash-table
+ :documentation "Obj -> position into the previous field."))
+
+(cl-defstruct (comp-ctxt (:include comp-cstr-ctxt))
+ "Lisp side of the compiler context."
+ (output nil :type string
+ :documentation "Target output file-name for the compilation.")
+ (speed native-comp-speed :type number
+ :documentation "Default speed for this compilation unit.")
+ (debug native-comp-debug :type number
+ :documentation "Default debug level for this compilation unit.")
+ (driver-options native-comp-driver-options :type list
+ :documentation "Options for the GCC driver.")
+ (top-level-forms () :type list
+ :documentation "List of spilled top level forms.")
+ (funcs-h (make-hash-table :test #'equal) :type hash-table
+ :documentation "c-name -> comp-func.")
+ (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table
+ :documentation "symbol-function -> c-name.
+This is only for optimizing intra CU calls at speed 3.")
+ (byte-func-to-func-h (make-hash-table :test #'equal) :type hash-table
+ :documentation "byte-function -> comp-func.
+Needed to replace immediate byte-compiled lambdas with the compiled reference.")
+ (lambda-fixups-h (make-hash-table :test #'equal) :type hash-table
+ :documentation "Hash table byte-func -> mvar to fixup.")
+ (function-docs (make-hash-table :test #'eql) :type (or hash-table vector)
+ :documentation "Documentation index -> documentation")
+ (d-default (make-comp-data-container) :type comp-data-container
+ :documentation "Standard data relocated in use by functions.")
+ (d-impure (make-comp-data-container) :type comp-data-container
+ :documentation "Relocated data that cannot be moved into pure space.
+This is typically for top-level forms other than defun.")
+ (d-ephemeral (make-comp-data-container) :type comp-data-container
+ :documentation "Relocated data not necessary after load.")
+ (with-late-load nil :type boolean
+ :documentation "When non-nil support late load."))
+
+(cl-defstruct comp-args-base
+ (min nil :type integer
+ :documentation "Minimum number of arguments allowed."))
+
+(cl-defstruct (comp-args (:include comp-args-base))
+ (max nil :type integer
+ :documentation "Maximum number of arguments allowed."))
+
+(cl-defstruct (comp-nargs (:include comp-args-base))
+ "Describe args when the function signature is of kind:
+(ptrdiff_t nargs, Lisp_Object *args)."
+ (nonrest nil :type integer
+ :documentation "Number of non rest arguments.")
+ (rest nil :type boolean
+ :documentation "t if rest argument is present."))
+
+(cl-defstruct (comp-block (:copier nil)
+ (:constructor nil))
+ "A base class for basic blocks."
+ (name nil :type symbol)
+ (insns () :type list
+ :documentation "List of instructions.")
+ (closed nil :type boolean
+ :documentation "t if closed.")
+ ;; All the following are for SSA and CGF analysis.
+ ;; Keep in sync with `comp-clean-ssa'!!
+ (in-edges () :type list
+ :documentation "List of incoming edges.")
+ (out-edges () :type list
+ :documentation "List of out-coming edges.")
+ (idom nil :type (or null comp-block)
+ :documentation "Immediate dominator.")
+ (df (make-hash-table) :type (or null hash-table)
+ :documentation "Dominance frontier set. Block-name -> block")
+ (post-num nil :type (or null number)
+ :documentation "Post order number.")
+ (final-frame nil :type (or null comp-vec)
+ :documentation "This is a copy of the frame when leaving the block.
+Is in use to help the SSA rename pass."))
+
+(cl-defstruct (comp-block-lap (:copier nil)
+ (:include comp-block)
+ (:constructor make--comp-block-lap
+ (addr sp name))) ; Positional
+ "A basic block created from lap (real code)."
+ ;; These two slots are used during limplification.
+ (sp nil :type number
+ :documentation "When non-nil indicates the sp value while entering
+into it.")
+ (addr nil :type number
+ :documentation "Start block LAP address.")
+ (non-ret-insn nil :type list
+ :documentation "Insn known to perform a non local exit.
+`comp-fwprop' may identify and store here basic blocks performing
+non local exits and mark it rewrite it later.")
+ (no-ret nil :type boolean
+ :documentation "t when the block is known to perform a
+non local exit (ends with an `unreachable' insn)."))
+
+(cl-defstruct (comp-latch (:copier nil)
+ (:include comp-block))
+ "A basic block for a latch loop.")
+
+(cl-defstruct (comp-block-cstr (:copier nil)
+ (:include comp-block))
+ "A basic block holding only constraints.")
+
+(cl-defstruct (comp-edge (:copier nil) (:constructor make--comp-edge))
+ "An edge connecting two basic blocks."
+ (src nil :type (or null comp-block))
+ (dst nil :type (or null comp-block))
+ (number nil :type number
+ :documentation "The index number corresponding to this edge in the
+ edge hash."))
+
+(defun make-comp-edge (&rest args)
+ "Create a `comp-edge' with basic blocks SRC and DST."
+ (let ((n (funcall (comp-func-edge-cnt-gen comp-func))))
+ (puthash
+ n
+ (apply #'make--comp-edge :number n args)
+ (comp-func-edges-h comp-func))))
+
+(defun comp-block-preds (basic-block)
+ "Return the list of predecessors of BASIC-BLOCK."
+ (mapcar #'comp-edge-src (comp-block-in-edges basic-block)))
+
+(defun comp-gen-counter ()
+ "Return a sequential number generator."
+ (let ((n -1))
+ (lambda ()
+ (cl-incf n))))
+
+(cl-defstruct (comp-func (:copier nil))
+ "LIMPLE representation of a function."
+ (name nil :type symbol
+ :documentation "Function symbol name. Nil indicates anonymous.")
+ (c-name nil :type string
+ :documentation "The function name in the native world.")
+ (byte-func nil
+ :documentation "Byte-compiled version.")
+ (doc nil :type string
+ :documentation "Doc string.")
+ (int-spec nil :type list
+ :documentation "Interactive form.")
+ (lap () :type list
+ :documentation "LAP assembly representation.")
+ (ssa-status nil :type symbol
+ :documentation "SSA status either: 'nil', 'dirty' or 't'.
+Once in SSA form this *must* be set to 'dirty' every time the topology of the
+CFG is mutated by a pass.")
+ (frame-size nil :type integer)
+ (vframe-size 0 :type integer)
+ (blocks (make-hash-table :test #'eq) :type hash-table
+ :documentation "Basic block symbol -> basic block.")
+ (lap-block (make-hash-table :test #'equal) :type hash-table
+ :documentation "LAP label -> LIMPLE basic block name.")
+ (edges-h (make-hash-table) :type hash-table
+ :documentation "Hash edge-num -> edge connecting basic two blocks.")
+ (block-cnt-gen (funcall #'comp-gen-counter) :type function
+ :documentation "Generates block numbers.")
+ (edge-cnt-gen (funcall #'comp-gen-counter) :type function
+ :documentation "Generates edges numbers.")
+ (has-non-local nil :type boolean
+ :documentation "t if non local jumps are present.")
+ (speed nil :type number
+ :documentation "Optimization level (see `native-comp-speed').")
+ (pure nil :type boolean
+ :documentation "t if pure nil otherwise.")
+ (type nil :type (or null comp-mvar)
+ :documentation "Mvar holding the derived return type."))
+
+(cl-defstruct (comp-func-l (:include comp-func))
+ "Lexically-scoped function."
+ (args nil :type comp-args-base
+ :documentation "Argument specification of the function"))
+
+(cl-defstruct (comp-func-d (:include comp-func))
+ "Dynamically-scoped function."
+ (lambda-list nil :type list
+ :documentation "Original lambda-list."))
+
+(cl-defstruct (comp-mvar (:constructor make--comp-mvar)
+ (:include comp-cstr))
+ "A meta-variable being a slot in the meta-stack."
+ (id nil :type (or null number)
+ :documentation "Unique id when in SSA form.")
+ (slot nil :type (or fixnum symbol)
+ :documentation "Slot number in the array if a number or
+ 'scratch' for scratch slot."))
+
+(defun comp-mvar-type-hint-match-p (mvar type-hint)
+ "Match MVAR against TYPE-HINT.
+In use by the back-end."
+ (cl-ecase type-hint
+ (cons (comp-cstr-cons-p mvar))
+ (fixnum (comp-cstr-fixnum-p mvar))))
+
+
+
+(defun comp-ensure-native-compiler ()
+ "Make sure Emacs has native compiler support and libgccjit can be loaded.
+Signal an error otherwise.
+To be used by all entry points."
+ (cond
+ ((null (featurep 'native-compile))
+ (error "Emacs was not compiled with native compiler support (--with-native-compilation)"))
+ ((null (native-comp-available-p))
+ (error "Cannot find libgccjit library"))))
+
+(defun comp-equality-fun-p (function)
+ "Equality functions predicate for FUNCTION."
+ (when (memq function '(eq eql equal)) t))
+
+(defun comp-arithm-cmp-fun-p (function)
+ "Predicate for arithmetic comparison functions."
+ (when (memq function '(= > < >= <=)) t))
+
+(defun comp-set-op-p (op)
+ "Assignment predicate for OP."
+ (when (memq op comp-limple-sets) t))
+
+(defun comp-assign-op-p (op)
+ "Assignment predicate for OP."
+ (when (memq op comp-limple-assignments) t))
+
+(defun comp-call-op-p (op)
+ "Call predicate for OP."
+ (when (memq op comp-limple-calls) t))
+
+(defun comp-branch-op-p (op)
+ "Branch predicate for OP."
+ (when (memq op comp-limple-branches) t))
+
+(defsubst comp-limple-insn-call-p (insn)
+ "Limple INSN call predicate."
+ (comp-call-op-p (car-safe insn)))
+
+(defun comp-type-hint-p (func)
+ "Type-hint predicate for function name FUNC."
+ (when (memq func comp-type-hints) t))
+
+(defun comp-func-unique-in-cu-p (func)
+ "Return t if FUNC is known to be unique in the current compilation unit."
+ (if (symbolp func)
+ (cl-loop with h = (make-hash-table :test #'eq)
+ for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt)
+ for name = (comp-func-name f)
+ when (gethash name h)
+ return nil
+ do (puthash name t h)
+ finally return t)
+ t))
+
+(defsubst comp-symbol-func-to-fun (symbol-funcion)
+ "Given a function called SYMBOL-FUNCION return its `comp-func'."
+ (gethash (gethash symbol-funcion (comp-ctxt-sym-to-c-name-h
+ comp-ctxt))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+(defun comp-function-pure-p (f)
+ "Return t if F is pure."
+ (or (get f 'pure)
+ (when-let ((func (comp-symbol-func-to-fun f)))
+ (comp-func-pure func))))
+
+(defun comp-alloc-class-to-container (alloc-class)
+ "Given ALLOC-CLASS, return the data container for the current context.
+Assume allocation class 'd-default as default."
+ (cl-struct-slot-value 'comp-ctxt (or alloc-class 'd-default) comp-ctxt))
+
+(defsubst comp-add-const-to-relocs (obj)
+ "Keep track of OBJ into the ctxt relocations."
+ (puthash obj t (comp-data-container-idx (comp-alloc-class-to-container
+ comp-curr-allocation-class))))
+
+
+;;; Log routines.
+
+(defconst comp-limple-lock-keywords
+ `((,(rx bol "(comment" (1+ not-newline)) . font-lock-comment-face)
+ (,(rx "#(" (group-n 1 "mvar"))
+ (1 font-lock-function-name-face))
+ (,(rx bol "(" (group-n 1 "phi"))
+ (1 font-lock-variable-name-face))
+ (,(rx bol "(" (group-n 1 (or "return" "unreachable")))
+ (1 font-lock-warning-face))
+ (,(rx (group-n 1 (or "entry"
+ (seq (or "entry_" "entry_fallback_" "bb_")
+ (1+ num) (? (or "_latch"
+ (seq "_cstrs_" (1+ num))))))))
+ (1 font-lock-constant-face))
+ (,(rx-to-string
+ `(seq "(" (group-n 1 (or ,@(mapcar #'symbol-name comp-limple-ops)))))
+ (1 font-lock-keyword-face)))
+ "Highlights used by `native-comp-limple-mode'.")
+
+(define-derived-mode native-comp-limple-mode fundamental-mode "LIMPLE"
+ "Syntax-highlight LIMPLE IR."
+ (setf font-lock-defaults '(comp-limple-lock-keywords)))
+
+(cl-defun comp-log (data &optional (level 1) quoted)
+ "Log DATA at LEVEL.
+LEVEL is a number from 1-3, and defaults to 1; if it is less
+than `native-comp-verbose', do nothing. If `noninteractive', log
+with `message'. Otherwise, log with `comp-log-to-buffer'."
+ (when (>= native-comp-verbose level)
+ (if noninteractive
+ (cl-typecase data
+ (atom (message "%s" data))
+ (t (dolist (elem data)
+ (message "%s" elem))))
+ (comp-log-to-buffer data quoted))))
+
+(cl-defun comp-log-to-buffer (data &optional quoted)
+ "Log DATA to `comp-log-buffer-name'."
+ (let* ((print-f (if quoted #'prin1 #'princ))
+ (log-buffer
+ (or (get-buffer comp-log-buffer-name)
+ (with-current-buffer (get-buffer-create comp-log-buffer-name)
+ (setf buffer-read-only t)
+ (current-buffer))))
+ (log-window (get-buffer-window log-buffer))
+ (inhibit-read-only t)
+ at-end-p)
+ (with-current-buffer log-buffer
+ (unless (eq major-mode 'native-comp-limple-mode)
+ (native-comp-limple-mode))
+ (when (= (point) (point-max))
+ (setf at-end-p t))
+ (save-excursion
+ (goto-char (point-max))
+ (cl-typecase data
+ (atom (funcall print-f data log-buffer))
+ (t (dolist (elem data)
+ (funcall print-f elem log-buffer)
+ (insert "\n"))))
+ (insert "\n"))
+ (when (and at-end-p log-window)
+ ;; When log window's point is at the end, follow the tail.
+ (with-selected-window log-window
+ (goto-char (point-max)))))))
+
+(defun comp-prettyformat-mvar (mvar)
+ (format "#(mvar %s %s %S)"
+ (comp-mvar-id mvar)
+ (comp-mvar-slot mvar)
+ (comp-cstr-to-type-spec mvar)))
+
+(defun comp-prettyformat-insn (insn)
+ (cl-typecase insn
+ (comp-mvar (comp-prettyformat-mvar insn))
+ (atom (prin1-to-string insn))
+ (cons (concat "(" (mapconcat #'comp-prettyformat-insn insn " ") ")"))))
+
+(defun comp-log-func (func verbosity)
+ "Log function FUNC at VERBOSITY.
+VERBOSITY is a number between 0 and 3."
+ (when (>= native-comp-verbose verbosity)
+ (comp-log (format "\nFunction: %s\n" (comp-func-name func)) verbosity)
+ (cl-loop
+ for block-name being each hash-keys of (comp-func-blocks func)
+ using (hash-value bb)
+ do (comp-log (concat "<" (symbol-name block-name) ">") verbosity)
+ (cl-loop
+ for insn in (comp-block-insns bb)
+ do (comp-log (comp-prettyformat-insn insn) verbosity)))))
+
+(defun comp-log-edges (func)
+ "Log edges in FUNC."
+ (let ((edges (comp-func-edges-h func)))
+ (comp-log (format "\nEdges in function: %s\n"
+ (comp-func-name func))
+ 2)
+ (maphash (lambda (_ e)
+ (comp-log (format "n: %d src: %s dst: %s\n"
+ (comp-edge-number e)
+ (comp-block-name (comp-edge-src e))
+ (comp-block-name (comp-edge-dst e)))
+ 2))
+ edges)))
+
+
+
+(defmacro comp-loop-insn-in-block (basic-block &rest body)
+ "Loop over all insns in BASIC-BLOCK executing BODY.
+Inside BODY, `insn' and `insn-cell'can be used to read or set the
+current instruction or its cell."
+ (declare (debug (form body))
+ (indent defun))
+ `(cl-symbol-macrolet ((insn (car insn-cell)))
+ (let ((insn-cell (comp-block-insns ,basic-block)))
+ (while insn-cell
+ ,@body
+ (setf insn-cell (cdr insn-cell))))))
+
+;;; spill-lap pass specific code.
+
+(defun comp-lex-byte-func-p (f)
+ "Return t if F is a lexically-scoped byte compiled function."
+ (and (byte-code-function-p f)
+ (fixnump (aref f 0))))
+
+(defun comp-spill-decl-spec (function-name spec)
+ "Return the declared specifier SPEC for FUNCTION-NAME."
+ (plist-get (cdr (assq function-name byte-to-native-plist-environment))
+ spec))
+
+(defun comp-spill-speed (function-name)
+ "Return the speed for FUNCTION-NAME."
+ (or (comp-spill-decl-spec function-name 'speed)
+ (comp-ctxt-speed comp-ctxt)))
+
+;; Autoloaded as might be used by `disassemble-internal'.
+;;;###autoload
+(defun comp-c-func-name (name prefix &optional first)
+ "Given NAME, return a name suitable for the native code.
+Add PREFIX in front of it. If FIRST is not nil, pick the first
+available name ignoring compilation context and potential name
+clashes."
+ ;; Unfortunately not all symbol names are valid as C function names...
+ ;; Nassi's algorithm here:
+ (let* ((orig-name (if (symbolp name) (symbol-name name) name))
+ (crypted (cl-loop with str = (make-string (* 2 (length orig-name)) 0)
+ for j from 0 by 2
+ for i across orig-name
+ for byte = (format "%x" i)
+ do (aset str j (aref byte 0))
+ (aset str (1+ j) (aref byte 1))
+ finally return str))
+ (human-readable (string-replace
+ "-" "_" orig-name))
+ (human-readable (replace-regexp-in-string
+ (rx (not (any "0-9a-z_"))) "" human-readable)))
+ (if (null first)
+ ;; Prevent C namespace conflicts.
+ (cl-loop
+ with h = (comp-ctxt-funcs-h comp-ctxt)
+ for i from 0
+ for c-sym = (concat prefix crypted "_" human-readable "_"
+ (number-to-string i))
+ unless (gethash c-sym h)
+ return c-sym)
+ ;; When called out of a compilation context (ex disassembling)
+ ;; pick the first one.
+ (concat prefix crypted "_" human-readable "_0"))))
+
+(defun comp-decrypt-arg-list (x function-name)
+ "Decrypt argument list X for FUNCTION-NAME."
+ (unless (fixnump x)
+ (signal 'native-compiler-error-dyn-func function-name))
+ (let ((rest (not (= (logand x 128) 0)))
+ (mandatory (logand x 127))
+ (nonrest (ash x -8)))
+ (if (and (null rest)
+ (< nonrest 9)) ;; SUBR_MAX_ARGS
+ (make-comp-args :min mandatory
+ :max nonrest)
+ (make-comp-nargs :min mandatory
+ :nonrest nonrest
+ :rest rest))))
+
+(defsubst comp-byte-frame-size (byte-compiled-func)
+ "Return the frame size to be allocated for BYTE-COMPILED-FUNC."
+ (aref byte-compiled-func 3))
+
+(defun comp-add-func-to-ctxt (func)
+ "Add FUNC to the current compiler context."
+ (let ((name (comp-func-name func))
+ (c-name (comp-func-c-name func)))
+ (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt))
+ (puthash c-name func (comp-ctxt-funcs-h comp-ctxt))))
+
+(cl-defgeneric comp-spill-lap-function (input)
+ "Byte-compile INPUT and spill lap for further stages.")
+
+(cl-defmethod comp-spill-lap-function ((function-name symbol))
+ "Byte-compile FUNCTION-NAME, spilling data from the byte compiler."
+ (unless (comp-ctxt-output comp-ctxt)
+ (setf (comp-ctxt-output comp-ctxt)
+ (make-temp-file (comp-c-func-name function-name "freefn-")
+ nil ".eln")))
+ (let* ((f (symbol-function function-name))
+ (c-name (comp-c-func-name function-name "F"))
+ (func (make-comp-func-l :name function-name
+ :c-name c-name
+ :doc (documentation f t)
+ :int-spec (interactive-form f)
+ :speed (comp-spill-speed function-name)
+ :pure (comp-spill-decl-spec function-name
+ 'pure))))
+ (when (byte-code-function-p f)
+ (signal 'native-compiler-error
+ "can't native compile an already byte-compiled function"))
+ (setf (comp-func-byte-func func)
+ (byte-compile (comp-func-name func)))
+ (let ((lap (byte-to-native-lambda-lap
+ (gethash (aref (comp-func-byte-func func) 1)
+ byte-to-native-lambdas-h))))
+ (cl-assert lap)
+ (comp-log lap 2 t)
+ (let ((arg-list (aref (comp-func-byte-func func) 0)))
+ (setf (comp-func-l-args func)
+ (comp-decrypt-arg-list arg-list function-name)
+ (comp-func-lap func)
+ lap
+ (comp-func-frame-size func)
+ (comp-byte-frame-size (comp-func-byte-func func))))
+ (setf (comp-ctxt-top-level-forms comp-ctxt)
+ (list (make-byte-to-native-func-def :name function-name
+ :c-name c-name)))
+ (comp-add-func-to-ctxt func))))
+
+(cl-defmethod comp-spill-lap-function ((form list))
+ "Byte-compile FORM, spilling data from the byte compiler."
+ (unless (eq (car-safe form) 'lambda)
+ (signal 'native-compiler-error
+ "Cannot native-compile, form is not a lambda"))
+ (unless (comp-ctxt-output comp-ctxt)
+ (setf (comp-ctxt-output comp-ctxt)
+ (make-temp-file "comp-lambda-" nil ".eln")))
+ (let* ((byte-code (byte-compile form))
+ (c-name (comp-c-func-name "anonymous-lambda" "F"))
+ (func (if (comp-lex-byte-func-p byte-code)
+ (make-comp-func-l :c-name c-name
+ :doc (documentation form t)
+ :int-spec (interactive-form form)
+ :speed (comp-ctxt-speed comp-ctxt))
+ (make-comp-func-d :c-name c-name
+ :doc (documentation form t)
+ :int-spec (interactive-form form)
+ :speed (comp-ctxt-speed comp-ctxt)))))
+ (let ((lap (byte-to-native-lambda-lap
+ (gethash (aref byte-code 1)
+ byte-to-native-lambdas-h))))
+ (cl-assert lap)
+ (comp-log lap 2 t)
+ (if (comp-func-l-p func)
+ (setf (comp-func-l-args func)
+ (comp-decrypt-arg-list (aref byte-code 0) byte-code))
+ (setf (comp-func-d-lambda-list func) (cadr form)))
+ (setf (comp-func-lap func) lap
+ (comp-func-frame-size func) (comp-byte-frame-size
+ byte-code))
+ (setf (comp-func-byte-func func) byte-code
+ (comp-ctxt-top-level-forms comp-ctxt)
+ (list (make-byte-to-native-func-def :name '--anonymous-lambda
+ :c-name c-name)))
+ (comp-add-func-to-ctxt func))))
+
+(defun comp-intern-func-in-ctxt (_ obj)
+ "Given OBJ of type `byte-to-native-lambda', create a function in `comp-ctxt'."
+ (when-let ((byte-func (byte-to-native-lambda-byte-func obj)))
+ (let* ((lap (byte-to-native-lambda-lap obj))
+ (top-l-form (cl-loop
+ for form in (comp-ctxt-top-level-forms comp-ctxt)
+ when (and (byte-to-native-func-def-p form)
+ (eq (byte-to-native-func-def-byte-func form)
+ byte-func))
+ return form))
+ (name (when top-l-form
+ (byte-to-native-func-def-name top-l-form)))
+ (c-name (comp-c-func-name (or name "anonymous-lambda") "F"))
+ (func (if (comp-lex-byte-func-p byte-func)
+ (make-comp-func-l
+ :args (comp-decrypt-arg-list (aref byte-func 0)
+ name))
+ (make-comp-func-d :lambda-list (aref byte-func 0)))))
+ (setf (comp-func-name func) name
+ (comp-func-byte-func func) byte-func
+ (comp-func-doc func) (documentation byte-func t)
+ (comp-func-int-spec func) (interactive-form byte-func)
+ (comp-func-c-name func) c-name
+ (comp-func-lap func) lap
+ (comp-func-frame-size func) (comp-byte-frame-size byte-func)
+ (comp-func-speed func) (comp-spill-speed name)
+ (comp-func-pure func) (comp-spill-decl-spec name 'pure))
+
+ ;; Store the c-name to have it retrievable from
+ ;; `comp-ctxt-top-level-forms'.
+ (when top-l-form
+ (setf (byte-to-native-func-def-c-name top-l-form) c-name))
+ (unless name
+ (puthash byte-func func (comp-ctxt-byte-func-to-func-h comp-ctxt)))
+ (comp-add-func-to-ctxt func)
+ (comp-log (format "Function %s:\n" name) 1)
+ (comp-log lap 1 t))))
+
+(cl-defmethod comp-spill-lap-function ((filename string))
+ "Byte-compile FILENAME, spilling data from the byte compiler."
+ (byte-compile-file filename)
+ (when (or (null byte-native-qualities)
+ (alist-get 'no-native-compile byte-native-qualities))
+ (throw 'no-native-compile nil))
+ (unless byte-to-native-top-level-forms
+ (signal 'native-compiler-error-empty-byte filename))
+ (unless (comp-ctxt-output comp-ctxt)
+ (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename
+ filename
+ (or native-compile-target-directory
+ (when byte+native-compile
+ (car (last native-comp-eln-load-path)))))))
+ (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed
+ byte-native-qualities)
+ (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug
+ byte-native-qualities)
+ (comp-ctxt-driver-options comp-ctxt) (alist-get 'native-comp-driver-options
+ byte-native-qualities)
+ (comp-ctxt-top-level-forms comp-ctxt)
+ (cl-loop
+ for form in (reverse byte-to-native-top-level-forms)
+ collect
+ (if (and (byte-to-native-func-def-p form)
+ (eq -1
+ (comp-spill-speed (byte-to-native-func-def-name form))))
+ (let ((byte-code (byte-to-native-func-def-byte-func form)))
+ (remhash byte-code byte-to-native-lambdas-h)
+ (make-byte-to-native-top-level
+ :form `(defalias
+ ',(byte-to-native-func-def-name form)
+ ,byte-code
+ nil)
+ :lexical (comp-lex-byte-func-p byte-code)))
+ form)))
+ (maphash #'comp-intern-func-in-ctxt byte-to-native-lambdas-h))
+
+(defun comp-spill-lap (input)
+ "Byte-compile and spill the LAP representation for INPUT.
+If INPUT is a symbol, it is the function-name to be compiled.
+If INPUT is a string, it is the filename to be compiled."
+ (let ((byte-native-compiling t)
+ (byte-to-native-lambdas-h (make-hash-table :test #'eq))
+ (byte-to-native-top-level-forms ())
+ (byte-to-native-plist-environment ()))
+ (comp-spill-lap-function input)))
+
+
+;;; Limplification pass specific code.
+
+(cl-defstruct (comp-limplify (:copier nil))
+ "Support structure used during function limplification."
+ (frame nil :type (or null comp-vec)
+ :documentation "Meta-stack used to flat LAP.")
+ (curr-block nil :type comp-block
+ :documentation "Current block being limplified.")
+ (sp -1 :type number
+ :documentation "Current stack pointer while walking LAP.
+Points to the next slot to be filled.")
+ (pc 0 :type number
+ :documentation "Current program counter while walking LAP.")
+ (label-to-addr nil :type hash-table
+ :documentation "LAP hash table -> address.")
+ (pending-blocks () :type list
+ :documentation "List of blocks waiting for limplification."))
+
+(defconst comp-lap-eob-ops
+ '(byte-goto byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop
+ byte-goto-if-not-nil-else-pop byte-return byte-pushcatch
+ byte-switch byte-pushconditioncase)
+ "LAP end of basic blocks op codes.")
+
+(defun comp-lap-eob-p (inst)
+ "Return t if INST closes the current basic blocks, nil otherwise."
+ (when (memq (car inst) comp-lap-eob-ops)
+ t))
+
+(defun comp-lap-fall-through-p (inst)
+ "Return t if INST falls through, nil otherwise."
+ (when (not (memq (car inst) '(byte-goto byte-return)))
+ t))
+
+(defsubst comp-sp ()
+ "Current stack pointer."
+ (declare (gv-setter (lambda (val)
+ `(setf (comp-limplify-sp comp-pass) ,val))))
+ (comp-limplify-sp comp-pass))
+
+(defmacro comp-with-sp (sp &rest body)
+ "Execute BODY setting the stack pointer to SP.
+Restore the original value afterwards."
+ (declare (debug (form body))
+ (indent defun))
+ (let ((sym (gensym)))
+ `(let ((,sym (comp-sp)))
+ (setf (comp-sp) ,sp)
+ (progn ,@body)
+ (setf (comp-sp) ,sym))))
+
+(defsubst comp-slot-n (n)
+ "Slot N into the meta-stack."
+ (comp-vec-aref (comp-limplify-frame comp-pass) n))
+
+(defsubst comp-slot ()
+ "Current slot into the meta-stack pointed by sp."
+ (comp-slot-n (comp-sp)))
+
+(defsubst comp-slot+1 ()
+ "Slot into the meta-stack pointed by sp + 1."
+ (comp-slot-n (1+ (comp-sp))))
+
+(defsubst comp-label-to-addr (label)
+ "Find the address of LABEL."
+ (or (gethash label (comp-limplify-label-to-addr comp-pass))
+ (signal 'native-ice (list "label not found" label))))
+
+(defsubst comp-mark-curr-bb-closed ()
+ "Mark the current basic block as closed."
+ (setf (comp-block-closed (comp-limplify-curr-block comp-pass)) t))
+
+(defun comp-bb-maybe-add (lap-addr &optional sp)
+ "If necessary create a pending basic block for LAP-ADDR with stack depth SP.
+The basic block is returned regardless it was already declared or not."
+ (let ((bb (or (cl-loop ; See if the block was already limplified.
+ for bb being the hash-value in (comp-func-blocks comp-func)
+ when (and (comp-block-lap-p bb)
+ (equal (comp-block-lap-addr bb) lap-addr))
+ return bb)
+ (cl-find-if (lambda (bb) ; Look within the pendings blocks.
+ (and (comp-block-lap-p bb)
+ (= (comp-block-lap-addr bb) lap-addr)))
+ (comp-limplify-pending-blocks comp-pass)))))
+ (if bb
+ (progn
+ (unless (or (null sp) (= sp (comp-block-lap-sp bb)))
+ (signal 'native-ice (list "incoherent stack pointers"
+ sp (comp-block-lap-sp bb))))
+ bb)
+ (car (push (make--comp-block-lap lap-addr sp (comp-new-block-sym))
+ (comp-limplify-pending-blocks comp-pass))))))
+
+(defsubst comp-call (func &rest args)
+ "Emit a call for function FUNC with ARGS."
+ `(call ,func ,@args))
+
+(defun comp-callref (func nargs stack-off)
+ "Emit a call using narg abi for FUNC.
+NARGS is the number of arguments.
+STACK-OFF is the index of the first slot frame involved."
+ `(callref ,func ,@(cl-loop repeat nargs
+ for sp from stack-off
+ collect (comp-slot-n sp))))
+
+(cl-defun make-comp-mvar (&key slot (constant nil const-vld) type)
+ "`comp-mvar' initializer."
+ (let ((mvar (make--comp-mvar :slot slot)))
+ (when const-vld
+ (comp-add-const-to-relocs constant)
+ (setf (comp-cstr-imm mvar) constant))
+ (when type
+ (setf (comp-mvar-typeset mvar) (list type)))
+ mvar))
+
+(defun comp-new-frame (size vsize &optional ssa)
+ "Return a clean frame of meta variables of size SIZE and VSIZE.
+If SSA is non-nil, populate it with m-var in ssa form."
+ (cl-loop with v = (make-comp-vec :beg (- vsize) :end size)
+ for i from (- vsize) below size
+ for mvar = (if ssa
+ (make-comp-ssa-mvar :slot i)
+ (make-comp-mvar :slot i))
+ do (setf (comp-vec-aref v i) mvar)
+ finally return v))
+
+(defun comp-emit (insn)
+ "Emit INSN into basic block BB."
+ (let ((bb (comp-limplify-curr-block comp-pass)))
+ (cl-assert (not (comp-block-closed bb)))
+ (push insn (comp-block-insns bb))))
+
+(defun comp-emit-set-call (call)
+ "Emit CALL assigning the result to the current slot frame.
+If the callee function is known to have a return type, propagate it."
+ (cl-assert call)
+ (comp-emit (list 'set (comp-slot) call)))
+
+(defun comp-copy-slot (src-n &optional dst-n)
+ "Set slot number DST-N to slot number SRC-N as source.
+If DST-N is specified, use it; otherwise assume it to be the current slot."
+ (comp-with-sp (or dst-n (comp-sp))
+ (let ((src-slot (comp-slot-n src-n)))
+ (cl-assert src-slot)
+ (comp-emit `(set ,(comp-slot) ,src-slot)))))
+
+(defsubst comp-emit-annotation (str)
+ "Emit annotation STR."
+ (comp-emit `(comment ,str)))
+
+(defsubst comp-emit-setimm (val)
+ "Set constant VAL to current slot."
+ (comp-add-const-to-relocs val)
+ ;; Leave relocation index nil on purpose, will be fixed-up in final
+ ;; by `comp-finalize-relocs'.
+ (comp-emit `(setimm ,(comp-slot) ,val)))
+
+(defun comp-make-curr-block (block-name entry-sp &optional addr)
+ "Create a basic block with BLOCK-NAME and set it as current block.
+ENTRY-SP is the sp value when entering.
+Add block to the current function and return it."
+ (let ((bb (make--comp-block-lap addr entry-sp block-name)))
+ (setf (comp-limplify-curr-block comp-pass) bb
+ (comp-limplify-pc comp-pass) addr
+ (comp-limplify-sp comp-pass) (when (comp-block-lap-p bb)
+ (comp-block-lap-sp bb)))
+ (puthash (comp-block-name bb) bb (comp-func-blocks comp-func))
+ bb))
+
+(defun comp-latch-make-fill (target)
+ "Create a latch pointing to TARGET and fill it.
+Return the created latch."
+ (let ((latch (make-comp-latch :name (comp-new-block-sym "latch")))
+ (curr-bb (comp-limplify-curr-block comp-pass)))
+ ;; See `comp-make-curr-block'.
+ (setf (comp-limplify-curr-block comp-pass) latch)
+ (when (< (comp-func-speed comp-func) 3)
+ ;; At speed 3 the programmer is responsible to manually
+ ;; place `comp-maybe-gc-or-quit'.
+ (comp-emit '(call comp-maybe-gc-or-quit)))
+ ;; See `comp-emit-uncond-jump'.
+ (comp-emit `(jump ,(comp-block-name target)))
+ (comp-mark-curr-bb-closed)
+ (puthash (comp-block-name latch) latch (comp-func-blocks comp-func))
+ (setf (comp-limplify-curr-block comp-pass) curr-bb)
+ latch))
+
+(defun comp-emit-uncond-jump (lap-label)
+ "Emit an unconditional branch to LAP-LABEL."
+ (cl-destructuring-bind (label-num . stack-depth) lap-label
+ (when stack-depth
+ (cl-assert (= (1- stack-depth) (comp-sp))))
+ (let* ((target-addr (comp-label-to-addr label-num))
+ (target (comp-bb-maybe-add target-addr
+ (comp-sp)))
+ (latch (when (< target-addr (comp-limplify-pc comp-pass))
+ (comp-latch-make-fill target)))
+ (eff-target-name (comp-block-name (or latch target))))
+ (comp-emit `(jump ,eff-target-name))
+ (comp-mark-curr-bb-closed))))
+
+(defun comp-emit-cond-jump (a b target-offset lap-label negated)
+ "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ.
+TARGET-OFFSET is the positive offset on the SP when branching to the target
+block.
+If NEGATED is non null, negate the tested condition.
+Return value is the fall-through block name."
+ (cl-destructuring-bind (label-num . label-sp) lap-label
+ (let* ((bb (comp-block-name (comp-bb-maybe-add
+ (1+ (comp-limplify-pc comp-pass))
+ (comp-sp)))) ; Fall through block.
+ (target-sp (+ target-offset (comp-sp)))
+ (target-addr (comp-label-to-addr label-num))
+ (target (comp-bb-maybe-add target-addr target-sp))
+ (latch (when (< target-addr (comp-limplify-pc comp-pass))
+ (comp-latch-make-fill target)))
+ (eff-target-name (comp-block-name (or latch target))))
+ (when label-sp
+ (cl-assert (= (1- label-sp) (+ target-offset (comp-sp)))))
+ (comp-emit (if negated
+ (list 'cond-jump a b bb eff-target-name)
+ (list 'cond-jump a b eff-target-name bb)))
+ (comp-mark-curr-bb-closed)
+ bb)))
+
+(defun comp-emit-handler (lap-label handler-type)
+ "Emit a nonlocal-exit handler to LAP-LABEL of type HANDLER-TYPE."
+ (cl-destructuring-bind (label-num . label-sp) lap-label
+ (cl-assert (= (- label-sp 2) (comp-sp)))
+ (setf (comp-func-has-non-local comp-func) t)
+ (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
+ (comp-sp)))
+ (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num)
+ (1+ (comp-sp))))
+ (pop-bb (make--comp-block-lap nil (comp-sp) (comp-new-block-sym))))
+ (comp-emit (list 'push-handler
+ handler-type
+ (comp-slot+1)
+ (comp-block-name pop-bb)
+ (comp-block-name guarded-bb)))
+ (comp-mark-curr-bb-closed)
+ ;; Emit the basic block to pop the handler if we got the non local.
+ (puthash (comp-block-name pop-bb) pop-bb (comp-func-blocks comp-func))
+ (setf (comp-limplify-curr-block comp-pass) pop-bb)
+ (comp-emit `(fetch-handler ,(comp-slot+1)))
+ (comp-emit `(jump ,(comp-block-name handler-bb)))
+ (comp-mark-curr-bb-closed))))
+
+(defun comp-limplify-listn (n)
+ "Limplify list N."
+ (comp-with-sp (+ (comp-sp) n -1)
+ (comp-emit-set-call (comp-call 'cons
+ (comp-slot)
+ (make-comp-mvar :constant nil))))
+ (cl-loop for sp from (+ (comp-sp) n -2) downto (comp-sp)
+ do (comp-with-sp sp
+ (comp-emit-set-call (comp-call 'cons
+ (comp-slot)
+ (comp-slot+1))))))
+
+(defun comp-new-block-sym (&optional postfix)
+ "Return a unique symbol postfixing POSTFIX naming the next new basic block."
+ (intern (format (if postfix "bb_%s_%s" "bb_%s")
+ (funcall (comp-func-block-cnt-gen comp-func))
+ postfix)))
+
+(defun comp-fill-label-h ()
+ "Fill label-to-addr hash table for the current function."
+ (setf (comp-limplify-label-to-addr comp-pass) (make-hash-table :test 'eql))
+ (cl-loop for insn in (comp-func-lap comp-func)
+ for addr from 0
+ do (pcase insn
+ (`(TAG ,label . ,_)
+ (puthash label addr (comp-limplify-label-to-addr comp-pass))))))
+
+(defun comp-jump-table-optimizable (jmp-table)
+ "Return t if JMP-TABLE can be optimized out."
+ (cl-loop
+ with labels = (cl-loop for target-label being each hash-value of jmp-table
+ collect target-label)
+ with x = (car labels)
+ for l in (cdr-safe labels)
+ unless (= l x)
+ return nil
+ finally return t))
+
+(defun comp-emit-switch (var last-insn)
+ "Emit a Limple for a lap jump table given VAR and LAST-INSN."
+ ;; FIXME this not efficient for big jump tables. We should have a second
+ ;; strategy for this case.
+ (pcase last-insn
+ (`(setimm ,_ ,jmp-table)
+ (unless (comp-jump-table-optimizable jmp-table)
+ (cl-loop
+ for test being each hash-keys of jmp-table
+ using (hash-value target-label)
+ with len = (hash-table-count jmp-table)
+ with test-func = (hash-table-test jmp-table)
+ for n from 1
+ for last = (= n len)
+ for m-test = (make-comp-mvar :constant test)
+ for target-name = (comp-block-name (comp-bb-maybe-add
+ (comp-label-to-addr target-label)
+ (comp-sp)))
+ for ff-bb = (if last
+ (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
+ (comp-sp))
+ (make--comp-block-lap nil
+ (comp-sp)
+ (comp-new-block-sym)))
+ for ff-bb-name = (comp-block-name ff-bb)
+ if (eq test-func 'eq)
+ do (comp-emit (list 'cond-jump var m-test target-name ff-bb-name))
+ else
+ ;; Store the result of the comparison into the scratch slot before
+ ;; emitting the conditional jump.
+ do (comp-emit (list 'set (make-comp-mvar :slot 'scratch)
+ (comp-call test-func var m-test)))
+ (comp-emit (list 'cond-jump
+ (make-comp-mvar :slot 'scratch)
+ (make-comp-mvar :constant nil)
+ ff-bb-name target-name))
+ unless last
+ ;; All fall through are artificially created here except the last one.
+ do (puthash ff-bb-name ff-bb (comp-func-blocks comp-func))
+ (setf (comp-limplify-curr-block comp-pass) ff-bb))))
+ (_ (signal 'native-ice
+ "missing previous setimm while creating a switch"))))
+
+(defun comp-emit-set-call-subr (subr-name sp-delta)
+ "Emit a call for SUBR-NAME.
+SP-DELTA is the stack adjustment."
+ (let ((subr (symbol-function subr-name))
+ (nargs (1+ (- sp-delta))))
+ (let* ((arity (func-arity subr))
+ (minarg (car arity))
+ (maxarg (cdr arity)))
+ (when (eq maxarg 'unevalled)
+ (signal 'native-ice (list "subr contains unevalled args" subr-name)))
+ (if (eq maxarg 'many)
+ ;; callref case.
+ (comp-emit-set-call (comp-callref subr-name nargs (comp-sp)))
+ ;; Normal call.
+ (unless (and (>= maxarg nargs) (<= minarg nargs))
+ (signal 'native-ice
+ (list "incoherent stack adjustment" nargs maxarg minarg)))
+ (let* ((subr-name subr-name)
+ (slots (cl-loop for i from 0 below maxarg
+ collect (comp-slot-n (+ i (comp-sp))))))
+ (comp-emit-set-call (apply #'comp-call (cons subr-name slots))))))))
+
+(eval-when-compile
+ (defun comp-op-to-fun (x)
+ "Given the LAP op strip \"byte-\" to have the subr name."
+ (intern (replace-regexp-in-string "byte-" "" x)))
+
+ (defun comp-body-eff (body op-name sp-delta)
+ "Given the original BODY, compute the effective one.
+When BODY is `auto', guess function name from the LAP byte-code
+name. Otherwise expect lname fnname."
+ (pcase (car body)
+ ('auto
+ `((comp-emit-set-call-subr ',(comp-op-to-fun op-name) ,sp-delta)))
+ ((pred symbolp)
+ `((comp-emit-set-call-subr ',(car body) ,sp-delta)))
+ (_ body))))
+
+(defmacro comp-op-case (&rest cases)
+ "Expand CASES into the corresponding `pcase' expansion.
+This is responsible for generating the proper stack adjustment, when known,
+and the annotation emission."
+ (declare (debug (body))
+ (indent defun))
+ `(pcase op
+ ,@(cl-loop for (op . body) in cases
+ for sp-delta = (gethash op comp-op-stack-info)
+ for op-name = (symbol-name op)
+ if body
+ collect `(',op
+ ;; Log all LAP ops except the TAG one.
+ ;; ,(unless (eq op 'TAG)
+ ;; `(comp-emit-annotation
+ ;; ,(concat "LAP op " op-name)))
+ ;; Emit the stack adjustment if present.
+ ,(when (and sp-delta (not (eq 0 sp-delta)))
+ `(cl-incf (comp-sp) ,sp-delta))
+ ,@(comp-body-eff body op-name sp-delta))
+ else
+ collect `(',op (signal 'native-ice
+ (list "unsupported LAP op" ',op-name))))
+ (_ (signal 'native-ice (list "unexpected LAP op" (symbol-name op))))))
+
+(defun comp-limplify-lap-inst (insn)
+ "Limplify LAP instruction INSN pushing it in the proper basic block."
+ (let ((op (car insn))
+ (arg (if (consp (cdr insn))
+ (cadr insn)
+ (cdr insn))))
+ (comp-op-case
+ (TAG
+ (cl-destructuring-bind (_TAG label-num . label-sp) insn
+ ;; Paranoid?
+ (when label-sp
+ (cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass))))
+ (comp-emit-annotation (format "LAP TAG %d" label-num))))
+ (byte-stack-ref
+ (comp-copy-slot (- (comp-sp) arg 1)))
+ (byte-varref
+ (comp-emit-set-call (comp-call 'symbol-value (make-comp-mvar
+ :constant arg))))
+ (byte-varset
+ (comp-emit (comp-call 'set_internal
+ (make-comp-mvar :constant arg)
+ (comp-slot+1))))
+ (byte-varbind ;; Verify
+ (comp-emit (comp-call 'specbind
+ (make-comp-mvar :constant arg)
+ (comp-slot+1))))
+ (byte-call
+ (cl-incf (comp-sp) (- arg))
+ (comp-emit-set-call (comp-callref 'funcall (1+ arg) (comp-sp))))
+ (byte-unbind
+ (comp-emit (comp-call 'helper_unbind_n
+ (make-comp-mvar :constant arg))))
+ (byte-pophandler
+ (comp-emit '(pop-handler)))
+ (byte-pushconditioncase
+ (comp-emit-handler (cddr insn) 'condition-case))
+ (byte-pushcatch
+ (comp-emit-handler (cddr insn) 'catcher))
+ (byte-nth auto)
+ (byte-symbolp auto)
+ (byte-consp auto)
+ (byte-stringp auto)
+ (byte-listp auto)
+ (byte-eq auto)
+ (byte-memq auto)
+ (byte-not
+ (comp-emit-set-call (comp-call 'eq (comp-slot-n (comp-sp))
+ (make-comp-mvar :constant nil))))
+ (byte-car auto)
+ (byte-cdr auto)
+ (byte-cons auto)
+ (byte-list1
+ (comp-limplify-listn 1))
+ (byte-list2
+ (comp-limplify-listn 2))
+ (byte-list3
+ (comp-limplify-listn 3))
+ (byte-list4
+ (comp-limplify-listn 4))
+ (byte-length auto)
+ (byte-aref auto)
+ (byte-aset auto)
+ (byte-symbol-value auto)
+ (byte-symbol-function auto)
+ (byte-set auto)
+ (byte-fset auto)
+ (byte-get auto)
+ (byte-substring auto)
+ (byte-concat2
+ (comp-emit-set-call (comp-callref 'concat 2 (comp-sp))))
+ (byte-concat3
+ (comp-emit-set-call (comp-callref 'concat 3 (comp-sp))))
+ (byte-concat4
+ (comp-emit-set-call (comp-callref 'concat 4 (comp-sp))))
+ (byte-sub1 1-)
+ (byte-add1 1+)
+ (byte-eqlsign =)
+ (byte-gtr >)
+ (byte-lss <)
+ (byte-leq <=)
+ (byte-geq >=)
+ (byte-diff -)
+ (byte-negate
+ (comp-emit-set-call (comp-call 'negate (comp-slot))))
+ (byte-plus +)
+ (byte-max auto)
+ (byte-min auto)
+ (byte-mult *)
+ (byte-point auto)
+ (byte-goto-char auto)
+ (byte-insert auto)
+ (byte-point-max auto)
+ (byte-point-min auto)
+ (byte-char-after auto)
+ (byte-following-char auto)
+ (byte-preceding-char preceding-char)
+ (byte-current-column auto)
+ (byte-indent-to
+ (comp-emit-set-call (comp-call 'indent-to
+ (comp-slot)
+ (make-comp-mvar :constant nil))))
+ (byte-scan-buffer-OBSOLETE)
+ (byte-eolp auto)
+ (byte-eobp auto)
+ (byte-bolp auto)
+ (byte-bobp auto)
+ (byte-current-buffer auto)
+ (byte-set-buffer auto)
+ (byte-save-current-buffer
+ (comp-emit (comp-call 'record_unwind_current_buffer)))
+ (byte-set-mark-OBSOLETE)
+ (byte-interactive-p-OBSOLETE)
+ (byte-forward-char auto)
+ (byte-forward-word auto)
+ (byte-skip-chars-forward auto)
+ (byte-skip-chars-backward auto)
+ (byte-forward-line auto)
+ (byte-char-syntax auto)
+ (byte-buffer-substring auto)
+ (byte-delete-region auto)
+ (byte-narrow-to-region
+ (comp-emit-set-call (comp-call 'narrow-to-region
+ (comp-slot)
+ (comp-slot+1))))
+ (byte-widen
+ (comp-emit-set-call (comp-call 'widen)))
+ (byte-end-of-line auto)
+ (byte-constant2) ; TODO
+ ;; Branches.
+ (byte-goto
+ (comp-emit-uncond-jump (cddr insn)))
+ (byte-goto-if-nil
+ (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0
+ (cddr insn) nil))
+ (byte-goto-if-not-nil
+ (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 0
+ (cddr insn) t))
+ (byte-goto-if-nil-else-pop
+ (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1
+ (cddr insn) nil))
+ (byte-goto-if-not-nil-else-pop
+ (comp-emit-cond-jump (comp-slot+1) (make-comp-mvar :constant nil) 1
+ (cddr insn) t))
+ (byte-return
+ (comp-emit `(return ,(comp-slot+1))))
+ (byte-discard 'pass)
+ (byte-dup
+ (comp-copy-slot (1- (comp-sp))))
+ (byte-save-excursion
+ (comp-emit (comp-call 'record_unwind_protect_excursion)))
+ (byte-save-window-excursion-OBSOLETE)
+ (byte-save-restriction
+ (comp-emit (comp-call 'helper_save_restriction)))
+ (byte-catch) ;; Obsolete
+ (byte-unwind-protect
+ (comp-emit (comp-call 'helper_unwind_protect (comp-slot+1))))
+ (byte-condition-case) ;; Obsolete
+ (byte-temp-output-buffer-setup-OBSOLETE)
+ (byte-temp-output-buffer-show-OBSOLETE)
+ (byte-unbind-all) ;; Obsolete
+ (byte-set-marker auto)
+ (byte-match-beginning auto)
+ (byte-match-end auto)
+ (byte-upcase auto)
+ (byte-downcase auto)
+ (byte-string= string-equal)
+ (byte-string< string-lessp)
+ (byte-equal auto)
+ (byte-nthcdr auto)
+ (byte-elt auto)
+ (byte-member auto)
+ (byte-assq auto)
+ (byte-nreverse auto)
+ (byte-setcar auto)
+ (byte-setcdr auto)
+ (byte-car-safe auto)
+ (byte-cdr-safe auto)
+ (byte-nconc auto)
+ (byte-quo /)
+ (byte-rem %)
+ (byte-numberp auto)
+ (byte-integerp auto)
+ (byte-listN
+ (cl-incf (comp-sp) (- 1 arg))
+ (comp-emit-set-call (comp-callref 'list arg (comp-sp))))
+ (byte-concatN
+ (cl-incf (comp-sp) (- 1 arg))
+ (comp-emit-set-call (comp-callref 'concat arg (comp-sp))))
+ (byte-insertN
+ (cl-incf (comp-sp) (- 1 arg))
+ (comp-emit-set-call (comp-callref 'insert arg (comp-sp))))
+ (byte-stack-set
+ (comp-copy-slot (1+ (comp-sp)) (- (comp-sp) arg -1)))
+ (byte-stack-set2 (cl-assert nil)) ;; TODO
+ (byte-discardN
+ (cl-incf (comp-sp) (- arg)))
+ (byte-switch
+ ;; Assume to follow the emission of a setimm.
+ ;; This is checked into comp-emit-switch.
+ (comp-emit-switch (comp-slot+1)
+ (cl-first (comp-block-insns
+ (comp-limplify-curr-block comp-pass)))))
+ (byte-constant
+ (comp-emit-setimm arg))
+ (byte-discardN-preserve-tos
+ (cl-incf (comp-sp) (- arg))
+ (comp-copy-slot (+ arg (comp-sp)))))))
+
+(defun comp-emit-narg-prologue (minarg nonrest rest)
+ "Emit the prologue for a narg function."
+ (cl-loop for i below minarg
+ do (comp-emit `(set-args-to-local ,(comp-slot-n i)))
+ (comp-emit '(inc-args)))
+ (cl-loop for i from minarg below nonrest
+ for bb = (intern (format "entry_%s" i))
+ for fallback = (intern (format "entry_fallback_%s" i))
+ do (comp-emit `(cond-jump-narg-leq ,i ,fallback ,bb))
+ (comp-make-curr-block bb (comp-sp))
+ (comp-emit `(set-args-to-local ,(comp-slot-n i)))
+ (comp-emit '(inc-args))
+ finally (comp-emit '(jump entry_rest_args)))
+ (when (/= minarg nonrest)
+ (cl-loop for i from minarg below nonrest
+ for bb = (intern (format "entry_fallback_%s" i))
+ for next-bb = (if (= (1+ i) nonrest)
+ 'entry_rest_args
+ (intern (format "entry_fallback_%s" (1+ i))))
+ do (comp-with-sp i
+ (comp-make-curr-block bb (comp-sp))
+ (comp-emit-setimm nil)
+ (comp-emit `(jump ,next-bb)))))
+ (comp-make-curr-block 'entry_rest_args (comp-sp))
+ (comp-emit `(set-rest-args-to-local ,(comp-slot-n nonrest)))
+ (setf (comp-sp) nonrest)
+ (when (and (> nonrest 8) (null rest))
+ (cl-decf (comp-sp))))
+
+(defun comp-limplify-finalize-function (func)
+ "Reverse insns into all basic blocks of FUNC."
+ (cl-loop for bb being the hash-value in (comp-func-blocks func)
+ do (setf (comp-block-insns bb)
+ (nreverse (comp-block-insns bb))))
+ (comp-log-func func 2)
+ func)
+
+(cl-defgeneric comp-prepare-args-for-top-level (function)
+ "Given FUNCTION, return the two arguments for comp--register-...")
+
+(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l))
+ "Lexically-scoped FUNCTION."
+ (let ((args (comp-func-l-args function)))
+ (cons (make-comp-mvar :constant (comp-args-base-min args))
+ (make-comp-mvar :constant (if (comp-args-p args)
+ (comp-args-max args)
+ 'many)))))
+
+(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d))
+ "Dynamically scoped FUNCTION."
+ (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function)))
+ (let ((comp-curr-allocation-class 'd-default))
+ ;; Lambda-lists must stay in the same relocation class of
+ ;; the object referenced by code to respect uninterned
+ ;; symbols.
+ (make-comp-mvar :constant (comp-func-d-lambda-list function)))))
+
+(cl-defgeneric comp-emit-for-top-level (form for-late-load)
+ "Emit the Limple code for top level FORM.")
+
+(cl-defmethod comp-emit-for-top-level ((form byte-to-native-func-def)
+ for-late-load)
+ (let* ((name (byte-to-native-func-def-name form))
+ (c-name (byte-to-native-func-def-c-name form))
+ (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt)))
+ (args (comp-prepare-args-for-top-level f)))
+ (cl-assert (and name f))
+ (comp-emit
+ `(set ,(make-comp-mvar :slot 1)
+ ,(comp-call (if for-late-load
+ 'comp--late-register-subr
+ 'comp--register-subr)
+ (make-comp-mvar :constant name)
+ (make-comp-mvar :constant c-name)
+ (car args)
+ (cdr args)
+ (setf (comp-func-type f)
+ (make-comp-mvar :constant nil))
+ (make-comp-mvar
+ :constant
+ (list
+ (let* ((h (comp-ctxt-function-docs comp-ctxt))
+ (i (hash-table-count h)))
+ (puthash i (comp-func-doc f) h)
+ i)
+ (comp-func-int-spec f)))
+ ;; This is the compilation unit it-self passed as
+ ;; parameter.
+ (make-comp-mvar :slot 0))))))
+
+(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level)
+ for-late-load)
+ (unless for-late-load
+ (comp-emit
+ (comp-call 'eval
+ (let ((comp-curr-allocation-class 'd-impure))
+ (make-comp-mvar :constant
+ (byte-to-native-top-level-form form)))
+ (make-comp-mvar :constant
+ (byte-to-native-top-level-lexical form))))))
+
+(defun comp-emit-lambda-for-top-level (func)
+ "Emit the creation of subrs for lambda FUNC.
+These are stored in the reloc data array."
+ (let ((args (comp-prepare-args-for-top-level func)))
+ (let ((comp-curr-allocation-class 'd-impure))
+ (comp-add-const-to-relocs (comp-func-byte-func func)))
+ (comp-emit
+ (comp-call 'comp--register-lambda
+ ;; mvar to be fixed-up when containers are
+ ;; finalized.
+ (or (gethash (comp-func-byte-func func)
+ (comp-ctxt-lambda-fixups-h comp-ctxt))
+ (puthash (comp-func-byte-func func)
+ (make-comp-mvar :constant nil)
+ (comp-ctxt-lambda-fixups-h comp-ctxt)))
+ (make-comp-mvar :constant (comp-func-c-name func))
+ (car args)
+ (cdr args)
+ (setf (comp-func-type func)
+ (make-comp-mvar :constant nil))
+ (make-comp-mvar
+ :constant
+ (list
+ (let* ((h (comp-ctxt-function-docs comp-ctxt))
+ (i (hash-table-count h)))
+ (puthash i (comp-func-doc func) h)
+ i)
+ (comp-func-int-spec func)))
+ ;; This is the compilation unit it-self passed as
+ ;; parameter.
+ (make-comp-mvar :slot 0)))))
+
+(defun comp-limplify-top-level (for-late-load)
+ "Create a Limple function to modify the global environment at load.
+When FOR-LATE-LOAD is non-nil, the emitted function modifies only
+function definition.
+
+Synthesize a function called `top_level_run' that gets one single
+parameter (the compilation unit itself). To define native
+functions, `top_level_run' will call back `comp--register-subr'
+into the C code forwarding the compilation unit."
+ ;; Once an .eln is loaded and Emacs is dumped 'top_level_run' has no
+ ;; reasons to be executed ever again. Therefore all objects can be
+ ;; just ephemeral.
+ (let* ((comp-curr-allocation-class 'd-ephemeral)
+ (func (make-comp-func-l :name (if for-late-load
+ 'late-top-level-run
+ 'top-level-run)
+ :c-name (if for-late-load
+ "late_top_level_run"
+ "top_level_run")
+ :args (make-comp-args :min 1 :max 1)
+ ;; Frame is 2 wide: Slot 0 is the
+ ;; compilation unit being loaded
+ ;; (incoming parameter). Slot 1 is
+ ;; the last function being
+ ;; registered.
+ :frame-size 2
+ :speed (comp-ctxt-speed comp-ctxt)))
+ (comp-func func)
+ (comp-pass (make-comp-limplify
+ :curr-block (make--comp-block-lap -1 0 'top-level)
+ :frame (comp-new-frame 1 0))))
+ (comp-make-curr-block 'entry (comp-sp))
+ (comp-emit-annotation (if for-late-load
+ "Late top level"
+ "Top level"))
+ ;; Assign the compilation unit incoming as parameter to the slot frame 0.
+ (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0))
+ (maphash (lambda (_ func)
+ (comp-emit-lambda-for-top-level func))
+ (comp-ctxt-byte-func-to-func-h comp-ctxt))
+ (mapc (lambda (x) (comp-emit-for-top-level x for-late-load))
+ (comp-ctxt-top-level-forms comp-ctxt))
+ (comp-emit `(return ,(make-comp-mvar :slot 1)))
+ (comp-limplify-finalize-function func)))
+
+(defun comp-addr-to-bb-name (addr)
+ "Search for a block starting at ADDR into pending or limplified blocks."
+ ;; FIXME Actually we could have another hash for this.
+ (cl-flet ((pred (bb)
+ (equal (comp-block-lap-addr bb) addr)))
+ (if-let ((pending (cl-find-if #'pred
+ (comp-limplify-pending-blocks comp-pass))))
+ (comp-block-name pending)
+ (cl-loop for bb being the hash-value in (comp-func-blocks comp-func)
+ when (pred bb)
+ return (comp-block-name bb)))))
+
+(defun comp-limplify-block (bb)
+ "Limplify basic-block BB and add it to the current function."
+ (setf (comp-limplify-curr-block comp-pass) bb
+ (comp-limplify-sp comp-pass) (comp-block-lap-sp bb)
+ (comp-limplify-pc comp-pass) (comp-block-lap-addr bb))
+ (puthash (comp-block-name bb) bb (comp-func-blocks comp-func))
+ (cl-loop
+ for inst-cell on (nthcdr (comp-limplify-pc comp-pass)
+ (comp-func-lap comp-func))
+ for inst = (car inst-cell)
+ for next-inst = (car-safe (cdr inst-cell))
+ do (comp-limplify-lap-inst inst)
+ (cl-incf (comp-limplify-pc comp-pass))
+ when (comp-lap-fall-through-p inst)
+ do (pcase next-inst
+ (`(TAG ,_label . ,label-sp)
+ (when label-sp
+ (cl-assert (= (1- label-sp) (comp-sp))))
+ (let* ((stack-depth (if label-sp
+ (1- label-sp)
+ (comp-sp)))
+ (next-bb (comp-block-name (comp-bb-maybe-add
+ (comp-limplify-pc comp-pass)
+ stack-depth))))
+ (unless (comp-block-closed bb)
+ (comp-emit `(jump ,next-bb))))
+ (cl-return)))
+ until (comp-lap-eob-p inst)))
+
+(defun comp-limplify-function (func)
+ "Limplify a single function FUNC."
+ (let* ((frame-size (comp-func-frame-size func))
+ (comp-func func)
+ (comp-pass (make-comp-limplify
+ :frame (comp-new-frame frame-size 0))))
+ (comp-fill-label-h)
+ ;; Prologue
+ (comp-make-curr-block 'entry (comp-sp))
+ (comp-emit-annotation (concat "Lisp function: "
+ (symbol-name (comp-func-name func))))
+ ;; Dynamic functions have parameters bound by the trampoline.
+ (when (comp-func-l-p func)
+ (let ((args (comp-func-l-args func)))
+ (if (comp-args-p args)
+ (cl-loop for i below (comp-args-max args)
+ do (cl-incf (comp-sp))
+ (comp-emit `(set-par-to-local ,(comp-slot) ,i)))
+ (comp-emit-narg-prologue (comp-args-base-min args)
+ (comp-nargs-nonrest args)
+ (comp-nargs-rest args)))))
+ (comp-emit '(jump bb_0))
+ ;; Body
+ (comp-bb-maybe-add 0 (comp-sp))
+ (cl-loop for next-bb = (pop (comp-limplify-pending-blocks comp-pass))
+ while next-bb
+ do (comp-limplify-block next-bb))
+ ;; Sanity check against block duplication.
+ (cl-loop with addr-h = (make-hash-table)
+ for bb being the hash-value in (comp-func-blocks func)
+ for addr = (when (comp-block-lap-p bb)
+ (comp-block-lap-addr bb))
+ when addr
+ do (cl-assert (null (gethash addr addr-h)))
+ (puthash addr t addr-h))
+ (comp-limplify-finalize-function func)))
+
+(defun comp-limplify (_)
+ "Compute LIMPLE IR for forms in `comp-ctxt'."
+ (maphash (lambda (_ f) (comp-limplify-function f))
+ (comp-ctxt-funcs-h comp-ctxt))
+ (comp-add-func-to-ctxt (comp-limplify-top-level nil))
+ (when (comp-ctxt-with-late-load comp-ctxt)
+ (comp-add-func-to-ctxt (comp-limplify-top-level t))))
+
+
+;;; add-cstrs pass specific code.
+
+;; This pass is responsible for adding constraints, these are
+;; generated from:
+;;
+;; - Conditional branches: each branch taken or non taken can be used
+;; in the CFG to infer information on the tested variables.
+;;
+;; - Range propagation under test and branch (when the test is an
+;; arithmetic comparison).
+;;
+;; - Type constraint under test and branch (when the test is a
+;; known predicate).
+;;
+;; - Function calls: function calls to function assumed to be not
+;; redefinable can be used to add constrains on the function
+;; arguments. Ex: if we execute successfully (= x y) we know that
+;; afterwards both x and y must satisfy the (or number marker)
+;; type specifier.
+
+
+(defsubst comp-mvar-used-p (mvar)
+ "Non-nil when MVAR is used as lhs in the current function."
+ (declare (gv-setter (lambda (val)
+ `(puthash ,mvar ,val comp-pass))))
+ (gethash mvar comp-pass))
+
+(defun comp-collect-mvars (form)
+ "Add rhs m-var present in FORM into `comp-pass'."
+ (cl-loop for x in form
+ if (consp x)
+ do (comp-collect-mvars x)
+ else
+ when (comp-mvar-p x)
+ do (setf (comp-mvar-used-p x) t)))
+
+(defun comp-collect-rhs ()
+ "Collect all lhs mvars into `comp-pass'."
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (cl-loop
+ for insn in (comp-block-insns b)
+ for (op . args) = insn
+ if (comp-assign-op-p op)
+ do (comp-collect-mvars (cdr args))
+ else
+ do (comp-collect-mvars args))))
+
+(defun comp-negate-arithm-cmp-fun (function)
+ "Negate FUNCTION.
+Return nil if we don't want to emit constraints for its negation."
+ (cl-ecase function
+ (= nil)
+ (> '<=)
+ (< '>=)
+ (>= '<)
+ (<= '>)))
+
+(defun comp-reverse-arithm-fun (function)
+ "Reverse FUNCTION."
+ (cl-case function
+ (= '=)
+ (> '<)
+ (< '>)
+ (>= '<=)
+ (<= '>=)
+ (t function)))
+
+(defun comp-emit-assume (kind lhs rhs bb negated)
+ "Emit an assume of kind KIND for mvar LHS being RHS.
+When NEGATED is non-nil, the assumption is negated.
+The assume is emitted at the beginning of the block BB."
+ (let ((lhs-slot (comp-mvar-slot lhs)))
+ (cl-assert lhs-slot)
+ (pcase kind
+ ((or 'and 'and-nhc)
+ (if (comp-mvar-p rhs)
+ (let ((tmp-mvar (if negated
+ (make-comp-mvar :slot (comp-mvar-slot rhs))
+ rhs)))
+ (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (,kind ,lhs ,tmp-mvar))
+ (comp-block-insns bb))
+ (if negated
+ (push `(assume ,tmp-mvar (not ,rhs))
+ (comp-block-insns bb))))
+ ;; If is only a constraint we can negate it directly.
+ (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (,kind ,lhs ,(if negated
+ (comp-cstr-negation-make rhs)
+ rhs)))
+ (comp-block-insns bb))))
+ ((pred comp-arithm-cmp-fun-p)
+ (when-let ((kind (if negated
+ (comp-negate-arithm-cmp-fun kind)
+ kind)))
+ (push `(assume ,(make-comp-mvar :slot lhs-slot)
+ (,kind ,lhs
+ ,(if-let* ((vld (comp-cstr-imm-vld-p rhs))
+ (val (comp-cstr-imm rhs))
+ (ok (and (integerp val)
+ (not (memq kind '(= !=))))))
+ val
+ (make-comp-mvar :slot (comp-mvar-slot rhs)))))
+ (comp-block-insns bb))))
+ (_ (cl-assert nil)))
+ (setf (comp-func-ssa-status comp-func) 'dirty)))
+
+(defun comp-maybe-add-vmvar (op cmp-res insns-seq)
+ "If CMP-RES is clobbering OP emit a new constrained mvar and return it.
+Return OP otherwise."
+ (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res)))
+ (new-mvar (make-comp-mvar
+ :slot
+ (- (cl-incf (comp-func-vframe-size comp-func))))))
+ (progn
+ (push `(assume ,new-mvar ,op) (cdr insns-seq))
+ new-mvar)
+ op))
+
+(defun comp-add-new-block-between (bb-symbol bb-a bb-b)
+ "Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B."
+ (cl-loop
+ with new-bb = (make-comp-block-cstr :name bb-symbol
+ :insns `((jump ,(comp-block-name bb-b))))
+ with new-edge = (make-comp-edge :src bb-a :dst new-bb)
+ for ed in (comp-block-in-edges bb-b)
+ when (eq (comp-edge-src ed) bb-a)
+ do
+ ;; Connect `ed' to `new-bb' and disconnect it from `bb-a'.
+ (cl-assert (memq ed (comp-block-out-edges bb-a)))
+ (setf (comp-edge-src ed) new-bb
+ (comp-block-out-edges bb-a) (delq ed (comp-block-out-edges bb-a)))
+ (push ed (comp-block-out-edges new-bb))
+ ;; Connect `bb-a' `new-bb' with `new-edge'.
+ (push new-edge (comp-block-out-edges bb-a))
+ (push new-edge (comp-block-in-edges new-bb))
+ (setf (comp-func-ssa-status comp-func) 'dirty)
+ ;; Add `new-edge' to the current function and return it.
+ (cl-return (puthash bb-symbol new-bb (comp-func-blocks comp-func)))
+ finally (cl-assert nil)))
+
+;; Cheap substitute to a copy propagation pass...
+(defun comp-cond-cstrs-target-mvar (mvar exit-insn bb)
+ "Given MVAR, search in BB the original mvar MVAR got assigned from.
+Keep on searching till EXIT-INSN is encountered."
+ (cl-flet ((targetp (x)
+ ;; Ret t if x is an mvar and target the correct slot number.
+ (and (comp-mvar-p x)
+ (eql (comp-mvar-slot mvar) (comp-mvar-slot x)))))
+ (cl-loop
+ with res = nil
+ for insn in (comp-block-insns bb)
+ when (eq insn exit-insn)
+ do (cl-return (and (comp-mvar-p res) res))
+ do (pcase insn
+ (`(,(pred comp-assign-op-p) ,(pred targetp) ,rhs)
+ (setf res rhs)))
+ finally (cl-assert nil))))
+
+(defun comp-add-cond-cstrs-target-block (curr-bb target-bb-sym)
+ "Return the appropriate basic block to add constraint assumptions into.
+CURR-BB is the current basic block.
+TARGET-BB-SYM is the symbol name of the target block."
+ (let* ((target-bb (gethash target-bb-sym
+ (comp-func-blocks comp-func)))
+ (target-bb-in-edges (comp-block-in-edges target-bb)))
+ (cl-assert target-bb-in-edges)
+ (if (length= target-bb-in-edges 1)
+ ;; If block has only one predecessor is already suitable for
+ ;; adding constraint assumptions.
+ target-bb
+ (cl-loop
+ ;; Search for the first suitable basic block name.
+ for i from 0
+ for new-name = (intern (format "%s_cstrs_%d" (symbol-name target-bb-sym)
+ i))
+ until (null (gethash new-name (comp-func-blocks comp-func)))
+ finally
+ ;; Add it.
+ (cl-return (comp-add-new-block-between new-name curr-bb target-bb))))))
+
+(defun comp-add-cond-cstrs-simple ()
+ "`comp-add-cstrs' worker function for each selected function."
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do
+ (cl-loop
+ named in-the-basic-block
+ for insn-seq on (comp-block-insns b)
+ do
+ (pcase insn-seq
+ (`((set ,(and (pred comp-mvar-p) tmp-mvar) ,(pred comp-mvar-p))
+ ;; (comment ,_comment-str)
+ (cond-jump ,tmp-mvar ,obj2 . ,blocks))
+ (cl-loop
+ for branch-target-cell on blocks
+ for branch-target = (car branch-target-cell)
+ for negated in '(nil t)
+ when (comp-mvar-used-p tmp-mvar)
+ do
+ (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (setf (car branch-target-cell) (comp-block-name block-target))
+ (comp-emit-assume 'and tmp-mvar obj2 block-target negated))
+ finally (cl-return-from in-the-basic-block)))
+ (`((cond-jump ,obj1 ,obj2 . ,blocks))
+ (cl-loop
+ for branch-target-cell on blocks
+ for branch-target = (car branch-target-cell)
+ for negated in '(nil t)
+ when (comp-mvar-used-p obj1)
+ do
+ (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (setf (car branch-target-cell) (comp-block-name block-target))
+ (comp-emit-assume 'and obj1 obj2 block-target negated))
+ finally (cl-return-from in-the-basic-block)))))))
+
+(defun comp-add-cond-cstrs ()
+ "`comp-add-cstrs' worker function for each selected function."
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do
+ (cl-loop
+ named in-the-basic-block
+ with prev-insns-seq
+ for insns-seq on (comp-block-insns b)
+ do
+ (pcase insns-seq
+ (`((set ,(and (pred comp-mvar-p) cmp-res)
+ (,(pred comp-call-op-p)
+ ,(and (or (pred comp-equality-fun-p)
+ (pred comp-arithm-cmp-fun-p))
+ fun)
+ ,op1 ,op2))
+ ;; (comment ,_comment-str)
+ (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
+ (cl-loop
+ with target-mvar1 = (comp-cond-cstrs-target-mvar op1 (car insns-seq) b)
+ with target-mvar2 = (comp-cond-cstrs-target-mvar op2 (car insns-seq) b)
+ for branch-target-cell on blocks
+ for branch-target = (car branch-target-cell)
+ for negated in '(t nil)
+ for kind = (cl-case fun
+ (equal 'and-nhc)
+ (eql 'and-nhc)
+ (eq 'and)
+ (t fun))
+ when (or (comp-mvar-used-p target-mvar1)
+ (comp-mvar-used-p target-mvar2))
+ do
+ (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (setf (car branch-target-cell) (comp-block-name block-target))
+ (when (comp-mvar-used-p target-mvar1)
+ (comp-emit-assume kind target-mvar1
+ (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq)
+ block-target negated))
+ (when (comp-mvar-used-p target-mvar2)
+ (comp-emit-assume (comp-reverse-arithm-fun kind)
+ target-mvar2
+ (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq)
+ block-target negated)))
+ finally (cl-return-from in-the-basic-block)))
+ (`((set ,(and (pred comp-mvar-p) cmp-res)
+ (,(pred comp-call-op-p)
+ ,(and (pred comp-known-predicate-p) fun)
+ ,op))
+ ;; (comment ,_comment-str)
+ (cond-jump ,cmp-res ,(pred comp-mvar-p) . ,blocks))
+ (cl-loop
+ with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
+ with cstr = (comp-pred-to-cstr fun)
+ for branch-target-cell on blocks
+ for branch-target = (car branch-target-cell)
+ for negated in '(t nil)
+ when (comp-mvar-used-p target-mvar)
+ do
+ (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (setf (car branch-target-cell) (comp-block-name block-target))
+ (comp-emit-assume 'and target-mvar cstr block-target negated))
+ finally (cl-return-from in-the-basic-block)))
+ ;; Match predicate on the negated branch (unless).
+ (`((set ,(and (pred comp-mvar-p) cmp-res)
+ (,(pred comp-call-op-p)
+ ,(and (pred comp-known-predicate-p) fun)
+ ,op))
+ (set ,neg-cmp-res (call eq ,cmp-res ,(pred comp-cstr-null-p)))
+ (cond-jump ,neg-cmp-res ,(pred comp-mvar-p) . ,blocks))
+ (cl-loop
+ with target-mvar = (comp-cond-cstrs-target-mvar op (car insns-seq) b)
+ with cstr = (comp-pred-to-cstr fun)
+ for branch-target-cell on blocks
+ for branch-target = (car branch-target-cell)
+ for negated in '(nil t)
+ when (comp-mvar-used-p target-mvar)
+ do
+ (let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
+ (setf (car branch-target-cell) (comp-block-name block-target))
+ (comp-emit-assume 'and target-mvar cstr block-target negated))
+ finally (cl-return-from in-the-basic-block))))
+ (setf prev-insns-seq insns-seq))))
+
+(defsubst comp-insert-insn (insn insn-cell)
+ "Insert INSN as second insn of INSN-CELL."
+ (let ((next-cell (cdr insn-cell))
+ (new-cell `(,insn)))
+ (setf (cdr insn-cell) new-cell
+ (cdr new-cell) next-cell
+ (comp-func-ssa-status comp-func) 'dirty)))
+
+(defun comp-emit-call-cstr (mvar call-cell cstr)
+ "Emit a constraint CSTR for MVAR after CALL-CELL."
+ (let* ((new-mvar (make-comp-mvar :slot (comp-mvar-slot mvar)))
+ ;; Have new-mvar as LHS *and* RHS to ensure monotonicity and
+ ;; fwprop convergence!!
+ (insn `(assume ,new-mvar (and ,new-mvar ,mvar ,cstr))))
+ (comp-insert-insn insn call-cell)))
+
+(defun comp-lambda-list-gen (lambda-list)
+ "Return a generator to iterate over LAMBDA-LIST."
+ (lambda ()
+ (cl-case (car lambda-list)
+ (&optional
+ (setf lambda-list (cdr lambda-list))
+ (prog1
+ (car lambda-list)
+ (setf lambda-list (cdr lambda-list))))
+ (&rest
+ (cadr lambda-list))
+ (t
+ (prog1
+ (car lambda-list)
+ (setf lambda-list (cdr lambda-list)))))))
+
+(defun comp-add-call-cstr ()
+ "Add args assumptions for each function of which the type specifier is known."
+ (cl-loop
+ for bb being each hash-value of (comp-func-blocks comp-func)
+ do
+ (comp-loop-insn-in-block bb
+ (when-let ((match
+ (pcase insn
+ (`(set ,lhs (,(pred comp-call-op-p) ,f . ,args))
+ (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
+ (cl-values f cstr-f lhs args)))
+ (`(,(pred comp-call-op-p) ,f . ,args)
+ (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
+ (cl-values f cstr-f nil args))))))
+ (cl-multiple-value-bind (f cstr-f lhs args) match
+ (cl-loop
+ with gen = (comp-lambda-list-gen (comp-cstr-f-args cstr-f))
+ for arg in args
+ for cstr = (funcall gen)
+ for target = (comp-cond-cstrs-target-mvar arg insn bb)
+ unless (comp-cstr-p cstr)
+ do (signal 'native-ice
+ (list "Incoherent type specifier for function" f))
+ when (and target
+ ;; No need to add call constraints if this is t
+ ;; (bug#45812 bug#45705 bug#45751).
+ (not (equal comp-cstr-t cstr))
+ (or (null lhs)
+ (not (eql (comp-mvar-slot lhs)
+ (comp-mvar-slot target)))))
+ do (comp-emit-call-cstr target insn-cell cstr)))))))
+
+(defun comp-add-cstrs (_)
+ "Rewrite conditional branches adding appropriate 'assume' insns.
+This is introducing and placing 'assume' insns in use by fwprop
+to propagate conditional branch test information on target basic
+blocks."
+ (maphash (lambda (_ f)
+ (when (and (>= (comp-func-speed f) 1)
+ ;; No point to run this on dynamic scope as
+ ;; this pass is effective only on local
+ ;; variables.
+ (comp-func-l-p f)
+ (not (comp-func-has-non-local f)))
+ (let ((comp-func f)
+ (comp-pass (make-hash-table :test #'eq)))
+ (comp-collect-rhs)
+ (comp-add-cond-cstrs-simple)
+ (comp-add-cond-cstrs)
+ (comp-add-call-cstr)
+ (comp-log-func comp-func 3))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; pure-func pass specific code.
+
+;; Simple IPA pass to infer function purity of functions not
+;; explicitly declared as such. This is effective only at speed 3 to
+;; avoid optimizing-out functions and preventing their redefinition
+;; being effective.
+
+(defun comp-collect-calls (f)
+ "Return a list with all the functions called by F."
+ (cl-loop
+ with h = (make-hash-table :test #'eq)
+ for b being each hash-value of (comp-func-blocks f)
+ do (cl-loop
+ for insn in (comp-block-insns b)
+ do (pcase insn
+ (`(set ,_lval (,(pred comp-call-op-p) ,f . ,_rest))
+ (puthash f t h))
+ (`(,(pred comp-call-op-p) ,f . ,_rest)
+ (puthash f t h))))
+ finally return (cl-loop
+ for f being each hash-key of h
+ collect (if (stringp f)
+ (comp-func-name
+ (gethash f
+ (comp-ctxt-funcs-h comp-ctxt)))
+ f))))
+
+(defun comp-pure-infer-func (f)
+ "If all functions called by F are pure then F is pure too."
+ (when (and (cl-every (lambda (x)
+ (or (comp-function-pure-p x)
+ (eq x (comp-func-name f))))
+ (comp-collect-calls f))
+ (not (eq (comp-func-pure f) t)))
+ (comp-log (format "%s inferred to be pure" (comp-func-name f)))
+ (setf (comp-func-pure f) t)))
+
+(defun comp-ipa-pure (_)
+ "Infer function purity."
+ (cl-loop
+ with pure-n = 0
+ for n from 1
+ while
+ (/= pure-n
+ (setf pure-n
+ (cl-loop
+ for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
+ when (and (>= (comp-func-speed f) 3)
+ (comp-func-l-p f)
+ (not (comp-func-pure f)))
+ do (comp-pure-infer-func f)
+ count (comp-func-pure f))))
+ finally (comp-log (format "ipa-pure iterated %d times" n))))
+
+
+;;; SSA pass specific code.
+;; After limplification no edges are present between basic blocks and an
+;; implicit phi is present for every slot at the beginning of every basic block.
+;; This pass is responsible for building all the edges and replace all m-vars
+;; plus placing the needed phis.
+;; Because the number of phis placed is (supposed) to be the minimum necessary
+;; this form is called 'minimal SSA form'.
+;; This pass should be run every time basic blocks or m-var are shuffled.
+
+(cl-defun make-comp-ssa-mvar (&rest rest &key _slot _constant _type)
+ "Same as `make-comp-mvar' but set the `id' slot."
+ (let ((mvar (apply #'make-comp-mvar rest)))
+ (setf (comp-mvar-id mvar) (sxhash-eq mvar))
+ mvar))
+
+(defun comp-clean-ssa (f)
+ "Clean-up SSA for function F."
+ (setf (comp-func-edges-h f) (make-hash-table))
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks f)
+ do (setf (comp-block-in-edges b) ()
+ (comp-block-out-edges b) ()
+ (comp-block-idom b) nil
+ (comp-block-df b) (make-hash-table)
+ (comp-block-post-num b) nil
+ (comp-block-final-frame b) nil
+ ;; Prune all phis.
+ (comp-block-insns b) (cl-loop for insn in (comp-block-insns b)
+ unless (eq 'phi (car insn))
+ collect insn))))
+
+(defun comp-compute-edges ()
+ "Compute the basic block edges for the current function."
+ (cl-loop with blocks = (comp-func-blocks comp-func)
+ for bb being each hash-value of blocks
+ for last-insn = (car (last (comp-block-insns bb)))
+ for (op first second third forth) = last-insn
+ do (cl-case op
+ (jump
+ (make-comp-edge :src bb :dst (gethash first blocks)))
+ (cond-jump
+ (make-comp-edge :src bb :dst (gethash third blocks))
+ (make-comp-edge :src bb :dst (gethash forth blocks)))
+ (cond-jump-narg-leq
+ (make-comp-edge :src bb :dst (gethash second blocks))
+ (make-comp-edge :src bb :dst (gethash third blocks)))
+ (push-handler
+ (make-comp-edge :src bb :dst (gethash third blocks))
+ (make-comp-edge :src bb :dst (gethash forth blocks)))
+ (return)
+ (unreachable)
+ (otherwise
+ (signal 'native-ice
+ (list "block does not end with a branch"
+ bb
+ (comp-func-name comp-func)))))
+ ;; Update edge refs into blocks.
+ finally
+ (cl-loop
+ for edge being the hash-value in (comp-func-edges-h comp-func)
+ do
+ (push edge
+ (comp-block-out-edges (comp-edge-src edge)))
+ (push edge
+ (comp-block-in-edges (comp-edge-dst edge))))
+ (comp-log-edges comp-func)))
+
+(defun comp-collect-rev-post-order (basic-block)
+ "Walk BASIC-BLOCK children and return their name in reversed post-order."
+ (let ((visited (make-hash-table))
+ (acc ()))
+ (cl-labels ((collect-rec (bb)
+ (let ((name (comp-block-name bb)))
+ (unless (gethash name visited)
+ (puthash name t visited)
+ (cl-loop for e in (comp-block-out-edges bb)
+ for dst-block = (comp-edge-dst e)
+ do (collect-rec dst-block))
+ (push name acc)))))
+ (collect-rec basic-block)
+ acc)))
+
+(defun comp-compute-dominator-tree ()
+ "Compute immediate dominators for each basic block in current function."
+ ;; Originally based on: "A Simple, Fast Dominance Algorithm"
+ ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
+ (cl-flet ((intersect (b1 b2)
+ (let ((finger1 (comp-block-post-num b1))
+ (finger2 (comp-block-post-num b2)))
+ (while (not (= finger1 finger2))
+ (while (< finger1 finger2)
+ (setf b1 (comp-block-idom b1)
+ finger1 (comp-block-post-num b1)))
+ (while (< finger2 finger1)
+ (setf b2 (comp-block-idom b2)
+ finger2 (comp-block-post-num b2))))
+ b1))
+ (first-processed (l)
+ (if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l)))
+ p
+ (signal 'native-ice "cant't find first preprocessed"))))
+
+ (when-let ((blocks (comp-func-blocks comp-func))
+ (entry (gethash 'entry blocks))
+ ;; No point to go on if the only bb is 'entry'.
+ (bb0 (gethash 'bb_0 blocks)))
+ (cl-loop
+ with rev-bb-list = (comp-collect-rev-post-order entry)
+ with changed = t
+ while changed
+ initially (progn
+ (comp-log "Computing dominator tree...\n" 2)
+ (setf (comp-block-idom entry) entry)
+ ;; Set the post order number.
+ (cl-loop for name in (reverse rev-bb-list)
+ for b = (gethash name blocks)
+ for i from 0
+ do (setf (comp-block-post-num b) i)))
+ do (cl-loop
+ for name in (cdr rev-bb-list)
+ for b = (gethash name blocks)
+ for preds = (comp-block-preds b)
+ for new-idom = (first-processed preds)
+ initially (setf changed nil)
+ do (cl-loop for p in (delq new-idom preds)
+ when (comp-block-idom p)
+ do (setf new-idom (intersect p new-idom)))
+ unless (eq (comp-block-idom b) new-idom)
+ do (setf (comp-block-idom b) (unless (and (comp-block-lap-p new-idom)
+ (comp-block-lap-no-ret
+ new-idom))
+ new-idom)
+ changed t))))))
+
+(defun comp-compute-dominator-frontiers ()
+ "Compute the dominator frontier for each basic block in `comp-func'."
+ ;; Originally based on: "A Simple, Fast Dominance Algorithm"
+ ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
+ (cl-loop with blocks = (comp-func-blocks comp-func)
+ for b-name being each hash-keys of blocks
+ using (hash-value b)
+ for preds = (comp-block-preds b)
+ when (length> preds 1) ; All joins
+ do (cl-loop for p in preds
+ for runner = p
+ do (while (not (eq runner (comp-block-idom b)))
+ (puthash b-name b (comp-block-df runner))
+ (setf runner (comp-block-idom runner))))))
+
+(defun comp-log-block-info ()
+ "Log basic blocks info for the current function."
+ (maphash (lambda (name bb)
+ (let ((dom (comp-block-idom bb))
+ (df (comp-block-df bb)))
+ (comp-log (format "block: %s idom: %s DF %s\n"
+ name
+ (when dom (comp-block-name dom))
+ (cl-loop for b being each hash-keys of df
+ collect b))
+ 3)))
+ (comp-func-blocks comp-func)))
+
+(defun comp-place-phis ()
+ "Place phi insns into the current function."
+ ;; Originally based on: Static Single Assignment Book
+ ;; Algorithm 3.1: Standard algorithm for inserting phi-functions
+ (cl-flet ((add-phi (slot-n bb)
+ ;; Add a phi func for slot SLOT-N at the top of BB.
+ (push `(phi ,slot-n) (comp-block-insns bb)))
+ (slot-assigned-p (slot-n bb)
+ ;; Return t if a SLOT-N was assigned within BB.
+ (cl-loop for insn in (comp-block-insns bb)
+ for op = (car insn)
+ when (or (and (comp-assign-op-p op)
+ (eql slot-n (comp-mvar-slot (cadr insn))))
+ ;; fetch-handler is after a non local
+ ;; therefore clobbers all frame!!!
+ (eq op 'fetch-handler))
+ return t)))
+
+ (cl-loop for i from (- (comp-func-vframe-size comp-func))
+ below (comp-func-frame-size comp-func)
+ ;; List of blocks with a definition of mvar i
+ for defs-v = (cl-loop with blocks = (comp-func-blocks comp-func)
+ for b being each hash-value of blocks
+ when (slot-assigned-p i b)
+ collect b)
+ ;; Set of basic blocks where phi is added.
+ for f = ()
+ ;; Worklist, set of basic blocks that contain definitions of v.
+ for w = defs-v
+ do
+ (while w
+ (let ((x (pop w)))
+ (cl-loop for y being each hash-value of (comp-block-df x)
+ unless (cl-find y f)
+ do (add-phi i y)
+ (push y f)
+ ;; Adding a phi implies mentioning the
+ ;; corresponding slot so in case adjust w.
+ (unless (cl-find y defs-v)
+ (push y w))))))))
+
+(defun comp-dom-tree-walker (bb pre-lambda post-lambda)
+ "Dominator tree walker function starting from basic block BB.
+PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
+ (when pre-lambda
+ (funcall pre-lambda bb))
+ (when-let ((out-edges (comp-block-out-edges bb)))
+ (cl-loop for ed in out-edges
+ for child = (comp-edge-dst ed)
+ when (eq bb (comp-block-idom child))
+ ;; Current block is the immediate dominator then recur.
+ do (comp-dom-tree-walker child pre-lambda post-lambda)))
+ (when post-lambda
+ (funcall post-lambda bb)))
+
+(cl-defstruct (comp-ssa (:copier nil))
+ "Support structure used while SSA renaming."
+ (frame (comp-new-frame (comp-func-frame-size comp-func)
+ (comp-func-vframe-size comp-func) t)
+ :type comp-vec
+ :documentation "`comp-vec' of m-vars."))
+
+(defun comp-ssa-rename-insn (insn frame)
+ (cl-loop
+ for slot-n from (- (comp-func-vframe-size comp-func))
+ below (comp-func-frame-size comp-func)
+ do
+ (cl-flet ((targetp (x)
+ ;; Ret t if x is an mvar and target the correct slot number.
+ (and (comp-mvar-p x)
+ (eql slot-n (comp-mvar-slot x))))
+ (new-lvalue ()
+ ;; If is an assignment make a new mvar and put it as l-value.
+ (let ((mvar (make-comp-ssa-mvar :slot slot-n)))
+ (setf (comp-vec-aref frame slot-n) mvar
+ (cadr insn) mvar))))
+ (pcase insn
+ (`(,(pred comp-assign-op-p) ,(pred targetp) . ,_)
+ (let ((mvar (comp-vec-aref frame slot-n)))
+ (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
+ (new-lvalue))
+ (`(fetch-handler . ,_)
+ ;; Clobber all no matter what!
+ (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n)))
+ (`(phi ,n)
+ (when (equal n slot-n)
+ (new-lvalue)))
+ (_
+ (let ((mvar (comp-vec-aref frame slot-n)))
+ (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn)))))))))
+
+(defun comp-ssa-rename ()
+ "Entry point to rename into SSA within the current function."
+ (comp-log "Renaming\n" 2)
+ (let ((visited (make-hash-table)))
+ (cl-labels ((ssa-rename-rec (bb in-frame)
+ (unless (gethash bb visited)
+ (puthash bb t visited)
+ (cl-loop for insn in (comp-block-insns bb)
+ do (comp-ssa-rename-insn insn in-frame))
+ (setf (comp-block-final-frame bb)
+ (copy-sequence in-frame))
+ (when-let ((out-edges (comp-block-out-edges bb)))
+ (cl-loop
+ for ed in out-edges
+ for child = (comp-edge-dst ed)
+ ;; Provide a copy of the same frame to all children.
+ do (ssa-rename-rec child (comp-vec-copy in-frame)))))))
+
+ (ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func))
+ (comp-new-frame (comp-func-frame-size comp-func)
+ (comp-func-vframe-size comp-func)
+ t)))))
+
+(defun comp-finalize-phis ()
+ "Fixup r-values into phis in all basic blocks."
+ (cl-flet ((finalize-phi (args b)
+ ;; Concatenate into args all incoming m-vars for this phi.
+ (setcdr args
+ (cl-loop with slot-n = (comp-mvar-slot (car args))
+ for e in (comp-block-in-edges b)
+ for b = (comp-edge-src e)
+ for in-frame = (comp-block-final-frame b)
+ collect (list (comp-vec-aref in-frame slot-n)
+ (comp-block-name b))))))
+
+ (cl-loop for b being each hash-value of (comp-func-blocks comp-func)
+ do (cl-loop for (op . args) in (comp-block-insns b)
+ when (eq op 'phi)
+ do (finalize-phi args b)))))
+
+(defun comp-remove-unreachable-blocks ()
+ "Remove unreachable basic blocks.
+Return t when one or more block was removed, nil otherwise."
+ (cl-loop
+ with ret
+ for bb being each hash-value of (comp-func-blocks comp-func)
+ for bb-name = (comp-block-name bb)
+ when (and (not (eq 'entry bb-name))
+ (null (comp-block-idom bb)))
+ do
+ (comp-log (format "Removing block: %s" bb-name) 1)
+ (remhash bb-name (comp-func-blocks comp-func))
+ (setf (comp-func-ssa-status comp-func) t
+ ret t)
+ finally return ret))
+
+(defun comp-ssa ()
+ "Port all functions into minimal SSA form."
+ (maphash (lambda (_ f)
+ (let* ((comp-func f)
+ (ssa-status (comp-func-ssa-status f)))
+ (unless (eq ssa-status t)
+ (cl-loop
+ when (eq ssa-status 'dirty)
+ do (comp-clean-ssa f)
+ do (comp-compute-edges)
+ (comp-compute-dominator-tree)
+ until (null (comp-remove-unreachable-blocks)))
+ (comp-compute-dominator-frontiers)
+ (comp-log-block-info)
+ (comp-place-phis)
+ (comp-ssa-rename)
+ (comp-finalize-phis)
+ (comp-log-func comp-func 3)
+ (setf (comp-func-ssa-status f) t))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; propagate pass specific code.
+;; A very basic propagation pass follows.
+;; This propagates values and types plus ref property in the control flow graph.
+;; This is also responsible for removing function calls to pure functions if
+;; possible.
+
+(defconst comp-fwprop-max-insns-scan 4500
+ ;; Chosen as ~ the greatest required value for full convergence
+ ;; native compiling all Emacs code-base.
+ "Max number of scanned insn before giving-up.")
+
+(defun comp-copy-insn (insn)
+ "Deep copy INSN."
+ ;; Adapted from `copy-tree'.
+ (if (consp insn)
+ (let (result)
+ (while (consp insn)
+ (let ((newcar (car insn)))
+ (if (or (consp (car insn)) (comp-mvar-p (car insn)))
+ (setf newcar (comp-copy-insn (car insn))))
+ (push newcar result))
+ (setf insn (cdr insn)))
+ (nconc (nreverse result)
+ (if (comp-mvar-p insn) (comp-copy-insn insn) insn)))
+ (if (comp-mvar-p insn)
+ (copy-comp-mvar insn)
+ insn)))
+
+(defmacro comp-apply-in-env (func &rest args)
+ "Apply FUNC to ARGS in the current compilation environment."
+ `(let ((env (cl-loop
+ for f being the hash-value in (comp-ctxt-funcs-h comp-ctxt)
+ for func-name = (comp-func-name f)
+ for byte-code = (comp-func-byte-func f)
+ when func-name
+ collect `(,func-name . ,(symbol-function func-name))
+ and do
+ (setf (symbol-function func-name) byte-code))))
+ (unwind-protect
+ (apply ,func ,@args)
+ (cl-loop
+ for (func-name . def) in env
+ do (setf (symbol-function func-name) def)))))
+
+(defun comp-fwprop-prologue ()
+ "Prologue for the propagate pass.
+Here goes everything that can be done not iteratively (read once).
+Forward propagate immediate involed in assignments." ; FIXME: Typo. Involved or invoked?
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (cl-loop
+ for insn in (comp-block-insns b)
+ do (pcase insn
+ (`(setimm ,lval ,v)
+ (setf (comp-cstr-imm lval) v))))))
+
+(defun comp-mvar-propagate (lval rval)
+ "Propagate into LVAL properties of RVAL."
+ (setf (comp-mvar-typeset lval) (comp-mvar-typeset rval)
+ (comp-mvar-valset lval) (comp-mvar-valset rval)
+ (comp-mvar-range lval) (comp-mvar-range rval)
+ (comp-mvar-neg lval) (comp-mvar-neg rval)))
+
+(defun comp-function-foldable-p (f args)
+ "Given function F called with ARGS, return non-nil when optimizable."
+ (and (comp-function-pure-p f)
+ (cl-every #'comp-cstr-imm-vld-p args)))
+
+(defun comp-function-call-maybe-fold (insn f args)
+ "Given INSN, when F is pure if all ARGS are known, remove the function call.
+Return non-nil if the function is folded successfully."
+ (cl-flet ((rewrite-insn-as-setimm (insn value)
+ ;; See `comp-emit-setimm'.
+ (comp-add-const-to-relocs value)
+ (setf (car insn) 'setimm
+ (cddr insn) `(,value))))
+ (cond
+ ((eq f 'symbol-value)
+ (when-let* ((arg0 (car args))
+ (const (comp-cstr-imm-vld-p arg0))
+ (ok-to-optim (member (comp-cstr-imm arg0)
+ comp-symbol-values-optimizable)))
+ (rewrite-insn-as-setimm insn (symbol-value (comp-cstr-imm
+ (car args))))))
+ ((comp-function-foldable-p f args)
+ (ignore-errors
+ ;; No point to complain here in case of error because we
+ ;; should do basic block pruning in order to be sure that this
+ ;; is not dead-code. This is now left to gcc, to be
+ ;; implemented only if we want a reliable diagnostic here.
+ (let* ((f (if-let (f-in-ctxt (comp-symbol-func-to-fun f))
+ ;; If the function is IN the compilation ctxt
+ ;; and know to be pure.
+ (comp-func-byte-func f-in-ctxt)
+ f))
+ (value (comp-apply-in-env f (mapcar #'comp-cstr-imm args))))
+ (rewrite-insn-as-setimm insn value)))))))
+
+(defun comp-fwprop-call (insn lval f args)
+ "Propagate on a call INSN into LVAL.
+F is the function being called with arguments ARGS.
+Fold the call in case."
+ (unless (comp-function-call-maybe-fold insn f args)
+ (when (and (eq 'funcall f)
+ (comp-cstr-imm-vld-p (car args)))
+ (setf f (comp-cstr-imm (car args))
+ args (cdr args)))
+ (when-let ((cstr-f (gethash f comp-known-func-cstr-h)))
+ (let ((cstr (comp-cstr-f-ret cstr-f)))
+ (when (comp-cstr-empty-p cstr)
+ ;; Store it to be rewritten as non local exit.
+ (setf (comp-block-lap-non-ret-insn comp-block) insn))
+ (setf (comp-mvar-range lval) (comp-cstr-range cstr)
+ (comp-mvar-valset lval) (comp-cstr-valset cstr)
+ (comp-mvar-typeset lval) (comp-cstr-typeset cstr)
+ (comp-mvar-neg lval) (comp-cstr-neg cstr))))
+ (cl-case f
+ (+ (comp-cstr-add lval args))
+ (- (comp-cstr-sub lval args))
+ (1+ (comp-cstr-add lval `(,(car args) ,comp-cstr-one)))
+ (1- (comp-cstr-sub lval `(,(car args) ,comp-cstr-one))))))
+
+(defun comp-fwprop-insn (insn)
+ "Propagate within INSN."
+ (pcase insn
+ (`(set ,lval ,rval)
+ (pcase rval
+ (`(,(or 'call 'callref) ,f . ,args)
+ (comp-fwprop-call insn lval f args))
+ (`(,(or 'direct-call 'direct-callref) ,f . ,args)
+ (let ((f (comp-func-name (gethash f (comp-ctxt-funcs-h comp-ctxt)))))
+ (comp-fwprop-call insn lval f args)))
+ (_
+ (comp-mvar-propagate lval rval))))
+ (`(assume ,lval ,(and (pred comp-mvar-p) rval))
+ (comp-mvar-propagate lval rval))
+ (`(assume ,lval (,kind . ,operands))
+ (cl-case kind
+ (and
+ (apply #'comp-cstr-intersection lval operands))
+ (and-nhc
+ (apply #'comp-cstr-intersection-no-hashcons lval operands))
+ (not
+ ;; Prevent double negation!
+ (unless (comp-cstr-neg (car operands))
+ (comp-cstr-value-negation lval (car operands))))
+ (>
+ (comp-cstr-> lval (car operands) (cadr operands)))
+ (>=
+ (comp-cstr->= lval (car operands) (cadr operands)))
+ (<
+ (comp-cstr-< lval (car operands) (cadr operands)))
+ (<=
+ (comp-cstr-<= lval (car operands) (cadr operands)))
+ (=
+ (comp-cstr-= lval (car operands) (cadr operands)))))
+ (`(setimm ,lval ,v)
+ (setf (comp-cstr-imm lval) v))
+ (`(phi ,lval . ,rest)
+ (let* ((from-latch (cl-some
+ (lambda (x)
+ (let* ((bb-name (cadr x))
+ (bb (gethash bb-name
+ (comp-func-blocks comp-func))))
+ (or (comp-latch-p bb)
+ (when (comp-block-cstr-p bb)
+ (comp-latch-p (car (comp-block-preds bb)))))))
+ rest))
+ (prop-fn (if from-latch
+ #'comp-cstr-union-no-range
+ #'comp-cstr-union))
+ (rvals (mapcar #'car rest)))
+ (apply prop-fn lval rvals)))))
+
+(defun comp-fwprop* ()
+ "Propagate for set* and phi operands.
+Return t if something was changed."
+ (cl-loop named outer
+ with modified = nil
+ with i = 0
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (cl-loop
+ with comp-block = b
+ for insn in (comp-block-insns b)
+ for orig-insn = (unless modified
+ ;; Save consing after 1st change.
+ (comp-copy-insn insn))
+ do
+ (comp-fwprop-insn insn)
+ (cl-incf i)
+ when (and (null modified) (not (equal insn orig-insn)))
+ do (setf modified t))
+ when (> i comp-fwprop-max-insns-scan)
+ do (cl-return-from outer nil)
+ finally return modified))
+
+(defun comp-rewrite-non-locals ()
+ "Make explicit in LIMPLE non-local exits if identified."
+ (cl-loop
+ for bb being each hash-value of (comp-func-blocks comp-func)
+ for non-local-insn = (and (comp-block-lap-p bb)
+ (comp-block-lap-non-ret-insn bb))
+ when non-local-insn
+ do
+ ;; Rework the current block.
+ (let* ((insn-seq (memq non-local-insn (comp-block-insns bb))))
+ (setf (comp-block-lap-non-ret-insn bb) ()
+ (comp-block-lap-no-ret bb) t
+ (comp-block-out-edges bb) ()
+ ;; Prune unnecessary insns!
+ (cdr insn-seq) '((unreachable))
+ (comp-func-ssa-status comp-func) 'dirty))))
+
+(defun comp-fwprop (_)
+ "Forward propagate types and consts within the lattice."
+ (comp-ssa)
+ (comp-dead-code)
+ (maphash (lambda (_ f)
+ (when (and (>= (comp-func-speed f) 2)
+ ;; FIXME remove the following condition when tested.
+ (not (comp-func-has-non-local f)))
+ (let ((comp-func f))
+ (comp-fwprop-prologue)
+ (cl-loop
+ for i from 1 to 100
+ while (comp-fwprop*)
+ finally
+ (when (= i 100)
+ (display-warning
+ 'comp
+ (format "fwprop pass jammed into %s?" (comp-func-name f))))
+ (comp-log (format "Propagation run %d times\n" i) 2))
+ (comp-rewrite-non-locals)
+ (comp-log-func comp-func 3))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; Call optimizer pass specific code.
+;; This pass is responsible for the following optimizations:
+;; - Call to subrs that are in defined in the C source and are passing through
+;; funcall trampoline gets optimized into normal indirect calls.
+;; This makes effectively this calls equivalent to all the subrs that got
+;; dedicated byte-code ops.
+;; Triggered at native-comp-speed >= 2.
+;; - Recursive calls gets optimized into direct calls.
+;; Triggered at native-comp-speed >= 2.
+;; - Intra compilation unit procedure calls gets optimized into direct calls.
+;; This can be a big win and even allow gcc to inline but does not make
+;; function in the compilation unit re-definable safely without recompiling
+;; the full compilation unit.
+;; For this reason this is triggered only at native-comp-speed == 3.
+
+(defun comp-func-in-unit (func)
+ "Given FUNC return the `comp-fun' definition in the current context.
+FUNCTION can be a function-name or byte compiled function."
+ (if (symbolp func)
+ (comp-symbol-func-to-fun func)
+ (cl-assert (byte-code-function-p func))
+ (gethash func (comp-ctxt-byte-func-to-func-h comp-ctxt))))
+
+(defun comp-call-optim-form-call (callee args)
+ (cl-flet ((fill-args (args total)
+ ;; Fill missing args to reach TOTAL
+ (append args (cl-loop repeat (- total (length args))
+ collect (make-comp-mvar :constant nil)))))
+ (when (and callee
+ (or (symbolp callee)
+ (gethash callee (comp-ctxt-byte-func-to-func-h comp-ctxt)))
+ (not (memq callee native-comp-never-optimize-functions)))
+ (let* ((f (if (symbolp callee)
+ (symbol-function callee)
+ (cl-assert (byte-code-function-p callee))
+ callee))
+ (subrp (subrp f))
+ (comp-func-callee (comp-func-in-unit callee)))
+ (cond
+ ((and subrp (not (subr-native-elisp-p f)))
+ ;; Trampoline removal.
+ (let* ((callee (intern (subr-name f))) ; Fix aliased names.
+ (maxarg (cdr (subr-arity f)))
+ (call-type (if (if subrp
+ (not (numberp maxarg))
+ (comp-nargs-p comp-func-callee))
+ 'callref
+ 'call))
+ (args (if (eq call-type 'callref)
+ args
+ (fill-args args maxarg))))
+ `(,call-type ,callee ,@args)))
+ ;; Intra compilation unit procedure call optimization.
+ ;; Attention speed 3 triggers this for non self calls too!!
+ ((and comp-func-callee
+ (comp-func-c-name comp-func-callee)
+ (or (and (>= (comp-func-speed comp-func) 3)
+ (comp-func-unique-in-cu-p callee))
+ (and (>= (comp-func-speed comp-func) 2)
+ ;; Anonymous lambdas can't be redefined so are
+ ;; always safe to optimize.
+ (byte-code-function-p callee))))
+ (let* ((func-args (comp-func-l-args comp-func-callee))
+ (nargs (comp-nargs-p func-args))
+ (call-type (if nargs 'direct-callref 'direct-call))
+ (args (if (eq call-type 'direct-callref)
+ args
+ (fill-args args (comp-args-max func-args)))))
+ `(,call-type ,(comp-func-c-name comp-func-callee) ,@args)))
+ ((comp-type-hint-p callee)
+ `(call ,callee ,@args)))))))
+
+(defun comp-call-optim-func ()
+ "Perform the trampoline call optimization for the current function."
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (comp-loop-insn-in-block b
+ (pcase insn
+ (`(set ,lval (callref funcall ,f . ,rest))
+ (when-let ((ok (comp-cstr-imm-vld-p f))
+ (new-form (comp-call-optim-form-call
+ (comp-cstr-imm f) rest)))
+ (setf insn `(set ,lval ,new-form))))
+ (`(callref funcall ,f . ,rest)
+ (when-let ((ok (comp-cstr-imm-vld-p f))
+ (new-form (comp-call-optim-form-call
+ (comp-cstr-imm f) rest)))
+ (setf insn new-form)))))))
+
+(defun comp-call-optim (_)
+ "Try to optimize out funcall trampoline usage when possible."
+ (maphash (lambda (_ f)
+ (when (and (>= (comp-func-speed f) 2)
+ (comp-func-l-p f))
+ (let ((comp-func f))
+ (comp-call-optim-func))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; Dead code elimination pass specific code.
+;; This simple pass try to eliminate insns became useful after propagation.
+;; Even if gcc would take care of this is good to perform this here
+;; in the hope of removing memory references.
+;;
+;; This pass can be run as last optim.
+
+(defun comp-collect-mvar-ids (insn)
+ "Collect the m-var unique identifiers into INSN."
+ (cl-loop for x in insn
+ if (consp x)
+ append (comp-collect-mvar-ids x)
+ else
+ when (comp-mvar-p x)
+ collect (comp-mvar-id x)))
+
+(defun comp-dead-assignments-func ()
+ "Clean-up dead assignments into current function.
+Return the list of m-var ids nuked."
+ (let ((l-vals ())
+ (r-vals ()))
+ ;; Collect used r and l-values.
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (cl-loop
+ for insn in (comp-block-insns b)
+ for (op arg0 . rest) = insn
+ if (comp-assign-op-p op)
+ do (push (comp-mvar-id arg0) l-vals)
+ (setf r-vals (nconc (comp-collect-mvar-ids rest) r-vals))
+ else
+ do (setf r-vals (nconc (comp-collect-mvar-ids insn) r-vals))))
+ ;; Every l-value appearing that does not appear as r-value has no right to
+ ;; exist and gets nuked.
+ (let ((nuke-list (cl-set-difference l-vals r-vals)))
+ (comp-log (format "Function %s\nl-vals %s\nr-vals %s\nNuking ids: %s\n"
+ (comp-func-name comp-func)
+ l-vals
+ r-vals
+ nuke-list)
+ 3)
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (comp-loop-insn-in-block b
+ (cl-destructuring-bind (op &optional arg0 arg1 &rest rest) insn
+ (when (and (comp-assign-op-p op)
+ (memq (comp-mvar-id arg0) nuke-list))
+ (setf insn
+ (if (comp-limple-insn-call-p arg1)
+ arg1
+ `(comment ,(format "optimized out: %s"
+ insn))))))))
+ nuke-list)))
+
+(defun comp-dead-code ()
+ "Dead code elimination."
+ (maphash (lambda (_ f)
+ (when (and (>= (comp-func-speed f) 2)
+ ;; FIXME remove the following condition when tested.
+ (not (comp-func-has-non-local f)))
+ (cl-loop
+ for comp-func = f
+ for i from 1
+ while (comp-dead-assignments-func)
+ finally (comp-log (format "dead code rm run %d times\n" i) 2)
+ (comp-log-func comp-func 3))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; Tail Call Optimization pass specific code.
+
+(defun comp-form-tco-call-seq (args)
+ "Generate a TCO sequence for ARGS."
+ `(,@(cl-loop for arg in args
+ for i from 0
+ collect `(set ,(make-comp-mvar :slot i) ,arg))
+ (jump bb_0)))
+
+(defun comp-tco-func ()
+ "Try to pattern match and perform TCO within the current function."
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (cl-loop
+ named in-the-basic-block
+ for insns-seq on (comp-block-insns b)
+ do (pcase insns-seq
+ (`((set ,l-val (direct-call ,func . ,args))
+ ;; (comment ,_comment)
+ (return ,ret-val))
+ (when (and (string= func (comp-func-c-name comp-func))
+ (eq l-val ret-val))
+ (let ((tco-seq (comp-form-tco-call-seq args)))
+ (setf (car insns-seq) (car tco-seq)
+ (cdr insns-seq) (cdr tco-seq)
+ (comp-func-ssa-status comp-func) 'dirty)
+ (cl-return-from in-the-basic-block))))))))
+
+(defun comp-tco (_)
+ "Simple peephole pass performing self TCO."
+ (maphash (lambda (_ f)
+ (when (and (>= (comp-func-speed f) 3)
+ (comp-func-l-p f)
+ (not (comp-func-has-non-local f)))
+ (let ((comp-func f))
+ (comp-tco-func)
+ (comp-log-func comp-func 3))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; Type hint removal pass specific code.
+
+;; This must run after all SSA prop not to have the type hint
+;; information overwritten.
+
+(defun comp-remove-type-hints-func ()
+ "Remove type hints from the current function.
+These are substituted with a normal 'set' op."
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks comp-func)
+ do (comp-loop-insn-in-block b
+ (pcase insn
+ (`(set ,l-val (call ,(pred comp-type-hint-p) ,r-val))
+ (setf insn `(set ,l-val ,r-val)))))))
+
+(defun comp-remove-type-hints (_)
+ "Dead code elimination."
+ (maphash (lambda (_ f)
+ (when (>= (comp-func-speed f) 2)
+ (let ((comp-func f))
+ (comp-remove-type-hints-func)
+ (comp-log-func comp-func 3))))
+ (comp-ctxt-funcs-h comp-ctxt)))
+
+
+;;; Final pass specific code.
+
+(defun comp-args-to-lambda-list (args)
+ "Return a lambda list for ARGS."
+ (cl-loop
+ with res
+ repeat (comp-args-base-min args)
+ do (push t res)
+ finally
+ (if (comp-args-p args)
+ (cl-loop
+ with n = (- (comp-args-max args) (comp-args-min args))
+ initially (unless (zerop n)
+ (push '&optional res))
+ repeat n
+ do (push t res))
+ (cl-loop
+ with n = (- (comp-nargs-nonrest args) (comp-nargs-min args))
+ initially (unless (zerop n)
+ (push '&optional res))
+ repeat n
+ do (push t res)
+ finally (when (comp-nargs-rest args)
+ (push '&rest res)
+ (push 't res))))
+ (cl-return (reverse res))))
+
+(defun comp-compute-function-type (_ func)
+ "Compute type specifier for `comp-func' FUNC.
+Set it into the `type' slot."
+ (when (and (comp-func-l-p func)
+ (comp-mvar-p (comp-func-type func)))
+ (let* ((comp-func (make-comp-func))
+ (res-mvar (apply #'comp-cstr-union
+ (make-comp-cstr)
+ (cl-loop
+ with res = nil
+ for bb being the hash-value in (comp-func-blocks
+ func)
+ do (cl-loop
+ for insn in (comp-block-insns bb)
+ ;; Collect over every exit point the returned
+ ;; mvars and union results.
+ do (pcase insn
+ (`(return ,mvar)
+ (push mvar res))))
+ finally return res)))
+ (type `(function ,(comp-args-to-lambda-list (comp-func-l-args func))
+ ,(comp-cstr-to-type-spec res-mvar))))
+ (comp-add-const-to-relocs type)
+ ;; Fix it up.
+ (setf (comp-cstr-imm (comp-func-type func)) type))))
+
+(defun comp-finalize-container (cont)
+ "Finalize data container CONT."
+ (setf (comp-data-container-l cont)
+ (cl-loop with h = (comp-data-container-idx cont)
+ for obj each hash-keys of h
+ for i from 0
+ do (puthash obj i h)
+ ;; Prune byte-code objects coming from lambdas.
+ ;; These are not anymore necessary as they will be
+ ;; replaced at load time by native-elisp-subrs.
+ ;; Note: we leave the objects in the idx hash table
+ ;; to still be able to retrieve the correct index
+ ;; from the corresponding m-var.
+ collect (if (gethash obj
+ (comp-ctxt-byte-func-to-func-h comp-ctxt))
+ 'lambda-fixup
+ obj))))
+
+(defun comp-finalize-relocs ()
+ "Finalize data containers for each relocation class.
+Remove immediate duplicates within relocation classes.
+Update all insn accordingly."
+ ;; Symbols imported by C inlined functions. We do this here because
+ ;; is better to add all objs to the relocation containers before we
+ ;; compacting them.
+ (mapc #'comp-add-const-to-relocs '(nil t consp listp))
+
+ (let* ((d-default (comp-ctxt-d-default comp-ctxt))
+ (d-default-idx (comp-data-container-idx d-default))
+ (d-impure (comp-ctxt-d-impure comp-ctxt))
+ (d-impure-idx (comp-data-container-idx d-impure))
+ (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt))
+ (d-ephemeral-idx (comp-data-container-idx d-ephemeral)))
+ ;; We never want compiled lambdas ending up in pure space. A copy must
+ ;; be already present in impure (see `comp-emit-lambda-for-top-level').
+ (cl-loop for obj being each hash-keys of d-default-idx
+ when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt))
+ do (cl-assert (gethash obj d-impure-idx))
+ (remhash obj d-default-idx))
+ ;; Remove entries in d-impure already present in d-default.
+ (cl-loop for obj being each hash-keys of d-impure-idx
+ when (gethash obj d-default-idx)
+ do (remhash obj d-impure-idx))
+ ;; Remove entries in d-ephemeral already present in d-default or
+ ;; d-impure.
+ (cl-loop for obj being each hash-keys of d-ephemeral-idx
+ when (or (gethash obj d-default-idx) (gethash obj d-impure-idx))
+ do (remhash obj d-ephemeral-idx))
+ ;; Fix-up indexes in each relocation class and fill corresponding
+ ;; reloc lists.
+ (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral))
+ ;; Make a vector from the function documentation hash table.
+ (cl-loop with h = (comp-ctxt-function-docs comp-ctxt)
+ with v = (make-vector (hash-table-count h) nil)
+ for idx being each hash-keys of h
+ for doc = (gethash idx h)
+ do (setf (aref v idx) doc)
+ finally
+ do (setf (comp-ctxt-function-docs comp-ctxt) v))
+ ;; And now we conclude with the following: We need to pass to
+ ;; `comp--register-lambda' the index in the impure relocation
+ ;; array to store revived lambdas, but given we know it only now
+ ;; we fix it up as last.
+ (cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt)
+ using (hash-value mvar)
+ with reverse-h = (make-hash-table) ;; Make sure idx is unique.
+ for idx = (gethash f d-impure-idx)
+ do
+ (cl-assert (null (gethash idx reverse-h)))
+ (cl-assert (fixnump idx))
+ (setf (comp-mvar-valset mvar) ()
+ (comp-mvar-range mvar) (list (cons idx idx)))
+ (puthash idx t reverse-h))))
+
+(defun comp-compile-ctxt-to-file (name)
+ "Compile as native code the current context naming it NAME.
+Prepare every function for final compilation and drive the C back-end."
+ (let ((dir (file-name-directory name)))
+ (comp-finalize-relocs)
+ (maphash (lambda (_ f)
+ (comp-log-func f 1))
+ (comp-ctxt-funcs-h comp-ctxt))
+ (unless (file-exists-p dir)
+ ;; In case it's created in the meanwhile.
+ (ignore-error file-already-exists
+ (make-directory dir t)))
+ (comp--compile-ctxt-to-file name)))
+
+(defun comp-final1 ()
+ (let (compile-result)
+ (comp--init-ctxt)
+ (unwind-protect
+ (setf compile-result
+ (comp-compile-ctxt-to-file (comp-ctxt-output comp-ctxt)))
+ (and (comp--release-ctxt)
+ compile-result))))
+
+(defvar comp-async-compilation nil
+ "Non-nil while executing an asynchronous native compilation.")
+
+(defun comp-final (_)
+ "Final pass driving the C back-end for code emission."
+ (maphash #'comp-compute-function-type (comp-ctxt-funcs-h comp-ctxt))
+ (unless comp-dry-run
+ ;; Always run the C side of the compilation as a sub-process
+ ;; unless during bootstrap or async compilation (bug#45056). GCC
+ ;; leaks memory but also interfere with the ability of Emacs to
+ ;; detect when a sub-process completes (TODO understand why).
+ (if (or byte+native-compile comp-async-compilation)
+ (comp-final1)
+ ;; Call comp-final1 in a child process.
+ (let* ((output (comp-ctxt-output comp-ctxt))
+ (print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-quoted t)
+ (print-gensym t)
+ (print-circle t)
+ (print-escape-multibyte t)
+ (expr `((require 'comp)
+ (setf native-comp-verbose ,native-comp-verbose
+ comp-libgccjit-reproducer ,comp-libgccjit-reproducer
+ comp-ctxt ,comp-ctxt
+ native-comp-eln-load-path ',native-comp-eln-load-path
+ native-comp-driver-options
+ ',native-comp-driver-options
+ load-path ',load-path)
+ ,native-comp-async-env-modifier-form
+ (message "Compiling %s..." ',output)
+ (comp-final1)))
+ (temp-file (make-temp-file
+ (concat "emacs-int-comp-"
+ (file-name-base output) "-")
+ nil ".el")))
+ (with-temp-file temp-file
+ (insert ";; -*-coding: nil; -*-\n")
+ (mapc (lambda (e)
+ (insert (prin1-to-string e)))
+ expr))
+ (with-temp-buffer
+ (unwind-protect
+ (if (zerop
+ (call-process (expand-file-name invocation-name
+ invocation-directory)
+ nil t t "--batch" "-l" temp-file))
+ (progn
+ (delete-file temp-file)
+ output)
+ (signal 'native-compiler-error (buffer-string)))
+ (comp-log-to-buffer (buffer-string))))))))
+
+
+;;; Compiler type hints.
+;; Public entry points to be used by user code to give comp
+;; suggestions about types. These are used to implement CL style
+;; `cl-the' and hopefully parameter type declaration.
+;; Note: types will propagates.
+;; WARNING: At speed >= 2 type checking is not performed anymore and suggestions
+;; are assumed just to be true. Use with extreme caution...
+
+(defun comp-hint-fixnum (x)
+ (declare (gv-setter (lambda (val) `(setf ,x ,val))))
+ x)
+
+(defun comp-hint-cons (x)
+ (declare (gv-setter (lambda (val) `(setf ,x ,val))))
+ x)
+
+
+;; Primitive function advice machinery
+
+(defun comp-eln-load-path-eff ()
+ "Return a list of effective eln load directories.
+Account for `native-comp-eln-load-path' and `comp-native-version-dir'."
+ (mapcar (lambda (dir)
+ (expand-file-name comp-native-version-dir
+ (file-name-as-directory
+ (expand-file-name dir invocation-directory))))
+ native-comp-eln-load-path))
+
+(defun comp-trampoline-filename (subr-name)
+ "Given SUBR-NAME return the filename containing the trampoline."
+ (concat (comp-c-func-name subr-name "subr--trampoline-" t) ".eln"))
+
+(defun comp-make-lambda-list-from-subr (subr)
+ "Given SUBR return the equivalent lambda-list."
+ (pcase-let ((`(,min . ,max) (subr-arity subr))
+ (lambda-list '()))
+ (cl-loop repeat min
+ do (push (gensym "arg") lambda-list))
+ (if (numberp max)
+ (cl-loop
+ initially (push '&optional lambda-list)
+ repeat (- max min)
+ do (push (gensym "arg") lambda-list))
+ (push '&rest lambda-list)
+ (push (gensym "arg") lambda-list))
+ (reverse lambda-list)))
+
+(defun comp-trampoline-search (subr-name)
+ "Search a trampoline file for SUBR-NAME.
+Return the trampoline if found or nil otherwise."
+ (cl-loop
+ with rel-filename = (comp-trampoline-filename subr-name)
+ for dir in (comp-eln-load-path-eff)
+ for filename = (expand-file-name rel-filename dir)
+ when (file-exists-p filename)
+ do (cl-return (native-elisp-load filename))))
+
+(defun comp-trampoline-compile (subr-name)
+ "Synthesize compile and return a trampoline for SUBR-NAME."
+ (let* ((lambda-list (comp-make-lambda-list-from-subr
+ (symbol-function subr-name)))
+ ;; The synthesized trampoline must expose the exact same ABI of
+ ;; the primitive we are replacing in the function reloc table.
+ (form `(lambda ,lambda-list
+ (let ((f #',subr-name))
+ (,(if (memq '&rest lambda-list) #'apply 'funcall)
+ f
+ ,@(cl-loop
+ for arg in lambda-list
+ unless (memq arg '(&optional &rest))
+ collect arg)))))
+ ;; Use speed 0 to maximize compilation speed and not to
+ ;; optimize away funcall calls!
+ (byte-optimize nil)
+ (native-comp-speed 1)
+ (lexical-binding t))
+ (comp--native-compile
+ form nil
+ (cl-loop
+ for dir in (comp-eln-load-path-eff)
+ for f = (expand-file-name
+ (comp-trampoline-filename subr-name)
+ dir)
+ unless (file-exists-p dir)
+ do (ignore-errors
+ (make-directory dir t)
+ (cl-return f))
+ when (file-writable-p f)
+ do (cl-return f)
+ finally (error "Cannot find suitable directory for output in \
+`native-comp-eln-load-path'")))))
+
+
+;; Some entry point support code.
+
+;;;###autoload
+(defun comp-clean-up-stale-eln (file)
+ "Given FILE remove all its *.eln files in `native-comp-eln-load-path'
+sharing the original source filename (including FILE)."
+ (when (string-match (rx "-" (group-n 1 (1+ hex)) "-" (1+ hex) ".eln" eos)
+ file)
+ (cl-loop
+ with filename-hash = (match-string 1 file)
+ with regexp = (rx-to-string
+ `(seq "-" ,filename-hash "-" (1+ hex) ".eln" eos))
+ for dir in (comp-eln-load-path-eff)
+ do (cl-loop
+ for f in (when (file-exists-p dir)
+ (directory-files dir t regexp t))
+ ;; We may not be able to delete the file if we have no write
+ ;; permission.
+ do (ignore-error file-error
+ (comp-delete-or-replace-file f))))))
+
+(defun comp-delete-or-replace-file (oldfile &optional newfile)
+ "Replace OLDFILE with NEWFILE.
+When NEWFILE is nil just delete OLDFILE.
+Takes the necessary steps when dealing with OLDFILE being a
+shared library that might be currently loaded into a running Emacs
+session."
+ (cond ((eq 'windows-nt system-type)
+ (ignore-errors (delete-file oldfile))
+ (while
+ (condition-case _
+ (progn
+ ;; oldfile maybe recreated by another Emacs in
+ ;; between the following two rename-file calls
+ (if (file-exists-p oldfile)
+ (rename-file oldfile (make-temp-file-internal
+ (file-name-sans-extension oldfile)
+ nil ".eln.old" nil)
+ t))
+ (when newfile
+ (rename-file newfile oldfile nil))
+ ;; Keep on trying.
+ nil)
+ (file-already-exists
+ ;; Done
+ t))))
+ ;; Remove the old eln instead of copying the new one into it
+ ;; to get a new inode and prevent crashes in case the old one
+ ;; is currently loaded.
+ (t (delete-file oldfile)
+ (when newfile
+ (rename-file newfile oldfile)))))
+
+(defvar comp-files-queue ()
+ "List of Emacs Lisp files to be compiled.")
+
+(defvar comp-async-compilations (make-hash-table :test #'equal)
+ "Hash table file-name -> async compilation process.")
+
+(defun comp-async-runnings ()
+ "Return the number of async compilations currently running.
+This function has the side effect of cleaning-up finished
+processes from `comp-async-compilations'"
+ (cl-loop
+ for file-name in (cl-loop
+ for file-name being each hash-key of comp-async-compilations
+ for prc = (gethash file-name comp-async-compilations)
+ unless (process-live-p prc)
+ collect file-name)
+ do (remhash file-name comp-async-compilations))
+ (hash-table-count comp-async-compilations))
+
+(declare-function w32-get-nproc "w32.c")
+(defvar comp-num-cpus nil)
+(defun comp-effective-async-max-jobs ()
+ "Compute the effective number of async jobs."
+ (if (zerop native-comp-async-jobs-number)
+ (or comp-num-cpus
+ (setf comp-num-cpus
+ ;; FIXME: we already have a function to determine
+ ;; the number of processors, see get_native_system_info in w32.c.
+ ;; The result needs to be exported to Lisp.
+ (max 1 (/ (cond ((eq 'windows-nt system-type)
+ (w32-get-nproc))
+ ((executable-find "nproc")
+ (string-to-number
+ (shell-command-to-string "nproc")))
+ ((eq 'berkeley-unix system-type)
+ (string-to-number
+ (shell-command-to-string "sysctl -n hw.ncpu")))
+ (t 1))
+ 2))))
+ native-comp-async-jobs-number))
+
+(defvar comp-last-scanned-async-output nil)
+(make-variable-buffer-local 'comp-last-scanned-async-output)
+(defun comp-accept-and-process-async-output (process)
+ "Accept PROCESS output and check for diagnostic messages."
+ (if native-comp-async-report-warnings-errors
+ (let ((warning-suppress-types
+ (if (eq native-comp-async-report-warnings-errors 'silent)
+ (cons '(comp) warning-suppress-types)
+ warning-suppress-types)))
+ (with-current-buffer (process-buffer process)
+ (save-excursion
+ (accept-process-output process)
+ (goto-char (or comp-last-scanned-async-output (point-min)))
+ (while (re-search-forward "^.*?\\(?:Error\\|Warning\\): .*$"
+ nil t)
+ (display-warning 'comp (match-string 0)))
+ (setq comp-last-scanned-async-output (point-max)))))
+ (accept-process-output process)))
+
+(defun comp-run-async-workers ()
+ "Start compiling files from `comp-files-queue' asynchronously.
+When compilation is finished, run `native-comp-async-all-done-hook' and
+display a message."
+ (if (or comp-files-queue
+ (> (comp-async-runnings) 0))
+ (unless (>= (comp-async-runnings) (comp-effective-async-max-jobs))
+ (cl-loop
+ for (source-file . load) = (pop comp-files-queue)
+ while source-file
+ do (cl-assert (string-match-p comp-valid-source-re source-file) nil
+ "`comp-files-queue' should be \".el\" files: %s"
+ source-file)
+ when (or native-comp-always-compile
+ load ; Always compile when the compilation is
+ ; commanded for late load.
+ (file-newer-than-file-p
+ source-file (comp-el-to-eln-filename source-file)))
+ do (let* ((expr `((require 'comp)
+ ,(when (boundp 'backtrace-line-length)
+ `(setf backtrace-line-length ,backtrace-line-length))
+ (setf native-compile-target-directory ,native-compile-target-directory
+ native-comp-speed ,native-comp-speed
+ native-comp-debug ,native-comp-debug
+ native-comp-verbose ,native-comp-verbose
+ comp-libgccjit-reproducer ,comp-libgccjit-reproducer
+ comp-async-compilation t
+ native-comp-eln-load-path ',native-comp-eln-load-path
+ native-comp-driver-options
+ ',native-comp-driver-options
+ load-path ',load-path
+ warning-fill-column most-positive-fixnum)
+ ,native-comp-async-env-modifier-form
+ (message "Compiling %s..." ,source-file)
+ (comp--native-compile ,source-file ,(and load t))))
+ (source-file1 source-file) ;; Make the closure works :/
+ (temp-file (make-temp-file
+ (concat "emacs-async-comp-"
+ (file-name-base source-file) "-")
+ nil ".el"))
+ (expr-strings (let ((print-length nil)
+ (print-level nil))
+ (mapcar #'prin1-to-string expr)))
+ (_ (progn
+ (with-temp-file temp-file
+ (mapc #'insert expr-strings))
+ (comp-log "\n")
+ (mapc #'comp-log expr-strings)))
+ (load1 load)
+ (process (make-process
+ :name (concat "Compiling: " source-file)
+ :buffer (with-current-buffer
+ (get-buffer-create
+ comp-async-buffer-name)
+ (setf buffer-read-only t)
+ (current-buffer))
+ :command (list
+ (expand-file-name invocation-name
+ invocation-directory)
+ "--batch" "-l" temp-file)
+ :sentinel
+ (lambda (process _event)
+ (run-hook-with-args
+ 'native-comp-async-cu-done-functions
+ source-file)
+ (comp-accept-and-process-async-output process)
+ (ignore-errors (delete-file temp-file))
+ (let ((eln-file (comp-el-to-eln-filename
+ source-file1)))
+ (when (and load1
+ (zerop (process-exit-status
+ process))
+ (file-exists-p eln-file))
+ (native-elisp-load eln-file
+ (eq load1 'late))))
+ (comp-run-async-workers))
+ :noquery (not native-comp-async-query-on-exit))))
+ (puthash source-file process comp-async-compilations))
+ when (>= (comp-async-runnings) (comp-effective-async-max-jobs))
+ do (cl-return)))
+ ;; No files left to compile and all processes finished.
+ (run-hooks 'native-comp-async-all-done-hook)
+ (with-current-buffer (get-buffer-create comp-async-buffer-name)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (insert "Compilation finished.\n"))))
+ ;; `comp-deferred-pending-h' should be empty at this stage.
+ ;; Reset it anyway.
+ (clrhash comp-deferred-pending-h)))
+
+(defun comp--native-compile (function-or-file &optional with-late-load output)
+ "Compile FUNCTION-OR-FILE into native code.
+When WITH-LATE-LOAD is non-nil, mark the compilation unit for late
+load once it finishes compiling.
+This serves as internal implementation of `native-compile' but
+allowing for WITH-LATE-LOAD to be controlled is in use also for
+the deferred compilation mechanism."
+ (comp-ensure-native-compiler)
+ (unless (or (functionp function-or-file)
+ (stringp function-or-file))
+ (signal 'native-compiler-error
+ (list "Not a function symbol or file" function-or-file)))
+ (catch 'no-native-compile
+ (let* ((data function-or-file)
+ (comp-native-compiling t)
+ (byte-native-qualities nil)
+ ;; Have byte compiler signal an error when compilation fails.
+ (byte-compile-debug t)
+ (comp-ctxt (make-comp-ctxt :output output
+ :with-late-load with-late-load)))
+ (comp-log "\n \n" 1)
+ (condition-case err
+ (cl-loop
+ with report = nil
+ for t0 = (current-time)
+ for pass in comp-passes
+ unless (memq pass comp-disabled-passes)
+ do
+ (comp-log (format "(%s) Running pass %s:\n"
+ function-or-file pass)
+ 2)
+ (setf data (funcall pass data))
+ (push (cons pass (float-time (time-since t0))) report)
+ (cl-loop for f in (alist-get pass comp-post-pass-hooks)
+ do (funcall f data))
+ finally
+ (when comp-log-time-report
+ (comp-log (format "Done compiling %s" data) 0)
+ (cl-loop for (pass . time) in (reverse report)
+ do (comp-log (format "Pass %s took: %fs." pass time) 0))))
+ (native-compiler-skip)
+ (t
+ (let ((err-val (cdr err)))
+ ;; If we are doing an async native compilation print the
+ ;; error in the correct format so is parsable and abort.
+ (if (and comp-async-compilation
+ (not (eq (car err) 'native-compiler-error)))
+ (progn
+ (message (if err-val
+ "%s: Error: %s %s"
+ "%s: Error %s")
+ function-or-file
+ (get (car err) 'error-message)
+ (car-safe err-val))
+ (kill-emacs -1))
+ ;; Otherwise re-signal it adding the compilation input.
+ (signal (car err) (if (consp err-val)
+ (cons function-or-file err-val)
+ (list function-or-file err-val)))))))
+ (if (stringp function-or-file)
+ data
+ ;; So we return the compiled function.
+ (native-elisp-load data)))))
+
+(defun native-compile-async-skip-p (file load selector)
+ "Return non-nil if FILE's compilation should be skipped.
+
+LOAD and SELECTOR work as described in `native--compile-async'."
+ ;; Make sure we are not already compiling `file' (bug#40838).
+ (or (gethash file comp-async-compilations)
+ (cond
+ ((null selector) nil)
+ ((functionp selector) (not (funcall selector file)))
+ ((stringp selector) (not (string-match-p selector file)))
+ (t (error "SELECTOR must be a function a regexp or nil")))
+ ;; Also exclude files from deferred compilation if
+ ;; any of the regexps in
+ ;; `native-comp-deferred-compilation-deny-list' matches.
+ (and (eq load 'late)
+ (cl-some (lambda (re)
+ (string-match-p re file))
+ native-comp-deferred-compilation-deny-list))))
+
+(defun native--compile-async (files &optional recursively load selector)
+ "Compile FILES asynchronously.
+FILES is one filename or a list of filenames or directories.
+
+If optional argument RECURSIVELY is non-nil, recurse into
+subdirectories of given directories.
+
+If optional argument LOAD is non-nil, request to load the file
+after compiling.
+
+The optional argument SELECTOR has the following valid values:
+
+nil -- Select all files.
+a string -- A regular expression selecting files with matching names.
+a function -- A function selecting files with matching names.
+
+The variable `native-comp-async-jobs-number' specifies the number
+of (commands) to run simultaneously.
+
+LOAD can also be the symbol `late'. This is used internally if
+the byte code has already been loaded when this function is
+called. It means that we request the special kind of load
+necessary in that situation, called \"late\" loading.
+
+During a \"late\" load, instead of executing all top-level forms
+of the original files, only function definitions are
+loaded (paying attention to have these effective only if the
+bytecode definition was not changed in the meantime)."
+ (comp-ensure-native-compiler)
+ (unless (member load '(nil t late))
+ (error "LOAD must be nil, t or 'late"))
+ (unless (listp files)
+ (setf files (list files)))
+ (let (file-list)
+ (dolist (path files)
+ (cond ((file-directory-p path)
+ (dolist (file (if recursively
+ (directory-files-recursively
+ path comp-valid-source-re)
+ (directory-files path t comp-valid-source-re)))
+ (push file file-list)))
+ ((file-exists-p path) (push path file-list))
+ (t (signal 'native-compiler-error
+ (list "Path not a file nor directory" path)))))
+ (dolist (file file-list)
+ (if-let ((entry (cl-find file comp-files-queue :key #'car :test #'string=)))
+ ;; Most likely the byte-compiler has requested a deferred
+ ;; compilation, so update `comp-files-queue' to reflect that.
+ (unless (or (null load)
+ (eq load (cdr entry)))
+ (cl-substitute (cons file load) (car entry) comp-files-queue
+ :key #'car :test #'string=))
+
+ (unless (native-compile-async-skip-p file load selector)
+ (let* ((out-filename (comp-el-to-eln-filename file))
+ (out-dir (file-name-directory out-filename)))
+ (unless (file-exists-p out-dir)
+ (make-directory out-dir t))
+ (if (file-writable-p out-filename)
+ (setf comp-files-queue
+ (append comp-files-queue `((,file . ,load))))
+ (display-warning 'comp
+ (format "No write access for %s skipping."
+ out-filename)))))))
+ (when (zerop (comp-async-runnings))
+ (comp-run-async-workers))))
+
+
+;;; Compiler entry points.
+
+;;;###autoload
+(defun comp-lookup-eln (filename)
+ "Given a Lisp source FILENAME return the corresponding .eln file if found.
+Search happens in `native-comp-eln-load-path'."
+ (cl-loop
+ with eln-filename = (comp-el-to-eln-rel-filename filename)
+ for dir in native-comp-eln-load-path
+ for f = (expand-file-name eln-filename
+ (expand-file-name comp-native-version-dir
+ (expand-file-name
+ dir
+ invocation-directory)))
+ when (file-exists-p f)
+ do (cl-return f)))
+
+;;;###autoload
+(defun native-compile (function-or-file &optional output)
+ "Compile FUNCTION-OR-FILE into native code.
+This is the synchronous entry-point for the Emacs Lisp native
+compiler.
+FUNCTION-OR-FILE is a function symbol, a form, or the filename of
+an Emacs Lisp source file.
+If OUTPUT is non-nil, use it as the filename for the compiled
+object.
+If FUNCTION-OR-FILE is a filename, return the filename of the
+compiled object. If FUNCTION-OR-FILE is a function symbol or a
+form, return the compiled function."
+ (comp--native-compile function-or-file nil output))
+
+;;;###autoload
+(defun batch-native-compile ()
+ "Perform native compilation on remaining command-line arguments.
+Use this from the command line, with ‘-batch’;
+it won’t work in an interactive Emacs.
+Native compilation equivalent to `batch-byte-compile'."
+ (comp-ensure-native-compiler)
+ (cl-loop for file in command-line-args-left
+ if (or (null byte+native-compile)
+ (cl-notany (lambda (re) (string-match re file))
+ native-comp-bootstrap-deny-list))
+ do (comp--native-compile file)
+ else
+ do (byte-compile-file file)))
+
+;;;###autoload
+(defun batch-byte+native-compile ()
+ "Like `batch-native-compile', but used for bootstrap.
+Generate .elc files in addition to the .eln files.
+Force the produced .eln to be outputted in the eln system
+directory (the last entry in `native-comp-eln-load-path') unless
+`native-compile-target-directory' is non-nil. If the environment
+variable 'NATIVE_DISABLED' is set, only byte compile."
+ (comp-ensure-native-compiler)
+ (if (equal (getenv "NATIVE_DISABLED") "1")
+ (batch-byte-compile)
+ (cl-assert (length= command-line-args-left 1))
+ (let ((byte+native-compile t)
+ (byte-to-native-output-file nil))
+ (batch-native-compile)
+ (pcase byte-to-native-output-file
+ (`(,tempfile . ,target-file)
+ (rename-file tempfile target-file t))))))
+
+;;;###autoload
+(defun native-compile-async (files &optional recursively load selector)
+ "Compile FILES asynchronously.
+FILES is one file or a list of filenames or directories.
+
+If optional argument RECURSIVELY is non-nil, recurse into
+subdirectories of given directories.
+
+If optional argument LOAD is non-nil, request to load the file
+after compiling.
+
+The optional argument SELECTOR has the following valid values:
+
+nil -- Select all files.
+a string -- A regular expression selecting files with matching names.
+a function -- A function selecting files with matching names.
+
+The variable `native-comp-async-jobs-number' specifies the number
+of (commands) to run simultaneously."
+ ;; Normalize: we only want to pass t or nil, never e.g. `late'.
+ (let ((load (not (not load))))
+ (native--compile-async files recursively load selector)))
+
+(provide 'comp)
+
+;; LocalWords: limplified limplified limplification limplify Limple LIMPLE libgccjit elc eln
+
+;;; comp.el ends here
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index a9baef39a9a..d2e4891acee 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -51,7 +51,7 @@ This is useful for ChangeLogs."
"\\(©\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
\\|[Cc]opyright\\s *:?\\s *©\\)\
\\s *[^0-9\n]*\\s *\
-\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
+\\([1-9]\\([-0-9, ';/*%#\n\t–]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"What your copyright notice looks like.
The second \\( \\) construct must match the years."
:type 'regexp)
@@ -69,7 +69,7 @@ someone else or to a group for which you do not work."
;;;###autoload(put 'copyright-names-regexp 'safe-local-variable 'stringp)
(defcustom copyright-years-regexp
- "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
+ "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t–]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"Match additional copyright notice years.
The second \\( \\) construct must match the years."
:type 'regexp)
@@ -144,11 +144,16 @@ This function sets the match-data that `copyright-update-year' uses."
(with-demoted-errors "Can't update copyright: %s"
;; (1) Need the extra \\( \\) around copyright-regexp because we
;; goto (match-end 1) below. See note (2) below.
- (copyright-re-search (concat "\\(" copyright-regexp
- "\\)\\([ \t]*\n\\)?.*\\(?:"
- copyright-names-regexp "\\)")
- (copyright-limit)
- t)))
+ (let ((regexp (concat "\\(" copyright-regexp
+ "\\)\\([ \t]*\n\\)?.*\\(?:"
+ copyright-names-regexp "\\)")))
+ (when (copyright-re-search regexp (copyright-limit) t)
+ ;; We may accidentally have landed in the middle of a
+ ;; copyright line, so re-perform the search without the
+ ;; search. (Otherwise we may be inserting the new year in the
+ ;; middle of the list of years.)
+ (goto-char (match-beginning 0))
+ (copyright-re-search regexp nil t)))))
(defun copyright-find-end ()
"Possibly adjust the search performed by `copyright-find-copyright'.
@@ -197,8 +202,8 @@ skips to the end of all the years."
(point))))
100)
1)
- (or (eq (char-after (+ (point) size -1)) ?-)
- (eq (char-after (+ (point) size -2)) ?-)))
+ (or (memq (char-after (+ (point) size -1)) '(?- ?–))
+ (memq (char-after (+ (point) size -2)) '(?- ?–))))
;; This is a range so just replace the end part.
(delete-char size)
;; Insert a comma with the preferred number of spaces.
@@ -287,7 +292,7 @@ independently replaces consecutive years with a range."
(setq year (string-to-number (match-string 0)))
(and (setq sep (char-before))
(/= (char-syntax sep) ?\s)
- (/= sep ?-)
+ (not (memq sep '(?- ?–)))
(insert " "))
(when (< year 100)
(insert (if (>= year 50) "19" "20"))
@@ -297,7 +302,7 @@ independently replaces consecutive years with a range."
;; If the previous thing was a range, don't try to tack more on.
;; Ie not 2000-2005 -> 2000-2005-2007
;; TODO should merge into existing range if possible.
- (if (eq sep ?-)
+ (if (memq sep '(?- ?–))
(setq prev-year nil
year nil)
(if (and prev-year (= year (1+ prev-year)))
@@ -306,7 +311,7 @@ independently replaces consecutive years with a range."
(> prev-year first-year))
(goto-char range-end)
(delete-region range-start range-end)
- (insert (format "-%d" prev-year))
+ (insert (format "%c%d" sep prev-year))
(goto-char p))
(setq first-year year
range-start (point)))))
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index e106815817e..d24ea355a51 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -183,8 +183,7 @@ Return t if the current element is now a valid match; otherwise return nil."
Like `minibuffer-complete-word' but for `completing-read-multiple'."
(interactive)
(crm--completion-command beg end
- (completion-in-region--single-word
- beg end minibuffer-completion-table minibuffer-completion-predicate)))
+ (completion-in-region--single-word beg end)))
(defun crm-complete-and-exit ()
"If all of the minibuffer elements are valid completions then exit.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index d9da0db4551..2007f79634d 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -182,7 +182,11 @@ the debugger will not be entered."
(equal "initial_terminal" (terminal-name)))))
;; Don't let `inhibit-message' get in our way (especially important if
;; `non-interactive-frame' evaluated to a non-nil value.
- (inhibit-message nil))
+ (inhibit-message nil)
+ ;; We may be entering the debugger from a context that has
+ ;; let-bound `inhibit-read-only', which means that all
+ ;; buffers would be read/write while the debugger is running.
+ (inhibit-read-only nil))
(unless non-interactive-frame
(message "Entering debugger..."))
(let (debugger-value
@@ -213,7 +217,7 @@ the debugger will not be entered."
last-input-event last-command-event last-nonmenu-event
last-event-frame
overriding-local-map
- load-read-function
+ (load-read-function #'read)
;; If we are inside a minibuffer, allow nesting
;; so that we don't get an error from the `e' command.
(enable-recursive-minibuffers
@@ -321,7 +325,7 @@ the debugger will not be entered."
(make-obsolete 'debugger-insert-backtrace
"use a `backtrace-mode' buffer or `backtrace-to-string'."
- "Emacs 27.1")
+ "27.1")
(defun debugger-insert-backtrace (frames do-xrefs)
"Format and insert the backtrace FRAMES at point.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 54528b2fb91..43d6dfd3c81 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -141,6 +141,9 @@ KEYWORD-ARGS:
:after-hook FORM
A single lisp form which is evaluated after the mode
hooks have been run. It should not be quoted.
+ :interactive BOOLEAN
+ Whether the derived mode should be `interactive' or not.
+ The default is t.
BODY: forms to execute just before running the
hooks for the new mode. Do not use `interactive' here.
@@ -194,6 +197,7 @@ See Info node `(elisp)Derived Modes' for more details.
(declare-syntax t)
(hook (derived-mode-hook-name child))
(group nil)
+ (interactive t)
(after-hook nil))
;; Process the keyword args.
@@ -203,6 +207,7 @@ See Info node `(elisp)Derived Modes' for more details.
(:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
(:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
(:after-hook (setq after-hook (pop body)))
+ (:interactive (setq interactive (pop body)))
(_ (pop body))))
(setq docstring (derived-mode-make-docstring
@@ -246,7 +251,7 @@ No problems result if this variable is not bound.
(defun ,child ()
,docstring
- (interactive)
+ ,(and interactive '(interactive))
; Run the parent.
(delay-mode-hooks
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 0d2890999a4..712fa511707 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -43,6 +43,8 @@
;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
(require 'byte-compile "bytecomp")
+(declare-function comp-c-func-name "comp.el")
+
(defvar disassemble-column-1-indent 8 "*")
(defvar disassemble-column-2-indent 10 "*")
@@ -73,8 +75,9 @@ redefine OBJECT if it is a symbol."
(disassemble-internal object indent nil)))
nil)
-
-(defun disassemble-internal (obj indent interactive-p)
+(declare-function native-comp-unit-file "data.c")
+(declare-function subr-native-comp-unit "data.c")
+(cl-defun disassemble-internal (obj indent interactive-p)
(let ((macro 'nil)
(name (when (symbolp obj)
(prog1 obj
@@ -82,7 +85,29 @@ redefine OBJECT if it is a symbol."
args)
(setq obj (autoload-do-load obj name))
(if (subrp obj)
- (error "Can't disassemble #<subr %s>" name))
+ (if (and (fboundp 'subr-native-elisp-p)
+ (subr-native-elisp-p obj))
+ (progn
+ (require 'comp)
+ (call-process "objdump" nil (current-buffer) t "-S"
+ (native-comp-unit-file (subr-native-comp-unit obj)))
+ (goto-char (point-min))
+ (re-search-forward (concat "^.*"
+ (regexp-quote
+ (concat "<"
+ (when (eq system-type 'darwin)
+ "_")
+ (comp-c-func-name
+ (subr-name obj) "F" t)
+ ">:"))))
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (when (re-search-forward "^.*<.*>:" nil t 2)
+ (delete-region (match-beginning 0) (point-max)))
+ (asm-mode)
+ (setq buffer-read-only t)
+ (cl-return-from disassemble-internal))
+ (error "Can't disassemble #<subr %s>" name)))
(if (eq (car-safe obj) 'macro) ;Handle macros.
(setq macro t
obj (cdr obj)))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 2916ae4adea..d9b5ea74f6e 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -84,18 +84,22 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
(defconst easy-mmode--arg-docstring
"
-If called interactively, toggle `%s'. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `%s'
+mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'.
Enable the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `%S'.
+
The mode's hook is called both when the mode is enabled and when
it is disabled.")
-(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym)
+(defun easy-mmode--mode-docstring (doc mode-pretty-name keymap-sym
+ getter)
(let ((doc (or doc (format "Toggle %s on or off.
\\{%s}" mode-pretty-name keymap-sym))))
@@ -104,7 +108,8 @@ it is disabled.")
(let* ((fill-prefix nil)
(docs-fc (bound-and-true-p emacs-lisp-docstring-fill-column))
(fill-column (if (integerp docs-fc) docs-fc 65))
- (argdoc (format easy-mmode--arg-docstring mode-pretty-name))
+ (argdoc (format easy-mmode--arg-docstring mode-pretty-name
+ getter))
(filled (if (fboundp 'fill-region)
(with-temp-buffer
(insert argdoc)
@@ -116,9 +121,9 @@ it is disabled.")
doc nil nil 1)))))
;;;###autoload
-(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
+(defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
;;;###autoload
-(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
+(defmacro define-minor-mode (mode doc &rest body)
"Define a new minor mode MODE.
This defines the toggle command MODE and (by default) a control variable
MODE (you can override this with the :variable keyword, see below).
@@ -139,56 +144,57 @@ documenting what its argument does. If the word \"ARG\" does not
appear in DOC, a paragraph is added to DOC explaining
usage of the mode argument.
-Optional INIT-VALUE is the initial value of the mode's variable.
- Note that the minor mode function won't be called by setting
- this option, so the value *reflects* the minor mode's natural
- initial state, rather than *setting* it.
- In the vast majority of cases it should be nil.
-Optional LIGHTER is displayed in the mode line when the mode is on.
-Optional KEYMAP is the default keymap bound to the mode keymap.
- If non-nil, it should be a variable name (whose value is a keymap),
- or an expression that returns either a keymap or a list of
- (KEY . BINDING) pairs where KEY and BINDING are suitable for
- `define-key'. If you supply a KEYMAP argument that is not a
- symbol, this macro defines the variable MODE-map and gives it
- the value that KEYMAP specifies.
-
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
alternating keywords and values. If you provide BODY, then you must
- provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
- at least one keyword argument, or both; otherwise, BODY would be
- misinterpreted as the first omitted argument. The following special
- keywords are supported (other keywords are passed to `defcustom' if
- the minor mode is global):
+ provide at least one keyword argument (e.g. `:lighter nil`).
+ The following special keywords are supported (other keywords are passed
+ to `defcustom' if the minor mode is global):
-:group GROUP Custom group name to use in all generated `defcustom' forms.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
-:init-value VAL Same as the INIT-VALUE argument.
+:init-value VAL the initial value of the mode's variable.
+ Note that the minor mode function won't be called by setting
+ this option, so the value *reflects* the minor mode's natural
+ initial state, rather than *setting* it.
+ In the vast majority of cases it should be nil.
Not used if you also specify :variable.
-:lighter SPEC Same as the LIGHTER argument.
-:keymap MAP Same as the KEYMAP argument.
-:require SYM Same as in `defcustom'.
+:lighter SPEC Text displayed in the mode line when the mode is on.
+:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'.
+ If non-nil, it should be a variable name (whose value is
+ a keymap), or an expression that returns either a keymap or
+ a list of (KEY . BINDING) pairs where KEY and BINDING are
+ suitable for `define-key'. If you supply a KEYMAP argument
+ that is not a symbol, this macro defines the variable MODE-map
+ and gives it the value that KEYMAP specifies.
+:interactive VAL Whether this mode should be a command or not. The default
+ is to make it one; use nil to avoid that. If VAL is a list,
+ it's interpreted as a list of major modes this minor mode
+ is useful in.
:variable PLACE The location to use instead of the variable MODE to store
the state of the mode. This can be simply a different
named variable, or a generalized variable.
PLACE can also be of the form (GET . SET), where GET is
an expression that returns the current state, and SET is
- a function that takes one argument, the new state, and
- sets it. If you specify a :variable, this function does
- not define a MODE variable (nor any of the terms used
+ a function that takes one argument, the new state, which should
+ be assigned to PLACE. If you specify a :variable, this function
+ does not define a MODE variable (nor any of the terms used
in :variable).
-
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
:lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\"
- ...BODY CODE...)"
+ ...BODY CODE...)
+
+For backward compatibility with the Emacs<21 calling convention,
+the keywords can also be preceded by the obsolete triplet
+INIT-VALUE LIGHTER KEYMAP.
+
+\(fn MODE DOC [KEYWORD VAL ... &rest BODY])"
(declare (doc-string 2)
(debug (&define name string-or-null-p
[&optional [&not keywordp] sexp
@@ -197,23 +203,15 @@ For example, you could write
[&rest [keywordp sexp]]
def-body)))
- ;; Allow skipping the first three args.
- (cond
- ((keywordp init-value)
- (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
- `(,init-value ,lighter))
- init-value nil lighter nil keymap nil))
- ((keywordp lighter)
- (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
- ((keywordp keymap) (push keymap body) (setq keymap nil)))
-
(let* ((last-message (make-symbol "last-message"))
(mode-name (symbol-name mode))
- (pretty-name (easy-mmode-pretty-mode-name mode lighter))
+ (init-value nil)
+ (keymap nil)
+ (lighter nil)
+ (pretty-name nil)
(globalp nil)
(set nil)
(initialize nil)
- (group nil)
(type nil)
(extra-args nil)
(extra-keywords nil)
@@ -221,13 +219,26 @@ For example, you could write
(setter `(setq ,mode)) ;The beginning of the exp to set the mode var.
(getter mode) ;The exp to get the mode value.
(modefun mode) ;The minor mode function name we're defining.
- (require t)
(after-hook nil)
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(hook-off (intern (concat mode-name "-off-hook")))
+ (interactive t)
+ (warnwrap (if (or (null body) (keywordp (car body))) #'identity
+ (lambda (exp)
+ (macroexp-warn-and-return
+ "Use keywords rather than deprecated positional arguments to `define-minor-mode'"
+ exp))))
keyw keymap-sym tmp)
+ ;; Allow BODY to start with the old INIT-VALUE LIGHTER KEYMAP triplet.
+ (unless (keywordp (car body))
+ (setq init-value (pop body))
+ (unless (keywordp (car body))
+ (setq lighter (pop body))
+ (unless (keywordp (car body))
+ (setq keymap (pop body)))))
+
;; Check keys.
(while (keywordp (setq keyw (car body)))
(setq body (cdr body))
@@ -241,10 +252,9 @@ For example, you could write
(:extra-args (setq extra-args (pop body)))
(:set (setq set (list :set (pop body))))
(:initialize (setq initialize (list :initialize (pop body))))
- (:group (setq group (nconc group (list :group (pop body)))))
(:type (setq type (list :type (pop body))))
- (:require (setq require (pop body)))
(:keymap (setq keymap (pop body)))
+ (:interactive (setq interactive (pop body)))
(:variable (setq variable (pop body))
(if (not (and (setq tmp (cdr-safe variable))
(or (symbolp tmp)
@@ -258,13 +268,14 @@ For example, you could write
(:after-hook (setq after-hook (pop body)))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
+ (setq pretty-name (easy-mmode-pretty-mode-name mode lighter))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
(unless set (setq set '(:set #'custom-set-minor-mode)))
(unless initialize
- (setq initialize '(:initialize 'custom-initialize-default)))
+ (setq initialize '(:initialize #'custom-initialize-default)))
;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
(unless type (setq type '(:type 'boolean)))
@@ -295,47 +306,73 @@ or call the function `%s'."))))
,(format base-doc-string pretty-name mode mode)
,@set
,@initialize
- ,@group
,@type
- ,@(unless (eq require t) `(:require ,require))
,@(nreverse extra-keywords)))))
;; The actual function.
- (defun ,modefun (&optional arg ,@extra-args)
- ,(easy-mmode--mode-docstring doc pretty-name keymap-sym)
- ;; Use `toggle' rather than (if ,mode 0 1) so that using
- ;; repeat-command still does the toggling correctly.
- (interactive (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- 'toggle)))
- (let ((,last-message (current-message)))
- (,@setter
- (cond ((eq arg 'toggle)
- (not ,getter))
- ((and (numberp arg)
- (< arg 1))
- nil)
- (t
- t)))
- ,@body
- ;; The on/off hooks are here for backward compatibility only.
- (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
- (if (called-interactively-p 'any)
- (progn
- ,(if (and globalp (not variable))
- `(customize-mark-as-set ',mode))
- ;; Avoid overwriting a message shown by the body,
- ;; but do overwrite previous messages.
- (unless (and (current-message)
- (not (equal ,last-message
- (current-message))))
- (let ((local ,(if globalp "" " in current buffer")))
- (message ,(format "%s %%sabled%%s" pretty-name)
- (if ,getter "en" "dis") local)))))
- ,@(when after-hook `(,after-hook)))
- (force-mode-line-update)
- ;; Return the new setting.
- ,getter)
+ ,(funcall
+ warnwrap
+ `(defun ,modefun (&optional arg ,@extra-args)
+ ,(easy-mmode--mode-docstring doc pretty-name keymap-sym
+ getter)
+ ,(when interactive
+ ;; Use `toggle' rather than (if ,mode 0 1) so that using
+ ;; repeat-command still does the toggling correctly.
+ (if (consp interactive)
+ `(interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle))
+ ,@interactive)
+ '(interactive
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle)))))
+ (let ((,last-message (current-message)))
+ (,@setter
+ (cond ((eq arg 'toggle)
+ (not ,getter))
+ ((and (numberp arg)
+ (< arg 1))
+ nil)
+ (t
+ t)))
+ ;; Keep minor modes list up to date.
+ ,@(if globalp
+ ;; When running this byte-compiled code in earlier
+ ;; Emacs versions, these variables may not be defined
+ ;; there. So check defensively, even if they're
+ ;; always defined in Emacs 28 and up.
+ `((when (boundp 'global-minor-modes)
+ (setq global-minor-modes
+ (delq ',modefun global-minor-modes))
+ (when ,getter
+ (push ',modefun global-minor-modes))))
+ ;; Ditto check.
+ `((when (boundp 'local-minor-modes)
+ (setq local-minor-modes
+ (delq ',modefun local-minor-modes))
+ (when ,getter
+ (push ',modefun local-minor-modes)))))
+ ,@body
+ ;; The on/off hooks are here for backward compatibility only.
+ (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
+ (if (called-interactively-p 'any)
+ (progn
+ ,(if (and globalp (not variable))
+ `(customize-mark-as-set ',mode))
+ ;; Avoid overwriting a message shown by the body,
+ ;; but do overwrite previous messages.
+ (unless (and (current-message)
+ (not (equal ,last-message
+ (current-message))))
+ (let ((local ,(if globalp "" " in current buffer")))
+ (message ,(format "%s %%sabled%%s" pretty-name)
+ (if ,getter "en" "dis") local)))))
+ ,@(when after-hook `(,after-hook)))
+ (force-mode-line-update)
+ ;; Return the new setting.
+ ,getter))
;; Autoloading a define-minor-mode autoloads everything
;; up-to-here.
@@ -377,9 +414,9 @@ No problems result if this variable is not bound.
;;;
;;;###autoload
-(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
+(defalias 'easy-mmode-define-global-mode #'define-globalized-minor-mode)
;;;###autoload
-(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
+(defalias 'define-global-minor-mode #'define-globalized-minor-mode)
;;;###autoload
(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
@@ -460,8 +497,11 @@ on if the hook has explicitly disabled it.
,(concat (format "Toggle %s in all buffers.\n" pretty-name)
(internal--format-docstring-line
"With prefix ARG, enable %s if ARG is positive; otherwise, \
-disable it. If called from Lisp, enable the mode if ARG is omitted or nil.\n\n"
+disable it.\n\n"
pretty-global-name)
+ "If called from Lisp, toggle the mode if ARG is `toggle'.
+Enable the mode if ARG is nil, omitted, or is a positive number.
+Disable the mode if ARG is a negative number.\n\n"
(internal--format-docstring-line
"%s is enabled in all buffers where `%s' would do it.\n\n"
pretty-name turn-on)
@@ -481,12 +521,12 @@ disable it. If called from Lisp, enable the mode if ARG is omitted or nil.\n\n"
(if ,global-mode
(progn
(add-hook 'after-change-major-mode-hook
- ',MODE-enable-in-buffers)
- (add-hook 'find-file-hook ',MODE-check-buffers)
- (add-hook 'change-major-mode-hook ',MODE-cmhh))
- (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
- (remove-hook 'find-file-hook ',MODE-check-buffers)
- (remove-hook 'change-major-mode-hook ',MODE-cmhh))
+ #',MODE-enable-in-buffers)
+ (add-hook 'find-file-hook #',MODE-check-buffers)
+ (add-hook 'change-major-mode-hook #',MODE-cmhh))
+ (remove-hook 'after-change-major-mode-hook #',MODE-enable-in-buffers)
+ (remove-hook 'find-file-hook #',MODE-check-buffers)
+ (remove-hook 'change-major-mode-hook #',MODE-cmhh))
;; Go through existing buffers.
(dolist (buf (buffer-list))
@@ -526,7 +566,7 @@ list."
;; A function which checks whether MODE has been disabled in the major
;; mode hook which has just been run.
- (add-hook ',minor-MODE-hook ',MODE-set-explicitly)
+ (add-hook ',minor-MODE-hook #',MODE-set-explicitly)
;; List of buffers left to process.
(defvar ,MODE-buffers nil)
@@ -553,13 +593,13 @@ list."
(defun ,MODE-check-buffers ()
(,MODE-enable-in-buffers)
- (remove-hook 'post-command-hook ',MODE-check-buffers))
+ (remove-hook 'post-command-hook #',MODE-check-buffers))
(put ',MODE-check-buffers 'definition-name ',global-mode)
;; The function that catches kill-all-local-variables.
(defun ,MODE-cmhh ()
(add-to-list ',MODE-buffers (current-buffer))
- (add-hook 'post-command-hook ',MODE-check-buffers))
+ (add-hook 'post-command-hook #',MODE-check-buffers))
(put ',MODE-cmhh 'definition-name ',global-mode))))
(defun easy-mmode--globalized-predicate-p (predicate)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 5303da3746c..360e685ea00 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -23,6 +23,9 @@
;;; Commentary:
+;; The `easy-menu-define' macro provides a convenient way to define
+;; pop-up menus and/or menu bar menus.
+;;
;; This is compatible with easymenu.el by Per Abrahamsen
;; but it is much simpler as it doesn't try to support other Emacs versions.
;; The code was mostly derived from lmenu.el.
@@ -32,7 +35,6 @@
(defsubst easy-menu-intern (s)
(if (stringp s) (intern s) s))
-;;;###autoload
(defmacro easy-menu-define (symbol maps doc menu)
"Define a pop-up menu and/or menu bar menu specified by MENU.
If SYMBOL is non-nil, define SYMBOL as a function to pop up the
@@ -140,7 +142,7 @@ solely of dashes is displayed as a menu separator.
Alternatively, a menu item can be a list with the same format as
MENU. This is a submenu."
- (declare (indent defun) (debug (symbolp body)))
+ (declare (indent defun) (debug (symbolp body)) (doc-string 3))
`(progn
,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
@@ -163,7 +165,6 @@ This is expected to be bound to a mouse event."
""))
(cons menu props)))))
-;;;###autoload
(defun easy-menu-do-define (symbol maps doc menu)
;; We can't do anything that might differ between Emacs dialects in
;; `easy-menu-define' in order to make byte compiled files
@@ -174,19 +175,24 @@ This is expected to be bound to a mouse event."
(set symbol keymap)
(defalias symbol
(lambda (event) (:documentation doc) (interactive "@e")
- ;; FIXME: XEmacs uses popup-menu which calls the binding
- ;; while x-popup-menu only returns the selection.
(x-popup-menu event
- (or (and (symbolp symbol)
+ (or (and (symbolp keymap)
(funcall
- (or (plist-get (get symbol 'menu-prop)
+ (or (plist-get (get keymap 'menu-prop)
:filter)
- 'identity)
- (symbol-function symbol)))
- symbol)))))
+ #'identity)
+ (symbol-function keymap)))
+ keymap))))
+ ;; These symbols are commands, but not interesting for users
+ ;; to `M-x TAB'.
+ (function-put symbol 'completion-predicate #'ignore))
(dolist (map (if (keymapp maps) (list maps) maps))
(define-key map
- (vector 'menu-bar (easy-menu-intern (car menu)))
+ (vector 'menu-bar (if (symbolp (car menu))
+ (car menu)
+ ;; If a string, then use the downcased
+ ;; version for greater backwards compatibility.
+ (intern (downcase (car menu)))))
(easy-menu-binding keymap (car menu))))))
(defun easy-menu-filter-return (menu &optional name)
@@ -212,7 +218,6 @@ If NAME is provided, it is used for the keymap."
If it holds a list, this is expected to be a list of keys already seen in the
menu we're processing. Else it means we're not processing a menu.")
-;;;###autoload
(defun easy-menu-create-menu (menu-name menu-items)
"Create a menu called MENU-NAME with items described in MENU-ITEMS.
MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
@@ -250,7 +255,7 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
;; anyway, so we'd better not convert it at all (it will
;; be converted on the fly by easy-menu-filter-return).
menu-items
- (append menu (mapcar 'easy-menu-convert-item menu-items))))
+ (append menu (mapcar #'easy-menu-convert-item menu-items))))
(when prop
(setq menu (easy-menu-make-symbol menu 'noexp))
(put menu 'menu-prop prop))
@@ -468,7 +473,6 @@ When non-nil, NOEXP indicates that CALLBACK cannot be an expression
(eval `(lambda () (interactive) ,callback) t)))
command))
-;;;###autoload
(defun easy-menu-change (path name items &optional before map)
"Change menu found at PATH as item NAME to contain ITEMS.
PATH is a list of strings for locating the menu that
@@ -488,14 +492,16 @@ To implement dynamic menus, either call this from
`menu-bar-update-hook' or use a menu filter."
(easy-menu-add-item map path (easy-menu-create-menu name items) before))
-(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1"
+(defalias 'easy-menu-remove #'ignore
"Remove MENU from the current menu bar.
Contrary to XEmacs, this is a nop on Emacs since menus are automatically
\(de)activated when the corresponding keymap is (de)activated.
\(fn MENU)")
+(make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \
+and can be safely removed." "28.1")
-(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1"
+(defalias 'easy-menu-add #'ignore
"Add the menu to the menubar.
On Emacs this is a nop, because menus are already automatically
activated when the corresponding keymap is activated. On XEmacs
@@ -505,6 +511,8 @@ You should call this once the menu and keybindings are set up
completely and menu filter functions can be expected to work.
\(fn MENU &optional MAP)")
+(make-obsolete 'easy-menu-add "this was always a no-op in Emacs \
+and can be safely removed." "28.1")
(defun add-submenu (menu-path submenu &optional before in-menu)
"Add submenu SUBMENU in the menu at MENU-PATH.
@@ -657,7 +665,7 @@ In some cases we use that to select between the local and global maps."
(let* ((name (if path (format "%s" (car (reverse path)))))
(newmap (make-sparse-keymap name)))
(define-key (or map (current-local-map))
- (apply 'vector (mapcar 'easy-menu-intern path))
+ (apply #'vector (mapcar #'easy-menu-intern path))
(if name (cons name newmap) newmap))
newmap))))
(or (keymapp map) (error "Malformed menu in easy-menu: (%s)" map))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 5d595851b9f..7def9ff96a7 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -55,6 +55,7 @@
(require 'backtrace)
(require 'macroexp)
(require 'cl-lib)
+(require 'seq)
(eval-when-compile (require 'pcase))
;;; Options
@@ -100,10 +101,6 @@ variable. You may wish to make it local to each buffer with
`emacs-lisp-mode-hook'."
:type 'boolean)
-;; edebug-all-defs and edebug-all-forms need to be autoloaded
-;; because the byte compiler binds them; as a result, if edebug
-;; is first loaded for a require in a compilation, they will be left unbound.
-
;;;###autoload
(defcustom edebug-all-forms nil
"Non-nil means evaluation of all forms will instrument for Edebug.
@@ -244,19 +241,30 @@ If the result is non-nil, then break. Errors are ignored."
;;; Form spec utilities.
-(defun get-edebug-spec (symbol)
+(defun edebug-get-spec (symbol)
+ "Return the Edebug spec of a given Lisp expression's head SYMBOL.
+The argument is usually a symbol, but it doesn't have to be."
;; Get the spec of symbol resolving all indirection.
(let ((spec nil)
(indirect symbol))
(while
- (progn
- (and (symbolp indirect)
- (setq indirect
- (function-get indirect 'edebug-form-spec 'macro))))
+ (and (symbolp indirect)
+ (setq indirect
+ (function-get indirect 'edebug-form-spec 'macro)))
;; (edebug-trace "indirection: %s" edebug-form-spec)
(setq spec indirect))
spec))
+(define-obsolete-function-alias 'get-edebug-spec #'edebug-get-spec "28.1")
+
+(defun edebug--get-elem-spec (elem)
+ "Return the specs of the Edebug element ELEM, if any.
+ELEM has to be a symbol."
+ (or (get elem 'edebug-elem-spec)
+ ;; For backward compatibility, we also allow the use of
+ ;; a form's name as a shorthand to refer to its spec.
+ (edebug-get-spec elem)))
+
;;;###autoload
(defun edebug-basic-spec (spec)
"Return t if SPEC uses only extant spec symbols.
@@ -445,66 +453,27 @@ the option `edebug-all-forms'."
;; We should somehow arrange to be able to do this
;; without actually replacing the eval-defun command.
-(defun edebug-eval-defun (edebug-it)
- "Evaluate the top-level form containing point, or after point.
-
-If the current defun is actually a call to `defvar', then reset the
-variable using its initial value expression even if the variable
-already has some other value. (Normally `defvar' does not change the
-variable's value if it already has a value.) Treat `defcustom'
-similarly. Reinitialize the face according to `defface' specification.
-
-With a prefix argument, instrument the code for Edebug.
-
-Setting option `edebug-all-defs' to a non-nil value reverses the meaning
+(defun edebug--eval-defun (orig-fun edebug-it)
+ "Setting option `edebug-all-defs' to a non-nil value reverses the meaning
of the prefix argument. Code is then instrumented when this function is
invoked without a prefix argument.
If acting on a `defun' for FUNCTION, and the function was instrumented,
`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
-just FUNCTION is printed.
+just FUNCTION is printed."
+ ;; Re-install our advice, in case `debug' re-bound `load-read-function' to
+ ;; its default value.
+ (add-function :around load-read-function #'edebug--read)
+ (let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs))))
+ (edebug-all-defs edebug-all-forms))
+ (funcall orig-fun nil)))
-If not acting on a `defun', the result of evaluation is displayed in
-the minibuffer."
+(defun edebug-eval-defun (edebug-it)
+ (declare (obsolete "use eval-defun or edebug--eval-defun instead" "28.1"))
(interactive "P")
- (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
- (edebug-result)
- (form
- (let ((edebug-all-forms edebugging)
- (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
- (edebug-read-top-level-form))))
- ;; This should be consistent with `eval-defun-1', but not the
- ;; same, since that gets a macroexpanded form.
- (cond ((and (eq (car form) 'defvar)
- (cdr-safe (cdr-safe form)))
- ;; Force variable to be bound.
- (makunbound (nth 1 form)))
- ((and (eq (car form) 'defcustom)
- (default-boundp (nth 1 form)))
- ;; Force variable to be bound.
- ;; FIXME: Shouldn't this use the :setter or :initializer?
- (set-default (nth 1 form) (eval (nth 2 form) lexical-binding)))
- ((eq (car form) 'defface)
- ;; Reset the face.
- (setq face-new-frame-defaults
- (assq-delete-all (nth 1 form) face-new-frame-defaults))
- (put (nth 1 form) 'face-defface-spec nil)
- (put (nth 1 form) 'face-documentation (nth 3 form))
- ;; See comments in `eval-defun-1' for purpose of code below
- (setq form (prog1 `(prog1 ,form
- (put ',(nth 1 form) 'saved-face
- ',(get (nth 1 form) 'saved-face))
- (put ',(nth 1 form) 'customized-face
- ,(nth 2 form)))
- (put (nth 1 form) 'saved-face nil)))))
- (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding))
- (if (not edebugging)
- (prog1
- (prin1 edebug-result)
- (let ((str (eval-expression-print-format edebug-result)))
- (if str (princ str))))
- edebug-result)))
-
+ (if (advice-member-p #'edebug--eval-defun 'eval-defun)
+ (eval-defun edebug-it)
+ (edebug--eval-defun #'eval-defun edebug-it)))
;;;###autoload
(defalias 'edebug-defun 'edebug-eval-top-level-form)
@@ -576,12 +545,12 @@ already is one.)"
(defun edebug-install-read-eval-functions ()
(interactive)
(add-function :around load-read-function #'edebug--read)
- (advice-add 'eval-defun :override #'edebug-eval-defun))
+ (advice-add 'eval-defun :around #'edebug--eval-defun))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
(remove-function load-read-function #'edebug--read)
- (advice-remove 'eval-defun #'edebug-eval-defun))
+ (advice-remove 'eval-defun #'edebug--eval-defun))
;;; Edebug internal data
@@ -961,6 +930,18 @@ circular objects. Let `read' read everything else."
;;; Cursors for traversal of list and vector elements with offsets.
+;; Edebug's instrumentation is based on parsing the sexps, which come with
+;; auxiliary position information. Instead of keeping the position
+;; information together with the sexps, it is kept in a "parallel
+;; tree" of offsets.
+;;
+;; An "edebug cursor" is a pair of a *list of sexps* (called the
+;; "expressions") together with a matching list of offsets.
+;; When we're parsing the content of a list, the
+;; `edebug-cursor-expressions' is simply the list but when parsing
+;; a vector, the `edebug-cursor-expressions' is a list formed of the
+;; elements of the vector.
+
(defvar edebug-dotted-spec nil
"Set to t when matching after the dot in a dotted spec list.")
@@ -1015,8 +996,8 @@ circular objects. Let `read' read everything else."
;; The following test should always fail.
(if (edebug-empty-cursor cursor)
(edebug-no-match cursor "Not enough arguments."))
- (setcar cursor (cdr (car cursor)))
- (setcdr cursor (cdr (cdr cursor)))
+ (cl-callf cdr (car cursor))
+ (cl-callf cdr (cdr cursor))
cursor)
@@ -1067,8 +1048,6 @@ circular objects. Let `read' read everything else."
;; This data is shared by all embedded definitions.
(defvar edebug-top-window-data)
-(defvar edebug-&optional)
-(defvar edebug-&rest)
(defvar edebug-gate nil) ;; whether no-match forces an error.
(defvar edebug-def-name nil) ; name of definition, used by interactive-form
@@ -1119,8 +1098,6 @@ purpose by adding an entry to this alist, and setting
edebug-top-window-data
edebug-def-name;; make sure it is locally nil
;; I don't like these here!!
- edebug-&optional
- edebug-&rest
edebug-gate
edebug-best-error
edebug-error-point
@@ -1153,7 +1130,7 @@ purpose by adding an entry to this alist, and setting
(eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
;; Find out if this is a defining form from first symbol
(setq def-kind (read (current-buffer))
- spec (and (symbolp def-kind) (get-edebug-spec def-kind))
+ spec (and (symbolp def-kind) (edebug-get-spec def-kind))
defining-form-p (and (listp spec)
(eq '&define (car spec)))
;; This is incorrect in general!! But OK most of the time.
@@ -1164,6 +1141,9 @@ purpose by adding an entry to this alist, and setting
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(let ((result
(cond
+ ;; IIUC, `&define' is treated specially here so as to avoid
+ ;; entering Edebug during the actual function's definition:
+ ;; we only want to enter Edebug later when the thing is called.
(defining-form-p
(if (or edebug-all-defs edebug-all-forms)
;; If it is a defining form and we are edebugging defs,
@@ -1211,26 +1191,12 @@ purpose by adding an entry to this alist, and setting
(funcall edebug-after-instrumentation-function result))))
(defvar edebug-def-args) ; args of defining form.
-(defvar edebug-def-interactive) ; is it an emacs interactive function?
(defvar edebug-inside-func) ;; whether code is inside function context.
;; Currently def-form sets this to nil; def-body sets it to t.
-(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
-
-(defun edebug-interactive-p-name ()
- ;; Return a unique symbol for the variable used to store the
- ;; status of interactive-p for this function.
- (intern (format "edebug-%s-interactive-p" edebug-def-name)))
-
-
-(defun edebug-wrap-def-body (forms)
- "Wrap the FORMS of a definition body."
- (if edebug-def-interactive
- `(let ((,(edebug-interactive-p-name)
- (called-interactively-p 'interactive)))
- ,(edebug-make-enter-wrapper forms))
- (edebug-make-enter-wrapper forms)))
+(defvar edebug-lexical-macro-ctx nil
+ "Alist mapping lexically scoped macro names to their debug spec.")
(defun edebug-make-enter-wrapper (forms)
;; Generate the enter wrapper for some forms of a definition.
@@ -1380,7 +1346,6 @@ contains a circular object."
(edebug-old-def-name (edebug--form-data-name form-data-entry))
edebug-def-name
edebug-def-args
- edebug-def-interactive
edebug-inside-func;; whether wrapped code executes inside a function.
)
@@ -1500,9 +1465,12 @@ contains a circular object."
((consp form)
;; The first offset for a list form is for the list form itself.
(if (eq 'quote (car form))
+ ;; This makes sure we don't instrument 'foo
+ ;; which would cause the debugger to single-step
+ ;; the trivial evaluation of a constant.
form
(let* ((head (car form))
- (spec (and (symbolp head) (get-edebug-spec head)))
+ (spec (and (symbolp head) (edebug-get-spec head)))
(new-cursor (edebug-new-cursor form offset)))
;; Find out if this is a defining form from first symbol.
;; An indirect spec would not work here, yet.
@@ -1542,13 +1510,10 @@ contains a circular object."
(defsubst edebug-list-form-args (head cursor)
;; Process the arguments of a list form given that head of form is a symbol.
;; Helper for edebug-list-form
- (let ((spec (get-edebug-spec head)))
+ (let* ((lex-spec (assq head edebug-lexical-macro-ctx))
+ (spec (if lex-spec (cdr lex-spec)
+ (edebug-get-spec head))))
(cond
- ;; Treat cl-macrolet bindings like macros with no spec.
- ((member head edebug--cl-macrolet-defs)
- (if edebug-eval-macro-args
- (edebug-forms cursor)
- (edebug-sexps cursor)))
(spec
(cond
((consp spec)
@@ -1562,7 +1527,7 @@ contains a circular object."
; but leave it in for compatibility.
))
;; No edebug-form-spec provided.
- ((macrop head)
+ ((or lex-spec (macrop head))
(if edebug-eval-macro-args
(edebug-forms cursor)
(edebug-sexps cursor)))
@@ -1575,10 +1540,7 @@ contains a circular object."
;; The after offset will be left in the cursor after processing the form.
(let ((head (edebug-top-element-required cursor "Expected elements"))
;; Prevent backtracking whenever instrumenting.
- (edebug-gate t)
- ;; A list form is never optional because it matches anything.
- (edebug-&optional nil)
- (edebug-&rest nil))
+ (edebug-gate t))
;; Skip the first offset.
(edebug-set-cursor cursor (edebug-cursor-expressions cursor)
(cdr (edebug-cursor-offsets cursor)))
@@ -1586,11 +1548,6 @@ contains a circular object."
((symbolp head)
(cond
((null head) nil) ; () is valid.
- ((eq head 'interactive-p)
- ;; Special case: replace (interactive-p) with variable
- (setq edebug-def-interactive 'check-it)
- (edebug-move-cursor cursor)
- (edebug-interactive-p-name))
(t
(cons head (edebug-list-form-args
head (edebug-move-cursor cursor))))))
@@ -1628,7 +1585,7 @@ contains a circular object."
(setq edebug-error-point (or edebug-error-point
(edebug-before-offset cursor))
edebug-best-error (or edebug-best-error args))
- (if (and edebug-gate (not edebug-&optional))
+ (if edebug-gate
(progn
(if edebug-error-point
(goto-char edebug-error-point))
@@ -1639,13 +1596,11 @@ contains a circular object."
(defun edebug-match (cursor specs)
;; Top level spec matching function.
;; Used also at each lower level of specs.
- (let (edebug-&optional
- edebug-&rest
- edebug-best-error
+ (let (edebug-best-error
edebug-error-point
(edebug-gate edebug-gate) ;; locally bound to limit effect
)
- (edebug-match-specs cursor specs 'edebug-match-specs)))
+ (edebug-match-specs cursor specs #'edebug-match-specs)))
(defun edebug-match-one-spec (cursor spec)
@@ -1687,10 +1642,10 @@ contains a circular object."
(first-char (and (symbolp spec) (aref (symbol-name spec) 0)))
(match (cond
((eq ?& first-char);; "&" symbols take all following specs.
- (funcall (get-edebug-spec spec) cursor (cdr specs)))
+ (edebug--match-&-spec-op spec cursor (cdr specs)))
((eq ?: first-char);; ":" symbols take one following spec.
(setq rest (cdr (cdr specs)))
- (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
+ (edebug--handle-:-spec-op spec cursor (car (cdr specs))))
(t;; Any other normal spec.
(setq rest (cdr specs))
(edebug-match-one-spec cursor spec)))))
@@ -1721,40 +1676,23 @@ contains a circular object."
;; user may want to define macros or functions with the same names.
;; We could use an internal obarray for these primitive specs.
-(dolist (pair '((&optional . edebug-match-&optional)
- (&rest . edebug-match-&rest)
- (&or . edebug-match-&or)
- (form . edebug-match-form)
+(dolist (pair '((form . edebug-match-form)
(sexp . edebug-match-sexp)
(body . edebug-match-body)
- (&define . edebug-match-&define)
- (name . edebug-match-name)
- (:name . edebug-match-colon-name)
- (:unique . edebug-match-:unique)
(arg . edebug-match-arg)
(def-body . edebug-match-def-body)
(def-form . edebug-match-def-form)
;; Less frequently used:
;; (function . edebug-match-function)
- (lambda-expr . edebug-match-lambda-expr)
- (cl-generic-method-qualifier
- . edebug-match-cl-generic-method-qualifier)
- (cl-generic-method-args . edebug-match-cl-generic-method-args)
- (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
- (cl-macrolet-name . edebug-match-cl-macrolet-name)
- (cl-macrolet-body . edebug-match-cl-macrolet-body)
- (&not . edebug-match-&not)
- (&key . edebug-match-&key)
- (&error . edebug-match-&error)
(place . edebug-match-place)
(gate . edebug-match-gate)
;; (nil . edebug-match-nil) not this one - special case it.
))
- (put (car pair) 'edebug-form-spec (cdr pair)))
+ (put (car pair) 'edebug-elem-spec (cdr pair)))
(defun edebug-match-symbol (cursor symbol)
;; Match a symbol spec.
- (let* ((spec (get-edebug-spec symbol)))
+ (let* ((spec (edebug--get-elem-spec symbol)))
(cond
(spec
(if (consp spec)
@@ -1793,13 +1731,12 @@ contains a circular object."
(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-(defun edebug-match-&optional (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&optional)) cursor specs)
;; Keep matching until one spec fails.
- (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
+ (edebug-&optional-wrapper cursor specs #'edebug-&optional-wrapper))
(defun edebug-&optional-wrapper (cursor specs remainder-handler)
(let (result
- (edebug-&optional specs)
(edebug-gate nil)
(this-form (edebug-cursor-expressions cursor))
(this-offset (edebug-cursor-offsets cursor)))
@@ -1814,20 +1751,24 @@ contains a circular object."
nil)))
-(defun edebug-&rest-wrapper (cursor specs remainder-handler)
- (if (null specs) (setq specs edebug-&rest))
- ;; Reuse the &optional handler with this as the remainder handler.
- (edebug-&optional-wrapper cursor specs remainder-handler))
+(cl-defgeneric edebug--match-&-spec-op (op cursor specs)
+ "Handle &foo spec operators.
+&foo spec operators operate on all the subsequent SPECS.")
-(defun edebug-match-&rest (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&rest)) cursor specs)
;; Repeatedly use specs until failure.
- (let ((edebug-&rest specs) ;; remember these
- edebug-best-error
+ (let (edebug-best-error
edebug-error-point)
- (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
+ ;; Reuse the &optional handler with this as the remainder handler.
+ (edebug-&optional-wrapper
+ cursor specs
+ (lambda (c s rh)
+ ;; `s' is the remaining spec to match.
+ ;; When it's nil, start over matching `specs'.
+ (edebug-&optional-wrapper c (or s specs) rh)))))
-(defun edebug-match-&or (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&or)) cursor specs)
;; Keep matching until one spec succeeds, and return its results.
;; If none match, fail.
;; This needs to be optimized since most specs spend time here.
@@ -1851,24 +1792,49 @@ contains a circular object."
(apply #'edebug-no-match cursor "Expected one of" original-specs))
))
-
-(defun edebug-match-&not (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs)
+ "Compute the specs for `&interpose SPEC FUN ARGS...'.
+Extracts the head of the data by matching it against SPEC,
+and then matches the rest by calling (FUN HEAD PF ARGS...)
+where PF is the parsing function which FUN can call exactly once,
+passing it the specs that it needs to match.
+Note that HEAD will always be a list, since specs are defined to match
+a sequence of elements."
+ (pcase-let*
+ ((`(,spec ,fun . ,args) specs)
+ (exps (edebug-cursor-expressions cursor))
+ (instrumented-head (edebug-match-one-spec cursor spec))
+ (consumed (- (length exps)
+ (length (edebug-cursor-expressions cursor))))
+ (head (seq-subseq exps 0 consumed)))
+ (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
+ (apply fun `(,head
+ ,(lambda (newspecs)
+ ;; FIXME: What'd be the difference if we used
+ ;; `edebug-match-sublist', which is what
+ ;; `edebug-list-form-args' uses for the similar purpose
+ ;; when matching "normal" forms?
+ (append instrumented-head (edebug-match cursor newspecs)))
+ ,@args))))
+
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&not)) cursor specs)
;; If any specs match, then fail
(if (null (catch 'no-match
(let ((edebug-gate nil))
(save-excursion
- (edebug-match-&or cursor specs)))
+ (edebug--match-&-spec-op '&or cursor specs)))
nil))
;; This means something matched, so it is a no match.
(edebug-no-match cursor "Unexpected"))
;; This means nothing matched, so it is OK.
nil) ;; So, return nothing
-(defun edebug-match-&key (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&key)) cursor specs)
;; Following specs must look like (<name> <spec>) ...
;; where <name> is the name of a keyword, and spec is its spec.
;; This really doesn't save much over the expanded form and takes time.
- (edebug-match-&rest
+ (edebug--match-&-spec-op
+ '&rest
cursor
(cons '&or
(mapcar (lambda (pair)
@@ -1876,7 +1842,7 @@ contains a circular object."
(car (cdr pair))))
specs))))
-(defun edebug-match-&error (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&error)) cursor specs)
;; Signal an error, using the following string in the spec as argument.
(let ((error-string (car specs))
(edebug-error-point (edebug-before-offset cursor)))
@@ -1945,19 +1911,15 @@ contains a circular object."
(defun edebug-match-sublist (cursor specs)
;; Match a sublist of specs.
- (let (edebug-&optional
- ;;edebug-best-error
- ;;edebug-error-point
- )
- (prog1
- ;; match with edebug-match-specs so edebug-best-error is not bound.
- (edebug-match-specs cursor specs 'edebug-match-specs)
- (if (not (edebug-empty-cursor cursor))
- (if edebug-best-error
- (apply #'edebug-no-match cursor edebug-best-error)
- ;; A failed &rest or &optional spec may leave some args.
- (edebug-no-match cursor "Failed matching" specs)
- )))))
+ (prog1
+ ;; match with edebug-match-specs so edebug-best-error is not bound.
+ (edebug-match-specs cursor specs 'edebug-match-specs)
+ (if (not (edebug-empty-cursor cursor))
+ (if edebug-best-error
+ (apply #'edebug-no-match cursor edebug-best-error)
+ ;; A failed &rest or &optional spec may leave some args.
+ (edebug-no-match cursor "Failed matching" specs)
+ ))))
(defun edebug-match-string (cursor spec)
@@ -1980,61 +1942,83 @@ contains a circular object."
(defun edebug-match-function (_cursor)
(error "Use function-form instead of function in edebug spec"))
-(defun edebug-match-&define (cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&define)) cursor specs)
;; Match a defining form.
;; Normally, &define is interpreted specially other places.
;; This should only be called inside of a spec list to match the remainder
;; of the current list. e.g. ("lambda" &define args def-body)
- (edebug-make-form-wrapper
- cursor
- (edebug-before-offset cursor)
- ;; Find the last offset in the list.
- (let ((offsets (edebug-cursor-offsets cursor)))
- (while (consp offsets) (setq offsets (cdr offsets)))
- offsets)
- specs))
-
-(defun edebug-match-lambda-expr (cursor)
- ;; The expression must be a function.
- ;; This will match any list form that begins with a symbol
- ;; that has an edebug-form-spec beginning with &define. In
- ;; practice, only lambda expressions should be used.
- ;; I could add a &lambda specification to avoid confusion.
- (let* ((sexp (edebug-top-element-required
- cursor "Expected lambda expression"))
- (offset (edebug-top-offset cursor))
- (head (and (consp sexp) (car sexp)))
- (spec (and (symbolp head) (get-edebug-spec head)))
- (edebug-inside-func nil))
- ;; Find out if this is a defining form from first symbol.
- (if (and (consp spec) (eq '&define (car spec)))
- (prog1
- (list
- (edebug-defining-form
- (edebug-new-cursor sexp offset)
- (car offset);; before the sexp
- (edebug-after-offset cursor)
- (cons (symbol-name head) (cdr spec))))
- (edebug-move-cursor cursor))
- (edebug-no-match cursor "Expected lambda expression")
- )))
-
-
-(defun edebug-match-name (cursor)
- ;; Set the edebug-def-name bound in edebug-defining-form.
- (let ((name (edebug-top-element-required cursor "Expected name")))
- ;; Maybe strings and numbers could be used.
- (if (not (symbolp name))
- (edebug-no-match cursor "Symbol expected for name of definition"))
- (setq edebug-def-name
- (if edebug-def-name
- ;; Construct a new name by appending to previous name.
- (intern (format "%s@%s" edebug-def-name name))
- name))
- (edebug-move-cursor cursor)
- (list name)))
-
-(defun edebug-match-colon-name (_cursor spec)
+ (prog1 (edebug-make-form-wrapper
+ cursor
+ (edebug-before-offset cursor)
+ ;; Find the last offset in the list.
+ (let ((offsets (edebug-cursor-offsets cursor)))
+ (while (consp offsets) (setq offsets (cdr offsets)))
+ offsets)
+ specs)
+ ;; Stop backtracking here (Bug#41988).
+ (setq edebug-gate t)))
+
+(cl-defmethod edebug--match-&-spec-op ((_ (eql '&name)) cursor specs)
+ "Compute the name for `&name SPEC FUN` spec operator.
+
+The full syntax of that operator is:
+ &name [PRESTRING] SPEC [POSTSTRING] FUN ARGS...
+
+Extracts the head of the data by matching it against SPEC,
+and then get the new name to use by calling
+ (FUN ARGS... OLDNAME [PRESTRING] HEAD [POSTSTRING])
+FUN should return either a string or a symbol.
+FUN can be missing in which case it defaults to concatenating
+the new name to the end of the old with an \"@\" char between the two.
+PRESTRING and POSTSTRING are optional strings that get prepended
+or appended to the actual name."
+ (pcase-let*
+ ((`(,spec ,fun . ,args) specs)
+ (prestrings (when (stringp spec)
+ (prog1 (list spec) (setq spec fun fun (pop args)))))
+ (poststrings (when (stringp fun)
+ (prog1 (list fun) (setq fun (pop args)))))
+ (exps (edebug-cursor-expressions cursor))
+ (instrumented (edebug-match-one-spec cursor spec))
+ (consumed (- (length exps)
+ (length (edebug-cursor-expressions cursor))))
+ (newname (apply (or fun #'edebug--concat-name)
+ `(,@args ,edebug-def-name
+ ,@prestrings
+ ,@(seq-subseq exps 0 consumed)
+ ,@poststrings))))
+ (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
+ (setq edebug-def-name (if (stringp newname) (intern newname) newname))
+ instrumented))
+
+(defun edebug--concat-name (oldname &rest newnames)
+ (let ((newname (if (null (cdr newnames))
+ (car newnames)
+ ;; Put spaces between each name, but not for the
+ ;; leading and trailing strings, if any.
+ (let (beg mid end)
+ (dolist (name newnames)
+ (if (stringp name)
+ (push name (if mid end beg))
+ (when end (setq mid (nconc end mid) end nil))
+ (push name mid)))
+ (apply #'concat `(,@(nreverse beg)
+ ,(mapconcat (lambda (x) (format "%s" x))
+ (nreverse mid) " ")
+ ,@(nreverse end)))))))
+ (if (null oldname)
+ (if (or (stringp newname) (symbolp newname))
+ newname
+ (format "%s" newname))
+ (format "%s@%s" edebug-def-name newname))))
+
+(def-edebug-elem-spec 'name '(&name symbolp))
+
+(cl-defgeneric edebug--handle-:-spec-op (op cursor spec)
+ "Handle :foo spec operators.
+:foo spec operators operate on just the one subsequent SPEC element.")
+
+(cl-defmethod edebug--handle-:-spec-op ((_ (eql :name)) _cursor spec)
;; Set the edebug-def-name to the spec.
(setq edebug-def-name
(if edebug-def-name
@@ -2043,7 +2027,7 @@ contains a circular object."
spec))
nil)
-(defun edebug-match-:unique (_cursor spec)
+(cl-defmethod edebug--handle-:-spec-op ((_ (eql :unique)) _cursor spec)
"Match a `:unique PREFIX' specifier.
SPEC is the symbol name prefix for `gensym'."
(let ((suffix (gensym spec)))
@@ -2054,63 +2038,6 @@ SPEC is the symbol name prefix for `gensym'."
suffix)))
nil)
-(defun edebug-match-cl-generic-method-qualifier (cursor)
- "Match a QUALIFIER for `cl-defmethod' at CURSOR."
- (let ((args (edebug-top-element-required cursor "Expected qualifier")))
- ;; Like in CLOS spec, we support any non-list values.
- (unless (atom args) (edebug-no-match cursor "Atom expected"))
- ;; Append the arguments to `edebug-def-name' (Bug#42671).
- (setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
- (edebug-move-cursor cursor)
- (list args)))
-
-(defun edebug-match-cl-generic-method-args (cursor)
- (let ((args (edebug-top-element-required cursor "Expected arguments")))
- (if (not (consp args))
- (edebug-no-match cursor "List expected"))
- ;; Append the arguments to edebug-def-name.
- (setq edebug-def-name
- (intern (format "%s %s" edebug-def-name args)))
- (edebug-move-cursor cursor)
- (list args)))
-
-(defvar edebug--cl-macrolet-defs nil
- "List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
-(defvar edebug--current-cl-macrolet-defs nil
- "List of symbols found within the bindings of the current `cl-macrolet' form.")
-
-(defun edebug-match-cl-macrolet-expr (cursor)
- "Match a `cl-macrolet' form at CURSOR."
- (let (edebug--current-cl-macrolet-defs)
- (edebug-match cursor
- '((&rest (&define cl-macrolet-name cl-macro-list
- cl-declarations-or-string
- def-body))
- cl-declarations cl-macrolet-body))))
-
-(defun edebug-match-cl-macrolet-name (cursor)
- "Match the name in a `cl-macrolet' binding at CURSOR.
-Collect the names in `edebug--cl-macrolet-defs' where they
-will be checked by `edebug-list-form-args' and treated as
-macros without a spec."
- (let ((name (edebug-top-element-required cursor "Expected name")))
- (when (not (symbolp name))
- (edebug-no-match cursor "Bad name:" name))
- ;; Change edebug-def-name to avoid conflicts with
- ;; names at global scope.
- (setq edebug-def-name (gensym "edebug-anon"))
- (edebug-move-cursor cursor)
- (push name edebug--current-cl-macrolet-defs)
- (list name)))
-
-(defun edebug-match-cl-macrolet-body (cursor)
- "Match the body of a `cl-macrolet' expression at CURSOR.
-Put the definitions collected in `edebug--current-cl-macrolet-defs'
-into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
- (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
- edebug--cl-macrolet-defs)))
- (edebug-match-body cursor)))
-
(defun edebug-match-arg (cursor)
;; set the def-args bound in edebug-defining-form
(let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
@@ -2139,151 +2066,135 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
;; This happens to handle bug#20281, tho maybe a better fix would be to
;; improve the `defun' spec.
(when forms
- (list (edebug-wrap-def-body forms)))))
+ (list (edebug-make-enter-wrapper forms)))))
;;;; Edebug Form Specs
;;; ==========================================================
-;;;;* Spec for def-edebug-spec
-;;; Out of date.
-
-(defun edebug-spec-p (object)
- "Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
- (and (symbolp object)
- (get object 'edebug-form-spec)))
-
-(def-edebug-spec def-edebug-spec
- ;; Top level is different from lower levels.
- (&define :name edebug-spec name
- &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
-
-(def-edebug-spec edebug-spec-list
- ;; A list must have something in it, or it is nil, a symbolp
- ((edebug-spec . [&or nil edebug-spec])))
-
-(def-edebug-spec edebug-spec
- (&or
- edebug-spec-list
- (vector &rest edebug-spec) ; matches a vector
- ("vector" &rest edebug-spec) ; matches a vector spec
- ("quote" symbolp)
- stringp
- [edebug-lambda-list-keywordp &rest edebug-spec]
- [keywordp gate edebug-spec]
- edebug-spec-p ;; Including all the special ones e.g. form.
- symbolp;; a predicate
- ))
-
-
;;;* Emacs special forms and some functions.
-;; quote expects only one argument, although it allows any number.
-(def-edebug-spec quote sexp)
+(pcase-dolist
+ (`(,name ,spec)
+
+ '((quote (sexp)) ;quote expects only one arg, tho it allows any number.
+
+ ;; The standard defining forms.
+ (defvar (symbolp &optional form stringp))
+ (defconst defvar)
+
+ ;; Contrary to macros, special forms default to assuming that all args
+ ;; are normal forms, so we don't need to do anything about those
+ ;; special forms:
+ ;;(save-current-buffer t)
+ ;;(save-excursion t)
+ ;;...
+ ;;(progn t)
+
+ ;; `defun' and `defmacro' are not special forms (any more), but it's
+ ;; more convenient to define their Edebug spec here.
+ (defun ( &define name lambda-list lambda-doc
+ [&optional ("declare" def-declarations)]
+ [&optional ("interactive" &optional [&or stringp def-form]
+ &rest symbolp)]
+ def-body))
+
+ (defmacro ( &define name lambda-list lambda-doc
+ [&optional ("declare" def-declarations)]
+ def-body))
+
+ ;; function expects a symbol or a lambda or macro expression
+ ;; A macro is allowed by Emacs.
+ (function (&or symbolp lambda-expr))
+
+ ;; FIXME? The manual uses this form (maybe that's just
+ ;; for illustration purposes?):
+ ;; (let ((&rest &or symbolp (gate symbolp &optional form)) body))
+ (let ((&rest &or (symbolp &optional form) symbolp) body))
+ (let* let)
+
+ (setq (&rest symbolp form))
+ (cond (&rest (&rest form)))
+
+ (condition-case ( symbolp form
+ &rest ([&or symbolp (&rest symbolp)] body)))
+
+ (\` (backquote-form))
+
+ ;; Assume immediate quote in unquotes mean backquote at next
+ ;; higher level.
+ (\, (&or ("quote" edebug-\`) def-form))
+ (\,@ (&define ;; so (,@ form) is never wrapped.
+ &or ("quote" edebug-\`) def-form))
+ ))
+ (put name 'edebug-form-spec spec))
+
+(defun edebug--match-declare-arg (head pf)
+ (funcall pf (get (car head) 'edebug-declaration-spec)))
-;; The standard defining forms.
-(def-edebug-spec defconst defvar)
-(def-edebug-spec defvar (symbolp &optional form stringp))
+(def-edebug-elem-spec 'def-declarations
+ '(&rest &or (&interpose symbolp edebug--match-declare-arg) sexp))
-(def-edebug-spec defun
- (&define name lambda-list lambda-doc
- [&optional ("declare" &rest sexp)]
- [&optional ("interactive" interactive)]
- def-body))
-(def-edebug-spec defmacro
- ;; FIXME: Improve `declare' so we can Edebug gv-expander and
- ;; gv-setter declarations.
- (&define name lambda-list lambda-doc
- [&optional ("declare" &rest sexp)] def-body))
+(def-edebug-elem-spec 'lambda-list
+ '(([&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )))
-(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
+(def-edebug-elem-spec 'lambda-expr
+ '(("lambda" &define lambda-list lambda-doc
+ [&optional ("interactive" interactive)]
+ def-body)))
-(def-edebug-spec lambda-list
- (([&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg]
- )))
+(def-edebug-elem-spec 'arglist '(lambda-list)) ;; deprecated - use lambda-list.
-(def-edebug-spec lambda-doc
- (&optional [&or stringp
- (&define ":documentation" def-form)]))
+(def-edebug-elem-spec 'lambda-doc
+ '(&optional [&or stringp
+ (&define ":documentation" def-form)]))
-(def-edebug-spec interactive
- (&optional &or stringp def-form))
+(def-edebug-elem-spec 'interactive '(&optional [&or stringp def-form]
+ &rest symbolp))
;; A function-form is for an argument that may be a function or a form.
;; This specially recognizes anonymous functions quoted with quote.
-(def-edebug-spec function-form
+(def-edebug-elem-spec 'function-form ;Deprecated, use `form'!
;; form at the end could also handle "function",
;; but recognize it specially to avoid wrapping function forms.
- (&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
-
-;; function expects a symbol or a lambda or macro expression
-;; A macro is allowed by Emacs.
-(def-edebug-spec function (&or symbolp lambda-expr))
-
-;; A macro expression is a lambda expression with "macro" prepended.
-(def-edebug-spec macro (&define "lambda" lambda-list def-body))
-
-;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
-
-;; Standard functions that take function-forms arguments.
-
-;; FIXME? The manual uses this form (maybe that's just for illustration?):
-;; (def-edebug-spec let
-;; ((&rest &or symbolp (gate symbolp &optional form))
-;; body))
-(def-edebug-spec let
- ((&rest &or (symbolp &optional form) symbolp)
- body))
-
-(def-edebug-spec let* let)
-
-(def-edebug-spec setq (&rest symbolp form))
-
-(def-edebug-spec cond (&rest (&rest form)))
-
-(def-edebug-spec condition-case
- (symbolp
- form
- &rest ([&or symbolp (&rest symbolp)] body)))
-
-
-(def-edebug-spec \` (backquote-form))
+ '(&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
;; Supports quotes inside backquotes,
;; but only at the top level inside unquotes.
-(def-edebug-spec backquote-form
- (&or
- ;; Disallow instrumentation of , and ,@ inside a nested backquote, since
- ;; these are likely to be forms generated by a macro being debugged.
- ("`" nested-backquote-form)
- ([&or "," ",@"] &or ("quote" backquote-form) form)
- ;; The simple version:
- ;; (backquote-form &rest backquote-form)
- ;; doesn't handle (a . ,b). The straightforward fix:
- ;; (backquote-form . [&or nil backquote-form])
- ;; uses up too much stack space.
- ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it.
- (backquote-form [&rest [&not ","] backquote-form]
- . [&or nil backquote-form])
- ;; If you use dotted forms in backquotes, replace the previous line
- ;; with the following. This takes quite a bit more stack space, however.
- ;; (backquote-form . [&or nil backquote-form])
- (vector &rest backquote-form)
- sexp))
-
-(def-edebug-spec nested-backquote-form
- (&or
- ("`" &error "Triply nested backquotes (without commas \"between\" them) \
+(def-edebug-elem-spec 'backquote-form
+ '(&or
+ ;; Disallow instrumentation of , and ,@ inside a nested backquote, since
+ ;; these are likely to be forms generated by a macro being debugged.
+ ("`" nested-backquote-form)
+ ([&or "," ",@"] &or ("quote" backquote-form) form)
+ ;; The simple version:
+ ;; (backquote-form &rest backquote-form)
+ ;; doesn't handle (a . ,b). The straightforward fix:
+ ;; (backquote-form . [&or nil backquote-form])
+ ;; uses up too much stack space.
+ ;; Note that `(foo . ,@bar) is not valid, so we don't need to handle it.
+ (backquote-form [&rest [&not ","] backquote-form]
+ . [&or nil backquote-form])
+ ;; If you use dotted forms in backquotes, replace the previous line
+ ;; with the following. This takes quite a bit more stack space, however.
+ ;; (backquote-form . [&or nil backquote-form])
+ (vector &rest backquote-form)
+ sexp))
+
+(def-edebug-elem-spec 'nested-backquote-form
+ '(&or
+ ("`" &error "Triply nested backquotes (without commas \"between\" them) \
are too difficult to instrument")
- ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or
- ;; (\,@ ...) matched on the next line.
- ([&or "," ",@"] backquote-form)
- (nested-backquote-form [&rest [&not "," ",@"] nested-backquote-form]
- . [&or nil nested-backquote-form])
- (vector &rest nested-backquote-form)
- sexp))
+ ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or
+ ;; (\,@ ...) matched on the next line.
+ ([&or "," ",@"] backquote-form)
+ (nested-backquote-form [&rest [&not "," ",@"] nested-backquote-form]
+ . [&or nil nested-backquote-form])
+ (vector &rest nested-backquote-form)
+ sexp))
;; Special version of backquote that instruments backquoted forms
;; destined to be evaluated, usually as the result of a
@@ -2298,20 +2209,9 @@ are too difficult to instrument")
;; ,@ might have some problems.
-(defalias 'edebug-\` '\`) ;; same macro as regular backquote.
-(def-edebug-spec edebug-\` (def-form))
-
-;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec \, (&or ("quote" edebug-\`) def-form))
-(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped.
- &or ("quote" edebug-\`) def-form))
-
-;; New byte compiler.
-
-(def-edebug-spec save-selected-window t)
-(def-edebug-spec save-current-buffer t)
-
-;; Anything else?
+(defmacro edebug-\` (exp)
+ (declare (debug (def-form)))
+ (list '\` exp))
;;; The debugger itself
@@ -2485,11 +2385,10 @@ STATUS should be a list returned by `edebug-var-status'."
(edebug-print-trace-after
(format "%s result: %s" function edebug-result)))))
-(def-edebug-spec edebug-tracing (form body))
-
(defmacro edebug-tracing (msg &rest body)
"Print MSG in *edebug-trace* before and after evaluating BODY.
The result of BODY is also printed."
+ (declare (debug (form body)))
`(let ((edebug-stack-depth (1+ edebug-stack-depth))
edebug-result)
(edebug-print-trace-before ,msg)
@@ -2921,7 +2820,6 @@ See `edebug-behavior-alist' for implementations.")
(defvar edebug-outside-match-data) ; match data outside of edebug
(defvar edebug-backtrace-buffer) ; each recursive edit gets its own
(defvar edebug-inside-windows)
-(defvar edebug-interactive-p)
(defvar edebug-mode-map) ; will be defined fully later.
@@ -2937,7 +2835,6 @@ See `edebug-behavior-alist' for implementations.")
;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
(edebug-recursion-depth (recursion-depth))
edebug-entered ; bind locally to nil
- (edebug-interactive-p nil) ; again non-interactive
edebug-backtrace-buffer ; each recursive edit gets its own
;; The window configuration may be saved and restored
;; during a recursive-edit
@@ -3601,7 +3498,10 @@ canceled the first time the function is entered."
;; Could store this in the edebug data instead.
(put function 'edebug-on-entry (if flag 'temp t)))
-(defalias 'edebug-cancel-edebug-on-entry #'cancel-edebug-on-entry)
+(define-obsolete-function-alias 'edebug-cancel-edebug-on-entry
+ #'edebug-cancel-on-entry "28.1")
+(define-obsolete-function-alias 'cancel-edebug-on-entry
+ #'edebug-cancel-on-entry "28.1")
(defun edebug--edebug-on-entry-functions ()
(let ((functions nil))
@@ -3613,9 +3513,9 @@ canceled the first time the function is entered."
obarray)
functions))
-(defun cancel-edebug-on-entry (function)
+(defun edebug-cancel-on-entry (function)
"Cause Edebug to not stop when FUNCTION is called.
-The removes the effect of `edebug-on-entry'. If FUNCTION is is
+The removes the effect of `edebug-on-entry'. If FUNCTION is
nil, remove `edebug-on-entry' on all functions."
(interactive
(list (let ((name (completing-read
@@ -3801,9 +3701,10 @@ Print result in minibuffer."
(interactive (list (read--expression "Eval: ")))
(princ
(edebug-outside-excursion
- (setq values (cons (edebug-eval expr) values))
- (concat (edebug-safe-prin1-to-string (car values))
- (eval-expression-print-format (car values))))))
+ (let ((result (edebug-eval expr)))
+ (values--store-value result)
+ (concat (edebug-safe-prin1-to-string result)
+ (eval-expression-print-format result))))))
(defun edebug-eval-last-sexp (&optional no-truncate)
"Evaluate sexp before point in the outside environment.
@@ -3936,10 +3837,14 @@ be installed in `emacs-lisp-mode-map'.")
;; Autoloading these global bindings doesn't make sense because
;; they cannot be used anyway unless Edebug is already loaded and active.
-(defvar global-edebug-prefix "\^XX"
+(define-obsolete-variable-alias 'global-edebug-prefix
+ 'edebug-global-prefix "28.1")
+(defvar edebug-global-prefix "\^XX"
"Prefix key for global edebug commands, available from any buffer.")
-(defvar global-edebug-map
+(define-obsolete-variable-alias 'global-edebug-map
+ 'edebug-global-map "28.1")
+(defvar edebug-global-map
(let ((map (make-sparse-keymap)))
(define-key map " " 'edebug-step-mode)
@@ -3972,9 +3877,9 @@ be installed in `emacs-lisp-mode-map'.")
map)
"Global map of edebug commands, available from any buffer.")
-(when global-edebug-prefix
- (global-unset-key global-edebug-prefix)
- (global-set-key global-edebug-prefix global-edebug-map))
+(when edebug-global-prefix
+ (global-unset-key edebug-global-prefix)
+ (global-set-key edebug-global-prefix edebug-global-map))
(defun edebug-help ()
@@ -4216,12 +4121,12 @@ This should be a list of `edebug---frame' objects.")
"Stack frames of the current Edebug Backtrace buffer with instrumentation.
This should be a list of `edebug---frame' objects.")
-;; Data structure for backtrace frames with information
-;; from Edebug instrumentation found in the backtrace.
(cl-defstruct
(edebug--frame
(:constructor edebug--make-frame)
(:include backtrace-frame))
+ "Data structure for backtrace frames with information
+from Edebug instrumentation found in the backtrace."
def-name before-index after-index)
(defun edebug-pop-to-backtrace ()
@@ -4236,7 +4141,8 @@ This should be a list of `edebug---frame' objects.")
(pop-to-buffer edebug-backtrace-buffer)
(unless (derived-mode-p 'backtrace-mode)
(backtrace-mode)
- (add-hook 'backtrace-goto-source-functions #'edebug--backtrace-goto-source))
+ (add-hook 'backtrace-goto-source-functions
+ #'edebug--backtrace-goto-source nil t))
(setq edebug-instrumented-backtrace-frames
(backtrace-get-frames 'edebug-debugger
:constructor #'edebug--make-frame)
@@ -4470,10 +4376,6 @@ It is removed when you hit any char."
(set variable (not (symbol-value variable)))
(message "%s: %s" variable (symbol-value variable)))
-;; We have to require easymenu (even for Emacs 18) just so
-;; the easy-menu-define macro call is compiled correctly.
-(require 'easymenu)
-
(defconst edebug-mode-menus
'("Edebug"
["Stop" edebug-stop t]
@@ -4578,13 +4480,18 @@ With prefix argument, make it a temporary breakpoint."
(add-hook 'called-interactively-p-functions
#'edebug--called-interactively-skip)
(defun edebug--called-interactively-skip (i frame1 frame2)
- (when (and (eq (car-safe (nth 1 frame1)) 'lambda)
- (eq (nth 1 (nth 1 frame1)) '())
- (eq (nth 1 frame2) 'edebug-enter))
+ (when (and (memq (car-safe (nth 1 frame1)) '(lambda closure))
+ ;; Lambda value with no arguments.
+ (null (nth (if (eq (car-safe (nth 1 frame1)) 'lambda) 1 2)
+ (nth 1 frame1)))
+ (memq (nth 1 frame2) '(edebug-enter edebug-default-enter)))
;; `edebug-enter' calls itself on its first invocation.
- (if (eq (nth 1 (backtrace-frame i 'called-interactively-p))
- 'edebug-enter)
- 2 1)))
+ (let ((s 1))
+ (while (memq (nth 1 (backtrace-frame i 'called-interactively-p))
+ '(edebug-enter edebug-default-enter))
+ (cl-incf s)
+ (cl-incf i))
+ s)))
;; Finally, hook edebug into the rest of Emacs.
;; There are probably some other things that could go here.
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index ec1077d447e..ec7c899bddc 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,7 +1,6 @@
;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software
-;;; Foundation, Inc.
+;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
@@ -157,7 +156,7 @@ only one object ever exists."
;; NOTE TO SELF: In next version, make `slot-boundp' support classes
;; with class allocated slots or default values.
(let ((old (oref-default class singleton)))
- (if (eq old eieio-unbound)
+ (if (eq old eieio--unbound)
(oset-default class singleton (cl-call-next-method))
old)))
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index db97d4ca4e8..6d84839c341 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -105,7 +105,7 @@ Summary:
(declare (doc-string 3) (obsolete cl-defmethod "25.1")
(debug
(&define ; this means we are defining something
- [&or name ("setf" name :name setf)]
+ [&name sexp] ;Allow (setf ...) additionally to symbols.
;; ^^ This is the methods symbol
[ &optional symbolp ] ; this is key :before etc
cl-generic-method-args ; arguments
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index a8361c0d4b4..b11ed3333f0 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -71,11 +71,10 @@ Currently under control of this var:
- Define <class>-child-p and <class>-list-p predicates.
- Allow object names in constructors.")
-(defconst eieio-unbound
- (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound))
- eieio-unbound
- (make-symbol "unbound"))
+(define-obsolete-variable-alias 'eieio-unbound 'eieio--unbound "28.1")
+(defvar eieio--unbound (make-symbol "eieio--unbound")
"Uninterned symbol representing an unbound slot in an object.")
+(defvar eieio--unbound-form (macroexp-quote eieio--unbound))
;; This is a bootstrap for eieio-default-superclass so it has a value
;; while it is being built itself.
@@ -169,7 +168,7 @@ Return nil if that option doesn't exist."
(and (recordp obj)
(eieio--class-p (eieio--object-class obj))))
-(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
+(define-obsolete-function-alias 'object-p #'eieio-object-p "25.1")
(defun class-abstract-p (class)
"Return non-nil if CLASS is abstract.
@@ -242,9 +241,9 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
(cl-deftype list-of (elem-type)
`(and list
- (satisfies (lambda (list)
- (cl-every (lambda (elem) (cl-typep elem ',elem-type))
- list)))))
+ (satisfies ,(lambda (list)
+ (cl-every (lambda (elem) (cl-typep elem elem-type))
+ list)))))
(defun eieio-make-class-predicate (class)
@@ -264,6 +263,7 @@ use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
(object-of-class-p obj class))))
(defvar eieio--known-slot-names nil)
+(defvar eieio--known-class-slot-names nil)
(defun eieio-defclass-internal (cname superclasses slots options)
"Define CNAME as a new subclass of SUPERCLASSES.
@@ -347,19 +347,20 @@ See `defclass' for more information."
(when eieio-backward-compatibility
(let ((csym (intern (concat (symbol-name cname) "-list-p"))))
(defalias csym
- `(lambda (obj)
- ,(format
- "Test OBJ to see if it a list of objects which are a child of type %s"
- cname)
- (when (listp obj)
- (let ((ans t)) ;; nil is valid
- ;; Loop over all the elements of the input list, test
- ;; each to make sure it is a child of the desired object class.
- (while (and obj ans)
- (setq ans (and (eieio-object-p (car obj))
- (object-of-class-p (car obj) ,cname)))
- (setq obj (cdr obj)))
- ans))))
+ (lambda (obj)
+ (:documentation
+ (format
+ "Test OBJ to see if it a list of objects which are a child of type %s"
+ cname))
+ (when (listp obj)
+ (let ((ans t)) ;; nil is valid
+ ;; Loop over all the elements of the input list, test
+ ;; each to make sure it is a child of the desired object class.
+ (while (and obj ans)
+ (setq ans (and (eieio-object-p (car obj))
+ (object-of-class-p (car obj) 'cname)))
+ (setq obj (cdr obj)))
+ ans))))
(make-obsolete csym (format
"use (cl-typep ... \\='(list-of %s)) instead"
cname)
@@ -380,7 +381,7 @@ See `defclass' for more information."
(pcase-dolist (`(,name . ,slot) slots)
(let* ((init (or (plist-get slot :initform)
(if (member :initform slot) nil
- eieio-unbound)))
+ eieio--unbound-form)))
(initarg (plist-get slot :initarg))
(docstr (plist-get slot :documentation))
(prot (plist-get slot :protection))
@@ -394,6 +395,14 @@ See `defclass' for more information."
(skip-nil (eieio--class-option-assoc options :allow-nil-initform))
)
+ (unless (or (macroexp-const-p init)
+ (eieio--eval-default-p init))
+ ;; FIXME: We duplicate this test here and in `defclass' because
+ ;; if we move this part to `defclass' we may break some existing
+ ;; code (because the `fboundp' test in `eieio--eval-default-p'
+ ;; returns a different result at compile time).
+ (setq init (macroexp-quote init)))
+
;; Clean up the meaning of protection.
(setq prot
(pcase prot
@@ -456,8 +465,9 @@ See `defclass' for more information."
(n (length slots))
(v (make-vector n nil)))
(dotimes (i n)
- (setf (aref v i) (eieio-default-eval-maybe
- (cl--slot-descriptor-initform (aref slots i)))))
+ (setf (aref v i) (eval
+ (cl--slot-descriptor-initform (aref slots i))
+ t)))
(setf (eieio--class-class-allocation-values newc) v))
;; Attach slot symbols into a hash table, and store the index of
@@ -512,7 +522,7 @@ See `defclass' for more information."
cname
))
-(defsubst eieio-eval-default-p (val)
+(defun eieio--eval-default-p (val)
"Whether the default value VAL should be evaluated for use."
(and (consp val) (symbolp (car val)) (fboundp (car val))))
@@ -521,10 +531,10 @@ See `defclass' for more information."
If SKIPNIL is non-nil, then if default value is nil return t instead."
(let ((value (cl--slot-descriptor-initform slot))
(spec (cl--slot-descriptor-type slot)))
- (if (not (or (eieio-eval-default-p value) ;FIXME: Why?
+ (if (not (or (not (macroexp-const-p value))
eieio-skip-typecheck
(and skipnil (null value))
- (eieio--perform-slot-validation spec value)))
+ (eieio--perform-slot-validation spec (eval value t))))
(signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value)))))
(defun eieio--slot-override (old new skipnil)
@@ -545,7 +555,7 @@ If SKIPNIL is non-nil, then if default value is nil return t instead."
type tp a))
(setf (cl--slot-descriptor-type new) tp))
;; If we have a repeat, only update the initarg...
- (unless (eq d eieio-unbound)
+ (unless (eq d eieio--unbound-form)
(eieio--perform-slot-validation-for-default new skipnil)
(setf (cl--slot-descriptor-initform old) d))
@@ -603,6 +613,8 @@ if default value is nil."
(cold (car (cl-member a (eieio--class-class-slots newc)
:key #'cl--slot-descriptor-name))))
(cl-pushnew a eieio--known-slot-names)
+ (when (eq alloc :class)
+ (cl-pushnew a eieio--known-class-slot-names))
(condition-case nil
(if (sequencep d) (setq d (copy-sequence d)))
;; This copy can fail on a cons cell with a non-cons in the cdr. Let's
@@ -678,7 +690,7 @@ the new child class."
(defun eieio--perform-slot-validation (spec value)
"Return non-nil if SPEC does not match VALUE."
(or (eq spec t) ; t always passes
- (eq value eieio-unbound) ; unbound always passes
+ (eq value eieio--unbound) ; unbound always passes
(cl-typep value spec)))
(defun eieio--validate-slot-value (class slot-idx value slot)
@@ -714,7 +726,7 @@ an error."
INSTANCE is the object being referenced. SLOTNAME is the offending
slot. If the slot is ok, return VALUE.
Argument FN is the function calling this verifier."
- (if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
+ (if (and (eq value eieio--unbound) (not eieio-skip-typecheck))
(slot-unbound instance (eieio--object-class instance) slotname fn)
value))
@@ -729,8 +741,9 @@ Argument FN is the function calling this verifier."
(pcase slot
((and (or `',name (and name (pred keywordp)))
(guard (not (memq name eieio--known-slot-names))))
- (macroexp--warn-and-return
- (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (macroexp-warn-and-return
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
(_ exp))))
(gv-setter eieio-oset))
(cl-check-type slot symbol)
@@ -754,15 +767,30 @@ Argument FN is the function calling this verifier."
(eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
-(defun eieio-oref-default (obj slot)
+(defun eieio-oref-default (class slot)
"Do the work for the macro `oref-default' with similar parameters.
-Fills in OBJ's SLOT with its default value."
- (declare (gv-setter eieio-oset-default))
- (cl-check-type obj (or eieio-object class))
+Fills in CLASS's SLOT with its default value."
+ (declare (gv-setter eieio-oset-default)
+ (compiler-macro
+ (lambda (exp)
+ (ignore class)
+ (pcase slot
+ ((and (or `',name (and name (pred keywordp)))
+ (guard (not (memq name eieio--known-slot-names))))
+ (macroexp-warn-and-return
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
+ ((and (or `',name (and name (pred keywordp)))
+ (guard (not (memq name eieio--known-class-slot-names))))
+ (macroexp-warn-and-return
+ (format-message "Slot `%S' is not class-allocated" name)
+ exp nil 'compile-only))
+ (_ exp)))))
+ (cl-check-type class (or eieio-object class))
(cl-check-type slot symbol)
- (let* ((cl (cond ((symbolp obj) (cl--find-class obj))
- ((eieio-object-p obj) (eieio--object-class obj))
- (t obj)))
+ (let* ((cl (cond ((symbolp class) (cl--find-class class))
+ ((eieio-object-p class) (eieio--object-class class))
+ (t class)))
(c (eieio--slot-name-index cl slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
@@ -772,27 +800,13 @@ Fills in OBJ's SLOT with its default value."
;; Oref that slot.
(aref (eieio--class-class-allocation-values cl)
c)
- (slot-missing obj slot 'oref-default))
+ (slot-missing class slot 'oref-default))
(eieio-barf-if-slot-unbound
(let ((val (cl--slot-descriptor-initform
(aref (eieio--class-slots cl)
(- c (eval-when-compile eieio--object-num-slots))))))
- (eieio-default-eval-maybe val))
- obj (eieio--class-name cl) 'oref-default))))
-
-(defun eieio-default-eval-maybe (val)
- "Check VAL, and return what `oref-default' would provide."
- ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate
- ;; variables as well? Why not just always call `eval'?
- (cond
- ;; Is it a function call? If so, evaluate it.
- ((eieio-eval-default-p val)
- (eval val))
- ;;;; check for quoted things, and unquote them
- ;;((and (consp val) (eq (car val) 'quote))
- ;; (car (cdr val)))
- ;; return it verbatim
- (t val)))
+ (eval val t))
+ class (eieio--class-name cl) 'oref-default))))
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
@@ -819,6 +833,21 @@ Fills in OBJ's SLOT with VALUE."
(defun eieio-oset-default (class slot value)
"Do the work for the macro `oset-default'.
Fills in the default value in CLASS' in SLOT with VALUE."
+ (declare (compiler-macro
+ (lambda (exp)
+ (ignore class value)
+ (pcase slot
+ ((and (or `',name (and name (pred keywordp)))
+ (guard (not (memq name eieio--known-slot-names))))
+ (macroexp-warn-and-return
+ (format-message "Unknown slot `%S'" name)
+ exp nil 'compile-only))
+ ((and (or `',name (and name (pred keywordp)))
+ (guard (not (memq name eieio--known-class-slot-names))))
+ (macroexp-warn-and-return
+ (format-message "Slot `%S' is not class-allocated" name)
+ exp nil 'compile-only))
+ (_ exp)))))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(cl-check-type slot symbol)
@@ -835,22 +864,18 @@ Fills in the default value in CLASS' in SLOT with VALUE."
(signal 'invalid-slot-name (list (eieio--class-name class) slot)))
;; `oset-default' on an instance-allocated slot is allowed by EIEIO but
;; not by CLOS and is mildly inconsistent with the :initform thingy, so
- ;; it'd be nice to get of it. This said, it is/was used at one place by
- ;; gnus/registry.el, so it might be used elsewhere as well, so let's
- ;; keep it for now.
+ ;; it'd be nice to get rid of it.
+ ;; This said, it is/was used at one place by gnus/registry.el, so it
+ ;; might be used elsewhere as well, so let's keep it for now.
;; FIXME: Generate a compile-time warning for it!
;; (error "Can't `oset-default' an instance-allocated slot: %S of %S"
;; slot class)
(eieio--validate-slot-value class c value slot)
;; Set this into the storage for defaults.
- (if (eieio-eval-default-p value)
- (error "Can't set default to a sexp that gets evaluated again"))
(setf (cl--slot-descriptor-initform
- ;; FIXME: Apparently we set it both in `slots' and in
- ;; `object-cache', which seems redundant.
(aref (eieio--class-slots class)
(- c (eval-when-compile eieio--object-num-slots))))
- value)
+ (macroexp-quote value))
;; Take the value, and put it into our cache object.
(eieio-oset (eieio--class-default-object-cache class)
slot value)
@@ -1029,7 +1054,7 @@ method invocation orders of the involved classes."
(eieio--class-precedence-c3 class))))))
(define-obsolete-function-alias
- 'class-precedence-list 'eieio--class-precedence-list "24.4")
+ 'class-precedence-list #'eieio--class-precedence-list "24.4")
;;; Here are some special types of errors
@@ -1092,8 +1117,20 @@ These match if the argument is the name of a subclass of CLASS."
(defmacro eieio-declare-slots (&rest slots)
"Declare that SLOTS are known eieio object slot names."
- `(eval-when-compile
- (setq eieio--known-slot-names (append ',slots eieio--known-slot-names))))
+ (let ((slotnames (mapcar (lambda (s) (if (consp s) (car s) s)) slots))
+ (classslots (delq nil
+ (mapcar (lambda (s)
+ (when (and (consp s)
+ (eq :class (plist-get (cdr s)
+ :allocation)))
+ (car s)))
+ slots))))
+ `(eval-when-compile
+ ,@(when classslots
+ (mapcar (lambda (s) `(add-to-list 'eieio--known-class-slot-names ',s))
+ classslots))
+ ,@(mapcar (lambda (s) `(add-to-list 'eieio--known-slot-names ',s))
+ slotnames))))
(provide 'eieio-core)
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 184b99fdac6..d7d078b2d94 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -1,4 +1,4 @@
-;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*-
+;;; eieio-custom.el --- eieio object customization -*- lexical-binding:t -*-
;; Copyright (C) 1999-2001, 2005, 2007-2021 Free Software Foundation,
;; Inc.
@@ -46,7 +46,7 @@
:documentation "A string for testing custom.
This is the next line of documentation.")
(listostuff :initarg :listostuff
- :initform ("1" "2" "3")
+ :initform '("1" "2" "3")
:type list
:custom (repeat (string :tag "Stuff"))
:label "List of Strings"
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index e65f424cbab..9c842f46829 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,4 +1,4 @@
-;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
+;;; eieio-opt.el --- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
;; Foundation, Inc.
@@ -323,7 +323,7 @@ current expansion depth."
(defun eieio-sb-expand (text class indent)
"For button TEXT, expand CLASS at the current location.
Argument INDENT is the depth of indentation."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -332,7 +332,7 @@ Argument INDENT is the depth of indentation."
(while subclasses
(eieio-class-button (car subclasses) (1+ indent))
(setq subclasses (cdr subclasses)))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index 8bf77e20dfa..86b22cad73b 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -1,4 +1,4 @@
-;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*-
+;;; eieio-speedbar.el --- Classes for managing speedbar displays. -*- lexical-binding:t -*-
;; Copyright (C) 1999-2002, 2005, 2007-2021 Free Software Foundation,
;; Inc.
@@ -248,7 +248,7 @@ and take the appropriate action."
Possible values are those symbols supported by the `exp-button-type' argument
to `speedbar-make-tag-line'."
:allocation :class)
- (buttonface :initform speedbar-tag-face
+ (buttonface :initform 'speedbar-tag-face
:type (or symbol face)
:documentation
"The face used on the textual part of the button for this class.
@@ -265,15 +265,15 @@ Add one of the child classes to this class to the parent list of a class."
:abstract t)
(defclass eieio-speedbar-directory-button (eieio-speedbar)
- ((buttontype :initform angle)
- (buttonface :initform speedbar-directory-face))
+ ((buttontype :initform 'angle)
+ (buttonface :initform 'speedbar-directory-face))
"Class providing support for objects which behave like a directory."
:method-invocation-order :depth-first
:abstract t)
(defclass eieio-speedbar-file-button (eieio-speedbar)
- ((buttontype :initform bracket)
- (buttonface :initform speedbar-file-face))
+ ((buttontype :initform 'bracket)
+ (buttonface :initform 'speedbar-file-face))
"Class providing support for objects which behave like a file."
:method-invocation-order :depth-first
:abstract t)
@@ -344,14 +344,14 @@ The object is at indentation level INDENT."
(defun eieio-speedbar-object-expand (text token indent)
"Expand object represented by TEXT.
TOKEN is the object. INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(oset token expanded t)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(eieio-speedbar-expand token (1+ indent)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(oset token expanded nil)
(speedbar-delete-subblock indent))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index a095ad0f6db..c16d8e110ec 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -53,6 +53,7 @@
(message eieio-version))
(require 'eieio-core)
+(eval-when-compile (require 'subr-x))
;;; Defining a new class
@@ -131,6 +132,7 @@ and reference them using the function `class-option'."
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
(testsym2 (intern (format "%s--eieio-childp" name)))
+ (warnings '())
(accessors ()))
;; Collect the accessors we need to define.
@@ -145,6 +147,8 @@ and reference them using the function `class-option'."
;; Update eieio--known-slot-names already in case we compile code which
;; uses this before the class is loaded.
(cl-pushnew sname eieio--known-slot-names)
+ (when (eq alloc :class)
+ (cl-pushnew sname eieio--known-class-slot-names))
(if eieio-error-unsupported-class-tags
(let ((tmp soptions))
@@ -176,8 +180,22 @@ and reference them using the function `class-option'."
(signal 'invalid-slot-type (list :label label)))
;; Is there an initarg, but allocation of class?
- (if (and initarg (eq alloc :class))
- (message "Class allocated slots do not need :initarg"))
+ (when (and initarg (eq alloc :class))
+ (push (format "Meaningless :initarg for class allocated slot '%S'"
+ sname)
+ warnings))
+
+ (let ((init (plist-get soptions :initform)))
+ (unless (or (macroexp-const-p init)
+ (eieio--eval-default-p init))
+ ;; FIXME: Historically, EIEIO used a heuristic to try and guess
+ ;; whether the initform is a form to be evaluated or just
+ ;; a constant. We use `eieio--eval-default-p' to see what the
+ ;; heuristic says and if it disagrees with normal evaluation
+ ;; then tweak the initform to make it fit and emit
+ ;; a warning accordingly.
+ (push (format "Ambiguous initform needs quoting: %S" init)
+ warnings)))
;; Anyone can have an accessor function. This creates a function
;; of the specified name, and also performs a `defsetf' if applicable
@@ -223,6 +241,9 @@ This method is obsolete."
))
`(progn
+ ,@(mapcar (lambda (w)
+ (macroexp-warn-and-return w `(progn ',w) nil 'compile-only))
+ warnings)
;; This test must be created right away so we can have self-
;; referencing classes. ei, a class whose slot can contain only
;; pointers to itself.
@@ -233,7 +254,7 @@ This method is obsolete."
,@(when eieio-backward-compatibility
(let ((f (intern (format "%s-child-p" name))))
- `((defalias ',f ',testsym2)
+ `((defalias ',f #',testsym2)
(make-obsolete
',f ,(format "use (cl-typep ... \\='%s) instead" name)
"25.1"))))
@@ -269,7 +290,7 @@ This method is obsolete."
(lambda (whole)
(if (not (stringp (car slots)))
whole
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(format "Obsolete name arg %S to constructor %S"
(car slots) (car whole))
;; Keep the name arg, for backward compatibility,
@@ -282,23 +303,19 @@ This method is obsolete."
;;; Get/Set slots in an object.
;;
(defmacro oref (obj slot)
- "Retrieve the value stored in OBJ in the slot named by SLOT.
-Slot is the name of the slot when created by `defclass' or the label
-created by the :initarg tag."
+ "Retrieve the value stored in OBJ in the slot named by SLOT."
(declare (debug (form symbolp)))
`(eieio-oref ,obj (quote ,slot)))
-(defalias 'slot-value 'eieio-oref)
-(defalias 'set-slot-value 'eieio-oset)
+(defalias 'slot-value #'eieio-oref)
+(defalias 'set-slot-value #'eieio-oset)
(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
-(defmacro oref-default (obj slot)
- "Get the default value of OBJ (maybe a class) for SLOT.
-The default value is the value installed in a class with the :initform
-tag. SLOT can be the slot name, or the tag specified by the :initarg
-tag in the `defclass' call."
+(defmacro oref-default (class slot)
+ "Get the value of class allocated slot SLOT.
+CLASS can also be an object, in which case we use the object's class."
(declare (debug (form symbolp)))
- `(eieio-oref-default ,obj (quote ,slot)))
+ `(eieio-oref-default ,class (quote ,slot)))
;;; Handy CLOS macros
;;
@@ -418,7 +435,7 @@ If EXTRA, include that in the string returned to represent the symbol."
(cl-check-type obj eieio-object)
(eieio-class-name (eieio--object-class obj)))
(define-obsolete-function-alias
- 'object-class-name 'eieio-object-class-name "24.4")
+ 'object-class-name #'eieio-object-class-name "24.4")
(defun eieio-class-parents (class)
;; FIXME: What does "(overload of variable)" mean here?
@@ -446,7 +463,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
(defmacro eieio-class-parent (class)
"Return first parent class to CLASS. (overload of variable)."
`(car (eieio-class-parents ,class)))
-(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4")
+(define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4")
(defun same-class-p (obj class)
"Return t if OBJ is of class-type CLASS."
@@ -461,7 +478,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
;; class will be checked one layer down
(child-of-class-p (eieio--object-class obj) class))
;; Backwards compatibility
-(defalias 'obj-of-class-p 'object-of-class-p)
+(defalias 'obj-of-class-p #'object-of-class-p)
(defun child-of-class-p (child class)
"Return non-nil if CHILD class is a subclass of CLASS."
@@ -538,11 +555,11 @@ OBJECT can be an instance or a class."
((eieio-object-p object) (eieio-oref object slot))
((symbolp object) (eieio-oref-default object slot))
(t (signal 'wrong-type-argument (list 'eieio-object-p object))))
- eieio-unbound))))
+ eieio--unbound))))
(defun slot-makeunbound (object slot)
"In OBJECT, make SLOT unbound."
- (eieio-oset object slot eieio-unbound))
+ (eieio-oset object slot eieio--unbound))
(defun slot-exists-p (object-or-class slot)
"Return non-nil if OBJECT-OR-CLASS has SLOT."
@@ -665,7 +682,7 @@ This class is not stored in the `parent' slot of a class vector."
(setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
(define-obsolete-function-alias 'standard-class
- 'eieio-default-superclass "26.1")
+ #'eieio-default-superclass "26.1")
(cl-defgeneric make-instance (class &rest initargs)
"Make a new instance of CLASS based on INITARGS.
@@ -725,35 +742,37 @@ Called from the constructor routine."
"Construct the new object THIS based on SLOTS.")
(cl-defmethod initialize-instance ((this eieio-default-superclass)
- &optional slots)
- "Construct the new object THIS based on SLOTS.
-SLOTS is a tagged list where odd numbered elements are tags, and
+ &optional args)
+ "Construct the new object THIS based on ARGS.
+ARGS is a property list where odd numbered elements are tags, and
even numbered elements are the values to store in the tagged slot.
If you overload the `initialize-instance', there you will need to
call `shared-initialize' yourself, or you can call `call-next-method'
to have this constructor called automatically. If these steps are
not taken, then new objects of your class will not have their values
-dynamically set from SLOTS."
- ;; First, see if any of our defaults are `lambda', and
- ;; re-evaluate them and apply the value to our slots.
+dynamically set from ARGS."
(let* ((this-class (eieio--object-class this))
+ (initargs args)
(slots (eieio--class-slots this-class)))
(dotimes (i (length slots))
- ;; For each slot, see if we need to evaluate it.
- ;;
- ;; Paul Landes said in an email:
- ;; > CL evaluates it if it can, and otherwise, leaves it as
- ;; > the quoted thing as you already have. This is by the
- ;; > Sonya E. Keene book and other things I've look at on the
- ;; > web.
+ ;; For each slot, see if we need to evaluate its initform.
(let* ((slot (aref slots i))
- (initform (cl--slot-descriptor-initform slot))
- (dflt (eieio-default-eval-maybe initform)))
- (when (not (eq dflt initform))
- ;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!
- (eieio-oset this (cl--slot-descriptor-name slot) dflt)))))
- ;; Shared initialize will parse our slots for us.
- (shared-initialize this slots))
+ (slot-name (eieio-slot-descriptor-name slot))
+ (initform (cl--slot-descriptor-initform slot)))
+ (unless (or (when-let ((initarg
+ (car (rassq slot-name
+ (eieio--class-initarg-tuples
+ this-class)))))
+ (plist-get initargs initarg))
+ ;; Those slots whose initform is constant already have
+ ;; the right value set in the default-object.
+ (macroexp-const-p initform))
+ ;; FIXME: Use `aset' instead of `eieio-oset', relying on that
+ ;; vector returned by `eieio--class-slots'
+ ;; should be congruent with the object itself.
+ (eieio-oset this slot-name (eval initform t))))))
+ ;; Shared initialize will parse our args for us.
+ (shared-initialize this args))
(cl-defgeneric slot-missing (object slot-name _operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.
@@ -972,13 +991,13 @@ this object."
This may create or delete slots, but does not affect the return value
of `eq'."
(error "EIEIO: `change-class' is unimplemented"))
-(define-obsolete-function-alias 'change-class 'eieio-change-class "26.1")
+(define-obsolete-function-alias 'change-class #'eieio-change-class "26.1")
;; Hook ourselves into help system for describing classes and methods.
;; FIXME: This is not actually needed any more since we can click on the
;; hyperlink from the constructor's docstring to see the type definition.
-(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
+(add-hook 'help-fns-describe-function-functions #'eieio-help-constructor)
(provide 'eieio)
-;;; eieio ends here
+;;; eieio.el ends here
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 90e075b1102..cec89cf3bc5 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -63,7 +63,7 @@ If this variable is set to 0, no idle time is required."
:type 'number)
(defcustom eldoc-print-after-edit nil
- "If non-nil eldoc info is only shown when editing.
+ "If non-nil, eldoc info is only shown when editing.
Changing the value requires toggling `eldoc-mode'."
:type 'boolean)
@@ -100,7 +100,7 @@ If the value is a positive number, it is used to calculate a
number of logical lines of documentation that ElDoc is allowed to
put in the echo area. If a positive integer, the number is used
directly, while a float specifies the number of lines as a
-proporting of the echo area frame's height.
+proportion of the echo area frame's height.
If value is the symbol `truncate-sym-name-if-fit' t, the part of
the doc string that represents a symbol's name may be truncated
@@ -248,7 +248,8 @@ expression point is on." :lighter eldoc-minor-mode-string
#'elisp-eldoc-var-docstring nil t)
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-funcall nil t)
- (setq eldoc-documentation-strategy 'eldoc-documentation-default)))
+ (setq-local eldoc-documentation-strategy
+ 'eldoc-documentation-default)))
(eldoc-mode +1))
;;;###autoload
@@ -390,12 +391,12 @@ name, inside its arg list, or on any object with some associated
information.
Each hook function is called with at least one argument CALLBACK,
-a function, and decides whether to display a doc short string
+a function, and decides whether to display a short doc string
about the context around point.
- If that decision can be taken quickly, the hook function may
- call CALLBACK immediately following the protocol described
- below. Alternatively it may ignore CALLBACK entirely and
+ call CALLBACK immediately, following the protocol described
+ below. Alternatively, it may ignore CALLBACK entirely and
return either the doc string, or nil if there's no doc
appropriate for the context.
@@ -537,7 +538,7 @@ documentation to potentially appear in the echo are is truncated."
(and truncatedp
(eq eldoc-echo-area-prefer-doc-buffer
'maybe)))
- (get-buffer-window eldoc--doc-buffer)))
+ (get-buffer-window eldoc--doc-buffer 'visible)))
(defun eldoc-display-in-echo-area (docs _interactive)
"Display DOCS in echo area.
@@ -687,11 +688,11 @@ following values are allowed:
- `eldoc-documentation-compose': calls all functions in the
special hook and displays all of the resulting doc strings
together. Wait for all strings to be ready, and preserve their
- relative as specified by the order of functions in the hook;
+ relative order as specified by the order of functions in the hook;
- `eldoc-documentation-compose-eagerly': calls all functions in
- the special hook and display as many of the resulting doc
- strings as possible, as soon as possibl. Preserving the
+ the special hook and displays as many of the resulting doc
+ strings as possible, as soon as possible. Preserves the
relative order of doc strings;
- `eldoc-documentation-enthusiast': calls all functions in the
@@ -792,7 +793,7 @@ function passes responsibility to the functions in
Other third-party values of `eldoc-documentation-strategy' should
not use `eldoc--make-callback'. They must find some alternate
way to produce callbacks to feed to
-`eldoc-documentation-function' and should endeavour to display
+`eldoc-documentation-functions' and should endeavour to display
the docstrings eventually produced, using
`eldoc-display-functions'."
(let* (;; How many callbacks have been created by the strategy
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index cc2927caf40..c2b026dc822 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -1,7 +1,6 @@
;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 1997-1998, 2001-2021 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw
;; Maintainer: emacs-devel@gnu.org
@@ -30,8 +29,8 @@
;; hacks those functions so that profiling information is recorded
;; whenever they are called. To print out the current results, use
;; M-x elp-results. If you want output to go to standard-output
-;; instead of a separate buffer, setq elp-use-standard-output to
-;; non-nil. With elp-reset-after-results set to non-nil, profiling
+;; instead of a separate buffer, set `elp-use-standard-output' to
+;; non-nil. With `elp-reset-after-results' set to non-nil, profiling
;; information will be reset whenever the results are displayed. You
;; can also reset all profiling info at any time with M-x
;; elp-reset-all.
@@ -40,12 +39,12 @@
;; the package follows the GNU coding standard of a common textual
;; prefix. Use M-x elp-instrument-package for this.
;;
-;; If you want to sort the results, set elp-sort-by-function to some
+;; If you want to sort the results, set `elp-sort-by-function' to some
;; predicate function. The three most obvious choices are predefined:
-;; elp-sort-by-call-count, elp-sort-by-average-time, and
-;; elp-sort-by-total-time. Also, you can prune from the output, all
+;; `elp-sort-by-call-count', `elp-sort-by-average-time', and
+;; `elp-sort-by-total-time'. Also, you can prune from the output, all
;; functions that have been called fewer than a given number of times
-;; by setting elp-report-limit.
+;; by setting `elp-report-limit'.
;;
;; Elp can instrument byte-compiled functions just as easily as
;; interpreted functions, but it cannot instrument macros. However,
@@ -95,11 +94,11 @@
;; Note that there are plenty of factors that could make the times
;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
+;; system clock, and the overhead spent in Lisp calculating and
;; recording the intervals. I figure the latter is pretty constant,
;; so while the times may not be entirely accurate, I think they'll
;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling. Note further that times
+;; various Lisp routines you are profiling. Note further that times
;; are calculated using wall-clock time, so other system load will
;; affect accuracy too.
@@ -404,15 +403,15 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
(defvar elp-et-len nil)
(defun elp-sort-by-call-count (vec1 vec2)
- ;; sort by highest call count. See `sort'.
+ "Predicate to sort by highest call count. See `sort'."
(>= (aref vec1 0) (aref vec2 0)))
(defun elp-sort-by-total-time (vec1 vec2)
- ;; sort by highest total time spent in function. See `sort'.
+ "Predicate to sort by highest total time spent in function. See `sort'."
(>= (aref vec1 1) (aref vec2 1)))
(defun elp-sort-by-average-time (vec1 vec2)
- ;; sort by highest average time spent in function. See `sort'.
+ "Predicate to sort by highest average time spent in function. See `sort'."
(>= (aref vec1 2) (aref vec2 2)))
(defsubst elp-pack-number (number width)
@@ -470,13 +469,13 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
"Keymap used on the function name column." )
(defun elp-results-jump-to-definition (&optional event)
- "Jump to the definition of the function under the point."
+ "Jump to the definition of the function at point."
(interactive (list last-nonmenu-event))
(if event (posn-set-point (event-end event)))
(find-function (get-text-property (point) 'elp-symname)))
(defun elp-output-insert-symname (symname)
- ;; Insert SYMNAME with text properties.
+ "Insert SYMNAME with text properties."
(insert (propertize symname
'elp-symname (intern symname)
'keymap elp-results-symname-map
@@ -484,6 +483,10 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
'face 'link
'help-echo "mouse-2 or RET jumps to definition")))
+(define-derived-mode elp-results-mode special-mode "ELP"
+ "Mode for ELP results."
+ :interactive nil)
+
;;;###autoload
(defun elp-results ()
"Display current profiling results.
@@ -491,11 +494,12 @@ If `elp-reset-after-results' is non-nil, then current profiling
information for all instrumented functions is reset after results are
displayed."
(interactive)
- (let ((curbuf (current-buffer))
- (resultsbuf (if elp-recycle-buffers-p
- (get-buffer-create elp-results-buffer)
- (generate-new-buffer elp-results-buffer))))
- (set-buffer resultsbuf)
+ (pop-to-buffer
+ (if elp-recycle-buffers-p
+ (get-buffer-create elp-results-buffer)
+ (generate-new-buffer elp-results-buffer)))
+ (elp-results-mode)
+ (let ((inhibit-read-only t))
(erase-buffer)
;; get the length of the longest function name being profiled
(let* ((longest 0)
@@ -566,9 +570,6 @@ displayed."
(if elp-sort-by-function
(setq resvec (sort resvec elp-sort-by-function)))
(mapc 'elp-output-result resvec))
- ;; now pop up results buffer
- (set-buffer curbuf)
- (pop-to-buffer resultsbuf)
;; copy results to standard-output?
(if (or elp-use-standard-output noninteractive)
(princ (buffer-substring (point-min) (point-max)))
@@ -583,11 +584,10 @@ displayed."
;; continue standard unloading
nil)
-(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun)))
+(cl-defmethod loadhist-unload-element :extra "elp" :before ((x (head defun)))
"Un-instrument before unloading a function."
(elp-restore-function (cdr x)))
-
(provide 'elp)
;;; elp.el ends here
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index d058d3dda0b..59ec4d24849 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -98,19 +98,10 @@ To be used in ERT tests. If BODY finishes successfully, the test
buffer is killed; if there is an error, the test buffer is kept
around on error for further inspection. Its name is derived from
the name of the test and the result of NAME-FORM."
- (declare (debug ((":name" form) body))
+ (declare (debug ((":name" form) def-body))
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
-;; We use these `put' forms in addition to the (declare (indent)) in
-;; the defmacro form since the `declare' alone does not lead to
-;; correct indentation before the .el/.elc file is loaded.
-;; Autoloading these `put' forms solves this.
-;;;###autoload
-(progn
- ;; TODO(ohler): Figure out what these mean and make sure they are correct.
- (put 'ert-with-test-buffer 'lisp-indent-function 1))
-
;;;###autoload
(defun ert-kill-all-test-buffers ()
"Kill all test buffers that are still live."
@@ -376,8 +367,7 @@ different resource directory naming scheme, set the variable
name will be trimmed using `string-trim' with arguments
`ert-resource-directory-trim-left-regexp' and
`ert-resource-directory-trim-right-regexp'."
- `(let* ((testfile ,(or (bound-and-true-p byte-compile-current-file)
- (and load-in-progress load-file-name)
+ `(let* ((testfile ,(or (macroexp-file-name)
buffer-file-name))
(default-directory (file-name-directory testfile)))
(file-truename
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index fdbf95319ff..92acfe7246f 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -60,7 +60,6 @@
(require 'cl-lib)
(require 'debug)
(require 'backtrace)
-(require 'easymenu)
(require 'ewoc)
(require 'find-func)
(require 'pp)
@@ -81,15 +80,13 @@ Use nil for no limit (caution: backtrace lines can be very long)."
:background "green1")
(((class color) (background dark))
:background "green3"))
- "Face used for expected results in the ERT results buffer."
- :group 'ert)
+ "Face used for expected results in the ERT results buffer.")
(defface ert-test-result-unexpected '((((class color) (background light))
:background "red1")
(((class color) (background dark))
:background "red3"))
- "Face used for unexpected results in the ERT results buffer."
- :group 'ert)
+ "Face used for unexpected results in the ERT results buffer.")
;;; Copies/reimplementations of cl functions.
@@ -196,8 +193,8 @@ it has to be wrapped in `(eval (quote ...))'.
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
[:tags \\='(TAG...)] BODY...)"
- (declare (debug (&define :name test
- name sexp [&optional stringp]
+ (declare (debug (&define [&name "test@" symbolp]
+ sexp [&optional stringp]
[&rest keywordp sexp] def-body))
(doc-string 3)
(indent 2))
@@ -224,16 +221,6 @@ it has to be wrapped in `(eval (quote ...))'.
:body (lambda () ,@body)))
',name))))
-;; We use these `put' forms in addition to the (declare (indent)) in
-;; the defmacro form since the `declare' alone does not lead to
-;; correct indentation before the .el/.elc file is loaded.
-;; Autoloading these `put' forms solves this.
-;;;###autoload
-(progn
- ;; TODO(ohler): Figure out what these mean and make sure they are correct.
- (put 'ert-deftest 'lisp-indent-function 2)
- (put 'ert-info 'lisp-indent-function 1))
-
(defvar ert--find-test-regexp
(concat "^\\s-*(ert-deftest"
find-function-space-re
@@ -274,7 +261,7 @@ DATA is displayed to the user and should state the reason for skipping."
It should only be stopped when ran from inside ert--run-test-internal."
(when (and (not (symbolp debugger)) ; only run on anonymous debugger
(memq error-symbol '(ert-test-failed ert-test-skipped)))
- (funcall debugger 'error (list error-symbol data))))
+ (funcall debugger 'error (cons error-symbol data))))
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
@@ -290,14 +277,7 @@ It should only be stopped when ran from inside ert--run-test-internal."
(let ((form
;; 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))))
+ (macroexpand-all form macroexpand-all-environment)
(error `(signal ',(car err) ',(cdr err))))))
(cond
((or (atom form) (ert--special-operator-p (car form)))
@@ -333,12 +313,13 @@ It should only be stopped when ran from inside ert--run-test-internal."
(list :form `(,,fn ,@,args))
(unless (eql ,value ',default-value)
(list :value ,value))
- (let ((-explainer-
- (and (symbolp ',fn-name)
- (get ',fn-name 'ert-explainer))))
- (when -explainer-
- (list :explanation
- (apply -explainer- ,args)))))
+ (unless (eql ,value ',default-value)
+ (let ((-explainer-
+ (and (symbolp ',fn-name)
+ (get ',fn-name 'ert-explainer))))
+ (when -explainer-
+ (list :explanation
+ (apply -explainer- ,args))))))
value)
,value))))))))
@@ -1299,11 +1280,28 @@ EXPECTEDP specifies whether the result was expected."
(ert-test-quit '("quit" "QUIT")))))
(elt s (if expectedp 0 1))))
+(defun ert-reason-for-test-result (result)
+ "Return the reason given for RESULT, as a string.
+
+The reason is the argument given when invoking `ert-fail' or `ert-skip'.
+It is output using `prin1' prefixed by two spaces.
+
+If no reason was given, or for a successful RESULT, return the
+empty string."
+ (let ((reason
+ (and
+ (ert-test-result-with-condition-p result)
+ (cadr (ert-test-result-with-condition-condition result))))
+ (print-escape-newlines t)
+ (print-level 6)
+ (print-length 10))
+ (if reason (format " %S" reason) "")))
+
(defun ert--pp-with-indentation-and-newline (object)
"Pretty-print OBJECT, indenting it to the current column of point.
Ensures a final newline is inserted."
(let ((begin (point))
- (pp-escape-newlines nil)
+ (pp-escape-newlines t)
(print-escape-control-characters t))
(pp object (current-buffer))
(unless (bolp) (insert "\n"))
@@ -1389,18 +1387,24 @@ Returns the stats object."
(cl-loop for test across (ert--stats-tests stats)
for result = (ert-test-most-recent-result test) do
(when (not (ert-test-result-expected-p test result))
- (message "%9s %S"
+ (message "%9s %S%s"
(ert-string-for-test-result result nil)
- (ert-test-name test))))
+ (ert-test-name test)
+ (if (getenv "EMACS_TEST_VERBOSE")
+ (ert-reason-for-test-result result)
+ ""))))
(message "%s" ""))
(unless (zerop skipped)
(message "%s skipped results:" skipped)
(cl-loop for test across (ert--stats-tests stats)
for result = (ert-test-most-recent-result test) do
(when (ert-test-result-type-p result :skipped)
- (message "%9s %S"
+ (message "%9s %S%s"
(ert-string-for-test-result result nil)
- (ert-test-name test))))
+ (ert-test-name test)
+ (if (getenv "EMACS_TEST_VERBOSE")
+ (ert-reason-for-test-result result)
+ ""))))
(message "%s" "")))))
(test-started
)
@@ -1548,7 +1552,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(when badtests
(message "%d files did not finish:" (length badtests))
(mapc (lambda (l) (message " %s" l)) badtests)
- (if (getenv "EMACS_HYDRA_CI")
+ (if (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
(with-temp-buffer
(dolist (f badtests)
(erase-buffer)
@@ -1563,9 +1567,9 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(message "------------------")
(setq tests (sort tests (lambda (x y) (> (car x) (car y)))))
(when (< high (length tests)) (setcdr (nthcdr (1- high) tests) nil))
- (message "%s" (mapconcat 'cdr tests "\n")))
- ;; More details on hydra, where the logs are harder to get to.
- (when (and (getenv "EMACS_HYDRA_CI")
+ (message "%s" (mapconcat #'cdr tests "\n")))
+ ;; More details on hydra and emba, where the logs are harder to get to.
+ (when (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
(not (zerop (+ nunexpected nskipped))))
(message "\nDETAILS")
(message "-------")
@@ -1653,7 +1657,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: ")))
+ (interactive (list (ert-read-test-name-at-point "Find test definition")))
(find-function-do-it test-name 'ert--test 'switch-to-buffer-other-window))
(defun ert-delete-test (test-name)
@@ -2090,7 +2094,7 @@ and how to display message."
(ert-run-tests selector listener t)))
;;;###autoload
-(defalias 'ert 'ert-run-tests-interactively)
+(defalias 'ert #'ert-run-tests-interactively)
;;; Simple view mode for auxiliary information like stack traces or
@@ -2103,6 +2107,7 @@ and how to display message."
(define-derived-mode ert-results-mode special-mode "ERT-Results"
"Major mode for viewing results of ERT test runs."
+ :interactive nil
(setq-local revert-buffer-function
(lambda (&rest _) (ert-results-rerun-all-tests))))
@@ -2198,7 +2203,7 @@ To be used in the ERT results buffer."
"Move point to the next test.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next
"No tests below"))
@@ -2206,7 +2211,7 @@ To be used in the ERT results buffer."
"Move point to the previous test.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev
"No tests above"))
@@ -2239,7 +2244,7 @@ user-error is signaled with the message ERROR-MESSAGE."
"Find the definition of the test at point in another window.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let ((name (ert-test-at-point)))
(unless name
(user-error "No test at point"))
@@ -2273,7 +2278,7 @@ To be used in the ERT results buffer."
;; the summary apparently needs to be easily accessible from the
;; error log, and perhaps it would be better to have it in a
;; separate buffer to keep it visible.
- (interactive)
+ (interactive nil ert-results-mode)
(let ((ewoc ert--results-ewoc)
(progress-bar-begin ert--results-progress-bar-button-begin))
(cond ((ert--results-test-node-or-null-at-point)
@@ -2390,7 +2395,7 @@ definition."
"Re-run all tests, using the same selector.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(cl-assert (eql major-mode 'ert-results-mode))
(let ((selector (ert--stats-selector ert--results-stats)))
(ert-run-tests-interactively selector (buffer-name))))
@@ -2399,7 +2404,7 @@ To be used in the ERT results buffer."
"Re-run the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(cl-destructuring-bind (test redefinition-state)
(ert--results-test-at-point-allow-redefinition)
(when (null test)
@@ -2434,7 +2439,7 @@ To be used in the ERT results buffer."
"Re-run the test at point with `ert-debug-on-error' bound to t.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let ((ert-debug-on-error t))
(ert-results-rerun-test-at-point)))
@@ -2442,7 +2447,7 @@ To be used in the ERT results buffer."
"Display the backtrace for the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@@ -2469,7 +2474,7 @@ To be used in the ERT results buffer."
"Display the part of the *Messages* buffer generated during the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@@ -2490,7 +2495,7 @@ To be used in the ERT results buffer."
"Display the list of `should' forms executed during the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@@ -2526,7 +2531,7 @@ To be used in the ERT results buffer."
"Toggle how much of the condition to print for the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((ewoc ert--results-ewoc)
(node (ert--results-test-node-at-point))
(entry (ewoc-data node)))
@@ -2538,7 +2543,7 @@ To be used in the ERT results buffer."
"Display test timings for the last run.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(let* ((stats ert--results-stats)
(buffer (get-buffer-create "*ERT timings*"))
(data (cl-loop for test across (ert--stats-tests stats)
@@ -2617,7 +2622,7 @@ To be used in the ERT results buffer."
"Display the documentation of the test at point.
To be used in the ERT results buffer."
- (interactive)
+ (interactive nil ert-results-mode)
(ert-describe-test (ert--results-test-at-point-no-redefinition t)))
diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
index 6c3931f9829..162c39634ed 100644
--- a/lisp/emacs-lisp/faceup.el
+++ b/lisp/emacs-lisp/faceup.el
@@ -1170,11 +1170,6 @@ Intended to be called when a file is loaded."
;; 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 c399a682f70..7bc3e6b25ff 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -123,10 +123,18 @@ should insert the feature name."
:group 'xref
:version "25.1")
+(defun find-function--defface (symbol)
+ (catch 'found
+ (while (re-search-forward (format find-face-regexp symbol) nil t)
+ (unless (ppss-comment-or-string-start
+ (save-excursion (syntax-ppss (match-beginning 0))))
+ ;; We're not in a comment or a string.
+ (throw 'found t)))))
+
(defvar find-function-regexp-alist
'((nil . find-function-regexp)
(defvar . find-variable-regexp)
- (defface . find-face-regexp)
+ (defface . find-function--defface)
(feature . find-feature-regexp)
(defalias . find-alias-regexp))
"Alist mapping definition types into regexp variables.
@@ -178,13 +186,18 @@ See the functions `find-function' and `find-variable'."
(setq name rel))))
(unless (equal name library) name)))
+(defvar comp-eln-to-el-h)
+
(defun find-library-name (library)
"Return the absolute file name of the Emacs Lisp source of LIBRARY.
LIBRARY should be a string (the name of the library)."
;; If the library is byte-compiled, try to find a source library by
;; the same name.
- (when (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
+ (cond
+ ((string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
(setq library (replace-match "" t t library)))
+ ((string-match "\\.eln\\'" library)
+ (setq library (gethash (file-name-nondirectory library) comp-eln-to-el-h))))
(or
(locate-file library
(or find-function-source-path load-path)
@@ -203,7 +216,7 @@ LIBRARY should be a string (the name of the library)."
(or find-function-source-path load-path)
load-file-rep-suffixes)))))
(find-library--from-load-history library)
- (error "Can't find library %s" library)))
+ (signal 'file-error (list "Can't find library" library))))
(defun find-library--from-load-history (library)
;; In `load-history', the file may be ".elc", ".el", ".el.gz", and
@@ -491,7 +504,7 @@ message about the whole chain of aliases."
(cons function
(cond
((autoloadp def) (nth 1 def))
- ((subrp def)
+ ((subr-primitive-p def)
(if lisp-only
(error "%s is a built-in function" function))
(help-C-file-name def 'subr))
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 4256bd59584..0e86b923c4a 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -31,6 +31,7 @@
(with-suppressed-warnings ((lexical pi))
(defconst pi float-pi
"Obsolete since Emacs-23.3. Use `float-pi' instead."))
+(make-obsolete-variable 'pi 'float-pi "23.3")
(internal-make-var-non-special 'pi)
(defconst float-e (exp 1) "The value of e (2.7182818...).")
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index e45260c32ac..4ae20ba4205 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -1,6 +1,6 @@
;;; generator.el --- generators -*- lexical-binding: t -*-
-;;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Daniel Colascione <dancol@dancol.org>
;; Keywords: extensions, elisp
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 29f8230e6b8..d6272a52469 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -135,7 +135,7 @@ The returned value will then be an Elisp expression that first evaluates
all the parts of PLACE that can be evaluated and then runs E.
\(fn (GETTER SETTER) PLACE &rest BODY)"
- (declare (indent 2) (debug (sexp form body)))
+ (declare (indent 2) (debug (sexp form def-body)))
`(gv-get ,place (lambda ,vars ,@body)))
;; Different ways to declare a generalized variable.
@@ -187,6 +187,13 @@ arguments as NAME. DO is a function as defined in `gv-get'."
(push (list 'gv-setter #'gv--setter-defun-declaration)
defun-declarations-alist))
+;;;###autoload
+(let ((spec (get 'compiler-macro 'edebug-declaration-spec)))
+ ;; It so happens that it's the same spec for gv-* as for compiler-macros.
+ ;; '(&or symbolp ("lambda" &define lambda-list lambda-doc def-body))
+ (put 'gv-expander 'edebug-declaration-spec spec)
+ (put 'gv-setter 'edebug-declaration-spec spec))
+
;; (defmacro gv-define-expand (name expander)
;; "Use EXPANDER to handle NAME as a generalized var.
;; NAME is a symbol: the name of a function, macro, or special form.
@@ -224,7 +231,8 @@ The first arg in ARGLIST (the one that receives VAL) receives an expression
which can do arbitrary things, whereas the other arguments are all guaranteed
to be pure and copyable. Example use:
(gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
- (declare (indent 2) (debug (&define name :name gv-setter sexp def-body)))
+ (declare (indent 2)
+ (debug (&define [&name symbolp "@gv-setter"] sexp def-body)))
`(gv-define-expander ,name
(lambda (do &rest args)
(declare-function
@@ -307,7 +315,7 @@ The return value is the last VAL in the list.
;; Autoload this `put' since a user might use C-u C-M-x on an expression
;; containing a non-trivial `push' even before gv.el was loaded.
;;;###autoload
-(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+(def-edebug-elem-spec 'gv-place '(form))
;; CL did the equivalent of:
;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
@@ -316,8 +324,7 @@ The return value is the last VAL in the list.
(gv-letplace (getter setter) place
(funcall do `(edebug-after ,before ,index ,getter)
(lambda (store)
- `(progn (edebug-after ,before ,index ,getter)
- ,(funcall setter store)))))))
+ `(edebug-after ,before ,index ,(funcall setter store)))))))
;;; The common generalized variables.
@@ -585,7 +592,7 @@ binding mode."
;; dynamic binding mode as well.
(eq (car-safe code) 'cons))
code
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
"Use of gv-ref probably requires lexical-binding"
code))))
@@ -607,5 +614,105 @@ REF must have been previously obtained with `gv-ref'."
;; (,(nth 1 vars) (v) (funcall ',setter v)))
;; ,@body)))
+;;; Generalized variables.
+
+;; Some Emacs-related place types.
+(gv-define-simple-setter buffer-file-name set-visited-file-name t)
+(gv-define-setter buffer-modified-p (flag &optional buf)
+ (macroexp-let2 nil buffer `(or ,buf (current-buffer))
+ `(with-current-buffer ,buffer
+ (set-buffer-modified-p ,flag))))
+(gv-define-simple-setter buffer-name rename-buffer t)
+(gv-define-setter buffer-string (store)
+ `(insert (prog1 ,store (erase-buffer))))
+(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
+(gv-define-simple-setter current-buffer set-buffer)
+(gv-define-simple-setter current-column move-to-column t)
+(gv-define-simple-setter current-global-map use-global-map t)
+(gv-define-setter current-input-mode (store)
+ `(progn (apply #'set-input-mode ,store) ,store))
+(gv-define-simple-setter current-local-map use-local-map t)
+(gv-define-simple-setter current-window-configuration
+ set-window-configuration t)
+(gv-define-simple-setter default-file-modes set-default-file-modes t)
+(gv-define-simple-setter documentation-property put)
+(gv-define-setter face-background (x f &optional s)
+ `(set-face-background ,f ,x ,s))
+(gv-define-setter face-background-pixmap (x f &optional s)
+ `(set-face-background-pixmap ,f ,x ,s))
+(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
+(gv-define-setter face-foreground (x f &optional s)
+ `(set-face-foreground ,f ,x ,s))
+(gv-define-setter face-underline-p (x f &optional s)
+ `(set-face-underline ,f ,x ,s))
+(gv-define-simple-setter file-modes set-file-modes t)
+(gv-define-setter frame-height (x &optional frame)
+ `(set-frame-height (or ,frame (selected-frame)) ,x))
+(gv-define-simple-setter frame-parameters modify-frame-parameters t)
+(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
+(gv-define-setter frame-width (x &optional frame)
+ `(set-frame-width (or ,frame (selected-frame)) ,x))
+(gv-define-simple-setter getenv setenv t)
+(gv-define-simple-setter get-register set-register)
+(gv-define-simple-setter global-key-binding global-set-key)
+(gv-define-simple-setter local-key-binding local-set-key)
+(gv-define-simple-setter mark set-mark t)
+(gv-define-simple-setter mark-marker set-mark t)
+(gv-define-simple-setter marker-position set-marker t)
+(gv-define-setter mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cadr ,store)
+ (cddr ,store)))
+(gv-define-simple-setter point goto-char)
+(gv-define-simple-setter point-marker goto-char t)
+(gv-define-setter point-max (store)
+ `(progn (narrow-to-region (point-min) ,store) ,store))
+(gv-define-setter point-min (store)
+ `(progn (narrow-to-region ,store (point-max)) ,store))
+(gv-define-setter read-mouse-position (store scr)
+ `(set-mouse-position ,scr (car ,store) (cdr ,store)))
+(gv-define-simple-setter screen-height set-screen-height t)
+(gv-define-simple-setter screen-width set-screen-width t)
+(gv-define-simple-setter selected-window select-window)
+(gv-define-simple-setter selected-screen select-screen)
+(gv-define-simple-setter selected-frame select-frame)
+(gv-define-simple-setter standard-case-table set-standard-case-table)
+(gv-define-simple-setter syntax-table set-syntax-table)
+(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
+(gv-define-setter window-height (store)
+ `(progn (enlarge-window (- ,store (window-height))) ,store))
+(gv-define-setter window-width (store)
+ `(progn (enlarge-window (- ,store (window-width)) t) ,store))
+(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
+
+;; More complex setf-methods.
+
+;; This is a hack that allows (setf (eq a 7) B) to mean either
+;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
+;; This is useful when you have control over the PLACE but not over
+;; the VALUE, as is the case in define-minor-mode's :variable.
+;; It turned out that :variable needed more flexibility anyway, so
+;; this doesn't seem too useful now.
+(gv-define-expander eq
+ (lambda (do place val)
+ (gv-letplace (getter setter) place
+ (macroexp-let2 nil val val
+ (funcall do `(eq ,getter ,val)
+ (lambda (v)
+ `(cond
+ (,v ,(funcall setter val))
+ ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
+
+(gv-define-expander substring
+ (lambda (do place from &optional to)
+ (gv-letplace (getter setter) place
+ (macroexp-let2* nil ((start from) (end to))
+ (funcall do `(substring ,getter ,start ,end)
+ (lambda (v)
+ (macroexp-let2 nil v v
+ `(progn
+ ,(funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v))
+ ,v))))))))
+
(provide 'gv)
;;; gv.el ends here
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
index d6106fe35d0..36d71a8c04d 100644
--- a/lisp/emacs-lisp/inline.el
+++ b/lisp/emacs-lisp/inline.el
@@ -262,7 +262,7 @@ See Info node `(elisp)Defining Functions' for more details."
'(throw 'inline--just-use
;; FIXME: This would inf-loop by calling us right back when
;; macroexpand-all recurses to expand inline--form.
- ;; (macroexp--warn-and-return (format ,@args)
+ ;; (macroexp-warn-and-return (format ,@args)
;; inline--form)
inline--form))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index adb9cb2372c..df14a5cd499 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -109,13 +109,10 @@
;; * Footer line --- marks end-of-file so it can be distinguished from
;; an expanded formfeed or the results of truncation.
-;;; Change Log:
-
-;; Tue Jul 14 23:44:17 1992 ESR
-;; * Created.
-
;;; Code:
+(require 'mail-parse)
+
;;; Variables:
(defgroup lisp-mnt nil
@@ -362,18 +359,11 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")"
summary)))))
(defun lm-crack-address (x)
- "Split up an email address X into full name and real email address.
-The value is a cons of the form (FULLNAME . ADDRESS)."
- (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
- (cons (match-string 1 x)
- (match-string 2 x)))
- ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x)
- (cons (match-string 2 x)
- (match-string 1 x)))
- ((string-match "\\S-+@\\S-+" x)
- (cons nil x))
- (t
- (cons x nil))))
+ "Split up email address(es) X into full name and real email address.
+The value is a list of elements of the form (FULLNAME . ADDRESS)."
+ (mapcar (lambda (elem)
+ (cons (cdr elem) (car elem)))
+ (mail-header-parse-addresses-lax x)))
(defun lm-authors (&optional file)
"Return the author list of file FILE, or current buffer if FILE is nil.
@@ -381,16 +371,24 @@ Each element of the list is a cons; the car is the full name,
the cdr is an email address."
(lm-with-file file
(let ((authorlist (lm-header-multiline "author")))
- (mapcar #'lm-crack-address authorlist))))
+ (mapcan #'lm-crack-address authorlist))))
+
+(defun lm-maintainers (&optional file)
+ "Return the maintainer list of file FILE, or current buffer if FILE is nil.
+If the maintainers are unspecified, then return the authors.
+Each element of the list is a cons; the car is the full name,
+the cdr is an email address."
+ (lm-with-file file
+ (mapcan #'lm-crack-address
+ (or (lm-header-multiline "maintainer")
+ (lm-header-multiline "author")))))
(defun lm-maintainer (&optional file)
"Return the maintainer of file FILE, or current buffer if FILE is nil.
+If the maintainer is unspecified, then return the author.
The return value has the form (NAME . ADDRESS)."
- (lm-with-file file
- (let ((maint (lm-header "maintainer")))
- (if maint
- (lm-crack-address maint)
- (car (lm-authors))))))
+ (declare (obsolete lm-maintainers "28.1"))
+ (car (lm-maintainers file)))
(defun lm-creation-date (&optional file)
"Return the created date given in file FILE, or current buffer if FILE is nil."
@@ -455,7 +453,7 @@ each line."
"Return list of keywords given in file FILE."
(let ((keywords (lm-keywords file)))
(if keywords
- (if (string-match-p "," keywords)
+ (if (string-search "," keywords)
(split-string keywords ",[ \t\n]*" t "[ ]+")
(split-string keywords "[ \t\n]+" t "[ ]+")))))
@@ -495,7 +493,7 @@ absent, return nil."
(concat "^;;;[[:blank:]]*\\("
lm-commentary-header
"\\):[[:blank:]\n]*")
- "^;;[[:blank:]]*" ; double semicolon prefix
+ "^;;[[:blank:]]?" ; double semicolon prefix
"[[:blank:]\n]*\\'") ; trailing new-lines
"" (buffer-substring-no-properties
start (lm-commentary-end))))))))
@@ -550,7 +548,7 @@ copyright notice is allowed."
"Can't find package name")
((not (lm-authors))
"`Author:' tag missing")
- ((not (lm-maintainer))
+ ((not (lm-maintainers))
"`Maintainer:' tag missing")
((not (lm-summary))
"Can't find the one-line summary description")
@@ -618,7 +616,7 @@ Prompts for bug subject TOPIC. Leaves you in a mail buffer."
(interactive "sBug Subject: ")
(require 'emacsbug)
(let ((package (lm-get-package-name))
- (addr (lm-maintainer))
+ (addr (car (lm-maintainers)))
(version (lm-version)))
(compose-mail (if addr
(concat (car addr) " <" (cdr addr) ">")
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index f5ce107185a..51fb88502ab 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -62,9 +62,6 @@
(modify-syntax-entry ?\t " " table)
(modify-syntax-entry ?\f " " table)
(modify-syntax-entry ?\n "> " table)
- ;; This is probably obsolete since nowadays such features use overlays.
- ;; ;; Give CR the same syntax as newline, for selective-display.
- ;; (modify-syntax-entry ?\^m "> " table)
(modify-syntax-entry ?\; "< " table)
(modify-syntax-entry ?` "' " table)
(modify-syntax-entry ?' "' " table)
@@ -530,7 +527,7 @@ 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.
- ;; That user has violated the http://www.cliki.net/Naming+conventions:
+ ;; That user has violated the https://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))
@@ -685,10 +682,16 @@ font-lock keywords will not be case sensitive."
(defun lisp-outline-level ()
"Lisp mode `outline-level' function."
+ ;; Expects outline-regexp is ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|("
+ ;; and point is at the beginning of a matching line.
(let ((len (- (match-end 0) (match-beginning 0))))
- (if (looking-at "(\\|;;;###autoload")
- 1000
- len)))
+ (cond ((looking-at "(\\|;;;###autoload")
+ 1000)
+ ((looking-at ";;\\(;+\\) ")
+ (- (match-end 1) (match-beginning 1)))
+ ;; Above should match everything but just in case.
+ (t
+ len))))
(defun lisp-current-defun-name ()
"Return the name of the defun at point, or nil."
@@ -743,27 +746,26 @@ font-lock keywords will not be case sensitive."
;;; Generic Lisp mode.
(defvar lisp-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Lisp")))
+ (let ((map (make-sparse-keymap)))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'lisp-eval-defun)
(define-key map "\C-c\C-z" 'run-lisp)
- (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map))
- (bindings--define-key menu-map [run-lisp]
- '(menu-item "Run inferior Lisp" run-lisp
- :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))
- (bindings--define-key menu-map [ev-def]
- '(menu-item "Eval defun" lisp-eval-defun
- :help "Send the current defun to the Lisp process made by M-x run-lisp"))
- (bindings--define-key menu-map [ind-sexp]
- '(menu-item "Indent sexp" indent-sexp
- :help "Indent each line of the list starting just after point"))
map)
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
+(easy-menu-define lisp-mode-menu lisp-mode-map
+ "Menu for ordinary Lisp mode."
+ '("Lisp"
+ ["Indent sexp" indent-sexp
+ :help "Indent each line of the list starting just after point"]
+ ["Eval defun" lisp-eval-defun
+ :help "Send the current defun to the Lisp process made by M-x run-lisp"]
+ ["Run inferior Lisp" run-lisp
+ :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"]))
+
(define-derived-mode lisp-mode lisp-data-mode "Lisp"
- "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
+ "Major mode for editing programs in Common Lisp and other similar Lisps.
Commands:
Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
@@ -1375,7 +1377,8 @@ and initial semicolons."
fill-column)))
(save-restriction
(save-excursion
- (let ((ppss (syntax-ppss)))
+ (let ((ppss (syntax-ppss))
+ (start (point)))
;; If we're in a string, then narrow (roughly) to that
;; string before filling. This avoids filling Lisp
;; statements that follow the string.
@@ -1390,6 +1393,8 @@ and initial semicolons."
t))
(narrow-to-region (ppss-comment-or-string-start ppss)
(point))))
+ ;; Move back to where we were.
+ (goto-char start)
(fill-paragraph justify)))))
;; Never return nil.
t))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 46ca94869c7..2495277ba23 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -503,7 +503,7 @@ If ARG is positive, that's the end of the buffer.
Otherwise, that's the beginning of the buffer."
(if (> arg 0) (point-max) (point-min)))
-(defun end-of-defun (&optional arg)
+(defun end-of-defun (&optional arg interactive)
"Move forward to next end of defun.
With argument, do it that many times.
Negative argument -N means move back to Nth preceding end of defun.
@@ -513,129 +513,145 @@ matches the open-parenthesis that starts a defun; see function
`beginning-of-defun'.
If variable `end-of-defun-function' is non-nil, its value
-is called as a function to find the defun's end."
- (interactive "^p")
- (or (not (eq this-command 'end-of-defun))
- (eq last-command 'end-of-defun)
- (and transient-mark-mode mark-active)
- (push-mark))
- (if (or (null arg) (= arg 0)) (setq arg 1))
- (let ((pos (point))
- (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
- (skip (lambda ()
- ;; When comparing point against pos, we want to consider that if
- ;; point was right after the end of the function, it's still
- ;; considered as "in that function".
- ;; E.g. `eval-defun' from right after the last close-paren.
- (unless (bolp)
- (skip-chars-forward " \t")
- (if (looking-at "\\s<\\|\n")
- (forward-line 1))))))
- (funcall end-of-defun-function)
- (when (<= arg 1)
- (funcall skip))
- (cond
- ((> arg 0)
- ;; Moving forward.
- (if (> (point) pos)
- ;; We already moved forward by one because we started from
- ;; within a function.
- (setq arg (1- arg))
- ;; We started from after the end of the previous function.
- (goto-char pos))
- (unless (zerop arg)
- (beginning-of-defun-raw (- arg))
- (funcall end-of-defun-function)))
- ((< arg 0)
- ;; Moving backward.
- (if (< (point) pos)
- ;; We already moved backward because we started from between
- ;; two functions.
- (setq arg (1+ arg))
- ;; We started from inside a function.
- (goto-char beg))
- (unless (zerop arg)
+is called as a function to find the defun's end.
+
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "^p\nd")
+ (if interactive
+ (condition-case e
+ (end-of-defun arg nil)
+ (scan-error (user-error (cadr e))))
+ (or (not (eq this-command 'end-of-defun))
+ (eq last-command 'end-of-defun)
+ (and transient-mark-mode mark-active)
+ (push-mark))
+ (if (or (null arg) (= arg 0)) (setq arg 1))
+ (let ((pos (point))
+ (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
+ (skip (lambda ()
+ ;; When comparing point against pos, we want to consider that
+ ;; if point was right after the end of the function, it's
+ ;; still considered as "in that function".
+ ;; E.g. `eval-defun' from right after the last close-paren.
+ (unless (bolp)
+ (skip-chars-forward " \t")
+ (if (looking-at "\\s<\\|\n")
+ (forward-line 1))))))
+ (funcall end-of-defun-function)
+ (when (<= arg 1)
+ (funcall skip))
+ (cond
+ ((> arg 0)
+ ;; Moving forward.
+ (if (> (point) pos)
+ ;; We already moved forward by one because we started from
+ ;; within a function.
+ (setq arg (1- arg))
+ ;; We started from after the end of the previous function.
+ (goto-char pos))
+ (unless (zerop arg)
+ (beginning-of-defun-raw (- arg))
+ (funcall end-of-defun-function)))
+ ((< arg 0)
+ ;; Moving backward.
+ (if (< (point) pos)
+ ;; We already moved backward because we started from between
+ ;; two functions.
+ (setq arg (1+ arg))
+ ;; We started from inside a function.
+ (goto-char beg))
+ (unless (zerop arg)
+ (beginning-of-defun-raw (- arg))
+ (setq beg (point))
+ (funcall end-of-defun-function))))
+ (funcall skip)
+ (while (and (< arg 0) (>= (point) pos))
+ ;; We intended to move backward, but this ended up not doing so:
+ ;; Try harder!
+ (goto-char beg)
(beginning-of-defun-raw (- arg))
- (setq beg (point))
- (funcall end-of-defun-function))))
- (funcall skip)
- (while (and (< arg 0) (>= (point) pos))
- ;; We intended to move backward, but this ended up not doing so:
- ;; Try harder!
- (goto-char beg)
- (beginning-of-defun-raw (- arg))
- (if (>= (point) beg)
- (setq arg 0)
- (setq beg (point))
- (funcall end-of-defun-function)
- (funcall skip)))))
-
-(defun mark-defun (&optional arg)
+ (if (>= (point) beg)
+ (setq arg 0)
+ (setq beg (point))
+ (funcall end-of-defun-function)
+ (funcall skip))))))
+
+(defun mark-defun (&optional arg interactive)
"Put mark at end of this defun, point at beginning.
The defun marked is the one that contains point or follows point.
With positive ARG, mark this and that many next defuns; with negative
ARG, change the direction of marking.
If the mark is active, it marks the next or previous defun(s) after
-the one(s) already marked."
- (interactive "p")
- (setq arg (or arg 1))
- ;; There is no `mark-defun-back' function - see
- ;; https://lists.gnu.org/r/bug-gnu-emacs/2016-11/msg00079.html
- ;; for explanation
- (when (eq last-command 'mark-defun-back)
- (setq arg (- arg)))
- (when (< arg 0)
- (setq this-command 'mark-defun-back))
- (cond ((use-region-p)
- (if (>= arg 0)
- (set-mark
- (save-excursion
- (goto-char (mark))
- ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
- (dotimes (_ignore arg)
- (end-of-defun))
- (point)))
- (beginning-of-defun-comments (- arg))))
- (t
- (let ((opoint (point))
- beg end)
- (push-mark opoint)
- ;; Try first in this order for the sake of languages with nested
- ;; functions where several can end at the same place as with the
- ;; offside rule, e.g. Python.
- (beginning-of-defun-comments)
- (setq beg (point))
- (end-of-defun)
- (setq end (point))
- (when (or (and (<= (point) opoint)
- (> arg 0))
- (= beg (point-min))) ; we were before the first defun!
- ;; beginning-of-defun moved back one defun so we got the wrong
- ;; one. If ARG < 0, however, we actually want to go back.
- (goto-char opoint)
- (end-of-defun)
- (setq end (point))
- (beginning-of-defun-comments)
- (setq beg (point)))
- (goto-char beg)
- (cond ((> arg 0)
- ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
+the one(s) already marked.
+
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "p\nd")
+ (if interactive
+ (condition-case e
+ (mark-defun arg nil)
+ (scan-error (user-error (cadr e))))
+ (setq arg (or arg 1))
+ ;; There is no `mark-defun-back' function - see
+ ;; https://lists.gnu.org/r/bug-gnu-emacs/2016-11/msg00079.html
+ ;; for explanation
+ (when (eq last-command 'mark-defun-back)
+ (setq arg (- arg)))
+ (when (< arg 0)
+ (setq this-command 'mark-defun-back))
+ (cond ((use-region-p)
+ (if (>= arg 0)
+ (set-mark
+ (save-excursion
+ (goto-char (mark))
+ ;; change the dotimes below to (end-of-defun arg)
+ ;; once bug #24427 is fixed
(dotimes (_ignore arg)
(end-of-defun))
- (setq end (point))
- (push-mark end nil t)
- (goto-char beg))
- (t
- (goto-char beg)
- (unless (= arg -1) ; beginning-of-defun behaves
- ; strange with zero arg - see
- ; 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")
- (unless (bobp)
- (forward-line 1)))
+ (point)))
+ (beginning-of-defun-comments (- arg))))
+ (t
+ (let ((opoint (point))
+ beg end)
+ (push-mark opoint)
+ ;; Try first in this order for the sake of languages with nested
+ ;; functions where several can end at the same place as with the
+ ;; offside rule, e.g. Python.
+ (beginning-of-defun-comments)
+ (setq beg (point))
+ (end-of-defun)
+ (setq end (point))
+ (when (or (and (<= (point) opoint)
+ (> arg 0))
+ (= beg (point-min))) ; we were before the first defun!
+ ;; beginning-of-defun moved back one defun so we got the wrong
+ ;; one. If ARG < 0, however, we actually want to go back.
+ (goto-char opoint)
+ (end-of-defun)
+ (setq end (point))
+ (beginning-of-defun-comments)
+ (setq beg (point)))
+ (goto-char beg)
+ (cond ((> arg 0)
+ ;; change the dotimes below to (end-of-defun arg)
+ ;; once bug #24427 is fixed
+ (dotimes (_ignore arg)
+ (end-of-defun))
+ (setq end (point))
+ (push-mark end nil t)
+ (goto-char beg))
+ (t
+ (goto-char beg)
+ (unless (= arg -1)
+ ;; beginning-of-defun behaves strange with zero arg - see
+ ;; 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")
+ (unless (bobp)
+ (forward-line 1))))
(defvar narrow-to-defun-include-comments nil
"If non-nil, `narrow-to-defun' will also show comments preceding the defun.")
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e842222b7c3..61c1ea490f0 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -112,7 +112,7 @@ and also to avoid outputting the warning during normal execution."
(funcall (eval (cadr form)))
(byte-compile-constant nil)))
-(defun macroexp--compiling-p ()
+(defun macroexp-compiling-p ()
"Return non-nil if we're macroexpanding for the compiler."
;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
;; macro-expansion will be processed by the byte-compiler, we check
@@ -120,30 +120,55 @@ and also to avoid outputting the warning during normal execution."
(member '(declare-function . byte-compile-macroexpand-declare-function)
macroexpand-all-environment))
+(defun macroexp-file-name ()
+ "Return the name of the file from which the code comes.
+Returns nil when we do not know.
+A non-nil result is expected to be reliable when called from a macro in order
+to find the file in which the macro's call was found, and it should be
+reliable as well when used at the top-level of a file.
+Other uses risk returning non-nil value that point to the wrong file."
+ ;; `eval-buffer' binds `current-load-list' but not `load-file-name',
+ ;; so prefer using it over using `load-file-name'.
+ (let ((file (car (last current-load-list))))
+ (or (if (stringp file) file)
+ (bound-and-true-p byte-compile-current-file))))
+
(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
-(defun macroexp--warn-and-return (msg form &optional compile-only)
- (let ((when-compiled (lambda () (byte-compile-warn "%s" msg))))
- (cond
- ((null msg) form)
- ((macroexp--compiling-p)
- (if (and (consp form) (gethash form macroexp--warned))
- ;; Already wrapped this exp with a warning: avoid inf-looping
- ;; where we keep adding the same warning onto `form' because
- ;; macroexpand-all gets right back to macroexpanding `form'.
- form
- (puthash form form macroexp--warned)
- `(progn
- (macroexp--funcall-if-compiled ',when-compiled)
- ,form)))
- (t
- (unless compile-only
- (message "%sWarning: %s"
- (if (stringp load-file-name)
- (concat (file-relative-name load-file-name) ": ")
- "")
- msg))
- form))))
+(defun macroexp--warn-wrap (msg form category)
+ (let ((when-compiled (lambda ()
+ (when (byte-compile-warning-enabled-p category)
+ (byte-compile-warn "%s" msg)))))
+ `(progn
+ (macroexp--funcall-if-compiled ',when-compiled)
+ ,form)))
+
+(define-obsolete-function-alias 'macroexp--warn-and-return
+ #'macroexp-warn-and-return "28.1")
+(defun macroexp-warn-and-return (msg form &optional category compile-only)
+ "Return code equivalent to FORM labeled with warning MSG.
+CATEGORY is the category of the warning, like the categories that
+can appear in `byte-compile-warnings'.
+COMPILE-ONLY non-nil means no warning should be emitted if the code
+is executed without being compiled first."
+ (cond
+ ((null msg) form)
+ ((macroexp-compiling-p)
+ (if (and (consp form) (gethash form macroexp--warned))
+ ;; Already wrapped this exp with a warning: avoid inf-looping
+ ;; where we keep adding the same warning onto `form' because
+ ;; macroexpand-all gets right back to macroexpanding `form'.
+ form
+ (puthash form form macroexp--warned)
+ (macroexp--warn-wrap msg form category)))
+ (t
+ (unless compile-only
+ (message "%sWarning: %s"
+ (if (stringp load-file-name)
+ (concat (file-relative-name load-file-name) ": ")
+ "")
+ msg))
+ form)))
(defun macroexp--obsolete-warning (fun obsolescence-data type)
(let ((instead (car obsolescence-data))
@@ -187,19 +212,80 @@ and also to avoid outputting the warning during normal execution."
(if (and (not (eq form new-form)) ;It was a macro call.
(car-safe form)
(symbolp (car form))
- (get (car form) 'byte-obsolete-info)
- (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p 'obsolete (car form))))
+ (get (car form) 'byte-obsolete-info))
(let* ((fun (car form))
(obsolete (get fun 'byte-obsolete-info)))
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
(macroexp--obsolete-warning
fun obsolete
(if (symbolp (symbol-function fun))
"alias" "macro"))
- new-form))
+ new-form 'obsolete))
new-form)))
+(defun macroexp--unfold-lambda (form &optional name)
+ ;; In lexical-binding mode, let and functions don't bind vars in the same way
+ ;; (let obey special-variable-p, but functions don't). But luckily, this
+ ;; doesn't matter here, because function's behavior is underspecified so it
+ ;; can safely be turned into a `let', even though the reverse is not true.
+ (or name (setq name "anonymous lambda"))
+ (let* ((lambda (car form))
+ (values (cdr form))
+ (arglist (nth 1 lambda))
+ (body (cdr (cdr lambda)))
+ optionalp restp
+ bindings)
+ (if (and (stringp (car body)) (cdr body))
+ (setq body (cdr body)))
+ (if (and (consp (car body)) (eq 'interactive (car (car body))))
+ (setq body (cdr body)))
+ ;; FIXME: The checks below do not belong in an optimization phase.
+ (while arglist
+ (cond ((eq (car arglist) '&optional)
+ ;; ok, I'll let this slide because funcall_lambda() does...
+ ;; (if optionalp (error "multiple &optional keywords in %s" name))
+ (if restp (error "&optional found after &rest in %s" name))
+ (if (null (cdr arglist))
+ (error "nothing after &optional in %s" name))
+ (setq optionalp t))
+ ((eq (car arglist) '&rest)
+ ;; ...but it is by no stretch of the imagination a reasonable
+ ;; thing that funcall_lambda() allows (&rest x y) and
+ ;; (&rest x &optional y) in arglists.
+ (if (null (cdr arglist))
+ (error "nothing after &rest in %s" name))
+ (if (cdr (cdr arglist))
+ (error "multiple vars after &rest in %s" name))
+ (setq restp t))
+ (restp
+ (setq bindings (cons (list (car arglist)
+ (and values (cons 'list values)))
+ bindings)
+ values nil))
+ ((and (not optionalp) (null values))
+ (setq arglist nil values 'too-few))
+ (t
+ (setq bindings (cons (list (car arglist) (car values))
+ bindings)
+ values (cdr values))))
+ (setq arglist (cdr arglist)))
+ (if values
+ (macroexp-warn-and-return
+ (format (if (eq values 'too-few)
+ "attempt to open-code `%s' with too few arguments"
+ "attempt to open-code `%s' with too many arguments")
+ name)
+ form)
+
+ ;; The following leads to infinite recursion when loading a
+ ;; file containing `(defsubst f () (f))', and then trying to
+ ;; byte-compile that file.
+ ;;(setq body (mapcar 'byte-optimize-form body)))
+
+ (if bindings
+ `(let ,(nreverse bindings) . ,body)
+ (macroexp-progn body)))))
+
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
@@ -213,10 +299,12 @@ Assumes the caller has bound `macroexpand-all-environment'."
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
(setq form (macroexp-macroexpand form macroexpand-all-environment))
+ ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when
+ ;; I tried it, it broke the bootstrap :-(
(pcase form
(`(cond . ,clauses)
(macroexp--cons 'cond (macroexp--all-clauses clauses) form))
- (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
+ (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare))
(macroexp--cons
'condition-case
(macroexp--cons err
@@ -233,51 +321,35 @@ Assumes the caller has bound `macroexpand-all-environment'."
(cdr form))
form))
(`(,(or 'function 'quote) . ,_) form)
- (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) dontcare))
- (macroexp--cons fun
- (macroexp--cons (macroexp--all-clauses bindings 1)
- (macroexp--all-forms body)
- (cdr form))
- form))
+ (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
+ pcase--dontcare))
+ (macroexp--cons
+ fun
+ (macroexp--cons
+ (macroexp--all-clauses bindings 1)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp-warn-and-return
+ (format "Empty %s body" fun)
+ nil nil 'compile-only))
+ (macroexp--all-forms body))
+ (cdr form))
+ form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
;; If the byte-optimizer is loaded, try to unfold this,
;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer
;; anyway, but doing it here (i.e. earlier) can sometimes avoid the
;; creation of a closure, thus resulting in much better code.
- (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda))
- 'macroexp--not-unfolded
- ;; Don't unfold if byte-opt is not yet loaded.
- (byte-compile-unfold-lambda form))))
- (if (or (eq newform 'macroexp--not-unfolded)
- (eq newform form))
+ (let ((newform (macroexp--unfold-lambda form)))
+ (if (eq newform form)
;; Unfolding failed for some reason, avoid infinite recursion.
(macroexp--cons (macroexp--all-forms fun 2)
(macroexp--all-forms args)
form)
(macroexp--expand-all newform))))
- ;; The following few cases are for normal function calls that
- ;; are known to funcall one of their arguments. The byte
- ;; compiler has traditionally handled these functions specially
- ;; by treating a lambda expression quoted by `quote' as if it
- ;; were quoted by `function'. We make the same transformation
- ;; here, so that any code that cares about the difference will
- ;; see the same transformation.
- ;; First arg is a function:
- (`(,(and fun (or 'funcall 'apply 'mapcar 'mapatoms 'mapconcat 'mapc))
- ',(and f `(lambda . ,_)) . ,args)
- (macroexp--warn-and-return
- (format "%s quoted with ' rather than with #'"
- (list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun #',f . ,args))))
- ;; Second arg is a function:
- (`(,(and fun (or 'sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
- (macroexp--warn-and-return
- (format "%s quoted with ' rather than with #'"
- (list 'lambda (nth 1 f) '...))
- (macroexp--expand-all `(,fun ,arg1 #',f . ,args))))
- (`(funcall ,exp . ,args)
+ (`(funcall . ,(or `(,exp . ,args) pcase--dontcare))
(let ((eexp (macroexp--expand-all exp))
(eargs (macroexp--all-forms args)))
;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
@@ -286,10 +358,22 @@ Assumes the caller has bound `macroexpand-all-environment'."
(`#',f (macroexp--expand-all `(,f . ,eargs)))
(_ `(funcall ,eexp . ,eargs)))))
(`(,func . ,_)
- ;; Macro expand compiler macros. This cannot be delayed to
- ;; byte-optimize-form because the output of the compiler-macro can
- ;; use macros.
- (let ((handler (function-get func 'compiler-macro)))
+ (let ((handler (function-get func 'compiler-macro))
+ (funargs (function-get func 'funarg-positions)))
+ ;; Check functions quoted with ' rather than with #'
+ (dolist (funarg funargs)
+ (let ((arg (nth funarg form)))
+ (when (and (eq 'quote (car-safe arg))
+ (eq 'lambda (car-safe (cadr arg))))
+ (setcar (nthcdr funarg form)
+ (macroexp-warn-and-return
+ (format "%S quoted with ' rather than with #'"
+ (let ((f (cadr arg)))
+ (if (symbolp f) f `(lambda ,(nth 1 f) ...))))
+ arg)))))
+ ;; Macro expand compiler macros. This cannot be delayed to
+ ;; byte-optimize-form because the output of the compiler-macro can
+ ;; use macros.
(if (null handler)
;; No compiler macro. We just expand each argument (for
;; setq/setq-default this works alright because the variable names
@@ -315,6 +399,19 @@ Assumes the caller has bound `macroexpand-all-environment'."
(_ form))))
+;; Record which arguments expect functions, so we can warn when those
+;; are accidentally quoted with ' rather than with #'
+(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash
+ map-char-table map-keymap map-keymap-internal))
+ (put f 'funarg-positions '(1)))
+(dolist (f '( add-hook remove-hook advice-remove advice--remove-function
+ defalias fset global-set-key run-after-idle-timeout
+ set-process-filter set-process-sentinel sort))
+ (put f 'funarg-positions '(2)))
+(dolist (f '( advice-add define-key
+ run-at-time run-with-idle-timer run-with-timer ))
+ (put f 'funarg-positions '(3)))
+
;;;###autoload
(defun macroexpand-all (form &optional environment)
"Return result of expanding macros at all levels in FORM.
@@ -513,20 +610,35 @@ test of free variables in the following ways:
- For the same reason it may cause the result to fail to include bindings
which will be used if SEXP is not yet fully macro-expanded and the
use of the binding will only be revealed by macro expansion."
- (let ((res '()))
- (while (and (consp sexp) bindings)
- (dolist (binding (macroexp--fgrep bindings (pop sexp)))
- (push binding res)
- (setq bindings (remove binding bindings))))
- (if (or (vectorp sexp) (byte-code-function-p sexp))
- ;; With backquote, code can appear within vectors as well.
- ;; This wouldn't be needed if we `macroexpand-all' before
- ;; calling macroexp--fgrep, OTOH.
- (macroexp--fgrep bindings (mapcar #'identity sexp))
- (let ((tmp (assq sexp bindings)))
- (if tmp
- (cons tmp res)
- res)))))
+ (let ((res '())
+ ;; Cyclic code should not happen, but code can contain cyclic data :-(
+ (seen (make-hash-table :test #'eq))
+ (sexpss (list (list sexp))))
+ ;; Use a nested while loop to reduce the amount of heap allocations for
+ ;; pushes to `sexpss' and the `gethash' overhead.
+ (while (and sexpss bindings)
+ (let ((sexps (pop sexpss)))
+ (unless (gethash sexps seen)
+ (puthash sexps t seen) ;; Using `setf' here causes bootstrap problems.
+ (if (vectorp sexps) (setq sexps (mapcar #'identity sexps)))
+ (let ((tortoise sexps) (skip t))
+ (while sexps
+ (let ((sexp (if (consp sexps) (pop sexps)
+ (prog1 sexps (setq sexps nil)))))
+ (if skip
+ (setq skip nil)
+ (setq tortoise (cdr tortoise))
+ (if (eq tortoise sexps)
+ (setq sexps nil) ;; Found a cycle: we're done!
+ (setq skip t)))
+ (cond
+ ((or (consp sexp) (vectorp sexp)) (push sexp sexpss))
+ (t
+ (let ((tmp (assq sexp bindings)))
+ (when tmp
+ (push tmp res)
+ (setq bindings (remove tmp bindings))))))))))))
+ res))
;;; Load-time macro-expansion.
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 14112a1c147..0522b31f577 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -38,46 +38,62 @@
(defun map-y-or-n-p (prompter actor list &optional help action-alist
no-cursor-in-echo-area)
- "Ask a series of boolean questions.
-Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
+ "Ask a boolean question per PROMPTER for each object in LIST, then call ACTOR.
LIST is a list of objects, or a function of no arguments to return the next
-object or nil.
-
-If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT). If not
-a string, PROMPTER is a function of one arg (an object from LIST), which
-returns a string to be used as the prompt for that object. If the return
-value is not a string, it may be nil to ignore the object or non-nil to act
-on the object without asking the user.
-
-ACTOR is a function of one arg (an object from LIST),
-which gets called with each object that the user answers `yes' for.
-
-If HELP is given, it is a list (OBJECT OBJECTS ACTION),
-where OBJECT is a string giving the singular noun for an elt of LIST;
-OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
-verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\").
-
-At the prompts, the user may enter y, Y, or SPC to act on that object;
-n, N, or DEL to skip that object; ! to act on all following objects;
-ESC or q to exit (skip all following objects); . (period) to act on the
-current object and then exit; or \\[help-command] to get help.
-
-If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys
-that will be accepted. KEY is a character; FUNCTION is a function of one
-arg (an object from LIST); HELP is a string. When the user hits KEY,
-FUNCTION is called. If it returns non-nil, the object is considered
-\"acted upon\", and the next object from LIST is processed. If it returns
-nil, the prompt is repeated for the same object.
-
-Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set
-`cursor-in-echo-area' while prompting.
+object; when it returns nil, the list of objects is considered exhausted.
+
+If PROMPTER is a string, it should be a format string to be used to format
+the question as \(format PROMPTER OBJECT).
+If PROMPTER is not a string, it should be a function of one argument, an
+object from LIST, which returns a string to be used as the question for
+that object. If the function's return value is not a string, it may be
+nil to ignore the object, or non-nil to act on the object with ACTOR
+without asking the user.
+
+ACTOR is a function of one argument, an object from LIST,
+which gets called with each object for which the user answers `yes'
+to the question presented by PROMPTER.
+
+The user's answers to the questions may be one of the following:
+
+ - y, Y, or SPC to act on that object;
+ - n, N, or DEL to skip that object;
+ - ! to act on all following objects;
+ - ESC or q to exit (skip all following objects);
+ - . (period) to act on the current object and then exit; or
+ - \\[help-command] to get help.
+
+HELP provides information for displaying help when the user
+types \\[help-command]. If HELP is given, it should be a list of
+the form (OBJECT OBJECTS ACTION), where OBJECT is a string giving
+the singular noun describing an element of LIST; OBJECTS is the
+plural noun describing several elements of LIST, and ACTION is a
+transitive verb describing action by ACTOR on one or more elements
+of LIST. If HELP is omitted or nil, it defaults
+to \(\"object\" \"objects\" \"act on\").
+
+If ACTION-ALIST is given, it is an alist specifying additional keys
+that will be accepted as an answer to the questions. Each element
+of the alist has the form (KEY FUNCTION HELP), where KEY is a character;
+FUNCTION is a function of one argument (an object from LIST); and HELP
+is a string. When the user presses KEY, FUNCTION is called; if it
+returns non-nil, the object is considered to have been \"acted upon\",
+and `map-y-or-n-p' proceeeds to the next object from LIST. If
+FUNCTION returns nil, the prompt is re-issued for the same object: this
+comes in handy if FUNCTION produces some display that will allow the
+user to make an intelligent decision whether the object in question
+should be acted upon. If the user types \\[help-command], the string
+given by HELP is used to describe the effect of KEY.
+
+Optional argument NO-CURSOR-IN-ECHO-AREA, if non-nil, means not to set
+`cursor-in-echo-area' while prompting with the questions.
This function uses `query-replace-map' to define the standard responses,
-but not all of the responses which `query-replace' understands
-are meaningful here.
+but only some of the responses which `query-replace' understands
+are meaningful here, as described above.
-Returns the number of actions taken."
+The function's value is the number of actions taken."
(let* ((actions 0)
(msg (current-message))
user-keys mouse-event map prompt char elt def
@@ -265,7 +281,8 @@ C-g to quit (cancel the whole command);
"If non-nil, `read-answer' accepts single-character answers.
If t, accept short (single key-press) answers to the question.
If nil, require long answers. If `auto', accept short answers if
-the function cell of `yes-or-no-p' is set to `y-or-n-p'."
+`use-short-answers' is non-nil, or the function cell of `yes-or-no-p'
+is set to `y-or-n-p'."
:type '(choice (const :tag "Accept short answers" t)
(const :tag "Require long answer" nil)
(const :tag "Guess preference" auto))
@@ -304,7 +321,8 @@ Return a long answer even in case of accepting short ones.
When `use-dialog-box' is t, pop up a dialog window to get user input."
(let* ((short (if (eq read-answer-short 'auto)
- (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
+ (or use-short-answers
+ (eq (symbol-function 'yes-or-no-p) 'y-or-n-p))
read-answer-short))
(answers-with-help
(if (assoc "help" answers)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 46a1bd21a3d..988a62a4e34 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -3,12 +3,10 @@
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
-;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 2.1
-;; Package-Requires: ((emacs "25"))
-;; Package: map
-
;; Maintainer: emacs-devel@gnu.org
+;; Keywords: extensions, lisp
+;; Version: 3.1
+;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
@@ -27,8 +25,9 @@
;;; Commentary:
-;; map.el provides map-manipulation functions that work on alists,
-;; hash-table and arrays. All functions are prefixed with "map-".
+;; map.el provides generic map-manipulation functions that work on
+;; alists, plists, hash-tables, and arrays. All functions are
+;; prefixed with "map-".
;;
;; Functions taking a predicate or iterating over a map using a
;; function take the function as their first argument. All other
@@ -54,7 +53,7 @@ ARGS is a list of elements to be matched in the map.
Each element of ARGS can be of the form (KEY PAT), in which case KEY is
evaluated and searched for in the map. The match fails if for any KEY
found in the map, the corresponding PAT doesn't match the value
-associated to the KEY.
+associated with the KEY.
Each element can also be a SYMBOL, which is an abbreviation of
a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL
@@ -75,7 +74,7 @@ bound to the looked up value in MAP.
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."
+MAP can be an alist, plist, hash-table, or array."
(declare (indent 2)
(debug ((&rest &or symbolp ([form symbolp])) form body)))
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
@@ -101,7 +100,7 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
(define-error 'map-not-inplace "Cannot modify map in-place")
(defsubst map--plist-p (list)
- (and (consp list) (not (listp (car list)))))
+ (and (consp list) (atom (car list))))
(cl-defgeneric map-elt (map key &optional default testfn)
"Lookup KEY in MAP and return its associated value.
@@ -109,7 +108,8 @@ If KEY is not found, return DEFAULT which defaults to nil.
TESTFN is deprecated. Its default depends on the MAP argument.
-In the base definition, MAP can be an alist, hash-table, or array."
+In the base definition, MAP can be an alist, plist, hash-table,
+or array."
(declare
(gv-expander
(lambda (do)
@@ -124,29 +124,30 @@ In the base definition, MAP can be an alist, hash-table, or array."
(with-no-warnings (map-put! ,mgetter ,key ,v ,testfn))
(map-not-inplace
,(funcall msetter
- `(map-insert ,mgetter ,key ,v))))))))))
+ `(map-insert ,mgetter ,key ,v))
+ ;; Always return the value.
+ ,v))))))))
;; `testfn' is deprecated.
(advertised-calling-convention (map key &optional default) "27.1"))
+ ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
(map--dispatch map
:list (if (map--plist-p map)
- (let ((res (plist-get map key)))
- (if (and default (null res) (not (plist-member map key)))
- default
- res))
+ (let ((res (plist-member map key)))
+ (if res (cadr res) default))
(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)
+ :array (if (map-contains-key map key)
+ (aref map key)
default)))
(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,
+When MAP is an alist, test equality with TESTFN if non-nil,
otherwise use `eql'.
-MAP can be a list, hash-table or array."
+MAP can be an alist, plist, hash-table, or array."
(declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
`(setf (map-elt ,map ,key nil ,testfn) ,value))
@@ -168,23 +169,30 @@ MAP can be a list, hash-table or array."
(cl-defgeneric map-delete (map key)
"Delete KEY in-place from MAP and return MAP.
-No error is signaled if KEY is not a key of MAP.
-If MAP is an array, store nil at the index KEY."
- (map--dispatch map
- ;; FIXME: Signal map-not-inplace i.s.o returning a different list?
- :list (if (map--plist-p map)
- (setq map (map--plist-delete map key))
- (setf (alist-get key map nil t) nil))
- :hash-table (remhash key map)
- :array (and (>= key 0)
- (<= key (seq-length map))
- (aset map key nil)))
+Keys not present in MAP are ignored.")
+
+(cl-defmethod map-delete ((map list) key)
+ ;; FIXME: Signal map-not-inplace i.s.o returning a different list?
+ (if (map--plist-p map)
+ (map--plist-delete map key)
+ (setf (alist-get key map nil t) nil)
+ map))
+
+(cl-defmethod map-delete ((map hash-table) key)
+ (remhash key map)
+ map)
+
+(cl-defmethod map-delete ((map array) key)
+ "Store nil at index KEY."
+ (when (map-contains-key map key)
+ (aset map key nil))
map)
(defun map-nested-elt (map keys &optional default)
"Traverse MAP using KEYS and return the looked up value or DEFAULT if nil.
-Map can be a nested map composed of alists, hash-tables and arrays."
+MAP can be a nested map composed of alists, plists, hash-tables,
+and arrays."
(or (seq-reduce (lambda (acc key)
(when (mapp acc)
(map-elt acc key)))
@@ -202,30 +210,49 @@ The default implementation delegates to `map-apply'."
The default implementation delegates to `map-apply'."
(map-apply (lambda (_ value) value) map))
+(cl-defmethod map-values ((map array))
+ "Convert MAP into a list."
+ (append map ()))
+
(cl-defgeneric map-pairs (map)
- "Return the elements of MAP as key/value association lists.
+ "Return the key/value pairs in MAP as an alist.
The default implementation delegates to `map-apply'."
(map-apply #'cons map))
(cl-defgeneric map-length (map)
;; FIXME: Should we rename this to `map-size'?
- "Return the number of elements in the map.
-The default implementation counts `map-keys'."
- (cond
- ((hash-table-p map) (hash-table-count map))
- ((listp map)
- ;; FIXME: What about repeated/shadowed keys?
- (if (map--plist-p map) (/ (length map) 2) (length map)))
- ((arrayp map) (length map))
- (t (length (map-keys map)))))
+ "Return the number of key/value pairs in MAP.
+Note that this does not always reflect the number of unique keys.
+The default implementation delegates to `map-do'."
+ (let ((size 0))
+ (map-do (lambda (_k _v) (setq size (1+ size))) map)
+ size))
+
+(cl-defmethod map-length ((map hash-table))
+ (hash-table-count map))
+
+(cl-defmethod map-length ((map list))
+ (if (map--plist-p map)
+ (/ (length map) 2)
+ (length map)))
+
+(cl-defmethod map-length ((map array))
+ (length map))
(cl-defgeneric map-copy (map)
- "Return a copy of MAP."
- ;; FIXME: Clarify how deep is the copy!
- (map--dispatch map
- :list (seq-copy map) ;FIXME: Probably not deep enough for alists!
- :hash-table (copy-hash-table map)
- :array (seq-copy map)))
+ "Return a copy of MAP.")
+
+(cl-defmethod map-copy ((map list))
+ "Use `copy-alist' on alists and `copy-sequence' on plists."
+ (if (map--plist-p map)
+ (copy-sequence map)
+ (copy-alist map)))
+
+(cl-defmethod map-copy ((map hash-table))
+ (copy-hash-table map))
+
+(cl-defmethod map-copy ((map array))
+ (copy-sequence map))
(cl-defgeneric map-apply (function map)
"Apply FUNCTION to each element of MAP and return the result as a list.
@@ -243,26 +270,28 @@ FUNCTION is called with two arguments, the key and the value.")
(cl-defmethod map-do (function (map hash-table)) (maphash function map))
(cl-defgeneric map-keys-apply (function map)
- "Return the result of applying FUNCTION to each key of MAP.
+ "Return the result of applying FUNCTION to each key in MAP.
The default implementation delegates to `map-apply'."
(map-apply (lambda (key _)
(funcall function key))
map))
(cl-defgeneric map-values-apply (function map)
- "Return the result of applying FUNCTION to each value of MAP.
+ "Return the result of applying FUNCTION to each value in MAP.
The default implementation delegates to `map-apply'."
(map-apply (lambda (_ val)
(funcall function val))
map))
+(cl-defmethod map-values-apply (function (map array))
+ (mapcar function map))
+
(cl-defgeneric map-filter (pred map)
"Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
The default implementation delegates to `map-apply'."
(delq nil (map-apply (lambda (key val)
- (if (funcall pred key val)
- (cons key val)
- nil))
+ (and (funcall pred key val)
+ (cons key val)))
map)))
(cl-defgeneric map-remove (pred map)
@@ -272,7 +301,7 @@ The default implementation delegates to `map-filter'."
map))
(cl-defgeneric mapp (map)
- "Return non-nil if MAP is a map (alist, hash-table, array, ...)."
+ "Return non-nil if MAP is a map (alist/plist, hash-table, array, ...)."
(or (listp map)
(hash-table-p map)
(arrayp map)))
@@ -292,130 +321,161 @@ The default implementation delegates to `map-length'."
;; test function!
"Return non-nil if and only if MAP contains KEY.
TESTFN is deprecated. Its default depends on MAP.
-The default implementation delegates to `map-do'."
+The default implementation delegates to `map-some'."
(unless testfn (setq testfn #'equal))
- (catch 'map--catch
- (map-do (lambda (k _v)
- (if (funcall testfn key k) (throw 'map--catch t)))
- map)
- nil))
+ (map-some (lambda (k _v) (funcall testfn key k)) map))
(cl-defmethod map-contains-key ((map list) key &optional testfn)
- (let ((v '(nil)))
- (not (eq v (alist-get key map v nil (or testfn #'equal))))))
+ "Return non-nil if MAP contains KEY.
+If MAP is an alist, TESTFN defaults to `equal'.
+If MAP is a plist, `plist-member' is used instead."
+ (if (map--plist-p map)
+ (plist-member map key)
+ (let ((v '(nil)))
+ (not (eq v (alist-get key map v nil (or testfn #'equal)))))))
(cl-defmethod map-contains-key ((map array) key &optional _testfn)
- (and (integerp key)
- (>= key 0)
- (< key (length map))))
+ "Return non-nil if KEY is an index of MAP, ignoring TESTFN."
+ (and (natnump key) (< key (length map))))
(cl-defmethod map-contains-key ((map hash-table) key &optional _testfn)
+ "Return non-nil if MAP contains KEY, ignoring TESTFN."
(let ((v '(nil)))
(not (eq v (gethash key map v)))))
(cl-defgeneric map-some (pred map)
"Return the first non-nil (PRED key val) in MAP.
-The default implementation delegates to `map-apply'."
+Return nil if no such element is found.
+The default implementation delegates to `map-do'."
;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
;; since as defined, I can't think of a map-type where we could provide an
;; algorithmically more efficient algorithm than the default.
(catch 'map--break
- (map-apply (lambda (key value)
- (let ((result (funcall pred key value)))
- (when result
- (throw 'map--break result))))
- map)
+ (map-do (lambda (key value)
+ (let ((result (funcall pred key value)))
+ (when result
+ (throw 'map--break result))))
+ map)
nil))
(cl-defgeneric map-every-p (pred map)
"Return non-nil if (PRED key val) is non-nil for all elements of MAP.
-The default implementation delegates to `map-apply'."
+The default implementation delegates to `map-do'."
;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
;; since as defined, I can't think of a map-type where we could provide an
;; algorithmically more efficient algorithm than the default.
(catch 'map--break
- (map-apply (lambda (key value)
+ (map-do (lambda (key value)
(or (funcall pred key value)
(throw 'map--break nil)))
map)
t))
+(defun map--merge (merge type &rest maps)
+ "Merge into a map of TYPE all the key/value pairs in MAPS.
+MERGE is a function that takes the target MAP, a KEY, and a
+VALUE, merges KEY and VALUE into MAP, and returns the result.
+MAP may be of a type other than TYPE."
+ ;; Use a hash table internally if `type' is a list. This avoids
+ ;; both quadratic lookup behavior and the type ambiguity of nil.
+ (let* ((tolist (memq type '(list alist plist)))
+ (result (map-into (pop maps)
+ ;; Use same testfn as `map-elt' gv setter.
+ (cond ((eq type 'plist) '(hash-table :test eq))
+ (tolist '(hash-table :test equal))
+ (type)))))
+ (dolist (map maps)
+ (map-do (lambda (key value)
+ (setq result (funcall merge result key value)))
+ map))
+ ;; Convert internal representation to desired type.
+ (if tolist (map-into result type) result)))
+
(defun map-merge (type &rest maps)
- "Merge into a map of type TYPE all the key/value pairs in MAPS.
+ "Merge into a map of TYPE all the key/value pairs in MAPS.
See `map-into' for all supported values of TYPE."
- (let ((result (map-into (pop maps) type)))
- (while maps
- ;; FIXME: When `type' is `list', we get an O(N^2) behavior.
- ;; For small tables, this is fine, but for large tables, we
- ;; should probably use a hash-table internally which we convert
- ;; to an alist in the end.
- (map-apply (lambda (key value)
- (setf (map-elt result key) value))
- (pop maps)))
- result))
+ (apply #'map--merge
+ (lambda (result key value)
+ (setf (map-elt result key) value)
+ result)
+ type maps))
(defun map-merge-with (type function &rest maps)
- "Merge into a map of type TYPE all the key/value pairs in MAPS.
-When two maps contain the same key (`eql'), call FUNCTION on the two
+ "Merge into a map of TYPE all the key/value pairs in MAPS.
+When two maps contain the same key, call FUNCTION on the two
values and use the value returned by it.
-MAP can be a list, hash-table or array.
+Each of MAPS can be an alist, plist, hash-table, or array.
See `map-into' for all supported values of TYPE."
- (let ((result (map-into (pop maps) type))
- (not-found (cons nil nil)))
- (while maps
- (map-apply (lambda (key value)
- (cl-callf (lambda (old)
- (if (eql old not-found)
- value
- (funcall function old value)))
- (map-elt result key not-found)))
- (pop maps)))
- result))
+ (let ((not-found (list nil)))
+ (apply #'map--merge
+ (lambda (result key value)
+ (cl-callf (lambda (old)
+ (if (eql old not-found)
+ value
+ (funcall function old value)))
+ (map-elt result key not-found))
+ result)
+ type maps)))
(cl-defgeneric map-into (map type)
- "Convert the map MAP into a map of type TYPE.")
+ "Convert MAP into a map of TYPE.")
+
;; FIXME: I wish there was a way to avoid this η-redex!
-(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
-(cl-defmethod map-into (map (_type (eql alist))) (map-pairs map))
-(cl-defmethod map-into (map (_type (eql plist)))
- (let ((plist '()))
- (map-do (lambda (k v) (setq plist `(,k ,v ,@plist))) map)
- plist))
+(cl-defmethod map-into (map (_type (eql 'list)))
+ "Convert MAP into an alist."
+ (map-pairs map))
+
+(cl-defmethod map-into (map (_type (eql 'alist)))
+ "Convert MAP into an alist."
+ (map-pairs map))
+
+(cl-defmethod map-into (map (_type (eql 'plist)))
+ "Convert MAP into a plist."
+ (let (plist)
+ (map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
+ (nreverse plist)))
(cl-defgeneric map-put! (map key value &optional testfn)
"Associate KEY with VALUE in MAP.
If KEY is already present in MAP, replace the associated value
with VALUE.
This operates by modifying MAP in place.
-If it cannot do that, it signals the `map-not-inplace' error.
-If you want to insert an element without modifying MAP, use `map-insert'."
+If it cannot do that, it signals a `map-not-inplace' error.
+To insert an element without modifying MAP, use `map-insert'."
;; `testfn' only exists for backward compatibility with `map-put'!
(declare (advertised-calling-convention (map key value) "27.1"))
- (map--dispatch map
- :list
- (if (map--plist-p map)
- (plist-put map key value)
- (let ((oldmap map))
- (setf (alist-get key map key nil (or testfn #'equal)) value)
- (unless (eq oldmap map)
- (signal 'map-not-inplace (list oldmap)))))
- :hash-table (puthash key value map)
- ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
- ;; and let `map-insert' grow the array?
- :array (aset map key value)))
-
-(define-error 'map-inplace "Can only modify map in place")
+ ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
+ (map--dispatch
+ map
+ :list
+ (progn
+ (if (map--plist-p map)
+ (plist-put map key value)
+ (let ((oldmap map))
+ (setf (alist-get key map key nil (or testfn #'equal)) value)
+ (unless (eq oldmap map)
+ (signal 'map-not-inplace (list oldmap)))))
+ ;; Always return the value.
+ value)
+ :hash-table (puthash key value map)
+ ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
+ ;; and let `map-insert' grow the array?
+ :array (aset map key value)))
(cl-defgeneric map-insert (map key value)
"Return a new map like MAP except that it associates KEY with VALUE.
This does not modify MAP.
-If you want to insert an element in place, use `map-put!'."
- (if (listp map)
- (if (map--plist-p map)
- `(,key ,value ,@map)
- (cons (cons key value) map))
- ;; FIXME: Should we signal an error or use copy+put! ?
- (signal 'map-inplace (list map))))
+If you want to insert an element in place, use `map-put!'.
+The default implementation defaults to `map-copy' and `map-put!'."
+ (let ((copy (map-copy map)))
+ (map-put! copy key value)
+ copy))
+
+(cl-defmethod map-insert ((map list) key value)
+ "Cons KEY and VALUE to the front of MAP."
+ (if (map--plist-p map)
+ (cons key (cons value map))
+ (cons (cons key value) map)))
;; There shouldn't be old source code referring to `map--put', yet we do
;; need to keep it for backward compatibility with .elc files where the
@@ -425,11 +485,9 @@ If you want to insert an element in place, use `map-put!'."
(cl-defmethod map-apply (function (map list))
(if (map--plist-p map)
(cl-call-next-method)
- (seq-map (lambda (pair)
- (funcall function
- (car pair)
- (cdr pair)))
- map)))
+ (mapcar (lambda (pair)
+ (funcall function (car pair) (cdr pair)))
+ map)))
(cl-defmethod map-apply (function (map hash-table))
(let (result)
@@ -439,46 +497,40 @@ If you want to insert an element in place, use `map-put!'."
(nreverse result)))
(cl-defmethod map-apply (function (map array))
- (let ((index 0))
- (seq-map (lambda (elt)
- (prog1
- (funcall function index elt)
- (setq index (1+ index))))
- map)))
+ (seq-map-indexed (lambda (elt index)
+ (funcall function index elt))
+ map))
(cl-defmethod map-do (function (map list))
- "Private function used to iterate over ALIST using FUNCTION."
(if (map--plist-p map)
(while map
(funcall function (pop map) (pop map)))
- (seq-do (lambda (pair)
- (funcall function
- (car pair)
- (cdr pair)))
- map)))
+ (mapc (lambda (pair)
+ (funcall function (car pair) (cdr pair)))
+ map)
+ nil))
-(cl-defmethod map-do (function (array array))
- "Private function used to iterate over ARRAY using FUNCTION."
+(cl-defmethod map-do (function (map array))
(seq-do-indexed (lambda (elt index)
- (funcall function index elt))
- array))
+ (funcall function index elt))
+ map))
(defun map--into-hash (map keyword-args)
"Convert MAP into a hash-table.
KEYWORD-ARGS are forwarded to `make-hash-table'."
(let ((ht (apply #'make-hash-table keyword-args)))
- (map-apply (lambda (key value)
- (setf (gethash key ht) value))
- map)
+ (map-do (lambda (key value)
+ (puthash key value ht))
+ map)
ht))
-(cl-defmethod map-into (map (_type (eql hash-table)))
- "Convert MAP into a hash-table."
- (map--into-hash map (list :size (map-length map) :test 'equal)))
+(cl-defmethod map-into (map (_type (eql 'hash-table)))
+ "Convert MAP into a hash-table with keys compared with `equal'."
+ (map--into-hash map (list :size (map-length map) :test #'equal)))
(cl-defmethod map-into (map (type (head hash-table)))
"Convert MAP into a hash-table.
-TYPE is a list where the car is `hash-table' and the cdr are the
+TYPE is a list whose car is `hash-table' and cdr a list of
keyword-args forwarded to `make-hash-table'.
Example:
@@ -487,23 +539,23 @@ Example:
(defun map--make-pcase-bindings (args)
"Return a list of pcase bindings from ARGS to the elements of a map."
- (seq-map (lambda (elt)
- (cond ((consp elt)
- `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
- ((keywordp elt)
- (let ((var (intern (substring (symbol-name elt) 1))))
- `(app (pcase--flip map-elt ,elt) ,var)))
- (t `(app (pcase--flip map-elt ',elt) ,elt))))
- args))
+ (mapcar (lambda (elt)
+ (cond ((consp elt)
+ `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
+ ((keywordp elt)
+ (let ((var (intern (substring (symbol-name elt) 1))))
+ `(app (pcase--flip map-elt ,elt) ,var)))
+ (t `(app (pcase--flip map-elt ',elt) ,elt))))
+ args))
(defun map--make-pcase-patterns (args)
"Return a list of `(map ...)' pcase patterns built from ARGS."
(cons 'map
- (seq-map (lambda (elt)
- (if (and (consp elt) (eq 'map (car elt)))
- (map--make-pcase-patterns elt)
- elt))
- args)))
+ (mapcar (lambda (elt)
+ (if (eq (car-safe elt) 'map)
+ (map--make-pcase-patterns elt)
+ elt))
+ args)))
(provide 'map)
;;; map.el ends here
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 3d6ca957e63..aee2a0079ca 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -44,6 +44,8 @@ by counted more than once."
(pop-to-buffer "*Memory Report*")
(special-mode)
(button-mode 1)
+ (setq-local revert-buffer-function (lambda (_ignore-auto _noconfirm)
+ (memory-report)))
(setq truncate-lines t)
(message "Gathering data...")
(let ((reports (append (memory-report--garbage-collect)
@@ -182,7 +184,7 @@ by counted more than once."
(cl-defmethod memory-report--object-size-1 (_ (value symbol))
;; Don't count global symbols -- makes sizes of lists of symbols too
- ;; heavey.
+ ;; heavy.
(if (intern-soft value obarray)
0
(memory-report--size 'symbol)))
@@ -214,22 +216,21 @@ by counted more than once."
(setf (gethash value counted) t)
(when (car value)
(cl-incf total (memory-report--object-size counted (car value))))
- (if (cdr value)
- (if (consp (cdr value))
- (if (gethash (cdr value) counted)
- (setq value nil)
- (setq value (cdr value)))
- (cl-incf total (memory-report--object-size counted (cdr value)))
- (setq value nil))
- (setq value nil)))
+ (let ((next (cdr value)))
+ (setq value (when next
+ (if (consp next)
+ (unless (gethash next counted)
+ (cdr value))
+ (cl-incf total (memory-report--object-size
+ counted next))
+ nil)))))
total))
(cl-defmethod memory-report--object-size-1 (counted (value vector))
(let ((total (+ (memory-report--size 'vector)
(* (memory-report--size 'object) (length value)))))
(cl-loop for elem across value
- do (setf (gethash elem counted) t)
- (cl-incf total (memory-report--object-size counted elem)))
+ do (cl-incf total (memory-report--object-size counted elem)))
total))
(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
@@ -237,8 +238,6 @@ by counted more than once."
(* (memory-report--size 'object) (hash-table-size value)))))
(maphash
(lambda (key elem)
- (setf (gethash key counted) t)
- (setf (gethash elem counted) t)
(cl-incf total (memory-report--object-size counted key))
(cl-incf total (memory-report--object-size counted elem)))
value)
@@ -295,7 +294,7 @@ by counted more than once."
(- (position-bytes (point-min)))
(gap-size)))
(seq-reduce #'+ (mapcar (lambda (elem)
- (if (cdr elem)
+ (if (and (consp elem) (cdr elem))
(memory-report--object-size
(make-hash-table :test #'eq)
(cdr elem))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index afdd372d273..4804e859ebe 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -316,8 +316,26 @@ is also interactive. There are 3 cases:
`(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
,function ,props))
+(declare-function comp-subr-trampoline-install "comp")
+
;;;###autoload
(defun advice--add-function (where ref function props)
+ (when (and (featurep 'native-compile)
+ (subr-primitive-p (gv-deref ref)))
+ (let ((subr-name (intern (subr-name (gv-deref ref)))))
+ ;; Requiring the native compiler to advice `macroexpand' cause a
+ ;; circular dependency in eager macro expansion. uniquify is
+ ;; advising `rename-buffer' while being loaded in loadup.el.
+ ;; This would require the whole native compiler machinery but we
+ ;; don't want to include it in the dump. Because these two
+ ;; functions are already handled in
+ ;; `native-comp-never-optimize-functions' we hack the problem
+ ;; this way for now :/
+ (unless (memq subr-name '(macroexpand rename-buffer))
+ ;; Must require explicitly as during bootstrap we have no
+ ;; autoloads.
+ (require 'comp)
+ (comp-subr-trampoline-install subr-name))))
(let* ((name (cdr (assq 'name props)))
(a (advice--member-p (or name function) (if name t) (gv-deref ref))))
(when a
@@ -485,7 +503,7 @@ arguments. Note if NAME is nil the advice is anonymous;
otherwise it is named `SYMBOL@NAME'.
\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
- (declare (indent 2) (doc-string 3) (debug (sexp sexp body)))
+ (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
(or (listp args) (signal 'wrong-type-argument (list 'listp args)))
(or (<= 2 (length args) 4)
(signal 'wrong-number-of-arguments (list 2 4 (length args))))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ccd52aa7b33..9ed23862e92 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -73,9 +73,9 @@
;; M-x list-packages
;; Enters a mode similar to buffer-menu which lets you manage
;; packages. You can choose packages for install (mark with "i",
-;; then "x" to execute) or deletion (not implemented yet), and you
-;; can see what packages are available. This will automatically
-;; fetch the latest list of packages from ELPA.
+;; then "x" to execute) or deletion, and you can see what packages
+;; are available. This will automatically fetch the latest list of
+;; packages from ELPA.
;;
;; M-x package-install-from-buffer
;; Install a package consisting of a single .el file that appears
@@ -89,7 +89,7 @@
;; Install a package from the indicated file. The package can be
;; either a tar file or a .el file. A tar file must contain an
;; appropriately-named "-pkg.el" file; a .el file must be properly
-;; formatted as with package-install-from-buffer.
+;; formatted as with `package-install-from-buffer'.
;;; Thanks:
;;; (sorted by sort-lines):
@@ -225,7 +225,7 @@ security."
:type '(alist :key-type (string :tag "Archive name")
:value-type (string :tag "URL or directory name"))
:risky t
- :version "26.1") ; gnutls test
+ :version "28.1")
(defcustom package-menu-hide-low-priority 'archive
"If non-nil, hide low priority packages from the packages menu.
@@ -397,6 +397,12 @@ a sane initial value."
:version "25.1"
:type '(repeat symbol))
+(defcustom package-native-compile nil
+ "Non-nil means to native compile packages on installation."
+ :type '(boolean)
+ :risky t
+ :version "28.1")
+
(defcustom package-menu-async t
"If non-nil, package-menu will use async operations when possible.
Currently, only the refreshing of archive contents supports
@@ -830,8 +836,6 @@ correspond to previously loaded files (those returned by
;; Don't return nil.
t)))
-(declare-function find-library-name "find-func" (library))
-
(defun package--files-load-history ()
(delq nil
(mapcar (lambda (x)
@@ -841,20 +845,22 @@ correspond to previously loaded files (those returned by
load-history)))
(defun package--list-of-conflicts (dir history)
- (delq
- nil
- (mapcar
- (lambda (x) (let* ((file (file-relative-name x dir))
- ;; Previously loaded file, if any.
- (previous
- (ignore-errors
- (file-name-sans-extension
- (file-truename (find-library-name file)))))
- (pos (when previous (member previous history))))
- ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
- (when pos
- (cons (file-name-sans-extension file) (length pos)))))
- (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))
+ (require 'find-func)
+ (declare-function find-library-name "find-func" (library))
+ (delq
+ nil
+ (mapcar
+ (lambda (x) (let* ((file (file-relative-name x dir))
+ ;; Previously loaded file, if any.
+ (previous
+ (ignore-error file-error ;"Can't find library"
+ (file-name-sans-extension
+ (file-truename (find-library-name file)))))
+ (pos (when previous (member previous history))))
+ ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
+ (when pos
+ (cons (file-name-sans-extension file) (length pos)))))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))
(defun package--list-loaded-files (dir)
"Recursively list all files in DIR which correspond to loaded features.
@@ -986,6 +992,8 @@ untar into a directory named DIR; otherwise, signal an error."
;; E.g. for multi-package installs, we should first install all packages
;; and then compile them.
(package--compile new-desc)
+ (when package-native-compile
+ (package--native-compile-async 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)))
@@ -1070,6 +1078,15 @@ This assumes that `pkg-desc' has already been activated with
(load-path load-path))
(byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
+(defun package--native-compile-async (pkg-desc)
+ "Native compile installed package PKG-DESC asynchronously.
+This assumes that `pkg-desc' has already been activated with
+`package-activate-1'."
+ (when (and (featurep 'native-compile)
+ (native-comp-available-p))
+ (let ((warning-minimum-level :error))
+ (native-compile-async (package-desc-dir pkg-desc) t))))
+
;;;; Inferring package from current buffer
(defun package-read-from-string (str)
"Read a Lisp expression from STR.
@@ -1104,7 +1121,7 @@ is wrapped around any parts requiring it."
(declare-function lm-header-multiline "lisp-mnt" (header))
(declare-function lm-homepage "lisp-mnt" (&optional file))
(declare-function lm-keywords-list "lisp-mnt" (&optional file))
-(declare-function lm-maintainer "lisp-mnt" (&optional file))
+(declare-function lm-maintainers "lisp-mnt" (&optional file))
(declare-function lm-authors "lisp-mnt" (&optional file))
(defun package-buffer-info ()
@@ -1150,7 +1167,10 @@ boundaries."
:kind 'single
:url homepage
:keywords keywords
- :maintainer (lm-maintainer)
+ :maintainer
+ ;; For backward compatibility, use a single string if there's only
+ ;; one maintainer (the most common case).
+ (let ((maints (lm-maintainers))) (if (cdr maints) maints (car maints)))
:authors (lm-authors)))))
(defun package--read-pkg-desc (kind)
@@ -1289,7 +1309,10 @@ is non-nil, don't propagate connection errors (does not apply to
errors signaled by ERROR-FORM or by BODY).
\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)"
- (declare (indent defun) (debug t))
+ (declare (indent defun)
+ ;; FIXME: This should be something like
+ ;; `form def-body &rest form', but that doesn't work.
+ (debug (form &rest sexp)))
(while (keywordp (car body))
(setq body (cdr (cdr body))))
`(package--with-response-buffer-1 ,url (lambda () ,@body)
@@ -1347,11 +1370,9 @@ errors signaled by ERROR-FORM or by BODY).
(kill-buffer buffer)
(goto-char (point-min))))))
(package--unless-error body
- (let ((url (expand-file-name file url)))
- (unless (file-name-absolute-p url)
- (error "Location %s is not a url nor an absolute file name"
- url))
- (insert-file-contents-literally url)))))
+ (unless (file-name-absolute-p url)
+ (error "Location %s is not a url nor an absolute file name" url))
+ (insert-file-contents-literally (expand-file-name file url)))))
(define-error 'bad-signature "Failed to verify signature")
@@ -2176,8 +2197,24 @@ Downloads and installs required packages as needed."
((derived-mode-p 'tar-mode)
(package-tar-file-info))
(t
- (save-excursion
- (package-buffer-info)))))
+ ;; Package headers should be parsed from decoded text
+ ;; (see Bug#48137) where possible.
+ (if (and (eq buffer-file-coding-system 'no-conversion)
+ buffer-file-name)
+ (let* ((package-buffer (current-buffer))
+ (decoding-system
+ (car (find-operation-coding-system
+ 'insert-file-contents
+ (cons buffer-file-name
+ package-buffer)))))
+ (with-temp-buffer
+ (insert-buffer-substring package-buffer)
+ (decode-coding-region (point-min) (point-max)
+ decoding-system)
+ (package-buffer-info)))
+
+ (save-excursion
+ (package-buffer-info))))))
(name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
@@ -2203,14 +2240,18 @@ directory."
(setq default-directory file)
(dired-mode))
(insert-file-contents-literally file)
+ (set-visited-file-name file)
(when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
;;;###autoload
-(defun package-install-selected-packages ()
+(defun package-install-selected-packages (&optional noconfirm)
"Ensure packages in `package-selected-packages' are installed.
-If some packages are not installed propose to install them."
+If some packages are not installed, propose to install them.
+If optional argument NOCONFIRM is non-nil, don't ask for
+confirmation to install packages."
(interactive)
+ (package--archives-initialize)
;; We don't need to populate `package-selected-packages' before
;; using here, because the outcome is the same either way (nothing
;; gets installed).
@@ -2221,10 +2262,11 @@ If some packages are not installed propose to install them."
(difference (- (length not-installed) (length available))))
(cond
(available
- (when (y-or-n-p
- (format "Packages to install: %d (%s), proceed? "
- (length available)
- (mapconcat #'symbol-name available " ")))
+ (when (or noconfirm
+ (y-or-n-p
+ (format "Packages to install: %d (%s), proceed? "
+ (length available)
+ (mapconcat #'symbol-name available " "))))
(mapc (lambda (p) (package-install p 'dont-select)) available)))
((> difference 0)
(message "Packages that are not available: %d (the rest is already installed), maybe you need to `M-x package-refresh-contents'"
@@ -2240,6 +2282,17 @@ If some packages are not installed propose to install them."
(equal (cadr (assq (package-desc-name pkg) package-alist))
pkg))
+(declare-function comp-el-to-eln-filename "comp.c")
+(defun package--delete-directory (dir)
+ "Delete DIR recursively.
+Clean-up the corresponding .eln files if Emacs is native
+compiled."
+ (when (featurep 'native-compile)
+ (cl-loop
+ for file in (directory-files-recursively dir "\\.el\\'")
+ do (comp-clean-up-stale-eln (comp-el-to-eln-filename file))))
+ (delete-directory dir t))
+
(defun package-delete (pkg-desc &optional force nosave)
"Delete package PKG-DESC.
@@ -2292,7 +2345,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)
+ (package--delete-directory dir)
;; Remove NAME-VERSION.signed and NAME-readme.txt files.
;;
;; NAME-readme.txt files are no longer created, but they
@@ -2693,9 +2746,9 @@ PROPERTIES are passed to `insert-text-button', for which this
function is a convenience wrapper used by `describe-package-1'."
(let ((button-text (if (display-graphic-p) text (concat "[" text "]")))
(button-face (if (display-graphic-p)
- '(:box (:line-width 2 :color "dark grey")
- :background "light grey"
- :foreground "black")
+ (progn
+ (require 'cus-edit) ; for the custom-button face
+ 'custom-button)
'link)))
(apply #'insert-text-button button-text 'face button-face 'follow-link t
properties)))
@@ -2732,6 +2785,7 @@ either a full name or nil, and EMAIL is a valid email address."
(define-key map "U" 'package-menu-mark-upgrades)
(define-key map "r" 'revert-buffer)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
+ (define-key map "w" 'package-browse-url)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "H" #'package-menu-hide-package)
@@ -2754,6 +2808,8 @@ either a full name or nil, and EMAIL is a valid email address."
"Menu for `package-menu-mode'."
'("Package"
["Describe Package" package-menu-describe-package :help "Display information about this package"]
+ ["Open Package Homepage" package-browse-url
+ :help "Open the homepage of this package"]
["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"]
"--"
["Refresh Package List" revert-buffer
@@ -2803,6 +2859,7 @@ either a full name or nil, and EMAIL is a valid email address."
Letters do not insert themselves; instead, they are commands.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
+ :interactive nil
(setq mode-line-process '((package--downloads-in-progress ":Loading")
(package-menu--transaction-status
package-menu--transaction-status)))
@@ -2925,7 +2982,7 @@ Installed obsolete packages are always displayed.")
Also hide packages whose name matches a regexp in user option
`package-hidden-regexps' (a list). To add regexps to this list,
use `package-menu-hide-package'."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(setq package-menu--hide-packages
(not package-menu--hide-packages))
@@ -3262,7 +3319,7 @@ To unhide a package, type
Type \\[package-menu-toggle-hiding] to toggle package hiding."
(declare (interactive-only "change `package-hidden-regexps' instead."))
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(let* ((name (when (derived-mode-p 'package-menu-mode)
(concat "\\`" (regexp-quote (symbol-name (package-desc-name
@@ -3286,7 +3343,7 @@ Type \\[package-menu-toggle-hiding] to toggle package hiding."
(defun package-menu-describe-package (&optional button)
"Describe the current package.
If optional arg BUTTON is non-nil, describe its associated package."
- (interactive)
+ (interactive nil package-menu-mode)
(let ((pkg-desc (if button (button-get button 'package-desc)
(tabulated-list-get-id))))
(if pkg-desc
@@ -3296,7 +3353,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
;; fixme numeric argument
(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status)
'("installed" "dependency" "obsolete" "unsigned"))
@@ -3305,7 +3362,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
(tabulated-list-put-tag "I" t)
@@ -3313,20 +3370,20 @@ If optional arg BUTTON is non-nil, describe its associated package."
(defun package-menu-mark-unmark (&optional _num)
"Clear any marks on a package and move to the next line."
- (interactive "p")
+ (interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(tabulated-list-put-tag " " t))
(defun package-menu-backup-unmark ()
"Back up one line and clear any marks on that package."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(forward-line -1)
(tabulated-list-put-tag " "))
(defun package-menu-mark-obsolete-for-deletion ()
"Mark all obsolete packages for deletion."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(save-excursion
(goto-char (point-min))
@@ -3336,7 +3393,8 @@ If optional arg BUTTON is non-nil, describe its associated package."
(forward-line 1)))))
(defvar package--quick-help-keys
- '(("install," "delete," "unmark," ("execute" . 1))
+ '((("mark for installation," . 9)
+ ("mark for deletion," . 9) "unmark," ("execute marked actions" . 1))
("next," "previous")
("Hide-package," "(-toggle-hidden")
("g-refresh-contents," "/-filter," "help")))
@@ -3357,7 +3415,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
(defun package-menu-quick-help ()
"Show short key binding help for `package-menu-mode'.
The full list of keys can be viewed with \\[describe-mode]."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(message (mapconcat #'package--prettify-quick-help-key
package--quick-help-keys "\n")))
@@ -3453,7 +3511,7 @@ call will upgrade the package.
If there's an async refresh operation in progress, the flags will
be placed as part of `package-menu--post-refresh' instead of
immediately."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(if (not package--downloads-in-progress)
(package-menu--mark-upgrades-1)
@@ -3547,7 +3605,7 @@ packages list, respectively."
Packages marked for installation are downloaded and installed;
packages marked for deletion are removed.
Optional argument NOQUERY non-nil means do not ask the user to confirm."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(let (install-list delete-list cmd pkg-desc)
(save-excursion
@@ -3792,7 +3850,8 @@ strings. If ARCHIVE is nil or the empty string, show all
packages."
(interactive (list (completing-read-multiple
"Filter by archive (comma separated): "
- (mapcar #'car package-archives))))
+ (mapcar #'car package-archives)))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(let ((re (if (listp archive)
(regexp-opt archive)
@@ -3813,7 +3872,8 @@ DESCRIPTION.
When called interactively, prompt for DESCRIPTION.
If DESCRIPTION is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by description (regexp)")))
+ (interactive (list (read-regexp "Filter by description (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not description) (string-empty-p description))
(package-menu--generate t t)
@@ -3834,10 +3894,11 @@ strings. If KEYWORD is nil or the empty string, show all
packages."
(interactive (list (completing-read-multiple
"Keywords (comma separated): "
- (package-all-keywords))))
+ (package-all-keywords)))
+ package-menu-mode)
+ (package--ensure-package-menu-mode)
(when (stringp keyword)
(setq keyword (list keyword)))
- (package--ensure-package-menu-mode)
(if (not keyword)
(package-menu--generate t t)
(package-menu--filter-by (lambda (pkg-desc)
@@ -3856,7 +3917,8 @@ When called interactively, prompt for NAME-OR-DESCRIPTION.
If NAME-OR-DESCRIPTION is nil or the empty string, show all
packages."
- (interactive (list (read-regexp "Filter by name or description (regexp)")))
+ (interactive (list (read-regexp "Filter by name or description (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not name-or-description) (string-empty-p name-or-description))
(package-menu--generate t t)
@@ -3875,7 +3937,8 @@ Display only packages with name that matches regexp NAME.
When called interactively, prompt for NAME.
If NAME is nil or the empty string, show all packages."
- (interactive (list (read-regexp "Filter by name (regexp)")))
+ (interactive (list (read-regexp "Filter by name (regexp)"))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not name) (string-empty-p name))
(package-menu--generate t t)
@@ -3905,13 +3968,19 @@ packages."
"incompat"
"installed"
"new"
- "unsigned"))))
+ "unsigned")))
+ package-menu-mode)
(package--ensure-package-menu-mode)
(if (or (not status) (string-empty-p status))
(package-menu--generate t t)
- (package-menu--filter-by (lambda (pkg-desc)
- (string-match-p status (package-desc-status pkg-desc)))
- (format "status:%s" status))))
+ (let ((status-list
+ (if (listp status)
+ status
+ (split-string status ","))))
+ (package-menu--filter-by
+ (lambda (pkg-desc)
+ (member (package-desc-status pkg-desc) status-list))
+ (format "status:%s" (string-join status-list ","))))))
(defun package-menu-filter-by-version (version predicate)
"Filter the \"*Packages*\" buffer by VERSION and PREDICATE.
@@ -3940,7 +4009,9 @@ If VERSION is nil or the empty string, show all packages."
('< "< less than")
('> "> greater than"))
"): "))
- choice))))
+ choice)))
+ package-menu-mode)
+ (package--ensure-package-menu-mode)
(unless (equal predicate 'quit)
(if (or (not version) (string-empty-p version))
(package-menu--generate t t)
@@ -3958,7 +4029,7 @@ If VERSION is nil or the empty string, show all packages."
(defun package-menu-filter-marked ()
"Filter \"*Packages*\" buffer by non-empty upgrade mark.
Unlike other filters, this leaves the marks intact."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(widen)
(let (found-entries mark pkg-id entry marks)
@@ -3986,7 +4057,7 @@ Unlike other filters, this leaves the marks intact."
(defun package-menu-filter-upgradable ()
"Filter \"*Packages*\" buffer to show only upgradable packages."
- (interactive)
+ (interactive nil package-menu-mode)
(let ((pkgs (mapcar #'car (package-menu--find-upgrades))))
(package-menu--filter-by
(lambda (pkg)
@@ -3995,7 +4066,7 @@ Unlike other filters, this leaves the marks intact."
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
- (interactive)
+ (interactive nil package-menu-mode)
(package--ensure-package-menu-mode)
(package-menu--generate t t))
@@ -4016,10 +4087,7 @@ The return value is a string (or nil in case we can't find it)."
;; the version at compile time and hardcodes it into the .elc file!
(declare (pure t))
;; Hack alert!
- (let ((file
- (or (if (boundp 'byte-compile-current-file) byte-compile-current-file)
- load-file-name
- buffer-file-name)))
+ (let ((file (or (macroexp-file-name) buffer-file-name)))
(cond
((null file) nil)
;; Packages are normally installed into directories named "<pkg>-<vers>",
@@ -4088,6 +4156,10 @@ activations need to be changed, such as when `package-load-list' is modified."
(package-activated-list ())
;; Make sure we can load this file without load-source-file-function.
(coding-system-for-write 'emacs-internal)
+ ;; Ensure that `pp' and `prin1-to-string' calls further down
+ ;; aren't truncated.
+ (print-length nil)
+ (print-level nil)
(Info-directory-list '("")))
(dolist (elt package-alist)
(condition-case err
@@ -4106,7 +4178,8 @@ activations need to be changed, such as when `package-load-list' is modified."
(let ((load-suffixes '(".el" ".elc")))
(locate-library (package--autoloads-file-name pkg))))
(pfile (prin1-to-string file)))
- (insert "(let ((load-file-name " pfile "))\n")
+ (insert "(let ((load-true-file-name " pfile ")\
+(load-file-name " pfile "))\n")
(insert-file-contents file)
;; Fixup the special #$ reader form and throw away comments.
(while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move)
@@ -4155,6 +4228,22 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
+(defun package-browse-url (desc &optional secondary)
+ "Open the home page of the package under point in a browser.
+`browse-url' is used to determine the browser to be used.
+If SECONDARY (interactively, the prefix), use the secondary browser."
+ (interactive (list (tabulated-list-get-id)
+ current-prefix-arg)
+ package-menu-mode)
+ (unless desc
+ (user-error "No package here"))
+ (let ((url (cdr (assoc :url (package-desc-extras desc)))))
+ (unless url
+ (user-error "No home page for %s" (package-desc-name desc)))
+ (if secondary
+ (funcall browse-url-secondary-browser-function url)
+ (browse-url url))))
+
;;;; Introspection
(defun package-get-descriptor (pkg-name)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ec746fa4747..63b187be02b 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -27,19 +27,10 @@
;; Todo:
-;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't
-;; use x, because x is bound separately for the equality constraint
-;; (as well as any pred/guard) and for the body, so uses at one place don't
-;; count for the other.
-;; - provide ways to extend the set of primitives, with some kind of
-;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP)
-;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)).
-;; But better would be if we could define new ways to match by having the
-;; extension provide its own `pcase--split-<foo>' thingy.
-;; - along these lines, provide patterns to match CL structs.
+;; - Allow to provide new `pcase--split-<foo>' thingy.
;; - provide something like (setq VAR) so a var can be set rather than
;; let-bound.
-;; - provide a way to fallthrough to subsequent cases
+;; - provide a way to continue matching to subsequent cases
;; (e.g. Like Racket's (=> ID).
;; - try and be more clever to reduce the size of the decision tree, and
;; to reduce the number of leaves that need to be turned into functions:
@@ -71,48 +62,37 @@
(defvar pcase--dontwarn-upats '(pcase--dontcare))
-(def-edebug-spec
- pcase-PAT
- (&or symbolp
- ("or" &rest pcase-PAT)
- ("and" &rest pcase-PAT)
- ("guard" form)
- ("let" pcase-PAT form)
- ("pred" pcase-FUN)
- ("app" pcase-FUN pcase-PAT)
- pcase-MACRO
- sexp))
-
-(def-edebug-spec
- pcase-FUN
- (&or lambda-expr
- ;; Punt on macros/special forms.
- (functionp &rest form)
- sexp))
-
-;; See bug#24717
-(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro)
+(def-edebug-elem-spec 'pcase-PAT
+ '(&or (&interpose symbolp pcase--edebug-match-pat-args) sexp))
+
+(def-edebug-elem-spec 'pcase-FUN
+ '(&or lambda-expr
+ ;; Punt on macros/special forms.
+ (functionp &rest form)
+ sexp))
;; Only called from edebug.
-(declare-function get-edebug-spec "edebug" (symbol))
-(declare-function edebug-match "edebug" (cursor specs))
+(declare-function edebug-get-spec "edebug" (symbol))
+(defun pcase--edebug-match-pat-args (head pf)
+ ;; (cl-assert (null (cdr head)))
+ (setq head (car head))
+ (or (alist-get head '((quote sexp)
+ (or &rest pcase-PAT)
+ (and &rest pcase-PAT)
+ (guard form)
+ (pred &or ("not" pcase-FUN) pcase-FUN)
+ (app pcase-FUN pcase-PAT)))
+ (let ((me (pcase--get-macroexpander head)))
+ (funcall pf (and me (symbolp me) (edebug-get-spec me))))))
(defun pcase--get-macroexpander (s)
"Return the macroexpander for pcase pattern head S, or nil"
(get s 'pcase-macroexpander))
-(defun pcase--edebug-match-macro (cursor)
- (let (specs)
- (mapatoms
- (lambda (s)
- (let ((m (pcase--get-macroexpander s)))
- (when (and m (get-edebug-spec m))
- (push (cons (symbol-name s) (get-edebug-spec m))
- specs)))))
- (edebug-match cursor (cons '&or specs))))
-
;;;###autoload
(defmacro pcase (exp &rest cases)
+ ;; FIXME: Add some "global pattern" to wrap every case?
+ ;; Could be used to wrap all cases in a `
"Evaluate EXP to get EXPVAL; try passing control to one of CASES.
CASES is a list of elements of the form (PATTERN CODE...).
For the first CASE whose PATTERN \"matches\" EXPVAL,
@@ -227,6 +207,7 @@ If EXP fails to match any of the patterns in CASES, an error is signaled."
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
;; FIXME: Could we add the FILE:LINE data in the error message?
+ ;; FILE is available from `macroexp-file-name'.
exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
;;;###autoload
@@ -336,86 +317,168 @@ of the elements of LIST is performed as if by `pcase-let'.
(pcase-let* ((,(car spec) ,tmpvar))
,@body)))))
+;;;###autoload
+(defmacro pcase-setq (pat val &rest args)
+ "Assign values to variables by destructuring with `pcase'.
+PATTERNS are normal `pcase' patterns, and VALUES are expression.
+
+Evaluation happens sequentially as in `setq' (not in parallel).
+
+An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+
+VAL is presumed to match PAT. Failure to match may signal an error or go
+undetected, binding variables to arbitrary values, such as nil.
+
+\(fn PATTERNS VALUE PATTERN VALUES ...)"
+ (declare (debug (&rest [pcase-PAT form])))
+ (cond
+ (args
+ (let ((arg-length (length args)))
+ (unless (= 0 (mod arg-length 2))
+ (signal 'wrong-number-of-arguments
+ (list 'pcase-setq (+ 2 arg-length)))))
+ (let ((result))
+ (while args
+ (push `(pcase-setq ,(pop args) ,(pop args))
+ result))
+ `(progn
+ (pcase-setq ,pat ,val)
+ ,@(nreverse result))))
+ ((pcase--trivial-upat-p pat)
+ `(setq ,pat ,val))
+ (t
+ (pcase-compile-patterns
+ val
+ `((,pat
+ . ,(lambda (varvals &rest _)
+ `(setq ,@(mapcan (lambda (varval)
+ (let ((var (car varval))
+ (val (cadr varval)))
+ (list var val)))
+ varvals))))
+ (pcase--dontcare . ignore))))))
(defun pcase--trivial-upat-p (upat)
(and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
-(defun pcase--expand (exp cases)
- ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
- ;; (emacs-pid) exp (sxhash cases))
+(defun pcase-compile-patterns (exp cases)
+ "Compile the set of patterns in CASES.
+EXP is the expression that will be matched against the patterns.
+CASES is a list of elements (PAT . CODEGEN)
+where CODEGEN is a function that returns the code to use when
+PAT matches. That code has to be in the form of a cons cell.
+
+CODEGEN will be called with at least 2 arguments, VARVALS and COUNT.
+VARVALS is a list of elements of the form (VAR VAL . RESERVED) where VAR
+is a variable bound by the pattern and VAL is a duplicable expression
+that returns the value this variable should be bound to.
+If the pattern PAT uses `or', CODEGEN may be called multiple times,
+in which case it may want to generate the code differently to avoid
+a potential code explosion. For this reason the COUNT argument indicates
+how many time this CODEGEN is called."
(macroexp-let2 macroexp-copyable-p val exp
- (let* ((defs ())
- (seen '())
- (codegen
- (lambda (code vars)
- (let ((vars (macroexp--fgrep vars code))
- (prev (assq code seen)))
- (if (not prev)
- (let ((res (pcase-codegen code vars)))
- (push (list code vars res) seen)
- res)
- ;; Since we use a tree-based pattern matching
- ;; technique, the leaves (the places that contain the
- ;; code to run once a pattern is matched) can get
- ;; copied a very large number of times, so to avoid
- ;; code explosion, we need to keep track of how many
- ;; times we've used each leaf and move it
- ;; to a separate function if that number is too high.
- ;;
- ;; We've already used this branch. So it is shared.
- (let* ((code (car prev)) (cdrprev (cdr prev))
- (prevvars (car cdrprev)) (cddrprev (cdr cdrprev))
- (res (car cddrprev)))
- (unless (symbolp res)
- ;; This is the first repeat, so we have to move
- ;; the branch to a separate function.
- (let ((bsym
- (make-symbol (format "pcase-%d" (length defs)))))
- (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
- defs)
- (setcar res 'funcall)
- (setcdr res (cons bsym (mapcar #'cdr prevvars)))
- (setcar (cddr prev) bsym)
- (setq res bsym)))
- (setq vars (copy-sequence vars))
- (let ((args (mapcar (lambda (pa)
- (let ((v (assq (car pa) vars)))
- (setq vars (delq v vars))
- (cdr v)))
- prevvars)))
- ;; If some of `vars' were not found in `prevvars', that's
- ;; OK it just means those vars aren't present in all
- ;; branches, so they can be used within the pattern
- ;; (e.g. by a `guard/let/pred') but not in the branch.
- ;; FIXME: But if some of `prevvars' are not in `vars' we
- ;; should remove them from `prevvars'!
- `(funcall ,res ,@args)))))))
- (used-cases ())
+ (let* ((seen '())
+ (phcounter 0)
(main
(pcase--u
- (mapcar (lambda (case)
- `(,(pcase--match val (pcase--macroexpand (car case)))
- ,(lambda (vars)
- (unless (memq case used-cases)
- ;; Keep track of the cases that are used.
- (push case used-cases))
- (funcall
- (if (pcase--small-branch-p (cdr case))
- ;; Don't bother sharing multiple
- ;; occurrences of this leaf since it's small.
- (lambda (code vars)
- (pcase-codegen code
- (macroexp--fgrep vars code)))
- codegen)
- (cdr case)
- vars))))
- cases))))
+ (mapcar
+ (lambda (case)
+ `(,(pcase--match val (pcase--macroexpand (car case)))
+ ,(lambda (vars)
+ (let ((prev (assq case seen)))
+ (unless prev
+ ;; Keep track of the cases that are used.
+ (push (setq prev (list case)) seen))
+ ;; Put a counter in the cdr just so that not
+ ;; all branches look identical (to avoid things
+ ;; like `macroexp--if' optimizing them too
+ ;; optimistically).
+ (let ((ph (cons 'pcase--placeholder
+ (setq phcounter (1+ phcounter)))))
+ (setcdr prev (cons (cons vars ph) (cdr prev)))
+ ph)))))
+ cases))))
+ ;; Take care of the place holders now.
+ (dolist (branch seen)
+ (let ((codegen (cdar branch))
+ (uses (cdr branch)))
+ ;; Find all the vars that are in scope (the union of the
+ ;; vars provided in each use case).
+ (let* ((allvarinfo '())
+ (_ (dolist (use uses)
+ (dolist (v (car use))
+ (let ((vi (assq (car v) allvarinfo)))
+ (if vi
+ (if (cddr v) (setcdr vi 'used))
+ (push (cons (car v) (cddr v)) allvarinfo))))))
+ (allvars (mapcar #'car allvarinfo)))
+ (dolist (use uses)
+ (let* ((vars (car use))
+ (varvals
+ (mapcar (lambda (v)
+ `(,v ,(cadr (assq v vars))
+ ,(cdr (assq v allvarinfo))))
+ allvars))
+ (placeholder (cdr use))
+ (code (funcall codegen varvals (length uses))))
+ ;; (cl-assert (eq (car placeholder) 'pcase--placeholder))
+ (setcar placeholder (car code))
+ (setcdr placeholder (cdr code)))))))
(dolist (case cases)
- (unless (or (memq case used-cases)
+ (unless (or (assq case seen)
(memq (car case) pcase--dontwarn-upats))
- (message "pcase pattern %S shadowed by previous pcase pattern"
- (car case))))
- (macroexp-let* defs main))))
+ (setq main
+ (macroexp-warn-and-return
+ (format "pcase pattern %S shadowed by previous pcase pattern"
+ (car case))
+ main))))
+ main)))
+
+(defun pcase--expand (exp cases)
+ ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
+ ;; (emacs-pid) exp (sxhash cases))
+ (let* ((defs ())
+ (codegen
+ (lambda (code)
+ (if (member code '(nil (nil) ('nil)))
+ (lambda (&rest _) ''nil)
+ (let ((bsym ()))
+ (lambda (varvals count &rest _)
+ (let* ((ignored-vars
+ (delq nil (mapcar (lambda (vv) (if (nth 2 vv) (car vv)))
+ varvals)))
+ (ignores (if ignored-vars
+ `((ignore . ,ignored-vars)))))
+ ;; Since we use a tree-based pattern matching
+ ;; technique, the leaves (the places that contain the
+ ;; code to run once a pattern is matched) can get
+ ;; copied a very large number of times, so to avoid
+ ;; code explosion, we need to keep track of how many
+ ;; times we've used each leaf and move it
+ ;; to a separate function if that number is too high.
+ (if (or (< count 2) (pcase--small-branch-p code))
+ `(let ,(mapcar (lambda (vv) (list (car vv) (cadr vv)))
+ varvals)
+ ;; Try and silence some of the most common
+ ;; spurious "unused var" warnings.
+ ,@ignores
+ ,@code)
+ ;; Several occurrence of this non-small branch in
+ ;; the output.
+ (unless bsym
+ (setq bsym (make-symbol
+ (format "pcase-%d" (length defs))))
+ (push `(,bsym (lambda ,(mapcar #'car varvals)
+ ,@ignores ,@code))
+ defs))
+ `(funcall ,bsym ,@(mapcar #'cadr varvals)))))))))
+ (main
+ (pcase-compile-patterns
+ exp
+ (mapcar (lambda (case)
+ (cons (car case) (funcall codegen (cdr case))))
+ cases))))
+ (macroexp-let* defs main)))
(defun pcase--macroexpand (pat)
"Expands all macro-patterns in PAT."
@@ -452,7 +515,13 @@ for the result of evaluating EXP (first arg to `pcase').
(decl (assq 'declare body)))
(when decl (setq body (remove decl body)))
`(progn
- (defun ,fsym ,args ,@body)
+ ;; FIXME: We use `eval-and-compile' here so that the pcase macro can be
+ ;; used in the same file where it's defined, but ideally, we should
+ ;; handle this using something similar to `overriding-plist-environment'
+ ;; but for `symbol-function' slots so compiling a file doesn't have the
+ ;; side-effect of defining the function.
+ (eval-and-compile
+ (defun ,fsym ,args ,@body))
(define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
(define-symbol-prop ',name 'pcase-macroexpander #',fsym))))
@@ -468,15 +537,6 @@ for the result of evaluating EXP (first arg to `pcase').
(t
`(match ,val . ,upat))))
-(defun pcase-codegen (code vars)
- ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
- ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
- ;; codegen from later metamorphosing this let into a funcall.
- (if vars
- `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
- ,@code)
- `(progn ,@code)))
-
(defun pcase--small-branch-p (code)
(and (= 1 (length code))
(or (not (consp (car code)))
@@ -489,8 +549,10 @@ for the result of evaluating EXP (first arg to `pcase').
;; the depth of the generated tree.
(defun pcase--if (test then else)
(cond
- ((eq else :pcase--dontcare) then)
- ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen?
+ ((eq else :pcase--dontcare) `(progn (ignore ,test) ,then))
+ ;; This happens very rarely. Known case:
+ ;; (pcase EXP ((and 1 pcase--dontcare) FOO))
+ ((eq then :pcase--dontcare) `(progn (ignore ,test) ,else))
(t (macroexp-if test then else))))
;; Note about MATCH:
@@ -515,11 +577,14 @@ for the result of evaluating EXP (first arg to `pcase').
"Expand matcher for rules BRANCHES.
Each BRANCH has the form (MATCH CODE . VARS) where
CODE is the code generator for that branch.
-VARS is the set of vars already bound by earlier matches.
MATCH is the pattern that needs to be matched, of the form:
(match VAR . PAT)
(and MATCH ...)
- (or MATCH ...)"
+ (or MATCH ...)
+VARS is the set of vars already bound by earlier matches.
+It is a list of (NAME VAL . USED) where NAME is the variable's symbol,
+VAL is the expression to which it should be bound and USED is a boolean
+recording whether the var has been referenced by earlier parts of the match."
(when (setq branches (delq nil branches))
(let* ((carbranch (car branches))
(match (car carbranch)) (cdarbranch (cdr carbranch))
@@ -662,7 +727,7 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--split-pred (vars upat pat)
"Indicate the overlap or mutual-exclusion between UPAT and PAT.
-More specifically retuns a pair (A . B) where A indicates whether PAT
+More specifically returns a pair (A . B) where A indicates whether PAT
can match when UPAT has matched, and B does the same for the case
where UPAT failed to match.
A and B can be one of:
@@ -679,7 +744,7 @@ A and B can be one of:
;; run, but we don't have the environment in which `pat' will
;; run, so we can't do a reliable verification. But let's try
;; and catch at least the easy cases such as (bug#14773).
- (not (macroexp--fgrep (mapcar #'car vars) (cadr upat)))))
+ (not (macroexp--fgrep vars (cadr upat)))))
'(:pcase--succeed . :pcase--fail))
;; In case PAT is of the form (pred (not PRED))
((and (eq 'pred (car-safe pat)) (eq 'not (car-safe (cadr pat))))
@@ -766,8 +831,11 @@ A and B can be one of:
((symbolp fun) `(,fun ,arg))
((eq 'not (car-safe fun)) `(not ,(pcase--funcall (cadr fun) arg vars)))
(t
- (let* (;; `env' is an upper bound on the bindings we need.
- (env (mapcar (lambda (x) (list (car x) (cdr x)))
+ (let* (;; `env' is hopefully an upper bound on the bindings we need,
+ ;; FIXME: See bug#46786 for a counter example :-(
+ (env (mapcar (lambda (x)
+ (setcdr (cdr x) 'used)
+ (list (car x) (cadr x)))
(macroexp--fgrep vars fun)))
(call (progn
(when (assq arg env)
@@ -775,7 +843,7 @@ A and B can be one of:
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
(setq arg newsym)))
- (if (functionp fun)
+ (if (or (functionp fun) (not (consp fun)))
`(funcall #',fun ,arg)
`(,@fun ,arg)))))
(if (null env)
@@ -788,10 +856,12 @@ A and B can be one of:
(defun pcase--eval (exp vars)
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
- (if found (cdr found)
+ (if found (progn (setcdr (cdr found) 'used) (cadr found))
(let* ((env (macroexp--fgrep vars exp)))
(if env
- (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
+ (macroexp-let* (mapcar (lambda (x)
+ (setcdr (cdr x) 'used)
+ (list (car x) (cadr x)))
env)
exp)
exp)))))
@@ -804,7 +874,7 @@ Otherwise, it defers to REST which is a list of branches of the form
\(ELSE-MATCH ELSE-CODE . ELSE-VARS)."
;; Depending on the order in which we choose to check each of the MATCHES,
;; the resulting tree may be smaller or bigger. So in general, we'd want
- ;; to be careful to chose the "optimal" order. But predicate
+ ;; to be careful to choose the "optimal" order. But predicate
;; patterns make this harder because they create dependencies
;; between matches. So we don't bother trying to reorder anything.
(cond
@@ -865,7 +935,7 @@ Otherwise, it defers to REST which is a list of branches of the form
((memq upat '(t _))
(let ((code (pcase--u1 matches code vars rest)))
(if (eq upat '_) code
- (macroexp--warn-and-return
+ (macroexp-warn-and-return
"Pattern t is deprecated. Use `_' instead"
code))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
@@ -883,12 +953,14 @@ Otherwise, it defers to REST which is a list of branches of the form
(pcase--u else-rest))))
((and (symbolp upat) upat)
(pcase--mark-used sym)
- (if (not (assq upat vars))
- (pcase--u1 matches code (cons (cons upat sym) vars) rest)
- ;; Non-linear pattern. Turn it into an `eq' test.
- (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars)))))
- matches)
- code vars rest)))
+ (let ((v (assq upat vars)))
+ (if (not v)
+ (pcase--u1 matches code (cons (list upat sym) vars) rest)
+ ;; Non-linear pattern. Turn it into an `eq' test.
+ (setcdr (cdr v) 'used)
+ (pcase--u1 (cons `(match ,sym . (pred (eql ,(cadr v))))
+ matches)
+ code vars rest))))
((eq (car-safe upat) 'app)
;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
@@ -946,14 +1018,13 @@ Otherwise, it defers to REST which is a list of branches of the form
(t (error "Unknown pattern `%S'" upat)))))
(t (error "Incorrect MATCH %S" (car matches)))))
-(def-edebug-spec
- pcase-QPAT
+(def-edebug-elem-spec 'pcase-QPAT
;; Cf. edebug spec for `backquote-form' in edebug.el.
- (&or ("," pcase-PAT)
- (pcase-QPAT [&rest [&not ","] pcase-QPAT]
- . [&or nil pcase-QPAT])
- (vector &rest pcase-QPAT)
- sexp))
+ '(&or ("," pcase-PAT)
+ (pcase-QPAT [&rest [&not ","] pcase-QPAT]
+ . [&or nil pcase-QPAT])
+ (vector &rest pcase-QPAT)
+ sexp))
(pcase-defmacro \` (qpat)
"Backquote-style pcase patterns: \\=`QPAT
@@ -992,8 +1063,8 @@ The predicate is the logical-AND of:
(nreverse upats))))
((consp qpat)
`(and (pred consp)
- (app car ,(list '\` (car qpat)))
- (app cdr ,(list '\` (cdr qpat)))))
+ (app car-safe ,(list '\` (car qpat)))
+ (app cdr-safe ,(list '\` (cdr qpat)))))
((or (stringp qpat) (numberp qpat) (symbolp qpat)) `',qpat)
;; In all other cases just raise an error so we can't break
;; backward compatibility when adding \` support for other
@@ -1002,7 +1073,13 @@ The predicate is the logical-AND of:
(pcase-defmacro let (pat expr)
"Matches if EXPR matches PAT."
+ (declare (debug (pcase-PAT form)))
`(app (lambda (_) ,expr) ,pat))
+;; (pcase-defmacro guard (expr)
+;; "Matches if EXPR is non-nil."
+;; (declare (debug (form)))
+;; `(pred (lambda (_) ,expr)))
+
(provide 'pcase)
;;; pcase.el ends here
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index ef4c9603284..0bf774dffd8 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -127,8 +127,9 @@ Also add the value to the front of the list in the variable `values'."
(interactive
(list (read--expression "Eval: ")))
(message "Evaluating...")
- (push (eval expression lexical-binding) values)
- (pp-display-expression (car values) "*Pp Eval Output*"))
+ (let ((result (eval expression lexical-binding)))
+ (values--store-value result)
+ (pp-display-expression result "*Pp Eval Output*")))
;;;###autoload
(defun pp-macroexpand-expression (expression)
@@ -138,7 +139,7 @@ Also add the value to the front of the list in the variable `values'."
(pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*"))
(defun pp-last-sexp ()
- "Read sexp before point. Ignores leading comment characters."
+ "Read sexp before point. Ignore leading comment characters."
(with-syntax-table emacs-lisp-mode-syntax-table
(let ((pt (point)))
(save-excursion
@@ -158,7 +159,7 @@ Also add the value to the front of the list in the variable `values'."
;;;###autoload
(defun pp-eval-last-sexp (arg)
"Run `pp-eval-expression' on sexp before point.
-With argument, pretty-print output into current buffer.
+With ARG, pretty-print output into current buffer.
Ignores leading comment characters."
(interactive "P")
(if arg
@@ -171,7 +172,7 @@ Ignores leading comment characters."
;;;###autoload
(defun pp-macroexpand-last-sexp (arg)
"Run `pp-macroexpand-expression' on sexp before point.
-With argument, pretty-print output into current buffer.
+With ARG, pretty-print output into current buffer.
Ignores leading comment characters."
(interactive "P")
(if arg
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index 0905ac608bb..a529ed025d6 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -194,14 +194,13 @@ If not found, return nil."
"Return an alist of all bindings in TREE for prefixes of STRING."
(radix-tree--prefixes tree string 0 nil))
-(eval-and-compile
- (pcase-defmacro radix-tree-leaf (vpat)
- "Pattern which matches a radix-tree leaf.
+(pcase-defmacro radix-tree-leaf (vpat)
+ "Pattern which matches a radix-tree leaf.
The pattern VPAT is matched against the leaf's carried value."
- ;; We used to use `(pred atom)', but `pcase' doesn't understand that
- ;; `atom' is equivalent to the negation of `consp' and hence generates
- ;; suboptimal code.
- `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat))))
+ ;; We used to use `(pred atom)', but `pcase' doesn't understand that
+ ;; `atom' is equivalent to the negation of `consp' and hence generates
+ ;; suboptimal code.
+ `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat)))
(defun radix-tree-iter-subtrees (tree fun)
"Apply FUN to every immediate subtree of radix TREE.
@@ -241,7 +240,7 @@ PREFIX is only used internally."
(declare-function map-apply "map" (function map))
(defun radix-tree-from-map (map)
- ;; Aka (cl-defmethod map-into (map (type (eql radix-tree)))) ...)
+ ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...)
(require 'map)
(let ((rt nil))
(map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index ce8d98df807..aec438ed994 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -217,8 +217,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
;; Define the local "\C-c" keymap
(defvar reb-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'reb-toggle-case)
(define-key map "\C-c\C-q" 'reb-quit)
(define-key map "\C-c\C-w" 'reb-copy)
@@ -228,43 +227,37 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(define-key map "\C-c\C-e" 'reb-enter-subexp-mode)
(define-key map "\C-c\C-b" 'reb-change-target-buffer)
(define-key map "\C-c\C-u" 'reb-force-update)
- (define-key map [menu-bar reb-mode] (cons "Re-Builder" menu-map))
- (define-key menu-map [rq]
- '(menu-item "Quit" reb-quit
- :help "Quit the RE Builder mode"))
- (define-key menu-map [div1] '(menu-item "--"))
- (define-key menu-map [rt]
- '(menu-item "Case sensitive" reb-toggle-case
- :button (:toggle . (with-current-buffer
- reb-target-buffer
- (null case-fold-search)))
- :help "Toggle case sensitivity of searches for RE Builder target buffer"))
- (define-key menu-map [rb]
- '(menu-item "Change target buffer..." reb-change-target-buffer
- :help "Change the target buffer and display it in the target window"))
- (define-key menu-map [rs]
- '(menu-item "Change syntax..." reb-change-syntax
- :help "Change the syntax used by the RE Builder"))
- (define-key menu-map [div2] '(menu-item "--"))
- (define-key menu-map [re]
- '(menu-item "Enter subexpression mode" reb-enter-subexp-mode
- :help "Enter the subexpression mode in the RE Builder"))
- (define-key menu-map [ru]
- '(menu-item "Force update" reb-force-update
- :help "Force an update in the RE Builder target window without a match limit"))
- (define-key menu-map [rn]
- '(menu-item "Go to next match" reb-next-match
- :help "Go to next match in the RE Builder target window"))
- (define-key menu-map [rp]
- '(menu-item "Go to previous match" reb-prev-match
- :help "Go to previous match in the RE Builder target window"))
- (define-key menu-map [div3] '(menu-item "--"))
- (define-key menu-map [rc]
- '(menu-item "Copy current RE" reb-copy
- :help "Copy current RE into the kill ring for later insertion"))
map)
"Keymap used by the RE Builder.")
+(easy-menu-define reb-mode-menu reb-mode-map
+ "Menu for the RE Builder."
+ '("Re-Builder"
+ ["Copy current RE" reb-copy
+ :help "Copy current RE into the kill ring for later insertion"]
+ "---"
+ ["Go to previous match" reb-prev-match
+ :help "Go to previous match in the RE Builder target window"]
+ ["Go to next match" reb-next-match
+ :help "Go to next match in the RE Builder target window"]
+ ["Force update" reb-force-update
+ :help "Force an update in the RE Builder target window without a match limit"]
+ ["Enter subexpression mode" reb-enter-subexp-mode
+ :help "Enter the subexpression mode in the RE Builder"]
+ "---"
+ ["Change syntax..." reb-change-syntax
+ :help "Change the syntax used by the RE Builder"]
+ ["Change target buffer..." reb-change-target-buffer
+ :help "Change the target buffer and display it in the target window"]
+ ["Case sensitive" reb-toggle-case
+ :style toggle
+ :selected (with-current-buffer reb-target-buffer
+ (null case-fold-search))
+ :help "Toggle case sensitivity of searches for RE Builder target buffer"]
+ "---"
+ ["Quit" reb-quit
+ :help "Quit the RE Builder mode"]))
+
(define-derived-mode reb-mode nil "RE Builder"
"Major mode for interactively building Regular Expressions."
(setq-local blink-matching-paren nil)
@@ -348,7 +341,12 @@ the regexp builder. It displays a buffer named \"*RE-Builder*\"
in another window, initially containing an empty regexp.
As you edit the regexp in the \"*RE-Builder*\" buffer, the
-matching parts of the target buffer will be highlighted."
+matching parts of the target buffer will be highlighted.
+
+Case-sensitivity can be toggled with \\[reb-toggle-case]. The
+regexp builder supports three different forms of input which can
+be set with \\[reb-change-syntax]. More options and details are
+provided in the Commentary section of this library."
(interactive)
(if (and (string= (buffer-name) reb-buffer)
(reb-mode-buffer-p))
@@ -357,18 +355,22 @@ matching parts of the target buffer will be highlighted."
(reb-delete-overlays))
(setq reb-target-buffer (current-buffer)
reb-target-window (selected-window))
- (select-window (or (get-buffer-window reb-buffer)
- (progn
- (setq reb-window-config (current-window-configuration))
- (split-window (selected-window) (- (window-height) 4)))))
- (switch-to-buffer (get-buffer-create reb-buffer))
+ (select-window
+ (or (get-buffer-window reb-buffer)
+ (let ((dir (if (window-parameter nil 'window-side)
+ 'bottom 'down)))
+ (setq reb-window-config (current-window-configuration))
+ (display-buffer
+ (get-buffer-create reb-buffer)
+ `((display-buffer-in-direction)
+ (direction . ,dir)
+ (dedicated . t))))))
(font-lock-mode 1)
(reb-initialize-buffer)))
(defun reb-change-target-buffer (buf)
"Change the target buffer and display it in the target window."
(interactive "bSet target buffer to: ")
-
(let ((buffer (get-buffer buf)))
(if (not buffer)
(error "No such buffer")
@@ -381,7 +383,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-force-update ()
"Force an update in the RE Builder target window without a match limit."
(interactive)
-
(let ((reb-auto-match-limit nil))
(reb-update-overlays
(if reb-subexp-mode reb-subexp-displayed nil))))
@@ -389,7 +390,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-quit ()
"Quit the RE Builder mode."
(interactive)
-
(setq reb-subexp-mode nil
reb-subexp-displayed nil)
(reb-delete-overlays)
@@ -399,7 +399,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-next-match ()
"Go to next match in the RE Builder target window."
(interactive)
-
(reb-assert-buffer-in-window)
(with-selected-window reb-target-window
(if (not (re-search-forward reb-regexp (point-max) t))
@@ -411,7 +410,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-prev-match ()
"Go to previous match in the RE Builder target window."
(interactive)
-
(reb-assert-buffer-in-window)
(with-selected-window reb-target-window
(let ((p (point)))
@@ -426,7 +424,6 @@ matching parts of the target buffer will be highlighted."
(defun reb-toggle-case ()
"Toggle case sensitivity of searches for RE Builder target buffer."
(interactive)
-
(with-current-buffer reb-target-buffer
(setq case-fold-search (not case-fold-search)))
(reb-update-modestring)
@@ -435,12 +432,11 @@ matching parts of the target buffer will be highlighted."
(defun reb-copy ()
"Copy current RE into the kill ring for later insertion."
(interactive)
-
(reb-update-regexp)
(let ((re (with-output-to-string
(print (reb-target-binding reb-regexp)))))
(setq re (substring re 1 (1- (length re))))
- (setq re (replace-regexp-in-string "\n" "\\n" re nil t))
+ (setq re (string-replace "\n" "\\n" re))
(kill-new re)
(message "Copied regexp `%s' to kill-ring" re)))
@@ -503,7 +499,6 @@ Optional argument SYNTAX must be specified if called non-interactively."
(defun reb-do-update (&optional subexp)
"Update matches in the RE Builder target window.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
-
(reb-assert-buffer-in-window)
(reb-update-regexp)
(reb-update-overlays subexp))
@@ -541,7 +536,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-assert-buffer-in-window ()
"Assert that `reb-target-buffer' is displayed in `reb-target-window'."
-
(if (not (eq reb-target-buffer (window-buffer reb-target-window)))
(set-window-buffer reb-target-window reb-target-buffer)))
@@ -560,7 +554,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-display-subexp (&optional subexp)
"Highlight only subexpression SUBEXP in the RE Builder."
(interactive)
-
(setq reb-subexp-displayed
(or subexp (string-to-number (format "%c" last-command-event))))
(reb-update-modestring)
@@ -568,7 +561,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-kill-buffer ()
"When the RE Builder buffer is killed make sure no overlays stay around."
-
(when (reb-mode-buffer-p)
(reb-delete-overlays)))
@@ -600,7 +592,6 @@ optional fourth argument FORCE is non-nil."
(defun reb-insert-regexp ()
"Insert current RE."
-
(let ((re (or (reb-target-binding reb-regexp)
(reb-empty-regexp))))
(cond ((eq reb-re-syntax 'read)
@@ -636,7 +627,6 @@ Return t if the (cooked) expression changed."
;; And now the real core of the whole thing
(defun reb-count-subexps (re)
"Return number of sub-expressions in the regexp RE."
-
(let ((i 0) (beg 0))
(while (string-match "\\\\(" re beg)
(setq i (1+ i)
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index 96894655b45..ea27bb3c31b 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -248,8 +248,6 @@ If SEQ is already a ring, return it."
(ring-insert-at-beginning ring (elt seq count))))
ring)))
-;;; provide ourself:
-
(provide 'ring)
;;; ring.el ends here
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index bedf598d442..8abe570e64b 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -26,29 +26,38 @@
(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 a list of (KEY NAME [DESCRIPTION]). KEY is a
-character to be entered. NAME is a short name for the entry to
-be displayed while prompting (if there's room, it might be
-shortened). DESCRIPTION is an optional longer explanation that
-will be displayed in a help buffer if the user requests more
-help.
+(defun read-multiple-choice (prompt choices &optional help-string)
+ "Ask user to select an entry from CHOICES, promting with PROMPT.
+This function allows to ask the user a multiple-choice question.
+
+CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
+KEY is a character the user should type to select the entry.
+NAME is a short name for the entry to be displayed while prompting
+\(if there's no room, it might be shortened).
+DESCRIPTION is an optional longer description of the entry; it will
+be displayed in a help buffer if the user requests more help. This
+help description has a fixed format in columns. For greater
+flexibility, instead of passing a DESCRIPTION, the caller can pass
+the optional argument HELP-STRING. This argument is a string that
+should contain a more detailed description of all of the possible
+choices. `read-multiple-choice' will display that description in a
+help buffer if the user requests that.
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.
+that variable for more information. The relevant bindings for the
+purposes of this function are `recenter', `scroll-up', `scroll-down',
+and `edit'.
+If the user types the `recenter', `scroll-up', or `scroll-down'
+responses, the function performs the requested window recentering or
+scrolling, and then asks the question again. If the user enters `edit',
+the function starts a recursive edit. When the user exit the recursive
+edit, the multiple-choice prompt gains focus again.
+
+When `use-dialog-box' is t (the default), and the command using this
+function was invoked via the mouse, this function pops up a GUI dialog
+to collect the user input, but only if Emacs is capable of using GUI
+dialogs. Otherwise, the function will always use text-mode dialogs.
The return value is the matching entry from the CHOICES list.
@@ -133,6 +142,13 @@ Usage example:
(ignore-errors (scroll-other-window)) t)
((eq answer 'scroll-other-window-down)
(ignore-errors (scroll-other-window-down)) t)
+ ((eq answer 'edit)
+ (save-match-data
+ (save-excursion
+ (message "%s"
+ (substitute-command-keys
+ "Recursive edit; type \\[exit-recursive-edit] to return to help screen"))
+ (recursive-edit))))
(t tchar)))
(when (eq tchar t)
(setq wrong-char nil
@@ -141,57 +157,61 @@ Usage example:
;; help messages.
(when (and (not (eq tchar nil))
(not (assq tchar choices)))
- (setq wrong-char (not (memq tchar '(?? ?\C-h)))
+ (setq wrong-char (not (memq tchar `(?? ,help-char)))
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))))
+ (setq buf (get-buffer-create "*Multiple Choice Help*"))
+ (if (stringp help-string)
+ (with-help-window buf
+ (with-current-buffer buf
+ (insert help-string)))
+ (with-help-window buf
+ (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)
- (dolist (line (split-string text "\n"))
- (end-of-line)
- (if (bolp)
- (insert line "\n")
- (insert line))
- (forward-line 1)))))))))))
+ (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)))
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index b29b870061d..071d390f0e4 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -890,7 +890,7 @@ Return (REGEXP . PRECEDENCE)."
(* (or (seq "[:" (+ (any "a-z")) ":]")
(not (any "]"))))
"]")
- anything
+ (not (any "*+?^$[\\"))
(seq "\\"
(or anything
(seq (any "sScC_") anything)
@@ -1210,7 +1210,7 @@ unmatchable Never match anything at all.
CHARCLASS Match a character from a character class. One of:
alpha, alphabetic, letter Alphabetic characters (defined by Unicode).
alnum, alphanumeric Alphabetic or decimal digit chars (Unicode).
- digit numeric, num 0-9.
+ digit, numeric, num 0-9.
xdigit, hex-digit, hex 0-9, A-F, a-f.
cntrl, control ASCII codes 0-31.
blank Horizontal whitespace (Unicode).
@@ -1418,6 +1418,12 @@ into a plain rx-expression, collecting names into `rx--pcase-vars'."
(cons head (mapcar #'rx--pcase-transform rest)))
(_ rx)))
+(defun rx--reduce-right (f l)
+ "Right-reduction on L by F. L must be non-empty."
+ (if (cdr l)
+ (funcall f (car l) (rx--reduce-right f (cdr l)))
+ (car l)))
+
;;;###autoload
(pcase-defmacro rx (&rest regexps)
"A pattern that matches strings against `rx' REGEXPS in sexp form.
@@ -1437,12 +1443,37 @@ following constructs:
construct."
(let* ((rx--pcase-vars nil)
(regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps)))))
- `(and (pred (string-match ,regexp))
- ,@(let ((i 0))
- (mapcar (lambda (name)
- (setq i (1+ i))
- `(app (match-string ,i) ,name))
- (reverse rx--pcase-vars))))))
+ `(and (pred stringp)
+ ,(pcase (length rx--pcase-vars)
+ (0
+ ;; No variables bound: a single predicate suffices.
+ `(pred (string-match ,regexp)))
+ (1
+ ;; Create a match value that on a successful regexp match
+ ;; is the submatch value, 0 on failure. We can't use nil
+ ;; for failure because it is a valid submatch value.
+ `(app (lambda (s)
+ (if (string-match ,regexp s)
+ (match-string 1 s)
+ 0))
+ (and ,(car rx--pcase-vars) (pred (not numberp)))))
+ (nvars
+ ;; Pack the submatches into a dotted list which is then
+ ;; immediately destructured into individual variables again.
+ ;; This is of course slightly inefficient.
+ ;; A dotted list is used to reduce the number of conses
+ ;; to create and take apart.
+ `(app (lambda (s)
+ (and (string-match ,regexp s)
+ ,(rx--reduce-right
+ (lambda (a b) `(cons ,a ,b))
+ (mapcar (lambda (i) `(match-string ,i s))
+ (number-sequence 1 nvars)))))
+ ,(list '\`
+ (rx--reduce-right
+ #'cons
+ (mapcar (lambda (name) (list '\, name))
+ (reverse rx--pcase-vars))))))))))
;; Obsolete internal symbol, used in old versions of the `flycheck' package.
(define-obsolete-function-alias 'rx-submatch-n 'rx-to-string "27.1")
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 31c15fea90d..f0dc283f57d 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -93,6 +93,14 @@ name to be bound to the rest of SEQUENCE."
(declare (indent 2) (debug (sexp form body)))
`(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
,@body))
+
+(defmacro seq-setq (args sequence)
+ "Assign to the variables in ARGS the elements of SEQUENCE.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQUENCE."
+ (declare (debug (sexp form)))
+ `(pcase-setq ,(seq--make-pcase-patterns args) ,sequence))
;;; Basic seq functions that have to be implemented by new sequence types
@@ -134,9 +142,10 @@ Unlike `seq-map', FUNCTION takes two arguments: the element of
the sequence, and its index within the sequence."
(let ((index 0))
(seq-do (lambda (elt)
- (funcall function elt index)
- (setq index (1+ index)))
- sequence)))
+ (funcall function elt index)
+ (setq index (1+ index)))
+ sequence))
+ nil)
(cl-defgeneric seqp (object)
"Return non-nil if OBJECT is a sequence, nil otherwise."
@@ -146,6 +155,7 @@ the sequence, and its index within the sequence."
"Return a shallow copy of SEQUENCE."
(copy-sequence sequence))
+;;;###autoload
(cl-defgeneric seq-subseq (sequence start &optional end)
"Return the sequence of elements of SEQUENCE from START to END.
END is exclusive.
@@ -392,14 +402,15 @@ found or not."
(setq count (+ 1 count))))
count))
-(cl-defgeneric seq-contains (sequence elt &optional testfn)
- (declare (obsolete seq-contains-p "27.1"))
- "Return the first element in SEQUENCE that is equal to ELT.
+(with-suppressed-warnings ((obsolete seq-contains))
+ (cl-defgeneric seq-contains (sequence elt &optional testfn)
+ "Return the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
- (seq-some (lambda (e)
- (when (funcall (or testfn #'equal) elt e)
- e))
- sequence))
+ (declare (obsolete seq-contains-p "27.1"))
+ (seq-some (lambda (e)
+ (when (funcall (or testfn #'equal) elt e)
+ e))
+ sequence)))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
"Return non-nil if SEQUENCE contains an element equal to ELT.
@@ -429,6 +440,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
(setq index (1+ index)))
nil)))
+;;;###autoload
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
TESTFN is used to compare elements, or `equal' if TESTFN is nil."
@@ -455,6 +467,7 @@ negative integer or 0, nil is returned."
(setq sequence (seq-drop sequence n)))
(nreverse result))))
+;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
"Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
@@ -465,6 +478,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reverse sequence1)
'()))
+;;;###autoload
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
"Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index c1d05941239..02f2ad3d816 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -115,9 +115,12 @@ See the documentation for `list-load-path-shadows' for further information."
;; FILE now contains the current file name, with no suffix.
(unless (or (member file files-seen-this-dir)
;; Ignore these files.
- (member file (list "subdirs" "leim-list"
- (file-name-sans-extension
- dir-locals-file))))
+ (member file
+ (list "subdirs" "leim-list"
+ (file-name-sans-extension dir-locals-file)
+ (concat
+ (file-name-sans-extension dir-locals-file)
+ "-2"))))
;; File has not been seen yet in this directory.
;; This test prevents us declaring that XXX.el shadows
;; XXX.elc (or vice-versa) when they are in the same directory.
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 39e69f5aab9..7d4a69f42a9 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -32,13 +32,10 @@
"Short documentation."
:group 'lisp)
-(defface shortdoc-separator
- '((((class color) (background dark))
- :height 0.1 :background "#505050" :extend t)
- (((class color) (background light))
- :height 0.1 :background "#a0a0a0" :extend t)
- (t :height 0.1 :inverse-video t :extend t))
- "Face used to separate sections.")
+(defface shortdoc-heading
+ '((t :inherit variable-pitch :height 1.3 :weight bold))
+ "Face used for a heading."
+ :version "28.1")
(defface shortdoc-section
'((t :inherit variable-pitch))
@@ -55,8 +52,10 @@ FUNCTIONS is a list of elements on the form:
:args ARGS
:eval EXAMPLE-FORM
:no-eval EXAMPLE-FORM
+ :no-eval* EXAMPLE-FORM
:no-value EXAMPLE-FORM
:result RESULT-FORM
+ :result-string RESULT-FORM
:eg-result RESULT-FORM
:eg-result-string RESULT-FORM)
@@ -155,6 +154,10 @@ There can be any number of :example/:result elements."
:eval (split-string "foo bar")
:eval (split-string "|foo|bar|" "|")
:eval (split-string "|foo|bar|" "|" t))
+ (split-string-and-unquote
+ :eval (split-string-and-unquote "foo \"bar zot\""))
+ (split-string-shell-command
+ :eval (split-string-shell-command "ls /tmp/'foo bar'"))
(string-lines
:eval (string-lines "foo\n\nbar")
:eval (string-lines "foo\n\nbar" t))
@@ -163,15 +166,12 @@ There can be any number of :example/:result elements."
(replace-regexp-in-string
:eval (replace-regexp-in-string "[a-z]+" "_" "*foo*"))
(string-trim
- :no-manual t
:args (string)
:doc "Trim STRING of leading and trailing white space."
:eval (string-trim " foo "))
(string-trim-left
- :no-manual t
:eval (string-trim-left "oofoo" "o+"))
(string-trim-right
- :no-manual t
:eval (string-trim-right "barkss" "s+"))
(string-truncate-left
:no-manual t
@@ -219,7 +219,7 @@ There can be any number of :example/:result elements."
(string-greaterp
:eval (string-greaterp "foo" "bar"))
(string-version-lessp
- :eval (string-lessp "foo32.png" "bar4.png"))
+ :eval (string-version-lessp "pic4.png" "pic32.png"))
(string-prefix-p
:eval (string-prefix-p "foo" "foobar"))
(string-suffix-p
@@ -264,14 +264,25 @@ There can be any number of :example/:result elements."
:eval (file-name-extension "/tmp/foo.txt"))
(file-name-sans-extension
:eval (file-name-sans-extension "/tmp/foo.txt"))
+ (file-name-with-extension
+ :eval (file-name-with-extension "foo.txt" "bin")
+ :eval (file-name-with-extension "foo" "bin"))
(file-name-base
:eval (file-name-base "/tmp/foo.txt"))
(file-relative-name
:eval (file-relative-name "/tmp/foo" "/tmp"))
(make-temp-name
:eval (make-temp-name "/tmp/foo-"))
+ (file-name-concat
+ :eval (file-name-concat "/tmp/" "foo")
+ :eval (file-name-concat "/tmp" "foo")
+ :eval (file-name-concat "/tmp" "foo" "bar/" "zot")
+ :eval (file-name-concat "/tmp" "~"))
(expand-file-name
- :eval (expand-file-name "foo" "/tmp/"))
+ :eval (expand-file-name "foo" "/tmp/")
+ :eval (expand-file-name "foo" "/tmp///")
+ :eval (expand-file-name "foo" "/tmp/foo/.././")
+ :eval (expand-file-name "~" "/tmp/"))
(substitute-in-file-name
:eval (substitute-in-file-name "$HOME/foo"))
"Directory Functions"
@@ -492,9 +503,13 @@ There can be any number of :example/:result elements."
(flatten-tree
:eval (flatten-tree '(1 (2 3) 4)))
(car
- :eval (car '(one two three)))
+ :eval (car '(one two three))
+ :eval (car '(one . two))
+ :eval (car nil))
(cdr
- :eval (cdr '(one two three)))
+ :eval (cdr '(one two three))
+ :eval (cdr '(one . two))
+ :eval (cdr nil))
(last
:eval (last '(one two three)))
(butlast
@@ -611,7 +626,7 @@ There can be any number of :example/:result elements."
(lax-plist-get
:eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b"))
(lax-plist-put
- :no-eval (setq plist (plist-put plist "d" 4))
+ :no-eval (setq plist (lax-plist-put plist "d" 4))
:eq-result '("a" 1 "b" 2 "c" 3 "d" 4))
(plist-member
:eval (plist-member '(a 1 b 2 c 3) 'b))
@@ -623,7 +638,7 @@ There can be any number of :example/:result elements."
(length>
:eval (length> '(a b c) 1))
(length=
- :eval (length> '(a b c) 3))
+ :eval (length= '(a b c) 3))
(safe-length
:eval (safe-length '(a b c))))
@@ -664,7 +679,7 @@ There can be any number of :example/:result elements."
:no-eval (re-search-backward "^foo$" nil t)
:eg-result 43)
(looking-at-p
- :no-eval (looking-at "f[0-9]")
+ :no-eval (looking-at-p "f[0-9]")
:eg-result t)
"Match Data"
(match-string
@@ -685,6 +700,8 @@ There can be any number of :example/:result elements."
(match-substitute-replacement
:no-eval (match-substitute-replacement "new")
:eg-result "new")
+ (replace-regexp-in-region
+ :no-value (replace-regexp-in-region "[0-9]+" "Num \\&"))
"Utilities"
(regexp-quote
:eval (regexp-quote "foo.*bar"))
@@ -836,7 +853,7 @@ There can be any number of :example/:result elements."
(point
:eval (point))
(point-min
- :eval (point-max))
+ :eval (point-min))
(point-max
:eval (point-max))
(line-beginning-position
@@ -879,11 +896,61 @@ There can be any number of :example/:result elements."
:no-value (erase-buffer))
(insert
:no-value (insert "This string will be inserted in the buffer\n"))
+ (subst-char-in-region
+ :no-eval "(subst-char-in-region (point-min) (point-max) ?+ ?-)")
+ (replace-string-in-region
+ :no-value (replace-string-in-region "foo" "bar"))
"Locking"
(lock-buffer
:no-value (lock-buffer "/tmp/foo"))
(unlock-buffer
- :no-value (lock-buffer)))
+ :no-value (unlock-buffer)))
+
+(define-short-documentation-group overlay
+ "Predicates"
+ (overlayp
+ :no-eval (overlayp some-overlay)
+ :eg-result t)
+ "Creation and Deletion"
+ (make-overlay
+ :args (beg end &optional buffer)
+ :no-eval (make-overlay 1 10)
+ :eg-result-string "#<overlay from 1 to 10 in *foo*>")
+ (delete-overlay
+ :no-eval (delete-overlay foo)
+ :eg-result t)
+ "Searching Overlays"
+ (overlays-at
+ :no-eval (overlays-at 15)
+ :eg-result-string "(#<overlay from 1 to 10 in *foo*>)")
+ (overlays-in
+ :no-eval (overlays-in 1 30)
+ :eg-result-string "(#<overlay from 1 to 10 in *foo*>)")
+ (next-overlay-change
+ :no-eval (next-overlay-change 1)
+ :eg-result 20)
+ (previous-overlay-change
+ :no-eval (previous-overlay-change 30)
+ :eg-result 20)
+ "Overlay Properties"
+ (overlay-start
+ :no-eval (overlay-start foo)
+ :eg-result 1)
+ (overlay-end
+ :no-eval (overlay-end foo)
+ :eg-result 10)
+ (overlay-put
+ :no-eval (overlay-put foo 'happy t)
+ :eg-result t)
+ (overlay-get
+ :no-eval (overlay-get foo 'happy)
+ :eg-result t)
+ (overlay-buffer
+ :no-eval (overlay-buffer foo))
+ "Moving Overlays"
+ (move-overlay
+ :no-eval (move-overlay foo 5 20)
+ :eg-result-string "#<overlay from 5 to 20 in *foo*>"))
(define-short-documentation-group process
(make-process
@@ -1054,7 +1121,7 @@ There can be any number of :example/:result elements."
(logb
:eval (logb 10.5))
(ffloor
- :eval (floor 1.2))
+ :eval (ffloor 1.2))
(fceiling
:eval (fceiling 1.2))
(ftruncate
@@ -1084,8 +1151,9 @@ There can be any number of :example/:result elements."
:eval (sqrt -1)))
;;;###autoload
-(defun shortdoc-display-group (group)
- "Pop to a buffer with short documentation summary for functions in GROUP."
+(defun shortdoc-display-group (group &optional function)
+ "Pop to a buffer with short documentation summary for functions in GROUP.
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any)."
(interactive (list (completing-read "Show summary for functions in: "
(mapcar #'car shortdoc--groups))))
(when (stringp group)
@@ -1107,24 +1175,26 @@ There can be any number of :example/:result elements."
(insert "\n"))
(insert (propertize
(concat (substitute-command-keys data) "\n\n")
- 'face '(variable-pitch (:height 1.3 :weight bold))
+ 'face 'shortdoc-heading
'shortdoc-section t)))
;; There may be functions not yet defined in the data.
((fboundp (car data))
(when prev
- (insert (propertize "\n" 'face 'shortdoc-separator)))
+ (insert (make-separator-line)))
(setq prev t)
(shortdoc--display-function data))))
(cdr (assq group shortdoc--groups))))
- (goto-char (point-min)))
+ (goto-char (point-min))
+ (when function
+ (text-property-search-forward 'shortdoc-function function t)
+ (beginning-of-line)))
(defun shortdoc--display-function (data)
(let ((function (pop data))
(start-section (point))
arglist-start)
;; Function calling convention.
- (insert (propertize "("
- 'shortdoc-function t))
+ (insert (propertize "(" 'shortdoc-function function))
(if (plist-get data :no-manual)
(insert-text-button
(symbol-name function)
@@ -1175,7 +1245,7 @@ function's documentation in the Info manual")))
(prin1 value (current-buffer)))
(insert "\n " single-arrow " "
(propertize "[it depends]"
- 'face 'variable-pitch)
+ 'face 'shortdoc-section)
"\n"))
(:no-value
(if (stringp value)
@@ -1233,11 +1303,11 @@ Example:
(let ((glist (assq group shortdoc--groups)))
(unless glist
(setq glist (list group))
- (setq shortdoc--groups (append shortdoc--groups (list glist))))
+ (push glist shortdoc--groups))
(let ((slist (member section glist)))
(unless slist
(setq slist (list section))
- (setq slist (append glist slist)))
+ (nconc glist slist))
(while (and (cdr slist)
(not (stringp (cadr slist))))
(setq slist (cdr slist)))
@@ -1250,41 +1320,45 @@ Example:
(define-key map (kbd "C-c C-n") 'shortdoc-next-section)
(define-key map (kbd "C-c C-p") 'shortdoc-previous-section)
map)
- "Keymap for `shortdoc-mode'")
+ "Keymap for `shortdoc-mode'.")
(define-derived-mode shortdoc-mode special-mode "shortdoc"
- "Mode for shortdoc.")
+ "Mode for shortdoc."
+ :interactive nil)
-(defmacro shortdoc--goto-section (arg sym &optional reverse)
- `(progn
- (unless (natnump ,arg)
- (setq ,arg 1))
- (while (< 0 ,arg)
- (,(if reverse
- 'text-property-search-backward
- 'text-property-search-forward)
- ,sym t)
- (setq ,arg (1- ,arg)))))
+(defun shortdoc--goto-section (arg sym &optional reverse)
+ (unless (natnump arg)
+ (setq arg 1))
+ (while (> arg 0)
+ (funcall
+ (if reverse 'text-property-search-backward
+ 'text-property-search-forward)
+ sym nil t t)
+ (setq arg (1- arg))))
(defun shortdoc-next (&optional arg)
- "Move cursor to next function."
- (interactive "p")
+ "Move cursor to the next function.
+With ARG, do it that many times."
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function))
(defun shortdoc-previous (&optional arg)
- "Move cursor to previous function."
- (interactive "p")
+ "Move cursor to the previous function.
+With ARG, do it that many times."
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-function t)
(backward-char 1))
(defun shortdoc-next-section (&optional arg)
- "Move cursor to next section."
- (interactive "p")
+ "Move cursor to the next section.
+With ARG, do it that many times."
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section))
(defun shortdoc-previous-section (&optional arg)
- "Move cursor to previous section."
- (interactive "p")
+ "Move cursor to the previous section.
+With ARG, do it that many times."
+ (interactive "p" shortdoc-mode)
(shortdoc--goto-section arg 'shortdoc-section t)
(forward-line -2))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 44be9afbfae..d775f152b36 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -57,18 +57,18 @@
;;
;; SMIE: Weakness is Power! Auto-indentation with incomplete information
;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
-;; doi: 10.22152/programming-journal.org/2020/5/1
+;; doi: 10.22152/programming-journal.org/2021/5/1
;; A good background to understand the development (especially the parts
;; building the 2D precedence tables and then computing the precedence levels
;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune
;; and Ceriel Jacobs (BookBody.pdf available at
-;; http://dickgrune.com/Books/PTAPG_1st_Edition/).
+;; https://dickgrune.com/Books/PTAPG_1st_Edition/).
;;
;; OTOH we had to kill many chickens, read many coffee grounds, and practice
;; untold numbers of black magic spells, to come up with the indentation code.
;; Since then, some of that code has been beaten into submission, but the
-;; smie-indent-keyword is still pretty obscure.
+;; `smie-indent-keyword' function is still pretty obscure.
;; Conflict resolution:
@@ -247,7 +247,7 @@ be either:
;; (exp (exp (or "+" "*" "=" ..) exp)).
;; Basically, make it EBNF (except for the specification of a separator in
;; the repetition, maybe).
- (let* ((nts (mapcar 'car bnf)) ;Non-terminals.
+ (let* ((nts (mapcar #'car bnf)) ;Non-terminals.
(first-ops-table ())
(last-ops-table ())
(first-nts-table ())
@@ -266,7 +266,7 @@ be either:
(push resolver precs))
(t (error "Unknown resolver %S" resolver))))
(apply #'smie-merge-prec2s over
- (mapcar 'smie-precs->prec2 precs))))
+ (mapcar #'smie-precs->prec2 precs))))
again)
(dolist (rules bnf)
(let ((nt (car rules))
@@ -497,7 +497,7 @@ CSTS is a list of pairs representing arcs in a graph."
res))
cycle)))
(mapconcat
- (lambda (elems) (mapconcat 'identity elems "="))
+ (lambda (elems) (mapconcat #'identity elems "="))
(append names (list (car names)))
" < ")))
@@ -567,7 +567,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
;; Then eliminate trivial constraints iteratively.
(let ((i 0))
(while csts
- (let ((rhvs (mapcar 'cdr csts))
+ (let ((rhvs (mapcar #'cdr csts))
(progress nil))
(dolist (cst csts)
(unless (memq (car cst) rhvs)
@@ -657,8 +657,8 @@ use syntax-tables to handle them in efficient C code.")
Same calling convention as `smie-forward-token-function' except
it should move backward to the beginning of the previous token.")
-(defalias 'smie-op-left 'car)
-(defalias 'smie-op-right 'cadr)
+(defalias 'smie-op-left #'car)
+(defalias 'smie-op-right #'cadr)
(defun smie-default-backward-token ()
(forward-comment (- (point)))
@@ -974,8 +974,7 @@ I.e. a good choice can be:
(defcustom smie-blink-matching-inners t
"Whether SMIE should blink to matching opener for inner keywords.
If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
- :type 'boolean
- :group 'smie)
+ :type 'boolean)
(defun smie-blink-matching-check (start end)
(save-excursion
@@ -1141,8 +1140,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
(defcustom smie-indent-basic 4
"Basic amount of indentation."
- :type 'integer
- :group 'smie)
+ :type 'integer)
(defvar smie-rules-function #'ignore
"Function providing the indentation rules.
@@ -1189,7 +1187,7 @@ designed specifically for use in this function.")
(and ;; (looking-at comment-start-skip) ;(bug#16041).
(forward-comment (point-max))))))
-(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p)
+(defalias 'smie-rule-hanging-p #'smie-indent--hanging-p)
(defun smie-indent--hanging-p ()
"Return non-nil if the current token is \"hanging\".
A hanging keyword is one that's at the end of a line except it's not at
@@ -1205,7 +1203,7 @@ the beginning of a line."
(funcall smie--hanging-eolp-function)
(point))))))
-(defalias 'smie-rule-bolp 'smie-indent--bolp)
+(defalias 'smie-rule-bolp #'smie-indent--bolp)
(defun smie-indent--bolp ()
"Return non-nil if the current token is the first on the line."
(save-excursion (skip-chars-backward " \t") (bolp)))
@@ -1409,7 +1407,9 @@ BASE-POS is the position relative to which offsets should be applied."
(funcall smie-rules-function method token)))
(defun smie-indent-forward-token ()
- "Skip token forward and return it, along with its levels."
+ "Skip token forward and return it, along with its levels.
+Point should be between tokens when calling this function (i.e.,
+not in the middle of a string/comment)."
(let ((tok (funcall smie-forward-token-function)))
(cond
((< 0 (length tok)) (assoc tok smie-grammar))
@@ -1421,7 +1421,7 @@ BASE-POS is the position relative to which offsets should be applied."
(forward-sexp 1)
nil)
((eobp) nil)
- (t (error "Bumped into unknown token")))))
+ (t (error "Bumped into unknown token: %S" tok)))))
(defun smie-indent-backward-token ()
"Skip token backward and return it, along with its levels."
@@ -1810,9 +1810,11 @@ Each function is called with no argument, shouldn't move point, and should
return either nil if it has no opinion, or an integer representing the column
to which that point should be aligned, if we were to reindent it.")
+(defalias 'smie--funcall #'funcall) ;Debugging/tracing convenience indirection.
+
(defun smie-indent-calculate ()
"Compute the indentation to use for point."
- (run-hook-with-args-until-success 'smie-indent-functions))
+ (run-hook-wrapped 'smie-indent-functions #'smie--funcall))
(defun smie-indent-line ()
"Indent current line using the SMIE indentation engine."
@@ -2016,7 +2018,7 @@ value with which to replace it."
;; FIXME improve value-type.
:type '(choice (const nil)
(alist :key-type symbol))
- :initialize 'custom-initialize-set
+ :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 a4514454c0b..4204d20249d 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -127,7 +127,7 @@ This is like `if-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
(declare (indent 2)
(debug ((&rest [&or symbolp (symbolp form) (form)])
- form body)))
+ body)))
(if varlist
`(let* ,(setq varlist (internal--build-bindings varlist))
(if ,(caar (last varlist))
@@ -146,9 +146,7 @@ This is like `when-let' but doesn't handle a VARLIST of the form
"Bind variables according to VARLIST and conditionally evaluate BODY.
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)))
+ (declare (indent 1) (debug if-let*))
(let (res)
(if varlist
`(let* ,(setq varlist (internal--build-bindings varlist))
@@ -174,9 +172,9 @@ As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
like \((SYMBOL SOMETHING)). This exists for backward compatibility
with an old syntax that accepted only one binding."
(declare (indent 2)
- (debug ([&or (&rest [&or symbolp (symbolp form) (form)])
- (symbolp form)]
- form body)))
+ (debug ([&or (symbolp form) ; must be first, Bug#48489
+ (&rest [&or symbolp (symbolp form) (form)])]
+ body)))
(when (and (<= (length spec) 2)
(not (listp (car spec))))
;; Adjust the single binding case
@@ -215,28 +213,6 @@ The variable list SPEC is the same as in `if-let'."
(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
-(defsubst string-trim-left (string &optional regexp)
- "Trim STRING of leading string matching REGEXP.
-
-REGEXP defaults to \"[ \\t\\n\\r]+\"."
- (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
- (substring string (match-end 0))
- string))
-
-(defsubst string-trim-right (string &optional regexp)
- "Trim STRING of trailing string matching REGEXP.
-
-REGEXP defaults to \"[ \\t\\n\\r]+\"."
- (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
- string)))
- (if i (substring string 0 i) string)))
-
-(defsubst string-trim (string &optional trim-left trim-right)
- "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT.
-
-TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
- (string-trim-left (string-trim-right string trim-right) trim-left))
-
;;;###autoload
(defun string-truncate-left (string length)
"Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
@@ -264,6 +240,7 @@ carriage return."
(substring string 0 (- (length string) (length suffix)))
string))
+;;;###autoload
(defun string-clean-whitespace (string)
"Clean up whitespace in STRING.
All sequences of whitespaces in STRING are collapsed into a
@@ -311,6 +288,18 @@ than this function."
(let ((result nil)
(result-length 0)
(index (if end (1- (length string)) 0)))
+ ;; FIXME: This implementation, which uses encode-coding-char
+ ;; to encode the string one character at a time, is in general
+ ;; incorrect: coding-systems that produce prefix or suffix
+ ;; bytes, such as ISO-2022-based or UTF-8/16 with BOM, will
+ ;; produce those bytes for each character, instead of just
+ ;; once for the entire string. encode-coding-char attempts to
+ ;; remove those extra bytes at least in some situations, but
+ ;; it cannot do that in all cases. And in any case, producing
+ ;; what is supposed to be a UTF-16 or ISO-2022-CN encoded
+ ;; string which lacks the BOM bytes at the beginning and the
+ ;; charset designation sequences at the head and tail of the
+ ;; result will definitely surprise the callers in some cases.
(while (let ((encoded (encode-coding-char
(aref string index) coding-system)))
(and (<= (+ (length encoded) result-length) length)
@@ -329,6 +318,7 @@ than this function."
(end (substring string (- (length string) length)))
(t (substring string 0 length)))))
+;;;###autoload
(defun string-lines (string &optional omit-nulls)
"Split STRING into a list of lines.
If OMIT-NULLS, empty lines will be removed from the results."
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index bee2f9639e7..0bb1b8916b1 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -125,6 +125,10 @@ otherwise nil. That construct can be a two character comment
delimiter or an Escaped or Char-quoted character."))
(defun syntax-propertize-wholelines (start end)
+ "Extend the region delimited by START and END to whole lines.
+This function is useful for
+`syntax-propertize-extend-region-functions';
+see Info node `(elisp) Syntax Properties'."
(goto-char start)
(cons (line-beginning-position)
(progn (goto-char end)
@@ -290,12 +294,13 @@ all RULES in total."
',(string-to-syntax (nth 1 action)))
,@(nthcdr 2 action))
`((let ((mb (match-beginning ,gn))
- (me (match-end ,gn))
- (syntax ,(nth 1 action)))
- (if syntax
- (put-text-property
- mb me 'syntax-table syntax))
- ,@(nthcdr 2 action)))))
+ (me (match-end ,gn)))
+ ,(macroexp-let2 nil syntax (nth 1 action)
+ `(progn
+ (if ,syntax
+ (put-text-property
+ mb me 'syntax-table ,syntax))
+ ,@(nthcdr 2 action)))))))
(t
`((let ((mb (match-beginning ,gn))
(me (match-end ,gn))
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 0c299b48b90..f0ee78745ac 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -36,6 +36,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup tabulated-list nil
"Tabulated-list customization group."
:group 'convenience
@@ -212,6 +214,8 @@ If ADVANCE is non-nil, move forward by one line afterwards."
special-mode-map))
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
+ (define-key map (kbd "M-<left>") 'tabulated-list-previous-column)
+ (define-key map (kbd "M-<right>") 'tabulated-list-next-column)
(define-key map "S" 'tabulated-list-sort)
(define-key map "}" 'tabulated-list-widen-current-column)
(define-key map "{" 'tabulated-list-narrow-current-column)
@@ -410,8 +414,7 @@ specified by `tabulated-list-sort-key'. It then erases the
buffer and inserts the entries with `tabulated-list-printer'.
Optional argument REMEMBER-POS, if non-nil, means to move point
-to the entry with the same ID element as the current line and
-recenter window line accordingly.
+to the entry with the same ID element as the current line.
Non-nil UPDATE argument means to use an alternative printing
method which is faster if most entries haven't changed since the
@@ -424,18 +427,10 @@ changing `tabulated-list-sort-key'."
(funcall tabulated-list-entries)
tabulated-list-entries))
(sorter (tabulated-list--get-sorter))
- entry-id saved-pt saved-col window-line)
+ entry-id saved-pt saved-col)
(and remember-pos
(setq entry-id (tabulated-list-get-id))
- (setq saved-col (current-column))
- (when (eq (window-buffer) (current-buffer))
- (setq window-line
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region (window-start) (point))
- (goto-char (point-min))
- (vertical-motion (buffer-size)))))))
+ (setq saved-col (current-column)))
;; Sort the entries, if necessary.
(when sorter
(setq entries (sort entries sorter)))
@@ -490,9 +485,7 @@ changing `tabulated-list-sort-key'."
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
(progn (goto-char saved-pt)
- (move-to-column saved-col)
- (when window-line
- (recenter window-line)))
+ (move-to-column saved-col))
(goto-char (point-min)))))
(defun tabulated-list-print-entry (id cols)
@@ -656,18 +649,41 @@ this is the vector stored within it."
(defun tabulated-list-sort (&optional n)
"Sort Tabulated List entries by the column at point.
-With a numeric prefix argument N, sort the Nth column."
+With a numeric prefix argument N, sort the Nth column.
+
+If the numeric prefix is -1, restore order the list was
+originally displayed in."
(interactive "P")
- (let ((name (if n
- (car (aref tabulated-list-format n))
- (get-text-property (point)
- 'tabulated-list-column-name))))
- (if (nth 2 (assoc name (append tabulated-list-format nil)))
- (tabulated-list--sort-by-column-name name)
- (user-error "Cannot sort by %s" name))))
+ (if (equal n -1)
+ ;; Restore original order.
+ (progn
+ (unless tabulated-list--original-order
+ (error "Order is already in original order"))
+ (setq tabulated-list-entries
+ (sort tabulated-list-entries
+ (lambda (e1 e2)
+ (< (gethash e1 tabulated-list--original-order)
+ (gethash e2 tabulated-list--original-order)))))
+ (setq tabulated-list-sort-key nil)
+ (tabulated-list-init-header)
+ (tabulated-list-print t))
+ ;; Sort based on a column name.
+ (let ((name (if n
+ (car (aref tabulated-list-format n))
+ (get-text-property (point)
+ 'tabulated-list-column-name))))
+ (if (nth 2 (assoc name (append tabulated-list-format nil)))
+ (tabulated-list--sort-by-column-name name)
+ (user-error "Cannot sort by %s" name)))))
(defun tabulated-list--sort-by-column-name (name)
(when (and name (derived-mode-p 'tabulated-list-mode))
+ (unless tabulated-list--original-order
+ ;; Store the original order so that we can restore it later.
+ (setq tabulated-list--original-order (make-hash-table))
+ (cl-loop for elem in tabulated-list-entries
+ for i from 0
+ do (setf (gethash elem tabulated-list--original-order) i)))
;; Flip the sort order on a second click.
(if (equal name (car tabulated-list-sort-key))
(setcdr tabulated-list-sort-key
@@ -726,8 +742,32 @@ Interactively, N is the prefix numeric argument, and defaults to
(setq-local tabulated-list--current-lnum-width lnum-width)
(tabulated-list-init-header)))))
+(defun tabulated-list-next-column (&optional arg)
+ "Go to the start of the next column after point on the current line.
+If ARG is provided, move that many columns."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (let ((next (or (next-single-property-change
+ (point) 'tabulated-list-column-name)
+ (point-max))))
+ (when (<= next (line-end-position))
+ (goto-char next)))))
+
+(defun tabulated-list-previous-column (&optional arg)
+ "Go to the start of the column point is in on the current line.
+If ARG is provided, move that many columns."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (let ((prev (or (previous-single-property-change
+ (point) 'tabulated-list-column-name)
+ 1)))
+ (unless (< prev (line-beginning-position))
+ (goto-char prev)))))
+
;;; The mode definition:
+(defvar tabulated-list--original-order nil)
+
(define-derived-mode tabulated-list-mode special-mode "Tabulated"
"Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major
@@ -768,6 +808,7 @@ as the ewoc pretty-printer."
(setq-local glyphless-char-display
(tabulated-list-make-glyphless-char-display-table))
(setq-local text-scale-remap-header-line t)
+ (setq-local tabulated-list--original-order nil)
;; Avoid messing up the entries' display just because the first
;; column of the first entry happens to begin with a R2L letter.
(setq bidi-paragraph-direction 'left-to-right)
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index fb9cd8f47df..4460fef97bd 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,4 +1,4 @@
-;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
+;;; tcover-ses.el --- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -6,6 +6,8 @@
;; Keywords: spreadsheet lisp utility
;; Package: testcover
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
@@ -30,8 +32,8 @@
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
-(let* ((pause nil)
- (x (if pause "\^Xq" ""))
+(let* (;; (pause nil)
+ (x (if nil "\^Xq" "")) ;; pause
(y "\^X\^Fses-test.ses\r\^[<"))
;;Fiddle with the existing spreadsheet
(fset 'ses-exercise-example
@@ -714,4 +716,4 @@ spreadsheet files with invalid formatting."
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
-;;; testcover-ses.el ends here.
+;;; tcover-ses.el ends here
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 75b27d08e56..e75f15140aa 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -1,4 +1,4 @@
-;;;; testcover.el -- Visual code-coverage tool -*- lexical-binding:t -*-
+;;; testcover.el --- Visual code-coverage tool -*- lexical-binding:t -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -675,4 +675,4 @@ The list is 1valued if all of its constituent elements are also 1valued."
(testcover-analyze-coverage (cadr form)))
(t (testcover-analyze-coverage-backquote form))))
-;; testcover.el ends here.
+;;; testcover.el ends here
diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el
index e909e4bf760..7da02a9cb2d 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -31,28 +31,40 @@
(defun text-property-search-forward (property &optional value predicate
not-current)
- "Search for the next region of text whose PROPERTY matches VALUE.
-
-If not found, return nil and don't move point.
-If found, move point to the start of the region and return a
-`prop-match' object describing the match. To access the details
-of the match, use `prop-match-beginning' and `prop-match-end' for
-the buffer positions that limit the region, and
-`prop-match-value' for the value of PROPERTY in the region.
-
+ "Search for the next region of text where PREDICATE is true.
PREDICATE is used to decide whether a value of PROPERTY should be
considered as matching VALUE.
-If PREDICATE is t, that means a value must `equal' VALUE to be
-considered a match.
-If PREDICATE is nil, a value will match if it is non-nil and
-is NOT `equal' to VALUE.
+
If PREDICATE is a function, it will be called with two arguments:
VALUE and the value of PROPERTY. The function should return
non-nil if these two values are to be considered a match.
+Two special values of PREDICATE can also be used:
+If PREDICATE is t, that means a value must `equal' VALUE to be
+considered a match.
+If PREDICATE is nil (which is the default value), a value will
+match if is not `equal' to VALUE. Furthermore, a nil PREDICATE
+means that the match region is ended if the value changes. For
+instance, this means that if you loop with
+
+ (while (setq prop (text-property-search-forward 'face))
+ ...)
+
+you will get all distinct regions with non-nil `face' values in
+the buffer, and the `prop' object will have the details about the
+match. See the manual for more details and examples about how
+VALUE and PREDICATE interact.
+
If NOT-CURRENT is non-nil, the function will search for the first
region that doesn't include point and has a value of PROPERTY
-that matches VALUE."
+that matches VALUE.
+
+If no matches can be found, return nil and don't move point.
+If found, move point to the end of the region and return a
+`prop-match' object describing the match. To access the details
+of the match, use `prop-match-beginning' and `prop-match-end' for
+the buffer positions that limit the region, and
+`prop-match-value' for the value of PROPERTY in the region."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
@@ -125,7 +137,7 @@ that matches VALUE."
"Search for the previous region of text whose PROPERTY matches VALUE.
Like `text-property-search-forward', which see, but searches backward,
-and if a matching region is found, place point at its end."
+and if a matching region is found, place point at the start of the region."
(interactive
(list
(let ((string (completing-read "Search for property: " obarray)))
@@ -214,3 +226,5 @@ and if a matching region is found, place point at its end."
(funcall predicate value prop-value))
(provide 'text-property-search)
+
+;;; text-property-search.el ends here
diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el
index 83e0fa75aa7..7e349d22a49 100644
--- a/lisp/emacs-lisp/thunk.el
+++ b/lisp/emacs-lisp/thunk.el
@@ -52,7 +52,7 @@
(defmacro thunk-delay (&rest body)
"Delay the evaluation of BODY."
- (declare (debug t))
+ (declare (debug (def-body)))
(cl-assert lexical-binding)
`(let (forced
(val (lambda () ,@body)))
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index fa07d622484..9354687b081 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -161,7 +161,7 @@
"Helper function to get internal values.
You can call this function to add internal values in the trace buffer."
(unless inhibit-trace
- (with-current-buffer trace-buffer
+ (with-current-buffer (get-buffer-create trace-buffer)
(goto-char (point-max))
(insert
(trace-entry-message
@@ -174,7 +174,7 @@ and CONTEXT is a string describing the dynamic context (e.g. values of
some global variables)."
(let ((print-circle t))
(format "%s%s%d -> %S%s\n"
- (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
+ (mapconcat 'char-to-string (make-string (max 0 (1- level)) ?|) " ")
(if (> level 1) " " "")
level
;; FIXME: Make it so we can click the function name to jump to its
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index d52a6c796db..fa4e0583ed3 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,4 +1,4 @@
-;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
+;;; unsafep.el --- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 67de690e67d..36b275e2d3c 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -307,7 +307,7 @@ entirely by setting `warning-suppress-types' or
'type 'warning-suppress-log-warning
'warning-type type))
(funcall newline)
- (when (and warning-fill-prefix (not (string-match "\n" message)))
+ (when (and warning-fill-prefix (not (string-search "\n" message)))
(let ((fill-prefix warning-fill-prefix)
(fill-column warning-fill-column))
(fill-region start (point))))
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index a64274bc0c1..54f881bde8a 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,4 +1,4 @@
-;;; cua-base.el --- emulate CUA key bindings
+;;; cua-base.el --- emulate CUA key bindings -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -272,19 +272,16 @@ a shifted movement key. If the value is nil, these keys are never
enabled."
:type '(choice (const :tag "Disabled" nil)
(const :tag "Shift region only" shift)
- (other :tag "Enabled" t))
- :group 'cua)
+ (other :tag "Enabled" t)))
(defcustom cua-remap-control-v t
"If non-nil, C-v binding is used for paste (yank).
Also, M-v is mapped to `delete-selection-repeat-replace-region'."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-remap-control-z t
"If non-nil, C-z binding is used for undo."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-highlight-region-shift-only nil
"If non-nil, only highlight region if marked with S-<move>.
@@ -292,8 +289,7 @@ When this is non-nil, CUA toggles `transient-mark-mode' on when the region
is marked using shifted movement keys, and off when the mark is cleared.
But when the mark was set using \\[cua-set-mark], Transient Mark mode
is not turned on."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(make-obsolete-variable 'cua-highlight-region-shift-only
'transient-mark-mode "24.4")
@@ -307,33 +303,28 @@ first prefix key is discarded, so typing a prefix key twice in quick
succession will also inhibit overriding the prefix key.
If the value is nil, use a shifted prefix key to inhibit the override."
:type '(choice (number :tag "Inhibit delay")
- (const :tag "No delay" nil))
- :group 'cua)
+ (const :tag "No delay" nil)))
(defcustom cua-delete-selection t
"If non-nil, typed text replaces text in the active selection."
:type '(choice (const :tag "Disabled" nil)
- (other :tag "Enabled" t))
- :group 'cua)
+ (other :tag "Enabled" t)))
(defcustom cua-keep-region-after-copy nil
"If non-nil, don't deselect the region after copying."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-toggle-set-mark t
"If non-nil, the `cua-set-mark' command toggles the mark."
:type '(choice (const :tag "Disabled" nil)
- (other :tag "Enabled" t))
- :group 'cua)
+ (other :tag "Enabled" t)))
(defcustom cua-auto-mark-last-change nil
"If non-nil, set implicit mark at position of last buffer change.
This means that \\[universal-argument] \\[cua-set-mark] will jump to the position
of the last buffer change before jumping to the explicit marks on the mark ring.
See `cua-set-mark' for details."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-enable-register-prefix 'not-ctrl-u
"If non-nil, registers are supported via numeric prefix arg.
@@ -346,32 +337,27 @@ interpreted as a register number."
:type '(choice (const :tag "Disabled" nil)
(const :tag "Enabled, but C-u arg is not a register" not-ctrl-u)
(const :tag "Enabled, but only for C-u arg" ctrl-u-only)
- (other :tag "Enabled" t))
- :group 'cua)
+ (other :tag "Enabled" t)))
(defcustom cua-delete-copy-to-register-0 t
;; FIXME: Obey delete-selection-save-to-register rather than hardcoding
;; register 0.
"If non-nil, save last deleted region or rectangle to register 0."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-enable-region-auto-help nil
"If non-nil, automatically show help for active region."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-enable-modeline-indications nil
"If non-nil, use minor-mode hook to show status in mode line."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-check-pending-input t
"If non-nil, don't override prefix key if input pending.
It is rumored that `input-pending-p' is unreliable under some window
managers, so try setting this to nil, if prefix override doesn't work."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-paste-pop-rotate-temporarily nil
"If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily.
@@ -380,8 +366,7 @@ insert the most recently killed text. Each immediately following \\[cua-paste-p
replaces the previous text with the next older element on the `kill-ring'.
With prefix arg, \\[universal-argument] \\[yank-pop] inserts the same text as the
most recent \\[yank-pop] (or \\[yank]) command."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
;;; Rectangle Customization
@@ -390,8 +375,7 @@ most recent \\[yank-pop] (or \\[yank]) command."
Note that although rectangles are always DISPLAYED with straight edges, the
buffer is NOT modified, until you execute a command that actually modifies it.
M-p toggles this feature when a rectangle is active."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-auto-tabify-rectangles 1000
"If non-nil, automatically tabify after rectangle commands.
@@ -403,11 +387,12 @@ present. The number specifies then number of characters before
and after the region marked by the rectangle to search."
:type '(choice (number :tag "Auto detect (limit)")
(const :tag "Disabled" nil)
- (other :tag "Enabled" t))
- :group 'cua)
+ (other :tag "Enabled" t)))
(defvar cua-global-keymap) ; forward
(defvar cua--region-keymap) ; forward
+(declare-function cua-clear-rectangle-mark "cua-rect" ())
+(declare-function cua-mouse-set-rectangle-mark "cua-rect" (event))
(defcustom cua-rectangle-mark-key [(control return)]
"Global key used to toggle the cua rectangle mark."
@@ -416,14 +401,13 @@ and after the region marked by the rectangle to search."
(when (and (boundp 'cua--keymaps-initialized)
cua--keymaps-initialized)
(define-key cua-global-keymap value
- 'cua-set-rectangle-mark)
+ #'cua-set-rectangle-mark)
(when (boundp 'cua--rectangle-keymap)
(define-key cua--rectangle-keymap value
- 'cua-clear-rectangle-mark)
+ #'cua-clear-rectangle-mark)
(define-key cua--region-keymap value
- 'cua-toggle-rectangle-mark))))
- :type 'key-sequence
- :group 'cua)
+ #'cua-toggle-rectangle-mark))))
+ :type 'key-sequence)
(defcustom cua-rectangle-modifier-key 'meta
"Modifier key used for rectangle commands bindings.
@@ -432,8 +416,7 @@ Must be set prior to enabling CUA."
:type '(choice (const :tag "Meta key" meta)
(const :tag "Alt key" alt)
(const :tag "Hyper key" hyper)
- (const :tag "Super key" super))
- :group 'cua)
+ (const :tag "Super key" super)))
(defcustom cua-rectangle-terminal-modifier-key 'meta
"Modifier key used for rectangle commands bindings in terminals.
@@ -442,54 +425,46 @@ Must be set prior to enabling CUA."
(const :tag "Alt key" alt)
(const :tag "Hyper key" hyper)
(const :tag "Super key" super))
- :group 'cua
:version "27.1")
(defcustom cua-enable-rectangle-auto-help t
"If non-nil, automatically show help for region, rectangle and global mark."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defface cua-rectangle
'((default :inherit region)
(((class color)) :foreground "white" :background "maroon"))
- "Font used by CUA for highlighting the rectangle."
- :group 'cua)
+ "Font used by CUA for highlighting the rectangle.")
(defface cua-rectangle-noselect
'((default :inherit region)
(((class color)) :foreground "white" :background "dimgray"))
- "Font used by CUA for highlighting the non-selected rectangle lines."
- :group 'cua)
+ "Font used by CUA for highlighting the non-selected rectangle lines.")
;;; Global Mark Customization
(defcustom cua-global-mark-keep-visible t
"If non-nil, always keep global mark visible in other window."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defface cua-global-mark
'((((min-colors 88)(class color)) :foreground "black" :background "yellow1")
(((class color)) :foreground "black" :background "yellow")
(t :weight bold))
- "Font used by CUA for highlighting the global mark."
- :group 'cua)
+ "Font used by CUA for highlighting the global mark.")
(defcustom cua-global-mark-blink-cursor-interval 0.20
"Blink cursor at this interval when global mark is active."
:type '(choice (number :tag "Blink interval")
- (const :tag "No blink" nil))
- :group 'cua)
+ (const :tag "No blink" nil)))
;;; Cursor Indication Customization
(defcustom cua-enable-cursor-indications nil
"If non-nil, use different cursor colors for indications."
- :type 'boolean
- :group 'cua)
+ :type 'boolean)
(defcustom cua-normal-cursor-color (or (and (boundp 'initial-cursor-color) initial-cursor-color)
(and (boundp 'initial-frame-alist)
@@ -507,7 +482,7 @@ If the value is a COLOR name, then only the `cursor-color' attribute will be
affected. If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
then only the `cursor-type' property will be affected. If the value is
a cons (TYPE . COLOR), then both properties are affected."
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:type '(choice
(color :tag "Color")
(choice :tag "Type"
@@ -521,8 +496,7 @@ a cons (TYPE . COLOR), then both properties are affected."
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
- (color :tag "Color")))
- :group 'cua)
+ (color :tag "Color"))))
(defcustom cua-read-only-cursor-color "darkgreen"
"Cursor color used in read-only buffers, if non-nil.
@@ -545,8 +519,7 @@ a cons (TYPE . COLOR), then both properties are affected."
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
- (color :tag "Color")))
- :group 'cua)
+ (color :tag "Color"))))
(defcustom cua-overwrite-cursor-color "yellow"
"Cursor color used when overwrite mode is set, if non-nil.
@@ -569,8 +542,7 @@ a cons (TYPE . COLOR), then both properties are affected."
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
- (color :tag "Color")))
- :group 'cua)
+ (color :tag "Color"))))
(defcustom cua-global-mark-cursor-color "cyan"
"Indication for active global mark.
@@ -594,8 +566,7 @@ a cons (TYPE . COLOR), then both properties are affected."
(const :tag "Vertical bar" bar)
(const :tag "Horizontal bar" hbar)
(const :tag "Hollow box" hollow))
- (color :tag "Color")))
- :group 'cua)
+ (color :tag "Color"))))
;;; Rectangle support is in cua-rect.el
@@ -710,7 +681,7 @@ a cons (TYPE . COLOR), then both properties are affected."
(<= cua-prefix-override-inhibit-delay 0)
;; In state [1], start [T] and change to state [2]
(run-with-timer cua-prefix-override-inhibit-delay nil
- 'cua--prefix-override-timeout)))
+ #'cua--prefix-override-timeout)))
;; Don't record this command
(setq this-command last-command)
;; Restore the prefix arg
@@ -1243,6 +1214,8 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(interactive)
(cua--shift-control-prefix ?\C-x))
+(declare-function delete-selection-repeat-replace-region "delsel" (arg))
+
(defun cua--init-keymaps ()
;; Cache actual rectangle modifier key.
(setq cua--rectangle-modifier-key
@@ -1250,68 +1223,84 @@ If ARG is the atom `-', scroll upward by nearly full screen."
cua-rectangle-terminal-modifier-key
cua-rectangle-modifier-key))
;; C-return always toggles rectangle mark
- (define-key cua-global-keymap cua-rectangle-mark-key 'cua-set-rectangle-mark)
+ (define-key cua-global-keymap cua-rectangle-mark-key #'cua-set-rectangle-mark)
(unless (eq cua--rectangle-modifier-key 'meta)
- (cua--M/H-key cua-global-keymap ?\s 'cua-set-rectangle-mark)
+ (cua--M/H-key cua-global-keymap ?\s #'cua-set-rectangle-mark)
(define-key cua-global-keymap
- (vector (list cua--rectangle-modifier-key 'mouse-1)) 'cua-mouse-set-rectangle-mark))
+ (vector (list cua--rectangle-modifier-key 'mouse-1))
+ #'cua-mouse-set-rectangle-mark))
- (define-key cua-global-keymap [(shift control ?\s)] 'cua-toggle-global-mark)
+ (define-key cua-global-keymap [(shift control ?\s)] #'cua-toggle-global-mark)
;; replace region with rectangle or element on kill ring
- (define-key cua-global-keymap [remap yank] 'cua-paste)
- (define-key cua-global-keymap [remap clipboard-yank] 'cua-paste)
- (define-key cua-global-keymap [remap x-clipboard-yank] 'cua-paste)
+ (define-key cua-global-keymap [remap yank] #'cua-paste)
+ (define-key cua-global-keymap [remap clipboard-yank] #'cua-paste)
+ (define-key cua-global-keymap [remap x-clipboard-yank] #'cua-paste)
;; replace current yank with previous kill ring element
- (define-key cua-global-keymap [remap yank-pop] 'cua-paste-pop)
+ (define-key cua-global-keymap [remap yank-pop] #'cua-paste-pop)
;; set mark
- (define-key cua-global-keymap [remap set-mark-command] 'cua-set-mark)
- (define-key cua-global-keymap [remap exchange-point-and-mark] 'cua-exchange-point-and-mark)
+ (define-key cua-global-keymap [remap set-mark-command] #'cua-set-mark)
+ (define-key cua-global-keymap [remap exchange-point-and-mark]
+ #'cua-exchange-point-and-mark)
;; scrolling
- (define-key cua-global-keymap [remap scroll-up] 'cua-scroll-up)
- (define-key cua-global-keymap [remap scroll-down] 'cua-scroll-down)
- (define-key cua-global-keymap [remap scroll-up-command] 'cua-scroll-up)
- (define-key cua-global-keymap [remap scroll-down-command] 'cua-scroll-down)
+ (define-key cua-global-keymap [remap scroll-up] #'cua-scroll-up)
+ (define-key cua-global-keymap [remap scroll-down] #'cua-scroll-down)
+ (define-key cua-global-keymap [remap scroll-up-command] #'cua-scroll-up)
+ (define-key cua-global-keymap [remap scroll-down-command] #'cua-scroll-down)
- (define-key cua--cua-keys-keymap [(control x) timeout] 'kill-region)
- (define-key cua--cua-keys-keymap [(control c) timeout] 'copy-region-as-kill)
+ (define-key cua--cua-keys-keymap [(control x) timeout] #'kill-region)
+ (define-key cua--cua-keys-keymap [(control c) timeout] #'copy-region-as-kill)
(when cua-remap-control-z
- (define-key cua--cua-keys-keymap [(control z)] 'undo))
+ (define-key cua--cua-keys-keymap [(control z)] #'undo))
(when cua-remap-control-v
- (define-key cua--cua-keys-keymap [(control v)] 'yank)
+ (define-key cua--cua-keys-keymap [(control v)] #'yank)
(define-key cua--cua-keys-keymap [(meta v)]
- 'delete-selection-repeat-replace-region))
+ #'delete-selection-repeat-replace-region))
- (define-key cua--prefix-override-keymap [(control x)] 'cua--prefix-override-handler)
- (define-key cua--prefix-override-keymap [(control c)] 'cua--prefix-override-handler)
+ (define-key cua--prefix-override-keymap [(control x)]
+ #'cua--prefix-override-handler)
+ (define-key cua--prefix-override-keymap [(control c)]
+ #'cua--prefix-override-handler)
- (define-key cua--prefix-repeat-keymap [(control x) (control x)] 'cua--prefix-repeat-handler)
- (define-key cua--prefix-repeat-keymap [(control c) (control c)] 'cua--prefix-repeat-handler)
+ (define-key cua--prefix-repeat-keymap [(control x) (control x)]
+ #'cua--prefix-repeat-handler)
+ (define-key cua--prefix-repeat-keymap [(control c) (control c)]
+ #'cua--prefix-repeat-handler)
(dolist (key '(up down left right home end next prior))
- (define-key cua--prefix-repeat-keymap (vector '(control x) key) 'cua--prefix-cut-handler)
- (define-key cua--prefix-repeat-keymap (vector '(control c) key) 'cua--prefix-copy-handler))
+ (define-key cua--prefix-repeat-keymap (vector '(control x) key)
+ #'cua--prefix-cut-handler)
+ (define-key cua--prefix-repeat-keymap (vector '(control c) key)
+ #'cua--prefix-copy-handler))
;; Enable shifted fallbacks for C-x and C-c when region is active
- (define-key cua--region-keymap [(shift control x)] 'cua--shift-control-x-prefix)
- (define-key cua--region-keymap [(shift control c)] 'cua--shift-control-c-prefix)
+ (define-key cua--region-keymap [(shift control x)]
+ #'cua--shift-control-x-prefix)
+ (define-key cua--region-keymap [(shift control c)]
+ #'cua--shift-control-c-prefix)
;; delete current region
- (define-key cua--region-keymap [remap delete-backward-char] 'cua-delete-region)
- (define-key cua--region-keymap [remap backward-delete-char] 'cua-delete-region)
- (define-key cua--region-keymap [remap backward-delete-char-untabify] 'cua-delete-region)
- (define-key cua--region-keymap [remap delete-char] 'cua-delete-region)
- (define-key cua--region-keymap [remap delete-forward-char] 'cua-delete-region)
+ (define-key cua--region-keymap [remap delete-backward-char]
+ #'cua-delete-region)
+ (define-key cua--region-keymap [remap backward-delete-char]
+ #'cua-delete-region)
+ (define-key cua--region-keymap [remap backward-delete-char-untabify]
+ #'cua-delete-region)
+ (define-key cua--region-keymap [remap delete-char]
+ #'cua-delete-region)
+ (define-key cua--region-keymap [remap delete-forward-char]
+ #'cua-delete-region)
;; kill region
- (define-key cua--region-keymap [remap kill-region] 'cua-cut-region)
- (define-key cua--region-keymap [remap clipboard-kill-region] 'cua-cut-region)
+ (define-key cua--region-keymap [remap kill-region] #'cua-cut-region)
+ (define-key cua--region-keymap [remap clipboard-kill-region] #'cua-cut-region)
;; copy region
- (define-key cua--region-keymap [remap copy-region-as-kill] 'cua-copy-region)
- (define-key cua--region-keymap [remap kill-ring-save] 'cua-copy-region)
- (define-key cua--region-keymap [remap clipboard-kill-ring-save] 'cua-copy-region)
+ (define-key cua--region-keymap [remap copy-region-as-kill] #'cua-copy-region)
+ (define-key cua--region-keymap [remap kill-ring-save] #'cua-copy-region)
+ (define-key cua--region-keymap [remap clipboard-kill-ring-save]
+ #'cua-copy-region)
;; cancel current region/rectangle
- (define-key cua--region-keymap [remap keyboard-escape-quit] 'cua-cancel)
- (define-key cua--region-keymap [remap keyboard-quit] 'cua-cancel)
+ (define-key cua--region-keymap [remap keyboard-escape-quit] #'cua-cancel)
+ (define-key cua--region-keymap [remap keyboard-quit] #'cua-cancel)
)
@@ -1344,11 +1333,9 @@ You can customize `cua-enable-cua-keys' to completely disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
the prefix fallback behavior."
:global t
- :group 'cua
:set-after '(cua-enable-modeline-indications
cua-remap-control-v cua-remap-control-z
cua-rectangle-mark-key cua-rectangle-modifier-key)
- :require 'cua-base
:link '(emacs-commentary-link "cua-base.el")
(setq mark-even-if-inactive t)
(setq highlight-nonselected-windows nil)
@@ -1359,15 +1346,15 @@ the prefix fallback behavior."
(if cua-mode
(progn
- (add-hook 'pre-command-hook 'cua--pre-command-handler)
- (add-hook 'post-command-hook 'cua--post-command-handler)
+ (add-hook 'pre-command-hook #'cua--pre-command-handler)
+ (add-hook 'post-command-hook #'cua--post-command-handler)
(if (and cua-enable-modeline-indications (not (assoc 'cua-mode minor-mode-alist)))
(setq minor-mode-alist (cons '(cua-mode cua--status-string) minor-mode-alist)))
(if cua-enable-cursor-indications
(cua--update-indications)))
- (remove-hook 'pre-command-hook 'cua--pre-command-handler)
- (remove-hook 'post-command-hook 'cua--post-command-handler))
+ (remove-hook 'pre-command-hook #'cua--pre-command-handler)
+ (remove-hook 'post-command-hook #'cua--post-command-handler))
(if (not cua-mode)
(setq emulation-mode-map-alists
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index 6f6b9fce130..7014330b6ef 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -1,4 +1,4 @@
-;;; cua-gmrk.el --- CUA unified global mark support
+;;; cua-gmrk.el --- CUA unified global mark support -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -186,7 +186,7 @@ With prefix argument, don't jump to global mark when canceling it."
(defun cua--copy-rectangle-to-global-mark (as-text)
;; Copy rectangle to global mark buffer/position.
(if (cua--global-mark-active)
- (let ((src-buf (current-buffer))
+ (let (;; (src-buf (current-buffer))
(text (cua--extract-rectangle)))
(with-current-buffer (marker-buffer cua--global-mark-marker)
(goto-char (marker-position cua--global-mark-marker))
@@ -351,29 +351,44 @@ With prefix argument, don't jump to global mark when canceling it."
;;; Initialization
(defun cua--init-global-mark ()
- (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark)
- (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark)
- (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark)
- (define-key cua--global-mark-keymap [remap yank] 'cua-copy-next-to-global-mark)
-
- (define-key cua--global-mark-keymap [remap keyboard-escape-quit] 'cua-cancel-global-mark)
- (define-key cua--global-mark-keymap [remap keyboard-quit] 'cua-cancel-global-mark)
-
- (define-key cua--global-mark-keymap [(control ?d)] 'cua-cut-next-to-global-mark)
- (define-key cua--global-mark-keymap [remap delete-backward-char] 'cua-delete-backward-char-at-global-mark)
- (define-key cua--global-mark-keymap [remap backward-delete-char] 'cua-delete-backward-char-at-global-mark)
- (define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark)
- (define-key cua--global-mark-keymap [remap self-insert-command] 'cua-insert-char-at-global-mark)
+ (define-key cua--global-mark-keymap [remap copy-region-as-kill]
+ #'cua-copy-to-global-mark)
+ (define-key cua--global-mark-keymap [remap kill-ring-save]
+ #'cua-copy-to-global-mark)
+ (define-key cua--global-mark-keymap [remap kill-region]
+ #'cua-cut-to-global-mark)
+ (define-key cua--global-mark-keymap [remap yank]
+ #'cua-copy-next-to-global-mark)
+
+ (define-key cua--global-mark-keymap [remap keyboard-escape-quit]
+ #'cua-cancel-global-mark)
+ (define-key cua--global-mark-keymap [remap keyboard-quit]
+ #'cua-cancel-global-mark)
+
+ (define-key cua--global-mark-keymap [(control ?d)]
+ #'cua-cut-next-to-global-mark)
+ (define-key cua--global-mark-keymap [remap delete-backward-char]
+ #'cua-delete-backward-char-at-global-mark)
+ (define-key cua--global-mark-keymap [remap backward-delete-char]
+ #'cua-delete-backward-char-at-global-mark)
+ (define-key cua--global-mark-keymap [remap backward-delete-char-untabify]
+ #'cua-delete-backward-char-at-global-mark)
+ (define-key cua--global-mark-keymap [remap self-insert-command]
+ #'cua-insert-char-at-global-mark)
;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--global-mark-keymap [t]
'(menu-item "sic" cua-insert-char-at-global-mark :filter cua--self-insert-char-p))
- (define-key cua--global-mark-keymap [remap newline] 'cua-insert-newline-at-global-mark)
- (define-key cua--global-mark-keymap [remap newline-and-indent] 'cua-insert-newline-at-global-mark)
- (define-key cua--global-mark-keymap "\r" 'cua-insert-newline-at-global-mark)
+ (define-key cua--global-mark-keymap [remap newline]
+ #'cua-insert-newline-at-global-mark)
+ (define-key cua--global-mark-keymap [remap newline-and-indent]
+ #'cua-insert-newline-at-global-mark)
+ (define-key cua--global-mark-keymap "\r"
+ #'cua-insert-newline-at-global-mark)
- (define-key cua--global-mark-keymap "\t" 'cua-indent-to-global-mark-column)
+ (define-key cua--global-mark-keymap "\t"
+ #'cua-indent-to-global-mark-column)
(setq cua--global-mark-initialized t))
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index be2d7c0fd8a..0039092fd6e 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1,4 +1,4 @@
-;;; cua-rect.el --- CUA unified rectangle support
+;;; cua-rect.el --- CUA unified rectangle support -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -46,7 +46,7 @@ A cua-rectangle definition is a vector used for all actions in
TOP is the upper-left corner point.
-BOTTOM is the point at the end of line after the the lower-right
+BOTTOM is the point at the end of line after the lower-right
corner point.
LEFT and RIGHT are column numbers.
@@ -90,7 +90,7 @@ See `cua--rectangle'.")
(defvar cua--overlay-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "\r" 'cua-rotate-rectangle)))
+ (define-key map "\r" #'cua-rotate-rectangle)))
(defvar cua--virtual-edges-debug nil)
@@ -104,7 +104,7 @@ See `cua--rectangle'.")
(e (cua--rect-end-position)))
(undo-boundary)
(push (list 'apply 0 s e
- 'cua--rect-undo-handler
+ #'cua--rect-undo-handler
(copy-sequence cua--rectangle) t s e)
buffer-undo-list))))
@@ -114,7 +114,7 @@ See `cua--rectangle'.")
(setq cua--restored-rectangle (copy-sequence rect))
(setq cua--buffer-and-point-before-command nil))
(push (list 'apply 0 s (if on e s)
- 'cua--rect-undo-handler rect on s e)
+ #'cua--rect-undo-handler rect on s e)
buffer-undo-list))
;;;###autoload
@@ -575,6 +575,7 @@ Set undo boundary if UNDO is non-nil.
Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges)
Perform auto-tabify after operation if TABIFY is non-nil.
Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear."
+ (declare (indent 4))
(let* ((inhibit-field-text-motion t)
(start (cua--rectangle-top))
(end (cua--rectangle-bot))
@@ -645,8 +646,6 @@ Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear."
(cua--keep-active)))
(setq cua--buffer-and-point-before-command nil)))
-(put 'cua--rectangle-operation 'lisp-indent-function 4)
-
(defun cua--delete-rectangle ()
(let ((lines 0))
(if (not (cua--rectangle-virtual-edges))
@@ -1220,6 +1219,7 @@ The numbers are formatted according to the FORMAT string."
;;; Replace/rearrange text in current rectangle
(defun cua--rectangle-aux-replace (width adjust keep replace pad format-fct &optional setup-fct)
+ (declare (indent 4))
;; Process text inserted by calling SETUP-FCT or current rectangle if nil.
;; Then call FORMAT-FCT on text (if non-nil); takes two args: start and end.
;; Fill to WIDTH characters if > 0 or fill to current width if == 0.
@@ -1279,8 +1279,6 @@ The numbers are formatted according to the FORMAT string."
(if keep
(cua--rectangle-resized)))))
-(put 'cua--rectangle-aux-replace 'lisp-indent-function 4)
-
(defun cua--left-fill-rectangle (_start _end)
(beginning-of-line)
(while (< (point) (point-max))
@@ -1485,79 +1483,79 @@ With prefix arg, indent to that column."
(cua--M/H-key cua--rectangle-keymap key cmd))
(defun cua--init-rectangles ()
- (define-key cua--rectangle-keymap cua-rectangle-mark-key 'cua-clear-rectangle-mark)
- (define-key cua--region-keymap cua-rectangle-mark-key 'cua-toggle-rectangle-mark)
+ (define-key cua--rectangle-keymap cua-rectangle-mark-key #'cua-clear-rectangle-mark)
+ (define-key cua--region-keymap cua-rectangle-mark-key #'cua-toggle-rectangle-mark)
(unless (eq cua--rectangle-modifier-key 'meta)
- (cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark)
- (cua--M/H-key cua--region-keymap ?\s 'cua-toggle-rectangle-mark))
-
- (define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark)
-
- (define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
- (define-key cua--rectangle-keymap [remap right-char] 'cua-resize-rectangle-right)
- (define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left)
- (define-key cua--rectangle-keymap [remap left-char] 'cua-resize-rectangle-left)
- (define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down)
- (define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up)
- (define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol)
- (define-key cua--rectangle-keymap [remap beginning-of-line] 'cua-resize-rectangle-bol)
- (define-key cua--rectangle-keymap [remap end-of-buffer] 'cua-resize-rectangle-bot)
- (define-key cua--rectangle-keymap [remap beginning-of-buffer] 'cua-resize-rectangle-top)
- (define-key cua--rectangle-keymap [remap scroll-down] 'cua-resize-rectangle-page-up)
- (define-key cua--rectangle-keymap [remap scroll-up] 'cua-resize-rectangle-page-down)
- (define-key cua--rectangle-keymap [remap scroll-down-command] 'cua-resize-rectangle-page-up)
- (define-key cua--rectangle-keymap [remap scroll-up-command] 'cua-resize-rectangle-page-down)
-
- (define-key cua--rectangle-keymap [remap delete-backward-char] 'cua-delete-char-rectangle)
- (define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle)
- (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)
- (define-key cua--rectangle-keymap [remap self-insert-command] 'cua-insert-char-rectangle)
+ (cua--rect-M/H-key ?\s #'cua-clear-rectangle-mark)
+ (cua--M/H-key cua--region-keymap ?\s #'cua-toggle-rectangle-mark))
+
+ (define-key cua--rectangle-keymap [remap set-mark-command] #'cua-toggle-rectangle-mark)
+
+ (define-key cua--rectangle-keymap [remap forward-char] #'cua-resize-rectangle-right)
+ (define-key cua--rectangle-keymap [remap right-char] #'cua-resize-rectangle-right)
+ (define-key cua--rectangle-keymap [remap backward-char] #'cua-resize-rectangle-left)
+ (define-key cua--rectangle-keymap [remap left-char] #'cua-resize-rectangle-left)
+ (define-key cua--rectangle-keymap [remap next-line] #'cua-resize-rectangle-down)
+ (define-key cua--rectangle-keymap [remap previous-line] #'cua-resize-rectangle-up)
+ (define-key cua--rectangle-keymap [remap end-of-line] #'cua-resize-rectangle-eol)
+ (define-key cua--rectangle-keymap [remap beginning-of-line] #'cua-resize-rectangle-bol)
+ (define-key cua--rectangle-keymap [remap end-of-buffer] #'cua-resize-rectangle-bot)
+ (define-key cua--rectangle-keymap [remap beginning-of-buffer] #'cua-resize-rectangle-top)
+ (define-key cua--rectangle-keymap [remap scroll-down] #'cua-resize-rectangle-page-up)
+ (define-key cua--rectangle-keymap [remap scroll-up] #'cua-resize-rectangle-page-down)
+ (define-key cua--rectangle-keymap [remap scroll-down-command] #'cua-resize-rectangle-page-up)
+ (define-key cua--rectangle-keymap [remap scroll-up-command] #'cua-resize-rectangle-page-down)
+
+ (define-key cua--rectangle-keymap [remap delete-backward-char] #'cua-delete-char-rectangle)
+ (define-key cua--rectangle-keymap [remap backward-delete-char] #'cua-delete-char-rectangle)
+ (define-key cua--rectangle-keymap [remap backward-delete-char-untabify] #'cua-delete-char-rectangle)
+ (define-key cua--rectangle-keymap [remap self-insert-command] #'cua-insert-char-rectangle)
;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--rectangle-keymap [t]
'(menu-item "sic" cua-insert-char-rectangle :filter cua--self-insert-char-p))
- (define-key cua--rectangle-keymap "\r" 'cua-rotate-rectangle)
- (define-key cua--rectangle-keymap "\t" 'cua-indent-rectangle)
-
- (define-key cua--rectangle-keymap [(control ??)] 'cua-help-for-rectangle)
-
- (define-key cua--rectangle-keymap [mouse-1] 'cua-mouse-set-rectangle-mark)
- (define-key cua--rectangle-keymap [down-mouse-1] 'cua--mouse-ignore)
- (define-key cua--rectangle-keymap [drag-mouse-1] 'cua--mouse-ignore)
- (define-key cua--rectangle-keymap [mouse-3] 'cua-mouse-save-then-kill-rectangle)
- (define-key cua--rectangle-keymap [down-mouse-3] 'cua--mouse-ignore)
- (define-key cua--rectangle-keymap [drag-mouse-3] 'cua--mouse-ignore)
-
- (cua--rect-M/H-key 'up 'cua-move-rectangle-up)
- (cua--rect-M/H-key 'down 'cua-move-rectangle-down)
- (cua--rect-M/H-key 'left 'cua-move-rectangle-left)
- (cua--rect-M/H-key 'right 'cua-move-rectangle-right)
-
- (cua--rect-M/H-key '(control up) 'cua-scroll-rectangle-up)
- (cua--rect-M/H-key '(control down) 'cua-scroll-rectangle-down)
-
- (cua--rect-M/H-key ?a 'cua-align-rectangle)
- (cua--rect-M/H-key ?b 'cua-blank-rectangle)
- (cua--rect-M/H-key ?c 'cua-close-rectangle)
- (cua--rect-M/H-key ?f 'cua-fill-char-rectangle)
- (cua--rect-M/H-key ?i 'cua-incr-rectangle)
- (cua--rect-M/H-key ?k 'cua-cut-rectangle-as-text)
- (cua--rect-M/H-key ?l 'cua-downcase-rectangle)
- (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text)
- (cua--rect-M/H-key ?n 'cua-sequence-rectangle)
- (cua--rect-M/H-key ?o 'cua-open-rectangle)
- (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges)
- (cua--rect-M/H-key ?P 'cua-do-rectangle-padding)
- (cua--rect-M/H-key ?q 'cua-refill-rectangle)
- (cua--rect-M/H-key ?r 'cua-replace-in-rectangle)
- (cua--rect-M/H-key ?R 'cua-reverse-rectangle)
- (cua--rect-M/H-key ?s 'cua-string-rectangle)
- (cua--rect-M/H-key ?t 'cua-text-fill-rectangle)
- (cua--rect-M/H-key ?u 'cua-upcase-rectangle)
- (cua--rect-M/H-key ?| 'cua-shell-command-on-rectangle)
- (cua--rect-M/H-key ?' 'cua-restrict-prefix-rectangle)
- (cua--rect-M/H-key ?/ 'cua-restrict-regexp-rectangle)
+ (define-key cua--rectangle-keymap "\r" #'cua-rotate-rectangle)
+ (define-key cua--rectangle-keymap "\t" #'cua-indent-rectangle)
+
+ (define-key cua--rectangle-keymap [(control ??)] #'cua-help-for-rectangle)
+
+ (define-key cua--rectangle-keymap [mouse-1] #'cua-mouse-set-rectangle-mark)
+ (define-key cua--rectangle-keymap [down-mouse-1] #'cua--mouse-ignore)
+ (define-key cua--rectangle-keymap [drag-mouse-1] #'cua--mouse-ignore)
+ (define-key cua--rectangle-keymap [mouse-3] #'cua-mouse-save-then-kill-rectangle)
+ (define-key cua--rectangle-keymap [down-mouse-3] #'cua--mouse-ignore)
+ (define-key cua--rectangle-keymap [drag-mouse-3] #'cua--mouse-ignore)
+
+ (cua--rect-M/H-key 'up #'cua-move-rectangle-up)
+ (cua--rect-M/H-key 'down #'cua-move-rectangle-down)
+ (cua--rect-M/H-key 'left #'cua-move-rectangle-left)
+ (cua--rect-M/H-key 'right #'cua-move-rectangle-right)
+
+ (cua--rect-M/H-key '(control up) #'cua-scroll-rectangle-up)
+ (cua--rect-M/H-key '(control down) #'cua-scroll-rectangle-down)
+
+ (cua--rect-M/H-key ?a #'cua-align-rectangle)
+ (cua--rect-M/H-key ?b #'cua-blank-rectangle)
+ (cua--rect-M/H-key ?c #'cua-close-rectangle)
+ (cua--rect-M/H-key ?f #'cua-fill-char-rectangle)
+ (cua--rect-M/H-key ?i #'cua-incr-rectangle)
+ (cua--rect-M/H-key ?k #'cua-cut-rectangle-as-text)
+ (cua--rect-M/H-key ?l #'cua-downcase-rectangle)
+ (cua--rect-M/H-key ?m #'cua-copy-rectangle-as-text)
+ (cua--rect-M/H-key ?n #'cua-sequence-rectangle)
+ (cua--rect-M/H-key ?o #'cua-open-rectangle)
+ (cua--rect-M/H-key ?p #'cua-toggle-rectangle-virtual-edges)
+ (cua--rect-M/H-key ?P #'cua-do-rectangle-padding)
+ (cua--rect-M/H-key ?q #'cua-refill-rectangle)
+ (cua--rect-M/H-key ?r #'cua-replace-in-rectangle)
+ (cua--rect-M/H-key ?R #'cua-reverse-rectangle)
+ (cua--rect-M/H-key ?s #'cua-string-rectangle)
+ (cua--rect-M/H-key ?t #'cua-text-fill-rectangle)
+ (cua--rect-M/H-key ?u #'cua-upcase-rectangle)
+ (cua--rect-M/H-key ?| #'cua-shell-command-on-rectangle)
+ (cua--rect-M/H-key ?' #'cua-restrict-prefix-rectangle)
+ (cua--rect-M/H-key ?/ #'cua-restrict-regexp-rectangle)
(setq cua--rectangle-initialized t))
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 98085c6214d..a723dbdbb90 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -1,4 +1,4 @@
-;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs
+;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2000-2021 Free Software Foundation, Inc.
@@ -26,7 +26,7 @@
;; [Part of the GNU Emacs EDT Emulation.]
-;; This emacs lisp program can be used to create an emacs lisp file
+;; This Emacs Lisp program can be used to create an Emacs Lisp file
;; that defines the mapping of the user's keyboard to the LK-201
;; keyboard function keys and keypad keys (around which EDT has been
;; designed). Please read the "Usage" AND "Known Problems" sections
@@ -101,6 +101,8 @@
(define-obsolete-variable-alias 'edt-window-system 'window-system "27.1")
(defconst edt-xserver (when (eq window-system 'x)
+ (declare-function x-server-vendor "xfns.c"
+ (&optional terminal))
;; The Cygwin window manager has a `/' in its
;; name, which breaks the generated file name of
;; the custom key map file. Replace `/' with a
@@ -176,7 +178,7 @@
(mapc
(lambda (function-key)
(if (not (lookup-key (current-global-map) function-key))
- (define-key (current-global-map) function-key 'forward-char)))
+ (define-key (current-global-map) function-key #'forward-char)))
'([kp-0] [kp-1] [kp-2] [kp-3] [kp-4]
[kp-5] [kp-6] [kp-7] [kp-8] [kp-9]
[kp-space]
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index 7760a7f2b46..f11afb1d02d 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -1,4 +1,4 @@
-;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs
+;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986, 1992-1995, 2000-2021 Free Software Foundation,
;; Inc.
@@ -178,9 +178,6 @@
(defvar edt-user-global-map)
(defvar rect-start-point)
-(defconst edt-version "4.0" "EDT Emulation version number.")
-(make-obsolete-variable 'edt-version nil "28.1")
-
;;;
;;; User Configurable Variables
;;;
@@ -192,8 +189,7 @@ Emulation. If set to nil (the default), the `page-delimiter' variable
is set to \"\\f\" when edt-emulation-on is first invoked. This
setting replicates EDT's page delimiter behavior. The original value
is restored when edt-emulation-off is called."
- :type 'boolean
- :group 'edt)
+ :type 'boolean)
(defcustom edt-use-EDT-control-key-bindings nil
"Emacs MUST be restarted for a change in value to take effect!
@@ -201,8 +197,7 @@ Non-nil causes the control key bindings to be replaced with EDT
bindings. If set to nil (the default), EDT control key bindings are
not used and the current Emacs control key bindings are retained for
use within the EDT emulation."
- :type 'boolean
- :group 'edt)
+ :type 'boolean)
(defcustom edt-word-entities '(?\t)
"Specifies the list of EDT word entity characters.
@@ -226,22 +221,19 @@ representations, which you can also use:
In EDT Emulation movement-by-word commands, each character in the list
will be treated as if it were a separate word."
- :type '(repeat integer)
- :group 'edt)
+ :type '(repeat integer))
(defcustom edt-top-scroll-margin 10
"Scroll margin at the top of the screen.
Interpreted as a percent of the current window size with a default
setting of 10%. If set to 0, top scroll margin is disabled."
- :type 'integer
- :group 'edt)
+ :type 'integer)
(defcustom edt-bottom-scroll-margin 15
"Scroll margin at the bottom of the screen.
Interpreted as a percent of the current window size with a default
setting of 15%. If set to 0, bottom scroll margin is disabled."
- :type 'integer
- :group 'edt)
+ :type 'integer)
;;;
;;; Internal Variables
@@ -304,6 +296,8 @@ This means that an edt-user.el file was found in the user's `load-path'.")
;;; o edt-emulation-on o edt-load-keys
;;;
(defconst edt-xserver (when (eq window-system 'x)
+ (declare-function x-server-vendor "xfns.c"
+ (&optional terminal))
;; The Cygwin window manager has a `/' in its
;; name, which breaks the generated file name of
;; the custom key map file. Replace `/' with a
@@ -323,31 +317,31 @@ This means that an edt-user.el file was found in the user's `load-path'.")
;;;; EDT Emulation Commands
;;;;
-;;; Almost all of EDT's keypad mode commands have equivalent Emacs
-;;; function counterparts. But many of these counterparts behave
-;;; somewhat differently in Emacs.
-;;;
-;;; So, the following Emacs functions emulate, where practical, the
-;;; exact behavior of the corresponding EDT keypad mode commands. In
-;;; a few cases, the emulation is not exact, but it should be close
-;;; enough for most EDT die-hards.
-;;;
+;; Almost all of EDT's keypad mode commands have equivalent Emacs
+;; function counterparts. But many of these counterparts behave
+;; somewhat differently in Emacs.
+;;
+;; So, the following Emacs functions emulate, where practical, the
+;; exact behavior of the corresponding EDT keypad mode commands. In
+;; a few cases, the emulation is not exact, but it should be close
+;; enough for most EDT die-hards.
+;;
;;;
;;; PAGE
;;;
-;;; Emacs uses the regexp assigned to page-delimiter to determine what
-;;; marks a page break. This is normally "^\f", which causes the
-;;; edt-page command to ignore form feeds not located at the beginning
-;;; of a line. To emulate the EDT PAGE command exactly,
-;;; page-delimiter is set to "\f" when EDT emulation is turned on, and
-;;; restored to its original value when EDT emulation is turned off.
-;;; But this can be overridden if the EDT definition is not desired by
-;;; placing
-;;;
-;;; (setq edt-keep-current-page-delimiter t)
-;;;
-;;; in your init file.
+;; Emacs uses the regexp assigned to page-delimiter to determine what
+;; marks a page break. This is normally "^\f", which causes the
+;; edt-page command to ignore form feeds not located at the beginning
+;; of a line. To emulate the EDT PAGE command exactly,
+;; page-delimiter is set to "\f" when EDT emulation is turned on, and
+;; restored to its original value when EDT emulation is turned off.
+;; But this can be overridden if the EDT definition is not desired by
+;; placing
+;;
+;; (setq edt-keep-current-page-delimiter t)
+;;
+;; in your init file.
(defun edt-page-forward (num)
"Move forward to just after next page delimiter.
@@ -384,12 +378,12 @@ Argument NUM is the number of page delimiters to move."
;;;
;;; SECT
;;;
-;;; EDT defaults a section size to be 16 lines of its one and only
-;;; 24-line window. That's two-thirds of the window at a time. The
-;;; EDT SECT commands moves the cursor, not the window.
-;;;
-;;; This emulation of EDT's SECT moves the cursor approximately
-;;; two-thirds of the current window at a time.
+;; EDT defaults a section size to be 16 lines of its one and only
+;; 24-line window. That's two-thirds of the window at a time. The
+;; EDT SECT commands moves the cursor, not the window.
+;;
+;; This emulation of EDT's SECT moves the cursor approximately
+;; two-thirds of the current window at a time.
(defun edt-sect-forward (num)
"Move cursor forward two-thirds of a window's number of lines.
@@ -417,8 +411,8 @@ Argument NUM is the number of sections to move."
;;;
;;; BEGINNING OF LINE
;;;
-;;; EDT's beginning-of-line command is not affected by current
-;;; direction, for some unknown reason.
+;; EDT's beginning-of-line command is not affected by current
+;; direction, for some unknown reason.
(defun edt-beginning-of-line (num)
"Move backward to next beginning of line mark.
@@ -470,13 +464,13 @@ Argument NUM is the number of EOL marks to move."
;;;
;;; WORD
;;;
-;;; This one is a tad messy. To emulate EDT's behavior everywhere in
-;;; the file (beginning of file, end of file, beginning of line, end
-;;; of line, etc.) it takes a bit of special handling.
-;;;
-;;; The variable edt-word-entities contains a list of characters which
-;;; are to be viewed as distinct words wherever they appear in the
-;;; buffer. This emulates the EDT line mode command SET ENTITY WORD.
+;; This one is a tad messy. To emulate EDT's behavior everywhere in
+;; the file (beginning of file, end of file, beginning of line, end
+;; of line, etc.) it takes a bit of special handling.
+;;
+;; The variable edt-word-entities contains a list of characters which
+;; are to be viewed as distinct words wherever they appear in the
+;; buffer. This emulates the EDT line mode command SET ENTITY WORD.
(defun edt-one-word-forward ()
@@ -567,9 +561,9 @@ Argument NUM is the number of characters to move."
;;;
;;; LINE
;;;
-;;; When direction is set to BACKUP, LINE behaves just like BEGINNING
-;;; OF LINE in EDT. So edt-line-backward is not really needed as a
-;;; separate function.
+;; When direction is set to BACKUP, LINE behaves just like BEGINNING
+;; OF LINE in EDT. So edt-line-backward is not really needed as a
+;; separate function.
(defun edt-line-backward (num)
"Move backward to next beginning of line mark.
@@ -640,8 +634,7 @@ Argument NUM is the number of lines to move."
(defmacro edt-with-position (&rest body)
"Execute BODY with some position-related variables bound."
- `(let* ((left nil)
- (beg (edt-current-line))
+ `(let* ((beg (edt-current-line))
(height (window-height))
(top-percent
(if (zerop edt-top-scroll-margin) 10 edt-top-scroll-margin))
@@ -655,6 +648,7 @@ Argument NUM is the number of lines to move."
(far (save-excursion
(goto-char bottom)
(point-at-bol (1- height)))))
+ (ignore top far)
,@body))
;;;
@@ -672,9 +666,10 @@ Optional argument FIND is t is this function is called from `edt-find'."
(search-backward edt-find-last-text)
(edt-set-match)
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left)
+ top-margin
+ (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin))))))
(defun edt-find-backward (&optional find)
@@ -711,9 +706,9 @@ Optional argument FIND is t if this function is called from `edt-find'."
(search-backward edt-find-last-text)
(edt-set-match)
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left) top-margin
+ (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin))))
(backward-char 1)
(error "Search failed: \"%s\"" edt-find-last-text))))
@@ -1203,9 +1198,9 @@ Argument BOTTOM is the bottom margin in number of lines or percent of window."
;;;;
;;;
-;;; Several enhancements and additions to EDT keypad mode commands are
-;;; provided here. Some of these have been motivated by similar
-;;; TPU/EVE and EVE-Plus commands. Others are new.
+;; Several enhancements and additions to EDT keypad mode commands are
+;; provided here. Some of these have been motivated by similar
+;; TPU/EVE and EVE-Plus commands. Others are new.
;;;
;;; CHANGE DIRECTION
@@ -1245,9 +1240,8 @@ Argument NUM is the positive number of sentences to move."
(forward-word 1)
(backward-sentence))
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left) top-margin (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin)))))
(defun edt-sentence-backward (num)
@@ -1286,9 +1280,8 @@ Argument NUM is the positive number of paragraphs to move."
(forward-line 1))
(setq num (1- num)))
(if (> (point) far)
- (if (zerop (setq left (save-excursion (forward-line height))))
- (recenter top-margin)
- (recenter (- left bottom-up-margin)))
+ (let ((left (save-excursion (forward-line height))))
+ (recenter (if (zerop left) top-margin (- left bottom-up-margin))))
(and (> (point) bottom) (recenter bottom-margin)))))
(defun edt-paragraph-backward (num)
@@ -1378,8 +1371,8 @@ Definition is stored in `edt-last-replaced-key-definition'."
;;;
;;; SCROLL WINDOW
;;;
-;;; Scroll a window (less one line) at a time. Leave cursor in center of
-;;; window.
+;; Scroll a window (less one line) at a time. Leave cursor in center of
+;; window.
(defun edt-scroll-window-forward (num)
"Scroll forward one window in buffer, less one line.
@@ -2051,7 +2044,7 @@ Optional argument USER-SETUP non-nil means called from function
(fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
(edt-select-default-global-map)))
;; Keep the menu bar Buffers menu up-to-date in edt-default-global-map.
- (add-hook 'menu-bar-update-hook 'edt-default-menu-bar-update-buffers))
+ (add-hook 'menu-bar-update-hook #'edt-default-menu-bar-update-buffers))
(defun edt-user-emulation-setup ()
"Setup user custom emulation of DEC's EDT editor."
@@ -2072,7 +2065,7 @@ Optional argument USER-SETUP non-nil means called from function
(edt-setup-user-bindings))
(edt-select-user-global-map)
;; Keep the menu bar Buffers menu up-to-date in edt-user-global-map.
- (add-hook 'menu-bar-update-hook 'edt-user-menu-bar-update-buffers))
+ (add-hook 'menu-bar-update-hook #'edt-user-menu-bar-update-buffers))
(defun edt-select-default-global-map()
"Select default EDT emulation key bindings."
@@ -2490,7 +2483,7 @@ G-C-\\: Split Window | FNDNXT | Yank | CUT |
(and b
(with-current-buffer b
(set-buffer-modified-p t)))
- (fset 'help-print-return-message 'ignore)
+ (fset 'help-print-return-message #'ignore)
(call-interactively fun)
(and (get-buffer name)
(get-buffer-window (get-buffer name))
@@ -2537,6 +2530,9 @@ G-C-\\: Split Window | FNDNXT | Yank | CUT |
(set-frame-width nil 132)
(message "Terminal width 132"))
+(defconst edt-version "4.0" "EDT Emulation version number.")
+(make-obsolete-variable 'edt-version 'emacs-version "28.1")
+
(provide 'edt)
;;; edt.el ends here
diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el
index e4f3c4d53ec..56202c7fff8 100644
--- a/lisp/emulation/keypad.el
+++ b/lisp/emulation/keypad.el
@@ -1,4 +1,4 @@
-;;; keypad.el --- simplified keypad bindings
+;;; keypad.el --- simplified keypad bindings -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -101,10 +101,10 @@
"Specifies the keypad setup for unshifted keypad keys when NumLock is off.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(if value
(keypad-setup value nil nil value)))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:link '(emacs-commentary-link "keypad.el")
:version "22.1"
:type '(choice (const :tag "Plain numeric keypad" numeric)
@@ -124,10 +124,10 @@ decimal key must be specified."
"Specifies the keypad setup for unshifted keypad keys when NumLock is on.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(if value
(keypad-setup value t nil value)))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:link '(emacs-commentary-link "keypad.el")
:version "22.1"
:type '(choice (const :tag "Plain numeric keypad" numeric)
@@ -147,10 +147,10 @@ decimal key must be specified."
"Specifies the keypad setup for shifted keypad keys when NumLock is off.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(if value
(keypad-setup value nil t value)))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:link '(emacs-commentary-link "keypad.el")
:version "22.1"
:type '(choice (const :tag "Plain numeric keypad" numeric)
@@ -170,10 +170,10 @@ decimal key must be specified."
"Specifies the keypad setup for shifted keypad keys when NumLock is off.
When selecting the plain numeric keypad setup, the character returned by the
decimal key must be specified."
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(if value
(keypad-setup value t t value)))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:link '(emacs-commentary-link "keypad.el")
:version "22.1"
:type '(choice (const :tag "Plain numeric keypad" numeric)
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index f38be908897..728f790a962 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -24,8 +24,6 @@
;;; Code:
-(provide 'viper-cmd)
-
;; Compiler pacifier
(defvar viper-minibuffer-current-face)
(defvar viper-minibuffer-insert-face)
@@ -293,15 +291,15 @@
;; desirable that viper-pre-command-sentinel is the last hook and
;; viper-post-command-sentinel is the first hook.
- (remove-hook 'post-command-hook 'viper-post-command-sentinel)
- (add-hook 'post-command-hook 'viper-post-command-sentinel)
- (remove-hook 'pre-command-hook 'viper-pre-command-sentinel)
- (add-hook 'pre-command-hook 'viper-pre-command-sentinel t)
+ (remove-hook 'post-command-hook #'viper-post-command-sentinel)
+ (add-hook 'post-command-hook #'viper-post-command-sentinel)
+ (remove-hook 'pre-command-hook #'viper-pre-command-sentinel)
+ (add-hook 'pre-command-hook #'viper-pre-command-sentinel t)
;; These hooks will be added back if switching to insert/replace mode
(remove-hook 'viper-post-command-hooks
- 'viper-insert-state-post-command-sentinel 'local)
+ #'viper-insert-state-post-command-sentinel 'local)
(remove-hook 'viper-pre-command-hooks
- 'viper-insert-state-pre-command-sentinel 'local)
+ #'viper-insert-state-pre-command-sentinel 'local)
(setq viper-intermediate-command nil)
(cond ((eq new-state 'vi-state)
(cond ((member viper-current-state '(insert-state replace-state))
@@ -344,9 +342,9 @@
(viper-move-marker-locally
'viper-last-posn-while-in-insert-state (point))
(add-hook 'viper-post-command-hooks
- 'viper-insert-state-post-command-sentinel t 'local)
+ #'viper-insert-state-post-command-sentinel t 'local)
(add-hook 'viper-pre-command-hooks
- 'viper-insert-state-pre-command-sentinel t 'local))
+ #'viper-insert-state-pre-command-sentinel t 'local))
) ; outermost cond
;; Nothing needs to be done to switch to emacs mode! Just set some
@@ -378,12 +376,12 @@
(cond ((memq state '(insert-state replace-state))
(if viper-auto-indent
(progn
- (define-key viper-insert-basic-map "\C-m" 'viper-autoindent)
+ (define-key viper-insert-basic-map "\C-m" #'viper-autoindent)
(if viper-want-emacs-keys-in-insert
;; expert
(define-key viper-insert-basic-map "\C-j" nil)
;; novice
- (define-key viper-insert-basic-map "\C-j" 'viper-autoindent)))
+ (define-key viper-insert-basic-map "\C-j" #'viper-autoindent)))
(define-key viper-insert-basic-map "\C-m" nil)
(define-key viper-insert-basic-map "\C-j" nil))
@@ -392,25 +390,24 @@
(if viper-want-ctl-h-help
(progn
- (define-key viper-insert-basic-map "\C-h" 'help-command)
- (define-key viper-replace-map "\C-h" 'help-command))
+ (define-key viper-insert-basic-map "\C-h" #'help-command)
+ (define-key viper-replace-map "\C-h" #'help-command))
(define-key viper-insert-basic-map
- "\C-h" 'viper-del-backward-char-in-insert)
+ "\C-h" #'viper-del-backward-char-in-insert)
(define-key viper-replace-map
- "\C-h" 'viper-del-backward-char-in-replace))
+ "\C-h" #'viper-del-backward-char-in-replace))
;; In XEmacs, C-h overrides backspace, so we make sure it doesn't.
(define-key viper-insert-basic-map
- [backspace] 'viper-del-backward-char-in-insert)
+ [backspace] #'viper-del-backward-char-in-insert)
(define-key viper-replace-map
- [backspace] 'viper-del-backward-char-in-replace)
+ [backspace] #'viper-del-backward-char-in-replace)
) ; end insert/replace case
(t ; Vi state
(setq viper-vi-diehard-minor-mode (not viper-want-emacs-keys-in-vi))
- (if viper-want-ctl-h-help
- (define-key viper-vi-basic-map "\C-h" 'help-command)
- (define-key viper-vi-basic-map "\C-h" 'viper-backward-char))
+ (define-key viper-vi-basic-map "\C-h"
+ (if viper-want-ctl-h-help #'help-command #'viper-backward-char))
;; In XEmacs, C-h overrides backspace, so we make sure it doesn't.
- (define-key viper-vi-basic-map [backspace] 'viper-backward-char))
+ (define-key viper-vi-basic-map [backspace] #'viper-backward-char))
))
@@ -831,7 +828,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
(condition-case nil
(let (viper-vi-kbd-minor-mode) ; execute without kbd macros
- (setq result (eval form)))
+ (setq result (eval form t)))
(error
(signal 'quit nil)))
@@ -847,7 +844,7 @@ Similar to `viper-escape-to-emacs', but accepts forms rather than keystrokes."
(let ((buff (current-buffer))
result)
(viper-set-mode-vars-for 'emacs-state)
- (setq result (eval form))
+ (setq result (eval form t))
(if (not (equal buff (current-buffer))) ; cmd switched buffer
(with-current-buffer buff
(viper-set-mode-vars-for viper-current-state)))
@@ -1411,17 +1408,17 @@ as a Meta key and any number of multiple escapes are allowed."
;; without affecting other functions. Buffer search can now be bound
;; to any character.
-(aset viper-exec-array ?c 'viper-exec-change)
-(aset viper-exec-array ?C 'viper-exec-Change)
-(aset viper-exec-array ?d 'viper-exec-delete)
-(aset viper-exec-array ?D 'viper-exec-Delete)
-(aset viper-exec-array ?y 'viper-exec-yank)
-(aset viper-exec-array ?Y 'viper-exec-Yank)
-(aset viper-exec-array ?r 'viper-exec-dummy)
-(aset viper-exec-array ?! 'viper-exec-bang)
-(aset viper-exec-array ?< 'viper-exec-shift)
-(aset viper-exec-array ?> 'viper-exec-shift)
-(aset viper-exec-array ?= 'viper-exec-equals)
+(aset viper-exec-array ?c #'viper-exec-change)
+(aset viper-exec-array ?C #'viper-exec-Change)
+(aset viper-exec-array ?d #'viper-exec-delete)
+(aset viper-exec-array ?D #'viper-exec-Delete)
+(aset viper-exec-array ?y #'viper-exec-yank)
+(aset viper-exec-array ?Y #'viper-exec-Yank)
+(aset viper-exec-array ?r #'viper-exec-dummy)
+(aset viper-exec-array ?! #'viper-exec-bang)
+(aset viper-exec-array ?< #'viper-exec-shift)
+(aset viper-exec-array ?> #'viper-exec-shift)
+(aset viper-exec-array ?= #'viper-exec-equals)
@@ -1560,7 +1557,7 @@ invokes the command before that, etc."
(defun viper-undo-sentinel (beg end length)
(run-hook-with-args 'viper-undo-functions beg end length))
-(add-hook 'after-change-functions 'viper-undo-sentinel)
+(add-hook 'after-change-functions #'viper-undo-sentinel)
;; Hook used in viper-undo
(defun viper-after-change-undo-hook (beg end _len)
@@ -1570,7 +1567,7 @@ invokes the command before that, etc."
;; some other hooks may be changing various text properties in
;; the buffer in response to 'undo'; so remove this hook to avoid
;; its repeated invocation
- (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)
+ (remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local)
))
(defun viper-undo ()
@@ -1581,7 +1578,7 @@ invokes the command before that, etc."
undo-beg-posn undo-end-posn)
;; the viper-after-change-undo-hook removes itself after the 1st invocation
- (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local)
+ (add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local)
(undo-start)
(undo-more 2)
@@ -1789,7 +1786,7 @@ Undo previous insertion and inserts new."
(do-not-change-default t))
(setq quote-str
(viper-read-string-with-history
- "Quote string: "
+ "Quote string"
nil
'viper-quote-region-history
;; FIXME: Use comment-region.
@@ -1853,8 +1850,8 @@ Undo previous insertion and inserts new."
;;; Minibuffer business
(defsubst viper-set-minibuffer-style ()
- (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
- (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook))
+ (add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel)
+ (add-hook 'post-command-hook #'viper-minibuffer-post-command-hook))
(defun viper-minibuffer-setup-sentinel ()
@@ -1998,30 +1995,24 @@ problems."
#'viper-minibuffer-standard-hook
(if (or (not (listp old)) (eq (car old) 'lambda))
(list old) old))))
- (val "")
- (padding "")
- temp-msg)
+ (val ""))
(setq keymap (or keymap minibuffer-local-map)
initial (or initial "")
- viper-initial initial
- temp-msg (if default
- (format "(default %s) " default)
- ""))
+ viper-initial initial)
(setq viper-incomplete-ex-cmd nil)
- (setq val (read-from-minibuffer prompt
- (concat temp-msg initial val padding)
- keymap nil history-var))
- (setq minibuffer-setup-hook nil
- padding (viper-array-to-string (this-command-keys))
- temp-msg "")
+ (setq val (read-from-minibuffer (format-prompt prompt default)
+ nil
+ keymap nil history-var default))
+ (setq minibuffer-setup-hook nil)
;; the following tries to be smart about what to put in history
- (if (not (string= val (car (eval history-var))))
- (set history-var (cons val (eval history-var))))
- (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var)))
- (string= (nth 0 (eval history-var)) ""))
- (set history-var (cdr (eval history-var))))
+ (if (not (string= val (car (symbol-value history-var))))
+ (push val (symbol-value history-var)))
+ (if (or (string= (nth 0 (symbol-value history-var))
+ (nth 1 (symbol-value history-var)))
+ (string= (nth 0 (symbol-value history-var)) ""))
+ (pop (symbol-value history-var)))
;; If the user enters nothing but the prev cmd wasn't viper-ex,
;; viper-command-argument, or `! shell-command', this probably means
;; that the user typed something then erased. Return "" in this case, not
@@ -2192,22 +2183,22 @@ problems."
viper-sitting-in-replace t
viper-replace-chars-to-delete 0)
(add-hook
- 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local)
+ 'viper-after-change-functions #'viper-replace-mode-spy-after t 'local)
(add-hook
- 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local)
+ 'viper-before-change-functions #'viper-replace-mode-spy-before t 'local)
;; this will get added repeatedly, but no harm
- (add-hook 'after-change-functions 'viper-after-change-sentinel t)
- (add-hook 'before-change-functions 'viper-before-change-sentinel t)
+ (add-hook 'after-change-functions #'viper-after-change-sentinel t)
+ (add-hook 'before-change-functions #'viper-before-change-sentinel t)
(viper-move-marker-locally
'viper-last-posn-in-replace-region (viper-replace-start))
(add-hook
- 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel
+ 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel
t 'local)
(add-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local)
;; guard against a smarty who switched from R-replace to normal replace
(remove-hook
- 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
(if overwrite-mode (overwrite-mode -1))
)
@@ -2281,13 +2272,13 @@ problems."
;; Don't delete anything if current point is past the end of the overlay.
(defun viper-finish-change ()
(remove-hook
- 'viper-after-change-functions 'viper-replace-mode-spy-after 'local)
+ 'viper-after-change-functions #'viper-replace-mode-spy-after 'local)
(remove-hook
- 'viper-before-change-functions 'viper-replace-mode-spy-before 'local)
+ 'viper-before-change-functions #'viper-replace-mode-spy-before 'local)
(remove-hook
- 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local)
(remove-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
(viper-restore-cursor-color 'after-replace-mode)
(setq viper-sitting-in-replace nil) ; just in case we'll need to know it
(save-excursion
@@ -2317,21 +2308,21 @@ problems."
(defun viper-finish-R-mode ()
(remove-hook
- 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
(remove-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
(viper-downgrade-to-insert))
(defun viper-start-R-mode ()
;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
(overwrite-mode 1)
(add-hook
- 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local)
+ 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local)
(add-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local)
;; guard against a smarty who switched from R-replace to normal replace
(remove-hook
- 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local)
)
@@ -3467,7 +3458,8 @@ controlled by the sign of prefix numeric value."
'(viper-command-argument viper-digit-argument viper-repeat))
(setq viper-this-command-keys (this-command-keys)))
(let* ((keymap (let ((keymap (copy-keymap minibuffer-local-map)))
- (define-key keymap [(control ?s)] 'viper-insert-isearch-string)
+ (define-key keymap [(control ?s)]
+ #'viper-insert-isearch-string)
keymap))
(s (viper-read-string-with-history
prompt
@@ -3776,8 +3768,8 @@ Null string will repeat previous search."
(char-to-string viper-buffer-search-char))
(t (error "viper-buffer-search-char: wrong value type, %S"
viper-buffer-search-char)))
- 'viper-command-argument)
- (aset viper-exec-array viper-buffer-search-char 'viper-exec-buffer-search)
+ #'viper-command-argument)
+ (aset viper-exec-array viper-buffer-search-char #'viper-exec-buffer-search)
(setq viper-prefix-commands
(cons viper-buffer-search-char viper-prefix-commands)))
@@ -3826,7 +3818,7 @@ Null string will repeat previous search."
(let (buffer buffer-name)
(setq buffer-name
(funcall viper-read-buffer-function
- (format "Kill buffer (%s): "
+ (format-prompt "Kill buffer"
(buffer-name (current-buffer)))))
(setq buffer
(if (null buffer-name)
@@ -4172,8 +4164,8 @@ and regexp replace."
(interactive)
(let (str)
(setq str (viper-read-string-with-history
- (if viper-re-query-replace "Query replace regexp: "
- "Query replace: ")
+ (if viper-re-query-replace "Query replace regexp"
+ "Query replace")
nil ; no initial
'viper-replace1-history
(car viper-replace1-history) ; default
@@ -4188,7 +4180,7 @@ and regexp replace."
(query-replace-regexp
str
(viper-read-string-with-history
- (format-message "Query replace regexp `%s' with: " str)
+ (format-message "Query replace regexp `%s' with" str)
nil ; no initial
'viper-replace1-history
(car viper-replace1-history) ; default
@@ -4196,7 +4188,7 @@ and regexp replace."
(query-replace
str
(viper-read-string-with-history
- (format-message "Query replace `%s' with: " str)
+ (format-message "Query replace `%s' with" str)
nil ; no initial
'viper-replace1-history
(car viper-replace1-history) ; default
@@ -4368,7 +4360,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
;; Input Mode Indentation
-(define-obsolete-function-alias 'viper-looking-back 'looking-back "24.4")
+(define-obsolete-function-alias 'viper-looking-back #'looking-back "24.4")
(defun viper-forward-indent ()
@@ -4511,8 +4503,8 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
;; standard value. Otherwise, get the value saved in the alist STORAGE. If
;; STORAGE is nil, use viper-saved-user-settings.
(defun viper-standard-value (symbol &optional storage)
- (or (eval (car (get symbol 'customized-value)))
- (eval (car (get symbol 'saved-value)))
+ (or (eval (car (get symbol 'customized-value)) t)
+ (eval (car (get symbol 'saved-value)) t)
(nth 1 (assoc symbol (or storage viper-saved-user-settings)))))
@@ -4849,7 +4841,5 @@ Mail anyway (y or n)? ")
nil 'delete-other-windows
salutation)))
-
-
-
+(provide 'viper-cmd)
;;; viper-cmd.el ends here
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 238faed069f..55930e7e6bc 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1,4 +1,4 @@
-;;; viper-ex.el --- functions implementing the Ex commands for Viper
+;;; viper-ex.el --- functions implementing the Ex commands for Viper -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1998, 2000-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;; Code:
-(provide 'viper-ex)
-
;; Compiler pacifier
(defvar read-file-name-map)
(defvar viper-use-register)
@@ -190,7 +188,7 @@
;; Executes the function associated with the command
(defun ex-cmd-execute (cmd)
- (eval (cadr cmd)))
+ (eval (cadr cmd) t))
;; If this is a one-letter magic command, splice in args.
(defun ex-splice-args-in-1-letr-cmd (key list)
@@ -299,8 +297,7 @@
"\\)")
shell-file-name)))
"Is the user using a unix-type shell under a non-OS?"
- :type 'boolean
- :group 'viper-ex)
+ :type 'boolean)
(defcustom ex-unix-type-shell-options
(let ((case-fold-search t))
@@ -312,13 +309,11 @@
)))
"Options to pass to the Unix-style shell.
Don't put `-c' here, as it is added automatically."
- :type '(choice (const nil) string)
- :group 'viper-ex)
+ :type '(choice (const nil) string))
(defcustom ex-compile-command "make"
"The command to run when the user types :make."
- :type 'string
- :group 'viper-ex)
+ :type 'string)
(defcustom viper-glob-function
(cond (ex-unix-type-shell 'viper-glob-unix-files)
@@ -331,8 +326,7 @@ The default tries to set this variable to work with Unix or MS Windows.
However, if it doesn't work right for some types of Unix shells or some OS,
the user should supply the appropriate function and set this variable to the
corresponding function symbol."
- :type 'symbol
- :group 'viper-ex)
+ :type 'symbol)
;; Remembers the previous Ex tag.
@@ -363,13 +357,11 @@ corresponding function symbol."
"If t, :n and :b cycles through files and buffers in other window.
Then :N and :B cycles in the current window. If nil, this behavior is
reversed."
- :type 'boolean
- :group 'viper-ex)
+ :type 'boolean)
(defcustom ex-cycle-through-non-files nil
"Cycle through *scratch* and other buffers that don't visit any file."
- :type 'boolean
- :group 'viper-ex)
+ :type 'boolean)
;; Last shell command executed with :! command.
(defvar viper-ex-last-shell-com nil)
@@ -1108,7 +1100,7 @@ reversed."
(setq viper-keep-reading-filename nil
val (read-file-name (concat prompt str) nil default-directory))
(setq val (expand-file-name val))
- (if (and (string-match " " val)
+ (if (and (string-search " " val)
(ex-cmd-accepts-multiple-files-p ex-token))
(setq val (concat "\"" val "\"")))
(setq str (concat str (if (equal val "") "" " ")
@@ -1314,7 +1306,7 @@ reversed."
(let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
(cond ((file-exists-p filespec) (find-file filespec))
((string-match nonstandard-filename-chars filespec)
- (mapcar 'find-file (funcall viper-glob-function filespec)))
+ (mapcar #'find-file (funcall viper-glob-function filespec)))
(t (find-file filespec)))
))
@@ -1639,7 +1631,7 @@ reversed."
;; this function fixes ex-history for some commands like ex-read, ex-edit
(defun ex-fixup-history (&rest args)
(setq viper-ex-history
- (cons (mapconcat 'identity args " ") (cdr viper-ex-history))))
+ (cons (mapconcat #'identity args " ") (cdr viper-ex-history))))
;; Ex recover from emacs \#file\#
@@ -1672,8 +1664,8 @@ reversed."
(cursor-in-echo-area t)
str batch)
(define-key
- minibuffer-local-completion-map " " 'minibuffer-complete-and-exit)
- (define-key minibuffer-local-completion-map "=" 'exit-minibuffer)
+ minibuffer-local-completion-map " " #'minibuffer-complete-and-exit)
+ (define-key minibuffer-local-completion-map "=" #'exit-minibuffer)
(if (viper-set-unread-command-events
(ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m"))
(progn
@@ -1837,7 +1829,7 @@ reversed."
(format "%S" val)
val)))
(if actual-lisp-cmd
- (eval (car (read-from-string actual-lisp-cmd))))
+ (eval (car (read-from-string actual-lisp-cmd)) t))
(if (string= var "fill-column")
(if (> val2 0)
(auto-fill-mode 1)
@@ -2308,10 +2300,10 @@ Type `mak ' (including the space) to run make with no args."
(defun ex-print-display-lines (lines)
(cond
;; String doesn't contain a newline.
- ((not (string-match "\n" lines))
+ ((not (string-search "\n" lines))
(message "%s" lines))
;; String contains only one newline at the end. Strip it off.
- ((= (string-match "\n" lines) (1- (length lines)))
+ ((= (string-search "\n" lines) (1- (length lines)))
(message "%s" (substring lines 0 -1)))
;; String spans more than one line. Use a temporary buffer.
(t
@@ -2319,4 +2311,5 @@ Type `mak ' (including the space) to run make with no args."
(with-output-to-temp-buffer " *viper-info*"
(princ lines))))))
+(provide 'viper-ex)
;;; viper-ex.el ends here
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index c05cf6a48b4..8188971c0d0 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -1,4 +1,4 @@
-;;; viper-init.el --- some common definitions for Viper
+;;; viper-init.el --- some common definitions for Viper -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -46,7 +46,7 @@
;; Tell whether we are running as a window application or on a TTY
-(define-obsolete-function-alias 'viper-device-type 'window-system "27.1")
+(define-obsolete-function-alias 'viper-device-type #'window-system "27.1")
(defun viper-color-display-p ()
(condition-case nil
@@ -141,7 +141,7 @@ docstring. The variable becomes buffer-local whenever set."
(append (vconcat string) nil))
(defsubst viper-charlist-to-string (list)
- (mapconcat 'char-to-string list ""))
+ (mapconcat #'char-to-string list ""))
;; like char-after/before, but saves typing
(defun viper-char-at-pos (direction &optional offset)
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 1d80c9cd026..4a9070e84be 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -155,29 +155,26 @@ In insert mode, this key also functions as Meta."
(let ((old-value (if (boundp 'viper-toggle-key)
viper-toggle-key
[(control ?z)])))
- (mapc
- (lambda (buf)
- (with-current-buffer buf
- (when (and (boundp 'viper-insert-basic-map)
- (keymapp viper-insert-basic-map))
- (when old-value
- (define-key viper-insert-basic-map old-value nil))
- (define-key viper-insert-basic-map value 'viper-escape-to-vi))
- (when (and (boundp 'viper-vi-intercept-map)
- (keymapp viper-vi-intercept-map))
- (when old-value
- (define-key viper-vi-intercept-map old-value nil))
- (define-key
- viper-vi-intercept-map value 'viper-toggle-key-action))
- (when (and (boundp 'viper-emacs-intercept-map)
- (keymapp viper-emacs-intercept-map))
- (define-key viper-emacs-intercept-map old-value nil)
- (define-key
- viper-emacs-intercept-map value 'viper-change-state-to-vi))
- ))
- (buffer-list))
- (set-default symbol value)
- )))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (and (boundp 'viper-insert-basic-map)
+ (keymapp viper-insert-basic-map))
+ (when old-value
+ (define-key viper-insert-basic-map old-value nil))
+ (define-key viper-insert-basic-map value 'viper-escape-to-vi))
+ (when (and (boundp 'viper-vi-intercept-map)
+ (keymapp viper-vi-intercept-map))
+ (when old-value
+ (define-key viper-vi-intercept-map old-value nil))
+ (define-key
+ viper-vi-intercept-map value 'viper-toggle-key-action))
+ (when (and (boundp 'viper-emacs-intercept-map)
+ (keymapp viper-emacs-intercept-map))
+ (define-key viper-emacs-intercept-map old-value nil)
+ (define-key
+ viper-emacs-intercept-map value 'viper-change-state-to-vi))
+ ))
+ (set-default symbol value))))
(defcustom viper-quoted-insert-key "\C-v"
"The key used to quote special characters when inserting them in Insert state."
@@ -257,7 +254,7 @@ In insert mode, this key also functions as Meta."
(let ((i ?\ ))
(while (<= i ?~)
- (define-key viper-insert-diehard-map (make-string 1 i) 'self-insert-command)
+ (define-key viper-insert-diehard-map (string i) #'self-insert-command)
(setq i (1+ i))))
;; Insert mode map when user wants emacs style
@@ -490,7 +487,7 @@ Useful in some modes, such as Gnus, MH, etc.")
The effect is seen in the current buffer only.
Useful for customizing mailer buffers, gnus, etc.
STATE is `vi-state', `insert-state', or `emacs-state'.
-ALIST is of the form ((key . func) (key . func) ...)
+ALIST is of the form ((KEY . FUNC) (KEY . FUNC) ...)
Normally, this would be called from a hook to a major mode or
on a per buffer basis.
Usage:
@@ -548,14 +545,11 @@ The above needs not to be done for major modes that come up in Vi or Insert
state by default.
Arguments: (major-mode viper-state keymap)"
- (let ((alist
- (cond ((eq state 'vi-state) 'viper-vi-state-modifier-alist)
- ((eq state 'insert-state) 'viper-insert-state-modifier-alist)
- ((eq state 'emacs-state) 'viper-emacs-state-modifier-alist)))
- elt)
- (if (setq elt (assoc mode (eval alist)))
- (set alist (delq elt (eval alist))))
- (set alist (cons (cons mode keymap) (eval alist)))
+ (let* ((alist
+ (cond ((eq state 'vi-state) 'viper-vi-state-modifier-alist)
+ ((eq state 'insert-state) 'viper-insert-state-modifier-alist)
+ ((eq state 'emacs-state) 'viper-emacs-state-modifier-alist))))
+ (setf (alist-get mode (symbol-value alist)) keymap)
;; Normalization usually doesn't help here, since one needs to
;; normalize in the actual buffer where changes to the keymap are
@@ -646,9 +640,9 @@ Arguments: (major-mode viper-state keymap)"
(cdr mapsrc)))
(defun viper-modify-keymap (map alist)
- "Modifies MAP with bindings specified in the ALIST. The alist has the
-form ((key . function) (key . function) ... )."
- (mapcar (lambda (p) (define-key map (eval (car p)) (cdr p)))
+ "Modifies MAP with bindings specified in the ALIST.
+The ALIST has the form ((KEY . FUNCTION) (KEY . FUNCTION) ... )."
+ (mapcar (lambda (p) (define-key map (eval (car p) t) (cdr p)))
alist))
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index 039ddabcdc3..94ab8178925 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -24,8 +24,6 @@
;;; Code:
-(provide 'viper-macs)
-
;; compiler pacifier
(defvar viper-ex-work-buf)
(defvar viper-custom-file-name)
@@ -37,7 +35,7 @@
(require 'viper-util)
(require 'viper-keym)
-
+(require 'seq)
;;; Variables
@@ -102,9 +100,11 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
;; if defining macro for insert, switch there for authentic WYSIWYG
(if ins (viper-change-state-to-insert))
(start-kbd-macro nil)
- (define-key viper-vi-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
- (define-key viper-insert-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
- (define-key viper-emacs-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
+ (define-key viper-vi-intercept-map "\C-x)" #'viper-end-mapping-kbd-macro)
+ (define-key viper-insert-intercept-map "\C-x)"
+ #'viper-end-mapping-kbd-macro)
+ (define-key viper-emacs-intercept-map "\C-x)"
+ #'viper-end-mapping-kbd-macro)
(message "Mapping %S in %s state. Type macro definition followed by `C-x )'"
(viper-display-macro macro-name)
(if ins "Insert" "Vi")))
@@ -442,7 +442,7 @@ If SCOPE is nil, the user is asked to specify the scope."
(list nil (list (cons scope nil)) (cons t nil)))
((stringp scope)
(list (list (cons scope nil)) nil (cons t nil))))))
- (setq old-elt (assoc macro-name (eval macro-alist-var)))
+ (setq old-elt (assoc macro-name (symbol-value macro-alist-var)))
(if (null old-elt)
(progn
@@ -450,8 +450,8 @@ If SCOPE is nil, the user is asked to specify the scope."
(define-key
keymap
(vector (viper-key-to-emacs-key (aref macro-name 0)))
- 'viper-exec-mapped-kbd-macro)
- (setq lis (eval macro-alist-var))
+ #'viper-exec-mapped-kbd-macro)
+ (setq lis (symbol-value macro-alist-var))
(while (and lis (string< (viper-array-to-string (car (car lis)))
(viper-array-to-string macro-name)))
(setq lis2 (cons (car lis) lis2))
@@ -514,7 +514,7 @@ mistakes in macro names to be passed to this function is to use
(if (viper-char-array-p macro-name)
(setq macro-name (viper-char-array-to-macro macro-name)))
- (setq macro-entry (assoc macro-name (eval macro-alist-var)))
+ (setq macro-entry (assoc macro-name (symbol-value macro-alist-var)))
(if (= (length macro-name) 0)
(error "Can't unmap an empty macro name"))
(if (null macro-entry)
@@ -557,9 +557,10 @@ mistakes in macro names to be passed to this function is to use
(cdr mode-mapping)
(cdr global-mapping)
(progn
- (set macro-alist-var (delq macro-entry (eval macro-alist-var)))
+ (set macro-alist-var (delq macro-entry
+ (symbol-value macro-alist-var)))
(if (viper-can-release-key (aref macro-name 0)
- (eval macro-alist-var))
+ (symbol-value macro-alist-var))
(define-key
keymap
(vector (viper-key-to-emacs-key (aref macro-name 0)))
@@ -649,11 +650,11 @@ mistakes in macro names to be passed to this function is to use
(interactive)
(with-output-to-temp-buffer " *viper-info*"
(princ "Macros in Vi state:\n===================\n")
- (mapc 'viper-describe-one-macro viper-vi-kbd-macro-alist)
+ (mapc #'viper-describe-one-macro viper-vi-kbd-macro-alist)
(princ "\n\nMacros in Insert and Replace states:\n====================================\n")
- (mapc 'viper-describe-one-macro viper-insert-kbd-macro-alist)
+ (mapc #'viper-describe-one-macro viper-insert-kbd-macro-alist)
(princ "\n\nMacros in Emacs state:\n======================\n")
- (mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist)
+ (mapc #'viper-describe-one-macro viper-emacs-kbd-macro-alist)
))
(defun viper-describe-one-macro (macro)
@@ -661,11 +662,11 @@ mistakes in macro names to be passed to this function is to use
(viper-display-macro (car macro))))
(princ " ** Buffer-specific:")
(if (viper-kbd-buf-alist macro)
- (mapc 'viper-describe-one-macro-elt (viper-kbd-buf-alist macro))
+ (mapc #'viper-describe-one-macro-elt (viper-kbd-buf-alist macro))
(princ " none\n"))
(princ "\n ** Mode-specific:")
(if (viper-kbd-mode-alist macro)
- (mapc 'viper-describe-one-macro-elt (viper-kbd-mode-alist macro))
+ (mapc #'viper-describe-one-macro-elt (viper-kbd-mode-alist macro))
(princ " none\n"))
(princ "\n ** Global:")
(if (viper-kbd-global-definition macro)
@@ -683,10 +684,9 @@ mistakes in macro names to be passed to this function is to use
;; check if SEQ is a prefix of some car of an element in ALIST
(defun viper-keyseq-is-a-possible-macro (seq alist)
(let ((converted-seq (viper-events-to-macro seq)))
- (eval (cons 'or
- (mapcar
- (lambda (elt) (viper-prefix-subseq-p converted-seq elt))
- (viper-this-buffer-macros alist))))))
+ (seq-some
+ (lambda (elt) (viper-prefix-subseq-p converted-seq elt))
+ (viper-this-buffer-macros alist))))
;; whether SEQ1 is a prefix of SEQ2
(defun viper-prefix-subseq-p (seq1 seq2)
@@ -704,11 +704,10 @@ mistakes in macro names to be passed to this function is to use
len)
(if (= (length seqs) 0)
(setq len 0)
- (setq len (apply 'min (mapcar 'length seqs))))
+ (setq len (apply #'min (mapcar #'length seqs))))
(while (< idx len)
- (if (eval (cons 'and
- (mapcar (lambda (s) (equal (elt first idx) (elt s idx)))
- rest)))
+ (if (seq-every-p (lambda (s) (equal (elt first idx) (elt s idx)))
+ rest)
(setq pref (vconcat pref (vector (elt first idx)))))
(setq idx (1+ idx)))
pref))
@@ -720,7 +719,7 @@ mistakes in macro names to be passed to this function is to use
(defun viper-do-sequence-completion (seq alist compl-message)
(let* ((matches (viper-extract-matching-alist-members seq alist))
- (new-seq (apply 'viper-common-seq-prefix matches))
+ (new-seq (apply #'viper-common-seq-prefix matches))
)
(cond ((and (equal seq new-seq) (= (length matches) 1))
(message "%s (Sole completion)" compl-message)
@@ -741,8 +740,8 @@ mistakes in macro names to be passed to this function is to use
(defun viper-display-vector-completions (list)
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
- (mapcar 'prin1-to-string
- (mapcar 'viper-display-macro list)))))
+ (mapcar #'prin1-to-string
+ (mapcar #'viper-display-macro list)))))
@@ -793,9 +792,9 @@ mistakes in macro names to be passed to this function is to use
;; string--do so. Otherwise, do nothing.
(defun viper-display-macro (macro-name-or-body)
(cond ((viper-char-symbol-sequence-p macro-name-or-body)
- (mapconcat 'symbol-name macro-name-or-body ""))
+ (mapconcat #'symbol-name macro-name-or-body ""))
((viper-char-array-p macro-name-or-body)
- (mapconcat 'char-to-string macro-name-or-body ""))
+ (mapconcat #'char-to-string macro-name-or-body ""))
(t macro-name-or-body)))
;; convert sequence of events (that came presumably from emacs kbd macro) into
@@ -815,7 +814,7 @@ mistakes in macro names to be passed to this function is to use
;; convert strings or arrays of characters to Viper macro form
(defun viper-char-array-to-macro (array)
- (vconcat (mapcar 'viper-event-key (vconcat array))))
+ (vconcat (mapcar #'viper-event-key (vconcat array))))
;; For macros bodies and names, goes over MACRO and checks if all members are
;; names of keys (actually, it only checks if they are symbols or lists
@@ -850,7 +849,7 @@ mistakes in macro names to be passed to this function is to use
macro)))
(defun viper-macro-to-events (macro-body)
- (vconcat (mapcar 'viper-key-to-emacs-key macro-body)))
+ (vconcat (mapcar #'viper-key-to-emacs-key macro-body)))
@@ -929,5 +928,5 @@ mistakes in macro names to be passed to this function is to use
(beginning-of-line)
(call-last-kbd-macro)))
-
+(provide 'viper-macs)
;;; viper-macs.el ends here
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 71e40ee023e..83fc5afafa5 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -1,4 +1,4 @@
-;;; viper-mous.el --- mouse support for Viper
+;;; viper-mous.el --- mouse support for Viper -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1997, 2001-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;; Code:
-(provide 'viper-mous)
-
;; compiler pacifier
(defvar double-click-time)
(defvar mouse-track-multi-click-time)
@@ -60,8 +58,7 @@
Takes two parameters: a COUNT, indicating how many words to return,
and CLICK-COUNT, telling whether this is the first click, a double-click,
or a triple-click."
- :type 'symbol
- :group 'viper-mouse)
+ :type 'symbol)
;; time interval in millisecond within which successive clicks are
;; considered related
@@ -70,8 +67,7 @@ or a triple-click."
500)
"Time interval in millisecond within which successive mouse clicks are
considered related."
- :type 'integer
- :group 'viper-mouse)
+ :type 'integer)
;; Local variable used to toggle wraparound search on click.
(defvar-local viper-mouse-click-search-noerror t)
@@ -292,7 +288,7 @@ See `viper-surrounding-word' for the definition of a word in this case."
(prin1-to-string (viper-event-key event)))))
(define-obsolete-function-alias 'viper-event-click-count
- 'event-click-count "28.1")
+ #'event-click-count "28.1")
(declare-function viper-forward-word "viper-cmd" (arg))
(declare-function viper-adjust-window "viper-cmd" ())
@@ -407,7 +403,7 @@ this command.
(setq arg (1- arg)))
))))
-(defun viper-mouse-catch-frame-switch (event arg)
+(defun viper-mouse-catch-frame-switch (_event arg)
"Catch the event of switching frame.
Usually is bound to a `down-mouse' event to work properly. See sample
bindings in the Viper manual."
@@ -436,8 +432,9 @@ bindings in the Viper manual."
;; until you do something other than viper-mouse-click-* command.
;; In XEmacs, you have to manually select frame B (with the mouse click) in
;; order to shift focus to frame B.
-(defsubst viper-remember-current-frame (frame)
- (setq last-command 'handle-switch-frame
+(defun viper-remember-current-frame (&rest _)
+ "Remember the selected frame before the switch-frame event."
+ (setq last-command #'handle-switch-frame
viper-current-frame-saved (selected-frame)))
@@ -446,8 +443,8 @@ bindings in the Viper manual."
;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
;; returns button-down key.
(defun viper-parse-mouse-key (key-var event-type)
- (let ((key (eval key-var))
- button-spec meta-spec shift-spec control-spec key-spec)
+ (let ((key (symbol-value key-var))
+ button-spec meta-spec shift-spec control-spec)
(if (null key)
;; just return nil
()
@@ -470,10 +467,9 @@ bindings in the Viper manual."
control-spec
(if (memq 'control key) "C-" ""))
- (setq key-spec
- (vector
- (intern (concat control-spec meta-spec
- shift-spec button-spec)))))))
+ (vector
+ (intern (concat control-spec meta-spec
+ shift-spec button-spec))))))
(defun viper-unbind-mouse-search-key ()
(if viper-mouse-up-search-key-parsed
@@ -497,8 +493,8 @@ bindings in the Viper manual."
(viper-parse-mouse-key 'viper-mouse-search-key 'up)
viper-mouse-down-search-key-parsed
(viper-parse-mouse-key 'viper-mouse-search-key 'down))
- (cond ((or (null viper-mouse-up-search-key-parsed)
- (null viper-mouse-down-search-key-parsed))
+ (cond ((not (and viper-mouse-up-search-key-parsed
+ viper-mouse-down-search-key-parsed))
nil) ; just quit
((and (null force)
(key-binding viper-mouse-up-search-key-parsed)
@@ -516,9 +512,9 @@ bindings in the Viper manual."
viper-mouse-down-search-key-parsed))
(t
(global-set-key viper-mouse-up-search-key-parsed
- 'viper-mouse-click-search-word)
+ #'viper-mouse-click-search-word)
(global-set-key viper-mouse-down-search-key-parsed
- 'viper-mouse-catch-frame-switch))))
+ #'viper-mouse-catch-frame-switch))))
;; If FORCE, bind even if this mouse action is already bound to something else
(defun viper-bind-mouse-insert-key (&optional force)
@@ -526,8 +522,8 @@ bindings in the Viper manual."
(viper-parse-mouse-key 'viper-mouse-insert-key 'up)
viper-mouse-down-insert-key-parsed
(viper-parse-mouse-key 'viper-mouse-insert-key 'down))
- (cond ((or (null viper-mouse-up-insert-key-parsed)
- (null viper-mouse-down-insert-key-parsed))
+ (cond ((not (and viper-mouse-up-insert-key-parsed
+ viper-mouse-down-insert-key-parsed))
nil) ; just quit
((and (null force)
(key-binding viper-mouse-up-insert-key-parsed)
@@ -545,9 +541,9 @@ bindings in the Viper manual."
viper-mouse-down-insert-key-parsed))
(t
(global-set-key viper-mouse-up-insert-key-parsed
- 'viper-mouse-click-insert-word)
+ #'viper-mouse-click-insert-word)
(global-set-key viper-mouse-down-insert-key-parsed
- 'viper-mouse-catch-frame-switch))))
+ #'viper-mouse-catch-frame-switch))))
(defun viper-reset-mouse-search-key (symb val)
(viper-unbind-mouse-search-key)
@@ -573,8 +569,7 @@ This buffer may be different from the one where the click occurred."
(const :format "%v " shift)
(const control))
(integer :tag "Button"))
- :set 'viper-reset-mouse-search-key
- :group 'viper-mouse)
+ :set #'viper-reset-mouse-search-key)
(defcustom viper-mouse-insert-key '(meta shift 2)
"Key used to click-insert in Viper.
@@ -589,7 +584,7 @@ This buffer may be different from the one where the click occurred."
(const :format "%v " shift)
(const control))
(integer :tag "Button"))
- :set 'viper-reset-mouse-insert-key
- :group 'viper-mouse)
+ :set #'viper-reset-mouse-insert-key)
+(provide 'viper-mous)
;;; viper-mous.el ends here
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 1bdb155538a..51f7406ad26 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -24,8 +24,7 @@
;;; Code:
-(provide 'viper-util)
-
+(require 'seq)
;; Compiler pacifier
(defvar viper-minibuffer-current-face)
@@ -47,22 +46,22 @@
-(define-obsolete-function-alias 'viper-overlay-p 'overlayp "27.1")
-(define-obsolete-function-alias 'viper-make-overlay 'make-overlay "27.1")
-(define-obsolete-function-alias 'viper-overlay-live-p 'overlayp "27.1")
-(define-obsolete-function-alias 'viper-move-overlay 'move-overlay "27.1")
-(define-obsolete-function-alias 'viper-overlay-start 'overlay-start "27.1")
-(define-obsolete-function-alias 'viper-overlay-end 'overlay-end "27.1")
-(define-obsolete-function-alias 'viper-overlay-get 'overlay-get "27.1")
-(define-obsolete-function-alias 'viper-overlay-put 'overlay-put "27.1")
-(define-obsolete-function-alias 'viper-read-event 'read-event "27.1")
-(define-obsolete-function-alias 'viper-characterp 'integerp "27.1")
-(define-obsolete-function-alias 'viper-int-to-char 'identity "27.1")
-(define-obsolete-function-alias 'viper-get-face 'facep "27.1")
+(define-obsolete-function-alias 'viper-overlay-p #'overlayp "27.1")
+(define-obsolete-function-alias 'viper-make-overlay #'make-overlay "27.1")
+(define-obsolete-function-alias 'viper-overlay-live-p #'overlayp "27.1")
+(define-obsolete-function-alias 'viper-move-overlay #'move-overlay "27.1")
+(define-obsolete-function-alias 'viper-overlay-start #'overlay-start "27.1")
+(define-obsolete-function-alias 'viper-overlay-end #'overlay-end "27.1")
+(define-obsolete-function-alias 'viper-overlay-get #'overlay-get "27.1")
+(define-obsolete-function-alias 'viper-overlay-put #'overlay-put "27.1")
+(define-obsolete-function-alias 'viper-read-event #'read-event "27.1")
+(define-obsolete-function-alias 'viper-characterp #'integerp "27.1")
+(define-obsolete-function-alias 'viper-int-to-char #'identity "27.1")
+(define-obsolete-function-alias 'viper-get-face #'facep "27.1")
(define-obsolete-function-alias 'viper-color-defined-p
- 'x-color-defined-p "27.1")
+ #'x-color-defined-p "27.1")
(define-obsolete-function-alias 'viper-iconify
- 'iconify-or-deiconify-frame "27.1")
+ #'iconify-or-deiconify-frame "27.1")
;; CHAR is supposed to be a char or an integer (positive or negative)
@@ -269,10 +268,10 @@ Otherwise return the normal value."
;; Then, each time this var is used in `viper-move-marker-locally' in a new
;; buffer, a new marker will be created.
(defun viper-move-marker-locally (var pos &optional buffer)
- (if (markerp (eval var))
+ (if (markerp (symbol-value var))
()
(set var (make-marker)))
- (move-marker (eval var) pos buffer))
+ (move-marker (symbol-value var) pos buffer))
;; Print CONDITIONS as a message.
@@ -280,7 +279,7 @@ Otherwise return the normal value."
(let ((case (car conditions)) (msg (cdr conditions)))
(if (null msg)
(message "%s" case)
- (message "%s: %s" case (mapconcat 'prin1-to-string msg " ")))
+ (message "%s: %s" case (mapconcat #'prin1-to-string msg " ")))
(beep 1)))
@@ -453,7 +452,7 @@ Otherwise return the normal value."
"$"))
tmp2))
(setq tmp (cdr tmp)))
- (reverse (apply 'append tmp2)))))
+ (reverse (apply #'append tmp2)))))
;;; Insertion ring
@@ -488,11 +487,11 @@ Otherwise return the normal value."
;; Push item onto ring. The second argument is a ring-variable, not value.
(defun viper-push-onto-ring (item ring-var)
- (or (ring-p (eval ring-var))
- (set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
+ (or (ring-p (symbol-value ring-var))
+ (set ring-var (make-ring (symbol-value (intern (format "%S-size" ring-var))))))
(or (null item) ; don't push nil
(and (stringp item) (string= item "")) ; or empty strings
- (equal item (viper-current-ring-item (eval ring-var))) ; or old stuff
+ (equal item (viper-current-ring-item (symbol-value ring-var))) ; or old stuff
;; Since viper-set-destructive-command checks if we are inside
;; viper-repeat, we don't check whether this-command-keys is a `.'. The
;; cmd viper-repeat makes a call to the current function only if `.' is
@@ -505,7 +504,7 @@ Otherwise return the normal value."
(and (eq ring-var 'viper-command-ring)
(string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
(viper-array-to-string (this-command-keys))))
- (viper-ring-insert (eval ring-var) item))
+ (viper-ring-insert (symbol-value ring-var) item))
)
@@ -595,7 +594,7 @@ Otherwise return the normal value."
;; Arguments: var message file &optional erase-message
(defun viper-save-setting (var message file &optional erase-msg)
(let* ((var-name (symbol-name var))
- (var-val (if (boundp var) (eval var)))
+ (var-val (if (boundp var) (symbol-value var)))
(regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z0-9---_']*[ \t\n)]" var-name))
(buf (find-file-noselect (substitute-in-file-name file)))
)
@@ -795,7 +794,7 @@ Otherwise return the normal value."
;;; XEmacs compatibility
(define-obsolete-function-alias 'viper-abbreviate-file-name
- 'abbreviate-file-name "27.1")
+ #'abbreviate-file-name "27.1")
(defsubst viper-sit-for-short (val &optional nodisp)
(declare (obsolete nil "28.1"))
@@ -815,7 +814,7 @@ Otherwise return the normal value."
(with-current-buffer buf
(and (<= pos (point-max)) (<= (point-min) pos))))))
-(define-obsolete-function-alias 'viper-mark-marker 'mark-marker "27.1")
+(define-obsolete-function-alias 'viper-mark-marker #'mark-marker "27.1")
(defvar viper-saved-mark nil
"Where viper saves mark. This mark is resurrected by m^.")
@@ -831,9 +830,9 @@ Otherwise return the normal value."
;; highlighted due to Viper's pushing marks. So, we deactivate marks,
;; unless the user explicitly wants highlighting, e.g., by hitting ''
;; or ``
-(define-obsolete-function-alias 'viper-deactivate-mark 'deactivate-mark "27.1")
+(define-obsolete-function-alias 'viper-deactivate-mark #'deactivate-mark "27.1")
-(define-obsolete-function-alias 'viper-leave-region-active 'ignore "27.1")
+(define-obsolete-function-alias 'viper-leave-region-active #'ignore "27.1")
;; Check if arg is a valid character for register
;; TYPE is a list that can contain `letter', `Letter', and `digit'.
@@ -852,7 +851,7 @@ Otherwise return the normal value."
-(define-obsolete-function-alias 'viper-copy-event 'identity "27.1")
+(define-obsolete-function-alias 'viper-copy-event #'identity "27.1")
;; Uses different timeouts for ESC-sequences and others
(defun viper-fast-keysequence-p ()
@@ -862,7 +861,7 @@ Otherwise return the normal value."
t)))
(define-obsolete-function-alias 'viper-read-event-convert-to-char
- 'read-event "27.1")
+ #'read-event "27.1")
;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
@@ -941,20 +940,20 @@ Otherwise return the normal value."
(car (read-from-string
(concat
"?\\"
- (mapconcat 'identity mod-char-list "-\\")
+ (mapconcat #'identity mod-char-list "-\\")
"-"
base-key-name))))
(setq key-name
(intern
(concat
- (mapconcat 'identity mod-char-list "-")
+ (mapconcat #'identity mod-char-list "-")
"-"
base-key-name))))))
))
;; LIS is assumed to be a list of events of characters
-(define-obsolete-function-alias 'viper-eventify-list-xemacs 'ignore "27.1")
+(define-obsolete-function-alias 'viper-eventify-list-xemacs #'ignore "27.1")
;; Arg is a character, an event, a list of events or a sequence of
@@ -985,22 +984,20 @@ Otherwise return the normal value."
;; XEmacs only
(defun viper-event-vector-p (vec)
(and (vectorp vec)
- (eval (cons 'and (mapcar (lambda (elt) (if (eventp elt) t)) vec)))))
+ (seq-every-p (lambda (elt) (if (eventp elt) t)) vec)))
;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
(and
(sequencep vec)
- (eval
- (cons 'and
- (mapcar (lambda (elt)
- (and (symbolp elt) (= (length (symbol-name elt)) 1)))
- vec)))))
+ (seq-every-p (lambda (elt)
+ (and (symbolp elt) (= (length (symbol-name elt)) 1)))
+ vec)))
(defun viper-char-array-p (array)
- (eval (cons 'and (mapcar 'characterp array))))
+ (seq-every-p #'characterp array))
;; Args can be a sequence of events, a string, or a Viper macro. Will try to
@@ -1012,19 +1009,19 @@ Otherwise return the normal value."
(let (temp temp2)
(cond ((stringp event-seq) event-seq)
((viper-event-vector-p event-seq)
- (setq temp (mapcar 'viper-event-key event-seq))
+ (setq temp (mapcar #'viper-event-key event-seq))
(cond ((viper-char-symbol-sequence-p temp)
- (mapconcat 'symbol-name temp ""))
+ (mapconcat #'symbol-name temp ""))
((and (viper-char-array-p
- (setq temp2 (mapcar 'viper-key-to-character temp))))
- (mapconcat 'char-to-string temp2 ""))
+ (setq temp2 (mapcar #'viper-key-to-character temp))))
+ (mapconcat #'char-to-string temp2 ""))
(t (prin1-to-string (vconcat temp)))))
((viper-char-symbol-sequence-p event-seq)
- (mapconcat 'symbol-name event-seq ""))
+ (mapconcat #'symbol-name event-seq ""))
((and (vectorp event-seq)
(viper-char-array-p
- (setq temp (mapcar 'viper-key-to-character event-seq))))
- (mapconcat 'char-to-string temp ""))
+ (setq temp (mapcar #'viper-key-to-character event-seq))))
+ (mapconcat #'char-to-string temp ""))
(t (prin1-to-string event-seq)))))
(defun viper-key-press-events-to-chars (events)
@@ -1172,7 +1169,7 @@ syntax tables.
This option is appropriate if you like Emacs-style words."
:type '(radio (const strict-vi) (const reformed-vi)
(const extended) (const emacs))
- :set 'viper-set-syntax-preference
+ :set #'viper-set-syntax-preference
:group 'viper)
(make-variable-buffer-local 'viper-syntax-preference)
@@ -1375,4 +1372,5 @@ This option is appropriate if you like Emacs-style words."
(setq i (1+ i) start (1+ start)))
res))))))
+(provide 'viper-util)
;;; viper-util.el ends here
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index df5a083a08a..cce51174336 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -1061,9 +1061,7 @@ This may be needed if the previous `:map' command terminated abnormally."
(if (viper-window-display-p)
(viper--advice-add
'handle-switch-frame :before
- (lambda (&rest _)
- "Remember the selected frame before the switch-frame event."
- (viper-remember-current-frame (selected-frame)))))
+ #'viper-remember-current-frame))
) ; end viper-non-hook-settings
@@ -1191,7 +1189,7 @@ These two lines must come in the order given."))
;; The default viper-toggle-key is \C-z; for the novice, it suspends or
;; iconifies Emacs
-(define-key viper-vi-intercept-map viper-toggle-key 'viper-toggle-key-action)
+(define-key viper-vi-intercept-map viper-toggle-key #'viper-toggle-key-action)
(define-key
viper-emacs-intercept-map viper-toggle-key #'viper-change-state-to-vi)
diff --git a/lisp/env.el b/lisp/env.el
index 51247f1ff84..83f43d1006b 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -44,7 +44,7 @@ If it is also not t, RET does not exit if it does non-null completion."
(completing-read prompt
(mapcar (lambda (enventry)
(let ((str (substring enventry 0
- (string-match "=" enventry))))
+ (string-search "=" enventry))))
(if (multibyte-string-p str)
(decode-coding-string
str locale-coding-system t)
@@ -184,7 +184,7 @@ a side-effect."
(setq variable (encode-coding-string variable locale-coding-system)))
(if (and value (multibyte-string-p value))
(setq value (encode-coding-string value locale-coding-system)))
- (if (string-match-p "=" variable)
+ (if (string-search "=" variable)
(error "Environment variable name `%s' contains `='" variable))
(if (string-equal "TZ" variable)
(set-time-zone-rule value))
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index e46e3684c8a..33bf5adabe6 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -198,7 +198,9 @@ encryption is used."
(mapcar #'car (epg-context-result-for
context 'encrypted-to)))
(if (or beg end)
- (setq string (substring string (or beg 0) end)))
+ (setq string (substring string
+ (or beg 0)
+ (and end (min end (length string))))))
(save-excursion
;; If visiting, bind off buffer-file-name so that
;; file-locking will not ask whether we should
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
new file mode 100644
index 00000000000..ebdb1274218
--- /dev/null
+++ b/lisp/epa-ks.el
@@ -0,0 +1,345 @@
+;;; epa-ks.el --- EasyPG Key Server Client -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Philip K. <philipk@posteo.net>
+;; Keywords: PGP, 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Keyserver client in Emacs.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'epa)
+(require 'subr-x)
+(require 'tabulated-list)
+(require 'url)
+(require 'url-http)
+
+(defgroup epa-ks nil
+ "The EasyPG Assistant Keyserver client."
+ :version "28.1"
+ :group 'epa)
+
+(defcustom epa-keyserver "pgp.mit.edu"
+ "Domain of keyserver.
+
+This is used by `epa-ks-lookup-key', for looking up public keys."
+ :type '(choice :tag "Keyserver"
+ (repeat :tag "Random pool"
+ (string :tag "Keyserver address"))
+ (const "keyring.debian.org")
+ (const "keys.gnupg.net")
+ (const "keyserver.ubuntu.com")
+ (const "pgp.mit.edu")
+ (const "pool.sks-keyservers.net")
+ (const "zimmermann.mayfirst.org")
+ (string :tag "Custom keyserver"))
+ :version "28.1")
+
+(cl-defstruct epa-ks-key
+ "Structure to hold key data."
+ id algo len created expires names flags)
+
+(cl-defstruct epa-ks-name
+ "Structure to hold user associated with keys data."
+ uid created expires flags)
+
+(defvar epa-ks-last-query nil
+ "List of arguments to pass to `epa-search-keys'.
+This is used when reverting a buffer to restart search.")
+
+(defvar epa-ks-search-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map (kbd "f") #'epa-ks-mark-key-to-fetch)
+ (define-key map (kbd "i") #'epa-ks-inspect-key-to-fetch)
+ (define-key map (kbd "u") #'epa-ks-unmark-key-to-fetch)
+ (define-key map (kbd "x") #'epa-ks-do-key-to-fetch)
+ map))
+
+(define-derived-mode epa-ks-search-mode tabulated-list-mode "Keyserver"
+ "Major mode for listing public key search results."
+ (buffer-disable-undo)
+ (setq tabulated-list-format [("ID" 8 t)
+ ("Algo." 5 nil)
+ ("Created" 10 t)
+ ("Expires" 10 t)
+ ("User" 0 t)]
+ tabulated-list-sort-key '("User" . nil)
+ tabulated-list-padding 2)
+ (add-hook 'tabulated-list-revert-hook
+ #'epa-ks--restart-search
+ nil t)
+ (tabulated-list-init-header))
+
+(defun epa-ks-inspect-key-to-fetch ()
+ "Display full ID of key under point in the minibuffer."
+ (interactive)
+ (message "Full ID: %s" (epa-ks-key-id (car (tabulated-list-get-id)))))
+
+(defun epa-ks-unmark-key-to-fetch ()
+ "Remove fetch mark for key under point.
+
+If a region is active, unmark all keys in active region."
+ (interactive)
+ (epa-ks-mark-key-to-fetch ""))
+
+(defun epa-ks-mark-key-to-fetch (tag)
+ "Add fetch-mark to key under point.
+
+If a region is active, mark all keys in active region.
+
+When all keys have been selected, use \\[epa-ks-do-key-to-fetch] to
+actually import the keys.
+
+When called interactively, `epa-ks-mark-key-to-fetch' will always
+add a \"F\" tag. Non-interactivly the tag must be specified by
+setting the TAG parameter."
+ (interactive (list "F"))
+ (if (region-active-p)
+ (save-mark-and-excursion
+ (save-restriction
+ (narrow-to-region (region-beginning) (1- (region-end)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (tabulated-list-put-tag tag t))))
+ (tabulated-list-put-tag tag t)))
+
+(defun epa-ks-do-key-to-fetch ()
+ "Fetch all marked keys from keyserver and import them.
+
+Keys are marked using `epa-ks-mark-key-to-fetch'."
+ (interactive)
+ (save-excursion
+ (let (keys)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (looking-at-p (rx bol "F"))
+ (push (epa-ks-key-id (car (tabulated-list-get-id)))
+ keys))
+ (forward-line))
+ (when (yes-or-no-p (format "Proceed with fetching all %d key(s)? "
+ (length keys))))
+ (dolist (id keys)
+ (epa-ks--fetch-key id))))
+ (tabulated-list-clear-all-tags))
+
+(defun epa-ks--query-url (query exact)
+ "Return URL for QUERY.
+If EXACT is non-nil, don't accept approximate matches."
+ (format "https://%s/pks/lookup?%s"
+ (cond ((null epa-keyserver)
+ (user-error "Empty keyserver pool"))
+ ((listp epa-keyserver)
+ (nth (random (length epa-keyserver))
+ epa-keyserver))
+ ((stringp epa-keyserver)
+ epa-keyserver)
+ ((error "Invalid type for `epa-keyserver'")))
+ (url-build-query-string
+ (append `(("search" ,query)
+ ("options" "mr")
+ ("op" "index"))
+ (and exact '(("exact" "on")))))))
+
+(defun epa-ks--fetch-key (id)
+ "Send request to import key with specified ID."
+ (url-retrieve
+ (epa-ks--query-url (concat "0x" (url-hexify-string id)) t)
+ (lambda (status)
+ (when (plist-get status :error)
+ (error "Request failed: %s"
+ (caddr (assq (caddr (plist-get status :error))
+ url-http-codes))))
+ (forward-paragraph)
+ (save-excursion
+ (goto-char (point-max))
+ (while (memq (char-before) '(?\s ?\t ?\n))
+ (forward-char -1))
+ (delete-region (point) (point-max)))
+ (let ((epa-popup-info-window nil))
+ (epa-import-armor-in-region (point) (point-max)))
+ (kill-buffer))))
+
+(defun epa-ks--display-keys (buf keys)
+ "Prepare KEYS for `tabulated-list-mode', for buffer BUF.
+
+KEYS is a list of `epa-ks-key' structures, as parsed by
+`epa-ks-parse-result'."
+ (when (buffer-live-p buf)
+ (let (entries)
+ (dolist (key keys)
+ (dolist (name (epa-ks-key-names key))
+ (push (list (cons key name)
+ (vector
+ (substring (epa-ks-key-id key) -8)
+ (cdr (epa-ks-key-algo key))
+ (if (epa-ks-key-created key)
+ (format-time-string "%F" (epa-ks-key-created key))
+ "N/A")
+ (if (epa-ks-key-expires key)
+ (let* ((date (epa-ks-key-expires key))
+ (str (format-time-string "%F" date)))
+ (when (< 0 (time-to-seconds (time-since date)))
+ (setq str (propertize str 'face
+ 'font-lock-warning-face)))
+ str)
+ (propertize "N/A" 'face 'shadow))
+ (decode-coding-string
+ (epa-ks-name-uid name)
+ (select-safe-coding-system (epa-ks-name-uid name)
+ nil 'utf-8))))
+ entries)))
+ (with-current-buffer buf
+ (setq tabulated-list-entries entries)
+ (tabulated-list-print t t))
+ (message "Press `f' to mark a key, `x' to fetch all marked keys."))))
+
+(defun epa-ks--restart-search ()
+ (when epa-ks-last-query
+ (apply #'epa-search-keys epa-ks-last-query)))
+
+;;;###autoload
+(defun epa-search-keys (query exact)
+ "Ask a keyserver for all keys matching QUERY.
+
+The keyserver to be used is specified by `epa-keyserver'.
+
+If EXACT is non-nil (interactively, prefix argument), require
+exact matches.
+
+Note that the request may fail if the query is not specific
+enough, since keyservers have strict timeout settings."
+ (interactive (list (read-string "Search for: ")
+ current-prefix-arg))
+ (when (string-empty-p query)
+ (user-error "No query"))
+ (let ((buf (get-buffer-create "*Key search*")))
+ (with-current-buffer buf
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (epa-ks-search-mode))
+ (url-retrieve
+ (epa-ks--query-url query exact)
+ (lambda (status)
+ (when (plist-get status :error)
+ (when buf
+ (kill-buffer buf))
+ (error "Request failed: %s"
+ (caddr (assq (caddr (plist-get status :error))
+ url-http-codes))))
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" t t))
+ (goto-char (point-min))
+ (re-search-forward "\n\n")
+ (let (keys)
+ (save-match-data
+ (setq keys (epa-ks--parse-buffer))
+ (kill-buffer (current-buffer)))
+ (when buf
+ (epa-ks--display-keys buf keys) keys))))
+ (pop-to-buffer buf)
+ (setq epa-ks-last-query (list query exact)))
+ (message "Searching keys..."))
+
+(defun epa-ks--parse-buffer ()
+ ;; parse machine readable response according to
+ ;; https://tools.ietf.org/html/draft-shaw-openpgp-hkp-00#section-5.2
+ (when (looking-at (rx bol "info:" (group (+ digit))
+ ":" (* digit) eol))
+ (unless (string= (match-string 1) "1")
+ (error "Unsupported keyserver version")))
+ (forward-line 1)
+ (let (key keys)
+ (while (and (not (eobp))
+ (not (looking-at "[ \t]*\n")))
+ (cond
+ ((looking-at (rx bol "pub:" (group (+ alnum))
+ ":" (group (* digit))
+ ":" (group (* digit))
+ ":" (group (* digit))
+ ":" (group (* digit))
+ ":" (group (* (any ?r ?d ?e)))
+ eol))
+ (setq key
+ (make-epa-ks-key
+ :id (match-string 1)
+ :algo
+ (and (match-string 2)
+ (not (string-empty-p (match-string 2)))
+ (assoc (string-to-number (match-string 2))
+ epg-pubkey-algorithm-alist))
+ :len
+ (and (match-string 3)
+ (not (string-empty-p (match-string 3)))
+ (string-to-number (match-string 3)))
+ :created
+ (and (match-string 4)
+ (not (string-empty-p (match-string 4)))
+ (seconds-to-time
+ (string-to-number (match-string 4))))
+ :expires
+ (and (match-string 5)
+ (not (string-empty-p (match-string 5)))
+ (seconds-to-time
+ (string-to-number (match-string 5))))
+ :flags
+ (mapcar (lambda (flag)
+ (cdr (assq flag '((?r revoked)
+ (?d disabled)
+ (?e expired)))))
+ (match-string 6))))
+ (push key keys))
+ ((looking-at (rx bol "uid:" (group (+ (not ":")))
+ ":" (group (* digit))
+ ":" (group (* digit))
+ ":" (group (* (any ?r ?d ?e)))
+ eol))
+ (push (make-epa-ks-name
+ :uid (url-unhex-string (match-string 1) t)
+ :created
+ (and (match-string 2)
+ (not (string-empty-p (match-string 2)))
+ (decode-time (seconds-to-time
+ (string-to-number
+ (match-string 2)))))
+ :expires
+ (and (match-string 3)
+ (not (string-empty-p (match-string 3)))
+ (decode-time (seconds-to-time
+ (string-to-number
+ (match-string 3)))))
+ :flags
+ (mapcar (lambda (flag)
+ (cdr (assq flag '((?r revoked)
+ (?d disabled)
+ (?e expired)))))
+ (match-string 4)))
+ (epa-ks-key-names key)))
+ ((looking-at-p (rx bol "uat:"))
+ ;; user attribute fields are ignored
+ nil)
+ (t (error "Invalid server response")))
+ (forward-line))
+ keys))
+
+;;; epa-ks.el ends here
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 7e100569b0f..b9dd437ed12 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -59,7 +59,7 @@ Otherwise, signal an error."
;;;###autoload
(define-minor-mode epa-mail-mode
"A minor-mode for composing encrypted/clearsigned mails."
- nil " epa-mail" epa-mail-mode-map)
+ :lighter " epa-mail")
;;; Utilities
@@ -108,8 +108,9 @@ use from your key ring."
(interactive
(save-excursion
(goto-char (point-min))
- (if (search-forward mail-header-separator nil t)
- (forward-line))
+ (rfc822-goto-eoh)
+ (unless (eobp)
+ (forward-line))
(setq epa-last-coding-system-specified
(or coding-system-for-write
(select-safe-coding-system (point) (point-max))))
@@ -135,9 +136,7 @@ If no one is selected, default secret key is used. "
(goto-char (point-min))
(save-restriction
(narrow-to-region (point)
- (if (search-forward mail-header-separator nil 0)
- (match-beginning 0)
- (point)))
+ (progn (rfc822-goto-eoh) (point)))
(setq recipients-string
(mapconcat #'identity
(nconc (mail-fetch-field "to" nil nil t)
@@ -170,7 +169,7 @@ If no one is selected, default secret key is used. "
(apply #'nconc
(mapcar
(lambda (recipient)
- (let ((tem (assoc recipient epa-mail-aliases)))
+ (let ((tem (assoc (downcase recipient) epa-mail-aliases)))
(if tem (copy-sequence (cdr tem))
(list recipient))))
real-recipients)))
@@ -220,7 +219,7 @@ If no one is selected, symmetric encryption will be performed. "
(epa-mail--find-usable-key
(epg-list-keys
(epg-make-context epa-protocol)
- (if (string-match "@" recipient)
+ (if (string-search "@" recipient)
(concat "<" recipient ">")
recipient))
'encrypt)))
@@ -236,8 +235,9 @@ If no one is selected, symmetric encryption will be performed. "
default-recipients)))))
(goto-char (point-min))
- (if (search-forward mail-header-separator nil t)
- (forward-line))
+ (rfc822-goto-eoh)
+ (unless (eobp)
+ (forward-line))
(setq start (point))
(setq epa-last-coding-system-specified
diff --git a/lisp/epa.el b/lisp/epa.el
index 572c947e4b2..2698b39ffe3 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -183,8 +183,7 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-last-coding-system-specified nil)
(defvar epa-key-list-mode-map
- (let ((keymap (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((keymap (make-sparse-keymap)))
(define-key keymap "\C-m" 'epa-show-key)
(define-key keymap [?\t] 'forward-button)
(define-key keymap [backtab] 'backward-button)
@@ -204,38 +203,32 @@ You should bind this variable with `let', but do not set it globally.")
(define-key keymap [?\S-\ ] 'scroll-down-command)
(define-key keymap [delete] 'scroll-down-command)
(define-key keymap "q" 'epa-exit-buffer)
- (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map))
- (define-key menu-map [epa-key-list-unmark-key]
- '(menu-item "Unmark Key" epa-unmark-key
- :help "Unmark a key"))
- (define-key menu-map [epa-key-list-mark-key]
- '(menu-item "Mark Key" epa-mark-key
- :help "Mark a key"))
- (define-key menu-map [separator-epa-file] '(menu-item "--"))
- (define-key menu-map [epa-verify-file]
- '(menu-item "Verify File..." epa-verify-file
- :help "Verify FILE"))
- (define-key menu-map [epa-sign-file]
- '(menu-item "Sign File..." epa-sign-file
- :help "Sign FILE by SIGNERS keys selected"))
- (define-key menu-map [epa-decrypt-file]
- '(menu-item "Decrypt File..." epa-decrypt-file
- :help "Decrypt FILE"))
- (define-key menu-map [epa-encrypt-file]
- '(menu-item "Encrypt File..." epa-encrypt-file
- :help "Encrypt FILE for RECIPIENTS"))
- (define-key menu-map [separator-epa-key-list] '(menu-item "--"))
- (define-key menu-map [epa-key-list-delete-keys]
- '(menu-item "Delete Keys" epa-delete-keys
- :help "Delete Marked Keys"))
- (define-key menu-map [epa-key-list-import-keys]
- '(menu-item "Import Keys" epa-import-keys
- :help "Import keys from a file"))
- (define-key menu-map [epa-key-list-export-keys]
- '(menu-item "Export Keys" epa-export-keys
- :help "Export marked keys to a file"))
keymap))
+(easy-menu-define epa-key-list-mode-menu epa-key-list-mode-map
+ "Menu for `epa-key-list-mode'."
+ '("Keys"
+ ["Export Keys" epa-export-keys
+ :help "Export marked keys to a file"]
+ ["Import Keys" epa-import-keys
+ :help "Import keys from a file"]
+ ["Delete Keys" epa-delete-keys
+ :help "Delete Marked Keys"]
+ "---"
+ ["Encrypt File..." epa-encrypt-file
+ :help "Encrypt file for recipients"]
+ ["Decrypt File..." epa-decrypt-file
+ :help "Decrypt file"]
+ ["Sign File..." epa-sign-file
+ :help "Sign file by signers keys selected"]
+ ["Verify File..." epa-verify-file
+ :help "Verify file"]
+ "---"
+ ["Mark Key" epa-mark-key
+ :help "Mark a key"]
+ ["Unmark Key" epa-unmark-key
+ :help "Unmark a key"]))
+
(defvar epa-key-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "q" 'epa-exit-buffer)
@@ -340,7 +333,10 @@ If ARG is non-nil, mark the key."
(insert
(propertize
(concat " " (epa--button-key-text key))
- 'epa-key key))
+ 'epa-key key
+ ;; Allow TAB to tab to the key.
+ 'button t
+ 'category t))
(insert "\n")))
(defun epa--list-keys (name secret &optional doc)
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 59d097c91f0..d32c8c897c7 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -1,4 +1,4 @@
-;;; epg-config.el --- configuration of the EasyPG Library
+;;; epg-config.el --- configuration of the EasyPG Library -*- lexical-binding: t -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -21,6 +21,8 @@
;; 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:
;;; Prelude
@@ -157,7 +159,7 @@ version requirement is met."
(setq program-alist epg-config--program-alist))
(let ((entry (assq protocol program-alist)))
(unless entry
- (error "Unknown protocol %S" protocol))
+ (error "Unknown protocol `%S'" protocol))
(cl-destructuring-bind (symbol . alist)
(cdr entry)
(let ((constructor
diff --git a/lisp/epg.el b/lisp/epg.el
index 36515ef4e5f..9d6295594fd 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -573,7 +573,7 @@ callback data (if any)."
"--status-fd" "1"
"--yes")
(if (and (not (eq (epg-context-protocol context) 'CMS))
- (string-match ":" (or agent-info "")))
+ (string-search ":" (or agent-info "")))
'("--use-agent"))
(if (and (not (eq (epg-context-protocol context) 'CMS))
(epg-context-progress-callback context))
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index a0085662e22..1a13aa95cd2 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -1,4 +1,4 @@
-;;; erc-autoaway.el --- Provides autoaway for ERC
+;;; erc-autoaway.el --- Provides autoaway for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
@@ -58,7 +58,7 @@ function each time you change `erc-autoaway-idle-seconds'."
(setq erc-autoaway-idletimer
(run-with-idle-timer erc-autoaway-idle-seconds
t
- 'erc-autoaway-set-away
+ #'erc-autoaway-set-away
erc-autoaway-idle-seconds)))
(defun erc-autoaway-some-server-buffer ()
@@ -66,21 +66,21 @@ function each time you change `erc-autoaway-idle-seconds'."
If none is found, return nil."
(car (erc-buffer-list #'erc-open-server-buffer-p)))
-(defun erc-autoaway-insinuate-maybe (&optional server &rest ignored)
+(defun erc-autoaway-insinuate-maybe (&optional server &rest _ignored)
"Add autoaway reset function to `post-command-hook' if at least one
ERC process is alive.
This is used when `erc-autoaway-idle-method' is `user'."
(when (or server (erc-autoaway-some-server-buffer))
- (add-hook 'post-command-hook 'erc-autoaway-reset-idle-user)))
+ (add-hook 'post-command-hook #'erc-autoaway-reset-idle-user)))
-(defun erc-autoaway-remove-maybe (&rest ignored)
+(defun erc-autoaway-remove-maybe (&rest _ignored)
"Remove the autoaway reset function from `post-command-hook' if
no ERC process is alive.
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)))
+ (remove-hook 'post-command-hook #'erc-autoaway-reset-idle-user)))
;;;###autoload(autoload 'erc-autoaway-mode "erc-autoaway")
(define-erc-module autoaway nil
@@ -107,36 +107,36 @@ set you no longer away.
Related variables: `erc-public-away-p' and `erc-away-nickname'."
;; Enable:
((when (boundp 'erc-autoaway-idle-method)
- (add-hook 'erc-connect-pre-hook 'erc-autoaway-reset-indicators)
+ (add-hook 'erc-connect-pre-hook #'erc-autoaway-reset-indicators)
(setq erc-autoaway-last-sent-time (erc-current-time))
(cond
((eq erc-autoaway-idle-method 'irc)
- (add-hook 'erc-send-completed-hook 'erc-autoaway-reset-idle-irc)
- (add-hook 'erc-server-001-functions 'erc-autoaway-reset-idle-irc))
+ (add-hook 'erc-send-completed-hook #'erc-autoaway-reset-idle-irc)
+ (add-hook 'erc-server-001-functions #'erc-autoaway-reset-idle-irc))
((eq erc-autoaway-idle-method 'user)
- (add-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe)
- (add-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe)
+ (add-hook 'erc-after-connect #'erc-autoaway-insinuate-maybe)
+ (add-hook 'erc-disconnected-hook #'erc-autoaway-remove-maybe)
(erc-autoaway-insinuate-maybe))
((eq erc-autoaway-idle-method 'emacs)
(erc-autoaway-reestablish-idletimer)))
- (add-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
- (add-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators)))
+ (add-hook 'erc-timer-hook #'erc-autoaway-possibly-set-away)
+ (add-hook 'erc-server-305-functions #'erc-autoaway-reset-indicators)))
;; Disable:
((when (boundp 'erc-autoaway-idle-method)
- (remove-hook 'erc-connect-pre-hook 'erc-autoaway-reset-indicators)
+ (remove-hook 'erc-connect-pre-hook #'erc-autoaway-reset-indicators)
(cond
((eq erc-autoaway-idle-method 'irc)
- (remove-hook 'erc-send-completed-hook 'erc-autoaway-reset-idle-irc)
- (remove-hook 'erc-server-001-functions 'erc-autoaway-reset-idle-irc))
+ (remove-hook 'erc-send-completed-hook #'erc-autoaway-reset-idle-irc)
+ (remove-hook 'erc-server-001-functions #'erc-autoaway-reset-idle-irc))
((eq erc-autoaway-idle-method 'user)
- (remove-hook 'post-command-hook 'erc-autoaway-reset-idle-user)
- (remove-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe)
- (remove-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe))
+ (remove-hook 'post-command-hook #'erc-autoaway-reset-idle-user)
+ (remove-hook 'erc-after-connect #'erc-autoaway-insinuate-maybe)
+ (remove-hook 'erc-disconnected-hook #'erc-autoaway-remove-maybe))
((eq erc-autoaway-idle-method 'emacs)
(cancel-timer erc-autoaway-idletimer)
(setq erc-autoaway-idletimer nil)))
- (remove-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
- (remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators))))
+ (remove-hook 'erc-timer-hook #'erc-autoaway-possibly-set-away)
+ (remove-hook 'erc-server-305-functions #'erc-autoaway-reset-indicators))))
(defcustom erc-autoaway-idle-method 'user
"The method used to determine how long you have been idle.
@@ -148,7 +148,6 @@ The time itself is specified by `erc-autoaway-idle-seconds'.
See `erc-autoaway-mode' for more information on the various
definitions of being idle."
- :group 'erc-autoaway
:type '(choice (const :tag "User idle time" user)
(const :tag "Emacs idle time" emacs)
(const :tag "Last IRC action" irc))
@@ -166,7 +165,6 @@ ERC autoaway mode can set you away when you idle, and set you no
longer away when you type something. This variable controls whether
you will be set away when you idle. See `erc-auto-discard-away' for
the other half."
- :group 'erc-autoaway
:type 'boolean)
(defcustom erc-auto-discard-away t
@@ -176,20 +174,17 @@ longer away when you type something. This variable controls whether
you will be set no longer away when you type something. See
`erc-auto-set-away' for the other half.
See also `erc-autoaway-no-auto-discard-regexp'."
- :group 'erc-autoaway
:type 'boolean)
(defcustom erc-autoaway-no-auto-discard-regexp "^/g?away.*$"
"Input that matches this will not automatically discard away status.
See `erc-auto-discard-away'."
- :group 'erc-autoaway
:type 'regexp)
(defcustom erc-autoaway-idle-seconds 1800
"Number of seconds after which ERC will set you automatically away.
If you are changing this variable using lisp instead of customizing it,
you have to run `erc-autoaway-reestablish-idletimer' afterwards."
- :group 'erc-autoaway
:set (lambda (sym val)
(set-default sym val)
(when (eq erc-autoaway-idle-method 'emacs)
@@ -201,10 +196,9 @@ you have to run `erc-autoaway-reestablish-idletimer' afterwards."
"Message ERC will use when setting you automatically away.
It is used as a `format' string with the argument of the idletime
in seconds."
- :group 'erc-autoaway
:type 'string)
-(defun erc-autoaway-reset-idle-user (&rest stuff)
+(defun erc-autoaway-reset-idle-user (&rest _stuff)
"Reset the stored user idle time.
This is one global variable since a user talking on one net can
talk on another net too."
@@ -212,7 +206,7 @@ talk on another net too."
(erc-autoaway-set-back #'erc-autoaway-remove-maybe))
(setq erc-autoaway-last-sent-time (erc-current-time)))
-(defun erc-autoaway-reset-idle-irc (line &rest stuff)
+(defun erc-autoaway-reset-idle-irc (line &rest _stuff)
"Reset the stored IRC idle time.
This is one global variable since a user talking on one net can
talk on another net too."
@@ -272,7 +266,7 @@ active server buffer available."
(setq erc-autoaway-caused-away t)
(erc-cmd-GAWAY (format-message erc-autoaway-message idle-time))))
-(defun erc-autoaway-reset-indicators (&rest stuff)
+(defun erc-autoaway-reset-indicators (&rest _stuff)
"Reset indicators used by the erc-autoaway module."
(setq erc-autoaway-last-sent-time (erc-current-time))
(setq erc-autoaway-caused-away nil))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4cabd42f532..6d84665873e 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -6,7 +6,7 @@
;; Author: Lawrence Mitchell <wence@gmx.li>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; Created: 2004-05-7
-;; Keywords: IRC chat client internet
+;; Keywords: comm, IRC, chat, client, internet
;; This file is part of GNU Emacs.
@@ -138,6 +138,13 @@ Use `erc-current-nick' to access this.")
(defvar-local erc-session-port nil
"The port used to connect to.")
+(defvar-local erc-session-client-certificate nil
+ "TLS client certificate used when connecting over TLS.
+If non-nil, should either be a list where the first element is
+the certificate key file name, and the second element is the
+certificate file name itself, or t, which means that
+`auth-source' will be queried for the key and the certificate.")
+
(defvar-local erc-server-announced-name nil
"The name the server announced to use.")
@@ -268,7 +275,6 @@ protection algorithm.")
"Non-nil means that ERC will attempt to reestablish broken connections.
Reconnection will happen automatically for any unexpected disconnection."
- :group 'erc-server
:type 'boolean)
(defcustom erc-server-reconnect-attempts 2
@@ -276,7 +282,6 @@ Reconnection will happen automatically for any unexpected disconnection."
broken connection, or t to always attempt to reconnect.
This only has an effect if `erc-server-auto-reconnect' is non-nil."
- :group 'erc-server
:type '(choice (const :tag "Always reconnect" t)
integer))
@@ -285,7 +290,6 @@ This only has an effect if `erc-server-auto-reconnect' is non-nil."
successive reconnect attempts.
If a key is pressed while ERC is waiting, it will stop waiting."
- :group 'erc-server
:type 'number)
(defcustom erc-split-line-length 440
@@ -299,14 +303,12 @@ And a typical message looks like this:
You can limit here the maximum length of the \"Hello!\" part.
Good luck."
- :type 'integer
- :group 'erc-server)
+ :type 'integer)
(defcustom erc-coding-system-precedence '(utf-8 undecided)
"List of coding systems to be preferred when receiving a string from the server.
This will only be consulted if the coding system in
`erc-server-coding-system' is `undecided'."
- :group 'erc-server
:version "24.1"
:type '(repeat coding-system))
@@ -331,7 +333,6 @@ If you need to send non-ASCII text to people not using a client that
does decoding on its own, you must tell ERC what encoding to use.
Emacs cannot guess it, since it does not know what the people on the
other end of the line are using."
- :group 'erc-server
:type '(choice (const :tag "None" nil)
coding-system
(cons (coding-system :tag "encoding" :value utf-8)
@@ -346,37 +347,32 @@ current target as returned by `erc-default-target'.
Example: If you know that the channel #linux-ru uses the coding-system
`cyrillic-koi8', then add (\"#linux-ru\" . cyrillic-koi8) to the
alist."
- :group 'erc-server
:type '(repeat (cons (regexp :tag "Target")
coding-system)))
(defcustom erc-server-connect-function #'erc-open-network-stream
"Function used to initiate a connection.
It should take same arguments as `open-network-stream' does."
- :group 'erc-server
:type 'function)
(defcustom erc-server-prevent-duplicates '("301")
"Either nil or a list of strings.
Each string is a IRC message type, like PRIVMSG or NOTICE.
All Message types in that list of subjected to duplicate prevention."
- :type '(choice (const nil) (list string))
- :group 'erc-server)
+ :type '(choice (const nil) (list string)))
(defcustom erc-server-duplicate-timeout 60
"The time allowed in seconds between duplicate messages.
If two identical messages arrive within this value of one another, the second
isn't displayed."
- :type 'integer
- :group 'erc-server)
+ :type 'integer)
(defcustom erc-server-timestamp-format "%Y-%m-%d %T"
"Timestamp format used with server response messages.
This string is processed using `format-time-string'."
:version "24.3"
- :type 'string
- :group 'erc-server)
+ :type 'string)
;;; Flood-related
@@ -395,22 +391,19 @@ detailed in RFC 2813, section 5.8 \"Flood control of clients\".
time, send a message, and increase
`erc-server-flood-last-message' by
`erc-server-flood-penalty' for each message."
- :type 'integer
- :group 'erc-server)
+ :type 'integer)
(defcustom erc-server-flood-penalty 3
"How much we penalize a message.
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm."
- :type 'integer
- :group 'erc-server)
+ :type 'integer)
;; Ping handling
(defcustom erc-server-send-ping-interval 30
"Interval of sending pings to the server, in seconds.
If this is set to nil, pinging the server is disabled."
- :group 'erc-server
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
@@ -422,7 +415,6 @@ This must be greater than or equal to the value for
`erc-server-send-ping-interval'.
If this is set to nil, never try to reconnect."
- :group 'erc-server
:type '(choice (const :tag "Disabled" nil)
(integer :tag "Seconds")))
@@ -520,18 +512,23 @@ The current buffer is given by BUFFER."
(memq (process-status erc-server-process) '(run open)))))
;;;; Connecting to a server
-(defun erc-open-network-stream (name buffer host service)
- "As `open-network-stream', but does non-blocking IO"
- (make-network-process :name name :buffer buffer
- :host host :service service :nowait t))
+(defun erc-open-network-stream (name buffer host service &rest parameters)
+ "Like `open-network-stream', but does non-blocking IO."
+ (let ((p (plist-put parameters :nowait t)))
+ (apply #'open-network-stream name buffer host service p)))
-(defun erc-server-connect (server port buffer)
+(defun erc-server-connect (server port buffer &optional client-certificate)
"Perform the connection and login using the specified SERVER and PORT.
-We will store server variables in the buffer given by BUFFER."
- (let ((msg (erc-format-message 'connect ?S server ?p port)) process)
+We will store server variables in the buffer given by BUFFER.
+CLIENT-CERTIFICATE may optionally be used to specify a TLS client
+certificate to use for authentication when connecting over
+TLS (see `erc-session-client-certificate' for more details)."
+ (let ((msg (erc-format-message 'connect ?S server ?p port)) process
+ (args `(,(format "erc-%s-%s" server port) nil ,server ,port)))
+ (when client-certificate
+ (setq args `(,@args :client-certificate ,client-certificate)))
(message "%s" msg)
- (setq process (funcall erc-server-connect-function
- (format "erc-%s-%s" server port) nil server port))
+ (setq process (apply erc-server-connect-function args))
(unless (processp process)
(error "Connection attempt failed"))
;; Misc server variables
@@ -953,15 +950,15 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(unless (string= string "") ;; Ignore empty strings
(save-match-data
(let* ((tag-list (when (eq (aref string 0) ?@)
- (substring string 1 (string-match " " string))))
+ (substring string 1 (string-search " " string))))
(msg (make-erc-response :unparsed string :tags (when tag-list
(erc-parse-tags
tag-list))))
(string (if tag-list
- (substring string (+ 1 (string-match " " string)))
+ (substring string (+ 1 (string-search " " string)))
string))
(posn (if (eq (aref string 0) ?:)
- (string-match " " string)
+ (string-search " " string)
0)))
(setf (erc-response.sender msg)
@@ -971,7 +968,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(setf (erc-response.command msg)
(let* ((bposn (string-match "[^ \n]" string posn))
- (eposn (string-match " " string bposn)))
+ (eposn (string-search " " string bposn)))
(setq posn (and eposn
(string-match "[^ \n]" string eposn)))
(substring string bposn eposn)))
@@ -979,7 +976,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(while (and posn
(not (eq (aref string posn) ?:)))
(push (let* ((bposn posn)
- (eposn (string-match " " string bposn)))
+ (eposn (string-search " " string bposn)))
(setq posn (and eposn
(string-match "[^ \n]" string eposn)))
(substring string bposn eposn))
@@ -1079,14 +1076,9 @@ Finds hooks by looking in the `erc-server-responses' hash table."
(erc-display-message parsed 'notice proc line)))
-(put 'define-erc-response-handler 'edebug-form-spec
- '(&define :name erc-response-handler
- (name &rest name)
- &optional sexp sexp def-body))
-
(cl-defmacro define-erc-response-handler ((name &rest aliases)
- &optional extra-fn-doc extra-var-doc
- &rest fn-body)
+ &optional extra-fn-doc extra-var-doc
+ &rest fn-body)
"Define an ERC handler hook/function pair.
NAME is the response name as sent by the server (see the IRC RFC for
meanings).
@@ -1166,6 +1158,9 @@ Would expand to:
See also `erc-server-311'.\"))
\(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)"
+ (declare (debug (&define [&name "erc-response-handler@"
+ (symbolp &rest symbolp)]
+ &optional sexp sexp def-body)))
(if (numberp name) (setq name (intern (format "%03i" name))))
(setq aliases (mapcar (lambda (a)
(if (numberp a)
@@ -1228,8 +1223,8 @@ add things to `%s' instead."
,@(cl-loop for fn in fn-alternates
for var in var-alternates
for a in aliases
- nconc (list `(defalias ',fn ',fn-name)
- `(defvar ,var ',fn-name ,(format hook-doc a))
+ nconc (list `(defalias ',fn #',fn-name)
+ `(defvar ,var #',fn-name ,(format hook-doc a))
`(put ',var 'definition-name ',hook-name))))))
(define-erc-response-handler (ERROR)
@@ -1766,7 +1761,7 @@ See `erc-display-server-message'." nil
's324 ?c channel ?m modes)))
(define-erc-response-handler (328)
- "Channel URL (on freenode network)." nil
+ "Channel URL." nil
(let ((channel (cadr (erc-response.command-args parsed)))
(url (erc-response.contents parsed)))
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 71ff40877a8..5953471ae8e 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -1,10 +1,10 @@
-;; erc-button.el --- A way of buttonizing certain things in ERC buffers -*- lexical-binding:t -*-
+;;; erc-button.el --- A way of buttonizing certain things in ERC buffers -*- lexical-binding:t -*-
;; Copyright (C) 1996-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: irc, button, url, regexp
+;; Keywords: comm, irc, button, url, regexp
;; URL: https://www.emacswiki.org/emacs/ErcButton
;; This file is part of GNU Emacs.
@@ -52,14 +52,14 @@
;;;###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)
- (add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append)
- (add-hook 'erc-complete-functions 'erc-button-next-function)
- (add-hook 'erc-mode-hook 'erc-button-setup))
- ((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons)
- (remove-hook 'erc-send-modify-hook 'erc-button-add-buttons)
- (remove-hook 'erc-complete-functions 'erc-button-next-function)
- (remove-hook 'erc-mode-hook 'erc-button-setup)))
+ ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
+ (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
+ (add-hook 'erc-complete-functions #'erc-button-next-function)
+ (add-hook 'erc-mode-hook #'erc-button-setup))
+ ((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons)
+ (remove-hook 'erc-send-modify-hook #'erc-button-add-buttons)
+ (remove-hook 'erc-complete-functions #'erc-button-next-function)
+ (remove-hook 'erc-mode-hook #'erc-button-setup)))
;;; Variables
@@ -91,7 +91,6 @@ above them."
(defcustom erc-button-url-regexp browse-url-button-regexp
"Regular expression that matches URLs."
:version "27.1"
- :group 'erc-button
:type 'regexp)
(defcustom erc-button-wrap-long-urls nil
@@ -100,28 +99,25 @@ above them."
If this variable is a number, consider URLs longer than its value to
be \"long\". If t, URLs will be considered \"long\" if they are
longer than `erc-fill-column'."
- :group 'erc-button
:type '(choice integer boolean))
(defcustom erc-button-buttonize-nicks t
"Flag indicating whether nicks should be buttonized or not."
- :group 'erc-button
:type 'boolean)
-(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html"
- "URL used to browse rfc references.
+(defcustom erc-button-rfc-url "https://tools.ietf.org/html/rfc%s"
+ "URL used to browse RFC references.
%s is replaced by the number."
- :group 'erc-button
- :type 'string)
+ :type 'string
+ :version "28.1")
(define-obsolete-variable-alias 'erc-button-google-url
'erc-button-search-url "27.1")
-(defcustom erc-button-search-url "http://duckduckgo.com/?q=%s"
+(defcustom erc-button-search-url "https://duckduckgo.com/?q=%s"
"URL used to search for a term.
%s is replaced by the search string."
- :version "27.1"
- :group 'erc-button
+ :version "28.1"
:type 'string)
(defcustom erc-button-alist
@@ -134,7 +130,8 @@ longer than `erc-fill-column'."
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url-button-open-url 1)
;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
;; emacs internal
- ("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1)
+ ("[`]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)[']"
+ 1 t erc-button-describe-symbol 1)
;; pseudo links
("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
@@ -179,7 +176,6 @@ PAR is a number of a regexp grouping whose text will be passed to
CALLBACK. There can be several PAR arguments. If REGEXP is
\\='nicknames, these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
- :group 'erc-button
:version "24.1" ; remove finger (bug#4443)
:type '(repeat
(list :tag "Button"
@@ -200,20 +196,18 @@ PAR is a number of a regexp grouping whose text will be passed to
(defcustom erc-emacswiki-url "https://www.emacswiki.org/cgi-bin/wiki.pl?"
"URL of the EmacsWiki Homepage."
- :group 'erc-button
:type 'string)
(defcustom erc-emacswiki-lisp-url "https://www.emacswiki.org/elisp/"
"URL of the EmacsWiki ELisp area."
- :group 'erc-button
:type 'string)
(defvar erc-button-keymap
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'erc-button-press-button)
- (define-key map (kbd "<mouse-2>") 'erc-button-click-button)
- (define-key map (kbd "TAB") 'erc-button-next)
- (define-key map (kbd "<backtab>") 'erc-button-previous)
+ (define-key map (kbd "RET") #'erc-button-press-button)
+ (define-key map (kbd "<mouse-2>") #'erc-button-click-button)
+ (define-key map (kbd "TAB") #'erc-button-next)
+ (define-key map (kbd "<backtab>") #'erc-button-previous)
(define-key map [follow-link] 'mouse-face)
(set-keymap-parent map erc-mode-map)
map)
@@ -244,7 +238,7 @@ global-level ERC button keys yet.")
"Add ERC mode-level button movement keys. This is only done once."
;; Add keys.
(unless erc-button-keys-added
- (define-key erc-mode-map (kbd "<backtab>") 'erc-button-previous)
+ (define-key erc-mode-map (kbd "<backtab>") #'erc-button-previous)
(setq erc-button-keys-added t)))
(defun erc-button-add-buttons ()
@@ -287,7 +281,7 @@ specified by `erc-button-alist'."
(fun (nth 3 entry))
bounds word)
(when (or (eq t form)
- (eval form))
+ (eval form t))
(goto-char (point-min))
(while (erc-forward-word)
(when (setq bounds (erc-bounds-of-word-at-point))
@@ -306,9 +300,9 @@ specified by `erc-button-alist'."
(end (match-end (nth 1 entry)))
(form (nth 2 entry))
(fun (nth 3 entry))
- (data (mapcar 'match-string (nthcdr 4 entry))))
+ (data (mapcar #'match-string-no-properties (nthcdr 4 entry))))
(when (or (eq t form)
- (eval form))
+ (eval form t))
(erc-button-add-button start end fun nil data regexp)))))
(defun erc-button-remove-old-buttons ()
@@ -483,7 +477,6 @@ Examples:
(format
\"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
nick)))"
- :group 'erc-button
:type '(repeat (cons (string :tag "Op")
sexp)))
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 4e4d012545a..19bc2dbb8ec 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -1,4 +1,4 @@
-;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
+;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -40,8 +40,8 @@
;; disable this module, it will continue removing message flags, but the
;; unidentified nickname prefix will not be added to messages.
-;; Visit <http://freenode.net/faq.shtml#spoofing> and
-;; <http://freenode.net/faq.shtml#registering> to find further
+;; Visit <https://freenode.net/kb/answer/cloaks> and
+;; <https://freenode.net/kb/answer/registration> to find further
;; explanations of this capability.
;; From freenode.net's web site (not there anymore) on how to mark
@@ -80,12 +80,10 @@
If you change this from the default \"*\", be sure to use a
character not found in IRC nicknames to avoid confusion."
- :group 'erc-capab
:type '(choice string (const nil)))
(defface erc-capab-identify-unidentified '((t)) ; same as `erc-default-face'
"Face to use for `erc-capab-identify-prefix'."
- :group 'erc-capab
:group 'erc-faces)
;;; Define module:
@@ -94,22 +92,22 @@ character not found in IRC nicknames to avoid confusion."
(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'
- ((add-hook 'erc-server-005-functions 'erc-capab-identify-setup t)
- (add-hook 'erc-server-290-functions 'erc-capab-identify-activate)
+ ((add-hook 'erc-server-005-functions #'erc-capab-identify-setup t)
+ (add-hook 'erc-server-290-functions #'erc-capab-identify-activate)
(add-hook 'erc-server-PRIVMSG-functions
- 'erc-capab-identify-remove/set-identified-flag)
+ #'erc-capab-identify-remove/set-identified-flag)
(add-hook 'erc-server-NOTICE-functions
- 'erc-capab-identify-remove/set-identified-flag)
- (add-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix t)
+ #'erc-capab-identify-remove/set-identified-flag)
+ (add-hook 'erc-insert-modify-hook #'erc-capab-identify-add-prefix t)
(mapc (lambda (buffer)
(when buffer
(with-current-buffer buffer (erc-capab-identify-setup))))
- (erc-buffer-list 'erc-open-server-buffer-p)))
- ((remove-hook 'erc-server-005-functions 'erc-capab-identify-setup)
- (remove-hook 'erc-server-290-functions 'erc-capab-identify-activate)
+ (erc-buffer-list #'erc-open-server-buffer-p)))
+ ((remove-hook 'erc-server-005-functions #'erc-capab-identify-setup)
+ (remove-hook 'erc-server-290-functions #'erc-capab-identify-activate)
;; we don't remove the `erc-capab-identify-remove/set-identified-flag' hooks
;; because there doesn't seem to be a way to tell the server to turn it off
- (remove-hook 'erc-insert-modify-hook 'erc-capab-identify-add-prefix)))
+ (remove-hook 'erc-insert-modify-hook #'erc-capab-identify-add-prefix)))
;;; Variables:
@@ -121,7 +119,7 @@ character not found in IRC nicknames to avoid confusion."
;;; Functions:
-(defun erc-capab-identify-setup (&optional proc parsed)
+(defun erc-capab-identify-setup (&optional _proc _parsed)
"Set up CAPAB IDENTIFY on the current server.
Optional argument PROC is the current server's process.
@@ -146,19 +144,19 @@ These arguments are sent to this function when called as a hook in
(setq erc-capab-identify-sent t)))
-(defun erc-capab-identify-activate (proc parsed)
+(defun erc-capab-identify-activate (_proc parsed)
"Set `erc-capab-identify-activated' and display an activation message.
PROC is the current server's process.
PARSED is an `erc-parsed' response struct."
- (when (or (string= "IDENTIFY-MSG" (erc-response.contents parsed))
- (string= "IDENTIFY-CTCP" (erc-response.contents parsed)))
+ (when (member (erc-response.contents parsed)
+ '("IDENTIFY-MSG" "IDENTIFY-CTCP"))
(setq erc-capab-identify-activated t)
(erc-display-message
parsed 'notice 'active (format "%s activated"
(erc-response.contents parsed)))))
-(defun erc-capab-identify-remove/set-identified-flag (proc parsed)
+(defun erc-capab-identify-remove/set-identified-flag (_proc parsed)
"Remove PARSED message's id flag and add the `erc-identified' text property.
PROC is the current server's process.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 9dedd3cda86..de72624aaa1 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -1,4 +1,4 @@
-;;; erc-dcc.el --- CTCP DCC module for ERC
+;;; erc-dcc.el --- CTCP DCC module for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2021 Free Software
;; Foundation, Inc.
@@ -7,7 +7,7 @@
;; Noah Friedman <friedman@prep.ai.mit.edu>
;; Per Persson <pp@sno.pp.se>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes
+;; Keywords: comm
;; Created: 1994-01-23
;; This file is part of GNU Emacs.
@@ -55,12 +55,6 @@
;; Require at run-time too to silence compiler.
(require 'pcomplete)
-;;;###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))
- ((remove-hook 'erc-server-401-functions 'erc-dcc-no-such-nick)))
-
(defgroup erc-dcc nil
"DCC stands for Direct Client Communication, where you and your
friend's client programs connect directly to each other,
@@ -71,9 +65,14 @@ Using DCC get and send, you can transfer files directly from and to other
IRC users."
:group 'erc)
+;;;###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))
+ ((remove-hook 'erc-server-401-functions #'erc-dcc-no-such-nick)))
+
(defcustom erc-dcc-verbose nil
"If non-nil, be verbose about DCC activity reporting."
- :group 'erc-dcc
:type 'boolean)
(defconst erc-dcc-connection-types
@@ -120,7 +119,8 @@ All values of the list must be uppercase strings.")
;; more: the entry data from erc-dcc-list for this particular process.
(defvar erc-dcc-connect-function 'erc-dcc-open-network-stream)
-(defun erc-dcc-open-network-stream (procname buffer addr port entry)
+(defun erc-dcc-open-network-stream (procname buffer addr port _entry)
+ ;; FIXME: Time to try activating this again!?
(if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes
;; cvs emacs
(open-network-stream-nowait procname buffer addr port)
@@ -187,7 +187,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive."
(plist-get elt prop)))
;; if the property exists and is equal, we continue, else, try the
;; next element of the list
- (or (and (eq prop :nick) (string-match "!" val)
+ (or (and (eq prop :nick) (string-search "!" val)
test (string-equal test val))
(and (eq prop :nick)
test val
@@ -286,7 +286,6 @@ The result is also a string."
"IP address to listen on when offering files.
Should be set to a string or nil. If nil, automatic detection of
the host interface to use will be attempted."
- :group 'erc-dcc
:type (list 'choice (list 'const :tag "Auto-detect" nil)
(list 'string :tag "IP-address"
:valid-regexp erc-dcc-ipv4-regexp)))
@@ -295,7 +294,6 @@ the host interface to use will be attempted."
"IP address to use for outgoing DCC offers.
Should be set to a string or nil. If nil, use the value of
`erc-dcc-listen-host'."
- :group 'erc-dcc
:type (list 'choice (list 'const :tag "Same as erc-dcc-listen-host" nil)
(list 'string :tag "IP-address"
:valid-regexp erc-dcc-ipv4-regexp)))
@@ -306,7 +304,6 @@ Should be set to a string or nil. If nil, use the value of
You might want to set `erc-dcc-auto-masks' for this.
`auto' - Automatically accept the request and begin downloading the file
`ignore' - Ignore incoming DCC Send requests completely."
- :group 'erc-dcc
:type '(choice (const ask) (const auto) (const ignore)))
(defun erc-dcc-get-host (proc)
@@ -323,7 +320,6 @@ If variable `erc-dcc-host' is non-nil, use it. Otherwise call
(defcustom erc-dcc-port-range nil
"If nil, any available user port is used for outgoing DCC connections.
If set to a cons, it specifies a range of ports to use in the form (min . max)"
- :group 'erc-dcc
:type '(choice
(const :tag "Any port" nil)
(cons :tag "Port range"
@@ -335,7 +331,6 @@ If set to a cons, it specifies a range of ports to use in the form (min . max)"
accepted automatically. A user identifier has the form \"nick!login@host\".
For instance, to accept all incoming DCC send offers automatically, add the
string \".*!.*@.*\" to this list."
- :group 'erc-dcc
:type '(repeat regexp))
(defun erc-dcc-server (name filter sentinel)
@@ -391,7 +386,6 @@ the accepted connection."
(defcustom erc-dcc-get-default-directory nil
"Default directory for incoming DCC file transfers.
If this is nil, then the current value of `default-directory' is used."
- :group 'erc-dcc
:type '(choice (const nil :tag "Default directory") directory))
;;;###autoload
@@ -421,33 +415,33 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
(pcase (intern (downcase (pcomplete-arg 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
(cl-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type) 'CHAT))
+ (lambda (elt)
+ (eq (plist-get elt :type) 'CHAT))
erc-dcc-list)))
('close (delete-dups
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
erc-dcc-list)))
('get (mapcar #'erc-dcc-nick
(cl-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type) 'GET))
+ (lambda (elt)
+ (eq (plist-get elt :type) 'GET))
erc-dcc-list)))
('send (pcomplete-erc-all-nicks))))
(pcomplete-here
(pcase (intern (downcase (pcomplete-arg 2)))
('get (mapcar (lambda (elt) (plist-get elt :file))
(cl-remove-if-not
- #'(lambda (elt)
- (and (eq (plist-get elt :type) 'GET)
- (erc-nick-equal-p (erc-extract-nick
- (plist-get elt :nick))
- (pcomplete-arg 1))))
+ (lambda (elt)
+ (and (eq (plist-get elt :type) 'GET)
+ (erc-nick-equal-p (erc-extract-nick
+ (plist-get elt :nick))
+ (pcomplete-arg 1))))
erc-dcc-list)))
('close (mapcar #'erc-dcc-nick
(cl-remove-if-not
- #'(lambda (elt)
- (eq (plist-get elt :type)
- (intern (upcase (pcomplete-arg 1)))))
+ (lambda (elt)
+ (eq (plist-get elt :type)
+ (intern (upcase (pcomplete-arg 1)))))
erc-dcc-list)))
('send (pcomplete-entries)))))
@@ -468,7 +462,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
'dcc-chat-offer ?n nick)
t))))
-(defun erc-dcc-do-CLOSE-command (proc &optional type nick)
+(defun erc-dcc-do-CLOSE-command (_proc &optional type nick)
"Close a connection. Usage: /dcc close type nick.
At least one of TYPE and NICK must be provided."
;; disambiguate type and nick if only one is provided
@@ -540,7 +534,7 @@ PROC is the server process."
(defvar-local erc-dcc-byte-count nil)
-(defun erc-dcc-do-LIST-command (proc)
+(defun erc-dcc-do-LIST-command (_proc)
"This is the handler for the /dcc list command.
It lists the current state of `erc-dcc-list' in an easy to read manner."
(let ((alist erc-dcc-list)
@@ -636,8 +630,8 @@ that subcommand."
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
- (replace-regexp-in-string "\\\\\\\\" "\\"
- (replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
+ (string-replace "\\\\" "\\"
+ (string-replace "\\\"" "\"" ,filename))))
(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.
@@ -703,7 +697,6 @@ the matching regexp, or nil if none found."
`ask' - Report the Chat request, and wait for the user to manually accept it
`auto' - Automatically accept the request and open a new chat window
`ignore' - Ignore incoming DCC chat requests completely."
- :group 'erc-dcc
:type '(choice (const ask) (const auto) (const ignore)))
(defun erc-dcc-handle-ctcp-chat (proc query nick login host to)
@@ -757,13 +750,11 @@ the matching regexp, or nil if none found."
(defcustom erc-dcc-block-size 1024
"Block size to use for DCC SEND sessions."
- :group 'erc-dcc
:type 'integer)
(defcustom erc-dcc-pump-bytes nil
"If set to an integer, keep sending until that number of bytes are
unconfirmed."
- :group 'erc-dcc
:type '(choice (const nil) integer))
(define-inline erc-dcc-get-parent (proc)
@@ -837,7 +828,6 @@ bytes sent."
'(erc-dcc-display-send erc-dcc-send-block)
"Hook run whenever the remote end of a DCC SEND offer connected to your
listening port."
- :group 'erc-dcc
:type 'hook)
(defun erc-dcc-nick (plist)
@@ -900,7 +890,6 @@ other client."
(defcustom erc-dcc-receive-cache (* 1024 512)
"Number of bytes to let the receive buffer grow before flushing it."
- :group 'erc-dcc
:type 'integer)
(defvar-local erc-dcc-file-name nil)
@@ -942,12 +931,12 @@ and making the connection."
(set-process-coding-system proc 'binary 'binary)
(set-buffer-file-coding-system 'binary t)
- (set-process-filter proc 'erc-dcc-get-filter)
- (set-process-sentinel proc 'erc-dcc-get-sentinel)
+ (set-process-filter proc #'erc-dcc-get-filter)
+ (set-process-sentinel proc #'erc-dcc-get-sentinel)
(setq entry (plist-put entry :start-time (erc-current-time)))
(setq entry (plist-put entry :peer proc)))))
-(defun erc-dcc-append-contents (buffer file)
+(defun erc-dcc-append-contents (buffer _file)
"Append the contents of BUFFER to FILE.
The contents of the BUFFER will then be erased."
(with-current-buffer buffer
@@ -1000,7 +989,7 @@ rather than every 1024 byte block, but nobody seems to care."
proc (erc-pack-int received-bytes)))))))
-(defun erc-dcc-get-sentinel (proc event)
+(defun erc-dcc-get-sentinel (proc _event)
"This is the process sentinel for CTCP DCC SEND connections.
It shuts down the connection and notifies the user that the
transfer is complete."
@@ -1025,25 +1014,21 @@ transfer is complete."
(defcustom erc-dcc-chat-buffer-name-format "DCC-CHAT-%s"
"Format to use for DCC Chat buffer names."
- :group 'erc-dcc
:type 'string)
(defcustom erc-dcc-chat-mode-hook nil
"Hook calls when `erc-dcc-chat-mode' finished setting up the buffer."
- :group 'erc-dcc
:type 'hook)
(defcustom erc-dcc-chat-connect-hook nil
""
- :group 'erc-dcc
:type 'hook)
(defcustom erc-dcc-chat-exit-hook nil
""
- :group 'erc-dcc
:type 'hook)
-(defun erc-cmd-CREQ (line &optional force)
+(defun erc-cmd-CREQ (line &optional _force)
"Set or get the DCC chat request flag.
Possible values are: ask, auto, ignore."
(when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
@@ -1058,7 +1043,7 @@ Possible values are: ask, auto, ignore."
erc-dcc-chat-request)))
t)))
-(defun erc-cmd-SREQ (line &optional force)
+(defun erc-cmd-SREQ (line &optional _force)
"Set or get the DCC send request flag.
Possible values are: ask, auto, ignore."
(when (string-match "^\\s-*\\(auto\\|ask\\|ignore\\)?$" line)
@@ -1075,7 +1060,7 @@ Possible values are: ask, auto, ignore."
(defun pcomplete/erc-mode/CREQ ()
(pcomplete-here '("auto" "ask" "ignore")))
-(defalias 'pcomplete/erc-mode/SREQ 'pcomplete/erc-mode/CREQ)
+(defalias 'pcomplete/erc-mode/SREQ #'pcomplete/erc-mode/CREQ)
(define-obsolete-variable-alias 'erc-dcc-chat-filter-hook
'erc-dcc-chat-filter-functions "24.3")
@@ -1087,19 +1072,19 @@ the unprocessed output.")
(defvar erc-dcc-chat-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'erc-send-current-line)
- (define-key map "\t" 'completion-at-point)
+ (define-key map (kbd "RET") #'erc-send-current-line)
+ (define-key map "\t" #'completion-at-point)
map)
"Keymap for `erc-dcc-mode'.")
(define-derived-mode erc-dcc-chat-mode fundamental-mode "DCC-Chat"
"Major mode for wasting time via DCC chat."
(setq mode-line-process '(":%s")
- erc-send-input-line-function 'erc-dcc-chat-send-input-line
+ erc-send-input-line-function #'erc-dcc-chat-send-input-line
erc-default-recipients '(dcc))
- (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
+ (add-hook 'completion-at-point-functions #'erc-complete-word-at-point nil t))
-(defun erc-dcc-chat-send-input-line (recipient line &optional force)
+(defun erc-dcc-chat-send-input-line (recipient line &optional _force)
"Send LINE to the remote end.
Argument RECIPIENT should always be the symbol dcc, and force
is ignored."
@@ -1150,14 +1135,14 @@ other client."
(setq erc-input-marker (make-marker))
(erc-display-prompt buffer (point-max))
(set-process-buffer proc buffer)
- (add-hook 'kill-buffer-hook 'erc-dcc-chat-buffer-killed nil t)
+ (add-hook 'kill-buffer-hook #'erc-dcc-chat-buffer-killed nil t)
(run-hook-with-args 'erc-dcc-chat-connect-hook proc)
buffer))
(defun erc-dcc-chat-accept (entry parent-proc)
"Accept an incoming DCC connection and open a DCC window."
- (let* ((nick (erc-extract-nick (plist-get entry :nick)))
- buffer proc)
+ (let* (;; (nick (erc-extract-nick (plist-get entry :nick)))
+ proc) ;; buffer
(setq proc
(funcall erc-dcc-connect-function
"dcc-chat" nil
@@ -1167,9 +1152,10 @@ other client."
;; XXX: connected, should we kill the ip/port properties?
(setq entry (plist-put entry :peer proc))
(setq entry (plist-put entry :parent parent-proc))
- (set-process-filter proc 'erc-dcc-chat-filter)
- (set-process-sentinel proc 'erc-dcc-chat-sentinel)
- (setq buffer (erc-dcc-chat-setup entry))))
+ (set-process-filter proc #'erc-dcc-chat-filter)
+ (set-process-sentinel proc #'erc-dcc-chat-sentinel)
+ ;; (setq buffer
+ (erc-dcc-chat-setup entry))) ;; )
(defun erc-dcc-chat-filter (proc str)
(let ((orig-buffer (current-buffer)))
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 056fb23777f..9838b239537 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -1,4 +1,4 @@
-;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions -*- lexical-binding:t -*-
+;;; erc-desktop-notifications.el --- Send notification on PRIVMSG or mentions -*- lexical-binding:t -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
@@ -45,13 +45,11 @@
(defcustom erc-notifications-icon nil
"Icon to use for notification."
- :group 'erc-notifications
:type '(choice (const :tag "No icon" nil) file))
(defcustom erc-notifications-bus :session
"D-Bus bus to use for notification."
:version "25.1"
- :group 'erc-notifications
:type '(choice (const :tag "Session bus" :session) string))
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
@@ -99,11 +97,11 @@ This will replace the last notification sent with this function."
(define-erc-module notifications nil
"Send notifications on private message reception and mentions."
;; Enable
- ((add-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
- (add-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match))
+ ((add-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
+ (add-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match))
;; Disable
- ((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG)
- (remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match)))
+ ((remove-hook 'erc-server-PRIVMSG-functions #'erc-notifications-PRIVMSG)
+ (remove-hook 'erc-text-matched-hook #'erc-notifications-notify-on-match)))
(provide 'erc-desktop-notifications)
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 8378ff53742..331d29a7b5b 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -1,4 +1,4 @@
-;;; erc-ezbounce.el --- Handle EZBounce bouncer commands
+;;; erc-ezbounce.el --- Handle EZBounce bouncer commands -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@@ -33,7 +33,6 @@
(defcustom erc-ezb-regexp "^ezbounce!srv$"
"Regexp used by the EZBouncer to identify itself to the user."
- :group 'erc-ezbounce
:type 'regexp)
(defcustom erc-ezb-login-alist '()
@@ -44,7 +43,6 @@ The alist's format is as follows:
(((server . port) . (username . password))
((server . port) . (username . password))
...)"
- :group 'erc-ezbounce
:type '(repeat
(cons (cons :tag "Server"
string
@@ -68,7 +66,7 @@ The alist's format is as follows:
"Indicate whether current notices are expected to be EZB session listings.")
;;;###autoload
-(defun erc-cmd-ezb (line &optional force)
+(defun erc-cmd-ezb (line &optional _force)
"Send EZB commands to the EZBouncer verbatim."
(erc-server-send (concat "EZB " line)))
(put 'erc-cmd-EZB 'do-not-parse-args t)
@@ -102,7 +100,7 @@ in the alist is nil, prompt for the appropriate values."
found))
;;;###autoload
-(defun erc-ezb-notice-autodetect (proc parsed)
+(defun erc-ezb-notice-autodetect (_proc parsed)
"React on an EZBounce NOTICE request."
(let* ((sender (erc-response.sender parsed))
(message (erc-response.contents parsed))
@@ -113,7 +111,7 @@ in the alist is nil, prompt for the appropriate values."
nil)
;;;###autoload
-(defun erc-ezb-identify (message)
+(defun erc-ezb-identify (_message)
"Identify to the EZBouncer server."
(let ((login (erc-ezb-get-login erc-session-server (erc-port-to-string erc-session-port))))
(unless (null login)
@@ -122,13 +120,13 @@ in the alist is nil, prompt for the appropriate values."
(erc-server-send (concat "LOGIN " username " " pass))))))
;;;###autoload
-(defun erc-ezb-init-session-list (message)
+(defun erc-ezb-init-session-list (_message)
"Reset the EZBounce session list to nil."
(setq erc-ezb-session-list nil)
(setq erc-ezb-inside-session-listing t))
;;;###autoload
-(defun erc-ezb-end-of-session-list (message)
+(defun erc-ezb-end-of-session-list (_message)
"Indicate the end of the EZBounce session listing."
(setq erc-ezb-inside-session-listing nil))
@@ -143,7 +141,7 @@ in the alist is nil, prompt for the appropriate values."
(add-to-list 'erc-ezb-session-list (list id nick to)))))
;;;###autoload
-(defun erc-ezb-select (message)
+(defun erc-ezb-select (_message)
"Select an IRC server to use by EZBounce, in ERC style."
(unless (and erc-ezb-session-list
(erc-ezb-select-session))
@@ -169,7 +167,7 @@ in the alist is nil, prompt for the appropriate values."
;;;###autoload
(defun erc-ezb-initialize ()
"Add EZBouncer convenience functions to ERC."
- (add-hook 'erc-server-NOTICE-functions 'erc-ezb-notice-autodetect))
+ (add-hook 'erc-server-NOTICE-functions #'erc-ezb-notice-autodetect))
(provide 'erc-ezbounce)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 83ef5f93fa7..41256682c00 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -1,4 +1,4 @@
-;;; erc-fill.el --- Filling IRC messages in various ways
+;;; erc-fill.el --- Filling IRC messages in various ways -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
@@ -46,8 +46,7 @@ the mode if ARG is omitted or nil.
ERC fill mode is a global minor mode. When enabled, messages in
the channel buffers are filled."
- nil nil nil
- :global t :group 'erc-fill
+ :global t
(if erc-fill-mode
(erc-fill-enable)
(erc-fill-disable)))
@@ -55,19 +54,18 @@ the channel buffers are filled."
(defun erc-fill-enable ()
"Setup hooks for `erc-fill-mode'."
(interactive)
- (add-hook 'erc-insert-modify-hook 'erc-fill)
- (add-hook 'erc-send-modify-hook 'erc-fill))
+ (add-hook 'erc-insert-modify-hook #'erc-fill)
+ (add-hook 'erc-send-modify-hook #'erc-fill))
(defun erc-fill-disable ()
"Cleanup hooks, disable `erc-fill-mode'."
(interactive)
- (remove-hook 'erc-insert-modify-hook 'erc-fill)
- (remove-hook 'erc-send-modify-hook 'erc-fill))
+ (remove-hook 'erc-insert-modify-hook #'erc-fill)
+ (remove-hook 'erc-send-modify-hook #'erc-fill))
(defcustom erc-fill-prefix nil
"Values used as `fill-prefix' for `erc-fill-variable'.
nil means fill with space, a string means fill with this string."
- :group 'erc-fill
:type '(choice (const nil) string))
(defcustom erc-fill-function 'erc-fill-variable
@@ -94,7 +92,6 @@ These two styles are implemented using `erc-fill-variable' and
`erc-fill-static'. You can, of course, define your own filling
function. Narrowing to the region in question is in effect while your
function is called."
- :group 'erc-fill
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
function))
@@ -104,18 +101,15 @@ function is called."
centered. This column denotes the point where the ` ' character
between <nickname> and the entered text will be put, thus aligning
nick names right and text left."
- :group 'erc-fill
:type 'integer)
(defcustom erc-fill-variable-maximum-indentation 17
"If we indent a line after a long nick, don't indent more then this
characters. Set to nil to disable."
- :group 'erc-fill
:type 'integer)
(defcustom erc-fill-column 78
"The column at which a filled paragraph is broken."
- :group 'erc-fill
:type 'integer)
;;;###autoload
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index aef68810dfa..fc9a8d39ef4 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -1,4 +1,4 @@
-;; erc-goodies.el --- Collection of ERC modules
+;;; erc-goodies.el --- Collection of ERC modules -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -37,7 +37,7 @@
"Setup Imenu support in an ERC buffer."
(setq-local imenu-create-index-function #'erc-create-imenu-index))
-(add-hook 'erc-mode-hook 'erc-imenu-setup)
+(add-hook 'erc-mode-hook #'erc-imenu-setup)
(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
;;; Automatically scroll to bottom
@@ -53,16 +53,16 @@ argument to `recenter'."
(define-erc-module scrolltobottom nil
"This mode causes the prompt to stay at the end of the window."
- ((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)
- (add-hook 'erc-insert-done-hook 'erc-possibly-scroll-to-bottom)
+ ((add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom)
+ (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)
(dolist (buffer (erc-buffer-list))
(with-current-buffer buffer
(erc-add-scroll-to-bottom))))
- ((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)
- (remove-hook 'erc-insert-done-hook 'erc-possibly-scroll-to-bottom)
+ ((remove-hook 'erc-mode-hook #'erc-add-scroll-to-bottom)
+ (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)
(dolist (buffer (erc-buffer-list))
(with-current-buffer buffer
- (remove-hook 'post-command-hook 'erc-scroll-to-bottom t)))))
+ (remove-hook 'post-command-hook #'erc-scroll-to-bottom t)))))
(defun erc-possibly-scroll-to-bottom ()
"Like `erc-add-scroll-to-bottom', but only if window is selected."
@@ -77,7 +77,7 @@ the value of `erc-input-line-position'.
This works whenever scrolling happens, so it's added to
`window-scroll-functions' rather than `erc-insert-post-hook'."
- (add-hook 'post-command-hook 'erc-scroll-to-bottom nil t))
+ (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t))
(defun erc-scroll-to-bottom ()
"Recenter WINDOW so that `point' is on the last line.
@@ -104,10 +104,10 @@ variable `erc-input-line-position'."
;;; Make read only
(define-erc-module readonly nil
"This mode causes all inserted text to be read-only."
- ((add-hook 'erc-insert-post-hook 'erc-make-read-only)
- (add-hook 'erc-send-post-hook 'erc-make-read-only))
- ((remove-hook 'erc-insert-post-hook 'erc-make-read-only)
- (remove-hook 'erc-send-post-hook 'erc-make-read-only)))
+ ((add-hook 'erc-insert-post-hook #'erc-make-read-only)
+ (add-hook 'erc-send-post-hook #'erc-make-read-only))
+ ((remove-hook 'erc-insert-post-hook #'erc-make-read-only)
+ (remove-hook 'erc-send-post-hook #'erc-make-read-only)))
(defun erc-make-read-only ()
"Make all the text in the current buffer read-only.
@@ -119,14 +119,14 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
;;; Move to prompt when typing text
(define-erc-module move-to-prompt nil
"This mode causes the point to be moved to the prompt when typing text."
- ((add-hook 'erc-mode-hook 'erc-move-to-prompt-setup)
+ ((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup)
(dolist (buffer (erc-buffer-list))
(with-current-buffer buffer
(erc-move-to-prompt-setup))))
- ((remove-hook 'erc-mode-hook 'erc-move-to-prompt-setup)
+ ((remove-hook 'erc-mode-hook #'erc-move-to-prompt-setup)
(dolist (buffer (erc-buffer-list))
(with-current-buffer buffer
- (remove-hook 'pre-command-hook 'erc-move-to-prompt t)))))
+ (remove-hook 'pre-command-hook #'erc-move-to-prompt t)))))
(defun erc-move-to-prompt ()
"Move the point to the ERC prompt if this is a self-inserting command."
@@ -138,15 +138,15 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
(defun erc-move-to-prompt-setup ()
"Initialize the move-to-prompt module for XEmacs."
- (add-hook 'pre-command-hook 'erc-move-to-prompt nil t))
+ (add-hook 'pre-command-hook #'erc-move-to-prompt nil t))
;;; Keep place in unvisited channels
(define-erc-module keep-place nil
"Leave point above un-viewed text in other channels."
- ((add-hook 'erc-insert-pre-hook 'erc-keep-place))
- ((remove-hook 'erc-insert-pre-hook 'erc-keep-place)))
+ ((add-hook 'erc-insert-pre-hook #'erc-keep-place))
+ ((remove-hook 'erc-insert-pre-hook #'erc-keep-place)))
-(defun erc-keep-place (ignored)
+(defun erc-keep-place (_ignored)
"Move point away from the last line in a non-selected ERC buffer."
(when (and (not (eq (window-buffer (selected-window))
(current-buffer)))
@@ -183,8 +183,8 @@ does not appear in the ERC buffer after the user presses ENTER.")
"This mode distinguishes non-commands.
Commands listed in `erc-insert-this' know how to display
themselves."
- ((add-hook 'erc-pre-send-functions 'erc-send-distinguish-noncommands))
- ((remove-hook 'erc-pre-send-functions 'erc-send-distinguish-noncommands)))
+ ((add-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands))
+ ((remove-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands)))
(defun erc-send-distinguish-noncommands (state)
"If STR is an ERC non-command, set `insertp' in STATE to nil."
@@ -211,20 +211,17 @@ highlighting effects. When this variable is non-nil, it can cause Emacs to run
slowly on systems lacking sufficient CPU speed. In chatty channels, or in an
emergency (message flood) it can be turned off to save processing time. See
`erc-toggle-interpret-controls'."
- :group 'erc-control-characters
:type '(choice (const :tag "Highlight control characters" t)
(const :tag "Remove control characters" remove)
(const :tag "Display raw control characters" nil)))
(defcustom erc-interpret-mirc-color nil
"If non-nil, ERC will interpret mIRC color codes."
- :group 'erc-control-characters
:type 'boolean)
(defcustom erc-beep-p nil
"Beep if C-g is in the server message.
The value `erc-interpret-controls-p' must also be t for this to work."
- :group 'erc-control-characters
:type 'boolean)
(defface erc-bold-face '((t :weight bold))
@@ -372,10 +369,10 @@ The value `erc-interpret-controls-p' must also be t for this to work."
(define-erc-module irccontrols nil
"This mode enables the interpretation of IRC control chars."
- ((add-hook 'erc-insert-modify-hook 'erc-controls-highlight)
- (add-hook 'erc-send-modify-hook 'erc-controls-highlight))
- ((remove-hook 'erc-insert-modify-hook 'erc-controls-highlight)
- (remove-hook 'erc-send-modify-hook 'erc-controls-highlight)))
+ ((add-hook 'erc-insert-modify-hook #'erc-controls-highlight)
+ (add-hook 'erc-send-modify-hook #'erc-controls-highlight))
+ ((remove-hook 'erc-insert-modify-hook #'erc-controls-highlight)
+ (remove-hook 'erc-send-modify-hook #'erc-controls-highlight)))
(defun erc-controls-interpret (str)
"Return a copy of STR after dealing with IRC control characters.
@@ -546,10 +543,10 @@ Else interpretation is turned off."
"This mode translates text-smileys such as :-) into pictures.
This requires the function `smiley-region', which is defined in
smiley.el, which is part of Gnus."
- ((add-hook 'erc-insert-modify-hook 'erc-smiley)
- (add-hook 'erc-send-modify-hook 'erc-smiley))
- ((remove-hook 'erc-insert-modify-hook 'erc-smiley)
- (remove-hook 'erc-send-modify-hook 'erc-smiley)))
+ ((add-hook 'erc-insert-modify-hook #'erc-smiley)
+ (add-hook 'erc-send-modify-hook #'erc-smiley))
+ ((remove-hook 'erc-insert-modify-hook #'erc-smiley)
+ (remove-hook 'erc-send-modify-hook #'erc-smiley)))
(defun erc-smiley ()
"Smilify a region.
@@ -560,8 +557,8 @@ This function should be used with `erc-insert-modify-hook'."
;; Unmorse
(define-erc-module unmorse nil
"This mode causes morse code in the current channel to be unmorsed."
- ((add-hook 'erc-insert-modify-hook 'erc-unmorse))
- ((remove-hook 'erc-insert-modify-hook 'erc-unmorse)))
+ ((add-hook 'erc-insert-modify-hook #'erc-unmorse))
+ ((remove-hook 'erc-insert-modify-hook #'erc-unmorse)))
(defun erc-unmorse ()
"Unmorse some text.
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 5a002ccae3e..31e59a6d3e4 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -1,4 +1,4 @@
-;;; erc-ibuffer.el --- ibuffer integration with ERC
+;;; erc-ibuffer.el --- ibuffer integration with ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@@ -39,20 +39,16 @@
(defcustom erc-ibuffer-keyword-char ?k
"Char used to indicate a channel which had keyword traffic lately (hidden)."
- :group 'erc-ibuffer
:type 'character)
(defcustom erc-ibuffer-pal-char ?p
"Char used to indicate a channel which had pal traffic lately (hidden)."
- :group 'erc-ibuffer
:type 'character)
(defcustom erc-ibuffer-fool-char ?f
"Char used to indicate a channel which had fool traffic lately (hidden)."
- :group 'erc-ibuffer
:type 'character)
(defcustom erc-ibuffer-dangerous-host-char ?d
"Char used to indicate a channel which had dangerous-host traffic lately
\(hidden)."
- :group 'erc-ibuffer
:type 'character)
(define-ibuffer-filter erc-server
@@ -77,7 +73,7 @@
erc-track-mode)
(let ((entry (assq (current-buffer) erc-modified-channels-alist)))
(if entry
- (if (> (length entry) 1)
+ (if (cdr entry)
(cond ((eq 'pal (nth 1 entry))
(string erc-ibuffer-pal-char))
((eq 'fool (nth 1 entry))
@@ -153,7 +149,7 @@
(if (and (eq major-mode 'erc-mode)
(or (> (length erc-channel-modes) 0)
erc-channel-user-limit))
- (concat (apply 'concat
+ (concat (apply #'concat
"(+" erc-channel-modes)
(if erc-channel-user-limit
(format "l %d" erc-channel-user-limit)
@@ -181,6 +177,7 @@
(defvar erc-ibuffer-limit-map nil
"Prefix keymap to use for ERC related limiting.")
(define-prefix-command 'erc-ibuffer-limit-map)
+;; FIXME: Where is `ibuffer-limit-by-erc-server' defined?
(define-key 'erc-ibuffer-limit-map (kbd "s") 'ibuffer-limit-by-erc-server)
(define-key ibuffer-mode-map (kbd "/ \C-e") 'erc-ibuffer-limit-map)
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index 5f1aab1784b..3821e298cda 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -1,10 +1,10 @@
-;;; erc-identd.el --- RFC1413 (identd authentication protocol) server
+;;; erc-identd.el --- RFC1413 (identd authentication protocol) server -*- lexical-binding: t; -*-
;; Copyright (C) 2003, 2006-2021 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes
+;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -50,7 +50,6 @@
`erc-identd-start'.
This can be either a string or a number."
- :group 'erc-identd
:type '(choice (const :tag "None" nil)
(integer :tag "Port number")
(string :tag "Port string")))
@@ -58,10 +57,10 @@ This can be either a string or a number."
;;;###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)
- (add-hook 'erc-disconnected-hook 'erc-identd-stop))
- ((remove-hook 'erc-connect-pre-hook 'erc-identd-quickstart)
- (remove-hook 'erc-disconnected-hook 'erc-identd-stop)))
+ ((add-hook 'erc-connect-pre-hook #'erc-identd-quickstart)
+ (add-hook 'erc-disconnected-hook #'erc-identd-stop))
+ ((remove-hook 'erc-connect-pre-hook #'erc-identd-quickstart)
+ (remove-hook 'erc-disconnected-hook #'erc-identd-stop)))
(defun erc-identd-filter (proc string)
"This filter implements RFC1413 (identd authentication protocol)."
@@ -95,16 +94,16 @@ system."
:buffer nil
:host 'local :service port
:server t :noquery t :nowait t
- :filter 'erc-identd-filter))
+ :filter #'erc-identd-filter))
(set-process-query-on-exit-flag erc-identd-process nil))
-(defun erc-identd-quickstart (&rest ignored)
+(defun erc-identd-quickstart (&rest _ignored)
"Start the identd server with the default port.
The default port is specified by `erc-identd-port'."
(erc-identd-start))
;;;###autoload
-(defun erc-identd-stop (&rest ignore)
+(defun erc-identd-stop (&rest _ignore)
(interactive)
(when erc-identd-process
(delete-process erc-identd-process)
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index 1a2d8e2755f..dcf6db7407a 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -1,4 +1,4 @@
-;;; erc-imenu.el -- Imenu support for ERC
+;;; erc-imenu.el --- Imenu support for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation,
;; Inc.
@@ -71,15 +71,13 @@ Don't rely on this function, read it first!"
(message-alist '())
(mode-change-alist '())
(topic-change-alist '())
- prev-pos)
+ ) ;; prev-pos
(goto-char (point-max))
- (imenu-progress-message prev-pos 0)
(while (if (bolp)
(> (forward-line -1)
-1)
(progn (forward-line 0)
t))
- (imenu-progress-message prev-pos nil t)
(save-match-data
(when (looking-at (concat (regexp-quote erc-notice-prefix)
"\\(.+\\)$"))
@@ -108,7 +106,8 @@ Don't rely on this function, read it first!"
"^\\(\\S-+\\) (.+) has set the topic for \\S-+: \\(.*\\)$"
notice-text)
(push (cons (concat (match-string 1 notice-text) ": "
- (match-string 2 notice-text)) pos)
+ (match-string 2 notice-text))
+ pos)
topic-change-alist)))))
(when (looking-at "<\\(\\S-+\\)> \\(.+\\)$")
(let ((from (match-string 1))
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index e6e50707830..2ad9c8bd941 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -1,10 +1,10 @@
-;;; erc-join.el --- autojoin channels on connect and reconnects
+;;; erc-join.el --- autojoin channels on connect and reconnects -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: irc
+;; Keywords: comm, irc
;; URL: https://www.emacswiki.org/emacs/ErcAutoJoin
;; This file is part of GNU Emacs.
@@ -42,14 +42,14 @@
;;;###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)
- (add-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident)
- (add-hook 'erc-server-JOIN-functions 'erc-autojoin-add)
- (add-hook 'erc-server-PART-functions 'erc-autojoin-remove))
- ((remove-hook 'erc-after-connect 'erc-autojoin-channels)
- (remove-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident)
- (remove-hook 'erc-server-JOIN-functions 'erc-autojoin-add)
- (remove-hook 'erc-server-PART-functions 'erc-autojoin-remove)))
+ ((add-hook 'erc-after-connect #'erc-autojoin-channels)
+ (add-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident)
+ (add-hook 'erc-server-JOIN-functions #'erc-autojoin-add)
+ (add-hook 'erc-server-PART-functions #'erc-autojoin-remove))
+ ((remove-hook 'erc-after-connect #'erc-autojoin-channels)
+ (remove-hook 'erc-nickserv-identified-hook #'erc-autojoin-after-ident)
+ (remove-hook 'erc-server-JOIN-functions #'erc-autojoin-add)
+ (remove-hook 'erc-server-PART-functions #'erc-autojoin-remove)))
(defcustom erc-autojoin-channels-alist nil
"Alist of channels to autojoin on IRC networks.
@@ -70,7 +70,6 @@ keeps track of what channels you are on, and will join them
again when you get disconnected. When you restart Emacs, however,
those changes are lost, and the customization you saved the last
time is used again."
- :group 'erc-autojoin
:type '(repeat (cons :tag "Server"
(regexp :tag "Name")
(repeat :tag "Channels"
@@ -82,7 +81,6 @@ If the value is `connect', autojoin immediately on connecting.
If the value is `ident', autojoin after successful NickServ
identification, or after `erc-autojoin-delay' seconds.
Any other value means the same as `connect'."
- :group 'erc-autojoin
:version "24.1"
:type '(choice (const :tag "On Connection" connect)
(const :tag "When Identified" ident)))
@@ -92,7 +90,6 @@ Any other value means the same as `connect'."
This only takes effect if `erc-autojoin-timing' is `ident'.
If NickServ identification occurs before this delay expires, ERC
autojoins immediately at that time."
- :group 'erc-autojoin
:version "24.1"
:type 'integer)
@@ -102,7 +99,6 @@ If non-nil, and a channel on the server a.b.c is joined, then
only b.c is used as the server for `erc-autojoin-channels-alist'.
This is important for networks that redirect you to other
servers, presumably in the same domain."
- :group 'erc-autojoin
:type 'boolean)
(defvar-local erc--autojoin-timer nil)
@@ -121,7 +117,7 @@ This is called from a timer set up by `erc-autojoin-channels'."
(erc-log "Delayed autojoin started (no ident success detected yet)")
(erc-autojoin-channels server nick))))
-(defun erc-autojoin-after-ident (network nick)
+(defun erc-autojoin-after-ident (_network _nick)
"Autojoin channels in `erc-autojoin-channels-alist'.
This function is run from `erc-nickserv-identified-hook'."
(if erc--autojoin-timer
@@ -149,7 +145,7 @@ This function is run from `erc-nickserv-identified-hook'."
(when (> erc-autojoin-delay 0)
(setq erc--autojoin-timer
(run-with-timer erc-autojoin-delay nil
- 'erc-autojoin-channels-delayed
+ #'erc-autojoin-channels-delayed
server nick (current-buffer))))
;; `erc-autojoin-timing' is `connect':
(let ((server (or erc-session-server erc-server-announced-name)))
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index b86a8d0be2b..136131ca36b 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -1,4 +1,4 @@
-;;; erc-lang.el --- provide the LANG command to ERC
+;;; erc-lang.el --- provide the LANG command to ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@@ -6,7 +6,7 @@
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; Old-Version: 1.0.0
;; URL: https://www.emacswiki.org/emacs/ErcLang
-;; Keywords: comm languages processes
+;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index cf150e74ab5..31693a7b77a 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -59,13 +59,13 @@
;;;###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)
- (remove-hook 'erc-server-322-functions 'erc-server-322-message))
+ ((remove-hook 'erc-server-321-functions #'erc-server-321-message)
+ (remove-hook 'erc-server-322-functions #'erc-server-322-message))
((erc-with-all-buffers-of-server nil
#'erc-open-server-buffer-p
- (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t))
- (add-hook 'erc-server-321-functions 'erc-server-321-message t)
- (add-hook 'erc-server-322-functions 'erc-server-322-message t)))
+ (remove-hook 'erc-server-322-functions #'erc-list-handle-322 t))
+ (add-hook 'erc-server-321-functions #'erc-server-321-message t)
+ (add-hook 'erc-server-322-functions #'erc-server-322-message t)))
;; Format a record for display.
(defun erc-list-make-string (channel users topic)
@@ -126,17 +126,17 @@
(defvar erc-list-menu-mode-map
(let ((map (make-keymap)))
(set-keymap-parent map special-mode-map)
- (define-key map "k" 'erc-list-kill)
- (define-key map "j" 'erc-list-join)
- (define-key map "g" 'erc-list-revert)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
+ (define-key map "k" #'erc-list-kill)
+ (define-key map "j" #'erc-list-join)
+ (define-key map "g" #'erc-list-revert)
+ (define-key map "n" #'next-line)
+ (define-key map "p" #'previous-line)
map)
"Local keymap for `erc-list-mode' buffers.")
(defvar erc-list-menu-sort-button-map
(let ((map (make-sparse-keymap)))
- (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column)
+ (define-key map [header-line mouse-1] #'erc-list-menu-sort-by-column)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for ERC list menu mode sorting buttons.")
@@ -181,12 +181,12 @@
(defun erc-list-install-322-handler (server-buffer)
(with-current-buffer server-buffer
;; Arrange for 322 responses to insert into our buffer.
- (add-hook 'erc-server-322-functions 'erc-list-handle-322 t t)
+ (add-hook 'erc-server-322-functions #'erc-list-handle-322 t t)
;; Arrange for 323 (end of list) to end this.
(erc-once-with-server-event
323
(lambda (_proc _parsed)
- (remove-hook 'erc-server-322-functions 'erc-list-handle-322 t)))
+ (remove-hook 'erc-server-322-functions #'erc-list-handle-322 t)))
;; Find the list buffer, empty it, and display it.
(setq-local erc-list-buffer
(get-buffer-create (concat "*Channels of "
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 4540ec6808f..ddd00afd73b 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -1,11 +1,11 @@
-;;; erc-log.el --- Logging facilities for ERC.
+;;; erc-log.el --- Logging facilities for ERC. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Lawrence Mitchell <wence@gmx.li>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ErcLogging
-;; Keywords: IRC, chat, client, Internet, logging
+;; Keywords: comm, IRC, chat, client, Internet, logging
;; Created 2003-04-26
;; Logging code taken from erc.el and modified to use markers.
@@ -112,7 +112,6 @@ SERVER and PORT are the parameters that were used to connect to BUFFERs
If you want to write logs into different directories, make a
custom function which returns the directory part and set
`erc-log-channels-directory' to its name."
- :group 'erc-log
:type '(choice (const :tag "#channel!nick@server:port.txt"
erc-generate-log-file-name-long)
(const :tag "#channel!nick@network.txt"
@@ -124,7 +123,6 @@ custom function which returns the directory part and set
(defcustom erc-truncate-buffer-on-save nil
"Erase the contents of any ERC (channel, query, server) buffer when it is saved."
- :group 'erc-log
:type 'boolean)
(defcustom erc-enable-logging t
@@ -138,7 +136,6 @@ This variable is buffer local. Setting it via \\[customize] sets the
default value.
Log files are stored in `erc-log-channels-directory'."
- :group 'erc-log
:type '(choice boolean
function))
(make-variable-buffer-local 'erc-enable-logging)
@@ -153,14 +150,12 @@ If this is the name of a function, the function will be called
with the buffer, target, nick, server, and port arguments. See
`erc-generate-log-file-name-function' for a description of these
arguments."
- :group 'erc-log
:type '(choice directory
(function "Function")
(const :tag "Disable logging" nil)))
(defcustom erc-log-insert-log-on-open nil
"Insert log file contents into the buffer if a log file exists."
- :group 'erc-log
:type 'boolean)
(defcustom erc-save-buffer-on-part t
@@ -168,7 +163,6 @@ arguments."
If you set this to nil, you may want to enable both
`erc-log-write-after-send' and `erc-log-write-after-insert'."
- :group 'erc-log
:type 'boolean)
(defcustom erc-save-queries-on-quit t
@@ -176,7 +170,6 @@ If you set this to nil, you may want to enable both
If you set this to nil, you may want to enable both
`erc-log-write-after-send' and `erc-log-write-after-insert'."
- :group 'erc-log
:type 'boolean)
(defcustom erc-log-write-after-send nil
@@ -184,7 +177,6 @@ If you set this to nil, you may want to enable both
If you set this to nil, you may want to enable both
`erc-save-buffer-on-part' and `erc-save-queries-on-quit'."
- :group 'erc-log
:type 'boolean)
(defcustom erc-log-write-after-insert nil
@@ -193,7 +185,6 @@ logged ERC buffer.
If you set this to nil, you may want to enable both
`erc-save-buffer-on-part' and `erc-save-queries-on-quit'."
- :group 'erc-log
:type 'boolean)
(defcustom erc-log-file-coding-system 'emacs-mule
@@ -201,15 +192,13 @@ If you set this to nil, you may want to enable both
This should ideally, be a \"catch-all\" coding system, like
`emacs-mule', or `iso-2022-7bit'."
- :type 'coding-system
- :group 'erc-log)
+ :type 'coding-system)
(defcustom erc-log-filter-function nil
"If non-nil, pass text through the given function before writing it to
a log file.
The function should take one argument, which is the text to filter."
- :group 'erc-log
:type '(choice (function "Function")
(const :tag "No filtering" nil)))
@@ -232,31 +221,31 @@ also be a predicate function. To only log when you are not set away, use:
(null (erc-away-time)))))"
;; enable
((when erc-log-write-after-insert
- (add-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs))
+ (add-hook 'erc-insert-post-hook #'erc-save-buffer-in-logs))
(when erc-log-write-after-send
- (add-hook 'erc-send-post-hook 'erc-save-buffer-in-logs))
- (add-hook 'erc-kill-buffer-hook 'erc-save-buffer-in-logs)
- (add-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs)
- (add-hook 'kill-emacs-hook 'erc-log-save-all-buffers)
- (add-hook 'erc-quit-hook 'erc-conditional-save-queries)
- (add-hook 'erc-part-hook 'erc-conditional-save-buffer)
+ (add-hook 'erc-send-post-hook #'erc-save-buffer-in-logs))
+ (add-hook 'erc-kill-buffer-hook #'erc-save-buffer-in-logs)
+ (add-hook 'erc-kill-channel-hook #'erc-save-buffer-in-logs)
+ (add-hook 'kill-emacs-hook #'erc-log-save-all-buffers)
+ (add-hook 'erc-quit-hook #'erc-conditional-save-queries)
+ (add-hook 'erc-part-hook #'erc-conditional-save-buffer)
;; append, so that 'erc-initialize-log-marker runs first
- (add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append)
+ (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append)
(dolist (buffer (erc-buffer-list))
(erc-log-setup-logging buffer)))
;; disable
- ((remove-hook 'erc-insert-post-hook 'erc-save-buffer-in-logs)
- (remove-hook 'erc-send-post-hook 'erc-save-buffer-in-logs)
- (remove-hook 'erc-kill-buffer-hook 'erc-save-buffer-in-logs)
- (remove-hook 'erc-kill-channel-hook 'erc-save-buffer-in-logs)
- (remove-hook 'kill-emacs-hook 'erc-log-save-all-buffers)
- (remove-hook 'erc-quit-hook 'erc-conditional-save-queries)
- (remove-hook 'erc-part-hook 'erc-conditional-save-buffer)
- (remove-hook 'erc-connect-pre-hook 'erc-log-setup-logging)
+ ((remove-hook 'erc-insert-post-hook #'erc-save-buffer-in-logs)
+ (remove-hook 'erc-send-post-hook #'erc-save-buffer-in-logs)
+ (remove-hook 'erc-kill-buffer-hook #'erc-save-buffer-in-logs)
+ (remove-hook 'erc-kill-channel-hook #'erc-save-buffer-in-logs)
+ (remove-hook 'kill-emacs-hook #'erc-log-save-all-buffers)
+ (remove-hook 'erc-quit-hook #'erc-conditional-save-queries)
+ (remove-hook 'erc-part-hook #'erc-conditional-save-buffer)
+ (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging)
(dolist (buffer (erc-buffer-list))
(erc-log-disable-logging buffer))))
-(define-key erc-mode-map "\C-c\C-l" 'erc-save-buffer-in-logs)
+(define-key erc-mode-map "\C-c\C-l" #'erc-save-buffer-in-logs)
;;; functionality referenced from erc.el
(defun erc-log-setup-logging (buffer)
@@ -357,13 +346,13 @@ The result is converted to lowercase, as IRC is case-insensitive."
buffer target nick server port)
erc-log-channels-directory)))))
-(defun erc-generate-log-file-name-with-date (buffer &rest ignore)
+(defun erc-generate-log-file-name-with-date (buffer &rest _ignore)
"This function computes a short log file name.
The name of the log file is composed of BUFFER and the current date.
This function is a possible value for `erc-generate-log-file-name-function'."
(concat (buffer-name buffer) "-" (format-time-string "%Y-%m-%d") ".txt"))
-(defun erc-generate-log-file-name-short (buffer &rest ignore)
+(defun erc-generate-log-file-name-short (buffer &rest _ignore)
"This function computes a short log file name.
In fact, it only uses the buffer name of the BUFFER argument, so
you can affect that using `rename-buffer' and the-like. This
@@ -371,7 +360,7 @@ function is a possible value for
`erc-generate-log-file-name-function'."
(concat (buffer-name buffer) ".txt"))
-(defun erc-generate-log-file-name-long (buffer target nick server port)
+(defun erc-generate-log-file-name-long (_buffer target nick server port)
"Generates a log-file name in the way ERC always did it.
This results in a file name of the form #channel!nick@server:port.txt.
This function is a possible value for `erc-generate-log-file-name-function'."
@@ -385,7 +374,7 @@ This function is a possible value for `erc-generate-log-file-name-function'."
(declare-function erc-network-name "erc-networks" ())
-(defun erc-generate-log-file-name-network (buffer target nick server port)
+(defun erc-generate-log-file-name-network (buffer target nick server _port)
"Generates a log-file name using the network name rather than server name.
This results in a file name of the form #channel!nick@network.txt.
This function is a possible value for `erc-generate-log-file-name-function'."
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 153742a6706..43fbca3e666 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -1,10 +1,10 @@
-;;; erc-match.el --- Highlight messages matching certain regexps
+;;; erc-match.el --- Highlight messages matching certain regexps -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, faces
+;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcMatch
;; This file is part of GNU Emacs.
@@ -52,19 +52,17 @@ they are hidden or highlighted. This is controlled via the variables
`erc-current-nick-highlight-type'. For all these highlighting types,
you can decide whether the entire message or only the sending nick is
highlighted."
- ((add-hook 'erc-insert-modify-hook 'erc-match-message 'append))
- ((remove-hook 'erc-insert-modify-hook 'erc-match-message)))
+ ((add-hook 'erc-insert-modify-hook #'erc-match-message 'append))
+ ((remove-hook 'erc-insert-modify-hook #'erc-match-message)))
;; Remaining customizations
(defcustom erc-pals nil
"List of pals on IRC."
- :group 'erc-match
:type '(repeat regexp))
(defcustom erc-fools nil
"List of fools on IRC."
- :group 'erc-match
:type '(repeat regexp))
(defcustom erc-keywords nil
@@ -72,14 +70,12 @@ highlighted."
Each entry in the list is either a regexp, or a cons cell with the
regexp in the car and the face to use in the cdr. If no face is
specified, `erc-keyword-face' is used."
- :group 'erc-match
:type '(repeat (choice regexp
(list regexp face))))
(defcustom erc-dangerous-hosts nil
"List of regexps for hosts to highlight.
Useful to mark nicks from dangerous hosts."
- :group 'erc-match
:type '(repeat regexp))
(defcustom erc-current-nick-highlight-type 'keyword
@@ -99,7 +95,6 @@ The following values are allowed:
current nickname occurs
Any other value disables highlighting of current nickname altogether."
- :group 'erc-match
:type '(choice (const nil)
(const nick)
(const keyword)
@@ -120,7 +115,6 @@ The following values are allowed:
from pal
Any other value disables pal highlighting altogether."
- :group 'erc-match
:type '(choice (const nil)
(const nick)
(const message)
@@ -139,7 +133,6 @@ The following values are allowed:
from fool
Any other value disables fool highlighting altogether."
- :group 'erc-match
:type '(choice (const nil)
(const nick)
(const message)
@@ -157,7 +150,6 @@ The following values are allowed:
containing keyword
Any other value disables keyword highlighting altogether."
- :group 'erc-match
:type '(choice (const nil)
(const keyword)
(const message)
@@ -175,7 +167,6 @@ The following values are allowed:
from dangerous-host
Any other value disables dangerous-host highlighting altogether."
- :group 'erc-match
:type '(choice (const nil)
(const nick)
(const message)
@@ -193,7 +184,6 @@ Valid match type keys are:
The other element of each cons pair in this list is the buffer name to
use for the logged message."
- :group 'erc-match
:type '(repeat (cons (choice :tag "Key"
(const keyword)
(const pal)
@@ -207,7 +197,6 @@ use for the logged message."
When nil, don't log any matched messages.
When t, log messages.
When `away', log messages only when away."
- :group 'erc-match
:type '(choice (const nil)
(const away)
(const t)))
@@ -222,14 +211,12 @@ will be formatted. The various format specs are:
%u Nickname!user@host of sender
%c Channel in which this was received
%m Message"
- :group 'erc-match
:type 'string)
(defcustom erc-beep-match-types '(current-nick)
"Types of matches to beep for when a match occurs.
The function `erc-beep-on-match' needs to be added to `erc-text-matched-hook'
for beeping to work."
- :group 'erc-match
:type '(choice (repeat :tag "Beep on match" (choice
(const current-nick)
(const keyword)
@@ -244,14 +231,12 @@ Functions in this hook are passed as arguments:
\(match-type nick!user@host message) where MATCH-TYPE is a symbol of:
current-nick, keyword, pal, dangerous-host, fool."
:options '(erc-log-matches erc-hide-fools erc-beep-on-match)
- :group 'erc-match
:type 'hook)
(defcustom erc-match-exclude-server-buffer nil
"If true, don't perform match on the server buffer; this is
useful for excluding all the things like MOTDs from the server
and other miscellaneous functions."
- :group 'erc-match
:version "24.3"
:type 'boolean)
@@ -390,7 +375,7 @@ car is the string."
(interactive)
(erc-remove-entry-from-list 'erc-dangerous-hosts "Delete dangerous-host: "))
-(defun erc-match-current-nick-p (nickuserhost msg)
+(defun erc-match-current-nick-p (_nickuserhost msg)
"Check whether the current nickname is in MSG.
NICKUSERHOST will be ignored."
(with-syntax-table erc-match-syntax-table
@@ -400,7 +385,7 @@ NICKUSERHOST will be ignored."
"\\b")
msg))))
-(defun erc-match-pal-p (nickuserhost msg)
+(defun erc-match-pal-p (nickuserhost _msg)
"Check whether NICKUSERHOST is in `erc-pals'.
MSG will be ignored."
(and nickuserhost
@@ -412,7 +397,7 @@ MSG will be ignored."
(or (erc-list-match erc-fools nickuserhost)
(erc-match-directed-at-fool-p msg))))
-(defun erc-match-keyword-p (nickuserhost msg)
+(defun erc-match-keyword-p (_nickuserhost msg)
"Check whether any keyword of `erc-keywords' matches for MSG.
NICKUSERHOST will be ignored."
(and msg
@@ -424,7 +409,7 @@ NICKUSERHOST will be ignored."
erc-keywords)
msg)))
-(defun erc-match-dangerous-host-p (nickuserhost msg)
+(defun erc-match-dangerous-host-p (nickuserhost _msg)
"Check whether NICKUSERHOST is in `erc-dangerous-hosts'.
MSG will be ignored."
(and nickuserhost
@@ -457,7 +442,7 @@ Use this defun with `erc-insert-modify-hook'."
(nickuserhost (erc-get-parsed-vector-nick vector))
(nickname (and nickuserhost
(nth 0 (erc-parse-user nickuserhost))))
- (old-pt (point))
+ ;; (old-pt (point))
(nick-beg (and nickname
(re-search-forward (regexp-quote nickname)
(point-max) t)
@@ -484,11 +469,12 @@ Use this defun with `erc-insert-modify-hook'."
(goto-char (point-min))
(let* ((match-prefix (concat "erc-" match-type))
(match-pred (intern (concat "erc-match-" match-type "-p")))
- (match-htype (eval (intern (concat match-prefix
- "-highlight-type"))))
+ (match-htype (symbol-value (intern (concat match-prefix
+ "-highlight-type"))))
(match-regex (if (string= match-type "current-nick")
(regexp-quote (erc-current-nick))
- (eval (intern (concat match-prefix "s")))))
+ (symbol-value
+ (intern (concat match-prefix "s")))))
(match-face (intern (concat match-prefix "-face"))))
(when (funcall match-pred nickuserhost message)
(cond
@@ -601,7 +587,7 @@ See `erc-log-match-format'."
(kill-buffer buffer)))))
buffer)))
-(defun erc-log-matches-come-back (proc parsed)
+(defun erc-log-matches-come-back (_proc _parsed)
"Display a notice that messages were logged while away."
(when (and (erc-away-time)
(eq erc-log-matches-flag 'away))
@@ -629,7 +615,7 @@ See `erc-log-match-format'."
nil)
; This handler must be run _before_ erc-process-away is.
-(add-hook 'erc-server-305-functions 'erc-log-matches-come-back nil)
+(add-hook 'erc-server-305-functions #'erc-log-matches-come-back nil)
(defun erc-go-to-log-matches-buffer ()
"Interactively open an erc-log-matches buffer."
@@ -642,9 +628,9 @@ See `erc-log-match-format'."
(get-buffer (car buffer-cons))))))
(switch-to-buffer buffer-name)))
-(define-key erc-mode-map "\C-c\C-k" 'erc-go-to-log-matches-buffer)
+(define-key erc-mode-map "\C-c\C-k" #'erc-go-to-log-matches-buffer)
-(defun erc-hide-fools (match-type nickuserhost message)
+(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide foolish comments.
This function should be called from `erc-text-matched-hook'."
(when (eq match-type 'fool)
@@ -652,7 +638,7 @@ This function should be called from `erc-text-matched-hook'."
'(invisible intangible)
(current-buffer))))
-(defun erc-beep-on-match (match-type nickuserhost message)
+(defun erc-beep-on-match (match-type _nickuserhost _message)
"Beep when text matches.
This function is meant to be called from `erc-text-matched-hook'."
(when (member match-type erc-beep-match-types)
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index 4c092c834bc..1bee6ff2a67 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -1,10 +1,10 @@
-;; erc-menu.el -- Menu-bar definitions for ERC
+;;; erc-menu.el --- Menu-bar definitions for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2002, 2004-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes, menu
+;; Keywords: comm, menu
;; This file is part of GNU Emacs.
@@ -28,7 +28,6 @@
;;; Code:
(require 'erc)
-(require 'easymenu)
(defgroup erc-menu nil
"ERC menu support."
@@ -111,11 +110,11 @@ ERC menu yet.")
(define-erc-module menu nil
"Enable a menu in ERC buffers."
((unless erc-menu-defined
- ;; make sure the menu only gets defined once, since Emacs 22
+ ;; make sure the menu only gets defined once, since Emacs
;; activates it immediately
(easy-menu-define erc-menu erc-mode-map "ERC menu" erc-menu-definition)
(setq erc-menu-defined t)))
- (;; `easy-menu-remove' is a no-op in Emacs 22
+ (;; `easy-menu-remove' is a no-op in Emacs
(message "You might have to restart Emacs to remove the ERC menu")))
(defun erc-menu-add ()
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 37fc4cf16c1..9cfb947003c 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -1,4 +1,4 @@
-;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
+;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
@@ -42,30 +42,27 @@ netsplits, so that it can filter the JOIN messages on a netjoin too."
(define-erc-module netsplit nil
"This mode hides quit/join messages if a netsplit occurs."
((erc-netsplit-install-message-catalogs)
- (add-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
- (add-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
- (add-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
- (add-hook 'erc-timer-hook 'erc-netsplit-timer))
- ((remove-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
- (remove-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
- (remove-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
- (remove-hook 'erc-timer-hook 'erc-netsplit-timer)))
+ (add-hook 'erc-server-JOIN-functions #'erc-netsplit-JOIN)
+ (add-hook 'erc-server-MODE-functions #'erc-netsplit-MODE)
+ (add-hook 'erc-server-QUIT-functions #'erc-netsplit-QUIT)
+ (add-hook 'erc-timer-hook #'erc-netsplit-timer))
+ ((remove-hook 'erc-server-JOIN-functions #'erc-netsplit-JOIN)
+ (remove-hook 'erc-server-MODE-functions #'erc-netsplit-MODE)
+ (remove-hook 'erc-server-QUIT-functions #'erc-netsplit-QUIT)
+ (remove-hook 'erc-timer-hook #'erc-netsplit-timer)))
(defcustom erc-netsplit-show-server-mode-changes-flag nil
"Set to t to enable display of server mode changes."
- :group 'erc-netsplit
:type 'boolean)
(defcustom erc-netsplit-debug nil
"If non-nil, debug messages will be shown in the sever buffer."
- :group 'erc-netsplit
:type 'boolean)
(defcustom erc-netsplit-regexp
"^[^ @!\"\n]+\\.[^ @!\n]+ [^ @!\n]+\\.[^ @!\"\n]+$"
"This regular expression should match quit reasons produced
by netsplits."
- :group 'erc-netsplit
:type 'regexp)
(defcustom erc-netsplit-hook nil
@@ -190,13 +187,13 @@ join from that split has been detected or not.")
(erc-display-message
nil 'notice 'active
'netsplit-wholeft ?s (car elt)
- ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ")
+ ?n (mapconcat #'erc-extract-nick (nthcdr 3 elt) " ")
?t (if (nth 2 elt)
"(joining)"
"")))))
t)
-(defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT)
+(defalias 'erc-cmd-WL #'erc-cmd-WHOLEFT)
(provide 'erc-netsplit)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 9926255e3aa..54502b2df05 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1,4 +1,4 @@
-;;; erc-networks.el --- IRC networks
+;;; erc-networks.el --- IRC networks -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004-2021 Free Software Foundation, Inc.
@@ -290,6 +290,13 @@
("LagNet: Random server" LagNet "irc.lagnet.org.za" 6667)
("LagNet: AF, ZA, Cape Town" LagNet "reaper.lagnet.org.za" 6667)
("LagNet: AF, ZA, Johannesburg" LagNet "mystery.lagnet.org.za" 6667)
+ ("Libera.Chat: Random server" Libera.Chat "irc.libera.chat" 6667)
+ ("Libera.Chat: Random Europe server" Libera.Chat "irc.eu.libera.chat" 6667)
+ ("Libera.Chat: Random US & Canada server" Libera.Chat "irc.us.libera.chat" 6667)
+ ("Libera.Chat: Random Australia & New Zealand server" Libera.Chat "irc.au.libera.chat" 6667)
+ ("Libera.Chat: Random East Asia server" Libera.Chat "irc.ea.libera.chat" 6667)
+ ("Libera.Chat: IPv4 only server" Libera.Chat "irc.ipv4.libera.chat" 6667)
+ ("Libera.Chat: IPv6 only server" Libera.Chat "irc.ipv6.libera.chat" 6667)
("Librenet: Random server" Librenet "irc.librenet.net" 6667)
("LinkNet: Random server" LinkNet "irc.link-net.org" ((6667 6669)))
("LinuxChix: Random server" LinuxChix "irc.linuxchix.org" 6667)
@@ -443,7 +450,6 @@ NET is a symbol indicating to which network from `erc-networks-alist'
this server corresponds,
HOST is the servers hostname and
PORTS is either a number, a list of numbers, or a list of port ranges."
- :group 'erc-networks
:type '(alist :key-type (string :tag "Name")
:value-type
(group symbol (string :tag "Hostname")
@@ -595,6 +601,7 @@ PORTS is either a number, a list of numbers, or a list of port ranges."
(Krono "krono.net")
(Krushnet "krushnet.org")
(LagNet "lagnet.org.za")
+ (Libera.Chat "libera.chat")
(Librenet "librenet.net")
(LinkNet "link-net.org")
(LinuxChix "cats\\.meow\\.at\\|linuxchix\\.org")
@@ -714,7 +721,6 @@ MATCHER is used to find a corresponding network to a server while
connected to it. If it is regexp, it's used to match against
`erc-server-announced-name'. It can also be a function (predicate).
Then it is executed with the server buffer as current-buffer."
- :group 'erc-networks
:type '(repeat
(list :tag "Network"
(symbol :tag "Network name")
@@ -762,25 +768,25 @@ Return the name of this server's network as a symbol."
"Return the name of the current network as a string."
(erc-with-server-buffer (symbol-name erc-network)))
-(defun erc-set-network-name (proc parsed)
+(defun erc-set-network-name (_proc _parsed)
"Set `erc-network' to the value returned by `erc-determine-network'."
(unless erc-server-connected
(setq erc-network (erc-determine-network)))
nil)
-(defun erc-unset-network-name (nick ip reason)
+(defun erc-unset-network-name (_nick _ip _reason)
"Set `erc-network' to nil."
(setq erc-network nil)
nil)
(define-erc-module networks nil
"Provide data about IRC networks."
- ((add-hook 'erc-server-375-functions 'erc-set-network-name)
- (add-hook 'erc-server-422-functions 'erc-set-network-name)
- (add-hook 'erc-disconnected-hook 'erc-unset-network-name))
- ((remove-hook 'erc-server-375-functions 'erc-set-network-name)
- (remove-hook 'erc-server-422-functions 'erc-set-network-name)
- (remove-hook 'erc-disconnected-hook 'erc-unset-network-name)))
+ ((add-hook 'erc-server-375-functions #'erc-set-network-name)
+ (add-hook 'erc-server-422-functions #'erc-set-network-name)
+ (add-hook 'erc-disconnected-hook #'erc-unset-network-name))
+ ((remove-hook 'erc-server-375-functions #'erc-set-network-name)
+ (remove-hook 'erc-server-422-functions #'erc-set-network-name)
+ (remove-hook 'erc-disconnected-hook #'erc-unset-network-name)))
(defun erc-ports-list (ports)
"Return a list of PORTS.
@@ -835,8 +841,8 @@ As an example:
;; think it is worth the effort.
(defvar erc-settings
- '((pals freenode ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)"))
- (format-nick-function (freenode "#emacs") erc-format-@nick))
+ '((pals Libera.Chat ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)"))
+ (format-nick-function (Libera.Chat "#emacs") erc-format-@nick))
"Experimental: Alist of configuration options.
The format is (VARNAME SCOPE VALUE) where
VARNAME is a symbol identifying the configuration option,
@@ -865,7 +871,7 @@ VALUE is the options value.")
items nil)))))
val))
-(erc-get 'pals 'freenode)
+(erc-get 'pals 'Libera.Chat)
(provide 'erc-networks)
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index e133e05a7d3..1ed056c277d 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -42,20 +42,17 @@
(defcustom erc-notify-list nil
"List of nicknames you want to be notified about online/offline
status change."
- :group 'erc-notify
:type '(repeat string))
(defcustom erc-notify-interval 60
"Time interval (in seconds) for checking online status of notified
people."
- :group 'erc-notify
:type 'integer)
(defcustom erc-notify-signon-hook nil
"Hook run after someone on `erc-notify-list' has signed on.
Two arguments are passed to the function, SERVER and NICK, both
strings."
- :group 'erc-notify
:type 'hook
:options '(erc-notify-signon))
@@ -63,7 +60,6 @@ strings."
"Hook run after someone on `erc-notify-list' has signed off.
Two arguments are passed to the function, SERVER and NICK, both
strings."
- :group 'erc-notify
:type 'hook
:options '(erc-notify-signoff))
@@ -95,14 +91,14 @@ strings."
(define-erc-module notify nil
"Periodically check for the online status of certain users and report
changes."
- ((add-hook 'erc-timer-hook 'erc-notify-timer)
- (add-hook 'erc-server-JOIN-functions 'erc-notify-JOIN)
- (add-hook 'erc-server-NICK-functions 'erc-notify-NICK)
- (add-hook 'erc-server-QUIT-functions 'erc-notify-QUIT))
- ((remove-hook 'erc-timer-hook 'erc-notify-timer)
- (remove-hook 'erc-server-JOIN-functions 'erc-notify-JOIN)
- (remove-hook 'erc-server-NICK-functions 'erc-notify-NICK)
- (remove-hook 'erc-server-QUIT-functions 'erc-notify-QUIT)))
+ ((add-hook 'erc-timer-hook #'erc-notify-timer)
+ (add-hook 'erc-server-JOIN-functions #'erc-notify-JOIN)
+ (add-hook 'erc-server-NICK-functions #'erc-notify-NICK)
+ (add-hook 'erc-server-QUIT-functions #'erc-notify-QUIT))
+ ((remove-hook 'erc-timer-hook #'erc-notify-timer)
+ (remove-hook 'erc-server-JOIN-functions #'erc-notify-JOIN)
+ (remove-hook 'erc-server-NICK-functions #'erc-notify-NICK)
+ (remove-hook 'erc-server-QUIT-functions #'erc-notify-QUIT)))
;;;; Timer handler
@@ -137,7 +133,7 @@ changes."
(setq erc-last-ison ison-list)
t)))
(erc-server-send
- (concat "ISON " (mapconcat 'identity erc-notify-list " ")))
+ (concat "ISON " (mapconcat #'identity erc-notify-list " ")))
(setq erc-last-ison-time now)))
(defun erc-notify-JOIN (proc parsed)
@@ -211,7 +207,7 @@ with args, toggle notify status of people."
'notify_current ?l ison))))
((string= (car args) "-l")
(erc-display-message nil 'notice 'active
- 'notify_list ?l (mapconcat 'identity erc-notify-list
+ 'notify_list ?l (mapconcat #'identity erc-notify-list
" ")))
(t
(while args
@@ -231,7 +227,7 @@ with args, toggle notify status of people."
(setq args (cdr args)))
(erc-display-message
nil 'notice 'active
- 'notify_list ?l (mapconcat 'identity erc-notify-list " "))))
+ 'notify_list ?l (mapconcat #'identity erc-notify-list " "))))
t)
(autoload 'pcomplete-erc-all-nicks "erc-pcomplete")
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index 0cb60f5efa0..457e8cd4684 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -1,4 +1,4 @@
-;; erc-page.el - CTCP PAGE support for ERC
+;;; erc-page.el --- CTCP PAGE support for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2002, 2004, 2006-2021 Free Software Foundation, Inc.
@@ -30,6 +30,10 @@
(require 'erc)
+(defgroup erc-page nil
+ "React to CTCP PAGE messages."
+ :group 'erc)
+
;;;###autoload(autoload 'erc-page-mode "erc-page")
(define-erc-module page ctcp-page
"Process CTCP PAGE requests from IRC."
@@ -37,10 +41,6 @@
(erc-define-catalog-entry 'english 'CTCP-PAGE "Page from %n (%u@%h): %m")
-(defgroup erc-page nil
- "React to CTCP PAGE messages."
- :group 'erc)
-
(defcustom erc-page-function nil
"A function to process a \"page\" request.
If nil, this prints the page message in the minibuffer and calls
@@ -53,20 +53,18 @@ Example for your init file:
(lambda (sender msg)
(play-sound-file \"/home/alex/elisp/erc/sounds/ni.wav\")
(message \"IRC Page from %s: %s\" sender msg)))"
- :group 'erc-page
:type '(choice (const nil)
(function)))
-(defcustom erc-ctcp-query-PAGE-hook '(erc-ctcp-query-PAGE)
+(defcustom erc-ctcp-query-PAGE-hook (list #'erc-ctcp-query-PAGE)
"List of functions to be called when a CTCP PAGE is received.
This is called from `erc-process-ctcp-query'. The functions are called
with six arguments: PROC NICK LOGIN HOST TO MSG. Note that you can
also set `erc-page-function' to a function, which only gets two arguments,
SENDER and MSG, so that might be easier to use."
- :group 'erc-page
:type '(repeat function))
-(defun erc-ctcp-query-PAGE (proc nick login host to msg)
+(defun erc-ctcp-query-PAGE (_proc nick login host _to msg)
"Deal with an CTCP PAGE query, if `erc-page-mode' is non-nil.
This will call `erc-page-function', if defined, or it will just print
a message and `beep'. In addition to that, the page message is also
@@ -91,7 +89,7 @@ inserted into the server buffer."
nil 'notice nil text)))
nil)
-(defun erc-cmd-PAGE (line &optional force)
+(defun erc-cmd-PAGE (line &optional _force)
"Send a CTCP page to the user given as the first word in LINE.
The rest of LINE is the message to send. Note that you will only
receive pages if `erc-page-mode' is on."
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index ab4c7c580c6..8ea37c7f290 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -1,10 +1,10 @@
-;;; erc-pcomplete.el --- Provides programmable completion for ERC
+;;; erc-pcomplete.el --- Provides programmable completion for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Sacha Chua <sacha@free.net.ph>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, convenience
+;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcCompletion
;; This file is part of GNU Emacs.
@@ -50,23 +50,21 @@
(defcustom erc-pcomplete-nick-postfix ":"
"When `pcomplete' is used in the first word after the prompt,
add this string to nicks completed."
- :group 'erc-pcomplete
:type 'string)
(defcustom erc-pcomplete-order-nickname-completions t
"If t, channel nickname completions will be ordered such that
the most recent speakers are listed first."
- :group 'erc-pcomplete
:type 'boolean)
;;;###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)
- (add-hook 'erc-complete-functions 'erc-pcompletions-at-point)
+ ((add-hook 'erc-mode-hook #'pcomplete-erc-setup)
+ (add-hook 'erc-complete-functions #'erc-pcompletions-at-point)
(erc-buffer-list #'pcomplete-erc-setup))
- ((remove-hook 'erc-mode-hook 'pcomplete-erc-setup)
- (remove-hook 'erc-complete-functions 'erc-pcompletions-at-point)))
+ ((remove-hook 'erc-mode-hook #'pcomplete-erc-setup)
+ (remove-hook 'erc-complete-functions #'erc-pcompletions-at-point)))
(defun erc-pcompletions-at-point ()
"ERC completion data from pcomplete.
@@ -89,7 +87,7 @@ for use on `completion-at-point-function'."
(defun pcomplete-erc-setup ()
"Setup `erc-mode' to use pcomplete."
- (setq-local pcomplete-ignore-case t)
+ (setq-local completion-ignore-case t)
(setq-local pcomplete-use-paring nil)
(setq-local pcomplete-parse-arguments-function
#'pcomplete-erc-parse-arguments)
@@ -154,7 +152,7 @@ for use on `completion-at-point-function'."
(defun pcomplete/erc-mode/NAMES ()
(while (pcomplete-here (pcomplete-erc-channels))))
-(defalias 'pcomplete/erc-mode/NOTICE 'pcomplete/erc-mode/MSG)
+(defalias 'pcomplete/erc-mode/NOTICE #'pcomplete/erc-mode/MSG)
(defun pcomplete/erc-mode/OP ()
(while (pcomplete-here (pcomplete-erc-not-ops))))
@@ -162,7 +160,7 @@ for use on `completion-at-point-function'."
(defun pcomplete/erc-mode/PART ()
(pcomplete-here (pcomplete-erc-channels)))
-(defalias 'pcomplete/erc-mode/LEAVE 'pcomplete/erc-mode/PART)
+(defalias 'pcomplete/erc-mode/LEAVE #'pcomplete/erc-mode/PART)
(defun pcomplete/erc-mode/QUERY ()
(pcomplete-here (append (pcomplete-erc-all-nicks)
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 91fafbb6308..3f69c4cb9cc 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -1,4 +1,4 @@
-;; erc-replace.el -- wash and massage messages inserted into the buffer
+;;; erc-replace.el --- wash and massage messages inserted into the buffer -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation,
;; Inc.
@@ -6,7 +6,7 @@
;; Author: Andreas Fuchs <asf@void.at>
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; URL: https://www.emacswiki.org/emacs/ErcReplace
-;; Keywords: IRC, client, Internet
+;; Keywords: comm, IRC, client, Internet
;; This file is part of GNU Emacs.
@@ -49,7 +49,6 @@ expression or a variable, or any sexp, TO can be a string or a
function to call, or any sexp. If a function, it will be called with
one argument, the string to be replaced, and it should return a
replacement string."
- :group 'erc-replace
:type '(repeat (cons :tag "Search & Replace"
(choice :tag "From"
regexp
@@ -68,23 +67,23 @@ It replaces text according to `erc-replace-alist'."
(let ((from (car elt))
(to (cdr elt)))
(unless (stringp from)
- (setq from (eval from)))
+ (setq from (eval from t)))
(while (re-search-forward from nil t)
(cond ((stringp to)
(replace-match to))
- ((and (symbolp to) (fboundp to))
+ ((functionp to)
(replace-match (funcall to (match-string 0))))
(t
- (eval to))))))
+ (eval to t))))))
erc-replace-alist))
;;;###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
- 'erc-replace-insert))
+ #'erc-replace-insert))
((remove-hook 'erc-insert-modify-hook
- 'erc-replace-insert)))
+ #'erc-replace-insert)))
(provide 'erc-replace)
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 71a9f8ef3da..666fd585926 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -1,4 +1,4 @@
-;; erc-ring.el -- Command history handling for erc using ring.el
+;;; erc-ring.el --- Command history handling for erc using ring.el -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
@@ -46,12 +46,12 @@
(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."
- ((add-hook 'erc-pre-send-functions 'erc-add-to-input-ring)
- (define-key erc-mode-map "\M-p" 'erc-previous-command)
- (define-key erc-mode-map "\M-n" 'erc-next-command))
- ((remove-hook 'erc-pre-send-functions 'erc-add-to-input-ring)
- (define-key erc-mode-map "\M-p" 'undefined)
- (define-key erc-mode-map "\M-n" 'undefined)))
+ ((add-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
+ (define-key erc-mode-map "\M-p" #'erc-previous-command)
+ (define-key erc-mode-map "\M-n" #'erc-next-command))
+ ((remove-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
+ (define-key erc-mode-map "\M-p" #'undefined)
+ (define-key erc-mode-map "\M-n" #'undefined)))
(defvar-local erc-input-ring nil "Input ring for erc.")
@@ -69,10 +69,13 @@ Call this function when setting up the mode."
(setq erc-input-ring (make-ring comint-input-ring-size)))
(setq erc-input-ring-index nil))
-(defun erc-add-to-input-ring (state)
- "Add string S to the input ring and reset history position."
+(defun erc-add-to-input-ring (state-or-string)
+ "Add STATE-OR-STRING to input ring and reset history position.
+STATE-OR-STRING should be a string or an erc-input object."
(unless erc-input-ring (erc-input-ring-setup))
- (ring-insert erc-input-ring (erc-input-string state))
+ (ring-insert erc-input-ring (if (erc-input-p state-or-string)
+ (erc-input-string state-or-string)
+ state-or-string)) ; string
(setq erc-input-ring-index nil))
(defun erc-clear-input-ring ()
@@ -101,11 +104,10 @@ containing a password."
;; area, push it on the history ring before moving back through
;; the input history, so it will be there when we return to the
;; front.
- (if (null erc-input-ring-index)
- (when (> (point-max) erc-input-marker)
- (erc-add-to-input-ring (buffer-substring erc-input-marker
- (point-max)))
- (setq erc-input-ring-index 0)))
+ (when (and (null erc-input-ring-index)
+ (> (point-max) erc-input-marker))
+ (erc-add-to-input-ring (erc-user-input))
+ (setq erc-input-ring-index 0))
(setq erc-input-ring-index (if erc-input-ring-index
(ring-plus1 erc-input-ring-index
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 9ef8b7f46ab..61006e0c028 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -30,10 +30,10 @@
;; are made to test if NickServ is the real NickServ for a given network or
;; server.
-;; As a default, ERC has the data for the official nickname services on
-;; the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet, GRnet,
-;; and Slashnet. You can add more by using M-x customize-variable RET
-;; erc-nickserv-alist.
+;; As a default, ERC has the data for the official nickname services
+;; on the networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet,
+;; GRnet, Libera.Chat, and Slashnet. You can add more by using
+;; M-x customize-variable RET erc-nickserv-alist.
;; Usage:
;;
@@ -43,9 +43,10 @@
;; (erc-services-mode 1)
;;
;; Add your nickname and NickServ password to `erc-nickserv-passwords'.
-;; Using the freenode network as an example:
+;; Using the Libera.Chat network as an example:
;;
-;; (setq erc-nickserv-passwords '((freenode (("nickname" "password")))))
+;; (setq erc-nickserv-passwords
+;; '((Libera.Chat (("nickname" "password")))))
;;
;; The default automatic identification mode is autodetection of NickServ
;; identify requests. Set the variable `erc-nickserv-identify-mode' if
@@ -91,7 +92,6 @@ Possible settings are:.
nil - Disables automatic Nickserv identification.
You can also use \\[erc-nickserv-identify-mode] to change modes."
- :group 'erc-services
:type '(choice (const autodetect)
(const nick-change)
(const both)
@@ -107,13 +107,13 @@ You can also use \\[erc-nickserv-identify-mode] to change modes."
"This mode automates communication with services."
((erc-nickserv-identify-mode erc-nickserv-identify-mode))
((remove-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identify-autodetect)
+ #'erc-nickserv-identify-autodetect)
(remove-hook 'erc-after-connect
- 'erc-nickserv-identify-on-connect)
+ #'erc-nickserv-identify-on-connect)
(remove-hook 'erc-nick-changed-functions
- 'erc-nickserv-identify-on-nick-change)
+ #'erc-nickserv-identify-on-nick-change)
(remove-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identification-autodetect)))
+ #'erc-nickserv-identification-autodetect)))
;;;###autoload
(defun erc-nickserv-identify-mode (mode)
@@ -123,7 +123,7 @@ You can also use \\[erc-nickserv-identify-mode] to change modes."
"Choose Nickserv identify mode (RET to disable): "
'(("autodetect") ("nick-change") ("both")) nil t))))
(add-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identification-autodetect)
+ #'erc-nickserv-identification-autodetect)
(unless erc-networks-mode
;; Force-enable networks module, because we need it to set
;; erc-network for us.
@@ -131,41 +131,40 @@ You can also use \\[erc-nickserv-identify-mode] to change modes."
(cond ((eq mode 'autodetect)
(setq erc-nickserv-identify-mode 'autodetect)
(add-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identify-autodetect)
+ #'erc-nickserv-identify-autodetect)
(remove-hook 'erc-nick-changed-functions
- 'erc-nickserv-identify-on-nick-change)
+ #'erc-nickserv-identify-on-nick-change)
(remove-hook 'erc-after-connect
- 'erc-nickserv-identify-on-connect))
+ #'erc-nickserv-identify-on-connect))
((eq mode 'nick-change)
(setq erc-nickserv-identify-mode 'nick-change)
(add-hook 'erc-after-connect
- 'erc-nickserv-identify-on-connect)
+ #'erc-nickserv-identify-on-connect)
(add-hook 'erc-nick-changed-functions
- 'erc-nickserv-identify-on-nick-change)
+ #'erc-nickserv-identify-on-nick-change)
(remove-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identify-autodetect))
+ #'erc-nickserv-identify-autodetect))
((eq mode 'both)
(setq erc-nickserv-identify-mode 'both)
(add-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identify-autodetect)
+ #'erc-nickserv-identify-autodetect)
(add-hook 'erc-after-connect
- 'erc-nickserv-identify-on-connect)
+ #'erc-nickserv-identify-on-connect)
(add-hook 'erc-nick-changed-functions
- 'erc-nickserv-identify-on-nick-change))
+ #'erc-nickserv-identify-on-nick-change))
(t
(setq erc-nickserv-identify-mode nil)
(remove-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identify-autodetect)
+ #'erc-nickserv-identify-autodetect)
(remove-hook 'erc-after-connect
- 'erc-nickserv-identify-on-connect)
+ #'erc-nickserv-identify-on-connect)
(remove-hook 'erc-nick-changed-functions
- 'erc-nickserv-identify-on-nick-change)
+ #'erc-nickserv-identify-on-nick-change)
(remove-hook 'erc-server-NOTICE-functions
- 'erc-nickserv-identification-autodetect))))
+ #'erc-nickserv-identification-autodetect))))
(defcustom erc-prompt-for-nickserv-password t
"Ask for the password when identifying to NickServ."
- :group 'erc-services
:type 'boolean)
(defcustom erc-use-auth-source-for-nickserv-password nil
@@ -174,7 +173,6 @@ This option has an no effect if `erc-prompt-for-nickserv-password'
is non-nil, and passwords from `erc-nickserv-passwords' take
precedence."
:version "28.1"
- :group 'erc-services
:type 'boolean)
(defcustom erc-nickserv-passwords nil
@@ -184,10 +182,9 @@ passwords to be used.
Example of use:
(setq erc-nickserv-passwords
- \\='((freenode ((\"nick-one\" . \"password\")
- (\"nick-two\" . \"password\")))
+ \\='((Libera.Chat ((\"nick-one\" . \"password\")
+ (\"nick-two\" . \"password\")))
(DALnet ((\"nick\" . \"password\")))))"
- :group 'erc-services
:type '(repeat
(list :tag "Network"
(choice :tag "Network name"
@@ -201,6 +198,7 @@ Example of use:
(const GalaxyNet)
(const GRnet)
(const iip)
+ (const Libera.Chat)
(const OFTC)
(const QuakeNet)
(const Rizon)
@@ -268,6 +266,15 @@ Example of use:
"type\\s-/squery\\s-Trent\\s-identify\\s-<password>"
"Trent@anon.iip"
"IDENTIFY" nil "SQUERY" nil)
+ (Libera.Chat
+ "NickServ!NickServ@services.libera.chat"
+ ;; Libera.Chat also accepts a password at login, see the `erc'
+ ;; :password argument.
+ "This\\s-nickname\\s-is\\s-registered.\\s-Please\\s-choose"
+ "NickServ"
+ "IDENTIFY" nil nil
+ ;; See also the 901 response code message.
+ "You\\s-are\\s-now\\s-identified\\s-for\\s-")
(OFTC
"NickServ!services@services.oftc.net"
;; OFTC's NickServ doesn't ask you to identify anymore.
@@ -305,7 +312,6 @@ ANSWER is the command to use for the answer. The default is `privmsg'.
SUCCESS-REGEXP is a regular expression matching the message nickserv
sends when you've successfully identified.
The last two elements are optional."
- :group 'erc-services
:type '(repeat
(list :tag "Nickserv data"
(symbol :tag "Network name")
@@ -357,7 +363,6 @@ The last two elements are optional."
(defcustom erc-nickserv-identified-hook nil
"Run this hook when NickServ acknowledged successful identification.
Hooks are called with arguments (NETWORK NICK)."
- :group 'erc-services
:type 'hook)
(defun erc-nickserv-identification-autodetect (_proc parsed)
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index edde9737ff9..92759d206a3 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -1,4 +1,4 @@
-;;; erc-sound.el --- CTCP SOUND support for ERC
+;;; erc-sound.el --- CTCP SOUND support for ERC -*- lexical-binding: t -*-
;; Copyright (C) 2002-2003, 2006-2021 Free Software Foundation, Inc.
@@ -52,11 +52,11 @@
"In ERC sound mode, the client will respond to CTCP SOUND requests
and play sound files as requested."
;; Enable:
- ((add-hook 'erc-ctcp-query-SOUND-hook 'erc-ctcp-query-SOUND)
- (define-key erc-mode-map "\C-c\C-s" 'erc-toggle-sound))
+ ((add-hook 'erc-ctcp-query-SOUND-hook #'erc-ctcp-query-SOUND)
+ (define-key erc-mode-map "\C-c\C-s" #'erc-toggle-sound))
;; Disable:
- ((remove-hook 'erc-ctcp-query-SOUND-hook 'erc-ctcp-query-SOUND)
- (define-key erc-mode-map "\C-c\C-s" 'undefined)))
+ ((remove-hook 'erc-ctcp-query-SOUND-hook #'erc-ctcp-query-SOUND)
+ (define-key erc-mode-map "\C-c\C-s" #'undefined)))
(erc-define-catalog-entry 'english 'CTCP-SOUND "%n (%u@%h) plays %s:%m")
@@ -66,18 +66,15 @@ and play sound files as requested."
(defcustom erc-play-sound t
"Play sounds when you receive CTCP SOUND requests."
- :group 'erc-sound
:type 'boolean)
(defcustom erc-sound-path nil
"List of directories that contain sound samples to play on SOUND events."
- :group 'erc-sound
:type '(repeat directory))
(defcustom erc-default-sound nil
"Play this sound if the requested file was not found.
If this is set to nil or the file doesn't exist a beep will sound."
- :group 'erc-sound
:type '(choice (const nil)
file))
@@ -108,7 +105,7 @@ LINE is the text entered, including the command."
t))
(t nil)))
-(defun erc-ctcp-query-SOUND (proc nick login host to msg)
+(defun erc-ctcp-query-SOUND (_proc nick login host _to msg)
"Display a CTCP SOUND message and play sound if `erc-play-sound' is non-nil."
(when (string-match "^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg)
(let ((sound (match-string 1 msg))
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index c2be23990f1..e61e741302d 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -1,4 +1,4 @@
-;;; erc-speedbar.el --- Speedbar support for ERC
+;;; erc-speedbar.el --- Speedbar support for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2004, 2006-2021 Free Software Foundation, Inc.
@@ -52,7 +52,6 @@
`activity' - Sort users by channel activity
`alphabetical' - Sort users alphabetically
nil - Do not sort users"
- :group 'erc-speedbar
:type '(choice (const :tag "Sort users by channel activity" activity)
(const :tag "Sort users alphabetically" alphabetical)
(const :tag "Do not sort users" nil)))
@@ -67,11 +66,11 @@ nil - Do not sort users"
(setq erc-speedbar-key-map (speedbar-make-specialized-keymap))
;; Basic tree features
- (define-key erc-speedbar-key-map "e" 'speedbar-edit-line)
- (define-key erc-speedbar-key-map "\C-m" 'speedbar-edit-line)
- (define-key erc-speedbar-key-map "+" 'speedbar-expand-line)
- (define-key erc-speedbar-key-map "=" 'speedbar-expand-line)
- (define-key erc-speedbar-key-map "-" 'speedbar-contract-line))
+ (define-key erc-speedbar-key-map "e" #'speedbar-edit-line)
+ (define-key erc-speedbar-key-map "\C-m" #'speedbar-edit-line)
+ (define-key erc-speedbar-key-map "+" #'speedbar-expand-line)
+ (define-key erc-speedbar-key-map "=" #'speedbar-expand-line)
+ (define-key erc-speedbar-key-map "-" #'speedbar-contract-line))
(speedbar-add-expansion-list '("ERC" erc-speedbar-menu-items
erc-speedbar-key-map
@@ -124,7 +123,7 @@ This will add a speedbar major display mode."
(erc-speedbar-insert-target buffer 0))
(t (ignore)))))
-(defun erc-speedbar-server-buttons (directory depth)
+(defun erc-speedbar-server-buttons (_directory depth)
"Insert the initial list of servers you are connected to."
(let ((servers (erc-buffer-list
(lambda ()
@@ -140,7 +139,7 @@ This will add a speedbar major display mode."
t))))
(defun erc-speedbar-expand-server (text server indent)
- (cond ((string-match "\\+" text)
+ (cond ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(if (speedbar-with-writable
(save-excursion
@@ -148,13 +147,13 @@ This will add a speedbar major display mode."
(erc-speedbar-channel-buttons nil (1+ indent) server)))
(speedbar-change-expand-button-char ?-)
(speedbar-change-expand-button-char ??)))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defun erc-speedbar-channel-buttons (directory depth server-buffer)
+(defun erc-speedbar-channel-buttons (_directory depth server-buffer)
(when (get-buffer server-buffer)
(let* ((proc (with-current-buffer server-buffer erc-server-process))
(targets (erc-buffer-list
@@ -185,13 +184,13 @@ This will add a speedbar major display mode."
"For the line matching TEXT, in CHANNEL, expand or contract a line.
INDENT is the current indentation level."
(cond
- ((string-match "\\+" text)
+ ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(let ((modes (with-current-buffer channel
- (concat (apply 'concat
+ (concat (apply #'concat
erc-channel-modes)
(cond
((and erc-channel-user-limit
@@ -234,7 +233,7 @@ INDENT is the current indentation level."
(speedbar-with-writable
(dolist (entry names)
(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
- ((string-match "-" text)
+ ((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -285,7 +284,7 @@ The update is only done when the channel is actually expanded already."
(erc-speedbar-expand-channel "+" buffer 1)))))
(defun erc-speedbar-expand-user (text token indent)
- (cond ((string-match "\\+" text)
+ (cond ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -308,13 +307,13 @@ The update is only done when the channel is actually expanded already."
nil nil nil nil
info nil nil nil
(1+ indent)))))))
- ((string-match "-" text)
+ ((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defun erc-speedbar-goto-buffer (text buffer indent)
+(defun erc-speedbar-goto-buffer (_text buffer _indent)
"When user clicks on TEXT, goto an ERC buffer.
The INDENT level is ignored."
(if (featurep 'dframe)
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index 44a3e358812..950a821e3c4 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -1,10 +1,10 @@
-;;; erc-spelling.el --- use flyspell in ERC
+;;; erc-spelling.el --- use flyspell in ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: irc
+;; Keywords: comm, irc
;; URL: https://www.emacswiki.org/emacs/ErcSpelling
;; This file is part of GNU Emacs.
@@ -38,10 +38,10 @@
"Enable flyspell mode in ERC buffers."
;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is
;; called AFTER the server buffer is initialized.
- ((add-hook 'erc-connect-pre-hook 'erc-spelling-init)
+ ((add-hook 'erc-connect-pre-hook #'erc-spelling-init)
(dolist (buffer (erc-buffer-list))
(erc-spelling-init buffer)))
- ((remove-hook 'erc-connect-pre-hook 'erc-spelling-init)
+ ((remove-hook 'erc-connect-pre-hook #'erc-spelling-init)
(dolist (buffer (erc-buffer-list))
(with-current-buffer buffer (flyspell-mode 0)))))
@@ -104,7 +104,7 @@ The cadr is the beginning and the caddr is the end."
(put 'erc-mode
'flyspell-mode-predicate
- 'erc-spelling-flyspell-verify)
+ #'erc-spelling-flyspell-verify)
(provide 'erc-spelling)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 2c42a18081e..dde2556ddb7 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes, timestamp
+;; Keywords: comm, timestamp
;; URL: https://www.emacswiki.org/emacs/ErcStamp
;; This file is part of GNU Emacs.
@@ -52,7 +52,6 @@ This string is processed using `format-time-string'.
Good examples are \"%T\" and \"%H:%M\".
If nil, timestamping is turned off."
- :group 'erc-stamp
:type '(choice (const nil)
(string)))
@@ -66,7 +65,6 @@ screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
If nil, timestamping is turned off."
- :group 'erc-stamp
:type '(choice (const nil)
(string)))
@@ -80,7 +78,6 @@ screen when `erc-insert-timestamp-function' is set to
`erc-insert-timestamp-left-and-right'.
If nil, timestamping is turned off."
- :group 'erc-stamp
:type '(choice (const nil)
(string)))
@@ -95,7 +92,6 @@ operate on.
You will probably want to set
`erc-insert-away-timestamp-function' to the same value."
- :group 'erc-stamp
:type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right)
(const :tag "Right" erc-insert-timestamp-right)
(const :tag "Left" erc-insert-timestamp-left)
@@ -108,7 +104,6 @@ If nil, timestamping is turned off when away unless `erc-timestamp-format'
is set.
If `erc-timestamp-format' is set, this will not be used."
- :group 'erc-stamp
:type '(choice (const nil)
(string)))
@@ -117,7 +112,6 @@ If `erc-timestamp-format' is set, this will not be used."
"Function to use to insert the away timestamp.
See `erc-insert-timestamp-function' for details."
- :group 'erc-stamp
:type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right)
(const :tag "Right" erc-insert-timestamp-right)
(const :tag "Left" erc-insert-timestamp-left)
@@ -128,7 +122,6 @@ See `erc-insert-timestamp-function' for details."
This is useful for logging, because, although timestamps will be
hidden, they will still be present in the logs."
- :group 'erc-stamp
:type 'boolean)
(defcustom erc-echo-timestamps nil
@@ -136,20 +129,17 @@ hidden, they will still be present in the logs."
Using this variable, you can turn off normal timestamping,
and simply move point to an irc message to see its timestamp
printed in the minibuffer."
- :group 'erc-stamp
:type 'boolean)
(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
"Format string to be used when `erc-echo-timestamps' is non-nil.
This string specifies the format of the timestamp being echoed in
the minibuffer."
- :group 'erc-stamp
:type 'string)
(defcustom erc-timestamp-intangible nil
"Whether the timestamps should be intangible, i.e. prevent the point
from entering them and instead jump over them."
- :group 'erc-stamp
:version "24.5"
:type 'boolean)
@@ -191,6 +181,11 @@ or `erc-send-modify-hook'."
(list (lambda (_window _before dir)
(erc-echo-timestamp dir ct))))))))
+(defvar-local erc-timestamp-last-window-width nil
+ "Stores the width of the last window that showed the current
+buffer. This is used by `erc-insert-timestamp-right' when the
+current buffer is not shown in any window.")
+
(defvar-local erc-timestamp-last-inserted nil
"Last timestamp inserted into the buffer.")
@@ -211,7 +206,6 @@ string of spaces which is the same size as the timestamp is added to
the beginning of the line in its place. If you use
`erc-insert-timestamp-right', nothing gets inserted in place of the
timestamp."
- :group 'erc-stamp
:type 'boolean)
(defcustom erc-timestamp-right-column nil
@@ -219,7 +213,6 @@ timestamp."
if the timestamp is to be printed to the right. If nil,
`erc-insert-timestamp-right' will use other means to determine
the correct column."
- :group 'erc-stamp
:type '(choice
(integer :tag "Column number")
(const :tag "Unspecified" nil)))
@@ -231,7 +224,6 @@ Asian language characters and math symbols) precede a timestamp.
A side effect of enabling this is that there will only be one
space before a right timestamp in any saved logs."
- :group 'erc-stamp
:type 'boolean)
(defun erc-insert-timestamp-left (string)
@@ -263,27 +255,32 @@ property to get to the POSth column."
(defun erc-insert-timestamp-right (string)
"Insert timestamp on the right side of the screen.
-STRING is the timestamp to insert. The function is a possible value
-for `erc-insert-timestamp-function'.
-
-If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
-printed. If this variable is non-nil, a timestamp is only printed if
-it is different from the last.
-
-If `erc-timestamp-right-column' is set, its value will be used as the
-column at which the timestamp is to be printed. If it is nil, and
-`erc-fill-mode' is active, then the timestamp will be printed just
-before `erc-fill-column'. Otherwise, if the current buffer is
-shown in a window, that window's width is used. If the buffer is
-not shown, and `fill-column' is set, then the timestamp will be
-printed just `fill-column'. As a last resort, the timestamp will
-be printed just before the window-width."
+STRING is the timestamp to insert. This function is a possible
+value for `erc-insert-timestamp-function'.
+
+If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is
+always printed. If this variable is non-nil, a timestamp is only
+printed if it is different from the last.
+
+If `erc-timestamp-right-column' is set, its value will be used as
+the column at which the timestamp is to be printed. If it is
+nil, and `erc-fill-mode' is active, then the timestamp will be
+printed just before `erc-fill-column'. Otherwise, if the current
+buffer is shown in a window, that window's width is used as the
+right boundary. In case multiple windows show the buffer, the
+width of the most recently selected one is used. If the buffer
+is not shown, the timestamp will be printed just before the
+window width of the last window that showed it. If the buffer
+was never shown, and `fill-column' is set, it will be printed
+just before `fill-column'. As a last resort, timestamp will be
+printed just after each line's text (no alignment)."
(unless (and erc-timestamp-only-if-changed-flag
(string-equal string erc-timestamp-last-inserted))
(setq erc-timestamp-last-inserted string)
(goto-char (point-max))
- (forward-char -1);; before the last newline
+ (forward-char -1) ; before the last newline
(let* ((str-width (string-width string))
+ window ; used in computation of `pos' only
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
((and (boundp 'erc-fill-mode)
@@ -291,10 +288,15 @@ be printed just before the window-width."
(boundp 'erc-fill-column)
erc-fill-column)
(1+ (- erc-fill-column str-width)))
+ ((setq window (get-buffer-window nil t))
+ (setq erc-timestamp-last-window-width
+ (window-width window))
+ (- erc-timestamp-last-window-width str-width))
+ (erc-timestamp-last-window-width
+ (- erc-timestamp-last-window-width str-width))
(fill-column
(1+ (- fill-column str-width)))
- (t
- (- (window-width) str-width 1))))
+ (t (current-column))))
(from (point))
(col (current-column)))
;; The following is a kludge used to calculate whether to move
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index ff51026088a..a75a74bb6fd 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -1,4 +1,4 @@
-;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC
+;;; erc-status-sidebar.el --- HexChat-like activity overview for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2017, 2020-2021 Free Software Foundation, Inc.
@@ -58,36 +58,30 @@
(defcustom erc-status-sidebar-buffer-name "*ERC Status*"
"Name of the sidebar buffer."
- :type 'string
- :group 'erc-status-sidebar)
+ :type 'string)
(defcustom erc-status-sidebar-mode-line-format "ERC Status"
"Mode line format for the status sidebar."
- :type 'string
- :group 'erc-status-sidebar)
+ :type 'string)
(defcustom erc-status-sidebar-header-line-format nil
"Header line format for the status sidebar."
:type '(choice (const :tag "No header line" nil)
- string)
- :group 'erc-status-sidebar)
+ string))
(defcustom erc-status-sidebar-width 15
"Default width of the sidebar (in columns)."
- :type 'number
- :group 'erc-status-sidebar)
+ :type 'number)
(defcustom erc-status-sidebar-channel-sort
'erc-status-sidebar-default-chansort
"Sorting function used to determine order of channels in the sidebar."
- :type 'function
- :group 'erc-status-sidebar)
+ :type 'function)
(defcustom erc-status-sidebar-channel-format
'erc-status-sidebar-default-chan-format
"Function used to format channel names for display in the sidebar."
- :type 'function
- :group 'erc-status-sidebar)
+ :type 'function)
(defun erc-status-sidebar-display-window ()
"Display the status buffer in a side window. Return the new window."
@@ -152,7 +146,8 @@ containing it on the current frame is closed. See
(save-excursion
(let ((sidebar-exists (erc-status-sidebar-buffer-exists-p))
(sidebar-buffer (erc-status-sidebar-get-buffer))
- (sidebar-window (erc-status-sidebar-get-window)))
+ ;; (sidebar-window (erc-status-sidebar-get-window))
+ )
(unless sidebar-exists
(with-current-buffer sidebar-buffer
(erc-status-sidebar-mode)
@@ -253,7 +248,7 @@ name stand out."
erc-disconnected-hook
erc-quit-hook))
-(defun erc-status-sidebar--post-refresh (&rest ignore)
+(defun erc-status-sidebar--post-refresh (&rest _ignore)
"Schedule sidebar refresh for execution after command stack is cleared.
Ignore arguments in IGNORE, allowing this function to be added to
@@ -276,7 +271,7 @@ to the `window-configuration-change-hook'."
(when (and (eq (selected-window) (erc-status-sidebar-get-window))
(fboundp 'window-preserve-size))
(unless (eq (window-total-width) (window-min-size nil t))
- (apply 'window-preserve-size (selected-window) t t nil))))
+ (apply #'window-preserve-size (selected-window) t t nil))))
(define-derived-mode erc-status-sidebar-mode special-mode "ERC Sidebar"
"Major mode for ERC status sidebar"
@@ -298,8 +293,7 @@ to the `window-configuration-change-hook'."
;; erc-status-sidebar-mode initialization code, so it won't undo the
;; add-hook's we did in the previous expressions.
(add-hook 'change-major-mode-hook #'erc-status-sidebar-mode--unhook nil t)
- (add-hook 'kill-buffer-hook #'erc-status-sidebar-mode--unhook nil t)
- :group 'erc-status-sidebar)
+ (add-hook 'kill-buffer-hook #'erc-status-sidebar-mode--unhook nil t))
(provide 'erc-status-sidebar)
;;; erc-status-sidebar.el ends here
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index d6ad847c5b9..2364d45d6f3 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -4,7 +4,7 @@
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, faces
+;; Keywords: comm
;; URL: https://www.emacswiki.org/emacs/ErcChannelTracking
;; This file is part of GNU Emacs.
@@ -60,7 +60,6 @@ The reason for using this default value is to both (1) adhere to
the Emacs development guidelines which say not to touch keys of
the form C-c C-<something> and also (2) to meet the expectations
of long-time ERC users, many of whom rely on these keybindings."
- :group 'erc-track
:type '(choice (const :tag "Ask, if used already" ask)
(const :tag "Enable" t)
(const :tag "Disable" nil)))
@@ -80,7 +79,6 @@ nil - only the selected frame
selected-visible - only the selected frame if it is visible
Activity means that there was no user input in the last 10 seconds."
- :group 'erc-track
:type '(choice (const :tag "All frames" t)
(const :tag "All visible frames" visible)
(const :tag "Only the selected frame" nil)
@@ -89,13 +87,11 @@ Activity means that there was no user input in the last 10 seconds."
(defcustom erc-track-exclude nil
"A list targets (channel names or query targets) which should not be tracked."
- :group 'erc-track
:type '(repeat string))
(defcustom erc-track-remove-disconnected-buffers nil
"If true, remove buffers associated with a server that is
disconnected from `erc-modified-channels-alist'."
- :group 'erc-track
:type 'boolean)
(defcustom erc-track-exclude-types '("NICK" "333" "353")
@@ -105,25 +101,21 @@ This list could look like (\"JOIN\" \"PART\").
By default, exclude changes of nicknames (NICK), display of who
set the channel topic (333), and listing of users on the current
channel (353)."
- :group 'erc-track
:type 'erc-message-type)
(defcustom erc-track-exclude-server-buffer nil
"If true, don't perform tracking on the server buffer; this is
useful for excluding all the things like MOTDs from the server and
other miscellaneous functions."
- :group 'erc-track
:type 'boolean)
(defcustom erc-track-shorten-start 1
"This number specifies the minimum number of characters a channel name in
the mode-line should be reduced to."
- :group 'erc-track
:type 'number)
(defcustom erc-track-shorten-cutoff 4
"All channel names longer than this value will be shortened."
- :group 'erc-track
:type 'number)
(defcustom erc-track-shorten-aggressively nil
@@ -144,7 +136,6 @@ not compared to #electronica -- only to #vi, therefore it can be shortened
even more and the result is #e and #v.
This setting is used by `erc-track-shorten-names'."
- :group 'erc-track
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t)
(const :tag "Max" max)))
@@ -154,7 +145,6 @@ This setting is used by `erc-track-shorten-names'."
It takes one argument, CHANNEL-NAMES which is a list of strings.
It should return a list of strings of the same number of elements.
If nil instead of a function, shortening is disabled."
- :group 'erc-track
:type '(choice (const :tag "Disabled")
function))
@@ -165,14 +155,12 @@ If nil instead of a function, shortening is disabled."
This is useful for people that don't use the default mode-line
notification but instead use a separate mechanism to provide
notification of channel activity."
- :group 'erc-track
:type 'hook)
(defcustom erc-track-use-faces t
"Use faces in the mode-line.
The faces used are the same as used for text in the buffers.
\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
- :group 'erc-track
:type 'boolean)
(defcustom erc-track-faces-priority-list
@@ -199,7 +187,6 @@ The faces used are the same as used for text in the buffers.
"A list of faces used to highlight active buffer names in the mode line.
If a message contains one of the faces in this list, the buffer name will
be highlighted using that face. The first matching face is used."
- :group 'erc-track
:type '(repeat (choice face
(repeat :tag "Combination" face))))
@@ -214,7 +201,6 @@ this feature.
Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
setting this variable might not be very useful."
- :group 'erc-track
:type '(choice (const nil)
(repeat string)
(const all)))
@@ -237,21 +223,17 @@ message. This gives a rough indication that active conversations
are occurring in these channels.
The effect may be disabled by setting this variable to nil."
- :group 'erc-track
:type '(repeat (choice face
(repeat :tag "Combination" face))))
(defcustom erc-track-position-in-mode-line 'before-modes
"Where to show modified channel information in the mode-line.
-Setting this variable only has effect in GNU Emacs versions above 21.3.
-
Choices are:
`before-modes' - add to the beginning of `mode-line-modes',
`after-modes' - add to the end of `mode-line-modes',
t - add to the end of `global-mode-string',
nil - don't add to mode line."
- :group 'erc-track
:type '(choice (const :tag "Just before mode information" before-modes)
(const :tag "Just after mode information" after-modes)
(const :tag "After all other information" t)
@@ -268,7 +250,7 @@ nil - don't add to mode line."
(if strings
(concat (if (eq erc-track-position-in-mode-line 'after-modes)
"[" " [")
- (mapconcat 'identity (nreverse strings) ",")
+ (mapconcat #'identity (nreverse strings) ",")
(if (eq erc-track-position-in-mode-line 'before-modes)
"] " "]"))
""))
@@ -291,20 +273,17 @@ while the buffer was not visible.")
(defcustom erc-track-showcount nil
"If non-nil, count of unseen messages will be shown for each channel."
- :type 'boolean
- :group 'erc-track)
+ :type 'boolean)
(defcustom erc-track-showcount-string ":"
"The string to display between buffer name and the count in the mode line.
The default is a colon, resulting in \"#emacs:9\"."
- :type 'string
- :group 'erc-track)
+ :type 'string)
(defcustom erc-track-switch-from-erc t
"If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer
when there are no more active channels."
- :type 'boolean
- :group 'erc-track)
+ :type 'boolean)
(defcustom erc-track-switch-direction 'oldest
"Direction `erc-track-switch-buffer' should switch.
@@ -318,7 +297,6 @@ when there are no more active channels."
If set to `importance', the importance is determined by position
in `erc-track-faces-priority-list', where first is most
important."
- :group 'erc-track
:type '(choice (const importance)
(const oldest)
(const newest)
@@ -474,9 +452,9 @@ START is the minimum length of the name used."
(defvar erc-track-minor-mode-map (make-sparse-keymap)
"Keymap for rcirc track minor mode.")
-(define-key erc-track-minor-mode-map (kbd "C-c C-@") 'erc-track-switch-buffer)
+(define-key erc-track-minor-mode-map (kbd "C-c C-@") #'erc-track-switch-buffer)
(define-key erc-track-minor-mode-map (kbd "C-c C-SPC")
- 'erc-track-switch-buffer)
+ #'erc-track-switch-buffer)
;;;###autoload
(define-minor-mode erc-track-minor-mode
@@ -486,11 +464,7 @@ 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."
- :init-value nil
- :lighter ""
- :keymap erc-track-minor-mode-map
- :global t
- :group 'erc-track)
+ :global t)
(defun erc-track-minor-mode-maybe (&optional buffer)
"Enable `erc-track-minor-mode', depending on `erc-track-enable-keybindings'."
@@ -532,17 +506,17 @@ keybindings will not do anything useful."
((when (boundp 'erc-track-when-inactive)
(if erc-track-when-inactive
(progn
- (add-hook 'window-configuration-change-hook 'erc-user-is-active)
- (add-hook 'erc-send-completed-hook 'erc-user-is-active)
- (add-hook 'erc-server-001-functions 'erc-user-is-active))
+ (add-hook 'window-configuration-change-hook #'erc-user-is-active)
+ (add-hook 'erc-send-completed-hook #'erc-user-is-active)
+ (add-hook 'erc-server-001-functions #'erc-user-is-active))
(erc-track-add-to-mode-line erc-track-position-in-mode-line)
(erc-update-mode-line)
(add-hook 'window-configuration-change-hook
- 'erc-window-configuration-change)
- (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
- (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
+ #'erc-window-configuration-change)
+ (add-hook 'erc-insert-post-hook #'erc-track-modified-channels)
+ (add-hook 'erc-disconnected-hook #'erc-modified-channels-update))
;; enable the tracking keybindings
- (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
+ (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
(erc-track-minor-mode-maybe)))
;; Disable:
((when (boundp 'erc-track-when-inactive)
@@ -550,23 +524,22 @@ keybindings will not do anything useful."
(if erc-track-when-inactive
(progn
(remove-hook 'window-configuration-change-hook
- 'erc-user-is-active)
- (remove-hook 'erc-send-completed-hook 'erc-user-is-active)
- (remove-hook 'erc-server-001-functions 'erc-user-is-active)
- (remove-hook 'erc-timer-hook 'erc-user-is-active))
+ #'erc-user-is-active)
+ (remove-hook 'erc-send-completed-hook #'erc-user-is-active)
+ (remove-hook 'erc-server-001-functions #'erc-user-is-active)
+ (remove-hook 'erc-timer-hook #'erc-user-is-active))
(remove-hook 'window-configuration-change-hook
- 'erc-window-configuration-change)
- (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
- (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
+ #'erc-window-configuration-change)
+ (remove-hook 'erc-disconnected-hook #'erc-modified-channels-update)
+ (remove-hook 'erc-insert-post-hook #'erc-track-modified-channels))
;; disable the tracking keybindings
- (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
+ (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
(when erc-track-minor-mode
(erc-track-minor-mode -1)))))
(defcustom erc-track-when-inactive nil
"Enable channel tracking even for visible buffers, if you are
inactive."
- :group 'erc-track
:type 'boolean
:set (lambda (sym val)
(if erc-track-mode
@@ -707,12 +680,12 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
;; four lists we use to create a new
;; `erc-modified-channels-object' using
;; `erc-make-mode-line-buffer-name'.
- (let* ((buffers (mapcar 'car erc-modified-channels-alist))
- (counts (mapcar 'cadr erc-modified-channels-alist))
- (faces (mapcar 'cddr erc-modified-channels-alist))
- (long-names (mapcar #'(lambda (buf)
- (or (buffer-name buf)
- ""))
+ (let* ((buffers (mapcar #'car erc-modified-channels-alist))
+ (counts (mapcar #'cadr erc-modified-channels-alist))
+ (faces (mapcar #'cddr erc-modified-channels-alist))
+ (long-names (mapcar (lambda (buf)
+ (or (buffer-name buf)
+ ""))
buffers))
(short-names (if (functionp erc-track-shorten-function)
(funcall erc-track-shorten-function
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index f4514ca1371..ff33fbc5570 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -1,4 +1,4 @@
-;;; erc-truncate.el --- Functions for truncating ERC buffers
+;;; erc-truncate.el --- Functions for truncating ERC buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
@@ -41,7 +41,6 @@
"Maximum size in chars of each ERC buffer.
Used only when auto-truncation is enabled.
\(see `erc-truncate-buffer' and `erc-insert-post-hook')."
- :group 'erc-truncate
:type 'integer)
;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t)
@@ -51,9 +50,9 @@ This prevents the query buffer from getting too large, which can
bring any grown Emacs to its knees after a few days worth of
tracking heavy-traffic channels."
;;enable
- ((add-hook 'erc-insert-post-hook 'erc-truncate-buffer))
+ ((add-hook 'erc-insert-post-hook #'erc-truncate-buffer))
;; disable
- ((remove-hook 'erc-insert-post-hook 'erc-truncate-buffer)))
+ ((remove-hook 'erc-insert-post-hook #'erc-truncate-buffer)))
;;;###autoload
(defun erc-truncate-buffer-to-size (size &optional buffer)
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index 6808f24911d..e1b9f0de3a7 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -1,10 +1,10 @@
-;;; erc-xdcc.el --- XDCC file-server support for ERC
+;;; erc-xdcc.el --- XDCC file-server support for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Maintainer: Amin Bandali <bandali@gnu.org>
-;; Keywords: comm, processes
+;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -51,7 +51,7 @@ Your friends should issue \"/ctcp yournick XDCC list\" to see this."
(defcustom erc-xdcc-help-text
'(("Hey " nick ", wondering how this works? Pretty easy.")
("Available commands: XDCC ["
- (mapconcat 'car erc-xdcc-handler-alist "|") "]")
+ (mapconcat #'car erc-xdcc-handler-alist "|") "]")
("Type \"/ctcp " (erc-current-nick)
" XDCC list\" to see the list of offered files, then type \"/ctcp "
(erc-current-nick) " XDCC send #\" to get a particular file number."))
@@ -82,7 +82,7 @@ being evaluated and should return strings."
(defvar erc-ctcp-query-XDCC-hook '(erc-xdcc)
"Hook called whenever a CTCP XDCC message is received.")
-(defun erc-xdcc (proc nick login host to query)
+(defun erc-xdcc (proc nick login host _to query)
"Handle incoming CTCP XDCC queries."
(when erc-xdcc-verbose-flag
(erc-display-message nil 'notice proc
@@ -96,15 +96,15 @@ being evaluated and should return strings."
(format "Unknown XDCC sub-command, try \"/ctcp %s XDCC help\""
(erc-current-nick))))))
-(defun erc-xdcc-help (proc nick login host args)
+(defun erc-xdcc-help (proc nick _login _host _args)
"Send basic help information to NICK."
(mapc
(lambda (msg)
(erc-xdcc-reply proc nick
- (mapconcat (lambda (elt) (if (stringp elt) elt (eval elt))) msg "")))
+ (mapconcat (lambda (elt) (if (stringp elt) elt (eval elt t))) msg "")))
erc-xdcc-help-text))
-(defun erc-xdcc-list (proc nick login host args)
+(defun erc-xdcc-list (proc nick _login _host _args)
"Show the contents of `erc-xdcc-files' via privmsg to NICK."
(if (null erc-xdcc-files)
(erc-xdcc-reply proc nick "No files offered, sorry")
@@ -117,7 +117,7 @@ being evaluated and should return strings."
(setq n (1+ n))
(erc-dcc-file-to-name file)))))))
-(defun erc-xdcc-send (proc nick login host args)
+(defun erc-xdcc-send (proc nick _login _host args)
"Send a file to NICK."
(let ((n (string-to-number (car args)))
(len (length erc-xdcc-files)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index dd7f50fb381..73202016ba7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1,4 +1,4 @@
-;; erc.el --- An Emacs Internet Relay Chat client -*- lexical-binding:t -*-
+;;; erc.el --- An Emacs Internet Relay Chat client -*- lexical-binding:t -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -9,6 +9,7 @@
;; Andreas Fuchs (afs@void.at)
;; Gergely Nagy (algernon@midgard.debian.net)
;; David Edmondson (dme@dme.org)
+;; Michael Olson (mwolson@gnu.org)
;; Kelvin White (kwhite@gnu.org)
;; Maintainer: Amin Bandali <bandali@gnu.org>
;; Keywords: IRC, chat, client, Internet
@@ -47,11 +48,12 @@
;;
;; M-x erc RET
;;
-;; After you are connected to a server, you can use C-h m or have a look at
-;; the ERC menu.
-
-;;; History:
+;; or
+;;
+;; M-x erc-tls RET
;;
+;; to connect over TLS (encrypted). Once you are connected to a
+;; server, you can use C-h m or have a look at the ERC menu.
;;; Code:
@@ -114,17 +116,6 @@
"Running scripts at startup and with /LOAD"
:group 'erc)
-;; compatibility with older ERC releases
-
-(define-obsolete-variable-alias 'erc-announced-server-name
- 'erc-server-announced-name "ERC 5.1")
-(define-obsolete-variable-alias 'erc-process 'erc-server-process "ERC 5.1")
-(define-obsolete-variable-alias 'erc-default-coding-system
- 'erc-server-coding-system "ERC 5.1")
-
-(define-obsolete-function-alias 'erc-send-command
- 'erc-server-send "ERC 5.1")
-
(require 'erc-backend)
;; tunable connection and authentication parameters
@@ -256,7 +247,7 @@ A typical value would be \(\"JOIN\" \"PART\" \"QUIT\")."
(defcustom erc-network-hide-list nil
"A list of IRC networks to hide message types from.
-A typical value would be \((\"freenode\" \"MODE\")
+A typical value would be \((\"Libera.Chat\" \"MODE\")
\(\"OFTC\" \"JOIN\" \"QUIT\"))."
:version "25.1"
:group 'erc-ignore
@@ -1144,31 +1135,31 @@ which the local user typed."
(defvar erc-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-m" 'erc-send-current-line)
- (define-key map "\C-a" 'erc-bol)
- (define-key map [home] 'erc-bol)
- (define-key map "\C-c\C-a" 'erc-bol)
- (define-key map "\C-c\C-b" 'erc-switch-to-buffer)
- (define-key map "\C-c\C-c" 'erc-toggle-interpret-controls)
- (define-key map "\C-c\C-d" 'erc-input-action)
- (define-key map "\C-c\C-e" 'erc-toggle-ctcp-autoresponse)
- (define-key map "\C-c\C-f" 'erc-toggle-flood-control)
- (define-key map "\C-c\C-i" 'erc-invite-only-mode)
- (define-key map "\C-c\C-j" 'erc-join-channel)
- (define-key map "\C-c\C-n" 'erc-channel-names)
- (define-key map "\C-c\C-o" 'erc-get-channel-mode-from-keypress)
- (define-key map "\C-c\C-p" 'erc-part-from-channel)
- (define-key map "\C-c\C-q" 'erc-quit-server)
- (define-key map "\C-c\C-r" 'erc-remove-text-properties-region)
- (define-key map "\C-c\C-t" 'erc-set-topic)
- (define-key map "\C-c\C-u" 'erc-kill-input)
- (define-key map "\C-c\C-x" 'erc-quit-server)
- (define-key map "\M-\t" 'ispell-complete-word)
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\C-m" #'erc-send-current-line)
+ (define-key map "\C-a" #'erc-bol)
+ (define-key map [home] #'erc-bol)
+ (define-key map "\C-c\C-a" #'erc-bol)
+ (define-key map "\C-c\C-b" #'erc-switch-to-buffer)
+ (define-key map "\C-c\C-c" #'erc-toggle-interpret-controls)
+ (define-key map "\C-c\C-d" #'erc-input-action)
+ (define-key map "\C-c\C-e" #'erc-toggle-ctcp-autoresponse)
+ (define-key map "\C-c\C-f" #'erc-toggle-flood-control)
+ (define-key map "\C-c\C-i" #'erc-invite-only-mode)
+ (define-key map "\C-c\C-j" #'erc-join-channel)
+ (define-key map "\C-c\C-n" #'erc-channel-names)
+ (define-key map "\C-c\C-o" #'erc-get-channel-mode-from-keypress)
+ (define-key map "\C-c\C-p" #'erc-part-from-channel)
+ (define-key map "\C-c\C-q" #'erc-quit-server)
+ (define-key map "\C-c\C-r" #'erc-remove-text-properties-region)
+ (define-key map "\C-c\C-t" #'erc-set-topic)
+ (define-key map "\C-c\C-u" #'erc-kill-input)
+ (define-key map "\C-c\C-x" #'erc-quit-server)
+ (define-key map "\M-\t" #'ispell-complete-word)
+ (define-key map "\t" #'completion-at-point)
;; Suppress `font-lock-fontify-block' key binding since it
;; destroys face properties.
- (define-key map [remap font-lock-fontify-block] 'undefined)
+ (define-key map [remap font-lock-fontify-block] #'undefined)
map)
"ERC keymap.")
@@ -1303,7 +1294,9 @@ With a prefix argument ARG, enable %s if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
%s" name name doc)
- nil nil nil
+ ;; FIXME: We don't know if this group exists, so this `:group' may
+ ;; actually just silence a valid warning about the fact that the var
+ ;; is not associated with any group.
:global ,(not local-p) :group (quote ,group)
(if ,mode
(,enable)
@@ -1324,12 +1317,10 @@ if ARG is omitted or nil.
,@disable-body)
,(when (and alias (not (eq name alias)))
`(defalias
- (quote
- ,(intern
+ ',(intern
(format "erc-%s-mode"
- (downcase (symbol-name alias)))))
- (quote
- ,mode)))
+ (downcase (symbol-name alias))))
+ #',mode))
;; For find-function and find-variable.
(put ',mode 'definition-name ',name)
(put ',enable 'definition-name ',name)
@@ -1489,7 +1480,7 @@ Defaults to the server buffer."
;; activation
-(defconst erc-default-server "chat.freenode.net"
+(defconst erc-default-server "irc.libera.chat"
"IRC server to use if it cannot be detected otherwise.")
(defconst erc-default-port 6667
@@ -1756,7 +1747,7 @@ nil."
(ignore res)
res)))
-(define-obsolete-function-alias 'erc-iswitchb 'erc-switch-to-buffer "25.1")
+(define-obsolete-function-alias 'erc-iswitchb #'erc-switch-to-buffer "25.1")
(defun erc--switch-to-buffer (&optional arg)
(read-buffer "Switch to ERC buffer: "
(when (boundp 'erc-modified-channels-alist)
@@ -1865,7 +1856,7 @@ removed from the list will be disabled."
:get (lambda (sym)
;; replace outdated names with their newer equivalents
(erc-migrate-modules (symbol-value sym)))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val)
;; disable modules which have just been removed
(when (and (boundp 'erc-modules) erc-modules val)
@@ -1981,7 +1972,8 @@ removed from the list will be disabled."
(switch-to-buffer buffer)))))
(defun erc-open (&optional server port nick full-name
- connect passwd tgt-list channel process)
+ connect passwd tgt-list channel process
+ client-certificate)
"Connect to SERVER on PORT as NICK with FULL-NAME.
If CONNECT is non-nil, connect to the server. Otherwise assume
@@ -1991,6 +1983,13 @@ target CHANNEL.
Use PASSWD as user password on the server. If TGT-LIST is
non-nil, use it to initialize `erc-default-recipients'.
+CLIENT-CERTIFICATE, if non-nil, should either be a list where the
+first element is the file name of the private key corresponding
+to a client certificate and the second element is the file name
+of the client certificate itself to use when connecting over TLS,
+or t, which means that `auth-source' will be queried for the
+private key and the certificate.
+
Returns the buffer for the given server or channel."
(let ((server-announced-name (when (and (boundp 'erc-session-server)
(string= server erc-session-server))
@@ -2073,6 +2072,8 @@ Returns the buffer for the given server or channel."
(if (functionp secret)
(funcall secret)
secret))))
+ ;; client certificate (only useful if connecting over TLS)
+ (setq erc-session-client-certificate client-certificate)
;; debug output buffer
(setq erc-dbuf
(when erc-log-p
@@ -2093,7 +2094,10 @@ Returns the buffer for the given server or channel."
(run-hook-with-args 'erc-connect-pre-hook buffer)
(when connect
- (erc-server-connect erc-session-server erc-session-port buffer))
+ (erc-server-connect erc-session-server
+ erc-session-port
+ buffer
+ erc-session-client-certificate))
(erc-update-mode-line)
;; Now display the buffer in a window as per user wishes.
@@ -2136,33 +2140,34 @@ If no buffer matches, return nil."
(erc-current-nick-p nick)))))
(defcustom erc-before-connect nil
- "Hook called before connecting to a server.
-This hook gets executed before `erc' actually invokes `erc-mode'
-with your input data. The functions in here get called with three
-parameters, SERVER, PORT and NICK."
+ "Functions called before connecting to a server.
+The functions in this variable gets executed before `erc'
+actually invokes `erc-mode' with your input data. The functions
+in here get called with three parameters, SERVER, PORT and NICK."
:group 'erc-hooks
- :type 'hook)
+ :type '(repeat function))
(defcustom erc-after-connect nil
- "Hook called after connecting to a server.
-This hook gets executed when an end of MOTD has been received. All
-functions in here get called with the parameters SERVER and NICK."
+ "Functions called after connecting to a server.
+This functions in this variable gets executed when an end of MOTD
+has been received. All functions in here get called with the
+parameters SERVER and NICK."
:group 'erc-hooks
- :type 'hook)
+ :type '(repeat function))
;;;###autoload
(defun erc-select-read-args ()
"Prompt the user for values of nick, server, port, and password."
(let (user-input server port nick passwd)
- (setq user-input (read-from-minibuffer
+ (setq user-input (read-string
"IRC server: "
- (erc-compute-server) nil nil 'erc-server-history-list))
+ (erc-compute-server) 'erc-server-history-list))
(if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
(setq port (erc-string-to-port (match-string 2 user-input))
user-input (match-string 1 user-input))
(setq port
- (erc-string-to-port (read-from-minibuffer
+ (erc-string-to-port (read-string
"IRC port: " (erc-port-to-string
(erc-compute-port))))))
@@ -2171,13 +2176,12 @@ functions in here get called with the parameters SERVER and NICK."
user-input (match-string 2 user-input))
(setq nick
(if (erc-already-logged-in server port nick)
- (read-from-minibuffer
+ (read-string
(erc-format-message 'nick-in-use ?n nick)
- nick
- nil nil 'erc-nick-history-list)
- (read-from-minibuffer
+ nick 'erc-nick-history-list)
+ (read-string
"Nickname: " (erc-compute-nick nick)
- nil nil 'erc-nick-history-list))))
+ 'erc-nick-history-list))))
(setq server user-input)
@@ -2196,10 +2200,9 @@ functions in here get called with the parameters SERVER and NICK."
;; bnc with the same nick. actually it would be nice to have
;; bncs transparent, so that erc-compute-buffer-name displays
;; the server one is connected to.
- (setq nick (read-from-minibuffer
+ (setq nick (read-string
(erc-format-message 'nick-in-use ?n nick)
- nick
- nil nil 'erc-nick-history-list)))
+ nick 'erc-nick-history-list)))
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
@@ -2211,45 +2214,90 @@ functions in here get called with the parameters SERVER and NICK."
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
-It permits you to select connection parameters, and then starts ERC.
+It allows selecting connection parameters, and then starts ERC.
Non-interactively, it takes the keyword arguments
(server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
password
- (full-name (erc-compute-full-name)))
+ (full-name (erc-compute-full-name))
That is, if called with
- (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\")
+ (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-then the server and full-name will be set to those values, whereas
-`erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
-be invoked for the values of the other parameters."
+then the server and full-name will be set to those values,
+whereas `erc-compute-port' and `erc-compute-nick' will be invoked
+for the values of the other parameters."
(interactive (erc-select-read-args))
(erc-open server port nick full-name t password))
;;;###autoload
-(defalias 'erc-select 'erc)
-(defalias 'erc-ssl 'erc-tls)
+(defalias 'erc-select #'erc)
+(defalias 'erc-ssl #'erc-tls)
;;;###autoload
-(defun erc-tls (&rest r)
- "Interactively select TLS connection parameters and run ERC.
-Arguments are the same as for `erc'."
+(cl-defun erc-tls (&key (server (erc-compute-server))
+ (port (erc-compute-port))
+ (nick (erc-compute-nick))
+ password
+ (full-name (erc-compute-full-name))
+ client-certificate)
+ "ERC is a powerful, modular, and extensible IRC client.
+This function is the main entry point for ERC over TLS.
+
+It allows selecting connection parameters, and then starts ERC
+over TLS.
+
+Non-interactively, it takes the keyword arguments
+ (server (erc-compute-server))
+ (port (erc-compute-port))
+ (nick (erc-compute-nick))
+ password
+ (full-name (erc-compute-full-name))
+ client-certificate
+
+That is, if called with
+
+ (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
+
+then the server and full-name will be set to those values,
+whereas `erc-compute-port' and `erc-compute-nick' will be invoked
+for the values of their respective parameters.
+
+CLIENT-CERTIFICATE, if non-nil, should either be a list where the
+first element is the certificate key file name, and the second
+element is the certificate file name itself, or t, which means
+that `auth-source' will be queried for the key and the
+certificate. Authenticating using a TLS client certificate is
+also refered to as \"CertFP\" (Certificate Fingerprint)
+authentication by various IRC networks.
+
+Example usage:
+
+ (erc-tls :server \"irc.libera.chat\" :port 6697
+ :client-certificate
+ '(\"/home/bandali/my-cert.key\"
+ \"/home/bandali/my-cert.crt\"))"
(interactive (let ((erc-default-port erc-default-port-tls))
(erc-select-read-args)))
(let ((erc-server-connect-function 'erc-open-tls-stream))
- (apply #'erc r)))
+ (erc-open server port nick full-name t password
+ nil nil nil client-certificate)))
-(defun erc-open-tls-stream (name buffer host port)
+(defun erc-open-tls-stream (name buffer host port &rest parameters)
"Open an TLS stream to an IRC server.
-The process will be given the name NAME, its target buffer will be
-BUFFER. HOST and PORT specify the connection target."
- (open-network-stream name buffer host port
- :nowait t
- :type 'tls))
+The process will be given the name NAME, its target buffer will
+be BUFFER. HOST and PORT specify the connection target.
+PARAMETERS should be a sequence of keywords and values, per
+`open-network-stream'."
+ (let ((p (plist-put parameters :type 'tls))
+ args)
+ (unless (plist-member p :nowait)
+ (setq p (plist-put p :nowait t)))
+ (setq args `(,name ,buffer ,host ,port ,@p))
+ (apply #'open-network-stream args)))
;;; Displaying error messages
@@ -2335,7 +2383,7 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(use-local-map (make-sparse-keymap))
(local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
(add-hook 'kill-buffer-hook
- #'(lambda () (setq erc-debug-irc-protocol nil))
+ (lambda () (setq erc-debug-irc-protocol nil))
nil 'local)
(goto-char (point-max))
(let ((inhibit-read-only t))
@@ -2853,14 +2901,14 @@ VALUE is computed by evaluating the rest of LINE in Lisp."
(val (read (match-string 2 line))))
(if (boundp var)
(progn
- (set var (eval val))
+ (set var (eval val t))
(erc-display-message
nil nil 'active (format "Set %S to %S" var val))
t)
(setq var (read (match-string 1 line)))
(if (boundp var)
(progn
- (set var (eval val))
+ (set var (eval val t))
(erc-display-message
nil nil 'active (format "Set %S to %S" var val))
t)
@@ -2882,8 +2930,8 @@ VALUE is computed by evaluating the rest of LINE in Lisp."
(current-buffer))
t)
(t nil)))
-(defalias 'erc-cmd-VAR 'erc-cmd-SET)
-(defalias 'erc-cmd-VARIABLE 'erc-cmd-SET)
+(defalias 'erc-cmd-VAR #'erc-cmd-SET)
+(defalias 'erc-cmd-VARIABLE #'erc-cmd-SET)
(put 'erc-cmd-SET 'do-not-parse-args t)
(put 'erc-cmd-SET 'process-not-needed t)
@@ -2959,9 +3007,9 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(if (null (erc-with-server-buffer erc-ignore-list))
(erc-display-line (erc-make-notice "Ignore list is empty") 'active)
(erc-display-line (erc-make-notice "Ignore list:") 'active)
- (mapc #'(lambda (item)
- (erc-display-line (erc-make-notice item)
- 'active))
+ (mapc (lambda (item)
+ (erc-display-line (erc-make-notice item)
+ 'active))
(erc-with-server-buffer erc-ignore-list))))
t)
@@ -3011,7 +3059,7 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(car user-data))
ops)))))
erc-channel-users))
- (setq ops (sort ops 'string-lessp))
+ (setq ops (sort ops #'string-lessp))
(if ops
(erc-display-message
nil 'notice (current-buffer) 'ops
@@ -3110,7 +3158,7 @@ For a list of user commands (/join /part, ...):
(message "Type C-h m to get additional information about keybindings.")
t))
-(defalias 'erc-cmd-H 'erc-cmd-HELP)
+(defalias 'erc-cmd-H #'erc-cmd-HELP)
(put 'erc-cmd-HELP 'process-not-needed t)
(defun erc-server-join-channel (server channel &optional secret)
@@ -3143,8 +3191,8 @@ were most recently invited. See also `invitation'."
(when chnl
;; Prevent double joining of same channel on same server.
(let* ((joined-channels
- (mapcar #'(lambda (chanbuf)
- (with-current-buffer chanbuf (erc-default-target)))
+ (mapcar (lambda (chanbuf)
+ (with-current-buffer chanbuf (erc-default-target)))
(erc-channel-list erc-server-process)))
(server (with-current-buffer (process-buffer erc-server-process)
(or erc-session-server erc-server-announced-name)))
@@ -3156,8 +3204,8 @@ were most recently invited. See also `invitation'."
(erc-server-join-channel server chnl key)))))
t)
-(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
-(defalias 'erc-cmd-J 'erc-cmd-JOIN)
+(defalias 'erc-cmd-CHANNEL #'erc-cmd-JOIN)
+(defalias 'erc-cmd-J #'erc-cmd-JOIN)
(defvar-local erc-channel-new-member-names nil
"If non-nil, a names list is currently being received.
@@ -3181,7 +3229,7 @@ command."
(erc-server-send (concat "NAMES " tgt)))
(erc-display-message nil 'error (current-buffer) 'no-default-channel)))
t)
-(defalias 'erc-cmd-N 'erc-cmd-NAMES)
+(defalias 'erc-cmd-N #'erc-cmd-NAMES)
(defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
"Kick the user indicated in LINE from the current channel.
@@ -3251,7 +3299,7 @@ If SERVER is non-nil, use that, rather than the current server."
(erc-log (format "cmd: %s" send))
(erc-server-send send)
t))
-(defalias 'erc-cmd-WI 'erc-cmd-WHOIS)
+(defalias 'erc-cmd-WI #'erc-cmd-WHOIS)
(defun erc-cmd-WHOAMI ()
"Display whois information about yourself."
@@ -3399,8 +3447,9 @@ to send.
If only one word is given, display the mode of that target.
-A list of valid mode strings for Freenode may be found at
-URL `http://freenode.net/using_the_network.shtml'."
+A list of valid mode strings for Libera.Chat may be found at
+`https://libera.chat/guides/channelmodes' and
+`https://libera.chat/guides/usermodes'."
(cond
((string-match "^\\s-\\(.*\\)$" line)
(let ((s (match-string 1 line)))
@@ -3422,7 +3471,7 @@ The rest is the message to send."
The rest of LINE is the message to send."
(erc-message "PRIVMSG" line))
-(defalias 'erc-cmd-M 'erc-cmd-MSG)
+(defalias 'erc-cmd-M #'erc-cmd-MSG)
(put 'erc-cmd-MSG 'do-not-parse-args t)
(defun erc-cmd-SQUERY (line)
@@ -3477,7 +3526,7 @@ Otherwise leave the channel indicated by LINE."
(t nil)))
(put 'erc-cmd-PART 'do-not-parse-args t)
-(defalias 'erc-cmd-LEAVE 'erc-cmd-PART)
+(defalias 'erc-cmd-LEAVE #'erc-cmd-PART)
(defun erc-cmd-PING (recipient)
"Ping RECIPIENT."
@@ -3521,7 +3570,7 @@ The type of query window/frame/etc will depend on the value of
If USER is omitted, close the current query buffer if one exists
- except this is broken now ;-)"
(interactive
- (list (read-from-minibuffer "Start a query with: " nil)))
+ (list (read-string "Start a query with: ")))
(let ((session-buffer (erc-server-buffer))
(erc-join-buffer erc-query-display))
(if user
@@ -3529,7 +3578,7 @@ If USER is omitted, close the current query buffer if one exists
;; currently broken, evil hack to display help anyway
;(erc-delete-query))))
(signal 'wrong-number-of-arguments ""))))
-(defalias 'erc-cmd-Q 'erc-cmd-QUERY)
+(defalias 'erc-cmd-Q #'erc-cmd-QUERY)
(defun erc-quit/part-reason-default ()
"Default quit/part message."
@@ -3548,7 +3597,7 @@ If S is non-nil, it will be used as the quit reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
- (replace-regexp-in-string "\n" "" (yow))
+ (string-replace "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@@ -3575,7 +3624,7 @@ If S is non-nil, it will be used as the part reason."
If S is non-nil, it will be used as the quit reason."
(or s
(if (fboundp 'yow)
- (replace-regexp-in-string "\n" "" (yow))
+ (string-replace "\n" "" (yow))
(erc-quit/part-reason-default))))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@@ -3624,9 +3673,9 @@ the message given by REASON."
t)
(t nil)))
-(defalias 'erc-cmd-BYE 'erc-cmd-QUIT)
-(defalias 'erc-cmd-EXIT 'erc-cmd-QUIT)
-(defalias 'erc-cmd-SIGNOFF 'erc-cmd-QUIT)
+(defalias 'erc-cmd-BYE #'erc-cmd-QUIT)
+(defalias 'erc-cmd-EXIT #'erc-cmd-QUIT)
+(defalias 'erc-cmd-SIGNOFF #'erc-cmd-QUIT)
(put 'erc-cmd-QUIT 'do-not-parse-args t)
(put 'erc-cmd-QUIT 'process-not-needed t)
@@ -3645,7 +3694,7 @@ the message given by REASON."
(kill-buffer buffer)))))
t)
-(defalias 'erc-cmd-GQ 'erc-cmd-GQUIT)
+(defalias 'erc-cmd-GQ #'erc-cmd-GQUIT)
(put 'erc-cmd-GQUIT 'do-not-parse-args t)
(put 'erc-cmd-GQUIT 'process-not-needed t)
@@ -3743,7 +3792,7 @@ the message given by REASON."
(erc-server-send (concat "TIME " args)))
t)
(t (erc-server-send "TIME"))))
-(defalias 'erc-cmd-DATE 'erc-cmd-TIME)
+(defalias 'erc-cmd-DATE #'erc-cmd-TIME)
(defun erc-cmd-TOPIC (topic)
"Set or request the topic for a channel.
@@ -3784,7 +3833,7 @@ be displayed."
(erc-display-message nil 'error (current-buffer) 'no-target)))
t)
(t nil)))
-(defalias 'erc-cmd-T 'erc-cmd-TOPIC)
+(defalias 'erc-cmd-T #'erc-cmd-TOPIC)
(put 'erc-cmd-TOPIC 'do-not-parse-args t)
(defun erc-cmd-APPENDTOPIC (topic)
@@ -3796,7 +3845,7 @@ be displayed."
;; strip trailing ^O
(when (string-match "\\(.*\\)\C-o" oldtopic)
(erc-cmd-TOPIC (concat (match-string 1 oldtopic) topic)))))
-(defalias 'erc-cmd-AT 'erc-cmd-APPENDTOPIC)
+(defalias 'erc-cmd-AT #'erc-cmd-APPENDTOPIC)
(put 'erc-cmd-APPENDTOPIC 'do-not-parse-args t)
(defun erc-cmd-CLEARTOPIC (&optional channel)
@@ -3820,6 +3869,8 @@ The property `received-from-server' indicates whether
or not the ban list has been requested from the server.")
(put 'erc-channel-banlist 'received-from-server nil)
+(defvar erc-fill-column)
+
(defun erc-cmd-BANLIST ()
"Pretty-print the contents of `erc-channel-banlist'.
@@ -3890,7 +3941,7 @@ The ban list is fetched from the server if necessary."
(put 'erc-channel-banlist 'received-from-server nil)))))
t)
-(defalias 'erc-cmd-BL 'erc-cmd-BANLIST)
+(defalias 'erc-cmd-BL #'erc-cmd-BANLIST)
(defun erc-cmd-MASSUNBAN ()
"Mass Unban.
@@ -3932,7 +3983,7 @@ Unban all currently banned users in the current channel."
(erc-group-list bans 3))))
t))))
-(defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN)
+(defalias 'erc-cmd-MUB #'erc-cmd-MASSUNBAN)
;;;; End of IRC commands
@@ -4033,8 +4084,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
"Interactively input a user action and send it to IRC."
(interactive "")
(erc-set-active-buffer (current-buffer))
- (let ((action (read-from-minibuffer
- "Action: " nil nil nil 'erc-action-history-list)))
+ (let ((action (read-string "Action: " nil 'erc-action-history-list)))
(if (not (string-match "^\\s-*$" action))
(erc-send-action (erc-default-target) action))))
@@ -4051,24 +4101,25 @@ If `point' is at the beginning of a channel name, use that as default."
(completing-read (format-prompt "Join channel" chnl)
table nil nil nil nil chnl))
(when (or current-prefix-arg erc-prompt-for-channel-key)
- (read-from-minibuffer "Channel key (RET for none): " nil))))
+ (read-string "Channel key (RET for none): "))))
(erc-cmd-JOIN channel (when (>= (length key) 1) key)))
(defun erc-part-from-channel (reason)
"Part from the current channel and prompt for a REASON."
(interactive
+ ;; FIXME: Has this ever worked? We're in the interactive-spec, so the
+ ;; argument `reason' can't be in scope yet!
+ ;;(if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
+ ;; reason
(list
- (if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
- reason
- (read-from-minibuffer (concat "Reason for leaving " (erc-default-target)
- ": ")))))
+ (read-string (concat "Reason for leaving " (erc-default-target) ": "))))
(erc-cmd-PART (concat (erc-default-target)" " reason)))
(defun erc-set-topic (topic)
"Prompt for a TOPIC for the current channel."
(interactive
(list
- (read-from-minibuffer
+ (read-string
(concat "Set topic of " (erc-default-target) ": ")
(when erc-channel-topic
(let ((ss (split-string erc-channel-topic "\C-o")))
@@ -4080,7 +4131,7 @@ If `point' is at the beginning of a channel name, use that as default."
(defun erc-set-channel-limit (&optional limit)
"Set a LIMIT for the current channel. Remove limit if nil.
Prompt for one if called interactively."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
(format "Limit for %s (RET to remove limit): "
(erc-default-target)))))
(let ((tgt (erc-default-target)))
@@ -4091,7 +4142,7 @@ Prompt for one if called interactively."
(defun erc-set-channel-key (&optional key)
"Set a KEY for the current channel. Remove key if nil.
Prompt for one if called interactively."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
(format "Key for %s (RET to remove key): "
(erc-default-target)))))
(let ((tgt (erc-default-target)))
@@ -4102,7 +4153,7 @@ Prompt for one if called interactively."
(defun erc-quit-server (reason)
"Disconnect from current server after prompting for REASON.
`erc-quit-reason' works with this just like with `erc-cmd-QUIT'."
- (interactive (list (read-from-minibuffer
+ (interactive (list (read-string
(format "Reason for quitting %s: "
(or erc-server-announced-name
erc-session-server)))))
@@ -4133,7 +4184,7 @@ This places `point' just after the prompt, or at the beginning of the line."
(defun erc-complete-word-at-point ()
(run-hook-with-args-until-success 'erc-complete-functions))
-(define-obsolete-function-alias 'erc-complete-word 'completion-at-point "24.1")
+(define-obsolete-function-alias 'erc-complete-word #'completion-at-point "24.1")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -4161,9 +4212,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
(mapconcat
#'identity
(let (res)
- (mapc #'(lambda (x)
- (if (stringp x)
- (setq res (append res (list x)))))
+ (mapc (lambda (x)
+ (if (stringp x)
+ (setq res (append res (list x)))))
parsed)
res)
" ")))
@@ -4551,10 +4602,10 @@ See also: `erc-echo-notice-in-user-buffers',
;; Remove the unbanned masks from the ban list
(setq erc-channel-banlist
(cl-delete-if
- #'(lambda (y)
- (member (upcase (cdr y))
- (mapcar #'upcase
- (cdr (split-string mode)))))
+ (lambda (y)
+ (member (upcase (cdr y))
+ (mapcar #'upcase
+ (cdr (split-string mode)))))
erc-channel-banlist)))
((string-match "^\\+" mode)
;; Add the banned mask(s) to the ban list
@@ -5181,7 +5232,7 @@ TOPIC string to the current topic."
"Sort LIST-OF-STRINGS in lexicographic order.
Side-effect free."
- (sort (copy-sequence list-of-strings) 'string<))
+ (sort (copy-sequence list-of-strings) #'string<))
(defun erc-parse-modes (mode-string)
"Parse MODE-STRING into a list.
@@ -5536,7 +5587,7 @@ This returns non-nil only if we actually send anything."
(when (and (erc-input-sendp state)
erc-send-this)
(let ((string (erc-input-string state)))
- (if (or (string-match "\n" string)
+ (if (or (string-search "\n" string)
(not (string-match erc-command-regexp string)))
(mapc
(lambda (line)
@@ -6118,11 +6169,11 @@ non-nil value is found.
;; time routines
-(define-obsolete-function-alias 'erc-string-to-emacs-time 'string-to-number
+(define-obsolete-function-alias 'erc-string-to-emacs-time #'string-to-number
"27.1")
-(defalias 'erc-emacs-time-to-erc-time 'float-time)
-(defalias 'erc-current-time 'float-time)
+(defalias 'erc-emacs-time-to-erc-time #'float-time)
+(defalias 'erc-current-time #'float-time)
(defun erc-time-diff (t1 t2)
"Return the absolute value of the difference in seconds between T1 and T2."
@@ -6289,7 +6340,6 @@ The following characters are replaced:
(defcustom erc-header-line-format "%n on %t (%m,%l) %o"
"A string to be formatted and shown in the header-line in `erc-mode'.
-Only used starting in Emacs 21.
Set this to nil if you do not want the header line to be
displayed.
@@ -6478,7 +6528,7 @@ if `erc-away' is non-nil."
(fill-region (point-min) (point-max))
(buffer-string))))
(setq header-line-format
- (replace-regexp-in-string
+ (string-replace
"%"
"%%"
(if face
@@ -6754,7 +6804,7 @@ functions."
nick user host channel
(if (not (string= reason ""))
(format ": %s"
- (replace-regexp-in-string "%" "%%" reason))
+ (string-replace "%" "%%" reason))
"")))))
@@ -6905,7 +6955,3 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
(require 'erc-goodies)
;;; erc.el ends here
-;;
-;; Local Variables:
-;; outline-regexp: ";;+"
-;; End:
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 638c0ac230a..cbfe0b81545 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -150,8 +150,8 @@ to writing a completion function."
:type (get 'pcomplete-dir-ignore 'custom-type))
(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
- (eshell-cmpl--custom-variable-docstring 'pcomplete-ignore-case)
- :type (get 'pcomplete-ignore-case 'custom-type))
+ (eshell-cmpl--custom-variable-docstring 'completion-ignore-case)
+ :type (get 'completion-ignore-case 'custom-type))
(defcustom eshell-cmpl-autolist nil
(eshell-cmpl--custom-variable-docstring 'pcomplete-autolist)
@@ -259,7 +259,7 @@ to writing a completion function."
eshell-cmpl-file-ignore)
(setq-local pcomplete-dir-ignore
eshell-cmpl-dir-ignore)
- (setq-local pcomplete-ignore-case
+ (setq-local completion-ignore-case
eshell-cmpl-ignore-case)
(setq-local pcomplete-autolist
eshell-cmpl-autolist)
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index c702ee192a6..ee9057f50e8 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -199,10 +199,10 @@ Thus, this does not include the current directory.")
(when eshell-cd-on-directory
(setq-local eshell-interpreter-alist
- (cons (cons #'(lambda (file _args)
- (eshell-lone-directory-p file))
- 'eshell-dirs-substitute-cd)
- eshell-interpreter-alist)))
+ (cons (cons (lambda (file _args)
+ (eshell-lone-directory-p file))
+ 'eshell-dirs-substitute-cd)
+ eshell-interpreter-alist)))
(add-hook 'eshell-parse-argument-hook
#'eshell-parse-user-reference nil t)
@@ -224,7 +224,7 @@ Thus, this does not include the current directory.")
(add-hook 'eshell-exit-hook #'eshell-write-last-dir-ring nil t)
- (add-hook 'kill-emacs-hook #'eshell-save-some-last-dir))
+ (add-hook 'kill-emacs-query-functions #'eshell-save-some-last-dir))
(defun eshell-save-some-last-dir ()
"Save the list-dir-ring for any open Eshell buffers."
@@ -238,7 +238,8 @@ Thus, this does not include the current directory.")
(format-message
"Save last dir ring for Eshell buffer `%s'? "
(buffer-name buf)))))
- (eshell-write-last-dir-ring))))))
+ (eshell-write-last-dir-ring)))))
+ t)
(defun eshell-lone-directory-p (file)
"Test whether FILE is just a directory name, and not a command name."
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 316094b17e4..e36f2d0c7fe 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -291,7 +291,7 @@ the form:
(let ((index 1))
(setq incl glob)
(while (and (eq incl glob)
- (setq index (string-match "~" glob index)))
+ (setq index (string-search "~" glob index)))
(if (or (get-text-property index 'escaped glob)
(or (= (1+ index) len)))
(setq index (1+ index))
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index b7b1778ebb1..d82946add00 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -293,7 +293,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(add-hook 'eshell-exit-hook #'eshell-write-history nil t)
- (add-hook 'kill-emacs-hook #'eshell-save-some-history)
+ (add-hook 'kill-emacs-query-functions #'eshell-save-some-history)
(add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t))
@@ -310,7 +310,8 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(format-message
"Save input history for Eshell buffer `%s'? "
(buffer-name buf)))))
- (eshell-write-history))))))
+ (eshell-write-history)))))
+ t)
(defun eshell/history (&rest args)
"List in help buffer the buffer's input history."
@@ -379,7 +380,7 @@ input."
(if (eq eshell-hist-ignoredups 'erase)
;; Remove any old occurrences of the input, and put
;; the new one at the end.
- (progn
+ (unless (ring-empty-p eshell-history-ring)
(ring-remove eshell-history-ring
(ring-member eshell-history-ring input))
t)
@@ -758,7 +759,7 @@ matched."
(setq nth (eshell-hist-word-reference nth)))
(unless (numberp mth)
(setq mth (eshell-hist-word-reference mth)))
- (cons (mapconcat #'identity (eshell-sublist textargs nth mth) " ")
+ (cons (mapconcat #'identity (seq-subseq textargs nth (1+ mth)) " ")
end))))
(defun eshell-hist-parse-modifier (hist reference)
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index e942ae26928..3d7c43b404b 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -680,12 +680,12 @@ Each member of FILES is either a string or a cons cell of the form
(let ((f files)
last-f
display-files
- ignore)
+ ) ;; ignore
(while f
(if (cdar f)
(setq last-f f
f (cdr f))
- (unless ignore
+ (unless nil ;; ignore
(funcall error-func
(format "%s: No such file or directory\n" (caar f))))
(if (eq f files)
@@ -698,7 +698,7 @@ Each member of FILES is either a string or a cons cell of the form
(setcar f (cadr f))
(setcdr f (cddr f))))))
(if (not show-size)
- (setq display-files (mapcar 'eshell-ls-annotate files))
+ (setq display-files (mapcar #'eshell-ls-annotate files))
(dolist (file files)
(let* ((str (eshell-ls-printable-size (file-attribute-size (cdr file)) t))
(len (length str)))
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index aecc8bb4e0a..def52f42e55 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -63,8 +63,7 @@ ordinary strings."
(defcustom eshell-pred-load-hook nil
"A list of functions to run when `eshell-pred' is loaded."
:version "24.1" ; removed eshell-pred-initialize
- :type 'hook
- :group 'eshell-pred)
+ :type 'hook)
(defcustom eshell-predicate-alist
'((?/ . (eshell-pred-file-type ?d)) ; directories
@@ -85,18 +84,18 @@ ordinary strings."
(?s . (eshell-pred-file-mode #o4000)) ; setuid
(?S . (eshell-pred-file-mode #o2000)) ; setgid
(?t . (eshell-pred-file-mode #o1000)) ; sticky bit
- (?U . #'(lambda (file) ; owned by effective uid
- (if (file-exists-p file)
- (= (file-attribute-user-id (file-attributes file))
- (user-uid)))))
- ;; (?G . #'(lambda (file) ; owned by effective gid
- ;; (if (file-exists-p file)
- ;; (= (file-attribute-user-id (file-attributes file))
- ;; (user-uid)))))
- (?* . #'(lambda (file)
- (and (file-regular-p file)
- (not (file-symlink-p file))
- (file-executable-p file))))
+ (?U . (lambda (file) ; owned by effective uid
+ (if (file-exists-p file)
+ (= (file-attribute-user-id (file-attributes file))
+ (user-uid)))))
+ ;; (?G . (lambda (file) ; owned by effective gid
+ ;; (if (file-exists-p file)
+ ;; (= (file-attribute-user-id (file-attributes file))
+ ;; (user-uid)))))
+ (?* . (lambda (file)
+ (and (file-regular-p file)
+ (not (file-symlink-p file))
+ (file-executable-p file))))
(?l . (eshell-pred-file-links))
(?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
(?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
@@ -108,31 +107,30 @@ ordinary strings."
The format of each entry is
(CHAR . PREDICATE-FUNC-SEXP)"
- :type '(repeat (cons character sexp))
- :group 'eshell-pred)
+ :type '(repeat (cons character sexp)))
(put 'eshell-predicate-alist 'risky-local-variable t)
(defcustom eshell-modifier-alist
- '((?E . #'(lambda (lst)
- (mapcar
- (lambda (str)
- (eshell-stringify
- (car (eshell-parse-argument str))))
- lst)))
- (?L . #'(lambda (lst) (mapcar 'downcase lst)))
- (?U . #'(lambda (lst) (mapcar 'upcase lst)))
- (?C . #'(lambda (lst) (mapcar 'capitalize lst)))
- (?h . #'(lambda (lst) (mapcar 'file-name-directory lst)))
+ '((?E . (lambda (lst)
+ (mapcar
+ (lambda (str)
+ (eshell-stringify
+ (car (eshell-parse-argument str))))
+ lst)))
+ (?L . (lambda (lst) (mapcar #'downcase lst)))
+ (?U . (lambda (lst) (mapcar #'upcase lst)))
+ (?C . (lambda (lst) (mapcar #'capitalize lst)))
+ (?h . (lambda (lst) (mapcar #'file-name-directory lst)))
(?i . (eshell-include-members))
(?x . (eshell-include-members t))
- (?r . #'(lambda (lst) (mapcar 'file-name-sans-extension lst)))
- (?e . #'(lambda (lst) (mapcar 'file-name-extension lst)))
- (?t . #'(lambda (lst) (mapcar 'file-name-nondirectory lst)))
- (?q . #'(lambda (lst) (mapcar 'eshell-escape-arg lst)))
- (?u . #'(lambda (lst) (eshell-uniquify-list lst)))
- (?o . #'(lambda (lst) (sort lst 'string-lessp)))
- (?O . #'(lambda (lst) (nreverse (sort lst 'string-lessp))))
+ (?r . (lambda (lst) (mapcar #'file-name-sans-extension lst)))
+ (?e . (lambda (lst) (mapcar #'file-name-extension lst)))
+ (?t . (lambda (lst) (mapcar #'file-name-nondirectory lst)))
+ (?q . (lambda (lst) (mapcar #'eshell-escape-arg lst)))
+ (?u . (lambda (lst) (seq-uniq lst)))
+ (?o . (lambda (lst) (sort lst #'string-lessp)))
+ (?O . (lambda (lst) (nreverse (sort lst #'string-lessp))))
(?j . (eshell-join-members))
(?S . (eshell-split-members))
(?R . 'reverse)
@@ -146,8 +144,7 @@ The format of each entry is
The format of each entry is
(CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
- :type '(repeat (cons character sexp))
- :group 'eshell-pred)
+ :type '(repeat (cons character sexp)))
(put 'eshell-modifier-alist 'risky-local-variable t)
@@ -297,9 +294,9 @@ This function is specially for adding onto `eshell-parse-argument-hook'."
(append
eshell-current-modifiers
(list
- `(lambda (lst)
- (eshell-apply-modifiers
- lst (quote ,preds) (quote ,mods)))))))))
+ (lambda (lst)
+ (eshell-apply-modifiers
+ lst preds mods))))))))
(goto-char (1+ end))
(eshell-finish-arg))))))
@@ -324,7 +321,7 @@ resultant list of strings."
(if (looking-at "[^|':]")
(let ((func (read (current-buffer))))
(if (and func (functionp func))
- (setq preds (eshell-add-pred-func func preds
+ (setq preds (eshell-add-pred-func (eval func t) preds
negate follow))
(error "Invalid function predicate `%s'"
(eshell-stringify func))))
@@ -341,8 +338,7 @@ resultant list of strings."
(let ((func (read (current-buffer))))
(if (and func (functionp func))
(setq mods
- (cons `(lambda (lst)
- (mapcar (function ,func) lst))
+ (cons (lambda (lst) (mapcar func lst))
mods))
(error "Invalid function modifier `%s'"
(eshell-stringify func))))
@@ -353,14 +349,14 @@ resultant list of strings."
(if (not mod)
(error "Unknown modifier character `%c'" (char-after))
(forward-char)
- (setq mods (cons (eval (cdr mod)) mods)))))
+ (setq mods (cons (eval (cdr mod) t) mods)))))
(t
(let ((pred (assq char eshell-predicate-alist)))
(if (not pred)
(error "Unknown predicate character `%c'" char)
(forward-char)
(setq preds
- (eshell-add-pred-func (eval (cdr pred)) preds
+ (eshell-add-pred-func (eval (cdr pred) t) preds
negate follow))))))))
(end-of-buffer
(error "Predicate or modifier ended prematurely")))
@@ -369,11 +365,11 @@ resultant list of strings."
(defun eshell-add-pred-func (pred funcs negate follow)
"Add the predicate function PRED to FUNCS."
(if negate
- (setq pred `(lambda (file)
- (not (funcall ,pred file)))))
+ (setq pred (lambda (file)
+ (not (funcall pred file)))))
(if follow
- (setq pred `(lambda (file)
- (funcall ,pred (file-truename file)))))
+ (setq pred (lambda (file)
+ (funcall pred (file-truename file)))))
(cons pred funcs))
(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func)
@@ -399,10 +395,10 @@ resultant list of strings."
(unless ugid
(error "Unknown %s name specified for modifier `%c'"
mod-type mod-char))
- `(lambda (file)
- (let ((attrs (file-attributes file)))
- (if attrs
- (= (nth ,attr-index attrs) ,ugid))))))
+ (lambda (file)
+ (let ((attrs (file-attributes file)))
+ (if attrs
+ (= (nth attr-index attrs) ugid))))))
(defun eshell-pred-file-time (mod-char mod-type attr-index)
"Return a predicate to test whether a file matches a certain time."
@@ -445,13 +441,13 @@ resultant list of strings."
(error "Cannot stat file `%s'" file))
(setq when (nth attr-index attrs)))
(goto-char (1+ end)))
- `(lambda (file)
- (let ((attrs (file-attributes file)))
- (if attrs
- (,(cond ((eq qual ?-) #'time-less-p)
+ (let ((f (cond ((eq qual ?-) #'time-less-p)
((eq qual ?+) (lambda (a b) (time-less-p b a)))
- (#'time-equal-p))
- ,when (nth ,attr-index attrs)))))))
+ (#'time-equal-p))))
+ (lambda (file)
+ (let ((attrs (file-attributes file)))
+ (if attrs
+ (funcall f when (nth attr-index attrs))))))))
(defun eshell-pred-file-type (type)
"Return a test which tests that the file is of a certain TYPE.
@@ -462,20 +458,20 @@ that `ls -l' will show in the first column of its display."
(if (memq type '(?b ?c))
(forward-char)
(setq type ?%)))
- `(lambda (file)
- (let ((attrs (eshell-file-attributes (directory-file-name file))))
- (if attrs
- (memq (aref (file-attribute-modes attrs) 0)
- ,(if (eq type ?%)
- '(?b ?c)
- (list 'quote (list type))))))))
+ (let ((set (if (eq type ?%)
+ '(?b ?c)
+ (list type))))
+ (lambda (file)
+ (let ((attrs (eshell-file-attributes (directory-file-name file))))
+ (if attrs
+ (memq (aref (file-attribute-modes attrs) 0) set))))))
(defsubst eshell-pred-file-mode (mode)
"Return a test which tests that MODE pertains to the file."
- `(lambda (file)
- (let ((modes (file-modes file 'nofollow)))
- (if modes
- (not (zerop (logand ,mode modes)))))))
+ (lambda (file)
+ (let ((modes (file-modes file 'nofollow)))
+ (if modes
+ (not (zerop (logand mode modes)))))))
(defun eshell-pred-file-links ()
"Return a predicate to test whether a file has a given number of links."
@@ -487,15 +483,15 @@ that `ls -l' will show in the first column of its display."
(error "Invalid file link count modifier `l'"))
(setq amount (string-to-number (match-string 0)))
(goto-char (match-end 0))
- `(lambda (file)
- (let ((attrs (eshell-file-attributes file)))
- (if attrs
- (,(if (eq qual ?-)
- '<
- (if (eq qual ?+)
- '>
- '=))
- (file-attribute-link-number attrs) ,amount))))))
+ (let ((f (if (eq qual ?-)
+ #'<
+ (if (eq qual ?+)
+ #'>
+ #'=))))
+ (lambda (file)
+ (let ((attrs (eshell-file-attributes file)))
+ (if attrs
+ (funcall f (file-attribute-link-number attrs) amount)))))))
(defun eshell-pred-file-size ()
"Return a predicate to test whether a file is of a given size."
@@ -517,15 +513,15 @@ that `ls -l' will show in the first column of its display."
(error "Invalid file size modifier `L'"))
(setq amount (* (string-to-number (match-string 0)) quantum))
(goto-char (match-end 0))
- `(lambda (file)
- (let ((attrs (eshell-file-attributes file)))
- (if attrs
- (,(if (eq qual ?-)
- '<
- (if (eq qual ?+)
- '>
- '=))
- (file-attribute-size attrs) ,amount))))))
+ (let ((f (if (eq qual ?-)
+ #'<
+ (if (eq qual ?+)
+ #'>
+ #'=))))
+ (lambda (file)
+ (let ((attrs (eshell-file-attributes file)))
+ (if attrs
+ (funcall f (file-attribute-size attrs) amount)))))))
(defun eshell-pred-substitute (&optional repeat)
"Return a modifier function that will substitute matches."
@@ -539,22 +535,22 @@ that `ls -l' will show in the first column of its display."
replace (buffer-substring-no-properties (point) end))
(goto-char (1+ end))
(if repeat
- `(lambda (lst)
- (mapcar
- (lambda (str)
- (let ((i 0))
- (while (setq i (string-match ,match str i))
- (setq str (replace-match ,replace t nil str))))
- str)
- lst))
- `(lambda (lst)
- (mapcar
- (lambda (str)
- (if (string-match ,match str)
- (setq str (replace-match ,replace t nil str))
- (error (concat str ": substitution failed")))
- str)
- lst)))))
+ (lambda (lst)
+ (mapcar
+ (lambda (str)
+ (let ((i 0))
+ (while (setq i (string-match match str i))
+ (setq str (replace-match replace t nil str))))
+ str)
+ lst))
+ (lambda (lst)
+ (mapcar
+ (lambda (str)
+ (if (string-match match str)
+ (setq str (replace-match replace t nil str))
+ (error (concat str ": substitution failed")))
+ str)
+ lst)))))
(defun eshell-include-members (&optional invert-p)
"Include only lisp members matching a regexp."
@@ -564,12 +560,12 @@ that `ls -l' will show in the first column of its display."
(setq end (eshell-find-delimiter delim delim nil nil t)
regexp (buffer-substring-no-properties (point) end))
(goto-char (1+ end))
- `(lambda (lst)
- (eshell-winnow-list
- lst nil '((lambda (elem)
- ,(if invert-p
- `(not (string-match ,regexp elem))
- `(string-match ,regexp elem))))))))
+ (let ((predicates
+ (list (if invert-p
+ (lambda (elem) (not (string-match regexp elem)))
+ (lambda (elem) (string-match regexp elem))))))
+ (lambda (lst)
+ (eshell-winnow-list lst nil predicates)))))
(defun eshell-join-members ()
"Return a modifier function that join matches."
@@ -581,8 +577,8 @@ that `ls -l' will show in the first column of its display."
(setq end (eshell-find-delimiter delim delim nil nil t)
str (buffer-substring-no-properties (point) end))
(goto-char (1+ end)))
- `(lambda (lst)
- (mapconcat 'identity lst ,str))))
+ (lambda (lst)
+ (mapconcat #'identity lst str))))
(defun eshell-split-members ()
"Return a modifier function that splits members."
@@ -593,10 +589,11 @@ that `ls -l' will show in the first column of its display."
(setq end (eshell-find-delimiter delim delim nil nil t)
sep (buffer-substring-no-properties (point) end))
(goto-char (1+ end)))
- `(lambda (lst)
- (mapcar
- (lambda (str)
- (split-string str ,sep)) lst))))
+ (lambda (lst)
+ (mapcar
+ (lambda (str)
+ (split-string str sep))
+ lst))))
(provide 'em-pred)
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index aecc48610f7..1f08e891919 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -59,11 +59,12 @@ This includes when running `eshell-command'."
(defun eshell-script-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the script parsing code."
(setq-local eshell-interpreter-alist
- (cons (cons #'(lambda (file _args)
- (string= (file-name-nondirectory file)
- "eshell"))
- 'eshell/source)
- eshell-interpreter-alist))
+ (cons (cons (lambda (file _args)
+ (and (file-regular-p file)
+ (string= (file-name-nondirectory file)
+ "eshell")))
+ 'eshell/source)
+ eshell-interpreter-alist))
(setq-local eshell-complex-commands
(append '("source" ".") eshell-complex-commands))
;; these two variables are changed through usage, but we don't want
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index fa3218baf2f..f58e1b85cbd 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -23,13 +23,10 @@
;;; Code:
+(require 'cl-lib)
(require 'esh-util)
(eval-when-compile
(require 'eshell))
-;; Strictly speaking, should only be needed at compile time.
-;; Require at run-time too to silence compiler.
-(require 'pcomplete)
-(require 'compile)
;; There are no items in this custom group, but eshell modules (ab)use
;; custom groups.
@@ -49,50 +46,45 @@ naturally accessible within Emacs."
(defun eshell/expr (&rest args)
"Implementation of expr, using the calc package."
- (if (not (fboundp 'calc-eval))
- (throw 'eshell-replace-command
- (eshell-parse-command "*expr" (flatten-tree args)))
- ;; to fool the byte-compiler...
- (let ((func 'calc-eval))
- (funcall func (eshell-flatten-and-stringify args)))))
+ (calc-eval (eshell-flatten-and-stringify args)))
(defun eshell/substitute (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'substitute (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-substitute', for comparing lists of strings."
+ (apply #'cl-substitute (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/count (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'count (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-count', for comparing lists of strings."
+ (apply #'cl-count (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/mismatch (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'mismatch (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-mismatch', for comparing lists of strings."
+ (apply #'cl-mismatch (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/union (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'union (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-union', for comparing lists of strings."
+ (apply #'cl-union (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/intersection (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'intersection (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-intersection', for comparing lists of strings."
+ (apply #'cl-intersection (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/set-difference (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'set-difference (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-set-difference', for comparing lists of strings."
+ (apply #'cl-set-difference (car args) (cadr args) :test #'equal
(cddr args)))
(defun eshell/set-exclusive-or (&rest args)
- "Easy front-end to `intersection', for comparing lists of strings."
- (apply 'set-exclusive-or (car args) (cadr args) :test 'equal
+ "Easy front-end to `cl-set-exclusive-or', for comparing lists of strings."
+ (apply #'cl-set-exclusive-or (car args) (cadr args) :test #'equal
(cddr args)))
-(defalias 'eshell/ff 'find-name-dired)
-(defalias 'eshell/gf 'find-grep-dired)
+(defalias 'eshell/ff #'find-name-dired)
+(defalias 'eshell/gf #'find-grep-dired)
(provide 'em-xtra)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index d29b010ea09..f9dbce9770d 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -458,7 +458,7 @@ and the hook `eshell-exit-hook'."
(let ((inhibit-read-only t)
(no-default (eobp))
(find-tag-default-function 'ignore))
- (setq tagname (car (find-tag-interactive "Find tag: " no-default)))
+ (setq tagname (car (find-tag-interactive "Find tag" no-default)))
(with-suppressed-warnings ((obsolete find-tag))
(find-tag tagname next-p regexp-p))))
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index c1db484be56..7d31845528b 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -23,14 +23,6 @@
;;; Code:
-
-;; Unused.
-;; (defgroup eshell-opt nil
-;; "The options processing code handles command argument parsing for
-;; Eshell commands implemented in Lisp."
-;; :tag "Command options processing"
-;; :group 'eshell)
-
;;; User Functions:
;; Macro expansion of eshell-eval-using-options refers to eshell-stringify-list
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 369382906c8..7a0b26a0658 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -37,23 +37,19 @@ finish."
(defcustom eshell-proc-load-hook nil
"A hook that gets run when `eshell-proc' is loaded."
:version "24.1" ; removed eshell-proc-initialize
- :type 'hook
- :group 'eshell-proc)
+ :type 'hook)
(defcustom eshell-process-wait-seconds 0
"The number of seconds to delay waiting for a synchronous process."
- :type 'integer
- :group 'eshell-proc)
+ :type 'integer)
(defcustom eshell-process-wait-milliseconds 50
"The number of milliseconds to delay waiting for a synchronous process."
- :type 'integer
- :group 'eshell-proc)
+ :type 'integer)
(defcustom eshell-done-messages-in-minibuffer t
"If non-nil, subjob \"Done\" messages will display in minibuffer."
- :type 'boolean
- :group 'eshell-proc)
+ :type 'boolean)
(defcustom eshell-delete-exited-processes t
"If nil, process entries will stick around until `jobs' is run.
@@ -72,14 +68,12 @@ subjob is done is that it will no longer appear in the
Note that Eshell will have to be restarted for a change in this
variable's value to take effect."
- :type 'boolean
- :group 'eshell-proc)
+ :type 'boolean)
(defcustom eshell-reset-signals
"^\\(interrupt\\|killed\\|quit\\|stopped\\)"
"If a termination signal matches this regexp, the terminal will be reset."
- :type 'regexp
- :group 'eshell-proc)
+ :type 'regexp)
(defcustom eshell-exec-hook nil
"Called each time a process is exec'd by `eshell-gather-process-output'.
@@ -88,8 +82,7 @@ It is useful for things that must be done each time a process is
executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag').
In contrast, `eshell-mode-hook' is only executed once, when the buffer
is created."
- :type 'hook
- :group 'eshell-proc)
+ :type 'hook)
(defcustom eshell-kill-hook nil
"Called when a process run by `eshell-gather-process-output' has ended.
@@ -99,8 +92,7 @@ nil, in which case the user attempted to send a signal, but there was
no relevant process. This can be used for displaying help
information, for example."
:version "24.1" ; removed eshell-reset-after-proc
- :type 'hook
- :group 'eshell-proc)
+ :type 'hook)
;;; Internal Variables:
@@ -126,8 +118,7 @@ information, for example."
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter."
;; Was there till 24.1, but it is not optional.
- (if (memq #'eshell-reset-after-proc eshell-kill-hook)
- (setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook)))
+ (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
(eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
@@ -165,7 +156,7 @@ The signals which will cause this to happen are matched by
eshell-process-wait-milliseconds))))
(setq procs (cdr procs))))
-(defalias 'eshell/wait 'eshell-wait-for-process)
+(defalias 'eshell/wait #'eshell-wait-for-process)
(defun eshell/jobs (&rest _args)
"List processes, if there are any."
@@ -275,7 +266,7 @@ See `eshell-needs-pipe'."
;; neither 'first nor 'last? See bug#1388 discussion.
(catch 'found
(dolist (exe eshell-needs-pipe)
- (if (string-equal exe (if (string-match "/" exe)
+ (if (string-equal exe (if (string-search "/" exe)
command
(file-name-nondirectory command)))
(throw 'found t))))))
@@ -457,8 +448,7 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC."
(defcustom eshell-kill-process-wait-time 5
"Seconds to wait between sending termination signals to a subprocess."
- :type 'integer
- :group 'eshell-proc)
+ :type 'integer)
(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
"Signals used to kill processes when an Eshell buffer exits.
@@ -466,8 +456,7 @@ Eshell calls each of these signals in order when an Eshell buffer is
killed; if the process is still alive afterwards, Eshell waits a
number of seconds defined by `eshell-kill-process-wait-time', and
tries the next signal in the list."
- :type '(repeat symbol)
- :group 'eshell-proc)
+ :type '(repeat symbol))
(defcustom eshell-kill-processes-on-exit nil
"If non-nil, kill active processes when exiting an Eshell buffer.
@@ -489,8 +478,7 @@ long to delay between signals."
:type '(choice (const :tag "Kill all, don't ask" t)
(const :tag "Ask before killing" ask)
(const :tag "Ask for each process" every)
- (const :tag "Don't kill subprocesses" nil))
- :group 'eshell-proc)
+ (const :tag "Don't kill subprocesses" nil)))
(defun eshell-round-robin-kill (&optional query)
"Kill current process by trying various signals in sequence.
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 8ef1ac9c345..72de6b13e2e 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -23,6 +23,7 @@
;;; Code:
+(require 'seq)
(eval-when-compile (require 'cl-lib))
(defgroup eshell-util nil
@@ -37,25 +38,21 @@
If nil, t will be represented only in the exit code of the function,
and not printed as a string. This causes Lisp functions to behave
similarly to external commands, as far as successful result output."
- :type 'boolean
- :group 'eshell-util)
+ :type 'boolean)
(defcustom eshell-group-file "/etc/group"
"If non-nil, the name of the group file on your system."
- :type '(choice (const :tag "No group file" nil) file)
- :group 'eshell-util)
+ :type '(choice (const :tag "No group file" nil) file))
(defcustom eshell-passwd-file "/etc/passwd"
"If non-nil, the name of the passwd file on your system."
- :type '(choice (const :tag "No passwd file" nil) file)
- :group 'eshell-util)
+ :type '(choice (const :tag "No passwd file" nil) file))
(defcustom eshell-hosts-file "/etc/hosts"
"The name of the /etc/hosts file.
Use `pcomplete-hosts-file' instead; this variable is obsolete and
has no effect."
- :type '(choice (const :tag "No hosts file" nil) file)
- :group 'eshell-util)
+ :type '(choice (const :tag "No hosts file" nil) file))
;; Don't make it into an alias, because it doesn't really work with
;; custom and risks creating duplicate entries. Just point users to
;; the other variable, which is less frustrating.
@@ -64,25 +61,21 @@ has no effect."
(defcustom eshell-handle-errors t
"If non-nil, Eshell will handle errors itself.
Setting this to nil is offered as an aid to debugging only."
- :type 'boolean
- :group 'eshell-util)
+ :type 'boolean)
(defcustom eshell-private-file-modes 384 ; umask 177
"The file-modes value to use for creating \"private\" files."
- :type 'integer
- :group 'eshell-util)
+ :type 'integer)
(defcustom eshell-private-directory-modes 448 ; umask 077
"The file-modes value to use for creating \"private\" directories."
- :type 'integer
- :group 'eshell-util)
+ :type 'integer)
(defcustom eshell-tar-regexp
"\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'"
"Regular expression used to match tar file names."
:version "24.1" ; added xz
- :type 'regexp
- :group 'eshell-util)
+ :type 'regexp)
(defcustom eshell-convert-numeric-arguments t
"If non-nil, converting arguments of numeric form to Lisp numbers.
@@ -99,16 +92,14 @@ following in your init file:
Any function with the property `eshell-no-numeric-conversions' set to
a non-nil value, will be passed strings, not numbers, even when an
argument matches `eshell-number-regexp'."
- :type 'boolean
- :group 'eshell-util)
+ :type 'boolean)
(defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?"
"Regular expression used to match numeric arguments.
If `eshell-convert-numeric-arguments' is non-nil, and an argument
matches this regexp, it will be converted to a Lisp number, using the
function `string-to-number'."
- :type 'regexp
- :group 'eshell-util)
+ :type 'regexp)
(defcustom eshell-ange-ls-uids nil
"List of user/host/id strings, used to determine remote ownership."
@@ -116,8 +107,7 @@ function `string-to-number'."
(string :tag "Hostname")
(repeat (cons :tag "User/UID List"
(string :tag "Username")
- (repeat :tag "UIDs" string)))))
- :group 'eshell-util)
+ (repeat :tag "UIDs" string))))))
;;; Internal Variables:
@@ -214,7 +204,7 @@ then quoting is done by a backslash, rather than a doubled delimiter."
string
(if (eq (aref string (1- len)) ?\n)
(setq string (substring string 0 (1- len))))
- (if (string-match "\n" string)
+ (if (string-search "\n" string)
(split-string string "\n")
(if (and eshell-convert-numeric-arguments
(string-match
@@ -223,18 +213,6 @@ then quoting is done by a backslash, rather than a doubled delimiter."
(string-to-number string)
string))))))
-(defun eshell-sublist (l &optional n m)
- "Return from LIST the N to M elements.
-If N or M is nil, it means the end of the list."
- (let ((a (copy-sequence l)))
- (if (and m (consp (nthcdr m a)))
- (setcdr (nthcdr m a) nil))
- (if n
- (setq a (nthcdr n a))
- (setq n (1- (length a))
- a (last a)))
- a))
-
(defvar-local eshell-path-env (getenv "PATH")
"Content of $PATH.
It might be different from \(getenv \"PATH\"), when
@@ -303,20 +281,6 @@ Prepend remote identification of `default-directory', if any."
(define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1")
-(defun eshell-uniquify-list (l)
- "Remove occurring multiples in L. You probably want to sort first."
- (let ((m l))
- (while m
- (while (and (cdr m)
- (string= (car m)
- (cadr m)))
- (setcdr m (cddr m)))
- (setq m (cdr m))))
- l)
-(define-obsolete-function-alias
- 'eshell-uniqify-list
- 'eshell-uniquify-list "27.1")
-
(defun eshell-stringify (object)
"Convert OBJECT into a string value."
(cond
@@ -334,11 +298,11 @@ Prepend remote identification of `default-directory', if any."
(defsubst eshell-stringify-list (args)
"Convert each element of ARGS into a string value."
- (mapcar 'eshell-stringify args))
+ (mapcar #'eshell-stringify args))
(defsubst eshell-flatten-and-stringify (&rest args)
"Flatten and stringify all of the ARGS into a single string."
- (mapconcat 'eshell-stringify (flatten-tree args) " "))
+ (mapconcat #'eshell-stringify (flatten-tree args) " "))
(defsubst eshell-directory-files (regexp &optional directory)
"Return a list of files in the given DIRECTORY matching REGEXP."
@@ -497,7 +461,7 @@ list."
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
- (mapcar 'concat process-environment))
+ (mapcar #'concat process-environment))
(defun eshell-subgroups (groupsym)
"Return all of the subgroups of GROUPSYM."
@@ -645,74 +609,82 @@ gid format. Valid values are `string' and `integer', defaulting to
"If the `processp' function does not exist, PROC is not a process."
(and (fboundp 'processp) (processp proc)))
-; (defun eshell-copy-file
-; (file newname &optional ok-if-already-exists keep-date)
-; "Copy FILE to NEWNAME. See docs for `copy-file'."
-; (let (copied)
-; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
-; (let ((front (match-string 1 file))
-; (back (match-string 2 file))
-; buffer)
-; (if (and front (string-match eshell-tar-regexp front)
-; (setq buffer (find-file-noselect front)))
-; (with-current-buffer buffer
-; (goto-char (point-min))
-; (if (re-search-forward (concat " " (regexp-quote back)
-; "$") nil t)
-; (progn
-; (tar-copy (if (file-directory-p newname)
-; (expand-file-name
-; (file-name-nondirectory back) newname)
-; newname))
-; (setq copied t))
-; (error "%s not found in tar file %s" back front))))))
-; (unless copied
-; (copy-file file newname ok-if-already-exists keep-date))))
-
-; (defun eshell-file-attributes (filename)
-; "Return a list of attributes of file FILENAME.
-; See the documentation for `file-attributes'."
-; (let (result)
-; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
-; (let ((front (match-string 1 filename))
-; (back (match-string 2 filename))
-; buffer)
-; (when (and front (string-match eshell-tar-regexp front)
-; (setq buffer (find-file-noselect front)))
-; (with-current-buffer buffer
-; (goto-char (point-min))
-; (when (re-search-forward (concat " " (regexp-quote back)
-; "\\s-*$") nil t)
-; (let* ((descrip (tar-current-descriptor))
-; (tokens (tar-desc-tokens descrip)))
-; (setq result
-; (list
-; (cond
-; ((eq (tar-header-link-type tokens) 5)
-; t)
-; ((eq (tar-header-link-type tokens) t)
-; (tar-header-link-name tokens)))
-; 1
-; (tar-header-uid tokens)
-; (tar-header-gid tokens)
-; (tar-header-date tokens)
-; (tar-header-date tokens)
-; (tar-header-date tokens)
-; (tar-header-size tokens)
-; (concat
-; (cond
-; ((eq (tar-header-link-type tokens) 5) "d")
-; ((eq (tar-header-link-type tokens) t) "l")
-; (t "-"))
-; (tar-grind-file-mode (tar-header-mode tokens)
-; (make-string 9 ? ) 0))
-; nil nil nil))))))))
-; (or result
-; (file-attributes filename))))
-
+;; (defun eshell-copy-file
+;; (file newname &optional ok-if-already-exists keep-date)
+;; "Copy FILE to NEWNAME. See docs for `copy-file'."
+;; (let (copied)
+;; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file)
+;; (let ((front (match-string 1 file))
+;; (back (match-string 2 file))
+;; buffer)
+;; (if (and front (string-match eshell-tar-regexp front)
+;; (setq buffer (find-file-noselect front)))
+;; (with-current-buffer buffer
+;; (goto-char (point-min))
+;; (if (re-search-forward (concat " " (regexp-quote back)
+;; "$") nil t)
+;; (progn
+;; (tar-copy (if (file-directory-p newname)
+;; (expand-file-name
+;; (file-name-nondirectory back) newname)
+;; newname))
+;; (setq copied t))
+;; (error "%s not found in tar file %s" back front))))))
+;; (unless copied
+;; (copy-file file newname ok-if-already-exists keep-date))))
+
+;; (defun eshell-file-attributes (filename)
+;; "Return a list of attributes of file FILENAME.
+;; See the documentation for `file-attributes'."
+;; (let (result)
+;; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename)
+;; (let ((front (match-string 1 filename))
+;; (back (match-string 2 filename))
+;; buffer)
+;; (when (and front (string-match eshell-tar-regexp front)
+;; (setq buffer (find-file-noselect front)))
+;; (with-current-buffer buffer
+;; (goto-char (point-min))
+;; (when (re-search-forward (concat " " (regexp-quote back)
+;; "\\s-*$") nil t)
+;; (let* ((descrip (tar-current-descriptor))
+;; (tokens (tar-desc-tokens descrip)))
+;; (setq result
+;; (list
+;; (cond
+;; ((eq (tar-header-link-type tokens) 5)
+;; t)
+;; ((eq (tar-header-link-type tokens) t)
+;; (tar-header-link-name tokens)))
+;; 1
+;; (tar-header-uid tokens)
+;; (tar-header-gid tokens)
+;; (tar-header-date tokens)
+;; (tar-header-date tokens)
+;; (tar-header-date tokens)
+;; (tar-header-size tokens)
+;; (file-modes-number-to-symbolic
+;; (logior (tar-header-mode tokens)
+;; (cond
+;; ((eq (tar-header-link-type tokens) 5) 16384)
+;; ((eq (tar-header-link-type tokens) t) 32768))))
+;; nil nil nil))))))))
+;; (or result
+;; (file-attributes filename))))
+
+;; Obsolete.
+
+(define-obsolete-function-alias 'eshell-uniquify-list #'seq-uniq "28.1")
+(define-obsolete-function-alias 'eshell-uniqify-list #'seq-uniq "28.1")
(define-obsolete-function-alias 'eshell-copy-tree #'copy-tree "28.1")
(define-obsolete-function-alias 'eshell-user-name #'user-login-name "28.1")
+(defun eshell-sublist (l &optional n m)
+ "Return from LIST the N to M elements.
+If N or M is nil, it means the end of the list."
+ (declare (obsolete seq-subseq "28.1"))
+ (seq-subseq l n (1+ m)))
+
(provide 'esh-util)
;;; esh-util.el ends here
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index a09c47ce7c2..5dc6a193050 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -355,7 +355,7 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
(defun pcomplete/eshell-mode/setq ()
"Completion function for Eshell's `setq'."
(while (and (pcomplete-here (all-completions pcomplete-stub
- obarray 'boundp))
+ obarray #'boundp))
(pcomplete-here))))
;; FIXME the real "env" command does more than this, it runs a program
@@ -381,7 +381,7 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
(mapcar (lambda (x)
- (substring x 0 (string-match "=" x)))
+ (substring x 0 (string-search "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 3aaf2fb78aa..101ac860346 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -294,9 +294,9 @@ With prefix ARG, insert output into the current buffer at point."
(setq arg current-prefix-arg))
(let ((eshell-non-interactive-p t))
;; Enable `eshell-mode' only in this minibuffer.
- (minibuffer-with-setup-hook #'(lambda ()
- (eshell-mode)
- (eshell-command-mode +1))
+ (minibuffer-with-setup-hook (lambda ()
+ (eshell-mode)
+ (eshell-command-mode +1))
(unless command
(setq command (read-from-minibuffer "Emacs shell command: "))
(if (eshell-using-module 'eshell-hist)
diff --git a/lisp/expand.el b/lisp/expand.el
index 9df8d9f15ac..1b722014f89 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -1,4 +1,4 @@
-;;; expand.el --- make abbreviations more usable
+;;; expand.el --- make abbreviations more usable -*- lexical-binding: t -*-
;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
@@ -74,20 +74,17 @@
(defcustom expand-load-hook nil
"Hooks run when `expand.el' is loaded."
- :type 'hook
- :group 'expand)
+ :type 'hook)
(make-obsolete-variable 'expand-load-hook
"use `with-eval-after-load' instead." "28.1")
(defcustom expand-expand-hook nil
"Hooks run when an abbrev made by `expand-add-abbrevs' is expanded."
- :type 'hook
- :group 'expand)
+ :type 'hook)
(defcustom expand-jump-hook nil
"Hooks run by `expand-jump-to-previous-slot' and `expand-jump-to-next-slot'."
- :type 'hook
- :group 'expand)
+ :type 'hook)
;;; Samples:
@@ -319,8 +316,7 @@ If ARG is omitted, point is placed at the end of the expanded text."
nil)
(if (and (symbolp expansion) (fboundp expansion))
expansion
- nil)
- )
+ nil))
'expand-abbrev-hook)))
(put 'expand-abbrev-hook 'no-self-insert t)
@@ -368,13 +364,12 @@ See `expand-add-abbrevs'. Value is non-nil if expansion was done."
(insert text)
(setq expand-point (point))))
(if jump-args
- (funcall 'expand-build-list (car jump-args) (cdr jump-args)))
+ (funcall #'expand-build-list (car jump-args) (cdr jump-args)))
(if position
(backward-char position))
(if hook
(funcall hook))
- t)
- )
+ t))
(defun expand-abbrev-from-expand (word)
"Test if an abbrev has a hook."
@@ -428,8 +423,7 @@ This is used only in conjunction with `expand-add-abbrevs'."
(lenlist (length expand-list)))
(while (< i lenlist)
(aset expand-list i (- len (1- (aref expand-list i))))
- (setq i (1+ i))))
- )
+ (setq i (1+ i)))))
(defun expand-build-marks (p)
"Transform the offsets vector into a marker vector."
@@ -490,7 +484,6 @@ This is used only in conjunction with `expand-add-abbrevs'."
(provide 'expand)
-;; run load hooks
(run-hooks 'expand-load-hook)
;;; expand.el ends here
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index dc5f8f46aba..7229d6163df 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -85,22 +85,17 @@
;;; Code:
-;; Global bindings:
-(define-key global-map [C-down-mouse-2] 'facemenu-menu)
-(define-key global-map "\M-o" 'facemenu-keymap)
-
(defgroup facemenu nil
"Create a face menu for interactively adding fonts to text."
:group 'faces
:prefix "facemenu-")
(defcustom facemenu-keybindings
- (mapcar 'purecopy
'((default . "d")
(bold . "b")
(italic . "i")
- (bold-italic . "l") ; {bold} intersect {italic} = {l}
- (underline . "u")))
+ (bold-italic . "l") ; {bold} intersect {italic} = {l}
+ (underline . "u"))
"Alist of interesting faces and keybindings.
Each element is itself a list: the car is the name of the face,
the next element is the key to use as a keyboard equivalent of the menu item;
@@ -151,7 +146,7 @@ it will remove any faces not explicitly in the list."
(defvar facemenu-face-menu
(let ((map (make-sparse-keymap "Face")))
- (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face))
+ (define-key map "o" (cons "Other..." 'facemenu-set-face))
map)
"Menu keymap for faces.")
(defalias 'facemenu-face-menu facemenu-face-menu)
@@ -159,7 +154,7 @@ it will remove any faces not explicitly in the list."
(defvar facemenu-foreground-menu
(let ((map (make-sparse-keymap "Foreground Color")))
- (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-foreground))
+ (define-key map "o" (cons "Other..." 'facemenu-set-foreground))
map)
"Menu keymap for foreground colors.")
(defalias 'facemenu-foreground-menu facemenu-foreground-menu)
@@ -167,12 +162,20 @@ it will remove any faces not explicitly in the list."
(defvar facemenu-background-menu
(let ((map (make-sparse-keymap "Background Color")))
- (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-background))
+ (define-key map "o" (cons "Other..." 'facemenu-set-background))
map)
"Menu keymap for background colors.")
(defalias 'facemenu-background-menu facemenu-background-menu)
(put 'facemenu-background-menu 'menu-enable '(facemenu-enable-faces-p))
+(defcustom facemenu-add-face-function nil
+ "Function called at beginning of text to change or nil.
+This function is passed the FACE to set and END of text to change, and must
+return a string which is inserted. It may set `facemenu-end-add-face'."
+ :type '(choice (const :tag "None" nil)
+ function)
+ :group 'facemenu)
+
;;; Condition for enabling menu items that set faces.
(defun facemenu-enable-faces-p ()
;; Enable the facemenu if facemenu-add-face-function is defined
@@ -182,27 +185,22 @@ it will remove any faces not explicitly in the list."
(defvar facemenu-special-menu
(let ((map (make-sparse-keymap "Special")))
- (define-key map [?s] (cons (purecopy "Remove Special")
- 'facemenu-remove-special))
- (define-key map [?c] (cons (purecopy "Charset")
- 'facemenu-set-charset))
- (define-key map [?t] (cons (purecopy "Intangible")
- 'facemenu-set-intangible))
- (define-key map [?v] (cons (purecopy "Invisible")
- 'facemenu-set-invisible))
- (define-key map [?r] (cons (purecopy "Read-Only")
- 'facemenu-set-read-only))
+ (define-key map [?s] (cons "Remove Special" 'facemenu-remove-special))
+ (define-key map [?c] (cons "Charset" 'facemenu-set-charset))
+ (define-key map [?t] (cons "Intangible" 'facemenu-set-intangible))
+ (define-key map [?v] (cons "Invisible" 'facemenu-set-invisible))
+ (define-key map [?r] (cons "Read-Only" 'facemenu-set-read-only))
map)
"Menu keymap for non-face text-properties.")
(defalias 'facemenu-special-menu facemenu-special-menu)
(defvar facemenu-justification-menu
(let ((map (make-sparse-keymap "Justification")))
- (define-key map [?c] (cons (purecopy "Center") 'set-justification-center))
- (define-key map [?b] (cons (purecopy "Full") 'set-justification-full))
- (define-key map [?r] (cons (purecopy "Right") 'set-justification-right))
- (define-key map [?l] (cons (purecopy "Left") 'set-justification-left))
- (define-key map [?u] (cons (purecopy "Unfilled") 'set-justification-none))
+ (define-key map [?c] (cons "Center" 'set-justification-center))
+ (define-key map [?b] (cons "Full" 'set-justification-full))
+ (define-key map [?r] (cons "Right" 'set-justification-right))
+ (define-key map [?l] (cons "Left" 'set-justification-left))
+ (define-key map [?u] (cons "Unfilled" 'set-justification-none))
map)
"Submenu for text justification commands.")
(defalias 'facemenu-justification-menu facemenu-justification-menu)
@@ -210,13 +208,13 @@ it will remove any faces not explicitly in the list."
(defvar facemenu-indentation-menu
(let ((map (make-sparse-keymap "Indentation")))
(define-key map [decrease-right-margin]
- (cons (purecopy "Indent Right Less") 'decrease-right-margin))
+ (cons "Indent Right Less" 'decrease-right-margin))
(define-key map [increase-right-margin]
- (cons (purecopy "Indent Right More") 'increase-right-margin))
+ (cons "Indent Right More" 'increase-right-margin))
(define-key map [decrease-left-margin]
- (cons (purecopy "Indent Less") 'decrease-left-margin))
+ (cons "Indent Less" 'decrease-left-margin))
(define-key map [increase-left-margin]
- (cons (purecopy "Indent More") 'increase-left-margin))
+ (cons "Indent More" 'increase-left-margin))
map)
"Submenu for indentation commands.")
(defalias 'facemenu-indentation-menu facemenu-indentation-menu)
@@ -226,36 +224,37 @@ it will remove any faces not explicitly in the list."
"Facemenu top-level menu keymap.")
(setq facemenu-menu (make-sparse-keymap "Text Properties"))
(let ((map facemenu-menu))
- (define-key map [dc] (cons (purecopy "Display Colors") 'list-colors-display))
- (define-key map [df] (cons (purecopy "Display Faces") 'list-faces-display))
- (define-key map [dp] (cons (purecopy "Describe Properties")
- 'describe-text-properties))
- (define-key map [ra] (list 'menu-item (purecopy "Remove Text Properties")
+ (define-key map [dc] (cons "Display Colors" 'list-colors-display))
+ (define-key map [df] (cons "Display Faces" 'list-faces-display))
+ (define-key map [dp] (cons "Describe Properties" 'describe-text-properties))
+ (define-key map [ra] (list 'menu-item "Remove Text Properties"
'facemenu-remove-all
:enable 'mark-active))
- (define-key map [rm] (list 'menu-item (purecopy "Remove Face Properties")
+ (define-key map [rm] (list 'menu-item "Remove Face Properties"
'facemenu-remove-face-props
:enable 'mark-active))
- (define-key map [s1] (list (purecopy "--"))))
+ (define-key map [s1] (list "--")))
(let ((map facemenu-menu))
- (define-key map [in] (cons (purecopy "Indentation")
- 'facemenu-indentation-menu))
- (define-key map [ju] (cons (purecopy "Justification")
- 'facemenu-justification-menu))
- (define-key map [s2] (list (purecopy "--")))
- (define-key map [sp] (cons (purecopy "Special Properties")
- 'facemenu-special-menu))
- (define-key map [bg] (cons (purecopy "Background Color")
- 'facemenu-background-menu))
- (define-key map [fg] (cons (purecopy "Foreground Color")
- 'facemenu-foreground-menu))
- (define-key map [fc] (cons (purecopy "Face")
- 'facemenu-face-menu)))
+ (define-key map [in] (cons "Indentation" 'facemenu-indentation-menu))
+ (define-key map [ju] (cons "Justification" 'facemenu-justification-menu))
+ (define-key map [s2] (list "--"))
+ (define-key map [sp] (cons "Special Properties" 'facemenu-special-menu))
+ (define-key map [bg] (cons "Background Color" 'facemenu-background-menu))
+ (define-key map [fg] (cons "Foreground Color" 'facemenu-foreground-menu))
+ (define-key map [fc] (cons "Face" 'facemenu-face-menu)))
(defalias 'facemenu-menu facemenu-menu)
+;;;###autoload (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
+;;;###autoload
+(define-key global-map [C-down-mouse-2] 'facemenu-menu)
+
+(easy-menu-add-item
+ menu-bar-edit-menu nil
+ ["Text Properties" facemenu-menu])
+
(defvar facemenu-keymap
(let ((map (make-sparse-keymap "Set face")))
- (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face))
+ (define-key map "o" (cons "Other..." 'facemenu-set-face))
(define-key map "\M-o" 'font-lock-fontify-block)
map)
"Keymap for face-changing commands.
@@ -264,14 +263,6 @@ requested in `facemenu-keybindings'.")
(defalias 'facemenu-keymap facemenu-keymap)
-(defcustom facemenu-add-face-function nil
- "Function called at beginning of text to change or nil.
-This function is passed the FACE to set and END of text to change, and must
-return a string which is inserted. It may set `facemenu-end-add-face'."
- :type '(choice (const :tag "None" nil)
- function)
- :group 'facemenu)
-
(defcustom facemenu-end-add-face nil
"String to insert or function called at end of text to change or nil.
This function is passed the FACE to set, and must return a string which is
@@ -295,6 +286,7 @@ May also be t meaning to use `facemenu-add-face-function'."
(defvar facemenu-color-alist nil
"Alist of colors, used for completion.
If this is nil, then the value of (defined-colors) is used.")
+(make-obsolete-variable 'facemenu-color-alist nil "28.1")
(defun facemenu-update ()
"Add or update the \"Face\" menu in the menu bar.
@@ -542,6 +534,7 @@ filter out the color from the output."
This is installed as a `revert-buffer-function' in the *Colors* buffer."
(list-colors-display nil (buffer-name) list-colors-callback))
+;;;###autoload
(defun list-colors-display (&optional list buffer-name callback)
"Display names of defined colors, and show what they look like.
If the optional argument LIST is non-nil, it should be a list of
@@ -725,7 +718,13 @@ they are used to set the face information.
As a special case, if FACE is `default', then the region is left with NO face
text property. Otherwise, selecting the default face would not have any
effect. See `facemenu-remove-face-function'."
- (interactive "*xFace: \nr")
+ (interactive (list (progn
+ (barf-if-buffer-read-only)
+ (read-face-name "Use face" (face-at-point t)))
+ (if (and mark-active (not current-prefix-arg))
+ (region-beginning))
+ (if (and mark-active (not current-prefix-arg))
+ (region-end))))
(cond
((and (eq face 'default)
(not (eq facemenu-remove-face-function t)))
@@ -821,11 +820,11 @@ This is called whenever you create a new face, and at other times."
symbol (intern name)))
(setq menu 'facemenu-face-menu)
(setq docstring
- (purecopy (format "Select face `%s' for subsequent insertion.
+ (format "Select face `%s' for subsequent insertion.
If the mark is active and there is no prefix argument,
apply face `%s' to the region instead.
This command was defined by `facemenu-add-new-face'."
- name name)))
+ name name))
(cond ((facemenu-iterate ; check if equivalent face is already in the menu
(lambda (m) (and (listp m)
(symbolp (car m))
@@ -838,15 +837,15 @@ This command was defined by `facemenu-add-new-face'."
(key
(setq function (intern (concat "facemenu-set-" name)))
(fset function
- `(lambda ()
- ,docstring
- (interactive)
- (facemenu-set-face
- (quote ,symbol)
- (if (and mark-active (not current-prefix-arg))
- (region-beginning))
- (if (and mark-active (not current-prefix-arg))
- (region-end)))))
+ (lambda ()
+ (:documentation docstring)
+ (interactive)
+ (facemenu-set-face
+ symbol
+ (if (and mark-active (not current-prefix-arg))
+ (region-beginning))
+ (if (and mark-active (not current-prefix-arg))
+ (region-end)))))
(define-key 'facemenu-keymap key (cons name function))
(define-key menu key (cons name function)))
;; Faces with no keyboard equivalent. Figure out where to put it:
diff --git a/lisp/faces.el b/lisp/faces.el
index 90f11bbe3bb..a3a6f1b78dd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -46,7 +46,7 @@ the terminal-initialization file to be loaded."
("vt320" . "vt200")
("vt400" . "vt200")
("vt420" . "vt200")
- )
+ ("alacritty" . "xterm"))
"Alist of terminal type aliases.
Entries are of the form (TYPE . ALIAS), where both elements are strings.
This means to treat a terminal of type TYPE as if it were of type ALIAS."
@@ -176,10 +176,28 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
;;; Creation, copying.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(make-obsolete-variable 'face-new-frame-defaults
+ "use `face--new-frame-defaults' or `face-alist' instead." "28.1")
+
+(defun frame-face-alist (&optional frame)
+ "Return an alist of frame-local faces defined on FRAME.
+This alist is a copy of the contents of `frame--face-hash-table'.
+For internal use only."
+ (declare (obsolete frame--face-hash-table "28.1"))
+ (let (faces)
+ (maphash (lambda (face spec)
+ (let ((face-id (car (gethash face face--new-frame-defaults))))
+ (push `(,face-id ,face . ,spec) faces)))
+ (frame--face-hash-table frame))
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun face-list ()
"Return a list of all defined faces."
- (mapcar #'car face-new-frame-defaults))
+ (let (faces)
+ (maphash (lambda (face spec)
+ (push `(,(car spec) . ,face) faces))
+ face--new-frame-defaults)
+ (mapcar #'cdr (sort faces (lambda (f1 f2) (< (car f1) (car f2)))))))
(defun make-face (face)
"Define a new face with name FACE, a symbol.
@@ -503,7 +521,8 @@ If INHERIT is t, and FACE doesn't define a foreground color, then any
foreground color that FACE inherits through its `:inherit' attribute
is considered as well; however the return value may still be nil.
If INHERIT is a face or a list of faces, then it is used to try to
- resolve an unspecified foreground color.
+ resolve an unspecified foreground color, in addition to using any
+inherited color.
To ensure that a valid color is always returned, use a value of
`default' for INHERIT; this will resolve any unspecified values by
@@ -523,7 +542,8 @@ If INHERIT is t, and FACE doesn't define a background color, then any
background color that FACE inherits through its `:inherit' attribute
is considered as well; however the return value may still be nil.
If INHERIT is a face or a list of faces, then it is used to try to
- resolve an unspecified background color.
+ resolve an unspecified background color, in addition to using any
+inherited color.
To ensure that a valid color is always returned, use a value of
`default' for INHERIT; this will resolve any unspecified values by
@@ -1259,7 +1279,15 @@ of a global face. Value is the new attribute value."
(or (car (rassoc old-value valid))
(format "%s" old-value))))
(setq new-value
- (face-read-string face default attribute-name valid))
+ (if (memq attribute '(:foreground :background))
+ (let ((color
+ (read-color
+ (format-prompt "%s for face `%s'"
+ default attribute-name face))))
+ (if (equal (string-trim color) "")
+ default
+ color))
+ (face-read-string face default attribute-name valid)))
(if (equal new-value default)
;; Nothing changed, so don't bother with all the stuff
;; below. In particular, this avoids a non-tty color
@@ -1917,12 +1945,11 @@ Interactively, or with optional arg MSG non-nil, print the
resulting color name in the echo area."
(interactive "i\np\ni\np") ; Always convert to RGB interactively.
(let* ((completion-ignore-case t)
- (colors (or facemenu-color-alist
- (append '("foreground at point" "background at point")
- (if allow-empty-name '(""))
- (if (display-color-p)
- (defined-colors-with-face-attributes)
- (defined-colors)))))
+ (colors (append '("foreground at point" "background at point")
+ (if allow-empty-name '(""))
+ (if (display-color-p)
+ (defined-colors-with-face-attributes)
+ (defined-colors))))
(color (completing-read
(or prompt "Color (name or #RGB triplet): ")
;; Completing function for reading colors, accepting
@@ -2106,10 +2133,28 @@ the X resource \"reverseVideo\" is present, handle that."
(unwind-protect
(progn
(x-setup-function-keys frame)
+ (dolist (face (nreverse (face-list)))
+ (face-spec-recalc face frame))
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
- (if (null visibility-spec)
+ ;; Mark frame as 'was-invisible' when it was created as
+ ;; invisible or iconified and PARAMETERS contains either a
+ ;; width or height specification. This should be sufficient
+ ;; to handle Bug#24526 (where a frame is initially iconified
+ ;; to allow manipulating its size in a non-obtrusive way) and
+ ;; avoid that a tiling window manager for GTK3 gets a resize
+ ;; request it cannot handle (Bug#48268). The 'was-invisible'
+ ;; flag is eventually processed in xterm.c after we receive a
+ ;; MapNotify event; non-X builds ignore it.
+ (frame--set-was-invisible
+ frame
+ (and visibility-spec
+ (memq (cdr visibility-spec) '(nil icon))
+ (or (assq 'width parameters)
+ (assq 'height parameters))))
+
+ (if (null visibility-spec)
(make-frame-visible frame)
(modify-frame-parameters frame (list visibility-spec)))
(setq success t))
@@ -2120,7 +2165,7 @@ the X resource \"reverseVideo\" is present, handle that."
(defun face-set-after-frame-default (frame &optional parameters)
"Initialize the frame-local faces of FRAME.
Calculate the face definitions using the face specs, custom theme
-settings, X resources, and `face-new-frame-defaults'.
+settings, X resources, and `face--new-frame-defaults'.
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
;; The `reverse' is so that `default' goes first.
@@ -2129,7 +2174,7 @@ frame parameters in PARAMETERS."
(progn
;; Initialize faces from face spec and custom theme.
(face-spec-recalc face frame)
- ;; Apply attributes specified by face-new-frame-defaults
+ ;; Apply attributes specified by face--new-frame-defaults
(internal-merge-in-global-face face frame))
;; Don't let invalid specs prevent frame creation.
(error nil)))
@@ -2235,7 +2280,8 @@ If you set `term-file-prefix' to nil, this function does nothing."
(let ((file (locate-library (concat term-file-prefix type))))
(and file
(or (assoc file load-history)
- (load file t t)))))
+ (load (file-name-sans-extension file)
+ t t)))))
type)
;; Next, try to find a matching initialization function, and call it.
(tty-find-type #'(lambda (type)
@@ -2815,6 +2861,30 @@ Note: Other faces cannot inherit from the cursor face."
"Face to highlight argument names in *Help* buffers."
:group 'help)
+(defface help-key-binding
+ '((((class color) (min-colors 88) (background light))
+ :background "grey96" :foreground "DarkBlue"
+ ;; We use negative thickness of the horizontal box border line to
+ ;; avoid enlarging the height of the echo-area display, which
+ ;; would then move the mode line a few pixels up.
+ :box (:line-width (1 . -1) :color "grey80"))
+ (((class color) (min-colors 88) (background dark))
+ :background "grey19" :foreground "LightBlue"
+ :box (:line-width (1 . -1) :color "grey35"))
+ (((class color grayscale) (background light)) :background "grey90")
+ (((class color grayscale) (background dark)) :background "grey25")
+ (t :background "grey90"))
+ "Face for keybindings in *Help* buffers.
+
+This face is added by `substitute-command-keys', which see.
+
+Note that this face will also be used for key bindings in
+tooltips. This means that, for example, changing the :height of
+this face will increase the height of any tooltip containing key
+bindings. See also the face `tooltip'."
+ :version "28.1"
+ :group 'help)
+
(defface glyphless-char
'((((type tty)) :inherit underline)
(((type pc)) :inherit escape-glyph)
@@ -2863,23 +2933,30 @@ It is used for characters of no fonts too."
;; Faces for TTY menus.
(defface tty-menu-enabled-face
- '((t
- :foreground "yellow" :background "blue" :weight bold))
+ '((((class color))
+ :foreground "yellow" :background "blue" :weight bold)
+ (t :weight bold))
"Face for displaying enabled items in TTY menus."
- :group 'basic-faces)
+ :group 'basic-faces
+ :version "28.1")
(defface tty-menu-disabled-face
'((((class color) (min-colors 16))
:foreground "lightgray" :background "blue")
- (t
- :foreground "white" :background "blue"))
+ (((class color))
+ :foreground "white" :background "blue")
+ (t :inherit shadow))
"Face for displaying disabled items in TTY menus."
- :group 'basic-faces)
+ :group 'basic-faces
+ :version "28.1")
(defface tty-menu-selected-face
- '((t :background "red"))
+ '((((class color))
+ :background "red")
+ (t :inverse-video t))
"Face for displaying the currently selected item in TTY menus."
- :group 'basic-faces)
+ :group 'basic-faces
+ :version "28.1")
(defgroup paren-showing-faces nil
"Faces used to highlight paren matches."
@@ -2985,7 +3062,7 @@ also the same size as FACE on FRAME, or fail."
(let ((fonts (x-list-fonts pattern face frame 1)))
(or fonts
(if face
- (if (string-match-p "\\*" pattern)
+ (if (string-search "*" pattern)
(if (null (face-font face))
(error "No matching fonts are the same height as the frame default font")
(error "No matching fonts are the same height as face `%s'" face))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 6faf8d50b26..84dcc04a712 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -260,6 +260,7 @@ ffap most of the time."
:type 'boolean
:group 'ffap)
+;;;###autoload
(defcustom ffap-file-finder 'find-file
"The command called by `find-file-at-point' to find a file."
:type 'function
@@ -1417,7 +1418,7 @@ which may actually result in an URL rather than a filename."
(string (ffap-string-at-point)) ; uses mode alist
(name
(or (condition-case nil
- (and (not (string-match "//" string)) ; foo.com://bar
+ (and (not (string-search "//" string)) ; foo.com://bar
(substitute-in-file-name string))
(error nil))
string))
@@ -1524,24 +1525,37 @@ which may actually result in an URL rather than a filename."
;; The solution here is to forcefully activate url-handler-mode, which
;; takes care of it for us.
+(defun ffap--url-file-handler (operation &rest args)
+ (let ((inhibit-file-name-handlers
+ (cons 'ffap--url-file-handler inhibit-file-name-handlers))
+ (inhibit-file-name-operation operation))
+ (cl-case operation
+ ;; We mainly just want to disable these bits:
+ (substitute-in-file-name (car args))
+ (expand-file-name (car args))
+ (otherwise
+ (apply operation args)))))
+
(defun ffap-read-file-or-url (prompt guess)
"Read file or URL from minibuffer, with PROMPT and initial GUESS."
- (or guess (setq guess default-directory))
- ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
- ;; or "w3/" or "../el/ffap.el" or "../../../"
- (if (ffap-url-p guess)
- ;; FIXME: We earlier tried to make use of `url-file-handler' so
- ;; `read-file-name' could also be used for URLs, but it
- ;; introduced all kinds of subtle breakage such as:
- ;; - (file-name-directory "http://a") returning "http://a/"
- ;; - Trying to contact remote hosts with no justification
- ;; These should be fixed in url-handler-mode before we can try
- ;; using it here again.
- (read-string prompt guess nil nil t)
- (unless (ffap-file-remote-p guess)
- (setq guess (abbreviate-file-name (expand-file-name guess))))
- (read-file-name prompt (file-name-directory guess) nil nil
- (file-name-nondirectory guess))))
+ (let ((elem (cons ffap-url-regexp #'ffap--url-file-handler)))
+ (unwind-protect
+ (progn
+ (push elem file-name-handler-alist)
+ (if (ffap-url-p guess)
+ (read-file-name prompt guess guess)
+ (unless guess
+ (setq guess default-directory))
+ (unless (ffap-file-remote-p guess)
+ (setq guess (abbreviate-file-name (expand-file-name guess))))
+ (read-file-name prompt
+ (file-name-directory guess) nil nil
+ (file-name-nondirectory guess))))
+ ;; Remove the special handler manually. We used to just let-bind
+ ;; file-name-handler-alist to preserve its value, but that caused
+ ;; other modifications to be lost (e.g. when Tramp gets loaded
+ ;; during the completing-read call).
+ (setq file-name-handler-alist (delq elem file-name-handler-alist)))))
;; The rest of this page is just to work with package complete.el.
;; This code assumes that you load ffap.el after complete.el.
@@ -1653,9 +1667,9 @@ See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
((or (not ffap-newfile-prompt)
(file-exists-p filename)
(y-or-n-p "File does not exist, create buffer? "))
- (funcall ffap-file-finder
- ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
- (expand-file-name filename)))
+ (find-file
+ ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
+ (expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-missing (list "Opening file buffer"
"No such file or directory"
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 67d2939dd3c..4223878b0e7 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -516,6 +516,16 @@ If called interactively, read the directory names one by one."
(concat directory "/")
directory)))
+(defun file-cache-cycle (name)
+ "Cycle through the directories that NAME is available in."
+ (let ((file-name (file-cache-file-name name)))
+ (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)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Minibuffer functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -545,13 +555,7 @@ the name is considered already unique; only the second substitution
(cond
;; If it's the only match, replace the original contents
((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)))))
+ (file-cache-cycle string))
;; If it's the longest match, insert it
((consp completion)
@@ -564,10 +568,7 @@ the name is considered already unique; only the second substitution
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))
+ (file-cache-cycle newstring)
(minibuffer-message file-cache-non-unique-message)
(setq file-cache-last-completion string))
(setq file-cache-last-completion string)
@@ -579,20 +580,12 @@ the name is considered already unique; only the second substitution
(if (> (length completion-list) 1)
(progn
(delete-region (- (point-max) (length string)) (point-max))
- (save-excursion (insert newstring))
- (forward-char newpoint)
+ (insert newstring)
(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)))))))))
+ (file-cache-cycle newstring))))))
;; No match
((eq completion nil)
@@ -674,10 +667,6 @@ match REGEXP."
(insert (nth 1 item) (nth 0 item) "\n"))
(pop-to-buffer buf))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Keybindings
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
(provide 'filecache)
;;; filecache.el ends here
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index cb9fe8f7769..45b9cea9397 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -120,7 +120,10 @@ operating on the next file and nil otherwise."
(kill-all-local-variables)
(erase-buffer)
(setq new next)
- (insert-file-contents new nil))
+ (condition-case nil
+ (insert-file-contents new nil)
+ (file-missing
+ (fileloop-next-file novisit))))
new)))
(defun fileloop-continue ()
@@ -171,7 +174,8 @@ operating on the next file and nil otherwise."
(goto-char pos))
(push-mark original-point t))
- (switch-to-buffer (current-buffer))
+ (let (switch-to-buffer-preserve-window-point)
+ (switch-to-buffer (current-buffer)))
;; Now operate on the file.
;; If value is non-nil, continue to scan the next file.
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 78571776a39..4fc7f0a8ec0 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -100,6 +100,7 @@ If it is registered in `file-notify-descriptors', a `stopped' event is sent."
"Handle a file system monitoring event, coming from backends.
If OBJECT is a filewatch event, call its callback.
Otherwise, signal a `file-notify-error'."
+ (declare (completion ignore))
(interactive "e")
(when file-notify-debug
(message "file-notify-handle-event %S" object))
@@ -504,7 +505,6 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
;; due to the way events are propagated during idle time. Note: This
;; may be perfectly acceptable.
-;; The end:
(provide 'filenotify)
;;; filenotify.el ends here
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 526a128623c..9e1954256a6 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -1,4 +1,4 @@
-;;; files-x.el --- extended file handling commands
+;;; files-x.el --- extended file handling commands -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).")
"Normalize plist CRITERIA according to properties.
Return a reordered plist."
(apply
- 'append
+ #'append
(mapcar
(lambda (property)
(when (and (plist-member criteria property) (plist-get criteria property))
@@ -699,13 +699,14 @@ will not be changed."
(copy-tree connection-local-variables-alist)))
(hack-local-variables-apply)))
-(defsubst connection-local-criteria-for-default-directory ()
- "Return a connection-local criteria, which represents `default-directory'."
+(defsubst connection-local-criteria-for-default-directory (&optional application)
+ "Return a connection-local criteria, which represents `default-directory'.
+If APPLICATION is nil, the symbol `tramp' is used."
(when (file-remote-p default-directory)
- `(:application tramp
- :protocol ,(file-remote-p default-directory 'method)
- :user ,(file-remote-p default-directory 'user)
- :machine ,(file-remote-p default-directory 'host))))
+ `(:application ,(or application 'tramp)
+ :protocol ,(file-remote-p default-directory 'method)
+ :user ,(file-remote-p default-directory 'user)
+ :machine ,(file-remote-p default-directory 'host))))
;;;###autoload
(defmacro with-connection-local-variables (&rest body)
diff --git a/lisp/files.el b/lisp/files.el
index dada69c1457..77977f14116 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -391,6 +391,10 @@ constructed by taking the directory part of the replaced file-name,
concatenated with the buffer file name with all directory separators
changed to `!' to prevent clashes. This will not work
correctly if your filesystem truncates the resulting name.
+If UNIQUIFY is one of the members of `secure-hash-algorithms',
+Emacs constructs the nondirectory part of the auto-save file name
+by applying that `secure-hash' to the buffer file name. This
+avoids any risk of excessively long file names.
All the transforms in the list are tried, in the order they are listed.
When one transform applies, its result is final;
@@ -461,6 +465,31 @@ If `silently', don't ask the user before saving."
:type '(choice (const t) (const nil) (const silently))
:group 'abbrev)
+(defcustom lock-file-name-transforms nil
+ "Transforms to apply to buffer file name before making a lock file name.
+This has the same syntax as
+`auto-save-file-name-transforms' (which see), but instead of
+applying to auto-save file names, it's applied to lock file names.
+
+By default, a lock file is put into the same directory as the
+file it's locking, and it has the same name, but with \".#\" prepended."
+ :group 'files
+ :type '(repeat (list (regexp :tag "Regexp")
+ (string :tag "Replacement")
+ (boolean :tag "Uniquify")))
+ :version "28.1")
+
+(defcustom remote-file-name-inhibit-locks nil
+ "Whether to use file locks for remote files."
+ :group 'files
+ :version "28.1"
+ :type 'boolean)
+
+(define-minor-mode lock-file-mode
+ "Toggle file locking in the current buffer (Lock File mode)."
+ :version "28.1"
+ (setq-local create-lockfiles (and lock-file-mode t)))
+
(defcustom find-file-run-dired t
"Non-nil means allow `find-file' to visit directories.
To visit the directory, `find-file' runs `find-directory-functions'."
@@ -577,7 +606,9 @@ a -*- line.
The command \\[normal-mode], when used interactively,
always obeys file local variable specifications and the -*- line,
-and ignores this variable."
+and ignores this variable.
+
+Also see the `permanently-enabled-local-variables' variable."
:risky t
:type '(choice (const :tag "Query Unsafe" t)
(const :tag "Safe Only" :safe)
@@ -751,7 +782,7 @@ nil (meaning `default-directory') as the associated list element."
(let ((spath (substitute-env-vars search-path)))
(mapcar (lambda (f)
(if (equal "" f) nil
- (let ((dir (expand-file-name (file-name-as-directory f))))
+ (let ((dir (file-name-as-directory f)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
@@ -823,7 +854,9 @@ The path separator is colon in GNU and GNU-like systems."
(expand-file-name dir))
(locate-file dir cd-path nil
(lambda (f) (and (file-directory-p f) 'dir-ok)))
- (error "No such directory found via CDPATH environment variable"))))
+ (if (getenv "CDPATH")
+ (error "No such directory found via CDPATH environment variable: %s" dir)
+ (error "No such directory: %s" dir)))))
(defun directory-files-recursively (dir regexp
&optional include-directories predicate
@@ -906,6 +939,8 @@ See `file-symlink-p' to distinguish symlinks."
(read-file-name "Load file: " nil nil 'lambda))))
(load (expand-file-name file) nil nil t))
+(defvar comp-eln-to-el-h)
+
(defun locate-file (filename path &optional suffixes predicate)
"Search for FILENAME through PATH.
If found, return the absolute file name of FILENAME; otherwise
@@ -932,7 +967,10 @@ one or more of those symbols."
(logior (if (memq 'executable predicate) 1 0)
(if (memq 'writable predicate) 2 0)
(if (memq 'readable predicate) 4 0))))
- (locate-file-internal filename path suffixes predicate))
+ (let ((file (locate-file-internal filename path suffixes predicate)))
+ (if (and file (string-match "\\.eln\\'" file))
+ (gethash (file-name-nondirectory file) comp-eln-to-el-h)
+ file)))
(defun locate-file-completion-table (dirs suffixes string pred action)
"Do completion for file names passed to `locate-file'."
@@ -998,7 +1036,7 @@ Any directory whose name matches this regexp will be treated like
a kind of root directory by `locate-dominating-file', which will stop its
search when it bumps into it.
The default regexp prevents fruitless and time-consuming attempts to find
-special files in directories in which filenames are interpreted as hostnames,
+special files in directories in which file names are interpreted as host names,
or mount points potentially requiring authentication as a different user.")
(defun locate-dominating-file (file name)
@@ -1639,20 +1677,21 @@ called additional times).
This macro actually adds an auxiliary function that calls FUN,
rather than FUN itself, to `minibuffer-setup-hook'."
- (declare (indent 1) (debug t))
+ (declare (indent 1) (debug ([&or (":append" form) [&or symbolp form]] body)))
(let ((hook (make-symbol "setup-hook"))
(funsym (make-symbol "fun"))
(append nil))
(when (eq (car-safe fun) :append)
(setq append '(t) fun (cadr fun)))
`(let ((,funsym ,fun)
- ,hook)
- (setq ,hook
- (lambda ()
- ;; Clear out this hook so it does not interfere
- ;; with any recursive minibuffer usage.
- (remove-hook 'minibuffer-setup-hook ,hook)
- (funcall ,funsym)))
+ ;; Use a symbol to make sure `add-hook' doesn't waste time
+ ;; in `equal'ity testing (bug#46326).
+ (,hook (make-symbol "minibuffer-setup")))
+ (fset ,hook (lambda ()
+ ;; Clear out this hook so it does not interfere
+ ;; with any recursive minibuffer usage.
+ (remove-hook 'minibuffer-setup-hook ,hook)
+ (funcall ,funsym)))
(unwind-protect
(progn
(add-hook 'minibuffer-setup-hook ,hook ,@append)
@@ -1663,6 +1702,10 @@ rather than FUN itself, to `minibuffer-setup-hook'."
(list (read-file-name prompt nil default-directory mustmatch)
t))
+(defun file-name-history--add (file)
+ "Add FILE to `file-name-history'."
+ (add-to-history 'file-name-history (abbreviate-file-name file)))
+
(defun find-file (filename &optional wildcards)
"Edit file FILENAME.
Switch to a buffer visiting file FILENAME,
@@ -2119,29 +2162,75 @@ think it does, because \"free\" is pretty hard to define in practice."
:version "25.1"
:type '(choice integer (const :tag "Never issue warning" nil)))
+(defcustom query-about-changed-file t
+ "If non-nil, query the user when re-visiting a file that has changed.
+This happens if the file is already visited in a buffer, the
+file was changed externally, and the user re-visits the file.
+
+If nil, don't prompt the user, but instead provide instructions for
+reverting, after switching to the buffer with its contents before
+the external changes."
+ :group 'files
+ :group 'find-file
+ :version "28.1"
+ :type 'boolean)
+
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
+(defun files--ask-user-about-large-file-help-text (op-type size)
+ "Format the text that explains the options to open large files in Emacs.
+OP-TYPE contains the kind of file operation that will be
+performed. SIZE is the size of the large file."
+ (format
+ "The file that you want to %s is large (%s), which exceeds the
+ threshold above which Emacs asks for confirmation (%s).
+
+ Large files may be slow to edit or navigate so Emacs asks you
+ before you try to %s such files.
+
+ You can press:
+ 'y' to %s the file.
+ 'n' to abort, and not %s the file.
+ 'l' (the letter ell) to %s the file literally, which means that
+ Emacs will %s the file without doing any format or character code
+ conversion and in Fundamental mode, without loading any potentially
+ expensive features.
+
+ You can customize the option `large-file-warning-threshold' to be the
+ file size, in bytes, from which Emacs will ask for confirmation. Set
+ it to nil to never request confirmation."
+ op-type
+ size
+ (funcall byte-count-to-string-function large-file-warning-threshold)
+ op-type
+ op-type
+ op-type
+ op-type
+ op-type))
+
(defun files--ask-user-about-large-file (size op-type filename offer-raw)
+ "Query the user about what to do with large files.
+Files are \"large\" if file SIZE is larger than `large-file-warning-threshold'.
+
+OP-TYPE specifies the file operation being performed on FILENAME.
+
+If OFFER-RAW is true, give user the additional option to open the
+file literally."
(let ((prompt (format "File %s is large (%s), really %s?"
(file-name-nondirectory filename)
(funcall byte-count-to-string-function size) op-type)))
(if (not offer-raw)
(if (y-or-n-p prompt) nil 'abort)
- (let* ((use-dialog (and (display-popup-menus-p)
- last-input-event
- (listp last-nonmenu-event)
- use-dialog-box))
- (choice
- (if use-dialog
- (x-popup-dialog t `(,prompt
- ("Yes" . ?y)
- ("No" . ?n)
- ("Open literally" . ?l)))
- (read-char-choice
- (concat prompt " (y)es or (n)o or (l)iterally ")
- '(?y ?Y ?n ?N ?l ?L)))))
- (cond ((memq choice '(?y ?Y)) nil)
- ((memq choice '(?l ?L)) 'raw)
+ (let ((choice
+ (car
+ (read-multiple-choice
+ prompt '((?y "yes")
+ (?n "no")
+ (?l "literally"))
+ (files--ask-user-about-large-file-help-text
+ op-type (funcall byte-count-to-string-function size))))))
+ (cond ((eq choice ?y) nil)
+ ((eq choice ?l) 'raw)
(t 'abort))))))
(defun abort-if-file-too-large (size op-type filename &optional offer-raw)
@@ -2241,7 +2330,8 @@ the various files."
;; Check to see if the file looks uncommonly large.
(when (not (or buf nowarn))
(when (eq (abort-if-file-too-large
- (file-attribute-size attributes) "open" filename t)
+ (file-attribute-size attributes) "open" filename
+ (not rawfile))
'raw)
(setf rawfile t))
(warn-maybe-out-of-memory (file-attribute-size attributes)))
@@ -2267,6 +2357,14 @@ the various files."
(message "Reverting file %s..." filename)
(revert-buffer t t)
(message "Reverting file %s...done" filename)))
+ ((not query-about-changed-file)
+ (message
+ (substitute-command-keys
+ "File %s changed on disk. \\[revert-buffer] to load new contents%s")
+ (file-name-nondirectory filename)
+ (if (buffer-modified-p buf)
+ " and discard your edits"
+ "")))
((yes-or-no-p
(if (string= (file-name-nondirectory filename)
(buffer-name buf))
@@ -2382,7 +2480,8 @@ Do you want to revisit the file normally now? ")))
(set-buffer-multibyte t))
(if rawfile
(condition-case ()
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (enable-local-variables nil))
(insert-file-contents-literally filename t))
(file-error
(when (and (file-exists-p filename)
@@ -2421,7 +2520,7 @@ Do you want to revisit the file normally now? ")))
(not (funcall backup-enable-predicate buffer-file-name))
(setq-local backup-inhibited t))
(if rawfile
- (progn
+ (let ((enable-local-variables nil))
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'no-conversion)
(set-buffer-major-mode buf)
@@ -2529,23 +2628,20 @@ unless NOMODES is non-nil."
(let* (not-serious
(msg
(cond
- ((not warn) nil)
- ((and error (file-attributes buffer-file-name))
+ ((and error (file-exists-p buffer-file-name))
(setq buffer-read-only t)
- (if (and (file-symlink-p buffer-file-name)
- (not (file-exists-p
- (file-chase-links buffer-file-name))))
- "Symbolic link that points to nonexistent file"
- "File exists, but cannot be read"))
+ "File exists, but cannot be read")
+ ((and error (file-symlink-p buffer-file-name))
+ "Symbolic link that points to nonexistent file")
((not buffer-read-only)
- (if (and warn
- ;; No need to warn if buffer is auto-saved
- ;; under the name of the visited file.
- (not (and buffer-file-name
- auto-save-visited-file-name))
- (file-newer-than-file-p (or buffer-auto-save-file-name
- (make-auto-save-file-name))
- buffer-file-name))
+ (if (and
+ ;; No need to warn if buffer is auto-saved
+ ;; under the name of the visited file.
+ (not (and buffer-file-name
+ auto-save-visited-file-name))
+ (file-newer-than-file-p (or buffer-auto-save-file-name
+ (make-auto-save-file-name))
+ buffer-file-name))
(format "%s has auto save data; consider M-x recover-this-file"
(file-name-nondirectory buffer-file-name))
(setq not-serious t)
@@ -2553,14 +2649,13 @@ unless NOMODES is non-nil."
((not error)
(setq not-serious t)
"Note: file is write protected")
- ((file-attributes (directory-file-name default-directory))
+ ((file-accessible-directory-p default-directory)
"File not found and directory write-protected")
- ((file-exists-p (file-name-directory buffer-file-name))
- (setq buffer-read-only nil))
(t
(setq buffer-read-only nil)
- "Use M-x make-directory RET RET to create the directory and its parents"))))
- (when msg
+ (unless (file-directory-p default-directory)
+ "Use M-x make-directory RET RET to create the directory and its parents")))))
+ (when (and warn msg)
(message "%s" msg)
(or not-serious (sit-for 1 t))))
(when (and auto-save-default (not noauto))
@@ -2726,6 +2821,7 @@ since only a single case-insensitive search through the alist is made."
("\\.scm\\.[0-9]*\\'" . scheme-mode)
("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
("\\.bash\\'" . sh-mode)
+ ("/PKGBUILD\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
@@ -2913,7 +3009,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" .
("\\.xmp\\'" . image-mode)
("\\.xwd\\'" . image-mode)
("\\.yuv\\'" . image-mode)))
- "Alist of filename patterns vs corresponding major mode functions.
+ "Alist of file name patterns vs corresponding major mode functions.
Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
\(NON-NIL stands for anything that is not nil; the value does not matter.)
Visiting a file whose name matches REGEXP specifies FUNCTION as the
@@ -3099,14 +3195,73 @@ If FUNCTION is nil, then it is not called.")
"Upper limit on `magic-mode-alist' regexp matches.
Also applies to `magic-fallback-mode-alist'.")
+(defun set-auto-mode--apply-alist (alist keep-mode-if-same dir-local)
+ "Helper function for `set-auto-mode'.
+This function takes an alist of the same form as
+`auto-mode-alist'. It then tries to find the appropriate match
+in the alist for the current buffer; setting the mode if
+possible.
+Return non-nil if the mode was set, nil otherwise.
+DIR-LOCAL non-nil means this call is via directory-locals, and
+extra checks should be done."
+ (if buffer-file-name
+ (let (mode
+ (name buffer-file-name)
+ (remote-id (file-remote-p buffer-file-name))
+ (case-insensitive-p (file-name-case-insensitive-p
+ buffer-file-name)))
+ ;; Remove backup-suffixes from file name.
+ (setq name (file-name-sans-versions name))
+ ;; Remove remote file name identification.
+ (when (and (stringp remote-id)
+ (string-match (regexp-quote remote-id) name))
+ (setq name (substring name (match-end 0))))
+ (while name
+ ;; Find first matching alist entry.
+ (setq mode
+ (if case-insensitive-p
+ ;; Filesystem is case-insensitive.
+ (let ((case-fold-search t))
+ (assoc-default name alist 'string-match))
+ ;; Filesystem is case-sensitive.
+ (or
+ ;; First match case-sensitively.
+ (let ((case-fold-search nil))
+ (assoc-default name alist 'string-match))
+ ;; Fallback to case-insensitive match.
+ (and auto-mode-case-fold
+ (let ((case-fold-search t))
+ (assoc-default name alist 'string-match))))))
+ (if (and mode
+ (consp mode)
+ (cadr mode))
+ (setq mode (car mode)
+ name (substring name 0 (match-beginning 0)))
+ (setq name nil)))
+ (when (and dir-local mode
+ (not (set-auto-mode--dir-local-valid-p mode)))
+ (message "Ignoring invalid mode `%s'" mode)
+ (setq mode nil))
+ (when mode
+ (set-auto-mode-0 mode keep-mode-if-same)
+ t))))
+
+(defun set-auto-mode--dir-local-valid-p (mode)
+ "Say whether MODE can be used in a .dir-local.el `auto-mode-alist'."
+ (and (symbolp mode)
+ (string-suffix-p "-mode" (symbol-name mode))
+ (commandp mode)
+ (not (provided-mode-derived-p mode 'special-mode))))
+
(defun set-auto-mode (&optional keep-mode-if-same)
"Select major mode appropriate for current buffer.
To find the right major mode, this function checks for a -*- mode tag
checks for a `mode:' entry in the Local Variables section of the file,
+checks if there an `auto-mode-alist' entry in `.dir-locals.el',
checks if it uses an interpreter listed in `interpreter-mode-alist',
matches the buffer beginning against `magic-mode-alist',
-compares the filename against the entries in `auto-mode-alist',
+compares the file name against the entries in `auto-mode-alist',
then matches the buffer beginning against `magic-fallback-mode-alist'.
If `enable-local-variables' is nil, or if the file name matches
@@ -3160,13 +3315,16 @@ we don't actually set it to the same mode the buffer already has."
(or (set-auto-mode-0 mode keep-mode-if-same)
;; continuing would call minor modes again, toggling them off
(throw 'nop nil))))))
- ;; hack-local-variables checks local-enable-local-variables etc, but
- ;; we might as well be explicit here for the sake of clarity.
+ ;; Check for auto-mode-alist entry in dir-locals.
+ (unless done
+ (with-demoted-errors "Directory-local variables error: %s"
+ ;; Note this is a no-op if enable-local-variables is nil.
+ (let* ((mode-alist (cdr (hack-dir-local--get-variables
+ (lambda (key) (eq key 'auto-mode-alist))))))
+ (setq done (set-auto-mode--apply-alist mode-alist
+ keep-mode-if-same t)))))
(and (not done)
- enable-local-variables
- local-enable-local-variables
- try-locals
- (setq mode (hack-local-variables t))
+ (setq mode (hack-local-variables t (not try-locals)))
(not (memq mode modes)) ; already tried and failed
(if (not (functionp mode))
(message "Ignoring unknown mode `%s'" mode)
@@ -3216,45 +3374,8 @@ we don't actually set it to the same mode the buffer already has."
(set-auto-mode-0 done keep-mode-if-same)))
;; Next compare the filename against the entries in auto-mode-alist.
(unless done
- (if buffer-file-name
- (let ((name buffer-file-name)
- (remote-id (file-remote-p buffer-file-name))
- (case-insensitive-p (file-name-case-insensitive-p
- buffer-file-name)))
- ;; Remove backup-suffixes from file name.
- (setq name (file-name-sans-versions name))
- ;; Remove remote file name identification.
- (when (and (stringp remote-id)
- (string-match (regexp-quote remote-id) name))
- (setq name (substring name (match-end 0))))
- (while name
- ;; Find first matching alist entry.
- (setq mode
- (if case-insensitive-p
- ;; Filesystem is case-insensitive.
- (let ((case-fold-search t))
- (assoc-default name auto-mode-alist
- 'string-match))
- ;; Filesystem is case-sensitive.
- (or
- ;; First match case-sensitively.
- (let ((case-fold-search nil))
- (assoc-default name auto-mode-alist
- 'string-match))
- ;; Fallback to case-insensitive match.
- (and auto-mode-case-fold
- (let ((case-fold-search t))
- (assoc-default name auto-mode-alist
- 'string-match))))))
- (if (and mode
- (consp mode)
- (cadr mode))
- (setq mode (car mode)
- name (substring name 0 (match-beginning 0)))
- (setq name nil))
- (when mode
- (set-auto-mode-0 mode keep-mode-if-same)
- (setq done t))))))
+ (setq done (set-auto-mode--apply-alist auto-mode-alist
+ keep-mode-if-same nil)))
;; Next try matching the buffer beginning against magic-fallback-mode-alist.
(unless done
(if (setq done (save-excursion
@@ -3348,13 +3469,27 @@ Major modes can use this to examine user-specified local variables
in order to initialize other data structure based on them.")
(defcustom safe-local-variable-values nil
- "List variable-value pairs that are considered safe.
+ "List of variable-value pairs that are considered safe.
Each element is a cons cell (VAR . VAL), where VAR is a variable
-symbol and VAL is a value that is considered safe."
+symbol and VAL is a value that is considered safe.
+
+Also see `ignored-local-variable-values'."
:risky t
:group 'find-file
:type 'alist)
+(defcustom ignored-local-variable-values nil
+ "List of variable-value pairs that should always be ignored.
+Each element is a cons cell (VAR . VAL), where VAR is a variable
+symbol and VAL is its value; if VAR is set to VAL by a file-local
+variables section, that setting should be ignored.
+
+Also see `safe-local-variable-values'."
+ :risky t
+ :group 'find-file
+ :type 'alist
+ :version "28.1")
+
(defcustom safe-local-eval-forms
;; This should be here at least as long as Emacs supports write-file-hooks.
'((add-hook 'write-file-hooks 'time-stamp)
@@ -3465,6 +3600,10 @@ function is allowed to change the contents of this alist.
This hook is called only if there is at least one file-local
variable to set.")
+(defvar permanently-enabled-local-variables '(lexical-binding)
+ "A list of file-local variables that are always enabled.
+This overrides any `enable-local-variables' setting.")
+
(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars dir-name)
"Get confirmation before setting up local variable values.
ALL-VARS is the list of all variables to be set up.
@@ -3501,7 +3640,9 @@ n -- to ignore the local variables list.")
(if offer-save
(insert "
! -- to apply the local variables list, and permanently mark these
- values (*) as safe (in the future, they will be set automatically.)\n\n")
+ values (*) as safe (in the future, they will be set automatically.)
+i -- to ignore the local variables list, and permanently mark these
+ values (*) as ignored\n\n")
(insert "\n\n"))
(dolist (elt all-vars)
(cond ((member elt unsafe-vars)
@@ -3525,16 +3666,24 @@ n -- to ignore the local variables list.")
(pop-to-buffer buf '(display-buffer--maybe-at-bottom))
(let* ((exit-chars '(?y ?n ?\s))
(prompt (format "Please type %s%s: "
- (if offer-save "y, n, or !" "y or n")
+ (if offer-save "y, n, ! or i" "y or n")
(if (< (line-number-at-pos (point-max))
(window-body-height))
""
", or C-v/M-v to scroll")))
char)
- (if offer-save (push ?! exit-chars))
+ (when offer-save
+ (push ?i exit-chars)
+ (push ?! exit-chars))
(setq char (read-char-choice prompt exit-chars))
- (when (and offer-save (= char ?!) unsafe-vars)
- (customize-push-and-save 'safe-local-variable-values unsafe-vars))
+ (when (and offer-save
+ (or (= char ?!) (= char ?i))
+ unsafe-vars)
+ (customize-push-and-save
+ (if (= char ?!)
+ 'safe-local-variable-values
+ 'ignored-local-variable-values)
+ unsafe-vars))
(prog1 (memq char '(?! ?\s ?y))
(quit-window t)))))))
@@ -3627,13 +3776,18 @@ If these settings come from directory-local variables, then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
- (let (all-vars risky-vars unsafe-vars)
+ (let (all-vars risky-vars unsafe-vars ignored)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
(cond ((memq var ignored-local-variables)
;; Ignore any variable in `ignored-local-variables'.
nil)
+ ((seq-some (lambda (elem)
+ (and (eq (car elem) var)
+ (eq (cdr elem) val)))
+ ignored-local-variable-values)
+ nil)
;; Obey `enable-local-eval'.
((eq var 'eval)
(when enable-local-eval
@@ -3678,25 +3832,26 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; TODO? Warn once per file rather than once per session?
(defvar hack-local-variables--warned-lexical nil)
-(defun hack-local-variables (&optional handle-mode)
+(defun hack-local-variables (&optional handle-mode inhibit-locals)
"Parse and put into effect this buffer's local variables spec.
For buffers visiting files, also puts into effect directory-local
variables.
-Uses `hack-local-variables-apply' to apply the variables.
-If HANDLE-MODE is nil, we apply all the specified local
-variables. If HANDLE-MODE is neither nil nor t, we do the same,
-except that any settings of `mode' are ignored.
+Uses `hack-local-variables-apply' to apply the variables.
-If HANDLE-MODE is t, all we do is check whether a \"mode:\"
-is specified, and return the corresponding mode symbol, or nil.
-In this case, we try to ignore minor-modes, and return only a
-major-mode.
+See `hack-local-variables--find-variables' for the meaning of
+HANDLE-MODE.
-If `enable-local-variables' or `local-enable-local-variables' is nil,
-this function does nothing. If `inhibit-local-variables-regexps'
+If `enable-local-variables' or `local-enable-local-variables' is
+nil, or INHIBIT-LOCALS is non-nil, this function disregards all
+normal local variables. If `inhibit-local-variables-regexps'
applies to the file in question, the file is not scanned for
-local variables, but directory-local variables may still be applied."
+local variables, but directory-local variables may still be
+applied.
+
+Variables present in `permanently-enabled-local-variables' will
+still be evaluated, even if local variables are otherwise
+inhibited."
;; We don't let inhibit-local-variables-p influence the value of
;; enable-local-variables, because then it would affect dir-local
;; variables. We don't want to search eg tar files for file local
@@ -3704,9 +3859,18 @@ local variables, but directory-local variables may still be applied."
;; to them. The real meaning of inhibit-local-variables-p is "do
;; not scan this file for local variables".
(let ((enable-local-variables
- (and local-enable-local-variables enable-local-variables))
- result)
- (unless (eq handle-mode t)
+ (and (not inhibit-locals)
+ local-enable-local-variables enable-local-variables)))
+ (if (eq handle-mode t)
+ ;; We're looking just for the major mode setting.
+ (and enable-local-variables
+ (not (inhibit-local-variables-p))
+ ;; If HANDLE-MODE is t, and the prop line specifies a
+ ;; mode, then we're done, and have no need to scan further.
+ (or (hack-local-variables-prop-line t)
+ ;; Look for the mode elsewhere in the buffer.
+ (hack-local-variables--find-variables t)))
+ ;; Normal handling of local variables.
(setq file-local-variables-alist nil)
(when (and (file-remote-p default-directory)
(fboundp 'hack-connection-local-variables)
@@ -3717,133 +3881,138 @@ local variables, but directory-local variables may still be applied."
(connection-local-criteria-for-default-directory))))
(with-demoted-errors "Directory-local variables error: %s"
;; Note this is a no-op if enable-local-variables is nil.
- (hack-dir-local-variables)))
- ;; This entire function is basically a no-op if enable-local-variables
- ;; is nil. All it does is set file-local-variables-alist to nil.
- (when enable-local-variables
- ;; This part used to ignore enable-local-variables when handle-mode
- ;; was t. That was inappropriate, eg consider the
- ;; (artificial) example of:
- ;; (setq local-enable-local-variables nil)
- ;; Open a file foo.txt that contains "mode: sh".
- ;; It correctly opens in text-mode.
- ;; M-x set-visited-file name foo.c, and it incorrectly stays in text-mode.
- (unless (or (inhibit-local-variables-p)
- ;; If HANDLE-MODE is t, and the prop line specifies a
- ;; mode, then we're done, and have no need to scan further.
- (and (setq result (hack-local-variables-prop-line
- handle-mode))
- (eq handle-mode t)))
- ;; Look for "Local variables:" line in last page.
- (save-excursion
- (goto-char (point-max))
- (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
- 'move)
- (when (let ((case-fold-search t))
- (search-forward "Local Variables:" nil t))
- (skip-chars-forward " \t")
- ;; suffix is what comes after "local variables:" in its line.
- ;; prefix is what comes before "local variables:" in its line.
- (let ((suffix
- (concat
- (regexp-quote (buffer-substring (point)
- (line-end-position)))
- "$"))
- (prefix
- (concat "^" (regexp-quote
- (buffer-substring (line-beginning-position)
- (match-beginning 0))))))
-
- (forward-line 1)
- (let ((startpos (point))
- endpos
- (thisbuf (current-buffer)))
- (save-excursion
- (unless (let ((case-fold-search t))
- (re-search-forward
- (concat prefix "[ \t]*End:[ \t]*" suffix)
- nil t))
- ;; This used to be an error, but really all it means is
- ;; that this may simply not be a local-variables section,
- ;; so just ignore it.
- (message "Local variables list is not properly terminated"))
- (beginning-of-line)
- (setq endpos (point)))
-
- (with-temp-buffer
- (insert-buffer-substring thisbuf startpos endpos)
- (goto-char (point-min))
- (subst-char-in-region (point) (point-max) ?\^m ?\n)
- (while (not (eobp))
- ;; Discard the prefix.
- (if (looking-at prefix)
- (delete-region (point) (match-end 0))
- (error "Local variables entry is missing the prefix"))
- (end-of-line)
- ;; Discard the suffix.
- (if (looking-back suffix (line-beginning-position))
- (delete-region (match-beginning 0) (point))
- (error "Local variables entry is missing the suffix"))
- (forward-line 1))
- (goto-char (point-min))
-
- (while (not (or (eobp)
- (and (eq handle-mode t) result)))
- ;; Find the variable name;
- (unless (looking-at hack-local-variable-regexp)
- (error "Malformed local variable line: %S"
- (buffer-substring-no-properties
- (point) (line-end-position))))
- (goto-char (match-end 1))
- (let* ((str (match-string 1))
- (var (intern str))
- val val2)
- (and (equal (downcase (symbol-name var)) "mode")
- (setq var 'mode))
- ;; Read the variable value.
- (skip-chars-forward "^:")
- (forward-char 1)
- ;; As a defensive measure, we do not allow
- ;; circular data in the file-local data.
- (let ((read-circle nil))
- (setq val (read (current-buffer))))
- (if (eq handle-mode t)
- (and (eq var 'mode)
- ;; Specifying minor-modes via mode: is
- ;; deprecated, but try to reject them anyway.
- (not (string-match
- "-minor\\'"
- (setq val2 (downcase (symbol-name val)))))
- (setq result (intern (concat val2 "-mode"))))
- (cond ((eq var 'coding))
- ((eq var 'lexical-binding)
- (unless hack-local-variables--warned-lexical
- (setq hack-local-variables--warned-lexical t)
- (display-warning
- 'files
- (format-message
- "%s: `lexical-binding' at end of file unreliable"
- (file-name-nondirectory
- ;; We are called from
- ;; 'with-temp-buffer', so we need
- ;; to use 'thisbuf's name in the
- ;; warning message.
- (or (buffer-file-name thisbuf) ""))))))
- ((and (eq var 'mode) handle-mode))
- (t
- (ignore-errors
- (push (cons (if (eq var 'eval)
- 'eval
- (indirect-variable var))
- val)
- result))))))
- (forward-line 1))))))))
- ;; Now we've read all the local variables.
- ;; If HANDLE-MODE is t, return whether the mode was specified.
- (if (eq handle-mode t) result
- ;; Otherwise, set the variables.
- (hack-local-variables-filter result nil)
- (hack-local-variables-apply)))))
+ (hack-dir-local-variables))
+ (let ((result (append (hack-local-variables--find-variables)
+ (hack-local-variables-prop-line))))
+ (if (and enable-local-variables
+ (not (inhibit-local-variables-p)))
+ (progn
+ ;; Set the variables.
+ (hack-local-variables-filter result nil)
+ (hack-local-variables-apply))
+ ;; Handle `lexical-binding' and other special local
+ ;; variables.
+ (dolist (variable permanently-enabled-local-variables)
+ (when-let ((elem (assq variable result)))
+ (push elem file-local-variables-alist)))
+ (hack-local-variables-apply))))))
+
+(defun hack-local-variables--find-variables (&optional handle-mode)
+ "Return all local variables in the ucrrent buffer.
+If HANDLE-MODE is nil, we gather all the specified local
+variables. If HANDLE-MODE is neither nil nor t, we do the same,
+except that any settings of `mode' are ignored.
+
+If HANDLE-MODE is t, all we do is check whether a \"mode:\"
+is specified, and return the corresponding mode symbol, or nil.
+In this case, we try to ignore minor-modes, and return only a
+major-mode."
+ (let ((result nil))
+ ;; Look for "Local variables:" line in last page.
+ (save-excursion
+ (goto-char (point-max))
+ (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
+ 'move)
+ (when (let ((case-fold-search t))
+ (search-forward "Local Variables:" nil t))
+ (skip-chars-forward " \t")
+ ;; suffix is what comes after "local variables:" in its line.
+ ;; prefix is what comes before "local variables:" in its line.
+ (let ((suffix
+ (concat
+ (regexp-quote (buffer-substring (point)
+ (line-end-position)))
+ "$"))
+ (prefix
+ (concat "^" (regexp-quote
+ (buffer-substring (line-beginning-position)
+ (match-beginning 0))))))
+
+ (forward-line 1)
+ (let ((startpos (point))
+ endpos
+ (thisbuf (current-buffer)))
+ (save-excursion
+ (unless (let ((case-fold-search t))
+ (re-search-forward
+ (concat prefix "[ \t]*End:[ \t]*" suffix)
+ nil t))
+ ;; This used to be an error, but really all it means is
+ ;; that this may simply not be a local-variables section,
+ ;; so just ignore it.
+ (message "Local variables list is not properly terminated"))
+ (beginning-of-line)
+ (setq endpos (point)))
+
+ (with-temp-buffer
+ (insert-buffer-substring thisbuf startpos endpos)
+ (goto-char (point-min))
+ (subst-char-in-region (point) (point-max) ?\^m ?\n)
+ (while (not (eobp))
+ ;; Discard the prefix.
+ (if (looking-at prefix)
+ (delete-region (point) (match-end 0))
+ (error "Local variables entry is missing the prefix"))
+ (end-of-line)
+ ;; Discard the suffix.
+ (if (looking-back suffix (line-beginning-position))
+ (delete-region (match-beginning 0) (point))
+ (error "Local variables entry is missing the suffix"))
+ (forward-line 1))
+ (goto-char (point-min))
+
+ (while (not (or (eobp)
+ (and (eq handle-mode t) result)))
+ ;; Find the variable name;
+ (unless (looking-at hack-local-variable-regexp)
+ (error "Malformed local variable line: %S"
+ (buffer-substring-no-properties
+ (point) (line-end-position))))
+ (goto-char (match-end 1))
+ (let* ((str (match-string 1))
+ (var (intern str))
+ val val2)
+ (and (equal (downcase (symbol-name var)) "mode")
+ (setq var 'mode))
+ ;; Read the variable value.
+ (skip-chars-forward "^:")
+ (forward-char 1)
+ ;; As a defensive measure, we do not allow
+ ;; circular data in the file-local data.
+ (let ((read-circle nil))
+ (setq val (read (current-buffer))))
+ (if (eq handle-mode t)
+ (and (eq var 'mode)
+ ;; Specifying minor-modes via mode: is
+ ;; deprecated, but try to reject them anyway.
+ (not (string-match
+ "-minor\\'"
+ (setq val2 (downcase (symbol-name val)))))
+ (setq result (intern (concat val2 "-mode"))))
+ (cond ((eq var 'coding))
+ ((eq var 'lexical-binding)
+ (unless hack-local-variables--warned-lexical
+ (setq hack-local-variables--warned-lexical t)
+ (display-warning
+ 'files
+ (format-message
+ "%s: `lexical-binding' at end of file unreliable"
+ (file-name-nondirectory
+ ;; We are called from
+ ;; 'with-temp-buffer', so we need
+ ;; to use 'thisbuf's name in the
+ ;; warning message.
+ (or (buffer-file-name thisbuf) ""))))))
+ ((and (eq var 'mode) handle-mode))
+ (t
+ (ignore-errors
+ (push (cons (if (eq var 'eval)
+ 'eval
+ (indirect-variable var))
+ val)
+ result))))))
+ (forward-line 1)))))))
+ result))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.
@@ -3981,7 +4150,7 @@ already the major mode."
('eval
(pcase val
(`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook)))
- (save-excursion (eval val)))
+ (save-excursion (eval val t)))
(_
(hack-one-local-variable--obsolete var)
;; Make sure the string has no text properties.
@@ -4027,10 +4196,13 @@ Returns the new list."
;; Need a new cons in case we setcdr later.
(push (cons variable value) variables)))))
-(defun dir-locals-collect-variables (class-variables root variables)
+(defun dir-locals-collect-variables (class-variables root variables
+ &optional predicate)
"Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
-Return the new variables list."
+Return the new variables list.
+If PREDICATE is given, it is used to test a symbol key in the alist
+to see whether it should be considered."
(let* ((file-name (or (buffer-file-name)
;; Handle non-file buffers, too.
(expand-file-name default-directory)))
@@ -4049,9 +4221,11 @@ Return the new variables list."
(>= (length sub-file-name) (length key))
(string-prefix-p key sub-file-name))
(setq variables (dir-locals-collect-variables
- (cdr entry) root variables))))
- ((or (not key)
- (derived-mode-p key))
+ (cdr entry) root variables predicate))))
+ ((if predicate
+ (funcall predicate key)
+ (or (not key)
+ (derived-mode-p key)))
(let* ((alist (cdr entry))
(subdirs (assq 'subdirs alist)))
(if (or (not subdirs)
@@ -4301,6 +4475,9 @@ Return the new class name, which is a symbol named DIR."
(let ((read-circle nil))
(read (current-buffer)))
(end-of-file nil))))
+ (unless (listp newvars)
+ (message "Invalid data in %s: %s" file newvars)
+ (setq newvars nil))
(setq variables
;; Try and avoid loading `map' since that also loads cl-lib
;; which then might hamper bytecomp warnings (bug#30635).
@@ -4345,13 +4522,13 @@ Return the new class name, which is a symbol named DIR."
(defvar hack-dir-local-variables--warned-coding nil)
-(defun hack-dir-local-variables ()
+(defun hack-dir-local--get-variables (predicate)
"Read per-directory local variables for the current buffer.
-Store the directory-local variables in `dir-local-variables-alist'
-and `file-local-variables-alist', without applying them.
-
-This does nothing if either `enable-local-variables' or
-`enable-dir-local-variables' are nil."
+Return a cons of the form (DIR . ALIST), where DIR is the
+directory name (maybe nil) and ALIST is an alist of all variables
+that might apply. These will be filtered according to the
+buffer's directory, but not according to its mode.
+PREDICATE is passed to `dir-locals-collect-variables'."
(when (and enable-local-variables
enable-dir-local-variables
(or enable-remote-dir-locals
@@ -4370,21 +4547,33 @@ This does nothing if either `enable-local-variables' or
(setq dir-name (nth 0 dir-or-cache))
(setq class (nth 1 dir-or-cache))))
(when class
- (let ((variables
- (dir-locals-collect-variables
- (dir-locals-get-class-variables class) dir-name nil)))
- (when variables
- (dolist (elt variables)
- (if (eq (car elt) 'coding)
- (unless hack-dir-local-variables--warned-coding
- (setq hack-dir-local-variables--warned-coding t)
- (display-warning 'files
- "Coding cannot be specified by dir-locals"))
- (unless (memq (car elt) '(eval mode))
- (setq dir-local-variables-alist
- (assq-delete-all (car elt) dir-local-variables-alist)))
- (push elt dir-local-variables-alist)))
- (hack-local-variables-filter variables dir-name)))))))
+ (cons dir-name
+ (dir-locals-collect-variables
+ (dir-locals-get-class-variables class)
+ dir-name nil predicate))))))
+
+(defun hack-dir-local-variables ()
+ "Read per-directory local variables for the current buffer.
+Store the directory-local variables in `dir-local-variables-alist'
+and `file-local-variables-alist', without applying them.
+
+This does nothing if either `enable-local-variables' or
+`enable-dir-local-variables' are nil."
+ (let* ((items (hack-dir-local--get-variables nil))
+ (dir-name (car items))
+ (variables (cdr items)))
+ (when variables
+ (dolist (elt variables)
+ (if (eq (car elt) 'coding)
+ (unless hack-dir-local-variables--warned-coding
+ (setq hack-dir-local-variables--warned-coding t)
+ (display-warning 'files
+ "Coding cannot be specified by dir-locals"))
+ (unless (memq (car elt) '(eval mode))
+ (setq dir-local-variables-alist
+ (assq-delete-all (car elt) dir-local-variables-alist)))
+ (push elt dir-local-variables-alist)))
+ (hack-local-variables-filter variables dir-name))))
(defun hack-dir-local-variables-non-file-buffer ()
"Apply directory-local variables to a non-file buffer.
@@ -4831,6 +5020,27 @@ extension, the value is \"\"."
(if period
"")))))
+(defun file-name-with-extension (filename extension)
+ "Set the EXTENSION of a FILENAME.
+The extension (in a file name) is the part that begins with the last \".\".
+
+Trims a leading dot from the EXTENSION so that either \"foo\" or
+\".foo\" can be given.
+
+Errors if the FILENAME or EXTENSION are empty, or if the given
+FILENAME has the format of a directory.
+
+See also `file-name-sans-extension'."
+ (let ((extn (string-trim-left extension "[.]")))
+ (cond ((string-empty-p filename)
+ (error "Empty filename: %s" filename))
+ ((string-empty-p extn)
+ (error "Malformed extension: %s" extension))
+ ((directory-name-p filename)
+ (error "Filename is a directory: %s" filename))
+ (t
+ (concat (file-name-sans-extension filename) "." extn)))))
+
(defun file-name-base (&optional filename)
"Return the base name of the FILENAME: no directory, no extension."
(declare (advertised-calling-convention (filename) "27.1"))
@@ -4857,7 +5067,7 @@ See also `backup-directory-alist'."
(function :tag "Function")))
(defcustom backup-directory-alist nil
- "Alist of filename patterns and backup directory names.
+ "Alist of file name patterns and backup directory names.
Each element looks like (REGEXP . DIRECTORY). Backups of files with
names matching REGEXP will be made in DIRECTORY. DIRECTORY may be
relative or absolute. If it is absolute, so that all matching files
@@ -4870,7 +5080,7 @@ For the common case of all backups going into one directory, the alist
should contain a single element pairing \".\" with the appropriate
directory name.
-If this variable is nil, or it fails to match a filename, the backup
+If this variable is nil, or it fails to match a file name, the backup
is made in the original file's directory.
On MS-DOS filesystems without long names this variable is always
@@ -4991,7 +5201,7 @@ The function `find-backup-file-name' also uses this."
(expand-file-name
(subst-char-in-string
?/ ?!
- (replace-regexp-in-string "!" "!!" file))
+ (string-replace "!" "!!" file))
backup-directory))
(expand-file-name (file-name-nondirectory file)
(file-name-as-directory abs-backup-directory))))))
@@ -5517,9 +5727,23 @@ be saved."
:group 'auto-save
;; FIXME nil should not be a valid option, let alone the default,
;; eg so that add-function can be used.
- :type '(choice (const :tag "Default" nil) function)
+ :type '(choice (const :tag "Default" nil)
+ (function :tag "Only in subdirs of root"
+ save-some-buffers-root)
+ (function :tag "Custom function"))
:version "26.1")
+(defun save-some-buffers-root ()
+ "A predicate to check whether the buffer is under the root directory.
+Can be used as a value of `save-some-buffers-default-predicate'
+to save buffers only under the project root or in subdirectories
+of the directory that was default during command invocation."
+ (let ((root (or (and (featurep 'project) (project-current)
+ (fboundp 'project-root)
+ (project-root (project-current)))
+ default-directory)))
+ (lambda () (file-in-directory-p default-directory root))))
+
(defun save-some-buffers (&optional arg pred)
"Save some modified file-visiting buffers. Asks user about each one.
You can answer `y' or SPC to save, `n' or DEL not to save, `C-r'
@@ -5548,6 +5772,11 @@ change the additional actions you can take on files."
(interactive "P")
(unless pred
(setq pred save-some-buffers-default-predicate))
+ ;; Allow `pred' to be a function that returns a predicate
+ ;; with lexical bindings in its original environment (bug#46374).
+ (let ((pred-fun (and (functionp pred) (funcall pred))))
+ (when (functionp pred-fun)
+ (setq pred pred-fun)))
(let* ((switched-buffer nil)
(save-some-buffers--switch-window-callback
(lambda (buffer)
@@ -6115,9 +6344,6 @@ This undoes all changes since the file was visited or saved.
With a prefix argument, offer to revert from latest auto-save file, if
that is more recent than the visited file.
-Reverting a buffer will try to preserve markers in the buffer;
-see the Info node `(elisp)Reverting' for details.
-
This command also implements an interface for special buffers
that contain text that doesn't come from a file, but reflects
some other data instead (e.g. Dired buffers, `buffer-list'
@@ -6143,7 +6369,12 @@ This function binds `revert-buffer-in-progress-p' non-nil while it operates.
This function calls the function that `revert-buffer-function' specifies
to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
The default function runs the hooks `before-revert-hook' and
-`after-revert-hook'."
+`after-revert-hook'
+
+Reverting a buffer will try to preserve markers in the buffer,
+but it cannot always preserve all of them. For better results,
+use `revert-buffer-with-fine-grain', which tries harder to
+preserve markers and overlays, at the price of being slower."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there that assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
@@ -6187,8 +6418,11 @@ Non-file buffers need a custom function."
(dolist (regexp revert-without-query)
(when (string-match regexp file-name)
(throw 'found t)))))
- (yes-or-no-p (format "Revert buffer from file %s? "
- file-name)))
+ (yes-or-no-p
+ (format (if (buffer-modified-p)
+ "Discard edits and reread from %s? "
+ "Revert buffer from file %s? ")
+ file-name)))
(run-hooks 'before-revert-hook)
;; If file was backed up but has changed since,
;; we should make another backup.
@@ -6237,11 +6471,6 @@ an auto-save file."
"Cannot revert unreadable file %s")
file-name))
(t
- ;; Bind buffer-file-name to nil
- ;; so that we don't try to lock the file.
- (let ((buffer-file-name nil))
- (or auto-save-p
- (unlock-buffer)))
(widen)
(let ((coding-system-for-read
;; Auto-saved file should be read by Emacs's
@@ -6323,7 +6552,8 @@ see `replace-buffer-contents'."
;; See comments in revert-buffer-with-fine-grain for an explanation.
(defun revert-buffer-with-fine-grain-success-p ()
success))
- (set-buffer-modified-p nil))))
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime))))
(defun revert-buffer-with-fine-grain (&optional ignore-auto noconfirm)
"Revert buffer preserving markers, overlays, etc.
@@ -6350,6 +6580,38 @@ details on the arguments, see `revert-buffer'."
(revert-buffer-with-fine-grain-success-p)
(fmakunbound 'revert-buffer-with-fine-grain-success-p)))))
+(defcustom revert-buffer-quick-short-answers nil
+ "How much confirmation to be done by the `revert-buffer-quick' command.
+If non-nil, use `y-or-n-p' instead of `yes-or-no-p'."
+ :version "28.1"
+ :type 'boolean)
+
+(defun revert-buffer-quick (&optional auto-save)
+ "Like `revert-buffer', but asks for less confirmation.
+If the current buffer is visiting a file, and the buffer is not
+modified, no confirmation is required.
+
+This command heeds the `revert-buffer-quick-short-answers' user option.
+
+If AUTO-SAVE (the prefix argument), offer to revert from latest
+auto-save file, if that is more recent than the visited file."
+ (interactive "P")
+ (cond
+ ;; If we've visiting a file, and we have no changes, don't ask for
+ ;; confirmation.
+ ((and buffer-file-name
+ (not (buffer-modified-p)))
+ (revert-buffer (not auto-save) t)
+ (message "Reverted buffer"))
+ ;; Heed `revert-buffer-quick-short-answers'.
+ (revert-buffer-quick-short-answers
+ (let ((use-short-answers t))
+ (revert-buffer (not auto-save))))
+ ;; Call `revert-buffer' normally.
+ (t
+ (revert-buffer (not auto-save)))))
+
+
(defun recover-this-file ()
"Recover the visited file--get contents from its last auto-save file."
(interactive)
@@ -6405,7 +6667,8 @@ details on the arguments, see `revert-buffer'."
(coding-system-for-read 'auto-save-coding))
(erase-buffer)
(insert-file-contents file-name nil)
- (set-buffer-file-coding-system coding-system))
+ (set-buffer-file-coding-system coding-system)
+ (set-buffer-auto-saved))
(after-find-file nil nil t))
(t (user-error "Recover-file canceled")))))
@@ -6524,6 +6787,7 @@ This command is used in the special Dired buffer created by
(message "No files can be recovered from this session now")))
(kill-buffer buffer))))
+
(defun kill-buffer-ask (buffer)
"Kill BUFFER if confirmed."
(when (yes-or-no-p (format "Buffer %s %s. Kill? "
@@ -6582,61 +6846,15 @@ Does not consider `auto-save-visited-file-name' as that variable is checked
before calling this function.
See also `auto-save-file-name-p'."
(if buffer-file-name
- (let ((handler (find-file-name-handler buffer-file-name
- 'make-auto-save-file-name)))
+ (let ((handler (find-file-name-handler
+ buffer-file-name 'make-auto-save-file-name)))
(if handler
(funcall handler 'make-auto-save-file-name)
- (let ((list auto-save-file-name-transforms)
- (filename buffer-file-name)
- result uniq)
- ;; Apply user-specified translations
- ;; to the file name.
- (while (and list (not result))
- (if (string-match (car (car list)) filename)
- (setq result (replace-match (cadr (car list)) t nil
- filename)
- uniq (car (cddr (car list)))))
- (setq list (cdr list)))
- (if result
- (if uniq
- (setq filename (concat
- (file-name-directory result)
- (subst-char-in-string
- ?/ ?!
- (replace-regexp-in-string "!" "!!"
- filename))))
- (setq filename result)))
- (setq result
- (if (and (eq system-type 'ms-dos)
- (not (msdos-long-file-names)))
- ;; We truncate the file name to DOS 8+3 limits
- ;; before doing anything else, because the regexp
- ;; passed to string-match below cannot handle
- ;; extensions longer than 3 characters, multiple
- ;; dots, and other atrocities.
- (let ((fn (dos-8+3-filename
- (file-name-nondirectory buffer-file-name))))
- (string-match
- "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
- fn)
- (concat (file-name-directory buffer-file-name)
- "#" (match-string 1 fn)
- "." (match-string 3 fn) "#"))
- (concat (file-name-directory filename)
- "#"
- (file-name-nondirectory filename)
- "#")))
- ;; Make sure auto-save file names don't contain characters
- ;; invalid for the underlying filesystem.
- (if (and (memq system-type '(ms-dos windows-nt cygwin))
- ;; Don't modify remote filenames
- (not (file-remote-p result)))
- (convert-standard-filename result)
- result))))
-
+ (files--transform-file-name
+ buffer-file-name auto-save-file-name-transforms
+ "#" "#")))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
-
(let ((buffer-name (buffer-name))
(limit 0)
file-name)
@@ -6684,6 +6902,74 @@ See also `auto-save-file-name-p'."
(file-error nil))
file-name)))
+(defun files--transform-file-name (filename transforms prefix suffix)
+ "Transform FILENAME according to TRANSFORMS.
+See `auto-save-file-name-transforms' for the format of
+TRANSFORMS. PREFIX is prepended to the non-directory portion of
+the resulting file name, and SUFFIX is appended."
+ (save-match-data
+ (let (result uniq)
+ ;; Apply user-specified translations to the file name.
+ (while (and transforms (not result))
+ (if (string-match (car (car transforms)) filename)
+ (setq result (replace-match (cadr (car transforms)) t nil
+ filename)
+ uniq (car (cddr (car transforms)))))
+ (setq transforms (cdr transforms)))
+ (when result
+ (setq filename
+ (cond
+ ((memq uniq (secure-hash-algorithms))
+ (concat
+ (file-name-directory result)
+ (secure-hash uniq filename)))
+ (uniq
+ (concat
+ (file-name-directory result)
+ (subst-char-in-string
+ ?/ ?!
+ (string-replace
+ "!" "!!" filename))))
+ (t result))))
+ (setq result
+ (if (and (eq system-type 'ms-dos)
+ (not (msdos-long-file-names)))
+ ;; We truncate the file name to DOS 8+3 limits before
+ ;; doing anything else, because the regexp passed to
+ ;; string-match below cannot handle extensions longer
+ ;; than 3 characters, multiple dots, and other
+ ;; atrocities.
+ (let ((fn (dos-8+3-filename
+ (file-name-nondirectory buffer-file-name))))
+ (string-match
+ "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
+ fn)
+ (concat (file-name-directory buffer-file-name)
+ prefix (match-string 1 fn)
+ "." (match-string 3 fn) suffix))
+ (concat (file-name-directory filename)
+ prefix
+ (file-name-nondirectory filename)
+ suffix)))
+ ;; Make sure auto-save file names don't contain characters
+ ;; invalid for the underlying filesystem.
+ (expand-file-name
+ (if (and (memq system-type '(ms-dos windows-nt cygwin))
+ ;; Don't modify remote filenames
+ (not (file-remote-p result)))
+ (convert-standard-filename result)
+ result)))))
+
+(defun make-lock-file-name (filename)
+ "Make a lock file name for FILENAME.
+By default, this just prepends \".#\" to the non-directory part
+of FILENAME, but the transforms in `lock-file-name-transforms'
+are done first."
+ (let ((handler (find-file-name-handler filename 'make-lock-file-name)))
+ (if handler
+ (funcall handler 'make-lock-file-name filename)
+ (files--transform-file-name filename lock-file-name-transforms ".#" ""))))
+
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes.
@@ -6692,7 +6978,7 @@ See also `make-auto-save-file-name'."
(defun wildcard-to-regexp (wildcard)
"Given a shell file name pattern WILDCARD, return an equivalent regexp.
-The generated regexp will match a filename only if the filename
+The generated regexp will match a file name only if the file name
matches that wildcard according to shell rules. Only wildcards known
by `sh' are supported."
(let* ((i (string-match "[[.*+\\^$?]" wildcard))
@@ -6745,7 +7031,7 @@ by `sh' are supported."
(prog1 ; copy everything upto next `]'.
(substring wildcard
i
- (setq j (string-match
+ (setq j (string-search
"]" wildcard i)))
(setq i (if j (1- j) (1- len)))))))
((eq ch ?.) "\\.")
@@ -6871,7 +7157,7 @@ need to be passed verbatim to shell commands."
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
- (if (or (string-match "[\"]" pattern)
+ (if (or (string-search "\"" pattern)
;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
@@ -7177,7 +7463,7 @@ normally equivalent short `-D' option is just passed on to
(unless (equal switches "")
;; Split the switches at any spaces so we can
;; pass separate options as separate args.
- (split-string-and-unquote switches)))
+ (split-string-shell-command switches)))
;; Avoid lossage if FILE starts with `-'.
'("--")
(list file))))))
@@ -7412,7 +7698,7 @@ If the current frame has no client, kill Emacs itself using
With prefix ARG, silently save all file-visiting buffers, then kill.
-If emacsclient was started with a list of filenames to edit, then
+If emacsclient was started with a list of file names to edit, then
only these files will be asked to be saved."
(interactive "P")
(if (frame-parameter nil 'client)
@@ -7433,12 +7719,11 @@ only these files will be asked to be saved."
;; operations, which return a file name. See Bug#29579.
(defun file-name-non-special (operation &rest arguments)
- (let (;; In general, we don't want any file name handler. For some
- ;; few cases, operations with two file name arguments which
- ;; might be bound to different file name handlers, we still
- ;; need this.
- (saved-file-name-handler-alist file-name-handler-alist)
- file-name-handler-alist
+ (let ((inhibit-file-name-handlers
+ (cons 'file-name-non-special
+ (and (eq inhibit-file-name-operation operation)
+ inhibit-file-name-handlers)))
+ (inhibit-file-name-operation operation)
;; Some operations respect file name handlers in
;; `default-directory'. Because core function like
;; `call-process' don't care about file name handlers in
@@ -7520,69 +7805,73 @@ only these files will be asked to be saved."
(when (car pair)
(setcar pair (file-name-unquote (car pair) t))))
(setq file-arg-indices (cdr file-arg-indices))))
- (pcase method
- ('identity (car arguments))
- ('add (file-name-quote (apply operation arguments) t))
- ('buffer-file-name
- (let ((buffer-file-name (file-name-unquote buffer-file-name t)))
- (apply operation arguments)))
- ('insert-file-contents
- (let ((visit (nth 1 arguments)))
- (unwind-protect
- (apply operation arguments)
- (when (and visit buffer-file-name)
- (setq buffer-file-name (file-name-quote buffer-file-name t))))))
- ('unquote-then-quote
- ;; We can't use `cl-letf' with `(buffer-local-value)' here
- ;; because it wouldn't work during bootstrapping.
- (let ((buffer (current-buffer)))
- ;; `unquote-then-quote' is used only for the
- ;; `verify-visited-file-modtime' action, which takes a buffer
- ;; as only optional argument.
- (with-current-buffer (or (car arguments) buffer)
- (let ((buffer-file-name (file-name-unquote buffer-file-name t)))
- ;; Make sure to hide the temporary buffer change from the
- ;; underlying operation.
- (with-current-buffer buffer
- (apply operation arguments))))))
- ('local-copy
- (let* ((file-name-handler-alist saved-file-name-handler-alist)
- (source (car arguments))
- (target (car (cdr arguments)))
- (prefix (expand-file-name
- "file-name-non-special" temporary-file-directory))
- tmpfile)
- (cond
- ;; If source is remote, we must create a local copy.
- ((file-remote-p source)
- (setq tmpfile (make-temp-name prefix))
- (apply operation source tmpfile (cddr arguments))
- (setq source tmpfile))
- ;; If source is quoted, and the unquoted source looks
- ;; remote, we must create a local copy.
- ((file-name-quoted-p source t)
- (setq source (file-name-unquote source t))
- (when (file-remote-p source)
+ ;; In general, we don't want any file name handler, see Bug#47625,
+ ;; Bug#48349. For some few cases, operations with two file name
+ ;; arguments which might be bound to different file name handlers,
+ ;; we still need this.
+ (let ((tramp-mode (and tramp-mode (eq method 'local-copy))))
+ (pcase method
+ ('identity (car arguments))
+ ('add (file-name-quote (apply operation arguments) t))
+ ('buffer-file-name
+ (let ((buffer-file-name (file-name-unquote buffer-file-name t)))
+ (apply operation arguments)))
+ ('insert-file-contents
+ (let ((visit (nth 1 arguments)))
+ (unwind-protect
+ (apply operation arguments)
+ (when (and visit buffer-file-name)
+ (setq buffer-file-name (file-name-quote buffer-file-name t))))))
+ ('unquote-then-quote
+ ;; We can't use `cl-letf' with `(buffer-local-value)' here
+ ;; because it wouldn't work during bootstrapping.
+ (let ((buffer (current-buffer)))
+ ;; `unquote-then-quote' is used only for the
+ ;; `verify-visited-file-modtime' action, which takes a
+ ;; buffer as only optional argument.
+ (with-current-buffer (or (car arguments) buffer)
+ (let ((buffer-file-name (file-name-unquote buffer-file-name t)))
+ ;; Make sure to hide the temporary buffer change from
+ ;; the underlying operation.
+ (with-current-buffer buffer
+ (apply operation arguments))))))
+ ('local-copy
+ (let ((source (car arguments))
+ (target (car (cdr arguments)))
+ (prefix (expand-file-name
+ "file-name-non-special" temporary-file-directory))
+ tmpfile)
+ (cond
+ ;; If source is remote, we must create a local copy.
+ ((file-remote-p source)
(setq tmpfile (make-temp-name prefix))
- (let (file-name-handler-alist)
- (apply operation source tmpfile (cddr arguments)))
- (setq source tmpfile))))
- ;; If target is quoted, and the unquoted target looks remote,
- ;; we must disable the file name handler.
- (when (file-name-quoted-p target t)
- (setq target (file-name-unquote target t))
- (when (file-remote-p target)
- (setq file-name-handler-alist nil)))
- ;; Do it.
- (setcar arguments source)
- (setcar (cdr arguments) target)
- (apply operation arguments)
- ;; Cleanup.
- (when (and tmpfile (file-exists-p tmpfile))
- (if (file-directory-p tmpfile)
- (delete-directory tmpfile 'recursive) (delete-file tmpfile)))))
- (_
- (apply operation arguments)))))
+ (apply operation source tmpfile (cddr arguments))
+ (setq source tmpfile))
+ ;; If source is quoted, and the unquoted source looks
+ ;; remote, we must create a local copy.
+ ((file-name-quoted-p source t)
+ (setq source (file-name-unquote source t))
+ (when (file-remote-p source)
+ (setq tmpfile (make-temp-name prefix))
+ (let (file-name-handler-alist)
+ (apply operation source tmpfile (cddr arguments)))
+ (setq source tmpfile))))
+ ;; If target is quoted, and the unquoted target looks
+ ;; remote, we must disable the file name handler.
+ (when (file-name-quoted-p target t)
+ (setq target (file-name-unquote target t))
+ (when (file-remote-p target)
+ (setq file-name-handler-alist nil)))
+ ;; Do it.
+ (setcar arguments source)
+ (setcar (cdr arguments) target)
+ (apply operation arguments)
+ ;; Cleanup.
+ (when (and tmpfile (file-exists-p tmpfile))
+ (if (file-directory-p tmpfile)
+ (delete-directory tmpfile 'recursive) (delete-file tmpfile)))))
+ (_
+ (apply operation arguments))))))
(defsubst file-name-quoted-p (name &optional top)
"Whether NAME is quoted with prefix \"/:\".
@@ -7638,6 +7927,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
+ ;; FIXME: These divisions/shifts seem to be right
+ ;; for the `7' part of the #o4700 mask, but not
+ ;; for the `4' part. Same below for `g' and `o'.
(+ uright (/ uright #o10) (/ uright #o100))))
((= char ?g) (let ((gright (logand #o2070 from)))
(+ gright (/ gright #o10) (* gright #o10))))
@@ -7672,11 +7964,28 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
-(defun file-modes-number-to-symbolic (mode)
+(defun file-modes-number-to-symbolic (mode &optional filetype)
+ "Return a string describing a file's MODE.
+For instance, if MODE is #o700, then it produces `-rwx------'.
+FILETYPE if provided should be a character denoting the type of file,
+such as `?d' for a directory, or `?l' for a symbolic link and will override
+the leading `-' char."
(string
- (if (zerop (logand 8192 mode))
- (if (zerop (logand 16384 mode)) ?- ?d)
- ?c) ; completeness
+ (or filetype
+ (pcase (lsh mode -12)
+ ;; POSIX specifies that the file type is included in st_mode
+ ;; and provides names for the file types but values only for
+ ;; the permissions (e.g., S_IWOTH=2).
+
+ ;; (#o017 ??) ;; #define S_IFMT 00170000
+ (#o014 ?s) ;; #define S_IFSOCK 0140000
+ (#o012 ?l) ;; #define S_IFLNK 0120000
+ ;; (8 ??) ;; #define S_IFREG 0100000
+ (#o006 ?b) ;; #define S_IFBLK 0060000
+ (#o004 ?d) ;; #define S_IFDIR 0040000
+ (#o002 ?c) ;; #define S_IFCHR 0020000
+ (#o001 ?p) ;; #define S_IFIFO 0010000
+ (_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
@@ -7732,7 +8041,7 @@ based on existing mode bits, as in \"og+rX-w\"."
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
- (replace-regexp-in-string
+ (string-replace
"-" ""
(format "u=%s,g=%s,o=%s"
(match-string 1 modestr)
@@ -7748,6 +8057,7 @@ based on existing mode bits, as in \"og+rX-w\"."
(define-obsolete-variable-alias 'cache-long-line-scans
'cache-long-scans "24.4")
+
;; Trashcan handling.
(defcustom trash-directory nil
"Directory for `move-file-to-trash' to move files and directories to.
@@ -7863,9 +8173,24 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
;; 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)))
+ (is-directory (file-directory-p fn))
+ (overwrite nil)
+ info-fn)
+ ;; We're checking further down whether the info file
+ ;; exists, but the file name may exist in the trash
+ ;; directory even if there is no info file for it.
+ (when (file-exists-p
+ (file-name-concat trash-files-dir files-base))
+ (setq overwrite t
+ files-base (file-name-nondirectory
+ (make-temp-file
+ (file-name-concat
+ trash-files-dir files-base)
+ is-directory))))
+ (setq info-fn (file-name-concat
+ trash-info-dir
+ (concat files-base ".trashinfo")))
+ ;; Re-check the existence (sort of).
(condition-case nil
(write-region nil nil info-fn nil 'quiet info-fn 'excl)
(file-already-exists
@@ -7873,16 +8198,17 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
;; 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)
+ (file-name-concat trash-info-dir files-base)
nil ".trashinfo"))
(setq files-base (substring (file-name-nondirectory info-fn)
0 (- (length ".trashinfo"))))
(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)
- (new-fn (expand-file-name files-base trash-files-dir)))
- (rename-file fn new-fn)))))))))
+ (new-fn (file-name-concat trash-files-dir files-base)))
+ (rename-file fn new-fn overwrite)))))))))
+
(defsubst file-attribute-type (attributes)
"The type field in ATTRIBUTES returned by `file-attributes'.
The value is either t for directory, string (name linked to) for
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 2ef13ae8320..8e9fae80f69 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -90,7 +90,6 @@
(require 'cl-lib)
(require 'seq)
-(require 'easymenu)
;;; Some variables
@@ -1184,7 +1183,7 @@ Return full path if FULL-FLAG is non-nil."
(constraint-flag
(message "Obsolete :constraint-flag %S, use :constraintp instead"
(cadr constraint-flag))
- (eval (cadr constraint-flag)))
+ (eval (cadr constraint-flag) t))
(t
t))))
@@ -1558,18 +1557,20 @@ Replace <file-name> or <<file-name>> with filename."
(completing-read "Select fileset: " filesets-data nil t))))
(when (and cmd-name name)
(let* ((event (if (equal cmd-name "Grep <<selection>>")
- 'on-grep
+ 'on-grep
'on-cmd))
(files (if (and fileset
- (or (equal mode ':ingroup)
- (equal mode ':tree)))
+ (or (equal mode :ingroup)
+ (equal mode :tree)))
(filesets-get-filelist fileset mode event)
- (filesets-get-filelist
- (filesets-get-fileset-from-name name)
- mode event))))
+ (filesets-get-filelist
+ (filesets-get-fileset-from-name name)
+ mode event))))
(when files
(let ((fn (filesets-cmd-get-fn cmd-name))
- (args (filesets-cmd-get-args cmd-name)))
+ (args
+ (dlet ((filesets--files files))
+ (filesets-cmd-get-args cmd-name))))
(if (memq fn '(multi-isearch-files multi-isearch-files-regexp))
(apply fn args)
(dolist (this files nil)
@@ -1578,28 +1579,27 @@ Replace <file-name> or <<file-name>> with filename."
(let ((buffer (filesets-find-file this)))
(when buffer
(goto-char (point-min))
- (progn
- (cond
- ((stringp fn)
- (let* ((args
- (mapconcat
- (lambda (this)
- (filesets-run-cmd--repl-fn
- this
- (lambda (this)
- (format "%s" this))))
- args
- " "))
- (cmd (concat fn " " args)))
- (filesets-cmd-show-result
- cmd (shell-command-to-string cmd))))
- ((symbolp fn)
- (apply fn
- (mapcan (lambda (this)
- (filesets-run-cmd--repl-fn
- this
- 'list))
- args)))))))))))))))))
+ (cond
+ ((stringp fn)
+ (let* ((args
+ (mapconcat
+ (lambda (this)
+ (filesets-run-cmd--repl-fn
+ this
+ (lambda (this)
+ (format "%s" this))))
+ args
+ " "))
+ (cmd (concat fn " " args)))
+ (filesets-cmd-show-result
+ cmd (shell-command-to-string cmd))))
+ ((symbolp fn)
+ (apply fn
+ (mapcan (lambda (this)
+ (filesets-run-cmd--repl-fn
+ this
+ 'list))
+ args))))))))))))))))
(defun filesets-get-cmd-menu ()
"Create filesets command menu."
@@ -1625,7 +1625,7 @@ Replace <file-name> or <<file-name>> with filename."
(defun filesets-cmd-isearch-getargs ()
"Get arguments for `multi-isearch-files' and `multi-isearch-files-regexp'."
- (and (boundp 'files) (list files)))
+ (and (boundp 'filesets--files) (list filesets--files)))
(defun filesets-cmd-shell-command-getargs ()
"Get arguments for `filesets-cmd-shell-command'."
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index adc5672eca9..87a7407a866 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -225,8 +225,8 @@ it finishes, type \\[kill-find]."
(use-local-map map))
(setq-local dired-sort-inhibit t)
(setq-local revert-buffer-function
- `(lambda (ignore-auto noconfirm)
- (find-dired ,dir ,find-args)))
+ (lambda (_ignore-auto _noconfirm)
+ (find-dired dir find-args)))
;; Set subdir-alist so that Tree Dired will work:
(if (fboundp 'dired-simple-subdir-alist)
;; will work even with nested dired format (dired-nstd.el,v 1.15
diff --git a/lisp/find-file.el b/lisp/find-file.el
index 8cc9c972ed4..4fd4f4e06b8 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -1,4 +1,4 @@
-;;; find-file.el --- find a file corresponding to this one given a pattern
+;;; find-file.el --- find a file corresponding to this one given a pattern -*- lexical-binding: t; -*-
;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au>
;; Maintainer: emacs-devel@gnu.org
@@ -39,8 +39,8 @@
;; and just has a different extension as described by the ff-other-file-alist
;; variable:
;;
-;; '(("\\.cc$" (".hh" ".h"))
-;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp")))
+;; '(("\\.cc\\'" (".hh" ".h"))
+;; ("\\.hh\\'" (".cc" ".C" ".CC" ".cxx" ".cpp")))
;;
;; If the current file has a .cc extension, ff-find-other-file will attempt
;; to look for a .hh file, and then a .h file in some directory as described
@@ -55,8 +55,8 @@
;; format above can be changed to include a function to be called when the
;; current file matches the regexp:
;;
-;; '(("\\.cc$" cc--function)
-;; ("\\.hh$" hh-function))
+;; '(("\\.cc\\'" cc--function)
+;; ("\\.hh\\'" hh-function))
;;
;; These functions must return a list consisting of the possible names of the
;; corresponding file, with or without path. There is no real need for more
@@ -64,10 +64,10 @@
;; file-alist:
;;
;; (setq cc-other-file-alist
-;; '(("\\.cc$" ff-cc-hh-converter)
-;; ("\\.hh$" ff-cc-hh-converter)
-;; ("\\.c$" (".h"))
-;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
+;; '(("\\.cc\\'" ff-cc-hh-converter)
+;; ("\\.hh\\'" ff-cc-hh-converter)
+;; ("\\.c\\'" (".h"))
+;; ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
;;
;; ff-cc-hh-converter is included at the end of this file as a reference.
;;
@@ -130,62 +130,51 @@
(defcustom ff-pre-find-hook nil
"List of functions to be called before the search for the file starts."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-pre-load-hook nil
"List of functions to be called before the other file is loaded."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-post-load-hook nil
"List of functions to be called after the other file is loaded."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-not-found-hook nil
"List of functions to be called if the other file could not be found."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-file-created-hook nil
"List of functions to be called if the other file needs to be created."
- :type 'hook
- :group 'ff)
+ :type 'hook)
(defcustom ff-case-fold-search nil
"Non-nil means ignore cases in matches (see `case-fold-search').
If you have extensions in different cases, you will want this to be nil."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-always-in-other-window nil
"If non-nil, find the corresponding file in another window by default.
To override this, give an argument to `ff-find-other-file'."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-ignore-include nil
"If non-nil, ignore `#include' lines."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-always-try-to-create t
"If non-nil, always attempt to create the other file if it was not found."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
(defcustom ff-quiet-mode nil
"If non-nil, trace which directories are being searched."
- :type 'boolean
- :group 'ff)
+ :type 'boolean)
;;;###autoload
(defcustom ff-special-constructs
;; C/C++ include, for NeXTstep too
`((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
- (lambda ()
- (buffer-substring (match-beginning 2) (match-end 2)))))
+ ,(lambda () (match-string 2))))
;; We include `ff-treat-as-special' documentation here so that autoload
;; can make it available to be read prior to loading this file.
"List of special constructs recognized by `ff-treat-as-special'.
@@ -194,8 +183,7 @@ If REGEXP matches the current line (from the beginning of the line),
`ff-treat-as-special' calls function EXTRACT with no args.
If EXTRACT returns nil, keep trying. Otherwise, return the
filename that EXTRACT returned."
- :type '(repeat (cons regexp function))
- :group 'ff)
+ :type '(repeat (cons regexp function)))
(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
(defcustom ff-other-file-alist 'cc-other-file-alist
@@ -207,8 +195,7 @@ directory specified in `ff-search-directories'. If a file is not found,
a new one is created with the first matching extension (`.cc' yields `.hh').
This alist should be set by the major mode."
:type '(choice (repeat (list regexp (choice (repeat string) function)))
- symbol)
- :group 'ff)
+ symbol))
(defcustom ff-search-directories 'cc-search-directories
"List of directories to search for a specific file.
@@ -231,14 +218,12 @@ not exist, it is replaced (silently) with an empty string.
The stars are *not* wildcards: they are searched for together with
the preceding slash. The star represents all the subdirectories except
`..', and each of these subdirectories will be searched in turn."
- :type '(choice (repeat directory) symbol)
- :group 'ff)
+ :type '(choice (repeat directory) symbol))
(defcustom cc-search-directories
'("." "/usr/include" "/usr/local/include/*")
"See the description of the `ff-search-directories' variable."
- :type '(repeat directory)
- :group 'ff)
+ :type '(repeat directory))
(defcustom cc-other-file-alist
'(("\\.cc\\'" (".hh" ".h"))
@@ -269,17 +254,15 @@ since the search algorithm searches sequentially through each directory
specified in `ff-search-directories'. If a file is not found, a new one
is created with the first matching extension (`.cc' yields `.hh')."
:version "24.4" ; add .m
- :type '(repeat (list regexp (choice (repeat string) function)))
- :group 'ff)
+ :type '(repeat (list regexp (choice (repeat string) function))))
(defcustom modula2-other-file-alist
'(
- ("\\.mi$" (".md")) ;; Modula-2 module definition
- ("\\.md$" (".mi")) ;; and implementation.
+ ("\\.mi\\'" (".md")) ;; Modula-2 module definition
+ ("\\.md\\'" (".mi")) ;; and implementation.
)
"See the description for the `ff-search-directories' variable."
- :type '(repeat (list regexp (choice (repeat string) function)))
- :group 'ff)
+ :type '(repeat (list regexp (choice (repeat string) function))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -308,22 +291,24 @@ See also the documentation for `ff-find-other-file'.
If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(interactive "P")
- (let ((ignore ff-ignore-include))
- (setq ff-ignore-include t)
- (ff-find-the-other-file in-other-window)
- (setq ff-ignore-include ignore)))
+ (let ((ff-ignore-include t))
+ (ff-find-the-other-file in-other-window)))
;;;###autoload
-(defalias 'ff-find-related-file 'ff-find-other-file)
+(defalias 'ff-find-related-file #'ff-find-other-file)
;;;###autoload
-(defun ff-find-other-file (&optional in-other-window ignore-include)
+(defun ff-find-other-file (&optional in-other-window ignore-include event)
"Find the header or source file corresponding to this file.
Being on a `#include' line pulls in that file.
If optional IN-OTHER-WINDOW is non-nil, find the file in the other window.
If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines.
+If optional EVENT is non-nil (default `last-nonmenu-event', move
+point to the end position of that event before calling the
+various ff-* hooks.
+
Variables of interest include:
- `ff-case-fold-search'
@@ -369,11 +354,17 @@ Variables of interest include:
- `ff-file-created-hook'
List of functions to be called if the other file has been created."
- (interactive "P")
- (let ((ignore ff-ignore-include))
- (setq ff-ignore-include ignore-include)
- (ff-find-the-other-file in-other-window)
- (setq ff-ignore-include ignore)))
+ (interactive (list current-prefix-arg nil last-nonmenu-event))
+ ;; We want to preserve point in the current buffer. But the point of
+ ;; ff-find-the-other-file is to make the the other file buffer
+ ;; current, so we can't use save-excursion here (see bug 48535).
+ (let ((start-buffer (current-buffer))
+ (start-point (point)))
+ (posn-set-point (event-end event))
+ (let ((ff-ignore-include ignore-include))
+ (ff-find-the-other-file in-other-window))
+ (with-current-buffer start-buffer
+ (goto-char start-point))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support functions
@@ -413,9 +404,9 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(message "Working...")
(setq dirs
- (if (symbolp ff-search-directories)
- (ff-list-replace-env-vars (symbol-value ff-search-directories))
- (ff-list-replace-env-vars ff-search-directories)))
+ (ff-list-replace-env-vars (if (symbolp ff-search-directories)
+ (symbol-value ff-search-directories)
+ ff-search-directories)))
(setq fname (ff-treat-as-special))
@@ -454,11 +445,10 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
;; if we have a function to generate new names,
;; invoke it with the name of the current file
(if (and (atom action) (fboundp action))
- (progn
- (setq suffixes (funcall action (ff-buffer-file-name))
- match (cons (car match) (list suffixes))
- stub nil
- default-name (car suffixes)))
+ (setq suffixes (funcall action (ff-buffer-file-name))
+ match (cons (car match) (list suffixes))
+ stub nil
+ default-name (car suffixes))
;; otherwise build our filename stub
(cond
@@ -472,7 +462,8 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
(t
(setq format (concat "\\(.+\\)" (car match)))
(string-match format fname)
- (setq stub (substring fname (match-beginning 1) (match-end 1)))
+ ;; FIXME: What if `string-match' failed?
+ (setq stub (match-string 1 fname))
))
;; if we find nothing, we should try to get a file like this one
@@ -522,89 +513,6 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
found)) ;; return buffer-name or filename
-(defun ff-other-file-name ()
- "Return name of the header or source file corresponding to the current file.
-Being on a `#include' line pulls in that file, but see the help on
-the `ff-ignore-include' variable."
-
- (let (match ;; matching regexp for this file
- suffixes ;; set of replacing regexps for the matching regexp
- action ;; function to generate the names of the other files
- fname ;; basename of this file
- pos ;; where we start matching filenames
- stub ;; name of the file without extension
- alist ;; working copy of the list of file extensions
- pathname ;; the pathname of the file or the #include line
- format ;; what we have to match
- found ;; name of the file or buffer found - nil if none
- dirs) ;; local value of ff-search-directories
-
- (message "Working...")
-
- (setq dirs
- (if (symbolp ff-search-directories)
- (ff-list-replace-env-vars (symbol-value ff-search-directories))
- (ff-list-replace-env-vars ff-search-directories)))
-
- (setq fname (ff-treat-as-special))
-
- (cond
- ((and (not ff-ignore-include) fname)
- (setq found (ff-get-file-name dirs fname nil)))
-
- ;; let's just get the corresponding file
- (t
- (setq alist (if (symbolp ff-other-file-alist)
- (symbol-value ff-other-file-alist)
- ff-other-file-alist)
- pathname (or (ff-buffer-file-name) "/none.none"))
-
- (setq fname (file-name-nondirectory pathname)
- match (car alist))
-
- ;; find the table entry corresponding to this file
- (setq pos (ff-string-match (car match) fname))
- (while (and match (if (and pos (>= pos 0)) nil (not pos)))
- (setq alist (cdr alist))
- (setq match (car alist))
- (setq pos (ff-string-match (car match) fname)))
-
- ;; no point going on if we haven't found anything
- (when match
-
- ;; otherwise, suffixes contains what we need
- (setq suffixes (car (cdr match))
- action (car (cdr match))
- found nil)
-
- ;; if we have a function to generate new names,
- ;; invoke it with the name of the current file
- (if (and (atom action) (fboundp action))
- (progn
- (setq suffixes (funcall action (ff-buffer-file-name))
- match (cons (car match) (list suffixes))
- stub nil))
-
- ;; otherwise build our filename stub
- (cond
-
- ;; get around the problem that 0 and nil both mean false!
- ((= pos 0)
- (setq format "")
- (setq stub "")
- )
-
- (t
- (setq format (concat "\\(.+\\)" (car match)))
- (string-match format fname)
- (setq stub (substring fname (match-beginning 1) (match-end 1)))
- )))
-
- ;; do the real work - find the file
- (setq found
- (ff-get-file-name dirs stub suffixes)))))
- found)) ;; return buffer-name or filename
-
(defun ff-get-file (search-dirs filename &optional suffix-list other-window)
"Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub).
If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search
@@ -709,11 +617,10 @@ name of the first file found."
;; otherwise dir matches the '/*', so search each dir separately
(progn
- (if (match-beginning 2)
- (setq rest (substring dir (match-beginning 2) (match-end 2)))
- (setq rest "")
- )
- (setq dir (substring dir (match-beginning 1) (match-end 1)))
+ (setq rest (if (match-beginning 2)
+ (match-string 2 dir)
+ ""))
+ (setq dir (match-string 1 dir))
(let ((dirlist (ff-all-dirs-under dir '("..")))
this-dir compl-dirs)
@@ -743,8 +650,8 @@ name of the first file found."
(defun ff-string-match (regexp string &optional start)
"Like `string-match', but set `case-fold-search' temporarily.
The value used comes from `ff-case-fold-search'."
- (let ((case-fold-search ff-case-fold-search))
- (if regexp
+ (if regexp
+ (let ((case-fold-search ff-case-fold-search))
(string-match regexp string start))))
(defun ff-list-replace-env-vars (search-list)
@@ -752,12 +659,12 @@ The value used comes from `ff-case-fold-search'."
(let (list
(var (car search-list)))
(while search-list
- (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var)
+ (if (string-match "\\(.*\\)\\$[({]*\\([[:alnum:]_]+\\)[)}]*\\(.*\\)" var)
(setq var
(concat
- (substring var (match-beginning 1) (match-end 1))
- (getenv (substring var (match-beginning 2) (match-end 2)))
- (substring var (match-beginning 3) (match-end 3)))))
+ (match-string 1 var)
+ (getenv (match-string 2 var))
+ (match-string 3 var))))
(setq search-list (cdr search-list))
(setq list (cons var list))
(setq var (car search-list)))
@@ -782,11 +689,7 @@ See variable `ff-special-constructs'."
(setq match (cdr elem)))
fname)))
-(defun ff-basename (string)
- "Return the basename of pathname STRING."
- (setq string (concat "/" string))
- (string-match ".*/\\([^/]+\\)$" string)
- (setq string (substring string (match-beginning 1) (match-end 1))))
+(define-obsolete-function-alias 'ff-basename #'file-name-nondirectory "28.1")
(defun ff-all-dirs-under (here &optional exclude)
"Get all the directory files under directory HERE.
@@ -800,7 +703,7 @@ Exclude all files in the optional EXCLUDE list."
(setq file (car files))
(if (and
(file-directory-p file)
- (not (member (ff-basename file) exclude)))
+ (not (member (file-name-nondirectory file) exclude)))
(setq dirlist (cons file dirlist)))
(setq files (cdr files)))
(setq dirlist (reverse dirlist))))
@@ -820,84 +723,65 @@ or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs.
If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is
called before `ff-post-load-hook'."
(run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks)
- (if (or
- (and in-other-window (not ff-always-in-other-window))
- (and (not in-other-window) ff-always-in-other-window))
- (funcall f2 file)
- (funcall f1 file))
+ (funcall (if (or
+ (and in-other-window (not ff-always-in-other-window))
+ (and (not in-other-window) ff-always-in-other-window))
+ f2 f1)
+ file)
(if new-file
(run-hooks 'ff-file-created-hook 'ff-file-created-hooks))
(run-hooks 'ff-post-load-hook 'ff-post-load-hooks))
(defun ff-find-file (file &optional in-other-window new-file)
"Like `find-file', but may show the file in another window."
- (ff-switch-file 'find-file
- 'find-file-other-window
+ (ff-switch-file #'find-file
+ #'find-file-other-window
file in-other-window new-file))
(defun ff-switch-to-buffer (buffer-or-name &optional in-other-window)
"Like `switch-to-buffer', but may show the buffer in another window."
- (ff-switch-file 'switch-to-buffer
- 'switch-to-buffer-other-window
+ (ff-switch-file #'switch-to-buffer
+ #'switch-to-buffer-other-window
buffer-or-name in-other-window nil))
;;;###autoload
-(defun ff-mouse-find-other-file (event)
- "Visit the file you click on."
- (interactive "e")
- (save-excursion
- (mouse-set-point event)
- (ff-find-other-file nil)))
+(define-obsolete-function-alias
+ 'ff-mouse-find-other-file #'ff-find-other-file "28.1")
;;;###autoload
-(defun ff-mouse-find-other-file-other-window (event)
- "Visit the file you click on in another window."
- (interactive "e")
- (save-excursion
- (mouse-set-point event)
- (ff-find-other-file t)))
+(define-obsolete-function-alias
+ 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1")
+;;;###autoload
+(defun ff-find-other-file-other-window (event)
+ "Visit the file you point at in another window."
+ (interactive (list last-nonmenu-event))
+ (ff-find-other-file t nil event))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This section offers an example of user defined function to select files
-(defun ff-upcase-p (string &optional start end)
- "Return t if STRING is all uppercase.
-Given START and/or END, checks between these characters."
- (let (match str)
- (if (not start)
- (setq start 0))
- (if (not end)
- (setq end (length string)))
- (if (= start end)
- (setq end (1+ end)))
- (setq str (substring string start end))
- (if (and
- (ff-string-match "[A-Z]+" str)
- (setq match (match-data))
- (= (car match) 0)
- (= (car (cdr match)) (length str)))
- t
- nil)))
+(defun ff-upcase-p (string)
+ "Return t if STRING is all uppercase."
+ ;; FIXME: Why `ff-string-match' since `[:upper:]' only makes
+ ;; sense when `case-fold-search' is nil?
+ (ff-string-match "\\`[[:upper:]]*\\'" string))
(defun ff-cc-hh-converter (arg)
"Discriminate file extensions.
Build up a new file list based possibly on part of the directory name
and the name of the file passed in."
(ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg)
- (let ((dire (if (match-beginning 2)
- (substring arg (match-beginning 2) (match-end 2)) nil))
- (file (if (match-beginning 3)
- (substring arg (match-beginning 3) (match-end 3)) nil))
- (extn (if (match-beginning 4)
- (substring arg (match-beginning 4) (match-end 4)) nil))
+ (let ((dire (match-string 2 arg))
+ (file (match-string 3 arg))
+ (extn (match-string 4 arg))
return-list)
(cond
;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h}
((and (string= extn "cc")
- (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file))
- (let ((stub (substring file (match-beginning 2) (match-end 2))))
- (setq dire (upcase (substring file (match-beginning 1) (match-end 1))))
+ (ff-string-match "^\\([[:lower:]]+\\)\\([[:upper:]].+\\)$" file))
+ (let ((stub (match-string 2 file)))
+ (setq dire (upcase (match-string 1 file)))
(setq return-list (list (concat stub ".hh")
(concat stub ".h")
(concat file ".hh")
diff --git a/lisp/finder.el b/lisp/finder.el
index 15c3fcbac79..c2d5806c0cd 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -1,11 +1,10 @@
-;;; finder.el --- topic & keyword-based code finder
+;;; finder.el --- topic & keyword-based code finder -*- lexical-binding: t -*-
;; Copyright (C) 1992, 1997-1999, 2001-2021 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
-;; Version: 1.0
;; Keywords: help
;; This file is part of GNU Emacs.
@@ -78,8 +77,7 @@
Each element has the form (KEYWORD . DESCRIPTION).")
(defvar finder-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Finder")))
+ (let ((map (make-sparse-keymap)))
(define-key map " " 'finder-select)
(define-key map "f" 'finder-select)
(define-key map [follow-link] 'mouse-face)
@@ -90,24 +88,21 @@ Each element has the form (KEYWORD . DESCRIPTION).")
(define-key map "p" 'previous-line)
(define-key map "q" 'finder-exit)
(define-key map "d" 'finder-list-keywords)
-
- (define-key map [menu-bar finder-mode]
- (cons "Finder" menu-map))
- (define-key menu-map [finder-exit]
- '(menu-item "Quit" finder-exit
- :help "Exit Finder mode"))
- (define-key menu-map [finder-summary]
- '(menu-item "Summary" finder-summary
- :help "Summary item on current line in a finder buffer"))
- (define-key menu-map [finder-list-keywords]
- '(menu-item "List keywords" finder-list-keywords
- :help "Display descriptions of the keywords in the Finder buffer"))
- (define-key menu-map [finder-select]
- '(menu-item "Select" finder-select
- :help "Select item on current line in a finder buffer"))
map)
"Keymap used in `finder-mode'.")
+(easy-menu-define finder-mode-menu finder-mode-map
+ "Menu for `finder-mode'."
+ '("Finder"
+ ["Select" finder-select
+ :help "Select item on current line in a finder buffer"]
+ ["List keywords" finder-list-keywords
+ :help "Display descriptions of the keywords in the Finder buffer"]
+ ["Summary" finder-summary
+ :help "Summary item on current line in a finder buffer"]
+ ["Quit" finder-exit
+ :help "Exit Finder mode"]))
+
(defvar finder-mode-syntax-table
(let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?\; ". " st)
@@ -202,8 +197,7 @@ from; the default is `load-path'."
(progress (make-progress-reporter
(byte-compile-info "Scanning files for finder")
0 (length files)))
- package-override base-name ; processed
- summary keywords package version entry desc)
+ base-name summary keywords package version entry desc)
(dolist (elem files)
(let* ((d (car elem))
(f (cdr elem))
@@ -233,7 +227,7 @@ from; the default is `load-path'."
;; (push base-name processed)
(with-temp-buffer
(insert-file-contents (expand-file-name f d))
- (setq keywords (mapcar 'intern (lm-keywords-list))
+ (setq keywords (mapcar #'intern (lm-keywords-list))
package (or package-override
(let ((str (lm-header "package")))
(if str (intern str)))
@@ -293,7 +287,7 @@ from; the default is `load-path'."
(defun finder-compile-keywords-make-dist ()
"Regenerate `finder-inf.el' for the Emacs distribution."
- (apply 'finder-compile-keywords command-line-args-left)
+ (apply #'finder-compile-keywords command-line-args-left)
(kill-emacs))
;;; Now the retrieval code
@@ -302,7 +296,7 @@ from; the default is `load-path'."
"Insert, at column COLUMN, other args STRINGS."
(if (>= (current-column) column) (insert "\n"))
(move-to-column column t)
- (apply 'insert strings))
+ (apply #'insert strings))
(defvar finder-help-echo nil)
@@ -319,7 +313,7 @@ from; the default is `load-path'."
(keys (nconc (where-is-internal
'finder-mouse-select finder-mode-map)
keys1)))
- (concat (mapconcat 'key-description keys ", ")
+ (concat (mapconcat #'key-description keys ", ")
": select item"))))
(add-text-properties
(line-beginning-position) (line-end-position)
@@ -371,7 +365,7 @@ not `finder-known-keywords'."
(define-button-type 'finder-xref 'action #'finder-goto-xref)
(defun finder-goto-xref (button)
- "Jump to a lisp file for the BUTTON at point."
+ "Jump to a Lisp file for the BUTTON at point."
(let* ((file (button-get button 'xref))
(lib (locate-library file)))
(if lib (finder-commentary lib)
@@ -421,7 +415,7 @@ FILE should be in a form suitable for passing to `locate-library'."
(defun finder-select ()
"Select item on current line in a Finder buffer."
- (interactive)
+ (interactive nil finder-mode)
(let ((key (finder-current-item)))
(if (string-match "\\.el$" key)
(finder-commentary key)
@@ -437,6 +431,7 @@ FILE should be in a form suitable for passing to `locate-library'."
;;;###autoload
(defun finder-by-keyword ()
"Find packages matching a given keyword."
+ ;; FIXME: Why does this function exist? Should it just be an alias?
(interactive)
(finder-list-keywords))
@@ -446,13 +441,14 @@ FILE should be in a form suitable for passing to `locate-library'."
\\[finder-select] more help for the item on the current line
\\[finder-exit] exit Finder mode and kill the Finder buffer."
:syntax-table finder-mode-syntax-table
+ :interactive nil
(setq buffer-read-only t
buffer-undo-list t)
(setq-local finder-headmark nil))
(defun finder-summary ()
"Summarize basic Finder commands."
- (interactive)
+ (interactive nil finder-mode)
(message "%s"
(substitute-command-keys
"\\<finder-mode-map>\\[finder-select] = select, \
@@ -462,7 +458,7 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
(defun finder-exit ()
"Exit Finder mode.
Quit the window and kill all Finder-related buffers."
- (interactive)
+ (interactive nil finder-mode)
(quit-window t)
(dolist (buf (list finder-buffer "*Finder-package*"))
(and (get-buffer buf) (kill-buffer buf))))
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 2de49d2839c..cadf2746ba1 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -1,4 +1,4 @@
-;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
+;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -*- lexical-binding: t -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@@ -33,7 +33,7 @@
;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry)
;; to expose the body or C-c C-i to expose the child (level-2) headings.
;;
-;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body
+;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the body
;; and child subheadings and narrows the buffer so that only the level-1
;; heading, the body and the level-2 headings are visible. If you now want to
;; look under one of the level-2 headings, position the cursor on it and do C-c
@@ -57,7 +57,7 @@
;; zoomed-in heading. This is useful for restricting changes to a particular
;; chapter or section of your document.
;;
-;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides
+;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides
;; all the text and subheadings under the top-level heading and returns you to
;; the previous view of the buffer. Specifying a numeric argument exits that
;; many folds. Specifying a zero argument exits *all* folds.
@@ -216,6 +216,8 @@ An end marker of nil means the fold ends after (point-max).")
(defvar-local foldout-mode-line-string nil
"Mode line string announcing that we are in an outline fold.")
+;; FIXME: This should be rewritten as a proper minor mode.
+
;; put our minor mode string immediately following outline-minor-mode's
(or (assq 'foldout-mode-line-string minor-mode-alist)
(let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist)
@@ -227,17 +229,8 @@ An end marker of nil means the fold ends after (point-max).")
(error "Can't find outline-minor-mode in minor-mode-alist"))
;; slip our fold announcement into the list
- (setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))
- ))
-
-;; outline-flag-region has different `flag' values in outline.el and
-;; noutline.el for hiding and showing text.
-
-(defconst foldout-hide-flag
- (if (featurep 'noutline) t ?\^M))
+ (setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))))
-(defconst foldout-show-flag
- (if (featurep 'noutline) nil ?\n))
(defun foldout-zoom-subtree (&optional exposure)
@@ -283,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg) changes this:-
((> exposure-value 0)
(outline-show-children exposure-value))
(t
- (outline-show-subtree))
- )
+ (outline-show-subtree)))
;; save the location of the fold we are entering
(setq foldout-fold-list (cons (cons start-marker end-marker)
foldout-fold-list))
;; update the mode line
- (foldout-update-mode-line)
- )))
+ (foldout-update-mode-line))))
(defun foldout-exit-fold (&optional num-folds)
@@ -316,8 +307,7 @@ exited and text is left visible."
;; have we been told not to hide the fold?
((< num-folds 0)
(setq hide-fold nil
- num-folds (- num-folds)))
- )
+ num-folds (- num-folds))))
;; limit the number of folds if we've been told to exit too many
(setq num-folds (min num-folds (length foldout-fold-list)))
@@ -364,8 +354,7 @@ exited and text is left visible."
;; make sure the next heading is exposed
(if end-marker
- (outline-flag-region end-of-subtree beginning-of-heading
- foldout-show-flag)))
+ (outline-flag-region end-of-subtree beginning-of-heading nil)))
;; zap the markers so they don't slow down editing
(set-marker start-marker nil)
@@ -491,8 +480,8 @@ Signal an error if the final event isn't the same type as the first one."
event)
(defun foldout-mouse-goto-heading (event)
- "Go to the heading where the mouse event started. Signal an error
-if the event didn't occur on a heading."
+ "Go to the heading where the mouse EVENT started.
+Signal an error if the event didn't occur on a heading."
(goto-char (posn-point (event-start event)))
(or (outline-on-heading-p)
;; outline.el sometimes treats beginning-of-buffer as a heading
@@ -514,17 +503,16 @@ M-C-down-mouse-{1,2,3}.
Valid modifiers are shift, control, meta, alt, hyper and super.")
-(if foldout-inhibit-key-bindings
- ()
- (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree)
- (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold)
+(unless foldout-inhibit-key-bindings
+ (define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree)
+ (define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold)
(let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix)))
(unless map
(setq map (make-sparse-keymap))
(define-key outline-minor-mode-map outline-minor-mode-prefix map))
- (define-key map "\C-z" 'foldout-zoom-subtree)
- (define-key map "\C-x" 'foldout-exit-fold))
- (let* ((modifiers (apply 'concat
+ (define-key map "\C-z" #'foldout-zoom-subtree)
+ (define-key map "\C-x" #'foldout-exit-fold))
+ (let* ((modifiers (apply #'concat
(mapcar (lambda (modifier)
(vector
(cond
@@ -534,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
((eq modifier 'alt) ?A)
((eq modifier 'hyper) ?H)
((eq modifier 'super) ?s)
- (t (error "invalid mouse modifier %s"
+ (t (error "Invalid mouse modifier %s"
modifier)))
?-))
foldout-mouse-modifiers)))
@@ -542,14 +530,21 @@ Valid modifiers are shift, control, meta, alt, hyper and super.")
(mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
(mouse-3 (vector (intern (concat modifiers "down-mouse-3")))))
- (define-key outline-mode-map mouse-1 'foldout-mouse-zoom)
- (define-key outline-mode-map mouse-2 'foldout-mouse-show)
- (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit)
+ (define-key outline-mode-map mouse-1 #'foldout-mouse-zoom)
+ (define-key outline-mode-map mouse-2 #'foldout-mouse-show)
+ (define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit)
+
+ (define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom)
+ (define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show)
+ (define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit)))
+
+;; Obsolete.
+
+(defconst foldout-hide-flag t)
+(make-obsolete-variable 'foldout-hide-flag nil "28.1")
- (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom)
- (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show)
- (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit)
- ))
+(defconst foldout-show-flag nil)
+(make-obsolete-variable 'foldout-show-flag nil "28.1")
(provide 'foldout)
diff --git a/lisp/follow.el b/lisp/follow.el
index 069758747c1..dde140d0fd5 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1,4 +1,4 @@
-;;; follow.el --- synchronize windows showing the same buffer
+;;; follow.el --- synchronize windows showing the same buffer -*- lexical-binding: t -*-
;; Copyright (C) 1995-1997, 1999, 2001-2021 Free Software Foundation,
;; Inc.
@@ -25,7 +25,7 @@
;;; Commentary:
-;; `Follow mode' is a minor mode that combines windows into one tall
+;; `follow-mode' is a minor mode that combines windows into one tall
;; virtual window.
;;
;; The feeling of a "virtual window" has been accomplished by the use
@@ -81,7 +81,7 @@
;; text. Enter long lines spanning several lines, or several
;; windows.
;;
-;; * Should you find `Follow' mode annoying, just type
+;; * Should you find Follow mode annoying, just type
;; M-x follow-mode <RETURN>
;; to turn it off.
@@ -93,25 +93,24 @@
;; key map. To do so, add the following lines (replacing `[f7]' and
;; `[f8]' with your favorite keys) to the init file:
;;
-;; (global-set-key [f8] 'follow-mode)
-;; (global-set-key [f7] 'follow-delete-other-windows-and-split)
+;; (global-set-key [f8] #'follow-mode)
+;; (global-set-key [f7] #'follow-delete-other-windows-and-split)
;; There exist two system variables that control the appearance of
;; lines wider than the window containing them. The default is to
;; truncate long lines whenever a window isn't as wide as the frame.
;;
-;; To make sure lines are never truncated, please place the following
-;; lines in your init file:
+;; To make sure lines are never truncated, place the following lines
+;; in your Init file:
;;
;; (setq truncate-lines nil)
;; (setq truncate-partial-width-windows nil)
-;; The correct way to configure Follow mode, or any other mode for
-;; that matter, is to create one or more functions that do
-;; whatever you would like to do. These functions are then added to
-;; a hook.
+;; One way to configure Follow mode is to create one or more functions
+;; that do whatever you would like to do. These functions are then
+;; added to a hook.
;;
;; The keymap `follow-mode-map' contains key bindings activated by
;; `follow-mode'.
@@ -120,8 +119,8 @@
;; (add-hook 'follow-mode-hook 'my-follow-mode-hook)
;;
;; (defun my-follow-mode-hook ()
-;; (define-key follow-mode-map "\C-ca" 'your-favorite-function)
-;; (define-key follow-mode-map "\C-cb" 'another-function))
+;; (define-key follow-mode-map "\C-ca" #'your-favorite-function)
+;; (define-key follow-mode-map "\C-cb" #'another-function))
;; Usage:
@@ -129,60 +128,60 @@
;; To activate, issue the command "M-x follow-mode"
;; and press Return. To deactivate, do it again.
;;
-;; The following is a list of commands useful when follow-mode is active.
+;; The following is a list of commands useful when `follow-mode' is active.
;;
-;; follow-scroll-up C-c . C-v
+;; `follow-scroll-up' C-c . C-v
;; Scroll text in a Follow mode window chain up.
;;
-;; follow-scroll-down C-c . v
+;; `follow-scroll-down' C-c . v
;; Like `follow-scroll-up', but in the other direction.
;;
-;; follow-delete-other-windows-and-split C-c . 1
+;; `follow-delete-other-windows-and-split' C-c . 1
;; Maximize the visible area of the current buffer,
-;; and enter Follow mode. This is a very convenient
+;; and enter Follow mode. This is a very convenient
;; way to start Follow mode, hence we recommend that
;; this command be added to the global keymap.
;;
-;; follow-recenter C-c . C-l
+;; `follow-recenter' C-c . C-l
;; Place point in the center of the middle window,
;; or a specified number of lines from either top or bottom.
;;
-;; follow-switch-to-buffer C-c . b
+;; `follow-switch-to-buffer' C-c . b
;; Switch buffer in all windows displaying the current buffer
;; in this frame.
;;
-;; follow-switch-to-buffer-all C-c . C-b
+;; `follow-switch-to-buffer-all' C-c . C-b
;; Switch buffer in all windows in the selected frame.
;;
-;; follow-switch-to-current-buffer-all
+;; `follow-switch-to-current-buffer-all'
;; Show the current buffer in all windows on the current
;; frame and turn on `follow-mode'.
;;
-;; follow-first-window C-c . <
+;; `follow-first-window' C-c . <
;; Select the first window in the frame showing the same buffer.
;;
-;; follow-last-window C-c . >
+;; `follow-last-window' C-c . >
;; Select the last window in the frame showing the same buffer.
;;
-;; follow-next-window C-c . n
+;; `follow-next-window' C-c . n
;; Select the next window in the frame showing the same buffer.
;;
-;; follow-previous-window C-c . p
+;; `follow-previous-window' C-c . p
;; Select the previous window showing the same buffer.
;; Well, it seems ok, but what if I really want to look at two different
-;; positions in the text? Here are two simple methods to use:
+;; positions in the text? Here are two simple methods to use:
;;
;; 1) Use multiple frames; `follow' mode only affects windows displayed
-;; in the same frame. (My apologies to you who can't use frames.)
+;; in the same frame. (My apologies to you who can't use frames.)
;;
;; 2) Bind `follow-mode' to key so you can turn it off whenever
-;; you want to view two locations. Of course, `follow' mode can
+;; you want to view two locations. Of course, `follow-mode' can
;; be reactivated by hitting the same key again.
;;
;; Example from my ~/.emacs:
-;; (global-set-key [f8] 'follow-mode)
+;; (global-set-key [f8] #'follow-mode)
;; Implementation:
;;
@@ -201,7 +200,6 @@
;;; Code:
-(require 'easymenu)
(eval-when-compile (require 'cl-lib))
;;; Variables
@@ -236,17 +234,17 @@ After that, changing the prefix key requires manipulating keymaps."
(defvar follow-mode-map
(let ((mainmap (make-sparse-keymap))
(map (make-sparse-keymap)))
- (define-key map "\C-v" 'follow-scroll-up)
- (define-key map "\M-v" 'follow-scroll-down)
- (define-key map "v" 'follow-scroll-down)
- (define-key map "1" 'follow-delete-other-windows-and-split)
- (define-key map "b" 'follow-switch-to-buffer)
- (define-key map "\C-b" 'follow-switch-to-buffer-all)
- (define-key map "\C-l" 'follow-recenter)
- (define-key map "<" 'follow-first-window)
- (define-key map ">" 'follow-last-window)
- (define-key map "n" 'follow-next-window)
- (define-key map "p" 'follow-previous-window)
+ (define-key map "\C-v" #'follow-scroll-up)
+ (define-key map "\M-v" #'follow-scroll-down)
+ (define-key map "v" #'follow-scroll-down)
+ (define-key map "1" #'follow-delete-other-windows-and-split)
+ (define-key map "b" #'follow-switch-to-buffer)
+ (define-key map "\C-b" #'follow-switch-to-buffer-all)
+ (define-key map "\C-l" #'follow-recenter)
+ (define-key map "<" #'follow-first-window)
+ (define-key map ">" #'follow-last-window)
+ (define-key map "n" #'follow-next-window)
+ (define-key map "p" #'follow-previous-window)
(define-key mainmap follow-mode-prefix map)
@@ -255,13 +253,13 @@ After that, changing the prefix key requires manipulating keymaps."
;; could be enhanced in Follow mode. End-of-buffer is a special
;; case since it is very simple to define and it greatly enhances
;; the look and feel of Follow mode.)
- (define-key mainmap [remap end-of-buffer] 'follow-end-of-buffer)
+ (define-key mainmap [remap end-of-buffer] #'follow-end-of-buffer)
- (define-key mainmap [remap scroll-bar-toolkit-scroll] 'follow-scroll-bar-toolkit-scroll)
- (define-key mainmap [remap scroll-bar-drag] 'follow-scroll-bar-drag)
- (define-key mainmap [remap scroll-bar-scroll-up] 'follow-scroll-bar-scroll-up)
- (define-key mainmap [remap scroll-bar-scroll-down] 'follow-scroll-bar-scroll-down)
- (define-key mainmap [remap mwheel-scroll] 'follow-mwheel-scroll)
+ (define-key mainmap [remap scroll-bar-toolkit-scroll] #'follow-scroll-bar-toolkit-scroll)
+ (define-key mainmap [remap scroll-bar-drag] #'follow-scroll-bar-drag)
+ (define-key mainmap [remap scroll-bar-scroll-up] #'follow-scroll-bar-scroll-up)
+ (define-key mainmap [remap scroll-bar-scroll-down] #'follow-scroll-bar-scroll-down)
+ (define-key mainmap [remap mwheel-scroll] #'follow-mwheel-scroll)
mainmap)
"Minor mode keymap for Follow mode.")
@@ -343,7 +341,7 @@ property `follow-mode-use-cache' to non-nil.")
;; Internal variables:
(defvar follow-internal-force-redisplay nil
- "True when Follow mode should redisplay the windows.")
+ "Non-nil when Follow mode should redisplay the windows.")
(defvar follow-active-menu nil
"The menu visible when Follow mode is active.")
@@ -370,7 +368,7 @@ This is typically set by explicit scrolling commands.")
(defsubst follow-debug-message (&rest args)
"Like `message', but only active when `follow-debug' is non-nil."
(if (and (boundp 'follow-debug) follow-debug)
- (apply 'message args)))
+ (apply #'message args)))
;;; Cache
@@ -1020,8 +1018,8 @@ returned by `follow-windows-start-end'."
(setq win-start-end (cdr win-start-end)))
result))
-;; Check if point is visible in all windows. (So that
-;; no one will be recentered.)
+;; Check if point is visible in all windows.
+;; (So that no one will be recentered.)
(defun follow-point-visible-all-windows-p (win-start-end)
"Non-nil when the `window-point' is visible in all windows."
@@ -1070,11 +1068,11 @@ Return the selected window."
win))
;; Lets select a window showing the end. Make sure we only select it if
-;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
+;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
;; point in the selected window.)
;;
;; (Compatibility kludge: in Emacs `window-end' is equal to `point-max';
-;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
+;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
;; checking `window-end' now when I check `end-of-buffer' explicitly?)
(defun follow-select-if-end-visible (win-start-end)
@@ -1098,7 +1096,7 @@ Return the selected window."
;; Select a window that will display point if the windows would
-;; be redisplayed with the first window fixed. This is useful for
+;; be redisplayed with the first window fixed. This is useful for
;; example when the user has pressed return at the bottom of a window
;; as point is not visible in any window.
@@ -1203,7 +1201,7 @@ should be a member of WINDOWS, starts at position START."
(goto-char guess)
(while (not done)
(if (not (= (vertical-motion 1 (car windows)) 1))
- ;; Hit bottom! (Can we really do this?)
+ ;; Hit bottom! (Can we really do this?)
;; We'll keep it, since it ensures termination.
(progn
(setq done t)
@@ -1284,7 +1282,7 @@ non-first windows in Follow mode."
(defvar follow-prev-buffer nil
"The buffer current at the last call to `follow-adjust-window' or nil.
-follow-mode is not necessarily enabled in this buffer.")
+`follow-mode' is not necessarily enabled in this buffer.")
;; This function is added to `pre-display-function' and is thus called
;; before each redisplay operation. It supersedes (2018-09) the
@@ -1332,7 +1330,7 @@ follow-mode is not necessarily enabled in this buffer.")
;; .
(defun follow-adjust-window (win)
- ;; Adjust the window WIN and its followers.
+ "Adjust the window WIN and its followers."
(cl-assert (eq (window-buffer win) (current-buffer)))
;; Have we moved out of or into a follow-mode window group?
@@ -1647,17 +1645,17 @@ This is updated by redisplay or by calling
(defun follow-window-end (&optional window update)
"Return position at which display currently ends in the Follow
- Mode group of windows which includes WINDOW.
+Mode group of windows which includes WINDOW.
- WINDOW must be a live window and defaults to the selected one.
- This is updated by redisplay, when it runs to completion.
- Simply changing the buffer text or setting `window-start' does
- not update this value.
-
- Return nil if there is no recorded value. (This can happen if
- the last redisplay of WINDOW was preempted, and did not
- finish.) If UPDATE is non-nil, compute the up-to-date position
- if it isn't already recorded."
+WINDOW must be a live window and defaults to the selected one.
+This is updated by redisplay, when it runs to completion.
+Simply changing the buffer text or setting `window-start' does
+not update this value.
+
+Return nil if there is no recorded value. (This can happen if
+the last redisplay of WINDOW was preempted, and did not
+finish.) If UPDATE is non-nil, compute the up-to-date position
+if it isn't already recorded."
(let* ((windows (follow-all-followers window))
(last (car (last windows))))
(when (and update follow-start-end-invalid)
@@ -1677,7 +1675,7 @@ overriding motion of point in order to display at this exact start."
(defun follow-pos-visible-in-window-p (&optional pos window partially)
"Return non-nil if position POS is currently on the frame in one of
- the windows in the Follow Mode group which includes WINDOW.
+the windows in the Follow Mode group which includes WINDOW.
WINDOW must be a live window and defaults to the selected one.
@@ -1696,8 +1694,7 @@ omitted if the character after POS is fully visible; otherwise, RTOP
and RBOT are the number of pixels off-window at the top and bottom of
the screen line (\"row\") containing POS, ROWH is the visible height
of that row, and VPOS is the row number \(zero-based)."
- (let* ((windows (follow-all-followers window))
- (last (car (last windows))))
+ (let* ((windows (follow-all-followers window)))
(when follow-start-end-invalid
(follow-redisplay windows (car windows)))
(let* ((cache (follow-windows-start-end windows))
@@ -1725,7 +1722,7 @@ zero means top of the first window in the group, negative means
(start-end (follow-windows-start-end windows))
(rev-start-end (reverse start-end))
(lines 0)
- middle-window elt count)
+ elt count)
(select-window
(cond
((null arg)
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 4b695424977..db06a607660 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -126,7 +126,6 @@ buffer local value for `font-lock-defaults', via its mode hook.
The above is the default behavior of `font-lock-mode'; you may
specify your own function which is called when `font-lock-mode'
is toggled via `font-lock-function'."
- nil nil nil
:after-hook (font-lock-initial-fontify)
;; Don't turn on Font Lock mode if we don't have a display (we're running a
;; batch job) or if the buffer is invisible (the name starts with a space).
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index c344a612581..c00a62a1607 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -312,6 +312,9 @@ If a number, only buffers greater than this size have fontification messages."
(defvar font-lock-doc-face 'font-lock-doc-face
"Face name to use for documentation.")
+(defvar font-lock-doc-markup-face 'font-lock-doc-markup-face
+ "Face name to use for documentation mark-up.")
+
(defvar font-lock-keyword-face 'font-lock-keyword-face
"Face name to use for keywords.")
@@ -1120,6 +1123,18 @@ portion of the buffer."
(funcall font-lock-ensure-function
(or beg (point-min)) (or end (point-max)))))
+(defun font-lock-update (&optional arg)
+ "Updates the syntax highlighting in this buffer.
+Refontify the accessible portion of this buffer, or enable Font Lock mode
+in this buffer if it is currently disabled. With prefix ARG, toggle Font
+Lock mode."
+ (interactive "P")
+ (save-excursion
+ (if (and (not arg) font-lock-mode)
+ (font-lock-fontify-region (point-min) (point-max))
+ (font-lock-unfontify-region (point-min) (point-max))
+ (font-lock-mode 'toggle))))
+
(defun font-lock-default-fontify-buffer ()
"Fontify the whole buffer using `font-lock-fontify-region-function'."
(let ((verbose (if (numberp font-lock-verbose)
@@ -1592,18 +1607,15 @@ START should be at the beginning of a line."
"If non-nil, Font Lock mode uses this instead of `comment-start-skip'.")
(defvar font-lock-comment-end-skip nil
- "If non-nil, Font Lock mode uses this instead of `comment-end'.")
+ "If non-nil, Font Lock mode uses this instead of `comment-end-skip'.")
(defun font-lock-fontify-syntactically-region (start end &optional loudly)
"Put proper face on each string and comment between START and END.
START should be at the beginning of a line."
(syntax-propertize end) ; Apply any needed syntax-table properties.
(with-syntax-table (or syntax-ppss-table (syntax-table))
- (let ((comment-end-regexp
- (or font-lock-comment-end-skip
- (regexp-quote
- (replace-regexp-in-string "^ *" "" comment-end))))
- ;; Find the `start' state.
+ (when (and comment-start (not comment-end-skip)) (comment-normalize-vars))
+ (let (;; Find the `start' state.
(state (if (or syntax-ppss-table
(not font-lock--syntax-table-affects-ppss))
(syntax-ppss start)
@@ -1636,7 +1648,9 @@ START should be at the beginning of a line."
comment-start-skip))
(put-text-property beg (match-end 0) 'face
font-lock-comment-delimiter-face)))
- (if (looking-back comment-end-regexp (point-at-bol) t)
+ (if (looking-back (or font-lock-comment-end-skip
+ comment-end-skip)
+ (point-at-bol) t)
(put-text-property (match-beginning 0) (point) 'face
font-lock-comment-delimiter-face))))
(< (point) end))
@@ -1992,7 +2006,16 @@ Sets various variables using `font-lock-defaults' and
(defface font-lock-doc-face
'((t :inherit font-lock-string-face))
- "Font Lock mode face used to highlight documentation."
+ "Font Lock mode face used to highlight documentation embedded in program code.
+It is typically used for special documentation comments or strings."
+ :group 'font-lock-faces)
+
+(defface font-lock-doc-markup-face
+ '((t :inherit font-lock-constant-face))
+ "Font Lock mode face used to highlight embedded documentation mark-up.
+It is meant for mark-up elements in text that uses `font-lock-doc-face', such
+as the constructs of Haddock, Javadoc and similar systems."
+ :version "28.1"
:group 'font-lock-faces)
(defface font-lock-keyword-face
diff --git a/lisp/format.el b/lisp/format.el
index 4209fc6401a..71cf885d417 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -181,7 +181,7 @@ it should be a Lisp function. BUFFER is currently ignored."
;; We should perhaps go via a temporary buffer and copy it
;; back, in case of errors.
(if (and (zerop (save-window-excursion
- (shell-command-on-region from to method t t
+ (shell-command-on-region from to method t 'no-mark
error-buff)))
;; gzip gives zero exit status with bad args, for instance.
(zerop (with-current-buffer error-buff
@@ -747,13 +747,17 @@ to write these unknown annotations back into the file."
(if (numberp val) ; add to ambient value if numeric
(format-property-increment-region from to prop val 0)
- (put-text-property
- from to prop
- (cond ((get prop 'format-list-valued) ; value gets consed onto
- ; list-valued properties
- (let ((prev (get-text-property from prop)))
- (cons val (if (listp prev) prev (list prev)))))
- (t val))))) ; normally, just set to val.
+ ;; Kludge alert: ignore items with reversed order of
+ ;; FROM and TO. They seem to be redundant anyway, and
+ ;; in one case I've seen them refer to EOB.
+ (when (<= from to)
+ (put-text-property
+ from to prop
+ (cond ((get prop 'format-list-valued) ; value gets consed onto
+ ; list-valued properties
+ (let ((prev (get-text-property from prop)))
+ (cons val (if (listp prev) prev (list prev)))))
+ (t val)))))) ; normally, just set to val.
(setq todo (cdr todo)))
(if unknown-ans
@@ -1009,6 +1013,12 @@ either strings, or lists of the form (PARAMETER VALUE)."
prop-alist (car old) nil))
close)
old (cdr old)))
+ ;; If the font is on the format (:background "red"),
+ ;; then we have a single face. We're assuming a list of
+ ;; faces, so transform.
+ (when (and (listp new)
+ (keywordp (car new)))
+ (setq new (list new)))
(while new
(setq open
(append (cdr (format-annotate-atomic-property-change
diff --git a/lisp/forms.el b/lisp/forms.el
index 62c4288869a..46f4df9b6c4 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1,7 +1,6 @@
-;;; forms.el --- Forms mode: edit a file as a form to fill in
+;;; forms.el --- Forms mode: edit a file as a form to fill in -*- lexical-binding: t; -*-
-;; Copyright (C) 1991, 1994-1997, 2001-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
@@ -298,7 +297,6 @@
(defcustom forms-mode-hook nil
"Hook run upon entering Forms mode."
- :group 'forms
:type 'hook)
;;; Mandatory variables - must be set by evaluating the control file.
@@ -316,7 +314,6 @@
(defcustom forms-check-number-of-fields t
"If non-nil, warn about records with wrong number of fields."
- :group 'forms
:type 'boolean)
(defvar forms-field-sep "\t"
@@ -332,13 +329,11 @@ If not nil: use this character to separate multi-line fields (default C-k).")
(defcustom forms-forms-scroll nil
"Non-nil means replace scroll-up/down commands in Forms mode.
The replacement commands performs forms-next/prev-record."
- :group 'forms
:type 'boolean)
(defcustom forms-forms-jump nil
"Non-nil means redefine beginning/end-of-buffer in Forms mode.
The replacement commands performs forms-first/last-record."
- :group 'forms
:type 'boolean)
(defvar forms-read-file-filter nil
@@ -363,23 +358,19 @@ The contents may NOT be modified.")
(defcustom forms-use-text-properties t
"Non-nil means to use text properties. "
- :group 'forms
:type 'boolean)
(defcustom forms-insert-after nil
"Non-nil means: inserts of new records go after current record.
Also, initial position is at last record."
- :group 'forms
:type 'boolean)
(defcustom forms-ro-face 'default
"The face (a symbol) that is used to display read-only text on the screen."
- :group 'forms
:type 'face)
(defcustom forms-rw-face 'region
"The face (a symbol) that is used to display read-write text on the screen."
- :group 'forms
:type 'face)
;;; Internal variables.
@@ -767,7 +758,7 @@ Commands: Equivalent keys in read-only mode:
;; If it is a symbol, eval it first.
(if (and (symbolp el)
(boundp el))
- (setq el (eval el)))
+ (setq el (symbol-value el)))
(cond
@@ -1261,35 +1252,35 @@ Commands: Equivalent keys in read-only mode:
;; `forms-mode-map' is always accessible via \C-c prefix.
(setq forms-mode-map (make-keymap))
- (define-key forms-mode-map "\t" 'forms-next-field)
- (define-key forms-mode-map "\C-k" 'forms-delete-record)
- (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
- (define-key forms-mode-map "\C-o" 'forms-insert-record)
- (define-key forms-mode-map "\C-l" 'forms-jump-record)
- (define-key forms-mode-map "\C-n" 'forms-next-record)
- (define-key forms-mode-map "\C-p" 'forms-prev-record)
- (define-key forms-mode-map "\C-r" 'forms-search-backward)
- (define-key forms-mode-map "\C-s" 'forms-search-forward)
- (define-key forms-mode-map "\C-x" 'forms-exit)
- (define-key forms-mode-map "<" 'forms-first-record)
- (define-key forms-mode-map ">" 'forms-last-record)
- (define-key forms-mode-map "\C-?" 'forms-prev-record)
+ (define-key forms-mode-map "\t" #'forms-next-field)
+ (define-key forms-mode-map "\C-k" #'forms-delete-record)
+ (define-key forms-mode-map "\C-q" #'forms-toggle-read-only)
+ (define-key forms-mode-map "\C-o" #'forms-insert-record)
+ (define-key forms-mode-map "\C-l" #'forms-jump-record)
+ (define-key forms-mode-map "\C-n" #'forms-next-record)
+ (define-key forms-mode-map "\C-p" #'forms-prev-record)
+ (define-key forms-mode-map "\C-r" #'forms-search-backward)
+ (define-key forms-mode-map "\C-s" #'forms-search-forward)
+ (define-key forms-mode-map "\C-x" #'forms-exit)
+ (define-key forms-mode-map "<" #'forms-first-record)
+ (define-key forms-mode-map ">" #'forms-last-record)
+ (define-key forms-mode-map "\C-?" #'forms-prev-record)
;; `forms-mode-ro-map' replaces the local map when in read-only mode.
(setq forms-mode-ro-map (make-keymap))
(suppress-keymap forms-mode-ro-map)
(define-key forms-mode-ro-map "\C-c" forms-mode-map)
- (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
- (define-key forms-mode-ro-map "l" 'forms-jump-record)
- (define-key forms-mode-ro-map "n" 'forms-next-record)
- (define-key forms-mode-ro-map "p" 'forms-prev-record)
- (define-key forms-mode-ro-map "r" 'forms-search-backward)
- (define-key forms-mode-ro-map "s" 'forms-search-forward)
- (define-key forms-mode-ro-map "x" 'forms-exit)
- (define-key forms-mode-ro-map "<" 'forms-first-record)
- (define-key forms-mode-ro-map ">" 'forms-last-record)
- (define-key forms-mode-ro-map "?" 'describe-mode)
- (define-key forms-mode-ro-map " " 'forms-next-record)
+ (define-key forms-mode-ro-map "q" #'forms-toggle-read-only)
+ (define-key forms-mode-ro-map "l" #'forms-jump-record)
+ (define-key forms-mode-ro-map "n" #'forms-next-record)
+ (define-key forms-mode-ro-map "p" #'forms-prev-record)
+ (define-key forms-mode-ro-map "r" #'forms-search-backward)
+ (define-key forms-mode-ro-map "s" #'forms-search-forward)
+ (define-key forms-mode-ro-map "x" #'forms-exit)
+ (define-key forms-mode-ro-map "<" #'forms-first-record)
+ (define-key forms-mode-ro-map ">" #'forms-last-record)
+ (define-key forms-mode-ro-map "?" #'describe-mode)
+ (define-key forms-mode-ro-map " " #'forms-next-record)
(forms--mode-commands1 forms-mode-ro-map)
(forms--mode-menu-ro forms-mode-ro-map)
@@ -1395,13 +1386,13 @@ Commands: Equivalent keys in read-only mode:
(defun forms--mode-commands1 (map)
"Helper routine to define keys."
- (define-key map "\t" 'forms-next-field)
- (define-key map [S-tab] 'forms-prev-field)
- (define-key map [next] 'forms-next-record)
- (define-key map [prior] 'forms-prev-record)
- (define-key map [begin] 'forms-first-record)
- (define-key map [last] 'forms-last-record)
- (define-key map [backtab] 'forms-prev-field)
+ (define-key map "\t" #'forms-next-field)
+ (define-key map [S-tab] #'forms-prev-field)
+ (define-key map [next] #'forms-next-record)
+ (define-key map [prior] #'forms-prev-record)
+ (define-key map [begin] #'forms-first-record)
+ (define-key map [last] #'forms-last-record)
+ (define-key map [backtab] #'forms-prev-field)
)
;;; Changed functions
@@ -1585,7 +1576,7 @@ As a side effect: sets `forms--the-record-list'."
(forms--trans the-record "\n" forms-multi-line))
;; A final sanity check before updating.
- (if (string-match-p "\n" the-record)
+ (if (string-search "\n" the-record)
(error "Multi-line fields in this record - update refused"))
(with-current-buffer forms--file-buffer
@@ -2034,8 +2025,7 @@ Usage: (setq forms-number-of-fields
(defcustom forms--debug nil
"If non-nil, enable Forms mode debugging."
- :type 'boolean
- :group 'forms)
+ :type 'boolean)
(defun forms--debug (&rest args)
"Internal debugging routine."
@@ -2046,7 +2036,7 @@ Usage: (setq forms-number-of-fields
(if (stringp el) el
(concat (prin1-to-string el) " = "
(if (boundp el)
- (prin1-to-string (eval el))
+ (prin1-to-string (symbol-value el))
"<unbound>")
"\n"
(if (fboundp el)
diff --git a/lisp/frame.el b/lisp/frame.el
index ce4de83b8c5..146fe278b3e 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -36,7 +36,7 @@ as its argument.")
(cl-generic-define-context-rewriter window-system (value)
;; If `value' is a `consp', it's probably an old-style specializer,
;; so just use it, and anyway `eql' isn't very useful on cons cells.
- `(window-system ,(if (consp value) value `(eql ,value))))
+ `(window-system ,(if (consp value) value `(eql ',value))))
(cl-defmethod frame-creation-function (params &context (window-system nil))
;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
@@ -301,7 +301,7 @@ This function runs the abnormal hook `move-frame-functions'."
(declare-function tool-bar-mode "tool-bar" (&optional arg))
(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
-(defalias 'tool-bar-lines-needed 'tool-bar-height)
+(defalias 'tool-bar-lines-needed #'tool-bar-height)
;; startup.el calls this function after loading the user's init
;; file. Now default-frame-alist and initial-frame-alist contain
@@ -367,6 +367,7 @@ there (in decreasing order of priority)."
;; by the lines added in x-create-frame for the tab-bar and
;; switch `tab-bar-mode' off.
(when (display-graphic-p)
+ (declare-function tab-bar-height "xdisp.c" (&optional frame pixelwise))
(let* ((init-lines
(assq 'tab-bar-lines initial-frame-alist))
(other-lines
@@ -614,15 +615,6 @@ there (in decreasing order of priority)."
(face-set-after-frame-default frame-initial-frame)
(setq newparms (delq new-bg newparms)))
- (when (numberp (car frame-size-history))
- (setq frame-size-history
- (cons (1- (car frame-size-history))
- (cons
- (list frame-initial-frame
- "FRAME-NOTICE-USER"
- nil newparms)
- (cdr frame-size-history)))))
-
(modify-frame-parameters frame-initial-frame newparms)))))
;; Restore the original buffer.
@@ -689,8 +681,8 @@ is not considered (see `next-frame')."
0))
(select-frame-set-input-focus (selected-frame)))
-(defalias 'next-multiframe-window 'next-window-any-frame)
-(defalias 'previous-multiframe-window 'previous-window-any-frame)
+(defalias 'next-multiframe-window #'next-window-any-frame)
+(defalias 'previous-multiframe-window #'previous-window-any-frame)
(defun window-system-for-display (display)
"Return the window system for DISPLAY.
@@ -708,9 +700,11 @@ Return nil if we don't know how to interpret DISPLAY."
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
The optional argument PARAMETERS specifies additional frame parameters."
- (interactive (list (completing-read
- (format "Make frame on display: ")
- (x-display-list))))
+ (interactive (if (fboundp 'x-display-list)
+ (list (completing-read
+ (format "Make frame on display: ")
+ (x-display-list)))
+ (user-error "This Emacs build does not support X displays")))
(make-frame (cons (cons 'display display) parameters)))
(defun make-frame-on-current-monitor (&optional parameters)
@@ -779,7 +773,7 @@ If DISPLAY is nil, that stands for the selected frame's display."
(format "Delete %s frames? " (length frames))
(format "Delete %s ? " (car frames))))))
(error "Abort!")
- (mapc 'delete-frame frames)
+ (mapc #'delete-frame frames)
(x-close-connection display))))
(defun make-frame-command ()
@@ -923,12 +917,6 @@ the new frame according to its own rules."
(let ((val (frame-parameter oldframe param)))
(when val (set-frame-parameter frame param val)))))
- (when (numberp (car frame-size-history))
- (setq frame-size-history
- (cons (1- (car frame-size-history))
- (cons (list frame "MAKE-FRAME")
- (cdr frame-size-history)))))
-
;; We can run `window-configuration-change-hook' for this frame now.
(frame-after-make-frame frame t)
(run-hook-with-args 'after-make-frame-functions frame)
@@ -1159,8 +1147,8 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
:group 'faces
:set #'(lambda (var value)
(set-default var value)
- (mapc 'frame-set-background-mode (frame-list)))
- :initialize 'custom-initialize-changed
+ (mapc #'frame-set-background-mode (frame-list)))
+ :initialize #'custom-initialize-changed
:type '(choice (const dark)
(const light)
(const :tag "automatic" nil)))
@@ -1173,6 +1161,27 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
(defvar inhibit-frame-set-background-mode nil)
+(defun frame--current-backround-mode (frame)
+ (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
+ (bg-color (frame-parameter frame 'background-color))
+ (tty-type (tty-type frame))
+ (default-bg-mode
+ (if (or (window-system frame)
+ (and tty-type
+ (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
+ tty-type)))
+ 'light
+ 'dark)))
+ (cond (frame-default-bg-mode)
+ ((equal bg-color "unspecified-fg") ; inverted colors
+ (if (eq default-bg-mode 'light) 'dark 'light))
+ ((not (color-values bg-color frame))
+ default-bg-mode)
+ ((color-dark-p (mapcar (lambda (c) (/ c 65535.0))
+ (color-values bg-color frame)))
+ 'dark)
+ (t 'light))))
+
(defun frame-set-background-mode (frame &optional keep-face-specs)
"Set up display-dependent faces on FRAME.
Display-dependent faces are those which have different definitions
@@ -1181,30 +1190,8 @@ according to the `background-mode' and `display-type' frame parameters.
If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
face specs for the new background mode."
(unless inhibit-frame-set-background-mode
- (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
- (bg-color (frame-parameter frame 'background-color))
- (tty-type (tty-type frame))
- (default-bg-mode
- (if (or (window-system frame)
- (and tty-type
- (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)"
- tty-type)))
- 'light
- 'dark))
- (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
- (bg-mode
- (cond (frame-default-bg-mode)
- ((equal bg-color "unspecified-fg") ; inverted colors
- non-default-bg-mode)
- ((not (color-values bg-color frame))
- default-bg-mode)
- ((>= (apply '+ (color-values bg-color frame))
- ;; Just looking at the screen, colors whose
- ;; values add up to .6 of the white total
- ;; still look dark to me.
- (* (apply '+ (color-values "white" frame)) .6))
- 'light)
- (t 'dark)))
+ (let* ((bg-mode
+ (frame--current-backround-mode frame))
(display-type
(cond ((null (window-system frame))
(if (tty-display-color-p frame) 'color 'mono))
@@ -1244,7 +1231,7 @@ face specs for the new background mode."
;; during startup with -rv on the command
;; line for the initial frame, because frames
;; are not recorded in the pdump file.
- (assq face (frame-face-alist frame))
+ (gethash face (frame--face-hash-table))
(face-spec-match-p face
(face-user-default-spec face)
frame)))
@@ -1270,6 +1257,26 @@ the `background-mode' terminal parameter."
(intern (downcase bg-resource))))
(terminal-parameter frame 'background-mode)))
+;; FIXME: This needs to be significantly improved before we can use it:
+;; - Fix the "scope" to be consistent: the code below is partly per-frame
+;; and partly all-frames :-(
+;; - Make it interact correctly with color themes (e.g. modus-themes).
+;; Maybe automatically disabling color themes that disagree with the
+;; selected value of `dark-mode'.
+;; - Check interaction with "(in|re)verse-video".
+;;
+;; (define-minor-mode dark-mode
+;; "Use light text on dark background."
+;; :global t
+;; :group 'faces
+;; (when (eq dark-mode
+;; (eq 'light (frame--current-backround-mode (selected-frame))))
+;; ;; FIXME: Change the face's SPEC instead?
+;; (set-face-attribute 'default nil
+;; :foreground (face-attribute 'default :background)
+;; :background (face-attribute 'default :foreground))
+;; (frame-set-background-mode (selected-frame))))
+
;;;; Frame configurations
@@ -1354,9 +1361,9 @@ 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)
+(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.
@@ -1370,7 +1377,7 @@ FRAME defaults to the selected frame."
FRAME defaults to the selected frame."
(setq frame (window-normalize-frame frame))
(- (frame-native-height frame)
- (tab-bar-height frame t)
+ (if (fboundp 'tab-bar-height) (tab-bar-height frame t) 0)
(* 2 (frame-internal-border-width frame))))
(defun frame-outer-width (&optional frame)
@@ -1390,7 +1397,7 @@ FRAME defaults to the selected frame."
(declare-function x-list-fonts "xfaces.c"
(pattern &optional face frame maximum width))
-(defun set-frame-font (font &optional keep-size frames)
+(defun set-frame-font (font &optional keep-size frames inhibit-customize)
"Set the default font to FONT.
When called interactively, prompt for the name of a font, and use
that font on the selected frame. When called from Lisp, FONT
@@ -1407,7 +1414,10 @@ If FRAMES is non-nil, it should be a list of frames to act upon,
or t meaning all existing graphical frames.
Also, if FRAMES is non-nil, alter the user's Customization settings
as though the font-related attributes of the `default' face had been
-\"set in this session\", so that the font is applied to future frames."
+\"set in this session\", so that the font is applied to future frames.
+
+If INHIBIT-CUSTOMIZE is non-nil, don't update the user's
+Customization settings."
(interactive
(let* ((completion-ignore-case t)
(default (frame-parameter nil 'font))
@@ -1444,7 +1454,8 @@ as though the font-related attributes of the `default' face had been
f
(list (cons 'height (round height (frame-char-height f)))
(cons 'width (round width (frame-char-width f))))))))
- (when frames
+ (when (and frames
+ (not inhibit-customize))
;; Alter the user's Custom setting of the `default' face, but
;; only for font-related attributes.
(let ((specs (cadr (assq 'user (get 'default 'theme-face))))
@@ -1673,26 +1684,104 @@ and width values are in pixels.
(defun frame--size-history (&optional frame)
"Print history of resize operations for FRAME.
-Print prettified version of `frame-size-history' into a buffer
-called *frame-size-history*. Optional argument FRAME denotes the
-frame whose history will be printed. FRAME defaults to the
-selected frame."
+This function dumps a prettified version of `frame-size-history'
+into a buffer called *frame-size-history*. The optional argument
+FRAME denotes the frame whose history will be dumped; it defaults
+to the selected frame.
+
+Storing information about resize operations is off by default.
+If you set the variable `frame-size-history' like this
+
+(setq frame-size-history '(100))
+
+then Emacs will save information about the next 100 significant
+operations affecting any frame's size in that variable. This
+function prints the entries for FRAME stored in that variable in
+a more legible way.
+
+All lines start with an indication of the requested action. An
+entry like `menu-bar-lines' or `scroll-bar-width' indicates that
+a change of the corresponding frame parameter or Lisp variable
+was requested. An entry like gui_figure_window_size indicates
+that that C function was executed, an entry like ConfigureNotify
+indicates that that event was received.
+
+In long entries, a number in parentheses displays the INHIBIT
+parameter passed to the C function adjust_frame_size. Such
+entries may also display changes of frame rectangles in a form
+like R=n1xn2~>n3xn4 where R denotes the rectangle type (TS for
+text, NS for native and IS for inner frame rectangle sizes, all
+in pixels, TC for text rectangle sizes in frame columns and
+lines), n1 and n2 denote the old width and height and n3 and n4
+the new width and height in the according units. MS stands for
+the minimum inner frame size in pixels, IH and IV, if present,
+indicate that resizing horizontally and/or vertically was
+inhibited (either by `frame-inhibit-implied-resize' or because of
+the frame's fullscreen state).
+
+Shorter entries represent C functions that process width and
+height changes of the native rectangle where PS stands for the
+frame's present pixel width and height, XS for a requested pixel
+width and height and DS for some earlier requested but so far
+delayed pixel width and height.
+
+Very short entries represent calls of C functions that do not
+directly ask for size changes but may indirectly affect the size
+of frames like calls to map a frame or change its visibility."
(let ((history (reverse frame-size-history))
- entry)
+ entry item)
(setq frame (window-normalize-frame frame))
(with-current-buffer (get-buffer-create "*frame-size-history*")
(erase-buffer)
(insert (format "Frame size history of %s\n" frame))
(while (consp (setq entry (pop history)))
- (when (eq (car entry) frame)
- (pop entry)
- (insert (format "%s" (pop entry)))
- (move-to-column 24 t)
- (while entry
- (insert (format " %s" (pop entry))))
- (insert "\n")))
- (unless frame-size-history
- (insert "Frame size history is nil.\n")))))
+ (setq item (car entry))
+ (cond
+ ((not (consp item))
+ ;; An item added quickly for debugging purposes.
+ (insert (format "%s\n" entry)))
+ ((and (eq (nth 0 item) frame) (= (nth 1 item) 1))
+ ;; Length 1 is a "plain event".
+ (insert (format "%s\n" (nth 2 item))))
+ ((and (eq (nth 0 item) frame) (= (nth 1 item) 2))
+ ;; Length 2 is an "extra" item.
+ (insert (format "%s" (nth 2 item)))
+ (setq item (nth 0 (cdr entry)))
+ (insert (format ", PS=%sx%s" (nth 0 item) (nth 1 item)))
+ (when (or (>= (nth 2 item) 0) (>= (nth 3 item) 0))
+ (insert (format ", XS=%sx%s" (nth 2 item) (nth 3 item))))
+ (setq item (nth 1 (cdr entry)))
+ (when (or (>= (nth 0 item) 0) (>= (nth 1 item) 0))
+ (insert (format ", DS=%sx%s" (nth 0 item) (nth 1 item))))
+ (insert "\n"))
+ ((and (eq (nth 0 item) frame) (= (nth 1 item) 5))
+ ;; Length 5 is an `adjust-frame-size' item.
+ (insert (format "%s (%s)" (nth 3 item) (nth 2 item)))
+ (setq item (nth 0 (cdr entry)))
+ (unless (and (= (nth 0 item) (nth 2 item))
+ (= (nth 1 item) (nth 3 item)))
+ (insert (format ", TS=%sx%s~>%sx%s"
+ (nth 0 item) (nth 1 item) (nth 2 item) (nth 3 item))))
+ (setq item (nth 1 (cdr entry)))
+ (unless (and (= (nth 0 item) (nth 2 item))
+ (= (nth 1 item) (nth 3 item)))
+ (insert (format ", TC=%sx%s~>%sx%s"
+ (nth 0 item) (nth 1 item) (nth 2 item) (nth 3 item))))
+ (setq item (nth 2 (cdr entry)))
+ (unless (and (= (nth 0 item) (nth 2 item))
+ (= (nth 1 item) (nth 3 item)))
+ (insert (format ", NS=%sx%s~>%sx%s"
+ (nth 0 item) (nth 1 item) (nth 2 item) (nth 3 item))))
+ (setq item (nth 3 (cdr entry)))
+ (unless (and (= (nth 0 item) (nth 2 item))
+ (= (nth 1 item) (nth 3 item)))
+ (insert (format ", IS=%sx%s~>%sx%s"
+ (nth 0 item) (nth 1 item) (nth 2 item) (nth 3 item))))
+ (setq item (nth 4 (cdr entry)))
+ (insert (format ", MS=%sx%s" (nth 0 item) (nth 1 item)))
+ (when (nth 2 item) (insert " IH"))
+ (when (nth 3 item) (insert " IV"))
+ (insert "\n")))))))
(declare-function x-frame-edges "xfns.c" (&optional frame type))
(declare-function w32-frame-edges "w32fns.c" (&optional frame type))
@@ -1988,9 +2077,9 @@ frame's display)."
(fboundp 'image-mask-p)
(fboundp 'image-size)))
-(defalias 'display-blink-cursor-p 'display-graphic-p)
-(defalias 'display-multi-frame-p 'display-graphic-p)
-(defalias 'display-multi-font-p 'display-graphic-p)
+(defalias 'display-blink-cursor-p #'display-graphic-p)
+(defalias 'display-multi-frame-p #'display-graphic-p)
+(defalias 'display-multi-font-p #'display-graphic-p)
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
@@ -2337,13 +2426,15 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to
the opposite frame edge from the edge indicated in the input spec."
(cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
-(defun delete-other-frames (&optional frame)
+(defun delete-other-frames (&optional frame iconify)
"Delete all frames on FRAME's terminal, except FRAME.
If FRAME uses another frame's minibuffer, the minibuffer frame is
left untouched. Do not delete any of FRAME's child frames. If
FRAME is a child frame, delete its siblings only. FRAME must be
-a live frame and defaults to the selected one."
- (interactive)
+a live frame and defaults to the selected one.
+If the prefix arg ICONIFY is non-nil, just iconify the frames rather than
+deleting them."
+ (interactive "i\nP")
(setq frame (window-normalize-frame frame))
(let ((minibuffer-frame (window-frame (minibuffer-window frame)))
(this (next-frame frame t))
@@ -2358,7 +2449,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
- (delete-frame this))
+ (if iconify (iconify-frame this) (delete-frame this)))
(setq this next))
;; In a second round consider all remaining frames.
(setq this (next-frame frame t))
@@ -2370,7 +2461,7 @@ a live frame and defaults to the selected one."
(and parent (not (eq (frame-parent this) parent)))
;; Do not delete a child frame of FRAME.
(eq (frame-parent this) frame))
- (delete-frame this))
+ (if iconify (iconify-frame this) (delete-frame this)))
(setq this next))))
@@ -2396,7 +2487,7 @@ parameters `bottom-divider-width' and `right-divider-width'."
:type '(choice (const :tag "Bottom only" bottom-only)
(const :tag "Right only" right-only)
(const :tag "Bottom and right" t))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@@ -2417,7 +2508,7 @@ parameter `bottom-divider-width'."
:type '(restricted-sexp
:tag "Default width of bottom dividers"
:match-alternatives (window-divider-width-valid-p))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@@ -2434,7 +2525,7 @@ parameter `right-divider-width'."
:type '(restricted-sexp
:tag "Default width of right dividers"
:match-alternatives (window-divider-width-valid-p))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
(when window-divider-mode
@@ -2711,14 +2802,14 @@ See also `toggle-frame-maximized'."
;;;; Key bindings
-(define-key ctl-x-5-map "2" 'make-frame-command)
-(define-key ctl-x-5-map "1" 'delete-other-frames)
-(define-key ctl-x-5-map "0" 'delete-frame)
-(define-key ctl-x-5-map "o" 'other-frame)
-(define-key ctl-x-5-map "5" 'other-frame-prefix)
-(define-key global-map [f11] 'toggle-frame-fullscreen)
-(define-key global-map [(meta f10)] 'toggle-frame-maximized)
-(define-key esc-map [f10] 'toggle-frame-maximized)
+(define-key ctl-x-5-map "2" #'make-frame-command)
+(define-key ctl-x-5-map "1" #'delete-other-frames)
+(define-key ctl-x-5-map "0" #'delete-frame)
+(define-key ctl-x-5-map "o" #'other-frame)
+(define-key ctl-x-5-map "5" #'other-frame-prefix)
+(define-key global-map [f11] #'toggle-frame-fullscreen)
+(define-key global-map [(meta f10)] #'toggle-frame-maximized)
+(define-key esc-map [f10] #'toggle-frame-maximized)
;; Misc.
@@ -2733,6 +2824,14 @@ See also `toggle-frame-maximized'."
(make-obsolete-variable
'window-system-version "it does not give useful information." "24.3")
+(defun set-frame-property--interactive (prompt number)
+ "Get a value for `set-frame-width' or `set-frame-height', prompting with PROMPT.
+Offer NUMBER as default value, if it is a natural number."
+ (if (and current-prefix-arg (not (consp current-prefix-arg)))
+ (list (selected-frame) (prefix-numeric-value current-prefix-arg))
+ (let ((default (and (natnump number) number)))
+ (list (selected-frame) (read-number prompt default)))))
+
;; 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,
diff --git a/lisp/frameset.el b/lisp/frameset.el
index e698d5401db..6aa94f8be5a 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -636,7 +636,7 @@ see `frameset-filter-alist'."
(not (frameset-switch-to-gui-p parameters))
(let* ((prefix:p (symbol-name (car current)))
(p (intern (substring prefix:p
- (1+ (string-match-p ":" prefix:p)))))
+ (1+ (string-search ":" prefix:p)))))
(val (cdr current))
(found (assq p filtered)))
(if (not found)
diff --git a/lisp/fringe.el b/lisp/fringe.el
index e2d7968adde..82cfacc6b6f 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -181,11 +181,15 @@ When setting this variable in a Lisp program, call
`set-fringe-mode' afterward to make it take real effect.
To modify the appearance of the fringe in a specific frame, use
-the interactive function `set-fringe-style'."
+the interactive function `set-fringe-style'.
+
+Note that, despite the name, this is not a variable that controls
+a (major or minor) Emacs mode, but controls the appearance of the
+fringes."
:type `(choice
,@ (mapcar (lambda (style)
(let ((name
- (replace-regexp-in-string "-" " " (car style))))
+ (string-replace "-" " " (car style))))
`(const :tag
,(concat (capitalize (substring name 0 1))
(substring name 1))
@@ -248,7 +252,10 @@ Fringe widths set by `set-window-fringes' override the default
fringe widths set by this command. This command applies to all
frames that exist and frames to be created in the future. If you
want to set the default appearance of fringes on the selected
-frame only, see the command `set-fringe-style'."
+frame only, see the command `set-fringe-style'.
+
+Note that, despite the name, this is not a (major or minor) Emacs
+mode, but a command that controls the appearance of the fringes."
(interactive (list (fringe-query-style 'all-frames)))
(set-fringe-mode mode))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 4c6e1189003..4505d8513f9 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -23,7 +23,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file contains a collection of generic modes.
;;
;; INSTALLATION:
diff --git a/lisp/gnus/.dir-locals.el b/lisp/gnus/.dir-locals.el
deleted file mode 100644
index fb968e13a36..00000000000
--- a/lisp/gnus/.dir-locals.el
+++ /dev/null
@@ -1,4 +0,0 @@
-((emacs-lisp-mode . ((show-trailing-whitespace . t))))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 08beef7db9f..e6c4630a67b 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -310,7 +310,7 @@ You can control what lines will be unwrapped by frobbing
`gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max',
indicating the minimum and maximum length of an unwrapped citation line. If
NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((case-fold-search nil)
(inhibit-read-only t)
(cite-marks gnus-outlook-deuglify-cite-marks)
@@ -430,7 +430,7 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
(defun gnus-article-outlook-repair-attribution (&optional nodisplay)
"Repair a broken attribution line.
If NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((attrib-start
(or
(gnus-outlook-repair-attribution-other)
@@ -442,7 +442,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer."
(defun gnus-article-outlook-rearrange-citation (&optional nodisplay)
"Repair broken citations.
If NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay)))
;; rearrange citations if an attribution line has been recognized
(if attrib-start
@@ -455,7 +455,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer."
Treat \"smartquotes\", unwrap lines, repair attribution and
rearrange citation. If NODISPLAY is non-nil, don't redisplay the
article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
;; apply treatment of dumb quotes
(gnus-article-treat-smartquotes)
;; repair wrapped cited lines
@@ -467,7 +467,7 @@ article buffer."
;;;###autoload
(defun gnus-article-outlook-deuglify-article ()
"Deuglify broken Outlook (Express) articles and redisplay."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-outlook-deuglify-article nil))
(provide 'deuglify)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 7ded9e40e99..3c1403e1551 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -170,12 +170,17 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored."
"All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
- :type '(choice
- (repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
+ :type `(choice
+ (repeat :value-to-internal
+ ,(lambda (_widget value)
+ ;; FIXME: Are we sure this can't be used without
+ ;; loading cus-edit?
+ (declare-function custom-split-regexp-maybe
+ "cus-edit" (regexp))
+ (custom-split-regexp-maybe value))
+ :match ,(lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
regexp)
(const :tag "Use gnus-ignored-headers" nil)
regexp)
@@ -402,14 +407,14 @@ the entire emphasized word. The third is a number that says what
regexp grouping should be displayed and highlighted. The fourth
is the face used for highlighting."
:type
- '(repeat
+ `(repeat
(menu-choice
:format "%[Customizing Style%]\n%v"
:indent 2
(group :tag "Default"
:value ("" 0 0 default)
:value-create
- (lambda (widget)
+ ,(lambda (widget)
(let ((value (widget-get
(cadr (widget-get (widget-get widget :parent)
:args))
@@ -728,9 +733,6 @@ Each element is a regular expression."
:type '(repeat regexp)
:group 'gnus-article-various)
-(make-obsolete-variable 'gnus-article-hide-pgp-hook nil
- "Gnus 5.10 (Emacs 22.1)")
-
(defface gnus-button
'((t (:weight bold)))
"Face used for highlighting a button in the article buffer."
@@ -974,7 +976,7 @@ see http://www.cs.indiana.edu/picons/ftp/index.html"
:version "22.1"
:type '(repeat directory)
:link '(url-link :tag "download"
- "http://www.cs.indiana.edu/picons/ftp/index.html")
+ "http://www.cs.indiana.edu/picons/ftp/index.html")
:link '(custom-manual "(gnus)Picons")
:group 'gnus-picon)
@@ -1264,9 +1266,6 @@ Any symbol is used to look up a regular expression to match the
banner in `gnus-list-identifiers'. A string is used as a regular
expression to match the identifier directly.")
-(make-obsolete-variable 'gnus-treat-strip-pgp nil
- "Gnus 5.10 (Emacs 22.1)")
-
(defcustom gnus-treat-strip-pem nil
"Strip PEM signatures.
Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1396,9 +1395,6 @@ predicate. See Info node `(gnus)Customizing Articles'."
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
-(make-obsolete-variable 'gnus-treat-display-xface
- 'gnus-treat-display-x-face "Emacs 22.1")
-
(defcustom gnus-treat-display-x-face
(and (not noninteractive)
(gnus-image-type-available-p 'xbm)
@@ -1423,17 +1419,7 @@ See Info node `(gnus)Customizing Articles' and Info node
symbol
(cond ((or (boundp symbol) (get symbol 'saved-value))
value)
- ((boundp 'gnus-treat-display-xface)
- (message "\
-** gnus-treat-display-xface is an obsolete variable;\
- use gnus-treat-display-x-face instead")
- (default-value 'gnus-treat-display-xface))
- ((get 'gnus-treat-display-xface 'saved-value)
- (message "\
-** gnus-treat-display-xface is an obsolete variable;\
- use gnus-treat-display-x-face instead")
- (eval (car (get 'gnus-treat-display-xface 'saved-value)) t))
- (t
+ (t
value)))))
(put 'gnus-treat-display-x-face 'highlight t)
@@ -1823,7 +1809,7 @@ Initialized from `text-mode-syntax-table'.")
(defun article-hide-headers (&optional _arg _delete)
"Hide unwanted headers and possibly sort them as well."
- (interactive)
+ (interactive nil gnus-article-mode)
;; This function might be inhibited.
(unless gnus-inhibit-hiding
(let ((inhibit-read-only t)
@@ -1891,7 +1877,7 @@ Initialized from `text-mode-syntax-table'.")
"Toggle hiding of headers that aren't very interesting.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
(not gnus-show-all-headers))
(save-excursion
@@ -2050,7 +2036,7 @@ always hide."
(defun article-normalize-headers ()
"Make all header lines 40 characters long."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((inhibit-read-only t)
column)
(save-excursion
@@ -2086,7 +2072,7 @@ iso-8859-1 character map in an attempt to provide more quoting
characters. If you see something like \\222 or \\264 where
you're expecting some kind of apostrophe or quotation mark, then
try this wash."
- (interactive)
+ (interactive nil gnus-article-mode)
(article-translate-strings gnus-article-smartquotes-map))
(define-obsolete-function-alias 'article-treat-dumbquotes
#'article-treat-smartquotes "27.1")
@@ -2095,7 +2081,7 @@ try this wash."
(defun article-treat-non-ascii ()
"Translate many Unicode characters into their ASCII equivalents."
- (interactive)
+ (interactive nil gnus-article-mode)
(require 'org-entities)
(let ((table (make-char-table nil)))
(dolist (elem org-entities)
@@ -2138,7 +2124,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(defun article-treat-overstrike ()
"Translate overstrikes into bold text."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(when (article-goto-body)
(let ((inhibit-read-only t))
@@ -2166,7 +2152,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
(defun article-treat-ansi-sequences ()
"Translate ANSI SGR control sequences into overlays or extents."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(when (article-goto-body)
(require 'ansi-color)
@@ -2178,7 +2164,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
"Unfold folded message headers.
Only the headers that fit into the current window width will be
unfolded."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (length)
(while (not (eobp))
@@ -2204,7 +2190,7 @@ unfolded."
(defun gnus-article-treat-fold-headers ()
"Fold message headers."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(while (not (eobp))
(save-restriction
@@ -2214,7 +2200,7 @@ unfolded."
(defun gnus-treat-smiley ()
"Toggle display of textual emoticons (\"smileys\") as small graphical icons."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (memq 'smiley gnus-article-wash-types)
(gnus-delete-images 'smiley)
@@ -2227,7 +2213,7 @@ unfolded."
(defun gnus-article-remove-images ()
"Remove all images from the article buffer."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(save-restriction
(widen)
@@ -2239,7 +2225,11 @@ unfolded."
(defun gnus-article-show-images ()
"Show any images that are in the HTML-rendered article buffer.
This only works if the article in question is HTML."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
+ ;; Reselect for image display.
+ (let ((gnus-blocked-images nil)
+ (gnus-inhibit-images nil))
+ (gnus-summary-select-article))
(gnus-with-article-buffer
(save-restriction
(widen)
@@ -2255,7 +2245,7 @@ This only works if the article in question is HTML."
(defun gnus-article-treat-fold-newsgroups ()
"Fold the Newsgroups and Followup-To message headers."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(while (gnus-article-goto-header "newsgroups\\|followup-to")
(save-restriction
@@ -2279,7 +2269,7 @@ predicate. See Info node `(gnus)Customizing Articles'."
If ARG is non-nil and not a number, toggle
`gnus-article-truncate-lines' too. If ARG is a number, truncate
long lines if and only if arg is positive."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(cond
((and (numberp arg) (> arg 0))
(setq gnus-article-truncate-lines t))
@@ -2298,7 +2288,7 @@ long lines if and only if arg is positive."
(defun gnus-article-treat-body-boundary ()
"Place a boundary line at the end of the headers."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(when (and gnus-body-boundary-delimiter
(> (length gnus-body-boundary-delimiter) 0))
(gnus-with-article-headers
@@ -2317,7 +2307,7 @@ long lines if and only if arg is positive."
"Fill lines that are wider than the window width or `fill-column'.
If WIDTH (interactively, the numeric prefix), use that as the
fill width."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(save-excursion
(let* ((inhibit-read-only t)
(window-width (window-width (get-buffer-window (current-buffer))))
@@ -2341,7 +2331,7 @@ fill width."
(defun article-capitalize-sentences ()
"Capitalize the first word in each sentence."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t)
(paragraph-start "^[\n\^L]"))
@@ -2352,7 +2342,7 @@ fill width."
(defun article-remove-cr ()
"Remove trailing CRs and then translate remaining CRs into LFs."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-min))
@@ -2364,7 +2354,7 @@ fill width."
(defun article-remove-trailing-blank-lines ()
"Remove all trailing blank lines from the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-max))
@@ -2383,7 +2373,7 @@ fill width."
(defun article-display-face (&optional force)
"Display any Face headers in the header."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode gnus-summary-mode)
(let ((wash-face-p buffer-read-only))
(gnus-with-article-headers
;; When displaying parts, this function can be called several times on
@@ -2431,7 +2421,7 @@ fill width."
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode gnus-summary-mode)
(let ((wash-face-p buffer-read-only)) ;; When type `W f'
(gnus-with-article-headers
;; Delete the old process, if any.
@@ -2493,7 +2483,7 @@ fill width."
(defun article-decode-mime-words ()
"Decode all MIME-encoded words in the article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t)
(mail-parse-charset gnus-newsgroup-charset)
@@ -2505,7 +2495,7 @@ fill width."
(defun article-decode-charset (&optional prompt)
"Decode charset-encoded text in the article.
If PROMPT (the prefix), prompt for a coding system to use."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((inhibit-point-motion-hooks t) (case-fold-search t)
(inhibit-read-only t)
(mail-parse-charset gnus-newsgroup-charset)
@@ -2529,7 +2519,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip-cte cte)))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-search "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(forward-line 1)
@@ -2627,7 +2617,7 @@ Mail-Reply-To: and Mail-Followup-To:."
If FORCE, decode the article whether it is marked as quoted-printable
or not.
If READ-CHARSET, ask for a coding system."
- (interactive (list 'force current-prefix-arg))
+ (interactive (list 'force current-prefix-arg) gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2655,7 +2645,7 @@ If READ-CHARSET, ask for a coding system."
"Translate a base64 article.
If FORCE, decode the article whether it is marked as base64 not.
If READ-CHARSET, ask for a coding system."
- (interactive (list 'force current-prefix-arg))
+ (interactive (list 'force current-prefix-arg) gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t) type charset)
(if (gnus-buffer-live-p gnus-original-article-buffer)
@@ -2687,7 +2677,7 @@ If READ-CHARSET, ask for a coding system."
(defun article-decode-HZ ()
"Translate a HZ-encoded article."
- (interactive)
+ (interactive nil gnus-article-mode)
(require 'rfc1843)
(save-excursion
(let ((inhibit-read-only t))
@@ -2695,7 +2685,7 @@ If READ-CHARSET, ask for a coding system."
(defun article-unsplit-urls ()
"Remove the newlines that some other mailers insert into URLs."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-read-only t))
(goto-char (point-min))
@@ -2707,7 +2697,7 @@ If READ-CHARSET, ask for a coding system."
(defun article-wash-html ()
"Format an HTML article."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((handles nil)
(inhibit-read-only t))
(when (gnus-buffer-live-p gnus-original-article-buffer)
@@ -3041,7 +3031,7 @@ This command creates temporary files to pass HTML contents including
images if any to the browser, and deletes them when exiting the group
\(if you want)."
;; Cf. `mm-w3m-safe-url-regexp'
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(if arg
(gnus-summary-show-article)
(let ((gnus-visible-headers
@@ -3078,7 +3068,7 @@ images if any to the browser, and deletes them when exiting the group
(defun article-hide-list-identifiers ()
"Remove list identifiers from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((inhibit-point-motion-hooks t)
(regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
(inhibit-read-only t))
@@ -3100,7 +3090,7 @@ The `gnus-list-identifiers' variable specifies what to do."
"Toggle hiding of any PEM headers and signatures in the current article.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(unless (gnus-article-check-hidden-text 'pem arg)
(save-excursion
(let ((inhibit-read-only t) end)
@@ -3126,7 +3116,7 @@ always hide."
(defun article-strip-banner ()
"Strip the banners specified by the `banner' group parameter and by
`gnus-article-address-banner-alist'."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(save-restriction
(let ((inhibit-point-motion-hooks t))
@@ -3175,7 +3165,7 @@ always hide."
(defun article-babel ()
"Translate article using an online translation service."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(require 'babel)
(gnus-with-article-buffer
(when (article-goto-body)
@@ -3192,7 +3182,7 @@ always hide."
"Hide the signature in the current article.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(unless (gnus-article-check-hidden-text 'signature arg)
(save-excursion
(save-restriction
@@ -3204,7 +3194,7 @@ always hide."
(defun article-strip-headers-in-body ()
"Strip offensive headers from bodies."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(article-goto-body)
(let ((case-fold-search t))
@@ -3213,7 +3203,7 @@ always hide."
(defun article-strip-leading-blank-lines ()
"Remove all blank lines from the beginning of the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3255,7 +3245,7 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-multiple-blank-lines ()
"Replace consecutive blank lines with one empty line."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3274,7 +3264,7 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-leading-space ()
"Remove all white space from the beginning of the lines in the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3284,7 +3274,7 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-trailing-space ()
"Remove all white space from the end of the lines in the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3294,14 +3284,14 @@ Point is left at the beginning of the narrowed-to region."
(defun article-strip-blank-lines ()
"Strip leading, trailing and multiple blank lines."
- (interactive)
+ (interactive nil gnus-article-mode)
(article-strip-leading-blank-lines)
(article-remove-trailing-blank-lines)
(article-strip-multiple-blank-lines))
(defun article-strip-all-blank-lines ()
"Strip all blank lines."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-read-only t))
@@ -3433,7 +3423,7 @@ lines forward."
"Convert DATE date to TYPE in the current article.
The default type is `ut'. See `gnus-article-date-headers' for
possible values."
- (interactive (list 'ut t))
+ (interactive (list 'ut t) gnus-article-mode)
(let* ((case-fold-search t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
@@ -3677,29 +3667,29 @@ possible values."
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'local highlight))
(defun article-date-english (&optional highlight)
"Convert the current article date to something that is proper English."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'english highlight))
(defun article-date-original (&optional highlight)
"Convert the current article date to what it was originally.
This is only useful if you have used some other date conversion
function and want to see what the date was before converting."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'original highlight))
(defun article-date-lapsed (&optional highlight)
"Convert the current article date to time lapsed since it was sent."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'lapsed highlight))
(defun article-date-combined-lapsed (&optional highlight)
"Convert the current article date to time lapsed since it was sent."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'combined-lapsed highlight))
(defun article-update-date-lapsed ()
@@ -3748,16 +3738,16 @@ function and want to see what the date was before converting."
"Start a timer to update the Date headers in the article buffers.
The numerical prefix says how frequently (in seconds) the function
is to run."
- (interactive "p")
+ (interactive "p" gnus-article-mode)
(unless n
(setq n 1))
(gnus-stop-date-timer)
(setq article-lapsed-timer
- (run-at-time 1 n 'article-update-date-lapsed)))
+ (run-at-time 1 n #'article-update-date-lapsed)))
(defun gnus-stop-date-timer ()
"Stop the Date timer."
- (interactive)
+ (interactive nil gnus-article-mode)
(when article-lapsed-timer
(cancel-timer article-lapsed-timer)
(setq article-lapsed-timer nil)))
@@ -3765,12 +3755,12 @@ is to run."
(defun article-date-user (&optional highlight)
"Convert the current article date to the user-defined format.
This format is defined by the `gnus-article-time-format' variable."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'user-defined highlight))
(defun article-date-iso8601 (&optional highlight)
"Convert the current article date to ISO8601."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode)
(article-date-ut 'iso8601 highlight))
(defmacro gnus-article-save-original-date (&rest forms)
@@ -3803,7 +3793,7 @@ This format is defined by the `gnus-article-time-format' variable."
(defun article-remove-leading-whitespace ()
"Remove excessive whitespace from all headers."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(save-restriction
(let ((inhibit-read-only t))
@@ -3814,7 +3804,7 @@ This format is defined by the `gnus-article-time-format' variable."
(defun article-emphasize (&optional arg)
"Emphasize text according to `gnus-emphasis-alist'."
- (interactive (gnus-article-hidden-arg))
+ (interactive (gnus-article-hidden-arg) gnus-article-mode)
(unless (gnus-article-check-hidden-text 'emphasis arg)
(save-excursion
(let ((alist (or
@@ -4247,7 +4237,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defun article-verify-x-pgp-sig ()
"Verify X-PGP-Sig."
;; <https://ftp.isc.org/pub/pgpcontrol/FORMAT>
- (interactive)
+ (interactive nil gnus-article-mode)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(let ((sig (with-current-buffer gnus-original-article-buffer
(gnus-fetch-field "X-PGP-Sig")))
@@ -4321,20 +4311,16 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defun article-verify-cancel-lock ()
"Verify Cancel-Lock header."
- (interactive)
+ (interactive nil gnus-article-mode)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(canlock-verify gnus-original-article-buffer)))
-(defmacro gnus--\,@ (exp)
- (declare (debug t))
- `(progn ,@(eval exp t)))
-
(gnus--\,@
(mapcar (lambda (func)
`(defun ,(intern (format "gnus-%s" func))
(&optional interactive &rest args)
,(format "Run `%s' in the article buffer." func)
- (interactive (list t))
+ (interactive (list t) gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(if interactive
(call-interactively #',func)
@@ -4424,7 +4410,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
"\M-g" gnus-article-read-summary-keys)
(substitute-key-definition
- 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
+ #'undefined #'gnus-article-read-summary-keys gnus-article-mode-map)
(defvar gnus-article-send-map)
(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
@@ -4502,12 +4488,12 @@ commands:
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
- (setq-local bookmark-make-record-function 'gnus-summary-bookmark-make-record)
+ (setq-local bookmark-make-record-function #'gnus-summary-bookmark-make-record)
;; Prevent Emacs from displaying non-break space with
;; `nobreak-space' face.
(setq-local nobreak-char-display nil)
;; Enable `gnus-article-remove-images' to delete images shr.el renders.
- (setq-local shr-put-image-function 'gnus-shr-put-image)
+ (setq-local shr-put-image-function #'gnus-shr-put-image)
(unless gnus-article-show-cursor
(setq cursor-in-non-selected-windows nil))
(gnus-set-default-directory)
@@ -4742,21 +4728,22 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle"
"Mode for sticky articles."
;; Release bindings that won't work.
- (substitute-key-definition 'gnus-article-read-summary-keys 'undefined
+ (substitute-key-definition #'gnus-article-read-summary-keys #'undefined
gnus-sticky-article-mode-map)
- (substitute-key-definition 'gnus-article-refer-article 'undefined
+ (substitute-key-definition #'gnus-article-refer-article #'undefined
gnus-sticky-article-mode-map)
(dolist (k '("e" "h" "s" "F" "R"))
(define-key gnus-sticky-article-mode-map k nil))
- (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer)
- (define-key gnus-sticky-article-mode-map "q" 'bury-buffer)
- (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly)
- (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key))
+ (define-key gnus-sticky-article-mode-map "k"
+ #'gnus-kill-sticky-article-buffer)
+ (define-key gnus-sticky-article-mode-map "q" #'bury-buffer)
+ (define-key gnus-sticky-article-mode-map "\C-hc" #'describe-key-briefly)
+ (define-key gnus-sticky-article-mode-map "\C-hk" #'describe-key))
(defun gnus-sticky-article (arg)
"Make the current article sticky.
If a prefix ARG is given, ask for a name for this sticky article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-summary-show-thread)
(gnus-summary-select-article nil nil 'pseudo)
(let (new-art-buf-name)
@@ -4800,7 +4787,7 @@ If a prefix ARG is given, ask for a name for this sticky article buffer."
"Kill the given sticky article BUFFER.
If none is given, assume the current buffer and kill it if it has
`gnus-sticky-article-mode'."
- (interactive)
+ (interactive nil gnus-article-mode)
(unless buffer
(setq buffer (current-buffer)))
(with-current-buffer buffer
@@ -4810,7 +4797,7 @@ If none is given, assume the current buffer and kill it if it has
(defun gnus-kill-sticky-article-buffers (arg)
"Kill all sticky article buffers.
If a prefix ARG is given, ask for confirmation."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(dolist (buf (gnus-buffers))
(with-current-buffer buf
(and (derived-mode-p 'gnus-sticky-article-mode)
@@ -4882,9 +4869,9 @@ General format specifiers can also be used. See Info node
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
- (define-key map "\r" 'gnus-article-push-button)
- (define-key map [mouse-2] 'gnus-article-push-button)
- (define-key map [down-mouse-3] 'gnus-mime-button-menu)
+ (define-key map "\r" #'gnus-article-push-button)
+ (define-key map [mouse-2] #'gnus-article-push-button)
+ (define-key map [down-mouse-3] #'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
@@ -4952,7 +4939,7 @@ General format specifiers can also be used. See Info node
(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
- (interactive)
+ (interactive nil gnus-article-mode)
(with-current-buffer gnus-article-buffer
(let ((handles (or handles gnus-article-mime-handles))
(mail-parse-charset gnus-newsgroup-charset)
@@ -4969,7 +4956,7 @@ General format specifiers can also be used. See Info node
(defun gnus-article-jump-to-part (n)
"Jump to MIME part N."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((parts (with-current-buffer gnus-article-buffer
(length gnus-article-mime-handle-alist))))
(when (zerop parts)
@@ -5065,11 +5052,11 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(defun gnus-mime-replace-part (file)
"Replace MIME part under point with an external body."
;; Useful if file has already been saved to disk
- (interactive
- (list
- (read-file-name "Replace MIME part with file: "
- (or mm-default-directory default-directory)
- nil t)))
+ (interactive (list
+ (read-file-name "Replace MIME part with file: "
+ (or mm-default-directory default-directory)
+ nil t))
+ gnus-article-mode)
(unless (file-regular-p (file-truename file))
(error "Can't replace part with %s, which isn't a regular file"
file))
@@ -5078,7 +5065,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(defun gnus-mime-save-part-and-strip (&optional file event)
"Save the MIME part under point then replace it with an external body.
If FILE is given, use it for the external part."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5120,7 +5107,7 @@ The current article has a complicated MIME structure, giving up..."))
(defun gnus-mime-delete-part (&optional event)
"Delete the MIME part under point.
Replace it with some information about the removed part."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
@@ -5169,7 +5156,7 @@ Deleting parts may malfunction or destroy the article; continue? "))
(defun gnus-mime-save-part (&optional event)
"Save the MIME part under point."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
@@ -5179,7 +5166,7 @@ Deleting parts may malfunction or destroy the article; continue? "))
(defun gnus-mime-pipe-part (&optional cmd event)
"Pipe the MIME part under point to a process.
Use CMD as the process."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
@@ -5188,7 +5175,7 @@ Use CMD as the process."
(defun gnus-mime-view-part (&optional event)
"Interactively choose a viewing method for the MIME part under point."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5218,7 +5205,7 @@ Use CMD as the process."
"Choose a MIME media type, and view the part as such.
If non-nil, PRED is a predicate to use during completion to limit the
available media-types."
- (interactive (list nil nil last-nonmenu-event))
+ (interactive (list nil nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(if event (mouse-set-point event))
(unless mime-type
@@ -5257,7 +5244,8 @@ available media-types."
"Put the MIME part under point into a new buffer.
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
are decompressed."
- (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (interactive (list nil current-prefix-arg last-nonmenu-event)
+ gnus-article-mode)
(mouse-set-point event)
(gnus-article-check-buffer)
(unless handle
@@ -5313,7 +5301,8 @@ are decompressed."
(defun gnus-mime-print-part (&optional handle filename event)
"Print the MIME part under point."
(interactive
- (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
+ (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)
+ gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5341,7 +5330,8 @@ are decompressed."
(defun gnus-mime-inline-part (&optional handle arg event)
"Insert the MIME part under point into the current buffer.
Compressed files like .gz and .bz2 are decompressed."
- (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (interactive (list nil current-prefix-arg last-nonmenu-event)
+ gnus-article-mode)
(if event (mouse-set-point event))
(gnus-article-check-buffer)
(let* ((inhibit-read-only t)
@@ -5439,7 +5429,8 @@ CHARSET may either be a string or a symbol."
(defun gnus-mime-view-part-as-charset (&optional handle arg event)
"Insert the MIME part under point into the current buffer using the
specified charset."
- (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (interactive (list nil current-prefix-arg last-nonmenu-event)
+ gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5479,7 +5470,7 @@ specified charset."
(defun gnus-mime-view-part-externally (&optional handle event)
"View the MIME part under point with an external viewer."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5501,7 +5492,7 @@ specified charset."
(defun gnus-mime-view-part-internally (&optional handle event)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
- (interactive (list nil last-nonmenu-event))
+ (interactive (list nil last-nonmenu-event) gnus-article-mode)
(save-excursion
(mouse-set-point event)
(gnus-article-check-buffer)
@@ -5522,7 +5513,9 @@ If no internal viewer is available, use an external viewer."
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at (point)."
(interactive
- (list (gnus-completing-read "Action" (mapcar #'car gnus-mime-action-alist) t)))
+ (list (gnus-completing-read
+ "Action" (mapcar #'car gnus-mime-action-alist) t))
+ gnus-article-mode)
(gnus-article-check-buffer)
(let ((action-pair (assoc action gnus-mime-action-alist)))
(if action-pair
@@ -5615,62 +5608,62 @@ If INTERACTIVE, call FUNCTION interactively."
(defun gnus-article-pipe-part (n)
"Pipe MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'mm-pipe-part))
(defun gnus-article-save-part (n)
"Save MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'mm-save-part))
(defun gnus-article-interactively-view-part (n)
"View MIME part N interactively, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'mm-interactively-view-part))
(defun gnus-article-copy-part (n)
"Copy MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-copy-part))
(defun gnus-article-view-part-as-charset (n)
"View MIME part N using a specified charset.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
(defun gnus-article-view-part-externally (n)
"View MIME part N externally, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
(defun gnus-article-inline-part (n)
"Inline MIME part N, which is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-inline-part))
(defun gnus-article-save-part-and-strip (n)
"Save MIME part N and replace it with an external body.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t))
(defun gnus-article-replace-part (n)
"Replace MIME part N with an external body.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-replace-part t t))
(defun gnus-article-delete-part (n)
"Delete MIME part N and add some information about the removed part.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-delete-part t))
(defun gnus-article-view-part-as-type (n)
"Choose a MIME media type, and view part N as such.
N is the numerical prefix."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
(defun gnus-article-mime-match-handle-first (condition)
@@ -5697,7 +5690,7 @@ N is the numerical prefix."
"View MIME part N, which is the numerical prefix.
If the part is already shown, hide the part. If N is nil, view
all parts."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(or (numberp n) (setq n (gnus-article-mime-match-handle-first
gnus-article-mime-match-handle-function)))
@@ -6046,7 +6039,28 @@ If nil, don't show those extra buttons."
(ignored gnus-ignored-mime-types)
(mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight))
(not-attachment t)
- display text)
+ ;; Arrange a callback from `mm-inline-message' if we're
+ ;; displaying a message/rfc822 part.
+ (mm-inline-message-prepare-function
+ (lambda (charset)
+ (let ((handles
+ (let (gnus-article-mime-handles
+ ;; disable prepare hook
+ gnus-article-prepare-hook
+ (gnus-newsgroup-charset
+ ;; mm-uu might set it.
+ (unless (eq charset 'gnus-decoded)
+ (or charset gnus-newsgroup-charset))))
+ (let ((gnus-original-article-buffer
+ (mm-handle-buffer handle)))
+ (run-hooks 'gnus-article-decode-hook))
+ (gnus-article-prepare-display)
+ gnus-article-mime-handles)))
+ (when handles
+ (setq gnus-article-mime-handles
+ (mm-merge-handles gnus-article-mime-handles handles))))))
+ display text
+ gnus-displaying-mime)
(catch 'ignored
(progn
(while ignored
@@ -6151,7 +6165,7 @@ If nil, don't show those extra buttons."
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
- handle (inhibit-read-only t) begend not-pref) ;; from
+ (inhibit-read-only t) begend not-pref) ;; from
(save-window-excursion
(save-restriction
(when ibegend
@@ -6165,8 +6179,8 @@ If nil, don't show those extra buttons."
(mm-remove-parts handles))
(setq begend (list (point-marker)))
;; Do the toggle.
- (unless (setq not-pref (cadr (member preferred ihandles)))
- (setq not-pref (car ihandles)))
+ (setq not-pref (or (cadr (member preferred ihandles))
+ (car ihandles)))
(when (or ibegend
(not preferred)
(not (gnus-unbuttonized-mime-type-p
@@ -6177,22 +6191,22 @@ If nil, don't show those extra buttons."
(progn
(insert (format "%d. " id))
(point))
- `(gnus-callback
- (lambda (handles)
- (unless ,(not ibegend)
- (setq gnus-article-mime-handle-alist
- ',gnus-article-mime-handle-alist))
- (gnus-mime-display-alternative
- ',ihandles ',not-pref ',begend ,id))
- keymap ,gnus-mime-button-map
- mouse-face ,gnus-article-mouse-face
- face ,gnus-article-button-face
- follow-link t
- gnus-part ,id
- article-type multipart
- rear-nonsticky t))
+ (let ((gamha gnus-article-mime-handle-alist))
+ `(gnus-callback
+ ,(lambda (_handles)
+ (unless (not ibegend)
+ (setq gnus-article-mime-handle-alist gamha))
+ (gnus-mime-display-alternative
+ ihandles not-pref begend id))
+ keymap ,gnus-mime-button-map
+ mouse-face ,gnus-article-mouse-face
+ face ,gnus-article-button-face
+ follow-link t
+ gnus-part ,id
+ article-type multipart
+ rear-nonsticky t)))
;; Do the handles
- (while (setq handle (pop handles))
+ (dolist (handle handles)
(add-text-properties
;; (setq from
(point) ;; )
@@ -6201,22 +6215,22 @@ If nil, don't show those extra buttons."
(if (equal handle preferred) ?* ? )
(mm-handle-media-type handle)))
(point))
- `(gnus-callback
- (lambda (handles)
- (unless ,(not ibegend)
- (setq gnus-article-mime-handle-alist
- ',gnus-article-mime-handle-alist))
- (gnus-mime-display-alternative
- ',ihandles ',handle ',begend ,id))
- keymap ,gnus-mime-button-map
- mouse-face ,gnus-article-mouse-face
- face ,gnus-article-button-face
- follow-link t
- gnus-part ,id
- button t
- category t
- gnus-data ,handle
- rear-nonsticky t))
+ (let ((gamha gnus-article-mime-handle-alist))
+ `(gnus-callback
+ ,(lambda (_handles)
+ (unless (not ibegend)
+ (setq gnus-article-mime-handle-alist gamha))
+ (gnus-mime-display-alternative
+ ihandles handle begend id))
+ keymap ,gnus-mime-button-map
+ mouse-face ,gnus-article-mouse-face
+ face ,gnus-article-button-face
+ follow-link t
+ gnus-part ,id
+ button t
+ category t
+ gnus-data ,handle
+ rear-nonsticky t)))
(insert " "))
(insert "\n\n"))
(when preferred
@@ -6224,8 +6238,9 @@ If nil, don't show those extra buttons."
(gnus-display-mime preferred)
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets)))
+ (and (buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets))))
(gnus-bind-mm-vars (mm-display-part preferred))
;; Do highlighting.
(save-excursion
@@ -6321,7 +6336,8 @@ is the string to use when it is inactive.")
(setq gnus-article-image-alist (delq entry gnus-article-image-alist))
(gnus-delete-wash-type category)))
-(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
+(defalias 'gnus-article-hide-headers-if-wanted
+ #'gnus-article-maybe-hide-headers)
(defun gnus-article-maybe-hide-headers ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
@@ -6387,7 +6403,7 @@ Provided for backwards compatibility."
This function toggles the display when called interactively. Note that
buttons to be added to the header are only the ones that aren't inlined
in the body. Use `gnus-header-face-alist' to highlight buttons."
- (interactive (list t))
+ (interactive (list t) gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((case-fold-search t) buttons st)
(save-excursion
@@ -6492,7 +6508,7 @@ the coding cookie."
(defun gnus-narrow-to-page (&optional arg)
"Narrow the article buffer to a page.
If given a numerical ARG, move forward ARG pages."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(setq arg (if arg (prefix-numeric-value arg) 0))
(with-current-buffer gnus-article-buffer
(widen)
@@ -6545,7 +6561,7 @@ If given a numerical ARG, move forward ARG pages."
(defun gnus-article-goto-next-page ()
"Show the next page of the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(when (gnus-article-next-page)
(goto-char (point-min))
(gnus-article-read-summary-keys nil ?n)))
@@ -6553,7 +6569,7 @@ If given a numerical ARG, move forward ARG pages."
(defun gnus-article-goto-prev-page ()
"Show the previous page of the article."
- (interactive)
+ (interactive nil gnus-article-mode)
(if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
(gnus-article-read-summary-keys nil ?p)
(gnus-article-prev-page nil)))
@@ -6576,7 +6592,7 @@ If given a numerical ARG, move forward ARG pages."
"Show the next page of the current article.
If end of article, return non-nil. Otherwise return nil.
Argument LINES specifies lines to be scrolled up."
- (interactive "p")
+ (interactive "p" gnus-article-mode)
(move-to-window-line (- -1 scroll-margin))
(if (and (not (and gnus-article-over-scroll
(> (count-lines (window-start) (point-max))
@@ -6632,7 +6648,7 @@ specifies."
(defun gnus-article-prev-page (&optional lines)
"Show previous page of current article.
Argument LINES specifies lines to be scrolled down."
- (interactive "p")
+ (interactive "p" gnus-article-mode)
(move-to-window-line 0)
(if (and gnus-page-broken
(bobp)
@@ -6665,15 +6681,16 @@ not have a face in `gnus-article-boring-faces'."
(catch 'only-boring
(while (re-search-forward "\\b\\w\\w" nil t)
(forward-char -1)
- (when (not (gnus-intersection
+ (when (not (seq-intersection
(gnus-faces-at (point))
- (symbol-value 'gnus-article-boring-faces)))
+ (symbol-value 'gnus-article-boring-faces)
+ #'eq))
(throw 'only-boring nil)))
(throw 'only-boring t))))))
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(re-search-backward "[ \t]\\|^" (point-at-bol) t)
(re-search-forward "<?news:<?\\|<" (point-at-eol) t)
@@ -6685,7 +6702,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-show-summary ()
"Reconfigure windows to show summary buffer."
- (interactive)
+ (interactive nil gnus-article-mode)
(if (not (gnus-buffer-live-p gnus-summary-buffer))
(error "There is no summary buffer for this article buffer")
(gnus-article-set-globals)
@@ -6695,7 +6712,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-describe-briefly ()
"Describe article mode commands briefly."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-message 6 "%s" (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
(defun gnus-article-check-buffer ()
@@ -6707,7 +6724,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-read-summary-keys (&optional _arg key not-restore-window)
"Read a summary buffer key sequence and execute it from the article buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(gnus-article-check-buffer)
(let ((nosaves
'("q" "Q" "r" "m" "a" "f" "WDD" "WDW"
@@ -6818,7 +6835,7 @@ not have a face in `gnus-article-boring-faces'."
(ding))))))))
(defun gnus-article-read-summary-send-keys ()
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((unread-command-events (list ?S)))
(gnus-article-read-summary-keys)))
@@ -6826,7 +6843,8 @@ not have a face in `gnus-article-boring-faces'."
"Display documentation of the function invoked by KEY.
KEY is a string or a vector."
(interactive (list (let ((cursor-in-echo-area t))
- (read-key-sequence "Describe key: "))))
+ (read-key-sequence "Describe key: ")))
+ gnus-article-mode)
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
@@ -6848,7 +6866,8 @@ KEY is a string or a vector."
KEY is a string or a vector."
(interactive (list (let ((cursor-in-echo-area t))
(read-key-sequence "Describe key: "))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-article-mode)
(gnus-article-check-buffer)
(if (memq (key-binding key t) '(gnus-article-read-summary-keys
gnus-article-read-summary-send-keys))
@@ -6875,7 +6894,7 @@ KEY is a string or a vector."
"Show a list of all defined keys, and their definitions.
The optional argument PREFIX, if non-nil, should be a key sequence;
then we display only bindings that start with that prefix."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-article-check-buffer)
(let ((keymap (copy-keymap gnus-article-mode-map))
(map (copy-keymap gnus-article-send-map))
@@ -6884,7 +6903,7 @@ then we display only bindings that start with that prefix."
parent agent draft)
(define-key keymap "S" map)
(define-key map [t] nil)
- (define-key summap [t] 'undefined)
+ (define-key summap [t] #'undefined)
(with-current-buffer gnus-article-current-summary
(dolist (key sumkeys)
(define-key summap key (key-binding key (current-local-map))))
@@ -6920,10 +6939,11 @@ then we display only bindings that start with that prefix."
(setq-local gnus-agent-summary-mode agent)
(setq-local gnus-draft-mode draft)
(describe-bindings prefix))
- (let ((item `((lambda (prefix)
- (with-current-buffer ,(current-buffer)
- (gnus-article-describe-bindings prefix)))
- ,prefix)))
+ (let* ((cb (current-buffer))
+ (item `(,(lambda (prefix)
+ (with-current-buffer cb
+ (gnus-article-describe-bindings prefix)))
+ ,prefix)))
;; Loading `help-mode' here is necessary if `describe-bindings'
;; is replaced with something, e.g. `helm-descbinds'.
(require 'help-mode)
@@ -6934,7 +6954,7 @@ then we display only bindings that start with that prefix."
"Start composing a reply mail to the current message.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((article (cdr gnus-article-current))
contents)
(if (not (and transient-mark-mode mark-active))
@@ -6952,14 +6972,14 @@ the entire article will be yanked."
"Start composing a wide reply mail to the current message.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-article-reply-with-original t))
(defun gnus-article-followup-with-original ()
"Compose a followup to the current article.
The text in the region will be yanked. If the region isn't active,
the entire article will be yanked."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((article (cdr gnus-article-current))
contents)
(if (not (and transient-mark-mode mark-active))
@@ -6978,7 +6998,8 @@ the entire article will be yanked."
This means that signatures, cited text and (some) headers will be
hidden.
If given a prefix, show the hidden text instead."
- (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (interactive (append (gnus-article-hidden-arg) (list 'force))
+ gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(article-hide-headers arg)
(article-hide-list-identifiers)
@@ -7273,7 +7294,7 @@ This is an extended text-mode.
This will have permanent effect only in mail groups.
If FORCE is non-nil, allow editing of articles even in read-only
groups."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
@@ -7306,7 +7327,7 @@ groups."
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
(start (window-start))
@@ -7340,7 +7361,7 @@ groups."
(defun gnus-article-edit-exit ()
"Exit the article editing without updating."
- (interactive)
+ (interactive nil gnus-article-mode)
(when (or (not (buffer-modified-p))
(yes-or-no-p "Article modified; kill anyway? "))
(let ((curbuf (current-buffer))
@@ -7361,7 +7382,7 @@ groups."
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
- (interactive)
+ (interactive nil gnus-article-mode)
(save-excursion
(goto-char (point-min))
(search-forward-regexp "^$" nil t)
@@ -7879,7 +7900,7 @@ HEADER is a regexp to match a header. For a fuller explanation, see
"Check text under the mouse pointer for a callback function.
If the text under the mouse pointer has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
- (interactive "e")
+ (interactive "e" gnus-article-mode)
(set-buffer (window-buffer (posn-window (event-start event))))
(let* ((pos (posn-point (event-start event)))
(data (get-text-property pos 'gnus-data))
@@ -7892,7 +7913,7 @@ call it with the value of the `gnus-data' text property."
"Check text at point for a callback function.
If the text at point has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
- (interactive (list last-nonmenu-event))
+ (interactive (list last-nonmenu-event) gnus-article-mode)
(save-excursion
(when event
(mouse-set-point event))
@@ -7906,7 +7927,7 @@ This function calls `gnus-article-highlight-headers',
`gnus-article-highlight-citation',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode)
(gnus-article-highlight-headers)
(gnus-article-highlight-citation force)
(gnus-article-highlight-signature)
@@ -7918,14 +7939,14 @@ do the highlighting. See the documentation for those functions."
This function calls `gnus-article-highlight-headers',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode)
(gnus-article-highlight-headers)
(gnus-article-highlight-signature)
(gnus-article-add-buttons))
(defun gnus-article-highlight-headers ()
"Highlight article headers as specified by `gnus-header-face-alist'."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (regexp header-face field-face from hpoints fpoints)
(dolist (entry gnus-header-face-alist)
@@ -7959,7 +7980,7 @@ do the highlighting. See the documentation for those functions."
"Highlight the signature in an article.
It does this by highlighting everything after
`gnus-signature-separator' using the face `gnus-signature'."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t))
(save-restriction
@@ -7982,7 +8003,7 @@ It does this by highlighting everything after
"Find external references in the article and make buttons of them.
\"External references\" are things like Message-IDs and URLs, as
specified by `gnus-button-alist'."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(let ((inhibit-point-motion-hooks t)
(case-fold-search t)
@@ -8076,7 +8097,7 @@ url is put as the `gnus-button-url' overlay property on the button."
;; Add buttons to the head of an article.
(defun gnus-article-add-buttons-to-head ()
"Add buttons to the head of the article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(let (beg end)
(dolist (entry gnus-header-button-alist)
@@ -8124,7 +8145,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-article-copy-string ()
"Copy the string in the button to the kill ring."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-string)))
(when data
@@ -8240,7 +8261,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-button-patch (library line)
"Visit an Emacs Lisp library LIBRARY on line LINE."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((file (locate-library (file-name-nondirectory library))))
(unless file
(error "Couldn't find library %s" library))
@@ -8267,7 +8288,7 @@ url is put as the `gnus-button-url' overlay property on the button."
")" (gnus-url-unhex-string (match-string 2 url)))))
((string-match "([^)\"]+)[^\"]+" url)
(setq url
- (replace-regexp-in-string
+ (string-replace
"\"" "" (replace-regexp-in-string "[\n\t ]+" " " url)))
(gnus-info-find-node url))
(t (error "Can't parse %s" url))))
@@ -8403,14 +8424,14 @@ url is put as the `gnus-button-url' overlay property on the button."
(defvar gnus-prev-page-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'gnus-button-prev-page)
- (define-key map "\r" 'gnus-button-prev-page)
+ (define-key map [mouse-2] #'gnus-button-prev-page)
+ (define-key map "\r" #'gnus-button-prev-page)
map))
(defvar gnus-next-page-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'gnus-button-next-page)
- (define-key map "\r" 'gnus-button-next-page)
+ (define-key map [mouse-2] #'gnus-button-next-page)
+ (define-key map "\r" #'gnus-button-next-page)
map))
(defun gnus-insert-prev-page-button ()
@@ -8432,7 +8453,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-button-next-page (&optional _args _more-args)
"Go to the next page."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
@@ -8440,7 +8461,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-button-prev-page (&optional _args _more-args)
"Go to the prev page."
- (interactive)
+ (interactive nil gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
@@ -8464,7 +8485,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-article-button-next-page (_arg)
"Go to the next page."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-next-page)
@@ -8472,7 +8493,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-article-button-prev-page (_arg)
"Go to the prev page."
- (interactive "P")
+ (interactive "P" gnus-article-mode)
(let ((win (selected-window)))
(select-window (gnus-get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
@@ -8606,9 +8627,10 @@ For example:
(list
(or gnus-article-encrypt-protocol
(gnus-completing-read "Encrypt protocol"
- (mapcar #'car gnus-article-encrypt-protocol-alist)
- t))
- current-prefix-arg))
+ (mapcar #'car gnus-article-encrypt-protocol-alist)
+ t))
+ current-prefix-arg)
+ gnus-article-mode)
;; User might hit `K E' instead of `K e', so prompt once.
(when (and gnus-article-encrypt-protocol
gnus-novice-user)
@@ -8713,9 +8735,9 @@ For example:
(defvar gnus-mime-security-button-map
(let ((map (make-sparse-keymap)))
- (define-key map "\r" 'gnus-article-push-button)
- (define-key map [mouse-2] 'gnus-article-push-button)
- (define-key map [down-mouse-3] 'gnus-mime-security-button-menu)
+ (define-key map "\r" #'gnus-article-push-button)
+ (define-key map [mouse-2] #'gnus-article-push-button)
+ (define-key map [down-mouse-3] #'gnus-mime-security-button-menu)
(dolist (c gnus-mime-security-button-commands)
(define-key map (cadr c) (car c)))
map))
@@ -8732,7 +8754,7 @@ For example:
(defun gnus-mime-security-button-menu (event prefix)
"Construct a context-sensitive menu of security commands."
- (interactive "e\nP")
+ (interactive "e\nP" gnus-article-mode)
(save-window-excursion
(let ((pos (event-start event)))
(select-window (posn-window pos))
@@ -8889,12 +8911,12 @@ For example:
(defun gnus-mime-security-save-part ()
"Save the security part under point."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-mime-security-run-function 'mm-save-part))
(defun gnus-mime-security-pipe-part ()
"Pipe the security part under point to a process."
- (interactive)
+ (interactive nil gnus-article-mode)
(gnus-mime-security-run-function 'mm-pipe-part))
(provide 'gnus-art)
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index bc41d5b149d..8c2a928ab98 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -168,7 +168,7 @@ So the cdr of each bookmark is an alist too.")
;;;###autoload
(defun gnus-bookmark-set ()
"Set a bookmark for this article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-bookmark-maybe-load-default-file)
(if (or (not (derived-mode-p 'gnus-summary-mode))
(not gnus-article-current))
@@ -483,7 +483,7 @@ Gnus bookmarks names preceded by a \"*\" have annotations.
(defun gnus-bookmark-bmenu-toggle-infos (&optional show)
"Toggle whether details are shown in the Gnus bookmark list.
Optional argument SHOW means show them unconditionally."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(cond
(show
(setq gnus-bookmark-bmenu-toggle-infos nil)
@@ -649,14 +649,14 @@ reposition and try again, else return nil."
(defun gnus-bookmark-bmenu-show-details ()
"Show the annotation for the current bookmark in another window."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(let ((bookmark (gnus-bookmark-bmenu-bookmark)))
(if (gnus-bookmark-bmenu-check-position)
(gnus-bookmark-show-details bookmark))))
(defun gnus-bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-select]."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(beginning-of-line)
(if (gnus-bookmark-bmenu-check-position)
(let ((inhibit-read-only t))
@@ -668,7 +668,7 @@ reposition and try again, else return nil."
(defun gnus-bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
- (interactive "P")
+ (interactive "P" gnus-bookmark-bmenu-mode)
(beginning-of-line)
(if (gnus-bookmark-bmenu-check-position)
(progn
@@ -683,7 +683,7 @@ Optional BACKUP means move up."
(defun gnus-bookmark-bmenu-backup-unmark ()
"Move up and cancel all requested operations on bookmark on line above."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(forward-line -1)
(if (gnus-bookmark-bmenu-check-position)
(progn
@@ -695,7 +695,7 @@ Optional BACKUP means move up."
"Mark Gnus bookmark on this line to be deleted.
To carry out the deletions that you've marked, use
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(beginning-of-line)
(if (gnus-bookmark-bmenu-check-position)
(let ((inhibit-read-only t))
@@ -708,7 +708,7 @@ To carry out the deletions that you've marked, use
"Mark bookmark on this line to be deleted, then move up one line.
To carry out the deletions that you've marked, use
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(gnus-bookmark-bmenu-delete)
(forward-line -2)
(if (gnus-bookmark-bmenu-check-position)
@@ -720,7 +720,7 @@ To carry out the deletions that you've marked, use
You can mark bookmarks with the
\\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark]
command."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(if (gnus-bookmark-bmenu-check-position)
(let ((bmrk (gnus-bookmark-bmenu-bookmark))
(menu (current-buffer)))
@@ -730,13 +730,13 @@ command."
(bury-buffer menu))))
(defun gnus-bookmark-bmenu-select-by-mouse (event)
- (interactive "e")
+ (interactive "e" gnus-bookmark-bmenu-mode)
(mouse-set-point event)
(gnus-bookmark-bmenu-select))
(defun gnus-bookmark-bmenu-load ()
"Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(if (gnus-bookmark-bmenu-check-position)
(save-excursion
(save-window-excursion
@@ -745,7 +745,7 @@ command."
(defun gnus-bookmark-bmenu-execute-deletions ()
"Delete Gnus bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
- (interactive)
+ (interactive nil gnus-bookmark-bmenu-mode)
(message "Deleting Gnus bookmarks...")
(let ((hide-em gnus-bookmark-bmenu-toggle-infos)
(o-point (point))
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 5ed731947bc..34dba54c11d 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -342,7 +342,7 @@ it's not cached."
"Enter the next N articles into the cache.
If not given a prefix, use the process marked articles instead.
Returns the list of articles entered."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let (out)
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-remove-process-mark article)
@@ -363,7 +363,7 @@ Returns the list of articles entered."
"Remove the next N articles from the cache.
If not given a prefix, use the process marked articles instead.
Returns the list of articles removed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-cache-change-buffer gnus-newsgroup-name)
(let (out)
(dolist (article (gnus-summary-work-articles n))
@@ -388,7 +388,7 @@ Returns the list of articles removed."
(defun gnus-summary-insert-cached-articles ()
"Insert all the articles cached for this group into the current buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(cond
((not gnus-newsgroup-cached)
@@ -401,7 +401,7 @@ Returns the list of articles removed."
(defun gnus-summary-limit-include-cached ()
"Limit the summary buffer to articles that are cached."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if gnus-newsgroup-cached
(progn
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 96f1a7de5ec..34947cece89 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -335,7 +335,7 @@ lines matches `message-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
- (interactive (list 'force))
+ (interactive (list 'force) gnus-article-mode gnus-summary-mode)
(with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer)
(gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
@@ -459,7 +459,7 @@ frame width.
Sections that are heuristically interpreted as not being
text (i.e., computer code and the like) will not be folded."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
@@ -529,7 +529,8 @@ text (i.e., computer code and the like) will not be folded."
See the documentation for `gnus-article-highlight-citation'.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive (append (gnus-article-hidden-arg) (list 'force)))
+ (interactive (append (gnus-article-hidden-arg) (list 'force))
+ gnus-article-mode gnus-summary-mode)
(gnus-set-format 'cited-opened-text-button t)
(gnus-set-format 'cited-closed-text-button t)
(with-current-buffer gnus-article-buffer
@@ -661,7 +662,8 @@ percent and at least `gnus-cite-hide-absolute' lines of the body is
cited text with attributions. When called interactively, these two
variables are ignored.
See also the documentation for `gnus-article-highlight-citation'."
- (interactive (append (gnus-article-hidden-arg) '(force)))
+ (interactive (append (gnus-article-hidden-arg) '(force))
+ gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-delete-wash-type 'cite)
(unless (gnus-article-check-hidden-text 'cite arg)
@@ -689,7 +691,7 @@ See also the documentation for `gnus-article-highlight-citation'."
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(let ((article (cdr gnus-article-current)))
(unless (with-current-buffer gnus-summary-buffer
@@ -837,7 +839,7 @@ See also the documentation for `gnus-article-highlight-citation'."
(setq current (car loop)
loop (cdr loop))
(setcdr current
- (gnus-set-difference (cdr current) numbers)))))))))
+ (seq-difference (cdr current) numbers #'eq)))))))))
(defun gnus-cite-parse-attributions ()
(let (al-alist)
@@ -997,7 +999,7 @@ See also the documentation for `gnus-article-highlight-citation'."
loop (cdr loop))
(if (eq current best)
()
- (setcdr current (gnus-set-difference (cdr current) numbers))
+ (setcdr current (seq-difference (cdr current) numbers #'eq))
(when (null (cdr current))
(setq gnus-cite-loose-prefix-alist
(delq current gnus-cite-loose-prefix-alist)
@@ -1132,9 +1134,7 @@ Returns nil if there is no such line before LIMIT, t otherwise."
(define-minor-mode gnus-message-citation-mode
"Minor mode providing more font-lock support for nested citations.
When enabled, it automatically turns on `font-lock-mode'."
- nil ;; init-value
- "" ;; lighter
- nil ;; keymap
+ :lighter ""
(when (derived-mode-p 'message-mode)
;; FIXME: Use font-lock-add-keywords!
(let ((defaults (car font-lock-defaults))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index d8f48b19f87..e7af94ff509 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -337,7 +337,8 @@ category."))
(defun gnus-group-customize (group &optional topic)
"Edit the group or topic on the current line."
- (interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
+ (interactive (list (gnus-group-group-name) (gnus-group-topic-name))
+ gnus-group-mode)
(let (info
(types (mapcar (lambda (entry)
`(cons :format "%v%h\n"
@@ -485,7 +486,7 @@ form, but who cares?"
(defun gnus-group-customize-done (&rest _ignore)
"Apply changes and bury the buffer."
- (interactive)
+ (interactive nil gnus-custom-mode)
(let ((params (widget-value gnus-custom-params)))
(if gnus-custom-topic
(gnus-topic-set-parameters gnus-custom-topic params)
@@ -829,7 +830,7 @@ eh?")))
"Customize score file FILE.
When called interactively, FILE defaults to the current score file.
This can be changed using the `\\[gnus-score-change-score-file]' command."
- (interactive (list gnus-current-score-file))
+ (interactive (list gnus-current-score-file) gnus-summary-mode)
(unless file
(error "No score file for %s" gnus-newsgroup-name))
(let ((scores (gnus-score-load file))
@@ -1000,7 +1001,7 @@ articles in the thread.
(defun gnus-agent-customize-category (category)
"Edit the CATEGORY."
- (interactive (list (gnus-category-name)))
+ (interactive (list (gnus-category-name)) gnus-custom-mode)
(let ((info (assq category gnus-category-alist))
(defaults (list nil '(agent-predicate . false)
(cons 'agent-enable-expiration
@@ -1101,8 +1102,6 @@ articles in the thread.
(widget-setup)
(buffer-enable-undo))))
-;;; The End:
-
(provide 'gnus-cus)
;;; gnus-cus.el ends here
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 0cee01b9428..944fd9795a2 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -76,10 +76,10 @@ DELAY is a string, giving the length of the time. Possible values are:
The value of `message-draft-headers' determines which headers are
generated when the article is delayed. Remaining headers are
generated when the article is sent."
- (interactive
- (list (read-string
- "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): "
- gnus-delay-default-delay)))
+ (interactive (list (read-string
+ "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): "
+ gnus-delay-default-delay))
+ message-mode)
;; Allow spell checking etc.
(run-hooks 'message-send-hook)
(let (num unit year month day hour minute deadline) ;; days
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 52705640bf0..e2cbca9007d 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -32,11 +32,6 @@
;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is
;; now fully documented in the Gnus manual.
-
-;; Bugs / Todo:
-;; ===========
-
-
;;; Code:
(require 'nndiary)
@@ -214,7 +209,7 @@ There are currently two built-in format functions:
(defun gnus-summary-sort-by-schedule (&optional reverse)
"Sort nndiary summary buffers by schedule of appointments.
Optional prefix (or REVERSE argument) means sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'schedule reverse))
(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
@@ -322,7 +317,7 @@ This function checks that all NNDiary required headers are present and
valid, and prompts for values / correction otherwise.
If ARG (or prefix) is non-nil, force prompting for all fields."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(mapcar
(lambda (head)
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index ca2d57de7dc..af0b782202a 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -124,7 +124,8 @@ filenames."
(mapcar
;; don't attach directories
(lambda (f) (if (file-directory-p f) nil f))
- (nreverse (dired-map-over-marks (dired-get-filename) nil))))))
+ (nreverse (dired-map-over-marks (dired-get-filename) nil)))))
+ dired-mode)
(let ((destination nil)
(files-str nil)
(bufs nil))
@@ -178,7 +179,8 @@ filenames."
If ARG is non-nil, open it in a new buffer."
(interactive (list
(file-name-sans-versions (dired-get-filename) t)
- current-prefix-arg))
+ current-prefix-arg)
+ dired-mode)
(mailcap-parse-mailcaps)
(if (file-exists-p file-name)
(let (mime-type method)
@@ -216,7 +218,8 @@ that name. If PRINT-TO is a number, prompt the user for the name
of the file to save in."
(interactive (list
(file-name-sans-versions (dired-get-filename) t)
- (ps-print-preprint current-prefix-arg)))
+ (ps-print-preprint current-prefix-arg))
+ dired-mode)
(mailcap-parse-mailcaps)
(cond
((file-directory-p file-name)
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index f68e9d6b749..9a0f21359f8 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -71,7 +71,7 @@
(defun gnus-draft-toggle-sending (article)
"Toggle whether to send an article or not."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number)) gnus-summary-mode)
(if (gnus-draft-article-sendable-p article)
(progn
(push article gnus-newsgroup-unsendable)
@@ -83,7 +83,7 @@
(defun gnus-draft-edit-message ()
"Enter a mail/post buffer to edit and send the draft."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((article (gnus-summary-article-number))
(group gnus-newsgroup-name))
(gnus-draft-check-draft-articles (list article))
@@ -109,7 +109,7 @@
(defun gnus-draft-send-message (&optional n)
"Send the current draft(s).
Obeys the standard process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let* ((articles (gnus-summary-work-articles n))
(total (length articles))
article)
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 265edf4d612..3fd8bf51de4 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -104,7 +104,7 @@ The optional LAYOUT overrides the `edit-form' window layout."
(defun gnus-edit-form-done ()
"Update changes and kill the current buffer."
- (interactive)
+ (interactive nil gnus-edit-form-mode)
(goto-char (point-min))
(let ((form (condition-case nil
(read (current-buffer))
@@ -115,7 +115,7 @@ The optional LAYOUT overrides the `edit-form' window layout."
(defun gnus-edit-form-exit ()
"Kill the current buffer."
- (interactive)
+ (interactive nil gnus-edit-form-mode)
(let ((winconf gnus-prev-winconf))
(kill-buffer (current-buffer))
(set-window-configuration winconf)))
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index f69c2ed12c2..8bca4ffe38f 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -132,11 +132,12 @@ For instance, to insert an X-Face use `gnus-random-x-face' as FUN
Files matching `gnus-x-face-omit-files' are not considered."
(interactive)
- (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files
- (lambda (file)
- (gnus-shell-command-to-string
- (format gnus-convert-pbm-to-x-face-command
- (shell-quote-argument file))))))
+ (gnus--random-face-with-type
+ gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files
+ (lambda (file)
+ (gnus-shell-command-to-string
+ (format gnus-convert-pbm-to-x-face-command
+ (shell-quote-argument file))))))
;;;###autoload
(defun gnus-insert-random-x-face-header ()
@@ -205,12 +206,11 @@ different input formats."
(defun gnus-convert-face-to-png (face)
"Convert FACE (which is base64-encoded) to a PNG.
The PNG is returned as a string."
- (let ((face (gnus-base64-repad face nil nil t)))
- (mm-with-unibyte-buffer
- (insert face)
- (ignore-errors
- (base64-decode-region (point-min) (point-max)))
- (buffer-string))))
+ (mm-with-unibyte-buffer
+ (insert face)
+ (ignore-errors
+ (base64-decode-region (point-min) (point-max)))
+ (buffer-string)))
;;;###autoload
(defun gnus-convert-png-to-face (file)
@@ -231,8 +231,8 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to
Files matching `gnus-face-omit-files' are not considered."
(interactive)
(gnus--random-face-with-type gnus-face-directory "\\.png$"
- gnus-face-omit-files
- 'gnus-convert-png-to-face))
+ gnus-face-omit-files
+ 'gnus-convert-png-to-face))
;;;###autoload
(defun gnus-insert-random-face-header ()
@@ -277,7 +277,6 @@ colors of the displayed X-Faces."
(defun gnus-grab-cam-x-face ()
"Grab a picture off the camera and make it into an X-Face."
- (interactive)
(shell-command "xawtv-remote snap ppm")
(let ((file nil))
(while (null (setq file (directory-files "/tftpboot/sparky/tmp"
@@ -289,13 +288,11 @@ colors of the displayed X-Faces."
(format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>%s | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
file null-device)
(current-buffer))
- ;;(sleep-for 3)
(delete-file file)
(buffer-string))))
(defun gnus-grab-cam-face ()
"Grab a picture off the camera and make it into an X-Face."
- (interactive)
(shell-command "xawtv-remote snap ppm")
(let ((file nil)
(tempfile (make-temp-file "gnus-face-" nil ".ppm"))
@@ -312,7 +309,6 @@ colors of the displayed X-Faces."
(gnus-fun-ppm-change-string))))
(setq result (gnus-face-from-file tempfile)))
(delete-file file)
- ;;(delete-file tempfile) ; FIXME why are we not deleting it?!
result))
(defun gnus-fun-ppm-change-string ()
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 9ea9e100316..be57774fe96 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -125,7 +125,7 @@ callback for `gravatar-retrieve'."
(defun gnus-treat-from-gravatar (&optional force)
"Display gravatar in the From header.
If gravatar is already displayed, remove it."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (memq 'from-gravatar gnus-article-wash-types)
(gnus-delete-images 'from-gravatar)
@@ -135,7 +135,7 @@ If gravatar is already displayed, remove it."
(defun gnus-treat-mail-gravatar (&optional force)
"Display gravatars in the Cc and To headers.
If gravatars are already displayed, remove them."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (memq 'mail-gravatar gnus-article-wash-types)
(gnus-delete-images 'mail-gravatar)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index e8b62a4133e..b1134397e55 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -589,8 +589,8 @@ simple manner."
"\M-p" gnus-group-prev-unread-group-same-level
"," gnus-group-best-unread-group
"." gnus-group-first-unread-group
- "u" gnus-group-unsubscribe-current-group
- "U" gnus-group-unsubscribe-group
+ "u" gnus-group-toggle-subscription-at-point
+ "U" gnus-group-toggle-subscription
"c" gnus-group-catchup-current
"C" gnus-group-catchup-current-all
"\M-c" gnus-group-clear-data
@@ -767,8 +767,8 @@ simple manner."
(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
"l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
+ "t" gnus-group-toggle-subscription-at-point
+ "s" gnus-group-toggle-subscription
"k" gnus-group-kill-group
"y" gnus-group-yank-group
"w" gnus-group-kill-region
@@ -814,7 +814,7 @@ simple manner."
["Check for new articles " gnus-topic-get-new-news-this-topic
:included (gnus-topic-mode-p)
:help "Check for new messages in current group or topic"]
- ["Toggle subscription" gnus-group-unsubscribe-current-group
+ ["Toggle subscription" gnus-group-toggle-subscription-at-point
(gnus-group-group-name)]
["Kill" gnus-group-kill-group :active (gnus-group-group-name)
:help "Kill (remove) current group"]
@@ -894,20 +894,20 @@ simple manner."
["Sort by real name" gnus-group-sort-selected-groups-by-real-name
(not (gnus-topic-mode-p))])
("Mark"
- ["Mark group" gnus-group-mark-group
+ ["Toggle/Set mark" gnus-group-mark-group
(and (gnus-group-group-name)
(not (memq (gnus-group-group-name) gnus-group-marked)))]
- ["Unmark group" gnus-group-unmark-group
+ ["Remove mark" gnus-group-unmark-group
(and (gnus-group-group-name)
(memq (gnus-group-group-name) gnus-group-marked))]
- ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
- ["Mark regexp..." gnus-group-mark-regexp t]
+ ["Remove all marks" gnus-group-unmark-all-groups gnus-group-marked]
+ ["Mark by regexp..." gnus-group-mark-regexp t]
["Mark region" gnus-group-mark-region :active mark-active]
["Mark buffer" gnus-group-mark-buffer t]
["Execute command" gnus-group-universal-argument
(or gnus-group-marked (gnus-group-group-name))])
("Subscribe"
- ["Subscribe to a group..." gnus-group-unsubscribe-group t]
+ ["Toggle subscription..." gnus-group-toggle-subscription t]
["Kill all newsgroups in region" gnus-group-kill-region
:active mark-active]
["Kill all zombie groups" gnus-group-kill-all-zombies
@@ -1042,7 +1042,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
;; (gnus-group-find-new-groups "???" nil)
(gnus-group-save-newsrc "save")
(gnus-group-describe-group "describe")
- (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
+ (gnus-group-toggle-subscription-at-point "gnus/toggle-subscription")
(gnus-group-prev-unread-group "left-arrow")
(gnus-group-next-unread-group "right-arrow")
(gnus-group-exit "exit")
@@ -1119,7 +1119,7 @@ The group buffer lists (some of) the groups available. For instance,
lists all zombie groups.
Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
-to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
+to a group not displayed, type `\\[gnus-group-toggle-subscription]'.
For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
@@ -1160,7 +1160,7 @@ The following commands are available:
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
- (interactive "e")
+ (interactive "e" gnus-group-mode)
(mouse-set-point e)
(gnus-group-read-group nil))
@@ -1241,7 +1241,8 @@ Also see the `gnus-group-use-permanent-levels' variable."
(or
(gnus-group-default-level nil t)
(gnus-group-default-list-level)
- gnus-level-subscribed))))
+ gnus-level-subscribed)))
+ gnus-group-mode)
(unless level
(setq level (car gnus-group-list-mode)
unread (cdr gnus-group-list-mode)))
@@ -1292,7 +1293,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
(defun gnus-group-list-level (level &optional all)
"List groups on LEVEL.
If ALL (the prefix), also list groups that have no unread articles."
- (interactive "nList groups on level: \nP")
+ (interactive "nList groups on level: \nP" gnus-group-mode)
(gnus-group-list-groups level all level))
(defun gnus-group-prepare-logic (group test)
@@ -1864,9 +1865,9 @@ If FIRST-TOO, the current line is also eligible as a target."
(forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
(eq (char-after) gnus-process-mark)))
-(defun gnus-group-mark-group (n &optional unmark no-advance)
+(defun gnus-group-mark-group (n &optional unmark no-advance no-toggle)
"Mark the current group."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let ((buffer-read-only nil)
group)
(while (and (> n 0)
@@ -1876,28 +1877,38 @@ If FIRST-TOO, the current line is also eligible as a target."
(beginning-of-line)
(forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
(delete-char 1)
- (if unmark
- (progn
- (setq gnus-group-marked (delete group gnus-group-marked))
- (insert-char ?\s 1 t))
- (setq gnus-group-marked
- (cons group (delete group gnus-group-marked)))
- (insert-char gnus-process-mark 1 t)))
+ (if (and gnus-process-mark-toggle (not no-toggle))
+ (if (memq group gnus-group-marked)
+ (gnus-group-mark-update group t)
+ (gnus-group-mark-update group))
+ (gnus-group-mark-update group unmark)))
(unless no-advance
(gnus-group-next-group 1))
(cl-decf n))
(gnus-group-position-point)
n))
+(defun gnus-group-mark-update (n &optional unmark)
+ "Set the process mark on current group and update the group line."
+ (if unmark
+ (progn
+ (setq gnus-group-marked
+ (delete n gnus-group-marked))
+ (insert-char ?\s 1 t))
+ (progn
+ (setq gnus-group-marked
+ (cons n (delete n gnus-group-marked)))
+ (insert-char gnus-process-mark 1 t))))
+
(defun gnus-group-unmark-group (n)
"Remove the mark from the current group."
- (interactive "p")
- (gnus-group-mark-group n 'unmark)
+ (interactive "p" gnus-group-mode)
+ (gnus-group-mark-group n 'unmark nil t)
(gnus-group-position-point))
(defun gnus-group-unmark-all-groups ()
"Unmark all groups."
- (interactive)
+ (interactive nil gnus-group-mode)
(save-excursion
(mapc #'gnus-group-remove-mark gnus-group-marked))
(gnus-group-position-point))
@@ -1905,21 +1916,21 @@ If FIRST-TOO, the current line is also eligible as a target."
(defun gnus-group-mark-region (unmark beg end)
"Mark all groups between point and mark.
If UNMARK, remove the mark instead."
- (interactive "P\nr")
+ (interactive "P\nr" gnus-group-mode)
(let ((num (count-lines beg end)))
(save-excursion
(goto-char beg)
- (- num (gnus-group-mark-group num unmark)))))
+ (- num (gnus-group-mark-group num unmark nil t)))))
(defun gnus-group-mark-buffer (&optional unmark)
"Mark all groups in the buffer.
If UNMARK, remove the mark instead."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-mark-region unmark (point-min) (point-max)))
(defun gnus-group-mark-regexp (regexp)
"Mark all groups that match some regexp."
- (interactive "sMark (regexp): ")
+ (interactive "sMark (regexp): " gnus-group-mode)
(let ((alist (cdr gnus-newsrc-alist))
group)
(save-excursion
@@ -1934,7 +1945,7 @@ If UNMARK, remove the mark instead."
Return nil if the group isn't displayed."
(if (gnus-group-goto-group group nil test-marked)
(save-excursion
- (gnus-group-mark-group 1 'unmark t)
+ (gnus-group-mark-group 1 'unmark t t)
t)
(setq gnus-group-marked
(delete group gnus-group-marked))
@@ -1944,7 +1955,7 @@ Return nil if the group isn't displayed."
"Set the process mark on GROUP."
(if (gnus-group-goto-group group)
(save-excursion
- (gnus-group-mark-group 1 nil t))
+ (gnus-group-mark-group 1 nil t t))
(setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
(defun gnus-group-universal-argument (arg &optional _groups func)
@@ -2028,7 +2039,7 @@ number of the earliest articles in the group.
If the optional argument NO-ARTICLE is non-nil, no article will
be auto-selected upon group entry. If GROUP is non-nil, fetch
that group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((no-display (eq all 0))
(group (or group (gnus-group-group-name)))
number active marked entry)
@@ -2062,7 +2073,7 @@ If ALL is a positive number, fetch this number of the latest
articles in the group.
If ALL is a negative number, fetch this number of the earliest
articles in the group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
(gnus-group-read-group all t))
@@ -2081,7 +2092,7 @@ buffer. If GROUP is nil, use current group.
This might be useful if you want to toggle threading
before entering the group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(require 'gnus-score)
(let (gnus-visual
gnus-score-find-score-files-function
@@ -2092,7 +2103,7 @@ before entering the group."
(defun gnus-group-visible-select-group (&optional all)
"Select the current group without hiding any articles."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((gnus-inhibit-limiting t))
(gnus-group-read-group all t)))
@@ -2101,7 +2112,7 @@ before entering the group."
You will actually be entered into a group that's a copy of
the current group; no changes you make while in this group will
be permanent."
- (interactive)
+ (interactive nil gnus-group-mode)
(require 'gnus-score)
(let* (gnus-visual
gnus-score-find-score-files-function gnus-apply-kill-hook
@@ -2175,7 +2186,7 @@ handle COLLECTION as a list, hash table, or vector."
require-match initial-input
(or hist 'gnus-group-history)
def)))
- (replace-regexp-in-string "\n" "" group)))
+ (string-replace "\n" "" group)))
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
@@ -2333,7 +2344,8 @@ specified by `gnus-gmane-group-download-format'."
(list
(gnus-group-completing-read "Gmane group")
(read-number "Start article number: ")
- (read-number "How many articles: ")))
+ (read-number "How many articles: "))
+ gnus-group-mode)
(unless range (setq range 500))
(when (< range 1)
(error "Invalid range: %s" range))
@@ -2367,8 +2379,7 @@ Valid input formats include:
;; - The URLs should be added to `gnus-button-alist'. Probably we should
;; prompt the user to decide: "View via `browse-url' or in Gnus? "
;; (`gnus-read-ephemeral-gmane-group-url')
- (interactive
- (list (gnus-group-completing-read "Gmane URL")))
+ (interactive (list (gnus-group-completing-read "Gmane URL")) gnus-group-mode)
(let (group start range)
(cond
;; URLs providing `group', `start' and `range':
@@ -2461,7 +2472,8 @@ the ephemeral group."
(with-temp-file tmpfile
(mm-disable-multibyte)
(dolist (id ids)
- (let ((file (concat "~/.emacs.d/debbugs-cache/" id)))
+ (let ((file (expand-file-name id (locate-user-emacs-file
+ "debbugs-cache"))))
(if (and (not gnus-plugged)
(file-exists-p file))
(insert-file-contents file)
@@ -2543,7 +2555,8 @@ If PROMPT (the prefix) is a number, use the prompt specified in
(or (and (stringp gnus-group-jump-to-group-prompt)
gnus-group-jump-to-group-prompt)
(let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
- (and (stringp p) p)))))))
+ (and (stringp p) p))))))
+ gnus-group-mode)
(when (equal group "")
(error "Empty group name"))
@@ -2612,7 +2625,7 @@ Return nil if GROUP is not found."
If N is negative, search backward instead.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group n t nil silent))
(defun gnus-group-next-unread-group (n &optional all level silent)
@@ -2624,7 +2637,7 @@ such group can be found, the next group with a level higher than
LEVEL.
Returns the difference between N and the number of skips actually
made."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -2641,14 +2654,14 @@ made."
"Go to previous N'th newsgroup.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group (- n) t))
(defun gnus-group-prev-unread-group (n)
"Go to previous N'th unread newsgroup.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group (- n)))
(defun gnus-group-next-unread-group-same-level (n)
@@ -2656,7 +2669,7 @@ done."
If N is negative, search backward instead.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group n t (gnus-group-group-level))
(gnus-group-position-point))
@@ -2664,14 +2677,14 @@ done."
"Go to next N'th unread newsgroup on the same level.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(gnus-group-next-unread-group (- n) t (gnus-group-group-level))
(gnus-group-position-point))
(defun gnus-group-best-unread-group (&optional exclude-group)
"Go to the group with the highest level.
If EXCLUDE-GROUP, do not go to that group."
- (interactive)
+ (interactive nil gnus-group-mode)
(goto-char (point-min))
(let ((best 100000)
unread best-point)
@@ -2711,7 +2724,7 @@ If EXCLUDE-GROUP, do not go to that group."
(defun gnus-group-first-unread-group ()
"Go to the first group with unread articles."
- (interactive)
+ (interactive nil gnus-group-mode)
(prog1
(let ((opoint (point))
unread)
@@ -2727,13 +2740,13 @@ If EXCLUDE-GROUP, do not go to that group."
(defun gnus-group-enter-server-mode ()
"Jump to the server buffer."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-enter-server-buffer))
(defun gnus-group-make-group-simple (&optional group)
"Add a new newsgroup.
The user will be prompted for GROUP."
- (interactive (list (gnus-group-completing-read)))
+ (interactive (list (gnus-group-completing-read)) gnus-group-mode)
(gnus-group-make-group (gnus-group-real-name group)
(gnus-group-server group)
nil nil))
@@ -2749,7 +2762,8 @@ server."
(interactive
(list
(gnus-read-group "Group name: ")
- (gnus-read-method "Select method for new group (use tab for completion)")))
+ (gnus-read-method "Select method for new group (use tab for completion)"))
+ gnus-group-mode)
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
@@ -2794,7 +2808,7 @@ server."
(defun gnus-group-delete-groups (&optional arg)
"Delete the current group. Only meaningful with editable groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((n (length (gnus-group-process-prefix arg))))
(when (gnus-yes-or-no-p
(if (= n 1)
@@ -2809,8 +2823,8 @@ server."
If OLDP (the prefix), only delete articles that are \"old\",
according to the expiry settings. Note that this will delete old
not-expirable articles, too."
- (interactive (list (gnus-group-group-name)
- current-prefix-arg))
+ (interactive (list (gnus-group-group-name) current-prefix-arg)
+ gnus-group-mode)
(let ((articles (gnus-uncompress-range (gnus-active group))))
(when (gnus-yes-or-no-p
(format "Do you really want to delete these %d articles forever? "
@@ -2829,9 +2843,8 @@ doing the deletion.
Note that you also have to specify FORCE if you want the group to
be removed from the server, even when it's empty."
- (interactive
- (list (gnus-group-group-name)
- current-prefix-arg))
+ (interactive (list (gnus-group-group-name) current-prefix-arg)
+ gnus-group-mode)
(unless group
(error "No group to delete"))
(unless (gnus-check-backend-function 'request-delete-group group)
@@ -2865,7 +2878,8 @@ and NEW-NAME will be prompted for."
"Rename group to: "
(gnus-group-real-name group))
method (gnus-info-method (gnus-get-info group)))
- (list group (gnus-group-prefixed-name new-name method))))
+ (list group (gnus-group-prefixed-name new-name method)))
+ gnus-group-mode)
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This back end does not support renaming groups"))
@@ -2911,7 +2925,7 @@ and NEW-NAME will be prompted for."
(defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(let ((part (or part 'info))
info)
(unless group
@@ -2950,12 +2964,12 @@ and NEW-NAME will be prompted for."
(defun gnus-group-edit-group-method (group)
"Edit the select method of GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(gnus-group-edit-group group 'method))
(defun gnus-group-edit-group-parameters (group)
"Edit the group parameters of GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(gnus-group-edit-group group 'params))
(defun gnus-group-edit-group-done (part group form)
@@ -2993,14 +3007,16 @@ and NEW-NAME will be prompted for."
(defun gnus-group-make-useful-group (group method)
"Create one of the groups described in `gnus-useful-groups'."
(interactive
- (let ((entry (assoc (gnus-completing-read "Create group"
- (mapcar #'car gnus-useful-groups)
- t)
+ (let ((entry (assoc (gnus-completing-read
+ "Create group"
+ (mapcar #'car gnus-useful-groups)
+ t)
gnus-useful-groups)))
(list (cadr entry)
- ;; Don't use `caddr' here since macros within the `interactive'
- ;; form won't be expanded.
- (car (cddr entry)))))
+ ;; Don't use `caddr' here since macros within the
+ ;; `interactive' form won't be expanded.
+ (car (cddr entry))))
+ gnus-group-mode)
(setq method (copy-tree method))
(let (entry)
(while (setq entry (memq (assq 'eval method) method))
@@ -3014,7 +3030,7 @@ group already exists:
- if not given, and error is signaled,
- if t, stay silent,
- if anything else, just print a message."
- (interactive)
+ (interactive nil gnus-group-mode)
(let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
(file (nnheader-find-etc-directory "gnus-tut.txt" t)))
(if (gnus-group-entry name)
@@ -3040,9 +3056,9 @@ group already exists:
"Create a group that uses a single file as the source.
If called with a prefix argument, ask for the file type."
- (interactive
- (list (read-file-name "File name: ")
- (and current-prefix-arg 'ask)))
+ (interactive (list (read-file-name "File name: ")
+ (and current-prefix-arg 'ask))
+ gnus-group-mode)
(when (eq type 'ask)
(let ((err "")
char found)
@@ -3077,7 +3093,7 @@ If called with a prefix argument, ask for the file type."
(defun gnus-group-make-web-group (&optional solid)
"Create an ephemeral nnweb group.
If SOLID (the prefix), create a solid group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(require 'nnweb)
(let* ((group
(if solid (gnus-read-group "Group name: ")
@@ -3117,7 +3133,7 @@ If SOLID (the prefix), create a solid group."
(defun gnus-group-make-rss-group (&optional url)
"Given a URL, discover if there is an RSS feed.
If there is, use Gnus to create an nnrss group"
- (interactive)
+ (interactive nil gnus-group-mode)
(require 'nnrss)
(if (not url)
(setq url (read-from-minibuffer "URL to Search for RSS: ")))
@@ -3158,8 +3174,8 @@ If there is, use Gnus to create an nnrss group"
The user will be prompted for a directory. The contents of this
directory will be used as a newsgroup. The directory should contain
mail messages or news articles in files that have numeric names."
- (interactive
- (list (read-directory-name "Create group from directory: ")))
+ (interactive (list (read-directory-name "Create group from directory: "))
+ gnus-group-mode)
(unless (file-exists-p dir)
(error "No such directory"))
(unless (file-directory-p dir)
@@ -3192,7 +3208,7 @@ prefix arg NO-PARSE means that Gnus should not parse the search
query before passing it to the underlying search engine. A
non-nil SPECS arg must be an alist with `search-query-spec' and
`search-group-spec' keys, and skips all prompting."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((name (gnus-read-group "Group name: ")))
(with-current-buffer gnus-group-buffer
(let* ((group-spec
@@ -3246,7 +3262,7 @@ prefix arg NO-PARSE means that Gnus should not parse the search
query before passing it to the underlying search engine. A
non-nil SPECS arg must be an alist with `search-query-spec' and
`search-group-spec' keys, and skips all prompting."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let* ((group-spec
(or (cdr (assq 'search-group-spec specs))
(cdr (assq 'nnir-group-spec specs))
@@ -3286,10 +3302,10 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
- (interactive
- (list current-prefix-arg
- (gnus-group-completing-read "Add to virtual group"
- nil t "nnvirtual:")))
+ (interactive (list current-prefix-arg
+ (gnus-group-completing-read "Add to virtual group"
+ nil t "nnvirtual:"))
+ gnus-group-mode)
(unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
(error "%s is not an nnvirtual group" vgroup))
(gnus-close-group vgroup)
@@ -3307,7 +3323,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(defun gnus-group-make-empty-virtual (group)
"Create a new, fresh, empty virtual group."
- (interactive "sCreate new, empty virtual group: ")
+ (interactive "sCreate new, empty virtual group: " gnus-group-mode)
(let* ((method (list 'nnvirtual "^$"))
(pgroup (gnus-group-prefixed-name group method)))
;; Check whether it exists already.
@@ -3321,7 +3337,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(defun gnus-group-enter-directory (dir)
"Enter an ephemeral nneething group."
- (interactive "DDirectory to read: ")
+ (interactive "DDirectory to read: " gnus-group-mode)
(let* ((method (list 'nneething dir '(nneething-read-only t)))
(leaf (gnus-group-prefixed-name
(file-name-nondirectory (directory-file-name dir))
@@ -3336,7 +3352,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(defun gnus-group-expunge-group (group)
"Expunge deleted articles in current nnimap GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(let ((method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-expunge-group (car method)))
@@ -3348,7 +3364,7 @@ non-nil SPECS arg must be an alist with `search-query-spec' and
(defun gnus-group-nnimap-edit-acl (group)
"Edit the Access Control List of current nnimap GROUP."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(let ((mailbox (gnus-group-real-name group)) method acl)
(unless group
(error "No group on current line"))
@@ -3395,7 +3411,8 @@ Editing the access control list for `%s'.
When used interactively, the sorting function used will be
determined by the `gnus-group-sort-function' variable.
If REVERSE (the prefix), reverse the sorting order."
- (interactive (list gnus-group-sort-function current-prefix-arg))
+ (interactive (list gnus-group-sort-function current-prefix-arg)
+ gnus-group-mode)
(funcall gnus-group-sort-alist-function
(gnus-make-sort-function func) reverse)
(gnus-group-unmark-all-groups)
@@ -3428,56 +3445,57 @@ value is disregarded."
(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
"Sort the group buffer alphabetically by group name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
(defun gnus-group-sort-groups-by-real-name (&optional reverse)
"Sort the group buffer alphabetically by real (unprefixed) group name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
(defun gnus-group-sort-groups-by-unread (&optional reverse)
"Sort the group buffer by number of unread articles.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
(defun gnus-group-sort-groups-by-level (&optional reverse)
"Sort the group buffer by group level.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
(defun gnus-group-sort-groups-by-score (&optional reverse)
"Sort the group buffer by group score.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
(defun gnus-group-sort-groups-by-rank (&optional reverse)
"Sort the group buffer by group rank.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
(defun gnus-group-sort-groups-by-method (&optional reverse)
"Sort the group buffer alphabetically by back end name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
(defun gnus-group-sort-groups-by-server (&optional reverse)
"Sort the group buffer alphabetically by server name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
;;; Selected group sorting.
(defun gnus-group-sort-selected-groups (n func &optional reverse)
"Sort the process/prefixed groups."
- (interactive (list current-prefix-arg gnus-group-sort-function))
+ (interactive (list current-prefix-arg gnus-group-sort-function)
+ gnus-group-mode)
(let ((groups (gnus-group-process-prefix n)))
(funcall gnus-group-sort-selected-function
groups (gnus-make-sort-function func) reverse)
@@ -3509,49 +3527,49 @@ If REVERSE is non-nil, reverse the sorting."
"Sort the group buffer alphabetically by group name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
"Sort the group buffer alphabetically by real group name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
"Sort the group buffer by number of unread articles.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
(defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
"Sort the group buffer by group level.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
(defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
"Sort the group buffer by group score.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
"Sort the group buffer by group rank.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
"Sort the group buffer alphabetically by back end name.
Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-group-mode)
(gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
;;; Sorting predicates.
@@ -3609,7 +3627,7 @@ sort in reverse order."
(defun gnus-group-clear-data (&optional arg)
"Clear all marks and read ranges from the current group.
Obeys the process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when (gnus-y-or-n-p "Really clear data? ")
(gnus-group-iterate arg
(lambda (group)
@@ -3621,7 +3639,7 @@ Obeys the process/prefix convention."
(defun gnus-group-clear-data-on-native-groups ()
"Clear all marks and read ranges from all native groups."
- (interactive)
+ (interactive nil gnus-group-mode)
(when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
(let ((alist (cdr gnus-newsrc-alist))
info)
@@ -3665,7 +3683,7 @@ caught up. If ALL is non-nil, marked articles will also be marked as
read. Cross references (Xref: header) of articles are ignored.
The number of newsgroups that this function was unable to catch
up is returned."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((groups (gnus-group-process-prefix n))
(ret 0)
group)
@@ -3704,7 +3722,7 @@ up is returned."
(defun gnus-group-catchup-current-all (&optional n)
"Mark all articles in current newsgroup as read.
Cross references (Xref: header) of articles are ignored."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-catchup-current n 'all))
(declare-function gnus-sequence-of-unread-articles "gnus-sum" (group))
@@ -3751,7 +3769,7 @@ or nil if no action could be taken."
(defun gnus-group-expire-articles (&optional n)
"Expire all expirable articles in the current newsgroup.
Uses the process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((groups (gnus-group-process-prefix n))
group)
(unless groups
@@ -3797,7 +3815,7 @@ Uses the process/prefix convention."
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
- (interactive)
+ (interactive nil gnus-group-mode)
(save-excursion
(gnus-message 5 "Expiring...")
(let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
@@ -3821,7 +3839,8 @@ Uses the process/prefix convention."
(if (string-match "^\\s-*$" s)
(int-to-string (or (gnus-group-group-level)
gnus-level-default-subscribed))
- s))))))
+ s)))))
+ gnus-group-mode)
(unless (and (>= level 1) (<= level gnus-level-killed))
(error "Invalid level: %d" level))
(dolist (group (gnus-group-process-prefix n))
@@ -3837,61 +3856,91 @@ Uses the process/prefix convention."
(defun gnus-group-unsubscribe (&optional n)
"Unsubscribe the current group."
- (interactive "P")
- (gnus-group-unsubscribe-current-group n 'unsubscribe))
+ (interactive "P" gnus-group-mode)
+ (gnus-group-set-subscription-at-point n 'unsubscribe))
(defun gnus-group-subscribe (&optional n)
"Subscribe the current group."
- (interactive "P")
- (gnus-group-unsubscribe-current-group n 'subscribe))
+ (interactive "P" gnus-group-mode)
+ (gnus-group-set-subscription-at-point n 'subscribe))
+
+(defsubst gnus-group-unsubscribe-current-group (&optional n do-sub)
+ (if do-sub
+ (gnus-group-set-subscription-at-point n do-sub)
+ (gnus-group-toggle-subscription-at-point n)))
+
+(defsubst gnus-group-unsubscribe-group (group &optional level silent)
+ (if level
+ (gnus-group-set-subscription group level silent)
+ (gnus-group-toggle-subscription group silent)))
+
+(make-obsolete 'gnus-group-unsubscribe-current-group
+ 'gnus-group-toggle-subscription-at-point "28.1")
-(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
+(make-obsolete 'gnus-group-unsubscribe-group
+ 'gnus-group-toggle-subscription "28.1")
+
+(defun gnus-group-toggle-subscription-at-point (&optional n)
"Toggle subscription of the current group.
If given numerical prefix, toggle the N next groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
+ (gnus-group-set-subscription-at-point n 'toggle))
+
+(defun gnus-group-set-subscription-at-point (n do-sub)
+ "Set subscription of the current group for next N groups."
(dolist (group (gnus-group-process-prefix n))
(gnus-group-remove-mark group)
- (gnus-group-unsubscribe-group
+ (gnus-group-set-subscription
group
- (cond
- ((eq do-sub 'unsubscribe)
- gnus-level-default-unsubscribed)
- ((eq do-sub 'subscribe)
- gnus-level-default-subscribed)
- ((<= (gnus-group-group-level) gnus-level-subscribed)
- gnus-level-default-unsubscribed)
- (t
- gnus-level-default-subscribed))
+ (cl-case do-sub
+ (unsubscribe gnus-level-default-unsubscribed)
+ (subscribe gnus-level-default-subscribed)
+ (toggle (if (<= (gnus-group-group-level) gnus-level-subscribed)
+ gnus-level-default-unsubscribed
+ gnus-level-default-subscribed))
+ (t (error "Unknown subscription setting %s" do-sub)))
t)
(gnus-group-update-group-line))
(gnus-group-next-group 1))
-(defun gnus-group-unsubscribe-group (group &optional level silent)
- "Toggle subscription to GROUP.
+(defun gnus-group-toggle-subscription (group &optional silent)
+ (interactive (list (gnus-group-completing-read
+ nil nil (gnus-read-active-file-p)))
+ gnus-group-mode)
+ (let* ((newsrc (gnus-group-entry group))
+ (level (cond
+ (newsrc
+ ;; Toggle subscription flag.
+ (if (<= (gnus-info-level (nth 1 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed))
+ ((and (stringp group)
+ (or (not (gnus-read-active-file-p))
+ (gnus-active group)))
+ ;; Add new newsgroup.
+ gnus-level-default-subscribed)
+ (t 'unsubscribe))))
+ (gnus-group-set-subscription group level silent)))
+
+(defun gnus-group-set-subscription (group level &optional silent)
+ "Set subscription of GROUP to LEVEL.
Killed newsgroups are subscribed. If SILENT, don't try to update the
group line."
- (interactive (list (gnus-group-completing-read
- nil nil (gnus-read-active-file-p))))
(let ((newsrc (gnus-group-entry group)))
(cond
((string-match "\\`[ \t]*\\'" group)
(error "Empty group name"))
(newsrc
- ;; Toggle subscription flag.
- (gnus-group-change-level
- newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
+ (gnus-group-change-level newsrc level)
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
(or (not (gnus-read-active-file-p))
(gnus-active group)))
- ;; Add new newsgroup.
(gnus-group-change-level
group
- (or level gnus-level-default-subscribed)
+ level
(or (and (member group gnus-zombie-list)
gnus-level-zombie)
gnus-level-killed)
@@ -3905,7 +3954,7 @@ group line."
"Move the current newsgroup up N places.
If given a negative prefix, move down instead. The difference between
N and the number of steps taken is returned."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(unless (gnus-group-group-name)
(error "No group on current line"))
(gnus-group-kill-group 1)
@@ -3917,7 +3966,8 @@ N and the number of steps taken is returned."
(defun gnus-group-kill-all-zombies (&optional dummy)
"Kill all zombie newsgroups.
The optional DUMMY should always be nil."
- (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
+ (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? ")))
+ gnus-group-mode)
(unless dummy
(setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
(setq gnus-zombie-list nil)
@@ -3927,7 +3977,7 @@ The optional DUMMY should always be nil."
(defun gnus-group-kill-region (begin end)
"Kill newsgroups in current region (excluding current point).
The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
- (interactive "r")
+ (interactive "r" gnus-group-mode)
(let ((lines
;; Count lines.
(save-excursion
@@ -3949,7 +3999,7 @@ However, only groups that were alive can be yanked; already killed
groups or zombie groups can't be yanked.
The return value is the name of the group that was killed, or a list
of groups killed."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((buffer-read-only nil)
(groups (gnus-group-process-prefix n))
group entry level out)
@@ -4009,7 +4059,7 @@ of groups killed."
The numeric ARG specifies how many newsgroups are to be yanked. The
name of the newsgroup yanked is returned, or (if several groups are
yanked) a list of yanked groups is returned."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(setq arg (or arg 1))
(let (info group prev out)
(while (>= (cl-decf arg) 0)
@@ -4034,7 +4084,7 @@ yanked) a list of yanked groups is returned."
(defun gnus-group-kill-level (level)
"Kill all groups that is on a certain LEVEL."
- (interactive "nKill all groups on level: ")
+ (interactive "nKill all groups on level: " gnus-group-mode)
(cond
((= level gnus-level-zombie)
(setq gnus-killed-list
@@ -4065,7 +4115,7 @@ yanked) a list of yanked groups is returned."
"List all newsgroups with level ARG or lower.
Default is `gnus-level-unsubscribed', which lists all subscribed and most
unsubscribed groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
;; Redefine this to list ALL killed groups if prefix arg used.
@@ -4074,7 +4124,7 @@ unsubscribed groups."
"List all killed newsgroups in the group buffer.
If ARG is non-nil, list ALL killed groups known to Gnus. This may
entail asking the server for the groups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
;; Find all possible killed newsgroups if arg.
(when arg
(gnus-get-killed-groups))
@@ -4088,7 +4138,7 @@ entail asking the server for the groups."
(defun gnus-group-list-zombies ()
"List all zombie newsgroups in the group buffer."
- (interactive)
+ (interactive nil gnus-group-mode)
(if (not gnus-zombie-list)
(gnus-message 6 "No zombie groups")
(let (gnus-group-list-mode)
@@ -4099,7 +4149,7 @@ entail asking the server for the groups."
(defun gnus-group-list-active ()
"List all groups that are available from the server(s)."
- (interactive)
+ (interactive nil gnus-group-mode)
;; First we make sure that we have really read the active file.
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t)
@@ -4121,7 +4171,7 @@ entail asking the server for the groups."
(defun gnus-activate-all-groups (level)
"Activate absolutely all groups."
- (interactive (list gnus-level-unsubscribed))
+ (interactive (list gnus-level-unsubscribed) gnus-group-mode)
(let ((gnus-activate-level level)
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
@@ -4133,7 +4183,7 @@ re-scanning. If ARG is non-nil and not a number, this will force
\"hard\" re-reading of the active files from all servers.
If ONE-LEVEL is not nil, then re-scan only the specified level,
otherwise all levels below ARG will be scanned too."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(require 'nnmail)
(let ((gnus-inhibit-demon t)
;; Binding this variable will inhibit multiple fetchings
@@ -4163,7 +4213,7 @@ otherwise all levels below ARG will be scanned too."
The difference between N and the number of newsgroup checked is returned.
If N is negative, this group and the N-1 previous groups will be checked.
If DONT-SCAN is non-nil, scan non-activated groups as well."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))
(beg (unless n
@@ -4208,7 +4258,8 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
- (interactive (list current-prefix-arg (gnus-group-group-name)))
+ (interactive (list current-prefix-arg (gnus-group-group-name))
+ gnus-group-mode)
(let* ((method (gnus-find-method-for-group group))
(mname (gnus-group-prefixed-name "" method))
desc)
@@ -4230,7 +4281,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-group-describe-all-groups (&optional force)
"Pop up a buffer with descriptions of all newsgroups."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when force
(setq gnus-description-hashtb nil))
(when (not (or gnus-description-hashtb
@@ -4255,7 +4306,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defun gnus-group-apropos (regexp &optional search-description)
"List all newsgroups that have names that match a regexp."
- (interactive "sGnus apropos (regexp): ")
+ (interactive "sGnus apropos (regexp): " gnus-group-mode)
(let ((prev "")
(obuf (current-buffer))
groups des)
@@ -4294,7 +4345,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(defun gnus-group-description-apropos (regexp)
"List all newsgroups that have names or descriptions that match REGEXP."
- (interactive "sGnus description apropos (regexp): ")
+ (interactive "sGnus description apropos (regexp): " gnus-group-mode)
(when (not (or gnus-description-hashtb
(gnus-read-all-descriptions-files)))
(error "Couldn't request descriptions file"))
@@ -4309,7 +4360,7 @@ If ALL, also list groups with no unread articles.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P\nsList newsgroups matching: ")
+ (interactive "P\nsList newsgroups matching: " gnus-group-mode)
;; First make sure active file has been read.
(when (and level
(> (prefix-numeric-value level) gnus-level-killed))
@@ -4324,7 +4375,7 @@ This command may read the active file."
If the prefix LEVEL is non-nil, it should be a number that says which
level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST."
- (interactive "P\nsList newsgroups matching: ")
+ (interactive "P\nsList newsgroups matching: " gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
@@ -4333,12 +4384,12 @@ If LOWEST, don't list groups with level lower than LOWEST."
(defun gnus-group-save-newsrc (&optional force)
"Save the Gnus startup files.
If FORCE, force saving whether it is necessary or not."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-save-newsrc-file force))
(defun gnus-group-restart (&optional _arg)
"Force Gnus to read the .newsrc file."
- (interactive)
+ (interactive nil gnus-group-mode)
(when (gnus-yes-or-no-p
(format "Are you sure you want to restart Gnus? "))
(gnus-save-newsrc-file)
@@ -4347,7 +4398,7 @@ If FORCE, force saving whether it is necessary or not."
(defun gnus-group-read-init-file ()
"Read the Gnus elisp init file."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-read-init-file)
(gnus-message 5 "Read %s" gnus-init-file))
@@ -4355,7 +4406,7 @@ If FORCE, force saving whether it is necessary or not."
"Check bogus newsgroups.
If given a prefix, don't ask for confirmation before removing a bogus
group."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
(gnus-group-list-groups))
@@ -4366,7 +4417,7 @@ With 1 C-u, use the `ask-server' method to query the server for new
groups.
With 2 C-u's, use most complete method possible to query the server
for new groups, and subscribe the new groups as zombies."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let ((new-groups (gnus-find-new-newsgroups (or arg 1)))
current-group)
(gnus-group-list-groups)
@@ -4379,7 +4430,7 @@ for new groups, and subscribe the new groups as zombies."
(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
If GROUP, edit that local kill file instead."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(setq gnus-current-kill-article article)
(gnus-kill-file-edit-file group)
(gnus-message 6 "Editing a %s kill file (Type %s to exit)"
@@ -4388,12 +4439,12 @@ If GROUP, edit that local kill file instead."
(defun gnus-group-edit-local-kill (article group)
"Edit a local kill file."
- (interactive (list nil (gnus-group-group-name)))
+ (interactive (list nil (gnus-group-group-name)) gnus-group-mode)
(gnus-group-edit-global-kill article group))
(defun gnus-group-force-update ()
"Update `.newsrc' file."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-save-newsrc-file))
(defvar gnus-backlog-articles)
@@ -4402,7 +4453,7 @@ If GROUP, edit that local kill file instead."
"Suspend the current Gnus session.
In fact, cleanup buffers except for group mode buffer.
The hook `gnus-suspend-gnus-hook' is called before actually suspending."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-run-hooks 'gnus-suspend-gnus-hook)
(gnus-offer-save-summaries)
;; Kill Gnus buffers except for group mode buffer.
@@ -4425,14 +4476,14 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending."
(defun gnus-group-clear-dribble ()
"Clear all information from the dribble buffer."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-dribble-clear)
(gnus-message 7 "Cleared dribble buffer"))
(defun gnus-group-exit ()
"Quit reading news after updating .newsrc.eld and .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
- (interactive)
+ (interactive nil gnus-group-mode)
(when
(or noninteractive ;For gnus-batch-kill
(not gnus-interactive-exit) ;Without confirmation
@@ -4466,7 +4517,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
(defun gnus-group-quit ()
"Quit reading news without updating .newsrc.eld or .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
- (interactive)
+ (interactive nil gnus-group-mode)
(when (or noninteractive ;For gnus-batch-kill
(zerop (buffer-size))
(not (gnus-server-opened gnus-select-method))
@@ -4491,7 +4542,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
(defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands."
- (interactive)
+ (interactive nil gnus-group-mode)
(gnus-message 7 "%s" (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
(defun gnus-group-browse-foreign-server (method)
@@ -4504,7 +4555,7 @@ and the second element is the address."
(list (let ((how (gnus-completing-read
"Which back end"
(mapcar #'car (append gnus-valid-select-methods
- gnus-server-alist))
+ gnus-server-alist))
t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a back end name or a virtual server name.
;; If the first, we also need an address.
@@ -4520,7 +4571,8 @@ and the second element is the address."
gnus-secondary-servers
(cdr gnus-select-method))))
;; We got a server name.
- how))))
+ how)))
+ gnus-group-mode)
(gnus-browse-foreign-server method))
(defun gnus-group-set-info (info &optional method-only-group part)
@@ -4678,27 +4730,27 @@ level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
(funcall gnus-group-prepare-function
(or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'cache marks)))
+ (lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'cache marks)))
lowest
- #'(lambda (group)
- (or (gethash group
- gnus-cache-active-hashtb)
- ;; Cache active file might use "."
- ;; instead of ":".
- (gethash
- (mapconcat #'identity
- (split-string group ":")
- ".")
- gnus-cache-active-hashtb))))
+ (lambda (group)
+ (or (gethash group
+ gnus-cache-active-hashtb)
+ ;; Cache active file might use "."
+ ;; instead of ":".
+ (gethash
+ (mapconcat #'identity
+ (split-string group ":")
+ ".")
+ gnus-cache-active-hashtb))))
(goto-char (point-min))
(gnus-group-position-point))
@@ -4709,16 +4761,16 @@ level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
(funcall gnus-group-prepare-function
(or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'dormant marks)))
+ (lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'dormant marks)))
lowest
'ignore)
(goto-char (point-min))
@@ -4731,16 +4783,16 @@ level to cut off listing groups.
If LOWEST, don't list groups with level lower than LOWEST.
This command may read the active file."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(when level
(setq level (prefix-numeric-value level)))
(when (or (not level) (>= level gnus-level-zombie))
(gnus-cache-open))
(funcall gnus-group-prepare-function
(or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'tick marks)))
+ (lambda (info)
+ (let ((marks (gnus-info-marks info)))
+ (assq 'tick marks)))
lowest
'ignore)
(goto-char (point-min))
@@ -4759,7 +4811,7 @@ This command may read the active file."
(defun gnus-group-list-plus (&optional _args)
"List groups plus the current selection."
- (interactive)
+ (interactive nil gnus-group-mode)
(let ((gnus-group-listed-groups (gnus-group-listed-groups))
(gnus-group-list-mode gnus-group-list-mode) ;; Save it.
func)
@@ -4775,7 +4827,7 @@ This command may read the active file."
(defun gnus-group-list-flush (&optional args)
"Flush groups from the current selection."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((gnus-group-list-option 'flush))
(gnus-group-list-plus args)))
@@ -4786,7 +4838,7 @@ with this command. If you've first limited to groups with
dormant articles with `A ?', you can then further limit with
`A / c', which will then limit to groups with cached articles, giving
you the groups that have both dormant articles and cached articles."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
(let ((gnus-group-list-option 'limit))
(gnus-group-list-plus args)))
@@ -4839,7 +4891,7 @@ operation is only meaningful for back ends using one file per article
\(e.g. nnml).
Note: currently only implemented in nnml."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-group-mode)
(unless group
(error "No group to compact"))
(unless (gnus-check-backend-function 'request-compact-group group)
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 9811e8b440f..5294b83d9e9 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -222,28 +222,32 @@
(uid . UID)))
(method (caddr (assoc 'METHOD (caddr (car (nreverse ical))))))
(attendee (when attendee-name-or-email
- (gnus-icalendar-event--find-attendee ical attendee-name-or-email)))
+ (gnus-icalendar-event--find-attendee
+ ical attendee-name-or-email)))
(attendee-names (gnus-icalendar-event--get-attendee-names ical))
(role (plist-get (cadr attendee) 'ROLE))
(participation-type (pcase role
- ("REQ-PARTICIPANT" 'required)
- ("OPT-PARTICIPANT" 'optional)
- (_ 'non-participant)))
+ ("REQ-PARTICIPANT" 'required)
+ ("OPT-PARTICIPANT" 'optional)
+ (_ 'non-participant)))
(zone-map (icalendar--convert-all-timezones ical))
- (args (list :method method
- :organizer organizer
- :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map)
- :end-time (gnus-icalendar-event--decode-datefield event 'DTEND zone-map)
- :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE")
- :participation-type participation-type
- :req-participants (car attendee-names)
- :opt-participants (cadr attendee-names)))
- (event-class (cond
- ((string= method "REQUEST") 'gnus-icalendar-event-request)
- ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
- ((string= method "REPLY") 'gnus-icalendar-event-reply)
- (t 'gnus-icalendar-event))))
-
+ (args
+ (list :method method
+ :organizer organizer
+ :start-time (gnus-icalendar-event--decode-datefield
+ event 'DTSTART zone-map)
+ :end-time (gnus-icalendar-event--decode-datefield
+ event 'DTEND zone-map)
+ :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE")
+ :participation-type participation-type
+ :req-participants (car attendee-names)
+ :opt-participants (cadr attendee-names)))
+ (event-class
+ (cond
+ ((string= method "REQUEST") 'gnus-icalendar-event-request)
+ ((string= method "CANCEL") 'gnus-icalendar-event-cancel)
+ ((string= method "REPLY") 'gnus-icalendar-event-reply)
+ (t 'gnus-icalendar-event))))
(cl-labels
((map-property
(prop)
@@ -252,10 +256,10 @@
;; ugly, but cannot get
;;replace-regexp-in-string work with "\\" as
;;REP, plus we should also handle "\\;"
- (replace-regexp-in-string
- "\\\\," ","
- (replace-regexp-in-string
- "\\\\n" "\n" (substring-no-properties value))))))
+ (string-replace
+ "\\," ","
+ (string-replace
+ "\\n" "\n" (substring-no-properties value))))))
(accumulate-args
(mapping)
(cl-destructuring-bind (slot . ical-property) mapping
@@ -271,7 +275,11 @@
for keyword = (intern
(format ":%s" (eieio-slot-descriptor-name slot)))
when (plist-member args keyword)
- append (list keyword (plist-get args keyword)))))))
+ append (list keyword
+ (if (eq keyword :uid)
+ ;; The UID has to be a string.
+ (or (plist-get args keyword) "")
+ (plist-get args keyword))))))))
(defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email)
"Parse RFC5545 iCalendar in buffer BUF and return an event object.
@@ -970,7 +978,7 @@ These will be used to retrieve the RSVP information from ical events."
(defun gnus-icalendar-save-event ()
"Save the Calendar event in the text/calendar part under point."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
@@ -978,28 +986,28 @@ These will be used to retrieve the RSVP information from ical events."
(defun gnus-icalendar-reply-accept ()
"Accept invitation in the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'accepted gnus-icalendar-event))
(setq-local gnus-icalendar-reply-status 'accepted)))
(defun gnus-icalendar-reply-tentative ()
"Send tentative response to invitation in the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'tentative gnus-icalendar-event))
(setq-local gnus-icalendar-reply-status 'tentative)))
(defun gnus-icalendar-reply-decline ()
"Decline invitation in the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-reply (list gnus-icalendar-handle 'declined gnus-icalendar-event))
(setq-local gnus-icalendar-reply-status 'declined)))
(defun gnus-icalendar-event-export ()
"Export calendar event to `org-mode', or update existing agenda entry."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(gnus-icalendar-sync-event-to-org gnus-icalendar-event))
;; refresh article buffer in case the reply had been sent before initial org
@@ -1009,14 +1017,14 @@ These will be used to retrieve the RSVP information from ical events."
(defun gnus-icalendar-event-show ()
"Display `org-mode' agenda entry related to the calendar event."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-icalendar--show-org-event
(with-current-buffer gnus-article-buffer
gnus-icalendar-event)))
(defun gnus-icalendar-event-check-agenda ()
"Display `org-mode' agenda for days between event start and end dates."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-icalendar-show-org-agenda
(with-current-buffer gnus-article-buffer gnus-icalendar-event)))
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 64928623e6a..01053797b3a 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -662,7 +662,7 @@ This is the string that Gnus uses to identify the group."
"Look up the current article in the group where it originated.
This command only makes sense for groups shows articles gathered
from other groups -- for instance, search results and the like."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-command-method
(gnus-find-method-for-group gnus-newsgroup-name)))
(or
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index b0e6cb59d52..525823e72ce 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -337,7 +337,7 @@ Returns the number of articles marked as read."
(gnus-newsgroup-kill-file gnus-newsgroup-name)))
(unreads (length gnus-newsgroup-unreads))
(gnus-summary-inhibit-highlight t)
- beg)
+ ) ;; beg
(setq gnus-newsgroup-kill-headers nil)
;; If there are any previously scored articles, we remove these
;; from the `gnus-newsgroup-headers' list that the score functions
@@ -381,7 +381,7 @@ Returns the number of articles marked as read."
(gnus-set-mode-line 'summary)
- (if beg
+ (if nil ;; beg
(let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
(or (eq nunreads 0)
(gnus-message 6 "Marked %d articles as read" nunreads))
@@ -435,7 +435,7 @@ Returns the number of articles marked as read."
;; The "f:+" command marks everything *but* the matches as read,
;; so we simply first match everything as read, and then unmark
;; PATTERN later.
- (when (string-match "\\+" commands)
+ (when (string-search "+" commands)
(gnus-kill "from" ".")
(setq commands "m"))
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index fc8d9be8d6d..df076c11759 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -53,7 +53,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
(gnus-summary-save-article arg)))
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index d42f0971259..6adda2ed147 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -169,7 +169,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
(when (not (null params))
(let ((split-spec (assoc 'split-spec params)) group-clean)
;; Remove backend from group name
- (setq group-clean (string-match ":" group))
+ (setq group-clean (string-search ":" group))
(setq group-clean
(if group-clean
(substring group (1+ group-clean))
@@ -209,7 +209,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
"\\)"))
;; Now create the new SPLIT
(let ((split-regexp-with-list-ids
- (replace-regexp-in-string "@" "[@.]" split-regexp t t))
+ (string-replace "@" "[@.]" split-regexp))
(exclude
;; Generate RESTRICTs for SPLIT-EXCLUDEs.
(if (listp split-exclude)
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 45e665be8c3..ef89e6e9fcb 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -143,9 +143,6 @@ See Info node `(gnus)Posting Styles'."
:group 'gnus-message
:type 'boolean)
-(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
- 'gnus-gcc-mark-as-read "Emacs 22.1")
-
(defcustom gnus-gcc-externalize-attachments nil
"Should local-file attachments be included as external parts in Gcc copies?
If it is `all', attach files as external parts;
@@ -418,11 +415,12 @@ only affect the Gcc copy, but not the original message."
gnus-article-reply)))
(,oarticle gnus-article-reply)
(,yanked gnus-article-yanked-articles)
- (,group (when gnus-article-reply
- (or (nnselect-article-group
- (or (car-safe gnus-article-reply)
- gnus-article-reply))
- gnus-newsgroup-name)))
+ (,group (if gnus-article-reply
+ (or (nnselect-article-group
+ (or (car-safe gnus-article-reply)
+ gnus-article-reply))
+ gnus-newsgroup-name)
+ gnus-newsgroup-name))
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(mbl mml-buffer-list)
@@ -609,8 +607,6 @@ instead."
If ARG, use the group under the point to find a posting style.
If ARG is 1, prompt for a group name to find the posting style."
(interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -634,8 +630,6 @@ This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
network. The corresponding back end must have a `request-post' method."
(interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -657,7 +651,7 @@ network. The corresponding back end must have a `request-post' method."
If ARG, post to group under point. If ARG is 1, prompt for group name.
Depending on the selected group, the message might be either a mail or
a news."
- (interactive "P")
+ (interactive "P" gnus-group-mode)
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
(if arg
@@ -676,9 +670,7 @@ a news."
Use the posting of the current group by default.
If ARG, don't do that. If ARG is 1, prompt for group name to find the
posting style."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
+ (interactive "P" gnus-summary-mode)
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -701,9 +693,7 @@ If ARG, don't do that. If ARG is 1, prompt for group name to post to.
This function prepares a news even when using mail groups. This is useful
for posting messages to mail groups without actually sending them over the
network. The corresponding back end must have a `request-post' method."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
+ (interactive "P" gnus-summary-mode)
(let* (;;(group gnus-newsgroup-name)
;; make sure last viewed article doesn't affect posting styles:
(gnus-article-copy)
@@ -730,7 +720,7 @@ network. The corresponding back end must have a `request-post' method."
If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
Depending on the selected group, the message might be either a mail or
a news."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
;; Bind this variable here to make message mode hooks work ok.
(let ((gnus-newsgroup-name
(if arg
@@ -750,9 +740,9 @@ If prefix argument YANK is non-nil, the original article is yanked
automatically.
YANK is a list of elements, where the car of each element is the
article number, and the cdr is the string to be yanked."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(when yank
(gnus-summary-goto-subject
(if (listp (car yank))
@@ -772,19 +762,19 @@ article number, and the cdr is the string to be yanked."
"Compose a followup to an article and include the original article.
The text in the region will be yanked. If the region isn't
active, the entire article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
(defun gnus-summary-followup-to-mail (&optional arg)
"Followup to the current mail message via news."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(gnus-summary-followup arg t))
(defun gnus-summary-followup-to-mail-with-original (&optional arg)
"Followup to the current mail message via news."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
@@ -819,7 +809,7 @@ active, the entire article will be yanked."
Uses the process-prefix convention. If given the symbolic
prefix `a', cancel using the standard posting method; if not
post using the current select method."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-summary-mode)
(let ((message-post-method
(let ((gn gnus-newsgroup-name))
(lambda (_arg) (gnus-post-method (eq symp 'a) gn))))
@@ -849,7 +839,7 @@ post using the current select method."
"Compose an article that will supersede a previous article.
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((article (gnus-summary-article-number))
(mail-parse-charset gnus-newsgroup-charset))
(gnus-setup-message 'reply-yank
@@ -1088,7 +1078,6 @@ If SILENT, don't prompt the user."
(defun gnus-extended-version ()
"Stringified Gnus version and Emacs version.
See the variable `gnus-user-agent'."
- (interactive)
(if (stringp gnus-user-agent)
gnus-user-agent
;; `gnus-user-agent' is a list:
@@ -1117,9 +1106,9 @@ If prefix argument YANK is non-nil, the original article is yanked
automatically.
If WIDE, make a wide reply.
If VERY-WIDE, make a very wide reply."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
;; Allow user to require confirmation before replying by mail to the
;; author of a news article (or mail message).
(when (or (not (or (gnus-news-group-p gnus-newsgroup-name)
@@ -1187,14 +1176,14 @@ If VERY-WIDE, make a very wide reply."
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
The original article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply (gnus-summary-work-articles n) wide))
(defun gnus-summary-reply-to-list-with-original (n &optional wide)
"Start composing a reply mail to the current message.
The reply goes only to the mailing list.
The original article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((message-reply-to-function
(lambda nil
`((To . ,(gnus-mailing-list-followup-to))))))
@@ -1206,32 +1195,32 @@ If prefix argument YANK is non-nil, the original article is yanked
automatically.
If WIDE, make a wide reply.
If VERY-WIDE, make a very wide reply."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(let ((gnus-msg-force-broken-reply-to t))
(gnus-summary-reply yank wide very-wide)))
(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
"Like `gnus-summary-reply-with-original' except removing reply-to field.
The original article will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
automatically."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(gnus-summary-reply yank t))
(defun gnus-summary-wide-reply-with-original (n)
"Start composing a wide reply mail to the current message.
The original article(s) will be yanked.
Uses the process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply-with-original n t))
(defun gnus-summary-very-wide-reply (&optional yank)
@@ -1244,9 +1233,9 @@ messages as the To/Cc headers.
If prefix argument YANK is non-nil, the original article(s) will
be yanked automatically."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
+ (interactive (list (and current-prefix-arg
+ (gnus-summary-work-articles 1)))
+ gnus-summary-mode)
(gnus-summary-reply yank t (gnus-summary-work-articles yank)))
(defun gnus-summary-very-wide-reply-with-original (n)
@@ -1258,7 +1247,7 @@ The reply will include all From/Cc headers from the original
messages as the To/Cc headers.
The original article(s) will be yanked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-reply
(gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
@@ -1274,7 +1263,7 @@ otherwise, use flipped `message-forward-as-mime'.
If POST, post instead of mail.
For the \"inline\" alternatives, also see the variable
`message-forward-ignored-headers'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if (cdr (gnus-summary-work-articles nil))
;; Process marks are given.
(gnus-uu-digest-mail-forward nil post)
@@ -1334,7 +1323,7 @@ For the \"inline\" alternatives, also see the variable
((stringp self)
(insert "Gcc: "
(encode-coding-string
- (if (string-match " " self)
+ (if (string-search " " self)
(concat "\"" self "\"")
self)
(gnus-group-name-charset (gnus-inews-group-method self)
@@ -1363,7 +1352,8 @@ the message before resending."
;; initial-contents.
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-summary-mode)
(let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
(message-sent-hook (copy-sequence message-sent-hook))
;; Honor posting-style for `name' and `address' in Resent-From header.
@@ -1416,7 +1406,7 @@ the message before resending."
A new buffer will be created to allow the user to modify body and
contents of the message, and then, everything will happen as when
composing a new message."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((mail-parse-charset gnus-newsgroup-charset))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
@@ -1444,12 +1434,12 @@ composing a new message."
(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
See `gnus-summary-mail-forward' for ARG."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mail-forward arg t))
(defun gnus-summary-mail-crosspost-complaint (n)
"Send a complaint about crossposting to the current article(s)."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(dolist (article (gnus-summary-work-articles n))
(set-buffer gnus-summary-buffer)
(gnus-summary-goto-subject article)
@@ -1517,9 +1507,9 @@ Already submitted bugs can be found in the Emacs bug tracker:
(defun gnus-summary-yank-message (buffer n)
"Yank the current article into a composed message."
- (interactive
- (list (gnus-completing-read "Buffer" (message-buffers) t)
- current-prefix-arg))
+ (interactive (list (gnus-completing-read "Buffer" (message-buffers) t)
+ current-prefix-arg)
+ gnus-summary-mode)
(gnus-summary-iterate n
(let ((gnus-inhibit-treatment t))
(gnus-summary-select-article))
@@ -1536,7 +1526,7 @@ contains some mail you have written which has been bounced back to
you.
If FETCH, try to fetch the article that this is a reply to, if indeed
this is a reply."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-select-article t)
(let (summary-buffer parent)
(if fetch
@@ -1579,7 +1569,6 @@ this is a reply."
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
- (interactive)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -1608,6 +1597,10 @@ this is a reply."
(if (stringp gnus-gcc-externalize-attachments)
(string-match gnus-gcc-externalize-attachments group)
gnus-gcc-externalize-attachments))
+ ;; If we want to externalize stuff when GCC-ing, then we
+ ;; can't use the cache, because that has all the contents.
+ (when mml-externalize-attachments
+ (setq encoded-cache nil))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options))
@@ -1668,9 +1661,7 @@ this is a reply."
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
(gnus-alive-p))
- (if (or gnus-gcc-mark-as-read
- (and (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read)))
+ (if gnus-gcc-mark-as-read
(gnus-group-mark-article-read group (cdr group-art))
(with-current-buffer gnus-group-buffer
(let ((gnus-group-marked (list group))
@@ -1690,7 +1681,7 @@ this is a reply."
(gnus-group-find-parameter group 'gcc-self t)))
(gcc-self-get (lambda (gcc-self-val group)
(if (stringp gcc-self-val)
- (if (string-match " " gcc-self-val)
+ (if (string-search " " gcc-self-val)
(concat "\"" gcc-self-val "\"")
gcc-self-val)
;; In nndoc groups, we use the parent group name
@@ -1698,7 +1689,7 @@ this is a reply."
(let ((group (or (gnus-group-find-parameter
gnus-newsgroup-name 'parent-group)
group)))
- (if (string-match " " group)
+ (if (string-search " " group)
(concat "\"" group "\"")
group)))))
result
@@ -1761,11 +1752,11 @@ this is a reply."
(gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
- (let ((str (if (string-match ":" name)
+ (let ((str (if (string-search ":" name)
name
(gnus-group-prefixed-name
name gnus-message-archive-method))))
- (insert (if (string-match " " str)
+ (insert (if (string-search " " str)
(concat "\"" str "\"")
str)))
(when groups
@@ -1972,7 +1963,7 @@ created.
This command uses the process/prefix convention, so if you
process-mark several articles, they will all be attached."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((buffers (message-buffers))
destination)
;; Set up the destination mail composition buffer.
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index a4d198b46e4..8646904637c 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -1,4 +1,4 @@
-;; gnus-notifications.el -- Send notification on new message in Gnus -*- lexical-binding: t; -*-
+;;; gnus-notifications.el --- Send notification on new message in Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index 7927b88c3de..fd4d3b8a762 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -244,7 +244,7 @@ replacement is added."
(gnus-picon-insert-glyph (pop spec) category))))))))))
(defun gnus-picon-transform-newsgroups (header)
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-headers
(gnus-article-goto-header header)
(mail-header-narrow-to-field)
@@ -283,7 +283,7 @@ replacement is added."
(defun gnus-treat-from-picon ()
"Display picons in the From header.
If picons are already displayed, remove them."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((wash-picon-p buffer-read-only))
(gnus-with-article-buffer
(if (and wash-picon-p (memq 'from-picon gnus-article-wash-types))
@@ -294,7 +294,7 @@ If picons are already displayed, remove them."
(defun gnus-treat-mail-picon ()
"Display picons in the Cc and To headers.
If picons are already displayed, remove them."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((wash-picon-p buffer-read-only))
(gnus-with-article-buffer
(if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types))
@@ -306,7 +306,7 @@ If picons are already displayed, remove them."
(defun gnus-treat-newsgroups-picon ()
"Display picons in the Newsgroups and Followup-To headers.
If picons are already displayed, remove them."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((wash-picon-p buffer-read-only))
(gnus-with-article-buffer
(if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types))
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 6cc60cb49b3..7d12ae9fdcc 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -42,13 +42,8 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
- (let ((hash2 (make-hash-table :test 'eq))
- (result nil))
- (dolist (elt list2) (puthash elt t hash2))
- (dolist (elt list1)
- (unless (gethash elt hash2)
- (setq result (cons elt result))))
- (nreverse result)))
+ (declare (obsolete seq-difference "28.1"))
+ (seq-difference list1 list2 #'eq))
(defun gnus-range-nconcat (&rest ranges)
"Return a range comprising all the RANGES, which are pre-sorted.
@@ -179,12 +174,8 @@ Both lists have to be sorted over <."
;;;###autoload
(defun gnus-intersection (list1 list2)
- (let ((result nil))
- (while list2
- (when (memq (car list2) list1)
- (setq result (cons (car list2) result)))
- (setq list2 (cdr list2)))
- result))
+ (declare (obsolete seq-intersection "28.1"))
+ (nreverse (seq-intersection list1 list2 #'eq)))
;;;###autoload
(defun gnus-sorted-intersection (list1 list2)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 147550d8cf3..0468d72edd0 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -88,7 +88,6 @@
(require 'gnus-art)
(require 'gnus-util)
(require 'nnmail)
-(require 'easymenu)
(require 'registry)
(defvar gnus-adaptive-word-syntax-table)
@@ -320,9 +319,12 @@ Encode names if ENCODE is non-nil, otherwise decode."
(setf (oref db tracked)
(append gnus-registry-track-extra
'(mark group keyword)))
- (when (not (equal old (oref db tracked)))
+ (when (not (seq-set-equal-p old (oref db tracked)))
(gnus-message 9 "Reindexing the Gnus registry (tracked change)")
- (registry-reindex db))
+ (let ((message-log-max (if (< gnus-verbose 9)
+ nil
+ message-log-max)))
+ (registry-reindex db)))
(gnus-registry--munge-group-names db)))
db)
@@ -813,7 +815,7 @@ Consults `gnus-registry-ignored-groups' and
(defun gnus-registry-wash-for-keywords (&optional force)
"Get the keywords of the current article.
Overrides existing keywords with FORCE set non-nil."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((id (gnus-registry-fetch-message-id-fast gnus-current-article))
word words)
(if (or (not (gnus-registry-get-id-key id 'keyword))
@@ -1039,13 +1041,15 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(defun gnus-registry-set-article-mark (&rest articles)
"Apply a mark to process-marked ARTICLES."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-article-mode gnus-summary-mode)
(gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
articles nil t))
(defun gnus-registry-remove-article-mark (&rest articles)
"Remove a mark from process-marked ARTICLES."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-article-mode gnus-summary-mode)
(gnus-registry-set-article-mark-internal (gnus-registry-read-mark)
articles t t))
@@ -1069,7 +1073,8 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
"Get the Gnus registry marks for ARTICLES and show them if interactive.
Uses process/prefix conventions. For multiple articles,
only the last one's marks are returned."
- (interactive (gnus-summary-work-articles 1))
+ (interactive (gnus-summary-work-articles 1)
+ gnus-article-mode gnus-summary-mode)
(let* ((article (last articles))
(id (gnus-registry-fetch-message-id-fast article))
(marks (when id (gnus-registry-get-id-key id 'mark))))
@@ -1288,16 +1293,14 @@ from your existing entries."
(registry-reindex db)
(cl-loop for k being the hash-keys of (oref db data)
using (hash-value v)
- do (let ((newv (delq nil (mapcar #'(lambda (entry)
- (unless (member (car entry) extra)
- entry))
+ do (let ((newv (delq nil (mapcar (lambda (entry)
+ (unless (member (car entry) extra)
+ entry))
v))))
(registry-delete db (list k) nil)
(gnus-registry-insert db k newv)))
(registry-reindex db))))
-;; TODO: a few things
-
(provide 'gnus-registry)
;;; gnus-registry.el ends here
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 5697c870888..c135ecea369 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -44,7 +44,7 @@
(case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(ctl (and ct (mail-header-parse-content-type ct))))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-search "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max))
(widen)
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index e222d24b694..5b746a8efa9 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -137,6 +137,8 @@ It accepts the same format specs that `gnus-summary-line-format' does."
"Start reading the picked articles.
If given a prefix, mark all unpicked articles as read."
(interactive "P")
+ (declare (completion (lambda (s b)
+ (completion-minor-mode-active-p s b 'gnus-pick-mode))))
(if gnus-newsgroup-processable
(progn
(gnus-summary-limit-to-articles nil)
@@ -462,7 +464,7 @@ Two predefined functions are available:
(defun gnus-tree-read-summary-keys (&optional arg)
"Read a summary buffer key sequence and execute it."
- (interactive "P")
+ (interactive "P" gnus-tree-mode)
(unless gnus-tree-inhibit
(let ((buf (current-buffer))
(gnus-tree-inhibit t)
@@ -477,7 +479,7 @@ Two predefined functions are available:
(defun gnus-tree-show-summary ()
"Reconfigure windows to show summary buffer."
- (interactive)
+ (interactive nil gnus-tree-mode)
(if (not (gnus-buffer-live-p gnus-summary-buffer))
(error "There is no summary buffer for this tree buffer")
(gnus-configure-windows 'article)
@@ -485,7 +487,7 @@ Two predefined functions are available:
(defun gnus-tree-select-article (article)
"Select the article under point, if any."
- (interactive (list (gnus-tree-article-number)))
+ (interactive (list (gnus-tree-article-number)) gnus-tree-mode)
(let ((buf (current-buffer)))
(when article
(with-current-buffer gnus-summary-buffer
@@ -494,7 +496,7 @@ Two predefined functions are available:
(defun gnus-tree-pick-article (e)
"Select the article under the mouse pointer."
- (interactive "e")
+ (interactive "e" gnus-tree-mode)
(mouse-set-point e)
(gnus-tree-select-article (gnus-tree-article-number)))
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index ade0897a16a..f40da9e9c4c 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -528,7 +528,8 @@ permanence, and the string to be used. The numerical prefix will
be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
says to use the `all.SCORE' file for the command instead of the
current score file."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny")
+ gnus-article-mode gnus-summary-mode)
(gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
(defun gnus-score-kill-help-buffer ()
@@ -544,7 +545,8 @@ permanence, and the string to be used. The numerical prefix will
be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
says to use the `all.SCORE' file for the command instead of the
current score file."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny")
+ gnus-article-mode gnus-summary-mode)
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
@@ -931,15 +933,16 @@ TYPE is the score type.
SCORE is the score to add.
EXTRA is the possible non-standard header."
(interactive (list (gnus-completing-read "Header"
- (mapcar
+ (mapcar
#'car
(seq-filter
(lambda (x) (fboundp (nth 2 x)))
gnus-header-index))
- t)
+ t)
(read-string "Match: ")
(if (y-or-n-p "Use regexp match? ") 'r 's)
- (string-to-number (read-string "Score: "))))
+ (string-to-number (read-string "Score: ")))
+ gnus-article-mode gnus-summary-mode)
(save-excursion
(unless (and (stringp match) (> (length match) 0))
(error "No match"))
@@ -974,7 +977,8 @@ EXTRA is the possible non-standard header."
"Automatically mark articles with score below SCORE as read."
(interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-number (read-string "Mark below: ")))))
+ (string-to-number (read-string "Mark below: "))))
+ gnus-article-mode gnus-summary-mode)
(setq score (or score gnus-summary-default-score 0))
(gnus-score-set 'mark (list score))
(gnus-score-set 'touched '(t))
@@ -1008,14 +1012,15 @@ EXTRA is the possible non-standard header."
"Automatically expunge articles with score below SCORE."
(interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-number (read-string "Set expunge below: ")))))
+ (string-to-number (read-string "Set expunge below: "))))
+ gnus-article-mode gnus-summary-mode)
(setq score (or score gnus-summary-default-score 0))
(gnus-score-set 'expunge (list score))
(gnus-score-set 'touched '(t)))
(defun gnus-score-followup-article (&optional score)
"Add SCORE to all followups to the article in the current buffer."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
@@ -1030,7 +1035,7 @@ EXTRA is the possible non-standard header."
(defun gnus-score-followup-thread (&optional score)
"Add SCORE to all later articles in the thread the current buffer is part of."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
@@ -1064,13 +1069,13 @@ EXTRA is the possible non-standard header."
(defun gnus-summary-raise-score (n)
"Raise the score of the current article by N."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-summary-set-score (+ (gnus-summary-article-score)
(or n gnus-score-interactive-default-score ))))
(defun gnus-summary-set-score (n)
"Set the score of the current article to N."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(save-excursion
(gnus-summary-show-thread)
(let ((buffer-read-only nil))
@@ -1089,7 +1094,7 @@ EXTRA is the possible non-standard header."
(defun gnus-summary-current-score (arg)
"Return the score of the current article.
With prefix ARG, return the total score of the current (sub)thread."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(message "%s" (if arg
(gnus-thread-total-score
(gnus-id-to-thread
@@ -1099,14 +1104,16 @@ EXTRA is the possible non-standard header."
(defun gnus-score-change-score-file (file)
"Change current score alist."
(interactive
- (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
+ (list (read-file-name "Change to score file: " gnus-kill-files-directory))
+ gnus-article-mode gnus-summary-mode)
(gnus-score-load-file file)
(gnus-set-mode-line 'summary))
(defvar gnus-score-edit-exit-function)
(defun gnus-score-edit-current-scores (file)
"Edit the current score alist."
- (interactive (list gnus-current-score-file))
+ (interactive (list gnus-current-score-file)
+ gnus-article-mode gnus-summary-mode)
(if (not gnus-current-score-file)
(error "No current score file")
(let ((winconf (current-window-configuration)))
@@ -1175,8 +1182,8 @@ If FORMAT, also format the current score file."
(when (consp rule) ;; the rule exists
(setq rule (if (symbolp (car rule))
(format "(%S)" (car rule))
- (mapconcat #'(lambda (obj)
- (regexp-quote (format "%S" obj)))
+ (mapconcat (lambda (obj)
+ (regexp-quote (format "%S" obj)))
rule
sep)))
(goto-char (point-min))
@@ -2496,7 +2503,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(defun gnus-score-find-trace ()
"Find all score rules that applies to the current article."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((old-scored gnus-newsgroup-scored))
(let ((gnus-newsgroup-headers
(list (gnus-summary-article-header)))
@@ -2611,7 +2618,7 @@ the score file and its full name, including the directory.")
(defun gnus-summary-rescore ()
"Redo the entire scoring process in the current summary."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-score-save)
(setq gnus-score-cache nil)
(setq gnus-newsgroup-scored nil)
@@ -2642,7 +2649,7 @@ the score file and its full name, including the directory.")
(defun gnus-summary-raise-same-subject-and-select (score)
"Raise articles which has the same subject with SCORE and select the next."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(let ((subject (gnus-summary-article-subject)))
(gnus-summary-raise-score score)
(while (gnus-summary-find-subject subject)
@@ -2651,7 +2658,7 @@ the score file and its full name, including the directory.")
(defun gnus-summary-raise-same-subject (score)
"Raise articles which has the same subject with SCORE."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(let ((subject (gnus-summary-article-subject)))
(gnus-summary-raise-score score)
(while (gnus-summary-find-subject subject)
@@ -2664,7 +2671,7 @@ the score file and its full name, including the directory.")
(defun gnus-summary-raise-thread (&optional score)
"Raise the score of the articles in the current thread with SCORE."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(setq score (gnus-score-delta-default score))
(let (e)
(save-excursion
@@ -2683,17 +2690,17 @@ the score file and its full name, including the directory.")
(defun gnus-summary-lower-same-subject-and-select (score)
"Raise articles which has the same subject with SCORE and select the next."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-summary-raise-same-subject-and-select (- score)))
(defun gnus-summary-lower-same-subject (score)
"Raise articles which has the same subject with SCORE."
- (interactive "p")
+ (interactive "p" gnus-article-mode gnus-summary-mode)
(gnus-summary-raise-same-subject (- score)))
(defun gnus-summary-lower-thread (&optional score)
"Lower score of articles in the current thread with SCORE."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-summary-raise-thread (- (gnus-score-delta-default score))))
;;; Finding score files.
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 21602f825c1..2a8069d400c 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -4,18 +4,20 @@
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -363,7 +365,7 @@ This variable can also be set per-server."
"A list of strings representing expandable search keys.
\"Expandable\" simply means the key can be abbreviated while
typing in search queries, ie \"subject\" could be entered as
-\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subj\" or even \"su\", though \"s\" is ambiguous between
\"subject\" and \"since\".
Ambiguous abbreviations will raise an error."
@@ -400,7 +402,7 @@ The search \"language\" is essentially a series of key:value
expressions. Key is most often a mail header, but there are
other keys. Value is a string, quoted if it contains spaces.
Key and value are separated by a colon, no space. Expressions
-are implictly ANDed; the \"or\" keyword can be used to
+are implicitly ANDed; the \"or\" keyword can be used to
OR. \"not\" will negate the following expression, or keys can be
prefixed with a \"-\". The \"near\" operator will work for
engines that understand it; other engines will convert it to
@@ -446,10 +448,10 @@ auto-completion of contact names and addresses for keys like
Date values (any key in `gnus-search-date-keys') can be provided
in any format that `parse-time-string' can parse (note that this
can produce weird results). Dates with missing bits will be
-interpreted as the most recent occurance thereof (ie \"march 03\"
-is the most recent March 3rd). Lastly, relative specifications
-such as 1d (one day ago) are understood. This also accepts w, m,
-and y. m is assumed to be 30 days.
+interpreted as the most recent occurrence thereof (i.e. \"march
+03\" is the most recent March 3rd). Lastly, relative
+specifications such as 1d (one day ago) are understood. This
+also accepts w, m, and y. m is assumed to be 30 days.
This function will accept pretty much anything as input. Its
only job is to parse the query into a sexp, and pass that on --
@@ -547,7 +549,7 @@ structure.
In the simplest case, they are simply consed together. String
KEY is converted to a symbol."
- (let (return)
+ (let () ;; return
(cond
((member key gnus-search-date-keys)
(when (string= "after" key)
@@ -557,7 +559,7 @@ KEY is converted to a symbol."
(setq value (gnus-search-query-parse-mark value)))
((string= "message-id" key)
(setq key "id")))
- (or return
+ (or nil ;; return
(cons (intern key) value))))
(defun gnus-search-query-parse-date (value &optional rel-date)
@@ -570,7 +572,7 @@ nil.
If VALUE is a relative time, interpret it as relative to
REL-DATE, or (current-time) if REL-DATE is nil."
;; Time parsing doesn't seem to work with slashes.
- (let ((value (replace-regexp-in-string "/" "-" value))
+ (let ((value (string-replace "/" "-" value))
(now (append '(0 0 0)
(seq-subseq (decode-time (or rel-date
(current-time)))
@@ -627,25 +629,30 @@ gnus-*-mark marks, and return an appropriate string."
mark))
(defun gnus-search-query-expand-key (key)
- (cond ((test-completion key gnus-search-expandable-keys)
- ;; We're done!
- key)
- ;; There is more than one possible completion.
- ((consp (cdr (completion-all-completions
- key gnus-search-expandable-keys #'stringp 0)))
- (signal 'gnus-search-parse-error
- (list (format "Ambiguous keyword: %s" key))))
- ;; Return KEY, either completed or untouched.
- ((car-safe (completion-try-completion
- key gnus-search-expandable-keys
- #'stringp 0)))))
+ "Attempt to expand KEY to a full keyword.
+Use `gnus-search-expandable-keys' as a completion table; return
+KEY directly if it can't be completed. Raise an error if KEY is
+ambiguous, meaning that it is a prefix of multiple known
+keywords. This means that it's not possible to enter a custom
+keyword that happens to be a prefix of a known keyword."
+ (let ((comp (try-completion key gnus-search-expandable-keys)))
+ (if (or (eql comp 't) ; Already a key.
+ (null comp)) ; An unknown key.
+ key
+ (if (null (member comp gnus-search-expandable-keys))
+ ;; KEY is a prefix of multiple known keywords, and could not
+ ;; be completed to something unique.
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key)))
+ ;; We completed to a unique known key.
+ comp))))
(defun gnus-search-query-return-string (&optional delimited trim)
"Return a string from the current buffer.
If DELIMITED is non-nil, assume the next character is a delimiter
character, and return everything between point and the next
-occurance of the delimiter, including the delimiters themselves.
-If TRIM is non-nil, do not return the delimiters. Otherwise,
+occurrence of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
return one word."
;; This function cannot handle nested delimiters, as it's not a
;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
@@ -787,7 +794,7 @@ the files in ARTLIST by that search key.")
(raw-queries-p
:initform (symbol-value 'gnus-search-imap-raw-queries-p)))
:documentation
- "The base IMAP search engine, using an IMAP server's search capabilites.
+ "The base IMAP search engine, using an IMAP server's search capabilities.
This backend may be subclassed to handle particular IMAP servers'
quirks.")
@@ -973,7 +980,7 @@ Responsible for handling and, or, and parenthetical expressions.")
;; Most search engines use implicit ANDs.
(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
- (_expr (eql and)))
+ (_expr (eql 'and)))
nil)
;; Most search engines use explicit infixed ORs.
@@ -1080,7 +1087,7 @@ Responsible for handling and, or, and parenthetical expressions.")
(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
(query string))
"Create the IMAP search command for QUERY.
-Currenly takes into account support for the LITERAL+ capability.
+Currently takes into account support for the LITERAL+ capability.
Other capabilities could be tested here."
(with-slots (literal-plus) engine
(when literal-plus
@@ -1276,24 +1283,30 @@ elements are present."
str)))
(defun gnus-search-imap-handle-flag (flag)
- "Make sure string FLAG is something IMAP will recognize."
- ;; What else? What about the KEYWORD search key?
+ "Adjust string FLAG to help IMAP recognize it.
+If it's one of the RFC3501 flags, make sure it's upcased.
+Otherwise, if FLAG starts with a \"$\", treat as a KEYWORD
+search. Otherwise, drop the flag."
(setq flag
(pcase flag
("flag" "flagged")
("read" "seen")
("replied" "answered")
(_ flag)))
- (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
- (upcase flag)
- ""))
+ (cond
+ ((member flag '("seen" "answered" "deleted" "draft" "flagged" "recent"))
+ (upcase flag))
+ ((string-prefix-p "$" flag)
+ (format "KEYWORD %s" flag))
+ ;; TODO: Provide a user option to treat *all* marks as a KEYWORDs?
+ (t "")))
;;; Methods for the indexed search engines.
;; First, some common methods.
-(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups)
- "Parse the results of ENGINE's query against SERVER in GROUPS.
+(cl-defgeneric gnus-search-indexed-parse-output (engine server query &optional groups)
+ "Parse the results of ENGINE's QUERY against SERVER in GROUPS.
Locally-indexed search engines return results as a list of
filenames, sometimes with additional information. Returns a list
of viable results, in the form of a list of [group article score]
@@ -1343,63 +1356,61 @@ Returns a list of [group article score] vectors."
(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
server query &optional groups)
- (let ((prefix (slot-value engine 'remove-prefix))
- (group-regexp (when groups
- (mapconcat
- (lambda (x)
- (replace-regexp-in-string
- ;; Accept any of [.\/] as path separators.
- "[.\\/]" "[.\\\\/]"
- (gnus-group-real-name x)))
- groups "\\|")))
- artlist vectors article group)
+ (let ((prefix (or (slot-value engine 'remove-prefix)
+ ""))
+ (groups (mapcar #'gnus-group-short-name groups))
+ artlist article group)
(goto-char (point-min))
- (while (not (eobp))
+ ;; Prep prefix, we want to at least be removing the root
+ ;; filesystem separator.
+ (when (stringp prefix)
+ (setq prefix (file-name-as-directory
+ (expand-file-name prefix "/"))))
+ (while (not (or (eobp)
+ (looking-at-p
+ "\\(?:[[:space:]\n]+\\)?Process .+ finished")))
(pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
- (when (and (file-readable-p f-name)
- (null (file-directory-p f-name))
- (or (null groups)
- (and (gnus-search-single-p query)
- (alist-get 'thread query))
- (string-match-p group-regexp f-name)))
- (push (list f-name score) artlist))))
+ (when (and f-name
+ (file-readable-p f-name)
+ (null (file-directory-p f-name)))
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "\\`\\." ""
+ (string-remove-prefix
+ prefix (file-name-directory f-name))
+ nil t)
+ nil t)
+ nil t))
+ (setq article (file-name-nondirectory f-name)
+ article
+ ;; TODO: Provide a cleaner way of producing final
+ ;; article numbers for the various backends.
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-search ":" article))
+ group (string-remove-prefix "nnmaildir:" server))))
+ (when (and (numberp article)
+ (or (null groups)
+ (member group groups)))
+ (push (list f-name article group score)
+ artlist)))))
;; Are we running an additional grep query?
(when-let ((grep-reg (alist-get 'grep query)))
(setq artlist (gnus-search-grep-search engine artlist grep-reg)))
- ;; Prep prefix.
- (when (and prefix (null (string-empty-p prefix)))
- (setq prefix (file-name-as-directory (expand-file-name prefix))))
- ;; Turn (file-name score) into [group article score].
- (pcase-dolist (`(,f-name ,score) artlist)
- (setq article (file-name-nondirectory f-name)
- group (file-name-directory f-name))
- ;; Remove prefix.
- (when prefix
- (setq group (string-remove-prefix prefix group)))
- ;; Break the directory name down until it's something that
- ;; (probably) can be used as a group name.
- (setq group
- (replace-regexp-in-string
- "[/\\]" "."
- (replace-regexp-in-string
- "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
- (replace-regexp-in-string
- "^[./\\]" ""
- group nil t)
- nil t)
- nil t))
-
- (push (vector (gnus-group-full-name group server)
- (if (string-match-p "\\`[[:digit:]]+\\'" article)
- (string-to-number article)
- (nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
- group (string-remove-prefix "nnmaildir:" server)))
- (if (numberp score)
- score
- (string-to-number score)))
- vectors))
- vectors))
+ ;; Munge into the list of vectors expected by nnselect.
+ (mapcar (pcase-lambda (`(,_ ,article ,group ,score))
+ (vector
+ (gnus-group-full-name group server)
+ article
+ (if (numberp score)
+ score
+ (string-to-number score))))
+ artlist)))
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
"Base implementation treats the whole line as a filename, and
@@ -1658,7 +1669,7 @@ cross our fingers for the rest of it."
Mairix negation requires a \"~\" preceding string search terms,
and \"-\" before marks."
(let ((next (gnus-search-transform-expression engine (cadr expr))))
- (replace-regexp-in-string
+ (string-replace
":"
(if (eql (caadr expr) 'mark)
":-"
@@ -1668,8 +1679,8 @@ and \"-\" before marks."
(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
(expr (head or)))
"Handle Mairix \"or\" statement.
-Mairix only accepts \"or\" expressions on homogenous keys. We
-cast \"or\" expressions on heterogenous keys as \"and\", which
+Mairix only accepts \"or\" expressions on homogeneous keys. We
+cast \"or\" expressions on heterogeneous keys as \"and\", which
isn't quite right, but it's the best we can do. For date keys,
only keep one of the terms."
(let ((term1 (caadr expr))
@@ -1852,9 +1863,9 @@ Assume \"size\" key is equal to \"larger\"."
group
(if (file-directory-p
(setq group
- (replace-regexp-in-string
- "\\." "/"
- group nil t)))
+ (string-replace
+ "." "/"
+ group)))
group))))))
(unless group
(signal 'gnus-search-config-error
@@ -2125,7 +2136,7 @@ article came from is also searched."
;; If the value contains spaces, make sure it's
;; quoted.
(when (and (memql status '(exact finished))
- (or (string-match-p " " str)
+ (or (string-search " " str)
in-string))
(unless (looking-at-p "\\s\"")
(insert "\""))
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 5dcd079fb48..eeedf7ff35c 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -113,7 +113,7 @@ Return nil if no rule could be guessed."
;;;###autoload
(defun gnus-sieve-article-add-rule ()
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-summary-select-article nil 'force)
(with-current-buffer gnus-original-article-buffer
(let ((rule (gnus-sieve-guess-rule-for-article))
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index cb60108ea9c..59c6956ac2f 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -582,7 +582,7 @@ or to characters when given a pad value."
((string= fstring "")
nil)
;; Not a format string.
- ((not (string-match "%" fstring))
+ ((not (string-search "%" fstring))
(list fstring))
;; A format string with just a single string spec.
((string= fstring "%s")
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index a305e343f69..1c75abb6f4b 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -409,7 +409,7 @@ The following commands are available:
(defun gnus-server-kill-server (server)
"Kill the server on the current line."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(unless (gnus-server-goto-server server)
(if server (error "No such server: %s" server)
(error "No server on the current line")))
@@ -438,7 +438,7 @@ The following commands are available:
(defun gnus-server-yank-server ()
"Yank the previously killed server."
- (interactive)
+ (interactive nil gnus-server-mode)
(unless gnus-server-killed-servers
(error "No killed servers to be yanked"))
(let ((alist gnus-server-alist)
@@ -460,14 +460,14 @@ The following commands are available:
(defun gnus-server-exit ()
"Return to the group buffer."
- (interactive)
+ (interactive nil gnus-server-mode)
(gnus-run-hooks 'gnus-server-exit-hook)
(gnus-kill-buffer (current-buffer))
(gnus-configure-windows 'group t))
(defun gnus-server-list-servers ()
"List all available servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(let ((cur (gnus-server-server-name)))
(gnus-server-prepare)
(if cur (gnus-server-goto-server cur)
@@ -489,7 +489,7 @@ The following commands are available:
(defun gnus-server-open-server (server)
"Force an open of SERVER."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -501,13 +501,13 @@ The following commands are available:
(defun gnus-server-open-all-servers ()
"Open all servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(dolist (server gnus-inserted-opened-servers)
(gnus-server-open-server (car server))))
(defun gnus-server-close-server (server)
"Close SERVER."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -519,7 +519,7 @@ The following commands are available:
(defun gnus-server-offline-server (server)
"Set SERVER to offline."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -531,7 +531,7 @@ The following commands are available:
(defun gnus-server-close-all-servers ()
"Close all servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(dolist (server gnus-inserted-opened-servers)
(gnus-server-close-server (car server)))
(dolist (server gnus-server-alist)
@@ -539,7 +539,7 @@ The following commands are available:
(defun gnus-server-deny-server (server)
"Make sure SERVER will never be attempted opened."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(unless method
(error "No such server: %s" server))
@@ -550,7 +550,7 @@ The following commands are available:
(defun gnus-server-remove-denials ()
"Make all denied servers into closed servers."
- (interactive)
+ (interactive nil gnus-server-mode)
(dolist (server gnus-opened-servers)
(when (eq (nth 1 server) 'denied)
(setcar (nthcdr 1 server) 'closed)))
@@ -558,11 +558,11 @@ The following commands are available:
(defun gnus-server-copy-server (from to)
"Copy a server definition to a new name."
- (interactive
- (list
- (or (gnus-server-server-name)
- (error "No server on the current line"))
- (read-string "Copy to: ")))
+ (interactive (list
+ (or (gnus-server-server-name)
+ (error "No server on the current line"))
+ (read-string "Copy to: "))
+ gnus-server-mode)
(unless from
(error "No server on current line"))
(unless (and to (not (string= to "")))
@@ -583,7 +583,8 @@ The following commands are available:
(list (intern (gnus-completing-read "Server method"
(mapcar #'car gnus-valid-select-methods)
t))
- (read-string "Server name: ")))
+ (read-string "Server name: "))
+ gnus-server-mode)
(when (assq where gnus-server-alist)
(error "Server with that name already defined"))
(push (list where how where) gnus-server-killed-servers)
@@ -593,7 +594,8 @@ The following commands are available:
"Jump to a server line."
(interactive
(list (gnus-completing-read "Goto server"
- (mapcar #'car gnus-server-alist) t)))
+ (mapcar #'car gnus-server-alist) t))
+ gnus-server-mode)
(let ((to (text-property-any (point-min) (point-max)
'gnus-server (intern server))))
(when to
@@ -602,7 +604,7 @@ The following commands are available:
(defun gnus-server-edit-server (server)
"Edit the server on the current line."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(unless server
(error "No server on current line"))
(unless (assoc server gnus-server-alist)
@@ -620,7 +622,7 @@ The following commands are available:
(defun gnus-server-show-server (server)
"Show the definition of the server on the current line."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(unless server
(error "No server on current line"))
(let ((info (gnus-server-to-method server)))
@@ -632,7 +634,7 @@ The following commands are available:
(defun gnus-server-scan-server (server)
"Request a scan from the current server."
- (interactive (list (gnus-server-server-name)))
+ (interactive (list (gnus-server-server-name)) gnus-server-mode)
(let ((method (gnus-server-to-method server)))
(if (not (gnus-get-function method 'request-scan))
(error "Server %s can't scan" (car method))
@@ -714,7 +716,7 @@ claim them."
"\M-n" gnus-browse-next-group
"\M-p" gnus-browse-prev-group
"\r" gnus-browse-select-group
- "u" gnus-browse-unsubscribe-current-group
+ "u" gnus-browse-toggle-subscription-at-point
"l" gnus-browse-exit
"L" gnus-browse-exit
"q" gnus-browse-exit
@@ -733,7 +735,7 @@ claim them."
(easy-menu-define
gnus-browse-menu gnus-browse-mode-map ""
'("Browse"
- ["Subscribe" gnus-browse-unsubscribe-current-group t]
+ ["Toggle Subscribe" gnus-browse-toggle-subscription-at-point t]
["Read" gnus-browse-read-group t]
["Select" gnus-browse-select-group t]
["Describe" gnus-browse-describe-group t]
@@ -879,9 +881,9 @@ All normal editing commands are switched off.
\\<gnus-browse-mode-map>
The only things you can do in this buffer is
-1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
-The group will be inserted into the group buffer upon exit from this
-buffer.
+1) `\\[gnus-browse-toggle-subscription-at-point]' to subscribe or unsubscribe to
+a group. The group will be inserted into the group buffer upon exit from
+this buffer.
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
@@ -897,7 +899,7 @@ buffer.
(defun gnus-browse-read-group (&optional no-article number)
"Enter the group at the current line.
If NUMBER, fetch this number of articles."
- (interactive "P")
+ (interactive "P" gnus-browse-mode)
(let* ((full-name (gnus-browse-group-name))
(group (if (gnus-native-method-p
(gnus-find-method-for-group full-name))
@@ -916,33 +918,38 @@ If NUMBER, fetch this number of articles."
(defun gnus-browse-select-group (&optional number)
"Select the current group.
If NUMBER, fetch this number of articles."
- (interactive "P")
+ (interactive "P" gnus-browse-mode)
(gnus-browse-read-group 'no number))
(defun gnus-browse-next-group (n)
"Go to the next group."
- (interactive "p")
+ (interactive "p" gnus-browse-mode)
(prog1
(forward-line n)
(gnus-group-position-point)))
(defun gnus-browse-prev-group (n)
"Go to the next group."
- (interactive "p")
+ (interactive "p" gnus-browse-mode)
(gnus-browse-next-group (- n)))
-(defun gnus-browse-unsubscribe-current-group (arg)
+(define-obsolete-function-alias 'gnus-browse-unsubscribe-current-group
+ 'gnus-browse-toggle-subscription-at-point "28.1")
+(define-obsolete-function-alias 'gnus-browse-unsubscribe-group
+ 'gnus-browse-toggle-subscription "28.1")
+
+(defun gnus-browse-toggle-subscription-at-point (arg)
"(Un)subscribe to the next ARG groups.
The variable `gnus-browse-subscribe-newsgroup-method' determines
how new groups will be entered into the group buffer."
- (interactive "p")
+ (interactive "p" gnus-browse-mode)
(when (eobp)
(error "No group at current line"))
(let ((ward (if (< arg 0) -1 1))
(arg (abs arg)))
(while (and (> arg 0)
(not (eobp))
- (gnus-browse-unsubscribe-group)
+ (gnus-browse-toggle-subscription)
(zerop (gnus-browse-next-group ward)))
(cl-decf arg))
(gnus-group-position-point)
@@ -961,7 +968,7 @@ how new groups will be entered into the group buffer."
(defun gnus-browse-describe-group (group)
"Describe the current group."
- (interactive (list (gnus-browse-group-name)))
+ (interactive (list (gnus-browse-group-name)) gnus-browse-mode)
(gnus-group-describe-group nil group))
(defun gnus-browse-delete-group (group force)
@@ -970,11 +977,11 @@ If FORCE (the prefix) is non-nil, all the articles in the group will
be deleted. This is \"deleted\" as in \"removed forever from the face
of the Earth\". There is no undo. The user will be prompted before
doing the deletion."
- (interactive (list (gnus-browse-group-name)
- current-prefix-arg))
+ (interactive (list (gnus-browse-group-name) current-prefix-arg)
+ gnus-browse-mode)
(gnus-group-delete-group group force))
-(defun gnus-browse-unsubscribe-group ()
+(defun gnus-browse-toggle-subscription ()
"Toggle subscription of the current group in the browse buffer."
(let ((sub nil)
(buffer-read-only nil)
@@ -1020,7 +1027,7 @@ doing the deletion."
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
- (interactive)
+ (interactive nil gnus-browse-mode)
(when (derived-mode-p 'gnus-browse-mode)
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
@@ -1032,7 +1039,7 @@ doing the deletion."
(defun gnus-browse-describe-briefly ()
"Give a one line description of the group mode commands."
- (interactive)
+ (interactive nil gnus-browse-mode)
(gnus-message 6 "%s"
(substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
@@ -1089,7 +1096,7 @@ Requesting compaction of %s... (this may take a long time)"
(defun gnus-server-toggle-cloud-server ()
"Toggle whether the server under point is replicated in the Emacs Cloud."
- (interactive)
+ (interactive nil gnus-server-mode)
(let ((server (gnus-server-server-name)))
(unless server
(error "No server on the current line"))
@@ -1110,7 +1117,7 @@ Requesting compaction of %s... (this may take a long time)"
(defun gnus-server-set-cloud-method-server ()
"Set the server under point to host the Emacs Cloud."
- (interactive)
+ (interactive nil gnus-server-mode)
(let ((server (gnus-server-server-name)))
(unless server
(error "No server on the current line"))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 1554635a3f2..02bbe19e7fe 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -663,7 +663,6 @@ the first newsgroup."
(defvar mail-sources)
(defvar nnmail-scan-directory-mail-source-once)
(defvar nnmail-split-history)
-(defvar nnmail-spool-file)
(defun gnus-close-all-servers ()
"Close all servers."
@@ -855,7 +854,7 @@ If REGEXP is given, lines that match it will be deleted."
(goto-char (point-max))
;; Make sure that each dribble entry is a single line, so that
;; the "remove" code above works.
- (insert (replace-regexp-in-string "\n" "\\\\n" string) "\n")
+ (insert (string-replace "\n" "\\n" string) "\n")
(bury-buffer gnus-dribble-buffer)
(with-current-buffer gnus-group-buffer
(gnus-group-set-mode-line)))))
@@ -1070,7 +1069,7 @@ With 1 C-u, use the `ask-server' method to query the server for new
groups.
With 2 C-u's, use most complete method possible to query the server
for new groups, and subscribe the new groups as zombies."
- (interactive "p")
+ (interactive "p" gnus-group-mode)
(let* ((gnus-subscribe-newsgroup-method
gnus-subscribe-newsgroup-method)
(check (cond
@@ -1173,7 +1172,7 @@ for new groups, and subscribe the new groups as zombies."
gnus-check-new-newsgroups)
gnus-secondary-select-methods))))
(groups 0)
- group new-newsgroups got-new method hashtb
+ new-newsgroups got-new method hashtb ;; group
gnus-override-subscribe-method)
(unless gnus-killed-hashtb
(gnus-make-hashtable-from-killed))
@@ -1204,14 +1203,14 @@ for new groups, and subscribe the new groups as zombies."
(cond
((eq do-sub 'subscribe)
(cl-incf groups)
- (puthash g-name group gnus-killed-hashtb)
+ (puthash g-name nil gnus-killed-hashtb) ;; group
(gnus-call-subscribe-functions
gnus-subscribe-options-newsgroup-method g-name))
((eq do-sub 'ignore)
nil)
(t
(cl-incf groups)
- (puthash g-name group gnus-killed-hashtb)
+ (puthash g-name nil gnus-killed-hashtb) ;; group
(if gnus-subscribe-hierarchical-interactive
(push g-name new-newsgroups)
(gnus-call-subscribe-functions
@@ -1405,7 +1404,7 @@ newsgroup."
(defun gnus-check-duplicate-killed-groups ()
"Remove duplicates from the list of killed groups."
- (interactive)
+ (interactive nil gnus-group-mode)
(let ((killed gnus-killed-list))
(while killed
(gnus-message 9 "%d" (length killed))
@@ -2379,6 +2378,11 @@ If FORCE is non-nil, the .newsrc file is read."
(unless (gnus-yes-or-no-p (concat errmsg "; continue? "))
(error "%s" errmsg)))))))))
+;; IIUC these 3 vars were used in older .newsrc files.
+(defvar gnus-killed-assoc)
+(defvar gnus-marked-assoc)
+(defvar gnus-newsrc-assoc)
+
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
(when (file-exists-p ding-file)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 456e7b0f8c4..856e95c0ba0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -73,18 +73,10 @@
(eval-when-compile
(require 'subr-x))
-(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil
+ '(gnus-summary-mode))
(autoload 'gnus-cache-write-active "gnus-cache")
-(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
-(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
(autoload 'gnus-pick-line-number "gnus-salt" nil t)
-(autoload 'mm-uu-dissect "mm-uu")
-(autoload 'gnus-article-outlook-deuglify-article "deuglify"
- "Deuglify broken Outlook (Express) articles and redisplay."
- t)
-(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
-(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
-(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
(autoload 'nnselect-article-rsv "nnselect" nil nil)
(autoload 'nnselect-article-group "nnselect" nil nil)
(autoload 'gnus-nnselect-group-p "nnselect" nil nil)
@@ -887,8 +879,9 @@ this reverses the sort order.
Ready-made functions include `gnus-article-sort-by-number',
`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
-`gnus-article-sort-by-date', `gnus-article-sort-by-random'
-and `gnus-article-sort-by-score'.
+`gnus-article-sort-by-date', `gnus-article-sort-by-score',
+`gnus-article-sort-by-rsv', `gnus-article-sort-by-newsgroups',
+and `gnus-article-sort-by-random'.
When threading is turned on, the variable `gnus-thread-sort-functions'
controls how articles are sorted."
@@ -900,6 +893,7 @@ controls how articles are sorted."
(function-item gnus-article-sort-by-date)
(function-item gnus-article-sort-by-score)
(function-item gnus-article-sort-by-rsv)
+ (function-item gnus-article-sort-by-newsgroups)
(function-item gnus-article-sort-by-random)
(function :tag "other"))
(boolean :tag "Reverse order"))))
@@ -924,8 +918,8 @@ Ready-made functions include `gnus-thread-sort-by-number',
`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
-`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
-and `gnus-thread-sort-by-total-score' (see
+`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-newsgroups',
+`gnus-thread-sort-by-random', and `gnus-thread-sort-by-total-score' (see
`gnus-thread-score-function').
When threading is turned off, the variable
@@ -946,6 +940,7 @@ subthreads, customize `gnus-subthread-sort-functions'."
(function-item gnus-thread-sort-by-rsv)
(function-item gnus-thread-sort-by-most-recent-number)
(function-item gnus-thread-sort-by-most-recent-date)
+ (function-item gnus-thread-sort-by-newsgroups)
(function-item gnus-thread-sort-by-random)
(function-item gnus-thread-sort-by-total-score)
(function :tag "other"))
@@ -969,6 +964,7 @@ according to the value of `gnus-thread-sort-functions'."
(function-item gnus-thread-sort-by-score)
(function-item gnus-thread-sort-by-most-recent-number)
(function-item gnus-thread-sort-by-most-recent-date)
+ (function-item gnus-thread-sort-by-newsgroups)
(function-item gnus-thread-sort-by-random)
(function-item gnus-thread-sort-by-total-score)
(function :tag "other"))
@@ -1984,6 +1980,8 @@ increase the score of each group you read."
"\C-c\C-s\C-i" gnus-summary-sort-by-score
"\C-c\C-s\C-o" gnus-summary-sort-by-original
"\C-c\C-s\C-r" gnus-summary-sort-by-random
+ "\C-c\C-s\C-u" gnus-summary-sort-by-newsgroups
+ "\C-c\C-s\C-x" gnus-summary-sort-by-extra
"=" gnus-summary-expand-window
"\C-x\C-s" gnus-summary-reselect-current-group
"\M-g" gnus-summary-rescan-group
@@ -2525,6 +2523,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
(let ((gnus-summary-show-article-charset-alist
`((1 . ,cs))))
(gnus-summary-show-article 1))))
+ (function-put command 'completion-predicate #'ignore)
`[,(symbol-name cs) ,command t]))
(sort (coding-system-list) #'string<)))))
("Washing"
@@ -2781,7 +2780,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
["Hide marked" gnus-summary-limit-exclude-marks t]
["Show expunged" gnus-summary-limit-include-expunged t])
("Process Mark"
- ["Set mark" gnus-summary-mark-as-processable t]
+ ["Toggle/Set mark" gnus-summary-mark-as-processable t]
["Remove mark" gnus-summary-unmark-as-processable t]
["Remove all marks" gnus-summary-unmark-all-processable t]
["Invert marks" gnus-uu-invert-processable t]
@@ -2838,6 +2837,8 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
["Sort by lines" gnus-summary-sort-by-lines t]
["Sort by characters" gnus-summary-sort-by-chars t]
["Sort by marks" gnus-summary-sort-by-marks t]
+ ["Sort by newsgroup" gnus-summary-sort-by-newsgroups t]
+ ["Sort by extra" gnus-summary-sort-by-extra t]
["Randomize" gnus-summary-sort-by-random t]
["Original sort" gnus-summary-sort-by-original t])
("Help"
@@ -3149,6 +3150,7 @@ buffer; read the Info manual for more information (`\\[gnus-info-find-node]').
The following commands are available:
\\{gnus-summary-mode-map}"
+ :interactive nil
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
(gnus-summary-make-local-variables))
(gnus-summary-make-local-variables)
@@ -3479,7 +3481,7 @@ marks of articles."
;; Various summary mode internalish functions.
(defun gnus-mouse-pick-article (e)
- (interactive "e")
+ (interactive "e" gnus-summary-mode)
(mouse-set-point e)
(gnus-summary-next-page nil t))
@@ -4219,7 +4221,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(defun gnus-summary-prepare ()
"Generate the summary buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(setq gnus-newsgroup-data nil
@@ -4268,7 +4270,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(defun gnus-summary-simplify-subject-query ()
"Query where the respool algorithm would put this article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject))))
@@ -5081,17 +5083,17 @@ using some other form will lead to serious barfage."
(gnus-article-sort-by-author
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-extract-extra (name header)
+ (let ((extract
+ (funcall gnus-extract-address-components
+ (or (cdr (assq name (mail-header-extra header)))
+ ""))))
+ (or (car extract) (cadr extract))))
+
(defsubst gnus-article-sort-by-recipient (h1 h2)
"Sort articles by recipient."
- (gnus-string<
- (let ((extract (funcall
- gnus-extract-address-components
- (or (cdr (assq 'To (mail-header-extra h1))) ""))))
- (or (car extract) (cadr extract)))
- (let ((extract (funcall
- gnus-extract-address-components
- (or (cdr (assq 'To (mail-header-extra h2))) ""))))
- (or (car extract) (cadr extract)))))
+ (let ((ex (lambda (h) (gnus-article-sort-extract-extra 'To h))))
+ (gnus-string< (funcall ex h1) (funcall ex h2))))
(defun gnus-thread-sort-by-recipient (h1 h2)
"Sort threads by root recipient."
@@ -5186,6 +5188,16 @@ Unscored articles will be counted as having a score of zero."
"Sort threads such that the thread with the most recently dated article comes first."
(> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
+(defsubst gnus-article-sort-by-newsgroups (h1 h2)
+ "Sort articles by newsgroups."
+ (let ((ex (lambda (h) (gnus-article-sort-extract-extra 'Newsgroups h))))
+ (gnus-string< (funcall ex h1) (funcall ex h2))))
+
+(defun gnus-thread-sort-by-newsgroups (h1 h2)
+ "Sort threads by root newsgroups."
+ (gnus-article-sort-by-newsgroups
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
; Since this is called not only to sort the top-level threads, but
; also in recursive sorts to order the articles within a thread, each
; article will be processed many times. Thus it speeds things up
@@ -5682,9 +5694,9 @@ or a straight list of headers."
(or dependencies
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-dependencies))))
- (delq nil (mapcar #'(lambda (header)
- (gnus-dependencies-add-header
- header dependencies force-new))
+ (delq nil (mapcar (lambda (header)
+ (gnus-dependencies-add-header
+ header dependencies force-new))
gnus-headers-retrieved-by)))))
(gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
@@ -5983,14 +5995,15 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(input
(read-string
(if only-read-p
- (format
- "How many articles from %s (available %d, default %d): "
- (gnus-group-real-name gnus-newsgroup-name)
- number default)
- (format
- "How many articles from %s (%d default): "
- (gnus-group-real-name gnus-newsgroup-name)
- default))
+ (format-prompt
+ "How many articles from %s (available %d)"
+ default
+ (gnus-group-real-name gnus-newsgroup-name)
+ number)
+ (format-prompt
+ "How many articles from %s"
+ default
+ (gnus-group-real-name gnus-newsgroup-name)))
nil
nil
(number-to-string default))))
@@ -6360,9 +6373,9 @@ The resulting hash table is returned, or nil if no Xrefs were found."
;; First peel off all invalid article numbers.
(when active
(let ((ids articles)
- id first)
+ id) ;; first
(while (setq id (pop ids))
- (when (and first (> id (cdr active)))
+ (when nil ;; (and first (> id (cdr active)))
;; We'll end up in this situation in one particular
;; obscure situation. If you re-scan a group and get
;; a new article that is cross-posted to a different
@@ -6671,19 +6684,19 @@ executed with point over the summary line of the articles."
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
- (interactive)
+ (interactive nil gnus-summary-mode)
(push (copy-sequence gnus-newsgroup-processable)
gnus-newsgroup-process-stack))
(defun gnus-summary-kill-process-mark ()
"Push the current set of process marked articles on the stack and unmark."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-save-process-mark)
(gnus-summary-unmark-all-processable))
(defun gnus-summary-yank-process-mark ()
"Pop the last process mark state off the stack and restore it."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-newsgroup-process-stack
(error "Empty mark stack"))
(gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
@@ -6818,7 +6831,7 @@ articles with that subject. If BACKWARD, search backward instead."
(defun gnus-recenter (&optional n)
"Center point in window and redisplay frame.
Also do horizontal recentering."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when (and gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
@@ -6852,7 +6865,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
- (interactive)
+ (interactive nil gnus-summary-mode)
;; The user has to want it.
(when gnus-auto-center-summary
(let* ((top (cond ((< (window-height) 4) 0)
@@ -7029,7 +7042,7 @@ displayed, no centering will be performed."
"Reconfigure windows to show the article buffer.
If `gnus-widen-article-window' is set, show only the article
buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
(or (get-buffer-window gnus-article-buffer)
@@ -7052,7 +7065,7 @@ buffer."
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((articles (gnus-summary-work-articles arg))
func article)
(if (eq
@@ -7073,7 +7086,7 @@ buffer."
(gnus-summary-position-point))
(define-obsolete-function-alias
- 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1")
+ 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1")
(defun gnus-summary-find-for-reselect ()
"Return the number of an article to stay on across a reselect.
@@ -7095,7 +7108,7 @@ insertion from another group. If there's no such then return a dummy 0."
(defun gnus-summary-reselect-current-group (&optional all rescan)
"Exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-find-for-reselect))
@@ -7113,7 +7126,7 @@ The prefix argument ALL means to select all articles."
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((config gnus-current-window-configuration))
(gnus-summary-reselect-current-group all t)
(gnus-configure-windows config)
@@ -7168,7 +7181,7 @@ The prefix argument ALL means to select all articles."
(defun gnus-summary-make-group-from-search ()
"Make a persistent group from the current ephemeral search group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(if (not (gnus-nnselect-group-p gnus-newsgroup-name))
(gnus-message 3 "%s is not a search group" gnus-newsgroup-name)
(let ((name (gnus-read-group "Group name: ")))
@@ -7185,7 +7198,7 @@ The prefix argument ALL means to select all articles."
"Save the current number of read/marked articles in the dribble buffer.
The dribble buffer will then be saved.
If FORCE (the prefix), also save the .newsrc file(s)."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-update-info t)
(if force
(gnus-save-newsrc-file)
@@ -7197,7 +7210,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-set-global-variables)
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
@@ -7303,7 +7316,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
(defun gnus-summary-exit-no-update (&optional no-questions)
"Quit reading current newsgroup without updating read article info."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((group gnus-newsgroup-name)
(gnus-group-is-exiting-p t)
(gnus-group-is-exiting-without-update-p t)
@@ -7457,7 +7470,7 @@ The state which existed when entering the ephemeral is reset."
(defun gnus-summary-wake-up-the-dead (&rest _)
"Wake up the dead summary buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-dead-summary-mode -1)
(let ((name (buffer-name)))
(when (string-match "Dead " name)
@@ -7470,12 +7483,12 @@ The state which existed when entering the ephemeral is reset."
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (&optional force)
"Describe the current newsgroup."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-group-describe-group force gnus-newsgroup-name))
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
@@ -7485,7 +7498,7 @@ The state which existed when entering the ephemeral is reset."
If prefix argument NO-ARTICLE is non-nil, no article is selected
initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
previous group instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
;; Stop pre-fetching.
(gnus-async-halt-prefetch)
(let ((current-group gnus-newsgroup-name)
@@ -7531,7 +7544,7 @@ previous group instead."
(defun gnus-summary-prev-group (&optional no-article)
"Exit current newsgroup and then select previous unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-next-group no-article nil t))
;; Walking around summary lines.
@@ -7542,7 +7555,7 @@ If UNREAD is non-nil, the article should be unread.
If UNDOWNLOADED is non-nil, the article should be undownloaded.
If UNSEEN is non-nil, the article should be unseen as well as unread.
Returns the article selected or nil if there are no matching articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(cond
;; Empty summary.
((null gnus-newsgroup-data)
@@ -7594,7 +7607,7 @@ If N is negative, go to the previous N'th subject line.
If UNREAD is non-nil, only unread articles are selected.
The difference between N and the actual number of steps taken is
returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -7613,18 +7626,18 @@ returned."
(defun gnus-summary-next-unread-subject (n)
"Go to next N'th unread summary line."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-subject n t))
(defun gnus-summary-prev-subject (n &optional unread)
"Go to previous N'th summary line.
If optional argument UNREAD is non-nil, only unread article is selected."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-subject (- n) unread))
(defun gnus-summary-prev-unread-subject (n)
"Go to previous N'th unread summary line."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-subject (- n) t))
(defun gnus-summary-goto-subjects (articles)
@@ -7638,7 +7651,7 @@ If optional argument UNREAD is non-nil, only unread article is selected."
(defun gnus-summary-goto-subject (article &optional force silent)
"Go to the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
- (interactive "nArticle number: ")
+ (interactive "nArticle number: " gnus-summary-mode)
(unless (numberp article)
(error "Article %s is not a number" article))
(let ((b (point))
@@ -7668,7 +7681,7 @@ If FORCE, also allow jumping to articles not currently shown."
(defun gnus-summary-expand-window (&optional arg)
"Make the summary buffer take up the entire Emacs frame.
Given a prefix, will force an `article' buffer configuration."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if arg
(gnus-configure-windows 'article 'force)
(gnus-configure-windows 'summary 'force)))
@@ -7751,7 +7764,7 @@ be displayed."
(defun gnus-summary-force-verify-and-decrypt ()
"Display buttons for signed/encrypted parts and verify/decrypt them."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(gnus-article-emulate-mime t)
@@ -7765,7 +7778,7 @@ be displayed."
If UNREAD, only unread articles are selected.
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
;; Make sure we are in the summary buffer.
(unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
@@ -7877,7 +7890,7 @@ If BACKWARD, the previous article is selected instead of the next."
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-last-article-p (gnus-summary-article-number)))
@@ -7887,12 +7900,12 @@ If BACKWARD, the previous article is selected instead of the next."
(defun gnus-summary-prev-article (&optional unread subject)
"Select the article before the current one.
If UNREAD is non-nil, only unread articles are selected."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-next-article unread subject t))
(defun gnus-summary-prev-unread-article ()
"Select unread article before current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-prev-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-first-article-p (gnus-summary-article-number)))
@@ -7913,7 +7926,7 @@ article.
If STOP is non-nil, just stop when reaching the end of the message.
Also see the variable `gnus-article-skip-boring'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-set-global-variables)
(let ((article (gnus-summary-article-number))
(article-window (get-buffer-window gnus-article-buffer t))
@@ -7958,7 +7971,7 @@ Also see the variable `gnus-article-skip-boring'."
Argument LINES specifies lines to be scrolled down.
If MOVE, move to the previous unread article if point is at
the beginning of the buffer."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((article (gnus-summary-article-number))
(article-window (get-buffer-window gnus-article-buffer t))
endp)
@@ -7988,14 +8001,14 @@ the beginning of the buffer."
"Show previous page of selected article.
Argument LINES specifies lines to be scrolled down.
If at the beginning of the article, go to the next article."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-prev-page lines t))
(defun gnus-summary-scroll-up (lines)
"Scroll up (or down) one line current article.
Argument LINES specifies lines to be scrolled up (or down if negative).
If no article is selected, then the current article will be selected first."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
@@ -8012,33 +8025,33 @@ If no article is selected, then the current article will be selected first."
"Scroll down (or up) one line current article.
Argument LINES specifies lines to be scrolled down (or up if negative).
If no article is selected, then the current article will be selected first."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-scroll-up (- lines)))
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-article nil (gnus-summary-article-subject)))
(defun gnus-summary-prev-same-subject ()
"Select previous article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-prev-article nil (gnus-summary-article-subject)))
(defun gnus-summary-next-unread-same-subject ()
"Select next unread article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-article t (gnus-summary-article-subject)))
(defun gnus-summary-prev-unread-same-subject ()
"Select previous unread article which has the same subject as current one."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-prev-article t (gnus-summary-article-subject)))
(defun gnus-summary-first-unread-article ()
"Select the first unread article.
Return nil if there are no unread articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
@@ -8049,7 +8062,7 @@ Return nil if there are no unread articles."
(defun gnus-summary-first-unread-subject ()
"Place the point on the subject line of the first unread article.
Return nil if there are no unread articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
@@ -8058,7 +8071,7 @@ Return nil if there are no unread articles."
(defun gnus-summary-next-unseen-article (&optional backward)
"Select the next unseen article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((article (gnus-summary-article-number))
(articles (gnus-data-find-list article (gnus-data-list backward))))
(when (or (not gnus-summary-check-current)
@@ -8079,13 +8092,13 @@ Return nil if there are no unread articles."
(defun gnus-summary-prev-unseen-article ()
"Select the previous unseen article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-next-unseen-article t))
(defun gnus-summary-first-unseen-subject ()
"Place the point on the subject line of the first unseen article.
Return nil if there are no unseen articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject nil nil t)
(gnus-summary-show-thread)
@@ -8094,9 +8107,9 @@ Return nil if there are no unseen articles."
(defun gnus-summary-first-unseen-or-unread-subject ()
"Place the point on the subject line of the first unseen and unread article.
-If all article have been seen, on the subject line of the first unread
+If all articles have been seen, on the subject line of the first unread
article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(unless (when (gnus-summary-first-subject nil nil t)
(gnus-summary-show-thread)
@@ -8109,7 +8122,7 @@ article."
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when (gnus-summary-first-subject)
(gnus-summary-show-thread)
@@ -8121,7 +8134,7 @@ Return nil if there are no articles."
"Select the unread article with the highest score.
If given a prefix argument, select the next unread article that has a
score higher than the default score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((article (if arg
(gnus-summary-better-unread-subject)
(gnus-summary-best-unread-subject))))
@@ -8131,7 +8144,7 @@ score higher than the default score."
(defun gnus-summary-best-unread-subject ()
"Select the unread subject with the highest score."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((best -1000000)
(data gnus-newsgroup-data)
article score)
@@ -8150,7 +8163,7 @@ score higher than the default score."
(defun gnus-summary-better-unread-subject ()
"Select the first unread subject that has a score over the default score."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((data gnus-newsgroup-data)
article)
(while (and (setq article (gnus-data-number (car data)))
@@ -8176,11 +8189,10 @@ If FORCE, go to the article even if it isn't displayed. If FORCE
is a number, it is the line the article is to be displayed on."
(interactive
(list
- (gnus-completing-read
- "Article number or Message-ID"
- (mapcar #'int-to-string gnus-newsgroup-limit))
- current-prefix-arg
- t))
+ (gnus-completing-read "Article number or Message-ID"
+ (mapcar #'int-to-string gnus-newsgroup-limit))
+ current-prefix-arg t)
+ gnus-summary-mode)
(prog1
(if (and (stringp article)
(string-match "@\\|%40" article))
@@ -8194,7 +8206,7 @@ is a number, it is the line the article is to be displayed on."
(defun gnus-summary-goto-last-article ()
"Go to the previously read article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(when gnus-last-article
(gnus-summary-goto-article gnus-last-article nil t))
@@ -8203,7 +8215,7 @@ is a number, it is the line the article is to be displayed on."
(defun gnus-summary-pop-article (number)
"Pop one article off the history and go to the previous.
NUMBER articles will be popped off."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let (to)
(setq gnus-newsgroup-history
(cdr (setq to (nthcdr number gnus-newsgroup-history))))
@@ -8217,7 +8229,7 @@ NUMBER articles will be popped off."
(defun gnus-summary-limit-to-articles (n)
"Limit the summary buffer to the next N articles.
If not given a prefix, use the process marked articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(prog1
(let ((articles (gnus-summary-work-articles n)))
(setq gnus-newsgroup-processable nil)
@@ -8227,7 +8239,7 @@ If not given a prefix, use the process marked articles instead."
(defun gnus-summary-pop-limit (&optional total)
"Restore the previous limit.
If given a prefix, remove all limits."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when total
(setq gnus-newsgroup-limits
(list (mapcar #'mail-header-number gnus-newsgroup-headers))))
@@ -8241,10 +8253,11 @@ If given a prefix, remove all limits."
"Limit the summary buffer to articles that have subjects that match a regexp.
If NOT-MATCHING, excluding articles that have subjects that match a regexp."
(interactive
- (list (read-string (if current-prefix-arg
- "Exclude subject (regexp): "
- "Limit to subject (regexp): "))
- nil current-prefix-arg))
+ (list
+ (read-string
+ (if current-prefix-arg "Exclude subject (regexp): " "Limit to subject (regexp): "))
+ nil current-prefix-arg)
+ gnus-summary-mode)
(unless header
(setq header "subject"))
(when (not (equal "" subject))
@@ -8252,7 +8265,7 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp."
(let ((articles (gnus-summary-find-matching
(or header "subject") subject 'all nil nil
not-matching)))
- (unless articles
+ (unless (or articles not-matching)
(error "Found no matches for \"%s\"" subject))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
@@ -8261,18 +8274,25 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp."
"Limit the summary buffer to articles that have authors that match a regexp.
If NOT-MATCHING, excluding articles that have authors that match a regexp."
(interactive
- (list (let* ((header (gnus-summary-article-header))
- (default (and header (car (mail-header-parse-address
- (mail-header-from header))))))
- (read-string (concat (if current-prefix-arg
- "Exclude author (regexp"
- "Limit to author (regexp")
- (if default
- (concat ", default \"" default "\"): ")
- "): "))
- nil nil
- default))
- current-prefix-arg))
+ (list
+ (let*
+ ((header
+ (gnus-summary-article-header))
+ (default
+ (and header
+ (car
+ (mail-header-parse-address
+ (mail-header-from header))))))
+ (read-string
+ (concat
+ (if current-prefix-arg
+ "Exclude author (regexp" "Limit to author (regexp")
+ (if default
+ (concat ", default \"" default "\"): ")
+ "): "))
+ nil nil default))
+ current-prefix-arg)
+ gnus-summary-mode)
(gnus-summary-limit-to-subject from "from" not-matching))
(defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
@@ -8284,9 +8304,12 @@ To and Cc headers are checked. You need to include them in
`nnmail-extra-headers'."
;; Unlike `rmail-summary-by-recipients', doesn't include From.
(interactive
- (list (read-string (format "%s recipient (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")))
- current-prefix-arg))
+ (list
+ (read-string
+ (format "%s recipient (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg)
+ gnus-summary-mode)
(when (not (equal "" recipient))
(prog1 (let* ((to
(if (memq 'To nnmail-extra-headers)
@@ -8313,7 +8336,7 @@ To and Cc headers are checked. You need to include them in
(and (memq a to) a))
cc)
(nconc to cc))))
- (unless articles
+ (unless (or articles not-matching)
(error "Found no matches for \"%s\"" recipient))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
@@ -8326,9 +8349,12 @@ If NOT-MATCHING, exclude ADDRESS.
To, Cc and From headers are checked. You need to include `To' and `Cc'
in `nnmail-extra-headers'."
(interactive
- (list (read-string (format "%s address (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")))
- current-prefix-arg))
+ (list
+ (read-string
+ (format "%s address (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg)
+ gnus-summary-mode)
(when (not (equal "" address))
(prog1 (let* ((to
(if (memq 'To nnmail-extra-headers)
@@ -8366,7 +8392,7 @@ in `nnmail-extra-headers'."
(nconc (if (eq to t) nil to)
(if (eq cc t) nil cc)
from))))
- (unless articles
+ (unless (or articles not-matching)
(error "Found no matches for \"%s\"" address))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
@@ -8415,7 +8441,8 @@ articles that are younger than AGE days."
(setq days (* days -1))))
(message "Please enter a number.")
(sleep-for 1)))
- (list days younger)))
+ (list days younger))
+ gnus-summary-mode)
(prog1
(let ((data gnus-newsgroup-data)
(cutoff (days-to-time age))
@@ -8439,30 +8466,31 @@ articles that are younger than AGE days."
(let ((header
(intern
(gnus-completing-read
- (if current-prefix-arg
- "Exclude extra header"
- "Limit extra header")
+ (if current-prefix-arg "Exclude extra header" "Limit extra header")
(mapcar #'symbol-name gnus-extra-headers)
t nil nil
- (symbol-name (car gnus-extra-headers))))))
+ (symbol-name
+ (car gnus-extra-headers))))))
(list header
- (read-string (format "%s header %s (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")
- header))
- current-prefix-arg)))
+ (read-string
+ (format "%s header %s (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")
+ header))
+ current-prefix-arg))
+ gnus-summary-mode)
(when (not (equal "" regexp))
(prog1
(let ((articles (gnus-summary-find-matching
(cons 'extra header) regexp 'all nil nil
not-matching)))
- (unless articles
+ (unless (or articles not-matching)
(error "Found no matches for \"%s\"" regexp))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
(defun gnus-summary-limit-to-display-predicate ()
"Limit the summary buffer to the predicated in the `display' group parameter."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-newsgroup-display
(error "There is no `display' group parameter"))
(let (articles)
@@ -8475,7 +8503,7 @@ articles that are younger than AGE days."
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
If ALL is non-nil, limit strictly to unread articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if all
(gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
(gnus-summary-limit-to-marks
@@ -8491,7 +8519,7 @@ If ALL is non-nil, limit strictly to unread articles."
(defun gnus-summary-limit-to-headers (match &optional reverse)
"Limit the summary buffer to articles that have headers that match MATCH.
If REVERSE (the prefix), limit to articles that don't match."
- (interactive "sMatch headers (regexp): \nP")
+ (interactive "sMatch headers (regexp): \nP" gnus-summary-mode)
(gnus-summary-limit-to-bodies match reverse t))
(declare-function article-goto-body "gnus-art" ())
@@ -8499,7 +8527,7 @@ If REVERSE (the prefix), limit to articles that don't match."
(defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
"Limit the summary buffer to articles that have bodies that match MATCH.
If REVERSE (the prefix), limit to articles that don't match."
- (interactive "sMatch body (regexp): \nP")
+ (interactive "sMatch body (regexp): \nP" gnus-summary-mode)
(let ((articles nil)
(gnus-select-article-hook nil) ;Disable hook.
(gnus-article-prepare-hook nil)
@@ -8532,7 +8560,7 @@ If REVERSE (the prefix), limit to articles that don't match."
(defun gnus-summary-limit-to-singletons (&optional threadsp)
"Limit the summary buffer to articles that aren't part on any thread.
If THREADSP (the prefix), limit to articles that are in threads."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((articles nil)
thread-articles
threads)
@@ -8556,11 +8584,12 @@ If THREADSP (the prefix), limit to articles that are in threads."
(defun gnus-summary-limit-to-replied (&optional unreplied)
"Limit the summary buffer to replied articles.
If UNREPLIED (the prefix), limit to unreplied articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if unreplied
(gnus-summary-limit
- (gnus-set-difference gnus-newsgroup-articles
- gnus-newsgroup-replied))
+ (seq-difference gnus-newsgroup-articles
+ gnus-newsgroup-replied
+ #'eq))
(gnus-summary-limit gnus-newsgroup-replied))
(gnus-summary-position-point))
@@ -8569,7 +8598,7 @@ If UNREPLIED (the prefix), limit to unreplied articles."
If REVERSE, limit the summary buffer to articles that are marked
with MARKS. MARKS can either be a string of marks or a list of marks.
Returns how many articles were removed."
- (interactive "sMarks: ")
+ (interactive "sMarks: " gnus-summary-mode)
(gnus-summary-limit-to-marks marks t))
(defun gnus-summary-limit-to-marks (marks &optional reverse)
@@ -8578,7 +8607,7 @@ If REVERSE (the prefix), limit the summary buffer to articles that are
not marked with MARKS. MARKS can either be a string of marks or a
list of marks.
Returns how many articles were removed."
- (interactive "sMarks: \nP")
+ (interactive "sMarks: \nP" gnus-summary-mode)
(prog1
(let ((data gnus-newsgroup-data)
(marks (if (listp marks) marks
@@ -8597,10 +8626,13 @@ Returns how many articles were removed."
With a prefix argument, limit to articles with score at or below
SCORE."
- (interactive (list (string-to-number
- (read-string
- (format "Limit to articles with score of at %s: "
- (if current-prefix-arg "most" "least"))))))
+ (interactive
+ (list
+ (string-to-number
+ (read-string
+ (format "Limit to articles with score of at %s: "
+ (if current-prefix-arg "most" "least")))))
+ gnus-summary-mode)
(let ((data gnus-newsgroup-data)
(compare (if (or below current-prefix-arg) #'<= #'>=))
articles)
@@ -8616,7 +8648,7 @@ SCORE."
(defun gnus-summary-limit-to-unseen ()
"Limit to unseen articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(gnus-summary-limit gnus-newsgroup-unseen)
(gnus-summary-position-point)))
@@ -8626,8 +8658,12 @@ SCORE."
When called interactively, ID is the Message-ID of the current
article. If thread-only is non-nil limit the summary buffer to
these articles."
- (interactive (list (mail-header-id (gnus-summary-article-header))
- current-prefix-arg))
+ (interactive
+ (list
+ (mail-header-id
+ (gnus-summary-article-header))
+ current-prefix-arg)
+ gnus-summary-mode)
(let ((articles (gnus-articles-in-thread
(gnus-id-to-thread (gnus-root-id id))))
;;we REALLY want the whole thread---this prevents cut-threads
@@ -8653,8 +8689,11 @@ these articles."
(defun gnus-summary-limit-include-matching-articles (header regexp)
"Display all the hidden articles that have HEADERs that match REGEXP."
- (interactive (list (read-string "Match on header: ")
- (read-string "Regexp: ")))
+ (interactive
+ (list
+ (read-string "Match on header: ")
+ (read-string "Regexp: "))
+ gnus-summary-mode)
(let ((articles (gnus-find-matching-articles header regexp)))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
@@ -8662,7 +8701,7 @@ these articles."
(defun gnus-summary-insert-dormant-articles ()
"Insert all the dormant articles for this group into the current buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-dormant)
(gnus-message 3 "No dormant articles for this group")
@@ -8670,7 +8709,7 @@ these articles."
(defun gnus-summary-insert-ticked-articles ()
"Insert ticked articles for this group into the current buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-marked)
(gnus-message 3 "No ticked articles for this group")
@@ -8680,7 +8719,7 @@ these articles."
"Display all the hidden articles that are marked as dormant.
Note that this command only works on a subset of the articles currently
fetched for this group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-newsgroup-dormant
(error "There are no dormant articles in this group"))
(prog1
@@ -8703,14 +8742,14 @@ fetched for this group."
(defun gnus-summary-limit-exclude-dormant ()
"Hide all dormant articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(prog1
(gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
(gnus-summary-position-point)))
(defun gnus-summary-limit-exclude-childless-dormant ()
"Hide all dormant articles that have no children."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((data (gnus-data-list t))
articles d children)
;; Find all articles that are either not dormant or have
@@ -8735,7 +8774,7 @@ fetched for this group."
(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
"Mark all unread excluded articles as read.
If ALL, mark even excluded ticked and dormants as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<))
(let ((articles (gnus-sorted-ndifference
(sort
@@ -8974,7 +9013,7 @@ fetch-old-headers verbiage, and so on."
"Refer parent article N times.
If N is negative, go to ancestor -N instead.
The difference between N and the number of articles fetched is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((skip 1)
error header ref)
(when (not (natnump n))
@@ -9016,7 +9055,7 @@ The difference between N and the number of articles fetched is returned."
(defun gnus-summary-refer-references ()
"Fetch all articles mentioned in the References header.
Return the number of articles fetched."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((ref (mail-header-references (gnus-summary-article-header)))
(current (gnus-summary-article-number))
(n 0))
@@ -9059,7 +9098,7 @@ has the reverse meaning. If no backend-specific `request-thread'
function is available fetch LIMIT (the numerical prefix) old
headers. If LIMIT is non-numeric or nil fetch the number
specified by the `gnus-refer-thread-limit' variable."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let* ((header (gnus-summary-article-header))
(id (mail-header-id header))
(gnus-inhibit-demon t)
@@ -9114,7 +9153,7 @@ specified by the `gnus-refer-thread-limit' variable."
(defun gnus-summary-open-group-with-article (message-id)
"Open a group containing the article with the given MESSAGE-ID."
- (interactive "sMessage-ID: ")
+ (interactive "sMessage-ID: " gnus-summary-mode)
(require 'nndoc)
(with-temp-buffer
;; Prepare a dummy article
@@ -9149,10 +9188,10 @@ specified by the `gnus-refer-thread-limit' variable."
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
+ (interactive "sMessage-ID: " gnus-summary-mode)
(when (and (stringp message-id)
(not (zerop (length message-id))))
- (setq message-id (replace-regexp-in-string " " "" message-id))
+ (setq message-id (string-replace " " "" message-id))
;; Construct the correct Message-ID if necessary.
;; Suggested by tale@pawl.rpi.edu.
(unless (string-match "^<" message-id)
@@ -9160,7 +9199,7 @@ specified by the `gnus-refer-thread-limit' variable."
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
;; People often post MIDs from URLs, so unhex it:
- (unless (string-match "@" message-id)
+ (unless (string-search "@" message-id)
(setq message-id (gnus-url-unhex-string message-id)))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
@@ -9222,12 +9261,12 @@ specified by the `gnus-refer-thread-limit' variable."
(defun gnus-summary-edit-parameters ()
"Edit the group parameters of the current group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-group-edit-group gnus-newsgroup-name 'params))
(defun gnus-summary-customize-parameters ()
"Customize the group parameters of the current group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-group-customize gnus-newsgroup-name))
(defun gnus-summary-enter-digest-group (&optional force)
@@ -9237,7 +9276,7 @@ what the document format is.
To control what happens when you exit the group, see the
`gnus-auto-select-on-ephemeral-exit' variable."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((conf gnus-current-window-configuration))
(save-window-excursion
(save-excursion
@@ -9322,7 +9361,7 @@ To control what happens when you exit the group, see the
This will allow you to read digests and other similar
documents as newsgroups.
Obeys the standard process/prefix convention."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let* ((ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))))
@@ -9371,7 +9410,7 @@ Obeys the standard process/prefix convention."
(defun gnus-summary-button-forward (arg)
"Move point to the next field or button in the article.
With optional ARG, move across that many fields."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(let ((win (or (gnus-get-buffer-window gnus-article-buffer t)
@@ -9385,7 +9424,7 @@ With optional ARG, move across that many fields."
(defun gnus-summary-button-backward (arg)
"Move point to the previous field or button in the article.
With optional ARG, move across that many fields."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(let ((win (or (gnus-get-buffer-window gnus-article-buffer t)
@@ -9442,7 +9481,7 @@ If only one link is found, browse that directly, otherwise use
completion to select a link. The first link marked in the
article text with `gnus-collect-urls-primary-text' is the
default."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let (urls target)
(gnus-summary-select-article)
(gnus-with-article-buffer
@@ -9467,7 +9506,7 @@ default."
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9477,14 +9516,14 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(defun gnus-summary-repeat-search-article-forward ()
"Repeat the previous search forwards."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-last-search-regexp
(error "No previous search"))
(gnus-summary-search-article-forward gnus-last-search-regexp))
(defun gnus-summary-repeat-search-article-backward ()
"Repeat the previous search backwards."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless gnus-last-search-regexp
(error "No previous search"))
(gnus-summary-search-article-forward gnus-last-search-regexp t))
@@ -9493,13 +9532,13 @@ If REGEXP-P (the prefix) is non-nil, do regexp isearch."
"Search for an article containing REGEXP forward.
If BACKWARD, search backward instead."
(interactive
- (list (read-string
- (format "Search article %s (regexp%s): "
- (if current-prefix-arg "backward" "forward")
- (if gnus-last-search-regexp
- (concat ", default " gnus-last-search-regexp)
- "")))
- current-prefix-arg))
+ (list
+ (read-string
+ (format-prompt "Search article %s (regexp)"
+ gnus-last-search-regexp
+ (if current-prefix-arg "backward" "forward")))
+ current-prefix-arg)
+ gnus-summary-mode)
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp)
@@ -9514,11 +9553,11 @@ If BACKWARD, search backward instead."
(defun gnus-summary-search-article-backward (regexp)
"Search for an article containing REGEXP backward."
(interactive
- (list (read-string
- (format "Search article backward (regexp%s): "
- (if gnus-last-search-regexp
- (concat ", default " gnus-last-search-regexp)
- "")))))
+ (list
+ (read-string
+ (format-prompt "Search article backward (regexp)"
+ gnus-last-search-regexp)))
+ gnus-summary-mode)
(gnus-summary-search-article-forward regexp 'backward))
(defun gnus-summary-search-article (regexp &optional backward)
@@ -9653,18 +9692,20 @@ that not match REGEXP on HEADER."
If HEADER is an empty string (or nil), the match is done on the entire
article. If BACKWARD (the prefix) is non-nil, search backward instead."
(interactive
- (list (let ((completion-ignore-case t))
- (gnus-completing-read
- "Header name"
- (mapcar #'symbol-name
- (append
- '(Number Subject From Lines Date
- Message-ID Xref References Body)
- gnus-extra-headers))
- 'require-match))
- (read-string "Regexp: ")
- (read-key-sequence "Command: ")
- current-prefix-arg))
+ (list
+ (let ((completion-ignore-case t))
+ (gnus-completing-read
+ "Header name"
+ (mapcar #'symbol-name
+ (append
+ '(Number Subject From Lines Date Message-ID
+ Xref References Body)
+ gnus-extra-headers))
+ 'require-match))
+ (read-string "Regexp: ")
+ (read-key-sequence "Command: ")
+ current-prefix-arg)
+ gnus-summary-mode)
(when (equal header "Body")
(setq header ""))
;; Hidden thread subtrees must be searched as well.
@@ -9688,7 +9729,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead."
(defun gnus-summary-beginning-of-article ()
"Scroll the article back to the beginning."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9699,7 +9740,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead."
(defun gnus-summary-end-of-article ()
"Scroll to the end of the article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9732,7 +9773,9 @@ If the optional first argument FILENAME is nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is a number, prompt the user for the name of the file
to save in."
- (interactive (list (ps-print-preprint current-prefix-arg)))
+ (interactive
+ (list (ps-print-preprint current-prefix-arg))
+ gnus-summary-mode)
(dolist (article (gnus-summary-work-articles n))
(gnus-summary-select-article nil nil 'pseudo article)
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9772,7 +9815,7 @@ to save in."
"Show a complete version of the current article.
This is only useful if you're looking at a partial version of the
article currently."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((gnus-keep-backlog nil)
(gnus-use-cache nil)
(gnus-agent nil)
@@ -9799,7 +9842,7 @@ If ARG (the prefix) is non-nil and not a number, show the article,
but without running any of the article treatment functions
article. Normally, the keystroke is `C-u g'. When using `C-u
C-u g', show the raw article."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(cond
((numberp arg)
(gnus-summary-show-article t)
@@ -9875,14 +9918,14 @@ C-u g', show the raw article."
(defun gnus-summary-show-raw-article ()
"Show the raw article without any article massaging functions being run."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-show-article t))
(defun gnus-summary-verbose-headers (&optional arg)
"Toggle permanent full header display.
If ARG is a positive number, turn header display on.
If ARG is a negative number, turn header display off."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(setq gnus-show-all-headers
(cond ((or (not (numberp arg))
(zerop arg))
@@ -9901,7 +9944,7 @@ If ARG is a negative number, turn header display off."
"Show the headers if they are hidden, or hide them if they are shown.
If ARG is a positive number, show the entire header.
If ARG is a negative number, hide the unwanted header lines."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((window (and (gnus-buffer-live-p gnus-article-buffer)
(get-buffer-window gnus-article-buffer t))))
(with-current-buffer gnus-article-buffer
@@ -9947,14 +9990,14 @@ If ARG is a negative number, hide the unwanted header lines."
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-toggle-header 1))
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
With a non-numerical prefix, also rotate headers. A numerical
prefix specifies how many places to rotate each letter forward."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9977,7 +10020,7 @@ invalid IDNA string (`xn--bar' is invalid).
You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/')
installed for this command to work."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -9991,7 +10034,7 @@ installed for this command to work."
(defun gnus-summary-morse-message (&optional _arg)
"Morse decode the current article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -10012,7 +10055,7 @@ installed for this command to work."
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-select-article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
@@ -10042,7 +10085,7 @@ newsgroup that you want to move to have to support the `request-move'
and `request-accept' functions.
ACTION can be either `move' (the default), `crosspost' or `copy'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(unless action
(setq action 'move))
;; Check whether the source group supports the required functions.
@@ -10348,13 +10391,13 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Copy the current article to some other group.
Arguments have the same meanings as in `gnus-summary-move-article'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-move-article n to-newsgroup select-method 'copy))
(defun gnus-summary-crosspost-article (&optional n)
"Crosspost the current article to some other group.
Arguments have the same meanings as in `gnus-summary-move-article'."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
@@ -10398,7 +10441,8 @@ latter case, they will be copied into the relevant groups."
(t
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
(cdr (assoc (gnus-completing-read "Server name" ms-alist t)
- ms-alist))))))))
+ ms-alist)))))))
+ gnus-summary-mode)
(unless method
(error "No method given for respooling"))
(if (assoc (symbol-name
@@ -10409,7 +10453,7 @@ latter case, they will be copied into the relevant groups."
(defun gnus-summary-import-article (file &optional edit)
"Import an arbitrary file into a mail newsgroup."
- (interactive "fImport file: \nP")
+ (interactive "fImport file: \nP" gnus-summary-mode)
(let ((group gnus-newsgroup-name)
atts lines group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
@@ -10453,7 +10497,7 @@ latter case, they will be copied into the relevant groups."
(defun gnus-summary-create-article ()
"Create an article in a mail newsgroup."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((group gnus-newsgroup-name)
(now (current-time))
group-art)
@@ -10477,7 +10521,7 @@ latter case, they will be copied into the relevant groups."
(defun gnus-summary-article-posted-p ()
"Say whether the current (mail) article is available from news as well.
This will be the case if the article has both been mailed and posted."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((id (mail-header-references (gnus-summary-article-header)))
(gnus-override-method (car (gnus-refer-article-methods))))
(if (gnus-request-head id "")
@@ -10489,7 +10533,7 @@ This will be the case if the article has both been mailed and posted."
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(when (and (not gnus-group-is-exiting-without-update-p)
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name))
@@ -10558,7 +10602,7 @@ This will be the case if the article has both been mailed and posted."
"Expunge all expirable articles in the current group.
This means that *all* articles that are marked as expirable will be
deleted forever, right now."
- (interactive)
+ (interactive nil gnus-summary-mode)
(or gnus-expert-user
(gnus-yes-or-no-p
"Are you really, really sure you want to delete all expirable messages? ")
@@ -10578,7 +10622,7 @@ delete these instead.
If `gnus-novice-user' is non-nil you will be asked for
confirmation before the articles are deleted."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
(error "The current newsgroup does not support article deletion"))
@@ -10628,7 +10672,7 @@ If ARG is 2, edit the raw articles even in read-only groups.
If ARG is 3, edit the articles with the current handles.
Otherwise, allow editing of articles even in read-only
groups."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let (force raw current-handles)
(cond
((null arg))
@@ -10708,7 +10752,7 @@ groups."
(defun gnus-summary-edit-article-done (&optional references read-only buffer
no-highlight)
"Make edits to the current article permanent."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-excursion
;; The buffer restriction contains the entire article if it exists.
(when (article-goto-body)
@@ -10796,7 +10840,8 @@ groups."
(list
(progn
(message "%s" (concat (this-command-keys) "- "))
- (read-char))))
+ (read-char)))
+ gnus-summary-mode)
(message "")
(gnus-summary-edit-article)
(execute-kbd-macro (concat (this-command-keys) key))
@@ -10809,7 +10854,7 @@ groups."
(defun gnus-summary-respool-query (&optional silent trace)
"Query where the respool algorithm would put this article."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let (gnus-mark-article-hook)
(gnus-summary-select-article)
(with-current-buffer gnus-original-article-buffer
@@ -10839,7 +10884,7 @@ groups."
(defun gnus-summary-respool-trace ()
"Trace where the respool algorithm would put this article.
Display a buffer showing all fancy splitting patterns which matched."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-respool-query nil t))
;; Summary marking commands.
@@ -10848,7 +10893,7 @@ Display a buffer showing all fancy splitting patterns which matched."
"Mark articles which has the same subject as read, and then select the next.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
@@ -10866,7 +10911,7 @@ If UNMARK is negative, tick articles."
"Mark articles which has the same subject as read.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
@@ -10916,7 +10961,7 @@ If optional argument UNMARK is negative, mark articles as unread instead."
If N is negative, mark backward instead. If UNMARK is non-nil, remove
the process mark instead. The difference between N and the actual
number of articles marked is returned."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(if (and (null n) (and transient-mark-mode mark-active))
(gnus-uu-mark-region (region-beginning) (region-end) unmark)
(setq n (prefix-numeric-value n))
@@ -10924,10 +10969,14 @@ number of articles marked is returned."
(n (abs n)))
(while (and
(> n 0)
- (if unmark
- (gnus-summary-remove-process-mark
- (gnus-summary-article-number))
- (gnus-summary-set-process-mark (gnus-summary-article-number)))
+ (let ((article (gnus-summary-article-number)))
+ (if unmark
+ (gnus-summary-remove-process-mark article)
+ (if gnus-process-mark-toggle
+ (if (memq article gnus-newsgroup-processable)
+ (gnus-summary-remove-process-mark article)
+ (gnus-summary-set-process-mark article))
+ (gnus-summary-set-process-mark article))))
(zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
(setq n (1- n)))
(when (/= 0 n)
@@ -10940,12 +10989,12 @@ number of articles marked is returned."
"Remove the process mark from the next N articles.
If N is negative, unmark backward instead. The difference between N and
the actual number of articles unmarked is returned."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-as-processable n t))
(defun gnus-summary-unmark-all-processable ()
"Remove the process mark from all articles."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-excursion
(while gnus-newsgroup-processable
(gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
@@ -10969,20 +11018,21 @@ the actual number of articles unmarked is returned."
"Mark N articles forward as expirable.
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-expirable-mark))
(defun gnus-summary-mark-as-spam (n)
"Mark N articles forward as spam.
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-spam-mark))
(defun gnus-summary-mark-article-as-replied (article)
"Mark ARTICLE as replied to and update the summary line.
ARTICLE can also be a list of articles."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number))
+ gnus-summary-mode)
(let ((articles (if (listp article) article (list article))))
(dolist (article articles)
(unless (numberp article)
@@ -11004,7 +11054,8 @@ ARTICLE can also be a list of articles."
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number))
+ gnus-summary-mode)
(when (or (not (get-buffer gnus-article-buffer))
(not gnus-current-article)
(not gnus-article-current)
@@ -11028,7 +11079,8 @@ ARTICLE can also be a list of articles."
(defun gnus-summary-remove-bookmark (article)
"Remove the bookmark from the current article."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number))
+ gnus-summary-mode)
;; Remove old bookmark, if one exists.
(if (not (assq article gnus-newsgroup-bookmarks))
(gnus-message 6 "No bookmark in current article.")
@@ -11040,7 +11092,7 @@ ARTICLE can also be a list of articles."
"Mark N articles forward as dormant.
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-dormant-mark))
(defun gnus-summary-set-process-mark (article)
@@ -11075,7 +11127,7 @@ If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned.
If NO-EXPIRE, auto-expiry will be inhibited."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-show-thread)
(let ((backward (< n 0))
(gnus-summary-goto-unread
@@ -11339,20 +11391,20 @@ If NO-EXPIRE, auto-expiry will be inhibited."
"Tick N articles forwards.
If N is negative, tick backwards instead.
The difference between N and the number of articles ticked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-ticked-mark))
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward (- n) gnus-ticked-mark))
(defun gnus-summary-tick-article (&optional article clear-mark)
"Mark current article as unread.
Optional 1st argument ARTICLE specifies article number to be marked as unread.
Optional 2nd argument CLEAR-MARK remove any kinds of mark."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-mark-article article (if clear-mark gnus-unread-mark
gnus-ticked-mark)))
@@ -11361,14 +11413,14 @@ Optional 2nd argument CLEAR-MARK remove any kinds of mark."
If N is negative, mark backwards instead.
The difference between N and the actual number of articles marked is
returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read-backward (n)
"Mark the N articles as read backwards.
The difference between N and the actual number of articles marked is
returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward
(- n) gnus-del-mark gnus-inhibit-user-auto-expire))
@@ -11382,13 +11434,13 @@ MARK specifies a string to be inserted at the beginning of the line."
"Clear marks from N articles forward.
If N is negative, clear backward instead.
The difference between N and the number of marks cleared is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward n gnus-unread-mark))
(defun gnus-summary-clear-mark-backward (n)
"Clear marks from N articles backward.
The difference between N and the number of marks cleared is returned."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-mark-forward (- n) gnus-unread-mark))
(defun gnus-summary-mark-unread-as-read ()
@@ -11421,7 +11473,7 @@ The difference between N and the number of marks cleared is returned."
"Mark all unread articles between point and mark as read.
If given a prefix, mark all articles between point and mark as read,
even ticked and dormant ones."
- (interactive "r\nP")
+ (interactive "r\nP" gnus-summary-mode)
(save-excursion
(let (article)
(goto-char point)
@@ -11438,7 +11490,7 @@ even ticked and dormant ones."
(defun gnus-summary-mark-below (score mark)
"Mark articles with score less than SCORE with MARK."
- (interactive "P\ncMark: ")
+ (interactive "P\ncMark: " gnus-summary-mode)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
@@ -11452,22 +11504,22 @@ even ticked and dormant ones."
(defun gnus-summary-kill-below (&optional score)
"Mark articles with score below SCORE as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-below score gnus-killed-mark))
(defun gnus-summary-clear-above (&optional score)
"Clear all marks from articles with score above SCORE."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-above score gnus-unread-mark))
(defun gnus-summary-tick-above (&optional score)
"Tick all articles with score above SCORE."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-mark-above score gnus-ticked-mark))
(defun gnus-summary-mark-above (score mark)
"Mark articles with score over SCORE with MARK."
- (interactive "P\ncMark: ")
+ (interactive "P\ncMark: " gnus-summary-mode)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
@@ -11483,7 +11535,7 @@ even ticked and dormant ones."
(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((inhibit-read-only t))
(let ((scored gnus-newsgroup-scored)
headers h)
@@ -11520,7 +11572,7 @@ Note that this function will only catch up the unread article
in the current summary buffer limitation.
The number of articles marked as read is returned."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(prog1
(save-excursion
(when (or quietly
@@ -11569,7 +11621,7 @@ The number of articles marked as read is returned."
(defun gnus-summary-catchup-to-here (&optional all)
"Mark all unticked articles before the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-save-hidden-threads
(let ((beg (point)))
@@ -11581,7 +11633,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read."
(defun gnus-summary-catchup-from-here (&optional all)
"Mark all unticked articles after (and including) the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-save-hidden-threads
(let ((beg (point)))
@@ -11594,14 +11646,14 @@ If ALL is non-nil, also mark ticked and dormant articles as read."
"Mark all articles in this newsgroup as read.
This command is dangerous. Normally, you want \\[gnus-summary-catchup]
instead, which marks only unread articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all unread articles in this group as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read.
If QUIETLY is non-nil, no questions will be asked."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when (gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
(if (and (not (gnus-group-quit-config gnus-newsgroup-name))
@@ -11613,14 +11665,14 @@ If QUIETLY is non-nil, no questions will be asked."
"Mark all articles in this newsgroup as read, and then exit.
This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit]
instead, which marks only unread articles as read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-catchup-and-exit t quietly))
(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-summary-catchup all))
(gnus-summary-next-group))
@@ -11629,7 +11681,7 @@ read."
"Mark all articles in this group as read and select the previous group.
If given a prefix, mark all articles, unread as well as ticked, as
read."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-excursion
(gnus-summary-catchup all))
(gnus-summary-next-group nil nil t))
@@ -11705,7 +11757,7 @@ with that article."
(defun gnus-summary-rethread-current ()
"Rethread the thread the current article is part of."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((gnus-show-threads t)
(article (gnus-summary-article-number))
(id (mail-header-id (gnus-summary-article-header)))
@@ -11720,7 +11772,7 @@ with that article."
Note that the re-threading will only work if `gnus-thread-ignore-subject'
is non-nil or the Subject: of both articles are the same."
- (interactive)
+ (interactive nil gnus-summary-mode)
(unless (not (gnus-group-read-only-p))
(error "The current newsgroup does not support article editing"))
(unless (<= (length gnus-newsgroup-processable) 1)
@@ -11739,9 +11791,10 @@ is non-nil or the Subject: of both articles are the same."
"Make PARENT the parent of CHILDREN.
When called interactively, PARENT is the current article and CHILDREN
are the process-marked articles."
- (interactive
- (list (gnus-summary-article-number)
- (gnus-summary-work-articles nil)))
+ (interactive (list
+ (gnus-summary-article-number)
+ (gnus-summary-work-articles nil))
+ gnus-summary-mode)
(dolist (child children)
(save-window-excursion
(let ((gnus-article-buffer " *reparent*"))
@@ -11774,7 +11827,7 @@ are the process-marked articles."
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
(setq gnus-show-threads
(if (null arg) (not gnus-show-threads)
@@ -11786,7 +11839,7 @@ If ARG is positive number, turn showing conversation threads on."
(defun gnus-summary-show-all-threads ()
"Show all threads."
- (interactive)
+ (interactive nil gnus-summary-mode)
(remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
(gnus-summary-position-point))
@@ -11796,7 +11849,7 @@ If ARG is positive number, turn showing conversation threads on."
(defun gnus-summary-show-thread ()
"Show thread subtrees.
Returns nil if no thread was there to be shown."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((orig (point))
(end (point-at-eol))
(end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
@@ -11837,7 +11890,7 @@ Returns nil if no thread was there to be shown."
"Hide all thread subtrees.
If PREDICATE is supplied, threads that satisfy this predicate
will not be hidden."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-excursion
(goto-char (point-min))
(let ((end nil)
@@ -11856,7 +11909,7 @@ will not be hidden."
(defun gnus-summary-hide-thread ()
"Hide thread subtrees.
Returns nil if no threads were there to be hidden."
- (interactive)
+ (interactive nil gnus-summary-mode)
(beginning-of-line)
(let ((start (point))
(starteol (line-end-position))
@@ -11908,7 +11961,7 @@ Returns the difference between N and the number of skips actually
done.
If SILENT, don't output messages."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -11924,7 +11977,7 @@ If SILENT, don't output messages."
"Go to the same level previous N'th thread.
Returns the difference between N and the number of skips actually
done."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-next-thread (- n)))
(defun gnus-summary-go-down-thread ()
@@ -11944,7 +11997,7 @@ done."
If N is negative, go up instead.
Returns the difference between N and how many steps down that were
taken."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(let ((up (< n 0))
(n (abs n)))
(while (and (> n 0)
@@ -11961,18 +12014,18 @@ taken."
If N is negative, go down instead.
Returns the difference between N and how many steps down that were
taken."
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-down-thread (- n)))
(defun gnus-summary-top-thread ()
"Go to the top of the thread."
- (interactive)
+ (interactive nil gnus-summary-mode)
(while (gnus-summary-go-up-thread))
(gnus-summary-article-number))
(defun gnus-summary-expire-thread ()
"Mark articles under current thread as expired."
- (interactive)
+ (interactive nil gnus-summary-mode)
(gnus-summary-kill-thread 0))
(defun gnus-summary-kill-thread (&optional unmark)
@@ -11980,7 +12033,7 @@ taken."
If the prefix argument is positive, remove any kinds of marks.
If the prefix argument is zero, mark thread as expired.
If the prefix argument is negative, tick articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread))
@@ -12015,82 +12068,88 @@ If the prefix argument is negative, tick articles instead."
(defun gnus-summary-sort-by-number (&optional reverse)
"Sort the summary buffer by article number.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'number reverse))
(defun gnus-summary-sort-by-most-recent-number (&optional reverse)
"Sort the summary buffer by most recent article number.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'most-recent-number reverse))
(defun gnus-summary-sort-by-random (&optional reverse)
"Randomize the order in the summary buffer.
Argument REVERSE means to randomize in reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'random reverse))
(defun gnus-summary-sort-by-author (&optional reverse)
"Sort the summary buffer by author name alphabetically.
If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'author reverse))
(defun gnus-summary-sort-by-recipient (&optional reverse)
"Sort the summary buffer by recipient name alphabetically.
If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'recipient reverse))
(defun gnus-summary-sort-by-subject (&optional reverse)
"Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'subject reverse))
(defun gnus-summary-sort-by-date (&optional reverse)
"Sort the summary buffer by date.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'date reverse))
(defun gnus-summary-sort-by-most-recent-date (&optional reverse)
"Sort the summary buffer by most recent date.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'most-recent-date reverse))
(defun gnus-summary-sort-by-score (&optional reverse)
"Sort the summary buffer by score.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'score reverse))
(defun gnus-summary-sort-by-lines (&optional reverse)
"Sort the summary buffer by the number of lines.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'lines reverse))
(defun gnus-summary-sort-by-chars (&optional reverse)
"Sort the summary buffer by article length.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'chars reverse))
(defun gnus-summary-sort-by-marks (&optional reverse)
"Sort the summary buffer by article marks.
Argument REVERSE means reverse order."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(gnus-summary-sort 'marks reverse))
+(defun gnus-summary-sort-by-newsgroups (&optional reverse)
+ "Sort the summary buffer by newsgroups alphabetically.
+Argument REVERSE means reverse order."
+ (interactive "P" gnus-summary-mode)
+ (gnus-summary-sort 'newsgroups reverse))
+
(defun gnus-summary-sort-by-original (&optional _reverse)
"Sort the summary buffer using the default sorting method.
Argument REVERSE means reverse order."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
@@ -12098,6 +12157,24 @@ Argument REVERSE means reverse order."
;; Hide subthreads if needed.
(gnus-summary-maybe-hide-threads)))
+(defun gnus-summary-sort-by-extra (&optional reverse)
+ "Sort the summary buffer using an extra header.
+Argument REVERSE means reverse order."
+ (interactive "P" gnus-summary-mode)
+ (let* ((extra-header
+ (gnus-completing-read "Sort by extra header"
+ (mapcar #'symbol-name gnus-extra-headers)
+ t nil nil
+ (symbol-name
+ (car gnus-extra-headers))))
+ (header (downcase extra-header)))
+ (if (and (fboundp (intern
+ (format "gnus-thread-sort-by-%s" header)))
+ (fboundp
+ (intern (format "gnus-article-sort-by-%s" header))))
+ (gnus-summary-sort header reverse)
+ (error "No sort function defined for header: %s" extra-header))))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(let* ((current (gnus-summary-article-number))
@@ -12139,7 +12216,7 @@ will not be marked as saved.
The `gnus-prompt-before-saving' variable says how prompting is
performed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
(save-buffer (save-excursion
@@ -12208,7 +12285,7 @@ is neither omitted nor the symbol `r', force including all headers
regardless of the `:headers' property. If it is the symbol `r',
articles that are not decoded and include all headers will be piped
no matter what the properties `:decode' and `:headers' are."
- (interactive (gnus-interactive "P\ny"))
+ (interactive (gnus-interactive "P\ny") gnus-summary-mode)
(require 'gnus-art)
(let* ((articles (gnus-summary-work-articles n))
(result-buffer shell-command-buffer-name)
@@ -12260,7 +12337,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
(gnus-summary-save-article arg)))
@@ -12271,7 +12348,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
@@ -12282,7 +12359,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-file))
(gnus-summary-save-article arg)))
@@ -12293,7 +12370,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-write-to-file))
(gnus-summary-save-article arg)))
@@ -12304,7 +12381,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
@@ -12315,7 +12392,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-write-body-to-file))
(gnus-summary-save-article arg)))
@@ -12326,14 +12403,14 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
(gnus-summary-save-article arg t)))
(defun gnus-summary-pipe-message (program)
"Pipe the current article through PROGRAM."
- (interactive "sProgram: ")
+ (interactive "sProgram: " gnus-summary-mode)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
@@ -12451,7 +12528,8 @@ If REVERSE, save parts that do not match TYPE."
(read-directory-name "Save to directory: "
gnus-summary-save-parts-last-directory
nil t))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-summary-mode)
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
gnus-article-prepare-hook
@@ -12590,12 +12668,12 @@ If REVERSE, save parts that do not match TYPE."
(defun gnus-summary-edit-global-kill (article)
"Edit the \"global\" kill file."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number)) gnus-summary-mode)
(gnus-group-edit-global-kill article))
(defun gnus-summary-edit-local-kill ()
"Edit a local kill file applied to the current newsgroup."
- (interactive)
+ (interactive nil gnus-summary-mode)
(setq gnus-current-headers (gnus-summary-article-header))
(gnus-group-edit-local-kill
(gnus-summary-article-number) gnus-newsgroup-name))
@@ -12707,7 +12785,7 @@ If REVERSE, save parts that do not match TYPE."
;; so we highlight the entire line instead.
(when (= (+ to 2) from)
(setq from beg)
- (setq to end))
+ (setq to (1+ end)))
(if gnus-newsgroup-selected-overlay
;; Move old overlay.
(move-overlay
@@ -12762,7 +12840,7 @@ If REVERSE, save parts that do not match TYPE."
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
- beg (point-at-eol) 'face
+ beg (1+ (point-at-eol)) 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))))
@@ -12893,7 +12971,7 @@ UNREAD is a sorted list."
"Display the current article buffer fully MIME-buttonized.
If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
treated as multipart/mixed."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-unbuttonized-mime-types nil)
(gnus-mime-display-multipart-as-mixed show-all-parts))
@@ -12901,7 +12979,7 @@ treated as multipart/mixed."
(defun gnus-summary-repair-multipart (article)
"Add a Content-Type header to a multipart article without one."
- (interactive (list (gnus-summary-article-number)))
+ (interactive (list (gnus-summary-article-number)) gnus-summary-mode)
(gnus-with-article article
(message-narrow-to-head)
(message-remove-header "Mime-Version")
@@ -12921,7 +12999,7 @@ treated as multipart/mixed."
(defun gnus-summary-toggle-display-buttonized ()
"Toggle the buttonizing of the article buffer."
- (interactive)
+ (interactive nil gnus-summary-mode)
(require 'gnus-art)
(if (setq gnus-inhibit-mime-unbuttonizing
(not gnus-inhibit-mime-unbuttonizing))
@@ -12976,7 +13054,7 @@ If N is negative, move in reverse order.
The difference between N and the actual number of articles marked is
returned."
name (cadr lway))
- (interactive "p")
+ (interactive "p" gnus-summary-mode)
(gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
(defun gnus-summary-generic-mark (n mark move unread)
@@ -13059,7 +13137,7 @@ returned."
"Insert all old articles in this group.
If ALL is non-nil, already read articles become readable.
If ALL is a number, fetch this number of articles."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(prog1
(let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<))
older len)
@@ -13133,7 +13211,7 @@ If ALL is a number, fetch this number of articles."
(defun gnus-summary-insert-new-articles ()
"Insert all new articles in this group."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let ((old (sort (mapcar #'gnus-data-number gnus-newsgroup-data) #'<))
(old-high gnus-newsgroup-highest)
(nnmail-fetched-sources (list t))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index e7d1cf86161..c8bcccdfdde 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -54,6 +54,7 @@ with some simple extensions.
%n Topic name.
%v Nothing if the topic is visible, \"...\" otherwise.
%g Number of groups in the topic.
+%G Number of groups in the topic and its subtopics.
%a Number of unread articles in the groups in the topic.
%A Number of unread articles in the groups in the topic and its subtopics.
@@ -70,6 +71,14 @@ See Info node `(gnus)Formatting Variables'."
"If non-nil, display the topic lines even of topics that have no unread articles."
:type 'boolean)
+(defcustom gnus-topic-display-predicate nil
+ "If non-nil, this should be a function to control the display of the topic.
+The function is called with one parameter -- the topic name, and
+should return non-nil if the topic is to be displayed."
+ :version "28.1"
+ :type '(choice (const :tag "Display all topics" nil)
+ function))
+
;; Internal variables.
(defvar gnus-topic-active-topology nil)
@@ -87,6 +96,7 @@ See Info node `(gnus)Formatting Variables'."
(?v visible ?s)
(?i indentation ?s)
(?g number-of-groups ?d)
+ (?G total-number-of-groups ?d)
(?a (gnus-topic-articles-in-topic entries) ?d)
(?A total-number-of-articles ?d)
(?l level ?d)))
@@ -146,7 +156,8 @@ See Info node `(gnus)Formatting Variables'."
(defun gnus-topic-jump-to-topic (topic)
"Go to TOPIC."
(interactive
- (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
+ (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))
+ gnus-topic-mode)
(let ((inhibit-read-only t))
(dolist (topic (gnus-current-topics topic))
(unless (gnus-topic-goto-topic topic)
@@ -235,12 +246,12 @@ If RECURSIVE is t, return groups in its subtopics too."
(defun gnus-topic-goto-previous-topic (n)
"Go to the N'th previous topic."
- (interactive "p")
+ (interactive "p" gnus-topic-mode)
(gnus-topic-goto-next-topic (- n)))
(defun gnus-topic-goto-next-topic (n)
"Go to the N'th next topic."
- (interactive "p")
+ (interactive "p" gnus-topic-mode)
(let ((backward (< n 0))
(n (abs n))
(topic (gnus-current-topic)))
@@ -484,16 +495,16 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
If SILENT, don't insert anything. Return the number of unread
articles in the topic and its subtopics."
(let* ((type (pop topicl))
- (entries (gnus-topic-find-groups
- (car type)
- (if gnus-group-listed-groups
- gnus-level-killed
- list-level)
- (or predicate gnus-group-listed-groups
- (cdr (assq 'visible
- (gnus-topic-hierarchical-parameters
- (car type)))))
- (if gnus-group-listed-groups 0 lowest)))
+ (name (car type))
+ (entries-level (if gnus-group-listed-groups
+ gnus-level-killed
+ list-level))
+ (all (or predicate gnus-group-listed-groups
+ (cdr (assq 'visible
+ (gnus-topic-hierarchical-parameters name)))))
+ (lowest (if gnus-group-listed-groups 0 lowest))
+ (entries (gnus-topic-find-groups name entries-level all lowest))
+ (all-groups (gnus-topic-find-groups name entries-level all lowest t))
(visiblep (and (eq (nth 1 type) 'visible) (not silent)))
(gnus-group-indentation
(make-string (* gnus-topic-indent-level level) ? ))
@@ -503,80 +514,84 @@ articles in the topic and its subtopics."
(point-max (point-max))
(unread 0)
info entry end active tick)
- ;; Insert any sub-topics.
- (while topicl
- (cl-incf unread
- (gnus-topic-prepare-topic
- (pop topicl) (1+ level) list-level predicate
- (not visiblep) lowest regexp)))
- (setq end (point))
- (goto-char beg)
- ;; Insert all the groups that belong in this topic.
- (while (setq entry (pop entries))
- (when (if (stringp entry)
- (gnus-group-prepare-logic
- entry
- (and
- (or (not gnus-group-listed-groups)
- (if (< list-level gnus-level-zombie) nil
- (let ((entry-level
- (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)))
- (and (<= entry-level list-level)
- (>= entry-level lowest)))))
- (cond
- ((stringp regexp)
- (string-match regexp entry))
- ((functionp regexp)
- (funcall regexp entry))
- ((null regexp) t)
- (t nil))))
- (setq info (nth 1 entry))
- (gnus-group-prepare-logic
- (gnus-info-group info)
- (and (or (not gnus-group-listed-groups)
- (let ((entry-level (gnus-info-level info)))
- (and (<= entry-level list-level)
- (>= entry-level lowest))))
- (or (not (functionp predicate))
- (funcall predicate info))
- (or (not (stringp regexp))
- (string-match regexp (gnus-info-group info))))))
- (when visiblep
- (if (stringp entry)
- ;; Dead groups.
- (gnus-group-insert-group-line
- entry (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)
- nil (- (1+ (cdr (setq active (gnus-active entry))))
- (car active))
- nil)
- ;; Living groups.
- (when (setq info (nth 1 entry))
- (gnus-group-insert-group-line
- (gnus-info-group info)
- (gnus-info-level info) (gnus-info-marks info)
- (car entry) (gnus-info-method info)))))
- (when (and (listp entry)
- (numberp (car entry)))
- (cl-incf unread (car entry)))
- (when (listp entry)
- (setq tick t))))
- (goto-char beg)
- ;; Insert the topic line.
- (when (and (not silent)
- (or gnus-topic-display-empty-topics ;We want empty topics
- (not (zerop unread)) ;Non-empty
- tick ;Ticked articles
- (/= point-max (point-max)))) ;Inactive groups
- (gnus-topic-insert-topic-line
- (car type) visiblep
- (not (eq (nth 2 type) 'hidden))
- level all-entries unread))
- (gnus-topic-update-unreads (car type) unread)
- (gnus-group--setup-tool-bar-update beg end)
- (goto-char end)
- unread))
+ (if (and gnus-topic-display-predicate
+ (not (funcall gnus-topic-display-predicate name)))
+ ;; We're filtering out this topic.
+ 0
+ ;; Insert any sub-topics.
+ (while topicl
+ (cl-incf unread
+ (gnus-topic-prepare-topic
+ (pop topicl) (1+ level) list-level predicate
+ (not visiblep) lowest regexp)))
+ (setq end (point))
+ (goto-char beg)
+ ;; Insert all the groups that belong in this topic.
+ (while (setq entry (pop entries))
+ (when (if (stringp entry)
+ (gnus-group-prepare-logic
+ entry
+ (and
+ (or (not gnus-group-listed-groups)
+ (if (< list-level gnus-level-zombie) nil
+ (let ((entry-level
+ (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)))
+ (and (<= entry-level list-level)
+ (>= entry-level lowest)))))
+ (cond
+ ((stringp regexp)
+ (string-match regexp entry))
+ ((functionp regexp)
+ (funcall regexp entry))
+ ((null regexp) t)
+ (t nil))))
+ (setq info (nth 1 entry))
+ (gnus-group-prepare-logic
+ (gnus-info-group info)
+ (and (or (not gnus-group-listed-groups)
+ (let ((entry-level (gnus-info-level info)))
+ (and (<= entry-level list-level)
+ (>= entry-level lowest))))
+ (or (not (functionp predicate))
+ (funcall predicate info))
+ (or (not (stringp regexp))
+ (string-match regexp (gnus-info-group info))))))
+ (when visiblep
+ (if (stringp entry)
+ ;; Dead groups.
+ (gnus-group-insert-group-line
+ entry (if (member entry gnus-zombie-list)
+ gnus-level-zombie gnus-level-killed)
+ nil (- (1+ (cdr (setq active (gnus-active entry))))
+ (car active))
+ nil)
+ ;; Living groups.
+ (when (setq info (nth 1 entry))
+ (gnus-group-insert-group-line
+ (gnus-info-group info)
+ (gnus-info-level info) (gnus-info-marks info)
+ (car entry) (gnus-info-method info)))))
+ (when (and (listp entry)
+ (numberp (car entry)))
+ (cl-incf unread (car entry)))
+ (when (listp entry)
+ (setq tick t))))
+ (goto-char beg)
+ ;; Insert the topic line.
+ (when (and (not silent)
+ (or gnus-topic-display-empty-topics ;We want empty topics
+ (not (zerop unread)) ;Non-empty
+ tick ;Ticked articles
+ (/= point-max (point-max)))) ;Inactive groups
+ (gnus-topic-insert-topic-line
+ name visiblep
+ (not (eq (nth 2 type) 'hidden))
+ level all-entries unread all-groups))
+ (gnus-topic-update-unreads name unread)
+ (gnus-group--setup-tool-bar-update beg end)
+ (goto-char end)
+ unread)))
(defun gnus-topic-remove-topic (&optional insert total-remove _hide in-level)
"Remove the current topic."
@@ -626,11 +641,19 @@ articles in the topic and its subtopics."
(defvar gnus-tmp-header)
(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
- &optional unread)
+ &optional unread all-groups)
+ (gnus--\,@
+ (let ((vars '(indentation visible name level number-of-groups
+ total-number-of-groups total-number-of-articles entries)))
+ `((with-suppressed-warnings ((lexical ,@vars))
+ ,@(mapcar (lambda (s) `(defvar ,s)) vars)))))
(let* ((visible (if visiblep "" "..."))
+ (level level)
+ (name name)
(indentation (make-string (* gnus-topic-indent-level level) ? ))
(total-number-of-articles unread)
(number-of-groups (length entries))
+ (total-number-of-groups (length all-groups))
(active-topic (eq gnus-topic-alist gnus-topic-active-alist))
gnus-tmp-header)
(gnus-topic-update-unreads name unread)
@@ -640,14 +663,7 @@ articles in the topic and its subtopics."
(add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec
- `((indentation . ,indentation)
- (visible . ,visible)
- (name . ,name)
- (level . ,level)
- (number-of-groups . ,number-of-groups)
- (total-number-of-articles . ,total-number-of-articles)
- (entries . ,entries))))
+ (eval gnus-topic-line-format-spec t))
(list 'gnus-topic name
'gnus-topic-level level
'gnus-topic-unread unread
@@ -661,7 +677,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-update-topics-containing-group (group)
"Update all topics that have GROUP as a member."
- (when (and (eq major-mode 'gnus-group-mode)
+ (when (and (eq major-mode 'gnus-topic-mode)
gnus-topic-mode)
(save-excursion
(let ((alist gnus-topic-alist))
@@ -677,7 +693,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-update-topic ()
"Update all parent topics to the current group."
- (when (and (eq major-mode 'gnus-group-mode)
+ (when (and (eq major-mode 'gnus-topic-mode)
gnus-topic-mode)
(let ((group (gnus-group-group-name))
(m (point-marker))
@@ -730,6 +746,9 @@ articles in the topic and its subtopics."
(entries (gnus-topic-find-groups
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
+ (all-groups (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode) nil t))
entry)
(while children
(cl-incf unread (gnus-topic-unread (caar (pop children)))))
@@ -737,7 +756,7 @@ articles in the topic and its subtopics."
(when (numberp (car entry))
(cl-incf unread (car entry))))
(gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil unread)))
+ topic t t (car (gnus-topic-find-topology topic)) nil unread all-groups)))
(defun gnus-topic-goto-missing-topic (topic)
(if (gnus-topic-goto-topic topic)
@@ -767,6 +786,9 @@ articles in the topic and its subtopics."
(entries (gnus-topic-find-groups
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
+ (all-groups (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode) t))
(parent (gnus-topic-parent-topic topic-name))
(all-entries entries)
(unread 0)
@@ -785,7 +807,7 @@ articles in the topic and its subtopics."
(gnus-topic-insert-topic-line
(car type) (gnus-topic-visible-p)
(not (eq (nth 2 type) 'hidden))
- (gnus-group-topic-level) all-entries unread)
+ (gnus-group-topic-level) all-entries unread all-groups)
(gnus-delete-line)
(forward-line -1)
(setq new-unread (gnus-group-topic-unread)))
@@ -1111,7 +1133,7 @@ articles in the topic and its subtopics."
["Delete" gnus-topic-delete t]
["Rename..." gnus-topic-rename t]
["Create..." gnus-topic-create-topic t]
- ["Mark" gnus-topic-mark-topic t]
+ ["Toggle/Set mark" gnus-topic-mark-topic t]
["Indent" gnus-topic-indent t]
["Sort" gnus-topic-sort-topics t]
["Previous topic" gnus-topic-goto-previous-topic t]
@@ -1122,7 +1144,9 @@ articles in the topic and its subtopics."
(define-minor-mode gnus-topic-mode
"Minor mode for topicsifying Gnus group buffers."
- :lighter " Topic" :keymap gnus-topic-mode-map
+ :lighter " Topic"
+ :keymap gnus-topic-mode-map
+ :interactive (gnus-group-mode)
(if (not (derived-mode-p 'gnus-group-mode))
(setq gnus-topic-mode nil)
;; Infest Gnus with topics.
@@ -1172,7 +1196,7 @@ articles in the group. If ALL is a negative number, fetch this
number of the earliest articles in the group.
If performed over a topic line, toggle folding the topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
(if (gnus-group-topic-p)
@@ -1184,13 +1208,13 @@ If performed over a topic line, toggle folding the topic."
(defun gnus-mouse-pick-topic (e)
"Select the group or topic under the mouse pointer."
- (interactive "e")
+ (interactive "e" gnus-topic-mode)
(mouse-set-point e)
(gnus-topic-read-group nil))
(defun gnus-topic-expire-articles (topic)
"Expire articles in this topic or group."
- (interactive (list (gnus-group-topic-name)))
+ (interactive (list (gnus-group-topic-name)) gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-expire-articles)
(save-excursion
@@ -1205,7 +1229,7 @@ If performed over a topic line, toggle folding the topic."
(defun gnus-topic-catchup-articles (topic)
"Catchup this topic or group.
Also see `gnus-group-catchup'."
- (interactive (list (gnus-group-topic-name)))
+ (interactive (list (gnus-group-topic-name)) gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-catchup-current)
(save-excursion
@@ -1232,7 +1256,7 @@ be auto-selected upon group entry. If GROUP is non-nil, fetch
that group.
If performed over a topic line, toggle folding the topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
(if (gnus-group-topic-p)
@@ -1247,7 +1271,8 @@ When used interactively, PARENT will be the topic under point."
(interactive
(list
(read-string "New topic: ")
- (gnus-current-topic)))
+ (gnus-current-topic))
+ gnus-topic-mode)
;; Check whether this topic already exists.
(when (gnus-topic-find-topology topic)
(error "Topic already exists"))
@@ -1284,7 +1309,8 @@ If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
(gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t
- nil 'gnus-topic-history)))
+ nil 'gnus-topic-history))
+ gnus-topic-mode)
(let ((use-marked (and (not n) (not (and transient-mark-mode mark-active))
gnus-group-marked t))
(groups (gnus-group-process-prefix n))
@@ -1309,7 +1335,7 @@ If COPYP, copy the groups instead."
(defun gnus-topic-remove-group (&optional n)
"Remove the current group from the topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(let ((use-marked (and (not n) (not (and transient-mark-mode mark-active))
gnus-group-marked t))
(groups (gnus-group-process-prefix n)))
@@ -1331,12 +1357,13 @@ If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
(gnus-completing-read
- "Copy to topic" (mapcar #'car gnus-topic-alist) t)))
+ "Copy to topic" (mapcar #'car gnus-topic-alist) t))
+ gnus-topic-mode)
(gnus-topic-move-group n topic t))
(defun gnus-topic-kill-group (&optional n discard)
"Kill the next N groups."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(if (gnus-group-topic-p)
(let ((topic (gnus-group-topic-name)))
(push (cons
@@ -1356,7 +1383,7 @@ If COPYP, copy the groups instead."
(defun gnus-topic-yank-group (&optional arg)
"Yank the last topic."
- (interactive "p")
+ (interactive "p" gnus-topic-mode)
(if gnus-topic-killed-topics
(let* ((previous
(or (gnus-group-topic-name)
@@ -1405,7 +1432,7 @@ If COPYP, copy the groups instead."
(defun gnus-topic-hide-topic (&optional permanent)
"Hide the current topic.
If PERMANENT, make it stay hidden in subsequent sessions as well."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (gnus-current-topic)
(gnus-topic-goto-topic (gnus-current-topic))
(if permanent
@@ -1418,7 +1445,7 @@ If PERMANENT, make it stay hidden in subsequent sessions as well."
(defun gnus-topic-show-topic (&optional permanent)
"Show the hidden topic.
If PERMANENT, make it stay shown in subsequent sessions as well."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when (gnus-group-topic-p)
(if (not permanent)
(gnus-topic-remove-topic t nil)
@@ -1430,34 +1457,42 @@ If PERMANENT, make it stay shown in subsequent sessions as well."
(setcar (cdr (cadr topic)) 'visible)
(gnus-group-list-groups)))))
-(defun gnus-topic-mark-topic (topic &optional unmark non-recursive)
+(defun gnus-topic-mark-topic (topic &optional unmark non-recursive no-toggle)
"Mark all groups in the TOPIC with the process mark.
If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics."
- (interactive (list (gnus-group-topic-name)
- nil
- (and current-prefix-arg t)))
+ (interactive
+ (list (gnus-group-topic-name)
+ nil
+ (and current-prefix-arg t))
+ gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-mark-group)
(save-excursion
(let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil
(not non-recursive))))
(while groups
- (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
- (gnus-info-group (nth 1 (pop groups)))))))))
+ (let ((group (gnus-info-group (nth 1 (pop groups)))))
+ (if (and gnus-process-mark-toggle (not no-toggle))
+ (if (memq group gnus-group-marked)
+ (gnus-group-remove-mark group )
+ (gnus-group-set-mark group))
+ (if unmark (gnus-group-remove-mark group)
+ (gnus-group-set-mark group)))))))))
(defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive)
"Remove the process mark from all groups in the TOPIC.
If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(interactive (list (gnus-group-topic-name)
nil
- (and current-prefix-arg t)))
+ (and current-prefix-arg t))
+ gnus-topic-mode)
(if (not topic)
(call-interactively 'gnus-group-unmark-group)
- (gnus-topic-mark-topic topic t non-recursive)))
+ (gnus-topic-mark-topic topic t non-recursive t)))
(defun gnus-topic-get-new-news-this-topic (&optional n)
"Check for new news in the current topic."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(if (not (gnus-group-topic-p))
(gnus-group-get-new-news-this-group n)
(let* ((topic (gnus-group-topic-name))
@@ -1475,7 +1510,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(list
(setq topic (gnus-completing-read "Move to topic"
(mapcar #'car gnus-topic-alist) t))
- (read-string (format "Move to %s (regexp): " topic))))))
+ (read-string (format "Move to %s (regexp): " topic)))))
+ gnus-topic-mode)
(gnus-group-mark-regexp regexp)
(gnus-topic-move-group nil topic copyp))
@@ -1486,12 +1522,13 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(mapcar #'car gnus-topic-alist) t)))
(nreverse
(list topic
- (read-string (format "Copy to %s (regexp): " topic))))))
+ (read-string (format "Copy to %s (regexp): " topic)))))
+ gnus-topic-mode)
(gnus-topic-move-matching regexp topic t))
(defun gnus-topic-delete (topic)
"Delete a topic."
- (interactive (list (gnus-group-topic-name)))
+ (interactive (list (gnus-group-topic-name)) gnus-topic-mode)
(unless topic
(error "No topic to be deleted"))
(let ((entry (assoc topic gnus-topic-alist))
@@ -1512,7 +1549,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(interactive
(let ((topic (gnus-current-topic)))
(list topic
- (read-string (format "Rename %s to: " topic) topic))))
+ (read-string (format "Rename %s to: " topic) topic)))
+ gnus-topic-mode)
;; Check whether the new name exists.
(when (gnus-topic-find-topology new-name)
(error "Topic `%s' already exists" new-name))
@@ -1535,7 +1573,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(defun gnus-topic-indent (&optional unindent)
"Indent a topic -- make it a sub-topic of the previous topic.
If UNINDENT, remove an indentation."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(if unindent
(gnus-topic-unindent)
(let* ((topic (gnus-current-topic))
@@ -1555,7 +1593,7 @@ If UNINDENT, remove an indentation."
(defun gnus-topic-unindent ()
"Unindent a topic."
- (interactive)
+ (interactive nil gnus-topic-mode)
(let* ((topic (gnus-current-topic))
(parent (gnus-topic-parent-topic topic))
(grandparent (gnus-topic-parent-topic parent)))
@@ -1574,7 +1612,7 @@ If UNINDENT, remove an indentation."
(defun gnus-topic-list-active (&optional force)
"List all groups that Gnus knows about in a topicsified fashion.
If FORCE, always re-read the active file."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(when force
(gnus-get-killed-groups))
(gnus-topic-grok-active force)
@@ -1585,7 +1623,7 @@ If FORCE, always re-read the active file."
(defun gnus-topic-toggle-display-empty-topics ()
"Show/hide topics that have no unread articles."
- (interactive)
+ (interactive nil gnus-topic-mode)
(setq gnus-topic-display-empty-topics
(not gnus-topic-display-empty-topics))
(gnus-group-list-groups)
@@ -1598,7 +1636,7 @@ If FORCE, always re-read the active file."
(defun gnus-topic-edit-parameters (group)
"Edit the group parameters of GROUP.
If performed on a topic, edit the topic parameters instead."
- (interactive (list (gnus-group-group-name)))
+ (interactive (list (gnus-group-group-name)) gnus-topic-mode)
(if group
(gnus-group-edit-group-parameters group)
(if (not (gnus-group-topic-p))
@@ -1642,7 +1680,8 @@ If performed on a topic, edit the topic parameters instead."
(defun gnus-topic-sort-groups (func &optional reverse)
"Sort the current topic according to FUNC.
If REVERSE, reverse the sorting order."
- (interactive (list gnus-group-sort-function current-prefix-arg))
+ (interactive (list gnus-group-sort-function current-prefix-arg)
+ gnus-topic-mode)
(let ((topic (assoc (gnus-current-topic) gnus-topic-alist)))
(gnus-topic-sort-topic
topic (gnus-make-sort-function func) reverse)
@@ -1651,43 +1690,43 @@ If REVERSE, reverse the sorting order."
(defun gnus-topic-sort-groups-by-alphabet (&optional reverse)
"Sort the current topic alphabetically by group name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse))
(defun gnus-topic-sort-groups-by-unread (&optional reverse)
"Sort the current topic by number of unread articles.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse))
(defun gnus-topic-sort-groups-by-level (&optional reverse)
"Sort the current topic by group level.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-level reverse))
(defun gnus-topic-sort-groups-by-score (&optional reverse)
"Sort the current topic by group score.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-score reverse))
(defun gnus-topic-sort-groups-by-rank (&optional reverse)
"Sort the current topic by group rank.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse))
(defun gnus-topic-sort-groups-by-method (&optional reverse)
"Sort the current topic alphabetically by backend name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
(defun gnus-topic-sort-groups-by-server (&optional reverse)
"Sort the current topic alphabetically by server name.
If REVERSE, sort in reverse order."
- (interactive "P")
+ (interactive "P" gnus-topic-mode)
(gnus-topic-sort-groups 'gnus-group-sort-by-server reverse))
(defun gnus-topic-sort-topics-1 (top reverse)
@@ -1708,7 +1747,8 @@ If REVERSE, reverse the sorting order."
(list (gnus-completing-read "Sort topics in"
(mapcar #'car gnus-topic-alist) t
(gnus-current-topic))
- current-prefix-arg))
+ current-prefix-arg)
+ gnus-topic-mode)
(let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
gnus-topic-topology)))
(gnus-topic-sort-topics-1 topic-topology reverse)
@@ -1721,7 +1761,8 @@ If REVERSE, reverse the sorting order."
(interactive
(list
(gnus-group-topic-name)
- (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t)))
+ (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t))
+ gnus-topic-mode)
(unless (and current to)
(error "Can't find topic"))
(let ((current-top (cdr (gnus-topic-find-topology current)))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 3c7c948c2b5..70ae81d95ea 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -154,7 +154,7 @@ is slower."
(and (string-match "(.+)" from)
(setq name (substring from (1+ (match-beginning 0))
(1- (match-end 0)))))
- (and (string-match "()" from)
+ (and (string-search "()" from)
(setq name address))
;; XOVER might not support folded From headers.
(and (string-match "(.*" from)
@@ -265,7 +265,7 @@ If END is non-nil, use the end of the span instead."
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
(let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
- (idx (string-match ":" newsgroup)))
+ (idx (string-search ":" newsgroup)))
(concat
(if idx (substring newsgroup 0 idx))
(if idx "/")
@@ -408,7 +408,7 @@ Cache the result as a text property stored in DATE."
(defun gnus-mode-string-quote (string)
"Quote all \"%\"'s in STRING."
- (replace-regexp-in-string "%" "%%" string))
+ (string-replace "%" "%%" string))
(defsubst gnus-make-hashtable (&optional size)
"Make a hash table of SIZE, testing on `equal'."
@@ -1068,6 +1068,11 @@ ARG is passed to the first function."
;;; Various
+(defmacro gnus--\,@ (exp)
+ "Splice EXP's value (a list of Lisp forms) into the code."
+ (declare (debug t))
+ `(progn ,@(eval exp t)))
+
(defvar gnus-group-buffer) ; Compiler directive
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
@@ -1286,61 +1291,6 @@ forbidden in URL encoding."
(setq tmp (concat tmp str))
tmp))
-(defun gnus-base64-repad (str &optional reject-newlines line-length no-check)
- "Take a base 64-encoded string and return it padded correctly.
-Existing padding is ignored.
-
-If any combination of CR and LF characters are present and
-REJECT-NEWLINES is nil, remove them; otherwise raise an error.
-If LINE-LENGTH is set and the string (or any line in the string
-if REJECT-NEWLINES is nil) is longer than that number, raise an
-error. Common line length for input characters are 76 plus CRLF
-\(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including
-CRLF (RFC 5321 SMTP).
-
-If NOCHECK, don't check anything, but just repad."
- ;; RFC 4648 specifies that:
- ;; - three 8-bit inputs make up a 24-bit group
- ;; - the 24-bit group is broken up into four 6-bit values
- ;; - each 6-bit value is mapped to one character of the base 64 alphabet
- ;; - if the final 24-bit quantum is filled with only 8 bits the output
- ;; will be two base 64 characters followed by two "=" padding characters
- ;; - if the final 24-bit quantum is filled with only 16 bits the output
- ;; will be three base 64 character followed by one "=" padding character
- ;;
- ;; RFC 4648 section 3 considerations:
- ;; - if reject-newlines is nil (default), concatenate multi-line
- ;; input (3.1, 3.3)
- ;; - if line-length is set, error on input exceeding the limit (3.1)
- ;; - reject characters outside base encoding (3.3, also section 12)
- ;;
- ;; RFC 5322 section 2.2.3 consideration:
- ;; Because base 64-encoded strings can appear in long header fields, remove
- ;; folding whitespace while still observing the RFC 4648 decisions above.
- (when no-check
- (setq str (replace-regexp-in-string "[\n\r \t]+" "" str)));
- (let ((splitstr (split-string str "[ \t]*[\r\n]+[ \t]?" t)))
- (when (and reject-newlines (> (length splitstr) 1))
- (error "Invalid Base64 string"))
- (dolist (substr splitstr)
- (when (and line-length (> (length substr) line-length))
- (error "Base64 string exceeds line-length"))
- (when (string-match "[^A-Za-z0-9+/=]" substr)
- (error "Invalid Base64 string")))
- (let* ((str (string-join splitstr))
- (len (length str)))
- (when (string-match "=" str)
- (setq len (match-beginning 0)))
- (concat
- (substring str 0 len)
- (make-string (/
- (- 24
- (pcase (mod (* len 6) 24)
- (`0 24)
- (n n)))
- 6)
- ?=)))))
-
(defun gnus-make-predicate (spec)
"Transform SPEC into a function that can be called.
SPEC is a predicate specifier that contains stuff like `or', `and',
@@ -1607,8 +1557,8 @@ empty directories from OLD-PATH."
"Rescale IMAGE to SIZE if possible.
SIZE is in format (WIDTH . HEIGHT). Return a new image.
Sizes are in pixels."
- (if (not (display-graphic-p))
- image
+ (when (display-images-p)
+ (declare-function image-size "image.c" (spec &optional pixels frame))
(let ((new-width (car size))
(new-height (cdr size)))
(when (> (cdr (image-size image t)) new-height)
@@ -1616,8 +1566,8 @@ Sizes are in pixels."
:max-height new-height)))
(when (> (car (image-size image t)) new-width)
(setq image (create-image (plist-get (cdr image) :data) nil t
- :max-width new-width)))
- image)))
+ :max-width new-width)))))
+ image)
(defun gnus-recursive-directory-files (dir)
"Return all regular files below DIR.
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 32a87851549..6c926384c97 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -355,7 +355,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defun gnus-uu-decode-uu (&optional n)
"Uudecodes the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-uustrip-article n))
(defun gnus-uu-decode-uu-and-save (n dir)
@@ -364,13 +364,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "Uudecode and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-uustrip-article n dir nil nil t))
(defun gnus-uu-decode-unshar (&optional n)
"Unshars the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-unshar-article n nil nil 'scan t))
(defun gnus-uu-decode-unshar-and-save (n dir)
@@ -379,8 +380,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "Unshar and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t))
(defun gnus-uu-decode-save (n file)
@@ -391,7 +393,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(read-directory-name
"Save articles in dir: " gnus-uu-default-dir gnus-uu-default-dir)
(read-file-name
- "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir))))
+ "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(setq gnus-uu-saved-article-name file)
(gnus-uu-decode-with-method #'gnus-uu-save-article n nil t))
@@ -401,8 +404,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "Unbinhex and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
@@ -414,14 +418,15 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(file-name-as-directory
(read-directory-name "yEnc decode and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir))))
+ gnus-uu-default-dir
+ gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(setq gnus-uu-yenc-article-name nil)
(gnus-uu-decode-with-method #'gnus-uu-yenc-article n dir nil t))
(defun gnus-uu-decode-uu-view (&optional n)
"Uudecodes and views the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu n)))
@@ -431,13 +436,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(read-file-name "Uudecode, view and save in dir: "
gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ gnus-uu-default-dir t))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-uu-and-save n dir)))
(defun gnus-uu-decode-unshar-view (&optional n)
"Unshars and views the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-unshar n)))
@@ -447,7 +453,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(read-file-name "Unshar, view and save in dir: "
gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ gnus-uu-default-dir t))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-unshar-and-save n dir)))
@@ -459,7 +466,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(read-directory-name "Save articles in dir: "
gnus-uu-default-dir gnus-uu-default-dir)
(read-file-name "Save articles in file: "
- gnus-uu-default-dir gnus-uu-default-dir))))
+ gnus-uu-default-dir gnus-uu-default-dir)))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-save n file)))
@@ -468,7 +476,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(interactive
(list current-prefix-arg
(read-file-name "Unbinhex, view and save in dir: "
- gnus-uu-default-dir gnus-uu-default-dir)))
+ gnus-uu-default-dir gnus-uu-default-dir))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
@@ -480,7 +489,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defun gnus-uu-digest-mail-forward (&optional n post)
"Digests and forwards all articles in this series."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-initialize)
(let ((gnus-uu-save-in-digest t)
(file (make-temp-file (nnheader-concat gnus-uu-work-dir "forward")))
@@ -546,7 +555,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defun gnus-uu-digest-post-forward (&optional n)
"Digest and forward to a newsgroup."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-digest-mail-forward n t))
;; Process marking.
@@ -569,14 +578,14 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defun gnus-new-processable (unmarkp articles)
(if unmarkp
- (gnus-intersection gnus-newsgroup-processable articles)
- (gnus-set-difference articles gnus-newsgroup-processable)))
+ (nreverse (seq-intersection gnus-newsgroup-processable articles #'eq))
+ (seq-difference articles gnus-newsgroup-processable #'eq)))
(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
"Set the process mark on articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP.
Optional UNMARK non-nil means unmark instead of mark."
- (interactive "sMark (regexp): \nP")
+ (interactive "sMark (regexp): \nP" gnus-article-mode gnus-summary-mode)
(save-excursion
(let* ((articles (gnus-uu-find-articles-matching regexp))
(new-marked (gnus-new-processable unmark articles)))
@@ -590,12 +599,12 @@ Optional UNMARK non-nil means unmark instead of mark."
(defun gnus-uu-unmark-by-regexp (regexp)
"Remove the process mark from articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP."
- (interactive "sUnmark (regexp): ")
+ (interactive "sUnmark (regexp): " gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-by-regexp regexp t))
(defun gnus-uu-mark-series (&optional silent)
"Mark the current series with the process mark."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let* ((articles (gnus-uu-find-articles-matching))
(l (length articles)))
(while articles
@@ -608,7 +617,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-region (beg end &optional unmark)
"Set the process mark on all articles between point and mark."
- (interactive "r")
+ (interactive "r" gnus-article-mode gnus-summary-mode)
(save-excursion
(goto-char beg)
(while (< (point) end)
@@ -620,22 +629,22 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-unmark-region (beg end)
"Remove the process mark from all articles between point and mark."
- (interactive "r")
+ (interactive "r" gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-region beg end t))
(defun gnus-uu-mark-buffer ()
"Set the process mark on all articles in the buffer."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-region (point-min) (point-max)))
(defun gnus-uu-unmark-buffer ()
"Remove the process mark on all articles in the buffer."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-uu-mark-region (point-min) (point-max) t))
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(gnus-save-hidden-threads
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
@@ -646,7 +655,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-unmark-thread ()
"Unmarks all articles downwards in this thread."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-remove-process-mark
(gnus-summary-article-number))
@@ -656,7 +665,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-invert-processable ()
"Invert the list of process-marked articles."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((data gnus-newsgroup-data)
number)
(save-excursion
@@ -669,7 +678,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-over (&optional score)
"Mark all articles with a score over SCORE (the prefix)."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((score (or score gnus-summary-default-score 0))
(data gnus-newsgroup-data))
(save-excursion
@@ -684,7 +693,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-sparse ()
"Mark all series that have some articles marked."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(let ((marked (nreverse gnus-newsgroup-processable))
subject articles total headers)
(unless marked
@@ -708,7 +717,7 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-mark-all ()
"Mark all articles in \"series\" order."
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(setq gnus-newsgroup-processable nil)
(save-excursion
(let ((data gnus-newsgroup-data)
@@ -728,33 +737,33 @@ When called interactively, prompt for REGEXP."
(defun gnus-uu-decode-postscript (&optional n)
"Gets PostScript of the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n))
(defun gnus-uu-decode-postscript-view (&optional n)
"Gets and views the current article."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-postscript n)))
(defun gnus-uu-decode-postscript-and-save (n dir)
"Extracts PostScript and saves the current article."
- (interactive
- (list current-prefix-arg
- (file-name-as-directory
- (read-directory-name "Save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ (interactive (list current-prefix-arg
+ (file-name-as-directory
+ (read-directory-name "Save in dir: "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t)))
+ gnus-article-mode gnus-summary-mode)
(gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article
n dir nil nil t))
(defun gnus-uu-decode-postscript-and-save-view (n dir)
"Decodes, views and saves the resulting file."
- (interactive
- (list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
+ (interactive (list current-prefix-arg
+ (read-file-name "Where do you want to save the file(s)? "
+ gnus-uu-default-dir
+ gnus-uu-default-dir t))
+ gnus-article-mode gnus-summary-mode)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-postscript-and-save n dir)))
@@ -1425,7 +1434,7 @@ When called interactively, prompt for REGEXP."
"View FILE using the gnus-uu methods."
(let ((action (gnus-uu-get-action file)))
(gnus-execute-command
- (if (string-match "%" action)
+ (if (string-search "%" action)
(format action file)
(concat action " " file))
(eq gnus-view-pseudos 'not-confirm))))
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index b7e6b2a8890..ec3601109e9 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -72,7 +72,7 @@ If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(require 'gnus-art)
(let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
(gnus-summary-save-article arg)))
@@ -80,7 +80,7 @@ save those articles instead."
(declare-function vm-save-message "ext:vm-save" (folder &optional count))
(defun gnus-summary-save-in-vm (&optional folder)
- (interactive)
+ (interactive nil gnus-article-mode gnus-summary-mode)
(require 'vm)
(setq folder
(gnus-read-save-file-name
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 98664ac2b44..d52bd26a2cb 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -525,25 +525,26 @@ be set in `.emacs' instead."
;; Summary mode faces.
-(defface gnus-summary-selected '((t (:underline t)))
+(defface gnus-summary-selected '((t (:underline t :extend t)))
"Face used for selected articles."
:group 'gnus-summary)
(defface gnus-summary-cancelled
'((((class color))
- (:foreground "yellow" :background "black")))
+ (:foreground "yellow" :background "black" :extend t))
+ (t (:extend t)))
"Face used for canceled articles."
:group 'gnus-summary)
(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
- (:foreground "pink"))
+ (:foreground "pink" :extend t))
(((class color)
(background light))
- (:foreground "firebrick"))
+ (:foreground "firebrick" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest ticked articles."
:group 'gnus-summary)
@@ -560,12 +561,12 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
- (:foreground "SkyBlue"))
+ (:foreground "SkyBlue" :extend t))
(((class color)
(background light))
- (:foreground "RoyalBlue"))
+ (:foreground "RoyalBlue" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest ancient articles."
:group 'gnus-summary)
@@ -582,10 +583,10 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-undownloaded
'((((class color)
(background light))
- (:foreground "cyan4" :bold nil))
+ (:foreground "cyan4" :bold nil :extend t))
(((class color) (background dark))
- (:foreground "LightGray" :bold nil))
- (t (:inverse-video t)))
+ (:foreground "LightGray" :bold nil :extend t))
+ (t (:inverse-video t :extend t)))
"Face used for normal interest uncached articles."
:group 'gnus-summary)
@@ -601,7 +602,7 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-unread
'((t
- ()))
+ (:extend t)))
"Face used for normal interest unread articles."
:group 'gnus-summary)
@@ -618,12 +619,12 @@ be set in `.emacs' instead."
(defface gnus-summary-normal-read
'((((class color)
(background dark))
- (:foreground "PaleGreen"))
+ (:foreground "PaleGreen" :extend t))
(((class color)
(background light))
- (:foreground "DarkGreen"))
+ (:foreground "DarkGreen" :extend t))
(t
- ()))
+ (:extend t)))
"Face used for normal interest read articles."
:group 'gnus-summary)
@@ -1138,7 +1139,7 @@ no need to set this variable."
:group 'gnus-message
:type '(choice (const :tag "default" nil)
string))
-(make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")
+(make-obsolete-variable 'gnus-local-domain nil "24.1")
;; Customization variables
@@ -1183,6 +1184,14 @@ newsgroups."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-process-mark-toggle t
+ "If nil the process mark command only sets the process mark."
+ :version "28.1"
+ :group 'gnus-summary
+ :group 'gnus-group-various
+ :group 'gnus-group-topic
+ :type 'boolean)
+
(defcustom gnus-large-newsgroup 200
"The number of articles which indicates a large newsgroup.
If the number of articles in a newsgroup is greater than this value,
@@ -2310,7 +2319,7 @@ automatically cache the article in the agent cache."
;; The carpal mode has been removed, but define the variable for
;; backwards compatibility.
(defvar gnus-carpal nil)
-(make-obsolete-variable 'gnus-carpal nil "Emacs 24.1")
+(make-obsolete-variable 'gnus-carpal nil "24.1")
(defvar gnus-agent-fetching nil
"Whether Gnus agent is in fetching mode.")
@@ -2513,7 +2522,7 @@ are always t.")
'(("info" :interactive t Info-goto-node)
("qp" quoted-printable-decode-region quoted-printable-decode-string)
("ps-print" ps-print-preprint)
- ("message" :interactive t
+ ("message" :interactive (message-mode)
message-send-and-exit message-yank-original)
("babel" babel-as-string)
("nnmail" nnmail-split-fancy nnmail-article-group)
@@ -2530,7 +2539,7 @@ are always t.")
("score-mode" :interactive t gnus-score-mode)
("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
- ("gnus-mh" :interactive t gnus-summary-save-in-folder)
+ ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder)
("gnus-demon" gnus-demon-add-scanmail
gnus-demon-add-rescan gnus-demon-add-scan-timestamps
gnus-demon-add-disconnection gnus-demon-add-handler
@@ -2545,7 +2554,7 @@ are always t.")
("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
gnus-server-server-name)
("gnus-srvr" gnus-browse-foreign-server)
- ("gnus-cite" :interactive t
+ ("gnus-cite" :interactive (gnus-article-mode gnus-summary-mode)
gnus-article-highlight-citation gnus-article-hide-citation-maybe
gnus-article-hide-citation gnus-article-fill-cited-article
gnus-article-hide-citation-in-followups
@@ -2561,29 +2570,34 @@ are always t.")
gnus-cache-enter-remove-article gnus-cached-article-p
gnus-cache-open gnus-cache-close gnus-cache-update-article
gnus-cache-articles-in-group)
- ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
+ ("gnus-cache" :interactive (gnus-summary-mode)
+ gnus-summary-insert-cached-articles gnus-cache-enter-article
gnus-cache-remove-article gnus-summary-insert-cached-articles)
+ ("gnus-cache" :interactive t gnus-jog-cache)
("gnus-score" :interactive t
+ gnus-score-flush-cache gnus-score-close)
+ ("gnus-score" :interactive (gnus-summary-mode)
gnus-summary-increase-score gnus-summary-set-score
gnus-summary-raise-thread gnus-summary-raise-same-subject
gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
gnus-summary-lower-thread gnus-summary-lower-same-subject
gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
gnus-summary-current-score gnus-score-delta-default
- gnus-score-flush-cache gnus-score-close
gnus-possibly-score-headers gnus-score-followup-article
gnus-score-followup-thread)
("gnus-score"
(gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
gnus-score-find-trace gnus-score-file-name)
- ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
- ("gnus-topic" :interactive t gnus-topic-mode)
+ ("gnus-cus" :interactive (gnus-group-mode) gnus-group-customize)
+ ("gnus-cus" :interactive (gnus-summary-mode) gnus-score-customize)
+ ("gnus-topic" :interactive (gnus-group-mode) gnus-topic-mode)
("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
gnus-subscribe-topics)
- ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
+ ("gnus-salt" :interactive (gnus-summary-mode)
+ gnus-pick-mode gnus-binary-mode)
("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
- ("gnus-uu" :interactive t
+ ("gnus-uu" :interactive (gnus-article-mode gnus-summary-mode)
gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
gnus-uu-mark-by-regexp gnus-uu-mark-all
@@ -2598,12 +2612,13 @@ are always t.")
("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
- ("gnus-msg" :interactive t
- gnus-group-post-news gnus-group-mail gnus-group-news
+ ("gnus-msg" :interactive (gnus-group-mode)
+ gnus-group-post-news gnus-group-mail gnus-group-news)
+ ("gnus-msg" :interactive (gnus-summary-mode)
gnus-summary-post-news gnus-summary-news-other-window
gnus-summary-followup gnus-summary-followup-with-original
gnus-summary-cancel-article gnus-summary-supersede-article
- gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
+ gnus-summary-reply gnus-summary-reply-with-original
gnus-summary-mail-forward gnus-summary-mail-other-window
gnus-summary-resend-message gnus-summary-resend-bounced-mail
gnus-summary-wide-reply gnus-summary-followup-to-mail
@@ -2611,7 +2626,9 @@ are always t.")
gnus-summary-wide-reply-with-original
gnus-summary-post-forward gnus-summary-wide-reply-with-original
gnus-summary-post-forward)
- ("gnus-picon" :interactive t gnus-treat-from-picon)
+ ("gnus-msg" gnus-post-news)
+ ("gnus-picon" :interactive (gnus-article-mode gnus-summary-mode)
+ gnus-treat-from-picon)
("smiley" :interactive t smiley-region)
("gnus-win" gnus-configure-windows gnus-add-configuration)
("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
@@ -2634,7 +2651,7 @@ are always t.")
gnus-request-article-this-buffer gnus-article-mode
gnus-article-setup-buffer gnus-narrow-to-page
gnus-article-delete-invisible-text gnus-treat-article)
- ("gnus-art" :interactive t
+ ("gnus-art" :interactive (gnus-summary-mode gnus-article-mode)
gnus-article-hide-headers gnus-article-hide-boring-headers
gnus-article-treat-overstrike
gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
@@ -2646,7 +2663,6 @@ are always t.")
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
- ;;gnus-article-show-all-headers
gnus-article-edit-mode gnus-article-edit-article
gnus-article-edit-done gnus-article-decode-encoded-words
gnus-start-date-timer gnus-stop-date-timer
@@ -2671,12 +2687,13 @@ are always t.")
gnus-agent-store-article gnus-agent-group-covered-p)
("gnus-agent" :interactive t
gnus-unplugged gnus-agentize gnus-agent-batch)
- ("gnus-vm" :interactive t gnus-summary-save-in-vm
+ ("gnus-vm" :interactive (gnus-summary-mode) gnus-summary-save-in-vm
gnus-summary-save-article-vm)
("compface" uncompface)
- ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
+ ("gnus-draft" :interactive (gnus-summary-mode) gnus-draft-mode)
+ ("gnus-draft" :interactive t gnus-group-send-queue)
("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
- ("gnus-mlspl" :interactive t gnus-group-split-setup
+ ("gnus-mlspl" :interactive (gnus-group-mode) gnus-group-split-setup
gnus-group-split-update)
("gnus-delay" gnus-delay-initialize))))
@@ -3212,9 +3229,9 @@ that that variable is buffer-local to the summary buffers."
(format "%s" (car method))
(format "%s:%s" (car method) (cadr method))))
(name-method (cons name method)))
- (when (and (not no-enter-cache)
- (not (member name-method gnus-server-method-cache))
- (not (assoc (car name-method) gnus-server-method-cache)))
+ (unless (or no-enter-cache
+ (member name-method gnus-server-method-cache)
+ (assoc (car name-method) gnus-server-method-cache))
(push name-method gnus-server-method-cache))
name)))
@@ -3509,7 +3526,7 @@ You should probably use `gnus-find-method-for-group' instead."
(defun gnus-group-native-p (group)
"Say whether the group is native or not."
- (not (string-match ":" group)))
+ (not (string-search ":" group)))
(defun gnus-group-secondary-p (group)
"Say whether the group is secondary or not."
@@ -3725,13 +3742,13 @@ just the host name."
;; Separate foreign select method from group name and collapse.
;; If method contains a server, collapse to non-domain server name,
;; otherwise collapse to select method.
- (let* ((colon (string-match ":" group))
+ (let* ((colon (string-search ":" group))
(server (and colon (substring group 0 colon)))
- (plus (and server (string-match "\\+" server))))
+ (plus (and server (string-search "+" server))))
(when server
(if plus
(setq foreign (substring server (+ 1 plus)
- (string-match "\\." server))
+ (string-search "." server))
group (substring group (+ 1 colon)))
(setq foreign server
group (substring group (+ 1 colon))))
@@ -4148,8 +4165,9 @@ prompt the user for the name of an NNTP server to use."
;; file.
(unless (string-match "^Gnus" gnus-version)
(load "gnus-load" nil t))
- (unless (byte-code-function-p (symbol-function 'gnus))
- (message "You should byte-compile Gnus")
+ (unless (or (byte-code-function-p (symbol-function 'gnus))
+ (subr-native-elisp-p (symbol-function 'gnus)))
+ (message "You should compile Gnus")
(sit-for 2))
(let ((gnus-action-message-log (list nil)))
(gnus-1 arg dont-connect child)
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 091e3899c26..4f800891b2b 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -1,4 +1,4 @@
-;;; gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*-
+;;; legacy-gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 5a5dbcebc1e..bff1b2a60d9 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -120,12 +120,13 @@
:group 'message-buffers
:type 'integer)
-(defcustom message-send-rename-function nil
+(defcustom message-send-rename-function #'message-default-send-rename-function
"Function called to rename the buffer after sending it."
:group 'message-buffers
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
-(defcustom message-fcc-handler-function 'message-output
+(defcustom message-fcc-handler-function #'message-output
"A function called to save outgoing articles.
This function will be called with the name of the file to store the
article in. The default function is `message-output' which saves in Unix
@@ -186,22 +187,26 @@ Otherwise, most addresses look like `angles', but they look like
(defcustom message-syntax-checks
(if message-insert-canlock '((sender . disabled)) nil)
- ;; Guess this one shouldn't be easy to customize...
"Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
`(signature . disabled)' to this list.
Don't touch this variable unless you really know what you're doing.
-Checks include `approved', `bogus-recipient', `continuation-headers',
-`control-chars', `empty', `existing-newsgroups', `from', `illegible-text',
-`invisible-text', `long-header-lines', `long-lines', `message-id',
-`multiple-headers', `new-text', `newsgroups', `quoting-style',
-`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
-`shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
-and `valid-newsgroups'."
- :group 'message-news
- :type '(repeat sexp)) ; Fixme: improve this
+See the Message manual for the meanings of the valid syntax check
+types."
+ :group 'message-headers
+ :link '(custom-manual "(message)Message Headers")
+ :type '(alist
+ :key-type symbol
+ :value-type (const disabled)
+ :options (approved bogus-recipient continuation-headers
+ control-chars empty existing-newsgroups from illegible-text
+ invisible-text long-header-lines long-lines message-id
+ multiple-headers new-text newgroups quoting-style
+ repeated-newsgroups reply-to sender sendsys shoot
+ shorten-followup-to signature size subject subject-cmsg
+ valid-newsgroups)))
(defcustom message-required-headers '((optional . References)
From)
@@ -382,7 +387,7 @@ Archives \(such as groups.google.com) respect this header."
:group 'message-various)
(defcustom message-archive-note
- "X-No-Archive: Yes - save http://groups.google.com/"
+ "X-No-Archive: Yes - save https://groups.google.com/"
"Note to insert why you wouldn't want this posting archived.
If nil, don't insert any text in the body."
:version "22.1"
@@ -418,7 +423,7 @@ you can explicitly override this setting by calling
:type 'string
:group 'message-various)
-(defcustom message-cross-post-note-function 'message-cross-post-insert-note
+(defcustom message-cross-post-note-function #'message-cross-post-insert-note
"Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
@@ -756,7 +761,7 @@ See also `send-mail-function'."
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
-(defcustom message-send-news-function 'message-send-news
+(defcustom message-send-news-function #'message-send-news
"Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'."
@@ -765,29 +770,32 @@ variable `mail-header-separator'."
:link '(custom-manual "(message)News Variables")
:type 'function)
-(defcustom message-reply-to-function nil
+(defcustom message-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Reply")
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
-(defcustom message-wide-reply-to-function nil
+(defcustom message-wide-reply-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Wide Reply")
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
-(defcustom message-followup-to-function nil
+(defcustom message-followup-to-function #'ignore
"If non-nil, function that should return a list of headers.
This function should pick out addresses from the To, Cc, and From headers
and respond with new To and Cc headers."
:group 'message-interface
:link '(custom-manual "(message)Followup")
- :type '(choice function (const nil)))
+ :version "28.1"
+ :type 'function)
(defcustom message-extra-wide-headers nil
"If non-nil, a list of additional address headers.
@@ -1021,7 +1029,7 @@ the signature is inserted."
:version "22.1"
:group 'message-various)
-(defcustom message-citation-line-function 'message-insert-citation-line
+(defcustom message-citation-line-function #'message-insert-citation-line
"Function called to insert the \"Whomever writes:\" line.
Predefined functions include `message-insert-citation-line' and
@@ -1103,7 +1111,7 @@ Used by `message-yank-original' via `message-yank-cite'."
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
-(defcustom message-cite-function 'message-cite-original-without-signature
+(defcustom message-cite-function #'message-cite-original-without-signature
"Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
@@ -1116,7 +1124,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
:version "22.3" ;; Gnus 5.10.12 (changed default)
:group 'message-insertion)
-(defcustom message-indent-citation-function 'message-indent-citation
+(defcustom message-indent-citation-function #'message-indent-citation
"Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
citation between (point) and (mark t). And each function should leave
@@ -1650,6 +1658,11 @@ starting with `not' and followed by regexps."
"Face used for displaying MML."
:group 'message-faces)
+(defface message-signature-separator '((t :bold t))
+ "Face used for displaying the signature separator."
+ :group 'message-faces
+ :version "28.1")
+
(defun message-match-to-eoh (_limit)
(let ((start (point)))
(rfc822-goto-eoh)
@@ -1743,9 +1756,22 @@ number of levels specified in the faces `message-cited-text-*'."
(0 ',cited-text-face))
keywords))
(setq level (1+ level)))
- keywords))
+ keywords)
+ ;; Match signature. This `field' stuff ensures that hitting `RET'
+ ;; after the signature separator doesn't remove the trailing space.
+ (list
+ '(message--match-signature (0 '( face message-signature-separator
+ rear-nonsticky t
+ field signature)))))
"Additional expressions to highlight in Message mode.")
+(defun message--match-signature (limit)
+ (save-excursion
+ (and (re-search-forward message-signature-separator limit t)
+ ;; It's the last one in the buffer.
+ (not (save-excursion
+ (re-search-forward message-signature-separator nil t))))))
+
(defvar message-face-alist
'((bold . message-bold-region)
(underline . underline-region)
@@ -2334,7 +2360,8 @@ Leading \"Re: \" is not stripped by this function. Use the function
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
(interactive
(list
- (read-from-minibuffer "New subject: ")))
+ (read-from-minibuffer "New subject: "))
+ message-mode)
(cond ((and (not (or (null new-subject) ; new subject not empty
(zerop (string-width new-subject))
(string-match "^[ \t]*$" new-subject))))
@@ -2364,7 +2391,7 @@ Leading \"Re: \" is not stripped by this function. Use the function
"Mark some region in the current article with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'.
If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
- (interactive "r\nP")
+ (interactive "r\nP" message-mode)
(save-excursion
;; add to the end of the region first, otherwise end would be invalid
(goto-char end)
@@ -2376,7 +2403,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
"Insert FILE at point, marking it with enclosing tags.
See `message-mark-insert-begin' and `message-mark-insert-end'.
If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
- (interactive "fFile to insert: \nP")
+ (interactive "fFile to insert: \nP" message-mode)
;; reverse insertion to get correct result.
(let ((p (point)))
(insert (if verbatim "#v-\n" message-mark-insert-end))
@@ -2390,7 +2417,7 @@ If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
The note can be customized using `message-archive-note'. When called with a
prefix argument, ask for a text to insert. If you don't want the note in the
body, set `message-archive-note' to nil."
- (interactive)
+ (interactive nil message-mode)
(if current-prefix-arg
(setq message-archive-note
(read-from-minibuffer "Reason for No-Archive: "
@@ -2416,7 +2443,8 @@ With prefix-argument just set Follow-Up, don't cross-post."
gnus-newsrc-alist)
nil nil '("poster" . 0)
(if (boundp 'gnus-group-history)
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ message-mode)
(message-remove-header "Follow[Uu]p-[Tt]o" t)
(message-goto-newsgroups)
(beginning-of-line)
@@ -2493,7 +2521,8 @@ With prefix-argument just set Follow-Up, don't cross-post."
gnus-newsrc-alist)
nil nil '("poster" . 0)
(if (boundp 'gnus-group-history)
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ message-mode)
(when (fboundp 'gnus-group-real-name)
(setq target-group (gnus-group-real-name target-group)))
(cond ((not (or (null target-group) ; new subject not empty
@@ -2528,7 +2557,7 @@ With prefix-argument just set Follow-Up, don't cross-post."
(defun message-reduce-to-to-cc ()
"Replace contents of To: header with contents of Cc: or Bcc: header."
- (interactive)
+ (interactive nil message-mode)
(let ((cc-content
(save-restriction (message-narrow-to-headers)
(message-fetch-field "cc")))
@@ -2694,7 +2723,7 @@ Point is left at the beginning of the narrowed-to region."
(defun message-sort-headers ()
"Sort headers of the current message according to `message-header-format-alist'."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(let ((max (1+ (length message-header-format-alist)))
@@ -2715,7 +2744,7 @@ Point is left at the beginning of the narrowed-to region."
(defun message-kill-address ()
"Kill the address under point."
- (interactive)
+ (interactive nil message-mode)
(let ((start (point)))
(message-skip-to-next-address)
(kill-region start (if (bolp) (1- (point)) (point)))))
@@ -2844,79 +2873,79 @@ Consider adding this function to `message-header-setup-hook'"
(unless message-mode-map
(setq message-mode-map (make-keymap))
(set-keymap-parent message-mode-map text-mode-map)
- (define-key message-mode-map "\C-c?" 'describe-mode)
-
- (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
- (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
- (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
- (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
- (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
- (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
- (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
- (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
- (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
- (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
- (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
+ (define-key message-mode-map "\C-c?" #'describe-mode)
+
+ (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to)
+ (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from)
+ (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc)
+ (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc)
+ (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc)
+ (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject)
+ (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to)
+ (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups)
+ (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution)
+ (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords)
+ (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary)
(define-key message-mode-map "\C-c\C-f\C-i"
- 'message-insert-or-toggle-importance)
+ #'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-f\C-a"
- 'message-generate-unsubscribed-mail-followup-to)
+ #'message-generate-unsubscribed-mail-followup-to)
;; modify headers (and insert notes in body)
- (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
+ (define-key message-mode-map "\C-c\C-fs" #'message-change-subject)
;;
- (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
+ (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to)
;; prefix+message-cross-post-followup-to = same w/o cross-post
- (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
- (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
+ (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc)
+ (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header)
;; mark inserted text
- (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
- (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
+ (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region)
+ (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file)
- (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
- (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+ (define-key message-mode-map "\C-c\C-b" #'message-goto-body)
+ (define-key message-mode-map "\C-c\C-i" #'message-goto-signature)
- (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
- (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
- (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
- (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
- (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
+ (define-key message-mode-map "\C-c\C-t" #'message-insert-to)
+ (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply)
+ (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups)
+ (define-key message-mode-map "\C-c\C-l" #'message-to-list-only)
+ (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires)
- (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\M-n"
- 'message-insert-disposition-notification-to)
-
- (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
- (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
- (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
- (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
- (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
- (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
- (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
- (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
-
- (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
- (define-key message-mode-map "\C-c\C-s" 'message-send)
- (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
- (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
- (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
-
- (define-key message-mode-map "\C-c\M-k" 'message-kill-address)
- (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
- (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
- (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
- (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- (define-key message-mode-map [remap split-line] 'message-split-line)
-
- (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
- (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot)
-
- (define-key message-mode-map "\C-a" 'message-beginning-of-line)
- (define-key message-mode-map "\t" 'message-tab)
-
- (define-key message-mode-map "\M-n" 'message-display-abbrev))
+ #'message-insert-disposition-notification-to)
+
+ (define-key message-mode-map "\C-c\C-y" #'message-yank-original)
+ (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer)
+ (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message)
+ (define-key message-mode-map "\C-c\C-w" #'message-insert-signature)
+ (define-key message-mode-map "\C-c\M-h" #'message-insert-headers)
+ (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body)
+ (define-key message-mode-map "\C-c\C-o" #'message-sort-headers)
+ (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer)
+
+ (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit)
+ (define-key message-mode-map "\C-c\C-s" #'message-send)
+ (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer)
+ (define-key message-mode-map "\C-c\C-d" #'message-dont-send)
+ (define-key message-mode-map "\C-c\n" #'gnus-delay-article)
+
+ (define-key message-mode-map "\C-c\M-k" #'message-kill-address)
+ (define-key message-mode-map "\C-c\C-e" #'message-elide-region)
+ (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region)
+ (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature)
+ (define-key message-mode-map "\M-\r" #'message-newline-and-reformat)
+ (define-key message-mode-map [remap split-line] #'message-split-line)
+
+ (define-key message-mode-map "\C-c\C-a" #'mml-attach-file)
+ (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot)
+
+ (define-key message-mode-map "\C-a" #'message-beginning-of-line)
+ (define-key message-mode-map "\t" #'message-tab)
+
+ (define-key message-mode-map "\M-n" #'message-display-abbrev))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
@@ -3166,14 +3195,13 @@ Like `text-mode', but with these additional commands:
;; `electric-pair-mode', and C-M-* navigation by syntactically
;; excluding citations and other artifacts.
;;
- (setq-local syntax-propertize-function 'message--syntax-propertize)
+ (setq-local syntax-propertize-function #'message--syntax-propertize)
(setq-local parse-sexp-ignore-comments t)
(setq-local message-encoded-mail-cache nil))
(defun message-setup-fill-variables ()
"Setup message fill variables."
(setq-local fill-paragraph-function #'message-fill-paragraph)
- (make-local-variable 'adaptive-fill-first-line-regexp)
(let ((quote-prefix-regexp
;; User should change message-cite-prefix-regexp if
;; message-yank-prefix is set to an abnormal value.
@@ -3208,87 +3236,87 @@ Like `text-mode', but with these additional commands:
(defun message-goto-to ()
"Move point to the To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "To"))
(defun message-goto-from ()
"Move point to the From header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "From"))
(defun message-goto-subject ()
"Move point to the Subject header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Subject"))
(defun message-goto-cc ()
"Move point to the Cc header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Cc" "To"))
(defun message-goto-bcc ()
"Move point to the Bcc header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Bcc" "Cc" "To"))
(defun message-goto-fcc ()
"Move point to the Fcc header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Fcc" "To" "Newsgroups"))
(defun message-goto-reply-to ()
"Move point to the Reply-To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Reply-To" "Subject"))
(defun message-goto-newsgroups ()
"Move point to the Newsgroups header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Newsgroups"))
(defun message-goto-distribution ()
"Move point to the Distribution header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Distribution"))
(defun message-goto-followup-to ()
"Move point to the Followup-To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Followup-To" "Newsgroups"))
(defun message-goto-mail-followup-to ()
"Move point to the Mail-Followup-To header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Mail-Followup-To" "To"))
(defun message-goto-keywords ()
"Move point to the Keywords header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Keywords" "Subject"))
(defun message-goto-summary ()
"Move point to the Summary header."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(message-position-on-field "Summary" "Subject"))
-(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1")
+(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1")
(defun message-goto-body (&optional interactive)
"Move point to the beginning of the message body.
Returns point."
- (interactive "p")
+ (interactive "p" message-mode)
(when interactive
(when (looking-at "[ \t]*\n")
(expand-abbrev))
@@ -3315,7 +3343,7 @@ Returns point."
(defun message-goto-eoh (&optional interactive)
"Move point to the end of the headers."
- (interactive "p")
+ (interactive "p" message-mode)
(message-goto-body interactive)
(forward-line -1))
@@ -3323,7 +3351,7 @@ Returns point."
"Move point to the beginning of the message signature.
If there is no signature in the article, go to the end and
return nil."
- (interactive)
+ (interactive nil message-mode)
(push-mark)
(goto-char (point-min))
(if (re-search-forward message-signature-separator nil t)
@@ -3342,7 +3370,7 @@ in the current mail buffer, and appends the current `user-mail-address'.
If the optional argument INCLUDE-CC is non-nil, the addresses in the
Cc: header are also put into the MFT."
- (interactive "P")
+ (interactive "P" message-mode)
(let* (cc tos)
(save-restriction
(message-narrow-to-headers)
@@ -3360,7 +3388,7 @@ Cc: header are also put into the MFT."
"Insert a To header that points to the author of the article being replied to.
If the original author requested not to be sent mail, don't insert unless the
prefix FORCE is given."
- (interactive "P")
+ (interactive "P" message-mode)
(let* ((mct (message-fetch-reply-field "mail-copies-to"))
(dont (and mct (or (equal (downcase mct) "never")
(equal (downcase mct) "nobody"))))
@@ -3379,7 +3407,7 @@ prefix FORCE is given."
(defun message-insert-wide-reply ()
"Insert To and Cc headers as if you were doing a wide reply."
- (interactive)
+ (interactive nil message-mode)
(let ((headers (message-with-reply-buffer
(message-get-reply-headers t))))
(message-carefully-insert-headers headers)))
@@ -3424,7 +3452,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
- (interactive)
+ (interactive nil message-mode)
(let ((follow-to
(and (buffer-live-p message-reply-buffer)
(with-current-buffer message-reply-buffer
@@ -3440,7 +3468,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
- (interactive)
+ (interactive nil message-mode)
(let ((old-newsgroups (mail-fetch-field "newsgroups"))
(new-newsgroups (message-fetch-reply-field "newsgroups"))
(first t)
@@ -3475,13 +3503,13 @@ or in the synonym headers, defined by `message-header-synonyms'."
(defun message-widen-and-recenter ()
"Widen the buffer and go to the start."
- (interactive)
+ (interactive nil message-mode)
(widen)
(goto-char (point-min)))
(defun message-delete-not-region (beg end)
"Delete everything in the body of the current message outside of the region."
- (interactive "r")
+ (interactive "r" message-mode)
(let (citeprefix)
(save-excursion
(goto-char beg)
@@ -3508,7 +3536,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
"Kill all text up to the signature.
If a numeric argument or prefix arg is given, leave that number
of lines before the signature intact."
- (interactive "P")
+ (interactive "P" message-mode)
(save-excursion
(save-restriction
(let ((point (point)))
@@ -3526,7 +3554,7 @@ of lines before the signature intact."
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
Prefix arg means justify as well."
- (interactive (list (if current-prefix-arg 'full)))
+ (interactive (list (if current-prefix-arg 'full)) message-mode)
(unless (message-in-body-p)
(error "This command only works in the body of the message"))
(let (quoted point beg end leading-space bolp fill-paragraph-function)
@@ -3617,7 +3645,7 @@ Prefix arg means justify as well."
"Message specific function to fill a paragraph.
This function is used as the value of `fill-paragraph-function' in
Message buffers and is not meant to be called directly."
- (interactive (list (if current-prefix-arg 'full)))
+ (interactive (list (if current-prefix-arg 'full)) message-mode)
(if (message-point-in-header-p)
(message-fill-field)
(message-newline-and-reformat arg t))
@@ -3648,7 +3676,7 @@ more information.
If FORCE is 0 (or when called interactively), the global values
of the signature variables will be consulted if the local ones
are null."
- (interactive (list 0))
+ (interactive (list 0) message-mode)
(let ((message-signature message-signature)
(message-signature-file message-signature-file))
;; If called interactively and there's no signature to insert,
@@ -3707,7 +3735,7 @@ are null."
(defun message-insert-importance-high ()
"Insert header to mark message as important."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -3717,7 +3745,7 @@ are null."
(defun message-insert-importance-low ()
"Insert header to mark message as unimportant."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -3729,7 +3757,7 @@ are null."
"Insert a \"Importance: high\" header, or cycle through the header values.
The three allowed values according to RFC 1327 are `high', `normal'
and `low'."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(let ((new "high")
cur)
@@ -3749,7 +3777,7 @@ and `low'."
(defun message-insert-disposition-notification-to ()
"Request a disposition notification (return receipt) to this message.
Note that this should not be used in newsgroups."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -3764,7 +3792,7 @@ Note that this should not be used in newsgroups."
"Elide the text in the region.
An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
- (interactive "r")
+ (interactive "r" message-mode)
(let ((lines (count-lines b e))
(chars (- e b)))
(kill-region b e)
@@ -3781,7 +3809,8 @@ text was killed."
(min (point) (or (mark t) (point)))
(max (point) (or (mark t) (point)))
(when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
+ (prefix-numeric-value current-prefix-arg)))
+ message-mode)
(setq n (if (numberp n) (mod n 26) 13)) ;canonize N
(unless (or (zerop n) ; no action needed for a rot of 0
@@ -3815,7 +3844,8 @@ With prefix arg, specifies the number of places to rotate each letter forward.
Mail and USENET news headers are not rotated unless WIDE is non-nil."
(interactive (if current-prefix-arg
(list (prefix-numeric-value current-prefix-arg))
- (list nil)))
+ (list nil))
+ message-mode)
(save-excursion
(save-restriction
(when (and (not wide) (message-goto-body))
@@ -3835,7 +3865,7 @@ Mail and USENET news headers are not rotated unless WIDE is non-nil."
"Rename the *message* buffer to \"*message* RECIPIENT\".
If the function is run with a prefix, it will ask for a new buffer
name, rather than giving an automatic name."
- (interactive "Pbuffer name: ")
+ (interactive "Pbuffer name: " message-mode)
(save-excursion
(save-restriction
(goto-char (point-min))
@@ -3858,7 +3888,7 @@ name, rather than giving an automatic name."
(defun message-fill-yanked-message (&optional justifyp)
"Fill the paragraphs of a message yanked into this one.
Numeric argument means justify as well."
- (interactive "P")
+ (interactive "P" message-mode)
(save-excursion
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t)
@@ -3923,7 +3953,7 @@ If REMOVE is non-nil, remove newlines, too.
To use this automatically, you may add this function to
`gnus-message-setup-hook'."
- (interactive "P")
+ (interactive "P" message-mode)
(let ((citexp (concat "^\\("
(concat message-yank-cited-prefix "\\|")
message-yank-prefix
@@ -3988,7 +4018,7 @@ This function uses `message-cite-function' to do the actual citing.
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
- (interactive "P")
+ (interactive "P" message-mode)
;; eval the let forms contained in message-cite-style
(let ((bindings (if (symbolp message-cite-style)
(symbol-value message-cite-style)
@@ -3999,7 +4029,7 @@ prefix, and don't delete any headers."
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
- (interactive "bYank buffer: ")
+ (interactive "bYank buffer: " message-mode)
(let ((message-reply-buffer (get-buffer buffer)))
(save-window-excursion
(message-yank-original))))
@@ -4226,7 +4256,7 @@ This function strips off the signature from the original message."
"Send message like `message-send', then, if no errors, exit from mail buffer.
The usage of ARG is defined by the instance that called Message.
It should typically alter the sending method in some way or other."
- (interactive "P")
+ (interactive "P" message-mode)
(let ((buf (current-buffer))
(position (point-marker))
(actions message-exit-actions))
@@ -4246,7 +4276,7 @@ It should typically alter the sending method in some way or other."
(defun message-dont-send ()
"Don't send the message you have been editing.
Instead, just auto-save the buffer and then bury it."
- (interactive)
+ (interactive nil message-mode)
(set-buffer-modified-p t)
(save-buffer)
(let ((actions message-postpone-actions))
@@ -4255,7 +4285,7 @@ Instead, just auto-save the buffer and then bury it."
(defun message-kill-buffer ()
"Kill the current buffer."
- (interactive)
+ (interactive nil message-mode)
(when (or (not (buffer-modified-p))
(not message-kill-buffer-query)
(yes-or-no-p "Message modified; kill anyway? "))
@@ -4304,7 +4334,7 @@ Otherwise any failure is reported in a message back to the user from
the mailer.
The usage of ARG is defined by the instance that called Message.
It should typically alter the sending method in some way or other."
- (interactive "P")
+ (interactive "P" message-mode)
;; Make it possible to undo the coming changes.
(undo-boundary)
(let ((inhibit-read-only t))
@@ -4572,7 +4602,7 @@ An address might be bogus if there's a matching entry in
"Warn before composing or sending a mail to an invalid address.
This function could be useful in `message-setup-hook'."
- (interactive)
+ (interactive nil message-mode)
(save-restriction
(message-narrow-to-headers)
(dolist (hdr '("To" "Cc" "Bcc"))
@@ -4892,6 +4922,7 @@ Each line should be no more than 79 characters long."
(defvar smtpmail-smtp-service)
(defvar smtpmail-smtp-user)
(defvar smtpmail-stream-type)
+(defvar smtpmail-store-queue-variables)
(defun message-multi-smtp-send-mail ()
"Send the current buffer to `message-send-mail-function'.
@@ -4907,7 +4938,8 @@ that instead."
(message-send-mail-with-sendmail))
((equal (car method) "smtp")
(require 'smtpmail)
- (let* ((smtpmail-smtp-server (nth 1 method))
+ (let* ((smtpmail-store-queue-variables t)
+ (smtpmail-smtp-server (nth 1 method))
(service (nth 2 method))
(port (string-to-number service))
;; If we're talking to the TLS SMTP port, then force a
@@ -5308,7 +5340,7 @@ Otherwise, generate and save a value for `canlock-password' first."
(followup-to (message-fetch-field "followup-to"))
to)
(when (and newsgroups
- (string-match "," newsgroups)
+ (string-search "," newsgroups)
(not followup-to)
(not
(zerop
@@ -5325,7 +5357,7 @@ Otherwise, generate and save a value for `canlock-password' first."
;; Check "Shoot me".
(message-check 'shoot
(if (re-search-forward
- "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
+ "Message-ID.*.mail-host-address-is-not-set" nil t)
(y-or-n-p "You appear to have a misconfigured system. Really post? ")
t))
;; Check for Approved.
@@ -5339,11 +5371,11 @@ Otherwise, generate and save a value for `canlock-password' first."
(message-id (message-fetch-field "message-id" t)))
(or (not message-id)
;; Is there an @ in the ID?
- (and (string-match "@" message-id)
+ (and (string-search "@" message-id)
;; Is there a dot in the ID?
(string-match "@[^.]*\\." message-id)
;; Does the ID end with a dot?
- (not (string-match "\\.>" message-id)))
+ (not (string-search ".>" message-id)))
(y-or-n-p
(format "The Message-ID looks strange: \"%s\". Really post? "
message-id)))))
@@ -5465,8 +5497,8 @@ Otherwise, generate and save a value for `canlock-password' first."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-search ".." ad) ;larsi@ifi..uio
+ (string-search "@." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
(string-match "(.*).*(.*)" from)) ;(lars) (lars)
@@ -5491,7 +5523,7 @@ Otherwise, generate and save a value for `canlock-password' first."
(cond
((not reply-to)
t)
- ((string-match "," reply-to)
+ ((string-search "," reply-to)
(y-or-n-p
(format "Multiple Reply-To addresses: \"%s\". Really post? "
reply-to)))
@@ -5499,8 +5531,8 @@ Otherwise, generate and save a value for `canlock-password' first."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
reply-to))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-search ".." ad) ;larsi@ifi..uio
+ (string-search "@." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
(string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
@@ -5744,7 +5776,7 @@ If NOW, use that time instead."
(defun message-insert-expires (days)
"Insert the Expires header. Expiry in DAYS days."
- (interactive "NExpire article in how many days? ")
+ (interactive "NExpire article in how many days? " message-mode)
(save-excursion
(message-position-on-field "Expires" "X-Draft-From")
(insert (message-make-expires-date days))))
@@ -5774,7 +5806,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
(mail-header-subject message-reply-headers))
(message-strip-subject-re psubject))))
(and psupersedes
- (string-match "_-_@" psupersedes)))
+ (string-search "_-_@" psupersedes)))
"_-_" ""))
"@" (message-make-fqdn) ">"))
@@ -5990,7 +6022,7 @@ give as trustworthy answer as possible."
"Return the pertinent part of `user-mail-address'."
(when (and user-mail-address
(string-match "@.*\\." user-mail-address))
- (if (string-match " " user-mail-address)
+ (if (string-search " " user-mail-address)
(nth 1 (mail-extract-address-components user-mail-address))
user-mail-address)))
@@ -6021,7 +6053,7 @@ give as trustworthy answer as possible."
message-user-fqdn)
;; A system name without any dots is unlikely to be a good fully
;; qualified domain name.
- ((and (string-match "[.]" sysname)
+ ((and (string-search "." sysname)
(not (string-match message-bogus-system-names sysname)))
;; `system-name' returned the right result.
sysname)
@@ -6036,8 +6068,7 @@ give as trustworthy answer as possible."
user-domain)
;; Default to this bogus thing.
(t
- (concat sysname
- ".i-did-not-set--mail-host-address--so-tickle-me")))))
+ (concat sysname ".mail-host-address-is-not-set")))))
(defun message-make-domain ()
"Return the domain name."
@@ -6047,7 +6078,7 @@ give as trustworthy answer as possible."
(defun message-to-list-only ()
"Send a message to the list only.
Remove all addresses but the list address from To and Cc headers."
- (interactive)
+ (interactive nil message-mode)
(let ((listaddr (message-make-mail-followup-to t)))
(when listaddr
(save-excursion
@@ -6133,7 +6164,7 @@ subscribed address (and not the additional To and Cc header contents)."
(defun message-idna-to-ascii-rhs ()
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
See `message-idna-encode'."
- (interactive)
+ (interactive nil message-mode)
(when message-use-idna
(save-excursion
(save-restriction
@@ -6351,7 +6382,7 @@ Headers already prepared in the buffer are not modified."
(defun message-split-line ()
"Split current line, moving portion beyond point vertically down.
If the current line has `message-yank-prefix', insert it on the new line."
- (interactive "*")
+ (interactive "*" message-mode)
(split-line message-yank-prefix))
(defun message-insert-header (header value)
@@ -6549,7 +6580,7 @@ When called without a prefix argument, header value spanning
multiple lines is treated as a single line. Otherwise, even if
N is 1, when point is on a continuation header line, it will be
moved to the beginning "
- (interactive "^p")
+ (interactive "^p" message-mode)
(cond
;; Go to beginning of header or beginning of line.
((and message-beginning-of-line (message-point-in-header-p))
@@ -6657,9 +6688,8 @@ moved to the beginning "
(not (buffer-modified-p buffer)))
(kill-buffer buffer))))
;; Rename the buffer.
- (if message-send-rename-function
- (funcall message-send-rename-function)
- (message-default-send-rename-function))
+ (funcall (or message-send-rename-function
+ #'message-default-send-rename-function))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
@@ -6758,8 +6788,9 @@ are not included."
(defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions)
(condition-case nil
+ ;; FIXME: Use functions rather than expressions!
(add-to-list 'message-send-actions
- `(apply ',(car action) ',(cdr action)))))
+ `(apply #',(car action) ',(cdr action)))))
(setq message-return-action return-action)
(setq message-reply-buffer
(if (and (consp yank-action)
@@ -6874,7 +6905,7 @@ are not included."
(defun message-insert-headers ()
"Generate the headers for the article."
- (interactive)
+ (interactive nil message-mode)
(save-excursion
(save-restriction
(message-narrow-to-headers)
@@ -6898,7 +6929,7 @@ are not included."
;;;###autoload
(defun message-mail (&optional to subject other-headers continue
switch-function yank-action send-actions
- return-action &rest ignored)
+ return-action &rest _)
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
@@ -7022,7 +7053,7 @@ article, it has the value of
" mft "
-which directs your response to " (if (string-match "," mft)
+which directs your response to " (if (string-search "," mft)
"the specified addresses"
"that address only") ".
@@ -7122,15 +7153,12 @@ want to get rid of this query permanently.")))
;; specific, and just Cc-in the rest.
(setq follow-to (list
(cons 'To
- (mapconcat
- (lambda (addr)
- (cdr addr)) recipients ", "))))
+ (mapconcat #'cdr recipients ", "))))
;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc.
(when recipients
- (setq recipients (mapconcat
- (lambda (addr) (cdr addr)) recipients ", "))
+ (setq recipients (mapconcat #'cdr recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))))
@@ -7329,7 +7357,7 @@ want to get rid of this query permanently."))
You should normally obey the Followup-To: header.
`Followup-To: " followup-to "'
-directs your response to " (if (string-match "," followup-to)
+directs your response to " (if (string-search "," followup-to)
"the specified newsgroups"
"that newsgroup only") ".
@@ -7857,7 +7885,7 @@ is for the internal use."
(interactive)
(setq rmail-enable-mime-composing t)
(setq rmail-insert-mime-forwarded-message-function
- 'message-forward-rmail-make-body))
+ #'message-forward-rmail-make-body))
;;;###autoload
(defun message-resend (address)
@@ -8214,7 +8242,7 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed."
Execute function specified by `message-tab-body-function' when
not in those headers. If that variable is nil, indent with the
regular text mode tabbing command."
- (interactive)
+ (interactive nil message-mode)
(cond
((let ((completion-fail-discreetly t))
(completion-at-point))
@@ -8571,7 +8599,7 @@ From headers in the original article."
(let ((value (message-field-value header)))
(dolist (string (mail-header-parse-addresses value 'raw))
(setq string
- (replace-regexp-in-string
+ (string-replace
"\n" ""
(replace-regexp-in-string "^ +\\| +$" "" string)))
(ecomplete-add-item 'mail (car (mail-header-parse-address string))
@@ -8591,7 +8619,7 @@ From headers in the original article."
(defun message-display-abbrev (&optional choose)
"Display the next possible abbrev for the text before point."
- (interactive (list t))
+ (interactive (list t) message-mode)
(when (message--in-tocc-p)
(let* ((end (point))
(start (save-excursion
@@ -8678,7 +8706,7 @@ Unless FORCE, prompt before sending.
The messages are separated by `message-form-letter-separator'.
Header and body are separated by `mail-header-separator'."
- (interactive "P")
+ (interactive "P" message-mode)
(let ((sent 0) (skipped 0)
start end text
buff
@@ -8713,17 +8741,18 @@ Header and body are separated by `mail-header-separator'."
(defun message-replace-header (header new-value &optional after force)
"Remove HEADER and insert the NEW-VALUE.
-If AFTER, insert after this header. If FORCE, insert new field
-even if NEW-VALUE is empty."
+If AFTER, insert after this header. AFTER may be a list of
+headers. If FORCE, insert new field even if NEW-VALUE is empty."
;; Similar to `nnheader-replace-header' but for message buffers.
(save-excursion
(save-restriction
(message-narrow-to-headers)
(message-remove-header header))
(when (or force (> (length new-value) 0))
- (if after
- (message-position-on-field header after)
- (message-position-on-field header))
+ (apply #'message-position-on-field header
+ (if (listp after)
+ after
+ (list after)))
(insert new-value))))
(make-obsolete-variable
@@ -8746,7 +8775,7 @@ Used in `message-simplify-recipients'."
(make-obsolete 'message-simplify-recipients nil "27.1")
(defun message-simplify-recipients ()
- (interactive)
+ (interactive nil message-mode)
(dolist (hdr '("Cc" "To"))
(message-replace-header
hdr
@@ -8769,7 +8798,8 @@ Used in `message-simplify-recipients'."
(defun message-make-html-message-with-image-files (files)
"Make a message containing the current dired-marked image files."
- (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+ (interactive (list (dired-get-marked-files nil current-prefix-arg))
+ dired-mode)
(message-mail)
(message-goto-body)
(insert "<#part type=text/html>\n\n")
@@ -8780,7 +8810,7 @@ Used in `message-simplify-recipients'."
(defun message-toggle-image-thumbnails ()
"For any included image files, insert a thumbnail of that image."
- (interactive)
+ (interactive nil message-mode)
(let ((displayed nil))
(save-excursion
(goto-char (point-min))
@@ -8816,7 +8846,7 @@ starting the screenshotting process.
The `message-screenshot-command' variable says what command is
used to take the screenshot."
- (interactive "p")
+ (interactive "p" message-mode)
(unless (executable-find (car message-screenshot-command))
(error "Can't find %s to take the screenshot"
(car message-screenshot-command)))
@@ -8859,7 +8889,7 @@ used to take the screenshot."
(defun message-parse-mailto-url (url)
"Parse a mailto: url."
- (setq url (replace-regexp-in-string "\n" " " url))
+ (setq url (string-replace "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
(setq url (if (string-match "^\\?" url)
@@ -8885,24 +8915,25 @@ used to take the screenshot."
retval))
;;;###autoload
-(defun message-mailto ()
+(defun message-mailto (&optional url)
"Command to parse command line mailto: links.
This is meant to be used for MIME handlers: Setting the handler
for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
-will then start up Emacs ready to compose mail."
+will then start up Emacs ready to compose mail. For emacsclient use
+ emacsclient -e '(message-mailto \"%u\")'"
(interactive)
;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a>
(message-mail)
- (message-mailto-1 (pop command-line-args-left)))
+ (message-mailto-1 (or url (pop command-line-args-left))))
(defun message-mailto-1 (url)
(let ((args (message-parse-mailto-url url)))
(dolist (arg args)
(unless (equal (car arg) "body")
(message-position-on-field (capitalize (car arg)))
- (insert (replace-regexp-in-string
+ (insert (string-replace
"\r\n" "\n"
- (mapconcat #'identity (reverse (cdr arg)) ", ") nil t))))
+ (mapconcat #'identity (reverse (cdr arg)) ", ")))))
(when (assoc "body" args)
(message-goto-body)
(dolist (body (cdr (assoc "body" args)))
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 1ecceeedeb7..fdc83e1de6e 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -108,4 +108,4 @@
(provide 'mm-archive)
-;; mm-archive.el ends here
+;;; mm-archive.el ends here
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 02cd6af0c98..82d1de25f3d 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -649,7 +649,7 @@ MIME-Version header before proceeding."
(setq description (mail-decode-encoded-word-string
description)))))
(if (or (not ctl)
- (not (string-match "/" (car ctl))))
+ (not (string-search "/" (car ctl))))
(mm-dissect-singlepart
(list mm-dissect-default-type)
(and cte (intern (downcase (mail-header-strip-cte cte))))
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 0c25c8f8bcd..0c628055acb 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -72,14 +72,14 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
id
(with-current-buffer gnus-summary-buffer
(gnus-summary-article-number))))
- #'(lambda (a b)
- (let ((anumber (string-to-number
- (cdr (assq 'number
- (cdr (mm-handle-type a))))))
- (bnumber (string-to-number
- (cdr (assq 'number
- (cdr (mm-handle-type b)))))))
- (< anumber bnumber)))))
+ (lambda (a b)
+ (let ((anumber (string-to-number
+ (cdr (assq 'number
+ (cdr (mm-handle-type a))))))
+ (bnumber (string-to-number
+ (cdr (assq 'number
+ (cdr (mm-handle-type b)))))))
+ (< anumber bnumber)))))
(setq gnus-article-mime-handles
(mm-merge-handles gnus-article-mime-handles phandles))
(with-current-buffer (generate-new-buffer " *mm*")
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 3e36d6724ea..2ec75a0bc59 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -418,16 +418,18 @@ This is only used if `mm-inline-large-images' is set to
(fundamental-mode)
(goto-char (point-min)))
-(defvar gnus-original-article-buffer)
-(defvar gnus-article-prepare-hook)
-(defvar gnus-displaying-mime)
+(defvar mm-inline-message-prepare-function nil
+ "Function called by `mm-inline-message' to do client specific setup.
+It is called with one parameter -- the charset.")
(defun mm-inline-message (handle)
+ "Insert HANDLE (a message/rfc822 part) into the current buffer.
+This function will call `mm-inline-message-prepare-function'
+after inserting the part."
(let ((b (point))
(bolp (bolp))
(charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- gnus-displaying-mime handles)
+ (mm-handle-type handle) 'charset)))
(when (and charset
(stringp charset))
(setq charset (intern (downcase charset)))
@@ -437,16 +439,8 @@ This is only used if `mm-inline-large-images' is set to
(save-restriction
(narrow-to-region b b)
(mm-insert-part handle)
- (let (gnus-article-mime-handles
- ;; disable prepare hook
- gnus-article-prepare-hook
- (gnus-newsgroup-charset
- (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
- (or charset gnus-newsgroup-charset))))
- (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
- (run-hooks 'gnus-article-decode-hook))
- (gnus-article-prepare-display)
- (setq handles gnus-article-mime-handles))
+ (when mm-inline-message-prepare-function
+ (funcall mm-inline-message-prepare-function charset))
(goto-char (point-min))
(unless bolp
(insert "\n"))
@@ -454,9 +448,6 @@ This is only used if `mm-inline-large-images' is set to
(unless (bolp)
(insert "\n"))
(insert "----------\n\n")
- (when handles
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handles)))
(mm-handle-set-undisplayer
handle
(let ((beg (point-min-marker))
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index d41c9dd0d9a..b49793509fc 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -140,7 +140,7 @@ by default identifies the used encryption keys, giving away the
Bcc'ed identities. Clearly, this contradicts the original goal of
*blind* copies.
For an academic paper explaining the problem, see URL
-`http://crypto.stanford.edu/portia/papers/bb-bcc.pdf'.
+`https://crypto.stanford.edu/portia/papers/bb-bcc.pdf'.
Use this variable to specify e-mail addresses whose owners do not
mind if they are identifiable as recipients. This may be useful if
you use Bcc headers to encrypt e-mails to yourself."
@@ -250,7 +250,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead."
"Add MML tags to sign this MML part.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part
(or method mml-secure-method mml-default-sign-method)
'sign))
@@ -259,43 +259,43 @@ Use METHOD if given. Else use `mml-secure-method' or
"Add MML tags to encrypt this MML part.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part
(or method mml-secure-method mml-default-sign-method)))
(defun mml-secure-sign-pgp ()
"Add MML tags to PGP sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgp" 'sign))
(defun mml-secure-sign-pgpauto ()
"Add MML tags to PGP-auto sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgpauto" 'sign))
(defun mml-secure-sign-pgpmime ()
"Add MML tags to PGP/MIME sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgpmime" 'sign))
(defun mml-secure-sign-smime ()
"Add MML tags to S/MIME sign this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "smime" 'sign))
(defun mml-secure-encrypt-pgp ()
"Add MML tags to PGP encrypt this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgp"))
(defun mml-secure-encrypt-pgpmime ()
"Add MML tags to PGP/MIME encrypt this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "pgpmime"))
(defun mml-secure-encrypt-smime ()
"Add MML tags to S/MIME encrypt this MML part."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-part "smime"))
(defun mml-secure-is-encrypted-p (&optional tag-present)
@@ -358,7 +358,7 @@ either an error is raised or not."
(defun mml-unsecure-message ()
"Remove security related MML tags from message."
- (interactive)
+ (interactive nil mml-mode)
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^<#secure.*>\n" nil t)
@@ -369,7 +369,7 @@ either an error is raised or not."
"Add MML tags to sign the entire message.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message
(or method mml-secure-method mml-default-sign-method)
'sign))
@@ -378,7 +378,7 @@ Use METHOD if given. Else use `mml-secure-method' or
"Add MML tag to sign and encrypt the entire message.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message
(or method mml-secure-method mml-default-sign-method)
'signencrypt))
@@ -387,53 +387,53 @@ Use METHOD if given. Else use `mml-secure-method' or
"Add MML tag to encrypt the entire message.
Use METHOD if given. Else use `mml-secure-method' or
`mml-default-sign-method'."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message
(or method mml-secure-method mml-default-sign-method)
'encrypt))
(defun mml-secure-message-sign-smime ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "smime" 'sign))
(defun mml-secure-message-sign-pgp ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "pgp" 'sign))
(defun mml-secure-message-sign-pgpmime ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "pgpmime" 'sign))
(defun mml-secure-message-sign-pgpauto ()
"Add MML tag to encrypt/sign the entire message."
- (interactive)
+ (interactive nil mml-mode)
(mml-secure-message "pgpauto" 'sign))
(defun mml-secure-message-encrypt-smime (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt)))
(defun mml-secure-message-encrypt-pgp (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt)))
(defun mml-secure-message-encrypt-pgpmime (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt)))
(defun mml-secure-message-encrypt-pgpauto (&optional dontsign)
"Add MML tag to encrypt and sign the entire message.
If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
+ (interactive "P" mml-mode)
(mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt)))
;;; Common functionality for mml1991.el, mml2015.el, mml-smime.el
@@ -1022,7 +1022,7 @@ Returns non-nil if the user has chosen to use SENDER."
(if (eq 'OpenPGP protocol)
(epg-sign-string context (buffer-string) mode)
(epg-sign-string context
- (replace-regexp-in-string
+ (string-replace
"\n" "\r\n" (buffer-string))
t))
mml-secure-secret-key-id-list nil)
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 5c133e680af..959de0902e2 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -404,7 +404,7 @@ Content-Disposition: attachment; filename=smime.p7m
nil t)))))
(mm-sec-error 'gnus-info "Corrupted")
(throw 'error handle))
- (setq part (replace-regexp-in-string "\n" "\r\n" part)
+ (setq part (string-replace "\n" "\r\n" part)
context (epg-make-context 'CMS))
(condition-case error
;; (setq plain
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index f77e5c6434e..5f35e73cd7c 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -550,7 +550,7 @@ type detected."
(end (point))
(parsed (url-generic-parse-url (cdr (assq 'src (cadr img))))))
(when (and (null (url-type parsed))
- (url-filename parsed)
+ (not (zerop (length (url-filename parsed))))
(file-exists-p (url-filename parsed)))
(goto-char start)
(when (search-forward (url-filename parsed) end t)
@@ -1339,7 +1339,7 @@ If not set, `default-directory' will be used."
(defun mml-quote-region (beg end)
"Quote the MML tags in the region."
- (interactive "r")
+ (interactive "r" mml-mode)
(save-excursion
(save-restriction
;; Temporarily narrow the region to defend from changes
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 1af7d10d055..8c40fc79f00 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -863,7 +863,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
nil t))))
(mm-sec-error 'gnus-info "Corrupted")
(throw 'error handle))
- (setq part (replace-regexp-in-string "\n" "\r\n" part)
+ (setq part (string-replace "\n" "\r\n" part)
signature (mm-get-part signature)
context (epg-make-context))
(condition-case error
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 3e6f9e88eea..5f486f49703 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -323,7 +323,7 @@
(nnbabyl-possibly-change-newsgroup group server)
(nnmail-check-syntax)
(let ((buf (current-buffer))
- result beg)
+ result) ;; beg
(and
(nnmail-activate 'nnbabyl)
(save-excursion
@@ -331,7 +331,7 @@
(search-forward "\n\n" nil t)
(forward-line -1)
(save-excursion
- (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
+ (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) ;; beg
(delete-region (point) (progn (forward-line 1) (point)))))
(when nnmail-cache-accepted-message-ids
(nnmail-cache-insert (nnmail-fetch-field "message-id")
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 15003fabcd2..adf4427523f 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -558,7 +558,7 @@ all. This may very well take some time.")
(nnmail-activate 'nndiary)
;; Articles not listed in active-articles are already gone,
;; so don't try to expire them.
- (setq articles (gnus-intersection articles active-articles))
+ (setq articles (nreverse (seq-intersection articles active-articles #'eq)))
(while articles
(setq article (nndiary-article-to-file (setq number (pop articles))))
(if (and (nndiary-deletable-article-p group number)
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 1dd784d5a5b..2de5b83a7b2 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -706,7 +706,7 @@ deleted. Point is left where the deleted region was."
(if dont-check
(setq nnfolder-current-group group
nnfolder-current-buffer nil)
- (let (inf file)
+ (let (file) ;; inf
;; If we have to change groups, see if we don't already have
;; the folder in memory. If we do, verify the modtime and
;; destroy the folder if needed so we can rescan it.
@@ -718,7 +718,7 @@ deleted. Point is left where the deleted region was."
;; touched the file since last time.
(when (and nnfolder-current-buffer
(not (gnus-buffer-live-p nnfolder-current-buffer)))
- (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
+ (setq nnfolder-buffer-alist (delq nil nnfolder-buffer-alist) ;; inf
nnfolder-current-buffer nil))
(setq nnfolder-current-group group)
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 708887cb9c7..c35e89289a2 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -803,7 +803,7 @@ If FORMAT isn't a format string, it and all ARGS will be inserted
without formatting."
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (if (string-match "%" format)
+ (if (string-search "%" format)
(insert (apply #'format format args))
(apply #'insert format args))
t))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index f4f4ef89a9e..8a48cd87dba 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -95,7 +95,7 @@ Uses the same syntax as `nnmail-split-methods'.")
"Articles with the flags in the list will not be considered when splitting.")
(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'."
- "Emacs 24.1")
+ "24.1")
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
@@ -136,6 +136,16 @@ will fetch all parts that have types that match that string. A
likely value would be \"text/\" to automatically fetch all
textual parts.")
+(defvoo nnimap-keepalive-intervals (cons (* 60 15)
+ (* 60 5))
+ "Configuration for the nnimap keepalive timer.
+The value is a cons of two integers (each representing a number
+of seconds): the first is how often to run the keepalive
+function, the second is the seconds of inactivity required to
+send the actual keepalive command.
+
+Set to nil to disable keepalive commands altogether.")
+
(defgroup nnimap nil
"IMAP for Gnus."
:group 'gnus)
@@ -405,20 +415,22 @@ during splitting, which may be slow."
nil)))
(defun nnimap-keepalive ()
- (let ((now (current-time)))
+ (let ((now (current-time))
+ ;; Set this so we don't wait for a response.
+ (nnimap-streaming t))
(dolist (buffer nnimap-process-buffers)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and nnimap-object
(nnimap-last-command-time nnimap-object)
(time-less-p
- ;; More than five minutes since the last command.
- (* 5 60)
+ (cdr nnimap-keepalive-intervals)
(time-subtract
now
(nnimap-last-command-time nnimap-object))))
- (ignore-errors ;E.g. "buffer foo has no process".
- (nnimap-send-command "NOOP"))))))))
+ (with-local-quit
+ (ignore-errors ;E.g. "buffer foo has no process".
+ (nnimap-send-command "NOOP")))))))))
(defun nnimap-open-connection (buffer)
;; Be backwards-compatible -- the earlier value of nnimap-stream was
@@ -440,6 +452,7 @@ during splitting, which may be slow."
;; This is only needed for Windows XP or earlier
(defun nnimap-map-port (port)
+ (declare-function x-server-version "xfns.c" (&optional terminal))
(if (and (eq system-type 'windows-nt)
(<= (car (x-server-version)) 5)
(equal port "imaps"))
@@ -447,9 +460,12 @@ during splitting, which may be slow."
port))
(defun nnimap-open-connection-1 (buffer)
- (unless nnimap-keepalive-timer
- (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
- #'nnimap-keepalive)))
+ (unless (or nnimap-keepalive-timer
+ (null nnimap-keepalive-intervals))
+ (setq nnimap-keepalive-timer (run-at-time
+ (car nnimap-keepalive-intervals)
+ (car nnimap-keepalive-intervals)
+ #'nnimap-keepalive)))
(with-current-buffer (nnimap-make-process-buffer buffer)
(let* ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)
@@ -583,6 +599,13 @@ during splitting, which may be slow."
(eq nnimap-authenticator 'anonymous)
(eq nnimap-authenticator 'login)))
(nnimap-command "LOGIN %S %S" user password))
+ ((and (nnimap-capability "AUTH=XOAUTH2")
+ (eq nnimap-authenticator 'xoauth2))
+ (nnimap-command "AUTHENTICATE XOAUTH2 %s"
+ (base64-encode-string
+ (format "user=%s\001auth=Bearer %s\001\001"
+ (nnimap-quote-specials user)
+ (nnimap-quote-specials password)))))
((and (nnimap-capability "AUTH=CRAM-MD5")
(or (null nnimap-authenticator)
(eq nnimap-authenticator 'cram-md5)))
@@ -1061,7 +1084,9 @@ during splitting, which may be slow."
"UID COPY %s %S")
(nnimap-article-ranges (gnus-compress-sequence articles))
(nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target)))
- (set (if can-move 'deleted-articles 'articles-to-delete) articles))))
+ (if can-move
+ (setq deleted-articles articles)
+ (setq articles-to-delete articles)))))
t)
(t
(dolist (article articles)
@@ -1274,7 +1299,7 @@ If LIMIT, first try to limit the search to the N last articles."
(when (and (nnimap-greeting nnimap-object)
(string-match greeting-match (nnimap-greeting nnimap-object))
(eq type 'append)
- (string-match "\000" data))
+ (string-search "\000" data))
(let ((choice (gnus-multiple-choice
"Message contains NUL characters. Delete, continue, abort? "
'((?d "Delete NUL characters")
@@ -1613,13 +1638,15 @@ If LIMIT, first try to limit the search to the N last articles."
(setq start-article 1))
(let* ((unread
(gnus-compress-sequence
- (gnus-set-difference
- (gnus-set-difference
+ (seq-difference
+ (seq-difference
existing
(gnus-sorted-union
(cdr (assoc '%Seen flags))
- (cdr (assoc '%Deleted flags))))
- (cdr (assoc '%Flagged flags)))))
+ (cdr (assoc '%Deleted flags)))
+ #'eq)
+ (cdr (assoc '%Flagged flags))
+ #'eq)))
(read (gnus-range-difference
(cons start-article high) unread)))
(when (> start-article 1)
@@ -1734,7 +1761,7 @@ If LIMIT, first try to limit the search to the N last articles."
(let ((result nil))
(dolist (elem (split-string irange ","))
(push
- (if (string-match ":" elem)
+ (if (string-search ":" elem)
(let ((numbers (split-string elem ":")))
(cons (string-to-number (car numbers))
(string-to-number (cadr numbers))))
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 9826bc6172c..bcf01cfa9e7 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -240,11 +240,6 @@ If non-nil, also update the cache when copy or move articles."
:group 'nnmail
:type 'boolean)
-(make-obsolete-variable 'nnmail-spool-file 'mail-sources
- "Gnus 5.9 (Emacs 22.1)")
-;; revision 5.29 / p0-85 / Gnus 5.9
-;; Variable removed in No Gnus v0.7
-
(defcustom nnmail-resplit-incoming nil
"If non-nil, re-split incoming procmail sorted mail."
:group 'nnmail-procmail
@@ -1321,9 +1316,6 @@ Eudora has a broken References line, but an OK In-Reply-To."
(when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
(replace-match "\\1" t))))
-(defalias 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references)
-(make-obsolete 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references "Emacs 23.1")
-
(custom-add-option 'nnmail-prepare-incoming-header-hook
'nnmail-ignore-broken-references)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 46691e3494b..171f0813b38 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -21,7 +21,7 @@
;;; Commentary:
-;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>.
+;; Maildir format is documented at <URL:https://cr.yp.to/proto/maildir.html>.
;; nnmaildir also stores extra information in the .nnmaildir/ directory
;; within a maildir.
;;
@@ -87,7 +87,7 @@ See `nnmaildir-flag-mark-mapping'."
(defun nnmaildir--ensure-suffix (filename)
"Ensure that FILENAME contains the suffix \":2,\"."
- (if (string-match-p ":2," filename)
+ (if (string-search ":2," filename)
filename
(concat filename ":2,")))
@@ -637,13 +637,11 @@ This variable is set by `nnmaildir-request-article'.")
(funcall func (cdr entry)))))))
(defun nnmaildir--system-name ()
- (replace-regexp-in-string
+ (string-replace
":" "\\072"
- (replace-regexp-in-string
+ (string-replace
"/" "\\057"
- (replace-regexp-in-string "\\\\" "\\134" (system-name) nil 'literal)
- nil 'literal)
- nil 'literal))
+ (string-replace "\\" "\\134" (system-name)))))
(defun nnmaildir-request-type (_group &optional _article)
'mail)
@@ -937,9 +935,9 @@ This variable is set by `nnmaildir-request-article'.")
(setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
ro (nnmaildir--param pgname 'read-only))
- (insert (replace-regexp-in-string
+ (insert (string-replace
" " "\\ "
- (nnmaildir--grp-name group) nil t)
+ (nnmaildir--grp-name group))
" ")
(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
@@ -968,7 +966,7 @@ This variable is set by `nnmaildir-request-article'.")
(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
(insert " "
- (replace-regexp-in-string " " "\\ " gname nil t)
+ (string-replace " " "\\ " gname)
"\n")))))
'group)
@@ -1098,7 +1096,7 @@ This variable is set by `nnmaildir-request-article'.")
(insert " ")
(princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
nntp-server-buffer)
- (insert " " (replace-regexp-in-string " " "\\ " gname nil t) "\n")
+ (insert " " (string-replace " " "\\ " gname) "\n")
t))))
(defun nnmaildir-request-create-group (gname &optional server _args)
@@ -1262,7 +1260,7 @@ This variable is set by `nnmaildir-request-article'.")
(insert "\t" (nnmaildir--nov-get-beg nov) "\t"
(nnmaildir--art-msgid article) "\t"
(nnmaildir--nov-get-mid nov) "\tXref: nnmaildir "
- (replace-regexp-in-string " " "\\ " gname nil t) ":")
+ (string-replace " " "\\ " gname) ":")
(princ num nntp-server-buffer)
(insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
(catch 'return
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index c6aaf460ece..92944887f44 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1629,7 +1629,7 @@ SERVER."
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
;; mairix somehow does not like '$' in message-id
- (when (string-match "\\$" mid)
+ (when (string-search "$" mid)
(setq mid (concat mid "=")))
(while (string-match "\\$" mid)
(setq mid (replace-match "=," t t mid)))
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 231583fae83..0923b8eff34 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -503,6 +503,8 @@ as unread by Gnus.")
(setcdr active (1+ (cdr active))))
(cdr active)))
+(defvar nnmh-newsgroup-articles)
+
(defun nnmh-update-gnus-unreads (group)
;; Go through the .nnmh-articles file and compare with the actual
;; articles in this folder. The articles that are "new" will be
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index 7759951662a..4e8490125f1 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -34,6 +34,7 @@
(defmacro defvoo (var init &optional doc &rest map)
"The same as `defvar', only takes list of variables to MAP to."
(declare (indent 2)
+ (doc-string 3)
(debug (var init &optional doc &rest map)))
`(prog1
,(if doc
@@ -44,6 +45,7 @@
(defmacro deffoo (func args &rest forms)
"The same as `defun', only register FUNC."
(declare (indent 2)
+ (doc-string 3)
(debug (&define name lambda-list def-body)))
`(prog1
(defun ,func ,args ,@forms)
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index aa7c8e584a5..97c9f18a602 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -200,7 +200,7 @@ for decoding when the cdr that the data specify is not available.")
(nnrss-possibly-change-group group server)
(let ((e (assq article nnrss-group-data))
(nntp-server-buffer (or buffer nntp-server-buffer))
- err) ;; post
+ ) ;; err post
(when e
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -302,8 +302,7 @@ for decoding when the cdr that the data specify is not available.")
(when nnrss-content-function
(funcall nnrss-content-function e group article))))
(cond
- (err
- (nnheader-report 'nnrss err))
+ ;; (err (nnheader-report 'nnrss err))
((not e)
(nnheader-report 'nnrss "no such id: %d" article))
(t
@@ -786,7 +785,7 @@ It is useful when `(setq nnrss-use-local t)'."
(nnrss-node-just-text node)
node))
(cleaned-text (if text
- (replace-regexp-in-string
+ (string-replace
"\r\n" "\n"
(replace-regexp-in-string
"^[\000-\037\177]+\\|^ +\\| +$" ""
@@ -850,7 +849,7 @@ DATA should be the output of `xml-parse-region'."
(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list)
`(cond ((or (string-match (concat "^" ,base-uri) ,item)
- (not (string-match "://" ,item)))
+ (not (string-search "://" ,item)))
(setq ,onsite-list (append ,onsite-list (list ,item))))
(t (setq ,offsite-list (append ,offsite-list (list ,item))))))
@@ -931,60 +930,7 @@ Use Mark Pilgrim's `ultra-liberal rss locator'."
(setq rss-link (nnrss-rss-title-description
rss-ns href-data (car hrefs))))
(setq hrefs (cdr hrefs)))))
- (if rss-link
- rss-link
- ;; 4. check syndic8
- (nnrss-find-rss-via-syndic8 url))))))))
-
-(declare-function xml-rpc-method-call "ext:xml-rpc"
- (server-url method &rest params))
-
-(defun nnrss-find-rss-via-syndic8 (url)
- "Query syndic8 for the rss feeds it has for URL."
- (if (not (locate-library "xml-rpc"))
- (progn
- (message "XML-RPC is not available... not checking Syndic8.")
- nil)
- (require 'xml-rpc)
- (let ((feedid (xml-rpc-method-call
- "http://www.syndic8.com/xmlrpc.php"
- 'syndic8.FindSites
- url)))
- (when feedid
- (let* ((feedinfo (xml-rpc-method-call
- "http://www.syndic8.com/xmlrpc.php"
- 'syndic8.GetFeedInfo
- feedid))
- (urllist
- (delq nil
- (mapcar
- (lambda (listinfo)
- (if (string-equal
- (cdr (assoc "status" listinfo))
- "Syndicated")
- (cons
- (cdr (assoc "sitename" listinfo))
- (list
- (cons 'title
- (cdr (assoc
- "sitename" listinfo)))
- (cons 'href
- (cdr (assoc
- "dataurl" listinfo)))))))
- feedinfo))))
- (if (not (> (length urllist) 1))
- (cdar urllist)
- (let ((completion-ignore-case t)
- (selection
- (mapcar (lambda (listinfo)
- (cons (cdr (assoc "sitename" listinfo))
- (string-to-number
- (cdr (assoc "feedid" listinfo)))))
- feedinfo)))
- (cdr (assoc
- (gnus-completing-read
- "Multiple feeds found. Select one"
- selection t) urllist)))))))))
+ rss-link))))))
(defun nnrss-rss-p (data)
"Test if DATA is an RSS feed.
@@ -1008,9 +954,10 @@ Simply ensures that the first element is rss or rdf."
"Given EL (containing a parsed element) and URI (containing a string
that gives the URI for which you want to retrieve the namespace
prefix), return the prefix."
- (let* ((prefix (car (rassoc uri (dom-attributes
- (dom-search
- el
+ (let* ((dom (car el))
+ (prefix (car (rassoc uri (dom-attributes
+ (dom-search
+ dom
(lambda (node)
(rassoc uri (dom-attributes node))))))))
(nslist (if prefix
@@ -1023,6 +970,11 @@ prefix), return the prefix."
(concat ns ":")
ns)))
+(defun nnrss-find-rss-via-syndic8 (_url)
+ "This function is obsolete and does nothing. Syndic8 shut down in 2013."
+ (declare (obsolete nil "28.1"))
+ nil)
+
(provide 'nnrss)
;;; nnrss.el ends here
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index fffa2d27312..ecec705b326 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -33,7 +33,7 @@
;; turn be a vector of three elements: a real prefixed group name, an
;; article number in that group, and an integer score. The score is
;; not used by nnselect but may be used by other code to help in
-;; sorting. Most functions will just chose a fixed number, such as
+;; sorting. Most functions will just choose a fixed number, such as
;; 100, for this score.
;; For example the search function `gnus-search-run-query' applied to
@@ -100,8 +100,8 @@
(setq selection
(vconcat
(cl-map 'vector
- #'(lambda (art)
- (vector artgroup art artrsv))
+ (lambda (art)
+ (vector artgroup art artrsv))
(gnus-uncompress-sequence artseq)) selection)))
selection)))
@@ -211,12 +211,12 @@ as `(keyfunc member)' and the corresponding element is just
#'nnselect-article-group #'nnselect-article-number))
((eq ,type 'tuple)
(nnselect-categorize ,articles
- #'(lambda (elem)
- (nnselect-article-group (car elem)))
- #'(lambda (elem)
- (cons (nnselect-article-number
- (car elem))
- (cdr elem)))))
+ (lambda (elem)
+ (nnselect-article-group (car elem)))
+ (lambda (elem)
+ (cons (nnselect-article-number
+ (car elem))
+ (cdr elem)))))
(t
(nnselect-categorize ,articles
#'nnselect-article-group
@@ -464,8 +464,8 @@ If this variable is nil, or if the provided function returns nil,
(error "Group %s does not support article expiration" artgroup))
(unless (gnus-check-server (gnus-find-method-for-group artgroup))
(error "Couldn't open server for group %s" artgroup))
- (push (mapcar #'(lambda (art)
- (car (rassq art artids)))
+ (push (mapcar (lambda (art)
+ (car (rassq art artids)))
(let ((nnimap-expunge 'immediately))
(gnus-request-expire-articles
artlist artgroup force)))
@@ -549,8 +549,8 @@ If this variable is nil, or if the provided function returns nil,
(gnus-add-to-range
(gnus-info-read info)
(delq nil (mapcar
- #'(lambda (art)
- (unless (memq (cdr art) unread) (car art)))
+ (lambda (art)
+ (unless (memq (cdr art) unread) (car art)))
artids))))
(pcase-dolist (`(,type . ,mark-list) marks)
(let ((mark-type (gnus-article-mark-to-type type)) new)
@@ -560,19 +560,19 @@ If this variable is nil, or if the provided function returns nil,
(cond
((eq mark-type 'tuple)
(mapcar
- #'(lambda (id)
- (let (mark)
- (when
- (setq mark (assq (cdr id) mark-list))
- (cons (car id) (cdr mark)))))
+ (lambda (id)
+ (let (mark)
+ (when
+ (setq mark (assq (cdr id) mark-list))
+ (cons (car id) (cdr mark)))))
artids))
(t
(setq mark-list
(gnus-uncompress-range mark-list))
(mapcar
- #'(lambda (id)
- (when (memq (cdr id) mark-list)
- (car id))) artids)))))
+ (lambda (id)
+ (when (memq (cdr id) mark-list)
+ (car id))) artids)))))
(let ((previous (alist-get type newmarks)))
(if previous
(nconc previous new)
@@ -607,8 +607,8 @@ If this variable is nil, or if the provided function returns nil,
(let ((thread
(gnus-id-to-thread (mail-header-id header))))
(when thread
- (cl-some #'(lambda (x)
- (when (and x (> x 0)) x))
+ (cl-some (lambda (x)
+ (when (and x (> x 0)) x))
(gnus-articles-in-thread thread)))))))))
;; Check if search-based thread referral is permitted, and
;; available.
@@ -642,15 +642,15 @@ If this variable is nil, or if the provided function returns nil,
old-arts seq
headers)
(mapc
- #'(lambda (article)
- (if
- (setq seq
- (cl-position article
- gnus-newsgroup-selection :test 'equal))
- (push (1+ seq) old-arts)
- (setq gnus-newsgroup-selection
- (vconcat gnus-newsgroup-selection (vector article)))
- (cl-incf last)))
+ (lambda (article)
+ (if
+ (setq seq
+ (cl-position article
+ gnus-newsgroup-selection :test 'equal))
+ (push (1+ seq) old-arts)
+ (setq gnus-newsgroup-selection
+ (vconcat gnus-newsgroup-selection (vector article)))
+ (cl-incf last)))
new-nnselect-artlist)
(setq headers
(gnus-fetch-headers
@@ -671,9 +671,9 @@ If this variable is nil, or if the provided function returns nil,
(when (setq new-marks
(delq nil
(mapcar
- #'(lambda (art)
- (when (memq (cdr art) marked)
- (car art)))
+ (lambda (art)
+ (when (memq (cdr art) marked)
+ (car art)))
artids)))
(nconc
(symbol-value
@@ -777,7 +777,7 @@ If this variable is nil, or if the provided function returns nil,
Return an article list."
(let ((func (alist-get 'nnselect-function specs))
(args (alist-get 'nnselect-args specs)))
- (condition-case err
+ (condition-case-unless-debug err
(funcall func args)
(error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err)
[]))))
@@ -968,7 +968,6 @@ Pass NO-PARSE on to the search engine."
(gnus-group-make-search-group no-parse spec)))
-;; The end.
(provide 'nnselect)
;;; nnselect.el ends here
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 1eb604d6754..615a3c931bf 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -233,7 +233,7 @@ server there that you can connect to. See also
(const :format "" "password")
(string :format "Password: %v")))))))
-(make-obsolete 'nntp-authinfo-file nil "Emacs 24.1")
+(make-obsolete 'nntp-authinfo-file nil "24.1")
@@ -1697,7 +1697,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
;; article comes from that group, I'd say.
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
+ (not (string-search "," newsgroups)))
newsgroups)
;; If there is more than one group in the
;; Newsgroups header, then the Xref header should
@@ -1725,7 +1725,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
number (string-to-number (match-string 2 xref))))
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
+ (not (string-search "," newsgroups)))
(setq group newsgroups))
(group)
(t (setq group ""))))
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index b3b701e4126..03a0ff296f2 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -362,9 +362,9 @@ It is computed from the marks of individual component groups.")
(dolist (group nnvirtual-component-groups)
(setq unexpired (nconc unexpired
(mapcar
- #'(lambda (article)
- (nnvirtual-reverse-map-article
- group article))
+ (lambda (article)
+ (nnvirtual-reverse-map-article
+ group article))
(gnus-uncompress-range
(gnus-group-expire-articles-1 group))))))
(sort (delq nil unexpired) #'<)))
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index d3ed3600ad9..51408618904 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -83,12 +83,12 @@ This mode is an extended emacs-lisp mode.
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
- (interactive)
+ (interactive nil gnus-score-mode)
(princ (time-to-days nil) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
- (interactive)
+ (interactive nil gnus-score-mode)
(goto-char (point-min))
(let ((form (read (current-buffer))))
(erase-buffer)
@@ -98,7 +98,7 @@ This mode is an extended emacs-lisp mode.
(defun gnus-score-edit-exit ()
"Stop editing the score file."
- (interactive)
+ (interactive nil gnus-score-mode)
(unless (file-exists-p (file-name-directory (buffer-file-name)))
(make-directory (file-name-directory (buffer-file-name)) t))
(let ((coding-system-for-write score-mode-coding-system))
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 3ee59479cf5..32283af52bf 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -242,7 +242,7 @@ interactively. If there's no argument, do it at the current buffer."
(defun smiley-toggle-buffer (&optional arg)
"Toggle displaying smiley faces in article buffer.
With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
+ (interactive "P" gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
(if (if (numberp arg)
(> arg 0)
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 8900be5e4f1..e9f703e90c6 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -42,7 +42,7 @@
;; reflect this.
;;
;; The home of this file is in Gnus, but also available from
-;; http://josefsson.org/smime.html.
+;; https://josefsson.org/smime.html.
;;; Quick introduction:
@@ -672,7 +672,7 @@ The following commands are available:
(defun smime-exit ()
"Quit the S/MIME buffer."
- (interactive)
+ (interactive nil smime-mode)
(kill-buffer (current-buffer)))
;; Other functions
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index d87a6c2af0d..5fa280ea058 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -120,7 +120,8 @@ submitted at once. Internal variable.")
(defun spam-report-gmane-ham (&rest articles)
"Report ARTICLES as ham (unregister) through Gmane."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-summary-mode)
(let ((count 0))
(dolist (article articles)
(setq count (1+ count))
@@ -130,7 +131,8 @@ submitted at once. Internal variable.")
(defun spam-report-gmane-spam (&rest articles)
"Report ARTICLES as spam through Gmane."
- (interactive (gnus-summary-work-articles current-prefix-arg))
+ (interactive (gnus-summary-work-articles current-prefix-arg)
+ gnus-summary-mode)
(let ((count 0))
(dolist (article articles)
(setq count (1+ count))
@@ -157,7 +159,7 @@ submitted at once. Internal variable.")
rpt-host
(concat
"/"
- (replace-regexp-in-string
+ (string-replace
"/" ":"
(replace-regexp-in-string
"^.*article.gmane.org/" ""
@@ -222,7 +224,7 @@ the function specified by `spam-report-url-ping-function'."
(defcustom spam-report-user-mail-address
(and (stringp user-mail-address)
- (replace-regexp-in-string "@" "<at>" user-mail-address))
+ (string-replace "@" "<at>" user-mail-address))
"Mail address of this user used for spam reports to Gmane.
This is initialized based on `user-mail-address'."
:type '(choice string
@@ -376,4 +378,4 @@ Process queued spam reports."
(provide 'spam-report)
-;;; spam-report.el ends here.
+;;; spam-report.el ends here
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 70753cad9ca..ab9be0da890 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -492,7 +492,7 @@ Add user supplied modifications if supplied."
(let* ((probs (mapcar #'cadr spam-stat-score-data))
(prod (apply #'* probs))
(score0
- (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
+ (/ prod (+ prod (apply #'* (mapcar (lambda (x) (- 1 x))
probs)))))
(score1s
(condition-case nil
@@ -575,7 +575,6 @@ check the variable `spam-stat-score-data'."
(defun spam-stat-count ()
"Return size of `spam-stat'."
- (interactive)
(hash-table-count spam-stat))
(defun spam-stat-test-directory (dir &optional verbose)
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index f7288c98f6f..3f978918b9a 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -710,16 +710,8 @@ finds ham or spam.")
(defun spam-set-difference (list1 list2)
"Return a set difference of LIST1 and LIST2.
When either list is nil, the other is returned."
- (if (and list1 list2)
- ;; we have two non-nil lists
- (progn
- (dolist (item (append list1 list2))
- (when (and (memq item list1) (memq item list2))
- (setq list1 (delq item list1))
- (setq list2 (delq item list2))))
- (append list1 list2))
- ;; if either of the lists was nil, return the other one
- (if list1 list1 list2)))
+ (declare (obsolete seq-difference "28.1"))
+ (seq-difference list1 list2 #'eq))
(defun spam-group-ham-mark-p (group mark &optional spam)
"Checks if MARK is considered a ham mark in GROUP."
@@ -1327,7 +1319,7 @@ In the case of mover backends, checks the setting of
(new-articles (spam-list-articles
gnus-newsgroup-articles
classification))
- (changed-articles (spam-set-difference new-articles old-articles)))
+ (changed-articles (seq-difference new-articles old-articles #'eq)))
;; now that we have the changed articles, we go through the processors
(dolist (backend (spam-backend-list))
(let (unregister-list)
@@ -1604,7 +1596,6 @@ parameters. A string as a parameter will set the
`spam-split-group' to that string.
See the Info node `(gnus)Fancy Mail Splitting' for more details."
- (interactive)
(setq spam-split-last-successful-check nil)
(unless spam-split-disabled
(let ((spam-split-group-choice spam-split-group))
@@ -1654,7 +1645,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(defun spam-find-spam ()
"Detect spam in the current newsgroup using `spam-split'."
- (interactive)
+ (interactive nil gnus-summary-mode)
(let* ((group gnus-newsgroup-name)
(autodetect (gnus-parameter-spam-autodetect group))
@@ -2434,7 +2425,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-bogofilter-score (&optional recheck)
"Get the Bogofilter spamicity score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
@@ -2606,7 +2597,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-spamassassin-score (&optional recheck)
"Get the SpamAssassin score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
@@ -2673,7 +2664,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-bsfilter-score (&optional recheck)
"Get the Bsfilter spamicity score."
- (interactive "P")
+ (interactive "P" gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
@@ -2759,7 +2750,7 @@ With a non-nil REMOVE, remove the ADDRESSES."
;; return something sensible if the score can't be determined
(defun spam-crm114-score ()
"Get the CRM114 Mailfilter pR."
- (interactive)
+ (interactive nil gnus-summary-mode)
(save-window-excursion
(gnus-summary-show-article t)
(set-buffer gnus-article-buffer)
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index e17bd0a081b..233c50504bf 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -1,4 +1,4 @@
-;;; help-at-pt.el --- local help through the keyboard
+;;; help-at-pt.el --- local help through the keyboard -*- lexical-binding: t -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -42,9 +42,6 @@
;;
;; (global-set-key [C-tab] 'scan-buf-next-region)
;; (global-set-key [C-M-tab] 'scan-buf-previous-region)
-;;
-;; You do not have to do anything special to use the functionality
-;; provided by this file, because all important functions autoload.
;;; Code:
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index b03a4404129..2c7956d9680 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -126,29 +126,37 @@ with the current prefix. The files are chosen according to
:group 'help
:version "26.3")
+(defun help--symbol-class (s)
+ "Return symbol class characters for symbol S."
+ (when (stringp s)
+ (setq s (intern-soft s)))
+ (concat
+ (when (fboundp s)
+ (concat
+ (cond
+ ((commandp s) "c")
+ ((eq (car-safe (symbol-function s)) 'macro) "m")
+ (t "f"))
+ (and (let ((flist (indirect-function s)))
+ (advice--p (if (eq 'macro (car-safe flist)) (cdr flist) flist)))
+ "!")
+ (and (get s 'byte-obsolete-info) "-")))
+ (when (boundp s)
+ (concat
+ (if (custom-variable-p s) "u" "v")
+ (and (local-variable-if-set-p s) "'")
+ (and (ignore-errors (not (equal (symbol-value s) (default-value s)))) "*")
+ (and (get s 'byte-obsolete-variable) "-")))
+ (and (facep s) "a")
+ (and (fboundp 'cl-find-class) (cl-find-class s) "t")))
+
(defun help--symbol-completion-table-affixation (completions)
(mapcar (lambda (c)
(let* ((s (intern c))
(doc (condition-case nil (documentation s) (error nil)))
- (doc (and doc (substring doc 0 (string-match "\n" doc)))))
+ (doc (and doc (substring doc 0 (string-search "\n" doc)))))
(list c (propertize
- (concat (cond ((commandp s)
- "c") ; command
- ((eq (car-safe (symbol-function s)) 'macro)
- "m") ; macro
- ((fboundp s)
- "f") ; function
- ((custom-variable-p s)
- "u") ; user option
- ((boundp s)
- "v") ; variable
- ((facep s)
- "a") ; fAce
- ((and (fboundp 'cl-find-class)
- (cl-find-class s))
- "t") ; CL type
- (" ")) ; something else
- " ") ; prefix separator
+ (format "%-4s" (help--symbol-class s))
'face 'completions-annotations)
(if doc (propertize (format " -- %s" doc)
'face 'completions-annotations)
@@ -174,26 +182,47 @@ with the current prefix. The files are chosen according to
Functions on `help-fns-describe-function-functions' can use this
to get buffer-local values.")
+(defun help-fns--describe-function-or-command-prompt (&optional want-command)
+ "Prompt for a function from `describe-function' or `describe-command'.
+If optional argument WANT-COMMAND is non-nil, prompt for an
+interactive command."
+ (let* ((fn (if want-command
+ (caar command-history)
+ (function-called-at-point)))
+ (prompt (format-prompt (if want-command
+ "Describe command"
+ "Describe function")
+ fn))
+ (enable-recursive-minibuffers t)
+ (val (completing-read
+ prompt
+ #'help--symbol-completion-table
+ (lambda (f) (if want-command
+ (commandp f)
+ (or (fboundp f) (get f 'function-documentation))))
+ t nil nil
+ (and fn (symbol-name fn)))))
+ (unless (equal val "")
+ (setq fn (intern val)))
+ ;; These error messages are intended to be less technical for the
+ ;; `describe-command' case, as they are directed at users that are
+ ;; not necessarily ELisp programmers.
+ (unless (and fn (symbolp fn))
+ (user-error (if want-command
+ "You didn't specify a command's symbol"
+ "You didn't specify a function symbol")))
+ (unless (or (fboundp fn) (get fn 'function-documentation))
+ (user-error (if want-command
+ "Symbol is not a command: %s"
+ "Symbol's function definition is void: %s")
+ fn))
+ (list fn)))
+
;;;###autoload
(defun describe-function (function)
"Display the full documentation of FUNCTION (a symbol).
When called from lisp, FUNCTION may also be a function object."
- (interactive
- (let* ((fn (function-called-at-point))
- (enable-recursive-minibuffers t)
- (val (completing-read
- (format-prompt "Describe function" fn)
- #'help--symbol-completion-table
- (lambda (f) (or (fboundp f) (get f 'function-documentation)))
- t nil nil
- (and fn (symbol-name fn)))))
- (unless (equal val "")
- (setq fn (intern val)))
- (unless (and fn (symbolp fn))
- (user-error "You didn't specify a function symbol"))
- (unless (or (fboundp fn) (get fn 'function-documentation))
- (user-error "Symbol's function definition is void: %s" fn))
- (list fn)))
+ (interactive (help-fns--describe-function-or-command-prompt))
;; We save describe-function-orig-buffer on the help xref stack, so
;; it is restored by the back/forward buttons. 'help-buffer'
@@ -223,9 +252,14 @@ When called from lisp, FUNCTION may also be a function object."
(describe-function-1 function)
(with-current-buffer standard-output
;; Return the text we displayed.
- (buffer-string))))
- ))
+ (buffer-string))))))
+;;;###autoload
+(defun describe-command (command)
+ "Display the full documentation of COMMAND (a symbol).
+When called from lisp, COMMAND may also be a function object."
+ (interactive (help-fns--describe-function-or-command-prompt 'is-command))
+ (describe-function command))
;; Could be this, if we make symbol-file do the work below.
;; (defun help-C-file-name (subr-or-var kind)
@@ -242,7 +276,9 @@ If we can't find the file name, nil is returned."
(let ((docbuf (get-buffer-create " *DOC*"))
(name (if (eq 'var kind)
(concat "V" (symbol-name subr-or-var))
- (concat "F" (subr-name (advice--cd*r subr-or-var))))))
+ (concat "F" (if (symbolp subr-or-var)
+ (symbol-name subr-or-var)
+ (subr-name (advice--cd*r subr-or-var)))))))
(with-current-buffer docbuf
(goto-char (point-min))
(if (eobp)
@@ -466,13 +502,16 @@ suitable file is found, return nil."
;; If lots of ordinary text characters run this command,
;; don't mention them one by one.
(if (< (length non-modified-keys) 10)
- (princ (mapconcat #'key-description keys ", "))
+ (with-current-buffer standard-output
+ (insert (mapconcat #'help--key-description-fontified
+ keys ", ")))
(dolist (key non-modified-keys)
(setq keys (delq key keys)))
(if keys
- (progn
- (princ (mapconcat #'key-description keys ", "))
- (princ ", and many ordinary text characters"))
+ (with-current-buffer standard-output
+ (insert (mapconcat #'help--key-description-fontified
+ keys ", "))
+ (insert ", and many ordinary text characters"))
(princ "many ordinary text characters"))))
(when (or remapped keys non-modified-keys)
(princ ".")
@@ -668,7 +707,7 @@ FILE is the file where FUNCTION was probably defined."
;; Almost all entries are of the form "* ... in Emacs NN.MM."
;; but there are also a few in the form "* Emacs NN.MM is a bug
;; fix release ...".
- (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)"
+ (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)"
nil t))
(message "Ref found in non-versioned section in %S"
(file-name-nondirectory f))
@@ -713,7 +752,7 @@ FILE is the file where FUNCTION was probably defined."
(insert-text-button
(symbol-name group)
'action (lambda (_)
- (shortdoc-display-group group))
+ (shortdoc-display-group group object))
'follow-link t
'help-echo (purecopy "mouse-1, RET: show documentation group")))
groups)
@@ -802,6 +841,8 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
;; aliases before functions.
(aliased
(format-message "an alias for `%s'" real-def))
+ ((subr-native-elisp-p def)
+ (concat beg "native compiled Lisp function"))
((subrp def)
(concat beg (if (eq 'unevalled (cdr (subr-arity def)))
"special form"
@@ -848,7 +889,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
nil t)
(help-xref-button 1 'help-function real-def)))))
- (when file-name
+ (if (not file-name)
+ (with-current-buffer standard-output
+ (setq help-mode--current-data (list :symbol function)))
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
(princ (format-message " in `%s'"
@@ -857,6 +900,8 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(help-fns-short-filename file-name))))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
+ (setq help-mode--current-data (list :symbol function
+ :file file-name))
(save-excursion
(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
@@ -991,12 +1036,12 @@ it is displayed along with the global value."
(format-prompt "Describe variable" (and (symbolp v) v))
#'help--symbol-completion-table
(lambda (vv)
- ;; In case the variable only exists in the buffer
- ;; the command we switch back to that buffer before
- ;; we examine the variable.
- (with-current-buffer orig-buffer
- (or (get vv 'variable-documentation)
- (and (boundp vv) (not (keywordp vv))))))
+ (or (get vv 'variable-documentation)
+ (and (not (keywordp vv))
+ ;; Since the variable may only exist in the
+ ;; original buffer, we have to look for it
+ ;; there.
+ (buffer-local-boundp vv orig-buffer))))
t nil nil
(if (symbolp v) (symbol-name v))))
(list (if (equal val "")
@@ -1026,12 +1071,18 @@ it is displayed along with the global value."
(princ (if file-name
(progn
(princ (format-message
- " is a variable defined in `%s'.\n"
+ " is a variable defined in `%s'.\n\n"
(if (eq file-name 'C-source)
"C source code"
(help-fns-short-filename file-name))))
(with-current-buffer standard-output
- (save-excursion
+ (setq help-mode--current-data
+ (list :symbol variable
+ :type (if (eq file-name 'C-source)
+ 'variable
+ 'defvar)
+ :file file-name))
+ (save-excursion
(re-search-backward (substitute-command-keys
"`\\([^`']+\\)'")
nil t)
@@ -1040,6 +1091,9 @@ it is displayed along with the global value."
(if valvoid
"It is void as a variable."
"Its "))
+ (with-current-buffer standard-output
+ (setq help-mode--current-data (list :symbol variable
+ :type 'variable)))
(if valvoid
" is void as a variable."
(substitute-command-keys "'s ")))))
@@ -1162,7 +1216,6 @@ it is displayed along with the global value."
(with-current-buffer standard-output
(help-fns--ensure-empty-line))
- (princ "Documentation:\n")
(with-current-buffer standard-output
(insert (or doc "Not documented as a variable."))))
@@ -1410,7 +1463,10 @@ If FRAME is omitted or nil, use the selected frame."
(concat "\\(" customize-label "\\)") nil t)
(help-xref-button 1 'help-customize-face f)))
(setq file-name (find-lisp-object-file-name f 'defface))
- (when file-name
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol f))
+ (setq help-mode--current-data (list :symbol f
+ :file file-name))
(princ (substitute-command-keys "Defined in `"))
(princ (help-fns-short-filename file-name))
(princ (substitute-command-keys "'"))
@@ -1521,11 +1577,7 @@ current buffer and the selected frame, respectively."
(insert doc)
(delete-region (point)
(progn (skip-chars-backward " \t\n") (point)))
- (insert "\n\n"
- (eval-when-compile
- (propertize "\n" 'face
- '(:height 0.1 :inverse-video t :extend t)))
- "\n")
+ (insert "\n\n" (make-separator-line) "\n")
(when name
(insert (symbol-name symbol)
" is also a " name "." "\n\n"))))
@@ -1700,7 +1752,9 @@ keymap value."
(unless used-gentemp
(princ (format-message "%S is a keymap variable" keymap))
(if (not file-name)
- (princ ".\n\n")
+ (progn
+ (setq help-mode--current-data (list :symbol keymap))
+ (princ ".\n\n"))
(princ (format-message
" defined in `%s'.\n\n"
(if (eq file-name 'C-source)
@@ -1710,6 +1764,8 @@ keymap value."
(re-search-backward (substitute-command-keys
"`\\([^`']+\\)'")
nil t)
+ (setq help-mode--current-data (list :symbol keymap
+ :file file-name))
(help-xref-button 1 'help-variable-def
keymap file-name))))
(when (and (not (equal "" doc)) doc)
@@ -1743,7 +1799,7 @@ documentation for the major and minor modes of that buffer."
;; don't switch buffers before calling `help-buffer'.
(with-help-window (help-buffer)
(with-current-buffer buffer
- (let (minor-modes)
+ (let (minors)
;; Older packages do not register in minor-mode-list but only in
;; minor-mode-alist.
(dolist (x minor-mode-alist)
@@ -1766,19 +1822,19 @@ documentation for the major and minor modes of that buffer."
fmode)))
(push (list fmode pretty-minor-mode
(format-mode-line (assq mode minor-mode-alist)))
- minor-modes)))))
+ minors)))))
;; Narrowing is not a minor mode, but its indicator is part of
;; mode-line-modes.
(when (buffer-narrowed-p)
- (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
- (setq minor-modes
- (sort minor-modes
+ (push '(narrow-to-region "Narrow" " Narrow") minors))
+ (setq minors
+ (sort minors
(lambda (a b) (string-lessp (cadr a) (cadr b)))))
- (when minor-modes
+ (when minors
(princ "Enabled minor modes:\n")
(make-local-variable 'help-button-cache)
(with-current-buffer standard-output
- (dolist (mode minor-modes)
+ (dolist (mode minors)
(let ((mode-function (nth 0 mode))
(pretty-minor-mode (nth 1 mode))
(indicator (nth 2 mode)))
@@ -1817,7 +1873,8 @@ documentation for the major and minor modes of that buffer."
(princ " mode")
(let* ((mode major-mode)
(file-name (find-lisp-object-file-name mode nil)))
- (when file-name
+ (if (not file-name)
+ (setq help-mode--current-data (list :symbol mode))
(princ (format-message " defined in `%s'"
(help-fns-short-filename file-name)))
;; Make a hyperlink to the library.
@@ -1825,11 +1882,36 @@ documentation for the major and minor modes of that buffer."
(save-excursion
(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
- (help-xref-button 1 'help-function-def mode file-name)))))
- (princ ":\n")
- (princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
+ (setq help-mode--current-data (list :symbol mode
+ :file file-name))
+ (help-xref-button 1 'help-function-def mode file-name)))))
+ (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc)))
+ (with-current-buffer standard-output
+ (insert ":\n")
+ (insert fundoc)
+ (insert (help-fns--list-local-commands)))))))
;; For the sake of IELM and maybe others
nil)
+
+(defun help-fns--list-local-commands ()
+ (let ((functions nil))
+ (mapatoms
+ (lambda (sym)
+ (when (and (commandp sym)
+ ;; Ignore aliases.
+ (not (symbolp (symbol-function sym)))
+ ;; Ignore everything bound.
+ (not (where-is-internal sym nil t))
+ (apply #'derived-mode-p (command-modes sym)))
+ (push sym functions))))
+ (with-temp-buffer
+ (when functions
+ (setq functions (sort functions #'string<))
+ (insert "\n\nOther commands for this mode, not bound to any keys:\n\n")
+ (dolist (function functions)
+ (insert (format "`%s'\n" function))))
+ (buffer-string))))
+
;; Widgets.
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 791b10a878f..1fa9d82afd8 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -1,4 +1,4 @@
-;;; help-macro.el --- makes command line help such as help-for-help
+;;; help-macro.el --- makes command line help such as help-for-help -*- lexical-binding: t -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -25,11 +25,12 @@
;;; Commentary:
-;; This file supplies the macro make-help-screen which constructs
-;; single character dispatching with browsable help such as that provided
-;; by help-for-help. This can be used to make many modes easier to use; for
-;; example, the GNU Emacs Empire Tool uses this for every "nested" mode map
-;; called from the main mode map.
+;; This file supplies the macro `make-help-screen' which constructs
+;; single character dispatching with browsable help such as that
+;; provided by `help-for-help'. This can be used to make many modes
+;; easier to use; for example, the (long-since defunct) GNU Emacs
+;; Empire Tool used this for every "nested" mode map called from the
+;; main mode map.
;; The name of this package was changed from help-screen.el to
;; help-macro.el in order to fit in a 14-character limit.
@@ -59,12 +60,6 @@
;;-> (define-key c-mp "\C-h" 'help-for-empire-redistribute-map)
;;-> (define-key c-mp help-character 'help-for-empire-redistribute-map)
-;;; Change Log:
-;;
-;; 22-Jan-1991 Lynn Slater x2048
-;; Last Modified: Mon Oct 1 11:43:52 1990 #3 (Lynn Slater)
-;; documented better
-
;;; Code:
(require 'backquote)
@@ -83,7 +78,8 @@ gives the window that lists the options."
:type 'boolean
:group 'help)
-(defmacro make-help-screen (fname help-line help-text helped-map)
+(defmacro make-help-screen (fname help-line help-text helped-map
+ &optional buffer-name)
"Construct help-menu function name FNAME.
When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP.
If the command is the help character, FNAME displays HELP-TEXT
@@ -92,119 +88,128 @@ If HELP-TEXT contains the sequence `%THIS-KEY%', that is replaced
with the key sequence that invoked FNAME.
When FNAME finally does get a command, it executes that command
and then returns."
- (let ((doc-fn (intern (concat (symbol-name fname) "-doc"))))
- `(progn
- (defun ,doc-fn () ,help-text nil)
- (defun ,fname ()
- "Help command."
- (interactive)
- (let ((line-prompt
- (substitute-command-keys ,help-line)))
- (when three-step-help
- (message "%s" line-prompt))
- (let* ((help-screen (documentation (quote ,doc-fn)))
- ;; We bind overriding-local-map for very small
- ;; sections, *excluding* where we switch buffers
- ;; and where we execute the chosen help command.
- (local-map (make-sparse-keymap))
- (new-minor-mode-map-alist minor-mode-map-alist)
- (prev-frame (selected-frame))
- config new-frame key char)
- (when (string-match "%THIS-KEY%" help-screen)
- (setq help-screen
- (replace-match (key-description
- (substring (this-command-keys) 0 -1))
- t t help-screen)))
- (unwind-protect
- (let ((minor-mode-map-alist nil))
- (setcdr local-map ,helped-map)
- (define-key local-map [t] 'undefined)
- ;; Make the scroll bar keep working normally.
- (define-key local-map [vertical-scroll-bar]
- (lookup-key global-map [vertical-scroll-bar]))
- (if three-step-help
- (progn
- (setq key (let ((overriding-local-map local-map))
- (read-key-sequence nil)))
- ;; Make the HELP key translate to C-h.
- (if (lookup-key function-key-map key)
- (setq key (lookup-key function-key-map key)))
- (setq char (aref key 0)))
- (setq char ??))
- (when (or (eq char ??) (eq char help-char)
- (memq char help-event-list))
- (setq config (current-window-configuration))
- (pop-to-buffer " *Metahelp*" nil t)
- (and (fboundp 'make-frame)
- (not (eq (window-frame)
- prev-frame))
- (setq new-frame (window-frame)
- config nil))
- (setq buffer-read-only nil)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert help-screen))
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- (help-mode)
- (setq new-minor-mode-map-alist minor-mode-map-alist))
- (goto-char (point-min))
- (while (or (memq char (append help-event-list
- (cons help-char '(?? ?\C-v ?\s ?\177 delete backspace vertical-scroll-bar ?\M-v))))
- (eq (car-safe char) 'switch-frame)
- (equal key "\M-v"))
- (condition-case nil
- (cond
- ((eq (car-safe char) 'switch-frame)
- (handle-switch-frame char))
- ((memq char '(?\C-v ?\s))
- (scroll-up))
- ((or (memq char '(?\177 ?\M-v delete backspace))
- (equal key "\M-v"))
- (scroll-down)))
- (error nil))
- (let ((cursor-in-echo-area t)
- (overriding-local-map local-map))
- (setq key (read-key-sequence
- (format "Type one of the options listed%s: "
- (if (pos-visible-in-window-p
- (point-max))
- "" ", or SPACE or DEL to scroll")))
- char (aref key 0)))
-
- ;; If this is a scroll bar command, just run it.
- (when (eq char 'vertical-scroll-bar)
- (command-execute (lookup-key local-map key) nil key))))
- ;; We don't need the prompt any more.
- (message "")
- ;; Mouse clicks are not part of the help feature,
- ;; so reexecute them in the standard environment.
- (if (listp char)
- (setq unread-command-events
- (cons char unread-command-events)
- config nil)
- (let ((defn (lookup-key local-map key)))
- (if defn
- (progn
- (when config
- (set-window-configuration config)
- (setq config nil))
- ;; Temporarily rebind `minor-mode-map-alist'
- ;; to `new-minor-mode-map-alist' (Bug#10454).
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- ;; `defn' must make sure that its frame is
- ;; selected, so we won't iconify it below.
- (call-interactively defn))
- (when new-frame
- ;; Do not iconify the selected frame.
- (unless (eq new-frame (selected-frame))
- (iconify-frame new-frame))
- (setq new-frame nil)))
- (ding)))))
- (when config
- (set-window-configuration config))
- (when new-frame
- (iconify-frame new-frame))
- (setq minor-mode-map-alist new-minor-mode-map-alist))))))))
+ (declare (indent defun))
+ `(defun ,fname ()
+ "Help command."
+ (interactive)
+ (let ((line-prompt
+ (substitute-command-keys ,help-line)))
+ (when three-step-help
+ (message "%s" line-prompt))
+ (let* ((help-screen ,help-text)
+ ;; We bind overriding-local-map for very small
+ ;; sections, *excluding* where we switch buffers
+ ;; and where we execute the chosen help command.
+ (local-map (make-sparse-keymap))
+ (new-minor-mode-map-alist minor-mode-map-alist)
+ (prev-frame (selected-frame))
+ config new-frame key char)
+ (when (string-match "%THIS-KEY%" help-screen)
+ (setq help-screen
+ (replace-match (help--key-description-fontified
+ (substring (this-command-keys) 0 -1))
+ t t help-screen)))
+ (unwind-protect
+ (let ((minor-mode-map-alist nil))
+ (setcdr local-map ,helped-map)
+ (define-key local-map [t] 'undefined)
+ ;; Make the scroll bar keep working normally.
+ (define-key local-map [vertical-scroll-bar]
+ (lookup-key global-map [vertical-scroll-bar]))
+ (if three-step-help
+ (progn
+ (setq key (let ((overriding-local-map local-map))
+ (read-key-sequence nil)))
+ ;; Make the HELP key translate to C-h.
+ (if (lookup-key function-key-map key)
+ (setq key (lookup-key function-key-map key)))
+ (setq char (aref key 0)))
+ (setq char ??))
+ (when (or (eq char ??) (eq char help-char)
+ (memq char help-event-list))
+ (setq config (current-window-configuration))
+ (pop-to-buffer (or ,buffer-name " *Metahelp*") nil t)
+ (and (fboundp 'make-frame)
+ (not (eq (window-frame)
+ prev-frame))
+ (setq new-frame (window-frame)
+ config nil))
+ (setq buffer-read-only nil)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (substitute-command-keys help-screen)))
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ (help-mode)
+ (setq new-minor-mode-map-alist minor-mode-map-alist))
+ (goto-char (point-min))
+ (while (or (memq char (append help-event-list
+ (cons help-char '( ?? ?\C-v ?\s ?\177 ?\M-v ?\S-\s
+ deletechar backspace vertical-scroll-bar
+ next prior up down))))
+ (eq (car-safe char) 'switch-frame)
+ (equal key "\M-v"))
+ (condition-case nil
+ (cond
+ ((eq (car-safe char) 'switch-frame)
+ (handle-switch-frame char))
+ ((memq char '(?\C-v ?\s next))
+ (scroll-up))
+ ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace prior))
+ (equal key "\M-v"))
+ (scroll-down))
+ ((memq char '(down))
+ (scroll-up 1))
+ ((memq char '(up))
+ (scroll-down 1)))
+ (error nil))
+ (let ((cursor-in-echo-area t)
+ (overriding-local-map local-map))
+ (setq key (read-key-sequence
+ (format "Type one of the options listed%s: "
+ (if (pos-visible-in-window-p
+ (point-max))
+ ""
+ (concat ", or "
+ (help--key-description-fontified (kbd "<PageDown>"))
+ " or "
+ (help--key-description-fontified (kbd "<PageUp>"))
+ " to scroll"))))
+ char (aref key 0)))
+
+ ;; If this is a scroll bar command, just run it.
+ (when (eq char 'vertical-scroll-bar)
+ (command-execute (lookup-key local-map key) nil key))))
+ ;; We don't need the prompt any more.
+ (message "")
+ ;; Mouse clicks are not part of the help feature,
+ ;; so reexecute them in the standard environment.
+ (if (listp char)
+ (setq unread-command-events
+ (cons char unread-command-events)
+ config nil)
+ (let ((defn (lookup-key local-map key)))
+ (if defn
+ (progn
+ (when config
+ (set-window-configuration config)
+ (setq config nil))
+ ;; Temporarily rebind `minor-mode-map-alist'
+ ;; to `new-minor-mode-map-alist' (Bug#10454).
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ ;; `defn' must make sure that its frame is
+ ;; selected, so we won't iconify it below.
+ (call-interactively defn))
+ (when new-frame
+ ;; Do not iconify the selected frame.
+ (unless (eq new-frame (selected-frame))
+ (iconify-frame new-frame))
+ (setq new-frame nil)))
+ (ding)))))
+ (when config
+ (set-window-configuration config))
+ (when new-frame
+ (iconify-frame new-frame))
+ (setq minor-mode-map-alist new-minor-mode-map-alist))))))
(provide 'help-macro)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 79710a18073..87f26651e01 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -30,13 +30,11 @@
;;; Code:
(require 'cl-lib)
-(eval-when-compile (require 'easymenu))
(defvar help-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap button-buffer-map
special-mode-map))
- (define-key map [mouse-2] 'help-follow-mouse)
(define-key map "l" 'help-go-back)
(define-key map "r" 'help-go-forward)
(define-key map "\C-c\C-b" 'help-go-back)
@@ -44,7 +42,9 @@
(define-key map [XF86Back] 'help-go-back)
(define-key map [XF86Forward] 'help-go-forward)
(define-key map "\C-c\C-c" 'help-follow-symbol)
- (define-key map "\r" 'help-follow)
+ (define-key map "s" 'help-view-source)
+ (define-key map "i" 'help-goto-info)
+ (define-key map "c" 'help-customize)
map)
"Keymap for Help mode.")
@@ -54,30 +54,81 @@
["Show Help for Symbol" help-follow-symbol
:help "Show the docs for the symbol at point"]
["Previous Topic" help-go-back
- :help "Go back to previous topic in this help buffer"]
+ :help "Go back to previous topic in this help buffer"
+ :active help-xref-stack]
["Next Topic" help-go-forward
- :help "Go back to next topic in this help buffer"]
+ :help "Go back to next topic in this help buffer"
+ :active help-xref-forward-stack]
["Move to Previous Button" backward-button
:help "Move to the Previous Button in the help buffer"]
["Move to Next Button" forward-button
- :help "Move to the Next Button in the help buffer"]))
+ :help "Move to the Next Button in the help buffer"]
+ ["View Source" help-view-source
+ :help "Go to the source file for the current help item"]
+ ["Goto Info" help-goto-info
+ :help "Go to the info node for the current help item"]
+ ["Customize" help-customize
+ :help "Customize variable or face"]))
+
+(defun help-mode-context-menu (menu)
+ (define-key menu [help-mode-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Help-Mode")))
+ (easy-menu-define nil easy-menu nil
+ '("Help-Mode"
+ ["Previous Topic" help-go-back
+ :help "Go back to previous topic in this help buffer"
+ :active help-xref-stack]
+ ["Next Topic" help-go-forward
+ :help "Go back to next topic in this help buffer"
+ :active help-xref-forward-stack]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar help-mode])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (and
+ ;; First check if `help-fns--list-local-commands'
+ ;; used `where-is-internal' to call this function
+ ;; with wrong `last-input-event'.
+ (eq (current-buffer) (window-buffer (posn-window (event-start last-input-event))))
+ (mouse-posn-property (event-start last-input-event) 'mouse-face))
+ (define-key menu [help-mode-push-button]
+ '(menu-item "Follow Link" (lambda (event)
+ (interactive "e")
+ (push-button event))
+ :help "Follow the link at click")))
+
+ menu)
+
+(defvar help-mode-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (tool-bar-local-item "close" 'quit-window 'quit map
+ :help "Quit help"
+ :vert-only t)
+ (define-key-after map [separator-1] menu-bar-separator)
+ (tool-bar-local-item "search" 'isearch-forward 'search map
+ :help "Search" :vert-only t)
+ (tool-bar-local-item-from-menu 'help-go-back "left-arrow" map help-mode-map
+ :rtl "right-arrow" :vert-only t)
+ (tool-bar-local-item-from-menu 'help-go-forward "right-arrow" map help-mode-map
+ :rtl "left-arrow" :vert-only t)
+ map))
(defvar-local help-xref-stack nil
"A stack of ways by which to return to help buffers after following xrefs.
-Used by `help-follow' and `help-xref-go-back'.
+Used by `help-follow-symbol' and `help-xref-go-back'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-stack 'permanent-local t)
(defvar-local help-xref-forward-stack nil
"A stack used to navigate help forwards after using the back button.
-Used by `help-follow' and `help-xref-go-forward'.
+Used by `help-follow-symbol' and `help-xref-go-forward'.
An element looks like (POSITION FUNCTION ARGS...).
To use the element, do (apply FUNCTION ARGS) then goto the point.")
(put 'help-xref-forward-stack 'permanent-local t)
(defvar-local help-xref-stack-item nil
- "An item for `help-follow' in this buffer to push onto `help-xref-stack'.
+ "An item for `help-follow-symbol' to push onto `help-xref-stack'.
The format is (FUNCTION ARGS...).")
(put 'help-xref-stack-item 'permanent-local t)
@@ -89,6 +140,15 @@ The format is (FUNCTION ARGS...).")
(setq-default help-xref-stack nil help-xref-stack-item nil)
(setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil)
+(defvar help-mode-syntax-table
+ (let ((table (make-syntax-table emacs-lisp-mode-syntax-table)))
+ ;; Treat single quotes as parens so that forward-sexp does not
+ ;; break when a quoted string contains punctuation.
+ (modify-syntax-entry ?‘ "(’ " table)
+ (modify-syntax-entry ?’ ")‘ " table)
+ table)
+ "Syntax table used in `help-mode'.")
+
(defcustom help-mode-hook nil
"Hook run by `help-mode'."
:type 'hook
@@ -308,6 +368,7 @@ The format is (FUNCTION ARGS...).")
'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement"))
(defvar bookmark-make-record-function)
+(defvar help-mode--current-data nil)
;;;###autoload
(define-derived-mode help-mode special-mode "Help"
@@ -317,6 +378,10 @@ Commands:
\\{help-mode-map}"
(setq-local revert-buffer-function
#'help-mode-revert-buffer)
+ (add-hook 'context-menu-functions 'help-mode-context-menu 5 t)
+ (setq-local tool-bar-map
+ help-mode-tool-bar-map)
+ (setq-local help-mode--current-data nil)
(setq-local bookmark-make-record-function
#'help-bookmark-make-record))
@@ -438,7 +503,7 @@ Each element has the form (NAME TESTFUN DESCFUN) where:
"Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and activate such cross
-references for selection with `help-follow'. Cross-references have
+references for selection with `help-follow-symbol'. Cross-references have
the canonical form `...' and the type of reference may be
disambiguated by the preceding word(s) used in
`help-xref-symbol-regexp'. Faces only get cross-referenced if
@@ -458,14 +523,13 @@ that."
(with-current-buffer (or buffer (current-buffer))
(save-excursion
(goto-char (point-min))
- ;; Skip the header-type info, though it might be useful to parse
- ;; it at some stage (e.g. "function in `library'").
+ ;; Skip the first bit, which has already been buttonized.
(forward-paragraph)
(let ((old-modified (buffer-modified-p)))
(let ((stab (syntax-table))
(case-fold-search t)
(inhibit-read-only t))
- (set-syntax-table emacs-lisp-mode-syntax-table)
+ (set-syntax-table help-mode-syntax-table)
;; The following should probably be abstracted out.
(unwind-protect
(progn
@@ -618,7 +682,7 @@ See `help-make-xrefs'."
(defun help-xref-on-pp (from to)
"Add xrefs for symbols in `pp's output between FROM and TO."
(if (> (- to from) 5000) nil
- (with-syntax-table emacs-lisp-mode-syntax-table
+ (with-syntax-table help-mode-syntax-table
(save-excursion
(save-restriction
(narrow-to-region from to)
@@ -706,6 +770,34 @@ See `help-make-xrefs'."
(help-xref-go-forward (current-buffer))
(user-error "No next help buffer")))
+(defun help-view-source ()
+ "View the source of the current help item."
+ (interactive nil help-mode)
+ (unless (plist-get help-mode--current-data :file)
+ (error "Source file for the current help item is not defined"))
+ (help-function-def--button-function
+ (plist-get help-mode--current-data :symbol)
+ (plist-get help-mode--current-data :file)
+ (plist-get help-mode--current-data :type)))
+
+(defun help-goto-info ()
+ "View the *info* node of the current help item."
+ (interactive nil help-mode)
+ (unless help-mode--current-data
+ (error "No symbol to look up in the current buffer"))
+ (info-lookup-symbol (plist-get help-mode--current-data :symbol)
+ 'emacs-lisp-mode))
+
+(defun help-customize ()
+ "Customize variable or face whose doc string is shown in the current buffer."
+ (interactive nil help-mode)
+ (let ((sym (plist-get help-mode--current-data :symbol)))
+ (unless (or (boundp sym) (facep sym))
+ (user-error "No variable or face to customize"))
+ (cond
+ ((boundp sym) (customize-variable sym))
+ ((facep sym) (customize-face sym)))))
+
(defun help-do-xref (_pos function args)
"Call the help cross-reference function FUNCTION with args ARGS.
Things are set up properly so that the resulting help-buffer has
@@ -719,6 +811,7 @@ a proper [back] button."
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
"Follow the cross-reference that you click on."
+ (declare (obsolete nil "28.1"))
(interactive)
(error "No cross-reference here"))
@@ -727,6 +820,7 @@ a proper [back] button."
"Follow cross-reference at point.
For the cross-reference format, see `help-make-xrefs'."
+ (declare (obsolete nil "28.1"))
(interactive)
(user-error "No cross-reference here"))
@@ -778,8 +872,8 @@ help buffer by other means."
(&optional no-file no-context posn))
(defun help-bookmark-make-record ()
- "Create and return a help-mode bookmark record.
-Implements `bookmark-make-record-function' for help-mode buffers."
+ "Create and return a `help-mode' bookmark record.
+Implements `bookmark-make-record-function' for `help-mode' buffers."
(unless (car help-xref-stack-item)
(error "Cannot create bookmark - help command not known"))
`(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
@@ -792,7 +886,7 @@ Implements `bookmark-make-record-function' for help-mode buffers."
;;;###autoload
(defun help-bookmark-jump (bookmark)
- "Jump to help-mode bookmark BOOKMARK.
+ "Jump to `help-mode' bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((help-fn (bookmark-prop-get bookmark 'help-fn))
diff --git a/lisp/help.el b/lisp/help.el
index 084e941549e..29ae3404813 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -104,8 +104,9 @@
(define-key map "R" 'info-display-manual)
(define-key map "s" 'describe-syntax)
(define-key map "t" 'help-with-tutorial)
- (define-key map "w" 'where-is)
(define-key map "v" 'describe-variable)
+ (define-key map "w" 'where-is)
+ (define-key map "x" 'describe-command)
(define-key map "q" 'help-quit)
map)
"Keymap for characters following the Help key.")
@@ -187,65 +188,124 @@ Do not call this in the scope of `with-help-window'."
;; So keyboard macro definitions are documented correctly
(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
-(defalias 'help 'help-for-help-internal)
-;; find-function can find this.
-(defalias 'help-for-help 'help-for-help-internal)
-;; It can't find this, but nobody will look.
-(make-help-screen help-for-help-internal
+
+;;; Help for help. (a.k.a. `C-h C-h')
+
+(defvar help-for-help-buffer-name " *Metahelp*"
+ "Name of the `help-for-help' buffer.")
+
+(defface help-for-help-header '((t :height 1.26))
+ "Face used for headers in the `help-for-help' buffer."
+ :group 'help)
+
+(defun help--for-help-make-commands (commands)
+ "Create commands for `help-for-help' screen from COMMANDS."
+ (mapconcat
+ (lambda (cmd)
+ (if (listp cmd)
+ (let ((name (car cmd)) (desc (cadr cmd)))
+ (concat
+ " "
+ (if (string-match (rx string-start "C-" word string-end) name)
+ ;; `help--key-description-fontified' would convert "C-m" to
+ ;; "RET" so we can't use it here.
+ (propertize name 'face 'help-key-binding)
+ (concat "\\[" name "]"))
+ " " ; ensure we have some whitespace before the description
+ (propertize "\t" 'display '(space :align-to 8))
+ desc))
+ ""))
+ commands "\n"))
+
+(defun help--for-help-make-sections (sections)
+ "Create sections for `help-for-help' screen from SECTIONS."
+ (mapconcat
+ (lambda (section)
+ (let ((title (car section)) (commands (cdr section)))
+ (concat
+ "\n\n"
+ (propertize title 'face 'help-for-help-header)
+ "\n\n"
+ (help--for-help-make-commands commands))))
+ sections ""))
+
+(defalias 'help 'help-for-help)
+(make-help-screen help-for-help
(purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?")
- ;; Don't purecopy this one, because it's not evaluated (it's
- ;; directly used as a docstring in a function definition, so it'll
- ;; be moved to the DOC file anyway: no need for purecopying it).
- "You have typed %THIS-KEY%, the help character. Type a Help option:
-\(Use SPC or DEL to scroll through this text. Type \\<help-map>\\[help-quit] to exit the Help command.)
-
-a PATTERN Show commands whose name matches the PATTERN (a list of words
- or a regexp). See also the `apropos' command.
-b Display all key bindings.
-c KEYS Display the command name run by the given key sequence.
-C CODING Describe the given coding system, or RET for current ones.
-d PATTERN Show a list of functions, variables, and other items whose
- documentation matches the PATTERN (a list of words or a regexp).
-e Go to the *Messages* buffer which logs echo-area messages.
-f FUNCTION Display documentation for the given function.
-F COMMAND Show the Emacs manual's section that describes the command.
-g Display information about the GNU project.
-h Display the HELLO file which illustrates various scripts.
-i Start the Info documentation reader: read included manuals.
-I METHOD Describe a specific input method, or RET for current.
-k KEYS Display the full documentation for the key sequence.
-K KEYS Show the Emacs manual's section for the command bound to KEYS.
-l Show last 300 input keystrokes (lossage).
-L LANG-ENV Describes a specific language environment, or RET for current.
-m Display documentation of current minor modes and current major mode,
- including their special commands.
-n Display news of recent Emacs changes.
-o SYMBOL Display the given function or variable's documentation and value.
-p TOPIC Find packages matching a given topic keyword.
-P PACKAGE Describe the given Emacs Lisp package.
-r Display the Emacs manual in Info mode.
-R Prompt for a manual and then display it in Info mode.
-s Display contents of current syntax table, plus explanations.
-S SYMBOL Show the section for the given symbol in the Info manual
- for the programming language used in this buffer.
-t Start the Emacs learn-by-doing tutorial.
-v VARIABLE Display the given variable's documentation and value.
-w COMMAND Display which keystrokes invoke the given command (where-is).
-. Display any available local help at point in the echo area.
-
-C-a Information about Emacs.
-C-c Emacs copying permission (GNU General Public License).
-C-d Instructions for debugging GNU Emacs.
-C-e External packages and information about Emacs.
-C-f Emacs FAQ.
-C-m How to order printed Emacs manuals.
-C-n News of recent Emacs changes.
-C-o Emacs ordering and distribution information.
-C-p Info about known Emacs problems.
-C-s Search forward \"help window\".
-C-t Emacs TODO list.
-C-w Information on absence of warranty for GNU Emacs."
- help-map)
+ (concat
+ "(Type "
+ (help--key-description-fontified (kbd "<PageDown>"))
+ " or "
+ (help--key-description-fontified (kbd "<PageUp>"))
+ " to scroll, "
+ (help--key-description-fontified "\C-s")
+ " to search, or \\<help-map>\\[help-quit] to exit.)"
+ (help--for-help-make-sections
+ `(("Commands, Keys and Functions"
+ ("describe-mode"
+ "Show help for current major and minor modes and their commands")
+ ("describe-bindings" "Show all key bindings")
+ ("describe-key" "Show help for key")
+ ("describe-key-briefly" "Show help for key briefly")
+ ("where-is" "Show which key runs a specific command")
+ ""
+ ("apropos-command"
+ "Search for commands (see also \\[apropos])")
+ ("apropos-documentation"
+ "Search documentation of functions, variables, and other items")
+ ("describe-command" "Show help for command")
+ ("describe-function" "Show help for function")
+ ("describe-variable" "Show help for variable")
+ ("describe-symbol" "Show help for function or variable"))
+ ("Manuals"
+ ("info-emacs-manual" "Show Emacs manual")
+ ("Info-goto-emacs-command-node"
+ "Show Emacs manual section for command")
+ ("Info-goto-emacs-key-command-node"
+ "Show Emacs manual section for a key sequence")
+ ("info" "Show all installed manuals")
+ ("info-display-manual" "Show a specific manual")
+ ("info-lookup-symbol" "Show description of symbol in pertinent manual"))
+ ("Other Help Commands"
+ ("view-external-packages"
+ "Extending Emacs with external packages")
+ ("finder-by-keyword"
+ "Search for Emacs packages (see also \\[list-packages])")
+ ("describe-package" "Describe a specific Emacs package")
+ ""
+ ("help-with-tutorial" "Start the Emacs tutorial")
+ ("view-echo-area-messages"
+ "Show recent messages (from echo area)")
+ ("view-lossage" ,(format "Show last %d input keystrokes (lossage)"
+ (lossage-size)))
+ ("display-local-help" "Show local help at point"))
+ ("Miscellaneous"
+ ("about-emacs" "About Emacs")
+ ("view-emacs-FAQ" "Emacs FAQ")
+ ("C-n" "News of recent changes")
+ ("view-emacs-problems" "Known problems")
+ ("view-emacs-debugging" "Debugging Emacs")
+ ""
+ ("describe-gnu-project" "About the GNU project")
+ ("describe-copying"
+ "Emacs copying permission (GNU General Public License)")
+ ("describe-distribution"
+ "Emacs ordering and distribution information")
+ ("C-m" "Order printed manuals")
+ ("view-emacs-todo" "Emacs TODO")
+ ("describe-no-warranty"
+ "Information on absence of warranty"))
+ ("Internationalization and Coding Systems"
+ ("describe-input-method" "Describe input method")
+ ("describe-coding-system" "Describe coding system")
+ ("describe-language-environment"
+ "Describe language environment")
+ ("describe-syntax" "Show current syntax table")
+ ("view-hello-file"
+ "Display the HELLO file illustrating various scripts"))))
+ "\n")
+ help-map
+ help-for-help-buffer-name)
@@ -492,6 +552,21 @@ To record all your input, use `open-dribble-file'."
;; Key bindings
+(defun help--key-description-fontified (keys &optional prefix)
+ "Like `key-description' but add face for \"*Help*\" buffers."
+ ;; We add both the `font-lock-face' and `face' properties here, as this
+ ;; seems to be the only way to get this to work reliably in any
+ ;; buffer.
+ (propertize (key-description keys prefix)
+ 'font-lock-face 'help-key-binding
+ 'face 'help-key-binding))
+
+(defcustom describe-bindings-outline nil
+ "Non-nil enables outlines in the output buffer of `describe-bindings'."
+ :type 'boolean
+ :group 'help
+ :version "28.1")
+
(defun describe-bindings (&optional prefix buffer)
"Display a buffer showing a list of all defined keys, and their definitions.
The keys are displayed in order of precedence.
@@ -509,24 +584,26 @@ or a buffer name."
;; Be aware that `describe-buffer-bindings' puts its output into
;; the current buffer.
(with-current-buffer (help-buffer)
- (describe-buffer-bindings buffer prefix))))
-
-;; This function used to be in keymap.c.
-(defun describe-bindings-internal (&optional menus prefix)
- "Show a list of all defined keys, and their definitions.
-We put that list in a buffer, and display the buffer.
-
-The optional argument MENUS, if non-nil, says to mention menu bindings.
-\(Ordinarily these are omitted from the output.)
-The optional argument PREFIX, if non-nil, should be a key sequence;
-then we display only bindings that start with that prefix."
- (declare (obsolete describe-buffer-bindings "24.4"))
- (let ((buf (current-buffer)))
- (with-help-window (help-buffer)
- ;; Be aware that `describe-buffer-bindings' puts its output into
- ;; the current buffer.
- (with-current-buffer (help-buffer)
- (describe-buffer-bindings buf prefix menus)))))
+ (describe-buffer-bindings buffer prefix)
+
+ (when describe-bindings-outline
+ (setq-local outline-regexp ".*:$")
+ (setq-local outline-heading-end-regexp ":\n")
+ (setq-local outline-level (lambda () 1))
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight t)
+ (outline-minor-mode 1)
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (insert (substitute-command-keys
+ (concat "\\<outline-mode-cycle-map>Type "
+ "\\[outline-cycle] or \\[outline-cycle-buffer] "
+ "on headings to cycle their visibility.\n\n")))
+ ;; Hide the longest body
+ (when (and (re-search-forward "Key translations" nil t)
+ (fboundp 'outline-cycle))
+ (outline-cycle))))))))
(defun where-is (definition &optional insert)
"Print message listing key sequences that invoke the command DEFINITION.
@@ -559,7 +636,8 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(let* ((remapped (command-remapping symbol))
(keys (where-is-internal
symbol overriding-local-map nil nil remapped))
- (keys (mapconcat 'key-description keys ", "))
+ (keys (mapconcat #'help--key-description-fontified
+ keys ", "))
string)
(setq string
(if insert
@@ -587,11 +665,11 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
nil)
(defun help-key-description (key untranslated)
- (let ((string (key-description key)))
+ (let ((string (help--key-description-fontified key)))
(if (or (not untranslated)
(and (eq (aref untranslated 0) ?\e) (not (eq (aref key 0) ?\e))))
string
- (let ((otherstring (key-description untranslated)))
+ (let ((otherstring (help--key-description-fontified untranslated)))
(if (equal string otherstring)
string
(format "%s (translated from %s)" string otherstring))))))
@@ -865,12 +943,7 @@ current buffer."
(when defn
(when (> (length info-list) 1)
(with-current-buffer standard-output
- (insert "\n\n"
- ;; FIXME: Can't use eval-when-compile because purified
- ;; strings lose their text properties :-(
- (propertize "\n" 'face
- '(:height 0.1 :inverse-video t :extend t))
- "\n")))
+ (insert "\n\n" (make-separator-line) "\n")))
(princ brief-desc)
(when locus
@@ -882,7 +955,7 @@ current buffer."
"Search forward \"help window\"."
(interactive)
;; Move cursor to the "help window".
- (pop-to-buffer " *Metahelp*")
+ (pop-to-buffer help-for-help-buffer-name)
;; Do incremental search forward.
(isearch-forward nil t))
@@ -979,7 +1052,7 @@ is currently activated with completion."
"Substitute key descriptions for command names in STRING.
Each substring of the form \\\\=[COMMAND] is replaced by either a
keystroke sequence that invokes COMMAND, or \"M-x COMMAND\" if COMMAND
-is not on any keys.
+is not on any keys. Keybindings will use the face `help-key-binding'.
Each substring of the form \\\\={MAPVAR} is replaced by a summary of
the value of MAPVAR as a keymap. This summary is similar to the one
@@ -999,7 +1072,7 @@ into the output, \\\\==\\[ puts \\[ into the output, and \\\\==\\=` puts \\=` in
output.
Return the original STRING if no substitutions are made.
-Otherwise, return a new string (without any text properties)."
+Otherwise, return a new string."
(when (not (null string))
;; KEYMAP is either nil (which means search all the active
;; keymaps) or a specified local map (which means search just that
@@ -1053,12 +1126,16 @@ Otherwise, return a new string (without any text properties)."
(where-is-internal fun keymap t))))
(if (not key)
;; Function is not on any key.
- (progn (insert "M-x ")
- (goto-char (+ end-point 3))
- (delete-char 1))
+ (let ((op (point)))
+ (insert "M-x ")
+ (goto-char (+ end-point 3))
+ (add-text-properties op (point)
+ '( face help-key-binding
+ font-lock-face help-key-binding))
+ (delete-char 1))
;; Function is on a key.
(delete-char (- end-point (point)))
- (insert (key-description key)))))
+ (insert (help--key-description-fontified key)))))
;; 1D. \{foo} is replaced with a summary of the keymap
;; (symbol-value foo).
;; \<foo> just sets the keymap used for \[cmd].
@@ -1172,7 +1249,7 @@ Any inserted text ends in two newlines (used by
(concat title
(if prefix
(concat " Starting With "
- (key-description prefix)))
+ (help--key-description-fontified prefix)))
":\n"))
"key binding\n"
"--- -------\n")))
@@ -1228,7 +1305,11 @@ Return nil if the key sequence is too long."
(= help--previous-description-column 32)))
32)
(t 16))))
- (indent-to description-column 1)
+ ;; Avoid using the `help-keymap' face.
+ (let ((op (point)))
+ (indent-to description-column 1)
+ (set-text-properties op (point) '( face nil
+ font-lock-face nil)))
(setq help--previous-description-column description-column)
(cond ((symbolp definition)
(insert (symbol-name definition) "\n"))
@@ -1240,7 +1321,11 @@ Return nil if the key sequence is too long."
(defun help--describe-translation (definition)
;; Converted from describe_translation in keymap.c.
- (indent-to 16 1)
+ ;; Avoid using the `help-keymap' face.
+ (let ((op (point)))
+ (indent-to 16 1)
+ (set-text-properties op (point) '( face nil
+ font-lock-face nil)))
(cond ((symbolp definition)
(insert (symbol-name definition) "\n"))
((or (stringp definition) (vectorp definition))
@@ -1351,9 +1436,9 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
(setq end (caar vect))))
;; Now START .. END is the range to describe next.
;; Insert the string to describe the event START.
- (insert (key-description (vector start) prefix))
+ (insert (help--key-description-fontified (vector start) prefix))
(when (not (eq start end))
- (insert " .. " (key-description (vector end) prefix)))
+ (insert " .. " (help--key-description-fontified (vector end) prefix)))
;; Print a description of the definition of this character.
;; Called function will take care of spacing out far enough
;; for alignment purposes.
@@ -1420,7 +1505,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
;; (setq first nil))
;; (when (and prefix (> (length prefix) 0))
;; (insert (format "%s" prefix)))
-;; (insert (key-description (vector start-idx) prefix))
+;; (insert (help--key-description-fontified (vector start-idx) prefix))
;; ;; Find all consecutive characters or rows that have the
;; ;; same definition.
;; (while (equal (keymap--get-keyelt (aref vector (1+ idx)) nil)
@@ -1433,7 +1518,7 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in
;; (insert " .. ")
;; (when (and prefix (> (length prefix) 0))
;; (insert (format "%s" prefix)))
-;; (insert (key-description (vector idx) prefix)))
+;; (insert (help--key-description-fontified (vector idx) prefix)))
;; (if transl
;; (help--describe-translation definition)
;; (help--describe-command definition))
@@ -1792,6 +1877,8 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
(error "Unrecognized usage format"))
(help--make-usage-docstring 'fn arglist)))))
+(declare-function subr-native-lambda-list "data.c")
+
(defun help-function-arglist (def &optional preserve-names)
"Return a formal argument list for the function DEF.
If PRESERVE-NAMES is non-nil, return a formal arglist that uses
@@ -1807,6 +1894,10 @@ the same names as used in the original source code, when possible."
((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
((eq (car-safe def) 'lambda) (nth 1 def))
((eq (car-safe def) 'closure) (nth 2 def))
+ ((and (featurep 'native-compile)
+ (subrp def)
+ (listp (subr-native-lambda-list def)))
+ (subr-native-lambda-list def))
((or (and (byte-code-function-p def) (integerp (aref def 0)))
(subrp def) (module-function-p def))
(or (when preserve-names
@@ -1821,7 +1912,7 @@ the same names as used in the original source code, when possible."
(let ((name (symbol-name arg)))
(if (eq (aref name 0) ?&)
(memq arg '(&rest &optional))
- (not (string-match "\\." name)))))
+ (not (string-search "." name)))))
(setq valid nil)))
(when valid arglist)))
(let* ((arity (func-arity def))
@@ -1924,6 +2015,8 @@ the suggested string to use instead. See
(add-function :after command-error-function
#'help-command-error-confusable-suggestions)
+(define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1")
+
(provide 'help)
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 85c3a53413d..8bfc1fb89e4 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -303,22 +303,30 @@ also supported.
There are several ways to change text in hexl mode:
-ASCII characters (character between space (0x20) and tilde (0x7E)) are
-bound to self-insert so you can simply type the character and it will
-insert itself (actually overstrike) into the buffer.
+Self-inserting characters are bound to `hexl-self-insert' so you
+can simply type the character and it will insert itself (actually
+overstrike) into the buffer. However, inserting non-ASCII characters
+requires caution: the buffer's coding-system should correspond to
+the encoding on disk, and multibyte characters should be inserted
+with cursor on the first byte of a multibyte sequence whose length
+is identical to the length of the multibyte sequence to be inserted,
+otherwise this could produce invalid multibyte sequences. Non-ASCII
+characters in ISO-2022 encodings should preferably inserted byte by
+byte, to avoid problems caused by the designation sequences before
+the actual characters.
\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
it isn't bound to self-insert. An octal number can be supplied in place
of another key to insert the octal number's ASCII representation.
-\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
-into the buffer at the current point.
+\\[hexl-insert-hex-char] will insert a given hexadecimal value
+into the buffer at the current address.
-\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
-into the buffer at the current point.
+\\[hexl-insert-octal-char] will insert a given octal value
+into the buffer at the current address.
-\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
-into the buffer at the current point.
+\\[hexl-insert-decimal-char] will insert a given decimal value
+into the buffer at the current address..
\\[hexl-mode-exit] will exit `hexl-mode'.
@@ -332,26 +340,16 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(unless (eq major-mode 'hexl-mode)
(let ((modified (buffer-modified-p))
(inhibit-read-only t)
- (original-point (- (point) (point-min))))
- (and (eobp) (not (bobp))
- (setq original-point (1- original-point)))
+ (point-offset (bufferpos-to-filepos (point) 'exact)))
;; If `hexl-mode' is invoked with an argument the buffer is assumed to
;; be in hexl format.
(when (memq arg '(1 nil))
- ;; If the buffer's EOL type is -dos, we need to account for
- ;; extra CR characters added when hexlify-buffer writes the
- ;; buffer to a file.
- ;; FIXME: This doesn't take into account multibyte coding systems.
- (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
- (setq original-point (+ (count-lines (point-min) (point))
- original-point))
- (or (bolp) (setq original-point (1- original-point))))
(hexlify-buffer)
(restore-buffer-modified-p modified))
(setq hexl-max-address
(+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
(condition-case nil
- (hexl-goto-address original-point)
+ (hexl-goto-address point-offset)
(error nil)))
(let ((max-address hexl-max-address))
@@ -440,7 +438,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(defun hexl-find-file (filename)
"Edit file FILENAME as a binary file in hex dump format.
Switch to a buffer visiting file FILENAME, creating one if none exists,
-and edit the file in `hexl-mode'."
+and edit the file in `hexl-mode'. The buffer's coding-system will be
+no-conversion, unlike if you visit it normally and then invoke `hexl-mode'."
(interactive
(list
(let ((completion-ignored-extensions nil))
@@ -478,17 +477,11 @@ With arg, don't unhexlify buffer."
(if (or (eq arg 1) (not arg))
(let ((modified (buffer-modified-p))
(inhibit-read-only t)
- (original-point (1+ (hexl-current-address))))
+ (point-offset (hexl-current-address)))
(dehexlify-buffer)
(remove-hook 'write-contents-functions #'hexl-save-buffer t)
(restore-buffer-modified-p modified)
- (goto-char original-point)
- ;; Maybe adjust point for the removed CR characters.
- (when (eq (coding-system-eol-type buffer-file-coding-system) 1)
- (setq original-point (- original-point
- (count-lines (point-min) (point))))
- (or (bobp) (setq original-point (1+ original-point))))
- (goto-char original-point)))
+ (goto-char (filepos-to-bufferpos point-offset 'exact))))
(remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
(major-mode-restore))
@@ -499,11 +492,11 @@ Ask the user for confirmation."
(if (y-or-n-p "Convert contents back to binary format? ")
(let ((modified (buffer-modified-p))
(inhibit-read-only t)
- (original-point (1+ (hexl-current-address))))
+ (point-offset (hexl-current-address)))
(dehexlify-buffer)
(remove-hook 'write-contents-functions #'hexl-save-buffer t)
(restore-buffer-modified-p modified)
- (goto-char original-point))))
+ (goto-char (filepos-to-bufferpos point-offset 'exact)))))
(defun hexl-current-address (&optional validate)
"Return current hexl-address."
@@ -879,14 +872,27 @@ This discards the buffer's undo information."
"Insert a possibly multibyte character CH NUM times.
Non-ASCII characters are first encoded with `buffer-file-coding-system',
-and their encoded form is inserted byte by byte."
+and their encoded form is inserted byte by byte. Note that if the
+hexl buffer was produced by `hexl-find-file', its coding-system
+is no-conversion.
+
+Inserting non-ASCII characters requires caution: the buffer's
+coding-system should correspond to the encoding on disk, and
+multibyte characters should be inserted with cursor on the first
+byte of a multibyte sequence whose length is identical to the
+length of the multibyte sequence to be inserted, otherwise this
+could produce invalid multibyte sequences. Non-ASCII characters
+in ISO-2022 encodings should preferably inserted byte by byte, to
+avoid problems caused by the designation sequences before the
+actual characters."
(let ((charset (char-charset ch))
(coding (if (or (null buffer-file-coding-system)
;; coding-system-type equals t means undecided.
(eq (coding-system-type buffer-file-coding-system) t))
(default-value 'buffer-file-coding-system)
buffer-file-coding-system)))
- (cond ((and (> ch 0) (< ch 256))
+ (cond ((and (>= ch 0) (< ch 256)
+ (coding-system-get coding :ascii-compatible-p))
(hexl-insert-char ch num))
((eq charset 'unknown)
(error
@@ -924,7 +930,19 @@ and their encoded form is inserted byte by byte."
Interactively, with a numeric argument, insert this character that many times.
Non-ASCII characters are first encoded with `buffer-file-coding-system',
-and their encoded form is inserted byte by byte."
+and their encoded form is inserted byte by byte. Note that if the
+hexl buffer was produced by `hexl-find-file', its coding-system
+is no-conversion.
+
+Inserting non-ASCII characters requires caution: the buffer's
+coding-system should correspond to the encoding on disk, and
+multibyte characters should be inserted with cursor on the first
+byte of a multibyte sequence whose length is identical to the
+length of the multibyte sequence to be inserted, otherwise this
+could produce invalid multibyte sequences. Non-ASCII characters
+in ISO-2022 encodings should preferably inserted byte by byte, to
+avoid problems caused by the designation sequences before the
+actual characters."
(interactive "p")
(hexl-insert-multibyte-char last-command-event arg))
@@ -964,7 +982,21 @@ CH must be a unibyte character whose value is between 0 and 255."
;; hex conversion
(defun hexl-insert-hex-char (arg)
- "Insert a character given by its hexadecimal code ARG times at point."
+ "Insert a character given by its hexadecimal code ARG times at point.
+
+Values above 0xFF are treated as multibyte characters, and first encoded
+using `buffer-file-coding-system'. Note that if the hexl buffer was
+produced by `hexl-find-file', its coding-system is no-conversion.
+
+Inserting non-ASCII characters requires caution: the buffer's
+coding-system should correspond to the encoding on disk, and
+multibyte characters should be inserted with cursor on the first
+byte of a multibyte sequence whose length is identical to the
+length of the multibyte sequence to be inserted, otherwise this
+could produce invalid multibyte sequences. Non-ASCII characters
+in ISO-2022 encodings should preferably inserted byte by byte, to
+avoid problems caused by the designation sequences before the
+actual characters."
(interactive "p")
(let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
(if (< num 0)
@@ -997,7 +1029,21 @@ Embedded whitespace, dashes, and periods in the string are ignored."
(setq arg (- arg 1)))))
(defun hexl-insert-decimal-char (arg)
- "Insert a character given by its decimal code ARG times at point."
+ "Insert a character given by its decimal code ARG times at point.
+
+Values above 256 are treated as multibyte characters, and first encoded
+using `buffer-file-coding-system'. Note that if the hexl buffer was
+produced by `hexl-find-file', its coding-system is no-conversion.
+
+Inserting non-ASCII characters requires caution: the buffer's
+coding-system should correspond to the encoding on disk, and
+multibyte characters should be inserted with cursor on the first
+byte of a multibyte sequence whose length is identical to the
+length of the multibyte sequence to be inserted, otherwise this
+could produce invalid multibyte sequences. Non-ASCII characters
+in ISO-2022 encodings should preferably inserted byte by byte, to
+avoid problems caused by the designation sequences before the
+actual characters."
(interactive "p")
(let ((num (string-to-number (read-string "Decimal Number: "))))
(if (< num 0)
@@ -1005,7 +1051,21 @@ Embedded whitespace, dashes, and periods in the string are ignored."
(hexl-insert-multibyte-char num arg))))
(defun hexl-insert-octal-char (arg)
- "Insert a character given by its octal code ARG times at point."
+ "Insert a character given by its octal code ARG times at point.
+
+Values above \377 are treated as multibyte characters, and first encoded
+using `buffer-file-coding-system'. Note that if the hexl buffer was
+produced by `hexl-find-file', its coding-system is no-conversion.
+
+Inserting non-ASCII characters requires caution: the buffer's
+coding-system should correspond to the encoding on disk, and
+multibyte characters should be inserted with cursor on the first
+byte of a multibyte sequence whose length is identical to the
+length of the multibyte sequence to be inserted, otherwise this
+could produce invalid multibyte sequences. Non-ASCII characters
+in ISO-2022 encodings should preferably inserted byte by byte, to
+avoid problems caused by the designation sequences before the
+actual characters."
(interactive "p")
(let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
(if (< num 0)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 0ad499b4dbf..37b88b318de 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -111,7 +111,7 @@ highlighting will be applied throughout the buffer."
:group 'hi-lock)
(defcustom hi-lock-exclude-modes
- '(rmail-mode mime/viewer-mode gnus-article-mode)
+ '(rmail-mode mime/viewer-mode gnus-article-mode term-mode)
"List of major modes in which hi-lock will not run.
For security reasons since font lock patterns can specify function
calls."
@@ -254,39 +254,25 @@ that older functionality. This variable avoids multiple reminders.")
Assumption is made if `hi-lock-mode' used in the *scratch* buffer while
a library is being loaded.")
-(defvar hi-lock-menu
- (let ((map (make-sparse-keymap "Hi Lock")))
- (define-key-after map [highlight-regexp]
- '(menu-item "Highlight Regexp..." highlight-regexp
- :help "Highlight text matching PATTERN (a regexp)."))
-
- (define-key-after map [highlight-phrase]
- '(menu-item "Highlight Phrase..." highlight-phrase
- :help "Highlight text matching PATTERN (a regexp processed to match phrases)."))
-
- (define-key-after map [highlight-lines-matching-regexp]
- '(menu-item "Highlight Lines..." highlight-lines-matching-regexp
- :help "Highlight lines containing match of PATTERN (a regexp)."))
-
- (define-key-after map [highlight-symbol-at-point]
- '(menu-item "Highlight Symbol at Point" highlight-symbol-at-point
- :help "Highlight symbol found near point without prompting."))
-
- (define-key-after map [unhighlight-regexp]
- '(menu-item "Remove Highlighting..." unhighlight-regexp
- :help "Remove previously entered highlighting pattern."
- :enable hi-lock-interactive-patterns))
-
- (define-key-after map [hi-lock-write-interactive-patterns]
- '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns
- :help "Insert interactively added REGEXPs into buffer at point."
- :enable hi-lock-interactive-patterns))
-
- (define-key-after map [hi-lock-find-patterns]
- '(menu-item "Patterns from Buffer" hi-lock-find-patterns
- :help "Use patterns (if any) near top of buffer."))
- map)
- "Menu for hi-lock mode.")
+(easy-menu-define hi-lock-menu nil
+ "Menu for hi-lock mode."
+ '("Hi Lock"
+ ["Highlight Regexp..." highlight-regexp
+ :help "Highlight text matching PATTERN (a regexp)."]
+ ["Highlight Phrase..." highlight-phrase
+ :help "Highlight text matching PATTERN (a regexp processed to match phrases)."]
+ ["Highlight Lines..." highlight-lines-matching-regexp
+ :help "Highlight lines containing match of PATTERN (a regexp)."]
+ ["Highlight Symbol at Point" highlight-symbol-at-point
+ :help "Highlight symbol found near point without prompting."]
+ ["Remove Highlighting..." unhighlight-regexp
+ :help "Remove previously entered highlighting pattern."
+ :enable hi-lock-interactive-patterns]
+ ["Patterns to Buffer" hi-lock-write-interactive-patterns
+ :help "Insert interactively added REGEXPs into buffer at point."
+ :enable hi-lock-interactive-patterns]
+ ["Patterns from Buffer" hi-lock-find-patterns
+ :help "Use patterns (if any) near top of buffer."]))
(defvar hi-lock-map
(let ((map (make-sparse-keymap "Hi Lock")))
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 89a1a9108c4..8919e982383 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1,4 +1,4 @@
-;;; hilit-chg.el --- minor mode displaying buffer changes with special face
+;;; hilit-chg.el --- minor mode displaying buffer changes with special face -*- lexical-binding: t -*-
;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
@@ -68,8 +68,7 @@
;; (defun my-highlight-changes-mode-hook ()
;; (if highlight-changes-mode
;; (add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)
-;; (remove-hook 'write-file-functions 'highlight-changes-rotate-faces t)
-;; ))
+;; (remove-hook 'write-file-functions 'highlight-changes-rotate-faces t)))
;; Automatically enabling Highlight Changes mode
@@ -114,16 +113,16 @@
;; Possible bindings:
-;; (global-set-key '[C-right] 'highlight-changes-next-change)
-;; (global-set-key '[C-left] 'highlight-changes-previous-change)
+;; (global-set-key '[C-right] #'highlight-changes-next-change)
+;; (global-set-key '[C-left] #'highlight-changes-previous-change)
;;
;; Other interactive functions (that could be bound if desired):
-;; highlight-changes-mode
-;; highlight-changes-toggle-visibility
-;; highlight-changes-remove-highlight
-;; highlight-compare-with-file
-;; highlight-compare-buffers
-;; highlight-changes-rotate-faces
+;; `highlight-changes-mode'
+;; `highlight-changes-toggle-visibility'
+;; `highlight-changes-remove-highlight'
+;; `highlight-compare-with-file'
+;; `highlight-compare-buffers'
+;; `highlight-changes-rotate-faces'
;;; Bugs:
@@ -179,7 +178,6 @@
:version "20.4"
:group 'faces)
-
;; Face information: How the changes appear.
;; Defaults for face: red foreground, no change to background,
@@ -192,22 +190,20 @@
'((((min-colors 88) (class color)) (:foreground "red1"))
(((class color)) (:foreground "red" ))
(t (:inverse-video t)))
- "Face used for highlighting changes."
- :group 'highlight-changes)
+ "Face used for highlighting changes.")
;; This looks pretty ugly, actually. Maybe the underline should be removed.
(defface highlight-changes-delete
'((((min-colors 88) (class color)) (:foreground "red1" :underline t))
(((class color)) (:foreground "red" :underline t))
(t (:inverse-video t)))
- "Face used for highlighting deletions."
- :group 'highlight-changes)
+ "Face used for highlighting deletions.")
;; A (not very good) default list of colors to rotate through.
(defcustom highlight-changes-colors
(if (eq (frame-parameter nil 'background-mode) 'light)
;; defaults for light background:
- '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
+ '("magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
;; defaults for dark background:
'("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
"Colors used by `highlight-changes-rotate-faces'.
@@ -218,8 +214,7 @@ This list is used if `highlight-changes-face-list' is nil, otherwise that
variable overrides this list. If you only care about foreground
colors then use this, if you want fancier faces then set
`highlight-changes-face-list'."
- :type '(repeat color)
- :group 'highlight-changes)
+ :type '(repeat color))
;; When you invoke highlight-changes-mode, should highlight-changes-visible-mode
;; be on or off?
@@ -230,8 +225,7 @@ colors then use this, if you want fancier faces then set
This controls the initial value of `highlight-changes-visible-mode'.
When a buffer is in Highlight Changes mode the function
`highlight-changes-visible-mode' is used to toggle the mode on or off."
- :type 'boolean
- :group 'highlight-changes)
+ :type 'boolean)
;; These are the strings displayed in the mode-line for the minor mode:
@@ -240,16 +234,14 @@ When a buffer is in Highlight Changes mode the function
This should be set to nil if no indication is desired, or to
a string with a leading space."
:type '(choice string
- (const :tag "None" nil))
- :group 'highlight-changes)
+ (const :tag "None" nil)))
(defcustom highlight-changes-invisible-string " -Chg"
"The string used when in Highlight Changes mode and changes are hidden.
This should be set to nil if no indication is desired, or to
a string with a leading space."
:type '(choice string
- (const :tag "None" nil))
- :group 'highlight-changes)
+ (const :tag "None" nil)))
(defcustom highlight-changes-global-modes t
"Determine whether a buffer is suitable for global Highlight Changes mode.
@@ -279,9 +271,7 @@ modes only."
(repeat :tag "Modes" :inline t (symbol :tag "mode")))
(function :menu-tag "determined by function"
:value buffer-file-name)
- (const :tag "none" nil)
- )
- :group 'highlight-changes)
+ (const :tag "none" nil)))
(defcustom highlight-changes-global-changes-existing-buffers nil
"If non-nil, toggling global Highlight Changes mode affects existing buffers.
@@ -290,8 +280,7 @@ created). However, if `highlight-changes-global-changes-existing-buffers'
is non-nil, then turning on `global-highlight-changes-mode' will turn on
Highlight Changes mode in suitable buffers, and turning the mode off will
remove it from existing buffers."
- :type 'boolean
- :group 'highlight-changes)
+ :type 'boolean)
;; These are for internal use.
@@ -320,9 +309,7 @@ through various faces.
\\[highlight-compare-with-file] - mark text as changed by comparing this
buffer with the contents of a file
\\[highlight-compare-buffers] highlights differences between two buffers."
- nil ;; init-value
- hilit-chg-string ;; lighter
- nil ;; keymap
+ :lighter hilit-chg-string
(if (or (display-color-p)
(and (fboundp 'x-display-grayscale-p) (x-display-grayscale-p)))
(progn
@@ -352,13 +339,8 @@ The default value can be customized with variable
`highlight-changes-visibility-initial-state'.
This command does not itself set Highlight Changes mode."
-
- t ;; init-value
- nil ;; lighter
- nil ;; keymap
-
- (hilit-chg-update)
- )
+ :init-value t
+ (hilit-chg-update))
(defun hilit-chg-cust-fix-changes-face-list (w _wc &optional event)
@@ -371,12 +353,10 @@ This command does not itself set Highlight Changes mode."
;; faces are saved but not to the actual list itself.
(let ((old-list (widget-value w)))
(if (member 'default old-list)
- (let
- ((p (reverse old-list))
+ (let ((p (reverse old-list))
(n (length old-list))
new-name old-name
- (new-list nil)
- )
+ (new-list nil))
(while p
(setq old-name (car p))
(setq new-name (intern (format "highlight-changes-%d" n)))
@@ -396,9 +376,7 @@ This command does not itself set Highlight Changes mode."
(if (equal new-list (widget-value w))
nil ;; (message "notify: no change!")
(widget-value-set w new-list)
- (widget-setup)
- )
- )
+ (widget-setup)))
;; (message "notify: no default here!")
))
(let ((parent (widget-get w :parent)))
@@ -417,10 +395,8 @@ Otherwise, this list will be constructed when needed from
:type '(choice
(repeat
:notify hilit-chg-cust-fix-changes-face-list
- face )
- (const :tag "Derive from highlight-changes-colors" nil)
- )
- :group 'highlight-changes)
+ face)
+ (const :tag "Derive from highlight-changes-colors" nil)))
(defun hilit-chg-map-changes (func &optional start-position end-position)
@@ -446,7 +422,7 @@ An overlay from BEG to END containing a change face is added
from the information in the text property of type `hilit-chg'.
This is the opposite of `hilit-chg-hide-changes'."
- (hilit-chg-map-changes 'hilit-chg-make-ov beg end))
+ (hilit-chg-map-changes #'hilit-chg-make-ov beg end))
(defun hilit-chg-make-ov (prop start end)
@@ -467,8 +443,7 @@ This is the opposite of `hilit-chg-hide-changes'."
(overlay-put ov 'evaporate t)
;; We set the change property so we can tell this is one
;; of our overlays (so we don't delete someone else's).
- (overlay-put ov 'hilit-chg t)
- )
+ (overlay-put ov 'hilit-chg t))
(error "hilit-chg-make-ov: no face for prop: %s" prop))))
(defun hilit-chg-hide-changes (&optional beg end)
@@ -517,9 +492,9 @@ This allows you to manually remove highlighting from uninteresting changes."
;; otherwise an undone change shows up as changed. While the properties
;; are automatically restored by undo, we must fix up the overlay.
(save-match-data
- (let (;;(beg-decr 1)
- (end-incr 1)
- (type 'hilit-chg))
+ (let ((end-incr 1)
+ (type 'hilit-chg)
+ (property 'hilit-chg))
(if undo-in-progress
(if (and highlight-changes-mode
highlight-changes-visible-mode)
@@ -540,7 +515,8 @@ This allows you to manually remove highlighting from uninteresting changes."
;; (setq beg-decr 0))))
;; (setq beg (max (- beg beg-decr) (point-min)))
(setq end (min (+ end end-incr) (point-max)))
- (setq type 'hilit-chg-delete))
+ (setq type 'hilit-chg-delete
+ property 'hilit-chg-delete))
;; Not a deletion.
;; Most of the time the following is not necessary, but
;; if the current text was marked as a deletion then
@@ -548,14 +524,15 @@ This allows you to manually remove highlighting from uninteresting changes."
;; text where she earlier deleted text, we have to remove the
;; deletion marking, and replace it explicitly with a `changed'
;; marking, otherwise its highlighting would disappear.
- (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete)
- (save-restriction
- (widen)
- (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg)
- (if highlight-changes-visible-mode
- (hilit-chg-fixup end (+ end 1))))))
+ (when (eq (get-text-property end 'hilit-chg-delete)
+ 'hilit-chg-delete)
+ (save-restriction
+ (widen)
+ (put-text-property end (+ end 1) 'hilit-chg-delete nil)
+ (if highlight-changes-visible-mode
+ (hilit-chg-fixup end (+ end 1))))))
(unless no-property-change
- (put-text-property beg end 'hilit-chg type))
+ (put-text-property beg end property type))
(if (or highlight-changes-visible-mode no-property-change)
(hilit-chg-make-ov type beg end)))))))
@@ -726,7 +703,7 @@ this, eval the following in the buffer to be saved:
;; remove our existing overlays
(hilit-chg-hide-changes)
;; for each change text property, increment it
- (hilit-chg-map-changes 'hilit-chg-bump-change)
+ (hilit-chg-map-changes #'hilit-chg-bump-change)
;; and display them
(hilit-chg-display-changes))
(unless modified
@@ -759,7 +736,7 @@ is non-nil."
(buf-b-read-only (with-current-buffer buf-b buffer-read-only))
temp-a temp-b)
(if (and file-a bufa-modified)
- (if (y-or-n-p (format "Save buffer %s? " buf-a))
+ (if (y-or-n-p (format "Save buffer %s? " buf-a))
(with-current-buffer buf-a
(save-buffer)
(setq bufa-modified (buffer-modified-p buf-a)))
@@ -768,7 +745,7 @@ is non-nil."
(setq temp-a (setq file-a (ediff-make-temp-file buf-a nil))))
(if (and file-b bufb-modified)
- (if (y-or-n-p (format "Save buffer %s? " buf-b))
+ (if (y-or-n-p (format "Save buffer %s? " buf-b))
(with-current-buffer buf-b
(save-buffer)
(setq bufb-modified (buffer-modified-p buf-b)))
@@ -809,12 +786,11 @@ is non-nil."
(if temp-a
(delete-file temp-a))
(if temp-b
- (delete-file temp-b)))
- ))
+ (delete-file temp-b)))))
;;;###autoload
(defun highlight-compare-buffers (buf-a buf-b)
-"Compare two buffers and highlight the differences.
+ "Compare two buffers and highlight the differences.
The default is the current buffer and the one in the next window.
@@ -835,8 +811,7 @@ changes are made, so \\[highlight-changes-next-change] and
(window-buffer (next-window)) t))))
(let ((file-a (buffer-file-name buf-a))
(file-b (buffer-file-name buf-b)))
- (highlight-markup-buffers buf-a file-a buf-b file-b)
- ))
+ (highlight-markup-buffers buf-a file-a buf-b file-b)))
;;;###autoload
(defun highlight-compare-with-file (file-b)
@@ -876,9 +851,11 @@ changes are made, so \\[highlight-changes-next-change] and
(find-file-noselect file-b))))
(highlight-markup-buffers buf-a file-a buf-b file-b (not existing-buf))
(unless existing-buf
- (kill-buffer buf-b))
- ))
+ (kill-buffer buf-b))))
+(defvar hilit-x) ; placate the byte-compiler
+(defvar hilit-y)
+(defvar hilit-e)
(defun hilit-chg-get-diff-info (buf-a file-a buf-b file-b)
;; hilit-e,x,y are set by function hilit-chg-get-diff-list-hk.
@@ -886,8 +863,7 @@ changes are made, so \\[highlight-changes-next-change] and
(ediff-setup buf-a file-a buf-b file-b
nil nil ; buf-c file-C
'(hilit-chg-get-diff-list-hk)
- (list (cons 'ediff-job-name 'something))
- )
+ (list (cons 'ediff-job-name 'something)))
(ediff-with-current-buffer hilit-e (ediff-really-quit nil))
(list hilit-x hilit-y)))
@@ -895,9 +871,6 @@ changes are made, so \\[highlight-changes-next-change] and
(defun hilit-chg-get-diff-list-hk ()
;; hilit-e/x/y are dynamically bound by hilit-chg-get-diff-info
;; which calls this function as a hook.
- (defvar hilit-x) ; placate the byte-compiler
- (defvar hilit-y)
- (defvar hilit-e)
(setq hilit-e (current-buffer))
(let ((n 0) extent p va vb a b)
(setq hilit-x nil hilit-y nil)
@@ -931,7 +904,7 @@ changes are made, so \\[highlight-changes-next-change] and
(setq extent (list (overlay-start (car p))
(overlay-end (car p))))
(setq p (cdr p))
- (setq hilit-y (append hilit-y (list extent) )))
+ (setq hilit-y (append hilit-y (list extent))))
(setq n (1+ n)));; while
;; ediff-quit doesn't work here.
;; No point in returning a value, since this is a hook function.
@@ -961,8 +934,7 @@ This is called when `global-highlight-changes-mode' is turned on."
(and
(not (string-match "^[ *]" (buffer-name)))
(buffer-file-name))))
- (highlight-changes-mode 1))
- ))
+ (highlight-changes-mode 1))))
;;;; Desktop support.
@@ -985,8 +957,7 @@ This is called when `global-highlight-changes-mode' is turned on."
;; (message "--- hilit-chg-debug-show ---")
;; (hilit-chg-map-changes (lambda (prop start end)
;; (message "%d-%d: %s" start end prop))
-;; beg end
-;; ))
+;; beg end))
;;
;; ================== end of debug ===============
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 4d020232939..4fadbbe4180 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -1,4 +1,4 @@
-;;; hippie-exp.el --- expand text trying various ways to find its expansion
+;;; hippie-exp.el --- expand text trying various ways to find its expansion -*- lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@@ -58,7 +58,7 @@
;; The variable `hippie-expand-dabbrev-as-symbol' controls whether
;; characters of syntax '_' is considered part of the words to expand
;; dynamically.
-;; See also the macro `make-hippie-expand-function' below.
+;; See also the function `make-hippie-expand-function' below.
;;
;; A short description of the current try-functions in this file:
;; `try-complete-file-name' : very convenient to have in any buffer,
@@ -215,50 +215,42 @@
"The list of expansion functions tried in order by `hippie-expand'.
To change the behavior of `hippie-expand', remove, change the order of,
or insert functions in this list."
- :type '(repeat function)
- :group 'hippie-expand)
+ :type '(repeat function))
(defcustom hippie-expand-verbose t
"Non-nil makes `hippie-expand' output which function it is trying."
- :type 'boolean
- :group 'hippie-expand)
+ :type 'boolean)
(defcustom hippie-expand-dabbrev-skip-space nil
"Non-nil means tolerate trailing spaces in the abbreviation to expand."
- :group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-dabbrev-as-symbol t
"Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
- :group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-no-restriction t
"Non-nil means that narrowed buffers are widened during search."
- :group 'hippie-expand
:type 'boolean)
(defcustom hippie-expand-max-buffers ()
"The maximum number of buffers (apart from the current) searched.
If nil, all buffers are searched."
:type '(choice (const :tag "All" nil)
- integer)
- :group 'hippie-expand)
+ integer))
(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
"A list specifying which buffers not to search (if not current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms)."
- :type '(repeat (choice regexp (symbol :tag "Major Mode")))
- :group 'hippie-expand)
+ :type '(repeat (choice regexp (symbol :tag "Major Mode"))))
(defcustom hippie-expand-only-buffers ()
"A list specifying the only buffers to search (in addition to current).
Can contain both regexps matching buffer names (as strings) and major modes
\(as atoms). If non-nil, this variable overrides the variable
`hippie-expand-ignore-buffers'."
- :type '(repeat (choice regexp (symbol :tag "Major Mode")))
- :group 'hippie-expand)
+ :type '(repeat (choice regexp (symbol :tag "Major Mode"))))
;;;###autoload
(defun hippie-expand (arg)
@@ -407,18 +399,19 @@ undoes the expansion."
;; try-expand-line-all-buffers)))
;;
;;;###autoload
-(defmacro make-hippie-expand-function (try-list &optional verbose)
+(defun make-hippie-expand-function (try-list &optional verbose)
"Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose."
- `(lambda (arg)
- ,(concat
- "Try to expand text before point, using the following functions: \n"
- (mapconcat 'prin1-to-string (eval try-list) ", "))
- (interactive "P")
- (let ((hippie-expand-try-functions-list ,try-list)
- (hippie-expand-verbose ,verbose))
- (hippie-expand arg))))
+ (lambda (arg)
+ (:documentation
+ (concat
+ "Try to expand text before point, using the following functions: \n"
+ (mapconcat #'prin1-to-string try-list ", ")))
+ (interactive "P")
+ (let ((hippie-expand-try-functions-list try-list)
+ (hippie-expand-verbose verbose))
+ (hippie-expand arg))))
;;; Here follows the try-functions and their requisites:
@@ -434,7 +427,8 @@ string). It returns t if a new completion is found, nil otherwise."
(he-init-string (he-file-name-beg) (point))
(let ((name-part (file-name-nondirectory he-search-string))
(dir-part (expand-file-name (or (file-name-directory
- he-search-string) ""))))
+ he-search-string)
+ ""))))
(if (not (he-string-member name-part he-tried-table))
(setq he-tried-table (cons name-part he-tried-table)))
(if (and (not (equal he-search-string ""))
@@ -442,7 +436,7 @@ string). It returns t if a new completion is found, nil otherwise."
(setq he-expand-list (sort (file-name-all-completions
name-part
dir-part)
- 'string-lessp))
+ #'string-lessp))
(setq he-expand-list ())))))
(while (and he-expand-list
@@ -513,8 +507,8 @@ otherwise."
"Try to slam together two parts of a file specification, system dependently."
(cond ((null dir-part) name-part)
((eq system-type 'ms-dos)
- (if (and (string-match "\\\\" dir-part)
- (not (string-match "/" dir-part))
+ (if (and (string-search "\\" dir-part)
+ (not (string-search "/" dir-part))
(= (aref name-part (1- (length name-part))) ?/))
(aset name-part (1- (length name-part)) ?\\))
(concat dir-part name-part))
@@ -538,7 +532,7 @@ string). It returns t if a new completion is found, nil otherwise."
(or (boundp sym)
(fboundp sym)
(symbol-plist sym))))
- 'string-lessp)))))
+ #'string-lessp)))))
(while (and he-expand-list
(he-string-member (car he-expand-list) he-tried-table))
(setq he-expand-list (cdr he-expand-list)))
@@ -822,9 +816,10 @@ string). It returns t if a new expansion is found, nil otherwise."
(setq he-expand-list
(and (not (equal he-search-string ""))
(mapcar (lambda (sym)
- (if (and (boundp sym) (vectorp (eval sym)))
+ (if (and (boundp sym)
+ (abbrev-table-p (symbol-value sym)))
(abbrev-expansion (downcase he-search-string)
- (eval sym))))
+ (symbol-value sym))))
(append '(local-abbrev-table
global-abbrev-table)
abbrev-table-name-list))))))
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 82952e934b6..26cfcc3f9cc 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -125,6 +125,9 @@ This variable is expected to be made buffer-local by modes.")
(defvar hl-line-overlay-buffer nil
"Most recently visited buffer in which Hl-Line mode is enabled.")
+(defvar hl-line-overlay-priority -50
+ "Priority used on the overlay used by hl-line.")
+
;;;###autoload
(define-minor-mode hl-line-mode
"Toggle highlighting of the current line (Hl-Line mode).
@@ -152,7 +155,7 @@ line about point in the selected window only."
(defun hl-line-make-overlay ()
(let ((ol (make-overlay (point) (point))))
- (overlay-put ol 'priority -50) ;(bug#16192)
+ (overlay-put ol 'priority hl-line-overlay-priority) ;(bug#16192)
(overlay-put ol 'face hl-line-face)
ol))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index bfbe0ee165b..3b961989e3e 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -523,22 +523,10 @@ therefore no longer care about) will be invalid at any time.\n
(defvar hfy-tmpfont-stack nil
"An alist of derived fonts resulting from overlays.")
-(defconst hfy-hex-regex "[[:xdigit:]]")
-
(defconst hfy-triplet-regex
- (concat
- "\\(" hfy-hex-regex hfy-hex-regex "\\)"
- "\\(" hfy-hex-regex hfy-hex-regex "\\)"
- "\\(" hfy-hex-regex hfy-hex-regex "\\)"))
-
-(defun hfy-interq (set-a set-b)
- "Return the intersection (using `eq') of two lists SET-A and SET-B."
- (let ((sa set-a) (interq nil) (elt nil))
- (while sa
- (setq elt (car sa)
- sa (cdr sa))
- (if (memq elt set-b) (setq interq (cons elt interq))))
- interq))
+ (rx (group xdigit xdigit)
+ (group xdigit xdigit)
+ (group xdigit xdigit)))
(defun hfy-color-vals (color)
"Where COLOR is a color name or #XXXXXX style triplet, return a
@@ -887,7 +875,9 @@ See also `hfy-display-class' for details of valid values for CLASS."
(setq score 0) (ignore "t match"))
((not (cdr (assq key face-class))) ;Neither good nor bad.
nil (ignore "non match, non collision"))
- ((setq x (hfy-interq val (cdr (assq key face-class))))
+ ((setq x (nreverse
+ (seq-intersection val (cdr (assq key face-class))
+ #'eq)))
(setq score (+ score (length x)))
(ignore "intersection"))
(t ;; nope.
@@ -983,19 +973,18 @@ merged by the user - `hfy-flatten-style' should do this."
(:italic (hfy-slant 'italic))))))
(setq that (hfy-face-to-style-i next))
;;(lwarn t :warning "%S => %S" fn (nconc this that parent))
- (nconc this parent that))) )
+ (append this parent that))) )
-(defun hfy-size-to-int (spec)
+(defun hfy--size-to-int (spec)
"Convert SPEC, a CSS font-size specifier, to an Emacs :height attribute value.
Used while merging multiple font-size attributes."
- ;;(message "hfy-size-to-int");;DBUG
- (list
- (if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec)
- (cond ((string= "%" (match-string 2 spec))
- (/ (string-to-number (match-string 1 spec)) 100.0))
- ((string= "pt" (match-string 2 spec))
- (* (string-to-number (match-string 1 spec)) 10)))
- (string-to-number spec))) )
+ ;;(message "hfy--size-to-int");;DBUG
+ (if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec)
+ (cond ((string= "%" (match-string 2 spec))
+ (/ (string-to-number (match-string 1 spec)) 100.0))
+ ((string= "pt" (match-string 2 spec))
+ (* (string-to-number (match-string 1 spec)) 10)))
+ (string-to-number spec)) )
;; size is different, in that in order to get it right at all,
;; we have to trawl the inheritance path, accumulating modifiers,
@@ -1006,19 +995,18 @@ any multiple attributes appropriately. Currently only font-size is merged
down to a single occurrence - others may need special handling, but I
haven't encountered them yet. Returns a `hfy-style-assoc'."
;;(message "(hfy-flatten-style %S)" style) ;;DBUG
- (let ((n 0)
- (m (list 1))
+ (let ((m (list 1))
(x nil)
(r nil))
(dolist (css style)
(if (string= (car css) "font-size")
(progn
- (when (not x) (setq m (nconc m (hfy-size-to-int (cdr css)))))
+ (when (not x) (push (hfy--size-to-int (cdr css)) m))
(when (string-match "pt" (cdr css)) (setq x t)))
- (setq r (nconc r (list css)))))
+ (push css r)))
;;(message "r: %S" r)
- (setq n (apply #'* m))
- (nconc r (hfy-size (if x (round n) (* n 1.0)))) ))
+ (let ((n (apply #'* m)))
+ (nconc (nreverse r) (hfy-size (if x (round n) (float n)))))))
(defun hfy-face-resolve-face (fn)
"For FN return a face specification.
@@ -1052,7 +1040,7 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
;; text-decoration is not inherited.
;; but it's not wrong and if this ever changes it will
;; be needed, so I think it's better to leave it in? -- v
- (nconc final-style '(("text-decoration" . "none"))))))
+ (push '("text-decoration" . "none") final-style))))
final-style))
;; strip redundant bits from a name. Technically, this could result in
@@ -1914,7 +1902,7 @@ tree depth, as determined from FILE (a filename).
START is the offset at which to start looking for the / character in FILE."
;;(message "hfy-relstub");;DBUG
(let ((c ""))
- (while (setq start (string-match "/" file start))
+ (while (setq start (string-search "/" file start))
(setq start (1+ start)) (setq c (concat c "../")))
c))
@@ -2357,6 +2345,13 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
(let ((file (hfy-initfile)))
(load file 'NOERROR nil nil) ))
+;; Obsolete.
+
+(defun hfy-interq (set-a set-b)
+ "Return the intersection (using `eq') of two lists SET-A and SET-B."
+ (declare (obsolete seq-intersection "28.1"))
+ (nreverse (seq-intersection set-a set-b #'eq)))
+
(provide 'htmlfontify)
;;; htmlfontify.el ends here
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 44574abd46a..907ee8d63fc 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -332,6 +332,17 @@ where NAME is a unique but arbitrary name and FILTER-GROUP-LIST
is a list of filter groups with the same structure as
allowed for `ibuffer-filter-groups'.
+For instance:
+
+ (setq ibuffer-saved-filter-groups
+ \\='((\"Home\"
+ (\"Modified\" (predicate buffer-modified-p (current-buffer)))
+ (\"Helm\" (name . \"\\\\*helm.+\"))
+ (\"Dev\" (or (filename . \".+\\\\.css\\\\'\")
+ (filename . \".+\\\\.html?\\\\'\")
+ (mode . android-mode)
+ (mode . clojure-mode))))))
+
See also the functions `ibuffer-save-filter-groups' and
`ibuffer-switch-to-saved-filter-groups' for saving and switching
between sets of filter groups, and the variable
@@ -402,7 +413,7 @@ format. See `ibuffer-update-saved-filters-format' and
;;;###autoload
(define-minor-mode ibuffer-auto-mode
"Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)."
- nil nil nil
+ :lighter nil
(unless (derived-mode-p 'ibuffer-mode)
(error "This buffer is not in Ibuffer mode"))
(cond (ibuffer-auto-mode
@@ -687,8 +698,8 @@ specifications with the same structure as
`ibuffer-filtering-qualifiers'."
(not
(memq nil ;; a filter will return nil if it failed
- (mapcar #'(lambda (filter)
- (ibuffer-included-in-filter-p buf filter))
+ (mapcar (lambda (filter)
+ (ibuffer-included-in-filter-p buf filter))
filters))))
(defun ibuffer-unary-operand (filter)
@@ -724,8 +735,8 @@ specification, with the same structure as an element of the list
;; (dolist (filter-spec (cdr filter) nil)
;; (when (ibuffer-included-in-filter-p buf filter-spec)
;; (throw 'has-match t))))
- (memq t (mapcar #'(lambda (x)
- (ibuffer-included-in-filter-p buf x))
+ (memq t (mapcar (lambda (x)
+ (ibuffer-included-in-filter-p buf x))
(cdr filter))))
('and
(catch 'no-match
@@ -1589,8 +1600,8 @@ to move by. The default is `ibuffer-marked-char'."
(message "No buffers marked; use `m' to mark a buffer")
(let ((count
(ibuffer-map-marked-lines
- #'(lambda (_buf _mark)
- 'kill))))
+ (lambda (_buf _mark)
+ 'kill))))
(message "Killed %s lines" count))))
;;;###autoload
@@ -1609,8 +1620,8 @@ a prefix argument reverses the meaning of that variable."
(when current-prefix-arg
(setq only-visible (not only-visible)))
(if only-visible
- (let ((table (mapcar #'(lambda (x)
- (buffer-name (car x)))
+ (let ((table (mapcar (lambda (x)
+ (buffer-name (car x)))
(ibuffer-current-state-list))))
(when (null table)
(error "No buffers!"))
@@ -1621,10 +1632,10 @@ a prefix argument reverses the meaning of that variable."
(let (buf-point)
;; Blindly search for our buffer: it is very likely that it is
;; not in a hidden filter group.
- (ibuffer-map-lines #'(lambda (buf _marks)
- (when (string= (buffer-name buf) name)
- (setq buf-point (point))
- nil))
+ (ibuffer-map-lines (lambda (buf _marks)
+ (when (string= (buffer-name buf) name)
+ (setq buf-point (point))
+ nil))
t nil)
(when (and
(null buf-point)
@@ -1635,10 +1646,10 @@ a prefix argument reverses the meaning of that variable."
(dolist (group ibuffer-hidden-filter-groups)
(ibuffer-jump-to-filter-group group)
(ibuffer-toggle-filter-group)
- (ibuffer-map-lines #'(lambda (buf _marks)
- (when (string= (buffer-name buf) name)
- (setq buf-point (point))
- nil))
+ (ibuffer-map-lines (lambda (buf _marks)
+ (when (string= (buffer-name buf) name)
+ (setq buf-point (point))
+ nil))
t group)
(if buf-point
(throw 'found nil)
@@ -1775,11 +1786,11 @@ You can then feed the file name(s) to other commands with \\[yank]."
(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
(let ((count
(ibuffer-map-lines
- #'(lambda (buf _mark)
- (when (funcall func buf)
- (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
- ibuffer-marked-char))
- t))
+ (lambda (buf _mark)
+ (when (funcall func buf)
+ (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
+ ibuffer-marked-char))
+ t))
nil
group)))
(ibuffer-redisplay t)
@@ -1791,8 +1802,8 @@ You can then feed the file name(s) to other commands with \\[yank]."
"Mark all buffers whose name matches REGEXP."
(interactive "sMark by name (regexp): ")
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (string-match regexp (buffer-name buf)))))
+ (lambda (buf)
+ (string-match regexp (buffer-name buf)))))
(defun ibuffer-locked-buffer-p (&optional buf)
"Return non-nil if BUF is locked.
@@ -1816,9 +1827,9 @@ When BUF nil, default to the buffer at current line."
"Mark all buffers whose major mode matches REGEXP."
(interactive "sMark by major mode (regexp): ")
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (string-match regexp (format-mode-line mode-name nil nil buf))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (string-match regexp (format-mode-line mode-name nil nil buf))))))
;;;###autoload
(defun ibuffer-mark-by-file-name-regexp (regexp)
@@ -1840,21 +1851,21 @@ Otherwise buffers whose name matches an element of
(interactive (let ((reg (read-string "Mark by content (regexp): ")))
(list reg current-prefix-arg)))
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (let ((mode (with-current-buffer buf major-mode))
- res)
- (cond ((and (not all-buffers)
- (or
- (memq mode ibuffer-never-search-content-mode)
- (cl-dolist (x ibuffer-never-search-content-name nil)
- (when-let ((found (string-match x (buffer-name buf))))
- (cl-return found)))))
- (setq res nil))
- (t
- (with-current-buffer buf
- (save-mark-and-excursion
- (goto-char (point-min))
- (setq res (re-search-forward regexp nil t)))))) res))))
+ (lambda (buf)
+ (let ((mode (with-current-buffer buf major-mode))
+ res)
+ (cond ((and (not all-buffers)
+ (or
+ (memq mode ibuffer-never-search-content-mode)
+ (cl-dolist (x ibuffer-never-search-content-name nil)
+ (when-let ((found (string-match x (buffer-name buf))))
+ (cl-return found)))))
+ (setq res nil))
+ (t
+ (with-current-buffer buf
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (setq res (re-search-forward regexp nil t)))))) res))))
;;;###autoload
(defun ibuffer-mark-by-mode (mode)
@@ -1869,92 +1880,92 @@ Otherwise buffers whose name matches an element of
(format-prompt "Mark by major mode" default)
(ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (eq (buffer-local-value 'major-mode buf) mode))))
+ (lambda (buf)
+ (eq (buffer-local-value 'major-mode buf) mode))))
;;;###autoload
(defun ibuffer-mark-modified-buffers ()
"Mark all modified buffers."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (buffer-modified-p buf))))
+ (lambda (buf) (buffer-modified-p buf))))
;;;###autoload
(defun ibuffer-mark-unsaved-buffers ()
"Mark all modified buffers that have an associated file."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
- (buffer-modified-p buf)))))
+ (lambda (buf) (and (buffer-local-value 'buffer-file-name buf)
+ (buffer-modified-p buf)))))
;;;###autoload
(defun ibuffer-mark-dissociated-buffers ()
"Mark all buffers whose associated file does not exist."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (or
- (and buffer-file-name
- (not (file-exists-p buffer-file-name)))
- (and (eq major-mode 'dired-mode)
- (boundp 'dired-directory)
- (stringp dired-directory)
- (not (file-exists-p (file-name-directory dired-directory)))))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (or
+ (and buffer-file-name
+ (not (file-exists-p buffer-file-name)))
+ (and (eq major-mode 'dired-mode)
+ (boundp 'dired-directory)
+ (stringp dired-directory)
+ (not (file-exists-p (file-name-directory dired-directory)))))))))
;;;###autoload
(defun ibuffer-mark-help-buffers ()
"Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (memq major-mode ibuffer-help-buffer-modes)))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (memq major-mode ibuffer-help-buffer-modes)))))
;;;###autoload
(defun ibuffer-mark-compressed-file-buffers ()
"Mark buffers whose associated file is compressed."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (and buffer-file-name
- (string-match ibuffer-compressed-file-name-regexp
- buffer-file-name))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (and buffer-file-name
+ (string-match ibuffer-compressed-file-name-regexp
+ buffer-file-name))))))
;;;###autoload
(defun ibuffer-mark-old-buffers ()
"Mark buffers which have not been viewed in `ibuffer-old-time' hours."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf)
- (with-current-buffer buf
- (when buffer-display-time
- (time-less-p
- (* 60 60 ibuffer-old-time)
- (time-since buffer-display-time)))))))
+ (lambda (buf)
+ (with-current-buffer buf
+ (when buffer-display-time
+ (time-less-p
+ (* 60 60 ibuffer-old-time)
+ (time-since buffer-display-time)))))))
;;;###autoload
(defun ibuffer-mark-special-buffers ()
"Mark all buffers whose name begins and ends with `*'."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (string-match "^\\*.+\\*$"
- (buffer-name buf)))))
+ (lambda (buf) (string-match "^\\*.+\\*$"
+ (buffer-name buf)))))
;;;###autoload
(defun ibuffer-mark-read-only-buffers ()
"Mark all read-only buffers."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (buffer-local-value 'buffer-read-only buf))))
+ (lambda (buf) (buffer-local-value 'buffer-read-only buf))))
;;;###autoload
(defun ibuffer-mark-dired-buffers ()
"Mark all `dired' buffers."
(interactive)
(ibuffer-mark-on-buffer
- #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
+ (lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode))))
;;;###autoload
(defun ibuffer-do-occur (regexp &optional nlines)
@@ -1970,8 +1981,8 @@ defaults to one."
(let ((ibuffer-do-occur-bufs nil))
;; Accumulate a list of marked buffers
(ibuffer-map-marked-lines
- #'(lambda (buf _mark)
- (push buf ibuffer-do-occur-bufs)))
+ (lambda (buf _mark)
+ (push buf ibuffer-do-occur-bufs)))
(occur-1 regexp nlines ibuffer-do-occur-bufs)))
(provide 'ibuf-ext)
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index be09c6582ce..fcc4f9e751c 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -66,8 +66,8 @@ During evaluation of body, bind `it' to the value returned by TEST."
(ibuffer-redisplay-engine
;; Get rid of dead buffers
(delq nil
- (mapcar #'(lambda (e) (when (buffer-live-p (car e))
- e))
+ (mapcar (lambda (e) (when (buffer-live-p (car e))
+ e))
ibuffer-save-marks-tmp-mark-list)))
(ibuffer-redisplay t))))))
@@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'.
(ibuffer-redisplay t)
(setq ibuffer-last-sorting-mode ',name))
(push (list ',name ,description
- #'(lambda (a b)
- ,@body))
+ (lambda (a b)
+ ,@body))
ibuffer-sorting-functions-alist)
:autoload-end))
@@ -259,18 +259,18 @@ buffer object.
'ibuffer-map-deletion-lines)
(_
'ibuffer-map-marked-lines))
- #'(lambda (buf mark)
- ;; Silence warning for code that doesn't
- ;; use `mark'.
- (ignore mark)
- ,(if (eq modifier-p :maybe)
- `(let ((ibuffer-tmp-previous-buffer-modification
- (buffer-modified-p buf)))
- (prog1 ,inner-body
- (when (not (eq ibuffer-tmp-previous-buffer-modification
- (buffer-modified-p buf)))
- (setq ibuffer-did-modification t))))
- inner-body)))))
+ (lambda (buf mark)
+ ;; Silence warning for code that doesn't
+ ;; use `mark'.
+ (ignore mark)
+ ,(if (eq modifier-p :maybe)
+ `(let ((ibuffer-tmp-previous-buffer-modification
+ (buffer-modified-p buf)))
+ (prog1 ,inner-body
+ (when (not (eq ibuffer-tmp-previous-buffer-modification
+ (buffer-modified-p buf)))
+ (setq ibuffer-did-modification t))))
+ inner-body)))))
,finish)))
(if dangerous
`(when (ibuffer-confirm-operation-on ,active-opstring marked-names)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 6dc1c7ebc2b..6c0180590b9 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -364,64 +364,6 @@ directory, like `default-directory'."
(regexp :tag "From")
(regexp :tag "To"))))
-(defvar ibuffer-mode-groups-popup
- (let ((groups-map (make-sparse-keymap "Filter Groups")))
- ;; Filter groups
-
- (define-key-after groups-map [filters-to-filter-group]
- '(menu-item "Create filter group from current filters..."
- ibuffer-filters-to-filter-group
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)))
- (define-key-after groups-map [forward-filter-group]
- '(menu-item "Move point to the next filter group"
- ibuffer-forward-filter-group))
- (define-key-after groups-map [backward-filter-group]
- '(menu-item "Move point to the previous filter group"
- ibuffer-backward-filter-group))
- (define-key-after groups-map [jump-to-filter-group]
- '(menu-item "Move point to a specific filter group..."
- ibuffer-jump-to-filter-group))
- (define-key-after groups-map [kill-filter-group]
- '(menu-item "Kill filter group named..."
- ibuffer-kill-filter-group
- :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
- (define-key-after groups-map [yank-filter-group]
- '(menu-item "Yank last killed filter group before..."
- ibuffer-yank-filter-group
- :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring)))
- (define-key-after groups-map [pop-filter-group]
- '(menu-item "Remove top filter group"
- ibuffer-pop-filter-group
- :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
- (define-key-after groups-map [clear-filter-groups]
- '(menu-item "Remove all filter groups"
- ibuffer-clear-filter-groups
- :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
- (define-key-after groups-map [pop-filter-group]
- '(menu-item "Decompose filter group..."
- ibuffer-pop-filter-group
- :help "\"Unmake\" a filter group"
- :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
- (define-key-after groups-map [save-filter-groups]
- '(menu-item "Save current filter groups permanently..."
- ibuffer-save-filter-groups
- :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)
- :help "Use a mnemonic name to store current filter groups"))
- (define-key-after groups-map [switch-to-saved-filter-groups]
- '(menu-item "Restore permanently saved filters..."
- ibuffer-switch-to-saved-filter-groups
- :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups)
- :help "Replace current filters with a saved stack"))
- (define-key-after groups-map [delete-saved-filter-groups]
- '(menu-item "Delete permanently saved filter groups..."
- ibuffer-delete-saved-filter-groups
- :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups)))
- (define-key-after groups-map [set-filter-groups-by-mode]
- '(menu-item "Set current filter groups to filter by mode"
- ibuffer-set-filter-groups-by-mode))
-
- groups-map))
-
(defvar ibuffer--filter-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'ibuffer-filter-by-mode)
@@ -588,303 +530,233 @@ directory, like `default-directory'."
(define-key map (kbd "C-x 5 RET") 'ibuffer-visit-buffer-other-frame)
(define-key map (kbd "/") ibuffer--filter-map)
-
- (define-key map [menu-bar view]
- (cons "View" (make-sparse-keymap "View")))
-
- (define-key-after map [menu-bar view visit-buffer]
- '(menu-item "View this buffer" ibuffer-visit-buffer))
- (define-key-after map [menu-bar view visit-buffer-other-window]
- '(menu-item "View (other window)" ibuffer-visit-buffer-other-window))
- (define-key-after map [menu-bar view visit-buffer-other-frame]
- '(menu-item "View (other frame)" ibuffer-visit-buffer-other-frame))
- (define-key-after map [menu-bar view ibuffer-update]
- '(menu-item "Update" ibuffer-update
- :help "Regenerate the list of buffers"))
- (define-key-after map [menu-bar view switch-format]
- '(menu-item "Switch display format" ibuffer-switch-format
- :help "Toggle between available values of `ibuffer-formats'"))
-
- (define-key-after map [menu-bar view dashes]
- '("--"))
-
- (define-key-after map [menu-bar view sort]
- (cons "Sort" (make-sparse-keymap "Sort")))
-
- (define-key-after map [menu-bar view sort do-sort-by-major-mode]
- '(menu-item "Sort by major mode" ibuffer-do-sort-by-major-mode))
- (define-key-after map [menu-bar view sort do-sort-by-size]
- '(menu-item "Sort by buffer size" ibuffer-do-sort-by-size))
- (define-key-after map [menu-bar view sort do-sort-by-alphabetic]
- '(menu-item "Sort lexicographically" ibuffer-do-sort-by-alphabetic
- :help "Sort by the alphabetic order of buffer name"))
- (define-key-after map [menu-bar view sort do-sort-by-recency]
- '(menu-item "Sort by view time" ibuffer-do-sort-by-recency
- :help "Sort by the last time the buffer was displayed"))
- (define-key-after map [menu-bar view sort dashes]
- '("--"))
- (define-key-after map [menu-bar view sort invert-sorting]
- '(menu-item "Reverse sorting order" ibuffer-invert-sorting))
- (define-key-after map [menu-bar view sort toggle-sorting-mode]
- '(menu-item "Switch sorting mode" ibuffer-toggle-sorting-mode
- :help "Switch between the various sorting criteria"))
-
- (define-key-after map [menu-bar view filter]
- (cons "Filter" (make-sparse-keymap "Filter")))
-
- (define-key-after map [menu-bar view filter filter-disable]
- '(menu-item "Disable all filtering" ibuffer-filter-disable
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)))
- (define-key-after map [menu-bar view filter filter-by-mode]
- '(menu-item "Add filter by any major mode..." ibuffer-filter-by-mode))
- (define-key-after map [menu-bar view filter filter-by-used-mode]
- '(menu-item "Add filter by a major mode in use..."
- ibuffer-filter-by-used-mode))
- (define-key-after map [menu-bar view filter filter-by-derived-mode]
- '(menu-item "Add filter by derived mode..."
- ibuffer-filter-by-derived-mode))
- (define-key-after map [menu-bar view filter filter-by-name]
- '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name))
- (define-key-after map [menu-bar view filter filter-by-starred-name]
- '(menu-item "Add filter by starred buffer name..."
- ibuffer-filter-by-starred-name
- :help "List buffers whose names begin with a star"))
- (define-key-after map [menu-bar view filter filter-by-filename]
- '(menu-item "Add filter by full filename..." ibuffer-filter-by-filename
- :help
- (concat "For a buffer associated with file `/a/b/c.d', "
- "list buffer if a given pattern matches `/a/b/c.d'")))
- (define-key-after map [menu-bar view filter filter-by-basename]
- '(menu-item "Add filter by file basename..."
- ibuffer-filter-by-basename
- :help (concat "For a buffer associated with file `/a/b/c.d', "
- "list buffer if a given pattern matches `c.d'")))
- (define-key-after map [menu-bar view filter filter-by-file-extension]
- '(menu-item "Add filter by file name extension..."
- ibuffer-filter-by-file-extension
- :help (concat "For a buffer associated with file `/a/b/c.d', "
- "list buffer if a given pattern matches `d'")))
- (define-key-after map [menu-bar view filter filter-by-directory]
- '(menu-item "Add filter by filename's directory..."
- ibuffer-filter-by-directory
- :help
- (concat "For a buffer associated with file `/a/b/c.d', "
- "list buffer if a given pattern matches `/a/b'")))
- (define-key-after map [menu-bar view filter filter-by-size-lt]
- '(menu-item "Add filter by size less than..." ibuffer-filter-by-size-lt))
- (define-key-after map [menu-bar view filter filter-by-size-gt]
- '(menu-item "Add filter by size greater than..."
- ibuffer-filter-by-size-gt))
- (define-key-after map [menu-bar view filter filter-by-modified]
- '(menu-item "Add filter by modified buffer" ibuffer-filter-by-modified
- :help "List buffers that are marked as modified"))
- (define-key-after map [menu-bar view filter filter-by-visiting-file]
- '(menu-item "Add filter by buffer visiting a file"
- ibuffer-filter-by-visiting-file
- :help "List buffers that are visiting files"))
- (define-key-after map [menu-bar view filter filter-by-content]
- '(menu-item "Add filter by content (regexp)..."
- ibuffer-filter-by-content))
- (define-key-after map [menu-bar view filter filter-by-predicate]
- '(menu-item "Add filter by Lisp predicate..."
- ibuffer-filter-by-predicate))
- (define-key-after map [menu-bar view filter pop-filter]
- '(menu-item "Remove top filter" ibuffer-pop-filter
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)))
- (define-key-after map [menu-bar view filter and-filter]
- '(menu-item "AND top two filters" ibuffer-and-filter
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers
- (cdr ibuffer-filtering-qualifiers))
- :help
- "Create a new filter which is the logical AND of the top two filters"))
- (define-key-after map [menu-bar view filter or-filter]
- '(menu-item "OR top two filters" ibuffer-or-filter
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers
- (cdr ibuffer-filtering-qualifiers))
- :help
- "Create a new filter which is the logical OR of the top two filters"))
- (define-key-after map [menu-bar view filter negate-filter]
- '(menu-item "Negate top filter" ibuffer-negate-filter
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)))
- (define-key-after map [menu-bar view filter decompose-filter]
- '(menu-item "Decompose top filter" ibuffer-decompose-filter
- :enable (and (featurep 'ibuf-ext)
- (memq (car ibuffer-filtering-qualifiers) '(or saved not)))
- :help "Break down a complex filter like OR or NOT"))
- (define-key-after map [menu-bar view filter exchange-filters]
- '(menu-item "Swap top two filters" ibuffer-exchange-filters
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers
- (cdr ibuffer-filtering-qualifiers))))
- (define-key-after map [menu-bar view filter save-filters]
- '(menu-item "Save current filters permanently..." ibuffer-save-filters
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)
- :help "Use a mnemonic name to store current filter stack"))
- (define-key-after map [menu-bar view filter switch-to-saved-filters]
- '(menu-item "Restore permanently saved filters..."
- ibuffer-switch-to-saved-filters
- :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters)
- :help "Replace current filters with a saved stack"))
- (define-key-after map [menu-bar view filter add-saved-filters]
- '(menu-item "Add to permanently saved filters..."
- ibuffer-add-saved-filters
- :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)
- :help "Include already saved stack with current filters"))
- (define-key-after map [menu-bar view filter delete-saved-filters]
- '(menu-item "Delete permanently saved filters..."
- ibuffer-delete-saved-filters
- :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters)))
-
- (define-key-after map [menu-bar view filter-groups]
- (cons "Filter Groups" ibuffer-mode-groups-popup))
-
- (define-key-after map [menu-bar view dashes2]
- '("--"))
- (define-key-after map [menu-bar view auto-mode]
- '(menu-item "Auto Mode" ibuffer-auto-mode
- :button (:toggle . ibuffer-auto-mode)
- :help "Attempt to automatically update the Ibuffer buffer"))
-
- (define-key-after map [menu-bar mark]
- (cons "Mark" (make-sparse-keymap "Mark")))
-
- (define-key-after map [menu-bar mark toggle-marks]
- '(menu-item "Toggle marks" ibuffer-toggle-marks
- :help "Unmark marked buffers, and mark unmarked buffers"))
- (define-key-after map [menu-bar mark change-marks]
- '(menu-item "Change marks" ibuffer-change-marks
- :help "Change OLD mark for marked buffers with NEW"))
- (define-key-after map [menu-bar mark mark-forward]
- '(menu-item "Mark" ibuffer-mark-forward
- :help "Mark the buffer at point"))
- (define-key-after map [menu-bar mark unmark-forward]
- '(menu-item "Unmark" ibuffer-unmark-forward
- :help "Unmark the buffer at point"))
- (define-key-after map [menu-bar mark mark-by-mode]
- '(menu-item "Mark by mode..." ibuffer-mark-by-mode
- :help "Mark all buffers in a particular major mode"))
- (define-key-after map [menu-bar mark mark-modified-buffers]
- '(menu-item "Mark modified buffers" ibuffer-mark-modified-buffers
- :help "Mark all buffers which have been modified"))
- (define-key-after map [menu-bar mark mark-unsaved-buffers]
- '(menu-item "Mark unsaved buffers" ibuffer-mark-unsaved-buffers
- :help "Mark all buffers which have a file and are modified"))
- (define-key-after map [menu-bar mark mark-read-only-buffers]
- '(menu-item "Mark read-only buffers" ibuffer-mark-read-only-buffers
- :help "Mark all buffers which are read-only"))
- (define-key-after map [menu-bar mark mark-special-buffers]
- '(menu-item "Mark special buffers" ibuffer-mark-special-buffers
- :help "Mark all buffers whose name begins with a *"))
- (define-key-after map [menu-bar mark mark-dired-buffers]
- '(menu-item "Mark dired buffers" ibuffer-mark-dired-buffers
- :help "Mark buffers in dired-mode"))
- (define-key-after map [menu-bar mark mark-dissociated-buffers]
- '(menu-item "Mark dissociated buffers" ibuffer-mark-dissociated-buffers
- :help "Mark buffers with a non-existent associated file"))
- (define-key-after map [menu-bar mark mark-help-buffers]
- '(menu-item "Mark help buffers" ibuffer-mark-help-buffers
- :help "Mark buffers in help-mode"))
- (define-key-after map [menu-bar mark mark-compressed-file-buffers]
- '(menu-item "Mark compressed file buffers"
- ibuffer-mark-compressed-file-buffers
- :help "Mark buffers which have a file that is compressed"))
- (define-key-after map [menu-bar mark mark-old-buffers]
- '(menu-item "Mark old buffers" ibuffer-mark-old-buffers
- :help "Mark buffers which have not been viewed recently"))
- (define-key-after map [menu-bar mark unmark-all]
- '(menu-item "Unmark All" ibuffer-unmark-all))
- (define-key-after map [menu-bar mark unmark-all-marks]
- '(menu-item "Unmark All buffers" ibuffer-unmark-all-marks))
-
- (define-key-after map [menu-bar mark dashes]
- '("--"))
-
- (define-key-after map [menu-bar mark mark-by-name-regexp]
- '(menu-item "Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp
- :help "Mark buffers whose name matches a regexp"))
- (define-key-after map [menu-bar mark mark-by-mode-regexp]
- '(menu-item "Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp
- :help "Mark buffers whose major mode name matches a regexp"))
- (define-key-after map [menu-bar mark mark-by-file-name-regexp]
- '(menu-item "Mark by file name (regexp)..."
- ibuffer-mark-by-file-name-regexp
- :help "Mark buffers whose file name matches a regexp"))
- (define-key-after map [menu-bar mark ibuffer-mark-by-content-regexp]
- '(menu-item "Mark by content (regexp)..."
- ibuffer-mark-by-content-regexp
- :help "Mark buffers whose content matches a regexp"))
- (define-key-after map [menu-bar mark mark-by-locked]
- '(menu-item "Mark by locked buffers..." ibuffer-mark-by-locked
- :help "Mark all locked buffers"))
-
map))
-(defvar ibuffer-mode-operate-map
- (let ((operate-map (make-sparse-keymap "Operate")))
- (define-key-after operate-map [do-view]
- '(menu-item "View" ibuffer-do-view))
- (define-key-after operate-map [do-view-other-frame]
- '(menu-item "View (separate frame)" ibuffer-do-view-other-frame))
- (define-key-after operate-map [do-save]
- '(menu-item "Save" ibuffer-do-save))
- (define-key-after operate-map [do-replace-regexp]
- '(menu-item "Replace (regexp)..." ibuffer-do-replace-regexp
- :help "Replace text inside marked buffers"))
- (define-key-after operate-map [do-query-replace]
- '(menu-item "Query Replace..." ibuffer-do-query-replace
- :help "Replace text in marked buffers, asking each time"))
- (define-key-after operate-map [do-query-replace-regexp]
- '(menu-item "Query Replace (regexp)..." ibuffer-do-query-replace-regexp
- :help "Replace text in marked buffers by regexp, asking each time"))
- (define-key-after operate-map [do-print]
- '(menu-item "Print" ibuffer-do-print))
- (define-key-after operate-map [do-toggle-modified]
- '(menu-item "Toggle modification flag" ibuffer-do-toggle-modified))
- (define-key-after operate-map [do-toggle-read-only]
- '(menu-item "Toggle read-only flag" ibuffer-do-toggle-read-only))
- (define-key-after operate-map [do-toggle-lock]
- '(menu-item "Toggle lock flag" ibuffer-do-toggle-lock))
- (define-key-after operate-map [do-revert]
- '(menu-item "Revert" ibuffer-do-revert
- :help "Revert marked buffers to their associated file"))
- (define-key-after operate-map [do-rename-uniquely]
- '(menu-item "Rename Uniquely" ibuffer-do-rename-uniquely
- :help "Rename marked buffers to a new, unique name"))
- (define-key-after operate-map [do-delete]
- '(menu-item "Kill" ibuffer-do-delete))
- (define-key-after operate-map [do-occur]
- '(menu-item "List lines matching..." ibuffer-do-occur
- :help "View all lines in marked buffers matching a regexp"))
- (define-key-after operate-map [do-shell-command-pipe]
- '(menu-item "Pipe to shell command..." ibuffer-do-shell-command-pipe
- :help "For each marked buffer, send its contents to a shell command"))
- (define-key-after operate-map [do-shell-command-pipe-replace]
- '(menu-item "Pipe to shell command (replace)..." ibuffer-do-shell-command-pipe-replace
- :help "For each marked buffer, replace its contents with output of shell command"))
- (define-key-after operate-map [do-shell-command-file]
- '(menu-item "Shell command on buffer's file..." ibuffer-do-shell-command-file
- :help "For each marked buffer, run a shell command with its file as argument"))
- (define-key-after operate-map [do-eval]
- '(menu-item "Eval..." ibuffer-do-eval
- :help "Evaluate a Lisp form in each marked buffer"))
- (define-key-after operate-map [do-view-and-eval]
- '(menu-item "Eval (viewing buffer)..." ibuffer-do-view-and-eval
- :help "Evaluate a Lisp form in each marked buffer while viewing it"))
- (define-key-after operate-map [diff-with-file]
- '(menu-item "Diff with file" ibuffer-diff-with-file
- :help "View the differences between this buffer and its file"))
-
- operate-map))
-
-(define-key ibuffer-mode-groups-popup [kill-filter-group]
- '(menu-item "Kill filter group"
- ibuffer-kill-line
- :enable (and (featurep 'ibuf-ext)
- ibuffer-filter-groups)))
-(define-key ibuffer-mode-groups-popup [yank-filter-group]
- '(menu-item "Yank last killed filter group"
- ibuffer-yank
- :enable (and (featurep 'ibuf-ext)
- ibuffer-filter-group-kill-ring)))
+(defun ibuffer-mode--groups-menu-definition (&optional is-popup)
+ "Build the `ibuffer' \"Filter\" menu. Internal."
+ `("Filter Groups"
+ ["Create filter group from current filters..."
+ ibuffer-filters-to-filter-group
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)]
+ ["Move point to the next filter group"
+ ibuffer-forward-filter-group]
+ ["Move point to the previous filter group"
+ ibuffer-backward-filter-group]
+ ["Move point to a specific filter group..."
+ ibuffer-jump-to-filter-group]
+ ,@(if is-popup
+ '(["Kill filter group"
+ ibuffer-kill-line
+ :enable (and (featurep 'ibuf-ext)
+ ibuffer-filter-groups)]
+ ["Yank last killed filter group"
+ ibuffer-yank
+ :enable (and (featurep 'ibuf-ext)
+ ibuffer-filter-group-kill-ring)])
+ '(["Kill filter group named..."
+ ibuffer-kill-filter-group
+ :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)]
+ ["Yank last killed filter group before..."
+ ibuffer-yank-filter-group
+ :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring)]))
+ ["Remove top filter group"
+ ibuffer-pop-filter-group
+ :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)]
+ ["Remove all filter groups"
+ ibuffer-clear-filter-groups
+ :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)]
+ ["Decompose filter group..."
+ ibuffer-pop-filter-group
+ :help "\"Unmake\" a filter group"
+ :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)]
+ ["Save current filter groups permanently..."
+ ibuffer-save-filter-groups
+ :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)
+ :help "Use a mnemonic name to store current filter groups"]
+ ["Restore permanently saved filters..."
+ ibuffer-switch-to-saved-filter-groups
+ :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups)
+ :help "Replace current filters with a saved stack"]
+ ["Delete permanently saved filter groups..."
+ ibuffer-delete-saved-filter-groups
+ :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups)]
+ ["Set current filter groups to filter by mode"
+ ibuffer-set-filter-groups-by-mode]))
+
+(easy-menu-define ibuffer-mode-groups-popup nil
+ "Menu for `ibuffer'."
+ (ibuffer-mode--groups-menu-definition 'is-popup))
+
+(easy-menu-define ibuffer-mode-mark-menu ibuffer-mode-map
+ "Mark menu for `ibuffer'."
+ '("Mark"
+ ["Toggle marks" ibuffer-toggle-marks
+ :help "Unmark marked buffers, and mark unmarked buffers"]
+ ["Change marks" ibuffer-change-marks
+ :help "Change OLD mark for marked buffers with NEW"]
+ ["Mark" ibuffer-mark-forward
+ :help "Mark the buffer at point"]
+ ["Unmark" ibuffer-unmark-forward
+ :help "Unmark the buffer at point"]
+ ["Mark by mode..." ibuffer-mark-by-mode
+ :help "Mark all buffers in a particular major mode"]
+ ["Mark modified buffers" ibuffer-mark-modified-buffers
+ :help "Mark all buffers which have been modified"]
+ ["Mark unsaved buffers" ibuffer-mark-unsaved-buffers
+ :help "Mark all buffers which have a file and are modified"]
+ ["Mark read-only buffers" ibuffer-mark-read-only-buffers
+ :help "Mark all buffers which are read-only"]
+ ["Mark special buffers" ibuffer-mark-special-buffers
+ :help "Mark all buffers whose name begins with a *"]
+ ["Mark dired buffers" ibuffer-mark-dired-buffers
+ :help "Mark buffers in dired-mode"]
+ ["Mark dissociated buffers" ibuffer-mark-dissociated-buffers
+ :help "Mark buffers with a non-existent associated file"]
+ ["Mark help buffers" ibuffer-mark-help-buffers
+ :help "Mark buffers in help-mode"]
+ ["Mark compressed file buffers" ibuffer-mark-compressed-file-buffers
+ :help "Mark buffers which have a file that is compressed"]
+ ["Mark old buffers" ibuffer-mark-old-buffers
+ :help "Mark buffers which have not been viewed recently"]
+ ["Unmark All" ibuffer-unmark-all]
+ ["Unmark All buffers" ibuffer-unmark-all-marks]
+ "---"
+ ["Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp
+ :help "Mark buffers whose name matches a regexp"]
+ ["Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp
+ :help "Mark buffers whose major mode name matches a regexp"]
+ ["Mark by file name (regexp)..." ibuffer-mark-by-file-name-regexp
+ :help "Mark buffers whose file name matches a regexp"]
+ ["Mark by content (regexp)..." ibuffer-mark-by-content-regexp
+ :help "Mark buffers whose content matches a regexp"]
+ ["Mark by locked buffers..." ibuffer-mark-by-locked
+ :help "Mark all locked buffers"]))
+
+(easy-menu-define ibuffer-mode-view-menu ibuffer-mode-map
+ "View menu for `ibuffer'."
+ `("View"
+ ["View this buffer" ibuffer-visit-buffer]
+ ["View (other window)" ibuffer-visit-buffer-other-window]
+ ["View (other frame)" ibuffer-visit-buffer-other-frame]
+ ["Update" ibuffer-update
+ :help "Regenerate the list of buffers"]
+ ["Switch display format" ibuffer-switch-format
+ :help "Toggle between available values of `ibuffer-formats'"]
+ "---"
+ ("Sort"
+ ["Sort by major mode" ibuffer-do-sort-by-major-mode]
+ ["Sort by buffer size" ibuffer-do-sort-by-size]
+ ["Sort lexicographically" ibuffer-do-sort-by-alphabetic
+ :help "Sort by the alphabetic order of buffer name"]
+ ["Sort by view time" ibuffer-do-sort-by-recency
+ :help "Sort by the last time the buffer was displayed"]
+ "---"
+ ["Reverse sorting order" ibuffer-invert-sorting]
+ ["Switch sorting mode" ibuffer-toggle-sorting-mode
+ :help "Switch between the various sorting criteria"])
+ ("Filter"
+ ["Disable all filtering" ibuffer-filter-disable
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)]
+ ["Add filter by any major mode..." ibuffer-filter-by-mode]
+ ["Add filter by a major mode in use..." ibuffer-filter-by-used-mode]
+ ["Add filter by derived mode..." ibuffer-filter-by-derived-mode]
+ ["Add filter by buffer name..." ibuffer-filter-by-name]
+ ["Add filter by starred buffer name..." ibuffer-filter-by-starred-name
+ :help "List buffers whose names begin with a star"]
+ ["Add filter by full filename..." ibuffer-filter-by-filename
+ :help (concat "For a buffer associated with file `/a/b/c.d', "
+ "list buffer if a given pattern matches `/a/b/c.d'")]
+ ["Add filter by file basename..." ibuffer-filter-by-basename
+ :help (concat "For a buffer associated with file `/a/b/c.d', "
+ "list buffer if a given pattern matches `c.d'")]
+ ["Add filter by file name extension..." ibuffer-filter-by-file-extension
+ :help (concat "For a buffer associated with file `/a/b/c.d', "
+ "list buffer if a given pattern matches `d'")]
+ ["Add filter by filename's directory..." ibuffer-filter-by-directory
+ :help (concat "For a buffer associated with file `/a/b/c.d', "
+ "list buffer if a given pattern matches `/a/b'")]
+ ["Add filter by size less than..." ibuffer-filter-by-size-lt]
+ ["Add filter by size greater than..." ibuffer-filter-by-size-gt]
+ ["Add filter by modified buffer" ibuffer-filter-by-modified
+ :help "List buffers that are marked as modified"]
+ ["Add filter by buffer visiting a file" ibuffer-filter-by-visiting-file
+ :help "List buffers that are visiting files"]
+ ["Add filter by content (regexp)..." ibuffer-filter-by-content]
+ ["Add filter by Lisp predicate..." ibuffer-filter-by-predicate]
+ ["Remove top filter" ibuffer-pop-filter
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)]
+ ["AND top two filters" ibuffer-and-filter
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers
+ (cdr ibuffer-filtering-qualifiers))
+ :help "Create a new filter which is the logical AND of the top two filters"]
+ ["OR top two filters" ibuffer-or-filter
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers
+ (cdr ibuffer-filtering-qualifiers))
+ :help "Create a new filter which is the logical OR of the top two filters"]
+ ["Negate top filter" ibuffer-negate-filter
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)]
+ ["Decompose top filter" ibuffer-decompose-filter
+ :enable (and (featurep 'ibuf-ext)
+ (memq (car ibuffer-filtering-qualifiers) '(or saved not)))
+ :help "Break down a complex filter like OR or NOT"]
+ ["Swap top two filters" ibuffer-exchange-filters
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers
+ (cdr ibuffer-filtering-qualifiers))]
+ ["Save current filters permanently..." ibuffer-save-filters
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)
+ :help "Use a mnemonic name to store current filter stack"]
+ ["Restore permanently saved filters..." ibuffer-switch-to-saved-filters
+ :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters)
+ :help "Replace current filters with a saved stack"]
+ ["Add to permanently saved filters..." ibuffer-add-saved-filters
+ :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers)
+ :help "Include already saved stack with current filters"]
+ ["Delete permanently saved filters..." ibuffer-delete-saved-filters
+ :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters)])
+ ;; The "Filter Groups" menu:
+ ,(ibuffer-mode--groups-menu-definition)
+ "---"
+ ["Auto Mode" ibuffer-auto-mode
+ :style toggle
+ :selected ibuffer-auto-mode
+ :help "Attempt to automatically update the Ibuffer buffer"]))
+
+(define-obsolete-variable-alias 'ibuffer-mode-operate-map 'ibuffer-mode-operate-menu "28.1")
+(easy-menu-define ibuffer-mode-operate-menu ibuffer-mode-map
+ "Operate menu for `ibuffer'."
+ '("Operate"
+ ["View" ibuffer-do-view]
+ ["View (separate frame)" ibuffer-do-view-other-frame]
+ ["Save" ibuffer-do-save]
+ ["Replace (regexp)..." ibuffer-do-replace-regexp
+ :help "Replace text inside marked buffers"]
+ ["Query Replace..." ibuffer-do-query-replace
+ :help "Replace text in marked buffers, asking each time"]
+ ["Query Replace (regexp)..." ibuffer-do-query-replace-regexp
+ :help "Replace text in marked buffers by regexp, asking each time"]
+ ["Print" ibuffer-do-print]
+ ["Toggle modification flag" ibuffer-do-toggle-modified]
+ ["Toggle read-only flag" ibuffer-do-toggle-read-only]
+ ["Toggle lock flag" ibuffer-do-toggle-lock]
+ ["Revert" ibuffer-do-revert
+ :help "Revert marked buffers to their associated file"]
+ ["Rename Uniquely" ibuffer-do-rename-uniquely
+ :help "Rename marked buffers to a new, unique name"]
+ ["Kill" ibuffer-do-delete]
+ ["List lines matching..." ibuffer-do-occur
+ :help "View all lines in marked buffers matching a regexp"]
+ ["Pipe to shell command..." ibuffer-do-shell-command-pipe
+ :help "For each marked buffer, send its contents to a shell command"]
+ ["Pipe to shell command (replace)..." ibuffer-do-shell-command-pipe-replace
+ :help "For each marked buffer, replace its contents with output of shell command"]
+ ["Shell command on buffer's file..." ibuffer-do-shell-command-file
+ :help "For each marked buffer, run a shell command with its file as argument"]
+ ["Eval..." ibuffer-do-eval
+ :help "Evaluate a Lisp form in each marked buffer"]
+ ["Eval (viewing buffer)..." ibuffer-do-view-and-eval
+ :help "Evaluate a Lisp form in each marked buffer while viewing it"]
+ ["Diff with file" ibuffer-diff-with-file
+ :help "View the differences between this buffer and its file"]))
(defvar ibuffer-name-map
(let ((map (make-sparse-keymap)))
@@ -1025,7 +897,7 @@ width and the longest string in LIST."
(goto-char eventpt)
(ibuffer-set-mark ibuffer-marked-char))
(save-excursion
- (popup-menu ibuffer-mode-operate-map)))))
+ (popup-menu ibuffer-mode-operate-menu)))))
(setq buffer-read-only t)
(if (= eventpt (point))
(goto-char origpt)))))
@@ -1116,9 +988,7 @@ one window."
(let ((buf (ibuffer-current-buffer t)))
(bury-buffer (current-buffer))
(if noselect
- (let ((curwin (selected-window)))
- (pop-to-buffer buf)
- (select-window curwin))
+ (display-buffer buf)
(switch-to-buffer-other-window buf))))
(defun ibuffer-visit-buffer-other-window-noselect ()
@@ -1209,8 +1079,11 @@ a new window in the current frame, splitting vertically."
;; Make sure that redisplay is performed, otherwise there can be a
;; bad interaction with code in the window-scroll-functions hook
(redisplay t)
- (fit-window-to-buffer nil (when owin (/ (frame-height)
- (length (window-list (selected-frame)))))))
+ (when (buffer-local-value 'ibuffer-auto-mode (window-buffer))
+ (fit-window-to-buffer
+ nil (and owin
+ (/ (frame-height)
+ (length (window-list (selected-frame))))))))
(defun ibuffer-confirm-operation-on (operation names)
"Display a buffer asking whether to perform OPERATION on NAMES."
@@ -1846,7 +1719,7 @@ If point is on a group name, this function operates on that group."
(ibuffer-buffer-name-face buffer mark))))
(if (not (seq-position string ?\n))
string
- (replace-regexp-in-string
+ (string-replace
"\n" (propertize "^J" 'font-lock-face 'escape-glyph) string))))
(define-ibuffer-column size
@@ -2425,7 +2298,7 @@ buffers which are visiting a file."
(defun ibuffer (&optional other-window-p name qualifiers noselect
shrink filter-groups formats)
"Begin using Ibuffer to edit a list of buffers.
-Type `h' after entering ibuffer for more information.
+Type \\<ibuffer-mode-map>\\[describe-mode] after entering ibuffer for more information.
All arguments are optional.
OTHER-WINDOW-P says to use another window.
@@ -2707,7 +2580,7 @@ will be inserted before the group at point."
(setq buffer-read-only t)
(buffer-disable-undo)
(setq truncate-lines ibuffer-truncate-lines)
- ;; This makes things less ugly for Emacs 21 users with a non-nil
+ ;; This makes things less ugly for users with a non-nil
;; `show-trailing-whitespace'.
(setq show-trailing-whitespace nil)
;; disable `show-paren-mode' buffer-locally
@@ -2734,7 +2607,6 @@ will be inserted before the group at point."
(setq-local ibuffer-tmp-hide-regexps nil)
(setq-local ibuffer-tmp-show-regexps nil)
(define-key ibuffer-mode-map [menu-bar edit] 'undefined)
- (define-key ibuffer-mode-map [menu-bar operate] (cons "Operate" ibuffer-mode-operate-map))
(ibuffer-update-format)
(when ibuffer-default-directory
(setq default-directory ibuffer-default-directory))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index da589c00649..03616f9b6aa 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -50,6 +50,8 @@
;;; Code:
(require 'rfn-eshadow) ; rfn-eshadow-overlay
+(require 'simple) ; max-mini-window-lines
+(require 'cl-lib)
(defgroup icomplete nil
"Show completions dynamically in minibuffer."
@@ -95,10 +97,24 @@ Otherwise this should be a list of the completion tables (e.g.,
:type '(choice (const :tag "All" t)
(repeat function)))
+(defcustom icomplete-matches-format "%s/%s "
+ "Format of the current/total number of matches for the prompt prefix."
+ :version "28.1"
+ :type '(choice (const :tag "No prefix" nil)
+ (string :tag "Prefix format string")))
+
(defface icomplete-first-match '((t :weight bold))
"Face used by Icomplete for highlighting first match."
:version "24.4")
+(defface icomplete-selected-match '((t :inherit highlight))
+ "Face used by `icomplete-vertical-mode' for the selected candidate."
+ :version "28.1")
+
+(defface icomplete-section '((t :inherit shadow :slant italic))
+ "Face used by `icomplete-vertical-mode' for the section title."
+ :version "28.1")
+
;;;_* User Customization variables
(defcustom icomplete-prospects-height 2
;; We used to compute how many lines 100 characters would take in
@@ -109,7 +125,7 @@ Otherwise this should be a list of the completion tables (e.g.,
:type 'integer
:version "26.1")
-(defcustom icomplete-compute-delay .3
+(defcustom icomplete-compute-delay .15
"Completions-computation stall, used only with large-number completions.
See `icomplete-delay-completions-threshold'."
:type 'number)
@@ -118,7 +134,7 @@ See `icomplete-delay-completions-threshold'."
"Pending-completions number over which to apply `icomplete-compute-delay'."
:type 'integer)
-(defcustom icomplete-max-delay-chars 3
+(defcustom icomplete-max-delay-chars 2
"Maximum number of initial chars to apply `icomplete-compute-delay'."
:type 'integer)
@@ -152,10 +168,6 @@ icompletion is occurring."
"Initial input in the minibuffer when icomplete-mode was activated.
Used to implement the option `icomplete-show-matches-on-no-input'.")
-(defun icomplete-pre-command-hook ()
- (let ((non-essential t))
- (icomplete-tidy)))
-
(defun icomplete-post-command-hook ()
(let ((non-essential t)) ;E.g. don't prompt for password!
(icomplete-exhibit)))
@@ -215,36 +227,82 @@ the default otherwise."
;; We're not at all interested in cycling here (bug#34077).
(minibuffer-force-complete nil nil 'dont-cycle))
+;; Apropos `icomplete-scroll', we implement "scrolling icomplete"
+;; within classic icomplete, which is "rotating", by contrast.
+;;
+;; The two variables supporing this are
+;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'.
+;; They come into play when:
+;;
+;; - The user invokes commands `icomplete-forward-completions' and
+;; `icomplete-backward-completions', thus "manually" scrolling to a
+;; given position;
+;;
+;; - The user re-filters a selection that had already been manually
+;; scrolled. The system attempts to keep the previous selection
+;; stable in the face of the new filtering. This is mostly done in
+;; `icomplete--render-vertical'.
+;;
+(defvar icomplete-scroll nil
+ "If non-nil, scroll candidates list instead of rotating it.")
+(defvar icomplete--scrolled-completions nil
+ "If non-nil, tail of completions list manually scrolled to.")
+(defvar icomplete--scrolled-past nil
+ "If non-nil, reverse tail of completions scrolled past.")
+
(defun icomplete-forward-completions ()
"Step forward completions by one entry.
Second entry becomes the first and can be selected with
-`icomplete-force-complete-and-exit'."
+`icomplete-force-complete-and-exit'.
+Return non-nil iff something was stepped."
(interactive)
(let* ((beg (icomplete--field-beg))
(end (icomplete--field-end))
- (comps (completion-all-sorted-completions beg end))
- (last (last comps)))
- (when comps
- (setcdr last (cons (car comps) (cdr last)))
- (completion--cache-all-sorted-completions beg end (cdr comps)))))
+ (comps (completion-all-sorted-completions beg end)))
+ (when (consp (cdr comps))
+ (cond (icomplete-scroll
+ (push (pop comps) icomplete--scrolled-past)
+ (setq icomplete--scrolled-completions comps))
+ (t
+ (let ((last (last comps)))
+ (setcdr (last comps) (cons (pop comps) (cdr last))))))
+ (completion--cache-all-sorted-completions beg end comps))))
(defun icomplete-backward-completions ()
"Step backward completions by one entry.
Last entry becomes the first and can be selected with
-`icomplete-force-complete-and-exit'."
+`icomplete-force-complete-and-exit'.
+Return non-nil iff something was stepped."
(interactive)
(let* ((beg (icomplete--field-beg))
(end (icomplete--field-end))
(comps (completion-all-sorted-completions beg end))
- (last-but-one (last comps 2))
- (last (cdr last-but-one)))
- (when (consp last) ; At least two elements in comps
- (setcdr last-but-one (cdr last))
- (push (car last) comps)
+ last-but-one)
+ (prog1
+ (cond ((and icomplete-scroll icomplete--scrolled-past)
+ (push (pop icomplete--scrolled-past) comps)
+ (setq icomplete--scrolled-completions comps))
+ ((and (not icomplete-scroll)
+ (consp (cdr (setq last-but-one (last comps 2)))))
+ ;; At least two elements in comps
+ (push (car (cdr last-but-one)) comps)
+ (setcdr last-but-one (cdr (cdr last-but-one)))))
(completion--cache-all-sorted-completions beg end comps))))
-;;; Helpers for `fido-mode' (or `ido-mode' emulation)
-;;;
+(defun icomplete-vertical-goto-first ()
+ "Go to first completions entry when `icomplete-scroll' is non-nil."
+ (interactive)
+ (unless icomplete-scroll (error "Only works with `icomplete-scroll'"))
+ (while (icomplete-backward-completions)))
+
+(defun icomplete-vertical-goto-last ()
+ "Go to last completions entry when `icomplete-scroll' is non-nil."
+ (interactive)
+ (unless icomplete-scroll (error "Only works with `icomplete-scroll'"))
+ (while (icomplete-forward-completions)))
+
+;;;_* Helpers for `fido-mode' (or `ido-mode' emulation)
+
(defun icomplete-fido-kill ()
"Kill line or current completion, like `ido-mode'.
If killing to the end of line make sense, call `kill-line',
@@ -259,18 +317,21 @@ require user confirmation."
(call-interactively 'kill-line)
(let* ((all (completion-all-sorted-completions))
(thing (car all))
+ (cat (icomplete--category))
(action
- (pcase (icomplete--category)
- (`buffer
+ (cl-case cat
+ (buffer
(lambda ()
(when (yes-or-no-p (concat "Kill buffer " thing "? "))
(kill-buffer thing))))
- (`file
+ ((project-file file)
(lambda ()
(let* ((dir (file-name-directory (icomplete--field-string)))
(path (expand-file-name thing dir)))
(when (yes-or-no-p (concat "Delete file " path "? "))
- (delete-file path) t)))))))
+ (delete-file path) t))))
+ (t
+ (error "Sorry, don't know how to kill things for `%s'" cat)))))
(when (let (;; Allow `yes-or-no-p' to work and don't let it
;; `icomplete-exhibit' anything.
(enable-recursive-minibuffers t)
@@ -298,7 +359,8 @@ require user confirmation."
(file-name-directory (icomplete--field-string))))
(current (car completion-all-sorted-completions))
(probe (and dir current
- (expand-file-name (directory-file-name current) dir))))
+ (expand-file-name (directory-file-name current)
+ (substitute-env-vars dir)))))
(cond ((and probe (file-directory-p probe) (not (string= current "./")))
(icomplete-force-complete))
(t
@@ -351,6 +413,7 @@ if that doesn't produce a completion match."
(setq-local icomplete-tidy-shadowed-file-names t
icomplete-show-matches-on-no-input t
icomplete-hide-common-prefix nil
+ icomplete-scroll (not (null icomplete-vertical-mode))
completion-styles '(flex)
completion-flex-nospace nil
completion-category-defaults nil
@@ -449,9 +512,9 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(when (and icomplete-mode (icomplete-simple-completing-p))
(setq-local icomplete--initial-input (icomplete--field-string))
(setq-local completion-show-inline-help nil)
+ (setq icomplete--scrolled-completions nil)
(use-local-map (make-composed-keymap icomplete-minibuffer-map
(current-local-map)))
- (add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t)
(add-hook 'post-command-hook #'icomplete-post-command-hook nil t)
(run-hooks 'icomplete-minibuffer-setup-hook)))
@@ -465,7 +528,6 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(setq icomplete--in-region-buffer nil)
(delete-overlay icomplete-overlay)
(kill-local-variable 'completion-show-inline-help)
- (remove-hook 'pre-command-hook 'icomplete-pre-command-hook t)
(remove-hook 'post-command-hook 'icomplete-post-command-hook t)
(message nil)))
(when (and completion-in-region-mode
@@ -477,12 +539,12 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(unless (memq icomplete-minibuffer-map (cdr tem))
(setcdr tem (make-composed-keymap icomplete-minibuffer-map
(cdr tem)))))
- (add-hook 'pre-command-hook 'icomplete-pre-command-hook nil t)
(add-hook 'post-command-hook 'icomplete-post-command-hook nil t)))
(defun icomplete--sorted-completions ()
(or completion-all-sorted-completions
(cl-loop
+ initially (setq icomplete--scrolled-past nil) ; Invalidate scrolled state
with beg = (icomplete--field-beg)
with end = (icomplete--field-end)
with all = (completion-all-sorted-completions beg end)
@@ -562,18 +624,60 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(completion--cache-all-sorted-completions beg end (cons comp all))))
finally return all)))
+(defvar icomplete-vertical-mode-minibuffer-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-n") 'icomplete-forward-completions)
+ (define-key map (kbd "C-p") 'icomplete-backward-completions)
+ (define-key map (kbd "<down>") 'icomplete-forward-completions)
+ (define-key map (kbd "<up>") 'icomplete-backward-completions)
+ (define-key map (kbd "M-<") 'icomplete-vertical-goto-first)
+ (define-key map (kbd "M->") 'icomplete-vertical-goto-last)
+ map)
+ "Keymap used by `icomplete-vertical-mode' in the minibuffer.")
+
+(defun icomplete--vertical-minibuffer-setup ()
+ "Setup the minibuffer for vertical display of completion candidates."
+ (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map
+ (current-local-map)))
+ (setq-local icomplete-hide-common-prefix nil
+ ;; Ask `icomplete-completions' to return enough completions candidates.
+ icomplete-prospects-height 25
+ redisplay-adhoc-scroll-in-resize-mini-windows nil))
+
+;;;###autoload
+(define-minor-mode icomplete-vertical-mode
+ "Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
+
+If none of these modes are on, turn on `icomplete-mode'.
+
+As many completion candidates as possible are displayed, depending on
+the value of `max-mini-window-height', and the way the mini-window is
+resized depends on `resize-mini-windows'."
+ :global t
+ (remove-hook 'icomplete-minibuffer-setup-hook
+ #'icomplete--vertical-minibuffer-setup)
+ (when icomplete-vertical-mode
+ (unless icomplete-mode
+ (icomplete-mode 1))
+ (add-hook 'icomplete-minibuffer-setup-hook
+ #'icomplete--vertical-minibuffer-setup)))
+
+;;;###autoload
+(define-minor-mode fido-vertical-mode
+ "Toggle vertical candidate display in `fido-mode'.
+When turning on, if non-vertical `fido-mode' is off, turn it on.
+If it's on, just add the vertical display."
+ :global t
+ (icomplete-vertical-mode -1)
+ (when fido-vertical-mode
+ (unless fido-mode (fido-mode 1))
+ (icomplete-vertical-mode 1)))
+
;;;_* Completion
-;;;_ > icomplete-tidy ()
-(defun icomplete-tidy ()
- "Remove completions display (if any) prior to new user input.
-Should be run in on the minibuffer `pre-command-hook'.
-See `icomplete-mode' and `minibuffer-setup-hook'."
- (delete-overlay icomplete-overlay))
-
;;;_ > icomplete-exhibit ()
(defun icomplete-exhibit ()
"Insert Icomplete completions display.
@@ -628,13 +732,163 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
deactivate-mark)
;; Do nothing if while-no-input was aborted.
(when (stringp text)
- (move-overlay icomplete-overlay (point) (point) (current-buffer))
+ (move-overlay icomplete-overlay (point-min) (point) (current-buffer))
;; The current C cursor code doesn't know to use the overlay's
;; marker's stickiness to figure out whether to place the cursor
;; before or after the string, so let's spoon-feed it the pos.
(put-text-property 0 1 'cursor t text)
+ (overlay-put
+ icomplete-overlay 'before-string
+ (and icomplete-scroll
+ icomplete-matches-format
+ (let* ((past (length icomplete--scrolled-past))
+ (current (1+ past))
+ (total (+ past (safe-length
+ completion-all-sorted-completions))))
+ (format icomplete-matches-format current total))))
(overlay-put icomplete-overlay 'after-string text))))))))
+(defun icomplete--augment (md prospects)
+ "Augment completion strings in PROSPECTS with completion metadata MD.
+Return a list of strings (COMP PREFIX SUFFIX SECTION). PREFIX
+and SUFFIX, if non-nil, are obtained from `affixation-function' or
+`annotation-function' metadata. SECTION is obtained from
+`group-function'. Consecutive `equal' sections are avoided.
+COMP is the element in PROSPECTS or a transformation also given
+by `group-function''s second \"transformation\" protocol."
+ (let* ((aff-fun (or (completion-metadata-get md 'affixation-function)
+ (plist-get completion-extra-properties :affixation-function)))
+ (ann-fun (or (completion-metadata-get md 'annotation-function)
+ (plist-get completion-extra-properties :annotation-function)))
+ (grp-fun (completion-metadata-get md 'group-function))
+ (annotated
+ (cond (aff-fun
+ (funcall aff-fun prospects))
+ (ann-fun
+ (mapcar
+ (lambda (comp)
+ (let ((suffix (or (funcall ann-fun comp) "")))
+ (list comp ""
+ ;; The default completion UI adds the
+ ;; `completions-annotations' face if no
+ ;; other faces are present.
+ (if (text-property-not-all 0 (length suffix) 'face nil suffix)
+ suffix
+ (propertize suffix 'face 'completions-annotations)))))
+ prospects))
+ (t (mapcar #'list prospects)))))
+ (if grp-fun
+ (cl-loop with section = nil
+ for (c prefix suffix) in annotated
+ for selectedp = (get-text-property 0 'icomplete-selected c)
+ for tr = (propertize (or (funcall grp-fun c t) c)
+ 'icomplete-selected selectedp)
+ if (not (equal section (setq section (funcall grp-fun c nil))))
+ collect (list tr prefix suffix section)
+ else collect (list tr prefix suffix ))
+ annotated)))
+
+(cl-defun icomplete--render-vertical
+ (comps md &aux scroll-above scroll-below
+ (total-space ; number of mini-window lines available
+ (1- (min
+ icomplete-prospects-height
+ (truncate (max-mini-window-lines) 1)))))
+ ;; Welcome to loopapalooza!
+ ;;
+ ;; First, be mindful of `icomplete-scroll' and manual scrolls. If
+ ;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'
+ ;; are:
+ ;;
+ ;; - both nil, there is no manual scroll;
+ ;; - both non-nil, there is a healthy manual scroll that doesn't need
+ ;; to be readjusted (user just moved around the minibuffer, for
+ ;; example)l
+ ;; - non-nil and nil, respectively, a refiltering took place and we
+ ;; may need to readjust them to the new filtered `comps'.
+ (when (and icomplete-scroll
+ icomplete--scrolled-completions
+ (null icomplete--scrolled-past))
+ (cl-loop with preds
+ for (comp . rest) on comps
+ when (equal comp (car icomplete--scrolled-completions))
+ do
+ (setq icomplete--scrolled-past preds
+ comps (cons comp rest))
+ (completion--cache-all-sorted-completions
+ (icomplete--field-beg)
+ (icomplete--field-end)
+ comps)
+ and return nil
+ do (push comp preds)
+ finally (setq icomplete--scrolled-completions nil)))
+ ;; Then, in this pretty ugly loop, collect completions to display
+ ;; above and below the selected one, considering scrolling
+ ;; positions.
+ (cl-loop with preds = icomplete--scrolled-past
+ with succs = (cdr comps)
+ with space-above = (- total-space
+ 1
+ (cl-loop for (_ . r) on comps
+ repeat (truncate total-space 2)
+ while (listp r)
+ count 1))
+ repeat total-space
+ for neighbour = nil
+ if (and preds (> space-above 0)) do
+ (push (setq neighbour (pop preds)) scroll-above)
+ (cl-decf space-above)
+ else if (consp succs) collect
+ (setq neighbour (pop succs)) into scroll-below-aux
+ while neighbour
+ finally (setq scroll-below scroll-below-aux))
+ ;; Halfway there...
+ (let* ((selected (propertize (car comps) 'icomplete-selected t))
+ (chosen (append scroll-above (list selected) scroll-below))
+ (tuples (icomplete--augment md chosen))
+ max-prefix-len max-comp-len lines nsections)
+ (add-face-text-property 0 (length selected)
+ 'icomplete-selected-match 'append selected)
+ ;; Figure out parameters for horizontal spacing
+ (cl-loop
+ for (comp prefix) in tuples
+ maximizing (length prefix) into max-prefix-len-aux
+ maximizing (length comp) into max-comp-len-aux
+ finally (setq max-prefix-len max-prefix-len-aux
+ max-comp-len max-comp-len-aux))
+ ;; Serialize completions and section titles into a list
+ ;; of lines to render
+ (cl-loop
+ for (comp prefix suffix section) in tuples
+ when section
+ collect (propertize section 'face 'icomplete-section) into lines-aux
+ and count 1 into nsections-aux
+ when (get-text-property 0 'icomplete-selected comp)
+ do (add-face-text-property 0 (length comp)
+ 'icomplete-selected-match 'append comp)
+ collect (concat prefix
+ (make-string (- max-prefix-len (length prefix)) ? )
+ comp
+ (make-string (- max-comp-len (length comp)) ? )
+ suffix)
+ into lines-aux
+ finally (setq lines lines-aux
+ nsections nsections-aux))
+ ;; Kick out some lines from the beginning due to extra sections.
+ ;; This hopes to keep the selected entry more or less in the
+ ;; middle of the dropdown-like widget when `icomplete-scroll' is
+ ;; t. Funky, but at least I didn't use `cl-loop'
+ (setq lines
+ (nthcdr
+ (cond ((<= (length lines) total-space) 0)
+ ((> (length scroll-above) (length scroll-below)) nsections)
+ (t (min (ceiling nsections 2) (length scroll-above))))
+ lines))
+ ;; At long last, render final string return value. This may still
+ ;; kick out lines at the end.
+ (concat " \n"
+ (cl-loop for l in lines repeat total-space concat l concat "\n"))))
+
;;;_ > icomplete-completions (name candidates predicate require-match)
(defun icomplete-completions (name candidates predicate require-match)
"Identify prospective candidates for minibuffer completion.
@@ -672,125 +926,131 @@ matches exist."
predicate))
(md (completion--field-metadata (icomplete--field-beg)))
(comps (icomplete--sorted-completions))
- (last (if (consp comps) (last comps)))
- (base-size (cdr last))
(open-bracket (if require-match "(" "["))
(close-bracket (if require-match ")" "]")))
;; `concat'/`mapconcat' is the slow part.
(if (not (consp comps))
(progn ;;(debug (format "Candidates=%S field=%S" candidates name))
(format " %sNo matches%s" open-bracket close-bracket))
- (if last (setcdr last nil))
- (let* ((most-try
- (if (and base-size (> base-size 0))
- (completion-try-completion
- name candidates predicate (length name) md)
- ;; If the `comps' are 0-based, the result should be
- ;; the same with `comps'.
- (completion-try-completion
- name comps nil (length name) md)))
- (most (if (consp most-try) (car most-try)
- (if most-try (car comps) "")))
- ;; Compare name and most, so we can determine if name is
- ;; a prefix of most, or something else.
- (compare (compare-strings name nil nil
- most nil nil completion-ignore-case))
- (ellipsis (if (char-displayable-p ?…) "…" "..."))
- (determ (unless (or (eq t compare) (eq t most-try)
- (= (setq compare (1- (abs compare)))
- (length most)))
- (concat open-bracket
- (cond
- ((= compare (length name))
- ;; Typical case: name is a prefix.
- (substring most compare))
- ;; Don't bother truncating if it doesn't gain
- ;; us at least 2 columns.
- ((< compare (+ 2 (string-width ellipsis))) most)
- (t (concat ellipsis (substring most compare))))
- close-bracket)))
- ;;"-prospects" - more than one candidate
- (prospects-len (+ (string-width
- (or determ (concat open-bracket close-bracket)))
- (string-width icomplete-separator)
- (+ 2 (string-width ellipsis)) ;; take {…} into account
- (string-width (buffer-string))))
- (prospects-max
- ;; Max total length to use, including the minibuffer content.
- (* (+ icomplete-prospects-height
- ;; If the minibuffer content already uses up more than
- ;; one line, increase the allowable space accordingly.
- (/ prospects-len (window-width)))
- (window-width)))
- ;; Find the common prefix among `comps'.
- ;; We can't use the optimization below because its assumptions
- ;; aren't always true, e.g. when completion-cycling (bug#10850):
- ;; (if (eq t (compare-strings (car comps) nil (length most)
- ;; most nil nil completion-ignore-case))
- ;; ;; Common case.
- ;; (length most)
- ;; Else, use try-completion.
- (prefix (when icomplete-hide-common-prefix
- (try-completion "" comps)))
- (prefix-len
- (and (stringp prefix)
- ;; Only hide the prefix if the corresponding info
- ;; is already displayed via `most'.
- (string-prefix-p prefix most t)
- (length prefix))) ;;)
- prospects comp limit)
- (if (or (eq most-try t) (not (consp (cdr comps))))
- (setq prospects nil)
- (when (member name comps)
- ;; NAME is complete but not unique. This scenario poses
- ;; following UI issues:
- ;;
- ;; - When `icomplete-hide-common-prefix' is non-nil, NAME
- ;; is stripped empty. This would make the entry
- ;; inconspicuous.
- ;;
- ;; - Due to sorting of completions, NAME may not be the
- ;; first of the prospects and could be hidden deep in
- ;; the displayed string.
- ;;
- ;; - Because of `icomplete-prospects-height' , NAME may
- ;; not even be displayed to the user.
- ;;
- ;; To circumvent all the above problems, provide a visual
- ;; cue to the user via an "empty string" in the try
- ;; completion field.
- (setq determ (concat open-bracket "" close-bracket)))
- ;; Compute prospects for display.
- (while (and comps (not limit))
- (setq comp
- (if prefix-len (substring (car comps) prefix-len) (car comps))
- comps (cdr comps))
- (setq prospects-len
- (+ (string-width comp)
- (string-width icomplete-separator)
- prospects-len))
- (if (< prospects-len prospects-max)
- (push comp prospects)
- (setq limit t))))
- (setq prospects (nreverse prospects))
- ;; Decorate first of the prospects.
- (when prospects
- (let ((first (copy-sequence (pop prospects))))
- (put-text-property 0 (length first)
- 'face 'icomplete-first-match first)
- (push first prospects)))
- ;; Restore the base-size info, since completion-all-sorted-completions
- ;; is cached.
- (if last (setcdr last base-size))
- (if prospects
- (concat determ
- "{"
- (mapconcat 'identity prospects icomplete-separator)
- (and limit (concat icomplete-separator ellipsis))
- "}")
- (concat determ " [Matched]"))))))
-
-;;; Iswitchb compatibility
+ (if icomplete-vertical-mode
+ (icomplete--render-vertical comps md)
+ (let* ((last (if (consp comps) (last comps)))
+ ;; Save the "base size" encoded in `comps' then
+ ;; removing making `comps' a proper list.
+ (base-size (prog1 (cdr last)
+ (if last (setcdr last nil))))
+ (most-try
+ ;; icomplete-hide-common-prefix logic is used
+ ;; unconditionally when there is single match.
+ (when (or icomplete-hide-common-prefix (not (cdr comps)))
+ (if (and base-size (> base-size 0))
+ (completion-try-completion
+ name candidates predicate (length name) md)
+ ;; If the `comps' are 0-based, the result should be
+ ;; the same with `comps'.
+ (completion-try-completion
+ name comps nil (length name) md))))
+ (most (if (consp most-try) (car most-try)
+ (if most-try (car comps) "")))
+ ;; Compare name and most, so we can determine if name is
+ ;; a prefix of most, or something else.
+ (compare (compare-strings name nil nil
+ most nil nil completion-ignore-case))
+ (ellipsis (if (char-displayable-p ?…) "…" "..."))
+ (determ (unless (or (eq t compare) (eq t most-try)
+ (= (setq compare (1- (abs compare)))
+ (length most)))
+ (concat open-bracket
+ (cond
+ ((= compare (length name))
+ ;; Typical case: name is a prefix.
+ (substring most compare))
+ ;; Don't bother truncating if it doesn't gain
+ ;; us at least 2 columns.
+ ((< compare (+ 2 (string-width ellipsis))) most)
+ (t (concat ellipsis (substring most compare))))
+ close-bracket)))
+ ;;"-prospects" - more than one candidate
+ (prospects-len (+ (string-width
+ (or determ (concat open-bracket close-bracket)))
+ (string-width icomplete-separator)
+ (+ 2 (string-width ellipsis)) ;; take {…} into account
+ (string-width (buffer-string))))
+ (prospects-max
+ ;; Max total length to use, including the minibuffer content.
+ (* (+ icomplete-prospects-height
+ ;; If the minibuffer content already uses up more than
+ ;; one line, increase the allowable space accordingly.
+ (/ prospects-len (window-width)))
+ (window-width)))
+ ;; Find the common prefix among `comps'.
+ ;; We can't use the optimization below because its assumptions
+ ;; aren't always true, e.g. when completion-cycling (bug#10850):
+ ;; (if (eq t (compare-strings (car comps) nil (length most)
+ ;; most nil nil completion-ignore-case))
+ ;; ;; Common case.
+ ;; (length most)
+ ;; Else, use try-completion.
+ (prefix (when icomplete-hide-common-prefix
+ (try-completion "" comps)))
+ (prefix-len
+ (and (stringp prefix)
+ ;; Only hide the prefix if the corresponding info
+ ;; is already displayed via `most'.
+ (string-prefix-p prefix most t)
+ (length prefix))) ;;)
+ prospects comp limit)
+ (prog1
+ (if (or (eq most-try t) (and (not icomplete-scroll)
+ (not (consp (cdr comps)))))
+ (concat determ " [Matched]")
+ (when (member name comps)
+ ;; NAME is complete but not unique. This scenario poses
+ ;; following UI issues:
+ ;;
+ ;; - When `icomplete-hide-common-prefix' is non-nil, NAME
+ ;; is stripped empty. This would make the entry
+ ;; inconspicuous.
+ ;;
+ ;; - Due to sorting of completions, NAME may not be the
+ ;; first of the prospects and could be hidden deep in
+ ;; the displayed string.
+ ;;
+ ;; - Because of `icomplete-prospects-height' , NAME may
+ ;; not even be displayed to the user.
+ ;;
+ ;; To circumvent all the above problems, provide a visual
+ ;; cue to the user via an "empty string" in the try
+ ;; completion field.
+ (setq determ (concat open-bracket "" close-bracket)))
+ (while (and comps (not limit))
+ (setq comp
+ (if prefix-len (substring (car comps) prefix-len) (car comps))
+ comps (cdr comps))
+ (setq prospects-len
+ (+ (string-width comp)
+ (string-width icomplete-separator)
+ prospects-len))
+ (if (< prospects-len prospects-max)
+ (push comp prospects)
+ (setq limit t)))
+ (setq prospects (nreverse prospects))
+ ;; Decorate first of the prospects.
+ (when prospects
+ (let ((first (copy-sequence (pop prospects))))
+ (put-text-property 0 (length first)
+ 'face 'icomplete-first-match first)
+ (push first prospects)))
+ (concat determ
+ "{"
+ (mapconcat 'identity prospects icomplete-separator)
+ (concat (and limit (concat icomplete-separator ellipsis))
+ "}")))
+ ;; Restore the base-size info, since completion-all-sorted-completions
+ ;; is cached.
+ (if last (setcdr last base-size))))))))
+
+;;;_* Iswitchb compatibility
;; We moved Iswitchb to `obsolete' in 24.4, but autoloads in files in
;; `obsolete' aren't obeyed (since that would encourage people to keep using
@@ -803,10 +1063,9 @@ matches exist."
;;;###autoload (make-obsolete 'iswitchb-mode
;;;###autoload "use `icomplete-mode' or `ido-mode' instead." "24.4"))
-;;;_* Provide
(provide 'icomplete)
-;;_* Local emacs vars.
+;;;_* Local emacs vars.
;;Local variables:
;;allout-layout: (-2 :)
;;End:
diff --git a/lisp/ido.el b/lisp/ido.el
index 3ed0d952f36..b81a9db5eb9 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1521,6 +1521,10 @@ Removes badly formatted data and ignored directories."
:global t
(remove-function read-file-name-function #'ido-read-file-name)
(remove-function read-buffer-function #'ido-read-buffer)
+ (when (boundp 'ffap-file-finder)
+ (remove-function ffap-file-finder #'ido-find-file)
+ (when ido-mode
+ (add-function :override ffap-file-finder #'ido-find-file)))
(when ido-everywhere
(if (not ido-mode)
(ido-mode 'both)
@@ -1746,7 +1750,7 @@ is enabled then some keybindings are changed in the keymap."
ido-max-file-prompt-width))
(literal (and (boundp 'ido-find-literal) ido-find-literal "(literal) "))
(vc-off (and ido-saved-vc-hb (not vc-handled-backends) "[-VC] "))
- (prefix nil)
+ ;; (prefix nil)
(rule ido-rewrite-file-prompt-rules))
(let ((case-fold-search nil))
(while rule
@@ -1762,11 +1766,11 @@ is enabled then some keybindings are changed in the keymap."
; (if ido-process-ignore-lists "" "&")
(or literal "")
(or vc-off "")
- (or prefix "")
+ ;; (or prefix "")
(let ((l (length dirname)))
(if (and max-width (> max-width 0) (> l max-width))
(let* ((s (substring dirname (- max-width)))
- (i (string-match "/" s)))
+ (i (string-search "/" s)))
(concat "..." (if i (substring s i) s)))
dirname)))))
(t prompt)))
@@ -2512,7 +2516,7 @@ If cursor is not at the end of the user input, move to end of input."
;; Do nothing
)
((and (memq ido-cur-item '(file dir))
- (string-match "[$]" ido-text))
+ (string-search "$" ido-text))
(let ((evar (substitute-in-file-name (concat ido-current-directory ido-text))))
(if (not (file-exists-p (file-name-directory evar)))
(message "Expansion generates non-existing directory name")
@@ -3085,7 +3089,7 @@ If repeated, insert text from buffer instead."
(setq ido-text-init word
ido-try-merged-list nil
ido-exit 'chdir))
- ((string-match "/" word)
+ ((string-search "/" word)
(setq ido-text-init (concat ido-current-directory word)
ido-try-merged-list nil
ido-exit 'chdir))
@@ -4555,7 +4559,7 @@ For details of keybindings, see `ido-find-file'."
(setq try-single-dir-match t))))
((and (string-equal (substring contents -2 -1) "/")
- (not (string-match "[$]" contents)))
+ (not (string-search "$" contents)))
(ido-set-current-directory
(cond
((= (length contents) 2)
@@ -4652,7 +4656,7 @@ For details of keybindings, see `ido-find-file'."
(memq ido-cur-item '(file dir))
(not (ido-is-root-directory))
(> (length contents) 1)
- (not (string-match "[$]" contents))
+ (not (string-search "$" contents))
(not ido-directory-nonreadable)
(not ido-directory-too-big))
(ido-trace "merge?")
diff --git a/lisp/iimage.el b/lisp/iimage.el
index cc1461d7b0f..192530a8e6a 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -1,4 +1,4 @@
-;;; iimage.el --- Inline image minor mode.
+;;; iimage.el --- Inline image minor mode. -*- lexical-binding: t -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -51,8 +51,7 @@
(defcustom iimage-mode-image-search-path nil
"List of directories to search for image files for iimage-mode."
- :type '(choice (const nil) (repeat directory))
- :group 'iimage)
+ :type '(choice (const nil) (repeat directory)))
(defvar iimage-mode-image-filename-regex
(concat "[-+./_0-9a-zA-Z]+\\."
@@ -74,14 +73,12 @@ Examples of image filename patterns to match:
\\=`file://foo.png\\='
\\[\\[foo.gif]]
<foo.png>
- foo.JPG
-"
- :type '(alist :key-type regexp :value-type integer)
- :group 'iimage)
+ foo.JPG"
+ :type '(alist :key-type regexp :value-type integer))
(defvar iimage-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-l" 'iimage-recenter)
+ (define-key map "\C-l" #'iimage-recenter)
map)
"Keymap used in `iimage-mode'.")
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 48f9cd0767c..cf878ae1223 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -67,9 +67,9 @@
;;
;; * For `image-dired-get-exif-data' and `image-dired-set-exif-data' to work,
;; the command line tool `exiftool' is needed. It can be found here:
-;; http://www.sno.phy.queensu.ca/~phil/exiftool/. These two functions
-;; are, among other things, used for writing comments to image files
-;; using `image-dired-thumbnail-set-image-description' and to create
+;; https://exiftool.org/. These two functions are, among other
+;; things, used for writing comments to image files using
+;; `image-dired-thumbnail-set-image-description' and to create
;; "unique" file names using `image-dired-get-exif-file-name' (used by
;; `image-dired-copy-with-exif-file-name').
;;
@@ -164,8 +164,7 @@
(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
"Directory where thumbnail images are stored."
- :type 'directory
- :group 'image-dired)
+ :type 'directory)
(defcustom image-dired-thumbnail-storage 'use-image-dired-dir
"How to store image-dired's thumbnail files.
@@ -181,51 +180,44 @@ that allows sharing of thumbnails across different programs."
(const :tag "Use image-dired-dir" use-image-dired-dir)
(const :tag "Thumbnail Managing Standard (normal 128x128)" standard)
(const :tag "Thumbnail Managing Standard (large 256x256)" standard-large)
- (const :tag "Per-directory" per-directory))
- :group 'image-dired)
+ (const :tag "Per-directory" per-directory)))
(defcustom image-dired-db-file
(expand-file-name ".image-dired_db" image-dired-dir)
"Database file where file names and their associated tags are stored."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-temp-image-file
(expand-file-name ".image-dired_temp" image-dired-dir)
"Name of temporary image file used by various commands."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-gallery-dir
(expand-file-name ".image-dired_gallery" image-dired-dir)
"Directory to store generated gallery html pages.
This path needs to be \"shared\" to the public so that it can access
the index.html page that image-dired creates."
- :type 'directory
- :group 'image-dired)
+ :type 'directory)
(defcustom image-dired-gallery-image-root-url
"https://your.own.server/image-diredpics"
"URL where the full size images are to be found.
Note that this path has to be configured in your web server. Image-Dired
expects to find pictures in this directory."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-gallery-thumb-image-root-url
"https://your.own.server/image-diredthumbs"
"URL where the thumbnail images are to be found.
Note that this path has to be configured in your web server. Image-Dired
expects to find pictures in this directory."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-cmd-create-thumbnail-program
"convert"
"Executable used to create thumbnail.
Used together with `image-dired-cmd-create-thumbnail-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-create-thumbnail-options
'("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
@@ -236,14 +228,12 @@ Available format specifiers are: %w which is replaced by
%f which is replaced by the file name of the original image and %t
which is replaced by the file name of the thumbnail file."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-create-temp-image-program "convert"
"Executable used to create temporary image.
Used together with `image-dired-cmd-create-temp-image-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-create-temp-image-options
'("-size" "%wx%h" "%f[0]" "-resize" "%wx%h>" "-strip" "jpeg:%t")
@@ -254,8 +244,7 @@ the calculated max size for width and height in the image display window,
%f which is replaced by the file name of the original image and %t which
is replaced by the file name of the temporary file."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-pngnq-program
(or (executable-find "pngnq")
@@ -264,8 +253,7 @@ is replaced by the file name of the temporary file."
It quantizes colors of PNG images down to 256 colors or fewer
using the NeuQuant algorithm."
:version "26.1"
- :type '(choice (const :tag "Not Set" nil) file)
- :group 'image-dired)
+ :type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-pngnq-options
'("-f" "%t")
@@ -273,15 +261,13 @@ using the NeuQuant algorithm."
Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options'."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
"The file name of the `pngcrush' program.
It optimizes the compression of PNG images. Also it adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
- :type '(choice (const :tag "Not Set" nil) file)
- :group 'image-dired)
+ :type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-pngcrush-options
`("-q"
@@ -299,14 +285,12 @@ Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options', with %q for a
temporary file name (typically generated by pnqnq)."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
"The file name of the `optipng' program."
:version "26.1"
- :type '(choice (const :tag "Not Set" nil) file)
- :group 'image-dired)
+ :type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
"Arguments passed to `image-dired-cmd-optipng-program'.
@@ -314,8 +298,7 @@ Available format specifiers are described in
`image-dired-cmd-create-thumbnail-options'."
:version "26.1"
:type '(repeat (string :tag "Argument"))
- :link '(url-link "man:optipng(1)")
- :group 'image-dired)
+ :link '(url-link "man:optipng(1)"))
(defcustom image-dired-cmd-create-standard-thumbnail-options
(append '("-size" "%wx%h" "%f[0]")
@@ -331,15 +314,13 @@ Available format specifiers are described in
Available format specifiers are the same as in
`image-dired-cmd-create-thumbnail-options', with %m for file modification time."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-rotate-thumbnail-program
"mogrify"
"Executable used to rotate thumbnail.
Used together with `image-dired-cmd-rotate-thumbnail-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-rotate-thumbnail-options
'("-rotate" "%d" "%t")
@@ -350,15 +331,13 @@ number of (positive) degrees to rotate the image, normally 90 or 270
\(for 90 degrees right and left), %t which is replaced by the file name
of the thumbnail file."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-rotate-original-program
"jpegtran"
"Executable used to rotate original image.
Used together with `image-dired-cmd-rotate-original-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-rotate-original-options
'("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
@@ -370,28 +349,24 @@ number of (positive) degrees to rotate the image, normally 90 or
original image file name and %t which is replaced by
`image-dired-temp-image-file'."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-temp-rotate-image-file
(expand-file-name ".image-dired_rotate_temp" image-dired-dir)
"Temporary file for rotate operations."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-rotate-original-ask-before-overwrite t
"Confirm overwrite of original file after rotate operation.
If non-nil, ask user for confirmation before overwriting the
original file with `image-dired-temp-rotate-image-file'."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-cmd-write-exif-data-program
"exiftool"
"Program used to write EXIF data to image.
Used together with `image-dired-cmd-write-exif-data-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-write-exif-data-options
'("-%t=%v" "%f")
@@ -401,15 +376,13 @@ Available format specifiers are: %f which is replaced by
the image file name, %t which is replaced by the tag name and %v
which is replaced by the tag value."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-read-exif-data-program
"exiftool"
"Program used to read EXIF data to image.
Used together with `image-dired-cmd-read-exif-data-options'."
- :type 'file
- :group 'image-dired)
+ :type 'file)
(defcustom image-dired-cmd-read-exif-data-options
'("-s" "-s" "-s" "-%t" "%f")
@@ -418,15 +391,13 @@ Used with `image-dired-cmd-read-exif-data-program'.
Available format specifiers are: %f which is replaced
by the image file name and %t which is replaced by the tag name."
:version "26.1"
- :type '(repeat (string :tag "Argument"))
- :group 'image-dired)
+ :type '(repeat (string :tag "Argument")))
(defcustom image-dired-gallery-hidden-tags
(list "private" "hidden" "pending")
"List of \"hidden\" tags.
Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
- :type '(repeat string)
- :group 'image-dired)
+ :type '(repeat string))
(defcustom image-dired-thumb-size
(cond
@@ -436,29 +407,37 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
"Size of thumbnails, in pixels.
This is the default size for both `image-dired-thumb-width'
and `image-dired-thumb-height'."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-width image-dired-thumb-size
"Width of thumbnails, in pixels."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-height image-dired-thumb-size
"Height of thumbnails, in pixels."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-relief 2
"Size of button-like border around thumbnails."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-thumb-margin 2
"Size of the margin around thumbnails.
This is where you see the cursor."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
+
+(defcustom image-dired-thumb-visible-marks t
+ "Make marks visible in thumbnail buffer.
+If non-nil, apply the `image-dired-thumb-mark' face to marked
+images."
+ :type 'boolean
+ :version "28.1")
+
+(defface image-dired-thumb-mark
+ '((t (:background "orange")))
+ "Background-color for marked images in thumbnail buffer."
+ :group 'image-dired
+ :version "28.1")
(defcustom image-dired-line-up-method 'dynamic
"Default method for line-up of thumbnails in thumbnail buffer.
@@ -471,34 +450,29 @@ and No line-up means that no automatic line-up will be done."
(const :tag "Dynamic" dynamic)
(const :tag "Fixed" fixed)
(const :tag "Interactive" interactive)
- (const :tag "No line-up" none))
- :group 'image-dired)
+ (const :tag "No line-up" none)))
(defcustom image-dired-thumbs-per-row 3
"Number of thumbnails to display per row in thumb buffer."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-display-window-width-correction 1
"Number to be used to correct image display window width.
Change if the default (1) does not work (i.e. if the image does not
completely fit)."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-display-window-height-correction 0
"Number to be used to correct image display window height.
Change if the default (0) does not work (i.e. if the image does not
completely fit)."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defcustom image-dired-track-movement t
"The current state of the tracking and mirroring.
For more information, see the documentation for
`image-dired-toggle-movement-tracking'."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-append-when-browsing nil
"Append thumbnails in thumbnail buffer when browsing.
@@ -508,8 +482,7 @@ images in the thumbnail buffer. If you enable this and want to clean
the thumbnail buffer because it is filled with too many thumbnails,
just call `image-dired-display-thumb' to display only the image at point.
This value can be toggled using `image-dired-toggle-append-browsing'."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-dired-disp-props t
"If non-nil, display properties for dired file when browsing.
@@ -517,16 +490,14 @@ Used by `image-dired-next-line-and-display',
`image-dired-previous-line-and-display' and `image-dired-mark-and-display-next'.
If the database file is large, this can slow down image browsing in
dired and you might want to turn it off."
- :type 'boolean
- :group 'image-dired)
+ :type 'boolean)
(defcustom image-dired-display-properties-format "%b: %f (%t): %c"
"Display format for thumbnail properties.
%b is replaced with associated dired buffer name, %f with file name
\(without path) of original image file, %t with the list of tags and %c
with the comment."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-external-viewer
;; TODO: Use mailcap, dired-guess-shell-alist-default,
@@ -539,20 +510,17 @@ Including parameters. Used when displaying original image from
`image-dired-thumbnail-mode'."
:version "27.1"
:type '(choice string
- (const :tag "Not Set" nil))
- :group 'image-dired)
+ (const :tag "Not Set" nil)))
(defcustom image-dired-main-image-directory "~/pics/"
"Name of main image directory, if any.
Used by `image-dired-copy-with-exif-file-name'."
- :type 'string
- :group 'image-dired)
+ :type 'string)
(defcustom image-dired-show-all-from-dir-max-files 50
"Maximum number of files to show using `image-dired-show-all-from-dir'
before warning the user."
- :type 'integer
- :group 'image-dired)
+ :type 'integer)
(defmacro image-dired--with-db-file (&rest body)
"Run BODY in a temp buffer containing `image-dired-db-file'.
@@ -684,6 +652,8 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).")
"Maximum number of concurrent jobs permitted for generating images.
Increase at own risk.")
+(defvar image-dired-tag-history nil "Variable holding the tag history.")
+
(defun image-dired-pngnq-thumb (spec)
"Quantize thumbnail described by format SPEC with pngnq(1)."
(let ((process
@@ -704,7 +674,7 @@ Increase at own risk.")
(thumb (cdr (assq ?t spec))))
(rename-file nq8 thumb t)))
(message "command %S %s" (process-command process)
- (replace-regexp-in-string "\n" "" status)))))
+ (string-replace "\n" "" status)))))
process))
(defun image-dired-pngcrush-thumb (spec)
@@ -726,7 +696,7 @@ Increase at own risk.")
(unless (and (eq (process-status process) 'exit)
(zerop (process-exit-status process)))
(message "command %S %s" (process-command process)
- (replace-regexp-in-string "\n" "" status)))
+ (string-replace "\n" "" status)))
(when (memq (process-status process) '(exit signal))
(let ((temp (cdr (assq ?q spec))))
(delete-file temp)))))
@@ -744,7 +714,7 @@ Increase at own risk.")
(unless (and (eq (process-status process) 'exit)
(zerop (process-exit-status process)))
(message "command %S %s" (process-command process)
- (replace-regexp-in-string "\n" "" status)))))
+ (string-replace "\n" "" status)))))
process))
(defun image-dired-create-thumb-1 (original-file thumbnail-file)
@@ -794,7 +764,7 @@ Increase at own risk.")
(zerop (process-exit-status process))))
(message "Thumb could not be created for %s: %s"
(abbreviate-file-name original-file)
- (replace-regexp-in-string "\n" "" status))
+ (string-replace "\n" "" status))
(set-file-modes thumbnail-file #o600)
(clear-image-cache thumbnail-file)
;; PNG thumbnail has been created since we are
@@ -829,6 +799,22 @@ Queued items live in `image-dired-queue'."
(list (list original-file thumbnail-file))))
(run-at-time 0 nil #'image-dired-thumb-queue-run))
+(defmacro image-dired--with-marked (&rest body)
+ "Eval BODY with point on each marked thumbnail.
+If no marked file could be found, execute BODY on the current
+thumbnail."
+ `(with-current-buffer image-dired-thumbnail-buffer
+ (let (found)
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (image-dired-thumb-file-marked-p)
+ (setq found t)
+ ,@body)
+ (forward-char)))
+ (unless found
+ ,@body))))
+
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
"Toggle thumbnails in front of file names in the dired buffer.
@@ -992,6 +978,19 @@ Restore any changes to the window configuration made by calling
(set-window-configuration image-dired-saved-window-configuration)
(message "No saved window configuration")))
+(defun image-dired--line-up-with-method ()
+ "Line up thumbnails according to `image-dired-line-up-method'."
+ (cond ((eq 'dynamic image-dired-line-up-method)
+ (image-dired-line-up-dynamic))
+ ((eq 'fixed image-dired-line-up-method)
+ (image-dired-line-up))
+ ((eq 'interactive image-dired-line-up-method)
+ (image-dired-line-up-interactive))
+ ((eq 'none image-dired-line-up-method)
+ nil)
+ (t
+ (image-dired-line-up-dynamic))))
+
;;;###autoload
(defun image-dired-display-thumbs (&optional arg append do-not-pop)
"Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'.
@@ -1033,16 +1032,7 @@ thumbnail buffer to be selected."
(if do-not-pop
(display-buffer buf)
(pop-to-buffer buf))
- (cond ((eq 'dynamic image-dired-line-up-method)
- (image-dired-line-up-dynamic))
- ((eq 'fixed image-dired-line-up-method)
- (image-dired-line-up))
- ((eq 'interactive image-dired-line-up-method)
- (image-dired-line-up-interactive))
- ((eq 'none image-dired-line-up-method)
- nil)
- (t
- (image-dired-line-up-dynamic))))))
+ (image-dired--line-up-with-method))))
;;;###autoload
(defun image-dired-show-all-from-dir (dir)
@@ -1108,7 +1098,7 @@ FILE-TAGS is an alist in the following form:
(end-of-line)
(insert (format ";%s" tag))))
(goto-char (point-max))
- (insert (format "\n%s;%s" file tag))))
+ (insert (format "%s;%s\n" file tag))))
(save-buffer))))
(defun image-dired-remove-tag (files tag)
@@ -1123,11 +1113,12 @@ FILE-TAGS is an alist in the following form:
(error "Files must be a string or a list of strings!")))
(dolist (file files)
(goto-char (point-min))
- (when (search-forward-regexp (format "^%s" file) nil t)
+ (when (search-forward-regexp (format "^%s;" file) nil t)
(end-of-line)
(setq end (point))
(beginning-of-line)
- (when (search-forward-regexp (format "\\(;%s\\)" tag) end t)
+ (when (search-forward-regexp
+ (format "\\(;%s\\)\\($\\|;\\)" tag) end t)
(delete-region (match-beginning 1) (match-end 1))
;; Check if file should still be in the database. If
;; it has no tags or comments, it will be removed.
@@ -1135,11 +1126,7 @@ FILE-TAGS is an alist in the following form:
(setq end (point))
(beginning-of-line)
(when (not (search-forward ";" end t))
- (kill-line 1)
- ;; If on empty line at end of buffer
- (and (eobp)
- (looking-at "^$")
- (delete-char -1)))))))
+ (kill-line 1))))))
(save-buffer)))
(defun image-dired-list-tags (file)
@@ -1162,7 +1149,9 @@ FILE-TAGS is an alist in the following form:
(defun image-dired-tag-files (arg)
"Tag marked file(s) in dired. With prefix ARG, tag file at point."
(interactive "P")
- (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history))
files)
(if arg
(setq files (list (dired-get-filename)))
@@ -1174,19 +1163,24 @@ FILE-TAGS is an alist in the following form:
files))))
(defun image-dired-tag-thumbnail ()
- "Tag current thumbnail."
+ "Tag current or marked thumbnails."
(interactive)
- (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
- (image-dired-write-tags (list (cons (image-dired-original-file-name) tag))))
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))
+ (let ((tag (completing-read
+ "Tags to add (separate tags with a semicolon): "
+ image-dired-tag-history nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-write-tags
+ (list (cons (image-dired-original-file-name) tag)))
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
;;;###autoload
(defun image-dired-delete-tag (arg)
"Remove tag for selected file(s).
With prefix argument ARG, remove tag from file at point."
(interactive "P")
- (let ((tag (read-string "Tag to remove: "))
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history))
files)
(if arg
(setq files (list (dired-get-filename)))
@@ -1194,12 +1188,14 @@ With prefix argument ARG, remove tag from file at point."
(image-dired-remove-tag files tag)))
(defun image-dired-tag-thumbnail-remove ()
- "Remove tag from thumbnail."
+ "Remove tag from current or marked thumbnails."
(interactive)
- (let ((tag (read-string "Tag to remove: ")))
- (image-dired-remove-tag (image-dired-original-file-name) tag))
- (image-dired-update-property
- 'tags (image-dired-list-tags (image-dired-original-file-name))))
+ (let ((tag (completing-read "Tag to remove: " image-dired-tag-history
+ nil nil nil 'image-dired-tag-history)))
+ (image-dired--with-marked
+ (image-dired-remove-tag (image-dired-original-file-name) tag)
+ (image-dired-update-property
+ 'tags (image-dired-list-tags (image-dired-original-file-name))))))
(defun image-dired-original-file-name ()
"Get original file name for thumbnail or display image at point."
@@ -1404,14 +1400,15 @@ dired."
(message "No image, or image with correct properties, at point.")
(with-current-buffer dired-buf
(message "%s" file-name)
- (if (dired-goto-file file-name)
- (cond ((eq command 'mark) (dired-mark 1))
- ((eq command 'unmark) (dired-unmark 1))
- ((eq command 'toggle)
- (if (image-dired-dired-file-marked-p)
- (dired-unmark 1)
- (dired-mark 1)))
- ((eq command 'flag) (dired-flag-file-deletion 1))))))))
+ (when (dired-goto-file file-name)
+ (cond ((eq command 'mark) (dired-mark 1))
+ ((eq command 'unmark) (dired-unmark 1))
+ ((eq command 'toggle)
+ (if (image-dired-dired-file-marked-p)
+ (dired-unmark 1)
+ (dired-mark 1)))
+ ((eq command 'flag) (dired-flag-file-deletion 1)))
+ (image-dired-thumb-update-marks))))))
(defun image-dired-mark-thumb-original-file ()
"Mark original image file in associated dired buffer."
@@ -1538,8 +1535,10 @@ You probably want to use this together with
'("Image-Dired"
["Quit" quit-window]
["Delete thumbnail from buffer" image-dired-delete-char]
- ["Remove tag from thumbnail" image-dired-tag-thumbnail-remove]
- ["Tag thumbnail" image-dired-tag-thumbnail]
+ ["Delete marked images" image-dired-delete-marked]
+ ["Remove tag from current or marked thumbnails"
+ image-dired-tag-thumbnail-remove]
+ ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
["Comment thumbnail" image-dired-comment-thumbnail]
["Refresh thumb" image-dired-refresh-thumb]
["Dynamic line up" image-dired-line-up-dynamic]
@@ -1623,7 +1622,6 @@ You probably want to use this together with
special-mode "image-dired-thumbnail"
"Browse and manipulate thumbnail images using dired.
Use `image-dired-minor-mode' to get a nice setup."
- :group 'image-dired
(buffer-disable-undo)
(add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t))
@@ -1631,7 +1629,6 @@ Use `image-dired-minor-mode' to get a nice setup."
special-mode "image-dired-image-display"
"Mode for displaying and manipulating original image.
Resized or in full-size."
- :group 'image-dired
(buffer-disable-undo)
(image-mode-setup-winprops)
(setq cursor-type nil)
@@ -2193,7 +2190,7 @@ FILE-COMMENTS is an alist on the following form:
(insert (format "comment:%s;" comment)))
;; File does not exist in database - add it.
(goto-char (point-max))
- (insert (format "\n%s;comment:%s" file comment))))
+ (insert (format "%s;comment:%s\n" file comment))))
(save-buffer))))
(defun image-dired-update-property (prop value)
@@ -2311,16 +2308,67 @@ non-nil."
(image-dired-track-original-file))
(image-dired-display-thumb-properties))
+(defun image-dired-thumb-file-marked-p ()
+ "Check if file is marked in associated dired buffer."
+ (let ((file-name (image-dired-original-file-name))
+ (dired-buf (image-dired-associated-dired-buffer)))
+ (when (and dired-buf file-name)
+ (with-current-buffer dired-buf
+ (when (dired-goto-file file-name)
+ (image-dired-dired-file-marked-p))))))
+
+(defun image-dired-delete-marked ()
+ "Delete current or marked thumbnails and associated images."
+ (interactive)
+ (with-current-buffer (image-dired-associated-dired-buffer)
+ (dired-do-delete))
+ (image-dired--with-marked
+ (image-dired-delete-char)
+ (backward-char))
+ (image-dired--line-up-with-method))
+
+(defun image-dired-thumb-update-marks ()
+ "Update the marks in the thumbnail buffer."
+ (when image-dired-thumb-visible-marks
+ (with-current-buffer image-dired-thumbnail-buffer
+ (save-mark-and-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (while (not (eobp))
+ (with-silent-modifications
+ (if (image-dired-thumb-file-marked-p)
+ (add-face-text-property (point) (1+ (point))
+ 'image-dired-thumb-mark)
+ (remove-text-properties (point) (1+ (point))
+ '(face image-dired-thumb-mark))))
+ (forward-char)))))))
+
+(defun image-dired-mouse-toggle-mark-1 ()
+ "Toggle dired mark for current thumbnail.
+Track this in associated dired buffer if `image-dired-track-movement' is
+non-nil."
+ (when image-dired-track-movement
+ (image-dired-track-original-file))
+ (image-dired-toggle-mark-thumb-original-file))
+
(defun image-dired-mouse-toggle-mark (event)
"Use mouse EVENT to toggle dired mark for thumbnail.
+Toggle marks of all thumbnails in region, if it's active.
Track this in associated dired buffer if `image-dired-track-movement' is
non-nil."
(interactive "e")
- (mouse-set-point event)
- (goto-char (posn-point (event-end event)))
- (if image-dired-track-movement
- (image-dired-track-original-file))
- (image-dired-toggle-mark-thumb-original-file))
+ (if (use-region-p)
+ (let ((end (region-end)))
+ (save-excursion
+ (goto-char (region-beginning))
+ (while (<= (point) end)
+ (when (image-dired-image-at-point-p)
+ (image-dired-mouse-toggle-mark-1))
+ (forward-char))))
+ (mouse-set-point event)
+ (goto-char (posn-point (event-end event)))
+ (image-dired-mouse-toggle-mark-1))
+ (image-dired-thumb-update-marks))
(defun image-dired-dired-display-properties ()
"Display properties for dired file in the echo area."
@@ -2553,7 +2601,6 @@ easy-to-use form."
(let ((files (dired-get-marked-files)))
(pop-to-buffer-same-window "*Image-Dired Edit Meta Data*")
(kill-all-local-variables)
- (make-local-variable 'widget-example-repeat)
(let ((inhibit-read-only t))
(erase-buffer))
(remove-overlays)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 9ed295e2aa1..69ef7015cce 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -95,6 +95,9 @@ Its value should be one of the following:
(defvar-local image-transform-rotation 0.0
"Rotation angle for the image in the current Image mode buffer.")
+(defvar-local image--transform-smoothing nil
+ "Whether to use transform smoothing.")
+
(defvar image-transform-right-angle-fudge 0.0001
"Snap distance to a multiple of a right angle.
There's no deep theory behind the default value, it should just
@@ -457,6 +460,7 @@ call."
(define-key map "sb" 'image-transform-fit-both)
(define-key map "ss" 'image-transform-set-scale)
(define-key map "sr" 'image-transform-set-rotation)
+ (define-key map "sm" 'image-transform-set-smoothing)
(define-key map "so" 'image-transform-original)
(define-key map "s0" 'image-transform-reset)
@@ -523,6 +527,8 @@ call."
:help "Rotate the image"]
["Set Rotation..." image-transform-set-rotation
:help "Set rotation angle of the image"]
+ ["Set Smoothing..." image-transform-set-smoothing
+ :help "Toggle smoothing"]
["Original Size" image-transform-original
:help "Reset image to actual size"]
["Reset to Default Size" image-transform-reset
@@ -707,8 +713,7 @@ Key bindings:
Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display],
to switch back to `image-mode' and display an image file as the
actual image."
- nil (:eval (if image-type (format " Image[%s]" image-type) " Image"))
- image-minor-mode-map
+ :lighter (:eval (if image-type (format " Image[%s]" image-type) " Image"))
:group 'image
:version "22.1"
(if image-minor-mode
@@ -726,8 +731,9 @@ displays an image file as text."
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
(image-minor-mode 1)
- ;; Show the image file as text.
- (image-toggle-display-text)))
+ (unless (image-get-display-property)
+ ;; Show the image file as text.
+ (image-toggle-display-text))))
(defun image-mode-as-hex ()
"Set a non-image mode as major mode in combination with image minor mode.
@@ -858,7 +864,9 @@ was inserted."
(setq image-transform-rotation
(or (exif-orientation
(ignore-error exif-error
- (exif-parse-buffer)))
+ ;; exif-parse-buffer can move point, so preserve it.
+ (save-excursion
+ (exif-parse-buffer))))
0.0)))
;; Swap width and height when changing orientation
;; between portrait and landscape.
@@ -985,7 +993,13 @@ Otherwise, display the image by calling `image-mode'."
(edges (window-inside-pixel-edges window))
(window-width (- (nth 2 edges) (nth 0 edges)))
(window-height (- (nth 3 edges) (nth 1 edges))))
+ ;; If the size has been changed manually (with `+'/`-'),
+ ;; then :max-width/:max-height is nil. In that case, do
+ ;; no automatic resizing.
(when (and image-width image-height
+ ;; Don't do resizing if we have a manual
+ ;; rotation (from the `r' command), either.
+ (not (plist-get (cdr spec) :rotation))
(or (not (= image-width window-width))
(not (= image-height window-height))))
(unless image-fit-to-window-lock
@@ -1130,8 +1144,8 @@ replacing the current Image mode buffer."
(funcall next))))
(defun image-mode--directory-buffers (file)
- "Return a alist of type/buffer for all \"parent\" buffers to image FILE.
-This is normally a list of dired buffers, but can also be archive and
+ "Return an alist of type/buffer for all \"parent\" buffers to image FILE.
+This is normally a list of Dired buffers, but can also be archive and
tar mode buffers."
(let ((buffers nil)
(dir (file-name-directory file)))
@@ -1466,7 +1480,10 @@ return value is suitable for appending to an image spec."
,@(when (cdr resized)
(list :height (cdr resized)))
,@(unless (= 0.0 image-transform-rotation)
- (list :rotation image-transform-rotation))))))
+ (list :rotation image-transform-rotation))
+ ,@(when image--transform-smoothing
+ (list :transform-smoothing
+ (string= image--transform-smoothing "smooth")))))))
(defun image-transform-set-scale (scale)
"Prompt for a number, and resize the current image by that amount."
@@ -1499,6 +1516,12 @@ ROTATION should be in degrees."
(setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
+(defun image-transform-set-smoothing (smoothing)
+ (interactive (list (completing-read "Smoothing: "
+ '("none" "smooth") nil t)))
+ (setq image--transform-smoothing smoothing)
+ (image-toggle-display-image))
+
(defun image-transform-original ()
"Display the current image with the original (actual) size and rotation."
(interactive)
@@ -1511,7 +1534,8 @@ ROTATION should be in degrees."
(interactive)
(setq image-transform-resize image-auto-resize
image-transform-rotation 0.0
- image-transform-scale 1)
+ image-transform-scale 1
+ image--transform-smoothing nil)
(image-toggle-display-image))
(provide 'image-mode)
diff --git a/lisp/image.el b/lisp/image.el
index 6955a90de77..494c26a8a33 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -141,6 +141,18 @@ based on the font pixel size."
(const :tag "Automatically compute" auto))
:version "26.1")
+(defcustom image-transform-smoothing #'image--default-smoothing
+ "Whether to do smoothing when applying transforms to images.
+Common transforms are rescaling and rotation.
+
+Valid values are nil (no smoothing), t (smoothing) or a predicate
+function that is called with the image specification and should return
+either nil or non-nil."
+ :type '(choice (const :tag "Do smoothing" t)
+ (const :tag "No smoothing" nil)
+ function)
+ :version "28.1")
+
(defcustom image-use-external-converter nil
"If non-nil, `create-image' will use external converters for exotic formats.
Emacs handles most of the common image formats (SVG, JPEG, PNG, GIF
@@ -485,11 +497,40 @@ Image file names that are not absolute are searched for in the
type 'png
data-p t)))
(when (image-type-available-p type)
- (append (list 'image :type type (if data-p :data :file) file-or-data)
- (and (not (plist-get props :scale))
- (list :scale
- (image-compute-scaling-factor image-scaling-factor)))
- props)))
+ (let ((image
+ (append (list 'image :type type (if data-p :data :file)
+ file-or-data)
+ (and (not (plist-get props :scale))
+ ;; Add default scaling.
+ (list :scale
+ (image-compute-scaling-factor
+ image-scaling-factor)))
+ props)))
+ ;; Add default smoothing.
+ (unless (plist-member props :transform-smoothing)
+ (setq image (nconc image
+ (list :transform-smoothing
+ (pcase image-transform-smoothing
+ ('t t)
+ ('nil nil)
+ (func (funcall func image)))))))
+ image)))
+
+(defun image--default-smoothing (image)
+ "Say whether IMAGE should be smoothed when transformed."
+ (let* ((props (nthcdr 5 image))
+ (scaling (plist-get props :scale))
+ (rotation (plist-get props :rotation)))
+ (cond
+ ;; We always smooth when scaling down and small upwards scaling.
+ ((and scaling (< scaling 2))
+ t)
+ ;; Smooth when doing non-90-degree rotation
+ ((and rotation
+ (or (not (zerop (mod rotation 1)))
+ (not (zerop (% (truncate rotation) 90)))))
+ t)
+ (t nil))))
(defun image--set-property (image property value)
"Set PROPERTY in IMAGE to VALUE.
@@ -562,12 +603,16 @@ means display it in the right marginal area."
(defun insert-image (image &optional string area slice)
"Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
-with a `display' property whose value is the image. STRING
-defaults to a single space if you omit it.
+with a `display' property whose value is the image.
+
+STRING defaults to a single space if you omit it, which means
+that the inserted image will behave as whitespace syntactically.
+
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
means display it in the right marginal area.
+
SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
specifying the X and Y positions and WIDTH and HEIGHT of image area
@@ -794,6 +839,9 @@ number, play until that number of seconds has elapsed."
(cancel-timer timer))
(plist-put (cdr image) :animate-buffer (current-buffer))
(plist-put (cdr image) :animate-tardiness 0)
+ ;; Stash the data about the animation here so that we don't
+ ;; trigger image recomputation unnecessarily later.
+ (plist-put (cdr image) :animate-multi-frame-data animation)
(run-with-timer 0.2 nil #'image-animate-timeout
image (or index 0) (car animation)
0 limit (+ (float-time) 0.2)))))
@@ -824,9 +872,10 @@ Frames are indexed from 0. Optional argument NOCHECK non-nil means
do not check N is within the range of frames present in the image."
(unless nocheck
(if (< n 0) (setq n 0)
- (setq n (min n (1- (car (image-multi-frame-p image)))))))
+ (setq n (min n (1- (car (plist-get (cdr image)
+ :animate-multi-frame-data)))))))
(plist-put (cdr image) :index n)
- (force-window-update))
+ (force-window-update (plist-get (cdr image) :animate-buffer)))
(defun image-animate-get-speed (image)
"Return the speed factor for animating IMAGE."
@@ -872,11 +921,11 @@ for the animation speed. A negative value means to animate in reverse."
(image-show-frame image n t)
(let* ((speed (image-animate-get-speed image))
(time (current-time))
- (animation (image-multi-frame-p image))
(time-to-load-image (time-since time))
- (stated-delay-time (/ (or (cdr animation)
- image-default-frame-delay)
- (float (abs speed))))
+ (stated-delay-time
+ (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data))
+ image-default-frame-delay)
+ (float (abs speed))))
;; Subtract off the time we took to load the image from the
;; stated delay time.
(delay (max (float-time (time-subtract stated-delay-time
@@ -1089,6 +1138,7 @@ default is 20%."
image))
(defun image--get-imagemagick-and-warn (&optional position)
+ (declare-function image-transforms-p "image.c" (&optional frame))
(unless (or (fboundp 'imagemagick-types) (image-transforms-p))
(error "Cannot rescale images on this terminal"))
(let ((image (image--get-image position)))
@@ -1141,7 +1191,9 @@ rotations by only multiples of 90 degrees."
360)))))
(defun image-save ()
- "Save the image under point."
+ "Save the image under point.
+This writes the original image data to a file. Rotating or
+changing the displayed image size does not affect the saved image."
(interactive)
(let ((image (image--get-image)))
(with-temp-buffer
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 2dc9419b817..c2cf2346408 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -118,8 +118,9 @@ If the data is invalid, an `exif-error' is signaled."
dest))
(when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
(exif--parse-exif-chunk app1))))
- (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
- (exif--parse-exif-chunk app1)))))
+ (save-excursion
+ (when-let ((app1 (cdr (assq #xffe1 (exif--parse-jpeg)))))
+ (exif--parse-exif-chunk app1))))))
(defun exif-orientation (exif)
"Return the orientation (in degrees) in EXIF.
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index e47f1f76e42..75d2e6692c0 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -78,7 +78,7 @@ is a string, it should be a MIME format string like
(string-match image-converter-regexp source))
(and data-p
(symbolp data-p)
- (string-match "/" (symbol-name data-p))
+ (string-search "/" (symbol-name data-p))
(string-match
image-converter-regexp
(concat "foo." (image-converter--mime-type data-p)))))
@@ -133,7 +133,7 @@ data is returned as a string."
(list value)
value)))
-(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
+(cl-defmethod image-converter--probe ((type (eql 'graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -151,7 +151,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
-(cl-defmethod image-converter--probe ((type (eql imagemagick)))
+(cl-defmethod image-converter--probe ((type (eql 'imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -171,7 +171,7 @@ data is returned as a string."
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
-(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
+(cl-defmethod image-converter--probe ((type (eql 'ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
@@ -212,12 +212,12 @@ Only suffixes that map to `image-mode' are returned."
'image-mode)
collect suffix))
-(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
-(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
+(cl-defmethod image-converter--convert ((type (eql 'imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
@@ -249,7 +249,7 @@ Only suffixes that map to `image-mode' are returned."
;; error message.
(buffer-string))))
-(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
+(cl-defmethod image-converter--convert ((type (eql 'ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 2a557e04536..2024bb1e066 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -36,14 +36,6 @@
;; A mode-specific function is called to generate the index. It is
;; then presented to the user, who can choose from this index.
-;;
-;; The package comes with a set of example functions for how to
-;; utilize this package.
-
-;; There are *examples* for index gathering functions/regular
-;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to
-;; customize for other modes. A function for jumping to the chosen
-;; index position is also supplied.
;;; History:
;; Thanks go to
@@ -81,25 +73,20 @@ Setting this to nil makes Imenu work a little faster but editing the
buffer will make the generated index positions wrong.
This might not yet be honored by all index-building functions."
- :type 'boolean
- :group 'imenu)
-
+ :type 'boolean)
(defcustom imenu-max-item-length 60
"If a number, truncate Imenu entries to that length."
:type '(choice integer
- (const :tag "Unlimited"))
- :group 'imenu)
+ (const :tag "Unlimited")))
(defcustom imenu-auto-rescan nil
"Non-nil means Imenu should always rescan the buffers."
- :type 'boolean
- :group 'imenu)
+ :type 'boolean)
(defcustom imenu-auto-rescan-maxout 600000
"Imenu auto-rescan is disabled in buffers larger than this size (in bytes)."
:type 'integer
- :group 'imenu
:version "26.2")
(defcustom imenu-use-popup-menu 'on-mouse
@@ -109,13 +96,11 @@ If t, always use a popup menu,
If `on-mouse' use a popup menu when `imenu' was invoked with the mouse."
:type '(choice (const :tag "On Mouse" on-mouse)
(const :tag "Never" nil)
- (other :tag "Always" t))
- :group 'imenu)
+ (other :tag "Always" t)))
(defcustom imenu-eager-completion-buffer t
"If non-nil, eagerly popup the completion buffer."
:type 'boolean
- :group 'imenu
:version "22.1")
(defcustom imenu-after-jump-hook nil
@@ -123,8 +108,7 @@ If `on-mouse' use a popup menu when `imenu' was invoked with the mouse."
Useful things to use here include `reposition-window', `recenter', and
\(lambda () (recenter 0)) to show at top of screen."
- :type 'hook
- :group 'imenu)
+ :type 'hook)
;;;###autoload
(defcustom imenu-sort-function nil
@@ -143,39 +127,23 @@ element should come before the second. The arguments are cons cells;
\(NAME . POSITION). Look at `imenu--sort-by-name' for an example."
:type '(choice (const :tag "No sorting" nil)
(const :tag "Sort by name" imenu--sort-by-name)
- (function :tag "Another function"))
- :group 'imenu)
+ (function :tag "Another function")))
(defcustom imenu-max-items 25
"Maximum number of elements in a mouse menu for Imenu."
- :type 'integer
- :group 'imenu)
-
-;; No longer used. KFS 2004-10-27
-;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)"
-;; "Progress message during the index scanning of the buffer.
-;; If non-nil, user gets a message during the scanning of the buffer.
-;;
-;; Relevant only if the mode-specific function that creates the buffer
-;; index use `imenu-progress-message', and not useful if that is fast, in
-;; which case you might as well set this to nil."
-;; :type '(choice string
-;; (const :tag "None" nil))
-;; :group 'imenu)
+ :type 'integer)
(defcustom imenu-space-replacement "."
"The replacement string for spaces in index names.
Used when presenting the index in a completion buffer to make the
names work as tokens."
- :type '(choice string (const nil))
- :group 'imenu)
+ :type '(choice string (const nil)))
(defcustom imenu-level-separator ":"
"The separator between index names of different levels.
Used for making mouse-menu titles and for flattening nested indexes
with name concatenation."
- :type 'string
- :group 'imenu)
+ :type 'string)
(defcustom imenu-generic-skip-comments-and-strings t
"When non-nil, ignore text inside comments and strings.
@@ -183,7 +151,6 @@ Only affects `imenu-default-create-index-function' (and any
alternative implementation of `imenu-create-index-function' that
uses `imenu--generic-function')."
:type 'boolean
- :group 'imenu
:version "24.4")
;;;###autoload
@@ -280,26 +247,11 @@ The function in this variable is called when selecting a normal index-item.")
(not (functionp (cadr item)))))
(defmacro imenu-progress-message (_prevpos &optional _relpos _reverse)
- "Macro to display a progress message.
-RELPOS is the relative position to display.
-If RELPOS is nil, then the relative position in the buffer
-is calculated.
-PREVPOS is the variable in which we store the last position displayed."
-
+ "This macro is obsolete and does nothing."
+ (declare (obsolete nil "28.1"))
;; Made obsolete/empty, as computers are now faster than the eye, and
;; it had problems updating the messages correctly, and could shadow
;; more important messages/prompts in the minibuffer. KFS 2004-10-27.
-
-;; `(and
-;; imenu-scanning-message
-;; (let ((pos ,(if relpos
-;; relpos
-;; `(imenu--relative-position ,reverse))))
-;; (if ,(if relpos t
-;; `(> pos (+ 5 ,prevpos)))
-;; (progn
-;; (message imenu-scanning-message pos)
-;; (setq ,prevpos pos)))))
)
@@ -511,8 +463,8 @@ Non-nil arguments are in recursive calls."
((imenu--subalist-p item)
(imenu--create-keymap (car item) (cdr item) cmd))
(t
- `(lambda () (interactive)
- ,(if cmd `(,cmd ',item) (list 'quote item)))))))
+ (lambda () (interactive)
+ (if cmd (funcall cmd item) item))))))
alist)))
(defun imenu--in-alist (str alist)
diff --git a/lisp/indent.el b/lisp/indent.el
index 5cbf0acaa25..a33d9620098 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -39,8 +39,8 @@
(defvar indent-line-function 'indent-relative
"Function to indent the current line.
This function will be called with no arguments.
-If it is called somewhere where auto-indentation cannot be done
-\(e.g. inside a string), the function should simply return `noindent'.
+If it is called somewhere where it cannot auto-indent, the function
+should return `noindent' to signal that it didn't.
Setting this function is all you need to make TAB indent appropriately.
Don't rebind TAB unless you really need to.")
@@ -525,7 +525,7 @@ From the beginning of the line, moves past the left-margin indentation, the
fill-prefix, and any indentation used for centering or right-justifying the
line, but does not move past any whitespace that was explicitly inserted
\(such as a tab used to indent the first line of a paragraph)."
- (interactive "p")
+ (interactive "^p")
(beginning-of-line n)
(skip-chars-forward " \t")
;; Skip over fill-prefix.
diff --git a/lisp/info-look.el b/lisp/info-look.el
index fd6f8f15082..33f15a34e99 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -43,6 +43,7 @@
(require 'info)
(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'cl-lib))
(defgroup info-lookup nil
"Major mode sensitive help agent."
@@ -901,6 +902,16 @@ Return nil if there is nothing appropriate in the buffer near point."
:parse-rule "[$@%]?\\([_a-zA-Z0-9]+\\|[^a-zA-Z]\\)")
(info-lookup-maybe-add-help
+ :mode 'python-mode
+ ;; Debian includes Python info files, but they're version-named
+ ;; instead of having a symlink.
+ :doc-spec `((,(cl-loop for version from 20 downto 7
+ for name = (format "python3.%d" version)
+ if (Info-find-file name t)
+ return (format "(%s)Index" name)
+ finally return "(python)Index"))))
+
+(info-lookup-maybe-add-help
:mode 'cperl-mode
:regexp "[$@%][^a-zA-Z]\\|\\$\\^[A-Z]\\|[$@%]?[a-zA-Z][_a-zA-Z0-9]*"
:other-modes '(perl-mode))
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index be1928d692b..e2e3e30ca21 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -95,7 +95,7 @@ about local variables or possible weirdness in a major mode.
`lm-with-file' does a similar thing, but it sets
`emacs-lisp-mode' which is not wanted here."
- (declare (debug t) (indent 1))
+ (declare (debug (form def-body)) (indent 1))
`(let* ((info-xref-with-file--filename ,filename)
(info-xref-with-file--body (lambda () ,@body))
(info-xref-with-file--existing
@@ -547,7 +547,7 @@ the sources handy."
;; skip nodes with "%" as probably `format' strings such as in
;; info-look.el
- (unless (string-match "%" node)
+ (unless (string-search "%" node)
;; "(emacs)" is the default manual for docstring hyperlinks,
;; per `help-make-xrefs'
diff --git a/lisp/info.el b/lisp/info.el
index 7f169f4b556..e6b5f3e5a7c 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1,4 +1,4 @@
-;; info.el --- Info package for Emacs -*- lexical-binding:t -*-
+;;; info.el --- Info package for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985-1986, 1992-2021 Free Software Foundation, Inc.
@@ -391,6 +391,14 @@ where SUPPORTS-INDEX-COOKIES can be either t or nil.")
(defvar-local Info-index-alternatives nil
"List of possible matches for last `Info-index' command.")
+(defvar-local Info--current-index-alternative 0
+ "Current displayed index alternative.")
+
+(defcustom Info-warn-on-index-alternatives-wrap t
+ "Warn when wrapping to the beginning/end when displaying index alternatives."
+ :type 'boolean
+ :version "28.1")
+
(defvar Info-point-loc nil
"Point location within a selected node.
If string, the point is moved to the proper occurrence of the
@@ -916,7 +924,8 @@ find a node."
(when (and (not no-pop-to-dir)
(not Info-current-file))
(Info-directory))
- (user-error "Info file %s does not exist" filename)))
+ (user-error "Info file `%s' does not exist; consider installing it"
+ filename)))
filename))))
(defun Info-find-node (filename nodename &optional no-going-back strict-case)
@@ -1723,14 +1732,14 @@ escaped (\\\",\\\\)."
(concat
" ("
(if (stringp Info-current-file)
- (replace-regexp-in-string
+ (string-replace
"%" "%%"
(file-name-sans-extension
(file-name-nondirectory Info-current-file)))
(format "*%S*" Info-current-file))
") "
(if Info-current-node
- (propertize (replace-regexp-in-string
+ (propertize (string-replace
"%" "%%" Info-current-node)
'face 'mode-line-buffer-id
'help-echo
@@ -1854,7 +1863,8 @@ See `completing-read' for a description of arguments and usage."
(lambda (string pred action)
(complete-with-action
action
- (Info-build-node-completions (Info-find-file file1 nil t))
+ (when-let ((file2 (Info-find-file file1 'noerror t)))
+ (Info-build-node-completions file2))
string pred))
nodename predicate code))))
;; Otherwise use Info-read-node-completion-table.
@@ -1880,10 +1890,17 @@ the Top node in FILENAME."
(or (cdr (assoc filename Info-file-completions))
(with-temp-buffer
(Info-mode)
- (Info-goto-node (format "(%s)Top" filename))
- (Info-build-node-completions-1)
- (push (cons filename Info-current-file-completions) Info-file-completions)
- Info-current-file-completions))
+ (condition-case nil
+ (Info-goto-node (format "(%s)Top" filename))
+ ;; `Info-goto-node' signals a `user-error' when there
+ ;; are no nodes in the file in question (for instance,
+ ;; if it's not actually an Info file).
+ (user-error nil)
+ (:success
+ (Info-build-node-completions-1)
+ (push (cons filename Info-current-file-completions)
+ Info-file-completions)
+ Info-current-file-completions))))
(or Info-current-file-completions
(Info-build-node-completions-1))))
@@ -1972,7 +1989,8 @@ If DIRECTION is `backward', search in the reverse direction."
(format-prompt
"Regexp search%s" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
- nil 'Info-search-history)))
+ nil 'Info-search-history))
+ Info-mode)
(when (equal regexp "")
(setq regexp (car Info-search-history)))
(when regexp
@@ -2080,13 +2098,13 @@ If DIRECTION is `backward', search in the reverse direction."
(defun Info-search-case-sensitively ()
"Search for a regexp case-sensitively."
- (interactive)
+ (interactive nil Info-mode)
(let ((case-fold-search nil))
(call-interactively 'Info-search)))
(defun Info-search-next ()
"Search for next regexp from a previous `Info-search' command."
- (interactive)
+ (interactive nil Info-mode)
(let ((case-fold-search Info-search-case-fold))
(if Info-search-history
(Info-search (car Info-search-history))
@@ -2098,7 +2116,8 @@ If DIRECTION is `backward', search in the reverse direction."
(format-prompt
"Regexp search%s backward" (car Info-search-history)
(if case-fold-search "" " case-sensitively"))
- nil 'Info-search-history)))
+ nil 'Info-search-history))
+ Info-mode)
(Info-search regexp bound noerror count 'backward))
(defun Info-isearch-search ()
@@ -2137,8 +2156,10 @@ If DIRECTION is `backward', search in the reverse direction."
(goto-char (if isearch-forward (point-min) (point-max)))))
(defun Info-isearch-push-state ()
- `(lambda (cmd)
- (Info-isearch-pop-state cmd ',Info-current-file ',Info-current-node)))
+ (let ((file Info-current-file)
+ (node Info-current-node))
+ (lambda (cmd)
+ (Info-isearch-pop-state cmd file node))))
(defun Info-isearch-pop-state (_cmd file node)
(or (and (equal Info-current-file file)
@@ -2235,7 +2256,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat."
(defun Info-next ()
"Go to the \"next\" node, staying on the same hierarchical level.
This command doesn't descend into sub-nodes, like \\<Info-mode-map>\\[Info-forward-node] does."
- (interactive)
+ (interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2244,7 +2265,7 @@ This command doesn't descend into sub-nodes, like \\<Info-mode-map>\\[Info-forwa
(defun Info-prev ()
"Go to the \"previous\" node, staying on the same hierarchical level.
This command doesn't go up to the parent node, like \\<Info-mode-map>\\[Info-backward-node] does."
- (interactive)
+ (interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2253,7 +2274,7 @@ This command doesn't go up to the parent node, like \\<Info-mode-map>\\[Info-bac
(defun Info-up (&optional same-file)
"Go to the superior node of this node.
If SAME-FILE is non-nil, do not move to a different Info file."
- (interactive)
+ (interactive nil Info-mode)
;; In case another window is currently selected
(save-window-excursion
(or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
@@ -2284,7 +2305,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(defun Info-history-back ()
"Go back in the history to the last node visited."
- (interactive)
+ (interactive nil Info-mode)
(or Info-history
(user-error "This is the first Info node you looked at"))
(let ((history-forward
@@ -2304,7 +2325,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(defun Info-history-forward ()
"Go forward in the history of visited nodes."
- (interactive)
+ (interactive nil Info-mode)
(or Info-history-forward
(user-error "This is the last Info node you looked at"))
(let ((history-forward (cdr Info-history-forward))
@@ -2378,7 +2399,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(defun Info-history ()
"Go to a node with a menu of visited nodes."
- (interactive)
+ (interactive nil Info-mode)
(Info-find-node "*History*" "Top")
(Info-next-reference)
(Info-next-reference))
@@ -2415,7 +2436,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(defun Info-toc ()
"Go to a node with table of contents of the current Info file.
Table of contents is created from the tree structure of menus."
- (interactive)
+ (interactive nil Info-mode)
(Info-find-node Info-current-file "*TOC*")
(let ((prev-node (nth 1 (car Info-history))) p)
(goto-char (point-min))
@@ -2462,7 +2483,7 @@ Table of contents is created from the tree structure of menus."
(match-string-no-properties 1)))
(section "Top")
menu-items)
- (when (and upnode (string-match "(" upnode)) (setq upnode nil))
+ (when (and upnode (string-search "(" upnode)) (setq upnode nil))
(when (and (not (Info-index-node nodename file))
(re-search-forward "^\\* Menu:" bound t))
(forward-line 1)
@@ -2587,14 +2608,15 @@ new buffer."
(list (if (equal input "")
default input)
current-prefix-arg))
- (user-error "No cross-references in this node"))))
+ (user-error "No cross-references in this node")))
+ Info-mode)
(unless footnotename
(error "No reference was specified"))
(let (target i (str (concat "\\*note " (regexp-quote footnotename)))
(case-fold-search t))
- (while (setq i (string-match " " str i))
+ (while (setq i (string-search " " str i))
(setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
(setq i (+ i 6)))
(save-excursion
@@ -2789,7 +2811,8 @@ new buffer."
(completing-read (format-prompt "Menu item" default)
#'Info-complete-menu-item nil t nil nil
default))))
- (list item current-prefix-arg))))
+ (list item current-prefix-arg)))
+ Info-mode)
;; there is a problem here in that if several menu items have the same
;; name you can only go to the node of the first with this command.
(Info-goto-node (Info-extract-menu-item menu-item)
@@ -2833,19 +2856,19 @@ new buffer."
(defun Info-nth-menu-item ()
"Go to the node of the Nth menu item.
N is the digit argument used to invoke this command."
- (interactive)
+ (interactive nil Info-mode)
(Info-goto-node
(Info-extract-menu-counting
(- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))
(defun Info-top-node ()
"Go to the Top node of this file."
- (interactive)
+ (interactive nil Info-mode)
(Info-goto-node "Top"))
(defun Info-final-node ()
"Go to the final node in this file."
- (interactive)
+ (interactive nil Info-mode)
(Info-goto-node "Top")
(let ((Info-history nil)
(case-fold-search t))
@@ -2869,7 +2892,7 @@ to the parent node.
When called from Lisp, NOT-DOWN non-nil means don't descend into sub-nodes,
NOT-UP non-nil means don't go to parent nodes, and NO-ERROR non-nil means
don't signal a user-error if there's no node to go to."
- (interactive)
+ (interactive nil Info-mode)
(goto-char (point-min))
(forward-line 1)
(let ((case-fold-search t))
@@ -2906,11 +2929,11 @@ don't signal a user-error if there's no node to go to."
"Go backward one node, considering all nodes as forming one sequence.
If the current node has a \"previous\" node, go to it, descending into its
last sub-node, if any; otherwise go \"up\" to the parent node."
- (interactive)
+ (interactive nil Info-mode)
(let ((prevnode (Info-extract-pointer "prev[ious]*" t))
(upnode (Info-extract-pointer "up" t))
(case-fold-search t))
- (cond ((and upnode (string-match "(" upnode))
+ (cond ((and upnode (string-search "(" upnode))
(user-error "First node in file"))
((and upnode (or (null prevnode)
;; Use string-equal, not equal,
@@ -2935,7 +2958,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node."
(defun Info-next-menu-item ()
"Go to the node of the next menu item."
- (interactive)
+ (interactive nil Info-mode)
;; Bind this in case the user sets it to nil.
(let* ((case-fold-search t)
(node
@@ -2949,7 +2972,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node."
(defun Info-last-menu-item ()
"Go to the node of the previous menu item."
- (interactive)
+ (interactive nil Info-mode)
(save-excursion
(forward-line 1)
;; Bind this in case the user sets it to nil.
@@ -2968,7 +2991,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node."
(defun Info-next-preorder ()
"Go to the next subnode or the next node, or go up a level."
- (interactive)
+ (interactive nil Info-mode)
(cond ((Info-no-error (Info-next-menu-item)))
((Info-no-error (Info-next)))
((Info-no-error (Info-up t))
@@ -2987,7 +3010,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node."
(defun Info-last-preorder ()
"Go to the last node, popping up a level if there is none."
- (interactive)
+ (interactive nil Info-mode)
(cond ((and Info-scroll-prefer-subnodes
(Info-no-error
(Info-last-menu-item)
@@ -3039,7 +3062,7 @@ the menu of a node, it moves to subnode indicated by the following menu
item. (That case won't normally result from this command, but can happen
in other ways.)"
- (interactive)
+ (interactive nil Info-mode)
(if (or (< (window-start) (point-min))
(> (window-start) (point-max)))
(set-window-start (selected-window) (point)))
@@ -3061,7 +3084,7 @@ in other ways.)"
(defun Info-mouse-scroll-up (e)
"Scroll one screenful forward in Info, using the mouse.
See `Info-scroll-up'."
- (interactive "e")
+ (interactive "e" Info-mode)
(save-selected-window
(if (eventp e)
(select-window (posn-window (event-start e))))
@@ -3073,7 +3096,7 @@ If point is within the menu of a node, and `Info-scroll-prefer-subnodes'
is non-nil, this goes to its last subnode. When you scroll past the
beginning of a node, that goes to the previous node or back up to the
parent node."
- (interactive)
+ (interactive nil Info-mode)
(if (or (< (window-start) (point-min))
(> (window-start) (point-max)))
(set-window-start (selected-window) (point)))
@@ -3093,7 +3116,7 @@ parent node."
(defun Info-mouse-scroll-down (e)
"Scroll one screenful backward in Info, using the mouse.
See `Info-scroll-down'."
- (interactive "e")
+ (interactive "e" Info-mode)
(save-selected-window
(if (eventp e)
(select-window (posn-window (event-start e))))
@@ -3139,7 +3162,7 @@ Return the new position of point, or nil."
"Move cursor to the next cross-reference or menu item in the node.
If COUNT is non-nil (interactively with a prefix arg), jump over
COUNT cross-references."
- (interactive "i\np")
+ (interactive "i\np" Info-mode)
(unless count
(setq count 1))
(if (< count 0)
@@ -3167,7 +3190,7 @@ COUNT cross-references."
"Move cursor to the previous cross-reference or menu item in the node.
If COUNT is non-nil (interactively with a prefix arg), jump over
COUNT cross-references."
- (interactive "i\np")
+ (interactive "i\np" Info-mode)
(unless count
(setq count 1))
(if (< count 0)
@@ -3360,39 +3383,56 @@ Give an empty topic name to go to the Index node itself."
(setq exact (cons found exact)
matches (delq found matches)))
(setq Info-history-list ohist-list)
- (setq Info-index-alternatives (nconc exact (nreverse matches)))
+ (setq Info-index-alternatives (nconc exact (nreverse matches))
+ Info--current-index-alternative 0)
(Info-index-next 0)))))
(defun Info-index-next (num)
- "Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command."
- (interactive "p")
- (or Info-index-alternatives
- (user-error "No previous `i' command"))
- (while (< num 0)
- (setq num (+ num (length Info-index-alternatives))))
- (while (> num 0)
- (setq Info-index-alternatives
- (nconc (cdr Info-index-alternatives)
- (list (car Info-index-alternatives)))
- num (1- num)))
- (Info-goto-node (nth 1 (car Info-index-alternatives)))
- (if (> (nth 3 (car Info-index-alternatives)) 0)
- ;; Forward 2 lines less because `Info-find-node-2' initially
- ;; puts point to the 2nd line.
- (forward-line (- (nth 3 (car Info-index-alternatives)) 2))
- (forward-line 3) ; don't search in headers
- (let ((name (car (car Info-index-alternatives))))
- (Info-find-index-name name)))
- (message "Found `%s' in %s. %s"
- (car (car Info-index-alternatives))
- (nth 2 (car Info-index-alternatives))
- (if (cdr Info-index-alternatives)
- (format-message
- "(%s total; use `%s' for next)"
- (length Info-index-alternatives)
- (key-description (where-is-internal
- 'Info-index-next overriding-local-map t)))
- "(Only match)")))
+ "Go to the next matching index item from the last \\<Info-mode-map>\\[Info-index] command.
+If given a numeric prefix, skip that many index items forward (or
+backward).
+
+Also see the `Info-warn-on-index-alternatives-wrap' user option."
+ (interactive "p" Info-mode)
+ (unless Info-index-alternatives
+ (user-error "No previous `i' command"))
+ (let ((index (+ Info--current-index-alternative num))
+ (total (length Info-index-alternatives))
+ (next-key (key-description (where-is-internal
+ 'Info-index-next overriding-local-map t))))
+ (if (and Info-warn-on-index-alternatives-wrap
+ (> total 1)
+ (cond
+ ((< index 0)
+ (setq Info--current-index-alternative (- total 2))
+ (message
+ "No previous matches, use `%s' to continue from end of list"
+ next-key)
+ t)
+ ((>= index total)
+ (setq Info--current-index-alternative -1)
+ (message
+ "No previous matches, use `%s' to continue from start of list"
+ next-key)
+ t)))
+ () ; Do nothing
+ (setq index (mod index total)
+ Info--current-index-alternative index)
+ (let ((entry (nth index Info-index-alternatives)))
+ (Info-goto-node (nth 1 entry))
+ (if (> (nth 3 entry) 0)
+ ;; Forward 2 lines less because `Info-find-node-2' initially
+ ;; puts point to the 2nd line.
+ (forward-line (- (nth 3 entry) 2))
+ (forward-line 3) ; don't search in headers
+ (Info-find-index-name (car entry)))
+ (message "Found `%s' in %s. %s"
+ (car entry)
+ (nth 2 entry)
+ (if (> total 1)
+ (format-message
+ "(%s total; use `%s' for next)" total next-key)
+ "(Only match)"))))))
(defun Info-find-index-name (name)
"Move point to the place within the current node where NAME is defined."
@@ -3487,7 +3527,8 @@ search results."
(with-current-buffer Info-complete-menu-buffer
(Info-goto-index)
(completing-read "Index topic: " #'Info-complete-menu-item))
- (kill-buffer Info-complete-menu-buffer)))))
+ (kill-buffer Info-complete-menu-buffer))))
+ Info-mode)
(if (equal topic "")
(Info-find-node Info-current-file "*Index*")
(unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes)
@@ -3737,7 +3778,7 @@ Build a menu of the possible matches."
"The following packages match the keyword ‘" nodename "’:\n\n")
(insert "* Menu:\n\n")
(let ((keywords
- (mapcar #'intern (if (string-match-p "," nodename)
+ (mapcar #'intern (if (string-search "," nodename)
(split-string nodename ",[ \t\n]*" t)
(list nodename))))
hits desc)
@@ -3793,7 +3834,7 @@ with a list of packages that contain all specified keywords."
(defun Info-undefined ()
"Make command be undefined in Info."
- (interactive)
+ (interactive nil Info-mode)
(ding))
(defun Info-help ()
@@ -3870,7 +3911,7 @@ ERRORSTRING optional fourth argument, controls action on no match:
"\\<Info-mode-map>Follow a node reference near point.
Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click.
At end of the node's text, moves to the next node, or up if none."
- (interactive "e")
+ (interactive "e" Info-mode)
(mouse-set-point click)
(and (not (Info-follow-nearest-node))
(save-excursion (forward-line 1) (eobp))
@@ -3884,7 +3925,7 @@ if point is in a menu item description, follow that menu item.
If FORK is non-nil (interactively with a prefix arg), show the node in
a new Info buffer.
If FORK is a string, it is the name to use for the new buffer."
- (interactive "P")
+ (interactive "P" Info-mode)
(or (Info-try-follow-nearest-node fork)
(when (save-excursion
(search-backward "\n* menu:" nil t))
@@ -3954,7 +3995,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(defun Info-mouse-follow-link (click)
"Follow a link where you click."
- (interactive "@e")
+ (interactive "@e" Info-mode)
(let* ((position (event-start click))
(posn-string (and position (posn-string position)))
(link-args (if posn-string
@@ -4076,9 +4117,9 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Search for another occurrence of regular expression"]
"---"
("History"
- ["Back in history" Info-history-back :active Info-history
+ ["Back in History" Info-history-back :active Info-history
:help "Go back in history to the last node you were at"]
- ["Forward in history" Info-history-forward :active Info-history-forward
+ ["Forward in History" Info-history-forward :active Info-history-forward
:help "Go forward in history"]
["Show History" Info-history :active Info-history-list
:help "Go to menu of visited nodes"])
@@ -4105,6 +4146,25 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
"---"
["Exit" quit-window :help "Stop reading Info"]))
+(defun Info-context-menu (menu)
+ (define-key menu [Info-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Info")))
+ (easy-menu-define nil easy-menu nil
+ '("Info"
+ ["Back in History" Info-history-back :visible Info-history
+ :help "Go back in history to the last node you were at"]
+ ["Forward in History" Info-history-forward :visible Info-history-forward
+ :help "Go forward in history"]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar info])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (mouse-posn-property (event-start last-input-event) 'mouse-face)
+ (define-key menu [Info-mouse-follow-nearest-node]
+ '(menu-item "Follow Link" Info-mouse-follow-nearest-node
+ :help "Follow a link where you click")))
+
+ menu)
(defvar info-tool-bar-map
(let ((map (make-sparse-keymap)))
@@ -4158,12 +4218,12 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(defun Info-history-back-menu (e)
"Pop up the menu with a list of previously visited Info nodes."
- (interactive "e")
+ (interactive "e" Info-mode)
(Info-history-menu e "Back in history" Info-history 'Info-history-back))
(defun Info-history-forward-menu (e)
"Pop up the menu with a list of Info nodes visited with ‘Info-history-back’."
- (interactive "e")
+ (interactive "e" Info-mode)
(Info-history-menu e "Forward in history" Info-history-forward 'Info-history-forward))
(defvar Info-menu-last-node nil)
@@ -4237,7 +4297,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
"Put the name of the current Info node into the kill ring.
The name of the Info file is prepended to the node name in parentheses.
With a zero prefix arg, put the name inside a function call to `info'."
- (interactive "P")
+ (interactive "P" Info-mode)
(unless Info-current-node
(user-error "No current Info node"))
(let ((node (if (stringp Info-current-file)
@@ -4405,6 +4465,7 @@ Advanced commands:
(add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
+ (add-hook 'context-menu-functions 'Info-context-menu 5 t)
(when Info-standalone
(add-hook 'quit-window-hook 'save-buffers-kill-emacs nil t))
(setq-local isearch-search-fun-function #'Info-isearch-search)
@@ -4792,10 +4853,10 @@ first line or header line, and for breadcrumb links.")
(skip-syntax-backward " ("))
(setq other-tag
(cond ((save-match-data (looking-back "\\(^\\| \\)see"
- (- (point) 3)))
+ (- (point) 4)))
"")
((save-match-data (looking-back "\\(^\\| \\)in"
- (- (point) 2)))
+ (- (point) 3)))
"")
((memq (char-before) '(nil ?\. ?! ??))
"See ")
@@ -5203,7 +5264,7 @@ The INDENT level is ignored."
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node (NAME . FILE).
INDENT is the current indentation depth."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(if (speedbar-with-writable
(save-excursion
@@ -5211,7 +5272,7 @@ INDENT is the current indentation depth."
(Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
(speedbar-change-expand-button-char ?-)
(speedbar-change-expand-button-char ??)))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/informat.el b/lisp/informat.el
index 3da23516333..bac09752b70 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,4 +1,4 @@
-;;; informat.el --- info support functions package for Emacs
+;;; informat.el --- info support functions package for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc.
@@ -140,7 +140,7 @@
(or (bolp)
(newline))
(insert "\^_\f\nTag table:\n")
- (if (eq major-mode 'info-mode)
+ (if (derived-mode-p 'info-mode)
(move-marker Info-tag-table-marker (point)))
(setq tag-list (nreverse tag-list))
(while tag-list
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 3c5a461a31e..0eb009fa526 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -43,12 +43,6 @@
;;; Code:
-;; Unused.
-;;; (defgroup ccl nil
-;;; "CCL (Code Conversion Language) compiler."
-;;; :prefix "ccl-"
-;;; :group 'i18n)
-
(defconst ccl-command-table
[if branch loop break repeat write-repeat write-read-repeat
read read-if read-branch write call end
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 9bce419b489..97bf31acfc3 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -265,7 +265,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
-(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x2975)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
@@ -484,9 +484,9 @@ with L, LRE, or LRO Unicode bidi character type.")
(progn
(modify-syntax-entry chars syntax)
(modify-category-entry chars category))
- (mapc #'(lambda (x)
- (modify-syntax-entry x syntax)
- (modify-category-entry x category))
+ (mapc (lambda (x)
+ (modify-syntax-entry x syntax)
+ (modify-category-entry x category))
chars)))))
;; Bidi categories
@@ -1390,8 +1390,8 @@ with L, LRE, or LRO Unicode bidi character type.")
(dolist (charset-info (nthcdr 2 slot))
(let ((charset (car charset-info)))
(dolist (code-range (cdr charset-info))
- (map-charset-chars #'(lambda (range _arg)
- (set-char-table-range table range 2))
+ (map-charset-chars (lambda (range _arg)
+ (set-char-table-range table range 2))
charset nil
(car code-range) (cdr code-range)))))
(optimize-char-table table)
@@ -1417,8 +1417,8 @@ Setup char-width-table appropriate for non-CJK language environment."
(require 'charscript))
(map-charset-chars
- #'(lambda (range _ignore)
- (set-char-table-range char-script-table range 'tibetan))
+ (lambda (range _ignore)
+ (set-char-table-range char-script-table range 'tibetan))
'tibetan)
@@ -1426,14 +1426,14 @@ Setup char-width-table appropriate for non-CJK language environment."
(when (setq unicode-category-table
(unicode-property-table-internal 'general-category))
- (map-char-table #'(lambda (key val)
- (if val
- (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
- (/= (aref (symbol-name val) 0) ?C))
- (eq val 'Zs))
- (modify-category-entry key ?.))
- ((eq val 'Mn)
- (modify-category-entry key ?^)))))
+ (map-char-table (lambda (key val)
+ (if val
+ (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
+ (/= (aref (symbol-name val) 0) ?C))
+ (eq val 'Zs))
+ (modify-category-entry key ?.))
+ ((eq val 'Mn)
+ (modify-category-entry key ?^)))))
unicode-category-table))
(optimize-char-table (standard-category-table))
@@ -1524,21 +1524,21 @@ option `glyphless-char-display'."
((eq target 'format-control)
(when unicode-category-table
(map-char-table
- #'(lambda (char category)
- (if (eq category 'Cf)
- (let ((this-method method)
- from to)
- (if (consp char)
- (setq from (car char) to (cdr char))
- (setq from char to char))
- (while (<= from to)
- (when (/= from #xAD)
- (if (eq method 'acronym)
- (setq this-method
- (aref char-acronym-table from)))
- (set-char-table-range glyphless-char-display
- from this-method))
- (setq from (1+ from))))))
+ (lambda (char category)
+ (if (eq category 'Cf)
+ (let ((this-method method)
+ from to)
+ (if (consp char)
+ (setq from (car char) to (cdr char))
+ (setq from char to char))
+ (while (<= from to)
+ (when (/= from #xAD)
+ (if (eq method 'acronym)
+ (setq this-method
+ (aref char-acronym-table from)))
+ (set-char-table-range glyphless-char-display
+ from this-method))
+ (setq from (1+ from))))))
unicode-category-table)))
((eq target 'no-font)
(set-char-table-extra-slot glyphless-char-display 0 method))
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 8f0f263dcce..3deaff96774 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -497,37 +497,37 @@
(:registry "iso10646-1"))))
(cjk-table (make-char-table nil))
(script-coverage
- #'(lambda (script)
- (let ((coverage))
- (map-char-table
- #'(lambda (range val)
- (when (eq val script)
- (if (consp range)
- (setq range (cons (car range) (cdr range))))
- (push range coverage)))
- char-script-table)
- coverage)))
+ (lambda (script)
+ (let ((coverage))
+ (map-char-table
+ (lambda (range val)
+ (when (eq val script)
+ (if (consp range)
+ (setq range (cons (car range) (cdr range))))
+ (push range coverage)))
+ char-script-table)
+ coverage)))
(data (list (vconcat (mapcar 'car cjk))))
(i 0))
(dolist (elt cjk)
(let ((mask (ash 1 i)))
(map-charset-chars
- #'(lambda (range _arg)
- (let ((from (car range)) (to (cdr range)))
- (if (< to #x110000)
- (while (<= from to)
- (or (memq (aref char-script-table from)
- '(kana hangul han cjk-misc))
- (aset cjk-table from
- (logior (or (aref cjk-table from) 0) mask)))
- (setq from (1+ from))))))
+ (lambda (range _arg)
+ (let ((from (car range)) (to (cdr range)))
+ (if (< to #x110000)
+ (while (<= from to)
+ (or (memq (aref char-script-table from)
+ '(kana hangul han cjk-misc))
+ (aset cjk-table from
+ (logior (or (aref cjk-table from) 0) mask)))
+ (setq from (1+ from))))))
(nth 1 elt) nil (nth 2 elt) (nth 3 elt)))
(setq i (1+ i)))
(map-char-table
- #'(lambda (range val)
- (if (consp range)
- (setq range (cons (car range) (cdr range))))
- (push (cons range val) data))
+ (lambda (range val)
+ (if (consp range)
+ (setq range (cons (car range) (cdr range))))
+ (push (cons range val) data))
cjk-table)
(dolist (script scripts)
(dolist (range (funcall script-coverage (car script)))
@@ -1227,7 +1227,7 @@ Done when `mouse-set-font' is called."
(string-match "fontset-auto[0-9]+$" fontset)
(push (list (fontset-plain-name fontset) fontset) l)))
(cons "Fontset"
- (sort l #'(lambda (x y) (string< (car x) (car y)))))))
+ (sort l (lambda (x y) (string< (car x) (car y)))))))
(declare-function query-fontset "fontset.c" (pattern &optional regexpp))
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 3be7849df19..793508cae4a 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -323,11 +323,9 @@
(insert ")\n\n")))
(defun skkdic-convert (filename &optional dirname)
- "Generate Emacs Lisp file form Japanese dictionary file FILENAME.
+ "Generate Emacs Lisp file from Japanese dictionary file FILENAME.
The format of the dictionary file should be the same as SKK dictionaries.
-Optional argument DIRNAME if specified is the directory name under which
-the generated Emacs Lisp is saved.
-The name of generated file is specified by the variable `ja-dic-filename'."
+Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)."
(interactive "FSKK dictionary file: ")
(let* ((skkbuf (get-buffer-create " *skkdic-unannotated*"))
(buf (get-buffer-create "*skkdic-work*")))
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index 4b6ef9833e5..b3d6a635b1c 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -186,8 +186,8 @@ character set."
'arabic-iso8859-6
(car (remq 'ascii (get-language-info language
'charset))))))
- (map-charset-chars #'(lambda (range _arg)
- (standard-display-default (car range) (cdr range)))
+ (map-charset-chars (lambda (range _arg)
+ (standard-display-default (car range) (cdr range)))
charset))
(sit-for 0))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 5dc3de4422b..71e2653ffe9 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -679,18 +679,18 @@ DEFAULT is the coding system to use by default in the query."
;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
(if unsafe
(setq unsafe
- (mapcar #'(lambda (coding)
- (cons coding
- (if (stringp from)
- (mapcar #'(lambda (pos)
- (cons pos (aref from pos)))
- (unencodable-char-position
- 0 (length from) coding
- 11 from))
- (mapcar #'(lambda (pos)
- (cons pos (char-after pos)))
- (unencodable-char-position
- from to coding 11)))))
+ (mapcar (lambda (coding)
+ (cons coding
+ (if (stringp from)
+ (mapcar (lambda (pos)
+ (cons pos (aref from pos)))
+ (unencodable-char-position
+ 0 (length from) coding
+ 11 from))
+ (mapcar (lambda (pos)
+ (cons pos (char-after pos)))
+ (unencodable-char-position
+ from to coding 11)))))
unsafe)))
(setq codings (sanitize-coding-system-list codings))
@@ -744,19 +744,19 @@ e.g., for sending an email message.\n ")
(insert (format " %s cannot encode these:" (car coding)))
(let ((i 0)
(func1
- #'(lambda (bufname pos)
- (when (buffer-live-p (get-buffer bufname))
- (pop-to-buffer bufname)
- (goto-char pos))))
+ (lambda (bufname pos)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (goto-char pos))))
(func2
- #'(lambda (bufname pos coding)
- (when (buffer-live-p (get-buffer bufname))
- (pop-to-buffer bufname)
- (if (< (point) pos)
- (goto-char pos)
- (forward-char 1)
- (search-unencodable-char coding)
- (forward-char -1))))))
+ (lambda (bufname pos coding)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (if (< (point) pos)
+ (goto-char pos)
+ (forward-char 1)
+ (search-unencodable-char coding)
+ (forward-char -1))))))
(dolist (elt (cdr coding))
(insert " ")
(if (stringp from)
@@ -1524,7 +1524,7 @@ To deactivate it programmatically, use `deactivate-input-method'."
(interactive
(let* ((default (or (car input-method-history) default-input-method)))
(list (read-input-method-name
- (if default "Select input method (default %s): " "Select input method: ")
+ (format-prompt "Select input method" default)
default t)
t)))
(activate-input-method input-method)
@@ -1569,7 +1569,7 @@ which marks the variable `default-input-method' as set for Custom buffers."
(if (or arg (not default))
(progn
(read-input-method-name
- (if default "Input method (default %s): " "Input method: " )
+ (format-prompt "Input method" default)
default t))
default))
(unless default-input-method
@@ -1620,7 +1620,7 @@ If `default-transient-input-method' was not yet defined, prompt for it."
"Describe input method INPUT-METHOD."
(interactive
(list (read-input-method-name
- "Describe input method (default current choice): ")))
+ (format-prompt "Describe input method" current-input-method))))
(if (and input-method (symbolp input-method))
(setq input-method (symbol-name input-method)))
(help-setup-xref (list #'describe-input-method
@@ -1929,7 +1929,7 @@ runs the hook `exit-language-environment-hook'. After setting up
the new language environment, it runs `set-language-environment-hook'."
(interactive (list (read-language-name
nil
- "Set language environment (default English): ")))
+ (format-prompt "Set language environment" "English"))))
(if language-name
(if (symbolp language-name)
(setq language-name (symbol-name language-name)))
@@ -2144,7 +2144,7 @@ See `set-language-info-alist' for use in programs."
(interactive
(list (read-language-name
'documentation
- "Describe language environment (default current choice): ")))
+ (format-prompt "Describe language environment" current-language-environment))))
(if (null language-name)
(setq language-name current-language-environment))
(if (or (null language-name)
@@ -2166,7 +2166,7 @@ See `set-language-info-alist' for use in programs."
(let ((str (eval (get-language-info language-name 'sample-text))))
(if (stringp str)
(insert "Sample text:\n "
- (replace-regexp-in-string "\n" "\n " str)
+ (string-replace "\n" "\n " str)
"\n\n")))
(error nil))
(let ((input-method (get-language-info language-name 'input-method))
@@ -2245,7 +2245,7 @@ See `set-language-info-alist' for use in programs."
;; LANGUAGE is a language code taken from ISO 639:1988 (E/F)
;; with additions from ISO 639/RA Newsletter No.1/1989;
;; see Internet RFC 2165 (1997-06) and
- ;; http://www.evertype.com/standards/iso639/iso639-en.html
+ ;; https://www.evertype.com/standards/iso639/iso639-en.html
;; TERRITORY is a country code taken from ISO 3166
;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html.
;; CODESET and MODIFIER are implementation-dependent.
@@ -2963,18 +2963,22 @@ STR should be a unibyte string."
str " "))
(defun encode-coding-char (char coding-system &optional charset)
- "Encode CHAR by CODING-SYSTEM and return the resulting string.
+ "Encode CHAR by CODING-SYSTEM and return the resulting string of bytes.
If CODING-SYSTEM can't safely encode CHAR, return nil.
The 3rd optional argument CHARSET, if non-nil, is a charset preferred
on encoding."
(let* ((str1 (string char))
(str2 (string char char))
(found (find-coding-systems-string str1))
- enc1 enc2 i1 i2)
- (if (eq (car-safe found) 'undecided) ;Aka (not (multibyte-string-p str1))
- ;; `char' is ASCII.
+ (bom-p (coding-system-get coding-system :bom))
+ enc1 enc2 i0 i1 i2)
+ ;; If CHAR is ASCII and CODING-SYSTEM doesn't prepend a BOM, just
+ ;; encode CHAR.
+ (if (and (eq (car-safe found) 'undecided)
+ (null bom-p))
(encode-coding-string str1 coding-system)
- (when (memq (coding-system-base coding-system) found)
+ (when (or (eq (car-safe found) 'undecided)
+ (memq (coding-system-base coding-system) found))
;; We must find the encoded string of CHAR. But, just encoding
;; CHAR will put extra control sequences (usually to designate
;; ASCII charset) at the tail if type of CODING is ISO 2022.
@@ -2995,7 +2999,19 @@ on encoding."
;; Now (substring enc1 i1) and (substring enc2 i2) are the same,
;; and they are the extra control sequences at the tail to
;; exclude.
- (substring enc2 0 i2)))))
+
+ ;; We also need to exclude the leading 2 or 3 bytes if they
+ ;; come from a BOM.
+ (setq i0
+ (if bom-p
+ (cond
+ ((eq (coding-system-type coding-system) 'utf-8)
+ 3)
+ ((eq (coding-system-type coding-system) 'utf-16)
+ 2)
+ (t 0))
+ 0))
+ (substring enc2 i0 i2)))))
;; Backwards compatibility. These might be better with :init-value t,
;; but that breaks loadup.
@@ -3047,7 +3063,7 @@ on encoding."
(#x1D000 . #x1FFFF)
;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused
(#xE0000 . #xE01FF)))
- (gc-cons-threshold 10000000)
+ (gc-cons-threshold (max gc-cons-threshold 10000000))
(names (make-hash-table :size 42943 :test #'equal)))
(dolist (range ranges)
(let ((c (car range))
@@ -3077,12 +3093,24 @@ on encoding."
(puthash "BELL (BEL)" ?\a names)
(setq ucs-names names))))
+(defun mule--ucs-names-sort-by-code (names)
+ (let ((codes-and-names
+ (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)))
+ (mapcar #'cdr (sort codes-and-names #'car-less-than-car))))
+
(defun mule--ucs-names-affixation (names)
(mapcar (lambda (name)
(let ((char (gethash name ucs-names)))
- (list name (concat (if char (format "%c" char) " ") "\t") "")))
+ (list name (concat (if char (list char) " ") "\t") "")))
names))
+(defun mule--ucs-names-group (name transform)
+ (if transform
+ name
+ (let* ((char (gethash name ucs-names))
+ (script (and char (aref char-script-table char))))
+ (if script (symbol-name script) "ungrouped"))))
+
(defun char-from-name (string &optional ignore-case)
"Return a character as a number from its Unicode name STRING.
If optional IGNORE-CASE is non-nil, ignore case in STRING.
@@ -3104,6 +3132,15 @@ Return nil if STRING does not name a character."
ignore-case))
code)))))))
+(defcustom read-char-by-name-sort nil
+ "How to sort characters for `read-char-by-name' completion.
+Defines the sorting order either by character names or their codepoints."
+ :type '(choice
+ (const :tag "Sort by character names" nil)
+ (const :tag "Sort by character codepoints" code))
+ :group 'mule
+ :version "28.1")
+
(defun read-char-by-name (prompt)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
@@ -3117,6 +3154,10 @@ preceded by an asterisk `*' and use completion, it will show all
the characters whose names include that substring, not necessarily
at the beginning of the name.
+The options `read-char-by-name-sort', `completions-group', and
+`completions-group-sort' define the sorting order of completion characters,
+whether to group them, and how to sort groups.
+
Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal
number like \"2A10\", or a number in hash notation (e.g.,
\"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for
@@ -3130,8 +3171,15 @@ as names, not numbers."
prompt
(lambda (string pred action)
(if (eq action 'metadata)
- '(metadata
- (affixation-function . mule--ucs-names-affixation)
+ `(metadata
+ (display-sort-function
+ . ,(when (eq read-char-by-name-sort 'code)
+ #'mule--ucs-names-sort-by-code))
+ (affixation-function
+ . ,#'mule--ucs-names-affixation)
+ (group-function
+ . ,(when completions-group
+ #'mule--ucs-names-group))
(category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 64aac46fcee..2d36dab6320 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -41,7 +41,7 @@
;; Standards docs equivalent to iso-2022 and iso-8859 are at
;; https://www.ecma.ch/.
-;; FWIW, http://www.microsoft.com/globaldev/ lists the following for
+;; FWIW, https://www.microsoft.com/globaldev/ lists the following for
;; MS Windows, which are presumably the only charsets we really need
;; to worry about on such systems:
;; `OEM codepages': 437, 720, 737, 775, 850, 852, 855, 857, 858, 862, 866
@@ -358,7 +358,7 @@
:code-offset #x130000
:unify-map "BIG5")
;; Fixme: AKA cp950 according to
-;; <URL:http://www.microsoft.com/globaldev/reference/WinCP.asp>. Is
+;; <URL:https://www.microsoft.com/globaldev/reference/WinCP.asp>. Is
;; that correct?
(define-charset 'chinese-big5-1
@@ -708,7 +708,7 @@
;; Original name for cp1125, says Serhii Hlodin <hlodin@lutsk.bank.gov.ua>
(define-charset-alias 'cp866u 'cp1125)
-;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html
+;; Fixme: C.f. iconv, https://czyborra.com/charsets/codepages.html
;; shows this as not ASCII compatible, with various graphics in
;; 0x01-0x1F.
(define-charset 'cp437
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index d97d090cd08..02169ceb689 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -45,8 +45,8 @@
(define-button-type 'sort-listed-character-sets
'help-echo (purecopy "mouse-2, RET: sort on this column")
'face 'bold
- 'action #'(lambda (button)
- (sort-listed-character-sets (button-get button 'sort-key))))
+ 'action (lambda (button)
+ (sort-listed-character-sets (button-get button 'sort-key))))
(define-button-type 'list-charset-chars
:supertype 'help-xref
@@ -835,6 +835,8 @@ The IGNORED argument is ignored."
(list (completing-read
"Font name (default current choice for ASCII chars): "
(and window-system
+ ;; Implied by `window-system'.
+ (fboundp 'x-list-fonts)
(fboundp 'fontset-list)
;; The final element in `fontset-list' is a default
;; (generic) one, so don't include that.
@@ -903,13 +905,13 @@ The IGNORED argument is ignored."
(setq family "*-*")
(if (symbolp family)
(setq family (symbol-name family)))
- (or (string-match "-" family)
+ (or (string-search "-" family)
(setq family (concat "*-" family))))
(if (not registry)
(setq registry "*-*")
(if (symbolp registry)
(setq registry (symbol-name registry)))
- (or (string-match "-" registry)
+ (or (string-search "-" registry)
(= (aref registry (1- (length registry))) ?*)
(setq registry (concat registry "*"))))
(insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
@@ -1170,12 +1172,12 @@ The default is 20. If LIMIT is negative, do not limit the listing."
(if (or (vectorp elt) (listp elt))
(let ((i 0))
(catch 'tag
- (mapc #'(lambda (x)
- (setq i (1+ i))
- (when (= i limit)
- (insert " ...\n")
- (throw 'tag nil))
- (insert (format " %s\n" x)))
+ (mapc (lambda (x)
+ (setq i (1+ i))
+ (when (= i limit)
+ (insert " ...\n")
+ (throw 'tag nil))
+ (insert (format " %s\n" x)))
elt)))
(insert (format " %s\n" elt)))))))
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 580bd293e73..38d29cb2385 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -278,14 +278,13 @@ Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil
CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'.
This affects the implicit sorting of lists of coding systems returned by
operations such as `find-coding-systems-region'."
+ (declare (indent 1) (debug t))
(let ((current (make-symbol "current")))
`(let ((,current (coding-system-priority-list)))
(apply #'set-coding-system-priority ,coding-systems)
(unwind-protect
(progn ,@body)
(apply #'set-coding-system-priority ,current)))))
-;;;###autoload(put 'with-coding-priority 'lisp-indent-function 1)
-(put 'with-coding-priority 'edebug-form-spec t)
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
@@ -334,13 +333,20 @@ QUALITY can be:
`approximate', in which case we may cut some corners to avoid
excessive work.
`exact', in which case we may end up re-(en/de)coding a large
- part of the file/buffer, this can be expensive and slow.
+ part of the file/buffer, this can be expensive and slow. (It
+ is an error to request the `exact' method when the buffer's
+ EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation."
(unless coding-system (setq coding-system buffer-file-coding-system))
(let ((eol (coding-system-eol-type coding-system))
(type (coding-system-type coding-system))
(base (coding-system-base coding-system))
(pm (save-restriction (widen) (point-min))))
+ ;; Handle EOL edge cases.
+ (unless (numberp eol)
+ (if (eq quality 'exact)
+ (error "Unknown EOL format in coding system: %s" coding-system)
+ (setq eol 0)))
(and (eq type 'utf-8)
;; Any post-read/pre-write conversions mean it's not really UTF-8.
(not (null (coding-system-get coding-system :post-read-conversion)))
@@ -410,14 +416,24 @@ QUALITY can be:
`approximate', in which case we may cut some corners to avoid
excessive work.
`exact', in which case we may end up re-(en/de)coding a large
- part of the file/buffer, this can be expensive and slow.
+ part of the file/buffer, this can be expensive and slow. (It
+ is an error to request the `exact' method when the buffer's
+ EOL format is not yet decided.)
nil, in which case we may return nil rather than an approximation."
(unless coding-system (setq coding-system buffer-file-coding-system))
(let* ((eol (coding-system-eol-type coding-system))
- (lineno (if (= eol 1) (1- (line-number-at-pos position)) 0))
(type (coding-system-type coding-system))
(base (coding-system-base coding-system))
- (point-min 1)) ;Clarify what the `1' means.
+ (point-min 1) ;Clarify what the `1' means.
+ lineno)
+ ;; Handle EOL edge cases.
+ (unless (numberp eol)
+ (if (eq quality 'exact)
+ (error "Unknown EOL format in coding system: %s" coding-system)
+ (setq eol 0)))
+ (setq lineno (if (= eol 1)
+ (1- (line-number-at-pos position))
+ 0))
(and (eq type 'utf-8)
;; Any post-read/pre-write conversions mean it's not really UTF-8.
(not (null (coding-system-get coding-system :post-read-conversion)))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 52e743e6f3d..9cd38afd8be 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -32,7 +32,7 @@
(defconst mule-version "6.0 (HANACHIRUSATO)" "\
Version number and name of this version of MULE (multilingual environment).")
-(make-obsolete-variable 'mule-version nil "28.1")
+(make-obsolete-variable 'mule-version 'emacs-version "28.1")
(defconst mule-version-date "2003.9.1" "\
Distribution date of this version of MULE (multilingual environment).")
@@ -317,8 +317,9 @@ Return t if file exists."
(when purify-flag
(push (purecopy file) preloaded-file-list))
(unwind-protect
- (let ((load-file-name fullname)
- (set-auto-coding-for-load t)
+ (let ((load-true-file-name fullname)
+ (load-file-name fullname)
+ (set-auto-coding-for-load t)
(inhibit-file-name-operation nil))
(with-current-buffer buffer
;; So that we don't get completely screwed if the
@@ -490,27 +491,27 @@ per-character basis, this may not be accurate."
(cond
((listp cs-list)
(catch 'tag
- (mapc #'(lambda (charset)
- (if (encode-char char charset)
- (throw 'tag charset)))
+ (mapc (lambda (charset)
+ (if (encode-char char charset)
+ (throw 'tag charset)))
cs-list)
nil))
((eq cs-list 'iso-2022)
(catch 'tag2
- (mapc #'(lambda (charset)
- (if (and (plist-get (charset-plist charset)
- :iso-final-char)
- (encode-char char charset))
- (throw 'tag2 charset)))
+ (mapc (lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :iso-final-char)
+ (encode-char char charset))
+ (throw 'tag2 charset)))
charset-list)
nil))
((eq cs-list 'emacs-mule)
(catch 'tag3
- (mapc #'(lambda (charset)
- (if (and (plist-get (charset-plist charset)
- :emacs-mule-id)
- (encode-char char charset))
- (throw 'tag3 charset)))
+ (mapc (lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :emacs-mule-id)
+ (encode-char char charset))
+ (throw 'tag3 charset)))
charset-list)
nil)))))))))))
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 67ea00665fc..5d1311530a5 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -728,9 +728,9 @@ Available types are listed in the variable `quail-keyboard-layout-alist'."
:type (cons 'choice (mapcar (lambda (elt)
(list 'const (car elt)))
quail-keyboard-layout-alist))
- :set #'(lambda (symbol value)
- (quail-update-keyboard-layout value)
- (set symbol value)))
+ :set (lambda (symbol value)
+ (quail-update-keyboard-layout value)
+ (set symbol value)))
;;;###autoload
(defun quail-set-keyboard-layout (kbd-type)
@@ -1075,7 +1075,7 @@ The installed decode map can be referred by the function `quail-decode-map'."
KEY is a string meaning a sequence of keystrokes to be translated.
TRANSLATION is a character, a string, a vector, a Quail map,
a function, or a cons.
-It it is a character, it is the sole translation of KEY.
+If it is a character, it is the sole translation of KEY.
If it is a string, each character is a candidate for the translation.
If it is a vector, each element (string or character) is a candidate
for the translation.
@@ -1368,6 +1368,30 @@ If STR has `advice' text property, append the following special event:
(delete-region (overlay-start quail-overlay)
(overlay-end quail-overlay))))
+;; Quail puts keys back in `unread-command-events' to be re-read
+;; again, but these keys have already been recorded in recent-keys and
+;; in the keyboard macro, if one is being defined, which means that
+;; recording them again creates duplicates. This function is a
+;; wrapper around adding input events to `unread-command-events', but
+;; it makes sure these events will not be recorded a second time.
+(defun quail-add-unread-command-events (key &optional reset)
+ "Add KEY to `unread-command-events', but avoid recording it a second time.
+If KEY is a character, it is prepended to `unread-command-events' as
+a cons cell of the form (no-record . KEY).
+If KEY is a vector of events, the events in the vector are prepended
+to `unread-command-events', after converting each event to a cons cell
+of the form (no-record . EVENT).
+If RESET is non-nil, the events in `unread-command-events' are first
+discarded, i.e. in this case KEY will end up being the only key
+in `unread-command-events'."
+ (if reset (setq unread-command-events nil))
+ (setq unread-command-events
+ (if (characterp key)
+ (cons (cons 'no-record key) unread-command-events)
+ (append (mapcan (lambda (e) (list (cons 'no-record e)))
+ (append key nil))
+ unread-command-events))))
+
(defun quail-start-translation (key)
"Start translation of the typed character KEY by the current Quail package.
Return the input string."
@@ -1385,13 +1409,11 @@ Return the input string."
;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
- last-command-event last-command this-command inhibit-record)
+ last-command-event last-command this-command)
(setq quail-current-key ""
quail-current-str ""
quail-translating t)
- (if key
- (setq unread-command-events (cons key unread-command-events)
- inhibit-record t))
+ (if key (quail-add-unread-command-events key))
(while quail-translating
(set-buffer-modified-p modified-p)
(quail-show-guidance)
@@ -1400,13 +1422,8 @@ Return the input string."
(or input-method-previous-message "")
quail-current-str
quail-guidance-str)))
- ;; We inhibit record_char only for the first key,
- ;; because it was already recorded before read_char
- ;; called quail-input-method.
- (inhibit--record-char inhibit-record)
(keyseq (read-key-sequence prompt nil nil t))
(cmd (lookup-key (quail-translation-keymap) keyseq)))
- (setq inhibit-record nil)
(if (if key
(and (commandp cmd) (not (eq cmd 'quail-other-command)))
(eq cmd 'quail-self-insert-command))
@@ -1420,9 +1437,7 @@ Return the input string."
(quail-error (message "%s" (cdr err)) (beep))))
;; KEYSEQ is not defined in the translation keymap.
;; Let's return the event(s) to the caller.
- (setq unread-command-events
- (append (this-single-command-raw-keys)
- unread-command-events))
+ (quail-add-unread-command-events (this-single-command-raw-keys))
(setq quail-translating nil))))
(quail-delete-region)
quail-current-str)
@@ -1450,15 +1465,13 @@ Return the input string."
;; (generated-events nil) ;FIXME: What is this?
(input-method-function nil)
(modified-p (buffer-modified-p))
- last-command-event last-command this-command inhibit-record)
+ last-command-event last-command this-command)
(setq quail-current-key ""
quail-current-str ""
quail-translating t
quail-converting t
quail-conversion-str "")
- (if key
- (setq unread-command-events (cons key unread-command-events)
- inhibit-record t))
+ (if key (quail-add-unread-command-events key))
(while quail-converting
(set-buffer-modified-p modified-p)
(or quail-translating
@@ -1474,13 +1487,8 @@ Return the input string."
quail-conversion-str
quail-current-str
quail-guidance-str)))
- ;; We inhibit record_char only for the first key,
- ;; because it was already recorded before read_char
- ;; called quail-input-method.
- (inhibit--record-char inhibit-record)
(keyseq (read-key-sequence prompt nil nil t))
(cmd (lookup-key (quail-conversion-keymap) keyseq)))
- (setq inhibit-record nil)
(if (if key (commandp cmd) (eq cmd 'quail-self-insert-command))
(progn
(setq last-command-event (aref keyseq (1- (length keyseq)))
@@ -1503,9 +1511,7 @@ Return the input string."
(setq quail-converting nil)))))
;; KEYSEQ is not defined in the conversion keymap.
;; Let's return the event(s) to the caller.
- (setq unread-command-events
- (append (this-single-command-raw-keys)
- unread-command-events))
+ (quail-add-unread-command-events (this-single-command-raw-keys))
(setq quail-converting nil))))
(setq quail-translating nil)
(if (overlay-start quail-conv-overlay)
@@ -1551,9 +1557,8 @@ with more keys."
(or input-method-exit-on-first-char
(while (> len control-flag)
(setq len (1- len))
- (setq unread-command-events
- (cons (aref quail-current-key len)
- unread-command-events))))))
+ (quail-add-unread-command-events
+ (aref quail-current-key len))))))
((null control-flag)
(unless quail-current-str
(setq quail-current-str
@@ -1571,12 +1576,12 @@ with more keys."
(let (char)
(if (stringp quail-current-str)
(catch 'tag
- (mapc #'(lambda (ch)
- (when (/= (unibyte-char-to-multibyte
- (multibyte-char-to-unibyte ch))
- ch)
- (setq char ch)
- (throw 'tag nil)))
+ (mapc (lambda (ch)
+ (when (/= (unibyte-char-to-multibyte
+ (multibyte-char-to-unibyte ch))
+ ch)
+ (setq char ch)
+ (throw 'tag nil)))
quail-current-str))
(if (/= (unibyte-char-to-multibyte
(multibyte-char-to-unibyte quail-current-str))
@@ -1799,8 +1804,7 @@ sequence counting from the head."
(setcar indices (1+ (car indices)))
(quail-update-current-translations)
(quail-update-translation nil)))
- (setq unread-command-events
- (cons last-command-event unread-command-events))
+ (quail-add-unread-command-events last-command-event)
(quail-terminate-translation)))
(defun quail-prev-translation ()
@@ -1814,8 +1818,7 @@ sequence counting from the head."
(setcar indices (1- (car indices)))
(quail-update-current-translations)
(quail-update-translation nil)))
- (setq unread-command-events
- (cons last-command-event unread-command-events))
+ (quail-add-unread-command-events last-command-event)
(quail-terminate-translation)))
(defun quail-next-translation-block ()
@@ -1830,8 +1833,7 @@ sequence counting from the head."
(setcar indices (+ (nth 2 indices) offset))
(quail-update-current-translations)
(quail-update-translation nil)))
- (setq unread-command-events
- (cons last-command-event unread-command-events))
+ (quail-add-unread-command-events last-command-event)
(quail-terminate-translation)))
(defun quail-prev-translation-block ()
@@ -1850,8 +1852,7 @@ sequence counting from the head."
(setcar indices (+ (nth 1 indices) offset))
(quail-update-current-translations)))
(quail-update-translation nil)))
- (setq unread-command-events
- (cons last-command-event unread-command-events))
+ (quail-add-unread-command-events last-command-event)
(quail-terminate-translation)))
(defun quail-abort-translation ()
@@ -2006,8 +2007,8 @@ Remaining args are for FUNC."
(sit-for 1000000)
(delete-region point-max (point-max))
(when quit-flag
- (setq quit-flag nil
- unread-command-events '(7)))))
+ (setq quit-flag nil)
+ (quail-add-unread-command-events 7 t))))
(defun quail-show-guidance ()
"Display a guidance for Quail input method in some window.
@@ -2827,19 +2828,19 @@ If CHAR is an ASCII character and can be input by typing itself, return t."
(key-list nil))
(if (consp decode-map)
(let ((str (string char)))
- (mapc #'(lambda (elt)
- (if (string= str (car elt))
- (setq key-list (cons (cdr elt) key-list))))
+ (mapc (lambda (elt)
+ (if (string= str (car elt))
+ (setq key-list (cons (cdr elt) key-list))))
(cdr decode-map)))
(let ((key-head (aref decode-map char)))
(if (stringp key-head)
(setq key-list (quail-find-key1
(quail-lookup-key key-head nil t)
key-head char nil))
- (mapc #'(lambda (elt)
- (setq key-list
- (quail-find-key1
- (quail-lookup-key elt nil t) elt char key-list)))
+ (mapc (lambda (elt)
+ (setq key-list
+ (quail-find-key1
+ (quail-lookup-key elt nil t) elt char key-list)))
key-head))))
(or key-list
(and (< char 128)
@@ -3066,28 +3067,31 @@ of each directory."
;; Don't get fooled by commented-out code.
(while (re-search-forward "^[ \t]*(quail-define-package" nil t)
(goto-char (match-beginning 0))
- (condition-case nil
- (let ((form (read (current-buffer))))
- (with-current-buffer list-buf
- (insert
- (format "(register-input-method
+ (let (form)
+ (condition-case err
+ (progn
+ (setq form (read (current-buffer)))
+ (with-current-buffer list-buf
+ (insert
+ (format "(register-input-method
%S %S '%s
%S %S
%S)\n"
- (nth 1 form) ; PACKAGE-NAME
- (nth 2 form) ; LANGUAGE
- 'quail-use-package ; ACTIVATE-FUNC
- (nth 3 form) ; PACKAGE-TITLE
- (progn ; PACKAGE-DESCRIPTION (one line)
- (string-match ".*" (nth 5 form))
- (match-string 0 (nth 5 form)))
- (file-relative-name ; PACKAGE-FILENAME
- (file-name-sans-extension (car pkg-list))
- (car dirnames))))))
- (error
- ;; Ignore the remaining contents of this file.
- (goto-char (point-max))
- (message "Some part of \"%s\" is broken" (car pkg-list))))))
+ (nth 1 form) ; PACKAGE-NAME
+ (nth 2 form) ; LANGUAGE
+ 'quail-use-package ; ACTIVATE-FUNC
+ (nth 3 form) ; PACKAGE-TITLE
+ (progn ; PACKAGE-DESCRIPTION (one line)
+ (string-match ".*" (nth 5 form))
+ (match-string 0 (nth 5 form)))
+ (file-relative-name ; PACKAGE-FILENAME
+ (file-name-sans-extension (car pkg-list))
+ (car dirnames))))))
+ (error
+ ;; Ignore the remaining contents of this file.
+ (goto-char (point-max))
+ (message "Some part of \"%s\" is broken: %s in %s"
+ (car pkg-list) err form))))))
(setq pkg-list (cdr pkg-list)))
(setq quail-dirs (cdr quail-dirs) dirnames (cdr dirnames))))
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 64d66443760..ccb4c8390bb 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -781,7 +781,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(if val (setq trans (concat val trans)))
(puthash key trans table)
(forward-line 1)))
- (maphash #'(lambda (key val) (setq dic (cons (cons key val) dic)))
+ (maphash (lambda (key val) (setq dic (cons (cons key val) dic)))
table)))
(setq dic (sort dic (lambda (x y) (string< (car x ) (car y)))))
(dolist (elt dic)
@@ -931,18 +931,18 @@ method `chinese-tonepy' with which you must specify tones by digits
(if val (setq trans (vconcat val trans)))
(puthash key trans table)
(forward-line 1))
- (maphash #'(lambda (key trans)
- (let ((len (length trans))
- i)
- (if (and (= len 1) (= (length (aref trans 0)) 1))
- (setq trans (aref trans 0))
- (setq i 0)
- (while (and (< i len)
- (= (length (aref trans i)) 1))
- (setq i (1+ i)))
- (if (= i len)
- (setq trans (mapconcat #'identity trans "")))))
- (setq dic (cons (cons key trans) dic)))
+ (maphash (lambda (key trans)
+ (let ((len (length trans))
+ i)
+ (if (and (= len 1) (= (length (aref trans 0)) 1))
+ (setq trans (aref trans 0))
+ (setq i 0)
+ (while (and (< i len)
+ (= (length (aref trans i)) 1))
+ (setq i (1+ i)))
+ (if (= i len)
+ (setq trans (mapconcat #'identity trans "")))))
+ (setq dic (cons (cons key trans) dic)))
table)))
(setq dic (sort dic (lambda (x y) (string< (car x) (car y)))))
(goto-char (point-max))
diff --git a/lisp/isearch.el b/lisp/isearch.el
index b58ca8a6f70..922ab0f6ad4 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -26,7 +26,7 @@
;; Instructions
-;; For programmed use of isearch-mode, e.g. calling (isearch-forward),
+;; For programmed use of isearch-mode, e.g. calling `isearch-forward',
;; isearch-mode behaves modally and does not return until the search
;; is completed. It uses a recursive-edit to behave this way.
@@ -46,7 +46,7 @@
;; exits and searches in the last search direction.
;; Exiting immediately from isearch uses isearch-edit-string instead
-;; of nonincremental-search, if search-nonincremental-instead is non-nil.
+;; of nonincremental-search, if `search-nonincremental-instead' is non-nil.
;; The name of this option should probably be changed if we decide to
;; keep the behavior. No point in forcing nonincremental search until
;; the last possible moment.
@@ -172,6 +172,29 @@ This allows you to resume earlier Isearch sessions through the
command history."
:type 'boolean)
+(defcustom isearch-wrap-pause t
+ "Define the behavior of wrapping when there are no more matches.
+When `t' (by default), signal an error when no more matches are found.
+Then after repeating the search, wrap with `isearch-wrap-function'.
+When `no', wrap immediately after reaching the last match.
+When `no-ding', wrap immediately without flashing the screen.
+When `nil', never wrap, just stop at the last match."
+ :type '(choice (const :tag "Pause before wrapping" t)
+ (const :tag "No pause before wrapping" no)
+ (const :tag "No pause and no flashing" no-ding)
+ (const :tag "Disable wrapping" nil))
+ :version "28.1")
+
+(defcustom isearch-repeat-on-direction-change nil
+ "Whether a direction change should move to another match.
+When `nil', the default, a direction change moves point to the other
+end of the current search match.
+When `t', a direction change moves to another search match, if there
+is one."
+ :type '(choice (const :tag "Remain on the same match" nil)
+ (const :tag "Move to another match" t))
+ :version "28.1")
+
(defvar isearch-mode-hook nil
"Function(s) to call after starting up an incremental search.")
@@ -210,6 +233,7 @@ called with the positions of the start and the end of the text
matched by Isearch and replace commands. If this function
returns nil, Isearch and replace commands will continue searching
without stopping at resp. replacing this match.
+This function is expected to be careful not to clobber the match data.
If you use `add-function' to modify this variable, you can use the
`isearch-message-prefix' advice property to specify the prefix string
@@ -381,7 +405,7 @@ A value of nil means highlight all matches shown on the screen."
(integer :tag "Some"))
:group 'lazy-highlight)
-(defcustom lazy-highlight-buffer-max-at-a-time 20
+(defcustom lazy-highlight-buffer-max-at-a-time 200 ; 20 (bug#48581)
"Maximum matches to highlight at a time (for `lazy-highlight-buffer').
Larger values may reduce Isearch's responsiveness to user input;
smaller values make matches highlight slowly.
@@ -389,7 +413,7 @@ A value of nil means highlight all matches in the buffer."
:type '(choice (const :tag "All" nil)
(integer :tag "Some"))
:group 'lazy-highlight
- :version "27.1")
+ :version "28.1")
(defcustom lazy-highlight-buffer nil
"Controls the lazy-highlighting of the full buffer.
@@ -460,11 +484,11 @@ and doesn't remove full-buffer highlighting after a search."
(make-help-screen isearch-help-for-help-internal
(purecopy "Type a help option: [bkm] or ?")
"You have typed %THIS-KEY%, the help character. Type a Help option:
-\(Type \\<help-map>\\[help-quit] to exit the Help command.)
+\(Type \\<isearch-help-map>\\[help-quit] to exit the Help command.)
-b Display all Isearch key bindings.
-k KEYS Display full documentation of Isearch key sequence.
-m Display documentation of Isearch mode.
+\\[isearch-describe-bindings] Display all Isearch key bindings.
+\\[isearch-describe-key] KEYS Display full documentation of Isearch key sequence.
+\\[isearch-describe-mode] Display documentation of Isearch mode.
You can't type here other help keys available in the global help map,
but outside of this help window when you type them in Isearch mode,
@@ -527,159 +551,6 @@ This is like `describe-bindings', but displays only Isearch keys."
'(isearch-tmm-menubar tmm-menubar menu-bar-open mouse-minor-mode-menu)
"List of commands that can open a menu during Isearch.")
-(defvar isearch-menu-bar-yank-map
- (let ((map (make-sparse-keymap)))
- (define-key map [isearch-yank-pop]
- '(menu-item "Previous kill" isearch-yank-pop-only
- :help "Replace previous yanked kill on search string"))
- (define-key map [isearch-yank-kill]
- '(menu-item "Current kill" isearch-yank-kill
- :help "Append current kill to search string"))
- (define-key map [isearch-yank-until-char]
- '(menu-item "Until char..." isearch-yank-until-char
- :help "Yank from point to specified character into search string"))
- (define-key map [isearch-yank-line]
- '(menu-item "Rest of line" isearch-yank-line
- :help "Yank the rest of the current line on search string"))
- (define-key map [isearch-yank-symbol-or-char]
- '(menu-item "Symbol/char"
- isearch-yank-symbol-or-char
- :help "Yank next symbol or char on search string"))
- (define-key map [isearch-yank-word-or-char]
- '(menu-item "Word/char"
- isearch-yank-word-or-char
- :help "Yank next word or char on search string"))
- (define-key map [isearch-yank-char]
- '(menu-item "Char" isearch-yank-char
- :help "Yank char at point on search string"))
- map))
-
-(defvar isearch-menu-bar-map
- (let ((map (make-sparse-keymap "Isearch")))
- (define-key map [isearch-complete]
- '(menu-item "Complete current search string" isearch-complete
- :help "Complete current search string over search history"))
- (define-key map [isearch-complete-separator]
- '(menu-item "--"))
- (define-key map [isearch-query-replace-regexp]
- '(menu-item "Replace search string as regexp" isearch-query-replace-regexp
- :help "Replace matches for current search string as regexp"))
- (define-key map [isearch-query-replace]
- '(menu-item "Replace search string" isearch-query-replace
- :help "Replace matches for current search string"))
- (define-key map [isearch-occur]
- '(menu-item "Show all matches for search string" isearch-occur
- :help "Show all matches for current search string"))
- (define-key map [isearch-highlight-regexp]
- '(menu-item "Highlight all matches for search string"
- isearch-highlight-regexp
- :help "Highlight all matches for current search string"))
- (define-key map [isearch-search-replace-separator]
- '(menu-item "--"))
- (define-key map [isearch-transient-input-method]
- '(menu-item "Turn on transient input method"
- isearch-transient-input-method
- :help "Turn on transient input method for search"))
- (define-key map [isearch-toggle-specified-input-method]
- '(menu-item "Turn on specific input method"
- isearch-toggle-specified-input-method
- :help "Turn on specific input method for search"))
- (define-key map [isearch-toggle-input-method]
- '(menu-item "Toggle input method" isearch-toggle-input-method
- :help "Toggle input method for search"))
- (define-key map [isearch-input-method-separator]
- '(menu-item "--"))
- (define-key map [isearch-char-by-name]
- '(menu-item "Search for char by name" isearch-char-by-name
- :help "Search for character by name"))
- (define-key map [isearch-quote-char]
- '(menu-item "Search for literal char" isearch-quote-char
- :help "Search for literal char"))
- (define-key map [isearch-special-char-separator]
- '(menu-item "--"))
- (define-key map [isearch-toggle-word]
- '(menu-item "Word matching" isearch-toggle-word
- :help "Word matching"
- :button (:toggle
- . (eq isearch-regexp-function 'word-search-regexp))))
- (define-key map [isearch-toggle-symbol]
- '(menu-item "Symbol matching" isearch-toggle-symbol
- :help "Symbol matching"
- :button (:toggle
- . (eq isearch-regexp-function
- 'isearch-symbol-regexp))))
- (define-key map [isearch-toggle-regexp]
- '(menu-item "Regexp matching" isearch-toggle-regexp
- :help "Regexp matching"
- :button (:toggle . isearch-regexp)))
- (define-key map [isearch-toggle-invisible]
- '(menu-item "Invisible text matching" isearch-toggle-invisible
- :help "Invisible text matching"
- :button (:toggle . isearch-invisible)))
- (define-key map [isearch-toggle-char-fold]
- '(menu-item "Character folding matching" isearch-toggle-char-fold
- :help "Character folding matching"
- :button (:toggle
- . (eq isearch-regexp-function
- 'char-fold-to-regexp))))
- (define-key map [isearch-toggle-case-fold]
- '(menu-item "Case folding matching" isearch-toggle-case-fold
- :help "Case folding matching"
- :button (:toggle . isearch-case-fold-search)))
- (define-key map [isearch-toggle-lax-whitespace]
- '(menu-item "Lax whitespace matching" isearch-toggle-lax-whitespace
- :help "Lax whitespace matching"
- :button (:toggle . isearch-lax-whitespace)))
- (define-key map [isearch-toggle-separator]
- '(menu-item "--"))
- (define-key map [isearch-yank-menu]
- `(menu-item "Yank on search string" ,isearch-menu-bar-yank-map))
- (define-key map [isearch-edit-string]
- '(menu-item "Edit current search string" isearch-edit-string
- :help "Edit current search string"))
- (define-key map [isearch-ring-retreat]
- '(menu-item "Edit previous search string" isearch-ring-retreat
- :help "Edit previous search string in Isearch history"))
- (define-key map [isearch-ring-advance]
- '(menu-item "Edit next search string" isearch-ring-advance
- :help "Edit next search string in Isearch history"))
- (define-key map [isearch-del-char]
- '(menu-item "Delete last char from search string" isearch-del-char
- :help "Delete last character from search string"))
- (define-key map [isearch-delete-char]
- '(menu-item "Undo last input item" isearch-delete-char
- :help "Undo the effect of the last Isearch command"))
- (define-key map [isearch-end-of-buffer]
- '(menu-item "Go to last match" isearch-end-of-buffer
- :help "Go to last occurrence of current search string"))
- (define-key map [isearch-beginning-of-buffer]
- '(menu-item "Go to first match" isearch-beginning-of-buffer
- :help "Go to first occurrence of current search string"))
- (define-key map [isearch-repeat-backward]
- '(menu-item "Repeat search backward" isearch-repeat-backward
- :help "Repeat current search backward"))
- (define-key map [isearch-repeat-forward]
- '(menu-item "Repeat search forward" isearch-repeat-forward
- :help "Repeat current search forward"))
- (define-key map [isearch-nonincremental]
- '(menu-item "Nonincremental search" isearch-exit
- :help "Start nonincremental search"
- :visible (string-equal isearch-string "")))
- (define-key map [isearch-exit]
- '(menu-item "Finish search" isearch-exit
- :help "Finish search leaving point where it is"
- :visible (not (string-equal isearch-string ""))))
- (define-key map [isearch-abort]
- '(menu-item "Remove characters not found" isearch-abort
- :help "Quit current search"
- :visible (not isearch-success)))
- (define-key map [isearch-cancel]
- `(menu-item "Cancel search" isearch-cancel
- :help "Cancel current search and return to starting point"
- :filter ,(lambda (binding)
- (if isearch-success 'isearch-abort binding))))
- map))
-
;; Note: Before adding more key bindings to this map, please keep in
;; mind that any unbound key exits Isearch and runs the command bound
;; to it in the local or global map. So in effect every key unbound
@@ -795,13 +666,116 @@ This is like `describe-bindings', but displays only Isearch keys."
;; The key translations defined in the C-x 8 prefix should add
;; characters to the search string. See iso-transl.el.
(define-key map "\C-x8\r" 'isearch-char-by-name)
-
- (define-key map [menu-bar search-menu]
- (list 'menu-item "Isearch" isearch-menu-bar-map))
-
map)
"Keymap for `isearch-mode'.")
+(easy-menu-define isearch-menu-bar-map isearch-mode-map
+ "Menu for `isearch-mode'."
+ '("Isearch"
+ ["Cancel search" isearch-cancel
+ :help "Cancel current search and return to starting point"
+ :filter (lambda (binding)
+ (if isearch-success 'isearch-abort binding))]
+ ["Remove characters not found" isearch-abort
+ :help "Quit current search"
+ :visible (not isearch-success)]
+ ["Finish search" isearch-exit
+ :help "Finish search leaving point where it is"
+ :visible (not (string-equal isearch-string ""))]
+ ["Nonincremental search" isearch-exit
+ :help "Start nonincremental search"
+ :visible (string-equal isearch-string "")]
+ ["Repeat search forward" isearch-repeat-forward
+ :help "Repeat current search forward"]
+ ["Repeat search backward" isearch-repeat-backward
+ :help "Repeat current search backward"]
+ ["Go to first match" isearch-beginning-of-buffer
+ :help "Go to first occurrence of current search string"]
+ ["Go to last match" isearch-end-of-buffer
+ :help "Go to last occurrence of current search string"]
+ ["Undo last input item" isearch-delete-char
+ :help "Undo the effect of the last Isearch command"]
+ ["Delete last char from search string" isearch-del-char
+ :help "Delete last character from search string"]
+ ["Edit next search string" isearch-ring-advance
+ :help "Edit next search string in Isearch history"]
+ ["Edit previous search string" isearch-ring-retreat
+ :help "Edit previous search string in Isearch history"]
+ ["Edit current search string" isearch-edit-string
+ :help "Edit current search string"]
+ ("Yank on search string"
+ ["Char" isearch-yank-char
+ :help "Yank char at point on search string"]
+ ["Word/char"
+ isearch-yank-word-or-char
+ :help "Yank next word or char on search string"]
+ ["Symbol/char"
+ isearch-yank-symbol-or-char
+ :help "Yank next symbol or char on search string"]
+ ["Rest of line" isearch-yank-line
+ :help "Yank the rest of the current line on search string"]
+ ["Until char..." isearch-yank-until-char
+ :help "Yank from point to specified character into search string"]
+ ["Current kill" isearch-yank-kill
+ :help "Append current kill to search string"]
+ ["Previous kill" isearch-yank-pop-only
+ :help "Replace previous yanked kill on search string"])
+ "---"
+ ["Lax whitespace matching" isearch-toggle-lax-whitespace
+ :help "Lax whitespace matching"
+ :style toggle
+ :selected isearch-lax-whitespace]
+ ["Case folding matching" isearch-toggle-case-fold
+ :help "Case folding matching"
+ :style toggle
+ :selected isearch-case-fold-search]
+ ["Character folding matching" isearch-toggle-char-fold
+ :help "Character folding matching"
+ :style toggle
+ :selected (eq isearch-regexp-function
+ 'char-fold-to-regexp)]
+ ["Invisible text matching" isearch-toggle-invisible
+ :help "Invisible text matching"
+ :style toggle
+ :selected isearch-invisible]
+ ["Regexp matching" isearch-toggle-regexp
+ :help "Regexp matching"
+ :style toggle
+ :selected isearch-regexp]
+ ["Symbol matching" isearch-toggle-symbol
+ :help "Symbol matching"
+ :style toggle
+ :selected (eq isearch-regexp-function
+ 'isearch-symbol-regexp)]
+ ["Word matching" isearch-toggle-word
+ :help "Word matching"
+ :style toggle
+ :selected (eq isearch-regexp-function 'word-search-regexp)]
+ "---"
+ ["Search for literal char" isearch-quote-char
+ :help "Search for literal char"]
+ ["Search for char by name" isearch-char-by-name
+ :help "Search for character by name"]
+ "---"
+ ["Toggle input method" isearch-toggle-input-method
+ :help "Toggle input method for search"]
+ ["Turn on specific input method" isearch-toggle-specified-input-method
+ :help "Turn on specific input method for search"]
+ ["Turn on transient input method" isearch-transient-input-method
+ :help "Turn on transient input method for search"]
+ "---"
+ ["Highlight all matches for search string" isearch-highlight-regexp
+ :help "Highlight all matches for current search string"]
+ ["Show all matches for search string" isearch-occur
+ :help "Show all matches for current search string"]
+ ["Replace search string" isearch-query-replace
+ :help "Replace matches for current search string"]
+ ["Replace search string as regexp" isearch-query-replace-regexp
+ :help "Replace matches for current search string as regexp"]
+ "---"
+ ["Complete current search string" isearch-complete
+ :help "Complete current search string over search history"]))
+
(defvar isearch-tool-bar-old-map nil
"Variable holding the old local value of `tool-bar-map', if any.")
@@ -999,12 +973,13 @@ Each element is an `isearch--state' struct where the slots are
(defvar-local isearch-mode nil) ;; Name of the minor mode, if non-nil.
(define-key global-map "\C-s" 'isearch-forward)
-(define-key esc-map "\C-s" 'isearch-forward-regexp)
+(define-key esc-map "\C-s" 'isearch-forward-regexp)
(define-key global-map "\C-r" 'isearch-backward)
-(define-key esc-map "\C-r" 'isearch-backward-regexp)
-(define-key search-map "w" 'isearch-forward-word)
-(define-key search-map "_" 'isearch-forward-symbol)
-(define-key search-map "." 'isearch-forward-symbol-at-point)
+(define-key esc-map "\C-r" 'isearch-backward-regexp)
+(define-key search-map "w" 'isearch-forward-word)
+(define-key search-map "_" 'isearch-forward-symbol)
+(define-key search-map "." 'isearch-forward-symbol-at-point)
+(define-key search-map "\M-." 'isearch-forward-thing-at-point)
;; Entry points to isearch-mode.
@@ -1184,6 +1159,42 @@ positive, or search for ARGth symbol backward if ARG is negative."
(isearch-push-state)
(isearch-update)))))
+(defcustom isearch-forward-thing-at-point '(region url symbol sexp)
+ "A list of symbols to try to get the \"thing\" at point.
+Each element of the list should be one of the symbols supported by
+`bounds-of-thing-at-point'. This variable is used by the command
+`isearch-forward-thing-at-point' to yank the initial \"thing\"
+as text to the search string."
+ :type '(repeat (symbol :tag "Thing symbol"))
+ :version "28.1")
+
+(defun isearch-forward-thing-at-point ()
+ "Do incremental search forward for the \"thing\" found near point.
+Like ordinary incremental search except that the \"thing\" found at point
+is added to the search string initially. The \"thing\" is defined by
+`bounds-of-thing-at-point'. You can customize the variable
+`isearch-forward-thing-at-point' to define a list of symbols to try
+to find a \"thing\" at point. For example, when the list contains
+the symbol `region' and the region is active, then text from the
+active region is added to the search string."
+ (interactive)
+ (isearch-forward nil 1)
+ (let ((bounds (seq-some (lambda (thing)
+ (bounds-of-thing-at-point thing))
+ isearch-forward-thing-at-point)))
+ (cond
+ (bounds
+ (when (use-region-p)
+ (deactivate-mark))
+ (when (< (car bounds) (point))
+ (goto-char (car bounds)))
+ (isearch-yank-string
+ (buffer-substring-no-properties (car bounds) (cdr bounds))))
+ (t
+ (setq isearch-error "No thing at point")
+ (isearch-push-state)
+ (isearch-update)))))
+
;; isearch-mode only sets up incremental search for the minor mode.
;; All the work is done by the isearch-mode commands.
@@ -1364,7 +1375,8 @@ The last thing is to trigger a new round of lazy highlighting."
;; the X coordinate it returns is 1 pixel beyond
;; the last visible one.
(>= (car visible-p)
- (* (window-max-chars-per-line) (frame-char-width))))
+ (* (window-max-chars-per-line) (frame-char-width)))
+ (< (car visible-p) 0))
(set-window-hscroll (selected-window) current-scroll))))
(if isearch-other-end
(if (< isearch-other-end (point)) ; isearch-forward?
@@ -1499,7 +1511,7 @@ REGEXP if non-nil says use the regexp search ring."
(apply 'propertize string properties))
(defun isearch-update-from-string-properties (string)
- "Update isearch properties from the isearch string"
+ "Update isearch properties from the isearch STRING."
(when (plist-member (text-properties-at 0 string) 'isearch-case-fold-search)
(setq isearch-case-fold-search
(get-text-property 0 'isearch-case-fold-search string)))
@@ -1877,14 +1889,15 @@ Use `isearch-exit' to quit without signaling."
;; After taking the last element, adjust ring to previous one.
(isearch-ring-adjust1 nil))
;; If already have what to search for, repeat it.
- (or isearch-success
- (progn
- ;; Set isearch-wrapped before calling isearch-wrap-function
- (setq isearch-wrapped t)
- (if isearch-wrap-function
- (funcall isearch-wrap-function)
- (goto-char (if isearch-forward (point-min) (point-max)))))))
+ (unless (or isearch-success (null isearch-wrap-pause))
+ ;; Set isearch-wrapped before calling isearch-wrap-function
+ (setq isearch-wrapped t)
+ (if isearch-wrap-function
+ (funcall isearch-wrap-function)
+ (goto-char (if isearch-forward (point-min) (point-max))))))
;; C-s in reverse or C-r in forward, change direction.
+ (if (and isearch-other-end isearch-repeat-on-direction-change)
+ (goto-char isearch-other-end))
(setq isearch-forward (not isearch-forward)
isearch-success t))
@@ -1894,7 +1907,8 @@ Use `isearch-exit' to quit without signaling."
(setq isearch-success t)
;; For the case when count > 1, don't keep intermediate states
;; added to isearch-cmds by isearch-push-state in this loop.
- (let ((isearch-cmds isearch-cmds))
+ (let ((isearch-cmds isearch-cmds)
+ (was-success isearch-success))
(while (<= 0 (setq count (1- (or count 1))))
(if (and isearch-success
(equal (point) isearch-other-end)
@@ -1909,13 +1923,26 @@ Use `isearch-exit' to quit without signaling."
(forward-char (if isearch-forward 1 -1))
(isearch-search))
(isearch-search))
- (when (> count 0)
- ;; Update isearch-cmds, so if isearch-search fails later,
- ;; it can restore old successful state from isearch-cmds.
- (isearch-push-state))
- ;; Stop looping on failure.
- (when (or (not isearch-success) isearch-error)
- (setq count 0)))))
+ (when (> count 0)
+ ;; Update isearch-cmds, so if isearch-search fails later,
+ ;; it can restore old successful state from isearch-cmds.
+ (isearch-push-state))
+ (cond
+ ;; Wrap immediately and repeat the search again
+ ((memq isearch-wrap-pause '(no no-ding))
+ (if isearch-success
+ (setq was-success isearch-success)
+ ;; If failed this time after succeeding last time
+ (when was-success
+ (setq was-success nil)
+ (setq count (1+ count)) ;; Increment to force repeat
+ (setq isearch-wrapped t)
+ (if isearch-wrap-function
+ (funcall isearch-wrap-function)
+ (goto-char (if isearch-forward (point-min) (point-max)))))))
+ ;; Stop looping on failure
+ (t (when (or (not isearch-success) isearch-error)
+ (setq count 0)))))))
(isearch-push-state)
(isearch-update))
@@ -1934,10 +1961,12 @@ of the buffer, type \\[isearch-beginning-of-buffer] with a numeric argument."
(cond ((< count 0)
(isearch-repeat-backward (abs count))
;; Reverse the direction back
- (isearch-repeat 'forward))
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat 'forward)))
(t
;; Take into account one iteration to reverse direction
- (when (not isearch-forward) (setq count (1+ count)))
+ (unless isearch-repeat-on-direction-change
+ (when (not isearch-forward) (setq count (1+ count))))
(isearch-repeat 'forward count))))
(isearch-repeat 'forward)))
@@ -1955,10 +1984,12 @@ of the buffer, type \\[isearch-end-of-buffer] with a numeric argument."
(cond ((< count 0)
(isearch-repeat-forward (abs count))
;; Reverse the direction back
- (isearch-repeat 'backward))
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat 'backward)))
(t
;; Take into account one iteration to reverse direction
- (when isearch-forward (setq count (1+ count)))
+ (unless isearch-repeat-on-direction-change
+ (when isearch-forward (setq count (1+ count))))
(isearch-repeat 'backward count))))
(isearch-repeat 'backward)))
@@ -2508,7 +2539,7 @@ If search string is empty, just beep."
"Read a string from the `kill-ring' and append it to the search string."
(interactive)
(with-isearch-suspended
- (let ((string (read-from-kill-ring)))
+ (let ((string (read-from-kill-ring "Yank from kill-ring: ")))
(if (and isearch-case-fold-search
(eq 'not-yanks search-upper-case))
(setq string (downcase string)))
@@ -2536,7 +2567,7 @@ minibuffer to read a string from the `kill-ring' as `yank-pop' does."
Unlike `isearch-yank-pop', when this command is called not immediately
after a `isearch-yank-kill' or a `isearch-yank-pop-only', it only pops
the last killed string instead of activating the minibuffer to read
-a string from the `kill-ring' as `yank-pop' does. The prefix arg C-u
+a string from the `kill-ring' as `yank-pop' does. The prefix arg \\[universal-argument]
always reads a string from the `kill-ring' using the minibuffer."
(interactive "P")
(cond
@@ -2569,7 +2600,9 @@ Otherwise invoke whatever the calling mouse-2 command sequence
is bound to outside of Isearch."
(interactive "e")
(let ((w (posn-window (event-start click)))
- (binding (let ((overriding-terminal-local-map nil))
+ (binding (let ((overriding-terminal-local-map nil)
+ ;; Key search depends on mode (bug#47755)
+ (isearch-mode nil))
(key-binding (this-command-keys-vector) t))))
(if (and (window-minibuffer-p w)
(not (minibuffer-window-active-p w))) ; in echo area
@@ -2695,7 +2728,7 @@ With argument, add COUNT copies of the character."
string ""))))))))
(defun isearch-search-and-update ()
- ;; Do the search and update the display.
+ "Do the search and update the display."
(when (or isearch-success
;; Unsuccessful regexp search may become successful by
;; addition of characters which make isearch-string valid
@@ -3227,7 +3260,7 @@ If there is no completion possible, say so and continue searching."
;; Message string
(defun isearch-message (&optional c-q-hack ellipsis)
- ;; Generate and print the message string.
+ "Generate and print the message string."
;; N.B.: This function should always be called with point at the
;; search point, because in certain (rare) circumstances, undesired
@@ -3356,7 +3389,7 @@ the word mode."
(defun isearch-lazy-count-format (&optional suffix-p)
"Format the current match number and the total number of matches.
-When SUFFIX-P is non-nil, the returned string is indended for
+When SUFFIX-P is non-nil, the returned string is intended for
isearch-message-suffix prompt. Otherwise, for isearch-message-prefix."
(let ((format-string (if suffix-p
lazy-count-suffix-format
@@ -3474,14 +3507,13 @@ Optional third argument, if t, means if fail just return nil (no error).
(when pos1
;; When using multiple buffers isearch, switch to the new buffer here,
;; because `save-excursion' above doesn't allow doing it inside funcall.
- (if (and multi-isearch-next-buffer-current-function
- (buffer-live-p multi-isearch-current-buffer))
- (switch-to-buffer multi-isearch-current-buffer))
+ (when multi-isearch-next-buffer-current-function
+ (multi-isearch-switch-buffer))
(goto-char pos1)
pos1)))
(defun isearch-search ()
- ;; Do the search with the current search string.
+ "Do the search with the current search string."
(if (and (eq isearch-case-fold-search t) search-upper-case)
(setq isearch-case-fold-search
(isearch-no-upper-case-p isearch-string isearch-regexp)))
@@ -3498,11 +3530,14 @@ Optional third argument, if t, means if fail just return nil (no error).
;; Clear RETRY unless the search predicate says
;; to skip this search hit.
(if (or (not isearch-success)
- (bobp) (eobp)
- (= (match-beginning 0) (match-end 0))
(funcall isearch-filter-predicate
(match-beginning 0) (match-end 0)))
- (setq retry nil)))
+ (setq retry nil)
+ ;; Advance point on empty matches before retrying
+ (when (= (match-beginning 0) (match-end 0))
+ (if (if isearch-forward (eobp) (bobp))
+ (setq retry nil isearch-success nil)
+ (forward-char (if isearch-forward 1 -1))))))
(setq isearch-just-started nil)
(when isearch-success
(setq isearch-other-end
@@ -3538,10 +3573,10 @@ Optional third argument, if t, means if fail just return nil (no error).
;; stack overflow in regexp search.
(setq isearch-error (format "%s" lossage))))
- (if isearch-success
- nil
+ (unless isearch-success
;; Ding if failed this time after succeeding last time.
(and (isearch--state-success (car isearch-cmds))
+ (not (eq isearch-wrap-pause 'no-ding))
(ding))
(if (functionp (isearch--state-pop-fun (car isearch-cmds)))
(funcall (isearch--state-pop-fun (car isearch-cmds))
@@ -4013,7 +4048,6 @@ Attempt to do the search exactly the way the pending Isearch would."
;; Clear RETRY unless the search predicate says
;; to skip this search hit.
(if (or (not success)
- (= (point) bound) ; like (bobp) (eobp) in `isearch-search'.
(= (match-beginning 0) (match-end 0))
(funcall isearch-filter-predicate
(match-beginning 0) (match-end 0)))
@@ -4127,13 +4161,13 @@ Attempt to do the search exactly the way the pending Isearch would."
"Update highlighting of other matches in the full buffer."
(let ((max lazy-highlight-buffer-max-at-a-time)
(looping t)
- nomore window-start window-end
- (opoint (point)))
+ nomore opoint window-start window-end)
(with-local-quit
(save-selected-window
(if (and (window-live-p isearch-lazy-highlight-window)
(not (memq (selected-window) isearch-lazy-highlight-window-group)))
(select-window isearch-lazy-highlight-window))
+ (setq opoint (point))
(setq window-start (window-group-start))
(setq window-end (window-group-end))
(save-excursion
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index 3713879e3b6..eaf7983cbd8 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -1,4 +1,4 @@
-;;; isearchb --- a marriage between iswitchb and isearch
+;;; isearchb.el --- a marriage between iswitchb and isearch -*- lexical-binding: t -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -7,7 +7,6 @@
;; Created: 16 Apr 2004
;; Version: 1.5
;; Keywords: lisp
-;; X-URL: http://www.newartisans.com/johnw/emacs.html
;; This file is part of GNU Emacs.
@@ -89,13 +88,11 @@
"Number of idle seconds before isearchb turns itself off.
If nil, don't use a timeout."
:type '(choice (integer :tag "Seconds")
- (const :tag "Disable" nil))
- :group 'isearchb)
+ (const :tag "Disable" nil)))
(defcustom isearchb-show-completions t
"If non-nil, show possible completions in the minibuffer."
- :type 'boolean
- :group 'isearchb)
+ :type 'boolean)
(defvar isearchb-start-buffer nil)
(defvar isearchb-last-buffer nil)
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index d169e40b817..a1287926eb9 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -105,7 +105,7 @@ This means those subsequent lines are refontified to reflect their new
syntactic context, after `jit-lock-context-time' seconds.
If any other value, e.g., `syntax-driven', it means refontification of
subsequent lines to reflect their new syntactic context may or may not
-occur after `jit-lock-context-time', depending on the the font-lock
+occur after `jit-lock-context-time', depending on the font-lock
definitions of the buffer. Specifically, if `font-lock-keywords-only'
is nil in a buffer, which generally means the syntactic fontification
is done using the buffer mode's syntax table, the syntactic
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 11d93a6df9a..6933a7c1d06 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -104,6 +104,9 @@ Otherwise, it is nil.")
(defun jka-compr-info-can-append (info) (aref info 7))
(defun jka-compr-info-strip-extension (info) (aref info 8))
(defun jka-compr-info-file-magic-bytes (info) (aref info 9))
+(defun jka-compr-info-uncompress-function (info)
+ (and (> (length info) 10)
+ (aref info 10)))
(defun jka-compr-get-compression-info (filename)
@@ -197,13 +200,15 @@ options through Custom does this automatically."
;;[regexp
;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args
- ;; can-append strip-extension-flag file-magic-bytes]
+ ;; can-append strip-extension-flag file-magic-bytes
+ ;; uncompress-function]
(mapcar 'purecopy
'(["\\.Z\\'"
"compressing" "compress" ("-c")
;; gzip is more common than uncompress. It can only read, not write.
"uncompressing" "gzip" ("-c" "-q" "-d")
- nil t "\037\235"]
+ nil t "\037\235"
+ zlib-decompress-region]
;; Formerly, these had an additional arg "-c", but that fails with
;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
;; "Version 0.9.0b, 9-Sept-98".
@@ -218,11 +223,13 @@ options through Custom does this automatically."
["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
- t nil "\037\213"]
+ t nil "\037\213"
+ zlib-decompress-region]
["\\.g?z\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
- t t "\037\213"]
+ t t "\037\213"
+ zlib-decompress-region]
["\\.lz\\'"
"Lzip compressing" "lzip" ("-c" "-q")
"Lzip uncompressing" "lzip" ("-c" "-q" "-d")
@@ -259,7 +266,7 @@ options through Custom does this automatically."
Each element, which describes a compression technique, is a vector of
the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
-APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
+APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS UNCOMPRESS-FUNCTION], where:
regexp is a regexp that matches filenames that are
compressed with this format
@@ -275,7 +282,7 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
uncompress-msg is the message to issue to the user when doing this
type of uncompression (nil means no message)
- uncompress-program is a program that performs this compression
+ uncompress-program is a program that performs this uncompression
uncompress-args is a list of args to pass to the uncompress program
@@ -288,6 +295,9 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
file-magic-chars is a string of characters that you would find
at the beginning of a file compressed in this way.
+ uncompress-function is a function that performs uncompression, if
+ uncompress-program is not found.
+
If you set this outside Custom while Auto Compression mode is
already enabled \(as it is by default), you have to call
`jka-compr-update' after setting it to properly update other
@@ -309,9 +319,12 @@ variables. Setting this through Custom does that automatically."
(repeat :tag "Uncompress Arguments" string)
(boolean :tag "Append")
(boolean :tag "Strip Extension")
- (string :tag "Magic Bytes")))
+ (string :tag "Magic Bytes")
+ (choice :tag "Uncompress Function"
+ (symbol)
+ (const :tag "None" nil))))
:set 'jka-compr-set
- :version "24.1" ; removed version extension piece
+ :version "28.1" ; add uncompress-function
:group 'jka-compr)
(defcustom jka-compr-mode-alist-additions
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 8aebcd0ec4d..658ea44a348 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,7 +1,6 @@
-;;; jka-compr.el --- reading/writing/loading compressed files
+;;; jka-compr.el --- reading/writing/loading compressed files -*- lexical-binding: t; -*-
-;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
;; Author: Jay K. Adams <jka@ece.cmu.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -120,7 +119,7 @@ data appears to be compressed already.")
(widen) (erase-buffer)
(insert (format "Error while executing \"%s %s < %s\"\n\n"
prog
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
infile))
(and errfile
@@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning."
(format
"%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s"
prog
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
err-file
jka-compr-dd-program
jka-compr-dd-blocksize
@@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning."
"-c"
(format "%s %s 2> %s %s"
prog
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
err-file
(if (stringp output)
(concat "> " output)
@@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning."
(jka-compr-error prog args infile message err-file))
(delete-file err-file)))
(or (eq 0
- (apply 'call-process
+ (apply #'call-process
prog infile (if (stringp output) temp output)
nil args))
(jka-compr-error prog args infile message))
@@ -387,6 +386,7 @@ There should be no more than seven characters after the final `/'."
(let ((uncompress-message (jka-compr-info-uncompress-message info))
(uncompress-program (jka-compr-info-uncompress-program info))
+ (uncompress-function (jka-compr-info-uncompress-function info))
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory filename))
(notfound nil)
@@ -410,58 +410,76 @@ There should be no more than seven characters after the final `/'."
jka-compr-verbose
(message "%s %s..." uncompress-message base-name))
- (condition-case error-code
-
- (let ((coding-system-for-read 'no-conversion))
- (if replace
- (goto-char (point-min)))
- (setq start (point))
- (if (or beg end)
- (jka-compr-partial-uncompress uncompress-program
- (concat uncompress-message
- " " base-name)
- uncompress-args
- local-file
- (or beg 0)
- (if (and beg end)
- (- end beg)
- end))
- ;; If visiting, bind off buffer-file-name so that
- ;; file-locking will not ask whether we should
- ;; really edit the buffer.
- (let ((buffer-file-name
- (if visit nil buffer-file-name)))
- (jka-compr-call-process uncompress-program
- (concat uncompress-message
- " " base-name)
- local-file
- t
- nil
- uncompress-args)))
- (setq size (- (point) start))
- (if replace
- (delete-region (point) (point-max)))
- (goto-char start))
- (error
- ;; If the file we wanted to uncompress does not exist,
- ;; handle that according to VISIT as `insert-file-contents'
- ;; would, maybe signaling the same error it normally would.
- (if (and (eq (car error-code) 'file-missing)
- (eq (nth 3 error-code) local-file))
- (if visit
- (setq notfound error-code)
- (signal 'file-missing
- (cons "Opening input file"
- (nthcdr 2 error-code))))
- ;; If the uncompression program can't be found,
- ;; signal that as a non-file error
- ;; so that find-file-noselect-1 won't handle it.
- (if (and (memq 'file-error (get (car error-code)
- 'error-conditions))
- (equal (cadr error-code) "Searching for program"))
- (error "Uncompression program `%s' not found"
- (nth 3 error-code)))
- (signal (car error-code) (cdr error-code))))))
+ (if (and (not (executable-find uncompress-program))
+ uncompress-function
+ (fboundp uncompress-function))
+ ;; If we don't have the uncompression program, then use the
+ ;; internal uncompression function (if we have one).
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (funcall uncompress-function (point-min) (point-max))
+ (when end
+ (delete-region end (point-max)))
+ (when beg
+ (delete-region (point-min) beg))
+ (setq size (buffer-size))
+ (insert-into-buffer buf))
+ (goto-char (point-min)))
+ ;; Use the external uncompression program.
+ (condition-case error-code
+
+ (let ((coding-system-for-read 'no-conversion))
+ (if replace
+ (goto-char (point-min)))
+ (setq start (point))
+ (if (or beg end)
+ (jka-compr-partial-uncompress
+ uncompress-program
+ (concat uncompress-message " " base-name)
+ uncompress-args
+ local-file
+ (or beg 0)
+ (if (and beg end)
+ (- end beg)
+ end))
+ ;; If visiting, bind off buffer-file-name so that
+ ;; file-locking will not ask whether we should
+ ;; really edit the buffer.
+ (let ((buffer-file-name
+ (if visit nil buffer-file-name)))
+ (jka-compr-call-process uncompress-program
+ (concat uncompress-message
+ " " base-name)
+ local-file
+ t
+ nil
+ uncompress-args)))
+ (setq size (- (point) start))
+ (if replace
+ (delete-region (point) (point-max)))
+ (goto-char start))
+ (error
+ ;; If the file we wanted to uncompress does not exist,
+ ;; handle that according to VISIT as `insert-file-contents'
+ ;; would, maybe signaling the same error it normally would.
+ (if (and (eq (car error-code) 'file-missing)
+ (eq (nth 3 error-code) local-file))
+ (if visit
+ (setq notfound error-code)
+ (signal 'file-missing
+ (cons "Opening input file"
+ (nthcdr 2 error-code))))
+ ;; If the uncompression program can't be found,
+ ;; signal that as a non-file error
+ ;; so that find-file-noselect-1 won't handle it.
+ (if (and (memq 'file-error (get (car error-code)
+ 'error-conditions))
+ (equal (cadr error-code) "Searching for program"))
+ (error "Uncompression program `%s' not found"
+ (nth 3 error-code)))
+ (signal (car error-code) (cdr error-code)))))))
(and
local-copy
@@ -622,12 +640,12 @@ There should be no more than seven characters after the final `/'."
(substring file 0 (string-match (jka-compr-info-regexp info) file)))
file)))
-(put 'write-region 'jka-compr 'jka-compr-write-region)
-(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
-(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
-(put 'load 'jka-compr 'jka-compr-load)
+(put 'write-region 'jka-compr #'jka-compr-write-region)
+(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents)
+(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy)
+(put 'load 'jka-compr #'jka-compr-load)
(put 'byte-compiler-base-file-name 'jka-compr
- 'jka-compr-byte-compiler-base-file-name)
+ #'jka-compr-byte-compiler-base-file-name)
;;;###autoload
(defvar jka-compr-inhibit nil
@@ -649,7 +667,7 @@ It is not recommended to set this variable permanently to anything but nil.")
;; to prevent the primitive from calling our handler again.
(defun jka-compr-run-real-handler (operation args)
(let ((inhibit-file-name-handlers
- (cons 'jka-compr-handler
+ (cons #'jka-compr-handler
(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
@@ -660,7 +678,7 @@ It is not recommended to set this variable permanently to anything but nil.")
"Uninstall jka-compr.
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
and `inhibit-local-variables-suffixes' that were added
-by `jka-compr-installed'."
+by `jka-compr-install'."
;; Delete from inhibit-local-variables-suffixes what jka-compr-install added.
(mapc
(lambda (x)
@@ -674,7 +692,7 @@ by `jka-compr-installed'."
(last fnha))
(while (cdr last)
- (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
+ (if (eq (cdr (car (cdr last))) #'jka-compr-handler)
(setcdr last (cdr (cdr last)))
(setq last (cdr last))))
diff --git a/lisp/json.el b/lisp/json.el
index 1f1f608eaba..0e61e1ad90c 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -26,7 +26,7 @@
;; This is a library for parsing and generating JSON (JavaScript Object
;; Notation).
-;; Learn all about JSON here: <URL:http://json.org/>.
+;; Learn all about JSON here: <URL:https://json.org/>.
;; The user-serviceable entry points for the parser are the functions
;; `json-read' and `json-read-from-string'. The encoder has a single
@@ -40,6 +40,17 @@
;; Similarly, since `false' and `null' are distinct in JSON, you can
;; distinguish them by binding `json-false' and `json-null' as desired.
+;;; Organization:
+
+;; Historically json.el used the prefix `json-read-' for decoding and
+;; the prefix `json-encode-' for encoding. Many of these definitions
+;; are used by external packages since few were marked as internal.
+;; Optimizing the encoder to manipulate a buffer rather than strings
+;; while minimizing code duplication therefore necessitated a new
+;; namespace `json--print-'. This rendered many encoding functions
+;; obsolete and unused, but those considered externally useful are
+;; kept for backward compatibility and as a public API.
+
;;; History:
;; 2006-03-11 - Initial version.
@@ -57,7 +68,7 @@
(require 'map)
(require 'subr-x)
-;; Parameters
+;;;; Parameters
(defvar json-object-type 'alist
"Type to convert JSON objects to.
@@ -102,13 +113,22 @@ this around your call to `json-read' instead of `setq'ing it.")
"Value to use as an element separator when encoding.")
(defvar json-encoding-default-indentation " "
- "The default indentation level for encoding.
+ "String used for a single indentation level during encoding.
+This value is repeated for each further nested element.
+Used only when `json-encoding-pretty-print' is non-nil.")
+
+(defvar json--print-indentation-prefix "\n"
+ "String used to start indentation during encoding.
Used only when `json-encoding-pretty-print' is non-nil.")
-(defvar json--encoding-current-indentation "\n"
- "Internally used to keep track of the current indentation level of encoding.
+(defvar json--print-indentation-depth 0
+ "Current indentation level during encoding.
+Dictates repetitions of `json-encoding-default-indentation'.
Used only when `json-encoding-pretty-print' is non-nil.")
+(defvar json--print-keyval-separator ":"
+ "String used to separate key-value pairs during encoding.")
+
(defvar json-encoding-pretty-print nil
"If non-nil, then the output of `json-encode' will be pretty-printed.")
@@ -137,7 +157,7 @@ respectively, with no arguments.")
-;;; Utilities
+;;;; Utilities
(define-obsolete-function-alias 'json-join #'string-join "28.1")
@@ -169,18 +189,38 @@ destructively modify PLIST to produce the result."
(setcdr (cdr plist) prev)))
plist)
+;; Encoder utilities
+
+(defmacro json--with-output-to-string (&rest body)
+ "Eval BODY in a temporary buffer bound to `standard-output'.
+Return the resulting buffer contents as a string."
+ (declare (indent 0) (debug t))
+ `(with-output-to-string
+ (with-current-buffer standard-output
+ ;; This affords decent performance gains.
+ (setq-local inhibit-modification-hooks t)
+ ,@body)))
+
(defmacro json--with-indentation (&rest body)
- "Evaluate BODY with the correct indentation for JSON encoding.
-This macro binds `json--encoding-current-indentation' according
-to `json-encoding-pretty-print' around BODY."
+ "Eval BODY with the JSON encoding nesting incremented by one step.
+This macro sets up appropriate variable bindings for
+`json--print-indentation' to produce the correct indentation when
+`json-encoding-pretty-print' is non-nil."
(declare (debug t) (indent 0))
- `(let ((json--encoding-current-indentation
- (if json-encoding-pretty-print
- (concat json--encoding-current-indentation
- json-encoding-default-indentation)
- "")))
+ `(let ((json--print-indentation-prefix
+ (if json-encoding-pretty-print json--print-indentation-prefix ""))
+ (json--print-keyval-separator (if json-encoding-pretty-print ": " ":"))
+ (json--print-indentation-depth (1+ json--print-indentation-depth)))
,@body))
+(defun json--print-indentation ()
+ "Insert the current indentation for JSON encoding at point.
+Has no effect if `json-encoding-pretty-print' is nil."
+ (when json-encoding-pretty-print
+ (insert json--print-indentation-prefix)
+ (dotimes (_ json--print-indentation-depth)
+ (insert json-encoding-default-indentation))))
+
;; Reader utilities
(define-inline json-advance (&optional n)
@@ -210,8 +250,6 @@ Signal `json-end-of-file' if called at the end of the buffer."
;; definition of whitespace in JSON.
(inline-quote (skip-chars-forward "\t\n\r ")))
-
-
;; Error conditions
(define-error 'json-error "Unknown JSON error")
@@ -228,7 +266,7 @@ Signal `json-end-of-file' if called at the end of the buffer."
-;;; Paths
+;;;; Paths
(defvar json--path '()
"Keeps track of the path during recursive calls to `json-read'.
@@ -283,7 +321,9 @@ element in a deeply nested structure."
(when (plist-get path :path)
path))))
-;;; Keywords
+
+
+;;;; Keywords
(defconst json-keywords '("true" "false" "null")
"List of JSON keywords.")
@@ -316,7 +356,13 @@ element in a deeply nested structure."
((eq keyword json-false) "false")
((eq keyword json-null) "null")))
-;;; Numbers
+(defun json--print-keyword (keyword)
+ "Insert KEYWORD as a JSON value at point.
+Return nil if KEYWORD is not recognized as a JSON keyword."
+ (prog1 (setq keyword (json-encode-keyword keyword))
+ (and keyword (insert keyword))))
+
+;;;; Numbers
;; Number parsing
@@ -339,10 +385,9 @@ element in a deeply nested structure."
;; Number encoding
-(defalias 'json-encode-number #'number-to-string
- "Return a JSON representation of NUMBER.")
+(define-obsolete-function-alias 'json-encode-number #'json-encode "28.1")
-;;; Strings
+;;;; Strings
(defconst json-special-chars
'((?\" . ?\")
@@ -410,58 +455,52 @@ element in a deeply nested structure."
;; String encoding
-;; Escape only quotation mark, backslash, and the control
-;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
-(rx-define json--escape (in ?\" ?\\ cntrl))
-
-(defvar json--long-string-threshold 200
- "Length above which strings are considered long for JSON encoding.
-It is generally faster to manipulate such strings in a buffer
-rather than directly.")
-
-(defvar json--string-buffer nil
- "Buffer used for encoding Lisp strings as JSON.
-Initialized lazily by `json-encode-string'.")
+(defun json--print-string (string &optional from)
+ "Insert a JSON representation of STRING at point.
+FROM is the index of STRING to start from and defaults to 0."
+ (insert ?\")
+ (goto-char (prog1 (point) (princ string)))
+ (and from (delete-char from))
+ ;; Escape only quotation mark, backslash, and the control
+ ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+ (while (re-search-forward (rx (in ?\" ?\\ cntrl)) nil 'move)
+ (let ((char (preceding-char)))
+ (delete-char -1)
+ (insert ?\\ (or
+ ;; Special JSON character (\n, \r, etc.).
+ (car (rassq char json-special-chars))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "u%04x" char)))))
+ (insert ?\")
+ string)
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- ;; Try to avoid buffer overhead in trivial cases, while also
- ;; avoiding searching pathological strings for escape characters.
- ;; Since `string-match-p' doesn't take a LIMIT argument, we use
- ;; string length as our heuristic. See also bug#20154.
- (if (and (< (length string) json--long-string-threshold)
- (not (string-match-p (rx json--escape) string)))
- (concat "\"" (substring-no-properties string) "\"")
- (with-current-buffer
- (or json--string-buffer
- (with-current-buffer (generate-new-buffer " *json-string*" t)
- ;; This seems to afford decent performance gains.
- (setq-local inhibit-modification-hooks t)
- (setq json--string-buffer (current-buffer))))
- (insert ?\" (substring-no-properties string)) ; see bug#43549
- (goto-char (1+ (point-min)))
- (while (re-search-forward (rx json--escape) nil 'move)
- (let ((char (preceding-char)))
- (delete-char -1)
- (insert ?\\ (or
- ;; Special JSON character (\n, \r, etc.).
- (car (rassq char json-special-chars))
- ;; Fallback: UCS code point in \uNNNN form.
- (format "u%04x" char)))))
- (insert ?\")
- ;; Empty buffer for next invocation.
- (delete-and-extract-region (point-min) (point-max)))))
+ (json--with-output-to-string (json--print-string string)))
+
+(defun json--print-stringlike (object)
+ "Insert OBJECT encoded as a JSON string at point.
+Return nil if OBJECT cannot be encoded as a JSON string."
+ (cond ((stringp object) (json--print-string object))
+ ((keywordp object) (json--print-string (symbol-name object) 1))
+ ((symbolp object) (json--print-string (symbol-name object)))))
+
+(defun json--print-key (object)
+ "Insert a JSON key representation of OBJECT at point.
+Signal `json-key-format' if it cannot be encoded as a string."
+ (or (json--print-stringlike object)
+ (signal 'json-key-format (list object))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
If the resulting JSON object isn't a valid JSON object key,
this signals `json-key-format'."
- (let ((encoded (json-encode object)))
- (unless (stringp (json-read-from-string encoded))
- (signal 'json-key-format (list object)))
- encoded))
+ (declare (obsolete json-encode "28.1"))
+ (json--with-output-to-string (json--print-key object)))
-;;; Objects
+;;;; Objects
+
+;; JSON object parsing
(defun json-new-object ()
"Create a new Elisp object corresponding to an empty JSON object.
@@ -494,8 +533,6 @@ Please see the documentation of `json-object-type' and `json-key-type'."
((eq json-object-type 'plist)
(cons key (cons value object))))))
-;; JSON object parsing
-
(defun json-read-object ()
"Read the JSON object at point."
;; Skip over the '{'.
@@ -530,95 +567,81 @@ Please see the documentation of `json-object-type' and `json-key-type'."
('plist (json--plist-nreverse elements))
(_ elements))))
+;; JSON object encoding
+
+(defun json--print-pair (key val)
+ "Insert JSON representation of KEY-VAL pair at point.
+This always inserts a trailing `json-encoding-separator'."
+ (json--print-indentation)
+ (json--print-key key)
+ (insert json--print-keyval-separator)
+ (json--print val)
+ (insert json-encoding-separator))
+
+(defun json--print-map (map)
+ "Insert JSON object representation of MAP at point.
+This works for any MAP satisfying `mapp'."
+ (insert ?\{)
+ (unless (map-empty-p map)
+ (json--with-indentation
+ (map-do #'json--print-pair map)
+ (delete-char (- (length json-encoding-separator))))
+ (or json-encoding-lisp-style-closings
+ (json--print-indentation)))
+ (insert ?\}))
+
+(defun json--print-unordered-map (map)
+ "Like `json--print-map', but optionally sort MAP first.
+If `json-encoding-object-sort-predicate' is non-nil, this first
+transforms an unsortable MAP into a sortable alist."
+ (if (and json-encoding-object-sort-predicate
+ (not (map-empty-p map)))
+ (json--print-alist (map-pairs map) t)
+ (json--print-map map)))
+
;; Hash table encoding
-(defun json-encode-hash-table (hash-table)
- "Return a JSON representation of HASH-TABLE."
- (cond ((hash-table-empty-p hash-table) "{}")
- (json-encoding-object-sort-predicate
- (json--encode-alist (map-pairs hash-table) t))
- (t
- (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
- result)
- (json--with-indentation
- (maphash
- (lambda (k v)
- (push (concat json--encoding-current-indentation
- (json-encode-key k)
- kv-sep
- (json-encode v))
- result))
- hash-table))
- (concat "{"
- (string-join (nreverse result) json-encoding-separator)
- (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings)
- json--encoding-current-indentation)
- "}")))))
+(define-obsolete-function-alias 'json-encode-hash-table #'json-encode "28.1")
;; List encoding (including alists and plists)
-(defun json--encode-alist (alist &optional destructive)
- "Return a JSON representation of ALIST.
-DESTRUCTIVE non-nil means it is safe to modify ALIST by
-side-effects."
- (when json-encoding-object-sort-predicate
- (setq alist (sort (if destructive alist (copy-sequence alist))
- (lambda (a b)
- (funcall json-encoding-object-sort-predicate
- (car a) (car b))))))
- (concat "{"
- (let ((kv-sep (if json-encoding-pretty-print ": " ":")))
- (json--with-indentation
- (mapconcat (lambda (cons)
- (concat json--encoding-current-indentation
- (json-encode-key (car cons))
- kv-sep
- (json-encode (cdr cons))))
- alist
- json-encoding-separator)))
- (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings)
- json--encoding-current-indentation)
- "}"))
+(defun json--print-alist (alist &optional destructive)
+ "Insert a JSON representation of ALIST at point.
+Sort ALIST first if `json-encoding-object-sort-predicate' is
+non-nil. Sorting can optionally be DESTRUCTIVE for speed."
+ (json--print-map (if (and json-encoding-object-sort-predicate alist)
+ (sort (if destructive alist (copy-sequence alist))
+ (lambda (a b)
+ (funcall json-encoding-object-sort-predicate
+ (car a) (car b))))
+ alist)))
+
+;; The following two are unused but useful to keep around due to the
+;; inherent ambiguity of lists.
(defun json-encode-alist (alist)
"Return a JSON representation of ALIST."
- (if alist (json--encode-alist alist) "{}"))
+ (json--with-output-to-string (json--print-alist alist)))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
- (cond ((null plist) "{}")
- (json-encoding-object-sort-predicate
- (json--encode-alist (map-pairs plist) t))
- (t
- (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
- result)
- (json--with-indentation
- (while plist
- (push (concat json--encoding-current-indentation
- (json-encode-key (pop plist))
- kv-sep
- (json-encode (pop plist)))
- result)))
- (concat "{"
- (string-join (nreverse result) json-encoding-separator)
- (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings)
- json--encoding-current-indentation)
- "}")))))
+ (json--with-output-to-string (json--print-unordered-map plist)))
+
+(defun json--print-list (list)
+ "Like `json-encode-list', but insert the JSON at point."
+ (cond ((json-alist-p list) (json--print-alist list))
+ ((json-plist-p list) (json--print-unordered-map list))
+ ((listp list) (json--print-array list))
+ ((signal 'json-error (list list)))))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
-Tries to DWIM: simple lists become JSON arrays, while alists and plists
-become JSON objects."
- (cond ((json-alist-p list) (json-encode-alist list))
- ((json-plist-p list) (json-encode-plist list))
- ((listp list) (json-encode-array list))
- (t
- (signal 'json-error (list list)))))
+Tries to DWIM: alists and plists become JSON objects, while
+simple lists become JSON arrays."
+ (declare (obsolete json-encode "28.1"))
+ (json--with-output-to-string (json--print-list list)))
-;;; Arrays
+;;;; Arrays
;; Array parsing
@@ -651,29 +674,32 @@ become JSON objects."
;; Array encoding
+(defun json--print-array (array)
+ "Like `json-encode-array', but insert the JSON at point."
+ (insert ?\[)
+ (unless (length= array 0)
+ (json--with-indentation
+ (json--print-indentation)
+ (let ((first t))
+ (mapc (lambda (elt)
+ (if first
+ (setq first nil)
+ (insert json-encoding-separator)
+ (json--print-indentation))
+ (json--print elt))
+ array)))
+ (or json-encoding-lisp-style-closings
+ (json--print-indentation)))
+ (insert ?\]))
+
(defun json-encode-array (array)
- "Return a JSON representation of ARRAY."
- (if (and json-encoding-pretty-print
- (if (listp array)
- array
- (> (length array) 0)))
- (concat
- "["
- (json--with-indentation
- (concat json--encoding-current-indentation
- (mapconcat #'json-encode array
- (concat json-encoding-separator
- json--encoding-current-indentation))))
- (unless json-encoding-lisp-style-closings
- json--encoding-current-indentation)
- "]")
- (concat "["
- (mapconcat #'json-encode array json-encoding-separator)
- "]")))
+ "Return a JSON representation of ARRAY.
+ARRAY can also be a list."
+ (json--with-output-to-string (json--print-array array)))
-;;; Reader
+;;;; Reader
(defmacro json-readtable-dispatch (char)
"Dispatch reader function for CHAR at point.
@@ -729,7 +755,17 @@ you will get the following structure returned:
-;;; Encoder
+;;;; Encoder
+
+(defun json--print (object)
+ "Like `json-encode', but insert or print the JSON at point."
+ (cond ((json--print-keyword object))
+ ((listp object) (json--print-list object))
+ ((json--print-stringlike object))
+ ((numberp object) (prin1 object))
+ ((arrayp object) (json--print-array object))
+ ((hash-table-p object) (json--print-unordered-map object))
+ ((signal 'json-error (list object)))))
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string.
@@ -737,21 +773,9 @@ you will get the following structure returned:
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
`json-error' is signaled."
- (cond ((eq object t) (json-encode-keyword object))
- ((eq object json-null) (json-encode-keyword object))
- ((eq object json-false) (json-encode-keyword object))
- ((stringp object) (json-encode-string object))
- ((keywordp object) (json-encode-string
- (substring (symbol-name object) 1)))
- ((listp object) (json-encode-list object))
- ((symbolp object) (json-encode-string
- (symbol-name object)))
- ((numberp object) (json-encode-number object))
- ((arrayp object) (json-encode-array object))
- ((hash-table-p object) (json-encode-hash-table object))
- (t (signal 'json-error (list object)))))
-
-;;; Pretty printing & minimizing
+ (json--with-output-to-string (json--print object)))
+
+;;;; Pretty printing & minimizing
(defun json-pretty-print-buffer (&optional minimize)
"Pretty-print current buffer.
@@ -762,7 +786,7 @@ With prefix argument MINIMIZE, minimize it instead."
(defvar json-pretty-print-max-secs 2.0
"Maximum time for `json-pretty-print's comparison.
The function `json-pretty-print' uses `replace-region-contents'
-(which see) passing the value of this variable as argument
+\(which see) passing the value of this variable as argument
MAX-SECS.")
(defun json-pretty-print (begin end &optional minimize)
@@ -774,6 +798,8 @@ With prefix argument MINIMIZE, minimize it instead."
(json-null :json-null)
;; Ensure that ordering is maintained.
(json-object-type 'alist)
+ ;; Ensure that keys survive roundtrip (bug#24252, bug#42545).
+ (json-key-type 'string)
(orig-buf (current-buffer))
error)
;; Strategy: Repeatedly `json-read' from the original buffer and
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 7f5aa8295fe..f1fb6c1ddaf 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -10,18 +10,20 @@
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 303f38a59b6..8821e35c2d1 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -167,53 +167,53 @@ macro to be executed before appending to it."
(defvar kmacro-keymap
(let ((map (make-sparse-keymap)))
;; Start, end, execute macros
- (define-key map "s" 'kmacro-start-macro)
- (define-key map "\C-s" 'kmacro-start-macro)
- (define-key map "\C-k" 'kmacro-end-or-call-macro-repeat)
- (define-key map "r" 'apply-macro-to-region-lines)
- (define-key map "q" 'kbd-macro-query) ;; Like C-x q
- (define-key map "Q" 'kdb-macro-redisplay)
+ (define-key map "s" #'kmacro-start-macro)
+ (define-key map "\C-s" #'kmacro-start-macro)
+ (define-key map "\C-k" #'kmacro-end-or-call-macro-repeat)
+ (define-key map "r" #'apply-macro-to-region-lines)
+ (define-key map "q" #'kbd-macro-query) ;; Like C-x q
+ (define-key map "Q" #'kdb-macro-redisplay)
;; macro ring
- (define-key map "\C-n" 'kmacro-cycle-ring-next)
- (define-key map "\C-p" 'kmacro-cycle-ring-previous)
- (define-key map "\C-v" 'kmacro-view-macro-repeat)
- (define-key map "\C-d" 'kmacro-delete-ring-head)
- (define-key map "\C-t" 'kmacro-swap-ring)
- (define-key map "\C-l" 'kmacro-call-ring-2nd-repeat)
+ (define-key map "\C-n" #'kmacro-cycle-ring-next)
+ (define-key map "\C-p" #'kmacro-cycle-ring-previous)
+ (define-key map "\C-v" #'kmacro-view-macro-repeat)
+ (define-key map "\C-d" #'kmacro-delete-ring-head)
+ (define-key map "\C-t" #'kmacro-swap-ring)
+ (define-key map "\C-l" #'kmacro-call-ring-2nd-repeat)
;; macro counter
- (define-key map "\C-f" 'kmacro-set-format)
- (define-key map "\C-c" 'kmacro-set-counter)
- (define-key map "\C-i" 'kmacro-insert-counter)
- (define-key map "\C-a" 'kmacro-add-counter)
+ (define-key map "\C-f" #'kmacro-set-format)
+ (define-key map "\C-c" #'kmacro-set-counter)
+ (define-key map "\C-i" #'kmacro-insert-counter)
+ (define-key map "\C-a" #'kmacro-add-counter)
;; macro editing
- (define-key map "\C-e" 'kmacro-edit-macro-repeat)
- (define-key map "\r" 'kmacro-edit-macro)
- (define-key map "e" 'edit-kbd-macro)
- (define-key map "l" 'kmacro-edit-lossage)
- (define-key map " " 'kmacro-step-edit-macro)
+ (define-key map "\C-e" #'kmacro-edit-macro-repeat)
+ (define-key map "\r" #'kmacro-edit-macro)
+ (define-key map "e" #'edit-kbd-macro)
+ (define-key map "l" #'kmacro-edit-lossage)
+ (define-key map " " #'kmacro-step-edit-macro)
;; naming and binding
- (define-key map "b" 'kmacro-bind-to-key)
- (define-key map "n" 'kmacro-name-last-macro)
- (define-key map "x" 'kmacro-to-register)
+ (define-key map "b" #'kmacro-bind-to-key)
+ (define-key map "n" #'kmacro-name-last-macro)
+ (define-key map "x" #'kmacro-to-register)
map)
"Keymap for keyboard macro commands.")
(defalias 'kmacro-keymap kmacro-keymap)
;;; Provide some binding for startup:
-;;;###autoload (global-set-key "\C-x(" 'kmacro-start-macro)
-;;;###autoload (global-set-key "\C-x)" 'kmacro-end-macro)
-;;;###autoload (global-set-key "\C-xe" 'kmacro-end-and-call-macro)
-;;;###autoload (global-set-key [f3] 'kmacro-start-macro-or-insert-counter)
-;;;###autoload (global-set-key [f4] 'kmacro-end-or-call-macro)
-;;;###autoload (global-set-key "\C-x\C-k" 'kmacro-keymap)
+;;;###autoload (global-set-key "\C-x(" #'kmacro-start-macro)
+;;;###autoload (global-set-key "\C-x)" #'kmacro-end-macro)
+;;;###autoload (global-set-key "\C-xe" #'kmacro-end-and-call-macro)
+;;;###autoload (global-set-key [f3] #'kmacro-start-macro-or-insert-counter)
+;;;###autoload (global-set-key [f4] #'kmacro-end-or-call-macro)
+;;;###autoload (global-set-key "\C-x\C-k" #'kmacro-keymap)
;;;###autoload (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap)
(if kmacro-call-mouse-event
- (global-set-key (vector kmacro-call-mouse-event) 'kmacro-end-call-mouse))
+ (global-set-key (vector kmacro-call-mouse-event) #'kmacro-end-call-mouse))
;;; Called from keyboard-quit
@@ -482,7 +482,7 @@ without repeating the prefix."
(defun kmacro-view-ring-2nd ()
- "Display the current head of the keyboard macro ring."
+ "Display the second macro in the keyboard macro ring."
(interactive)
(unless (kmacro-ring-empty-p)
(kmacro-display (car (car kmacro-ring)) nil "2nd macro")))
@@ -668,11 +668,13 @@ use \\[kmacro-name-last-macro]."
(set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map (vector repeat-key)
- `(lambda () (interactive)
- (kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg)
- 'repeating nil ,(if end-macro
- last-kbd-macro
- (or macro last-kbd-macro)))))
+ (let ((ra (and kmacro-call-repeat-with-arg arg))
+ (m (if end-macro
+ last-kbd-macro
+ (or macro last-kbd-macro))))
+ (lambda ()
+ (interactive)
+ (kmacro-call-macro ra 'repeating nil m))))
map)))))
@@ -782,23 +784,36 @@ If kbd macro currently being defined end it before activating it."
;;;###autoload
(defun kmacro-lambda-form (mac &optional counter format)
"Create lambda form for macro bound to symbol or key."
- (if counter
- (setq mac (list mac counter format)))
- `(lambda (&optional arg)
- "Keyboard macro."
- (interactive "p")
- (kmacro-exec-ring-item ',mac arg)))
+ ;; Apparently, there are two different ways this is called:
+ ;; either `counter' and `format' are both provided and `mac' is a vector,
+ ;; or only `mac' is provided, as a list (MAC COUNTER FORMAT).
+ ;; The first is used from `insert-kbd-macro' and `edmacro-finish-edit',
+ ;; while the second is used from within this file.
+ (let ((mac (if counter (list mac counter format) mac)))
+ ;; FIXME: This should be a "funcallable struct"!
+ (lambda (&optional arg)
+ "Keyboard macro."
+ ;; We put an "unused prompt" as a special marker so
+ ;; `kmacro-extract-lambda' can see it's "one of us".
+ (interactive "pkmacro")
+ (if (eq arg 'kmacro--extract-lambda)
+ (cons 'kmacro--extract-lambda mac)
+ (kmacro-exec-ring-item mac arg)))))
(defun kmacro-extract-lambda (mac)
"Extract kmacro from a kmacro lambda form."
- (and (eq (car-safe mac) 'lambda)
- (setq mac (assoc 'kmacro-exec-ring-item mac))
- (setq mac (car-safe (cdr-safe (car-safe (cdr-safe mac)))))
- (listp mac)
- (= (length mac) 3)
- (arrayp (car mac))
- mac))
-
+ (let ((mac (cond
+ ((eq (car-safe mac) 'lambda)
+ (let ((e (assoc 'kmacro-exec-ring-item mac)))
+ (car-safe (cdr-safe (car-safe (cdr-safe e))))))
+ ((and (functionp mac)
+ (equal (interactive-form mac) '(interactive "pkmacro")))
+ (let ((r (funcall mac 'kmacro--extract-lambda)))
+ (and (eq (car-safe r) 'kmacro--extract-lambda) (cdr r)))))))
+ (and (consp mac)
+ (= (length mac) 3)
+ (arrayp (car mac))
+ mac)))
(defalias 'kmacro-p #'kmacro-extract-lambda
"Return non-nil if MAC is a kmacro keyboard macro.")
@@ -965,7 +980,7 @@ without repeating the prefix."
"Edit most recent 300 keystrokes as a keyboard macro."
(interactive)
(kmacro-push-ring)
- (edit-kbd-macro "\C-hl"))
+ (edit-kbd-macro (car (where-is-internal 'view-lossage))))
;;; Single-step editing of keyboard macros
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index 373f25ac5ca..ade3566717b 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -55,3 +55,5 @@
(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))
+
+;;; burmese.el ends here
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index 3aac986b437..cbb35565af2 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -43,3 +43,5 @@ an Austronesian language spoken by some 245,000 Chams
in Vietnam and Cambodia.")))
(provide 'cham)
+
+;;; cham.el ends here
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index c12096f95eb..b64a237cf73 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -33,7 +33,7 @@
;; are converted to Unicode internally. See
;; <URL:http://www.ecma.ch/ecma1/STAND/ECMA-113.HTM>. For more info
;; on Cyrillic charsets, see
-;; <URL:http://czyborra.com/charsets/cyrillic.html>. The KOI and
+;; <URL:https://czyborra.com/charsets/cyrillic.html>. The KOI and
;; Alternativnyj coding systems should live in code-pages.el, but
;; they've always been preloaded and the coding system autoload
;; mechanism didn't get accepted, so they have to stay here and
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index fa31cd5f9f8..dc385b07d3e 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -98,48 +98,74 @@
;; users' preference
;;
-(defvar ethio-primary-language 'tigrigna
+(defgroup ethiopic nil
+ "Options for writing Ethiopic."
+ :version "28.1"
+ :group 'languages)
+
+(defcustom ethio-primary-language 'tigrigna
"Symbol that defines the primary language in SERA --> FIDEL conversion.
-The value should be one of: `tigrigna', `amharic' or `english'.")
+The value should be one of: `tigrigna', `amharic' or `english'."
+ :version "28.1"
+ :type '(choice (const :tag "Tigrigna" tigrigna)
+ (const :tag "Amharic" amharic)
+ (const :tag "English" english)))
-(defvar ethio-secondary-language 'english
+(defcustom ethio-secondary-language 'english
"Symbol that defines the secondary language in SERA --> FIDEL conversion.
-The value should be one of: `tigrigna', `amharic' or `english'.")
+The value should be one of: `tigrigna', `amharic' or `english'."
+ :version "28.1"
+ :type '(choice (const :tag "Tigrigna" tigrigna)
+ (const :tag "Amharic" amharic)
+ (const :tag "English" english)))
-(defvar ethio-use-colon-for-colon nil
+(defcustom ethio-use-colon-for-colon nil
"Non-nil means associate ASCII colon with Ethiopic colon.
If nil, associate ASCII colon with Ethiopic word separator, i.e., two
vertically stacked dots. All SERA <--> FIDEL converters refer this
-variable.")
+variable."
+ :version "28.1"
+ :type 'boolean)
-(defvar ethio-use-three-dot-question nil
+(defcustom ethio-use-three-dot-question nil
"If non-nil, associate ASCII question mark with Ethiopic question mark.
The Ethiopic old style question mark is three vertically stacked dots.
If nil, associate ASCII question mark with Ethiopic stylized question
-mark. All SERA <--> FIDEL converters refer this variable.")
+mark. All SERA <--> FIDEL converters refer this variable."
+ :version "28.1"
+ :type 'boolean)
-(defvar ethio-quote-vowel-always nil
+(defcustom ethio-quote-vowel-always nil
"Non-nil means always put an apostrophe before an isolated vowel.
This happens in FIDEL --> SERA conversions. Isolated vowels at
word beginning do not get an apostrophe put before them.
If nil, put an apostrophe only between a 6th-form consonant and an
-isolated vowel.")
+isolated vowel."
+ :version "28.1"
+ :type 'boolean)
-(defvar ethio-W-sixth-always nil
+(defcustom ethio-W-sixth-always nil
"Non-nil means convert the Wu-form of a 12-form consonant to \"W'\".
-This is instead of \"Wu\" in FIDEL --> SERA conversion.")
+This is instead of \"Wu\" in FIDEL --> SERA conversion."
+ :version "28.1"
+ :type 'boolean)
-(defvar ethio-numeric-reduction 0
+(defcustom ethio-numeric-reduction 0
"Degree of reduction in converting Ethiopic digits into Arabic digits.
Should be 0, 1 or 2.
For example, ({10}{9}{100}{80}{7}) is converted into:
\\=`10\\=`9\\=`100\\=`80\\=`7 if `ethio-numeric-reduction' is 0,
\\=`109100807 if `ethio-numeric-reduction' is 1,
- \\=`10900807 if `ethio-numeric-reduction' is 2.")
+ \\=`10900807 if `ethio-numeric-reduction' is 2."
+ :version "28.1"
+ :type 'integer)
-(defvar ethio-java-save-lowercase nil
+(defcustom ethio-java-save-lowercase nil
"Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
-If nil, use uppercases.")
+If nil, use uppercases."
+ :version "28.1"
+ :type 'boolean)
+
(defun ethio-prefer-amharic-p ()
(or (eq ethio-primary-language 'amharic)
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 948bfef9f22..f3e3590645b 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -96,9 +96,9 @@ HANKAKU-KATAKANA belongs to `japanese-jisx0201-kana'.")
(put-char-code-property jisx0201 'jisx0208 katakana)))))
(defconst japanese-symbol-table
- '((?\  ?\ ) (?, ?, ?、) (?. ?. ?。) (?、 ?, ?、) (?。 ?. ?。) (?・ nil ?・)
+ '((?\  ?\ ) (?, ?,) (?. ?.) (?、 nil ?、) (?。 nil ?。) (?・ nil ?・)
(?: ?:) (?; ?\;) (?? ??) (?! ?!) (?゛ nil ?゙) (?゜ nil ?゚)
- (?´ ?') (?` ?`) (?^ ?^) (?_ ?_) (?ー ?- ?ー) (?— ?-) (?‐ ?-)
+ (?´ ?') (?` ?`) (?^ ?^) (?_ ?_) (?ー nil ?ー) (?— ?-) (?‐ ?-)
(?/ ?/) (?\ ?\\) (?〜 ?~) (?| ?|) (?‘ ?`) (?’ ?') (?“ ?\") (?” ?\")
(?\( ?\() (?\) ?\)) (?\[ ?\[) (?\] ?\]) (?\{ ?{) (?\} ?})
(?〈 ?<) (?〉 ?>) (?\「 nil ?\「) (?\」 nil ?\」)
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index 6f08e60d601..471af401656 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -35,4 +35,4 @@
(set-char-table-range composition-function-table '(#x1780 . #x17FF) val)
(set-char-table-range composition-function-table '(#x19E0 . #x19FF) val))
-;; khmer.el ends here
+;;; khmer.el ends here
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index b999eff662f..121a4c542e7 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -29,7 +29,7 @@
;;;###autoload
(defvar default-korean-keyboard
- (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
+ (purecopy (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
"3"
""))
"The kind of Korean keyboard for Korean (Hangul) input method.
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index 99a104ec339..89392ad6c50 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -45,4 +45,4 @@
"[\u0D80-\u0DFF]")
0 #'font-shape-gstring)))
-;; sinhala.el ends here
+;;; sinhala.el ends here
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index 4549b111a3d..366c39202d3 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -56,3 +56,5 @@ The language name is spelled as \"ꪁꪫꪱꪣ ꪼꪕ\", and the script name is
spelled as \"ꪎꪳ ꪼꪕ\".")))
(provide 'tai-viet)
+
+;;; tai-viet.el ends here
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index ff1e80298ba..5d0389c28df 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -1,4 +1,4 @@
-;;; thai-word.el -- find Thai word boundaries -*- lexical-binding: t; -*-
+;;; thai-word.el --- find Thai word boundaries -*- lexical-binding: t; -*-
;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -11074,4 +11074,4 @@ With argument, do this that many times."
;; coding: utf-8
;; End:
-;; end of thai-word.el
+;;; thai-word.el ends here
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index 1a530d350f2..207d76f47c1 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -136,5 +136,6 @@
(if (looking-at tai-viet-re)
(tai-viet-compose-region from (match-end 0)))))
-;;
(provide 'tai-viet-util)
+
+;;; tv-util.el ends here
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 9924d62774e..e6ac5d54fc7 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -62,7 +62,7 @@ should return a grid vector array that is the new solution.
;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0))
;;; Generated autoloads from vc/add-log.el
-(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
+(put 'change-log-default-name 'safe-local-variable #'string-or-null-p)
(defvar add-log-current-defun-function nil "\
If non-nil, function to guess name of surrounding function.
@@ -477,31 +477,31 @@ With value nil, inhibit any automatic allout-mode activation.")
(custom-autoload 'allout-auto-activation "allout" nil)
-(put 'allout-use-hanging-indents 'safe-local-variable 'booleanp)
+(put 'allout-use-hanging-indents 'safe-local-variable #'booleanp)
(put 'allout-reindent-bodies 'safe-local-variable (lambda (x) (memq x '(nil t text force))))
-(put 'allout-show-bodies 'safe-local-variable 'booleanp)
+(put 'allout-show-bodies 'safe-local-variable #'booleanp)
-(put 'allout-header-prefix 'safe-local-variable 'stringp)
+(put 'allout-header-prefix 'safe-local-variable #'stringp)
-(put 'allout-primary-bullet 'safe-local-variable 'stringp)
+(put 'allout-primary-bullet 'safe-local-variable #'stringp)
-(put 'allout-plain-bullets-string 'safe-local-variable 'stringp)
+(put 'allout-plain-bullets-string 'safe-local-variable #'stringp)
-(put 'allout-distinctive-bullets-string 'safe-local-variable 'stringp)
+(put 'allout-distinctive-bullets-string 'safe-local-variable #'stringp)
(put 'allout-use-mode-specific-leader 'safe-local-variable (lambda (x) (or (memq x '(t nil allout-mode-leaders comment-start)) (stringp x))))
-(put 'allout-old-style-prefixes 'safe-local-variable 'booleanp)
+(put 'allout-old-style-prefixes 'safe-local-variable #'booleanp)
-(put 'allout-stylish-prefixes 'safe-local-variable 'booleanp)
+(put 'allout-stylish-prefixes 'safe-local-variable #'booleanp)
-(put 'allout-numbered-bullet 'safe-local-variable 'string-or-null-p)
+(put 'allout-numbered-bullet 'safe-local-variable #'string-or-null-p)
-(put 'allout-file-xref-bullet 'safe-local-variable 'string-or-null-p)
+(put 'allout-file-xref-bullet 'safe-local-variable #'string-or-null-p)
-(put 'allout-presentation-padding 'safe-local-variable 'integerp)
+(put 'allout-presentation-padding 'safe-local-variable #'integerp)
(put 'allout-layout 'safe-local-variable (lambda (x) (or (numberp x) (listp x) (memq x '(: * + -)))))
@@ -511,14 +511,17 @@ Return t if `allout-mode' is active in current buffer." nil t)
(autoload 'allout-mode "allout" "\
Toggle Allout outline mode.
-If called interactively, toggle `Allout mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Allout
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `allout-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -784,7 +787,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be.
\(fn &optional ARG)" t nil)
-(defalias 'outlinify-sticky 'outlineify-sticky)
+(defalias 'outlinify-sticky #'outlineify-sticky)
(autoload 'outlineify-sticky "allout" "\
Activate outline mode and establish file var so it is started subsequently.
@@ -827,19 +830,22 @@ See `allout-widgets-mode' for allout widgets mode features.")
(custom-autoload 'allout-widgets-auto-activation "allout-widgets" nil)
-(put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp)
+(put 'allout-widgets-mode-inhibit 'safe-local-variable #'booleanp)
(autoload 'allout-widgets-mode "allout-widgets" "\
Toggle Allout Widgets mode.
-If called interactively, toggle `Allout-Widgets mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Allout-Widgets mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `allout-widgets-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -946,6 +952,11 @@ This is a good function to put in `comint-output-filter-functions'.
\(fn IGNORED)" nil nil)
+(autoload 'ansi-color-compilation-filter "ansi-color" "\
+Maybe translate SGR control sequences into text properties.
+This function depends on the `ansi-color-for-compilation-mode'
+variable, and is meant to be used in `compilation-filter-hook'." nil nil)
+
(register-definition-prefixes "ansi-color" '("ansi-color-"))
;;;***
@@ -1063,7 +1074,7 @@ or a non-nil `apropos-do-all' argument.
\(fn PATTERN)" t nil)
-(defalias 'command-apropos 'apropos-command)
+(defalias 'command-apropos #'apropos-command)
(autoload 'apropos-command "apropos" "\
Show commands (interactively callable functions) that match PATTERN.
@@ -1161,11 +1172,11 @@ Returns list of symbols and documentation found.
(autoload 'archive-mode "arc-mode" "\
Major mode for viewing an archive file in a dired-like way.
You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the archive and into its own buffer;
+Letters no longer insert themselves.\\<archive-mode-map>
+Type \\[archive-extract] to pull a file out of the archive and into its own buffer;
or click mouse-2 on the file's line in the archive mode buffer.
-If you edit a sub-file of this archive (as with the `e' command) and
+If you edit a sub-file of this archive (as with the \\[archive-extract] command) and
save it, the contents of that buffer will be saved back into the
archive.
@@ -1200,17 +1211,17 @@ in array mode may have different values assigned to the variables.
The variables are:
Variables you assign:
- array-max-row: The number of rows in the array.
- array-max-column: The number of columns in the array.
- array-columns-per-line: The number of columns in the array
+ `array-max-row': The number of rows in the array.
+ `array-max-column': The number of columns in the array.
+ `array-columns-per-line': The number of columns in the array
per line of buffer.
- array-field-width: The width of each field, in characters.
- array-rows-numbered: A logical variable describing whether to ignore
+ `array-field-width': The width of each field, in characters.
+ `array-rows-numbered': A logical variable describing whether to ignore
row numbers in the buffer.
Variables which are calculated:
- array-line-length: The number of characters in a buffer line.
- array-lines-per-row: The number of buffer lines used to
+ `array-line-length': The number of characters in a buffer line.
+ `array-lines-per-row': The number of buffer lines used to
display each row.
The following commands are available (an asterisk indicates it may
@@ -1258,14 +1269,17 @@ Entering array mode calls the function `array-mode-hook'.
(autoload 'artist-mode "artist" "\
Toggle Artist mode.
-If called interactively, toggle `Artist mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Artist
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `artist-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1539,7 +1553,7 @@ ENTRY is the name of a password-store entry.
The key used to retrieve the password is the symbol `secret'.
The convention used as the format for a password-store file is
-the following (see http://www.passwordstore.org/#organization):
+the following (see URL `https://www.passwordstore.org/#organization'):
secret
key1: value1
@@ -1597,14 +1611,17 @@ or call the function `autoarg-kp-mode'.")
(autoload 'autoarg-kp-mode "autoarg" "\
Toggle Autoarg-KP mode, a global minor mode.
-If called interactively, toggle `Autoarg-Kp mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Autoarg-Kp
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'autoarg-kp-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1659,14 +1676,17 @@ or call the function `auto-insert-mode'.")
(autoload 'auto-insert-mode "autoinsert" "\
Toggle Auto-insert mode, a global minor mode.
-If called interactively, toggle `Auto-Insert mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Auto-Insert mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'auto-insert-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1752,14 +1772,17 @@ should be non-nil)." nil nil)
(autoload 'auto-revert-mode "autorevert" "\
Toggle reverting buffer when the file changes (Auto-Revert Mode).
-If called interactively, toggle `Auto-Revert mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Auto-Revert mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `auto-revert-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1770,6 +1793,10 @@ disk changes.
When a buffer is reverted, a message is generated. This can be
suppressed by setting `auto-revert-verbose' to nil.
+Reverting can sometimes fail to preserve all the markers in the buffer.
+To avoid that, set `revert-buffer-insert-file-contents-function' to
+the slower function `revert-buffer-insert-file-contents-delicately'.
+
Use `global-auto-revert-mode' to automatically revert all buffers.
Use `auto-revert-tail-mode' if you know that the file will only grow
without being changed in the part that is already in the buffer.
@@ -1785,14 +1812,17 @@ This function is designed to be added to hooks, for example:
(autoload 'auto-revert-tail-mode "autorevert" "\
Toggle reverting tail of buffer when the file grows.
-If called interactively, toggle `Auto-Revert-Tail mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Auto-Revert-Tail mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `auto-revert-tail-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1832,14 +1862,17 @@ or call the function `global-auto-revert-mode'.")
(autoload 'global-auto-revert-mode "autorevert" "\
Toggle Global Auto-Revert Mode.
-If called interactively, toggle `Global Auto-Revert mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Global
+Auto-Revert mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-auto-revert-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1881,7 +1914,7 @@ specifies in the mode line.
Activate Mouse Avoidance mode.
See function `mouse-avoidance-mode' for possible values.
Setting this variable directly does not take effect;
-use either \\[customize] or the function `mouse-avoidance-mode'.")
+use either \\[customize] or \\[mouse-avoidance-mode].")
(custom-autoload 'mouse-avoidance-mode "avoid" nil)
@@ -1969,14 +2002,17 @@ or call the function `display-battery-mode'.")
(autoload 'display-battery-mode "battery" "\
Toggle battery status display in mode line (Display Battery mode).
-If called interactively, toggle `Display-Battery mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Display-Battery mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'display-battery-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -1995,6 +2031,20 @@ seconds.
;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/benchmark.el
+(autoload 'benchmark-call "benchmark" "\
+Measure the run time of calling FUNC a number REPETITIONS of times.
+The result is a list (TIME GC GCTIME)
+where TIME is the total time it took, in seconds.
+GCTIME is the amount of time that was spent in the GC
+and GC is the number of times the GC was called.
+
+REPETITIONS can also be a floating point number, in which case it
+specifies a minimum number of seconds that the benchmark execution
+should take. In that case the return value is prepended with the
+number of repetitions actually used.
+
+\(fn FUNC &optional REPETITIONS)" nil nil)
+
(autoload 'benchmark-run "benchmark" "\
Time execution of FORMS.
If REPETITIONS is supplied as a number, run FORMS that many times,
@@ -2024,6 +2074,8 @@ Interactively, REPETITIONS is taken from the prefix arg, and
the command prompts for the form to benchmark.
For non-interactive use see also `benchmark-run' and
`benchmark-run-compiled'.
+FORM can also be a function in which case we measure the time it takes
+to call it without any argument.
\(fn REPETITIONS FORM)" t nil)
@@ -2035,7 +2087,7 @@ The return value is the value of the final form in BODY.
(function-put 'benchmark-progn 'lisp-indent-function '0)
-(register-definition-prefixes "benchmark" '("benchmark-elapse"))
+(register-definition-prefixes "benchmark" '("benchmark-"))
;;;***
@@ -2529,7 +2581,7 @@ deletion, or > if it is flagged for displaying." t nil)
(defalias 'edit-bookmarks 'bookmark-bmenu-list)
(autoload 'bookmark-bmenu-search "bookmark" "\
-Incremental search of bookmarks, hiding the non-matches as we go." t nil)
+Incremental search of bookmarks, hiding the non-matches as we go." '(bookmark-bmenu-mode) nil)
(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map))
@@ -2576,7 +2628,7 @@ Emacs 28.1 and will be removed in a future release.
\(fn URL &optional KIND)" nil nil)
(autoload 'browse-url-of-file "browse-url" "\
-Ask a WWW browser to display FILE.
+Use a web browser to display FILE.
Display the current buffer's file if FILE is nil or if called
interactively. Turn the filename into a URL with function
`browse-url-file-url'. Pass the URL to a browser using the
@@ -2585,7 +2637,9 @@ interactively. Turn the filename into a URL with function
\(fn &optional FILE)" t nil)
(autoload 'browse-url-of-buffer "browse-url" "\
-Ask a WWW browser to display BUFFER.
+Use a web browser to display BUFFER.
+See `browse-url' for details.
+
Display the current buffer if BUFFER is nil. Display only the
currently visible part of BUFFER (from a temporary file) if buffer is
narrowed.
@@ -2596,19 +2650,24 @@ narrowed.
In Dired, ask a WWW browser to display the file named on this line." t nil)
(autoload 'browse-url-of-region "browse-url" "\
-Ask a WWW browser to display the current region.
+Use a web browser to display the current region.
+See `browse-url' for details.
\(fn MIN MAX)" t nil)
(autoload 'browse-url "browse-url" "\
-Ask a WWW browser to load URL.
-Prompt for a URL, defaulting to the URL at or before point.
-Invokes a suitable browser function which does the actual job.
+Open URL using a configurable method.
+This will typically (by default) open URL with an external web
+browser, but a wide variety of different methods can be used,
+depending on the URL type.
The variables `browse-url-browser-function',
`browse-url-handlers', and `browse-url-default-handlers'
determine which browser function to use.
+This command prompts for a URL, defaulting to the URL at or
+before point.
+
The additional ARGS are passed to the browser function. See the
doc strings of the actual functions, starting with
`browse-url-browser-function', for information about the
@@ -2620,8 +2679,8 @@ If ARGS are omitted, the default is to pass
\(fn URL &rest ARGS)" t nil)
(autoload 'browse-url-at-point "browse-url" "\
-Ask a WWW browser to load the URL at or before point.
-Variable `browse-url-browser-function' says which browser to use.
+Open URL at point using a configurable method.
+See `browse-url' for details.
Optional prefix argument ARG non-nil inverts the value of the option
`browse-url-new-window-flag'.
@@ -2637,10 +2696,11 @@ opposite of the browser kind of `browse-url-browser-function'.
\(fn KIND URL &optional ARG)" t nil)
(autoload 'browse-url-at-mouse "browse-url" "\
-Ask a WWW browser to load a URL clicked with the mouse.
-The URL is the one around or before the position of the mouse click
-but point is not changed. Variable `browse-url-browser-function'
-says which browser to use.
+Use a web browser to load a URL clicked with the mouse.
+See `browse-url' for details.
+
+The URL is the one around or before the position of the mouse
+click but point is not changed.
\(fn EVENT)" t nil)
@@ -2878,6 +2938,13 @@ from `browse-url-elinks-wrapper'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(autoload 'browse-url-button-open-url "browse-url" "\
+Open URL using `browse-url'.
+If `current-prefix-arg' is non-nil, use
+`browse-url-secondary-browser-function' instead.
+
+\(fn URL)" nil nil)
+
(register-definition-prefixes "browse-url" '("browse-url-"))
;;;***
@@ -2951,14 +3018,17 @@ columns on its right towards the left.
(autoload 'bug-reference-mode "bug-reference" "\
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
-If called interactively, toggle `Bug-Reference mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Bug-Reference mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `bug-reference-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -2967,14 +3037,17 @@ disabled.
(autoload 'bug-reference-prog-mode "bug-reference" "\
Like `bug-reference-mode', but only buttonize in comments and strings.
-If called interactively, toggle `Bug-Reference-Prog mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Bug-Reference-Prog mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `bug-reference-prog-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -3124,7 +3197,7 @@ and corresponding effects.
\(fn &optional ARG)" nil nil)
-(register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte-" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile"))
+(register-definition-prefixes "bytecomp" '("batch-byte-compile-file" "byte" "displaying-byte-compile-warnings" "emacs-lisp-" "no-byte-compile"))
;;;***
@@ -4063,7 +4136,7 @@ in this way.
If DONT-OVERRIDE is t, style variables that already have values (i.e., whose
values are not the symbol `set-from-style') will not be overridden. CC Mode
calls c-set-style internally in this way whilst initializing a buffer; if
-cc-set-style is called like this from anywhere else, it will usually behave as
+c-set-style is called like this from anywhere else, it will usually behave as
a null operation.
\(fn STYLENAME &optional DONT-OVERRIDE)" t nil)
@@ -4410,11 +4483,6 @@ Returns a form where all lambdas don't have any free variables.
\(fn FORM)" nil nil)
-(autoload 'cconv-warnings-only "cconv" "\
-Add the warnings that closure conversion would encounter.
-
-\(fn FORM)" nil nil)
-
(register-definition-prefixes "cconv" '("cconv-"))
;;;***
@@ -4716,14 +4784,17 @@ Prefix argument is the same as for `checkdoc-defun'." t nil)
(autoload 'checkdoc-minor-mode "checkdoc" "\
Toggle automatic docstring checking (Checkdoc minor mode).
-If called interactively, toggle `Checkdoc minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Checkdoc
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `checkdoc-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -4799,7 +4870,7 @@ element to judge if that element should be excluded from the list.
The buffer is left in Command History mode." t nil)
(autoload 'command-history "chistory" "\
-Examine commands from `command-history' in a buffer.
+Examine commands from variable `command-history' in a buffer.
The number of commands listed is controlled by `list-command-history-max'.
The command history is filtered by `list-command-history-filter' if non-nil.
Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line.
@@ -4832,14 +4903,18 @@ or call the function `cl-font-lock-built-in-mode'.")
(autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\
Highlight built-in functions, variables, and types in `lisp-mode'.
-If called interactively, toggle `Cl-Font-Lock-Built-In mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Cl-Font-Lock-Built-In mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'cl-font-lock-built-in-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -4880,7 +4955,7 @@ DEFAULT-BODY, if present, is used as the body of a default method.
(autoload 'cl-defmethod "cl-generic" "\
Define a new method for generic function NAME.
-This it defines an implementation of NAME to use for invocations
+This defines an implementation of NAME to use for invocations
of specific types of arguments.
ARGS is a list of dispatch arguments (see `cl-defun'), but where
@@ -4897,8 +4972,12 @@ all methods of NAME have to use the same set of arguments for dispatch.
Each dispatch argument and TYPE are specified in ARGS where the corresponding
formal argument appears as (VAR TYPE) rather than just VAR.
-The optional second argument QUALIFIER is a specifier that
-modifies how the method is combined with other methods, including:
+The optional EXTRA element, on the form `:extra STRING', allows
+you to add more methods for the same specializers and qualifiers.
+These are distinguished by STRING.
+
+The optional argument QUALIFIER is a specifier that modifies how
+the method is combined with other methods, including:
:before - Method will be called before the primary
:after - Method will be called after the primary
:around - Method will be called around everything else
@@ -4915,9 +4994,9 @@ method to be applicable.
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)" nil t)
+\(fn NAME [EXTRA] [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" nil t)
-(function-put 'cl-defmethod 'doc-string-elt '3)
+(function-put 'cl-defmethod 'doc-string-elt 'cl--defmethod-doc-pos)
(function-put 'cl-defmethod 'lisp-indent-function 'defun)
@@ -5060,14 +5139,17 @@ This can be needed when using code byte-compiled using the old
macro-expansion of `cl-defstruct' that used vectors objects instead
of record objects.
-If called interactively, toggle `Cl-Old-Struct-Compat mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'cl-old-struct-compat-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5142,7 +5224,7 @@ Normally display output in temp buffer, but
prefix arg means replace the region with it.
`c-macro-preprocessor' specifies the preprocessor to use.
-Tf the user option `c-macro-prompt-flag' is non-nil
+If the user option `c-macro-prompt-flag' is non-nil
prompt for arguments to the preprocessor (e.g. `-DDEBUG -I ./include'),
otherwise use `c-macro-cppflags'.
@@ -5306,6 +5388,96 @@ REGEXP-GROUP is the regular expression group in REGEXP to use.
;;;***
+;;;### (autoloads nil "comp" "emacs-lisp/comp.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/comp.el
+(put 'no-native-compile 'safe-local-variable 'booleanp)
+
+(autoload 'comp-subr-trampoline-install "comp" "\
+Make SUBR-NAME effectively advice-able when called from native code.
+
+\(fn SUBR-NAME)" nil nil)
+
+(autoload 'comp-c-func-name "comp" "\
+Given NAME, return a name suitable for the native code.
+Add PREFIX in front of it. If FIRST is not nil, pick the first
+available name ignoring compilation context and potential name
+clashes.
+
+\(fn NAME PREFIX &optional FIRST)" nil nil)
+
+(autoload 'comp-clean-up-stale-eln "comp" "\
+Given FILE remove all its *.eln files in `native-comp-eln-load-path'
+sharing the original source filename (including FILE).
+
+\(fn FILE)" nil nil)
+
+(autoload 'comp-lookup-eln "comp" "\
+Given a Lisp source FILENAME return the corresponding .eln file if found.
+Search happens in `native-comp-eln-load-path'.
+
+\(fn FILENAME)" nil nil)
+
+(autoload 'native-compile "comp" "\
+Compile FUNCTION-OR-FILE into native code.
+This is the synchronous entry-point for the Emacs Lisp native
+compiler.
+FUNCTION-OR-FILE is a function symbol, a form, or the filename of
+an Emacs Lisp source file.
+If OUTPUT is non-nil, use it as the filename for the compiled
+object.
+If FUNCTION-OR-FILE is a filename, return the filename of the
+compiled object. If FUNCTION-OR-FILE is a function symbol or a
+form, return the compiled function.
+
+\(fn FUNCTION-OR-FILE &optional OUTPUT)" nil nil)
+
+(autoload 'batch-native-compile "comp" "\
+Perform native compilation on remaining command-line arguments.
+Use this from the command line, with ‘-batch’;
+it won’t work in an interactive Emacs.
+Native compilation equivalent to `batch-byte-compile'." nil nil)
+
+(autoload 'batch-byte+native-compile "comp" "\
+Like `batch-native-compile', but used for bootstrap.
+Generate .elc files in addition to the .eln files.
+Force the produced .eln to be outputted in the eln system
+directory (the last entry in `native-comp-eln-load-path') unless
+`native-compile-target-directory' is non-nil. If the environment
+variable 'NATIVE_DISABLED' is set, only byte compile." nil nil)
+
+(autoload 'native-compile-async "comp" "\
+Compile FILES asynchronously.
+FILES is one file or a list of filenames or directories.
+
+If optional argument RECURSIVELY is non-nil, recurse into
+subdirectories of given directories.
+
+If optional argument LOAD is non-nil, request to load the file
+after compiling.
+
+The optional argument SELECTOR has the following valid values:
+
+nil -- Select all files.
+a string -- A regular expression selecting files with matching names.
+a function -- A function selecting files with matching names.
+
+The variable `native-comp-async-jobs-number' specifies the number
+of (commands) to run simultaneously.
+
+\(fn FILES &optional RECURSIVELY LOAD SELECTOR)" nil nil)
+
+(register-definition-prefixes "comp" '("comp-" "make-comp-edge" "native-" "no-native-compile"))
+
+;;;***
+
+;;;### (autoloads nil "comp-cstr" "emacs-lisp/comp-cstr.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from emacs-lisp/comp-cstr.el
+
+(register-definition-prefixes "comp-cstr" '("comp-" "with-comp-cstr-accessors"))
+
+;;;***
+
;;;### (autoloads nil "compare-w" "vc/compare-w.el" (0 0 0 0))
;;; Generated autoloads from vc/compare-w.el
@@ -5499,14 +5671,18 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
(autoload 'compilation-shell-minor-mode "compile" "\
Toggle Compilation Shell minor mode.
-If called interactively, toggle `Compilation-Shell minor mode'. If
-the prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Compilation-Shell minor mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `compilation-shell-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5520,14 +5696,17 @@ See `compilation-mode'.
(autoload 'compilation-minor-mode "compile" "\
Toggle Compilation minor mode.
-If called interactively, toggle `Compilation minor mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Compilation minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `compilation-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5563,14 +5742,17 @@ or call the function `dynamic-completion-mode'.")
(autoload 'dynamic-completion-mode "completion" "\
Toggle dynamic word-completion on or off.
-If called interactively, toggle `Dynamic-Completion mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Dynamic-Completion mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'dynamic-completion-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -5940,8 +6122,7 @@ span the needed amount of lines.
Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
-here-docs sections. With capable Emaxen results of scan are used
-for indentation too, otherwise they are used for highlighting only.
+here-docs sections. Results of scan are used for indentation too.
Variables controlling indentation style:
`cperl-tab-always-indent'
@@ -6130,14 +6311,17 @@ or call the function `cua-mode'.")
(autoload 'cua-mode "cua-base" "\
Toggle Common User Access style editing (CUA mode).
-If called interactively, toggle `Cua mode'. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
+This is a minor mode. If called interactively, toggle the `Cua mode'
+mode. If the prefix argument is positive, enable the mode, and if it
+is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'cua-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6184,14 +6368,17 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
Toggle the region as rectangular.
Activates the region if needed. Only lasts until the region is deactivated.
-If called interactively, toggle `Cua-Rectangle-Mark mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `cua-rectangle-mark-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6213,14 +6400,17 @@ By convention, this is a list of symbols where each symbol stands for the
(autoload 'cursor-intangible-mode "cursor-sensor" "\
Keep cursor outside of any `cursor-intangible' text property.
-If called interactively, toggle `Cursor-Intangible mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Cursor-Intangible mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `cursor-intangible-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6234,14 +6424,17 @@ where WINDOW is the affected window, OLDPOS is the last known position of
the cursor and DIR can be `entered' or `left' depending on whether the cursor
is entering the area covered by the text-property property or leaving it.
-If called interactively, toggle `Cursor-Sensor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Cursor-Sensor mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `cursor-sensor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6405,9 +6598,9 @@ PACKAGE value appearing in the :package-version keyword. Since
the user might see the value in an error message, a good choice is
the official name of the package, such as MH-E or Gnus.")
-(defalias 'customize-changed 'customize-changed-options)
+(define-obsolete-function-alias 'customize-changed-options #'customize-changed "28.1")
-(autoload 'customize-changed-options "cus-edit" "\
+(autoload 'customize-changed "cus-edit" "\
Customize all settings whose meanings have changed in Emacs itself.
This includes new user options and faces, and new customization
groups, as well as older options and faces whose meanings or
@@ -6620,14 +6813,17 @@ Mode used for cvs status output.
(autoload 'cwarn-mode "cwarn" "\
Minor mode that highlights suspicious C and C++ constructions.
-If called interactively, toggle `Cwarn mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Cwarn
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `cwarn-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -6775,6 +6971,15 @@ If the HANDLER returns a `dbus-error', it is propagated as return message.
\(fn EVENT)" t nil)
+(function-put 'dbus-handle-event 'completion-predicate #'ignore)
+
+(autoload 'dbus-monitor "dbus" "\
+Invoke `dbus-register-monitor' interactively, and switch to the buffer.
+BUS is either a Lisp keyword, `:system' or `:session', or a
+string denoting the bus address. The value nil defaults to `:session'.
+
+\(fn &optional BUS)" t nil)
+
(register-definition-prefixes "dbus" '("dbus-"))
;;;***
@@ -7006,7 +7211,9 @@ The most useful commands are:
\\[decipher-frequency-count] Display the frequency of each ciphertext letter
\\[decipher-adjacency-list] Show adjacency list for current letter (lists letters appearing next to it)
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
-\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)" t nil)
+\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)
+
+\(fn)" t nil)
(register-definition-prefixes "decipher" '("decipher-"))
@@ -7074,14 +7281,17 @@ or call the function `delete-selection-mode'.")
(autoload 'delete-selection-mode "delsel" "\
Toggle Delete Selection mode.
-If called interactively, toggle `Delete-Selection mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Delete-Selection mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'delete-selection-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -7094,6 +7304,13 @@ information on adapting behavior of commands in Delete Selection mode.
\(fn &optional ARG)" t nil)
+(autoload 'delete-active-region "delsel" "\
+Delete the active region.
+If KILLP is non-nil, or if called interactively with a prefix argument,
+the active region is killed instead of deleted.
+
+\(fn &optional KILLP)" t nil)
+
(register-definition-prefixes "delsel" '("del" "minibuffer-keyboard-quit"))
;;;***
@@ -7130,6 +7347,9 @@ KEYWORD-ARGS:
:after-hook FORM
A single lisp form which is evaluated after the mode
hooks have been run. It should not be quoted.
+ :interactive BOOLEAN
+ Whether the derived mode should be `interactive' or not.
+ The default is t.
BODY: forms to execute just before running the
hooks for the new mode. Do not use `interactive' here.
@@ -7249,14 +7469,17 @@ or call the function `desktop-save-mode'.")
(autoload 'desktop-save-mode "desktop" "\
Toggle desktop saving (Desktop Save mode).
-If called interactively, toggle `Desktop-Save mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Desktop-Save mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'desktop-save-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -7475,13 +7698,13 @@ You can control what lines will be unwrapped by frobbing
indicating the minimum and maximum length of an unwrapped citation line. If
NODISPLAY is non-nil, don't redisplay the article buffer.
-\(fn &optional NODISPLAY)" t nil)
+\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-article-outlook-repair-attribution "deuglify" "\
Repair a broken attribution line.
If NODISPLAY is non-nil, don't redisplay the article buffer.
-\(fn &optional NODISPLAY)" t nil)
+\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-outlook-deuglify-article "deuglify" "\
Full deuglify of broken Outlook (Express) articles.
@@ -7489,10 +7712,10 @@ Treat \"smartquotes\", unwrap lines, repair attribution and
rearrange citation. If NODISPLAY is non-nil, don't redisplay the
article buffer.
-\(fn &optional NODISPLAY)" t nil)
+\(fn &optional NODISPLAY)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-article-outlook-deuglify-article "deuglify" "\
-Deuglify broken Outlook (Express) articles and redisplay." t nil)
+Deuglify broken Outlook (Express) articles and redisplay." '(gnus-article-mode gnus-summary-mode) nil)
(register-definition-prefixes "deuglify" '("gnus-"))
@@ -7559,23 +7782,22 @@ This is a mode for searching a dictionary server implementing the
protocol defined in RFC 2229.
This is a quick reference to this mode describing the default key bindings:
+\\<dictionary-mode-map>
+* \\[dictionary-close] close the dictionary buffer
+* \\[dictionary-help] display this help information
+* \\[dictionary-search] ask for a new word to search
+* \\[dictionary-lookup-definition] search the word at point
+* \\[forward-button] or TAB place point to the next link
+* \\[backward-button] or S-TAB place point to the prev link
-* q close the dictionary buffer
-* h display this help information
-* s ask for a new word to search
-* d search the word at point
-* n or Tab place point to the next link
-* p or S-Tab place point to the prev link
+* \\[dictionary-match-words] ask for a pattern and list all matching words.
+* \\[dictionary-select-dictionary] select the default dictionary
+* \\[dictionary-select-strategy] select the default search strategy
-* m ask for a pattern and list all matching words.
-* D select the default dictionary
-* M select the default search strategy
-
-* Return or Button2 visit that link
-" nil nil)
+* RET or <mouse-2> visit that link" nil nil)
(autoload 'dictionary "dictionary" "\
-Create a new dictonary buffer and install dictionary-mode." t nil)
+Create a new dictionary buffer and install `dictionary-mode'." t nil)
(autoload 'dictionary-search "dictionary" "\
Search the WORD in DICTIONARY if given or in all if nil.
@@ -7606,7 +7828,7 @@ Display entries matching WORD or the current word if not given.
Display tooltips for the current word.
This function can be used to enable or disable the tooltip mode
-for the current buffer (based on ARG). If global-tooltip-mode is
+for the current buffer (based on ARG). If global-tooltip-mode is
active it will overwrite that mode for the current buffer.
\(fn &optional ARG)" t nil)
@@ -7732,14 +7954,17 @@ a diff with \\[diff-reverse-direction].
(autoload 'diff-minor-mode "diff-mode" "\
Toggle Diff minor mode.
-If called interactively, toggle `Diff minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Diff minor
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `diff-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -7755,8 +7980,10 @@ disabled.
;;; Generated autoloads from net/dig.el
(autoload 'dig "dig" "\
-Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
-Optional arguments are passed to `dig-invoke'.
+Query addresses of a DOMAIN using dig.
+See `dig-invoke' for an explanation for the parameters.
+When called interactively, DOMAIN is prompted for. If given a prefix,
+also prompt for the QUERY-TYPE parameter.
\(fn DOMAIN &optional QUERY-TYPE QUERY-CLASS QUERY-OPTION DIG-OPTION SERVER)" t nil)
@@ -7772,10 +7999,15 @@ Switches passed to `ls' for Dired. MUST contain the `l' option.
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.
+
+If you have files with names with embedded newline characters, adding
+`b' to the switches will allow Dired to handle those files better.
+
Options that include embedded whitespace must be quoted
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,
some of the `ls' switches are not supported; see the doc string of
`insert-directory' in `ls-lisp.el' for more details.")
@@ -7873,19 +8105,9 @@ directories again, type \\[dired-do-redisplay] to relist the file at point or th
subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
again for the directory tree.
-Customization variables (rename this buffer and type \\[describe-variable] on each line
-for more info):
+See the `dired' customization group for a list of user options.
- `dired-listing-switches'
- `dired-trivial-filenames'
- `dired-marker-char'
- `dired-del-marker'
- `dired-keep-marker-rename'
- `dired-keep-marker-copy'
- `dired-keep-marker-hardlink'
- `dired-keep-marker-symlink'
-
-Hooks (use \\[describe-variable] to see their documentation):
+This mode runs the following hooks:
`dired-before-readin-hook'
`dired-after-readin-hook'
@@ -7924,14 +8146,17 @@ Like \\[dired-jump] (`dired-jump') but in other window.
(autoload 'dirtrack-mode "dirtrack" "\
Toggle directory tracking in shell buffers (Dirtrack mode).
-If called interactively, toggle `Dirtrack mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Dirtrack
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `dirtrack-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8101,14 +8326,18 @@ in `.emacs'.
Toggle display of fill-column indicator.
This uses `display-fill-column-indicator' internally.
-If called interactively, toggle `Display-Fill-Column-Indicator mode'.
-If the prefix argument is positive, enable the mode, and if it is zero
-or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Display-Fill-Column-Indicator mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `display-fill-column-indicator-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8178,14 +8407,17 @@ list.")
Toggle display of line numbers in the buffer.
This uses `display-line-numbers' internally.
-If called interactively, toggle `Display-Line-Numbers mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Display-Line-Numbers mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `display-line-numbers-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8266,6 +8498,13 @@ if some action was made, or nil if the URL is ignored.")
;;;### (autoloads nil "dns" "net/dns.el" (0 0 0 0))
;;; Generated autoloads from net/dns.el
+(autoload 'dns-query "dns" "\
+Query a DNS server for NAME of TYPE.
+If FULL, return the entire record returned.
+If REVERSE, look up an IP address.
+
+\(fn NAME &optional TYPE FULL REVERSE)" nil nil)
+
(register-definition-prefixes "dns" '("dns-"))
;;;***
@@ -8321,14 +8560,17 @@ to the next best mode." nil nil)
(autoload 'doc-view-minor-mode "doc-view" "\
Toggle displaying buffer via Doc View (Doc View minor mode).
-If called interactively, toggle `Doc-View minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Doc-View
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `doc-view-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8389,14 +8631,17 @@ Switch to *doctor* buffer and start giving psychotherapy." t nil)
(autoload 'double-mode "double" "\
Toggle special insertion on double keypresses (Double mode).
-If called interactively, toggle `Double mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Double
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `double-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -8431,7 +8676,7 @@ Switch to *dungeon* buffer and start game." t nil)
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
-(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
+(defalias 'easy-mmode-define-minor-mode #'define-minor-mode)
(autoload 'define-minor-mode "easy-mmode" "\
Define a new minor mode MODE.
@@ -8454,39 +8699,35 @@ documenting what its argument does. If the word \"ARG\" does not
appear in DOC, a paragraph is added to DOC explaining
usage of the mode argument.
-Optional INIT-VALUE is the initial value of the mode's variable.
- Note that the minor mode function won't be called by setting
- this option, so the value *reflects* the minor mode's natural
- initial state, rather than *setting* it.
- In the vast majority of cases it should be nil.
-Optional LIGHTER is displayed in the mode line when the mode is on.
-Optional KEYMAP is the default keymap bound to the mode keymap.
- If non-nil, it should be a variable name (whose value is a keymap),
- or an expression that returns either a keymap or a list of
- (KEY . BINDING) pairs where KEY and BINDING are suitable for
- `define-key'. If you supply a KEYMAP argument that is not a
- symbol, this macro defines the variable MODE-map and gives it
- the value that KEYMAP specifies.
-
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
alternating keywords and values. If you provide BODY, then you must
- provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
- at least one keyword argument, or both; otherwise, BODY would be
- misinterpreted as the first omitted argument. The following special
- keywords are supported (other keywords are passed to `defcustom' if
- the minor mode is global):
+ provide at least one keyword argument (e.g. `:lighter nil`).
+ The following special keywords are supported (other keywords are passed
+ to `defcustom' if the minor mode is global):
-:group GROUP Custom group name to use in all generated `defcustom' forms.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
buffer-local, so don't make the variable MODE buffer-local.
By default, the mode is buffer-local.
-:init-value VAL Same as the INIT-VALUE argument.
+:init-value VAL the initial value of the mode's variable.
+ Note that the minor mode function won't be called by setting
+ this option, so the value *reflects* the minor mode's natural
+ initial state, rather than *setting* it.
+ In the vast majority of cases it should be nil.
Not used if you also specify :variable.
-:lighter SPEC Same as the LIGHTER argument.
-:keymap MAP Same as the KEYMAP argument.
-:require SYM Same as in `defcustom'.
+:lighter SPEC Text displayed in the mode line when the mode is on.
+:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'.
+ If non-nil, it should be a variable name (whose value is
+ a keymap), or an expression that returns either a keymap or
+ a list of (KEY . BINDING) pairs where KEY and BINDING are
+ suitable for `define-key'. If you supply a KEYMAP argument
+ that is not a symbol, this macro defines the variable MODE-map
+ and gives it the value that KEYMAP specifies.
+:interactive VAL Whether this mode should be a command or not. The default
+ is to make it one; use nil to avoid that. If VAL is a list,
+ it's interpreted as a list of major modes this minor mode
+ is useful in.
:variable PLACE The location to use instead of the variable MODE to store
the state of the mode. This can be simply a different
named variable, or a generalized variable.
@@ -8496,7 +8737,6 @@ BODY contains code to execute each time the mode is enabled or disabled.
sets it. If you specify a :variable, this function does
not define a MODE variable (nor any of the terms used
in :variable).
-
:after-hook A single lisp form which is evaluated after the mode hooks
have been run. It should not be quoted.
@@ -8505,13 +8745,17 @@ For example, you could write
:lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\"
...BODY CODE...)
-\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil t)
+For backward compatibility with the Emacs<21 calling convention,
+the keywords can also be preceded by the obsolete triplet
+INIT-VALUE LIGHTER KEYMAP.
+
+\(fn MODE DOC [KEYWORD VAL ... &rest BODY])" nil t)
(function-put 'define-minor-mode 'doc-string-elt '2)
-(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
+(defalias 'easy-mmode-define-global-mode #'define-globalized-minor-mode)
-(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
+(defalias 'define-global-minor-mode #'define-globalized-minor-mode)
(autoload 'define-globalized-minor-mode "easy-mmode" "\
Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
@@ -8586,158 +8830,6 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
;;;***
-;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (0 0 0
-;;;;;; 0))
-;;; Generated autoloads from emacs-lisp/easymenu.el
-
-(autoload 'easy-menu-define "easymenu" "\
-Define a pop-up menu and/or menu bar menu specified by MENU.
-If SYMBOL is non-nil, define SYMBOL as a function to pop up the
-submenu defined by MENU, with DOC as its doc string.
-
-MAPS, if non-nil, should be a keymap or a list of keymaps; add
-the submenu defined by MENU to the keymap or each of the keymaps,
-as a top-level menu bar item.
-
-The first element of MENU must be a string. It is the menu bar
-item name. It may be followed by the following keyword argument
-pairs:
-
- :filter FUNCTION
- FUNCTION must be a function which, if called with one
- argument---the list of the other menu items---returns the
- items to actually display.
-
- :visible INCLUDE
- INCLUDE is an expression. The menu is visible if the
- expression evaluates to a non-nil value. `:included' is an
- alias for `:visible'.
-
- :active ENABLE
- ENABLE is an expression. The menu is enabled for selection
- if the expression evaluates to a non-nil value. `:enable' is
- an alias for `:active'.
-
- :label FORM
- FORM is an expression that is dynamically evaluated and whose
- value serves as the menu's label (the default is the first
- element of MENU).
-
- :help HELP
- HELP is a string, the help to display for the menu.
- In a GUI this is a \"tooltip\" on the menu button. (Though
- in Lucid :help is not shown for the top-level menu bar, only
- for sub-menus.)
-
-The rest of the elements in MENU are menu items.
-A menu item can be a vector of three elements:
-
- [NAME CALLBACK ENABLE]
-
-NAME is a string--the menu item name.
-
-CALLBACK is a command to run when the item is chosen, or an
-expression to evaluate when the item is chosen.
-
-ENABLE is an expression; the item is enabled for selection if the
-expression evaluates to a non-nil value.
-
-Alternatively, a menu item may have the form:
-
- [ NAME CALLBACK [ KEYWORD ARG ]... ]
-
-where NAME and CALLBACK have the same meanings as above, and each
-optional KEYWORD and ARG pair should be one of the following:
-
- :keys KEYS
- KEYS is a string; a keyboard equivalent to the menu item.
- This is normally not needed because keyboard equivalents are
- usually computed automatically. KEYS is expanded with
- `substitute-command-keys' before it is used.
-
- :key-sequence KEYS
- KEYS is a hint for speeding up Emacs's first display of the
- menu. It should be nil if you know that the menu item has no
- keyboard equivalent; otherwise it should be a string or
- vector specifying a keyboard equivalent for the menu item.
-
- :active ENABLE
- ENABLE is an expression; the item is enabled for selection
- whenever this expression's value is non-nil. `:enable' is an
- alias for `:active'.
-
- :visible INCLUDE
- INCLUDE is an expression; this item is only visible if this
- expression has a non-nil value. `:included' is an alias for
- `:visible'.
-
- :label FORM
- FORM is an expression that is dynamically evaluated and whose
- value serves as the menu item's label (the default is NAME).
-
- :suffix FORM
- FORM is an expression that is dynamically evaluated and whose
- value is concatenated with the menu entry's label.
-
- :style STYLE
- STYLE is a symbol describing the type of menu item; it should
- be `toggle' (a checkbox), or `radio' (a radio button), or any
- other value (meaning an ordinary menu item).
-
- :selected SELECTED
- SELECTED is an expression; the checkbox or radio button is
- selected whenever the expression's value is non-nil.
-
- :help HELP
- HELP is a string, the help to display for the menu item.
-
-Alternatively, a menu item can be a string. Then that string
-appears in the menu as unselectable text. A string consisting
-solely of dashes is displayed as a menu separator.
-
-Alternatively, a menu item can be a list with the same format as
-MENU. This is a submenu.
-
-\(fn SYMBOL MAPS DOC MENU)" nil t)
-
-(function-put 'easy-menu-define 'lisp-indent-function 'defun)
-
-(autoload 'easy-menu-do-define "easymenu" "\
-
-
-\(fn SYMBOL MAPS DOC MENU)" nil nil)
-
-(autoload 'easy-menu-create-menu "easymenu" "\
-Create a menu called MENU-NAME with items described in MENU-ITEMS.
-MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
-possibly preceded by keyword pairs as described in `easy-menu-define'.
-
-\(fn MENU-NAME MENU-ITEMS)" nil nil)
-
-(autoload 'easy-menu-change "easymenu" "\
-Change menu found at PATH as item NAME to contain ITEMS.
-PATH is a list of strings for locating the menu that
-should contain a submenu named NAME.
-ITEMS is a list of menu items, as in `easy-menu-define'.
-These items entirely replace the previous items in that submenu.
-
-If MAP is specified, it should normally be a keymap; nil stands for the local
-menu-bar keymap. It can also be a symbol, which has earlier been used as the
-first argument in a call to `easy-menu-define', or the value of such a symbol.
-
-If the menu located by PATH has no submenu named NAME, add one.
-If the optional argument BEFORE is present, add it just before
-the submenu named BEFORE, otherwise add it at the end of the menu.
-
-To implement dynamic menus, either call this from
-`menu-bar-update-hook' or use a menu filter.
-
-\(fn PATH NAME ITEMS &optional BEFORE MAP)" nil nil)
-
-(register-definition-prefixes "easymenu" '("add-submenu" "easy-menu-"))
-
-;;;***
-
;;;### (autoloads nil "ebnf-abn" "progmodes/ebnf-abn.el" (0 0 0 0))
;;; Generated autoloads from progmodes/ebnf-abn.el
@@ -9239,14 +9331,17 @@ or call the function `global-ede-mode'.")
(autoload 'global-ede-mode "ede" "\
Toggle global EDE (Emacs Development Environment) mode.
-If called interactively, toggle `Global Ede mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Global Ede
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-ede-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -9476,7 +9571,7 @@ Toggle edebugging of all definitions." t nil)
(autoload 'edebug-all-forms "edebug" "\
Toggle edebugging of all forms." t nil)
-(register-definition-prefixes "edebug" '("cancel-edebug-on-entry" "edebug" "get-edebug-spec" "global-edebug-"))
+(register-definition-prefixes "edebug" '("arglist" "backquote-form" "def-declarations" "edebug" "function-form" "interactive" "lambda-" "name" "nested-backquote-form"))
;;;***
@@ -9498,9 +9593,9 @@ arguments after setting up the Ediff buffers.
\(fn FILE-A FILE-B FILE-C &optional STARTUP-HOOKS)" t nil)
-(defalias 'ediff3 'ediff-files3)
+(defalias 'ediff3 #'ediff-files3)
-(defalias 'ediff 'ediff-files)
+(defalias 'ediff #'ediff-files)
(autoload 'ediff-current-file "ediff" "\
Start ediff between current buffer and its file on disk.
@@ -9526,7 +9621,7 @@ symbol describing the Ediff job type; it defaults to
\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME)" t nil)
-(defalias 'ebuffers 'ediff-buffers)
+(defalias 'ebuffers #'ediff-buffers)
(autoload 'ediff-buffers3 "ediff" "\
Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C.
@@ -9540,7 +9635,7 @@ symbol describing the Ediff job type; it defaults to
\(fn BUFFER-A BUFFER-B BUFFER-C &optional STARTUP-HOOKS JOB-NAME)" t nil)
-(defalias 'ebuffers3 'ediff-buffers3)
+(defalias 'ebuffers3 #'ediff-buffers3)
(autoload 'ediff-directories "ediff" "\
Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have
@@ -9549,7 +9644,7 @@ expression; only file names that match the regexp are considered.
\(fn DIR1 DIR2 REGEXP)" t nil)
-(defalias 'edirs 'ediff-directories)
+(defalias 'edirs #'ediff-directories)
(autoload 'ediff-directory-revisions "ediff" "\
Run Ediff on a directory, DIR1, comparing its files with their revisions.
@@ -9558,7 +9653,7 @@ names. Only the files that are under revision control are taken into account.
\(fn DIR1 REGEXP)" t nil)
-(defalias 'edir-revisions 'ediff-directory-revisions)
+(defalias 'edir-revisions #'ediff-directory-revisions)
(autoload 'ediff-directories3 "ediff" "\
Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that
@@ -9567,7 +9662,7 @@ regular expression; only file names that match the regexp are considered.
\(fn DIR1 DIR2 DIR3 REGEXP)" t nil)
-(defalias 'edirs3 'ediff-directories3)
+(defalias 'edirs3 #'ediff-directories3)
(autoload 'ediff-merge-directories "ediff" "\
Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
@@ -9577,7 +9672,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
\(fn DIR1 DIR2 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
-(defalias 'edirs-merge 'ediff-merge-directories)
+(defalias 'edirs-merge #'ediff-merge-directories)
(autoload 'ediff-merge-directories-with-ancestor "ediff" "\
Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors.
@@ -9597,7 +9692,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
-(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions)
+(defalias 'edir-merge-revisions #'ediff-merge-directory-revisions)
(autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" "\
Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors.
@@ -9839,7 +9934,7 @@ Call `ediff-merge-directories-with-ancestor' with the next four command line arg
(autoload 'ediff-show-registry "ediff-mult" "\
Display Ediff's registry." t nil)
-(defalias 'eregistry 'ediff-show-registry)
+(defalias 'eregistry #'ediff-show-registry)
(register-definition-prefixes "ediff-mult" '("ediff-"))
@@ -10093,14 +10188,17 @@ or call the function `electric-pair-mode'.")
(autoload 'electric-pair-mode "elec-pair" "\
Toggle automatic parens pairing (Electric Pair mode).
-If called interactively, toggle `Electric-Pair mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Electric-Pair mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'electric-pair-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10117,14 +10215,17 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'.
(autoload 'electric-pair-local-mode "elec-pair" "\
Toggle `electric-pair-mode' only in this buffer.
-If called interactively, toggle `Electric-Pair-Local mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Electric-Pair-Local mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(buffer-local-value 'electric-pair-mode (current-buffer))'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10340,14 +10441,17 @@ Minor mode for editing text/enriched files.
These are files with embedded formatting information in the MIME standard
text/enriched format.
-If called interactively, toggle `Enriched mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Enriched
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `enriched-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10599,20 +10703,43 @@ Encrypt marked files." t nil)
;;;***
+;;;### (autoloads nil "epa-ks" "epa-ks.el" (0 0 0 0))
+;;; Generated autoloads from epa-ks.el
+
+(autoload 'epa-search-keys "epa-ks" "\
+Ask a keyserver for all keys matching QUERY.
+
+The keyserver to be used is specified by `epa-keyserver'.
+
+If EXACT is non-nil (interactively, prefix argument), require
+exact matches.
+
+Note that the request may fail if the query is not specific
+enough, since keyservers have strict timeout settings.
+
+\(fn QUERY EXACT)" t nil)
+
+(register-definition-prefixes "epa-ks" '("epa-k"))
+
+;;;***
+
;;;### (autoloads nil "epa-mail" "epa-mail.el" (0 0 0 0))
;;; Generated autoloads from epa-mail.el
(autoload 'epa-mail-mode "epa-mail" "\
A minor-mode for composing encrypted/clearsigned mails.
-If called interactively, toggle `epa-mail mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `epa-mail
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `epa-mail-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10675,14 +10802,17 @@ or call the function `epa-global-mail-mode'.")
(autoload 'epa-global-mail-mode "epa-mail" "\
Minor mode to hook EasyPG into Mail mode.
-If called interactively, toggle `Epa-Global-Mail mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Epa-Global-Mail mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'epa-global-mail-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -10756,32 +10886,66 @@ Prompt the user for values of nick, server, port, and password." nil nil)
ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
-It permits you to select connection parameters, and then starts ERC.
+It allows selecting connection parameters, and then starts ERC.
Non-interactively, it takes the keyword arguments
(server (erc-compute-server))
(port (erc-compute-port))
(nick (erc-compute-nick))
password
- (full-name (erc-compute-full-name)))
+ (full-name (erc-compute-full-name))
That is, if called with
- (erc :server \"chat.freenode.net\" :full-name \"Harry S Truman\")
+ (erc :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
-then the server and full-name will be set to those values, whereas
-`erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
-be invoked for the values of the other parameters.
+then the server and full-name will be set to those values,
+whereas `erc-compute-port' and `erc-compute-nick' will be invoked
+for the values of the other parameters.
\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)))" t nil)
-(defalias 'erc-select 'erc)
+(defalias 'erc-select #'erc)
(autoload 'erc-tls "erc" "\
-Interactively select TLS connection parameters and run ERC.
-Arguments are the same as for `erc'.
+ERC is a powerful, modular, and extensible IRC client.
+This function is the main entry point for ERC over TLS.
+
+It allows selecting connection parameters, and then starts ERC
+over TLS.
+
+Non-interactively, it takes the keyword arguments
+ (server (erc-compute-server))
+ (port (erc-compute-port))
+ (nick (erc-compute-nick))
+ password
+ (full-name (erc-compute-full-name))
+ client-certificate
+
+That is, if called with
+
+ (erc-tls :server \"irc.libera.chat\" :full-name \"J. Random Hacker\")
+
+then the server and full-name will be set to those values,
+whereas `erc-compute-port' and `erc-compute-nick' will be invoked
+for the values of their respective parameters.
+
+CLIENT-CERTIFICATE, if non-nil, should either be a list where the
+first element is the certificate key file name, and the second
+element is the certificate file name itself, or t, which means
+that `auth-source' will be queried for the key and the
+certificate. Authenticating using a TLS client certificate is
+also refered to as \"CertFP\" (Certificate Fingerprint)
+authentication by various IRC networks.
+
+Example usage:
+
+ (erc-tls :server \"irc.libera.chat\" :port 6697
+ :client-certificate
+ '(\"/home/bandali/my-cert.key\"
+ \"/home/bandali/my-cert.crt\"))
-\(fn &rest R)" t nil)
+\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil)
(autoload 'erc-handle-irc-url "erc" "\
Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
@@ -10866,10 +11030,6 @@ it has to be wrapped in `(eval (quote ...))'.
(function-put 'ert-deftest 'lisp-indent-function '2)
-(put 'ert-deftest 'lisp-indent-function 2)
-
-(put 'ert-info 'lisp-indent-function 1)
-
(autoload 'ert-run-tests-batch "ert" "\
Run the tests specified by SELECTOR, printing results to the terminal.
@@ -10902,7 +11062,7 @@ and how to display message.
\(fn SELECTOR &optional OUTPUT-BUFFER-NAME MESSAGE-FN)" t nil)
-(defalias 'ert 'ert-run-tests-interactively)
+(defalias 'ert #'ert-run-tests-interactively)
(autoload 'ert-describe-test "ert" "\
Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
@@ -10916,8 +11076,6 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/ert-x.el
-(put 'ert-with-test-buffer 'lisp-indent-function 1)
-
(autoload 'ert-kill-all-test-buffers "ert-x" "\
Kill all test buffers that are still live." t nil)
@@ -11067,6 +11225,8 @@ Any other value means use the setting of `case-fold-search'.")
(custom-autoload 'tags-case-fold-search "etags" t)
+(put 'tags-case-fold-search 'safe-local-variable 'symbolp)
+
(defvar tags-table-list nil "\
List of file names of tags tables to search.
An element that is a directory means the file \"TAGS\" in that directory.
@@ -11298,7 +11458,7 @@ argument is passed to `next-file', which see).
(autoload 'tags-search "etags" "\
Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
-To continue searching for next match, use command \\[tags-loop-continue].
+To continue searching for next match, use the command \\[fileloop-continue].
If FILES if non-nil should be a list or an iterator returning the
files to search. The search will be restricted to these files.
@@ -11311,7 +11471,7 @@ Also see the documentation of the `tags-file-name' variable.
Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
-with the command \\[tags-loop-continue].
+with the command \\[fileloop-continue].
For non-interactive use, superseded by `fileloop-initialize-replace'.
\(fn FROM TO &optional DELIMITED FILES)" t nil)
@@ -12034,9 +12194,9 @@ INC may be passed as a numeric prefix argument.
The actual adjustment made depends on the final component of the
key-binding used to invoke the command, with all modifiers removed:
- +, = Increase the default face height by one step
- - Decrease the default face height by one step
- 0 Reset the default face height to the global default
+ +, = Increase the height of the default face by one step
+ - Decrease the height of the default face by one step
+ 0 Reset the height of the default face to the global default
After adjusting, continue to read input events and further adjust
the face height as long as the input event read
@@ -12058,14 +12218,17 @@ a top-level keymap, `text-scale-increase' or
(autoload 'buffer-face-mode "face-remap" "\
Minor mode for a buffer-specific default face.
-If called interactively, toggle `Buffer-Face mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Buffer-Face mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `buffer-face-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -12115,6 +12278,33 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
;;;***
+;;;### (autoloads nil "facemenu" "facemenu.el" (0 0 0 0))
+;;; Generated autoloads from facemenu.el
+ (autoload 'facemenu-menu "facemenu" nil nil 'keymap)
+
+(define-key global-map [C-down-mouse-2] 'facemenu-menu)
+
+(autoload 'list-colors-display "facemenu" "\
+Display names of defined colors, and show what they look like.
+If the optional argument LIST is non-nil, it should be a list of
+colors to display. Otherwise, this command computes a list of
+colors that the current display can handle. Customize
+`list-colors-sort' to change the order in which colors are shown.
+Type `g' or \\[revert-buffer] after customizing `list-colors-sort'
+to redisplay colors in the new order.
+
+If the optional argument BUFFER-NAME is nil, it defaults to *Colors*.
+
+If the optional argument CALLBACK is non-nil, it should be a
+function to call each time the user types RET or clicks on a
+color. The function should accept a single argument, the color name.
+
+\(fn &optional LIST BUFFER-NAME CALLBACK)" t nil)
+
+(register-definition-prefixes "facemenu" '("facemenu-" "list-colors-"))
+
+;;;***
+
;;;### (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)
@@ -12211,6 +12401,11 @@ reminders, you can set `feedmail-queue-reminder-alist' to nil.
;;;### (autoloads nil "ffap" "ffap.el" (0 0 0 0))
;;; Generated autoloads from ffap.el
+(defvar ffap-file-finder 'find-file "\
+The command called by `find-file-at-point' to find a file.")
+
+(custom-autoload 'ffap-file-finder "ffap" t)
+
(autoload 'ffap-next "ffap" "\
Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
@@ -12379,6 +12574,8 @@ Otherwise, signal a `file-notify-error'.
\(fn OBJECT)" t nil)
+(function-put 'file-notify-handle-event 'completion-predicate #'ignore)
+
(register-definition-prefixes "filenotify" '("file-notify-"))
;;;***
@@ -12576,7 +12773,7 @@ specifies what to use in place of \"-ls\" as the final argument.
;;;### (autoloads nil "find-file" "find-file.el" (0 0 0 0))
;;; Generated autoloads from find-file.el
-(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\
+(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") \, (lambda nil (match-string 2)))) "\
List of special constructs recognized by `ff-treat-as-special'.
Each element, tried in order, has the form (REGEXP . EXTRACT).
If REGEXP matches the current line (from the beginning of the line),
@@ -12594,7 +12791,7 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window.
\(fn &optional IN-OTHER-WINDOW)" t nil)
-(defalias 'ff-find-related-file 'ff-find-other-file)
+(defalias 'ff-find-related-file #'ff-find-other-file)
(autoload 'ff-find-other-file "find-file" "\
Find the header or source file corresponding to this file.
@@ -12603,6 +12800,10 @@ Being on a `#include' line pulls in that file.
If optional IN-OTHER-WINDOW is non-nil, find the file in the other window.
If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines.
+If optional EVENT is non-nil (default `last-nonmenu-event', move
+point to the end position of that event before calling the
+various ff-* hooks.
+
Variables of interest include:
- `ff-case-fold-search'
@@ -12649,15 +12850,14 @@ Variables of interest include:
- `ff-file-created-hook'
List of functions to be called if the other file has been created.
-\(fn &optional IN-OTHER-WINDOW IGNORE-INCLUDE)" t nil)
+\(fn &optional IN-OTHER-WINDOW IGNORE-INCLUDE EVENT)" t nil)
-(autoload 'ff-mouse-find-other-file "find-file" "\
-Visit the file you click on.
+(define-obsolete-function-alias 'ff-mouse-find-other-file #'ff-find-other-file "28.1")
-\(fn EVENT)" t nil)
+(define-obsolete-function-alias 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1")
-(autoload 'ff-mouse-find-other-file-other-window "find-file" "\
-Visit the file you click on in another window.
+(autoload 'ff-find-other-file-other-window "find-file" "\
+Visit the file you point at in another window.
\(fn EVENT)" t nil)
@@ -12878,7 +13078,6 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP.
;;;### (autoloads nil "finder" "finder.el" (0 0 0 0))
;;; Generated autoloads from finder.el
-(push (purecopy '(finder 1 0)) package--builtin-versions)
(autoload 'finder-list-keywords "finder" "\
Display descriptions of the keywords in the Finder buffer." t nil)
@@ -12947,7 +13146,7 @@ lines.
(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 warning. If this form is included in a file,
the generated warning contains an indication of the file that
generated it.
@@ -12986,14 +13185,17 @@ region is invalid. This function saves match data.
(autoload 'flymake-mode "flymake" "\
Toggle Flymake mode on or off.
-If called interactively, toggle `Flymake mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Flymake
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `flymake-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13074,14 +13276,17 @@ Turn on `flyspell-mode' for comments and strings." t nil)
(autoload 'flyspell-mode "flyspell" "\
Toggle on-the-fly spell checking (Flyspell mode).
-If called interactively, toggle `Flyspell mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Flyspell
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `flyspell-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13157,14 +13362,17 @@ Turn off Follow mode. Please see the function `follow-mode'." nil nil)
(autoload 'follow-mode "follow" "\
Toggle Follow mode.
-If called interactively, toggle `Follow mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Follow
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `follow-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13287,14 +13495,17 @@ selected if the original window is the first one in the frame.
(autoload 'footnote-mode "footnote" "\
Toggle Footnote mode.
-If called interactively, toggle `Footnote mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Footnote
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `footnote-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13757,14 +13968,17 @@ being transferred. This list may grow up to a size of
`gdb-debug-log-max' after which the oldest element (at the end of
the list) is deleted every time a new one is added (at the front).
-If called interactively, toggle `Gdb-Enable-Debug mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Gdb-Enable-Debug mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'gdb-enable-debug)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -13941,14 +14155,17 @@ regular expression that can be used as an element of
(autoload 'glasses-mode "glasses" "\
Minor mode for making identifiers likeThis readable.
-If called interactively, toggle `Glasses mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Glasses
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `glasses-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -14190,7 +14407,7 @@ Make the current buffer look like a nice article." nil nil)
;;; Generated autoloads from gnus/gnus-bookmark.el
(autoload 'gnus-bookmark-set "gnus-bookmark" "\
-Set a bookmark for this article." t nil)
+Set a bookmark for this article." '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-bookmark-jump "gnus-bookmark" "\
Jump to a Gnus bookmark (BMK-NAME).
@@ -14296,7 +14513,7 @@ The value of `message-draft-headers' determines which headers are
generated when the article is delayed. Remaining headers are
generated when the article is sent.
-\(fn DELAY)" t nil)
+\(fn DELAY)" '(message-mode) nil)
(autoload 'gnus-delay-send-queue "gnus-delay" "\
Send all the delayed messages that are due now." t nil)
@@ -14440,13 +14657,13 @@ Insert a random Face header from `gnus-face-directory'." nil nil)
Display gravatar in the From header.
If gravatar is already displayed, remove it.
-\(fn &optional FORCE)" t nil)
+\(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-treat-mail-gravatar "gnus-gravatar" "\
Display gravatars in the Cc and To headers.
If gravatars are already displayed, remove them.
-\(fn &optional FORCE)" t nil)
+\(fn &optional FORCE)" '(gnus-article-mode gnus-summary-mode) nil)
(register-definition-prefixes "gnus-gravatar" '("gnus-gravatar-"))
@@ -14556,16 +14773,19 @@ If FORCE is non-nil, replace the old ones.
(autoload 'gnus-mailing-list-mode "gnus-ml" "\
Minor mode for providing mailing-list commands.
-If called interactively, toggle `Gnus-Mailing-List mode'. If the
-prefix argument is positive, enable the mode, and if it is zero
-or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Gnus-Mailing-List mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `gnus-mailing-list-mode'.
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
\\{gnus-mailing-list-mode-map}
@@ -14724,15 +14944,15 @@ This is typically a function to add in
(autoload 'gnus-treat-from-picon "gnus-picon" "\
Display picons in the From header.
-If picons are already displayed, remove them." t nil)
+If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-treat-mail-picon "gnus-picon" "\
Display picons in the Cc and To headers.
-If picons are already displayed, remove them." t nil)
+If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil)
(autoload 'gnus-treat-newsgroups-picon "gnus-picon" "\
Display picons in the Newsgroups and Followup-To headers.
-If picons are already displayed, remove them." t nil)
+If picons are already displayed, remove them." '(gnus-article-mode gnus-summary-mode) nil)
(register-definition-prefixes "gnus-picon" '("gnus-picon-"))
@@ -14766,6 +14986,8 @@ Both lists have to be sorted over <.
\(fn LIST1 LIST2)" nil nil)
+(make-obsolete 'gnus-intersection 'seq-intersection '"28.1")
+
(autoload 'gnus-sorted-intersection "gnus-range" "\
Return intersection of LIST1 and LIST2.
LIST1 and LIST2 have to be sorted over <.
@@ -14864,7 +15086,7 @@ between gnus-sieve-region-start and gnus-sieve-region-end with
\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost).
See the documentation for these variables and functions for details." t nil)
-(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil t nil)
+(autoload 'gnus-sieve-article-add-rule "gnus-sieve" nil '(gnus-article-mode gnus-summary-mode) nil)
(register-definition-prefixes "gnus-sieve" '("gnus-sieve-"))
@@ -15021,14 +15243,17 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
(autoload 'goto-address-mode "goto-addr" "\
Minor mode to buttonize URLs and e-mail addresses in the current buffer.
-If called interactively, toggle `Goto-Address mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Goto-Address mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `goto-address-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -15062,14 +15287,17 @@ See `goto-address-mode' for more information on Goto-Address mode.
(autoload 'goto-address-prog-mode "goto-addr" "\
Like `goto-address-mode', but only for comments and strings.
-If called interactively, toggle `Goto-Address-Prog mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Goto-Address-Prog mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `goto-address-prog-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -15139,7 +15367,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches" 1 nil nil 0 1)) "\
+(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:" "\\(?:[a-zA-Z]:\\)?" "[^\n:]+?[^\n/:]\\):[\11 ]*\\(?2:[1-9][0-9]*\\)[\11 ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg 1)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches" 1 nil nil 0 1)) "\
Regexp used to match grep hits.
See `compilation-error-regexp-alist' for format details.")
@@ -15402,14 +15630,17 @@ or call the function `gud-tooltip-mode'.")
(autoload 'gud-tooltip-mode "gud" "\
Toggle the display of GUD tooltips.
-If called interactively, toggle `Gud-Tooltip mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Gud-Tooltip mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'gud-tooltip-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -15472,6 +15703,8 @@ arguments as NAME. DO is a function as defined in `gv-get'.
(or (assq 'gv-setter defun-declarations-alist) (push (list 'gv-setter #'gv--setter-defun-declaration) defun-declarations-alist))
+(let ((spec (get 'compiler-macro 'edebug-declaration-spec))) (put 'gv-expander 'edebug-declaration-spec spec) (put 'gv-setter 'edebug-declaration-spec spec))
+
(autoload 'gv-define-setter "gv" "\
Define a setter method for generalized variable NAME.
This macro is an easy-to-use substitute for `gv-define-expander' that works
@@ -15512,7 +15745,7 @@ The return value is the last VAL in the list.
\(fn PLACE VAL PLACE VAL ...)" nil t)
-(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+(def-edebug-elem-spec 'gv-place '(form))
(autoload 'gv-ref "gv" "\
Return a reference to PLACE.
@@ -15760,6 +15993,12 @@ When called from lisp, FUNCTION may also be a function object.
\(fn FUNCTION)" t nil)
+(autoload 'describe-command "help-fns" "\
+Display the full documentation of COMMAND (a symbol).
+When called from lisp, COMMAND may also be a function object.
+
+\(fn COMMAND)" t nil)
+
(autoload 'help-C-file-name "help-fns" "\
Return the name of the C file where SUBR-OR-VAR is defined.
KIND should be `var' for a variable or `subr' for a subroutine.
@@ -15949,7 +16188,7 @@ it does not already exist." nil nil)
Parse and hyperlink documentation cross-references in the given BUFFER.
Find cross-reference information in a buffer and activate such cross
-references for selection with `help-follow'. Cross-references have
+references for selection with `help-follow-symbol'. Cross-references have
the canonical form `...' and the type of reference may be
disambiguated by the preceding word(s) used in
`help-xref-symbol-regexp'. Faces only get cross-referenced if
@@ -15993,7 +16232,7 @@ Add xrefs for symbols in `pp's output between FROM and TO.
(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
(autoload 'help-bookmark-jump "help-mode" "\
-Jump to help-mode bookmark BOOKMARK.
+Jump to `help-mode' bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
BOOKMARK is a bookmark name or a bookmark record.
@@ -16074,22 +16313,30 @@ also supported.
There are several ways to change text in hexl mode:
-ASCII characters (character between space (0x20) and tilde (0x7E)) are
-bound to self-insert so you can simply type the character and it will
-insert itself (actually overstrike) into the buffer.
+Self-inserting characters are bound to `hexl-self-insert' so you
+can simply type the character and it will insert itself (actually
+overstrike) into the buffer. However, inserting non-ASCII characters
+requires caution: the buffer's coding-system should correspond to
+the encoding on disk, and multibyte characters should be inserted
+with cursor on the first byte of a multibyte sequence whose length
+is identical to the length of the multibyte sequence to be inserted,
+otherwise this could produce invalid multibyte sequences. Non-ASCII
+characters in ISO-2022 encodings should preferably inserted byte by
+byte, to avoid problems caused by the designation sequences before
+the actual characters.
\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
it isn't bound to self-insert. An octal number can be supplied in place
of another key to insert the octal number's ASCII representation.
-\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
-into the buffer at the current point.
+\\[hexl-insert-hex-char] will insert a given hexadecimal value
+into the buffer at the current address.
-\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
-into the buffer at the current point.
+\\[hexl-insert-octal-char] will insert a given octal value
+into the buffer at the current address.
-\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
-into the buffer at the current point.
+\\[hexl-insert-decimal-char] will insert a given decimal value
+into the buffer at the current address..
\\[hexl-mode-exit] will exit `hexl-mode'.
@@ -16105,7 +16352,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(autoload 'hexl-find-file "hexl" "\
Edit file FILENAME as a binary file in hex dump format.
Switch to a buffer visiting file FILENAME, creating one if none exists,
-and edit the file in `hexl-mode'.
+and edit the file in `hexl-mode'. The buffer's coding-system will be
+no-conversion, unlike if you visit it normally and then invoke `hexl-mode'.
\(fn FILENAME)" t nil)
@@ -16123,14 +16371,17 @@ This discards the buffer's undo information." t nil)
(autoload 'hi-lock-mode "hi-lock" "\
Toggle selective highlighting of patterns (Hi Lock mode).
-If called interactively, toggle `Hi-Lock mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Hi-Lock
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hi-lock-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16334,14 +16585,17 @@ Add patterns from the current buffer to the list of hi-lock patterns." t nil)
(autoload 'hide-ifdef-mode "hideif" "\
Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode).
-If called interactively, toggle `Hide-Ifdef mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Hide-Ifdef
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hide-ifdef-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16419,14 +16673,17 @@ whitespace. Case does not matter.")
(autoload 'hs-minor-mode "hideshow" "\
Minor mode to selectively hide/show code and comment blocks.
-If called interactively, toggle `Hs minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `hs minor
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hs-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16469,14 +16726,17 @@ Unconditionally turn off `hs-minor-mode'." nil nil)
(autoload 'highlight-changes-mode "hilit-chg" "\
Toggle highlighting changes in this buffer (Highlight Changes mode).
-If called interactively, toggle `Highlight-Changes mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Highlight-Changes mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `highlight-changes-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16500,14 +16760,18 @@ buffer with the contents of a file
(autoload 'highlight-changes-visible-mode "hilit-chg" "\
Toggle visibility of highlighting due to Highlight Changes mode.
-If called interactively, toggle `Highlight-Changes-Visible mode'. If
-the prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Highlight-Changes-Visible mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `highlight-changes-visible-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16638,7 +16902,7 @@ Construct a function similar to `hippie-expand'.
Make it use the expansion functions in TRY-LIST. An optional second
argument VERBOSE non-nil makes the function verbose.
-\(fn TRY-LIST &optional VERBOSE)" nil t)
+\(fn TRY-LIST &optional VERBOSE)" nil nil)
(register-definition-prefixes "hippie-exp" '("he-" "hippie-expand-" "try-"))
@@ -16650,14 +16914,17 @@ argument VERBOSE non-nil makes the function verbose.
(autoload 'hl-line-mode "hl-line" "\
Toggle highlighting of the current line (Hl-Line mode).
-If called interactively, toggle `Hl-Line mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Hl-Line
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `hl-line-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -16686,14 +16953,17 @@ or call the function `global-hl-line-mode'.")
(autoload 'global-hl-line-mode "hl-line" "\
Toggle line highlighting in all buffers (Global Hl-Line mode).
-If called interactively, toggle `Global Hl-Line mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Global
+Hl-Line mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-hl-line-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17005,7 +17275,7 @@ buffers which are visiting a file.
(autoload 'ibuffer "ibuffer" "\
Begin using Ibuffer to edit a list of buffers.
-Type `h' after entering ibuffer for more information.
+Type \\<ibuffer-mode-map>\\[describe-mode] after entering ibuffer for more information.
All arguments are optional.
OTHER-WINDOW-P says to use another window.
@@ -17029,7 +17299,7 @@ If optional arg OTHER-WINDOW is non-nil, then use another window.
\(fn &optional OTHER-WINDOW)" t nil)
-(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "size"))
+(register-definition-prefixes "ibuffer" '("filename" "ibuffer-" "locked" "mark" "mod" "name" "process" "read-only" "recency" "size"))
;;;***
@@ -17104,14 +17374,17 @@ or call the function `fido-mode'.")
(autoload 'fido-mode "icomplete" "\
An enhanced `icomplete-mode' that emulates `ido-mode'.
-If called interactively, toggle `Fido mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Fido mode'
+mode. If the prefix argument is positive, enable the mode, and if it
+is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'fido-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17133,14 +17406,17 @@ or call the function `icomplete-mode'.")
(autoload 'icomplete-mode "icomplete" "\
Toggle incremental minibuffer completion (Icomplete mode).
-If called interactively, toggle `Icomplete mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Icomplete
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'icomplete-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17158,12 +17434,45 @@ completions:
\\{icomplete-minibuffer-map}
\(fn &optional ARG)" t nil)
+
+(defvar icomplete-vertical-mode nil "\
+Non-nil if Icomplete-Vertical mode is enabled.
+See the `icomplete-vertical-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 `icomplete-vertical-mode'.")
+
+(custom-autoload 'icomplete-vertical-mode "icomplete" nil)
+
+(autoload 'icomplete-vertical-mode "icomplete" "\
+Toggle vertical candidate display in `icomplete-mode' or `fido-mode'.
+
+This is a minor mode. If called interactively, toggle the
+`Icomplete-Vertical mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'icomplete-vertical-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+As many completion candidates as possible are displayed, depending on
+the value of `max-mini-window-height', and the way the mini-window is
+resized depends on `resize-mini-windows'.
+
+\(fn &optional ARG)" t nil)
(when (locate-library "obsolete/iswitchb")
(autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t)
(make-obsolete 'iswitchb-mode
"use `icomplete-mode' or `ido-mode' instead." "24.4"))
-(register-definition-prefixes "icomplete" '("icomplete-"))
+(register-definition-prefixes "icomplete" '("fido-vertical-mode" "icomplete-"))
;;;***
@@ -17291,7 +17600,7 @@ The main features of this mode are
Use \\[idlwave-fill-paragraph] to refill a paragraph inside a
comment. The indentation of the second line of the paragraph
relative to the first will be retained. Use
- \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these
+ \\[auto-fill-mode] to toggle auto-fill mode for these
comments. When the variable `idlwave-fill-comment-line-only' is
nil, code can also be auto-filled and auto-indented.
@@ -17681,14 +17990,17 @@ See `inferior-emacs-lisp-mode' for details.
(autoload 'iimage-mode "iimage" "\
Toggle Iimage mode on or off.
-If called interactively, toggle `Iimage mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Iimage
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `iimage-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -17805,12 +18117,16 @@ means display it in the right marginal area.
(autoload 'insert-image "image" "\
Insert IMAGE into current buffer at point.
IMAGE is displayed by inserting STRING into the current buffer
-with a `display' property whose value is the image. STRING
-defaults to a single space if you omit it.
+with a `display' property whose value is the image.
+
+STRING defaults to a single space if you omit it, which means
+that the inserted image will behave as whitespace syntactically.
+
AREA is where to display the image. AREA nil or omitted means
display it in the text area, a value of `left-margin' means
display it in the left marginal area, a value of `right-margin'
means display it in the right marginal area.
+
SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
specifying the X and Y positions and WIDTH and HEIGHT of image area
@@ -17997,14 +18313,17 @@ Setup easy-to-use keybindings for the commands to be used in dired mode.
Note that n, p and <down> and <up> will be hijacked and bound to
`image-dired-dired-x-line'.
-If called interactively, toggle `Image-Dired minor mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Image-Dired minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `image-dired-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -18099,14 +18418,17 @@ or call the function `auto-image-file-mode'.")
(autoload 'auto-image-file-mode "image-file" "\
Toggle visiting of image files as images (Auto Image File mode).
-If called interactively, toggle `Auto-Image-File mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Auto-Image-File mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'auto-image-file-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -18134,14 +18456,17 @@ Key bindings:
(autoload 'image-minor-mode "image-mode" "\
Toggle Image minor mode in this buffer.
-If called interactively, toggle `Image minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Image
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `image-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -18192,7 +18517,7 @@ element should come before the second. The arguments are cons cells;
(custom-autoload 'imenu-sort-function "imenu" t)
-(defvar imenu-generic-expression nil "\
+(defvar-local imenu-generic-expression nil "\
List of definition matchers for creating an Imenu index.
Each element of this list should have the form
@@ -18228,9 +18553,7 @@ characters which normally have \"symbol\" syntax are considered to have
\"word\" syntax during matching.")
(put 'imenu-generic-expression 'risky-local-variable t)
-(make-variable-buffer-local 'imenu-generic-expression)
-
-(defvar imenu-create-index-function 'imenu-default-create-index-function "\
+(defvar-local imenu-create-index-function 'imenu-default-create-index-function "\
The function to use for creating an index alist of the current buffer.
It should be a function that takes no arguments and returns
@@ -18239,9 +18562,7 @@ called within a `save-excursion'.
See `imenu--index-alist' for the format of the buffer index alist.")
-(make-variable-buffer-local 'imenu-create-index-function)
-
-(defvar imenu-prev-index-position-function 'beginning-of-defun "\
+(defvar-local imenu-prev-index-position-function 'beginning-of-defun "\
Function for finding the next index position.
If `imenu-create-index-function' is set to
@@ -18252,18 +18573,14 @@ file.
The function should leave point at the place to be connected to the
index and it should return nil when it doesn't find another index.")
-(make-variable-buffer-local 'imenu-prev-index-position-function)
-
-(defvar imenu-extract-index-name-function nil "\
+(defvar-local imenu-extract-index-name-function nil "\
Function for extracting the index item name, given a position.
This function is called after `imenu-prev-index-position-function'
finds a position for an index item, with point at that position.
It should return the name for that index item.")
-(make-variable-buffer-local 'imenu-extract-index-name-function)
-
-(defvar imenu-name-lookup-function nil "\
+(defvar-local imenu-name-lookup-function nil "\
Function to compare string with index item.
This function will be called with two strings, and should return
@@ -18274,18 +18591,28 @@ Set this to some other function for more advanced comparisons,
such as \"begins with\" or \"name matches and number of
arguments match\".")
-(make-variable-buffer-local 'imenu-name-lookup-function)
-
-(defvar imenu-default-goto-function 'imenu-default-goto-function "\
+(defvar-local imenu-default-goto-function 'imenu-default-goto-function "\
The default function called when selecting an Imenu item.
The function in this variable is called when selecting a normal index-item.")
-
-(make-variable-buffer-local 'imenu-default-goto-function)
(put 'imenu--index-alist 'risky-local-variable t)
-(make-variable-buffer-local 'imenu-syntax-alist)
+(defvar-local imenu-syntax-alist nil "\
+Alist of syntax table modifiers to use while in `imenu--generic-function'.
+
+The car of the assocs may be either a character or a string and the
+cdr is a syntax description appropriate for `modify-syntax-entry'. For
+a string, all the characters in the string get the specified syntax.
-(make-variable-buffer-local 'imenu-case-fold-search)
+This is typically used to give word syntax to characters which
+normally have symbol syntax to simplify `imenu-expression'
+and speed-up matching.")
+
+(defvar-local imenu-case-fold-search t "\
+Defines whether `imenu--generic-function' should fold case when matching.
+
+This variable should be set (only) by initialization code
+for modes which use `imenu--generic-function'. If it is not set, but
+`font-lock-defaults' is set, then font-lock's setting is used.")
(autoload 'imenu-add-to-menubar "imenu" "\
Add an `imenu' entry to the menu bar for the current buffer.
@@ -18349,9 +18676,14 @@ Convert old Emacs Devanagari characters to UCS.
Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch
to that buffer.
+
With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
+
+If any parts of the command name contains spaces, they should be
+quoted using shell quote syntax.
+
\(Type \\[describe-mode] in the process buffer for a list of commands.)
\(fn CMD)" t nil)
@@ -18757,25 +19089,6 @@ See Info node `(elisp)Defining Functions' for more details.
;;;***
-;;;### (autoloads nil "inversion" "cedet/inversion.el" (0 0 0 0))
-;;; Generated autoloads from cedet/inversion.el
-(push (purecopy '(inversion 1 3)) package--builtin-versions)
-
-(autoload 'inversion-require-emacs "inversion" "\
-Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
-Only checks one based on which kind of Emacs is being run.
-
-This function is obsolete; do this instead:
- (when (version<= \"28.1\" emacs-version) ...)
-
-\(fn EMACS-VER XEMACS-VER SXEMACS-VER)" nil nil)
-
-(make-obsolete 'inversion-require-emacs 'nil '"28.1")
-
-(register-definition-prefixes "inversion" '("inversion-"))
-
-;;;***
-
;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (0
;;;;;; 0 0 0))
;;; Generated autoloads from international/isearch-x.el
@@ -19095,14 +19408,17 @@ available on the net." t nil)
(autoload 'ispell-minor-mode "ispell" "\
Toggle last-word spell checking (Ispell minor mode).
-If called interactively, toggle `ISpell minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `ISpell
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `ispell-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -19253,7 +19569,7 @@ It is not recommended to set this variable permanently to anything but nil.")
Uninstall jka-compr.
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
and `inhibit-local-variables-suffixes' that were added
-by `jka-compr-installed'." nil nil)
+by `jka-compr-install'." nil nil)
(register-definition-prefixes "jka-compr" '("compression-error" "jka-compr-"))
@@ -19418,12 +19734,12 @@ and the return value is the length of the conversion.
;;;### (autoloads nil "kmacro" "kmacro.el" (0 0 0 0))
;;; Generated autoloads from kmacro.el
- (global-set-key "\C-x(" 'kmacro-start-macro)
- (global-set-key "\C-x)" 'kmacro-end-macro)
- (global-set-key "\C-xe" 'kmacro-end-and-call-macro)
- (global-set-key [f3] 'kmacro-start-macro-or-insert-counter)
- (global-set-key [f4] 'kmacro-end-or-call-macro)
- (global-set-key "\C-x\C-k" 'kmacro-keymap)
+ (global-set-key "\C-x(" #'kmacro-start-macro)
+ (global-set-key "\C-x)" #'kmacro-end-macro)
+ (global-set-key "\C-xe" #'kmacro-end-and-call-macro)
+ (global-set-key [f3] #'kmacro-start-macro-or-insert-counter)
+ (global-set-key [f4] #'kmacro-end-or-call-macro)
+ (global-set-key "\C-x\C-k" #'kmacro-keymap)
(autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap)
(autoload 'kmacro-exec-ring-item "kmacro" "\
@@ -19703,13 +20019,13 @@ A major mode to edit GNU ld script files
;;;;;; (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-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-output-directory 'safe-local-variable #'stringp)
-(put 'less-css-input-file-name '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" "\
@@ -19790,14 +20106,17 @@ sleep in seconds.
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
-If called interactively, toggle `Linum mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Linum
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `linum-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -19931,28 +20250,28 @@ except that FILTER is not optional.
;;; Generated autoloads from vc/log-edit.el
(autoload 'log-edit "log-edit" "\
-Setup a buffer to enter a log message.
-The buffer is put in mode MODE or `log-edit-mode' if MODE is nil.
+Setup a buffer to enter a VC commit log message.
+The buffer is put in mode MODE, or `log-edit-mode' if MODE is nil.
\\<log-edit-mode-map>
If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
Set mark and point around the entire contents of the buffer, so
that it is easy to kill the contents of the buffer with
-\\[kill-region]. Once the user is done editing the message,
-invoking the command \\[log-edit-done] (`log-edit-done') will
-call CALLBACK to do the actual commit.
+\\[kill-region]. Once the user is done editing the message, he
+or she is expected to invoke the command \\[log-edit-done] (`log-edit-done'),
+which will call CALLBACK, a function to do the actual commit.
-PARAMS if non-nil is an alist of variables and buffer-local
-values to give them in the Log Edit buffer. Possible keys and
-associated values:
+PARAMS, if non-nil, is an alist of variables and buffer-local
+values to give to those variables in the Log Edit buffer. Possible
+keys and associated values are:
`log-edit-listfun' -- function taking no arguments that returns the list of
- files that are concerned by the current operation (using relative names);
+ files that are concerned by the current operation (using relative names);
`log-edit-diff-function' -- function taking no arguments that
- displays a diff of the files concerned by the current operation.
+ displays a diff of the files concerned by the current operation.
`vc-log-fileset' -- the VC fileset to be committed (if any).
-If BUFFER is non-nil `log-edit' will jump to that buffer, use it
+If BUFFER is non-nil, `log-edit' will switch to that buffer, use it
to edit the log message and go back to the current buffer when
-done. Otherwise, it uses the current buffer.
+done. Otherwise, this function will use the current buffer.
\(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil)
@@ -20368,14 +20687,17 @@ or call the function `mail-abbrevs-mode'.")
(autoload 'mail-abbrevs-mode "mailabbrev" "\
Toggle abbrev expansion of mail aliases (Mail Abbrevs mode).
-If called interactively, toggle `Mail-Abbrevs mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'mail-abbrevs-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -20492,6 +20814,50 @@ The mail client is taken to be the handler of mailto URLs." nil nil)
;;;### (autoloads nil "mairix" "net/mairix.el" (0 0 0 0))
;;; Generated autoloads from net/mairix.el
+(autoload 'mairix-search "mairix" "\
+Call Mairix with SEARCH.
+If THREADS is non-nil, also display whole threads of found
+messages. Results will be put into the default search file.
+
+\(fn SEARCH THREADS)" t nil)
+
+(autoload 'mairix-use-saved-search "mairix" "\
+Use a saved search for querying Mairix." t nil)
+
+(autoload 'mairix-edit-saved-searches-customize "mairix" "\
+Edit the list of saved searches in a customization buffer." t nil)
+
+(autoload 'mairix-search-from-this-article "mairix" "\
+Search messages from sender of the current article.
+This is effectively a shortcut for calling `mairix-search' with
+f:current_from. If prefix THREADS is non-nil, include whole
+threads.
+
+\(fn THREADS)" t nil)
+
+(autoload 'mairix-search-thread-this-article "mairix" "\
+Search thread for the current article.
+This is effectively a shortcut for calling `mairix-search'
+with m:msgid of the current article and enabled threads." t nil)
+
+(autoload 'mairix-widget-search-based-on-article "mairix" "\
+Create mairix query based on current article using widgets." t nil)
+
+(autoload 'mairix-edit-saved-searches "mairix" "\
+Edit current mairix searches." t nil)
+
+(autoload 'mairix-widget-search "mairix" "\
+Create mairix query interactively using graphical widgets.
+MVALUES may contain values from current article.
+
+\(fn &optional MVALUES)" t nil)
+
+(autoload 'mairix-update-database "mairix" "\
+Call mairix for updating the database for SERVERS.
+Mairix will be called asynchronously unless
+`mairix-synchronous-update' is t. Mairix will be called with
+`mairix-update-options'." t nil)
+
(register-definition-prefixes "mairix" '("mairix-"))
;;;***
@@ -20616,13 +20982,6 @@ An adapted `makefile-mode' that knows about imake.
;;;***
-;;;### (autoloads nil "makeinfo" "textmodes/makeinfo.el" (0 0 0 0))
-;;; Generated autoloads from textmodes/makeinfo.el
-
-(register-definition-prefixes "makeinfo" '("makeinfo-"))
-
-;;;***
-
;;;### (autoloads nil "makesum" "makesum.el" (0 0 0 0))
;;; Generated autoloads from makesum.el
@@ -20685,7 +21044,7 @@ to auto-complete your input based on the installed manual pages.
(autoload 'man-follow "man" "\
Get a Un*x manual page of the item under point and put it in a buffer.
-\(fn MAN-ARGS)" t nil)
+\(fn MAN-ARGS)" '(man-common) nil)
(autoload 'Man-bookmark-jump "man" "\
Default bookmark handler for Man buffers.
@@ -20698,7 +21057,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 2 1)) package--builtin-versions)
+(push (purecopy '(map 3 0)) package--builtin-versions)
(register-definition-prefixes "map" '("map-"))
@@ -20710,14 +21069,17 @@ Default bookmark handler for Man buffers.
(autoload 'master-mode "master" "\
Toggle Master mode.
-If called interactively, toggle `Master mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Master
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `master-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -20752,14 +21114,18 @@ or call the function `minibuffer-depth-indicate-mode'.")
(autoload 'minibuffer-depth-indicate-mode "mb-depth" "\
Toggle Minibuffer Depth Indication mode.
-If called interactively, toggle `Minibuffer-Depth-Indicate mode'. If
-the prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Minibuffer-Depth-Indicate mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'minibuffer-depth-indicate-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -20815,7 +21181,7 @@ OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION
is a function used to switch to and display the mail buffer.
-\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" t nil)
+\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest _)" t nil)
(autoload 'message-news "message" "\
Start editing a news article to be sent.
@@ -20922,9 +21288,12 @@ which specify the range to operate on.
Command to parse command line mailto: links.
This is meant to be used for MIME handlers: Setting the handler
for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
-will then start up Emacs ready to compose mail." t nil)
+will then start up Emacs ready to compose mail. For emacsclient use
+ emacsclient -e '(message-mailto \"%u\")'
+
+\(fn &optional URL)" t nil)
-(register-definition-prefixes "message" '("message-" "nil"))
+(register-definition-prefixes "message" '("message-"))
;;;***
@@ -21314,14 +21683,17 @@ or call the function `midnight-mode'.")
(autoload 'midnight-mode "midnight" "\
Non-nil means run `midnight-hook' at midnight.
-If called interactively, toggle `Midnight mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Midnight
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'midnight-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -21366,14 +21738,18 @@ or call the function `minibuffer-electric-default-mode'.")
(autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\
Toggle Minibuffer Electric Default mode.
-If called interactively, toggle `Minibuffer-Electric-Default mode'.
-If the prefix argument is positive, enable the mode, and if it is zero
-or negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Minibuffer-Electric-Default mode' mode. If the prefix argument is
+positive, enable the mode, and if it is zero or negative, disable the
+mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'minibuffer-electric-default-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -21503,6 +21879,9 @@ Sequence of files visited by multiple file buffers Isearch.")
Set up isearch to search multiple buffers.
Intended to be added to `isearch-mode-hook'." nil nil)
+(autoload 'multi-isearch-switch-buffer "misearch" "\
+Switch to the next buffer in multi-buffer search." nil nil)
+
(autoload 'multi-isearch-buffers "misearch" "\
Start multi-buffer Isearch on a list of BUFFERS.
This list can contain live buffers or their names.
@@ -21944,14 +22323,17 @@ or call the function `msb-mode'.")
(autoload 'msb-mode "msb" "\
Toggle Msb mode.
-If called interactively, toggle `Msb mode'. If the prefix argument is
-positive, enable the mode, and if it is zero or negative, disable the
-mode.
+This is a minor mode. If called interactively, toggle the `Msb mode'
+mode. If the prefix argument is positive, enable the mode, and if it
+is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'msb-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -22202,7 +22584,8 @@ This affects the implicit sorting of lists of coding systems returned by
operations such as `find-coding-systems-region'.
\(fn CODING-SYSTEMS &rest BODY)" nil t)
-(put 'with-coding-priority 'lisp-indent-function 1)
+
+(function-put 'with-coding-priority 'lisp-indent-function '1)
(autoload 'detect-coding-with-language-environment "mule-util" "\
Detect a coding system for the text between FROM and TO with LANG-ENV.
@@ -22246,6 +22629,35 @@ QUALITY can be:
;;;### (autoloads nil "mwheel" "mwheel.el" (0 0 0 0))
;;; Generated autoloads from mwheel.el
+(defcustom mouse-wheel-mode t "\
+Non-nil if Mouse-Wheel mode is enabled.
+See the `mouse-wheel-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 `mouse-wheel-mode'." :set #'custom-set-minor-mode :initialize 'custom-initialize-delay :type 'boolean :group 'mouse)
+
+(custom-autoload 'mouse-wheel-mode "mwheel" nil)
+
+(autoload 'mouse-wheel-mode "mwheel" "\
+Toggle mouse wheel support (Mouse Wheel mode).
+
+This is a minor mode. If called interactively, toggle the
+`Mouse-Wheel mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'mouse-wheel-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
+
(register-definition-prefixes "mwheel" '("mouse-wheel-" "mwheel-"))
;;;***
@@ -22506,7 +22918,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters').
\(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil)
-(defalias 'open-protocol-stream 'open-network-stream)
+(define-obsolete-function-alias 'open-protocol-stream #'open-network-stream "26.1")
(register-definition-prefixes "network-stream" '("network-stream-"))
@@ -24200,18 +24612,23 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
`outline-mode-hook', if they are non-nil.
\(fn)" t nil)
+(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp)
+(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp)
(autoload 'outline-minor-mode "outline" "\
Toggle Outline minor mode.
-If called interactively, toggle `Outline minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Outline
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `outline-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -24345,7 +24762,11 @@ directory.
(autoload 'package-install-selected-packages "package" "\
Ensure packages in `package-selected-packages' are installed.
-If some packages are not installed propose to install them." t nil)
+If some packages are not installed, propose to install them.
+If optional argument NOCONFIRM is non-nil, don't ask for
+confirmation to install packages.
+
+\(fn &optional NOCONFIRM)" t nil)
(autoload 'package-reinstall "package" "\
Reinstall package PKG.
@@ -24441,14 +24862,17 @@ or call the function `show-paren-mode'.")
(autoload 'show-paren-mode "paren" "\
Toggle visualization of matching parens (Show Paren mode).
-If called interactively, toggle `Show-Paren mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Show-Paren
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'show-paren-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -24585,7 +25009,6 @@ PATTERN matches. PATTERN can take one of the forms:
(pred (not FUN)) matches if FUN called on EXPVAL returns nil.
(app FUN PAT) matches if FUN called on EXPVAL matches PAT.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
- (let PAT EXPR) matches if EXPR matches PAT.
(and PAT...) matches if all the patterns match.
(or PAT...) matches if any of the patterns matches.
@@ -24595,7 +25018,7 @@ FUN in `pred' and `app' can take one of the forms:
(F ARG1 .. ARGn)
call F with ARG1..ARGn and EXPVAL as n+1'th argument
-FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables
+FUN, BOOLEXP, and subsequent PAT can refer to variables
bound earlier in the pattern by a SYMBOL pattern.
Additional patterns can be defined using `pcase-defmacro'.
@@ -25155,14 +25578,17 @@ or call the function `pixel-scroll-mode'.")
(autoload 'pixel-scroll-mode "pixel-scroll" "\
A minor mode to scroll text pixel-by-pixel.
-If called interactively, toggle `Pixel-Scroll mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Pixel-Scroll mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'pixel-scroll-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -25265,14 +25691,14 @@ Macroexpand EXPRESSION and pretty-print its value.
(autoload 'pp-eval-last-sexp "pp" "\
Run `pp-eval-expression' on sexp before point.
-With argument, pretty-print output into current buffer.
+With ARG, pretty-print output into current buffer.
Ignores leading comment characters.
\(fn ARG)" t nil)
(autoload 'pp-macroexpand-last-sexp "pp" "\
Run `pp-macroexpand-expression' on sexp before point.
-With argument, pretty-print output into current buffer.
+With ARG, pretty-print output into current buffer.
Ignores leading comment characters.
\(fn ARG)" t nil)
@@ -25847,8 +26273,12 @@ Proced buffers.
(autoload 'profiler-start "profiler" "\
Start/restart profilers.
MODE can be one of `cpu', `mem', or `cpu+mem'.
-If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
-Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started.
+If MODE is `cpu' or `cpu+mem', start the time-based profiler,
+ whereby CPU is sampled periodically using the SIGPROF signal.
+If MODE is `mem' or `cpu+mem', start profiler that samples CPU
+ whenever memory-allocation functions are called -- this is useful
+ if SIGPROF is not supported, or is unreliable, or is not sampling
+ at a high enough frequency.
\(fn MODE)" t nil)
@@ -25873,7 +26303,7 @@ Open profile FILENAME.
;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0))
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 5 4)) package--builtin-versions)
+(push (purecopy '(project 0 6 0)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -26058,6 +26488,13 @@ Save the result in `project-list-file' if the list of projects has changed.
\(fn PR)" nil nil)
+(autoload 'project-remove-known-project "project" "\
+Remove directory PROJECT-ROOT from the project list.
+PROJECT-ROOT is the root directory of a known project listed in
+the project list.
+
+\(fn PROJECT-ROOT)" t nil)
+
(autoload 'project-known-project-roots "project" "\
Return the list of root directories of all known projects." nil nil)
@@ -26066,19 +26503,6 @@ Execute an extended command in project root." t nil)
(function-put 'project-execute-extended-command 'interactive-only 'command-execute)
-(defvar project-switch-commands '((project-find-file "Find file") (project-find-regexp "Find regexp") (project-dired "Dired") (project-vc-dir "VC-Dir") (project-eshell "Eshell")) "\
-Alist mapping commands to descriptions.
-Used by `project-switch-project' to construct a dispatch menu of
-commands available upon \"switching\" to another project.
-
-Each element is of the form (COMMAND LABEL &optional KEY) where
-COMMAND is the command to run when KEY is pressed. LABEL is used
-to distinguish the menu entries in the dispatch menu. If KEY is
-absent, COMMAND must be bound in `project-prefix-map', and the
-key is looked up in that map.")
-
-(custom-autoload 'project-switch-commands "project" t)
-
(autoload 'project-switch-project "project" "\
\"Switch\" to another project by running an Emacs command.
The available commands are presented as a dispatch menu
@@ -26655,7 +27079,7 @@ Add one translation rule, KEY to TRANSLATION, in the current Quail package.
KEY is a string meaning a sequence of keystrokes to be translated.
TRANSLATION is a character, a string, a vector, a Quail map,
a function, or a cons.
-It it is a character, it is the sole translation of KEY.
+If it is a character, it is the sole translation of KEY.
If it is a string, each character is a candidate for the translation.
If it is a vector, each element (string or character) is a candidate
for the translation.
@@ -26908,7 +27332,11 @@ If ARG is non-nil, instead prompt for connection parameters.
(defalias 'irc 'rcirc)
(autoload 'rcirc-connect "rcirc" "\
-
+Connect to SERVER.
+The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
+ENCRYPTION, SERVER-ALIAS are interpreted as in
+`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
+that are joined after authentication.
\(fn SERVER &optional PORT NICK USER-NAME FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS)" nil nil)
@@ -26925,20 +27353,23 @@ or call the function `rcirc-track-minor-mode'.")
(autoload 'rcirc-track-minor-mode "rcirc" "\
Global minor mode for tracking activity in rcirc buffers.
-If called interactively, toggle `Rcirc-Track minor mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Rcirc-Track minor mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'rcirc-track-minor-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
\(fn &optional ARG)" t nil)
-(register-definition-prefixes "rcirc" '("defun-rcirc-command" "rcirc-" "set-rcirc-" "with-rcirc-"))
+(register-definition-prefixes "rcirc" '("rcirc-" "with-rcirc-"))
;;;***
@@ -26955,7 +27386,12 @@ the regexp builder. It displays a buffer named \"*RE-Builder*\"
in another window, initially containing an empty regexp.
As you edit the regexp in the \"*RE-Builder*\" buffer, the
-matching parts of the target buffer will be highlighted." t nil)
+matching parts of the target buffer will be highlighted.
+
+Case-sensitivity can be toggled with \\[reb-toggle-case]. The
+regexp builder supports three different forms of input which can
+be set with \\[reb-change-syntax]. More options and details are
+provided in the Commentary section of this library." t nil)
(register-definition-prefixes "re-builder" '("re-builder-unload-function" "reb-"))
@@ -26977,14 +27413,17 @@ or call the function `recentf-mode'.")
(autoload 'recentf-mode "recentf" "\
Toggle \"Open Recent\" menu (Recentf mode).
-If called interactively, toggle `Recentf mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Recentf
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'recentf-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27142,14 +27581,17 @@ with a prefix argument, prompt for START-AT and FORMAT.
(autoload 'rectangle-mark-mode "rect" "\
Toggle the region as rectangular.
-If called interactively, toggle `Rectangle-Mark mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Rectangle-Mark mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `rectangle-mark-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27181,14 +27623,17 @@ Activates the region if needed. Only lasts until the region is deactivated.
(autoload 'refill-mode "refill" "\
Toggle automatic refilling (Refill mode).
-If called interactively, toggle `Refill mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Refill
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `refill-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27218,14 +27663,17 @@ Turn on RefTeX mode." nil nil)
(autoload 'reftex-mode "reftex" "\
Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX.
-If called interactively, toggle `Reftex mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Reftex
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `reftex-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27362,8 +27810,8 @@ This means the number of non-shy regexp grouping constructs
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
-INITIAL is the text to initially place in the *Remember* buffer,
-or nil to bring up a blank *Remember* buffer.
+INITIAL is the text to initially place in the `remember-buffer',
+or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL.
@@ -27428,7 +27876,43 @@ recently executed command not bound to an input event\".
\(fn REPEAT-ARG)" t nil)
-(register-definition-prefixes "repeat" '("repeat-"))
+(defvar repeat-map nil "\
+The value of the repeating map for the next command.
+A command called from the map can set it again to the same map when
+the map can't be set on the command symbol property `repeat-map'.")
+
+(defvar repeat-mode nil "\
+Non-nil if Repeat mode is enabled.
+See the `repeat-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 `repeat-mode'.")
+
+(custom-autoload 'repeat-mode "repeat" nil)
+
+(autoload 'repeat-mode "repeat" "\
+Toggle Repeat mode.
+When Repeat mode is enabled, and the command symbol has the property named
+`repeat-map', this map is activated temporarily for the next command.
+
+This is a minor mode. If called interactively, toggle the `Repeat
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the
+mode if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'repeat-mode)'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+\(fn &optional ARG)" t nil)
+
+(register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-"))
;;;***
@@ -27486,8 +27970,10 @@ visible (if only part could otherwise be made so), to make the defun line
visible (if point is in code and it could not be made so, or if only
comments, including the first comment line, are visible), or to make the
first comment line visible (if point is in a comment).
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage.
-\(fn &optional ARG)" t nil)
+\(fn &optional ARG INTERACTIVE)" t nil)
(register-definition-prefixes "reposition" '("repos-count-screen-lines"))
@@ -27499,14 +27985,17 @@ first comment line visible (if point is in a comment).
(autoload 'reveal-mode "reveal" "\
Toggle uncloaking of invisible text near point (Reveal mode).
-If called interactively, toggle `Reveal mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Reveal
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `reveal-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27531,14 +28020,17 @@ or call the function `global-reveal-mode'.")
Toggle Reveal mode in all buffers (Global Reveal mode).
Reveal mode renders invisible text around point visible again.
-If called interactively, toggle `Global Reveal mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Global
+Reveal mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-reveal-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -27940,28 +28432,37 @@ than appending to it. Deletes the message after writing if
;;; 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 a list of (KEY NAME [DESCRIPTION]). KEY is a
-character to be entered. NAME is a short name for the entry to
-be displayed while prompting (if there's room, it might be
-shortened). DESCRIPTION is an optional longer explanation that
-will be displayed in a help buffer if the user requests more
-help.
+Ask user to select an entry from CHOICES, promting with PROMPT.
+This function allows to ask the user a multiple-choice question.
+
+CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
+KEY is a character the user should type to select the entry.
+NAME is a short name for the entry to be displayed while prompting
+\(if there's no room, it might be shortened).
+DESCRIPTION is an optional longer description of the entry; it will
+be displayed in a help buffer if the user requests more help. This
+help description has a fixed format in columns. For greater
+flexibility, instead of passing a DESCRIPTION, the caller can pass
+the optional argument HELP-STRING. This argument is a string that
+should contain a more detailed description of all of the possible
+choices. `read-multiple-choice' will display that description in a
+help buffer if the user requests that.
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.
+that variable for more information. The relevant bindings for the
+purposes of this function are `recenter', `scroll-up', `scroll-down',
+and `edit'.
+If the user types the `recenter', `scroll-up', or `scroll-down'
+responses, the function performs the requested window recentering or
+scrolling, and then asks the question again. If the user enters `edit',
+the function starts a recursive edit. When the user exit the recursive
+edit, the multiple-choice prompt gains focus again.
+
+When `use-dialog-box' is t (the default), and the command using this
+function was invoked via the mouse, this function pops up a GUI dialog
+to collect the user input, but only if Emacs is capable of using GUI
+dialogs. Otherwise, the function will always use text-mode dialogs.
The return value is the matching entry from the CHOICES list.
@@ -27972,7 +28473,7 @@ Usage example:
(?s \"session only\")
(?n \"no\")))
-\(fn PROMPT CHOICES)" nil nil)
+\(fn PROMPT CHOICES &optional HELP-STRING)" nil nil)
;;;***
@@ -28063,14 +28564,17 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil)
(autoload 'rng-validate-mode "rng-valid" "\
Minor mode performing continual validation against a RELAX NG schema.
-If called interactively, toggle `Rng-Validate mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Rng-Validate mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `rng-validate-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28220,14 +28724,17 @@ highlighting.
(autoload 'rst-minor-mode "rst" "\
Toggle ReST minor mode.
-If called interactively, toggle `Rst minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Rst minor
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `rst-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28269,21 +28776,24 @@ Major mode for editing Ruby code.
;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (0 0 0 0))
;;; Generated autoloads from ruler-mode.el
-(defvar ruler-mode nil "\
+(defvar-local ruler-mode nil "\
Non-nil if Ruler mode is enabled.
Use the command `ruler-mode' to change this variable.")
(autoload 'ruler-mode "ruler-mode" "\
Toggle display of ruler in header line (Ruler mode).
-If called interactively, toggle `Ruler mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Ruler
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `ruler-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28353,7 +28863,7 @@ unmatchable Never match anything at all.
CHARCLASS Match a character from a character class. One of:
alpha, alphabetic, letter Alphabetic characters (defined by Unicode).
alnum, alphanumeric Alphabetic or decimal digit chars (Unicode).
- digit numeric, num 0-9.
+ digit, numeric, num 0-9.
xdigit, hex-digit, hex 0-9, A-F, a-f.
cntrl, control ASCII codes 0-31.
blank Horizontal whitespace (Unicode).
@@ -28483,24 +28993,7 @@ For more details, see Info node `(elisp) Extending Rx'.
(function-put 'rx-define 'lisp-indent-function 'defun)
-(autoload 'rx--pcase-macroexpander "rx" "\
-A pattern that matches strings against `rx' REGEXPS in sexp form.
-REGEXPS are interpreted as in `rx'. The pattern matches any
-string that is a match for REGEXPS, as if by `string-match'.
-
-In addition to the usual `rx' syntax, REGEXPS can contain the
-following constructs:
-
- (let REF RX...) binds the symbol REF to a submatch that matches
- the regular expressions RX. REF is bound in
- CODE to the string of the submatch or nil, but
- can also be used in `backref'.
- (backref REF) matches whatever the submatch REF matched.
- REF can be a number, as usual, or a name
- introduced by a previous (let REF ...)
- construct.
-
-\(fn &rest REGEXPS)" nil nil)
+(eval-and-compile (defun rx--pcase-macroexpander (&rest regexps) "A pattern that matches strings against `rx' REGEXPS in sexp form.\nREGEXPS are interpreted as in `rx'. The pattern matches any\nstring that is a match for REGEXPS, as if by `string-match'.\n\nIn addition to the usual `rx' syntax, REGEXPS can contain the\nfollowing constructs:\n\n (let REF RX...) binds the symbol REF to a submatch that matches\n the regular expressions RX. REF is bound in\n CODE to the string of the submatch or nil, but\n can also be used in `backref'.\n (backref REF) matches whatever the submatch REF matched.\n REF can be a number, as usual, or a name\n introduced by a previous (let REF ...)\n construct." (let* ((rx--pcase-vars nil) (regexp (rx--to-expr (rx--pcase-transform (cons 'seq regexps))))) `(and (pred stringp) ,(pcase (length rx--pcase-vars) (0 `(pred (string-match ,regexp))) (1 `(app (lambda (s) (if (string-match ,regexp s) (match-string 1 s) 0)) (and ,(car rx--pcase-vars) (pred (not numberp))))) (nvars `(app (lambda (s) (and (string-match ,regexp s) ,(rx--reduce-right (lambda (a b) `(cons ,a ,b)) (mapcar (lambda (i) `(match-string ,i s)) (number-sequence 1 nvars))))) ,(list '\` (rx--reduce-right #'cons (mapcar (lambda (name) (list '\, name)) (reverse rx--pcase-vars)))))))))))
(define-symbol-prop 'rx--pcase-macroexpander 'edebug-form-spec 'nil)
@@ -28570,14 +29063,17 @@ or call the function `savehist-mode'.")
(autoload 'savehist-mode "savehist" "\
Toggle saving of minibuffer history (Savehist mode).
-If called interactively, toggle `Savehist mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Savehist
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'savehist-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28631,14 +29127,17 @@ Non-nil means automatically save place in each file.
This means when you visit a file, point goes to the last place
where it was when you previously visited the same file.
-If called interactively, toggle `Save-Place mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Save-Place
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'save-place-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28650,14 +29149,17 @@ If this mode is enabled, point is recorded when you kill the buffer
or exit Emacs. Visiting this file again will go to that position,
even in a later Emacs session.
-If called interactively, toggle `Save-Place-Local mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Save-Place-Local mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `save-place-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28744,14 +29246,17 @@ or call the function `scroll-all-mode'.")
(autoload 'scroll-all-mode "scroll-all" "\
Toggle shared scrolling in same-frame windows (Scroll-All mode).
-If called interactively, toggle `Scroll-All mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Scroll-All
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'scroll-all-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28777,14 +29282,17 @@ one window apply to all visible windows in the same frame.
(autoload 'scroll-lock-mode "scroll-lock" "\
Buffer-local minor mode for pager-like scrolling.
-If called interactively, toggle `Scroll-Lock mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Scroll-Lock mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `scroll-lock-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28853,14 +29361,17 @@ or call the function `semantic-mode'.")
(autoload 'semantic-mode "semantic" "\
Toggle parser features (Semantic mode).
-If called interactively, toggle `Semantic mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Semantic
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'semantic-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -28995,14 +29506,6 @@ Major mode for editing Bovine grammars.
;;;***
-;;;### (autoloads nil "semantic/grammar-wy" "cedet/semantic/grammar-wy.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from cedet/semantic/grammar-wy.el
-
-(register-definition-prefixes "semantic/grammar-wy" '("semantic-grammar-wy--"))
-
-;;;***
-
;;;### (autoloads nil "semantic/java" "cedet/semantic/java.el" (0
;;;;;; 0 0 0))
;;; Generated autoloads from cedet/semantic/java.el
@@ -29366,6 +29869,17 @@ Like `mail' command, but display mail buffer in another frame.
;;; Generated autoloads from emacs-lisp/seq.el
(push (purecopy '(seq 2 22)) package--builtin-versions)
+(autoload 'seq-subseq "seq" "\
+Return the sequence of elements of SEQUENCE from START to END.
+END is exclusive.
+
+If END is omitted, it defaults to the length of the sequence. If
+START or END is negative, it counts from the end. Signal an
+error if START or END are outside of the sequence (i.e too large
+if positive or too small if negative).
+
+\(fn SEQUENCE START &optional END)" nil nil)
+
(autoload 'seq-take "seq" "\
Take the first N elements of SEQUENCE and return the result.
The result is a sequence of the same type as SEQUENCE.
@@ -29433,6 +29947,24 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil.
\(fn SEQUENCE ELT &optional TESTFN)" nil nil)
+(autoload 'seq-uniq "seq" "\
+Return a list of the elements of SEQUENCE with duplicates removed.
+TESTFN is used to compare elements, or `equal' if TESTFN is nil.
+
+\(fn SEQUENCE &optional TESTFN)" nil nil)
+
+(autoload 'seq-intersection "seq" "\
+Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
+Equality is defined by TESTFN if non-nil or by `equal' if nil.
+
+\(fn SEQUENCE1 SEQUENCE2 &optional TESTFN)" nil nil)
+
+(autoload 'seq-difference "seq" "\
+Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
+Equality is defined by TESTFN if non-nil or by `equal' if nil.
+
+\(fn SEQUENCE1 SEQUENCE2 &optional TESTFN)" nil nil)
+
(autoload 'seq-group-by "seq" "\
Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results as
@@ -29501,14 +30033,17 @@ or call the function `server-mode'.")
(autoload 'server-mode "server" "\
Toggle Server mode.
-If called interactively, toggle `Server mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Server
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'server-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -29540,7 +30075,7 @@ Major mode for Simple Emacs Spreadsheet.
When you invoke SES in a new buffer, it is divided into cells
that you can enter data into. You can navigate the cells with
the arrow keys and add more cells with the tab key. The contents
-of these cells can be numbers, text, or Lisp expressions. (To
+of these cells can be numbers, text, or Lisp expressions. (To
enter text, enclose it in double quotes.)
In an expression, you can use cell coordinates to refer to the
@@ -29626,7 +30161,7 @@ or Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a
href=\"URL\">see also URL</a> where URL is a filename relative to current
-directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
+directory, or absolute as in `https://www.cs.indiana.edu/elisp/w3/docs.html'.
Images in many formats can be inlined with <img src=\"URL\">.
@@ -29805,6 +30340,13 @@ arguments.")
(custom-autoload 'shell-dumb-shell-regexp "shell" t)
+(autoload 'split-string-shell-command "shell" "\
+Split STRING (a shell command) into a list of strings.
+General shell syntax, like single and double quoting, as well as
+backslash quoting, is respected.
+
+\(fn STRING)" nil nil)
+
(autoload 'shell "shell" "\
Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*').
Interactively, a prefix arg means to prompt for BUFFER.
@@ -29851,10 +30393,11 @@ Make the shell buffer the current buffer, and return it.
(autoload 'shortdoc-display-group "shortdoc" "\
Pop to a buffer with short documentation summary for functions in GROUP.
+If FUNCTION is non-nil, place point on the entry for FUNCTION (if any).
-\(fn GROUP)" t nil)
+\(fn GROUP &optional FUNCTION)" t nil)
-(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "process" "regexp" "sequence" "shortdoc-" "string" "vector"))
+(register-definition-prefixes "shortdoc" '("alist" "buffer" "define-short-documentation-group" "file" "hash-table" "list" "number" "overlay" "process" "regexp" "sequence" "shortdoc-" "string" "vector"))
;;;***
@@ -29939,9 +30482,6 @@ Turning on Sieve mode runs `sieve-mode-hook'.
Major mode for editing SIMULA code.
\\{simula-mode-map}
Variables controlling indentation style:
- `simula-tab-always-indent'
- Non-nil means TAB in SIMULA mode should always reindent the current line,
- regardless of where in the line point is when the TAB command is used.
`simula-indent-level'
Indentation of SIMULA statements with respect to containing block.
`simula-substatement-offset'
@@ -30134,14 +30674,17 @@ buffer names.
(autoload 'smerge-mode "smerge-mode" "\
Minor mode to simplify editing output from the diff3 program.
-If called interactively, toggle `Smerge mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `SMerge
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `smerge-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -30267,14 +30810,17 @@ Open the so-long `customize' group." t nil)
(autoload 'so-long-minor-mode "so-long" "\
This is the minor mode equivalent of `so-long-mode'.
-If called interactively, toggle `So-Long minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `So-Long
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `so-long-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -30349,14 +30895,17 @@ or call the function `global-so-long-mode'.")
(autoload 'global-so-long-mode "so-long" "\
Toggle automated performance mitigations for files with long lines.
-If called interactively, toggle `Global So-Long mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Global
+So-Long mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-so-long-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31375,7 +31924,7 @@ Major-mode for writing SRecode macros.
\(fn)" t nil)
-(defalias 'srt-mode 'srecode-template-mode)
+(defalias 'srt-mode #'srecode-template-mode)
(register-definition-prefixes "srecode/srt-mode" '("semantic-" "srecode-"))
@@ -31467,14 +32016,17 @@ or call the function `strokes-mode'.")
(autoload 'strokes-mode "strokes" "\
Toggle Strokes mode, a global minor mode.
-If called interactively, toggle `Strokes mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Strokes
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'strokes-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31565,6 +32117,12 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\".
\(fn STRING LENGTH)" nil nil)
+(autoload 'string-lines "subr-x" "\
+Split STRING into a list of lines.
+If OMIT-NULLS, empty lines will be removed from the results.
+
+\(fn STRING &optional OMIT-NULLS)" nil nil)
+
(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*"))
;;;***
@@ -31577,14 +32135,17 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\".
(autoload 'subword-mode "subword" "\
Toggle subword movement and editing (Subword mode).
-If called interactively, toggle `Subword mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Subword
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `subword-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31636,14 +32197,17 @@ See `subword-mode' for more information on Subword mode.
(autoload 'superword-mode "subword" "\
Toggle superword movement and editing (Superword mode).
-If called interactively, toggle `Superword mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Superword
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `superword-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31741,14 +32305,17 @@ or call the function `gpm-mouse-mode'.")
(autoload 'gpm-mouse-mode "t-mouse" "\
Toggle mouse support in GNU/Linux consoles (GPM Mouse mode).
-If called interactively, toggle `Gpm-Mouse mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Gpm-Mouse
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'gpm-mouse-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -31772,22 +32339,23 @@ GPM. This is due to limitations in GPM and the Linux kernel.
(autoload 'tab-line-mode "tab-line" "\
Toggle display of window tab line in the buffer.
-If called interactively, toggle `Tab-Line mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Tab-Line
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `tab-line-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
\(fn &optional ARG)" t nil)
-(defvar tab-line-exclude nil)
-
-(make-variable-buffer-local 'tab-line-exclude)
+(defvar-local tab-line-exclude nil)
(put 'global-tab-line-mode 'globalized-minor-mode t)
@@ -31939,7 +32507,7 @@ Move the point under the table as shown below.
+--------------+------+--------------------------------+
-!-
-Type M-x table-insert-row instead of \\[table-insert-row-column]. \\[table-insert-row-column] does not work
+Type \\[table-insert-row] instead of \\[table-insert-row-column]. \\[table-insert-row-column] does not work
when the point is outside of the table. This insertion at
outside of the table effectively appends a row at the end.
@@ -32188,14 +32756,17 @@ location is indicated by `table-word-continuation-char'. This
variable's value can be toggled by \\[table-fixed-width-mode] at
run-time.
-If called interactively, toggle `Table-Fixed-Width mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Table-Fixed-Width mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `table-fixed-width-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -32236,11 +32807,11 @@ HTML:
URL `https://www.w3.org'
LaTeX:
- URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
+ URL `https://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
CALS (DocBook DTD):
- URL `http://www.oasis-open.org/html/a502.htm'
- URL `http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
+ URL `https://www.oasis-open.org/html/a502.htm'
+ URL `https://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
\(fn LANGUAGE &optional DEST-BUFFER CAPTION)" t nil)
@@ -32448,12 +33019,12 @@ Connect to the Emacs talk group from the current X display or tty frame." t nil)
(autoload 'tar-mode "tar-mode" "\
Major mode for viewing a tar file as a dired-like listing of its contents.
You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the tar file and into its own buffer;
+Letters no longer insert themselves.\\<tar-mode-map>
+Type \\[tar-extract] to pull a file out of the tar file and into its own buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
-Type `c' to copy an entry from the tar file into another file on disk.
+Type \\[tar-copy] to copy an entry from the tar file into another file on disk.
-If you edit a sub-file of this archive (as with the `e' command) and
+If you edit a sub-file of this archive (as with the \\[tar-extract] command) and
save it with \\[save-buffer], the contents of that buffer will be
saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.
@@ -32807,11 +33378,11 @@ says which mode to use.
\(fn)" t nil)
-(defalias 'TeX-mode 'tex-mode)
+(defalias 'TeX-mode #'tex-mode)
-(defalias 'plain-TeX-mode 'plain-tex-mode)
+(defalias 'plain-TeX-mode #'plain-tex-mode)
-(defalias 'LaTeX-mode 'latex-mode)
+(defalias 'LaTeX-mode #'latex-mode)
(autoload 'plain-tex-mode "tex-mode" "\
Major mode for editing files of input for plain TeX.
@@ -33081,14 +33652,6 @@ value of `texinfo-mode-hook'.
;;;***
-;;;### (autoloads nil "texnfo-upd" "textmodes/texnfo-upd.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from textmodes/texnfo-upd.el
-
-(register-definition-prefixes "texnfo-upd" '("texinfo-"))
-
-;;;***
-
;;;### (autoloads nil "text-property-search" "emacs-lisp/text-property-search.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/text-property-search.el
@@ -33376,14 +33939,17 @@ This function is meant to be used as a `post-self-insert-hook'." t nil)
(autoload 'tildify-mode "tildify" "\
Adds electric behavior to space character.
-If called interactively, toggle `Tildify mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Tildify
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `tildify-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -33431,14 +33997,17 @@ or call the function `display-time-mode'.")
(autoload 'display-time-mode "time" "\
Toggle display of time, load level, and mail flag in mode lines.
-If called interactively, toggle `Display-Time mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Display-Time mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'display-time-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -33467,7 +34036,11 @@ point.
\(fn &optional FORMAT HERE)" t nil)
(autoload 'emacs-init-time "time" "\
-Return a string giving the duration of the Emacs initialization." t nil)
+Return a string giving the duration of the Emacs initialization.
+FORMAT is a string to format the result, using `format'. If nil,
+the default format \"%f seconds\" is used.
+
+\(fn &optional FORMAT)" t nil)
(register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "time--display-world-list" "world-clock-" "zoneinfo-style-world-list"))
@@ -33602,7 +34175,7 @@ look like one of the following:
Time-stamp: <>
Time-stamp: \" \"
The time stamp is written between the brackets or quotes:
- Time-stamp: <2001-02-18 10:20:51 gildea>
+ Time-stamp: <2020-08-07 17:10:21 gildea>
The time stamp is updated only if the variable
`time-stamp-active' is non-nil.
@@ -33614,7 +34187,7 @@ The variables `time-stamp-pattern', `time-stamp-line-limit',
(autoload 'time-stamp-toggle-active "time-stamp" "\
Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
-With ARG, turn time stamping on if and only if arg is positive.
+With ARG, turn time stamping on if and only if ARG is positive.
\(fn &optional ARG)" t nil)
@@ -34034,6 +34607,8 @@ the output buffer or changing the window configuration.
;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0))
;;; Generated autoloads from net/tramp.el
+ (when (featurep 'tramp-compat)
+ (load "tramp-compat" 'noerror 'nomessage))
(defvar tramp-mode t "\
Whether Tramp is enabled.
@@ -34063,10 +34638,10 @@ 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." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args))
+Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (when (bound-and-true-p tramp-archive-autoload) (load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror 'nomessage))) (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 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t))
+Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t))
(tramp-register-autoload-file-name-handlers)
(defun tramp-unload-file-name-handlers nil "\
@@ -34104,7 +34679,8 @@ It must be supported by libarchive(3).")
(defmacro tramp-archive-autoload-file-name-regexp nil "\
Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'"))
-(defalias 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
+(defun tramp-archive-autoload-file-name-handler (operation &rest args) "\
+Load Tramp archive file name handler, and perform OPERATION." (when tramp-archive-enabled (let ((default-directory temporary-file-directory) (tramp-archive-autoload t)) tramp-archive-autoload (apply #'tramp-autoload-file-name-handler operation args))))
(defun tramp-register-archive-file-name-handler nil "\
Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t)))
@@ -34153,6 +34729,13 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;***
+;;;### (autoloads nil "tramp-fuse" "net/tramp-fuse.el" (0 0 0 0))
+;;; Generated autoloads from net/tramp-fuse.el
+
+(register-definition-prefixes "tramp-fuse" '("tramp-fuse-"))
+
+;;;***
+
;;;### (autoloads nil "tramp-gvfs" "net/tramp-gvfs.el" (0 0 0 0))
;;; Generated autoloads from net/tramp-gvfs.el
@@ -34190,6 +34773,13 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;***
+;;;### (autoloads nil "tramp-sshfs" "net/tramp-sshfs.el" (0 0 0 0))
+;;; Generated autoloads from net/tramp-sshfs.el
+
+(register-definition-prefixes "tramp-sshfs" '("tramp-sshfs-"))
+
+;;;***
+
;;;### (autoloads nil "tramp-sudoedit" "net/tramp-sudoedit.el" (0
;;;;;; 0 0 0))
;;; Generated autoloads from net/tramp-sudoedit.el
@@ -34207,12 +34797,73 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 5 1 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 5 2 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
;;;***
+;;;### (autoloads nil "transient" "transient.el" (0 0 0 0))
+;;; Generated autoloads from transient.el
+
+(autoload 'transient-insert-suffix "transient" "\
+Insert a SUFFIX into PREFIX before LOC.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'.
+
+\(fn PREFIX LOC SUFFIX)" nil nil)
+
+(function-put 'transient-insert-suffix 'lisp-indent-function 'defun)
+
+(autoload 'transient-append-suffix "transient" "\
+Insert a SUFFIX into PREFIX after LOC.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'.
+
+\(fn PREFIX LOC SUFFIX)" nil nil)
+
+(function-put 'transient-append-suffix 'lisp-indent-function 'defun)
+
+(autoload 'transient-replace-suffix "transient" "\
+Replace the suffix at LOC in PREFIX with SUFFIX.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'.
+
+\(fn PREFIX LOC SUFFIX)" nil nil)
+
+(function-put 'transient-replace-suffix 'lisp-indent-function 'defun)
+
+(autoload 'transient-remove-suffix "transient" "\
+Remove the suffix or group at LOC in PREFIX.
+PREFIX is a prefix command, a symbol.
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'.
+
+\(fn PREFIX LOC)" nil nil)
+
+(function-put 'transient-remove-suffix 'lisp-indent-function 'defun)
+
+(register-definition-prefixes "transient" '("transient-"))
+
+;;;***
+
;;;### (autoloads nil "tree-widget" "tree-widget.el" (0 0 0 0))
;;; Generated autoloads from tree-widget.el
@@ -34262,8 +34913,8 @@ resumed later.
;;;;;; 0 0))
;;; Generated autoloads from textmodes/two-column.el
(autoload '2C-command "two-column" () t 'keymap)
- (global-set-key "\C-x6" '2C-command)
- (global-set-key [f2] '2C-command)
+ (global-set-key "\C-x6" #'2C-command)
+ (global-set-key [f2] #'2C-command)
(autoload '2C-two-columns "two-column" "\
Split current window vertically for two-column editing.
@@ -34276,11 +34927,13 @@ first and the associated buffer to its right.
\(fn &optional BUFFER)" t nil)
(autoload '2C-associate-buffer "two-column" "\
-Associate another buffer with this one in two-column minor mode.
+Associate another BUFFER with this one in two-column minor mode.
Can also be used to associate a just previously visited file, by
accepting the proposed default buffer.
-\(See \\[describe-mode] .)" t nil)
+\(See \\[describe-mode] .)
+
+\(fn BUFFER)" t nil)
(autoload '2C-split "two-column" "\
Split a two-column text at point, into two buffers in two-column minor mode.
@@ -34323,14 +34976,17 @@ or call the function `type-break-mode'.")
Enable or disable typing-break mode.
This is a minor mode, but it is global to all buffers by default.
-If called interactively, toggle `Type-Break mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Type-Break
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'type-break-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -34763,7 +35419,7 @@ added to this list, so most requests can just pass in nil.
\(fn URL)" nil nil)
-(register-definition-prefixes "url-dav" '("url-"))
+(register-definition-prefixes "url-dav" '("url-dav-"))
;;;***
@@ -34854,14 +35510,17 @@ or call the function `url-handler-mode'.")
(autoload 'url-handler-mode "url-handlers" "\
Toggle using `url' library for URL filenames (URL Handler mode).
-If called interactively, toggle `Url-Handler mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Url-Handler mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'url-handler-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -35262,11 +35921,14 @@ instead of just \"key\" as in the example above.
\(fn QUERY &optional SEMICOLONS KEEP-EMPTY)" nil nil)
(autoload 'url-unhex-string "url-util" "\
-Remove %XX embedded spaces, etc in a URL.
+Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
forbidden in URL encoding.
+The resulting string in general requires decoding using an
+appropriate coding-system; see `decode-coding-string'.
+
\(fn STR &optional ALLOW-NEWLINES)" nil nil)
(autoload 'url-hexify-string "url-util" "\
@@ -35368,7 +36030,12 @@ The buffer in question is current when this function is called.
\(fn FILENAME)" nil nil)
-(register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--check-content-unchanged"))
+(autoload 'userlock--handle-unlock-error "userlock" "\
+Report an ERROR that occurred while unlocking a file.
+
+\(fn ERROR)" nil nil)
+
+(register-definition-prefixes "userlock" '("ask-user-about-" "file-" "userlock--"))
;;;***
@@ -35515,6 +36182,22 @@ first backend that could register the file is used.
\(fn &optional VC-FILESET COMMENT)" t nil)
+(autoload 'vc-ignore "vc" "\
+Ignore FILE under the VCS of DIRECTORY.
+
+Normally, FILE is a wildcard specification that matches the files
+to be ignored. When REMOVE is non-nil, remove FILE from the list
+of ignored files.
+
+DIRECTORY defaults to `default-directory' and is used to
+determine the responsible VC backend.
+
+When called interactively, prompt for a FILE to ignore, unless a
+prefix argument is given, in which case prompt for a file FILE to
+remove from the list of ignored files.
+
+\(fn FILE &optional DIRECTORY REMOVE)" t nil)
+
(autoload 'vc-version-diff "vc" "\
Report diffs between revisions REV1 and REV2 in the repository history.
This compares two revisions of the current fileset.
@@ -36119,7 +36802,7 @@ Add a description of the problem and include a reproducible test case.
Feel free to send questions and enhancement requests to <reto@gnu.org>.
Official distribution is at
-URL `http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html'
+URL `https://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html'
The Vera Mode Maintainer
@@ -36139,7 +36822,7 @@ Key bindings:
;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from progmodes/verilog-mode.el
-(push (purecopy '(verilog-mode 2020 6 27 14326051)) package--builtin-versions)
+(push (purecopy '(verilog-mode 2021 4 12 188864585)) package--builtin-versions)
(autoload 'verilog-mode "verilog-mode" "\
Major mode for editing Verilog code.
@@ -36888,15 +37571,13 @@ If nil, make an icon of the frame. If non-nil, delete the frame.")
(custom-autoload 'view-remove-frame-by-deleting "view" t)
-(defvar view-mode nil "\
+(defvar-local view-mode nil "\
Non-nil if View mode is enabled.
Don't change this variable directly, you must change it by one of the
functions that enable or disable view mode.")
-(make-variable-buffer-local 'view-mode)
-
(autoload 'kill-buffer-if-not-modified "view" "\
-Like `kill-buffer', but does nothing if the buffer is modified.
+Like `kill-buffer', but does nothing if buffer BUF is modified.
\(fn BUF)" nil nil)
@@ -36962,7 +37643,7 @@ file: Users may suspend viewing in order to modify the buffer.
Exiting View mode will then discard the user's edits. Setting
EXIT-ACTION to `kill-buffer-if-not-modified' avoids this.
-This function does not enable View mode if the buffer's major-mode
+This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings.
@@ -36984,7 +37665,7 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
this argument instead of explicitly setting `view-exit-action'.
-This function does not enable View mode if the buffer's major-mode
+This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings.
@@ -37006,7 +37687,7 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
this argument instead of explicitly setting `view-exit-action'.
-This function does not enable View mode if the buffer's major-mode
+This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings.
@@ -37015,14 +37696,17 @@ own View-like bindings.
(autoload 'view-mode "view" "\
Toggle View mode, a minor mode for viewing text but not editing it.
-If called interactively, toggle `View mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `View mode'
+mode. If the prefix argument is positive, enable the mode, and if it
+is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `view-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37394,14 +38078,17 @@ or call the function `which-function-mode'.")
(autoload 'which-function-mode "which-func" "\
Toggle mode line display of current function (Which Function mode).
-If called interactively, toggle `Which-Function mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Which-Function mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'which-function-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37422,14 +38109,17 @@ in certain major modes.
(autoload 'whitespace-mode "whitespace" "\
Toggle whitespace visualization (Whitespace mode).
-If called interactively, toggle `Whitespace mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Whitespace
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `whitespace-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37441,14 +38131,17 @@ See also `whitespace-style', `whitespace-newline' and
(autoload 'whitespace-newline-mode "whitespace" "\
Toggle newline visualization (Whitespace Newline mode).
-If called interactively, toggle `Whitespace-Newline mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Whitespace-Newline mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `whitespace-newline-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37474,14 +38167,17 @@ or call the function `global-whitespace-mode'.")
(autoload 'global-whitespace-mode "whitespace" "\
Toggle whitespace visualization globally (Global Whitespace mode).
-If called interactively, toggle `Global Whitespace mode'. If the
-prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Global
+Whitespace mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-whitespace-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37503,14 +38199,17 @@ or call the function `global-whitespace-newline-mode'.")
(autoload 'global-whitespace-newline-mode "whitespace" "\
Toggle global newline visualization (Global Whitespace Newline mode).
-If called interactively, toggle `Global Whitespace-Newline mode'. If
-the prefix argument is positive, enable the mode, and if it is zero or
-negative, disable the mode.
+This is a minor mode. If called interactively, toggle the `Global
+Whitespace-Newline mode' mode. If the prefix argument is positive,
+enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'global-whitespace-newline-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37833,14 +38532,17 @@ Show widget browser for WIDGET in other window.
(autoload 'widget-minor-mode "wid-browse" "\
Minor mode for traversing widgets.
-If called interactively, toggle `Widget minor mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the `Widget
+minor mode' mode. If the prefix argument is positive, enable the
+mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `widget-minor-mode'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -37943,31 +38645,37 @@ unless `windmove-create-window' is non-nil and a new window is created.
Set up keybindings for `windmove'.
Keybindings are of the form MODIFIERS-{left,right,up,down},
where MODIFIERS is either a list of modifiers or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to
+the arrow keys.
Default value of MODIFIERS is `shift'.
\(fn &optional MODIFIERS)" t nil)
(autoload 'windmove-display-left "windmove" "\
Display the next buffer in window to the left of the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'.
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'.
\(fn &optional ARG)" t nil)
(autoload 'windmove-display-up "windmove" "\
Display the next buffer in window above the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'.
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'.
\(fn &optional ARG)" t nil)
(autoload 'windmove-display-right "windmove" "\
Display the next buffer in window to the right of the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'.
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'.
\(fn &optional ARG)" t nil)
(autoload 'windmove-display-down "windmove" "\
Display the next buffer in window below the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'.
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'.
\(fn &optional ARG)" t nil)
@@ -37991,6 +38699,8 @@ Set up keybindings for directional buffer display.
Keys are bound to commands that display the next buffer in the specified
direction. Keybindings are of the form MODIFIERS-{left,right,up,down},
where MODIFIERS is either a list of modifiers or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to
+the arrow keys.
Default value of MODIFIERS is `shift-meta'.
\(fn &optional MODIFIERS)" t nil)
@@ -38028,7 +38738,10 @@ Set up keybindings for directional window deletion.
Keys are bound to commands that delete windows in the specified
direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down},
where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or
-a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'.
+a single modifier.
+If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings
+are directly bound to the arrow keys.
+Default value of PREFIX is `C-x' and MODIFIERS is `shift'.
\(fn &optional PREFIX MODIFIERS)" t nil)
@@ -38049,7 +38762,10 @@ Set up keybindings for directional window swap states.
Keys are bound to commands that swap the states of the selected window
with the window in the specified direction. Keybindings are of the form
MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers
-or a single modifier. Default value of MODIFIERS is `shift-super'.
+or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to the
+arrow keys.
+Default value of MODIFIERS is `shift-super'.
\(fn &optional MODIFIERS)" t nil)
@@ -38073,14 +38789,17 @@ or call the function `winner-mode'.")
(autoload 'winner-mode "winner" "\
Toggle Winner mode on or off.
-If called interactively, toggle `Winner mode'. If the prefix argument
-is positive, enable the mode, and if it is zero or negative, disable
-the mode.
+This is a minor mode. If called interactively, toggle the `Winner
+mode' mode. If the prefix argument is positive, enable the mode, and
+if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'winner-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -38245,7 +38964,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT.
;;;### (autoloads nil "xref" "progmodes/xref.el" (0 0 0 0))
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 0 4)) package--builtin-versions)
+(push (purecopy '(xref 1 1 0)) package--builtin-versions)
(autoload 'xref-find-backend "xref" nil nil nil)
@@ -38365,14 +39084,17 @@ or call the function `xterm-mouse-mode'.")
(autoload 'xterm-mouse-mode "xt-mouse" "\
Toggle XTerm mouse mode.
-If called interactively, toggle `Xterm-Mouse mode'. If the prefix
-argument is positive, enable the mode, and if it is zero or negative,
-disable the mode.
+This is a minor mode. If called interactively, toggle the
+`Xterm-Mouse mode' mode. If the prefix argument is positive, enable
+the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the
mode if ARG is a negative number.
+To check whether the minor mode is enabled in the current buffer,
+evaluate `(default-value 'xterm-mouse-mode)'.
+
The mode's hook is called both when the mode is enabled and when it is
disabled.
@@ -38455,7 +39177,8 @@ Zone out, completely." t nil)
;;;;;; "cedet/semantic/db-typecache.el" "cedet/semantic/db.el" "cedet/semantic/debug.el"
;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el"
;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/edit.el"
-;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/html.el"
+;;;;;; "cedet/semantic/find.el" "cedet/semantic/format.el" "cedet/semantic/grammar-wy.el"
+;;;;;; "cedet/semantic/grm-wy-boot.el" "cedet/semantic/html.el"
;;;;;; "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" "cedet/semantic/idle.el"
;;;;;; "cedet/semantic/imenu.el" "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el"
;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/scope.el"
@@ -38476,12 +39199,12 @@ Zone out, completely." t nil)
;;;;;; "cus-face.el" "cus-start.el" "custom.el" "dired-aux.el" "dired-x.el"
;;;;;; "electric.el" "emacs-lisp/backquote.el" "emacs-lisp/byte-run.el"
;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-preloaded.el"
-;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el"
-;;;;;; "emacs-lisp/eieio-opt.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" "erc/erc-autoaway.el" "erc/erc-button.el"
-;;;;;; "erc/erc-capab.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el"
+;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/easymenu.el" "emacs-lisp/eieio-compat.el"
+;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-opt.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" "erc/erc-autoaway.el"
+;;;;;; "erc/erc-button.el" "erc/erc-capab.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"
@@ -38495,74 +39218,66 @@ Zone out, completely." t nil)
;;;;;; "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"
+;;;;;; "eshell/em-xtra.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/iso-transl.el"
+;;;;;; "ibuf-ext.el" "indent.el" "international/characters.el" "international/charscript.el"
+;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/iso-transl.el"
;;;;;; "international/mule-cmds.el" "international/mule-conf.el"
-;;;;;; "international/mule.el" "international/uni-bidi.el" "international/uni-brackets.el"
-;;;;;; "international/uni-category.el" "international/uni-combining.el"
-;;;;;; "international/uni-comment.el" "international/uni-decimal.el"
-;;;;;; "international/uni-decomposition.el" "international/uni-digit.el"
-;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el"
-;;;;;; "international/uni-name.el" "international/uni-numeric.el"
-;;;;;; "international/uni-old-name.el" "international/uni-special-lowercase.el"
-;;;;;; "international/uni-special-titlecase.el" "international/uni-special-uppercase.el"
-;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el"
-;;;;;; "isearch.el" "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el"
-;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el"
-;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el"
-;;;;;; "language/european.el" "language/georgian.el" "language/greek.el"
-;;;;;; "language/hebrew.el" "language/indian.el" "language/japanese.el"
-;;;;;; "language/khmer.el" "language/korean.el" "language/lao.el"
-;;;;;; "language/misc-lang.el" "language/romanian.el" "language/sinhala.el"
-;;;;;; "language/slovak.el" "language/tai-viet.el" "language/thai.el"
-;;;;;; "language/tibetan.el" "language/utf-8-lang.el" "language/vietnamese.el"
-;;;;;; "ldefs-boot.el" "leim/ja-dic/ja-dic.el" "leim/leim-list.el"
-;;;;;; "leim/quail/4Corner.el" "leim/quail/ARRAY30.el" "leim/quail/CCDOSPY.el"
-;;;;;; "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el" "leim/quail/ECDICT.el"
-;;;;;; "leim/quail/ETZY.el" "leim/quail/PY-b5.el" "leim/quail/PY.el"
-;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el"
-;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el"
-;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el"
-;;;;;; "leim/quail/cham.el" "leim/quail/compose.el" "leim/quail/croatian.el"
-;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el"
-;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el"
-;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el"
-;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el"
-;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/persian.el"
-;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el"
-;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" "leim/quail/quick-cns.el"
-;;;;;; "leim/quail/rfc1345.el" "leim/quail/sami.el" "leim/quail/sgml-input.el"
-;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el"
-;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el"
-;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el"
-;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
-;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
-;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el"
-;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el"
-;;;;;; "obarray.el" "org/ob-core.el" "org/ob-lob.el" "org/ob-matlab.el"
-;;;;;; "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el" "org/ol-irc.el"
-;;;;;; "org/ol.el" "org/org-archive.el" "org/org-attach.el" "org/org-clock.el"
-;;;;;; "org/org-colview.el" "org/org-compat.el" "org/org-datetree.el"
-;;;;;; "org/org-duration.el" "org/org-element.el" "org/org-feed.el"
-;;;;;; "org/org-footnote.el" "org/org-goto.el" "org/org-id.el" "org/org-indent.el"
-;;;;;; "org/org-install.el" "org/org-keys.el" "org/org-lint.el"
-;;;;;; "org/org-list.el" "org/org-macs.el" "org/org-mobile.el" "org/org-num.el"
-;;;;;; "org/org-plot.el" "org/org-refile.el" "org/org-table.el"
-;;;;;; "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el"
-;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-md.el" "org/ox-odt.el"
-;;;;;; "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el"
-;;;;;; "progmodes/elisp-mode.el" "progmodes/prog-mode.el" "ps-mule.el"
-;;;;;; "register.el" "replace.el" "rfn-eshadow.el" "select.el" "simple.el"
-;;;;;; "startup.el" "subdirs.el" "subr.el" "tab-bar.el" "textmodes/fill.el"
+;;;;;; "international/mule.el" "isearch.el" "jit-lock.el" "jka-cmpr-hook.el"
+;;;;;; "language/burmese.el" "language/cham.el" "language/chinese.el"
+;;;;;; "language/cyrillic.el" "language/czech.el" "language/english.el"
+;;;;;; "language/ethiopic.el" "language/european.el" "language/georgian.el"
+;;;;;; "language/greek.el" "language/hebrew.el" "language/indian.el"
+;;;;;; "language/japanese.el" "language/khmer.el" "language/korean.el"
+;;;;;; "language/lao.el" "language/misc-lang.el" "language/romanian.el"
+;;;;;; "language/sinhala.el" "language/slovak.el" "language/tai-viet.el"
+;;;;;; "language/thai.el" "language/tibetan.el" "language/utf-8-lang.el"
+;;;;;; "language/vietnamese.el" "ldefs-boot.el" "leim/ja-dic/ja-dic.el"
+;;;;;; "leim/leim-list.el" "leim/quail/4Corner.el" "leim/quail/ARRAY30.el"
+;;;;;; "leim/quail/CCDOSPY.el" "leim/quail/CTLau-b5.el" "leim/quail/CTLau.el"
+;;;;;; "leim/quail/ECDICT.el" "leim/quail/ETZY.el" "leim/quail/PY-b5.el"
+;;;;;; "leim/quail/PY.el" "leim/quail/Punct-b5.el" "leim/quail/Punct.el"
+;;;;;; "leim/quail/QJ-b5.el" "leim/quail/QJ.el" "leim/quail/SW.el"
+;;;;;; "leim/quail/TONEPY.el" "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el"
+;;;;;; "leim/quail/arabic.el" "leim/quail/cham.el" "leim/quail/compose.el"
+;;;;;; "leim/quail/croatian.el" "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el"
+;;;;;; "leim/quail/czech.el" "leim/quail/georgian.el" "leim/quail/greek.el"
+;;;;;; "leim/quail/hanja-jis.el" "leim/quail/hanja.el" "leim/quail/hanja3.el"
+;;;;;; "leim/quail/hebrew.el" "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el"
+;;;;;; "leim/quail/latin-ltx.el" "leim/quail/latin-post.el" "leim/quail/latin-pre.el"
+;;;;;; "leim/quail/persian.el" "leim/quail/programmer-dvorak.el"
+;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el"
+;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el"
+;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el" "leim/quail/symbol-ksc.el"
+;;;;;; "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el"
+;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el"
+;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" "mail/rmailkwd.el"
+;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
+;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el"
+;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el"
+;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-lob.el"
+;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el"
+;;;;;; "org/ol-irc.el" "org/ol.el" "org/org-archive.el" "org/org-attach.el"
+;;;;;; "org/org-clock.el" "org/org-colview.el" "org/org-compat.el"
+;;;;;; "org/org-datetree.el" "org/org-duration.el" "org/org-element.el"
+;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-goto.el"
+;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-install.el"
+;;;;;; "org/org-keys.el" "org/org-lint.el" "org/org-list.el" "org/org-macs.el"
+;;;;;; "org/org-mobile.el" "org/org-num.el" "org/org-plot.el" "org/org-refile.el"
+;;;;;; "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el"
+;;;;;; "org/ox-html.el" "org/ox-icalendar.el" "org/ox-latex.el"
+;;;;;; "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el"
+;;;;;; "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el"
+;;;;;; "progmodes/prog-mode.el" "ps-mule.el" "register.el" "replace.el"
+;;;;;; "rfn-eshadow.el" "select.el" "simple.el" "startup.el" "subdirs.el"
+;;;;;; "subr.el" "tab-bar.el" "textmodes/fill.el" "textmodes/makeinfo.el"
;;;;;; "textmodes/page.el" "textmodes/paragraphs.el" "textmodes/reftex-auc.el"
;;;;;; "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" "textmodes/reftex-global.el"
;;;;;; "textmodes/reftex-index.el" "textmodes/reftex-parse.el" "textmodes/reftex-ref.el"
-;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/text-mode.el"
-;;;;;; "uniquify.el" "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el"
-;;;;;; "widget.el" "window.el") (0 0 0 0))
+;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el"
+;;;;;; "textmodes/text-mode.el" "uniquify.el" "vc/ediff-hook.el"
+;;;;;; "vc/vc-hooks.el" "version.el" "widget.el" "window.el") (0
+;;;;;; 0 0 0))
;;;***
diff --git a/lisp/leim/quail/croatian.el b/lisp/leim/quail/croatian.el
index 08f1e47b6f3..7402b81a8cc 100644
--- a/lisp/leim/quail/croatian.el
+++ b/lisp/leim/quail/croatian.el
@@ -1,4 +1,4 @@
-;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8; lexical-binding:t -*-
+;;; croatian.el --- Quail package for inputting Croatian -*-coding: utf-8; lexical-binding:t -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index ca1aae77be3..c03e86b33c0 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -1,4 +1,4 @@
-;;; hangul.el --- Korean Hangul input method
+;;; hangul.el --- Korean Hangul input method -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -88,9 +88,9 @@
(defvar hangul-im-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "\d" 'hangul-delete-backward-char)
- (define-key map [f9] 'hangul-to-hanja-conversion)
- (define-key map [Hangul_Hanja] 'hangul-to-hanja-conversion)
+ (define-key map "\d" #'hangul-delete-backward-char)
+ (define-key map [f9] #'hangul-to-hanja-conversion)
+ (define-key map [Hangul_Hanja] #'hangul-to-hanja-conversion)
map)
"Keymap for Hangul method. It is used by all Hangul input methods.")
@@ -337,7 +337,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
char)))))
(aset hangul-queue 5 char)))
(hangul-insert-character hangul-queue)
- (if (zerop (apply '+ (append hangul-queue nil)))
+ (if (zerop (apply #'+ (append hangul-queue nil)))
(hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0)))
(hangul-insert-character hangul-queue
(setq hangul-queue (vector 0 0 0 0 char 0))))))
@@ -349,7 +349,7 @@ Other parts are the same as a `hangul3-input-method-cho'."
(while (and (> i 0) (zerop (aref hangul-queue i)))
(setq i (1- i)))
(aset hangul-queue i 0))
- (if (notzerop (apply '+ (append hangul-queue nil)))
+ (if (notzerop (apply #'+ (append hangul-queue nil)))
(hangul-insert-character hangul-queue)
(delete-char -1)))
@@ -514,16 +514,16 @@ When a Korean input method is off, convert the following hangul character."
(defvar-local hangul-input-method-help-text nil)
;;;###autoload
-(defun hangul-input-method-activate (input-method func help-text &rest args)
+(defun hangul-input-method-activate (_input-method func help-text &rest _args)
"Activate Hangul input method INPUT-METHOD.
FUNC is a function to handle input key.
HELP-TEXT is a text set in `hangul-input-method-help-text'."
- (setq deactivate-current-input-method-function 'hangul-input-method-deactivate
- describe-current-input-method-function 'hangul-input-method-help
+ (setq deactivate-current-input-method-function #'hangul-input-method-deactivate
+ describe-current-input-method-function #'hangul-input-method-help
hangul-input-method-help-text help-text)
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
+ (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer))
(setq-local input-method-function func))
(defun hangul-input-method-deactivate ()
@@ -538,7 +538,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'."
(define-obsolete-function-alias
'hangul-input-method-inactivate
- 'hangul-input-method-deactivate "24.3")
+ #'hangul-input-method-deactivate "24.3")
(defun hangul-input-method-help ()
"Describe the current Hangul input method."
diff --git a/lisp/leim/quail/hebrew.el b/lisp/leim/quail/hebrew.el
index fc6bb80596b..28b2eb34367 100644
--- a/lisp/leim/quail/hebrew.el
+++ b/lisp/leim/quail/hebrew.el
@@ -1,4 +1,4 @@
-;; hebrew.el --- Quail package for inputting Hebrew characters -*- coding: utf-8; lexical-binding: t -*-
+;;; hebrew.el --- Quail package for inputting Hebrew characters -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 6f5054e3f62..251b18c9887 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -1,4 +1,4 @@
-;;; indian.el --- Quail packages for inputting Indian
+;;; indian.el --- Quail packages for inputting Indian -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -39,7 +39,10 @@
(defun quail-define-indian-trans-package (hashtbls pkgname
lang title doc)
- (funcall 'quail-define-package pkgname lang title t doc
+ ;; This is a funcall to avoid `quail-update-leim-list-file'
+ ;; determining that this is a quail definition (it searches for
+ ;; "(quail-define-package").
+ (funcall #'quail-define-package pkgname lang title t doc
nil nil nil nil nil nil t nil)
(maphash
(lambda (key val)
@@ -200,7 +203,7 @@
(setq clm 6)
(dolist (v vowels)
- (apply 'insert (propertize "\t" 'display (list 'space :align-to clm))
+ (apply #'insert (propertize "\t" 'display (list 'space :align-to clm))
(if (nth 1 c) (list (nth 1 c) (nth 2 v)) (list "")))
(setq clm (+ clm 6))))
(insert "\n")
@@ -309,7 +312,10 @@ Full key sequences are listed below:")
(defun quail-define-inscript-package (char-tables key-tables pkgname lang
title docstring)
- (funcall 'quail-define-package pkgname lang title nil docstring
+ ;; This is a funcall to avoid `quail-update-leim-list-file'
+ ;; determining that this is a quail definition (it searches for
+ ;; "(quail-define-package").
+ (funcall #'quail-define-package pkgname lang title nil docstring
nil nil nil t nil nil nil nil)
(let (char-table key-table char key)
(while (and char-tables key-tables)
@@ -627,7 +633,7 @@ Full key sequences are listed below:")
(quail-define-package "malayalam-mozhi" "Malayalam" "MlmMI" t
"Malayalam transliteration by Mozhi method."
nil nil t nil nil nil t nil
- 'indian-mlm-mozhi-update-translation)
+ #'indian-mlm-mozhi-update-translation)
(maphash
(lambda (key val)
@@ -636,9 +642,9 @@ Full key sequences are listed below:")
(vector val))))
(cdr indian-mlm-mozhi-hash))
-(defun indian-mlm-mozhi-underscore (key len) (throw 'quail-tag nil))
+(defun indian-mlm-mozhi-underscore (_key _len) (throw 'quail-tag nil))
-(quail-defrule "_" 'indian-mlm-mozhi-underscore)
+(quail-defrule "_" #'indian-mlm-mozhi-underscore)
(quail-defrule "|" ?‌)
(quail-defrule "||" ?​)
diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el
index 0920bc79009..1a95395fd74 100644
--- a/lisp/leim/quail/ipa-praat.el
+++ b/lisp/leim/quail/ipa-praat.el
@@ -35,7 +35,7 @@
"ipa-praat" "IPA" "IPAP" t
"International Phonetic Alphabet input method.
This follows the input method of the phonetic analysis program
-Praat (http://www.fon.hum.uva.nl/praat/).
+Praat (https://www.fon.hum.uva.nl/praat/).
* Vowels
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index d9f58885f20..c25687574ed 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -1,4 +1,4 @@
-;;; ipa.el --- Quail package for inputting IPA characters -*-coding: utf-8;-*-
+;;; ipa.el --- Quail package for inputting IPA characters -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -276,7 +276,7 @@ string."
(cl-assert (vectorp quail-keymap) t)
(setq quail-keymap (append quail-keymap nil))))
(list
- (apply 'vector
+ (apply #'vector
(mapcar
#'(lambda (entry)
(cl-assert (char-or-string-p entry) t)
@@ -336,12 +336,12 @@ exchange in environments where Unicode is not available. This input method
uses this transliteration to allow you to produce the IPA in your editor
with a keyboard that's limited to ASCII.
-See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition
+See https://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition
of the mapping.")
(quail-define-rules
;; Table taken from https://en.wikipedia.org/wiki/X-SAMPA, checked with
- ;; http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf
+ ;; https://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf
("d`" "ɖ") ;; Voiced retroflex plosive U+0256
("g" "ɡ") ;; Voiced velar plosive U+0261
@@ -502,9 +502,9 @@ of the mapping.")
;; diacritic. To avoid this, handle the input specially with the function
;; ipa-x-sampa-underscore-implosive.
-(dolist (implosive-x-sampa (mapcar 'car ipa-x-sampa-implosive-submap))
+(dolist (implosive-x-sampa (mapcar #'car ipa-x-sampa-implosive-submap))
(setq implosive-x-sampa (car (split-string implosive-x-sampa "_")))
(quail-defrule (format "%s_" implosive-x-sampa)
- 'ipa-x-sampa-underscore-implosive))
+ #'ipa-x-sampa-underscore-implosive))
;;; ipa.el ends here
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index a4ea550c265..6a2bcdc9ed7 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -1,4 +1,4 @@
-;;; japanese.el --- Quail package for inputting Japanese
+;;; japanese.el --- Quail package for inputting Japanese -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -412,7 +412,7 @@ C-h kkc-help
List these key bindings.
"
nil t t nil nil nil nil nil
- 'quail-japanese-update-translation
+ #'quail-japanese-update-translation
'(("K" . quail-japanese-toggle-kana)
(" " . quail-japanese-kanji-kkc)
("\C-m" . quail-no-conversion)
@@ -491,7 +491,7 @@ qh: shift to the input method `japanese',
qq: toggle between this input method and the input method `japanese-ascii'.
"
nil t t nil nil nil nil nil
- 'quail-japanese-hankaku-update-translation)
+ #'quail-japanese-hankaku-update-translation)
(dolist (elt quail-japanese-transliteration-rules)
(quail-defrule (car elt)
@@ -517,7 +517,7 @@ qq: toggle between this input method and the input method `japanese-ascii'.
nil
"Japanese hiragana input method by Roman transliteration."
nil t t nil nil nil nil nil
- 'quail-japanese-update-translation)
+ #'quail-japanese-update-translation)
;; Use the same map as that of `japanese'.
(setcar (cdr (cdr quail-current-package))
@@ -538,7 +538,7 @@ qq: toggle between this input method and the input method `japanese-ascii'.
nil
"Japanese katakana input method by Roman transliteration."
nil t t nil nil nil nil nil
- 'quail-japanese-katakana-update-translation)
+ #'quail-japanese-katakana-update-translation)
(dolist (elt quail-japanese-transliteration-rules)
(quail-defrule (car elt)
diff --git a/lisp/leim/quail/lao.el b/lisp/leim/quail/lao.el
index af3b5892629..a932460a20a 100644
--- a/lisp/leim/quail/lao.el
+++ b/lisp/leim/quail/lao.el
@@ -1,4 +1,4 @@
-;;; lao.el --- Quail package for inputting Lao characters -*-coding: utf-8;-*-
+;;; lao.el --- Quail package for inputting Lao characters -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
@@ -195,7 +195,7 @@ you need to re-load it to properly re-initialize related alists.")
(quail-define-package
"lao" "Lao" "ລ" t
"Lao input method simulating Lao keyboard layout based on Thai TIS620"
- nil t t t t nil nil nil 'quail-lao-update-translation nil t)
+ nil t t t t nil nil nil #'quail-lao-update-translation nil t)
(quail-install-map
(quail-map-from-table
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index fd78253c4fb..2146304f156 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -1,4 +1,4 @@
-;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*-
+;;; latin-ltx.el --- Quail package for TeX-style input -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
@@ -279,13 +279,17 @@ system, including many technical ones. Examples:
("\\Vdash" ?⊩)
("\\Vert" ?‖)
("\\Vvdash" ?⊪)
+ ("\\above" ?┴)
("\\aleph" ?ℵ)
("\\amalg" ?∐)
("\\angle" ?∠)
+ ("\\aoint" ?∳)
("\\approx" ?≈)
("\\approxeq" ?≊)
+ ("\\asmash" ?⬆)
("\\ast" ?∗)
("\\asymp" ?≍)
+ ("\\atop" ?¦)
("\\backcong" ?≌)
("\\backepsilon" ?∍)
("\\backprime" ?‵)
@@ -294,11 +298,18 @@ system, including many technical ones. Examples:
("\\backslash" ?\\)
("\\barwedge" ?⊼)
("\\because" ?∵)
+ ("\\begin" ?\〖)
+ ("\\below" ?┬)
("\\beth" ?ℶ)
("\\between" ?≬)
("\\bigcap" ?⋂)
("\\bigcirc" ?◯)
("\\bigcup" ?⋃)
+ ("\\bigodot" ?⨀)
+ ("\\bigoplus" ?⨁)
+ ("\\bigotimes" ?⨂)
+ ("\\bigsqcup" ?⨆)
+ ("\\biguplus" ?⨄)
("\\bigstar" ?★)
("\\bigtriangledown" ?▽)
("\\bigtriangleup" ?△)
@@ -315,6 +326,7 @@ system, including many technical ones. Examples:
("\\boxminus" ?⊟)
("\\boxplus" ?⊞)
("\\boxtimes" ?⊠)
+ ("\\bra" ?\⟨)
("\\bullet" ?•)
("\\bumpeq" ?≏)
("\\cap" ?∩)
@@ -331,7 +343,9 @@ system, including many technical ones. Examples:
("\\circledast" ?⊛)
("\\circledcirc" ?⊚)
("\\circleddash" ?⊝)
+ ("\\close" ?┤)
("\\clubsuit" ?♣)
+ ("\\coint" ?∲)
("\\coloneq" ?≔)
("\\complement" ?∁)
("\\cong" ?≅)
@@ -349,8 +363,12 @@ system, including many technical ones. Examples:
("\\dagger" ?†)
("\\daleth" ?ℸ)
("\\dashv" ?⊣)
+ ("\\Dd" ?ⅅ)
+ ("\\dd" ?ⅆ)
("\\ddag" ?‡)
("\\ddagger" ?‡)
+ ("\\ddddot" ?⃜)
+ ("\\dddot" ?⃛)
("\\ddots" ?⋱)
("\\diamond" ?⋄)
("\\diamondsuit" ?♢)
@@ -363,8 +381,12 @@ system, including many technical ones. Examples:
("\\downdownarrows" ?⇊)
("\\downleftharpoon" ?⇃)
("\\downrightharpoon" ?⇂)
+ ("\\dsmash" ?⬇)
+ ("\\ee" ?ⅇ)
("\\ell" ?ℓ)
("\\emptyset" ?∅)
+ ("\\end" ?\〗)
+ ("\\eqarray" ?█)
("\\eqcirc" ?≖)
("\\eqcolon" ?≕)
("\\eqslantgtr" ?⋝)
@@ -414,16 +436,25 @@ system, including many technical ones. Examples:
("\\heartsuit" ?♥)
("\\hookleftarrow" ?↩)
("\\hookrightarrow" ?↪)
+ ("\\hphantom" ?⬄)
+ ("\\hsmash" ?⬌)
("\\iff" ?⇔)
+ ("\\ii" ?ⅈ)
+ ("\\iiiint" ?⨌)
+ ("\\iiint" ?∭)
+ ("\\iint" ?∬)
("\\imath" ?ı)
("\\in" ?∈)
("\\infty" ?∞)
("\\int" ?∫)
("\\intercal" ?⊺)
+ ("\\jj" ?ⅉ)
+ ("\\jmath" ?ȷ)
("\\langle" ?⟨) ;; Was ?〈, see bug#12948.
("\\lbrace" ?{)
("\\lbrack" ?\[)
("\\lceil" ?⌈)
+ ("\\ldiv" ?∕)
("\\ldots" ?…)
("\\le" ?≤)
("\\leadsto" ?↝)
@@ -529,16 +560,25 @@ system, including many technical ones. Examples:
("\\nvdash" ?⊬)
("\\nwarrow" ?↖)
("\\odot" ?⊙)
+ ("\\oiiint" ?∰)
+ ("\\oiint" ?∯)
("\\oint" ?∮)
("\\ominus" ?⊖)
("\\oplus" ?⊕)
("\\oslash" ?⊘)
("\\otimes" ?⊗)
+ ("\\overbrace" ?⏞)
+ ("\\overparen" ?⏜)
("\\par" ?
)
("\\parallel" ?∥)
("\\partial" ?∂)
("\\perp" ?⊥)
+ ("\\phantom" ?⟡)
("\\pitchfork" ?⋔)
+ ("\\pppprime" ?⁗)
+ ("\\ppprime" ?‴)
+ ("\\pprime" ?″)
+ ("\\prcue" ?≼)
("\\prec" ?≺)
("\\precapprox" ?≾)
("\\preceq" ?≼)
@@ -548,12 +588,16 @@ system, including many technical ones. Examples:
("\\prime" ?′)
("\\prod" ?∏)
("\\propto" ?∝)
+ ("\\qdrt" ?∜)
("\\qed" ?∎)
("\\quad" ? )
("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948.
+ ("\\ratio" ?∶)
("\\rbrace" ?})
("\\rbrack" ?\])
("\\rceil" ?⌉)
+ ("\\rddots" ?⋰)
+ ("\\rect" ?▭)
("\\rfloor" ?⌋)
("\\rightarrow" ?→)
("\\rightarrowtail" ?↣)
@@ -565,6 +609,8 @@ system, including many technical ones. Examples:
("\\rightrightarrows" ?⇉)
("\\rightthreetimes" ?⋌)
("\\risingdotseq" ?≓)
+ ("\\rrect" ?▢)
+ ("\\sdiv" ?⁄)
("\\rtimes" ?⋊)
("\\sbs" ?﹨)
("\\searrow" ?↘)
@@ -577,6 +623,7 @@ system, including many technical ones. Examples:
("\\smallamalg" ?∐)
("\\smallsetminus" ?∖)
("\\smallsmile" ?⌣)
+ ("\\smash" ?⬍)
("\\smile" ?⌣)
("\\spadesuit" ?♠)
("\\sphericalangle" ?∢)
@@ -627,12 +674,16 @@ system, including many technical ones. Examples:
("\\ulcorner" ?⌜)
("\\uparrow" ?↑)
("\\updownarrow" ?↕)
+ ("\\underbar" ?▁)
+ ("\\underbrace" ?⏟)
+ ("\\underparen" ?⏝)
("\\upleftharpoon" ?↿)
("\\uplus" ?⊎)
("\\uprightharpoon" ?↾)
("\\upuparrows" ?⇈)
("\\urcorner" ?⌝)
("\\u{i}" ?ĭ)
+ ("\\vbar" ?│)
("\\vDash" ?⊨)
((lambda (name char)
@@ -655,6 +706,7 @@ system, including many technical ones. Examples:
("\\vee" ?∨)
("\\veebar" ?⊻)
("\\vert" ?|)
+ ("\\vphantom" ?⇳)
("\\wedge" ?∧)
("\\wp" ?℘)
("\\wr" ?≀)
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index 8e21ed80130..8329fff82ed 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -744,7 +744,7 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
;;; correctly on most displays.
;;; This reference is an authoritative guide to Hawaiian orthography:
-;;; http://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html
+;;; https://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html
;;; Initial coding 2018-09-08 Bob Newell, Honolulu, Hawaiʻi
;;; Comments to bobnewell@bobnewell.net
@@ -1298,6 +1298,64 @@ Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=`
("a__" ["a_"])
)
+;; Input modes of various orthographies for the Lakota language.
+;; I'd like to acknowledge the elders and ancestors who fought
+;; to keep the language and culture alive.
+;; Grant Shangreaux <grant@churls.world> 2021-05-23
+
+(quail-define-package
+ "lakota-white-hat-postfix" "Lakota" "Lak " t
+ "Lakota White Hat orthography input method with postfix modifiers.
+The `f' key produces the nasal ŋ while unused letters `r' and `v' add
+the combining dot above and macron diacritics respectively. This allows
+production of all the consonants:
+
+cv -> c̄ hr -> ḣ pv -> p̄ tv -> t̄
+cr -> ċ kv -> k̄ pr -> ṗ tr -> ṫ
+gr -> ġ kr -> k̇ sr -> ṡ zr -> ż
+
+The glottal stop is produced by repeating the ' character. This orthography
+does not use stress diacritics on vowels. Mit̄ak̄uyep̄i p̄ilamayayap̄ilo."
+nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("f" ?ŋ)
+ ("''" ?’)
+ ;; using hex representation as these characters combine with the ? syntax
+ ("r" #x307) ; COMBINING DOT ABOVE
+ ("v" #x304)) ; COMBINING MACRON
+
+
+
+(quail-define-package
+ "lakota-slo-postfix" "Lakota" "SLO " t
+ "Suggested Lakota Orthography input method with postfix modifier.
+To add stress to a vowel, simply type the single quote ' after the vowel.
+The glottal stop is produced by repeating the ' character. All other
+characters are bound to a single key. Mitákuyepi philámayayapi ló."
+nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ;; accented vowels
+ ("a'" ?á) ("A'" ?Á)
+ ("e'" ?é) ("E'" ?É)
+ ("i'" ?í) ("I'" ?Í)
+ ("o'" ?ó) ("O'" ?Ó)
+ ("u'" ?ú) ("U'" ?Ú)
+
+ ;; consonants with caron
+ ("c" ?č) ("C" ?Č)
+ ("j" ?ȟ) ("J" ?Ȟ)
+ ("q" ?ǧ) ("Q" ?Ǧ)
+ ("x" ?ž) ("X" ?Ž)
+ ("r" ?š) ("R" ?Š)
+
+ ;; velar nasal n
+ ("f" ?ŋ)
+
+ ;; glottal stop
+ ("''" ?’))
+
(quail-define-package
"norwegian-postfix" "Latin-1" "NO<" t
"Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E\\='->É
diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el
index 22006547c45..3b9c942a8c1 100644
--- a/lisp/leim/quail/latin-pre.el
+++ b/lisp/leim/quail/latin-pre.el
@@ -1294,7 +1294,7 @@ of characters from a single Latin-N charset.
;;; correctly on most displays.
;;; This reference is an authoritative guide to Hawaiian orthography:
-;;; http://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html
+;;; https://www2.hawaii.edu/~strauch/tips/HawaiianOrthography.html
;;; Initial coding 2018-09-08 Bob Newell, Honolulu, Hawaiʻi
;;; Comments to bobnewell@bobnewell.net
@@ -1337,4 +1337,33 @@ Doubling the prefix separates the letter and prefix. --a -> -a
("``" ["`"])
)
+(quail-define-package
+ "lakota-slo-prefix" "Lakota" "SLO " t
+ "Suggested Lakota Orthography input method with prefix modifier.
+To add stress to a vowel, simply type the single quote ' before the vowel.
+The glottal stop is produced by repeating the ' character. All other
+characters are bound to a single key. Mitákuyepi philámayayapi ló."
+nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ;; accented vowels
+ ("'a" ?á) ("'A" ?Á)
+ ("'e" ?é) ("'E" ?É)
+ ("'i" ?í) ("'I" ?Í)
+ ("'o" ?ó) ("'O" ?Ó)
+ ("'u" ?ú) ("'U" ?Ú)
+
+ ;; consonants with caron
+ ("c" ?č) ("C" ?Č)
+ ("j" ?ȟ) ("J" ?Ȟ)
+ ("q" ?ǧ) ("Q" ?Ǧ)
+ ("x" ?ž) ("X" ?Ž)
+ ("r" ?š) ("R" ?Š)
+
+ ;; velar nasal n
+ ("f" ?ŋ)
+
+ ;; glottal stop
+ ("''" ?’))
+
;;; latin-pre.el ends here
diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el
index e05bc1e6cb7..68eaeb58ec6 100644
--- a/lisp/leim/quail/lrt.el
+++ b/lisp/leim/quail/lrt.el
@@ -1,4 +1,4 @@
-;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-coding: utf-8;-*-
+;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*- lexical-binding: t; -*-
;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -60,7 +60,7 @@
`\\' (backslash) + `$' => ຯ LAO ELLIPSIS
"
nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout
- nil nil nil 'quail-lrt-update-translation nil t)
+ nil nil nil #'quail-lrt-update-translation nil t)
;; LRT (Lao Roman Transcription) input method accepts the following
;; key sequence:
diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el
index 4157f886704..cb1f6e3c78b 100644
--- a/lisp/leim/quail/persian.el
+++ b/lisp/leim/quail/persian.el
@@ -1,4 +1,4 @@
-;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8; lexical-binding: t -*-
+;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8; lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
diff --git a/lisp/leim/quail/programmer-dvorak.el b/lisp/leim/quail/programmer-dvorak.el
index 49f9d82bc0d..9e1e23c04bb 100644
--- a/lisp/leim/quail/programmer-dvorak.el
+++ b/lisp/leim/quail/programmer-dvorak.el
@@ -24,7 +24,7 @@
;;; Commentary:
;;; This file provides an input method for the programmers Dvorak keyboard
-;;; layout by Roland Kaufman (<http://www.kaufmann.no/roland/dvorak/>).
+;;; layout by Roland Kaufman (<https://www.kaufmann.no/roland/dvorak/>).
;;; Code:
diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el
index 8e7a500276a..aa35bb0574f 100644
--- a/lisp/leim/quail/sisheng.el
+++ b/lisp/leim/quail/sisheng.el
@@ -1,4 +1,4 @@
-;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration
+;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
diff --git a/lisp/leim/quail/thai.el b/lisp/leim/quail/thai.el
index 7cf11daf9d0..07ba657f9b8 100644
--- a/lisp/leim/quail/thai.el
+++ b/lisp/leim/quail/thai.el
@@ -1,4 +1,4 @@
-;;; thai.el --- Quail package for inputting Thai characters -*-coding: utf-8;-*-
+;;; thai.el --- Quail package for inputting Thai characters -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
index a54763d56f6..33cc6f5965f 100644
--- a/lisp/leim/quail/tibetan.el
+++ b/lisp/leim/quail/tibetan.el
@@ -1,4 +1,4 @@
-;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs;-*-
+;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs; lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -158,7 +158,7 @@
Tsheg is assigned to SPC. Space is assigned to period `.'.
"
nil nil nil nil nil nil nil nil
- 'quail-tibetan-update-translation)
+ #'quail-tibetan-update-translation)
;; Here we build up a Quail map for a Tibetan sequence the whole of
;; which can be one composition.
@@ -371,7 +371,7 @@
(setq trans-list (cons trans trans-list)
i last)
(setq trans-list nil i len))))
- (apply 'concat (nreverse trans-list))))
+ (apply #'concat (nreverse trans-list))))
(defvar quail-tibkey-characters nil)
@@ -440,7 +440,7 @@
I hope I'll complete in a future revision.
"
nil nil nil nil nil nil nil nil
- 'quail-tibkey-update-translation)
+ #'quail-tibkey-update-translation)
(quail-install-map
(quail-map-from-table
diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el
index c7cf6abe2aa..bfe4ce6f120 100644
--- a/lisp/leim/quail/uni-input.el
+++ b/lisp/leim/quail/uni-input.el
@@ -1,4 +1,4 @@
-;;; uni-input.el --- Hex Unicode input method
+;;; uni-input.el --- Hex Unicode input method -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
@@ -57,11 +57,12 @@
(echo-keystrokes 0)
(help-char nil)
(events (list key))
- (str " "))
+ ;; (str " ")
+ )
(unwind-protect
(catch 'non-digit
(progn
- (dotimes (i 4)
+ (dotimes (_ 4)
(let ((seq (read-key-sequence nil))
key)
(if (and (stringp seq)
@@ -76,7 +77,7 @@
(throw 'non-digit (append (reverse events)
(listify-key-sequence seq))))))
(quail-delete-region)
- (let ((n (string-to-number (apply 'string
+ (let ((n (string-to-number (apply #'string
(cdr (nreverse events)))
16)))
(if (characterp n)
@@ -100,12 +101,12 @@ While this input method is active, the variable
(quail-delete-overlays)
(setq describe-current-input-method-function nil))
(kill-local-variable 'input-method-function))
- (setq deactivate-current-input-method-function 'ucs-input-deactivate)
- (setq describe-current-input-method-function 'ucs-input-help)
+ (setq deactivate-current-input-method-function #'ucs-input-deactivate)
+ (setq describe-current-input-method-function #'ucs-input-help)
(quail-delete-overlays)
(if (eq (selected-window) (minibuffer-window))
- (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
- (setq-local input-method-function 'ucs-input-method)))
+ (add-hook 'minibuffer-exit-hook #'quail-exit-from-minibuffer))
+ (setq-local input-method-function #'ucs-input-method)))
(defun ucs-input-deactivate ()
"Deactivate UCS input method."
@@ -114,7 +115,7 @@ While this input method is active, the variable
(define-obsolete-function-alias
'ucs-input-inactivate
- 'ucs-input-deactivate "24.3")
+ #'ucs-input-deactivate "24.3")
(defun ucs-input-help ()
(interactive)
diff --git a/lisp/linum.el b/lisp/linum.el
index f9761d22c6e..c78f596d768 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -31,9 +31,6 @@
;;; Code:
-(defconst linum-version "0.9x")
-(make-obsolete-variable 'linum-version nil "28.1")
-
(defvar-local linum-overlays nil "Overlays used in this buffer.")
(defvar-local linum-available nil "Overlays available for reuse.")
(defvar linum-before-numbering-hook nil
@@ -222,7 +219,7 @@ Linum mode is a buffer-local minor mode."
;; update overlays on deletions, and after newlines are inserted
(when (or (= beg end)
(= end (point-max))
- (string-match-p "\n" (buffer-substring-no-properties beg end)))
+ (string-search "\n" (buffer-substring-no-properties beg end)))
(linum-update-current)))
(defun linum-after-scroll (win _start)
@@ -244,6 +241,9 @@ Linum mode is a buffer-local minor mode."
;; continue standard unloading
nil)
+(defconst linum-version "0.9x")
+(make-obsolete-variable 'linum-version 'emacs-version "28.1")
+
(provide 'linum)
;;; linum.el ends here
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index a60d6b29095..0b12bdad058 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,4 +1,4 @@
-;;; loadhist.el --- lisp functions for working with feature groups
+;;; loadhist.el --- lisp functions for working with feature groups -*- lexical-binding: t -*-
;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc.
@@ -82,12 +82,6 @@ A library name is equivalent to the file name that `load-library' would load."
(when (eq (car-safe x) 'require)
(push (cdr x) requires)))))
-(defsubst file-set-intersect (p q)
- "Return the set intersection of two lists."
- (let (ret)
- (dolist (x p ret)
- (when (memq x q) (push x ret)))))
-
(defun file-dependents (file)
"Return the list of loaded libraries that depend on FILE.
This can include FILE itself.
@@ -97,7 +91,7 @@ A library name is equivalent to the file name that `load-library' would load."
(dependents nil))
(dolist (x load-history dependents)
(when (and (stringp (car x))
- (file-set-intersect provides (file-requires (car x))))
+ (seq-intersection provides (file-requires (car x)) #'eq))
(push (car x) dependents)))))
(defun read-feature (prompt &optional loaded-p)
@@ -322,6 +316,13 @@ something strange, such as redefining an Emacs function."
;; Don't return load-history, it is not useful.
nil)
+;; Obsolete.
+
+(defsubst file-set-intersect (p q)
+ "Return the set intersection of two lists."
+ (declare (obsolete seq-intersection "28.1"))
+ (nreverse (seq-intersection p q #'eq)))
+
(provide 'loadhist)
;;; loadhist.el ends here
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 9cee6a2fd83..158c02eceaa 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,4 +1,4 @@
-;;; loadup.el --- load up standardly loaded Lisp files for Emacs
+;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -112,7 +112,7 @@
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
- (setq purify-flag (make-hash-table :test 'equal :size 80000)))
+ (setq purify-flag (make-hash-table :test #'equal :size 80000)))
(message "Using load-path %s" load-path)
@@ -134,7 +134,7 @@
;; Do it after subr, since both after-load-functions and add-hook are
;; implemented in subr.el.
-(add-hook 'after-load-functions (lambda (f) (garbage-collect)))
+(add-hook 'after-load-functions (lambda (_) (garbage-collect)))
(load "version")
@@ -151,13 +151,14 @@
;; variable its advertised default value (it starts as nil, see
;; xdisp.c).
(setq resize-mini-windows 'grow-only)
-(setq load-source-file-function 'load-with-code-conversion)
+(setq load-source-file-function #'load-with-code-conversion)
(load "files")
;; Load-time macro-expansion can only take effect after setting
;; load-source-file-function because of where it is called in lread.c.
(load "emacs-lisp/macroexp")
-(if (byte-code-function-p (symbol-function 'macroexpand-all))
+(if (or (byte-code-function-p (symbol-function 'macroexpand-all))
+ (subr-native-elisp-p (symbol-function 'macroexpand-all)))
nil
;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
;; fail until pcase is explicitly loaded. This also means that we have to
@@ -186,7 +187,7 @@
;; In case loaddefs hasn't been generated yet.
(file-error (load "ldefs-boot.el")))
-(let ((new (make-hash-table :test 'equal)))
+(let ((new (make-hash-table :test #'equal)))
;; Now that loaddefs has populated definition-prefixes, purify its contents.
(maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
definition-prefixes)
@@ -253,9 +254,6 @@
(load "startup")
(load "term/tty-colors")
(load "font-core")
-;; facemenu must be loaded before font-lock, because `facemenu-keymap'
-;; needs to be defined when font-lock is loaded.
-(load "facemenu")
(load "emacs-lisp/syntax")
(load "font-lock")
(load "jit-lock")
@@ -265,6 +263,7 @@
(load "scroll-bar"))
(load "select")
(load "emacs-lisp/timer")
+(load "emacs-lisp/easymenu")
(load "isearch")
(load "rfn-eshadow")
@@ -401,7 +400,7 @@ lost after dumping")))
emacs-repository-branch (ignore-errors (emacs-repository-get-branch)))
;; A constant, so we shouldn't change it with `setq'.
(defconst emacs-build-number
- (if versions (1+ (apply 'max versions)) 1))))
+ (if versions (1+ (apply #'max versions)) 1))))
(message "Finding pointers to doc strings...")
@@ -431,11 +430,11 @@ lost after dumping")))
;; We keep the load-history data in PURE space.
;; Make sure that the spine of the list is not in pure space because it can
;; be destructively mutated in lread.c:build_load_history.
-(setq load-history (mapcar 'purecopy load-history))
+(setq load-history (mapcar #'purecopy load-history))
(set-buffer-modified-p nil)
-(remove-hook 'after-load-functions (lambda (f) (garbage-collect)))
+(remove-hook 'after-load-functions (lambda (_) (garbage-collect)))
(if (boundp 'load--prefer-newer)
(progn
@@ -450,6 +449,43 @@ lost after dumping")))
;; At this point, we're ready to resume undo recording for scratch.
(buffer-enable-undo "*scratch*")
+(when (featurep 'native-compile)
+ ;; Fix the compilation unit filename to have it working when
+ ;; installed or if the source directory got moved. This is set to be
+ ;; a pair in the form of:
+ ;; (rel-filename-from-install-bin . rel-filename-from-local-bin).
+ (let ((h (make-hash-table :test #'eq))
+ (bin-dest-dir (cadr (member "--bin-dest" command-line-args)))
+ (eln-dest-dir (cadr (member "--eln-dest" command-line-args))))
+ (when (and bin-dest-dir eln-dest-dir)
+ (setq eln-dest-dir
+ (concat eln-dest-dir "native-lisp/" comp-native-version-dir "/"))
+ (mapatoms (lambda (s)
+ (let ((f (symbol-function s)))
+ (when (subr-native-elisp-p f)
+ (puthash (subr-native-comp-unit f) nil h)))))
+ (maphash (lambda (cu _)
+ (let* ((file (native-comp-unit-file cu))
+ (preloaded (equal (substring (file-name-directory file)
+ -10 -1)
+ "preloaded"))
+ (eln-dest-dir-eff (if preloaded
+ (expand-file-name "preloaded"
+ eln-dest-dir)
+ eln-dest-dir)))
+ (native-comp-unit-set-file
+ cu
+ (cons
+ ;; Relative filename from the installed binary.
+ (file-relative-name (expand-file-name
+ (file-name-nondirectory
+ file)
+ eln-dest-dir-eff)
+ bin-dest-dir)
+ ;; Relative filename from the built uninstalled binary.
+ (file-relative-name file invocation-directory)))))
+ h))))
+
(when (hash-table-p purify-flag)
(let ((strings 0)
(vectors 0)
@@ -477,12 +513,19 @@ lost after dumping")))
;; Make sure we will attempt bidi reordering henceforth.
(setq redisplay--inhibit-bidi nil)
+
+
(if dump-mode
(let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp")
((equal dump-mode "dump") "emacs")
((equal dump-mode "bootstrap") "emacs")
((equal dump-mode "pbootstrap") "bootstrap-emacs.pdmp")
(t (error "unrecognized dump mode %s" dump-mode)))))
+ (when (and (featurep 'native-compile)
+ (equal dump-mode "pdump"))
+ ;; Don't enable this before bootstrap is completed, as the
+ ;; compiler infrastructure may not be usable yet.
+ (setq comp-enable-subr-trampolines t))
(message "Dumping under the name %s" output)
(condition-case ()
(delete-file output)
@@ -539,8 +582,9 @@ lost after dumping")))
;; Don't keep `load-file-name' set during the top-level session!
;; Otherwise, it breaks a lot of code which does things like
;; (or load-file-name byte-compile-current-file).
+(setq load-true-file-name nil)
(setq load-file-name nil)
-(eval top-level)
+(eval top-level t)
;; Local Variables:
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 012d2518929..29a0fd8d728 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,4 +1,4 @@
-;;; lpr.el --- print Emacs buffer on line printer
+;;; lpr.el --- print Emacs buffer on line printer -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -39,12 +39,10 @@
(memq system-type '(usg-unix-v hpux))
"Non-nil if running on a system type that uses the \"lp\" command.")
-
(defgroup lpr nil
"Print Emacs buffer on line printer."
:group 'text)
-
;;;###autoload
(defcustom printer-name
(and (eq system-type 'ms-dos) "PRN")
@@ -65,8 +63,7 @@ file. If you want to discard the printed output, set this to \"NUL\"."
:tag "Printer Name"
(const :tag "Default" nil)
;; could use string but then we lose completion for files.
- (file :tag "Name"))
- :group 'lpr)
+ (file :tag "Name")))
;;;###autoload
(defcustom lpr-switches nil
@@ -74,16 +71,14 @@ file. If you want to discard the printed output, set this to \"NUL\"."
It is recommended to set `printer-name' instead of including an explicit
switch on this list.
See `lpr-command'."
- :type '(repeat (string :tag "Argument"))
- :group 'lpr)
+ :type '(repeat (string :tag "Argument")))
(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux))
"Non-nil means construct `-T' and `-J' options for the printer program.
These are made assuming that the program is `lpr';
if you are using some other incompatible printer program,
this variable should be nil."
- :type 'boolean
- :group 'lpr)
+ :type 'boolean)
(defcustom lpr-printer-switch
(if lpr-lp-system
@@ -94,8 +89,7 @@ This switch is used in conjunction with `printer-name'."
:type '(choice :menu-tag "Printer Name Switch"
:tag "Printer Name Switch"
(const :tag "None" nil)
- (string :tag "Printer Switch"))
- :group 'lpr)
+ (string :tag "Printer Switch")))
;;;###autoload
(defcustom lpr-command
@@ -116,8 +110,7 @@ Windows NT and Novell Netware respectively) are handled specially, using
`printer-name' as the destination for output; any other program is
treated like `lpr' except that an explicit filename is given as the last
argument."
- :type 'string
- :group 'lpr)
+ :type 'string)
;; Default is nil, because that enables us to use pr -f
;; which is more reliable than pr with no args, which is what lpr -p does.
@@ -127,22 +120,21 @@ If nil, we run `lpr-page-header-program' to make page headings
and print the result."
:type '(choice (const nil)
(string :tag "Single argument")
- (repeat :tag "Multiple arguments" (string :tag "Argument")))
- :group 'lpr)
+ (repeat :tag "Multiple arguments" (string :tag "Argument"))))
(defcustom print-region-function
(if (memq system-type '(ms-dos windows-nt))
- #'w32-direct-print-region-function
+ (progn
+ (declare-function w32-direct-print-region-function "w32-fns")
+ #'w32-direct-print-region-function)
#'call-process-region)
"Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
- :type 'function
- :group 'lpr)
+ :type 'function)
(defcustom lpr-page-header-program "pr"
"Name of program for adding page headers to a file."
- :type 'string
- :group 'lpr)
+ :type 'string)
;; Berkeley systems support -F, and GNU pr supports both -f and -F,
;; So it looks like -F is a better default.
@@ -151,8 +143,7 @@ See definition of `print-region-1' for calling conventions."
If `%s' appears in any of the strings, it is substituted by the page title.
Note that for correct quoting, `%s' should normally be a separate element.
The variable `lpr-page-header-program' specifies the program to use."
- :type '(repeat string)
- :group 'lpr)
+ :type '(repeat string))
;;;###autoload
(defun lpr-buffer ()
@@ -248,7 +239,7 @@ for further customization of the printer command."
nil
;; Run a separate program to get page headers.
(let ((new-coords (print-region-new-buffer start end)))
- (apply 'call-process-region (car new-coords) (cdr new-coords)
+ (apply #'call-process-region (car new-coords) (cdr new-coords)
lpr-page-header-program t t nil
(mapcar (lambda (e) (format e name))
lpr-page-header-switches)))
@@ -270,7 +261,7 @@ for further customization of the printer command."
(let ((retval
(let ((tempbuf (current-buffer)))
(with-current-buffer buf
- (apply (or print-region-function 'call-process-region)
+ (apply (or print-region-function #'call-process-region)
start end lpr-command
nil tempbuf nil
(nconc (and name lpr-add-switches
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 3721e86475c..9041b9ac0f9 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -28,7 +28,7 @@
;; OVERVIEW ==========================================================
;; This file advises the function `insert-directory' to implement it
-;; directly from Emacs lisp, without running ls in a subprocess.
+;; directly from Emacs Lisp, without running ls in a subprocess.
;; This is useful if you don't have ls installed (ie, on MS Windows).
;; This function can use regexps instead of shell wildcards. If you
@@ -276,7 +276,9 @@ supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
is non-nil; otherwise, it interprets wildcards as regular expressions
to match file names. It does not support all `ls' switches -- those
that work are: A a B C c F G g h i n R r S s t U u v X. The l switch
-is assumed to be always present and cannot be turned off."
+is assumed to be always present and cannot be turned off.
+Long variants of the above switches, as documented for GNU `ls',
+are also supported; unsupported long options are silently ignored."
(if ls-lisp-use-insert-directory-program
(funcall orig-fun
file switches wildcard full-directory-p)
@@ -284,13 +286,21 @@ is assumed to be always present and cannot be turned off."
(let ((handler (find-file-name-handler (expand-file-name file)
'insert-directory))
(orig-file file)
- wildcard-regexp)
+ wildcard-regexp
+ (ls-lisp-dirs-first
+ (or ls-lisp-dirs-first
+ (string-match "--group-directories-first" switches))))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
- ;; Remove --dired switch
- (if (string-match "--dired " switches)
- (setq switches (replace-match "" nil nil switches)))
+ (when (string-match "--group-directories-first" switches)
+ ;; if ls-lisp-dirs-first is nil, dirs are grouped but come out in
+ ;; reverse order:
+ (setq ls-lisp-dirs-first t)
+ (setq switches (replace-match "" nil nil switches)))
+ ;; Remove unrecognized long options, and convert the
+ ;; recognized ones to their short variants.
+ (setq switches (ls-lisp--sanitize-switches switches))
;; Convert SWITCHES to a list of characters.
(setq switches (delete ?\ (delete ?- (append switches nil))))
;; Sometimes we get ".../foo*/" as FILE. While the shell and
@@ -890,6 +900,60 @@ All ls time options, namely c, t and u, are handled."
;; Continue standard unloading.
nil)
+(defun ls-lisp--sanitize-switches (switches)
+ "Convert long options of GNU 'ls' to their short form.
+Conversion is done only for flags supported by ls-lisp.
+Long options not supported by ls-lisp are removed.
+Supported options are: A a B C c F G g h i n R r S s t U u v X.
+The l switch is assumed to be always present and cannot be turned off."
+ (let ((lsflags '(("-a" . "--all")
+ ("-A" . "--almost-all")
+ ("-B" . "--ignore-backups")
+ ("-C" . "--color")
+ ("-F" . "--classify")
+ ("-G" . "--no-group")
+ ("-h" . "--human-readable")
+ ("-H" . "--dereference-command-line")
+ ("-i" . "--inode")
+ ("-n" . "--numeric-uid-gid")
+ ("-r" . "--reverse")
+ ("-R" . "--recursive")
+ ("-s" . "--size")
+ ("-S" . "--sort.*[ \\\t]")
+ ("" . "--group-directories-first")
+ ("" . "--author")
+ ("" . "--escape")
+ ("" . "--directory")
+ ("" . "--dired")
+ ("" . "--file-type")
+ ("" . "--format")
+ ("" . "--full-time")
+ ("" . "--si")
+ ("" . "--dereference-command-line-symlink-to-dir")
+ ("" . "--hide")
+ ("" . "--hyperlink")
+ ("" . "--ignore")
+ ("" . "--kibibytes")
+ ("" . "--dereference")
+ ("" . "--literal")
+ ("" . "--hide-control-chars")
+ ("" . "--show-control-chars")
+ ("" . "--quote-name")
+ ("" . "--context")
+ ("" . "--help")
+ ;; ("" . "--indicator-style.*[ \\\t]")
+ ;; ("" . "--quoting-style.*[ \t\\]")
+ ;; ("" . "--time.*[ \\\t]")
+ ;; ("" . "--time-style.*[ \\\t]")
+ ;; ("" . "--tabsize.*[ \\\t]")
+ ;; ("" . "--width.*[ \\\t]")
+ ("" . "--.*=.*[ \\\t\n]?") ;; catch all with '=' sign in
+ ("" . "--version"))))
+ (dolist (f lsflags)
+ (if (string-match (cdr f) switches)
+ (setq switches (replace-match (car f) nil nil switches))))
+ (string-trim switches)))
+
(provide 'ls-lisp)
;;; ls-lisp.el ends here
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index edb52b65789..af327442c28 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -38,19 +38,16 @@
"Non-nil value should be a string that names a binhex decoder.
The program should expect to read binhex data on its standard
input and write the converted data to its standard output."
- :type 'string
- :group 'binhex)
+ :type 'string)
(defcustom binhex-decoder-switches '("-d")
"List of command line flags passed to the command `binhex-decoder-program'."
- :group 'binhex
:type '(repeat string))
(defcustom binhex-use-external
(executable-find binhex-decoder-program)
"Use external binhex program."
:version "22.1"
- :group 'binhex
:type 'boolean)
(defconst binhex-alphabet-decoding-alist
@@ -80,7 +77,7 @@ input and write the converted data to its standard output."
(make-obsolete-variable 'binhex-temporary-file-directory
'temporary-file-directory "28.1")
-(defun binhex-insert-char (char &optional count ignored buffer)
+(defun binhex-insert-char (char &optional count _ignored buffer)
"Insert COUNT copies of CHARACTER into BUFFER."
(if (or (null buffer) (eq buffer (current-buffer)))
(insert-char char count)
@@ -273,7 +270,8 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(defun binhex-decode-region-external (start end)
"Binhex decode region between START and END using external decoder."
(interactive "r")
- (let ((cbuf (current-buffer)) firstline work-buffer
+ (let ((cbuf (current-buffer))
+ work-buffer ;; firstline
(file-name (expand-file-name
(concat (binhex-decode-region-internal start end t)
".data")
@@ -287,9 +285,9 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(set-buffer (setq work-buffer
(generate-new-buffer " *binhex-work*")))
(buffer-disable-undo work-buffer)
- (insert-buffer-substring cbuf firstline end)
+ (insert-buffer-substring cbuf nil end) ;; firstline
(cd temporary-file-directory)
- (apply 'call-process-region
+ (apply #'call-process-region
(point-min)
(point-max)
binhex-decoder-program
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index 505ce5d4767..f380f0df290 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -1,4 +1,4 @@
-;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t -*-
+;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t; lexical-binding: t; -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 815ff4339eb..14c93f2fc8e 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,4 +1,4 @@
-;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
+;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1994, 1997-1998, 2000-2021 Free Software
;; Foundation, Inc.
@@ -45,12 +45,10 @@
(defcustom report-emacs-bug-no-confirmation nil
"If non-nil, suppress the confirmations asked for the sake of novice users."
- :group 'emacsbug
:type 'boolean)
(defcustom report-emacs-bug-no-explanations nil
"If non-nil, suppress the explanations given for the sake of novice users."
- :group 'emacsbug
:type 'boolean)
;; User options end here.
@@ -204,7 +202,7 @@ This requires either the macOS \"open\" command, or the freedesktop
(defvar message-sendmail-envelope-from)
;;;###autoload
-(defun report-emacs-bug (topic &optional unused)
+(defun report-emacs-bug (topic &optional _unused)
"Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer.
@@ -219,10 +217,10 @@ Already submitted bugs can be found in the Emacs bug tracker:
(let ((from-buffer (current-buffer))
(can-insert-mail (or (report-emacs-bug-can-use-xdg-email)
(report-emacs-bug-can-use-osx-open)))
- user-point message-end-point)
- (setq message-end-point
- (with-current-buffer (messages-buffer)
- (point-max-marker)))
+ user-point) ;; message-end-point
+ ;; (setq message-end-point
+ ;; (with-current-buffer (messages-buffer)
+ ;; (point-max-marker)))
(condition-case nil
;; For the novice user make sure there's always enough space for
;; the mail and the warnings buffer on this frame (Bug#10873).
@@ -263,7 +261,7 @@ Already submitted bugs can be found in the Emacs bug tracker:
"Bug-GNU-Emacs"
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
- 'action (lambda (button)
+ 'action (lambda (_button)
(browse-url "https://lists.gnu.org/r/bug-gnu-emacs/"))
'follow-link t)
(insert " mailing list\nand the GNU bug tracker at ")
@@ -271,7 +269,7 @@ Already submitted bugs can be found in the Emacs bug tracker:
"debbugs.gnu.org"
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
- 'action (lambda (button)
+ 'action (lambda (_button)
(browse-url "https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1"))
'follow-link t)
@@ -311,7 +309,7 @@ usually do not have translators for other languages.\n\n")))
(lambda (var)
(let ((val (getenv var)))
(if val (insert (format " value of $%s: %s\n" var val)))))
- '("EMACSDATA" "EMACSDOC" "EMACSLOADPATH" "EMACSPATH"
+ '("EMACSDATA" "EMACSDOC" "EMACSLOADPATH" "EMACSNATIVELOADPATH" "EMACSPATH"
"LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
"LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS"))
(insert (format " locale-coding-system: %s\n" locale-coding-system))
@@ -347,10 +345,10 @@ usually do not have translators for other languages.\n\n")))
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-i" 'info-emacs-bug)
+ (define-key (current-local-map) "\C-c\C-i" #'info-emacs-bug)
(if can-insert-mail
(define-key (current-local-map) "\C-c\M-i"
- 'report-emacs-bug-insert-to-mailer))
+ #'report-emacs-bug-insert-to-mailer))
(setq report-emacs-bug-send-command (get mail-user-agent 'sendfunc)
report-emacs-bug-send-hook (get mail-user-agent 'hookvar))
(if report-emacs-bug-send-command
@@ -376,7 +374,7 @@ usually do not have translators for other languages.\n\n")))
(shrink-window-if-larger-than-buffer (get-buffer-window "*Bug Help*")))
;; Make it less likely people will send empty messages.
(if report-emacs-bug-send-hook
- (add-hook report-emacs-bug-send-hook 'report-emacs-bug-hook nil t))
+ (add-hook report-emacs-bug-send-hook #'report-emacs-bug-hook nil t))
(goto-char (point-max))
(skip-chars-backward " \t\n")
(setq-local report-emacs-bug-orig-text
@@ -398,7 +396,7 @@ usually do not have translators for other languages.\n\n")))
;; This is used not only for X11 but also W32 and others.
(insert "Windowing system distributor '" (x-server-vendor)
"', version "
- (mapconcat 'number-to-string (x-server-version) ".") "\n")
+ (mapconcat #'number-to-string (x-server-version) ".") "\n")
(error t)))
(let ((os (ignore-errors (report-emacs-bug--os-description))))
(if (stringp os)
@@ -409,7 +407,7 @@ usually do not have translators for other languages.\n\n")))
system-configuration-options "'\n\n")
(fill-region (line-beginning-position -1) (point))))
-(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3")
+(define-obsolete-function-alias 'report-emacs-bug-info #'info-emacs-bug "24.3")
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 2bcbdf4a223..cec573642ec 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -163,7 +163,7 @@
;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t)
;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail)
;;
-;; Alternatively, the FLIM <http://www.m17n.org/FLIM/> project
+;; Alternatively, the FLIM <https://www.m17n.org/FLIM/> project
;; provides a library called smtp.el. If you want to use that, the above lines
;; would be:
;;
@@ -1381,7 +1381,7 @@ It shows the simple addresses and gets a confirmation. Use as:
(save-window-excursion
(display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
(erase-buffer)
- (insert (mapconcat 'identity feedmail-address-list " "))
+ (insert (mapconcat #'identity feedmail-address-list " "))
(if (not (y-or-n-p "How do you like them apples? "))
(error "FQM: Sending...gave up in last chance hook"))))
@@ -1592,10 +1592,10 @@ Feeds the buffer to it."
(feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid)
(set-buffer prepped)
(apply
- 'call-process-region
+ #'call-process-region
(append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
(format feedmail-binmail-template
- (mapconcat 'identity addr-listoid " "))))))
+ (mapconcat #'identity addr-listoid " "))))))
(defvar sendmail-program)
@@ -1609,7 +1609,7 @@ local gurus."
(require 'sendmail)
(feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
(set-buffer prepped)
- (apply 'call-process-region
+ (apply #'call-process-region
(append (list (point-min) (point-max) sendmail-program
nil errors-to nil "-oi" "-t")
;; provide envelope "from" to sendmail; results will vary
@@ -2042,7 +2042,7 @@ backup file names and the like)."
(message "FQM: Trapped `%s', message left in queue." (car signal-stuff))
(sit-for 3)
(message "FQM: Trap details: \"%s\""
- (mapconcat 'identity (cdr signal-stuff) "\" \""))
+ (mapconcat #'identity (cdr signal-stuff) "\" \""))
(sit-for 3)))
(kill-buffer blobby-buffer)
(feedmail-say-chatter
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 0fab1b21b47..5319ab994ce 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -81,7 +81,7 @@ RFC 2646 suggests 66 characters for readability."
(while (setq end (text-property-any start (point-max) 'hard 't))
(save-restriction
(narrow-to-region start end)
- (let ((fill-column (eval fill-flowed-encode-column)))
+ (let ((fill-column (eval fill-flowed-encode-column t)))
(fill-flowed-fill-buffer))
(goto-char (point-min))
(while (re-search-forward "\n" nil t)
@@ -119,7 +119,7 @@ If BUFFER is nil, default to the current buffer.
If DELETE-SPACE, delete RFC2646 spaces padding at the end of
lines."
(with-current-buffer (or buffer (current-buffer))
- (let ((fill-column (eval fill-flowed-display-column)))
+ (let ((fill-column (eval fill-flowed-display-column t)))
(goto-char (point-min))
(while (not (eobp))
(cond
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 795e37dced6..b1682cf78a2 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -232,13 +232,13 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
;; If we found no display-name, then we look for comments.
(if display-name
(setq display-string
- (mapconcat 'identity (reverse display-name) " "))
+ (mapconcat #'identity (reverse display-name) " "))
(setq display-string (ietf-drums-get-comment string)))
(if (not mailbox)
(when (and display-string
- (string-match "@" display-string))
+ (string-search "@" display-string))
(cons
- (mapconcat 'identity (nreverse display-name) "")
+ (mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
(cons mailbox (if decode
(rfc2047-decode-string display-string)
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 4e3bf78c807..24d8311f641 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,4 +1,4 @@
-;;; mail-extr.el --- extract full name and address from email header
+;;; mail-extr.el --- extract full name and address from email header -*- lexical-binding: t; -*-
;; Copyright (C) 1991-1994, 1997, 2001-2021 Free Software Foundation,
;; Inc.
@@ -222,23 +222,20 @@
"Whether to try to guess middle initial from mail address.
If true, then when we see an address like \"John Smith <jqs@host.com>\"
we will assume that \"John Q. Smith\" is the fellow's name."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
(defcustom mail-extr-ignore-single-names nil
"Whether to ignore a name that is just a single word.
If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
we will act as though we couldn't find a full name in the address."
:type 'boolean
- :version "22.1"
- :group 'mail-extr)
+ :version "22.1")
(defcustom mail-extr-ignore-realname-equals-mailbox-name t
"Whether to ignore a name that is equal to the mailbox name.
If true, then when the address is like \"Single <single@address.com>\"
we will act as though we couldn't find a full name in the address."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
;; Matches a leading title that is not part of the name (does not
;; contribute to uniquely identifying the person).
@@ -248,19 +245,16 @@ we will act as though we couldn't find a full name in the address."
"Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
uniquely identifying the person."
- :type 'regexp
- :group 'mail-extr)
+ :type 'regexp)
(defcustom mail-extr-@-binds-tighter-than-! nil
"Whether the local mail transport agent looks at ! before @."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
(defcustom mail-extr-mangle-uucp nil
"Whether to throw away information in UUCP addresses
by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
- :type 'boolean
- :group 'mail-extr)
+ :type 'boolean)
;;----------------------------------------------------------------------
;; what orderings are meaningful?????
@@ -713,7 +707,10 @@ This function is primarily meant for when you're displaying the
result to the user: Many prettifications are applied to the
result returned. If you want to decode an address for further
non-display use, you should probably use
-`mail-header-parse-address' instead."
+`mail-header-parse-address' instead. Also see
+`mail-header-parse-address-lax' for a function that's less strict
+than `mail-header-parse-address', but does less post-processing
+to the results."
(let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
(extraction-buffer (get-buffer-create " *extract address components*"))
value-list)
@@ -760,7 +757,6 @@ non-display use, you should probably use
end-of-address
<-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos
group-:-pos group-\;-pos route-addr-:-pos
- record-pos-symbol
first-real-pos last-real-pos
phrase-beg phrase-end
;; Dynamically set in mail-extr-voodoo.
@@ -852,13 +848,16 @@ non-display use, you should probably use
)
;; record the position of various interesting chars, determine
;; validity later.
- ((setq record-pos-symbol
- (cdr (assq char
- '((?< . <-pos) (?> . >-pos) (?@ . @-pos)
- (?: . colon-pos) (?, . comma-pos) (?! . !-pos)
- (?% . %-pos) (?\; . \;-pos)))))
- (set record-pos-symbol
- (cons (point) (symbol-value record-pos-symbol)))
+ ((memq char '(?< ?> ?@ ?: ?, ?! ?% ?\;))
+ (push (point) (pcase-exhaustive char
+ (?< <-pos)
+ (?> >-pos)
+ (?@ @-pos)
+ (?: colon-pos)
+ (?, comma-pos)
+ (?! !-pos)
+ (?% %-pos)
+ (?\; \;-pos)))
(forward-char 1))
((eq char ?.)
(forward-char 1))
@@ -1065,7 +1064,7 @@ non-display use, you should probably use
(mail-extr-demarkerize route-addr-:-pos)
(setq route-addr-:-pos nil
>-pos (mail-extr-demarkerize >-pos)
- %-pos (mapcar 'mail-extr-demarkerize %-pos)))
+ %-pos (mapcar #'mail-extr-demarkerize %-pos)))
;; de-listify @-pos
(setq @-pos (car @-pos))
@@ -1122,7 +1121,7 @@ non-display use, you should probably use
(setq insert-point (point-max)))
(%-pos
(setq insert-point (car (last %-pos))
- saved-%-pos (mapcar 'mail-extr-markerize %-pos)
+ saved-%-pos (mapcar #'mail-extr-markerize %-pos)
%-pos nil
@-pos (mail-extr-markerize @-pos)))
(@-pos
@@ -1162,7 +1161,7 @@ non-display use, you should probably use
"uucp"))
(setq !-pos (cdr !-pos))))
(and saved-%-pos
- (setq %-pos (append (mapcar 'mail-extr-demarkerize
+ (setq %-pos (append (mapcar #'mail-extr-demarkerize
saved-%-pos)
%-pos)))
(setq @-pos (mail-extr-demarkerize @-pos))
@@ -1461,8 +1460,7 @@ If it is neither nil nor a string, modifying of names will never take
place. It affects how `mail-extract-address-components' works."
:type '(choice (regexp :size 0)
(const :tag "Always enabled" nil)
- (const :tag "Always disabled" t))
- :group 'mail-extr)
+ (const :tag "Always disabled" t)))
(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer)
(unless (and mail-extr-disable-voodoo
@@ -2241,13 +2239,13 @@ place. It affects how `mail-extract-address-components' works."
;(let ((all nil))
-; (mapatoms #'(lambda (x)
+; (mapatoms (lambda (x)
; (if (and (boundp x)
; (string-match "^mail-extr-" (symbol-name x)))
; (setq all (cons x all)))))
; (setq all (sort all #'string-lessp))
; (cons 'setq
-; (apply 'nconc (mapcar #'(lambda (x)
+; (apply 'nconc (mapcar (lambda (x)
; (list x (symbol-value x)))
; all))))
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 37c8ad68860..239b386ff84 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,4 +1,4 @@
-;;; mail-hist.el --- headers and message body history for outgoing mail
+;;; mail-hist.el --- headers and message body history for outgoing mail -*- lexical-binding: t; -*-
;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc.
@@ -69,8 +69,8 @@
;;;###autoload
(defun mail-hist-enable ()
- (add-hook 'mail-mode-hook 'mail-hist-define-keys)
- (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history))
+ (add-hook 'mail-mode-hook #'mail-hist-define-keys)
+ (add-hook 'mail-send-hook #'mail-hist-put-headers-into-history))
(defvar mail-hist-header-ring-alist nil
"Alist of form (header-name . history-ring).
@@ -80,14 +80,12 @@ previous/next input.")
(defcustom mail-hist-history-size (or kill-ring-max 1729)
"The maximum number of elements in a mail field's history.
Oldest elements are dumped first."
- :type 'integer
- :group 'mail-hist)
+ :type 'integer)
;;;###autoload
(defcustom mail-hist-keep-history t
"Non-nil means keep a history for headers and text of outgoing mail."
- :type 'boolean
- :group 'mail-hist)
+ :type 'boolean)
;; For handling repeated history requests
(defvar mail-hist-access-count 0)
@@ -184,8 +182,7 @@ HEADER is a string without the colon."
(defcustom mail-hist-text-size-limit nil
"Don't store any header or body with more than this many characters.
If the value is nil, that means no limit on text size."
- :type '(choice (const nil) integer)
- :group 'mail-hist)
+ :type '(choice (const nil) integer))
(defun mail-hist-text-too-long-p (text)
"Return non-nil if TEXT's length exceeds `mail-hist-text-size-limit'."
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index e72ed828494..212fadf3823 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -71,6 +71,45 @@
(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region)
(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string)
+(defun mail-header-parse-addresses-lax (string)
+ "Parse STRING as a comma-separated list of mail addresses.
+The return value is a list with mail/name pairs."
+ (delq nil
+ (mapcar (lambda (elem)
+ (or (mail-header-parse-address elem)
+ (mail-header-parse-address-lax elem)))
+ (mail-header-parse-addresses string t))))
+
+(defun mail-header-parse-address-lax (string)
+ "Parse STRING as a mail address.
+Returns a mail/name pair.
+
+This function will first try to parse STRING as a
+standards-compliant address string, and if that fails, try to use
+heuristics to determine the email address and the name in the
+string."
+ (with-temp-buffer
+ (insert (string-clean-whitespace string))
+ ;; Find the bit with the @ and guess that that's the mail.
+ (goto-char (point-max))
+ (when (search-backward "@" nil t)
+ (if (re-search-backward " " nil t)
+ (forward-char 1)
+ (goto-char (point-min)))
+ (let* ((start (point))
+ (mail (buffer-substring
+ start (or (re-search-forward " " nil t)
+ (goto-char (point-max))))))
+ (delete-region start (point))
+ ;; We've now removed the email bit, so the rest of the stuff
+ ;; has to be the name.
+ (cons (string-trim mail "[<]+" "[>]+")
+ (let ((name (string-trim (buffer-string)
+ "[ \t\n\r(]+" "[ \t\n\r)]+")))
+ (if (length= name 0)
+ nil
+ name)))))))
+
(provide 'mail-parse)
;;; mail-parse.el ends here
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index ad2dee59c7c..3eb3ccb93de 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -1,4 +1,4 @@
-;;; mail-utils.el --- utility functions used both by rmail and rnews
+;;; mail-utils.el --- utility functions used both by rmail and rnews -*- lexical-binding: t -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -46,6 +46,7 @@ also the To field, unless this would leave an empty To field."
:type '(choice regexp (const :tag "Your Name" nil))
:group 'mail)
+(defvar epa-inhibit)
;; Returns t if file FILE is an Rmail file.
;;;###autoload
(defun mail-file-babyl-p (file)
@@ -58,6 +59,7 @@ also the To field, unless this would leave an empty To field."
(defun mail-string-delete (string start end)
"Return a string containing all of STRING except the part
from START (inclusive) to END (exclusive)."
+ ;; FIXME: This is not used anywhere. Make obsolete?
(if (null end) (substring string 0 start)
(concat (substring string 0 start)
(substring string end nil))))
@@ -132,7 +134,7 @@ we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
(aref string (1+ (match-beginning 1))))))
strings)))
(setq i (match-end 0)))
- (apply 'concat (nreverse (cons (substring string i) strings))))))
+ (apply #'concat (nreverse (cons (substring string i) strings))))))
;; FIXME Gnus for some reason has `quoted-printable-decode-region' in qp.el.
;;;###autoload
@@ -192,7 +194,7 @@ Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR.
Return a modified address list."
(when address
(if mail-use-rfc822
- (mapconcat 'identity (rfc822-addresses address) ", ")
+ (mapconcat #'identity (rfc822-addresses address) ", ")
(let (pos)
;; Strip comments.
@@ -250,7 +252,7 @@ comma-separated list, and return the pruned list."
(setq cur-pos (string-match "[,\"]" destinations cur-pos))
(if (and cur-pos (equal (match-string 0 destinations) "\""))
;; Search for matching quote.
- (let ((next-pos (string-match "\"" destinations (1+ cur-pos))))
+ (let ((next-pos (string-search "\"" destinations (1+ cur-pos))))
(if next-pos
(setq cur-pos (1+ next-pos))
;; If the open-quote has no close-quote,
@@ -280,7 +282,7 @@ comma-separated list, and return the pruned list."
destinations))
;; Legacy name
-(define-obsolete-function-alias 'rmail-dont-reply-to 'mail-dont-reply-to "24.1")
+(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to "24.1")
;;;###autoload
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 2147049ab19..5cb4a7469a9 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -1,4 +1,4 @@
-;;; mailabbrev.el --- abbrev-expansion of mail aliases
+;;; mailabbrev.el --- abbrev-expansion of mail aliases -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2021 Free
;; Software Foundation, Inc.
@@ -140,15 +140,13 @@ abbrev-like expansion is performed when editing certain mail
headers (those specified by `mail-abbrev-mode-regexp'), based on
the entries in your `mail-personal-alias-file'."
:global t
- :group 'mail-abbrev
:version "20.3"
(if mail-abbrevs-mode (mail-abbrevs-enable) (mail-abbrevs-disable)))
(defcustom mail-abbrevs-only nil
"Non-nil means only mail abbrevs should expand automatically.
Other abbrevs expand only when you explicitly use `expand-abbrev'."
- :type 'boolean
- :group 'mail-abbrev)
+ :type 'boolean)
;; originally defined in sendmail.el - used to be an alist, now is a table.
(defvar mail-abbrevs nil
@@ -186,11 +184,11 @@ no aliases, which is represented by this being a table with no entries.)")
(abbrev-mode 1))
(defun mail-abbrevs-enable ()
- (add-hook 'mail-mode-hook 'mail-abbrevs-setup))
+ (add-hook 'mail-mode-hook #'mail-abbrevs-setup))
(defun mail-abbrevs-disable ()
"Turn off use of the `mailabbrev' package."
- (remove-hook 'mail-mode-hook 'mail-abbrevs-setup)
+ (remove-hook 'mail-mode-hook #'mail-abbrevs-setup)
(abbrev-mode (if (default-value 'abbrev-mode) 1 -1)))
;;;###autoload
@@ -258,8 +256,7 @@ By default this is the file specified by `mail-personal-alias-file'."
"String inserted between addresses in multi-address mail aliases.
This has to contain a comma, so \", \" is a reasonable value. You might
also want something like \",\\n \" to get each address on its own line."
- :type 'string
- :group 'mail-abbrev)
+ :type 'string)
;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
;; to be called before expanding abbrevs if it's necessary.
@@ -367,7 +364,7 @@ double-quotes."
(defun mail-resolve-all-aliases-1 (sym &optional so-far)
(if (memq sym so-far)
(error "mail alias loop detected: %s"
- (mapconcat 'symbol-name (cons sym so-far) " <- ")))
+ (mapconcat #'symbol-name (cons sym so-far) " <- ")))
(let ((definition (and (boundp sym) (symbol-value sym))))
(if definition
(let ((result '())
@@ -420,8 +417,7 @@ of the current line; if it matches, abbrev mode will be turned on, otherwise
it will be turned off. (You don't need to worry about continuation lines.)
This should be set to match those mail fields in which you want abbreviations
turned on."
- :type 'regexp
- :group 'mail-abbrev)
+ :type 'regexp)
(defvar mail-abbrev-syntax-table nil
"The syntax-table used for abbrev-expansion purposes.
@@ -433,14 +429,14 @@ of a mail alias. The value is set up, buffer-local, when first needed.")
(make-local-variable 'mail-abbrev-syntax-table)
(unless mail-abbrev-syntax-table
(let ((tab (copy-syntax-table (syntax-table)))
- (_ (aref (standard-syntax-table) ?_))
+ (syntax-_ (aref (standard-syntax-table) ?_))
(w (aref (standard-syntax-table) ?w)))
(map-char-table
(lambda (key value)
(if (null value)
;; Fetch the inherited value
(setq value (aref tab key)))
- (if (equal value _)
+ (if (equal value syntax-_)
(set-char-table-range tab key w)))
tab)
(modify-syntax-entry ?@ "w" tab)
@@ -600,12 +596,12 @@ In other respects, this behaves like `end-of-buffer', which see."
(eval-after-load "sendmail"
'(progn
- (define-key mail-mode-map "\C-c\C-a" 'mail-abbrev-insert-alias)
+ (define-key mail-mode-map "\C-c\C-a" #'mail-abbrev-insert-alias)
(define-key mail-mode-map "\e\t" ; like completion-at-point
- 'mail-abbrev-complete-alias)))
+ #'mail-abbrev-complete-alias))) ;; FIXME: Use `completion-at-point'.
-;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
-;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
+;;(define-key mail-mode-map "\C-n" #'mail-abbrev-next-line)
+;;(define-key mail-mode-map "\M->" #'mail-abbrev-end-of-buffer)
(provide 'mailabbrev)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 3cba6a60e8f..5c153ce1c1f 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -1,4 +1,4 @@
-;;; mailclient.el --- mail sending via system's mail client.
+;;; mailclient.el --- mail sending via system's mail client. -*- lexical-binding: t; -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index cbc01e4a442..0443279be84 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -1,4 +1,4 @@
-;;; mailheader.el --- mail header parsing, merging, formatting
+;;; mailheader.el --- mail header parsing, merging, formatting -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -99,23 +99,23 @@ value."
headers)
;; Advertised part of the interface; see mail-header, mail-header-set.
-(with-suppressed-warnings ((lexical headers))
- (defvar headers))
-(defsubst mail-header (header &optional header-alist)
+(defun mail-header (header &optional header-alist)
"Return the value associated with header HEADER in HEADER-ALIST.
If the value is a string, it is the original value of the header. If the
value is a list, its first element is the original value of the header,
-with any subsequent elements being the result of parsing the value.
-If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
+with any subsequent elements being the result of parsing the value."
(declare (gv-setter (lambda (value)
`(mail-header-set ,header ,value ,header-alist))))
+ (with-suppressed-warnings ((lexical headers)) (defvar headers))
(cdr (assq header (or header-alist headers))))
(defun mail-header-set (header value &optional header-alist)
"Set the value associated with header HEADER to VALUE in HEADER-ALIST.
HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
See `mail-header' for the semantics of VALUE."
+ (declare (obsolete alist-get "28.1"))
+ (with-suppressed-warnings ((lexical headers)) (defvar headers))
(let* ((alist (or header-alist headers))
(entry (assq header alist)))
(if entry
@@ -131,10 +131,13 @@ should be a string or a list of string. The first element may be nil to
denote that the formatting functions must use the remaining elements, or
skip the header altogether if there are no other elements.
The macro `mail-header' can be used to access headers in HEADERS."
- (mapcar
- (lambda (rule)
- (cons (car rule) (eval (cdr rule))))
- merge-rules))
+ (declare (obsolete alist-get "28.1"))
+ (with-suppressed-warnings ((lexical headers)) (defvar headers))
+ (let ((headers headers))
+ (mapcar
+ (lambda (rule)
+ (cons (car rule) (eval (cdr rule) t)))
+ merge-rules)))
(defvar mail-header-format-function
(lambda (header value)
@@ -167,7 +170,7 @@ A key of nil has as its value a list of defaulted headers to ignore."
(mapcar #'car format-rules))))
(dolist (rule format-rules)
(let* ((header (car rule))
- (value (mail-header header)))
+ (value (alist-get header headers)))
(if (stringp header)
(setq header (intern header)))
(cond ((null header) 'ignore)
@@ -176,13 +179,11 @@ A key of nil has as its value a list of defaulted headers to ignore."
(unless (memq (car defaulted) ignore)
(let* ((header (car defaulted))
(value (cdr defaulted)))
- (if (cdr rule)
- (funcall (cdr rule) header value)
- (funcall mail-header-format-function header value))))))
+ (funcall (or (cdr rule) mail-header-format-function)
+ header value)))))
(value
- (if (cdr rule)
- (funcall (cdr rule) header value)
- (funcall mail-header-format-function header value))))))
+ (funcall (or (cdr rule) mail-header-format-function)
+ header value)))))
(insert "\n")))
(provide 'mailheader)
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 970f52c3374..6d834140582 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -167,11 +167,11 @@ your primary spool is. If this fails, set it to something like
(defvar mspools-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'mspools-visit-spool)
- (define-key map "\C-m" 'mspools-visit-spool)
- (define-key map " " 'mspools-visit-spool)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
+ (define-key map "\C-c\C-c" #'mspools-visit-spool)
+ (define-key map "\C-m" #'mspools-visit-spool)
+ (define-key map " " #'mspools-visit-spool)
+ (define-key map "n" #'next-line)
+ (define-key map "p" #'previous-line)
map)
"Keymap for the *spools* buffer.")
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 5b08713949f..c442913d282 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -612,7 +612,7 @@ should not change this value.")
(setq next prev
prev nil)
(if (or (< index limit)
- (<= (+ len (or (string-match "\n" tail)
+ (<= (+ len (or (string-search "\n" tail)
(length tail)))
rfc2047-encode-max-chars))
(setq prev next
@@ -1111,7 +1111,7 @@ strings are stripped."
"Decode MIME-encoded STRING and return the result.
If ADDRESS-MIME is non-nil, strip backslashes which precede characters
other than `\"' and `\\' in quoted strings."
- (if (string-match "=\\?" string)
+ (if (string-search "=?" string)
(with-temp-buffer
;; We used to only call mm-enable-multibyte if `m' is non-nil,
;; but this can't be the right criterion. Don't just revert this
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index 6fb4502b23b..a398ce0e9cc 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -61,12 +61,12 @@ must never cause a Lisp error."
;; make it parsable. Let's try...
(error
(let (mod)
- (when (and (string-match "\\\\\"" string)
+ (when (and (string-search "\\\"" string)
(not (string-match "\\`\"\\|[^\\]\"" string)))
- (setq string (replace-regexp-in-string "\\\\\"" "\"" string)
+ (setq string (string-replace "\\\"" "\"" string)
mod t))
- (when (and (string-match "\\\\(" string)
- (string-match "\\\\)" string)
+ (when (and (string-search "\\(" string)
+ (string-search "\\)" string)
(not (string-match "\\`(\\|[^\\][()]" string)))
(setq string (replace-regexp-in-string
"\\\\\\([()]\\)" "\\1" string)
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 553f3cc3a54..b96f15d3e68 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -91,7 +91,7 @@ Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., &amp; -> &), before
calling this function."
(let ((case-fold-search t)
prequery query headers-alist)
- (setq mailto-url (replace-regexp-in-string "\n" " " mailto-url))
+ (setq mailto-url (string-replace "\n" " " mailto-url))
(if (string-match rfc2368-mailto-regexp mailto-url)
(progn
(setq prequery
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index f07fcdfc9f1..2e97226662f 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -1,4 +1,4 @@
-;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc.
+;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc. -*- lexical-binding: t; -*-
;; Copyright (C) 1986-1987, 1990, 2001-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index dda472eb30e..fbac9e0cc0c 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -1,4 +1,4 @@
-;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader
+;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
@@ -82,50 +82,42 @@
(defcustom rmail-use-spam-filter nil
"Non-nil to activate the Rmail spam filter.
Set `rsf-definitions-alist' to define what you consider spam emails."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-file "~/XRMAIL-SPAM"
"Name of Rmail file for optionally saving some of the spam.
You can either just delete spam, or save it in this file for
later review. Which action to take for each spam definition is
specified by the \"action\" element of the definition."
- :type 'string
- :group 'rmail-spam-filter)
+ :type 'string)
(defcustom rsf-no-blind-cc nil
"Non-nil means mail with no explicit To: or Cc: is spam."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-ignore-case nil
"Non-nil means to ignore case in `rsf-definitions-alist'."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-beep nil
"Non-nil means to beep if spam is found."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-sleep-after-message 2.0
"Seconds to wait after displaying a message that spam was found."
- :type 'number
- :group 'rmail-spam-filter)
+ :type 'number)
(defcustom rsf-min-region-to-spam-list 7
"Minimum size of region that you can add to the spam list.
The aim is to avoid adding too short a region, which could result
in false positive identification of a valid message as spam."
- :type 'integer
- :group 'rmail-spam-filter)
+ :type 'integer)
(defcustom rsf-autosave-newly-added-definitions nil
"Non-nil to auto-save new spam entries.
Any time you add an entry via the \"Spam\" menu, immediately saves
the custom file."
- :type 'boolean
- :group 'rmail-spam-filter)
+ :type 'boolean)
(defcustom rsf-white-list nil
"List of regexps to identify valid senders.
@@ -133,8 +125,7 @@ If any element matches the \"From\" header, the message is
flagged as a valid, non-spam message. E.g., if your domain is
\"emacs.com\" then including \"emacs\\\\.com\" in this list would
flag all mail (purporting to be) from your colleagues as valid."
- :type '(repeat regexp)
- :group 'rmail-spam-filter)
+ :type '(repeat regexp))
(defcustom rsf-definitions-alist nil
"A list of rules (definitions) matching spam messages.
@@ -178,8 +169,7 @@ A rule matches only if all the specified elements match."
(choice :tag "Action selection"
(const :tag "Output and delete" output-and-delete)
(const :tag "Delete" delete-spam)
- ))))
- :group 'rmail-spam-filter)
+ )))))
;; FIXME nothing uses this, and it could just be let-bound.
(defvar rsf-scanning-messages-now nil
@@ -224,6 +214,8 @@ the cdr is set to t. Else, the car is set to nil."
;; empty buffer.
(1- (or (rmail-first-unseen-message) 1))))
+(defvar bbdb/mail_auto_create_p)
+
(defun rmail-spam-filter (msg)
"Return nil if message number MSG is spam based on `rsf-definitions-alist'.
If spam, optionally output message to a file `rsf-file' and delete
@@ -522,12 +514,12 @@ to the spam list (remember to save it)" region-to-spam-list))))))
["Customize spam definitions" rsf-customize-spam-definitions]
["Browse spam customizations" rsf-customize-group]
))
- (define-key map "\C-cSt" 'rsf-add-subject-to-spam-list)
- (define-key map "\C-cSr" 'rsf-add-sender-to-spam-list)
- (define-key map "\C-cSn" 'rsf-add-region-to-spam-list)
- (define-key map "\C-cSa" 'rsf-custom-save-all)
- (define-key map "\C-cSd" 'rsf-customize-spam-definitions)
- (define-key map "\C-cSg" 'rsf-customize-group))
+ (define-key map "\C-cSt" #'rsf-add-subject-to-spam-list)
+ (define-key map "\C-cSr" #'rsf-add-sender-to-spam-list)
+ (define-key map "\C-cSn" #'rsf-add-region-to-spam-list)
+ (define-key map "\C-cSa" #'rsf-custom-save-all)
+ (define-key map "\C-cSd" #'rsf-customize-spam-definitions)
+ (define-key map "\C-cSg" #'rsf-customize-group))
(defun rsf-add-content-type-field ()
"Maintain backward compatibility for `rmail-spam-filter'.
@@ -563,4 +555,4 @@ checks to see if the old format is used, and updates it if necessary."
(provide 'rmail-spam-filter)
-;;; rmail-spam-filter ends here
+;;; rmail-spam-filter.el ends here
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 8ccf1bffdd6..8a38337773e 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -551,7 +551,7 @@ Examples:
(defvar rmail-reply-regexp
(concat "\\`\\("
rmail-re-abbrevs
- "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?[::] *\\)*")
+ "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?\u00a0*[::] *\\)*")
"Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
(defcustom rmail-display-summary nil
@@ -1721,7 +1721,7 @@ not be a new one). It returns non-nil if it got any new messages."
(buffer-read-only nil)
;; Don't make undo records while getting mail.
(buffer-undo-list t)
- delete-files files file-last-names)
+ files file-last-names) ;; delete-files
;; Pull files off all-files onto files as long as there is
;; no name conflict. A conflict happens when two inbox
;; file names have the same last component.
@@ -1743,7 +1743,7 @@ not be a new one). It returns non-nil if it got any new messages."
(while (not (looking-back "\n\n" (- (point) 2)))
(insert "\n")))
(setq found (or
- (rmail-get-new-mail-1 file-name files delete-files)
+ (rmail-get-new-mail-1 file-name files nil) ;; delete-files
found))))
;; Move to the first new message unless we have other unseen
;; messages before it.
@@ -1960,7 +1960,7 @@ Value is the size of the newly read mail after conversion."
(file-name-nondirectory
(if (memq system-type '(windows-nt cygwin ms-dos))
;; cannot have colons in file name
- (replace-regexp-in-string ":" "-" file)
+ (string-replace ":" "-" file)
file)))
;; Use the directory of this rmail file
;; because it's a nuisance to use the homedir
@@ -3356,7 +3356,12 @@ whitespace, replacing whitespace runs with a single space and
removing prefixes such as Re:, Fwd: and so on and mailing list
tags such as [tag]."
(let ((subject (or (rmail-get-header "Subject" msgnum) ""))
- (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}[::]\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
+ (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}\u00a0*[::]\\|\\[[^]]+]\\)[ \t\n]+\\)*"))
+ ;; Corporate mailing systems sometimes add `[External] :'; if that happened,
+ ;; delete everything up thru there. Empirically, that deletion makes
+ ;; the Subject match the other messages in the thread.
+ (if (string-match "\\[external][ \t\n]*:" subject)
+ (setq subject (substring subject (match-end 0))))
(setq subject (rfc2047-decode-string subject))
(setq subject (replace-regexp-in-string regexp "" subject))
(replace-regexp-in-string "[ \t\n]+" " " subject)))
@@ -3369,7 +3374,7 @@ The idea is to match it against simplified subjects of other messages."
;; Hide commas so it will work ok if parsed as a comma-separated list
;; of regexps.
(setq subject
- (replace-regexp-in-string "," "\054" subject t t))
+ (string-replace "," "\054" subject))
(concat "\\`" subject "\\'")))
(defun rmail-next-same-subject (n)
@@ -3671,9 +3676,9 @@ If BUFFER is not swapped, yank out of its message viewer buffer."
(push (cons "cc" cc) other-headers)
(push (cons "in-reply-to" in-reply-to) other-headers)
(setq other-headers
- (mapcar #'(lambda (elt)
- (cons (car elt) (if (stringp (cdr elt))
- (rfc2047-decode-string (cdr elt)))))
+ (mapcar (lambda (elt)
+ (cons (car elt) (if (stringp (cdr elt))
+ (rfc2047-decode-string (cdr elt)))))
other-headers))
(if (stringp to) (setq to (rfc2047-decode-string to)))
(if (stringp in-reply-to)
@@ -3762,32 +3767,61 @@ use \\[mail-yank-original] to yank the original message into it."
(rmail-apply-in-message
rmail-current-message
(lambda ()
- (search-forward "\n\n" nil 'move)
- (narrow-to-region (point-min) (point))
- (setq from (mail-fetch-field "from")
- reply-to (or (mail-fetch-field "mail-reply-to" nil t)
- (mail-fetch-field "reply-to" nil t)
- from)
- subject (mail-fetch-field "subject")
- date (mail-fetch-field "date")
- message-id (mail-fetch-field "message-id")
- references (mail-fetch-field "references" nil nil t)
- ;; Bug#512. It's inappropriate to reply to these addresses.
- ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
- ;;resent-cc (and (not just-sender)
- ;; (mail-fetch-field "resent-cc" nil t))
- ;;resent-to (or (mail-fetch-field "resent-to" nil t) "")
- ;;resent-subject (mail-fetch-field "resent-subject")
- ;;resent-date (mail-fetch-field "resent-date")
- ;;resent-message-id (mail-fetch-field "resent-message-id")
- )
- (unless just-sender
- (if (mail-fetch-field "mail-followup-to" nil t)
- ;; If this header field is present, use it instead of the
- ;; To and Cc fields.
- (setq to (mail-fetch-field "mail-followup-to" nil t))
- (setq cc (or (mail-fetch-field "cc" nil t) "")
- to (or (mail-fetch-field "to" nil t) ""))))))
+ (let ((end (point-max))
+ subheader)
+ ;; Find the message's real header.
+ (search-forward "\n\n" nil 'move)
+ (narrow-to-region (point-min) (point))
+
+ (goto-char (point-min))
+
+ ;; If this is an encrypted message, search for other header fields
+ ;; inside the encrypted part, and use them instead of the real header.
+
+ ;; First, find a From: field after a plausible section start.
+ (when (and (search-forward "\nContent-Type: multipart/encrypted;\n" nil t)
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (and (search-forward "\nFrom: " nil t)
+ (setq subheader (point)))))
+ ;; We found one, so widen up to end of message and go there.
+ (narrow-to-region (point-min) end)
+ (goto-char subheader)
+
+ ;; Find the start of the inner header.
+ (search-backward "\n--")
+ (forward-line 2)
+
+ ;; Find the end of it.
+ (let ((subheader-start (point)))
+ (goto-char subheader)
+ (search-forward "\n\n" nil 'move)
+ (narrow-to-region subheader-start (point))))
+
+ (setq from (mail-fetch-field "from")
+ reply-to (or (mail-fetch-field "mail-reply-to" nil t)
+ (mail-fetch-field "reply-to" nil t)
+ from)
+ subject (mail-fetch-field "subject")
+ date (mail-fetch-field "date")
+ message-id (mail-fetch-field "message-id")
+ references (mail-fetch-field "references" nil nil t)
+ ;; Bug#512. It's inappropriate to reply to these addresses.
+ ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
+ ;;resent-cc (and (not just-sender)
+ ;; (mail-fetch-field "resent-cc" nil t))
+ ;;resent-to (or (mail-fetch-field "resent-to" nil t) "")
+ ;;resent-subject (mail-fetch-field "resent-subject")
+ ;;resent-date (mail-fetch-field "resent-date")
+ ;;resent-message-id (mail-fetch-field "resent-message-id")
+ )
+ (unless just-sender
+ (if (mail-fetch-field "mail-followup-to" nil t)
+ ;; If this header field is present, use it instead of the
+ ;; To and Cc fields.
+ (setq to (mail-fetch-field "mail-followup-to" nil t))
+ (setq cc (or (mail-fetch-field "cc" nil t) "")
+ to (or (mail-fetch-field "to" nil t) "")))))))
;; Merge the resent-to and resent-cc into the to and cc.
;; Bug#512. It's inappropriate to reply to these addresses.
;;(if (and resent-to (not (equal resent-to "")))
@@ -4585,8 +4619,9 @@ Argument MIME is non-nil if this is a mime message."
;; change it in one of the calls to `epa-decrypt-region'.
(save-excursion
- (let (decrypts (mime (rmail-mime-message-p))
- mime-disabled)
+ (let (decrypts
+ (mime (and (eq major-mode 'rmail-mode) (rmail-mime-message-p)))
+ mime-disabled)
(goto-char (point-min))
;; Turn off mime processing.
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index c3b351d7bc8..fd24bdceccc 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -1,4 +1,4 @@
-;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
+;;; rmailedit.el --- "RMAIL edit mode" Edit the current message -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc.
@@ -38,8 +38,8 @@
(let ((map (make-sparse-keymap)))
;; Make a keymap that inherits text-mode-map.
(set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" 'rmail-cease-edit)
- (define-key map "\C-c\C-]" 'rmail-abort-edit)
+ (define-key map "\C-c\C-c" #'rmail-cease-edit)
+ (define-key map "\C-c\C-]" #'rmail-abort-edit)
map))
(declare-function rmail-summary-disable "rmailsum" ())
@@ -69,7 +69,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(setq-local auto-save-include-big-deletions t)
;; If someone uses C-x C-s, don't clobber the rmail file (bug#2625).
(add-hook 'write-region-annotate-functions
- 'rmail-write-region-annotate nil t)
+ #'rmail-write-region-annotate nil t)
(run-mode-hooks 'rmail-edit-mode-hook)))
;; Rmail Edit mode is suitable only for specially formatted data.
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index 657b3629bd1..58a8eb7a370 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -1,4 +1,4 @@
-;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
+;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1988, 1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -73,7 +73,7 @@ according to the choice made, and returns a symbol."
(or (eq major-mode 'rmail-summary-mode)
(rmail-summary-exists)
(and (setq old (rmail-get-keywords))
- (mapc 'rmail-make-label (split-string old ", "))))
+ (mapc #'rmail-make-label (split-string old ", "))))
(completing-read (concat prompt
(if rmail-last-label
(concat " (default "
@@ -93,7 +93,7 @@ according to the choice made, and returns a symbol."
"Set LABEL as present or absent according to STATE in message MSG.
LABEL may be a symbol or string."
(or (stringp label) (setq label (symbol-name label)))
- (if (string-match "," label)
+ (if (string-search "," label)
(error "More than one label specified"))
(with-current-buffer rmail-buffer
(rmail-maybe-set-message-counters)
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index ab5b49aab92..99bff66657b 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1,4 +1,4 @@
-;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
+;;; rmailmm.el --- MIME decoding and display stuff for RMAIL -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -78,6 +78,7 @@
(require 'rmail)
(require 'mail-parse)
(require 'message)
+(require 'cl-lib)
;;; User options.
@@ -101,8 +102,7 @@ all others are handled by `rmail-mime-bulk-handler'.
Note also that this alist is ignored when the variable
`rmail-enable-mime' is non-nil."
:type '(alist :key-type regexp :value-type (repeat function))
- :version "23.1"
- :group 'rmail-mime)
+ :version "23.1")
(defcustom rmail-mime-attachment-dirs-alist
`(("text/.*" "~/Documents")
@@ -114,8 +114,7 @@ The first item is a regular expression matching a content-type.
The remaining elements are directories, in order of decreasing preference.
The first directory that exists is used."
:type '(alist :key-type regexp :value-type (repeat directory))
- :version "23.1"
- :group 'rmail-mime)
+ :version "23.1")
(defcustom rmail-mime-show-images 'button
"What to do with image attachments that Emacs is capable of displaying.
@@ -128,12 +127,11 @@ automatically display the image in the buffer."
(const :tag "No special treatment" nil)
(number :tag "Show if smaller than certain size")
(other :tag "Always show" show))
- :version "23.2"
- :group 'rmail-mime)
+ :version "23.2")
(defcustom rmail-mime-render-html-function
- (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr)
- ((executable-find "lynx") 'rmail-mime-render-html-lynx)
+ (cond ((fboundp 'libxml-parse-html-region) #'rmail-mime-render-html-shr)
+ ((executable-find "lynx") #'rmail-mime-render-html-lynx)
(t nil))
"Function to convert HTML to text.
Called with buffer containing HTML extracted from message in a
@@ -177,9 +175,12 @@ operations such as HTML decoding")
;;; MIME-entity object
-(defun rmail-mime-entity (type disposition transfer-encoding
- display header tagline body children handler
- &optional truncated)
+(cl-defstruct (rmail-mime-entity
+ (:copier nil) (:constructor nil)
+ (:constructor rmail-mime-entity
+ ( type disposition transfer-encoding
+ display header tagline body children handler
+ &optional truncated)
"Return a newly created MIME-entity object from arguments.
A MIME-entity is a vector of 10 elements:
@@ -210,12 +211,7 @@ Content-Transfer-Encoding, and is a lower-case string.
DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
the header, tag line, and body of the entity are displayed now,
and NEW indicates how their display should be updated.
-Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
-where each constituent element is a symbol for the corresponding
-item with these values:
- nil: not displayed
- t: displayed by the decoded presentation form
- raw: displayed by the raw MIME data (for the header and body only)
+Both elements are `rmail-mime-display' objects.
HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
END are markers that specify the region of the header or body lines
@@ -236,24 +232,13 @@ has just one child. Any other entity has no child.
HANDLER is a function to insert the entity according to DISPLAY.
It is called with one argument ENTITY.
-TRUNCATED is non-nil if the text of this entity was truncated."
-
- (vector type disposition transfer-encoding
- display header tagline body children handler truncated))
-
-;; Accessors for a MIME-entity object.
-(defsubst rmail-mime-entity-type (entity) (aref entity 0))
-(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
-(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
-(defsubst rmail-mime-entity-display (entity) (aref entity 3))
-(defsubst rmail-mime-entity-header (entity) (aref entity 4))
-(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
-(defsubst rmail-mime-entity-body (entity) (aref entity 6))
-(defsubst rmail-mime-entity-children (entity) (aref entity 7))
-(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
-(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
+TRUNCATED is non-nil if the text of this entity was truncated."))
+ type disposition transfer-encoding
+ display header tagline body children handler truncated)
+
(defsubst rmail-mime-entity-set-truncated (entity truncated)
- (aset entity 9 truncated))
+ (declare (obsolete (setf rmail-mime-entity-truncated) "28.1"))
+ (setf (rmail-mime-entity-truncated entity) truncated))
;;; Buttons
@@ -303,9 +288,16 @@ TRUNCATED is non-nil if the text of this entity was truncated."
;; Display options returned by rmail-mime-entity-display.
;; Value is on of nil, t, raw.
-(defsubst rmail-mime-display-header (disp) (aref disp 0))
-(defsubst rmail-mime-display-tagline (disp) (aref disp 1))
-(defsubst rmail-mime-display-body (disp) (aref disp 2))
+(cl-defstruct (rmail-mime-display
+ (:copier rmail-mime--copy-display) (:constructor nil)
+ (:constructor rmail-mime--make-display (header tagline body)
+ "Make an object describing how to display.
+Each field's value is a symbol for the corresponding
+item with these values:
+ nil: not displayed
+ t: displayed by the decoded presentation form
+ raw: displayed by the raw MIME data (for the header and body only)."))
+ header tagline body)
(defun rmail-mime-entity-segment (pos &optional entity)
"Return a vector describing the displayed region of a MIME-entity at POS.
@@ -371,27 +363,30 @@ The value is a vector [INDEX HEADER TAGLINE BODY END], where
(defun rmail-mime-shown-mode (entity)
"Make MIME-entity ENTITY display in the default way."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 (aref (rmail-mime-entity-header entity) 2))
- (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
- (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
+ (setf (rmail-mime-display-header new)
+ (aref (rmail-mime-entity-header entity) 2))
+ (setf (rmail-mime-display-tagline new)
+ (aref (rmail-mime-entity-tagline entity) 2))
+ (setf (rmail-mime-display-body new)
+ (aref (rmail-mime-entity-body entity) 2)))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-shown-mode child)))
(defun rmail-mime-hidden-mode (entity)
"Make MIME-entity ENTITY display in hidden mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 nil)
- (aset new 1 t)
- (aset new 2 nil))
+ (setf (rmail-mime-display-header new) nil)
+ (setf (rmail-mime-display-tagline new) t)
+ (setf (rmail-mime-display-body new) nil))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-hidden-mode child)))
(defun rmail-mime-raw-mode (entity)
"Make MIME-entity ENTITY display in raw mode."
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 'raw)
- (aset new 1 nil)
- (aset new 2 'raw))
+ (setf (rmail-mime-display-header new) 'raw)
+ (setf (rmail-mime-display-tagline new) nil)
+ (setf (rmail-mime-display-body new) 'raw))
(dolist (child (rmail-mime-entity-children entity))
(rmail-mime-raw-mode child)))
@@ -404,8 +399,8 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode."
(current (aref (rmail-mime-entity-display entity) 0))
(segment (rmail-mime-entity-segment pos entity)))
(if (or (eq state 'raw)
- (and (not state)
- (not (eq (rmail-mime-display-header current) 'raw))))
+ (not (or state
+ (eq (rmail-mime-display-header current) 'raw))))
;; Enter the raw mode.
(rmail-mime-raw-mode entity)
;; Enter the shown mode.
@@ -439,7 +434,7 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode."
;; header.
(if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
(let ((new (aref (rmail-mime-entity-display entity) 1)))
- (aset new 0 t))))
+ (setf (rmail-mime-display-header new) t))))
;; Query as a warning before showing if truncated.
(if (and (not (stringp entity))
(rmail-mime-entity-truncated entity))
@@ -448,7 +443,8 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode."
;; Enter the shown mode.
(rmail-mime-shown-mode entity)
;; Force this body shown.
- (aset (aref (rmail-mime-entity-display entity) 1) 2 t))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (setf (rmail-mime-display-body new) t)))
(let ((inhibit-read-only t)
(modified (buffer-modified-p))
(rmail-mime-mbox-buffer rmail-view-buffer)
@@ -458,9 +454,9 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode."
(rmail-mime-insert entity)
(restore-buffer-modified-p modified))))))
-(define-key rmail-mode-map "\t" 'forward-button)
-(define-key rmail-mode-map [backtab] 'backward-button)
-(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
+(define-key rmail-mode-map "\t" #'forward-button)
+(define-key rmail-mode-map [backtab] #'backward-button)
+(define-key rmail-mode-map "\r" #'rmail-mime-toggle-hidden)
;;; Handlers
@@ -483,7 +479,7 @@ to the tag line."
(when item
(if (stringp item)
(insert item)
- (apply 'insert-button item))))
+ (apply #'insert-button item))))
;; Follow the tagline by an empty line to make it a separate
;; paragraph, so that the paragraph direction of the following text
;; is determined based on that text.
@@ -495,8 +491,10 @@ to the tag line."
(modified (buffer-modified-p))
;; If we are going to show the body, the new button label is
;; "Hide". Otherwise, it's "Show".
- (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
- "Show"))
+ (label
+ (if (rmail-mime-display-body
+ (aref (rmail-mime-entity-display entity) 1))
+ "Hide" "Show"))
(button (next-button (point))))
;; Go to the second character of the button "Show" or "Hide".
(goto-char (1+ (button-start button)))
@@ -556,9 +554,10 @@ HEADER is a header component of a MIME-entity object (see
(rmail-mime-insert-text
(rmail-mime-entity content-type content-disposition
content-transfer-encoding
- (vector (vector nil nil nil) (vector nil nil t))
+ (vector (rmail-mime--make-display nil nil nil)
+ (rmail-mime--make-display nil nil t))
(vector nil nil nil) (vector "" (cons nil nil) t)
- (vector nil nil nil) nil 'rmail-mime-insert-text))
+ (vector nil nil nil) nil #'rmail-mime-insert-text))
t)
(defun rmail-mime-insert-decoded-text (entity)
@@ -592,7 +591,7 @@ HEADER is a header component of a MIME-entity object (see
(let ((current (aref (rmail-mime-entity-display entity) 0))
(new (aref (rmail-mime-entity-display entity) 1))
(header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
(body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
@@ -634,7 +633,7 @@ HEADER is a header component of a MIME-entity object (see
(defun rmail-mime-insert-image (entity)
"Decode and insert the image body of MIME-entity ENTITY."
- (let* ((content-type (car (rmail-mime-entity-type entity)))
+ (let* (;; (content-type (car (rmail-mime-entity-type entity)))
(bulk-data (aref (rmail-mime-entity-tagline entity) 1))
(body (rmail-mime-entity-body entity))
data)
@@ -709,6 +708,9 @@ HEADER is a header component of a MIME-entity object (see
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
+(defvar shr-inhibit-images)
+(defvar shr-width)
+
(defun rmail-mime-render-html-shr (source-buffer)
(let ((dom (with-current-buffer source-buffer
(libxml-parse-html-region (point-min) (point-max))))
@@ -759,7 +761,8 @@ For images that Emacs is capable of displaying, the behavior
depends upon the value of `rmail-mime-show-images'."
(rmail-mime-insert-bulk
(rmail-mime-entity content-type content-disposition content-transfer-encoding
- (vector (vector nil nil nil) (vector nil t nil))
+ (vector (rmail-mime--make-display nil nil nil)
+ (rmail-mime--make-display nil t nil))
(vector nil nil nil) (vector "" (cons nil nil) t)
(vector nil nil nil) nil 'rmail-mime-insert-bulk)))
@@ -781,9 +784,11 @@ directly."
(let ((encoding (rmail-mime-entity-transfer-encoding entity)))
(setq size (- (aref body 1) (aref body 0)))
(cond ((string= encoding "base64")
- (setq size (/ (* size 3) 4)))
+ ;; https://en.wikipedia.org/wiki/Base64#MIME
+ (setq size (* size 0.73)))
((string= encoding "quoted-printable")
- (setq size (/ (* size 7) 3)))))))
+ ;; Assume most of the text is ASCII...
+ (setq size (/ (* size 5) 7)))))))
(cond
((string-match "text/html" content-type)
@@ -1024,9 +1029,10 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
nil (format "%s/%d" parse-tag index)
content-type content-disposition)))
;; Display a tagline.
- (aset (aref (rmail-mime-entity-display child) 1) 1
+ (setf (rmail-mime-display-tagline
+ (aref (rmail-mime-entity-display child) 1))
(aset (rmail-mime-entity-tagline child) 2 t))
- (rmail-mime-entity-set-truncated child truncated)
+ (setf (rmail-mime-entity-truncated child) truncated)
(push child entities)))
(delete-region end next)
@@ -1072,8 +1078,8 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
(let ((current (aref (rmail-mime-entity-display entity) 0))
(new (aref (rmail-mime-entity-display entity) 1))
(header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
- (body (rmail-mime-entity-body entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
+ ;; (body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
;; header
@@ -1169,13 +1175,11 @@ The parsed header value:
content-transfer-encoding))
(save-restriction
(widen)
- (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
- current new)
+ (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity)))
(when entity
- (setq current (aref (rmail-mime-entity-display entity) 0)
- new (aref (rmail-mime-entity-display entity) 1))
- (dotimes (i 3)
- (aset current i (aref new i)))))))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (setf (aref (rmail-mime-entity-display entity) 0)
+ (rmail-mime--copy-display new)))))))
(defun rmail-mime-show (&optional show-headers)
"Handle the current buffer as a MIME message.
@@ -1240,13 +1244,15 @@ modified."
(header (vector (point-min-marker) hdr-end nil))
(tagline (vector parse-tag (cons nil nil) t))
(body (vector hdr-end (point-max-marker) is-inline))
- (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
+ (new (rmail-mime--make-display
+ (aref header 2) (aref tagline 2) (aref body 2)))
children handler entity)
(cond ((string-match "multipart/.*" (car content-type))
(save-restriction
(narrow-to-region (1- end) (point-max))
(if (zerop (length parse-tag)) ; top level of message
- (aset new 1 (aset tagline 2 nil))) ; don't show tagline
+ (setf (rmail-mime-display-tagline new)
+ (aset tagline 2 nil))) ; don't show tagline
(setq children (rmail-mime-process-multipart
content-type
content-disposition
@@ -1260,37 +1266,38 @@ modified."
'("text/plain") '("inline")))
(msg-new (aref (rmail-mime-entity-display msg) 1)))
;; Show header of the child.
- (aset msg-new 0 t)
+ (setf (rmail-mime-display-header msg-new) t)
(aset (rmail-mime-entity-header msg) 2 t)
;; Hide tagline of the child.
- (aset msg-new 1 nil)
+ (setf (rmail-mime-display-tagline msg-new) nil)
(aset (rmail-mime-entity-tagline msg) 2 nil)
(setq children (list msg)
handler 'rmail-mime-insert-multipart))))
((and is-inline (string-match "text/html" (car content-type)))
;; Display tagline, so part can be detached
- (aset new 1 (aset tagline 2 t))
- (aset new 2 (aset body 2 t)) ; display body also.
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
+ (setf (rmail-mime-display-body new) (aset body 2 t)) ; display body also.
(setq handler 'rmail-mime-insert-bulk))
;; Inline non-HTML text
((and is-inline (string-match "text/" (car content-type)))
;; Don't need a tagline.
- (aset new 1 (aset tagline 2 nil))
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 nil))
(setq handler 'rmail-mime-insert-text))
(t
;; Force hidden mode.
- (aset new 1 (aset tagline 2 t))
- (aset new 2 (aset body 2 nil))
+ (setf (rmail-mime-display-tagline new) (aset tagline 2 t))
+ (setf (rmail-mime-display-body new) (aset body 2 nil))
(setq handler 'rmail-mime-insert-bulk)))
- (setq entity (rmail-mime-entity content-type
- content-disposition
- content-transfer-encoding
- (vector (vector nil nil nil) new)
- header tagline body children handler))
+ (setq entity (rmail-mime-entity
+ content-type
+ content-disposition
+ content-transfer-encoding
+ (vector (rmail-mime--make-display nil nil nil) new)
+ header tagline body children handler))
(if (and (eq handler 'rmail-mime-insert-bulk)
(rmail-mime-set-bulk-data entity))
;; Show the body.
- (aset new 2 (aset body 2 t)))
+ (setf (rmail-mime-display-body new) (aset body 2 t)))
entity)
;; Hide headers and handle the part.
@@ -1324,7 +1331,8 @@ If an error occurs, return an error message string."
'("text/plain") '("inline")))
(new (aref (rmail-mime-entity-display entity) 1)))
;; Show header.
- (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
+ (setf (rmail-mime-display-header new)
+ (aset (rmail-mime-entity-header entity) 2 t))
entity)))
(error (format "%s" err)))))
@@ -1339,7 +1347,7 @@ available."
;; Not a raw-mode. Each handler should handle it.
(funcall (rmail-mime-entity-handler entity) entity)
(let ((header (rmail-mime-entity-header entity))
- (tagline (rmail-mime-entity-tagline entity))
+ ;; (tagline (rmail-mime-entity-tagline entity))
(body (rmail-mime-entity-body entity))
(beg (point))
(segment (rmail-mime-entity-segment (point) entity)))
@@ -1370,15 +1378,15 @@ available."
(aref body 0) (aref body 1))
(or (bolp) (insert "\n")))
(put-text-property beg (point) 'rmail-mime-entity entity)))))
- (dotimes (i 3)
- (aset current i (aref new i)))))
+ (setf (aref (rmail-mime-entity-display entity) 0)
+ (rmail-mime--copy-display new))))
(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
"Major mode used in `rmail-mime' buffers."
(setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
;;;###autoload
-(defun rmail-mime (&optional arg state)
+(defun rmail-mime (&optional _arg state)
"Toggle the display of a MIME message.
The actual behavior depends on the value of `rmail-enable-mime'.
@@ -1396,7 +1404,7 @@ are handled according to `rmail-mime-media-type-handlers-alist'.
By default, this displays text and multipart messages, and offers to
download attachments as specified by `rmail-mime-attachment-dirs-alist'.
The arguments ARG and STATE have no effect in this case."
- (interactive (list current-prefix-arg nil))
+ (interactive)
(if rmail-enable-mime
(with-current-buffer rmail-buffer
(if (or (rmail-mime-message-p)
@@ -1442,7 +1450,7 @@ The arguments ARG and STATE have no effect in this case."
(rmail-mime-view-buffer rmail-view-buffer)
(rmail-mime-coding-system nil))
;; If ENTITY is not a vector, it is a string describing an error.
- (if (vectorp entity)
+ (if (rmail-mime-entity-p entity)
(with-current-buffer rmail-mime-view-buffer
(erase-buffer)
;; This condition-case is for catching an error in the
@@ -1530,7 +1538,7 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'."
(rmail-mime-view-buffer rmail-view-buffer)
(header-end (save-excursion
(re-search-forward "^$" nil 'move) (point)))
- (body-end (point-max))
+ ;; (body-end (point-max))
(entity (rmail-mime-parse)))
(or
;; At first, just search the headers.
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index ef5f3c31bbc..673b2c5a7e5 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -1,4 +1,4 @@
-;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
+;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
@@ -45,7 +45,7 @@ This applies only to the current session."
(nreverse (mail-parse-comma-list)))))
(when (or (not rmail-inbox-list)
(y-or-n-p (concat "Replace "
- (mapconcat 'identity
+ (mapconcat #'identity
rmail-inbox-list
", ")
"? ")))
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 9305a48b8d8..4c23686909c 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,4 +1,4 @@
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
+;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1987, 1993-1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -81,14 +81,14 @@ This uses `rmail-output-file-alist'."
(widen)
(narrow-to-region beg end)
(let ((tail rmail-output-file-alist)
- answer err)
+ answer) ;; err
;; Suggest a file based on a pattern match.
(while (and tail (not answer))
(goto-char (point-min))
(if (re-search-forward (caar tail) nil t)
(setq answer
(condition-case err
- (eval (cdar tail))
+ (eval (cdar tail) t)
(error
(display-warning
'rmail-output
@@ -197,7 +197,8 @@ display message number MSG."
(defun rmail-convert-to-babyl-format ()
"Convert the mbox message in the current buffer to Babyl format."
- (let ((count 0) (start (point-min))
+ (let (;; (count 0)
+ (start (point-min))
(case-fold-search nil)
(buffer-undo-list t))
(goto-char (point-min))
@@ -357,7 +358,7 @@ unless NOMSG is a symbol (neither nil nor t).
AS-SEEN is non-nil if we are copying the message \"as seen\"."
(let ((case-fold-search t)
encrypted-file-name
- from date)
+ ) ;; from date
(goto-char (point-min))
;; Preserve the Mail-From and MIME-Version fields
;; even if they have been pruned.
@@ -677,9 +678,9 @@ than appending to it. Deletes the message after writing if
(or (mail-fetch-field "Subject")
rmail-default-body-file)))
(setq default-file
- (replace-regexp-in-string ":" "-" default-file))
+ (string-replace ":" "-" default-file))
(setq default-file
- (replace-regexp-in-string " " "-" default-file))
+ (string-replace " " "-" default-file))
(list (setq rmail-default-body-file
(read-file-name
"Output message body to file: "
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index 2c42e6c8598..1669c8cd7bb 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -1,4 +1,4 @@
-;;; rmailsort.el --- Rmail: sort messages
+;;; rmailsort.el --- Rmail: sort messages -*- lexical-binding: t; -*-
;; Copyright (C) 1990, 1993-1994, 2001-2021 Free Software Foundation,
;; Inc.
@@ -142,7 +142,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order."
"\\(,\\|\\'\\)")
labelvec))
(setq labels (substring labels (match-end 0))))
- (setq labelvec (apply 'vector (nreverse labelvec))
+ (setq labelvec (apply #'vector (nreverse labelvec))
nmax (length labelvec))
(rmail-sort-messages reverse
;; If no labels match, returns nmax; if they
@@ -205,7 +205,7 @@ Numeric keys are sorted numerically, all others as strings."
(inhibit-read-only t)
(current-message nil)
(msgnum 1)
- (msginfo nil)
+ ;; (msginfo nil)
(undo (not (eq buffer-undo-list t))))
;; There's little hope that we can easily undo after that.
(buffer-disable-undo (current-buffer))
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index f53e6e768f8..9dd9573a9fc 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -755,7 +755,12 @@ the message being processed."
(forward-char -1)
(skip-chars-backward " \t")
(point))))))
- len mch lo)
+ len mch lo newline)
+ ;; If there are multiple lines in FROM,
+ ;; discard up to the last newline in it.
+ (while (and (stringp from)
+ (setq newline (string-search "\n" from)))
+ (setq from (substring from (1+ newline))))
(if (or (null from)
(string-match
(or rmail-user-mail-address-regexp
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index cd071667562..fee11c06aa7 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -30,6 +30,7 @@
(require 'mail-utils)
(require 'rfc2047)
(autoload 'message-make-date "message")
+(autoload 'message-narrow-to-headers "message")
(defgroup sendmail nil
"Mail sending commands for Emacs."
@@ -725,14 +726,21 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
;; Lines containing just >= 3 dashes, perhaps after whitespace,
;; are also sometimes used and should be separators.
(setq paragraph-separate
- (concat (regexp-quote mail-header-separator)
+ (if (zerop (length mail-header-separator))
+ (concat
;; This is based on adaptive-fill-regexp (presumably
;; the idea is to allow navigation etc of cited paragraphs).
- "$\\|\t*[-–!|#%;>*·•‣⁃◦ ]+$"
+ "\t*[-–!|#%;>*·•‣⁃◦ ]+$"
"\\|[ \t]*[-[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
"--\\( \\|-+\\)$\\|"
- page-delimiter)))
-
+ page-delimiter)
+ (concat (regexp-quote mail-header-separator)
+ ;; This is based on adaptive-fill-regexp (presumably
+ ;; the idea is to allow navigation etc of cited paragraphs).
+ "$\\|\t*[-–!|#%;>*·•‣⁃◦ ]+$"
+ "\\|[ \t]*[-[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
+ "--\\( \\|-+\\)$\\|"
+ page-delimiter))))
(defun mail-header-end ()
"Return the buffer location of the end of headers, as a number."
@@ -762,10 +770,11 @@ Concretely: replace the first blank line in the header with the separator."
"Remove header separator to put the message in correct form for sendmail.
Leave point at the start of the delimiter line."
(goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n")
- nil t)
- (replace-match "\n"))
+ (unless (zerop (length mail-header-separator))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n")
+ nil t)
+ (replace-match "\n")))
(rfc822-goto-eoh))
(defun mail-mode-auto-fill ()
@@ -887,8 +896,9 @@ the user from the mailer."
(concat "\\(?:[[:space:];,]\\|\\`\\)"
(regexp-opt mail-mailing-lists t)
"\\(?:[[:space:];,]\\|\\'\\)"))))
- (mail-combine-fields "To")
- (mail-combine-fields "Cc")
+ (unless noninteractive
+ (mail-combine-fields "To")
+ (mail-combine-fields "Cc"))
;; If there are mailing lists defined
(when ml
(save-excursion
@@ -930,7 +940,9 @@ the user from the mailer."
(error "Message contains non-ASCII characters"))))
;; Complain about any invalid line.
(goto-char (point-min))
- (re-search-forward (regexp-quote mail-header-separator) (point-max) t)
+ ;; Search for mail-header-eeparator as whole line.
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")
+ (point-max) t)
(let ((header-end (or (match-beginning 0) (point-max))))
(goto-char (point-min))
(while (< (point) header-end)
@@ -961,7 +973,10 @@ the user from the mailer."
(defun mail-envelope-from ()
"Return the envelope mail address to use when sending mail.
-This function uses `mail-envelope-from'."
+This function uses the `mail-envelope-from' variable.
+
+The buffer should be narrowed to the headers of the mail message
+before this function is called."
(if (eq mail-envelope-from 'header)
(nth 1 (mail-extract-address-components
(mail-fetch-field "From")))
@@ -1177,7 +1192,12 @@ external program defined by `sendmail-program'."
;; local binding in the mail buffer will take effect.
(envelope-from
(and mail-specify-envelope-from
- (or (mail-envelope-from) user-mail-address))))
+ (or (save-restriction
+ ;; Only look at the headers when fetching the
+ ;; envelope address.
+ (message-narrow-to-headers)
+ (mail-envelope-from))
+ user-mail-address))))
(unwind-protect
(with-current-buffer tembuf
(erase-buffer)
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 5526f2fbe64..ec9f340db86 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -135,8 +135,9 @@ Used for the value of `sendmail-coding-system' when
(defcustom smtpmail-queue-mail nil
"Non-nil means mail is queued; otherwise it is sent immediately.
-If queued, it is stored in the directory `smtpmail-queue-dir'
-and sent with `smtpmail-send-queued-mail'."
+If queued, it is stored in the directory `smtpmail-queue-dir' and
+sent with `smtpmail-send-queued-mail'. Also see
+`smtpmail-store-queue-variables'."
:type 'boolean)
(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
@@ -173,10 +174,21 @@ mean \"try again\"."
:type 'integer
:version "27.1")
+(defcustom smtpmail-store-queue-variables nil
+ "If non-nil, store SMTP variables when queueing mail.
+These will then be used when sending the queue."
+ :type 'boolean
+ :version "28.1")
+
;;; Variables
(defvar smtpmail-address-buffer)
-(defvar smtpmail-recipient-address-list)
+(defvar smtpmail-recipient-address-list nil)
+(defvar smtpmail--stored-queue-variables
+ '(smtpmail-smtp-server
+ smtpmail-stream-type
+ smtpmail-smtp-service
+ smtpmail-smtp-user))
(defvar smtpmail-queue-counter 0)
@@ -186,7 +198,7 @@ mean \"try again\"."
(defvar smtpmail-auth-supported '(cram-md5 plain login)
"List of supported SMTP AUTH mechanisms.
The list is in preference order.
-Every element should have a matching `cl-defmethod' for
+Every element should have a matching `cl-defmethod'
for `smtpmail-try-auth-method'.")
(defvar smtpmail-mail-address nil
@@ -207,11 +219,15 @@ for `smtpmail-try-auth-method'.")
;; Examine this variable now, so that
;; local binding in the mail buffer will take effect.
(smtpmail-mail-address
- (or (and mail-specify-envelope-from (mail-envelope-from))
- (let ((from (mail-fetch-field "from")))
- (and from
- (cadr (mail-extract-address-components from))))
- (smtpmail-user-mail-address)))
+ (save-restriction
+ ;; Only look at the headers when fetching the
+ ;; envelope address.
+ (message-narrow-to-headers)
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ (let ((from (mail-fetch-field "from")))
+ (and from
+ (cadr (mail-extract-address-components from))))
+ (smtpmail-user-mail-address))))
(smtpmail-code-conv-from
(if enable-multibyte-characters
(let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -326,7 +342,7 @@ for `smtpmail-try-auth-method'.")
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line)
+ (if (eval mail-mailer-swallows-blank-line t)
(newline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
@@ -383,11 +399,17 @@ for `smtpmail-try-auth-method'.")
nil t)
(insert-buffer-substring tembuf)
(write-file file-data)
- (write-region
- (concat "(setq smtpmail-recipient-address-list '"
- (prin1-to-string smtpmail-recipient-address-list)
- ")\n")
- nil file-elisp nil 'silent)
+ (let ((coding-system-for-write 'utf-8))
+ (with-temp-buffer
+ (insert "(setq ")
+ (dolist (var (cons 'smtpmail-recipient-address-list
+ ;; Perhaps store the server etc.
+ (and smtpmail-store-queue-variables
+ smtpmail--stored-queue-variables)))
+ (insert (format " %s %S\n" var (symbol-value var))))
+ (insert ")\n")
+ (write-region (point-min) (point-max) file-elisp
+ nil 'silent)))
(write-region (concat file-data "\n") nil
(expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir)
@@ -407,26 +429,30 @@ for `smtpmail-try-auth-method'.")
(let (file-data file-elisp
(qfile (expand-file-name smtpmail-queue-index-file
smtpmail-queue-dir))
+ (stored (cons 'smtpmail-recipient-address-list
+ smtpmail--stored-queue-variables))
+ smtpmail-recipient-address-list
+ (smtpmail-smtp-server smtpmail-smtp-server)
+ (smtpmail-stream-type smtpmail-stream-type)
+ (smtpmail-smtp-service smtpmail-smtp-service)
+ (smtpmail-smtp-user smtpmail-smtp-user)
result)
(insert-file-contents qfile)
(goto-char (point-min))
(while (not (eobp))
(setq file-data (buffer-substring (point) (line-end-position)))
(setq file-elisp (concat file-data ".el"))
- ;; FIXME: Avoid `load' which can execute arbitrary code and is hence
- ;; a source of security holes. Better read the file and extract the
- ;; data "by hand".
- ;;(load file-elisp)
- (with-temp-buffer
- (insert-file-contents file-elisp)
- (goto-char (point-min))
- (pcase (read (current-buffer))
- (`(setq smtpmail-recipient-address-list ',v)
- (skip-chars-forward " \n\t")
- (unless (eobp) (message "Ignoring trailing text in %S"
- file-elisp))
- (setq smtpmail-recipient-address-list v))
- (sexp (error "Unexpected code in %S: %S" file-elisp sexp))))
+ (let ((coding-system-for-read 'utf-8))
+ (with-temp-buffer
+ (insert-file-contents file-elisp)
+ (let ((form (read (current-buffer))))
+ (when (or (not (consp form))
+ (not (eq (car form) 'setq))
+ (not (consp (cdr form))))
+ (error "Unexpected code in %S: %S" file-elisp form))
+ (cl-loop for (var val) on (cdr form) by #'cddr
+ when (memq var stored)
+ do (set var val)))))
;; Insert the message literally: it is already encoded as per
;; the MIME headers, and code conversions might guess the
;; encoding wrongly.
@@ -434,15 +460,20 @@ for `smtpmail-try-auth-method'.")
(let ((coding-system-for-read 'no-conversion))
(insert-file-contents file-data))
(let ((smtpmail-mail-address
- (or (and mail-specify-envelope-from (mail-envelope-from))
+ (or (and mail-specify-envelope-from
+ (save-restriction
+ ;; Only look at the headers when fetching the
+ ;; envelope address.
+ (message-narrow-to-headers)
+ (mail-envelope-from)))
user-mail-address)))
- (if (not (null smtpmail-recipient-address-list))
- (when (setq result (smtpmail-via-smtp
- smtpmail-recipient-address-list
- (current-buffer)))
- (error "Sending failed: %s"
- (smtpmail--sanitize-error-message result)))
- (error "Sending failed; no recipients"))))
+ (if (not smtpmail-recipient-address-list)
+ (error "Sending failed; no recipients")
+ (when (setq result (smtpmail-via-smtp
+ smtpmail-recipient-address-list
+ (current-buffer)))
+ (error "Sending failed: %s"
+ (smtpmail--sanitize-error-message result))))))
(delete-file file-data)
(delete-file file-elisp)
(delete-region (point-at-bol) (point-at-bol 2)))
@@ -485,17 +516,10 @@ for `smtpmail-try-auth-method'.")
(defun smtpmail-maybe-append-domain (recipient)
(if (or (not smtpmail-sendto-domain)
- (string-match "@" recipient))
+ (string-search "@" recipient))
recipient
(concat recipient "@" smtpmail-sendto-domain)))
-(defun smtpmail-intersection (list1 list2)
- (let ((result nil))
- (dolist (el2 list2)
- (when (memq el2 list1)
- (push el2 result)))
- (nreverse result)))
-
(defun smtpmail-command-or-throw (process string &optional code)
(let (ret)
(smtpmail-send-command process string)
@@ -512,9 +536,10 @@ for `smtpmail-try-auth-method'.")
(if port
(format "%s" port)
"smtp"))
- (let* ((mechs (smtpmail-intersection
+ (let* ((mechs (seq-intersection
+ smtpmail-auth-supported
(cdr-safe (assoc 'auth supported-extensions))
- smtpmail-auth-supported))
+ #'eq))
(auth-source-creation-prompts
'((user . "SMTP user name for %h: ")
(secret . "SMTP password for %u@%h: ")))
@@ -571,7 +596,7 @@ USER and PASSWORD should be non-nil."
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -593,13 +618,13 @@ USER and PASSWORD should be non-nil."
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
@@ -611,6 +636,14 @@ USER and PASSWORD should be non-nil."
(base64-encode-string (concat "\0" user "\0" password) t))
235))
+(cl-defmethod smtpmail-try-auth-method
+ (process (_mech (eql xoauth2)) user password)
+ (smtpmail-command-or-throw
+ process
+ (concat "AUTH XOAUTH2 "
+ (base64-encode-string
+ (concat "user=" user "\1auth=Bearer " password "\1\1") t))))
+
(defun smtpmail-response-code (string)
(when string
(with-temp-buffer
@@ -627,7 +660,7 @@ USER and PASSWORD should be non-nil."
(= code (car response)))))
(defun smtpmail-response-text (response)
- (mapconcat 'identity (cdr response) "\n"))
+ (mapconcat #'identity (cdr response) "\n"))
(defun smtpmail-query-smtp-server ()
"Query for an SMTP server and try to contact it.
@@ -667,7 +700,7 @@ Returns an error if the server cannot be contacted."
(let ((parts (split-string user-mail-address "@")))
(and (= (length parts) 2)
;; There's a dot in the domain name.
- (string-match "\\." (cadr parts))
+ (string-search "." (cadr parts))
user-mail-address))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
@@ -683,13 +716,17 @@ Returns an error if the server cannot be contacted."
;; `smtpmail-mail-address' should be set to the appropriate
;; buffer-local value by the caller, but in case not:
(envelope-from
- (or smtpmail-mail-address
- (and mail-specify-envelope-from
- (mail-envelope-from))
- (let ((from (mail-fetch-field "from")))
- (and from
- (cadr (mail-extract-address-components from))))
- (smtpmail-user-mail-address)))
+ (save-restriction
+ ;; Only look at the headers when fetching the
+ ;; envelope address.
+ (message-narrow-to-headers)
+ (or smtpmail-mail-address
+ (and mail-specify-envelope-from
+ (mail-envelope-from))
+ (let ((from (mail-fetch-field "from")))
+ (and from
+ (cadr (mail-extract-address-components from))))
+ (smtpmail-user-mail-address))))
process-buffer
result
auth-mechanisms
@@ -741,7 +778,7 @@ Returns an error if the server cannot be contacted."
"Unable to contact server")))
;; set the send-filter
- (set-process-filter process 'smtpmail-process-filter)
+ (set-process-filter process #'smtpmail-process-filter)
(let* ((greeting (plist-get (cdr result) :greeting))
(code (smtpmail-response-code greeting)))
@@ -1087,6 +1124,12 @@ many continuation lines."
(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
(replace-match ""))))))
+;; Obsolete.
+
+(defun smtpmail-intersection (list1 list2)
+ (declare (obsolete seq-intersection "28.1"))
+ (seq-intersection list2 list1 #'eq))
+
(provide 'smtpmail)
;;; smtpmail.el ends here
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 99ac41dd9ba..d545b0c3f15 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1,4 +1,4 @@
-;;; supercite.el --- minor mode for citing mail and news replies
+;;; supercite.el --- minor mode for citing mail and news replies -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -527,71 +527,71 @@ string."
(defvar sc-T-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'sc-S-preferred-attribution-list)
- (define-key map "b" 'sc-T-mail-nuke-blank-lines)
- (define-key map "c" 'sc-T-confirm-always)
- (define-key map "d" 'sc-T-downcase)
- (define-key map "e" 'sc-T-electric-references)
- (define-key map "f" 'sc-T-auto-fill-region)
- (define-key map "h" 'sc-T-describe)
- (define-key map "l" 'sc-S-cite-region-limit)
- (define-key map "n" 'sc-S-mail-nuke-mail-headers)
- (define-key map "N" 'sc-S-mail-header-nuke-list)
- (define-key map "o" 'sc-T-electric-circular)
- (define-key map "p" 'sc-S-preferred-header-style)
- (define-key map "s" 'sc-T-nested-citation)
- (define-key map "u" 'sc-T-use-only-preferences)
- (define-key map "w" 'sc-T-fixup-whitespace)
- (define-key map "?" 'sc-T-describe)
+ (define-key map "a" #'sc-S-preferred-attribution-list)
+ (define-key map "b" #'sc-T-mail-nuke-blank-lines)
+ (define-key map "c" #'sc-T-confirm-always)
+ (define-key map "d" #'sc-T-downcase)
+ (define-key map "e" #'sc-T-electric-references)
+ (define-key map "f" #'sc-T-auto-fill-region)
+ (define-key map "h" #'sc-T-describe)
+ (define-key map "l" #'sc-S-cite-region-limit)
+ (define-key map "n" #'sc-S-mail-nuke-mail-headers)
+ (define-key map "N" #'sc-S-mail-header-nuke-list)
+ (define-key map "o" #'sc-T-electric-circular)
+ (define-key map "p" #'sc-S-preferred-header-style)
+ (define-key map "s" #'sc-T-nested-citation)
+ (define-key map "u" #'sc-T-use-only-preferences)
+ (define-key map "w" #'sc-T-fixup-whitespace)
+ (define-key map "?" #'sc-T-describe)
map)
"Keymap for sub-keymap of setting and toggling functions.")
(defvar sc-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "c" 'sc-cite-region)
- (define-key map "f" 'sc-mail-field-query)
- (define-key map "g" 'sc-mail-process-headers)
- (define-key map "h" 'sc-describe)
- (define-key map "i" 'sc-insert-citation)
- (define-key map "o" 'sc-open-line)
- (define-key map "r" 'sc-recite-region)
- (define-key map "\C-p" 'sc-raw-mode-toggle)
- (define-key map "u" 'sc-uncite-region)
- (define-key map "w" 'sc-insert-reference)
- (define-key map "\C-t" sc-T-keymap)
- (define-key map "?" 'sc-describe)
+ (define-key map "c" #'sc-cite-region)
+ (define-key map "f" #'sc-mail-field-query)
+ (define-key map "g" #'sc-mail-process-headers)
+ (define-key map "h" #'sc-describe)
+ (define-key map "i" #'sc-insert-citation)
+ (define-key map "o" #'sc-open-line)
+ (define-key map "r" #'sc-recite-region)
+ (define-key map "\C-p" #'sc-raw-mode-toggle)
+ (define-key map "u" #'sc-uncite-region)
+ (define-key map "w" #'sc-insert-reference)
+ (define-key map "\C-t" sc-T-keymap)
+ (define-key map "?" #'sc-describe)
map)
"Keymap for Supercite quasi-mode.")
(defvar sc-electric-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "p" 'sc-eref-prev)
- (define-key map "n" 'sc-eref-next)
- (define-key map "s" 'sc-eref-setn)
- (define-key map "j" 'sc-eref-jump)
- (define-key map "x" 'sc-eref-abort)
- (define-key map "q" 'sc-eref-abort)
- (define-key map "\r" 'sc-eref-exit)
- (define-key map "\n" 'sc-eref-exit)
- (define-key map "g" 'sc-eref-goto)
- (define-key map "?" 'describe-mode)
- (define-key map "\C-h" 'describe-mode)
- (define-key map [f1] 'describe-mode)
- (define-key map [help] 'describe-mode)
+ (define-key map "p" #'sc-eref-prev)
+ (define-key map "n" #'sc-eref-next)
+ (define-key map "s" #'sc-eref-setn)
+ (define-key map "j" #'sc-eref-jump)
+ (define-key map "x" #'sc-eref-abort)
+ (define-key map "q" #'sc-eref-abort)
+ (define-key map "\r" #'sc-eref-exit)
+ (define-key map "\n" #'sc-eref-exit)
+ (define-key map "g" #'sc-eref-goto)
+ (define-key map "?" #'describe-mode)
+ (define-key map "\C-h" #'describe-mode)
+ (define-key map [f1] #'describe-mode)
+ (define-key map [help] #'describe-mode)
map)
"Keymap for `sc-electric-mode' electric references mode.")
(defvar sc-minibuffer-local-completion-map
(let ((map (copy-keymap minibuffer-local-completion-map)))
- (define-key map "\C-t" 'sc-toggle-fn)
- (define-key map " " 'self-insert-command)
+ (define-key map "\C-t" #'sc-toggle-fn)
+ (define-key map " " #'self-insert-command)
map)
"Keymap for minibuffer confirmation of attribution strings.")
(defvar sc-minibuffer-local-map
(let ((map (copy-keymap minibuffer-local-map)))
- (define-key map "\C-t" 'sc-toggle-fn)
+ (define-key map "\C-t" #'sc-toggle-fn)
map)
"Keymap for minibuffer confirmation of attribution strings.")
@@ -1109,6 +1109,8 @@ Only used during confirmation."
(setq sc-attrib-or-cite (not sc-attrib-or-cite))
(throw 'sc-reconfirm t))
+(defvar completer-disable) ;; From some `completer.el' package.
+
(defun sc-select-attribution ()
"Select an attribution from `sc-attributions'.
@@ -1126,6 +1128,8 @@ selection but before querying is performed. During
auto-selected citation string and the variable `attribution' is bound
to the auto-selected attribution string."
(run-hooks 'sc-attribs-preselect-hook)
+ (with-suppressed-warnings ((lexical citation attribution))
+ (defvar citation) (defvar attribution))
(let ((query-p sc-confirm-always-p)
attribution citation
(attriblist sc-preferred-attribution-list))
@@ -1150,7 +1154,7 @@ to the auto-selected attribution string."
(setq attribution attrib
attriblist nil))
((listp attrib)
- (setq attribution (eval attrib))
+ (setq attribution (eval attrib t))
(if (stringp attribution)
(setq attriblist nil)
(setq attribution nil
@@ -1593,7 +1597,7 @@ error occurs."
(let ((ref (nth sc-eref-style sc-rewrite-header-list)))
(condition-case err
(progn
- (eval ref)
+ (eval ref t)
(let ((lines (count-lines (point-min) (point-max))))
(or nomsg (message "Ref header %d [%d line%s]: %s"
sc-eref-style lines
@@ -1767,8 +1771,7 @@ querying you by typing `C-h'. Note that the format is changed
slightly from that used by `set-variable' -- the current value is
printed just after the variable's name instead of at the bottom of the
help window."
- (let* ((minibuffer-help-form '(funcall myhelp))
- (myhelp
+ (let* ((myhelp
(lambda ()
(with-output-to-temp-buffer "*Help*"
(prin1 var)
@@ -1784,7 +1787,8 @@ help window."
1))
(with-current-buffer standard-output
(help-mode))
- nil))))
+ nil)))
+ (minibuffer-help-form `(funcall #',myhelp)))
(set var (eval-minibuffer (format "Set %s to value: " var)))))
(defmacro sc-toggle-symbol (rootname)
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index a573c8a2673..b07004de38c 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -1,4 +1,4 @@
-;;; uce.el --- facilitate reply to unsolicited commercial email
+;;; uce.el --- facilitate reply to unsolicited commercial email -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 1998, 2000-2021 Free Software Foundation, Inc.
@@ -127,14 +127,12 @@
"A symbol indicating which mail reader you are using.
Choose from: `gnus', `rmail'."
:type '(choice (const gnus) (const rmail))
- :version "20.3"
- :group 'uce)
+ :version "20.3")
(defcustom uce-setup-hook nil
"Hook to run after UCE rant message is composed.
This hook is run after `mail-setup-hook', which is run as well."
- :type 'hook
- :group 'uce)
+ :type 'hook)
(defcustom uce-message-text
"Recently, I have received an Unsolicited Commercial E-mail from you.
@@ -180,36 +178,31 @@ on beginning of some line from the spamming list. So, when you set it
up, it might be a good idea to actually use this feature.
Value nil means insert no text by default, lets you type it in."
- :type '(choice (const nil) string)
- :group 'uce)
+ :type '(choice (const nil) string))
(defcustom uce-uce-separator
"----- original unsolicited commercial email follows -----"
"Line that will begin quoting of the UCE.
Value nil means use no separator."
- :type '(choice (const nil) string)
- :group 'uce)
+ :type '(choice (const nil) string))
(defcustom uce-signature mail-signature
"Text to put as your signature after the note to UCE sender.
Value nil means none, t means insert `~/.signature' file (if it happens
to exist), if this variable is a string this string will be inserted
as your signature."
- :type '(choice (const nil) (const t) string)
- :group 'uce)
+ :type '(choice (const nil) (const t) string))
(defcustom uce-default-headers
"Errors-To: nobody@localhost\nPrecedence: bulk\n"
"Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
These are mostly meant for headers that prevent delivery errors reporting."
- :type '(choice (const nil) string)
- :group 'uce)
+ :type '(choice (const nil) string))
(defcustom uce-subject-line
"Spam alert: unsolicited commercial e-mail"
"Subject of the message that will be sent in response to a UCE."
- :type 'string
- :group 'uce)
+ :type 'string)
;; End of user options.
@@ -221,7 +214,7 @@ These are mostly meant for headers that prevent delivery errors reporting."
(declare-function rmail-toggle-header "rmail" (&optional arg))
;;;###autoload
-(defun uce-reply-to-uce (&optional ignored)
+(defun uce-reply-to-uce (&optional _ignored)
"Compose a reply to unsolicited commercial email (UCE).
Sets up a reply buffer addressed to: the sender, his postmaster,
his abuse@ address, and the postmaster of the mail relay used.
@@ -253,10 +246,10 @@ You might need to set `uce-mail-reader' before using this."
(if reply-to
(setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
(let (first-at-sign end-of-hostname sender-host)
- (setq first-at-sign (string-match "@" to)
+ (setq first-at-sign (string-search "@" to)
end-of-hostname (string-match "[ ,>]" to first-at-sign)
sender-host (substring to first-at-sign end-of-hostname))
- (if (string-match "\\." sender-host)
+ (if (string-search "." sender-host)
(setq to (format "%s, postmaster%s, abuse%s"
to sender-host sender-host))))
(setq mail-send-actions nil)
@@ -298,7 +291,7 @@ You might need to set `uce-mail-reader' before using this."
(search-forward " ")
(forward-char -1)
;; And add its postmaster to the list of addresses.
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
;; Also look at the message-id, it helps *very* often.
@@ -309,7 +302,7 @@ You might need to set `uce-mail-reader' before using this."
(setq temp (point))
(search-forward ">")
(forward-char -1)
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))))
(when (eq uce-mail-reader 'gnus)
@@ -367,7 +360,7 @@ You might need to set `uce-mail-reader' before using this."
;; functions in mail-mode, etc.
(run-hooks 'mail-setup-hook 'uce-setup-hook))))
-(defun uce-insert-ranting (&optional ignored)
+(defun uce-insert-ranting (&optional _ignored)
"Insert text of the usual reply to UCE into current buffer."
(interactive "P")
(insert uce-message-text))
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index bf57ed6fa6f..0760a477296 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -125,7 +125,7 @@ See rmail-digest-methods."
;; Undo masking of separators inside digestified messages
(goto-char (point-min))
(while (search-forward
- (replace-regexp-in-string "\n-" "\n " separator) nil t)
+ (string-replace "\n-" "\n " separator) nil t)
(replace-match separator))
;; Return the list of marker pairs
(nreverse result))))))
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 34de416c959..5b1abd54c6f 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -1,4 +1,4 @@
-;;; unrmail.el --- convert Rmail Babyl files to mbox files
+;;; unrmail.el --- convert Rmail Babyl files to mbox files -*- lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@@ -235,7 +235,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use."
;; Insert the `From ' line.
(insert mail-from)
;; Record the keywords and attributes in our special way.
- (insert "X-RMAIL-ATTRIBUTES: " (apply 'string attrs) "\n")
+ (insert "X-RMAIL-ATTRIBUTES: " (apply #'string attrs) "\n")
(when keywords
(insert "X-RMAIL-KEYWORDS: " keywords "\n"))
;; Convert From to >From, etc.
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index fdd402e0fa0..026356efe97 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -1,4 +1,4 @@
-;;; uudecode.el -- elisp native uudecode -*- lexical-binding:t -*-
+;;; uudecode.el --- elisp native uudecode -*- lexical-binding:t -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
diff --git a/lisp/man.el b/lisp/man.el
index 1fded38e72d..6009a319198 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -801,8 +801,8 @@ POS defaults to `point'."
;; doesn't include a hyphen, we consider the hyphen to be
;; added by troff, and remove it.
(or (not (eq (string-to-char (substring 1st-part -1)) ?-))
- (string-match-p "-" (substring 1st-part 0 -1))
- (setq word (replace-regexp-in-string "-" "" word))))
+ (string-search "-" (substring 1st-part 0 -1))
+ (setq word (string-replace "-" "" word))))
;; Make sure the section number gets included by the code below.
(goto-char (match-end 1)))
(when (string-match "[-._‐]+$" word)
@@ -1024,7 +1024,7 @@ to auto-complete your input based on the installed manual pages."
;;;###autoload
(defun man-follow (man-args)
"Get a Un*x manual page of the item under point and put it in a buffer."
- (interactive (list (Man-default-man-entry)))
+ (interactive (list (Man-default-man-entry)) man-common)
(if (or (not man-args)
(string= man-args ""))
(error "No item under point")
@@ -1143,7 +1143,7 @@ Return the buffer in which the manpage will appear."
(defun Man-update-manpage ()
"Reformat current manpage by calling the man command again synchronously."
- (interactive)
+ (interactive nil man-common)
(when (eq Man-arguments nil)
;;this shouldn't happen unless it is not in a Man buffer."
(error "Man-arguments not initialized"))
@@ -1239,7 +1239,7 @@ See the variable `Man-notify-method' for the different notification behaviors."
(defun Man-fontify-manpage ()
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
- (interactive)
+ (interactive nil man-common)
(goto-char (point-min))
;; Fontify ANSI escapes.
(let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face)
@@ -1355,7 +1355,7 @@ default type, `Man-xref-man-page' is used for the buttons."
Normally skip any jobs that should have been done by the sed script,
but when called interactively, do those jobs even if the sed
script would have done them."
- (interactive "p")
+ (interactive "p" man-common)
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
@@ -1503,7 +1503,9 @@ manpage command."
(quit-restore-window
(get-buffer-window Man-buffer t) 'kill)
;; Ensure that we end up in the correct window.
- (select-window (old-selected-window)))
+ (let ((old-window (old-selected-window)))
+ (when (window-live-p old-window)
+ (select-window old-window))))
(kill-buffer Man-buffer)))
(when message
@@ -1527,7 +1529,14 @@ manpage command."
(defvar bookmark-make-record-function)
-(define-derived-mode Man-mode special-mode "Man"
+(define-derived-mode man-common special-mode "Man Shared"
+ "Parent mode for `Man-mode' like modes.
+This mode is here to be inherited by modes that need to use
+commands from `Man-mode'. Used by `woman'.
+(In itself, this mode currently does nothing.)"
+ :interactive nil)
+
+(define-derived-mode Man-mode man-common "Man"
"A mode for browsing Un*x manual pages.
The following man commands are available in the buffer. Try
@@ -1723,7 +1732,7 @@ The following key bindings are currently in effect in the buffer:
(defun Man-next-section (n)
"Move point to Nth next section (default 1)."
- (interactive "p")
+ (interactive "p" man-common)
(let ((case-fold-search nil)
(start (point)))
(if (looking-at Man-heading-regexp)
@@ -1739,7 +1748,7 @@ The following key bindings are currently in effect in the buffer:
(defun Man-previous-section (n)
"Move point to Nth previous section (default 1)."
- (interactive "p")
+ (interactive "p" man-common)
(let ((case-fold-search nil))
(if (looking-at Man-heading-regexp)
(forward-line -1))
@@ -1756,8 +1765,7 @@ Returns t if section is found, nil otherwise."
(if (re-search-forward (concat "^" section) (point-max) t)
(progn (beginning-of-line) t)
(goto-char curpos)
- nil)
- ))
+ nil)))
(defvar Man--last-section nil)
@@ -1771,7 +1779,8 @@ Returns t if section is found, nil otherwise."
(prompt (concat "Go to section (default " default "): "))
(chosen (completing-read prompt Man--sections
nil nil nil nil default)))
- (list chosen)))
+ (list chosen))
+ man-common)
(setq Man--last-section section)
(unless (Man-find-section section)
(error "Section %s not found" section)))
@@ -1780,7 +1789,7 @@ Returns t if section is found, nil otherwise."
(defun Man-goto-see-also-section ()
"Move point to the \"SEE ALSO\" section.
Actually the section moved to is described by `Man-see-also-regexp'."
- (interactive)
+ (interactive nil man-common)
(if (not (Man-find-section Man-see-also-regexp))
(error "%s" (concat "No " Man-see-also-regexp
" section found in the current manpage"))))
@@ -1834,7 +1843,8 @@ Specify which REFERENCE to use; default is based on word at point."
(prompt (concat "Refer to (default " default "): "))
(chosen (completing-read prompt Man--refpages
nil nil nil nil defaults)))
- chosen))))
+ chosen)))
+ man-common)
(if (not Man--refpages)
(error "Can't find any references in the current manpage")
(setq Man--last-refpage reference)
@@ -1843,7 +1853,7 @@ Specify which REFERENCE to use; default is based on word at point."
(defun Man-kill ()
"Kill the buffer containing the manpage."
- (interactive)
+ (interactive nil man-common)
(quit-window t))
(defun Man-goto-page (page &optional noerror)
@@ -1854,7 +1864,8 @@ Specify which REFERENCE to use; default is based on word at point."
(if (= (length Man-page-list) 1)
(error "You're looking at the only manpage in the buffer")
(list (read-minibuffer (format "Go to manpage [1-%d]: "
- (length Man-page-list)))))))
+ (length Man-page-list))))))
+ man-common)
(if (and (not Man-page-list) (not noerror))
(error "Not a man page buffer"))
(when Man-page-list
@@ -1876,7 +1887,7 @@ Specify which REFERENCE to use; default is based on word at point."
(defun Man-next-manpage ()
"Find the next manpage entry in the buffer."
- (interactive)
+ (interactive nil man-common)
(if (= (length Man-page-list) 1)
(error "This is the only manpage in the buffer"))
(if (< Man-current-page (length Man-page-list))
@@ -1887,7 +1898,7 @@ Specify which REFERENCE to use; default is based on word at point."
(defun Man-previous-manpage ()
"Find the previous manpage entry in the buffer."
- (interactive)
+ (interactive nil man-common)
(if (= (length Man-page-list) 1)
(error "This is the only manpage in the buffer"))
(if (> Man-current-page 1)
diff --git a/lisp/master.el b/lisp/master.el
index 796f2189d66..3dcee50c5e0 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -1,4 +1,4 @@
-;;; master.el --- make a buffer the master over another buffer
+;;; master.el --- make a buffer the master over another buffer -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
;;; Commentary:
-;; master-mode is a minor mode which enables you to scroll another
+;; `master-mode' is a minor mode which enables you to scroll another
;; buffer (the slave) without leaving your current buffer (the master).
;; It can be used by sql.el, for example: The SQL buffer is the master
@@ -47,17 +47,8 @@
;;
;; Rob Riepel <networking.stanford.edu>
-;;; History:
-;;
-
;;; Code:
-;; Unused.
-;;; (defgroup master nil
-;;; "Support for master/slave relationships between buffers."
-;;; :version "22.1"
-;;; :group 'convenience)
-
;; Variables that don't need initialization.
(defvar master-of nil
@@ -93,7 +84,7 @@ yourself the value of `master-of' by calling `master-show-slave'."
;; Initialize Master mode by setting a slave buffer.
(defun master-set-slave (buffer)
- "Makes BUFFER the slave of the current buffer.
+ "Make BUFFER the slave of the current buffer.
Use \\[master-mode] to toggle control of the slave buffer."
(interactive "bSlave: ")
(setq-local master-of buffer)
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index f9a24e34bf2..88003afb409 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -30,10 +30,17 @@
;;; Code:
-(defvar minibuffer-depth-indicator-function nil
- "If non-nil, function to set up the minibuffer depth indicator.
-It is called with one argument, the minibuffer depth,
-and must return a string.")
+(defcustom minibuffer-depth-indicator-function nil
+ "If non-nil, a function to produce the minibuffer depth indicator.
+The function will be called with one argument, the minibuffer depth,
+and must return a string to display as indication of the minibuffer
+depth.
+If nil, display the depth as a number inside brackets, [NN], with
+the `minibuffer-depth-indicator' face."
+ :version "28.1"
+ :type '(choice (const :tag "Default indicator display, [NN]" nil)
+ (function))
+ :group 'minibuffer)
(defface minibuffer-depth-indicator '((t :inherit highlight))
"Face to use for minibuffer depth indicator."
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 2fdfcc8b582..8def1575b24 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -79,9 +79,6 @@
:help "Print current buffer with page headings"))
menu))
-;; Only declared obsolete (and only made a proper alias) in 23.3.
-(define-obsolete-variable-alias
- 'menu-bar-files-menu 'menu-bar-file-menu "22.1")
(defvar menu-bar-file-menu
(let ((menu (make-sparse-keymap "File")))
@@ -459,9 +456,6 @@
(defvar menu-bar-edit-menu
(let ((menu (make-sparse-keymap "Edit")))
- (bindings--define-key menu [props]
- '(menu-item "Text Properties" facemenu-menu))
-
;; ns-win.el said: Add spell for platform consistency.
(if (featurep 'ns)
(bindings--define-key menu [spell]
@@ -495,7 +489,7 @@
'(menu-item "Select All" mark-whole-buffer
:help "Mark the whole buffer for a subsequent cut/copy"))
(bindings--define-key menu [clear]
- '(menu-item "Clear" delete-region
+ '(menu-item "Clear" delete-active-region
:enable (and mark-active
(not buffer-read-only))
:help
@@ -576,7 +570,9 @@
(defun clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
- (let ((select-enable-clipboard t))
+ (let ((select-enable-clipboard t)
+ ;; Ensure that we defeat the DWIM login in `gui-selection-value'.
+ (gui--last-selected-text-clipboard nil))
(yank)))
(defun clipboard-kill-ring-save (beg end &optional region)
@@ -604,7 +600,7 @@ Do the same for the keys of the same name."
(define-key global-map [f20] 'clipboard-kill-region)
(define-key global-map [f16] 'clipboard-kill-ring-save)
(define-key global-map [f18] 'clipboard-yank)
- ;; X11R6 versions:
+ ;; X11 versions:
(define-key global-map [cut] 'clipboard-kill-region)
(define-key global-map [copy] 'clipboard-kill-ring-save)
(define-key global-map [paste] 'clipboard-yank))
@@ -636,9 +632,9 @@ Do the same for the keys of the same name."
:help "Customize value of specific option"))
(bindings--define-key menu [separator-2]
menu-bar-separator)
- (bindings--define-key menu [customize-changed-options]
- '(menu-item "New Options..." customize-changed-options
- :help "Options added or changed in recent Emacs versions"))
+ (bindings--define-key menu [customize-changed]
+ '(menu-item "New Options..." customize-changed
+ :help "Options and faces added or changed in recent Emacs versions"))
(bindings--define-key menu [customize-saved]
'(menu-item "Saved Options" customize-saved
:help "Customize previously saved options"))
@@ -1882,6 +1878,9 @@ they ran"))
(bindings--define-key menu [describe-function]
'(menu-item "Describe Function..." describe-function
:help "Display documentation of function/command"))
+ (bindings--define-key menu [describe-command]
+ '(menu-item "Describe Command..." describe-command
+ :help "Display documentation of command"))
(bindings--define-key menu [shortdoc-display-group]
'(menu-item "Function Group Overview..." shortdoc-display-group
:help "Display a function overview for a specific topic"))
@@ -2244,6 +2243,7 @@ Buffers menu is regenerated."
"String to display in buffer listings for buffers not visiting a file.")
(defun menu-bar-select-buffer ()
+ (declare (obsolete nil "28.1"))
(interactive)
(switch-to-buffer last-command-event))
@@ -2291,9 +2291,10 @@ It must accept a buffer as its only required argument.")
(setq i (1- i))
(aset buffers-vec i
(cons (car pair)
- `(lambda ()
- (interactive)
- (funcall menu-bar-select-buffer-function ,(cdr pair))))))
+ (let ((buf (cdr pair)))
+ (lambda ()
+ (interactive)
+ (funcall menu-bar-select-buffer-function buf))))))
buffers-vec))
(defun menu-bar-update-buffers (&optional force)
@@ -2348,8 +2349,8 @@ It must accept a buffer as its only required argument.")
(aset frames-vec i
(cons
(frame-parameter frame 'name)
- `(lambda ()
- (interactive) (menu-bar-select-frame ,frame))))
+ (lambda ()
+ (interactive) (menu-bar-select-frame frame))))
(setq i (1+ i)))
;; Put it after the normal buffers
(setq buffers-menu
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index f1aeca65479..b0fdd02e3b3 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -11196,7 +11196,7 @@
instead of "0 msgs". Do not try to print a range when there are
no messages.
* mh-e.el (mh-regenerate-headers): Bug fix. Catch and remove the
- "scan: band message list" message.
+ "scan: bad message list" message.
2001-11-13 Jeffrey C Honig <jch@honig.net>
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index af6f2f1ab02..8fdcf3c62b4 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -1,4 +1,4 @@
-;;; mh-acros.el --- macros used in MH-E
+;;; mh-acros.el --- macros used in MH-E -*- lexical-binding: t; -*-
;; Copyright (C) 2004, 2006-2021 Free Software Foundation, Inc.
@@ -36,8 +36,6 @@
;; because it's pointless to compile a file full of macros. But we
;; kept the name.
-;;; Change Log:
-
;;; Code:
(require 'cl-lib)
@@ -49,20 +47,19 @@
;;;###mh-autoload
(defmacro mh-do-in-gnu-emacs (&rest body)
"Execute BODY if in GNU Emacs."
- (declare (debug t))
+ (declare (debug t) (indent defun))
(unless (featurep 'xemacs) `(progn ,@body)))
-(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-do-in-xemacs (&rest body)
"Execute BODY if in XEmacs."
- (declare (debug t))
+ (declare (debug t) (indent defun))
(when (featurep 'xemacs) `(progn ,@body)))
-(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-funcall-if-exists (function &rest args)
"Call FUNCTION with ARGS as parameters if it exists."
+ (declare (debug (symbolp body)))
;; FIXME: Not clear when this should be used. If the function happens
;; not to exist at compile-time (e.g. because the corresponding package
;; wasn't loaded), then it won't ever be used :-(
@@ -75,25 +72,24 @@
"Create function NAME.
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
Otherwise, create function NAME with ARG-LIST and BODY."
+ (declare (indent defun) (doc-string 4)
+ (debug (&define name symbolp sexp def-body)))
`(defalias ',name
(if (fboundp ',function)
',function
(lambda ,arg-list ,@body))))
-(put 'defun-mh 'lisp-indent-function 'defun)
-(put 'defun-mh 'doc-string-elt 4)
;;;###mh-autoload
(defmacro defmacro-mh (name macro arg-list &rest body)
"Create macro NAME.
If MACRO exists, then NAME becomes an alias for MACRO.
Otherwise, create macro NAME with ARG-LIST and BODY."
+ (declare (indent defun) (doc-string 4)
+ (debug (&define name symbolp sexp def-body)))
(let ((defined-p (fboundp macro)))
(if defined-p
`(defalias ',name ',macro)
`(defmacro ,name ,arg-list ,@body))))
-(put 'defmacro-mh 'lisp-indent-function 'defun)
-(put 'defmacro-mh 'doc-string-elt 4)
-
;;; Miscellaneous
@@ -127,7 +123,7 @@ Execute BODY, which can modify the folder buffer without having to
worry about file locking or the read-only flag, and return its result.
If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification flag
is unchanged, otherwise it is cleared."
- (declare (debug t))
+ (declare (debug t) (indent defun))
(setq save-modification-flag (car save-modification-flag)) ; CL style
`(prog1
(let ((mh-folder-updating-mod-flag (buffer-modified-p))
@@ -139,14 +135,13 @@ is unchanged, otherwise it is cleared."
(mh-set-folder-modified-p mh-folder-updating-mod-flag)))
,@(if (not save-modification-flag)
'((mh-set-folder-modified-p nil)))))
-(put 'with-mh-folder-updating 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-in-show-buffer (show-buffer &rest body)
"Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
Display buffer SHOW-BUFFER in other window and execute BODY in it.
Stronger than `save-excursion', weaker than `save-window-excursion'."
- (declare (debug t))
+ (declare (debug t) (indent defun))
(setq show-buffer (car show-buffer)) ; CL style
`(let ((mh-in-show-buffer-saved-window (selected-window)))
(switch-to-buffer-other-window ,show-buffer)
@@ -155,7 +150,6 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
(progn
,@body)
(select-window mh-in-show-buffer-saved-window))))
-(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-do-at-event-location (event &rest body)
@@ -163,7 +157,7 @@ Stronger than `save-excursion', weaker than `save-window-excursion'."
After BODY has been executed return to original window.
The modification flag of the buffer in the event window is
preserved."
- (declare (debug t))
+ (declare (debug t) (indent defun))
(let ((event-window (make-symbol "event-window"))
(event-position (make-symbol "event-position"))
(original-window (make-symbol "original-window"))
@@ -190,7 +184,6 @@ preserved."
(goto-char ,original-position)
(set-marker ,original-position nil)
(select-window ,original-window))))))
-(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
@@ -209,7 +202,7 @@ VAR is bound to the message on the current line as we loop
starting from BEGIN till END. In each step BODY is executed.
If VAR is nil then the loop is executed without any binding."
- (declare (debug (symbolp body)))
+ (declare (debug (symbolp body)) (indent defun))
(unless (symbolp var)
(error "Can not bind the non-symbol %s" var))
(let ((binding-needed-flag var))
@@ -221,7 +214,6 @@ If VAR is nil then the loop is executed without any binding."
(let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
,@body))
(forward-line 1)))))
-(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun)
;;;###mh-autoload
(defmacro mh-iterate-on-range (var range &rest body)
@@ -235,7 +227,7 @@ a string. In each iteration, BODY is executed.
The parameter RANGE is usually created with
`mh-interactive-range' in order to provide a uniform interface to
MH-E functions."
- (declare (debug (symbolp body)))
+ (declare (debug (symbolp body)) (indent defun))
(unless (symbolp var)
(error "Can not bind the non-symbol %s" var))
(let ((binding-needed-flag var)
@@ -263,7 +255,6 @@ MH-E functions."
(when (gethash v ,seq-hash-table)
(let ,(if binding-needed-flag `((,var v)) ())
,@body))))))))
-(put 'mh-iterate-on-range 'lisp-indent-hook 'defun)
(defmacro mh-dlet* (binders &rest body)
"Like `let*' but always dynamically scoped."
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 012725cab60..37fdb166011 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -1,4 +1,4 @@
-;;; mh-alias.el --- MH-E mail alias completion and expansion
+;;; mh-alias.el --- MH-E mail alias completion and expansion -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1997, 2001-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -42,8 +40,8 @@
"Time aliases were last loaded.")
(defvar mh-alias-read-address-map
(let ((map (copy-keymap minibuffer-local-completion-map)))
- (define-key map "," 'mh-alias-minibuffer-confirm-address)
- (define-key map " " 'self-insert-command)
+ (define-key map "," #'mh-alias-minibuffer-confirm-address)
+ (define-key map " " #'self-insert-command)
map))
(defcustom mh-alias-system-aliases
@@ -113,10 +111,10 @@ COMMA-SEPARATOR is non-nil."
(string-match "^\\([^,]+\\)," res))
(setq res (match-string 1 res)))
;; Replace "&" with capitalized username
- (if (string-match "&" res)
+ (if (string-search "&" res)
(setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
;; Remove " character
- (if (string-match "\"" res)
+ (if (string-search "\"" res)
(setq res (mh-replace-regexp-in-string "\"" "" res)))
;; If empty string, use username instead
(if (string-equal "" res)
@@ -270,9 +268,9 @@ Blind aliases or users from /etc/passwd are not expanded."
(t (split-string
(completing-read prompt mh-alias-alist nil nil) ",")))))
(if (not mh-alias-expand-aliases-flag)
- (mapconcat 'identity the-answer ", ")
+ (mapconcat #'identity the-answer ", ")
;; Loop over all elements, checking if in passwd alias or blind first
- (mapconcat 'mh-alias-expand the-answer ",\n ")))))
+ (mapconcat #'mh-alias-expand the-answer ",\n ")))))
;;;###mh-autoload
(defun mh-alias-minibuffer-confirm-address ()
@@ -287,7 +285,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(message "%s -> %s" the-name (mh-alias-expand the-name))
;; Check if it was a single word likely to be an alias
(if (and (equal mh-alias-flash-on-comma 1)
- (not (string-match " " the-name)))
+ (not (string-search " " the-name)))
(message "No alias for %s" the-name))))))
(self-insert-command 1))
@@ -427,10 +425,10 @@ contains it."
(if (or (not alias)
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
(completing-read "Alias file: "
- (mapcar 'list mh-alias-insert-file) nil t)
+ (mapcar #'list mh-alias-insert-file) nil t)
(or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
(completing-read "Alias file: "
- (mapcar 'list mh-alias-insert-file) nil t)))))
+ (mapcar #'list mh-alias-insert-file) nil t)))))
((and mh-alias-insert-file (stringp mh-alias-insert-file))
mh-alias-insert-file)
(t
@@ -449,11 +447,10 @@ set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
(car autolist))
((or (not alias)
(string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
- (completing-read "Alias file: " (mapcar 'list autolist) nil t))
+ (completing-read "Alias file: " autolist nil t))
(t
(or (mh-alias-which-file-has-alias alias autolist)
- (completing-read "Alias file: "
- (mapcar 'list autolist) nil t))))))))
+ (completing-read "Alias file: " autolist nil t))))))))
;;;###mh-autoload
(defun mh-alias-address-to-alias (address)
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index 55f74b6585d..ef21fdb2f95 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -1,4 +1,4 @@
-;;; mh-buffers.el --- MH-E buffer constants and utilities
+;;; mh-buffers.el --- MH-E buffer constants and utilities -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
;; The names of ephemeral buffers have a " *mh-" prefix (so that they
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 0dedb7e0ad0..4fae69defaf 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1,4 +1,4 @@
-;;; mh-comp.el --- MH-E functions for composing and sending messages
+;;; mh-comp.el --- MH-E functions for composing and sending messages -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
@@ -29,8 +29,6 @@
;; that are used to send the mail. Other that those, functions that
;; are needed in mh-letter.el should be found there.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -639,8 +637,8 @@ See also `mh-compose-forward-as-mime-flag',
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
Original message has headers FROM and SUBJECT."
- (let ((addr-start (string-match "<" from))
- (comment (string-match "(" from)))
+ (let ((addr-start (string-search "<" from))
+ (comment (string-search "(" from)))
(cond ((and addr-start (> addr-start 0))
;; Full Name <luser@host>
(setq from (substring from 0 (1- addr-start))))
@@ -719,12 +717,14 @@ message and scan line."
(mh-insert-fields field value)))))
(mh-components-to-list components-file))
(delete-file components-file))
- (mh-insert-fields "Resent-To:" (mapconcat 'identity (list to comp-to) ", ")
- "Resent-Cc:" (mapconcat 'identity (list cc comp-cc) ", ")
- "Resent-Fcc:" (mapconcat 'identity (list fcc
- comp-fcc) ", ")
- "Resent-Bcc:" (mapconcat 'identity (list bcc
- comp-bcc) ", ")
+ (mh-insert-fields "Resent-To:" (mapconcat #'identity (list to comp-to)
+ ", ")
+ "Resent-Cc:" (mapconcat #'identity (list cc comp-cc)
+ ", ")
+ "Resent-Fcc:" (mapconcat #'identity (list fcc comp-fcc)
+ ", ")
+ "Resent-Bcc:" (mapconcat #'identity (list bcc comp-bcc)
+ ", ")
"Resent-From:" from)
(save-buffer)
(message "Redistributing...")
@@ -1096,7 +1096,7 @@ letter."
(setq mode-line-buffer-identification (list " {%b}"))
(mh-logo-display)
(mh-make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
+ (add-hook 'kill-buffer-hook #'mh-tidy-draft-buffer nil t)
(run-hook-with-args 'mh-compose-letter-function to subject cc))
(defun mh-insert-x-mailer ()
@@ -1165,7 +1165,7 @@ This should be the last function called when composing the draft."
MSG can be a message number, a list of message numbers, or a sequence.
The hook `mh-annotate-msg-hook' is run after annotating; see its
documentation for variables it can use."
- (apply 'mh-exec-cmd "anno" folder
+ (apply #'mh-exec-cmd "anno" folder
(if (listp msg) (append msg args) (cons msg args)))
(save-excursion
(cond ((get-buffer folder) ; Buffer may be deleted
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 07bf03b30ee..ade80e8b95e 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -1,4 +1,4 @@
-;;; mh-compat.el --- make MH-E compatible with various versions of Emacs
+;;; mh-compat.el --- make MH-E compatible with various versions of Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -23,8 +23,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
;; This is a good place to gather code that is used for compatibility
@@ -42,7 +40,7 @@
(eval-when-compile (require 'mh-acros))
(mh-do-in-gnu-emacs
- (defalias 'mh-require 'require))
+ (defalias 'mh-require #'require))
(mh-do-in-xemacs
(defun mh-require (feature &optional filename noerror)
@@ -83,6 +81,7 @@ This is an analogue of a dynamically scoped `let' that operates on
the function cell of FUNCs rather than their value cell.
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+ (declare (indent 1) (debug ((&rest (sexp sexp &rest form)) &rest form)))
(if (fboundp 'cl-letf)
`(cl-letf ,(mapcar (lambda (binding)
`((symbol-function ',(car binding))
@@ -90,9 +89,6 @@ the function cell of FUNCs rather than their value cell.
bindings)
,@body)
`(flet ,bindings ,@body)))
-(put 'mh-flet 'lisp-indent-function 1)
-(put 'mh-flet 'edebug-form-spec
- '((&rest (sexp sexp &rest form)) &rest form))
(defun mh-display-color-cells (&optional display)
"Return the number of color cells supported by DISPLAY.
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 2eb7fbaa20c..949787a2501 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1,4 +1,4 @@
-;;; mh-e.el --- GNU Emacs interface to the MH mail system
+;;; mh-e.el --- GNU Emacs interface to the MH mail system -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2021 Free
;; Software Foundation, Inc.
@@ -229,7 +229,7 @@ User's mail folder directory.")
(defvar mh-arrow-marker nil
"Marker for arrow display in fringe.")
-(defvar mh-blacklist nil
+(defvar mh-blocklist nil
"List of messages to use to train the junk filter.
This variable can be used by
`mh-before-commands-processed-hook'.")
@@ -295,7 +295,7 @@ Elements have the form (SEQUENCE . MESSAGES).")
"Stack of operations that change the folder view.
These operations include narrowing or threading.")
-(defvar mh-whitelist nil
+(defvar mh-allowlist nil
"List of messages to use to train the junk filter.
This variable can be used by
`mh-before-commands-processed-hook'.")
@@ -522,7 +522,7 @@ parsed by MH-E."
(let* ((initial-size (mh-truncate-log-buffer))
(start (point))
(args (mh-list-to-string args)))
- (apply 'call-process (expand-file-name command mh-progs) nil t nil args)
+ (apply #'call-process (expand-file-name command mh-progs) nil t nil args)
(when (> (buffer-size) initial-size)
(save-excursion
(goto-char start)
@@ -560,7 +560,7 @@ ARGS are passed to COMMAND as command line arguments."
(with-current-buffer (get-buffer-create mh-log-buffer)
(mh-truncate-log-buffer))
(let* ((process-connection-type nil)
- (process (apply 'start-process
+ (process (apply #'start-process
command nil
(expand-file-name command mh-progs)
(mh-list-to-string args))))
@@ -602,7 +602,7 @@ RAISE-ERROR is non-nil, in which case an error is signaled if
(set-buffer (get-buffer-create mh-temp-buffer))
(erase-buffer)
(let ((value
- (apply 'call-process
+ (apply #'call-process
(expand-file-name command mh-progs) nil t nil
args)))
(goto-char (point-min))
@@ -616,7 +616,7 @@ Put the output into buffer after point.
Set mark after inserted text.
Output is expected to be shown to user, not parsed by MH-E."
(push-mark (point) t)
- (apply 'call-process
+ (apply #'call-process
(expand-file-name command mh-progs) nil t display
(mh-list-to-string args))
@@ -650,7 +650,7 @@ preserves whether the mark is active or not."
"Execute MH library command COMMAND with ARGS.
Put the output into buffer after point.
Set mark after inserted text."
- (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args))
+ (apply #'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args))
(defun mh-handle-process-error (command status)
"Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS."
@@ -695,9 +695,8 @@ See documentation for `defgroup' for a description of the arguments
SYMBOL, MEMBERS, DOC and ARGS.
This macro is used by Emacs versions that lack the :package-version
keyword, introduced in Emacs 22."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
`(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args)))
-(put 'defgroup-mh 'lisp-indent-function 'defun)
(defmacro defcustom-mh (symbol value doc &rest args)
"Declare SYMBOL as a customizable variable that defaults to VALUE.
@@ -705,9 +704,8 @@ See documentation for `defcustom' for a description of the arguments
SYMBOL, VALUE, DOC and ARGS.
This macro is used by Emacs versions that lack the :package-version
keyword, introduced in Emacs 22."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
`(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args)))
-(put 'defcustom-mh 'lisp-indent-function 'defun)
(defmacro defface-mh (face spec doc &rest args)
"Declare FACE as a customizable face that defaults to SPEC.
@@ -715,9 +713,8 @@ See documentation for `defface' for a description of the arguments
FACE, SPEC, DOC and ARGS.
This macro is used by Emacs versions that lack the :package-version
keyword, introduced in Emacs 22."
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent defun))
`(defface ,face ,spec ,doc ,@(mh-strip-package-version args)))
-(put 'defface-mh 'lisp-indent-function 'defun)
@@ -741,8 +738,11 @@ is described by the variable `mh-variants'."
;; Make a unique list of directories, keeping the given order.
;; We don't want the same MH variant to be listed multiple times.
(cl-loop for dir in (append mh-path mh-sys-path exec-path) do
- (setq dir (file-chase-links (directory-file-name dir)))
- (cl-pushnew dir list-unique :test #'equal))
+ ;; skip relative dirs, typically "."
+ (if (file-name-absolute-p dir)
+ (progn
+ (setq dir (file-chase-links (directory-file-name dir)))
+ (cl-pushnew dir list-unique :test #'equal))))
(cl-loop for dir in (nreverse list-unique) do
(when (and dir (file-accessible-directory-p dir))
(let ((variant (mh-variant-info dir)))
@@ -977,7 +977,7 @@ necessary and can actually cause problems."
:set (lambda (symbol value)
(set-default symbol value) ;Done in mh-variant-set-variant!
(mh-variant-set value))
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:group 'mh-e
:package-version '(MH-E . "8.0"))
@@ -1551,7 +1551,7 @@ as the result is undefined."
'(radio)
(mapcar
(lambda (arg) `(const ,arg))
- (mapcar 'car mh-identity-list))))
+ (mapcar #'car mh-identity-list))))
(cons :tag "Fcc Field"
(const "fcc")
(string :tag "Value"))
@@ -1578,7 +1578,7 @@ See `mh-identity-list'."
'(radio)
(cons '(const :tag "None" nil)
(mapcar (lambda (arg) `(const ,arg))
- (mapcar 'car mh-identity-list))))
+ (mapcar #'car mh-identity-list))))
:group 'mh-identity
:package-version '(MH-E . "7.1"))
@@ -1687,13 +1687,13 @@ fashion."
;; Available spam filter interfaces
(defvar mh-junk-function-alist
- '((spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist)
- (bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist)
- (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist))
+ '((spamassassin mh-spamassassin-blocklist mh-spamassassin-allowlist)
+ (bogofilter mh-bogofilter-blocklist mh-bogofilter-allowlist)
+ (spamprobe mh-spamprobe-blocklist mh-spamprobe-allowlist))
"Available choices of spam programs to use.
This is an alist. For each element there are functions that
-blacklist a message as spam and whitelist a message incorrectly
+blocklist a message as spam and allowlist a message incorrectly
classified as spam.")
(defun mh-junk-choose (symbol value)
@@ -1718,8 +1718,8 @@ be slow when junking large numbers of messages. If you have
enough memory or don't junk that many messages at the same time,
you might try turning on this option.
-Note that this option is used as the \"display\" argument in the
-call to `call-process'. Therefore, turning on this option means
+Note that this option is used as the \"destination\" argument in
+the call to `call-process'. Therefore, turning on this option means
setting its value to \"0\". You can also set its value to t to
direct the programs' output to the \"*MH-E Log*\" buffer; this
may be useful for debugging."
@@ -1747,7 +1747,7 @@ bogofilter, then you can set this option to \"Bogofilter\"."
(const :tag "SpamAssassin" spamassassin)
(const :tag "Bogofilter" bogofilter)
(const :tag "SpamProbe" spamprobe))
- :set 'mh-junk-choose
+ :set #'mh-junk-choose
:group 'mh-junk
:package-version '(MH-E . "7.3"))
@@ -1910,7 +1910,7 @@ white image, can be generated using the \"compface\" command (see URL
`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z'). The
\"Online X-Face Converter\" is a useful resource for quick conversion
of images into \"X-Face:\" header fields (see URL
-`http://www.dairiki.org/xface/').
+`https://www.dairiki.org/xface/').
Use the \"make-face\" script to convert a JPEG image to the higher
resolution, color, \"Face:\" header field (see URL
@@ -2008,7 +2008,7 @@ call `mh-set-cmd-note' with the width specified by your format file
you would use \"(mh-set-cmd-note 4)\"."
:type 'boolean
:group 'mh-scan-line-formats
- :set 'mh-adaptive-cmd-note-flag-check
+ :set #'mh-adaptive-cmd-note-flag-check
:package-version '(MH-E . "7.0"))
(defun mh-scan-format-file-check (symbol value)
@@ -2047,7 +2047,7 @@ Emacs start with 0)."
(const :tag "Use Default scan Format" nil)
(file :tag "Specify a scan Format File"))
:group 'mh-scan-line-formats
- :set 'mh-scan-format-file-check
+ :set #'mh-scan-format-file-check
:package-version '(MH-E . "6.0"))
(defun mh-adaptive-cmd-note-flag-check (symbol value)
@@ -2236,11 +2236,11 @@ commands."
:group 'mh-sequences
:package-version '(MH-E . "7.0"))
-(defcustom-mh mh-whitelist-preserves-sequences-flag t
- "Non-nil means that sequences are preserved when messages are whitelisted.
+(defcustom-mh mh-allowlist-preserves-sequences-flag t
+ "Non-nil means that sequences are preserved when messages are allowlisted.
If a message is in any sequence (except \"Previous-Sequence:\"
-and \"cur\") when it is whitelisted, then it will still be in
+and \"cur\") when it is allowlisted, then it will still be in
those sequences in the destination folder. If this behavior is
not desired, then turn off this option."
:type 'boolean
@@ -2469,9 +2469,9 @@ of citations entirely, choose \"None\"."
"Disposition-Notification-Options:" ; RFC 2298
"Disposition-Notification-To:" ; RFC 2298
"Distribution:" ; RFC 1036
- "DKIM-" ; http://antispam.yahoo.com/domainkeys
+ "DKIM-" ; https://en.wikipedia.org/wiki/DomainKeys_Identified_Mail
"DL-Expansion-History:" ; RFC 2156
- "DomainKey-" ; http://antispam.yahoo.com/domainkeys
+ "DomainKey-" ; https://en.wikipedia.org/wiki/DomainKeys_Identified_Mail
"DomainKey-Signature:"
"Encoding:" ; RFC 1505
"Envelope-to:"
@@ -2558,7 +2558,7 @@ of citations entirely, choose \"None\"."
"X-Abuse-Info:"
"X-Accept-Language:" ; Netscape/Mozilla
"X-Ack:"
- "X-ACL-Warn:" ; http://www.exim.org
+ "X-ACL-Warn:" ; https://www.exim.org
"X-Admin:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Administrivia-To:"
"X-AMAZON" ; Amazon.com
@@ -2582,8 +2582,8 @@ of citations entirely, choose \"None\"."
"X-BFI:"
"X-Bigfish:"
"X-Bogosity:" ; bogofilter
- "X-BPS1:" ; http://www.boggletools.com
- "X-BPS2:" ; http://www.boggletools.com
+ "X-BPS1:" ; http://www.boggletools.com [dead link?]
+ "X-BPS2:" ; http://www.boggletools.com [dead link?]
"X-Brightmail-Tracker:" ; Brightmail
"X-BrightmailFiltered:" ; Brightmail
"X-Bugzilla-" ; Bugzilla
@@ -2599,12 +2599,12 @@ of citations entirely, choose \"None\"."
"X-Confirm-Reading-To:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Content-Filtered-By:"
"X-ContentStamp:" ; NetZero
- "X-Country-Chain:" ; http://www.declude.com/x-note.htm
+ "X-Country-Chain:" ; http://www.declude.com/x-note.htm [dead link?]
"X-Cr-Hashedpuzzle:"
"X-Cr-Puzzleid:"
"X-Cron-Env:"
"X-DCC-" ; SpamAssassin
- "X-Declude-" ; http://www.declude.com/x-note.htm
+ "X-Declude-" ; http://www.declude.com/x-note.htm [dead link?]
"X-Dedicated:"
"X-Delivered"
"X-Destination-ID:"
@@ -2619,7 +2619,7 @@ of citations entirely, choose \"None\"."
"X-EID:"
"X-ELNK-Trace:" ; Earthlink mailer
"X-EM-" ; Some ecommerce software
- "X-Email-Type-Id:" ; Paypal http://www.paypal.com
+ "X-Email-Type-Id:" ; Paypal https://www.paypal.com
"X-Enigmail-Version:"
"X-Envelope-Date:" ; GNU mailutils
"X-Envelope-From:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
@@ -2635,21 +2635,21 @@ of citations entirely, choose \"None\"."
"X-Folder:" ; Spam
"X-Forwarded-" ; Google+
"X-From-Line"
- "X-FuHaFi:" ; http://www.gmx.net/
+ "X-FuHaFi:" ; https://www.gmx.net/
"X-Generated-By:" ; launchpad.net
"X-Gmail-" ; Gmail
"X-Gnus-Mail-Source:" ; gnus
"X-Google-" ; Google mail
"X-Google-Sender-Auth:"
"X-Greylist:" ; milter-greylist-1.2.1
- "X-Habeas-" ; http://www.returnpath.net
+ "X-Habeas-" ; https://www.returnpath.net
"X-Hashcash:" ; hashcash
"X-Headers-End:" ; SpamCop
"X-HPL-"
"X-HR-"
"X-HTTP-UserAgent:"
"X-Hz" ; Hertz
- "X-Identity:" ; http://www.declude.com/x-note.htm
+ "X-Identity:" ; http://www.declude.com/x-note.htm [dead link?]
"X-IEEE-UCE-" ; IEEE spam filter
"X-Image-URL:"
"X-IMAP:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
@@ -2670,7 +2670,7 @@ of citations entirely, choose \"None\"."
"X-Loop:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
"X-Lrde-Mailscanner:"
"X-Lumos-SenderID:" ; Roving ConstantContact
- "X-mail_abuse_inquiries:" ; http://www.salesforce.com
+ "X-mail_abuse_inquiries:" ; https://www.salesforce.com
"X-Mail-from:" ; fastmail.fm
"X-MAIL-INFO:" ; NetZero
"X-Mailer_"
@@ -2683,11 +2683,11 @@ of citations entirely, choose \"None\"."
"X-Mailutils-Message-Id" ; GNU Mailutils
"X-Majordomo:" ; Majordomo mailing list manager
"X-Match:"
- "X-MaxCode-Template:" ; Paypal http://www.paypal.com
+ "X-MaxCode-Template:" ; Paypal https://www.paypal.com
"X-MB-Message-" ; AOL WebMail
"X-MDaemon-Deliver-To:"
"X-MDRemoteIP:"
- "X-ME-Bayesian:" ; http://www.newmediadevelopment.net/page.cfm/parent/Client-Area/content/Managing-spam/
+ "X-ME-Bayesian:" ; https://www.newmediadevelopment.net/page.cfm/parent/Client-Area/content/Managing-spam/
"X-Message-Id"
"X-Message-Type:"
"X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX
@@ -2758,7 +2758,7 @@ of citations entirely, choose \"None\"."
"X-Server-Date:"
"X-Server-Uuid:"
"X-Service-Code:"
- "X-SFDC-" ; http://www.salesforce.com
+ "X-SFDC-" ; https://www.salesforce.com
"X-Sieve:" ; Sieve filtering
"X-SMFBL:"
"X-SMHeaderMap:"
@@ -2773,7 +2773,7 @@ of citations entirely, choose \"None\"."
"X-Submissions-To:"
"X-Sun-Charset:"
"X-Telecom-Digest"
- "X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com
+ "X-TM-IMSS-Message-ID:" ; https://www.trendmicro.com
"X-Trace:"
"X-UID"
"X-UIDL:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
@@ -2793,10 +2793,10 @@ of citations entirely, choose \"None\"."
"X-WebTV-Signature:"
"X-Wss-Id:" ; Worldtalk gateways
"X-X-Sender:" ; https://people.dsv.su.se/~jpalme/ietf/mail-headers/
- "X-XPT-XSL-Name:" ; Paypal http://www.paypal.com
+ "X-XPT-XSL-Name:" ; Paypal https://www.paypal.com
"X-xsi-"
- "X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm
- "X-Y-GMX-Trusted:" ; http://www.gmx.net/
+ "X-XWALL-" ; https://www.dataenter.co.at/doc/xwall_undocumented_config.htm
+ "X-Y-GMX-Trusted:" ; https://www.gmx.net/
"X-Yahoo"
"X-Yahoo-Newman-"
"X-YMail-"
@@ -3042,7 +3042,7 @@ 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 `http://www.jpl.org/ftp/pub/elisp/').
+and the x-face package (see URL `https://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
@@ -3195,7 +3195,7 @@ annotated messages with `mh-annotate-list'."
"Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests.
Variables that are useful in this hook include `mh-delete-list',
-`mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be
+`mh-refile-list', `mh-blocklist', and `mh-allowlist' which can be
used to see which changes will be made to the current folder,
`mh-current-folder'."
:type 'hook
@@ -3227,8 +3227,8 @@ before sending, add the `ispell-message' function."
:group 'mh-letter
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-blacklist-msg-hook nil
- "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blacklist] after marking each message for blacklisting."
+(defcustom-mh mh-blocklist-msg-hook nil
+ "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blocklist] after marking each message for blocklisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
@@ -3400,8 +3400,8 @@ sequence."
:group 'mh-sequences
:package-version '(MH-E . "6.0"))
-(defcustom-mh mh-whitelist-msg-hook nil
- "Hook run by \\<mh-letter-mode-map>\\[mh-junk-whitelist] after marking each message for whitelisting."
+(defcustom-mh mh-allowlist-msg-hook nil
+ "Hook run by \\<mh-letter-mode-map>\\[mh-junk-allowlist] after marking each message for allowlisting."
:type 'hook
:group 'mh-hooks
:group 'mh-show
@@ -3627,9 +3627,9 @@ specified colors."
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-blacklisted
+(defface-mh mh-folder-blocklisted
(mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number))))
- "Blacklisted message face."
+ "Blocklisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
@@ -3723,9 +3723,9 @@ format `mh-scan-format-nmh' and the regular expression
:group 'mh-folder
:package-version '(MH-E . "8.0"))
-(defface-mh mh-folder-whitelisted
+(defface-mh mh-folder-allowlisted
(mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled))))
- "Whitelisted message face."
+ "Allowlisted message face."
:group 'mh-faces
:group 'mh-folder
:package-version '(MH-E . "8.4"))
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 555d13d7235..35277ae46a1 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -1,4 +1,4 @@
-;;; mh-folder.el --- MH-Folder mode
+;;; mh-folder.el --- MH-Folder mode -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
@@ -25,8 +25,6 @@
;; Mode for browsing folders
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -209,10 +207,10 @@ annotation.")
;; Use defalias to make sure the documented primary key bindings
;; appear in menu lists.
-(defalias 'mh-alt-show 'mh-show)
-(defalias 'mh-alt-refile-msg 'mh-refile-msg)
-(defalias 'mh-alt-send 'mh-send)
-(defalias 'mh-alt-visit-folder 'mh-visit-folder)
+(defalias 'mh-alt-show #'mh-show)
+(defalias 'mh-alt-refile-msg #'mh-refile-msg)
+(defalias 'mh-alt-send #'mh-send)
+(defalias 'mh-alt-visit-folder #'mh-visit-folder)
;; Save the "b" binding for a future `back'. Maybe?
(gnus-define-keys mh-folder-mode-map
@@ -280,7 +278,8 @@ annotation.")
(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
"?" mh-prefix-help
- "b" mh-junk-blacklist
+ "a" mh-junk-allowlist
+ "b" mh-junk-blocklist
"w" mh-junk-whitelist)
(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
@@ -388,7 +387,7 @@ annotation.")
(?K "[v]iew, [i]nline, with [e]xternal viewer; \n"
"[o]utput/save MIME part; save [a]ll parts; \n"
"[t]oggle buttons; [TAB] next; [SHIFT-TAB] previous")
- (?J "[b]lacklist, [w]hitelist message"))
+ (?J "[b]locklist, [a]llowlist message"))
"Key binding cheat sheet.
See `mh-set-help'.")
@@ -407,12 +406,12 @@ See `mh-set-help'.")
;; Marked for deletion
(list (concat mh-scan-deleted-msg-regexp ".*")
'(0 'mh-folder-deleted))
- ;; Marked for blacklisting
- (list (concat mh-scan-blacklisted-msg-regexp ".*")
- '(0 'mh-folder-blacklisted))
- ;; Marked for whitelisting
- (list (concat mh-scan-whitelisted-msg-regexp ".*")
- '(0 'mh-folder-whitelisted))
+ ;; Marked for blocklisting
+ (list (concat mh-scan-blocklisted-msg-regexp ".*")
+ '(0 'mh-folder-blocklisted))
+ ;; Marked for allowlisting
+ (list (concat mh-scan-allowlisted-msg-regexp ".*")
+ '(0 'mh-folder-allowlisted))
;; After subject
(list mh-scan-body-regexp
'(1 'mh-folder-body nil t))
@@ -618,8 +617,8 @@ perform the operation on all messages in that region.
'mh-showing-mode nil ; Show message also?
'mh-refile-list nil ; List of folder names in mh-seq-list
'mh-delete-list nil ; List of msgs nums to delete
- 'mh-blacklist nil ; List of messages to process as spam
- 'mh-whitelist nil ; List of messages to process as ham
+ 'mh-blocklist nil ; List of messages to process as spam
+ 'mh-allowlist nil ; List of messages to process as ham
'mh-seq-list nil ; Alist of (seq . msgs) nums
'mh-seen-list nil ; List of displayed messages
'mh-next-direction 'forward ; Direction to move to next message
@@ -650,11 +649,11 @@ perform the operation on all messages in that region.
(auto-save-mode -1)
(setq buffer-offer-save t)
(mh-make-local-hook (mh-write-file-functions))
- (add-hook (mh-write-file-functions) 'mh-execute-commands nil t)
+ (add-hook (mh-write-file-functions) #'mh-execute-commands nil t)
(make-local-variable 'revert-buffer-function)
(make-local-variable 'hl-line-mode) ; avoid pollution
(mh-funcall-if-exists hl-line-mode 1)
- (setq revert-buffer-function 'mh-undo-folder)
+ (setq revert-buffer-function #'mh-undo-folder)
(add-to-list 'minor-mode-alist '(mh-showing-mode " Show"))
(mh-do-in-xemacs
(easy-menu-add mh-folder-sequence-menu)
@@ -716,8 +715,8 @@ RANGE is read in interactive use."
(defun mh-execute-commands ()
"Perform outstanding operations\\<mh-folder-mode-map>.
-If you've marked messages to be refiled, deleted, blacklisted, or
-whitelisted and you want to go ahead and perform these operations
+If you've marked messages to be refiled, deleted, blocklisted, or
+allowlisted and you want to go ahead and perform these operations
on these messages, use this command. Many MH-E commands that may
affect the numbering of the messages (such as
\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want
@@ -1117,7 +1116,7 @@ called interactively."
(message "Destination folder: %s" (cdr mh-last-destination)))
(t
(mh-iterate-on-range msg range
- (apply 'mh-write-msg-to-file msg (cdr mh-last-destination)))
+ (apply #'mh-write-msg-to-file msg (cdr mh-last-destination)))
(mh-next-msg interactive-flag))))
;;;###mh-autoload
@@ -1190,16 +1189,16 @@ RANGE is read in interactive use."
(beginning-of-line)
(while (not (or (looking-at mh-scan-refiled-msg-regexp)
(looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-blacklisted-msg-regexp)
- (looking-at mh-scan-whitelisted-msg-regexp)
+ (looking-at mh-scan-blocklisted-msg-regexp)
+ (looking-at mh-scan-allowlisted-msg-regexp)
(and (eq mh-next-direction 'forward) (bobp))
(and (eq mh-next-direction 'backward)
(save-excursion (forward-line) (eobp)))))
(forward-line (if (eq mh-next-direction 'forward) -1 1)))
(if (or (looking-at mh-scan-refiled-msg-regexp)
(looking-at mh-scan-deleted-msg-regexp)
- (looking-at mh-scan-blacklisted-msg-regexp)
- (looking-at mh-scan-whitelisted-msg-regexp))
+ (looking-at mh-scan-blocklisted-msg-regexp)
+ (looking-at mh-scan-allowlisted-msg-regexp))
(progn
(mh-undo-msg (mh-get-msg-num t))
(mh-maybe-show))
@@ -1531,7 +1530,7 @@ is updated."
(save-excursion
(when (eq major-mode 'mh-show-mode)
(set-buffer mh-show-folder-buffer))
- (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist)))
+ (or mh-delete-list mh-refile-list mh-blocklist mh-allowlist)))
;;;###mh-autoload
(defun mh-set-folder-modified-p (flag)
@@ -1557,12 +1556,12 @@ after the commands are processed."
(folders-changed (list mh-current-folder))
(seq-map (and
(or (and mh-refile-list mh-refile-preserves-sequences-flag)
- (and mh-whitelist
- mh-whitelist-preserves-sequences-flag))
+ (and mh-allowlist
+ mh-allowlist-preserves-sequences-flag))
(mh-create-sequence-map mh-seq-list)))
(dest-map (and mh-refile-list mh-refile-preserves-sequences-flag
(make-hash-table)))
- (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag
+ (allow-map (and mh-allowlist mh-allowlist-preserves-sequences-flag
(make-hash-table))))
;; Remove invalid scan lines if we are in an index folder and then remove
;; the real messages
@@ -1606,53 +1605,53 @@ after the commands are processed."
;; Now delete messages
(cond (mh-delete-list
(setq redraw-needed-flag t)
- (apply 'mh-exec-cmd "rmm" folder
+ (apply #'mh-exec-cmd "rmm" folder
(mh-coalesce-msg-list mh-delete-list))
(mh-delete-scan-msgs mh-delete-list)
(setq mh-delete-list nil)))
- ;; Blacklist messages.
- (when mh-blacklist
- (let ((msg-list (mh-coalesce-msg-list mh-blacklist))
- (dest (mh-junk-blacklist-disposition)))
- (mh-junk-process-blacklist mh-blacklist)
+ ;; Blocklist messages.
+ (when mh-blocklist
+ (let ((msg-list (mh-coalesce-msg-list mh-blocklist))
+ (dest (mh-junk-blocklist-disposition)))
+ (mh-junk-process-blocklist mh-blocklist)
;; TODO I wonder why mh-exec-cmd is used instead of the following:
;; (mh-refile-a-msg nil (intern dest))
;; (mh-delete-a-msg nil)))
(if (null dest)
- (apply 'mh-exec-cmd "rmm" folder msg-list)
- (apply 'mh-exec-cmd "refile" "-src" folder dest msg-list)
+ (apply #'mh-exec-cmd "rmm" folder msg-list)
+ (apply #'mh-exec-cmd "refile" "-src" folder dest msg-list)
(push dest folders-changed))
(setq redraw-needed-flag t)
- (mh-delete-scan-msgs mh-blacklist)
- (setq mh-blacklist nil)))
+ (mh-delete-scan-msgs mh-blocklist)
+ (setq mh-blocklist nil)))
- ;; Whitelist messages.
- (when mh-whitelist
- (let ((msg-list (mh-coalesce-msg-list mh-whitelist))
+ ;; Allowlist messages.
+ (when mh-allowlist
+ (let ((msg-list (mh-coalesce-msg-list mh-allowlist))
(last (car (mh-translate-range mh-inbox "last"))))
- (mh-junk-process-whitelist mh-whitelist)
+ (mh-junk-process-allowlist mh-allowlist)
(apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list)
(push mh-inbox folders-changed)
(setq redraw-needed-flag t)
- (mh-delete-scan-msgs mh-whitelist)
- (when mh-whitelist-preserves-sequences-flag
- (clrhash white-map)
+ (mh-delete-scan-msgs mh-allowlist)
+ (when mh-allowlist-preserves-sequences-flag
+ (clrhash allow-map)
(cl-loop for i from (1+ (or last 0))
- for msg in (sort (copy-sequence mh-whitelist) #'<)
+ for msg in (sort (copy-sequence mh-allowlist) #'<)
do (cl-loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name white-map))))
+ do (push i (gethash seq-name allow-map))))
(maphash
#'(lambda (seq msgs)
;; Can't be run in background, since the current
;; folder is changed by mark this could lead to a
- ;; race condition with the next refile/whitelist.
+ ;; race condition with the next refile/allowlist.
(apply #'mh-exec-cmd "mark"
"-sequence" (symbol-name seq) mh-inbox
"-add" (mapcar #'(lambda(x) (format "%s" x))
(mh-coalesce-msg-list msgs))))
- white-map))
- (setq mh-whitelist nil)))
+ allow-map))
+ (setq mh-allowlist nil)))
;; Don't need to remove sequences since delete and refile do so.
;; Mark cur message
@@ -1703,7 +1702,7 @@ after the commands are processed."
(mh-recenter nil)))
;;;###mh-autoload
-(defun mh-make-folder-mode-line (&optional ignored)
+(defun mh-make-folder-mode-line (&optional _ignored)
"Set the fields of the mode line for a folder buffer.
The optional argument is now obsolete and IGNORED. It used to be
used to pass in what is now stored in the buffer-local variable
@@ -1963,10 +1962,10 @@ once when he kept statistics on his mail usage."
(setq message (mh-get-msg-num t)))
(if (looking-at mh-scan-refiled-msg-regexp)
(error "Message %d is refiled; undo refile before deleting" message))
- (if (looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before deleting" message))
- (if (looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before deleting" message))
+ (if (looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before deleting" message))
+ (if (looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before deleting" message))
(if (looking-at mh-scan-deleted-msg-regexp)
nil
(mh-set-folder-modified-p t)
@@ -1988,10 +1987,10 @@ be refiled."
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-deleted-msg-regexp)
(error "Message %d is deleted; undo delete before moving" message))
- ((looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before moving" message))
- ((looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before moving" message))
+ ((looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before moving" message))
+ ((looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before moving" message))
((looking-at mh-scan-refiled-msg-regexp)
(if (y-or-n-p
(format "Message %d already refiled; copy to %s as well? "
@@ -2010,7 +2009,7 @@ be refiled."
(run-hooks 'mh-refile-msg-hook)))))
(defun mh-undo-msg (msg)
- "Undo the deletion, refile, black- or whitelisting of one MSG.
+ "Undo the deletion, refile, block- or allowlisting of one MSG.
If MSG is nil then act on the message at point"
(save-excursion
(if (numberp msg)
@@ -2019,10 +2018,10 @@ If MSG is nil then act on the message at point"
(setq msg (mh-get-msg-num t)))
(cond ((memq msg mh-delete-list)
(setq mh-delete-list (delq msg mh-delete-list)))
- ((memq msg mh-blacklist)
- (setq mh-blacklist (delq msg mh-blacklist)))
- ((memq msg mh-whitelist)
- (setq mh-whitelist (delq msg mh-whitelist)))
+ ((memq msg mh-blocklist)
+ (setq mh-blocklist (delq msg mh-blocklist)))
+ ((memq msg mh-allowlist)
+ (setq mh-allowlist (delq msg mh-allowlist)))
(t
(dolist (folder-msg-list mh-refile-list)
(setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 309bcb4b49f..4a5e670c1ef 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -1,4 +1,4 @@
-;;; mh-funcs.el --- MH-E functions not everyone will use right away
+;;; mh-funcs.el --- MH-E functions not everyone will use right away -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
@@ -30,8 +30,6 @@
;; small support routines are needed, place them with the function;
;; otherwise, create a separate section for them.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -348,7 +346,7 @@ See `mh-store-msg' for a description of DIRECTORY."
(error "Error occurred during execution of %s" command)))))
;;;###mh-autoload
-(defun mh-undo-folder (&rest ignored)
+(defun mh-undo-folder (&rest _ignored)
"Undo all refiles and deletes in the current folder.
Arguments are IGNORED (for `revert-buffer')."
(interactive)
@@ -356,8 +354,8 @@ Arguments are IGNORED (for `revert-buffer')."
(yes-or-no-p "Undo all commands in folder? "))
(setq mh-delete-list nil
mh-refile-list nil
- mh-blacklist nil
- mh-whitelist nil
+ mh-blocklist nil
+ mh-allowlist nil
mh-seq-list nil
mh-next-direction 'forward)
(with-mh-folder-updating (nil)
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 6a9851662ab..cc60f7b6640 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -1,4 +1,4 @@
-;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus
+;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -129,7 +127,7 @@
(unless default
(setq default (mml-content-disposition type filename)))
(let ((disposition (completing-read
- (format "Disposition (default %s): " default)
+ (format-prompt "Disposition" default)
'(("attachment") ("inline") (""))
nil t nil nil default)))
(if (not (equal disposition ""))
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 18443992177..ceede0d07cb 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -1,4 +1,4 @@
-;;; mh-identity.el --- multiple identify support for MH-E
+;;; mh-identity.el --- multiple identify support for MH-E -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -33,8 +33,6 @@
;; in MH-Letter mode. The command `mh-insert-identity' can be used
;; to manually insert an identity.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -50,7 +48,7 @@ This is normally set as part of an Identity in
(defvar mh-identity-menu nil
"The Identity menu.")
-(defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu)
+(defalias 'mh-identity-make-menu-no-autoload #'mh-identity-make-menu)
;;;###mh-autoload
(defun mh-identity-make-menu ()
@@ -74,7 +72,7 @@ See `mh-identity-add-menu'."
(mapcar (lambda (arg)
`[,arg (mh-insert-identity ,arg) :style radio
:selected (equal mh-identity-local ,arg)])
- (mapcar 'car mh-identity-list))
+ (mapcar #'car mh-identity-list))
'(["None"
(mh-insert-identity "None") :style radio
:selected (not mh-identity-local)]
@@ -142,7 +140,7 @@ See `mh-identity-list'."
(completing-read
"Identity: "
(cons '("None")
- (mapcar 'list (mapcar 'car mh-identity-list)))
+ (mapcar #'list (mapcar #'car mh-identity-list)))
nil t default nil default))
(if (eq identity "None")
nil
@@ -171,8 +169,8 @@ See `mh-identity-list'."
"Identity: "
(if mh-identity-local
(cons '("None")
- (mapcar 'list (mapcar 'car mh-identity-list)))
- (mapcar 'list (mapcar 'car mh-identity-list)))
+ (mapcar #'list (mapcar #'car mh-identity-list)))
+ (mapcar #'list (mapcar #'car mh-identity-list)))
nil t)
nil))
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 32f731799b9..83cfe4f99f1 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -1,4 +1,4 @@
-;;; mh-inc.el --- MH-E "inc" and separate mail spool handling
+;;; mh-inc.el --- MH-E "inc" and separate mail spool handling -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2004, 2006-2021 Free Software Foundation, Inc.
@@ -28,8 +28,6 @@
;; inc can also be used to incorporate mail from multiple spool files
;; into separate folders. See "C-h v mh-inc-spool-list".
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -58,19 +56,15 @@
(mh-inc-spool-generator folder spool)
(mh-inc-spool-def-key key folder))))))
-(defalias 'mh-inc-spool-make-no-autoload 'mh-inc-spool-make)
+(defalias 'mh-inc-spool-make-no-autoload #'mh-inc-spool-make)
(defun mh-inc-spool-generator (folder spool)
"Create a command to inc into FOLDER from SPOOL file."
- (let ((folder1 (make-symbol "folder"))
- (spool1 (make-symbol "spool")))
- (set folder1 folder)
- (set spool1 spool)
- (setf (symbol-function (intern (concat "mh-inc-spool-" folder)))
- `(lambda ()
- ,(format "Inc spool file %s into folder %s." spool folder)
- (interactive)
- (mh-inc-folder ,spool1 (concat "+" ,folder1))))))
+ (defalias (symbol-function (intern (concat "mh-inc-spool-" folder)))
+ (lambda ()
+ (:documentation (format "Inc spool file %s into folder %s." spool folder))
+ (interactive)
+ (mh-inc-folder spool (concat "+" folder)))))
(defun mh-inc-spool-def-key (key folder)
"Define a KEY in `mh-inc-spool-map' to inc FOLDER and collect help string."
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index b49c6322492..6c3674811b0 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -1,4 +1,4 @@
-;;; mh-junk.el --- MH-E interface to anti-spam measures
+;;; mh-junk.el --- MH-E interface to anti-spam measures -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -26,16 +26,14 @@
;; Spam handling in MH-E.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
(require 'mh-scan)
;;;###mh-autoload
-(defun mh-junk-blacklist (range)
- "Blacklist RANGE as spam.
+(defun mh-junk-blocklist (range)
+ "Blocklist RANGE as spam.
This command trains the spam program in use (see the option
`mh-junk-program') with the content of RANGE and then handles the
@@ -47,44 +45,44 @@ read in interactive use.
For more information about using your particular spam fighting
program, see:
- - `mh-spamassassin-blacklist'
- - `mh-bogofilter-blacklist'
- - `mh-spamprobe-blacklist'"
- (interactive (list (mh-interactive-range "Blacklist")))
- (mh-iterate-on-range () range (mh-blacklist-a-msg nil))
- (if (looking-at mh-scan-blacklisted-msg-regexp)
+ - `mh-spamassassin-blocklist'
+ - `mh-bogofilter-blocklist'
+ - `mh-spamprobe-blocklist'"
+ (interactive (list (mh-interactive-range "Blocklist")))
+ (mh-iterate-on-range () range (mh-junk-blocklist-a-msg nil))
+ (if (looking-at mh-scan-blocklisted-msg-regexp)
(mh-next-msg)))
-(defun mh-blacklist-a-msg (message)
- "Blacklist MESSAGE.
-If MESSAGE is nil then the message at point is blacklisted.
-The hook `mh-blacklist-msg-hook' is called after you mark a message
-for blacklisting."
+(defun mh-junk-blocklist-a-msg (message)
+ "Blocklist MESSAGE.
+If MESSAGE is nil then the message at point is blocklisted.
+The hook `mh-blocklist-msg-hook' is called after you mark a message
+for blocklisting."
(save-excursion
(if (numberp message)
(mh-goto-msg message nil t)
(beginning-of-line)
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled; undo refile before blacklisting"
+ (error "Message %d is refiled; undo refile before blocklisting"
message))
((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted; undo delete before blacklisting"
+ (error "Message %d is deleted; undo delete before blocklisting"
message))
- ((looking-at mh-scan-whitelisted-msg-regexp)
- (error "Message %d is whitelisted; undo before blacklisting"
+ ((looking-at mh-scan-allowlisted-msg-regexp)
+ (error "Message %d is allowlisted; undo before blocklisting"
message))
- ((looking-at mh-scan-blacklisted-msg-regexp) nil)
+ ((looking-at mh-scan-blocklisted-msg-regexp) nil)
(t
(mh-set-folder-modified-p t)
- (setq mh-blacklist (cons message mh-blacklist))
+ (setq mh-blocklist (cons message mh-blocklist))
(if (not (memq message mh-seen-list))
(setq mh-seen-list (cons message mh-seen-list)))
- (mh-notate nil mh-note-blacklisted mh-cmd-note)
- (run-hooks 'mh-blacklist-msg-hook)))))
+ (mh-notate nil mh-note-blocklisted mh-cmd-note)
+ (run-hooks 'mh-blocklist-msg-hook)))))
;;;###mh-autoload
-(defun mh-junk-blacklist-disposition ()
+(defun mh-junk-blocklist-disposition ()
"Determines the fate of the selected spam."
(cond ((null mh-junk-disposition) nil)
((equal mh-junk-disposition "") "+")
@@ -96,73 +94,76 @@ for blacklisting."
(t (concat "+" mh-junk-disposition))))
;;;###mh-autoload
-(defun mh-junk-process-blacklist (range)
- "Blacklist RANGE as spam.
+(defun mh-junk-process-blocklist (range)
+ "Blocklist RANGE as spam.
This command trains the spam program in use (see the option
`mh-junk-program') with the content of RANGE and then handles the
message(s) as specified by the option `mh-junk-disposition'."
- (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
- (unless blacklist-func
+ (let ((blocklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist))))
+ (unless blocklist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
- (message "Blacklisting message %d..." msg)
- (funcall (symbol-function blacklist-func) msg)
- (message "Blacklisting message %d...done" msg))))
+ (funcall (symbol-function blocklist-func) msg))))
;;;###mh-autoload
(defun mh-junk-whitelist (range)
- "Whitelist RANGE as ham.
+ "Old name for `mh-junk-allowlist'; use \\[mh-junk-allowlist] instead."
+ (declare (obsolete mh-junk-allowlist "28.1"))
+ (interactive (list (mh-interactive-range "Allowlist")))
+ (mh-junk-allowlist range))
-This command reclassifies the RANGE as ham if it were incorrectly
+;;;###mh-autoload
+(defun mh-junk-allowlist (range)
+ "Allowlist RANGE as ham.
+
+This command reclassifies the RANGE as ham if it has been incorrectly
classified as spam (see the option `mh-junk-program'). It then
refiles the message into the \"+inbox\" folder.
Check the documentation of `mh-interactive-range' to see how
RANGE is read in interactive use."
- (interactive (list (mh-interactive-range "Whitelist")))
- (mh-iterate-on-range () range (mh-junk-whitelist-a-msg nil))
- (if (looking-at mh-scan-whitelisted-msg-regexp)
+ (interactive (list (mh-interactive-range "Allowlist")))
+ (mh-iterate-on-range () range (mh-junk-allowlist-a-msg nil))
+ (if (looking-at mh-scan-allowlisted-msg-regexp)
(mh-next-msg)))
-(defun mh-junk-whitelist-a-msg (message)
- "Whitelist MESSAGE.
-If MESSAGE is nil then the message at point is whitelisted. The
-hook `mh-whitelist-msg-hook' is called after you mark a message
-for whitelisting."
+(defun mh-junk-allowlist-a-msg (message)
+ "Allowlist MESSAGE.
+If MESSAGE is nil then the message at point is allowlisted. The
+hook `mh-allowlist-msg-hook' is called after you mark a message
+for allowlisting."
(save-excursion
(if (numberp message)
(mh-goto-msg message nil t)
(beginning-of-line)
(setq message (mh-get-msg-num t)))
(cond ((looking-at mh-scan-refiled-msg-regexp)
- (error "Message %d is refiled; undo refile before whitelisting"
+ (error "Message %d is refiled; undo refile before allowlisting"
message))
((looking-at mh-scan-deleted-msg-regexp)
- (error "Message %d is deleted; undo delete before whitelisting"
+ (error "Message %d is deleted; undo delete before allowlisting"
message))
- ((looking-at mh-scan-blacklisted-msg-regexp)
- (error "Message %d is blacklisted; undo before whitelisting"
+ ((looking-at mh-scan-blocklisted-msg-regexp)
+ (error "Message %d is blocklisted; undo before allowlisting"
message))
- ((looking-at mh-scan-whitelisted-msg-regexp) nil)
+ ((looking-at mh-scan-allowlisted-msg-regexp) nil)
(t
(mh-set-folder-modified-p t)
- (setq mh-whitelist (cons message mh-whitelist))
- (mh-notate nil mh-note-whitelisted mh-cmd-note)
- (run-hooks 'mh-whitelist-msg-hook)))))
+ (setq mh-allowlist (cons message mh-allowlist))
+ (mh-notate nil mh-note-allowlisted mh-cmd-note)
+ (run-hooks 'mh-allowlist-msg-hook)))))
;;;###mh-autoload
-(defun mh-junk-process-whitelist (range)
- "Whitelist RANGE as ham.
+(defun mh-junk-process-allowlist (range)
+ "Allowlist RANGE as ham.
This command reclassifies the RANGE as ham if it were incorrectly
classified as spam (see the option `mh-junk-program')."
- (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
- (unless whitelist-func
+ (let ((allowlist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist))))
+ (unless allowlist-func
(error "Customize `mh-junk-program' appropriately"))
(mh-iterate-on-range msg range
- (message "Whitelisting message %d..." msg)
- (funcall (symbol-function whitelist-func) msg)
- (message "Whitelisting message %d...done" msg))))
+ (funcall (symbol-function allowlist-func) msg))))
@@ -172,12 +173,12 @@ classified as spam (see the option `mh-junk-program')."
(defvar mh-sa-learn-executable (executable-find "sa-learn"))
;;;###mh-autoload
-(defun mh-spamassassin-blacklist (msg)
- "Blacklist MSG with SpamAssassin.
+(defun mh-spamassassin-blocklist (msg)
+ "Blocklist MSG with SpamAssassin.
SpamAssassin is one of the more popular spam filtering programs.
Get it from your local distribution or from the SpamAssassin web
-site at URL `http://spamassassin.org/'.
+site at URL `https://spamassassin.apache.org/'.
To use SpamAssassin, add the following recipes to
\".procmailrc\":
@@ -198,7 +199,7 @@ To use SpamAssassin, add the following recipes to
* ^X-Spam-Status: Yes
spam/.
-If you don't use \"spamc\", use \"spamassassin -P -a\".
+If you don't use \"spamc\", use \"spamassassin\".
Note that one of the recipes above throws away messages with a
score greater than or equal to 10. Here's how you can determine a
@@ -221,22 +222,22 @@ rules-based filters is a plethora of false positives so it is
worthwhile to check.
If SpamAssassin classifies a message incorrectly, or is unsure,
-you can use the MH-E commands \\[mh-junk-blacklist] and
-\\[mh-junk-whitelist].
+you can use the MH-E commands \\[mh-junk-blocklist] and
+\\[mh-junk-allowlist].
-The command \\[mh-junk-blacklist] adds a \"blacklist_from\" entry
+The command \\[mh-junk-blocklist] adds a \"blacklist_from\" entry
to \"~/spamassassin/user_prefs\", deletes the message, and sends
the message to the Razor, so that others might not see this spam.
If the \"sa-learn\" command is available, the message is also
recategorized as spam.
-The command \\[mh-junk-whitelist] adds a \"whitelist_from\" rule
+The command \\[mh-junk-allowlist] adds a \"whitelist_from\" rule
to the \"~/.spamassassin/user_prefs\" file. If the \"sa-learn\"
command is available, the message is also recategorized as ham.
Over time, you'll observe that the same host or domain occurs
repeatedly in the \"blacklist_from\" entries, so you might think
-that you could avoid future spam by blacklisting all mail from a
+that you could avoid future spam by blocklisting all mail from a
particular domain. The utility function
`mh-spamassassin-identify-spammers' helps you do precisely that.
This function displays a frequency count of the hosts and domains
@@ -245,35 +246,26 @@ in the \"blacklist_from\" entries from the last blank line in
information can be used so that you can replace multiple
\"blacklist_from\" entries with a single wildcard entry such as:
- blacklist_from *@*amazingoffersdirect2u.com
-
-In versions of SpamAssassin (2.50 and on) that support a Bayesian
-classifier, \\[mh-junk-blacklist] uses the program \"sa-learn\"
-to recategorize the message as spam. Neither MH-E, nor
-SpamAssassin, rebuilds the database after adding words, so you
-will need to run \"sa-learn --rebuild\" periodically. This can be
-done by adding the following to your crontab:
-
- 0 * * * * sa-learn --rebuild > /dev/null 2>&1"
+ blacklist_from *@*amazingoffersdirect2u.com"
(unless mh-spamassassin-executable
(error "Unable to find the spamassassin executable"))
(let ((current-folder mh-current-folder)
(msg-file (mh-msg-filename msg mh-current-folder))
(sender))
- (message "Reporting message %d..." msg)
+ (message "Reporting message %d as spam with spamassassin..." msg)
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamassassin-executable msg-file mh-junk-background nil
- ;;"--report" "--remove-from-whitelist"
- "-r" "-R") ; spamassassin V2.20
+ ;; -R removes from allowlist
+ "--report" "-R")
(when mh-sa-learn-executable
- (message "Recategorizing message %d as spam..." msg)
+ (message "Recategorizing message %d as spam with sa-learn..." msg)
(mh-truncate-log-buffer)
(call-process mh-sa-learn-executable msg-file mh-junk-background nil
- "--single" "--spam" "--local" "--no-rebuild")))
- (message "Blacklisting sender of message %d..." msg)
+ "--spam" "--local" "--no-sync")))
+ (message "Blocklisting sender of message %d..." msg)
(with-current-buffer (get-buffer-create mh-temp-buffer)
(erase-buffer)
(call-process (expand-file-name mh-scan-prog mh-progs)
@@ -285,18 +277,18 @@ done by adding the following to your crontab:
(progn
(setq sender (match-string 0))
(mh-spamassassin-add-rule "blacklist_from" sender)
- (message "Blacklisting sender of message %d...done" msg))
- (message "Blacklisting sender of message %d...not done (from my address)" msg)))))
+ (message "Blocklisting sender of message %d...done" msg))
+ (message "Blocklisting sender of message %d...not done (from my address)" msg)))))
;;;###mh-autoload
-(defun mh-spamassassin-whitelist (msg)
- "Whitelist MSG with SpamAssassin.
+(defun mh-spamassassin-allowlist (msg)
+ "Allowlist MSG with SpamAssassin.
-The \\[mh-junk-whitelist] command adds a \"whitelist_from\" rule to
+The \\[mh-junk-allowlist] command adds a \"whitelist_from\" rule to
the \"~/.spamassassin/user_prefs\" file. If the \"sa-learn\" command
is available, the message is also recategorized as ham.
-See `mh-spamassassin-blacklist' for more information."
+See `mh-spamassassin-blocklist' for more information."
(unless mh-spamassassin-executable
(error "Unable to find the spamassassin executable"))
(let ((msg-file (mh-msg-filename msg mh-current-folder))
@@ -306,27 +298,28 @@ See `mh-spamassassin-blacklist' for more information."
(erase-buffer)
(message "Removing spamassassin markup from message %d..." msg)
(call-process mh-spamassassin-executable msg-file t nil
- ;; "--remove-markup"
- "-d") ; spamassassin V2.20
+ "--remove-markup")
(if show-buffer
(kill-buffer show-buffer))
(write-file msg-file)
(when mh-sa-learn-executable
- (message "Recategorizing message %d as ham..." msg)
+ (message "Recategorizing message %d as ham with sa-learn..." msg)
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-sa-learn-executable msg-file mh-junk-background nil
- "--single" "--ham" "--local" "--no-rebuild")))
- (message "Whitelisting sender of message %d..." msg)
+ "--ham" "--local" "--no-sync")))
+ (message "Allowlisting sender of message %d..." msg)
(setq from
(car (mh-funcall-if-exists
ietf-drums-parse-address (mh-get-header-field "From:"))))
(kill-buffer nil)
- (unless (or (null from) (equal from ""))
- (mh-spamassassin-add-rule "whitelist_from" from))
- (message "Whitelisting sender of message %d...done" msg))))
+ (if (or (null from) (equal from ""))
+ (message "Allowlisting sender of message %d...%s"
+ msg "not done (cannot identify sender)")
+ (mh-spamassassin-add-rule "whitelist_from" from)
+ (message "Allowlisting sender of message %d...done" msg)))))
(defun mh-spamassassin-add-rule (rule body)
"Add a new rule to \"~/.spamassassin/user_prefs\".
@@ -396,8 +389,8 @@ information can be used so that you can replace multiple
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
;;;###mh-autoload
-(defun mh-bogofilter-blacklist (msg)
- "Blacklist MSG with bogofilter.
+(defun mh-bogofilter-blocklist (msg)
+ "Blocklist MSG with bogofilter.
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the bogofilter web site at URL
@@ -434,7 +427,7 @@ To use bogofilter, add the following recipes to \".procmailrc\":
spam/unsure/.
If bogofilter classifies a message incorrectly, or is unsure, you can
-use the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist]
+use the MH-E commands \\[mh-junk-blocklist] and \\[mh-junk-allowlist]
to update bogofilter's training.
The \"Bogofilter FAQ\" suggests that you run the following
@@ -447,28 +440,32 @@ occasionally to shrink the database:
The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
+ (message "Blocklisting message %d with bogofilter..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-bogofilter-executable msg-file mh-junk-background
- nil "-s"))))
+ nil "-s")
+ (message "Blocklisting message %d with bogofilter...done" msg))))
;;;###mh-autoload
-(defun mh-bogofilter-whitelist (msg)
- "Whitelist MSG with bogofilter.
+(defun mh-bogofilter-allowlist (msg)
+ "Allowlist MSG with bogofilter.
-See `mh-bogofilter-blacklist' for more information."
+See `mh-bogofilter-blocklist' for more information."
(unless mh-bogofilter-executable
(error "Unable to find the bogofilter executable"))
+ (message "Allowlisting message %d with bogofilter..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-bogofilter-executable msg-file mh-junk-background
- nil "-n"))))
+ nil "-n")
+ (message "Allowlisting message %d with bogofilter...done" msg))))
@@ -477,8 +474,8 @@ See `mh-bogofilter-blacklist' for more information."
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
;;;###mh-autoload
-(defun mh-spamprobe-blacklist (msg)
- "Blacklist MSG with SpamProbe.
+(defun mh-spamprobe-blocklist (msg)
+ "Blocklist MSG with SpamProbe.
SpamProbe is a Bayesian spam filtering program. Get it from your
local distribution or from the SpamProbe web site at URL
@@ -501,32 +498,36 @@ To use SpamProbe, add the following recipes to \".procmailrc\":
spam/.
If SpamProbe classifies a message incorrectly, you can use the
-MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to
+MH-E commands \\[mh-junk-blocklist] and \\[mh-junk-allowlist] to
update SpamProbe's training."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
+ (message "Blocklisting message %d with spamprobe..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamprobe-executable msg-file mh-junk-background
- nil "spam"))))
+ nil "spam")
+ (message "Blocklisting message %d with spamprobe...done" msg))))
;;;###mh-autoload
-(defun mh-spamprobe-whitelist (msg)
- "Whitelist MSG with SpamProbe.
+(defun mh-spamprobe-allowlist (msg)
+ "Allowlist MSG with SpamProbe.
-See `mh-spamprobe-blacklist' for more information."
+See `mh-spamprobe-blocklist' for more information."
(unless mh-spamprobe-executable
(error "Unable to find the spamprobe executable"))
+ (message "Allowlisting message %d with spamprobe..." msg)
(let ((msg-file (mh-msg-filename msg mh-current-folder)))
(mh-truncate-log-buffer)
;; Put call-process output in log buffer if we are saving it
;; (this happens if mh-junk-background is t).
(with-current-buffer mh-log-buffer
(call-process mh-spamprobe-executable msg-file mh-junk-background
- nil "good"))))
+ nil "good")
+ (message "Allowlisting message %d with spamprobe...done" msg))))
(provide 'mh-junk)
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index f5ad73d800d..ae5b80d5807 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -1,4 +1,4 @@
-;;; mh-letter.el --- MH-Letter mode
+;;; mh-letter.el --- MH-Letter mode -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
@@ -31,8 +31,6 @@
;; mh-utils.el. That will help prevent the loading of this file until
;; a message is actually composed.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -334,15 +332,15 @@ order).
;; Maybe we want to use the existing Mail menu from mail-mode in
;; 9.0; in the mean time, let's remove it since the redundancy will
;; only produce confusion.
- (define-key mh-letter-mode-map [menu-bar mail] 'undefined)
+ (define-key mh-letter-mode-map [menu-bar mail] #'undefined)
(mh-do-in-xemacs (easy-menu-remove mail-menubar-menu))
(setq fill-column mh-letter-fill-column)
(add-hook 'completion-at-point-functions
- 'mh-letter-completion-at-point nil 'local)
+ #'mh-letter-completion-at-point nil 'local)
;; If text-mode-hook turned on auto-fill, tune it for messages
(when auto-fill-function
(make-local-variable 'auto-fill-function)
- (setq auto-fill-function 'mh-auto-fill-for-letter)))
+ (setq auto-fill-function #'mh-auto-fill-for-letter)))
@@ -390,10 +388,7 @@ This command leaves the mark before the letter and point after it."
(or mh-sent-from-msg (nth 0 (mh-translate-range folder "cur")))
(nth 0 (mh-translate-range folder "cur"))))
(message
- (read-string (concat "Message number"
- (or (and default
- (format " (default %d): " default))
- ": "))
+ (read-string (format-prompt "Message number" default)
nil nil
(if (numberp default)
(int-to-string default)
@@ -851,7 +846,7 @@ body."
(forward-line)))))
;;;###mh-autoload
-(defun mh-position-on-field (field &optional ignored)
+(defun mh-position-on-field (field &optional _ignored)
"Move to the end of the FIELD in the header.
Move to end of entire header if FIELD not found.
Returns non-nil if FIELD was found.
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index 036522f3ddd..39cf7c5d271 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -1,4 +1,4 @@
-;;; mh-limit.el --- MH-E display limits
+;;; mh-limit.el --- MH-E display limits -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2003, 2006-2021 Free Software Foundation, Inc.
@@ -25,8 +25,6 @@
;; "Poor man's threading" by psg.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -237,7 +235,7 @@ Return number of messages put in the sequence:
(setq list (cons (mh-get-msg-num t) list)))
(if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject))
;; sort the result into a sequence
- (let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
+ (let ((sorted-list (sort (copy-sequence list) #'mh-lessp)))
(while sorted-list
(mh-add-msgs-to-seq (car sorted-list) 'subject nil)
(setq sorted-list (cdr sorted-list)))
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 70df9e6b0f2..ef702525b7b 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1,4 +1,4 @@
-;;; mh-mime.el --- MH-E MIME support
+;;; mh-mime.el --- MH-E MIME support -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
@@ -36,8 +36,6 @@
;; MIME option to mh-forward command to move to content-description
;; insertion point.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -190,9 +188,9 @@ Set from last use.")
;; XEmacs doesn't care.
(set-keymap-parent map mh-show-mode-map))
(mh-do-in-gnu-emacs
- (define-key map [mouse-2] 'mh-push-button))
+ (define-key map [mouse-2] #'mh-push-button))
(mh-do-in-xemacs
- (define-key map '(button2) 'mh-push-button))
+ (define-key map '(button2) #'mh-push-button))
(dolist (c mh-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
@@ -214,11 +212,11 @@ Set from last use.")
(let ((map (make-sparse-keymap)))
(unless (>= (string-to-number emacs-version) 21)
(set-keymap-parent map mh-show-mode-map))
- (define-key map "\r" 'mh-press-button)
+ (define-key map "\r" #'mh-press-button)
(mh-do-in-gnu-emacs
- (define-key map [mouse-2] 'mh-push-button))
+ (define-key map [mouse-2] #'mh-push-button))
(mh-do-in-xemacs
- (define-key map '(button2) 'mh-push-button))
+ (define-key map '(button2) #'mh-push-button))
map))
@@ -259,9 +257,7 @@ usually reads the file \"/etc/mailcap\"."
(methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
(mailcap-mime-info type 'all)))
(def (caar methods))
- (prompt (format "Viewer%s: " (if def
- (format " (default %s)" def)
- "")))
+ (prompt (format-prompt "Viewer" def))
(method (completing-read prompt methods nil nil nil nil def))
(folder mh-show-folder-buffer)
(buffer-read-only nil))
@@ -395,9 +391,9 @@ do the work."
((and (or prompt
(equal t mh-mime-save-parts-default-directory))
mh-mime-save-parts-directory)
- (read-directory-name (format
- "Store in directory (default %s): "
- mh-mime-save-parts-directory)
+ (read-directory-name (format-prompt
+ "Store in directory"
+ mh-mime-save-parts-directory)
"" mh-mime-save-parts-directory t ""))
((stringp mh-mime-save-parts-default-directory)
mh-mime-save-parts-default-directory)
@@ -413,7 +409,7 @@ do the work."
(cd directory)
(setq mh-mime-save-parts-directory directory)
(let ((initial-size (mh-truncate-log-buffer)))
- (apply 'call-process
+ (apply #'call-process
(expand-file-name command mh-progs) nil t nil
(mh-list-to-string (list folder msg "-auto"
(if (not (mh-variant-p 'nmh))
@@ -452,7 +448,7 @@ decoding the same message multiple times."
(let ((b (point))
(clean-message-header mh-clean-message-header-flag)
(invisible-headers mh-invisible-header-fields-compiled)
- (visible-headers nil))
+ ) ;; (visible-headers nil)
(save-excursion
(save-restriction
(narrow-to-region b b)
@@ -474,7 +470,7 @@ decoding the same message multiple times."
(cond (clean-message-header
(mh-clean-msg-header (point-min)
invisible-headers
- visible-headers)
+ nil) ;; visible-headers
(goto-char (point-min)))
(t
(mh-start-of-uncleaned-message)))
@@ -489,15 +485,11 @@ decoding the same message multiple times."
(mh-display-emphasis)
(mm-handle-set-undisplayer
handle
- `(lambda ()
- (let (buffer-read-only)
- (if (fboundp 'remove-specifier)
- ;; This is only valid on XEmacs.
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
+ (let ((beg (point-min-marker))
+ (end (point-max-marker)))
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region beg end)))))))))
;;;###mh-autoload
(defun mh-decode-message-header ()
@@ -783,7 +775,7 @@ This is only useful if a Content-Disposition header is not present."
(funcall media-test handle) ; Since mm-inline-large-images is T,
; this only tells us if the image is
; something that emacs can display
- (let* ((image (mm-get-image handle)))
+ (let ((image (mm-get-image handle)))
(or (mh-do-in-xemacs
(and (mh-funcall-if-exists glyphp image)
(< (glyph-width image)
@@ -792,7 +784,7 @@ This is only useful if a Content-Disposition header is not present."
(or mh-max-inline-image-height
(window-pixel-height)))))
(mh-do-in-gnu-emacs
- (let ((size (mh-funcall-if-exists image-size image)))
+ (let ((size (and (fboundp 'image-size) (image-size image))))
(and size
(< (cdr size) (or mh-max-inline-image-height
(1- (window-height))))
@@ -1225,7 +1217,7 @@ The option `mh-compose-insertion' controls what type of tags are inserted."
t)
t t)))
(list description folder range)))
- (let ((messages (mapconcat 'identity (mh-list-to-string range) " ")))
+ (let ((messages (mapconcat #'identity (mh-list-to-string range) " ")))
(dolist (message (mh-translate-range folder messages))
(if (equal mh-compose-insertion 'mml)
(mh-mml-forward-message description folder (format "%s" message))
@@ -1258,11 +1250,7 @@ See also \\[mh-mh-to-mime]."
(interactive (list
(mml-minibuffer-read-description)
(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
- (read-string (concat "Messages"
- (if (numberp mh-sent-from-msg)
- (format " (default %d): "
- mh-sent-from-msg)
- ": ")))))
+ (read-string (format-prompt "Messages" mh-sent-from-msg))))
(beginning-of-line)
(insert "#forw [")
(and description
@@ -1596,7 +1584,7 @@ the possible security methods (see `mh-mml-method-default')."
(if current-prefix-arg
(let ((def (or (car mh-mml-cryptographic-method-history)
mh-mml-method-default)))
- (completing-read (format "Method (default %s): " def)
+ (completing-read (format-prompt "Method" def)
'(("pgp") ("pgpmime") ("smime"))
nil t nil 'mh-mml-cryptographic-method-history def))
mh-mml-method-default))
@@ -1731,7 +1719,7 @@ Optional argument DEFAULT is returned if a type isn't entered."
(type (or (and (not (equal probed-type "application/octet-stream"))
probed-type)
(completing-read
- (format "Content type (default %s): " default)
+ (format-prompt "Content type" default)
(mapcar #'list (mailcap-mime-types))))))
(if (not (equal type ""))
type
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index 513a1bc953d..2074ff6f8f3 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -1,4 +1,4 @@
-;;; mh-print.el --- MH-E printing support
+;;; mh-print.el --- MH-E printing support -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -207,8 +205,9 @@ Consider using \\[mh-ps-print-msg] instead."
;; Print scan listing if we have more than one message.
(if (> (length msgs) 1)
(let* ((msgs-string
- (mapconcat 'identity (mh-list-to-string
- (mh-coalesce-msg-list msgs)) " "))
+ (mapconcat #'identity (mh-list-to-string
+ (mh-coalesce-msg-list msgs))
+ " "))
(lpr-command
(format mh-lpr-command-format
(cond ((listp range)
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index cec331389b0..10235209dce 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -1,4 +1,4 @@
-;;; mh-scan.el --- MH-E scan line constants and utilities
+;;; mh-scan.el --- MH-E scan line constants and utilities -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
@@ -27,8 +27,6 @@
;; This file contains constants and a few functions for interpreting
;; scan lines.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -115,8 +113,8 @@ expression which matches the body text as in the default of
not correct, the body fragment will not be highlighted with the
face `mh-folder-body'.")
-(defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B"
- "This regular expression matches blacklisted (spam) messages.
+(defvar mh-scan-blocklisted-msg-regexp "^\\( *[0-9]+\\)B"
+ "This regular expression matches blocklisted (spam) messages.
It must match from the beginning of the line. Note that the
default setting of `mh-folder-font-lock-keywords' expects this
@@ -127,9 +125,9 @@ matches the message number as in the default of
This expression includes the leading space within parenthesis
since it looks better to highlight it as well. The highlighting
-is done with the face `mh-folder-blacklisted'. This regular
+is done with the face `mh-folder-blocklisted'. This regular
expression should be correct as it is needed by non-fontification
-functions. See also `mh-note-blacklisted'.")
+functions. See also `mh-note-blocklisted'.")
(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
"This regular expression matches the current message.
@@ -297,21 +295,21 @@ non-fontification functions.")
This is used to eliminate error messages that are occasionally
produced by \"inc\".")
-(defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W"
- "This regular expression matches whitelisted (non-spam) messages.
+(defvar mh-scan-allowlisted-msg-regexp "^\\( *[0-9]+\\)A"
+ "This regular expression matches allowlisted (non-spam) messages.
It must match from the beginning of the line. Note that the
default setting of `mh-folder-font-lock-keywords' expects this
expression to contain at least one parenthesized expression which
matches the message number as in the default of
- \"^\\\\( *[0-9]+\\\\)W\".
+ \"^\\\\( *[0-9]+\\\\)A\".
This expression includes the leading space within parenthesis
since it looks better to highlight it as well. The highlighting
-is done with the face `mh-folder-whitelisted'. This regular
+is done with the face `mh-folder-allowlisted'. This regular
expression should be correct as it is needed by non-fontification
-functions. See also `mh-note-whitelisted'.")
+functions. See also `mh-note-allowlisted'.")
@@ -335,8 +333,8 @@ This column will have one of the values: \" \", \"^\", \"D\", \"B\", \"W\", \"+\
\" \" is the default value,
\"^\" is the `mh-note-refiled' character,
\"D\" is the `mh-note-deleted' character,
- \"B\" is the `mh-note-blacklisted' character,
- \"W\" is the `mh-note-whitelisted' character, and
+ \"B\" is the `mh-note-blocklisted' character,
+ \"A\" is the `mh-note-allowlisted' character, and
\"+\" is the `mh-note-cur' character.")
(defvar mh-scan-destination-width 1
@@ -401,9 +399,9 @@ This column will only ever have spaces in it.")
;; Alphabetical.
-(defvar mh-note-blacklisted ?B
- "Messages that have been blacklisted are marked by this character.
-See also `mh-scan-blacklisted-msg-regexp'.")
+(defvar mh-note-blocklisted ?B
+ "Messages that have been blocklisted are marked by this character.
+See also `mh-scan-blocklisted-msg-regexp'.")
(defvar mh-note-cur ?+
"The current message (in MH, not in MH-E) is marked by this character.
@@ -438,9 +436,9 @@ See also `mh-scan-refiled-msg-regexp'.")
Messages in the \"search\" sequence are marked by this character as
well.")
-(defvar mh-note-whitelisted ?W
- "Messages that have been whitelisted are marked by this character.
-See also `mh-scan-whitelisted-msg-regexp'.")
+(defvar mh-note-allowlisted ?A
+ "Messages that have been allowlisted are marked by this character.
+See also `mh-scan-allowlisted-msg-regexp'.")
@@ -497,7 +495,7 @@ with `mh-scan-msg-format-string'."
(width 0))
(with-current-buffer tmp-buffer
(erase-buffer)
- (apply 'call-process
+ (apply #'call-process
(expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
(list folder "last" "-format" "%(msg)"))
(goto-char (point-min))
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index 05ba12d7617..e03c9dc83f7 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1,4 +1,4 @@
-;;; mh-search --- MH-Search mode
+;;; mh-search.el --- MH-Search mode -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
@@ -39,8 +39,6 @@
;; documentation will direct you to the specific instructions for
;; your particular searcher.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -274,23 +272,23 @@ folder containing the index search results."
t)))
;; Copy the search results over.
- (maphash #'(lambda (folder msgs)
- (let ((cur (car (mh-translate-range folder "cur")))
- (msgs (sort (cl-loop
- for msg being the hash-keys of msgs
- collect msg)
- #'<)))
- (mh-exec-cmd "refile" msgs "-src" folder
- "-link" index-folder)
- ;; Restore cur to old value, that refile changed
- (when cur
- (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
- "-sequence"
- "cur" (format "%s" cur)))
- (cl-loop for msg in msgs
- do (cl-incf result-count)
- (setf (gethash result-count origin-map)
- (cons folder msg)))))
+ (maphash (lambda (folder msgs)
+ (let ((cur (car (mh-translate-range folder "cur")))
+ (msgs (sort (cl-loop
+ for msg being the hash-keys of msgs
+ collect msg)
+ #'<)))
+ (mh-exec-cmd "refile" msgs "-src" folder
+ "-link" index-folder)
+ ;; Restore cur to old value, that refile changed
+ (when cur
+ (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
+ "-sequence"
+ "cur" (format "%s" cur)))
+ (cl-loop for msg in msgs
+ do (cl-incf result-count)
+ (setf (gethash result-count origin-map)
+ (cons folder msg)))))
folder-results-map)
;; Vist the results folder.
@@ -332,7 +330,7 @@ configuration and is used when the search folder is dismissed."
(interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t)
(current-window-configuration)))
;; FIXME: `pick-folder' is unused!
- (let ((pick-folder (if (equal folder "+") mh-current-folder folder)))
+ (let () ;; (pick-folder (if (equal folder "+") mh-current-folder folder))
(switch-to-buffer-other-window "search-pattern")
(if (or (zerop (buffer-size))
(not (y-or-n-p "Reuse pattern? ")))
@@ -356,7 +354,7 @@ configuration and is used when the search folder is dismissed."
"---------\n")
(mh-search-mode)
(goto-char (point-min))
- (dotimes (i 5)
+ (dotimes (_ 5)
(add-text-properties (point) (1+ (point)) '(front-sticky t))
(add-text-properties (- (mh-line-end-position) 2)
(1- (mh-line-end-position))
@@ -453,7 +451,7 @@ search all folders."
(defvar mh-flists-search-folders)
-(defun mh-flists-execute (&rest ignored)
+(defun mh-flists-execute (&rest _ignored)
"Execute flists.
Search for messages belonging to `mh-flists-sequence' in the
folders specified by `mh-flists-search-folders'. If
@@ -880,7 +878,7 @@ used to search."
folder-path
(format "%s/" folder-path)))))
-(defalias 'mh-swish++-next-result 'mh-swish-next-result)
+(defalias 'mh-swish++-next-result #'mh-swish-next-result)
(defun mh-swish++-regexp-builder (regexp-list)
"Generate query for swish++.
@@ -1136,10 +1134,10 @@ REGEXP-LIST is an alist of fields and values."
((atom (cadr expr)) `(or (and ,expr)))
((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr)))
((eq (caadr expr) 'and) (mh-mairix-convert-to-sop*
- `(or ,@(mapcar #'(lambda (x) `(not ,x))
+ `(or ,@(mapcar (lambda (x) `(not ,x))
(cdadr expr)))))
((eq (caadr expr) 'or) (mh-mairix-convert-to-sop*
- `(and ,@(mapcar #'(lambda (x) `(not ,x))
+ `(and ,@(mapcar (lambda (x) `(not ,x))
(cdadr expr)))))
(t (error "Unreachable: %s" expr))))
@@ -1450,7 +1448,7 @@ being the list of messages originally from that folder."
(defun mh-index-execute-commands ()
"Perform the outstanding operations on the actual messages.
The copies in the searched folder are then deleted, refiled,
-blacklisted and whitelisted to get the desired result. Before
+blocklisted and allowlisted to get the desired result. Before
processing the messages we make sure that the message is
identical to the one that the user has marked in the index
buffer."
@@ -1467,12 +1465,12 @@ buffer."
(with-current-buffer folder
(let ((old-refile-list mh-refile-list)
(old-delete-list mh-delete-list)
- (old-blacklist mh-blacklist)
- (old-whitelist mh-whitelist))
+ (old-blocklist mh-blocklist)
+ (old-allowlist mh-allowlist))
(setq mh-refile-list nil
mh-delete-list msgs
- mh-blacklist nil
- mh-whitelist nil)
+ mh-blocklist nil
+ mh-allowlist nil)
(unwind-protect (mh-execute-commands)
(setq mh-refile-list
(mapcar (lambda (x)
@@ -1484,11 +1482,11 @@ buffer."
mh-delete-list
(cl-loop for x in old-delete-list
unless (memq x msgs) collect x)
- mh-blacklist
- (cl-loop for x in old-blacklist
+ mh-blocklist
+ (cl-loop for x in old-blocklist
unless (memq x msgs) collect x)
- mh-whitelist
- (cl-loop for x in old-whitelist
+ mh-allowlist
+ (cl-loop for x in old-allowlist
unless (memq x msgs) collect x))
(mh-set-folder-modified-p (mh-outstanding-commands-p))
(when (mh-outstanding-commands-p)
@@ -1496,8 +1494,8 @@ buffer."
(mh-index-matching-source-msgs (append (cl-loop for x in mh-refile-list
append (cdr x))
mh-delete-list
- mh-blacklist
- mh-whitelist)
+ mh-blocklist
+ mh-allowlist)
t))
folders)))
@@ -1620,7 +1618,7 @@ garbled."
(cl-loop for seq in seq-list
do (apply #'mh-exec-cmd "mark" mh-current-folder
"-sequence" (symbol-name (car seq)) "-add"
- (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
+ (mapcar (lambda (x) (format "%s" x)) (cdr seq))))))
;;;###mh-autoload
(defun mh-create-sequence-map (seq-list)
@@ -1853,7 +1851,7 @@ PROC is used to convert the value to actual data."
(1+ last-slash) (1- last-space)))
(buffer-substring-no-properties (1+ last-space) end))))))
-(defalias 'mh-md5-parser 'mh-openssl-parser)
+(defalias 'mh-md5-parser #'mh-openssl-parser)
;;;###mh-autoload
(defun mh-index-update-maps (folder &optional origin-map)
@@ -1945,4 +1943,4 @@ folder buffer."
;; sentence-end-double-space: nil
;; End:
-;;; mh-search ends here
+;;; mh-search.el ends here
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index e8a03f6704b..9cdf39f7f1e 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -1,4 +1,4 @@
-;;; mh-seq.el --- MH-E sequences support
+;;; mh-seq.el --- MH-E sequences support -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 2001-2021 Free Software Foundation, Inc.
@@ -26,8 +26,6 @@
;; Sequences are stored in the alist `mh-seq-list' in the form:
;; ((seq-name msgs ...) (seq-name msgs ...) ...)
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -156,7 +154,7 @@ The list appears in a buffer named \"*MH-E Sequences*\"."
(let ((name (mh-seq-name (car seq-list)))
(sorted-seq-msgs
(mh-coalesce-msg-list
- (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
+ (sort (copy-sequence (mh-seq-msgs (car seq-list))) #'<)))
name-spec)
(insert (setq name-spec (format (format "%%%ss:" max-len) name)))
(while sorted-seq-msgs
@@ -191,7 +189,7 @@ MESSAGE appears."
(cond (dest-folder (format " (to be refiled to %s)" dest-folder))
(deleted-flag (format " (to be deleted)"))
(t ""))
- (mapconcat 'concat
+ (mapconcat #'concat
(mh-list-to-string (mh-seq-containing-msg message t))
" "))))
@@ -390,10 +388,7 @@ Prompt with PROMPT, raise an error if the sequence is empty and
the NOT-EMPTY flag is non-nil, and supply an optional DEFAULT
sequence. A reply of `%' defaults to the first sequence
containing the current message."
- (let* ((input (completing-read (format "%s sequence%s: " prompt
- (if default
- (format " (default %s)" default)
- ""))
+ (let* ((input (completing-read (format-prompt "%s sequence" default prompt)
(mh-seq-names mh-seq-list)
nil nil nil 'mh-sequence-history))
(seq (cond ((equal input "%")
@@ -494,13 +489,13 @@ folder buffer are not updated."
;; Add to a SEQUENCE each message the list of MSGS.
(if (and (mh-valid-seq-p seq) (not (mh-folder-name-p seq)))
(if msgs
- (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
+ (apply #'mh-exec-cmd "mark" mh-current-folder "-add"
"-sequence" (symbol-name seq)
(mh-coalesce-msg-list msgs)))))
(defun mh-canonicalize-sequence (msgs)
"Sort MSGS in decreasing order and remove duplicates."
- (let* ((sorted-msgs (sort (copy-sequence msgs) '>))
+ (let* ((sorted-msgs (sort (copy-sequence msgs) #'>))
(head sorted-msgs))
(while (cdr head)
(if (= (car head) (cadr head))
@@ -565,7 +560,7 @@ OP is one of `widen' and `unthread'."
(defvar mh-range-seq-names)
(defvar mh-range-history ())
(defvar mh-range-completion-map (copy-keymap minibuffer-local-completion-map))
-(define-key mh-range-completion-map " " 'self-insert-command)
+(define-key mh-range-completion-map " " #'self-insert-command)
;;;###mh-autoload
(defun mh-interactive-range (range-prompt &optional default)
@@ -646,13 +641,10 @@ should be replaced with:
((stringp default) default)
((symbolp default) (symbol-name default))))
(prompt (cond ((and guess large default)
- (format "%s (folder has %s messages, default %s)"
- prompt (car counts) default))
- ((and guess large)
- (format "%s (folder has %s messages)"
- prompt (car counts)))
+ (format-prompt "%s (folder has %s messages)"
+ default prompt (car counts)))
(default
- (format "%s (default %s)" prompt default))))
+ (format-prompt prompt default))))
(minibuffer-local-completion-map mh-range-completion-map)
(seq-list (if (eq folder mh-current-folder)
mh-seq-list
@@ -662,7 +654,7 @@ should be replaced with:
(mh-seq-names seq-list)))
(input (cond ((and (not ask-flag) unseen) (symbol-name mh-unseen-seq))
((and (not ask-flag) (not large)) "all")
- (t (completing-read (format "%s: " prompt)
+ (t (completing-read prompt
'mh-range-completion-function nil nil
nil 'mh-range-history default))))
msg-list)
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 9ad843c3259..803f07e02b2 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -1,4 +1,4 @@
-;;; mh-show.el --- MH-Show mode
+;;; mh-show.el --- MH-Show mode -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
@@ -26,8 +26,6 @@
;; Mode for showing messages.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -136,7 +134,7 @@ displayed."
(show-window (get-buffer-window mh-show-buffer))
(display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
(if (not (eq (next-window (minibuffer-window)) (selected-window)))
- (delete-other-windows)) ; force ourself to the top window
+ (delete-other-windows)) ; force ourselves to the top window
(mh-in-show-buffer (mh-show-buffer)
(setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
(if (and show-window
@@ -187,7 +185,7 @@ Sets the current buffer to the show buffer."
(set-buffer folder)
;; When Gnus uses external displayers it has to keep handles longer. So
;; we will delete these handles when mh-quit is called on the folder. It
- ;; would be nicer if there are weak pointers in emacs lisp, then we could
+ ;; would be nicer if there are weak pointers in Emacs Lisp, then we could
;; get the garbage collector to do this for us.
(unless (mh-buffer-data)
(setf (mh-buffer-data) (mh-make-buffer-data)))
@@ -195,7 +193,7 @@ Sets the current buffer to the show buffer."
(let ((formfile mh-mhl-format-file)
(clean-message-header mh-clean-message-header-flag)
(invisible-headers mh-invisible-header-fields-compiled)
- (visible-headers nil)
+ ;; (visible-headers nil)
(msg-filename (mh-msg-filename msg-num folder-name))
(show-buffer mh-show-buffer)
(mm-inline-media-tests mh-mm-inline-media-tests))
@@ -241,7 +239,7 @@ Sets the current buffer to the show buffer."
(cond (clean-message-header
(mh-clean-msg-header (point-min)
invisible-headers
- visible-headers)
+ nil) ;; visible-headers
(goto-char (point-min)))
(t
(mh-start-of-uncleaned-message)))
@@ -465,8 +463,10 @@ still visible.\n")
(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
-(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
-(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
+(mh-defun-show-buffer mh-show-junk-allowlist mh-junk-allowlist)
+(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-allowlist)
+(make-obsolete 'mh-show-junk-whitelist 'mh-show-junk-allowlist "28.1")
+(mh-defun-show-buffer mh-show-junk-blocklist mh-junk-blocklist)
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
(mh-defun-show-buffer mh-show-index-sequenced-messages
@@ -635,7 +635,8 @@ still visible.\n")
(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
"?" mh-prefix-help
- "b" mh-show-junk-blacklist
+ "a" mh-show-junk-allowlist
+ "b" mh-show-junk-blocklist
"w" mh-show-junk-whitelist)
(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
@@ -862,7 +863,7 @@ See also `mh-folder-mode'.
(turn-on-font-lock))
(when mh-decode-mime-flag
(mh-make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
+ (add-hook 'kill-buffer-hook #'mh-mime-cleanup nil t))
(mh-do-in-xemacs
(easy-menu-add mh-show-sequence-menu)
(easy-menu-add mh-show-message-menu)
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 7cbd42c8ea2..76ef990d825 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -1,4 +1,4 @@
-;;; mh-speed.el --- MH-E speedbar support
+;;; mh-speed.el --- MH-E speedbar support -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -26,8 +26,6 @@
;; Future versions should only use flists.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -100,9 +98,9 @@
;; Alphabetical.
-(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
+(defalias 'mh-speed-contract-folder #'mh-speed-toggle)
-(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
+(defalias 'mh-speed-expand-folder #'mh-speed-toggle)
(defun mh-speed-refresh ()
"Regenerates the list of folders in the speedbar.
@@ -202,9 +200,9 @@ created."
(mh-speed-flists nil))))
;;;###mh-autoload
-(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
+(defalias 'mh-show-speedbar-buttons #'mh-folder-speedbar-buttons)
;;;###mh-autoload
-(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
+(defalias 'mh-letter-speedbar-buttons #'mh-folder-speedbar-buttons)
(defmacro mh-speed-select-attached-frame ()
"Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
@@ -431,7 +429,7 @@ flists is run only for that one folder."
(setq mh-speed-flists-folder nil)
(mh-process-kill-without-query mh-speed-flists-process)
(set-process-filter mh-speed-flists-process
- 'mh-speed-parse-flists-output)))))))
+ #'mh-speed-parse-flists-output)))))))
;; Copied from mh-make-folder-list-filter...
;; XXX Refactor to use mh-make-folder-list-filer?
@@ -443,7 +441,7 @@ be handled next."
(position 0)
line-end line folder unseen total)
(unwind-protect
- (while (setq line-end (string-match "\n" output position))
+ (while (setq line-end (string-search "\n" output position))
(setq line (format "%s%s"
mh-speed-partial-line
(substring output position line-end))
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index 365746259af..89b0dbd9798 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -1,4 +1,4 @@
-;;; mh-thread.el --- MH-E threading support
+;;; mh-thread.el --- MH-E threading support -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2004, 2006-2021 Free Software Foundation, Inc.
@@ -69,8 +69,6 @@
;; (5) Better canonicalizing for message identifier and subject
;; strings.
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -233,7 +231,7 @@ sibling."
(push index msg-list)))
(forward-line))
(mh-scan-folder mh-current-folder
- (mapcar #'(lambda (x) (format "%s" x))
+ (mapcar (lambda (x) (format "%s" x))
(mh-coalesce-msg-list msg-list))
t))
(when mh-index-data
@@ -591,7 +589,7 @@ Only information about messages in MSG-LIST are added to the tree."
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
"-width" "10000" "-format"
"%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
- folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
+ folder (mapcar (lambda (x) (format "%s" x)) msg-list)))
(goto-char (point-min))
(let ((roots ())
(case-fold-search t))
@@ -635,9 +633,9 @@ Only information about messages in MSG-LIST are added to the tree."
(mh-thread-remove-parent-link id)
(mh-thread-add-link (car ancestors) id)))
(mh-thread-add-link (car ancestors) (cadr ancestors)))))))
- (maphash #'(lambda (_k v)
- (when (null (mh-container-parent v))
- (push v roots)))
+ (maphash (lambda (_k v)
+ (when (null (mh-container-parent v))
+ (push v roots)))
mh-thread-id-table)
(setq roots (mh-thread-prune-containers roots))
(prog1 (setq roots (mh-thread-group-by-subject roots))
@@ -720,25 +718,25 @@ For now it will take the last string inside angles."
mh-thread-history)
(mh-thread-remove-parent-link node)))))
(let ((results ()))
- (maphash #'(lambda (_k v)
- (when (and (null (mh-container-parent v))
- (gethash (mh-message-id (mh-container-message v))
- mh-thread-id-index-map))
- (push v results)))
+ (maphash (lambda (_k v)
+ (when (and (null (mh-container-parent v))
+ (gethash (mh-message-id (mh-container-message v))
+ mh-thread-id-index-map))
+ (push v results)))
mh-thread-id-table)
(mh-thread-sort-containers results))))
(defun mh-thread-sort-containers (containers)
"Sort a list of message CONTAINERS to be in ascending order wrt index."
(sort containers
- #'(lambda (x y)
- (when (and (mh-container-message x) (mh-container-message y))
- (let* ((id-x (mh-message-id (mh-container-message x)))
- (id-y (mh-message-id (mh-container-message y)))
- (index-x (gethash id-x mh-thread-id-index-map))
- (index-y (gethash id-y mh-thread-id-index-map)))
- (and (integerp index-x) (integerp index-y)
- (< index-x index-y)))))))
+ (lambda (x y)
+ (when (and (mh-container-message x) (mh-container-message y))
+ (let* ((id-x (mh-message-id (mh-container-message x)))
+ (id-y (mh-message-id (mh-container-message y)))
+ (index-x (gethash id-x mh-thread-id-index-map))
+ (index-y (gethash id-y mh-thread-id-index-map)))
+ (and (integerp index-x) (integerp index-y)
+ (< index-x index-y)))))))
(defvar mh-thread-last-ancestor)
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 7dbddbc891b..94aa8dd4a92 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -1,4 +1,4 @@
-;;; mh-tool-bar.el --- MH-E tool bar support
+;;; mh-tool-bar.el --- MH-E tool bar support -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -356,7 +354,7 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
'(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults))
"List of buttons to include in MH-Folder tool bar."
:group 'mh-tool-bar
- :set 'mh-tool-bar-folder-buttons-set
+ :set #'mh-tool-bar-folder-buttons-set
:type '(set ,@(cl-loop for x in folder-buttons
for y in folder-docs
collect `(const :tag ,y ,x)))
@@ -367,7 +365,7 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
'(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults))
"List of buttons to include in MH-Letter tool bar."
:group 'mh-tool-bar
- :set 'mh-tool-bar-letter-buttons-set
+ :set #'mh-tool-bar-letter-buttons-set
:type '(set ,@(cl-loop for x in letter-buttons
for y in letter-docs
collect `(const :tag ,y ,x)))
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index d7c607df5c3..bbce17013b1 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -1,4 +1,4 @@
-;;; mh-utils.el --- MH-E general utilities
+;;; mh-utils.el --- MH-E general utilities -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1995, 1997, 2000-2021 Free Software Foundation,
;; Inc.
@@ -24,8 +24,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -268,7 +266,7 @@ and displayed in a help buffer."
(interactive)
(let* ((help (or help-messages
(cdr (assoc nil (assoc major-mode mh-help-messages)))))
- (text (substitute-command-keys (mapconcat 'identity help ""))))
+ (text (substitute-command-keys (mapconcat #'identity help ""))))
(with-electric-help
(lambda ()
(insert text))
@@ -298,7 +296,7 @@ and displayed in a help buffer."
This is the inverse of `mh-read-msg-list', which expands ranges.
Message lists passed to MH programs should be processed by this
function to avoid exceeding system command line argument limits."
- (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
+ (let ((msgs (sort (copy-sequence messages) #'mh-greaterp))
(range-high nil)
(prev -1)
(ranges nil))
@@ -380,7 +378,7 @@ names and the function is called when OUTPUT is available."
(prevailing-match-data (match-data))
line-end folder)
(unwind-protect
- (while (setq line-end (string-match "\n" output position))
+ (while (setq line-end (string-search "\n" output position))
(setq folder (format "+%s%s"
mh-flists-partial-line
(substring output position line-end)))
@@ -544,8 +542,8 @@ nested folders within them."
(mh-sub-folders-actual folder)))
(t match))))
(if add-trailing-slash-flag
- (mapcar #'(lambda (x)
- (if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
+ (mapcar (lambda (x)
+ (if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
sub-folders)
sub-folders)))
@@ -669,7 +667,7 @@ three arguments so we bind this variable to t or nil.
This variable should never be set.")
(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map))
-(define-key mh-folder-completion-map " " 'minibuffer-complete) ;Why???
+(define-key mh-folder-completion-map " " #'minibuffer-complete) ;Why???
(defvar mh-speed-flists-inhibit-flag nil)
@@ -704,7 +702,7 @@ See Info node `(elisp) Programmed Completion' for details."
(let ((slash (mh-search-from-end ?/ orig-name)))
(if slash (1+ slash)
(if (string-match "\\`\\+" orig-name) 1 0)))
- (if (cdr flag) (string-match "/" (cdr flag)))))
+ (if (cdr flag) (string-search "/" (cdr flag)))))
((eq flag nil)
(let ((try-res
(try-completion
@@ -730,8 +728,7 @@ See Info node `(elisp) Programmed Completion' for details."
(t (file-directory-p path))))))))
;; Shush compiler.
-(mh-do-in-xemacs
- (defvar completion-root-regexp))
+(defvar completion-root-regexp) ;; Apparently used in XEmacs
(defun mh-folder-completing-read (prompt default allow-root-folder-flag)
"Read folder name with PROMPT and default result DEFAULT.
@@ -758,10 +755,9 @@ function will accept the folder +, which means all folders when
used in searching."
(if (null default)
(setq default ""))
- (let* ((default-string (cond (default-string (format " (default %s)" default-string))
- ((equal "" default) "")
- (t (format " (default %s)" default))))
- (prompt (format "%s folder%s: " prompt default-string))
+ (let* ((default-string (or default-string
+ (if (equal default "") nil default)))
+ (prompt (format-prompt "%s folder" default-string prompt))
(mh-current-folder-name mh-current-folder)
read-name folder-name)
(while (and (setq read-name (mh-folder-completing-read
@@ -925,10 +921,10 @@ Handle RFC 822 (or later) continuation lines."
(defvar mh-hidden-header-keymap
(let ((map (make-sparse-keymap)))
(mh-do-in-gnu-emacs
- (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
+ (define-key map [mouse-2] #'mh-letter-toggle-header-field-display-button))
(mh-do-in-xemacs
(define-key map '(button2)
- 'mh-letter-toggle-header-field-display-button))
+ #'mh-letter-toggle-header-field-display-button))
map))
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 036575a8e64..d4d5c5c3784 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -1,4 +1,4 @@
-;;; mh-xface.el --- MH-E X-Face and Face header field display
+;;; mh-xface.el --- MH-E X-Face and Face header field display -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
@@ -23,8 +23,6 @@
;;; Commentary:
-;;; Change Log:
-
;;; Code:
(require 'mh-e)
@@ -365,7 +363,7 @@ Replace the ?/ character with a ?! character and append .png.
Also replaces special characters with `mh-url-hexify-string'
since not all characters, such as :, are valid within Windows
filenames. In addition, replaces * with %2a. See URL
-`http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'."
+`https://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'."
(format "%s/%s.png" mh-x-image-cache-directory
(mh-replace-regexp-in-string
"\\*" "%2a"
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 03cc70c0d4d..ffcd5d88abe 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -122,10 +122,17 @@ This metadata is an alist. Currently understood keys are:
returns a string to append to STRING.
- `affixation-function': function to prepend/append a prefix/suffix to
entries. Takes one argument (COMPLETIONS) and should return a list
- of completions with a list of either two elements: completion
- and suffix, or three elements: completion, its prefix
- and suffix. This function takes priority over `annotation-function'
- when both are provided, so only this function is used.
+ of annotated completions. The elements of the list must be
+ three-element lists: completion, its prefix and suffix. This
+ function takes priority over `annotation-function' when both are
+ provided, so only this function is used.
+- `group-function': function for grouping the completion candidates.
+ Takes two arguments: a completion candidate (COMPLETION) and a
+ boolean flag (TRANSFORM). If TRANSFORM is nil, the function
+ returns the group title of the group to which the candidate
+ belongs. The returned title may be nil. Otherwise the function
+ returns the transformed candidate. The transformation can remove a
+ redundant prefix, which is displayed in the group title.
- `display-sort-function': function to sort entries in *Completions*.
Takes one argument (COMPLETIONS) and should return a new list
of completions. Can operate destructively.
@@ -271,7 +278,7 @@ the form (concat S2 S)."
(let* ((str (if (string-prefix-p s1 string completion-ignore-case)
(concat s2 (substring string (length s1)))))
(res (if str (complete-with-action action table str pred))))
- (when res
+ (when (or res (eq (car-safe action) 'boundaries))
(cond
((eq (car-safe action) 'boundaries)
(let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
@@ -488,8 +495,17 @@ for use at QPOS."
(qsuffix (cdr action))
(ufull (if (zerop (length qsuffix)) ustring
(funcall unquote (concat string qsuffix))))
- (_ (cl-assert (string-prefix-p ustring ufull)))
- (usuffix (substring ufull (length ustring)))
+ ;; If (not (string-prefix-p ustring ufull)) we have a problem:
+ ;; unquoting the qfull gives something "unrelated" to ustring.
+ ;; E.g. "~/" and "/" where "~//" gets unquoted to just "/" (see
+ ;; bug#47678).
+ ;; In that case we can't even tell if we're right before the
+ ;; "/" or right after it (aka if this "/" is from qstring or
+ ;; from qsuffix), thus which usuffix to use is very unclear.
+ (usuffix (if (string-prefix-p ustring ufull)
+ (substring ufull (length ustring))
+ ;; FIXME: Maybe "" is preferable/safer?
+ qsuffix))
(boundaries (completion-boundaries ustring table pred usuffix))
(qlboundary (car (funcall requote (car boundaries) string)))
(qrboundary (if (zerop (cdr boundaries)) 0 ;Common case.
@@ -725,14 +741,16 @@ If ARGS are provided, then pass MESSAGE through `format-message'."
;; Don't overwrite the face properties the caller has set
(text-properties-at 0 message))
(setq message (apply #'propertize message minibuffer-message-properties)))
- (let ((ol (make-overlay (point-max) (point-max) nil t t))
- ;; A quit during sit-for normally only interrupts the sit-for,
- ;; but since minibuffer-message is used at the end of a command,
- ;; at a time when the command has virtually finished already, a C-g
- ;; should really cause an abort-recursive-edit instead (i.e. as if
- ;; the C-g had been typed at top-level). Binding inhibit-quit here
- ;; is an attempt to get that behavior.
- (inhibit-quit t))
+ ;; Put overlay either on `minibuffer-message' property, or at EOB.
+ (let* ((ovpos (minibuffer--message-overlay-pos))
+ (ol (make-overlay ovpos ovpos nil t t))
+ ;; A quit during sit-for normally only interrupts the sit-for,
+ ;; but since minibuffer-message is used at the end of a command,
+ ;; at a time when the command has virtually finished already, a C-g
+ ;; should really cause an abort-recursive-edit instead (i.e. as if
+ ;; the C-g had been typed at top-level). Binding inhibit-quit here
+ ;; is an attempt to get that behavior.
+ (inhibit-quit t))
(unwind-protect
(progn
(unless (zerop (length message))
@@ -741,6 +759,12 @@ If ARGS are provided, then pass MESSAGE through `format-message'."
;; before or after the string, so let's spoon-feed it the pos.
(put-text-property 0 1 'cursor t message))
(overlay-put ol 'after-string message)
+ ;; Make sure the overlay with the message is displayed before
+ ;; any other overlays in that position, in case they have
+ ;; resize-mini-windows set to nil and the other overlay strings
+ ;; are too long for the mini-window width. This makes sure the
+ ;; temporary message will always be visible.
+ (overlay-put ol 'priority 1100)
(sit-for (or minibuffer-message-timeout 1000000)))
(delete-overlay ol)))))
@@ -762,8 +786,10 @@ and `clear-minibuffer-message' called automatically via
(defvar minibuffer-message-overlay nil)
(defun minibuffer--message-overlay-pos ()
- "Return position where `set-minibuffer-message' shall put message overlay."
- ;; Starting from point, look for non-nil 'minibuffer-message'
+ "Return position where minibuffer message functions shall put message overlay.
+The minibuffer message functions include `minibuffer-message' and
+`set-minibuffer-message'."
+ ;; Starting from point, look for non-nil `minibuffer-message'
;; property, and return its position. If none found, return the EOB
;; position.
(let* ((pt (point))
@@ -808,7 +834,7 @@ via `set-message-function'."
;; The current C cursor code doesn't know to use the overlay's
;; marker's stickiness to figure out whether to place the cursor
;; before or after the string, so let's spoon-feed it the pos.
- (put-text-property 0 1 'cursor 1 message))
+ (put-text-property 0 1 'cursor t message))
(overlay-put minibuffer-message-overlay 'after-string message)
;; Make sure the overlay with the message is displayed before
;; any other overlays in that position, in case they have
@@ -856,6 +882,12 @@ If the current buffer is not a minibuffer, erase its entire contents."
;; is on, the field doesn't cover the entire minibuffer contents.
(delete-region (minibuffer-prompt-end) (point-max)))
+(defun minibuffer--completion-prompt-end ()
+ (let ((end (minibuffer-prompt-end)))
+ (if (< (point) end)
+ (user-error "Can't complete in prompt")
+ end)))
+
(defvar completion-show-inline-help t
"If non-nil, print helpful inline messages during completion.")
@@ -1129,6 +1161,44 @@ completion candidates than this number."
:version "24.1"
:type completion--cycling-threshold-type)
+(defcustom completions-group nil
+ "Enable grouping of completion candidates in the *Completions* buffer.
+See also `completions-group-format' and `completions-group-sort'."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom completions-group-sort nil
+ "Sort groups in the *Completions* buffer.
+
+The value can either be nil to disable sorting, `alphabetical' for
+alphabetical sorting or a custom sorting function. The sorting
+function takes and returns an alist of groups, where each element is a
+pair of a group title string and a list of group candidate strings."
+ :type '(choice (const :tag "No sorting" nil)
+ (const :tag "Alphabetical sorting" alphabetical)
+ function)
+ :version "28.1")
+
+(defcustom completions-group-format
+ (concat
+ (propertize " " 'face 'completions-group-separator)
+ (propertize " %s " 'face 'completions-group-title)
+ (propertize " " 'face 'completions-group-separator
+ 'display '(space :align-to right)))
+ "Format string used for the group title."
+ :type 'string
+ :version "28.1")
+
+(defface completions-group-title
+ '((t :inherit shadow :slant italic))
+ "Face used for the title text of the candidate group headlines."
+ :version "28.1")
+
+(defface completions-group-separator
+ '((t :inherit shadow :strike-through t))
+ "Face used for the separator lines between the candidate groups."
+ :version "28.1")
+
(defun completion--cycle-threshold (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
(over (completion--category-override cat 'cycle)))
@@ -1285,10 +1355,9 @@ If no characters can be completed, display a list of possible completions.
If you repeat this command after it displayed such a list,
scroll the window of possible completions."
(interactive)
- (when (<= (minibuffer-prompt-end) (point))
- (completion-in-region (minibuffer-prompt-end) (point-max)
- minibuffer-completion-table
- minibuffer-completion-predicate)))
+ (completion-in-region (minibuffer--completion-prompt-end) (point-max)
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
(defun completion--in-region-1 (beg end)
;; If the previous command was not this,
@@ -1346,6 +1415,68 @@ scroll the window of possible completions."
(if (eq (car bounds) base) md-at-point
(completion-metadata (substring string 0 base) table pred))))
+(defun minibuffer--sort-by-key (elems keyfun)
+ "Return ELEMS sorted by increasing value of their KEYFUN.
+KEYFUN takes an element of ELEMS and should return a numerical value."
+ (mapcar #'cdr
+ (sort (mapcar (lambda (x) (cons (funcall keyfun x) x)) elems)
+ #'car-less-than-car)))
+
+(defun minibuffer--sort-by-position (hist elems)
+ "Sort ELEMS by their position in HIST."
+ (let ((hash (make-hash-table :test #'equal :size (length hist)))
+ (index 0))
+ ;; Record positions in hash
+ (dolist (c hist)
+ (unless (gethash c hash)
+ (puthash c index hash))
+ (cl-incf index))
+ (minibuffer--sort-by-key
+ elems (lambda (x) (gethash x hash most-positive-fixnum)))))
+
+(defun minibuffer--sort-by-length-alpha (elems)
+ "Sort ELEMS first by length, then alphabetically."
+ (sort elems (lambda (c1 c2)
+ (or (< (length c1) (length c2))
+ (and (= (length c1) (length c2))
+ (string< c1 c2))))))
+
+(defun minibuffer--sort-preprocess-history (base)
+ "Preprocess history.
+Remove completion BASE prefix string from history elements."
+ (let* ((def (if (stringp minibuffer-default)
+ minibuffer-default
+ (car-safe minibuffer-default)))
+ (hist (and (not (eq minibuffer-history-variable t))
+ (symbol-value minibuffer-history-variable)))
+ (base-size (length base)))
+ ;; Default comes first.
+ (setq hist (if def (cons def hist) hist))
+ ;; Drop base string from the history elements.
+ (if (= base-size 0)
+ hist
+ (delq nil (mapcar
+ (lambda (c)
+ (when (string-prefix-p base c)
+ (substring c base-size)))
+ hist)))))
+
+(defun minibuffer--group-by (group-fun sort-fun elems)
+ "Group ELEMS by GROUP-FUN and sort groups by SORT-FUN."
+ (let ((groups))
+ (dolist (cand elems)
+ (let* ((key (funcall group-fun cand nil))
+ (group (assoc key groups)))
+ (if group
+ (setcdr group (cons cand (cdr group)))
+ (push (list key cand) groups))))
+ (setq groups (nreverse groups)
+ groups (mapc (lambda (x)
+ (setcdr x (nreverse (cdr x))))
+ groups)
+ groups (funcall sort-fun groups))
+ (mapcan #'cdr groups)))
+
(defun completion-all-sorted-completions (&optional start end)
(or completion-all-sorted-completions
(let* ((start (or start (minibuffer-prompt-end)))
@@ -1375,23 +1506,18 @@ scroll the window of possible completions."
(setq all (delete-dups all))
(setq last (last all))
- (cond
- (sort-fun
- (setq all (funcall sort-fun all)))
- (t
- ;; Prefer shorter completions, by default.
- (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
- (if (minibufferp)
- ;; Prefer recently used completions and put the default, if
- ;; it exists, on top.
- (let ((hist (symbol-value minibuffer-history-variable)))
- (setq all
- (sort all
- (lambda (c1 c2)
- (cond ((equal c1 minibuffer-default) t)
- ((equal c2 minibuffer-default) nil)
- (t (> (length (member c1 hist))
- (length (member c2 hist))))))))))))
+ (if sort-fun
+ (setq all (funcall sort-fun all))
+ ;; Sort first by length and alphabetically.
+ (setq all (minibuffer--sort-by-length-alpha all))
+ ;; Sort by history position, put the default, if it
+ ;; exists, on top.
+ (when (minibufferp)
+ (setq all (minibuffer--sort-by-position
+ (minibuffer--sort-preprocess-history
+ (substring string 0 base-size))
+ all))))
+
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
@@ -1409,12 +1535,12 @@ scroll the window of possible completions."
(unless completion-cycling
(minibuffer-force-complete nil nil 'dont-cycle))
(completion--complete-and-exit
- (minibuffer-prompt-end) (point-max) #'exit-minibuffer
+ (minibuffer--completion-prompt-end) (point-max) #'exit-minibuffer
;; If the previous completion completed to an element which fails
;; test-completion, then we shouldn't exit, but that should be rare.
(lambda ()
(if minibuffer--require-match
- (minibuffer-message "Incomplete")
+ (completion--message "Incomplete")
;; If a match is not required, exit after all.
(exit-minibuffer)))))
@@ -1427,7 +1553,7 @@ DONT-CYCLE tells the function not to setup cycling."
;; FIXME: Need to deal with the extra-size issue here as well.
;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
- (let* ((start (copy-marker (or start (minibuffer-prompt-end))))
+ (let* ((start (copy-marker (or start (minibuffer--completion-prompt-end))))
(end (or end (point-max)))
;; (md (completion--field-metadata start))
(all (completion-all-sorted-completions start end))
@@ -1498,7 +1624,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
`minibuffer-confirm-exit-commands', and accept the input
otherwise."
(interactive)
- (completion-complete-and-exit (minibuffer-prompt-end) (point-max)
+ (completion-complete-and-exit (minibuffer--completion-prompt-end) (point-max)
#'exit-minibuffer))
(defun completion-complete-and-exit (beg end exit-function)
@@ -1664,17 +1790,12 @@ is added, provided that matches some possible completion.
Return nil if there is no valid completion, else t."
(interactive)
(completion-in-region--single-word
- (minibuffer-prompt-end) (point-max)
- minibuffer-completion-table minibuffer-completion-predicate))
-
-(defun completion-in-region--single-word (beg end collection
- &optional predicate)
- (let ((minibuffer-completion-table collection)
- (minibuffer-completion-predicate predicate))
- (pcase (completion--do-completion beg end
- #'completion--try-word-completion)
+ (minibuffer--completion-prompt-end) (point-max)))
+
+(defun completion-in-region--single-word (beg end)
+ (pcase (completion--do-completion beg end #'completion--try-word-completion)
(#b000 nil)
- (_ t))))
+ (_ t)))
(defface completions-annotations '((t :inherit (italic shadow)))
"Face to use for annotations in the *Completions* buffer.")
@@ -1697,15 +1818,17 @@ or appended to completions."
:type 'boolean
:version "28.1")
-(defun completion--insert-strings (strings)
+(defun completion--insert-strings (strings &optional group-fun)
"Insert a list of STRINGS into the current buffer.
-Uses columns to keep the listing readable but compact.
-It also eliminates runs of equal strings."
+The candidate strings are inserted into the buffer depending on the
+completions format as specified by the variable `completions-format'.
+Runs of equal candidate strings are eliminated. GROUP-FUN is a
+`group-function' used for grouping the completion candidates."
(when (consp strings)
(let* ((length (apply #'max
(mapcar (lambda (s)
(if (consp s)
- (apply #'+ (mapcar #'string-width s))
+ (apply #'+ (mapcar #'string-width s))
(string-width s)))
strings)))
(window (get-buffer-window (current-buffer) 0))
@@ -1716,104 +1839,158 @@ It also eliminates runs of equal strings."
;; Don't allocate more columns than we can fill.
;; Windows can't show less than 3 lines anyway.
(max 1 (/ (length strings) 2))))
- (colwidth (/ wwidth columns))
- (column 0)
- (rows (/ (length strings) columns))
- (row 0)
- (first t)
- (laststring nil))
+ (colwidth (/ wwidth columns)))
(unless (or tab-stop-list (null completion-tab-width)
(zerop (mod colwidth completion-tab-width)))
;; Align to tab positions for the case
;; when the caller uses tabs inside prefix.
(setq colwidth (- colwidth (mod colwidth completion-tab-width))))
- ;; The insertion should be "sensible" no matter what choices were made
- ;; for the parameters above.
- (dolist (str strings)
- (unless (equal laststring str) ; Remove (consecutive) duplicates.
- (setq laststring str)
+ (funcall (intern (format "completion--insert-%s" completions-format))
+ strings group-fun length wwidth colwidth columns))))
+
+(defun completion--insert-horizontal (strings group-fun
+ length wwidth
+ colwidth _columns)
+ (let ((column 0)
+ (first t)
+ (last-title nil)
+ (last-string nil))
+ (dolist (str strings)
+ (unless (equal last-string str) ; Remove (consecutive) duplicates.
+ (setq last-string str)
+ (when group-fun
+ (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+ (unless (equal title last-title)
+ (setq last-title title)
+ (when title
+ (insert (if first "" "\n") (format completions-group-format title) "\n")
+ (setq column 0
+ first t)))))
+ (unless first
;; FIXME: `string-width' doesn't pay attention to
;; `display' properties.
- (let ((length (if (consp str)
- (apply #'+ (mapcar #'string-width str))
- (string-width str))))
- (cond
- ((eq completions-format 'one-column)
- ;; Nothing special
- )
- ((eq completions-format 'vertical)
- ;; Vertical format
- (when (> row rows)
- (forward-line (- -1 rows))
- (setq row 0 column (+ column colwidth)))
- (when (> column 0)
- (end-of-line)
- (while (> (current-column) column)
- (if (eobp)
- (insert "\n")
- (forward-line 1)
- (end-of-line)))
- (insert " \t")
- (set-text-properties (1- (point)) (point)
- `(display (space :align-to ,column)))))
- (t
- ;; Horizontal format
- (unless first
- (if (< wwidth (+ (max colwidth length) column))
- ;; No space for `str' at point, move to next line.
- (progn (insert "\n") (setq column 0))
- (insert " \t")
- ;; Leave the space unpropertized so that in the case we're
- ;; already past the goal column, there is still
- ;; a space displayed.
- (set-text-properties (1- (point)) (point)
- ;; We can set tab-width using
- ;; completion-tab-width, but
- ;; the caller can prefer using
- ;; \t to align prefixes.
- `(display (space :align-to ,column)))
- nil))))
- (setq first nil)
- (if (not (consp str))
- (put-text-property (point) (progn (insert str) (point))
- 'mouse-face 'highlight)
- ;; If `str' is a list that has 2 elements,
- ;; then the second element is a suffix annotation.
- ;; If `str' has 3 elements, then the second element
- ;; is a prefix, and the third element is a suffix.
- (let* ((prefix (when (nth 2 str) (nth 1 str)))
- (suffix (or (nth 2 str) (nth 1 str))))
- (when prefix
- (let ((beg (point))
- (end (progn (insert prefix) (point))))
- (put-text-property beg end 'mouse-face nil)))
- (put-text-property (point) (progn (insert (car str)) (point))
- 'mouse-face 'highlight)
- (let ((beg (point))
- (end (progn (insert suffix) (point))))
- (put-text-property beg end 'mouse-face nil)
- ;; Put the predefined face only when suffix
- ;; is added via annotation-function without prefix,
- ;; and when the caller doesn't use own face.
- (unless (or prefix (text-property-not-all
- 0 (length suffix) 'face nil suffix))
- (font-lock-prepend-text-property
- beg end 'face 'completions-annotations)))))
- (cond
- ((eq completions-format 'one-column)
- (insert "\n"))
- ((eq completions-format 'vertical)
- ;; Vertical format
- (if (> column 0)
- (forward-line)
- (insert "\n"))
- (setq row (1+ row)))
- (t
- ;; Horizontal format
- ;; Next column to align to.
- (setq column (+ column
- ;; Round up to a whole number of columns.
- (* colwidth (ceiling length colwidth))))))))))))
+ (if (< wwidth (+ column (max colwidth
+ (if (consp str)
+ (apply #'+ (mapcar #'string-width str))
+ (string-width str)))))
+ ;; No space for `str' at point, move to next line.
+ (progn (insert "\n") (setq column 0))
+ (insert " \t")
+ ;; Leave the space unpropertized so that in the case we're
+ ;; already past the goal column, there is still
+ ;; a space displayed.
+ (set-text-properties (1- (point)) (point)
+ ;; We can set tab-width using
+ ;; completion-tab-width, but
+ ;; the caller can prefer using
+ ;; \t to align prefixes.
+ `(display (space :align-to ,column)))
+ nil))
+ (setq first nil)
+ (completion--insert str group-fun)
+ ;; Next column to align to.
+ (setq column (+ column
+ ;; Round up to a whole number of columns.
+ (* colwidth (ceiling length colwidth))))))))
+
+(defun completion--insert-vertical (strings group-fun
+ _length _wwidth
+ colwidth columns)
+ (while strings
+ (let ((group nil)
+ (column 0)
+ (row 0)
+ (rows)
+ (last-string nil))
+ (if group-fun
+ (let* ((str (car strings))
+ (title (funcall group-fun (if (consp str) (car str) str) nil)))
+ (while (and strings
+ (equal title (funcall group-fun
+ (if (consp (car strings))
+ (car (car strings))
+ (car strings))
+ nil)))
+ (push (car strings) group)
+ (pop strings))
+ (setq group (nreverse group)))
+ (setq group strings
+ strings nil))
+ (setq rows (/ (length group) columns))
+ (when group-fun
+ (let* ((str (car group))
+ (title (funcall group-fun (if (consp str) (car str) str) nil)))
+ (when title
+ (goto-char (point-max))
+ (insert (format completions-group-format title) "\n"))))
+ (dolist (str group)
+ (unless (equal last-string str) ; Remove (consecutive) duplicates.
+ (setq last-string str)
+ (when (> row rows)
+ (forward-line (- -1 rows))
+ (setq row 0 column (+ column colwidth)))
+ (when (> column 0)
+ (end-of-line)
+ (while (> (current-column) column)
+ (if (eobp)
+ (insert "\n")
+ (forward-line 1)
+ (end-of-line)))
+ (insert " \t")
+ (set-text-properties (1- (point)) (point)
+ `(display (space :align-to ,column))))
+ (completion--insert str group-fun)
+ (if (> column 0)
+ (forward-line)
+ (insert "\n"))
+ (setq row (1+ row)))))))
+
+(defun completion--insert-one-column (strings group-fun &rest _)
+ (let ((last-title nil) (last-string nil))
+ (dolist (str strings)
+ (unless (equal last-string str) ; Remove (consecutive) duplicates.
+ (setq last-string str)
+ (when group-fun
+ (let ((title (funcall group-fun (if (consp str) (car str) str) nil)))
+ (unless (equal title last-title)
+ (setq last-title title)
+ (when title
+ (insert (format completions-group-format title) "\n")))))
+ (completion--insert str group-fun)
+ (insert "\n")))))
+
+(defun completion--insert (str group-fun)
+ (if (not (consp str))
+ (add-text-properties
+ (point)
+ (progn
+ (insert
+ (if group-fun
+ (funcall group-fun str 'transform)
+ str))
+ (point))
+ `(mouse-face highlight completion--string ,str))
+ ;; If `str' is a list that has 2 elements,
+ ;; then the second element is a suffix annotation.
+ ;; If `str' has 3 elements, then the second element
+ ;; is a prefix, and the third element is a suffix.
+ (let* ((prefix (when (nth 2 str) (nth 1 str)))
+ (suffix (or (nth 2 str) (nth 1 str))))
+ (when prefix
+ (let ((beg (point))
+ (end (progn (insert prefix) (point))))
+ (put-text-property beg end 'mouse-face nil)))
+ (completion--insert (car str) group-fun)
+ (let ((beg (point))
+ (end (progn (insert suffix) (point))))
+ (put-text-property beg end 'mouse-face nil)
+ ;; Put the predefined face only when suffix
+ ;; is added via annotation-function without prefix,
+ ;; and when the caller doesn't use own face.
+ (unless (or prefix (text-property-not-all
+ 0 (length suffix) 'face nil suffix))
+ (font-lock-prepend-text-property
+ beg end 'face 'completions-annotations))))))
(defvar completion-setup-hook nil
"Normal hook run at the end of setting up a completion list buffer.
@@ -1873,7 +2050,7 @@ and with BASE-SIZE appended as the last element."
completions)
base-size))))
-(defun display-completion-list (completions &optional common-substring)
+(defun display-completion-list (completions &optional common-substring group-fun)
"Display the list of completions, COMPLETIONS, using `standard-output'.
Each element may be just a symbol or string
or may be a list of two strings to be printed as if concatenated.
@@ -1883,7 +2060,9 @@ alternative, the second serves as annotation.
The actual completion alternatives, as inserted, are given `mouse-face'
properties of `highlight'.
At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'."
+It can find the completion buffer in `standard-output'.
+GROUP-FUN is a `group-function' used for grouping the completion
+candidates."
(declare (advertised-calling-convention (completions) "24.4"))
(if common-substring
(setq completions (completion-hilit-commonality
@@ -1896,7 +2075,7 @@ It can find the completion buffer in `standard-output'."
(let ((standard-output (current-buffer))
(completion-setup-hook nil))
(with-suppressed-warnings ((callargs display-completion-list))
- (display-completion-list completions common-substring)))
+ (display-completion-list completions common-substring group-fun)))
(princ (buffer-string)))
(with-current-buffer standard-output
@@ -1904,7 +2083,7 @@ It can find the completion buffer in `standard-output'."
(if (null completions)
(insert "There are no possible completions of what you have typed.")
(insert "Possible completions are:\n")
- (completion--insert-strings completions))))
+ (completion--insert-strings completions group-fun))))
(run-hooks 'completion-setup-hook)
nil)
@@ -1922,11 +2101,11 @@ These include:
`:affixation-function': Function to prepend/append a prefix/suffix to
completions. The function must accept one argument, a list of
- completions, and return a list where each element is a list of
- either two elements: a completion, and a suffix, or
- three elements: a completion, a prefix and a suffix.
- This function takes priority over `:annotation-function'
- when both are provided, so only this function is used.
+ completions, and return a list of annotated completions. The
+ elements of the list must be three-element lists: completion, its
+ prefix and suffix. This function takes priority over
+ `:annotation-function' when both are provided, so only this
+ function is used.
`:exit-function': Function to run after completion is performed.
@@ -1980,7 +2159,7 @@ variables.")
"Display a list of possible completions of the current minibuffer contents."
(interactive)
(message "Making completion list...")
- (let* ((start (or start (minibuffer-prompt-end)))
+ (let* ((start (or start (minibuffer--completion-prompt-end)))
(end (or end (point-max)))
(string (buffer-substring start end))
(md (completion--field-metadata start))
@@ -1999,7 +2178,7 @@ variables.")
;; the sole completion, then hide (previous&stale) completions.
(minibuffer-hide-completions)
(ding)
- (minibuffer-message
+ (completion--message
(if completions "Sole completion" "No completions")))
(let* ((last (last completions))
@@ -2017,6 +2196,8 @@ variables.")
(aff-fun (or (completion-metadata-get all-md 'affixation-function)
(plist-get completion-extra-properties
:affixation-function)))
+ (sort-fun (completion-metadata-get all-md 'display-sort-function))
+ (group-fun (completion-metadata-get all-md 'group-function))
(mainbuf (current-buffer))
;; If the *Completions* buffer is shown in a new
;; window, mark it as softly-dedicated, so bury-buffer in
@@ -2048,15 +2229,32 @@ variables.")
;; Remove the base-size tail because `sort' requires a properly
;; nil-terminated list.
(when last (setcdr last nil))
- (setq completions
- ;; FIXME: This function is for the output of all-completions,
- ;; not completion-all-completions. Often it's the same, but
- ;; not always.
- (let ((sort-fun (completion-metadata-get
- all-md 'display-sort-function)))
- (if sort-fun
- (funcall sort-fun completions)
- (sort completions 'string-lessp))))
+
+ ;; Sort first using the `display-sort-function'.
+ ;; FIXME: This function is for the output of
+ ;; all-completions, not
+ ;; completion-all-completions. Often it's the
+ ;; same, but not always.
+ (setq completions (if sort-fun
+ (funcall sort-fun completions)
+ (sort completions 'string-lessp)))
+
+ ;; After sorting, group the candidates using the
+ ;; `group-function'.
+ (when group-fun
+ (setq completions
+ (minibuffer--group-by
+ group-fun
+ (pcase completions-group-sort
+ ('nil #'identity)
+ ('alphabetical
+ (lambda (groups)
+ (sort groups
+ (lambda (x y)
+ (string< (car x) (car y))))))
+ (_ completions-group-sort))
+ completions)))
+
(cond
(aff-fun
(setq completions
@@ -2102,7 +2300,7 @@ variables.")
(if (eq (car bounds) (length result))
'exact 'finished)))))))
- (display-completion-list completions)))))
+ (display-completion-list completions nil group-fun)))))
nil)))
nil))
@@ -2116,16 +2314,38 @@ variables.")
(defun exit-minibuffer ()
"Terminate this minibuffer argument."
(interactive)
+ (when (minibufferp)
+ (when (not (minibuffer-innermost-command-loop-p))
+ (error "%s" "Not in most nested command loop"))
+ (when (not (innermost-minibuffer-p))
+ (error "%s" "Not in most nested minibuffer")))
;; If the command that uses this has made modifications in the minibuffer,
;; we don't want them to cause deactivation of the mark in the original
;; buffer.
;; A better solution would be to make deactivate-mark buffer-local
;; (or to turn it into a list of buffers, ...), but in the mean time,
;; this should do the trick in most cases.
- (when (innermost-minibuffer-p)
- (setq deactivate-mark nil)
- (throw 'exit nil))
- (error "%s" "Not in most nested minibuffer"))
+ (setq deactivate-mark nil)
+ (throw 'exit nil))
+
+(defun minibuffer-restore-windows ()
+ "Restore some windows on exit from minibuffer.
+When `read-minibuffer-restore-windows' is nil, then this function
+added to `minibuffer-exit-hook' will remove at least the window
+that displays the \"*Completions*\" buffer."
+ (unless read-minibuffer-restore-windows
+ (minibuffer-hide-completions)))
+
+(add-hook 'minibuffer-exit-hook 'minibuffer-restore-windows)
+
+(defun minibuffer-quit-recursive-edit ()
+ "Quit the command that requested this recursive edit without error.
+Like `abort-recursive-edit' without aborting keyboard macro
+execution."
+ ;; See Info node `(elisp)Recursive Editing' for an explanation of
+ ;; throwing a function to `exit'.
+ (throw 'exit (lambda ()
+ (signal 'minibuffer-quit nil))))
(defun self-insert-and-exit ()
"Terminate minibuffer input."
@@ -2396,8 +2616,10 @@ The completion method is determined by `completion-at-point-functions'."
(define-key map "\C-g" 'abort-minibuffers)
(define-key map "\M-<" 'minibuffer-beginning-of-buffer)
- (define-key map "\r" 'exit-minibuffer)
- (define-key map "\n" 'exit-minibuffer))
+ ;; Put RET last so that it is shown in doc strings in preference to
+ ;; C-j, when using the \\[exit-minibuffer] notation.
+ (define-key map "\n" 'exit-minibuffer)
+ (define-key map "\r" 'exit-minibuffer))
(defvar minibuffer-local-completion-map
(let ((map (make-sparse-keymap)))
@@ -2410,6 +2632,7 @@ The completion method is determined by `completion-at-point-functions'."
(define-key map "?" 'minibuffer-completion-help)
(define-key map [prior] 'switch-to-completions)
(define-key map "\M-v" 'switch-to-completions)
+ (define-key map "\M-g\M-c" 'switch-to-completions)
map)
"Local keymap for minibuffer input with completion.")
@@ -2432,10 +2655,33 @@ with `minibuffer-local-must-match-map'.")
(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
-(let ((map minibuffer-local-ns-map))
- (define-key map " " 'exit-minibuffer)
- (define-key map "\t" 'exit-minibuffer)
- (define-key map "?" 'self-insert-and-exit))
+(defvar minibuffer-local-ns-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map " " #'exit-minibuffer)
+ (define-key map "\t" #'exit-minibuffer)
+ (define-key map "?" #'self-insert-and-exit)
+ map)
+ "Local keymap for the minibuffer when spaces are not allowed.")
+
+(defun read-no-blanks-input (prompt &optional initial inherit-input-method)
+ "Read a string from the terminal, not allowing blanks.
+Prompt with PROMPT. Whitespace terminates the input. If INITIAL is
+non-nil, it should be a string, which is used as initial input, with
+point positioned at the end, so that SPACE will accept the input.
+\(Actually, INITIAL can also be a cons of a string and an integer.
+Such values are treated as in `read-from-minibuffer', but are normally
+not useful in this function.)
+
+Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
+the current input method and the setting of`enable-multibyte-characters'.
+
+If `inhibit-interaction' is non-nil, this function will signal an
+`inhibited-interaction' error."
+ (read-from-minibuffer prompt initial minibuffer-local-ns-map
+ nil minibuffer-history nil inherit-input-method))
+
+;;; Major modes for the minibuffer
(defvar minibuffer-inactive-mode-map
(let ((map (make-keymap)))
@@ -2460,7 +2706,27 @@ not active.")
:abbrev-table nil ;abbrev.el is not loaded yet during dump.
;; Note: this major mode is called from minibuf.c.
"Major mode to use in the minibuffer when it is not active.
-This is only used when the minibuffer area has no active minibuffer.")
+This is only used when the minibuffer area has no active minibuffer.
+
+Note that the minibuffer may change to this mode more often than
+you might expect. For instance, typing `M-x' may change the
+buffer to this mode, then to a different mode, and then back
+again to this mode upon exit. Code running from
+`minibuffer-inactive-mode-hook' has to be prepared to run
+multiple times per minibuffer invocation. Also see
+`minibuffer-exit-hook'.")
+
+(defvaralias 'minibuffer-mode-map 'minibuffer-local-map)
+
+(define-derived-mode minibuffer-mode nil "Minibuffer"
+ "Major mode used for active minibuffers.
+
+For customizing this mode, it is better to use
+`minibuffer-setup-hook' and `minibuffer-exit-hook' rather than
+the mode hook of this mode."
+ :syntax-table nil
+ :abbrev-table nil
+ :interactive nil)
;;; Completion tables.
@@ -2483,7 +2749,7 @@ Useful to give the user default values that won't be substituted."
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
- (substring enventry 0 (string-match-p "=" enventry)))
+ (substring enventry 0 (string-search "=" enventry)))
process-environment))
(defconst completion--embedded-envvar-re
@@ -2552,7 +2818,7 @@ same as `substitute-in-file-name'."
pred action))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
- (end (string-match-p "/" (cdr action))))
+ (end (string-search "/" (cdr action))))
`(boundaries
;; if `string' is "C:" in w32, (file-name-directory string)
;; returns "C:/", so `start' is 3 rather than 2.
@@ -2839,7 +3105,7 @@ See `read-file-name' for the meaning of the arguments."
(minibuffer-maybe-quote-filename dir)))
(initial (cons (minibuffer-maybe-quote-filename initial) 0)))))
- (let ((completion-ignore-case read-file-name-completion-ignore-case)
+ (let ((ignore-case read-file-name-completion-ignore-case)
(minibuffer-completing-file-name t)
(pred (or predicate 'file-exists-p))
(add-to-history nil))
@@ -2867,6 +3133,7 @@ See `read-file-name' for the meaning of the arguments."
minibuffer-default))
(setq minibuffer-default
(cdr-safe minibuffer-default)))
+ (setq-local completion-ignore-case ignore-case)
;; On the first request on `M-n' fill
;; `minibuffer-default' with a list of defaults
;; relevant for file-name reading.
@@ -2922,6 +3189,7 @@ See `read-file-name' for the meaning of the arguments."
(unless val (error "No file name specified"))
(if (and default-filename
+ (not (file-remote-p dir))
(string-equal val (if (consp insdef) (car insdef) insdef)))
(setq val default-filename))
(setq val (substitute-in-file-name val))
@@ -3159,7 +3427,7 @@ or a symbol, see `completion-pcm--merge-completions'."
(let ((n '()))
(while p
(pcase p
- (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,rest)
+ (`(,(or 'any 'any-delim) ,(or 'any 'point) . ,_)
(setq p (cdr p)))
;; This is not just a performance improvement: it turns a
;; terminating `point' into an implicit `any', which affects
@@ -3255,7 +3523,8 @@ between 0 and 1, and with faces `completions-common-part',
(when completions
(let* ((re (completion-pcm--pattern->regex pattern 'group))
(point-idx (completion-pcm--pattern-point-idx pattern))
- (case-fold-search completion-ignore-case))
+ (case-fold-search completion-ignore-case)
+ last-md)
(mapcar
(lambda (str)
;; Don't modify the string itself.
@@ -3264,7 +3533,7 @@ between 0 and 1, and with faces `completions-common-part',
(error "Internal error: %s does not match %s" re str))
(let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
(match-end (match-end 0))
- (md (cddr (match-data)))
+ (md (cddr (setq last-md (match-data t last-md))))
(from 0)
(end (length str))
;; To understand how this works, consider these simple
@@ -3674,39 +3943,38 @@ that is non-nil."
(put 'flex 'completion--adjust-metadata 'completion--flex-adjust-metadata)
(defun completion--flex-adjust-metadata (metadata)
- (cl-flet
- ((compose-flex-sort-fn
- (existing-sort-fn) ; wish `cl-flet' had proper indentation...
- (lambda (completions)
- (let ((pre-sorted
- (if existing-sort-fn
- (funcall existing-sort-fn completions)
- completions)))
- (cond
- ((or (not (window-minibuffer-p))
- ;; JT@2019-12-23: FIXME: this is still wrong. What
- ;; we need to test here is "some input that actually
- ;; leads to flex filtering", not "something after
- ;; the minibuffer prompt". Among other
- ;; inconsistencies, the latter is always true for
- ;; file searches, meaning the next clauses will be
- ;; ignored.
- (> (point-max) (minibuffer-prompt-end)))
- (sort
- pre-sorted
- (lambda (c1 c2)
- (let ((s1 (get-text-property 0 'completion-score c1))
- (s2 (get-text-property 0 'completion-score c2)))
- (> (or s1 0) (or s2 0))))))
- (t pre-sorted))))))
- `(metadata
- (display-sort-function
- . ,(compose-flex-sort-fn
- (completion-metadata-get metadata 'display-sort-function)))
- (cycle-sort-function
- . ,(compose-flex-sort-fn
- (completion-metadata-get metadata 'cycle-sort-function)))
- ,@(cdr metadata))))
+ "If `flex' is actually doing filtering, adjust sorting."
+ (let ((flex-is-filtering-p
+ ;; JT@2019-12-23: FIXME: this is kinda wrong. What we need
+ ;; to test here is "some input that actually leads/led to
+ ;; flex filtering", not "something after the minibuffer
+ ;; prompt". E.g. The latter is always true for file
+ ;; searches, meaning we'll be doing extra work when we
+ ;; needn't.
+ (or (not (window-minibuffer-p))
+ (> (point-max) (minibuffer-prompt-end))))
+ (existing-dsf
+ (completion-metadata-get metadata 'display-sort-function))
+ (existing-csf
+ (completion-metadata-get metadata 'cycle-sort-function)))
+ (cl-flet
+ ((compose-flex-sort-fn
+ (existing-sort-fn) ; wish `cl-flet' had proper indentation...
+ (lambda (completions)
+ (sort
+ (funcall existing-sort-fn completions)
+ (lambda (c1 c2)
+ (let ((s1 (get-text-property 0 'completion-score c1))
+ (s2 (get-text-property 0 'completion-score c2)))
+ (> (or s1 0) (or s2 0))))))))
+ `(metadata
+ ,@(and flex-is-filtering-p
+ `((display-sort-function
+ . ,(compose-flex-sort-fn (or existing-dsf #'identity)))))
+ ,@(and flex-is-filtering-p
+ `((cycle-sort-function
+ . ,(compose-flex-sort-fn (or existing-csf #'identity)))))
+ ,@(cdr metadata)))))
(defun completion-flex--make-flex-pattern (pattern)
"Convert PCM-style PATTERN into PCM-style flex pattern.
@@ -3727,7 +3995,7 @@ which is at the core of flex logic. The extra
(defun completion-flex-try-completion (string table pred point)
"Try to flex-complete STRING in TABLE given PRED and POINT."
- (unless (and completion-flex-nospace (string-match-p " " string))
+ (unless (and completion-flex-nospace (string-search " " string))
(pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
@@ -3744,7 +4012,7 @@ which is at the core of flex logic. The extra
(defun completion-flex-all-completions (string table pred point)
"Get flex-completions of STRING in TABLE, given PRED and POINT."
- (unless (and completion-flex-nospace (string-match-p " " string))
+ (unless (and completion-flex-nospace (string-search " " string))
(pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
@@ -3812,13 +4080,7 @@ See `completing-read' for the meaning of the arguments."
;; `read-from-minibuffer' uses 1-based index.
(1+ (cdr initial-input)))))
- (let* ((minibuffer-completion-table collection)
- (minibuffer-completion-predicate predicate)
- ;; FIXME: Remove/rename this var, see the next one.
- (minibuffer-completion-confirm (unless (eq require-match t)
- require-match))
- (minibuffer--require-match require-match)
- (base-keymap (if require-match
+ (let* ((base-keymap (if require-match
minibuffer-local-must-match-map
minibuffer-local-completion-map))
(keymap (if (memq minibuffer-completing-file-name '(nil lambda))
@@ -3831,8 +4093,17 @@ See `completing-read' for the meaning of the arguments."
;; in minibuffer-local-filename-completion-map can
;; override bindings in base-keymap.
base-keymap)))
- (result (read-from-minibuffer prompt initial-input keymap
- nil hist def inherit-input-method)))
+ (result
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-completion-table collection)
+ (setq-local minibuffer-completion-predicate predicate)
+ ;; FIXME: Remove/rename this var, see the next one.
+ (setq-local minibuffer-completion-confirm
+ (unless (eq require-match t) require-match))
+ (setq-local minibuffer--require-match require-match))
+ (read-from-minibuffer prompt initial-input keymap
+ nil hist def inherit-input-method))))
(when (and (equal result "") def)
(setq result (if (consp def) (car def) def)))
result))
@@ -3938,13 +4209,15 @@ it. See `format' for details.
If DEFAULT is a list, the first element is used as the default.
If not, the element is used as is.
-If DEFAULT is nil, no \"default value\" string is included in the
-return value."
+If DEFAULT is nil or an empty string, no \"default value\" string
+is included in the return value."
(concat
(if (null format-args)
prompt
(apply #'format prompt format-args))
(and default
+ (or (not (stringp default))
+ (length> default 0))
(format minibuffer-default-prompt-format
(if (consp default)
(car default)
diff --git a/lisp/misc.el b/lisp/misc.el
index 09f6011f98d..39ec9497d7f 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -41,7 +41,7 @@ The characters copied are inserted in the buffer before point."
(save-excursion
(beginning-of-line)
(backward-char 1)
- (skip-chars-backward "\ \t\n")
+ (skip-chars-backward " \t\n")
(move-to-column cc)
;; Default is enough to copy the whole rest of the line.
(setq n (if arg (prefix-numeric-value arg) (point-max)))
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 668c711922a..7f3e981bb0e 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -1,4 +1,4 @@
-;;; misearch.el --- isearch extensions for multi-buffer search
+;;; misearch.el --- isearch extensions for multi-buffer search -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
@@ -28,6 +28,8 @@
;;; Code:
+(require 'cl-lib)
+
;;; Search multiple buffers
;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup)
@@ -40,8 +42,7 @@
(defcustom multi-isearch-search t
"Non-nil enables searching multiple related buffers, in certain modes."
:type 'boolean
- :version "23.1"
- :group 'multi-isearch)
+ :version "23.1")
(defcustom multi-isearch-pause t
"A choice defining where to pause the search.
@@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string."
(const :tag "Don't pause" nil)
(const :tag "Only in initial buffer" initial)
(const :tag "All buffers" t))
- :version "23.1"
- :group 'multi-isearch)
+ :version "23.1")
;;;###autoload
(defvar multi-isearch-next-buffer-function nil
@@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'."
(default-value 'isearch-wrap-function)
multi-isearch-orig-push-state
(default-value 'isearch-push-state-function))
- (setq-default isearch-search-fun-function 'multi-isearch-search-fun
- isearch-wrap-function 'multi-isearch-wrap
- isearch-push-state-function 'multi-isearch-push-state)
- (add-hook 'isearch-mode-end-hook 'multi-isearch-end)))
+ (setq-default isearch-search-fun-function #'multi-isearch-search-fun
+ isearch-wrap-function #'multi-isearch-wrap
+ isearch-push-state-function #'multi-isearch-push-state)
+ (add-hook 'isearch-mode-end-hook #'multi-isearch-end)))
(defun multi-isearch-end ()
"Clean up the multi-buffer search after terminating isearch."
@@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'."
(setq-default isearch-search-fun-function multi-isearch-orig-search-fun
isearch-wrap-function multi-isearch-orig-wrap
isearch-push-state-function multi-isearch-orig-push-state)
- (remove-hook 'isearch-mode-end-hook 'multi-isearch-end))
+ (remove-hook 'isearch-mode-end-hook #'multi-isearch-end))
(defun multi-isearch-search-fun ()
"Return the proper search function, for isearch in multiple buffers."
@@ -190,10 +190,10 @@ the initial buffer."
(if (or (null multi-isearch-pause)
(and multi-isearch-pause multi-isearch-current-buffer))
(progn
- (switch-to-buffer
- (setq multi-isearch-current-buffer
- (funcall multi-isearch-next-buffer-current-function
- (current-buffer) t)))
+ (setq multi-isearch-current-buffer
+ (funcall multi-isearch-next-buffer-current-function
+ (current-buffer) t))
+ (multi-isearch-switch-buffer)
(goto-char (if isearch-forward (point-min) (point-max))))
(setq multi-isearch-current-buffer (current-buffer))
(setq isearch-wrapped nil)))
@@ -202,14 +202,25 @@ the initial buffer."
"Save a function restoring the state of multiple buffers search.
Save the current buffer to the additional state parameter in the
search status stack."
- `(lambda (cmd)
- (multi-isearch-pop-state cmd ,(current-buffer))))
+ (let ((buf (current-buffer)))
+ (lambda (cmd)
+ (multi-isearch-pop-state cmd buf))))
(defun multi-isearch-pop-state (_cmd buffer)
- "Restore the multiple buffers search state.
+ "Restore the multiple buffers search state in BUFFER.
Switch to the buffer restored from the search status stack."
- (unless (equal buffer (current-buffer))
- (switch-to-buffer (setq multi-isearch-current-buffer buffer))))
+ (unless (eq buffer (current-buffer))
+ (setq multi-isearch-current-buffer buffer)
+ (multi-isearch-switch-buffer)))
+
+;;;###autoload
+(defun multi-isearch-switch-buffer ()
+ "Switch to the next buffer in multi-buffer search."
+ (when (and (buffer-live-p multi-isearch-current-buffer)
+ (not (eq multi-isearch-current-buffer (current-buffer))))
+ (setq isearch-mode nil)
+ (switch-to-buffer multi-isearch-current-buffer)
+ (setq isearch-mode " M-Isearch")))
;;; Global multi-buffer search invocations
@@ -238,7 +249,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
(while (not (string-equal
(setq buf (read-buffer (multi-occur--prompt) nil t))
""))
- (add-to-list 'bufs buf)
+ (cl-pushnew buf bufs :test #'equal)
(setq ido-ignore-item-temp-list bufs))
(nreverse bufs)))
@@ -322,7 +333,7 @@ Every next/previous file in the defined sequence is visited by
default-directory
default-directory))
default-directory))
- (add-to-list 'files file))
+ (cl-pushnew file files :test #'equal))
(nreverse files)))
;; A regexp is not the same thing as a file glob - does this matter?
@@ -381,7 +392,7 @@ whose file names match the specified wildcard."
(defun multi-isearch-unload-function ()
"Remove autoloaded variables from `unload-function-defs-list'.
Also prevent the feature from being reloaded via `isearch-mode-hook'."
- (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
+ (remove-hook 'isearch-mode-hook #'multi-isearch-setup)
(let ((defs (list (car unload-function-defs-list)))
(auto '(multi-isearch-next-buffer-function
multi-isearch-next-buffer-current-function
@@ -395,7 +406,7 @@ Also prevent the feature from being reloaded via `isearch-mode-hook'."
;; .
nil))
-(defalias 'misearch-unload-function 'multi-isearch-unload-function)
+(defalias 'misearch-unload-function #'multi-isearch-unload-function)
(provide 'multi-isearch)
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index 8155c9dff30..14fbb51b27e 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -1,4 +1,4 @@
-;;; mouse-copy.el --- one-click text copy and move
+;;; mouse-copy.el --- one-click text copy and move -*- lexical-binding: t -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -213,8 +213,7 @@ by johnh@ficus.cs.ucla.edu."
(if (mouse-drag-secondary start-event)
(progn
(mouse-kill-preserving-secondary)
- (insert (gui-get-selection 'SECONDARY))))
-)
+ (insert (gui-get-selection 'SECONDARY)))))
(provide 'mouse-copy)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index b2960a4ccd3..b424b6edfe8 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -1,4 +1,4 @@
-;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
+;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling -*- lexical-binding: t -*-
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 8732fb80866..d2a5200d8de 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -119,7 +119,9 @@ Expects to be bound to `(double-)mouse-1' in `key-translation-map'."
(time-since (cdr mouse--last-down))
(/ (abs mouse-1-click-follows-link) 1000.0))))))
(eq (car mouse--last-down)
- (event-convert-list (list 'down (car-safe last-input-event))))
+ (event-convert-list
+ `(down ,@(event-modifiers last-input-event)
+ ,(event-basic-type last-input-event))))
(let* ((action (mouse-on-link-p (event-start last-input-event))))
(when (and action
(or mouse-1-click-in-non-selected-windows
@@ -178,7 +180,7 @@ items `Turn Off' and `Help'."
`(keymap
,(format "%s - %s" indicator
(capitalize
- (replace-regexp-in-string
+ (string-replace
"-" " " (format "%S" minor-mode))))
(turn-off menu-item "Turn off minor mode" ,mm-fun)
(help menu-item "Help for minor mode"
@@ -275,6 +277,194 @@ not it is actually displayed."
minor-mode-menus)))
+;; Context menus.
+
+(defcustom context-menu-functions '(context-menu-undo
+ context-menu-region
+ context-menu-local
+ context-menu-minor)
+ "List of functions that produce the contents of the context menu.
+Each function receives the menu as its argument and should return
+the same menu with changes such as added new menu items."
+ :type '(repeat
+ (choice (function-item context-menu-undo)
+ (function-item context-menu-region)
+ (function-item context-menu-global)
+ (function-item context-menu-local)
+ (function-item context-menu-minor)
+ (function-item context-menu-vc)
+ (function-item context-menu-ffap)
+ (function :tag "Custom function")))
+ :version "28.1")
+
+(defcustom context-menu-filter-function nil
+ "Function that can filter the list produced by `context-menu-functions'."
+ :type '(choice (const nil) function)
+ :version "28.1")
+
+(defun context-menu-map ()
+ "Return composite menu map."
+ (let ((menu (make-sparse-keymap)))
+ (run-hook-wrapped 'context-menu-functions
+ (lambda (fun)
+ (setq menu (funcall fun menu))
+ nil))
+ (when (functionp context-menu-filter-function)
+ (setq menu (funcall context-menu-filter-function menu)))
+ menu))
+
+(defun context-menu-global (menu)
+ "Global submenus."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-global] menu-bar-separator)
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ (lookup-key global-map [menu-bar]))
+ menu)
+
+(defun context-menu-local (menu)
+ "Major mode submenus."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-local] menu-bar-separator)
+ (let ((keymap (local-key-binding [menu-bar])))
+ (when keymap
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ keymap)))
+ menu)
+
+(defun context-menu-minor (menu)
+ "Minor modes submenus."
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (define-key-after menu [separator-minor] menu-bar-separator)
+ (dolist (mode (reverse (minor-mode-key-binding [menu-bar])))
+ (when (and (consp mode) (symbol-value (car mode)))
+ (map-keymap (lambda (key binding)
+ (when (consp binding)
+ (define-key-after menu (vector key)
+ (copy-sequence binding))))
+ (cdr mode))))
+ menu)
+
+(defun context-menu-vc (menu)
+ "Version Control menu."
+ (define-key-after menu [separator-vc] menu-bar-separator)
+ (define-key-after menu [vc-menu] vc-menu-entry)
+ menu)
+
+(defun context-menu-undo (menu)
+ "Undo menu."
+ (when (cddr menu)
+ (define-key-after menu [separator-undo] menu-bar-separator))
+ (define-key-after menu [undo]
+ '(menu-item "Undo" undo
+ :visible (and (not buffer-read-only)
+ (not (eq t buffer-undo-list))
+ (if (eq last-command 'undo)
+ (listp pending-undo-list)
+ (consp buffer-undo-list)))
+ :help "Undo last edits"))
+ (define-key-after menu [undo-redo]
+ '(menu-item "Redo" undo-redo
+ :visible (and (not buffer-read-only)
+ (undo--last-change-was-undo-p buffer-undo-list))
+ :help "Redo last undone edits"))
+ menu)
+
+(defun context-menu-region (menu)
+ "Region commands menu."
+ (when (cddr menu)
+ (define-key-after menu [separator-region] menu-bar-separator))
+ (define-key-after menu [cut]
+ '(menu-item "Cut" kill-region
+ :visible (and mark-active (not buffer-read-only))
+ :help
+ "Cut (kill) text in region between mark and current position"))
+ (define-key-after menu [copy]
+ ;; ns-win.el said: Substitute a Copy function that works better
+ ;; under X (for GNUstep).
+ `(menu-item "Copy" ,(if (featurep 'ns)
+ 'ns-copy-including-secondary
+ 'kill-ring-save)
+ :visible mark-active
+ :help "Copy text in region between mark and current position"
+ :keys ,(if (featurep 'ns)
+ "\\[ns-copy-including-secondary]"
+ "\\[kill-ring-save]")))
+ (define-key-after menu [paste]
+ `(menu-item "Paste" mouse-yank-primary
+ :visible (funcall
+ ',(lambda ()
+ (and (or
+ (gui-backend-selection-exists-p 'CLIPBOARD)
+ (if (featurep 'ns) ; like paste-from-menu
+ (cdr yank-menu)
+ kill-ring))
+ (not buffer-read-only))))
+ :help "Paste (yank) text most recently cut/copied"))
+ (define-key-after menu (if (featurep 'ns) [select-paste]
+ [paste-from-menu])
+ ;; ns-win.el said: Change text to be more consistent with
+ ;; surrounding menu items `paste', etc."
+ `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
+ yank-menu
+ :visible (and (cdr yank-menu) (not buffer-read-only))
+ :help "Choose a string from the kill ring and paste it"))
+ (define-key-after menu [clear]
+ '(menu-item "Clear" delete-active-region
+ :visible (and mark-active
+ (not buffer-read-only))
+ :help
+ "Delete the text in region between mark and current position"))
+ (define-key-after menu [mark-whole-buffer]
+ '(menu-item "Select All" mark-whole-buffer
+ :help "Mark the whole buffer for a subsequent cut/copy"))
+ menu)
+
+(defun context-menu-ffap (menu)
+ "File at point menu."
+ (save-excursion
+ (mouse-set-point last-input-event)
+ (when (ffap-guess-file-name-at-point)
+ (define-key menu [ffap-separator] menu-bar-separator)
+ (define-key menu [ffap-at-mouse]
+ '(menu-item "Find File or URL" ffap-at-mouse
+ :help "Find file or URL guessed from text around mouse click"))))
+ menu)
+
+(defvar context-menu-entry
+ `(menu-item ,(purecopy "Context Menu") ignore
+ :filter (lambda (_) (context-menu-map))))
+
+(defvar context-menu--old-down-mouse-3 nil)
+(defvar context-menu--old-mouse-3 nil)
+
+(define-minor-mode context-menu-mode
+ "Toggle Context Menu mode.
+
+When Context Menu mode is enabled, clicking the mouse button down-mouse-3
+activates the menu whose contents depends on its surrounding context."
+ :global t :group 'mouse
+ (cond
+ (context-menu-mode
+ (setq context-menu--old-mouse-3 (global-key-binding [mouse-3]))
+ (global-unset-key [mouse-3])
+ (setq context-menu--old-down-mouse-3 (global-key-binding [down-mouse-3]))
+ (global-set-key [down-mouse-3] context-menu-entry))
+ (t
+ (if (not context-menu--old-down-mouse-3)
+ (global-unset-key [down-mouse-3])
+ (global-set-key [down-mouse-3] context-menu--old-down-mouse-3)
+ (setq context-menu--old-down-mouse-3 nil))
+ (when context-menu--old-mouse-3
+ (global-set-key [mouse-3] context-menu--old-mouse-3)
+ (setq context-menu--old-mouse-3 nil)))))
+
+
;; Commands that operate on windows.
(defun mouse-minibuffer-check (event)
@@ -413,7 +603,7 @@ must be one of the symbols `header', `mode', or `vertical'."
(when (window-live-p (setq posn-window (posn-window start)))
;; Add left edge of `posn-window' to `position'.
(setq position (+ (window-pixel-left posn-window) position))
- (unless (nth 1 start)
+ (unless (posn-area start)
;; Add width of objects on the left of the text area to
;; `position'.
(when (eq (window-current-scroll-bars posn-window) 'left)
@@ -492,9 +682,11 @@ must be one of the symbols `header', `mode', or `vertical'."
(define-key map [header-line] map)
(define-key map [vertical-line] map)
;; ... and some maybe even with a right- or bottom-divider
- ;; prefix.
+ ;; or left- or right-margin prefix ...
(define-key map [right-divider] map)
(define-key map [bottom-divider] map)
+ (define-key map [left-margin] map)
+ (define-key map [right-margin] map)
map)
t (lambda () (setq track-mouse old-track-mouse)))))))
@@ -546,6 +738,18 @@ the frame instead."
(when (frame-parameter frame 'drag-with-header-line)
(mouse-drag-frame-move start-event))))))
+(defun mouse-drag-tab-line (start-event)
+ "Drag frame with tab line in its topmost window.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (let* ((start (event-start start-event))
+ (window (posn-window start)))
+ (when (and (window-live-p window)
+ (window-at-side-p window 'top))
+ (let ((frame (window-frame window)))
+ (when (frame-parameter frame 'drag-with-tab-line)
+ (mouse-drag-frame-move start-event))))))
+
(defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on a vertical line.
START-EVENT is the starting mouse event of the drag action."
@@ -674,6 +878,7 @@ frame with the mouse."
;; 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 [tab-line] map)
(define-key map [vertical-line] map)
;; ... and some maybe even with a right- or bottom-divider
;; prefix.
@@ -900,6 +1105,7 @@ frame with the mouse."
;; 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 [tab-line] map)
(define-key map [vertical-line] map)
;; ... and some maybe even with a right- or bottom-divider
;; prefix.
@@ -1190,7 +1396,7 @@ overlay property, the value of that property determines what to do.
for the `follow-link' event, the binding of that event determines
what to do.
-The resulting value determine whether POS is inside a link:
+The resulting value determines whether POS is inside a link:
- If the value is `mouse-face', POS is inside a link if there
is a non-nil `mouse-face' property at POS. Return t in this case.
@@ -2863,8 +3069,8 @@ is copied instead of being cut."
(set-marker (nth 2 state) nil))
(with-current-buffer (window-buffer window)
(setq cursor-type (nth 3 state)))))))
-
+
;;; Bindings for mouse commands.
(global-set-key [down-mouse-1] 'mouse-drag-region)
@@ -2904,6 +3110,7 @@ is copied instead of being cut."
;; versions.
(global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
(global-set-key [header-line mouse-1] 'mouse-select-window)
+(global-set-key [tab-line down-mouse-1] 'mouse-drag-tab-line)
(global-set-key [tab-line mouse-1] 'mouse-select-window)
;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 827f8aacdd6..029f0ca8f42 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -125,16 +125,13 @@
(unless (member elem seen) (push elem res)))))
(nreverse res)))
-(defun mpc-intersection (l1 l2 &optional selectfun)
+(defun mpc-intersection (l1 l2 selectfun)
"Return L1 after removing all elements not found in L2.
-If SELECTFUN is non-nil, elements aren't compared directly, but instead
+Elements aren't compared directly, but instead
they are passed through SELECTFUN before comparison."
- (let ((res ()))
- (if selectfun (setq l2 (mapcar selectfun l2)))
- (dolist (elem l1)
- (when (member (if selectfun (funcall selectfun elem) elem) l2)
- (push elem res)))
- (nreverse res)))
+ (seq-intersection l1 l2 (lambda (x y)
+ (equal (funcall selectfun x)
+ (funcall selectfun y)))))
(defun mpc-event-set-point (event)
(condition-case nil (posn-set-point (event-end event))
@@ -185,7 +182,7 @@ numerically rather than lexicographically."
(abs res))
res))))))))
-(define-obsolete-function-alias 'mpc-string-prefix-p 'string-prefix-p "24.3")
+(define-obsolete-function-alias 'mpc-string-prefix-p #'string-prefix-p "24.3")
;; This can speed up mpc--song-search significantly. The table may grow
;; very large, tho. It's only bounded by the fact that it gets flushed
@@ -217,8 +214,8 @@ defaults to 6600 and HOST defaults to localhost."
(with-current-buffer "*MPC-debug*"
(goto-char (point-max))
(insert-before-markers ;So it scrolls.
- (replace-regexp-in-string "\n" "\n "
- (apply #'format-message format args))
+ (string-replace "\n" "\n "
+ (apply #'format-message format args))
"\n"))))
(defun mpc--proc-filter (proc string)
@@ -293,11 +290,11 @@ defaults to 6600 and HOST defaults to localhost."
(let ((plist (process-plist mpc-proc)))
(while plist (process-put proc (pop plist) (pop plist)))))
(mpc-proc-buffer proc 'mpd-commands (current-buffer))
- (process-put proc 'callback 'ignore)
+ (process-put proc 'callback #'ignore)
(process-put proc 'ready nil)
(clrhash mpc--find-memoize)
- (set-process-filter proc 'mpc--proc-filter)
- (set-process-sentinel proc 'ignore)
+ (set-process-filter proc #'mpc--proc-filter)
+ (set-process-sentinel proc #'ignore)
(set-process-query-on-exit-flag proc nil)
;; This may be called within a process filter ;-(
(with-local-quit (mpc-proc-sync proc))
@@ -308,7 +305,7 @@ defaults to 6600 and HOST defaults to localhost."
(defun mpc--proc-quote-string (s)
(if (numberp s) (number-to-string s)
(setq s (replace-regexp-in-string "[\"\\]" "\\\\\\&" s))
- (if (string-match " " s) (concat "\"" s "\"") s)))
+ (if (string-search " " s) (concat "\"" s "\"") s)))
(defconst mpc--proc-alist-to-alists-starters '(file directory))
@@ -378,7 +375,7 @@ which will be concatenated with proper quoting before passing them to MPD."
(mpc--debug "Send \"%s\"" cmd)
(process-send-string
proc (concat (if (stringp cmd) cmd
- (mapconcat 'mpc--proc-quote-string cmd " "))
+ (mapconcat #'mpc--proc-quote-string cmd " "))
"\n")))
(if callback
;; (let ((buf (current-buffer)))
@@ -390,7 +387,7 @@ which will be concatenated with proper quoting before passing them to MPD."
;; (set-buffer buf)))))
)
;; If `callback' is nil, we're executing synchronously.
- (process-put proc 'callback 'ignore)
+ (process-put proc 'callback #'ignore)
;; This returns the process's buffer.
(mpc-proc-sync proc)))))
@@ -400,7 +397,7 @@ which will be concatenated with proper quoting before passing them to MPD."
(concat "command_list_begin\n"
(mapconcat (lambda (cmd)
(if (stringp cmd) cmd
- (mapconcat 'mpc--proc-quote-string cmd " ")))
+ (mapconcat #'mpc--proc-quote-string cmd " ")))
cmds
"\n")
"\ncommand_list_end"))
@@ -490,9 +487,9 @@ to call FUN for any change whatsoever.")
(defvar mpc--status-timer nil)
(defun mpc--status-timer-start ()
- (add-hook 'pre-command-hook 'mpc--status-timer-stop)
+ (add-hook 'pre-command-hook #'mpc--status-timer-stop)
(unless mpc--status-timer
- (setq mpc--status-timer (run-with-timer 1 1 'mpc--status-timer-run))))
+ (setq mpc--status-timer (run-with-timer 1 1 #'mpc--status-timer-run))))
(defun mpc--status-timer-stop ()
(when mpc--status-timer
(cancel-timer mpc--status-timer)
@@ -512,7 +509,7 @@ to call FUN for any change whatsoever.")
;; Turn it off even if we'll start it again, in case it changes the delay.
(cancel-timer mpc--status-idle-timer))
(setq mpc--status-idle-timer
- (run-with-idle-timer 1 t 'mpc--status-idle-timer-run))
+ (run-with-idle-timer 1 t #'mpc--status-idle-timer-run))
;; Typically, the idle timer is started from the mpc--status-callback,
;; which is run asynchronously while we're already idle (we typically
;; just started idling), so the timer itself will only be run the next
@@ -527,7 +524,7 @@ to call FUN for any change whatsoever.")
(unless really
;; We don't completely stop the timer, so that if some other MPD
;; client starts playback, we may get a chance to notice it.
- (run-with-idle-timer 10 t 'mpc--status-idle-timer-run))))
+ (run-with-idle-timer 10 t #'mpc--status-idle-timer-run))))
(defun mpc--status-idle-timer-run ()
(mpc--status-timer-start)
(mpc--status-timer-run))
@@ -598,7 +595,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
;; (dotimes (i (string-to-number pos)) (mpc--queue-pop))
;; (mpc-proc-cmd (mpc-proc-cmd-list
;; (make-list (string-to-number pos) "delete 0"))
-;; 'ignore)
+;; #'ignore)
;; (if (not (equal (cdr (assq 'file mpc-status))
;; (mpc--queue-head)))
;; (message "MPC's queue is out of sync"))))))
@@ -614,7 +611,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
(defun mpc-cmd-special-tag-p (tag)
(or (memq tag '(Playlist Search Directory))
- (string-match "|" (symbol-name tag))))
+ (string-search "|" (symbol-name tag))))
(defun mpc-cmd-find (tag value)
"Return a list of all songs whose tag TAG has value VALUE.
@@ -685,7 +682,7 @@ The songs are returned as alists."
(let ((plsongs (mpc-cmd-find 'Playlist pl)))
(if (not (mpc-cmd-special-tag-p other-tag))
(when (member (cons other-tag value)
- (apply 'append plsongs))
+ (apply #'append plsongs))
(push pl pls))
;; Problem N°2: we compute the intersection whereas all
;; we care about is whether it's empty. So we could
@@ -696,15 +693,15 @@ The songs are returned as alists."
;; good enough because this is only used with "search", which
;; doesn't pay attention to playlists and URLs anyway.
(let* ((osongs (mpc-cmd-find other-tag value))
- (ofiles (mpc-assq-all 'file (apply 'append osongs)))
- (plfiles (mpc-assq-all 'file (apply 'append plsongs))))
- (when (mpc-intersection plfiles ofiles)
+ (ofiles (mpc-assq-all 'file (apply #'append osongs)))
+ (plfiles (mpc-assq-all 'file (apply #'append plsongs))))
+ (when (seq-intersection plfiles ofiles)
(push pl pls)))))))
pls))
((eq tag 'Directory)
(if (null other-tag)
- (apply 'nconc
+ (apply #'nconc
(mpc-assq-all 'directory
(mpc-proc-buf-to-alist
(mpc-proc-cmd "lsinfo")))
@@ -727,7 +724,7 @@ The songs are returned as alists."
;; If there's an other-tag, then just extract the dir info from the
;; list of other-tag's songs.
(let* ((other-songs (mpc-cmd-find other-tag value))
- (files (mpc-assq-all 'file (apply 'append other-songs)))
+ (files (mpc-assq-all 'file (apply #'append other-songs)))
(dirs '()))
(dolist (file files)
(let ((dir (file-name-directory file)))
@@ -761,7 +758,7 @@ The songs are returned as alists."
((null other-tag)
(condition-case nil
- (mapcar 'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag))))
+ (mapcar #'cdr (mpc-proc-cmd-to-alist (list "list" (symbol-name tag))))
(mpc-proc-error
;; If `tag' is not one of the expected tags, MPD burps about not
;; having the relevant table.
@@ -772,7 +769,7 @@ The songs are returned as alists."
(condition-case nil
(if (mpc-cmd-special-tag-p other-tag)
(signal 'mpc-proc-error "Not implemented")
- (mapcar 'cdr
+ (mapcar #'cdr
(mpc-proc-cmd-to-alist
(list "list" (symbol-name tag)
(symbol-name other-tag) value))))
@@ -783,7 +780,7 @@ The songs are returned as alists."
(mpc-assq-all tag
;; Don't use `nconc' now that mpc-cmd-find may
;; return a memoized result.
- (apply 'append other-songs))))))))
+ (apply #'append other-songs))))))))
(defun mpc-cmd-stop (&optional callback)
(mpc-proc-cmd "stop" callback))
@@ -849,7 +846,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions don't affect
;; later ones.
- (sort (copy-sequence song-poss) '>))))
+ (sort (copy-sequence song-poss) #'>))))
(if (stringp playlist)
(puthash (cons 'Playlist playlist) nil mpc--find-memoize)))
@@ -873,7 +870,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Sort them from last to first, so the renumbering
;; caused by the earlier deletions affect
;; later ones a bit less.
- (sort (copy-sequence song-poss) '>))))
+ (sort (copy-sequence song-poss) #'>))))
(if (stringp playlist)
(puthash (cons 'Playlist playlist) nil mpc--find-memoize))))
@@ -884,7 +881,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(unless callback (mpc-proc-sync))))
(defun mpc-cmd-tagtypes ()
- (mapcar 'cdr (mpc-proc-cmd-to-alist "tagtypes")))
+ (mapcar #'cdr (mpc-proc-cmd-to-alist "tagtypes")))
;; This was never integrated into MPD.
;; (defun mpc-cmd-download (file)
@@ -1000,7 +997,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(cond
((>= col 0) (insert str))
(t (insert (substring str (min (length str) (- col))))))))
- (pred nil))
+ (pred #'always))
(while (string-match "%\\(?:%\\|\\(-\\)?\\([0-9]+\\)?{\\([[:alpha:]][[:alnum:]]*\\)\\(?:-\\([^}]+\\)\\)?}\\)" format-spec pos)
(let ((pre-text (substring format-spec pos (match-beginning 0))))
(funcall insert pre-text)
@@ -1019,7 +1016,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(pcase tag
((or 'Time 'Duration)
(let ((time (cdr (or (assq 'time info) (assq 'Time info)))))
- (setq pred (list nil)) ;Just assume it's never eq.
+ (setq pred #'ignore) ;Just assume it's never eq.
(when time
(mpc-secs-to-time (if (and (eq tag 'Duration)
(string-match ":" time))
@@ -1028,7 +1025,15 @@ If PLAYLIST is t or nil or missing, use the main playlist."
('Cover
(let ((dir (file-name-directory (cdr (assq 'file info)))))
;; (debug)
- (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred)
+ (setq pred
+ ;; We want the closure to capture the current
+ ;; value of `pred' and not a reference to the
+ ;; variable itself.
+ (let ((oldpred pred))
+ (lambda (info)
+ (and (funcall oldpred info)
+ (equal dir (file-name-directory
+ (cdr (assq 'file info))))))))
(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)
@@ -1045,7 +1050,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(setq size nil)
(propertize dir 'display image))
;; Make sure we return something on which we can
- ;; place the `mpc-pred' property, as
+ ;; place the `mpc--uptodate-p' property, as
;; a negative-cache. We could also use
;; a default cover.
(progn (setq size nil) " "))))
@@ -1054,7 +1059,14 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; than the URL in `file'. Pretend it's in `Title'.
(when (and (null val) (eq tag 'Title))
(setq val (cdr (assq 'file info))))
- (push `(equal ',val (cdr (assq ',tag info))) pred)
+ (setq pred
+ ;; We want the closure to capture the current
+ ;; value of `pred' and not a reference to the
+ ;; variable itself.
+ (let ((oldpred pred))
+ (lambda (info)
+ (and (funcall oldpred info)
+ (equal val (cdr (assq tag info)))))))
(cond
((not (and (eq tag 'Date) (stringp val))) val)
;; For "date", only keep the year!
@@ -1082,11 +1094,11 @@ If PLAYLIST is t or nil or missing, use the main playlist."
'follow-link t
'keymap `(keymap
(mouse-2
- . (lambda ()
- (interactive)
- (mpc-constraints-push 'noerror)
- (mpc-constraints-restore
- ',(list (list tag text)))))))))
+ . ,(lambda ()
+ (interactive)
+ (mpc-constraints-push 'noerror)
+ (mpc-constraints-restore
+ ',(list (list tag text)))))))))
(funcall insert
(concat (when size
(propertize " " 'display
@@ -1099,35 +1111,34 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(if (null size) (setq col (+ col textwidth postwidth))
(insert space)
(setq col (+ col size))))))
- (put-text-property start (point) 'mpc-pred
- `(lambda (info) (and ,@(nreverse pred))))))
+ (put-text-property start (point) 'mpc--uptodate-p pred)))
;;; The actual UI code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mpc-mode-map
(let ((map (make-sparse-keymap)))
- ;; (define-key map "\e" 'mpc-stop)
- (define-key map "q" 'mpc-quit)
- (define-key map "\r" 'mpc-select)
- (define-key map [(shift return)] 'mpc-select-toggle)
- (define-key map [mouse-2] 'mpc-select)
- (define-key map [S-mouse-2] 'mpc-select-extend)
- (define-key map [C-mouse-2] 'mpc-select-toggle)
- (define-key map [drag-mouse-2] 'mpc-drag-n-drop)
+ ;; (define-key map "\e" #'mpc-stop)
+ (define-key map "q" #'mpc-quit)
+ (define-key map "\r" #'mpc-select)
+ (define-key map [(shift return)] #'mpc-select-toggle)
+ (define-key map [mouse-2] #'mpc-select)
+ (define-key map [S-mouse-2] #'mpc-select-extend)
+ (define-key map [C-mouse-2] #'mpc-select-toggle)
+ (define-key map [drag-mouse-2] #'mpc-drag-n-drop)
;; We use `always' because a binding to t is like a binding to nil.
(define-key map [follow-link] :always)
;; But follow-link doesn't apply blindly to header-line and
;; mode-line clicks.
- (define-key map [header-line follow-link] 'ignore)
- (define-key map [mode-line follow-link] 'ignore)
+ (define-key map [header-line follow-link] #'ignore)
+ (define-key map [mode-line follow-link] #'ignore)
;; Doesn't work because the first click changes the buffer, so the second
;; is applied elsewhere :-(
- ;; (define-key map [(double mouse-2)] 'mpc-play-at-point)
- (define-key map "p" 'mpc-pause)
- (define-key map "s" 'mpc-toggle-play)
- (define-key map ">" 'mpc-next)
- (define-key map "<" 'mpc-prev)
- (define-key map "g" 'mpc-seek-current)
+ ;; (define-key map [(double mouse-2)] #'mpc-play-at-point)
+ (define-key map "p" #'mpc-pause)
+ (define-key map "s" #'mpc-toggle-play)
+ (define-key map ">" #'mpc-next)
+ (define-key map "<" #'mpc-prev)
+ (define-key map "g" #'mpc-seek-current)
map))
(easy-menu-define mpc-mode-menu mpc-mode-map
@@ -1219,7 +1230,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(when (assq 'file mpc-status)
(let ((inhibit-read-only t))
(dolist (spec mpc-status-buffer-format)
- (let ((pred (get-text-property (point) 'mpc-pred)))
+ (let ((pred (get-text-property (point) 'mpc--uptodate-p)))
(if (and pred (funcall pred mpc-status))
(forward-line)
(delete-region (point) (line-beginning-position 2))
@@ -1279,7 +1290,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; Restore the selection. I.e. move the overlays back to their
;; corresponding location. Actually which overlay is used for what
;; doesn't matter.
- (mapc 'delete-overlay mpc-select)
+ (mapc #'delete-overlay mpc-select)
(setq mpc-select nil)
(dolist (elem selection)
;; After an update, some elements may have disappeared.
@@ -1304,7 +1315,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(interactive (list last-nonmenu-event))
(mpc-event-set-point event)
(if (and (bolp) (eobp)) (forward-line -1))
- (mapc 'delete-overlay mpc-select)
+ (mapc #'delete-overlay mpc-select)
(setq mpc-select nil)
(if (mpc-tagbrowser-all-p)
nil
@@ -1427,7 +1438,7 @@ when constructing the set of constraints."
(let (res)
(dolist (constraint constraints)
(when (or (eq (car constraint) buffer-tag)
- (and (string-match "|" (symbol-name buffer-tag))
+ (and (string-search "|" (symbol-name buffer-tag))
(member (symbol-name (car constraint))
(split-string (symbol-name buffer-tag) "|"))))
(setq res (cdr constraint))))
@@ -1664,12 +1675,12 @@ Return non-nil if a selection was deactivated."
;; (unless (equal constraints mpc-constraints)
;; (setq-local mpc-constraints constraints)
(dolist (cst constraints)
- (let ((vals (apply 'mpc-union
+ (let ((vals (apply #'mpc-union
(mapcar (lambda (val)
(mpc-cmd-list mpc-tag (car cst) val))
(cdr cst)))))
(setq active
- (if (listp active) (mpc-intersection active vals) vals))))
+ (if (listp active) (seq-intersection active vals) vals))))
(when (listp active)
;; Remove the selections if they are all in conflict with
@@ -1683,7 +1694,7 @@ Return non-nil if a selection was deactivated."
(setq mpc--changed-selection t))
(unless nodeactivate
(setq selection nil)
- (mapc 'delete-overlay mpc-select)
+ (mapc #'delete-overlay mpc-select)
(setq mpc-select nil)
(mpc-tagbrowser-all-select))))
@@ -1728,7 +1739,7 @@ Return non-nil if a selection was deactivated."
(defvar mpc-tagbrowser-dir-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map mpc-tagbrowser-mode-map)
- (define-key map [?\M-\C-m] 'mpc-tagbrowser-dir-toggle)
+ (define-key map [?\M-\C-m] #'mpc-tagbrowser-dir-toggle)
map))
;; (defvar mpc-tagbrowser-dir-keywords
@@ -1840,12 +1851,12 @@ A value of t means the main playlist.")
(let ((map (make-sparse-keymap)))
;; Bind the up-events rather than the down-event, so the
;; `message' isn't canceled by the subsequent up-event binding.
- (define-key map [down-mouse-1] 'ignore)
- (define-key map [mouse-1] 'mpc-volume-mouse-set)
- (define-key map [header-line mouse-1] 'mpc-volume-mouse-set)
- (define-key map [header-line down-mouse-1] 'ignore)
- (define-key map [mode-line mouse-1] 'mpc-volume-mouse-set)
- (define-key map [mode-line down-mouse-1] 'ignore)
+ (define-key map [down-mouse-1] #'ignore)
+ (define-key map [mouse-1] #'mpc-volume-mouse-set)
+ (define-key map [header-line mouse-1] #'mpc-volume-mouse-set)
+ (define-key map [header-line down-mouse-1] #'ignore)
+ (define-key map [mode-line mouse-1] #'mpc-volume-mouse-set)
+ (define-key map [mode-line down-mouse-1] #'ignore)
map))
(defvar mpc-volume nil) (put 'mpc-volume 'risky-local-variable t)
@@ -1878,7 +1889,7 @@ A value of t means the main playlist.")
(progn
(message "MPD volume already at %s%%" newvol)
(ding))
- (mpc-proc-cmd (list "setvol" newvol) 'mpc-status-refresh)
+ (mpc-proc-cmd (list "setvol" newvol) #'mpc-status-refresh)
(message "Set MPD volume to %s%%" newvol))))
(defun mpc-volume-widget (vol &optional size)
@@ -1915,7 +1926,7 @@ A value of t means the main playlist.")
(defvar mpc-songs-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [remap mpc-select] 'mpc-songs-jump-to)
+ (define-key map [remap mpc-select] #'mpc-songs-jump-to)
map))
(defvar mpc-songpointer-set-visible nil)
@@ -1963,7 +1974,7 @@ This is used so that they can be compared with `eq', which is needed for
(setq mpc-songs-playlist (cadr cst)))
;; We don't do anything really special here for playlists,
;; because it's unclear what's a correct "union" of playlists.
- (let ((vals (apply 'mpc-union
+ (let ((vals (apply #'mpc-union
(mapcar (lambda (val)
(mpc-cmd-find (car cst) val))
(cdr cst)))))
@@ -2337,7 +2348,7 @@ This is used so that they can be compared with `eq', which is needed for
"Quit Music Player Daemon."
(interactive)
(let* ((proc mpc-proc)
- (bufs (mapcar 'cdr (if proc (process-get proc 'buffers))))
+ (bufs (mapcar #'cdr (if proc (process-get proc 'buffers))))
(wins (mapcar (lambda (buf) (get-buffer-window buf 0)) bufs))
(song-buf (mpc-songs-buf))
frames)
@@ -2358,7 +2369,7 @@ This is used so that they can be compared with `eq', which is needed for
(unless (memq (window-buffer win) bufs) (setq delete nil)))
(if delete (ignore-errors (delete-frame frame))))))
;; Then kill the buffers.
- (mapc 'kill-buffer bufs)
+ (mapc #'kill-buffer bufs)
(mpc-status-stop)
(if proc (delete-process proc))))
@@ -2521,7 +2532,7 @@ If stopped, start playback."
(setq mpc-last-seek-time
(cons currenttime (setq time (+ time step))))
(mpc-proc-cmd (list "seekid" songid time)
- 'mpc-status-refresh))))
+ #'mpc-status-refresh))))
(let ((status (mpc-cmd-status)))
(let* ((songid (cdr (assq 'songid status)))
(time (if songid (string-to-number
@@ -2531,7 +2542,7 @@ If stopped, start playback."
(lambda ()
(mpc-proc-cmd (list "seekid" songid
(setq time (+ time step)))
- 'mpc-status-refresh)))))
+ #'mpc-status-refresh)))))
(while (mouse-movement-p
(event-basic-type (setq event (read-event)))))
(cancel-timer timer)))))))
@@ -2586,7 +2597,7 @@ If stopped, start playback."
((and (>= songtime songduration) mpc--faster-toggle-forward)
;; Skip to the beginning of the next song.
(if (not (equal (cdr (assq 'state mpc-status)) "play"))
- (mpc-proc-cmd "next" 'mpc-status-refresh)
+ (mpc-proc-cmd "next" #'mpc-status-refresh)
;; If we're playing, this is done automatically, so we
;; don't need to do anything, or rather we *shouldn't*
;; do anything otherwise there's a race condition where
@@ -2618,7 +2629,7 @@ If stopped, start playback."
(condition-case nil
(mpc-proc-cmd
(list "seekid" songid songtime)
- 'mpc-status-refresh)
+ #'mpc-status-refresh)
(mpc-proc-error (mpc-status-refresh)))))))))))
(setq mpc--faster-toggle-forward (> step 0))
(funcall fun) ;Initialize values.
@@ -2702,7 +2713,7 @@ If stopped, start playback."
(error "Not a playlist")
(buffer-substring (line-beginning-position)
(line-end-position)))))
- (mpc-cmd-add (mapcar 'car songs) playlist)
+ (mpc-cmd-add (mapcar #'car songs) playlist)
(message "Added %d songs to %s" (length songs) playlist)
(if (member playlist
(cdr (assq 'Playlist (mpc-constraints-get-current))))
@@ -2714,7 +2725,7 @@ If stopped, start playback."
((eq start-buf end-buf)
;; Moving songs within the shown playlist.
(let ((dest-pos (get-text-property (point) 'mpc-file-pos)))
- (mpc-cmd-move (mapcar 'cdr songs) dest-pos mpc-songs-playlist)
+ (mpc-cmd-move (mapcar #'cdr songs) dest-pos mpc-songs-playlist)
(message "Moved %d songs" (length songs))))
(t
;; Adding songs to the shown playlist.
@@ -2725,10 +2736,10 @@ If stopped, start playback."
;; MPD's protocol does not let us add songs at a particular
;; position in a playlist, so we first have to add them to the
;; end, and then move them to their final destination.
- (mpc-cmd-add (mapcar 'car songs) mpc-songs-playlist)
+ (mpc-cmd-add (mapcar #'car songs) mpc-songs-playlist)
(mpc-cmd-move (let ((poss '()))
(dotimes (i (length songs))
- (push (+ i (length pl)) poss))
+ (push (+ i (length pl)) poss))
(nreverse poss))
dest-pos mpc-songs-playlist)
(message "Added %d songs" (length songs)))))
diff --git a/lisp/msb.el b/lisp/msb.el
index 14209d9956d..1f05e9db589 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,4 +1,4 @@
-;;; msb.el --- customizable buffer-selection with multiple menus
+;;; msb.el --- customizable buffer-selection with multiple menus -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc.
@@ -252,14 +252,12 @@ error every time you do \\[msb]."
:type `(choice (const :tag "long" :value ,msb--very-many-menus)
(const :tag "short" :value ,msb--few-menus)
(sexp :tag "user"))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-modes-key 4000
"The sort key for files sorted by mode."
:type 'integer
- :set 'msb-custom-set
- :group 'msb
+ :set #'msb-custom-set
:version "20.3")
(defcustom msb-separator-diff 100
@@ -267,8 +265,7 @@ error every time you do \\[msb]."
The separators will appear between all menus that have a sorting key
that differs by this value or more."
:type '(choice integer (const nil))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defvar msb-files-by-directory-sort-key 0
"The sort key for files sorted by directory.")
@@ -278,8 +275,7 @@ that differs by this value or more."
If this variable is set to 15 for instance, then the submenu will be
split up in minor parts, 15 items each. A value of nil means no limit."
:type '(choice integer (const nil))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-max-file-menu-items 10
"The maximum number of items from different directories.
@@ -293,27 +289,23 @@ them together.
If the value is not a number, then the value 10 is used."
:type 'integer
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-most-recently-used-sort-key -1010
"Where should the menu with the most recently used buffers be placed?"
:type 'integer
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-display-most-recently-used 15
"How many buffers should be in the most-recently-used menu.
No buffers at all if less than 1 or nil (or any non-number)."
:type 'integer
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-most-recently-used-title "Most recently used (%d)"
"The title for the most-recently-used menu."
:type 'string
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defvar msb-horizontal-shift-function (lambda () 0)
"Function that specifies how many pixels to shift the top menu leftwards.")
@@ -323,8 +315,7 @@ No buffers at all if less than 1 or nil (or any non-number)."
Non-nil means that the buffer menu should include buffers that have
names that starts with a space character."
:type 'boolean
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defvar msb-item-handling-function 'msb-item-handler
"The appearance of a buffer menu.
@@ -354,15 +345,13 @@ Set this to nil or t if you don't want any sorting (faster)."
:type '(choice (const msb-sort-by-name)
(const :tag "Newest first" t)
(const :tag "Oldest first" nil))
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(defcustom msb-files-by-directory nil
"Non-nil means that files should be sorted by directory.
This is instead of the groups in `msb-menu-cond'."
:type 'boolean
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(define-obsolete-variable-alias 'msb-after-load-hooks
'msb-after-load-hook "24.1")
@@ -370,8 +359,7 @@ This is instead of the groups in `msb-menu-cond'."
(defcustom msb-after-load-hook nil
"Hook run after the msb package has been loaded."
:type 'hook
- :set 'msb-custom-set
- :group 'msb)
+ :set #'msb-custom-set)
(make-obsolete-variable 'msb-after-load-hook
"use `with-eval-after-load' instead." "28.1")
@@ -458,10 +446,10 @@ An item look like (NAME . BUFFER)."
;;;
;;; msb
-;;;
-;;; This function can be used instead of (mouse-buffer-menu EVENT)
-;;; function in "mouse.el".
-;;;
+;;
+;; This function can be used instead of (mouse-buffer-menu EVENT)
+;; function in "mouse.el".
+;;
(defun msb (event)
"Pop up several menus of buffers for selection with the mouse.
This command switches buffers in the window that you clicked on, and
@@ -707,7 +695,7 @@ See `msb-menu-cond' for a description of its elements."
(cl-loop for fi
across function-info-vector
if (and (setq result
- (eval (aref fi 1))) ;Test CONDITION
+ (eval (aref fi 1) t)) ;Test CONDITION
(not (and (eq result 'no-multi)
multi-flag))
(progn (when (eq result 'multi)
@@ -727,12 +715,11 @@ All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER)
to the buffer-list variable in FUNCTION-INFO."
(let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
;; Here comes the hairy side-effect!
- (set list-symbol
- (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER
- buffer
- max-buffer-name-length)
- buffer)
- (eval list-symbol)))))
+ (push (cons (funcall (aref function-info 4) ;ITEM-HANDLER
+ buffer
+ max-buffer-name-length)
+ buffer)
+ (symbol-value list-symbol))))
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
"Select the appropriate menu for BUFFER."
@@ -754,7 +741,7 @@ to the buffer-list variable in FUNCTION-INFO."
(defun msb--create-sort-item (function-info)
"Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty."
- (let ((buffer-list (eval (aref function-info 0))))
+ (let ((buffer-list (symbol-value (aref function-info 0))))
(when buffer-list
(let ((sorter (aref function-info 5)) ;SORTER
(sort-key (aref function-info 2))) ;MENU-SORT-KEY
@@ -925,7 +912,7 @@ It takes the form ((TITLE . BUFFER-LIST)...)."
for value = (msb--create-sort-item elt)
if value collect value))))
(setq menu
- (mapcar 'cdr ;Remove the SORT-KEY
+ (mapcar #'cdr ;Remove the SORT-KEY
;; Sort the menus - not the items.
(msb--add-separators
(sort
@@ -1065,9 +1052,12 @@ variable `msb-menu-cond'."
(msb--split-menus-2 list 0 nil)
list))
+(defun msb--select-buffer ()
+ (interactive)
+ (switch-to-buffer last-command-event))
+
(defun msb--make-keymap-menu (raw-menu)
- (let ((end 'menu-bar-select-buffer)
- (mcount 0))
+ (let ((mcount 0))
(mapcar
(lambda (sub-menu)
(cond
@@ -1076,7 +1066,7 @@ variable `msb-menu-cond'."
(t
(let ((buffers (mapcar (lambda (item)
(cons (buffer-name (cdr item))
- (cons (car item) end)))
+ (cons (car item) 'msb--select-buffer)))
(cdr sub-menu))))
(nconc (list (cl-incf mcount) (car sub-menu)
'keymap (car sub-menu))
@@ -1113,8 +1103,8 @@ variable `msb-menu-cond'."
(nconc
(list (frame-parameter frame 'name)
(frame-parameter frame 'name))
- `(lambda ()
- (interactive) (menu-bar-select-frame ,frame))))
+ (lambda ()
+ (interactive) (menu-bar-select-frame frame))))
frames)))))
(setcdr global-buffers-menu-map
(if (and buffers-menu frames-menu)
@@ -1128,7 +1118,7 @@ variable `msb-menu-cond'."
;; C-down-mouse-1).
(defvar msb-mode-map
(let ((map (make-sparse-keymap "Msb")))
- (define-key map [remap mouse-buffer-menu] 'msb)
+ (define-key map [remap mouse-buffer-menu] #'msb)
map))
;;;###autoload
@@ -1137,14 +1127,14 @@ variable `msb-menu-cond'."
This mode overrides the binding(s) of `mouse-buffer-menu' to provide a
different buffer menu using the function `msb'."
- :global t :group 'msb
+ :global t
(if msb-mode
(progn
- (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
- (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
+ (add-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
+ (remove-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
(msb-menu-bar-update-buffers t))
- (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers)
- (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
+ (remove-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers)
+ (add-hook 'menu-bar-update-hook #'menu-bar-update-buffers)
(menu-bar-update-buffers t)))
(defun msb-unload-function ()
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index adfeaccb29b..def77587747 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -40,6 +40,8 @@
(require 'timer)
(defvar mouse-wheel-mode)
+(defvar mouse-wheel--installed-bindings-alist nil
+ "Alist of all installed mouse wheel key bindings.")
;; Setter function for mouse-button user-options. Switch Mouse Wheel
;; mode off and on again so that the old button is unbound and
@@ -47,8 +49,10 @@
(defun mouse-wheel-change-button (var button)
(set-default var button)
- ;; Sync the bindings.
- (when (bound-and-true-p mouse-wheel-mode) (mouse-wheel-mode 1)))
+ ;; Sync the bindings if they're already setup.
+ (when (and mouse-wheel--installed-bindings-alist
+ (bound-and-true-p mouse-wheel-mode))
+ (mouse-wheel-mode 1)))
(defcustom mouse-wheel-down-event
(if (or (featurep 'w32-win) (featurep 'ns-win))
@@ -131,7 +135,10 @@ scrolling."
:version "28.1")
(defcustom mouse-wheel-progressive-speed t
- "If non-nil, the faster the user moves the wheel, the faster the scrolling.
+ "If nil, scrolling speed is proportional to the wheel speed.
+If non-nil, moving the wheel faster will make scrolling
+progressively faster.
+
Note that this has no effect when `mouse-wheel-scroll-amount' specifies
a \"near full screen\" scroll or when the mouse wheel sends key instead
of button events."
@@ -377,9 +384,6 @@ value of ARG, and the command uses it in subsequent scrolls."
(text-scale-decrease 1)))
(select-window selected-window))))
-(defvar mouse-wheel--installed-bindings-alist nil
- "Alist of all installed mouse wheel key bindings.")
-
(defun mouse-wheel--add-binding (key fun)
"Bind mouse wheel button KEY to function FUN.
Save it for later removal by `mouse-wheel--remove-bindings'."
@@ -411,33 +415,35 @@ an event used for scrolling, such as `mouse-wheel-down-event'."
(cons (vector event)
(mapcar (lambda (prefix) (vector prefix event)) prefixes)))))
+;;;###autoload
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support (Mouse Wheel mode)."
:init-value t
- ;; We'd like to use custom-initialize-set here so the setup is done
- ;; before dumping, but at the point where the defcustom is evaluated,
- ;; the corresponding function isn't defined yet, so
- ;; custom-initialize-set signals an error.
- :initialize 'custom-initialize-delay
:global t
:group 'mouse
;; Remove previous bindings, if any.
(mouse-wheel--remove-bindings)
;; Setup bindings as needed.
(when mouse-wheel-mode
- (dolist (binding mouse-wheel-scroll-amount)
- (cond
- ;; Bindings for changing font size.
- ((and (consp binding) (eq (cdr binding) 'text-scale))
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
- (mouse-wheel--add-binding `[,(list (caar binding) event)]
- 'mouse-wheel-text-scale)))
- ;; Bindings for scrolling.
- (t
- (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
- mouse-wheel-left-event mouse-wheel-right-event))
- (dolist (key (mouse-wheel--create-scroll-keys binding event))
- (mouse-wheel--add-binding key 'mwheel-scroll))))))))
+ (mouse-wheel--setup-bindings)))
+
+(defun mouse-wheel--setup-bindings ()
+ (dolist (binding mouse-wheel-scroll-amount)
+ (cond
+ ;; Bindings for changing font size.
+ ((and (consp binding) (eq (cdr binding) 'text-scale))
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event))
+ (mouse-wheel--add-binding `[,(list (caar binding) event)]
+ 'mouse-wheel-text-scale)))
+ ;; Bindings for scrolling.
+ (t
+ (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
+ mouse-wheel-left-event mouse-wheel-right-event))
+ (dolist (key (mouse-wheel--create-scroll-keys binding event))
+ (mouse-wheel--add-binding key 'mwheel-scroll)))))))
+
+(when mouse-wheel-mode
+ (mouse-wheel--setup-bindings))
;;; Obsolete.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index fa13dd57d1d..e302aa89f30 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -949,7 +949,11 @@ Some AT&T folks claim to use something called `pftp' here."
:type 'string)
(defcustom ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
- "A list of arguments passed to the FTP program when started."
+ ;; Clients that use the BSD editline instead of the GNU readline
+ ;; library may need to disable command line editing. (Bug#48494)
+ "A list of arguments passed to the FTP program when started.
+Some FTP clients may also require the \"-e\" argument, which disables
+command line editing."
:group 'ange-ftp
:type '(repeat string))
@@ -2292,7 +2296,7 @@ and NOWAIT."
;; If the dir name contains a space, some ftp servers will
;; refuse to list it. We instead change directory to the
;; directory in question and ls ".".
- (when (string-match " " cmd1)
+ (when (string-search " " cmd1)
;; Keep the result. In case of failure, we will (see below)
;; short-circuit CMD and return this result directly.
(setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
@@ -2877,13 +2881,13 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
(or
;; No dots in dir names in vms.
(and (eq host-type 'vms)
- (string-match "\\." efile))
+ (string-search "." efile))
;; No subdirs in mts of cms.
(and (memq host-type '(mts cms))
(not (string-equal "/" (nth 2 parsed))))
;; No dots in pseudo-dir names in bs2000.
(and (eq host-type 'bs2000)
- (string-match "\\." efile))))))
+ (string-search "." efile))))))
(defun ange-ftp-file-entry-p (name)
"Given NAME, return whether there is a file entry for it."
@@ -3716,7 +3720,7 @@ so return the size on the remote host exactly. See RFC 3659."
(binary (or (ange-ftp-binary-file filename)
(ange-ftp-binary-file newname)))
temp1
- temp2)
+ ) ;; temp2
;; check to see if we can overwrite
(if (or (not ok-if-already-exists)
@@ -3750,7 +3754,7 @@ so return the size on the remote host exactly. See RFC 3659."
filename newname binary msg
f-parsed f-host f-user f-name f-abbr
t-parsed t-host t-user t-name t-abbr
- temp1 temp2 cont nowait)
+ temp1 nil cont nowait) ;; temp2
nowait))
;; filename wasn't remote. newname must be remote. call the
@@ -6111,8 +6115,7 @@ Other orders of $ and _ seem to all work just fine.")
(1- (match-end 2)))))
(filename (if (match-beginning 3)
(substring name (match-beginning 3)))))
- (if (and (boundp 'filename)
- (stringp filename)
+ (if (and (stringp filename)
(string-match "[#@].+" filename))
(setq filename (concat ange-ftp-bs2000-special-prefix
(substring filename 1))))
@@ -6259,10 +6262,6 @@ be recognized automatically (they are all valid BS2000 hosts too)."
;; ange-ftp-bs2000-file-name-as-directory
;; ange-ftp-bs2000-make-compressed-filename
;; ange-ftp-bs2000-file-name-sans-versions
-
-;;;; ------------------------------------------------------------
-;;;; Finally provide package.
-;;;; ------------------------------------------------------------
(provide 'ange-ftp)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 58f01d5bf98..f739cd72cc3 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -47,6 +47,7 @@
;; browse-url-xdg-open freedesktop.org xdg-open
;; browse-url-kde KDE konqueror (kfm)
;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT)
+;; eww-browse-url Emacs Web Wowser
;; Browsers can cache Web pages so it may be necessary to tell them to
;; reload the current page if it has changed (e.g., if you have edited
@@ -758,7 +759,7 @@ for use in `interactive'."
;;;###autoload
(defun browse-url-of-file (&optional file)
- "Ask a WWW browser to display FILE.
+ "Use a web browser to display FILE.
Display the current buffer's file if FILE is nil or if called
interactively. Turn the filename into a URL with function
`browse-url-file-url'. Pass the URL to a browser using the
@@ -773,6 +774,8 @@ interactively. Turn the filename into a URL with function
(cond ((not (buffer-modified-p)))
(browse-url-save-file (save-buffer))
(t (message "%s modified since last save" file))))))
+ (when (file-remote-p file)
+ (setq file (file-local-copy file)))
(browse-url (browse-url-file-url file))
(run-hooks 'browse-url-of-file-hook))
@@ -793,7 +796,9 @@ Use variable `browse-url-filename-alist' to map filenames to URLs."
;;;###autoload
(defun browse-url-of-buffer (&optional buffer)
- "Ask a WWW browser to display BUFFER.
+ "Use a web browser to display BUFFER.
+See `browse-url' for details.
+
Display the current buffer if BUFFER is nil. Display only the
currently visible part of BUFFER (from a temporary file) if buffer is
narrowed."
@@ -826,7 +831,7 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
(if (and file-name (file-exists-p file-name))
(delete-file file-name))))
-(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
+(add-hook 'kill-buffer-hook #'browse-url-delete-temp-file)
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
@@ -842,7 +847,8 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
;;;###autoload
(defun browse-url-of-region (min max)
- "Ask a WWW browser to display the current region."
+ "Use a web browser to display the current region.
+See `browse-url' for details."
(interactive "r")
(save-excursion
(save-restriction
@@ -856,14 +862,18 @@ If optional arg TEMP-FILE-NAME is non-nil, delete it instead."
;;;###autoload
(defun browse-url (url &rest args)
- "Ask a WWW browser to load URL.
-Prompt for a URL, defaulting to the URL at or before point.
-Invokes a suitable browser function which does the actual job.
+ "Open URL using a configurable method.
+This will typically (by default) open URL with an external web
+browser, but a wide variety of different methods can be used,
+depending on the URL type.
The variables `browse-url-browser-function',
`browse-url-handlers', and `browse-url-default-handlers'
determine which browser function to use.
+This command prompts for a URL, defaulting to the URL at or
+before point.
+
The additional ARGS are passed to the browser function. See the
doc strings of the actual functions, starting with
`browse-url-browser-function', for information about the
@@ -895,8 +905,8 @@ If ARGS are omitted, the default is to pass
;;;###autoload
(defun browse-url-at-point (&optional arg)
- "Ask a WWW browser to load the URL at or before point.
-Variable `browse-url-browser-function' says which browser to use.
+ "Open URL at point using a configurable method.
+See `browse-url' for details.
Optional prefix argument ARG non-nil inverts the value of the option
`browse-url-new-window-flag'."
(interactive "P")
@@ -937,10 +947,11 @@ opposite of the browser kind of `browse-url-browser-function'."
;;;###autoload
(defun browse-url-at-mouse (event)
- "Ask a WWW browser to load a URL clicked with the mouse.
-The URL is the one around or before the position of the mouse click
-but point is not changed. Variable `browse-url-browser-function'
-says which browser to use."
+ "Use a web browser to load a URL clicked with the mouse.
+See `browse-url' for details.
+
+The URL is the one around or before the position of the mouse
+click but point is not changed."
(interactive "e")
(save-excursion
(mouse-set-point event)
@@ -1064,7 +1075,7 @@ xdg-open is a desktop utility that calls your preferred web browser."
(executable-find "xdg-open")))
;;;###autoload
-(defun browse-url-xdg-open (url &optional ignored)
+(defun browse-url-xdg-open (url &optional _ignored)
"Pass the specified URL to the \"xdg-open\" command.
xdg-open is a desktop utility that calls your preferred web browser.
The optional argument IGNORED is not used."
@@ -1095,7 +1106,7 @@ used instead of `browse-url-new-window-flag'."
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process
- (apply 'start-process
+ (apply #'start-process
(concat "netscape " url) nil
browse-url-netscape-program
(append
@@ -1113,8 +1124,8 @@ used instead of `browse-url-new-window-flag'."
",new-window"))
")"))))))))
(set-process-sentinel process
- `(lambda (process change)
- (browse-url-netscape-sentinel process ,url)))))
+ (lambda (process _change)
+ (browse-url-netscape-sentinel process url)))))
(function-put 'browse-url-netscape 'browse-url-browser-kind 'external)
@@ -1125,7 +1136,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
(message "Starting %s..." browse-url-netscape-program)
- (apply 'start-process (concat "netscape" url) nil
+ (apply #'start-process (concat "netscape" url) nil
browse-url-netscape-program
(append browse-url-netscape-startup-arguments (list url))))))
@@ -1144,7 +1155,7 @@ How depends on `browse-url-netscape-version'."
"Send a remote control command to Netscape."
(declare (obsolete nil "25.1"))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process "netscape" nil
+ (apply #'start-process "netscape" nil
browse-url-netscape-program
(append browse-url-netscape-arguments
(list "-remote" command)))))
@@ -1170,7 +1181,7 @@ used instead of `browse-url-new-window-flag'."
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(process
- (apply 'start-process
+ (apply #'start-process
(concat "mozilla " url) nil
browse-url-mozilla-program
(append
@@ -1185,8 +1196,8 @@ used instead of `browse-url-new-window-flag'."
",new-window"))
")"))))))
(set-process-sentinel process
- `(lambda (process change)
- (browse-url-mozilla-sentinel process ,url)))))
+ (lambda (process _change)
+ (browse-url-mozilla-sentinel process url)))))
(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external)
@@ -1196,7 +1207,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Mozilla is not running - start it
(message "Starting %s..." browse-url-mozilla-program)
- (apply 'start-process (concat "mozilla " url) nil
+ (apply #'start-process (concat "mozilla " url) nil
browse-url-mozilla-program
(append browse-url-mozilla-startup-arguments (list url))))))
@@ -1219,7 +1230,7 @@ instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process
+ (apply #'start-process
(concat "firefox " url) nil
browse-url-firefox-program
(append
@@ -1242,7 +1253,7 @@ The optional argument NEW-WINDOW is not used."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process
+ (apply #'start-process
(concat "chromium " url) nil
browse-url-chromium-program
(append
@@ -1260,7 +1271,7 @@ The optional argument NEW-WINDOW is not used."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process
+ (apply #'start-process
(concat "google-chrome " url) nil
browse-url-chrome-program
(append
@@ -1290,7 +1301,7 @@ used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
- (process (apply 'start-process
+ (process (apply #'start-process
(concat "galeon " url)
nil
browse-url-galeon-program
@@ -1303,8 +1314,8 @@ used instead of `browse-url-new-window-flag'."
'("--existing"))
(list url)))))
(set-process-sentinel process
- `(lambda (process change)
- (browse-url-galeon-sentinel process ,url)))))
+ (lambda (process _change)
+ (browse-url-galeon-sentinel process url)))))
(function-put 'browse-url-galeon 'browse-url-browser-kind 'external)
@@ -1315,7 +1326,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
(message "Starting %s..." browse-url-galeon-program)
- (apply 'start-process (concat "galeon " url) nil
+ (apply #'start-process (concat "galeon " url) nil
browse-url-galeon-program
(append browse-url-galeon-startup-arguments (list url))))))
@@ -1338,7 +1349,7 @@ used instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
- (process (apply 'start-process
+ (process (apply #'start-process
(concat "epiphany " url)
nil
browse-url-epiphany-program
@@ -1351,8 +1362,8 @@ used instead of `browse-url-new-window-flag'."
'("--existing"))
(list url)))))
(set-process-sentinel process
- `(lambda (process change)
- (browse-url-epiphany-sentinel process ,url)))))
+ (lambda (process _change)
+ (browse-url-epiphany-sentinel process url)))))
(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external)
@@ -1362,7 +1373,7 @@ used instead of `browse-url-new-window-flag'."
(let* ((process-environment (browse-url-process-environment)))
;; Epiphany is not running - start it
(message "Starting %s..." browse-url-epiphany-program)
- (apply 'start-process (concat "epiphany " url) nil
+ (apply #'start-process (concat "epiphany " url) nil
browse-url-epiphany-program
(append browse-url-epiphany-startup-arguments (list url))))))
@@ -1403,7 +1414,7 @@ When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
- (apply 'start-process (concat "gnome-moz-remote " url)
+ (apply #'start-process (concat "gnome-moz-remote " url)
nil
browse-url-gnome-moz-program
(append
@@ -1437,7 +1448,7 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
- (apply 'start-process (format "conkeror %s" url)
+ (apply #'start-process (format "conkeror %s" url)
nil
browse-url-conkeror-program
(append
@@ -1487,7 +1498,7 @@ The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'. Default to the URL around or before point."
(declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
- (apply 'start-process (concat "gnudoit:" url) nil
+ (apply #'start-process (concat "gnudoit:" url) nil
browse-url-gnudoit-program
(append browse-url-gnudoit-args
(list (concat "(w3-fetch \"" url "\")")
@@ -1633,7 +1644,7 @@ used instead of `browse-url-new-window-flag'."
(insert "\n"))
(goto-char (prog1
(point)
- (insert (replace-regexp-in-string "\r\n" "\n" body))
+ (insert (string-replace "\r\n" "\n" body))
(unless (bolp)
(insert "\n"))))))))
@@ -1667,7 +1678,7 @@ don't offer a form of remote control."
(interactive (browse-url-interactive-arg "URL: "))
(if (not browse-url-generic-program)
(error "No browser defined (`browse-url-generic-program')"))
- (apply 'call-process browse-url-generic-program nil
+ (apply #'call-process browse-url-generic-program nil
0 nil
(append browse-url-generic-args (list url))))
@@ -1715,8 +1726,8 @@ from `browse-url-elinks-wrapper'."
(elinks-ping-process (start-process "elinks-ping" nil
"elinks" "-remote" "ping()")))
(set-process-sentinel elinks-ping-process
- `(lambda (process change)
- (browse-url-elinks-sentinel process ,url))))))
+ (lambda (process _change)
+ (browse-url-elinks-sentinel process url))))))
(function-put 'browse-url-elinks 'browse-url-browser-kind 'external)
@@ -1742,9 +1753,9 @@ from `browse-url-elinks-wrapper'."
(defvar browse-url-button-map
(let ((map (make-sparse-keymap)))
- (define-key map "\r" 'browse-url-button-open)
- (define-key map [mouse-2] 'browse-url-button-open)
- (define-key map "w" 'browse-url-button-copy)
+ (define-key map "\r" #'browse-url-button-open)
+ (define-key map [mouse-2] #'browse-url-button-open)
+ (define-key map "w" #'browse-url-button-copy)
map)
"The keymap used for browse-url buttons.")
@@ -1782,6 +1793,7 @@ external browser instead of the default one."
(funcall browse-url-secondary-browser-function url)
(browse-url url))))
+;;;###autoload
(defun browse-url-button-open-url (url)
"Open URL using `browse-url'.
If `current-prefix-arg' is non-nil, use
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index a9de35c814f..4116d293e1b 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -1144,6 +1144,7 @@ compound type arguments (TYPE VALUE) will be kept as is."
EVENT is a D-Bus event, see `dbus-check-event'. HANDLER, being
part of the event, is called with arguments ARGS (without type information).
If the HANDLER returns a `dbus-error', it is propagated as return message."
+ (declare (completion ignore))
(interactive "e")
(condition-case err
(let (monitor args result)
@@ -2028,8 +2029,9 @@ either a method name, a signal name, or an error name."
",")
rule (or rule ""))
- (unless (ignore-errors (dbus-get-unique-name bus-private))
- (dbus-init-bus bus 'private))
+ (when (fboundp 'dbus-get-unique-name)
+ (unless (ignore-errors (dbus-get-unique-name bus-private))
+ (dbus-init-bus bus 'private)))
(dbus-call-method
bus-private dbus-service-dbus dbus-path-dbus dbus-interface-monitoring
"BecomeMonitor" `(:array :string ,rule) :uint32 0)
diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el
index 8ad4fe4e637..b874c488a82 100644
--- a/lisp/net/dictionary-connection.el
+++ b/lisp/net/dictionary-connection.el
@@ -22,10 +22,10 @@
;;; Commentary:
-;; dictionary-connection allows to handle TCP-based connections in
-;; client mode where text-based information are exchanged. There is
+;; dictionary-connection allows handling TCP-based connections in
+;; client mode where text-based information is exchanged. There is
;; special support for handling CR LF (and the usual CR LF . CR LF
-;; terminater).
+;; terminator).
;;; Code:
@@ -68,7 +68,7 @@
(defun dictionary-connection-open (server port)
"Open a connection to SERVER at PORT.
-A data structure identifing the connection is returned"
+Return a data structure identifying the connection."
(let ((process-buffer (generate-new-buffer (format " connection to %s:%s"
server
@@ -82,11 +82,11 @@ A data structure identifing the connection is returned"
(defun dictionary-connection-status (connection)
"Return the status of the CONNECTION.
Possible return values are the symbols:
-nil: argument is no connection object
-'none: argument has no connection
-'up: connection is open and buffer is existing
-'down: connection is closed
-'alone: connection is not associated with a buffer"
+ nil: argument is not a connection object
+ 'none: argument is not connected
+ 'up: connection is open and buffer is existing
+ 'down: connection is closed
+ 'alone: connection is not associated with a buffer"
(when (dictionary-connection-p connection)
(let ((process (dictionary-connection-process connection))
(buffer (dictionary-connection-buffer connection)))
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index ccc24cbf303..f33cbaf1126 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -35,7 +35,6 @@
;;; Code:
(require 'cl-lib)
-(require 'easymenu)
(require 'custom)
(require 'dictionary-connection)
(require 'button)
@@ -77,7 +76,7 @@ You can specify here:
- dict.org: Only use dict.org
- User-defined: You can specify your own server here"
:group 'dictionary
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type '(choice (const :tag "Automatic" nil)
(const :tag "localhost" "localhost")
(const :tag "dict.org" "dict.org")
@@ -89,7 +88,7 @@ You can specify here:
"The port of the dictionary server.
This port is propably always 2628 so there should be no need to modify it."
:group 'dictionary
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'number
:version "28.1")
@@ -127,9 +126,9 @@ by the choice value:
The found word exactly matches the searched word.
-- Similiar sounding
+- Similar sounding
- The found word sounds similiar to the searched word. For this match type
+ The found word sounds similar to the searched word. For this match type
the soundex algorithm defined by Donald E. Knuth is used. It will only
works with english words and the algorithm is not very reliable (i.e.,
the soundex algorithm is quite simple).
@@ -148,7 +147,7 @@ by the choice value:
dictionary server."
:group 'dictionary
:type '(choice (const :tag "Exact match" "exact")
- (const :tag "Similiar sounding" "soundex")
+ (const :tag "Similar sounding" "soundex")
(const :tag "Levenshtein distance one" "lev")
(string :tag "User choice"))
:version "28.1")
@@ -160,6 +159,18 @@ by the choice value:
:type 'boolean
:version "28.1")
+(defcustom dictionary-link-dictionary
+ "*"
+ "The dictionary which is used in links.
+* means to create links that search all dictionaries,
+nil means to create links that search only in the same dictionary
+where the current word was found."
+ :group 'dictionary
+ :type '(choice (const :tag "Link to all dictionaries" "*")
+ (const :tag "Link only to the same dictionary" nil)
+ (string :tag "User choice"))
+ :version "28.1")
+
(defcustom dictionary-mode-hook
nil
"Hook run in dictionary mode buffers."
@@ -167,11 +178,18 @@ by the choice value:
:type 'hook
:version "28.1")
+(defcustom dictionary-post-buffer-hook
+ nil
+ "Hook run at the end of every update of the dictionary buffer."
+ :group 'dictionary
+ :type 'hook
+ :version "28.1")
+
(defcustom dictionary-use-http-proxy
nil
"Connects via a HTTP proxy using the CONNECT command when not nil."
:group 'dictionary-proxy
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'boolean
:version "28.1")
@@ -179,7 +197,7 @@ by the choice value:
"proxy"
"The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'string
:version "28.1")
@@ -187,7 +205,7 @@ by the choice value:
3128
"The port of the proxy server, used only when `dictionary-use-http-proxy' is set."
:group 'dictionary-proxy
- :set 'dictionary-set-server-var
+ :set #'dictionary-set-server-var
:type 'number
:version "28.1")
@@ -313,18 +331,19 @@ is utf-8"
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
- (define-key map "q" 'dictionary-close)
- (define-key map "h" 'dictionary-help)
- (define-key map "s" 'dictionary-search)
- (define-key map "d" 'dictionary-lookup-definition)
- (define-key map "D" 'dictionary-select-dictionary)
- (define-key map "M" 'dictionary-select-strategy)
- (define-key map "m" 'dictionary-match-words)
- (define-key map "l" 'dictionary-previous)
- (define-key map "n" 'forward-button)
- (define-key map "p" 'backward-button)
- (define-key map " " 'scroll-up)
- (define-key map (read-kbd-macro "M-SPC") 'scroll-down)
+ (define-key map "q" #'dictionary-close)
+ (define-key map "h" #'dictionary-help)
+ (define-key map "s" #'dictionary-search)
+ (define-key map "d" #'dictionary-lookup-definition)
+ (define-key map "D" #'dictionary-select-dictionary)
+ (define-key map "M" #'dictionary-select-strategy)
+ (define-key map "m" #'dictionary-match-words)
+ (define-key map "l" #'dictionary-previous)
+ (define-key map "n" #'forward-button)
+ (define-key map "p" #'backward-button)
+ (define-key map " " #'scroll-up-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map (read-kbd-macro "M-SPC") #'scroll-down-command)
map)
"Keymap for the dictionary mode.")
@@ -394,12 +413,12 @@ This is a quick reference to this mode describing the default key bindings:
(make-local-variable 'dictionary-default-dictionary)
(make-local-variable 'dictionary-default-strategy)
- (add-hook 'kill-buffer-hook 'dictionary-close t t)
+ (add-hook 'kill-buffer-hook #'dictionary-close t t)
(run-hooks 'dictionary-mode-hook))
;;;###autoload
(defun dictionary ()
- "Create a new dictonary buffer and install `dictionary-mode'."
+ "Create a new dictionary buffer and install `dictionary-mode'."
(interactive)
(let ((buffer (or (and dictionary-use-single-buffer
(get-buffer "*Dictionary*"))
@@ -516,7 +535,7 @@ The connection takes the proxy setting in customization group
;; Dealing with closing the buffer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun dictionary-close (&rest ignored)
+(defun dictionary-close (&rest _ignored)
"Close the current dictionary buffer and its connection."
(interactive)
(if (eq major-mode 'dictionary-mode)
@@ -548,7 +567,7 @@ The connection takes the proxy setting in customization group
answer)))
(defun dictionary-split-string (string)
- "Split STRING constiting of space-separated words into elements.
+ "Split STRING consisting of space-separated words into elements.
This function knows about the special meaning of quotes (\")"
(let ((list))
(while (and string (> (length string) 0))
@@ -650,7 +669,7 @@ previous state."
(setq dictionary-positions (cons (point) (window-start))))
;; Restore the previous state
-(defun dictionary-restore-state (&rest ignored)
+(defun dictionary-restore-state (&rest _ignored)
"Restore the state just before the last operation."
(let ((position (pop dictionary-position-stack))
(data (pop dictionary-data-stack)))
@@ -702,13 +721,14 @@ of matching words."
(if (dictionary-check-reply reply 552)
(progn
(unless nomatching
- (beep)
- (insert "Word not found, maybe you are looking "
- "for one of these words\n\n")
- (dictionary-do-matching word
- dictionary
- "."
- 'dictionary-display-only-match-result)
+ (insert "Word not found")
+ (dictionary-do-matching
+ word
+ dictionary
+ "."
+ (lambda (reply)
+ (insert ", maybe you are looking for one of these words\n\n")
+ (dictionary-display-only-match-result reply)))
(dictionary-post-buffer)))
(if (dictionary-check-reply reply 550)
(error "Dictionary \"%s\" is unknown, please select an existing one"
@@ -772,7 +792,8 @@ of matching words."
(goto-char dictionary-marker)
(set-buffer-modified-p nil)
- (setq buffer-read-only t))
+ (setq buffer-read-only t)
+ (run-hooks 'dictionary-post-buffer-hook))
(defun dictionary-display-search-result (reply)
"Start displaying the result in REPLY."
@@ -809,7 +830,7 @@ The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION."
(defun dictionary-display-word-definition (reply word dictionary)
"Insert the definition in REPLY for the current WORD from DICTIONARY.
It will replace links which are found in the REPLY and replace
-them with buttons to perform a a new search."
+them with buttons to perform a new search."
(let ((start (point)))
(insert (dictionary-decode-charset reply dictionary))
(insert "\n\n")
@@ -842,6 +863,8 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
(setq word (replace-match " " t t word)))
(while (string-match "[*\"]" word)
(setq word (replace-match "" t t word)))
+ (when dictionary-link-dictionary
+ (setq dictionary dictionary-link-dictionary))
(unless (equal word displayed-word)
(make-button start end :type 'dictionary-link
@@ -850,7 +873,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
'help-echo (concat "Press Mouse-2 to lookup \""
word "\" in \"" dictionary "\"")))))
-(defun dictionary-select-dictionary (&rest ignored)
+(defun dictionary-select-dictionary (&rest _ignored)
"Save the current state and start a dictionary selection."
(interactive)
(dictionary-ensure-buffer)
@@ -858,7 +881,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
(dictionary-do-select-dictionary)
(dictionary-store-state 'dictionary-do-select-dictionary nil))
-(defun dictionary-do-select-dictionary (&rest ignored)
+(defun dictionary-do-select-dictionary (&rest _ignored)
"The workhorse for doing the dictionary selection."
(message "Looking up databases and descriptions")
@@ -871,7 +894,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument."
(unless (dictionary-check-reply reply 110)
(error "Unknown server answer: %s"
(dictionary-reply reply)))
- (dictionary-display-dictionarys))))
+ (dictionary-display-dictionaries))))
(defun dictionary-simple-split-string (string &optional pattern)
"Return a list of substrings of STRING which are separated by PATTERN.
@@ -886,7 +909,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
start (match-end 0)))
(nreverse (cons (substring string start) parts))))
-(defun dictionary-display-dictionarys ()
+(defun dictionary-display-dictionaries ()
"Handle the display of all dictionaries existing on the server."
(dictionary-pre-buffer)
(insert "Please select your default dictionary:\n\n")
@@ -894,7 +917,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(dictionary-display-dictionary-line "! \"The first matching dictionary\"")
(let* ((reply (dictionary-read-answer))
(list (dictionary-simple-split-string reply "\n+")))
- (mapc 'dictionary-display-dictionary-line list))
+ (mapc #'dictionary-display-dictionary-line list))
(dictionary-post-buffer))
(defun dictionary-display-dictionary-line (string)
@@ -962,7 +985,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(dictionary-store-state 'dictionary-display-more-info dictionary))))
-(defun dictionary-select-strategy (&rest ignored)
+(defun dictionary-select-strategy (&rest _ignored)
"Save the current state and start a strategy selection."
(interactive)
(dictionary-ensure-buffer)
@@ -992,7 +1015,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(dictionary-display-strategy-line ". \"The servers default\"")
(let* ((reply (dictionary-read-answer))
(list (dictionary-simple-split-string reply "\n+")))
- (mapc 'dictionary-display-strategy-line list))
+ (mapc #'dictionary-display-strategy-line list))
(dictionary-post-buffer))
(defun dictionary-display-strategy-line (string)
@@ -1008,7 +1031,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
'help-echo (purecopy "Mouse-2 to select this matching algorithm"))
(insert "\n")))))
-(defun dictionary-set-strategy (strategy &rest ignored)
+(defun dictionary-set-strategy (strategy &rest _ignored)
"Select this STRATEGY as new default."
(setq dictionary-default-strategy strategy)
(dictionary-restore-state)
@@ -1052,7 +1075,6 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
(defun dictionary-display-only-match-result (reply)
"Display the results from the current matches in REPLY without the headers."
-
(let ((number (nth 1 (dictionary-reply-list reply)))
(list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
(insert number " matching word" (if (equal number "1") "" "s")
@@ -1117,9 +1139,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
;; - if region is active returns its contents
;; - otherwise return the word near the point
(defun dictionary-search-default ()
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning) (region-end))
- (current-word t)))
+ (cond
+ ((use-region-p)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ ((car (get-char-property (point) 'data)))
+ (t (current-word t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User callable commands
@@ -1146,7 +1170,7 @@ allows editing it."
;; if called by pressing the button
(unless word
(setq word (read-string "Search word: " nil 'dictionary-word-history)))
- ;; just in case non-interactivly called
+ ;; just in case non-interactively called
(unless dictionary
(setq dictionary dictionary-default-dictionary))
(dictionary-new-search (cons word dictionary)))
@@ -1170,7 +1194,7 @@ allows editing it."
(describe-function 'dictionary-mode))
;;;###autoload
-(defun dictionary-match-words (&optional pattern &rest ignored)
+(defun dictionary-match-words (&optional pattern &rest _ignored)
"Search PATTERN in current default dictionary using default strategy."
(interactive)
;; can't use interactive because of mouse events
@@ -1224,10 +1248,10 @@ allows editing it."
;;; Tooltip support
-;; Add a mode indicater named "Dict"
+;; Add a mode indicator named "Dict"
(defvar dictionary-tooltip-mode
nil
- "Indicates wheather the dictionary tooltip mode is active.")
+ "Indicates whether the dictionary tooltip mode is active.")
(nconc minor-mode-alist '((dictionary-tooltip-mode " Dict")))
(defcustom dictionary-tooltip-dictionary
@@ -1246,7 +1270,7 @@ allows editing it."
(defun dictionary-read-definition (&ignore)
(let ((list (dictionary-simple-split-string (dictionary-read-answer) "\n+")))
- (mapconcat 'identity (cdr list) "\n")))
+ (mapconcat #'identity (cdr list) "\n")))
;;; Tooltip support for GNU Emacs
(defvar global-dictionary-tooltip-mode
@@ -1298,8 +1322,8 @@ will be set to nil."
(interactive)
(tooltip-mode on)
(if on
- (add-hook 'tooltip-functions 'dictionary-display-tooltip)
- (remove-hook 'tooltip-functions 'dictionary-display-tooltip)))
+ (add-hook 'tooltip-functions #'dictionary-display-tooltip)
+ (remove-hook 'tooltip-functions #'dictionary-display-tooltip)))
;;;###autoload
(defun dictionary-tooltip-mode (&optional arg)
@@ -1340,9 +1364,8 @@ any buffer where (dictionary-tooltip-mode 1) has been called."
(make-local-variable 'dictionary-tooltip-mouse-event)
(setq-default track-mouse on)
(dictionary-switch-tooltip-mode 1)
- (if on
- (global-set-key [mouse-movement] 'dictionary-tooltip-track-mouse)
- (global-set-key [mouse-movement] 'ignore))
+ (global-set-key [mouse-movement]
+ (if on #'dictionary-tooltip-track-mouse #'ignore))
on))
(provide 'dictionary)
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 92dcf73250b..4f0b0df2b73 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -79,7 +79,7 @@ and is a commonly available debugging tool."
(push domain cmdline)
(if server (push (concat "@" server) cmdline)
(if dig-dns-server (push (concat "@" dig-dns-server) cmdline)))
- (apply 'call-process dig-program nil buf nil cmdline)
+ (apply #'call-process dig-program nil buf nil cmdline)
buf))
(defun dig-extract-rr (domain &optional type class)
@@ -120,7 +120,7 @@ Buffer should contain output generated by `dig-invoke'."
(defvar dig-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "g" nil)
- (define-key map "q" 'dig-exit)
+ (define-key map "q" #'dig-exit)
map))
(define-derived-mode dig-mode special-mode "Dig"
@@ -138,9 +138,14 @@ Buffer should contain output generated by `dig-invoke'."
;;;###autoload
(defun dig (domain &optional
query-type query-class query-option dig-option server)
- "Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
-Optional arguments are passed to `dig-invoke'."
- (interactive "sHost: ")
+ "Query addresses of a DOMAIN using dig.
+See `dig-invoke' for an explanation for the parameters.
+When called interactively, DOMAIN is prompted for. If given a prefix,
+also prompt for the QUERY-TYPE parameter."
+ (interactive
+ (list (read-string "Host: ")
+ (and current-prefix-arg
+ (read-string "Query type: "))))
(pop-to-buffer-same-window
(dig-invoke domain query-type query-class query-option dig-option server))
(goto-char (point-min))
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 2045d4dfca1..1086bab9466 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -135,8 +135,8 @@ updated. Set this variable to t to disable the check.")
(if (stringp ended)
(if (null name)
ended
- (concat (mapconcat 'identity (nreverse name) ".") "." ended))
- (mapconcat 'identity (nreverse name) "."))))
+ (concat (mapconcat #'identity (nreverse name) ".") "." ended))
+ (mapconcat #'identity (nreverse name) "."))))
(defun dns-write (spec &optional tcp-p)
"Write a DNS packet according to SPEC.
@@ -283,7 +283,7 @@ If TCP-P, the first two bytes of the packet will be the length field."
(let ((bytes nil))
(dotimes (_ 4)
(push (dns-read-bytes 1) bytes))
- (mapconcat 'number-to-string (nreverse bytes) ".")))
+ (mapconcat #'number-to-string (nreverse bytes) ".")))
((eq type 'AAAA)
(let (hextets)
(dotimes (_ 8)
@@ -332,7 +332,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(setq dns-servers (nreverse dns-servers))))
(when (executable-find "nslookup")
(with-temp-buffer
- (call-process "nslookup" nil t nil "localhost")
+ (call-process "nslookup" nil t nil "-retry=0" "-timeout=2" "localhost")
(goto-char (point-min))
(when (re-search-forward
"^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\|[[:xdigit:]:]*\\)" nil t)
@@ -386,7 +386,7 @@ If REVERSE, look up an IP address."
(when reverse
(setq name (concat
- (mapconcat 'identity (nreverse (split-string name "\\.")) ".")
+ (mapconcat #'identity (nreverse (split-string name "\\.")) ".")
".in-addr.arpa")
type 'PTR))
@@ -492,19 +492,22 @@ If REVERSE, look up an IP address."
(dns-get-txt-answer (dns-get 'answers result))
(dns-get 'data answer))))))))))
+;;;###autoload
(defun dns-query (name &optional type full reverse)
"Query a DNS server for NAME of TYPE.
If FULL, return the entire record returned.
If REVERSE, look up an IP address."
- (let ((result nil))
- (dns-query-asynchronous
- name
- (lambda (response)
- (setq result (list response)))
- type full reverse)
- ;; Loop until we get the callback.
- (while (not result)
- (sleep-for 0.01))
+ (let* ((result nil)
+ (query-started
+ (dns-query-asynchronous
+ name
+ (lambda (response)
+ (setq result (list response)))
+ type full reverse)))
+ (if query-started
+ ;; Loop until we get the callback.
+ (while (not result)
+ (sleep-for 0.01)))
(car result)))
(provide 'dns)
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 456d70ee0fe..1d7af7f5b5f 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -41,38 +41,38 @@
(defvar eudc-bob-generic-keymap
(let ((map (make-sparse-keymap)))
- (define-key map "s" 'eudc-bob-save-object)
- (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
- (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
+ (define-key map "s" #'eudc-bob-save-object)
+ (define-key map "!" #'eudc-bob-pipe-object-to-external-program)
+ (define-key map [down-mouse-3] #'eudc-bob-popup-menu)
map)
"Keymap for multimedia objects.")
(defvar eudc-bob-image-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map eudc-bob-generic-keymap)
- (define-key map "t" 'eudc-bob-toggle-inline-display)
+ (define-key map "t" #'eudc-bob-toggle-inline-display)
map)
"Keymap for inline images.")
(defvar eudc-bob-sound-keymap
(let ((map (make-sparse-keymap)))
(set-keymap-parent map eudc-bob-generic-keymap)
- (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
- (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
+ (define-key map (kbd "RET") #'eudc-bob-play-sound-at-point)
+ (define-key map [down-mouse-2] #'eudc-bob-play-sound-at-mouse)
map)
"Keymap for inline sounds.")
(defvar eudc-bob-url-keymap
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'browse-url-at-point)
- (define-key map [down-mouse-2] 'browse-url-at-mouse)
+ (define-key map (kbd "RET") #'browse-url-at-point)
+ (define-key map [down-mouse-2] #'browse-url-at-mouse)
map)
"Keymap for inline urls.")
(defvar eudc-bob-mail-keymap
(let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'goto-address-at-point)
- (define-key map [down-mouse-2] 'goto-address-at-point)
+ (define-key map (kbd "RET") #'goto-address-at-point)
+ (define-key map [down-mouse-2] #'goto-address-at-point)
map)
"Keymap for inline e-mail addresses.")
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index bac75e6555d..66db7814ad8 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -1,4 +1,4 @@
-;;; eudc-export.el --- functions to export EUDC query results
+;;; eudc-export.el --- functions to export EUDC query results -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -35,6 +35,7 @@
;; NOERROR is so we can compile it.
(require 'bbdb nil t)
(require 'bbdb-com nil t)
+(require 'cl-lib)
(defun eudc-create-bbdb-record (record &optional silent)
"Create a BBDB record using the RECORD alist.
@@ -42,24 +43,22 @@ RECORD is an alist of (KEY . VALUE) where KEY is a directory attribute name
symbol and VALUE is the corresponding value for the record.
If SILENT is non-nil then the created BBDB record is not displayed."
(require 'bbdb)
+ (declare-function bbdb-create-internal "bbdb-com" (&rest spec))
+ (declare-function bbdb-display-records "bbdb"
+ (records &optional layout append))
;; This function runs in a special context where lisp symbols corresponding
;; to field names in record are bound to the corresponding values
- (eval
- `(let* (,@(mapcar (lambda (c)
- (list (car c) (if (listp (cdr c))
- (list 'quote (cdr c))
- (cdr c))))
- record)
- bbdb-name
- bbdb-company
- bbdb-net
- bbdb-address
- bbdb-phones
- bbdb-notes
- spec
- bbdb-record
- value
- (conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
+ (cl-progv (mapcar #'car record) (mapcar #'cdr record)
+ (let* (bbdb-name
+ bbdb-company
+ bbdb-net
+ bbdb-address
+ bbdb-phones
+ bbdb-notes
+ spec
+ bbdb-record
+ value
+ (conversion-alist (symbol-value eudc-bbdb-conversion-alist)))
;; BBDB standard fields
(setq bbdb-name (eudc-parse-spec (cdr (assq 'name conversion-alist)) record nil)
@@ -68,14 +67,14 @@ If SILENT is non-nil then the created BBDB record is not displayed."
bbdb-notes (eudc-parse-spec (cdr (assq 'notes conversion-alist)) record nil))
(setq spec (cdr (assq 'address conversion-alist)))
(setq bbdb-address (delq nil (eudc-parse-spec (if (listp (car spec))
- spec
- (list spec))
- record t)))
+ spec
+ (list spec))
+ record t)))
(setq spec (cdr (assq 'phone conversion-alist)))
(setq bbdb-phones (delq nil (eudc-parse-spec (if (listp (car spec))
- spec
- (list spec))
- record t)))
+ spec
+ (list spec))
+ record t)))
;; BBDB custom fields
(setq bbdb-notes (append (list (and bbdb-notes (cons 'notes bbdb-notes)))
(mapcar (lambda (mapping)
@@ -85,19 +84,20 @@ If SILENT is non-nil then the created BBDB record is not displayed."
(cons (car mapping) value)))
conversion-alist)))
(setq bbdb-notes (delq nil bbdb-notes))
- (setq bbdb-record (bbdb-create-internal
- bbdb-name
- ,@(when (eudc--using-bbdb-3-or-newer-p)
- '(nil
- nil))
- bbdb-company
- bbdb-net
- ,@(if (eudc--using-bbdb-3-or-newer-p)
- '(bbdb-phones
- bbdb-address)
- '(bbdb-address
- bbdb-phones))
- bbdb-notes))
+ (setq bbdb-record
+ (apply #'bbdb-create-internal
+ `(,bbdb-name
+ ,@(when (eudc--using-bbdb-3-or-newer-p)
+ '(nil
+ nil))
+ ,bbdb-company
+ ,bbdb-net
+ ,@(if (eudc--using-bbdb-3-or-newer-p)
+ (list bbdb-phones
+ bbdb-address)
+ (list bbdb-address
+ bbdb-phones))
+ ,bbdb-notes)))
(or silent
(bbdb-display-records (list bbdb-record))))))
@@ -111,7 +111,7 @@ If RECURSE is non-nil then SPEC may be a list of atomic specs."
(symbolp (car spec))
(fboundp (car spec))))
(condition-case nil
- (eval spec)
+ (eval spec t)
(void-variable nil)))
((and recurse
(listp spec))
@@ -194,9 +194,9 @@ LOCATION is used as the phone location for BBDB."
(signal (car err) (cdr err)))))
(if (= 3 (length phone-list))
(setq phone-list (append phone-list '(nil))))
- (apply 'vector location phone-list)))
+ (apply #'vector location phone-list)))
((listp phone)
- (vector location (mapconcat 'identity phone ", ")))
+ (vector location (mapconcat #'identity phone ", ")))
(t
(error "Invalid phone specification"))))
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index e4b7e8ae71b..a737a99ce95 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -1,4 +1,4 @@
-;;; eudc-hotlist.el --- hotlist management for EUDC
+;;; eudc-hotlist.el --- hotlist management for EUDC -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -37,12 +37,12 @@
(defvar eudc-hotlist-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'eudc-hotlist-add-server)
- (define-key map "d" 'eudc-hotlist-delete-server)
- (define-key map "s" 'eudc-hotlist-select-server)
- (define-key map "t" 'eudc-hotlist-transpose-servers)
- (define-key map "q" 'eudc-hotlist-quit-edit)
- (define-key map "x" 'kill-current-buffer)
+ (define-key map "a" #'eudc-hotlist-add-server)
+ (define-key map "d" #'eudc-hotlist-delete-server)
+ (define-key map "s" #'eudc-hotlist-select-server)
+ (define-key map "t" #'eudc-hotlist-transpose-servers)
+ (define-key map "q" #'eudc-hotlist-quit-edit)
+ (define-key map "x" #'kill-current-buffer)
map))
(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers"
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index f61929c9ef8..6459c52afee 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -49,10 +49,6 @@
(require 'cl-lib)
-(eval-and-compile
- (if (not (fboundp 'make-overlay))
- (require 'overlay)))
-
(unless (fboundp 'custom-menu-create)
(autoload 'custom-menu-create "cus-edit"))
@@ -69,12 +65,12 @@
(defvar eudc-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map widget-keymap)
- (define-key map "q" 'kill-current-buffer)
- (define-key map "x" 'kill-current-buffer)
- (define-key map "f" 'eudc-query-form)
- (define-key map "b" 'eudc-try-bbdb-insert)
- (define-key map "n" 'eudc-move-to-next-record)
- (define-key map "p" 'eudc-move-to-previous-record)
+ (define-key map "q" #'kill-current-buffer)
+ (define-key map "x" #'kill-current-buffer)
+ (define-key map "f" #'eudc-query-form)
+ (define-key map "b" #'eudc-try-bbdb-insert)
+ (define-key map "n" #'eudc-move-to-next-record)
+ (define-key map "p" #'eudc-move-to-previous-record)
map))
(defvar mode-popup-menu)
@@ -411,7 +407,7 @@ if any, is called to print the value in cdr of FIELD."
(val (cdr field)))
(if match
(progn
- (eval (list (cdr match) val))
+ (funcall (cdr match) val)
(insert "\n"))
(mapc
(lambda (val-elem)
@@ -1056,8 +1052,6 @@ queries the server for the existing fields and displays a corresponding form."
;;{{{ Menus and keymaps
-(require 'easymenu)
-
(defconst eudc-custom-generated-menu (cdr (custom-menu-create 'eudc)))
(defconst eudc-tail-menu
@@ -1114,12 +1108,12 @@ queries the server for the existing fields and displays a corresponding form."
proto-name)))
(if (not (fboundp command))
(fset command
- `(lambda ()
- (interactive)
- (eudc-set-server ,server (quote ,protocol))
- (message "Selected directory server is now %s (%s)"
- ,server
- ,proto-name))))
+ (lambda ()
+ (interactive)
+ (eudc-set-server server protocol)
+ (message "Selected directory server is now %s (%s)"
+ server
+ proto-name))))
(vector (format "%s (%s)" server proto-name)
command
:style 'radio
@@ -1135,7 +1129,9 @@ queries the server for the existing fields and displays a corresponding form."
(cons "Directory Servers"
(easy-menu-create-menu "Directory Servers" (cdr (eudc-menu))))))
-;;; Load time initializations :
+;;}}}
+
+;;{{{ Load time initializations
;; Load the options file
(if (and (not noninteractive)
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index e11458b29cb..e241a1c2fac 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -1,4 +1,4 @@
-;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
+;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -34,6 +34,7 @@
;; Make it loadable on systems without bbdb.
(require 'bbdb nil t)
(require 'bbdb-com nil t)
+(require 'seq)
;;{{{ Internal cooking
@@ -87,33 +88,30 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
"Return RECORD if it matches `eudc-bbdb-current-query', nil otherwise."
(require 'bbdb)
(catch 'unmatch
- (progn
- (dolist (condition eudc-bbdb-current-query)
- (let ((attr (car condition))
- (val (cdr condition))
- (case-fold-search t)
- bbdb-val)
- (or (and (memq attr '(firstname lastname aka company phones
- addresses net))
- (progn
- (setq bbdb-val
- (eval (list (intern (concat "bbdb-record-"
- (symbol-name
- (eudc-bbdb-field
- attr))))
- 'record)))
- (if (listp bbdb-val)
- (if eudc-bbdb-enable-substring-matches
- (eval `(or ,@(mapcar (lambda (subval)
- (string-match val subval))
- bbdb-val)))
- (member (downcase val)
- (mapcar 'downcase bbdb-val)))
+ (dolist (condition eudc-bbdb-current-query)
+ (let ((attr (car condition))
+ (val (cdr condition))
+ (case-fold-search t))
+ (or (and (memq attr '(firstname lastname aka company phones
+ addresses net))
+ (let ((bbdb-val
+ (funcall (intern (concat "bbdb-record-"
+ (symbol-name
+ (eudc-bbdb-field
+ attr))))
+ record)))
+ (if (listp bbdb-val)
(if eudc-bbdb-enable-substring-matches
- (string-match val bbdb-val)
- (string-equal (downcase val) (downcase bbdb-val))))))
- (throw 'unmatch nil))))
- record)))
+ (seq-some (lambda (subval)
+ (string-match val subval))
+ bbdb-val)
+ (member (downcase val)
+ (mapcar #'downcase bbdb-val)))
+ (if eudc-bbdb-enable-substring-matches
+ (string-match val bbdb-val)
+ (string-equal (downcase val) (downcase bbdb-val))))))
+ (throw 'unmatch nil))))
+ record))
;; External.
(declare-function bbdb-phone-location "ext:bbdb" t) ; via bbdb-defstruct
@@ -182,40 +180,34 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'."
(require 'bbdb)
(let ((attrs (or eudc-bbdb-current-return-attributes
'(firstname lastname aka company phones addresses net notes)))
- attr
- eudc-rec
- val)
- (while (prog1
- (setq attr (car attrs))
- (setq attrs (cdr attrs)))
- (cond
- ((eq attr 'phones)
- (setq val (eudc-bbdb-extract-phones record)))
- ((eq attr 'addresses)
- (setq val (eudc-bbdb-extract-addresses record)))
- ((eq attr 'notes)
- (if (eudc--using-bbdb-3-or-newer-p)
- (setq val (bbdb-record-xfield record 'notes))
- (setq val (bbdb-record-notes record))))
- ((memq attr '(firstname lastname aka company net))
- (setq val (eval
- (list (intern
- (concat "bbdb-record-"
- (symbol-name (eudc-bbdb-field attr))))
- 'record))))
- (t
- (error "Unknown BBDB attribute")))
- (cond
- ((or (not val) (equal val ""))) ; do nothing
- ((memq attr '(phones addresses))
- (setq eudc-rec (append val eudc-rec)))
- ((and (listp val)
- (= 1 (length val)))
- (setq eudc-rec (cons (cons attr (car val)) eudc-rec)))
- ((> (length val) 0)
- (setq eudc-rec (cons (cons attr val) eudc-rec)))
- (t
- (error "Unexpected attribute value"))))
+ eudc-rec)
+ (dolist (attr attrs)
+ (let ((val
+ (pcase attr
+ ('phones (eudc-bbdb-extract-phones record))
+ ('addresses (eudc-bbdb-extract-addresses record))
+ ('notes
+ (if (eudc--using-bbdb-3-or-newer-p)
+ (bbdb-record-xfield record 'notes)
+ (bbdb-record-notes record)))
+ ((or 'firstname 'lastname 'aka 'company 'net)
+ (funcall (intern
+ (concat "bbdb-record-"
+ (symbol-name (eudc-bbdb-field attr))))
+ record))
+ (_
+ (error "Unknown BBDB attribute")))))
+ (cond
+ ((or (not val) (equal val ""))) ; do nothing
+ ((memq attr '(phones addresses))
+ (setq eudc-rec (append val eudc-rec)))
+ ((and (listp val)
+ (= 1 (length val)))
+ (push (cons attr (car val)) eudc-rec))
+ ((> (length val) 0)
+ (push (cons attr val) eudc-rec))
+ (t
+ (error "Unexpected attribute value")))))
(nreverse eudc-rec)))
@@ -240,21 +232,20 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(while (and records (> (length query-attrs) 0))
(setq bbdb-attrs (append bbdb-attrs (list (car query-attrs))))
(if (car query-attrs)
- (setq records (eval `(bbdb-search ,(quote records) ,@bbdb-attrs))))
+ ;; BEWARE: `bbdb-search' is a macro!
+ (setq records (eval `(bbdb-search records ,@bbdb-attrs) t)))
(setq query-attrs (cdr query-attrs)))
(mapc (lambda (record)
(setq filtered (eudc-filter-duplicate-attributes record))
;; If there were duplicate attributes reverse the order of the
;; record so the unique attributes appear first
(if (> (length filtered) 1)
- (setq filtered (mapcar (lambda (rec)
- (reverse rec))
- filtered)))
+ (setq filtered (mapcar #'reverse filtered)))
(setq result (append result filtered)))
(delq nil
- (mapcar 'eudc-bbdb-format-record-as-result
+ (mapcar #'eudc-bbdb-format-record-as-result
(delq nil
- (mapcar 'eudc-bbdb-filter-non-matching-record
+ (mapcar #'eudc-bbdb-filter-non-matching-record
records)))))
result))
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index 4623079ea9f..0aff276475e 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,4 +1,4 @@
-;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
+;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -38,10 +38,10 @@
;;{{{ Internal cooking
-(eval-and-compile
+(defalias 'eudc-ldap-get-host-parameter
(if (fboundp 'ldap-get-host-parameter)
- (fset 'eudc-ldap-get-host-parameter 'ldap-get-host-parameter)
- (defun eudc-ldap-get-host-parameter (host parameter)
+ #'ldap-get-host-parameter
+ (lambda (host parameter)
"Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'."
(plist-get (cdr (assoc host ldap-host-parameters-alist))
parameter))))
@@ -84,7 +84,7 @@
record))
(defun eudc-filter-$ (string)
- (mapconcat 'identity (split-string string "\\$") "\n"))
+ (mapconcat #'identity (split-string string "\\$") "\n"))
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
"Clean up RECORD to make it suitable for EUDC.
@@ -104,7 +104,7 @@ multiple addresses."
(value (cdr field)))
(when (and clean-up-addresses
(memq name '(postaladdress registeredaddress)))
- (setq value (mapcar 'eudc-filter-$ value)))
+ (setq value (mapcar #'eudc-filter-$ value)))
(if (eq name 'mail)
(setq mail-addresses (append mail-addresses value))
(push (cons name (if (cdr value)
@@ -126,9 +126,9 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(let ((result (ldap-search (eudc-ldap-format-query-as-rfc1558 query)
eudc-server
(if (listp return-attrs)
- (mapcar 'symbol-name return-attrs))))
+ (mapcar #'symbol-name return-attrs))))
final-result)
- (setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
+ (setq result (mapcar #'eudc-ldap-cleanup-record-filtering-addresses result))
(if (and eudc-strict-return-matches
return-attrs
@@ -154,7 +154,7 @@ attribute names are returned. Default to `person'."
(let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
- (mapcar 'eudc-ldap-cleanup-record-filtering-addresses
+ (mapcar #'eudc-ldap-cleanup-record-filtering-addresses
(ldap-search
(eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index eb7032ac4c8..732881f75a0 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -1,4 +1,4 @@
-;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
+;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el
index 66a684dfc59..18c8958c160 100644
--- a/lisp/net/eudcb-macos-contacts.el
+++ b/lisp/net/eudcb-macos-contacts.el
@@ -1,4 +1,4 @@
-;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend
+;;; eudcb-macos-contacts.el --- EUDC - macOS Contacts backend -*- lexical-binding: t; -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
@@ -74,7 +74,7 @@ end tell" str))
"`osascript' executable not found. "
"Is this is a macOS 10.0 or later system?"))))
-(defun eudc-macos-contacts-query-internal (query &optional return-attrs)
+(defun eudc-macos-contacts-query-internal (query &optional _return-attrs)
"Query macOS Contacts with QUERY.
QUERY is a list of cons cells (ATTR . VALUE) where ATTRs should be valid
macOS Contacts attribute names.
@@ -108,7 +108,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(defun eudc-macos-contacts-set-server (dummy)
"Set the EUDC server to macOS Contacts app.
The server in DUMMY is not actually used, since this backend
-always and implicitly connetcs to an instance of the Contacts app
+always and implicitly connects to an instance of the Contacts app
running on the local host."
(interactive)
(eudc-set-server dummy 'macos-contacts)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index e39a4c33b20..90301e92acf 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -779,7 +779,7 @@ Currently this means either text/html or application/xhtml+xml."
(propertize "...: " 'face
'variable-pitch))))
(propertize "..." 'face 'variable-pitch)))))))
- (replace-regexp-in-string
+ (string-replace
"%" "%%"
(format-spec
eww-header-line-format
@@ -855,7 +855,7 @@ Currently this means either text/html or application/xhtml+xml."
(defun eww-view-source ()
"View the HTML source code of the current page."
- (interactive)
+ (interactive nil eww-mode)
(let ((buf (get-buffer-create "*eww-source*"))
(source (plist-get eww-data :source)))
(with-current-buffer buf
@@ -881,7 +881,7 @@ Currently this means either text/html or application/xhtml+xml."
(defun eww-toggle-paragraph-direction ()
"Cycle the paragraph direction between left-to-right, right-to-left and auto."
- (interactive)
+ (interactive nil eww-mode)
(setq bidi-paragraph-direction
(cond ((eq bidi-paragraph-direction 'left-to-right)
nil)
@@ -899,7 +899,7 @@ Currently this means either text/html or application/xhtml+xml."
This command uses heuristics to find the parts of the web page that
contains the main textual portion, leaving out navigation menus and
the like."
- (interactive)
+ (interactive nil eww-mode)
(let* ((old-data eww-data)
(dom (with-temp-buffer
(insert (plist-get old-data :source))
@@ -987,6 +987,7 @@ the like."
(define-key map "F" 'eww-toggle-fonts)
(define-key map "D" 'eww-toggle-paragraph-direction)
(define-key map [(meta C)] 'eww-toggle-colors)
+ (define-key map [(meta I)] 'eww-toggle-images)
(define-key map "b" 'eww-add-bookmark)
(define-key map "B" 'eww-list-bookmarks)
@@ -1015,10 +1016,40 @@ the like."
["List cookies" url-cookie-list t]
["Toggle fonts" eww-toggle-fonts t]
["Toggle colors" eww-toggle-colors t]
+ ["Toggle images" eww-toggle-images t]
["Character Encoding" eww-set-character-encoding]
["Toggle Paragraph Direction" eww-toggle-paragraph-direction]))
map))
+(defun eww-context-menu (menu)
+ (define-key menu [eww-separator] menu-bar-separator)
+ (let ((easy-menu (make-sparse-keymap "Eww")))
+ (easy-menu-define nil easy-menu nil
+ '("Eww"
+ ["Back to previous page" eww-back-url
+ :visible (not (zerop (length eww-history)))]
+ ["Forward to next page" eww-forward-url
+ :visible (not (zerop eww-history-position))]
+ ["Reload" eww-reload t]))
+ (dolist (item (reverse (lookup-key easy-menu [menu-bar eww])))
+ (when (consp item)
+ (define-key menu (vector (car item)) (cdr item)))))
+
+ (when (or (mouse-posn-property (event-start last-input-event) 'shr-url)
+ (mouse-posn-property (event-start last-input-event) 'image-url))
+ (define-key menu [shr-mouse-browse-url-new-window]
+ `(menu-item "Follow URL in new window" ,(if browse-url-new-window-flag
+ 'shr-mouse-browse-url
+ 'shr-mouse-browse-url-new-window)
+ :help "Browse the URL under the mouse cursor in a new window"))
+ (define-key menu [shr-mouse-browse-url]
+ `(menu-item "Follow URL" ,(if browse-url-new-window-flag
+ 'shr-mouse-browse-url-new-window
+ 'shr-mouse-browse-url)
+ :help "Browse the URL under the mouse cursor")))
+
+ menu)
+
(defvar eww-tool-bar-map
(let ((map (make-sparse-keymap)))
(dolist (tool-bar-item
@@ -1038,9 +1069,11 @@ the like."
;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
"Mode for browsing the web."
+ :interactive nil
(setq-local eww-data (list :title ""))
(setq-local browse-url-browser-function #'eww-browse-url)
(add-hook 'after-change-functions #'eww-process-text-input nil t)
+ (add-hook 'context-menu-functions 'eww-context-menu 5 t)
(setq-local eww-history nil)
(setq-local eww-history-position 0)
(when (boundp 'tool-bar-map)
@@ -1090,7 +1123,7 @@ instead of `browse-url-new-window-flag'."
(defun eww-back-url ()
"Go to the previously displayed page."
- (interactive)
+ (interactive nil eww-mode)
(when (>= eww-history-position (length eww-history))
(user-error "No previous page"))
(eww-save-history)
@@ -1099,7 +1132,7 @@ instead of `browse-url-new-window-flag'."
(defun eww-forward-url ()
"Go to the next displayed page."
- (interactive)
+ (interactive nil eww-mode)
(when (zerop eww-history-position)
(user-error "No next page"))
(eww-save-history)
@@ -1123,7 +1156,7 @@ instead of `browse-url-new-window-flag'."
"Go to the page marked `next'.
A page is marked `next' if rel=\"next\" appears in a <link>
or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(if (plist-get eww-data :next)
(eww-browse-url (shr-expand-url (plist-get eww-data :next)
(plist-get eww-data :url)))
@@ -1133,7 +1166,7 @@ or <a> tag."
"Go to the page marked `previous'.
A page is marked `previous' if rel=\"previous\" appears in a <link>
or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(if (plist-get eww-data :previous)
(eww-browse-url (shr-expand-url (plist-get eww-data :previous)
(plist-get eww-data :url)))
@@ -1143,7 +1176,7 @@ or <a> tag."
"Go to the page marked `up'.
A page is marked `up' if rel=\"up\" appears in a <link>
or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(if (plist-get eww-data :up)
(eww-browse-url (shr-expand-url (plist-get eww-data :up)
(plist-get eww-data :url)))
@@ -1153,7 +1186,7 @@ or <a> tag."
"Go to the page marked `top'.
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
- (interactive)
+ (interactive nil eww-mode)
(let ((best-url (or (plist-get eww-data :start)
(plist-get eww-data :contents)
(plist-get eww-data :home))))
@@ -1166,7 +1199,7 @@ appears in a <link> or <a> tag."
If LOCAL is non-nil (interactively, the command was invoked with
a prefix argument), don't reload the page from the network, but
just re-display the HTML already fetched."
- (interactive "P")
+ (interactive "P" eww-mode)
(let ((url (plist-get eww-data :url)))
(if local
(if (null (plist-get eww-data :dom))
@@ -1232,12 +1265,12 @@ just re-display the HTML already fetched."
(defun eww-beginning-of-text ()
"Move to the start of the input field."
- (interactive)
+ (interactive nil eww-mode)
(goto-char (eww-beginning-of-field)))
(defun eww-end-of-text ()
"Move to the end of the text in the input field."
- (interactive)
+ (interactive nil eww-mode)
(goto-char (eww-end-of-field))
(let ((start (eww-beginning-of-field)))
(while (and (equal (following-char) ? )
@@ -1329,7 +1362,7 @@ just re-display the HTML already fetched."
(defun eww-select-file ()
"Change the value of the upload file menu under point."
- (interactive)
+ (interactive nil eww-mode)
(let* ((input (get-text-property (point) 'eww-form)))
(let ((filename
(let ((insert-default-directory t))
@@ -1537,7 +1570,9 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-change-select (event)
"Change the value of the select drop-down menu under point."
- (interactive (list last-nonmenu-event))
+ (interactive
+ (list last-nonmenu-event)
+ eww-mode)
(mouse-set-point event)
(let ((input (get-text-property (point) 'eww-form)))
(popup-menu
@@ -1572,7 +1607,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-toggle-checkbox ()
"Toggle the value of the checkbox under point."
- (interactive)
+ (interactive nil eww-mode)
(let* ((input (get-text-property (point) 'eww-form))
(type (plist-get input :type)))
(if (equal type "checkbox")
@@ -1592,9 +1627,9 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(goto-char (car elem))
(if (not (eq (cdr elem) input))
(progn
- (plist-put input :checked nil)
+ (plist-put (cdr elem) :checked nil)
(eww-update-field eww-form-checkbox-symbol))
- (plist-put input :checked t)
+ (plist-put (cdr elem) :checked t)
(eww-update-field eww-form-checkbox-selected-symbol)))))
(forward-char 1)))))
@@ -1642,7 +1677,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-submit ()
"Submit the current form."
- (interactive)
+ (interactive nil eww-mode)
(let* ((this-input (get-text-property (point) 'eww-form))
(form (plist-get this-input :eww-form))
values next-submit)
@@ -1729,7 +1764,7 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
"Browse the current URL with an external browser.
The browser to used is specified by the
`browse-url-secondary-browser-function' variable."
- (interactive)
+ (interactive nil eww-mode)
(funcall browse-url-secondary-browser-function
(or url (plist-get eww-data :url))))
@@ -1739,7 +1774,9 @@ If EXTERNAL is single prefix, browse the URL using
`browse-url-secondary-browser-function'.
If EXTERNAL is double prefix, browse in new buffer."
- (interactive (list current-prefix-arg last-nonmenu-event))
+ (interactive
+ (list current-prefix-arg last-nonmenu-event)
+ eww-mode)
(mouse-set-point mouse-event)
(let ((url (get-text-property (point) 'shr-url)))
(cond
@@ -1773,14 +1810,14 @@ Differences in #targets are ignored."
(defun eww-copy-page-url ()
"Copy the URL of the current page into the kill ring."
- (interactive)
+ (interactive nil eww-mode)
(message "%s" (plist-get eww-data :url))
(kill-new (plist-get eww-data :url)))
(defun eww-download ()
"Download URL to `eww-download-directory'.
Use link at point if there is one, else the current page's URL."
- (interactive)
+ (interactive nil eww-mode)
(let ((dir (if (stringp eww-download-directory)
eww-download-directory
(funcall eww-download-directory))))
@@ -1848,14 +1885,14 @@ Use link at point if there is one, else the current page's URL."
(defun eww-set-character-encoding (charset)
"Set character encoding to CHARSET.
If CHARSET is nil then use UTF-8."
- (interactive "zUse character set (default utf-8): ")
+ (interactive "zUse character set (default utf-8): " eww-mode)
(if (null charset)
(eww-reload nil 'utf-8)
(eww-reload nil charset)))
(defun eww-switch-to-buffer ()
"Prompt for an EWW buffer to display in the selected window."
- (interactive)
+ (interactive nil eww-mode)
(let ((completion-extra-properties
'(:annotation-function (lambda (buf)
(with-current-buffer buf
@@ -1873,7 +1910,7 @@ If CHARSET is nil then use UTF-8."
(defun eww-toggle-fonts ()
"Toggle whether to use monospaced or font-enabled layouts."
- (interactive)
+ (interactive nil eww-mode)
(setq shr-use-fonts (not shr-use-fonts))
(eww-reload)
(message "Proportional fonts are now %s"
@@ -1881,20 +1918,28 @@ If CHARSET is nil then use UTF-8."
(defun eww-toggle-colors ()
"Toggle whether to use HTML-specified colors or not."
- (interactive)
+ (interactive nil eww-mode)
(message "Colors are now %s"
(if (setq shr-use-colors (not shr-use-colors))
"on"
"off"))
(eww-reload))
+(defun eww-toggle-images ()
+ "Toggle whether or not to display images."
+ (interactive nil eww-mode)
+ (setq shr-inhibit-images (not shr-inhibit-images))
+ (eww-reload)
+ (message "Images are now %s"
+ (if shr-inhibit-images "off" "on")))
+
;;; Bookmarks code
(defvar eww-bookmarks nil)
(defun eww-add-bookmark ()
"Bookmark the current page."
- (interactive)
+ (interactive nil eww-mode)
(eww-read-bookmarks)
(dolist (bookmark eww-bookmarks)
(when (equal (plist-get eww-data :url) (plist-get bookmark :url))
@@ -1958,7 +2003,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-bookmark-kill ()
"Kill the current bookmark."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let* ((start (line-beginning-position))
(bookmark (get-text-property start 'eww-bookmark))
(inhibit-read-only t))
@@ -1972,7 +2017,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-bookmark-yank ()
"Yank a previously killed bookmark to the current line."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(unless eww-bookmark-kill-ring
(user-error "No previously killed bookmark"))
(beginning-of-line)
@@ -1990,7 +2035,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-bookmark-browse ()
"Browse the bookmark under point in eww."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
(unless bookmark
(user-error "No bookmark on the current line"))
@@ -1999,7 +2044,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-next-bookmark ()
"Go to the next bookmark in the list."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let ((first nil)
bookmark)
(unless (get-buffer "*eww bookmarks*")
@@ -2018,7 +2063,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-previous-bookmark ()
"Go to the previous bookmark in the list."
- (interactive)
+ (interactive nil eww-bookmark-mode)
(let ((first nil)
bookmark)
(unless (get-buffer "*eww bookmarks*")
@@ -2061,6 +2106,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
"Mode for listing bookmarks.
\\{eww-bookmark-mode-map}"
+ :interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
@@ -2109,7 +2155,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-history-browse ()
"Browse the history under point in eww."
- (interactive)
+ (interactive nil eww-history-mode)
(let ((history (get-text-property (line-beginning-position) 'eww-history)))
(unless history
(error "No history on the current line"))
@@ -2137,6 +2183,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
"Mode for listing eww-histories.
\\{eww-history-mode-map}"
+ :interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
@@ -2191,7 +2238,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-buffer-select ()
"Switch to eww buffer."
- (interactive)
+ (interactive nil eww-buffers-mode)
(let ((buffer (get-text-property (line-beginning-position)
'eww-buffer)))
(unless buffer
@@ -2211,7 +2258,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-buffer-show-next ()
"Move to next eww buffer in the list and display it."
- (interactive)
+ (interactive nil eww-buffers-mode)
(forward-line)
(when (eobp)
(goto-char (point-min)))
@@ -2219,7 +2266,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-buffer-show-previous ()
"Move to previous eww buffer in the list and display it."
- (interactive)
+ (interactive nil eww-buffers-mode)
(beginning-of-line)
(when (bobp)
(goto-char (point-max)))
@@ -2228,7 +2275,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
(defun eww-buffer-kill ()
"Kill buffer from eww list."
- (interactive)
+ (interactive nil eww-buffers-mode)
(let* ((start (line-beginning-position))
(buffer (get-text-property start 'eww-buffer))
(inhibit-read-only t))
@@ -2262,6 +2309,7 @@ If ERROR-OUT, signal user-error if there are no bookmarks."
"Mode for listing buffers.
\\{eww-buffers-mode-map}"
+ :interactive nil
(buffer-disable-undo)
(setq truncate-lines t))
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index ff58cbb035e..43dd9dc15cd 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -1,10 +1,10 @@
-;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
+;;; gnutls.el --- Support SSL/TLS connections through GnuTLS -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
-;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/)
+;; Originally-By: Simon Josefsson (See https://josefsson.org/emacs-security/)
;; Thanks-To: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -59,7 +59,6 @@ general, Emacs network security is handled by the Network
Security Manager (NSM), and the default value of nil delegates
the job of checking the connection security to the NSM.
See Info node `(emacs) Network Security'."
- :group 'gnutls
:type '(choice (const nil)
string))
@@ -91,7 +90,6 @@ checks are performed at the gnutls level. Instead the checks are
performed via `open-network-stream' at a higher level by the
Network Security Manager. See Info node `(emacs) Network
Security'."
- :group 'gnutls
:version "24.4"
:type '(choice
(const t)
@@ -118,7 +116,6 @@ Security'."
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
- :group 'gnutls
:type '(choice (function :tag "Function to produce list of bundle filenames")
(repeat (file :tag "Bundle filename"))))
@@ -139,7 +136,6 @@ network security is handled at a higher level via
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
(integer :tag "Number of bits" 2048))
- :group 'gnutls
:version "27.1")
(defcustom gnutls-crlfiles
@@ -150,7 +146,6 @@ node `(emacs) Network Security'."
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
- :group 'gnutls
:type '(choice (function :tag "Function to produce list of CRL filenames")
(repeat (file :tag "CRL filename")))
:version "27.1")
@@ -341,8 +336,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
t)
;; if a list, look for hostname matches
((listp gnutls-verify-error)
- (cadr (cl-find-if #'(lambda (x)
- (string-match (car x) hostname))
+ (cadr (cl-find-if (lambda (x)
+ (string-match (car x) hostname))
gnutls-verify-error)))
;; else it's nil
(t nil))))
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index d1926302470..2c43d0f7532 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -1,4 +1,4 @@
-;;; goto-addr.el --- click to browse URL or to send to e-mail address
+;;; goto-addr.el --- click to browse URL or to send to e-mail address -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2000-2021 Free Software Foundation, Inc.
@@ -73,19 +73,16 @@
(defcustom goto-address-fontify-p t
"Non-nil means URLs and e-mail addresses in buffer are fontified.
But only if `goto-address-highlight-p' is also non-nil."
- :type 'boolean
- :group 'goto-address)
+ :type 'boolean)
(defcustom goto-address-highlight-p t
"Non-nil means URLs and e-mail addresses in buffer are highlighted."
- :type 'boolean
- :group 'goto-address)
+ :type 'boolean)
(defcustom goto-address-fontify-maximum-size 30000
"Maximum size of file in which to fontify and/or highlight URLs.
A value of t means there is no limit--fontify regardless of the size."
- :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t))
- :group 'goto-address)
+ :type '(choice (integer :tag "Maximum size") (const :tag "No limit" t)))
(defvar goto-address-mail-regexp
;; Actually pretty much any char could appear in the username part. -stef
@@ -122,30 +119,34 @@ will have no effect.")
(defvar goto-address-highlight-keymap
(let ((m (make-sparse-keymap)))
- (define-key m (kbd "<mouse-2>") 'goto-address-at-point)
- (define-key m (kbd "C-c RET") 'goto-address-at-point)
+ (define-key m (kbd "<mouse-2>") #'goto-address-at-point)
+ (define-key m (kbd "C-c RET") #'goto-address-at-point)
m)
"Keymap to hold goto-addr's mouse key defs under highlighted URLs.")
+(defun goto-address-context-menu (menu)
+ (when (mouse-posn-property (event-start last-input-event) 'goto-address)
+ (define-key menu [goto-address-separator] menu-bar-separator)
+ (define-key menu [goto-address-at-mouse]
+ '(menu-item "Follow Link" goto-address-at-mouse
+ :help "Follow a link where you click")))
+ menu)
+
(defcustom goto-address-url-face 'link
"Face to use for URLs."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defcustom goto-address-url-mouse-face 'highlight
"Face to use for URLs when the mouse is on them."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defcustom goto-address-mail-face 'italic
"Face to use for e-mail addresses."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defcustom goto-address-mail-mouse-face 'secondary-selection
"Face to use for e-mail addresses when the mouse is on them."
- :type 'face
- :group 'goto-address)
+ :type 'face)
(defun goto-address-unfontify (start end)
"Remove `goto-address' fontification from the given region."
@@ -252,6 +253,11 @@ address. If no e-mail address found, return nil."
(goto-char (match-beginning 0))))
(match-string-no-properties 0)))
+(defun goto-address-at-mouse (click)
+ "Send to the e-mail address or load the URL at mouse click."
+ (interactive "e")
+ (goto-address-at-point click))
+
;;;###autoload
(defun goto-address ()
"Sets up goto-address functionality in the current buffer.
@@ -270,15 +276,17 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
;;;###autoload
(define-minor-mode goto-address-mode
"Minor mode to buttonize URLs and e-mail addresses in the current buffer."
- nil
- ""
- nil
- (if goto-address-mode
- (jit-lock-register #'goto-address-fontify-region)
+ :lighter ""
+ (cond
+ (goto-address-mode
+ (jit-lock-register #'goto-address-fontify-region)
+ (add-hook 'context-menu-functions 'goto-address-context-menu 10 t))
+ (t
(jit-lock-unregister #'goto-address-fontify-region)
(save-restriction
(widen)
- (goto-address-unfontify (point-min) (point-max)))))
+ (goto-address-unfontify (point-min) (point-max)))
+ (remove-hook 'context-menu-functions 'goto-address-context-menu t))))
(defun goto-addr-mode--turn-on ()
(when (not goto-address-mode)
@@ -287,15 +295,12 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
;;;###autoload
(define-globalized-minor-mode global-goto-address-mode
goto-address-mode goto-addr-mode--turn-on
- :group 'goto-address
:version "28.1")
;;;###autoload
(define-minor-mode goto-address-prog-mode
"Like `goto-address-mode', but only for comments and strings."
- nil
- ""
- nil
+ :lighter ""
(if goto-address-prog-mode
(jit-lock-register #'goto-address-fontify-region)
(jit-lock-unregister #'goto-address-fontify-region)
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 052ef292957..6ca76f1f994 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -160,7 +160,6 @@
%l with the value of `imap-default-user'. The program should accept
IMAP commands on stdin and return responses to stdout. Each entry in
the list is tried until a successful connection is made."
- :group 'imap
:type '(repeat string))
(defcustom imap-gssapi-program (list
@@ -173,7 +172,6 @@ the list is tried until a successful connection is made."
%l with the value of `imap-default-user'. The program should accept
IMAP commands on stdin and return responses to stdout. Each entry in
the list is tried until a successful connection is made."
- :group 'imap
:type '(repeat string))
(defcustom imap-shell-program '("ssh %s imapd"
@@ -186,7 +184,6 @@ number on server, %g with `imap-shell-host', and %l with
`imap-default-user'. The program should read IMAP commands from stdin
and write IMAP response to stdout. Each entry in the list is tried
until a successful connection is made."
- :group 'imap
:type '(repeat string))
(defcustom imap-process-connection-type nil
@@ -198,7 +195,6 @@ system has no ptys or if all ptys are busy: then a pipe is used
in any case. The value takes effect when an IMAP server is
opened; changing it after that has no effect."
:version "22.1"
- :group 'imap
:type 'boolean)
(defcustom imap-use-utf7 t
@@ -206,7 +202,6 @@ opened; changing it after that has no effect."
Since the UTF7 decoding currently only decodes into ISO-8859-1
characters, you may disable this decoding if you need to access UTF7
encoded mailboxes which doesn't translate into ISO-8859-1."
- :group 'imap
:type 'boolean)
(defcustom imap-log nil
@@ -217,7 +212,6 @@ It is not written to disk, however. Do not enable this
variable unless you are comfortable with that.
See also `imap-debug'."
- :group 'imap
:type 'boolean)
(defcustom imap-debug nil
@@ -232,17 +226,14 @@ variable unless you are comfortable with that.
This variable only takes effect when loading the `imap' library.
See also `imap-log'."
- :group 'imap
:type 'boolean)
(defcustom imap-shell-host "gateway"
"Hostname of rlogin proxy."
- :group 'imap
:type 'string)
(defcustom imap-default-user (user-login-name)
"Default username to use."
- :group 'imap
:type 'string)
(defcustom imap-read-timeout (if (memq system-type '(windows-nt cygwin))
@@ -250,12 +241,10 @@ See also `imap-log'."
0.1)
"How long to wait between checking for the end of output.
Shorter values mean quicker response, but is more CPU intensive."
- :type 'number
- :group 'imap)
+ :type 'number)
(defcustom imap-store-password nil
"If non-nil, store session password without prompting."
- :group 'imap
:type 'boolean)
;;; Various variables
@@ -737,9 +726,9 @@ sure of changing the value of `foo'."
:end-of-command "\r\n"
:success "^1 OK "
:starttls-function
- #'(lambda (capabilities)
- (when (string-match-p "STARTTLS" capabilities)
- "1 STARTTLS\r\n"))))
+ (lambda (capabilities)
+ (when (string-match-p "STARTTLS" capabilities)
+ "1 STARTTLS\r\n"))))
done)
(when process
(imap-log buffer)
@@ -987,8 +976,8 @@ t if it successfully authenticates, nil otherwise."
"imap" buffer imap-server imap-port)
((error quit) nil)))
(when imap-process
- (set-process-filter imap-process 'imap-arrival-filter)
- (set-process-sentinel imap-process 'imap-sentinel)
+ (set-process-filter imap-process #'imap-arrival-filter)
+ (set-process-sentinel imap-process #'imap-sentinel)
(while (and (eq imap-state 'initial)
(memq (process-status imap-process) '(open run)))
(message "Waiting for response from %s..." imap-server)
@@ -1012,7 +1001,7 @@ necessary. If nil, the buffer name is generated."
(with-current-buffer (get-buffer-create buffer)
(if (imap-opened buffer)
(imap-close buffer))
- (mapc 'make-local-variable imap-local-variables)
+ (mapc #'make-local-variable imap-local-variables)
(set-buffer-multibyte nil)
(buffer-disable-undo)
(setq imap-server (or server imap-server))
@@ -1034,7 +1023,7 @@ necessary. If nil, the buffer name is generated."
;; Stream changed?
(if (not (eq imap-default-stream stream))
(with-current-buffer (generate-new-buffer " *temp*")
- (mapc 'make-local-variable imap-local-variables)
+ (mapc #'make-local-variable imap-local-variables)
(set-buffer-multibyte nil)
(buffer-disable-undo)
(setq imap-server (or server imap-server))
@@ -1078,7 +1067,6 @@ necessary. If nil, the buffer name is generated."
"If non-nil, check if IMAP is open.
See the function `imap-ping-server'."
:version "23.1" ;; No Gnus
- :group 'imap
:type 'boolean)
(defun imap-opened (&optional buffer)
@@ -1346,16 +1334,16 @@ If BUFFER is nil the current buffer is assumed."
(when imap-current-mailbox
(if asynch
(imap-add-callback (imap-send-command "CLOSE")
- `(lambda (tag status)
- (message "IMAP mailbox `%s' closed... %s"
- imap-current-mailbox status)
- (when (eq ,imap-current-mailbox
- imap-current-mailbox)
- ;; Don't wipe out data if another mailbox
- ;; was selected...
- (setq imap-current-mailbox nil
- imap-message-data nil
- imap-state 'auth))))
+ (let ((cmb imap-current-mailbox))
+ (lambda (_tag status)
+ (message "IMAP mailbox `%s' closed... %s"
+ imap-current-mailbox status)
+ (when (eq cmb imap-current-mailbox)
+ ;; Don't wipe out data if another mailbox
+ ;; was selected...
+ (setq imap-current-mailbox nil
+ imap-message-data nil
+ imap-state 'auth)))))
(when (imap-ok-p (imap-send-command-wait "CLOSE"))
(setq imap-current-mailbox nil
imap-message-data nil
@@ -1740,8 +1728,8 @@ See `imap-enable-exchange-bug-workaround'."
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
- (apply 'max (imap-message-map
- (lambda (uid _prop) uid) 'UID))))
+ (apply #'max (imap-message-map
+ (lambda (uid _prop) uid) 'UID))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@@ -1786,7 +1774,7 @@ first element. The rest of list contains the saved articles' UIDs."
(prog1
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
- (apply 'max (imap-message-map
+ (apply #'max (imap-message-map
(lambda (uid _prop) uid) 'UID))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
@@ -1820,7 +1808,7 @@ on failure."
(numberp (nth 9 body)))
(nth 9 body))
(t 0))
- (apply '+ (mapcar 'imap-body-lines body)))
+ (apply #'+ (mapcar #'imap-body-lines body)))
0))
(defun imap-envelope-from (from)
@@ -2424,7 +2412,7 @@ Return nil if no complete line has arrived."
(buffer-substring (point) (1- (re-search-forward "[] ]" nil t)))))
(if (eq (char-before) ? )
(prog1
- (mapconcat 'identity (cons section (imap-parse-header-list)) " ")
+ (mapconcat #'identity (cons section (imap-parse-header-list)) " ")
(search-forward "]" nil t))
section)))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 0476835ebd9..7997bf3c90b 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,4 +1,4 @@
-;;; ldap.el --- client interface to LDAP for Emacs
+;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -418,12 +418,12 @@ RFC2798 Section 9.1.1")
(encode-coding-string str ldap-coding-system))
(defun ldap-decode-address (str)
- (mapconcat 'ldap-decode-string
+ (mapconcat #'ldap-decode-string
(split-string str "\\$")
"\n"))
(defun ldap-encode-address (str)
- (mapconcat 'ldap-encode-string
+ (mapconcat #'ldap-encode-string
(split-string str "\n")
"$"))
@@ -601,7 +601,7 @@ an alist of attribute/value pairs."
(sizelimit (plist-get search-plist 'sizelimit))
(withdn (plist-get search-plist 'withdn))
(numres 0)
- arglist dn name value record result proc)
+ arglist dn name value record result)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
@@ -671,7 +671,7 @@ an alist of attribute/value pairs."
" bind distinguished name (binddn)"))
(error "Failed ldapsearch invocation: %s \"%s\""
ldap-ldapsearch-prog
- (mapconcat 'identity proc-args "\" \""))))))
+ (mapconcat #'identity proc-args "\" \""))))))
(apply #'call-process ldap-ldapsearch-prog
;; Ignore stderr, which can corrupt results
nil (list buf nil) nil
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index b95cd0febcd..5473ba7e697 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -332,7 +332,7 @@ whose car is a symbol, it is `eval'uated to yield the validity. If it
is a string or list of strings, it represents a shell command to run
to return a true or false shell value for the validity.
-The last matching entry in this structure takes presedence over
+The last matching entry in this structure takes precedence over
preceding entries.")
(put 'mailcap-mime-data 'risky-local-variable t)
@@ -1075,7 +1075,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
(dolist (data mailcap--computed-mime-data)
(dolist (info (cdr data))
(setq type (cdr (assq 'type (cdr info))))
- (unless (string-match-p "\\*" type)
+ (unless (string-search "*" type)
(push type res))))
(nreverse res)))))
@@ -1156,6 +1156,46 @@ current buffer after passing its contents to the shell command."
(mailcap--async-shell method file))
(funcall method))))
+(defun mailcap-view-file (file)
+ "View FILE according to rules given by the mailcap system.
+This normally involves executing some external program to display
+the file.
+
+See \"~/.mailcap\", `mailcap-mime-data' and related files and variables."
+ (interactive "fOpen file with mailcap: ")
+ (setq file (expand-file-name file))
+ (mailcap-parse-mailcaps)
+ (let ((command (mailcap-mime-info
+ (mailcap-extension-to-mime (file-name-extension file)))))
+ (unless command
+ (error "No viewer for %s" (file-name-extension file)))
+ ;; Remove quotes around the file name - we'll use shell-quote-argument.
+ (while (string-match "['\"]%s['\"]" command)
+ (setq command (replace-match "%s" t t command)))
+ (setq command (replace-regexp-in-string
+ "%s"
+ (shell-quote-argument (convert-standard-filename file))
+ command
+ nil t))
+ ;; Handlers such as "gio open" and kde-open5 start viewer in background
+ ;; and exit immediately. Avoid `start-process' since it assumes
+ ;; :connection-type `pty' and kills children processes with SIGHUP
+ ;; when temporary terminal session is finished (Bug#44824).
+ ;; An alternative is `process-connection-type' let-bound to nil for
+ ;; `start-process-shell-command' call (with no chance to report failure).
+ (make-process
+ :name "mailcap-view-file"
+ :connection-type 'pipe
+ :buffer nil ; "*Messages*" may be suitable for debugging
+ :sentinel (lambda (proc event)
+ (when (and (memq (process-status proc) '(exit signal))
+ (/= (process-exit-status proc) 0))
+ (message
+ "Command %s: %s."
+ (mapconcat #'identity (process-command proc) " ")
+ (substring event 0 -1))))
+ :command (list shell-file-name shell-command-switch command))))
+
(provide 'mailcap)
;;; mailcap.el ends here
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 08edb44275c..727aa55de58 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -1,4 +1,4 @@
-;;; mairix.el --- Mairix interface for Emacs
+;;; mairix.el --- Mairix interface for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -83,55 +83,46 @@
(defcustom mairix-file-path "~/"
"Path where output files produced by Mairix should be stored."
- :type 'directory
- :group 'mairix)
+ :type 'directory)
(defcustom mairix-search-file "mairixsearch.mbox"
"Name of the default file for storing the searches.
Note that this will be prefixed by `mairix-file-path'."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-command "mairix"
"Command for calling mairix.
You can add further options here if you want to, but better use
`mairix-update-options' instead."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-output-buffer "*mairix output*"
"Name of the buffer for the output of the mairix binary."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-customize-query-buffer "*mairix query*"
"Name of the buffer for customizing a search query."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-saved-searches-buffer "*mairix searches*"
"Name of the buffer for displaying saved searches."
- :type 'string
- :group 'mairix)
+ :type 'string)
(defcustom mairix-update-options '("-F" "-Q")
"Options when calling mairix for updating the database.
The default is \"-F\" and \"-Q\" for making updates faster. You
should call mairix without these options from time to
time (e.g. via cron job)."
- :type '(repeat string)
- :group 'mairix)
+ :type '(repeat string))
(defcustom mairix-search-options '("-Q")
"Options when calling mairix for searching.
The default is \"-Q\" for making searching faster."
- :type '(repeat string)
- :group 'mairix)
+ :type '(repeat string))
(defcustom mairix-synchronous-update nil
"Defines if Emacs should wait for the mairix database update."
- :type 'boolean
- :group 'mairix)
+ :type 'boolean)
(defcustom mairix-saved-searches nil
"Saved mairix searches.
@@ -144,8 +135,7 @@ threads (nil or t). Note that the file will be prefixed by
(choice :tag "File"
(const :tag "default")
file)
- (boolean :tag "Threads")))
- :group 'mairix)
+ (boolean :tag "Threads"))))
(defcustom mairix-mail-program 'rmail
"Mail program used to display search results.
@@ -153,8 +143,7 @@ Currently RMail, Gnus (mbox), and VM are supported. If you use Gnus
with maildir, use nnmairix.el instead."
:type '(choice (const :tag "RMail" rmail)
(const :tag "Gnus mbox" gnus)
- (const :tag "VM" vm))
- :group 'mairix)
+ (const :tag "VM" vm)))
(defcustom mairix-display-functions
'((rmail mairix-rmail-display)
@@ -166,8 +155,7 @@ This is an alist where each entry consists of a symbol from
displaying the search results. The function will be called with
the mailbox file produced by mairix as the single argument."
:type '(repeat (list (symbol :tag "Mail program")
- (function)))
- :group 'mairix)
+ (function))))
(defcustom mairix-get-mail-header-functions
'((rmail mairix-rmail-fetch-field)
@@ -184,15 +172,13 @@ won't work."
:type '(repeat (list (symbol :tag "Mail program")
(choice :tag "Header function"
(const :tag "none")
- function)))
- :group 'mairix)
+ function))))
(defcustom mairix-widget-select-window-function
(lambda () (select-window (get-largest-window)))
"Function for selecting the window for customizing the mairix query.
The default chooses the largest window in the current frame."
- :type 'function
- :group 'mairix)
+ :type 'function)
;; Other variables
@@ -342,6 +328,7 @@ Currently there are `threads' and `flags'.")
;;;; Main interactive functions
+;;;###autoload
(defun mairix-search (search threads)
"Call Mairix with SEARCH.
If THREADS is non-nil, also display whole threads of found
@@ -356,6 +343,7 @@ messages. Results will be put into the default search file."
threads)
(mairix-show-folder mairix-search-file)))
+;;;###autoload
(defun mairix-use-saved-search ()
"Use a saved search for querying Mairix."
(interactive)
@@ -388,6 +376,7 @@ Overwrite existing entry? ")
(setcdr (assoc name mairix-saved-searches) mairix-last-search))))
(mairix-select-save))
+;;;###autoload
(defun mairix-edit-saved-searches-customize ()
"Edit the list of saved searches in a customization buffer."
(interactive)
@@ -400,6 +389,8 @@ in your .emacs by pressing `Save for Future Sessions'.\n"
(make-string 65 ?=) "\n")))
(autoload 'mail-strip-quoted-names "mail-utils")
+
+;;;###autoload
(defun mairix-search-from-this-article (threads)
"Search messages from sender of the current article.
This is effectively a shortcut for calling `mairix-search' with
@@ -416,6 +407,7 @@ threads."
threads)
(error "No function for obtaining mail header specified"))))
+;;;###autoload
(defun mairix-search-thread-this-article ()
"Search thread for the current article.
This is effectively a shortcut for calling `mairix-search'
@@ -430,19 +422,21 @@ with m:msgid of the current article and enabled threads."
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
;; mairix somehow does not like '$' in message-id
- (when (string-match "\\$" mid)
+ (when (string-search "$" mid)
(setq mid (concat mid "=")))
(while (string-match "\\$" mid)
(setq mid (replace-match "=," t t mid)))
(mairix-search
(format "m:%s" mid) t)))
+;;;###autoload
(defun mairix-widget-search-based-on-article ()
"Create mairix query based on current article using widgets."
(interactive)
(mairix-widget-search
(mairix-widget-get-values)))
+;;;###autoload
(defun mairix-edit-saved-searches ()
"Edit current mairix searches."
(interactive)
@@ -455,6 +449,7 @@ with m:msgid of the current article and enabled threads."
(defvar mairix-widgets)
+;;;###autoload
(defun mairix-widget-search (&optional mvalues)
"Create mairix query interactively using graphical widgets.
MVALUES may contain values from current article."
@@ -466,24 +461,25 @@ MVALUES may contain values from current article."
;; generate Buttons
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _)
(mairix-widget-send-query mairix-widgets))
"Send Query")
(widget-insert " ")
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _)
(mairix-widget-save-search mairix-widgets))
"Save search")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(kill-buffer mairix-customize-query-buffer))
"Cancel")
(use-local-map widget-keymap)
(widget-setup)
(goto-char (point-min)))
+;;;###autoload
(defun mairix-update-database ()
"Call mairix for updating the database for SERVERS.
Mairix will be called asynchronously unless
@@ -502,7 +498,7 @@ Mairix will be called asynchronously unless
(cdr commandsplit)
mairix-update-options))
(setq args (append args mairix-update-options)))
- (apply 'call-process args))
+ (apply #'call-process args))
(progn
(message "Updating mairix database...")
(setq args (append (list "mairixupdate" (get-buffer-create mairix-output-buffer)
@@ -511,8 +507,8 @@ Mairix will be called asynchronously unless
(setq args (append args (cdr commandsplit) mairix-update-options))
(setq args (append args mairix-update-options)))
(set-process-sentinel
- (apply 'start-process args)
- 'mairix-sentinel-mairix-update-finished)))))
+ (apply #'start-process args)
+ #'mairix-sentinel-mairix-update-finished)))))
;;;; Helper functions
@@ -535,8 +531,11 @@ The mail program is given by `mairix-mail-program'."
If FILE is nil, use default. If THREADS is non-nil, also return
whole threads. Function returns t if messages were found."
(let* ((commandsplit (split-string mairix-command))
- (args (cons (car commandsplit)
- `(nil ,(get-buffer-create mairix-output-buffer) nil)))
+ (args (cons
+ (car commandsplit)
+ (append
+ `(nil ,(get-buffer-create mairix-output-buffer) nil)
+ mairix-search-options)))
rval)
(with-current-buffer mairix-output-buffer
(erase-buffer))
@@ -557,7 +556,7 @@ whole threads. Function returns t if messages were found."
mairix-file-path))
file))
(setq rval
- (apply 'call-process
+ (apply #'call-process
(append args (list "-o" file) query)))
(if (zerop rval)
(with-current-buffer mairix-output-buffer
@@ -582,7 +581,7 @@ whole threads. Function returns t if messages were found."
(setq header (replace-match "," t t header)))
header))
-(defun mairix-sentinel-mairix-update-finished (proc status)
+(defun mairix-sentinel-mairix-update-finished (_proc status)
"Sentinel for mairix update process PROC with STATUS."
(if (equal status "finished\n")
(message "Updating mairix database... done")
@@ -642,51 +641,50 @@ See %s for details" mairix-output-buffer)))
(when (not (zerop (length flag)))
(push (concat "F:" flag) query)))
;; return query string
- (mapconcat 'identity query " ")))
+ (mapconcat #'identity query " ")))
(defun mairix-widget-create-query (&optional values)
"Create widgets for creating mairix queries.
Fill in VALUES if based on an article."
- (let (allwidgets)
- (when (get-buffer mairix-customize-query-buffer)
- (kill-buffer mairix-customize-query-buffer))
- (switch-to-buffer mairix-customize-query-buffer)
- (kill-all-local-variables)
- (erase-buffer)
- (widget-insert
- "Specify your query for Mairix using check boxes for activating fields.\n\n")
- (widget-insert
- (concat "Use ~word to match messages "
- (propertize "not" 'face 'italic)
- " containing the word)\n"
- " substring= to match words containing the substring\n"
- " substring=N to match words containing the substring, allowing\n"
- " up to N errors(missing/extra/different letters)\n"
- " ^substring= to match the substring at the beginning of a word.\n"))
- (widget-insert
- (format-message
- "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
- (setq mairix-widgets (mairix-widget-build-editable-fields values))
- (when (member 'flags mairix-widget-other)
- (widget-insert "\nFlags:\n Seen: ")
- (mairix-widget-add "seen"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore"))
- (widget-insert " Replied: ")
- (mairix-widget-add "replied"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore"))
- (widget-insert " Ticked: ")
- (mairix-widget-add "flagged"
- 'menu-choice
- :value "ignore"
- '(item "yes") '(item "no") '(item "ignore")))
- (when (member 'threads mairix-widget-other)
- (widget-insert "\n")
- (mairix-widget-add "Threads" 'checkbox nil))
- (widget-insert " Show full threads\n\n")))
+ (when (get-buffer mairix-customize-query-buffer)
+ (kill-buffer mairix-customize-query-buffer))
+ (switch-to-buffer mairix-customize-query-buffer)
+ (kill-all-local-variables)
+ (erase-buffer)
+ (widget-insert
+ "Specify your query for Mairix using check boxes for activating fields.\n\n")
+ (widget-insert
+ (concat "Use ~word to match messages "
+ (propertize "not" 'face 'italic)
+ " containing the word)\n"
+ " substring= to match words containing the substring\n"
+ " substring=N to match words containing the substring, allowing\n"
+ " up to N errors(missing/extra/different letters)\n"
+ " ^substring= to match the substring at the beginning of a word.\n"))
+ (widget-insert
+ (format-message
+ "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
+ (setq mairix-widgets (mairix-widget-build-editable-fields values))
+ (when (member 'flags mairix-widget-other)
+ (widget-insert "\nFlags:\n Seen: ")
+ (mairix-widget-add "seen"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore"))
+ (widget-insert " Replied: ")
+ (mairix-widget-add "replied"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore"))
+ (widget-insert " Ticked: ")
+ (mairix-widget-add "flagged"
+ 'menu-choice
+ :value "ignore"
+ '(item "yes") '(item "no") '(item "ignore")))
+ (when (member 'threads mairix-widget-other)
+ (widget-insert "\n")
+ (mairix-widget-add "Threads" 'checkbox nil))
+ (widget-insert " Show full threads\n\n"))
(defun mairix-widget-build-editable-fields (values)
"Build editable field widgets in `nnmairix-widget-fields-list'.
@@ -703,7 +701,7 @@ VALUES may contain values for editable fields from current article."
(concat "c" field)
(widget-create 'checkbox
:tag field
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (widget &rest _ignore)
(mairix-widget-toggle-activate widget))
nil)))
(list
@@ -727,7 +725,7 @@ VALUES may contain values for editable fields from current article."
"Add a widget NAME with optional ARGS."
(push
(list name
- (apply 'widget-create args))
+ (apply #'widget-create args))
mairix-widgets))
(defun mairix-widget-toggle-activate (widget)
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index d5aad3a3f77..90cca7d415c 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -1,4 +1,4 @@
-;;; net-utils.el --- network functions
+;;; net-utils.el --- network functions -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -67,17 +67,14 @@
"tracert"
"traceroute")
"Program to trace network hops to a destination."
- :group 'net-utils
:type 'string)
(defcustom traceroute-program-options nil
"Options for the traceroute program."
- :group 'net-utils
:type '(repeat string))
(defcustom ping-program "ping"
"Program to send network test packets to a host."
- :group 'net-utils
:type 'string)
;; On GNU/Linux and Irix, the system's ping program seems to send packets
@@ -87,7 +84,6 @@
(list "-c" "4"))
"Options for the ping program.
These options can be used to limit how many ICMP packets are emitted."
- :group 'net-utils
:type '(repeat string))
(defcustom ifconfig-program
@@ -98,7 +94,6 @@ These options can be used to limit how many ICMP packets are emitted."
(t "ip"))
"Program to print network configuration information."
:version "25.1" ; add ip
- :group 'net-utils
:type 'string)
(defcustom ifconfig-program-options
@@ -108,7 +103,6 @@ These options can be used to limit how many ICMP packets are emitted."
"Options for the ifconfig program."
:version "25.1"
:set-after '(ifconfig-program)
- :group 'net-utils
:type '(repeat string))
(defcustom iwconfig-program
@@ -116,7 +110,6 @@ These options can be used to limit how many ICMP packets are emitted."
((net-utils--executable-find-sbin "iw") "iw")
(t "iw"))
"Program to print wireless network configuration information."
- :group 'net-utils
:type 'string
:version "26.1")
@@ -124,7 +117,6 @@ These options can be used to limit how many ICMP packets are emitted."
(cond ((string-match-p "iw\\'" iwconfig-program) (list "dev"))
(t nil))
"Options for the iwconfig program."
- :group 'net-utils
:type '(repeat string)
:version "26.1")
@@ -133,25 +125,21 @@ These options can be used to limit how many ICMP packets are emitted."
((net-utils--executable-find-sbin "ss"))
(t "ss"))
"Program to print network statistics."
- :group 'net-utils
:type 'string
:version "26.1")
(defcustom netstat-program-options
(list "-a")
"Options for the netstat program."
- :group 'net-utils
:type '(repeat string))
(defcustom arp-program (or (net-utils--executable-find-sbin "arp") "arp")
"Program to print IP to address translation tables."
- :group 'net-utils
:type 'string)
(defcustom arp-program-options
(list "-a")
"Options for the arp program."
- :group 'net-utils
:type '(repeat string))
(defcustom route-program
@@ -162,7 +150,6 @@ These options can be used to limit how many ICMP packets are emitted."
((net-utils--executable-find-sbin "ip"))
(t "ip"))
"Program to print routing tables."
- :group 'net-utils
:type 'string
:version "26.1")
@@ -171,18 +158,15 @@ These options can be used to limit how many ICMP packets are emitted."
((string-match-p "netstat\\'" route-program) (list "-r"))
(t (list "route")))
"Options for the route program."
- :group 'net-utils
:type '(repeat string)
:version "26.1")
(defcustom nslookup-program "nslookup"
"Program to interactively query DNS information."
- :group 'net-utils
:type 'string)
(defcustom nslookup-program-options nil
"Options for the nslookup program."
- :group 'net-utils
:type '(repeat string))
(defcustom nslookup-prompt-regexp "^> "
@@ -190,28 +174,23 @@ These options can be used to limit how many ICMP packets are emitted."
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
- :group 'net-utils
:type 'regexp)
(defcustom dig-program "dig"
"Program to query DNS information."
- :group 'net-utils
:type 'string)
(defcustom dig-program-options nil
"Options for the dig program."
- :group 'net-utils
:type '(repeat string)
:version "26.1")
(defcustom ftp-program "ftp"
"Program to run to do FTP transfers."
- :group 'net-utils
:type 'string)
(defcustom ftp-program-options nil
"Options for the ftp program."
- :group 'net-utils
:type '(repeat string))
(defcustom ftp-prompt-regexp "^ftp>"
@@ -219,17 +198,14 @@ This variable is only used if the variable
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
- :group 'net-utils
:type 'regexp)
(defcustom smbclient-program "smbclient"
"Smbclient program."
- :group 'net-utils
:type 'string)
(defcustom smbclient-program-options nil
"Options for the smbclient program."
- :group 'net-utils
:type '(repeat string))
(defcustom smbclient-prompt-regexp "^smb: >"
@@ -237,17 +213,14 @@ This variable is only used if the variable
This variable is only used if the variable
`comint-use-prompt-regexp' is non-nil."
- :group 'net-utils
:type 'regexp)
(defcustom dns-lookup-program "host"
"Program to interactively query DNS information."
- :group 'net-utils
:type 'string)
(defcustom dns-lookup-program-options nil
"Options for the dns-lookup program."
- :group 'net-utils
:type '(repeat string))
;; Internal variables
@@ -265,7 +238,7 @@ This variable is only used if the variable
1 'font-lock-keyword-face)
;; Dotted quads
(list
- (mapconcat 'identity
+ (mapconcat #'identity
(make-list 4 "[0-9]+")
"\\.")
0 'font-lock-variable-name-face)
@@ -273,7 +246,7 @@ This variable is only used if the variable
(list
(let ((host-expression "[-A-Za-z0-9]+"))
(concat
- (mapconcat 'identity
+ (mapconcat #'identity
(make-list 2 host-expression)
"\\.")
"\\(\\." host-expression "\\)*"))
@@ -288,7 +261,7 @@ This variable is only used if the variable
(list
;; Dotted quads
(list
- (mapconcat 'identity (make-list 4 "[0-9]+") "\\.")
+ (mapconcat #'identity (make-list 4 "[0-9]+") "\\.")
0 'font-lock-variable-name-face)
;; Simple rfc4291 addresses
(list (concat
@@ -300,7 +273,7 @@ This variable is only used if the variable
(list
(let ((host-expression "[-A-Za-z0-9]+"))
(concat
- (mapconcat 'identity (make-list 2 host-expression) "\\.")
+ (mapconcat #'identity (make-list 2 host-expression) "\\.")
"\\(\\." host-expression "\\)*"))
0 'font-lock-variable-name-face))
"Expressions to font-lock for general network utilities.")
@@ -371,8 +344,8 @@ This variable is only used if the variable
(erase-buffer)
(insert header "\n")
(set-process-filter
- (apply 'start-process name buf program args)
- 'net-utils-remove-ctrl-m-filter)
+ (apply #'start-process name buf program args)
+ #'net-utils-remove-ctrl-m-filter)
(display-buffer buf)
buf))
@@ -390,27 +363,27 @@ This variable is only used if the variable
(when proc
(set-process-filter proc nil)
(delete-process proc)))
- (let ((inhibit-read-only t)
- (coding-system-for-read
- ;; MS-Windows versions of network utilities output text
- ;; encoded in the console (a.k.a. "OEM") codepage, which is
- ;; different from the default system (a.k.a. "ANSI")
- ;; codepage.
- (if (eq system-type 'windows-nt)
- (intern (format "cp%d" (w32-get-console-output-codepage)))
- coding-system-for-read)))
+ (let ((inhibit-read-only t))
(erase-buffer))
(net-utils-mode)
(setq-local net-utils--revert-cmd
`(net-utils-run-simple ,(current-buffer)
,program-name ,args nodisplay))
- (set-process-filter
- (apply 'start-process program-name
- (current-buffer) program-name args)
- 'net-utils-remove-ctrl-m-filter)
+ (let ((coding-system-for-read
+ ;; MS-Windows versions of network utilities output text
+ ;; encoded in the console (a.k.a. "OEM") codepage, which is
+ ;; different from the default system (a.k.a. "ANSI")
+ ;; codepage.
+ (if (eq system-type 'windows-nt)
+ (intern (format "cp%d" (w32-get-console-output-codepage)))
+ coding-system-for-read)))
+ (set-process-filter
+ (apply #'start-process program-name
+ (current-buffer) program-name args)
+ #'net-utils-remove-ctrl-m-filter))
(unless nodisplay (display-buffer (current-buffer)))))
-(defun net-utils--revert-function (&optional ignore-auto noconfirm)
+(defun net-utils--revert-function (&optional _ignore-auto _noconfirm)
(message "Reverting `%s'..." (buffer-name))
(apply (car net-utils--revert-cmd) (cdr net-utils--revert-cmd))
(let ((proc (get-buffer-process (current-buffer))))
@@ -430,7 +403,7 @@ This variable is only used if the variable
ifconfig-program
ifconfig-program-options))
-(defalias 'ipconfig 'ifconfig)
+(defalias 'ipconfig #'ifconfig)
;;;###autoload
(defun iwconfig ()
@@ -532,7 +505,7 @@ in Lisp code."
(net-utils-run-program
"Nslookup"
(concat "** "
- (mapconcat 'identity
+ (mapconcat #'identity
(list "Nslookup" host nslookup-program)
" ** "))
nslookup-program
@@ -618,7 +591,7 @@ This command uses `nslookup-program' to look up DNS records."
(defvar nslookup-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\t" #'completion-at-point)
map))
;; Using a derived mode gives us keymaps, hooks, etc.
@@ -646,9 +619,9 @@ This command uses `dns-lookup-program' for looking up the DNS information."
(net-utils-run-program
(concat "DNS Lookup [" host "]")
(concat "** "
- (mapconcat 'identity
- (list "DNS Lookup" host dns-lookup-program)
- " ** "))
+ (mapconcat #'identity
+ (list "DNS Lookup" host dns-lookup-program)
+ " ** "))
dns-lookup-program
options)))
@@ -669,13 +642,14 @@ This command uses `dig-program' for looking up the DNS information."
(net-utils-run-program
"Dig"
(concat "** "
- (mapconcat 'identity
+ (mapconcat #'identity
(list "Dig" host dig-program)
" ** "))
dig-program
options)))
(autoload 'comint-exec "comint")
+(declare-function comint-watch-for-password-prompt "comint" (string))
;; This is a lot less than ange-ftp, but much simpler.
;;;###autoload
@@ -697,7 +671,7 @@ This command uses `dig-program' for looking up the DNS information."
(defvar ftp-mode-map
(let ((map (make-sparse-keymap)))
;; Occasionally useful
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\t" #'completion-at-point)
map))
(define-derived-mode ftp-mode comint-mode "FTP"
@@ -710,9 +684,9 @@ This command uses `dig-program' for looking up the DNS information."
;; password prompts will probably immediately follow the initial
;; connection), but it's better than getting prompted twice for the
;; same password.
- (unless (memq 'comint-watch-for-password-prompt
+ (unless (memq #'comint-watch-for-password-prompt
(default-value 'comint-output-filter-functions))
- (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
+ (add-hook 'comint-output-filter-functions #'comint-watch-for-password-prompt
nil t)))
(defun smbclient (host service)
@@ -759,9 +733,9 @@ This command uses `smbclient-program' to connect to HOST."
;; password prompts will probably immediately follow the initial
;; connection), but it's better than getting prompted twice for the
;; same password.
- (unless (memq 'comint-watch-for-password-prompt
+ (unless (memq #'comint-watch-for-password-prompt
(default-value 'comint-output-filter-functions))
- (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt
+ (add-hook 'comint-output-filter-functions #'comint-watch-for-password-prompt
nil t)))
@@ -810,7 +784,7 @@ This list is not complete.")
(error "Could not open connection to %s" host))
(erase-buffer)
(set-marker (process-mark tcp-connection) (point-min))
- (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
+ (set-process-filter tcp-connection #'net-utils-remove-ctrl-m-filter)
(and initial-string
(process-send-string tcp-connection
(concat initial-string "\r\n")))
@@ -825,7 +799,6 @@ This list is not complete.")
If a host name passed to `finger' matches one of these regular
expressions, it is assumed to be a host that doesn't accept
queries of the form USER@HOST, and wants a query containing USER only."
- :group 'net-utils
:type '(repeat regexp)
:version "21.1")
@@ -852,7 +825,7 @@ and `network-connection-service-alist', which see."
(let* ((user-and-host (concat user "@" host))
(process-name (concat "Finger [" user-and-host "]"))
(regexps finger-X.500-host-regexps)
- found)
+ ) ;; found
(and regexps
(while (not (string-match (car regexps) host))
(setq regexps (cdr regexps)))
@@ -866,7 +839,6 @@ and `network-connection-service-alist', which see."
(defcustom whois-server-name "rs.internic.net"
"Default host name for the whois service."
- :group 'net-utils
:type 'string)
(defcustom whois-server-list
@@ -880,15 +852,19 @@ and `network-connection-service-alist', which see."
("whois.nic.gov")
("whois.ripe.net"))
"A list of whois servers that can be queried."
- :group 'net-utils
:type '(repeat (list string)))
;; FIXME: modern whois clients include a much better tld <-> whois server
;; list, Emacs should probably avoid specifying the server as the client
;; will DTRT anyway... -rfr
+;; I'm not sure about the above FIXME. It seems to me that we should
+;; just check the Root Zone Database maintained at:
+;; https://www.iana.org/domains/root/db
+;; For example: whois -h whois.iana.org .se | grep whois
(defcustom whois-server-tld
- '(("rs.internic.net" . "com")
- ("whois.publicinterestregistry.net" . "org")
+ '(("whois.verisign-grs.com" . "com")
+ ("whois.verisign-grs.com" . "net")
+ ("whois.pir.org" . "org")
("whois.ripe.net" . "be")
("whois.ripe.net" . "de")
("whois.ripe.net" . "dk")
@@ -896,21 +872,22 @@ and `network-connection-service-alist', which see."
("whois.ripe.net" . "fi")
("whois.ripe.net" . "fr")
("whois.ripe.net" . "uk")
+ ("whois.iis.se" . "se")
+ ("whois.iis.nu" . "nu")
("whois.apnic.net" . "au")
("whois.apnic.net" . "ch")
("whois.apnic.net" . "hk")
("whois.apnic.net" . "jp")
+ ("whois.eu" . "eu")
("whois.nic.gov" . "gov")
("whois.nic.mil" . "mil"))
"Alist to map top level domains to whois servers."
- :group 'net-utils
:type '(repeat (cons string string)))
(defcustom whois-guess-server t
"If non-nil then whois will try to deduce the appropriate whois
server from the query. If the query doesn't look like a domain or hostname
then the server named by `whois-server-name' is used."
- :group 'net-utils
:type 'boolean)
(defun whois-get-tld (host)
@@ -951,7 +928,6 @@ The port is deduced from `network-connection-service-alist'."
(defcustom whois-reverse-lookup-server "whois.arin.net"
"Server which provides inverse DNS mapping."
- :group 'net-utils
:type 'string)
;;;###autoload
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index b45cefcb442..1983688cef2 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -248,8 +248,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(list key cert)))))))
;;;###autoload
-(defalias 'open-protocol-stream 'open-network-stream)
-(define-obsolete-function-alias 'open-protocol-stream 'open-network-stream
+(define-obsolete-function-alias 'open-protocol-stream #'open-network-stream
"26.1")
(defun network-stream-open-plain (name buffer host service parameters)
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index ea96012af20..dc541943587 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -39,10 +39,10 @@
(require 'iso8601)
;; Silence warnings
+(defvar newsticker-groups)
(defvar w3-mode-map)
(defvar w3m-minor-mode-map)
-
(defvar newsticker--retrieval-timer-list nil
"List of timers for news retrieval.
This is an alist, each element consisting of (feed-name . timer).")
@@ -66,35 +66,34 @@ considered to be running if the newsticker timer list is not empty."
;; Hard-coding URLs like this is a recipe for propagating obsolete info.
(defconst newsticker--raw-url-list-defaults
- '(
- ("Debian Security Advisories"
- "http://www.debian.org/security/dsa.en.rdf")
+ '(("Debian Security Advisories"
+ "https://www.debian.org/security/dsa.en.rdf")
("Debian Security Advisories - Long format"
- "http://www.debian.org/security/dsa-long.en.rdf")
+ "https://www.debian.org/security/dsa-long.en.rdf")
("Emacs Wiki"
- "https://www.emacswiki.org/emacs?action=rss"
- nil
- 3600)
+ "https://www.emacswiki.org/emacs?action=rss"
+ nil
+ 3600)
("LWN (Linux Weekly News)"
- "https://lwn.net/headlines/rss")
+ "https://lwn.net/headlines/rss")
("Quote of the day"
- "http://feeds.feedburner.com/quotationspage/qotd"
- "07:00"
- 86400)
+ "https://feeds.feedburner.com/quotationspage/qotd"
+ "07:00"
+ 86400)
("The Register"
- "https://www.theregister.co.uk/headlines.rss")
+ "https://www.theregister.co.uk/headlines.rss")
("slashdot"
- "http://rss.slashdot.org/Slashdot/slashdot"
- nil
- 3600) ;/. will ban you if under 3600 seconds!
+ "http://rss.slashdot.org/Slashdot/slashdot"
+ nil
+ 3600) ;/. will ban you if under 3600 seconds!
("Wired News"
- "https://www.wired.com/feed/rss")
+ "https://www.wired.com/feed/rss")
("Heise News (german)"
- "http://www.heise.de/newsticker/heise.rdf")
+ "http://www.heise.de/newsticker/heise.rdf")
("Tagesschau (german)"
- "http://www.tagesschau.de/newsticker.rdf"
- nil
- 1800))
+ "http://www.tagesschau.de/newsticker.rdf"
+ nil
+ 1800))
"Default URL list in raw form.
This list is fed into defcustom via `newsticker--splicer'.")
@@ -153,10 +152,10 @@ value effective."
:group 'newsticker)
(defcustom newsticker-url-list-defaults
- '(("Emacs Wiki"
- "https://www.emacswiki.org/emacs?action=rss"
- nil
- 3600))
+ '(("Emacs Wiki"
+ "https://www.emacswiki.org/emacs?action=rss"
+ nil
+ 3600))
"A customizable list of news feeds to select from.
These were mostly extracted from the Radio Community Server
<http://rcs.userland.com/>.
@@ -164,7 +163,7 @@ These were mostly extracted from the Radio Community Server
You may add other entries in `newsticker-url-list'."
:type `(set ,@(mapcar #'newsticker--splicer
newsticker--raw-url-list-defaults))
- :set 'newsticker--set-customvar-retrieval
+ :set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-url-list nil
@@ -218,7 +217,7 @@ which apply for this feed only, overriding the value of
(choice :tag "Wget Arguments"
(const :tag "Default arguments" nil)
(repeat :tag "Special arguments" string))))
- :set 'newsticker--set-customvar-retrieval
+ :set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-retrieval-method
@@ -261,7 +260,7 @@ make it less than 1800 seconds (30 minutes)!"
(const :tag "Daily" 86400)
(const :tag "Weekly" 604800)
(integer :tag "Interval"))
- :set 'newsticker--set-customvar-retrieval
+ :set #'newsticker--set-customvar-retrieval
:group 'newsticker-retrieval)
(defcustom newsticker-desc-comp-max
@@ -550,7 +549,7 @@ name/timer pair to `newsticker--retrieval-timer-list'."
(if (<= interval 0)
(setq interval nil))
(setq timer (run-at-time start-time interval
- 'newsticker-get-news feed-name))
+ #'newsticker-get-news feed-name))
(if interval
(add-to-list 'newsticker--retrieval-timer-list
(cons feed-name timer))))))
@@ -611,7 +610,7 @@ This does NOT start the retrieval timers."
(interactive)
(let ((filename (read-string "Filename: "
(concat feed ":_"
- (replace-regexp-in-string
+ (string-replace
" " "_" (newsticker--title item))
".html"))))
(with-temp-buffer
@@ -645,6 +644,15 @@ If URL is nil it is searched at point."
(add-to-list 'newsticker-url-list (list name url nil nil nil) t)
(customize-variable 'newsticker-url-list))
+(defun newsticker-customize-feed (feed-name)
+ "Open customization buffer for `newsticker-url-list' and jump to FEED-NAME."
+ (interactive
+ (list (completing-read "Name of feed or group to edit: "
+ (mapcar #'car newsticker-url-list))))
+ (customize-variable 'newsticker-url-list)
+ (when (search-forward (concat "Label: " feed-name) nil t)
+ (forward-line -1)))
+
(defun newsticker-customize ()
"Open the newsticker customization group."
(interactive)
@@ -671,8 +679,8 @@ See `newsticker-get-news'."
(condition-case error-data
(url-retrieve url 'newsticker--get-news-by-url-callback
(list feed-name))
- (error (message "Error retrieving news from %s: %s" feed-name
- error-data))))
+ (error (message "Error retrieving news from %s: %s" feed-name
+ error-data))))
(force-mode-line-update))
(defun newsticker--get-news-by-url-callback (status feed-name)
@@ -719,10 +727,10 @@ See `newsticker-get-news'."
(error "Another wget-process is running for %s" feed-name))
;; start wget
(let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process feed-name buffername
+ (proc (apply #'start-process feed-name buffername
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--sentinel)
+ (set-process-sentinel proc #'newsticker--sentinel)
(process-put proc 'nt-feed-name feed-name)
(setq newsticker--process-ids (cons (process-id proc)
newsticker--process-ids))
@@ -816,7 +824,7 @@ Argument BUFFER is the buffer of the retrieval process."
(setq coding-system (intern (downcase (match-string 1))))
(setq coding-system
(condition-case nil
- (check-coding-system coding-system)
+ (check-coding-system coding-system)
(coding-system-error
(message
"newsticker.el: ignoring coding system %s for %s"
@@ -927,8 +935,8 @@ Argument BUFFER is the buffer of the retrieval process."
;; setup scrollable text
(when (= 0 (length newsticker--process-ids))
(when (fboundp 'newsticker--ticker-text-setup) ;silence
- ;compiler
- ;warnings
+ ;compiler
+ ;warnings
(newsticker--ticker-text-setup)))
(setq newsticker--latest-update-time (current-time))
(when something-was-added
@@ -936,8 +944,8 @@ Argument BUFFER is the buffer of the retrieval process."
(newsticker--cache-save-feed
(newsticker--cache-get-feed name-symbol))
(when (fboundp 'newsticker--buffer-set-uptodate) ;silence
- ;compiler
- ;warnings
+ ;compiler
+ ;warnings
(newsticker--buffer-set-uptodate nil)))
;; kill the process buffer if wanted
(unless newsticker-debug
@@ -1004,7 +1012,7 @@ Argument BUFFER is the buffer of the retrieval process."
;; And another one (20050702)! If description is HTML
;; encoded and starts with a `<', wrap the whole
;; description in a CDATA expression. This happened for
- ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
+ ;; https://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
(goto-char (point-min))
(while (re-search-forward
"<description>\\(<img.*?\\)</description>" nil t)
@@ -1098,8 +1106,8 @@ same as in `newsticker--parse-atom-1.0'."
;; time-fn
(lambda (node)
(newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children node 'modified))))))
+ (car (xml-node-children
+ (car (xml-get-children node 'modified))))))
;; guid-fn
(lambda (node)
(newsticker--guid-to-string
@@ -1123,9 +1131,9 @@ Restore an xml-string from a an xml NODE that was returned by xml-parse..."
(children (cddr node)))
(concat "<" qname
(when att-list " ")
- (mapconcat 'newsticker--unxml-attribute att-list " ")
+ (mapconcat #'newsticker--unxml-attribute att-list " ")
">"
- (mapconcat 'newsticker--unxml children "") "</" qname ">")))
+ (mapconcat #'newsticker--unxml children "") "</" qname ">")))
(defun newsticker--unxml-attribute (attribute)
"Actually restore xml-string of an ATTRIBUTE of an xml node."
@@ -1168,7 +1176,7 @@ URL `http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html'"
;; unxml the content or the summary node. Atom
;; allows for integrating (x)html into the atom
;; structure but we need the raw html string.
- ;; e.g. http://www.heise.de/open/news/news-atom.xml
+ ;; e.g. https://www.heise.de/open/news/news-atom.xml
;; http://feeds.feedburner.com/ru_nix_blogs
(or (newsticker--unxml
(car (xml-node-children
@@ -1548,6 +1556,7 @@ argument, which is one of the items in ITEMLIST."
;; ======================================================================
(defun newsticker--insert-bytes (bytes)
+ "Decode BYTES and insert in current buffer."
(insert (decode-coding-string bytes 'binary)))
(defun newsticker--remove-whitespace (string)
@@ -1571,7 +1580,7 @@ Remove the pre-formatted from `newsticker--cache'."
"Forget all cached pre-formatted data.
Remove the pre-formatted from `newsticker--cache'."
(mapc (lambda (feed)
- (mapc 'newsticker--do-forget-preformatted
+ (mapc #'newsticker--do-forget-preformatted
(cdr feed)))
newsticker--cache)
(when (fboundp 'newsticker--buffer-set-uptodate)
@@ -1584,10 +1593,10 @@ This function calls `message' with arguments STRING and ARGS, if
(and newsticker-debug
;;(not (active-minibuffer-window))
;;(not (current-message))
- (apply 'message string args)))
+ (apply #'message string args)))
(defun newsticker--decode-iso8601-date (string)
- "Return ISO8601-STRING in format like `encode-time'.
+ "Return ISO8601-encoded STRING in format like `encode-time'.
Converts from ISO-8601 to Emacs representation. If no time zone
is present, this function defaults to universal time."
(if string
@@ -1669,8 +1678,9 @@ Sat, 07 Sep 2002 00:00:01 GMT
(message "Cannot decode \"%s\": %s %s" rfc822-string
(car error-data) (cdr error-data))
nil))))
- nil))
+ nil))
+;; FIXME: Can this be replaced by seq-intersection?
(defun newsticker--lists-intersect-p (list1 list2)
"Return t if LIST1 and LIST2 share elements."
(let ((result nil))
@@ -1728,27 +1738,27 @@ Save image as FILENAME in DIRECTORY, download it from URL."
(let* ((proc-name (concat feed-name "-" filename))
(buffername (concat " *newsticker-wget-image-" proc-name "*"))
(item (or (assoc feed-name newsticker-url-list)
- (assoc feed-name newsticker-url-list-defaults)
- (error
- "Cannot get image for %s: Check newsticker-url-list"
- feed-name)))
+ (assoc feed-name newsticker-url-list-defaults)
+ (error
+ "Cannot get image for %s: Check newsticker-url-list"
+ feed-name)))
(wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
newsticker-wget-arguments)))
- (with-current-buffer (get-buffer-create buffername)
- (erase-buffer)
- ;; throw an error if there is an old wget-process around
- (if (get-process feed-name)
- (error "Another wget-process is running for image %s"
- feed-name))
- ;; start wget
- (let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process proc-name buffername
- newsticker-wget-name args)))
- (set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--image-sentinel)
- (process-put proc 'nt-directory directory)
- (process-put proc 'nt-feed-name feed-name)
- (process-put proc 'nt-filename filename)))))
+ (with-current-buffer (get-buffer-create buffername)
+ (erase-buffer)
+ ;; throw an error if there is an old wget-process around
+ (if (get-process feed-name)
+ (error "Another wget-process is running for image %s"
+ feed-name))
+ ;; start wget
+ (let* ((args (append wget-arguments (list url)))
+ (proc (apply #'start-process proc-name buffername
+ newsticker-wget-name args)))
+ (set-process-coding-system proc 'no-conversion 'no-conversion)
+ (set-process-sentinel proc #'newsticker--image-sentinel)
+ (process-put proc 'nt-directory directory)
+ (process-put proc 'nt-feed-name feed-name)
+ (process-put proc 'nt-filename filename)))))
(defun newsticker--image-sentinel (process _event)
"Sentinel for image-retrieving PROCESS caused by EVENT."
@@ -1773,18 +1783,18 @@ Save image as FILENAME in DIRECTORY, download it from URL."
"Save contents of BUFFER in DIRECTORY as FILE-NAME.
Finally kill buffer."
(with-current-buffer buffer
- (let ((image-name (concat directory file-name)))
- (set-buffer-file-coding-system 'no-conversion)
- ;; make sure the cache dir exists
- (unless (file-directory-p directory)
- (make-directory directory))
- ;; write and close buffer
- (let ((require-final-newline nil)
- (backup-inhibited t)
- (coding-system-for-write 'no-conversion))
- (write-region nil nil image-name nil 'quiet))
- (set-buffer-modified-p nil)
- (kill-buffer buffer))))
+ (let ((image-name (concat directory file-name)))
+ (set-buffer-file-coding-system 'no-conversion)
+ ;; make sure the cache dir exists
+ (unless (file-directory-p directory)
+ (make-directory directory))
+ ;; write and close buffer
+ (let ((require-final-newline nil)
+ (backup-inhibited t)
+ (coding-system-for-write 'no-conversion))
+ (write-region nil nil image-name nil 'quiet))
+ (set-buffer-modified-p nil)
+ (kill-buffer buffer))))
(defun newsticker--image-remove (directory file-name)
"In DIRECTORY remove FILE-NAME."
@@ -1799,8 +1809,8 @@ Save image as FILENAME in DIRECTORY, download it from URL."
(condition-case error-data
(url-retrieve url 'newsticker--image-download-by-url-callback
(list feed-name directory filename))
- (error (message "Error retrieving image from %s: %s" feed-name
- error-data))))
+ (error (message "Error retrieving image from %s: %s" feed-name
+ error-data))))
(force-mode-line-update))
(defun newsticker--image-download-by-url-callback (status feed-name directory filename)
@@ -2137,11 +2147,11 @@ FEED is a symbol!"
(concat newsticker-dir "/feeds"))
(defun newsticker--cache-save ()
- "Save cache data for all feeds."
- (unless (file-directory-p newsticker-dir)
- (make-directory newsticker-dir t))
- (mapc 'newsticker--cache-save-feed newsticker--cache)
- nil)
+ "Save cache data for all feeds."
+ (unless (file-directory-p newsticker-dir)
+ (make-directory newsticker-dir t))
+ (mapc #'newsticker--cache-save-feed newsticker--cache)
+ nil)
(defun newsticker--cache-save-feed (feed)
"Save cache data for FEED."
@@ -2207,14 +2217,14 @@ If AGES is nil, the total number of items is returned."
(if (memq (newsticker--age (car items)) ages)
(setq num (1+ num)))
(if (memq (newsticker--age (car items)) '(new old immortal obsolete))
- (setq num (1+ num))))
+ (setq num (1+ num))))
(setq items (cdr items)))
num))
(defun newsticker--stat-num-items-total (&optional age)
"Return total number of items in all feeds which have the given AGE.
If AGE is nil, the total number of items is returned."
- (apply '+
+ (apply #'+
(mapcar (lambda (feed)
(if age
(newsticker--stat-num-items (intern (car feed)) age)
@@ -2227,39 +2237,66 @@ If AGE is nil, the total number of items is returned."
(defun newsticker-opml-export ()
"OPML subscription export.
Export subscriptions to a buffer in OPML Format."
- ;; FIXME: use newsticker-groups
(interactive)
(with-current-buffer (get-buffer-create "*OPML Export*")
+ (erase-buffer)
(set-buffer-file-coding-system 'utf-8)
(insert (concat
"<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
"<!-- OPML generated by Emacs newsticker.el -->\n"
"<opml version=\"1.0\">\n"
" <head>\n"
- " <title>mySubscriptions</title>\n"
+ " <title>Emacs newsticker subscriptions</title>\n"
" <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
"</dateCreated>\n"
" <ownerEmail>" user-mail-address "</ownerEmail>\n"
" <ownerName>" (user-full-name) "</ownerName>\n"
" </head>\n"
" <body>\n"))
- (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"))
+ (let ((feeds (append newsticker-url-list newsticker-url-list-defaults))
+ ;; insert the feed groups and all feeds that are contained
+ (saved-feed-names (newsticker--opml-insert-elt newsticker-groups 2)))
+ ;; to be safe: insert all feeds that are not contained in any group
+ (dolist (f feeds)
+ (unless (seq-find (lambda (sfn) (string= (car f) sfn)) saved-feed-names)
+ (newsticker--opml-insert-feed (car f) 4)))
+ (insert " </body>\n</opml>\n")))
(pop-to-buffer "*OPML Export*")
(when (fboundp 'sgml-mode)
(sgml-mode)))
+(defun newsticker--opml-insert-elt (elt depth)
+ "Insert an OPML ELT with indentation level DEPTH."
+ (if (listp elt)
+ (newsticker--opml-insert-group elt (+ 2 depth))
+ (newsticker--opml-insert-feed elt (+ 2 depth))))
+
+(defun newsticker--opml-insert-group (group depth)
+ "Insert an OPML GROUP with indentation level DEPTH."
+ (let (saved-feeds)
+ (insert (make-string depth ? ) "<outline type=\"folder\" text=\"" (car group) "\">\n")
+ (setq saved-feeds (mapcar (lambda (e)
+ (newsticker--opml-insert-elt e depth))
+ (cdr group)))
+ (insert (make-string depth ? ) "</outline>\n")
+ (flatten-tree saved-feeds)))
+
+(defun newsticker--opml-insert-feed (feed-name depth)
+ "Insert an OPML FEED-NAME with indentation level DEPTH."
+ (let* ((feed-definition (seq-find (lambda (f)
+ (string= feed-name (car f)))
+ (append newsticker-url-list newsticker-url-list-defaults)))
+ (url (nth 1 feed-definition))
+ (url-string (if (functionp url) (prin1-to-string url)
+ (xml-escape-string url))))
+ (insert (make-string depth ? ) "<outline text=\"" feed-name
+ "\" xmlUrl=\"" url-string
+ "\"/>\n"))
+ feed-name)
+
(defun newsticker--opml-import-outlines (outlines)
- "Recursively import OUTLINES from OPML data.
-Note that nested outlines are currently flattened -- i.e. grouping is
-removed."
- (mapc (lambda (outline)
+ "Recursively import OUTLINES from OPML data."
+ (mapcar (lambda (outline)
(let ((name (xml-get-attribute outline 'text))
(url (xml-get-attribute outline 'xmlUrl))
(children (xml-get-children outline 'outline)))
@@ -2267,18 +2304,27 @@ removed."
(add-to-list 'newsticker-url-list
(list name url nil nil nil) t))
(if children
- (newsticker--opml-import-outlines children))))
- outlines))
+ (append (list name)
+ (newsticker--opml-import-outlines children))
+ name)))
+ outlines))
(defun newsticker-opml-import (filename)
- "Import OPML data from FILENAME."
+ "Import OPML data from FILENAME.
+Feeds are added to `newsticker-url-list' and `newsticker-groups'
+preserving the outline structure."
(interactive "fOPML file: ")
(set-buffer (find-file-noselect filename))
(goto-char (point-min))
(let* ((node-list (xml-parse-region (point-min) (point-max)))
+ (title (car (xml-node-children
+ (car (xml-get-children
+ (car (xml-get-children (car node-list) 'head))
+ 'title)))))
(body (car (xml-get-children (car node-list) 'body)))
- (outlines (xml-get-children body 'outline)))
- (newsticker--opml-import-outlines outlines))
+ (outlines (xml-get-children body 'outline))
+ (imported-groups-data (newsticker--opml-import-outlines outlines)))
+ (add-to-list 'newsticker-groups (cons title imported-groups-data) t))
(customize-variable 'newsticker-url-list))
;; ======================================================================
@@ -2350,7 +2396,7 @@ the item."
(make-directory temp-dir t))
(cd temp-dir)
(message "Getting image %s" url)
- (apply 'start-process "wget-image"
+ (apply #'start-process "wget-image"
" *newsticker-wget-download-images*"
newsticker-wget-name
(list url))
@@ -2372,7 +2418,7 @@ This function is suited for adding it to `newsticker-new-item-functions'."
(make-directory temp-dir t))
(cd temp-dir)
(message "Getting enclosure %s" url)
- (apply 'start-process "wget-enclosure"
+ (apply #'start-process "wget-enclosure"
" *newsticker-wget-download-enclosures*"
newsticker-wget-name
(list url))
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index 21d47b838f5..420cf82e4d8 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -1,10 +1,10 @@
-;;; newst-plainview.el --- Single buffer frontend for newsticker.
+;;; newst-plainview.el --- Single buffer frontend for newsticker. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-plainview.el
-;; URL: http://www.nongnu.org/newsticker
+;; URL: https://www.nongnu.org/newsticker
;; Package: newsticker
;; ======================================================================
@@ -90,7 +90,7 @@ The following sort methods are available:
(const :tag "Keep original order" sort-by-original-order)
(const :tag "Sort by time" sort-by-time)
(const :tag "Sort by title" sort-by-title))
- :set 'newsticker--set-customvar-sorting
+ :set #'newsticker--set-customvar-sorting
:group 'newsticker-plainview)
(defcustom newsticker-heading-format
@@ -107,7 +107,7 @@ The following printf-like specifiers can be used:
%s The statistical data of the feed. See `newsticker-statistics-format'.
%t The title of the feed, i.e. its name."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-item-format
@@ -122,7 +122,7 @@ The following printf-like specifiers can be used:
the title of the feed is used.
%t The title of the item."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-desc-format
@@ -133,7 +133,7 @@ The following printf-like specifiers can be used:
%d The date the item was (first) retrieved. See
`newsticker-date-format'."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
(defcustom newsticker-statistics-format
@@ -146,7 +146,7 @@ The following printf-like specifiers can be used:
%o The number of old items in the feed.
%O The number of obsolete items in the feed."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-plainview)
@@ -195,7 +195,7 @@ If set to t old items will be completely folded and only new
items will show up in the *newsticker* buffer. Otherwise old as
well as new items will be visible."
:type 'boolean
- :set 'newsticker--set-customvar-buffer
+ :set #'newsticker--set-customvar-buffer
:group 'newsticker-plainview)
(defcustom newsticker-show-descriptions-of-new-items
@@ -204,14 +204,14 @@ well as new items will be visible."
If set to t old items will be folded and new items will be
unfolded. Otherwise old as well as new items will be folded."
:type 'boolean
- :set 'newsticker--set-customvar-buffer
+ :set #'newsticker--set-customvar-buffer
:group 'newsticker-plainview)
(defcustom newsticker-show-all-news-elements
nil
"Show all news elements."
:type 'boolean
- ;;:set 'newsticker--set-customvar
+ ;;:set #'newsticker--set-customvar
:group 'newsticker-plainview)
;; ======================================================================
@@ -273,6 +273,7 @@ images."
(defvar newsticker--plainview-tool-bar-map
(when (boundp 'tool-bar-map)
+ (defvar tool-bar-map)
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item "newsticker/prev-feed"
'newsticker-previous-feed
@@ -386,51 +387,45 @@ images."
(defvar newsticker-mode-map
(let ((map (make-keymap)))
- (define-key map "sO" 'newsticker-show-old-items)
- (define-key map "hO" 'newsticker-hide-old-items)
- (define-key map "sa" 'newsticker-show-all-desc)
- (define-key map "ha" 'newsticker-hide-all-desc)
- (define-key map "sf" 'newsticker-show-feed-desc)
- (define-key map "hf" 'newsticker-hide-feed-desc)
- (define-key map "so" 'newsticker-show-old-item-desc)
- (define-key map "ho" 'newsticker-hide-old-item-desc)
- (define-key map "sn" 'newsticker-show-new-item-desc)
- (define-key map "hn" 'newsticker-hide-new-item-desc)
- (define-key map "se" 'newsticker-show-entry)
- (define-key map "he" 'newsticker-hide-entry)
- (define-key map "sx" 'newsticker-show-extra)
- (define-key map "hx" 'newsticker-hide-extra)
-
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map " " 'scroll-up-command)
- (define-key map "q" 'newsticker-close-buffer)
- (define-key map "p" 'newsticker-previous-item)
- (define-key map "P" 'newsticker-previous-new-item)
- (define-key map "F" 'newsticker-previous-feed)
- (define-key map "\t" 'newsticker-next-item)
- (define-key map "n" 'newsticker-next-item)
- (define-key map "N" 'newsticker-next-new-item)
- (define-key map "f" 'newsticker-next-feed)
- (define-key map "M" 'newsticker-mark-all-items-as-read)
- (define-key map "m"
- 'newsticker-mark-all-items-at-point-as-read-and-redraw)
- (define-key map "o"
- 'newsticker-mark-item-at-point-as-read)
- (define-key map "O"
- 'newsticker-mark-all-items-at-point-as-read)
- (define-key map "G" 'newsticker-get-all-news)
- (define-key map "g" 'newsticker-get-news-at-point)
- (define-key map "u" 'newsticker-buffer-update)
- (define-key map "U" 'newsticker-buffer-force-update)
- (define-key map "a" 'newsticker-add-url)
-
- (define-key map "i"
- 'newsticker-mark-item-at-point-as-immortal)
-
- (define-key map "xf"
- 'newsticker-toggle-auto-narrow-to-feed)
- (define-key map "xi"
- 'newsticker-toggle-auto-narrow-to-item)
+ (define-key map "sO" #'newsticker-show-old-items)
+ (define-key map "hO" #'newsticker-hide-old-items)
+ (define-key map "sa" #'newsticker-show-all-desc)
+ (define-key map "ha" #'newsticker-hide-all-desc)
+ (define-key map "sf" #'newsticker-show-feed-desc)
+ (define-key map "hf" #'newsticker-hide-feed-desc)
+ (define-key map "so" #'newsticker-show-old-item-desc)
+ (define-key map "ho" #'newsticker-hide-old-item-desc)
+ (define-key map "sn" #'newsticker-show-new-item-desc)
+ (define-key map "hn" #'newsticker-hide-new-item-desc)
+ (define-key map "se" #'newsticker-show-entry)
+ (define-key map "he" #'newsticker-hide-entry)
+ (define-key map "sx" #'newsticker-show-extra)
+ (define-key map "hx" #'newsticker-hide-extra)
+
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map " " #'scroll-up-command)
+ (define-key map "q" #'newsticker-close-buffer)
+ (define-key map "p" #'newsticker-previous-item)
+ (define-key map "P" #'newsticker-previous-new-item)
+ (define-key map "F" #'newsticker-previous-feed)
+ (define-key map "\t" #'newsticker-next-item)
+ (define-key map "n" #'newsticker-next-item)
+ (define-key map "N" #'newsticker-next-new-item)
+ (define-key map "f" #'newsticker-next-feed)
+ (define-key map "M" #'newsticker-mark-all-items-as-read)
+ (define-key map "m" #'newsticker-mark-all-items-at-point-as-read-and-redraw)
+ (define-key map "o" #'newsticker-mark-item-at-point-as-read)
+ (define-key map "O" #'newsticker-mark-all-items-at-point-as-read)
+ (define-key map "G" #'newsticker-get-all-news)
+ (define-key map "g" #'newsticker-get-news-at-point)
+ (define-key map "u" #'newsticker-buffer-update)
+ (define-key map "U" #'newsticker-buffer-force-update)
+ (define-key map "a" #'newsticker-add-url)
+
+ (define-key map "i" #'newsticker-mark-item-at-point-as-immortal)
+
+ (define-key map "xf" #'newsticker-toggle-auto-narrow-to-feed)
+ (define-key map "xi" #'newsticker-toggle-auto-narrow-to-item)
;; Bind menu to mouse.
(define-key map [down-mouse-3] newsticker-menu)
@@ -479,11 +474,11 @@ images."
;; maps for the clickable portions
(defvar newsticker--url-keymap
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'newsticker-mouse-browse-url)
- (define-key map [mouse-2] 'newsticker-mouse-browse-url)
- (define-key map "\n" 'newsticker-browse-url)
- (define-key map "\C-m" 'newsticker-browse-url)
- (define-key map [(control return)] 'newsticker-handle-url)
+ (define-key map [mouse-1] #'newsticker-mouse-browse-url)
+ (define-key map [mouse-2] #'newsticker-mouse-browse-url)
+ (define-key map "\n" #'newsticker-browse-url)
+ (define-key map "\C-m" #'newsticker-browse-url)
+ (define-key map [(control return)] #'newsticker-handle-url)
map)
"Key map for click-able headings in the newsticker buffer.")
@@ -980,7 +975,7 @@ not get changed."
(let* (pos1 pos2
(inhibit-read-only t)
inv-prop org-inv-prop
- is-invisible)
+ ) ;; is-invisible
(newsticker--buffer-beginning-of-item)
(newsticker--buffer-goto '(desc))
(setq pos1 (max (point-min) (1- (point))))
@@ -1009,7 +1004,7 @@ not get changed."
(let* (pos1 pos2
(inhibit-read-only t)
inv-prop org-inv-prop
- is-invisible)
+ ) ;; is-invisible
(newsticker--buffer-beginning-of-item)
(newsticker--buffer-goto '(desc))
(setq pos1 (max (point-min) (1- (point))))
@@ -1147,7 +1142,7 @@ If VALUE is nil, auto-narrowing is turned off, otherwise it is turned on."
(setq index-alist (list feed-list)))
index-alist)))
-(defun newsticker--imenu-goto (name pos &rest args)
+(defun newsticker--imenu-goto (_name pos &rest _args)
"Go to item NAME at position POS and show item.
ARGS are ignored."
(goto-char pos)
@@ -1236,6 +1231,9 @@ item-retrieval time is added as well."
;; insert the description
(newsticker--buffer-do-insert-text item 'desc feed-name-symbol))
+(defvar w3m-fill-column)
+(defvar w3-maximum-line-length)
+
(defun newsticker--buffer-do-insert-text (item type feed-name-symbol)
"Actually insert contents of news item, format it, render it and all that.
ITEM is a news item, TYPE tells which part of the item shall be inserted,
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index b188bd4589e..40e304402ad 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -1,4 +1,4 @@
-;;; newst-reader.el --- Generic RSS reader functions.
+;;; newst-reader.el --- Generic RSS reader functions. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -94,7 +94,7 @@ done."
(const :tag "Right" right)
(const :tag "Center" center)
(const :tag "Full" full))
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-use-full-width
@@ -103,7 +103,7 @@ done."
If non-nil newsticker sets `fill-column' so that the whole
window is used when filling. See also `newsticker-justification'."
:type 'boolean
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-html-renderer
@@ -122,7 +122,7 @@ htmlr if this option is set."
(const :tag "w3" w3-region)
(const :tag "w3m" w3m-region)
(const :tag "htmlr" newsticker-htmlr-render))
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defcustom newsticker-date-format
@@ -130,7 +130,7 @@ htmlr if this option is set."
"Format for the date part in item and feed lines.
See `format-time-string' for a list of valid specifiers."
:type 'string
- :set 'newsticker--set-customvar-formatting
+ :set #'newsticker--set-customvar-formatting
:group 'newsticker-reader)
(defgroup newsticker-faces nil
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 275c91a36ea..8cfafb5bfe4 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -1,4 +1,4 @@
-;; newst-ticker.el --- mode line ticker for newsticker.
+;;; newst-ticker.el --- mode line ticker for newsticker. -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
@@ -83,7 +83,7 @@ smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
reasonable. For non-smooth display a value of 10 is a good starting
point."
:type 'number
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-scroll-smoothly
@@ -104,7 +104,7 @@ at all. If you change `newsticker-scroll-smoothly' you should also change
If t the echo area will not show immortal items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-hide-old-items-in-echo-area
@@ -113,7 +113,7 @@ If t the echo area will not show immortal items. See also
If t the echo area will show only new items, i.e. only items which have
been added between the last two retrievals."
:type 'boolean
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defcustom newsticker-hide-obsolete-items-in-echo-area
@@ -122,7 +122,7 @@ been added between the last two retrievals."
If t the echo area will not show obsolete items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
- :set 'newsticker--set-customvar-ticker
+ :set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
(defun newsticker--display-tick ()
@@ -205,7 +205,7 @@ running already."
(setq newsticker--ticker-timer
(run-at-time newsticker-ticker-interval
newsticker-ticker-interval
- 'newsticker--display-tick))))
+ #'newsticker--display-tick))))
(defun newsticker-stop-ticker ()
"Stop newsticker's ticker (but not the news retrieval)."
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index cf55f66e780..d524e6dd173 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -31,10 +31,6 @@
;; See newsticker.el
;; ======================================================================
-;;; History:
-;;
-
-;; ======================================================================
;;; Code:
(require 'cl-lib)
(require 'newst-reader)
@@ -52,72 +48,73 @@
(defface newsticker-treeview-face
'((((class color) (background dark)) :foreground "white")
(((class color) (background light)) :foreground "black"))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-new-face
'((t :inherit newsticker-treeview-face :weight bold))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-old-face
'((t :inherit newsticker-treeview-face))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-immortal-face
'((default :inherit newsticker-treeview-face :slant italic)
(((class color) (background dark)) :foreground "orange")
(((class color) (background light)) :foreground "blue"))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-obsolete-face
'((t :inherit newsticker-treeview-face :strike-through t))
- "Face for newsticker tree."
- :group 'newsticker-treeview)
+ "Face for newsticker tree.")
(defface newsticker-treeview-selection-face
'((((class color) (background dark)) :background "#4444aa")
(((class color) (background light)) :background "#bbbbff"))
- "Face for newsticker selection."
- :group 'newsticker-treeview)
+ "Face for newsticker selection.")
(defcustom newsticker-treeview-date-format
"%d.%m.%y, %H:%M"
"Format for the date column in the treeview list buffer.
See `format-time-string' for a list of valid specifiers."
:version "25.1"
- :type 'string
- :group 'newsticker-treeview)
+ :type 'string)
(defcustom newsticker-treeview-own-frame
nil
"Decides whether newsticker treeview creates and uses its own frame."
- :type 'boolean
- :group 'newsticker-treeview)
+ :type 'boolean)
(defcustom newsticker-treeview-treewindow-width
30
"Width of tree window in treeview layout.
See also `newsticker-treeview-listwindow-height'."
- :type 'integer
- :group 'newsticker-treeview)
+ :type 'integer)
(defcustom newsticker-treeview-listwindow-height
10
"Height of list window in treeview layout.
See also `newsticker-treeview-treewindow-width'."
- :type 'integer
- :group 'newsticker-treeview)
+ :type 'integer)
(defcustom newsticker-treeview-automatically-mark-displayed-items-as-old
t
"Decides whether to automatically mark displayed items as old.
If t an item is marked as old as soon as it is displayed. This
applies to newsticker only."
- :type 'boolean
- :group 'newsticker-treeview)
+ :type 'boolean)
+
+(defcustom newsticker-treeview-use-feed-name-from-url-list-in-treeview
+ t
+ "Use the feed names from 'newsticker-url-list' for display in treeview."
+ :version "28.1"
+ :type 'boolean)
+
+(defcustom newsticker-treeview-use-feed-name-from-url-list-in-itemview
+ t
+ "Use feed names from 'newsticker-url-list' in itemview."
+ :version "28.1"
+ :type 'boolean)
(defvar newsticker-groups
'("Feeds")
@@ -152,14 +149,16 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
(defvar newsticker--treeview-feed-tree nil)
(defvar newsticker--treeview-vfeed-tree nil)
+(declare-function newsticker-handle-url "newst-plainview" ())
+
;; maps for the clickable portions
(defvar newsticker--treeview-url-keymap
(let ((map (make-sparse-keymap 'newsticker--treeview-url-keymap)))
- (define-key map [mouse-1] 'newsticker-treeview-mouse-browse-url)
- (define-key map [mouse-2] 'newsticker-treeview-mouse-browse-url)
- (define-key map "\n" 'newsticker-treeview-browse-url)
- (define-key map "\C-m" 'newsticker-treeview-browse-url)
- (define-key map [(control return)] 'newsticker-handle-url)
+ (define-key map [mouse-1] #'newsticker-treeview-mouse-browse-url)
+ (define-key map [mouse-2] #'newsticker-treeview-mouse-browse-url)
+ (define-key map "\n" #'newsticker-treeview-browse-url)
+ (define-key map "\C-m" #'newsticker-treeview-browse-url)
+ (define-key map [(control return)] #'newsticker-handle-url)
map)
"Key map for click-able headings in the newsticker treeview buffers.")
@@ -328,9 +327,9 @@ If string SHOW-FEED is non-nil it is shown in the item string."
(replace-match " "))
(let ((map (make-sparse-keymap)))
(dolist (key'([mouse-1] [mouse-3]))
- (define-key map key 'newsticker-treeview-tree-click))
- (define-key map "\n" 'newsticker-treeview-show-item)
- (define-key map "\C-m" 'newsticker-treeview-show-item)
+ (define-key map key #'newsticker-treeview-tree-click))
+ (define-key map "\n" #'newsticker-treeview-show-item)
+ (define-key map "\C-m" #'newsticker-treeview-show-item)
(add-text-properties pos1 (point-max)
(list :nt-item item
:nt-feed feed
@@ -612,9 +611,9 @@ If CLEAR-BUFFER is non-nil the list buffer is completely erased."
(defvar newsticker-treeview-list-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1]
- 'newsticker--treeview-list-sort-by-column)
+ #'newsticker--treeview-list-sort-by-column)
(define-key map [header-line mouse-2]
- 'newsticker--treeview-list-sort-by-column)
+ #'newsticker--treeview-list-sort-by-column)
map)
"Local keymap for newsticker treeview list window sort buttons.")
@@ -738,11 +737,14 @@ for the button."
(img (newsticker--image-read feed-name-symbol nil 40)))
(if (and (display-images-p) img)
(newsticker--insert-image img (car item))
- (insert (newsticker--real-feed-name feed-name-symbol))))
+ (insert (if newsticker-treeview-use-feed-name-from-url-list-in-itemview
+ (symbol-name feed-name-symbol)
+ (newsticker--real-feed-name feed-name-symbol)))))
(add-text-properties (point-min) (point)
(list 'face 'newsticker-feed-face
'mouse-face 'highlight
- 'help-echo "Visit in web browser."
+ 'help-echo (concat (newsticker--real-feed-name feed-name-symbol)
+ "\nClick to visit in web browser.")
:nt-link (newsticker--link item)
'keymap newsticker--treeview-url-keymap))
(setq pos (point))
@@ -933,31 +935,31 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored."
(newsticker-treeview-mode)))
(defun newsticker--treeview-propertize-tag (tag &optional num-new nt-id feed
- vfeed)
+ vfeed tooltip)
"Return propertized copy of string TAG.
Optional argument NUM-NEW is used for choosing face, other
-arguments NT-ID, FEED, and VFEED are added as properties."
+arguments NT-ID, FEED, VFEED and TOOLTIP are added as properties."
;;(message "newsticker--treeview-propertize-tag `%s' %s" feed nt-id)
(let ((face 'newsticker-treeview-face)
(map (make-sparse-keymap)))
(if (and num-new (> num-new 0))
(setq face 'newsticker-treeview-new-face))
(dolist (key '([mouse-1] [mouse-3]))
- (define-key map key 'newsticker-treeview-tree-click))
- (define-key map "\n" 'newsticker-treeview-tree-do-click)
- (define-key map "\C-m" 'newsticker-treeview-tree-do-click)
+ (define-key map key #'newsticker-treeview-tree-click))
+ (define-key map "\n" #'newsticker-treeview-tree-do-click)
+ (define-key map "\C-m" #'newsticker-treeview-tree-do-click)
(propertize tag 'face face 'keymap map
:nt-id nt-id
:nt-feed feed
:nt-vfeed vfeed
- 'help-echo tag
+ 'help-echo tooltip
'mouse-face 'highlight)))
(defun newsticker--treeview-tree-get-tag (feed-name vfeed-name
&optional nt-id)
"Return a tag string for either FEED-NAME or, if it is nil, for VFEED-NAME.
Optional argument NT-ID is added to the tag's properties."
- (let (tag (num-new 0))
+ (let (tag tooltip (num-new 0))
(cond (vfeed-name
(cond ((string= vfeed-name "new")
(setq num-new (newsticker--stat-num-items-total 'new))
@@ -970,18 +972,29 @@ Optional argument NT-ID is added to the tag's properties."
(setq tag (format "Obsolete items (%d)" num-new)))
((string= vfeed-name "all")
(setq num-new (newsticker--stat-num-items-total))
- (setq tag (format "All items (%d)" num-new)))))
+ (setq tag (format "All items (%d)" num-new))))
+ (setq tooltip tag))
(feed-name
(setq num-new (newsticker--stat-num-items-for-group
(intern feed-name) 'new 'immortal))
(setq tag
(format "%s (%d)"
- (newsticker--real-feed-name (intern feed-name))
- num-new))))
+ (if newsticker-treeview-use-feed-name-from-url-list-in-itemview
+ feed-name
+ (newsticker--real-feed-name (intern feed-name)))
+ num-new))
+ (setq tooltip
+ (if (newsticker--group-get-group feed-name)
+ tag
+ (format "%s (%d)\n%s"
+ feed-name
+ num-new
+ (newsticker--real-feed-name (intern feed-name)))))))
(if tag
(newsticker--treeview-propertize-tag tag num-new
nt-id
- feed-name vfeed-name))))
+ feed-name vfeed-name
+ tooltip))))
(defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
"Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
@@ -1085,6 +1098,7 @@ Arguments are ignored."
;; ======================================================================
(defvar newsticker-treeview-tool-bar-map
(when (boundp 'tool-bar-map)
+ (defvar tool-bar-map)
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item "newsticker/prev-feed"
'newsticker-treeview-prev-feed
@@ -1434,6 +1448,15 @@ Move to next item unless DONT-PROCEED is non-nil."
newsticker--treeview-current-vfeed)
(newsticker--treeview-get-selected-item)))
+(defun newsticker-treeview-customize-current-feed ()
+ "Open customization buffer for `newsticker-url-list' and move to current feed."
+ (interactive)
+ (let ((cur-feed (or newsticker--treeview-current-feed
+ newsticker--treeview-current-vfeed)))
+ (if (newsticker--group-get-group cur-feed)
+ (message "Cannot customize groups. Please select a feed.")
+ (newsticker-customize-feed cur-feed))))
+
(defun newsticker--treeview-set-current-node (node)
"Make NODE the current node."
(with-current-buffer (newsticker--treeview-tree-buffer)
@@ -1626,7 +1649,7 @@ Return t if a new feed was activated, nil otherwise."
(interactive
(list (let ((completion-ignore-case t))
(completing-read
- "Jump to feed: "
+ "Jump to feed/group: "
(append '("new" "obsolete" "immortal" "all")
(mapcar #'car (append newsticker-url-list
newsticker-url-list-defaults)))
@@ -1852,28 +1875,34 @@ of the shift. If MOVE-GROUP is nil the currently selected feed
`newsticker--treeview-current-feed' is shifted, if it is t then
the current feed's parent group is shifted.."
(let* ((cur-feed newsticker--treeview-current-feed)
- (thing (if move-group
- (newsticker--group-find-parent-group cur-feed)
+ (thing (if (and move-group
+ (not (newsticker--group-get-group cur-feed)))
+ (car (newsticker--group-find-parent-group cur-feed))
cur-feed))
(parent-group (newsticker--group-find-parent-group
- (if move-group (car thing) thing))))
+ ;;(if move-group (car thing) thing)
+ thing)))
(unless parent-group
(error "Group not found!"))
(let* ((siblings (cdr parent-group))
- (pos (cl-position thing siblings :test 'equal))
+ (pos (cl-position thing siblings :test
+ (lambda (o1 o2)
+ (equal (if (listp o1) (car o1) o1)
+ (if (listp o2) (car o2) o2)))))
(tpos (+ pos delta ))
(new-pos (max 0 (min (length siblings) tpos)))
(beg (cl-subseq siblings 0 (min pos new-pos)))
(end (cl-subseq siblings (+ 1 (max pos new-pos))))
(p (elt siblings new-pos)))
(when (not (= pos new-pos))
- (setcdr parent-group
- (cl-concatenate 'list
- beg
- (if (> delta 0)
- (list p thing)
- (list thing p))
- end))
+ (let ((th (or (newsticker--group-get-group thing) thing)))
+ (setcdr parent-group
+ (cl-concatenate 'list
+ beg
+ (if (> delta 0)
+ (list p th)
+ (list th p))
+ end)))
(newsticker--treeview-tree-update)
(newsticker-treeview-update)
(newsticker-treeview-jump cur-feed)))))
@@ -1986,36 +2015,37 @@ Return t if groups have changed, nil otherwise."
(defvar newsticker-treeview-mode-map
(let ((map (make-sparse-keymap 'newsticker-treeview-mode-map)))
- (define-key map " " 'newsticker-treeview-next-page)
- (define-key map "a" 'newsticker-add-url)
- (define-key map "b" 'newsticker-treeview-browse-url-item)
- (define-key map "F" 'newsticker-treeview-prev-feed)
- (define-key map "f" 'newsticker-treeview-next-feed)
- (define-key map "g" 'newsticker-treeview-get-news)
- (define-key map "G" 'newsticker-get-all-news)
- (define-key map "i" 'newsticker-treeview-toggle-item-immortal)
- (define-key map "j" 'newsticker-treeview-jump)
- (define-key map "n" 'newsticker-treeview-next-item)
- (define-key map "N" 'newsticker-treeview-next-new-or-immortal-item)
- (define-key map "O" 'newsticker-treeview-mark-list-items-old)
- (define-key map "o" 'newsticker-treeview-mark-item-old)
- (define-key map "p" 'newsticker-treeview-prev-item)
- (define-key map "P" 'newsticker-treeview-prev-new-or-immortal-item)
- (define-key map "q" 'newsticker-treeview-quit)
- (define-key map "S" 'newsticker-treeview-save-item)
- (define-key map "s" 'newsticker-treeview-save)
- (define-key map "u" 'newsticker-treeview-update)
- (define-key map "v" 'newsticker-treeview-browse-url)
- ;;(define-key map "\n" 'newsticker-treeview-scroll-item)
- ;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
- (define-key map "\M-m" 'newsticker-group-move-feed)
- (define-key map "\M-a" 'newsticker-group-add-group)
- (define-key map "\M-d" 'newsticker-group-delete-group)
- (define-key map "\M-r" 'newsticker-group-rename-group)
- (define-key map [M-down] 'newsticker-group-shift-feed-down)
- (define-key map [M-up] 'newsticker-group-shift-feed-up)
- (define-key map [M-S-down] 'newsticker-group-shift-group-down)
- (define-key map [M-S-up] 'newsticker-group-shift-group-up)
+ (define-key map " " #'newsticker-treeview-next-page)
+ (define-key map "a" #'newsticker-add-url)
+ (define-key map "b" #'newsticker-treeview-browse-url-item)
+ (define-key map "c" #'newsticker-treeview-customize-current-feed)
+ (define-key map "F" #'newsticker-treeview-prev-feed)
+ (define-key map "f" #'newsticker-treeview-next-feed)
+ (define-key map "g" #'newsticker-treeview-get-news)
+ (define-key map "G" #'newsticker-get-all-news)
+ (define-key map "i" #'newsticker-treeview-toggle-item-immortal)
+ (define-key map "j" #'newsticker-treeview-jump)
+ (define-key map "n" #'newsticker-treeview-next-item)
+ (define-key map "N" #'newsticker-treeview-next-new-or-immortal-item)
+ (define-key map "O" #'newsticker-treeview-mark-list-items-old)
+ (define-key map "o" #'newsticker-treeview-mark-item-old)
+ (define-key map "p" #'newsticker-treeview-prev-item)
+ (define-key map "P" #'newsticker-treeview-prev-new-or-immortal-item)
+ (define-key map "q" #'newsticker-treeview-quit)
+ (define-key map "S" #'newsticker-treeview-save-item)
+ (define-key map "s" #'newsticker-treeview-save)
+ (define-key map "u" #'newsticker-treeview-update)
+ (define-key map "v" #'newsticker-treeview-browse-url)
+ ;;(define-key map "\n" #'newsticker-treeview-scroll-item)
+ ;;(define-key map "\C-m" #'newsticker-treeview-scroll-item)
+ (define-key map "\M-m" #'newsticker-group-move-feed)
+ (define-key map "\M-a" #'newsticker-group-add-group)
+ (define-key map "\M-d" #'newsticker-group-delete-group)
+ (define-key map "\M-r" #'newsticker-group-rename-group)
+ (define-key map [M-down] #'newsticker-group-shift-feed-down)
+ (define-key map [M-up] #'newsticker-group-shift-feed-up)
+ (define-key map [M-S-down] #'newsticker-group-shift-group-down)
+ (define-key map [M-S-up] #'newsticker-group-shift-group-up)
map)
"Mode map for newsticker treeview.")
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 0ce65a35ead..1d9ee6db86c 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -640,7 +640,7 @@ References:
[1]: Sotirov A, Stevens M et al (2008). \"MD5 considered harmful today
- Creating a rogue CA certificate\",
-`http://www.win.tue.nl/hashclash/rogue-ca/'
+`https://www.win.tue.nl/hashclash/rogue-ca/'
[2]: Turner S, Chen L (2011). \"Updated Security Considerations for
the MD5 Message-Digest and the HMAC-MD5 Algorithms\",
`https://tools.ietf.org/html/rfc6151'"
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index dcac36f2a4a..a267ac319b6 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -551,8 +551,8 @@ Returns the process associated with the connection."
(when result
(let ((response (plist-get (cdr result) :greeting)))
(setq pop3-timestamp
- (substring response (or (string-match "<" response) 0)
- (+ 1 (or (string-match ">" response) -1)))))
+ (substring response (or (string-search "<" response) 0)
+ (+ 1 (or (string-search ">" response) -1)))))
(set-process-query-on-exit-flag (car result) nil)
(erase-buffer)
(car result)))))
@@ -725,9 +725,9 @@ Otherwise, return the size of the message-id MSG."
(setq pop3-read-point (point-marker))
(goto-char (match-beginning 0))
(setq end (point-marker))
- (mapcar #'(lambda (s) (let ((split (split-string s " ")))
- (cons (string-to-number (nth 0 split))
- (string-to-number (nth 1 split)))))
+ (mapcar (lambda (s) (let ((split (split-string s " ")))
+ (cons (string-to-number (nth 0 split))
+ (string-to-number (nth 1 split)))))
(split-string (buffer-substring start end) "\r\n" t)))))))
(defun pop3-retr (process msg crashbuf)
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index 6b3663a5fb2..42a7e796798 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -37,7 +37,7 @@ For instance, \"fśf.org\" => \"xn--ff-2sa.org\"."
;; add a check first to avoid doing unnecessary work.
(if (string-match "\\`[[:ascii:]]+\\'" domain)
domain
- (mapconcat 'puny-encode-string (split-string domain "[.]") ".")))
+ (mapconcat #'puny-encode-string (split-string domain "[.]") ".")))
(defun puny-encode-string (string)
"Encode STRING according to the IDNA/punycode algorithm.
@@ -57,7 +57,7 @@ For instance, \"bücher\" => \"xn--bcher-kva\"."
(defun puny-decode-domain (domain)
"Decode DOMAIN according to the IDNA/punycode algorithm.
For instance, \"xn--ff-2sa.org\" => \"fśf.org\"."
- (mapconcat 'puny-decode-string (split-string domain "[.]") "."))
+ (mapconcat #'puny-decode-string (split-string domain "[.]") "."))
(defun puny-decode-string (string)
"Decode an IDNA/punycode-encoded string.
@@ -75,7 +75,7 @@ For instance \"xn--bcher-kva\" => \"bücher\"."
(defconst puny-damp 700)
(defconst puny-tmin 1)
(defconst puny-tmax 26)
-(defconst puny-skew 28)
+(defconst puny-skew 38)
;; 0-25 a-z
;; 26-36 0-9
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index ab1f43f552b..2574c8cb63e 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,4 +1,4 @@
-;;; quickurl.el --- insert a URL based on text at point in buffer
+;;; quickurl.el --- insert a URL based on text at point in buffer -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -97,23 +97,19 @@
(locate-user-emacs-file "quickurls" ".quickurls")
"File that contains the URL list."
:version "24.4" ; added locate-user-emacs-file
- :type 'file
- :group 'quickurl)
+ :type 'file)
(defcustom quickurl-format-function #'quickurl-format-url
"Function to format the URL before insertion into the current buffer."
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defcustom quickurl-sort-function #'quickurl-sort-urls
"Function to sort the URL list."
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defcustom quickurl-grab-lookup-function #'current-word
"Function to grab the thing to lookup."
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defun quickurl--assoc-function (key alist)
"Default function for `quickurl-assoc-function'."
@@ -122,31 +118,26 @@
(defcustom quickurl-assoc-function #'quickurl--assoc-function
"Function to use for alist lookup into `quickurl-urls'."
:version "26.1" ; was the obsolete assoc-ignore-case
- :type 'function
- :group 'quickurl)
+ :type 'function)
(defcustom quickurl-completion-ignore-case t
"Should `quickurl-ask' ignore case when doing the input lookup?"
- :type 'boolean
- :group 'quickurl)
+ :type 'boolean)
(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
"Text to write to `quickurl-url-file' before writing the URL list."
- :type 'string
- :group 'quickurl)
+ :type 'string)
(defcustom quickurl-postfix ""
"Text to write to `quickurl-url-file' after writing the URL list.
See the constant `quickurl-reread-hook-postfix' for some example text that
could be used here."
- :type 'string
- :group 'quickurl)
+ :type 'string)
(defcustom quickurl-list-mode-hook nil
"Hooks for `quickurl-list-mode'."
- :type 'hook
- :group 'quickurl)
+ :type 'hook)
;; Constants.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 58cc8b1be55..e7aec505b0b 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -25,7 +25,7 @@
;;; Commentary:
;; Internet Relay Chat (IRC) is a form of instant communication over
-;; the Internet. It is mainly designed for group (many-to-many)
+;; the Internet. It is mainly designed for group (many-to-many)
;; communication in discussion forums called channels, but also allows
;; one-to-one communication.
@@ -44,7 +44,10 @@
(require 'cl-lib)
(require 'ring)
(require 'time-date)
+(require 'auth-source)
+(require 'parse-time)
(eval-when-compile (require 'subr-x))
+(eval-when-compile (require 'rx))
(defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version))
@@ -56,10 +59,10 @@
:group 'applications)
(defcustom rcirc-server-alist
- '(("chat.freenode.net" :channels ("#rcirc")
- ;; Don't use the TLS port by default, in case gnutls is not available.
- ;; :port 7000 :encryption tls
- ))
+ (if (gnutls-available-p)
+ '(("irc.libera.chat" :channels ("#rcirc")
+ :port 6697 :encryption tls))
+ '(("irc.libera.chat" :channels ("#rcirc"))))
"An alist of IRC connections to establish when running `rcirc'.
Each element looks like (SERVER-NAME PARAMETERS).
@@ -108,8 +111,9 @@ for connections using SSL/TLS.
`:server-alias'
-VALUE must be a string that will be used instead of the server name for
-display purposes. If absent, the real server name will be displayed instead."
+VALUE must be a string that will be used instead of the server
+name for display purposes. If absent, the real server name will
+be displayed instead."
:type '(alist :key-type string
:value-type (plist :options
((:nick string)
@@ -120,7 +124,8 @@ display purposes. If absent, the real server name will be displayed instead."
(:channels (repeat string))
(:encryption (choice (const tls)
(const plain)))
- (:server-alias string)))))
+ (:server-alias string))))
+ :version "28.1")
(defcustom rcirc-default-port 6667
"The default port to connect to."
@@ -179,24 +184,36 @@ If nil, no maximum is applied."
(integer :tag "Number of characters")))
(defvar-local rcirc-ignore-buffer-activity-flag nil
- "If non-nil, ignore activity in this buffer.")
+ "Non-nil means ignore activity in this buffer.")
(defvar-local rcirc-low-priority-flag nil
- "If non-nil, activity in this buffer is considered low priority.")
+ "Non-nil means activity in this buffer is considered low priority.")
(defcustom rcirc-omit-responses
'("JOIN" "PART" "QUIT" "NICK")
"Responses which will be hidden when `rcirc-omit-mode' is enabled."
:type '(repeat string))
-(defvar rcirc-prompt-start-marker nil)
+(defcustom rcirc-omit-after-reconnect
+ '("JOIN" "TOPIC" "NAMES")
+ "Types of messages to hide right after reconnecting."
+ :type '(repeat string)
+ :version "28.1")
+
+(defvar-local rcirc-reconncting nil
+ "Non-nil means we have just reconnected.
+This is used to hide the message types enumerated in
+`rcirc-supress-after-reconnect'.")
+
+(defvar-local rcirc-prompt-start-marker nil
+ "Marker indicating the beginning of the message prompt.")
(define-minor-mode rcirc-omit-mode
"Toggle the hiding of \"uninteresting\" lines.
Uninteresting lines are those whose responses are listed in
`rcirc-omit-responses'."
- nil " Omit" nil
+ :lighter " Omit"
(if rcirc-omit-mode
(progn
(add-to-invisibility-spec '(rcirc-omit . nil))
@@ -228,8 +245,7 @@ number. If zero or nil, no truncating is done."
(integer :tag "Number of lines")))
(defcustom rcirc-scroll-show-maximum-output t
- "If non-nil, scroll buffer to keep the point at the bottom of
-the window."
+ "Non-nil means scroll to keep the point at the bottom of the window."
:type 'boolean)
(defcustom rcirc-authinfo nil
@@ -245,13 +261,15 @@ The ARGUMENTS for each METHOD symbol are:
`chanserv': NICK CHANNEL PASSWORD
`bitlbee': NICK PASSWORD
`quakenet': ACCOUNT PASSWORD
+ `sasl': NICK PASSWORD
Examples:
- ((\"freenode\" nickserv \"bob\" \"p455w0rd\")
- (\"freenode\" chanserv \"bob\" \"#bobland\" \"passwd99\")
+ ((\"Libera.Chat\" nickserv \"bob\" \"p455w0rd\")
+ (\"Libera.Chat\" chanserv \"bob\" \"#bobland\" \"passwd99\")
(\"bitlbee\" bitlbee \"robert\" \"sekrit\")
(\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\")
- (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))"
+ (\"quakenet.org\" quakenet \"bobby\" \"sekrit\")
+ (\"oftc\" sasl \"bob\" \"hunter2\"))"
:type '(alist :key-type (regexp :tag "Server")
:value-type (choice (list :tag "NickServ"
(const nickserv)
@@ -269,6 +287,10 @@ Examples:
(list :tag "QuakeNet"
(const quakenet)
(string :tag "Account")
+ (string :tag "Password"))
+ (list :tag "SASL"
+ (const sasl)
+ (string :tag "Nick")
(string :tag "Password")))))
(defcustom rcirc-auto-authenticate-flag t
@@ -290,10 +312,11 @@ The following replacements are made:
%s is the server.
%t is the buffer target, a channel or a user.
-Setting this alone will not affect the prompt;
-use either M-x customize or also call `rcirc-update-prompt'."
+Setting this alone will not affect the prompt; use either
+\\[execute-extended-command] customize or also call
+`rcirc-update-prompt'."
:type 'string
- :set 'rcirc-set-changed
+ :set #'rcirc-set-changed
:initialize 'custom-initialize-default)
(defcustom rcirc-keywords nil
@@ -329,7 +352,8 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
:type 'hook)
(defvar rcirc-authenticated-hook nil
- "Hook run after successfully authenticated.")
+ "Hook run after successfully authenticated.
+Functions in this hook are called with a single argument PROCESS.")
(defcustom rcirc-always-use-server-buffer-flag nil
"Non-nil means messages without a channel target will go to the server buffer."
@@ -384,13 +408,21 @@ will be killed."
:version "24.3"
:type 'boolean)
-(defvar rcirc-nick nil)
+(defcustom rcirc-nick-filter #'identity
+ "Function applied to nicknames before displaying."
+ :version "28.1"
+ :type 'function)
+
+(defvar-local rcirc-nick nil
+ "The nickname used for the current connection.")
-(defvar rcirc-prompt-end-marker nil)
+(defvar-local rcirc-prompt-end-marker nil
+ "Marker indicating the end of the message prompt.")
-(defvar rcirc-nick-table nil)
+(defvar-local rcirc-nick-table nil
+ "Hash table mapping nicks to channels.")
-(defvar rcirc-recent-quit-alist nil
+(defvar-local rcirc-recent-quit-alist nil
"Alist of nicks that have recently quit or parted the channel.")
(defvar rcirc-nick-syntax-table
@@ -401,8 +433,8 @@ will be killed."
table)
"Syntax table which includes all nick characters as word constituents.")
-;; each process has an alist of (target . buffer) pairs
-(defvar rcirc-buffer-alist nil)
+(defvar-local rcirc-buffer-alist nil
+ "Alist of (TARGET . BUFFER) pairs.")
(defvar rcirc-activity nil
"List of buffers with unviewed activity.")
@@ -411,16 +443,16 @@ will be killed."
"String displayed in mode line representing `rcirc-activity'.")
(put 'rcirc-activity-string 'risky-local-variable t)
-(defvar rcirc-server-buffer nil
+(defvar-local rcirc-server-buffer nil
"The server buffer associated with this channel buffer.")
-(defvar rcirc-server-parameters nil
+(defvar-local rcirc-server-parameters nil
"List of parameters received from the server.")
-(defvar rcirc-target nil
+(defvar-local rcirc-target nil
"The channel or user associated with this buffer.")
-(defvar rcirc-urls nil
+(defvar-local rcirc-urls nil
"List of URLs seen in the current buffer and their start positions.")
(put 'rcirc-urls 'permanent-local t)
@@ -428,7 +460,8 @@ will be killed."
"Kill connection after this many seconds if there is no activity.")
-(defvar rcirc-startup-channels nil)
+(defvar-local rcirc-startup-channels nil
+ "List of channel names to join after authenticating.")
(defvar rcirc-server-name-history nil
"History variable for \\[rcirc] call.")
@@ -498,6 +531,12 @@ If ARG is non-nil, instead prompt for connection parameters."
(encryption (plist-get (cdr c) :encryption))
(server-alias (plist-get (cdr c) :server-alias))
contact)
+ (when-let (((not password))
+ (auth (auth-source-search :host server
+ :user user-name
+ :port port))
+ (fn (plist-get (car auth) :secret)))
+ (setq password (funcall fn)))
(when server
(let (connected)
(dolist (p (rcirc-process-list))
@@ -529,23 +568,78 @@ If ARG is non-nil, instead prompt for connection parameters."
(defalias 'irc 'rcirc)
-(defvar rcirc-process-output nil)
-(defvar rcirc-topic nil)
-(defvar rcirc-keepalive-timer nil)
-(defvar rcirc-last-server-message-time nil)
-(defvar rcirc-server nil) ; server provided by server
-(defvar rcirc-server-name nil) ; server name given by 001 response
-(defvar rcirc-timeout-timer nil)
-(defvar rcirc-user-authenticated nil)
-(defvar rcirc-user-disconnect nil)
-(defvar rcirc-connecting nil)
-(defvar rcirc-connection-info nil)
-(defvar rcirc-process nil)
+(defvar-local rcirc-process-output nil
+ "Partial message response.")
+(defvar-local rcirc-topic nil
+ "Topic of the current channel.")
+(defvar rcirc-keepalive-timer nil
+ "Timer for sending KEEPALIVE message.")
+(defvar-local rcirc-last-server-message-time nil
+ "Timestamp for the last server response.")
+(defvar-local rcirc-server nil
+ "Server provided by server.")
+(defvar-local rcirc-server-name nil
+ "Server name given by 001 response.")
+(defvar-local rcirc-timeout-timer nil
+ "Timer for determining a network timeout.")
+(defvar-local rcirc-user-authenticated nil
+ "Flag indicating if the user is authenticated.")
+(defvar-local rcirc-user-disconnect nil
+ "Flag indicating if the connection was broken.")
+(defvar-local rcirc-connecting nil
+ "Flag indicating if the connection is being established.")
+(defvar-local rcirc-connection-info nil
+ "Information about the current connection.
+If defined, it is a list of this form (SERVER PORT NICK USER-NAME
+FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION SERVER-ALIAS).
+See `rcirc-connect' for more details on these variables.")
+(defvar-local rcirc-process nil
+ "Network process for the current connection.")
+
+;;; IRCv3 capability negotiation (https://ircv3.net/specs/extensions/capability-negotiation)
+(defvar rcirc-implemented-capabilities
+ '("message-tags" ;https://ircv3.net/specs/extensions/message-tags
+ "server-time" ;https://ircv3.net/specs/extensions/server-time
+ "batch" ;https://ircv3.net/specs/extensions/batch
+ "message-ids" ;https://ircv3.net/specs/extensions/message-ids
+ "invite-notify" ;https://ircv3.net/specs/extensions/invite-notify
+ "sasl" ;https://ircv3.net/specs/extensions/sasl-3.1
+ )
+ "A list of capabilities that rcirc supports.")
+(defvar-local rcirc-requested-capabilities nil
+ "A list of capabilities that client has requested.")
+(defvar-local rcirc-acked-capabilities nil
+ "A list of capabilities that the server supports.")
+(defvar-local rcirc-finished-sasl t
+ "Check whether SASL authentication has completed")
+
+(defun rcirc-get-server-method (server)
+ "Return authentication method for SERVER."
+ (catch 'method
+ (dolist (i rcirc-authinfo)
+ (let ((server-i (car i))
+ (method (cadr i)))
+ (when (string-match server-i server)
+ (throw 'method method))))))
+
+(defun rcirc-get-server-password (server)
+ "Return password for SERVER."
+ (catch 'pass
+ (dolist (i rcirc-authinfo)
+ (let ((server-i (car i))
+ (args (cdddr i)))
+ (when (string-match server-i server)
+ (throw 'pass (car args)))))))
;;;###autoload
(defun rcirc-connect (server &optional port nick user-name
full-name startup-channels password encryption
server-alias)
+ "Connect to SERVER.
+The arguments PORT, NICK, USER-NAME, FULL-NAME, PASSWORD,
+ENCRYPTION, SERVER-ALIAS are interpreted as in
+`rcirc-server-alist'. STARTUP-CHANNELS is a list of channels
+that are joined after authentication."
(save-excursion
(message "Connecting to %s..." (or server-alias server))
(let* ((inhibit-eol-conversion)
@@ -558,6 +652,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(user-name (or user-name rcirc-default-user-name))
(full-name (or full-name rcirc-default-full-name))
(startup-channels startup-channels)
+ (use-sasl (eq (rcirc-get-server-method server) 'sasl))
(process (open-network-stream
(or server-alias server) nil server port-number
:type (or encryption 'plain))))
@@ -565,38 +660,42 @@ If ARG is non-nil, instead prompt for connection parameters."
(set-process-coding-system process 'raw-text 'raw-text)
(switch-to-buffer (rcirc-generate-new-buffer-name process nil))
(set-process-buffer process (current-buffer))
- (rcirc-mode process nil)
+ (unless (eq major-mode 'rcirc-mode)
+ (rcirc-mode process nil))
(set-process-sentinel process 'rcirc-sentinel)
(set-process-filter process 'rcirc-filter)
- (setq-local rcirc-connection-info
- (list server port nick user-name full-name startup-channels
- password encryption server-alias))
- (setq-local rcirc-process process)
- (setq-local rcirc-server server)
- (setq-local rcirc-server-name
- (or server-alias server)) ; Update when we get 001 response.
- (setq-local rcirc-buffer-alist nil)
- (setq-local rcirc-nick-table (make-hash-table :test 'equal))
- (setq-local rcirc-nick nick)
- (setq-local rcirc-process-output nil)
- (setq-local rcirc-startup-channels startup-channels)
- (setq-local rcirc-last-server-message-time (current-time))
-
- (setq-local rcirc-timeout-timer nil)
- (setq-local rcirc-user-disconnect nil)
- (setq-local rcirc-user-authenticated nil)
- (setq-local rcirc-connecting t)
- (setq-local rcirc-server-parameters nil)
+ (setq rcirc-connection-info
+ (list server port nick user-name full-name startup-channels
+ password encryption server-alias))
+ (setq rcirc-process process)
+ (setq rcirc-server server)
+ (setq rcirc-server-name (or server-alias server)) ; Update when we get 001 response.
+ (setq rcirc-nick-table (make-hash-table :test 'equal))
+ (setq rcirc-nick nick)
+ (setq rcirc-startup-channels startup-channels)
+ (setq rcirc-last-server-message-time (current-time))
+
+ (setq rcirc-connecting t)
(add-hook 'auto-save-hook 'rcirc-log-write)
+ (when use-sasl
+ (rcirc-send-string process "CAP REQ sasl"))
+ (when use-sasl
+ (setq-local rcirc-finished-sasl nil))
;; identify
+ (dolist (cap rcirc-implemented-capabilities)
+ (rcirc-send-string process "CAP" "REQ" : cap)
+ (push cap rcirc-requested-capabilities))
(unless (zerop (length password))
- (rcirc-send-string process (concat "PASS " password)))
- (rcirc-send-string process (concat "NICK " nick))
- (rcirc-send-string process (concat "USER " user-name
- " 0 * :" full-name))
+ (rcirc-send-string process "PASS" password))
+ (rcirc-send-string process "NICK" nick)
+ (rcirc-send-string process "USER" user-name "0" "*" : full-name)
+ ;; Setup sasl, and initiate authentication.
+ (when (and rcirc-auto-authenticate-flag
+ use-sasl)
+ (rcirc-send-string process "AUTHENTICATE" "PLAIN"))
;; setup ping timer if necessary
(unless rcirc-keepalive-timer
@@ -604,31 +703,33 @@ If ARG is non-nil, instead prompt for connection parameters."
(run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive)))
(message "Connecting to %s...done" (or server-alias server))
+ (setq mode-line-process nil)
;; return process object
process)))
(defmacro with-rcirc-process-buffer (process &rest body)
+ "Evaluate BODY in the buffer of PROCESS."
(declare (indent 1) (debug t))
`(with-current-buffer (process-buffer ,process)
,@body))
(defmacro with-rcirc-server-buffer (&rest body)
+ "Evaluate BODY in the server buffer of the current channel."
(declare (indent 0) (debug t))
- `(with-current-buffer rcirc-server-buffer
- ,@body))
+ `(if (buffer-live-p rcirc-server-buffer)
+ (with-current-buffer rcirc-server-buffer
+ ,@body)
+ (user-error "Server buffer was killed")))
(define-obsolete-function-alias 'rcirc-float-time 'float-time "26.1")
(defun rcirc-prompt-for-encryption (server-plist)
"Prompt the user for the encryption method to use.
SERVER-PLIST is the property list for the server."
- (let ((choices '("plain" "tls"))
- (default (or (plist-get server-plist :encryption)
- "plain")))
- (intern
- (completing-read (format-prompt "Encryption" default)
- choices nil t nil nil default))))
+ (if (or (eq (plist-get server-plist :encryption) 'plain)
+ (yes-or-no-p "Encrypt connection?"))
+ 'tls 'plain))
(defun rcirc-keepalive ()
"Send keep alive pings to active rcirc processes.
@@ -649,14 +750,18 @@ last ping."
(setq rcirc-keepalive-timer nil)))
(defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message)
+ "Uptime header in PROCESS buffer.
+MESSAGE should contain a timestamp, indicating when the KEEPALIVE
+message was generated."
(with-rcirc-process-buffer process
(setq header-line-format
(format "%f" (float-time
(time-since (string-to-number message)))))))
-(defvar rcirc-debug-buffer "*rcirc debug*")
+(defvar rcirc-debug-buffer "*rcirc debug*"
+ "Buffer name for debugging messages.")
(defvar rcirc-debug-flag nil
- "If non-nil, write information to `rcirc-debug-buffer'.")
+ "Non-nil means write information to `rcirc-debug-buffer'.")
(defun rcirc-debug (process text)
"Add an entry to the debug log including PROCESS and TEXT.
Debug text is appended to `rcirc-debug-buffer' if `rcirc-debug-flag'
@@ -690,12 +795,12 @@ When 0, do not auto-reconnect."
:version "25.1"
:type 'integer)
-(defvar rcirc-last-connect-time nil
+(defvar-local rcirc-last-connect-time nil
"The last time the buffer was connected.")
(defun rcirc-sentinel (process sentinel)
"Called when PROCESS receives SENTINEL."
- (let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
+ (let ((sentinel (string-replace "\n" "" sentinel)))
(rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
(with-rcirc-process-buffer process
(dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
@@ -718,6 +823,8 @@ When 0, do not auto-reconnect."
(run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
(defun rcirc-disconnect-buffer (&optional buffer)
+ "Disconnect BUFFER.
+If BUFFER is nil, default to the current buffer."
(with-current-buffer (or buffer (current-buffer))
;; set rcirc-target to nil for each channel so cleanup
;; doesn't happen when we reconnect
@@ -755,19 +862,19 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(rcirc-process-server-response process line))))))
(defun rcirc-reschedule-timeout (process)
+ "Update timeout indicator for PROCESS."
(with-rcirc-process-buffer process
(when (not rcirc-connecting)
(with-rcirc-process-buffer process
(when rcirc-timeout-timer (cancel-timer rcirc-timeout-timer))
(setq rcirc-timeout-timer (run-at-time rcirc-timeout-seconds nil
- 'rcirc-delete-process
+ 'delete-process
process))))))
-(defun rcirc-delete-process (process)
- (delete-process process))
-
-(defvar rcirc-trap-errors-flag t)
+(defvar rcirc-trap-errors-flag t
+ "Non-nil means Lisp errors are degraded to error messages.")
(defun rcirc-process-server-response (process text)
+ "Parse TEXT as received from PROCESS."
(if rcirc-trap-errors-flag
(condition-case err
(rcirc-process-server-response-1 process text)
@@ -776,17 +883,91 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(format "\"%s\" %s" text err) t)))
(rcirc-process-server-response-1 process text)))
+(defconst rcirc-process-regexp
+ (rx-let ((message-tag ; message tags as specified in
+ ; https://ircv3.net/specs/extensions/message-tags
+ (: (? "+")
+ (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/")
+ (+ (any alnum "-"))
+ (? "="
+ (* (not (any 0 ?\n ?\r ?\; ?\s)))))))
+ (rx line-start
+ (optional "@" (group message-tag (* ";" message-tag)) (+ space))
+ ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1.
+ ;; We're a bit more accepting than the RFC: We allow any non-space
+ ;; characters in the command name, multiple spaces between
+ ;; arguments, and allow the last argument to omit the leading ":",
+ ;; even if there are less than 15 arguments.
+ (optional
+ (group ":" (group (one-or-more (not (any " ")))) " "))
+ (group (one-or-more (not (any " "))))))
+ "Regular expression used for parsing server response.")
+
+(defconst rcirc-tag-regexp
+ (rx bos
+ (group
+ (? "+")
+ (? (+ (or alnum "-")) (+ "." (+ (or alnum "-"))) "/")
+ (+ (any alnum "-")))
+ (? "=" (group (* (not (any 0 ?\n ?\r ?\; ?\s)))))
+ eos)
+ "Regular expression used for destructing a tag.")
+
+(defvar rcirc-message-tags nil
+ "Alist of parsed message tags.")
+
+(defvar rcirc-supported-batch-types
+ '()
+ "List of recognized batch types.
+Each element has the form (TYPE HANDLE), where TYPE is a string
+and HANDLE is either the symbol `immediate' or `deferred'.
+Messages in an immediate batch are handled just like regular
+messages, while deferred messages are stored in
+`rcirc-batch-messages'.")
+
+(defvar-local rcirc-batch-attributes nil
+ "Alist mapping batch IDs to parameters.")
+
+(defvar-local rcirc-batched-messages nil
+ "Alist mapping batch IDs to deferred messages.
+Note that the messages are stored in reverse order.")
+
+(defsubst rcirc-get-tag (key &optional default)
+ "Return tag value for KEY or DEFAULT."
+ (alist-get key rcirc-message-tags default nil #'string=))
+
(defun rcirc-process-server-response-1 (process text)
- ;; See https://tools.ietf.org/html/rfc2812#section-2.3.1. We're a
- ;; bit more accepting than the RFC: We allow any non-space
- ;; characters in the command name, multiple spaces between
- ;; arguments, and allow the last argument to omit the leading ":",
- ;; even if there are less than 15 arguments.
- (if (string-match "^\\(:\\([^ ]+\\) \\)?\\([^ ]+\\)" text)
- (let* ((user (match-string 2 text))
+ "Parse TEXT as received from PROCESS."
+ (if (string-match rcirc-process-regexp text)
+ (let* ((rcirc-message-tags
+ (append
+ (and-let* ((tag-data (match-string 1 text)))
+ (save-match-data
+ (mapcar
+ (lambda (tag)
+ (unless (string-match rcirc-tag-regexp tag)
+ ;; This should not happen, unless there is
+ ;; a mismatch between this regular
+ ;; expression and `rcirc-process-regexp'.
+ (error "Malformed tag %S" tag))
+ (cons (match-string 1 tag)
+ (replace-regexp-in-string
+ (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n))
+ (lambda (rep)
+ (concat (substring rep 0 -2)
+ (cl-case (aref rep (1- (length rep)))
+ (?: ";")
+ (?s " ")
+ (?\\ "\\\\")
+ (?r "\r")
+ (?n "\n"))))
+ (match-string 2 tag))))
+ (split-string tag-data ";"))))
+ rcirc-message-tags))
+ (user (match-string 3 text))
(sender (rcirc-user-nick user))
- (cmd (match-string 3 text))
- (cmd-end (match-end 3))
+ (cmd (match-string 4 text))
+ (cmd-end (match-end 4))
(args nil)
(handler (intern-soft (concat "rcirc-handler-" cmd))))
(cl-loop with i = cmd-end
@@ -799,9 +980,18 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(push (substring text (match-end 0)) args)
(cl-assert (= i (length text))))
(cl-callf nreverse args)))
- (if (not (fboundp handler))
- (rcirc-handler-generic process cmd sender args text)
- (funcall handler process sender args text))
+ (cond ((and-let* ((batch-id (rcirc-get-tag "batch"))
+ (type (cadr (assoc batch-id rcirc-batch-attributes)))
+ (attr (assoc type rcirc-supported-batch-types))
+ ((eq (cadr attr) 'deferred)))
+ ;; handle deferred batch messages later
+ (push (list cmd process sender args text rcirc-message-tags)
+ (alist-get batch-id rcirc-batched-messages
+ nil nil #'string=))
+ t))
+ ((not (fboundp handler))
+ (rcirc-handler-generic process cmd sender args text))
+ ((funcall handler process sender args text)))
(run-hook-with-args 'rcirc-receive-message-functions
process cmd sender args text))
(message "UNHANDLED: %s" text)))
@@ -810,17 +1000,34 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
"Responses that don't trigger activity in the mode-line indicator.")
(defun rcirc-handler-generic (process response sender args _text)
- "Generic server response handler."
+ "Generic server response handler.
+This handler is called, when no more specific handler could be
+found. PROCESS, SENDER and RESPONSE are passed on to
+`rcirc-print'. ARGS are concatenated into a single string and
+used as the message body."
(rcirc-print process sender response nil
(mapconcat 'identity (cdr args) " ")
(not (member response rcirc-responses-no-activity))))
(defun rcirc--connection-open-p (process)
+ "Check if PROCESS is open or running."
(memq (process-status process) '(run open)))
-(defun rcirc-send-string (process string)
- "Send PROCESS a STRING plus a newline."
- (let ((string (concat (encode-coding-string string rcirc-encode-coding-system)
+(defun rcirc-send-string (process &rest parts)
+ "Send PROCESS a PARTS plus a newline.
+PARTS may contain a `:' symbol, to designate that the next string
+is the message, that should be prefixed by a colon. If the last
+element in PARTS is a list, append it to PARTS."
+ (let ((last (car (last parts))))
+ (when (listp last)
+ (setf parts (append (butlast parts) last))))
+ (when-let (message (memq : parts))
+ (cl-check-type (cadr message) string)
+ (setf (cadr message) (concat ":" (cadr message))
+ parts (remq : parts)))
+ (let ((string (concat (encode-coding-string
+ (mapconcat #'identity parts " ")
+ rcirc-encode-coding-system)
"\n")))
(unless (rcirc--connection-open-p process)
(error "Network connection to %s is not open"
@@ -829,13 +1036,17 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(process-send-string process string)))
(defun rcirc-send-privmsg (process target string)
+ "Send TARGET the message in STRING via PROCESS."
(cl-check-type target string)
- (rcirc-send-string process (format "PRIVMSG %s :%s" target string)))
+ (rcirc-send-string process "PRIVMSG" target : string))
+
+(defun rcirc-ctcp-wrap (&rest args)
+ "Join ARGS into a string wrapped by ASCII 1 charterers."
+ (concat "\C-a" (string-join (delq nil args) " ") "\C-a"))
(defun rcirc-send-ctcp (process target request &optional args)
- (let ((args (if args (concat " " args) "")))
- (rcirc-send-privmsg process target
- (format "\C-a%s%s\C-a" request args))))
+ "Send TARGET a REQUEST via PROCESS."
+ (rcirc-send-privmsg process target (rcirc-ctcp-wrap request args)))
(defun rcirc-buffer-process (&optional buffer)
"Return the process associated with channel BUFFER.
@@ -861,7 +1072,7 @@ With no argument or nil as argument, use the current buffer."
"Return the nick associated with BUFFER.
With no argument or nil as argument, use the current buffer."
(with-current-buffer (or buffer (current-buffer))
- (with-current-buffer rcirc-server-buffer
+ (with-rcirc-server-buffer
(or rcirc-nick rcirc-default-nick))))
(defvar rcirc-max-message-length 420
@@ -894,17 +1105,22 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(let ((response (if noticep "NOTICE" "PRIVMSG")))
(rcirc-get-buffer-create process target)
(dolist (msg (rcirc-split-message message))
- (rcirc-send-string process (concat response " " target " :" msg))
+ (rcirc-send-string process response target : msg)
(unless silent
(rcirc-print process (rcirc-nick process) response target msg)))))
-(defvar rcirc-input-ring nil)
-(defvar rcirc-input-ring-index 0)
+(defvar-local rcirc-input-ring nil
+ "Ring object for input.")
+
+(defvar-local rcirc-input-ring-index 0
+ "Current position in the input ring.")
(defun rcirc-prev-input-string (arg)
+ "Move ARG elements ahead in the input ring."
(ring-ref rcirc-input-ring (+ rcirc-input-ring-index arg)))
(defun rcirc-insert-prev-input ()
+ "Insert previous element in input ring."
(interactive)
(when (<= rcirc-prompt-end-marker (point))
(delete-region rcirc-prompt-end-marker (point-max))
@@ -912,6 +1128,7 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(setq rcirc-input-ring-index (1+ rcirc-input-ring-index))))
(defun rcirc-insert-next-input ()
+ "Insert next element in input ring."
(interactive)
(when (<= rcirc-prompt-end-marker (point))
(delete-region rcirc-prompt-end-marker (point-max))
@@ -945,63 +1162,62 @@ The list is updated automatically by `defun-rcirc-command'.")
(if (re-search-backward "[[:space:]@]" rcirc-prompt-end-marker t)
(1+ (point))
rcirc-prompt-end-marker)))
- (table (if (and (= beg rcirc-prompt-end-marker)
- (eq (char-after beg) ?/))
- (delete-dups
- (nconc (sort (copy-sequence rcirc-client-commands)
- 'string-lessp)
- (sort (copy-sequence rcirc-server-commands)
- 'string-lessp)))
- (rcirc-channel-nicks (rcirc-buffer-process)
- rcirc-target))))
- (list beg (point) table))))
-
-(defvar rcirc-completions nil)
-(defvar rcirc-completion-start nil)
-
-(defun rcirc-complete ()
- "Cycle through completions from list of nicks in channel or IRC commands.
-IRC command completion is performed only if `/' is the first input char."
- (interactive)
- (unless (rcirc-looking-at-input)
- (error "Point not located after rcirc prompt"))
- (if (eq last-command this-command)
- (setq rcirc-completions
- (append (cdr rcirc-completions) (list (car rcirc-completions))))
- (let ((completion-ignore-case t)
- (table (rcirc-completion-at-point)))
- (setq rcirc-completion-start (car table))
- (setq rcirc-completions
- (and rcirc-completion-start
- (all-completions (buffer-substring rcirc-completion-start
- (cadr table))
- (nth 2 table))))))
- (let ((completion (car rcirc-completions)))
- (when completion
- (delete-region rcirc-completion-start (point))
- (insert
- (cond
- ((= (aref completion 0) ?/) (concat completion " "))
- ((= rcirc-completion-start rcirc-prompt-end-marker)
- (format rcirc-nick-completion-format completion))
- (t completion))))))
-
-(defun set-rcirc-decode-coding-system (coding-system)
- "Set the decode coding system used in this channel."
+ (table (cond
+ ;; No completion before the prompt
+ ((< beg rcirc-prompt-end-marker) nil)
+ ;; Only complete nicks mid-message
+ ((> beg rcirc-prompt-end-marker)
+ (mapcar rcirc-nick-filter
+ (rcirc-channel-nicks
+ (rcirc-buffer-process)
+ rcirc-target)))
+ ;; Complete commands at the beginning of the
+ ;; message, when the first character is a dash
+ ((eq (char-after beg) ?/)
+ (mapcar
+ (lambda (cmd) (concat cmd " "))
+ (nconc (sort (copy-sequence rcirc-client-commands)
+ 'string-lessp)
+ (sort (copy-sequence rcirc-server-commands)
+ 'string-lessp))))
+ ;; Complete usernames right after the prompt by
+ ;; appending a colon after the name
+ ((mapcar
+ (lambda (str) (concat (funcall rcirc-nick-filter str) ": "))
+ (rcirc-channel-nicks (rcirc-buffer-process)
+ rcirc-target))))))
+ (list beg (point)
+ (lambda (str pred action)
+ (if (eq action 'metadata)
+ '(metadata (cycle-sort-function . identity))
+ (complete-with-action action table str pred)))))))
+
+(defun rcirc-set-decode-coding-system (coding-system)
+ "Set the decode CODING-SYSTEM used in this channel."
(interactive "zCoding system for incoming messages: ")
(setq-local rcirc-decode-coding-system coding-system))
-(defun set-rcirc-encode-coding-system (coding-system)
- "Set the encode coding system used in this channel."
+(define-obsolete-function-alias
+ 'rcirc-set-decode-coding-system
+ 'set-rcirc-decode-coding-system
+ "28.1")
+
+(defun rcirc-set-encode-coding-system (coding-system)
+ "Set the encode CODING-SYSTEM used in this channel."
(interactive "zCoding system for outgoing messages: ")
(setq-local rcirc-encode-coding-system coding-system))
+(define-obsolete-function-alias
+ 'rcirc-set-encode-coding-system
+ 'set-rcirc-encode-coding-system
+ "28.1")
+
(defvar rcirc-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'rcirc-send-input)
(define-key map (kbd "M-p") 'rcirc-insert-prev-input)
(define-key map (kbd "M-n") 'rcirc-insert-next-input)
- (define-key map (kbd "TAB") 'rcirc-complete)
+ (define-key map (kbd "TAB") 'completion-at-point)
(define-key map (kbd "C-c C-b") 'rcirc-browse-url)
(define-key map (kbd "C-c C-c") 'rcirc-edit-multiline)
(define-key map (kbd "C-c C-j") 'rcirc-cmd-join)
@@ -1024,34 +1240,35 @@ IRC command completion is performed only if `/' is the first input char."
map)
"Keymap for rcirc mode.")
-(defvar rcirc-short-buffer-name nil
+(defvar-local rcirc-short-buffer-name nil
"Generated abbreviation to use to indicate buffer activity.")
(defvar rcirc-mode-hook nil
"Hook run when setting up rcirc buffer.")
-(defvar rcirc-last-post-time nil)
+(defvar-local rcirc-last-post-time nil
+ "Timestamp indicating last user action.")
(defvar rcirc-log-alist nil
"Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
Each element looks like (FILENAME . TEXT).")
-(defvar rcirc-current-line 0
+(defvar-local rcirc-current-line 0
"The current number of responses printed in this channel.
This number is independent of the number of lines in the buffer.")
(defun rcirc-mode (process target)
- ;; FIXME: Use define-derived-mode.
"Major mode for IRC channel buffers.
\\{rcirc-mode-map}"
+ ;; FIXME: Use define-derived-mode.
(kill-all-local-variables)
(use-local-map rcirc-mode-map)
(setq mode-name "rcirc")
(setq major-mode 'rcirc-mode)
(setq mode-line-process nil)
- (setq-local rcirc-input-ring
+ (setq rcirc-input-ring
;; If rcirc-input-ring is already a ring with desired
;; size do not re-initialize.
(if (and (ring-p rcirc-input-ring)
@@ -1059,18 +1276,14 @@ This number is independent of the number of lines in the buffer.")
rcirc-input-ring-size))
rcirc-input-ring
(make-ring rcirc-input-ring-size)))
- (setq-local rcirc-server-buffer (process-buffer process))
- (setq-local rcirc-target target)
- (setq-local rcirc-topic nil)
- (setq-local rcirc-last-post-time (current-time))
+ (setq rcirc-server-buffer (process-buffer process))
+ (setq rcirc-target target)
+ (setq rcirc-last-post-time (current-time))
(setq-local fill-paragraph-function 'rcirc-fill-paragraph)
- (setq-local rcirc-recent-quit-alist nil)
- (setq-local rcirc-current-line 0)
- (setq-local rcirc-last-connect-time (current-time))
+ (setq rcirc-current-line 0)
+ (setq rcirc-last-connect-time (current-time))
(use-hard-newlines t)
- (setq-local rcirc-short-buffer-name nil)
- (setq-local rcirc-urls nil)
;; setup for omitting responses
(setq buffer-invisibility-spec '())
@@ -1091,8 +1304,8 @@ This number is independent of the number of lines in the buffer.")
(if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
- (setq-local rcirc-prompt-start-marker (point-max-marker))
- (setq-local rcirc-prompt-end-marker (point-max-marker))
+ (setq rcirc-prompt-start-marker (point-max-marker))
+ (setq rcirc-prompt-end-marker (point-max-marker))
(rcirc-update-prompt)
(goto-char rcirc-prompt-end-marker)
@@ -1113,6 +1326,7 @@ This number is independent of the number of lines in the buffer.")
(add-hook 'completion-at-point-functions
'rcirc-completion-at-point nil 'local)
+ (setq-local completion-cycle-threshold t)
(run-mode-hooks 'rcirc-mode-hook))
@@ -1151,7 +1365,7 @@ If ALL is non-nil, update prompts in all IRC buffers."
'front-sticky t 'rear-nonsticky t))))))))
(defun rcirc-set-changed (option value)
- "Set OPTION to VALUE and do updates after a customization change."
+ "Set OPTION to VALUE and update after a customization change."
(set-default option value)
(cond ((eq option 'rcirc-prompt)
(rcirc-update-prompt 'all))
@@ -1165,9 +1379,10 @@ If ALL is non-nil, update prompts in all IRC buffers."
(or (eq (aref target 0) ?#)
(eq (aref target 0) ?&))))
-(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log"
+(defcustom rcirc-log-directory (locate-user-emacs-file "rcirc-log")
"Directory to keep IRC logfiles."
- :type 'directory)
+ :type 'directory
+ :version "28.1")
(defcustom rcirc-log-flag nil
"Non-nil means log IRC activity to disk.
@@ -1193,10 +1408,11 @@ with it."
(kill-buffer (cdr channel))))))
(defun rcirc-change-major-mode-hook ()
- "Part the channel when changing the major-mode."
+ "Part the channel when changing the major mode."
(rcirc-clean-up-buffer "Changed major mode"))
(defun rcirc-clean-up-buffer (reason)
+ "Clean up current buffer and part with REASON."
(let ((buffer (current-buffer)))
(rcirc-clear-activity buffer)
(when (and (rcirc-buffer-process)
@@ -1207,7 +1423,7 @@ with it."
(rcirc-update-short-buffer-names)
(if (rcirc-channel-p rcirc-target)
(rcirc-send-string (rcirc-buffer-process)
- (concat "PART " rcirc-target " :" reason))
+ "PART" rcirc-target : reason)
(when rcirc-target
(rcirc-remove-nick-channel (rcirc-buffer-process)
(rcirc-buffer-nick)
@@ -1247,9 +1463,11 @@ Create the buffer if it doesn't exist."
(let ((new-buffer (get-buffer-create
(rcirc-generate-new-buffer-name process target))))
(with-current-buffer new-buffer
- (rcirc-mode process target)
+ (unless (eq major-mode 'rcirc-mode)
+ (rcirc-mode process target)))
+ (setq mode-line-process nil)
(rcirc-put-nick-channel process (rcirc-nick process) target
- rcirc-current-line))
+ rcirc-current-line)
new-buffer)))))
(defun rcirc-send-input ()
@@ -1285,6 +1503,8 @@ Create the buffer if it doesn't exist."
(setq rcirc-input-ring-index 0))))))
(defun rcirc-fill-paragraph (&optional justify)
+ "Implementation for `fill-paragraph-function'.
+The argument JUSTIFY is passed on to `fill-region'."
(interactive "P")
(when (> (point) rcirc-prompt-end-marker)
(save-restriction
@@ -1293,13 +1513,15 @@ Create the buffer if it doesn't exist."
(fill-region (point-min) (point-max) justify)))))
(defun rcirc-process-input-line (line)
- (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
+ "Process LINE as a message or a command."
+ (if (string-match "^/\\([^/ ][^ ]*\\) ?\\(.*\\)$" line)
(rcirc-process-command (match-string 1 line)
(match-string 2 line)
line)
(rcirc-process-message line)))
(defun rcirc-process-message (line)
+ "Process LINE as a message to be sent."
(if (not rcirc-target)
(message "Not joined (no target)")
(delete-region rcirc-prompt-end-marker (point))
@@ -1307,28 +1529,31 @@ Create the buffer if it doesn't exist."
(setq rcirc-last-post-time (current-time))))
(defun rcirc-process-command (command args line)
- (if (eq (aref command 0) ?/)
- ;; "//text" will send "/text" as a message
- (rcirc-process-message (substring line 1))
- (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
- (process (rcirc-buffer-process)))
- (newline)
- (with-current-buffer (current-buffer)
- (delete-region rcirc-prompt-end-marker (point))
- (if (string= command "me")
- (rcirc-print process (rcirc-buffer-nick)
- "ACTION" rcirc-target args)
+ "Process COMMAND with arguments ARGS.
+LINE is the raw input, from which COMMAND and ARGS was
+extracted."
+ (let ((fun (intern-soft (concat "rcirc-cmd-" command)))
+ (process (rcirc-buffer-process)))
+ (newline)
+ (with-current-buffer (current-buffer)
+ (delete-region rcirc-prompt-end-marker (point))
+ (if (string= command "me")
(rcirc-print process (rcirc-buffer-nick)
- "COMMAND" rcirc-target line))
- (set-marker rcirc-prompt-end-marker (point))
- (if (fboundp fun)
- (funcall fun args process rcirc-target)
- (rcirc-send-string process
- (concat command " :" args)))))))
-
-(defvar-local rcirc-parent-buffer nil)
+ "ACTION" rcirc-target args)
+ (rcirc-print process (rcirc-buffer-nick)
+ "COMMAND" rcirc-target line))
+ (set-marker rcirc-prompt-end-marker (point))
+ (if (fboundp fun)
+ (funcall fun args process rcirc-target)
+ (rcirc-send-string process command : args)))))
+
+(defvar-local rcirc-parent-buffer nil
+ "Message buffer that requested a multiline buffer.")
(put 'rcirc-parent-buffer 'permanent-local t)
-(defvar rcirc-window-configuration nil)
+
+(defvar rcirc-window-configuration nil
+ "Window configuration before creating multiline buffer.")
+
(defun rcirc-edit-multiline ()
"Move current edit to a dedicated buffer."
(interactive)
@@ -1358,9 +1583,7 @@ Create the buffer if it doesn't exist."
(define-minor-mode rcirc-multiline-minor-mode
"Minor mode for editing multiple lines in rcirc."
- :init-value nil
:lighter " rcirc-mline"
- :keymap rcirc-multiline-minor-mode-map
:global nil
(setq fill-column rcirc-max-message-length))
@@ -1426,9 +1649,10 @@ the of the following escape sequences replaced by the described values:
:value-type string))
(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
-is found by looking up RESPONSE in `rcirc-response-formats'."
+ "Return a formatted response string from SENDER, incorporating TEXT.
+The specific formatting used is found by looking up RESPONSE in
+`rcirc-response-formats'. PROCESS is the process object used for
+communication."
(with-temp-buffer
(insert (or (cdr (assoc response rcirc-response-formats))
(cdr (assq t rcirc-response-formats))))
@@ -1437,7 +1661,7 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(sender (if (or (not sender)
(string= (rcirc-server-name process) sender))
""
- sender))
+ (funcall rcirc-nick-filter sender)))
face)
(while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t)
(rcirc-add-face start (match-beginning 0) face)
@@ -1482,7 +1706,8 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(buffer-substring (point-min) (point-max))))
(defun rcirc-target-buffer (process sender response target _text)
- "Return a buffer to print the server response."
+ "Return a buffer to print the server response from SENDER.
+PROCESS is the process object for the current connection."
(cl-assert (not (bufferp target)))
(with-rcirc-process-buffer process
(cond ((not target)
@@ -1498,8 +1723,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
((or (rcirc-get-buffer process target)
(rcirc-any-buffer process))))))
-(defvar-local rcirc-activity-types nil)
(defvar-local rcirc-last-sender nil)
+(defvar-local rcirc-activity-types nil
+ "List of symbols designating kinds of activities in a buffer.")
(defcustom rcirc-omit-threshold 100
"Lines since last activity from a nick before `rcirc-omit-responses' are omitted."
@@ -1512,14 +1738,16 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(defun rcirc-last-quit-line (process nick target)
"Return the line number where NICK left TARGET.
-Returns nil if the information is not recorded."
+Returns nil if the information is not recorded.
+PROCESS is the process object for the current connection."
(let ((chanbuf (rcirc-get-buffer process target)))
(when chanbuf
(cdr (assoc-string nick (with-current-buffer chanbuf
rcirc-recent-quit-alist))))))
(defun rcirc-last-line (process nick target)
- "Return the line from the last activity from NICK in TARGET."
+ "Return the line from the last activity from NICK in TARGET.
+PROCESS is the process object for the current connection."
(let ((line (or (cdr (assoc-string target
(gethash nick (with-rcirc-server-buffer
rcirc-nick-table)) t))
@@ -1530,7 +1758,8 @@ Returns nil if the information is not recorded."
nil)))
(defun rcirc-elapsed-lines (process nick target)
- "Return the number of lines since activity from NICK in TARGET."
+ "Return the number of lines since activity from NICK in TARGET.
+PROCESS is the process object for the current connection."
(let ((last-activity-line (rcirc-last-line process nick target)))
(when (and last-activity-line
(> last-activity-line 0))
@@ -1538,11 +1767,12 @@ Returns nil if the information is not recorded."
(defvar rcirc-markup-text-functions
'(rcirc-markup-attributes
+ rcirc-color-attributes
+ rcirc-remove-markup-codes
rcirc-markup-my-nick
rcirc-markup-urls
rcirc-markup-keywords
rcirc-markup-bright-nicks)
-
"List of functions used to manipulate text before it is printed.
Each function takes two arguments, SENDER, and RESPONSE. The
@@ -1552,7 +1782,8 @@ at the beginning of the `rcirc-text' propertized text.")
(defun rcirc-print (process sender response target text &optional activity)
"Print TEXT in the buffer associated with TARGET.
Format based on SENDER and RESPONSE. If ACTIVITY is non-nil,
-record activity."
+record activity. PROCESS is the process object for the current
+connection."
(or text (setq text ""))
(unless (and (or (member sender rcirc-ignore-list)
(member (with-syntax-table rcirc-nick-syntax-table
@@ -1562,11 +1793,13 @@ record activity."
;; do not ignore if we sent the message
(not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
+ (time (if-let ((time (rcirc-get-tag "time")))
+ (parse-iso8601-time-string time)
+ (current-time)))
(inhibit-read-only t))
(with-current-buffer buffer
(let ((moving (= (point) rcirc-prompt-end-marker))
- (old-point (point-marker))
- (fill-start (marker-position rcirc-prompt-start-marker)))
+ (old-point (point-marker)))
(setq text (decode-coding-string text rcirc-decode-coding-system))
(unless (string= sender (rcirc-nick process))
@@ -1580,25 +1813,32 @@ record activity."
;; temporarily set the marker insertion-type because
;; insert-before-markers results in hidden text in new buffers
(goto-char rcirc-prompt-start-marker)
+ (catch 'exit
+ (while (not (bobp))
+ (goto-char (or (previous-single-property-change (point) 'hard)
+ (point-min)))
+ (when (let ((then (get-text-property (point) 'rcirc-time)))
+ (and then (not (time-less-p time then))))
+ (next-single-property-change (point) 'hard)
+ (forward-char 1)
+ (throw 'exit nil))))
(set-marker-insertion-type rcirc-prompt-start-marker t)
(set-marker-insertion-type rcirc-prompt-end-marker t)
- (let ((start (point)))
- (insert (rcirc-format-response-string process sender response nil
- text)
- (propertize "\n" 'hard t))
-
- ;; squeeze spaces out of text before rcirc-text
- (fill-region fill-start
- (1- (or (next-single-property-change fill-start
- 'rcirc-text)
- rcirc-prompt-end-marker)))
-
- ;; run markup functions
- (save-excursion
- (save-restriction
- (narrow-to-region start rcirc-prompt-start-marker)
- (goto-char (or (next-single-property-change start 'rcirc-text)
+ ;; run markup functions
+ (cl-assert (bolp))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (propertize (rcirc-format-response-string process sender response
+ nil text)
+ 'rcirc-msgid (rcirc-get-tag "msgid"))
+ (propertize "\n" 'hard t))
+
+ ;; squeeze spaces out of text before rcirc-text
+ (fill-region (point-min) (point-max))
+
+ (goto-char (or (next-single-property-change (point-min) 'rcirc-text)
(point)))
(when (rcirc-buffer-process)
(save-excursion (rcirc-markup-timestamp sender response))
@@ -1609,14 +1849,21 @@ record activity."
(when rcirc-read-only-flag
(add-text-properties (point-min) (point-max)
- '(read-only t front-sticky t))))
- ;; make text omittable
+ '(read-only t front-sticky t)))
+
+ (add-text-properties (point-min) (point-max)
+ (list 'rcirc-time time))
+
+ ;; make text omittable
(let ((last-activity-lines (rcirc-elapsed-lines process sender target)))
(if (and (not (string= (rcirc-nick process) sender))
- (member response rcirc-omit-responses)
+ (or (member response rcirc-omit-responses)
+ (if (member response rcirc-omit-after-reconnect)
+ rcirc-reconncting
+ (setq rcirc-reconncting nil)))
(or (not last-activity-lines)
(< rcirc-omit-threshold last-activity-lines)))
- (put-text-property (1- start) (1- rcirc-prompt-start-marker)
+ (put-text-property (point-min) (point-max)
'invisible 'rcirc-omit)
;; otherwise increment the line count
(setq rcirc-current-line (1+ rcirc-current-line))))))
@@ -1638,11 +1885,11 @@ record activity."
(window-buffer w))
(>= (window-point w)
rcirc-prompt-end-marker))
- (set-window-point w (point-max))))
+ (set-window-point w (point-max))))
nil t)
;; restore the point
- (goto-char (if moving rcirc-prompt-end-marker old-point))
+ (goto-char (if moving rcirc-prompt-end-marker old-point)))
;; keep window on bottom line if it was already there
(when rcirc-scroll-show-maximum-output
@@ -1659,28 +1906,29 @@ record activity."
;; flush undo (can we do something smarter here?)
(buffer-disable-undo)
- (buffer-enable-undo))
-
- ;; record mode line activity
- (when (and activity
- (not rcirc-ignore-buffer-activity-flag)
- (not (and rcirc-dim-nicks sender
- (string-match (regexp-opt rcirc-dim-nicks) sender)
- (rcirc-channel-p target))))
- (rcirc-record-activity (current-buffer)
- (when (not (rcirc-channel-p rcirc-target))
- 'nick)))
-
- (when (and rcirc-log-flag
- (or target
- rcirc-log-process-buffers))
- (rcirc-log process sender response target text))
-
- (sit-for 0) ; displayed text before hook
- (run-hook-with-args 'rcirc-print-functions
- process sender response target text)))))
+ (buffer-enable-undo)
+
+ ;; record mode line activity
+ (when (and activity
+ (not rcirc-ignore-buffer-activity-flag)
+ (not (and rcirc-dim-nicks sender
+ (string-match (regexp-opt rcirc-dim-nicks) sender)
+ (rcirc-channel-p target))))
+ (rcirc-record-activity (current-buffer)
+ (when (not (rcirc-channel-p rcirc-target))
+ 'nick)))
+
+ (when (and rcirc-log-flag
+ (or target
+ rcirc-log-process-buffers))
+ (rcirc-log process sender response target text))
+
+ (sit-for 0) ; displayed text before hook
+ (run-hook-with-args 'rcirc-print-functions
+ process sender response target text)))))
(defun rcirc-generate-log-filename (process target)
+ "Return filename for log file based on PROCESS and TARGET."
(if target
(rcirc-generate-new-buffer-name process target)
(process-name process)))
@@ -1702,11 +1950,15 @@ guarantee valid filenames for the current OS."
:type 'function)
(defun rcirc-log (process sender response target text)
- "Record line in `rcirc-log', to be later written to disk."
- (let ((filename (funcall rcirc-log-filename-function process target)))
+ "Record TEXT from SENDER to TARGET to be logged.
+The message is logged in `rcirc-log', and is later written to
+disk. PROCESS is the process object for the current connection."
+ (let ((filename (funcall rcirc-log-filename-function process target))
+ (time (and-let* ((time (rcirc-get-tag "time")))
+ (parse-iso8601-time-string time))))
(unless (null filename)
(let ((cell (assoc-string filename rcirc-log-alist))
- (line (concat (format-time-string rcirc-time-format)
+ (line (concat (format-time-string rcirc-time-format time)
(substring-no-properties
(rcirc-format-response-string process sender
response target text))
@@ -1741,14 +1993,17 @@ log-files with absolute names (see `rcirc-log-filename-function')."
rcirc-log-directory)))
(defun rcirc-join-channels (process channels)
- "Join CHANNELS."
+ "Join CHANNELS.
+PROCESS is the process object for the current connection."
(save-window-excursion
(dolist (channel channels)
(with-rcirc-process-buffer process
(rcirc-cmd-join channel process)))))
;;; nick management
-(defvar rcirc-nick-prefix-chars "~&@%+")
+(defvar rcirc-nick-prefix-chars '(?~ ?& ?@ ?% ?+)
+ "List of junk characters to strip from nick prefixes.")
+
(defun rcirc-user-nick (user)
"Return the nick from USER. Remove any non-nick junk."
(save-match-data
@@ -1758,7 +2013,8 @@ log-files with absolute names (see `rcirc-log-filename-function')."
user)))
(defun rcirc-nick-channels (process nick)
- "Return list of channels for NICK."
+ "Return list of channels for NICK.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(mapcar (lambda (x) (car x))
(gethash nick rcirc-nick-table))))
@@ -1768,7 +2024,7 @@ log-files with absolute names (see `rcirc-log-filename-function')."
Update the associated linestamp if LINE is non-nil.
If the record doesn't exist, and LINE is nil, set the linestamp
-to zero."
+to zero. PROCESS is the process object for the current connection."
(let ((nick (rcirc-user-nick nick)))
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
@@ -1780,12 +2036,14 @@ to zero."
rcirc-nick-table))))))
(defun rcirc-nick-remove (process nick)
- "Remove NICK from table."
+ "Remove NICK from table.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(remhash nick rcirc-nick-table)))
(defun rcirc-remove-nick-channel (process nick channel)
- "Remove the CHANNEL from list associated with NICK."
+ "Remove the CHANNEL from list associated with NICK.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(let* ((chans (gethash nick rcirc-nick-table))
(newchans
@@ -1799,7 +2057,8 @@ to zero."
(remhash nick rcirc-nick-table)))))
(defun rcirc-channel-nicks (process target)
- "Return the list of nicks associated with TARGET sorted by last activity."
+ "Return the list of nicks associated with TARGET sorted by last activity.
+PROCESS is the process object for the current connection."
(when target
(if (rcirc-channel-p target)
(with-rcirc-process-buffer process
@@ -1818,8 +2077,9 @@ to zero."
(list target))))
(defun rcirc-ignore-update-automatic (nick)
- "Remove NICK from `rcirc-ignore-list'
-if NICK is also on `rcirc-ignore-list-automatic'."
+ "Check if NICK is in `rcirc-ignore-list-automatic'.
+If so, remove from `rcirc-ignore-list'. PROCESS is the process
+object for the current connection."
(when (member nick rcirc-ignore-list-automatic)
(setq rcirc-ignore-list-automatic
(delete nick rcirc-ignore-list-automatic)
@@ -1827,7 +2087,7 @@ if NICK is also on `rcirc-ignore-list-automatic'."
(delete nick rcirc-ignore-list))))
(defun rcirc-nickname< (s1 s2)
- "Return t if IRC nickname S1 is less than S2, and nil otherwise.
+ "Return non-nil if IRC nickname S1 is less than S2, and nil otherwise.
Operator nicknames (@) are considered less than voiced
nicknames (+). Any other nicknames are greater than voiced
nicknames. The comparison is case-insensitive."
@@ -1849,7 +2109,7 @@ INPUT is a string containing nicknames separated by SEP.
This function does not alter the INPUT string."
(let* ((parts (split-string input sep t))
(sorted (sort parts 'rcirc-nickname<)))
- (mapconcat 'identity sorted sep)))
+ (mapconcat rcirc-nick-filter sorted sep)))
;;; activity tracking
(defvar rcirc-track-minor-mode-map
@@ -1862,9 +2122,6 @@ This function does not alter the INPUT string."
;;;###autoload
(define-minor-mode rcirc-track-minor-mode
"Global minor mode for tracking activity in rcirc buffers."
- :init-value nil
- :lighter ""
- :keymap rcirc-track-minor-mode-map
:global t
(or global-mode-string (setq global-mode-string '("")))
;; toggle the mode-line channel indicator
@@ -1880,12 +2137,8 @@ This function does not alter the INPUT string."
(remove-hook 'window-configuration-change-hook
'rcirc-window-configuration-change)))
-(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
- (setq minor-mode-alist
- (cons '(rcirc-ignore-buffer-activity-flag " Ignore") minor-mode-alist)))
-(or (assq 'rcirc-low-priority-flag minor-mode-alist)
- (setq minor-mode-alist
- (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist)))
+(add-to-list 'minor-mode-alist '(rcirc-ignore-buffer-activity-flag " Ignore"))
+(add-to-list 'minor-mode-alist '(rcirc-low-priority-flag " LowPri"))
(defun rcirc-toggle-ignore-buffer-activity ()
"Toggle the value of `rcirc-ignore-buffer-activity-flag'."
@@ -1910,9 +2163,7 @@ This function does not alter the INPUT string."
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
(interactive)
- (unless (buffer-live-p rcirc-server-buffer)
- (error "No such buffer"))
- (switch-to-buffer rcirc-server-buffer))
+ (switch-to-buffer (with-rcirc-server-buffer (current-buffer))))
(defun rcirc-jump-to-first-unread-line ()
"Move the point to the first unread line in this buffer."
@@ -1948,7 +2199,8 @@ With prefix ARG, go to the next low priority buffer with activity."
(concat
" Type C-u " (key-description (this-command-keys))
" for low priority activity.")
- "")))))
+ ""))))
+ (rcirc-update-activity-string))
(define-obsolete-variable-alias 'rcirc-activity-hooks
'rcirc-activity-functions "24.3")
@@ -2004,7 +2256,6 @@ activity. Only run if the buffer is not visible and
(defvar rcirc-update-activity-string-hook nil
"Hook run whenever the activity string is updated.")
-;; TODO: add mouse properties
(defun rcirc-update-activity-string ()
"Update mode-line string."
(let* ((pair (rcirc-split-activity rcirc-activity))
@@ -2023,19 +2274,26 @@ activity. Only run if the buffer is not visible and
((not (null (rcirc-process-list)))
"[]")
(t "[]")))
- (run-hooks 'rcirc-update-activity-string-hook)))
+ (run-hooks 'rcirc-update-activity-string-hook)
+ (force-mode-line-update t)))
(defun rcirc-activity-string (buffers)
+ "Generate activity string for all BUFFERS."
(mapconcat (lambda (b)
(let ((s (substring-no-properties (rcirc-short-buffer-name b))))
(with-current-buffer b
(dolist (type rcirc-activity-types)
- (rcirc-add-face 0 (length s)
- (cl-case type
+ (rcirc-facify s (cl-case type
(nick 'rcirc-track-nick)
- (keyword 'rcirc-track-keyword))
- s)))
- s))
+ (keyword 'rcirc-track-keyword)))))
+ (let ((map (make-mode-line-mouse-map
+ 'mouse-1
+ (lambda ()
+ (interactive)
+ (pop-to-buffer b)))))
+ (propertize s
+ 'mouse-face 'mode-line-highlight
+ 'local-map map))))
buffers ","))
(defun rcirc-short-buffer-name (buffer)
@@ -2044,7 +2302,7 @@ activity. Only run if the buffer is not visible and
(or rcirc-short-buffer-name (buffer-name))))
(defun rcirc-visible-buffers ()
- "Return a list of the visible buffers that are in rcirc-mode."
+ "Return a list of the visible buffers that are in `rcirc-mode'."
(let (acc)
(walk-windows (lambda (w)
(with-current-buffer (window-buffer w)
@@ -2052,13 +2310,16 @@ activity. Only run if the buffer is not visible and
(push (current-buffer) acc)))))
acc))
-(defvar rcirc-visible-buffers nil)
+(defvar rcirc-visible-buffers nil
+ "List of visible IRC buffers.")
+
(defun rcirc-window-configuration-change ()
+ "Clear activity and overlay arrows, unless minibuffer is active."
(unless (minibuffer-window-active-p (minibuffer-window))
(rcirc-window-configuration-change-1)))
(defun rcirc-window-configuration-change-1 ()
- ;; clear activity and overlay arrows
+ "Clear activity and overlay arrows."
(let* ((old-activity rcirc-activity)
(hidden-buffers rcirc-visible-buffers))
@@ -2084,6 +2345,7 @@ activity. Only run if the buffer is not visible and
;;; buffer name abbreviation
(defun rcirc-update-short-buffer-names ()
+ "Update variable `rcirc-short-buffer-name' for IRC buffers."
(let ((bufalist
(apply 'append (mapcar (lambda (process)
(with-rcirc-process-buffer process
@@ -2095,10 +2357,15 @@ activity. Only run if the buffer is not visible and
(setq rcirc-short-buffer-name (car i)))))))
(defun rcirc-abbreviate (pairs)
+ "Generate alist of abbreviated buffer names to buffers.
+PAIRS is the concatenated value of all `rcirc-buffer-alist'
+values, from each process."
(apply 'append (mapcar 'rcirc-rebuild-tree (rcirc-make-trees pairs))))
-(defun rcirc-rebuild-tree (tree &optional acc)
- (let ((ch (char-to-string (car tree))))
+(defun rcirc-rebuild-tree (tree)
+ "Merge prefix TREE into alist of unique prefixes to buffers."
+ (let ((ch (char-to-string (car tree)))
+ acc)
(dolist (x (cdr tree))
(if (listp x)
(setq acc (append acc
@@ -2110,6 +2377,12 @@ activity. Only run if the buffer is not visible and
acc))
(defun rcirc-make-trees (pairs)
+ "Generate tree prefix tree of buffer names.
+PAIRS is a list of (TARGET . BUFFER) entries. The resulting tree
+is a list of (CHAR . CHILDREN) cons-cells, where CHAR is the
+leading character and CHILDREN is either BUFFER when a unique
+prefix could be found or another tree if it shares the same
+prefix with another element in PAIRS."
(let (alist)
(mapc (lambda (pair)
(if (consp pair)
@@ -2142,50 +2415,85 @@ activity. Only run if the buffer is not visible and
;; the current buffer/channel/user, and ARGS, which is a string
;; containing the text following the /cmd.
-(defmacro defun-rcirc-command (command argument docstring interactive-form
- &rest body)
- "Define a command."
- `(progn
- (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
- (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
- (,@argument &optional process target)
- ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
- "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
- ,interactive-form
- (let ((process (or process (rcirc-buffer-process)))
- (target (or target rcirc-target)))
- (ignore target) ; mark `target' variable as ignorable
- ,@body))))
-
-(defun-rcirc-command msg (message)
- "Send private MESSAGE to TARGET."
- (interactive "i")
- (if (null message)
- (progn
- (setq target (completing-read "Message nick: "
+(defmacro rcirc-define-command (command arguments &rest body)
+ "Define a new client COMMAND in BODY that takes ARGUMENTS.
+ARGUMENTS may designate optional arguments using a single
+`&optional' symbol. Just like `defun', a string at the beginning
+of BODY is interpreted as the documentation string. Following
+that, an interactive form can specified."
+ (declare (debug (symbolp (&rest symbolp) def-body))
+ (indent defun))
+ (cl-check-type command symbol)
+ (cl-check-type arguments list)
+ (let* ((fn-name (intern (concat "rcirc-cmd-" (symbol-name command))))
+ (total (length (remq '&optional arguments)))
+ (required (- (length arguments) (length (memq '&optional arguments))))
+ (optional (- total required))
+ (regexp (with-temp-buffer
+ (insert "\\`")
+ (when arguments
+ (dotimes (_ (1- (length arguments)))
+ (insert "\\(?:\\(.+?\\)[[:space:]]+"))
+ (dotimes (i (1- (length arguments)))
+ (if (< i optional)
+ (insert "\\)?")
+ (insert "\\)"))))
+ (insert "\\(.*?\\)")
+ (insert "[[:space:]]*\\'")
+ (buffer-string)))
+ (argument (gensym))
+ documentation
+ interactive-spec)
+ (when (stringp (car body))
+ (setq documentation (pop body)))
+ (when (eq (car-safe (car-safe body)) 'interactive)
+ (setq interactive-spec (cdr (pop body))))
+ `(progn
+ (defun ,fn-name (,argument &optional process target)
+ ,(concat documentation
+ "\n\nNote: If PROCESS or TARGET are nil, the values given"
+ "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
+ (interactive (list ,@interactive-spec))
+ (unless (if (listp ,argument)
+ (<= ,required (length ,argument) ,total)
+ (string-match ,regexp ,argument))
+ (user-error "Malformed input (%s): %S" ',command ',argument))
+ (let ((process (or process (rcirc-buffer-process)))
+ (target (or target rcirc-target)))
+ (ignore target process)
+ (let (,@(cl-loop
+ for i from 0 for arg in (delq '&optional arguments)
+ collect `(,arg (if (listp ,argument)
+ (nth ,i ,argument)
+ (match-string ,(1+ i) ,argument)))))
+ ,@body)))
+ (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))))))
+
+(define-obsolete-function-alias
+ 'defun-rcirc-command
+ 'rcirc-define-command
+ "28.1")
+
+(rcirc-define-command msg (chan-or-nick message)
+ "Send MESSAGE to CHAN-OR-NICK."
+ (interactive (list (completing-read "Message nick: "
(with-rcirc-server-buffer
- rcirc-nick-table)))
- (when (> (length target) 0)
- (setq message (read-string (format "Message %s: " target)))
- (when (> (length message) 0)
- (rcirc-send-message process target message))))
- (if (not (string-match "\\([^ ]+\\) \\(.+\\)" message))
- (message "Not enough args, or something.")
- (setq target (match-string 1 message)
- message (match-string 2 message))
- (rcirc-send-message process target message))))
-
-(defun-rcirc-command query (nick)
+ rcirc-nick-table))
+ (read-string "Message: ")))
+ (rcirc-send-message process chan-or-nick message))
+
+(rcirc-define-command query (nick)
"Open a private chat buffer to NICK."
(interactive (list (completing-read "Query nick: "
- (with-rcirc-server-buffer rcirc-nick-table))))
+ (with-rcirc-server-buffer
+ rcirc-nick-table))))
(let ((existing-buffer (rcirc-get-buffer process nick)))
(switch-to-buffer (or existing-buffer
(rcirc-get-buffer-create process nick)))
(when (not existing-buffer)
(rcirc-cmd-whois nick))))
-(defun-rcirc-command join (channels)
+(rcirc-define-command join (channels)
"Join CHANNELS.
CHANNELS is a comma- or space-separated string of channel names."
(interactive "sJoin channels: ")
@@ -2194,46 +2502,35 @@ CHANNELS is a comma- or space-separated string of channel names."
(rcirc-get-buffer-create process ch))
split-channels))
(channels (mapconcat 'identity split-channels ",")))
- (rcirc-send-string process (concat "JOIN " channels))
+ (rcirc-send-string process "JOIN" channels)
(when (not (eq (selected-window) (minibuffer-window)))
(dolist (b buffers) ;; order the new channel buffers in the buffer list
(switch-to-buffer b)))))
-(defun-rcirc-command invite (nick-channel)
+(rcirc-define-command invite (nick channel)
"Invite NICK to CHANNEL."
(interactive (list
- (concat
- (completing-read "Invite nick: "
- (with-rcirc-server-buffer rcirc-nick-table))
- " "
- (read-string "Channel: "))))
- (rcirc-send-string process (concat "INVITE " nick-channel)))
-
-(defun-rcirc-command part (channel)
+ (completing-read "Invite nick: "
+ (with-rcirc-server-buffer rcirc-nick-table))
+ (read-string "Channel: ")))
+ (rcirc-send-string process "INVITE" nick channel))
+
+(rcirc-define-command part (&optional channel reason)
"Part CHANNEL.
CHANNEL should be a string of the form \"#CHANNEL-NAME REASON\".
If omitted, CHANNEL-NAME defaults to TARGET, and REASON defaults
to `rcirc-default-part-reason'."
- (interactive "sPart channel: ")
- (let ((channel (if (> (length channel) 0) channel target))
- (msg rcirc-default-part-reason))
- (when (string-match "\\`\\([&#+!]\\S-+\\)?\\s-*\\(.+\\)?\\'" channel)
- (when (match-beginning 2)
- (setq msg (match-string 2 channel)))
- (setq channel (if (match-beginning 1)
- (match-string 1 channel)
- target)))
- (rcirc-send-string process (concat "PART " channel " :" msg))))
-
-(defun-rcirc-command quit (reason)
+ (interactive "sPart channel: \nsReason: ")
+ (rcirc-send-string process "PART" (or channel target)
+ : (or reason rcirc-default-part-reason)))
+
+(rcirc-define-command quit (&optional reason)
"Send a quit message to server with REASON."
(interactive "sQuit reason: ")
- (rcirc-send-string process (concat "QUIT :"
- (if (not (zerop (length reason)))
- reason
- rcirc-default-quit-reason))))
+ (rcirc-send-string process "QUIT"
+ : (or reason rcirc-default-quit-reason)))
-(defun-rcirc-command reconnect (_)
+(rcirc-define-command reconnect ()
"Reconnect to current server."
(interactive "i")
(with-rcirc-server-buffer
@@ -2244,79 +2541,73 @@ to `rcirc-default-part-reason'."
(setf (nth 5 conn-info)
(cl-remove-if-not #'rcirc-channel-p
(mapcar #'car rcirc-buffer-alist)))
+ (dolist (buf (nth 5 conn-info))
+ (with-current-buffer (cdr (assoc buf rcirc-buffer-alist))
+ (setq rcirc-reconncting t)))
(apply #'rcirc-connect conn-info))))))
-(defun-rcirc-command nick (nick)
+(rcirc-define-command nick (nick)
"Change nick to NICK."
- (interactive "i")
- (when (null nick)
- (setq nick (read-string "New nick: " (rcirc-nick process))))
- (rcirc-send-string process (concat "NICK " nick)))
+ (interactive (list (read-string "New nick: ")))
+ (rcirc-send-string process "NICK" nick))
-(defun-rcirc-command names (channel)
+(rcirc-define-command names (&optional channel)
"Display list of names in CHANNEL or in current channel if CHANNEL is nil.
If called interactively, prompt for a channel when prefix arg is supplied."
- (interactive "P")
- (if (called-interactively-p 'interactive)
- (if channel
- (setq channel (read-string "List names in channel: " target))))
- (let ((channel (if (> (length channel) 0)
- channel
- target)))
- (rcirc-send-string process (concat "NAMES " channel))))
-
-(defun-rcirc-command topic (topic)
+ (interactive (list (and current-prefix-arg
+ (read-string "List names in channel: "))))
+ (rcirc-send-string process "NAMES" (or channel target)))
+
+(rcirc-define-command topic (topic)
"List TOPIC for the TARGET channel.
With a prefix arg, prompt for new topic."
- (interactive "P")
- (if (and (called-interactively-p 'interactive) topic)
- (setq topic (read-string "New Topic: " rcirc-topic)))
- (rcirc-send-string process (concat "TOPIC " target
- (when (> (length topic) 0)
- (concat " :" topic)))))
+ (interactive (list (and current-prefix-arg
+ (read-string "List names in channel: "))))
+ (if (> (length topic) 0)
+ (rcirc-send-string process "TOPIC" : topic)
+ (rcirc-send-string process "TOPIC")))
-(defun-rcirc-command whois (nick)
+(rcirc-define-command whois (nick)
"Request information from server about NICK."
- (interactive (list
- (completing-read "Whois: "
- (with-rcirc-server-buffer rcirc-nick-table))))
- (rcirc-send-string process (concat "WHOIS " nick)))
-
-(defun-rcirc-command mode (args)
- "Set mode with ARGS."
- (interactive (list (concat (read-string "Mode nick or channel: ")
- " " (read-string "Mode: "))))
- (rcirc-send-string process (concat "MODE " args)))
-
-(defun-rcirc-command list (channels)
+ (interactive (list (completing-read
+ "Whois: "
+ (with-rcirc-server-buffer rcirc-nick-table))))
+ (rcirc-send-string process "WHOIS" nick))
+
+(rcirc-define-command mode (nick-or-chan mode)
+ "Set NICK-OR-CHAN mode to MODE."
+ (interactive (list (read-string "Mode nick or channel: ")
+ (read-string "Mode: ")))
+ (rcirc-send-string process "MODE" nick-or-chan mode))
+
+(rcirc-define-command list (channels)
"Request information on CHANNELS from server."
(interactive "sList Channels: ")
- (rcirc-send-string process (concat "LIST " channels)))
+ (rcirc-send-string process "LIST" channels))
-(defun-rcirc-command oper (args)
+(rcirc-define-command oper (args)
"Send operator command to server."
(interactive "sOper args: ")
- (rcirc-send-string process (concat "OPER " args)))
+ (rcirc-send-string process "OPER" args))
-(defun-rcirc-command quote (message)
+(rcirc-define-command quote (message)
"Send MESSAGE literally to server."
(interactive "sServer message: ")
(rcirc-send-string process message))
-(defun-rcirc-command kick (arg)
+(rcirc-define-command kick (nick reason)
"Kick NICK from current channel."
(interactive (list
- (concat (completing-read "Kick nick: "
- (rcirc-channel-nicks
- (rcirc-buffer-process)
- rcirc-target))
- (read-from-minibuffer "Kick reason: "))))
- (let* ((arglist (split-string arg))
- (argstring (concat (car arglist) " :"
- (mapconcat 'identity (cdr arglist) " "))))
- (rcirc-send-string process (concat "KICK " target " " argstring))))
+ (completing-read "Kick nick: "
+ (rcirc-channel-nicks
+ (rcirc-buffer-process)
+ rcirc-target))
+ (read-from-minibuffer "Kick reason: ")))
+ (rcirc-send-string process "KICK" target nick : reason))
(defun rcirc-cmd-ctcp (args &optional process _target)
+ "Handle ARGS as a CTCP command.
+PROCESS is the process object for the current connection."
(if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
(let* ((target (match-string 1 args))
(request (upcase (match-string 2 args)))
@@ -2328,14 +2619,18 @@ With a prefix arg, prompt for new topic."
"usage: /ctcp NICK REQUEST")))
(defun rcirc-ctcp-sender-PING (process target _request)
- "Send a CTCP PING message to TARGET."
+ "Send a CTCP PING message to TARGET.
+PROCESS is the process object for the current connection."
(let ((timestamp (format-time-string "%s")))
(rcirc-send-ctcp process target "PING" timestamp)))
(defun rcirc-cmd-me (args process target)
+ "Send an action message ARGS to TARGET.
+PROCESS is the process object for the current connection."
(when target (rcirc-send-ctcp process target "ACTION" args)))
(defun rcirc-add-or-remove (set &rest elements)
+ "Toggle membership of ELEMENTS in SET."
(dolist (elt elements)
(if (and elt (not (string= "" elt)))
(setq set (if (member-ignore-case elt set)
@@ -2343,7 +2638,8 @@ With a prefix arg, prompt for new topic."
(cons elt set)))))
set)
-(defun-rcirc-command ignore (nick)
+
+(rcirc-define-command ignore (nick)
"Manage the ignore list.
Ignore NICK, unignore NICK if already ignored, or list ignored
nicks when no NICK is given. When listing ignored nicks, the
@@ -2360,7 +2656,7 @@ ones added to the list automatically are marked with an asterisk."
"*" "")))
rcirc-ignore-list " ")))
-(defun-rcirc-command bright (nick)
+(rcirc-define-command bright (nick)
"Manage the bright nick list."
(interactive "sToggle emphasis of nick: ")
(setq rcirc-bright-nicks
@@ -2369,7 +2665,7 @@ ones added to the list automatically are marked with an asterisk."
(rcirc-print process nil "BRIGHT" target
(mapconcat 'identity rcirc-bright-nicks " ")))
-(defun-rcirc-command dim (nick)
+(rcirc-define-command dim (nick)
"Manage the dim nick list."
(interactive "sToggle deemphasis of nick: ")
(setq rcirc-dim-nicks
@@ -2378,7 +2674,7 @@ ones added to the list automatically are marked with an asterisk."
(rcirc-print process nil "DIM" target
(mapconcat 'identity rcirc-dim-nicks " ")))
-(defun-rcirc-command keyword (keyword)
+(rcirc-define-command keyword (keyword)
"Manage the keyword list.
Mark KEYWORD, unmark KEYWORD if already marked, or list marked
keywords when no KEYWORD is given."
@@ -2453,28 +2749,85 @@ If ARG is given, opens the URL in a new browser window."
arg)))
(defun rcirc-markup-timestamp (_sender _response)
+ "Insert a timestamp."
(goto-char (point-min))
- (insert (rcirc-facify (format-time-string rcirc-time-format)
- 'rcirc-timestamp)))
+ (let ((time (and-let* ((time (rcirc-get-tag "time")))
+ (parse-iso8601-time-string time))))
+ (insert (rcirc-facify (format-time-string rcirc-time-format time)
+ 'rcirc-timestamp))))
(defun rcirc-markup-attributes (_sender _response)
- (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
+ "Highlight IRC markup, indicated by ASCII control codes."
+ (while (re-search-forward
+ (rx (group (or #x02 #x1d #x1f #x1e #x11))
+ (*? nonl)
+ (group (or (backref 1) (+ #x0f) eol)))
+ nil t)
(rcirc-add-face (match-beginning 0) (match-end 0)
- (cl-case (char-after (match-beginning 1))
- (?\C-b 'bold)
- (?\C-v 'italic)
- (?\C-_ 'underline)))
- ;; keep the ^O since it could terminate other attributes
- (when (not (eq ?\C-o (char-before (match-end 2))))
- (delete-region (match-beginning 2) (match-end 2)))
- (delete-region (match-beginning 1) (match-end 1))
- (goto-char (match-beginning 1)))
- ;; remove the ^O characters now
- (goto-char (point-min))
- (while (re-search-forward "\C-o+" nil t)
+ (cl-case (char-after (match-beginning 0))
+ (#x02 'bold)
+ (#x1d 'italic)
+ (#x1f 'underline)
+ (#x1e '(:strike-through t))
+ (#x11 'rcirc-monospace-text)))
+ (goto-char (1+ (match-beginning 0)))))
+
+(defconst rcirc-color-codes
+ ;; Taken from https://modern.ircdocs.horse/formatting.html
+ ["white" "black" "blue" "green" "red" "brown" "magenta"
+ "orange" "yellow" "light green" "cyan" "light cyan"
+ "light blue" "pink" "grey" "light grey"
+ "#470000" "#472100" "#474700" "#324700" "#004700" "#00472c"
+ "#004747" "#002747" "#000047" "#2e0047" "#470047" "#47002a"
+ "#740000" "#743a00" "#747400" "#517400" "#007400" "#007449"
+ "#007474" "#004074" "#000074" "#4b0074" "#740074" "#740045"
+ "#b50000" "#b56300" "#b5b500" "#7db500" "#00b500" "#00b571"
+ "#00b5b5" "#0063b5" "#0000b5" "#7500b5" "#b500b5" "#b5006b"
+ "#ff0000" "#ff8c00" "#ffff00" "#b2ff00" "#00ff00" "#00ffa0"
+ "#00ffff" "#008cff" "#0000ff" "#a500ff" "#ff00ff" "#ff0098"
+ "#ff5959" "#ffb459" "#ffff71" "#cfff60" "#6fff6f" "#65ffc9"
+ "#6dffff" "#59b4ff" "#5959ff" "#c459ff" "#ff66ff" "#ff59bc"
+ "#ff9c9c" "#ffd39c" "#ffff9c" "#e2ff9c" "#9cff9c" "#9cffdb"
+ "#9cffff" "#9cd3ff" "#9c9cff" "#dc9cff" "#ff9cff" "#ff94d3"
+ "#000000" "#131313" "#282828" "#363636" "#4d4d4d" "#656565"
+ "#818181" "#9f9f9f" "#bcbcbc" "#e2e2e2" "#ffffff"]
+ "Vector of colors for each IRC color code.")
+
+(defun rcirc-color-attributes (_sender _response)
+ "Highlight IRC color-codes, indicated by ASCII control codes."
+ (while (re-search-forward
+ (rx #x03
+ (? (group (= 2 digit)) (? "," (group (= 2 digit))))
+ (*? nonl)
+ (or #x03 #x0f eol))
+ nil t)
+ (let (foreground background)
+ (when-let ((fg-raw (match-string 1))
+ (fg (string-to-number fg-raw))
+ ((<= 0 fg (1- (length rcirc-color-codes)))))
+ (setq foreground (aref rcirc-color-codes fg)))
+ (when-let ((bg-raw (match-string 2))
+ (bg (string-to-number bg-raw))
+ ((<= 0 bg (1- (length rcirc-color-codes)))))
+ (setq background (aref rcirc-color-codes bg)))
+ (rcirc-add-face (match-beginning 0) (match-end 0)
+ `(face (:foreground
+ ,foreground
+ :background
+ ,background))))))
+
+(defun rcirc-remove-markup-codes (_sender _response)
+ "Remove ASCII control codes used to designate markup."
+ (while (re-search-forward
+ (rx (or #x02 #x1d #x1f #x1e #x11 #x0f
+ (: #x03 (? (= 2 digit) (? "," (= 2 digit))))))
+ nil t)
(delete-region (match-beginning 0) (match-end 0))))
(defun rcirc-markup-my-nick (_sender response)
+ "Highlight the users nick.
+If RESPONSE indicates that the nick was mentioned in a message,
+highlight the entire line and record the activity."
(with-syntax-table rcirc-nick-syntax-table
(while (re-search-forward (concat "\\b"
(regexp-quote (rcirc-nick
@@ -2489,6 +2842,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-record-activity (current-buffer) 'nick)))))
(defun rcirc-markup-urls (_sender _response)
+ "Highlight and activate URLs."
(while (and rcirc-url-regexp ; nil means disable URL catching.
(re-search-forward rcirc-url-regexp nil t))
(let* ((start (match-beginning 0))
@@ -2505,12 +2859,17 @@ If ARG is given, opens the URL in a new browser window."
'follow-link t
'rcirc-url url
'action (lambda (button)
- (browse-url (button-get button 'rcirc-url))))
+ (browse-url-button-open-url
+ (button-get button 'rcirc-url))))
;; Record the URL if it is not already the latest stored URL.
(unless (string= url (caar rcirc-urls))
(push (cons url start) rcirc-urls)))))
(defun rcirc-markup-keywords (sender response)
+ "Highlight keywords as specified by `rcirc-keywords'.
+Keywords are only highlighted in messages (as indicated by
+RESPONSE) when they were not written by the user (as indicated by
+SENDER)."
(when (and (string= response "PRIVMSG")
(not (string= sender (rcirc-nick (rcirc-buffer-process)))))
(let* ((target (or rcirc-target ""))
@@ -2525,6 +2884,9 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-record-activity (current-buffer) 'keyword))))))
(defun rcirc-markup-bright-nicks (_sender response)
+ "Highlight nicks brightly as specified by `rcirc-bright-nicks'.
+This highlighting only takes place in name lists (as indicated by
+RESPONSE)."
(when (and rcirc-bright-nicks
(string= response "NAMES"))
(with-syntax-table rcirc-nick-syntax-table
@@ -2533,6 +2895,8 @@ If ARG is given, opens the URL in a new browser window."
'rcirc-bright-nick)))))
(defun rcirc-markup-fill (_sender response)
+ "Fill messages as configured by `rcirc-fill-column'.
+MOTD messages are not filled (as indicated by RESPONSE)."
(when (not (string= response "372")) ; /motd
(let ((fill-prefix
(or rcirc-fill-prefix
@@ -2550,8 +2914,11 @@ If ARG is given, opens the URL in a new browser window."
;; server or a user, depending on the command, the ARGS, which is a
;; list of strings, and the TEXT, which is the original server text,
;; verbatim
-(defun rcirc-handler-001 (process sender args text)
- (rcirc-handler-generic process "001" sender args text)
+(defun rcirc-handler-001 (process sender args _text)
+ "Handle welcome message.
+SENDER and ARGS are used to initialize the current connection.
+PROCESS is the process object for the current connection."
+ (rcirc-handler-generic process "001" sender args nil)
(with-rcirc-process-buffer process
(setq rcirc-connecting nil)
(rcirc-reschedule-timeout process)
@@ -2575,11 +2942,16 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-join-channels process rcirc-startup-channels))))
(defun rcirc-join-channels-post-auth (process)
- "Join `rcirc-startup-channels' after authenticating."
+ "Join `rcirc-startup-channels' after authenticating.
+PROCESS is the process object for the current connection."
(with-rcirc-process-buffer process
(rcirc-join-channels process rcirc-startup-channels)))
(defun rcirc-handler-PRIVMSG (process sender args text)
+ "Handle a (private) message from SENDER.
+ARGS should have the form (TARGET MESSAGE). TEXT is the verbatim
+message as received from the server. PROCESS is the process
+object for the current connection."
(rcirc-check-auth-status process sender args text)
(let ((target (if (rcirc-channel-p (car args))
(car args)
@@ -2593,6 +2965,10 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-put-nick-channel process sender target rcirc-current-line))))
(defun rcirc-handler-NOTICE (process sender args text)
+ "Handle a notice message from SENDER.
+ARGS should have the form (TARGET MESSAGE).
+TEXT is the verbatim message as received from the server.
+PROCESS is the process object for the current connection."
(rcirc-check-auth-status process sender args text)
(let ((target (car args))
(message (cadr args)))
@@ -2602,7 +2978,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-print process sender "NOTICE"
(cond ((rcirc-channel-p target)
target)
- ;;; -ChanServ- [#gnu] Welcome...
+ ;; -ChanServ- [#gnu] Welcome...
((string-match "\\[\\(#[^] ]+\\)\\]" message)
(match-string 1 message))
(sender
@@ -2614,7 +2990,9 @@ If ARG is given, opens the URL in a new browser window."
(defun rcirc-check-auth-status (process sender args _text)
"Check if the user just authenticated.
If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
-the only argument."
+the only argument. ARGS should have the form (TARGET MESSAGE).
+SENDER is used the determine the authentication method. PROCESS
+is the process object for the current connection."
(with-rcirc-process-buffer process
(when (and (not rcirc-user-authenticated)
rcirc-authenticate-before-join
@@ -2644,9 +3022,17 @@ the only argument."
(remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t))))))
(defun rcirc-handler-WALLOPS (process sender args _text)
+ "Handle WALLOPS message from SENDER.
+ARGS should have the form (MESSAGE).
+PROCESS is the process object for the current
+connection."
(rcirc-print process sender "WALLOPS" sender (car args) t))
(defun rcirc-handler-JOIN (process sender args _text)
+ "Handle JOIN message from SENDER.
+ARGS should have the form (CHANNEL).
+PROCESS is the process object for the current
+connection."
(let ((channel (car args)))
(with-current-buffer (rcirc-get-buffer-create process channel)
;; when recently rejoining, restore the linestamp
@@ -2668,6 +3054,8 @@ the only argument."
;; PART and KICK are handled the same way
(defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args)
+ "Remove NICK from CHANNEL.
+PROCESS is the process object for the current connection."
(rcirc-ignore-update-automatic nick)
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
@@ -2685,6 +3073,9 @@ the only argument."
(rcirc-disconnect-buffer buffer)))))
(defun rcirc-handler-PART (process sender args _text)
+ "Handle PART message from SENDER.
+ARGS should have the form (CHANNEL REASON).
+PROCESS is the process object for the current connection."
(let* ((channel (car args))
(reason (cadr args))
(message (concat channel " " reason)))
@@ -2696,6 +3087,9 @@ the only argument."
(rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
(defun rcirc-handler-KICK (process sender args _text)
+ "Handle PART message from SENDER.
+ARGS should have the form (CHANNEL NICK REASON).
+PROCESS is the process object for the current connection."
(let* ((channel (car args))
(nick (cadr args))
(reason (nth 2 args))
@@ -2708,7 +3102,8 @@ the only argument."
(rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
(defun rcirc-maybe-remember-nick-quit (process nick channel)
- "Remember NICK as leaving CHANNEL if they recently spoke."
+ "Remember NICK as leaving CHANNEL if they recently spoke.
+PROCESS is the process object for the current connection."
(let ((elapsed-lines (rcirc-elapsed-lines process nick channel)))
(when (and elapsed-lines
(< elapsed-lines rcirc-omit-threshold))
@@ -2724,6 +3119,8 @@ the only argument."
rcirc-recent-quit-alist))))))))))
(defun rcirc-handler-QUIT (process sender args _text)
+ "Handle QUIT message from SENDER.
+PROCESS is the process object for the current connection."
(rcirc-ignore-update-automatic sender)
(mapc (lambda (channel)
;; broadcast quit message each channel
@@ -2734,6 +3131,9 @@ the only argument."
(rcirc-nick-remove process sender))
(defun rcirc-handler-NICK (process sender args _text)
+ "Handle NICK message from SENDER.
+ARGS should have the form (NEW-NICK).
+PROCESS is the process object for the current connection."
(let* ((old-nick sender)
(new-nick (car args))
(channels (rcirc-nick-channels process old-nick)))
@@ -2765,21 +3165,30 @@ the only argument."
(when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
(defun rcirc-handler-PING (process _sender args _text)
- (rcirc-send-string process (concat "PONG :" (car args))))
+ "Respond to a PING with a PONG.
+ARGS should have the form (MESSAGE). MESSAGE is relayed back to
+the server. PROCESS is the process object for the current
+connection."
+ (rcirc-send-string process "PONG" : (car args)))
(defun rcirc-handler-PONG (_process _sender _args _text)
- ;; do nothing
- )
+ "Ignore all incoming PONG messages.")
(defun rcirc-handler-TOPIC (process sender args _text)
+ "Note the topic change from SENDER.
+PROCESS is the process object for the current connection."
(let ((topic (cadr args)))
(rcirc-print process sender "TOPIC" (car args) topic)
(with-current-buffer (rcirc-get-buffer process (car args))
(setq rcirc-topic topic))))
-(defvar rcirc-nick-away-alist nil)
+(defvar rcirc-nick-away-alist nil
+ "Alist from nicks to away messages.")
+
(defun rcirc-handler-301 (process _sender args text)
- "RPL_AWAY"
+ "Handle away messages (RPL_AWAY).
+ARGS should have the form (NICK AWAY-MESSAGE).
+PROCESS is the process object for the current connection."
(let* ((nick (cadr args))
(rec (assoc-string nick rcirc-nick-away-alist))
(away-message (nth 2 args)))
@@ -2793,7 +3202,9 @@ the only argument."
rcirc-nick-away-alist))))))
(defun rcirc-handler-317 (process sender args _text)
- "RPL_WHOISIDLE"
+ "Handle idle messages from SENDER (RPL_WHOISIDLE).
+ARGS should have the form (NICK IDLE-SECS SIGNON-TIME).
+PROCESS is the process object for the current connection."
(let* ((nick (nth 1 args))
(idle-secs (string-to-number (nth 2 args)))
(idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs))
@@ -2804,15 +3215,20 @@ the only argument."
(rcirc-print process sender "317" nil message t)))
(defun rcirc-handler-332 (process _sender args _text)
- "RPL_TOPIC"
+ "Update topic when notified by server (RPL_TOPIC).
+ARGS should have the form (CHANNEL TOPIC).
+PROCESS is the process object for the current connection."
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
(setq rcirc-topic (nth 2 args)))))
(defun rcirc-handler-333 (process sender args _text)
- "333 says who set the topic and when.
-Not in rfc1459.txt"
+ "Update when and who set the current topic.
+ARGS has the form (CHANNEL SETTER TIME). SENDER is passed on to
+`rcirc-print'. PROCESS is the process object for the current
+connection. This is a non-standard extension, not specified in
+RFC1459."
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
@@ -2823,10 +3239,17 @@ Not in rfc1459.txt"
(format "%s (%s on %s)" rcirc-topic setter time))))))
(defun rcirc-handler-477 (process sender args _text)
- "ERR_NOCHANMODES"
+ "Notify user that CHANNEL does not support modes (ERR_NOCHANMODES).
+ARGS has the form (CHANNEL MESSAGE). SENDER is passed on to
+`rcirc-print'. PROCESS is the process object for the current
+connection."
(rcirc-print process sender "477" (cadr args) (nth 2 args)))
(defun rcirc-handler-MODE (process sender args _text)
+ "Handle MODE messages.
+ARGS should have the form (TARGET . MESSAGE-LIST).
+SENDER is passed on to `rcirc-print'.
+PROCESS is the process object for the current connection."
(let ((target (car args))
(msg (mapconcat 'identity (cdr args) " ")))
(rcirc-print process sender "MODE"
@@ -2847,7 +3270,9 @@ Not in rfc1459.txt"
(get-buffer-create tmpnam)))
(defun rcirc-handler-353 (process _sender args _text)
- "RPL_NAMREPLY"
+ "Start handling list of users (RPL_NAMREPLY).
+ARGS should have the form (TYPE CHANNEL . NICK-LIST).
+PROCESS is the process object for the current connection."
(let ((channel (nth 2 args))
(names (or (nth 3 args) "")))
(mapc (lambda (nick)
@@ -2860,7 +3285,9 @@ Not in rfc1459.txt"
(insert (car (last args)) " "))))
(defun rcirc-handler-366 (process sender args _text)
- "RPL_ENDOFNAMES"
+ "Handle end of user list (RPL_ENDOFNAMES).
+SENDER is passed on to `rcirc-print'.
+PROCESS is the process object for the current connection."
(let* ((channel (cadr args))
(buffer (rcirc-get-temp-buffer-create process channel)))
(with-current-buffer buffer
@@ -2870,7 +3297,10 @@ Not in rfc1459.txt"
(kill-buffer buffer)))
(defun rcirc-handler-433 (process sender args text)
- "ERR_NICKNAMEINUSE"
+ "Warn user that nick is used (ERR_NICKNAMEINUSE).
+ARGS should have the form (NICK CHANNEL WARNING).
+SENDER is passed on to `rcirc-handler-generic'.
+PROCESS is the process object for the current connection."
(rcirc-handler-generic process "433" sender args text)
(with-rcirc-process-buffer process
(let* ((length (string-to-number
@@ -2879,8 +3309,10 @@ Not in rfc1459.txt"
(rcirc-cmd-nick (rcirc--make-new-nick (cadr args) length) nil process))))
(defun rcirc--make-new-nick (nick length)
- ;; If we already have some ` chars at the end, then shorten the
- ;; non-` bit of the name.
+ "Attempt to create a unused nickname out of NICK.
+A new nick may at most be LENGTH characters long. If we already
+have some ` chars at the end, then shorten the non-` bit of the
+name."
(when (= (length nick) length)
(setq nick (replace-regexp-in-string "[^`]\\(`+\\)\\'" "\\1" nick)))
(concat
@@ -2890,7 +3322,14 @@ Not in rfc1459.txt"
"`"))
(defun rcirc-handler-005 (process sender args text)
- "ERR_NICKNAMEINUSE"
+ "Register supported server features (RPL_ISUPPORT).
+ARGS should be a list of string feature parameters, either of the
+form \"PARAMETER\" to enable a feature, \"PARAMETER=VALUE\" to
+configure a specific option or \"-PARAMETER\" to disable a
+previously specified feature. SENDER is passed on to
+`rcirc-handler-generic'. PROCESS is the process object for the
+current connection. Note that this is not the behaviour as
+specified in RFC2812, where 005 stood for RPL_BOUNCE."
(rcirc-handler-generic process "005" sender args text)
(with-rcirc-process-buffer process
(setq rcirc-server-parameters (append rcirc-server-parameters args))))
@@ -2925,7 +3364,8 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(rcirc-send-privmsg
process
"&bitlbee"
- (concat "IDENTIFY " (car args)))))
+ (concat "IDENTIFY " (car args))))
+ (sasl nil))
;; quakenet authentication doesn't rely on the user's nickname.
;; the variable `nick' here represents the Q account name.
(when (eq method 'quakenet)
@@ -2935,12 +3375,37 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(format "AUTH %s %s" nick (car args))))))))))
(defun rcirc-handler-INVITE (process sender args _text)
- (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
+ "Notify user of an invitation from SENDER.
+ARGS should have the form (TARGET CHANNEL). PROCESS is the
+process object for the current connection."
+ (let ((self (buffer-local-value 'rcirc-nick rcirc-process))
+ (target (car args))
+ (chan (cadr args)))
+ (if (string= target self)
+ (rcirc-print process sender "INVITE" nil
+ (format "%s invited you to %s"
+ sender chan)
+ t)
+ (rcirc-print process sender "INVITE" chan
+ (format "%s invited %s"
+ sender target)
+ t))))
(defun rcirc-handler-ERROR (process sender args _text)
+ "Print a error message.
+SENDER and ARGS (in concatenated form) are passed on to
+`rcirc-print'. PROCESS is the process object for the current
+connection."
(rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
(defun rcirc-handler-CTCP (process target sender text)
+ "Handle Client-To-Client-Protocol message TEXT.
+The message is addressed from SENDER to TARGET. Attempt to find
+an appropriate handler, by invoicing the function
+`rcirc-handler-ctcp-REQUEST', where REQUEST is the message type
+as extracted from TEXT. If no handler was found, an error
+message will be printed. PROCESS is the process object for the
+current connection."
(if (string-match "^\\([^ ]+\\) *\\(.*\\)$" text)
(let* ((request (upcase (match-string 1 text)))
(args (match-string 2 text))
@@ -2955,28 +3420,128 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(rcirc-print process sender "CTCP" target
(format "%s" text) t))))))
-(defun rcirc-handler-ctcp-VERSION (process _target sender _args)
- (rcirc-send-string process
- (concat "NOTICE " sender
- " :\C-aVERSION " rcirc-id-string
- "\C-a")))
+(defun rcirc-handler-ctcp-VERSION (process _target sender _message)
+ "Handle a CTCP VERSION message from SENDER.
+PROCESS is the process object for the current connection."
+ (rcirc-send-string process "NOTICE" sender :
+ (rcirc-ctcp-wrap "VERSION" rcirc-id-string)))
-(defun rcirc-handler-ctcp-ACTION (process target sender args)
- (rcirc-print process sender "ACTION" target args t))
+(defun rcirc-handler-ctcp-ACTION (process target sender message)
+ "Handle a CTCP ACTION MESSAGE from SENDER to TARGET.
+PROCESS is the process object for the current connection."
+ (rcirc-print process sender "ACTION" target message t))
-(defun rcirc-handler-ctcp-TIME (process _target sender _args)
- (rcirc-send-string process
- (concat "NOTICE " sender
- " :\C-aTIME " (current-time-string) "\C-a")))
+(defun rcirc-handler-ctcp-TIME (process _target sender _message)
+ "Respond to CTCP TIME message from SENDER.
+PROCESS is the process object for the current connection."
+ (rcirc-send-string process "NOTICE" sender :
+ (rcirc-ctcp-wrap "TIME" (current-time-string))))
(defun rcirc-handler-CTCP-response (process _target sender message)
+ "Handle CTCP response MESSAGE from SENDER.
+PROCESS is the process object for the current connection."
(rcirc-print process sender "CTCP" nil message t))
+
+
+(defun rcirc-handler-CAP (process _sender args _text)
+ "Handle capability negotiation messages.
+ARGS should have the form (USER SUBCOMMAND . ARGUMENTS). PROCESS
+is the process object for the current connection."
+ (with-rcirc-process-buffer process
+ (let ((subcmd (cadr args)))
+ (dolist (cap (cddr args))
+ (cond ((string= subcmd "ACK")
+ (push cap rcirc-acked-capabilities)
+ (setq rcirc-requested-capabilities
+ (delete cap rcirc-requested-capabilities)))
+ ((string= subcmd "NAK")
+ (setq rcirc-requested-capabilities
+ (delete cap rcirc-requested-capabilities))))))
+ (when (and (null rcirc-requested-capabilities) rcirc-finished-sasl)
+ ;; All requested capabilities have been responded to
+ (rcirc-send-string process "CAP" "END"))))
+
+(defun rcirc-handler-TAGMSG (process sender _args _text)
+ "Handle a empty tag message from SENDER.
+PROCESS is the process object for the current connection."
+ (dolist (tag rcirc-message-tags)
+ (when-let ((handler (intern-soft (concat "rcirc-tag-handler-" (car tag))))
+ ((fboundp handler)))
+ (funcall handler process sender (cdr tag)))))
+
+(defun rcirc-handler-BATCH (process _sender args _text)
+ "Open or close a batch.
+ARGS should have the form (tag type . parameters) when starting a
+batch, or (tag) when closing a batch. PROCESS is the process
+object for the current connection."
+ (with-rcirc-process-buffer process
+ (let ((type (cadr args))
+ (id (substring (car args) 1)))
+ (cond
+ ((= (aref (car args) 0) ?+) ;start a new batch
+ (when (assoc id rcirc-batch-attributes)
+ (error "Starting batch with already used ID"))
+ (setf (alist-get id rcirc-batch-attributes nil nil #'string=)
+ (cons type (cddr args))))
+ ((= (aref (car args) 0) ?-) ;close a batch
+ (unless (assoc id rcirc-batch-attributes)
+ (error "Closing a unknown batch"))
+ (let ((type (car (alist-get id rcirc-batch-attributes
+ nil nil #'string=))))
+ (when (eq (car (alist-get type rcirc-supported-batch-types
+ nil nil #'string=))
+ 'deferred)
+ (let ((messages (alist-get id rcirc-batched-messages
+ nil nil #'string=))
+ (bhandler (intern-soft (concat "rcirc-batch-handler-" type))))
+ (if (fboundp bhandler)
+ (funcall bhandler process id (nreverse messages))
+ (dolist (message (nreverse messages))
+ (let ((cmd (nth 0 message))
+ (process (nth 1 message))
+ (sender (nth 2 message))
+ (args (nth 3 message))
+ (text (nth 4 message))
+ (rcirc-message-tags (nth 5 message)))
+ (if-let (handler (intern-soft (concat "rcirc-handler-" cmd)))
+ (funcall handler process sender args text)
+ (rcirc-handler-generic process cmd sender args text))))))))
+ (setq rcirc-batch-attributes
+ (delq (assoc id rcirc-batch-attributes)
+ rcirc-batch-attributes)
+ rcirc-batched-messages
+ (delq (assoc id rcirc-batched-messages)
+ rcirc-batched-messages)))))))
+
+(defun rcirc-handler-AUTHENTICATE (process _cmd _args _text)
+ "Respond to authentication request.
+PROCESS is the process object for the current connection."
+ (rcirc-send-string
+ process
+ "AUTHENTICATE"
+ (base64-encode-string
+ ;; use connection user-name
+ (concat "\0" (nth 3 rcirc-connection-info)
+ "\0" (rcirc-get-server-password rcirc-server)))))
+
+(defun rcirc-handler-900 (process sender args _text)
+ "Respond to a successful authentication response."
+ (rcirc-handler-generic process "900" sender args nil)
+ (when (not rcirc-finished-sasl)
+ (setq-local rcirc-finished-sasl t)
+ (rcirc-send-string process "CAP" "END"))
+ (rcirc-join-channels-post-auth process))
+
(defgroup rcirc-faces nil
"Faces for rcirc."
:group 'rcirc
:group 'faces)
+(defface rcirc-monospace-text
+ '((t :family "Monospace"))
+ "Face used for monospace text in messages.")
+
(defface rcirc-my-nick ; font-lock-function-name-face
'((((class color) (min-colors 88) (background light)) :foreground "Blue1")
(((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue")
@@ -3086,11 +3651,12 @@ Passwords are stored in `rcirc-authinfo' (which see)."
;; When using M-x flyspell-mode, only check words after the prompt
(put 'rcirc-mode 'flyspell-mode-predicate 'rcirc-looking-at-input)
(defun rcirc-looking-at-input ()
- "Return true if point is past the input marker."
+ "Return non-nil if point is past the input marker."
(>= (point) rcirc-prompt-end-marker))
(defun rcirc-server-parameter-value (parameter)
+ "Traverse `rcirc-server-parameters' for PARAMETER."
(cl-loop for elem in rcirc-server-parameters
for setting = (split-string elem "=")
when (and (= (length setting) 2)
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index ad271679618..4102b9d322a 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -643,7 +643,7 @@ starting with a colon. Example:
The object labels of the found items are returned as list."
(mapcar
(lambda (item-path) (secrets-get-item-property item-path "Label"))
- (apply 'secrets-search-item-paths collection attributes)))
+ (apply #'secrets-search-item-paths collection attributes)))
(defun secrets-create-item (collection item password &rest attributes)
"Create a new item in COLLECTION with label ITEM and password PASSWORD.
@@ -780,9 +780,9 @@ ITEM can also be an object path, which is used if contained in COLLECTION."
(defvar secrets-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (make-composed-keymap special-mode-map widget-keymap))
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "z" 'kill-current-buffer)
+ (define-key map "n" #'next-line)
+ (define-key map "p" #'previous-line)
+ (define-key map "z" #'kill-current-buffer)
map)
"Keymap used in `secrets-mode' buffers.")
@@ -859,7 +859,7 @@ to their attributes."
;; padding is needed to format attribute names.
(padding
(apply
- 'max
+ #'max
(cons
(1+ (length "password"))
(mapcar
@@ -957,3 +957,5 @@ to their attributes."
;; * Check, whether the dh-ietf1024-aes128-cbc-pkcs7 algorithm can be
;; used for the transfer of the secrets. Currently, we use the
;; plain algorithm.
+
+;;; secrets.el ends here
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index ac1f701fd37..eb78a259a8c 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -36,14 +36,12 @@
(defcustom shr-color-visible-luminance-min 40
"Minimum luminance distance between two colors to be considered visible.
Must be between 0 and 100."
- :group 'shr-color
:type 'number)
(defcustom shr-color-visible-distance-min 5
"Minimum color distance between two colors to be considered visible.
This value is used to compare result for `ciede2000'. It's an
absolute value without any unit."
- :group 'shr-color
:type 'integer)
(defconst shr-color-html-colors-alist
@@ -332,8 +330,8 @@ color will be adapted to be visible on BG."
(if (or (null fg-norm)
(null bg-norm))
(list bg fg)
- (let* ((fg-lab (apply 'color-srgb-to-lab fg-norm))
- (bg-lab (apply 'color-srgb-to-lab bg-norm))
+ (let* ((fg-lab (apply #'color-srgb-to-lab fg-norm))
+ (bg-lab (apply #'color-srgb-to-lab bg-norm))
;; Compute color distance using CIE DE 2000
(fg-bg-distance (color-cie-de2000 fg-lab bg-lab))
;; Compute luminance distance (subtract L component)
@@ -351,12 +349,12 @@ color will be adapted to be visible on BG."
(list
(if fixed-background
bg
- (apply 'format "#%02x%02x%02x"
+ (apply #'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
- (apply 'color-lab-to-srgb bg-lab))))
- (apply 'format "#%02x%02x%02x"
+ (apply #'color-lab-to-srgb bg-lab))))
+ (apply #'format "#%02x%02x%02x"
(mapcar (lambda (x) (* (max (min 1 x) 0) 255))
- (apply 'color-lab-to-srgb fg-lab))))))))))
+ (apply #'color-lab-to-srgb fg-lab))))))))))
(provide 'shr-color)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 9c3740fccc9..85d81b6bbcc 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -183,8 +183,37 @@ temporarily blinks with this face."
"Face for <abbr> elements."
:version "27.1")
-(defvar shr-inhibit-images nil
- "If non-nil, inhibit loading images.")
+(defface shr-h1
+ '((t :height 1.3 :weight bold))
+ "Face for <h1> elements."
+ :version "28.1")
+
+(defface shr-h2
+ '((t :weight bold))
+ "Face for <h2> elements."
+ :version "28.1")
+
+(defface shr-h3
+ '((t :slant italic))
+ "Face for <h3> elements."
+ :version "28.1")
+
+(defface shr-h4 nil
+ "Face for <h4> elements."
+ :version "28.1")
+
+(defface shr-h5 nil
+ "Face for <h5> elements."
+ :version "28.1")
+
+(defface shr-h6 nil
+ "Face for <h6> elements."
+ :version "28.1")
+
+(defcustom shr-inhibit-images nil
+ "If non-nil, inhibit loading images."
+ :version "28.1"
+ :type 'boolean)
(defvar shr-external-rendering-functions nil
"Alist of tag/function pairs used to alter how shr renders certain tags.
@@ -220,20 +249,20 @@ and other things:
(defvar shr-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'shr-show-alt-text)
- (define-key map "i" 'shr-browse-image)
- (define-key map "z" 'shr-zoom-image)
- (define-key map [?\t] 'shr-next-link)
- (define-key map [?\M-\t] 'shr-previous-link)
+ (define-key map "a" #'shr-show-alt-text)
+ (define-key map "i" #'shr-browse-image)
+ (define-key map "z" #'shr-zoom-image)
+ (define-key map [?\t] #'shr-next-link)
+ (define-key map [?\M-\t] #'shr-previous-link)
(define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'shr-browse-url)
- (define-key map [C-down-mouse-1] 'shr-mouse-browse-url-new-window)
- (define-key map "I" 'shr-insert-image)
- (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)
+ (define-key map [mouse-2] #'shr-browse-url)
+ (define-key map [C-down-mouse-1] #'shr-mouse-browse-url-new-window)
+ (define-key map "I" #'shr-insert-image)
+ (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)
map))
(defvar shr-image-map
@@ -313,6 +342,12 @@ DOM should be a parse tree as generated by
(* (frame-char-width) 2))
1))))
(max-specpdl-size max-specpdl-size)
+ ;; `bidi-display-reordering' is supposed to be only used for
+ ;; debugging purposes, but Shr's naïve filling algorithm
+ ;; cannot cope with the complexity of RTL text in an LTR
+ ;; paragraph, when a long line has been continued, and for
+ ;; most scripts the character metrics don't change when they
+ ;; are reordered, so... this is the best we could do :-(
bidi-display-reordering)
;; Adjust for max width specification.
(when (and shr-max-width
@@ -434,6 +469,7 @@ Value is a pair of positions (START . END) if there is a non-nil
(defun shr-show-alt-text ()
"Show the ALT text of the image under point."
+ (declare (completion (lambda (_ b) (command-completion-button-p 'shr b))))
(interactive)
(let ((text (get-text-property (point) 'shr-alt)))
(if (not text)
@@ -1248,20 +1284,20 @@ Return a string with image data."
CONTENT-FUNCTION is a function to retrieve an image for a cid url that
is an argument. The function to be returned takes three arguments URL,
START, and END. Note that START and END should be markers."
- `(lambda (url start end)
- (when url
- (if (string-match "\\`cid:" url)
- ,(when content-function
- `(let ((image (funcall ,content-function
- (substring url (match-end 0)))))
- (when image
- (goto-char start)
- (funcall shr-put-image-function
- image (buffer-substring start end))
- (delete-region (point) end))))
- (url-retrieve url #'shr-image-fetched
- (list (current-buffer) start end)
- t t)))))
+ (lambda (url start end)
+ (when url
+ (if (string-match "\\`cid:" url)
+ (when content-function
+ (let ((image (funcall content-function
+ (substring url (match-end 0)))))
+ (when image
+ (goto-char start)
+ (funcall shr-put-image-function
+ image (buffer-substring start end))
+ (delete-region (point) end))))
+ (url-retrieve url #'shr-image-fetched
+ (list (current-buffer) start end)
+ t t)))))
(defun shr-heading (dom &rest types)
(shr-ensure-paragraph)
@@ -1930,24 +1966,22 @@ BASE is the URL of the HTML being rendered."
(shr-generic dom))
(defun shr-tag-h1 (dom)
- (shr-heading dom (if shr-use-fonts
- '(variable-pitch (:height 1.3 :weight bold))
- 'bold)))
+ (shr-heading dom 'shr-h1))
(defun shr-tag-h2 (dom)
- (shr-heading dom 'bold))
+ (shr-heading dom 'shr-h2))
(defun shr-tag-h3 (dom)
- (shr-heading dom 'italic))
+ (shr-heading dom 'shr-h3))
(defun shr-tag-h4 (dom)
- (shr-heading dom))
+ (shr-heading dom 'shr-h4))
(defun shr-tag-h5 (dom)
- (shr-heading dom))
+ (shr-heading dom 'shr-h5))
(defun shr-tag-h6 (dom)
- (shr-heading dom))
+ (shr-heading dom 'shr-h6))
(defun shr-tag-hr (_dom)
(shr-ensure-newline)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index c4d6ec4b6cc..1f08a15e570 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -89,18 +89,15 @@
(defcustom sieve-manage-log "*sieve-manage-log*"
"Name of buffer for managesieve session trace."
- :type 'string
- :group 'sieve-manage)
+ :type 'string)
(defcustom sieve-manage-server-eol "\r\n"
"The EOL string sent from the server."
- :type 'string
- :group 'sieve-manage)
+ :type 'string)
(defcustom sieve-manage-client-eol "\r\n"
"The EOL string we send to the server."
- :type 'string
- :group 'sieve-manage)
+ :type 'string)
(defcustom sieve-manage-authenticators '(digest-md5
cram-md5
@@ -112,8 +109,7 @@
;; FIXME Improve this. It's not `set'.
;; It's like (repeat (choice (const ...))), where each choice can
;; only appear once.
- :type '(repeat symbol)
- :group 'sieve-manage)
+ :type '(repeat symbol))
(defcustom sieve-manage-authenticator-alist
'((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth)
@@ -130,26 +126,22 @@ NAME names the authenticator. CHECK is a function returning non-nil if
the server support the authenticator and AUTHENTICATE is a function
for doing the actual authentication."
:type '(repeat (list (symbol :tag "Name") (function :tag "Check function")
- (function :tag "Authentication function")))
- :group 'sieve-manage)
+ (function :tag "Authentication function"))))
(defcustom sieve-manage-default-port "sieve"
"Default port number or service name for managesieve protocol."
:type '(choice integer string)
- :version "24.4"
- :group 'sieve-manage)
+ :version "24.4")
(defcustom sieve-manage-default-stream 'network
"Default stream type to use for `sieve-manage'."
:version "24.1"
- :type 'symbol
- :group 'sieve-manage)
+ :type 'symbol)
(defcustom sieve-manage-ignore-starttls nil
"Ignore STARTTLS even if STARTTLS capability is provided."
:version "26.1"
- :type 'boolean
- :group 'sieve-manage)
+ :type 'boolean)
;; Internal variables:
@@ -247,7 +239,7 @@ Return the buffer associated with the connection."
(sasl-read-passphrase
;; We *need* to copy the password, because sasl will modify it
;; somehow.
- `(lambda (prompt) ,(copy-sequence user-password)))
+ (lambda (_prompt) (copy-sequence user-password)))
(step (sasl-next-step client nil))
(_tag (sieve-manage-send
(concat
@@ -580,4 +572,4 @@ to local variable `sieve-manage-capability'."
(provide 'sieve-manage)
-;; sieve-manage.el ends here
+;;; sieve-manage.el ends here
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index 7bc1d16122d..0e8fdc0a905 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -139,9 +139,9 @@
(defvar sieve-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-l" 'sieve-upload)
- (define-key map "\C-c\C-c" 'sieve-upload-and-kill)
- (define-key map "\C-c\C-m" 'sieve-manage)
+ (define-key map "\C-c\C-l" #'sieve-upload)
+ (define-key map "\C-c\C-c" #'sieve-upload-and-kill)
+ (define-key map "\C-c\C-m" #'sieve-manage)
map)
"Key map used in sieve mode.")
@@ -206,4 +206,4 @@ Turning on Sieve mode runs `sieve-mode-hook'."
(provide 'sieve-mode)
-;; sieve-mode.el ends here
+;;; sieve-mode.el ends here
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index ca100267f67..6d571a0a30f 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -1,4 +1,4 @@
-;;; sieve.el --- Utilities to manage sieve scripts
+;;; sieve.el --- Utilities to manage sieve scripts -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -69,13 +69,11 @@
(defcustom sieve-new-script "<new script>"
"Name of name script indicator."
- :type 'string
- :group 'sieve)
+ :type 'string)
(defcustom sieve-buffer "*sieve*"
"Name of sieve management buffer."
- :type 'string
- :group 'sieve)
+ :type 'string)
(defcustom sieve-template "\
require \"fileinto\";
@@ -91,8 +89,7 @@ require \"fileinto\";
# }
"
"Template sieve script."
- :type 'string
- :group 'sieve)
+ :type 'string)
;; Internal variables:
@@ -104,31 +101,36 @@ require \"fileinto\";
;; Sieve-manage mode:
+;; This function is defined by `easy-menu-define' but it's only done
+;; at run time and the compiler is not aware of it.
+;; FIXME: This is arguably a bug/problem in `easy-menu-define'.
+(declare-function sieve-manage-mode-menu "sieve")
+
(defvar sieve-manage-mode-map
(let ((map (make-sparse-keymap)))
;; various
- (define-key map "?" 'sieve-help)
- (define-key map "h" 'sieve-help)
+ (define-key map "?" #'sieve-help)
+ (define-key map "h" #'sieve-help)
;; activating
- (define-key map "m" 'sieve-activate)
- (define-key map "u" 'sieve-deactivate)
- (define-key map "\M-\C-?" 'sieve-deactivate-all)
+ (define-key map "m" #'sieve-activate)
+ (define-key map "u" #'sieve-deactivate)
+ (define-key map "\M-\C-?" #'sieve-deactivate-all)
;; navigation keys
- (define-key map "\C-p" 'sieve-prev-line)
- (define-key map [up] 'sieve-prev-line)
- (define-key map "\C-n" 'sieve-next-line)
- (define-key map [down] 'sieve-next-line)
- (define-key map " " 'sieve-next-line)
- (define-key map "n" 'sieve-next-line)
- (define-key map "p" 'sieve-prev-line)
- (define-key map "\C-m" 'sieve-edit-script)
- (define-key map "f" 'sieve-edit-script)
- (define-key map "o" 'sieve-edit-script-other-window)
- (define-key map "r" 'sieve-remove)
- (define-key map "q" 'sieve-bury-buffer)
- (define-key map "Q" 'sieve-manage-quit)
- (define-key map [(down-mouse-2)] 'sieve-edit-script)
- (define-key map [(down-mouse-3)] 'sieve-manage-mode-menu)
+ (define-key map "\C-p" #'sieve-prev-line)
+ (define-key map [up] #'sieve-prev-line)
+ (define-key map "\C-n" #'sieve-next-line)
+ (define-key map [down] #'sieve-next-line)
+ (define-key map " " #'sieve-next-line)
+ (define-key map "n" #'sieve-next-line)
+ (define-key map "p" #'sieve-prev-line)
+ (define-key map "\C-m" #'sieve-edit-script)
+ (define-key map "f" #'sieve-edit-script)
+ ;; (define-key map "o" #'sieve-edit-script-other-window)
+ (define-key map "r" #'sieve-remove)
+ (define-key map "q" #'sieve-bury-buffer)
+ (define-key map "Q" #'sieve-manage-quit)
+ (define-key map [(down-mouse-2)] #'sieve-edit-script)
+ (define-key map [(down-mouse-3)] #'sieve-manage-mode-menu)
map)
"Keymap for `sieve-manage-mode'.")
@@ -159,8 +161,8 @@ require \"fileinto\";
(interactive)
(bury-buffer))
-(defun sieve-activate (&optional pos)
- (interactive "d")
+(defun sieve-activate (&optional _pos)
+ (interactive)
(let ((name (sieve-script-at-point)) err)
(when (or (null name) (string-equal name sieve-new-script))
(error "No sieve script at point"))
@@ -171,20 +173,20 @@ require \"fileinto\";
(message "Activating script %s...done" name)
(message "Activating script %s...failed: %s" name (nth 2 err)))))
-(defun sieve-deactivate-all (&optional pos)
- (interactive "d")
- (let ((name (sieve-script-at-point)) err)
- (message "Deactivating scripts...")
- (setq err (sieve-manage-setactive "" sieve-manage-buffer))
+(defun sieve-deactivate-all (&optional _pos)
+ (interactive)
+ (message "Deactivating scripts...")
+ (let (;; (name (sieve-script-at-point))
+ (err (sieve-manage-setactive "" sieve-manage-buffer)))
(sieve-refresh-scriptlist)
(if (sieve-manage-ok-p err)
(message "Deactivating scripts...done")
(message "Deactivating scripts...failed: %s" (nth 2 err)))))
-(defalias 'sieve-deactivate 'sieve-deactivate-all)
+(defalias 'sieve-deactivate #'sieve-deactivate-all)
-(defun sieve-remove (&optional pos)
- (interactive "d")
+(defun sieve-remove (&optional _pos)
+ (interactive)
(let ((name (sieve-script-at-point)) err)
(when (or (null name) (string-equal name sieve-new-script))
(error "No sieve script at point"))
@@ -195,8 +197,8 @@ require \"fileinto\";
(sieve-refresh-scriptlist)
(message "Removing sieve script %s...done" name)))
-(defun sieve-edit-script (&optional pos)
- (interactive "d")
+(defun sieve-edit-script (&optional _pos)
+ (interactive)
(let ((name (sieve-script-at-point)))
(unless name
(error "No sieve script at point"))
@@ -224,11 +226,11 @@ require \"fileinto\";
(defmacro sieve-change-region (&rest body)
"Turns off sieve-region before executing BODY, then re-enables it after.
Used to bracket operations which move point in the sieve-buffer."
+ (declare (indent 0) (debug t))
`(progn
(sieve-highlight nil)
,@body
(sieve-highlight t)))
-(put 'sieve-change-region 'lisp-indent-function 0)
(defun sieve-next-line (&optional arg)
(interactive)
@@ -377,4 +379,4 @@ Used to bracket operations which move point in the sieve-buffer."
(provide 'sieve)
-;; sieve.el ends here
+;;; sieve.el ends here
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index 983e6d92ee0..ae878ef3a51 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -1,4 +1,4 @@
-;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode
+;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode -*- lexical-binding: t -*-
;; Copyright (C) 1995, 1998, 2001-2021 Free Software Foundation, Inc.
@@ -69,16 +69,6 @@
;; Once the template is done, you can use C-cC-f and C-cC-b to move back
;; and forth between the Tempo sequence points to fill in the rest of
;; the information.
-;;
-;; Font Lock
-;; ------------
-;;
-;; If you want font-lock in your MIB buffers, add this:
-;;
-;; (add-hook 'snmp-common-mode-hook 'turn-on-font-lock)
-;;
-;; Enabling global-font-lock-mode is also sufficient.
-;;
;;; Code:
@@ -101,42 +91,35 @@
(defcustom snmp-special-indent t
"If non-nil, use a simple heuristic to try to guess the right indentation.
If nil, then no special indentation is attempted."
- :type 'boolean
- :group 'snmp)
+ :type 'boolean)
(defcustom snmp-indent-level 4
"Indentation level for SNMP MIBs."
- :type 'integer
- :group 'snmp)
+ :type 'integer)
(defcustom snmp-tab-always-indent nil
"Non-nil means TAB should always reindent the current line.
A value of nil means reindent if point is within the initial line indentation;
otherwise insert a TAB."
- :type 'boolean
- :group 'snmp)
+ :type 'boolean)
(defcustom snmp-completion-ignore-case t
"Non-nil means that case differences are ignored during completion.
A value of nil means that case is significant.
This is used during Tempo template completion."
- :type 'boolean
- :group 'snmp)
+ :type 'boolean)
(defcustom snmp-common-mode-hook nil
"Hook(s) evaluated when a buffer enters either SNMP or SNMPv2 mode."
- :type 'hook
- :group 'snmp)
+ :type 'hook)
(defcustom snmp-mode-hook nil
"Hook(s) evaluated when a buffer enters SNMP mode."
- :type 'hook
- :group 'snmp)
+ :type 'hook)
(defcustom snmpv2-mode-hook nil
"Hook(s) evaluated when a buffer enters SNMPv2 mode."
- :type 'hook
- :group 'snmp)
+ :type 'hook)
(defvar snmp-tempo-tags nil
"Tempo tags for SNMP mode.")
@@ -291,7 +274,7 @@ This is used during Tempo template completion."
;; Set up the stuff that's common between snmp-mode and snmpv2-mode
;;
-(defun snmp-common-mode (name mode abbrev font-keywords imenu-index tempo-tags)
+(defun snmp-common-mode (name mode abbrev font-keywords imenu-index mode-tempo-tags)
(kill-all-local-variables)
;; Become the current major mode
@@ -326,7 +309,7 @@ This is used during Tempo template completion."
(setq-local imenu-create-index-function imenu-index)
;; Tempo
- (tempo-use-tag-list tempo-tags)
+ (tempo-use-tag-list mode-tempo-tags)
(setq-local tempo-match-finder "\\b\\(.+\\)\\=")
(setq-local tempo-interactive t)
@@ -338,6 +321,7 @@ This is used during Tempo template completion."
;;
;;;###autoload
(defun snmp-mode ()
+ ;; FIXME: Use define-derived-mode.
"Major mode for editing SNMP MIBs.
Expression and list commands understand all C brackets.
Tab indents for C code.
@@ -370,6 +354,7 @@ Turning on snmp-mode runs the hooks in `snmp-common-mode-hook', then
;;;###autoload
(defun snmpv2-mode ()
+ ;; FIXME: Use define-derived-mode.
"Major mode for editing SNMPv2 MIBs.
Expression and list commands understand all C brackets.
Tab indents for C code.
@@ -474,13 +459,11 @@ lines for the purposes of this function."
(index-table-alist '())
(index-trap-alist '())
(case-fold-search nil) ; keywords must be uppercase
- prev-pos token end)
+ token end)
(goto-char (point-min))
- (imenu-progress-message prev-pos 0)
;; Search for a useful MIB item (that's not in a comment)
(save-match-data
(while (re-search-forward snmp-clause-regexp nil t)
- (imenu-progress-message prev-pos)
(setq
end (match-end 0)
token (cons (match-string 1)
@@ -498,7 +481,6 @@ lines for the purposes of this function."
(push token index-tc-alist)))
(goto-char end)))
;; Create the menu
- (imenu-progress-message prev-pos 100)
(setq index-alist (nreverse index-alist))
(and index-tc-alist
(push (cons "Textual Conventions" (nreverse index-tc-alist))
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 3cc5569b55c..de1cd9d320f 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -10,6 +10,7 @@
;; Package: soap-client
;; Homepage: https://github.com/alex-hhh/emacs-soap-client
;; Package-Requires: ((cl-lib "0.6.1"))
+;;FIXME: Put in `Package-Requires:' the Emacs version we expect.
;; This file is part of GNU Emacs.
@@ -658,7 +659,7 @@ representing leap seconds."
(if second
(if second-fraction
(let* ((second-fraction-significand
- (replace-regexp-in-string "\\." "" second-fraction))
+ (string-replace "." "" second-fraction))
(hertz
(expt 10 (length second-fraction-significand)))
(ticks (+ (* hertz (string-to-number second))
@@ -771,6 +772,8 @@ This is a specialization of `soap-decode-type' for
(Array (soap-decode-array node))))))
(defalias 'soap-type-of
+ ;; FIXME: Once we drop support for Emacs<25, use generic functions
+ ;; via `cl-defmethod' instead of our own ad-hoc version of it.
(if (eq 'soap-xs-basic-type (type-of (make-soap-xs-basic-type)))
;; `type-of' in Emacs ≥ 26 already does what we need.
#'type-of
@@ -1263,7 +1266,7 @@ See also `soap-wsdl-resolve-references'."
(soap-l2wk (xml-node-name node)))
(setf (soap-xs-simple-type-base type)
- (mapcar 'soap-l2fq
+ (mapcar #'soap-l2fq
(split-string
(or (xml-get-attribute-or-nil node 'memberTypes) ""))))
@@ -1343,7 +1346,7 @@ See also `soap-wsdl-resolve-references'."
(soap-validate-xs-basic-type value base))))
(error (push (cadr error-object) messages))))
(when messages
- (error (mapconcat 'identity (nreverse messages) "; and: "))))
+ (error (mapconcat #'identity (nreverse messages) "; and: "))))
(cl-labels ((fail-with-message (format value)
(push (format format value) messages)
(throw 'invalid nil)))
@@ -1935,7 +1938,7 @@ This is a specialization of `soap-decode-type' for
(e-name (soap-xs-element-name element))
;; Heuristic: guess if we need to decode using local
;; namespaces.
- (use-fq-names (string-match ":" (symbol-name (car node))))
+ (use-fq-names (string-search ":" (symbol-name (car node))))
(children (if e-name
(if use-fq-names
;; Find relevant children
@@ -2345,8 +2348,8 @@ See also `soap-resolve-references' and
(when (= (length (soap-operation-parameter-order operation)) 0)
(setf (soap-operation-parameter-order operation)
- (mapcar 'car (soap-message-parts
- (cdr (soap-operation-input operation))))))
+ (mapcar #'car (soap-message-parts
+ (cdr (soap-operation-input operation))))))
(setf (soap-operation-parameter-order operation)
(mapcar (lambda (p)
@@ -2391,13 +2394,13 @@ See also `soap-wsdl-resolve-references'."
;; Install resolvers for our types
(progn
(put (soap-type-of (make-soap-message)) 'soap-resolve-references
- 'soap-resolve-references-for-message)
+ #'soap-resolve-references-for-message)
(put (soap-type-of (make-soap-operation)) 'soap-resolve-references
- 'soap-resolve-references-for-operation)
+ #'soap-resolve-references-for-operation)
(put (soap-type-of (make-soap-binding)) 'soap-resolve-references
- 'soap-resolve-references-for-binding)
+ #'soap-resolve-references-for-binding)
(put (soap-type-of (make-soap-port)) 'soap-resolve-references
- 'soap-resolve-references-for-port))
+ #'soap-resolve-references-for-port))
(defun soap-wsdl-resolve-references (wsdl)
"Resolve all references inside the WSDL structure.
@@ -2511,7 +2514,7 @@ Build on WSDL if it is provided."
(soap-wsdl-resolve-references (soap-parse-wsdl xml wsdl))
wsdl))
-(defalias 'soap-load-wsdl-from-url 'soap-load-wsdl)
+(defalias 'soap-load-wsdl-from-url #'soap-load-wsdl)
(defun soap-parse-wsdl-phase-validate-node (node)
"Assert that NODE is valid."
@@ -2884,7 +2887,7 @@ decode function to perform the actual decoding."
(if (fboundp 'define-error)
(define-error 'soap-error "SOAP error")
- ;; Support older Emacs versions that do not have define-error, so
+ ;; Support Emacs<24.4 that do not have define-error, so
;; that soap-client can remain unchanged in GNU ELPA.
(put 'soap-error
'error-conditions
@@ -3123,8 +3126,7 @@ http://schemas.xmlsoap.org/soap/encoding/\"\n"))
(defcustom soap-debug nil
"When t, enable some debugging facilities."
- :type 'boolean
- :group 'soap-client)
+ :type 'boolean)
(defun soap-find-port (wsdl service)
"Return the WSDL port having SERVICE name.
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 9d4e440719d..6f9ce6a2d69 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -109,7 +109,7 @@ soap-xs-attribute objects."
This is a specialization of `soap-sample-value' for
`soap-xs-simple-type' objects."
(append
- (mapcar 'soap-sample-value-for-xs-attribute
+ (mapcar #'soap-sample-value-for-xs-attribute
(soap-xs-type-attributes type))
(cond
((soap-xs-simple-type-enumeration type)
@@ -143,7 +143,7 @@ This is a specialization of `soap-sample-value' for
This is a specialization of `soap-sample-value' for
`soap-xs-complex-type' objects."
(append
- (mapcar 'soap-sample-value-for-xs-attribute
+ (mapcar #'soap-sample-value-for-xs-attribute
(soap-xs-type-attributes type))
(cl-case (soap-xs-complex-type-indicator type)
(array
@@ -176,31 +176,31 @@ This is a specialization of `soap-sample-value' for
;; Install soap-sample-value methods for our types
(put (soap-type-of (make-soap-xs-basic-type))
'soap-sample-value
- 'soap-sample-value-for-xs-basic-type)
+ #'soap-sample-value-for-xs-basic-type)
(put (soap-type-of (make-soap-xs-element))
'soap-sample-value
- 'soap-sample-value-for-xs-element)
+ #'soap-sample-value-for-xs-element)
(put (soap-type-of (make-soap-xs-attribute))
'soap-sample-value
- 'soap-sample-value-for-xs-attribute)
+ #'soap-sample-value-for-xs-attribute)
(put (soap-type-of (make-soap-xs-attribute))
'soap-sample-value
- 'soap-sample-value-for-xs-attribute-group)
+ #'soap-sample-value-for-xs-attribute-group)
(put (soap-type-of (make-soap-xs-simple-type))
'soap-sample-value
- 'soap-sample-value-for-xs-simple-type)
+ #'soap-sample-value-for-xs-simple-type)
(put (soap-type-of (make-soap-xs-complex-type))
'soap-sample-value
- 'soap-sample-value-for-xs-complex-type)
+ #'soap-sample-value-for-xs-complex-type)
(put (soap-type-of (make-soap-message))
'soap-sample-value
- 'soap-sample-value-for-message))
+ #'soap-sample-value-for-message))
@@ -437,7 +437,7 @@ TYPE is a `soap-xs-complex-type'."
(funcall (list 'soap-invoke '*WSDL* "SomeService"
(soap-element-name operation))))
(let ((sample-invocation
- (append funcall (mapcar 'cdr sample-message-value))))
+ (append funcall (mapcar #'cdr sample-message-value))))
(pp sample-invocation (current-buffer)))))
(defun soap-inspect-port-type (port-type)
@@ -460,7 +460,7 @@ TYPE is a `soap-xs-complex-type'."
collect o))
op-name-width)
- (setq operations (sort operations 'string<))
+ (setq operations (sort operations #'string<))
(setq op-name-width (cl-loop for o in operations maximizing (length o)))
@@ -504,39 +504,39 @@ TYPE is a `soap-xs-complex-type'."
;; Install the soap-inspect methods for our types
(put (soap-type-of (make-soap-xs-basic-type)) 'soap-inspect
- 'soap-inspect-xs-basic-type)
+ #'soap-inspect-xs-basic-type)
(put (soap-type-of (make-soap-xs-element)) 'soap-inspect
- 'soap-inspect-xs-element)
+ #'soap-inspect-xs-element)
(put (soap-type-of (make-soap-xs-simple-type)) 'soap-inspect
- 'soap-inspect-xs-simple-type)
+ #'soap-inspect-xs-simple-type)
(put (soap-type-of (make-soap-xs-complex-type)) 'soap-inspect
- 'soap-inspect-xs-complex-type)
+ #'soap-inspect-xs-complex-type)
(put (soap-type-of (make-soap-xs-attribute)) 'soap-inspect
- 'soap-inspect-xs-attribute)
+ #'soap-inspect-xs-attribute)
(put (soap-type-of (make-soap-xs-attribute-group)) 'soap-inspect
- 'soap-inspect-xs-attribute-group)
+ #'soap-inspect-xs-attribute-group)
(put (soap-type-of (make-soap-message)) 'soap-inspect
- 'soap-inspect-message)
+ #'soap-inspect-message)
(put (soap-type-of (make-soap-operation)) 'soap-inspect
- 'soap-inspect-operation)
+ #'soap-inspect-operation)
(put (soap-type-of (make-soap-port-type)) 'soap-inspect
- 'soap-inspect-port-type)
+ #'soap-inspect-port-type)
(put (soap-type-of (make-soap-binding)) 'soap-inspect
- 'soap-inspect-binding)
+ #'soap-inspect-binding)
(put (soap-type-of (make-soap-port)) 'soap-inspect
- 'soap-inspect-port)
+ #'soap-inspect-port)
(put (soap-type-of (soap-make-wsdl "origin")) 'soap-inspect
- 'soap-inspect-wsdl))
+ #'soap-inspect-wsdl))
(provide 'soap-inspect)
;;; soap-inspect.el ends here
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 96fafc826b8..78a261fd83e 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -277,7 +277,7 @@
(setq version (process-get proc 'socks-server-protocol))
(cond
((equal version 'http)
- (if (not (string-match "\r\n\r\n" string))
+ (if (not (string-search "\r\n\r\n" string))
nil ; Need to spin some more
(process-put proc 'socks-state socks-state-connected)
(process-put proc 'socks-reply 0)
@@ -390,6 +390,8 @@
proc)))
(defun socks-send-command (proc command atype address port)
+ "Send COMMAND to SOCKS service PROC for proxying ADDRESS and PORT.
+When ATYPE indicates an IP, param ADDRESS must be given as raw bytes."
(let ((addr (cond
((or (= atype socks-address-type-v4)
(= atype socks-address-type-v6))
@@ -528,7 +530,7 @@
(setq host (socks-nslookup-host host))
(if (not (listp host))
(error "Could not get IP address for: %s" host))
- (setq host (apply #'format "%c%c%c%c" host))
+ (setq host (apply #'unibyte-string host))
socks-address-type-v4)
(t
socks-address-type-name))))
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index 44f535f01c9..bb65ecaa981 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,4 +1,4 @@
-;;; telnet.el --- run a telnet session from within an Emacs buffer
+;;; telnet.el --- run a telnet session from within an Emacs buffer -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -63,11 +63,11 @@ LOGIN-NAME, which is optional, says what to log in as on that machine.")
(defvar telnet-new-line "\r")
(defvar telnet-mode-map
(let ((map (nconc (make-sparse-keymap) comint-mode-map)))
- (define-key map "\C-m" 'telnet-send-input)
- ;; (define-key map "\C-j" 'telnet-send-input)
- (define-key map "\C-c\C-q" 'send-process-next-char)
- (define-key map "\C-c\C-c" 'telnet-interrupt-subjob)
- (define-key map "\C-c\C-z" 'telnet-c-z)
+ (define-key map "\C-m" #'telnet-send-input)
+ ;; (define-key map "\C-j" #'telnet-send-input)
+ (define-key map "\C-c\C-q" #'send-process-next-char)
+ (define-key map "\C-c\C-c" #'telnet-interrupt-subjob)
+ (define-key map "\C-c\C-z" #'telnet-c-z)
map))
(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
@@ -152,7 +152,7 @@ rejecting one login and prompting again for a username and password.")
(t (telnet-check-software-type-initialize string)
(telnet-filter proc string)
(cond ((> telnet-count telnet-maximum-count)
- (set-process-filter proc 'telnet-filter))
+ (set-process-filter proc #'telnet-filter))
(t (setq telnet-count (1+ telnet-count)))))))))
;; Identical to comint-simple-send, except that it sends telnet-new-line
@@ -227,9 +227,9 @@ Normally input is edited in Emacs and sent a line at a time."
(if (and buffer (get-buffer-process buffer))
(switch-to-buffer (concat "*" name "*"))
(switch-to-buffer
- (apply 'make-comint name telnet-program nil telnet-options))
+ (apply #'make-comint name telnet-program nil telnet-options))
(setq process (get-buffer-process (current-buffer)))
- (set-process-filter process 'telnet-initial-filter)
+ (set-process-filter process #'telnet-initial-filter)
;; Don't send the `open' cmd till telnet is ready for it.
(accept-process-output process)
(erase-buffer)
@@ -263,7 +263,7 @@ Normally input is edited in Emacs and sent a line at a time."
(require 'shell)
(let ((name (concat "rsh-" host )))
(switch-to-buffer (make-comint name remote-shell-program nil host))
- (set-process-filter (get-process name) 'telnet-initial-filter)
+ (set-process-filter (get-process name) #'telnet-initial-filter)
(telnet-mode)
(setq-local telnet-connect-command (list 'rsh host))
(setq telnet-count -16)))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 6ec4d1fed38..c16e232c6d5 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -44,7 +44,6 @@
:version "24.4"
:type 'string)
-;;;###tramp-autoload
(defcustom tramp-adb-connect-if-not-connected nil
"Try to run `adb connect' if provided device is not connected currently.
It is used for TCP/IP devices."
@@ -56,7 +55,6 @@ It is used for TCP/IP devices."
(defconst tramp-adb-method "adb"
"When this method name is used, forward all calls to Android Debug Bridge.")
-;;;###tramp-autoload
(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'regexp
@@ -135,6 +133,7 @@ It is used for TCP/IP devices."
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-adb-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-adb-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -161,9 +160,11 @@ It is used for TCP/IP devices."
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-adb-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -182,6 +183,7 @@ It is used for TCP/IP devices."
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-adb-handle-write-region))
@@ -325,9 +327,9 @@ arguments to pass to the OPERATION."
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-compat-file-name-concat localname "."))
(tramp-shell-quote-argument
- (concat (file-name-as-directory localname) ".."))))
+ (tramp-compat-file-name-concat localname ".."))))
(widen)))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
@@ -537,7 +539,8 @@ But handle the case, if the \"test\" command is not available."
(defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -546,16 +549,26 @@ But handle the case, if the \"test\" command is not available."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let* ((curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (curbuf (current-buffer))
+ (tmpfile (tramp-compat-make-temp-file filename)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter
- v 3 (format-message
- "Moving tmp file `%s' to `%s'" tmpfile filename)
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
(unless (tramp-adb-execute-adb-command
v "push" tmpfile (tramp-compat-file-name-unquote localname))
@@ -578,6 +591,11 @@ But handle the case, if the \"test\" command is not available."
(file-attributes filename))
(current-time))))
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
@@ -785,7 +803,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let (command input tmpinput stderr tmpstderr outbuf ret)
;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument
@@ -906,7 +924,10 @@ implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (if (plist-member args :connection-type)
+ (plist-get args :connection-type)
+ tramp-process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -922,7 +943,7 @@ implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (unless (memq connection-type '(nil pipe t pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -1047,7 +1068,7 @@ implementation will be used."
p))))
;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 0bbd9271b18..67798e892ab 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -236,6 +236,7 @@ It must be supported by libarchive(3).")
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-archive-handle-file-local-copy)
+ (file-locked-p . ignore)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-archive-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler.
@@ -262,9 +263,11 @@ It must be supported by libarchive(3).")
(insert-directory . tramp-archive-handle-insert-directory)
(insert-file-contents . tramp-archive-handle-insert-file-contents)
(load . tramp-archive-handle-load)
+ (lock-file . ignore)
(make-auto-save-file-name . ignore)
(make-directory . tramp-archive-handle-not-implemented)
(make-directory-internal . tramp-archive-handle-not-implemented)
+ (make-lock-file-name . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-archive-handle-not-implemented)
@@ -283,6 +286,7 @@ It must be supported by libarchive(3).")
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-archive-handle-not-implemented))
@@ -328,6 +332,8 @@ arguments to pass to the OPERATION."
;; `filename' could be a quoted file name. Or the file
;; archive could be a directory, see Bug#30293.
(if (or (null archive)
+ (not (tramp-archive-run-real-handler
+ #'file-exists-p (list archive)))
(tramp-archive-run-real-handler
#'file-directory-p (list archive)))
(tramp-archive-run-real-handler operation args)
@@ -345,8 +351,17 @@ arguments to pass to the OPERATION."
(tramp-archive-run-real-handler operation args)))))))
;;;###autoload
-(defalias
- 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler)
+(progn (defun tramp-archive-autoload-file-name-handler (operation &rest args)
+ "Load Tramp archive file name handler, and perform OPERATION."
+ (when tramp-archive-enabled
+ ;; We cannot use `tramp-compat-temporary-file-directory' here due
+ ;; to autoload. When installing Tramp's GNU ELPA package, there
+ ;; might be an older, incompatible version active. We try to
+ ;; overload this.
+ (let ((default-directory temporary-file-directory)
+ (tramp-archive-autoload t))
+ tramp-archive-autoload ; Silence byte compiler.
+ (apply #'tramp-autoload-file-name-handler operation args)))))
;;;###autoload
(progn (defun tramp-register-archive-file-name-handler ()
@@ -628,10 +643,8 @@ offered."
(let ((result
(insert-file-contents
(tramp-archive-gvfs-file-name filename) visit beg end replace)))
- (prog1
- (list (expand-file-name filename)
- (cadr result))
- (when visit (setq buffer-file-name filename)))))
+ (when visit (setq buffer-file-name filename))
+ (cons (expand-file-name filename) (cdr result))))
(defun tramp-archive-handle-load
(file &optional noerror nomessage nosuffix must-suffix)
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 2b0a4d9cd05..5a00915f4f0 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -49,6 +49,8 @@
;; an open connection. Examples: "scripts" keeps shell script
;; definitions already sent to the remote shell, "last-cmd-time" is
;; the time stamp a command has been sent to the remote process.
+;; "lock-pid" is the timestamp a (network) process is created, it is
+;; used instead of the pid in file locks.
;;
;; - The key is nil. These are temporary properties related to the
;; local machine. Examples: "parse-passwd" and "parse-group" keep
@@ -70,7 +72,8 @@
;; process key retrieved by `tramp-get-process' (the main connection
;; process). Other processes could reuse these properties, avoiding
;; recomputation when a new asynchronous process is created by
-;; `make-process'. Examples are "remote-path" or "device" (tramp-adb.el).
+;; `make-process'. Examples are "unsafe-temporary-file",
+;; "remote-path", "device" (tramp-adb.el) or "share" (tramp-gvfs.el).
;;; Code:
@@ -122,7 +125,7 @@ If KEY is `tramp-cache-undefined', don't create anything, and return nil."
(puthash key (make-hash-table :test #'equal) tramp-cache-data)))
(when (tramp-file-name-p key)
(dolist (elt tramp-connection-properties)
- (when (string-match-p
+ (when (tramp-compat-string-search
(or (nth 0 elt) "")
(tramp-make-tramp-file-name key 'noloc 'nohop))
(tramp-set-connection-property key (nth 1 elt) (nth 2 elt)))))
@@ -162,16 +165,20 @@ Return DEFAULT if not set."
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
file property value remote-file-name-inhibit-cache cache-used cached-at)
+ ;; For analysis purposes, count the number of getting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (numberp (bound-and-true-p var))
- (progn
- (add-hook 'tramp-cache-unload-hook
- (lambda () (makunbound var)))
- 0))))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
(set var (1+ val))))
value))
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (dolist (var (all-completions "tramp-cache-get-count-" obarray))
+ (unintern var obarray))))
+
;;;###tramp-autoload
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
@@ -186,16 +193,20 @@ Return VALUE."
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
(tramp-message key 8 "%s %s %s" file property value)
+ ;; For analysis purposes, count the number of setting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (numberp (bound-and-true-p var))
- (progn
- (add-hook 'tramp-cache-unload-hook
- (lambda () (makunbound var)))
- 0))))
+ (val (or (and (boundp var) (numberp (symbol-value var))
+ (symbol-value var))
+ 0)))
(set var (1+ val))))
value))
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (dolist (var (all-completions "tramp-cache-set-count-" obarray))
+ (unintern var obarray))))
+
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."
@@ -229,8 +240,7 @@ Return VALUE."
;;;###tramp-autoload
(defun tramp-flush-file-properties (key file)
"Remove all properties of FILE in the cache context of KEY."
- (let* ((file (tramp-run-real-handler
- #'directory-file-name (list file)))
+ (let* ((file (tramp-run-real-handler #'directory-file-name (list file)))
(truename (tramp-get-file-property key file "file-truename" nil)))
;; Unify localname. Remove hop from `tramp-file-name' structure.
(setq file (tramp-compat-file-name-unquote file)
@@ -258,8 +268,8 @@ Remove also properties of all files in subdirectories."
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (tramp-file-name-p key)
(stringp (tramp-file-name-localname key))
- (string-match-p (regexp-quote directory)
- (tramp-file-name-localname key)))
+ (tramp-compat-string-search
+ directory (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
@@ -463,11 +473,11 @@ used to cache connection properties of the local machine."
;; don't save either, because all other properties might
;; depend on the login name, and we want to give the
;; possibility to use another login name later on. Key
- ;; "started" exists for the "ftp" method only, which must be
+ ;; "started" exists for the "ftp" method only, which must not
;; be kept persistent.
(maphash
(lambda (key value)
- (if (and (tramp-file-name-p key) value
+ (if (and (tramp-file-name-p key) (hash-table-p value)
(not (string-equal
(tramp-file-name-method key) tramp-archive-method))
(not (tramp-file-name-localname key))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 097f25ea85e..6278fd302af 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -57,7 +57,9 @@ SYNTAX can be one of the symbols `default' (default),
(all-completions
"*tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
(all-completions
- "*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
+ "*debug tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))
+ (all-completions
+ "*trace tramp" (mapcar #'list (mapcar #'buffer-name (buffer-list))))))
(defun tramp-list-remote-buffers ()
"Return a list of all buffers with remote `default-directory'."
@@ -144,11 +146,18 @@ When called interactively, a Tramp connection has to be selected."
;;;###tramp-autoload
(defun tramp-cleanup-this-connection ()
"Flush all connection related objects of the current buffer's connection."
+ ;; (declare (completion tramp-command-completion-p)))
(interactive)
(and (tramp-tramp-file-p default-directory)
(tramp-cleanup-connection
(tramp-dissect-file-name default-directory 'noexpand))))
+;; Starting with Emacs 28.1, this can be replaced by the "(declare ...)" form.
+;;;###tramp-autoload
+(function-put
+ #'tramp-cleanup-this-connection 'completion-predicate
+ #'tramp-command-completion-p)
+
;;;###tramp-autoload
(defvar tramp-cleanup-all-connections-hook nil
"List of functions to be called after all Tramp connections are cleaned up.")
@@ -201,7 +210,6 @@ This includes password cache, file cache, connection cache, buffers."
(dolist (name (tramp-list-remote-buffers))
(when (bufferp (get-buffer name)) (kill-buffer name))))
-;;;###tramp-autoload
(defcustom tramp-default-rename-alist nil
"Default target for renaming remote buffer file names.
This is an alist of cons cells (SOURCE . TARGET). The first
@@ -224,7 +232,6 @@ expression which always matches."
:type '(repeat (cons (choice :tag "Source regexp" regexp sexp)
(choice :tag "Target name" string (const nil)))))
-;;;###tramp-autoload
(defcustom tramp-confirm-rename-file-names t
"Whether renaming a buffer file name must be confirmed."
:group 'tramp
@@ -243,7 +250,7 @@ function returns nil"
(host (or (file-remote-p string 'host) ""))
item result)
(while (setq item (pop tdra))
- (when (string-match-p (or (eval (car item)) "") string)
+ (when (string-match-p (or (eval (car item) t) "") string)
(setq tdra nil
result
(format-spec
@@ -431,6 +438,7 @@ Interactively, TARGET is selected from `tramp-default-rename-alist'
without confirmation if the prefix argument is non-nil.
For details, see `tramp-rename-files'."
+ ;; (declare (completion tramp-command-completion-p))
(interactive
(let ((source default-directory)
target
@@ -461,11 +469,59 @@ For details, see `tramp-rename-files'."
(tramp-rename-files default-directory target))
+;; Starting with Emacs 28.1, this can be replaced by the "(declare ...)" form.
+;;;###tramp-autoload
+(function-put
+ #'tramp-rename-these-files 'completion-predicate #'tramp-command-completion-p)
+
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+;;;###tramp-autoload
+(defun tramp-recompile-elpa-command-completion-p (_symbol _buffer)
+ "A predicate for `tramp-recompile-elpa'.
+It is completed by \"M-x TAB\" only if package.el is loaded, and
+Tramp is an installed ELPA package."
+ ;; We cannot apply `package-installed-p', this would also return the
+ ;; builtin package.
+ (and (assq 'tramp (bound-and-true-p package-alist))
+ (tramp-compat-funcall 'package--user-installed-p 'tramp)))
+
+;;;###tramp-autoload
+(defun tramp-recompile-elpa ()
+ "Recompile the installed Tramp ELPA package.
+This is needed if there are compatibility problems."
+ ;; (declare (completion tramp-recompile-elpa-command-completion-p))
+ (interactive)
+ ;; We expect just one Tramp package is installed.
+ (when-let
+ ((dir (tramp-compat-funcall
+ 'package-desc-dir
+ (car (alist-get 'tramp (bound-and-true-p package-alist))))))
+ (dolist (elc (directory-files dir 'full "\\.elc\\'"))
+ (delete-file elc))
+ (with-current-buffer (get-buffer-create byte-compile-log-buffer)
+ (let ((inhibit-read-only t))
+ (compilation-mode)
+ (goto-char (point-max))
+ (insert "\f\n")
+ (call-process
+ (expand-file-name invocation-name invocation-directory) nil t t
+ "-Q" "-batch" "-L" dir
+ "--eval" (format "(byte-recompile-directory %S 0 t)" dir))
+ (message "Package `tramp' recompiled.")))))
+
+;; Starting with Emacs 28.1, this can be replaced by the "(declare ...)" form.
+;;;###tramp-autoload
+(function-put
+ #'tramp-recompile-elpa 'completion-predicate
+ #'tramp-recompile-elpa-command-completion-p)
+
;; Tramp version is useful in a number of situations.
;;;###tramp-autoload
(defun tramp-version (arg)
- "Print version number of tramp.el in minibuffer or current buffer."
+ "Print version number of tramp.el in echo area or current buffer."
(interactive "P")
(if arg (insert tramp-version) (message tramp-version)))
@@ -616,7 +672,7 @@ buffer in your bug report.
(insert "\nload-path shadows:\n==================\n")
(ignore-errors
(mapc
- (lambda (x) (when (string-match-p "tramp" x) (insert x "\n")))
+ (lambda (x) (when (tramp-compat-string-search "tramp" x) (insert x "\n")))
(split-string (list-load-path-shadows t) "\n")))
;; Append buffers only when we are in message mode.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 27461e6917c..b713d5eae82 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -63,14 +63,12 @@
`(when (functionp ,function)
(with-no-warnings (funcall ,function ,@arguments))))
-(put #'tramp-compat-funcall 'tramp-suppress-trace t)
-
(defsubst tramp-compat-temporary-file-directory ()
"Return name of directory for temporary files.
It is the default value of `temporary-file-directory'."
;; We must return a local directory. If it is remote, we could run
;; into an infloop.
- (eval (car (get 'temporary-file-directory 'standard-value))))
+ (eval (car (get 'temporary-file-directory 'standard-value)) t))
(defsubst tramp-compat-make-temp-name ()
"Generate a local temporary file name (compat function)."
@@ -353,7 +351,44 @@ A nil value for either argument stands for the current time."
(if (fboundp 'string-replace)
#'string-replace
(lambda (fromstring tostring instring)
- (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
+ (let ((case-fold-search nil))
+ (replace-regexp-in-string
+ (regexp-quote fromstring) tostring instring t t)))))
+
+;; Function `string-search' is new in Emacs 28.1.
+(defalias 'tramp-compat-string-search
+ (if (fboundp 'string-search)
+ #'string-search
+ (lambda (needle haystack &optional start-pos)
+ (let ((case-fold-search nil))
+ (string-match-p (regexp-quote needle) haystack start-pos)))))
+
+;; Function `make-lock-file-name' is new in Emacs 28.1.
+(defalias 'tramp-compat-make-lock-file-name
+ (if (fboundp 'make-lock-file-name)
+ #'make-lock-file-name
+ (lambda (filename)
+ (expand-file-name
+ (concat
+ ".#" (file-name-nondirectory filename))
+ (file-name-directory filename)))))
+
+;; Function `file-name-concat' is new in Emacs 28.1.
+(defalias 'tramp-compat-file-name-concat
+ (if (fboundp 'file-name-concat)
+ #'file-name-concat
+ (lambda (directory &rest components)
+ (unless (null directory)
+ (let ((components (delq nil components))
+ file-name-handler-alist)
+ (if (null components)
+ directory
+ (tramp-compat-file-name-concat
+ (concat (file-name-as-directory directory) (car components))
+ (cdr components))))))))
+
+(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
+ (put (intern elt) 'tramp-suppress-trace t))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index f8de7085e25..fdb2907ec32 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -112,6 +112,18 @@ initializing a new crypted remote directory."
"Non-nil when encryption support is available.")
(setq tramp-crypt-enabled (executable-find tramp-crypt-encfs-program))
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+(defun tramp-crypt-command-completion-p (symbol _buffer)
+ "A predicate for Tramp interactive commands.
+They are completed by \"M-x TAB\" only when encryption support is enabled."
+ (and tramp-crypt-enabled
+ ;; `tramp-crypt-remove-directory' needs to be completed only in
+ ;; case we have already crypted directories.
+ (or (not (eq symbol #'tramp-crypt-remove-directory))
+ tramp-crypt-directories)))
+
;;;###tramp-autoload
(defconst tramp-crypt-encfs-config ".encfs6.xml"
"Encfs configuration file name.")
@@ -170,6 +182,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-crypt-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-crypt-handle-file-name-all-completions)
;; `file-name-as-directory' performed by default handler.
@@ -196,9 +209,11 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
(insert-directory . tramp-crypt-handle-insert-directory)
;; `insert-file-contents' performed by default handler.
(load . tramp-handle-load)
+ (lock-file . tramp-crypt-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-crypt-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -217,6 +232,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
;; `tramp-get-remote-uid' performed by default handler.
(tramp-set-file-uid-gid . tramp-crypt-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-crypt-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region))
@@ -481,10 +497,17 @@ directory. File names will be also encrypted."
(setq tramp-crypt-directories (cons name tramp-crypt-directories)))
(tramp-register-file-name-handlers))
+;; `tramp-crypt-command-completion-p' is not autoloaded, and this
+;; setting isn't either.
+(function-put
+ #'tramp-crypt-add-directory 'completion-predicate
+ #'tramp-crypt-command-completion-p)
+
(defun tramp-crypt-remove-directory (name)
"Unmark remote directory NAME for encryption.
Existing files in that directory and its subdirectories will be
kept in their encrypted form."
+ ;; (declare (completion tramp-crypt-command-completion-p))
(interactive "DRemote directory name: ")
(unless tramp-crypt-enabled
(tramp-user-error nil "Feature is not enabled."))
@@ -498,6 +521,11 @@ kept in their encrypted form."
(setq tramp-crypt-directories (delete name tramp-crypt-directories))
(tramp-register-file-name-handlers)))
+;; Starting with Emacs 28.1, this can be replaced by the "(declare ...)" form.
+(function-put
+ #'tramp-crypt-remove-directory 'completion-predicate
+ #'tramp-crypt-command-completion-p)
+
;; `auth-source' requires a user.
(defun tramp-crypt-dissect-file-name (name)
"Return a `tramp-file-name' structure for NAME.
@@ -710,6 +738,11 @@ absolute file names."
(let (tramp-crypt-enabled)
(file-executable-p (tramp-crypt-encrypt-file-name filename))))
+(defun tramp-crypt-handle-file-locked-p (filename)
+ "Like `file-locked-p' for Tramp files."
+ (let (tramp-crypt-enabled)
+ (file-locked-p (tramp-crypt-encrypt-file-name filename))))
+
(defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
(all-completions
@@ -773,6 +806,13 @@ WILDCARD is not supported."
(delete-region (prop-match-beginning match) (prop-match-end match))
(insert (propertize string 'dired-filename t)))))))
+(defun tramp-crypt-handle-lock-file (filename)
+ "Like `lock-file' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall
+ 'lock-file (tramp-crypt-encrypt-file-name filename))))
+
(defun tramp-crypt-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name dir) nil
@@ -824,6 +864,13 @@ WILDCARD is not supported."
(tramp-set-file-uid-gid
(tramp-crypt-encrypt-file-name filename) uid gid))))
+(defun tramp-crypt-handle-unlock-file (filename)
+ "Like `unlock-file' for Tramp files."
+ (let (tramp-crypt-enabled)
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall
+ 'unlock-file (tramp-crypt-encrypt-file-name filename))))
+
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-crypt 'force)))
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
new file mode 100644
index 00000000000..93b184a36c2
--- /dev/null
+++ b/lisp/net/tramp-fuse.el
@@ -0,0 +1,214 @@
+;;; tramp-fuse.el --- Tramp access functions for FUSE mounts -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; 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:
+
+;; These are helper functions for FUSE file systems.
+
+;;; Code:
+
+(require 'tramp)
+
+;; File name primitives.
+
+(defun tramp-fuse-handle-delete-directory
+ (directory &optional recursive trash)
+ "Like `delete-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (tramp-flush-directory-properties v localname)
+ (delete-directory (tramp-fuse-local-file-name directory) recursive trash)))
+
+(defun tramp-fuse-handle-delete-file (filename &optional trash)
+ "Like `delete-file' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (delete-file (tramp-fuse-local-file-name filename) trash)
+ (tramp-flush-file-properties v localname)))
+
+(defun tramp-fuse-handle-directory-files
+ (directory &optional full match nosort count)
+ "Like `directory-files' for Tramp files."
+ (unless (file-exists-p directory)
+ (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
+ (when (file-directory-p directory)
+ (setq directory (file-name-as-directory (expand-file-name directory)))
+ (with-parsed-tramp-file-name directory nil
+ (let ((result
+ (tramp-compat-directory-files
+ (tramp-fuse-local-file-name directory) full match nosort count)))
+ ;; Massage the result.
+ (when full
+ (let ((local (concat "^" (regexp-quote (tramp-fuse-mount-point v))))
+ (remote (directory-file-name
+ (funcall
+ (if (tramp-compat-file-name-quoted-p directory)
+ #'tramp-compat-file-name-quote #'identity)
+ (file-remote-p directory)))))
+ (setq result
+ (mapcar
+ (lambda (x) (replace-regexp-in-string local remote x))
+ result))))
+ ;; Some storage systems do not return "." and "..".
+ (dolist (item '(".." "."))
+ (when (and (string-match-p (or match (regexp-quote item)) item)
+ (not
+ (member (if full (setq item (concat directory item)) item)
+ result)))
+ (setq result (cons item result))))
+ ;; Return result.
+ (if nosort result (sort result #'string<))))))
+
+(defun tramp-fuse-handle-file-attributes (filename &optional id-format)
+ "Like `file-attributes' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (file-attributes (tramp-fuse-local-file-name filename) id-format))))
+
+(defun tramp-fuse-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-executable-p"
+ (file-executable-p (tramp-fuse-local-file-name filename)))))
+
+(defun tramp-fuse-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (delete-dups
+ (append
+ (file-name-all-completions
+ filename (tramp-fuse-local-file-name directory))
+ ;; Some storage systems do not return "." and "..".
+ (let (result)
+ (dolist (item '(".." ".") result)
+ (when (string-prefix-p filename item)
+ (catch 'match
+ (dolist (elt completion-regexp-list)
+ (unless (string-match-p elt item) (throw 'match nil)))
+ (setq result (cons (concat item "/") result))))))))))
+
+(defun tramp-fuse-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property v localname "file-readable-p"
+ (file-readable-p (tramp-fuse-local-file-name filename)))))
+
+;; This function isn't used.
+(defun tramp-fuse-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (insert-directory
+ (tramp-fuse-local-file-name filename) switches wildcard full-directory-p)
+ (goto-char (point-min))
+ (while (search-forward (tramp-fuse-local-file-name filename) nil 'noerror)
+ (replace-match filename)))
+
+(defun tramp-fuse-handle-make-directory (dir &optional parents)
+ "Like `make-directory' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name dir) nil
+ (make-directory (tramp-fuse-local-file-name dir) parents)
+ ;; When PARENTS is non-nil, DIR could be a chain of non-existent
+ ;; directories a/b/c/... Instead of checking, we simply flush the
+ ;; whole file cache.
+ (tramp-flush-file-properties v localname)
+ (tramp-flush-directory-properties
+ v (if parents "/" (file-name-directory localname)))))
+
+
+;; File name helper functions.
+
+(defun tramp-fuse-mount-spec (vec)
+ "Return local mount spec of VEC."
+ (if-let ((host (tramp-file-name-host vec))
+ (user (tramp-file-name-user vec)))
+ (format "%s@%s:/" user host)
+ (format "%s:/" host)))
+
+(defun tramp-fuse-mount-point (vec)
+ "Return local mount point of VEC."
+ (or (tramp-get-connection-property vec "mount-point" nil)
+ (expand-file-name
+ (concat
+ tramp-temp-name-prefix
+ (tramp-file-name-method vec) "."
+ (when (tramp-file-name-user vec)
+ (concat (tramp-file-name-user-domain vec) "@"))
+ (tramp-file-name-host-port vec))
+ (tramp-compat-temporary-file-directory))))
+
+(defun tramp-fuse-mounted-p (vec)
+ "Check, whether fuse volume determined by VEC is mounted."
+ (when (tramp-get-connection-process vec)
+ ;; We cannot use `with-connection-property', because we don't want
+ ;; to cache a nil result.
+ (or (tramp-get-connection-property
+ (tramp-get-connection-process vec) "mounted" nil)
+ (let* ((default-directory (tramp-compat-temporary-file-directory))
+ (command (format "mount -t fuse.%s" (tramp-file-name-method vec)))
+ (mount (shell-command-to-string command)))
+ (tramp-message vec 6 "%s\n%s" command mount)
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "mounted"
+ (when (string-match
+ (format
+ "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec)))
+ mount)
+ (match-string 1 mount)))))))
+
+(defun tramp-fuse-unmount (vec)
+ "Unmount fuse volume determined by VEC."
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (command (format "fusermount3 -u %s" (tramp-fuse-mount-point vec))))
+ (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command))
+ (tramp-flush-connection-property
+ (tramp-get-connection-process vec) "mounted")
+ ;; Give the caches a chance to expire.
+ (sleep-for 1)))
+
+(defun tramp-fuse-local-file-name (filename)
+ "Return local mount name of FILENAME."
+ (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ ;; As long as we call `tramp-*-maybe-open-connection' here,
+ ;; we cache the result.
+ (with-tramp-file-property v localname "local-file-name"
+ (funcall
+ (intern
+ (format "tramp-%s-maybe-open-connection" (tramp-file-name-method v)))
+ v)
+ (let ((quoted (tramp-compat-file-name-quoted-p localname))
+ (localname (tramp-compat-file-name-unquote localname)))
+ (funcall
+ (if quoted #'tramp-compat-file-name-quote #'identity)
+ (expand-file-name
+ (if (file-name-absolute-p localname)
+ (substring localname 1) localname)
+ (tramp-fuse-mount-point v)))))))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-fuse 'force)))
+
+(provide 'tramp-fuse)
+
+;;; tramp-fuse.el ends here
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e946d73e66c..e4f54cf4c46 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -175,7 +175,6 @@ They are checked during start up via
(dbus-list-known-names :session))
(setq tramp-media-methods (delete method tramp-media-methods)))))
-;;;###tramp-autoload
(defcustom tramp-gvfs-zeroconf-domain "local"
"Zeroconf domain to be used for discovering services, like host names."
:group 'tramp
@@ -775,6 +774,7 @@ It has been changed in GVFS 1.14.")
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -801,9 +801,11 @@ It has been changed in GVFS 1.14.")
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -822,6 +824,7 @@ It has been changed in GVFS 1.14.")
(tramp-get-remote-uid . tramp-gvfs-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-gvfs-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region))
@@ -1090,7 +1093,7 @@ file names."
'copy filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(tramp-run-real-handler
- 'copy-file
+ #'copy-file
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
@@ -1139,7 +1142,7 @@ file names."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -1172,6 +1175,9 @@ file names."
;; There might be a double slash. Remove this.
(while (string-match "//" localname)
(setq localname (replace-match "/" t t localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
@@ -1395,7 +1401,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -1627,8 +1633,10 @@ If FILE-SYSTEM is non-nil, return file system attributes."
ID-FORMAT valid values are `string' and `integer'."
(if (equal id-format 'string)
(tramp-file-name-user vec)
- (when-let
- ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (when-let ((localname
+ (tramp-get-connection-property
+ (tramp-get-process vec) "share"
+ (tramp-get-connection-property vec "default-location" nil))))
(tramp-compat-file-attribute-user-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format)))))
@@ -1636,8 +1644,10 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
- (when-let
- ((localname (tramp-get-connection-property vec "default-location" nil)))
+ (when-let ((localname
+ (tramp-get-connection-property
+ (tramp-get-process vec) "share"
+ (tramp-get-connection-property vec "default-location" nil))))
(tramp-compat-file-attribute-group-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format))))
@@ -1991,6 +2001,9 @@ a downcased host name only."
(tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint)
(tramp-set-connection-property
vec "default-location" default-location)
+ (when share
+ (tramp-set-connection-property
+ (tramp-get-process vec) "share" (concat "/" share)))
(throw 'mounted t)))))))
(defun tramp-gvfs-unmount (vec)
@@ -2142,6 +2155,9 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 64b5b48e7d4..17264193fd6 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -42,6 +42,8 @@
(declare-function tramp-dissect-file-name "tramp")
(declare-function tramp-file-name-equal-p "tramp")
(declare-function tramp-tramp-file-p "tramp")
+(declare-function tramp-rename-files "tramp-cmds")
+(declare-function tramp-rename-these-files "tramp-cmds")
(defvar eshell-path-env)
(defvar ido-read-file-name-non-ido)
(defvar info-lookup-alist)
@@ -49,6 +51,7 @@
(defvar recentf-exclude)
(defvar tramp-current-connection)
(defvar tramp-postfix-host-format)
+(defvar tramp-use-ssh-controlmaster-options)
;;; Fontification of `read-file-name':
@@ -183,14 +186,14 @@ NAME must be equal to `tramp-current-connection'."
;;; Integration of ido.el:
(with-eval-after-load 'ido
- (add-to-list 'ido-read-file-name-non-ido 'tramp-rename-files)
- (add-to-list 'ido-read-file-name-non-ido 'tramp-these-rename-files)
+ (add-to-list 'ido-read-file-name-non-ido #'tramp-rename-files)
+ (add-to-list 'ido-read-file-name-non-ido #'tramp-rename-these-files)
(add-hook 'tramp-integration-unload-hook
(lambda ()
(setq ido-read-file-name-non-ido
- (delq 'tramp-these-rename-files ido-read-file-name-non-ido)
+ (delq #'tramp-rename-these-files ido-read-file-name-non-ido)
ido-read-file-name-non-ido
- (delq 'tramp-rename-files ido-read-file-name-non-ido)))))
+ (delq #'tramp-rename-files ido-read-file-name-non-ido)))))
;;; Integration of ivy.el:
@@ -198,17 +201,17 @@ NAME must be equal to `tramp-current-connection'."
(add-to-list 'ivy-completing-read-handlers-alist
'(tramp-rename-files . completing-read-default))
(add-to-list 'ivy-completing-read-handlers-alist
- '(tramp-these-rename-files . completing-read-default))
+ '(tramp-rename-these-files . completing-read-default))
(add-hook
'tramp-integration-unload-hook
(lambda ()
(setq ivy-completing-read-handlers-alist
(delete
- (assq 'tramp-these-rename-files ivy-completing-read-handlers-alist)
+ (assq #'tramp-rename-these-files ivy-completing-read-handlers-alist)
ivy-completing-read-handlers-alist)
ivy-completing-read-handlers-alist
(delete
- (assq 'tramp-rename-files ivy-completing-read-handlers-alist)
+ (assq #'tramp-rename-files ivy-completing-read-handlers-alist)
ivy-completing-read-handlers-alist)))))
;;; Integration of info-look.el:
@@ -231,7 +234,7 @@ NAME must be equal to `tramp-current-connection'."
(delete (info-lookup->mode-cache 'symbol 'tramp-info-lookup-mode)
(info-lookup->topic-cache 'symbol)))))
- (dolist (mode (mapcar 'car (info-lookup->topic-value 'symbol)))
+ (dolist (mode (mapcar #'car (info-lookup->topic-value 'symbol)))
;; Add `tramp-info-lookup-mode' to `other-modes' for either
;; `emacs-lisp-mode' itself, or to modes which use
;; `emacs-lisp-mode' as `other-modes'. Reset `info-lookup-cache'.
@@ -261,6 +264,23 @@ NAME must be equal to `tramp-current-connection'."
(delete (info-lookup->mode-cache 'symbol ',mode)
(info-lookup->topic-cache 'symbol))))))))
+;;; Integration of compile.el:
+
+;; Compilation processes use `accept-process-output' such a way that
+;; Tramp's parallel `accept-process-output' blocks. See last part of
+;; Bug#45518. So we don't use ssh ControlMaster options.
+(defun tramp-compile-disable-ssh-controlmaster-options ()
+ "Don't allow ssh ControlMaster while compiling."
+ (setq-local tramp-use-ssh-controlmaster-options nil))
+
+(with-eval-after-load 'compile
+ (add-hook 'compilation-mode-hook
+ #'tramp-compile-disable-ssh-controlmaster-options)
+ (add-hook 'tramp-integration-unload-hook
+ (lambda ()
+ (remove-hook 'compilation-start-hook
+ #'tramp-compile-disable-ssh-controlmaster-options))))
+
;;; Default connection-local variables for Tramp:
;; `connection-local-set-profile-variables' and
;; `connection-local-set-profiles' exists since Emacs 26.1.
@@ -277,7 +297,7 @@ NAME must be equal to `tramp-current-connection'."
(tramp-compat-funcall
'connection-local-set-profiles
- `(:application tramp)
+ '(:application tramp)
'tramp-connection-local-default-system-profile)
(defconst tramp-connection-local-default-shell-variables
@@ -293,7 +313,7 @@ NAME must be equal to `tramp-current-connection'."
(with-eval-after-load 'shell
(tramp-compat-funcall
'connection-local-set-profiles
- `(:application tramp)
+ '(:application tramp)
'tramp-connection-local-default-shell-profile))
(add-hook 'tramp-unload-hook
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 96f7d9a89b9..49e366c01c6 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -35,14 +35,13 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
(require 'tramp)
+(require 'tramp-fuse)
;;;###tramp-autoload
(defconst tramp-rclone-method "rclone"
"When this method name is used, forward all calls to rclone mounts.")
-;;;###tramp-autoload
(defcustom tramp-rclone-program "rclone"
"Name of the rclone program."
:group 'tramp
@@ -53,7 +52,12 @@
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-rclone-method
- (tramp-mount-args nil)
+ ;; Be careful changing "--dir-cache-time", this could
+ ;; delay visibility of files. Since we use Tramp's
+ ;; internal cache for file attributes, there shouldn't
+ ;; be serious performance penalties when set to 0.
+ (tramp-mount-args
+ ("--no-unicode-normalization" "--dir-cache-time" "0s"))
(tramp-copyto-args nil)
(tramp-moveto-args nil)
(tramp-about-args ("--full"))))
@@ -72,11 +76,11 @@
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-handle-copy-directory)
(copy-file . tramp-rclone-handle-copy-file)
- (delete-directory . tramp-rclone-handle-delete-directory)
- (delete-file . tramp-rclone-handle-delete-file)
+ (delete-directory . tramp-fuse-handle-delete-directory)
+ (delete-file . tramp-fuse-handle-delete-file)
;; `diff-latest-backup-file' performed by default handler.
(directory-file-name . tramp-handle-directory-file-name)
- (directory-files . tramp-rclone-handle-directory-files)
+ (directory-files . tramp-fuse-handle-directory-files)
(directory-files-and-attributes
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . ignore)
@@ -85,15 +89,16 @@
(expand-file-name . tramp-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . ignore)
- (file-attributes . tramp-rclone-handle-file-attributes)
+ (file-attributes . tramp-fuse-handle-file-attributes)
(file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p)
- (file-executable-p . tramp-rclone-handle-file-executable-p)
+ (file-executable-p . tramp-fuse-handle-file-executable-p)
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
- (file-name-all-completions . tramp-rclone-handle-file-name-all-completions)
+ (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
(file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
(file-name-completion . tramp-handle-file-name-completion)
@@ -105,7 +110,7 @@
(file-notify-rm-watch . ignore)
(file-notify-valid-p . ignore)
(file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-rclone-handle-file-readable-p)
+ (file-readable-p . tramp-fuse-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-handle-file-selinux-context)
@@ -118,9 +123,11 @@
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
- (make-directory . tramp-rclone-handle-make-directory)
+ (make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-handle-make-symbolic-link)
@@ -139,6 +146,7 @@
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-handle-write-region))
@@ -247,24 +255,13 @@ file names."
"Error %s `%s' `%s'" msg-operation filename newname)))
(when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)
- (when (tramp-rclone-file-name-p filename)
- (tramp-rclone-flush-directory-cache v1)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (file-exists-p filename)
- (tramp-flush-file-properties v1 v1-localname)))))
+ (while (file-exists-p filename)
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname))))
(when t2
(with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname)
- (when (tramp-rclone-file-name-p newname)
- (tramp-rclone-flush-directory-cache v2)
- ;; The mount point's directory cache might need time
- ;; to flush.
- (while (not (file-exists-p newname))
- (tramp-flush-file-properties v2 v2-localname))))))))))
+ (tramp-flush-file-properties v2 v2-localname))))))))
(defun tramp-rclone-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -283,88 +280,6 @@ file names."
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
-(defun tramp-rclone-handle-delete-directory
- (directory &optional recursive trash)
- "Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (tramp-flush-directory-properties v localname)
- (tramp-rclone-flush-directory-cache v)
- (delete-directory (tramp-rclone-local-file-name directory) recursive trash)))
-
-(defun tramp-rclone-handle-delete-file (filename &optional trash)
- "Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-rclone-flush-directory-cache v)
- (delete-file (tramp-rclone-local-file-name filename) trash)
- (tramp-flush-file-properties v localname)))
-
-(defun tramp-rclone-handle-directory-files
- (directory &optional full match nosort count)
- "Like `directory-files' for Tramp files."
- (unless (file-exists-p directory)
- (tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
- (when (file-directory-p directory)
- (setq directory (file-name-as-directory (expand-file-name directory)))
- (with-parsed-tramp-file-name directory nil
- (let ((result
- (tramp-compat-directory-files
- (tramp-rclone-local-file-name directory) full match nosort count)))
- ;; Massage the result.
- (when full
- (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
- (remote (funcall (if (tramp-compat-file-name-quoted-p directory)
- #'tramp-compat-file-name-quote #'identity)
- (file-remote-p directory))))
- (setq result
- (mapcar
- (lambda (x) (replace-regexp-in-string local remote x))
- result))))
- ;; Some storage systems do not return "." and "..".
- (dolist (item '(".." "."))
- (when (and (string-match-p (or match (regexp-quote item)) item)
- (not
- (member (if full (setq item (concat directory item)) item)
- result)))
- (setq result (cons item result))))
- ;; Return result.
- (if nosort result (sort result #'string<))))))
-
-(defun tramp-rclone-handle-file-attributes (filename &optional id-format)
- "Like `file-attributes' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (file-attributes (tramp-rclone-local-file-name filename) id-format))))
-
-(defun tramp-rclone-handle-file-executable-p (filename)
- "Like `file-executable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-executable-p"
- (file-executable-p (tramp-rclone-local-file-name filename)))))
-
-(defun tramp-rclone-handle-file-name-all-completions (filename directory)
- "Like `file-name-all-completions' for Tramp files."
- (all-completions
- filename
- (delete-dups
- (append
- (file-name-all-completions
- filename (tramp-rclone-local-file-name directory))
- ;; Some storage systems do not return "." and "..".
- (let (result)
- (dolist (item '(".." ".") result)
- (when (string-prefix-p filename item)
- (catch 'match
- (dolist (elt completion-regexp-list)
- (unless (string-match-p elt item) (throw 'match nil)))
- (setq result (cons (concat item "/") result))))))))))
-
-(defun tramp-rclone-handle-file-readable-p (filename)
- "Like `file-readable-p' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-readable-p"
- (file-readable-p (tramp-rclone-local-file-name filename)))))
-
(defun tramp-rclone-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
(ignore-errors
@@ -392,37 +307,6 @@ file names."
(when (and total free)
(list total free (- total free))))))))
-(defun tramp-rclone-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- (insert-directory
- (tramp-rclone-local-file-name filename) switches wildcard full-directory-p)
- (goto-char (point-min))
- (while (search-forward (tramp-rclone-local-file-name filename) nil 'noerror)
- (replace-match filename)))
-
-(defun tramp-rclone-handle-insert-file-contents
- (filename &optional visit beg end replace)
- "Like `insert-file-contents' for Tramp files."
- (let ((result
- (insert-file-contents
- (tramp-rclone-local-file-name filename) visit beg end replace)))
- (prog1
- (list (expand-file-name filename) (cadr result))
- (when visit (setq buffer-file-name filename)))))
-
-(defun tramp-rclone-handle-make-directory (dir &optional parents)
- "Like `make-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name dir) nil
- (make-directory (tramp-rclone-local-file-name dir) parents)
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole file cache.
- (tramp-flush-file-properties v localname)
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
- (tramp-rclone-flush-directory-cache v)))
-
(defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
@@ -440,83 +324,6 @@ file names."
;; File name conversions.
-(defun tramp-rclone-mount-point (vec)
- "Return local mount point of VEC."
- (expand-file-name
- (concat
- tramp-temp-name-prefix (tramp-file-name-method vec)
- "." (tramp-file-name-host vec))
- (tramp-compat-temporary-file-directory)))
-
-(defun tramp-rclone-mounted-p (vec)
- "Check, whether storage system determined by VEC is mounted."
- (when (tramp-get-connection-process vec)
- ;; We cannot use `with-connection-property', because we don't want
- ;; to cache a nil result.
- (or (tramp-get-connection-property
- (tramp-get-connection-process vec) "mounted" nil)
- (let* ((default-directory (tramp-compat-temporary-file-directory))
- (mount (shell-command-to-string "mount -t fuse.rclone")))
- (tramp-message vec 6 "%s" "mount -t fuse.rclone")
- (tramp-message vec 6 "\n%s" mount)
- (tramp-set-connection-property
- (tramp-get-connection-process vec) "mounted"
- (when (string-match
- (format
- "^\\(%s:\\S-*\\)" (regexp-quote (tramp-file-name-host vec)))
- mount)
- (match-string 1 mount)))))))
-
-(defun tramp-rclone-flush-directory-cache (vec)
- "Flush directory cache of VEC mount."
- (let ((rclone-pid
- ;; Identify rclone process.
- (when (tramp-get-connection-process vec)
- (with-tramp-connection-property
- (tramp-get-connection-process vec) "rclone-pid"
- (catch 'pid
- (dolist
- (pid
- ;; Until Emacs 25, `process-attributes' could
- ;; crash Emacs for some processes. So we use
- ;; "pidof", which might not work everywhere.
- (if (<= emacs-major-version 25)
- (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (mapcar
- #'string-to-number
- (split-string
- (shell-command-to-string "pidof rclone"))))
- (list-system-processes)))
- (and (string-match-p
- (regexp-quote
- (format "rclone mount %s:" (tramp-file-name-host vec)))
- (or (cdr (assoc 'args (process-attributes pid))) ""))
- (throw 'pid pid))))))))
- ;; Send a SIGHUP in order to flush directory cache.
- (when rclone-pid
- (tramp-message
- vec 6 "Send SIGHUP %d: %s"
- rclone-pid (cdr (assoc 'args (process-attributes rclone-pid))))
- (signal-process rclone-pid 'SIGHUP))))
-
-(defun tramp-rclone-local-file-name (filename)
- "Return local mount name of FILENAME."
- (setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- ;; As long as we call `tramp-rclone-maybe-open-connection' here,
- ;; we cache the result.
- (with-tramp-file-property v localname "local-file-name"
- (tramp-rclone-maybe-open-connection v)
- (let ((quoted (tramp-compat-file-name-quoted-p localname))
- (localname (tramp-compat-file-name-unquote localname)))
- (funcall
- (if quoted #'tramp-compat-file-name-quote #'identity)
- (expand-file-name
- (if (file-name-absolute-p localname)
- (substring localname 1) localname)
- (tramp-rclone-mount-point v)))))))
-
(defun tramp-rclone-remote-file-name (filename)
"Return FILENAME as used in the `rclone' command."
(setq filename (tramp-compat-file-name-unquote (expand-file-name filename)))
@@ -529,7 +336,7 @@ file names."
;; TODO: This shall be handled by `expand-file-name'.
(setq localname
(replace-regexp-in-string "^\\." "" (or localname "")))
- (format "%s%s" (tramp-rclone-mounted-p v) localname)))
+ (format "%s%s" (tramp-fuse-mounted-p v) localname)))
;; It is a local file name.
filename))
@@ -555,24 +362,26 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property
+ p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)))
;; Create directory.
- (unless (file-directory-p (tramp-rclone-mount-point vec))
- (make-directory (tramp-rclone-mount-point vec) 'parents))
+ (unless (file-directory-p (tramp-fuse-mount-point vec))
+ (make-directory (tramp-fuse-mount-point vec) 'parents))
;; Mount. This command does not return, so we use 0 as
;; DESTINATION of `tramp-call-process'.
- (unless (tramp-rclone-mounted-p vec)
+ (unless (tramp-fuse-mounted-p vec)
(apply
#'tramp-call-process
vec tramp-rclone-program nil 0 nil
- (delq nil
- `("mount" ,(concat host ":/")
- ,(tramp-rclone-mount-point vec)
- ;; This could be nil.
- ,(tramp-get-method-parameter vec 'tramp-mount-args))))
+ "mount" (tramp-fuse-mount-spec vec)
+ (tramp-fuse-mount-point vec)
+ (tramp-get-method-parameter vec 'tramp-mount-args))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
@@ -607,9 +416,4 @@ The command is the list of strings ARGS."
(provide 'tramp-rclone)
-;;; TODO:
-
-;; * If possible, get rid of "rclone mount". Maybe it is more
-;; performant then.
-
;;; tramp-rclone.el ends here
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index bcdc014daba..f00434c1468 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -46,7 +46,6 @@
(defconst tramp-default-remote-shell "/bin/sh"
"The default remote shell Tramp applies.")
-;;;###tramp-autoload
(defcustom tramp-inline-compress-start-size 4096
"The minimum size of compressing where inline transfer.
When inline transfer, compress transferred data of file whose
@@ -56,23 +55,12 @@ If it is nil, no compression at all will be applied."
:group 'tramp
:type '(choice (const nil) integer))
-;;;###tramp-autoload
(defcustom tramp-copy-size-limit 10240
"Maximum file size where inline copying is preferred to an out-of-the-band copy.
If it is nil, out-of-the-band copy will be used without a check."
:group 'tramp
:type '(choice (const nil) integer))
-;;;###tramp-autoload
-(defcustom tramp-terminal-type "dumb"
- "Value of TERM environment variable for logging in to remote host.
-Because Tramp wants to parse the output of the remote shell, it is easily
-confused by ANSI color escape sequences and suchlike. Often, shell init
-files conditionalize this setup based on the TERM environment variable."
- :group 'tramp
- :type 'string)
-
-;;;###tramp-autoload
(defcustom tramp-histfile-override "~/.tramp_history"
"When invoking a shell, override the HISTFILE with this value.
When setting to a string, it redirects the shell history to that
@@ -115,13 +103,12 @@ detected as prompt when being sent on echoing hosts, therefore.")
(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
"String used to recognize end of heredoc strings.")
-;;;###tramp-autoload
-(defcustom tramp-use-ssh-controlmaster-options t
+(defcustom tramp-use-ssh-controlmaster-options (not (eq system-type 'windows-nt))
"Whether to use `tramp-ssh-controlmaster-options'.
Set it to nil, if you use Control* or Proxy* options in your ssh
configuration."
:group 'tramp
- :version "24.4"
+ :version "28.1"
:type 'boolean)
(defvar tramp-ssh-controlmaster-options nil
@@ -138,6 +125,15 @@ depends on the installed local ssh version.
The string is used in `tramp-methods'.")
+(defvar tramp-scp-strict-file-name-checking nil
+ "Which scp strict file name checking argument to use.
+
+It is the string \"-T\" if supported by the local scp (since
+release 8.0), otherwise the string \"\". If it is nil, it will
+be auto-detected by Tramp.
+
+The string is used in `tramp-methods'.")
+
;; Initialize `tramp-methods' with the supported methods.
;;;###tramp-autoload
(tramp--with-startup
@@ -173,8 +169,8 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
- (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
- ("-r") ("%c")))
+ (tramp-copy-args (("-P" "%p") ("-p" "%k")
+ ("%x") ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(add-to-list 'tramp-methods
@@ -182,14 +178,15 @@ The string is used in `tramp-methods'.")
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("-t" "-t")
- ("-o" "RemoteCommand='%l'") ("%h")))
+ ("-o" "RemoteCommand=\"%l\"")
+ ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
- ("-q") ("-r") ("%c")))
+ ("%x") ("-q") ("-r") ("%c")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(add-to-list 'tramp-methods
@@ -238,7 +235,8 @@ The string is used in `tramp-methods'.")
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("-t" "-t")
- ("-o" "RemoteCommand='%l'") ("%h")))
+ ("-o" "RemoteCommand=\"%l\"")
+ ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@@ -412,16 +410,34 @@ The string is used in `tramp-methods'.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-ssh
- '((tramp-parse-rhosts "/etc/hosts.equiv")
+ `((tramp-parse-rhosts "/etc/hosts.equiv")
(tramp-parse-rhosts "/etc/shosts.equiv")
- (tramp-parse-shosts "/etc/ssh_known_hosts")
- (tramp-parse-sconfig "/etc/ssh_config")
+ ;; On W32 systems, the ssh directory is located somewhere else.
+ (tramp-parse-shosts ,(expand-file-name
+ "ssh/ssh_known_hosts"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "ProgramData"))
+ "/etc/")))
+ (tramp-parse-sconfig ,(expand-file-name
+ "ssh/ssh_config"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "ProgramData"))
+ "/etc/")))
(tramp-parse-shostkeys "/etc/ssh2/hostkeys")
(tramp-parse-sknownhosts "/etc/ssh2/knownhosts")
(tramp-parse-rhosts "~/.rhosts")
(tramp-parse-rhosts "~/.shosts")
- (tramp-parse-shosts "~/.ssh/known_hosts")
- (tramp-parse-sconfig "~/.ssh/config")
+ ;; On W32 systems, the .ssh directory is located somewhere else.
+ (tramp-parse-shosts ,(expand-file-name
+ ".ssh/known_hosts"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "USERPROFILE"))
+ "~/")))
+ (tramp-parse-sconfig ,(expand-file-name
+ ".ssh/config"
+ (or (and (eq system-type 'windows-nt)
+ (getenv "USERPROFILE"))
+ "~/")))
(tramp-parse-shostkeys "~/.ssh2/hostkeys")
(tramp-parse-sknownhosts "~/.ssh2/knownhosts"))
"Default list of (FUNCTION FILE) pairs to be examined for ssh methods.")
@@ -444,7 +460,7 @@ The string is used in `tramp-methods'.")
;;;###tramp-autoload
(defconst tramp-completion-function-alist-putty
`((tramp-parse-putty
- ,(if (memq system-type '(windows-nt))
+ ,(if (eq system-type 'windows-nt)
"HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions"
"~/.putty/sessions")))
"Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.")
@@ -477,70 +493,6 @@ The string is used in `tramp-methods'.")
(tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))
-;; "getconf PATH" yields:
-;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
-;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
-;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
-;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
-;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
-;; IRIX64: /usr/bin
-;; QNAP QTS: ---
-;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
-;;;###tramp-autoload
-(defcustom tramp-remote-path
- '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
- "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin"
- "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
- "/opt/bin" "/opt/sbin" "/opt/local/bin")
- "List of directories to search for executables on remote host.
-For every remote host, this variable will be set buffer local,
-keeping the list of existing directories on that host.
-
-You can use \"~\" in this list, but when searching for a shell which groks
-tilde expansion, all directory names starting with \"~\" will be ignored.
-
-`Default Directories' represent the list of directories given by
-the command \"getconf PATH\". It is recommended to use this
-entry on head of this list, because these are the default
-directories for POSIX compatible commands. On remote hosts which
-do not offer the getconf command (like cygwin), the value
-\"/bin:/usr/bin\" is used instead. This entry is represented in
-the list by the special value `tramp-default-remote-path'.
-
-`Private Directories' are the settings of the $PATH environment,
-as given in your `~/.profile'. This entry is represented in
-the list by the special value `tramp-own-remote-path'."
- :group 'tramp
- :type '(repeat (choice
- (const :tag "Default Directories" tramp-default-remote-path)
- (const :tag "Private Directories" tramp-own-remote-path)
- (string :tag "Directory"))))
-
-;;;###tramp-autoload
-(defcustom tramp-remote-process-environment
- '("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.
-
-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 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))
-
-;;;###tramp-autoload
(defcustom tramp-sh-extra-args
'(("/bash\\'" . "-noediting -norc -noprofile")
("/zsh\\'" . "-f +Z -V"))
@@ -567,6 +519,7 @@ shell from reading its init file."
(tramp-yn-prompt-regexp tramp-action-yn)
(tramp-terminal-prompt-regexp tramp-action-terminal)
(tramp-antispoof-regexp tramp-action-confirm-message)
+ (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-process-alive))
"List of pattern/action pairs.
Whenever a pattern matches, the corresponding action is performed.
@@ -584,6 +537,7 @@ corresponding PATTERN matches, the ACTION function is called.")
'((tramp-password-prompt-regexp tramp-action-password)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(tramp-copy-failed-regexp tramp-action-permission-denied)
+ (tramp-security-key-confirm-regexp tramp-action-show-and-confirm-message)
(tramp-process-alive-regexp tramp-action-out-of-band))
"List of pattern/action pairs.
This list is used for copying/renaming with out-of-band methods.
@@ -1010,6 +964,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(file-exists-p . tramp-sh-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-sh-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-sh-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -1018,7 +973,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(file-name-directory . tramp-handle-file-name-directory)
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
;; `file-name-sans-versions' performed by default handler.
- (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p)
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
(file-notify-valid-p . tramp-handle-file-notify-valid-p)
@@ -1036,9 +991,11 @@ Format specifiers \"%s\" are replaced before the script is used.")
(insert-directory . tramp-sh-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
;; `make-directory-internal' performed by default handler.
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . tramp-sh-handle-make-process)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
@@ -1057,6 +1014,7 @@ Format specifiers \"%s\" are replaced before the script is used.")
(tramp-get-remote-uid . tramp-sh-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sh-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
(write-region . tramp-sh-handle-write-region))
@@ -1626,49 +1584,6 @@ ID-FORMAT valid values are `string' and `integer'."
(or (tramp-check-cached-permissions v ?r)
(tramp-run-test "-r" filename)))))
-;; When the remote shell is started, it looks for a shell which groks
-;; tilde expansion. Here, we assume that all shells which grok tilde
-;; expansion will also provide a `test' command which groks `-nt' (for
-;; newer than). If this breaks, tell me about it and I'll try to do
-;; something smarter about it.
-(defun tramp-sh-handle-file-newer-than-file-p (file1 file2)
- "Like `file-newer-than-file-p' for Tramp files."
- (cond ((not (file-exists-p file1)) nil)
- ((not (file-exists-p file2)) t)
- (t ;; We are sure both files exist at this point. We try to
- ;; get the mtime of both files. If they are not equal to
- ;; the "dont-know" value, then we subtract the times and
- ;; obtain the result.
- (let ((fa1 (file-attributes file1))
- (fa2 (file-attributes file2)))
- (if (and
- (not
- (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time fa1)
- tramp-time-dont-know))
- (not
- (tramp-compat-time-equal-p
- (tramp-compat-file-attribute-modification-time fa2)
- tramp-time-dont-know)))
- (time-less-p
- (tramp-compat-file-attribute-modification-time fa2)
- (tramp-compat-file-attribute-modification-time fa1))
- ;; If one of them is the dont-know value, then we can
- ;; still try to run a shell command on the remote host.
- ;; However, this only works if both files are Tramp
- ;; files and both have the same method, same user, same
- ;; host.
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p file1) file1 file2) nil
- (tramp-error
- v 'file-error
- "Files %s and %s must have same method, user, host"
- file1 file2)))
- (with-parsed-tramp-file-name file1 nil
- (tramp-run-test2
- (tramp-get-test-nt-command v) file1 file2)))))))
-
;; Functions implemented using the basic functions above.
(defun tramp-sh-handle-file-directory-p (filename)
@@ -1825,7 +1740,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (string-match-p "/" filename)
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -1934,7 +1849,7 @@ ID-FORMAT valid values are `string' and `integer'."
'copy filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(tramp-run-real-handler
- 'copy-file
+ #'copy-file
(list filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
@@ -1975,7 +1890,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; We must do it file-wise.
(tramp-run-real-handler
- 'copy-directory
+ #'copy-directory
(list dirname newname keep-date parents copy-contents)))
;; When newname did exist, we have wrong cached values.
@@ -2031,7 +1946,7 @@ file names."
(length (tramp-compat-file-attribute-size
(file-attributes (file-truename filename))))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
+ (file-extended-attributes filename)))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
@@ -2107,7 +2022,7 @@ file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
+ (set-file-extended-attributes newname attributes)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
@@ -2318,7 +2233,7 @@ The method used must be an out-of-band method."
(t2 (tramp-tramp-file-p newname))
(orig-vec (tramp-dissect-file-name (if t1 filename newname)))
copy-program copy-args copy-env copy-keep-date listener spec
- options source target remote-copy-program remote-copy-args)
+ options source target remote-copy-program remote-copy-args p)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(if (and t1 t2)
@@ -2353,10 +2268,10 @@ The method used must be an out-of-band method."
#'identity)
(if t1
(tramp-make-copy-program-file-name v)
- (tramp-unquote-shell-quote-argument filename)))
+ (tramp-compat-file-name-unquote filename)))
target (if t2
(tramp-make-copy-program-file-name v)
- (tramp-unquote-shell-quote-argument newname)))
+ (tramp-compat-file-name-unquote newname)))
;; Check for user. There might be an interactive setting.
(setq user (or (tramp-file-name-user v)
@@ -2370,53 +2285,38 @@ The method used must be an out-of-band method."
(setq listener (number-to-string (+ 50000 (random 10000))))))
;; Compose copy command.
- (setq host (or host "")
- user (or user "")
- port (or port "")
- spec (format-spec-make
- ?t (tramp-get-connection-property
- (tramp-get-connection-process v) "temp-file" ""))
- options (format-spec (tramp-ssh-controlmaster-options v) spec)
- spec (format-spec-make
- ?h host ?u user ?p port ?r listener ?c options
- ?k (if keep-date " " "")
- ?n (concat "2>" (tramp-get-remote-null-device v)))
+ (setq options
+ (format-spec
+ (tramp-ssh-controlmaster-options v)
+ (format-spec-make
+ ?t (tramp-get-connection-property
+ (tramp-get-connection-process v) "temp-file" "")))
+ spec (list
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?r listener ?c options ?k (if keep-date " " "")
+ ?n (concat "2>" (tramp-get-remote-null-device v))
+ ?x (tramp-scp-strict-file-name-checking v))
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
v 'tramp-copy-keep-date)
-
copy-args
- (delete
- ;; " " has either been a replacement of "%k" (when
- ;; keep-date argument is non-nil), or a replacement
- ;; for the whole keep-date sublist.
- " "
- (dolist
- (x (tramp-get-method-parameter v 'tramp-copy-args) copy-args)
- (setq copy-args
- (append
- copy-args
- (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
- (if (member "" y) '(" ") y))))))
-
- copy-env
- (delq
- nil
+ ;; " " has either been a replacement of "%k" (when
+ ;; keep-date argument is non-nil), or a replacement for
+ ;; the whole keep-date sublist.
+ (delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
+ ;; `tramp-ssh-controlmaster-options' is a string instead
+ ;; of a list. Unflatten it.
+ copy-args
+ (tramp-compat-flatten-tree
(mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (string-join x " ")))
- (tramp-get-method-parameter v 'tramp-copy-env)))
-
+ (lambda (x) (if (tramp-compat-string-search " " x)
+ (split-string x) x))
+ copy-args))
+ copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
remote-copy-program
- (tramp-get-method-parameter v 'tramp-remote-copy-program))
-
- (dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args))
- (setq remote-copy-args
- (append
- remote-copy-args
- (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
- (if (member "" y) '(" ") y)))))
+ (tramp-get-method-parameter v 'tramp-remote-copy-program)
+ remote-copy-args
+ (apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
;; Check for local copy program.
(unless (executable-find copy-program)
@@ -2462,41 +2362,38 @@ The method used must be an out-of-band method."
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
- (while copy-env
+ (when copy-env
(tramp-message
- orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
- (setenv (pop copy-env) (pop copy-env)))
+ orig-vec 6 "%s=\"%s\""
+ (car copy-env) (string-join (cdr copy-env) " "))
+ (setenv (car copy-env) (string-join (cdr copy-env) " ")))
(setq
copy-args
(append
copy-args
(if remote-copy-program
(list (if t1 (concat ">" target) (concat "<" source)))
- (list source target))))
-
- ;; Use an asynchronous process. By this, password can
- ;; be handled. We don't set a timeout, because the
- ;; copying of large files can last longer than 60 secs.
- (let* ((command
- (mapconcat
- #'identity (append (list copy-program) copy-args)
- " "))
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- command))))
- (tramp-message orig-vec 6 "%s" command)
- (process-put p 'vector orig-vec)
- (process-put p 'adjust-window-size-function #'ignore)
- (set-process-query-on-exit-flag p nil)
-
- ;; We must adapt `tramp-local-end-of-line' for
- ;; sending the password.
- (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band))))
+ (list source target)))
+ ;; Use an asynchronous process. By this, password
+ ;; can be handled. We don't set a timeout, because
+ ;; the copying of large files can last longer than 60
+ ;; secs.
+ p (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (apply
+ #'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program copy-args)))
+ (tramp-message orig-vec 6 "%s" (string-join (process-command p) " "))
+ (process-put p 'vector orig-vec)
+ (process-put p 'adjust-window-size-function #'ignore)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; We must adapt `tramp-local-end-of-line' for
+ ;; sending the password.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band)))
;; Reset the transfer process properties.
(tramp-flush-connection-property v "process-name")
@@ -2684,12 +2581,9 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Check for "--dired" output.
- (forward-line -2)
- (when (looking-at-p "//SUBDIRED//")
- (forward-line -1))
- (when (looking-at "//DIRED//\\s-+")
- (let ((beg (match-end 0))
- (end (point-at-eol)))
+ (when (re-search-backward "^//DIRED//\\s-+\\(.+\\)$" nil 'noerror)
+ (let ((beg (match-beginning 1))
+ (end (match-end 0)))
;; Now read the numeric positions of file names.
(goto-char beg)
(while (< (point) end)
@@ -2699,7 +2593,7 @@ The method used must be an out-of-band method."
;; End is followed by \n or by " -> ".
(put-text-property start end 'dired-filename t))))))
;; Remove trailing lines.
- (goto-char (point-at-bol))
+ (beginning-of-line)
(while (looking-at "//")
(forward-line 1)
(delete-region (match-beginning 0) (point))))
@@ -2709,8 +2603,8 @@ The method used must be an out-of-band method."
(save-restriction
(narrow-to-region beg-marker end-marker)
;; Some busyboxes are reluctant to discard colors.
- (unless
- (string-match-p "color" (tramp-get-connection-property v "ls" ""))
+ (unless (tramp-compat-string-search
+ "color" (tramp-get-connection-property v "ls" ""))
(goto-char (point-min))
(while (re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "")))
@@ -2780,66 +2674,75 @@ the result will be a local, non-Tramp, file name."
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
- ;; Unless NAME is absolute, concat DIR and NAME.
- (unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
- ;; If connection is not established yet, run the real handler.
- (if (not (tramp-connectable-p name))
- (tramp-run-real-handler #'expand-file-name (list name nil))
- ;; Dissect NAME.
- (with-parsed-tramp-file-name name nil
- (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
- (setq localname (concat "~/" localname)))
- ;; Tilde expansion if necessary. This needs a shell which
- ;; groks tilde expansion! The function `tramp-find-shell' is
- ;; supposed to find such a shell on the remote host. Please
- ;; tell me about it when this doesn't work on your system.
- (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
- (let ((uname (match-string 1 localname))
- (fname (match-string 2 localname)))
- ;; We cannot simply apply "~/", because under sudo "~/" is
- ;; expanded to the local user home directory but to the
- ;; root home directory. On the other hand, using always
- ;; the default user name for tilde expansion is not
- ;; appropriate either, because ssh and companions might
- ;; use a user name from the config file.
- (when (and (string-equal uname "~")
- (string-match-p "\\`su\\(do\\)?\\'" method))
- (setq uname (concat uname user)))
- (setq uname
- (with-tramp-connection-property v uname
- (tramp-send-command
- v (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (buffer-substring (point) (point-at-eol)))))
- (setq localname (concat uname fname))))
- ;; There might be a double slash, for example when "~/"
- ;; expands to "/". Remove this.
- (while (string-match "//" localname)
- (setq localname (replace-match "/" t t localname)))
- ;; No tilde characters in file name, do normal
- ;; `expand-file-name' (this does "/./" and "/../").
- ;; `default-directory' is bound, because on Windows there would
- ;; be problems with UNC shares or Cygwin mounts.
- (let ((default-directory (tramp-compat-temporary-file-directory)))
- (tramp-make-tramp-file-name
- v (tramp-drop-volume-letter
- (tramp-run-real-handler
- #'expand-file-name (list localname))))))))
+ ;; On MS Windows, some special file names are not returned properly
+ ;; by `file-name-absolute-p'.
+ (if (and (eq system-type 'windows-nt)
+ (string-match-p
+ (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name))
+ (tramp-run-real-handler #'expand-file-name (list name dir))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (tramp-compat-file-name-concat dir name)))
+ ;; If connection is not established yet, run the real handler.
+ (if (not (tramp-connectable-p name))
+ (tramp-run-real-handler #'expand-file-name (list name nil))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ (unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
+ (setq localname (concat "~/" localname)))
+ ;; Tilde expansion if necessary. This needs a shell which
+ ;; groks tilde expansion! The function `tramp-find-shell' is
+ ;; supposed to find such a shell on the remote host. Please
+ ;; tell me about it when this doesn't work on your system.
+ (when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname)))
+ ;; We cannot simply apply "~/", because under sudo "~/" is
+ ;; expanded to the local user home directory but to the
+ ;; root home directory. On the other hand, using always
+ ;; the default user name for tilde expansion is not
+ ;; appropriate either, because ssh and companions might
+ ;; use a user name from the config file.
+ (when (and (string-equal uname "~")
+ (string-match-p "\\`su\\(do\\)?\\'" method))
+ (setq uname (concat uname user)))
+ (setq uname
+ (with-tramp-connection-property v uname
+ (tramp-send-command
+ v
+ (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-min))
+ (buffer-substring (point) (point-at-eol)))))
+ (setq localname (concat uname fname))))
+ ;; There might be a double slash, for example when "~/"
+ ;; expands to "/". Remove this.
+ (while (string-match "//" localname)
+ (setq localname (replace-match "/" t t localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
+ ;; No tilde characters in file name, do normal
+ ;; `expand-file-name' (this does "/./" and "/../").
+ ;; `default-directory' is bound, because on Windows there
+ ;; would be problems with UNC shares or Cygwin mounts.
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ v (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ #'expand-file-name (list localname)))))))))
;;; Remote commands:
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
-;; The complete STDERR buffer is available only when the process has
-;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files.
-STDERR can also be a file name. If method parameter `tramp-direct-async'
-and connection property \"direct-async-process\" are non-nil, an
-alternative implementation will be used."
+STDERR can also be a remote file name. If method parameter
+`tramp-direct-async' and connection property
+\"direct-async-process\" are non-nil, an alternative
+implementation will be used."
(if (tramp-direct-async-process-p args)
(apply #'tramp-handle-make-process args)
(when args
@@ -2849,7 +2752,10 @@ alternative implementation will be used."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (if (plist-member args :connection-type)
+ (plist-get args :connection-type)
+ tramp-process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -2865,7 +2771,7 @@ alternative implementation will be used."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (unless (memq connection-type '(nil pipe t pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -2873,7 +2779,7 @@ alternative implementation will be used."
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'bufferp stderr)))
- (when (and (stringp stderr) (tramp-tramp-file-p stderr)
+ (when (and (stringp stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
@@ -2885,9 +2791,9 @@ alternative implementation will be used."
;; STDERR can also be a file name.
(tmpstderr
(and stderr
- (if (and (stringp stderr) (tramp-tramp-file-p stderr))
- (tramp-unquote-file-local-name stderr)
- (tramp-make-tramp-temp-file v))))
+ (tramp-unquote-file-local-name
+ (if (stringp stderr)
+ stderr (tramp-make-tramp-temp-name v)))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
@@ -2896,7 +2802,8 @@ alternative implementation will be used."
;; "-c", it might be that the arguments exceed the
;; command line length. Therefore, we modify the
;; command.
- (heredoc (and (stringp program)
+ (heredoc (and (not (bufferp stderr))
+ (stringp program)
(string-match-p "sh$" program)
(= (length args) 2)
(string-equal "-c" (car args))
@@ -2925,18 +2832,13 @@ alternative implementation will be used."
(env (dolist (elt (cons prompt process-environment) env)
(or (member
elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
+ (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv)))))))
+ (setq uenv (cons elt uenv))))))
+ (env (setenv-internal
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(command
(when (stringp program)
- (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep)
(format "cd %s && %s exec %s %s env %s %s"
(tramp-shell-quote-argument localname)
(if uenv
@@ -2965,6 +2867,23 @@ alternative implementation will be used."
tramp-current-connection
p)
+ ;; Handle error buffer.
+ (when (bufferp stderr)
+ (with-current-buffer stderr
+ (setq buffer-read-only nil))
+ ;; Create named pipe.
+ (tramp-send-command v (format "mknod %s p" tmpstderr))
+ ;; Create stderr process.
+ (make-process
+ :name (buffer-name stderr)
+ :buffer stderr
+ :command `("cat" ,tmpstderr)
+ :coding coding
+ :noquery t
+ :filter nil
+ :sentinel #'ignore
+ :file-handler t))
+
(while (get-process name1)
;; NAME must be unique as process name.
(setq i (1+ i)
@@ -2993,16 +2912,16 @@ alternative implementation will be used."
(if (symbolp coding) coding (cdr coding))))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
- ;; We call `tramp-maybe-open-connection', in
- ;; order 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 $$")))
+ (setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
+ ;; Disable carriage return to newline translation.
+ (when (memq connection-type '(nil pipe))
+ (tramp-send-command v "stty -icrnl"))
;; `tramp-maybe-open-connection' and
;; `tramp-send-command-and-read' could have
;; trashed the connection buffer. Remove this.
@@ -3030,40 +2949,22 @@ alternative implementation will be used."
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
- ;; We must flush them here already; otherwise
- ;; `rename-file', `delete-file' or
- ;; `insert-file-contents' will fail.
- (tramp-flush-connection-property v "process-name")
- (tramp-flush-connection-property v "process-buffer")
- ;; Copy tmpstderr file.
- (when (and (stringp stderr)
- (not (tramp-tramp-file-p stderr)))
- (add-function
- :after (process-sentinel p)
- (lambda (_proc _msg)
- (rename-file remote-tmpstderr stderr))))
- ;; Provide error buffer. This shows only
- ;; initial error messages; messages arriving
- ;; later on will be inserted when the process
- ;; is deleted. The temporary file will exist
- ;; until the process is deleted.
+ ;; Kill stderr process delete and named pipe.
(when (bufferp stderr)
- (with-current-buffer stderr
- (insert-file-contents-literally remote-tmpstderr))
- ;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
- (when (file-exists-p remote-tmpstderr)
- (with-current-buffer stderr
- (insert-file-contents-literally
- remote-tmpstderr nil nil nil 'replace))
+ (ignore-errors
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))
+ (delete-process (get-buffer-process stderr)))
+ (ignore-errors
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
;; Save exit.
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (string-prefix-p tramp-temp-buffer-name (buffer-name))
(ignore-errors
(set-process-buffer p nil)
(kill-buffer (current-buffer)))
@@ -3137,7 +3038,7 @@ alternative implementation will be used."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let (command env uenv input tmpinput stderr tmpstderr outbuf ret)
;; Compute command.
(setq command (mapconcat #'tramp-shell-quote-argument
@@ -3145,16 +3046,10 @@ alternative implementation will be used."
;; We use as environment the difference to toplevel `process-environment'.
(dolist (elt process-environment)
(or (member elt (default-toplevel-value 'process-environment))
- (if (string-match-p "=" elt)
+ (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt)))
- (if (tramp-get-env-with-u-option v)
- (setq env (append `("-u" ,elt) env))
- (setq uenv (cons elt uenv))))))
- (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep)
+ (setq uenv (cons elt uenv)))))
+ (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)
(when env
(setq command
(format
@@ -3350,11 +3245,11 @@ alternative implementation will be used."
(run-hooks 'tramp-handle-file-local-copy-hook)
tmpfile)))
-;; CCC grok LOCKNAME
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -3363,25 +3258,31 @@ alternative implementation will be used."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let ((uid (or (tramp-compat-file-attribute-user-id
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
(tramp-get-remote-uid v 'integer)))
(gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer))))
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(if (and (tramp-local-host-p v)
;; `file-writable-p' calls `file-expand-file-name'. We
;; cannot use `tramp-run-real-handler' therefore.
- (let (file-name-handler-alist)
- (and
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))))
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (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))
+ (let ((create-lockfiles (not file-locked)))
+ (write-region start end localname append 'no-message lockname))
(let* ((modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
@@ -3414,13 +3315,11 @@ alternative implementation will be used."
;; file. We call `set-visited-file-modtime' ourselves later
;; on. We must ensure that `file-coding-system-alist'
;; matches `tmpfile'.
- (let (file-name-handler-alist
- (file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile)))
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile))
+ create-lockfiles)
(condition-case err
- (tramp-run-real-handler
- #'write-region
- (list start end tmpfile append 'no-message lockname))
+ (write-region start end tmpfile append 'no-message)
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
@@ -3589,6 +3488,12 @@ alternative implementation will be used."
;; Set the ownership.
(when need-chown
(tramp-set-file-uid-gid filename uid gid))
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
(tramp-message v 0 "Wrote %s" filename))
@@ -3762,6 +3667,8 @@ Fall back to normal file name handler if no Tramp handler exists."
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
(let ((default-directory (file-name-directory file-name))
+ (process-environment
+ (cons "GIO_USE_FILE_MONITOR=help" process-environment))
command events filter p sequence)
(cond
;; "inotifywait".
@@ -3794,18 +3701,6 @@ Fall back to normal file name handler if no Tramp handler exists."
'(created changed changes-done-hint moved deleted))
((memq 'attribute-change flags) '(attribute-changed)))
sequence `(,command "monitor" ,localname)))
- ;; "gvfs-monitor-dir".
- ((setq command (tramp-get-remote-gvfs-monitor-dir v))
- (setq filter #'tramp-sh-gvfs-monitor-dir-process-filter
- events
- (cond
- ((and (memq 'change flags) (memq 'attribute-change flags))
- '(created changed changes-done-hint moved deleted
- attribute-changed))
- ((memq 'change flags)
- '(created changed changes-done-hint moved deleted))
- ((memq 'attribute-change flags) '(attribute-changed)))
- sequence `(,command ,localname)))
;; None.
(t (tramp-error
v 'file-notify-error
@@ -3838,10 +3733,6 @@ Fall back to normal file name handler if no Tramp handler exists."
(unless (process-live-p p)
(tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name))
- ;; Set "gio-file-monitor" property if needed.
- (when (string-equal (file-name-nondirectory command) "gio")
- (tramp-set-connection-property
- p "gio-file-monitor" (tramp-get-remote-gio-file-monitor v)))
p))))
(defun tramp-sh-gio-monitor-process-filter (proc string)
@@ -3850,7 +3741,8 @@ Fall back to normal file name handler if no Tramp handler exists."
(remote-prefix
(with-current-buffer (process-buffer proc)
(file-remote-p default-directory)))
- (rest-string (process-get proc 'rest-string)))
+ (rest-string (process-get proc 'rest-string))
+ pos)
(when rest-string
(tramp-message proc 10 "Previous string:\n%s" rest-string))
(tramp-message proc 6 "%S\n%s" proc string)
@@ -3862,93 +3754,72 @@ Fall back to normal file name handler if no Tramp handler exists."
"changes done" "changes-done-hint" string)
string (tramp-compat-string-replace
"renamed to" "moved" string))
- ;; https://bugs.launchpad.net/bugs/1742946
- (when
- (string-match-p "Monitoring not supported\\|No locations given" string)
- (delete-process proc))
-
- ;; Delete empty lines.
- (setq string (tramp-compat-string-replace "\n\n" "\n" string))
-
- (while (string-match
- (eval-when-compile
- (concat "^[^:]+:"
- "[[:space:]]\\([^:]+\\):"
- "[[:space:]]" (regexp-opt tramp-gio-events t)
- "\\([[:space:]]\\([^:]+\\)\\)?$"))
- string)
-
- (let* ((file (match-string 1 string))
- (file1 (match-string 4 string))
- (object
- (list
- proc
- (list
- (intern-soft (match-string 2 string)))
- ;; File names are returned as absolute paths. We must
- ;; add the remote prefix.
- (concat remote-prefix file)
- (when file1 (concat remote-prefix file1)))))
- (setq string (replace-match "" nil nil string))
- ;; Usually, we would add an Emacs event now. Unfortunately,
- ;; `unread-command-events' does not accept several events at
- ;; once. Therefore, we apply the handler directly.
- (when (member (cl-caadr object) events)
- (tramp-compat-funcall
- (lookup-key special-event-map [file-notify])
- `(file-notify ,object file-notify-callback)))))
- ;; Save rest of the string.
- (when (zerop (length string)) (setq string nil))
- (when string (tramp-message proc 10 "Rest string:\n%s" string))
- (process-put proc 'rest-string string)))
-
-(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string)
- "Read output from \"gvfs-monitor-dir\" and add corresponding \
-`file-notify' events."
- (let ((events (process-get proc 'events))
- (remote-prefix
- (with-current-buffer (process-buffer proc)
- (file-remote-p default-directory)))
- (rest-string (process-get proc 'rest-string)))
- (when rest-string
- (tramp-message proc 10 "Previous string:\n%s" rest-string))
- (tramp-message proc 6 "%S\n%s" proc string)
- (setq string (concat rest-string string)
- ;; Attribute change is returned in unused wording.
- string (tramp-compat-string-replace
- "ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
-
- (while (string-match
- (concat "^[\n\r]*"
- "Directory Monitor Event:[\n\r]+"
- "Child = \\([^\n\r]+\\)[\n\r]+"
- "\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
- "Event = \\([^[:blank:]]+\\)[\n\r]+")
- string)
- (let* ((file (match-string 1 string))
- (file1 (match-string 3 string))
- (object
- (list
- proc
- (list
- (intern-soft
- (tramp-compat-string-replace
- "_" "-" (downcase (match-string 4 string)))))
- ;; File names are returned as absolute paths. We must
- ;; add the remote prefix.
- (concat remote-prefix file)
- (when file1 (concat remote-prefix file1)))))
- (setq string (replace-match "" nil nil string))
- ;; Usually, we would add an Emacs event now. Unfortunately,
- ;; `unread-command-events' does not accept several events at
- ;; once. Therefore, we apply the handler directly.
- (when (member (cl-caadr object) events)
- (tramp-compat-funcall
- (lookup-key special-event-map [file-notify])
- `(file-notify ,object file-notify-callback)))))
+ (catch 'doesnt-work
+ ;; https://bugs.launchpad.net/bugs/1742946
+ (when
+ (string-match-p "Monitoring not supported\\|No locations given" string)
+ (delete-process proc)
+ (throw 'doesnt-work nil))
+
+ ;; Determine monitor name.
+ (unless (tramp-connection-property-p proc "gio-file-monitor")
+ (tramp-set-connection-property
+ proc "gio-file-monitor"
+ (cond
+ ;; We have seen this on cygwin gio and on emba. Let's make
+ ;; some assumptions.
+ ((string-match
+ "Can't find module 'help' specified in GIO_USE_FILE_MONITOR" string)
+ (setq pos (match-end 0))
+ (cond
+ ((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor)
+ ((eq system-type 'cygwin) 'GPollFileMonitor)
+ (t nil)))
+ ;; TODO: What happens, if several monitor names are reported?
+ ((string-match "\
+Supported arguments for GIO_USE_FILE_MONITOR environment variable:
+\\s-*\\([[:alpha:]]+\\) - 20" string)
+ (setq pos (match-end 0))
+ (intern
+ (format "G%sFileMonitor" (capitalize (match-string 1 string)))))
+ (t (setq pos (length string)) nil)))
+ (setq string (substring string pos)))
+
+ ;; Delete empty lines.
+ (setq string (tramp-compat-string-replace "\n\n" "\n" string))
+
+ (while (string-match
+ (eval-when-compile
+ (concat "^[^:]+:"
+ "[[:space:]]\\([^:]+\\):"
+ "[[:space:]]" (regexp-opt tramp-gio-events t)
+ "\\([[:space:]]\\([^:]+\\)\\)?$"))
+ string)
+
+ (let* ((file (match-string 1 string))
+ (file1 (match-string 4 string))
+ (object
+ (list
+ proc
+ (list
+ (intern-soft (match-string 2 string)))
+ ;; File names are returned as absolute paths. We
+ ;; must add the remote prefix.
+ (concat remote-prefix file)
+ (when file1 (concat remote-prefix file1)))))
+ (setq string (replace-match "" nil nil string))
+ ;; Usually, we would add an Emacs event now. Unfortunately,
+ ;; `unread-command-events' does not accept several events at
+ ;; once. Therefore, we apply the handler directly.
+ (when (member (cl-caadr object) events)
+ (tramp-compat-funcall
+ (lookup-key special-event-map [file-notify])
+ `(file-notify ,object file-notify-callback))))))
;; Save rest of the string.
+ (while (string-match "^\n" string)
+ (setq string (replace-match "" nil nil string)))
(when (zerop (length string)) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(process-put proc 'rest-string string)))
@@ -4098,24 +3969,6 @@ Returns the exit code of the `test' program."
switch
(tramp-shell-quote-argument localname)))))
-(defun tramp-run-test2 (format-string file1 file2)
- "Run `test'-like program on the remote system, given FILE1, FILE2.
-FORMAT-STRING contains the program name, switches, and place holders.
-Returns the exit code of the `test' program. Barfs if the methods,
-hosts, or files, disagree."
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
- (tramp-error
- v 'file-error
- "tramp-run-test2 only implemented for same method, user, host")))
- (with-parsed-tramp-file-name file1 v1
- (with-parsed-tramp-file-name file1 v2
- (tramp-send-command-and-check
- v1
- (format format-string
- (tramp-shell-quote-argument v1-localname)
- (tramp-shell-quote-argument v2-localname))))))
-
(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
@@ -4307,10 +4160,9 @@ file exists and nonzero exit status otherwise."
(tramp-send-command
vec (format
(concat
- "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "exec env TERM='%s' INSIDE_EMACS='%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")
- tramp-terminal-type
- (or (getenv "INSIDE_EMACS") emacs-version) tramp-version
+ tramp-terminal-type (tramp-inside-emacs)
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -4463,7 +4315,7 @@ process to set up. VEC specifies the connection."
;; Use MULE to select the right EOL convention for communicating
;; with the process.
(let ((cs (or (and (memq 'utf-8-hfs (coding-system-list))
- (string-match-p "^Darwin" uname)
+ (string-prefix-p "Darwin" uname)
(cons 'utf-8-hfs 'utf-8-hfs))
(and (memq 'utf-8 (coding-system-list))
(string-match-p "utf-?8" (tramp-get-remote-locale vec))
@@ -4476,7 +4328,7 @@ process to set up. VEC specifies the connection."
cs-encode (or (cdr cs) 'undecided)
cs-encode
(coding-system-change-eol-conversion
- cs-encode (if (string-match-p "^Darwin" uname) 'mac 'unix)))
+ cs-encode (if (string-prefix-p "Darwin" uname) 'mac 'unix)))
(tramp-send-command vec "(echo foo ; echo bar)" t)
(goto-char (point-min))
(when (search-forward "\r" nil t)
@@ -4526,7 +4378,7 @@ process to set up. VEC specifies the connection."
;; IRIX64 bash expands "!" even when in single quotes. This
;; destroys our shell functions, we must disable it. See
;; <https://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
- (when (string-match-p "^IRIX64" uname)
+ (when (string-prefix-p "IRIX64" uname)
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
@@ -4782,12 +4634,12 @@ means standard output and thus the current buffer), or nil (which
means discard it)."
(tramp-call-process
nil tramp-encoding-shell
- (when (and input (not (string-match-p "%s" cmd))) input)
+ (when (and input (not (tramp-compat-string-search "%s" cmd))) input)
(if (eq output t) t nil)
nil
tramp-encoding-command-switch
(concat
- (if (string-match-p "%s" cmd) (format cmd input) cmd)
+ (if (tramp-compat-string-search "%s" cmd) (format cmd input) cmd)
(if (stringp output) (concat " >" output) ""))))
(defconst tramp-inline-compress-commands
@@ -4918,6 +4770,33 @@ Goes through the list `tramp-inline-compress-commands'."
" -o ControlPersist=no")))))))))
tramp-ssh-controlmaster-options)))
+(defun tramp-scp-strict-file-name-checking (vec)
+ "Return the strict file name checking argument of the local scp."
+ (cond
+ ;; No options to be computed.
+ ((null (assoc "%x" (tramp-get-method-parameter vec 'tramp-copy-args)))
+ "")
+
+ ;; There is already a value to be used.
+ ((stringp tramp-scp-strict-file-name-checking)
+ tramp-scp-strict-file-name-checking)
+
+ ;; Determine the options.
+ (t (setq tramp-scp-strict-file-name-checking "")
+ (let ((case-fold-search t))
+ (ignore-errors
+ (when (executable-find "scp")
+ (with-tramp-progress-reporter
+ vec 4 "Computing strict file name argument"
+ (with-temp-buffer
+ (tramp-call-process vec "scp" nil t nil "-T")
+ (goto-char (point-min))
+ (unless
+ (search-forward-regexp
+ "\\(illegal\\|unknown\\) option -- T" nil t)
+ (setq tramp-scp-strict-file-name-checking "-T")))))))
+ tramp-scp-strict-file-name-checking)))
+
(defun tramp-timeout-session (vec)
"Close the connection VEC after a session timeout.
If there is just some editing, retry it after 5 seconds."
@@ -4927,7 +4806,7 @@ If there is just some editing, retry it after 5 seconds."
(progn
(tramp-message
vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
- (run-at-time 5 nil 'tramp-timeout-session vec))
+ (run-at-time 5 nil #'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
(tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
@@ -4982,10 +4861,12 @@ connection if a previous connection has died for some reason."
(with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
- (format "Opening connection for %s using %s"
+ (format "Opening connection %s for %s using %s"
+ process-name
(tramp-file-name-host vec)
(tramp-file-name-method vec))
- (format "Opening connection for %s@%s using %s"
+ (format "Opening connection %s for %s@%s using %s"
+ process-name
(tramp-file-name-user vec)
(tramp-file-name-host vec)
(tramp-file-name-method vec)))
@@ -5058,19 +4939,17 @@ connection if a previous connection has died for some reason."
(l-domain (tramp-file-name-domain hop))
(l-host (tramp-file-name-host hop))
(l-port (tramp-file-name-port hop))
- (login-program
- (tramp-get-method-parameter hop 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter hop 'tramp-login-args))
(remote-shell
(tramp-get-method-parameter hop 'tramp-remote-shell))
(extra-args (tramp-get-sh-extra-args remote-shell))
(async-args
- (tramp-get-method-parameter hop 'tramp-async-args))
+ (tramp-compat-flatten-tree
+ (tramp-get-method-parameter hop 'tramp-async-args)))
(connection-timeout
(tramp-get-method-parameter
hop 'tramp-connection-timeout))
- (command login-program)
+ (command
+ (tramp-get-method-parameter hop 'tramp-login-program))
;; We don't create the temporary file. In
;; fact, it is just a prefix for the
;; ControlPath option of ssh; the real
@@ -5084,11 +4963,7 @@ connection if a previous connection has died for some reason."
(with-tramp-connection-property
(tramp-get-process vec) "temp-file"
(tramp-compat-make-temp-name)))
- spec r-shell)
-
- ;; Add arguments for asynchronous processes.
- (when (and process-name async-args)
- (setq login-args (append async-args login-args)))
+ r-shell)
;; Check, whether there is a restricted shell.
(dolist (elt tramp-restricted-shell-hosts-alist)
@@ -5113,31 +4988,24 @@ connection if a previous connection has died for some reason."
;; Replace `login-args' place holders.
(setq
- l-host (or l-host "")
- l-user (or l-user "")
- l-port (or l-port "")
- spec (format-spec-make ?t tmpfile)
- options (format-spec options spec)
- spec (format-spec-make
- ?h l-host ?u l-user ?p l-port ?c options
- ?l (concat remote-shell " " extra-args " -i"))
command
- (concat
- ;; We do not want to see the trailing local
- ;; prompt in `start-file-process'.
- (unless r-shell "exec ")
- command " "
- (mapconcat
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (string-join x " ")))
- login-args " ")
- ;; Local shell could be a Windows COMSPEC. It
- ;; doesn't know the ";" syntax, but we must exit
- ;; always for `start-file-process'. It could
- ;; also be a restricted shell, which does not
- ;; allow "exec".
- (when r-shell " && exit || exit")))
+ (mapconcat
+ #'identity
+ (append
+ ;; We do not want to see the trailing local
+ ;; prompt in `start-file-process'.
+ (unless r-shell '("exec"))
+ `(,command)
+ ;; Add arguments for asynchronous processes.
+ (when process-name async-args)
+ (tramp-expand-args
+ hop 'tramp-login-args
+ ?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
+ ?c (format-spec options (format-spec-make ?t tmpfile))
+ ?l (concat remote-shell " " extra-args " -i"))
+ ;; A restricted shell does not allow "exec".
+ (when r-shell '("&&" "exit" "||" "exit")))
+ " "))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
@@ -5158,7 +5026,7 @@ connection if a previous connection has died for some reason."
(when (tramp-get-connection-property p "session-timeout" nil)
(run-at-time
(tramp-get-connection-property p "session-timeout" nil) nil
- 'tramp-timeout-session vec))
+ #'tramp-timeout-session vec))
;; Make initial shell settings.
(tramp-open-connection-setup-interactive-shell p vec)
@@ -5361,7 +5229,7 @@ Return ATTR."
(when (stringp (car attr))
(aset (nth 8 attr) 0 ?l)))
;; Convert directory indication bit.
- (when (string-match-p "^d" (nth 8 attr))
+ (when (string-prefix-p "d" (nth 8 attr))
(setcar attr t))
;; Convert symlink from `tramp-do-file-attributes-with-stat'.
;; Decode also multibyte string.
@@ -5423,15 +5291,16 @@ Return ATTR."
(directory-file-name (tramp-file-name-unquote-localname vec))))
(when (string-match-p tramp-ipv6-regexp host)
(setq host (format "[%s]" host)))
+ ;; This does not work for MS Windows scp, if there are characters
+ ;; to be quoted. OpenSSH 8 supports disabling of strict file name
+ ;; checking in scp, we use it when available.
(unless (string-match-p "ftp$" method)
- (setq localname (tramp-shell-quote-argument localname)))
+ (setq localname (tramp-unquote-shell-quote-argument localname)))
(cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
localname)
- ((not (zerop (length user)))
- (format
- "%s@%s:%s" user host (tramp-unquote-shell-quote-argument localname)))
- (t (format "%s:%s" host (tramp-unquote-shell-quote-argument localname))))))
+ ((zerop (length user)) (format "%s:%s" host localname))
+ (t (format "%s@%s:%s" user host localname)))))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
@@ -5459,8 +5328,7 @@ Nonexistent directories are removed from spec."
;; cache the result for the session only. Otherwise, the
;; result is cached persistently.
(if (memq 'tramp-own-remote-path tramp-remote-path)
- (tramp-get-process vec)
- vec)
+ (tramp-get-process vec) vec)
"remote-path"
(let* ((remote-path (copy-tree tramp-remote-path))
(elt1 (memq 'tramp-default-remote-path remote-path))
@@ -5478,7 +5346,7 @@ Nonexistent directories are removed from spec."
(progn
(tramp-message
vec 3
- "`getconf PATH' not successful, using default value \"%s\"."
+ "`getconf PATH' not successful, using default value \"%s\"."
"/bin:/usr/bin")
"/bin:/usr/bin"))))
(own-remote-path
@@ -5682,15 +5550,15 @@ Nonexistent directories are removed from spec."
;; Check whether stat(1) returns usable syntax. "%s" does not
;; work on older AIX systems. Recent GNU stat versions
;; (8.24?) use shell quoted format for "%N", we check the
- ;; boundaries "`" and "'", therefore. See Bug#23422 in
- ;; coreutils. Since GNU stat 8.26, environment variable
- ;; QUOTING_STYLE is supported.
+ ;; boundaries "`" and "'" and their localized variants,
+ ;; therefore. See Bug#23422 in coreutils. Since GNU stat
+ ;; 8.26, environment variable QUOTING_STYLE is supported.
(when result
(setq result (concat "env QUOTING_STYLE=locale " result)
tmp (tramp-send-command-and-read
vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror))
(unless (and (listp tmp) (stringp (car tmp))
- (string-match-p "^\\(`/'\\|‘/’\\)$" (car tmp))
+ (string-match-p "^[\"`‘„”«「]/[\"'’“”»」]$" (car tmp))
(integerp (cadr tmp)))
(setq result nil)))
result))))
@@ -5765,42 +5633,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-message vec 5 "Finding a suitable `gio-monitor' command")
(tramp-find-executable vec "gio" (tramp-get-remote-path vec) t t)))
-(defun tramp-get-remote-gio-file-monitor (vec)
- "Determine remote GFileMonitor."
- (with-tramp-connection-property vec "gio-file-monitor"
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 5 "Finding the used GFileMonitor")
- (when-let ((gio (tramp-get-remote-gio-monitor vec)))
- ;; Search for the used FileMonitor. There is no known way to
- ;; get this information directly from gio, so we check for
- ;; linked libraries of libgio.
- (when (tramp-send-command-and-check vec (concat "ldd " gio))
- (goto-char (point-min))
- (when (re-search-forward "\\S-+/libgio\\S-+")
- (when (tramp-send-command-and-check
- vec (concat "strings " (match-string 0)))
- (goto-char (point-min))
- (re-search-forward
- (format
- "^%s$"
- (regexp-opt
- '("GFamFileMonitor" "GFenFileMonitor"
- "GInotifyFileMonitor" "GKqueueFileMonitor")))
- nil 'noerror)
- (intern (match-string 0)))))))))
-
-(defun tramp-get-remote-gvfs-monitor-dir (vec)
- "Determine remote `gvfs-monitor-dir' command."
- (with-tramp-connection-property vec "gvfs-monitor-dir"
- (tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command")
- ;; We distinguish "gvfs-monitor-dir.exe" from cygwin in order to
- ;; establish better timeouts in filenotify-tests.el. Any better
- ;; distinction approach would be welcome!
- (or (tramp-find-executable
- vec "gvfs-monitor-dir.exe" (tramp-get-remote-path vec) t t)
- (tramp-find-executable
- vec "gvfs-monitor-dir" (tramp-get-remote-path vec) t t))))
-
(defun tramp-get-remote-inotifywait (vec)
"Determine remote `inotifywait' command."
(with-tramp-connection-property vec "inotifywait"
@@ -5945,16 +5777,6 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
(delete-file tmpfile)))))
-(defun tramp-get-env-with-u-option (vec)
- "Check, whether the remote `env' command supports the -u option."
- (with-tramp-connection-property vec "env-u-option"
- (tramp-message vec 5 "Checking, whether `env -u' works")
- ;; Option "-u" is a GNU extension.
- (tramp-send-command-and-check
- vec (format "env FOO=foo env -u FOO 2>%s | grep -qv FOO"
- (tramp-get-remote-null-device vec))
- t)))
-
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
"Return the compress command related to PROP.
@@ -5987,12 +5809,13 @@ function cell is returned to be applied on a buffer."
(with-tramp-connection-property (tramp-get-process vec) prop
(tramp-find-inline-encoding vec)
(tramp-get-connection-property (tramp-get-process vec) prop nil)))
- (prop1 (if (string-match-p "encoding" prop)
+ (prop1 (if (tramp-compat-string-search "encoding" prop)
"inline-compress" "inline-decompress"))
compress)
;; The connection property might have been cached. So we must
;; send the script to the remote side - maybe.
- (when (and coding (symbolp coding) (string-match-p "remote" prop))
+ (when (and coding (symbolp coding)
+ (tramp-compat-string-search "remote" prop))
(let ((name (symbol-name coding)))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
@@ -6004,7 +5827,7 @@ function cell is returned to be applied on a buffer."
;; Return the value.
(cond
((and compress (symbolp coding))
- (if (string-match-p "decompress" prop1)
+ (if (tramp-compat-string-search "decompress" prop1)
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
@@ -6023,16 +5846,16 @@ function cell is returned to be applied on a buffer."
(,coding (point-min) (point-max)))))
((symbolp coding)
coding)
- ((and compress (string-match-p "decoding" prop))
+ ((and compress (tramp-compat-string-search "decoding" prop))
(format
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
(cond
- ((and (string-match-p "local" prop)
- (memq system-type '(windows-nt)))
+ ((and (tramp-compat-string-search "local" prop)
+ (eq system-type 'windows-nt))
"(%s | \"%s\")")
- ((string-match-p "local" prop) "(%s | %s)")
+ ((tramp-compat-string-search "local" prop) "(%s | %s)")
(t "(%s | %s >%%s)"))
coding compress))
(compress
@@ -6040,14 +5863,14 @@ function cell is returned to be applied on a buffer."
;; Windows shells need the program file name after
;; the pipe symbol be quoted if they use forward
;; slashes as directory separators.
- (if (and (string-match-p "local" prop)
- (memq system-type '(windows-nt)))
+ (if (and (tramp-compat-string-search "local" prop)
+ (eq system-type 'windows-nt))
"(%s <%%s | \"%s\")"
"(%s <%%s | %s)")
compress coding))
- ((string-match-p "decoding" prop)
+ ((tramp-compat-string-search "decoding" prop)
(cond
- ((string-match-p "local" prop) (format "%s" coding))
+ ((tramp-compat-string-search "local" prop) (format "%s" coding))
(t (format "%s >%%s" coding))))
(t
(format "%s <%%s" coding)))))))
@@ -6143,8 +5966,6 @@ function cell is returned to be applied on a buffer."
;; session could be reused after a connection loss. Use dtach, or
;; screen, or tmux, or mosh.
;;
-;; * Implement `:stderr' of `make-process' as pipe process.
-
;; * One interesting solution (with other applications as well) would
;; be to stipulate, as a directory or connection-local variable, an
;; additional rc file on the remote machine that is sourced every
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 26ec910ecc8..69372449172 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -60,20 +60,17 @@
tramp-smb-method
'((tramp-parse-netrc "~/.netrc"))))
-;;;###tramp-autoload
(defcustom tramp-smb-program "smbclient"
"Name of SMB client to run."
:group 'tramp
:type 'string)
-;;;###tramp-autoload
(defcustom tramp-smb-acl-program "smbcacls"
"Name of SMB acls to run."
:group 'tramp
:type 'string
:version "24.4")
-;;;###tramp-autoload
(defcustom tramp-smb-conf null-device
"Path of the \"smb.conf\" file.
If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program'
@@ -81,7 +78,6 @@ call, letting the SMB client use the default one."
:group 'tramp
:type '(choice (const nil) (file :must-match t)))
-;;;###tramp-autoload
(defcustom tramp-smb-options nil
"List of additional options.
They are added to the `tramp-smb-program' call via \"--option '...'\".
@@ -251,6 +247,7 @@ See `tramp-actions-before-shell' for more info.")
(file-exists-p . tramp-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-smb-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions . tramp-smb-handle-file-name-all-completions)
(file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -277,9 +274,11 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
@@ -298,6 +297,7 @@ See `tramp-actions-before-shell' for more info.")
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-smb-handle-write-region))
@@ -305,7 +305,6 @@ See `tramp-actions-before-shell' for more info.")
Operations not mentioned here will be handled by the default Emacs primitives.")
;; Options for remote processes via winexe.
-;;;###tramp-autoload
(defcustom tramp-smb-winexe-program "winexe"
"Name of winexe client to run.
If it isn't found in the local $PATH, the absolute path of winexe
@@ -314,7 +313,6 @@ shall be given. This is needed for remote processes."
:type 'string
:version "24.3")
-;;;###tramp-autoload
(defcustom tramp-smb-winexe-shell-command "powershell.exe"
"Shell to be used for processes on remote machines.
This must be Powershell V2 compatible."
@@ -322,7 +320,6 @@ This must be Powershell V2 compatible."
:type 'string
:version "24.3")
-;;;###tramp-autoload
(defcustom tramp-smb-winexe-shell-command-switch "-file -"
"Command switch used together with `tramp-smb-winexe-shell-command'.
This can be used to disable echo etc."
@@ -539,7 +536,7 @@ arguments to pass to the OPERATION."
(tramp-process-actions p v nil tramp-smb-actions-with-tar)
(while (process-live-p p)
- (sit-for 0.1))
+ (sleep-for 0.1))
(tramp-message v 6 "\n%s" (buffer-string))))
;; Reset the transfer process properties.
@@ -725,7 +722,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -743,6 +740,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Make the file name absolute.
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; No tilde characters in file name, do normal
;; `expand-file-name' (this does "/./" and "/../").
(tramp-make-tramp-file-name
@@ -849,7 +849,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Check result.
(when entry
- (list (and (string-match-p "d" (nth 1 entry))
+ (list (and (tramp-compat-string-search "d" (nth 1 entry))
t) ;0 file type
-1 ;1 link count
uid ;2 uid
@@ -982,7 +982,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(mapcar
(lambda (x)
(list
- (if (string-match-p "d" (nth 1 x))
+ (if (tramp-compat-string-search "d" (nth 1 x))
(file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))
@@ -1021,7 +1021,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
- (string-match-p
+ (tramp-compat-string-search
"w"
(or (tramp-compat-file-attribute-modes (file-attributes filename)) ""))
(let ((dir (file-name-directory filename)))
@@ -1076,9 +1076,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Check for matching entries.
(mapcar
(lambda (x)
- (when (string-match-p
- (format "^%s" base) (nth 0 x))
- x))
+ (when (string-match-p (format "^%s" base) (nth 0 x)) x))
entries)
;; We just need the only and only entry FILENAME.
(list (assoc base entries)))))
@@ -1088,14 +1086,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(sort
entries
(lambda (x y)
- (if (string-match-p "t" switches)
+ (if (tramp-compat-string-search "t" switches)
;; Sort by date.
(time-less-p (nth 3 y) (nth 3 x))
;; Sort by name.
(string-lessp (nth 0 x) (nth 0 y))))))
;; Handle "-F" switch.
- (when (string-match-p "F" switches)
+ (when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
(unless (zerop (length (car x)))
@@ -1124,7 +1122,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(expand-file-name
(nth 0 x) (file-name-directory filename))
'string)))))
- (when (string-match-p "l" switches)
+ (when (tramp-compat-string-search "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
@@ -1153,7 +1151,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(put-text-property start (point) 'dired-filename t))
;; Insert symlink.
- (when (and (string-match-p "l" switches)
+ (when (and (tramp-compat-string-search "l" switches)
(stringp (tramp-compat-file-attribute-type attr)))
(insert " -> " (tramp-compat-file-attribute-type attr))))
@@ -1259,7 +1257,7 @@ component is used as the target of the symlink."
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
- (with-parsed-tramp-file-name default-directory nil
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let* ((name (file-name-nondirectory program))
(name1 name)
(i 0)
@@ -1551,7 +1549,7 @@ component is used as the target of the symlink."
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
- (if (string-match-p tramp-temp-buffer-name (buffer-name))
+ (if (tramp-compat-string-search tramp-temp-buffer-name (buffer-name))
(progn
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
@@ -1579,7 +1577,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -1588,15 +1587,25 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let ((curbuf (current-buffer))
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
(with-tramp-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
@@ -1623,6 +1632,11 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(file-attributes filename))
(current-time))))
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
;; The end.
(when (and (null noninteractive)
(or (eq visit t) (null visit) (stringp visit)))
@@ -1841,10 +1855,12 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)."
mode (or (match-string 1 line) "")
mode (format
"%s%s"
- (if (string-match-p "D" mode) "d" "-")
+ (if (tramp-compat-string-search "D" mode) "d" "-")
(mapconcat
(lambda (_x) "") " "
- (concat "r" (if (string-match-p "R" mode) "-" "w") "x")))
+ (format
+ "r%sx"
+ (if (tramp-compat-string-search "R" mode) "-" "w"))))
line (substring line 0 -6))
(cl-return))
@@ -1925,7 +1941,7 @@ If ARGUMENT is non-nil, use it as argument for
;; Check whether we still have the same smbclient version.
;; Otherwise, we must delete the connection cache, because
- ;; capabilities migh have changed.
+ ;; capabilities might have changed.
(unless (or argument (processp p))
(let ((default-directory (tramp-compat-temporary-file-directory))
(command (concat tramp-smb-program " -V")))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
new file mode 100644
index 00000000000..c5b84a6e4e4
--- /dev/null
+++ b/lisp/net/tramp-sshfs.el
@@ -0,0 +1,391 @@
+;;; tramp-sshfs.el --- Tramp access functions via sshfs -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, processes
+;; Package: tramp
+
+;; 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:
+
+;; sshfs is a program to mount a virtual file system, based on an sftp
+;; connection. Tramp uses its mount utility to access files and
+;; directories there.
+
+;; A remote file under sshfs control has the form
+;; "/sshfs:user@host#port:/path/to/file". User name and port number
+;; are optional.
+
+;;; Code:
+
+(require 'tramp)
+(require 'tramp-fuse)
+
+;;;###tramp-autoload
+(defconst tramp-sshfs-method "sshfs"
+ "Tramp method for sshfs mounts.")
+
+(defcustom tramp-sshfs-program "sshfs"
+ "The sshfs mount command."
+ :group 'tramp
+ :version "28.1"
+ :type 'string)
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (add-to-list 'tramp-methods
+ `(,tramp-sshfs-method
+ (tramp-mount-args (("-C") ("-p" "%p")
+ ("-o" "idmap=user,reconnect")))
+ ;; These are for remote processes.
+ (tramp-login-program "ssh")
+ (tramp-login-args (("-q")("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("%h") ("%l")))
+ (tramp-direct-async t)
+ (tramp-remote-shell ,tramp-default-remote-shell)
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))))
+
+ (add-to-list 'tramp-connection-properties
+ `(,(format "/%s:" tramp-sshfs-method) "direct-async-process" t))
+
+ (tramp-set-completion-function
+ tramp-sshfs-method tramp-completion-function-alist-ssh))
+
+
+;; New handlers should be added here.
+;;;###tramp-autoload
+(defconst tramp-sshfs-file-name-handler-alist
+ '((access-file . tramp-handle-access-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
+ ;; `byte-compiler-base-file-name' performed by default handler.
+ (copy-directory . tramp-handle-copy-directory)
+ (copy-file . tramp-sshfs-handle-copy-file)
+ (delete-directory . tramp-fuse-handle-delete-directory)
+ (delete-file . tramp-fuse-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler.
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-fuse-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-handle-directory-files-and-attributes)
+ (dired-compress-file . ignore)
+ (dired-uncache . tramp-handle-dired-uncache)
+ (exec-path . tramp-sshfs-handle-exec-path)
+ (expand-file-name . tramp-handle-expand-file-name)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
+ (file-acl . ignore)
+ (file-attributes . tramp-fuse-handle-file-attributes)
+ (file-directory-p . tramp-handle-file-directory-p)
+ (file-equal-p . tramp-handle-file-equal-p)
+ (file-executable-p . tramp-fuse-handle-file-executable-p)
+ (file-exists-p . tramp-handle-file-exists-p)
+ (file-in-directory-p . tramp-handle-file-in-directory-p)
+ (file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
+ (file-modes . tramp-handle-file-modes)
+ (file-name-all-completions . tramp-fuse-handle-file-name-all-completions)
+ (file-name-as-directory . tramp-handle-file-name-as-directory)
+ (file-name-case-insensitive-p . tramp-handle-file-name-case-insensitive-p)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler.
+ (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
+ (file-notify-add-watch . ignore)
+ (file-notify-rm-watch . ignore)
+ (file-notify-valid-p . ignore)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-fuse-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-remote-p . tramp-handle-file-remote-p)
+ (file-selinux-context . tramp-handle-file-selinux-context)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-sshfs-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
+ (file-writable-p . tramp-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `get-file-buffer' performed by default handler.
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-sshfs-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
+ (make-directory . tramp-fuse-handle-make-directory)
+ (make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
+ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
+ (make-process . tramp-handle-make-process)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
+ (process-file . tramp-sshfs-handle-process-file)
+ (rename-file . tramp-sshfs-handle-rename-file)
+ (set-file-acl . ignore)
+ (set-file-modes . tramp-sshfs-handle-set-file-modes)
+ (set-file-selinux-context . ignore)
+ (set-file-times . ignore)
+ (set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
+ (shell-command . tramp-handle-shell-command)
+ (start-file-process . tramp-handle-start-file-process)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (temporary-file-directory . tramp-handle-temporary-file-directory)
+ (tramp-get-remote-gid . ignore)
+ (tramp-get-remote-uid . ignore)
+ (tramp-set-file-uid-gid . ignore)
+ (unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
+ (write-region . tramp-sshfs-handle-write-region))
+"Alist of handler functions for Tramp SSHFS method.
+Operations not mentioned here will be handled by the default Emacs primitives.")
+
+;; It must be a `defsubst' in order to push the whole code into
+;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading.
+;;;###tramp-autoload
+(defsubst tramp-sshfs-file-name-p (filename)
+ "Check if it's a FILENAME for sshfs."
+ (and (tramp-tramp-file-p filename)
+ (string= (tramp-file-name-method (tramp-dissect-file-name filename))
+ tramp-sshfs-method)))
+
+;;;###tramp-autoload
+(defun tramp-sshfs-file-name-handler (operation &rest args)
+ "Invoke the sshfs handler for OPERATION and ARGS.
+First arg specifies the OPERATION, second arg is a list of
+arguments to pass to the OPERATION."
+ (if-let ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args)))
+
+;;;###tramp-autoload
+(tramp--with-startup
+ (tramp-register-foreign-file-name-handler
+ #'tramp-sshfs-file-name-p #'tramp-sshfs-file-name-handler))
+
+
+;; File name primitives.
+
+(defun tramp-sshfs-handle-copy-file
+ (filename newname &optional ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ "Like `copy-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ (if (file-directory-p filename)
+ (copy-directory filename newname keep-date t)
+ (copy-file
+ (if (tramp-sshfs-file-name-p filename)
+ (tramp-fuse-local-file-name filename) filename)
+ (if (tramp-sshfs-file-name-p newname)
+ (tramp-fuse-local-file-name newname) newname)
+ ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (when (tramp-sshfs-file-name-p newname)
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname)))))
+
+(defun tramp-sshfs-handle-exec-path ()
+ "Like `exec-path' for Tramp files."
+ (append
+ (with-parsed-tramp-file-name default-directory nil
+ (with-tramp-connection-property (tramp-get-process v) "remote-path"
+ (with-temp-buffer
+ (process-file "getconf" nil t nil "PATH")
+ (split-string
+ (progn
+ ;; Read the expression.
+ (goto-char (point-min))
+ (buffer-substring (point) (point-at-eol)))
+ ":" 'omit))))
+ ;; The equivalent to `exec-directory'.
+ `(,(tramp-file-local-name (expand-file-name default-directory)))))
+
+(defun tramp-sshfs-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ ;;`file-system-info' exists since Emacs 27.1.
+ (tramp-compat-funcall 'file-system-info (tramp-fuse-local-file-name filename)))
+
+(defun tramp-sshfs-handle-insert-file-contents
+ (filename &optional visit beg end replace)
+ "Like `insert-file-contents' for Tramp files."
+ (let ((result
+ (insert-file-contents
+ (tramp-fuse-local-file-name filename) visit beg end replace)))
+ (when visit (setq buffer-file-name filename))
+ (cons (expand-file-name filename) (cdr result))))
+
+(defun tramp-sshfs-handle-process-file
+ (program &optional infile destination display &rest args)
+ "Like `process-file' for Tramp files."
+ ;; The implementation is not complete yet.
+ (when (and (numberp destination) (zerop destination))
+ (error "Implementation does not handle immediate return"))
+
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let ((command
+ (format
+ "cd %s && exec %s"
+ localname
+ (mapconcat #'tramp-shell-quote-argument (cons program args) " "))))
+ (unwind-protect
+ (apply
+ #'tramp-call-process
+ v (tramp-get-method-parameter v 'tramp-login-program)
+ infile destination display
+ (tramp-expand-args
+ v 'tramp-login-args
+ ?h (or (tramp-file-name-host v) "")
+ ?u (or (tramp-file-name-user v) "")
+ ?p (or (tramp-file-name-port v) "")
+ ?l command))
+
+ (unless process-file-side-effects
+ (tramp-flush-directory-properties v ""))))))
+
+(defun tramp-sshfs-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (setq filename (expand-file-name filename)
+ newname (expand-file-name newname))
+ (rename-file
+ (if (tramp-sshfs-file-name-p filename)
+ (tramp-fuse-local-file-name filename) filename)
+ (if (tramp-sshfs-file-name-p newname)
+ (tramp-fuse-local-file-name newname) newname)
+ ok-if-already-exists)
+ (when (tramp-sshfs-file-name-p filename)
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)))
+ (when (tramp-sshfs-file-name-p newname)
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname))))
+
+(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
+ "Like `set-file-modes' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+ (tramp-flush-file-properties v localname)
+ (tramp-compat-set-file-modes
+ (tramp-fuse-local-file-name filename) mode flag))))
+
+(defun tramp-sshfs-handle-write-region
+ (start end filename &optional append visit lockname mustbenew)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
+ (with-parsed-tramp-file-name filename nil
+ (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 ((file-locked (eq (file-locked-p lockname) t)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
+ (let (create-lockfiles)
+ (write-region
+ start end (tramp-fuse-local-file-name filename) append 'nomessage)
+ (tramp-flush-file-properties v localname))
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))
+
+
+;; File name conversions.
+
+(defun tramp-sshfs-maybe-open-connection (vec)
+ "Maybe open a connection VEC.
+Does not do anything if a connection is already open, but re-opens the
+connection if a previous connection has died for some reason."
+ ;; During completion, don't reopen a new connection.
+ (unless (tramp-connectable-p vec)
+ (throw 'non-essential 'non-essential))
+
+ ;; We need a process bound to the connection buffer. Therefore, we
+ ;; create a dummy process. Maybe there is a better solution?
+ (unless (get-buffer-process (tramp-get-connection-buffer vec))
+ (let ((p (make-network-process
+ :name (tramp-get-connection-name vec)
+ :buffer (tramp-get-connection-buffer vec)
+ :server t :host 'local :service t :noquery t)))
+ (process-put p 'vector vec)
+ (set-process-query-on-exit-flag p nil)
+
+ ;; Mark process for filelock.
+ (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
+ ;; Set connection-local variables.
+ (tramp-set-connection-local-variables vec)
+
+ ;; Create directory.
+ (unless (file-directory-p (tramp-fuse-mount-point vec))
+ (make-directory (tramp-fuse-mount-point vec) 'parents))
+
+ (unless
+ (or (tramp-fuse-mounted-p vec)
+ (with-temp-buffer
+ (zerop
+ (apply
+ #'tramp-call-process
+ vec tramp-sshfs-program nil t nil
+ (tramp-fuse-mount-spec vec)
+ (tramp-fuse-mount-point vec)
+ (tramp-expand-args
+ vec 'tramp-mount-args
+ ?p (or (tramp-file-name-port vec) "")))))
+ (tramp-error
+ vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))))
+
+ ;; Mark it as connected.
+ (tramp-set-connection-property
+ (tramp-get-connection-process vec) "connected" t)))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; "{uid,gid}-{integer,string}" are used. We set them to proper values.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-sshfs 'force)))
+
+(provide 'tramp-sshfs)
+
+;;; tramp-sshfs.el ends here
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 0a60b791822..5895f1d25b5 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -88,6 +88,7 @@ See `tramp-actions-before-shell' for more info.")
(file-exists-p . tramp-sudoedit-handle-file-exists-p)
(file-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy)
+ (file-locked-p . tramp-handle-file-locked-p)
(file-modes . tramp-handle-file-modes)
(file-name-all-completions
. tramp-sudoedit-handle-file-name-all-completions)
@@ -115,9 +116,11 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
+ (lock-file . tramp-handle-lock-file)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sudoedit-handle-make-directory)
(make-directory-internal . ignore)
+ (make-lock-file-name . tramp-handle-make-lock-file-name)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-process . ignore)
(make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link)
@@ -136,6 +139,7 @@ See `tramp-actions-before-shell' for more info.")
(tramp-get-remote-uid . tramp-sudoedit-handle-get-remote-uid)
(tramp-set-file-uid-gid . tramp-sudoedit-handle-set-file-uid-gid)
(unhandled-file-name-directory . ignore)
+ (unlock-file . tramp-handle-unlock-file)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
(write-region . tramp-sudoedit-handle-write-region))
@@ -233,7 +237,7 @@ absolute file names."
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
- (apply #'file-extended-attributes (list filename))))
+ (file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
@@ -289,7 +293,7 @@ absolute file names."
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
- (apply #'set-file-extended-attributes (list newname attributes))))
+ (set-file-extended-attributes newname attributes)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
@@ -349,7 +353,7 @@ the result will be a local, non-Tramp, file name."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
(with-parsed-tramp-file-name name nil
;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory
@@ -364,6 +368,9 @@ the result will be a local, non-Tramp, file name."
(when (string-equal uname "~")
(setq uname (concat uname user)))
(setq localname (concat uname fname))))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
(tramp-make-tramp-file-name v (expand-file-name localname))))
@@ -647,7 +654,7 @@ component is used as the target of the symlink."
'rename filename newname ok-if-already-exists
'keep-date 'preserve-uid-gid)
(tramp-run-real-handler
- 'rename-file (list filename newname ok-if-already-exists))))
+ #'rename-file (list filename newname ok-if-already-exists))))
(defun tramp-sudoedit-handle-set-file-acl (filename acl-string)
"Like `set-file-acl' for Tramp files."
@@ -710,6 +717,7 @@ ID-FORMAT valid values are `string' and `integer'."
(defun tramp-sudoedit-handle-write-region
(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
(let* ((uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
@@ -718,13 +726,14 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer)))
(flag (and (eq mustbenew 'excl) 'nofollow))
- (modes (tramp-default-file-modes filename flag)))
+ (modes (tramp-default-file-modes filename flag))
+ (attributes (file-extended-attributes filename)))
(prog1
(tramp-handle-write-region
start end filename append visit lockname mustbenew)
- ;; Set the ownership and modes. This is not performed in
- ;; `tramp-handle-write-region'.
+ ;; Set the ownership, modes and extended attributes. This is
+ ;; not performed in `tramp-handle-write-region'.
(unless (and (= (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
uid)
@@ -732,7 +741,12 @@ ID-FORMAT valid values are `string' and `integer'."
(file-attributes filename 'integer))
gid))
(tramp-set-file-uid-gid filename uid gid))
- (tramp-compat-set-file-modes filename modes flag)))))
+ (tramp-compat-set-file-modes filename modes flag)
+ ;; We ignore possible errors, because ACL strings could be
+ ;; incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes filename attributes)))))))
;; Internal functions.
@@ -773,6 +787,9 @@ connection if a previous connection has died for some reason."
(process-put p 'vector vec)
(set-process-query-on-exit-flag p nil)
+ ;; Mark process for filelock.
+ (tramp-set-connection-property p "lock-pid" (truncate (time-to-seconds)))
+
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
@@ -788,24 +805,21 @@ in case of error, t otherwise."
(tramp-sudoedit-maybe-open-connection vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(erase-buffer)
- (let* ((login (tramp-get-method-parameter vec 'tramp-sudo-login))
- (host (or (tramp-file-name-host vec) ""))
- (user (or (tramp-file-name-user vec) ""))
- (spec (format-spec-make ?h host ?u user))
- (args (append
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) x))
- login))
- (tramp-compat-flatten-tree (delq nil args))))
- (delete-exited-processes t)
+ (let* ((delete-exited-processes t)
(process-connection-type tramp-process-connection-type)
(p (apply #'start-process
- (tramp-get-connection-name vec) (current-buffer) args))
+ (tramp-get-connection-name vec) (current-buffer)
+ (append
+ (tramp-expand-args
+ vec 'tramp-sudo-login
+ ?h (or (tramp-file-name-host vec) "")
+ ?u (or (tramp-file-name-user vec) ""))
+ (tramp-compat-flatten-tree args))))
;; We suppress the messages `Waiting for prompts from remote shell'.
(tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
+ ;; The password shall be cached also in case of "emacs -Q".
+ ;; See `tramp-process-actions'.
+ (tramp-cache-read-persistent-data t)
;; We do not want to save the password.
auth-source-save-behavior)
(tramp-message vec 6 "%s" (string-join (process-command p) " "))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 690dd99ae55..83df05c24b7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -64,6 +64,10 @@
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
+;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA package.
+;;;###autoload (when (featurep 'tramp-compat)
+;;;###autoload (load "tramp-compat" 'noerror 'nomessage))
+
;;; User Customizable Internal Variables:
(defgroup tramp nil
@@ -105,7 +109,8 @@ Any level x includes messages for all levels 1 .. x-1. The levels are
7 file caching
8 connection properties
9 test commands
-10 traces (huge)."
+10 traces (huge)
+11 call traces (maintainer only)."
:type 'integer)
(defcustom tramp-debug-to-file nil
@@ -248,6 +253,8 @@ pair of the form (KEY VALUE). The following KEYs are defined:
- \"%c\" adds additional `tramp-ssh-controlmaster-options'
options for the first hop.
- \"%n\" expands to \"2>/dev/null\".
+ - \"%x\" is replaced by the `tramp-scp-strict-file-name-checking'
+ argument if it is supported.
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -354,12 +361,13 @@ Notes:
All these arguments can be overwritten by connection properties.
See Info node `(tramp) Predefined connection information'.
-When using `su' or `sudo' the phrase \"open connection to a remote
-host\" sounds strange, but it is used nevertheless, for consistency.
-No connection is opened to a remote host, but `su' or `sudo' is
-started on the local host. You should specify a remote host
-`localhost' or the name of the local host. Another host name is
-useful only in combination with `tramp-default-proxies-alist'.")
+When using `su', `sudo' or `doas' the phrase \"open connection to
+a remote host\" sounds strange, but it is used nevertheless, for
+consistency. No connection is opened to a remote host, but `su',
+`sudo' or `doas' is started on the local host. You should
+specify a remote host `localhost' or the name of the local host.
+Another host name is useful only in combination with
+`tramp-default-proxies-alist'.")
(defcustom tramp-default-method
;; An external copy method seems to be preferred, because it performs
@@ -386,6 +394,8 @@ Also see `tramp-default-method-alist'."
:type 'string)
(defcustom tramp-default-method-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default method to use for specific host/user pairs.
This is an alist of items (HOST USER METHOD). The first matching item
specifies the method to use for a file name which does not specify a
@@ -413,6 +423,8 @@ This variable is regarded as obsolete, and will be removed soon."
:type '(choice (const nil) string))
(defcustom tramp-default-user-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default user to use for specific method/host pairs.
This is an alist of items (METHOD HOST USER). The first matching item
specifies the user to use for a file name which does not specify a
@@ -432,6 +444,8 @@ Useful for su and sudo methods mostly."
:type 'string)
(defcustom tramp-default-host-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Default host to use for specific method/user pairs.
This is an alist of items (METHOD USER HOST). The first matching item
specifies the host to use for a file name which does not specify a
@@ -447,6 +461,8 @@ empty string for the method name."
(choice :tag " Host name" string (const nil)))))
(defcustom tramp-default-proxies-alist nil
+ ;; FIXME: This is not an "alist", because its elements are not of
+ ;; the form (KEY . VAL) but (KEY1 KEY2 VAL).
"Route to be followed for specific host/user pairs.
This is an alist of items (HOST USER PROXY). The first matching
item specifies the proxy to be passed for a file name located on
@@ -479,7 +495,7 @@ interpreted as a regular expression which always matches."
;; either lower case or upper case letters. See
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(defcustom tramp-restricted-shell-hosts-alist
- (when (memq system-type '(windows-nt))
+ (when (eq system-type 'windows-nt)
(list (format "\\`\\(%s\\|%s\\)\\'"
(regexp-quote (downcase tramp-system-name))
(regexp-quote (upcase tramp-system-name)))))
@@ -549,7 +565,7 @@ usually suffice.")
the remote shell.")
(defcustom tramp-local-end-of-line
- (if (memq system-type '(windows-nt)) "\r\n" "\n")
+ (if (eq system-type 'windows-nt) "\r\n" "\n")
"String used for end of line in local processes."
:version "24.1"
:type 'string)
@@ -570,8 +586,7 @@ Sometimes the prompt is reported to look like \"login as:\"."
(defcustom tramp-shell-prompt-pattern
;; Allow a prompt to start right after a ^M since it indeed would be
- ;; displayed at the beginning of the line (and Zsh uses it). This
- ;; regexp works only for GNU Emacs.
+ ;; displayed at the beginning of the line (and Zsh uses it).
;; Allow also [] style prompts. They can appear only during
;; connection initialization; Tramp redefines the prompt afterwards.
(concat "\\(?:^\\|\r\\)"
@@ -652,6 +667,14 @@ The regexp should match at end of buffer.
See also `tramp-yesno-prompt-regexp'."
:type 'regexp)
+(defcustom tramp-terminal-type "dumb"
+ "Value of TERM environment variable for logging in to remote host.
+Because Tramp wants to parse the output of the remote shell, it is easily
+confused by ANSI color escape sequences and suchlike. Often, shell init
+files conditionalize this setup based on the TERM environment variable."
+ :group 'tramp
+ :type 'string)
+
(defcustom tramp-terminal-prompt-regexp
(concat "\\("
"TERM = (.*)"
@@ -674,6 +697,23 @@ The regexp should match at end of buffer."
:version "27.1"
:type 'regexp)
+;; A security key requires the user physically to touch the device
+;; with their finger. We must tell it to the user.
+;; Added in OpenSSH 8.2. I've tested it with yubikey.
+(defcustom tramp-security-key-confirm-regexp
+ "^\r*Confirm user presence for key .*[\r\n]*"
+ "Regular expression matching security key confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
+(defcustom tramp-security-key-confirmed-regexp
+ "^\r*User presence confirmed[\r\n]*"
+ "Regular expression matching security key confirmation message.
+The regexp should match at end of buffer."
+ :version "28.1"
+ :type 'regexp)
+
(defcustom tramp-operation-not-permitted-regexp
(concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*"
(regexp-opt '("Operation not permitted") t))
@@ -1061,7 +1101,13 @@ initial value is overwritten by the car of `tramp-file-name-structure'.")
(defconst tramp-completion-file-name-regexp-default
(concat
- "\\`/\\("
+ "\\`"
+ ;; `file-name-completion' uses absolute paths for matching. This
+ ;; means that on W32 systems, something like "/ssh:host:~/path"
+ ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'.
+ (when (eq system-type 'windows-nt)
+ "\\(?:[[:alpha:]]:\\)?")
+ "/\\("
;; Optional multi hop.
"\\([^/|:]+:[^/|:]*|\\)*"
;; Last hop.
@@ -1080,7 +1126,13 @@ On W32 systems, the volume letter must be ignored.")
(defconst tramp-completion-file-name-regexp-simplified
(concat
- "\\`/\\("
+ "\\`"
+ ;; Allow the volume letter at the beginning of the path. See the
+ ;; comment in `tramp-completion-file-name-regexp-default' for more
+ ;; details.
+ (when (eq system-type 'windows-nt)
+ "\\(?:[[:alpha:]]:\\)?")
+ "/\\("
;; Optional multi hop.
"\\([^/|:]*|\\)*"
;; Last hop.
@@ -1096,7 +1148,14 @@ See `tramp-file-name-structure' for more explanations.
On W32 systems, the volume letter must be ignored.")
(defconst tramp-completion-file-name-regexp-separate
- "\\`/\\(\\[[^]]*\\)?\\'"
+ (concat
+ "\\`"
+ ;; Allow the volume letter at the beginning of the path. See the
+ ;; comment in `tramp-completion-file-name-regexp-default' for more
+ ;; details.
+ (when (eq system-type 'windows-nt)
+ "\\(?:[[:alpha:]]:\\)?")
+ "/\\(\\[[^]]*\\)?\\'")
"Value for `tramp-completion-file-name-regexp' for separate remoting.
See `tramp-file-name-structure' for more explanations.")
@@ -1205,14 +1264,14 @@ this variable to be set as well."
:type '(choice (const nil) integer))
;; Logging in to a remote host normally requires obtaining a pty. But
-;; Emacs on macOS has process-connection-type set to nil by default,
+;; Emacs on macOS has `process-connection-type' set to nil by default,
;; so on those systems Tramp doesn't obtain a pty. Here, we allow
;; for an override of the system default.
(defcustom tramp-process-connection-type t
"Overrides `process-connection-type' for connections from Tramp.
Tramp binds `process-connection-type' to the value given here before
opening a connection to a remote host."
- :type '(choice (const nil) (const t) (const pty)))
+ :type '(choice (const nil) (const t) (const pipe) (const pty)))
(defcustom tramp-connection-timeout 60
"Defines the max time to wait for establishing a connection (in seconds).
@@ -1235,6 +1294,67 @@ let-bind this variable."
:version "24.4"
:type '(choice (const nil) integer))
+;; "getconf PATH" yields:
+;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin
+;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
+;; GNU/Linux (Debian, Suse, RHEL): /bin:/usr/bin
+;; FreeBSD, DragonFly: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
+;; FreeBSD 12.1, Darwin: /usr/bin:/bin:/usr/sbin:/sbin
+;; IRIX64: /usr/bin
+;; QNAP QTS: ---
+;; Hydra: /run/current-system/sw/bin:/bin:/usr/bin
+(defcustom tramp-remote-path
+ '(tramp-default-remote-path "/bin" "/usr/bin" "/sbin" "/usr/sbin"
+ "/usr/local/bin" "/usr/local/sbin" "/local/bin" "/local/freeware/bin"
+ "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin"
+ "/opt/bin" "/opt/sbin" "/opt/local/bin")
+ "List of directories to search for executables on remote host.
+For every remote host, this variable will be set buffer local,
+keeping the list of existing directories on that host.
+
+You can use \"~\" in this list, but when searching for a shell which groks
+tilde expansion, all directory names starting with \"~\" will be ignored.
+
+`Default Directories' represent the list of directories given by
+the command \"getconf PATH\". It is recommended to use this
+entry on head of this list, because these are the default
+directories for POSIX compatible commands. On remote hosts which
+do not offer the getconf command (like cygwin), the value
+\"/bin:/usr/bin\" is used instead. This entry is represented in
+the list by the special value `tramp-default-remote-path'.
+
+`Private Directories' are the settings of the $PATH environment,
+as given in your `~/.profile'. This entry is represented in
+the list by the special value `tramp-own-remote-path'."
+ :group 'tramp
+ :type '(repeat (choice
+ (const :tag "Default Directories" tramp-default-remote-path)
+ (const :tag "Private Directories" tramp-own-remote-path)
+ (string :tag "Directory"))))
+
+(defcustom tramp-remote-process-environment
+ '("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.
+
+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 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))
+
(defcustom tramp-completion-reread-directory-timeout 10
"Defines seconds since last remote command before rereading a directory.
A remote directory might have changed its contents. In order to
@@ -1287,6 +1407,14 @@ calling HANDLER.")
(cl-defstruct (tramp-file-name (:type list) :named)
method user domain host port localname hop)
+(put #'tramp-file-name-method 'tramp-suppress-trace t)
+(put #'tramp-file-name-user 'tramp-suppress-trace t)
+(put #'tramp-file-name-domain 'tramp-suppress-trace t)
+(put #'tramp-file-name-host 'tramp-suppress-trace t)
+(put #'tramp-file-name-port 'tramp-suppress-trace t)
+(put #'tramp-file-name-localname 'tramp-suppress-trace t)
+(put #'tramp-file-name-hop 'tramp-suppress-trace t)
+
(defun tramp-file-name-user-domain (vec)
"Return user and domain components of VEC."
(when (or (tramp-file-name-user vec) (tramp-file-name-domain vec))
@@ -1295,6 +1423,8 @@ calling HANDLER.")
tramp-prefix-domain-format)
(tramp-file-name-domain vec))))
+(put #'tramp-file-name-user-domain 'tramp-suppress-trace t)
+
(defun tramp-file-name-host-port (vec)
"Return host and port components of VEC."
(when (or (tramp-file-name-host vec) (tramp-file-name-port vec))
@@ -1303,12 +1433,16 @@ calling HANDLER.")
tramp-prefix-port-format)
(tramp-file-name-port vec))))
+(put #'tramp-file-name-host-port 'tramp-suppress-trace t)
+
(defun tramp-file-name-port-or-default (vec)
"Return port component of VEC.
If nil, return `tramp-default-port'."
(or (tramp-file-name-port vec)
(tramp-get-method-parameter vec 'tramp-default-port)))
+(put #'tramp-file-name-port-or-default 'tramp-suppress-trace t)
+
;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
"Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
@@ -1355,6 +1489,8 @@ entry does not exist, return nil."
(string-match-p tramp-file-name-regexp name)
t))
+(put #'tramp-tramp-file-p 'tramp-suppress-trace t)
+
;; This function bypasses the file name handler approach. It is NOT
;; recommended to use it in any package if not absolutely necessary.
;; However, it is more performant than `file-local-name', and might be
@@ -1403,6 +1539,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
+(put #'tramp-find-method 'tramp-suppress-trace t)
+
(defun tramp-find-user (method user host)
"Return the right user string to use depending on METHOD and HOST.
This is USER, if non-nil. Otherwise, do a lookup in
@@ -1424,6 +1562,8 @@ This is USER, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
+(put #'tramp-find-user 'tramp-suppress-trace t)
+
(defun tramp-find-host (method user host)
"Return the right host string to use depending on METHOD and USER.
This is HOST, if non-nil. Otherwise, do a lookup in
@@ -1445,6 +1585,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in
result
(propertize result 'tramp-default t))))
+(put #'tramp-find-host 'tramp-suppress-trace t)
+
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure of NAME, a remote file name.
The structure consists of method, user, domain, host, port,
@@ -1483,7 +1625,8 @@ default values are used."
(setq v (tramp-dissect-hop-name hop)
hop (and hop (tramp-make-tramp-hop-name v))))
(let ((tramp-default-host
- (or (and v (not (string-match-p "%h" (tramp-file-name-host v)))
+ (or (and v (not (tramp-compat-string-search
+ "%h" (tramp-file-name-host v)))
(tramp-file-name-host v))
tramp-default-host)))
(setq method (tramp-find-method method user host)
@@ -1509,6 +1652,8 @@ default values are used."
(tramp-user-error
v "Method `%s' is not supported for multi-hops." method)))))))
+(put #'tramp-dissect-file-name 'tramp-suppress-trace t)
+
(defun tramp-dissect-hop-name (name &optional nodefault)
"Return a `tramp-file-name' structure of `hop' part of NAME.
See `tramp-dissect-file-name' for details."
@@ -1526,6 +1671,8 @@ See `tramp-dissect-file-name' for details."
;; Return result.
v))
+(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
+
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
(let ((method (tramp-file-name-method vec))
@@ -1535,6 +1682,8 @@ See `tramp-dissect-file-name' for details."
(format "*tramp/%s %s@%s*" method user-domain host-port)
(format "*tramp/%s %s*" method host-port))))
+(put #'tramp-buffer-name 'tramp-suppress-trace t)
+
(defun tramp-make-tramp-file-name (&rest args)
"Construct a Tramp file name from ARGS.
@@ -1702,6 +1851,8 @@ version, the function does nothing."
(format "*debug tramp/%s %s@%s*" method user-domain host-port)
(format "*debug tramp/%s %s*" method host-port))))
+(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
+
(defconst tramp-debug-outline-regexp
(concat
"[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp.
@@ -1710,6 +1861,10 @@ version, the function does nothing."
"Used for highlighting Tramp debug buffers in `outline-mode'.")
(defconst tramp-debug-font-lock-keywords
+ ;; FIXME: Make it a function instead of an ELisp expression, so you
+ ;; can evaluate it with `funcall' rather than `eval'!
+ ;; Also, in `font-lock-defaults' you can specify a function name for
+ ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords!
'(list
(concat "^\\(?:" tramp-debug-outline-regexp "\\).+")
'(1 font-lock-warning-face t t)
@@ -1723,10 +1878,13 @@ Point must be at the beginning of a header line.
The outline level is equal to the verbosity of the Tramp message."
(1+ (string-to-number (match-string 2))))
+(put #'tramp-debug-outline-level 'tramp-suppress-trace t)
+
(defun tramp-get-debug-buffer (vec)
"Get the debug buffer for VEC."
(with-current-buffer (get-buffer-create (tramp-debug-buffer-name vec))
(when (bobp)
+ (set-buffer-file-coding-system 'utf-8)
(setq buffer-undo-list t)
;; Activate `outline-mode'. This runs `text-mode-hook' and
;; `outline-mode-hook'. We must prevent that local processes
@@ -1738,19 +1896,35 @@ The outline level is equal to the verbosity of the Tramp message."
(outline-mode))
(setq-local outline-level 'tramp-debug-outline-level)
(setq-local font-lock-keywords
- `(t (eval ,tramp-debug-font-lock-keywords)
- ,(eval tramp-debug-font-lock-keywords)))
+ ;; FIXME: This `(t FOO . BAR)' representation in
+ ;; `font-lock-keywords' is supposed to be an
+ ;; internal implementation "detail". Don't abuse it here!
+ `(t (eval ,tramp-debug-font-lock-keywords t)
+ ,(eval tramp-debug-font-lock-keywords t)))
;; Do not edit the debug buffer.
(use-local-map special-mode-map))
(current-buffer)))
+(put #'tramp-get-debug-buffer 'tramp-suppress-trace t)
+
(defun tramp-get-debug-file-name (vec)
- "Get the debug buffer for VEC."
+ "Get the debug file name for VEC."
(expand-file-name
(tramp-compat-string-replace "/" " " (tramp-debug-buffer-name vec))
(tramp-compat-temporary-file-directory)))
-(defsubst tramp-debug-message (vec fmt-string &rest arguments)
+(put #'tramp-get-debug-file-name 'tramp-suppress-trace t)
+
+(defun tramp-trace-buffer-name (vec)
+ "A name for the trace buffer for VEC."
+ (tramp-compat-string-replace "debug" "trace" (tramp-debug-buffer-name vec)))
+
+(put #'tramp-trace-buffer-name 'tramp-suppress-trace t)
+
+(defvar tramp-trace-functions nil
+ "A list of non-Tramp functions to be traced with tramp-verbose > 10.")
+
+(defun tramp-debug-message (vec fmt-string &rest arguments)
"Append message to debug buffer of VEC.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
@@ -1760,11 +1934,11 @@ ARGUMENTS to actually emit the message (if applicable)."
(with-current-buffer (tramp-get-debug-buffer vec)
(goto-char (point-max))
(let ((point (point)))
- ;; Headline.
(when (bobp)
+ ;; Headline.
(insert
(format
- ";; Emacs: %s Tramp: %s -*- mode: outline; -*-"
+ ";; Emacs: %s Tramp: %s -*- mode: outline; coding: utf-8; -*-"
emacs-version tramp-version))
(when (>= tramp-verbose 10)
(let ((tramp-verbose 0))
@@ -1774,6 +1948,15 @@ ARGUMENTS to actually emit the message (if applicable)."
(locate-library "tramp")
(or tramp-repository-branch "")
(or tramp-repository-version "")))))
+ ;; Traces.
+ (when (>= tramp-verbose 11)
+ (dolist
+ (elt
+ (append
+ (mapcar #'intern (all-completions "tramp-" obarray 'functionp))
+ tramp-trace-functions))
+ (unless (get elt 'tramp-suppress-trace)
+ (trace-function-background elt))))
;; Delete debug file.
(when (and tramp-debug-to-file (tramp-get-debug-file-name vec))
(ignore-errors (delete-file (tramp-get-debug-file-name vec)))))
@@ -1791,7 +1974,7 @@ ARGUMENTS to actually emit the message (if applicable)."
(if (not btf)
(setq fn "")
(and (symbolp btf) (setq fn (symbol-name btf))
- (or (not (string-match-p "^tramp" fn))
+ (or (not (string-prefix-p "tramp" fn))
(get btf 'tramp-suppress-trace))
(setq fn nil))
(setq btn (1+ btn))))
@@ -1882,7 +2065,7 @@ function is meant for debugging purposes."
(put #'tramp-backtrace 'tramp-suppress-trace t)
-(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
+(defun tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
VEC-OR-PROC identifies the connection to use, SIGNAL is the
signal identifier to be raised, remaining arguments passed to
@@ -2043,7 +2226,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
"Report progress of an operation for Tramp."
(let* ((parameters (cdr reporter))
(message (aref parameters 3)))
- (when (string-match-p message (or (current-message) ""))
+ (when (tramp-compat-string-search message (or (current-message) ""))
(tramp-compat-progress-reporter-update reporter value suffix))))
(defmacro with-tramp-progress-reporter (vec level message &rest body)
@@ -2083,14 +2266,15 @@ without a visible progress reporter."
FILE must be a local file name on a connection identified via VEC."
(declare (indent 3) (debug t))
`(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our
- ;; debug messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
+ (let ((value (tramp-get-file-property
+ ,vec ,file ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,vec ,file ,property value))
+ value)
,@body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>"))
@@ -2098,14 +2282,15 @@ FILE must be a local file name on a connection identified via VEC."
(defmacro with-tramp-connection-property (key property &rest body)
"Check in Tramp for property PROPERTY, otherwise execute BODY and set."
(declare (indent 2) (debug t))
- `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
+ `(let ((value (tramp-get-connection-property
+ ,key ,property tramp-cache-undefined)))
+ (when (eq value tramp-cache-undefined)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
(font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-connection-property\\>"))
@@ -2155,7 +2340,7 @@ Example:
(unless (and (functionp (nth 0 (car v)))
(cond
;; Windows registry.
- ((string-match-p "^HKEY_CURRENT_USER" (nth 1 (car v)))
+ ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v)))
(and (memq system-type '(cygwin windows-nt))
(zerop
(tramp-call-process
@@ -2287,6 +2472,8 @@ Must be handled by the callers."
file-name-case-insensitive-p
;; Emacs 27+ only.
file-system-info
+ ;; Emacs 28+ only.
+ file-locked-p lock-file make-lock-file-name unlock-file
;; Tramp internal magic file name function.
tramp-set-file-uid-gid))
(if (file-name-absolute-p (nth 0 args))
@@ -2459,8 +2646,12 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(tramp-unload-file-name-handlers)
(when tramp-mode
;; We cannot use `tramp-compat-temporary-file-directory' here due
- ;; to autoload.
+ ;; to autoload. When installing Tramp's GNU ELPA package, there
+ ;; might be an older, incompatible version active. We try to
+ ;; overload this.
(let ((default-directory temporary-file-directory))
+ (when (bound-and-true-p tramp-archive-autoload)
+ (load "tramp-archive" 'noerror 'nomessage))
(load "tramp" 'noerror 'nomessage)))
(apply operation args)))
@@ -2472,7 +2663,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
"Add Tramp file name handlers to `file-name-handler-alist' during autoload."
(add-to-list 'file-name-handler-alist
(cons tramp-autoload-file-name-regexp
- 'tramp-autoload-file-name-handler))
+ #'tramp-autoload-file-name-handler))
(put #'tramp-autoload-file-name-handler 'safe-magic t)))
;;;###autoload (tramp-register-autoload-file-name-handlers)
@@ -2591,6 +2782,14 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
;;; File name handler functions for completion mode:
+;; This function takes action since Emacs 28.1, when
+;; `read-extended-command-predicate' is set to
+;; `command-completion-default-include-p'.
+(defun tramp-command-completion-p (_symbol buffer)
+ "A predicate for Tramp interactive commands.
+They are completed by \"M-x TAB\" only if the current buffer is remote."
+ (with-current-buffer buffer (tramp-tramp-file-p default-directory)))
+
(defun tramp-connectable-p (vec-or-filename)
"Check, whether it is possible to connect the remote host w/o side-effects.
This is true, if either the remote host is already connected, or if we are
@@ -2676,7 +2875,7 @@ not in completion mode."
result1
(ignore-errors
(tramp-run-real-handler
- 'file-name-all-completions (list filename directory))))))
+ #'file-name-all-completions (list filename directory))))))
;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion
@@ -2800,8 +2999,7 @@ remote host and localname (filename on remote host)."
"Return all method completions for PARTIAL-METHOD."
(mapcar
(lambda (method)
- (and method
- (string-match-p (concat "^" (regexp-quote partial-method)) method)
+ (and method (string-prefix-p partial-method method)
(tramp-completion-make-tramp-file-name method nil nil nil)))
(mapcar #'car tramp-methods)))
@@ -2813,8 +3011,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(cond
((and partial-user partial-host)
- (if (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host)
+ (if (and host (string-prefix-p partial-host host)
(string-equal partial-user (or user partial-user)))
(setq user partial-user)
(setq user nil
@@ -2822,16 +3019,12 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST."
(partial-user
(setq host nil)
- (unless
- (and user
- (string-match-p (concat "^" (regexp-quote partial-user)) user))
+ (unless (and user (string-prefix-p partial-user user))
(setq user nil)))
(partial-host
(setq user nil)
- (unless
- (and host
- (string-match-p (concat "^" (regexp-quote partial-host)) host))
+ (unless (and host (string-prefix-p partial-host host))
(setq host nil)))
(t (setq user nil
@@ -3025,7 +3218,7 @@ User may be nil."
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
User is always nil."
- (if (memq system-type '(windows-nt))
+ (if (eq system-type 'windows-nt)
(with-tramp-connection-property nil "parse-putty"
(with-temp-buffer
(when (zerop (tramp-call-process
@@ -3097,7 +3290,7 @@ User is always nil."
(tramp-compat-file-missing (tramp-dissect-file-name directory) directory))
;; We must do it file-wise.
(tramp-run-real-handler
- 'copy-directory
+ #'copy-directory
(list directory newname keep-date parents copy-contents)))
(defun tramp-handle-directory-file-name (directory)
@@ -3155,7 +3348,7 @@ User is always nil."
(when (zerop (length name)) (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
- (setq name (concat (file-name-as-directory dir) name)))
+ (setq name (tramp-compat-file-name-concat dir name)))
;; If NAME is not a Tramp file, run the real handler.
(if (not (tramp-tramp-file-p name))
(tramp-run-real-handler #'expand-file-name (list name nil))
@@ -3163,6 +3356,9 @@ User is always nil."
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Do not keep "/..".
+ (when (string-match-p "^/\\.\\.?$" localname)
+ (setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../").
;; `default-directory' is bound, because on Windows there would
;; be problems with UNC shares or Cygwin mounts.
@@ -3444,6 +3640,11 @@ User is always nil."
(and (file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename)))))))
+(defcustom tramp-allow-unsafe-temporary-files nil
+ "Whether root-owned auto-save, backup or lock files can be written to \"/tmp\"."
+ :version "28.1"
+ :type 'boolean)
+
(defun tramp-handle-find-backup-file-name (filename)
"Like `find-backup-file-name' for Tramp files."
(with-parsed-tramp-file-name filename nil
@@ -3459,8 +3660,26 @@ User is always nil."
(tramp-make-tramp-file-name v (cdr x))
(cdr x))))
tramp-backup-directory-alist)
- backup-directory-alist)))
- (tramp-run-real-handler #'find-backup-file-name (list filename)))))
+ backup-directory-alist))
+ result)
+ (prog1 ;; Run plain `find-backup-file-name'.
+ (setq result
+ (tramp-run-real-handler
+ #'find-backup-file-name (list filename)))
+ ;; Protect against security hole.
+ (when (and (not tramp-allow-unsafe-temporary-files)
+ (not backup-inhibited)
+ (file-in-directory-p (car result) temporary-file-directory)
+ (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ tramp-unknown-id-integer))
+ (not (with-tramp-connection-property
+ (tramp-get-process v) "unsafe-temporary-file"
+ (yes-or-no-p
+ (concat
+ "Backup file on local temporary directory, "
+ "do you want to continue? ")))))
+ (tramp-error v 'file-error "Unsafe backup file name"))))))
(defun tramp-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
@@ -3483,7 +3702,7 @@ User is always nil."
(list filename switches wildcard full-directory-p))
;; `ls-lisp' always returns full listings. We must remove
;; superfluous parts.
- (unless (string-match-p "l" switches)
+ (unless (tramp-compat-string-search "l" switches)
(save-excursion
(goto-char (point-min))
(while (setq start
@@ -3597,21 +3816,114 @@ User is always nil."
(signal (car err) (cdr err))))))
;; Save exit.
- (progn
- (when visit
- (setq buffer-file-name filename
- buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (and (stringp local-copy)
- (or remote-copy (null tramp-temp-buffer-file-name)))
- (delete-file local-copy))
- (when (stringp remote-copy)
- (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop)))))
+ (when visit
+ (setq buffer-file-name filename
+ buffer-read-only (not (file-writable-p filename)))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (when (and (stringp local-copy)
+ (or remote-copy (null tramp-temp-buffer-file-name)))
+ (delete-file local-copy))
+ (when (stringp remote-copy)
+ (delete-file (tramp-make-tramp-file-name v remote-copy 'nohop))))
;; Result.
- (list (expand-file-name filename)
- (cadr result)))))
+ (cons (expand-file-name filename) (cdr result)))))
+
+(defun tramp-get-lock-file (file)
+ "Read lockfile info of FILE.
+Return nil when there is no lockfile."
+ (when-let ((lockname (tramp-compat-make-lock-file-name file)))
+ (or (file-symlink-p lockname)
+ (and (file-readable-p lockname)
+ (with-temp-buffer
+ (insert-file-contents-literally lockname)
+ (buffer-string))))))
+
+(defun tramp-get-lock-pid (file)
+ "Determine pid for lockfile of FILE."
+ ;; Some Tramp methods do not offer a connection process, but just a
+ ;; network process as a place holder. Those processes use the
+ ;; "lock-pid" connection property as fake pid, in fact it is the
+ ;; time stamp the process is created.
+ (let ((p (tramp-get-process (tramp-dissect-file-name file))))
+ (number-to-string
+ (or (process-id p)
+ (tramp-get-connection-property p "lock-pid" (emacs-pid))))))
+
+(defconst tramp-lock-file-info-regexp
+ ;; USER@HOST.PID[:BOOT_TIME]
+ "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'"
+ "The format of a lock file.")
+
+(defun tramp-handle-file-locked-p (file)
+ "Like `file-locked-p' for Tramp files."
+ (when-let ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
+ (or (and (string-equal (match-string 1 info) (user-login-name))
+ (string-equal (match-string 2 info) (system-name))
+ (string-equal (match-string 3 info) (tramp-get-lock-pid file)))
+ (match-string 1 info))))
+
+(defun tramp-handle-lock-file (file)
+ "Like `lock-file' for Tramp files."
+ ;; See if this file is visited and has changed on disk since it
+ ;; was visited.
+ (catch 'dont-lock
+ (unless (eq (file-locked-p file) t) ;; Locked by me.
+ (when-let ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
+ (unless (ask-user-about-lock
+ file (format
+ "%s@%s (pid %s)" (match-string 1 info)
+ (match-string 2 info) (match-string 3 info)))
+ (throw 'dont-lock nil)))
+
+ (when-let ((lockname (tramp-compat-make-lock-file-name file))
+ ;; USER@HOST.PID[:BOOT_TIME]
+ (info
+ (format
+ "%s@%s.%s" (user-login-name) (system-name)
+ (tramp-get-lock-pid file))))
+
+ ;; Protect against security hole.
+ (with-parsed-tramp-file-name file nil
+ (when (and (not tramp-allow-unsafe-temporary-files)
+ create-lockfiles
+ (file-in-directory-p lockname temporary-file-directory)
+ (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes file 'integer))
+ tramp-unknown-id-integer))
+ (not (with-tramp-connection-property
+ (tramp-get-process v) "unsafe-temporary-file"
+ (yes-or-no-p
+ (concat
+ "Lock file on local temporary directory, "
+ "do you want to continue? ")))))
+ (tramp-error v 'file-error "Unsafe lock file name")))
+
+ ;; Do the lock.
+ (let (create-lockfiles signal-hook-function)
+ (condition-case nil
+ (make-symbolic-link info lockname 'ok-if-already-exists)
+ (error
+ (with-file-modes #o0644
+ (write-region info nil lockname)))))))))
+
+(defun tramp-handle-make-lock-file-name (file)
+ "Like `make-lock-file-name' for Tramp files."
+ (and create-lockfiles
+ ;; This variable has been introduced with Emacs 28.1.
+ (not (bound-and-true-p remote-file-name-inhibit-locks))
+ (tramp-run-real-handler 'make-lock-file-name (list file))))
+
+(defun tramp-handle-unlock-file (file)
+ "Like `unlock-file' for Tramp files."
+ (when-let ((lockname (tramp-compat-make-lock-file-name file)))
+ (condition-case err
+ (delete-file lockname)
+ ;; `userlock--handle-unlock-error' exists since Emacs 28.1.
+ (error (tramp-compat-funcall 'userlock--handle-unlock-error err)))))
(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
"Like `load' for Tramp files."
@@ -3680,15 +3992,15 @@ User is always nil."
(setq choices tramp-default-proxies-alist)
(while choices
(setq item (pop choices)
- proxy (eval (nth 2 item)))
+ proxy (eval (nth 2 item) t))
(when (and
;; Host.
(string-match-p
- (or (eval (nth 0 item)) "")
+ (or (eval (nth 0 item) t) "")
(or (tramp-file-name-host-port (car target-alist)) ""))
;; User.
(string-match-p
- (or (eval (nth 1 item)) "")
+ (or (eval (nth 1 item) t) "")
(or (tramp-file-name-user-domain (car target-alist)) "")))
(if (null proxy)
;; No more hops needed.
@@ -3739,6 +4051,22 @@ User is always nil."
;; Result.
target-alist))
+(defun tramp-expand-args (vec parameter &rest spec-list)
+ "Expand login arguments as given by PARAMETER in `tramp-methods'.
+PARAMETER is a symbol like `tramp-login-args', denoting a list of
+list of strings from `tramp-methods', containing %-sequences for
+substitution. SPEC-LIST is a list of char/value pairs used for
+`format-spec-make'."
+ (let ((args (tramp-get-method-parameter vec parameter))
+ (spec (apply 'format-spec-make spec-list)))
+ ;; Expand format spec.
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) x))
+ args))))
+
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory))
@@ -3756,8 +4084,7 @@ User is always nil."
(or (not (stringp stderr)) (not (tramp-tramp-file-p stderr))))))
(defun tramp-handle-make-process (&rest args)
- "An alternative `make-process' implementation for Tramp files.
-It does not support `:stderr'."
+ "An alternative `make-process' implementation for Tramp files."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((default-directory (tramp-compat-temporary-file-directory))
@@ -3766,7 +4093,10 @@ It does not support `:stderr'."
(command (plist-get args :command))
(coding (plist-get args :coding))
(noquery (plist-get args :noquery))
- (connection-type (plist-get args :connection-type))
+ (connection-type
+ (if (plist-member args :connection-type)
+ (plist-get args :connection-type)
+ tramp-process-connection-type))
(filter (plist-get args :filter))
(sentinel (plist-get args :sentinel))
(stderr (plist-get args :stderr)))
@@ -3782,7 +4112,7 @@ It does not support `:stderr'."
(memq (car coding) coding-system-list)
(memq (cdr coding) coding-system-list)))
(signal 'wrong-type-argument (list #'symbolp coding)))
- (unless (or (null connection-type) (memq connection-type '(pipe pty)))
+ (unless (memq connection-type '(nil pipe t pty))
(signal 'wrong-type-argument (list #'symbolp connection-type)))
(unless (or (null filter) (functionp filter))
(signal 'wrong-type-argument (list #'functionp filter)))
@@ -3798,23 +4128,20 @@ It does not support `:stderr'."
(generate-new-buffer tramp-temp-buffer-name)))
(env (mapcar
(lambda (elt)
- (when (string-match-p "=" elt) elt))
+ (when (tramp-compat-string-search "=" elt) elt))
tramp-remote-process-environment))
;; We use as environment the difference to toplevel
;; `process-environment'.
(env (dolist (elt process-environment env)
(when
(and
- (string-match-p "=" elt)
+ (tramp-compat-string-search "=" elt)
(not
(member
elt (default-toplevel-value 'process-environment))))
(setq env (cons elt env)))))
(env (setenv-internal
- env "INSIDE_EMACS"
- (concat (or (getenv "INSIDE_EMACS") emacs-version)
- ",tramp:" tramp-version)
- 'keep))
+ env "INSIDE_EMACS" (tramp-inside-emacs) 'keep))
(env (mapcar #'tramp-shell-quote-argument (delq nil env)))
;; Quote command.
(command (mapconcat #'tramp-shell-quote-argument command " "))
@@ -3823,14 +4150,11 @@ It does not support `:stderr'."
(append `("cd" ,localname "&&" "(" "env") env `(,command ")"))))
;; Check for `tramp-sh-file-name-handler', because something
- ;; is different between tramp-adb.el and tramp-sh.el.
+ ;; is different between tramp-sh.el, and tramp-adb.el or
+ ;; tramp-sshfs.el.
(let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
(login-program
(tramp-get-method-parameter v 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter v 'tramp-login-args))
- (async-args
- (tramp-get-method-parameter v 'tramp-async-args))
;; We don't create the temporary file. In fact, it
;; is just a prefix for the ControlPath option of
;; ssh; the real temporary file has another name, and
@@ -3848,29 +4172,23 @@ It does not support `:stderr'."
(when sh-file-name-handler-p
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
- spec p)
+ login-args p)
- ;; Replace `login-args' place holders.
+ ;; Replace `login-args' place holders. Split
+ ;; ControlMaster options.
(setq
- spec (format-spec-make ?t tmpfile)
- options (format-spec (or options "") spec)
- spec (format-spec-make
- ?h (or host "") ?u (or user "") ?p (or port "")
- ?c options ?l "")
- ;; Add arguments for asynchronous processes.
- login-args (append async-args login-args)
- ;; Expand format spec.
- login-args
- (tramp-compat-flatten-tree
- (mapcar
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) x))
- login-args))
- ;; Split ControlMaster options.
login-args
- (tramp-compat-flatten-tree
- (mapcar (lambda (x) (split-string x " ")) login-args))
+ (append
+ (tramp-compat-flatten-tree
+ (tramp-get-method-parameter v 'tramp-async-args))
+ (tramp-compat-flatten-tree
+ (mapcar
+ (lambda (x) (split-string x " "))
+ (tramp-expand-args
+ v 'tramp-login-args
+ ?h (or host "") ?u (or user "") ?p (or port "")
+ ?c (format-spec (or options "") (format-spec-make ?t tmpfile))
+ ?l ""))))
p (make-process
:name name :buffer buffer
:command (append `(,login-program) login-args command)
@@ -4151,7 +4469,8 @@ of."
(defun tramp-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename))
+ (setq filename (expand-file-name filename)
+ lockname (file-truename (or lockname filename)))
(with-parsed-tramp-file-name filename nil
(when (and mustbenew (file-exists-p filename)
(or (eq mustbenew 'excl)
@@ -4160,7 +4479,8 @@ of."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
- (let ((tmpfile (tramp-compat-make-temp-file filename))
+ (let ((file-locked (eq (file-locked-p lockname) t))
+ (tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes
filename (and (eq mustbenew 'excl) 'nofollow)))
(uid (or (tramp-compat-file-attribute-user-id
@@ -4169,6 +4489,15 @@ of."
(gid (or (tramp-compat-file-attribute-group-id
(file-attributes filename 'integer))
(tramp-get-remote-gid v 'integer))))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p (file-name-nondirectory filename)))
+ (file-remote-p lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file lockname))
+
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -4180,8 +4509,8 @@ of."
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
- (tramp-run-real-handler
- #'write-region (list start end tmpfile append 'no-message lockname))
+ (let (create-lockfiles)
+ (write-region start end tmpfile append 'no-message))
(condition-case nil
(rename-file tmpfile filename 'ok-if-already-exists)
(error
@@ -4199,13 +4528,18 @@ of."
(current-time))))
;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid))
+ (tramp-set-file-uid-gid filename uid gid)
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (null visit) (stringp visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file lockname))
+
+ ;; The end.
+ (when (and (null noninteractive)
+ (or (eq visit t) (null visit) (stringp visit)))
+ (tramp-message v 0 "Wrote %s" filename))
+ (run-hooks 'tramp-handle-write-region-hook))))
;; This is used in tramp-sh.el and tramp-sudoedit.el.
(defconst tramp-stat-marker "/////"
@@ -4261,6 +4595,9 @@ of."
;; prompts from the remote host. See the variable
;; `tramp-actions-before-shell' for usage of these functions.
+(defvar tramp-process-action-regexp nil
+ "The regexp used to invoke an action in `tramp-process-one-action'.")
+
(defun tramp-action-login (_proc vec)
"Send the login name."
(let ((user (or (tramp-file-name-user vec)
@@ -4286,7 +4623,7 @@ of."
(unless (tramp-get-connection-property vec "first-password-request" nil)
(tramp-clear-passwd vec))
(goto-char (point-min))
- (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
;; password from the debug buffer and the traces.
@@ -4351,6 +4688,24 @@ The terminal type can be configured with `tramp-terminal-type'."
(tramp-send-string vec tramp-local-end-of-line)
t)
+(defun tramp-action-show-and-confirm-message (proc vec)
+ "Show the user a message for confirmation.
+Wait, until the connection buffer changes."
+ (with-current-buffer (process-buffer proc)
+ (let ((stimers (with-timeout-suspend)))
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
+ (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string 0))
+ (redisplay 'force)
+ ;; Hide message in buffer.
+ (narrow-to-region (point-max) (point-max))
+ ;; Wait for new output.
+ (tramp-wait-for-regexp proc 30 tramp-security-key-confirmed-regexp))
+ ;; Reenable the timers.
+ (with-timeout-unsuspend stimers)))
+ t)
+
(defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished."
(unless (process-live-p proc)
@@ -4388,6 +4743,7 @@ The terminal type can be configured with `tramp-terminal-type'."
"Wait for output from the shell and perform one action.
See `tramp-process-actions' for the format of ACTIONS."
(let ((case-fold-search t)
+ tramp-process-action-regexp
found todo item pattern action)
(while (not found)
;; Reread output once all actions have been performed.
@@ -4396,7 +4752,8 @@ See `tramp-process-actions' for the format of ACTIONS."
(setq todo actions)
(while todo
(setq item (pop todo)
- pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))
+ tramp-process-action-regexp (symbol-value (nth 0 item))
+ pattern (format "\\(%s\\)\\'" tramp-process-action-regexp)
action (nth 1 item))
(tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern)
@@ -4870,7 +5227,7 @@ VEC is used for tracing."
(let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8"))
locale)
(with-temp-buffer
- (unless (or (memq system-type '(windows-nt))
+ (unless (or (eq system-type 'windows-nt)
(not (zerop (tramp-call-process
nil "locale" nil t nil "-a"))))
(while candidates
@@ -4961,7 +5318,7 @@ ID-FORMAT valid values are `string' and `integer'."
(or (when-let
((handler
(find-file-name-handler
- (tramp-make-tramp-file-name vec) 'tramp-get-remote-uid)))
+ (tramp-make-tramp-file-name vec) 'tramp-get-remote-gid)))
(funcall handler #'tramp-get-remote-gid vec id-format))
;; Ensure there is a valid result.
(and (equal id-format 'integer) tramp-unknown-id-integer)
@@ -5041,37 +5398,54 @@ Return the local name of the temporary file."
"Like `make-auto-save-file-name' for Tramp files.
Returns a file name in `tramp-auto-save-directory' for autosaving
this file, if that variable is non-nil."
- (when (stringp tramp-auto-save-directory)
- (setq tramp-auto-save-directory
- (expand-file-name tramp-auto-save-directory)))
- ;; Create directory.
- (unless (or (null tramp-auto-save-directory)
- (file-exists-p tramp-auto-save-directory))
- (make-directory tramp-auto-save-directory t))
-
- (let ((system-type
- (if (and (stringp tramp-auto-save-directory)
- (tramp-tramp-file-p tramp-auto-save-directory))
- 'not-windows
- system-type))
- (auto-save-file-name-transforms
- (if (null tramp-auto-save-directory)
- auto-save-file-name-transforms))
- (buffer-file-name
- (if (null tramp-auto-save-directory)
- buffer-file-name
- (expand-file-name
- (tramp-subst-strs-in-string
- '(("_" . "|")
- ("/" . "_a")
- (":" . "_b")
- ("|" . "__")
- ("[" . "_l")
- ("]" . "_r"))
- (tramp-compat-file-name-unquote (buffer-file-name)))
- tramp-auto-save-directory))))
- ;; Run plain `make-auto-save-file-name'.
- (tramp-run-real-handler #'make-auto-save-file-name nil)))
+ (with-parsed-tramp-file-name buffer-file-name nil
+ (when (stringp tramp-auto-save-directory)
+ (setq tramp-auto-save-directory
+ (expand-file-name tramp-auto-save-directory)))
+ ;; Create directory.
+ (unless (or (null tramp-auto-save-directory)
+ (file-exists-p tramp-auto-save-directory))
+ (make-directory tramp-auto-save-directory t))
+
+ (let ((system-type
+ (if (and (stringp tramp-auto-save-directory)
+ (tramp-tramp-file-p tramp-auto-save-directory))
+ 'not-windows
+ system-type))
+ (auto-save-file-name-transforms
+ (if (null tramp-auto-save-directory)
+ auto-save-file-name-transforms))
+ (filename buffer-file-name)
+ (buffer-file-name
+ (if (null tramp-auto-save-directory)
+ buffer-file-name
+ (expand-file-name
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ (tramp-compat-file-name-unquote (buffer-file-name)))
+ tramp-auto-save-directory)))
+ result)
+ (prog1 ;; Run plain `make-auto-save-file-name'.
+ (setq result (tramp-run-real-handler #'make-auto-save-file-name nil))
+ ;; Protect against security hole.
+ (when (and (not tramp-allow-unsafe-temporary-files)
+ auto-save-default
+ (file-in-directory-p result temporary-file-directory)
+ (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes filename 'integer))
+ tramp-unknown-id-integer))
+ (not (with-tramp-connection-property
+ (tramp-get-process v) "unsafe-temporary-file"
+ (yes-or-no-p
+ (concat
+ "Autosave file on local temporary directory, "
+ "do you want to continue? ")))))
+ (tramp-error v 'file-error "Unsafe autosave file name"))))))
(defun tramp-subst-strs-in-string (alist string)
"Replace all occurrences of the string FROM with TO in STRING.
@@ -5281,6 +5655,8 @@ Invokes `password-read' if available, `read-passwd' else."
;; Reenable the timers.
(with-timeout-unsuspend stimers))))
+(put #'tramp-read-passwd 'tramp-suppress-trace t)
+
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(let ((method (tramp-file-name-method vec))
@@ -5295,6 +5671,8 @@ Invokes `password-read' if available, `read-passwd' else."
:host ,host-port :port ,method))
(password-cache-remove (tramp-make-tramp-file-name vec 'noloc 'nohop))))
+(put #'tramp-clear-passwd 'tramp-suppress-trace t)
+
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."
@@ -5439,11 +5817,6 @@ BODY is the backend specific code."
;; strange when doing zerop, we should kill the process and start
;; again. (Greg Stark)
;;
-;; * I was wondering if it would be possible to use tramp even if I'm
-;; actually using sshfs. But when I launch a command I would like
-;; to get it executed on the remote machine where the files really
-;; are. (Andrea Crotti)
-;;
;; * Run emerge on two remote files. Bug is described here:
;; <https://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index ced3e93fc09..8ad641ee45b 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.5.1-pre
+;; Version: 2.5.2-pre
;; Package-Requires: ((emacs "25.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -40,7 +40,7 @@
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.5.1-pre"
+(defconst tramp-version "2.5.2-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,10 +76,15 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "25.1"))
"ok"
- (format "Tramp 2.5.1-pre is not fit for %s"
+ (format "Tramp 2.5.2-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
+(defun tramp-inside-emacs ()
+ "Version string provided by INSIDE_EMACS enmvironment variable."
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version))
+
;; Tramp versions integrated into Emacs. If a user option declares a
;; `:package-version' which doesn't belong to an integrated Tramp
;; version, it must be added here as well (see `tramp-syntax', for
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 1fa625c3245..4baa657c0a5 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -252,7 +252,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
(cond ((not expr) "")
((stringp expr) expr)
((vectorp expr) (webjump-builtin expr name))
- ((listp expr) (eval expr))
+ ((listp expr) (eval expr t))
((symbolp expr)
(if (fboundp expr)
(funcall expr name)
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index ea47eec4fda..57a52effd14 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -840,9 +840,13 @@ Ensure that `comment-normalize-vars' has been called before you use this."
(make-string (min comment-padding
(- (match-end 0) (match-end 1)))
?\s)
- (substring comment-padding ;additional right padding
- (min (- (match-end 0) (match-end 1))
- (length comment-padding))))))
+ (if (not (string-match-p "\\`\\s-" comment-padding))
+ ;; If the padding isn't spaces, then don't
+ ;; shorten the padding.
+ comment-padding
+ (substring comment-padding ;additional right padding
+ (min (- (match-end 0) (match-end 1))
+ (length comment-padding)))))))
;; We can only duplicate C if the comment-end has multiple chars
;; or if comments can be nested, else the comment-end `}' would
;; be turned into `}}}' where only the first ends the comment
@@ -876,9 +880,13 @@ Ensure that `comment-normalize-vars' has been called before you use this."
;; Only separate the left pad because we assume there is no right pad.
(string-match "\\`\\s-*" str)
(let ((s (substring str (match-end 0)))
- (pad (concat (substring comment-padding
- (min (- (match-end 0) (match-beginning 0))
- (length comment-padding)))
+ (pad (concat (if (not (string-match-p "\\`\\s-" comment-padding))
+ ;; If the padding isn't spaces, then don't
+ ;; shorten the padding.
+ comment-padding
+ (substring comment-padding
+ (min (- (match-end 0) (match-beginning 0))
+ (length comment-padding))))
(match-string 0 str)))
(c (aref str (match-end 0))) ;the first non-space char of STR
;; We can only duplicate C if the comment-end has multiple chars
@@ -1300,7 +1308,11 @@ out."
(let ((s (comment-padleft comment-end numarg)))
(and s (if (string-match comment-end-skip s) s
(comment-padright comment-end))))
- (if multi (comment-padright comment-continue numarg))
+ (if multi
+ (or (comment-padright comment-continue numarg)
+ ;; `comment-padright' returns nil when
+ ;; `comment-continue' contains only whitespace
+ (and (stringp comment-continue) comment-continue)))
(if multi
(comment-padleft (comment-string-reverse comment-continue) numarg))
block
diff --git a/lisp/notifications.el b/lisp/notifications.el
index 2241afa9050..ebd74dd3ef2 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -1,4 +1,4 @@
-;;; notifications.el --- Client interface to desktop notifications.
+;;; notifications.el --- Client interface to desktop notifications. -*- lexical-binding: t -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -229,56 +229,69 @@ of another `notifications-notify' call."
id)
;; Build hints array
(when urgency
- (add-to-list 'hints `(:dict-entry
- "urgency"
- (:variant :byte ,(pcase urgency
- ('low 0)
- ('critical 2)
- (_ 1)))) t))
+ (push `(:dict-entry
+ "urgency"
+ (:variant :byte ,(pcase urgency
+ ('low 0)
+ ('critical 2)
+ (_ 1))))
+ hints))
(when category
- (add-to-list 'hints `(:dict-entry
- "category"
- (:variant :string ,category)) t))
+ (push `(:dict-entry
+ "category"
+ (:variant :string ,category))
+ hints))
(when desktop-entry
- (add-to-list 'hints `(:dict-entry
- "desktop-entry"
- (:variant :string ,desktop-entry)) t))
+ (push `(:dict-entry
+ "desktop-entry"
+ (:variant :string ,desktop-entry))
+ hints))
(when image-data
- (add-to-list 'hints `(:dict-entry
- "image-data"
- (:variant :struct ,image-data)) t))
+ (push `(:dict-entry
+ "image-data"
+ (:variant :struct ,image-data))
+ hints))
(when image-path
- (add-to-list 'hints `(:dict-entry
- "image-path"
- (:variant :string ,image-path)) t))
+ (push `(:dict-entry
+ "image-path"
+ (:variant :string ,image-path))
+ hints))
(when action-items
- (add-to-list 'hints `(:dict-entry
- "action-items"
- (:variant :boolean ,action-items)) t))
+ (push `(:dict-entry
+ "action-items"
+ (:variant :boolean ,action-items))
+ hints))
(when sound-file
- (add-to-list 'hints `(:dict-entry
- "sound-file"
- (:variant :string ,sound-file)) t))
+ (push `(:dict-entry
+ "sound-file"
+ (:variant :string ,sound-file))
+ hints))
(when sound-name
- (add-to-list 'hints `(:dict-entry
- "sound-name"
- (:variant :string ,sound-name)) t))
+ (push `(:dict-entry
+ "sound-name"
+ (:variant :string ,sound-name))
+ hints))
(when suppress-sound
- (add-to-list 'hints `(:dict-entry
- "suppress-sound"
- (:variant :boolean ,suppress-sound)) t))
+ (push `(:dict-entry
+ "suppress-sound"
+ (:variant :boolean ,suppress-sound))
+ hints))
(when resident
- (add-to-list 'hints `(:dict-entry
- "resident"
- (:variant :boolean ,resident)) t))
+ (push `(:dict-entry
+ "resident"
+ (:variant :boolean ,resident))
+ hints))
(when transient
- (add-to-list 'hints `(:dict-entry
- "transient"
- (:variant :boolean ,transient)) t))
+ (push `(:dict-entry
+ "transient"
+ (:variant :boolean ,transient))
+ hints))
(when x
- (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
+ (push `(:dict-entry "x" (:variant :int32 ,x)) hints))
(when y
- (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
+ (push `(:dict-entry "y" (:variant :int32 ,y)) hints))
+
+ (setq hints (nreverse hints))
;; Call Notify method.
(setq id
@@ -313,8 +326,8 @@ of another `notifications-notify' call."
(on-close (plist-get params :on-close))
(unique-name (dbus-get-name-owner bus notifications-service)))
(when on-action
- (add-to-list 'notifications-on-action-map
- (list (list bus unique-name id) on-action))
+ (push (list (list bus unique-name id) on-action)
+ notifications-on-action-map)
(unless notifications-on-action-object
(setq notifications-on-action-object
(dbus-register-signal
@@ -326,8 +339,8 @@ of another `notifications-notify' call."
'notifications-on-action-signal))))
(when on-close
- (add-to-list 'notifications-on-close-map
- (list (list bus unique-name id) on-close))
+ (push (list (list bus unique-name id) on-close)
+ notifications-on-close-map)
(unless notifications-on-close-object
(setq notifications-on-close-object
(dbus-register-signal
@@ -407,3 +420,5 @@ version this library is compliant with."
notifications-get-server-information-method)))
(provide 'notifications)
+
+;;; notifications.el ends here
diff --git a/lisp/novice.el b/lisp/novice.el
index 22eca21784c..16766c253c5 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -1,4 +1,4 @@
-;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
+;;; novice.el --- handling of disabled commands ("novice mode") for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1994, 2001-2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 0602943db20..405f803325c 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -540,13 +540,15 @@ Many aspects this mode can be customized using
(nxml-scan-prolog)))))
(setq-local syntax-ppss-table sgml-tag-syntax-table)
(setq-local syntax-propertize-function #'nxml-syntax-propertize)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'nxml--buffer-substring-filter)
(add-hook 'change-major-mode-hook #'nxml-cleanup nil t)
(when (not (and (buffer-file-name) (file-exists-p (buffer-file-name))))
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
(setq buffer-file-coding-system nxml-default-buffer-file-coding-system))
- ;; When starting a new file, insert the XML declaraction.
+ ;; When starting a new file, insert the XML declaration.
(when (and nxml-auto-insert-xml-declaration-flag
(zerop (buffer-size)))
(nxml-insert-xml-declaration)))
@@ -564,6 +566,15 @@ Many aspects this mode can be customized using
(with-demoted-errors (rng-nxml-mode-init)))
+(defun nxml--buffer-substring-filter (string)
+ ;; The `rng-state' property is huge, so don't copy it to the kill ring.
+ ;; This avoids problems when saving the kill ring with savehist.
+ (when (seq-find (lambda (elem)
+ (plist-get (nth 2 elem) 'rng-state))
+ (object-intervals string))
+ (remove-text-properties 0 (length string) '(rng-state nil) string))
+ string)
+
(defun nxml-cleanup ()
"Clean up after nxml-mode."
;; Disable associated minor modes.
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 6dca34a80f2..c265b19cf05 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -633,7 +633,7 @@ non-transparent child section."
tag-qnames))))
(defun nxml-highlighted-qname (qname)
- (let ((colon (string-match ":" qname)))
+ (let ((colon (string-search ":" qname)))
(if colon
(concat (propertize (substring qname 0 colon)
'face
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 45a69a73f35..dd3000773fd 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -26,7 +26,7 @@
;; specified in rng-pttrn.el.
;;
;; RELAX NG Compact Syntax is specified by
-;; http://relaxng.org/compact.html
+;; https://relaxng.org/compact.html
;;
;; This file uses the prefix "rng-c-".
@@ -100,7 +100,7 @@ Return a pattern."
"Regular expression to match a single-quoted literal.")
(defconst rng-c-literal-2-re
- (replace-regexp-in-string "'" "\"" rng-c-literal-1-re)
+ (string-replace "'" "\"" rng-c-literal-1-re)
"Regular expression to match a double-quoted literal.")
(defconst rng-c-ncname-re "\\w+")
@@ -179,7 +179,7 @@ Return a pattern."
(setq rng-c-default-namespace rng-c-inherit-namespace)))
(defun rng-c-expand-name (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-name (rng-c-lookup-prefix (substring prefixed-name
0
i))
@@ -222,7 +222,7 @@ and URI is a symbol.")
(cdr binding)))
(defun rng-c-expand-datatype (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-datatype
(rng-c-lookup-datatype-prefix (substring prefixed-name 0 i))
(substring prefixed-name (+ i 1)))))
@@ -922,4 +922,4 @@ Current token after parse is token following ]."
(provide 'rng-cmpct)
-;;; rng-cmpct.el
+;;; rng-cmpct.el ends here
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index d5a608d6ff2..a38da794226 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -182,7 +182,7 @@ If TYPE-ID is non-nil, then locate the schema for this TYPE-ID."
(while files
(setq type-ids (rng-possible-type-ids-using (car files) type-ids))
(setq files (cdr files)))
- (rng-uniquify-equal (sort type-ids 'string<))))
+ (seq-uniq (sort type-ids 'string<))))
(defun rng-locate-schema-file-using (files)
"Locate a schema using the schema locating files FILES.
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index 4fc6727d0e6..7a2739c0616 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -472,7 +472,7 @@ list is nullable and whose cdr is the normalized list."
(cons nullable
(if sorted
head
- (rng-uniquify-eq (sort head 'rng-compare-ipattern))))))
+ (seq-uniq (sort head 'rng-compare-ipattern) #'eq)))))
(defun rng-compare-ipattern (p1 p2)
(< (rng--ipattern-index p1)
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index 7d74fd3c8a7..d70a346159a 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -24,7 +24,6 @@
;;; Code:
-(require 'easymenu)
(require 'xmltok)
(require 'nxml-util)
(require 'nxml-ns)
@@ -180,7 +179,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
;; attributes are required
(insert " "))))
((member completion extra-strings)
- (insert ">")))))))))
+ (insert ">"))))
+ :company-kind ,(lambda () 'property))))))
(defconst rng-in-end-tag-name-regex
(replace-regexp-in-string
@@ -255,7 +255,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
(when (and (eq status 'finished)
(not (looking-at "=")))
(insert "=\"\"")
- (forward-char -1)))))))))
+ (forward-char -1)))
+ :company-kind ,(lambda (_) 'enum-member)))))))
(defconst rng-in-attribute-value-regex
(replace-regexp-in-string
@@ -280,7 +281,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
(lambda (_completion status)
(when (eq status 'finished)
(let ((delim (char-before value-start)))
- (unless (eq (char-after) delim) (insert delim)))))))
+ (unless (eq (char-after) delim) (insert delim))))))
+ (kind-function (lambda (_) 'value)))
(and (rng-adjust-state-for-attribute lt-pos
name-start)
(if (string= (buffer-substring-no-properties name-start
@@ -291,14 +293,16 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil."
(rng-possible-namespace-uris
(and colon
(buffer-substring-no-properties (1+ colon) name-end))))
- :exit-function ,exit-function)
+ :exit-function ,exit-function
+ :company-kind ,kind-function)
(rng-adjust-state-for-attribute-value name-start
colon
name-end)
`(,value-start ,(point)
,(rng-strings-to-completion-table
(rng-match-possible-value-strings))
- :exit-function ,exit-function))))))
+ :exit-function ,exit-function
+ :company-kind ,kind-function))))))
(defun rng-possible-namespace-uris (prefix)
(let ((ns (if prefix (nxml-ns-get-prefix prefix)
@@ -523,7 +527,7 @@ set `xmltok-dtd'. Returns the position of the end of the token."
(unless attribute-flag
(setcdr ns-prefixes (cons nil (cdr ns-prefixes))))))
(setq iter (cdr iter)))
- (rng-uniquify-equal
+ (seq-uniq
(sort (apply #'append
(cons extra-strings
(mapcar (lambda (name)
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index fda481fa281..24f4d2ec443 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -93,7 +93,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-error "`?' not escaped in file URI `%s'" uri))
(when fragment-id
(rng-uri-error "URI `%s' has a fragment identifier" uri))
- (when (string-match ";" path)
+ (when (string-search ";" path)
(rng-uri-error "`;' not escaped in URI `%s'" uri))
(when (string-match "%2[fF]" path) ;; 2f is hex code of slash
(rng-uri-error "Escaped slash in URI `%s'" uri))
@@ -110,7 +110,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-unescape-unibyte-replace path 2))
(t
(rng-uri-unescape-unibyte path))))
- (when (string-match "\000" path)
+ (when (string-search "\000" path)
(rng-uri-error "URI `%s' has NUL character in path" uri))
(when (eq pattern 'match)
(setq path
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index a20e95086cb..67e2ee9f1e3 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -36,26 +36,6 @@
(defconst rng-builtin-datatypes-uri (rng-make-datatypes-uri ""))
-(defun rng-uniquify-eq (list)
- "Destructively remove `eq' duplicates from LIST."
- (and list
- (let ((head list))
- (while (cdr head)
- (if (eq (car head) (cadr head))
- (setcdr head (cddr head)))
- (setq head (cdr head)))
- list)))
-
-(defun rng-uniquify-equal (list)
- "Destructively remove `equal' duplicates from LIST."
- (and list
- (let ((head list))
- (while (cdr head)
- (if (equal (car head) (cadr head))
- (setcdr head (cddr head)))
- (setq head (cdr head)))
- list)))
-
(defun rng-blank-p (str) (string-match "\\`[ \t\n\r]*\\'" str))
(defun rng-substq (new old list)
@@ -104,6 +84,14 @@ LIST is not modified."
(define-error 'rng-error nil)
+;; Obsolete.
+
+(defun rng-uniquify-eq (list)
+ (declare (obsolete seq-uniq "28.1"))
+ (seq-uniq list #'eq))
+
+(define-obsolete-function-alias 'rng-uniquify-equal #'seq-uniq "28.1")
+
(provide 'rng-util)
;;; rng-util.el ends here
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 81314b85ca9..9941aba6eb1 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -24,14 +24,14 @@
;; The main entry point is `rng-xsd-compile'. The validator
;; knows to use this for the datatype library with URI
-;; http://www.w3.org/2001/XMLSchema-datatypes because it
+;; https://www.w3.org/2001/XMLSchema-datatypes because it
;; is the value of the rng-dt-compile property on that URI
;; as a symbol.
;;
;; W3C XML Schema Datatypes are specified by
-;; http://www.w3.org/TR/xmlschema-2/
+;; https://www.w3.org/TR/xmlschema-2/
;; Guidelines for using them with RELAX NG are described in
-;; http://relaxng.org/xsd.html
+;; https://relaxng.org/xsd.html
;;; Code:
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 8f89598a5ad..38bc2e141e6 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -324,8 +324,8 @@ and VALUE-END, otherwise a STRING giving the value."
(setq strs (cons (car arg) strs))
(setq names (cons (cdr arg) names)))
(setq args (cdr args))))
- (cons (apply 'concat (nreverse strs))
- (apply 'append (nreverse names))))))
+ (cons (apply #'concat (nreverse strs))
+ (apply #'append (nreverse names))))))
(eval-when-compile
;; Make a symbolic group named NAME from the regexp R.
@@ -338,7 +338,7 @@ and VALUE-END, otherwise a STRING giving the value."
(cons (concat "\\(" (car ,sym) "\\)") (cons ',name (cdr ,sym)))))))
(defun xmltok-p (&rest r) (xmltok+ "\\(?:"
- (apply 'xmltok+ r)
+ (apply #'xmltok+ r)
"\\)"))
;; Get the group index of ELEM in a LIST of symbols.
@@ -372,22 +372,23 @@ and VALUE-END, otherwise a STRING giving the value."
(defmacro xmltok-defregexp (sym r)
`(defalias ',sym
(let ((r ,r))
- `(macro lambda (action &optional group-name)
- (cond ((eq action 'regexp)
- ,(car r))
- ((or (eq action 'start) (eq action 'beginning))
- (list 'match-beginning (xmltok-get-index group-name
- ',(cdr r))))
- ((eq action 'end)
- (list 'match-end (xmltok-get-index group-name
- ',(cdr r))))
- ((eq action 'string)
- (list 'match-string
- (xmltok-get-index group-name ',(cdr r))))
- ((eq action 'string-no-properties)
- (list 'match-string-no-properties
- (xmltok-get-index group-name ',(cdr r))))
- (t (error "Invalid action: %s" action))))))))
+ `(macro
+ . ,(lambda (action &optional group-name)
+ (cond ((eq action 'regexp)
+ (car r))
+ ((or (eq action 'start) (eq action 'beginning))
+ (list 'match-beginning (xmltok-get-index group-name
+ (cdr r))))
+ ((eq action 'end)
+ (list 'match-end (xmltok-get-index group-name
+ (cdr r))))
+ ((eq action 'string)
+ (list 'match-string
+ (xmltok-get-index group-name (cdr r))))
+ ((eq action 'string-no-properties)
+ (list 'match-string-no-properties
+ (xmltok-get-index group-name (cdr r))))
+ (t (error "Invalid action: %s" action)))))))))
(eval-when-compile
@@ -478,7 +479,7 @@ and VALUE-END, otherwise a STRING giving the value."
"[^<'&\r\n\t]*"
(xmltok-g complex1 "[&\r\n\t][^<']*") opt
"'"))
- (lit2 (cons (replace-regexp-in-string "'" "\"" (car lit1))
+ (lit2 (cons (string-replace "'" "\"" (car lit1))
'(complex2)))
(literal (xmltok-g literal lit1 or lit2))
(name (xmltok+ open (xmltok-g xmlns "xmlns") or ncname close
@@ -878,7 +879,7 @@ and VALUE-END, otherwise a STRING giving the value."
(cons " " value-parts)))))
(< (point) end))))
(when well-formed
- (aset att 5 (apply 'concat (nreverse value-parts))))
+ (aset att 5 (apply #'concat (nreverse value-parts))))
(aset att 6 (nreverse refs))))
(defun xmltok-scan-after-amp (entity-handler)
@@ -1333,7 +1334,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
t))))
(if (not well-formed)
nil
- (apply 'concat
+ (apply #'concat
(nreverse (cons (buffer-substring-no-properties start lim)
value-parts))))))
@@ -1358,7 +1359,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
(defun xmltok-require-next-token (&rest types)
(xmltok-next-prolog-token)
- (apply 'xmltok-require-token types))
+ (apply #'xmltok-require-token types))
(defun xmltok-require-token (&rest types)
;; XXX Generate a more helpful error message
diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el
index 1d517dbd116..c9c0956903f 100644
--- a/lisp/obsolete/abbrevlist.el
+++ b/lisp/obsolete/abbrevlist.el
@@ -1,4 +1,4 @@
-;;; abbrevlist.el --- list one abbrev table alphabetically ordered
+;;; abbrevlist.el --- list one abbrev table alphabetically ordered -*- lexical-binding: t; -*-
;; Copyright (C) 1986, 1992, 2001-2021 Free Software Foundation, Inc.
;; Suggested by a previous version by Gildea.
@@ -38,7 +38,7 @@
(function (lambda (abbrev)
(setq abbrev-list (cons abbrev abbrev-list))))
abbrev-table)
- (setq abbrev-list (sort abbrev-list 'string-lessp))
+ (setq abbrev-list (sort abbrev-list #'string-lessp))
(while abbrev-list
(if (> (+ first-column 40) (window-width))
(progn
diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el
index 398f315c5d4..1c3581f7d05 100644
--- a/lisp/obsolete/bruce.el
+++ b/lisp/obsolete/bruce.el
@@ -1,4 +1,4 @@
-;;; bruce.el --- bruce phrase utility for overloading the Communications
+;;; bruce.el --- bruce phrase utility for overloading the Communications -*- lexical-binding: t; -*-
;;; Decency Act snoops, if any.
;; Copyright (C) 1988, 1993, 1997, 2001-2021 Free Software Foundation,
@@ -30,7 +30,7 @@
;; Decency Act of 1996. This Act bans "indecent speech", whatever that is,
;; from the Internet. For more on the CDA, see Richard Stallman's essay on
;; censorship, included in the etc directory of emacs distributions 19.34
-;; and up. See also http://www.eff.org/blueribbon.html.
+;; and up. See also https://www.eff.org/blueribbon.html.
;; For many years, emacs has included a program called Spook. This program
;; adds a series of "keywords" to email just before it goes out. On the
@@ -113,13 +113,11 @@
(defcustom bruce-phrases-file "~/bruce.lines"
"Keep your favorite phrases here."
- :type 'file
- :group 'bruce)
+ :type 'file)
(defcustom bruce-phrase-default-count 15
"Default number of phrases to insert."
- :type 'integer
- :group 'bruce)
+ :type 'integer)
;;;###autoload
(defun bruce ()
diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el
index 96b036e892c..037a8e9e87c 100644
--- a/lisp/obsolete/cc-compat.el
+++ b/lisp/obsolete/cc-compat.el
@@ -1,4 +1,4 @@
-;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion
+;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -156,7 +156,7 @@ This is in addition to c-continued-statement-offset.")
(if bracep 0 c-indent-level)))))
-(defun cc-substatement-open-offset (langelem)
+(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 4abedf3e627..619bc06122b 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -1,4 +1,4 @@
-;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
+;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@@ -46,31 +46,23 @@
;;; Code:
-;; This used to be:
-;; (or (featurep 'cl) (require 'cl))
-;; which just has the effect of fooling the byte-compiler into not
-;; loading cl when compiling. However, that leads to some bogus
-;; compiler warnings. Loading cl when compiling cannot do any harm,
-;; because for a long time bootstrap-emacs contained 'cl, due to being
-;; dumped from uncompiled files that eval-when-compile'd cl. So every
-;; file was compiled with 'cl loaded.
-(require 'cl)
+(require 'cl-lib)
;;; Keyword routines not supported by new package.
(defmacro defkeyword (x &optional doc)
- (list* 'defconst x (list 'quote x) (and doc (list doc))))
+ (cl-list* 'defconst x (list 'quote x) (and doc (list doc))))
(defun keyword-of (sym)
(or (keywordp sym) (keywordp (intern (format ":%s" sym)))))
-;;; Multiple values. Note that the new package uses a different
-;;; convention for multiple values. The following definitions
-;;; emulate the old convention; all function names have been changed
-;;; by capitalizing the first letter: Values, Multiple-value-*,
-;;; to avoid conflict with the new-style definitions in cl-macs.
+;; Multiple values. Note that the new package uses a different
+;; convention for multiple values. The following definitions
+;; emulate the old convention; all function names have been changed
+;; by capitalizing the first letter: Values, Multiple-value-*,
+;; to avoid conflict with the new-style definitions in cl-macs.
(defvar *mvalues-values* nil)
@@ -79,7 +71,7 @@
(car val-forms))
(defun Values-list (val-forms)
- (apply 'values val-forms))
+ (apply #'cl-values val-forms))
(defmacro Multiple-value-list (form)
(list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form))
@@ -95,7 +87,7 @@
(defmacro Multiple-value-bind (vars form &rest body)
(declare (indent 2))
- (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
+ (cl-list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
(defmacro Multiple-value-setq (vars form)
(declare (indent 2))
@@ -103,17 +95,16 @@
(defmacro Multiple-value-prog1 (form &rest body)
(declare (indent 1))
- (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body)))
+ (list 'prog1 form (cl-list* 'let '((*mvalues-values* nil)) body)))
;;; Routines for parsing keyword arguments.
(defun build-klist (arglist keys &optional allow-others)
- (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist))))
+ (let ((res (Multiple-value-call #'cl-mapcar 'cons (unzip-lists arglist))))
(or allow-others
- (with-suppressed-warnings ((obsolete set-difference))
- (let ((bad (set-difference (mapcar 'car res) keys)))
- (if bad (error "Bad keywords: %s not in %s" bad keys)))))
+ (let ((bad (cl-set-difference (mapcar #'car res) keys)))
+ (if bad (error "Bad keywords: %s not in %s" bad keys))))
res))
(defun extract-from-klist (klist key &optional def)
@@ -131,18 +122,16 @@
(funcall (or test 'eql) item elt))))
(defun safe-idiv (a b)
- (with-suppressed-warnings ((obsolete signum))
- (let* ((q (/ (abs a) (abs b)))
- (s (* (signum a) (signum b))))
- (Values q (- a (* s q b)) s))))
+ (let* ((q (/ (abs a) (abs b)))
+ (s (* (cl-signum a) (cl-signum b))))
+ (Values q (- a (* s q b)) s)))
;; Internal routines.
(defun pair-with-newsyms (oldforms)
- (with-suppressed-warnings ((obsolete mapcar*))
- (let ((newsyms (mapcar (lambda (x) (make-symbol "--cl-var--")) oldforms)))
- (Values (mapcar* 'list newsyms oldforms) newsyms))))
+ (let ((newsyms (mapcar (lambda (_) (make-symbol "--cl-var--")) oldforms)))
+ (Values (cl-mapcar #'list newsyms oldforms) newsyms)))
(defun zip-lists (evens odds)
(cl-mapcan 'list evens odds))
@@ -154,7 +143,7 @@
(Values (nreverse e) (nreverse o))))
(defun reassemble-argslists (list)
- (let ((n (apply 'min (mapcar 'length list))) (res nil))
+ (let ((n (apply #'min (mapcar #'length list))) (res nil))
(while (>= (setq n (1- n)) 0)
(setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res)))
res))
diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el
index 95af29bb87f..9df62318572 100644
--- a/lisp/obsolete/cl.el
+++ b/lisp/obsolete/cl.el
@@ -331,7 +331,7 @@ The two cases that are handled are:
(cddr f))))
(if (and cl-closure-vars
(cl--expr-contains-any body cl-closure-vars))
- (let* ((new (mapcar 'cl-gensym cl-closure-vars))
+ (let* ((new (mapcar #'cl-gensym cl-closure-vars))
(sub (cl-pairlis cl-closure-vars new)) (decls nil))
(while (or (stringp (car body))
(eq (car-safe (car body)) 'interactive))
@@ -431,14 +431,13 @@ definitions, or lack thereof).
(obsolete "use either `cl-flet' or `cl-letf'." "24.3"))
`(letf ,(mapcar
(lambda (x)
- (if (or (and (fboundp (car x))
- (eq (car-safe (symbol-function (car x))) 'macro))
+ (if (or (eq (car-safe (symbol-function (car x))) 'macro)
(cdr (assq (car x) macroexpand-all-environment)))
(error "Use `labels', not `flet', to rebind macro names"))
(let ((func `(cl-function
(lambda ,(cadr x)
(cl-block ,(car x) ,@(cddr x))))))
- (when (cl--compiling-file)
+ (when (macroexp-compiling-p)
;; Bug#411. It would be nice to fix this.
(and (get (car x) 'byte-compile)
(error "Byte-compiling a redefinition of `%s' \
@@ -446,7 +445,7 @@ will not work - use `labels' instead" (symbol-name (car x))))
;; FIXME This affects the rest of the file, when it
;; should be restricted to the flet body.
(and (boundp 'byte-compile-function-environment)
- (push (cons (car x) (eval func))
+ (push (cons (car x) (eval func t))
byte-compile-function-environment)))
(list `(symbol-function ',(car x)) func)))
bindings)
@@ -466,10 +465,10 @@ rather than relying on `lexical-binding'."
(push `(cl-function (lambda . ,(cdr binding))) sets)
(push var sets)
(push (cons (car binding)
- `(lambda (&rest cl-labels-args)
- (if (eq (car cl-labels-args) cl--labels-magic)
- (list cl--labels-magic ',var)
- (cl-list* 'funcall ',var cl-labels-args))))
+ (lambda (&rest cl-labels-args)
+ (if (eq (car cl-labels-args) cl--labels-magic)
+ (list cl--labels-magic var)
+ (cl-list* 'funcall var cl-labels-args))))
newenv)))
;; `lexical-let' adds `cl--function-convert' (which calls
;; `cl--labels-convert') as a macroexpander for `function'.
@@ -630,10 +629,10 @@ You can replace this macro with `gv-letplace'."
;;; Additional compatibility code.
;; For names that were clean but really aren't needed any more.
-(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.3")
+(define-obsolete-function-alias 'cl-macroexpand #'macroexpand "24.3")
(define-obsolete-variable-alias 'cl-macro-environment
'macroexpand-all-environment "24.3")
-(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.3")
+(define-obsolete-function-alias 'cl-macroexpand-all #'macroexpand-all "24.3")
;;; Hash tables.
;; This is just kept for compatibility with code byte-compiled by Emacs-20.
@@ -652,22 +651,22 @@ You can replace this macro with `gv-letplace'."
(defvar cl-builtin-maphash (symbol-function 'maphash))
(make-obsolete-variable 'cl-builtin-maphash nil "24.3")
-(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.3")
-(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.3")
-(define-obsolete-function-alias 'cl-gethash 'gethash "24.3")
-(define-obsolete-function-alias 'cl-puthash 'puthash "24.3")
-(define-obsolete-function-alias 'cl-remhash 'remhash "24.3")
-(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.3")
-(define-obsolete-function-alias 'cl-maphash 'maphash "24.3")
-(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.3")
-(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.3")
-(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.3")
+(define-obsolete-function-alias 'cl-map-keymap #'map-keymap "24.3")
+(define-obsolete-function-alias 'cl-copy-tree #'copy-tree "24.3")
+(define-obsolete-function-alias 'cl-gethash #'gethash "24.3")
+(define-obsolete-function-alias 'cl-puthash #'puthash "24.3")
+(define-obsolete-function-alias 'cl-remhash #'remhash "24.3")
+(define-obsolete-function-alias 'cl-clrhash #'clrhash "24.3")
+(define-obsolete-function-alias 'cl-maphash #'maphash "24.3")
+(define-obsolete-function-alias 'cl-make-hash-table #'make-hash-table "24.3")
+(define-obsolete-function-alias 'cl-hash-table-p #'hash-table-p "24.3")
+(define-obsolete-function-alias 'cl-hash-table-count #'hash-table-count "24.3")
(define-obsolete-function-alias 'cl-map-keymap-recursively
- 'cl--map-keymap-recursively "24.3")
-(define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.3")
-(define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.3")
-(define-obsolete-function-alias 'cl-set-getf 'cl--set-getf "24.3")
+ #'cl--map-keymap-recursively "24.3")
+(define-obsolete-function-alias 'cl-map-intervals #'cl--map-intervals "24.3")
+(define-obsolete-function-alias 'cl-map-extents #'cl--map-overlays "24.3")
+(define-obsolete-function-alias 'cl-set-getf #'cl--set-getf "24.3")
(defun cl-maclisp-member (item list)
(declare (obsolete member "24.3"))
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index 735e1e0b6a6..2d3be2dd9a4 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -1,4 +1,4 @@
-;;; complete.el --- partial completion mechanism plus other goodies
+;;; complete.el --- partial completion mechanism plus other goodies -*- lexical-binding: t; -*-
;; Copyright (C) 1990-1993, 1999-2021 Free Software Foundation, Inc.
@@ -102,14 +102,12 @@ If non-nil and non-t, the first character is taken literally only for file name
completion."
:type '(choice (const :tag "delimiter" nil)
(const :tag "literal" t)
- (other :tag "find-file" find-file))
- :group 'partial-completion)
+ (other :tag "find-file" find-file)))
(defcustom PC-meta-flag t
"If non-nil, TAB means PC completion and M-TAB means normal completion.
Otherwise, TAB means normal completion and M-TAB means Partial Completion."
- :type 'boolean
- :group 'partial-completion)
+ :type 'boolean)
(defcustom PC-word-delimiters "-_. "
"A string of characters treated as word delimiters for completion.
@@ -119,19 +117,16 @@ If `^' is in this string, it must not come first.
If `-' is in this string, it must come first or right after `]'.
In other words, if S is this string, then `[S]' must be a valid Emacs regular
expression (not containing character ranges like `a-z')."
- :type 'string
- :group 'partial-completion)
+ :type 'string)
(defcustom PC-include-file-path '("/usr/include" "/usr/local/include")
"A list of directories in which to look for include files.
If nil, means use the colon-separated path in the variable $INCPATH instead."
- :type '(repeat directory)
- :group 'partial-completion)
+ :type '(repeat directory))
(defcustom PC-disable-includes nil
"If non-nil, include-file support in \\[find-file] is disabled."
- :type 'boolean
- :group 'partial-completion)
+ :type 'boolean)
(defvar PC-default-bindings t
"If non-nil, default partial completion key bindings are suppressed.")
@@ -146,36 +141,36 @@ If nil, means use the colon-separated path in the variable $INCPATH instead."
(cond ((not bind)
;; These bindings are the default bindings. It would be better to
;; restore the previous bindings.
- (define-key read-expression-map "\e\t" 'lisp-complete-symbol)
+ (define-key read-expression-map "\e\t" #'completion-at-point)
- (define-key completion-map "\t" 'minibuffer-complete)
- (define-key completion-map " " 'minibuffer-complete-word)
- (define-key completion-map "?" 'minibuffer-completion-help)
+ (define-key completion-map "\t" #'minibuffer-complete)
+ (define-key completion-map " " #'minibuffer-complete-word)
+ (define-key completion-map "?" #'minibuffer-completion-help)
- (define-key must-match-map "\r" 'minibuffer-complete-and-exit)
- (define-key must-match-map "\n" 'minibuffer-complete-and-exit)
+ (define-key must-match-map "\r" #'minibuffer-complete-and-exit)
+ (define-key must-match-map "\n" #'minibuffer-complete-and-exit)
(define-key global-map [remap lisp-complete-symbol] nil))
(PC-default-bindings
- (define-key read-expression-map "\e\t" 'PC-lisp-complete-symbol)
+ (define-key read-expression-map "\e\t" #'PC-lisp-complete-symbol)
- (define-key completion-map "\t" 'PC-complete)
- (define-key completion-map " " 'PC-complete-word)
- (define-key completion-map "?" 'PC-completion-help)
+ (define-key completion-map "\t" #'PC-complete)
+ (define-key completion-map " " #'PC-complete-word)
+ (define-key completion-map "?" #'PC-completion-help)
- (define-key completion-map "\e\t" 'PC-complete)
- (define-key completion-map "\e " 'PC-complete-word)
- (define-key completion-map "\e\r" 'PC-force-complete-and-exit)
- (define-key completion-map "\e\n" 'PC-force-complete-and-exit)
- (define-key completion-map "\e?" 'PC-completion-help)
+ (define-key completion-map "\e\t" #'PC-complete)
+ (define-key completion-map "\e " #'PC-complete-word)
+ (define-key completion-map "\e\r" #'PC-force-complete-and-exit)
+ (define-key completion-map "\e\n" #'PC-force-complete-and-exit)
+ (define-key completion-map "\e?" #'PC-completion-help)
- (define-key must-match-map "\r" 'PC-complete-and-exit)
- (define-key must-match-map "\n" 'PC-complete-and-exit)
+ (define-key must-match-map "\r" #'PC-complete-and-exit)
+ (define-key must-match-map "\n" #'PC-complete-and-exit)
- (define-key must-match-map "\e\r" 'PC-complete-and-exit)
- (define-key must-match-map "\e\n" 'PC-complete-and-exit)
+ (define-key must-match-map "\e\r" #'PC-complete-and-exit)
+ (define-key must-match-map "\e\n" #'PC-complete-and-exit)
- (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol)))))
+ (define-key global-map [remap lisp-complete-symbol] #'PC-lisp-complete-symbol)))))
(defvar PC-do-completion-end nil
"Internal variable used by `PC-do-completion'.")
@@ -212,14 +207,15 @@ see), so that if it is neither nil nor t, Emacs shows the `*Completions*'
buffer only on the second attempt to complete. That is, if TAB finds nothing
to complete, the first TAB just says \"Next char not unique\" and the
second TAB brings up the `*Completions*' buffer."
- :global t :group 'partial-completion
+ :global t
;; Deal with key bindings...
(PC-bindings partial-completion-mode)
;; Deal with include file feature...
(cond ((not partial-completion-mode)
- (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file))
+ (remove-hook 'find-file-not-found-functions
+ #'PC-look-for-include-file))
((not PC-disable-includes)
- (add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))
+ (add-hook 'find-file-not-found-functions #'PC-look-for-include-file)))
;; Adjust the completion selection in *Completion* buffers to the way
;; we work. The default minibuffer completion code only completes the
;; text before point and leaves the text after point alone (new in
@@ -229,9 +225,9 @@ second TAB brings up the `*Completions*' buffer."
;; to trick choose-completion into replacing the whole minibuffer text
;; rather than only the text before point. --Stef
(funcall
- (if partial-completion-mode 'add-hook 'remove-hook)
+ (if partial-completion-mode #'add-hook #'remove-hook)
'choose-completion-string-functions
- (lambda (choice buffer &rest ignored)
+ (lambda (_choice buffer &rest _)
;; When completing M-: (lisp- ) with point before the ), it is
;; not appropriate to go to point-max (unlike the filename case).
(if (and (not PC-goto-end)
@@ -247,7 +243,7 @@ second TAB brings up the `*Completions*' buffer."
(when (and partial-completion-mode (null PC-env-vars-alist))
(setq PC-env-vars-alist
(mapcar (lambda (string)
- (let ((d (string-match "=" string)))
+ (let ((d (string-search "=" string)))
(cons (concat "$" (substring string 0 d))
(and d (substring string (1+ d))))))
process-environment))))
@@ -579,7 +575,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
p (+ p (length PC-ndelims-regex) 1)))))
(setq p 0)
(if filename
- (while (setq p (string-match "\\\\\\*" regex p))
+ (while (setq p (string-search "\\*" regex p))
(setq regex (concat (substring regex 0 p)
"[^/]*"
(substring regex (+ p 2))))))
@@ -648,7 +644,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
(when (string-match regex x)
(push x p)))
(setq basestr (try-completion "" p)))
- (setq basestr (mapconcat 'list str "-"))
+ (setq basestr (mapconcat #'list str "-"))
(delete-region beg end)
(setq end (+ beg (length basestr)))
(insert basestr))))
@@ -672,7 +668,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
(setq PC-ignored-regexp
(concat "\\("
(mapconcat
- 'regexp-quote
+ #'regexp-quote
(setq PC-ignored-extensions
completion-ignored-extensions)
"\\|")
@@ -815,7 +811,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
(eq mode 'help))
(let ((prompt-end (minibuffer-prompt-end)))
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list (sort helpposs 'string-lessp))
+ (display-completion-list (sort helpposs #'string-lessp))
(setq PC-do-completion-end end
PC-goto-end goto-end)
(with-current-buffer standard-output
@@ -1093,7 +1089,7 @@ absolute rather than relative to some directory on the SEARCH-PATH."
file-lists))))
(setq search-path (cdr search-path))))
;; Compress out duplicates while building complete list (slloooow!)
- (let ((sorted (sort (apply 'nconc file-lists)
+ (let ((sorted (sort (apply #'nconc file-lists)
(lambda (x y) (not (string-lessp x y)))))
compressed)
(while sorted
diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el
index 91ff899c84d..69bf3ed12bc 100644
--- a/lisp/obsolete/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -1,4 +1,4 @@
-;;; crisp.el --- CRiSP/Brief Emacs emulator
+;;; crisp.el --- CRiSP/Brief Emacs emulator -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc.
@@ -66,63 +66,63 @@
(defvar crisp-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [(f1)] 'other-window)
+ (define-key map [(f1)] #'other-window)
- (define-key map [(f2) (down)] 'enlarge-window)
- (define-key map [(f2) (left)] 'shrink-window-horizontally)
- (define-key map [(f2) (right)] 'enlarge-window-horizontally)
- (define-key map [(f2) (up)] 'shrink-window)
- (define-key map [(f3) (down)] 'split-window-below)
- (define-key map [(f3) (right)] 'split-window-right)
+ (define-key map [(f2) (down)] #'enlarge-window)
+ (define-key map [(f2) (left)] #'shrink-window-horizontally)
+ (define-key map [(f2) (right)] #'enlarge-window-horizontally)
+ (define-key map [(f2) (up)] #'shrink-window)
+ (define-key map [(f3) (down)] #'split-window-below)
+ (define-key map [(f3) (right)] #'split-window-right)
- (define-key map [(f4)] 'delete-window)
- (define-key map [(control f4)] 'delete-other-windows)
+ (define-key map [(f4)] #'delete-window)
+ (define-key map [(control f4)] #'delete-other-windows)
- (define-key map [(f5)] 'search-forward-regexp)
- (define-key map [(f19)] 'search-forward-regexp)
- (define-key map [(meta f5)] 'search-backward-regexp)
+ (define-key map [(f5)] #'search-forward-regexp)
+ (define-key map [(f19)] #'search-forward-regexp)
+ (define-key map [(meta f5)] #'search-backward-regexp)
- (define-key map [(f6)] 'query-replace)
+ (define-key map [(f6)] #'query-replace)
- (define-key map [(f7)] 'start-kbd-macro)
- (define-key map [(meta f7)] 'end-kbd-macro)
+ (define-key map [(f7)] #'start-kbd-macro)
+ (define-key map [(meta f7)] #'end-kbd-macro)
- (define-key map [(f8)] 'call-last-kbd-macro)
- (define-key map [(meta f8)] 'save-kbd-macro)
+ (define-key map [(f8)] #'call-last-kbd-macro)
+ ;;(define-key map [(meta f8)] #'save-kbd-macro) ;FIXME:Unknown command?
- (define-key map [(f9)] 'find-file)
- (define-key map [(meta f9)] 'load-library)
+ (define-key map [(f9)] #'find-file)
+ (define-key map [(meta f9)] #'load-library)
- (define-key map [(f10)] 'execute-extended-command)
- (define-key map [(meta f10)] 'compile)
+ (define-key map [(f10)] #'execute-extended-command)
+ (define-key map [(meta f10)] #'compile)
- (define-key map [(SunF37)] 'kill-buffer)
- (define-key map [(kp-add)] 'crisp-copy-line)
- (define-key map [(kp-subtract)] 'crisp-kill-line)
+ (define-key map [(SunF37)] #'kill-buffer)
+ (define-key map [(kp-add)] #'crisp-copy-line)
+ (define-key map [(kp-subtract)] #'crisp-kill-line)
;; just to cover all the bases (GNU Emacs, for instance)
- (define-key map [(f24)] 'crisp-kill-line)
- (define-key map [(insert)] 'crisp-yank-clipboard)
- (define-key map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd
- (define-key map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd
- (define-key map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd
+ (define-key map [(f24)] #'crisp-kill-line)
+ (define-key map [(insert)] #'crisp-yank-clipboard)
+ (define-key map [(f16)] #'crisp-set-clipboard) ; copy on Sun5 kbd
+ (define-key map [(f20)] #'crisp-kill-region) ; cut on Sun5 kbd
+ (define-key map [(f18)] #'crisp-yank-clipboard) ; paste on Sun5 kbd
- (define-key map [(control f)] 'fill-paragraph-or-region)
+ ;; (define-key map [(control f)] #'fill-paragraph-or-region)
(define-key map [(meta d)] (lambda ()
(interactive)
(beginning-of-line) (kill-line)))
- (define-key map [(meta e)] 'find-file)
- (define-key map [(meta g)] 'goto-line)
- (define-key map [(meta h)] 'help)
- (define-key map [(meta i)] 'overwrite-mode)
- (define-key map [(meta j)] 'bookmark-jump)
- (define-key map [(meta l)] 'crisp-mark-line)
- (define-key map [(meta m)] 'set-mark-command)
- (define-key map [(meta n)] 'bury-buffer)
- (define-key map [(meta p)] 'crisp-unbury-buffer)
- (define-key map [(meta u)] 'undo)
- (define-key map [(f14)] 'undo)
- (define-key map [(meta w)] 'save-buffer)
- (define-key map [(meta x)] 'crisp-meta-x-wrapper)
+ (define-key map [(meta e)] #'find-file)
+ (define-key map [(meta g)] #'goto-line)
+ (define-key map [(meta h)] #'help)
+ (define-key map [(meta i)] #'overwrite-mode)
+ (define-key map [(meta j)] #'bookmark-jump)
+ (define-key map [(meta l)] #'crisp-mark-line)
+ (define-key map [(meta m)] #'set-mark-command)
+ (define-key map [(meta n)] #'bury-buffer)
+ (define-key map [(meta p)] #'crisp-unbury-buffer)
+ (define-key map [(meta u)] #'undo)
+ (define-key map [(f14)] #'undo)
+ (define-key map [(meta w)] #'save-buffer)
+ (define-key map [(meta x)] #'crisp-meta-x-wrapper)
(define-key map [(meta ?0)] (lambda ()
(interactive)
(bookmark-set "0")))
@@ -154,21 +154,21 @@
(interactive)
(bookmark-set "9")))
- (define-key map [(shift delete)] 'kill-word)
- (define-key map [(shift backspace)] 'backward-kill-word)
- (define-key map [(control left)] 'backward-word)
- (define-key map [(control right)] 'forward-word)
+ (define-key map [(shift delete)] #'kill-word)
+ (define-key map [(shift backspace)] #'backward-kill-word)
+ (define-key map [(control left)] #'backward-word)
+ (define-key map [(control right)] #'forward-word)
- (define-key map [(home)] 'crisp-home)
+ (define-key map [(home)] #'crisp-home)
(define-key map [(control home)] (lambda ()
(interactive)
(move-to-window-line 0)))
- (define-key map [(meta home)] 'beginning-of-line)
- (define-key map [(end)] 'crisp-end)
+ (define-key map [(meta home)] #'beginning-of-line)
+ (define-key map [(end)] #'crisp-end)
(define-key map [(control end)] (lambda ()
(interactive)
(move-to-window-line -1)))
- (define-key map [(meta end)] 'end-of-line)
+ (define-key map [(meta end)] #'end-of-line)
map)
"Local keymap for CRiSP emulation mode.
All the bindings are done here instead of globally to try and be
@@ -179,8 +179,7 @@ nice to the world.")
(defcustom crisp-mode-mode-line-string " *CRiSP*"
"String to display in the mode line when CRiSP emulation mode is enabled."
- :type 'string
- :group 'crisp)
+ :type 'string)
;;;###autoload
(defcustom crisp-mode nil
@@ -190,20 +189,18 @@ indicates CRiSP mode is enabled.
Setting this variable directly does not take effect;
use either M-x customize or the function `crisp-mode'."
- :set (lambda (symbol value) (crisp-mode (if value 1 0)))
- :initialize 'custom-initialize-default
+ :set (lambda (_symbol value) (crisp-mode (if value 1 0)))
+ :initialize #'custom-initialize-default
:require 'crisp
:version "20.4"
- :type 'boolean
- :group 'crisp)
+ :type 'boolean)
(defcustom crisp-override-meta-x t
"Controls overriding the normal Emacs M-x key binding in the CRiSP emulator.
Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and
provides the usual M-x functionality on the F10 key. If this variable
is non-nil, M-x will exit Emacs."
- :type 'boolean
- :group 'crisp)
+ :type 'boolean)
(defcustom crisp-load-scroll-all nil
"Controls loading of the Scroll Lock in the CRiSP emulator.
@@ -212,18 +209,15 @@ package when enabling the CRiSP emulator.
If this variable is nil when you start the CRiSP emulator, it
does not load the scroll-all package."
- :type 'boolean
- :group 'crisp)
+ :type 'boolean)
(defcustom crisp-load-hook nil
"Hooks to run after loading the CRiSP emulator package."
- :type 'hook
- :group 'crisp)
+ :type 'hook)
(defcustom crisp-mode-hook nil
"Hook run by the function `crisp-mode'."
- :type 'hook
- :group 'crisp)
+ :type 'hook)
(defconst crisp-version "1.34"
"The version of the CRiSP emulator.")
@@ -370,11 +364,11 @@ normal CRiSP binding) and when it is nil M-x will run
(if crisp-load-scroll-all
(require 'scroll-all))
(if (featurep 'scroll-all)
- (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode))))
+ (define-key crisp-mode-map [(meta f1)] #'scroll-all-mode))))
;; People might use Apropos on `brief'.
;;;###autoload
-(defalias 'brief-mode 'crisp-mode)
+(defalias 'brief-mode #'crisp-mode)
(run-hooks 'crisp-load-hook)
(provide 'crisp)
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index c7342b61ae7..01fcd38199c 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -1,4 +1,4 @@
-;;; cust-print.el --- handles print-level and print-circle
+;;; cust-print.el --- handles print-level and print-circle -*- lexical-binding: t; -*-
;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc.
@@ -118,9 +118,6 @@
;; Emacs 18 doesn't have defalias.
;; Provide def for byte compiler.
-(eval-and-compile
- (or (fboundp 'defalias) (fset 'defalias 'fset)))
-
;; Variables:
;;=========================================================
@@ -141,8 +138,7 @@ If non-nil, components at levels equal to or greater than `print-level'
are printed simply as `#'. The object to be printed is at level 0,
and if the object is a list or vector, its top-level components are at
level 1."
- :type '(choice (const nil) integer)
- :group 'cust-print)
+ :type '(choice (const nil) integer))
(defcustom print-circle nil
@@ -157,14 +153,12 @@ If non-nil, shared substructures anywhere in the structure are printed
with `#N=' before the first occurrence (in the order of the print
representation) and `#N#' in place of each subsequent occurrence,
where N is a positive decimal integer."
- :type 'boolean
- :group 'cust-print)
+ :type 'boolean)
(defcustom custom-print-vectors nil
"Non-nil if printing of vectors should obey `print-level' and `print-length'."
- :type 'boolean
- :group 'cust-print)
+ :type 'boolean)
;; Custom printers
@@ -201,7 +195,7 @@ Any pair that has the same PREDICATE is first removed."
(cust-print-update-custom-printers))
-(defun cust-print-use-custom-printer (object)
+(defun cust-print-use-custom-printer (_object)
;; Default function returns nil.
nil)
@@ -231,11 +225,11 @@ Any pair that has the same PREDICATE is first removed."
(defalias (car symbol-pair)
(symbol-function (car (cdr symbol-pair)))))
-(defun cust-print-original-princ (object &optional stream)) ; dummy def
+(defun cust-print-original-princ (_object &optional _stream) nil) ; dummy def
;; Save emacs routines.
(if (not (fboundp 'cust-print-original-prin1))
- (mapc 'cust-print-set-function-cell
+ (mapc #'cust-print-set-function-cell
'((cust-print-original-prin1 prin1)
(cust-print-original-princ princ)
(cust-print-original-print print)
@@ -243,14 +237,15 @@ Any pair that has the same PREDICATE is first removed."
(cust-print-original-format format)
(cust-print-original-message message)
(cust-print-original-error error))))
-
+(declare-function cust-print-original-format "cust-print")
+(declare-function cust-print-original-message "cust-print")
(defun custom-print-install ()
"Replace print functions with general, customizable, Lisp versions.
The Emacs subroutines are saved away, and you can reinstall them
by running `custom-print-uninstall'."
(interactive)
- (mapc 'cust-print-set-function-cell
+ (mapc #'cust-print-set-function-cell
'((prin1 custom-prin1)
(princ custom-princ)
(print custom-print)
@@ -264,7 +259,7 @@ by running `custom-print-uninstall'."
(defun custom-print-uninstall ()
"Reset print functions to their Emacs subroutines."
(interactive)
- (mapc 'cust-print-set-function-cell
+ (mapc #'cust-print-set-function-cell
'((prin1 cust-print-original-prin1)
(princ cust-print-original-princ)
(print cust-print-original-print)
@@ -275,22 +270,20 @@ by running `custom-print-uninstall'."
))
t)
-(defalias 'custom-print-funcs-installed-p 'custom-print-installed-p)
+(defalias 'custom-print-funcs-installed-p #'custom-print-installed-p)
(defun custom-print-installed-p ()
"Return t if custom-print is currently installed, nil otherwise."
(eq (symbol-function 'custom-prin1) (symbol-function 'prin1)))
-(put 'with-custom-print-funcs 'edebug-form-spec '(body))
-(put 'with-custom-print 'edebug-form-spec '(body))
-
-(defalias 'with-custom-print-funcs 'with-custom-print)
(defmacro with-custom-print (&rest body)
"Temporarily install the custom print package while executing BODY."
+ (declare (debug t))
`(unwind-protect
(progn
(custom-print-install)
,@body)
(custom-print-uninstall)))
+(defalias 'with-custom-print-funcs #'with-custom-print)
;; Lisp replacements for prin1 and princ, and for some subrs that use them
@@ -369,7 +362,7 @@ vector, or symbol args. The format specification for such args should
be `%s' in any case, so a string argument will also work. The string
is generated with `custom-prin1-to-string', which quotes quotable
characters."
- (apply 'cust-print-original-format fmt
+ (apply #'cust-print-original-format fmt
(mapcar (function (lambda (arg)
(if (or (listp arg) (vectorp arg) (symbolp arg))
(custom-prin1-to-string arg)
@@ -393,7 +386,7 @@ See `custom-format' for the details."
;; because the echo area requires special handling
;; to avoid duplicating the output.
;; cust-print-original-message does it right.
- (apply 'cust-print-original-message fmt
+ (apply #'cust-print-original-message fmt
(mapcar (function (lambda (arg)
(if (or (listp arg) (vectorp arg) (symbolp arg))
(custom-prin1-to-string arg)
@@ -406,7 +399,7 @@ See `custom-format' for the details."
This is the custom-print replacement for the standard `error'.
See `custom-format' for the details."
- (signal 'error (list (apply 'custom-format fmt args))))
+ (signal 'error (list (apply #'custom-format fmt args))))
@@ -417,9 +410,9 @@ See `custom-format' for the details."
(defvar circle-table)
(defvar cust-print-current-level)
-(defun cust-print-original-printer (object)) ; One of the standard printers.
-(defun cust-print-low-level-prin (object)) ; Used internally.
-(defun cust-print-prin (object)) ; Call this to print recursively.
+(defun cust-print-original-printer (_object) nil) ; One of the standard printers.
+(defun cust-print-low-level-prin (_object) nil) ; Used internally.
+(defun cust-print-prin (_object) nil) ; Call this to print recursively.
(defun cust-print-top-level (object stream emacs-printer)
;; Set up for printing.
diff --git a/lisp/obsolete/erc-compat.el b/lisp/obsolete/erc-compat.el
index 203ef079c14..9972e927e61 100644
--- a/lisp/obsolete/erc-compat.el
+++ b/lisp/obsolete/erc-compat.el
@@ -1,4 +1,4 @@
-;;; erc-compat.el --- ERC compatibility code for XEmacs
+;;; erc-compat.el --- ERC compatibility code for XEmacs -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
@@ -31,8 +31,7 @@
(require 'format-spec)
;;;###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)
+(defalias 'erc-define-minor-mode #'define-minor-mode)
(defun erc-decode-coding-string (s coding-system)
"Decode S using CODING-SYSTEM."
@@ -73,7 +72,7 @@ are placed.
Note that this should end with a directory separator.")
(defun erc-replace-match-subexpression-in-string
- (newtext string match subexp start &optional fixedcase literal)
+ (newtext string _match subexp _start &optional fixedcase literal)
"Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT.
MATCH is the text which matched the subexpression (see `match-string').
START is the beginning position of the last match (see `match-beginning').
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index fce79f7f34f..36b08d56f7b 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -1,4 +1,4 @@
-;;; erc-hecomplete.el --- Provides Nick name completion for ERC
+;;; erc-hecomplete.el --- Provides Nick name completion for ERC -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2002, 2004, 2006-2021 Free Software Foundation,
;; Inc.
@@ -39,8 +39,8 @@
;;;###autoload (autoload 'erc-hecomplete-mode "erc-hecomplete" nil t)
(define-erc-module hecomplete nil
"Complete nick at point."
- ((add-hook 'erc-complete-functions 'erc-hecomplete))
- ((remove-hook 'erc-complete-functions 'erc-hecomplete)))
+ ((add-hook 'erc-complete-functions #'erc-hecomplete))
+ ((remove-hook 'erc-complete-functions #'erc-hecomplete)))
(defun erc-hecomplete ()
"Complete nick at point.
@@ -70,15 +70,13 @@ or you may use an arbitrary lisp expression."
erc-nick-completion-exclude-myself)
(repeat :tag "List" (string :tag "Nick"))
function
- sexp)
- :group 'erc-hecomplete)
+ sexp))
(defcustom erc-nick-completion-ignore-case t
"Non-nil means don't consider case significant in nick completion.
Case will be automatically corrected when non-nil.
For instance if you type \"dely TAB\" the word completes and changes to
\"delYsid\"."
- :group 'erc-hecomplete
:type 'boolean)
(defun erc-nick-completion-exclude-myself ()
@@ -95,7 +93,6 @@ typing \"f o TAB\" will directly give you foobar. Use this with
(defcustom erc-nick-completion-postfix ": "
"When `erc-complete' is used in the first word after the prompt,
add this string when a unique expansion was found."
- :group 'erc-hecomplete
:type 'string)
(defun erc-command-list ()
diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el
index c7212e3fdb7..187879ce2f7 100644
--- a/lisp/obsolete/eudcb-ph.el
+++ b/lisp/obsolete/eudcb-ph.el
@@ -1,4 +1,4 @@
-;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
+;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -69,7 +69,7 @@ defaulting to `eudc-default-return-attributes'."
query
" "))
(if return-fields
- (concat " return " (mapconcat 'symbol-name return-fields " ")))))
+ (concat " return " (mapconcat #'symbol-name return-fields " ")))))
(and (> (length request) 6)
(eudc-ph-do-request request)
(eudc-ph-parse-query-result return-fields))))
@@ -189,7 +189,7 @@ SERVER is either a string naming the server or a list (NAME PORT)."
(with-current-buffer (process-buffer process)
(eudc-ph-send-command process "quit")
(eudc-ph-read-response process)
- (run-at-time 2 nil 'delete-process process)))
+ (run-at-time 2 nil #'delete-process process)))
(defun eudc-ph-send-command (process command)
(goto-char (point-max))
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index 8848c89c62f..960233d5627 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -1,4 +1,4 @@
-;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
+;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
@@ -190,18 +190,6 @@
(defvar font-lock-face-list)
(eval-when-compile
- ;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (varlist &rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state."
- `(let* (,@(append varlist
- '((modified (buffer-modified-p)) (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)))
- ,@body
- (when (and (not modified) (buffer-modified-p))
- (set-buffer-modified-p nil))))
- (put 'save-buffer-state 'lisp-indent-function 1)
;;
;; We use this to verify that a face should be saved.
(defmacro fast-lock-save-facep (face)
@@ -244,8 +232,7 @@ for buffers in Rmail mode, and size is irrelevant otherwise."
(symbol :tag "name"))
(radio :tag "Size"
(const :tag "none" nil)
- (integer :tag "size")))))
- :group 'fast-lock)
+ (integer :tag "size"))))))
(defcustom fast-lock-cache-directories '("~/.emacs-flc")
; - `internal', keep each file's Font Lock cache file in the same file.
@@ -271,8 +258,7 @@ to avoid the possibility of using the cache of another user."
:type '(repeat (radio (directory :tag "directory")
(cons :tag "Matching"
(regexp :tag "regexp")
- (directory :tag "directory"))))
- :group 'fast-lock)
+ (directory :tag "directory")))))
(put 'fast-lock-cache-directories 'risky-local-variable t)
(defcustom fast-lock-save-events '(kill-buffer kill-emacs)
@@ -282,23 +268,20 @@ If concurrent editing sessions use the same associated cache file for a file's
buffer, then you should add `save-buffer' to this list."
:type '(set (const :tag "buffer saving" save-buffer)
(const :tag "buffer killing" kill-buffer)
- (const :tag "emacs killing" kill-emacs))
- :group 'fast-lock)
+ (const :tag "emacs killing" kill-emacs)))
(defcustom fast-lock-save-others t
"If non-nil, save Font Lock cache files irrespective of file owner.
If nil, means only buffer files known to be owned by you can have associated
Font Lock cache files saved. Ownership may be unknown for networked files."
- :type 'boolean
- :group 'fast-lock)
+ :type 'boolean)
(defcustom fast-lock-verbose font-lock-verbose
"If non-nil, means show status messages for cache processing.
If a number, only buffers greater than this size have processing messages."
:type '(choice (const :tag "never" nil)
(other :tag "always" t)
- (integer :tag "size"))
- :group 'fast-lock)
+ (integer :tag "size")))
(defvar fast-lock-save-faces
(when (featurep 'xemacs)
@@ -455,8 +438,7 @@ See `fast-lock-mode'."
;; Flag so that a cache will be saved later even if the file is never saved.
(setq fast-lock-cache-timestamp nil))
-(defalias 'fast-lock-after-unfontify-buffer
- 'ignore)
+(defalias 'fast-lock-after-unfontify-buffer #'ignore)
;; Miscellaneous Functions:
@@ -473,7 +455,7 @@ See `fast-lock-mode'."
(defun fast-lock-save-caches-before-kill-emacs ()
;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'.
(when (memq 'kill-emacs fast-lock-save-events)
- (mapcar 'fast-lock-save-cache (buffer-list))))
+ (mapcar #'fast-lock-save-cache (buffer-list))))
(defun fast-lock-cache-directory (directory create)
"Return usable directory based on DIRECTORY.
@@ -534,7 +516,7 @@ See `fast-lock-cache-directory'."
(function (lambda (c) (or (cdr (assq c chars-alist)) (list c))))))
(concat
(file-name-as-directory (expand-file-name directory))
- (mapconcat 'char-to-string (apply 'append (mapcar mapchars bufile)) "")
+ (mapconcat #'char-to-string (apply #'append (mapcar mapchars bufile)) "")
".flc"))))
;; Font Lock Cache Processing Functions:
@@ -581,7 +563,7 @@ See `fast-lock-cache-directory'."
(defun fast-lock-cache-data (version timestamp
syntactic-keywords syntactic-properties
keywords face-properties
- &rest ignored)
+ &rest _ignored)
;; Find value of syntactic keywords in case it is a symbol.
(setq font-lock-syntactic-keywords (font-lock-eval-keywords
font-lock-syntactic-keywords))
@@ -708,86 +690,26 @@ See `fast-lock-get-face-properties'."
"Add `syntax-table' and `face' text properties to the current buffer.
Any existing `syntax-table' and `face' text properties are removed first.
See `fast-lock-get-face-properties'."
- (save-buffer-state (plist regions)
- (save-restriction
- (widen)
- (font-lock-unfontify-region (point-min) (point-max))
- ;;
- ;; Set the `syntax-table' property for each start/end region.
- (while syntactic-properties
- (setq plist (list 'syntax-table (car (car syntactic-properties)))
- regions (cdr (car syntactic-properties))
- syntactic-properties (cdr syntactic-properties))
- (while regions
- (add-text-properties (nth 0 regions) (nth 1 regions) plist)
- (setq regions (nthcdr 2 regions))))
- ;;
- ;; Set the `face' property for each start/end region.
- (while face-properties
- (setq plist (list 'face (car (car face-properties)))
- regions (cdr (car face-properties))
- face-properties (cdr face-properties))
- (while regions
- (add-text-properties (nth 0 regions) (nth 1 regions) plist)
- (setq regions (nthcdr 2 regions)))))))
+ (with-silent-modifications
+ (let ((inhibit-point-motion-hooks t))
+ (save-restriction
+ (widen)
+ (font-lock-unfontify-region (point-min) (point-max))
+ ;;
+ ;; Set the `syntax-table' property for each start/end region.
+ (pcase-dolist (`(,plist . ,regions) syntactic-properties)
+ (while regions
+ (add-text-properties (nth 0 regions) (nth 1 regions) plist)
+ (setq regions (nthcdr 2 regions))))
+ ;;
+ ;; Set the `face' property for each start/end region.
+ (pcase-dolist (`(,plist . ,regions) face-properties)
+ (while regions
+ (add-text-properties (nth 0 regions) (nth 1 regions) plist)
+ (setq regions (nthcdr 2 regions))))))))
;; Functions for XEmacs:
-(when (featurep 'xemacs)
- ;;
- ;; It would be better to use XEmacs' `map-extents' over extents with a
- ;; `font-lock' property, but `face' properties are on different extents.
- (defun fast-lock-get-face-properties ()
- "Return a list of `face' text properties in the current buffer.
-Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-where VALUE is a `face' property value and STARTx and ENDx are positions.
-Only those `face' VALUEs in `fast-lock-save-faces' are returned."
- (save-restriction
- (widen)
- (let ((properties ()) cell)
- (map-extents
- (function (lambda (extent ignore)
- (let ((value (extent-face extent)))
- ;; We're only interested if it's one of `fast-lock-save-faces'.
- (when (and value (fast-lock-save-facep value))
- (let ((start (extent-start-position extent))
- (end (extent-end-position extent)))
- ;; Make or add to existing list of regions with the same
- ;; `face' property value.
- (if (setq cell (assoc value properties))
- (setcdr cell (cons start (cons end (cdr cell))))
- (push (list value start end) properties))))
- ;; Return nil to keep `map-extents' going.
- nil))))
- properties)))
- ;;
- ;; XEmacs does not support the `syntax-table' text property.
- (defalias 'fast-lock-get-syntactic-properties
- 'ignore)
- ;;
- ;; Make extents just like XEmacs' font-lock.el does.
- (defun fast-lock-add-properties (syntactic-properties face-properties)
- "Set `face' text properties in the current buffer.
-Any existing `face' text properties are removed first.
-See `fast-lock-get-face-properties'."
- (save-restriction
- (widen)
- (font-lock-unfontify-region (point-min) (point-max))
- ;; Set the `face' property, etc., for each start/end region.
- (while face-properties
- (let ((face (car (car face-properties)))
- (regions (cdr (car face-properties))))
- (while regions
- (font-lock-set-face (nth 0 regions) (nth 1 regions) face)
- (setq regions (nthcdr 2 regions)))
- (setq face-properties (cdr face-properties))))
- ;; XEmacs does not support the `syntax-table' text property.
- ))
- ;;
- ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook.
- (add-hook 'font-lock-after-fontify-buffer-hook
- 'fast-lock-after-fontify-buffer))
-
(unless (boundp 'font-lock-syntactic-keywords)
(defvar font-lock-syntactic-keywords nil))
@@ -795,14 +717,14 @@ See `fast-lock-get-face-properties'."
(defvar font-lock-inhibit-thing-lock nil))
(unless (fboundp 'font-lock-compile-keywords)
- (defalias 'font-lock-compile-keywords 'identity))
+ (defalias 'font-lock-compile-keywords #'identity))
(unless (fboundp 'font-lock-eval-keywords)
(defun font-lock-eval-keywords (keywords)
(if (symbolp keywords)
(font-lock-eval-keywords (if (fboundp keywords)
(funcall keywords)
- (eval keywords)))
+ (eval keywords t)))
keywords)))
(unless (fboundp 'font-lock-value-in-major-mode)
@@ -817,10 +739,10 @@ See `fast-lock-get-face-properties'."
;; Install ourselves:
-(add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file)
-(add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer)
+(add-hook 'after-save-hook #'fast-lock-save-cache-after-save-file)
+(add-hook 'kill-buffer-hook #'fast-lock-save-cache-before-kill-buffer)
(unless noninteractive
- (add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs))
+ (add-hook 'kill-emacs-hook #'fast-lock-save-caches-before-kill-emacs))
;;;###autoload
(when (fboundp 'add-minor-mode)
@@ -830,8 +752,6 @@ See `fast-lock-get-face-properties'."
(unless (assq 'fast-lock-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil)))))
-;; Provide ourselves:
-
(provide 'fast-lock)
;;; fast-lock.el ends here
diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el
index 6ab3fc59380..5a82c6b05f0 100644
--- a/lisp/obsolete/gs.el
+++ b/lisp/obsolete/gs.el
@@ -1,4 +1,4 @@
-;;; gs.el --- interface to Ghostscript
+;;; gs.el --- interface to Ghostscript -*- lexical-binding: t; -*-
;; Copyright (C) 1998, 2001-2021 Free Software Foundation, Inc.
@@ -205,7 +205,7 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful."
(gs-set-ghostview-window-prop frame spec img-width img-height)
(gs-set-ghostview-colors-window-prop frame pixel-colors)
(setenv "GHOSTVIEW" window-and-pixmap-id)
- (setq gs (apply 'start-process "gs" "*GS*" gs-program
+ (setq gs (apply #'start-process "gs" "*GS*" gs-program
(gs-options gs-device file)))
(set-process-query-on-exit-flag gs nil)
gs)
diff --git a/lisp/obsolete/gulp.el b/lisp/obsolete/gulp.el
index 0fbaa1cc4f8..6ec2f4f772c 100644
--- a/lisp/obsolete/gulp.el
+++ b/lisp/obsolete/gulp.el
@@ -1,4 +1,4 @@
-;;; gulp.el --- ask for updates for Lisp packages
+;;; gulp.el --- ask for updates for Lisp packages -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
@@ -37,18 +37,15 @@
(defcustom gulp-discard "^;+ *Maintainer: *\\(FSF\\|emacs-devel@gnu\\.org\\) *$"
"The regexp matching the packages not requiring the request for updates."
:version "24.4" ; added emacs-devel
- :type 'regexp
- :group 'gulp)
+ :type 'regexp)
(defcustom gulp-tmp-buffer "*gulp*"
"The name of the temporary buffer."
- :type 'string
- :group 'gulp)
+ :type 'string)
(defcustom gulp-max-len 2000
"Distance into a Lisp source file to scan for keywords."
- :type 'integer
- :group 'gulp)
+ :type 'integer)
(defcustom gulp-request-header
(concat
@@ -57,8 +54,7 @@ I'm going to start pretesting a new version of GNU Emacs soon, so I'd
like to ask if you have any updates for the Emacs packages you work on.
You're listed as the maintainer of the following package(s):\n\n")
"The starting text of a gulp message."
- :type 'string
- :group 'gulp)
+ :type 'string)
(defcustom gulp-request-end
(concat
@@ -75,8 +71,7 @@ of information to include.
Thanks.")
"The closing text in a gulp message."
- :type 'string
- :group 'gulp)
+ :type 'string)
(declare-function mail-subject "sendmail" ())
(declare-function mail-send "sendmail" ())
diff --git a/lisp/obsolete/html2text.el b/lisp/obsolete/html2text.el
index f01561bd12c..be0553cb3ae 100644
--- a/lisp/obsolete/html2text.el
+++ b/lisp/obsolete/html2text.el
@@ -1,4 +1,4 @@
-;;; html2text.el --- a simple html to plain text converter -*- coding: utf-8 -*-
+;;; html2text.el --- a simple html to plain text converter -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
diff --git a/lisp/obsolete/info-edit.el b/lisp/obsolete/info-edit.el
index c8a187c08ee..19958979a85 100644
--- a/lisp/obsolete/info-edit.el
+++ b/lisp/obsolete/info-edit.el
@@ -1,4 +1,4 @@
-;; info-edit.el --- Editing info files -*- lexical-binding:t -*-
+;;; info-edit.el --- Editing info files -*- lexical-binding:t -*-
;; Copyright (C) 1985-1986, 1992-2021 Free Software Foundation, Inc.
@@ -36,7 +36,7 @@
(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1")
(defvar Info-edit-mode-map (let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" 'Info-cease-edit)
+ (define-key map "\C-c\C-c" #'Info-cease-edit)
map)
"Local keymap used within `e' command of Info.")
diff --git a/lisp/cedet/inversion.el b/lisp/obsolete/inversion.el
index 2ef7e0df961..ac7749af5e8 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/obsolete/inversion.el
@@ -1,10 +1,11 @@
-;;; inversion.el --- When you need something in version XX.XX
+;;; inversion.el --- When you need something in version XX.XX -*- lexical-binding: t; -*-
-;;; Copyright (C) 2002-2003, 2005-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.3
;; Keywords: OO, lisp
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
@@ -222,7 +223,7 @@ not an indication of new features or bug fixes."
)))
(defun inversion-check-version (version incompatible-version
- minimum &rest reserved)
+ minimum &rest _reserved)
"Check that a given version meets the minimum requirement.
VERSION, INCOMPATIBLE-VERSION and MINIMUM are of similar format to
return entries of `inversion-decode-version', or a classic version
@@ -329,7 +330,7 @@ Return nil if everything is ok. Return an error string otherwise."
(t "Inversion version check failed."))))
(defun inversion-require (package version &optional file directory
- &rest reserved)
+ &rest _reserved)
"Declare that you need PACKAGE with at least VERSION.
PACKAGE might be found in FILE. (See `require'.)
Throws an error if VERSION is incompatible with what is installed.
@@ -453,7 +454,7 @@ If it is a URL, wget will be used for download.
Optional argument VERSION will restrict the list of available versions
to the file matching VERSION exactly, or nil."
;;DIRECTORY should also allow a URL:
-;; \"http://ftp1.sourceforge.net/PACKAGE\"
+;; \"https://ftp1.sourceforge.net/PACKAGE\"
;; but then I can get file listings easily.
(if (symbolp package) (setq package (symbol-name package)))
(directory-files directory t
@@ -524,31 +525,6 @@ The package should have VERSION available for download."
(copy-file (cdr (car files)) dest))))))
-;;; How we upgrade packages in Emacs has yet to be ironed out.
-
-;; (defun inversion-upgrade-package (package &optional directory)
-;; "Try to upgrade PACKAGE in DIRECTORY is available."
-;; (interactive "sPackage to upgrade: ")
-;; (if (stringp package) (setq package (intern package)))
-;; (if (not directory)
-;; ;; Hope that the package maintainer specified.
-;; (setq directory (symbol-value (or (intern-soft
-;; (concat (symbol-name package)
-;; "-url"))
-;; (intern-soft
-;; (concat (symbol-name package)
-;; "-directory"))))))
-;; (let ((files (inversion-locate-package-files-and-split
-;; package directory))
-;; (cver (inversion-package-version package))
-;; (newer nil))
-;; (mapc (lambda (f)
-;; (if (inversion-< cver (inversion-decode-version (car f)))
-;; (setq newer (cons f newer))))
-;; files)
-;; newer
-;; ))
-
(provide 'inversion)
;;; inversion.el ends here
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 58cada13747..a630baf3543 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1,4 +1,4 @@
-;;; iswitchb.el --- switch between buffers using substrings
+;;; iswitchb.el --- switch between buffers using substrings -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1997, 2000-2021 Free Software Foundation, Inc.
@@ -258,8 +258,7 @@
"Non-nil if searching of buffer names should ignore case.
If this is non-nil but the user input has any upper case letters, matching
is temporarily case sensitive."
- :type 'boolean
- :group 'iswitchb)
+ :type 'boolean)
(defcustom iswitchb-buffer-ignore
'("^ ")
@@ -267,8 +266,7 @@ is temporarily case sensitive."
For example, traditional behavior is not to list buffers whose names begin
with a space, for which the regexp is `^ '. See the source file for
example functions that filter buffer names."
- :type '(repeat (choice regexp function))
- :group 'iswitchb)
+ :type '(repeat (choice regexp function)))
(put 'iswitchb-buffer-ignore 'risky-local-variable t)
(defcustom iswitchb-max-to-show nil
@@ -277,8 +275,7 @@ If this value is N, and N is greater than the number of matching
buffers, the first N/2 and the last N/2 matching buffers are
shown. This can greatly speed up iswitchb if you have a
multitude of buffers open."
- :type '(choice (const :tag "Show all" nil) integer)
- :group 'iswitchb)
+ :type '(choice (const :tag "Show all" nil) integer))
(defcustom iswitchb-use-virtual-buffers nil
"If non-nil, refer to past buffers when none match.
@@ -289,8 +286,7 @@ enabled if this variable is configured to a non-nil value."
:set (function
(lambda (sym value)
(if value (recentf-mode 1))
- (set sym value)))
- :group 'iswitchb)
+ (set sym value))))
(defvar iswitchb-virtual-buffers nil)
@@ -299,8 +295,7 @@ enabled if this variable is configured to a non-nil value."
The most useful values are `iswitchb-completion-help', which pops up a
window with completion alternatives, or `iswitchb-next-match' or
`iswitchb-prev-match', which cycle the buffer list."
- :type 'hook
- :group 'iswitchb)
+ :type 'hook)
;; Examples for setting the value of iswitchb-buffer-ignore
;;(defun iswitchb-ignore-c-mode (name)
@@ -318,7 +313,7 @@ Possible values:
`otherwindow' Show new buffer in another window (same frame)
`display' Display buffer in another window without switching to it
`otherframe' Show new buffer in another frame
-`maybe-frame' If a buffer is visible in another frame, prompt to ask if you
+`maybe-frame' If a buffer is visible in another frame, prompt to ask if
you want to see the buffer in the same window of the current
frame or in the other frame.
`always-frame' If a buffer is visible in another frame, raise that
@@ -328,46 +323,38 @@ Possible values:
(const display)
(const otherframe)
(const maybe-frame)
- (const always-frame))
- :group 'iswitchb)
+ (const always-frame)))
(defcustom iswitchb-regexp nil
"Non-nil means that `iswitchb' will do regexp matching.
Value can be toggled within `iswitchb' using `iswitchb-toggle-regexp'."
- :type 'boolean
- :group 'iswitchb)
+ :type 'boolean)
(defcustom iswitchb-newbuffer t
"Non-nil means create new buffer if no buffer matches substring.
See also `iswitchb-prompt-newbuffer'."
- :type 'boolean
- :group 'iswitchb)
+ :type 'boolean)
(defcustom iswitchb-prompt-newbuffer t
"Non-nil means prompt user to confirm before creating new buffer.
See also `iswitchb-newbuffer'."
- :type 'boolean
- :group 'iswitchb)
+ :type 'boolean)
(defcustom iswitchb-use-faces t
"Non-nil means use font-lock faces for showing first match."
- :type 'boolean
- :group 'iswitchb)
+ :type 'boolean)
(defcustom iswitchb-use-frame-buffer-list nil
"Non-nil means use the currently selected frame's buffer list."
- :type 'boolean
- :group 'iswitchb)
+ :type 'boolean)
(defcustom iswitchb-make-buflist-hook nil
"Hook to run when list of matching buffers is created."
- :type 'hook
- :group 'iswitchb)
+ :type 'hook)
(defcustom iswitchb-delim ","
"Delimiter to put between buffer names when displaying results."
- :type 'string
- :group 'iswitchb)
+ :type 'string)
(defcustom iswitchb-all-frames 'visible
"Argument to pass to `walk-windows' when iswitchb is finding buffers.
@@ -375,8 +362,7 @@ See documentation of `walk-windows' for useful values."
:type '(choice (const :tag "Selected frame only" nil)
(const :tag "All existing frames" t)
(const :tag "All visible frames" visible)
- (const :tag "All frames on this terminal" 0))
- :group 'iswitchb)
+ (const :tag "All frames on this terminal" 0)))
(defcustom iswitchb-minibuffer-setup-hook nil
"Iswitchb-specific customization of minibuffer setup.
@@ -387,37 +373,32 @@ For instance:
\\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3)))
will constrain the minibuffer to a maximum height of 3 lines when
iswitchb is running."
- :type 'hook
- :group 'iswitchb)
+ :type 'hook)
(defface iswitchb-single-match
'((t
(:inherit font-lock-comment-face)))
"Iswitchb face for single matching buffer name."
- :version "22.1"
- :group 'iswitchb)
+ :version "22.1")
(defface iswitchb-current-match
'((t
(:inherit font-lock-function-name-face)))
"Iswitchb face for current matching buffer name."
- :version "22.1"
- :group 'iswitchb)
+ :version "22.1")
(defface iswitchb-virtual-matches
'((t
(:inherit font-lock-builtin-face)))
"Iswitchb face for matching virtual buffer names.
See also `iswitchb-use-virtual-buffers'."
- :version "22.1"
- :group 'iswitchb)
+ :version "22.1")
(defface iswitchb-invalid-regexp
'((t
(:inherit font-lock-warning-face)))
"Iswitchb face for indicating invalid regexp. "
- :version "22.1"
- :group 'iswitchb)
+ :version "22.1")
;; Do we need the variable iswitchb-use-mycompletion?
@@ -465,18 +446,18 @@ interfere with other minibuffer usage.")
(defvar iswitchb-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (define-key map "?" 'iswitchb-completion-help)
- (define-key map "\C-s" 'iswitchb-next-match)
- (define-key map "\C-r" 'iswitchb-prev-match)
- (define-key map [?\C-.] 'iswitchb-next-match)
- (define-key map [?\C-,] 'iswitchb-prev-match)
- (define-key map "\t" 'iswitchb-complete)
- (define-key map "\C-j" 'iswitchb-select-buffer-text)
- (define-key map "\C-t" 'iswitchb-toggle-regexp)
- (define-key map "\C-x\C-f" 'iswitchb-find-file)
- (define-key map "\C-c" 'iswitchb-toggle-case)
- (define-key map "\C-k" 'iswitchb-kill-buffer)
- (define-key map "\C-m" 'iswitchb-exit-minibuffer)
+ (define-key map "?" #'iswitchb-completion-help)
+ (define-key map "\C-s" #'iswitchb-next-match)
+ (define-key map "\C-r" #'iswitchb-prev-match)
+ (define-key map [?\C-.] #'iswitchb-next-match)
+ (define-key map [?\C-,] #'iswitchb-prev-match)
+ (define-key map "\t" #'iswitchb-complete)
+ (define-key map "\C-j" #'iswitchb-select-buffer-text)
+ (define-key map "\C-t" #'iswitchb-toggle-regexp)
+ (define-key map "\C-x\C-f" #'iswitchb-find-file)
+ (define-key map "\C-c" #'iswitchb-toggle-case)
+ (define-key map "\C-k" #'iswitchb-kill-buffer)
+ (define-key map "\C-m" #'iswitchb-exit-minibuffer)
map)
"Minibuffer keymap for `iswitchb-buffer'.")
@@ -596,17 +577,17 @@ the selection process begins. Used by isearchb.el."
(let ((map (copy-keymap minibuffer-local-map))
buf-sel iswitchb-final-text
icomplete-mode) ; prevent icomplete starting up
- (define-key map "?" 'iswitchb-completion-help)
- (define-key map "\C-s" 'iswitchb-next-match)
- (define-key map "\C-r" 'iswitchb-prev-match)
- (define-key map "\t" 'iswitchb-complete)
- (define-key map "\C-j" 'iswitchb-select-buffer-text)
- (define-key map "\C-t" 'iswitchb-toggle-regexp)
- (define-key map "\C-x\C-f" 'iswitchb-find-file)
- (define-key map "\C-n" 'iswitchb-toggle-ignore)
- (define-key map "\C-c" 'iswitchb-toggle-case)
- (define-key map "\C-k" 'iswitchb-kill-buffer)
- (define-key map "\C-m" 'iswitchb-exit-minibuffer)
+ (define-key map "?" #'iswitchb-completion-help)
+ (define-key map "\C-s" #'iswitchb-next-match)
+ (define-key map "\C-r" #'iswitchb-prev-match)
+ (define-key map "\t" #'iswitchb-complete)
+ (define-key map "\C-j" #'iswitchb-select-buffer-text)
+ (define-key map "\C-t" #'iswitchb-toggle-regexp)
+ (define-key map "\C-x\C-f" #'iswitchb-find-file)
+ (define-key map "\C-n" #'iswitchb-toggle-ignore)
+ (define-key map "\C-c" #'iswitchb-toggle-case)
+ (define-key map "\C-k" #'iswitchb-kill-buffer)
+ (define-key map "\C-m" #'iswitchb-exit-minibuffer)
(setq iswitchb-mode-map map)
(run-hooks 'iswitchb-define-mode-map-hook)
@@ -946,9 +927,9 @@ If `iswitchb-change-word-sub' cannot be found in WORD, return nil."
(if iswitchb-regexp
subs
(regexp-quote subs)))
- (setq res (mapcar 'iswitchb-word-matching-substring lis))
+ (setq res (mapcar #'iswitchb-word-matching-substring lis))
(setq res (delq nil res)) ;; remove any nil elements (shouldn't happen)
- (setq alist (mapcar 'iswitchb-makealist res)) ;; could use an OBARRAY
+ (setq alist (mapcar #'iswitchb-makealist res)) ;; could use an OBARRAY
;; try-completion returns t if there is an exact match.
(let ((completion-ignore-case (iswitchb-case)))
@@ -1148,43 +1129,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'."
(setq iswitchb-method 'otherframe)
(iswitchb))
-;;; XEmacs hack for showing default buffer
-
-;; The first time we enter the minibuffer, Emacs puts up the default
-;; buffer to switch to, but XEmacs doesn't -- presumably there is a
-;; subtle difference in the two versions of post-command-hook. The
-;; default is shown for both whenever we delete all of our text
-;; though, indicating its just a problem the first time we enter the
-;; function. To solve this, we use another entry hook for emacs to
-;; show the default the first time we enter the minibuffer.
-
-(defun iswitchb-init-XEmacs-trick ()
- "Display default buffer when first entering minibuffer.
-This is a hack for XEmacs, and should really be handled by `iswitchb-exhibit'."
- (if (iswitchb-entryfn-p)
- (progn
- (iswitchb-exhibit)
- (goto-char (point-min)))))
-
-;; add this hook for XEmacs only.
-(if (featurep 'xemacs)
- (add-hook 'iswitchb-minibuffer-setup-hook
- 'iswitchb-init-XEmacs-trick))
-
-;;; XEmacs / backspace key
-;; For some reason, if the backspace key is pressed in XEmacs, the
-;; line gets confused, so I've added a simple key definition to make
-;; backspace act like the normal delete key.
-
-(defun iswitchb-xemacs-backspacekey ()
- "Bind backspace to `backward-delete-char'."
- (define-key iswitchb-mode-map '[backspace] 'backward-delete-char)
- (define-key iswitchb-mode-map '[(meta backspace)] 'backward-kill-word))
-
-(if (featurep 'xemacs)
- (add-hook 'iswitchb-define-mode-map-hook
- 'iswitchb-xemacs-backspacekey))
-
;;; ICOMPLETE TYPE CODE
(defun iswitchb-exhibit ()
@@ -1214,18 +1158,6 @@ Copied from `icomplete-exhibit' with two changes:
(insert (iswitchb-completions
contents))))))
-(defvar most-len)
-(defvar most-is-exact)
-
-(defun iswitchb-output-completion (com)
- (if (= (length com) most-len)
- ;; Most is one exact match,
- ;; note that and leave out
- ;; for later indication:
- (ignore
- (setq most-is-exact t))
- (substring com most-len)))
-
(defun iswitchb-completions (name)
"Return the string that is displayed after the user's text.
Modified from `icomplete-completions'."
@@ -1273,7 +1205,7 @@ Modified from `icomplete-completions'."
iswitchb-virtual-buffers)))
(setq head (cdr head)))
(setq iswitchb-virtual-buffers (nreverse iswitchb-virtual-buffers)
- comps (mapcar 'car iswitchb-virtual-buffers))
+ comps (mapcar #'car iswitchb-virtual-buffers))
(let ((comp comps))
(while comp
(put-text-property 0 (length (car comp))
@@ -1316,15 +1248,11 @@ Modified from `icomplete-completions'."
(nreverse res))
(list "...")
(nthcdr (- (length comps)
- (/ iswitchb-max-to-show 2)) comps))))
+ (/ iswitchb-max-to-show 2))
+ comps))))
(let* (
- ;;(most (try-completion name candidates predicate))
- (most nil)
- (most-len (length most))
- most-is-exact
(alternatives
- (mapconcat (if most 'iswitchb-output-completion
- 'identity) comps iswitchb-delim)))
+ (mapconcat #'identity comps iswitchb-delim)))
(concat
@@ -1338,17 +1266,9 @@ Modified from `icomplete-completions'."
close-bracket-determined))
;; end of partial matches...
- ;; think this bit can be ignored.
- (and (> most-len (length name))
- (concat open-bracket-determined
- (substring most (length name))
- close-bracket-determined))
-
;; list all alternatives
open-bracket-prospects
- (if most-is-exact
- (concat iswitchb-delim alternatives)
- alternatives)
+ alternatives
close-bracket-prospects))))))
(defun iswitchb-minibuffer-setup ()
@@ -1356,8 +1276,8 @@ Modified from `icomplete-completions'."
Copied from `icomplete-minibuffer-setup-hook'."
(when (iswitchb-entryfn-p)
(set (make-local-variable 'iswitchb-use-mycompletion) t)
- (add-hook 'pre-command-hook 'iswitchb-pre-command nil t)
- (add-hook 'post-command-hook 'iswitchb-post-command nil t)
+ (add-hook 'pre-command-hook #'iswitchb-pre-command nil t)
+ (add-hook 'post-command-hook #'iswitchb-post-command nil t)
(run-hooks 'iswitchb-minibuffer-setup-hook)))
(defun iswitchb-pre-command ()
@@ -1416,10 +1336,10 @@ See the variable `iswitchb-case' for details."
Iswitchb mode is a global minor mode that enables switching
between buffers using substrings. See `iswitchb' for details."
- nil nil iswitchb-global-map :global t :group 'iswitchb
+ :keymap iswitchb-global-map :global t
(if iswitchb-mode
- (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)
- (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))
+ (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)
+ (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))
(provide 'iswitchb)
diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el
index ae15109beaa..cc4fd19c389 100644
--- a/lisp/obsolete/landmark.el
+++ b/lisp/obsolete/landmark.el
@@ -163,51 +163,50 @@
(defcustom landmark-mode-hook nil
"If non-nil, its value is called on entry to Landmark mode."
- :type 'hook
- :group 'landmark)
+ :type 'hook)
(defvar landmark-mode-map
(let ((map (make-sparse-keymap)))
;; Key bindings for cursor motion.
- (define-key map "y" 'landmark-move-nw) ; y
- (define-key map "u" 'landmark-move-ne) ; u
- (define-key map "b" 'landmark-move-sw) ; b
- (define-key map "n" 'landmark-move-se) ; n
- (define-key map "h" 'backward-char) ; h
- (define-key map "l" 'forward-char) ; l
- (define-key map "j" 'landmark-move-down) ; j
- (define-key map "k" 'landmark-move-up) ; k
-
- (define-key map [kp-7] 'landmark-move-nw)
- (define-key map [kp-9] 'landmark-move-ne)
- (define-key map [kp-1] 'landmark-move-sw)
- (define-key map [kp-3] 'landmark-move-se)
- (define-key map [kp-4] 'backward-char)
- (define-key map [kp-6] 'forward-char)
- (define-key map [kp-2] 'landmark-move-down)
- (define-key map [kp-8] 'landmark-move-up)
-
- (define-key map "\C-n" 'landmark-move-down) ; C-n
- (define-key map "\C-p" 'landmark-move-up) ; C-p
+ (define-key map "y" #'landmark-move-nw) ; y
+ (define-key map "u" #'landmark-move-ne) ; u
+ (define-key map "b" #'landmark-move-sw) ; b
+ (define-key map "n" #'landmark-move-se) ; n
+ (define-key map "h" #'backward-char) ; h
+ (define-key map "l" #'forward-char) ; l
+ (define-key map "j" #'landmark-move-down) ; j
+ (define-key map "k" #'landmark-move-up) ; k
+
+ (define-key map [kp-7] #'landmark-move-nw)
+ (define-key map [kp-9] #'landmark-move-ne)
+ (define-key map [kp-1] #'landmark-move-sw)
+ (define-key map [kp-3] #'landmark-move-se)
+ (define-key map [kp-4] #'backward-char)
+ (define-key map [kp-6] #'forward-char)
+ (define-key map [kp-2] #'landmark-move-down)
+ (define-key map [kp-8] #'landmark-move-up)
+
+ (define-key map "\C-n" #'landmark-move-down) ; C-n
+ (define-key map "\C-p" #'landmark-move-up) ; C-p
;; Key bindings for entering Human moves.
- (define-key map "X" 'landmark-human-plays) ; X
- (define-key map "x" 'landmark-human-plays) ; x
-
- (define-key map " " 'landmark-start-robot) ; SPC
- (define-key map [down-mouse-1] 'landmark-start-robot)
- (define-key map [drag-mouse-1] 'landmark-click)
- (define-key map [mouse-1] 'landmark-click)
- (define-key map [down-mouse-2] 'landmark-click)
- (define-key map [mouse-2] 'landmark-mouse-play)
- (define-key map [drag-mouse-2] 'landmark-mouse-play)
-
- (define-key map [remap previous-line] 'landmark-move-up)
- (define-key map [remap next-line] 'landmark-move-down)
- (define-key map [remap beginning-of-line] 'landmark-beginning-of-line)
- (define-key map [remap end-of-line] 'landmark-end-of-line)
- (define-key map [remap undo] 'landmark-human-takes-back)
- (define-key map [remap advertised-undo] 'landmark-human-takes-back)
+ (define-key map "X" #'landmark-human-plays) ; X
+ (define-key map "x" #'landmark-human-plays) ; x
+
+ (define-key map " " #'landmark-start-robot) ; SPC
+ (define-key map [down-mouse-1] #'landmark-start-robot)
+ (define-key map [drag-mouse-1] #'landmark-click)
+ (define-key map [mouse-1] #'landmark-click)
+ (define-key map [down-mouse-2] #'landmark-click)
+ (define-key map [mouse-2] #'landmark-mouse-play)
+ (define-key map [drag-mouse-2] #'landmark-mouse-play)
+
+ (define-key map [remap previous-line] #'landmark-move-up)
+ (define-key map [remap next-line] #'landmark-move-down)
+ (define-key map [remap beginning-of-line] #'landmark-beginning-of-line)
+ (define-key map [remap end-of-line] #'landmark-end-of-line)
+ (define-key map [remap undo] #'landmark-human-takes-back)
+ (define-key map [remap advertised-undo] #'landmark-human-takes-back)
map)
"Local keymap to use in Landmark mode.")
@@ -219,14 +218,12 @@
(defface landmark-font-lock-face-O '((((class color)) :foreground "red")
(t :weight bold))
"Face to use for Emacs's O."
- :version "22.1"
- :group 'landmark)
+ :version "22.1")
(defface landmark-font-lock-face-X '((((class color)) :foreground "green")
(t :weight bold))
"Face to use for your X."
- :version "22.1"
- :group 'landmark)
+ :version "22.1")
(defvar landmark-font-lock-keywords
'(("O" . 'landmark-font-lock-face-O)
@@ -1132,12 +1129,10 @@ this program to add a random element to the way moves were made.")
"If non-nil, print \"One moment please\" when a new board is generated.
The drawback of this is you don't see how many moves the last run took
because it is overwritten by \"One moment please\"."
- :type 'boolean
- :group 'landmark)
+ :type 'boolean)
(defcustom landmark-output-moves t
"If non-nil, output number of moves so far on a move-by-move basis."
- :type 'boolean
- :group 'landmark)
+ :type 'boolean)
(defun landmark-weights-debug ()
@@ -1153,7 +1148,7 @@ because it is overwritten by \"One moment please\"."
(defun landmark-print-distance ()
(insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 'landmark-tree)))
- (mapc 'landmark-print-distance-int landmark-directions))
+ (mapc #'landmark-print-distance-int landmark-directions))
;;(setq direction 'landmark-n)
@@ -1166,10 +1161,10 @@ because it is overwritten by \"One moment please\"."
(defun landmark-nslify-wts ()
(interactive)
- (let ((l (apply 'append (mapcar 'landmark-nslify-wts-int landmark-directions))))
+ (let ((l (apply #'append (mapcar #'landmark-nslify-wts-int landmark-directions))))
(insert (format "set data_value WTS \n %s \n" l))
(insert (format "/* max: %S min: %S */"
- (eval (cons 'max l)) (eval (cons 'min l))))))
+ (apply #'max l) (apply #'min l)))))
(defun landmark-print-wts-int (direction)
(mapc (lambda (target-direction)
@@ -1184,7 +1179,7 @@ because it is overwritten by \"One moment please\"."
(interactive)
(with-current-buffer "*landmark-wts*"
(insert "==============================\n")
- (mapc 'landmark-print-wts-int landmark-directions)))
+ (mapc #'landmark-print-wts-int landmark-directions)))
(defun landmark-print-moves (moves)
(interactive)
@@ -1204,7 +1199,7 @@ because it is overwritten by \"One moment please\"."
(interactive)
(with-current-buffer "*landmark-y,s,noise*"
(insert "==============================\n")
- (mapc 'landmark-print-y-s-noise-int landmark-directions)))
+ (mapc #'landmark-print-y-s-noise-int landmark-directions)))
(defun landmark-print-smell-int (direction)
(insert (format "%S: smell: %S \n"
@@ -1216,7 +1211,7 @@ because it is overwritten by \"One moment please\"."
(with-current-buffer "*landmark-smell*"
(insert "==============================\n")
(insert (format "tree: %S \n" (get 'z 't)))
- (mapc 'landmark-print-smell-int landmark-directions)))
+ (mapc #'landmark-print-smell-int landmark-directions)))
(defun landmark-print-w0-int (direction)
(insert (format "%S: w0: %S \n"
@@ -1227,7 +1222,7 @@ because it is overwritten by \"One moment please\"."
(interactive)
(with-current-buffer "*landmark-w0*"
(insert "==============================\n")
- (mapc 'landmark-print-w0-int landmark-directions)))
+ (mapc #'landmark-print-w0-int landmark-directions)))
(defun landmark-blackbox ()
(with-current-buffer "*landmark-blackbox*"
@@ -1252,36 +1247,31 @@ because it is overwritten by \"One moment please\"."
(defun landmark-print-wts-blackbox ()
(interactive)
- (mapc 'landmark-print-wts-int landmark-directions))
+ (mapc #'landmark-print-wts-int landmark-directions))
;;;_ - learning parameters
(defcustom landmark-bound 0.005
"The maximum that w0j may be."
- :type 'number
- :group 'landmark)
+ :type 'number)
(defcustom landmark-c 1.0
"A factor applied to modulate the increase in wij.
Used in the function landmark-update-normal-weights."
- :type 'number
- :group 'landmark)
+ :type 'number)
(defcustom landmark-c-naught 0.5
"A factor applied to modulate the increase in w0j.
Used in the function landmark-update-naught-weights."
- :type 'number
- :group 'landmark)
+ :type 'number)
(defvar landmark-initial-w0 0.0)
(defvar landmark-initial-wij 0.0)
(defcustom landmark-no-payoff 0
"The amount of simulation cycles that have occurred with no movement.
Used to move the robot when he is stuck in a rut for some reason."
- :type 'integer
- :group 'landmark)
+ :type 'integer)
(defcustom landmark-max-stall-time 2
"The maximum number of cycles that the robot can remain stuck in a place.
After this limit is reached, landmark-random-move is called to
push him out of it."
- :type 'integer
- :group 'landmark)
+ :type 'integer)
;;;_ + Randomizing functions
@@ -1346,7 +1336,8 @@ push him out of it."
(put 'landmark-e 'y (/ landmark-board-height 2))
(put 'landmark-e 'sym 4)
- (mapc 'landmark-plot-internal '(landmark-n landmark-s landmark-e landmark-w landmark-tree)))
+ (mapc #'landmark-plot-internal
+ '(landmark-n landmark-s landmark-e landmark-w landmark-tree)))
@@ -1434,7 +1425,7 @@ push him out of it."
;;;_ + Functions to move robot
(defun landmark-confidence-for (target-direction)
- (apply '+
+ (apply #'+
(get target-direction 'w0)
(mapcar (lambda (direction)
(*
@@ -1494,13 +1485,13 @@ push him out of it."
(landmark-random-move)
(progn
(landmark-calc-confidences)
- (mapc 'landmark-y landmark-directions)
+ (mapc #'landmark-y landmark-directions)
(landmark-move)))
(landmark-calc-payoff)
- (mapc 'landmark-update-normal-weights landmark-directions)
- (mapc 'landmark-update-naught-weights landmark-directions)
+ (mapc #'landmark-update-normal-weights landmark-directions)
+ (mapc #'landmark-update-naught-weights landmark-directions)
(if landmark-debug
(landmark-weights-debug)))
(landmark-terminate-game nil))
@@ -1536,8 +1527,8 @@ If the game is finished, this command requests for another game."
(landmark-calc-payoff)
- (mapc 'landmark-update-normal-weights landmark-directions)
- (mapc 'landmark-update-naught-weights landmark-directions)
+ (mapc #'landmark-update-normal-weights landmark-directions)
+ (mapc #'landmark-update-naught-weights landmark-directions)
(landmark-amble-robot)
)))))))
@@ -1576,7 +1567,7 @@ If the game is finished, this command requests for another game."
(if (not save-weights)
(progn
- (mapc 'landmark-fix-weights-for landmark-directions)
+ (mapc #'landmark-fix-weights-for landmark-directions)
(dolist (direction landmark-directions)
(put direction 'w0 landmark-initial-w0)))
(message "Weights preserved for this run."))
@@ -1618,7 +1609,7 @@ If the game is finished, this command requests for another game."
;;;_ + landmark-test-run ()
;;;###autoload
-(defalias 'landmark-repeat 'landmark-test-run)
+(defalias 'landmark-repeat #'landmark-test-run)
;;;###autoload
(defun landmark-test-run ()
"Run 100 Landmark games, each time saving the weights from the previous game."
@@ -1670,13 +1661,13 @@ Use \\[describe-mode] for more info."
(if landmark-one-moment-please
(message "One moment, please..."))
(landmark-start-game landmark-n landmark-m)
- (eval (cons 'landmark-init
- (cond
- ((= parg 1) '(t nil))
- ((= parg 2) '(t t))
- ((= parg 3) '(nil t))
- ((= parg 4) '(nil nil))
- (t '(nil t))))))))
+ (apply #'landmark-init
+ (cond
+ ((= parg 1) '(t nil))
+ ((= parg 2) '(t t))
+ ((= parg 3) '(nil t))
+ ((= parg 4) '(nil nil))
+ (t '(nil t)))))))
;;;_ + Local variables
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index e1a01913bea..13f14aad6d1 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -1,4 +1,4 @@
-;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
+;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1998, 2001-2021 Free Software Foundation, Inc.
@@ -270,30 +270,14 @@
(eval-when-compile (require 'cl-lib))
(eval-when-compile
- ;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (varlist &rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state."
- `(let* (,@(append varlist
- '((modified (buffer-modified-p))
- (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)))
- ,@body
- (when (and (not modified) (buffer-modified-p))
- (restore-buffer-modified-p nil))))
- (put 'save-buffer-state 'lisp-indent-function 1)
;;
;; We use this for clarity and speed. Naughty but nice.
(defmacro do-while (test &rest body)
"(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil.
The order of execution is thus BODY, TEST, BODY, TEST and so on
until TEST returns nil."
- `(while (progn ,@body ,test)))
- (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function)))
+ (declare (indent 1) (debug t))
+ `(while (progn ,@body ,test))))
(defgroup lazy-lock nil
"Font Lock support mode to fontify lazily."
@@ -326,8 +310,7 @@ The value of this variable is used when Lazy Lock mode is turned on."
(symbol :tag "name"))
(radio :tag "Size"
(const :tag "none" nil)
- (integer :tag "size")))))
- :group 'lazy-lock)
+ (integer :tag "size"))))))
(defcustom lazy-lock-defer-on-the-fly t
"If non-nil, means fontification after a change should be deferred.
@@ -346,8 +329,7 @@ The value of this variable is used when Lazy Lock mode is turned on."
(set :menu-tag "mode specific" :tag "modes"
:value (not)
(const :tag "Except" not)
- (repeat :inline t (symbol :tag "mode"))))
- :group 'lazy-lock)
+ (repeat :inline t (symbol :tag "mode")))))
(defcustom lazy-lock-defer-on-scrolling nil
"If non-nil, means fontification after a scroll should be deferred.
@@ -371,8 +353,7 @@ makes little sense if `lazy-lock-defer-contextually' is non-nil.)
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
- (other :tag "eventually" eventually))
- :group 'lazy-lock)
+ (other :tag "eventually" eventually)))
(defcustom lazy-lock-defer-contextually 'syntax-driven
"If non-nil, means deferred fontification should be syntactically true.
@@ -389,8 +370,7 @@ buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
(const :tag "always" t)
- (other :tag "syntax-driven" syntax-driven))
- :group 'lazy-lock)
+ (other :tag "syntax-driven" syntax-driven)))
(defcustom lazy-lock-defer-time 0.25
"Time in seconds to delay before beginning deferred fontification.
@@ -401,8 +381,7 @@ variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds"))
- :group 'lazy-lock)
+ (number :tag "seconds")))
(defcustom lazy-lock-stealth-time 30
"Time in seconds to delay before beginning stealth fontification.
@@ -411,16 +390,14 @@ If nil, means stealth fontification is never performed.
The value of this variable is used when Lazy Lock mode is turned on."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds"))
- :group 'lazy-lock)
+ (number :tag "seconds")))
(defcustom lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250)
"Maximum size of a chunk of stealth fontification.
Each iteration of stealth fontification can fontify this number of lines.
To speed up input response during stealth fontification, at the cost of stealth
taking longer to fontify, you could reduce the value of this variable."
- :type '(integer :tag "lines")
- :group 'lazy-lock)
+ :type '(integer :tag "lines"))
(defcustom lazy-lock-stealth-load
(if (condition-case nil (load-average) (error)) 200)
@@ -435,8 +412,7 @@ See also `lazy-lock-stealth-nice'."
:type (if (condition-case nil (load-average) (error))
'(choice (const :tag "never" nil)
(integer :tag "load"))
- '(const :format "%t: unsupported\n" nil))
- :group 'lazy-lock)
+ '(const :format "%t: unsupported\n" nil)))
(defcustom lazy-lock-stealth-nice 0.125
"Time in seconds to pause between chunks of stealth fontification.
@@ -447,14 +423,12 @@ To reduce machine load during stealth fontification, at the cost of stealth
taking longer to fontify, you could increase the value of this variable.
See also `lazy-lock-stealth-load'."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds"))
- :group 'lazy-lock)
+ (number :tag "seconds")))
(defcustom lazy-lock-stealth-verbose
(and (not lazy-lock-defer-contextually) (not (null font-lock-verbose)))
"If non-nil, means stealth fontification should show status messages."
- :type 'boolean
- :group 'lazy-lock)
+ :type 'boolean)
;; User Functions:
@@ -580,30 +554,30 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring.
(when (or fontifying defer-change defer-scroll defer-context)
(add-hook 'window-scroll-functions (if defer-scroll
- 'lazy-lock-defer-after-scroll
- 'lazy-lock-fontify-after-scroll)
+ #'lazy-lock-defer-after-scroll
+ #'lazy-lock-fontify-after-scroll)
nil t))
;;
;; Add hook if lazy-lock.el is fontifying and is not deferring changes.
(when (and fontifying (not defer-change) (not defer-context))
- (add-hook 'before-change-functions 'lazy-lock-arrange-before-change nil t))
+ (add-hook 'before-change-functions #'lazy-lock-arrange-before-change nil t))
;;
;; Replace Font Lock mode hook.
- (remove-hook 'after-change-functions 'font-lock-after-change-function t)
+ (remove-hook 'after-change-functions #'font-lock-after-change-function t)
(add-hook 'after-change-functions
(cond ((and defer-change defer-context)
- 'lazy-lock-defer-rest-after-change)
+ #'lazy-lock-defer-rest-after-change)
(defer-change
- 'lazy-lock-defer-line-after-change)
+ #'lazy-lock-defer-line-after-change)
(defer-context
- 'lazy-lock-fontify-rest-after-change)
+ #'lazy-lock-fontify-rest-after-change)
(t
- 'lazy-lock-fontify-line-after-change))
+ #'lazy-lock-fontify-line-after-change))
nil t)
;;
;; Add package-specific hook.
- (add-hook 'outline-view-change-hook 'lazy-lock-fontify-after-visage nil t)
- (add-hook 'hs-hide-hook 'lazy-lock-fontify-after-visage nil t))
+ (add-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage nil t)
+ (add-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage nil t))
(defun lazy-lock-install-timers (dtime stime)
;; Schedule or re-schedule the deferral and stealth timers.
@@ -616,13 +590,13 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(when (cdr defer)
(cancel-timer (cdr defer)))
(setcar lazy-lock-timers (cons dtime (and dtime
- (run-with-idle-timer dtime t 'lazy-lock-fontify-after-defer))))))
+ (run-with-idle-timer dtime t #'lazy-lock-fontify-after-defer))))))
(unless (eq stime (car (cdr lazy-lock-timers)))
(let ((stealth (cdr lazy-lock-timers)))
(when (cdr stealth)
(cancel-timer (cdr stealth)))
(setcdr lazy-lock-timers (cons stime (and stime
- (run-with-idle-timer stime t 'lazy-lock-fontify-after-idle)))))))
+ (run-with-idle-timer stime t #'lazy-lock-fontify-after-idle)))))))
(defun lazy-lock-unstall ()
;;
@@ -640,21 +614,21 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(save-restriction
(widen)
(lazy-lock-fontify-region (point-min) (point-max))))))
- (add-hook 'after-change-functions 'font-lock-after-change-function nil t))
+ (add-hook 'after-change-functions #'font-lock-after-change-function nil t))
;;
;; Remove the text properties.
(lazy-lock-after-unfontify-buffer)
;;
;; Remove the fontification hooks.
- (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t)
- (remove-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll t)
- (remove-hook 'before-change-functions 'lazy-lock-arrange-before-change t)
- (remove-hook 'after-change-functions 'lazy-lock-fontify-line-after-change t)
- (remove-hook 'after-change-functions 'lazy-lock-fontify-rest-after-change t)
- (remove-hook 'after-change-functions 'lazy-lock-defer-line-after-change t)
- (remove-hook 'after-change-functions 'lazy-lock-defer-rest-after-change t)
- (remove-hook 'outline-view-change-hook 'lazy-lock-fontify-after-visage t)
- (remove-hook 'hs-hide-hook 'lazy-lock-fontify-after-visage t))
+ (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t)
+ (remove-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll t)
+ (remove-hook 'before-change-functions #'lazy-lock-arrange-before-change t)
+ (remove-hook 'after-change-functions #'lazy-lock-fontify-line-after-change t)
+ (remove-hook 'after-change-functions #'lazy-lock-fontify-rest-after-change t)
+ (remove-hook 'after-change-functions #'lazy-lock-defer-line-after-change t)
+ (remove-hook 'after-change-functions #'lazy-lock-defer-rest-after-change t)
+ (remove-hook 'outline-view-change-hook #'lazy-lock-fontify-after-visage t)
+ (remove-hook 'hs-hide-hook #'lazy-lock-fontify-after-visage t))
;; Hook functions.
@@ -682,7 +656,7 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; result in an unnecessary trigger after this if we did not cancel it now.
(set-window-redisplay-end-trigger window nil))
-(defun lazy-lock-defer-after-scroll (window window-start)
+(defun lazy-lock-defer-after-scroll (window _window-start)
;; Called from `window-scroll-functions'.
;; Defer fontification following the scroll. Save the current buffer so that
;; we subsequently fontify in all windows showing the buffer.
@@ -750,7 +724,7 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(defalias 'lazy-lock-fontify-line-after-change
;; Called from `after-change-functions'.
;; Fontify the current change.
- 'font-lock-after-change-function)
+ #'font-lock-after-change-function)
(defun lazy-lock-fontify-rest-after-change (beg end old-len)
;; Called from `after-change-functions'.
@@ -758,29 +732,29 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; buffer. Save the current buffer so that we subsequently fontify in all
;; windows showing the buffer.
(lazy-lock-fontify-line-after-change beg end old-len)
- (save-buffer-state nil
+ (with-silent-modifications
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
(save-restriction
(widen)
(remove-text-properties end (point-max) '(lazy-lock nil)))))
-(defun lazy-lock-defer-line-after-change (beg end old-len)
+(defun lazy-lock-defer-line-after-change (beg end _old-len)
;; Called from `after-change-functions'.
;; Defer fontification of the current change. Save the current buffer so
;; that we subsequently fontify in all windows showing the buffer.
- (save-buffer-state nil
+ (with-silent-modifications
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
(remove-text-properties (max (1- beg) (point-min))
(min (1+ end) (point-max))
'(lazy-lock nil))))
-(defun lazy-lock-defer-rest-after-change (beg end old-len)
+(defun lazy-lock-defer-rest-after-change (beg _end _old-len)
;; Called from `after-change-functions'.
;; Defer fontification of the rest of the buffer. Save the current buffer so
;; that we subsequently fontify in all windows showing the buffer.
- (save-buffer-state nil
+ (with-silent-modifications
(unless (memq (current-buffer) lazy-lock-buffers)
(push (current-buffer) lazy-lock-buffers))
(save-restriction
@@ -809,10 +783,10 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(setq lazy-lock-buffers (cdr lazy-lock-buffers)))))
;; Add hook if fontification should now be defer-driven in this buffer.
(when (and lazy-lock-mode lazy-lock-defer-on-scrolling
- (memq 'lazy-lock-fontify-after-scroll window-scroll-functions)
+ (memq #'lazy-lock-fontify-after-scroll window-scroll-functions)
(not (or (input-pending-p) (lazy-lock-unfontified-p))))
- (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t)
- (add-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll nil t)))
+ (remove-hook 'window-scroll-functions #'lazy-lock-fontify-after-scroll t)
+ (add-hook 'window-scroll-functions #'lazy-lock-defer-after-scroll nil t)))
(defun lazy-lock-fontify-after-idle ()
;; Called from `timer-idle-list'.
@@ -868,14 +842,14 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; Called from `font-lock-after-fontify-buffer'.
;; Mark the current buffer as fontified.
;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
- (save-buffer-state nil
+ (with-silent-modifications
(add-text-properties (point-min) (point-max) '(lazy-lock t))))
(defun lazy-lock-after-unfontify-buffer ()
;; Called from `font-lock-after-unfontify-buffer'.
;; Mark the current buffer as unfontified.
;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
- (save-buffer-state nil
+ (with-silent-modifications
(remove-text-properties (point-min) (point-max) '(lazy-lock nil))))
;; Fontification functions.
@@ -888,27 +862,27 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(widen)
(when (setq beg (text-property-any beg end 'lazy-lock nil))
(save-excursion
- (save-match-data
- (save-buffer-state
- (next)
- ;; Find successive unfontified regions between BEG and END.
- (condition-case data
- (do-while beg
- (setq next (or (text-property-any beg end 'lazy-lock t) end))
- ;; Make sure the region end points are at beginning of line.
- (goto-char beg)
- (unless (bolp)
- (beginning-of-line)
- (setq beg (point)))
- (goto-char next)
- (unless (bolp)
- (forward-line)
- (setq next (point)))
- ;; Fontify the region, then flag it as fontified.
- (font-lock-fontify-region beg next)
- (add-text-properties beg next '(lazy-lock t))
- (setq beg (text-property-any next end 'lazy-lock nil)))
- ((error quit) (message "Fontifying region...%s" data)))))))))
+ (with-silent-modifications
+ (let ((inhibit-point-motion-hooks t))
+ ;; Find successive unfontified regions between BEG and END.
+ (condition-case data
+ (do-while beg
+ (let ((next (or (text-property-any beg end 'lazy-lock t)
+ end)))
+ ;; Make sure the region end points are at beginning of line.
+ (goto-char beg)
+ (unless (bolp)
+ (beginning-of-line)
+ (setq beg (point)))
+ (goto-char next)
+ (unless (bolp)
+ (forward-line)
+ (setq next (point)))
+ ;; Fontify the region, then flag it as fontified.
+ (font-lock-fontify-region beg next)
+ (add-text-properties beg next '(lazy-lock t))
+ (setq beg (text-property-any next end 'lazy-lock nil))))
+ ((error quit) (message "Fontifying region...%s" data)))))))))
(defun lazy-lock-fontify-chunk ()
;; Fontify the nearest chunk, for stealth, in the current buffer.
@@ -1036,14 +1010,12 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
;; Install ourselves:
-(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize)
-(add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger)
+(add-hook 'window-size-change-functions #'lazy-lock-fontify-after-resize)
+(add-hook 'redisplay-end-trigger-functions #'lazy-lock-fontify-after-trigger)
(unless (assq 'lazy-lock-mode minor-mode-alist)
(setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil)))))
-;; Provide ourselves:
-
(provide 'lazy-lock)
;; Local Variables:
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index f274dfb926d..9bf68456826 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -1,4 +1,4 @@
-;;; longlines.el --- automatically wrap long lines -*- coding:utf-8 -*-
+;;; longlines.el --- automatically wrap long lines -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc.
@@ -48,7 +48,6 @@
Otherwise, you can perform filling using `fill-paragraph' or
`auto-fill-mode'. In any case, the soft newlines will be removed
when the file is saved to disk."
- :group 'longlines
:type 'boolean)
(defcustom longlines-wrap-follows-window-size nil
@@ -60,7 +59,6 @@ with differing widths.
If the value is an integer, that specifies the distance from the
right edge of the window at which wrapping occurs. For any other
non-nil value, wrapping occurs 2 characters from the right edge."
- :group 'longlines
:type 'boolean)
(defcustom longlines-show-hard-newlines nil
@@ -68,13 +66,11 @@ non-nil value, wrapping occurs 2 characters from the right edge."
\(The variable `longlines-show-effect' controls what they look like.)
You can also enable the display temporarily, using the command
`longlines-show-hard-newlines'."
- :group 'longlines
:type 'boolean)
(defcustom longlines-show-effect (propertize "¶\n" 'face 'escape-glyph)
"A string to display when showing hard newlines.
This is used when `longlines-show-hard-newlines' is on."
- :group 'longlines
:type 'string)
;;; Internal variables
@@ -110,23 +106,23 @@ always call `fill-paragraph' to fill individual paragraphs.
If the variable `longlines-show-hard-newlines' is non-nil, hard
newlines are indicated with a symbol."
- :group 'longlines :lighter " ll"
+ :lighter " ll"
(if longlines-mode
;; Turn on longlines mode
(progn
(use-hard-newlines 1 'never)
(set (make-local-variable 'require-final-newline) nil)
(add-to-list 'buffer-file-format 'longlines)
- (add-hook 'change-major-mode-hook 'longlines-mode-off nil t)
- (add-hook 'before-revert-hook 'longlines-before-revert-hook nil t)
+ (add-hook 'change-major-mode-hook #'longlines-mode-off nil t)
+ (add-hook 'before-revert-hook #'longlines-before-revert-hook nil t)
(make-local-variable 'buffer-substring-filters)
(make-local-variable 'longlines-auto-wrap)
(set (make-local-variable 'isearch-search-fun-function)
- 'longlines-search-function)
+ #'longlines-search-function)
(set (make-local-variable 'replace-search-function)
- 'longlines-search-forward)
+ #'longlines-search-forward)
(set (make-local-variable 'replace-re-search-function)
- 'longlines-re-search-forward)
+ #'longlines-re-search-forward)
(add-to-list 'buffer-substring-filters 'longlines-encode-string)
(when longlines-wrap-follows-window-size
(let ((dw (if (and (integerp longlines-wrap-follows-window-size)
@@ -138,7 +134,7 @@ newlines are indicated with a symbol."
(set (make-local-variable 'fill-column)
(- (window-width) dw)))
(add-hook 'window-configuration-change-hook
- 'longlines-window-change-function nil t))
+ #'longlines-window-change-function nil t))
(let ((buffer-undo-list t)
(inhibit-read-only t)
(inhibit-modification-hooks t)
@@ -160,21 +156,22 @@ newlines are indicated with a symbol."
;; Hacks to make longlines play nice with various modes.
(cond ((eq major-mode 'mail-mode)
- (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t)
+ (declare-function mail-indent-citation "sendmail" ())
+ (add-hook 'mail-setup-hook #'longlines-decode-buffer nil t)
(or mail-citation-hook
- (add-hook 'mail-citation-hook 'mail-indent-citation nil t))
- (add-hook 'mail-citation-hook 'longlines-decode-region nil t))
+ (add-hook 'mail-citation-hook #'mail-indent-citation nil t))
+ (add-hook 'mail-citation-hook #'longlines-decode-region nil t))
((eq major-mode 'message-mode)
- (add-hook 'message-setup-hook 'longlines-decode-buffer nil t)
+ (add-hook 'message-setup-hook #'longlines-decode-buffer nil t)
(make-local-variable 'message-indent-citation-function)
(if (not (listp message-indent-citation-function))
(setq message-indent-citation-function
(list message-indent-citation-function)))
- (add-to-list 'message-indent-citation-function
- 'longlines-decode-region t)))
+ (add-hook 'message-indent-citation-function
+ #'longlines-decode-region t t)))
- (add-hook 'after-change-functions 'longlines-after-change-function nil t)
- (add-hook 'post-command-hook 'longlines-post-command-function nil t)
+ (add-hook 'after-change-functions #'longlines-after-change-function nil t)
+ (add-hook 'post-command-hook #'longlines-post-command-function nil t)
(when longlines-auto-wrap
(auto-fill-mode 0)))
;; Turn off longlines mode
@@ -190,12 +187,12 @@ newlines are indicated with a symbol."
(widen)
(longlines-encode-region (point-min) (point-max))
(setq longlines-decoded nil))))
- (remove-hook 'change-major-mode-hook 'longlines-mode-off t)
- (remove-hook 'after-change-functions 'longlines-after-change-function t)
- (remove-hook 'post-command-hook 'longlines-post-command-function t)
- (remove-hook 'before-revert-hook 'longlines-before-revert-hook t)
+ (remove-hook 'change-major-mode-hook #'longlines-mode-off t)
+ (remove-hook 'after-change-functions #'longlines-after-change-function t)
+ (remove-hook 'post-command-hook #'longlines-post-command-function t)
+ (remove-hook 'before-revert-hook #'longlines-before-revert-hook t)
(remove-hook 'window-configuration-change-hook
- 'longlines-window-change-function t)
+ #'longlines-window-change-function t)
(when longlines-wrap-follows-window-size
(kill-local-variable 'fill-column))
(kill-local-variable 'isearch-search-fun-function)
@@ -396,11 +393,11 @@ compatibility with `format-alist', and is ignored."
"Return a copy of STRING with each soft newline replaced by a space.
Hard newlines are left intact."
(let* ((str (copy-sequence string))
- (pos (string-match "\n" str)))
+ (pos (string-search "\n" str)))
(while pos
(if (null (get-text-property pos 'hard str))
(aset str pos ? ))
- (setq pos (string-match "\n" str (1+ pos))))
+ (setq pos (string-search "\n" str (1+ pos))))
str))
;;; Auto wrap
@@ -482,17 +479,17 @@ This is called by `window-configuration-change-hook'."
;;; Loading and saving
(defun longlines-before-revert-hook ()
- (add-hook 'after-revert-hook 'longlines-after-revert-hook nil t)
+ (add-hook 'after-revert-hook #'longlines-after-revert-hook nil t)
(longlines-mode 0))
(defun longlines-after-revert-hook ()
- (remove-hook 'after-revert-hook 'longlines-after-revert-hook t)
+ (remove-hook 'after-revert-hook #'longlines-after-revert-hook t)
(longlines-mode 1))
(add-to-list
'format-alist
(list 'longlines "Automatically wrap long lines." nil nil
- 'longlines-encode-region t nil))
+ #'longlines-encode-region t nil))
;;; Unloading
diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el
index 2f74faf1d6c..5b3a76e2f79 100644
--- a/lisp/obsolete/mailpost.el
+++ b/lisp/obsolete/mailpost.el
@@ -1,4 +1,4 @@
-;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer
+;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer -*- lexical-binding: t; -*-
;; This is in the public domain
;; since Delp distributed it in 1986 without a copyright notice.
@@ -76,7 +76,7 @@ site-init."
(with-current-buffer errbuf
(erase-buffer))))
(with-file-modes 384 (setq temfile (make-temp-file ",rpost")))
- (apply 'call-process
+ (apply #'call-process
(append (list (if (boundp 'post-mail-program)
post-mail-program
"/usr/uci/lib/mh/post")
diff --git a/lisp/obsolete/mantemp.el b/lisp/obsolete/mantemp.el
index 287a5a732ca..97e70f29841 100644
--- a/lisp/obsolete/mantemp.el
+++ b/lisp/obsolete/mantemp.el
@@ -1,4 +1,4 @@
-;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output
+;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output -*- lexical-binding: t; -*-
;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/obsolete/meese.el b/lisp/obsolete/meese.el
index 81739dfa6cb..7443bacc8b2 100644
--- a/lisp/obsolete/meese.el
+++ b/lisp/obsolete/meese.el
@@ -1,4 +1,4 @@
-;;; meese.el --- protect the impressionable young minds of America
+;;; meese.el --- protect the impressionable young minds of America -*- lexical-binding: t; -*-
;; This is in the public domain on account of being distributed since
;; 1985 or 1986 without a copyright notice.
diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el
index fa73dc7a0fd..be252395e45 100644
--- a/lisp/obsolete/messcompat.el
+++ b/lisp/obsolete/messcompat.el
@@ -1,4 +1,4 @@
-;;; messcompat.el --- making message mode compatible with mail mode
+;;; messcompat.el --- making message mode compatible with mail mode -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
diff --git a/lisp/obsolete/metamail.el b/lisp/obsolete/metamail.el
index ef97e8aa55c..72237239ddb 100644
--- a/lisp/obsolete/metamail.el
+++ b/lisp/obsolete/metamail.el
@@ -1,4 +1,4 @@
-;;; metamail.el --- Metamail interface for GNU Emacs
+;;; metamail.el --- Metamail interface for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 1996, 2001-2021 Free Software Foundation, Inc.
@@ -44,13 +44,11 @@
(defcustom metamail-program-name "metamail"
"Metamail program name."
- :type 'string
- :group 'metamail)
+ :type 'string)
(defcustom metamail-mailer-name "emacs"
"Mailer name set to MM_MAILER environment variable."
- :type 'string
- :group 'metamail)
+ :type 'string)
(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
"Environment variables passed to `metamail'.
@@ -65,8 +63,7 @@ It is not expected to be altered globally by `set' or `setq'.
Instead, change its value temporary using `let' or `let*' form.
`-m MAILER' argument is automatically generated from the
`metamail-mailer-name' variable."
- :type '(repeat (string :tag "Switch"))
- :group 'metamail)
+ :type '(repeat (string :tag "Switch")))
;;;###autoload
(defun metamail-interpret-header ()
@@ -193,7 +190,7 @@ redisplayed as output is inserted."
(list "-m" (or metamail-mailer-name "emacs"))
(list metafile))))
;; `metamail' may not delete the temporary file!
- (condition-case error
+ (condition-case nil
(delete-file metafile)
(error nil))
)))
diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el
index 608596e882b..36d9dc658c7 100644
--- a/lisp/obsolete/mouse-sel.el
+++ b/lisp/obsolete/mouse-sel.el
@@ -1,4 +1,4 @@
-;;; mouse-sel.el --- multi-click selection support
+;;; mouse-sel.el --- multi-click selection support -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc.
@@ -146,20 +146,17 @@
If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
of the region nearest to where the mouse last was.
If nil, point will always be placed at the beginning of the region."
- :type 'boolean
- :group 'mouse-sel)
+ :type 'boolean)
(defcustom mouse-sel-cycle-clicks t
"If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks."
- :type 'boolean
- :group 'mouse-sel)
+ :type 'boolean)
(defcustom mouse-sel-default-bindings t
"Control mouse bindings."
:type '(choice (const :tag "none" nil)
(const :tag "cut and paste" interprogram-cut-paste)
- (other :tag "default bindings" t))
- :group 'mouse-sel)
+ (other :tag "default bindings" t)))
;;=== Key bindings ========================================================
@@ -216,14 +213,13 @@ the mouse position (or point, if `mouse-yank-at-point' is non-nil).
- mouse-2 while selecting or extending copies selection to the
kill ring; mouse-1 or mouse-3 kills it."
:global t
- :group 'mouse-sel
(if mouse-sel-mode
(progn
;; If mouse-2 has never been done by the user, initialize the
;; `event-kind' property to ensure that `follow-link' clicks
;; are interpreted correctly.
(put 'mouse-2 'event-kind 'mouse-click)
- (add-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
+ (add-hook 'x-lost-selection-functions #'mouse-sel-lost-selection-hook)
(when mouse-sel-default-bindings
;; Save original bindings and replace them with new ones.
(setq mouse-sel-original-bindings
@@ -240,7 +236,7 @@ kill ring; mouse-1 or mouse-3 kills it."
#'mouse-sel--ignore))))
;; Restore original bindings
- (remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
+ (remove-hook 'x-lost-selection-functions #'mouse-sel-lost-selection-hook)
(dolist (binding mouse-sel-original-bindings)
(global-set-key (car binding) (cdr binding)))
;; Restore the old values of these variables,
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index 147efed0057..9aab1e7c9f5 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -228,8 +228,7 @@ with three items unique to nnir summary buffers:
If nil this will use `gnus-summary-line-format'."
:version "24.1"
- :type '(choice (const :tag "gnus-summary-line-format" nil) string)
- :group 'nnir)
+ :type '(choice (const :tag "gnus-summary-line-format" nil) string))
(defcustom nnir-ignored-newsgroups ""
@@ -237,8 +236,7 @@ If nil this will use `gnus-summary-line-format'."
Any newsgroup in the active file matching this regexp will be
skipped when searching."
:version "24.1"
- :type '(regexp)
- :group 'nnir)
+ :type '(regexp))
(defcustom nnir-imap-default-search-key "whole message"
"The default IMAP search key for an nnir search.
@@ -246,19 +244,16 @@ Must be one of the keys in `nnir-imap-search-arguments'. To use
raw imap queries by default set this to \"imap\"."
:version "24.1"
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
- nnir-imap-search-arguments))
- :group 'nnir)
+ nnir-imap-search-arguments)))
(defcustom nnir-swish++-configuration-file
(expand-file-name "~/Mail/swish++.conf")
"Configuration file for swish++."
- :type '(file)
- :group 'nnir)
+ :type '(file))
(defcustom nnir-swish++-program "search"
"Name of swish++ search executable."
- :type '(string)
- :group 'nnir)
+ :type '(string))
(defcustom nnir-swish++-additional-switches '()
"A list of strings, to be given as additional arguments to swish++.
@@ -267,8 +262,7 @@ Note that this should be a list. I.e., do NOT use the following:
(setq nnir-swish++-additional-switches \"-i -w\") ; wrong
Instead, use this:
(setq nnir-swish++-additional-switches \\='(\"-i\" \"-w\"))"
- :type '(repeat (string))
- :group 'nnir)
+ :type '(repeat (string)))
(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from swish++ file names to get group names.
@@ -277,37 +271,23 @@ expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for swish++, not Namazu."
- :type '(regexp)
- :group 'nnir)
+ :type '(regexp))
;; Swish-E.
-;; URL: http://swish-e.org/
-;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and
+;; URL: http://swish-e.org/ [dead link?]
+;; Variables `nnir-swish-e-index-files', `nnir-swish-e-program' and
;; `nnir-swish-e-additional-switches'
-(make-obsolete-variable 'nnir-swish-e-index-file
- 'nnir-swish-e-index-files "Emacs 23.1")
-(defcustom nnir-swish-e-index-file
- (expand-file-name "~/Mail/index.swish-e")
- "Index file for swish-e.
-This could be a server parameter.
-It is never consulted once `nnir-swish-e-index-files', which should be
-used instead, has been customized."
- :type '(file)
- :group 'nnir)
-
(defcustom nnir-swish-e-index-files
- (list nnir-swish-e-index-file)
+ (list (expand-file-name "~/Mail/index.swish-e"))
"List of index files for swish-e.
This could be a server parameter."
- :type '(repeat (file))
- :group 'nnir)
+ :type '(repeat (file)))
(defcustom nnir-swish-e-program "swish-e"
"Name of swish-e search executable.
This cannot be a server parameter."
- :type '(string)
- :group 'nnir)
+ :type '(string))
(defcustom nnir-swish-e-additional-switches '()
"A list of strings, to be given as additional arguments to swish-e.
@@ -318,8 +298,7 @@ Instead, use this:
(setq nnir-swish-e-additional-switches \\='(\"-i\" \"-w\"))
This could be a server parameter."
- :type '(repeat (string))
- :group 'nnir)
+ :type '(repeat (string)))
(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from swish-e file names to get group names.
@@ -330,15 +309,13 @@ This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for swish-e, not Namazu.
This could be a server parameter."
- :type '(regexp)
- :group 'nnir)
+ :type '(regexp))
-;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/>
+;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/> [dead link?]
(defcustom nnir-hyrex-program "nnir-search"
"Name of the nnir-search executable."
- :type '(string)
- :group 'nnir)
+ :type '(string))
(defcustom nnir-hyrex-additional-switches '()
"A list of strings, to be given as additional arguments for nnir-search.
@@ -346,13 +323,11 @@ Note that this should be a list. I.e., do NOT use the following:
(setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong !
Instead, use this:
(setq nnir-hyrex-additional-switches \\='(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
- :type '(repeat (string))
- :group 'nnir)
+ :type '(repeat (string)))
(defcustom nnir-hyrex-index-directory (getenv "HOME")
"Index directory for HyREX."
- :type '(directory)
- :group 'nnir)
+ :type '(directory))
(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from HyREX file names to get group names.
@@ -364,20 +339,17 @@ setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\")
Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
arrive at the correct group name, \"mail.misc\"."
- :type '(directory)
- :group 'nnir)
+ :type '(directory))
;; Namazu engine, see <URL:http://www.namazu.org/>
(defcustom nnir-namazu-program "namazu"
"Name of Namazu search executable."
- :type '(string)
- :group 'nnir)
+ :type '(string))
(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/")
"Index directory for Namazu."
- :type '(directory)
- :group 'nnir)
+ :type '(directory))
(defcustom nnir-namazu-additional-switches '()
"A list of strings, to be given as additional arguments to namazu.
@@ -388,8 +360,7 @@ Note that this should be a list. I.e., do NOT use the following:
(setq nnir-namazu-additional-switches \"-i -w\") ; wrong
Instead, use this:
(setq nnir-namazu-additional-switches \\='(\"-i\" \"-w\"))"
- :type '(repeat (string))
- :group 'nnir)
+ :type '(repeat (string)))
(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
"The prefix to remove from Namazu file names to get group names.
@@ -401,14 +372,12 @@ setting: (setq nnir-namazu-remove-prefix \"/home/john/Mail/\")
Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
arrive at the correct group name, \"mail.misc\"."
- :type '(directory)
- :group 'nnir)
+ :type '(directory))
(defcustom nnir-notmuch-program "notmuch"
"Name of notmuch search executable."
:version "24.1"
- :type '(string)
- :group 'nnir)
+ :type '(string))
(defcustom nnir-notmuch-additional-switches '()
"A list of strings, to be given as additional arguments to notmuch.
@@ -418,8 +387,7 @@ Note that this should be a list. I.e., do NOT use the following:
Instead, use this:
(setq nnir-notmuch-additional-switches \\='(\"-i\" \"-w\"))"
:version "24.1"
- :type '(repeat (string))
- :group 'nnir)
+ :type '(repeat (string)))
(defcustom nnir-notmuch-remove-prefix
(regexp-quote (or (getenv "MAILDIR") (expand-file-name "~/Mail")))
@@ -430,8 +398,7 @@ expression.
This variable is very similar to `nnir-namazu-remove-prefix', except
that it is for notmuch, not Namazu."
:version "27.1"
- :type '(regexp)
- :group 'nnir)
+ :type '(regexp))
(defcustom nnir-notmuch-filter-group-names-function nil
"Whether and how to use Gnus group names as \"path:\" search terms.
@@ -457,7 +424,7 @@ like so:
`((imap nnir-run-imap
((criteria
"Imap Search in" ; Prompt
- ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
+ ,(mapcar #'car nnir-imap-search-arguments) ; alist for completing
nil ; allow any user input
nil ; initial value
nnir-imap-search-argument-history ; the history to use
@@ -495,7 +462,6 @@ Add an entry here when adding a new search engine.")
(defcustom nnir-method-default-engines '((nnimap . imap))
"Alist of default search engines keyed by server method."
:version "27.1"
- :group 'nnir
:type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool)
(const nneething) (const nndir) (const nnmbox)
(const nnml) (const nnmh) (const nndraft)
@@ -543,7 +509,7 @@ construct the vector entries."
(vector (gnus-group-full-name group server)
(if (string-match "\\`nnmaildir:" (gnus-group-server server))
(nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
+ (substring article 0 (string-search ":" article))
group nil)
(string-to-number article))
(string-to-number score)))))
@@ -573,7 +539,7 @@ extensions."
(or groups (gnus-server-get-active srv nnir-ignored-newsgroups))))
(message "Opening server %s" server)
(apply
- 'vconcat
+ #'vconcat
(catch 'found
(mapcar
#'(lambda (group)
@@ -954,10 +920,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
;; eliminate all ".", "/", "\" from beginning. Always matches.
(string-match "^[./\\]*\\(.*\\)$" dirnam)
;; "/" -> "."
- (setq group (replace-regexp-in-string
+ (setq group (string-replace
"/" "." (match-string 1 dirnam)))
;; Windows "\\" -> "."
- (setq group (replace-regexp-in-string "\\\\" "." group))
+ (setq group (string-replace "\\" "." group))
(push (vector (gnus-group-full-name group server)
(string-to-number artno)
@@ -1030,7 +996,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
(when (string-match prefix dirnam)
(setq dirnam (replace-match "" t t dirnam)))
(push (vector (gnus-group-full-name
- (replace-regexp-in-string "/" "." dirnam) server)
+ (string-replace "/" "." dirnam) server)
(string-to-number artno)
(string-to-number score))
artlist))
@@ -1214,7 +1180,7 @@ construct path: search terms (see the variable
(error "No directory found in method specification of server %s"
server))
(apply
- 'vconcat
+ #'vconcat
(mapcar (lambda (x)
(let ((group x)
artlist)
@@ -1239,15 +1205,15 @@ construct path: search terms (see the variable
group
(if (file-directory-p
(setq group
- (replace-regexp-in-string
- "\\." "/"
- group nil t)))
+ (string-replace
+ "." "/"
+ group)))
group))))))
(unless group
(error "Cannot locate directory for group"))
(save-excursion
(apply
- 'call-process "find" nil t
+ #'call-process "find" nil t
"find" group "-maxdepth" "1" "-type" "f"
"-name" "[0-9]*" "-exec"
"grep"
@@ -1260,7 +1226,8 @@ construct path: search terms (see the variable
(let* ((path (split-string
(buffer-substring
(point)
- (line-end-position)) "/" t))
+ (line-end-position))
+ "/" t))
(art (string-to-number (car (last path)))))
(while (string= "." (car path))
(setq path (cdr path)))
@@ -1359,7 +1326,7 @@ Query for the specs, or use SPECS."
(query-spec
(or (cdr (assq 'nnir-query-spec specs))
(apply
- 'append
+ #'append
(list (cons 'query
(read-string "Query: " nil 'nnir-search-history)))
(when nnir-extra-parms
@@ -1370,9 +1337,8 @@ Query for the specs, or use SPECS."
(list (cons 'nnir-query-spec query-spec)
(cons 'nnir-group-spec group-spec))))
-(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1")
+(define-obsolete-function-alias 'nnir-get-active #'gnus-server-get-active "28.1")
-;; The end.
(provide 'nnir)
;;; nnir.el ends here
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
index 07bccd90711..ce4c60e6a17 100644
--- a/lisp/obsolete/old-emacs-lock.el
+++ b/lisp/obsolete/old-emacs-lock.el
@@ -1,4 +1,4 @@
-;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked
+;;; old-emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked -*- lexical-binding: t; -*-
;; Copyright (C) 1994, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -90,13 +90,13 @@ If the buffer is locked, signal error and display its name."
(setq emacs-lock-from-exiting t)))
(unless noninteractive
- (add-hook 'kill-emacs-hook 'check-emacs-lock))
-(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock)
-(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked)
-(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel)
-(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked)
-(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel)
+ (add-hook 'kill-emacs-hook #'check-emacs-lock))
+(add-hook 'kill-buffer-hook #'emacs-lock-check-buffer-lock)
+(add-hook 'shell-mode-hook #'emacs-lock-was-buffer-locked)
+(add-hook 'shell-mode-hook #'emacs-lock-shell-sentinel)
+(add-hook 'telnet-mode-hook #'emacs-lock-was-buffer-locked)
+(add-hook 'telnet-mode-hook #'emacs-lock-shell-sentinel)
(provide 'emacs-lock)
-;;; emacs-lock.el ends here
+;;; old-emacs-lock.el ends here
diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el
index 58c385adad4..47f5089452f 100644
--- a/lisp/obsolete/otodo-mode.el
+++ b/lisp/obsolete/otodo-mode.el
@@ -1,4 +1,4 @@
-;;; todo-mode.el --- major mode for editing TODO list files
+;;; otodo-mode.el --- major mode for editing TODO list files -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
@@ -280,26 +280,21 @@ every day and it may also be marked on every day of the calendar.
Using \"&%%(equal (calendar-current-date) date)\" instead will only
show and mark todo entries for today, but may slow down processing of
the diary file somewhat."
- :type 'string
- :group 'todo)
+ :type 'string)
(defcustom todo-file-do (locate-user-emacs-file "todo-do" ".todo-do")
"TODO mode list file."
:version "24.4" ; added locate-user-emacs-file
- :type 'file
- :group 'todo)
+ :type 'file)
(defcustom todo-file-done (locate-user-emacs-file "todo-done" ".todo-done")
"TODO mode archive file."
:version "24.4" ; added locate-user-emacs-file
- :type 'file
- :group 'todo)
+ :type 'file)
(defcustom todo-mode-hook nil
"TODO mode hooks."
- :type 'hook
- :group 'todo)
+ :type 'hook)
(defcustom todo-edit-mode-hook nil
"TODO Edit mode hooks."
- :type 'hook
- :group 'todo)
+ :type 'hook)
(defcustom todo-insert-threshold 0
"TODO mode insertion accuracy.
@@ -314,8 +309,7 @@ your item just before that point. If you set the threshold to,
e.g. 8, it will stop as soon as the window size drops below that
amount and will insert the item in the approximate center of that
window."
- :type 'integer
- :group 'todo)
+ :type 'integer)
(defvar todo-edit-buffer " *TODO Edit*"
"TODO Edit buffer name.")
(defcustom todo-file-top (locate-user-emacs-file "todo-top" ".todo-top")
@@ -324,32 +318,26 @@ window."
Not in TODO format, but diary compatible.
Automatically generated when `todo-save-top-priorities' is non-nil."
:version "24.4" ; added locate-user-emacs-file
- :type 'string
- :group 'todo)
+ :type 'string)
(defcustom todo-print-function 'ps-print-buffer-with-faces
"Function to print the current buffer."
- :type 'symbol
- :group 'todo)
+ :type 'symbol)
(defcustom todo-show-priorities 1
"Default number of priorities to show by \\[todo-top-priorities].
0 means show all entries."
- :type 'integer
- :group 'todo)
+ :type 'integer)
(defcustom todo-print-priorities 0
"Default number of priorities to print by \\[todo-print].
0 means print all entries."
- :type 'integer
- :group 'todo)
+ :type 'integer)
(defcustom todo-remove-separator t
"Non-nil to remove category separators in\
\\[todo-top-priorities] and \\[todo-print]."
- :type 'boolean
- :group 'todo)
+ :type 'boolean)
(defcustom todo-save-top-priorities-too t
"Non-nil makes `todo-save' automatically save top-priorities in `todo-file-top'."
- :type 'boolean
- :group 'todo)
+ :type 'boolean)
;; Thanks for the ISO time stamp format go to Karl Eichwalder <ke@suse.de>
;; My format string for the appt.el package is "%3b %2d, %y, %02I:%02M%p".
@@ -358,17 +346,14 @@ Automatically generated when `todo-save-top-priorities' is non-nil."
"%:y-%02m-%02d %02H:%02M"
"TODO mode time string format for done entries.
For details see the variable `time-stamp-format'."
- :type 'string
- :group 'todo)
+ :type 'string)
(defcustom todo-entry-prefix-function 'todo-entry-timestamp-initials
"Function producing text to insert at start of todo entry."
- :type 'symbol
- :group 'todo)
+ :type 'symbol)
(defcustom todo-initials (or (getenv "INITIALS") (user-login-name))
"Initials of todo item author."
- :type 'string
- :group 'todo)
+ :type 'string)
(defun todo-entry-timestamp-initials ()
"Prepend timestamp and your initials to the head of a TODO entry."
@@ -395,25 +380,25 @@ Use `todo-categories' instead.")
(defvar todo-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
- (define-key map "+" 'todo-forward-category)
- (define-key map "-" 'todo-backward-category)
- (define-key map "d" 'todo-file-item) ;done/delete
- (define-key map "e" 'todo-edit-item)
- (define-key map "E" 'todo-edit-multiline)
- (define-key map "f" 'todo-file-item)
- (define-key map "i" 'todo-insert-item)
- (define-key map "I" 'todo-insert-item-here)
- (define-key map "j" 'todo-jump-to-category)
- (define-key map "k" 'todo-delete-item)
- (define-key map "l" 'todo-lower-item)
- (define-key map "n" 'todo-forward-item)
- (define-key map "p" 'todo-backward-item)
- (define-key map "P" 'todo-print)
- (define-key map "q" 'todo-quit)
- (define-key map "r" 'todo-raise-item)
- (define-key map "s" 'todo-save)
- (define-key map "S" 'todo-save-top-priorities)
- (define-key map "t" 'todo-top-priorities)
+ (define-key map "+" #'todo-forward-category)
+ (define-key map "-" #'todo-backward-category)
+ (define-key map "d" #'todo-file-item) ;done/delete
+ (define-key map "e" #'todo-edit-item)
+ (define-key map "E" #'todo-edit-multiline)
+ (define-key map "f" #'todo-file-item)
+ (define-key map "i" #'todo-insert-item)
+ (define-key map "I" #'todo-insert-item-here)
+ (define-key map "j" #'todo-jump-to-category)
+ (define-key map "k" #'todo-delete-item)
+ (define-key map "l" #'todo-lower-item)
+ (define-key map "n" #'todo-forward-item)
+ (define-key map "p" #'todo-backward-item)
+ (define-key map "P" #'todo-print)
+ (define-key map "q" #'todo-quit)
+ (define-key map "r" #'todo-raise-item)
+ (define-key map "s" #'todo-save)
+ (define-key map "S" #'todo-save-top-priorities)
+ (define-key map "t" #'todo-top-priorities)
map)
"TODO mode keymap.")
@@ -451,7 +436,7 @@ Use `todo-categories' instead.")
(search-forward-regexp (concat "^" todo-category-end))
(narrow-to-region begin (line-beginning-position))
(goto-char (point-min)))))
-(defalias 'todo-cat-slct 'todo-category-select)
+(defalias 'todo-cat-slct #'todo-category-select)
(defun todo-forward-category ()
"Go forward to TODO list of next category."
@@ -459,7 +444,7 @@ Use `todo-categories' instead.")
(setq todo-category-number
(mod (1+ todo-category-number) (length todo-categories)))
(todo-category-select))
-(defalias 'todo-cmd-forw 'todo-forward-category)
+(defalias 'todo-cmd-forw #'todo-forward-category)
(defun todo-backward-category ()
"Go back to TODO list of previous category."
@@ -467,14 +452,14 @@ Use `todo-categories' instead.")
(setq todo-category-number
(mod (1- todo-category-number) (length todo-categories)))
(todo-category-select))
-(defalias 'todo-cmd-back 'todo-backward-category)
+(defalias 'todo-cmd-back #'todo-backward-category)
(defun todo-backward-item ()
"Select previous entry of TODO list."
(interactive)
(search-backward-regexp (concat "^" (regexp-quote todo-prefix)) nil t)
(message ""))
-(defalias 'todo-cmd-prev 'todo-backward-item)
+(defalias 'todo-cmd-prev #'todo-backward-item)
(defun todo-forward-item (&optional count)
"Select COUNT-th next entry of TODO list."
@@ -485,7 +470,7 @@ Use `todo-categories' instead.")
nil 'goto-end count)
(beginning-of-line)
(message ""))
-(defalias 'todo-cmd-next 'todo-forward-item)
+(defalias 'todo-cmd-next #'todo-forward-item)
(defun todo-save ()
"Save the TODO list."
@@ -494,7 +479,7 @@ Use `todo-categories' instead.")
(save-restriction
(save-buffer)))
(if todo-save-top-priorities-too (todo-save-top-priorities)))
-(defalias 'todo-cmd-save 'todo-save)
+(defalias 'todo-cmd-save #'todo-save)
(defun todo-quit ()
"Done with TODO list for now."
@@ -503,7 +488,7 @@ Use `todo-categories' instead.")
(todo-save)
(message "")
(bury-buffer))
-(defalias 'todo-cmd-done 'todo-quit)
+(defalias 'todo-cmd-done #'todo-quit)
(defun todo-edit-item ()
"Edit current TODO list entry."
@@ -518,7 +503,7 @@ Use `todo-categories' instead.")
(todo-backward-item)
(message ""))))
(error "No TODO list entry to edit")))
-(defalias 'todo-cmd-edit 'todo-edit-item)
+(defalias 'todo-cmd-edit #'todo-edit-item)
(defun todo-edit-multiline ()
"Set up a buffer for editing a multiline TODO list entry."
@@ -622,7 +607,7 @@ category."
(category (if arg (todo-completing-read) current-category)))
(todo-add-item-non-interactively new-item category))))
-(defalias 'todo-cmd-inst 'todo-insert-item)
+(defalias 'todo-cmd-inst #'todo-insert-item)
(defun todo-insert-item-here ()
"Insert a new TODO list entry directly above the entry at point.
@@ -650,7 +635,7 @@ If point is on an empty line, insert the entry there."
(setq todo-previous-answer
(y-or-n-p (format-message "More important than `%s'? " item)))))
todo-previous-answer)
-(defalias 'todo-ask-p 'todo-more-important-p)
+(defalias 'todo-ask-p #'todo-more-important-p)
(defun todo-delete-item ()
"Delete current TODO list entry."
@@ -664,7 +649,7 @@ If point is on an empty line, insert the entry there."
(todo-backward-item))
(message ""))
(error "No TODO list entry to delete")))
-(defalias 'todo-cmd-kill 'todo-delete-item)
+(defalias 'todo-cmd-kill #'todo-delete-item)
(defun todo-raise-item ()
"Raise priority of current entry."
@@ -677,7 +662,7 @@ If point is on an empty line, insert the entry there."
(insert item "\n"))
(message ""))
(error "No TODO list entry to raise")))
-(defalias 'todo-cmd-rais 'todo-raise-item)
+(defalias 'todo-cmd-rais #'todo-raise-item)
(defun todo-lower-item ()
"Lower priority of current entry."
@@ -691,7 +676,7 @@ If point is on an empty line, insert the entry there."
(insert item "\n"))
(message ""))
(error "No TODO list entry to lower")))
-(defalias 'todo-cmd-lowr 'todo-lower-item)
+(defalias 'todo-cmd-lowr #'todo-lower-item)
(defun todo-file-item (&optional comment)
"File the current TODO list entry away, annotated with an optional COMMENT."
@@ -978,4 +963,4 @@ If INCLUDE-SEP is non-nil, return point after the separator."
(provide 'todo-mode)
-;;; todo-mode.el ends here
+;;; otodo-mode.el ends here
diff --git a/lisp/obsolete/patcomp.el b/lisp/obsolete/patcomp.el
index 8545f0721fa..2c35cb07007 100644
--- a/lisp/obsolete/patcomp.el
+++ b/lisp/obsolete/patcomp.el
@@ -1,4 +1,4 @@
-;;; patcomp.el --- used by patch files to update Emacs releases
+;;; patcomp.el --- used by patch files to update Emacs releases -*- lexical-binding: t; -*-
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el
index d4c90c2b298..cf0bc28b110 100644
--- a/lisp/obsolete/pc-mode.el
+++ b/lisp/obsolete/pc-mode.el
@@ -1,4 +1,4 @@
-;;; pc-mode.el --- emulate certain key bindings used on PCs
+;;; pc-mode.el --- emulate certain key bindings used on PCs -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -40,16 +40,16 @@ C-Escape does list-buffers."
(define-key function-key-map [delete] "\C-d")
(define-key function-key-map [M-delete] [?\M-d])
(define-key function-key-map [C-delete] [?\M-d])
- (global-set-key [C-M-delete] 'kill-sexp)
- (global-set-key [C-backspace] 'backward-kill-word)
- (global-set-key [M-backspace] 'undo)
+ (global-set-key [C-M-delete] #'kill-sexp)
+ (global-set-key [C-backspace] #'backward-kill-word)
+ (global-set-key [M-backspace] #'undo)
- (global-set-key [C-escape] 'list-buffers)
+ (global-set-key [C-escape] #'list-buffers)
- (global-set-key [home] 'beginning-of-line)
- (global-set-key [end] 'end-of-line)
- (global-set-key [C-home] 'beginning-of-buffer)
- (global-set-key [C-end] 'end-of-buffer))
+ (global-set-key [home] #'beginning-of-line)
+ (global-set-key [end] #'end-of-line)
+ (global-set-key [C-home] #'beginning-of-buffer)
+ (global-set-key [C-end] #'end-of-buffer))
(provide 'pc-mode)
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 3f184881096..f999f507972 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -1,4 +1,4 @@
-;;; pc-select.el --- emulate mark, cut, copy and paste from Motif
+;;; pc-select.el --- emulate mark, cut, copy and paste from Motif -*- lexical-binding: t; -*-
;;; (or MAC GUI or MS-windoze (bah)) look-and-feel
;;; including key bindings.
@@ -94,25 +94,21 @@ The scroll commands normally generate an error if you try to scroll
past the top or bottom of the buffer. This is annoying when selecting
text with these commands. If you set this variable to non-nil, these
errors are suppressed."
- :type 'boolean
- :group 'pc-select)
+ :type 'boolean)
(defcustom pc-select-selection-keys-only nil
"Non-nil means only bind the basic selection keys when started.
Other keys that emulate pc-behavior will be untouched.
This gives mostly Emacs-like behavior with only the selection keys enabled."
- :type 'boolean
- :group 'pc-select)
+ :type 'boolean)
(defcustom pc-select-meta-moves-sexps nil
"Non-nil means move sexp-wise with Meta key, otherwise move word-wise."
- :type 'boolean
- :group 'pc-select)
+ :type 'boolean)
(defcustom pc-selection-mode-hook nil
"The hook to run when PC Selection mode is toggled."
- :type 'hook
- :group 'pc-select)
+ :type 'hook)
(defvar pc-select-saved-settings-alist nil
"The values of the variables before PC Selection mode was toggled on.
@@ -318,9 +314,6 @@ but before calling PC Selection mode):
C-BACKSPACE backward-kill-word
M-BACKSPACE undo"
;; FIXME: bring pc-bindings-mode here ?
- nil nil nil
-
- :group 'pc-select
:global t
(if pc-selection-mode
diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el
index 425093832f8..4d30e326148 100644
--- a/lisp/obsolete/pgg-def.el
+++ b/lisp/obsolete/pgg-def.el
@@ -1,4 +1,4 @@
-;;; pgg-def.el --- functions/macros for defining PGG functions
+;;; pgg-def.el --- functions/macros for defining PGG functions -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2002-2021 Free Software Foundation, Inc.
@@ -32,47 +32,39 @@
(defcustom pgg-default-scheme 'gpg
"Default PGP scheme."
- :group 'pgg
:type '(choice (const :tag "GnuPG" gpg)
(const :tag "PGP 5" pgp5)
(const :tag "PGP" pgp)))
(defcustom pgg-default-user-id (user-login-name)
"User ID of your default identity."
- :group 'pgg
:type 'string)
(defcustom pgg-default-keyserver-address "subkeys.pgp.net"
"Host name of keyserver."
- :group 'pgg
:type 'string)
(defcustom pgg-query-keyserver nil
"Whether PGG queries keyservers for missing keys when verifying messages."
:version "22.1"
- :group 'pgg
:type 'boolean)
(defcustom pgg-encrypt-for-me t
"If t, encrypt all outgoing messages with user's public key."
- :group 'pgg
:type 'boolean)
(defcustom pgg-cache-passphrase t
"If t, cache passphrase."
- :group 'pgg
:type 'boolean)
(defcustom pgg-passphrase-cache-expiry 16
"How many seconds the passphrase is cached.
Whether the passphrase is cached at all is controlled by
`pgg-cache-passphrase'."
- :group 'pgg
:type 'integer)
(defcustom pgg-passphrase-coding-system nil
"Coding system to encode passphrase."
- :group 'pgg
:type 'coding-system)
(defvar pgg-messages-coding-system nil
diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el
index 90255fe2f7d..d06a485b975 100644
--- a/lisp/obsolete/pgg-gpg.el
+++ b/lisp/obsolete/pgg-gpg.el
@@ -1,4 +1,4 @@
-;;; pgg-gpg.el --- GnuPG support for PGG.
+;;; pgg-gpg.el --- GnuPG support for PGG. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
@@ -37,23 +37,19 @@
(defcustom pgg-gpg-program "gpg"
"The GnuPG executable."
- :group 'pgg-gpg
:type 'string)
(defcustom pgg-gpg-extra-args nil
"Extra arguments for every GnuPG invocation."
- :group 'pgg-gpg
:type '(repeat (string :tag "Argument")))
(defcustom pgg-gpg-recipient-argument "--recipient"
"GnuPG option to specify recipient."
- :group 'pgg-gpg
:type '(choice (const :tag "New `--recipient' option" "--recipient")
(const :tag "Old `--remote-user' option" "--remote-user")))
(defcustom pgg-gpg-use-agent t
"Whether to use gnupg agent for key caching."
- :group 'pgg-gpg
:type 'boolean)
(defvar pgg-gpg-user-id nil
@@ -97,7 +93,7 @@
passphrase-with-newline
(coding-system-change-eol-conversion
pgg-passphrase-coding-system 'unix)))
- (pgg-clear-string passphrase-with-newline))
+ (clear-string passphrase-with-newline))
(setq encoded-passphrase-with-new-line passphrase-with-newline
passphrase-with-newline nil))
(process-send-string process encoded-passphrase-with-new-line))
@@ -125,9 +121,9 @@
(if (= 127 exit-status)
(error "%s could not be found" program))))
(if passphrase-with-newline
- (pgg-clear-string passphrase-with-newline))
+ (clear-string passphrase-with-newline))
(if encoded-passphrase-with-new-line
- (pgg-clear-string encoded-passphrase-with-new-line))
+ (clear-string encoded-passphrase-with-new-line))
(if (and process (eq 'run (process-status process)))
(interrupt-process process))
(if (file-exists-p output-file-name)
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index edb5d4f6775..2c76365a415 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -1,4 +1,4 @@
-;;; pgg-parse.el --- OpenPGP packet parsing
+;;; pgg-parse.el --- OpenPGP packet parsing -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2002-2021 Free Software Foundation, Inc.
@@ -44,14 +44,12 @@
(defcustom pgg-parse-public-key-algorithm-alist
'((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
"Alist of the assigned number to the public key algorithm."
- :group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-parse-symmetric-key-algorithm-alist
'((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
"Alist of the assigned number to the symmetric key algorithm."
- :group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
@@ -59,7 +57,6 @@
'((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2) (8 . SHA256) (9 . SHA384)
(10 . SHA512))
"Alist of the assigned number to the cryptographic hash algorithm."
- :group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
@@ -68,7 +65,6 @@
(1 . ZIP)
(2 . ZLIB))
"Alist of the assigned number to the compression algorithm."
- :group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
@@ -87,13 +83,11 @@
(48 . "Certification revocation signature")
(64 . "Timestamp signature."))
"Alist of the assigned number to the signature type."
- :group 'pgg-parse
:type '(repeat
(cons (sexp :tag "Number") (sexp :tag "Type"))))
(defcustom pgg-ignore-packet-checksum t; XXX
"If non-nil checksum of each ascii armored packet will be ignored."
- :group 'pgg-parse
:type 'boolean)
(defvar pgg-armor-header-lines
@@ -148,7 +142,7 @@
;; `(string-to-number-list (pgg-read-body-string ,ptag))
)
-(defalias 'pgg-skip-bytes 'forward-char)
+(defalias 'pgg-skip-bytes #'forward-char)
(defmacro pgg-skip-header (ptag)
`(pgg-skip-bytes (nth 2 ,ptag)))
@@ -345,7 +339,7 @@
;; 100 to 110 = internal or user-defined
))
-(defun pgg-parse-signature-packet (ptag)
+(defun pgg-parse-signature-packet (_ptag)
(let* ((signature-version (pgg-byte-after))
(result (list (cons 'version signature-version)))
hashed-material field n)
@@ -411,7 +405,7 @@
pgg-parse-hash-algorithm-alist)))
result))
-(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+(defun pgg-parse-public-key-encrypted-session-key-packet (_ptag)
(let (result)
(pgg-set-alist result
'version (pgg-read-byte))
@@ -425,7 +419,7 @@
pgg-parse-public-key-algorithm-alist)))
result))
-(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (_ptag)
(let (result)
(pgg-set-alist result
'version
@@ -436,7 +430,7 @@
pgg-parse-symmetric-key-algorithm-alist)))
result))
-(defun pgg-parse-public-key-packet (ptag)
+(defun pgg-parse-public-key-packet (_ptag)
(let* ((key-version (pgg-read-byte))
(result (list (cons 'version key-version)))
field)
diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el
index e02032a6a57..665be0b2e2c 100644
--- a/lisp/obsolete/pgg-pgp.el
+++ b/lisp/obsolete/pgg-pgp.el
@@ -1,4 +1,4 @@
-;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
@@ -35,23 +35,19 @@
(defcustom pgg-pgp-program "pgp"
"PGP 2.* and 6.* executable."
- :group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-shell-file-name "/bin/sh"
"File name to load inferior shells from.
Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
- :group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-shell-command-switch "-c"
"Switch used to have the shell execute its command line argument."
- :group 'pgg-pgp
:type 'string)
(defcustom pgg-pgp-extra-args nil
"Extra arguments for every PGP invocation."
- :group 'pgg-pgp
:type '(choice
(const :tag "None" nil)
(string :tag "Arguments")))
@@ -112,7 +108,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(delete-file errors-file-name)
(file-error nil)))))
-(defun pgg-pgp-lookup-key (string &optional type)
+(defun pgg-pgp-lookup-key (string &optional _type)
"Search keys associated with STRING."
(let ((args (list "+batchmode" "+language=en" "-kv" string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
@@ -133,7 +129,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(defun pgg-pgp-encrypt-region (start end recipients &optional sign passphrase)
"Encrypt the current region between START and END."
(let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
- (passphrase (or passphrase
+ (_passphrase (or passphrase
(when sign
(pgg-read-passphrase
(format "PGP passphrase for %s: "
@@ -143,10 +139,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(concat
"+encrypttoself=off +verbose=1 +batchmode +language=us -fate "
(if (or recipients pgg-encrypt-for-me)
- (mapconcat 'shell-quote-argument
+ (mapconcat #'shell-quote-argument
(append recipients
(if pgg-encrypt-for-me
- (list pgg-pgp-user-id))) " "))
+ (list pgg-pgp-user-id)))
+ " "))
(if sign (concat " -s -u " (shell-quote-argument pgg-pgp-user-id))))))
(pgg-pgp-process-region start end nil pgg-pgp-program args)
(pgg-process-when-success nil)))
@@ -203,6 +200,7 @@ passphrase cache or user."
(let* ((orig-file (pgg-make-temp-file "pgg"))
(args "+verbose=1 +batchmode +language=us"))
(with-file-modes 448
+ (defvar jam-zcat-filename-list)
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el
index 42ff1ca2bd6..d9523172418 100644
--- a/lisp/obsolete/pgg-pgp5.el
+++ b/lisp/obsolete/pgg-pgp5.el
@@ -1,4 +1,4 @@
-;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+;;; pgg-pgp5.el --- PGP 5.* support for PGG. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
@@ -35,38 +35,31 @@
(defcustom pgg-pgp5-pgpe-program "pgpe"
"PGP 5.* `pgpe' executable."
- :group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgps-program "pgps"
"PGP 5.* `pgps' executable."
- :group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgpk-program "pgpk"
"PGP 5.* `pgpk' executable."
- :group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgpv-program "pgpv"
"PGP 5.* `pgpv' executable."
- :group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-shell-file-name "/bin/sh"
"File name to load inferior shells from.
Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
- :group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-shell-command-switch "-c"
"Switch used to have the shell execute its command line argument."
- :group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-extra-args nil
"Extra arguments for every PGP 5.* invocation."
- :group 'pgg-pgp5
:type '(choice
(const :tag "None" nil)
(string :tag "Arguments")))
@@ -128,7 +121,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(delete-file errors-file-name)
(file-error nil)))))
-(defun pgg-pgp5-lookup-key (string &optional type)
+(defun pgg-pgp5-lookup-key (string &optional _type)
"Search keys associated with STRING."
(let ((args (list "+language=en" "-l" string)))
(with-current-buffer (get-buffer-create pgg-output-buffer)
@@ -145,7 +138,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(defun pgg-pgp5-encrypt-region (start end recipients &optional sign passphrase)
"Encrypt the current region between START and END."
(let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
- (passphrase (or passphrase
+ (_passphrase (or passphrase
(when sign
(pgg-read-passphrase
(format "PGP passphrase for %s: "
@@ -209,6 +202,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(let ((orig-file (pgg-make-temp-file "pgg"))
(args '("+verbose=1" "+batchmode=1" "+language=us")))
(with-file-modes 448
+ (defvar jam-zcat-filename-list) ;Not sure where this comes from.
(let ((coding-system-for-write 'binary)
jka-compr-compression-info-list jam-zcat-filename-list)
(write-region start end orig-file)))
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index ec93eeb93f8..5ed59933f23 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -1,4 +1,4 @@
-;;; pgg.el --- glue for the various PGP implementations.
+;;; pgg.el --- glue for the various PGP implementations. -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2000, 2002-2021 Free Software Foundation, Inc.
@@ -27,99 +27,19 @@
(require 'pgg-def)
(require 'pgg-parse)
-(autoload 'run-at-time "timer")
(eval-when-compile (require 'cl-lib))
;;; @ utility functions
;;;
-(eval-when-compile
- (when (featurep 'xemacs)
- (defmacro pgg-run-at-time-1 (time repeat function args)
- (if (condition-case nil
- (let ((delete-itimer 'delete-itimer)
- (itimer-driver-start 'itimer-driver-start)
- (itimer-value 'itimer-value)
- (start-itimer 'start-itimer))
- (unless (or (symbol-value 'itimer-process)
- (symbol-value 'itimer-timer))
- (funcall itimer-driver-start))
- ;; Check whether there is a bug to which the difference of
- ;; the present time and the time when the itimer driver was
- ;; woken up is subtracted from the initial itimer value.
- (let* ((inhibit-quit t)
- (ctime (current-time))
- (itimer-timer-last-wakeup
- (prog1
- ctime
- (setcar ctime (1- (car ctime)))))
- (itimer-list nil)
- (itimer (funcall start-itimer "pgg-run-at-time"
- 'ignore 5)))
- (sleep-for 0.1) ;; Accept the timeout interrupt.
- (prog1
- (> (funcall itimer-value itimer) 0)
- (funcall delete-itimer itimer))))
- (error nil))
- `(let ((time ,time))
- (apply #'start-itimer "pgg-run-at-time"
- ,function (if time (max time 1e-9) 1e-9)
- ,repeat nil t ,args))
- `(let ((time ,time)
- (itimers (list nil)))
- (setcar
- itimers
- (apply #'start-itimer "pgg-run-at-time"
- (lambda (itimers repeat function &rest args)
- (let ((itimer (car itimers)))
- (if repeat
- (progn
- (set-itimer-function
- itimer
- (lambda (itimer repeat function &rest args)
- (set-itimer-restart itimer repeat)
- (set-itimer-function itimer function)
- (set-itimer-function-arguments itimer args)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer repeat function) args)))
- (set-itimer-function
- itimer
- (lambda (itimer function &rest args)
- (delete-itimer itimer)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer function) args)))))
- 1e-9 (if time (max time 1e-9) 1e-9)
- nil t itimers ,repeat ,function ,args)))))))
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (progn
- (defun pgg-run-at-time (time repeat function &rest args)
- "Emulating function run as `run-at-time'.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (pgg-run-at-time-1 time repeat function args))
- (defun pgg-cancel-timer (timer)
- "Emulate cancel-timer for xemacs."
- (let ((delete-itimer 'delete-itimer))
- (funcall delete-itimer timer))))
- (defalias 'pgg-run-at-time 'run-at-time)
- (defalias 'pgg-cancel-timer 'cancel-timer)))
-
(defun pgg-invoke (func scheme &rest args)
(progn
(require (intern (format "pgg-%s" scheme)))
- (apply 'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
-
-(put 'pgg-save-coding-system 'lisp-indent-function 2)
+ (apply #'funcall (intern (format "pgg-%s-%s" scheme func)) args)))
(defmacro pgg-save-coding-system (start end &rest body)
+ (declare (indent 2) (debug t))
`(if (called-interactively-p 'interactive)
(let ((buffer (current-buffer)))
(with-temp-buffer
@@ -209,23 +129,16 @@ regulate cache behavior."
(let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
(interned-timer-key (intern-soft key pgg-pending-timers))
(old-timer (symbol-value interned-timer-key))
- new-timer)
+ ) ;; new-timer
(when old-timer
(cancel-timer old-timer)
(unintern interned-timer-key pgg-pending-timers))
(set (intern key pgg-passphrase-cache)
passphrase)
(set (intern key pgg-pending-timers)
- (pgg-run-at-time pgg-passphrase-cache-expiry nil
- #'pgg-remove-passphrase-from-cache
- key notruncate))))
-
-(if (fboundp 'clear-string)
- (defalias 'pgg-clear-string 'clear-string)
- (defun pgg-clear-string (string)
- (fillarray string ?_)))
-
-(declare-function pgg-clear-string "pgg" (string))
+ (run-at-time pgg-passphrase-cache-expiry nil
+ #'pgg-remove-passphrase-from-cache
+ key notruncate))))
(defun pgg-remove-passphrase-from-cache (key &optional notruncate)
"Omit passphrase associated with KEY in time-limited passphrase cache.
@@ -245,10 +158,10 @@ regulate cache behavior."
(interned-timer-key (intern-soft key pgg-pending-timers))
(old-timer (symbol-value interned-timer-key)))
(when passphrase
- (pgg-clear-string passphrase)
+ (clear-string passphrase)
(unintern key pgg-passphrase-cache))
(when old-timer
- (pgg-cancel-timer old-timer)
+ (cancel-timer old-timer)
(unintern interned-timer-key pgg-pending-timers))))
(defmacro pgg-convert-lbt-region (start end lbt)
@@ -265,9 +178,8 @@ regulate cache behavior."
(while (re-search-forward "\r$" pgg-conversion-end t)
(replace-match ""))))))
-(put 'pgg-as-lbt 'lisp-indent-function 3)
-
(defmacro pgg-as-lbt (start end lbt &rest body)
+ (declare (indent 3) (debug t))
`(let ((inhibit-read-only t)
buffer-read-only
buffer-undo-list)
@@ -277,9 +189,8 @@ regulate cache behavior."
(push nil buffer-undo-list)
(ignore-errors (undo))))
-(put 'pgg-process-when-success 'lisp-indent-function 0)
-
(defmacro pgg-process-when-success (&rest body)
+ (declare (indent 0) (debug t))
`(with-current-buffer pgg-output-buffer
(if (zerop (buffer-size)) nil ,@body t)))
@@ -377,7 +288,7 @@ passphrase cache or user."
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(interactive "r")
- (let* ((buf (current-buffer))
+ (let* (;; (buf (current-buffer))
(status
(pgg-save-coding-system start end
(pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme)
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index 29931d9bda4..d7020f0d074 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -1,4 +1,4 @@
-;;; rcompile.el --- run a compilation on a remote machine
+;;; rcompile.el --- run a compilation on a remote machine -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -76,14 +76,12 @@
(defcustom remote-compile-host nil
"Host for remote compilations."
- :type '(choice string (const nil))
- :group 'remote-compile)
+ :type '(choice string (const nil)))
(defcustom remote-compile-user nil
"User for remote compilations.
nil means use the value returned by \\[user-login-name]."
- :type '(choice string (const nil))
- :group 'remote-compile)
+ :type '(choice string (const nil)))
(defcustom remote-compile-run-before nil
"Command to run before compilation.
@@ -91,18 +89,15 @@ This can be used for setting up environment variables,
since rsh does not invoke the shell as a login shell and files like .login
\(tcsh) and .bash_profile \(bash) are not run.
nil means run no commands."
- :type '(choice string (const nil))
- :group 'remote-compile)
+ :type '(choice string (const nil)))
(defcustom remote-compile-prompt-for-host nil
"Non-nil means prompt for host if not available from filename."
- :type 'boolean
- :group 'remote-compile)
+ :type 'boolean)
(defcustom remote-compile-prompt-for-user nil
"Non-nil means prompt for user if not available from filename."
- :type 'boolean
- :group 'remote-compile)
+ :type 'boolean)
;;;; internal variables
@@ -123,7 +118,7 @@ nil means run no commands."
"Compile the current buffer's directory on HOST. Log in as USER.
See \\[compile]."
(interactive
- (let (host user command prompt l l-host l-user)
+ (let (host user command prompt) ;; l l-host l-user
(setq prompt (if (stringp remote-compile-host)
(format "Compile on host (default %s): "
remote-compile-host)
@@ -153,7 +148,7 @@ See \\[compile]."
(setq remote-compile-user user))
((null remote-compile-user)
(setq remote-compile-user (user-login-name))))
- (let* (localname ;; Pacify byte-compiler.
+ (let* (;; localname ;; Pacify byte-compiler.
(compile-command
(format "%s %s -l %s \"(%scd %s; %s)\""
remote-shell-program
diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el
index bcb5279d115..4d4c39e9b11 100644
--- a/lisp/obsolete/s-region.el
+++ b/lisp/obsolete/s-region.el
@@ -1,4 +1,4 @@
-;;; s-region.el --- set region using shift key
+;;; s-region.el --- set region using shift key -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
@@ -112,11 +112,11 @@ to global keymap."
[M-next] [M-previous] [M-home] [M-end]))
(or (global-key-binding [C-insert])
- (global-set-key [C-insert] 'copy-region-as-kill))
+ (global-set-key [C-insert] #'copy-region-as-kill))
(or (global-key-binding [S-delete])
- (global-set-key [S-delete] 'kill-region))
+ (global-set-key [S-delete] #'kill-region))
(or (global-key-binding [S-insert])
- (global-set-key [S-insert] 'yank))
+ (global-set-key [S-insert] #'yank))
(provide 's-region)
diff --git a/lisp/obsolete/sb-image.el b/lisp/obsolete/sb-image.el
index 53ecfb7f268..fc9e03eae6e 100644
--- a/lisp/obsolete/sb-image.el
+++ b/lisp/obsolete/sb-image.el
@@ -1,4 +1,4 @@
-;;; sb-image --- Image management for speedbar
+;;; sb-image.el --- Image management for speedbar -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2003, 2005-2019, 2021 Free Software Foundation,
;; Inc.
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
index ac5f62dd67e..371dcbf8498 100644
--- a/lisp/obsolete/sregex.el
+++ b/lisp/obsolete/sregex.el
@@ -1,4 +1,4 @@
-;;; sregex.el --- symbolic regular expressions
+;;; sregex.el --- symbolic regular expressions -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1998, 2000-2021 Free Software Foundation, Inc.
@@ -208,7 +208,7 @@
;; This is a "trapdoor" for including ordinary regular expression
;; strings in the result. Some regular expressions are clearer when
;; written the old way: "[a-z]" vs. (sregexq (char (?a . ?z))), for
-;; instance. However, see the note under "Bugs," below.
+;; instance.
;; Each CHAR-CLAUSE that is passed to (char ...) and (not-char ...)
;; has one of the following forms:
@@ -236,8 +236,6 @@
;; - add support for non-greedy operators *? and +?
;; - bug: (sregexq (opt (opt ?a))) returns "a??" which is a non-greedy "a?"
-;;; Bugs:
-
;;; Code:
(eval-when-compile (require 'cl-lib))
@@ -246,15 +244,15 @@
(defvar sregex--current-sregex nil)
(defun sregex-info () nil)
(defmacro sregex-save-match-data (&rest forms) (cons 'save-match-data forms))
-(defun sregex-replace-match (r &optional f l str subexp x)
+(defun sregex-replace-match (r &optional f l str subexp _x)
(replace-match r f l str subexp))
-(defun sregex-match-string (c &optional i x) (match-string c i))
-(defun sregex-match-string-no-properties (count &optional in-string sregex)
+(defun sregex-match-string (c &optional i _x) (match-string c i))
+(defun sregex-match-string-no-properties (count &optional in-string _sregex)
(match-string-no-properties count in-string))
-(defun sregex-match-beginning (count &optional sregex) (match-beginning count))
-(defun sregex-match-end (count &optional sregex) (match-end count))
-(defun sregex-match-data (&optional sregex) (match-data))
-(defun sregex-backref-num (n &optional sregex) n)
+(defun sregex-match-beginning (count &optional _sregex) (match-beginning count))
+(defun sregex-match-end (count &optional _sregex) (match-end count))
+(defun sregex-match-data (&optional _sregex) (match-data))
+(defun sregex-backref-num (n &optional _sregex) n)
(defun sregex (&rest exps)
@@ -525,23 +523,23 @@ has one of the following forms:
(concat "\\(?:" re "\\)")
re))))
-(defun sregex--group (exps combine) (concat "\\(" (sregex--sequence exps nil) "\\)"))
+(defun sregex--group (exps _combine) (concat "\\(" (sregex--sequence exps nil) "\\)"))
-(defun sregex--backref (exps combine) (concat "\\" (int-to-string (car exps))))
-(defun sregex--opt (exps combine) (concat (sregex--sequence exps 'suffix) "?"))
-(defun sregex--0+ (exps combine) (concat (sregex--sequence exps 'suffix) "*"))
-(defun sregex--1+ (exps combine) (concat (sregex--sequence exps 'suffix) "+"))
+(defun sregex--backref (exps _combine) (concat "\\" (int-to-string (car exps))))
+(defun sregex--opt (exps _combine) (concat (sregex--sequence exps 'suffix) "?"))
+(defun sregex--0+ (exps _combine) (concat (sregex--sequence exps 'suffix) "*"))
+(defun sregex--1+ (exps _combine) (concat (sregex--sequence exps 'suffix) "+"))
-(defun sregex--char (exps combine) (sregex--char-aux nil exps))
-(defun sregex--not-char (exps combine) (sregex--char-aux t exps))
+(defun sregex--char (exps _combine) (sregex--char-aux nil exps))
+(defun sregex--not-char (exps _combine) (sregex--char-aux t exps))
-(defun sregex--syntax (exps combine) (format "\\s%c" (car exps)))
-(defun sregex--not-syntax (exps combine) (format "\\S%c" (car exps)))
+(defun sregex--syntax (exps _combine) (format "\\s%c" (car exps)))
+(defun sregex--not-syntax (exps _combine) (format "\\S%c" (car exps)))
(defun sregex--regex (exps combine)
(if combine (concat "\\(?:" (car exps) "\\)") (car exps)))
-(defun sregex--repeat (exps combine)
+(defun sregex--repeat (exps _combine)
(let* ((min (or (pop exps) 0))
(minstr (number-to-string min))
(max (pop exps)))
diff --git a/lisp/obsolete/starttls.el b/lisp/obsolete/starttls.el
index 451c7eb2ffc..926248db9af 100644
--- a/lisp/obsolete/starttls.el
+++ b/lisp/obsolete/starttls.el
@@ -1,4 +1,4 @@
-;;; starttls.el --- STARTTLS functions
+;;; starttls.el --- STARTTLS functions -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -126,28 +126,24 @@
This program is used when GnuTLS is used, i.e. when
`starttls-use-gnutls' is non-nil."
:version "22.1"
- :type 'string
- :group 'starttls)
+ :type 'string)
(defcustom starttls-program "starttls"
"The program to run in a subprocess to open an TLSv1 connection.
This program is used when the `starttls' command is used,
i.e. when `starttls-use-gnutls' is nil."
- :type 'string
- :group 'starttls)
+ :type 'string)
(defcustom starttls-use-gnutls (not (executable-find starttls-program))
"Whether to use GnuTLS instead of the `starttls' command."
:version "22.1"
- :type 'boolean
- :group 'starttls)
+ :type 'boolean)
(defcustom starttls-extra-args nil
"Extra arguments to `starttls-program'.
These apply when the `starttls' command is used, i.e. when
`starttls-use-gnutls' is nil."
- :type '(repeat string)
- :group 'starttls)
+ :type '(repeat string))
(defcustom starttls-extra-arguments nil
"Extra arguments to `starttls-gnutls-program'.
@@ -157,14 +153,12 @@ For example, non-TLS compliant servers may require
\(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to
find out which parameters are available."
:version "22.1"
- :type '(repeat string)
- :group 'starttls)
+ :type '(repeat string))
(defcustom starttls-process-connection-type nil
"Value for `process-connection-type' to use when starting STARTTLS process."
:version "22.1"
- :type 'boolean
- :group 'starttls)
+ :type 'boolean)
(defcustom starttls-connect "- Simple Client Mode:\n\n"
"Regular expression indicating successful connection.
@@ -173,8 +167,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs."
;; in the application read/write phase. If the logic, or the string
;; itself, is modified, this must be updated.
:version "22.1"
- :type 'regexp
- :group 'starttls)
+ :type 'regexp)
(defcustom starttls-failure "\\*\\*\\* Handshake has failed"
"Regular expression indicating failed TLS handshake.
@@ -182,8 +175,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs."
;; GnuTLS cli.c:do_handshake() prints this string on failure. If the
;; logic, or the string itself, is modified, this must be updated.
:version "22.1"
- :type 'regexp
- :group 'starttls)
+ :type 'regexp)
(defcustom starttls-success "- Compression: "
"Regular expression indicating completed TLS handshakes.
@@ -193,8 +185,7 @@ The default is what GnuTLS's \"gnutls-cli\" outputs."
;; last. If that logic, or the string itself, is modified, this
;; must be updated.
:version "22.1"
- :type 'regexp
- :group 'starttls)
+ :type 'regexp)
(defun starttls-negotiate-gnutls (process)
"Negotiate TLS on PROCESS opened by `open-starttls-stream'.
@@ -296,9 +287,8 @@ GnuTLS requires a port number."
starttls-gnutls-program
starttls-program))))
-(defalias 'starttls-any-program-available 'starttls-available-p)
-(make-obsolete 'starttls-any-program-available 'starttls-available-p
- "2011-08-02")
+(define-obsolete-function-alias 'starttls-any-program-available
+ #'starttls-available-p "24.1")
(provide 'starttls)
diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el
index f3db27f567e..4e312e968b3 100644
--- a/lisp/obsolete/sup-mouse.el
+++ b/lisp/obsolete/sup-mouse.el
@@ -1,4 +1,4 @@
-;;; sup-mouse.el --- supdup mouse support for lisp machines
+;;; sup-mouse.el --- supdup mouse support for lisp machines -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index bde656dfa6a..0167a00066b 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -1,4 +1,4 @@
-;;; terminal.el --- terminal emulator for GNU Emacs
+;;; terminal.el --- terminal emulator for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986-1989, 1993-1994, 2001-2021 Free Software
;; Foundation, Inc.
@@ -32,7 +32,7 @@
;; For information on US government censorship of the Internet, and
;; what you can do to bring back freedom of the press, see the web
-;; site http://www.vtw.org/
+;; site https://www.eff.org/ [used to be vtw.org but that link is dead]
;;; Code:
@@ -58,22 +58,19 @@ to the emulator program itself. Type this character twice to send
it through the emulator. Type ? after typing it for a list of
possible commands.
This variable is local to each terminal-emulator buffer."
- :type 'character
- :group 'terminal)
+ :type 'character)
(defcustom terminal-scrolling t ;;>> Setting this to t sort-of defeats my whole aim in writing this package...
"If non-nil, the terminal-emulator will losingly `scroll' when output occurs
past the bottom of the screen. If nil, output will win and `wrap' to the top
of the screen.
This variable is local to each terminal-emulator buffer."
- :type 'boolean
- :group 'terminal)
+ :type 'boolean)
(defcustom terminal-more-processing t
"If non-nil, do more-processing.
This variable is local to each terminal-emulator buffer."
- :type 'boolean
- :group 'terminal)
+ :type 'boolean)
;; If you are the sort of loser who uses scrolling without more breaks
;; and expects to actually see anything, you should probably set this to
@@ -84,8 +81,7 @@ terminal-emulator before a screen redisplay is forced.
Set this to a large value for greater throughput,
set it smaller for more frequent updates but overall slower
performance."
- :type 'integer
- :group 'terminal)
+ :type 'integer)
(defvar terminal-more-break-insertion
"*** More break -- Press space to continue ***")
@@ -94,7 +90,7 @@ performance."
(if terminal-meta-map
nil
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'te-pass-through)
+ (define-key map [t] #'te-pass-through)
(setq terminal-meta-map map)))
(defvar terminal-map nil)
@@ -104,8 +100,8 @@ performance."
;; Prevent defining [menu-bar] as te-pass-through
;; so we allow the global menu bar to be visible.
(define-key map [menu-bar] (make-sparse-keymap))
- (define-key map [t] 'te-pass-through)
- (define-key map [switch-frame] 'handle-switch-frame)
+ (define-key map [t] #'te-pass-through)
+ (define-key map [switch-frame] #'handle-switch-frame)
(define-key map "\e" terminal-meta-map)
;;(define-key map "\C-l"
;; (lambda () (interactive) (te-pass-through) (redraw-display)))
@@ -115,22 +111,22 @@ performance."
(if terminal-escape-map
nil
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'undefined)
+ (define-key map [t] #'undefined)
(let ((s "0"))
(while (<= (aref s 0) ?9)
- (define-key map s 'digit-argument)
+ (define-key map s #'digit-argument)
(aset s 0 (1+ (aref s 0)))))
- (define-key map "b" 'switch-to-buffer)
- (define-key map "o" 'other-window)
- (define-key map "e" 'te-set-escape-char)
- (define-key map "\C-l" 'redraw-display)
- (define-key map "\C-o" 'te-flush-pending-output)
- (define-key map "m" 'te-toggle-more-processing)
- (define-key map "x" 'te-escape-extended-command)
+ (define-key map "b" #'switch-to-buffer)
+ (define-key map "o" #'other-window)
+ (define-key map "e" #'te-set-escape-char)
+ (define-key map "\C-l" #'redraw-display)
+ (define-key map "\C-o" #'te-flush-pending-output)
+ (define-key map "m" #'te-toggle-more-processing)
+ (define-key map "x" #'te-escape-extended-command)
;;>> What use is this? Why is it in the default terminal-emulator map?
- (define-key map "w" 'te-edit)
- (define-key map "?" 'te-escape-help)
- (define-key map (char-to-string help-char) 'te-escape-help)
+ (define-key map "w" #'te-edit)
+ (define-key map "?" #'te-escape-help)
+ (define-key map (char-to-string help-char) #'te-escape-help)
(setq terminal-escape-map map)))
(defvar te-escape-command-alist nil)
@@ -161,14 +157,14 @@ performance."
(if terminal-more-break-map
nil
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'te-more-break-unread)
- (define-key map (char-to-string help-char) 'te-more-break-help)
- (define-key map " " 'te-more-break-resume)
- (define-key map "\C-l" 'redraw-display)
- (define-key map "\C-o" 'te-more-break-flush-pending-output)
+ (define-key map [t] #'te-more-break-unread)
+ (define-key map (char-to-string help-char) #'te-more-break-help)
+ (define-key map " " #'te-more-break-resume)
+ (define-key map "\C-l" #'redraw-display)
+ (define-key map "\C-o" #'te-more-break-flush-pending-output)
;;>>> this isn't right
- ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL
- (define-key map "\r" 'te-more-break-advance-one-line)
+ ;(define-key map "\^?" #'te-more-break-flush-pending-output) ;DEL
+ (define-key map "\r" #'te-more-break-advance-one-line)
(setq terminal-more-break-map map)))
@@ -525,7 +521,7 @@ lets you type a terminal emulator command."
(if terminal-edit-map
nil
(setq terminal-edit-map (make-sparse-keymap))
- (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit))
+ (define-key terminal-edit-map "\C-c\C-c" #'terminal-cease-edit))
;; Terminal Edit mode is suitable only for specially formatted data.
(put 'terminal-edit-mode 'mode-class 'special)
@@ -1140,10 +1136,10 @@ subprocess started."
;; Then finally start the program we wanted.
(format "%s; exec %s"
te-stty-string
- (mapconcat 'te-quote-arg-for-sh
+ (mapconcat #'te-quote-arg-for-sh
(cons program args) " "))))
- (set-process-filter te-process 'te-filter)
- (set-process-sentinel te-process 'te-sentinel))
+ (set-process-filter te-process #'te-filter)
+ (set-process-sentinel te-process #'te-sentinel))
(error (fundamental-mode)
(signal (car err) (cdr err))))
(setq inhibit-quit t) ;sport death
@@ -1151,8 +1147,8 @@ subprocess started."
(run-hooks 'terminal-mode-hook)
(message "Entering Emacs terminal-emulator... Type %s %s for help"
(single-key-description terminal-escape-char)
- (mapconcat 'single-key-description
- (where-is-internal 'te-escape-help terminal-escape-map t)
+ (mapconcat #'single-key-description
+ (where-is-internal #'te-escape-help terminal-escape-map t)
" ")))
@@ -1226,7 +1222,7 @@ of the terminal-emulator"
(cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
string)
string)
- ((not (string-match "[$]" string))
+ ((not (string-search "$" string))
;; "[\"\\]" are special to sh and the lisp reader in the same way
(prin1-to-string string))
(t
@@ -1292,7 +1288,7 @@ in the directory specified by `te-terminfo-directory'."
(directory-file-name te-terminfo-directory))
process-environment)))
(set-process-sentinel (start-process "tic" nil "tic" file-name)
- 'te-tic-sentinel))))
+ #'te-tic-sentinel))))
(directory-file-name te-terminfo-directory))
(defun te-create-termcap ()
diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el
index 67a497f9412..5cba18d7897 100644
--- a/lisp/obsolete/tls.el
+++ b/lisp/obsolete/tls.el
@@ -1,4 +1,4 @@
-;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
+;;; tls.el --- TLS/SSL support via wrapper around GnuTLS -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2002-2021 Free Software Foundation, Inc.
@@ -70,8 +70,7 @@
Client data stream begins after the last character this matches.
The default matches the output of \"gnutls-cli\" (version 2.0.1)."
:version "22.2"
- :type 'regexp
- :group 'tls)
+ :type 'regexp)
(defcustom tls-program
'("gnutls-cli --x509cafile %t -p %p %h"
@@ -104,22 +103,19 @@ successful negotiation."
(repeat :inline t :tag "Other" (string)))
(list :tag "List of commands"
(repeat :tag "Command" (string))))
- :version "26.1" ; remove s_client
- :group 'tls)
+ :version "26.1")
(defcustom tls-process-connection-type nil
"Value for `process-connection-type' to use when starting TLS process."
:version "22.1"
- :type 'boolean
- :group 'tls)
+ :type 'boolean)
(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
"Regular expression indicating completed TLS handshakes.
The default is what GnuTLS's \"gnutls-cli\" outputs."
;; or OpenSSL's \"openssl s_client\"
:version "22.1"
- :type 'regexp
- :group 'tls)
+ :type 'regexp)
(defcustom tls-checktrust nil
"Indicate if certificates should be checked against trusted root certs.
@@ -137,8 +133,7 @@ consider trustworthy, e.g.:
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask))
- :version "23.1" ;; No Gnus
- :group 'tls)
+ :version "23.1")
(defcustom tls-untrusted
"- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)"
@@ -147,8 +142,7 @@ The default is what GnuTLS's \"gnutls-cli\" returns in the event of
unsuccessful verification."
;; or OpenSSL's \"openssl s_client\"
:type 'regexp
- :version "23.1" ;; No Gnus
- :group 'tls)
+ :version "23.1")
(defcustom tls-hostmismatch
"# The hostname in the certificate does NOT match"
@@ -158,20 +152,13 @@ name of the host you are connecting to, gnutls-cli issues a
warning to this effect. There is no such feature in openssl. Set
this to nil if you want to ignore host name mismatches."
:type 'regexp
- :version "23.1" ;; No Gnus
- :group 'tls)
+ :version "23.1")
(defcustom tls-certtool-program "certtool"
"Name of GnuTLS certtool.
Used by `tls-certificate-information'."
:version "22.1"
- :type 'string
- :group 'tls)
-
-(defalias 'tls-format-message
- (if (fboundp 'format-message) 'format-message
- ;; for Emacs < 25, and XEmacs, don't worry about quote translation.
- 'format))
+ :type 'string)
(defun tls-certificate-information (der)
"Parse X.509 certificate in DER format into an assoc list."
@@ -272,7 +259,7 @@ Fourth arg PORT is an integer specifying a port to connect to."
(message "The certificate presented by `%s' is \
NOT trusted." host))
(not (yes-or-no-p
- (tls-format-message "\
+ (format-message "\
The certificate presented by `%s' is NOT trusted. Accept anyway? " host)))))
(and tls-hostmismatch
(save-excursion
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index 78d88cf3774..e0e89c390ea 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -1,4 +1,4 @@
-;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
+;;; tpu-edt.el --- Emacs emulating TPU emulating EDT -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
@@ -289,18 +289,15 @@
;;;
(defcustom tpu-kill-buffers-silently nil
"If non-nil, TPU-edt kills modified buffers without asking."
- :type 'boolean
- :group 'tpu)
+ :type 'boolean)
(defcustom tpu-percent-scroll 75
"Percentage of the screen to scroll for next/previous screen commands."
- :type 'integer
- :group 'tpu)
+ :type 'integer)
(defcustom tpu-pan-columns 16
"Number of columns the tpu-pan functions scroll left or right."
- :type 'integer
- :group 'tpu)
+ :type 'integer)
;;;
@@ -313,17 +310,17 @@
;; that term/*.el does its job to map the escape sequence to the right
;; key-symbol.
- (define-key map [up] 'tpu-move-to-beginning) ; up-arrow
- (define-key map [down] 'tpu-move-to-end) ; down-arrow
- (define-key map [right] 'end-of-line) ; right-arrow
- (define-key map [left] 'beginning-of-line) ; left-arrow
+ (define-key map [up] #'tpu-move-to-beginning) ; up-arrow
+ (define-key map [down] #'tpu-move-to-end) ; down-arrow
+ (define-key map [right] #'end-of-line) ; right-arrow
+ (define-key map [left] #'beginning-of-line) ; left-arrow
;; (define-key map [find] nil) ; Find
;; (define-key map [insert] nil) ; Insert Here
- (define-key map [delete] 'tpu-store-text) ; Remove
- (define-key map [select] 'tpu-unselect) ; Select
- (define-key map [prior] 'tpu-previous-window) ; Prev Screen
- (define-key map [next] 'tpu-next-window) ; Next Screen
+ (define-key map [delete] #'tpu-store-text) ; Remove
+ (define-key map [select] #'tpu-unselect) ; Select
+ (define-key map [prior] #'tpu-previous-window) ; Prev Screen
+ (define-key map [next] #'tpu-next-window) ; Next Screen
;; (define-key map [f1] nil) ; F1
;; (define-key map [f2] nil) ; F2
@@ -339,45 +336,45 @@
;; (define-key map [f12] nil) ; F12
;; (define-key map [f13] nil) ; F13
;; (define-key map [f14] nil) ; F14
- (define-key map [help] 'describe-bindings) ; HELP
+ (define-key map [help] #'describe-bindings) ; HELP
;; (define-key map [menu] nil) ; DO
- (define-key map [f17] 'tpu-drop-breadcrumb) ; F17
+ (define-key map [f17] #'tpu-drop-breadcrumb) ; F17
;; (define-key map [f18] nil) ; F18
;; (define-key map [f19] nil) ; F19
;; (define-key map [f20] nil) ; F20
- (define-key map [kp-f1] 'keyboard-quit) ; PF1
- (define-key map [kp-f2] 'help-for-help) ; PF2
- (define-key map [kp-f3] 'tpu-search) ; PF3
- (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4
- (define-key map [kp-0] 'open-line) ; KP0
- (define-key map [kp-1] 'tpu-change-case) ; KP1
- (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2
- (define-key map [kp-3] 'tpu-special-insert) ; KP3
- (define-key map [kp-4] 'tpu-move-to-end) ; KP4
- (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5
- (define-key map [kp-6] 'tpu-paste) ; KP6
- (define-key map [kp-7] 'execute-extended-command) ; KP7
- (define-key map [kp-8] 'tpu-fill) ; KP8
- (define-key map [kp-9] 'tpu-replace) ; KP9
- (define-key map [kp-subtract] 'tpu-undelete-words) ; KP-
- (define-key map [kp-separator] 'tpu-undelete-char) ; KP,
- (define-key map [kp-decimal] 'tpu-unselect) ; KP.
- (define-key map [kp-enter] 'tpu-substitute) ; KPenter
+ (define-key map [kp-f1] #'keyboard-quit) ; PF1
+ (define-key map [kp-f2] #'help-for-help) ; PF2
+ (define-key map [kp-f3] #'tpu-search) ; PF3
+ (define-key map [kp-f4] #'tpu-undelete-lines) ; PF4
+ (define-key map [kp-0] #'open-line) ; KP0
+ (define-key map [kp-1] #'tpu-change-case) ; KP1
+ (define-key map [kp-2] #'tpu-delete-to-eol) ; KP2
+ (define-key map [kp-3] #'tpu-special-insert) ; KP3
+ (define-key map [kp-4] #'tpu-move-to-end) ; KP4
+ (define-key map [kp-5] #'tpu-move-to-beginning) ; KP5
+ (define-key map [kp-6] #'tpu-paste) ; KP6
+ (define-key map [kp-7] #'execute-extended-command) ; KP7
+ (define-key map [kp-8] #'tpu-fill) ; KP8
+ (define-key map [kp-9] #'tpu-replace) ; KP9
+ (define-key map [kp-subtract] #'tpu-undelete-words) ; KP-
+ (define-key map [kp-separator] #'tpu-undelete-char) ; KP,
+ (define-key map [kp-decimal] #'tpu-unselect) ; KP.
+ (define-key map [kp-enter] #'tpu-substitute) ; KPenter
;;
- (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A
+ (define-key map "\C-A" #'tpu-toggle-overwrite-mode) ; ^A
;; (define-key map "\C-B" nil) ; ^B
;; (define-key map "\C-C" nil) ; ^C
;; (define-key map "\C-D" nil) ; ^D
;; (define-key map "\C-E" nil) ; ^E
- (define-key map "\C-F" 'set-visited-file-name) ; ^F
- (define-key map "\C-g" 'keyboard-quit) ; safety first
- (define-key map "\C-h" 'delete-other-windows) ; BS
- (define-key map "\C-i" 'other-window) ; TAB
+ (define-key map "\C-F" #'set-visited-file-name) ; ^F
+ (define-key map "\C-g" #'keyboard-quit) ; safety first
+ (define-key map "\C-h" #'delete-other-windows) ; BS
+ (define-key map "\C-i" #'other-window) ; TAB
;; (define-key map "\C-J" nil) ; ^J
- (define-key map "\C-K" 'tpu-define-macro-key) ; ^K
- (define-key map "\C-l" 'downcase-region) ; ^L
+ (define-key map "\C-K" #'tpu-define-macro-key) ; ^K
+ (define-key map "\C-l" #'downcase-region) ; ^L
;; (define-key map "\C-M" nil) ; ^M
;; (define-key map "\C-N" nil) ; ^N
;; (define-key map "\C-O" nil) ; ^O
@@ -385,104 +382,104 @@
;; (define-key map "\C-Q" nil) ; ^Q
;; (define-key map "\C-R" nil) ; ^R
;; (define-key map "\C-S" nil) ; ^S
- (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T
- (define-key map "\C-u" 'upcase-region) ; ^U
+ (define-key map "\C-T" #'tpu-toggle-control-keys) ; ^T
+ (define-key map "\C-u" #'upcase-region) ; ^U
;; (define-key map "\C-V" nil) ; ^V
- (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W
+ (define-key map "\C-w" #'tpu-write-current-buffers) ; ^W
;; (define-key map "\C-X" nil) ; ^X
;; (define-key map "\C-Y" nil) ; ^Y
;; (define-key map "\C-Z" nil) ; ^Z
- (define-key map " " 'undo) ; SPC
+ (define-key map " " #'undo) ; SPC
;; (define-key map "!" nil) ; !
;; (define-key map "#" nil) ; #
- (define-key map "$" 'tpu-add-at-eol) ; $
- (define-key map "%" 'tpu-goto-percent) ; %
+ (define-key map "$" #'tpu-add-at-eol) ; $
+ (define-key map "%" #'tpu-goto-percent) ; %
;; (define-key map "&" nil) ; &
;; (define-key map "(" nil) ; (
;; (define-key map ")" nil) ; )
- (define-key map "*" 'tpu-toggle-regexp) ; *
+ (define-key map "*" #'tpu-toggle-regexp) ; *
;; (define-key map "+" nil) ; +
- (define-key map "," 'tpu-goto-breadcrumb) ; ,
- (define-key map "-" 'negative-argument) ; -
- (define-key map "." 'tpu-drop-breadcrumb) ; .
- (define-key map "/" 'tpu-emacs-replace) ; /
- (define-key map "0" 'digit-argument) ; 0
- (define-key map "1" 'digit-argument) ; 1
- (define-key map "2" 'digit-argument) ; 2
- (define-key map "3" 'digit-argument) ; 3
- (define-key map "4" 'digit-argument) ; 4
- (define-key map "5" 'digit-argument) ; 5
- (define-key map "6" 'digit-argument) ; 6
- (define-key map "7" 'digit-argument) ; 7
- (define-key map "8" 'digit-argument) ; 8
- (define-key map "9" 'digit-argument) ; 9
+ (define-key map "," #'tpu-goto-breadcrumb) ; ,
+ (define-key map "-" #'negative-argument) ; -
+ (define-key map "." #'tpu-drop-breadcrumb) ; .
+ (define-key map "/" #'tpu-emacs-replace) ; /
+ (define-key map "0" #'digit-argument) ; 0
+ (define-key map "1" #'digit-argument) ; 1
+ (define-key map "2" #'digit-argument) ; 2
+ (define-key map "3" #'digit-argument) ; 3
+ (define-key map "4" #'digit-argument) ; 4
+ (define-key map "5" #'digit-argument) ; 5
+ (define-key map "6" #'digit-argument) ; 6
+ (define-key map "7" #'digit-argument) ; 7
+ (define-key map "8" #'digit-argument) ; 8
+ (define-key map "9" #'digit-argument) ; 9
;; (define-key map ":" nil) ; :
- (define-key map ";" 'tpu-trim-line-ends) ; ;
+ (define-key map ";" #'tpu-trim-line-ends) ; ;
;; (define-key map "<" nil) ; <
;; (define-key map "=" nil) ; =
;; (define-key map ">" nil) ; >
- (define-key map "?" 'tpu-spell-check) ; ?
- ;; (define-key map "A" 'tpu-toggle-newline-and-indent) ; A
- ;; (define-key map "B" 'tpu-next-buffer) ; B
- ;; (define-key map "C" 'repeat-complex-command) ; C
- ;; (define-key map "D" 'shell-command) ; D
- ;; (define-key map "E" 'tpu-exit) ; E
- ;; (define-key map "F" 'tpu-cursor-free-mode) ; F
- ;; (define-key map "G" 'tpu-get) ; G
+ (define-key map "?" #'tpu-spell-check) ; ?
+ ;; (define-key map "A" #'tpu-toggle-newline-and-indent) ; A
+ ;; (define-key map "B" #'tpu-next-buffer) ; B
+ ;; (define-key map "C" #'repeat-complex-command) ; C
+ ;; (define-key map "D" #'shell-command) ; D
+ ;; (define-key map "E" #'tpu-exit) ; E
+ ;; (define-key map "F" #'tpu-cursor-free-mode) ; F
+ ;; (define-key map "G" #'tpu-get) ; G
;; (define-key map "H" nil) ; H
- ;; (define-key map "I" 'tpu-include) ; I
- ;; (define-key map "K" 'tpu-kill-buffer) ; K
- (define-key map "L" 'tpu-what-line) ; L
- ;; (define-key map "M" 'buffer-menu) ; M
- ;; (define-key map "N" 'tpu-next-file-buffer) ; N
- ;; (define-key map "O" 'occur) ; O
- (define-key map "P" 'lpr-buffer) ; P
- ;; (define-key map "Q" 'tpu-quit) ; Q
- ;; (define-key map "R" 'tpu-toggle-rectangle) ; R
- ;; (define-key map "S" 'replace) ; S
- ;; (define-key map "T" 'tpu-line-to-top-of-window) ; T
- ;; (define-key map "U" 'undo) ; U
- ;; (define-key map "V" 'tpu-version) ; V
- ;; (define-key map "W" 'save-buffer) ; W
- ;; (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X
- ;; (define-key map "Y" 'copy-region-as-kill) ; Y
- ;; (define-key map "Z" 'suspend-emacs) ; Z
- (define-key map "[" 'blink-matching-open) ; [
+ ;; (define-key map "I" #'tpu-include) ; I
+ ;; (define-key map "K" #'tpu-kill-buffer) ; K
+ (define-key map "L" #'tpu-what-line) ; L
+ ;; (define-key map "M" #'buffer-menu) ; M
+ ;; (define-key map "N" #'tpu-next-file-buffer) ; N
+ ;; (define-key map "O" #'occur) ; O
+ (define-key map "P" #'lpr-buffer) ; P
+ ;; (define-key map "Q" #'tpu-quit) ; Q
+ ;; (define-key map "R" #'tpu-toggle-rectangle) ; R
+ ;; (define-key map "S" #'replace) ; S
+ ;; (define-key map "T" #'tpu-line-to-top-of-window) ; T
+ ;; (define-key map "U" #'undo) ; U
+ ;; (define-key map "V" #'tpu-version) ; V
+ ;; (define-key map "W" #'save-buffer) ; W
+ ;; (define-key map "X" #'tpu-save-all-buffers-kill-emacs) ; X
+ ;; (define-key map "Y" #'copy-region-as-kill) ; Y
+ ;; (define-key map "Z" #'suspend-emacs) ; Z
+ (define-key map "[" #'blink-matching-open) ; [
;; (define-key map "\\" nil) ; \
- (define-key map "]" 'blink-matching-open) ; ]
- (define-key map "^" 'tpu-add-at-bol) ; ^
- (define-key map "_" 'split-window-below) ; -
- (define-key map "`" 'what-line) ; `
- (define-key map "a" 'tpu-toggle-newline-and-indent) ; a
- (define-key map "b" 'tpu-next-buffer) ; b
- (define-key map "c" 'repeat-complex-command) ; c
- (define-key map "d" 'shell-command) ; d
- (define-key map "e" 'tpu-exit) ; e
- (define-key map "f" 'tpu-cursor-free-mode) ; f
- (define-key map "g" 'tpu-get) ; g
+ (define-key map "]" #'blink-matching-open) ; ]
+ (define-key map "^" #'tpu-add-at-bol) ; ^
+ (define-key map "_" #'split-window-below) ; -
+ (define-key map "`" #'what-line) ; `
+ (define-key map "a" #'tpu-toggle-newline-and-indent) ; a
+ (define-key map "b" #'tpu-next-buffer) ; b
+ (define-key map "c" #'repeat-complex-command) ; c
+ (define-key map "d" #'shell-command) ; d
+ (define-key map "e" #'tpu-exit) ; e
+ (define-key map "f" #'tpu-cursor-free-mode) ; f
+ (define-key map "g" #'tpu-get) ; g
;; (define-key map "h" nil) ; h
- (define-key map "i" 'tpu-include) ; i
- (define-key map "k" 'tpu-kill-buffer) ; k
- (define-key map "l" 'goto-line) ; l
- (define-key map "m" 'buffer-menu) ; m
- (define-key map "n" 'tpu-next-file-buffer) ; n
- (define-key map "o" 'occur) ; o
- (define-key map "p" 'lpr-region) ; p
- (define-key map "q" 'tpu-quit) ; q
- (define-key map "r" 'tpu-toggle-rectangle) ; r
- (define-key map "s" 'replace) ; s
- (define-key map "t" 'tpu-line-to-top-of-window) ; t
- (define-key map "u" 'undo) ; u
- (define-key map "v" 'tpu-version) ; v
- (define-key map "w" 'save-buffer) ; w
- (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x
- (define-key map "y" 'copy-region-as-kill) ; y
- (define-key map "z" 'suspend-emacs) ; z
+ (define-key map "i" #'tpu-include) ; i
+ (define-key map "k" #'tpu-kill-buffer) ; k
+ (define-key map "l" #'goto-line) ; l
+ (define-key map "m" #'buffer-menu) ; m
+ (define-key map "n" #'tpu-next-file-buffer) ; n
+ (define-key map "o" #'occur) ; o
+ (define-key map "p" #'lpr-region) ; p
+ (define-key map "q" #'tpu-quit) ; q
+ (define-key map "r" #'tpu-toggle-rectangle) ; r
+ (define-key map "s" #'replace) ; s
+ (define-key map "t" #'tpu-line-to-top-of-window) ; t
+ (define-key map "u" #'undo) ; u
+ (define-key map "v" #'tpu-version) ; v
+ (define-key map "w" #'save-buffer) ; w
+ (define-key map "x" #'tpu-save-all-buffers-kill-emacs) ; x
+ (define-key map "y" #'copy-region-as-kill) ; y
+ (define-key map "z" #'suspend-emacs) ; z
;; (define-key map "{" nil) ; {
- (define-key map "|" 'split-window-right) ; |
+ (define-key map "|" #'split-window-right) ; |
;; (define-key map "}" nil) ; }
- (define-key map "~" 'exchange-point-and-mark) ; ~
- (define-key map "\177" 'delete-window) ; <X]
+ (define-key map "~" #'exchange-point-and-mark) ; ~
+ (define-key map "\177" #'delete-window) ; <X]
map)
"Maps the function keys on the VT100 keyboard preceded by PF1.
GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
@@ -492,12 +489,12 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
;; Previously defined in CSI-map. We now presume that term/*.el does
;; its job to map the escape sequence to the right key-symbol.
- (define-key map [find] 'tpu-search) ; Find
- (define-key map [insert] 'tpu-paste) ; Insert Here
- (define-key map [delete] 'tpu-cut) ; Remove
- (define-key map [select] 'tpu-select) ; Select
- (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen
- (define-key map [next] 'tpu-scroll-window-up) ; Next Screen
+ (define-key map [find] #'tpu-search) ; Find
+ (define-key map [insert] #'tpu-paste) ; Insert Here
+ (define-key map [delete] #'tpu-cut) ; Remove
+ (define-key map [select] #'tpu-select) ; Select
+ (define-key map [prior] #'tpu-scroll-window-down) ; Prev Screen
+ (define-key map [next] #'tpu-scroll-window-up) ; Next Screen
;; (define-key map [f1] nil) ; F1
;; (define-key map [f2] nil) ; F2
@@ -508,14 +505,14 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
;; (define-key map [f7] nil) ; F7
;; (define-key map [f8] nil) ; F8
;; (define-key map [f9] nil) ; F9
- (define-key map [f10] 'tpu-exit) ; F10
- (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC)
- (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS)
- (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF)
- (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14
- (define-key map [help] 'tpu-help) ; HELP
- (define-key map [menu] 'execute-extended-command) ; DO
- (define-key map [f17] 'tpu-goto-breadcrumb) ; F17
+ (define-key map [f10] #'tpu-exit) ; F10
+ (define-key map [f11] #'tpu-insert-escape) ; F11 (ESC)
+ (define-key map [f12] #'tpu-next-beginning-of-line) ; F12 (BS)
+ (define-key map [f13] #'tpu-delete-previous-word) ; F13 (LF)
+ (define-key map [f14] #'tpu-toggle-overwrite-mode) ; F14
+ (define-key map [help] #'tpu-help) ; HELP
+ (define-key map [menu] #'execute-extended-command) ; DO
+ (define-key map [f17] #'tpu-goto-breadcrumb) ; F17
;; (define-key map [f18] nil) ; F18
;; (define-key map [f19] nil) ; F19
;; (define-key map [f20] nil) ; F20
@@ -525,28 +522,28 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
;; its job to map the escape sequence to the right key-symbol.
(define-key map [kp-f1] tpu-gold-map) ; GOLD map
;;
- (define-key map [up] 'tpu-previous-line) ; up
- (define-key map [down] 'tpu-next-line) ; down
- (define-key map [right] 'tpu-forward-char) ; right
- (define-key map [left] 'tpu-backward-char) ; left
-
- (define-key map [kp-f2] 'tpu-help) ; PF2
- (define-key map [kp-f3] 'tpu-search-again) ; PF3
- (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4
- (define-key map [kp-0] 'tpu-line) ; KP0
- (define-key map [kp-1] 'tpu-word) ; KP1
- (define-key map [kp-2] 'tpu-end-of-line) ; KP2
- (define-key map [kp-3] 'tpu-char) ; KP3
- (define-key map [kp-4] 'tpu-advance-direction) ; KP4
- (define-key map [kp-5] 'tpu-backup-direction) ; KP5
- (define-key map [kp-6] 'tpu-cut) ; KP6
- (define-key map [kp-7] 'tpu-page) ; KP7
- (define-key map [kp-8] 'tpu-scroll-window) ; KP8
- (define-key map [kp-9] 'tpu-append-region) ; KP9
- (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP-
- (define-key map [kp-separator] 'tpu-delete-current-char) ; KP,
- (define-key map [kp-decimal] 'tpu-select) ; KP.
- (define-key map [kp-enter] 'newline) ; KPenter
+ (define-key map [up] #'tpu-previous-line) ; up
+ (define-key map [down] #'tpu-next-line) ; down
+ (define-key map [right] #'tpu-forward-char) ; right
+ (define-key map [left] #'tpu-backward-char) ; left
+
+ (define-key map [kp-f2] #'tpu-help) ; PF2
+ (define-key map [kp-f3] #'tpu-search-again) ; PF3
+ (define-key map [kp-f4] #'tpu-delete-current-line) ; PF4
+ (define-key map [kp-0] #'tpu-line) ; KP0
+ (define-key map [kp-1] #'tpu-word) ; KP1
+ (define-key map [kp-2] #'tpu-end-of-line) ; KP2
+ (define-key map [kp-3] #'tpu-char) ; KP3
+ (define-key map [kp-4] #'tpu-advance-direction) ; KP4
+ (define-key map [kp-5] #'tpu-backup-direction) ; KP5
+ (define-key map [kp-6] #'tpu-cut) ; KP6
+ (define-key map [kp-7] #'tpu-page) ; KP7
+ (define-key map [kp-8] #'tpu-scroll-window) ; KP8
+ (define-key map [kp-9] #'tpu-append-region) ; KP9
+ (define-key map [kp-subtract] #'tpu-delete-current-word) ; KP-
+ (define-key map [kp-separator] #'tpu-delete-current-char) ; KP,
+ (define-key map [kp-decimal] #'tpu-select) ; KP.
+ (define-key map [kp-enter] #'newline) ; KPenter
map)
"TPU-edt global keymap.")
@@ -883,7 +880,7 @@ With argument, fill and justify."
if no region is selected."
(interactive)
(let ((m (tpu-mark)))
- (apply 'ispell-region
+ (apply #'ispell-region
(if m
(if (> m (point)) (list (point) m)
(list m (point)))
@@ -970,14 +967,14 @@ and the total number of lines in the buffer."
;;;###autoload
(define-minor-mode tpu-edt-mode
"Toggle TPU/edt emulation on or off."
- :global t :group 'tpu
+ :global t
(if tpu-edt-mode (tpu-edt-on) (tpu-edt-off)))
-(defalias 'TPU-EDT-MODE 'tpu-edt-mode)
+(defalias 'TPU-EDT-MODE #'tpu-edt-mode)
;;;###autoload
-(defalias 'tpu-edt 'tpu-edt-on)
-(defalias 'TPU-EDT 'tpu-edt-on)
+(defalias 'tpu-edt #'tpu-edt-on)
+(defalias 'TPU-EDT #'tpu-edt-on)
;; Note: The following functions have no `tpu-' prefix. This is unavoidable.
;; The real TPU/edt editor has interactive commands with these names,
@@ -985,42 +982,42 @@ and the total number of lines in the buffer."
;; to work. Therefore it really is necessary to define these functions,
;; even in cases where they redefine existing Emacs functions.
-(defalias 'exit 'tpu-exit)
-(defalias 'EXIT 'tpu-exit)
+(defalias 'exit #'tpu-exit)
+(defalias 'EXIT #'tpu-exit)
-(defalias 'Get 'tpu-get)
-(defalias 'GET 'tpu-get)
+(defalias 'Get #'tpu-get)
+(defalias 'GET #'tpu-get)
-(defalias 'include 'tpu-include)
-(defalias 'INCLUDE 'tpu-include)
+(defalias 'include #'tpu-include)
+(defalias 'INCLUDE #'tpu-include)
-(defalias 'quit 'tpu-quit)
-(defalias 'QUIT 'tpu-quit)
+(defalias 'quit #'tpu-quit)
+(defalias 'QUIT #'tpu-quit)
-(defalias 'spell 'tpu-spell-check)
-(defalias 'SPELL 'tpu-spell-check)
+(defalias 'spell #'tpu-spell-check)
+(defalias 'SPELL #'tpu-spell-check)
-(defalias 'what\ line 'tpu-what-line)
-(defalias 'WHAT\ LINE 'tpu-what-line)
+(defalias 'what\ line #'tpu-what-line)
+(defalias 'WHAT\ LINE #'tpu-what-line)
-(defalias 'replace 'tpu-lm-replace)
-(defalias 'REPLACE 'tpu-lm-replace)
+(defalias 'replace #'tpu-lm-replace)
+(defalias 'REPLACE #'tpu-lm-replace)
-(defalias 'help 'tpu-help)
-(defalias 'HELP 'tpu-help)
+(defalias 'help #'tpu-help)
+(defalias 'HELP #'tpu-help)
-(defalias 'set\ cursor\ free 'tpu-set-cursor-free)
-(defalias 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
+(defalias 'set\ cursor\ free #'tpu-set-cursor-free)
+(defalias 'SET\ CURSOR\ FREE #'tpu-set-cursor-free)
-(defalias 'set\ cursor\ bound 'tpu-set-cursor-bound)
-(defalias 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
+(defalias 'set\ cursor\ bound #'tpu-set-cursor-bound)
+(defalias 'SET\ CURSOR\ BOUND #'tpu-set-cursor-bound)
-(defalias 'set\ scroll\ margins 'tpu-set-scroll-margins)
-(defalias 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
+(defalias 'set\ scroll\ margins #'tpu-set-scroll-margins)
+(defalias 'SET\ SCROLL\ MARGINS #'tpu-set-scroll-margins)
;; Real TPU error messages end in periods.
;; Define this to avoid openly flouting Emacs coding standards.
-(defalias 'tpu-error 'error)
+(defalias 'tpu-error #'error)
;;;
@@ -1227,7 +1224,7 @@ and the total number of lines in the buffer."
"Bind a set of keystrokes to a single key, or key combination."
(interactive)
(setq tpu-saved-control-r (global-key-binding "\C-r"))
- (global-set-key "\C-r" 'tpu-end-define-macro-key)
+ (global-set-key "\C-r" #'tpu-end-define-macro-key)
(start-kbd-macro nil))
@@ -1361,18 +1358,18 @@ If an argument is specified, don't set the search direction."
(if (not arg) (setq tpu-searching-forward tpu-advance))
(cond (tpu-searching-forward
(cond (tpu-regexp-p
- (fset 'tpu-emacs-search 're-search-forward)
- (fset 'tpu-emacs-rev-search 're-search-backward))
+ (fset 'tpu-emacs-search #'re-search-forward)
+ (fset 'tpu-emacs-rev-search #'re-search-backward))
(t
- (fset 'tpu-emacs-search 'search-forward)
- (fset 'tpu-emacs-rev-search 'search-backward))))
+ (fset 'tpu-emacs-search #'search-forward)
+ (fset 'tpu-emacs-rev-search #'search-backward))))
(t
(cond (tpu-regexp-p
- (fset 'tpu-emacs-search 're-search-backward)
- (fset 'tpu-emacs-rev-search 're-search-forward))
+ (fset 'tpu-emacs-search #'re-search-backward)
+ (fset 'tpu-emacs-rev-search #'re-search-forward))
(t
- (fset 'tpu-emacs-search 'search-backward)
- (fset 'tpu-emacs-rev-search 'search-forward))))))
+ (fset 'tpu-emacs-search #'search-backward)
+ (fset 'tpu-emacs-rev-search #'search-forward))))))
(defun tpu-search-internal (pat &optional quiet)
"Search for a string or regular expression."
@@ -1418,9 +1415,9 @@ If an argument is specified, don't set the search direction."
;; if using regexp, eliminate upper case forms (\B \W \S.)
(if tpu-regexp-p
(let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
- (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\\\" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\B" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\W" pat)) (aset pat (+ 1 pos) ?.))
(while (setq pos (string-match "\\\\S." pat))
(aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
(string-equal pat (downcase pat)))
@@ -2203,18 +2200,18 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
;; Standard Emacs settings under xterm in function-key-map map
;; "\eOM" to [kp-enter] and [kp-enter] to RET, but since the output of the map
;; is not fed back into the map, the key stays as kp-enter :-(.
-(define-key minibuffer-local-map [kp-enter] 'exit-minibuffer)
+(define-key minibuffer-local-map [kp-enter] #'exit-minibuffer)
;; These are not necessary because they are inherited.
;; (define-key minibuffer-local-ns-map [kp-enter] 'exit-minibuffer)
;; (define-key minibuffer-local-completion-map [kp-enter] 'exit-minibuffer)
-(define-key minibuffer-local-must-match-map [kp-enter] 'minibuffer-complete-and-exit)
+(define-key minibuffer-local-must-match-map [kp-enter] #'minibuffer-complete-and-exit)
;;;
;;; Minibuffer map additions to set search direction
;;;
-(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4
-(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5
+(define-key minibuffer-local-map [kp-4] #'tpu-search-forward-exit) ;KP4
+(define-key minibuffer-local-map [kp-5] #'tpu-search-backward-exit) ;KP5
;;;
@@ -2223,19 +2220,19 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
(defvar tpu-control-keys-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-\\" 'quoted-insert) ; ^\
- (define-key map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A
- (define-key map "\C-b" 'repeat-complex-command) ; ^B
- (define-key map "\C-e" 'tpu-current-end-of-line) ; ^E
- (define-key map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS)
- (define-key map "\C-j" 'tpu-delete-previous-word) ; ^J (LF)
- (define-key map "\C-k" 'tpu-define-macro-key) ; ^K
- (define-key map "\C-l" 'tpu-insert-formfeed) ; ^L (FF)
- (define-key map "\C-r" 'recenter) ; ^R
- (define-key map "\C-u" 'tpu-delete-to-bol) ; ^U
- (define-key map "\C-v" 'tpu-quoted-insert) ; ^V
- (define-key map "\C-w" 'redraw-display) ; ^W
- (define-key map "\C-z" 'tpu-exit) ; ^Z
+ (define-key map "\C-\\" #'quoted-insert) ; ^\
+ (define-key map "\C-a" #'tpu-toggle-overwrite-mode) ; ^A
+ (define-key map "\C-b" #'repeat-complex-command) ; ^B
+ (define-key map "\C-e" #'tpu-current-end-of-line) ; ^E
+ (define-key map "\C-h" #'tpu-next-beginning-of-line) ; ^H (BS)
+ (define-key map "\C-j" #'tpu-delete-previous-word) ; ^J (LF)
+ (define-key map "\C-k" #'tpu-define-macro-key) ; ^K
+ (define-key map "\C-l" #'tpu-insert-formfeed) ; ^L (FF)
+ (define-key map "\C-r" #'recenter) ; ^R
+ (define-key map "\C-u" #'tpu-delete-to-bol) ; ^U
+ (define-key map "\C-v" #'tpu-quoted-insert) ; ^V
+ (define-key map "\C-w" #'redraw-display) ; ^W
+ (define-key map "\C-z" #'tpu-exit) ; ^Z
map))
(defun tpu-set-control-keys ()
@@ -2285,18 +2282,18 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll."
(defun tpu-arrow-history nil
"Modify minibuffer maps to use arrows for history recall."
(interactive)
- (dolist (cur (where-is-internal 'tpu-previous-line))
- (define-key read-expression-map cur 'tpu-previous-history-element)
- (define-key minibuffer-local-map cur 'tpu-previous-history-element)
+ (dolist (cur (where-is-internal #'tpu-previous-line))
+ (define-key read-expression-map cur #'tpu-previous-history-element)
+ (define-key minibuffer-local-map cur #'tpu-previous-history-element)
;; These are inherited anyway. --Stef
;; (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element)
;; (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element)
;; (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element)
)
- (dolist (cur (where-is-internal 'tpu-next-line))
- (define-key read-expression-map cur 'tpu-next-history-element)
- (define-key minibuffer-local-map cur 'tpu-next-history-element)
+ (dolist (cur (where-is-internal #'tpu-next-line))
+ (define-key read-expression-map cur #'tpu-next-history-element)
+ (define-key minibuffer-local-map cur #'tpu-next-history-element)
;; These are inherited anyway. --Stef
;; (define-key minibuffer-local-ns-map cur 'tpu-next-history-element)
;; (define-key minibuffer-local-completion-map cur 'tpu-next-history-element)
@@ -2382,7 +2379,7 @@ If FILE is nil, try to load a default file. The default file names are
(use-global-map global-map)
;; Then do the normal TPU setup.
(transient-mark-mode t)
- (add-hook 'post-command-hook 'tpu-search-highlight)
+ (add-hook 'post-command-hook #'tpu-search-highlight)
(tpu-set-mode-line t)
(tpu-advance-direction)
;; set page delimiter, display line truncation, and scrolling like TPU
@@ -2406,7 +2403,7 @@ If FILE is nil, try to load a default file. The default file names are
"Turn off TPU/edt emulation. Note that the keypad is left on."
(interactive)
(tpu-reset-control-keys nil)
- (remove-hook 'post-command-hook 'tpu-search-highlight)
+ (remove-hook 'post-command-hook #'tpu-search-highlight)
(tpu-set-mode-line nil)
(while tpu-edt-old-global-values
(let ((varval (pop tpu-edt-old-global-values)))
diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el
index 10b9c893721..f375e05d8ac 100644
--- a/lisp/obsolete/tpu-extras.el
+++ b/lisp/obsolete/tpu-extras.el
@@ -1,4 +1,4 @@
-;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
+;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
@@ -144,12 +144,12 @@ the previous line when starting from a line beginning."
;;; Hooks -- Set cursor free in picture mode.
;;; Clean up when writing a file from cursor free mode.
-(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
+(add-hook 'picture-mode-hook #'tpu-set-cursor-free)
(defun tpu-trim-line-ends-if-needed ()
"Eliminate whitespace at ends of lines, if the cursor is free."
(if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends)))
-(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed)
+(add-hook 'before-save-hook #'tpu-trim-line-ends-if-needed)
;;; Utility routines for implementing scroll margins
@@ -368,34 +368,22 @@ A repeat count means scroll that many sections."
(and (< (point) top) (recenter (min beg top-margin))))))
;; Advise the newline, newline-and-indent, and do-auto-fill functions.
-(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
+(defun tpu--respect-bottom-scroll-margin (orig-fun &optional &rest args)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line))
- (num (prefix-numeric-value (ad-get-arg 0))))
- ad-do-it
+ (num (prefix-numeric-value (car args))))
+ (apply orig-fun args)
(tpu-bottom-check beg num)))
-(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
- "Respect `tpu-bottom-scroll-margin'."
- (let ((beg (tpu-current-line)))
- ad-do-it
- (tpu-bottom-check beg 1)))
-
-(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
- "Respect `tpu-bottom-scroll-margin'."
- (let ((beg (tpu-current-line)))
- ad-do-it
- (tpu-bottom-check beg 1)))
-
-
;;; Function to set scroll margins
;;;###autoload
-(defun tpu-set-scroll-margins (top bottom)
+(defun tpu-set-scroll-margins (top bottom &optional emit-msg)
"Set scroll margins."
(interactive
"sEnter top scroll margin (N lines or N%% or RETURN for current value): \
-\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
+\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): \
+\np")
;; set top scroll margin
(or (string= top "")
(setq tpu-top-scroll-margin
@@ -411,10 +399,9 @@ A repeat count means scroll that many sections."
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
(window-height)))))
(dolist (f '(newline newline-and-indent do-auto-fill))
- (ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
- (ad-activate f))
+ (advice-add f :around #'tpu--respect-bottom-scroll-margin))
;; report scroll margin settings if running interactively
- (and (called-interactively-p 'interactive)
+ (and emit-msg
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
tpu-top-scroll-margin tpu-bottom-scroll-margin)))
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index 2735820ae49..5ae0a6558d5 100644
--- a/lisp/obsolete/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -1,4 +1,4 @@
-;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file
+;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2001-2021 Free Software Foundation, Inc.
@@ -69,7 +69,7 @@
;;;###autoload
(defun tpu-mapper ()
- "Create an Emacs lisp file defining the TPU-edt keypad for X-windows.
+ "Create an Emacs Lisp file defining the TPU-edt keypad for X-windows.
This command displays an instruction screen showing the TPU-edt keypad
and asks you to press the TPU-edt editing keys. It uses the keys you
diff --git a/lisp/obsolete/url-ns.el b/lisp/obsolete/url-ns.el
index fff3be95453..6cd6693fc43 100644
--- a/lisp/obsolete/url-ns.el
+++ b/lisp/obsolete/url-ns.el
@@ -1,4 +1,4 @@
-;;; url-ns.el --- Various netscape-ish functions for proxy definitions
+;;; url-ns.el --- Various netscape-ish functions for proxy definitions -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1999, 2004-2021 Free Software Foundation, Inc.
@@ -31,7 +31,7 @@
;;;###autoload
(defun isPlainHostName (host)
- (not (string-match "\\." host)))
+ (not (string-search "." host)))
;;;###autoload
(defun dnsDomainIs (host dom)
@@ -55,9 +55,9 @@
(if (or (/= (length netc) (length ipc))
(/= (length ipc) (length maskc)))
nil
- (setq netc (mapcar 'string-to-number netc)
- ipc (mapcar 'string-to-number ipc)
- maskc (mapcar 'string-to-number maskc))
+ (setq netc (mapcar #'string-to-number netc)
+ ipc (mapcar #'string-to-number ipc)
+ maskc (mapcar #'string-to-number maskc))
(and
(= (logand (nth 0 netc) (nth 0 maskc))
(logand (nth 0 ipc) (nth 0 maskc)))
@@ -79,24 +79,23 @@
(if (not (and (file-exists-p file)
(file-readable-p file)))
(message "Could not open %s for reading" file)
- (save-excursion
- (let ((false nil)
- (true t))
- (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal))
- (set-buffer (get-buffer-create " *ns-parse*"))
- (erase-buffer)
- (insert-file-contents file)
- (goto-char (point-min))
- (while (re-search-forward "^//" nil t)
- (replace-match ";;"))
- (goto-char (point-min))
- (while (re-search-forward "^user_pref(" nil t)
- (replace-match "(url-ns-set-user-pref "))
- (goto-char (point-min))
- (while (re-search-forward "\"," nil t)
- (replace-match "\""))
- (goto-char (point-min))
- (eval-buffer)))))
+ (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal))
+ (with-current-buffer (get-buffer-create " *ns-parse*")
+ (erase-buffer)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (while (re-search-forward "^//" nil t)
+ (replace-match ";;"))
+ (goto-char (point-min))
+ (while (re-search-forward "^user_pref(" nil t)
+ (replace-match "(url-ns-set-user-pref "))
+ (goto-char (point-min))
+ (while (re-search-forward "\"," nil t)
+ (replace-match "\""))
+ (goto-char (point-min))
+ (with-suppressed-warnings ((lexical true false))
+ (dlet ((false nil) (true t))
+ (eval-buffer))))))
(defun url-ns-set-user-pref (key val)
(puthash key val url-ns-user-prefs))
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 80a2094d804..cfbf981d3c8 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -26,7 +26,7 @@
;; The home page of the Arch version control system is at
;;
-;; http://www.gnuarch.org/
+;; https://www.gnu.org/software/gnu-arch/
;;
;; This is derived from vc-mcvs.el as follows:
;; - cp vc-mcvs.el vc-arch.el and then M-% mcvs RET arch RET
@@ -81,8 +81,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "23.1"
- :group 'vc-arch)
+ :version "23.1")
(define-obsolete-variable-alias 'vc-arch-command 'vc-arch-program "23.1")
@@ -92,8 +91,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(setq candidates (cdr candidates)))
(or (car candidates) "tla"))
"Name of the Arch executable."
- :type 'string
- :group 'vc-arch)
+ :type 'string)
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -341,7 +339,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
("--" . permissions-changed)
("-/" . permissions-changed) ;directory
))
- (state-map-regexp (regexp-opt (mapcar 'car state-map) t))
+ (state-map-regexp (regexp-opt (mapcar #'car state-map) t))
(entry-regexp (concat "^" state-map-regexp " \\(.*\\)$"))
result)
(goto-char (point-min))
@@ -387,8 +385,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(defcustom vc-arch-mode-line-rewrite
'(("\\`.*--\\(.*--.*\\)--\\(v?\\).*-\\([0-9]+\\)\\'" . "\\2\\3[\\1]"))
"Rewrite rules to shorten Arch's revision names on the mode-line."
- :type '(repeat (cons regexp string))
- :group 'vc-arch)
+ :type '(repeat (cons regexp string)))
(defun vc-arch-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
@@ -420,7 +417,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
;; The .rej file is obsolete.
(condition-case nil (delete-file rej) (error nil))
;; Remove the hook so that it is not called multiple times.
- (remove-hook 'after-save-hook 'vc-arch-delete-rej-if-obsolete t))))))
+ (remove-hook 'after-save-hook #'vc-arch-delete-rej-if-obsolete t))))))
(defun vc-arch-find-file-hook ()
(let ((rej (concat buffer-file-name ".rej")))
@@ -433,7 +430,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(condition-case nil (delete-file rej) (error nil))
(smerge-mode 1)
(add-hook 'after-save-hook
- 'vc-arch-delete-rej-if-obsolete nil t)
+ #'vc-arch-delete-rej-if-obsolete nil t)
(message "There are unresolved conflicts in this file")))
(message "There are unresolved conflicts in %s"
(file-name-nondirectory rej))))))
@@ -488,11 +485,11 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(defun vc-arch-rename-file (old new)
(vc-arch-command nil 0 new "mv" (file-relative-name old)))
-(defalias 'vc-arch-responsible-p 'vc-arch-root)
+(defalias 'vc-arch-responsible-p #'vc-arch-root)
(defun vc-arch-command (buffer okstatus file &rest flags)
"A wrapper around `vc-do-command' for use in vc-arch.el."
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags))
+ (apply #'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags))
;;; Completion of versions and revisions.
@@ -571,7 +568,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(when (string-match "-\\([0-9]+\\)\\'" f)
(cons (string-to-number (match-string 1 f)) f)))
(directory-files dir nil nil 'nosort)))
- 'car-less-than-car))
+ #'car-less-than-car))
(subdirs nil))
(when (cddr revs)
(dotimes (_i (/ (length revs) 2))
@@ -600,26 +597,26 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(let* ((archives (directory-files rl-dir 'full
directory-files-no-dot-files-regexp))
(categories
- (apply 'append
+ (apply #'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
(directory-files
dir 'full directory-files-no-dot-files-regexp)))
archives)))
(branches
- (apply 'append
+ (apply #'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
(directory-files
dir 'full directory-files-no-dot-files-regexp)))
categories)))
(versions
- (apply 'append
+ (apply #'append
(mapcar (lambda (dir)
(when (file-directory-p dir)
(directory-files dir 'full "--.*--")))
branches))))
- (mapc 'vc-arch-trim-one-revlib versions))
+ (mapc #'vc-arch-trim-one-revlib versions))
))
(defvar vc-arch-extra-menu-map
diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el
index eee00b43a26..91baa4d28ef 100644
--- a/lisp/obsolete/vi.el
+++ b/lisp/obsolete/vi.el
@@ -1,4 +1,4 @@
-;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs
+;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs -*- lexical-binding: t; -*-
;; This file is in the public domain because the authors distributed it
;; without a copyright notice before the US signed the Bern Convention.
@@ -48,7 +48,7 @@
(defvar vi-mode-old-case-fold)
(if (null (where-is-internal 'vi-switch-mode (current-local-map)))
- (define-key ctl-x-map "~" 'vi-switch-mode))
+ (define-key ctl-x-map "~" #'vi-switch-mode))
(defvar vi-tilde-map nil
"Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.")
@@ -56,24 +56,24 @@
(if vi-tilde-map
nil
(setq vi-tilde-map (make-keymap))
- (define-key vi-tilde-map "a" 'abbrev-mode)
- (define-key vi-tilde-map "c" 'c-mode)
- (define-key vi-tilde-map "d" 'vi-debugging)
- (define-key vi-tilde-map "e" 'emacs-lisp-mode)
- (define-key vi-tilde-map "f" 'auto-fill-mode)
- (define-key vi-tilde-map "g" 'prolog-mode)
- (define-key vi-tilde-map "h" 'hanoi)
- (define-key vi-tilde-map "i" 'info-mode)
- (define-key vi-tilde-map "l" 'lisp-mode)
- (define-key vi-tilde-map "n" 'nroff-mode)
- (define-key vi-tilde-map "o" 'overwrite-mode)
- (define-key vi-tilde-map "O" 'outline-mode)
- (define-key vi-tilde-map "P" 'picture-mode)
- (define-key vi-tilde-map "r" 'vi-readonly-mode)
- (define-key vi-tilde-map "t" 'text-mode)
- (define-key vi-tilde-map "v" 'vi-mode)
- (define-key vi-tilde-map "x" 'tex-mode)
- (define-key vi-tilde-map "~" 'vi-back-to-old-mode))
+ (define-key vi-tilde-map "a" #'abbrev-mode)
+ (define-key vi-tilde-map "c" #'c-mode)
+ (define-key vi-tilde-map "d" #'vi-debugging)
+ (define-key vi-tilde-map "e" #'emacs-lisp-mode)
+ (define-key vi-tilde-map "f" #'auto-fill-mode)
+ (define-key vi-tilde-map "g" #'prolog-mode)
+ (define-key vi-tilde-map "h" #'hanoi)
+ ;; (define-key vi-tilde-map "i" #'info-mode)
+ (define-key vi-tilde-map "l" #'lisp-mode)
+ (define-key vi-tilde-map "n" #'nroff-mode)
+ (define-key vi-tilde-map "o" #'overwrite-mode)
+ (define-key vi-tilde-map "O" #'outline-mode)
+ (define-key vi-tilde-map "P" #'picture-mode)
+ (define-key vi-tilde-map "r" #'vi-readonly-mode)
+ (define-key vi-tilde-map "t" #'text-mode)
+ (define-key vi-tilde-map "v" #'vi-mode)
+ (define-key vi-tilde-map "x" #'tex-mode)
+ (define-key vi-tilde-map "~" #'vi-back-to-old-mode))
(defun vi-switch-mode (arg mode-char)
"Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}"
@@ -123,143 +123,143 @@ command extensions.")
(put 'vi-undefined 'suppress-keymap t)
(if vi-com-map nil
(setq vi-com-map (make-keymap))
-;;(fillarray vi-com-map 'vi-undefined)
- (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension
- (define-key vi-com-map "\C-a" 'vi-ask-for-info) ; extension
- (define-key vi-com-map "\C-b" 'vi-backward-windowful)
- (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension
- (define-key vi-com-map "\C-d" 'vi-scroll-down-window)
- (define-key vi-com-map "\C-e" 'vi-expose-line-below)
- (define-key vi-com-map "\C-f" 'vi-forward-windowful)
- (define-key vi-com-map "\C-g" 'keyboard-quit)
- (define-key vi-com-map "\C-i" 'indent-relative-first-indent-point) ; TAB
- (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD
- (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension
- (define-key vi-com-map "\C-l" 'recenter)
- (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET
- (define-key vi-com-map "\C-n" 'vi-next-line)
- (define-key vi-com-map "\C-o" 'vi-split-open-line)
- (define-key vi-com-map "\C-p" 'previous-line)
- (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension
- (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification
- (define-key vi-com-map "\C-s" 'vi-isearch-forward) ; extension
- (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension
- (define-key vi-com-map "\C-u" 'vi-scroll-up-window)
- (define-key vi-com-map "\C-v" 'scroll-up-command) ; extension
- (define-key vi-com-map "\C-w" 'vi-kill-region) ; extension
+;;(fillarray vi-com-map #'vi-undefined)
+ (define-key vi-com-map "\C-@" #'vi-mark-region) ; extension
+ (define-key vi-com-map "\C-a" #'vi-ask-for-info) ; extension
+ (define-key vi-com-map "\C-b" #'vi-backward-windowful)
+ (define-key vi-com-map "\C-c" #'vi-do-old-mode-C-c-command) ; extension
+ (define-key vi-com-map "\C-d" #'vi-scroll-down-window)
+ (define-key vi-com-map "\C-e" #'vi-expose-line-below)
+ (define-key vi-com-map "\C-f" #'vi-forward-windowful)
+ (define-key vi-com-map "\C-g" #'keyboard-quit)
+ (define-key vi-com-map "\C-i" #'indent-relative-first-indent-point) ; TAB
+ (define-key vi-com-map "\C-j" #'vi-next-line) ; LFD
+ (define-key vi-com-map "\C-k" #'vi-kill-line) ; extension
+ (define-key vi-com-map "\C-l" #'recenter)
+ (define-key vi-com-map "\C-m" #'vi-next-line-first-nonwhite) ; RET
+ (define-key vi-com-map "\C-n" #'vi-next-line)
+ (define-key vi-com-map "\C-o" #'vi-split-open-line)
+ (define-key vi-com-map "\C-p" #'previous-line)
+ (define-key vi-com-map "\C-q" #'vi-query-replace) ; extension
+ (define-key vi-com-map "\C-r" #'vi-isearch-backward) ; modification
+ (define-key vi-com-map "\C-s" #'vi-isearch-forward) ; extension
+ (define-key vi-com-map "\C-t" #'vi-transpose-objects) ; extension
+ (define-key vi-com-map "\C-u" #'vi-scroll-up-window)
+ (define-key vi-com-map "\C-v" #'scroll-up-command) ; extension
+ (define-key vi-com-map "\C-w" #'vi-kill-region) ; extension
(define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension
- (define-key vi-com-map "\C-y" 'vi-expose-line-above)
- (define-key vi-com-map "\C-z" 'suspend-emacs)
+ (define-key vi-com-map "\C-y" #'vi-expose-line-above)
+ (define-key vi-com-map "\C-z" #'suspend-emacs)
(define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC)
- (define-key vi-com-map "\C-\\" 'vi-unimplemented)
- (define-key vi-com-map "\C-]" 'find-tag)
- (define-key vi-com-map "\C-^" 'vi-locate-def) ; extension
- (define-key vi-com-map "\C-_" 'vi-undefined)
-
- (define-key vi-com-map " " 'forward-char)
- (define-key vi-com-map "!" 'vi-operator)
- (define-key vi-com-map "\"" 'vi-char-argument)
- (define-key vi-com-map "#" 'universal-argument) ; extension
- (define-key vi-com-map "$" 'end-of-line)
- (define-key vi-com-map "%" 'vi-find-matching-paren)
- (define-key vi-com-map "&" 'vi-unimplemented)
- (define-key vi-com-map "'" 'vi-goto-line-mark)
- (define-key vi-com-map "(" 'backward-sexp)
- (define-key vi-com-map ")" 'forward-sexp)
- (define-key vi-com-map "*" 'vi-name-last-change-or-macro) ; extension
- (define-key vi-com-map "+" 'vi-next-line-first-nonwhite)
- (define-key vi-com-map "," 'vi-reverse-last-find-char)
- (define-key vi-com-map "-" 'vi-previous-line-first-nonwhite)
- (define-key vi-com-map "." 'vi-redo-last-change-command)
- (define-key vi-com-map "/" 'vi-search-forward)
- (define-key vi-com-map "0" 'beginning-of-line)
-
- (define-key vi-com-map "1" 'vi-digit-argument)
- (define-key vi-com-map "2" 'vi-digit-argument)
- (define-key vi-com-map "3" 'vi-digit-argument)
- (define-key vi-com-map "4" 'vi-digit-argument)
- (define-key vi-com-map "5" 'vi-digit-argument)
- (define-key vi-com-map "6" 'vi-digit-argument)
- (define-key vi-com-map "7" 'vi-digit-argument)
- (define-key vi-com-map "8" 'vi-digit-argument)
- (define-key vi-com-map "9" 'vi-digit-argument)
-
- (define-key vi-com-map ":" 'vi-ex-cmd)
- (define-key vi-com-map ";" 'vi-repeat-last-find-char)
- (define-key vi-com-map "<" 'vi-operator)
- (define-key vi-com-map "=" 'vi-operator)
- (define-key vi-com-map ">" 'vi-operator)
- (define-key vi-com-map "?" 'vi-search-backward)
- (define-key vi-com-map "@" 'vi-call-named-change-or-macro) ; extension
-
- (define-key vi-com-map "A" 'vi-append-at-end-of-line)
- (define-key vi-com-map "B" 'vi-backward-blank-delimited-word)
- (define-key vi-com-map "C" 'vi-change-rest-of-line)
- (define-key vi-com-map "D" 'vi-kill-line)
- (define-key vi-com-map "E" 'vi-end-of-blank-delimited-word)
- (define-key vi-com-map "F" 'vi-backward-find-char)
- (define-key vi-com-map "G" 'vi-goto-line)
- (define-key vi-com-map "H" 'vi-home-window-line)
- (define-key vi-com-map "I" 'vi-insert-before-first-nonwhite)
- (define-key vi-com-map "J" 'vi-join-lines)
- (define-key vi-com-map "K" 'vi-undefined)
- (define-key vi-com-map "L" 'vi-last-window-line)
- (define-key vi-com-map "M" 'vi-middle-window-line)
- (define-key vi-com-map "N" 'vi-reverse-last-search)
- (define-key vi-com-map "O" 'vi-open-above)
- (define-key vi-com-map "P" 'vi-put-before)
- (define-key vi-com-map "Q" 'vi-quote-words) ; extension
- (define-key vi-com-map "R" 'vi-replace-chars)
- (define-key vi-com-map "S" 'vi-substitute-lines)
- (define-key vi-com-map "T" 'vi-backward-upto-char)
- (define-key vi-com-map "U" 'vi-unimplemented)
- (define-key vi-com-map "V" 'vi-undefined)
- (define-key vi-com-map "W" 'vi-forward-blank-delimited-word)
- (define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension
- (define-key vi-com-map "Y" 'vi-yank-line)
+ (define-key vi-com-map "\C-\\" #'vi-unimplemented)
+ (define-key vi-com-map "\C-]" #'xref-find-definitions)
+ (define-key vi-com-map "\C-^" #'vi-locate-def) ; extension
+ (define-key vi-com-map "\C-_" #'vi-undefined)
+
+ (define-key vi-com-map " " #'forward-char)
+ (define-key vi-com-map "!" #'vi-operator)
+ (define-key vi-com-map "\"" #'vi-char-argument)
+ (define-key vi-com-map "#" #'universal-argument) ; extension
+ (define-key vi-com-map "$" #'end-of-line)
+ (define-key vi-com-map "%" #'vi-find-matching-paren)
+ (define-key vi-com-map "&" #'vi-unimplemented)
+ (define-key vi-com-map "'" #'vi-goto-line-mark)
+ (define-key vi-com-map "(" #'backward-sexp)
+ (define-key vi-com-map ")" #'forward-sexp)
+ (define-key vi-com-map "*" #'vi-name-last-change-or-macro) ; extension
+ (define-key vi-com-map "+" #'vi-next-line-first-nonwhite)
+ (define-key vi-com-map "," #'vi-reverse-last-find-char)
+ (define-key vi-com-map "-" #'vi-previous-line-first-nonwhite)
+ (define-key vi-com-map "." #'vi-redo-last-change-command)
+ (define-key vi-com-map "/" #'vi-search-forward)
+ (define-key vi-com-map "0" #'beginning-of-line)
+
+ (define-key vi-com-map "1" #'vi-digit-argument)
+ (define-key vi-com-map "2" #'vi-digit-argument)
+ (define-key vi-com-map "3" #'vi-digit-argument)
+ (define-key vi-com-map "4" #'vi-digit-argument)
+ (define-key vi-com-map "5" #'vi-digit-argument)
+ (define-key vi-com-map "6" #'vi-digit-argument)
+ (define-key vi-com-map "7" #'vi-digit-argument)
+ (define-key vi-com-map "8" #'vi-digit-argument)
+ (define-key vi-com-map "9" #'vi-digit-argument)
+
+ (define-key vi-com-map ":" #'vi-ex-cmd)
+ (define-key vi-com-map ";" #'vi-repeat-last-find-char)
+ (define-key vi-com-map "<" #'vi-operator)
+ (define-key vi-com-map "=" #'vi-operator)
+ (define-key vi-com-map ">" #'vi-operator)
+ (define-key vi-com-map "?" #'vi-search-backward)
+ (define-key vi-com-map "@" #'vi-call-named-change-or-macro) ; extension
+
+ (define-key vi-com-map "A" #'vi-append-at-end-of-line)
+ (define-key vi-com-map "B" #'vi-backward-blank-delimited-word)
+ (define-key vi-com-map "C" #'vi-change-rest-of-line)
+ (define-key vi-com-map "D" #'vi-kill-line)
+ (define-key vi-com-map "E" #'vi-end-of-blank-delimited-word)
+ (define-key vi-com-map "F" #'vi-backward-find-char)
+ (define-key vi-com-map "G" #'vi-goto-line)
+ (define-key vi-com-map "H" #'vi-home-window-line)
+ (define-key vi-com-map "I" #'vi-insert-before-first-nonwhite)
+ (define-key vi-com-map "J" #'vi-join-lines)
+ (define-key vi-com-map "K" #'vi-undefined)
+ (define-key vi-com-map "L" #'vi-last-window-line)
+ (define-key vi-com-map "M" #'vi-middle-window-line)
+ (define-key vi-com-map "N" #'vi-reverse-last-search)
+ (define-key vi-com-map "O" #'vi-open-above)
+ (define-key vi-com-map "P" #'vi-put-before)
+ (define-key vi-com-map "Q" #'vi-quote-words) ; extension
+ (define-key vi-com-map "R" #'vi-replace-chars)
+ (define-key vi-com-map "S" #'vi-substitute-lines)
+ (define-key vi-com-map "T" #'vi-backward-upto-char)
+ (define-key vi-com-map "U" #'vi-unimplemented)
+ (define-key vi-com-map "V" #'vi-undefined)
+ (define-key vi-com-map "W" #'vi-forward-blank-delimited-word)
+ (define-key vi-com-map "X" #'call-last-kbd-macro) ; modification/extension
+ (define-key vi-com-map "Y" #'vi-yank-line)
(define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command
- (define-key vi-com-map "ZZ" 'vi-save-all-and-exit)
-
- (define-key vi-com-map "[" 'vi-unimplemented)
- (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op
- (define-key vi-com-map "]" 'vi-unimplemented)
- (define-key vi-com-map "^" 'back-to-indentation)
- (define-key vi-com-map "_" 'vi-undefined)
- (define-key vi-com-map "`" 'vi-goto-char-mark)
-
- (define-key vi-com-map "a" 'vi-insert-after)
- (define-key vi-com-map "b" 'backward-word)
- (define-key vi-com-map "c" 'vi-operator)
- (define-key vi-com-map "d" 'vi-operator)
- (define-key vi-com-map "e" 'vi-end-of-word)
- (define-key vi-com-map "f" 'vi-forward-find-char)
- (define-key vi-com-map "g" 'vi-beginning-of-buffer) ; extension
- (define-key vi-com-map "h" 'backward-char)
- (define-key vi-com-map "i" 'vi-insert-before)
- (define-key vi-com-map "j" 'vi-next-line)
- (define-key vi-com-map "k" 'previous-line)
- (define-key vi-com-map "l" 'forward-char)
- (define-key vi-com-map "m" 'vi-set-mark)
- (define-key vi-com-map "n" 'vi-repeat-last-search)
- (define-key vi-com-map "o" 'vi-open-below)
- (define-key vi-com-map "p" 'vi-put-after)
- (define-key vi-com-map "q" 'vi-replace)
- (define-key vi-com-map "r" 'vi-replace-1-char)
- (define-key vi-com-map "s" 'vi-substitute-chars)
- (define-key vi-com-map "t" 'vi-forward-upto-char)
- (define-key vi-com-map "u" 'undo)
- (define-key vi-com-map "v" 'vi-verify-spelling)
- (define-key vi-com-map "w" 'vi-forward-word)
- (define-key vi-com-map "x" 'vi-kill-char)
- (define-key vi-com-map "y" 'vi-operator)
- (define-key vi-com-map "z" 'vi-adjust-window)
-
- (define-key vi-com-map "{" 'backward-paragraph)
- (define-key vi-com-map "|" 'vi-goto-column)
- (define-key vi-com-map "}" 'forward-paragraph)
- (define-key vi-com-map "~" 'vi-change-case)
- (define-key vi-com-map "\177" 'delete-backward-char))
+ (define-key vi-com-map "ZZ" #'vi-save-all-and-exit)
+
+ (define-key vi-com-map "[" #'vi-unimplemented)
+ (define-key vi-com-map "\\" #'vi-operator) ; extension for vi-narrow-op
+ (define-key vi-com-map "]" #'vi-unimplemented)
+ (define-key vi-com-map "^" #'back-to-indentation)
+ (define-key vi-com-map "_" #'vi-undefined)
+ (define-key vi-com-map "`" #'vi-goto-char-mark)
+
+ (define-key vi-com-map "a" #'vi-insert-after)
+ (define-key vi-com-map "b" #'backward-word)
+ (define-key vi-com-map "c" #'vi-operator)
+ (define-key vi-com-map "d" #'vi-operator)
+ (define-key vi-com-map "e" #'vi-end-of-word)
+ (define-key vi-com-map "f" #'vi-forward-find-char)
+ (define-key vi-com-map "g" #'vi-beginning-of-buffer) ; extension
+ (define-key vi-com-map "h" #'backward-char)
+ (define-key vi-com-map "i" #'vi-insert-before)
+ (define-key vi-com-map "j" #'vi-next-line)
+ (define-key vi-com-map "k" #'previous-line)
+ (define-key vi-com-map "l" #'forward-char)
+ (define-key vi-com-map "m" #'vi-set-mark)
+ (define-key vi-com-map "n" #'vi-repeat-last-search)
+ (define-key vi-com-map "o" #'vi-open-below)
+ (define-key vi-com-map "p" #'vi-put-after)
+ (define-key vi-com-map "q" #'vi-replace)
+ (define-key vi-com-map "r" #'vi-replace-1-char)
+ (define-key vi-com-map "s" #'vi-substitute-chars)
+ (define-key vi-com-map "t" #'vi-forward-upto-char)
+ (define-key vi-com-map "u" #'undo)
+ (define-key vi-com-map "v" #'vi-verify-spelling)
+ (define-key vi-com-map "w" #'vi-forward-word)
+ (define-key vi-com-map "x" #'vi-kill-char)
+ (define-key vi-com-map "y" #'vi-operator)
+ (define-key vi-com-map "z" #'vi-adjust-window)
+
+ (define-key vi-com-map "{" #'backward-paragraph)
+ (define-key vi-com-map "|" #'vi-goto-column)
+ (define-key vi-com-map "}" #'forward-paragraph)
+ (define-key vi-com-map "~" #'vi-change-case)
+ (define-key vi-com-map "\177" #'delete-backward-char))
(put 'backward-char 'point-moving-unit 'char)
(put 'vi-next-line 'point-moving-unit 'line)
@@ -1182,7 +1182,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
(defun vi-narrow-op (motion-command arg)
"Narrow to region specified by MOTION-COMMAND with ARG."
(let* ((range (vi-effective-range motion-command arg))
- (begin (car range)) (end (cdr range)) reg)
+ (begin (car range)) (end (cdr range)))
(if (= begin end)
nil ; point not moved, abort op
(narrow-to-region begin end))))
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
index 08085e51d74..16906b68a67 100644
--- a/lisp/obsolete/vip.el
+++ b/lisp/obsolete/vip.el
@@ -1,4 +1,4 @@
-;;; vip.el --- a VI Package for GNU Emacs
+;;; vip.el --- a VI Package for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2021 Free Software
;; Foundation, Inc.
@@ -95,13 +95,11 @@
(defcustom vip-shift-width 8
"The number of columns shifted by > and < command."
- :type 'integer
- :group 'vip)
+ :type 'integer)
(defcustom vip-re-replace nil
"If t then do regexp replace, if nil then do string replace."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defvar vip-d-char nil
"The character remembered by the vi \"r\" command.")
@@ -120,13 +118,11 @@
(defcustom vip-search-wrap-around t
"If t, search wraps around."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defcustom vip-re-search nil
"If t, search is reg-exp search, otherwise vanilla search."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defvar vip-s-string nil
"Last vip search string.")
@@ -136,24 +132,20 @@
(defcustom vip-case-fold-search nil
"If t, search ignores cases."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defcustom vip-re-query-replace nil
"If t then do regexp replace, if nil then do string replace."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defcustom vip-open-with-indent nil
"If t, indent when open a new line."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defcustom vip-help-in-insert-mode nil
"If t then C-h is bound to help-command in insert mode.
If nil then it is bound to `delete-backward-char'."
- :type 'boolean
- :group 'vip)
+ :type 'boolean)
(defvar vip-quote-string "> "
"String inserted at the beginning of region.")
@@ -169,131 +161,131 @@ If nil then it is bound to `delete-backward-char'."
(defvar vip-mode-map
(let ((map (make-keymap)))
- (define-key map "\C-a" 'beginning-of-line)
- (define-key map "\C-b" 'vip-scroll-back)
- (define-key map "\C-c" 'vip-ctl-c)
- (define-key map "\C-d" 'vip-scroll-up)
- (define-key map "\C-e" 'vip-scroll-up-one)
- (define-key map "\C-f" 'vip-scroll)
- (define-key map "\C-g" 'vip-keyboard-quit)
- (define-key map "\C-h" 'help-command)
- (define-key map "\C-m" 'vip-scroll-back)
- (define-key map "\C-n" 'vip-other-window)
- (define-key map "\C-o" 'vip-open-line-at-point)
- (define-key map "\C-u" 'vip-scroll-down)
- (define-key map "\C-x" 'vip-ctl-x)
- (define-key map "\C-y" 'vip-scroll-down-one)
- (define-key map "\C-z" 'vip-change-mode-to-emacs)
- (define-key map "\e" 'vip-ESC)
-
- (define-key map [?\S-\ ] 'vip-scroll-back)
- (define-key map " " 'vip-scroll)
- (define-key map "!" 'vip-command-argument)
- (define-key map "\"" 'vip-command-argument)
- (define-key map "#" 'vip-command-argument)
- (define-key map "$" 'vip-goto-eol)
- (define-key map "%" 'vip-paren-match)
- (define-key map "&" 'vip-nil)
- (define-key map "'" 'vip-goto-mark-and-skip-white)
- (define-key map "(" 'vip-backward-sentence)
- (define-key map ")" 'vip-forward-sentence)
- (define-key map "*" 'call-last-kbd-macro)
- (define-key map "+" 'vip-next-line-at-bol)
- (define-key map "," 'vip-repeat-find-opposite)
- (define-key map "-" 'vip-previous-line-at-bol)
- (define-key map "." 'vip-repeat)
- (define-key map "/" 'vip-search-forward)
-
- (define-key map "0" 'vip-beginning-of-line)
- (define-key map "1" 'vip-digit-argument)
- (define-key map "2" 'vip-digit-argument)
- (define-key map "3" 'vip-digit-argument)
- (define-key map "4" 'vip-digit-argument)
- (define-key map "5" 'vip-digit-argument)
- (define-key map "6" 'vip-digit-argument)
- (define-key map "7" 'vip-digit-argument)
- (define-key map "8" 'vip-digit-argument)
- (define-key map "9" 'vip-digit-argument)
-
- (define-key map ":" 'vip-ex)
- (define-key map ";" 'vip-repeat-find)
- (define-key map "<" 'vip-command-argument)
- (define-key map "=" 'vip-command-argument)
- (define-key map ">" 'vip-command-argument)
- (define-key map "?" 'vip-search-backward)
- (define-key map "@" 'vip-nil)
-
- (define-key map "A" 'vip-Append)
- (define-key map "B" 'vip-backward-Word)
- (define-key map "C" 'vip-ctl-c-equivalent)
- (define-key map "D" 'vip-kill-line)
- (define-key map "E" 'vip-end-of-Word)
- (define-key map "F" 'vip-find-char-backward)
- (define-key map "G" 'vip-goto-line)
- (define-key map "H" 'vip-window-top)
- (define-key map "I" 'vip-Insert)
- (define-key map "J" 'vip-join-lines)
- (define-key map "K" 'vip-kill-buffer)
- (define-key map "L" 'vip-window-bottom)
- (define-key map "M" 'vip-window-middle)
- (define-key map "N" 'vip-search-Next)
- (define-key map "O" 'vip-Open-line)
- (define-key map "P" 'vip-Put-back)
- (define-key map "Q" 'vip-query-replace)
- (define-key map "R" 'vip-replace-string)
- (define-key map "S" 'vip-switch-to-buffer-other-window)
- (define-key map "T" 'vip-goto-char-backward)
- (define-key map "U" 'vip-nil)
- (define-key map "V" 'vip-find-file-other-window)
- (define-key map "W" 'vip-forward-Word)
- (define-key map "X" 'vip-ctl-x-equivalent)
- (define-key map "Y" 'vip-yank-line)
- (define-key map "ZZ" 'save-buffers-kill-emacs)
-
- (define-key map "[" 'vip-nil)
- (define-key map "\\" 'vip-escape-to-emacs)
- (define-key map "]" 'vip-nil)
- (define-key map "^" 'vip-bol-and-skip-white)
- (define-key map "_" 'vip-nil)
- (define-key map "`" 'vip-goto-mark)
-
- (define-key map "a" 'vip-append)
- (define-key map "b" 'vip-backward-word)
- (define-key map "c" 'vip-command-argument)
- (define-key map "d" 'vip-command-argument)
- (define-key map "e" 'vip-end-of-word)
- (define-key map "f" 'vip-find-char-forward)
- (define-key map "g" 'vip-info-on-file)
- (define-key map "h" 'vip-backward-char)
- (define-key map "i" 'vip-insert)
- (define-key map "j" 'vip-next-line)
- (define-key map "k" 'vip-previous-line)
- (define-key map "l" 'vip-forward-char)
- (define-key map "m" 'vip-mark-point)
- (define-key map "n" 'vip-search-next)
- (define-key map "o" 'vip-open-line)
- (define-key map "p" 'vip-put-back)
- (define-key map "q" 'vip-nil)
- (define-key map "r" 'vip-replace-char)
- (define-key map "s" 'vip-switch-to-buffer)
- (define-key map "t" 'vip-goto-char-forward)
- (define-key map "u" 'vip-undo)
- (define-key map "v" 'vip-find-file)
- (define-key map "w" 'vip-forward-word)
- (define-key map "x" 'vip-delete-char)
- (define-key map "y" 'vip-command-argument)
- (define-key map "zH" 'vip-line-to-top)
- (define-key map "zM" 'vip-line-to-middle)
- (define-key map "zL" 'vip-line-to-bottom)
- (define-key map "z\C-m" 'vip-line-to-top)
- (define-key map "z." 'vip-line-to-middle)
- (define-key map "z-" 'vip-line-to-bottom)
-
- (define-key map "{" 'vip-backward-paragraph)
- (define-key map "|" 'vip-goto-col)
- (define-key map "}" 'vip-forward-paragraph)
- (define-key map "~" 'vip-nil)
- (define-key map "\177" 'vip-delete-backward-char)
+ (define-key map "\C-a" #'beginning-of-line)
+ (define-key map "\C-b" #'vip-scroll-back)
+ (define-key map "\C-c" #'vip-ctl-c)
+ (define-key map "\C-d" #'vip-scroll-up)
+ (define-key map "\C-e" #'vip-scroll-up-one)
+ (define-key map "\C-f" #'vip-scroll)
+ (define-key map "\C-g" #'vip-keyboard-quit)
+ (define-key map "\C-h" #'help-command)
+ (define-key map "\C-m" #'vip-scroll-back)
+ (define-key map "\C-n" #'vip-other-window)
+ (define-key map "\C-o" #'vip-open-line-at-point)
+ (define-key map "\C-u" #'vip-scroll-down)
+ (define-key map "\C-x" #'vip-ctl-x)
+ (define-key map "\C-y" #'vip-scroll-down-one)
+ (define-key map "\C-z" #'vip-change-mode-to-emacs)
+ (define-key map "\e" #'vip-ESC)
+
+ (define-key map [?\S-\ ] #'vip-scroll-back)
+ (define-key map " " #'vip-scroll)
+ (define-key map "!" #'vip-command-argument)
+ (define-key map "\"" #'vip-command-argument)
+ (define-key map "#" #'vip-command-argument)
+ (define-key map "$" #'vip-goto-eol)
+ (define-key map "%" #'vip-paren-match)
+ (define-key map "&" #'vip-nil)
+ (define-key map "'" #'vip-goto-mark-and-skip-white)
+ (define-key map "(" #'vip-backward-sentence)
+ (define-key map ")" #'vip-forward-sentence)
+ (define-key map "*" #'call-last-kbd-macro)
+ (define-key map "+" #'vip-next-line-at-bol)
+ (define-key map "," #'vip-repeat-find-opposite)
+ (define-key map "-" #'vip-previous-line-at-bol)
+ (define-key map "." #'vip-repeat)
+ (define-key map "/" #'vip-search-forward)
+
+ (define-key map "0" #'vip-beginning-of-line)
+ (define-key map "1" #'vip-digit-argument)
+ (define-key map "2" #'vip-digit-argument)
+ (define-key map "3" #'vip-digit-argument)
+ (define-key map "4" #'vip-digit-argument)
+ (define-key map "5" #'vip-digit-argument)
+ (define-key map "6" #'vip-digit-argument)
+ (define-key map "7" #'vip-digit-argument)
+ (define-key map "8" #'vip-digit-argument)
+ (define-key map "9" #'vip-digit-argument)
+
+ (define-key map ":" #'vip-ex)
+ (define-key map ";" #'vip-repeat-find)
+ (define-key map "<" #'vip-command-argument)
+ (define-key map "=" #'vip-command-argument)
+ (define-key map ">" #'vip-command-argument)
+ (define-key map "?" #'vip-search-backward)
+ (define-key map "@" #'vip-nil)
+
+ (define-key map "A" #'vip-Append)
+ (define-key map "B" #'vip-backward-Word)
+ (define-key map "C" #'vip-ctl-c-equivalent)
+ (define-key map "D" #'vip-kill-line)
+ (define-key map "E" #'vip-end-of-Word)
+ (define-key map "F" #'vip-find-char-backward)
+ (define-key map "G" #'vip-goto-line)
+ (define-key map "H" #'vip-window-top)
+ (define-key map "I" #'vip-Insert)
+ (define-key map "J" #'vip-join-lines)
+ (define-key map "K" #'vip-kill-buffer)
+ (define-key map "L" #'vip-window-bottom)
+ (define-key map "M" #'vip-window-middle)
+ (define-key map "N" #'vip-search-Next)
+ (define-key map "O" #'vip-Open-line)
+ (define-key map "P" #'vip-Put-back)
+ (define-key map "Q" #'vip-query-replace)
+ (define-key map "R" #'vip-replace-string)
+ (define-key map "S" #'vip-switch-to-buffer-other-window)
+ (define-key map "T" #'vip-goto-char-backward)
+ (define-key map "U" #'vip-nil)
+ (define-key map "V" #'vip-find-file-other-window)
+ (define-key map "W" #'vip-forward-Word)
+ (define-key map "X" #'vip-ctl-x-equivalent)
+ (define-key map "Y" #'vip-yank-line)
+ (define-key map "ZZ" #'save-buffers-kill-emacs)
+
+ (define-key map "[" #'vip-nil)
+ (define-key map "\\" #'vip-escape-to-emacs)
+ (define-key map "]" #'vip-nil)
+ (define-key map "^" #'vip-bol-and-skip-white)
+ (define-key map "_" #'vip-nil)
+ (define-key map "`" #'vip-goto-mark)
+
+ (define-key map "a" #'vip-append)
+ (define-key map "b" #'vip-backward-word)
+ (define-key map "c" #'vip-command-argument)
+ (define-key map "d" #'vip-command-argument)
+ (define-key map "e" #'vip-end-of-word)
+ (define-key map "f" #'vip-find-char-forward)
+ (define-key map "g" #'vip-info-on-file)
+ (define-key map "h" #'vip-backward-char)
+ (define-key map "i" #'vip-insert)
+ (define-key map "j" #'vip-next-line)
+ (define-key map "k" #'vip-previous-line)
+ (define-key map "l" #'vip-forward-char)
+ (define-key map "m" #'vip-mark-point)
+ (define-key map "n" #'vip-search-next)
+ (define-key map "o" #'vip-open-line)
+ (define-key map "p" #'vip-put-back)
+ (define-key map "q" #'vip-nil)
+ (define-key map "r" #'vip-replace-char)
+ (define-key map "s" #'vip-switch-to-buffer)
+ (define-key map "t" #'vip-goto-char-forward)
+ (define-key map "u" #'vip-undo)
+ (define-key map "v" #'vip-find-file)
+ (define-key map "w" #'vip-forward-word)
+ (define-key map "x" #'vip-delete-char)
+ (define-key map "y" #'vip-command-argument)
+ (define-key map "zH" #'vip-line-to-top)
+ (define-key map "zM" #'vip-line-to-middle)
+ (define-key map "zL" #'vip-line-to-bottom)
+ (define-key map "z\C-m" #'vip-line-to-top)
+ (define-key map "z." #'vip-line-to-middle)
+ (define-key map "z-" #'vip-line-to-bottom)
+
+ (define-key map "{" #'vip-backward-paragraph)
+ (define-key map "|" #'vip-goto-col)
+ (define-key map "}" #'vip-forward-paragraph)
+ (define-key map "~" #'vip-nil)
+ (define-key map "\177" #'vip-delete-backward-char)
map))
(defun vip-version ()
@@ -306,8 +298,8 @@ If nil then it is bound to `delete-backward-char'."
;;;###autoload
(defun vip-setup ()
"Set up bindings for C-x 7 and C-z that are useful for VIP users."
- (define-key ctl-x-map "7" 'vip-buffer-in-two-windows)
- (global-set-key "\C-z" 'vip-change-mode-to-vi))
+ (define-key ctl-x-map "7" #'vip-buffer-in-two-windows)
+ (global-set-key "\C-z" #'vip-change-mode-to-vi))
(defmacro vip-loop (count body)
"(COUNT BODY) Execute BODY COUNT times."
@@ -375,13 +367,13 @@ No message."
vip-emacs-local-map)))
(vip-change-mode-line "Insert")
(use-local-map vip-insert-local-map)
- (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi)
- (define-key vip-insert-local-map "\C-z" 'vip-ESC)
+ (define-key vip-insert-local-map "\e" #'vip-change-mode-to-vi)
+ (define-key vip-insert-local-map "\C-z" #'vip-ESC)
(define-key vip-insert-local-map "\C-h"
- (if vip-help-in-insert-mode 'help-command
- 'delete-backward-char))
+ (if vip-help-in-insert-mode #'help-command
+ #'delete-backward-char))
(define-key vip-insert-local-map "\C-w"
- 'vip-delete-backward-word))
+ #'vip-delete-backward-word))
((eq new-mode 'emacs-mode)
(vip-change-mode-line "Emacs:")
(use-local-map vip-emacs-local-map)))
@@ -461,13 +453,13 @@ Type `n' to quit this window for now.\n")
ARG is used as the prefix value for the executed command. If
EVENTS is a list of events, which become the beginning of the command."
(interactive "P")
- (let (com key (old-map (current-local-map)))
+ (let (com (old-map (current-local-map)))
(if events (setq unread-command-events
(append events unread-command-events)))
(setq prefix-arg arg)
(use-local-map vip-emacs-local-map)
(unwind-protect
- (setq com (key-binding (setq key (read-key-sequence nil))))
+ (setq com (key-binding (read-key-sequence nil)))
(use-local-map old-map))
(command-execute com prefix-arg)
(setq prefix-arg nil) ;; reset prefix arg
@@ -617,7 +609,7 @@ obtained so far, and COM is the command part obtained so far."
(defun vip-command-argument (arg)
"Accept a motion command as an argument."
(interactive "P")
- (condition-case conditions
+ (condition-case nil
(vip-prefix-arg-com
last-command-event
(cond ((null arg) nil)
@@ -918,11 +910,11 @@ each line in the region."
(defun vip-read-string (prompt &optional init)
(setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map))
- (define-key minibuffer-local-map "\C-h" 'backward-char)
- (define-key minibuffer-local-map "\C-w" 'backward-word)
- (define-key minibuffer-local-map "\e" 'exit-minibuffer)
+ (define-key minibuffer-local-map "\C-h" #'backward-char)
+ (define-key minibuffer-local-map "\C-w" #'backward-word)
+ (define-key minibuffer-local-map "\e" #'exit-minibuffer)
(let (str)
- (condition-case conditions
+ (condition-case nil
(setq str (read-string prompt init))
(quit
(setq minibuffer-local-map vip-save-minibuffer-local-map)
@@ -2651,7 +2643,7 @@ a token has type \(command, address, end-mark) and value."
(progn
(with-output-to-temp-buffer " *delete text*"
(princ (buffer-substring (point) (mark))))
- (condition-case conditions
+ (condition-case nil
(vip-read-string "[Hit return to continue] ")
(quit
(save-excursion (kill-buffer " *delete text*"))
@@ -2759,7 +2751,7 @@ a token has type \(command, address, end-mark) and value."
(progn
(with-output-to-temp-buffer " *text*"
(princ (buffer-substring (point) (mark))))
- (condition-case conditions
+ (condition-case nil
(progn
(vip-read-string "[Hit return to continue] ")
(ex-line-subr com (point) (mark)))
@@ -2829,12 +2821,9 @@ a token has type \(command, address, end-mark) and value."
(define-key ex-map char
(or (lookup-key vip-mode-map char) 'vip-nil)))
(define-key vip-mode-map char
- (eval
- (list 'quote
- (cons 'lambda
- (list '(count)
- '(interactive "p")
- (list 'execute-kbd-macro string 'count))))))))
+ (lambda (count)
+ (interactive "p")
+ (execute-kbd-macro string count)))))
(defun ex-unmap ()
"ex unmap"
@@ -2892,10 +2881,7 @@ a token has type \(command, address, end-mark) and value."
(with-no-warnings
(insert-file file)))))
-(defun ex-set ()
- (eval (list 'setq
- (read-variable "Variable: ")
- (eval (read-minibuffer "Value: ")))))
+(defalias 'ex-set #'set-variable)
(defun ex-shell ()
"ex shell"
@@ -2935,7 +2921,7 @@ vip-s-string"
(setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
;(setq G opt-g)
(let ((beg (car ex-addresses)) (end (car (cdr ex-addresses)))
- (cont t) eol-mark)
+ eol-mark) ;;(cont t)
(save-excursion
(vip-enlarge-region beg end)
(let ((limit (save-excursion
diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el
index d1ced86c468..235a1d7e43d 100644
--- a/lisp/obsolete/ws-mode.el
+++ b/lisp/obsolete/ws-mode.el
@@ -41,144 +41,144 @@
(defvar wordstar-C-k-map
(let ((map (make-keymap)))
(define-key map " " ())
- (define-key map "0" 'ws-set-marker-0)
- (define-key map "1" 'ws-set-marker-1)
- (define-key map "2" 'ws-set-marker-2)
- (define-key map "3" 'ws-set-marker-3)
- (define-key map "4" 'ws-set-marker-4)
- (define-key map "5" 'ws-set-marker-5)
- (define-key map "6" 'ws-set-marker-6)
- (define-key map "7" 'ws-set-marker-7)
- (define-key map "8" 'ws-set-marker-8)
- (define-key map "9" 'ws-set-marker-9)
- (define-key map "b" 'ws-begin-block)
- (define-key map "\C-b" 'ws-begin-block)
- (define-key map "c" 'ws-copy-block)
- (define-key map "\C-c" 'ws-copy-block)
- (define-key map "d" 'save-buffers-kill-emacs)
- (define-key map "\C-d" 'save-buffers-kill-emacs)
- (define-key map "f" 'find-file)
- (define-key map "\C-f" 'find-file)
- (define-key map "h" 'ws-show-markers)
- (define-key map "\C-h" 'ws-show-markers)
- (define-key map "i" 'ws-indent-block)
- (define-key map "\C-i" 'ws-indent-block)
- (define-key map "k" 'ws-end-block)
- (define-key map "\C-k" 'ws-end-block)
- (define-key map "p" 'ws-print-block)
- (define-key map "\C-p" 'ws-print-block)
- (define-key map "q" 'kill-emacs)
- (define-key map "\C-q" 'kill-emacs)
- (define-key map "r" 'insert-file)
- (define-key map "\C-r" 'insert-file)
- (define-key map "s" 'save-some-buffers)
- (define-key map "\C-s" 'save-some-buffers)
- (define-key map "t" 'ws-mark-word)
- (define-key map "\C-t" 'ws-mark-word)
- (define-key map "u" 'ws-exdent-block)
- (define-key map "\C-u" 'keyboard-quit)
- (define-key map "v" 'ws-move-block)
- (define-key map "\C-v" 'ws-move-block)
- (define-key map "w" 'ws-write-block)
- (define-key map "\C-w" 'ws-write-block)
- (define-key map "x" 'save-buffers-kill-emacs)
- (define-key map "\C-x" 'save-buffers-kill-emacs)
- (define-key map "y" 'ws-delete-block)
- (define-key map "\C-y" 'ws-delete-block)
+ (define-key map "0" #'ws-set-marker-0)
+ (define-key map "1" #'ws-set-marker-1)
+ (define-key map "2" #'ws-set-marker-2)
+ (define-key map "3" #'ws-set-marker-3)
+ (define-key map "4" #'ws-set-marker-4)
+ (define-key map "5" #'ws-set-marker-5)
+ (define-key map "6" #'ws-set-marker-6)
+ (define-key map "7" #'ws-set-marker-7)
+ (define-key map "8" #'ws-set-marker-8)
+ (define-key map "9" #'ws-set-marker-9)
+ (define-key map "b" #'ws-begin-block)
+ (define-key map "\C-b" #'ws-begin-block)
+ (define-key map "c" #'ws-copy-block)
+ (define-key map "\C-c" #'ws-copy-block)
+ (define-key map "d" #'save-buffers-kill-emacs)
+ (define-key map "\C-d" #'save-buffers-kill-emacs)
+ (define-key map "f" #'find-file)
+ (define-key map "\C-f" #'find-file)
+ (define-key map "h" #'ws-show-markers)
+ (define-key map "\C-h" #'ws-show-markers)
+ (define-key map "i" #'ws-indent-block)
+ (define-key map "\C-i" #'ws-indent-block)
+ (define-key map "k" #'ws-end-block)
+ (define-key map "\C-k" #'ws-end-block)
+ (define-key map "p" #'ws-print-block)
+ (define-key map "\C-p" #'ws-print-block)
+ (define-key map "q" #'kill-emacs)
+ (define-key map "\C-q" #'kill-emacs)
+ (define-key map "r" #'insert-file)
+ (define-key map "\C-r" #'insert-file)
+ (define-key map "s" #'save-some-buffers)
+ (define-key map "\C-s" #'save-some-buffers)
+ (define-key map "t" #'ws-mark-word)
+ (define-key map "\C-t" #'ws-mark-word)
+ (define-key map "u" #'ws-exdent-block)
+ (define-key map "\C-u" #'keyboard-quit)
+ (define-key map "v" #'ws-move-block)
+ (define-key map "\C-v" #'ws-move-block)
+ (define-key map "w" #'ws-write-block)
+ (define-key map "\C-w" #'ws-write-block)
+ (define-key map "x" #'save-buffers-kill-emacs)
+ (define-key map "\C-x" #'save-buffers-kill-emacs)
+ (define-key map "y" #'ws-delete-block)
+ (define-key map "\C-y" #'ws-delete-block)
map))
(defvar wordstar-C-o-map
(let ((map (make-keymap)))
(define-key map " " ())
- (define-key map "c" 'wordstar-center-line)
- (define-key map "\C-c" 'wordstar-center-line)
- (define-key map "b" 'switch-to-buffer)
- (define-key map "\C-b" 'switch-to-buffer)
- (define-key map "j" 'justify-current-line)
- (define-key map "\C-j" 'justify-current-line)
- (define-key map "k" 'kill-buffer)
- (define-key map "\C-k" 'kill-buffer)
- (define-key map "l" 'list-buffers)
- (define-key map "\C-l" 'list-buffers)
- (define-key map "m" 'auto-fill-mode)
- (define-key map "\C-m" 'auto-fill-mode)
- (define-key map "r" 'set-fill-column)
- (define-key map "\C-r" 'set-fill-column)
- (define-key map "\C-u" 'keyboard-quit)
- (define-key map "wd" 'delete-other-windows)
- (define-key map "wh" 'split-window-right)
- (define-key map "wo" 'other-window)
- (define-key map "wv" 'split-window-below)
+ (define-key map "c" #'wordstar-center-line)
+ (define-key map "\C-c" #'wordstar-center-line)
+ (define-key map "b" #'switch-to-buffer)
+ (define-key map "\C-b" #'switch-to-buffer)
+ (define-key map "j" #'justify-current-line)
+ (define-key map "\C-j" #'justify-current-line)
+ (define-key map "k" #'kill-buffer)
+ (define-key map "\C-k" #'kill-buffer)
+ (define-key map "l" #'list-buffers)
+ (define-key map "\C-l" #'list-buffers)
+ (define-key map "m" #'auto-fill-mode)
+ (define-key map "\C-m" #'auto-fill-mode)
+ (define-key map "r" #'set-fill-column)
+ (define-key map "\C-r" #'set-fill-column)
+ (define-key map "\C-u" #'keyboard-quit)
+ (define-key map "wd" #'delete-other-windows)
+ (define-key map "wh" #'split-window-right)
+ (define-key map "wo" #'other-window)
+ (define-key map "wv" #'split-window-below)
map))
(defvar wordstar-C-q-map
(let ((map (make-keymap)))
(define-key map " " ())
- (define-key map "0" 'ws-find-marker-0)
- (define-key map "1" 'ws-find-marker-1)
- (define-key map "2" 'ws-find-marker-2)
- (define-key map "3" 'ws-find-marker-3)
- (define-key map "4" 'ws-find-marker-4)
- (define-key map "5" 'ws-find-marker-5)
- (define-key map "6" 'ws-find-marker-6)
- (define-key map "7" 'ws-find-marker-7)
- (define-key map "8" 'ws-find-marker-8)
- (define-key map "9" 'ws-find-marker-9)
- (define-key map "a" 'ws-query-replace)
- (define-key map "\C-a" 'ws-query-replace)
- (define-key map "b" 'ws-goto-block-begin)
- (define-key map "\C-b" 'ws-goto-block-begin)
- (define-key map "c" 'end-of-buffer)
- (define-key map "\C-c" 'end-of-buffer)
- (define-key map "d" 'end-of-line)
- (define-key map "\C-d" 'end-of-line)
- (define-key map "f" 'ws-search)
- (define-key map "\C-f" 'ws-search)
- (define-key map "k" 'ws-goto-block-end)
- (define-key map "\C-k" 'ws-goto-block-end)
- (define-key map "l" 'ws-undo)
- (define-key map "\C-l" 'ws-undo)
- (define-key map "p" 'ws-last-cursorp)
- (define-key map "\C-p" 'ws-last-cursorp)
- (define-key map "r" 'beginning-of-buffer)
- (define-key map "\C-r" 'beginning-of-buffer)
- (define-key map "s" 'beginning-of-line)
- (define-key map "\C-s" 'beginning-of-line)
- (define-key map "\C-u" 'keyboard-quit)
- (define-key map "w" 'ws-last-error)
- (define-key map "\C-w" 'ws-last-error)
- (define-key map "y" 'ws-kill-eol)
- (define-key map "\C-y" 'ws-kill-eol)
- (define-key map "\177" 'ws-kill-bol)
+ (define-key map "0" #'ws-find-marker-0)
+ (define-key map "1" #'ws-find-marker-1)
+ (define-key map "2" #'ws-find-marker-2)
+ (define-key map "3" #'ws-find-marker-3)
+ (define-key map "4" #'ws-find-marker-4)
+ (define-key map "5" #'ws-find-marker-5)
+ (define-key map "6" #'ws-find-marker-6)
+ (define-key map "7" #'ws-find-marker-7)
+ (define-key map "8" #'ws-find-marker-8)
+ (define-key map "9" #'ws-find-marker-9)
+ (define-key map "a" #'ws-query-replace)
+ (define-key map "\C-a" #'ws-query-replace)
+ (define-key map "b" #'ws-goto-block-begin)
+ (define-key map "\C-b" #'ws-goto-block-begin)
+ (define-key map "c" #'end-of-buffer)
+ (define-key map "\C-c" #'end-of-buffer)
+ (define-key map "d" #'end-of-line)
+ (define-key map "\C-d" #'end-of-line)
+ (define-key map "f" #'ws-search)
+ (define-key map "\C-f" #'ws-search)
+ (define-key map "k" #'ws-goto-block-end)
+ (define-key map "\C-k" #'ws-goto-block-end)
+ (define-key map "l" #'ws-undo)
+ (define-key map "\C-l" #'ws-undo)
+ ;; (define-key map "p" #'ws-last-cursorp)
+ ;; (define-key map "\C-p" #'ws-last-cursorp)
+ (define-key map "r" #'beginning-of-buffer)
+ (define-key map "\C-r" #'beginning-of-buffer)
+ (define-key map "s" #'beginning-of-line)
+ (define-key map "\C-s" #'beginning-of-line)
+ (define-key map "\C-u" #'keyboard-quit)
+ (define-key map "w" #'ws-last-error)
+ (define-key map "\C-w" #'ws-last-error)
+ (define-key map "y" #'ws-kill-eol)
+ (define-key map "\C-y" #'ws-kill-eol)
+ (define-key map "\177" #'ws-kill-bol)
map))
(defvar wordstar-mode-map
(let ((map (make-keymap)))
- (define-key map "\C-a" 'backward-word)
- (define-key map "\C-b" 'fill-paragraph)
- (define-key map "\C-c" 'scroll-up-command)
- (define-key map "\C-d" 'forward-char)
- (define-key map "\C-e" 'previous-line)
- (define-key map "\C-f" 'forward-word)
- (define-key map "\C-g" 'delete-char)
- (define-key map "\C-h" 'backward-char)
- (define-key map "\C-i" 'indent-for-tab-command)
- (define-key map "\C-j" 'help-for-help)
+ (define-key map "\C-a" #'backward-word)
+ (define-key map "\C-b" #'fill-paragraph)
+ (define-key map "\C-c" #'scroll-up-command)
+ (define-key map "\C-d" #'forward-char)
+ (define-key map "\C-e" #'previous-line)
+ (define-key map "\C-f" #'forward-word)
+ (define-key map "\C-g" #'delete-char)
+ (define-key map "\C-h" #'backward-char)
+ (define-key map "\C-i" #'indent-for-tab-command)
+ (define-key map "\C-j" #'help-for-help)
(define-key map "\C-k" wordstar-C-k-map)
- (define-key map "\C-l" 'ws-repeat-search)
- (define-key map "\C-n" 'open-line)
+ (define-key map "\C-l" #'ws-repeat-search)
+ (define-key map "\C-n" #'open-line)
(define-key map "\C-o" wordstar-C-o-map)
- (define-key map "\C-p" 'quoted-insert)
+ (define-key map "\C-p" #'quoted-insert)
(define-key map "\C-q" wordstar-C-q-map)
- (define-key map "\C-r" 'scroll-down-command)
- (define-key map "\C-s" 'backward-char)
- (define-key map "\C-t" 'kill-word)
- (define-key map "\C-u" 'keyboard-quit)
- (define-key map "\C-v" 'overwrite-mode)
- (define-key map "\C-w" 'scroll-down-line)
- (define-key map "\C-x" 'next-line)
- (define-key map "\C-y" 'kill-complete-line)
- (define-key map "\C-z" 'scroll-up-line)
+ (define-key map "\C-r" #'scroll-down-command)
+ (define-key map "\C-s" #'backward-char)
+ (define-key map "\C-t" #'kill-word)
+ (define-key map "\C-u" #'keyboard-quit)
+ (define-key map "\C-v" #'overwrite-mode)
+ (define-key map "\C-w" #'scroll-down-line)
+ (define-key map "\C-x" #'next-line)
+ (define-key map "\C-y" #'kill-complete-line)
+ (define-key map "\C-z" #'scroll-up-line)
map))
;; wordstar-C-j-map not yet implemented
diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el
index 76485f989c1..ca8de4f9224 100644
--- a/lisp/obsolete/yow.el
+++ b/lisp/obsolete/yow.el
@@ -1,4 +1,4 @@
-;;; yow.el --- quote random zippyisms
+;;; yow.el --- quote random zippyisms -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1995, 2000-2021 Free Software Foundation, Inc.
@@ -39,8 +39,7 @@
(defcustom yow-file (expand-file-name "yow.lines" data-directory)
"File containing pertinent pinhead phrases."
- :type 'file
- :group 'yow)
+ :type 'file)
(defconst yow-load-message "Am I CONSING yet?...")
(defconst yow-after-load-message "I have SEEN the CONSING!!")
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index df2d691f68b..9834509fb03 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -38,7 +38,7 @@
;; 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
+;; web page: https://technomancy.us/126
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 18d4f3c9388..b14849df691 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -44,7 +44,7 @@
BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-excursion' and
`save-match-data'."
- (declare (indent 1))
+ (declare (indent 1) (debug t))
`(progn
(unless (org-babel-comint-buffer-livep ,buffer)
(error "Buffer %s does not exist or has no process" ,buffer))
@@ -53,7 +53,6 @@ executed inside the protection of `save-excursion' and
(save-excursion
(let ((comint-input-filter (lambda (_input) nil)))
,@body))))))
-(def-edebug-spec org-babel-comint-in-buffer (form body))
(defmacro org-babel-comint-with-output (meta &rest body)
"Evaluate BODY in BUFFER and return process output.
@@ -67,7 +66,7 @@ elements are optional.
This macro ensures that the filter is removed in case of an error
or user `keyboard-quit' during execution of body."
- (declare (indent 1))
+ (declare (indent 1) (debug (sexp body)))
(let ((buffer (nth 0 meta))
(eoe-indicator (nth 1 meta))
(remove-echo (nth 2 meta))
@@ -112,7 +111,6 @@ or user `keyboard-quit' during execution of body."
string-buffer))
(setq string-buffer (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
-(def-edebug-spec org-babel-comint-with-output (sexp body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 1343410792a..b1fd6943716 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -1100,7 +1100,7 @@ end-header-args -- point at the end of the header-args
body ------------- string holding the body of the code block
beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
- (declare (indent 1))
+ (declare (indent 1) (debug t))
(let ((tempvar (make-symbol "file")))
`(let* ((case-fold-search t)
(,tempvar ,file)
@@ -1139,7 +1139,6 @@ end-body --------- point at the end of the body"
(goto-char end-block)))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
-(def-edebug-spec org-babel-map-src-blocks (form body))
;;;###autoload
(defmacro org-babel-map-inline-src-blocks (file &rest body)
@@ -1354,7 +1353,7 @@ the `org-mode-hook'."
(goto-char (match-beginning 0))
(org-babel-hide-hash)
(goto-char (match-end 0))))))
-(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
+(add-hook 'org-mode-hook #'org-babel-hide-all-hashes)
(defun org-babel-hash-at-point (&optional point)
"Return the value of the hash at POINT.
@@ -1372,7 +1371,7 @@ This can be called with `\\[org-ctrl-c-ctrl-c]'."
Add `org-babel-hide-result' as an invisibility spec for hiding
portions of results lines."
(add-to-invisibility-spec '(org-babel-hide-result . t)))
-(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
+(add-hook 'org-mode-hook #'org-babel-result-hide-spec)
(defvar org-babel-hide-result-overlays nil
"Overlays hiding results.")
@@ -1443,11 +1442,11 @@ portions of results lines."
(push ov org-babel-hide-result-overlays)))))
;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
+(add-hook 'org-tab-first-hook #'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
(lambda () (add-hook 'change-major-mode-hook
- 'org-babel-show-result-all 'append 'local)))
+ #'org-babel-show-result-all 'append 'local)))
(defun org-babel-params-from-properties (&optional lang no-eval)
"Retrieve source block parameters specified as properties.
@@ -3075,8 +3074,7 @@ Emacs shutdown."))
(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
"Call the code to parse raw string results according to RESULT-PARAMS."
- (declare (indent 1)
- (debug (form form &rest form)))
+ (declare (indent 1) (debug t))
(org-with-gensyms (params)
`(let ((,params ,result-params))
(unless (member "none" ,params)
@@ -3093,7 +3091,6 @@ Emacs shutdown."))
(not (member "table" ,params))))
,scalar-form
,@table-forms)))))
-(def-edebug-spec org-babel-result-cond (form form body))
(defun org-babel-temp-file (prefix &optional suffix)
"Create a temporary file in the `org-babel-temporary-directory'.
@@ -3136,7 +3133,7 @@ of `org-babel-temporary-directory'."
org-babel-temporary-directory
"[directory not defined]"))))))
-(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+(add-hook 'kill-emacs-hook #'org-babel-remove-temporary-directory)
(defun org-babel-one-header-arg-safe-p (pair safe-list)
"Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el
index 3d2f46cdce2..48dcb8cea1a 100644
--- a/lisp/org/ob-hledger.el
+++ b/lisp/org/ob-hledger.el
@@ -1,4 +1,4 @@
-;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
+;;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index fbdd905a5fe..47397e66259 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -220,7 +220,7 @@ If error in compilation, attempt to mark the error in lilypond org file."
FILE-NAME is full path to lilypond (.ly) file."
(message "Compiling LilyPond...")
(let ((arg-1 org-babel-lilypond-ly-command) ;program
- (arg-2 nil) ;infile
+ ;; (arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
(arg-5 (if org-babel-lilypond-gen-png "--png" "")) ;&rest...
@@ -231,10 +231,10 @@ FILE-NAME is full path to lilypond (.ly) file."
(arg-10 (concat "--output=" (file-name-sans-extension file-name)))
(arg-11 file-name))
(if test
- `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6
+ `(,arg-1 ,nil ,arg-3 ,arg-4 ,arg-5 ,arg-6 ;; arg-2
,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11)
(call-process
- arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
+ arg-1 nil arg-3 arg-4 arg-5 arg-6 ;; arg-2
arg-7 arg-8 arg-9 arg-10 arg-11))))
(defun org-babel-lilypond-check-for-compile-error (file-name &optional test)
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index 999d4f4140b..79c9f8702eb 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -1,4 +1,4 @@
-;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
+;;; ob-mscgen.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -78,4 +78,4 @@ mscgen supported formats."
(provide 'ob-mscgen)
-;;; ob-msc.el ends here
+;;; ob-mscgen.el ends here
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index 0aa91afdb24..5fd6d1e09ff 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -32,7 +32,7 @@
;;; Requirements:
-;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/
+;; - tuareg-mode :: https://www-rocq.inria.fr/~acohen/tuareg/
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index 3c3943c8fa9..aa0373ab88e 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -150,7 +150,7 @@ represented in the file."
"Open FILE into a temporary buffer execute BODY there like
`progn', then kill the FILE buffer returning the result of
evaluating BODY."
- (declare (indent 1))
+ (declare (indent 1) (debug t))
(let ((temp-path (make-symbol "temp-path"))
(temp-result (make-symbol "temp-result"))
(temp-file (make-symbol "temp-file"))
@@ -164,7 +164,6 @@ evaluating BODY."
(setf ,temp-result (progn ,@body)))
(unless ,visited-p (kill-buffer ,temp-file))
,temp-result)))
-(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang-re)
diff --git a/lisp/org/ol-eshell.el b/lisp/org/ol-eshell.el
index 769e7ee5225..8920e0afb0d 100644
--- a/lisp/org/ol-eshell.el
+++ b/lisp/org/ol-eshell.el
@@ -1,4 +1,4 @@
-;;; ol-eshell.el - Links to Working Directories in Eshell -*- lexical-binding: t; -*-
+;;; ol-eshell.el --- Links to Working Directories in Eshell -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el
index 71051bc6830..2d51447e0c4 100644
--- a/lisp/org/ol-gnus.el
+++ b/lisp/org/ol-gnus.el
@@ -198,11 +198,11 @@ If `org-store-link' was called with a prefix arg the meaning of
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))
- newsgroup xarchive) ;those are always nil for gcc
+ ) ;; newsgroup xarchive ;those are always nil for gcc
(unless gcc (error "Can not create link: No Gcc header found"))
(org-link-store-props :type "gnus" :from from :subject subject
:message-id id :group gcc :to to)
- (let ((link (org-gnus-article-link gcc newsgroup id xarchive))
+ (let ((link (org-gnus-article-link gcc nil id nil)) ;;newsgroup xarchive
(description (org-link-email-description)))
(org-link-add-props :link link :description description)
link)))))))
diff --git a/lisp/org/ol-irc.el b/lisp/org/ol-irc.el
index e3d7651c1a1..df62dd06257 100644
--- a/lisp/org/ol-irc.el
+++ b/lisp/org/ol-irc.el
@@ -39,9 +39,9 @@
;;
;; Links within an org buffer might look like this:
;;
-;; [[irc:/irc.freenode.net/#emacs/bob][chat with bob in #emacs on freenode]]
-;; [[irc:/irc.freenode.net/#emacs][#emacs on freenode]]
-;; [[irc:/irc.freenode.net/]]
+;; [[irc:/irc.libera.chat/#emacs/bob][chat with bob in #emacs on Libera.Chat]]
+;; [[irc:/irc.libera.chat/#emacs][#emacs on Libera.Chat]]
+;; [[irc:/irc.libera.chat/]]
;;
;; If, when the resulting link is visited, there is no connection to a
;; requested server then one will be created.
diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el
index f1f3afd764d..ebb11ce3d54 100644
--- a/lisp/org/ol-w3m.el
+++ b/lisp/org/ol-w3m.el
@@ -7,13 +7,13 @@
;; Homepage: https://orgmode.org
;;
;; This file is part of GNU Emacs.
-;;
-;; This program is free software: you can redistribute it and/or modify
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 994e30f4f43..38e2dd6a02c 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -591,7 +591,7 @@ 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 can continue with other options like
+nil to indicate that Org can continue with other options like
exact and fuzzy text search.")
@@ -1467,7 +1467,7 @@ non-nil."
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
- (let (link cpltxt desc description search custom-id agenda-link)
+ (let (link cpltxt desc search custom-id agenda-link) ;; description
(cond
;; Store a link using an external link type, if any function is
;; available. If more than one can generate a link from current
@@ -1598,7 +1598,7 @@ non-nil."
'org-create-file-search-functions))
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
"::" search))
- (setq cpltxt (or description link)))
+ (setq cpltxt (or link))) ;; description
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(org-with-limited-levels
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 99e5464c2b9..3acc18715dd 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -2090,6 +2090,7 @@ Note that functions in this alist don't need to be quoted."
If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
+ (declare (debug t))
(org-with-gensyms (marker)
`(let ((,marker (get-text-property (if ,string 0 (point-at-bol))
'org-hd-marker ,string)))
@@ -2097,7 +2098,6 @@ of the current line."
(save-excursion
(goto-char ,marker)
,@body)))))
-(def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
(defun org-add-agenda-custom-command (entry)
"Replace or add a command in `org-agenda-custom-commands'.
@@ -3205,7 +3205,7 @@ s Search for keywords M Like m, but only TODO entries
(delete-window)
(org-agenda-get-restriction-and-command prefix-descriptions))
- ((equal c ?q) (error "Abort"))
+ ((equal c ?q) (user-error "Abort"))
(t (user-error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
@@ -3224,6 +3224,15 @@ s Search for keywords M Like m, but only TODO entries
(defvar org-agenda-overriding-cmd nil)
(defvar org-agenda-overriding-arguments nil)
(defvar org-agenda-overriding-cmd-arguments nil)
+
+(defun org-let (list &rest body) ;FIXME: So many kittens are suffering here.
+ (declare (indent 1))
+ (eval (cons 'let (cons list body))))
+
+(defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
+ (declare (indent 2))
+ (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
+
(defun org-agenda-run-series (name series)
"Run agenda NAME as a SERIES of agenda commands."
(org-let (nth 1 series) '(org-agenda-prepare name))
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index f40f2b335ef..7ae8fae3aab 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -521,7 +521,7 @@ for a capture buffer.")
"Minor mode for special key bindings in a capture buffer.
Turning on this mode runs the normal hook `org-capture-mode-hook'."
- nil " Cap" org-capture-mode-map
+ :lighter " Cap"
(setq-local
header-line-format
(substitute-command-keys
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 2073b33380b..1283970bc2b 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -539,8 +539,8 @@ of a different task.")
"Marker pointing to the task that has been interrupted by the current clock.")
(defvar org-clock-mode-line-map (make-sparse-keymap))
-(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)
+(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.
@@ -911,17 +911,17 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
(defmacro org-with-clock-position (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock."
+ (declare (indent 1) (debug t))
`(with-current-buffer (marker-buffer (car ,clock))
(org-with-wide-buffer
(goto-char (car ,clock))
(beginning-of-line)
,@forms)))
-(def-edebug-spec org-with-clock-position (form body))
-(put 'org-with-clock-position 'lisp-indent-function 1)
(defmacro org-with-clock (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock.
This macro also protects the current active clock from being altered."
+ (declare (indent 1) (debug t))
`(org-with-clock-position ,clock
(let ((org-clock-start-time (cdr ,clock))
(org-clock-total-time)
@@ -932,8 +932,6 @@ This macro also protects the current active clock from being altered."
(org-back-to-heading t)
(point-marker))))
,@forms)))
-(def-edebug-spec org-with-clock (form body))
-(put 'org-with-clock 'lisp-indent-function 1)
(defsubst org-clock-clock-in (clock &optional resume start-time)
"Clock in to the clock located by CLOCK.
@@ -1416,12 +1414,12 @@ the default behavior."
(setq org-clock-mode-line-timer
(run-with-timer org-clock-update-period
org-clock-update-period
- 'org-clock-update-mode-line)))
+ #'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))
+ (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))))))
@@ -1718,7 +1716,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
-(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
+(add-hook 'org-clock-out-hook #'org-clock-remove-empty-clock-drawer)
(defun org-clock-remove-empty-clock-drawer ()
"Remove empty clock drawers in current subtree."
@@ -2014,7 +2012,7 @@ Use `\\[org-clock-remove-overlays]' to remove the subtree times."
(when time (org-clock-put-overlay time)))))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
- (add-hook 'before-change-functions 'org-clock-remove-overlays
+ (add-hook 'before-change-functions #'org-clock-remove-overlays
nil 'local))))
(let* ((h (/ org-clock-file-total-minutes 60))
(m (- org-clock-file-total-minutes (* 60 h))))
@@ -2065,7 +2063,7 @@ If NOREMOVE is nil, remove this function from the
(setq org-clock-overlays nil)
(unless noremove
(remove-hook 'before-change-functions
- 'org-clock-remove-overlays 'local))))
+ #'org-clock-remove-overlays 'local))))
;;;###autoload
(defun org-clock-out-if-current ()
@@ -2241,7 +2239,7 @@ have priority."
((>= month 7) 3)
((>= month 4) 2)
(t 1)))
- m1 h1 d1 month1 y1 shiftedy shiftedm shiftedq)
+ h1 d1 month1 y1 shiftedy shiftedm shiftedq) ;; m1
(cond
((string-match "\\`[0-9]+\\'" skey)
(setq y (string-to-number skey) month 1 d 1 key 'year))
@@ -2344,7 +2342,7 @@ have priority."
(`interactive (org-read-date nil t nil "Range end? "))
(`untilnow (current-time))
(_ (encode-time 0
- (or m1 m)
+ m ;; (or m1 m)
(or h1 h)
(or d1 d)
(or month1 month)
@@ -2391,7 +2389,7 @@ the currently selected interval size."
(user-error "Line needs a :block definition before this command works")
(let* ((b (match-beginning 1)) (e (match-end 1))
(s (match-string 1))
- block shift ins y mw d date wp m)
+ block shift ins y mw d date wp) ;; m
(cond
((equal s "yesterday") (setq s "today-1"))
((equal s "lastweek") (setq s "thisweek-1"))
@@ -2416,7 +2414,7 @@ the currently selected interval size."
(cond
(d (setq ins (format-time-string
"%Y-%m-%d"
- (encode-time 0 0 0 (+ d n) m y))))
+ (encode-time 0 0 0 (+ d n) nil y)))) ;; m
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
@@ -2934,12 +2932,12 @@ PROPERTIES: The list properties specified in the `:properties' parameter
(save-excursion
(org-clock-sum ts te
(when matcher
- `(lambda ()
- (let* ((todo (org-get-todo-state))
- (tags-list (org-get-tags))
- (org-scanner-tags tags-list)
- (org-trust-scanner-tags t))
- (funcall ,matcher todo tags-list nil)))))
+ (lambda ()
+ (let* ((todo (org-get-todo-state))
+ (tags-list (org-get-tags))
+ (org-scanner-tags tags-list)
+ (org-trust-scanner-tags t))
+ (funcall matcher todo tags-list nil)))))
(goto-char (point-min))
(setq st t)
(while (or (and (bobp) (prog1 st (setq st nil))
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 75056d45a7e..2f039064404 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -162,20 +162,20 @@ See `org-columns-summary-types' for details.")
(org-overview)
(org-content))
-(org-defkey org-columns-map "c" 'org-columns-content)
-(org-defkey org-columns-map "o" 'org-overview)
-(org-defkey org-columns-map "e" 'org-columns-edit-value)
-(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo)
-(org-defkey org-columns-map "\C-c\C-c" 'org-columns-toggle-or-columns-quit)
-(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link)
-(org-defkey org-columns-map "v" 'org-columns-show-value)
-(org-defkey org-columns-map "q" 'org-columns-quit)
-(org-defkey org-columns-map "r" 'org-columns-redo)
-(org-defkey org-columns-map "g" 'org-columns-redo)
-(org-defkey org-columns-map [left] 'backward-char)
-(org-defkey org-columns-map "\M-b" 'backward-char)
-(org-defkey org-columns-map "a" 'org-columns-edit-allowed)
-(org-defkey org-columns-map "s" 'org-columns-edit-attributes)
+(org-defkey org-columns-map "c" #'org-columns-content)
+(org-defkey org-columns-map "o" #'org-overview)
+(org-defkey org-columns-map "e" #'org-columns-edit-value)
+(org-defkey org-columns-map "\C-c\C-t" #'org-columns-todo)
+(org-defkey org-columns-map "\C-c\C-c" #'org-columns-toggle-or-columns-quit)
+(org-defkey org-columns-map "\C-c\C-o" #'org-columns-open-link)
+(org-defkey org-columns-map "v" #'org-columns-show-value)
+(org-defkey org-columns-map "q" #'org-columns-quit)
+(org-defkey org-columns-map "r" #'org-columns-redo)
+(org-defkey org-columns-map "g" #'org-columns-redo)
+(org-defkey org-columns-map [left] #'backward-char)
+(org-defkey org-columns-map "\M-b" #'backward-char)
+(org-defkey org-columns-map "a" #'org-columns-edit-allowed)
+(org-defkey org-columns-map "s" #'org-columns-edit-attributes)
(org-defkey org-columns-map "\M-f"
(lambda () (interactive) (goto-char (1+ (point)))))
(org-defkey org-columns-map [right]
@@ -187,7 +187,7 @@ See `org-columns-summary-types' for details.")
(while (and (org-invisible-p2) (not (eobp)))
(beginning-of-line 2))
(move-to-column col)
- (if (eq major-mode 'org-agenda-mode)
+ (if (derived-mode-p 'org-agenda-mode)
(org-agenda-do-context-action)))))
(org-defkey org-columns-map [up]
(lambda () (interactive)
@@ -198,20 +198,20 @@ See `org-columns-summary-types' for details.")
(move-to-column col)
(if (eq major-mode 'org-agenda-mode)
(org-agenda-do-context-action)))))
-(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value)
-(org-defkey org-columns-map "n" 'org-columns-next-allowed-value)
-(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value)
-(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value)
-(org-defkey org-columns-map "<" 'org-columns-narrow)
-(org-defkey org-columns-map ">" 'org-columns-widen)
-(org-defkey org-columns-map [(meta right)] 'org-columns-move-right)
-(org-defkey org-columns-map [(meta left)] 'org-columns-move-left)
-(org-defkey org-columns-map [(shift meta right)] 'org-columns-new)
-(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete)
+(org-defkey org-columns-map [(shift right)] #'org-columns-next-allowed-value)
+(org-defkey org-columns-map "n" #'org-columns-next-allowed-value)
+(org-defkey org-columns-map [(shift left)] #'org-columns-previous-allowed-value)
+(org-defkey org-columns-map "p" #'org-columns-previous-allowed-value)
+(org-defkey org-columns-map "<" #'org-columns-narrow)
+(org-defkey org-columns-map ">" #'org-columns-widen)
+(org-defkey org-columns-map [(meta right)] #'org-columns-move-right)
+(org-defkey org-columns-map [(meta left)] #'org-columns-move-left)
+(org-defkey org-columns-map [(shift meta right)] #'org-columns-new)
+(org-defkey org-columns-map [(shift meta left)] #'org-columns-delete)
(dotimes (i 10)
(org-defkey org-columns-map (number-to-string i)
- `(lambda () (interactive)
- (org-columns-next-allowed-value nil ,i))))
+ (lambda () (interactive)
+ (org-columns-next-allowed-value nil i))))
(easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
'("Column"
@@ -490,7 +490,7 @@ for the duration of the command.")
(org-add-props " " nil 'display `(space :align-to ,linum-offset))
(org-add-props (substring title 0 -1) nil 'face 'org-column-title)))
(setq org-columns-previous-hscroll -1)
- (add-hook 'post-command-hook 'org-columns-hscroll-title nil 'local)))
+ (add-hook 'post-command-hook #'org-columns-hscroll-title nil 'local)))
(defun org-columns-hscroll-title ()
"Set the `header-line-format' so that it scrolls along with the table."
@@ -519,7 +519,7 @@ for the duration of the command.")
(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))
+ (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))
@@ -782,7 +782,7 @@ around it."
(setq time-after (copy-sequence time))
(setf (nth 3 time-before) (1- (nth 3 time)))
(setf (nth 3 time-after) (1+ (nth 3 time)))
- (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
+ (mapcar (lambda (x) (format-time-string fmt (apply #'encode-time x)))
(list time-before time time-after)))))
(defun org-columns-open-link (&optional arg)
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 1f4e2e8308f..b68e5b58fca 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -1151,8 +1151,8 @@ key."
((guard (not (lookup-key calendar-mode-map "c")))
(local-set-key "c" #'org-calendar-goto-agenda))
(_ nil))
- (unless (and (boundp 'org-agenda-diary-file)
- (eq org-agenda-diary-file 'diary-file))
+ (when (and (boundp 'org-agenda-diary-file)
+ (not (eq org-agenda-diary-file 'diary-file)))
(local-set-key org-calendar-insert-diary-entry-key
#'org-agenda-diary-entry)))
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index caf9de91b98..103baeb49e0 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -284,6 +284,8 @@ Assume `epg-context' is set."
nil)))
(_ nil)))
+(defvar org--matcher-tags-todo-only)
+
;;;###autoload
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 1fca873c159..dc2b3be6326 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -1,5 +1,5 @@
-;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*-
-;;
+;;; org-ctags.el --- Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*-
+
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index b7319d638ed..31f5f78eae0 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -4206,6 +4206,7 @@ looking into captions:
(lambda (b)
(and (org-element-map b \\='latex-snippet #\\='identity nil t) b))
nil nil nil t)"
+ (declare (indent 2))
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
(let* ((types (if (listp types) types (list types)))
(no-recursion (if (listp no-recursion) no-recursion
@@ -4299,7 +4300,6 @@ looking into captions:
(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.
;;
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index c6bf416564e..3475cadc42d 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -167,7 +167,7 @@ properties, after each buffer modification, on the modified zone.
The process is synchronous. Though, initial indentation of
buffer, which can take a few seconds on large buffers, is done
during idle time."
- nil " Ind" nil
+ :lighter " Ind"
(cond
(org-indent-mode
;; mode was turned on.
diff --git a/lisp/org/org-install.el b/lisp/org/org-install.el
index 58359597363..d521d819db2 100644
--- a/lisp/org/org-install.el
+++ b/lisp/org/org-install.el
@@ -1,4 +1,4 @@
-;;; org-install.el --- backward compatibility file for obsolete configuration
+;;; org-install.el --- backward compatibility file for obsolete configuration -*- lexical-binding: t -*-
;;
;;; Code:
;;
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 39122e7ce41..f97164ee33b 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -2304,7 +2304,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is
;;;###autoload
(define-minor-mode org-list-checkbox-radio-mode
"When turned on, use list checkboxes as radio buttons."
- nil " CheckBoxRadio" nil
+ :lighter " CheckBoxRadio"
(unless (eq major-mode 'org-mode)
(user-error "Cannot turn this mode outside org-mode buffers")))
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 56afdf6ef19..58d3fd39922 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -627,18 +627,10 @@ program is needed for, so that the error message can be more informative."
(let ((message-log-max nil))
(apply #'message args)))
-(defun org-let (list &rest body)
- (eval (cons 'let (cons list body))))
-(put 'org-let 'lisp-indent-function 1)
-
-(defun org-let2 (list1 list2 &rest body)
- (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
-(put 'org-let2 'lisp-indent-function 2)
-
(defun org-eval (form)
"Eval FORM and return result."
(condition-case error
- (eval form)
+ (eval form t)
(error (format "%%![Error: %s]" error))))
(defvar org-outline-regexp) ; defined in org.el
@@ -877,7 +869,8 @@ delimiting S."
(let ((width (plist-get props :width)))
(and (wholenump width) width)))
(`(image . ,_)
- (ceiling (car (image-size spec))))
+ (and (fboundp 'image-size)
+ (ceiling (car (image-size spec)))))
((pred stringp)
;; Displayed string could contain invisible parts,
;; but no nested display.
@@ -1241,31 +1234,29 @@ Return 0. if S is not recognized as a valid value."
When ADDITIONAL-KEYS is not nil, also include SPC and DEL in the
allowed keys for scrolling, as expected in the export dispatch
window."
- (let ((scrlup (if additional-keys '(?\s 22) 22))
- (scrldn (if additional-keys `(?\d 134217846) 134217846)))
- (eval
- `(cl-case ,key
- ;; C-n
- (14 (if (not (pos-visible-in-window-p (point-max)))
- (ignore-errors (scroll-up 1))
- (message "End of buffer")
- (sit-for 1)))
- ;; C-p
- (16 (if (not (pos-visible-in-window-p (point-min)))
- (ignore-errors (scroll-down 1))
- (message "Beginning of buffer")
- (sit-for 1)))
- ;; SPC or
- (,scrlup
- (if (not (pos-visible-in-window-p (point-max)))
- (scroll-up nil)
- (message "End of buffer")
- (sit-for 1)))
- ;; DEL
- (,scrldn (if (not (pos-visible-in-window-p (point-min)))
- (scroll-down nil)
- (message "Beginning of buffer")
- (sit-for 1)))))))
+ (let ((scrlup (if additional-keys '(?\s ?\C-v) ?\C-v))
+ (scrldn (if additional-keys `(?\d ?\M-v) ?\M-v)))
+ (pcase key
+ (?\C-n (if (not (pos-visible-in-window-p (point-max)))
+ (ignore-errors (scroll-up 1))
+ (message "End of buffer")
+ (sit-for 1)))
+ (?\C-p (if (not (pos-visible-in-window-p (point-min)))
+ (ignore-errors (scroll-down 1))
+ (message "Beginning of buffer")
+ (sit-for 1)))
+ ;; SPC or
+ ((guard (memq key scrlup))
+ (if (not (pos-visible-in-window-p (point-max)))
+ (scroll-up nil)
+ (message "End of buffer")
+ (sit-for 1)))
+ ;; DEL
+ ((guard (memq key scrldn))
+ (if (not (pos-visible-in-window-p (point-min)))
+ (scroll-down nil)
+ (message "Beginning of buffer")
+ (sit-for 1))))))
(provide 'org-macs)
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 5c222ea70d5..57281dd68c0 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -167,14 +167,12 @@ indirectly, for example, through the agenda buffer.")
(defcustom org-mouse-punctuation ":"
"Punctuation used when inserting text by drag and drop."
- :group 'org-mouse
:type 'string)
(defcustom org-mouse-features
'(context-menu yank-link activate-stars activate-bullets activate-checkboxes)
"The features of org-mouse that should be activated.
Changing this variable requires a restart of Emacs to get activated."
- :group 'org-mouse
:type '(set :greedy t
(const :tag "Mouse-3 shows context menu" context-menu)
(const :tag "C-mouse-1 and mouse-3 move trees" move-tree)
@@ -292,19 +290,19 @@ argument. If it is a string, it is interpreted as the format
string to (format ITEMFORMAT keyword). If it is neither a string
nor a function, elements of KEYWORDS are used directly."
(mapcar
- `(lambda (keyword)
+ (lambda (keyword)
(vector (cond
- ((functionp ,itemformat) (funcall ,itemformat keyword))
- ((stringp ,itemformat) (format ,itemformat keyword))
+ ((functionp itemformat) (funcall itemformat keyword))
+ ((stringp itemformat) (format itemformat keyword))
(t keyword))
- (list 'funcall ,function keyword)
+ (list 'funcall function keyword)
:style (cond
- ((null ,selected) t)
- ((functionp ,selected) 'toggle)
+ ((null selected) t)
+ ((functionp selected) 'toggle)
(t 'radio))
- :selected (if (functionp ,selected)
- (and (funcall ,selected keyword) t)
- (equal ,selected keyword))))
+ :selected (if (functionp selected)
+ (and (funcall selected keyword) t)
+ (equal selected keyword))))
keywords))
(defun org-mouse-remove-match-and-spaces ()
@@ -344,12 +342,12 @@ string to (format ITEMFORMAT keyword). If it is neither a string
nor a function, elements of KEYWORDS are used directly."
(setq group (or group 0))
(let ((replace (org-mouse-match-closure
- (if nosurround 'replace-match
- 'org-mouse-replace-match-and-surround))))
+ (if nosurround #'replace-match
+ #'org-mouse-replace-match-and-surround))))
(append
(org-mouse-keyword-menu
keywords
- `(lambda (keyword) (funcall ,replace keyword t t nil ,group))
+ (lambda (keyword) (funcall replace keyword t t nil group))
(match-string group)
itemformat)
`(["None" org-mouse-remove-match-and-spaces
@@ -416,7 +414,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(let ((kwds org-todo-keywords-1))
(org-mouse-keyword-menu
kwds
- `(lambda (kwd) (org-todo kwd))
+ #'org-todo
(lambda (kwd) (equal state kwd))))))
(defun org-mouse-tag-menu () ;todo
@@ -424,14 +422,14 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(append
(let ((tags (org-get-tags nil t)))
(org-mouse-keyword-menu
- (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
- `(lambda (tag)
+ (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+ (lambda (tag)
(org-mouse-set-tags
- (sort (if (member tag (quote ,tags))
- (delete tag (quote ,tags))
- (cons tag (quote ,tags)))
- 'string-lessp)))
- `(lambda (tag) (member tag (quote ,tags)))
+ (sort (if (member tag tags)
+ (delete tag tags)
+ (cons tag tags))
+ #'string-lessp)))
+ (lambda (tag) (member tag tags))
))
'("--"
["Align Tags Here" (org-align-tags) t]
@@ -500,7 +498,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Check TODOs" org-show-todo-tree t]
("Check Tags"
,@(org-mouse-keyword-menu
- (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
+ (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
#'(lambda (tag) (org-tags-sparse-tree nil tag)))
"--"
["Custom Tag ..." org-tags-sparse-tree t])
@@ -510,16 +508,16 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Display TODO List" org-todo-list t]
("Display Tags"
,@(org-mouse-keyword-menu
- (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp)
+ (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
#'(lambda (tag) (org-tags-view nil tag)))
"--"
["Custom Tag ..." org-tags-view t])
["Display Calendar" org-goto-calendar t]
"--"
,@(org-mouse-keyword-menu
- (mapcar 'car org-agenda-custom-commands)
+ (mapcar #'car org-agenda-custom-commands)
#'(lambda (key)
- (eval `(org-agenda nil (string-to-char ,key))))
+ (org-agenda nil (string-to-char key)))
nil
#'(lambda (key)
(let ((entry (assoc key org-agenda-custom-commands)))
@@ -594,10 +592,10 @@ This means, between the beginning of line and the point."
(defun org-mouse-match-closure (function)
(let ((match (match-data t)))
- `(lambda (&rest rest)
- (save-match-data
- (set-match-data ',match)
- (apply ',function rest)))))
+ (lambda (&rest rest)
+ (save-match-data
+ (set-match-data match)
+ (apply function rest)))))
(defun org-mouse-yank-link (click)
(interactive "e")
@@ -631,7 +629,7 @@ This means, between the beginning of line and the point."
((save-excursion (beginning-of-line) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
- ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
+ ,@(org-mouse-list-options-menu (mapcar #'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(\\+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
@@ -857,21 +855,21 @@ This means, between the beginning of line and the point."
(add-hook 'org-mode-hook
#'(lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-context-menu)
+ (setq org-mouse-context-menu-function #'org-mouse-context-menu)
(when (memq 'context-menu org-mouse-features)
(org-defkey org-mouse-map [mouse-3] nil)
- (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu))
- (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse)
+ (org-defkey org-mode-map [mouse-3] #'org-mouse-show-context-menu))
+ (org-defkey org-mode-map [down-mouse-1] #'org-mouse-down-mouse)
(when (memq 'context-menu org-mouse-features)
- (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree)
- (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start))
+ (org-defkey org-mouse-map [C-drag-mouse-1] #'org-mouse-move-tree)
+ (org-defkey org-mouse-map [C-down-mouse-1] #'org-mouse-move-tree-start))
(when (memq 'yank-link org-mouse-features)
- (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link)
- (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link))
+ (org-defkey org-mode-map [S-mouse-2] #'org-mouse-yank-link)
+ (org-defkey org-mode-map [drag-mouse-3] #'org-mouse-yank-link))
(when (memq 'move-tree org-mouse-features)
- (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree)
- (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start))
+ (org-defkey org-mouse-map [drag-mouse-3] #'org-mouse-move-tree)
+ (org-defkey org-mouse-map [down-mouse-3] #'org-mouse-move-tree-start))
(when (memq 'activate-stars org-mouse-features)
(font-lock-add-keywords
@@ -1086,11 +1084,11 @@ This means, between the beginning of line and the point."
(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)
+ (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)
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index 29d9d58482a..d8a4937b95a 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -239,11 +239,11 @@ When completing for #+STARTUP, for example, this function returns
(require 'ox)
(pcomplete-here
(and org-export-exclude-tags
- (list (mapconcat 'identity org-export-exclude-tags " ")))))
+ (list (mapconcat #'identity org-export-exclude-tags " ")))))
(defun pcomplete/org-mode/file-option/filetags ()
"Complete arguments for the #+FILETAGS file option."
- (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " "))))
+ (pcomplete-here (and org-file-tags (mapconcat #'identity org-file-tags " "))))
(defun pcomplete/org-mode/file-option/language ()
"Complete arguments for the #+LANGUAGE file option."
@@ -264,13 +264,13 @@ When completing for #+STARTUP, for example, this function returns
(require 'ox)
(pcomplete-here
(and org-export-select-tags
- (list (mapconcat 'identity org-export-select-tags " ")))))
+ (list (mapconcat #'identity org-export-select-tags " ")))))
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
(while (pcomplete-here
(let ((opts (pcomplete-uniquify-list
- (mapcar 'car org-startup-options))))
+ (mapcar #'car org-startup-options))))
;; Some options are mutually exclusive, and shouldn't be completed
;; against if certain other options have already been seen.
(dolist (arg pcomplete-args)
@@ -340,7 +340,8 @@ When completing for #+STARTUP, for example, this function returns
"Complete against TeX-style HTML entity names."
(require 'org-entities)
(while (pcomplete-here
- (pcomplete-uniquify-list (remove nil (mapcar 'car-safe org-entities)))
+ (pcomplete-uniquify-list
+ (remove nil (mapcar #'car-safe org-entities)))
(substring pcomplete-stub 1))))
(defun pcomplete/org-mode/todo ()
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 74043f8340b..726c1ca2bae 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -535,7 +535,7 @@ The location for a browser's bookmark should look like this:
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
- (let ((result nil)
+ (let (;; (result nil)
(f (org-protocol-sanitize-uri
(plist-get (org-protocol-parse-parameters fname nil '(:url))
:url))))
@@ -586,7 +586,7 @@ The location for a browser's bookmark should look like this:
(if (file-exists-p the-file)
(message "%s: permission denied!" the-file)
(message "%s: no such file or directory." the-file))))))
- result)))
+ nil))) ;; FIXME: Really?
;;; Core functions:
diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el
index 1e0c339f7b2..8b42f817c1a 100644
--- a/lisp/org/org-refile.el
+++ b/lisp/org/org-refile.el
@@ -7,18 +7,18 @@
;;
;; This file is part of GNU Emacs.
-;; This program is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 20acee4e662..cabedecb689 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -682,7 +682,7 @@ This minor mode is turned on in two situations:
\\{org-src-mode-map}
See also `org-src-mode-hook'."
- nil " OrgSrc" nil
+ :lighter " OrgSrc"
(when org-edit-src-persistent-message
(setq header-line-format
(substitute-command-keys
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 1248efabc15..0e93fb271f3 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -495,7 +495,7 @@ This may be useful when columns have been shrunk."
;;;###autoload
(define-minor-mode org-table-header-line-mode
"Display the first row of the table at point in the header line."
- nil " TblHeader" nil
+ :lighter " TblHeader"
(unless (eq major-mode 'org-mode)
(user-error "Cannot turn org table header mode outside org-mode buffers"))
(if org-table-header-line-mode
@@ -1976,7 +1976,7 @@ lines."
When this mode is active, the field editor window will always show the
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
+ :lighter " TblFollow"
(if org-table-follow-field-mode
(add-hook 'post-command-hook 'org-table-follow-fields-with-editor
'append 'local)
@@ -5149,7 +5149,7 @@ When LOCAL is non-nil, show references for the table at point."
;;;###autoload
(define-minor-mode orgtbl-mode
"The Org mode table editor as a minor mode for use in other modes."
- :lighter " OrgTbl" :keymap orgtbl-mode-map
+ :lighter " OrgTbl"
(org-load-modules-maybe)
(cond
((derived-mode-p 'org-mode)
diff --git a/lisp/org/org-tempo.el b/lisp/org/org-tempo.el
index 36b8614fe1c..c121b8e7aca 100644
--- a/lisp/org/org-tempo.el
+++ b/lisp/org/org-tempo.el
@@ -65,7 +65,7 @@ just like `org-structure-template-alist'. The tempo snippet
\"<KEY\" will be expanded using the KEYWORD value. For example
\"<L\" at the beginning of a line is expanded to \"#+latex:\".
-Do not use \"I\" as a KEY, as it it reserved for expanding
+Do not use \"I\" as a KEY, as it is reserved for expanding
\"#+include\"."
:group 'org-tempo
:type '(repeat (cons (string :tag "Key")
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index b6802fe8b04..852d18579a4 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -366,7 +366,7 @@ VALUE can be `on', `off', or `paused'."
(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))))))
+ (run-with-timer 1 1 #'org-timer-update-mode-line))))))
(defun org-timer-update-mode-line ()
"Update the timer time in the mode line."
@@ -456,14 +456,15 @@ using three `C-u' prefix arguments."
"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)))
+ (let ((msg (format "%s: time out" title))
+ (sound org-clock-sound))
(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)))))
+ secs nil (lambda ()
+ (setq org-timer-countdown-timer nil
+ org-timer-start-time nil)
+ (org-notify msg sound)
+ (org-timer-set-mode-line 'off)
+ (run-hooks 'org-timer-done-hook)))))
(defun org-timer--get-timer-title ()
"Construct timer title.
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 25b3354bdd7..8871ef798d5 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -1,4 +1,4 @@
-;;; org-version.el --- autogenerated file, do not edit
+;;; org-version.el --- autogenerated file, do not edit -*- lexical-binding: t -*-
;;
;;; Code:
;;;###autoload
diff --git a/lisp/org/org.el b/lisp/org/org.el
index e6a5cca9391..f560c65dc4f 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -4757,8 +4757,8 @@ This is for getting out of special buffers like capture.")
;; Other stuff we need.
(require 'time-date)
(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time))
-(require 'easymenu)
-(require 'overlay)
+(when (< emacs-major-version 28) ; preloaded in Emacs 28
+ (require 'easymenu))
(require 'org-entities)
(require 'org-faces)
@@ -15584,7 +15584,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
This mode supports entering LaTeX environment and math in LaTeX fragments
in Org mode.
\\{org-cdlatex-mode-map}"
- nil " OCDL" nil
+ :lighter " OCDL"
(when org-cdlatex-mode
(require 'cdlatex)
(run-hooks 'cdlatex-mode-hook)
@@ -20318,7 +20318,7 @@ unless optional argument NO-INHERITANCE is non-nil."
(defun org-point-at-end-of-empty-headline ()
"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
+If the heading only contains a TODO keyword, it is still considered
empty."
(let ((case-fold-search nil))
(and (looking-at "[ \t]*$")
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index 1a1732b6836..6ed95e84d6b 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -895,14 +895,16 @@ holding export options."
;;; Minor Mode
-(defvar org-beamer-mode-map (make-sparse-keymap)
+(defvar org-beamer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-b" 'org-beamer-select-environment)
+ map)
"The keymap for `org-beamer-mode'.")
-(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
;;;###autoload
(define-minor-mode org-beamer-mode
"Support for editing Beamer oriented Org mode files."
- nil " Bm" 'org-beamer-mode-map)
+ :lighter " Bm")
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords
diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el
index 6cace7e6989..27d2dedb8ed 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 -*- lexical-binding: t; -*-
+;;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 2d550d92774..a076d15978d 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -2111,7 +2111,8 @@ SHORT-CAPTION are strings."
(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))
+ ;; (short-caption nil)
+ )
(when (or label caption)
(let* ((default-category
(cl-case (org-element-type element)
@@ -2159,7 +2160,7 @@ SHORT-CAPTION are strings."
"<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">%s</text:sequence>"
label counter counter seqno))
(?c . ,(or caption "")))))
- short-caption))
+ nil)) ;; short-caption
;; Case 2: Handle Label reference.
(reference
(let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
@@ -2362,14 +2363,14 @@ used as a communication channel."
;; If yes, note down its contents. It will go in to frame
;; description. This quite useful for debugging.
(desc (and replaces (org-element-property :value replaces)))
- width height)
+ ) ;; width height
(cond
((eq embed-as 'character)
- (org-odt--render-image/formula "InlineFormula" href width height
+ (org-odt--render-image/formula "InlineFormula" href nil nil ;; width height
nil nil title desc))
(t
(let* ((equation (org-odt--render-image/formula
- "CaptionedDisplayFormula" href width height
+ "CaptionedDisplayFormula" href nil nil ;; width height
captions nil title desc))
(label
(let* ((org-odt-category-map-alist
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index cf080549a6a..6e8d0d62141 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -1627,6 +1627,22 @@ Return output file's name."
(org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist)))
+(defun org-texinfo-export-to-texinfo-batch ()
+ "Export Org file INFILE to Texinfo file OUTFILE, in batch mode.
+Overwrites existing output file.
+Usage: emacs -batch -f org-texinfo-export-to-texinfo-batch INFILE OUTFILE"
+ (or noninteractive (user-error "Batch mode use only"))
+ (let ((infile (pop command-line-args-left))
+ (outfile (pop command-line-args-left))
+ (org-export-coding-system org-texinfo-coding-system)
+ (make-backup-files nil))
+ (unless (file-readable-p infile)
+ (message "File `%s' not readable" infile)
+ (kill-emacs 1))
+ (with-temp-buffer
+ (insert-file-contents infile)
+ (org-export-to-file 'texinfo outfile))))
+
;;;###autoload
(defun org-texinfo-export-to-info
(&optional async subtreep visible-only body-only ext-plist)
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 050a8094d07..36ecf014830 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -2706,9 +2706,9 @@ a list of footnote definitions or in the widened buffer."
(and (or (eq (org-element-type f) 'footnote-definition)
(eq (org-element-property :type f) 'inline))
(org-element-property :label f)))))
- seen)
+ ) ;; seen
(dolist (l (funcall list-labels tree))
- (cond ((member l seen))
+ (cond ;; ((member l seen))
((member l known-definitions) (push l defined))
(t (push l undefined)))))
;; Complete MISSING-DEFINITIONS by finding the definition of every
diff --git a/lisp/outline.el b/lisp/outline.el
index 57909b307b8..0bb74ffd64a 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -175,23 +175,44 @@ in the file it applies to.")
outline-mode-menu-bar-map))))))
map))
+(defvar outline-mode-cycle-map
+ (let ((map (make-sparse-keymap)))
+ (let ((tab-binding `(menu-item
+ "" outline-cycle
+ ;; Only takes effect if point is on a heading.
+ :filter ,(lambda (cmd)
+ (when (outline-on-heading-p) cmd)))))
+ (define-key map (kbd "TAB") tab-binding)
+ (define-key map (kbd "<backtab>") #'outline-cycle-buffer))
+ map)
+ "Keymap used by `outline-mode-map' and `outline-minor-mode-cycle'.")
+
(defvar outline-mode-map
(let ((map (make-sparse-keymap)))
+ (set-keymap-parent map outline-mode-cycle-map)
(define-key map "\C-c" outline-mode-prefix-map)
(define-key map [menu-bar] outline-mode-menu-bar-map)
- ;; Only takes effect if point is on a heading.
- (define-key map (kbd "TAB")
- `(menu-item "" outline-cycle
- :filter ,(lambda (cmd)
- (when (outline-on-heading-p) cmd))))
- (define-key map (kbd "<backtab>") #'outline-cycle-buffer)
map))
(defvar outline-font-lock-keywords
'(
;; Highlight headings according to the level.
(eval . (list (concat "^\\(?:" outline-regexp "\\).+")
- 0 '(outline-font-lock-face) nil t)))
+ 0 '(if outline-minor-mode
+ (if outline-minor-mode-cycle
+ (if outline-minor-mode-highlight
+ (list 'face (outline-font-lock-face)
+ 'keymap outline-mode-cycle-map)
+ (list 'face nil
+ 'keymap outline-mode-cycle-map))
+ (if outline-minor-mode-highlight
+ (list 'face (outline-font-lock-face))))
+ (outline-font-lock-face))
+ (when outline-minor-mode
+ (pcase outline-minor-mode-highlight
+ ('override t)
+ ('append 'append)))
+ t)))
"Additional expressions to highlight in Outline mode.")
(defface outline-1
@@ -305,15 +326,66 @@ After that, changing the prefix key requires manipulating keymaps."
(define-key outline-minor-mode-map val outline-mode-prefix-map)
(set-default sym val)))
+(defcustom outline-minor-mode-cycle nil
+ "Enable cycling of headings in `outline-minor-mode'.
+When enabled, it puts a keymap with cycling keys on heading lines.
+When point is on a heading line, then typing `TAB' cycles between `hide all',
+`headings only' and `show all' (`outline-cycle'). Typing `S-TAB' on
+a heading line cycles the whole buffer (`outline-cycle-buffer').
+Typing these keys anywhere outside heading lines uses their default bindings."
+ :type 'boolean
+ :version "28.1")
+;;;###autoload(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp)
+
+(defcustom outline-minor-mode-highlight nil
+ "Highlight headings in `outline-minor-mode' using font-lock keywords.
+Non-nil value works well only when outline font-lock keywords
+don't conflict with the major mode's font-lock keywords.
+When t, it puts outline faces only if there are no major mode's faces
+on headings. When `override', it completely overwrites major mode's
+faces with outline faces. When `append', it tries to append outline
+faces to major mode's faces."
+ :type '(choice (const :tag "No highlighting" nil)
+ (const :tag "Overwrite major mode faces" override)
+ (const :tag "Append outline faces to major mode faces" append)
+ (const :tag "Highlight separately from major mode faces" t))
+ :version "28.1")
+;;;###autoload(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp)
+
+(defun outline-minor-mode-highlight-buffer ()
+ ;; Fallback to overlays when font-lock is unsupported.
+ (save-excursion
+ (goto-char (point-min))
+ (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$")))
+ (while (re-search-forward regexp nil t)
+ (let ((overlay (make-overlay (match-beginning 0)
+ (match-end 0))))
+ (overlay-put overlay 'outline-overlay t)
+ (when (or (eq outline-minor-mode-highlight 'override)
+ (and (eq outline-minor-mode-highlight t)
+ (goto-char (match-beginning 0))
+ (not (get-text-property (point) 'face))))
+ (overlay-put overlay 'face (outline-font-lock-face)))
+ (when outline-minor-mode-cycle
+ (overlay-put overlay 'keymap outline-mode-cycle-map)))
+ (goto-char (match-end 0))))))
+
;;;###autoload
(define-minor-mode outline-minor-mode
"Toggle Outline minor mode.
See the command `outline-mode' for more information on this mode."
- nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
- (cons outline-minor-mode-prefix outline-mode-prefix-map))
+ :lighter " Outl"
+ :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map)
+ (cons outline-minor-mode-prefix outline-mode-prefix-map))
(if outline-minor-mode
(progn
+ (when (or outline-minor-mode-cycle outline-minor-mode-highlight)
+ (if (and global-font-lock-mode (font-lock-specified-p major-mode))
+ (progn
+ (font-lock-add-keywords nil outline-font-lock-keywords t)
+ (font-lock-flush))
+ (outline-minor-mode-highlight-buffer)))
;; Turn off this mode if we change major modes.
(add-hook 'change-major-mode-hook
(lambda () (outline-minor-mode -1))
@@ -321,6 +393,11 @@ See the command `outline-mode' for more information on this mode."
(setq-local line-move-ignore-invisible t)
;; Cause use of ellipses for invisible text.
(add-to-invisibility-spec '(outline . t)))
+ (when (or outline-minor-mode-cycle outline-minor-mode-highlight)
+ (if font-lock-fontified
+ (font-lock-remove-keywords nil outline-font-lock-keywords))
+ (remove-overlays nil nil 'outline-overlay t)
+ (font-lock-flush))
(setq line-move-ignore-invisible nil)
;; Cause use of ellipses for invisible text.
(remove-from-invisibility-spec '(outline . t))
@@ -1198,6 +1275,45 @@ Return either 'hide-all, 'headings-only, or 'show-all."
(setq outline--cycle-buffer-state 'show-all)
(message "Show all")))))
+(defvar outline-navigation-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-b") #'outline-backward-same-level)
+ (define-key map (kbd "b") #'outline-backward-same-level)
+ (define-key map (kbd "C-f") #'outline-forward-same-level)
+ (define-key map (kbd "f") #'outline-forward-same-level)
+ (define-key map (kbd "C-n") #'outline-next-visible-heading)
+ (define-key map (kbd "n") #'outline-next-visible-heading)
+ (define-key map (kbd "C-p") #'outline-previous-visible-heading)
+ (define-key map (kbd "p") #'outline-previous-visible-heading)
+ (define-key map (kbd "C-u") #'outline-up-heading)
+ (define-key map (kbd "u") #'outline-up-heading)
+ map))
+
+(dolist (command '(outline-backward-same-level
+ outline-forward-same-level
+ outline-next-visible-heading
+ outline-previous-visible-heading
+ outline-up-heading))
+ (put command 'repeat-map 'outline-navigation-repeat-map))
+
+(defvar outline-editing-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-v") #'outline-move-subtree-down)
+ (define-key map (kbd "v") #'outline-move-subtree-down)
+ (define-key map (kbd "C-^") #'outline-move-subtree-up)
+ (define-key map (kbd "^") #'outline-move-subtree-up)
+ (define-key map (kbd "C->") #'outline-demote)
+ (define-key map (kbd ">") #'outline-demote)
+ (define-key map (kbd "C-<") #'outline-promote)
+ (define-key map (kbd "<") #'outline-promote)
+ map))
+
+(dolist (command '(outline-move-subtree-down
+ outline-move-subtree-up
+ outline-demote
+ outline-promote))
+ (put command 'repeat-map 'outline-editing-repeat-map))
+
(provide 'outline)
(provide 'noutline)
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index dd964e36384..6c68645eb22 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -106,7 +106,7 @@
(while (pcomplete-here (completion-table-in-turn
(pcmpl-gnu-make-rule-names)
(pcomplete-entries))
- nil 'identity))))
+ nil #'identity))))
(defun pcmpl-gnu-makefile-names ()
"Return a list of possible makefile names."
@@ -336,7 +336,7 @@ Return the new list."
(pcomplete-match-string 1 0)))))
(unless saw-option
(pcomplete-here
- (mapcar 'char-to-string
+ (mapcar #'char-to-string
(string-to-list
"01234567ABCFGIKLMNOPRSTUVWXZbcdfghiklmoprstuvwxz")))
(if (pcomplete-match "[xt]" 'first 1)
@@ -355,7 +355,7 @@ Return the new list."
(pcmpl-gnu-with-file-buffer
file (mapcar #'tar-header-name tar-parse-info)))))
(pcomplete-entries))
- nil 'identity))))
+ nil #'identity))))
;;;###autoload
@@ -391,7 +391,7 @@ Return the new list."
(string= prec "-execdir"))
(while (pcomplete-here* (funcall pcomplete-command-completion-function)
(pcomplete-arg 'last) t))))
- (while (pcomplete-here (pcomplete-dirs) nil 'identity))))
+ (while (pcomplete-here (pcomplete-dirs) nil #'identity))))
;;;###autoload
(defalias 'pcomplete/gdb 'pcomplete/xargs)
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 2f42dbd4fa1..39d4add2be1 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -31,11 +31,6 @@
(require 'pcomplete)
-;; Unused.
-;;; (defgroup pcmpl-linux nil
-;;; "Functions for dealing with GNU/Linux completions."
-;;; :group 'pcomplete)
-
;; Functions:
;;;###autoload
@@ -50,20 +45,20 @@
(while (pcomplete-here
(if (file-directory-p "/proc")
(directory-files "/proc" nil "\\`[0-9]+\\'"))
- nil 'identity)))
+ nil #'identity)))
;;;###autoload
(defun pcomplete/umount ()
"Completion for GNU/Linux `umount'."
(pcomplete-opt "hVafrnvt(pcmpl-linux-fs-types)")
(while (pcomplete-here (pcmpl-linux-mounted-directories)
- nil 'identity)))
+ nil #'identity)))
;;;###autoload
(defun pcomplete/mount ()
"Completion for GNU/Linux `mount'."
(pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?")
- (while (pcomplete-here (pcomplete-entries) nil 'identity)))
+ (while (pcomplete-here (pcomplete-entries) nil #'identity)))
(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/")
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 70273b94a1b..49dc2d2fc6c 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -77,12 +77,13 @@ being via `pcmpl-ssh-known-hosts-file'."
(let ((pcomplete-help "(fileutils)rm invocation"))
(pcomplete-opt "dfirRv")
(while (pcomplete-here (pcomplete-all-entries) nil
- 'expand-file-name))))
+ #'expand-file-name))))
;;;###autoload
(defun pcomplete/xargs ()
"Completion for `xargs'."
- ;; FIXME: Add completion of xargs-specific arguments.
+ (while (string-prefix-p "-" (pcomplete-arg 0))
+ (pcomplete-here (funcall pcomplete-default-completion-function)))
(funcall pcomplete-command-completion-function)
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
@@ -213,7 +214,7 @@ Includes files as well as host names followed by a colon."
(list string)
(completion-table-subvert (pcomplete-all-entries)
"" "/ssh:")))
- ((string-match "/" string) ; Local file name.
+ ((string-search "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.
(append (all-completions string (pcomplete-all-entries))
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 61d88666798..fd147101b69 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -27,7 +27,7 @@
(require 'pcomplete)
-;;;; tlmgr - http://www.tug.org/texlive/tlmgr.html
+;;;; tlmgr - https://www.tug.org/texlive/tlmgr.html
(defcustom pcmpl-x-tlmgr-program "tlmgr"
"Name of the tlmgr program."
@@ -301,7 +301,8 @@ long options."
"nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
"pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
"rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
- "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
+ "tes" "thr" "ucp" "use" "voi" "zdi")
+ (match-string 2 cur)))
((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
(pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 7effb27af7f..64acc416c23 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -135,11 +135,8 @@
"A regexp of names to be disregarded during directory completion."
:type '(choice regexp (const :tag "None" nil)))
-(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
- ;; FIXME: the doc mentions file-name completion, but the code
- ;; seems to apply it to all completions.
- "If non-nil, ignore case when doing filename completion."
- :type 'boolean)
+(define-obsolete-variable-alias 'pcomplete-ignore-case 'completion-ignore-case
+ "28.1")
(defcustom pcomplete-autolist nil
"If non-nil, automatically list possibilities on partial completion.
@@ -472,7 +469,7 @@ Same as `pcomplete' but using the standard completion UI."
(not (member
(funcall norm-func (directory-file-name f))
seen)))))))
- (when pcomplete-ignore-case
+ (when completion-ignore-case
(setq table (completion-table-case-fold table)))
(list beg (point) table
:predicate pred
@@ -865,7 +862,7 @@ this is `comint-dynamic-complete-functions'."
(sort comps pcomplete-compare-entry-function)))
,@(cdr (completion-file-name-table s p a)))
(let ((completion-ignored-extensions nil)
- (completion-ignore-case pcomplete-ignore-case))
+ (completion-ignore-case completion-ignore-case))
(completion-table-with-predicate
#'comint-completion-file-name-table pred 'strict s p a))))))
@@ -1116,7 +1113,7 @@ Typing SPC flushes the help buffer."
"Insert a completion entry at point.
Returns non-nil if a space was appended at the end."
(let ((here (point)))
- (if (not pcomplete-ignore-case)
+ (if (not completion-ignore-case)
(insert-and-inherit (if raw-p
(substring entry (length stub))
(comint-quote-filename
@@ -1194,7 +1191,7 @@ Returns `partial' if completed as far as possible with the matches.
Returns `listed' if a completion listing was shown.
See also `pcomplete-filename'."
- (let* ((completion-ignore-case pcomplete-ignore-case)
+ (let* ((completion-ignore-case completion-ignore-case)
(completions (all-completions stub candidates))
(entry (try-completion stub candidates))
result)
@@ -1263,18 +1260,9 @@ If specific documentation can't be given, be generic."
(defun pcomplete-uniquify-list (l)
"Sort and remove multiples in L."
- (setq l (sort l 'string-lessp))
- (let ((m l))
- (while m
- (while (and (cdr m)
- (string= (car m)
- (cadr m)))
- (setcdr m (cddr m)))
- (setq m (cdr m))))
- l)
-(define-obsolete-function-alias
- 'pcomplete-uniqify-list
- 'pcomplete-uniquify-list "27.1")
+ (setq l (sort l #'string-lessp))
+ (seq-uniq l))
+(define-obsolete-function-alias 'pcomplete-uniqify-list #'pcomplete-uniquify-list "27.1")
(defun pcomplete-process-result (cmd &rest args)
"Call CMD using `call-process' and return the simplest result."
@@ -1323,18 +1311,6 @@ If specific documentation can't be given, be generic."
(pcomplete-read-hosts pcomplete-hosts-file 'pcomplete--host-name-cache
'pcomplete--host-name-cache-timestamp)))
-;; create a set of aliases which allow completion functions to be not
-;; quite so verbose
-
-;;; jww (1999-10-20): are these a good idea?
-;; (defalias 'pc-here 'pcomplete-here)
-;; (defalias 'pc-test 'pcomplete-test)
-;; (defalias 'pc-opt 'pcomplete-opt)
-;; (defalias 'pc-match 'pcomplete-match)
-;; (defalias 'pc-match-string 'pcomplete-match-string)
-;; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
-;; (defalias 'pc-match-end 'pcomplete-match-end)
-
(provide 'pcomplete)
;;; pcomplete.el ends here
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 68dc0fb94b3..78b8259b395 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -1,4 +1,4 @@
-;;; pixel-scroll.el --- Scroll a line smoothly
+;;; pixel-scroll.el --- Scroll a line smoothly -*- lexical-binding: t -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
;; Author: Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
@@ -124,7 +124,7 @@ This is an alternative of `scroll-up'. Scope moves downward."
(or arg (setq arg 1))
(if (pixel-scroll-in-rush-p)
(scroll-up arg)
- (dotimes (ii arg) ; move scope downward
+ (dotimes (_ arg) ; move scope downward
(let ((amt (if pixel-resolution-fine-flag
(if (integerp pixel-resolution-fine-flag)
pixel-resolution-fine-flag
@@ -145,7 +145,7 @@ This is and alternative of `scroll-down'. Scope moves upward."
(or arg (setq arg 1))
(if (pixel-scroll-in-rush-p)
(scroll-down arg)
- (dotimes (ii arg)
+ (dotimes (_ arg)
(let ((amt (if pixel-resolution-fine-flag
(if (integerp pixel-resolution-fine-flag)
pixel-resolution-fine-flag
@@ -244,7 +244,7 @@ that was scrolled."
(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
- (dotimes (ii line)
+ (dotimes (_ line)
;; On horizontal scrolling, move cursor.
(when (> (window-hscroll) 0)
(vertical-motion 1))
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 05e61dfe401..3630c199bc4 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,4 +1,4 @@
-;;; 5x5.el --- simple little puzzle game
+;;; 5x5.el --- simple little puzzle game -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -179,6 +179,7 @@ GRID is the grid of positions to click.")
(define-derived-mode 5x5-mode special-mode "5x5"
"A mode for playing `5x5'."
+ :interactive nil
(setq buffer-read-only t
truncate-lines t)
(buffer-disable-undo))
@@ -221,7 +222,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-new-game ()
"Start a new game of `5x5'."
- (interactive)
+ (interactive nil 5x5-mode)
(when (if (called-interactively-p 'interactive)
(5x5-y-or-n-p "Start a new game? ") t)
(setq 5x5-x-pos (/ 5x5-grid-size 2)
@@ -234,7 +235,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-quit-game ()
"Quit the current game of `5x5'."
- (interactive)
+ (interactive nil 5x5-mode)
(kill-buffer 5x5-buffer-name))
(defun 5x5-make-new-grid ()
@@ -289,7 +290,7 @@ Quit current game \\[5x5-quit-game]"
(defun 5x5-draw-grid-end ()
"Draw the top/bottom of the grid."
(insert "+")
- (dotimes (x 5x5-grid-size)
+ (dotimes (_ 5x5-grid-size)
(insert "-" (make-string 5x5-x-scale ?-)))
(insert "-+ "))
@@ -297,11 +298,11 @@ Quit current game \\[5x5-quit-game]"
"Draw the grids GRIDS into the current buffer."
(let ((inhibit-read-only t) grid-org)
(erase-buffer)
- (dolist (grid grids) (5x5-draw-grid-end))
+ (dolist (_ grids) (5x5-draw-grid-end))
(insert "\n")
(setq grid-org (point))
(dotimes (y 5x5-grid-size)
- (dotimes (lines 5x5-y-scale)
+ (dotimes (_lines 5x5-y-scale)
(dolist (grid grids)
(dotimes (x 5x5-grid-size)
(insert (if (zerop x) "| " " ")
@@ -331,7 +332,7 @@ Quit current game \\[5x5-quit-game]"
(forward-char (1+ 5x5-x-scale))))
(forward-line 5x5-y-scale))))
(setq 5x5-solver-output nil)))
- (dolist (grid grids) (5x5-draw-grid-end))
+ (dolist (_grid grids) (5x5-draw-grid-end))
(insert "\n")
(insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves))))
@@ -475,11 +476,11 @@ position."
"Convert a grid matrix GRID-MATRIX in Calc format to a grid in
5x5 format. See function `5x5-grid-to-vec'."
(apply
- 'vector
+ #'vector
(mapcar
(lambda (x)
(apply
- 'vector
+ #'vector
(mapcar
(lambda (y) (/= (cadr y) 0))
(cdr x))))
@@ -503,7 +504,9 @@ position."
Log a matrix VALUE of (mod B 2) forms, only B is output and
Scilab matrix notation is used. VALUE is returned so that it is
easy to log a value with minimal rewrite of code."
- (when (buffer-live-p 5x5-log-buffer)
+ (when (buffer-live-p 5x5-log-buffer)
+ (defvar calc-matrix-brackets)
+ (defvar calc-vector-commas)
(let* ((unpacked-value
(math-map-vec
(lambda (row) (math-map-vec 'cadr row))
@@ -515,7 +518,7 @@ easy to log a value with minimal rewrite of code."
(insert name ?= value-to-log ?\n))))
value))
(defsubst 5x5-log-init ())
- (defsubst 5x5-log (name value) value)))
+ (defsubst 5x5-log (_name value) value)))
(declare-function math-map-vec "calc-vec" (f a))
(declare-function math-sub "calc" (a b))
@@ -533,6 +536,10 @@ easy to log a value with minimal rewrite of code."
(declare-function calcFunc-mcol "calc-vec" (mat n))
(declare-function calcFunc-vconcat "calc-vec" (a b))
(declare-function calcFunc-index "calc-vec" (n &optional start incr))
+(defvar calc-word-size)
+(defvar calc-leading-zeros)
+(defvar calc-number-radix)
+(defvar calc-command-flags)
(defun 5x5-solver (grid)
"Return a list of solutions for GRID.
@@ -671,16 +678,16 @@ Solutions are sorted from least to greatest Hamming weight."
(5x5-log
"cb"
(math-mul inv-base-change targetv))); CB
- (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
+ ;; (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2
(row-2 (math-make-intv 1 transferm-kernel-size
grid-size-squared)); 3..25
(col-1 (math-make-intv 3 1 (- grid-size-squared
transferm-kernel-size))); 1..23
- (col-2 (math-make-intv 1 (- grid-size-squared
- transferm-kernel-size)
- grid-size-squared)); 24..25
- (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
- (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
+ ;; (col-2 (math-make-intv 1 (- grid-size-squared
+ ;; transferm-kernel-size)
+ ;; grid-size-squared)) ; 24..25
+ ;; (ctransferm-1-: (calcFunc-mrow ctransferm row-1))
+ ;; (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1))
;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0
;; and ctransferm-2-2 = 0.
@@ -696,8 +703,8 @@ Solutions are sorted from least to greatest Hamming weight."
;;
;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2))
- (ctarget-1 (calcFunc-mrow ctarget row-1))
- (ctarget-2 (calcFunc-mrow ctarget row-2))
+ ;; (ctarget-1 (calcFunc-mrow ctarget row-1))
+ (ctarget-2 (calcFunc-mrow ctarget row-2))
;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1)
;; + ctransferm-1-2(2x2) *cx-2(2x1);
@@ -770,13 +777,13 @@ Solutions are sorted from least to greatest Hamming weight."
(message "5x5 Solution computation done.")
solution-list)))
-(defun 5x5-solve-suggest (&optional n)
+(defun 5x5-solve-suggest (&optional _n)
"Suggest to the user where to click.
Argument N is ignored."
;; For the time being n is ignored, the idea was to use some numeric
;; argument to show a limited amount of positions.
- (interactive "P")
+ (interactive "P" 5x5-mode)
(5x5-log-init)
(let ((solutions (5x5-solver 5x5-grid)))
(setq 5x5-solver-output
@@ -799,7 +806,7 @@ list. The list of solution is ordered by number of strokes, so
rotating left just after calling `5x5-solve-suggest' will show
the solution with second least number of strokes, while rotating
right will show the solution with greatest number of strokes."
- (interactive "P")
+ (interactive "P" 5x5-mode)
(let ((len (length 5x5-solver-output)))
(when (>= len 3)
(setq n (if (integerp n) n 1)
@@ -833,7 +840,7 @@ right will show the solution with greatest number of strokes."
If N is not supplied, rotate by 1. Similar to function
`5x5-solve-rotate-left' except that rotation is right instead of
lest."
- (interactive "P")
+ (interactive "P" 5x5-mode)
(setq n
(if (integerp n) (- n)
-1))
@@ -845,7 +852,7 @@ lest."
(defun 5x5-flip-current ()
"Make a move on the current cursor location."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-grid (5x5-make-move 5x5-grid 5x5-y-pos 5x5-x-pos))
(5x5-made-move)
(unless 5x5-cracking
@@ -857,61 +864,61 @@ lest."
(defun 5x5-up ()
"Move up."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (zerop 5x5-y-pos)
(cl-decf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-down ()
"Move down."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (= 5x5-y-pos (1- 5x5-grid-size))
(cl-incf 5x5-y-pos)
(5x5-position-cursor)))
(defun 5x5-left ()
"Move left."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (zerop 5x5-x-pos)
(cl-decf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-right ()
"Move right."
- (interactive)
+ (interactive nil 5x5-mode)
(unless (= 5x5-x-pos (1- 5x5-grid-size))
(cl-incf 5x5-x-pos)
(5x5-position-cursor)))
(defun 5x5-bol ()
"Move to beginning of line."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos 0)
(5x5-position-cursor))
(defun 5x5-eol ()
"Move to end of line."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos (1- 5x5-grid-size))
(5x5-position-cursor))
(defun 5x5-first ()
"Move to the first cell."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos 0
5x5-y-pos 0)
(5x5-position-cursor))
(defun 5x5-last ()
"Move to the last cell."
- (interactive)
+ (interactive nil 5x5-mode)
(setq 5x5-x-pos (1- 5x5-grid-size)
5x5-y-pos (1- 5x5-grid-size))
(5x5-position-cursor))
(defun 5x5-randomize ()
"Randomize the grid."
- (interactive)
+ (interactive nil 5x5-mode)
(when (5x5-y-or-n-p "Start a new game with a random grid? ")
(setq 5x5-x-pos (/ 5x5-grid-size 2)
5x5-y-pos (/ 5x5-grid-size 2)
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index e3854b55a14..13bcdcc8595 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,4 +1,4 @@
-;;; blackbox.el --- blackbox game in Emacs Lisp
+;;; blackbox.el --- blackbox game in Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation,
;; Inc.
@@ -274,45 +274,45 @@ a reflection."
))
(defun bb-right (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (< bb-x 8))
(forward-char 2)
(setq bb-x (1+ bb-x))
(setq count (1- count))))
(defun bb-left (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (> bb-x -1))
(backward-char 2)
(setq bb-x (1- bb-x))
(setq count (1- count))))
(defun bb-up (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (> bb-y -1))
(with-no-warnings (previous-line))
(setq bb-y (1- bb-y))
(setq count (1- count))))
(defun bb-down (count)
- (interactive "p")
+ (interactive "p" blackbox-mode)
(while (and (> count 0) (< bb-y 8))
(with-no-warnings (next-line))
(setq bb-y (1+ bb-y))
(setq count (1- count))))
(defun bb-eol ()
- (interactive)
+ (interactive nil blackbox-mode)
(setq bb-x 8)
(bb-goto (cons bb-x bb-y)))
(defun bb-bol ()
- (interactive)
+ (interactive nil blackbox-mode)
(setq bb-x -1)
(bb-goto (cons bb-x bb-y)))
(defun bb-romp ()
- (interactive)
+ (interactive nil blackbox-mode)
(cond
((and
(or (= bb-x -1) (= bb-x 8))
@@ -379,7 +379,7 @@ a reflection."
(defun bb-done ()
"Finish the game and report score."
- (interactive)
+ (interactive nil blackbox-mode)
(let (bogus-balls)
(cond
((not (= (length bb-balls-placed) (length bb-board)))
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index dc93ef90310..e695a75e083 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -72,9 +72,6 @@
;;; Code:
-(defconst bubbles-version "0.5" "Version number of bubbles.el.")
-(make-obsolete-variable 'bubbles-version nil "28.1")
-
(require 'gamegrid)
;; User options
@@ -772,117 +769,46 @@ static char * dot3d_xpm[] = {
(defun bubbles-set-graphics-theme-ascii ()
"Set graphics theme to `ascii'."
- (interactive)
+ (interactive nil bubbles-mode)
(setq bubbles-graphics-theme 'ascii)
(bubbles--update-faces-or-images))
(defun bubbles-set-graphics-theme-circles ()
"Set graphics theme to `circles'."
- (interactive)
+ (interactive nil bubbles-mode)
(setq bubbles-graphics-theme 'circles)
(bubbles--initialize-images)
(bubbles--update-faces-or-images))
(defun bubbles-set-graphics-theme-squares ()
"Set graphics theme to `squares'."
- (interactive)
+ (interactive nil bubbles-mode)
(setq bubbles-graphics-theme 'squares)
(bubbles--initialize-images)
(bubbles--update-faces-or-images))
(defun bubbles-set-graphics-theme-diamonds ()
"Set graphics theme to `diamonds'."
- (interactive)
+ (interactive nil bubbles-mode)
(setq bubbles-graphics-theme 'diamonds)
(bubbles--initialize-images)
(bubbles--update-faces-or-images))
(defun bubbles-set-graphics-theme-balls ()
"Set graphics theme to `balls'."
- (interactive)
+ (interactive nil bubbles-mode)
(setq bubbles-graphics-theme 'balls)
(bubbles--initialize-images)
(bubbles--update-faces-or-images))
(defun bubbles-set-graphics-theme-emacs ()
"Set graphics theme to `emacs'."
- (interactive)
+ (interactive nil bubbles-mode)
(setq bubbles-graphics-theme 'emacs)
(bubbles--initialize-images)
(bubbles--update-faces-or-images))
-;; game theme menu
-(defvar bubbles-game-theme-menu
- (let ((menu (make-sparse-keymap "Game Theme")))
- (define-key menu [bubbles-set-game-userdefined]
- (list 'menu-item "User defined" 'bubbles-set-game-userdefined
- :button '(:radio . (eq bubbles-game-theme 'user-defined))))
- (define-key menu [bubbles-set-game-hard]
- (list 'menu-item "Hard" 'bubbles-set-game-hard
- :button '(:radio . (eq bubbles-game-theme 'hard))))
- (define-key menu [bubbles-set-game-difficult]
- (list 'menu-item "Difficult" 'bubbles-set-game-difficult
- :button '(:radio . (eq bubbles-game-theme 'difficult))))
- (define-key menu [bubbles-set-game-medium]
- (list 'menu-item "Medium" 'bubbles-set-game-medium
- :button '(:radio . (eq bubbles-game-theme 'medium))))
- (define-key menu [bubbles-set-game-easy]
- (list 'menu-item "Easy" 'bubbles-set-game-easy
- :button '(:radio . (eq bubbles-game-theme 'easy))))
- menu)
- "Map for bubbles game theme menu.")
-
-;; graphics theme menu
-(defvar bubbles-graphics-theme-menu
- (let ((menu (make-sparse-keymap "Graphics Theme")))
- (define-key menu [bubbles-set-graphics-theme-ascii]
- (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii
- :button '(:radio . (eq bubbles-graphics-theme 'ascii))))
- (define-key menu [bubbles-set-graphics-theme-emacs]
- (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs
- :button '(:radio . (eq bubbles-graphics-theme 'emacs))))
- (define-key menu [bubbles-set-graphics-theme-balls]
- (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls
- :button '(:radio . (eq bubbles-graphics-theme 'balls))))
- (define-key menu [bubbles-set-graphics-theme-diamonds]
- (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds
- :button '(:radio . (eq bubbles-graphics-theme 'diamonds))))
- (define-key menu [bubbles-set-graphics-theme-squares]
- (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares
- :button '(:radio . (eq bubbles-graphics-theme 'squares))))
- (define-key menu [bubbles-set-graphics-theme-circles]
- (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles
- :button '(:radio . (eq bubbles-graphics-theme 'circles))))
- menu)
- "Map for bubbles graphics theme menu.")
-
-;; menu
-(defvar bubbles-menu
- (let ((menu (make-sparse-keymap "Bubbles")))
- (define-key menu [bubbles-quit]
- (list 'menu-item "Quit" 'bubbles-quit))
- (define-key menu [bubbles]
- (list 'menu-item "New game" 'bubbles))
- (define-key menu [bubbles-separator-1]
- '("--"))
- (define-key menu [bubbles-save-settings]
- (list 'menu-item "Save all settings" 'bubbles-save-settings))
- (define-key menu [bubbles-customize]
- (list 'menu-item "Edit all settings" 'bubbles-customize))
- (define-key menu [bubbles-game-theme-menu]
- (list 'menu-item "Game Theme" bubbles-game-theme-menu))
- (define-key menu [bubbles-graphics-theme-menu]
- (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu
- :enable 'bubbles--playing))
- (define-key menu [bubbles-separator-2]
- '("--"))
- (define-key menu [bubbles-undo]
- (list 'menu-item "Undo last move" 'bubbles-undo
- :enable '(and bubbles--playing (listp buffer-undo-list))))
- menu)
- "Map for bubbles menu.")
-
-;; bubbles mode map
+
(defvar bubbles-mode-map
(let ((map (make-sparse-keymap 'bubbles-mode-map)))
;; (suppress-keymap map t)
@@ -897,12 +823,59 @@ static char * dot3d_xpm[] = {
(define-key map "n" 'next-line)
(define-key map "f" 'forward-char)
(define-key map "b" 'backward-char)
- ;; bind menu to mouse
- (define-key map [down-mouse-3] bubbles-menu)
- ;; Put menu in menu-bar
- (define-key map [menu-bar Bubbles] (cons "Bubbles" bubbles-menu))
map)
- "Mode map for bubbles.")
+ "Mode map for `bubbles'.")
+
+(easy-menu-define bubbles-menu bubbles-mode-map
+ "Menu for `bubbles'."
+ '("Bubbles"
+ ["Undo last move" bubbles-undo
+ :enable '(and bubbles--playing (listp buffer-undo-list))]
+ "---"
+ ("Graphics Theme"
+ :enable bubbles--playing
+ ["Circles" bubbles-set-graphics-theme-circles
+ :style radio
+ :selected (eq bubbles-graphics-theme 'circles)]
+ ["Squares" bubbles-set-graphics-theme-squares
+ :style radio
+ :selected (eq bubbles-graphics-theme 'squares)]
+ ["Diamonds" bubbles-set-graphics-theme-diamonds
+ :style radio
+ :selected (eq bubbles-graphics-theme 'diamonds)]
+ ["Balls" bubbles-set-graphics-theme-balls
+ :style radio
+ :selected (eq bubbles-graphics-theme 'balls)]
+ ["Emacs" bubbles-set-graphics-theme-emacs
+ :style radio
+ :selected (eq bubbles-graphics-theme 'emacs)]
+ ["ASCII" bubbles-set-graphics-theme-ascii
+ :style radio
+ :selected (eq bubbles-graphics-theme 'ascii)])
+ ("Game Theme"
+ ["Easy" bubbles-set-game-easy
+ :style radio
+ :selected (eq bubbles-game-theme 'easy)]
+ ["Medium" bubbles-set-game-medium
+ :style radio
+ :selected (eq bubbles-game-theme 'medium)]
+ ["Difficult" bubbles-set-game-difficult
+ :style radio
+ :selected (eq bubbles-game-theme 'difficult)]
+ ["Hard" bubbles-set-game-hard
+ :style radio
+ :selected (eq bubbles-game-theme 'hard)]
+ ["User defined" bubbles-set-game-userdefined
+ :style radio
+ :selected (eq bubbles-game-theme 'user-defined)])
+ ["Edit all settings" bubbles-customize]
+ ["Save all settings" bubbles-save-settings]
+ "---"
+ ["New game" bubbles]
+ ["Quit" bubbles-quit]))
+
+;; bind menu to mouse
+(define-key bubbles-mode-map [down-mouse-3] bubbles-menu)
(define-derived-mode bubbles-mode nil "Bubbles"
"Major mode for playing bubbles.
@@ -938,7 +911,7 @@ columns on its right towards the left.
(defun bubbles-quit ()
"Quit Bubbles."
- (interactive)
+ (interactive nil bubbles-mode)
(message "bubbles-quit")
(bury-buffer))
@@ -1189,7 +1162,7 @@ Use optional parameter POS instead of point if given."
(defun bubbles-plop ()
"Remove active bubbles region."
- (interactive)
+ (interactive nil bubbles-mode)
(when (and bubbles--playing
(> bubbles--neighborhood-score 0))
(setq bubbles--save-data (list bubbles--score (buffer-string)))
@@ -1273,7 +1246,7 @@ Use optional parameter POS instead of point if given."
(defun bubbles-undo ()
"Undo last move."
- (interactive)
+ (interactive nil bubbles-mode)
(when bubbles--save-data
(let ((inhibit-read-only t)
(pos (point)))
@@ -1429,6 +1402,11 @@ Return t if new char is non-empty."
(forward-char 1)))
(put-text-property (point-min) (point-max) 'pointer 'arrow)))))
+;; Obsolete.
+
+(defconst bubbles-version "0.5" "Version number of bubbles.el.")
+(make-obsolete-variable 'bubbles-version 'emacs-version "28.1")
+
(provide 'bubbles)
;;; bubbles.el ends here
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 5255d81e5b1..be35daf4da8 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -1,4 +1,4 @@
-;;; cookie1.el --- retrieve random phrases from fortune cookie files
+;;; cookie1.el --- retrieve random phrases from fortune cookie files -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
@@ -177,11 +177,12 @@ Argument REQUIRE-MATCH non-nil forces a matching cookie."
"Randomly permute the elements of VECTOR (all permutations equally likely)."
(let ((len (length vector))
j temp)
- (dotimes (i len vector)
+ (dotimes (i len)
(setq j (+ i (random (- len i)))
temp (aref vector i))
(aset vector i (aref vector j))
- (aset vector j temp))))
+ (aset vector j temp))
+ vector))
(define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4")
@@ -204,9 +205,10 @@ If called interactively, or if DISPLAY is non-nil, display a list of matches."
(cookie-table-symbol (intern phrase-file cookie-cache))
(string-table (symbol-value cookie-table-symbol))
(matches nil))
- (and (dotimes (i (length string-table) matches)
- (and (string-match-p regexp (aref string-table i))
- (setq matches (cons (aref string-table i) matches))))
+ (dotimes (i (length string-table))
+ (and (string-match-p regexp (aref string-table i))
+ (setq matches (cons (aref string-table i) matches))))
+ (and matches
(setq matches (sort matches 'string-lessp)))
(and display
(if matches
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 524ca81f30a..47ed6e28b58 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -1,4 +1,4 @@
-;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
+;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1995-1996, 2001-2021 Free Software Foundation, Inc.
;;
@@ -71,7 +71,7 @@
;; Emacs commands.
;;
;; Decipher supports Font Lock mode. To use it, you can also add
-;; (add-hook 'decipher-mode-hook 'turn-on-font-lock)
+;; (add-hook 'decipher-mode-hook #'turn-on-font-lock)
;; See the variable `decipher-font-lock-keywords' if you want to customize
;; the faces used. I'd like to thank Simon Marshall for his help in making
;; Decipher work well with Font Lock.
@@ -84,6 +84,8 @@
;; 1. The consonant-line shortcut
;; 2. More functions for analyzing ciphertext
+;;; Code:
+
;;;===================================================================
;;; Variables:
;;;===================================================================
@@ -139,20 +141,20 @@ the tail of the list."
(defvar decipher-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
- (define-key map "A" 'decipher-show-alphabet)
- (define-key map "C" 'decipher-complete-alphabet)
- (define-key map "D" 'decipher-digram-list)
- (define-key map "F" 'decipher-frequency-count)
- (define-key map "M" 'decipher-make-checkpoint)
- (define-key map "N" 'decipher-adjacency-list)
- (define-key map "R" 'decipher-restore-checkpoint)
- (define-key map "U" 'decipher-undo)
- (define-key map " " 'decipher-keypress)
- (define-key map [remap undo] 'decipher-undo)
- (define-key map [remap advertised-undo] 'decipher-undo)
+ (define-key map "A" #'decipher-show-alphabet)
+ (define-key map "C" #'decipher-complete-alphabet)
+ (define-key map "D" #'decipher-digram-list)
+ (define-key map "F" #'decipher-frequency-count)
+ (define-key map "M" #'decipher-make-checkpoint)
+ (define-key map "N" #'decipher-adjacency-list)
+ (define-key map "R" #'decipher-restore-checkpoint)
+ (define-key map "U" #'decipher-undo)
+ (define-key map " " #'decipher-keypress)
+ (define-key map [remap undo] #'decipher-undo)
+ (define-key map [remap advertised-undo] #'decipher-undo)
(let ((key ?a))
(while (<= key ?z)
- (define-key map (vector key) 'decipher-keypress)
+ (define-key map (vector key) #'decipher-keypress)
(cl-incf key)))
map)
"Keymap for Decipher mode.")
@@ -161,24 +163,21 @@ the tail of the list."
(defvar decipher-stats-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
- (define-key map "D" 'decipher-digram-list)
- (define-key map "F" 'decipher-frequency-count)
- (define-key map "N" 'decipher-adjacency-list)
+ (define-key map "D" #'decipher-digram-list)
+ (define-key map "F" #'decipher-frequency-count)
+ (define-key map "N" #'decipher-adjacency-list)
map)
-"Keymap for Decipher-Stats mode.")
+ "Keymap for Decipher-Stats mode.")
-(defvar decipher-mode-syntax-table nil
- "Decipher mode syntax table")
-
-(if decipher-mode-syntax-table
- ()
+(defvar decipher-mode-syntax-table
(let ((table (make-syntax-table))
(c ?0))
(while (<= c ?9)
(modify-syntax-entry c "_" table) ;Digits are not part of words
(cl-incf c))
- (setq decipher-mode-syntax-table table)))
+ table)
+ "Decipher mode syntax table")
(defvar-local decipher-alphabet nil)
;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR),
@@ -214,7 +213,6 @@ list of such cons cells.")
(defvar decipher--freqs)
;;;===================================================================
-;;; Code:
;;;===================================================================
;; Main entry points:
;;--------------------------------------------------------------------
@@ -256,7 +254,7 @@ ABCDEFGHIJKLMNOPQRSTUVWXYZ -*-decipher-*-\n)\n\n")
(decipher-mode))
;;;###autoload
-(defun decipher-mode ()
+(define-derived-mode decipher-mode nil "Decipher"
"Major mode for decrypting monoalphabetic substitution ciphers.
Lower-case letters enter plaintext.
Upper-case letters are commands.
@@ -272,16 +270,10 @@ The most useful commands are:
Show adjacency list for current letter (lists letters appearing next to it)
\\[decipher-make-checkpoint] Save the current cipher alphabet (checkpoint)
\\[decipher-restore-checkpoint] Restore a saved cipher alphabet (checkpoint)"
- (interactive)
- (kill-all-local-variables)
(setq buffer-undo-list t ;Disable undo
- indent-tabs-mode nil ;Do not use tab characters
- major-mode 'decipher-mode
- mode-name "Decipher")
+ indent-tabs-mode nil) ;Do not use tab characters
(if decipher-force-uppercase
(setq case-fold-search nil)) ;Case is significant when searching
- (use-local-map decipher-mode-map)
- (set-syntax-table decipher-mode-syntax-table)
(unless (= (point-min) (point-max))
(decipher-read-alphabet))
(setq-local font-lock-defaults
@@ -291,7 +283,6 @@ The most useful commands are:
(lambda () (setq buffer-read-only nil
buffer-undo-list nil))
nil t)
- (run-mode-hooks 'decipher-mode-hook)
(setq buffer-read-only t))
(put 'decipher-mode 'mode-class 'special)
@@ -301,7 +292,7 @@ The most useful commands are:
(defun decipher-keypress ()
"Enter a plaintext or ciphertext character."
- (interactive)
+ (interactive nil decipher-mode)
(let ((decipher-function 'decipher-set-map)
buffer-read-only) ;Make buffer writable
(save-excursion
@@ -314,10 +305,10 @@ The most useful commands are:
((= ?> first-char)
nil)
((= ?\( first-char)
- (setq decipher-function 'decipher-alphabet-keypress)
+ (setq decipher-function #'decipher-alphabet-keypress)
t)
((= ?\) first-char)
- (setq decipher-function 'decipher-alphabet-keypress)
+ (setq decipher-function #'decipher-alphabet-keypress)
nil)
(t
(error "Bad location")))))
@@ -355,7 +346,7 @@ The most useful commands are:
(defun decipher-undo ()
"Undo a change in Decipher mode."
- (interactive)
+ (interactive nil decipher-mode)
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(setq this-command t)
@@ -456,7 +447,7 @@ The most useful commands are:
(decipher-insert plain-char)
(setq case-fold-search t ;Case is not significant
cipher-string (downcase cipher-string))
- (let ((font-lock-fontify-region-function 'ignore))
+ (let ((font-lock-fontify-region-function #'ignore))
;; insert-and-inherit will pick the right face automatically
(while (search-forward-regexp "^:" nil t)
(setq bound (point-at-eol))
@@ -496,7 +487,7 @@ The most useful commands are:
This records the current alphabet so you can return to it later.
You may have any number of checkpoints.
Type `\\[decipher-restore-checkpoint]' to restore a checkpoint."
- (interactive "sCheckpoint description: ")
+ (interactive "sCheckpoint description: " decipher-mode)
(or (stringp desc)
(setq desc ""))
(let (alphabet
@@ -523,7 +514,7 @@ If point is not on a checkpoint line, moves to the first checkpoint line.
If point is on a checkpoint, restores that checkpoint.
Type `\\[decipher-make-checkpoint]' to make a checkpoint."
- (interactive)
+ (interactive nil decipher-mode)
(beginning-of-line)
(if (looking-at "%!\\([A-Z ]+\\)!")
;; Restore this checkpoint:
@@ -551,7 +542,7 @@ Type `\\[decipher-make-checkpoint]' to make a checkpoint."
This fills any blanks in the cipher alphabet with the unused letters
in alphabetical order. Use this when you have a keyword cipher and
you have determined the keyword."
- (interactive)
+ (interactive nil decipher-mode)
(let ((cipher-char ?A)
(ptr decipher-alphabet)
buffer-read-only ;Make buffer writable
@@ -568,7 +559,7 @@ you have determined the keyword."
(defun decipher-show-alphabet ()
"Display the current cipher alphabet in the message line."
- (interactive)
+ (interactive nil decipher-mode)
(message "%s"
(mapconcat (lambda (a)
(concat
@@ -581,7 +572,7 @@ you have determined the keyword."
"Reprocess the buffer using the alphabet from the top.
This regenerates all deciphered plaintext and clears the undo list.
You should use this if you edit the ciphertext."
- (interactive)
+ (interactive nil decipher-mode)
(message "Reprocessing buffer...")
(let (alphabet
buffer-read-only ;Make buffer writable
@@ -625,13 +616,13 @@ You should use this if you edit the ciphertext."
(defun decipher-frequency-count ()
"Display the frequency count in the statistics buffer."
- (interactive)
+ (interactive nil decipher-mode)
(decipher-analyze)
(decipher-display-regexp "^A" "^[A-Z][A-Z]"))
(defun decipher-digram-list ()
"Display the list of digrams in the statistics buffer."
- (interactive)
+ (interactive nil decipher-mode)
(decipher-analyze)
(decipher-display-regexp "[A-Z][A-Z] +[0-9]" "^$"))
@@ -648,7 +639,7 @@ words, and ends 3 words (`*' represents a space). X comes before 8
different letters, after 7 different letters, and is next to a total
of 11 different letters. It occurs 14 times, making up 9% of the
ciphertext."
- (interactive (list (upcase (following-char))))
+ (interactive (list (upcase (following-char))) decipher-mode)
(decipher-analyze)
(let (start end)
(with-current-buffer (decipher-stats-buffer)
@@ -868,12 +859,12 @@ Creates the statistics buffer if it doesn't exist."
(aset decipher--after i (make-vector 27 0))))
(if decipher-ignore-spaces
(progn
- (decipher-loop-no-breaks 'decipher--analyze)
+ (decipher-loop-no-breaks #'decipher--analyze)
;; The first character of ciphertext was marked as following a space:
(let ((i 26))
(while (>= (cl-decf i) 0)
(aset (aref decipher--after i) 26 0))))
- (decipher-loop-with-breaks 'decipher--analyze))
+ (decipher-loop-with-breaks #'decipher--analyze))
(message "Processing results...")
(setcdr (last decipher--digram-list 2) nil) ;Delete the phony "* " digram
;; Sort the digram list by frequency and alphabetical order:
@@ -954,18 +945,12 @@ Creates the statistics buffer if it doesn't exist."
;; Statistics Buffer:
;;====================================================================
-(defun decipher-stats-mode ()
+(define-derived-mode decipher-stats-mode nil "Decipher-Stats"
"Major mode for displaying ciphertext statistics."
- (interactive)
- (kill-all-local-variables)
(setq buffer-read-only t
buffer-undo-list t ;Disable undo
case-fold-search nil ;Case is significant when searching
- indent-tabs-mode nil ;Do not use tab characters
- major-mode 'decipher-stats-mode
- mode-name "Decipher-Stats")
- (use-local-map decipher-stats-mode-map)
- (run-mode-hooks 'decipher-stats-mode-hook))
+ indent-tabs-mode nil)) ;Do not use tab characters
(put 'decipher-stats-mode 'mode-class 'special)
;;--------------------------------------------------------------------
@@ -1001,9 +986,8 @@ if it can't, it signals an error."
(let ((stats-name (concat "*" (buffer-name) "*")))
(setq decipher-stats-buffer
(if (eq 'decipher-stats-mode
- (cdr-safe (assoc 'major-mode
- (buffer-local-variables
- (get-buffer stats-name)))))
+ (buffer-local-value 'major-mode
+ (get-buffer stats-name)))
;; We just lost track of the statistics buffer:
(get-buffer stats-name)
(generate-new-buffer stats-name))))
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index 028f04c325b..bf923f4f2e5 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,4 +1,4 @@
-;;; doctor.el --- psychological help for frustrated users
+;;; doctor.el --- psychological help for frustrated users -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2021 Free Software
;; Foundation, Inc.
@@ -1583,7 +1583,7 @@ Hack on previous word, setting global variable DOCTOR-OWNER to correct result."
E-mail: jo@samaritans.org or\, at your option\,
anonymous E-mail: samaritans@anon.twwells.com\ \.
or find a Befrienders crisis center at
- http://www.befrienders.org/\ \.
+ https://www.befrienders.org/\ \.
(doc$ doctor--please) (doc$ doctor--continue) \.)))
(t (doctor-type (doc$ doctor--deathlst)))))
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index c3be029a658..9d5ee261976 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -2170,7 +2170,7 @@ other words."
(let (pos ret-list end-pos)
(setq pos 0)
(setq ret-list nil)
- (while (setq end-pos (string-match " " (substring strin pos)))
+ (while (setq end-pos (string-search " " (substring strin pos)))
(setq end-pos (+ end-pos pos))
(if (not (= end-pos pos))
(setq ret-list (append ret-list (list
@@ -2269,7 +2269,7 @@ except for the verb."
startlist
(if (string= (substring dirstring 0 1) "/")
(dun-get-path (substring dirstring 1) (append startlist (list "/")))
- (if (not (setq slash (string-match "/" dirstring)))
+ (if (not (setq slash (string-search "/" dirstring)))
(append startlist (list dirstring))
(dun-get-path (substring dirstring (1+ slash))
(append startlist
@@ -2348,7 +2348,7 @@ Also prints current score to let user know he has scored."
(princ dun-line)
(if (eq (dun-parse2 nil dun-unix-verbs dun-line) -1)
(progn
- (if (setq esign (string-match "=" dun-line))
+ (if (setq esign (string-search "=" dun-line))
(dun-doassign dun-line esign)
(dun-mprinc (car dun-line-list))
(dun-mprincl ": not found.")))))
@@ -2373,28 +2373,28 @@ Also prints current score to let user know he has scored."
(dun-mprincl "Incorrect.")))
(let (varname epoint afterq i value)
- (setq varname (replace-regexp-in-string " " "" (substring line 0 esign)))
+ (setq varname (string-replace " " "" (substring line 0 esign)))
(if (or (= (length varname) 0) (< (- (length line) esign) 2))
(progn
(dun-mprinc line)
(dun-mprincl " : not found."))
- (if (not (setq epoint (string-match ")" line)))
+ (if (not (setq epoint (string-search ")" line)))
(if (string= (substring line (1+ esign) (+ esign 2))
"\"")
(progn
(setq afterq (substring line (+ esign 2)))
(setq epoint (+
- (string-match "\"" afterq)
+ (string-search "\"" afterq)
(+ esign 3))))
- (if (not (setq epoint (string-match " " line)))
+ (if (not (setq epoint (string-search " " line)))
(setq epoint (length line))))
(setq epoint (1+ epoint))
(while (and
(not (= epoint (length line)))
- (setq i (string-match ")" (substring line epoint))))
+ (setq i (string-search ")" (substring line epoint))))
(setq epoint (+ epoint i 1))))
(setq value (substring line (1+ esign) epoint))
(dun-eval varname value)))))
@@ -2788,7 +2788,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(cond
((null (setq args (car args)))
(dun-mprincl "Usage: cat <ascii-file-name>"))
- ((string-match-p "/" args)
+ ((string-search "/" args)
(dun-mprincl "cat: only files in current directory allowed."))
((and (> dun-cdroom 0) (string= args "description"))
(dun-mprincl (car (nth dun-cdroom dun-rooms))))
@@ -3110,7 +3110,7 @@ File not found")))
(setq dun-line (downcase (dun-read-line)))
(if (eq (dun-parse2 nil dun-unix-verbs dun-line) -1)
(let (esign)
- (if (setq esign (string-match "=" dun-line))
+ (if (setq esign (string-search "=" dun-line))
(dun-doassign dun-line esign)
(dun-mprinc (car dun-line-list))
(dun-mprincl ": not found.")))))
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index 1c2c24ad75a..c6aef027e5f 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -1,4 +1,4 @@
-;;; gametree.el --- manage game analysis trees in Emacs
+;;; gametree.el --- manage game analysis trees in Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 8db40d7f94f..0a45885b875 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -28,39 +28,36 @@
;; RULES:
;;
;; Gomoku is a game played between two players on a rectangular board. Each
-;; player, in turn, marks a free square of its choice. The winner is the first
+;; player, in turn, marks a free square of its choice. The winner is the first
;; one to mark five contiguous squares in any direction (horizontally,
;; vertically or diagonally).
;;
;; I have been told that, in "The TRUE Gomoku", some restrictions are made
;; about the squares where one may play, or else there is a known forced win
-;; for the first player. This program has no such restriction, but it does not
+;; for the first player. This program has no such restriction, but it does not
;; know about the forced win, nor do I.
-;; See http://renju.se/rif/r1rulhis.htm for more information.
-
+;; See https://renju.se/rif/r1rulhis.htm for more information.
;; There are two main places where you may want to customize the program: key
-;; bindings and board display. These features are commented in the code. Go
+;; bindings and board display. These features are commented in the code. Go
;; and see.
-
;; HOW TO USE:
;;
-;; The command "M-x gomoku" displays a
-;; board, the size of which depends on the size of the current window. The
-;; size of the board is easily modified by giving numeric arguments to the
-;; gomoku command and/or by customizing the displaying parameters.
+;; The command `M-x gomoku' displays a board, the size of which depends on the
+;; size of the current window. The size of the board is easily modified by
+;; giving numeric arguments to the gomoku command and/or by customizing the
+;; displaying parameters.
;;
-;; Emacs plays when it is its turn. When it is your turn, just put the cursor
+;; Emacs plays when it is its turn. When it is your turn, just put the cursor
;; on the square where you want to play and hit RET, or X, or whatever key you
-;; bind to the command gomoku-human-plays. When it is your turn, Emacs is
+;; bind to the command `gomoku-human-plays'. When it is your turn, Emacs is
;; idle: you may switch buffers, read your mail, ... Just come back to the
;; *Gomoku* buffer and resume play.
-
;; ALGORITHM:
;;
-;; The algorithm is briefly described in section "THE SCORE TABLE". Some
+;; The algorithm is briefly described in section "THE SCORE TABLE". Some
;; parameters may be modified if you want to change the style exhibited by the
;; program.
@@ -86,13 +83,15 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
"Name of the Gomoku buffer.")
;; You may change these values if you have a small screen or if the squares
-;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
+;; look rectangular.
(defconst gomoku-square-width 4
- "Horizontal spacing between squares on the Gomoku board.")
+ "Horizontal spacing between squares on the Gomoku board.
+SHOULD be at least 2 (MUST BE at least 1).")
(defconst gomoku-square-height 2
- "Vertical spacing between squares on the Gomoku board.")
+ "Vertical spacing between squares on the Gomoku board.
+SHOULD be at least 2 (MUST BE at least 1).")
(defconst gomoku-x-offset 3
"Number of columns between the Gomoku board and the side of the window.")
@@ -270,13 +269,13 @@ Other useful commands:\n
;; internested 5-tuples of contiguous squares (called qtuples).
;;
;; The aim of the program is to fill one qtuple with its O's while preventing
-;; you from filling another one with your X's. To that effect, it computes a
-;; score for every qtuple, with better qtuples having better scores. Of
+;; you from filling another one with your X's. To that effect, it computes a
+;; score for every qtuple, with better qtuples having better scores. Of
;; course, the score of a qtuple (taken in isolation) is just determined by
-;; its contents as a set, i.e. not considering the order of its elements. The
+;; its contents as a set, i.e. not considering the order of its elements. The
;; highest score is given to the "OOOO" qtuples because playing in such a
-;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
-;; not playing in it is just losing the game, and so on. Note that a
+;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
+;; not playing in it is just losing the game, and so on. Note that a
;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
;; has score zero because there is no more any point in playing in it, from
;; both an attacking and a defending point of view.
@@ -284,11 +283,11 @@ Other useful commands:\n
;; Given the score of every qtuple, the score of a given free square on the
;; board is just the sum of the scores of all the qtuples to which it belongs,
;; because playing in that square is playing in all its containing qtuples at
-;; once. And it is that function which takes into account the internesting of
+;; once. And it is that function which takes into account the internesting of
;; the qtuples.
;;
;; This algorithm is rather simple but anyway it gives a not so dumb level of
-;; play. It easily extends to "n-dimensional Gomoku", where a win should not
+;; play. It easily extends to "n-dimensional Gomoku", where a win should not
;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !)
;; should be preferred.
@@ -323,8 +322,8 @@ Other useful commands:\n
;; because "a" mainly belongs to six "XX" qtuples (the others are less
;; important) while "b" belongs to one "XXX" and one "XX" qtuples. Other
;; conditions are required to obtain sensible moves, but the previous example
-;; should illustrate the point. If you manage to improve on these values,
-;; please send me a note. Thanks.
+;; should illustrate the point. If you manage to improve on these values,
+;; please send me a note. Thanks.
;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the
@@ -343,9 +342,9 @@ Other useful commands:\n
;; If you do not modify drastically the previous constants, the only way for a
;; square to have a score higher than gomoku-OOOOscore is to belong to a "OOOO"
-;; qtuple, thus to be a winning move. Similarly, the only way for a square to
+;; qtuple, thus to be a winning move. Similarly, the only way for a square to
;; have a score between gomoku-XXXXscore and gomoku-OOOOscore is to belong to a "XXXX"
-;; qtuple. We may use these considerations to detect when a given move is
+;; qtuple. We may use these considerations to detect when a given move is
;; winning or losing.
(defconst gomoku-winning-threshold gomoku-OOOOscore
@@ -357,8 +356,8 @@ Other useful commands:\n
(defun gomoku-strongest-square ()
"Compute index of free square with highest score, or nil if none."
- ;; We just have to loop other all squares. However there are two problems:
- ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
+ ;; We just have to loop other all squares. However there are two problems:
+ ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
;; up future searches, we set the score of padding or occupied squares
;; to -1 whenever we meet them.
;; 2/ We want to choose randomly between equally good moves.
@@ -378,7 +377,7 @@ Other useful commands:\n
best-square square
score-max score)
(aset gomoku-score-table square -1))) ; no: kill it !
- ;; If score is equally good, choose randomly. But first check freedom:
+ ;; If score is equally good, choose randomly. But first check freedom:
((not (zerop (aref gomoku-board square)))
(aset gomoku-score-table square -1))
((zerop (random (setq count (1+ count))))
@@ -392,11 +391,11 @@ Other useful commands:\n
;;;
;; At initialization the board is empty so that every qtuple amounts for
-;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score times the number
-;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
-;; are sufficiently far from the sides. As computing the number is time
+;; gomoku-nil-score. Therefore, the score of any square is gomoku-nil-score times the number
+;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
+;; are sufficiently far from the sides. As computing the number is time
;; consuming, we initialize every square with 20*gomoku-nil-score and then only
-;; consider squares at less than 5 squares from one side. We speed this up by
+;; consider squares at less than 5 squares from one side. We speed this up by
;; taking symmetry into account.
;; Also, as it is likely that successive games will be played on a board with
;; same size, it is a good idea to save the initial SCORE-TABLE configuration.
@@ -451,7 +450,7 @@ Other useful commands:\n
"Return the number of qtuples containing square I,J."
;; This function is complicated because we have to deal
;; with ugly cases like 3 by 6 boards, but it works.
- ;; If you have a simpler (and correct) solution, send it to me. Thanks !
+ ;; If you have a simpler (and correct) solution, send it to me. Thanks !
(let ((left (min 4 (1- i)))
(right (min 4 (- gomoku-board-width i)))
(up (min 4 (1- j)))
@@ -477,9 +476,9 @@ Other useful commands:\n
;;;
;; We do not provide functions for computing the SCORE-TABLE given the
-;; contents of the BOARD. This would involve heavy nested loops, with time
-;; proportional to the size of the board. It is better to update the
-;; SCORE-TABLE after each move. Updating needs not modify more than 36
+;; contents of the BOARD. This would involve heavy nested loops, with time
+;; proportional to the size of the board. It is better to update the
+;; SCORE-TABLE after each move. Updating needs not modify more than 36
;; squares: it is done in constant time.
(defun gomoku-update-score-table (square dval)
@@ -782,7 +781,7 @@ Use \\[describe-mode] for more info."
(defun gomoku-emacs-plays ()
"Compute Emacs next move and play it."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -815,7 +814,7 @@ Use \\[describe-mode] for more info."
;; pixels, event's (X . Y) is a character's top-left corner.
(defun gomoku-click (click)
"Position at the square where you click."
- (interactive "e")
+ (interactive "e" gomoku-mode)
(and (windowp (posn-window (setq click (event-end click))))
(numberp (posn-point click))
(select-window (posn-window click))
@@ -844,7 +843,7 @@ Use \\[describe-mode] for more info."
(defun gomoku-mouse-play (click)
"Play at the square where you click."
- (interactive "e")
+ (interactive "e" gomoku-mode)
(if (gomoku-click click)
(gomoku-human-plays)))
@@ -852,7 +851,7 @@ Use \\[describe-mode] for more info."
"Signal to the Gomoku program that you have played.
You must have put the cursor on the square where you want to play.
If the game is finished, this command requests for another game."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -880,7 +879,7 @@ If the game is finished, this command requests for another game."
(defun gomoku-human-takes-back ()
"Signal to the Gomoku program that you wish to take back your last move."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -904,7 +903,7 @@ If the game is finished, this command requests for another game."
(defun gomoku-human-resigns ()
"Signal to the Gomoku program that you may want to resign."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-switch-to-window)
(cond
(gomoku-emacs-is-computing
@@ -1162,20 +1161,20 @@ If the game is finished, this command requests for another game."
;; the screen.
(defun gomoku-move-right ()
"Move point right one column on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (< (gomoku-point-x) gomoku-board-width)
(forward-char gomoku-square-width)))
(defun gomoku-move-left ()
"Move point left one column on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (> (gomoku-point-x) 1)
(backward-char gomoku-square-width)))
;; previous-line and next-line don't work right with intangible newlines
(defun gomoku-move-down ()
"Move point down one row on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (< (gomoku-point-y) gomoku-board-height)
(let ((column (current-column)))
(forward-line gomoku-square-height)
@@ -1183,7 +1182,7 @@ If the game is finished, this command requests for another game."
(defun gomoku-move-up ()
"Move point up one row on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(when (> (gomoku-point-y) 1)
(let ((column (current-column)))
(forward-line (- gomoku-square-height))
@@ -1191,36 +1190,36 @@ If the game is finished, this command requests for another game."
(defun gomoku-move-ne ()
"Move point North East on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-up)
(gomoku-move-right))
(defun gomoku-move-se ()
"Move point South East on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-down)
(gomoku-move-right))
(defun gomoku-move-nw ()
"Move point North West on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-up)
(gomoku-move-left))
(defun gomoku-move-sw ()
"Move point South West on the Gomoku board."
- (interactive)
+ (interactive nil gomoku-mode)
(gomoku-move-down)
(gomoku-move-left))
(defun gomoku-beginning-of-line ()
"Move point to first square on the Gomoku board row."
- (interactive)
+ (interactive nil gomoku-mode)
(move-to-column gomoku-x-offset))
(defun gomoku-end-of-line ()
"Move point to last square on the Gomoku board row."
- (interactive)
+ (interactive nil gomoku-mode)
(move-to-column (+ gomoku-x-offset
(* gomoku-square-width (1- gomoku-board-width)))))
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 98da26c2e6c..2aec408e11b 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -90,7 +90,8 @@
(define-key map [handwrite] '("Write by hand" . handwrite))
map))
(fset 'menu-bar-handwrite-map menu-bar-handwrite-map)
-
+(make-obsolete 'menu-bar-handwrite-map nil "28.1")
+(make-obsolete-variable 'menu-bar-handwrite-map nil "28.1")
;; User definable variables
@@ -199,7 +200,7 @@ Variables: `handwrite-linespace' (default 12)
(concat "\\\\" (cdr trans))
line)))
(switch-to-buffer ps-buf-name)
- (insert (replace-regexp-in-string "\n" "" line))
+ (insert (string-replace "\n" "" line))
(message "write write write...")
(setq ps-ypos (+ ps-ypos handwrite-linespace))
(end-of-line)
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index f6e5fcd3675..ac28fba10a4 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -1,4 +1,4 @@
-;;; hanoi.el --- towers of hanoi in Emacs
+;;; hanoi.el --- towers of hanoi in Emacs -*- lexical-binding: t -*-
;; Author: Damon Anton Permezel
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
index 8e09c225059..bfb25ba1d56 100644
--- a/lisp/play/morse.el
+++ b/lisp/play/morse.el
@@ -79,17 +79,16 @@
("8" . "---..")
("9" . "----.")
;; Non-ASCII
- ("Ä" . ".-.-")
- ("Æ" . ".-.-")
- ("Á" . ".--.-")
- ("Å" . ".--.-")
- ;; ligature character?? ("Ch" . "----")
- ("ß" . ".../...")
- ("É" . "..-..")
- ("Ñ" . "--.--")
- ("Ö" . "---.")
- ("Ø" . "---.")
- ("Ü" . "..--")
+ ("ä" . ".-.-")
+ ("æ" . ".-.-")
+ ("á" . ".--.-")
+ ("å" . ".--.-")
+ ("ß" . ".../...") ; also ...--..
+ ("é" . "..-..")
+ ("ñ" . "--.--")
+ ("ö" . "---.")
+ ("ø" . "---.")
+ ("ü" . "..--")
;; Recently standardized
("@" . ".--.-."))
"Morse code character set.")
@@ -146,7 +145,7 @@
"NATO phonetic alphabet.
See “International Code of Signals” (INTERCO), United States
Edition, 1969 Edition (Revised 2003) available from National
-Geospatial-Intelligence Agency at URL `http://www.nga.mil/'")
+Geospatial-Intelligence Agency at URL `https://www.nga.mil/'")
;;;###autoload
(defun morse-region (beg end)
@@ -165,7 +164,7 @@ Geospatial-Intelligence Agency at URL `http://www.nga.mil/'")
(setq sep ""))
((setq morse (assoc str morse-code))
(delete-char 1)
- (insert sep (cdr morse))
+ (insert-before-markers sep (cdr morse))
(setq sep "/"))
(t
(forward-char 1)
@@ -211,7 +210,7 @@ Geospatial-Intelligence Agency at URL `http://www.nga.mil/'")
(setq sep ""))
((setq nato (assoc str nato-alphabet))
(delete-char 1)
- (insert sep (cdr nato))
+ (insert-before-markers sep (cdr nato))
(setq sep "-"))
(t
(forward-char 1)
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index bed7cea6ee5..29effa23460 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -336,38 +336,38 @@ Argument SNAKE-BUFFER is the name of the buffer."
(defun snake-move-left ()
"Make the snake move left."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-x-velocity))
(push '(-1 0) snake-velocity-queue)))
(defun snake-move-right ()
"Make the snake move right."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-x-velocity))
(push '(1 0) snake-velocity-queue)))
(defun snake-move-up ()
"Make the snake move up."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-y-velocity))
(push '(0 -1) snake-velocity-queue)))
(defun snake-move-down ()
"Make the snake move down."
- (interactive)
+ (interactive nil snake-mode)
(when (zerop (snake-final-y-velocity))
(push '(0 1) snake-velocity-queue)))
(defun snake-end-game ()
"Terminate the current game."
- (interactive)
+ (interactive nil snake-mode)
(gamegrid-kill-timer)
(use-local-map snake-null-map)
(gamegrid-add-score snake-score-file snake-score))
(defun snake-start-game ()
"Start a new game of Snake."
- (interactive)
+ (interactive nil snake-mode)
(snake-reset-game)
(snake-set-dot)
(use-local-map snake-mode-map)
@@ -375,7 +375,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(defun snake-pause-game ()
"Pause (or resume) the current game."
- (interactive)
+ (interactive nil snake-mode)
(setq snake-paused (not snake-paused))
(message (and snake-paused "Game paused (press p to resume)")))
@@ -386,6 +386,7 @@ Argument SNAKE-BUFFER is the name of the buffer."
(define-derived-mode snake-mode special-mode "Snake"
"A mode for playing Snake."
+ :interactive nil
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 05e4ffe0111..f43aa47326f 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -506,7 +506,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-bottom ()
"Drop the shape to the bottom of the playing area."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(let ((hit nil))
(tetris-erase-shape)
@@ -519,7 +519,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-left ()
"Move the shape one square to the left."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1- tetris-pos-x))
@@ -529,7 +529,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-right ()
"Move the shape one square to the right."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1+ tetris-pos-x))
@@ -539,7 +539,7 @@ Drops the shape one square, testing for collision."
(defun tetris-move-down ()
"Move the shape one square to the bottom."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-y (1+ tetris-pos-y))
@@ -549,7 +549,7 @@ Drops the shape one square, testing for collision."
(defun tetris-rotate-prev ()
"Rotate the shape clockwise."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-rot (% (+ 1 tetris-rot)
@@ -561,7 +561,7 @@ Drops the shape one square, testing for collision."
(defun tetris-rotate-next ()
"Rotate the shape anticlockwise."
- (interactive)
+ (interactive nil tetris-mode)
(unless tetris-paused
(tetris-erase-shape)
(setq tetris-rot (% (+ 3 tetris-rot)
@@ -573,14 +573,14 @@ Drops the shape one square, testing for collision."
(defun tetris-end-game ()
"Terminate the current game."
- (interactive)
+ (interactive nil tetris-mode)
(gamegrid-kill-timer)
(use-local-map tetris-null-map)
(gamegrid-add-score tetris-score-file tetris-score))
(defun tetris-start-game ()
"Start a new game of Tetris."
- (interactive)
+ (interactive nil tetris-mode)
(tetris-reset-game)
(use-local-map tetris-mode-map)
(let ((period (or (tetris-get-tick-period)
@@ -589,7 +589,7 @@ Drops the shape one square, testing for collision."
(defun tetris-pause-game ()
"Pause (or resume) the current game."
- (interactive)
+ (interactive nil tetris-mode)
(setq tetris-paused (not tetris-paused))
(message (and tetris-paused "Game paused (press p to resume)")))
@@ -600,6 +600,7 @@ Drops the shape one square, testing for collision."
(define-derived-mode tetris-mode nil "Tetris"
"A mode for playing Tetris."
+ :interactive nil
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 70b6a01a017..19e4e399ff3 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,4 +1,4 @@
-;;; zone.el --- idle display hacks
+;;; zone.el --- idle display hacks -*- lexical-binding: t -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -128,14 +128,17 @@ If the element is a function or a list of a function and a number,
(let ((pgm (elt zone-programs (random (length zone-programs))))
(ct (and f (frame-parameter f 'cursor-type)))
(show-trailing-whitespace nil)
- (restore (list '(kill-buffer outbuf))))
+ restore)
(when ct
- (modify-frame-parameters f '((cursor-type . (bar . 0))))
- (setq restore (cons '(modify-frame-parameters
- f (list (cons 'cursor-type ct)))
- restore)))
+ (modify-frame-parameters f '((cursor-type . (bar . 0)))))
;; Make `restore' a self-disabling one-shot thunk.
- (setq restore `(lambda () ,@restore (setq restore nil)))
+ (setq restore
+ (lambda ()
+ (when ct
+ (modify-frame-parameters
+ f (list (cons 'cursor-type ct))))
+ (kill-buffer outbuf)
+ (setq restore nil)))
(condition-case nil
(progn
(message "Zoning... (%s)" pgm)
@@ -419,7 +422,7 @@ If the element is a function or a list of a function and a number,
(defsubst zone-replace-char (count del-count char-as-string new-value)
(delete-char (or del-count (- count)))
(aset char-as-string 0 new-value)
- (dotimes (i count) (insert char-as-string)))
+ (dotimes (_ count) (insert char-as-string)))
(defsubst zone-park/sit-for (pos seconds)
(let ((p (point)))
@@ -460,7 +463,7 @@ If the element is a function or a list of a function and a number,
(let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0)
(setq line (concat line "\n"))
- (dotimes (i nl)
+ (dotimes (_ nl)
(insert line))))
(goto-char start)
(recenter 0)
diff --git a/lisp/plstore.el b/lisp/plstore.el
index 46533664d52..4ca5886bf15 100644
--- a/lisp/plstore.el
+++ b/lisp/plstore.el
@@ -1,4 +1,5 @@
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
+
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
@@ -19,7 +20,7 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;; Commentary
+;;; Commentary:
;; Plist based data store providing search and partial encryption.
;;
diff --git a/lisp/printing.el b/lisp/printing.el
index 2f234b7b052..e7aab901d53 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -103,14 +103,14 @@ Please send all bug fixes and enhancements to
;; For example, after previewing a PostScript file, *Printing Command Output*
;; will have the following entry:
;;
-;; /usr/X11R6/bin/gv ("/home/user/example/file.ps")
+;; /usr/bin/gv ("/home/user/example/file.ps")
;; Exit status: 0
;;
;; In the example above, the previewing was successful. If during previewing,
;; you quit gv execution (by typing C-g during Emacs session), the log entry
;; would be:
;;
-;; /usr/X11R6/bin/gv ("/home/user/example/file.ps")
+;; /usr/bin/gv ("/home/user/example/file.ps")
;; Exit status: Quit
;;
;; So, if something goes wrong, a good place to take a look is the buffer
@@ -264,7 +264,7 @@ Please send all bug fixes and enhancements to
;; Also the gsprint utility comes together with gsview distribution.
;;
;; For more information about gsprint see
-;; `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
+;; `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
;;
;; As an example of gsprint declaration:
;;
@@ -950,18 +950,18 @@ Please send all bug fixes and enhancements to
;; * For GNU or Unix system:
;;
;; gs, gv `https://www.gnu.org/software/ghostscript/ghostscript.html'
-;; enscript `http://people.ssh.fi/mtr/genscript/'
+;; enscript `https://people.ssh.fi/mtr/genscript/'
;; psnup `http://www.knackered.org/angus/psutils/'
-;; mpage `http://www.mesa.nl/pub/mpage/'
+;; mpage `https://www.mesa.nl/pub/mpage/'
;;
;; * For Windows system:
;;
;; gswin32, gsview32
;; `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/'
+;; gsprint `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
+;; enscript `https://people.ssh.fi/mtr/genscript/'
;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm'
-;; redmon `http://www.cs.wisc.edu/~ghost/redmon/'
+;; redmon `http://www.ghostgum.com.au/software/redmon.htm'
;;
;;
;; Acknowledgments
@@ -1014,7 +1014,6 @@ Please send all bug fixes and enhancements to
(require 'lpr)
(require 'ps-print)
-(require 'easymenu)
(and (string< ps-print-version "6.6.4")
(error "`printing' requires `ps-print' package version 6.6.4 or later"))
@@ -1082,24 +1081,15 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
"Specify Printing menu-bar entry.")
(defun pr-global-menubar (menu-spec)
- (let ((menu-file '("menu-bar" "file")))
- (cond
- (pr-menu-print-item
- (easy-menu-add-item global-map menu-file
- (easy-menu-create-menu "Print" menu-spec)
- "print-buffer")
- (dolist (item '("print-buffer" "print-region"
- "ps-print-buffer-faces" "ps-print-region-faces"
- "ps-print-buffer" "ps-print-region"))
- (easy-menu-remove-item global-map menu-file item))
- (setq pr-menu-print-item nil
- pr-menu-bar (vector 'menu-bar
- (easy-menu-intern (nth 1 menu-file))
- (easy-menu-intern "Print"))))
- (t
- (easy-menu-add-item global-map menu-file
- (easy-menu-create-menu "Print" menu-spec)))
- )))
+ (let ((menu-file '("menu-bar" "file"))
+ (submenu-path [menu-bar file Print])
+ (submenu (easy-menu-create-menu "Print" menu-spec)))
+ (cond (pr-menu-print-item
+ (easy-menu-add-item global-map menu-file submenu "Print")
+ (easy-menu-remove-item global-map menu-file "print")
+ (setq pr-menu-print-item nil
+ pr-menu-bar submenu-path))
+ (t (easy-menu-add-item global-map menu-file submenu)))))
(defun pr-menu-position (entry index horizontal)
(let ((pos (cdr (mouse-pixel-position))))
@@ -1521,22 +1511,19 @@ Examples:
Useful links:
* Information about the print command (print.exe)
- `http://www.computerhope.com/printhlp.htm'
+ `https://www.computerhope.com/printhlp.htm'
* RedMon - Redirection Port Monitor (redpr.exe)
- `http://www.cs.wisc.edu/~ghost/redmon/index.htm'
+ `http://www.ghostgum.com.au/software/redmon.htm'
* Redirection Port Monitor (redpr.exe on-line help)
- `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm'
+ `https://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm'
* UNIX man pages: lpr (or type `man lpr')
- `http://bama.ua.edu/cgi-bin/man-cgi?lpr'
- `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr'
+ `https://linux.die.net/man/1/lpr-cups'
* UNIX man pages: lp (or type `man lp')
- `http://bama.ua.edu/cgi-bin/man-cgi?lp'
- `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp'
-"
+ `https://linux.die.net/man/1/lp'"
:type '(repeat
(list :tag "Text Printer"
(symbol :tag "Printer Symbol Name")
@@ -1761,30 +1748,28 @@ are not printed.
Useful links:
* GSPRINT - Ghostscript print to Windows printer
- `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'
+ `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'
* Introduction to Ghostscript
- `http://www.cs.wisc.edu/~ghost/doc/intro.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/intro.htm'
* How to use Ghostscript
- `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
* Information about the print command (print.exe)
- `http://www.computerhope.com/printhlp.htm'
+ `https://www.computerhope.com/printhlp.htm'
* RedMon - Redirection Port Monitor (redpr.exe)
- `http://www.cs.wisc.edu/~ghost/redmon/index.htm'
+ `http://www.ghostgum.com.au/software/redmon.htm'
* Redirection Port Monitor (redpr.exe on-line help)
- `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm'
+ `https://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm'
* UNIX man pages: lpr (or type `man lpr')
- `http://bama.ua.edu/cgi-bin/man-cgi?lpr'
- `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr'
+ `https://linux.die.net/man/1/lpr-cups'
* UNIX man pages: lp (or type `man lp')
- `http://bama.ua.edu/cgi-bin/man-cgi?lp'
- `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp'
+ `https://linux.die.net/man/1/lp'
* GNU utilities for w32 (cp.exe)
`http://unxutils.sourceforge.net/'
@@ -1874,28 +1859,28 @@ Useful links:
`https://www.gnu.org/software/gv/manual/gv.html'
* GSview Help
- `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm'
+ `https://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm'
* GSview Help - Common Problems
- `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm#Common_Problems'
+ `https://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm#Common_Problems'
* GSview Readme (compilation & installation)
- `http://www.cs.wisc.edu/~ghost/gsview/Readme.htm'
+ `https://www.cs.wisc.edu/~ghost/gsview/Readme.htm'
* GSview (main site)
- `http://www.cs.wisc.edu/~ghost/gsview/index.htm'
+ `https://www.cs.wisc.edu/~ghost/gsview/index.htm'
* Ghostscript, Ghostview and GSview
- `http://www.cs.wisc.edu/~ghost/'
+ `https://www.cs.wisc.edu/~ghost/'
* Ghostview
- `http://www.cs.wisc.edu/~ghost/gv/index.htm'
+ `https://www.cs.wisc.edu/~ghost/gv/index.htm'
* gv 3.5, June 1997
- `http://www.cs.wisc.edu/~ghost/gv/gv_doc/gv.html'
+ `http://pages.cs.wisc.edu/~ghost/gv/gv_doc/gv.html'
* MacGSView (Mac OS)
- `http://www.cs.wisc.edu/~ghost/macos/index.htm'
+ `http://pages.cs.wisc.edu/~ghost/macos/index.htm'
"
:type '(string :tag "Ghostview Utility"))
@@ -1911,16 +1896,16 @@ See also `pr-path-alist'.
Useful links:
* Ghostscript, Ghostview and GSview
- `http://www.cs.wisc.edu/~ghost/'
+ `https://www.cs.wisc.edu/~ghost/'
* Introduction to Ghostscript
- `http://www.cs.wisc.edu/~ghost/doc/intro.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/intro.htm'
* How to use Ghostscript
- `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
* Printer compatibility
- `http://www.cs.wisc.edu/~ghost/doc/printer.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/printer.htm'
"
:type '(string :tag "Ghostscript Utility"))
@@ -1955,13 +1940,13 @@ To see ghostscript documentation for more information:
Useful links:
* Introduction to Ghostscript
- `http://www.cs.wisc.edu/~ghost/doc/intro.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/intro.htm'
* How to use Ghostscript
- `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
* Printer compatibility
- `http://www.cs.wisc.edu/~ghost/doc/printer.htm'
+ `https://www.cs.wisc.edu/~ghost/doc/printer.htm'
"
:type '(repeat (string :tag "Ghostscript Switch")))
@@ -2408,11 +2393,10 @@ Examples:
Useful links:
* mpage download (GNU or Unix)
- `http://www.mesa.nl/pub/mpage/'
+ `https://www.mesa.nl/pub/mpage/'
* mpage documentation (GNU or Unix - or type `man mpage')
- `http://www.cs.umd.edu/faq/guides/manual_unix/node48.html'
- `http://www.rt.com/man/mpage.1.html'
+ `https://linux.die.net/man/1/mpage'
* psnup (Windows, GNU or Unix)
`http://www.knackered.org/angus/psutils/'
@@ -2422,14 +2406,13 @@ Useful links:
`http://gnuwin32.sourceforge.net/packages/psutils.htm'
* psnup documentation (GNU or Unix - or type `man psnup')
- `http://linux.about.com/library/cmd/blcmdl1_psnup.htm'
- `http://amath.colorado.edu/computing/software/man/psnup.html'
+ `https://linux.die.net/man/1/psnup'
* GNU Enscript (Windows, GNU or Unix)
- `http://people.ssh.com/mtr/genscript/'
+ `https://people.ssh.com/mtr/genscript/'
* GNU Enscript documentation (Windows, GNU or Unix)
- `http://people.ssh.com/mtr/genscript/enscript.man.html'
+ `https://people.ssh.com/mtr/genscript/enscript.man.html'
(on GNU or Unix, type `man enscript')
"
:type '(repeat
@@ -4783,13 +4766,13 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-menu-create (name alist var-sym fun entry index)
(cons name
(mapcar
- #'(lambda (elt)
- (let ((sym (car elt)))
- (vector
- (symbol-name sym)
- `(,fun ',sym nil ',entry ',index)
- :style 'radio
- :selected `(eq ,var-sym ',sym))))
+ (lambda (elt)
+ (let ((sym (car elt)))
+ (vector
+ (symbol-name sym)
+ `(,fun ',sym nil ',entry ',index)
+ :style 'radio
+ :selected `(eq ,var-sym ',sym))))
alist)))
@@ -4891,23 +4874,23 @@ If menu binding was not done, calls `pr-menu-bind'."
(cons inherits old)))))
(mapc
(cond ((not local) ; global settings
- #'(lambda (option)
- (let ((var-sym (car option)))
- (or (eq var-sym 'inherits-from:)
- (set var-sym (eval (cdr option)))))))
+ (lambda (option)
+ (let ((var-sym (car option)))
+ (or (eq var-sym 'inherits-from:)
+ (set var-sym (eval (cdr option)))))))
(kill ; local settings with killing
- #'(lambda (option)
- (let ((var-sym (car option)))
- (unless (eq var-sym 'inherits-from:)
- (setq local-list (cons var-sym local-list))
- (set (make-local-variable var-sym)
- (eval (cdr option)))))))
+ (lambda (option)
+ (let ((var-sym (car option)))
+ (unless (eq var-sym 'inherits-from:)
+ (setq local-list (cons var-sym local-list))
+ (set (make-local-variable var-sym)
+ (eval (cdr option)))))))
(t ; local settings without killing
- #'(lambda (option)
- (let ((var-sym (car option)))
- (or (eq var-sym 'inherits-from:)
- (set (make-local-variable var-sym)
- (eval (cdr option))))))))
+ (lambda (option)
+ (let ((var-sym (car option)))
+ (or (eq var-sym 'inherits-from:)
+ (set (make-local-variable var-sym)
+ (eval (cdr option))))))))
(nthcdr 3 setting))
local-list))))
@@ -5085,9 +5068,9 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-complete-alist (prompt alist default)
- (let ((collection (mapcar #'(lambda (elt)
- (setq elt (car elt))
- (cons (symbol-name elt) elt))
+ (let ((collection (mapcar (lambda (elt)
+ (setq elt (car elt))
+ (cons (symbol-name elt) elt))
alist)))
(cdr (assoc (completing-read (concat prompt ": ")
collection nil t
@@ -5421,19 +5404,19 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-file-list (dir file-regexp fun)
- (mapcar #'(lambda (file)
- (and (or pr-list-directory
- (not (file-directory-p file)))
- (let ((buffer (pr-find-buffer-visiting file))
- pop-up-windows
- pop-up-frames)
- (and (or buffer
- (file-readable-p file))
- (with-current-buffer (or buffer
- (find-file-noselect file))
- (funcall fun)
- (or buffer
- (kill-buffer (current-buffer))))))))
+ (mapcar (lambda (file)
+ (and (or pr-list-directory
+ (not (file-directory-p file)))
+ (let ((buffer (pr-find-buffer-visiting file))
+ pop-up-windows
+ pop-up-frames)
+ (and (or buffer
+ (file-readable-p file))
+ (with-current-buffer (or buffer
+ (find-file-noselect file))
+ (funcall fun)
+ (or buffer
+ (kill-buffer (current-buffer))))))))
(directory-files dir t file-regexp)))
@@ -5446,10 +5429,10 @@ If menu binding was not done, calls `pr-menu-bind'."
(pr-delete-file-if-exists (setq filename (expand-file-name filename)))
(let ((pr-spool-p t))
(pr-file-list dir file-regexp
- #'(lambda ()
- (if (pr-auto-mode-p)
- (pr-ps-mode n-up filename)
- (pr-text2ps 'buffer n-up filename)))))
+ (lambda ()
+ (if (pr-auto-mode-p)
+ (pr-ps-mode n-up filename)
+ (pr-text2ps 'buffer n-up filename)))))
(or pr-spool-p
(pr-despool-print filename)))
@@ -5680,44 +5663,44 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-checkbox
"\n "
'pr-i-region
- #'(lambda (widget &rest _ignore)
- (let ((region-p (pr-interface-save
- (ps-mark-active-p))))
- (cond ((null (widget-value widget)) ; widget is nil
- (setq pr-i-region nil))
- (region-p ; widget is true and there is a region
- (setq pr-i-region t)
- (widget-value-set widget t)
- (widget-setup)) ; MUST be called after widget-value-set
- (t ; widget is true and there is no region
- (ding)
- (message "There is no region active")
- (setq pr-i-region nil)
- (widget-value-set widget nil)
- (widget-setup))))) ; MUST be called after widget-value-set
+ (lambda (widget &rest _ignore)
+ (let ((region-p (pr-interface-save
+ (ps-mark-active-p))))
+ (cond ((null (widget-value widget)) ; widget is nil
+ (setq pr-i-region nil))
+ (region-p ; widget is true and there is a region
+ (setq pr-i-region t)
+ (widget-value-set widget t)
+ (widget-setup)) ; MUST be called after widget-value-set
+ (t ; widget is true and there is no region
+ (ding)
+ (message "There is no region active")
+ (setq pr-i-region nil)
+ (widget-value-set widget nil)
+ (widget-setup))))) ; MUST be called after widget-value-set
" Region"))
;; 1a. Buffer: Mode
(put 'pr-i-mode 'pr-widget
(pr-insert-checkbox
" "
'pr-i-mode
- #'(lambda (widget &rest _ignore)
- (let ((mode-p (pr-interface-save
- (pr-mode-alist-p))))
- (cond
- ((null (widget-value widget)) ; widget is nil
- (setq pr-i-mode nil))
- (mode-p ; widget is true and there is a `mode'
- (setq pr-i-mode t)
- (widget-value-set widget t)
- (widget-setup)) ; MUST be called after widget-value-set
- (t ; widget is true and there is no `mode'
- (ding)
- (message
- "This buffer isn't in a mode that printing treats specially.")
- (setq pr-i-mode nil)
- (widget-value-set widget nil)
- (widget-setup))))) ; MUST be called after widget-value-set
+ (lambda (widget &rest _ignore)
+ (let ((mode-p (pr-interface-save
+ (pr-mode-alist-p))))
+ (cond
+ ((null (widget-value widget)) ; widget is nil
+ (setq pr-i-mode nil))
+ (mode-p ; widget is true and there is a `mode'
+ (setq pr-i-mode t)
+ (widget-value-set widget t)
+ (widget-setup)) ; MUST be called after widget-value-set
+ (t ; widget is true and there is no `mode'
+ (ding)
+ (message
+ "This buffer isn't in a mode that printing treats specially.")
+ (setq pr-i-mode nil)
+ (widget-value-set widget nil)
+ (widget-setup))))) ; MUST be called after widget-value-set
" Mode\n"))
;; 1b. Directory:
@@ -5777,14 +5760,14 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-checkbox
" "
'pr-i-despool
- #'(lambda (widget &rest _ignore)
- (if pr-spool-p
- (setq pr-i-despool (not pr-i-despool))
- (ding)
- (message "Can despool only when spooling is actually selected")
- (setq pr-i-despool nil))
- (widget-value-set widget pr-i-despool)
- (widget-setup)) ; MUST be called after widget-value-set
+ (lambda (widget &rest _ignore)
+ (if pr-spool-p
+ (setq pr-i-despool (not pr-i-despool))
+ (ding)
+ (message "Can despool only when spooling is actually selected")
+ (setq pr-i-despool nil))
+ (widget-value-set widget pr-i-despool)
+ (widget-setup)) ; MUST be called after widget-value-set
" Despool "))
;; 2. PostScript Printer: Preview Print Quit
(pr-insert-button 'pr-interface-preview "Preview" " ")
@@ -5843,9 +5826,9 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; 4. Settings:
;; 4. Settings: Landscape Auto Region Verbose
(pr-insert-checkbox "\n\n " 'ps-landscape-mode
- #'(lambda (&rest _ignore)
- (setq ps-landscape-mode (not ps-landscape-mode)
- pr-file-landscape ps-landscape-mode))
+ (lambda (&rest _ignore)
+ (setq ps-landscape-mode (not ps-landscape-mode)
+ pr-file-landscape ps-landscape-mode))
" Landscape ")
(pr-insert-toggle 'pr-auto-region " Auto Region ")
(pr-insert-toggle 'pr-buffer-verbose " Verbose\n ")
@@ -5865,28 +5848,28 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-toggle 'ps-zebra-stripes " Zebra Stripes")
(pr-insert-checkbox " "
'pr-spool-p
- #'(lambda (&rest _ignore)
- (setq pr-spool-p (not pr-spool-p))
- (unless pr-spool-p
- (setq pr-i-despool nil)
- (pr-update-checkbox 'pr-i-despool)))
+ (lambda (&rest _ignore)
+ (setq pr-spool-p (not pr-spool-p))
+ (unless pr-spool-p
+ (setq pr-i-despool nil)
+ (pr-update-checkbox 'pr-i-despool)))
" Spool Buffer")
;; 4. Settings: Duplex Print with faces
(pr-insert-checkbox "\n "
'ps-spool-duplex
- #'(lambda (&rest _ignore)
- (setq ps-spool-duplex (not ps-spool-duplex)
- pr-file-duplex ps-spool-duplex))
+ (lambda (&rest _ignore)
+ (setq ps-spool-duplex (not ps-spool-duplex)
+ pr-file-duplex ps-spool-duplex))
" Duplex ")
(pr-insert-toggle 'pr-faces-p " Print with faces")
;; 4. Settings: Tumble Print via Ghostscript
(pr-insert-checkbox "\n "
'ps-spool-tumble
- #'(lambda (&rest _ignore)
- (setq ps-spool-tumble (not ps-spool-tumble)
- pr-file-tumble ps-spool-tumble))
+ (lambda (&rest _ignore)
+ (setq ps-spool-tumble (not ps-spool-tumble)
+ pr-file-tumble ps-spool-tumble))
" Tumble ")
(pr-insert-toggle 'pr-print-using-ghostscript " Print via Ghostscript\n ")
@@ -5894,11 +5877,11 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-toggle 'ps-print-upside-down " Upside-Down")
(pr-insert-italic "\n\nSelect Pages : " 2 14)
(pr-insert-menu "Page Parity" 'ps-even-or-odd-pages
- (mapcar #'(lambda (alist)
- (list 'choice-item
- :format "%[%t%]"
- :tag (cdr alist)
- :value (car alist)))
+ (mapcar (lambda (alist)
+ (list 'choice-item
+ :format "%[%t%]"
+ :tag (cdr alist)
+ :value (car alist)))
pr-even-or-odd-alist)))
@@ -5906,7 +5889,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; 5. Customize:
(pr-insert-italic "\n\nCustomize : " 2 11)
(pr-insert-button 'pr-customize "printing" " ")
- (pr-insert-button #'(lambda (&rest _ignore) (ps-print-customize))
+ (pr-insert-button (lambda (&rest _ignore) (ps-print-customize))
"ps-print" " ")
(pr-insert-button 'lpr-customize "lpr"))
@@ -6215,18 +6198,18 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defun pr-choice-alist (alist)
- (let ((max (apply #'max (mapcar #'(lambda (alist)
- (length (symbol-name (car alist))))
+ (let ((max (apply #'max (mapcar (lambda (alist)
+ (length (symbol-name (car alist))))
alist))))
- (mapcar #'(lambda (alist)
- (let* ((sym (car alist))
- (name (symbol-name sym)))
- (list
- 'choice-item
- :format "%[%t%]"
- :tag (concat name
- (make-string (- max (length name)) ?_))
- :value sym)))
+ (mapcar (lambda (alist)
+ (let* ((sym (car alist))
+ (name (symbol-name sym)))
+ (list
+ 'choice-item
+ :format "%[%t%]"
+ :tag (concat name
+ (make-string (- max (length name)) ?_))
+ :value sym)))
alist)))
@@ -6235,5 +6218,4 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(provide 'printing)
-
;;; printing.el ends here
diff --git a/lisp/proced.el b/lisp/proced.el
index d1a243df8e0..2fafdcc58e5 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1389,7 +1389,7 @@ The return string is always 6 characters wide."
(defun proced-format-args (args)
"Format attribute ARGS.
Replace newline characters by \"^J\" (two characters)."
- (replace-regexp-in-string "\n" "^J" args))
+ (string-replace "\n" "^J" args))
(defun proced-format (process-alist format)
"Display PROCESS-ALIST using FORMAT."
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 64d71f4aab2..4c427692cb8 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -499,7 +499,7 @@ RET: expand or collapse"))
(defun profiler-report-header-line-format (fmt &rest args)
(let* ((header (apply #'profiler-format fmt args))
- (escaped (replace-regexp-in-string "%" "%%" header)))
+ (escaped (string-replace "%" "%%" header)))
(concat
(propertize " "
'display '(space :align-to 0)
@@ -822,8 +822,12 @@ below entry at point."
(defun profiler-start (mode)
"Start/restart profilers.
MODE can be one of `cpu', `mem', or `cpu+mem'.
-If MODE is `cpu' or `cpu+mem', time-based profiler will be started.
-Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started."
+If MODE is `cpu' or `cpu+mem', start the time-based profiler,
+ whereby CPU is sampled periodically using the SIGPROF signal.
+If MODE is `mem' or `cpu+mem', start profiler that samples CPU
+ whenever memory-allocation functions are called -- this is useful
+ if SIGPROF is not supported, or is unreliable, or is not sampling
+ at a high enough frequency."
(interactive
(list (if (not (fboundp 'profiler-cpu-start)) 'mem
(intern (completing-read (format-prompt "Mode" "cpu")
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index e5b9ac0a537..2a4b3482831 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1,4 +1,4 @@
-;;; antlr-mode.el --- major mode for ANTLR grammar files
+;;; antlr-mode.el --- major mode for ANTLR grammar files -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -33,7 +33,7 @@
;; the manual style, follow all commands mentioned in the documentation of
;; `antlr-mode'. ANTLR is a LL(k)-based recognition tool which generates
;; lexers, parsers and tree transformers in Java, C++ or Sather and can be
-;; found at <http://www.antlr.org/>.
+;; found at <https://www.antlr.org/>.
;; Bug fixes, bug reports, improvements, and suggestions for the newest version
;; are strongly appreciated.
@@ -84,98 +84,17 @@
(eval-when-compile (require 'cl-lib))
-(require 'easymenu)
+(when (< emacs-major-version 28) ; preloaded in Emacs 28
+ (require 'easymenu))
(require 'cc-mode)
-;; Just to get the rid of the byte compiler warning. The code for
-;; this function and its friends are too complex for their own good.
-(declare-function cond-emacs-xemacs-macfn "antlr-mode" (args &optional msg))
-
-;; General Emacs/XEmacs-compatibility compile-time macros
-(eval-when-compile
- (defmacro cond-emacs-xemacs (&rest args)
- (cond-emacs-xemacs-macfn
- args "`cond-emacs-xemacs' must return exactly one element"))
- (defun cond-emacs-xemacs-macfn (args &optional msg)
- (if (atom args) args
- (and (eq (car args) :@) (null msg) ; (:@ ...spliced...)
- (setq args (cdr args)
- msg "(:@ ....) must return exactly one element"))
- (let ((ignore (if (featurep 'xemacs) :EMACS :XEMACS))
- (mode :BOTH) code)
- (while (consp args)
- (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args)))
- (if (atom args)
- (or args (error "Used selector %s without elements" mode))
- (or (eq ignore mode)
- (push (cond-emacs-xemacs-macfn (car args)) code))
- (pop args)))
- (cond (msg (if (or args (cdr code)) (error msg) (car code)))
- ((or (null args) (eq ignore mode)) (nreverse code))
- (t (nconc (nreverse code) args))))))
- ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use
- ;; existing functions when they are `fboundp', provide shortcuts if they are
- ;; known to be defined in a specific Emacs branch (for short .elc)
- (defmacro defunx (name arglist &rest definition)
- (let ((xemacsp (featurep 'xemacs)) reuses)
- (while (memq (car definition)
- '(:try :emacs-and-try :xemacs-and-try))
- (if (eq (pop definition) (if xemacsp :xemacs-and-try :emacs-and-try))
- (setq reuses (car definition)
- definition nil)
- (push (pop definition) reuses)))
- (if (and reuses (symbolp reuses))
- `(defalias ',name ',reuses)
- (let* ((docstring (if (stringp (car definition)) (pop definition)))
- (spec (and (not xemacsp)
- (eq (car-safe (car definition)) 'interactive)
- (null (cddar definition))
- (cadar definition))))
- (if (and (stringp spec)
- (not (string-equal spec ""))
- (eq (aref spec 0) ?_))
- (setq definition
- (cons (if (string-equal spec "_")
- '(interactive)
- `(interactive ,(substring spec 1)))
- (cdr definition))))
- (if (null reuses)
- `(defun ,name ,arglist ,docstring
- ,@(cond-emacs-xemacs-macfn definition))
- ;; no dynamic docstring in this case
- `(eval-and-compile ; no warnings in Emacs
- (defalias ',name
- (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func))
- (nreverse reuses))
- (t ,(if definition
- `(lambda ,arglist ,docstring
- ,@(cond-emacs-xemacs-macfn definition))
- 'ignore))))))))))
- (defmacro ignore-errors-x (&rest body)
- (let ((specials '((scan-sexps . 4) (scan-lists . 5)))
- spec nils)
- (if (and (featurep 'xemacs)
- (null (cdr body)) (consp (car body))
- (setq spec (assq (caar body) specials))
- (>= (setq nils (- (cdr spec) (length (car body)))) 0))
- `(,@(car body) ,@(make-list nils nil) t)
- `(ignore-errors ,@body)))))
-
;; More compile-time-macros
(eval-when-compile
(defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el
- (let ((modified (with-no-warnings (gensym "save-buffer-state-x-modified-"))))
- `(let ((,modified (buffer-modified-p)))
- (unwind-protect
- (let ((buffer-undo-list t) (inhibit-read-only t)
- ,@(unless (featurep 'xemacs)
- '((inhibit-point-motion-hooks t) deactivate-mark))
- (inhibit-modification-hooks t)
- buffer-file-name buffer-file-truename)
- ,@body)
- (and (not ,modified) (buffer-modified-p)
- (set-buffer-modified-p nil)))))))
-(put 'save-buffer-state-x 'lisp-indent-function 0)
+ (declare (debug t) (indent 0))
+ `(let ((inhibit-point-motion-hooks t))
+ (with-silent-modifications
+ ,@body))))
(defvar outline-level)
(defvar imenu-use-markers)
@@ -188,7 +107,7 @@
;; Additional to the `defalias' below, we must set `antlr-c-forward-sws' to
;; `c-forward-syntactic-ws' when `c-forward-sws' is not defined after requiring
;; cc-mode.
-(defalias 'antlr-c-forward-sws 'c-forward-sws)
+(defalias 'antlr-c-forward-sws #'c-forward-sws)
;;;;##########################################################################
@@ -231,7 +150,6 @@ value of `antlr-language' if the first group in the string matched by
REGEXP in `antlr-language-limit-n-regexp' is one of the OPTION-VALUEs.
An OPTION-VALUE of nil denotes the fallback element. MODELINE-STRING is
also displayed in the mode line next to \"Antlr\"."
- :group 'antlr
:type '(repeat (group :value (java-mode "")
(function :tag "Major mode")
(string :tag "Mode line string")
@@ -245,7 +163,6 @@ also displayed in the mode line next to \"Antlr\"."
Looks like \(LIMIT . REGEXP). Search for REGEXP from the beginning of
the buffer to LIMIT and use the first group in the matched string to set
the language according to `antlr-language-alist'."
- :group 'antlr
:type '(cons (choice :tag "Limit" (const :tag "No" nil) (integer :value 0))
regexp))
@@ -259,7 +176,6 @@ the language according to `antlr-language-alist'."
If nil, the actions with their surrounding braces are hidden. If a
number, do not hide the braces, only hide the contents if its length is
greater than this number."
- :group 'antlr
:type '(choice (const :tag "Completely hidden" nil)
(integer :tag "Hidden if longer than" :value 3)))
@@ -268,7 +184,6 @@ greater than this number."
If nil, no continuation line of a block comment is changed. If t, they
are changed according to `c-indentation-line'. When not nil and not t,
they are only changed by \\[antlr-indent-command]."
- :group 'antlr
:type '(radio (const :tag "No" nil)
(const :tag "Always" t)
(sexp :tag "With TAB" :format "%t" :value tab)))
@@ -282,7 +197,6 @@ The first element whose MAJOR-MODE is nil or equal to `major-mode' and
whose REGEXP is nil or matches variable `buffer-file-name' is used to
set `tab-width' and `indent-tabs-mode'. This is useful to support both
ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'."
- :group 'antlr
:type '(repeat (group :value (antlr-mode nil 8 nil)
(choice (const :tag "All" nil)
(function :tag "Major mode"))
@@ -294,14 +208,12 @@ ANTLR's and Java's indentation styles. Used by `antlr-set-tabs'."
"If non-nil, cc-mode indentation style used for `antlr-mode'.
See `c-set-style' and for details, where the most interesting part in
`c-style-alist' is the value of `c-basic-offset'."
- :group 'antlr
:type '(choice (const nil) regexp))
(defcustom antlr-indent-item-regexp
"[]}):;|&]" ; & is local ANTLR extension (SGML's and-connector)
"Regexp matching lines which should be indented by one TAB less.
See `antlr-indent-line' and command \\[antlr-indent-command]."
- :group 'antlr
:type 'regexp)
(defcustom antlr-indent-at-bol-alist
@@ -316,7 +228,6 @@ If `antlr-language' equals to a MODE, the line starting at the first
non-whitespace is matched by the corresponding REGEXP, and the line is
part of a header action, indent the line at column 0 instead according
to the normal rules of `antlr-indent-line'."
- :group 'antlr
:type '(repeat (cons (function :tag "Major mode") regexp)))
;; adopt indentation to cc-engine
@@ -337,7 +248,6 @@ to the normal rules of `antlr-indent-line'."
"Non-nil, if the major mode menu should include option submenus.
If nil, the menu just includes a command to insert options. Otherwise,
it includes four submenus to insert file/grammar/rule/subrule options."
- :group 'antlr
:type 'boolean)
(defcustom antlr-tool-version 20701
@@ -349,7 +259,6 @@ version correct option values when using \\[antlr-insert-option].
Don't use a number smaller than 20600 since the stored history of
Antlr's options starts with v2.06.00, see `antlr-options-alists'. You
can make this variable buffer-local."
- :group 'antlr
:type 'integer)
(defcustom antlr-options-auto-colon t
@@ -358,7 +267,6 @@ A `:' is only inserted if this value is non-nil, if a rule or subrule
option is inserted with \\[antlr-insert-option], if there was no rule or
subrule options section before, and if a `:' is not already present
after the section, ignoring whitespace, comments and the init action."
- :group 'antlr
:type 'boolean)
(defcustom antlr-options-style nil
@@ -369,7 +277,6 @@ identifier.
The only style symbol used in the default value of `antlr-options-alist'
is `language-as-string'. See also `antlr-read-value'."
- :group 'antlr
:type '(repeat (symbol :tag "Style symbol")))
(defcustom antlr-options-push-mark t
@@ -380,7 +287,6 @@ number, only set mark if point was outside the options area before and
the number of lines between point and the insert position is greater
than this value. Otherwise, only set mark if point was outside the
options area before."
- :group 'antlr
:type '(radio (const :tag "No" nil)
(const :tag "Always" t)
(integer :tag "Lines between" :value 10)
@@ -391,7 +297,6 @@ options area before."
This string is only used if the option to insert did not exist before
or if there was no `=' after it. In other words, the spacing around an
existing `=' won't be changed when changing an option value."
- :group 'antlr
:type 'string)
@@ -576,13 +481,11 @@ AS-STRING is non-nil and is either t or a symbol which is a member of
"Command used in \\[antlr-run-tool] to run the Antlr tool.
This variable should include all options passed to Antlr except the
option \"-glib\" which is automatically suggested if necessary."
- :group 'antlr
:type 'string)
(defcustom antlr-ask-about-save t
"If not nil, \\[antlr-run-tool] asks which buffers to save.
Otherwise, it saves all modified buffers before running without asking."
- :group 'antlr
:type 'boolean)
(defcustom antlr-makefile-specification
@@ -604,7 +507,6 @@ Then, GEN-VAR is a string with the name of the variable which contains
the file names of all makefile rules. GEN-VAR-FORMAT is a format string
producing the variable of each target with substitution COUNT/%d where
COUNT starts with 1. GEN-SEP is used to separate long variable values."
- :group 'antlr
:type '(list (string :tag "Rule separator")
(choice
(const :tag "Direct targets" nil)
@@ -683,7 +585,6 @@ DIRECTORY is the name of the current directory.")
"Non-nil, if a \"Index\" menu should be added to the menubar.
If it is a string, it is used instead \"Index\". Requires package
imenu."
- :group 'antlr
:type '(choice (const :tag "No menu" nil)
(const :tag "Index menu" t)
(string :tag "Other menu name")))
@@ -719,9 +620,7 @@ imenu."
(easy-menu-define antlr-mode-menu antlr-mode-map
"Major mode menu."
`("Antlr"
- ,@(if (cond-emacs-xemacs
- :EMACS antlr-options-use-submenus
- :XEMACS antlr-options-use-submenus)
+ ,@(if antlr-options-use-submenus
`(("Insert File Option"
:filter ,(lambda (x) (antlr-options-menu-filter 1 x)))
("Insert Grammar Option"
@@ -780,7 +679,6 @@ bound to `antlr-language'. For example, with value
((java-mode . 2) (c++-mode . 0))
Java actions are fontified with level 2 and C++ actions are not
fontified at all."
- :group 'antlr
:type '(choice (const :tag "None" none)
(const :tag "Inherit" inherit)
(const :tag "Default" nil)
@@ -824,62 +722,49 @@ in the grammar's actions and semantic predicates, see
(defface antlr-default '((t nil))
"Face to prevent strings from language dependent highlighting.
-Do not change."
- :group 'antlr)
+Do not change.")
(defface antlr-keyword
- (cond-emacs-xemacs
- '((((class color) (background light))
- (:foreground "black" :EMACS :weight bold :XEMACS :bold t))
- (t :inherit font-lock-keyword-face)))
- "ANTLR keywords."
- :group 'antlr)
+ '((((class color) (background light))
+ (:foreground "black" :weight bold))
+ (t :inherit font-lock-keyword-face))
+ "ANTLR keywords.")
(defface antlr-syntax
- (cond-emacs-xemacs
- '((((class color) (background light))
- (:foreground "black" :EMACS :weight bold :XEMACS :bold t))
- (t :inherit font-lock-constant-face)))
- "ANTLR syntax symbols like :, |, (, ), ...."
- :group 'antlr)
+ '((((class color) (background light))
+ (:foreground "black" :weight bold))
+ (t :inherit font-lock-constant-face))
+ "ANTLR syntax symbols like :, |, (, ), ....")
(defface antlr-ruledef
- (cond-emacs-xemacs
- '((((class color) (background light))
- (:foreground "blue" :EMACS :weight bold :XEMACS :bold t))
- (t :inherit font-lock-function-name-face)))
- "ANTLR rule references (definition)."
- :group 'antlr)
+ '((((class color) (background light))
+ (:foreground "blue" :weight bold))
+ (t :inherit font-lock-function-name-face))
+ "ANTLR rule references (definition).")
(defface antlr-tokendef
- (cond-emacs-xemacs
- '((((class color) (background light))
- (:foreground "blue" :EMACS :weight bold :XEMACS :bold t))
- (t :inherit font-lock-function-name-face)))
- "ANTLR token references (definition)."
- :group 'antlr)
+ '((((class color) (background light))
+ (:foreground "blue" :weight bold))
+ (t :inherit font-lock-function-name-face))
+ "ANTLR token references (definition).")
(defface antlr-ruleref
'((((class color) (background light)) (:foreground "blue4"))
(t :inherit font-lock-type-face))
- "ANTLR rule references (usage)."
- :group 'antlr)
+ "ANTLR rule references (usage).")
(defface antlr-tokenref
'((((class color) (background light)) (:foreground "orange4"))
(t :inherit font-lock-type-face))
- "ANTLR token references (usage)."
- :group 'antlr)
+ "ANTLR token references (usage).")
(defface antlr-literal
- (cond-emacs-xemacs
- '((((class color) (background light))
- (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t))
- (t :inherit font-lock-string-face)))
+ '((((class color) (background light))
+ (:foreground "brown4" :weight bold))
+ (t :inherit font-lock-string-face))
"ANTLR special literal tokens.
It is used to highlight strings matched by the first regexp group of
-`antlr-font-lock-literal-regexp'."
- :group 'antlr)
+`antlr-font-lock-literal-regexp'.")
(defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\""
"Regexp matching literals with special syntax highlighting, or nil.
@@ -887,7 +772,6 @@ If nil, there is no special syntax highlighting for some literals.
Otherwise, it should be a regular expression which must contain a regexp
group. The string matched by the first group is highlighted with
`antlr-font-lock-literal-face'."
- :group 'antlr
:type '(choice (const :tag "None" nil) regexp))
(defvar antlr-class-header-regexp
@@ -895,50 +779,48 @@ group. The string matched by the first group is highlighted with
"Regexp matching class headers.")
(defvar antlr-font-lock-additional-keywords
- (cond-emacs-xemacs
- `((antlr-invalidate-context-cache)
- ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))"
- (1 'antlr-tokendef))
- ("\\$\\sw+" (0 'antlr-keyword))
- ;; the tokens are already fontified as string/docstrings:
- (,(lambda (limit)
- (if antlr-font-lock-literal-regexp
- (antlr-re-search-forward antlr-font-lock-literal-regexp limit)))
- (1 'antlr-literal t)
- :XEMACS (0 nil)) ; XEmacs bug workaround
- (,(lambda (limit)
- (antlr-re-search-forward antlr-class-header-regexp limit))
- (1 'antlr-keyword)
- (2 'antlr-ruledef)
- (3 'antlr-keyword)
- (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
- 'antlr-keyword
- 'font-lock-type-face)))
- (,(lambda (limit)
- (antlr-re-search-forward
- "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
- limit))
+ `((antlr-invalidate-context-cache)
+ ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))"
+ (1 'antlr-tokendef))
+ ("\\$\\sw+" (0 'antlr-keyword))
+ ;; the tokens are already fontified as string/docstrings:
+ (,(lambda (limit)
+ (if antlr-font-lock-literal-regexp
+ (antlr-re-search-forward antlr-font-lock-literal-regexp limit)))
+ (1 'antlr-literal t))
+ (,(lambda (limit)
+ (antlr-re-search-forward antlr-class-header-regexp limit))
+ (1 'antlr-keyword)
+ (2 'antlr-ruledef)
+ (3 'antlr-keyword)
+ (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
+ 'antlr-keyword
+ 'font-lock-type-face)))
+ (,(lambda (limit)
+ (antlr-re-search-forward
+ "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
+ limit))
(1 'antlr-keyword))
- (,(lambda (limit)
- (antlr-re-search-forward
- "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?"
- limit))
- (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad
+ (,(lambda (limit)
+ (antlr-re-search-forward
+ "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?"
+ limit))
+ (1 'font-lock-type-face) ; not XEmacs's java level-3 fruit salad
(3 (if (antlr-upcase-p (char-after (match-beginning 3)))
'antlr-tokendef
'antlr-ruledef)
nil t)
(4 'antlr-syntax nil t))
- (,(lambda (limit)
- (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit))
+ (,(lambda (limit)
+ (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit))
(1 (if (antlr-upcase-p (char-after (match-beginning 0)))
'antlr-tokendef
'antlr-ruledef)
nil t)
(2 'antlr-syntax nil t))
- (,(lambda (limit)
- ;; v:ruleref and v:"literal" is allowed...
- (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit))
+ (,(lambda (limit)
+ ;; v:ruleref and v:"literal" is allowed...
+ (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit))
(1 (if (match-beginning 2)
(if (eq (char-after (match-beginning 2)) ?=)
'antlr-default
@@ -947,9 +829,9 @@ group. The string matched by the first group is highlighted with
'antlr-tokenref
'antlr-ruleref)))
(2 'antlr-default nil t))
- (,(lambda (limit)
- (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit))
- (0 'antlr-syntax))))
+ (,(lambda (limit)
+ (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit))
+ (0 'antlr-syntax)))
"Font-lock keywords for ANTLR's normal grammar code.
See `antlr-font-lock-keywords-alist' for the keywords of actions.")
@@ -1015,35 +897,6 @@ Used for `antlr-slow-syntactic-context'.")
;;; Syntax functions -- Emacs vs XEmacs dependent, part 1
;;;===========================================================================
-;; From help.el (XEmacs-21.1), without `copy-syntax-table'
-(defmacro antlr-with-syntax-table (syntab &rest body)
- "Evaluate BODY with the syntax table SYNTAB."
- `(let ((stab (syntax-table)))
- (unwind-protect
- (progn (set-syntax-table ,syntab) ,@body)
- (set-syntax-table stab))))
-(put 'antlr-with-syntax-table 'lisp-indent-function 1)
-(put 'antlr-with-syntax-table 'edebug-form-spec '(form body))
-
-(defunx antlr-default-directory ()
- :xemacs-and-try default-directory
- "Return `default-directory'."
- default-directory)
-
-;; Check Emacs-21.1 simple.el, `shell-command'.
-(defunx antlr-read-shell-command (prompt &optional initial-input history)
- :xemacs-and-try read-shell-command
- "Read a string from the minibuffer, using `shell-command-history'."
- (read-from-minibuffer prompt initial-input nil nil
- (or history 'shell-command-history)))
-
-(defunx antlr-with-displaying-help-buffer (thunk &optional _name)
- :xemacs-and-try with-displaying-help-buffer
- "Make a help buffer and call `thunk' there."
- (with-output-to-temp-buffer "*Help*"
- (save-excursion (funcall thunk))))
-
-
;;;===========================================================================
;;; Context cache
;;;===========================================================================
@@ -1056,26 +909,18 @@ Used for `antlr-slow-syntactic-context'.")
;;;(defvar antlr-statistics-cache 0)
;;;(defvar antlr-statistics-inval 0)
-(defunx antlr-invalidate-context-cache (&rest _dummies)
+(defun antlr-invalidate-context-cache (&rest _dummies)
;; checkdoc-params: (dummies)
"Invalidate context cache for syntactical context information."
- :XEMACS ; XEmacs bug workaround
- (with-current-buffer (get-buffer-create " ANTLR XEmacs bug workaround")
- (buffer-syntactic-context-depth)
- nil)
- :EMACS
;;; (cl-incf antlr-statistics-inval)
(setq antlr-slow-context-cache nil))
-(defunx antlr-syntactic-context ()
+(defun antlr-syntactic-context ()
"Return some syntactic context information.
Return `string' if point is within a string, `block-comment' or
`comment' is point is within a comment or the depth within all
parenthesis-syntax delimiters at point otherwise.
WARNING: this may alter `match-data'."
- :XEMACS
- (or (buffer-syntactic-context) (buffer-syntactic-context-depth))
- :EMACS
(let ((orig (point)) diff state
;; Arg, Emacs's (buffer-modified-tick) changes with font-lock. Use
;; hack that `loudly' is bound during font-locking => cache use will
@@ -1094,9 +939,9 @@ WARNING: this may alter `match-data'."
(if (>= orig antlr-slow-cache-diff-threshold)
(beginning-of-defun)
(goto-char (point-min)))
-;;; (cond ((and diff (< diff 0)) (cl-incf antlr-statistics-full-neg))
-;;; ((and diff (>= diff 3000)) (cl-incf antlr-statistics-full-diff))
-;;; (t (cl-incf antlr-statistics-full-other)))
+ ;; (cond ((and diff (< diff 0)) (cl-incf antlr-statistics-full-neg))
+ ;; ((and diff (>= diff 3000)) (cl-incf antlr-statistics-full-diff))
+ ;; (t (cl-incf antlr-statistics-full-other)))
(setq state (parse-partial-sexp (point) orig)))
(goto-char orig)
(if antlr-slow-context-cache
@@ -1108,52 +953,52 @@ WARNING: this may alter `match-data'."
((nth 4 state) 'comment) ; block-comment? -- we don't care
(t (car state)))))
-;;; (cl-incf (aref antlr-statistics 2))
-;;; (unless (and (eq (current-buffer)
-;;; (caar antlr-slow-context-cache))
-;;; (eq (buffer-modified-tick)
-;;; (cdar antlr-slow-context-cache)))
-;;; (cl-incf (aref antlr-statistics 1))
-;;; (setq antlr-slow-context-cache nil))
-;;; (let* ((orig (point))
-;;; (base (cadr antlr-slow-context-cache))
-;;; (curr (cddr antlr-slow-context-cache))
-;;; (state (cond ((eq orig (car curr)) (cdr curr))
-;;; ((eq orig (car base)) (cdr base))))
-;;; diff diff2)
-;;; (unless state
-;;; (cl-incf (aref antlr-statistics 3))
-;;; (when curr
-;;; (if (< (setq diff (abs (- orig (car curr))))
-;;; (setq diff2 (abs (- orig (car base)))))
-;;; (setq state curr)
-;;; (setq state base
-;;; diff diff2))
-;;; (if (or (>= (1+ diff) (point)) (>= diff 3000))
-;;; (setq state nil))) ; start from bod/bob
-;;; (if state
-;;; (setq state
-;;; (parse-partial-sexp (car state) orig nil nil (cdr state)))
-;;; (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min)))
-;;; (cl-incf (aref antlr-statistics 4))
-;;; (setq cw (list orig (point) base curr))
-;;; (setq state (parse-partial-sexp (point) orig)))
-;;; (goto-char orig)
-;;; (if antlr-slow-context-cache
-;;; (setcdr (cdr antlr-slow-context-cache) (cons orig state))
-;;; (setq antlr-slow-context-cache
-;;; (cons (cons (current-buffer) (buffer-modified-tick))
-;;; (cons (cons orig state) (cons orig state))))))
-;;; (cond ((nth 3 state) 'string)
-;;; ((nth 4 state) 'comment) ; block-comment? -- we don't care
-;;; (t (car state)))))
-
-;;; (beginning-of-defun)
-;;; (let ((state (parse-partial-sexp (point) orig)))
-;;; (goto-char orig)
-;;; (cond ((nth 3 state) 'string)
-;;; ((nth 4 state) 'comment) ; block-comment? -- we don't care
-;;; (t (car state))))))
+;; (cl-incf (aref antlr-statistics 2))
+;; (unless (and (eq (current-buffer)
+;; (caar antlr-slow-context-cache))
+;; (eq (buffer-modified-tick)
+;; (cdar antlr-slow-context-cache)))
+;; (cl-incf (aref antlr-statistics 1))
+;; (setq antlr-slow-context-cache nil))
+;; (let* ((orig (point))
+;; (base (cadr antlr-slow-context-cache))
+;; (curr (cddr antlr-slow-context-cache))
+;; (state (cond ((eq orig (car curr)) (cdr curr))
+;; ((eq orig (car base)) (cdr base))))
+;; diff diff2)
+;; (unless state
+;; (cl-incf (aref antlr-statistics 3))
+;; (when curr
+;; (if (< (setq diff (abs (- orig (car curr))))
+;; (setq diff2 (abs (- orig (car base)))))
+;; (setq state curr)
+;; (setq state base
+;; diff diff2))
+;; (if (or (>= (1+ diff) (point)) (>= diff 3000))
+;; (setq state nil))) ; start from bod/bob
+;; (if state
+;; (setq state
+;; (parse-partial-sexp (car state) orig nil nil (cdr state)))
+;; (if (>= orig 3000) (beginning-of-defun) (goto-char (point-min)))
+;; (cl-incf (aref antlr-statistics 4))
+;; (setq cw (list orig (point) base curr))
+;; (setq state (parse-partial-sexp (point) orig)))
+;; (goto-char orig)
+;; (if antlr-slow-context-cache
+;; (setcdr (cdr antlr-slow-context-cache) (cons orig state))
+;; (setq antlr-slow-context-cache
+;; (cons (cons (current-buffer) (buffer-modified-tick))
+;; (cons (cons orig state) (cons orig state))))))
+;; (cond ((nth 3 state) 'string)
+;; ((nth 4 state) 'comment) ; block-comment? -- we don't care
+;; (t (car state)))))
+
+;; (beginning-of-defun)
+;; (let ((state (parse-partial-sexp (point) orig)))
+;; (goto-char orig)
+;; (cond ((nth 3 state) 'string)
+;; ((nth 4 state) 'comment) ; block-comment? -- we don't care
+;; (t (car state))))))
;;;===========================================================================
@@ -1207,7 +1052,7 @@ strings and actions/semantic predicates."
(defsubst antlr-skip-sexps (count)
"Skip the next COUNT balanced expressions and the comments after it.
Return position before the comments after the last expression."
- (goto-char (or (ignore-errors-x (scan-sexps (point) count)) (point-max)))
+ (goto-char (or (ignore-errors (scan-sexps (point) count)) (point-max)))
(prog1 (point)
(antlr-c-forward-sws)))
@@ -1229,7 +1074,8 @@ See `antlr-font-lock-additional-keywords', `antlr-language' and
antlr-font-lock-keywords-alist))
(if (eq antlr-font-lock-maximum-decoration 'inherit)
font-lock-maximum-decoration
- antlr-font-lock-maximum-decoration)))))))
+ antlr-font-lock-maximum-decoration)))
+ t))))
;;;===========================================================================
@@ -1246,10 +1092,9 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names."
(let ((items nil)
(classes nil)
(continue t))
- ;; Using `imenu-progress-message' would require imenu for compilation, but
- ;; nobody is missing these messages. The generic imenu function searches
- ;; backward, which is slower and more likely not to work during editing.
- (antlr-with-syntax-table antlr-action-syntax-table
+ ;; The generic imenu function searches backward, which is slower
+ ;; and more likely not to work during editing.
+ (with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(goto-char (point-min))
(antlr-skip-file-prelude t)
@@ -1393,37 +1238,37 @@ Move to the beginning of the current rule if point is inside a rule."
A grammar class header and the file prelude are also considered as a
rule."
(save-excursion
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(not (antlr-outside-rule-p)))))
-(defunx antlr-end-of-rule (&optional arg)
+(defun antlr-end-of-rule (&optional arg)
"Move forward to next end of rule. Do it ARG [default: 1] many times.
A grammar class header and the file prelude are also considered as a
rule. Negative argument ARG means move back to ARGth preceding end of
rule. If ARG is zero, run `antlr-end-of-body'."
- (interactive "_p")
+ (interactive "^p")
(if (zerop arg)
(antlr-end-of-body)
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-next-rule arg nil))))
-(defunx antlr-beginning-of-rule (&optional arg)
+(defun antlr-beginning-of-rule (&optional arg)
"Move backward to preceding beginning of rule. Do it ARG many times.
A grammar class header and the file prelude are also considered as a
rule. Negative argument ARG means move forward to ARGth next beginning
of rule. If ARG is zero, run `antlr-beginning-of-body'."
- (interactive "_p")
+ (interactive "^p")
(if (zerop arg)
(antlr-beginning-of-body)
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-next-rule (- arg) t))))
-(defunx antlr-end-of-body (&optional msg)
+(defun antlr-end-of-body (&optional msg)
"Move to position after the `;' of the current rule.
A grammar class header is also considered as a rule. With optional
prefix arg MSG, move to `:'."
- (interactive "_")
- (antlr-with-syntax-table antlr-action-syntax-table
+ (interactive "^")
+ (with-syntax-table antlr-action-syntax-table
(let ((orig (point)))
(if (antlr-outside-rule-p)
(error "Outside an ANTLR rule"))
@@ -1441,9 +1286,9 @@ prefix arg MSG, move to `:'."
(error msg))
(antlr-c-forward-sws))))))
-(defunx antlr-beginning-of-body ()
+(defun antlr-beginning-of-body ()
"Move to the first element after the `:' of the current rule."
- (interactive "_")
+ (interactive "^")
(antlr-end-of-body "Class headers and the file prelude are without `:'"))
@@ -1459,7 +1304,7 @@ If non-nil, TRANSFORM is used on literals instead of `downcase-region'."
(let ((literals 0))
(save-excursion
(goto-char (point-min))
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(while (antlr-re-search-forward "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" nil)
(funcall transform (match-beginning 0) (match-end 0))
@@ -1488,10 +1333,10 @@ Display a message unless optional argument SILENT is non-nil."
(antlr-hide-actions 0 t)
(save-excursion
(goto-char (point-min))
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(while (antlr-re-search-forward regexp nil)
- (let ((beg (ignore-errors-x (scan-sexps (point) -1))))
+ (let ((beg (ignore-errors (scan-sexps (point) -1))))
(when beg
(if diff ; braces are visible
(if (> (point) (+ beg diff))
@@ -1684,7 +1529,7 @@ like \(AREA . PLACE), see `antlr-option-location'."
(cond ((null pos) 'error)
((looking-at "options[ \t\n]*{")
(goto-char (match-end 0))
- (setq pos (ignore-errors-x (scan-lists (point) 1 1)))
+ (setq pos (ignore-errors (scan-lists (point) 1 1)))
(antlr-option-location orig min0 max0
(point)
(if pos (1- pos) (point-max))
@@ -1709,7 +1554,7 @@ is undefined."
(widen)
(if (eq requested 1)
1
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(let* ((orig (point))
(outsidep (antlr-outside-rule-p))
@@ -2087,7 +1932,7 @@ its export vocabulary is used as an import vocabulary."
(unless buffer-file-name
(error "Grammar buffer does not visit a file"))
(let (classes export-vocabs import-vocabs superclasses default-vocab)
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(goto-char (point-min))
(while (antlr-re-search-forward antlr-class-header-regexp nil)
;; parse class definition --------------------------------------------
@@ -2240,9 +2085,9 @@ Use prefix argument ARG to return \(COMMAND FILE SAVED)."
(setq glibs (car (antlr-superclasses-glibs
supers
(car (antlr-directory-dependencies
- (antlr-default-directory)))))))
- (list (antlr-read-shell-command "Run Antlr on current file with: "
- (concat antlr-tool-command glibs " "))
+ default-directory))))))
+ (list (read-shell-command "Run Antlr on current file with: "
+ (concat antlr-tool-command glibs " "))
buffer-file-name
supers)))
@@ -2264,7 +2109,7 @@ Also insert strings PRE and POST before and after the variable."
"Insert Makefile rules in the current buffer at point.
IN-MAKEFILE is non-nil, if the current buffer is the Makefile. See
command `antlr-show-makefile-rules' for detail."
- (let* ((dirname (antlr-default-directory))
+ (let* ((dirname default-directory)
(deps0 (antlr-directory-dependencies dirname))
(classes (car deps0)) ; CLASS -> (FILE . EVOCAB) ...
(deps (cdr deps0)) ; FILE -> (c . s) (ev . iv) . LANGUAGE
@@ -2343,7 +2188,9 @@ commentary with value `antlr-help-unknown-file-text' is added. The
*Help* buffer always starts with the text in `antlr-help-rules-intro'."
(interactive)
(if (null (derived-mode-p 'makefile-mode))
- (antlr-with-displaying-help-buffer 'antlr-insert-makefile-rules)
+ (with-output-to-temp-buffer "*Help*"
+ (save-excursion
+ (antlr-insert-makefile-rules)))
(push-mark)
(antlr-insert-makefile-rules t)))
@@ -2386,7 +2233,7 @@ to a lesser extent, `antlr-tab-offset-alist'."
(skip-chars-forward " \t")
(setq boi (point))
;; check syntax at beginning of indentation ----------------------------
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(setq syntax (antlr-syntactic-context))
(cond ((symbolp syntax)
@@ -2482,7 +2329,7 @@ ANTLR's syntax and influences the auto indentation, see
(interactive "*P")
(if (or arg
(save-excursion (skip-chars-backward " \t") (not (bolp)))
- (antlr-with-syntax-table antlr-action-syntax-table
+ (with-syntax-table antlr-action-syntax-table
(antlr-invalidate-context-cache)
(let ((context (antlr-syntactic-context)))
(not (and (numberp context)
@@ -2525,7 +2372,7 @@ ANTLR's syntax and influences the auto indentation, see
(while settings
(when (boundp (car settings))
(ignore-errors
- (set (car settings) (eval (cadr settings)))))
+ (set (car settings) (eval (cadr settings) t))))
(setq settings (cddr settings)))))
(defun antlr-language-option (search)
@@ -2572,20 +2419,11 @@ the default language."
(cadr (assq antlr-language antlr-language-alist)))))
;; indentation, for the C engine -------------------------------------------
(setq c-buffer-is-cc-mode antlr-language)
- (cond ((fboundp 'c-init-language-vars-for) ; cc-mode 5.30.5+
- (c-init-language-vars-for antlr-language))
- ((fboundp 'c-init-c-language-vars) ; cc-mode 5.30 to 5.30.4
- (c-init-c-language-vars) ; not perfect, but OK
- (setq c-recognize-knr-p nil))
- ((fboundp 'c-init-language-vars) ; cc-mode 5.29
- (let ((init-fn 'c-init-language-vars))
- (funcall init-fn))) ; is a function in v5.29
- (t ; cc-mode upto 5.28
- (antlr-c-init-language-vars))) ; do it myself
+ (c-init-language-vars-for antlr-language)
(c-basic-common-init antlr-language (or antlr-indent-style "gnu"))
(set (make-local-variable 'outline-regexp) "[^#\n\^M]")
- (set (make-local-variable 'outline-level) 'c-outline-level) ;TODO: define own
- (set (make-local-variable 'indent-line-function) 'antlr-indent-line)
+ (set (make-local-variable 'outline-level) #'c-outline-level) ;TODO: define own
+ (set (make-local-variable 'indent-line-function) #'antlr-indent-line)
(set (make-local-variable 'indent-region-function) nil) ; too lazy
(setq comment-start "// "
comment-end ""
@@ -2595,7 +2433,7 @@ the default language."
(when (featurep 'xemacs)
(easy-menu-add antlr-mode-menu))
(set (make-local-variable 'imenu-create-index-function)
- 'antlr-imenu-create-index-function)
+ #'antlr-imenu-create-index-function)
(set (make-local-variable 'imenu-generic-expression) t) ; fool stupid test
(and antlr-imenu-name ; there should be a global variable...
(fboundp 'imenu-add-to-menubar)
@@ -2625,6 +2463,6 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'."
(provide 'antlr-mode)
-;;; Local IspellPersDict: .ispell_antlr
+;; Local IspellPersDict: .ispell_antlr
;;; antlr-mode.el ends here
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 99b2ec6d87e..2f7d7bf7966 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -73,19 +73,19 @@
;; Note that the comment character isn't set up until asm-mode is called.
(define-key map ":" 'asm-colon)
(define-key map "\C-c;" 'comment-region)
- (define-key map [menu-bar asm-mode] (cons "Asm" (make-sparse-keymap)))
- (define-key map [menu-bar asm-mode comment-region]
- '(menu-item "Comment Region" comment-region
- :help "Comment or uncomment each line in the region"))
- (define-key map [menu-bar asm-mode newline-and-indent]
- '(menu-item "Insert Newline and Indent" newline-and-indent
- :help "Insert a newline, then indent according to major mode"))
- (define-key map [menu-bar asm-mode asm-colon]
- '(menu-item "Insert Colon" asm-colon
- :help "Insert a colon; if it follows a label, delete the label's indentation"))
map)
"Keymap for Asm mode.")
+(easy-menu-define asm-mode-menu asm-mode-map
+ "Menu for Asm mode."
+ '("Asm"
+ ["Insert Colon" asm-colon
+ :help "Insert a colon; if it follows a label, delete the label's indentation"]
+ ["Insert Newline and Indent" newline-and-indent
+ :help "Insert a newline, then indent according to major mode"]
+ ["Comment Region" comment-region
+ :help "Comment or uncomment each line in the region"]))
+
(defconst asm-font-lock-keywords
(append
'(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\(\\.\\sw+\\)*\\)?"
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index a759394abeb..9b9c58eb1f2 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -1,4 +1,4 @@
-;; bug-reference.el --- buttonize bug references -*- lexical-binding: t; -*-
+;;; bug-reference.el --- buttonize bug references -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -25,10 +25,13 @@
;; This file provides minor modes for putting clickable overlays on
;; references to bugs. A bug reference is text like "PR foo/29292";
-;; this is mapped to a URL using a user-supplied format.
+;; this is mapped to a URL using a user-supplied format; see
+;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More
+;; extensive documentation is in (info "(emacs) Bug Reference").
;; Two minor modes are provided. One works on any text in the buffer;
-;; the other operates only on comments and strings.
+;; the other operates only on comments and strings. By default, the
+;; URL link is followed by invoking C-c RET or mouse-2.
;;; Code:
@@ -73,8 +76,7 @@ so that it is considered safe, see `enable-local-variables'.")
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
:type 'regexp
- :version "24.3" ; previously defconst
- :group 'bug-reference)
+ :version "24.3") ; previously defconst
;;;###autoload
(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
@@ -127,6 +129,9 @@ The second subexpression should match the bug reference (usually a number)."
"Open URL corresponding to the bug reference at POS."
(interactive
(list (if (integerp last-command-event) (point) last-command-event)))
+ (when (null bug-reference-url-format)
+ (user-error
+ "You must customize some bug-reference variables; see Emacs info node Bug Reference"))
(if (and (not (integerp pos)) (eventp pos))
;; POS is a mouse event; switch to the proper window/buffer
(let ((posn (event-start pos)))
@@ -139,7 +144,7 @@ The second subexpression should match the bug reference (usually a number)."
(when url
(browse-url url))))))
-(defun bug-reference--maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt)
+(defun bug-reference-maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt)
(when (string-match url-rx url)
(setq-local bug-reference-bug-regexp bug-rx)
(setq-local bug-reference-url-format
@@ -179,6 +184,22 @@ The second subexpression should match the bug reference (usually a number)."
"/issues/"
(match-string 2))))))
;;
+ ;; Codeberg projects.
+ ;;
+ ;; The systematics is exactly as for Github projects.
+ ("[/@]codeberg.org[/:]\\([.A-Za-z0-9_/-]+\\)\\.git"
+ "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://codeberg.org/"
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/issues/"
+ (match-string 2))))))
+ ;;
;; GitLab projects.
;;
;; Here #18 is an issue and !17 is a merge request. Explicit
@@ -196,6 +217,30 @@ The second subexpression should match the bug reference (usually a number)."
(if (string= (match-string 3) "#")
"issues/"
"merge_requests/")
+ (match-string 2))))))
+ ;;
+ ;; Sourcehut projects.
+ ;;
+ ;; #19 is an issue. Other project's issues can be referenced as
+ ;; #~user/project#19.
+ ;;
+ ;; Caveat: The code assumes that a project on git.sr.ht or
+ ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. That's
+ ;; a very common setup but all sr.ht services are loosely coupled,
+ ;; so you can have a repo without tracker, or a repo with a
+ ;; tracker using a different name, etc. So we can only try to
+ ;; make a good guess.
+ ("[/@]\\(?:git\\|hg\\).sr.ht[/:]\\(~[.A-Za-z0-9_/-]+\\)"
+ "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>"
+ ,(lambda (groups)
+ (let ((ns-project (nth 1 groups)))
+ (lambda ()
+ (concat "https://todo.sr.ht/"
+ (or
+ ;; Explicit user/proj#18 link.
+ (match-string 1)
+ ns-project)
+ "/"
(match-string 2)))))))
"An alist for setting up `bug-reference-mode' based on VC URL.
@@ -225,7 +270,7 @@ and apply it if applicable."
(when url
(catch 'found
(dolist (config bug-reference-setup-from-vc-alist)
- (when (apply #'bug-reference--maybe-setup-from-vc
+ (when (apply #'bug-reference-maybe-setup-from-vc
url config)
(throw 'found t)))))))))
@@ -239,8 +284,8 @@ and apply it if applicable."
"An alist for setting up `bug-reference-mode' in mail modes.
This takes action if `bug-reference-mode' is enabled in group and
-message buffers of Emacs mail clients. Currently, only Gnus is
-supported.
+message buffers of Emacs mail clients. Currently, Gnus and Rmail
+are supported.
Each element has the form
@@ -259,7 +304,7 @@ same `bug-reference-url-format' and `bug-reference-url-format'.")
(defvar gnus-newsgroup-name)
-(defun bug-reference--maybe-setup-from-mail (group header-values)
+(defun bug-reference-maybe-setup-from-mail (group header-values)
"Set up according to mail GROUP or HEADER-VALUES.
Group is a mail group/folder name and HEADER-VALUES is a list of
mail header values, e.g., the values of From, To, Cc, List-ID,
@@ -295,65 +340,83 @@ and set it if applicable."
;; article changes.
(add-hook 'gnus-article-prepare-hook
#'bug-reference--try-setup-gnus-article)
- (bug-reference--maybe-setup-from-mail gnus-newsgroup-name nil)))
+ (bug-reference-maybe-setup-from-mail gnus-newsgroup-name nil)))
(defvar gnus-article-buffer)
(defvar gnus-original-article-buffer)
(defvar gnus-summary-buffer)
+(defvar bug-reference-mode)
(defun bug-reference--try-setup-gnus-article ()
- (with-demoted-errors
- "Error in bug-reference--try-setup-gnus-article: %S"
- (when (and bug-reference-mode ;; Only if enabled in article buffers.
- (derived-mode-p
- 'gnus-article-mode
- ;; Apparently, gnus-article-prepare-hook is run in the
- ;; summary buffer...
- 'gnus-summary-mode)
- gnus-article-buffer
- gnus-original-article-buffer
- (buffer-live-p (get-buffer gnus-article-buffer))
- (buffer-live-p (get-buffer gnus-original-article-buffer)))
- (with-current-buffer gnus-article-buffer
- (catch 'setup-done
- ;; Copy over the values from the summary buffer.
- (when (and gnus-summary-buffer
- (buffer-live-p gnus-summary-buffer))
- (setq-local bug-reference-bug-regexp
- (with-current-buffer gnus-summary-buffer
- bug-reference-bug-regexp))
- (setq-local bug-reference-url-format
- (with-current-buffer gnus-summary-buffer
- bug-reference-url-format))
- (when (and bug-reference-bug-regexp
- bug-reference-url-format)
- (throw 'setup-done t)))
- ;; If the summary had no values, try setting according to
- ;; the values of the From, To, and Cc headers.
- (let (header-values)
- (with-current-buffer
- (get-buffer gnus-original-article-buffer)
- (save-excursion
- (goto-char (point-min))
- ;; The Newsgroup is omitted because we already matched
- ;; based on group name in the summary buffer.
- (dolist (field '("list-id" "to" "from" "cc"))
- (let ((val (mail-fetch-field field)))
- (when val
- (push val header-values))))))
- (bug-reference--maybe-setup-from-mail nil header-values)))))))
+ (when (and bug-reference-mode ;; Only if enabled in article buffers.
+ (derived-mode-p
+ 'gnus-article-mode
+ ;; Apparently, gnus-article-prepare-hook is run in the
+ ;; summary buffer...
+ 'gnus-summary-mode)
+ gnus-article-buffer
+ gnus-original-article-buffer
+ (buffer-live-p (get-buffer gnus-article-buffer))
+ (buffer-live-p (get-buffer gnus-original-article-buffer)))
+ (with-current-buffer gnus-article-buffer
+ (catch 'setup-done
+ ;; Copy over the values from the summary buffer.
+ (when (and gnus-summary-buffer
+ (buffer-live-p gnus-summary-buffer))
+ (setq-local bug-reference-bug-regexp
+ (with-current-buffer gnus-summary-buffer
+ bug-reference-bug-regexp))
+ (setq-local bug-reference-url-format
+ (with-current-buffer gnus-summary-buffer
+ bug-reference-url-format))
+ (when (and bug-reference-bug-regexp
+ bug-reference-url-format)
+ (throw 'setup-done t)))
+ ;; If the summary had no values, try setting according to
+ ;; the values of the From, To, and Cc headers.
+ (let (header-values)
+ (with-current-buffer
+ (get-buffer gnus-original-article-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ ;; The Newsgroup is omitted because we already matched
+ ;; based on group name in the summary buffer.
+ (dolist (field '("list-id" "to" "from" "cc"))
+ (let ((val (mail-fetch-field field)))
+ (when val
+ (push val header-values))))))
+ (bug-reference-maybe-setup-from-mail nil header-values))))))
+
+(defun bug-reference-try-setup-from-rmail ()
+ "Try setting up `bug-reference-mode' from the current rmail mail.
+Guesses suitable `bug-reference-bug-regexp' and
+`bug-reference-url-format' values by matching the current Rmail
+file's name against GROUP-REGEXP and the values of List-Id, To,
+From, and Cc against HEADER-REGEXP in
+`bug-reference-setup-from-mail-alist'."
+ (when (and bug-reference-mode
+ (derived-mode-p 'rmail-mode))
+ (let (header-values)
+ (save-excursion
+ (goto-char (point-min))
+ (dolist (field '("list-id" "to" "from" "cc"))
+ (let ((val (mail-fetch-field field)))
+ (when val
+ (push val header-values)))))
+ (bug-reference-maybe-setup-from-mail
+ (buffer-file-name) header-values))))
(defvar bug-reference-setup-from-irc-alist
`((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc"
"erc") 'words))
- "freenode"
+ "Libera.Chat"
"\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
"https://debbugs.gnu.org/%s"))
"An alist for setting up `bug-reference-mode' in IRC modes.
This takes action if `bug-reference-mode' is enabled in IRC
-channels using one of Emacs' IRC clients (rcirc and ERC).
-Currently, rcirc and ERC are supported.
+channels using one of Emacs' IRC clients. Currently, rcirc and
+ERC are supported.
Each element has the form
@@ -361,12 +424,12 @@ Each element has the form
CHANNEL-REGEXP is a regexp matched against the current IRC
channel name (e.g. #emacs). NETWORK-REGEXP is matched against
-the IRC network name (e.g. freenode). Both entries are optional.
-If all given entries match, BUG-REGEXP is set as
+the IRC network name (e.g. Libera.Chat). Both entries are
+optional. If all given entries match, BUG-REGEXP is set as
`bug-reference-bug-regexp' and URL-FORMAT is set as
`bug-reference-url-format'.")
-(defun bug-reference--maybe-setup-from-irc (channel network)
+(defun bug-reference-maybe-setup-from-irc (channel network)
"Set up according to IRC CHANNEL or NETWORK.
CHANNEL is an IRC channel name (or generally a target, i.e., it
could also be a user name) and NETWORK is that channel's network
@@ -402,7 +465,7 @@ corresponding BUG-REGEXP and URL-FORMAT are set."
Test each configuration in `bug-reference-setup-from-irc-alist'
and set it if applicable."
(when (derived-mode-p 'rcirc-mode)
- (bug-reference--maybe-setup-from-irc
+ (bug-reference-maybe-setup-from-irc
rcirc-target
(and rcirc-server-buffer
(buffer-live-p rcirc-server-buffer)
@@ -417,10 +480,29 @@ and set it if applicable."
Test each configuration in `bug-reference-setup-from-irc-alist'
and set it if applicable."
(when (derived-mode-p 'erc-mode)
- (bug-reference--maybe-setup-from-irc
+ (bug-reference-maybe-setup-from-irc
(erc-format-target)
(erc-network-name))))
+(defvar bug-reference-auto-setup-functions
+ (list #'bug-reference-try-setup-from-vc
+ #'bug-reference-try-setup-from-gnus
+ #'bug-reference-try-setup-from-rmail
+ #'bug-reference-try-setup-from-rcirc
+ #'bug-reference-try-setup-from-erc)
+ "Functions trying to auto-setup `bug-reference-mode'.
+These functions are run after `bug-reference-mode' has been
+activated in a buffer and try to guess suitable values for
+`bug-reference-bug-regexp' and `bug-reference-url-format'. Their
+guesswork is based on these variables:
+
+- `bug-reference-setup-from-vc-alist' for guessing based on
+ version control, e.g., URL of repository.
+- `bug-reference-setup-from-mail-alist' for guessing based on
+ mail group names or mail header values.
+- `bug-reference-setup-from-irc-alist' for guessing based on IRC
+ channel or network names.")
+
(defun bug-reference--run-auto-setup ()
(when (or bug-reference-mode
bug-reference-prog-mode)
@@ -431,19 +513,13 @@ and set it if applicable."
(with-demoted-errors
"Error during bug-reference auto-setup: %S"
(catch 'setup
- (dolist (f (list #'bug-reference-try-setup-from-vc
- #'bug-reference-try-setup-from-gnus
- #'bug-reference-try-setup-from-rcirc
- #'bug-reference-try-setup-from-erc))
+ (dolist (f bug-reference-auto-setup-functions)
(when (funcall f)
(throw 'setup t))))))))
;;;###autoload
(define-minor-mode bug-reference-mode
"Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
- nil
- ""
- nil
:after-hook (bug-reference--run-auto-setup)
(if bug-reference-mode
(jit-lock-register #'bug-reference-fontify)
@@ -452,12 +528,21 @@ and set it if applicable."
(widen)
(bug-reference-unfontify (point-min) (point-max)))))
+(defun bug-reference-mode-force-auto-setup ()
+ "Enable `bug-reference-mode' and force auto-setup.
+Enabling `bug-reference-mode' runs its auto-setup only if
+`bug-reference-bug-regexp' and `bug-reference-url-format' are not
+set already. This function sets the latter to `nil'
+buffer-locally, so that the auto-setup will always run.
+
+This is mostly intended for MUA modes like `rmail-mode' where the
+same buffer is re-used for different contexts."
+ (setq-local bug-reference-url-format nil)
+ (bug-reference-mode))
+
;;;###autoload
(define-minor-mode bug-reference-prog-mode
"Like `bug-reference-mode', but only buttonize in comments and strings."
- nil
- ""
- nil
:after-hook (bug-reference--run-auto-setup)
(if bug-reference-prog-mode
(jit-lock-register #'bug-reference-fontify)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index d14ef1744af..9234d0b19b9 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1,4 +1,4 @@
-;;; cc-align.el --- custom indentation functions for CC Mode
+;;; cc-align.el --- custom indentation functions for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -44,6 +44,9 @@
(cc-require 'cc-vars)
(cc-require 'cc-engine)
+(defvar c-syntactic-context)
+(defvar c-syntactic-element)
+
;; Standard line-up functions
;;
@@ -274,8 +277,10 @@ statement-block-intro, statement-case-intro, arglist-intro."
(save-excursion
(beginning-of-line)
(backward-up-list 1)
+ (forward-char)
(skip-chars-forward " \t" (c-point 'eol))
- (vector (1+ (current-column)))))
+ (if (eolp) (skip-chars-backward " \t"))
+ (vector (current-column))))
(defun c-lineup-arglist-close-under-paren (langelem)
"Line up a line under the enclosing open paren.
@@ -1145,7 +1150,8 @@ Works with brace-list-intro."
; the line.
(save-excursion ; "{" earlier on the line
(goto-char (c-langelem-pos
- (assq 'brace-list-intro c-syntactic-context)))
+ (assq 'brace-list-entry
+ c-syntactic-context)))
(and
(eq (c-backward-token-2
1 nil
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 32289443725..334e82114fc 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1,4 +1,4 @@
-;;; cc-awk.el --- AWK specific code within cc-mode.
+;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*-
;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation,
;; Inc.
@@ -1227,4 +1227,4 @@ comment at the start of cc-engine.el for more info."
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-;;; awk-mode.el ends here
+;;; cc-awk.el ends here
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 3f7caf3c2e9..edbac64eadb 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -1,4 +1,4 @@
-;;; cc-bytecomp.el --- compile time setup for proper compilation
+;;; cc-bytecomp.el --- compile time setup for proper compilation -*- lexical-binding: t -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -85,8 +85,8 @@
(defvar cc-bytecomp-environment-set nil)
-(defmacro cc-bytecomp-debug-msg (&rest args)
- (ignore args)
+(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed.
+ ;; (declare (debug t))
;;`(message ,@args)
)
@@ -97,6 +97,8 @@
;; compilation can trigger loading (various `require' type forms)
;; and loading can trigger compilation (the package manager does
;; this). We walk the lisp stack if necessary.
+ ;; Never native compile to allow cc-defs.el:2345 hack.
+ (declare (speed -1))
(cond
((and load-in-progress
(boundp 'byte-compile-dest-file)
@@ -108,14 +110,15 @@
(memq (cadr elt)
'(load require
byte-compile-file byte-recompile-directory
- batch-byte-compile)))))
+ batch-byte-compile batch-native-compile)))))
(setq n (1+ n)))
(cond
((memq (cadr elt) '(load require))
'loading)
((memq (cadr elt) '(byte-compile-file
byte-recompile-directory
- batch-byte-compile))
+ batch-byte-compile
+ batch-native-compile))
'compiling)
(t ; Can't happen.
(message "cc-bytecomp-compiling-or-loading: System flags spuriously set")
@@ -284,7 +287,9 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere"))
(cons cc-file cc-bytecomp-loaded-files))
(cc-bytecomp-debug-msg
"cc-bytecomp-load: Loading %S" cc-file)
- (load cc-file nil t t)
+ ;; native-comp may async compile also intalled el.gz
+ ;; files therefore we may have to load here other el.gz.
+ (load cc-part nil t)
(cc-bytecomp-debug-msg
"cc-bytecomp-load: Loaded %S" cc-file)))
(cc-bytecomp-setup-environment)
@@ -297,6 +302,7 @@ during compilation, but compile in a `require'. Don't use within
Having cyclic cc-require's will result in infinite recursion. That's
somewhat intentional."
+ (declare (debug t))
`(progn
(eval-when-compile
(cc-bytecomp-load (symbol-name ,cc-part)))
@@ -309,6 +315,7 @@ time, (ii) generate code to load the file at load time.
CC-PART will normally be a quoted name such as \\='cc-fix.
CONDITION should not be quoted."
+ (declare (debug t))
(if (eval condition)
(progn
(cc-bytecomp-load (symbol-name (eval cc-part)))
@@ -323,6 +330,7 @@ after the loading of FILE.
CC-PART will normally be a quoted name such as \\='cc-fix. FILE
should be a string. CONDITION should not be quoted."
+ (declare (debug t))
(if (eval condition)
(progn
(cc-bytecomp-load (symbol-name (eval cc-part)))
@@ -333,6 +341,7 @@ should be a string. CONDITION should not be quoted."
(defmacro cc-provide (feature)
"A replacement for the `provide' form that restores the environment
after the compilation. Don't use within `eval-when-compile'."
+ (declare (debug t))
`(progn
(eval-when-compile (cc-bytecomp-restore-environment))
(provide ,feature)))
@@ -344,6 +353,7 @@ during compilation. Don't use outside `eval-when-compile' or
Having cyclic cc-load's will result in infinite recursion. That's
somewhat intentional."
+ (declare (debug t))
`(or (and (featurep 'cc-bytecomp)
(cc-bytecomp-load ,cc-part))
(load ,cc-part nil t nil)))
@@ -352,6 +362,7 @@ somewhat intentional."
"Force loading of the corresponding .el file in the current directory
during compilation, but do a compile time `require' otherwise. Don't
use within `eval-when-compile'."
+ (declare (debug t))
`(eval-when-compile
(if (and (fboundp 'cc-bytecomp-is-compiling)
(cc-bytecomp-is-compiling))
@@ -363,6 +374,7 @@ use within `eval-when-compile'."
"Do a `require' of an external package.
This restores and sets up the compilation environment before and
afterwards. Don't use within `eval-when-compile'."
+ (declare (debug t))
`(progn
(eval-when-compile (cc-bytecomp-restore-environment))
(require ,feature)
@@ -371,6 +383,7 @@ afterwards. Don't use within `eval-when-compile'."
(defmacro cc-bytecomp-defvar (var)
"Binds the symbol as a variable during compilation of the file,
to silence the byte compiler. Don't use within `eval-when-compile'."
+ (declare (debug nil))
`(eval-when-compile
(if (boundp ',var)
(cc-bytecomp-debug-msg
@@ -398,6 +411,7 @@ definition. That means that this macro will not shut up warnings
about incorrect number of arguments. It's dangerous to try to replace
existing functions since the byte compiler might need the definition
at compile time, e.g. for macros and inline functions."
+ (declare (debug nil))
`(eval-when-compile
(if (fboundp ',fun)
(cc-bytecomp-debug-msg
@@ -419,6 +433,7 @@ at compile time, e.g. for macros and inline functions."
(defmacro cc-bytecomp-put (symbol propname value)
"Set a property on a symbol during compilation (and evaluation) of
the file. Don't use outside `eval-when-compile'."
+ (declare (debug t))
`(eval-when-compile
(if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties))
(progn
@@ -439,6 +454,7 @@ the file. Don't use outside `eval-when-compile'."
the compilation. This is the same as using `boundp' but additionally
exclude any variables that have been bound during compilation with
`cc-bytecomp-defvar'."
+ (declare (debug t))
(if (and (cc-bytecomp-is-compiling)
(memq (car (cdr symbol)) cc-bytecomp-unbound-variables))
nil
@@ -449,6 +465,7 @@ exclude any variables that have been bound during compilation with
the compilation. This is the same as using `fboundp' but additionally
exclude any functions that have been bound during compilation with
`cc-bytecomp-defun'."
+ (declare (debug t))
(let (fun-elem)
(if (and (cc-bytecomp-is-compiling)
(setq fun-elem (assq (car (cdr symbol))
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 33a03602070..bdfdf178d43 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1,4 +1,4 @@
-;;; cc-cmds.el --- user level commands for CC Mode
+;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -49,12 +49,11 @@
; which looks at this.
(cc-bytecomp-defun electric-pair-post-self-insert-function)
(cc-bytecomp-defvar c-indent-to-body-directives)
+(defvar c-syntactic-context)
;; 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
@@ -1220,9 +1219,9 @@ numeric argument is supplied, or the point is inside a literal."
(self-insert-command (prefix-numeric-value arg)))
(setq final-pos (point))
-;;;; 2010-01-31: There used to be code here to put a syntax-table text
-;;;; property on the new < or > and its mate (if any) when they are template
-;;;; parens. This is now done in an after-change function.
+;;;; 2010-01-31: There used to be code here to put a syntax-table text
+;;;; property on the new < or > and its mate (if any) when they are template
+;;;; parens. This is now done in an after-change function.
(when (and (not arg) (not literal))
;; Have we got a delimiter on a #include directive?
@@ -1639,8 +1638,8 @@ No indentation or other \"electric\" behavior is performed."
;;
;; This function might do hidden buffer changes.
(save-excursion
- (let* (kluge-start
- decl-result brace-decl-p
+ (let* (knr-start knr-res
+ decl-result
(start (point))
(paren-state (c-parse-state))
(least-enclosing (c-least-enclosing-brace paren-state)))
@@ -1670,63 +1669,54 @@ No indentation or other \"electric\" behavior is performed."
(not (looking-at c-defun-type-name-decl-key))))))
'at-function-end)
(t
- ;; Find the start of the current declaration. NOTE: If we're in the
- ;; variables after a "struct/eval" type block, we don't get to the
- ;; real declaration here - we detect and correct for this later.
-
- ;;If we're in the parameters' parens, move back out of them.
- (if least-enclosing (goto-char least-enclosing))
;; Kluge so that c-beginning-of-decl-1 won't go back if we're already
;; at a declaration.
(if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>"
- (not (looking-at
-"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)")))
+ (not (c-looking-at-non-alphnumspace)))
(forward-char))
- (setq kluge-start (point))
- ;; First approximation as to whether the current "header" we're in is
- ;; one followed by braces.
- (setq brace-decl-p
- (save-excursion
- (and (c-syntactic-re-search-forward "[;{]" nil t t)
- (or (eq (char-before) ?\{)
- (and c-recognize-knr-p
- ;; Might have stopped on the
- ;; ';' in a K&R argdecl. In
- ;; that case the declaration
- ;; should contain a block.
- (c-in-knr-argdecl))))))
- (setq decl-result
- (car (c-beginning-of-decl-1
- ;; NOTE: If we're in a K&R region, this might be the start
- ;; of a parameter declaration, not the actual function.
- ;; It might also leave us at a label or "label" like
- ;; "private:".
- (and least-enclosing ; LIMIT for c-b-of-decl-1
- (c-safe-position least-enclosing paren-state)))))
-
- ;; Has the declaration we've gone back to got braces?
- (if (or (eq decl-result 'label)
- (looking-at c-protection-key))
- (setq brace-decl-p nil))
- (cond
- ((or (eq decl-result 'label) ; e.g. "private:" or invalid syntax.
- (= (point) kluge-start)) ; might be BOB or unbalanced parens.
- 'outwith-function)
- ((eq decl-result 'same)
- (if brace-decl-p
- (if (eq (point) start)
- 'at-header
+ (if (and least-enclosing
+ (eq (char-after least-enclosing) ?\())
+ (c-go-list-forward least-enclosing))
+ (c-forward-syntactic-ws)
+ (setq knr-start (point))
+ (if (and (c-syntactic-re-search-forward "[;{]" nil t t)
+ (eq (char-before) ?\{))
+ (progn
+ (backward-char)
+ (cond
+ ((or (progn
+ (c-backward-syntactic-ws)
+ (<= (point) start))
+ (and c-recognize-knr-p
+ (and (setq knr-res (c-in-knr-argdecl))
+ (<= knr-res knr-start))))
'in-header)
- 'outwith-function))
- ((eq decl-result 'previous)
- (if (and (not brace-decl-p)
- (c-in-function-trailer-p))
- 'at-function-end
- 'outwith-function))
- (t (error
- "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s"
- decl-result))))))))
+ ((and knr-res
+ (goto-char knr-res)
+ (c-backward-syntactic-ws))) ; Always returns nil.
+ (t
+ (when (eq (char-before) ?\))
+ ;; The `c-go-list-backward' is a precaution against
+ ;; `c-beginning-of-decl-1' spuriously finding a C++ lambda
+ ;; function inside the parentheses.
+ (c-go-list-backward))
+ (setq decl-result
+ (car (c-beginning-of-decl-1
+ (and least-enclosing
+ (c-safe-position
+ least-enclosing paren-state)))))
+ (cond
+ ((> (point) start)
+ 'outwith-function)
+ ((eq decl-result 'same)
+ (if (eq (point) start)
+ 'at-header
+ 'in-header))
+ (t (error
+ "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s"
+ decl-result))))))
+ 'outwith-function))))))
(defun c-backward-to-nth-BOF-{ (n where)
;; Skip to the opening brace of the Nth function before point. If
@@ -1749,9 +1739,11 @@ No indentation or other \"electric\" behavior is performed."
(goto-char (c-least-enclosing-brace (c-parse-state)))
(setq n (1- n)))
((eq where 'in-header)
- (c-syntactic-re-search-forward "{")
- (backward-char)
- (setq n (1- n)))
+ (let ((encl-paren (c-least-enclosing-brace (c-parse-state))))
+ (if encl-paren (goto-char encl-paren))
+ (c-syntactic-re-search-forward "{" nil t t)
+ (backward-char)
+ (setq n (1- n))))
((memq where '(at-header outwith-function at-function-end in-trailer))
(c-syntactic-skip-backward "^}")
(when (eq (char-before) ?\})
@@ -1832,15 +1824,18 @@ No indentation or other \"electric\" behavior is performed."
nil)))
(eval-and-compile
- (defmacro c-while-widening-to-decl-block (condition)
+ (defmacro c-while-widening-to-decl-block (condition &optional no-where)
;; Repeatedly evaluate CONDITION until it returns nil. After each
;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards
;; of the next enclosing declaration block (e.g. namespace, class), or the
;; buffer's original restriction.
;;
+ ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'.
+ ;;
;; This is a very special purpose macro, which assumes the existence of
;; several variables. It is for use only in c-beginning-of-defun and
;; c-end-of-defun.
+ (declare (debug t))
`(while
(and ,condition
(eq c-defun-tactic 'go-outward)
@@ -1848,7 +1843,8 @@ No indentation or other \"electric\" behavior is performed."
(setq paren-state (c-whack-state-after lim paren-state))
(setq lim (c-widen-to-enclosing-decl-scope
paren-state orig-point-min orig-point-max))
- (setq where 'in-block))))
+ ,@(if (not no-where)
+ `((setq where 'in-block))))))
(def-edebug-spec c-while-widening-to-decl-block t)
@@ -1965,21 +1961,24 @@ defun."
;; The actual movement is done below.
(setq n (1- n)))
((memq where '(at-function-end outwith-function at-header in-header))
- (when (c-syntactic-re-search-forward "{" nil 'eob)
+ (if (eq where 'in-header)
+ (let ((pos (c-least-enclosing-brace (c-parse-state))))
+ (if pos (c-go-list-forward pos))))
+ (when (c-syntactic-re-search-forward "{" nil 'eob t)
(backward-char)
(forward-sexp)
(setq n (1- n))))
(t (error "c-forward-to-nth-EOF-\\;-or-}: `where' is %s" where)))
- (when (c-in-function-trailer-p)
- (c-syntactic-re-search-forward ";" nil 'eob t))
-
;; Each time round the loop, go forward to a "}" at the outermost level.
(while (and (> n 0) (not (eobp)))
(when (c-syntactic-re-search-forward "{" nil 'eob)
(backward-char)
(forward-sexp)
(setq n (1- n))))
+
+ (when (c-in-function-trailer-p)
+ (c-syntactic-re-search-forward ";" nil 'eob t))
n)
(defun c-end-of-defun (&optional arg)
@@ -2326,11 +2325,11 @@ with a brace block, at the outermost level of nesting."
(c-save-buffer-state ((paren-state (c-parse-state))
(orig-point-min (point-min))
(orig-point-max (point-max))
- lim name limits where)
+ lim name limits)
(setq lim (c-widen-to-enclosing-decl-scope
paren-state orig-point-min orig-point-max))
(and lim (setq lim (1- lim)))
- (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))))
+ (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t)
(when name
(setq limits (c-declaration-limits-1 near))
(cons name limits)))
@@ -2946,10 +2945,13 @@ function does not require the declaration to contain a brace block."
(c-looking-at-special-brace-list)))
(or allow-early-stop (/= here last))
(save-excursion ; Is this a check that we're NOT at top level?
-;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii) The next enclosing
-;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense.
-;;;; 2003/8/8 This might have something to do with the GCC extension "Statement Expressions", e.g.
-;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement Expressions.
+;;;; NO! This seems to check that (i) EITHER we're at the top level;
+;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM.
+;;;; Doesn't seem to make sense.
+;;;; 2003/8/8 This might have something to do with the GCC extension
+;;;; "Statement Expressions", e.g.
+;;;; while ({stmt1 ; stmt2 ; exp ;}).
+;;;; This form excludes such Statement Expressions.
(or (not (c-safe (up-list -1) t))
(= (char-after) ?{))))
(goto-char last)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 38fe23b0eaf..01bd64cb5c3 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1,4 +1,4 @@
-;;; cc-defs.el --- compile time definitions for CC Mode
+;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -125,7 +125,7 @@ The result of the body appears to the compiler as a quoted constant.
This variant works around bugs in `eval-when-compile' in various
\(X)Emacs versions. See cc-defs.el for details."
-
+ (declare (indent 0) (debug t))
(if c-inside-eval-when-compile
;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it
;; evaluates its body at macro expansion time if it's nested
@@ -170,17 +170,20 @@ This variant works around bugs in `eval-when-compile' in various
;; constant that we eval. That otoh introduce a problem in
;; that a returned lambda expression doesn't get byte
;; compiled (even if `function' is used).
- (eval '(let ((c-inside-eval-when-compile t)) ,@body)))))
-
- (put 'cc-eval-when-compile 'lisp-indent-hook 0))
+ (eval '(let ((c-inside-eval-when-compile t)) ,@body))))))
;;; Macros.
+(or (fboundp 'cadar) (defsubst cadar (elt) (car (cdar elt))))
+(or (fboundp 'caddr) (defsubst caddr (elt) (car (cddr elt))))
+(or (fboundp 'cdddr) (defsubst cdddr (elt) (cdr (cddr elt))))
+
(defmacro c--mapcan (fun liszt)
;; CC Mode equivalent of `mapcan' which bridges the difference
;; between the host [X]Emacsen."
;; The motivation for this macro is to avoid the irritating message
;; "function `mapcan' from cl package called at runtime" produced by Emacs.
+ (declare (debug t))
(cond
((and (fboundp 'mapcan)
(subrp (symbol-function 'mapcan)))
@@ -196,18 +199,21 @@ 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.
+ (declare (debug (form form &rest [symbolp form])))
(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.
+ (declare (debug (form form &rest [symbolp form])))
(if (eq c--cl-library 'cl-lib)
`(cl-intersection ,liszt1 ,liszt2 ,@other-args)
`(intersection ,liszt1 ,liszt2 ,@other-args)))
(eval-and-compile
(defmacro c--macroexpand-all (form &optional environment)
+ (declare (debug t))
;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3.
(if (fboundp 'macroexpand-all)
`(macroexpand-all ,form ,environment)
@@ -215,6 +221,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.
+ (declare (debug (form &rest [symbolp form])))
(if (eq c--cl-library 'cl-lib)
`(cl-delete-duplicates ,cl-seq ,@cl-keys)
`(delete-duplicates ,cl-seq ,@cl-keys))))
@@ -222,6 +229,7 @@ This variant works around bugs in `eval-when-compile' in various
(defmacro c-font-lock-flush (beg end)
"Declare the region BEG...END's fontification as out-of-date.
On XEmacs and older Emacsen, this refontifies that region immediately."
+ (declare (debug t))
(if (fboundp 'font-lock-flush)
`(font-lock-flush ,beg ,end)
`(font-lock-fontify-region ,beg ,end)))
@@ -232,6 +240,7 @@ The current point is used if POINT isn't specified. POSITION can be
one of the following symbols:
`bol' -- beginning of line
+`boll' -- beginning of logical line (i.e. without preceding escaped NL)
`eol' -- end of line
`eoll' -- end of logical line (i.e. without escaped NL)
`bod' -- beginning of defun
@@ -249,6 +258,7 @@ one of the following symbols:
If the referenced position doesn't exist, the closest accessible point
to it is returned. This function does not modify the point or the mark."
+ (declare (debug t))
(if (eq (car-safe position) 'quote)
(let ((position (eval position)))
(cond
@@ -261,6 +271,15 @@ to it is returned. This function does not modify the point or the mark."
(beginning-of-line)
(point))))
+ ((eq position 'boll)
+ `(save-excursion
+ ,@(if point `((goto-char ,point)))
+ (while (progn (beginning-of-line)
+ (when (not (bobp))
+ (eq (char-before (1- (point))) ?\\)))
+ (backward-char))
+ (point)))
+
((eq position 'eol)
(if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
'(line-end-position)
@@ -417,6 +436,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-is-escaped (pos)
;; Are there an odd number of backslashes before POS?
+ (declare (debug t))
`(save-excursion
(goto-char ,pos)
(not (zerop (logand (skip-chars-backward "\\\\") 1)))))
@@ -424,6 +444,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-will-be-escaped (pos beg end)
;; Will the character after POS be escaped after the removal of (BEG END)?
;; It is assumed that (>= POS END).
+ (declare (debug t))
`(save-excursion
(let ((-end- ,end)
count)
@@ -436,6 +457,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-will-be-unescaped (beg)
;; Would the character after BEG be unescaped?
+ (declare (debug t))
`(save-excursion
(let (count)
(goto-char ,beg)
@@ -446,6 +468,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-next-single-property-change (position prop &optional object limit)
;; See the doc string for either of the defuns expanded to.
+ (declare (debug t))
(if (and c-use-extents
(fboundp 'next-single-char-property-change))
;; XEmacs >= 2005-01-25
@@ -455,6 +478,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-previous-single-property-change (position prop &optional object limit)
;; See the doc string for either of the defuns expanded to.
+ (declare (debug t))
(if (and c-use-extents
(fboundp 'previous-single-char-property-change))
;; XEmacs >= 2005-01-25
@@ -474,6 +498,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-set-region-active (activate)
;; Activate the region if ACTIVE is non-nil, deactivate it
;; otherwise. Covers the differences between Emacs and XEmacs.
+ (declare (debug t))
(if (fboundp 'zmacs-activate-region)
;; XEmacs.
`(if ,activate
@@ -483,6 +508,7 @@ to it is returned. This function does not modify the point or the mark."
`(setq mark-active ,activate)))
(defmacro c-set-keymap-parent (map parent)
+ (declare (debug t))
(cond
;; XEmacs
((cc-bytecomp-fboundp 'set-keymap-parents)
@@ -495,6 +521,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-delete-and-extract-region (start end)
"Delete the text between START and END and return it."
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'delete-and-extract-region)
;; Emacs 21.1 and later
`(delete-and-extract-region ,start ,end)
@@ -505,15 +532,16 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-safe (&rest body)
;; safely execute BODY, return nil if an error occurred
+ (declare (indent 0) (debug t))
`(condition-case nil
(progn ,@body)
(error nil)))
-(put 'c-safe 'lisp-indent-function 0)
(defmacro c-int-to-char (integer)
;; In Emacs, a character is an integer. In XEmacs, a character is a
;; type distinct from an integer. Sometimes we need to convert integers to
;; characters. `c-int-to-char' makes this conversion, if necessary.
+ (declare (debug t))
(if (fboundp 'int-to-char)
`(int-to-char ,integer)
integer))
@@ -521,6 +549,7 @@ to it is returned. This function does not modify the point or the mark."
(defmacro c-characterp (arg)
;; Return t when ARG is a character (XEmacs) or integer (Emacs), otherwise
;; return nil.
+ (declare (debug t))
(if (integerp ?c)
`(integerp ,arg)
`(characterp ,arg)))
@@ -567,6 +596,7 @@ to it is returned. This function does not modify the point or the mark."
;; string opener, or after the introductory R of one. The match data is
;; overwritten. On success the opener's identifier will be (match-string
;; 1). Text properties on any characters are ignored.
+ (declare (debug t))
(if pos
`(save-excursion
(goto-char ,pos)
@@ -599,7 +629,7 @@ must not be within a `c-save-buffer-state', since the user then
wouldn't be able to undo them.
The return value is the value of the last form in BODY."
- (declare (debug t) (indent 1))
+ (declare (debug let*) (indent 1))
(if (fboundp 'with-silent-modifications)
`(with-silent-modifications (let* ,varlist ,@body))
`(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
@@ -628,6 +658,7 @@ If BODY makes a change that unconditionally is undone then wrap this
macro inside `c-save-buffer-state'. That way the change can be done
even when the buffer is read-only, and without interference from
various buffer change hooks."
+ (declare (indent 0) (debug t))
`(let (-tnt-chng-keep
-tnt-chng-state)
(unwind-protect
@@ -638,7 +669,6 @@ various buffer change hooks."
-tnt-chng-state (c-tnt-chng-record-state)
-tnt-chng-keep (progn ,@body))
(c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state))))
-(put 'c-tentative-buffer-changes 'lisp-indent-function 0)
(defun c-tnt-chng-record-state ()
;; Used internally in `c-tentative-buffer-changes'.
@@ -691,14 +721,17 @@ whitespace.
LIMIT sets an upper limit of the forward movement, if specified. If
LIMIT or the end of the buffer is reached inside a comment or
-preprocessor directive, the point will be left there.
+preprocessor directive, the point will be left there. If point starts
+on the wrong side of LIMIT, it stays unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
+ (declare (debug t))
(if limit
- `(save-restriction
- (narrow-to-region (point-min) (or ,limit (point-max)))
- (c-forward-sws))
+ `(when (< (point) (or ,limit (point-max)))
+ (save-restriction
+ (narrow-to-region (point-min) (or ,limit (point-max)))
+ (c-forward-sws)))
'(c-forward-sws)))
(defmacro c-backward-syntactic-ws (&optional limit)
@@ -710,14 +743,17 @@ whitespace.
LIMIT sets a lower limit of the backward movement, if specified. If
LIMIT is reached inside a line comment or preprocessor directive then
-the point is moved into it past the whitespace at the end.
+the point is moved into it past the whitespace at the end. If point
+starts on the wrong side of LIMIT, it stays unchanged.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
+ (declare (debug t))
(if limit
- `(save-restriction
- (narrow-to-region (or ,limit (point-min)) (point-max))
- (c-backward-sws))
+ `(when (> (point) (or ,limit (point-min)))
+ (save-restriction
+ (narrow-to-region (or ,limit (point-min)) (point-max))
+ (c-backward-sws)))
'(c-backward-sws)))
(defmacro c-forward-sexp (&optional count)
@@ -729,11 +765,13 @@ This is like `forward-sexp' except that it isn't interactive and does
not do any user friendly adjustments of the point and that it isn't
susceptible to user configurations such as disabling of signals in
certain situations."
+ (declare (debug t))
(or count (setq count 1))
`(goto-char (scan-sexps (point) ,count)))
(defmacro c-backward-sexp (&optional count)
"See `c-forward-sexp' and reverse directions."
+ (declare (debug t))
(or count (setq count 1))
`(c-forward-sexp ,(if (numberp count) (- count) `(- ,count))))
@@ -743,6 +781,7 @@ for unbalanced parens.
A limit for the search may be given. FROM is assumed to be on the
right side of it."
+ (declare (debug t))
(let ((res (if (featurep 'xemacs)
`(scan-lists ,from ,count ,depth nil t)
`(c-safe (scan-lists ,from ,count ,depth)))))
@@ -770,6 +809,7 @@ leave point unmoved.
A LIMIT for the search may be given. The start position is assumed to be
before it."
+ (declare (debug t))
`(let ((dest (c-safe-scan-lists ,(or pos '(point)) 1 0 ,limit)))
(when dest (goto-char dest) dest)))
@@ -780,6 +820,7 @@ leave point unmoved.
A LIMIT for the search may be given. The start position is assumed to be
after it."
+ (declare (debug t))
`(let ((dest (c-safe-scan-lists ,(or pos '(point)) -1 0 ,limit)))
(when dest (goto-char dest) dest)))
@@ -789,6 +830,7 @@ or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) 1 1 ,limit))
(defmacro c-up-list-backward (&optional pos limit)
@@ -797,6 +839,7 @@ or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) -1 1 ,limit))
(defmacro c-down-list-forward (&optional pos limit)
@@ -805,6 +848,7 @@ or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) 1 -1 ,limit))
(defmacro c-down-list-backward (&optional pos limit)
@@ -813,6 +857,7 @@ or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(c-safe-scan-lists ,(or pos '(point)) -1 -1 ,limit))
(defmacro c-go-up-list-forward (&optional pos limit)
@@ -822,6 +867,7 @@ position exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(let ((dest (c-up-list-forward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -832,6 +878,7 @@ position exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(let ((dest (c-up-list-backward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -842,6 +889,7 @@ exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be before it."
+ (declare (debug t))
`(let ((dest (c-down-list-forward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -852,6 +900,7 @@ exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be after it."
+ (declare (debug t))
`(let ((dest (c-down-list-backward ,pos ,limit)))
(when dest (goto-char dest) t)))
@@ -963,6 +1012,7 @@ be after it."
;; point)? Always returns nil for languages which don't have Virtual
;; semicolons.
;; This macro might do hidden buffer changes.
+ (declare (debug t))
`(if c-at-vsemi-p-fn
(funcall c-at-vsemi-p-fn ,@(if pos `(,pos)))))
@@ -980,6 +1030,7 @@ be after it."
(defmacro c-benign-error (format &rest args)
;; Formats an error message for the echo area and dings, i.e. like
;; `error' but doesn't abort.
+ (declare (debug t))
`(progn
(message ,format ,@args)
(ding)))
@@ -989,18 +1040,19 @@ be after it."
;; way to execute code.
;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call
;; any forms inside this that call `c-parse-state'. !!!!
+ (declare (indent 1) (debug t))
`(let ((c-with-syntax-table-orig-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ,table)
,@code)
(set-syntax-table c-with-syntax-table-orig-table))))
-(put 'c-with-syntax-table 'lisp-indent-function 1)
(defmacro c-skip-ws-forward (&optional limit)
"Skip over any whitespace following point.
This function skips over horizontal and vertical whitespace and line
continuations."
+ (declare (debug t))
(if limit
`(let ((limit (or ,limit (point-max))))
(while (progn
@@ -1022,6 +1074,7 @@ continuations."
"Skip over any whitespace preceding point.
This function skips over horizontal and vertical whitespace and line
continuations."
+ (declare (debug t))
(if limit
`(let ((limit (or ,limit (point-min))))
(while (progn
@@ -1044,6 +1097,7 @@ continuations."
"Return non-nil if the current CC Mode major mode is MODE.
MODE is either a mode symbol or a list of mode symbols."
+ (declare (debug t))
(if c-langs-are-parametric
;; Inside a `c-lang-defconst'.
`(c-lang-major-mode-is ,mode)
@@ -1126,6 +1180,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; 21) then it's assumed that the property is present on it.
;;
;; This macro does a hidden buffer change.
+ (declare (debug t))
(setq property (eval property))
(if (or c-use-extents
(not (cc-bytecomp-boundp 'text-property-default-nonsticky)))
@@ -1143,6 +1198,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; Get the value of the given property on the character at POS if
;; it's been put there by `c-put-char-property'. PROPERTY is
;; assumed to be constant.
+ (declare (debug t))
(setq property (eval property))
(if c-use-extents
;; XEmacs.
@@ -1173,6 +1229,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; constant.
;;
;; This macro does a hidden buffer change.
+ (declare (debug t))
(setq property (eval property))
(cond (c-use-extents
;; XEmacs.
@@ -1195,6 +1252,7 @@ MODE is either a mode symbol or a list of mode symbols."
;; Return the first position in the range [FROM to) where the text property
;; PROPERTY is set, or `most-positive-fixnum' if there is no such position.
;; PROPERTY should be a quoted constant.
+ (declare (debug t))
`(let ((-from- ,from) (-to- ,to) pos)
(cond
((and (< -from- -to-)
@@ -1210,31 +1268,44 @@ MODE is either a mode symbol or a list of mode symbols."
;; region that has been put with `c-put-char-property'. PROPERTY is
;; assumed to be constant.
;;
+ ;; The returned value is the buffer position of the lowest character
+ ;; whose PROPERTY was removed, or nil if there was none.
+ ;;
;; Note that this function does not clean up the property from the
;; lists of the `rear-nonsticky' properties in the region, if such
;; are used. Thus it should not be used for common properties like
;; `syntax-table'.
;;
;; This macro does hidden buffer changes.
+ (declare (debug t))
(setq property (eval property))
- (if c-use-extents
- ;; XEmacs.
- `(map-extents (lambda (ext ignored)
- (delete-extent ext))
- nil ,from ,to nil nil ',property)
- ;; Emacs.
- (if (and (fboundp 'syntax-ppss)
- (eq `,property 'syntax-table))
- `(let ((-from- ,from) (-to- ,to))
- (setq c-syntax-table-hwm
- (min c-syntax-table-hwm
- (c-min-property-position -from- -to- ',property)))
- (remove-text-properties -from- -to- '(,property nil)))
- `(remove-text-properties ,from ,to '(,property nil)))))
+ `(let* ((-to- ,to)
+ (ret (c-min-property-position ,from -to- ',property)))
+ (if (< ret -to-)
+ (progn
+ ,(cond
+ (c-use-extents
+ ;; XEmacs
+ `(map-extents (lambda (ext ignored)
+ (delete-extent ext))
+ nil ret -to- nil nil ',property))
+ ((and (fboundp 'syntax-ppss)
+ (eq property 'syntax-table))
+ ;; Emacs 'syntax-table
+ `(progn
+ (setq c-syntax-table-hwm
+ (min c-syntax-table-hwm ret))
+ (remove-text-properties ret -to- '(,property nil))))
+ (t
+ ;; Emacs other property.
+ `(remove-text-properties ret -to- '(,property nil))))
+ ret)
+ nil)))
(defmacro c-clear-syn-tab-properties (from to)
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
;; properties between FROM and TO.
+ (declare (debug t))
`(let ((-from- ,from) (-to- ,to))
(when (and
c-min-syn-tab-mkr c-max-syn-tab-mkr
@@ -1256,6 +1327,7 @@ LIMIT bounds the search. The comparison is done with `equal'.
Leave point just after the character, and set the match data on
this character, and return point. If VALUE isn't found, Return
nil; point is then left undefined."
+ (declare (debug t))
`(let ((place (point)))
(while
(and
@@ -1275,6 +1347,7 @@ LIMIT bounds the search. The comparison is done with `equal'.
Leave point just before the character, set the match data on this
character, and return point. If VALUE isn't found, Return nil;
point is then left undefined."
+ (declare (debug t))
`(let ((place (point)))
(while
(and
@@ -1318,6 +1391,7 @@ been put there by c-put-char-property. POINT remains unchanged."
which have the value VALUE, 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."
+ (declare (debug t))
(if c-use-extents
;; XEmacs
`(let ((-property- ,property))
@@ -1338,6 +1412,7 @@ 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."
+ (declare (debug t))
`(let ((char-skip (concat "^" (char-to-string ,char)))
(-limit- (or ,limit (point-max)))
(-value- ,value))
@@ -1361,6 +1436,7 @@ PROPERTY must be a constant.
Leave point just before the character, and set the match data on
this character, and return point. If the search fails, return
nil; point is then left undefined."
+ (declare (debug t))
`(let ((char-skip (concat "^" (char-to-string ,char)))
(-limit- (or ,limit (point-min)))
(-value- ,value))
@@ -1384,6 +1460,7 @@ 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."
+ (declare (debug t))
`(let ((char-skip (concat "^" (char-to-string ,char)))
(-limit- (or ,limit (point-max)))
(-value- ,value))
@@ -1432,6 +1509,7 @@ by `equal'. These properties are assumed to be over individual
characters, having been put there by c-put-char-property. POINT
remains unchanged. Return the position of the first removed
property, or nil."
+ (declare (debug t))
(if c-use-extents
;; XEmacs
`(let ((-property- ,property)
@@ -1455,6 +1533,7 @@ property, or nil."
;; `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)."
+ (declare (debug t))
`(let ((skip-string (concat "^" (list ,char)))
(-to- ,to))
(save-excursion
@@ -1477,6 +1556,7 @@ with value CHAR in the region [FROM to)."
;; Put an overlay/extent covering the given range in the current
;; buffer. It's currently undefined whether it's front/end sticky
;; or not. The overlay/extent object is returned.
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'make-overlay)
;; Emacs.
`(let ((ol (make-overlay ,from ,to)))
@@ -1490,6 +1570,7 @@ with value CHAR in the region [FROM to)."
(defmacro c-delete-overlay (overlay)
;; Deletes an overlay/extent object previously retrieved using
;; `c-put-overlay'.
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'make-overlay)
;; Emacs.
`(delete-overlay ,overlay)
@@ -1497,80 +1578,6 @@ with value CHAR in the region [FROM to)."
`(delete-extent ,overlay)))
-;; Make edebug understand the macros.
-;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '(progn
-(def-edebug-spec cc-eval-when-compile (&rest def-form))
-(def-edebug-spec c-font-lock-flush t)
-(def-edebug-spec c--mapcan t)
-(def-edebug-spec c--set-difference (form form &rest [symbolp form]))
-(def-edebug-spec c--intersection (form form &rest [symbolp form]))
-(def-edebug-spec c--delete-duplicates (form &rest [symbolp form]))
-(def-edebug-spec c-point t)
-(def-edebug-spec c-is-escaped t)
-(def-edebug-spec c-will-be-escaped t)
-(def-edebug-spec c-next-single-property-change t)
-(def-edebug-spec c-delete-and-extract-region 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-int-to-char t)
-(def-edebug-spec c-characterp t)
-(def-edebug-spec c-save-buffer-state let*)
-(def-edebug-spec c-tentative-buffer-changes t)
-(def-edebug-spec c-forward-syntactic-ws t)
-(def-edebug-spec c-backward-syntactic-ws t)
-(def-edebug-spec c-forward-sexp t)
-(def-edebug-spec c-backward-sexp t)
-(def-edebug-spec c-safe-scan-lists t)
-(def-edebug-spec c-go-list-forward t)
-(def-edebug-spec c-go-list-backward t)
-(def-edebug-spec c-up-list-forward t)
-(def-edebug-spec c-up-list-backward t)
-(def-edebug-spec c-down-list-forward t)
-(def-edebug-spec c-down-list-backward t)
-(def-edebug-spec c-go-up-list-forward t)
-(def-edebug-spec c-go-up-list-backward t)
-(def-edebug-spec c-go-down-list-forward t)
-(def-edebug-spec c-go-down-list-backward t)
-(def-edebug-spec c-at-vsemi-p t)
-(def-edebug-spec c-add-syntax t)
-(def-edebug-spec c-add-class-syntax t)
-(def-edebug-spec c-benign-error t)
-(def-edebug-spec c-with-syntax-table t)
-(def-edebug-spec c-skip-ws-forward t)
-(def-edebug-spec c-skip-ws-backward t)
-(def-edebug-spec c-major-mode-is t)
-(def-edebug-spec c-search-forward-char-property t)
-(def-edebug-spec c-search-backward-char-property t)
-(def-edebug-spec c-put-char-property t)
-(def-edebug-spec c-put-syn-tab t)
-(def-edebug-spec c-get-char-property t)
-(def-edebug-spec c-clear-char-property t)
-(def-edebug-spec c-clear-syn-tab t)
-;;(def-edebug-spec c-min-property-position nil) ; invoked only by macros
-(def-edebug-spec c-min-property-position t) ; Now invoked from functions (2019-07)
-(def-edebug-spec c-clear-char-property-with-value 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-clear-syn-tab-properties t)
-(def-edebug-spec c-with-extended-string-fences (form form body))
-(def-edebug-spec c-put-overlay t)
-(def-edebug-spec c-delete-overlay t)
-(def-edebug-spec c-mark-<-as-paren t)
-(def-edebug-spec c-mark->-as-paren t)
-(def-edebug-spec c-unmark-<->-as-paren t)
-(def-edebug-spec c-with-<->-as-parens-suppressed (body))
-(def-edebug-spec c-self-bind-state-cache (body))
-(def-edebug-spec c-sc-scan-lists-no-category+1+1 t)
-(def-edebug-spec c-sc-scan-lists-no-category+1-1 t)
-(def-edebug-spec c-sc-scan-lists-no-category-1+1 t)
-(def-edebug-spec c-sc-scan-lists-no-category-1-1 t)
-(def-edebug-spec c-sc-scan-lists t)
-(def-edebug-spec c-sc-parse-partial-sexp t);))
-
-
;;; Functions.
;; Note: All these after the macros, to be on safe side in avoiding
@@ -1600,6 +1607,7 @@ with value CHAR in the region [FROM to)."
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
+ (declare (debug t))
(if c-use-category
`(c-put-char-property ,pos 'category 'c-<-as-paren-syntax)
`(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax)))
@@ -1614,6 +1622,7 @@ with value CHAR in the region [FROM to)."
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
+ (declare (debug t))
(if c-use-category
`(c-put-char-property ,pos 'category 'c->-as-paren-syntax)
`(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax)))
@@ -1627,6 +1636,7 @@ with value CHAR in the region [FROM to)."
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
+ (declare (debug t))
`(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table)))
(defsubst c-suppress-<->-as-parens ()
@@ -1647,50 +1657,13 @@ with value CHAR in the region [FROM to)."
;; Like progn, except that the paren property is suppressed on all
;; template brackets whilst they are running. This macro does a hidden
;; buffer change.
+ (declare (debug (body)))
`(unwind-protect
(progn
(c-suppress-<->-as-parens)
,@forms)
(c-restore-<->-as-parens)))
-;;;;;;;;;;;;;;;
-
-(defmacro c-self-bind-state-cache (&rest forms)
- ;; Bind the state cache to itself and execute the FORMS. Return the result
- ;; of the last FORM executed. It is assumed that no buffer changes will
- ;; happen in FORMS, and no hidden buffer changes which could affect the
- ;; parsing will be made by FORMS.
- `(let* ((c-state-cache (copy-tree c-state-cache))
- (c-state-cache-good-pos c-state-cache-good-pos)
- ;(c-state-nonlit-pos-cache (copy-tree c-state-nonlit-pos-cache))
- ;(c-state-nonlit-pos-cache-limit c-state-nonlit-pos-cache-limit)
- ;(c-state-semi-nonlit-pos-cache (copy-tree c-state-semi-nonlit-pos-cache))
- ;(c-state-semi-nonlit-pos-cache-limit c-state-semi-nonlit-pos-cache)
- (c-state-brace-pair-desert (copy-tree c-state-brace-pair-desert))
- (c-state-point-min c-state-point-min)
- (c-state-point-min-lit-type c-state-point-min-lit-type)
- (c-state-point-min-lit-start c-state-point-min-lit-start)
- (c-state-min-scan-pos c-state-min-scan-pos)
- (c-state-old-cpp-beg-marker (if (markerp c-state-old-cpp-beg-marker)
- (copy-marker c-state-old-cpp-beg-marker)
- c-state-old-cpp-beg-marker))
- (c-state-old-cpp-beg (if (markerp c-state-old-cpp-beg)
- c-state-old-cpp-beg-marker
- c-state-old-cpp-beg))
- (c-state-old-cpp-end-marker (if (markerp c-state-old-cpp-end-marker)
- (copy-marker c-state-old-cpp-end-marker)
- c-state-old-cpp-end-marker))
- (c-state-old-cpp-end (if (markerp c-state-old-cpp-end)
- c-state-old-cpp-end-marker
- c-state-old-cpp-end))
- (c-parse-state-state c-parse-state-state))
- (prog1
- (progn ,@forms)
- (if (markerp c-state-old-cpp-beg-marker)
- (move-marker c-state-old-cpp-beg-marker nil))
- (if (markerp c-state-old-cpp-end-marker)
- (move-marker c-state-old-cpp-end-marker nil)))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following macros are to be used only in `c-parse-state' and its
;; subroutines. Their main purpose is to simplify the handling of C++/Java
@@ -1704,8 +1677,8 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is
;; determined by and angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
- `(let ((here (point))
- (pos (scan-lists ,from 1 1)))
+ (declare (debug t))
+ `(let ((pos (scan-lists ,from 1 1)))
(while (eq (char-before pos) ?>)
(setq pos (scan-lists pos 1 1)))
pos))
@@ -1714,8 +1687,8 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is
;; determined by an angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
- `(let ((here (point))
- (pos (scan-lists ,from 1 -1)))
+ (declare (debug t))
+ `(let ((pos (scan-lists ,from 1 -1)))
(while (eq (char-before pos) ?<)
(setq pos (scan-lists pos 1 1))
(setq pos (scan-lists pos 1 -1)))
@@ -1725,8 +1698,8 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is
;; determined by and angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
- `(let ((here (point))
- (pos (scan-lists ,from -1 1)))
+ (declare (debug t))
+ `(let ((pos (scan-lists ,from -1 1)))
(while (eq (char-after pos) ?<)
(setq pos (scan-lists pos -1 1)))
pos))
@@ -1735,14 +1708,15 @@ with value CHAR in the region [FROM to)."
;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is
;; determined by and angle bracket; or (ii) is inside a macro whose start
;; isn't POINT-MACRO-START doesn't count as a finishing position.
- `(let ((here (point))
- (pos (scan-lists ,from -1 -1)))
+ (declare (debug t))
+ `(let ((pos (scan-lists ,from -1 -1)))
(while (eq (char-after pos) ?>)
(setq pos (scan-lists pos -1 1))
(setq pos (scan-lists pos -1 -1)))
pos))
(defmacro c-sc-scan-lists (from count depth)
+ (declare (debug t))
(if c-use-category
`(scan-lists ,from ,count ,depth)
(cond
@@ -1790,6 +1764,7 @@ with value CHAR in the region [FROM to)."
(defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore
oldstate)
+ (declare (debug t))
(if c-use-category
`(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate)
`(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore
@@ -2350,6 +2325,7 @@ system."
"Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
immediately, i.e. at the same time as the `c-lang-defconst' form
itself is evaluated."
+ (declare (debug t))
;; Evaluate at macro expansion time, i.e. in the
;; `c--macroexpand-all' inside `c-lang-defconst'.
(eval form))
@@ -2392,7 +2368,8 @@ one `c-lang-defconst' for each NAME is permitted per file. If there
already is one it will be completely replaced; the value in the
earlier definition will not affect `c-lang-const' on the same
constant. A file is identified by its base name."
-
+ (declare (indent 1)
+ (debug (&define name [&optional stringp] [&rest sexp def-form])))
(let* ((sym (intern (symbol-name name) c-lang-constants))
;; Make `c-lang-const' expand to a straightforward call to
;; `c-get-lang-constant' in `c--macroexpand-all' below.
@@ -2483,12 +2460,6 @@ constant. A file is identified by its base name."
(c-define-lang-constant ',name ,bindings
,@(and pre-files `(',pre-files))))))
-(put 'c-lang-defconst 'lisp-indent-function 1)
-;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '
-(def-edebug-spec c-lang-defconst
- (&define name [&optional stringp] [&rest sexp def-form]))
-
(defun c-define-lang-constant (name bindings &optional pre-files)
;; Used by `c-lang-defconst'.
@@ -2544,6 +2515,7 @@ LANG is the name of the language, i.e. the mode name without the
language. NAME and LANG are not evaluated so they should not be
quoted."
+ (declare (debug (name &optional symbolp)))
(or (symbolp name)
(error "Not a symbol: %S" name))
(or (symbolp lang)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 484624b8664..5d2e41ae575 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,4 +1,4 @@
-;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*-
+;;; cc-engine.el --- core syntax guessing engine for CC mode -*- lexical-binding:t; coding: utf-8 -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -163,11 +163,14 @@
(defvar c-doc-line-join-re)
(defvar c-doc-bright-comment-start-re)
(defvar c-doc-line-join-end-ch)
+(defvar c-syntactic-context)
+(defvar c-syntactic-element)
(cc-bytecomp-defvar c-min-syn-tab-mkr)
(cc-bytecomp-defvar c-max-syn-tab-mkr)
(cc-bytecomp-defun c-clear-syn-tab)
(cc-bytecomp-defun c-clear-string-fences)
(cc-bytecomp-defun c-restore-string-fences)
+(cc-bytecomp-defun c-remove-string-fences)
;; Make declarations for all the `c-lang-defvar' variables in cc-langs.
@@ -735,6 +738,7 @@ comment at the start of cc-engine.el for more info."
'(setq stack (cons (cons state saved-pos)
stack)))
(defmacro c-bos-pop-state (&optional do-if-done)
+ (declare (debug t))
`(if (setq state (car (car stack))
saved-pos (cdr (car stack))
stack (cdr stack))
@@ -759,6 +763,7 @@ comment at the start of cc-engine.el for more info."
(goto-char pos)
(setq sym nil)))
(defmacro c-bos-save-error-info (missing got)
+ (declare (debug t))
`(setq saved-pos (vector pos ,missing ,got)))
(defmacro c-bos-report-error ()
'(unless noerror
@@ -1184,6 +1189,15 @@ comment at the start of cc-engine.el for more info."
;; suitable error.
(setq pre-stmt-found t)
(throw 'loop nil))
+ ;; Handle C++'s `constexpr', etc.
+ (if (save-excursion
+ (and (looking-at c-block-stmt-hangon-key)
+ (progn
+ (c-backward-syntactic-ws lim)
+ (c-safe (c-backward-sexp) t))
+ (looking-at c-block-stmt-2-key)
+ (setq pos (point))))
+ (goto-char pos))
(cond
;; Have we moved into a macro?
((and (not macro-start)
@@ -1860,51 +1874,51 @@ comment at the start of cc-engine.el for more info."
; (setq in-face (point)))
; (not (eobp)))))))
-(defmacro c-debug-sws-msg (&rest args)
- (ignore args)
+(defmacro c-debug-sws-msg (&rest _args)
+ ;; (declare (debug t))
;;`(message ,@args)
)
(defmacro c-put-is-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(put-text-property beg end 'c-is-sws t)
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-add-face beg end 'c-debug-is-sws-face)))))
-(def-edebug-spec c-put-is-sws t)
(defmacro c-put-in-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(put-text-property beg end 'c-in-sws t)
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-add-face beg end 'c-debug-in-sws-face)))))
-(def-edebug-spec c-put-in-sws t)
(defmacro c-remove-is-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(remove-text-properties beg end '(c-is-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-is-sws-face)))))
-(def-edebug-spec c-remove-is-sws t)
(defmacro c-remove-in-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(remove-text-properties beg end '(c-in-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-in-sws-face)))))
-(def-edebug-spec c-remove-in-sws t)
(defmacro c-remove-is-and-in-sws (beg end)
;; This macro does a hidden buffer change.
+ (declare (debug t))
`(let ((beg ,beg) (end ,end))
(remove-text-properties beg end '(c-is-sws nil c-in-sws nil))
,@(when (facep 'c-debug-is-sws-face)
'((c-debug-remove-face beg end 'c-debug-is-sws-face)
(c-debug-remove-face beg end 'c-debug-in-sws-face)))))
-(def-edebug-spec c-remove-is-and-in-sws t)
;; The type of literal position `end' is in a `before-change-functions'
;; function - one of `c', `c++', `pound', `noise', `attribute' or nil (but NOT
@@ -2665,7 +2679,7 @@ comment at the start of cc-engine.el for more info."
;; One of the above "near" caches is associated with each of these functions.
;;
;; When searching this cache, these functions first seek an exact match, then
-;; a "close" match from the assiciated near cache. If neither of these
+;; a "close" match from the associated near cache. If neither of these
;; succeed, the nearest preceding entry in the far cache is used.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2708,9 +2722,9 @@ comment at the start of cc-engine.el for more info."
;; two char construct (such as a comment opener or an escaped character).)
(if (and (consp elt) (>= (length elt) 3))
;; Inside a string or comment
- (let ((depth 0) (containing nil) (last nil)
+ (let ((depth 0) (containing nil)
in-string in-comment
- (min-depth 0) com-style com-str-start (intermediate nil)
+ (min-depth 0) com-style com-str-start
(char-1 (nth 3 elt)) ; first char of poss. 2-char construct
(pos (car elt))
(type (cadr elt)))
@@ -2727,14 +2741,13 @@ comment at the start of cc-engine.el for more info."
(1- pos)
pos))
(if (memq 'pps-extended-state c-emacs-features)
- (list depth containing last
+ (list depth containing nil
in-string in-comment nil
min-depth com-style com-str-start
- intermediate nil)
- (list depth containing last
+ nil nil)
+ (list depth containing nil
in-string in-comment nil
- min-depth com-style com-str-start
- intermediate)))
+ min-depth com-style com-str-start nil)))
;; Not in a string or comment.
(if (memq 'pps-extended-state c-emacs-features)
@@ -3128,21 +3141,21 @@ comment at the start of cc-engine.el for more info."
(setq base far-base
s far-s
end nil))))
- (when
- (or
- (and (> here base) (null end))
- (null (nth 8 s))
- (and end (>= here end))
- (not
- (or
- (and (nth 3 s) ; string
- (not (eq (char-before here) ?\\)))
- (and (nth 4 s) (not (nth 7 s)) ; Block comment
- (not (memq (char-before here)
- c-block-comment-awkward-chars)))
- (and (nth 4 s) (nth 7 s) ; Line comment
- (not (memq (char-before here) '(?\\ ?\n)))))))
+ (cond
+ ((or (and (> here base) (null end))
+ (null (nth 8 s))
+ (and end (>= here end)))
(setq s (parse-partial-sexp base here nil nil s)))
+ ((or (and (nth 3 s) ; string
+ (eq (char-before here) ?\\))
+ (and (nth 4 s) (not (nth 7 s)) ; block comment
+ (memq (char-before here) c-block-comment-awkward-chars))
+ (and (nth 4 s) (nth 7 s) ; line comment
+ (memq (char-before here) '(?\\ ?\n))))
+ (setq s
+ (if (>= here base)
+ (parse-partial-sexp base here nil nil s)
+ (parse-partial-sexp (nth 8 s) here)))))
(cond
((or (nth 3 s)
(and (nth 4 s)
@@ -3507,6 +3520,7 @@ mhtml-mode."
(defmacro c-state-cache-top-lparen (&optional cache)
;; Return the address of the top left brace/bracket/paren recorded in CACHE
;; (default `c-state-cache') (or nil).
+ (declare (debug t))
(let ((cash (or cache 'c-state-cache)))
`(if (consp (car ,cash))
(caar ,cash)
@@ -3515,6 +3529,7 @@ mhtml-mode."
(defmacro c-state-cache-top-paren (&optional cache)
;; Return the address of the latest brace/bracket/paren (whether left or
;; right) recorded in CACHE (default `c-state-cache') or nil.
+ (declare (debug t))
(let ((cash (or cache 'c-state-cache)))
`(if (consp (car ,cash))
(cdar ,cash)
@@ -3523,6 +3538,7 @@ mhtml-mode."
(defmacro c-state-cache-after-top-paren (&optional cache)
;; Return the position just after the latest brace/bracket/paren (whether
;; left or right) recorded in CACHE (default `c-state-cache') or nil.
+ (declare (debug t))
(let ((cash (or cache 'c-state-cache)))
`(if (consp (car ,cash))
(cdar ,cash)
@@ -3784,12 +3800,14 @@ mhtml-mode."
(point)))
(bra ; Position of "{".
;; Don't start scanning in the middle of a CPP construct unless
- ;; it contains HERE - these constructs, in Emacs, are "commented
- ;; out" with category properties.
- (if (eq (c-get-char-property macro-start-or-from 'category)
- 'c-cpp-delimiter)
- macro-start-or-from
- from))
+ ;; it contains HERE.
+ (if (and (not (eq macro-start-or-from from))
+ (< macro-start-or-from here) ; Might not be needed.
+ (progn (goto-char macro-start-or-from)
+ (c-end-of-macro)
+ (>= (point) here)))
+ from
+ macro-start-or-from))
ce) ; Position of "}"
(or upper-lim (setq upper-lim from))
@@ -4319,38 +4337,29 @@ mhtml-mode."
(setq c-state-nonlit-pos-cache-limit (1- here)))
(c-truncate-lit-pos-cache here)
- ;; `c-state-cache':
- ;; Case 1: if `here' is in a literal containing point-min, everything
- ;; becomes (or is already) nil.
- (if (or (null c-state-cache-good-pos)
- (< here (c-state-get-min-scan-pos)))
- (setq c-state-cache nil
- c-state-cache-good-pos nil
- c-state-min-scan-pos nil)
-
- ;; Truncate `c-state-cache' and set `c-state-cache-good-pos' to a value
- ;; below `here'. To maintain its consistency, we may need to insert a new
- ;; 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?
- ;; The easy bit - knock over-the-top bits off `c-state-cache'.
- (while (and c-state-cache
- (>= (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)))
-
- ;; Do we need to add in an earlier brace pair, having lopped one off?
- (if (and dropped-cons
- (<= too-high-pa here))
- (c-append-lower-brace-pair-to-state-cache too-high-pa here here-bol))
- (if (and c-state-cache-good-pos (< here c-state-cache-good-pos))
- (setq c-state-cache-good-pos
- (or (save-excursion
- (goto-char here)
- (c-literal-start))
- here)))))
+ (cond
+ ;; `c-state-cache':
+ ;; Case 1: if `here' is in a literal containing point-min, everything
+ ;; becomes (or is already) nil.
+ ((or (null c-state-cache-good-pos)
+ (< here (c-state-get-min-scan-pos)))
+ (setq c-state-cache nil
+ c-state-cache-good-pos nil
+ c-state-min-scan-pos nil))
+
+ ;; Case 2: `here' is below `c-state-cache-good-pos', so we need to amend
+ ;; the entire `c-state-cache' data.
+ ((< here c-state-cache-good-pos)
+ (let* ((res (c-remove-stale-state-cache-backwards here))
+ (good-pos (car res))
+ (scan-backward-pos (cadr res))
+ (scan-forward-p (car (cddr res))))
+ (if scan-backward-pos
+ (c-append-lower-brace-pair-to-state-cache scan-backward-pos here))
+ (setq c-state-cache-good-pos
+ (if scan-forward-p
+ (c-append-to-state-cache good-pos here)
+ good-pos)))))
;; The brace-pair desert marker:
(when (car c-state-brace-pair-desert)
@@ -4484,6 +4493,7 @@ mhtml-mode."
(defmacro c-state-maybe-marker (place marker)
;; If PLACE is non-nil, return a marker marking it, otherwise nil.
;; We (re)use MARKER.
+ (declare (debug (form symbolp)))
`(let ((-place- ,place))
(and -place-
(or ,marker (setq ,marker (make-marker)))
@@ -5970,6 +5980,7 @@ comment at the start of cc-engine.el for more info."
; spots and the preceding token end.")
(defmacro c-debug-put-decl-spot-faces (match-pos decl-pos)
+ (declare (debug t))
(when (facep 'c-debug-decl-spot-face)
`(c-save-buffer-state ((match-pos ,match-pos) (decl-pos ,decl-pos))
(c-debug-add-face (max match-pos (point-min)) decl-pos
@@ -5977,6 +5988,7 @@ comment at the start of cc-engine.el for more info."
(c-debug-add-face decl-pos (min (1+ decl-pos) (point-max))
'c-debug-decl-spot-face))))
(defmacro c-debug-remove-decl-spot-faces (beg end)
+ (declare (debug t))
(when (facep 'c-debug-decl-spot-face)
`(c-save-buffer-state ()
(c-debug-remove-face ,beg ,end 'c-debug-decl-spot-face)
@@ -6931,8 +6943,10 @@ comment at the start of cc-engine.el for more info."
(c-go-list-forward))
(when (equal (c-get-char-property (1- (point)) 'syntax-table)
c->-as-paren-syntax) ; should always be true.
- (c-unmark-<->-as-paren (1- (point))))
- (c-unmark-<->-as-paren pos))))
+ (c-unmark-<->-as-paren (1- (point)))
+ (c-truncate-lit-pos-cache (1- (point))))
+ (c-unmark-<->-as-paren pos)
+ (c-truncate-lit-pos-cache pos))))
(defun c-clear->-pair-props (&optional pos)
;; POS (default point) is at a > character. If it is marked with
@@ -6948,8 +6962,10 @@ comment at the start of cc-engine.el for more info."
(c-go-up-list-backward))
(when (equal (c-get-char-property (point) 'syntax-table)
c-<-as-paren-syntax) ; should always be true.
- (c-unmark-<->-as-paren (point)))
- (c-unmark-<->-as-paren pos))))
+ (c-unmark-<->-as-paren (point))
+ (c-truncate-lit-pos-cache (point)))
+ (c-unmark-<->-as-paren pos)
+ (c-truncate-lit-pos-cache pos))))
(defun c-clear-<>-pair-props (&optional pos)
;; POS (default point) is at a < or > character. If it has an
@@ -6982,7 +6998,8 @@ comment at the start of cc-engine.el for more info."
(equal (c-get-char-property (1- (point)) 'syntax-table)
c->-as-paren-syntax)) ; should always be true.
(c-unmark-<->-as-paren (1- (point)))
- (c-unmark-<->-as-paren pos))
+ (c-unmark-<->-as-paren pos)
+ (c-truncate-lit-pos-cache pos))
t)))
(defun c-clear->-pair-props-if-match-before (lim &optional pos)
@@ -7003,6 +7020,7 @@ comment at the start of cc-engine.el for more info."
(equal (c-get-char-property (point) 'syntax-table)
c-<-as-paren-syntax)) ; should always be true.
(c-unmark-<->-as-paren (point))
+ (c-truncate-lit-pos-cache (point))
(c-unmark-<->-as-paren pos))
t)))
@@ -7150,554 +7168,954 @@ comment at the start of cc-engine.el for more info."
(goto-char c-new-END)))))
-;; Functions to handle C++ raw strings.
+;; Handling of CC Mode multi-line strings.
;;
-;; A valid C++ raw string looks like
-;; R"<id>(<contents>)<id>"
-;; , where <id> is an identifier from 0 to 16 characters long, not containing
-;; spaces, control characters, or left/right paren. <contents> can include
-;; anything which isn't the terminating )<id>", including new lines, "s,
-;; parentheses, etc.
+;; By a "multi-line string" is meant a string opened by a "decorated"
+;; double-quote mark, and which can continue over several lines without the
+;; need to escape the newlines, terminating at a closer, a possibly
+;; "decorated" double-quote mark. The string can usually contain double
+;; quotes without them being quoted, whether or not backslashes quote the
+;; following character being a matter of configuration.
;;
-;; CC Mode handles C++ raw strings by the use of `syntax-table' text
+;; CC Mode handles multi-line strings by the use of `syntax-table' text
;; properties as follows:
;;
-;; (i) On a validly terminated raw string, no `syntax-table' text properties
-;; are applied to the opening and closing delimiters, but any " in the
-;; contents is given the property value "punctuation" (`(1)') to prevent it
-;; interacting with the "s in the delimiters.
+;; (i) On a validly terminated ml string, syntax-table text-properties are
+;; applied as needed to the opener, so that the " character in the opener
+;; (or (usually) the first of them if there are several) retains its normal
+;; syntax, and any other characters with obtrusive syntax are given
+;; "punctuation" '(1) properties. Similarly, the " character in the closer
+;; retains its normal syntax, and characters with obtrusive syntax are
+;; "punctuated out" as before.
;;
-;; The font locking routine `c-font-lock-raw-strings' (in cc-fonts.el)
-;; recognizes valid raw strings, and fontifies the delimiters (apart from
-;; the parentheses) with the default face and the parentheses and the
-;; <contents> with font-lock-string-face.
+;; The font locking routine `c-font-lock-ml-strings' (in cc-fonts.el)
+;; recognizes validly terminated ml strings and fontifies (typically) the
+;; innermost character of each delimiter in font-lock-string-face and the
+;; rest of those delimiters in the default face. The contents, of course,
+;; are in font-lock-string-face.
;;
-;; (ii) A valid, but unterminated, raw string opening delimiter gets the
-;; "punctuation" value (`(1)') of the `syntax-table' text property, and the
-;; open parenthesis gets the "string fence" value (`(15)'). When such a
-;; delimiter is found, no attempt is made in any way to "correct" any text
-;; properties after the delimiter.
+;; (ii) A valid, but unterminated, ml string's opening delimiter gets the
+;; "punctuation" value (`(1)') of the `syntax-table' text property on its ",
+;; and the last char of the opener gets the "string fence" value '(15).
+;; (The latter takes precedence over the former.) When such a delimiter is
+;; found, no attempt is made in any way to "correct" any text properties
+;; after the delimiter.
;;
-;; `c-font-lock-raw-strings' puts c-font-lock-warning-face on the entire
-;; unmatched opening delimiter (from the R up to the open paren), and allows
-;; the rest of the buffer to get font-lock-string-face, caused by the
-;; unmatched "string fence" `syntax-table' text property value.
+;; `c-font-lock-ml-strings' puts c-font-lock-warning-face on the entire
+;; unmatched opening delimiter, and allows the tail of the buffer to get
+;; font-lock-string-face, caused by the unmatched "string fence"
+;; `syntax-table' text property value.
;;
-;; (iii) Inside a macro, a valid raw string is handled as in (i). An
-;; unmatched opening delimiter is handled slightly differently. In addition
-;; to the "punctuation" and "string fence" properties on the delimiter,
-;; another "string fence" `syntax-table' property is applied to the last
-;; possible character of the macro before the terminating linefeed (if there
-;; is such a character after the "("). This "last possible" character is
+;; (iii) Inside a macro, a valid ml string is handled as in (i). An unmatched
+;; opening delimiter is handled slightly differently. In addition to the
+;; "punctuation" and "string fence" properties on the delimiter, another
+;; "string fence" `syntax-table' property is applied to the last possible
+;; character of the macro before the terminating linefeed (if there is such
+;; a character after the delimiter). This "last possible" character is
;; never a backslash escaping the end of line. If the character preceding
;; this "last possible" character is itself a backslash, this preceding
-;; character gets a "punctuation" `syntax-table' value. If the "(" is
-;; already at the end of the macro, it gets the "punctuation" value, and no
-;; "string fence"s are used.
+;; character gets a "punctuation" `syntax-table' value. If the last
+;; character of the closing delimiter is already at the end of the macro, it
+;; gets the "punctuation" value, and no "string fence"s are used.
;;
;; The effect on the fontification of either of these tactics is that the
;; rest of the macro (if any) after the "(" gets font-lock-string-face, but
;; the rest of the file is fontified normally.
-;; The values of the function `c-raw-string-pos' at before-change-functions'
-;; BEG and END.
-(defvar c-old-beg-rs nil)
-(defvar c-old-end-rs nil)
-;; Whether a buffer change has disrupted or will disrupt the terminating id of
-;; a raw string.
-(defvar c-raw-string-end-delim-disrupted nil)
-
-(defun c-raw-string-pos ()
- ;; Get POINT's relationship to any containing raw string.
- ;; If point isn't in a raw string, return nil.
- ;; Otherwise, return the following list:
- ;;
- ;; (POS B\" B\( E\) E\")
- ;;
- ;; , where POS is the symbol `open-delim' if point is in the opening
- ;; delimiter, the symbol `close-delim' if it's in the closing delimiter, and
- ;; nil if it's in the string body. B\", B\(, E\), E\" are the positions of
- ;; the opening and closing quotes and parentheses of a correctly terminated
- ;; raw string. (N.B.: E\) and E\" are NOT on the "outside" of these
- ;; characters.) If the raw string is not terminated, E\) and E\" are set to
+(defun c-ml-string-make-closer-re (_opener)
+ "Return c-ml-string-any-closer-re.
+
+This is a suitable language specific value of
+`c-make-ml-string-closer-re-function' for most languages with
+multi-line strings (but not C++, for example)."
+ c-ml-string-any-closer-re)
+
+(defun c-ml-string-make-opener-re (_closer)
+ "Return c-ml-string-opener-re.
+
+This is a suitable language specific value of
+`c-make-ml-string-opener-re-function' for most languages with
+multi-line strings (but not C++, for example)."
+ c-ml-string-opener-re)
+
+(defun c-c++-make-ml-string-closer-re (opener)
+ "Construct a regexp for a C++ raw string closer matching OPENER."
+ (concat "\\()" (regexp-quote (substring opener 2 -1)) "\\(\"\\)\\)"))
+
+(defun c-c++-make-ml-string-opener-re (closer)
+ "Construct a regexp for a C++ raw string opener matching CLOSER."
+ (concat "\\(R\\(\"\\)" (regexp-quote (substring closer 1 -1)) "(\\)"))
+
+;; The positions of various components of mult-line strings surrounding BEG,
+;; END and (1- BEG) (of before-change-functions) as returned by
+;; `c-ml-string-delims-around-point'.
+(defvar c-old-beg-ml nil)
+(defvar c-old-1-beg-ml nil) ; only non-nil when `c-old-beg-ml' is nil.
+(defvar c-old-end-ml nil)
+;; The values of the function `c-position-wrt-ml-delims' at
+;; before-change-function's BEG and END.
+(defvar c-beg-pos nil)
+(defvar c-end-pos nil)
+;; Whether a buffer change has disrupted or will disrupt the terminator of an
+;; multi-line string.
+(defvar c-ml-string-end-delim-disrupted nil)
+
+(defun c-depropertize-ml-string-delims (string-delims)
+ ;; Remove any syntax-table text properties from the multi-line string
+ ;; delimiters specified by STRING-DELIMS, the output of
+ ;; `c-ml-string-delims-around-point'.
+ (let (found)
+ (if (setq found (c-clear-char-properties (caar string-delims)
+ (cadar string-delims)
+ 'syntax-table))
+ (c-truncate-lit-pos-cache found))
+ (when (cdr string-delims)
+ (if (setq found (c-clear-char-properties (cadr string-delims)
+ (caddr string-delims)
+ 'syntax-table))
+ (c-truncate-lit-pos-cache found)))))
+
+(defun c-get-ml-closer (open-delim)
+ ;; Return the closer, a three element dotted list of the closer's start, its
+ ;; end and the position of the double quote, matching the given multi-line
+ ;; string OPENER, also such a three element dotted list. Otherwise return
+ ;; nil. All pertinent syntax-table text properties must be in place.
+ (save-excursion
+ (goto-char (cadr open-delim))
+ (and (not (equal (c-get-char-property (1- (point)) 'syntax-table)
+ '(15)))
+ (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (car open-delim) (cadr open-delim)))
+ nil t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))))
+
+(defun c-ml-string-opener-around-point ()
+ ;; If point is inside an ml string opener, return a dotted list of the start
+ ;; and end of that opener, and the position of its double-quote. That list
+ ;; will not include any "context characters" before or after the opener. If
+ ;; an opener is found, the match-data will indicate it, with (match-string
+ ;; 1) being the entire delimiter, and (match-string 2) the "main" double
+ ;; quote. Otherwise the match-data is undefined.
+ (let ((here (point)) found)
+ (goto-char (max (- here (1- c-ml-string-max-opener-len)) (point-min)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp
+ c-ml-string-opener-re
+ (min (+ here (1- c-ml-string-max-opener-len)) (point-max))
+ 'bound))
+ (<= (match-end 1) here)))
+ (prog1
+ (and found
+ (< (match-beginning 1) here)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char here))))
+
+(defun c-ml-string-opener-intersects-region (&optional start finish)
+ ;; If any part of the region [START FINISH] is inside an ml-string opener,
+ ;; return a dotted list of the start, end and double-quote position of that
+ ;; opener. That list wlll not include any "context characters" before or
+ ;; after the opener. If an opener is found, the match-data will indicate
+ ;; it, with (match-string 1) being the entire delimiter, and (match-string
+ ;; 2) the "main" double-quote. Otherwise, the match-data is undefined.
+ ;; Both START and FINISH default to point. FINISH may not be at an earlier
+ ;; buffer position than START.
+ (let ((here (point)) found)
+ (or finish (setq finish (point)))
+ (or start (setq start (point)))
+ (goto-char (max (- start (1- c-ml-string-max-opener-len)) (point-min)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp
+ c-ml-string-opener-re
+ (min (+ finish (1- c-ml-string-max-opener-len)) (point-max))
+ 'bound))
+ (<= (match-end 1) start)))
+ (prog1
+ (and found
+ (< (match-beginning 1) finish)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char here))))
+
+(defun c-ml-string-opener-at-or-around-point (&optional position)
+ ;; If POSITION (default point) is at or inside an ml string opener, return a
+ ;; dotted list of the start and end of that opener, and the position of the
+ ;; double-quote in it. That list will not include any "context characters"
+ ;; before or after the opener.
+ (let ((here (point))
+ found)
+ (or position (setq position (point)))
+ (goto-char (max (- position (1- c-ml-string-max-opener-len)) (point-min)))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp
+ c-ml-string-opener-re
+ (min (+ position c-ml-string-max-opener-len) (point-max))
+ 'bound))
+ (<= (match-end 1) position)))
+ (prog1
+ (and found
+ (<= (match-beginning 1) position)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char here))))
+
+(defun c-ml-string-back-to-neutral (opening-point)
+ ;; Given OPENING-POINT, the position of the start of a multiline string
+ ;; opening delimiter, move point back to a neutral position within the ml
+ ;; string. It is assumed that point is within the innards of or the closing
+ ;; delimiter of string opened by OPEN-DELIM.
+ (let ((opener-end (save-excursion
+ (goto-char opening-point)
+ (looking-at c-ml-string-opener-re)
+ (match-end 1))))
+ (if (not c-ml-string-back-closer-re)
+ (goto-char (max (c-point 'boll) opener-end))
+ (re-search-backward c-ml-string-back-closer-re
+ (max opener-end
+ (c-point 'eopl))
+ 'bound))))
+
+(defun c-ml-string-in-end-delim (beg end open-delim)
+ ;; If the region (BEG END) intersects or touches a possible multiline string
+ ;; terminator, return a cons of the position of the start and end of the
+ ;; first such terminator. The syntax-table text properties must be in a
+ ;; consistent state when using this function. OPEN-DELIM is the three
+ ;; element dotted list of the start, end, and double quote position of the
+ ;; multiline string opener that BEG is in, or nil if it isn't in one.
+ (save-excursion
+ (goto-char beg)
+ (when open-delim
+ ;; If BEG is in an opener, move back to a position we know to be "safe".
+ (if (<= beg (cadr open-delim))
+ (goto-char (cadr open-delim))
+ (c-ml-string-back-to-neutral (car open-delim))))
+
+ (let (saved-match-data)
+ (or
+ ;; If we might be in the middle of "context" bytes at the start of a
+ ;; closer, move to after the closer.
+ (and c-ml-string-back-closer-re
+ (looking-at c-ml-string-any-closer-re)
+ (eq (c-in-literal) 'string)
+ (setq saved-match-data (match-data))
+ (goto-char (match-end 0)))
+
+ ;; Otherwise, move forward over closers while we haven't yet reached END,
+ ;; until we're after BEG.
+ (progn
+ (while
+ (let (found)
+ (while ; Go over a single real closer.
+ (and
+ (search-forward-regexp
+ c-ml-string-any-closer-re
+ (min (+ end c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ t)
+ (save-excursion
+ (goto-char (match-end 1))
+ (if (c-in-literal) ; a psuedo closer.
+ t
+ (setq saved-match-data (match-data))
+ (setq found t)
+ nil))))
+ (and found
+ (<= (point) beg))
+ ;; (not (save-excursion
+ ;; (goto-char (match-beginning 2))
+ ;; (c-literal-start)))
+ ))))
+ (set-match-data saved-match-data))
+
+ ;; Test whether we've found the sought closing delimiter.
+ (unless (or (null (match-data))
+ (and (not (eobp))
+ (<= (point) beg))
+ (> (match-beginning 0) beg)
+ (progn (goto-char (match-beginning 2))
+ (not (c-literal-start))))
+ (cons (match-beginning 1) (match-end 1)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun c-ml-string-delims-around-point ()
+ ;; Get POINT's relationship to any containing multi-line string or such a
+ ;; multi-line string which point is at the end of.
+ ;;
+ ;; If point isn't thus situated, return nil.
+ ;; Otherwise return the following cons:
+ ;;
+ ;; (OPENER . CLOSER)
+ ;;
+ ;; , where each of OPENER and CLOSER is a dotted list of the form
+ ;;
+ ;; (START-DELIM END-DELIM . QUOTE-POSITION)
+ ;;
+ ;; , the bounds of the delimiters and the buffer position of the ?" in the
+ ;; delimiter. If the ml-string is not validly terminated, CLOSER is instead
;; nil.
;;
;; Note: this function is dependent upon the correct syntax-table text
;; properties being set.
- (let ((state (c-semi-pp-to-literal (point)))
- open-quote-pos open-paren-pos close-paren-pos close-quote-pos id)
- (save-excursion
- (when
- (and
- (cond
- ((null (cadr state))
- (or (eq (char-after) ?\")
- (search-backward "\"" (max (- (point) 17) (point-min)) t)))
- ((and (eq (cadr state) 'string)
- (goto-char (nth 2 state))
- (cond
- ((eq (char-after) ?\"))
- ((eq (char-after) ?\()
- (let ((here (point)))
- (goto-char (max (- (point) 18) (point-min)))
- (while
- (and
- (search-forward-regexp
- c-c++-raw-string-opener-re
- (1+ here) 'limit)
- (< (point) here)))
- (and (eq (point) (1+ here))
- (match-beginning 1)
- (goto-char (1- (match-beginning 1)))))))
- (not (bobp)))))
- (c-at-c++-raw-string-opener))
- (setq open-quote-pos (point)
- open-paren-pos (match-end 1)
- id (match-string-no-properties 1))
- (goto-char (1+ open-paren-pos))
- (when (and (not (c-get-char-property open-paren-pos 'syntax-table))
- (search-forward (concat ")" id "\"") nil t))
- (setq close-paren-pos (match-beginning 0)
- close-quote-pos (1- (point))))))
- (and open-quote-pos
- (list
- (cond
- ((<= (point) open-paren-pos)
- 'open-delim)
- ((and close-paren-pos
- (> (point) close-paren-pos))
- 'close-delim)
- (t nil))
- open-quote-pos open-paren-pos close-paren-pos close-quote-pos))))
-
-(defun c-raw-string-in-end-delim (beg end)
- ;; If the region (BEG END) intersects a possible raw string terminator,
- ;; return a cons of the position of the ) and the position of the " in the
- ;; first one found.
- (save-excursion
- (goto-char (max (- beg 17) (point-min)))
- (while
- (and
- (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\""
- (min (+ end 17) (point-max)) t)
- (<= (point) beg)))
- (unless (or (<= (point) beg)
- (>= (match-beginning 0) end))
- (cons (match-beginning 0) (match-end 1)))))
-
-(defun c-depropertize-raw-string (id open-quote open-paren bound)
- ;; Point is immediately after a raw string opening delimiter. Remove any
- ;; `syntax-table' text properties associated with the delimiter (if it's
- ;; unmatched) or the raw string.
- ;;
- ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN
- ;; are the buffer positions of the delimiter's components. BOUND is the
- ;; bound for searching for a matching closing delimiter; it is usually nil,
- ;; but if we're inside a macro, it's the end of the macro (i.e. just before
- ;; the terminating \n).
- ;;
- ;; Point is moved to after the (terminated) raw string, or left after the
- ;; unmatched opening delimiter, as the case may be. The return value is of
- ;; no significance.
- (let ((open-paren-prop (c-get-char-property open-paren 'syntax-table))
- first)
- ;; If the delimiter is "unclosed", or sombody's used " in their id, clear
- ;; the 'syntax-table property from all of them.
- (setq first (c-clear-char-property-with-value-on-char
- open-quote open-paren 'syntax-table '(1) ?\"))
- (if first (c-truncate-lit-pos-cache first))
+ (let ((here (point))
+ (state (c-semi-pp-to-literal (point)))
+ open-dlist close-dlist ret found opener)
(cond
- ((null open-paren-prop)
- ;; Should be a terminated raw string...
- (when (search-forward (concat ")" id "\"") nil t)
- ;; Yes, it is. :-)
- ;; Clear any '(1)s from "s in the identifier.
- (setq first (c-clear-char-property-with-value-on-char
- (1+ (match-beginning 0)) (1- (match-end 0))
- 'syntax-table '(1) ?\"))
- (if first (c-truncate-lit-pos-cache first))
- ;; Clear any random `syntax-table' text properties from the contents.
- (let* ((closing-paren (match-beginning 0))
- (first-st
- (and
- (< (1+ open-paren) closing-paren)
- (or
- (and (c-get-char-property (1+ open-paren) 'syntax-table)
- (1+ open-paren))
- (and
- (setq first
- (c-next-single-property-change
- (1+ open-paren) 'syntax-table nil closing-paren))
- (< first closing-paren)
- first)))))
- (when first-st
- (c-clear-char-properties first-st (match-beginning 0)
- 'syntax-table)
- (c-truncate-lit-pos-cache first-st))
- (when (c-get-char-property (1- (match-end 0)) 'syntax-table)
- ;; Was previously an unterminated (ordinary) string
- (save-excursion
- (goto-char (1- (match-end 0)))
- (when (c-safe (c-forward-sexp)) ; to '(1) at EOL.
- (c-clear-char-property (1- (point)) 'syntax-table))
- (c-clear-char-property (1- (match-end 0)) 'syntax-table)
- (c-truncate-lit-pos-cache (1- (match-end 0))))))))
- ((or (and (equal open-paren-prop '(15)) (null bound))
- (equal open-paren-prop '(1)))
- ;; An unterminated raw string either not in a macro, or in a macro with
- ;; the open parenthesis right up against the end of macro
- (c-clear-char-property open-quote 'syntax-table)
- (c-truncate-lit-pos-cache open-quote)
- (c-clear-char-property open-paren 'syntax-table))
- (t
- ;; An unterminated string in a macro, with at least one char after the
- ;; open paren
- (c-clear-char-property open-quote 'syntax-table)
- (c-truncate-lit-pos-cache open-quote)
- (c-clear-char-property open-paren 'syntax-table)
- (c-clear-char-property-with-value (1+ open-paren) bound 'syntax-table
- '(15))))))
-
-(defun c-depropertize-raw-strings-in-region (start finish)
- ;; Remove any `syntax-table' text properties associated with C++ raw strings
- ;; contained in the region (START FINISH). Point is undefined at entry and
- ;; exit, and the return value has no significance.
- (goto-char start)
- (while (and (< (point) finish)
- (re-search-forward
- (concat "\\(" ; 1
- c-anchored-cpp-prefix ; 2
- "\\)\\|\\(" ; 3
- c-c++-raw-string-opener-re ; 4
- "\\)")
- finish t))
- (when (save-excursion
- (goto-char (match-beginning 0)) (not (c-in-literal)))
- (if (match-beginning 4) ; the id
- ;; We've found a raw string
- (c-depropertize-raw-string
- (match-string-no-properties 4) ; id
- (1+ (match-beginning 3)) ; open quote
- (match-end 4) ; open paren
- nil) ; bound
- ;; We've found a CPP construct. Search for raw strings within it.
- (goto-char (match-beginning 2)) ; the "#"
- (c-end-of-macro)
- (let ((eom (point)))
- (goto-char (match-end 2)) ; after the "#".
- (while (and (< (point) eom)
- (c-syntactic-re-search-forward
- c-c++-raw-string-opener-re eom t))
- (c-depropertize-raw-string
- (match-string-no-properties 1) ; id
- (1+ (match-beginning 0)) ; open quote
- (match-end 1) ; open paren
- eom))))))) ; bound.
-
-(defun c-before-change-check-raw-strings (beg end)
- ;; This function clears `syntax-table' text properties from C++ raw strings
- ;; whose delimiters are about to change in the region (c-new-BEG c-new-END).
- ;; BEG and END are the standard arguments supplied to any before-change
- ;; function.
+ ((or
+ ;; Is HERE between the start of an opener and the "?
+ (and (null (cadr state))
+ (progn
+ ;; Search for the start of the opener.
+ (goto-char (max (- (point) (1- c-ml-string-max-opener-len))
+ (point-min)))
+ (setq found nil)
+ ;; In the next loop, skip over any complete ml strings, or an ml
+ ;; string opener which is in a macro not containing HERE, or an
+ ;; apparent "opener" which is in a comment or string.
+ (while
+ (and (re-search-forward c-ml-string-opener-re
+ (+ here (1- c-ml-string-max-opener-len))
+ t)
+ (< (match-beginning 1) here)
+ (or
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (or (c-in-literal)
+ (and (c-beginning-of-macro)
+ (< (progn (c-end-of-macro) (point))
+ here))))
+ (and
+ (setq found (match-beginning 1))
+ (<= (point) here)
+ (save-match-data
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ here t))
+ (<= (point) here))))
+ (setq found nil))
+ found))
+ ;; Is HERE after the "?
+ (and (eq (cadr state) 'string)
+ (goto-char (nth 2 state))
+ (c-ml-string-opener-at-or-around-point)))
+ (setq open-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char (cadr open-dlist))
+ (setq ret
+ (cons open-dlist
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))
+ nil)))
+ (goto-char here)
+ ret)
+ ;; Is HERE between the " and the end of the closer?
+ ((and (null (cadr state))
+ (progn
+ (if (null c-ml-string-back-closer-re)
+ (goto-char (max (- here (1- c-ml-string-max-closer-len))
+ (point-min)))
+ (goto-char here)
+ (re-search-backward c-ml-string-back-closer-re nil t))
+ (re-search-forward c-ml-string-any-closer-re
+ (+ here -1 c-ml-string-max-closer-len-no-leader)
+ t))
+ (>= (match-end 1) here)
+ (<= (match-end 2) here)
+ (setq close-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (goto-char (car close-dlist))
+ (setq state (c-semi-pp-to-literal (point)))
+ (eq (cadr state) 'string)
+ (goto-char (nth 2 state))
+ (setq opener (c-ml-string-opener-around-point))
+ (goto-char (cadr opener))
+ (setq open-dlist (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2))))
+ (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t))
+ (goto-char here)
+ (cons open-dlist close-dlist))
+
+ (t (goto-char here)
+ nil))))
+
+(defun c-position-wrt-ml-delims (ml-string-delims)
+ ;; Given ML-STRING-DELIMS, a structure produced by
+ ;; `c-ml-string-delims-around-point' called at point, return one of the
+ ;; following indicating where POINT is with respect to the multi-line
+ ;; string:
+ ;; o - nil; not in the string.
+ ;; o - open-delim: in the open-delimiter.
+ ;; o - close-delim: in the close-delimiter.
+ ;; o - after-close: just after the close-delimiter
+ ;; o - string: inside the delimited string.
+ (cond
+ ((null ml-string-delims)
+ nil)
+ ((< (point) (cadar ml-string-delims))
+ 'open-delim)
+ ((or (null (cdr ml-string-delims))
+ (<= (point) (cadr ml-string-delims)))
+ 'string)
+ ((eq (point) (caddr ml-string-delims))
+ 'after-close)
+ (t 'close-delim)))
+
+(defun c-before-change-check-ml-strings (beg end)
+ ;; This function clears `syntax-table' text properties from multi-line
+ ;; strings whose delimiters are about to change in the region (c-new-BEG
+ ;; c-new-END). BEG and END are the standard arguments supplied to any
+ ;; before-change function.
;;
;; Point is undefined on both entry and exit, and the return value has no
;; significance.
;;
;; This function is called as a before-change function solely due to its
- ;; membership of the C++ value of `c-get-state-before-change-functions'.
+ ;; membership of mode-specific value of
+ ;; `c-get-state-before-change-functions'.
(goto-char end)
- (setq c-raw-string-end-delim-disrupted nil)
+ (setq c-ml-string-end-delim-disrupted nil)
;; We use the following to detect a R"<id>( being swallowed into a string by
;; the pending change.
(setq c-old-END-literality (c-in-literal))
+ (goto-char beg)
+ (setq c-old-beg-ml (c-ml-string-delims-around-point))
+ (setq c-beg-pos (c-position-wrt-ml-delims c-old-beg-ml))
+ (setq c-old-1-beg-ml
+ (and (not (or c-old-beg-ml (bobp)))
+ (goto-char (1- beg))
+ (c-ml-string-delims-around-point)))
+ (goto-char end)
+ (setq c-old-end-ml
+ (if (or (eq end beg)
+ (and c-old-beg-ml
+ (>= end (caar c-old-beg-ml))
+ (or (null (cdr c-old-beg-ml))
+ (< end (caddr c-old-beg-ml)))))
+ c-old-beg-ml
+ (c-ml-string-delims-around-point)))
+ (setq c-end-pos (c-position-wrt-ml-delims c-old-end-ml))
+
(c-save-buffer-state
- ((term-del (c-raw-string-in-end-delim beg end))
+ ((term-del (c-ml-string-in-end-delim beg end (car c-old-beg-ml)))
Rquote close-quote)
- (setq c-old-beg-rs (progn (goto-char beg) (c-raw-string-pos))
- c-old-end-rs (progn (goto-char end) (c-raw-string-pos)))
(cond
- ;; We're not changing, or we're obliterating raw strings.
- ((and (null c-old-beg-rs) (null c-old-end-rs)))
- ;; We're changing the putative terminating delimiter of a raw string
+ ;; We're not changing, or we're obliterating ml strings.
+ ((and (null c-beg-pos) (null c-end-pos)))
+ ;; We're changing the putative terminating delimiter of an ml string
;; containing BEG.
- ((and c-old-beg-rs term-del
- (or (null (nth 3 c-old-beg-rs))
- (<= (car term-del) (nth 3 c-old-beg-rs))))
- (setq Rquote (1- (cadr c-old-beg-rs))
- close-quote (1+ (cdr term-del)))
- (setq c-raw-string-end-delim-disrupted t)
- (c-depropertize-raw-strings-in-region Rquote close-quote)
+ ((and c-beg-pos term-del
+ (or (null (cdr c-old-beg-ml))
+ (<= (car term-del) (cadr c-old-beg-ml))))
+ (setq Rquote (caar c-old-beg-ml)
+ close-quote (cdr term-del))
+ (setq c-ml-string-end-delim-disrupted t)
+ (c-depropertize-ml-strings-in-region Rquote close-quote)
(setq c-new-BEG (min c-new-BEG Rquote)
c-new-END (max c-new-END close-quote)))
;; We're breaking an escaped NL in a raw string in a macro.
- ((and c-old-end-rs
+ ((and c-old-end-ml
(< beg end)
(goto-char end) (eq (char-before) ?\\)
(c-beginning-of-macro))
(let ((bom (point))
(eom (progn (c-end-of-macro) (point))))
- (c-depropertize-raw-strings-in-region bom eom)
+ (c-depropertize-ml-strings-in-region bom eom)
(setq c-new-BEG (min c-new-BEG bom)
c-new-END (max c-new-END eom))))
;; We're changing only the contents of a raw string.
- ((and (equal (cdr c-old-beg-rs) (cdr c-old-end-rs))
- (null (car c-old-beg-rs)) (null (car c-old-end-rs))))
+ ;; Any critical deletion of "s will be handled in
+ ;; `c-after-change-unmark-ml-strings'.
+ ((and (equal c-old-beg-ml c-old-end-ml)
+ (eq c-beg-pos 'string) (eq c-end-pos 'string)))
((or
;; We're removing (at least part of) the R" of the starting delim of a
;; raw string:
- (null c-old-beg-rs)
- (and (eq beg (cadr c-old-beg-rs))
+ (null c-old-beg-ml)
+ (and (eq beg (caar c-old-beg-ml))
(< beg end))
;; Or we're removing the ( of the starting delim of a raw string.
- (and (eq (car c-old-beg-rs) 'open-delim)
- (or (null c-old-end-rs)
- (not (eq (car c-old-end-rs) 'open-delim))
- (not (equal (cdr c-old-beg-rs) (cdr c-old-end-rs))))))
- (let ((close (nth 4 (or c-old-end-rs c-old-beg-rs))))
- (setq Rquote (1- (cadr (or c-old-end-rs c-old-beg-rs)))
- close-quote (if close (1+ close) (point-max))))
- (c-depropertize-raw-strings-in-region Rquote close-quote)
+ (and (eq c-beg-pos 'open-delim)
+ (or (null c-old-end-ml)
+ (not (eq c-end-pos 'open-delim))
+ (not (equal c-old-beg-ml c-old-end-ml))))
+ ;; Or we're disrupting a starting delim by typing into it, or removing
+ ;; characters from it.
+ (and (eq c-beg-pos 'open-delim)
+ (eq c-end-pos 'open-delim)
+ (equal c-old-beg-ml c-old-end-ml)))
+ (let ((close (caddr (or c-old-end-ml c-old-beg-ml))))
+ (setq Rquote (caar (or c-old-end-ml c-old-beg-ml))
+ close-quote (or close (point-max))))
+ (c-depropertize-ml-strings-in-region Rquote close-quote)
(setq c-new-BEG (min c-new-BEG Rquote)
- c-new-END (max c-new-END close-quote)))
- ;; We're changing only the text of the identifier of the opening
- ;; delimiter of a raw string.
- ((and (eq (car c-old-beg-rs) 'open-delim)
- (equal c-old-beg-rs c-old-end-rs))))))
-
-(defun c-propertize-raw-string-id (start end)
- ;; If the raw string identifier between buffer positions START and END
- ;; contains any double quote characters, put a punctuation syntax-table text
- ;; property on them. The return value is of no significance.
- (save-excursion
- (goto-char start)
- (while (and (skip-chars-forward "^\"" end)
- (< (point) end))
- (c-put-char-property (point) 'syntax-table '(1))
- (c-truncate-lit-pos-cache (point))
- (forward-char))))
+ c-new-END (max c-new-END close-quote))))))
-(defun c-propertize-raw-string-opener (id open-quote open-paren bound)
- ;; Point is immediately after a raw string opening delimiter. Apply any
- ;; pertinent `syntax-table' text properties to the delimiter and also the
- ;; raw string, should there be a valid matching closing delimiter.
- ;;
- ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN
- ;; are the buffer positions of the delimiter's components. BOUND is the
- ;; bound for searching for a matching closing delimiter; it is usually nil,
- ;; but if we're inside a macro, it's the end of the macro (i.e. the position
- ;; of the closing newline).
- ;;
- ;; Point is moved to after the (terminated) raw string and t is returned, or
- ;; it is left after the unmatched opening delimiter and nil is returned.
- (c-propertize-raw-string-id (1+ open-quote) open-paren)
- (prog1
- (if (search-forward (concat ")" id "\"") bound t)
- (let ((end-string (match-beginning 0))
- (after-quote (match-end 0)))
- (c-propertize-raw-string-id
- (1+ (match-beginning 0)) (1- (match-end 0)))
- (goto-char open-paren)
- (while (progn (skip-syntax-forward "^\"" end-string)
- (< (point) end-string))
- (c-put-char-property (point) 'syntax-table '(1)) ; punctuation
- (c-truncate-lit-pos-cache (point))
- (forward-char))
- (goto-char after-quote)
- t)
- (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation
- (c-truncate-lit-pos-cache open-quote)
- (c-put-char-property open-paren 'syntax-table '(15)) ; generic string
- (when bound
- ;; In a CPP construct, we try to apply a generic-string
- ;; `syntax-table' text property to the last possible character in
- ;; the string, so that only characters within the macro get
- ;; "stringed out".
- (goto-char bound)
- (if (save-restriction
- (narrow-to-region (1+ open-paren) (point-max))
- (re-search-backward
- (eval-when-compile
- ;; This regular expression matches either an escape pair
- ;; (which isn't an escaped NL) (submatch 5) or a
- ;; non-escaped character (which isn't itself a backslash)
- ;; (submatch 10). The long preambles to these
- ;; (respectively submatches 2-4 and 6-9) ensure that we
- ;; have the correct parity for sequences of backslashes,
- ;; etc..
- (concat "\\(" ; 1
- "\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ; 2-4
- "\\(\\\\.\\)" ; 5
- "\\|"
- "\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9
- "\\([^\\]\\)" ; 10
- "\\)"
- "\\(\\\\\n\\)*\\=")) ; 11
- (1+ open-paren) t))
- (if (match-beginning 10)
- (progn
- (c-put-char-property (match-beginning 10) 'syntax-table '(15))
- (c-truncate-lit-pos-cache (match-beginning 10)))
- (c-put-char-property (match-beginning 5) 'syntax-table '(1))
- (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15))
- (c-truncate-lit-pos-cache (1+ (match-beginning 5))))
- ;; (c-put-char-property open-paren 'syntax-table '(1))
- )
- (goto-char bound))
- nil)))
-
-(defun c-after-change-unmark-raw-strings (beg end _old-len)
- ;; This function removes `syntax-table' text properties from any raw strings
+(defun c-after-change-unmark-ml-strings (beg end old-len)
+ ;; This function removes `syntax-table' text properties from any ml strings
;; which have been affected by the current change. These are those which
- ;; have been "stringed out" and from newly formed raw strings, or any
- ;; existing raw string which the new text terminates. BEG, END, and
- ;; _OLD-LEN are the standard arguments supplied to any
+ ;; have been "stringed out" and from newly formed ml strings, or any
+ ;; existing ml string which the new text terminates. BEG, END, and
+ ;; OLD-LEN are the standard arguments supplied to any
;; after-change-function.
;;
;; Point is undefined on both entry and exit, and the return value has no
;; significance.
;;
;; This functions is called as an after-change function by virtue of its
- ;; membership of the C++ value of `c-before-font-lock-functions'.
+ ;; membership of the mode's value of `c-before-font-lock-functions'.
;; (when (< beg end)
- (c-save-buffer-state (found eoll state id found-beg)
- ;; Has an inserted " swallowed up a R"(, turning it into "...R"(?
+ ;;
+ ;; Maintainers' note: Be careful with the use of `c-old-beg-ml' and
+ ;; `c-old-end-ml'; since text has been inserted or removed, most of the
+ ;; components in these variables will no longer be valid. (caar
+ ;; c-old-beg-ml) is normally OK, (cadar c-old-beg-ml) often is, any others
+ ;; will need adjstments.
+ (c-save-buffer-state (found eoll state opener)
+ ;; Has an inserted " swallowed up a R"(, turning it into "...R"(?
+ (goto-char end)
+ (setq eoll (c-point 'eoll))
+ (when (and (null c-old-END-literality)
+ (search-forward-regexp c-ml-string-opener-re eoll t))
+ (setq state (c-semi-pp-to-literal end))
+ (when (eq (cadr state) 'string)
+ (unwind-protect
+ ;; Temporarily insert a closing string delimiter....
+ (progn
+ (goto-char end)
+ (cond
+ ((c-characterp (nth 3 (car state)))
+ (insert (nth 3 (car state))))
+ ((eq (nth 3 (car state)) t)
+ (insert ?\")
+ (c-put-char-property end 'syntax-table '(15))))
+ (c-truncate-lit-pos-cache end)
+ ;; ....ensure c-new-END extends right to the end of the about
+ ;; to be un-stringed raw string....
+ (save-excursion
+ (goto-char (1+ (match-end 1))) ; Count inserted " too.
+ (setq c-new-END
+ (max c-new-END
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t)
+ (1- (match-end 1)) ; 1- For the inserted ".
+ eoll))))
+
+ ;; ...and clear `syntax-table' text propertes from the
+ ;; following raw strings.
+ (c-depropertize-ml-strings-in-region (point) (1+ eoll)))
+ ;; Remove the temporary string delimiter.
+ (goto-char end)
+ (delete-char 1)
+ (c-truncate-lit-pos-cache end))))
+
+ ;; Have we just created a new starting id?
+ (goto-char beg)
+ (setq opener
+ (if (eq beg end)
+ (c-ml-string-opener-at-or-around-point end)
+ (c-ml-string-opener-intersects-region beg end)))
+ (when
+ (and opener (<= (car opener) end)
+ (setq state (c-semi-pp-to-literal (car opener)))
+ (not (cadr state)))
+ (setq c-new-BEG (min c-new-BEG (car opener)))
+ (goto-char (cadr opener))
+ (when (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (car opener) (cadr opener)))
+ nil t) ; No bound
+ (setq c-new-END (max c-new-END (match-end 1))))
+ (goto-char c-new-BEG)
+ (while (c-search-forward-char-property-with-value-on-char
+ 'syntax-table '(15) ?\" c-new-END)
+ (c-remove-string-fences (1- (point))))
+ (c-depropertize-ml-strings-in-region c-new-BEG c-new-END))
+
+ ;; Have we matched up with an existing terminator by typing into or
+ ;; deleting from an opening delimiter? ... or by messing up a raw string's
+ ;; terminator so that it now matches a later terminator?
+ (when
+ (cond
+ ((or c-ml-string-end-delim-disrupted
+ (and c-old-beg-ml
+ (eq c-beg-pos 'open-delim)))
+ (goto-char (caar c-old-beg-ml)))
+ ((and (< beg end)
+ (not c-old-beg-ml)
+ c-old-1-beg-ml
+ (save-excursion
+ (goto-char (1- beg))
+ (c-ml-string-back-to-neutral (caar c-old-1-beg-ml))
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (caar c-old-1-beg-ml)
+ (cadar c-old-1-beg-ml)))
+ nil 'bound)
+ (> (point) beg)))
+ (goto-char (caar c-old-1-beg-ml))
+ (setq c-new-BEG (min c-new-BEG (point)))
+ (c-truncate-lit-pos-cache (point))))
+
+ (when (looking-at c-ml-string-opener-re)
+ (goto-char (match-end 1))
+ (when (re-search-forward (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ nil t) ; No bound
+ ;; If what is to be the new delimiter was previously an unterminated
+ ;; ordinary string, clear the c-fl-syn-tab properties from this old
+ ;; string.
+ (when (c-get-char-property (match-beginning 2) 'c-fl-syn-tab)
+ (c-remove-string-fences (match-beginning 2)))
+ (setq c-new-END (point-max))
+ (c-clear-char-properties (caar (or c-old-beg-ml c-old-1-beg-ml))
+ c-new-END
+ 'syntax-table)
+ (c-truncate-lit-pos-cache
+ (caar (or c-old-beg-ml c-old-1-beg-ml))))))
+
+ ;; Have we disturbed the innards of an ml string, possibly by deleting "s?
+ (when (and
+ c-old-beg-ml
+ (eq c-beg-pos 'string)
+ (eq beg end))
+ (goto-char beg)
+ (c-ml-string-back-to-neutral (caar c-old-beg-ml))
+ (let ((bound (if (cdr c-old-end-ml)
+ (min (+ (- (caddr c-old-end-ml) old-len)
+ c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ (point-max)))
+ (new-END-end-ml-string
+ (if (cdr c-old-end-ml)
+ (- (caddr c-old-end-ml) old-len)
+ (point-max))))
+ (when (and
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (caar c-old-beg-ml) (cadar c-old-beg-ml)))
+ bound 'bound)
+ (< (match-end 1) new-END-end-ml-string))
+ (setq c-new-END (max new-END-end-ml-string c-new-END))
+ (c-clear-char-properties (caar c-old-beg-ml) c-new-END
+ 'syntax-table)
+ (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG))
+ (c-truncate-lit-pos-cache (caar c-old-beg-ml)))))
+
+ ;; Have we terminated an existing raw string by inserting or removing
+ ;; text?
+ (when
+ (and
+ (< beg end)
+ (eq c-old-END-literality 'string)
+ c-old-beg-ml)
+ ;; Have we just made or modified a closing delimiter?
(goto-char end)
- (setq eoll (c-point 'eoll))
- (when (and (null c-old-END-literality)
- (search-forward-regexp c-c++-raw-string-opener-re eoll t))
- (setq state (c-semi-pp-to-literal end))
- (when (eq (cadr state) 'string)
- (unwind-protect
- ;; Temporarily insert a closing string delimiter....
- (progn
- (goto-char end)
- (cond
- ((c-characterp (nth 3 (car state)))
- (insert (nth 3 (car state))))
- ((eq (nth 3 (car state)) t)
- (insert ?\")
- (c-put-char-property end 'syntax-table '(15))))
- (c-truncate-lit-pos-cache end)
- ;; ....ensure c-new-END extends right to the end of the about
- ;; to be un-stringed raw string....
- (save-excursion
- (goto-char (match-beginning 1))
- (let ((end-bs (c-raw-string-pos)))
- (setq c-new-END
- (max c-new-END
- (if (nth 4 end-bs)
- (1+ (nth 4 end-bs))
- eoll)))))
-
- ;; ...and clear `syntax-table' text propertes from the
- ;; following raw strings.
- (c-depropertize-raw-strings-in-region (point) (1+ eoll)))
- ;; Remove the temporary string delimiter.
- (goto-char end)
- (delete-char 1))))
-
- ;; Have we just created a new starting id?
- (goto-char (max (- beg 18) (point-min)))
+ (c-ml-string-back-to-neutral (caar c-old-beg-ml))
(while
(and
(setq found
- (search-forward-regexp c-c++-raw-string-opener-re
- c-new-END 'bound))
- (<= (match-end 0) beg)))
+ (search-forward-regexp
+ c-ml-string-any-closer-re
+ (+ (c-point 'eol end)
+ (1- c-ml-string-max-closer-len-no-leader))
+ t))
+ (< (match-end 1) beg))
+ (goto-char (match-end 1)))
(when (and found (<= (match-beginning 0) end))
- (setq c-new-BEG (min c-new-BEG (match-beginning 0)))
- (c-depropertize-raw-strings-in-region c-new-BEG c-new-END))
-
- ;; Have we invalidated an opening delimiter by typing into it?
- (when (and c-old-beg-rs
- (eq (car c-old-beg-rs) 'open-delim)
- (equal (c-get-char-property (cadr c-old-beg-rs)
- 'syntax-table)
- '(1)))
- (goto-char (1- (cadr c-old-beg-rs)))
- (unless (looking-at c-c++-raw-string-opener-re)
- (c-clear-char-property (1+ (point)) 'syntax-table)
- (c-truncate-lit-pos-cache (1+ (point)))
- (if (c-search-forward-char-property 'syntax-table '(15)
- (c-point 'eol))
- (c-clear-char-property (1- (point)) 'syntax-table))))
-
- ;; Have we matched up with an existing terminator by typing into an
- ;; opening delimiter? ... or by messing up a raw string's terminator so
- ;; that it now matches a later terminator?
- (when
- (or c-raw-string-end-delim-disrupted
- (and c-old-beg-rs
- (eq (car c-old-beg-rs) 'open-delim)))
- (goto-char (cadr c-old-beg-rs))
- (when (looking-at c-c++-raw-string-opener-1-re)
- (setq id (match-string-no-properties 1))
- (when (search-forward (concat ")" id "\"") nil t) ; No bound.
- (setq c-new-END (point-max))
- (c-clear-char-properties (cadr c-old-beg-rs) c-new-END
- 'syntax-table)
- (c-truncate-lit-pos-cache (cadr c-old-beg-rs)))))
- ;; Have we terminated an existing raw string by inserting or removing
- ;; text?
- (when (eq c-old-END-literality 'string)
- ;; Have we just made or modified a closing delimiter?
- (goto-char (max (- beg 18) (point-min)))
- (while
- (and
- (setq found
- (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\""
- (+ end 17) t))
- (< (match-end 0) beg)))
- (when (and found (<= (match-beginning 0) end))
- (setq id (match-string-no-properties 1))
- (goto-char (match-beginning 0))
+ (let ((opener-re (funcall c-make-ml-string-opener-re-function
+ (match-string 1))))
(while
(and
- (setq found (search-backward (concat "R\"" id "(") nil t))
+ (setq found (re-search-backward opener-re nil t))
(setq state (c-semi-pp-to-literal (point)))
- (memq (nth 3 (car state)) '(t ?\"))))
- (when found
- (setq c-new-BEG (min (point) c-new-BEG)
- c-new-END (point-max))
- (c-clear-syn-tab-properties (point) c-new-END)
- (c-truncate-lit-pos-cache (point)))))
-
- ;; Are there any raw strings in a newly created macro?
- (when (< beg end)
- (goto-char beg)
- (setq found-beg (point))
- (when (search-forward-regexp c-anchored-cpp-prefix end t)
+ (memq (nth 3 (car state)) '(t ?\")))))
+ (when found
+ (setq c-new-BEG (min (point) c-new-BEG)
+ c-new-END (point-max))
+ (c-clear-syn-tab-properties (point) c-new-END)
+ (c-truncate-lit-pos-cache (point)))))
+
+ ;; Are there any raw strings in a newly created macro?
+ (goto-char (c-point 'bol beg))
+ (while (and (< (point) (c-point 'eol end))
+ (re-search-forward c-anchored-cpp-prefix (c-point 'eol end)
+ 'boundt))
+ (when (and (<= beg (match-end 1))
+ (>= end (match-beginning 1)))
+ (goto-char (match-beginning 1))
(c-end-of-macro)
- (c-depropertize-raw-strings-in-region found-beg (point))))))
+ (c-depropertize-ml-strings-in-region
+ (match-beginning 1) (point))))))
-(defun c-maybe-re-mark-raw-string ()
+(defun c-maybe-re-mark-ml-string ()
;; When this function is called, point is immediately after a " which opens
- ;; a string. If this " is the characteristic " of a raw string
- ;; opener, apply the pertinent `syntax-table' text properties to the
- ;; entire raw string (when properly terminated) or just the delimiter
- ;; (otherwise). In either of these cases, return t, otherwise return nil.
- ;;
- (let (in-macro macro-end)
+ ;; a string. If this " is the characteristic " of a multi-line string
+ ;; opener, apply the pertinent `syntax-table' text properties to the entire
+ ;; ml string (when properly terminated) or just the delimiter (otherwise).
+ ;; In either of these cases, return t, otherwise return nil. Point is moved
+ ;; to after the terminated raw string, or to the end of the containing
+ ;; macro, or to point-max.
+ ;;
+ (let (delim in-macro macro-end)
(when
(and
- (eq (char-before (1- (point))) ?R)
- (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)("))
+ (setq delim (c-ml-string-opener-at-or-around-point (1- (point))))
+ (save-excursion
+ (goto-char (car delim))
+ (not (c-in-literal))))
(save-excursion
(setq in-macro (c-beginning-of-macro))
(setq macro-end (when in-macro
(c-end-of-macro)
- (point) ;; (min (1+ (point)) (point-max))
+ (point)
)))
(when
(not
- (c-propertize-raw-string-opener
- (match-string-no-properties 1) ; id
- (1- (point)) ; open quote
- (match-end 1) ; open paren
- macro-end)) ; bound (end of macro) or nil.
+ (c-propertize-ml-string-opener
+ delim
+ macro-end)) ; bound (end of macro) or nil.
(goto-char (or macro-end (point-max))))
t)))
+(defun c-propertize-ml-string-id (delim)
+ ;; Apply punctuation ('(1)) syntax-table text properties to the opening or
+ ;; closing delimiter given by the three element dotted list DELIM, such that
+ ;; its "total syntactic effect" is that of a single ".
+ (save-excursion
+ (goto-char (car delim))
+ (while (and (skip-chars-forward c-ml-string-non-punc-skip-chars
+ (cadr delim))
+ (< (point) (cadr delim)))
+ (when (not (eq (point) (cddr delim)))
+ (c-put-char-property (point) 'syntax-table '(1))
+ (c-truncate-lit-pos-cache (point)))
+ (forward-char))))
+
+(defun c-propertize-ml-string-opener (delim bound)
+ ;; DELIM defines the opening delimiter of a multi-line string in the
+ ;; way returned by `c-ml-string-opener-around-point'. Apply any
+ ;; pertinent `syntax-table' text properties to this opening delimiter and in
+ ;; the case of a terminated ml string, also to the innards of the string and
+ ;; the terminating delimiter.
+ ;;
+ ;; BOUND is the end of the macro we're inside (i.e. the position of the
+ ;; closing newline), if any, otherwise nil.
+ ;;
+ ;; Point is undefined at the function start. For a terminated ml string,
+ ;; point is left after the terminating delimiter and t is returned. For an
+ ;; unterminated string, point is left at the end of the macro, if any, or
+ ;; after the unmatched opening delimiter, and nil is returned.
+ (c-propertize-ml-string-id delim)
+ (goto-char (cadr delim))
+ (if (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (buffer-substring-no-properties
+ (car delim) (cadr delim)))
+ bound t)
+
+ (let ((end-delim
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))))
+ (c-propertize-ml-string-id end-delim)
+ (goto-char (cadr delim))
+ (while (progn (skip-syntax-forward c-ml-string-non-punc-skip-chars
+ (car end-delim))
+ (< (point) (car end-delim)))
+ (c-put-char-property (point) 'syntax-table '(1)) ; punctuation
+ (c-truncate-lit-pos-cache (point))
+ (forward-char))
+ (goto-char (cadr end-delim))
+ t)
+ (c-put-char-property (cddr delim) 'syntax-table '(1))
+ (c-put-char-property (1- (cadr delim)) 'syntax-table '(15))
+ (c-truncate-lit-pos-cache (1- (cddr delim)))
+ (when bound
+ ;; In a CPP construct, we try to apply a generic-string
+ ;; `syntax-table' text property to the last possible character in
+ ;; the string, so that only characters within the macro get
+ ;; "stringed out".
+ (goto-char bound)
+ (if (save-restriction
+ (narrow-to-region (cadr delim) (point-max))
+ (re-search-backward
+ (eval-when-compile
+ ;; This regular expression matches either an escape pair
+ ;; (which isn't an escaped NL) (submatch 5) or a
+ ;; non-escaped character (which isn't itself a backslash)
+ ;; (submatch 10). The long preambles to these
+ ;; (respectively submatches 2-4 and 6-9) ensure that we
+ ;; have the correct parity for sequences of backslashes,
+ ;; etc..
+ (concat "\\(" ; 1
+ "\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ; 2-4
+ "\\(\\\\.\\)" ; 5
+ "\\|"
+ "\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9
+ "\\([^\\]\\)" ; 10
+ "\\)"
+ "\\(\\\\\n\\)*\\=")) ; 11
+ (cadr delim) t))
+ (if (match-beginning 10)
+ (progn
+ (c-put-char-property (match-beginning 10) 'syntax-table '(15))
+ (c-truncate-lit-pos-cache (match-beginning 10)))
+ (c-put-char-property (match-beginning 5) 'syntax-table '(1))
+ (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15))
+ (c-truncate-lit-pos-cache (match-beginning 5))))
+ (goto-char bound))
+ nil))
+
+(defvar c-neutralize-pos nil)
+ ;; Buffer position of character neutralized by punctuation syntax-table
+ ;; text property ('(1)), or nil if there's no such character.
+(defvar c-neutralized-prop nil)
+ ;; syntax-table text property that was on the character at
+ ;; `c-neutralize-pos' before it was replaced with '(1), or nil if none.
+
+(defun c-depropertize-ml-string (string-delims bound)
+ ;; Remove any `syntax-table' text properties associated with the opening
+ ;; delimiter of a multi-line string (if it's unmatched) or with the entire
+ ;; string. Exception: A single punctuation ('(1)) property will be left on
+ ;; a string character to make the entire set of multi-line strings
+ ;; syntactically neutral. This is done using the global variable
+ ;; `c-neutralize-pos', the position of this property (or nil if there is
+ ;; none).
+ ;;
+ ;; STRING-DELIMS, of the form of the output from
+ ;; `c-ml-string-delims-around-point' defines the current ml string. BOUND
+ ;; is the bound for searching for a matching closing delimiter; it is
+ ;; usually nil, but if we're inside a macro, it's the end of the macro
+ ;; (i.e. just before the terminating \n).
+ ;;
+ ;; Point is undefined on input, and is moved to after the (terminated) raw
+ ;; string, or left after the unmatched opening delimiter, as the case may
+ ;; be. The return value is of no significance.
+
+ ;; Handle the special case of a closing " previously having been an
+ ;; unterminated ordinary string.
+ (when
+ (and
+ (cdr string-delims)
+ (equal (c-get-char-property (cdddr string-delims) ; pos of closing ".
+ 'syntax-table)
+ '(15)))
+ (goto-char (cdddr string-delims))
+ (when (c-safe (c-forward-sexp)) ; To '(15) at EOL.
+ (c-clear-char-property (1- (point)) 'syntax-table)
+ (c-truncate-lit-pos-cache (1- (point)))))
+ ;; The '(15) in the closing delimiter will be cleared by the following.
+
+ (c-depropertize-ml-string-delims string-delims)
+ (let ((bound1 (if (cdr string-delims)
+ (caddr string-delims) ; end of closing delimiter.
+ bound))
+ first s)
+ (if (and
+ bound1
+ (setq first (c-clear-char-properties (cadar string-delims) bound1
+ 'syntax-table)))
+ (c-truncate-lit-pos-cache first))
+ (setq s (parse-partial-sexp (or c-neutralize-pos (caar string-delims))
+ (or bound1 (point-max))))
+ (cond
+ ((not (nth 3 s))) ; Nothing changed by this ml-string.
+ ((not c-neutralize-pos) ; "New" unbalanced quote in this ml-s.
+ (setq c-neutralize-pos (nth 8 s))
+ (setq c-neutralized-prop (c-get-char-property c-neutralize-pos
+ 'syntax-table))
+ (c-put-char-property c-neutralize-pos 'syntax-table '(1))
+ (c-truncate-lit-pos-cache c-neutralize-pos))
+ ((eq (nth 3 s) (char-after c-neutralize-pos))
+ ;; New unbalanced quote balances old one.
+ (if c-neutralized-prop
+ (c-put-char-property c-neutralize-pos 'syntax-table
+ c-neutralized-prop)
+ (c-clear-char-property c-neutralize-pos 'syntax-table))
+ (c-truncate-lit-pos-cache c-neutralize-pos)
+ (setq c-neutralize-pos nil))
+ ;; New unbalanced quote doesn't balance old one. Nothing to do.
+ )))
+
+(defun c-depropertize-ml-strings-in-region (start finish)
+ ;; Remove any `syntax-table' text properties associated with multi-line
+ ;; strings contained in the region (START FINISH). Point is undefined at
+ ;; entry and exit, and the return value has no significance.
+ (setq c-neutralize-pos nil)
+ (goto-char start)
+ (while (and (< (point) finish)
+ (re-search-forward
+ c-ml-string-cpp-or-opener-re
+ finish t))
+ (if (match-beginning (+ c-cpp-or-ml-match-offset 1)) ; opening delimiter
+ ;; We've found a raw string
+ (let ((open-delim
+ (cons (match-beginning (+ c-cpp-or-ml-match-offset 1))
+ (cons (match-end (+ c-cpp-or-ml-match-offset 1))
+ (match-beginning (+ c-cpp-or-ml-match-offset 2))))))
+ (c-depropertize-ml-string
+ (cons open-delim
+ (when
+ (and
+ (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties
+ (+ c-cpp-or-ml-match-offset 1)))
+ (min (+ finish c-ml-string-max-closer-len-no-leader)
+ (point-max))
+ t)
+ (<= (match-end 1) finish))
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))))
+ nil)) ; bound
+ ;; We've found a CPP construct. Search for raw strings within it.
+ (goto-char (match-beginning 2)) ; the "#"
+ (c-end-of-macro)
+ (let ((eom (point)))
+ (goto-char (match-end 2)) ; after the "#".
+ (while (and (< (point) eom)
+ (c-syntactic-re-search-forward
+ c-ml-string-opener-re eom t))
+ (save-excursion
+ (let ((open-delim (cons (match-beginning 1)
+ (cons (match-end 1)
+ (match-beginning 2)))))
+ (c-depropertize-ml-string
+ (cons open-delim
+ (when (re-search-forward
+ (funcall c-make-ml-string-closer-re-function
+ (match-string-no-properties 1))
+ eom t)
+ (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))))
+ eom))))))) ; bound.
+ (when c-neutralize-pos
+ (if c-neutralized-prop
+ (c-put-char-property c-neutralize-pos 'syntax-table
+ c-neutralized-prop)
+ (c-clear-char-property c-neutralize-pos 'syntax-table))
+ (c-truncate-lit-pos-cache c-neutralize-pos)))
+
;; Handling of small scale constructs like types and names.
@@ -7771,6 +8189,7 @@ comment at the start of cc-engine.el for more info."
(defvar c-last-identifier-range nil)
(defmacro c-record-type-id (range)
+ (declare (debug t))
(if (eq (car-safe range) 'cons)
;; Always true.
`(setq c-record-type-identifiers
@@ -7781,6 +8200,7 @@ comment at the start of cc-engine.el for more info."
(cons range c-record-type-identifiers))))))
(defmacro c-record-ref-id (range)
+ (declare (debug t))
(if (eq (car-safe range) 'cons)
;; Always true.
`(setq c-record-ref-identifiers
@@ -7806,6 +8226,7 @@ comment at the start of cc-engine.el for more info."
;; if TYPE is 'type or as a reference if TYPE is 'ref.
;;
;; This macro might do hidden buffer changes.
+ (declare (debug t))
`(let (res)
(setq c-last-identifier-range nil)
(while (if (setq res ,(if (eq type 'type)
@@ -7830,6 +8251,7 @@ comment at the start of cc-engine.el for more info."
;; `c-forward-keyword-prefixed-id'.
;;
;; This macro might do hidden buffer changes.
+ (declare (debug t))
`(while (and (progn
,(when update-safe-pos
'(setq safe-pos (point)))
@@ -8042,13 +8464,14 @@ comment at the start of cc-engine.el for more info."
;; bracket arglist. It's propagated through the return value
;; on successful completion.
(c-record-found-types c-record-found-types)
+ (syntax-table-prop-on-< (c-get-char-property (point) 'syntax-table))
;; List that collects the positions after the argument
;; separating ',' in the arglist.
arg-start-pos)
;; If the '<' has paren open syntax then we've marked it as an angle
;; bracket arglist before, so skip to the end.
(if (and (not c-parse-and-markup-<>-arglists)
- (c-get-char-property (point) 'syntax-table))
+ syntax-table-prop-on-<)
(progn
(forward-char)
@@ -8133,8 +8556,20 @@ comment at the start of cc-engine.el for more info."
(c-put-c-type-property (1- (car arg-start-pos))
'c-<>-arg-sep)
(setq arg-start-pos (cdr arg-start-pos)))
+ (when (and (not syntax-table-prop-on-<)
+ (c-get-char-property (1- (point))
+ 'syntax-table))
+ ;; Clear the now spuriously matching < of its
+ ;; syntax-table property. This could happen on
+ ;; inserting "_cast" into "static <" with C-y.
+ (save-excursion
+ (and (c-go-list-backward)
+ (eq (char-after) ?<)
+ (c-truncate-lit-pos-cache (point))
+ (c-unmark-<->-as-paren (point)))))
(c-mark-<-as-paren start)
- (c-mark->-as-paren (1- (point))))
+ (c-mark->-as-paren (1- (point)))
+ (c-truncate-lit-pos-cache start))
(setq res t)
nil)) ; Exit the loop.
@@ -8298,7 +8733,7 @@ comment at the start of cc-engine.el for more info."
;; o - nil if no name is found;
;; o - 'template if it's an identifier ending with an angle bracket
;; arglist;
- ;; o - 'operator of it's an operator identifier;
+ ;; o - 'operator if it's an operator identifier;
;; o - t if it's some other kind of name.
;;
;; This function records identifier ranges on
@@ -8318,6 +8753,7 @@ comment at the start of cc-engine.el for more info."
(lim+ (c-determine-+ve-limit 500)))
(while
(and
+ (< (point) lim+)
(looking-at c-identifier-key)
(progn
@@ -8367,23 +8803,28 @@ comment at the start of cc-engine.el for more info."
;; '*', '&' or a name followed by ":: *",
;; where each can be followed by a sequence
;; of `c-opt-type-modifier-key'.
- (while (cond ((looking-at "[*&]")
- (goto-char (match-end 0))
- t)
- ((looking-at c-identifier-start)
- (and (c-forward-name)
- (looking-at "::")
- (progn
- (goto-char (match-end 0))
- (c-forward-syntactic-ws lim+)
- (eq (char-after) ?*))
- (progn
- (forward-char)
- t))))
+ (while
+ (and
+ (< (point) lim+)
+ (cond ((looking-at "[*&]")
+ (goto-char (match-end 0))
+ t)
+ ((looking-at c-identifier-start)
+ (and (c-forward-name)
+ (looking-at "::")
+ (progn
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws lim+)
+ (eq (char-after) ?*))
+ (progn
+ (forward-char)
+ t)))))
(while (progn
(c-forward-syntactic-ws lim+)
(setq pos (point))
- (looking-at c-opt-type-modifier-key))
+ (and
+ (<= (point) lim+)
+ (looking-at c-opt-type-modifier-key)))
(goto-char (match-end 1))))))
((looking-at c-overloadable-operators-regexp)
@@ -8429,6 +8870,9 @@ comment at the start of cc-engine.el for more info."
;; Maybe an angle bracket arglist.
(when (let (c-last-identifier-range)
(c-forward-<>-arglist nil))
+ ;; <> arglists can legitimately be very long, so recalculate
+ ;; `lim+'.
+ (setq lim+ (c-determine-+ve-limit 500))
(c-forward-syntactic-ws lim+)
(unless (eq (char-after) ?\()
@@ -8764,6 +9208,7 @@ comment at the start of cc-engine.el for more info."
(defmacro c-pull-open-brace (ps)
;; Pull the next open brace from PS (which has the form of paren-state),
;; skipping over any brace pairs. Returns NIL when PS is exhausted.
+ (declare (debug (symbolp)))
`(progn
(while (consp (car ,ps))
(setq ,ps (cdr ,ps)))
@@ -8879,6 +9324,7 @@ comment at the start of cc-engine.el for more info."
;; a comma. If either of <symbol> or bracketed <expression> is missing,
;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil
;; to 'done. This is not a general purpose macro!
+ (declare (debug t))
`(while (eq (char-before) ?,)
(backward-char)
(c-backward-syntactic-ws ,limit)
@@ -9272,6 +9718,7 @@ This function might do hidden buffer changes."
;; sometimes consumes the identifier in the declaration as a type.
;; This is used to "backtrack" and make the last type be treated as
;; an identifier instead.
+ (declare (debug nil))
`(progn
,(unless short
;; These identifiers are bound only in the inner let.
@@ -11419,7 +11866,9 @@ comment at the start of cc-engine.el for more info."
;; also might be part of a declarator expression. Currently
;; there's no such language.
(not (or (looking-at c-symbol-start)
- (looking-at c-type-decl-prefix-key))))))
+ (looking-at c-type-decl-prefix-key)
+ (and (eq (char-after) ?{)
+ (not (c-looking-at-statement-block))))))))
;; In Pike a list of modifiers may be followed by a brace
;; to make them apply to many identifiers. Note that the
@@ -11826,15 +12275,17 @@ comment at the start of cc-engine.el for more info."
;; 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.
+ ;; The determination of whether the brace starts a brace list is mainly by
+ ;; the context of the brace, not by its contents. In exceptional
+ ;; circumstances (e.g. "struct A {" in C++ Mode), the contents are examined,
+ ;; too.
;;
;; Here, "brace list" does not include the body of an enum.
(save-excursion
(let ((start (point))
(braceassignp 'dontknow)
inexpr-brace-list bufpos macro-start res pos after-type-id-pos
- in-paren parens-before-brace
+ pos2 in-paren parens-before-brace
paren-state paren-pos)
(setq res (c-backward-token-2 1 t lim))
@@ -11850,12 +12301,16 @@ comment at the start of cc-engine.el for more info."
(goto-char paren-pos)
(setq braceassignp 'c++-noassign
in-paren 'in-paren))
- ((looking-at c-pre-id-bracelist-key)
+ ((looking-at c-pre-brace-non-bracelist-key)
(setq braceassignp nil))
((looking-at c-return-key))
((and (looking-at c-symbol-start)
(not (looking-at c-keywords-regexp)))
- (setq after-type-id-pos (point)))
+ (if (save-excursion
+ (and (zerop (c-backward-token-2 1 t lim))
+ (looking-at c-pre-id-bracelist-key)))
+ (setq braceassignp 'c++-noassign)
+ (setq after-type-id-pos (point))))
((eq (char-after) ?\()
(setq parens-before-brace t)
nil)
@@ -11869,8 +12324,13 @@ comment at the start of cc-engine.el for more info."
(eq (char-after paren-pos) ?\()
(setq in-paren 'in-paren)
(goto-char paren-pos)))
- ((looking-at c-pre-id-bracelist-key))
+ ((looking-at c-pre-brace-non-bracelist-key))
((looking-at c-return-key))
+ ((and (looking-at c-symbol-start)
+ (not (looking-at c-keywords-regexp))
+ (save-excursion
+ (and (zerop (c-backward-token-2 1 t lim))
+ (looking-at c-pre-id-bracelist-key)))))
(t (setq after-type-id-pos (point))
nil))))
(setq braceassignp 'c++-noassign))
@@ -11955,8 +12415,12 @@ comment at the start of cc-engine.el for more info."
(cond
(braceassignp
;; We've hit the beginning of the aggregate list.
- (c-beginning-of-statement-1 containing-sexp)
- (cons (point) (or in-paren inexpr-brace-list)))
+ (setq pos2 (point))
+ (cons
+ (if (eq (c-beginning-of-statement-1 containing-sexp) 'same)
+ (point)
+ pos2)
+ (or in-paren inexpr-brace-list)))
((and after-type-id-pos
(save-excursion
(when (eq (char-after) ?\;)
@@ -11968,34 +12432,36 @@ comment at the start of cc-engine.el for more info."
(c-get-char-property (point) 'syntax-table))
(c-go-list-forward nil after-type-id-pos)
(c-forward-syntactic-ws)))
- (and
- (or (not (looking-at c-class-key))
- (save-excursion
- (goto-char (match-end 1))
- (c-forward-syntactic-ws)
- (not (eq (point) after-type-id-pos))))
- (progn
- (setq res
- (c-forward-decl-or-cast-1
- (save-excursion (c-backward-syntactic-ws) (point))
- nil nil))
- (and (consp res)
- (cond
- ((eq (car res) after-type-id-pos))
- ((> (car res) after-type-id-pos) nil)
- (t
- (catch 'find-decl
- (save-excursion
- (goto-char (car res))
- (c-do-declarators
- (point-max) t nil nil
- (lambda (id-start _id-end _tok _not-top _func _init)
- (cond
- ((> id-start after-type-id-pos)
- (throw 'find-decl nil))
- ((eq id-start after-type-id-pos)
- (throw 'find-decl t)))))
- nil)))))))))
+ (if (and (not (eq (point) after-type-id-pos))
+ (or (not (looking-at c-class-key))
+ (save-excursion
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (not (eq (point) after-type-id-pos)))))
+ (progn
+ (setq res
+ (c-forward-decl-or-cast-1 (c-point 'bosws)
+ nil nil))
+ (and (consp res)
+ (cond
+ ((eq (car res) after-type-id-pos))
+ ((> (car res) after-type-id-pos) nil)
+ (t
+ (catch 'find-decl
+ (save-excursion
+ (goto-char (car res))
+ (c-do-declarators
+ (point-max) t nil nil
+ (lambda (id-start _id-end _tok _not-top _func _init)
+ (cond
+ ((> id-start after-type-id-pos)
+ (throw 'find-decl nil))
+ ((eq id-start after-type-id-pos)
+ (throw 'find-decl t)))))
+ nil))))))
+ (save-excursion
+ (goto-char start)
+ (not (c-looking-at-statement-block))))))
(cons bufpos (or in-paren inexpr-brace-list)))
((or (eq (char-after) ?\;)
;; Brace lists can't contain a semicolon, so we're done.
@@ -12145,33 +12611,31 @@ 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 the block are terminated by semicolons, or the block is
- ;; empty, or the block contains a keyword) return non-nil. Otherwise,
- ;; return nil.
+ ;; empty, or the block contains a characteristic keyword, or there is a
+ ;; nested statement block) return non-nil. 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 ; 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)))))
+ ((eq (char-before) ?\;))
+ ((progn (c-forward-syntactic-ws)
+ (eq (point) (1- there))))
+ ((c-syntactic-re-search-forward
+ c-stmt-block-only-keywords-regexp there t))
+ ((c-syntactic-re-search-forward "{" there t t)
+ (backward-char)
+ (c-looking-at-statement-block))
+ (t nil)))
(forward-char)
(cond
- ((c-syntactic-re-search-forward "[;,]" nil t t)
- (eq (char-before) ?\;))
+ ((c-syntactic-re-search-forward ";" nil t t))
((progn (c-forward-syntactic-ws)
(eobp)))
- ((c-syntactic-re-search-forward c-keywords-regexp nil t t))
+ ((c-syntactic-re-search-forward c-stmt-block-only-keywords-regexp
+ nil t t))
((c-syntactic-re-search-forward "{" nil t t)
(backward-char)
(c-looking-at-statement-block))
@@ -12211,7 +12675,7 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(while
(progn
- (c-syntactic-skip-backward "^;=}>" closest-lim t)
+ (c-syntactic-skip-backward "^;=,}>" closest-lim t)
(and (eq (char-before) ?>)
(c-backward-token-2)
(not (looking-at c-haskell-op-re)))))
@@ -14658,18 +15122,6 @@ Cannot combine absolute offsets %S and %S in `add' method"
indent)))
-(def-edebug-spec c-bos-pop-state t)
-(def-edebug-spec c-bos-save-error-info t)
-(def-edebug-spec c-state-cache-top-lparen t)
-(def-edebug-spec c-state-cache-top-paren t)
-(def-edebug-spec c-state-cache-after-top-paren t)
-(def-edebug-spec c-state-maybe-marker (form symbolp))
-(def-edebug-spec c-record-type-id t)
-(def-edebug-spec c-record-ref-id t)
-(def-edebug-spec c-forward-keyword-prefixed-id t)
-(def-edebug-spec c-forward-id-comma-list t)
-(def-edebug-spec c-pull-open-brace (symbolp))
-
(cc-provide 'cc-engine)
;; Local Variables:
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 4e283764ceb..7e7053b98e1 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,4 +1,4 @@
-;;; cc-fonts.el --- font lock support for CC Mode
+;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -218,6 +218,7 @@
;; incorrectly.
;;
;; This function does a hidden buffer change.
+ (declare (debug t))
(if (fboundp 'font-lock-set-face)
;; Note: This function has no docstring in XEmacs so it might be
;; considered internal.
@@ -228,6 +229,7 @@
;; This is the inverse of `c-put-font-lock-face'.
;;
;; This function does a hidden buffer change.
+ (declare (debug t))
(if (fboundp 'font-lock-remove-face)
`(font-lock-remove-face ,from ,to)
`(remove-text-properties ,from ,to '(face nil))))
@@ -238,11 +240,13 @@
;; region should include them.
;;
;; This function does a hidden buffer change.
+ (declare (debug t))
(if (featurep 'xemacs)
`(c-put-font-lock-face (1+ ,from) (1- ,to) 'font-lock-string-face)
`(c-put-font-lock-face ,from ,to 'font-lock-string-face)))
(defmacro c-fontify-types-and-refs (varlist &rest body)
+ (declare (indent 1) (debug let*))
;; Like `let', but additionally activates `c-record-type-identifiers'
;; and `c-record-ref-identifiers', and fontifies the recorded ranges
;; accordingly on exit.
@@ -253,7 +257,6 @@
,@varlist)
(prog1 (progn ,@body)
(c-fontify-recorded-types-and-refs))))
- (put 'c-fontify-types-and-refs 'lisp-indent-function 1)
(defun c-skip-comments-and-strings (limit)
;; If the point is within a region fontified as a comment or
@@ -482,20 +485,7 @@
;; 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.
-; '(progn
-(def-edebug-spec c-put-font-lock-face t)
-(def-edebug-spec c-remove-font-lock-face t)
-(def-edebug-spec c-put-font-lock-string-face t)
- (def-edebug-spec c-fontify-types-and-refs let*)
- (def-edebug-spec c-make-syntactic-matcher t)
- ;; If there are literal quoted or backquoted highlight specs in
- ;; the call to `c-make-font-lock-search-function' then let's
- ;; instrument the forms in them.
- (def-edebug-spec c-make-font-lock-search-function
- (form &rest &or ("quote" (&rest form)) ("`" (&rest form)) form)));))
+ nil)))))
(defun c-fontify-recorded-types-and-refs ()
;; Convert the ranges recorded on `c-record-type-identifiers' and
@@ -791,9 +781,9 @@ casts and declarations are fontified. Used on level 2 and higher."
;; 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))
+ ;; Fontify multiline strings.
+ ,@(when (c-lang-const c-ml-string-opener-re)
+ '(c-font-lock-ml-strings))
;; Fontify keyword constants.
,@(when (c-lang-const c-constant-kwds)
@@ -1679,9 +1669,7 @@ casts and declarations are fontified. Used on level 2 and higher."
c-recognize-knr-p) ; Strictly speaking, bogus, but it
; speeds up lisp.h tremendously.
(save-excursion
- (when (not (c-back-over-member-initializers
- (max (- (point) 2000) (point-min)))) ; c-determine-limit
- ; is too slow, here.
+ (when (not (c-back-over-member-initializers decl-search-lim))
(unless (or (eobp)
(looking-at "\\s(\\|\\s)"))
(forward-char))
@@ -1749,8 +1737,8 @@ casts and declarations are fontified. Used on level 2 and higher."
(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.
+(defun c-font-lock-ml-strings (limit)
+ ;; Fontify multi-line strings.
;;
;; 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
@@ -1760,52 +1748,75 @@ casts and declarations are fontified. Used on level 2 and higher."
(let* ((state (c-semi-pp-to-literal (point)))
(string-start (and (eq (cadr state) 'string)
(car (cddr state))))
- (raw-id (and string-start
- (c-at-c++-raw-string-opener string-start)
- (match-string-no-properties 1)))
- (content-start (and raw-id (point))))
+ (open-delim (and string-start
+ (save-excursion
+ (goto-char (1+ string-start))
+ (c-ml-string-opener-around-point))))
+ (string-delims (and open-delim
+ (cons open-delim (c-get-ml-closer open-delim))))
+ found)
;; We go round the next loop twice per raw string, once for each "end".
(while (< (point) limit)
- (if raw-id
- ;; Search for the raw string end delimiter
- (progn
- (when (search-forward-regexp (concat ")\\(" (regexp-quote raw-id) "\\)\"")
- limit 'limit)
- (c-put-font-lock-face content-start (match-beginning 1)
- 'font-lock-string-face)
- (c-remove-font-lock-face (match-beginning 1) (point)))
- (setq raw-id nil))
- ;; Search for the start of a raw string.
- (when (search-forward-regexp
- "R\\(\"\\)\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" limit 'limit)
- (when
- ;; Make sure we're not in a comment or string.
- (and
- (not (memq (c-get-char-property (match-beginning 0) 'face)
- '(font-lock-comment-face font-lock-comment-delimiter-face
- font-lock-string-face)))
- (or (and (eobp)
- (eq (c-get-char-property (1- (point)) 'face)
- 'font-lock-warning-face))
- (not (eq (c-get-char-property (point) 'face) 'font-lock-comment-face))
- ;; (eq (c-get-char-property (point) 'face) 'font-lock-string-face)
- (and (equal (c-get-char-property (match-end 2) 'syntax-table) '(1))
- (equal (c-get-char-property (match-beginning 1) 'syntax-table)
- '(1)))))
- (let ((paren-prop (c-get-char-property (1- (point)) 'syntax-table)))
- (if paren-prop
- (progn
- (c-put-font-lock-face (match-beginning 0) (match-end 0)
- 'font-lock-warning-face)
- (when
- (and
- (equal paren-prop '(15))
- (not (c-search-forward-char-property 'syntax-table '(15) limit)))
- (goto-char limit)))
- (c-remove-font-lock-face (match-beginning 0) (match-end 2))
- (setq raw-id (match-string-no-properties 2))
- (setq content-start (match-end 0)))))))))
- nil)
+ (cond
+ ;; Point is not in an ml string
+ ((not string-delims)
+ (while (and (setq found (re-search-forward c-ml-string-opener-re
+ limit 'limit))
+ (> (match-beginning 0) (point-min))
+ (memq (c-get-char-property (1- (match-beginning 0)) 'face)
+ '(font-lock-comment-face font-lock-string-face
+ font-lock-comment-delimiter-face))))
+ (when found
+ (setq open-delim (cons (match-beginning 1)
+ (cons (match-end 1) (match-beginning 2)))
+ string-delims (cons open-delim (c-get-ml-closer open-delim)))
+ (goto-char (caar string-delims))))
+
+ ;; Point is in the body of an ml string.
+ ((and string-delims
+ (>= (point) (cadar string-delims))
+ (or (not (cdr string-delims))
+ (< (point) (cadr string-delims))))
+ (if (cdr string-delims)
+ (goto-char (cadr string-delims))
+ (if (equal (c-get-char-property (1- (cadar string-delims))
+ 'syntax-table)
+ '(15)) ; "Always" the case.
+ ;; The next search should be successful for an unterminated ml
+ ;; string inside a macro, but not for any other unterminated
+ ;; string.
+ (progn
+ (or (c-search-forward-char-property 'syntax-table '(15) limit)
+ (goto-char limit))
+ (setq string-delims nil))
+ (c-benign-error "Missing '(15) syntax-table property at %d"
+ (1- (cadar string-delims)))
+ (setq string-delims nil))))
+
+ ;; Point is at or in a closing delimiter
+ ((and string-delims
+ (cdr string-delims)
+ (>= (point) (cadr string-delims)))
+ (c-put-font-lock-face (cadr string-delims) (1+ (cadr string-delims))
+ 'font-lock-string-face)
+ (c-remove-font-lock-face (1+ (cadr string-delims))
+ (caddr string-delims))
+ (goto-char (caddr string-delims))
+ (setq string-delims nil))
+
+ ;; point is at or in an opening delimiter.
+ (t
+ (if (cdr string-delims)
+ (progn
+ (c-remove-font-lock-face (caar string-delims)
+ (1- (cadar string-delims)))
+ (c-put-font-lock-face (1- (cadar string-delims))
+ (cadar string-delims)
+ 'font-lock-string-face))
+ (c-put-font-lock-face (caar string-delims) (cadar string-delims)
+ 'font-lock-warning-face))
+ (goto-char (cadar string-delims)))))
+ nil))
(defun c-font-lock-c++-lambda-captures (limit)
;; Fontify the lambda capture component of C++ lambda declarations.
@@ -2287,7 +2298,7 @@ need for `c-font-lock-extra-types'.")
;; font-lock-keyword-face. It always returns NIL to inhibit this and
;; prevent a repeat invocation. See elisp/lispref page "Search-based
;; fontification".
- (let (pos after-name)
+ (let (pos)
(while (c-syntactic-re-search-forward c-using-key limit 'end)
(while ; Do one declarator of a comma separated list, each time around.
(progn
@@ -2295,7 +2306,6 @@ need for `c-font-lock-extra-types'.")
(setq pos (point)) ; token after "using".
(when (and (c-on-identifier)
(c-forward-name))
- (setq after-name (point))
(cond
((eq (char-after) ?=) ; using foo = <type-id>;
(goto-char pos)
@@ -2305,7 +2315,8 @@ need for `c-font-lock-extra-types'.")
(c-go-up-list-backward)
(eq (char-after) ?{)
(eq (car (c-beginning-of-decl-1
- (c-determine-limit 1000))) 'same)
+ (c-determine-limit 1000)))
+ 'same)
(looking-at c-colon-type-list-re)))
;; Inherited protected member: leave unfontified
)
@@ -2712,6 +2723,7 @@ need for `pike-font-lock-extra-types'.")
(defmacro c-set-doc-comment-re-element (suffix)
;; Set the variable `c-doc-line-join-re' to a buffer local value suitable
;; for the current doc comment style, or kill the local value.
+ (declare (debug t))
(let ((var (intern (concat "c-doc" suffix))))
`(let* ((styles (c-get-doc-comment-style))
elts)
@@ -2738,6 +2750,7 @@ need for `pike-font-lock-extra-types'.")
(defmacro c-set-doc-comment-char-list (suffix)
;; Set the variable 'c-doc-<suffix>' to the list of *-<suffix>, which must
;; be characters, and * represents the doc comment style.
+ (declare (debug t))
(let ((var (intern (concat "c-doc" suffix))))
`(let* ((styles (c-get-doc-comment-style))
elts)
@@ -2783,14 +2796,15 @@ need for `pike-font-lock-extra-types'.")
;; is used as a flag in other code to skip comments.
;;
;; This function might do hidden buffer changes.
-
- (let (comment-beg region-beg)
+ (declare (indent 2))
+ (let (comment-beg region-beg comment-mid)
(if (memq (get-text-property (point) 'face)
'(font-lock-comment-face font-lock-comment-delimiter-face))
;; Handle the case when the fontified region starts inside a
;; comment.
(let ((start (c-literal-start)))
- (setq region-beg (point))
+ (setq region-beg (point)
+ comment-mid (point))
(when start
(goto-char start))
(when (looking-at prefix)
@@ -2816,7 +2830,8 @@ need for `pike-font-lock-extra-types'.")
(goto-char comment-beg)
(c-in-literal)))))
(setq comment-beg nil))
- (setq region-beg comment-beg))
+ (setq region-beg comment-beg
+ comment-mid comment-beg))
(if (elt (parse-partial-sexp comment-beg (+ comment-beg 2)) 7)
;; Collect a sequence of doc style line comments.
@@ -2824,15 +2839,16 @@ need for `pike-font-lock-extra-types'.")
(goto-char comment-beg)
(while (and (progn
(c-forward-single-comment)
- (c-put-font-lock-face comment-beg (point)
+ (c-put-font-lock-face comment-mid (point)
c-doc-face-name)
(skip-syntax-forward " ")
- (setq comment-beg (point))
+ (setq comment-beg (point)
+ comment-mid (point))
(< (point) limit))
(looking-at prefix))))
(goto-char comment-beg)
(c-forward-single-comment)
- (c-put-font-lock-face comment-beg (point) c-doc-face-name))
+ (c-put-font-lock-face region-beg (point) c-doc-face-name))
(if (> (point) limit) (goto-char limit))
(setq comment-beg nil)
@@ -2866,7 +2882,6 @@ need for `pike-font-lock-extra-types'.")
(goto-char region-end)))))
nil)
-(put 'c-font-lock-doc-comments 'lisp-indent-function 2)
(defun c-find-invalid-doc-markup (regexp limit)
;; Used to fontify invalid markup in doc comments after the correct
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index 1b852ec4910..9c88c14a6c1 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -1,4 +1,4 @@
-;;; cc-guess.el --- guess indentation values by scanning existing code
+;;; cc-guess.el --- guess indentation values by scanning existing code -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software
;; Foundation, Inc.
@@ -58,7 +58,7 @@
;;
;; If you want to reuse the guessed style in future emacs sessions,
;; you may want to put it to your .emacs. `c-guess-view' is for
-;; you. It emits emacs lisp code which defines the last guessed
+;; you. It emits Emacs Lisp code which defines the last guessed
;; style, in a temporary buffer. You can put the emitted code into
;; your .emacs. This command was suggested by Alan Mackenzie.
@@ -527,7 +527,7 @@ is called with one argument, the guessed style."
(cdr needs-markers)))))
(defun c-guess-view (&optional with-name)
- "Emit emacs lisp code which defines the last guessed style.
+ "Emit Emacs Lisp code which defines the last guessed style.
So you can put the code into .emacs if you prefer the
guessed code.
\"STYLE NAME HERE\" is used as the name for the style in the
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 07479389c62..0b125bc43fa 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1,4 +1,4 @@
-;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*-
+;;; cc-langs.el --- language specific settings for CC Mode -*- lexical-binding: t; coding: utf-8 -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -159,7 +159,9 @@ evaluated and bound to VAR when the result from the macro
`c-lang-const' is typically used in VAL to get the right value for the
language being initialized, and such calls will be macro expanded to
the evaluated constant value at compile time."
-
+ (declare (indent defun)
+ (debug (&define name def-form
+ &optional &or ("quote" symbolp) stringp)))
(when (and (not doc)
(eq (car-safe val) 'c-lang-const)
(eq (nth 1 val) var)
@@ -191,6 +193,7 @@ Emacs variable like `comment-start'.
`c-lang-const' is typically used in VAL to get the right value for the
language being initialized, and such calls will be macro expanded to
the evaluated constant value at compile time."
+ (declare (debug (&define name def-form)))
(let ((elem (assq var (cdr c-emacs-variable-inits))))
(if elem
(setcdr elem (list val)) ; Maybe remove "list", sometime. 2006-07-19
@@ -200,13 +203,6 @@ the evaluated constant value at compile time."
;; Return the symbol, like the other def* forms.
`',var)
-(put 'c-lang-defvar 'lisp-indent-function 'defun)
-; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
-; '
-(def-edebug-spec c-lang-defvar
- (&define name def-form &optional &or ("quote" symbolp) stringp))
-(def-edebug-spec c-lang-setvar (&define name def-form))
-
;; Suppress "might not be defined at runtime" warning.
;; This file is only used when compiling other cc files.
(declare-function cl-delete-duplicates "cl-seq" (cl-seq &rest cl-keys))
@@ -337,7 +333,8 @@ the evaluated constant value at compile time."
This includes setting \\=' and \" as string delimiters, and setting up
the comment syntax to handle both line style \"//\" and block style
\"/*\" \"*/\" comments."
-
+ ;; Never native compile to allow cc-mode.el:467 hack.
+ (declare (speed -1))
(modify-syntax-entry ?_ "_" table)
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?+ "." table)
@@ -378,12 +375,14 @@ The syntax tables aren't stored directly since they're quite large."
(let ((table (make-syntax-table)))
(c-populate-syntax-table table)
;; Mode specific syntaxes.
- ,(cond ((or (c-major-mode-is 'objc-mode) (c-major-mode-is 'java-mode))
+ ,(cond ((c-major-mode-is 'objc-mode)
;; Let '@' be part of symbols in ObjC to cope with
;; its compiler directives as single keyword tokens.
;; This is then necessary since it's assumed that
;; every keyword is a single symbol.
'(modify-syntax-entry ?@ "_" table))
+ ((c-major-mode-is 'java-mode)
+ '(modify-syntax-entry ?@ "'" table))
((c-major-mode-is 'pike-mode)
'(modify-syntax-entry ?@ "." table)))
table)))
@@ -454,9 +453,9 @@ so that all identifiers are recognized as words.")
;; The value here may be a list of functions or a single function.
t 'c-before-change-check-unbalanced-strings
c++ '(c-extend-region-for-CPP
- c-before-change-check-raw-strings
- c-before-change-check-<>-operators
c-depropertize-CPP
+ c-before-change-check-ml-strings
+ c-before-change-check-<>-operators
c-truncate-bs-cache
c-before-change-check-unbalanced-strings
c-parse-quotes-before-change)
@@ -468,6 +467,8 @@ so that all identifiers are recognized as words.")
java '(c-parse-quotes-before-change
c-before-change-check-unbalanced-strings
c-before-change-check-<>-operators)
+ pike '(c-before-change-check-ml-strings
+ c-before-change-check-unbalanced-strings)
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)))
@@ -507,7 +508,7 @@ parameters \(point-min) and \(point-max).")
c-change-expand-fl-region)
c++ '(c-depropertize-new-text
c-after-change-escape-NL-in-string
- c-after-change-unmark-raw-strings
+ c-after-change-unmark-ml-strings
c-parse-quotes-after-change
c-after-change-mark-abnormal-strings
c-extend-font-lock-region-for-macros
@@ -520,6 +521,11 @@ parameters \(point-min) and \(point-max).")
c-after-change-mark-abnormal-strings
c-restore-<>-properties
c-change-expand-fl-region)
+ pike '(c-depropertize-new-text
+ c-after-change-escape-NL-in-string
+ c-after-change-unmark-ml-strings
+ c-after-change-mark-abnormal-strings
+ c-change-expand-fl-region)
awk '(c-depropertize-new-text
c-awk-extend-and-syntax-tablify-region))
(c-lang-defvar c-before-font-lock-functions
@@ -579,14 +585,12 @@ don't have EOL terminated statements. "
(c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn))
(c-lang-defconst c-vsemi-status-unknown-p-fn
- "Contains a predicate regarding the presence of virtual semicolons.
-More precisely, the function answers the question, \"are we unsure whether a
-virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of
-such a function is to prevent an infinite recursion in
-`c-beginning-of-statement-1' when point starts at a `while' token. The function
-MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even
-indirectly. This variable contains nil for languages which don't have EOL
-terminated statements."
+ "A function \"are we unsure whether there is a virtual semicolon on this line?\".
+The (admittedly kludgy) purpose of such a function is to prevent an infinite
+recursion in c-beginning-of-statement-1 when point starts at a `while' token.
+The function MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1',
+even indirectly. This variable contains nil for languages which don't have
+EOL terminated statements."
t nil
(c c++ objc) 'c-macro-vsemi-status-unknown-p
awk 'c-awk-vsemi-status-unknown-p)
@@ -623,6 +627,176 @@ Note that to set up a language to use this, additionally:
'(?\")))
(c-lang-defvar c-string-delims (c-lang-const c-string-delims))
+
+;; The next section of the code defines multi-line ("ml") strings for each
+;; language. By default, there are no ml strings in a language. To configure
+;; them, set each needed lang const in the section. See further details in
+;; cc-engine.el (search for "Handling of CC Mode multi-line strings.").
+(c-lang-defconst c-ml-string-backslash-escapes
+ ;; N.B. if `c-ml-string-backslash-escapes' is non-nil, you probably need a
+ ;; `c-ml-string-any-closer-re' that scans backslashed characters, etc.
+ "If non-nil, a \\ character escapes the next character in a ml string.
+Otherwise such a \\ will be marked to be handled as any other character."
+ t nil
+ pike t
+ )
+
+(c-lang-defconst c-ml-string-non-punc-skip-chars
+ ;; A `skip-chars-forward' argument which skips over all ml string characters
+ ;; which don't need to be marked with punctuation ('(1)) syntax.
+ t (if (c-lang-const c-ml-string-backslash-escapes)
+ "^\""
+ "^\"\\"))
+(c-lang-defvar c-ml-string-non-punc-skip-chars
+ (c-lang-const c-ml-string-non-punc-skip-chars))
+
+(c-lang-defconst c-ml-string-opener-re
+ "If non-nil, a regexp that matches a multi-line string opener.
+It may also match context.
+
+Such an opener must be at least 2 characters long, and must
+contain a \" character. (match-string 1) matches the actual
+delimiter and (match-string 2) matches the actual \". If a
+delimiter contains several \"s, it is recommended to configure
+the first of them as \"the\" \"."
+ t nil
+ pike "\\(#\\(\"\\)\\)"
+ c++ "\\(R\\(\"\\)[^ ()\\\n\r\t]\\{0,16\\}(\\)")
+(c-lang-defvar c-ml-string-opener-re (c-lang-const c-ml-string-opener-re))
+
+(c-lang-defconst c-ml-string-max-opener-len
+ "If non-nil, the maximum length of a multi-line string opener."
+ t nil
+ pike 2
+ c++ 19)
+(c-lang-defvar c-ml-string-max-opener-len
+ (c-lang-const c-ml-string-max-opener-len))
+
+(c-lang-defconst c-ml-string-any-closer-re
+ "If non-nil, a regexp that matches any multi-line string closer.
+It may also match context.
+
+A search for this regexp starting at the end of the corresponding
+opener must find the first closer as the first match.
+
+Such a closer must include a \" character. (match-string 1)
+matches the actual delimiter and and (match-string 2) matches the
+actual \". If a delimiter contains several \"s, it is
+recommended to regard the last of them as \"the\" \"."
+ t nil
+ pike "\\(?:\\=\\|[^\\\"]\\)\\(?:\\\\.\\)*\\(\\(\"\\)\\)"
+ c++ "\\()[^ ()\\n\r\t]\\{0,16\\}\\(\"\\)\\)")
+;; csharp "\\(?:\\=\\|[^\"]\\)\\(?:\"\"\\)*\\(\\(\"\\)\\)\\(?:[^\"]\\|\\'\\)"
+(c-lang-defvar c-ml-string-any-closer-re
+ (c-lang-const c-ml-string-any-closer-re))
+
+(c-lang-defconst c-ml-string-max-closer-len
+ "If non-nil, the maximum length of a multi-line string closer.
+This must include the length of any \"context trailer\" following
+the actual closer and any \"context leader\" preceding it. This
+variable is ignored when `c-ml-string-back-closer-re' is non-nil."
+ t nil
+ c++ 18)
+(c-lang-defvar c-ml-string-max-closer-len
+ (c-lang-const c-ml-string-max-closer-len))
+
+(c-lang-defconst c-ml-string-max-closer-len-no-leader
+ "If non-nil, the maximum length of a ml string closer without its leader.
+By \"leader\" is meant the context bytes preceding the actual
+multi-line string closer, that part of
+`c-ml-string-any-closer-re''s match preceding (match-beginning 1)."
+ t nil
+ pike 1
+ ;; 2
+ ;; 3
+ c++ 18)
+(c-lang-defvar c-ml-string-max-closer-len-no-leader
+ (c-lang-const c-ml-string-max-closer-len-no-leader))
+
+(c-lang-defconst c-ml-string-back-closer-re
+ "A regexp to move back out of a putative ml closer point is in.
+
+This variable need only be non-nil for languages with multi-line
+string closers that can contain an indefinite length \"leader\"
+preceding the actual closer. It was designed for formats where
+an unbounded number of \\s or \"s might precede the closer
+proper, for example in Pike Mode or csharp-mode.
+
+If point is in a putative multi-line string closer, a backward
+regexp search with `c-ml-string-back-closer-re' will leave point
+in a \"safe place\", from where a forward regexp search with
+`c-ml-string-any-closer-re' can test whether the original
+position was inside an actual closer.
+
+When non-nil, this variable should end in \"\\\\\\==\". Note that
+such a backward search will match a minimal string, so a
+\"context character\" is probably needed at the start of the
+regexp. The value for csharp-mode would be something like
+\"\\\\(:?\\\\`\\\\|[^\\\"]\\\\)\\\"*\\\\\\==\"."
+ t nil
+ pike "\\(:?\\`\\|[^\\\"]\\)\\(:?\\\\.\\)*\\="
+ ;;pike ;; 2
+ ;; "\\(:?\\`\\|[^\"]\\)\"*\\="
+ )
+(c-lang-defvar c-ml-string-back-closer-re
+ (c-lang-const c-ml-string-back-closer-re))
+
+(c-lang-defconst c-make-ml-string-closer-re-function
+ "If non-nil, a function which creates a closer regexp matching an opener.
+
+Such a function is given one argument, a multi-line opener (a
+string), and returns a regexp which will match the corresponding
+closer. When this regexp matches, (match-string 1) should be the
+actual closing delimiter, and (match-string 2) the \"active\" \"
+it contains.
+
+A forward regexp search for this regexp starting at the end of
+the opener must find the closer as its first match."
+ t (if (c-lang-const c-ml-string-any-closer-re)
+ 'c-ml-string-make-closer-re)
+ c++ 'c-c++-make-ml-string-closer-re)
+(c-lang-defvar c-make-ml-string-closer-re-function
+ (c-lang-const c-make-ml-string-closer-re-function))
+
+(c-lang-defconst c-make-ml-string-opener-re-function
+ "If non-nil, a function which creates an opener regexp matching a closer.
+
+Such a function is given one argument, a multi-line closer (a
+string), and returns a regexp which will match the corresponding
+opener. When this regexp matches, (match-string 1) should be the
+actual opening delimiter, and (match-string 2) the \"active\" \"
+it contains.
+
+A backward regexp search for this regexp starting at the start of
+the closer might not find the opener as its first match, should
+there be copies of the opener contained in the multi-line string."
+ t (if (c-lang-const c-ml-string-opener-re)
+ 'c-ml-string-make-opener-re)
+ c++ 'c-c++-make-ml-string-opener-re)
+(c-lang-defvar c-make-ml-string-opener-re-function
+ (c-lang-const c-make-ml-string-opener-re-function))
+
+(c-lang-defconst c-ml-string-cpp-or-opener-re
+ ;; A regexp which matches either a macro or a multi-line string opener.
+ t (concat "\\("
+ (or (c-lang-const c-anchored-cpp-prefix) "\\`a\\`")
+ "\\)\\|\\("
+ (or (c-lang-const c-ml-string-opener-re) "\\`a\\`")
+ "\\)"))
+(c-lang-defvar c-ml-string-cpp-or-opener-re
+ (c-lang-const c-ml-string-cpp-or-opener-re))
+
+(c-lang-defconst c-cpp-or-ml-match-offset
+ ;; The offset to be added onto match numbers for a multi-line string in
+ ;; matches for `c-cpp-or-ml-string-opener-re'.
+ t (if (c-lang-const c-anchored-cpp-prefix)
+ (+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix)))
+ 2))
+(c-lang-defvar c-cpp-or-ml-match-offset
+ (c-lang-const c-cpp-or-ml-match-offset))
+;; End of ml string section.
+
+
(c-lang-defconst c-has-quoted-numbers
"Whether the language has numbers quoted like 4'294'967'295."
t nil
@@ -863,9 +1037,15 @@ literals."
"Set if the language supports multiline string literals without escaped
newlines. If t, all string literals are multiline. If a character,
only literals where the open quote is immediately preceded by that
-literal are multiline."
- t nil
- pike ?#)
+literal are multiline.
+
+Note that from CC Mode 5.36, this character use is obsolete,
+having been superseded by the \"multi-line string\" mechanism.
+If both mechanisms are set for a language, the newer one prevails
+over the old `c-multiline-string-start-char'. See the variables
+in the page containing `c-ml-string-opener-re' in cc-langs.el for
+further directions."
+ t nil)
(c-lang-defvar c-multiline-string-start-char
(c-lang-const c-multiline-string-start-char))
@@ -2746,7 +2926,8 @@ if this isn't nil."
`c-recognize-<>-arglists' for details. That language constant is
assumed to be set if this isn't nil."
t nil
- c++ '("template")
+ c++ '("template" "const_cast" "dynamic_cast" "reinterpret_cast"
+ "static_cast")
idl '("fixed" "string" "wstring"))
(c-lang-defconst c-<>-sexp-kwds
@@ -3098,6 +3279,36 @@ Note that Java specific rules are currently applied to tell this from
t (c-make-keywords-re t (c-lang-const c-keywords)))
(c-lang-defvar c-keywords-regexp (c-lang-const c-keywords-regexp))
+(c-lang-defconst c-stmt-block-only-keywords
+ "All keywords which unambiguously signify a statement block (as opposed to
+ a brace list) when occurring inside braces."
+ t (c--set-difference
+ (c-lang-const c-keywords)
+ (append (c-lang-const c-primary-expr-kwds)
+ (c-lang-const c-constant-kwds)
+ `(,@(when (c-major-mode-is 'c++-mode)
+ '("typeid" "dynamic_cast" "static_cast" "const_cast"
+ "reinterpret_cast" "alignof")))
+ (c-lang-const c-type-modifier-prefix-kwds)
+ (c-lang-const c-overloadable-operators)
+ (c-lang-const c-template-typename-kwds)
+ `(,@(when (c-major-mode-is 'c++-mode)
+ '("reflexpr")))
+ `(,@(when (c-major-mode-is '(c-mode c++-mode))
+ '("sizeof")))
+ (c-lang-const c-pre-lambda-tokens)
+ (c-lang-const c-block-decls-with-vars)
+ (c-lang-const c-primitive-type-kwds))
+ :test 'string-equal))
+
+(c-lang-defconst c-stmt-block-only-keywords-regexp
+ ;; A regexp matching a keyword in `c-stmt-block-only-keywords'. Such a
+ ;; match can start and end only at token boundaries.
+ t (concat "\\(^\\|\\=\\|[^" (c-lang-const c-symbol-chars) "]\\)"
+ (c-make-keywords-re t (c-lang-const c-stmt-block-only-keywords))))
+(c-lang-defvar c-stmt-block-only-keywords-regexp
+ (c-lang-const c-stmt-block-only-keywords-regexp))
+
(c-lang-defconst c-keyword-member-alist
;; An alist with all the keywords in the cars. The cdr for each
;; keyword is a list of the symbols for the `*-kwds' lists that
@@ -3650,13 +3861,25 @@ list."
c t)
(c-lang-defvar c-recognize-knr-p (c-lang-const c-recognize-knr-p))
+(c-lang-defconst c-pre-id-bracelist-kwds
+ "Keywords which, preceding an identifier and brace, signify a bracelist.
+This is only used in c++-mode."
+ t nil
+ c++ '("new" "throw"))
+
(c-lang-defconst c-pre-id-bracelist-key
- "A regexp matching tokens which, preceding an identifier, signify a bracelist.
-"
- t regexp-unmatchable
- c++ "new\\([^[:alnum:]_$]\\|$\\)\\|&&?\\(\\S.\\|$\\)")
+ ;; A regexp matching keywords which, preceding an identifier and brace,
+ ;; signify a bracelist. Only used in c++-mode.
+ t (c-make-keywords-re t (c-lang-const c-pre-id-bracelist-kwds)))
(c-lang-defvar c-pre-id-bracelist-key (c-lang-const c-pre-id-bracelist-key))
+(c-lang-defconst c-pre-brace-non-bracelist-key
+ "A regexp matching tokens which, preceding a brace, make it a non-bracelist."
+ t regexp-unmatchable
+ c++ "&&?\\(\\S.\\|$\\)")
+(c-lang-defvar c-pre-brace-non-bracelist-key
+ (c-lang-const c-pre-brace-non-bracelist-key))
+
(c-lang-defconst c-recognize-typeless-decls
"Non-nil means function declarations without return type should be
recognized. That can introduce an ambiguity with parenthesized macro
@@ -4051,6 +4274,7 @@ accomplish that conveniently."
This macro is expanded at compile time to a form tailored for the mode
in question, so MODE must be a constant. Therefore MODE is not
evaluated and should not be quoted."
+ (declare (debug nil))
`(funcall ,(c-make-init-lang-vars-fun mode)))
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 0ff6efb7d37..a099ec1de95 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -1,4 +1,4 @@
-;;; cc-menus.el --- imenu support for CC Mode
+;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index cfb23d0d45e..057d292246f 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,4 +1,4 @@
-;;; cc-mode.el --- major mode for editing C and similar languages
+;;; cc-mode.el --- major mode for editing C and similar languages -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -969,6 +969,7 @@ Note that the style variables are always made local to the buffer."
(defmacro c-run-mode-hooks (&rest hooks)
;; Emacs 21.1 has introduced a system with delayed mode hooks that
;; requires the use of the new function `run-mode-hooks'.
+ (declare (debug t))
(if (cc-bytecomp-fboundp 'run-mode-hooks)
`(run-mode-hooks ,@hooks)
`(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks))))
@@ -1002,8 +1003,8 @@ Note that the style variables are always made local to the buffer."
(goto-char (match-beginning 1))
(setq m-beg (point))
(c-end-of-macro)
- (when (c-major-mode-is 'c++-mode)
- (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))))
+ (when c-ml-string-opener-re
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
(c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
(while (and (< (point) end)
@@ -1013,8 +1014,8 @@ Note that the style variables are always made local to the buffer."
(setq m-beg (point))
(c-end-of-macro))
(when (and ss-found (> (point) end))
- (when (c-major-mode-is 'c++-mode)
- (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))))
+ (when c-ml-string-opener-re
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
(c-clear-char-property-with-value m-beg (point) 'syntax-table '(1)))
(while (and (< (point) c-new-END)
@@ -1022,8 +1023,8 @@ Note that the style variables are always made local to the buffer."
(goto-char (match-beginning 1))
(setq m-beg (point))
(c-end-of-macro)
- (when (c-major-mode-is 'c++-mode)
- (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))))
+ (when c-ml-string-opener-re
+ (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))))
(c-clear-char-property-with-value
m-beg (point) 'syntax-table '(1)))))
@@ -1173,12 +1174,15 @@ Note that the style variables are always made local to the buffer."
)))))
(defun c-unescaped-nls-in-string-p (&optional quote-pos)
- ;; Return whether unescaped newlines can be inside strings.
+ ;; Return whether unescaped newlines can be inside strings. If the current
+ ;; language handles multi-line strings, the value of this function is always
+ ;; nil.
;;
;; QUOTE-POS, if present, is the position of the opening quote of a string.
;; Depending on the language, there might be a special character before it
;; signifying the validity of such NLs.
(cond
+ (c-ml-string-opener-re nil)
((null c-multiline-string-start-char) nil)
((c-characterp c-multiline-string-start-char)
(and quote-pos
@@ -1322,13 +1326,13 @@ Note that the style variables are always made local to the buffer."
(setq pos (c-min-property-position pos c-max-syn-tab-mkr
'c-fl-syn-tab))
(when (< pos c-max-syn-tab-mkr)
- (goto-char pos))
- (when (and (save-match-data
- (c-search-backward-char-property-with-value-on-char
- 'c-fl-syn-tab '(15) ?\"
- (max (- (point) 500) (point-min))))
- (not (equal (c-get-char-property (point) 'syntax-table) '(1))))
- (setq pos (1+ pos)))
+ (goto-char pos)
+ (when (and (save-match-data
+ (c-search-backward-char-property-with-value-on-char
+ 'c-fl-syn-tab '(15) ?\"
+ (max (- (point) 500) (point-min))))
+ (not (equal (c-get-char-property (point) 'syntax-table) '(1))))
+ (setq pos (1+ pos))))
(while (< pos c-max-syn-tab-mkr)
(setq pos
(c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
@@ -1434,7 +1438,8 @@ Note that the style variables are always made local to the buffer."
;; quotes up until the next unescaped EOL. Also guard against the change
;; being the insertion of \ before an EOL, escaping it.
(cond
- ((c-characterp c-multiline-string-start-char)
+ ((and (not c-ml-string-opener-re)
+ (c-characterp c-multiline-string-start-char))
;; The text about to be inserted might contain a multiline string
;; opener. Set c-new-END after anything which might be affected.
;; Go to the end of the putative multiline string.
@@ -1460,7 +1465,8 @@ Note that the style variables are always made local to the buffer."
(< (point) (point-max))))))
(setq c-new-END (max (point) c-new-END)))
- (c-multiline-string-start-char
+ ((and (not c-ml-string-opener-re)
+ c-multiline-string-start-char)
(setq c-bc-changed-stringiness
(not (eq (eq end-literal-type 'string)
(eq beg-literal-type 'string))))
@@ -1505,7 +1511,7 @@ Note that the style variables are always made local to the buffer."
;; Opening " at EOB.
(c-clear-syn-tab (1- (point))))
(when (and (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
- (memq (char-after) c-string-delims)) ; Ignore an unterminated raw string's (.
+ (memq (char-after) c-string-delims)) ; Ignore an unterminated ml string's (.
;; Opening " on last line of text (without EOL).
(c-remove-string-fences)
(setq c-new-BEG (min c-new-BEG (point))))))
@@ -1519,13 +1525,16 @@ Note that the style variables are always made local to the buffer."
(unless
(or (and
- ;; Don't set c-new-BEG/END if we're in a raw string.
+ ;; Don't set c-new-BEG/END if we're in an ml string.
+ c-ml-string-opener-re
(eq beg-literal-type 'string)
- (c-at-c++-raw-string-opener (car beg-limits)))
+ (c-ml-string-opener-at-or-around-point (car beg-limits)))
(and c-multiline-string-start-char
+ (not c-ml-string-opener-re)
(not (c-characterp c-multiline-string-start-char))))
(when (and (eq end-literal-type 'string)
- (not (eq (char-before (cdr end-limits)) ?\())
+ (or (memq (char-before (cdr end-limits)) c-string-delims)
+ (memq (char-before (cdr end-limits)) '(?\n ?\r)))
(memq (char-after (car end-limits)) c-string-delims))
(setq c-new-END (max c-new-END (cdr end-limits)))
(when (equal (c-get-char-property (car end-limits) 'syntax-table)
@@ -1548,6 +1557,7 @@ Note that the style variables are always made local to the buffer."
;; This function is called exclusively as an after-change function via
;; `c-before-font-lock-functions'.
(if (and c-multiline-string-start-char
+ (not c-ml-string-opener-re)
(not (c-characterp c-multiline-string-start-char)))
;; Only the last " might need to be marked.
(c-save-buffer-state
@@ -1590,6 +1600,7 @@ Note that the style variables are always made local to the buffer."
((and (null beg-literal-type)
(goto-char beg)
(and (not (bobp))
+ (not c-ml-string-opener-re)
(eq (char-before) c-multiline-string-start-char))
(memq (char-after) c-string-delims))
(cons (point)
@@ -1614,6 +1625,7 @@ Note that the style variables are always made local to the buffer."
(point))
c-new-END))
s)
+
(goto-char
(cond ((null beg-literal-type)
c-new-BEG)
@@ -1637,8 +1649,9 @@ Note that the style variables are always made local to the buffer."
(and (memq (char-before) c-string-delims)
(not (nth 4 s))))) ; Check we're actually out of the
; comment. not stuck at EOB
- (unless (and (c-major-mode-is 'c++-mode)
- (c-maybe-re-mark-raw-string))
+ (unless
+ (and c-ml-string-opener-re
+ (c-maybe-re-mark-ml-string))
(if (c-unescaped-nls-in-string-p (1- (point)))
(looking-at "\\(\\\\\\(.\\|\n\\)\\|[^\"]\\)*")
(looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
@@ -1677,21 +1690,15 @@ Note that the style variables are always made local to the buffer."
(progn (goto-char end)
(setq lit-start (c-literal-start)))
(memq (char-after lit-start) c-string-delims)
- (or (not (c-major-mode-is 'c++-mode))
+ (or (not c-ml-string-opener-re)
(progn
(goto-char lit-start)
- (and (not (and (eq (char-before) ?R)
- (looking-at c-c++-raw-string-opener-1-re)))
- (not (and (eq (char-after) ?\()
- (equal (c-get-char-property
- (point) 'syntax-table)
- '(15))))))
+ (not (c-ml-string-opener-at-or-around-point)))
(save-excursion
(c-beginning-of-macro))))
(goto-char (1+ end)) ; After the \
- ;; Search forward for EOLL
- (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
- nil t))
+ ;; Search forward for EOLL.
+ (setq lim (c-point 'eoll))
(goto-char (1+ end))
(when (c-search-forward-char-property-with-value-on-char
'syntax-table '(15) ?\" lim)
@@ -2503,6 +2510,7 @@ This function is called from `c-common-init', once per mode initialization."
;; Emacs < 22 and XEmacs
(defmacro c-advise-fl-for-region (function)
+ (declare (debug t))
`(defadvice ,function (before get-awk-region activate)
;; Make sure that any string/regexp is completely font-locked.
(when c-buffer-is-cc-mode
@@ -2977,7 +2985,7 @@ Key bindings:
;; bug reporting
(defconst c-mode-help-address
- "submit@debbugs.gnu.org"
+ "bug-gnu-emacs@gnu.org"
"Address(es) for CC Mode bug reports.")
(defun c-version ()
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index aec259f1b38..8514434e9ac 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -1,4 +1,4 @@
-;;; cc-styles.el --- support for styles in CC Mode
+;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -374,7 +374,7 @@ in this way.
If DONT-OVERRIDE is t, style variables that already have values (i.e., whose
values are not the symbol `set-from-style') will not be overridden. CC Mode
calls c-set-style internally in this way whilst initializing a buffer; if
-cc-set-style is called like this from anywhere else, it will usually behave as
+c-set-style is called like this from anywhere else, it will usually behave as
a null operation."
(interactive
(list (let ((completion-ignore-case t)
@@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil."
offset))
;;;###autoload
-(defun c-set-offset (symbol offset &optional ignored)
+(defun c-set-offset (symbol offset &optional _ignored)
"Change the value of a syntactic element symbol in `c-offsets-alist'.
SYMBOL is the syntactic element symbol to change and OFFSET is the new
offset for that syntactic element. The optional argument is not used
@@ -476,8 +476,8 @@ and exists only for compatibility reasons."
(if current-prefix-arg " or add" "")
": ")
(mapcar
- #'(lambda (langelem)
- (cons (format "%s" (car langelem)) nil))
+ (lambda (langelem)
+ (cons (format "%s" (car langelem)) nil))
(get 'c-offsets-alist 'c-stylevar-fallback))
nil (not current-prefix-arg)
;; initial contents tries to be the last element
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 88ee092da79..b33fea0b48c 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1,4 +1,4 @@
-;;; cc-vars.el --- user customization variables for CC Mode
+;;; cc-vars.el --- user customization variables for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc.
@@ -42,6 +42,9 @@
(cc-require 'cc-defs)
+(defvar c-syntactic-context)
+(defvar c-syntactic-element)
+
(cc-eval-when-compile
(require 'custom)
(require 'widget))
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index f516664f7f4..4649e506541 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1,4 +1,4 @@
-;;; cfengine.el --- mode for editing Cfengine files
+;;; cfengine.el --- mode for editing Cfengine files -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -69,7 +69,6 @@
(defcustom cfengine-indent 2
"Size of a CFEngine indentation step in columns."
- :group 'cfengine
:type 'integer)
(defcustom cfengine-cf-promises
@@ -86,7 +85,6 @@ Used for syntax discovery and checking. Set to nil to disable
the `compile-command' override. In that case, the ElDoc support
will use a fallback syntax definition."
:version "24.4"
- :group 'cfengine
:type '(choice file (const nil)))
(defcustom cfengine-parameters-indent '(promise pname 2)
@@ -145,7 +143,6 @@ bundle agent rcfiles
}
"
:version "24.4"
- :group 'cfengine
:type '(list
(choice (const :tag "Anchor at beginning of promise" promise)
(const :tag "Anchor at beginning of line" bol))
@@ -799,7 +796,6 @@ bundle agent rcfiles
(defcustom cfengine-mode-abbrevs nil
"Abbrevs for CFEngine2 mode."
- :group 'cfengine
:type '(repeat (list (string :tag "Name")
(string :tag "Expansion")
(choice :tag "Hook" (const nil) function))))
@@ -991,13 +987,11 @@ Intended as the value of `indent-line-function'."
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))))
-;; This doesn't work too well in Emacs 21.2. See 22.1 development
-;; code.
(defun cfengine-fill-paragraph (&optional justify)
"Fill `paragraphs' in Cfengine code."
(interactive "P")
(or (if (fboundp 'fill-comment-paragraph)
- (fill-comment-paragraph justify) ; post Emacs 21.3
+ (fill-comment-paragraph justify)
;; else do nothing in a comment
(nth 4 (parse-partial-sexp (save-excursion
(beginning-of-defun)
@@ -1446,7 +1440,7 @@ to the action header."
(cfengine3-mode)
(cfengine2-mode)))
-(defalias 'cfengine-mode 'cfengine3-mode)
+(defalias 'cfengine-mode #'cfengine3-mode)
(provide 'cfengine3)
(provide 'cfengine)
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 1a45b1cb838..0f7c8c6f31a 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -1,7 +1,6 @@
-;;; cmacexp.el --- expand C macros in a region
+;;; cmacexp.el --- expand C macros in a region -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
;; Author: Francesco Potortì <pot@gnu.org>
;; Adapted-By: ESR
@@ -33,20 +32,20 @@
;; USAGE =============================================================
-;; In C mode C-C C-e is bound to c-macro-expand. The result of the
+;; In C mode C-c C-e is bound to `c-macro-expand'. The result of the
;; expansion is put in a separate buffer. A user option allows the
;; window displaying the buffer to be optimally sized.
;;
-;; When called with a C-u prefix, c-macro-expand replaces the selected
+;; When called with a C-u prefix, `c-macro-expand' replaces the selected
;; region with the expansion. Both the preprocessor name and the
-;; initial flag can be set by the user. If c-macro-prompt-flag is set
+;; initial flag can be set by the user. If `c-macro-prompt-flag' is set
;; to a non-nil value the user is offered to change the options to the
-;; preprocessor each time c-macro-expand is invoked. Preprocessor
-;; arguments default to the last ones entered. If c-macro-prompt-flag
+;; preprocessor each time `c-macro-expand' is invoked. Preprocessor
+;; arguments default to the last ones entered. If `c-macro-prompt-flag'
;; is nil, one must use M-x set-variable to set a different value for
-;; c-macro-cppflags.
+;; `c-macro-cppflags'.
-;; A c-macro-expansion function is provided for non-interactive use.
+;; A `c-macro-expansion' function is provided for non-interactive use.
;; INSTALLATION ======================================================
@@ -54,18 +53,22 @@
;; If you want the *Macroexpansion* window to be not higher than
;; necessary:
-;;(setq c-macro-shrink-window-flag t)
+;;
+;; (setq c-macro-shrink-window-flag t)
;;
;; If you use a preprocessor other than /lib/cpp (be careful to set a
;; -C option or equivalent in order to make the preprocessor not to
;; strip the comments):
-;;(setq c-macro-preprocessor "gpp -C")
+;;
+;; (setq c-macro-preprocessor "gpp -C")
;;
;; If you often use a particular set of flags:
-;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG"
+;;
+;; (setq c-macro-cppflags "-I /usr/include/local -DDEBUG"
;;
;; If you want the "Preprocessor arguments: " prompt:
-;;(setq c-macro-prompt-flag t)
+;;
+;; (setq c-macro-prompt-flag t)
;; BUG REPORTS =======================================================
@@ -87,25 +90,19 @@
(require 'cc-mode)
-(provide 'cmacexp)
-
(defvar msdos-shells)
-
(defgroup c-macro nil
"Expand C macros in a region."
:group 'c)
-
(defcustom c-macro-shrink-window-flag nil
"Non-nil means shrink the *Macroexpansion* window to fit its contents."
- :type 'boolean
- :group 'c-macro)
+ :type 'boolean)
(defcustom c-macro-prompt-flag nil
"Non-nil makes `c-macro-expand' prompt for preprocessor arguments."
- :type 'boolean
- :group 'c-macro)
+ :type 'boolean)
(defcustom c-macro-preprocessor
(cond ;; Solaris has it in an unusual place.
@@ -129,13 +126,11 @@
If you change this, be sure to preserve the `-C' (don't strip comments)
option, or to set an equivalent one."
- :type 'string
- :group 'c-macro)
+ :type 'string)
(defcustom c-macro-cppflags ""
"Preprocessor flags used by `c-macro-expand'."
- :type 'string
- :group 'c-macro)
+ :type 'string)
(defconst c-macro-buffer-name "*Macroexpansion*")
@@ -146,7 +141,7 @@ Normally display output in temp buffer, but
prefix arg means replace the region with it.
`c-macro-preprocessor' specifies the preprocessor to use.
-Tf the user option `c-macro-prompt-flag' is non-nil
+If the user option `c-macro-prompt-flag' is non-nil
prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include'),
otherwise use `c-macro-cppflags'.
@@ -396,4 +391,6 @@ Optional arg DISPLAY non-nil means show messages in the echo area."
;; Cleanup.
(kill-buffer outbuf))))
+(provide 'cmacexp)
+
;;; cmacexp.el ends here
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 48b5ee99736..1fb6124ab56 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -173,6 +173,7 @@ and a string describing how the process finished.")
;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
(defvar compilation-error-regexp-alist-alist
+ (eval-when-compile
`((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -615,7 +616,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
;; we do not know what lines will follow.
(guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
(guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
- )
+ ))
"Alist of values for `compilation-error-regexp-alist'.")
(defcustom compilation-error-regexp-alist
@@ -1248,11 +1249,14 @@ POS and RES.")
(setq col (match-string-no-properties col))
(string-to-number col))))
(setq end-col
- (or (if (functionp end-col) (funcall end-col)
- (and end-col
- (setq end-col (match-string-no-properties end-col))
- (- (string-to-number end-col) -1)))
- (and end-line -1)))
+ (let ((ec (if (functionp end-col)
+ (funcall end-col)
+ (and end-col (match-beginning end-col)
+ (string-to-number
+ (match-string-no-properties end-col))))))
+ (if ec
+ (1+ ec) ; Add one to get an exclusive upper bound.
+ (and end-line -1))))
(if (consp type) ; not a static type, check what it is.
(setq type (or (and (car type) (match-end (car type)) 1)
(and (cdr type) (match-end (cdr type)) 0)
@@ -1540,7 +1544,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
file line end-line col end-col
(or type 2) fmt rule))
- (when (integerp file)
+ (when file
(let ((this-type (if (consp type)
(compilation-type type)
(or type 2))))
@@ -2844,8 +2848,9 @@ and overlay is highlighted between MK and END-MK."
(when (and (not pre-existing) w)
(compilation-set-window-height w))
- (if from-compilation-buffer
- ;; If the compilation buffer window was selected,
+ (if (or from-compilation-buffer
+ (eq w (selected-window)))
+ ;; If the compilation buffer window is selected,
;; keep the compilation buffer in this window;
;; display the source in another window.
(let ((pop-up-windows t))
@@ -3040,12 +3045,7 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; Get the specified directory from FILE.
(spec-directory
(if (cdr file)
- ;; This function is active in `compilation-filter'.
- ;; There could be problems to call `file-truename'
- ;; for remote compilation processes.
- (if (file-remote-p default-directory)
- (concat comint-file-name-prefix (cdr file))
- (file-truename (concat comint-file-name-prefix (cdr file)))))))
+ (file-truename (concat comint-file-name-prefix (cdr file))))))
;; Check for a comint-file-name-prefix and prepend it if appropriate.
;; (This is very useful for compilation-minor-mode in an rlogin-mode
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index a70e8e36c0b..3370df64919 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -92,6 +92,7 @@
(concat msg ": ")))))
(eval-when-compile (require 'cl-lib))
+(require 'facemenu)
(defvar msb-menu-cond)
(defvar gud-perldb-history)
@@ -440,12 +441,6 @@ after reload."
:type 'boolean
:group 'cperl-speed)
-(defcustom cperl-imenu-addback nil
- "Not-nil means add backreferences to generated `imenu's.
-May require patched `imenu' and `imenu-go'. Obsolete."
- :type 'boolean
- :group 'cperl-help-system)
-
(defcustom cperl-max-help-size 66
"Non-nil means shrink-wrapping of info-buffer allowed up to these percents."
:type '(choice integer (const nil))
@@ -659,8 +654,8 @@ Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing.
Switch auto-help on/off with Perl/Tools/Auto-help.
-Though with contemporary Emaxen CPerl mode should maintain the correct
-parsing of Perl even when editing, sometimes it may be lost. Fix this by
+Though CPerl mode should maintain the correct parsing of Perl even when
+editing, sometimes it may be lost. Fix this by
\\[normal-mode]
@@ -676,63 +671,20 @@ micro-docs on what I know about CPerl problems.")
"Description of problems in CPerl mode.
`fill-paragraph' on a comment may leave the point behind the
paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
-to detect it and bulk out).
-
-See documentation of a variable `cperl-problems-old-emaxen' for the
-problems which disappear if you upgrade Emacs to a reasonably new
-version (20.3 for Emacs).")
+to detect it and bulk out).")
(defvar cperl-problems-old-emaxen 'please-ignore-this-line
- "Description of problems in CPerl mode specific for older Emacs versions.
-
-Emacs had a _very_ restricted syntax parsing engine until version
-20.1. Most problems below are corrected starting from this version of
-Emacs, and all of them should be fixed in version 20.3. (Or apply
-patches to Emacs 19.33/34 - see tips.)
-
-Note that even with newer Emacsen in some very rare cases the details
-of interaction of `font-lock' and syntaxification may be not cleaned
-up yet. You may get slightly different colors basing on the order of
-fontification and syntaxification. Say, the initial faces is correct,
-but editing the buffer breaks this.
-
-Even with older Emacsen CPerl mode tries to corrects some Emacs
-misunderstandings, however, for efficiency reasons the degree of
-correction is different for different operations. The partially
-corrected problems are: POD sections, here-documents, regexps. The
-operations are: highlighting, indentation, electric keywords, electric
-braces.
-
-This may be confusing, since the regexp s#//#/#; may be highlighted
-as a comment, but it will be recognized as a regexp by the indentation
-code. Or the opposite case, when a POD section is highlighted, but
-may break the indentation of the following code (though indentation
-should work if the balance of delimiters is not broken by POD).
-
-The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think of is
-to insert it as $ {aaa} (valid in perl5, not in perl4).
-
-Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transposition is not always possible.
-
-The solution is to upgrade your Emacs or patch an older one. Note
-that Emacs 20.2 has some bugs related to `syntax-table' text
-properties. Patches are available on the main CPerl download site,
-and on CPAN.
-
-If these bugs cannot be fixed on your machine (say, you have an inferior
-environment and cannot recompile), you may still disable all the fancy stuff
-via `cperl-use-syntax-table-text-property'.")
+ "This used to contain a description of problems in CPerl mode
+specific for very old Emacs versions. This is no longer relevant
+and has been removed.")
+(make-obsolete-variable 'cperl-problems-old-emaxen nil "28.1")
(defvar cperl-praise 'please-ignore-this-line
"Advantages of CPerl mode.
0) It uses the newest `syntax-table' property ;-);
-1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
-mode - but the latter number may have improved too in last years) even
-with old Emaxen which do not support `syntax-table' property.
+1) It does 99% of Perl syntax correct.
When using `syntax-table' property for syntax assist hints, it should
handle 99.995% of lines correct - or somesuch. It automatically
@@ -813,8 +765,7 @@ the settings present before the switch.
9) When doing indentation of control constructs, may correct
line-breaks/spacing between elements of the construct.
-10) Uses a linear-time algorithm for indentation of regions (on Emaxen with
-capable syntax engines).
+10) Uses a linear-time algorithm for indentation of regions.
11) Syntax-highlight, indentation, sexp-recognition inside regular expressions.
")
@@ -838,8 +789,8 @@ syntax-parsing routines, and marks them up so that either
A1) CPerl may work around these deficiencies (for big chunks, mostly
PODs and HERE-documents), or
- A2) On capable Emaxen CPerl will use improved syntax-handling
- which reads mark-up hints directly.
+ A2) CPerl will use improved syntax-handling which reads mark-up
+ hints directly.
The scan in case A2 is much more comprehensive, thus may be slower.
@@ -957,22 +908,12 @@ In regular expressions (including character classes):
(defun cperl-make-indent (column &optional minimum keep)
- "Makes indent of the current line the requested amount.
-Unless KEEP, removes the old indentation. Works around a bug in ancient
-versions of Emacs."
- (let ((prop (get-text-property (point) 'syntax-type)))
- (or keep
- (delete-horizontal-space))
- (indent-to column minimum)
- ;; In old versions (e.g., 19.33) `indent-to' would not inherit properties
- (and prop
- (> (current-column) 0)
- (save-excursion
- (beginning-of-line)
- (or (get-text-property (point) 'syntax-type)
- (and (looking-at "\\=[ \t]")
- (put-text-property (point) (match-end 0)
- 'syntax-type prop)))))))
+ "Indent from point with tabs and spaces until COLUMN is reached.
+MINIMUM is like in `indent-to', which see.
+Unless KEEP, removes the old indentation."
+ (or keep
+ (delete-horizontal-space))
+ (indent-to column minimum))
;; Probably it is too late to set these guys already, but it can help later:
@@ -1019,9 +960,12 @@ versions of Emacs."
"Abbrev table in use in CPerl mode buffers."
:parents (list cperl-mode-electric-keywords-abbrev-table))
-(when (boundp 'edit-var-mode-alist)
- ;; FIXME: What package uses this?
- (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))))
+;; ;; TODO: Commented out as we don't know what it is used for. If
+;; ;; there are no bug reports about this for Emacs 28.1, this
+;; ;; can probably be removed. (Code search online reveals nothing.)
+;; (when (boundp 'edit-var-mode-alist)
+;; ;; FIXME: What package uses this?
+;; (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))))
(defvar cperl-mode-map
(let ((map (make-sparse-keymap)))
@@ -1091,172 +1035,314 @@ versions of Emacs."
map)
"Keymap used in CPerl mode.")
-(defvar cperl-menu)
(defvar cperl-lazy-installed)
(defvar cperl-old-style nil)
-(condition-case nil
- (progn
- (require 'easymenu)
- (easy-menu-define
- cperl-menu cperl-mode-map "Menu for CPerl mode"
- '("Perl"
- ["Beginning of function" beginning-of-defun t]
- ["End of function" end-of-defun t]
- ["Mark function" mark-defun t]
- ["Indent expression" cperl-indent-exp t]
- ["Fill paragraph/comment" fill-paragraph t]
- "----"
- ["Line up a construction" cperl-lineup (use-region-p)]
- ["Invert if/unless/while etc" cperl-invert-if-unless t]
- ("Regexp"
- ["Beautify" cperl-beautify-regexp
- cperl-use-syntax-table-text-property]
- ["Beautify one level deep" (cperl-beautify-regexp 1)
- cperl-use-syntax-table-text-property]
- ["Beautify a group" cperl-beautify-level
- cperl-use-syntax-table-text-property]
- ["Beautify a group one level deep" (cperl-beautify-level 1)
- cperl-use-syntax-table-text-property]
- ["Contract a group" cperl-contract-level
- cperl-use-syntax-table-text-property]
- ["Contract groups" cperl-contract-levels
- cperl-use-syntax-table-text-property]
- "----"
- ["Find next interpolated" cperl-next-interpolated-REx
- (next-single-property-change (point-min) 'REx-interpolated)]
- ["Find next interpolated (no //o)"
- cperl-next-interpolated-REx-0
- (or (text-property-any (point-min) (point-max) 'REx-interpolated t)
- (text-property-any (point-min) (point-max) 'REx-interpolated 1))]
- ["Find next interpolated (neither //o nor whole-REx)"
- cperl-next-interpolated-REx-1
- (text-property-any (point-min) (point-max) 'REx-interpolated t)])
- ["Insert spaces if needed to fix style" cperl-find-bad-style t]
- ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
- "----"
- ["Indent region" cperl-indent-region (use-region-p)]
- ["Comment region" cperl-comment-region (use-region-p)]
- ["Uncomment region" cperl-uncomment-region (use-region-p)]
- "----"
- ["Run" mode-compile (fboundp 'mode-compile)]
- ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
- (get-buffer "*compilation*"))]
- ["Next error" next-error (get-buffer "*compilation*")]
- ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
- "----"
- ["Debugger" cperl-db t]
- "----"
- ("Tools"
- ["Imenu" imenu (fboundp 'imenu)]
- ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)]
- "----"
- ["Ispell PODs" cperl-pod-spell
- ;; Better not to update syntaxification here:
- ;; debugging syntaxification can be broken by this???
- (or
- (get-text-property (point-min) 'in-pod)
- (< (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point-max)))
- (next-single-property-change (point-min) 'in-pod nil (point-max)))
- (point-max)))]
- ["Ispell HERE-DOCs" cperl-here-doc-spell
- (< (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point-max)))
- (next-single-property-change (point-min) 'here-doc-group nil (point-max)))
- (point-max))]
- ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc
- (eq 'here-doc (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point)))
- (get-text-property (point) 'syntax-type)))]
- ["Select this HERE-DOC or POD section"
- cperl-select-this-pod-or-here-doc
- (memq (progn
- (and cperl-syntaxify-for-menu
- (cperl-update-syntaxification (point)))
- (get-text-property (point) 'syntax-type))
- '(here-doc pod))]
- "----"
- ["CPerl pretty print (experimental)" cperl-ps-print
- (fboundp 'ps-extend-face-list)]
- "----"
- ["Syntaxify region" cperl-find-pods-heres-region
- (use-region-p)]
- ["Profile syntaxification" cperl-time-fontification t]
- ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t]
- ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t]
- ["Debug backtrace on syntactic scan (BEWARE!!!)"
- (cperl-toggle-set-debug-unwind nil t) t]
- "----"
- ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
- ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
- ("Tags"
- ;; ["Create tags for current file" cperl-etags t]
- ;; ["Add tags for current file" (cperl-etags t) t]
- ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t]
- ;; ["Add tags for Perl files in directory" (cperl-etags t t) t]
- ;; ["Create tags for Perl files in (sub)directories"
- ;; (cperl-etags nil 'recursive) t]
- ;; ["Add tags for Perl files in (sub)directories"
- ;; (cperl-etags t 'recursive) t])
- ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer)
- ["Create tags for current file" (cperl-write-tags nil t) t]
- ["Add tags for current file" (cperl-write-tags) t]
- ["Create tags for Perl files in directory"
- (cperl-write-tags nil t nil t) t]
- ["Add tags for Perl files in directory"
- (cperl-write-tags nil nil nil t) t]
- ["Create tags for Perl files in (sub)directories"
- (cperl-write-tags nil t t t) t]
- ["Add tags for Perl files in (sub)directories"
- (cperl-write-tags nil nil t t) t]))
- ("Perl docs"
- ["Define word at point" imenu-go-find-at-position
- (fboundp 'imenu-go-find-at-position)]
- ["Help on function" cperl-info-on-command t]
- ["Help on function at point" cperl-info-on-current-command t]
- ["Help on symbol at point" cperl-get-help t]
- ["Perldoc" cperl-perldoc t]
- ["Perldoc on word at point" cperl-perldoc-at-point t]
- ["View manpage of POD in this file" cperl-build-manpage t]
- ["Auto-help on" cperl-lazy-install
- (not cperl-lazy-installed)]
- ["Auto-help off" cperl-lazy-unstall
- cperl-lazy-installed])
- ("Toggle..."
- ["Auto newline" cperl-toggle-auto-newline t]
- ["Electric parens" cperl-toggle-electric t]
- ["Electric keywords" cperl-toggle-abbrev t]
- ["Fix whitespace on indent" cperl-toggle-construct-fix t]
- ["Auto-help on Perl constructs" cperl-toggle-autohelp t]
- ["Auto fill" auto-fill-mode t])
- ("Indent styles..."
- ["CPerl" (cperl-set-style "CPerl") t]
- ["PBP" (cperl-set-style "PBP") t]
- ["PerlStyle" (cperl-set-style "PerlStyle") t]
- ["GNU" (cperl-set-style "GNU") t]
- ["C++" (cperl-set-style "C++") t]
- ["K&R" (cperl-set-style "K&R") t]
- ["BSD" (cperl-set-style "BSD") t]
- ["Whitesmith" (cperl-set-style "Whitesmith") t]
- ["Memorize Current" (cperl-set-style "Current") t]
- ["Memorized" (cperl-set-style-back) cperl-old-style])
- ("Micro-docs"
- ["Tips" (describe-variable 'cperl-tips) t]
- ["Problems" (describe-variable 'cperl-problems) t]
- ["Speed" (describe-variable 'cperl-speed) t]
- ["Praise" (describe-variable 'cperl-praise) t]
- ["Faces" (describe-variable 'cperl-tips-faces) t]
- ["CPerl mode" (describe-function 'cperl-mode) t]))))
- (error nil))
+(easy-menu-define cperl-menu cperl-mode-map
+ "Menu for CPerl mode."
+ '("Perl"
+ ["Beginning of function" beginning-of-defun t]
+ ["End of function" end-of-defun t]
+ ["Mark function" mark-defun t]
+ ["Indent expression" cperl-indent-exp t]
+ ["Fill paragraph/comment" fill-paragraph t]
+ "----"
+ ["Line up a construction" cperl-lineup (use-region-p)]
+ ["Invert if/unless/while etc" cperl-invert-if-unless t]
+ ("Regexp"
+ ["Beautify" cperl-beautify-regexp
+ cperl-use-syntax-table-text-property]
+ ["Beautify one level deep" (cperl-beautify-regexp 1)
+ cperl-use-syntax-table-text-property]
+ ["Beautify a group" cperl-beautify-level
+ cperl-use-syntax-table-text-property]
+ ["Beautify a group one level deep" (cperl-beautify-level 1)
+ cperl-use-syntax-table-text-property]
+ ["Contract a group" cperl-contract-level
+ cperl-use-syntax-table-text-property]
+ ["Contract groups" cperl-contract-levels
+ cperl-use-syntax-table-text-property]
+ "----"
+ ["Find next interpolated" cperl-next-interpolated-REx
+ (next-single-property-change (point-min) 'REx-interpolated)]
+ ["Find next interpolated (no //o)"
+ cperl-next-interpolated-REx-0
+ (or (text-property-any (point-min) (point-max) 'REx-interpolated t)
+ (text-property-any (point-min) (point-max) 'REx-interpolated 1))]
+ ["Find next interpolated (neither //o nor whole-REx)"
+ cperl-next-interpolated-REx-1
+ (text-property-any (point-min) (point-max) 'REx-interpolated t)])
+ ["Insert spaces if needed to fix style" cperl-find-bad-style t]
+ ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
+ "----"
+ ["Indent region" cperl-indent-region (use-region-p)]
+ ["Comment region" cperl-comment-region (use-region-p)]
+ ["Uncomment region" cperl-uncomment-region (use-region-p)]
+ "----"
+ ["Run" mode-compile (fboundp 'mode-compile)]
+ ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
+ (get-buffer "*compilation*"))]
+ ["Next error" next-error (get-buffer "*compilation*")]
+ ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
+ "----"
+ ["Debugger" cperl-db t]
+ "----"
+ ("Tools"
+ ["Imenu" imenu (fboundp 'imenu)]
+ ["Imenu on Perl Info" cperl-imenu-on-info (featurep 'imenu)]
+ "----"
+ ["Ispell PODs" cperl-pod-spell
+ ;; Better not to update syntaxification here:
+ ;; debugging syntaxification can be broken by this???
+ (or
+ (get-text-property (point-min) 'in-pod)
+ (< (progn
+ (and cperl-syntaxify-for-menu
+ (cperl-update-syntaxification (point-max)))
+ (next-single-property-change (point-min) 'in-pod nil (point-max)))
+ (point-max)))]
+ ["Ispell HERE-DOCs" cperl-here-doc-spell
+ (< (progn
+ (and cperl-syntaxify-for-menu
+ (cperl-update-syntaxification (point-max)))
+ (next-single-property-change (point-min) 'here-doc-group nil (point-max)))
+ (point-max))]
+ ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc
+ (eq 'here-doc (progn
+ (and cperl-syntaxify-for-menu
+ (cperl-update-syntaxification (point)))
+ (get-text-property (point) 'syntax-type)))]
+ ["Select this HERE-DOC or POD section"
+ cperl-select-this-pod-or-here-doc
+ (memq (progn
+ (and cperl-syntaxify-for-menu
+ (cperl-update-syntaxification (point)))
+ (get-text-property (point) 'syntax-type))
+ '(here-doc pod))]
+ "----"
+ ["CPerl pretty print (experimental)" cperl-ps-print
+ (fboundp 'ps-extend-face-list)]
+ "----"
+ ["Syntaxify region" cperl-find-pods-heres-region
+ (use-region-p)]
+ ["Profile syntaxification" cperl-time-fontification t]
+ ["Debug errors in delayed fontification" cperl-emulate-lazy-lock t]
+ ["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t]
+ ["Debug backtrace on syntactic scan (BEWARE!!!)"
+ (cperl-toggle-set-debug-unwind nil t) t]
+ "----"
+ ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
+ ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
+ ("Tags"
+ ;; ["Create tags for current file" cperl-etags t]
+ ;; ["Add tags for current file" (cperl-etags t) t]
+ ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t]
+ ;; ["Add tags for Perl files in directory" (cperl-etags t t) t]
+ ;; ["Create tags for Perl files in (sub)directories"
+ ;; (cperl-etags nil 'recursive) t]
+ ;; ["Add tags for Perl files in (sub)directories"
+ ;; (cperl-etags t 'recursive) t])
+ ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer)
+ ["Create tags for current file" (cperl-write-tags nil t) t]
+ ["Add tags for current file" (cperl-write-tags) t]
+ ["Create tags for Perl files in directory"
+ (cperl-write-tags nil t nil t) t]
+ ["Add tags for Perl files in directory"
+ (cperl-write-tags nil nil nil t) t]
+ ["Create tags for Perl files in (sub)directories"
+ (cperl-write-tags nil t t t) t]
+ ["Add tags for Perl files in (sub)directories"
+ (cperl-write-tags nil nil t t) t]))
+ ("Perl docs"
+ ["Define word at point" imenu-go-find-at-position
+ (fboundp 'imenu-go-find-at-position)]
+ ["Help on function" cperl-info-on-command t]
+ ["Help on function at point" cperl-info-on-current-command t]
+ ["Help on symbol at point" cperl-get-help t]
+ ["Perldoc" cperl-perldoc t]
+ ["Perldoc on word at point" cperl-perldoc-at-point t]
+ ["View manpage of POD in this file" cperl-build-manpage t]
+ ["Auto-help on" cperl-lazy-install
+ (not cperl-lazy-installed)]
+ ["Auto-help off" cperl-lazy-unstall
+ cperl-lazy-installed])
+ ("Toggle..."
+ ["Auto newline" cperl-toggle-auto-newline t]
+ ["Electric parens" cperl-toggle-electric t]
+ ["Electric keywords" cperl-toggle-abbrev t]
+ ["Fix whitespace on indent" cperl-toggle-construct-fix t]
+ ["Auto-help on Perl constructs" cperl-toggle-autohelp t]
+ ["Auto fill" auto-fill-mode t])
+ ("Indent styles..."
+ ["CPerl" (cperl-set-style "CPerl") t]
+ ["PBP" (cperl-set-style "PBP") t]
+ ["PerlStyle" (cperl-set-style "PerlStyle") t]
+ ["GNU" (cperl-set-style "GNU") t]
+ ["C++" (cperl-set-style "C++") t]
+ ["K&R" (cperl-set-style "K&R") t]
+ ["BSD" (cperl-set-style "BSD") t]
+ ["Whitesmith" (cperl-set-style "Whitesmith") t]
+ ["Memorize Current" (cperl-set-style "Current") t]
+ ["Memorized" (cperl-set-style-back) cperl-old-style])
+ ("Micro-docs"
+ ["Tips" (describe-variable 'cperl-tips) t]
+ ["Problems" (describe-variable 'cperl-problems) t]
+ ["Speed" (describe-variable 'cperl-speed) t]
+ ["Praise" (describe-variable 'cperl-praise) t]
+ ["Faces" (describe-variable 'cperl-tips-faces) t]
+ ["CPerl mode" (describe-function 'cperl-mode) t])))
(autoload 'c-macro-expand "cmacexp"
"Display the result of expanding all C macros occurring in the region.
The expansion is entirely correct because it uses the C preprocessor."
t)
+
+;;; Perl Grammar Components
+;;
+;; The following regular expressions are building blocks for a
+;; minimalistic Perl grammar, to be used instead of individual (and
+;; not always consistent) literal regular expressions.
+
+(defconst cperl--basic-identifier-regexp
+ (rx (sequence (or alpha "_") (* (or word "_"))))
+ "A regular expression for the name of a \"basic\" Perl variable.
+Neither namespace separators nor sigils are included. As is,
+this regular expression applies to labels,subroutine calls where
+the ampersand sigil is not required, and names of subroutine
+attributes.")
+
+(defconst cperl--label-regexp
+ (rx-to-string
+ `(sequence
+ symbol-start
+ (regexp ,cperl--basic-identifier-regexp)
+ (0+ space)
+ ":"))
+ "A regular expression for a Perl label.
+By convention, labels are uppercase alphabetics, but this isn't
+enforced.")
+
+(defconst cperl--normal-identifier-regexp
+ (rx-to-string
+ `(or
+ (sequence
+ (1+ (sequence
+ (opt (regexp ,cperl--basic-identifier-regexp))
+ "::"))
+ (opt (regexp ,cperl--basic-identifier-regexp)))
+ (regexp ,cperl--basic-identifier-regexp)))
+ "A regular expression for a Perl variable name with optional namespace.
+Examples are `foo`, `Some::Module::VERSION`, and `::` (yes, that
+is a legal variable name).")
+
+(defconst cperl--special-identifier-regexp
+ (rx-to-string
+ `(or
+ (1+ digit) ; $0, $1, $2, ...
+ (sequence "^" (any "A-Z" "]^_?\\")) ; $^V
+ (sequence "{" (0+ space) ; ${^MATCH}
+ "^" (any "A-Z" "]^_?\\")
+ (0+ (any "A-Z" "_" digit))
+ (0+ space) "}")
+ (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~"))) ; $., $|, $", ... but not $^ or ${
+ "The list of Perl \"punctuation\" variables, as listed in perlvar.")
+
+(defconst cperl--ws-regexp
+ (rx-to-string
+ '(or space "\n"))
+ "Regular expression for a single whitespace in Perl.")
+
+(defconst cperl--eol-comment-regexp
+ (rx-to-string
+ '(sequence "#" (0+ (not (in "\n"))) "\n"))
+ "Regular expression for a single end-of-line comment in Perl")
+
+(defconst cperl--ws-or-comment-regexp
+ (rx-to-string
+ `(1+
+ (or
+ (regexp ,cperl--ws-regexp)
+ (regexp ,cperl--eol-comment-regexp))))
+ "Regular expression for a sequence of whitespace and comments in Perl.")
+
+(defconst cperl--ows-regexp
+ (rx-to-string
+ `(opt (regexp ,cperl--ws-or-comment-regexp)))
+ "Regular expression for optional whitespaces or comments in Perl")
+
+(defconst cperl--version-regexp
+ (rx-to-string
+ `(or
+ (sequence (opt "v")
+ (>= 2 (sequence (1+ digit) "."))
+ (1+ digit)
+ (opt (sequence "_" (1+ word))))
+ (sequence (1+ digit)
+ (opt (sequence "." (1+ digit)))
+ (opt (sequence "_" (1+ word))))))
+ "A sequence for recommended version number schemes in Perl.")
+
+(defconst cperl--package-regexp
+ (rx-to-string
+ `(sequence
+ "package" ; FIXME: the "class" and "role" keywords need to be
+ ; recognized soon...ish.
+ (regexp ,cperl--ws-or-comment-regexp)
+ (group (regexp ,cperl--normal-identifier-regexp))
+ (opt
+ (sequence
+ (regexp ,cperl--ws-or-comment-regexp)
+ (group (regexp ,cperl--version-regexp))))))
+ "A regular expression for package NAME VERSION in Perl.
+Contains two groups for the package name and version.")
+
+(defconst cperl--package-for-imenu-regexp
+ (rx-to-string
+ `(sequence
+ (regexp ,cperl--package-regexp)
+ (regexp ,cperl--ows-regexp)
+ (group (or ";" "{"))))
+ "A regular expression to collect package names for `imenu`.
+Catches \"package NAME;\", \"package NAME VERSION;\", \"package
+NAME BLOCK\" and \"package NAME VERSION BLOCK.\" Contains three
+groups: Two from `cperl--package-regexp` for the package name and
+version, and a third to detect \"package BLOCK\" syntax.")
+
+(defconst cperl--sub-name-regexp
+ (rx-to-string
+ `(sequence
+ (optional (sequence (group (or "my" "state" "our"))
+ (regexp ,cperl--ws-or-comment-regexp)))
+ "sub" ; FIXME: the "method" and maybe "fun" keywords need to be
+ ; recognized soon...ish.
+ (regexp ,cperl--ws-or-comment-regexp)
+ (group (regexp ,cperl--normal-identifier-regexp))))
+ "A regular expression to detect a subroutine start.
+Contains two groups: One for to distinguish lexical from
+\"normal\" subroutines and one for the subroutine name.")
+
+(defconst cperl--pod-heading-regexp
+ (rx-to-string
+ `(sequence
+ line-start "=head"
+ (group (in "1-4"))
+ (1+ (in " \t"))
+ (group (1+ (not (in "\n"))))
+ line-end)) ; that line-end seems to be redundant?
+ "A regular expression to detect a POD heading.
+Contains two groups: One for the heading level, and one for the
+heading text.")
+
+(defconst cperl--imenu-entries-regexp
+ (rx-to-string
+ `(or
+ (regexp ,cperl--package-for-imenu-regexp) ; 1..3
+ (regexp ,cperl--sub-name-regexp) ; 4..5
+ (regexp ,cperl--pod-heading-regexp))) ; 6..7
+ "A regular expression to collect stuff that goes into the `imenu` index.
+Covers packages, subroutines, and POD headings.")
+
+
;; These two must be unwound, otherwise take exponential time
(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
"Regular expression to match optional whitespace with interspersed comments.
@@ -1268,8 +1354,7 @@ Should contain exactly one group.")
Should contain exactly one group.")
-;; Is incorporated in `cperl-imenu--function-name-regexp-perl'
-;; `cperl-outline-regexp', `defun-prompt-regexp'.
+;; Is incorporated in `cperl-outline-regexp', `defun-prompt-regexp'.
;; Details of groups in this may be used in several functions; see comments
;; near mentioned above variable(s)...
;; sub($$):lvalue{} sub:lvalue{} Both allowed...
@@ -1396,13 +1481,15 @@ the last)."
(defvar cperl-font-lock-multiline nil)
(defvar cperl-font-locking nil)
-;; NB as it stands the code in cperl-mode assumes this only has one
-;; element. Since XEmacs 19 support has been dropped, this could all be simplified.
-(defvar cperl-compilation-error-regexp-alist
+(defvar cperl-compilation-error-regexp-list
;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS).
- '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
- 2 3))
- "Alist that specifies how to match errors in perl output.")
+ '("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
+ 2 3)
+ "List that specifies how to match errors in Perl output.")
+
+(defvar cperl-compilation-error-regexp-alist)
+(make-obsolete-variable 'cperl-compilation-error-regexp-alist
+ 'cperl-compilation-error-regexp-list "28.1")
(defvar compilation-error-regexp-alist)
@@ -1512,8 +1599,7 @@ span the needed amount of lines.
Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
`cperl-pod-face', `cperl-pod-head-face' control processing of POD and
-here-docs sections. With capable Emaxen results of scan are used
-for indentation too, otherwise they are used for highlighting only.
+here-docs sections. Results of scan are used for indentation too.
Variables controlling indentation style:
`cperl-tab-always-indent'
@@ -1639,19 +1725,18 @@ or as help on variables `cperl-tips', `cperl-problems',
(setq-local imenu-sort-function nil)
(setq-local vc-rcs-header cperl-vc-rcs-header)
(setq-local vc-sccs-header cperl-vc-sccs-header)
- (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (setq-local compilation-error-regexp-alist-alist
- (cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
- compilation-error-regexp-alist-alist))
- (if (fboundp 'compilation-build-compilation-error-regexp-alist)
- (let ((f 'compilation-build-compilation-error-regexp-alist))
- (funcall f))
- (make-local-variable 'compilation-error-regexp-alist)
- (push 'cperl compilation-error-regexp-alist)))
- ((boundp 'compilation-error-regexp-alist);; xemacs 19.x
- (setq-local compilation-error-regexp-alist
- (append cperl-compilation-error-regexp-alist
- compilation-error-regexp-alist))))
+ (when (boundp 'compilation-error-regexp-alist-alist)
+ ;; The let here is just a compatibility kludge for the obsolete
+ ;; variable `cperl-compilation-error-regexp-alist'. It can be removed
+ ;; when that variable is removed.
+ (let ((regexp (if (boundp 'cperl-compilation-error-regexp-alist)
+ (car cperl-compilation-error-regexp-alist)
+ cperl-compilation-error-regexp-list)))
+ (setq-local compilation-error-regexp-alist-alist
+ (cons (cons 'cperl regexp)
+ compilation-error-regexp-alist-alist)))
+ (make-local-variable 'compilation-error-regexp-alist)
+ (push 'cperl compilation-error-regexp-alist))
(setq-local font-lock-defaults
'((cperl-load-font-lock-keywords
cperl-load-font-lock-keywords-1
@@ -1665,12 +1750,12 @@ or as help on variables `cperl-tips', `cperl-problems',
(setq-local syntax-propertize-function
(lambda (start end)
(goto-char start)
- ;; Even if cperl-fontify-syntaxically has already gone
+ ;; Even if cperl-fontify-syntactically has already gone
;; beyond `start', syntax-propertize has just removed
;; syntax-table properties between start and end, so we have
;; to re-apply them.
(setq cperl-syntax-done-to start)
- (cperl-fontify-syntaxically end))))
+ (cperl-fontify-syntactically end))))
(setq cperl-font-lock-multiline t) ; Not localized...
(setq-local font-lock-multiline t)
(setq-local font-lock-fontify-region-function
@@ -2139,7 +2224,7 @@ Help message may be switched off by setting `cperl-message-electric-keyword'
to nil."
(let ((beg (point-at-bol)))
(and (save-excursion
- (backward-sexp 1)
+ (skip-chars-backward "[:alpha:]")
(cperl-after-expr-p nil "{;:"))
(save-excursion
(not
@@ -3500,7 +3585,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
"\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>" ; QUOTED CONSTRUCT
"\\|"
;; 1+6+2+1=10 extra () before this:
- "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob>
+ "\\([/<]\\)" ; /blah/ or <file*glob>
"\\|"
;; 1+6+2+1+1=11 extra () before this
"\\<" cperl-sub-regexp "\\>" ; sub with proto/attr
@@ -3523,7 +3608,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; 1+6+2+1+1+6+1+1+1=20 extra () before this:
"\\|"
"\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy
- ""))))
+ "")))
+ warning-message)
(unwind-protect
(progn
(save-excursion
@@ -3586,7 +3672,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(looking-at "\\(cut\\|end\\)\\>"))
(if (or (nth 3 state) (nth 4 state) ignore-max)
nil ; Doing a chunk only
- (message "=cut is not preceded by a POD section")
+ (setq warning-message "=cut is not preceded by a POD section")
(or (car err-l) (setcar err-l (point))))
(beginning-of-line)
@@ -3601,7 +3687,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(goto-char b)
(if (re-search-forward "\n=\\(cut\\|end\\)\\>" stop-point 'toend)
(progn
- (message "=cut is not preceded by an empty line")
+ (setq warning-message "=cut is not preceded by an empty line")
(setq b1 t)
(or (car err-l) (setcar err-l b))))))
(beginning-of-line 2) ; An empty line after =cut is not POD!
@@ -3744,7 +3830,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(progn ; Pretend we matched at the end
(goto-char (point-max))
(re-search-forward "\\'")
- (message "End of here-document `%s' not found." tag)
+ (setq warning-message
+ (format "End of here-document `%s' not found." tag))
(or (car err-l) (setcar err-l b))))
(if cperl-pod-here-fontify
(progn
@@ -3821,7 +3908,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
'face font-lock-string-face)
(cperl-commentify (point) (+ (point) 2) nil)
(cperl-put-do-not-fontify (point) (+ (point) 2) t))
- (message "End of format `%s' not found." name)
+ (setq warning-message
+ (format "End of format `%s' not found." name))
(or (car err-l) (setcar err-l b)))
(forward-line)
(if (> (point) max)
@@ -3832,7 +3920,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; 1+6+2=9 extra () before this:
;; "\\<\\(q[wxqr]?\\|[msy]\\|tr\\)\\>"
;; "\\|"
- ;; "\\([?/<]\\)" ; /blah/ or ?blah? or <file*glob>
+ ;; "\\([/<]\\)" ; /blah/ or <file*glob>
(setq b1 (if (match-beginning 10) 10 11)
argument (buffer-substring
(match-beginning b1) (match-end b1))
@@ -3842,21 +3930,24 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
bb (char-after (1- (match-beginning b1))) ; tmp holder
;; bb == "Not a stringy"
bb (if (eq b1 10) ; user variables/whatever
- (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
- (cond ((eq bb ?-) (eq c ?s)) ; -s file test
- ((eq bb ?\:) ; $opt::s
- (eq (char-after
- (- (match-beginning b1) 2))
- ?\:))
- ((eq bb ?\>) ; $foo->s
- (eq (char-after
- (- (match-beginning b1) 2))
- ?\-))
- ((eq bb ?\&)
- (not (eq (char-after ; &&m/blah/
- (- (match-beginning b1) 2))
- ?\&)))
- (t t)))
+ (or
+ ; false positive: "y_" has no word boundary
+ (save-match-data (looking-at "_"))
+ (and (memq bb (append "$@%*#_:-&>" nil)) ; $#y)
+ (cond ((eq bb ?-) (eq c ?s)) ; -s file test
+ ((eq bb ?\:) ; $opt::s
+ (eq (char-after
+ (- (match-beginning b1) 2))
+ ?\:))
+ ((eq bb ?\>) ; $foo->s
+ (eq (char-after
+ (- (match-beginning b1) 2))
+ ?\-))
+ ((eq bb ?\&)
+ (not (eq (char-after ; &&m/blah/
+ (- (match-beginning b1) 2))
+ ?\&)))
+ (t t))))
;; <file> or <$file>
(and (eq c ?\<)
;; Do not stringify <FH>, <$fh> :
@@ -3867,7 +3958,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(goto-char (match-beginning b1))
(cperl-backward-to-noncomment (point-min))
(or bb
- (if (eq b1 11) ; bare /blah/ or ?blah? or <foo>
+ (if (eq b1 11) ; bare /blah/ or <foo>
(setq argument ""
b1 nil
bb ; Not a regexp?
@@ -3875,7 +3966,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; What is below: regexp-p?
(and
(or (memq (preceding-char)
- (append (if (memq c '(?\? ?\<))
+ (append (if (char-equal c ?\<)
;; $a++ ? 1 : 2
"~{(=|&*!,;:["
"~{(=|&+-*!,;:[") nil))
@@ -3886,14 +3977,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(forward-sexp -1)
;; After these keywords `/' starts a RE. One should add all the
;; functions/builtins which expect an argument, but ...
- (if (eq (preceding-char) ?-)
- ;; -d ?foo? is a RE
- (looking-at "[a-zA-Z]\\>")
(and
(not (memq (preceding-char)
'(?$ ?@ ?& ?%)))
(looking-at
- "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>")))))
+ "\\(while\\|if\\|unless\\|until\\|for\\(each\\)?\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\|say\\|return\\)\\>"))))
(and (eq (preceding-char) ?.)
(eq (char-after (- (point) 2)) ?.))
(bobp))
@@ -4338,8 +4426,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
REx-subgr-end argument) ; continue
(setq argument nil)))
(and argument
- (message "Couldn't find end of charclass in a REx, pos=%s"
- REx-subgr-start))
+ (setq warning-message
+ (format "Couldn't find end of charclass in a REx, pos=%s"
+ REx-subgr-start)))
(setq argument (1- (point)))
(goto-char REx-subgr-end)
(cperl-highlight-charclass
@@ -4395,7 +4484,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq qtag "Can't find })")))
(progn
(goto-char (1- e))
- (message "%s" qtag))
+ (setq warning-message
+ (format "%s" qtag)))
(cperl-postpone-fontification
(1- tag) (1- (point))
'face font-lock-variable-name-face)
@@ -4424,9 +4514,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; (1- e) 'toend)
(search-forward ")" (1- e) 'toend)
;;)
- (message
- "Couldn't find end of (?#...)-comment in a REx, pos=%s"
- REx-subgr-start))))
+ (setq warning-message
+ (format "Couldn't find end of (?#...)-comment in a REx, pos=%s"
+ REx-subgr-start)))))
(if (>= (point) e)
(goto-char (1- e)))
(cond
@@ -4504,8 +4594,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(if (> (point) stop-point)
(progn
(if end
- (message "Garbage after __END__/__DATA__ ignored")
- (message "Unbalanced syntax found while scanning")
+ (setq warning-message "Garbage after __END__/__DATA__ ignored")
+ (setq warning-message "Unbalanced syntax found while scanning")
(or (car err-l) (setcar err-l b)))
(goto-char stop-point))))
(setq cperl-syntax-state (cons state-point state)
@@ -4524,6 +4614,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
;; cperl-mode-syntax-table.
;; (set-syntax-table cperl-mode-syntax-table)
)
+ (when warning-message (message warning-message))
(list (car err-l) overshoot)))
(defun cperl-find-pods-heres-region (min max)
@@ -5188,117 +5279,80 @@ indentation and initial hashes. Behaves usually outside of comment."
;; Previous space could have gone:
(or (memq (preceding-char) '(?\s ?\t)) (insert " "))))))
-(defun cperl-imenu-addback (lst &optional isback name)
- ;; We suppose that the lst is a DAG, unless the first element only
- ;; loops back, and ISBACK is set. Thus this function cannot be
- ;; applied twice without ISBACK set.
- (cond ((not cperl-imenu-addback) lst)
- (t
- (or name
- (setq name "+++BACK+++"))
- (mapc (lambda (elt)
- (if (and (listp elt) (listp (cdr elt)))
- (progn
- ;; In the other order it goes up
- ;; one level only ;-(
- (setcdr elt (cons (cons name lst)
- (cdr elt)))
- (cperl-imenu-addback (cdr elt) t name))))
- (if isback (cdr lst) lst))
- lst)))
-
-(defun cperl-imenu--create-perl-index (&optional regexp)
- (require 'imenu) ; May be called from TAGS creator
- (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
+(defun cperl-imenu--create-perl-index ()
+ "Implement `imenu-create-index-function` for CPerl mode.
+This function relies on syntaxification to exclude lines which
+look like declarations but actually are part of a string, a
+comment, or POD."
+ (interactive) ; We'll remove that at some point
+ (goto-char (point-min))
+ (cperl-update-syntaxification (point-max))
+ (let ((case-fold-search nil)
+ (index-alist '())
+ (index-package-alist '())
+ (index-pod-alist '())
+ (index-sub-alist '())
(index-unsorted-alist '())
- (index-meth-alist '()) meth
- packages ends-ranges p marker is-proto
- is-pack index index1 name (end-range 0) package)
- (goto-char (point-min))
- (cperl-update-syntaxification (point-max))
- ;; Search for the function
- (progn ;;save-match-data
- (while (re-search-forward
- (or regexp cperl-imenu--function-name-regexp-perl)
- nil t)
- ;; 2=package-group, 5=package-name 8=sub-name
+ (package-stack '()) ; for package NAME BLOCK
+ (current-package "(main)")
+ (current-package-end (point-max))) ; end of package scope
+ ;; collect index entries
+ (while (re-search-forward cperl--imenu-entries-regexp nil t)
+ ;; First, check whether we have left the scope of previously
+ ;; recorded packages, and if so, eliminate them from the stack.
+ (while (< current-package-end (point))
+ (setq current-package (pop package-stack))
+ (setq current-package-end (pop package-stack)))
+ (let ((state (syntax-ppss))
+ name marker) ; for the "current" entry
(cond
- ((and ; Skip some noise if building tags
- (match-beginning 5) ; package name
- ;;(eq (char-after (match-beginning 2)) ?p) ; package
- (not (save-match-data
- (looking-at "[ \t\n]*;")))) ; Plain text word 'package'
- nil)
- ((and
- (or (match-beginning 2)
- (match-beginning 8)) ; package or sub
- ;; Skip if quoted (will not skip multi-line ''-strings :-():
- (null (get-text-property (match-beginning 1) 'syntax-table))
- (null (get-text-property (match-beginning 1) 'syntax-type))
- (null (get-text-property (match-beginning 1) 'in-pod)))
- (setq is-pack (match-beginning 2))
- ;; (if (looking-at "([^()]*)[ \t\n\f]*")
- ;; (goto-char (match-end 0))) ; Messes what follows
- (setq meth nil
- p (point))
- (while (and ends-ranges (>= p (car ends-ranges)))
- ;; delete obsolete entries
- (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
- (setq package (or (car packages) "")
- end-range (or (car ends-ranges) 0))
- (if is-pack ; doing "package"
- (progn
- (if (match-beginning 5) ; named package
- (setq name (buffer-substring (match-beginning 5)
- (match-end 5))
- name (progn
- (set-text-properties 0 (length name) nil name)
- name)
- package (concat name "::")
- name (concat "package " name))
- ;; Support nameless packages
- (setq name "package;" package ""))
- (setq end-range
- (save-excursion
- (parse-partial-sexp (point) (point-max) -1) (point))
- ends-ranges (cons end-range ends-ranges)
- packages (cons package packages)))
- (setq is-proto
- (or (eq (following-char) ?\;)
- (eq 0 (get-text-property (point) 'attrib-group)))))
- ;; Skip this function name if it is a prototype declaration.
- (if (and is-proto (not is-pack)) nil
- (or is-pack
- (setq name
- (buffer-substring (match-beginning 8) (match-end 8)))
- (set-text-properties 0 (length name) nil name))
- (setq marker (make-marker))
- (set-marker marker (match-end (if is-pack 2 8)))
- (cond (is-pack nil)
- ((string-match "[:']" name)
- (setq meth t))
- ((> p end-range) nil)
- (t
- (setq name (concat package name) meth t)))
- (setq index (cons name marker))
- (if is-pack
- (push index index-pack-alist)
- (push index index-alist))
- (if meth (push index index-meth-alist))
- (push index index-unsorted-alist)))
- ((match-beginning 16) ; POD section
- (setq name (buffer-substring (match-beginning 17) (match-end 17))
- marker (make-marker))
- (set-marker marker (match-beginning 17))
- (set-text-properties 0 (length name) nil name)
- (setq name (concat (make-string
- (* 3 (- (char-after (match-beginning 16)) ?1))
- ?\ )
- name)
- index (cons name marker))
- (setq index1 (cons (concat "=" name) (cdr index)))
- (push index index-pod-alist)
- (push index1 index-unsorted-alist)))))
+ ((nth 3 state) nil) ; matched in a string, so skip
+ ((match-string 1) ; found a package name!
+ (unless (nth 4 state) ; skip if in a comment
+ (setq name (match-string-no-properties 1)
+ marker (copy-marker (match-end 1)))
+ (if (string= (match-string 3) ";")
+ (setq current-package name) ; package NAME;
+ ;; No semicolon, therefore we have: package NAME BLOCK.
+ ;; Stash the current package, because we need to restore
+ ;; it after the end of BLOCK.
+ (push current-package-end package-stack)
+ (push current-package package-stack)
+ ;; record the current name and its scope
+ (setq current-package name)
+ (setq current-package-end (save-excursion
+ (goto-char (match-beginning 3))
+ (forward-sexp)
+ (point)))
+ (push (cons name marker) index-package-alist)
+ (push (cons (concat "package " name) marker) index-unsorted-alist))))
+ ((match-string 5) ; found a sub name!
+ (unless (nth 4 state) ; skip if in a comment
+ (setq name (match-string-no-properties 5)
+ marker (copy-marker (match-end 5)))
+ ;; Qualify the sub name with the package if it doesn't
+ ;; already have one, and if it isn't lexically scoped.
+ ;; "my" and "state" subs are lexically scoped, but "our"
+ ;; are just lexical aliases to package subs.
+ (if (and (null (string-match "::" name))
+ (or (null (match-string 4))
+ (string-equal (match-string 4) "our")))
+ (setq name (concat current-package "::" name)))
+ (let ((index (cons name marker)))
+ (push index index-alist)
+ (push index index-sub-alist)
+ (push index index-unsorted-alist))))
+ ((match-string 6) ; found a POD heading!
+ (when (get-text-property (match-beginning 6) 'in-pod)
+ (setq name (concat (make-string
+ (* 3 (- (char-after (match-beginning 6)) ?1))
+ ?\ )
+ (match-string-no-properties 7))
+ marker (copy-marker (match-beginning 7)))
+ (push (cons name marker) index-pod-alist)
+ (push (cons (concat "=" name) marker) index-unsorted-alist)))
+ (t (error "Unidentified match: %s" (match-string 0))))))
+ ;; Now format the collected stuff
(setq index-alist
(if (default-value 'imenu-sort-function)
(sort index-alist (default-value 'imenu-sort-function))
@@ -5307,14 +5361,14 @@ indentation and initial hashes. Behaves usually outside of comment."
(push (cons "+POD headers+..."
(nreverse index-pod-alist))
index-alist))
- (and (or index-pack-alist index-meth-alist)
- (let ((lst index-pack-alist) hier-list pack elt group name)
- ;; Remove "package ", reverse and uniquify.
+ (and (or index-package-alist index-sub-alist)
+ (let ((lst index-package-alist) hier-list pack elt group name)
+ ;; reverse and uniquify.
(while lst
- (setq elt (car lst) lst (cdr lst) name (substring (car elt) 8))
+ (setq elt (car lst) lst (cdr lst) name (car elt))
(if (assoc name hier-list) nil
(setq hier-list (cons (cons name (cdr elt)) hier-list))))
- (setq lst index-meth-alist)
+ (setq lst index-sub-alist)
(while lst
(setq elt (car lst) lst (cdr lst))
(cond ((string-match "\\(::\\|'\\)[_a-zA-Z0-9]+$" (car elt))
@@ -5342,17 +5396,18 @@ indentation and initial hashes. Behaves usually outside of comment."
(push (cons "+Hierarchy+..."
hier-list)
index-alist)))
- (and index-pack-alist
+ (and index-package-alist
(push (cons "+Packages+..."
- (nreverse index-pack-alist))
+ (nreverse index-package-alist))
index-alist))
- (and (or index-pack-alist index-pod-alist
+ (and (or index-package-alist index-pod-alist
(default-value 'imenu-sort-function))
index-unsorted-alist
(push (cons "+Unsorted List+..."
(nreverse index-unsorted-alist))
index-alist))
- (cperl-imenu-addback index-alist)))
+ ;; Finally, return the whole collection
+ index-alist))
;; Suggested by Mark A. Hershberger
@@ -5415,120 +5470,79 @@ indentation and initial hashes. Behaves usually outside of comment."
(cons
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; FIXME: Use regexp-opt.
- (mapconcat
- #'identity
+ (regexp-opt
(append
cperl-sub-keywords
'("if" "until" "while" "elsif" "else"
- "given" "when" "default" "break"
- "unless" "for"
- "try" "catch" "finally"
- "foreach" "continue" "exit" "die" "last" "goto" "next"
- "redo" "return" "local" "exec"
- "do" "dump"
- "use" "our"
- "require" "package" "eval" "evalbytes" "my" "state"
- "BEGIN" "END" "CHECK" "INIT" "UNITCHECK"))
- "\\|") ; Flow control
+ "given" "when" "default" "break"
+ "unless" "for"
+ "try" "catch" "finally"
+ "foreach" "continue" "exit" "die" "last" "goto" "next"
+ "redo" "return" "local" "exec"
+ "do" "dump"
+ "use" "our"
+ "require" "package" "eval" "evalbytes" "my" "state"
+ "BEGIN" "END" "CHECK" "INIT" "UNITCHECK"))) ; Flow control
"\\)\\>") 2) ; was "\\)[ \n\t;():,|&]"
; In what follows we use `type' style
; for overwritable builtins
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; FIXME: Use regexp-opt.
- ;; "CORE" "__FILE__" "__LINE__" "__SUB__" "abs" "accept" "alarm"
- ;; "and" "atan2" "bind" "binmode" "bless" "caller"
- ;; "chdir" "chmod" "chown" "chr" "chroot" "close"
- ;; "closedir" "cmp" "connect" "continue" "cos" "crypt"
- ;; "dbmclose" "dbmopen" "die" "dump" "endgrent"
- ;; "endhostent" "endnetent" "endprotoent" "endpwent"
- ;; "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl"
- ;; "fileno" "flock" "fork" "formline" "ge" "getc"
- ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
- ;; "gethostbyname" "gethostent" "getlogin"
- ;; "getnetbyaddr" "getnetbyname" "getnetent"
- ;; "getpeername" "getpgrp" "getppid" "getpriority"
- ;; "getprotobyname" "getprotobynumber" "getprotoent"
- ;; "getpwent" "getpwnam" "getpwuid" "getservbyname"
- ;; "getservbyport" "getservent" "getsockname"
- ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
- ;; "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
- ;; "link" "listen" "localtime" "lock" "log" "lstat" "lt"
- ;; "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
- ;; "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
- ;; "quotemeta" "rand" "read" "readdir" "readline"
- ;; "readlink" "readpipe" "recv" "ref" "rename" "require"
- ;; "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
- ;; "seekdir" "select" "semctl" "semget" "semop" "send"
- ;; "setgrent" "sethostent" "setnetent" "setpgrp"
- ;; "setpriority" "setprotoent" "setpwent" "setservent"
- ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
- ;; "shutdown" "sin" "sleep" "socket" "socketpair"
- ;; "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
- ;; "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite" "tell"
- ;; "telldir" "time" "times" "truncate" "uc" "ucfirst"
- ;; "umask" "unlink" "unpack" "utime" "values" "vec"
- ;; "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"
- "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|"
- "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
- "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
- "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|"
- "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|"
- "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|"
- "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|"
- "f\\(ileno\\|c\\(ntl\\)?\\|lock\\|or\\(k\\|mline\\)\\)\\|"
- "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|"
- "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w"
- "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|"
- "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|"
- "ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|"
- "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
- "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
- "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
- "\\(\\|ngth\\)\\|o\\(c\\(altime\\|k\\)\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
- "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
- "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
- "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
- "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name"
- "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r"
- "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
- "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
- "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
- "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|open\\|tem\\|write\\|seek\\)\\|"
- "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
- "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
- "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
- "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
- "x\\(\\|or\\)\\|__\\(FILE\\|LINE\\|PACKAGE\\|SUB\\)__"
- "\\)\\>") 2 'font-lock-type-face)
+ (regexp-opt
+ '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__"
+ "abs" "accept" "alarm" "and" "atan2"
+ "bind" "binmode" "bless" "caller"
+ "chdir" "chmod" "chown" "chr" "chroot" "close"
+ "closedir" "cmp" "connect" "continue" "cos" "crypt"
+ "dbmclose" "dbmopen" "die" "dump" "endgrent"
+ "endhostent" "endnetent" "endprotoent" "endpwent"
+ "endservent" "eof" "eq" "exec" "exit" "exp" "fc" "fcntl"
+ "fileno" "flock" "fork" "formline" "ge" "getc"
+ "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
+ "gethostbyname" "gethostent" "getlogin"
+ "getnetbyaddr" "getnetbyname" "getnetent"
+ "getpeername" "getpgrp" "getppid" "getpriority"
+ "getprotobyname" "getprotobynumber" "getprotoent"
+ "getpwent" "getpwnam" "getpwuid" "getservbyname"
+ "getservbyport" "getservent" "getsockname"
+ "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int"
+ "ioctl" "join" "kill" "lc" "lcfirst" "le" "length"
+ "link" "listen" "localtime" "lock" "log" "lstat" "lt"
+ "mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "ne"
+ "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
+ "quotemeta" "rand" "read" "readdir" "readline"
+ "readlink" "readpipe" "recv" "ref" "rename" "require"
+ "reset" "reverse" "rewinddir" "rindex" "rmdir" "seek"
+ "seekdir" "select" "semctl" "semget" "semop" "send"
+ "setgrent" "sethostent" "setnetent" "setpgrp"
+ "setpriority" "setprotoent" "setpwent" "setservent"
+ "setsockopt" "shmctl" "shmget" "shmread" "shmwrite"
+ "shutdown" "sin" "sleep" "socket" "socketpair"
+ "sprintf" "sqrt" "srand" "stat" "substr" "symlink"
+ "syscall" "sysopen" "sysread" "sysseek" "system" "syswrite" "tell"
+ "telldir" "time" "times" "truncate" "uc" "ucfirst"
+ "umask" "unlink" "unpack" "utime" "values" "vec"
+ "wait" "waitpid" "wantarray" "warn" "write" "x" "xor"))
+ "\\)\\>")
+ 2 'font-lock-type-face)
;; In what follows we use `other' style
;; for nonoverwritable builtins
- ;; Somehow 's', 'm' are not auto-generated???
(list
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
- ;; "AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK" "__END__" "chomp"
- ;; "break" "chop" "default" "defined" "delete" "do" "each" "else" "elsif"
- ;; "eval" "evalbytes" "exists" "for" "foreach" "format" "given" "goto"
- ;; "grep" "if" "keys" "last" "local" "map" "my" "next"
- ;; "no" "our" "package" "pop" "pos" "print" "printf" "prototype" "push"
- ;; "q" "qq" "qw" "qx" "redo" "return" "say" "scalar" "shift"
- ;; "sort" "splice" "split" "state" "study" "sub" "tie" "tr"
- ;; "undef" "unless" "unshift" "untie" "until" "use"
- ;; "when" "while" "y"
- "AUTOLOAD\\|BEGIN\\|\\(UNIT\\)?CHECK\\|break\\|c\\(atch\\|ho\\(p\\|mp\\)\\)\\|d\\(e\\(f\\(inally\\|ault\\|ined\\)\\|lete\\)\\|"
- "o\\)\\|DESTROY\\|e\\(ach\\|val\\(bytes\\)?\\|xists\\|ls\\(e\\|if\\)\\)\\|"
- "END\\|for\\(\\|each\\|mat\\)\\|g\\(iven\\|rep\\|oto\\)\\|INIT\\|if\\|keys\\|"
- "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|our\\|"
- "p\\(ackage\\|rototype\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
- "q\\(\\|q\\|w\\|x\\|r\\)\\|re\\(turn\\|do\\)\\|s\\(ay\\|pli\\(ce\\|t\\)\\|"
- "calar\\|t\\(ate\\|udy\\)\\|ub\\|hift\\|ort\\)\\|t\\(ry?\\|ied?\\)\\|"
- "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
- "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
- "\\|[sm]" ; Added manually
- "\\)\\>")
+ (regexp-opt
+ '("AUTOLOAD" "BEGIN" "CHECK" "DESTROY" "END" "INIT" "UNITCHECK"
+ "__END__" "__DATA__" "break" "catch" "chomp" "chop" "default"
+ "defined" "delete" "do" "each" "else" "elsif" "eval"
+ "evalbytes" "exists" "finally" "for" "foreach" "format" "given"
+ "goto" "grep" "if" "keys" "last" "local" "m" "map" "my" "next"
+ "no" "our" "package" "pop" "pos" "print" "printf" "prototype"
+ "push" "q" "qq" "qr" "qw" "qx" "redo" "return" "s" "say" "scalar"
+ "shift" "sort" "splice" "split" "state" "study" "sub" "tie"
+ "tied" "tr" "try" "undef" "unless" "unshift" "untie" "until"
+ "use" "when" "while" "y"))
+ "\\)\\>")
2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted
;; (mapconcat #'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
@@ -6694,9 +6708,9 @@ One may build such TAGS files from CPerl mode menu."
(or (nthcdr 2 elt)
;; Only in one file
(setcdr elt (cdr (nth 1 elt))))))
- to l1 l2 l3)
+ to) ;; l1 l2 l3
;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
- (setq cperl-hierarchy (list l1 l2 l3))
+ (setq cperl-hierarchy (list () () ())) ;; (list l1 l2 l3)
(or tags-table-list
(call-interactively 'visit-tags-table))
(mapc
@@ -6713,9 +6727,7 @@ One may build such TAGS files from CPerl mode menu."
(cperl-tags-treeify to 1)
(setcar (nthcdr 2 cperl-hierarchy)
(cperl-menu-to-keymap (cons '("+++UPDATE+++" . -999) (cdr to))))
- (message "Updating list of classes: done, requesting display...")
- ;;(cperl-imenu-addback (nth 2 cperl-hierarchy))
- ))
+ (message "Updating list of classes: done, requesting display...")))
(or (nth 2 cperl-hierarchy)
(error "No items found"))
(setq update
@@ -6744,7 +6756,7 @@ One may build such TAGS files from CPerl mode menu."
"\\)\\(::\\)?"))
(packages (cdr (nth 1 to)))
(methods (cdr (nth 2 to)))
- l1 head cons1 cons2 ord writeto recurse
+ head cons1 cons2 ord writeto recurse ;; l1
root-packages root-functions
(move-deeper
(lambda (elt)
@@ -6764,7 +6776,7 @@ One may build such TAGS files from CPerl mode menu."
(setq root-functions (cons elt root-functions)))
(t
(setq root-packages (cons elt root-packages)))))))
- (setcdr to l1) ; Init to dynamic space
+ (setcdr to nil) ;; l1 ; Init to dynamic space
(setq writeto to)
(setq ord 1)
(mapc move-deeper packages)
@@ -7217,8 +7229,7 @@ $~ The name of the current report format.
... >= ... Numeric greater than or equal to.
... >> ... Bitwise shift right.
... >>= ... Bitwise shift right assignment.
-... ? ... : ... Condition=if-then-else operator. ?PAT? One-time pattern match.
-?PATTERN? One-time pattern match.
+... ? ... : ... Condition=if-then-else operator.
@ARGV Command line arguments (not including the command name - see $0).
@INC List of places to look for perl scripts during do/include/use.
@_ Parameter array for subroutines; result of split() unless in list context.
@@ -8387,7 +8398,7 @@ do extra unwind via `cperl-unwind-to-safe'."
(setq end (point)))
(font-lock-default-fontify-region beg end loudly))
-(defun cperl-fontify-syntaxically (end)
+(defun cperl-fontify-syntactically (end)
;; Some vars for debugging only
;; (message "Syntaxifying...")
(let ((dbg (point)) (iend end) (idone cperl-syntax-done-to)
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index b2c2e8dab57..6602a79b2a4 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -53,8 +53,7 @@
(defcustom cpp-config-file (convert-standard-filename ".cpp.el")
"File name to save cpp configuration."
- :type 'file
- :group 'cpp)
+ :type 'file)
(define-widget 'cpp-face 'lazy
"Either a face or the special symbol `invisible'."
@@ -62,13 +61,11 @@
(defcustom cpp-known-face 'invisible
"Face used for known cpp symbols."
- :type 'cpp-face
- :group 'cpp)
+ :type 'cpp-face)
(defcustom cpp-unknown-face 'highlight
"Face used for unknown cpp symbols."
- :type 'cpp-face
- :group 'cpp)
+ :type 'cpp-face)
(defcustom cpp-face-type 'light
"Indicate what background face type you prefer.
@@ -76,18 +73,15 @@ Can be either light or dark for color screens, mono for monochrome
screens, and none if you don't use a window system and don't have
a color-capable display."
:options '(light dark mono nil)
- :type 'symbol
- :group 'cpp)
+ :type 'symbol)
(defcustom cpp-known-writable t
"Non-nil means you are allowed to modify the known conditionals."
- :type 'boolean
- :group 'cpp)
+ :type 'boolean)
(defcustom cpp-unknown-writable t
"Non-nil means you are allowed to modify the unknown conditionals."
- :type 'boolean
- :group 'cpp)
+ :type 'boolean)
(defcustom cpp-edit-list nil
"Alist of cpp macros and information about how they should be displayed.
@@ -101,15 +95,13 @@ Each entry is a list with the following elements:
(cpp-face :tag "False")
(choice (const :tag "True branch writable" t)
(const :tag "False branch writable" nil)
- (const :tag "Both branches writable" both))))
- :group 'cpp)
+ (const :tag "Both branches writable" both)))))
(defcustom cpp-message-min-time-interval 1.0
"Minimum time interval in seconds for `cpp-progress-message' messages.
If nil, `cpp-progress-message' prints no progress messages."
:type '(choice (const :tag "Disable progress messages" nil)
float)
- :group 'cpp
:version "26.1")
(defvar-local cpp-overlay-list nil
@@ -153,36 +145,31 @@ or a cons cell (background-color . COLOR)."
:value-type (choice face
(const invisible)
(cons (const background-color)
- (string :tag "Color"))))
- :group 'cpp)
+ (string :tag "Color")))))
(defcustom cpp-face-light-name-list
'("light gray" "light blue" "light cyan" "light yellow" "light pink"
"pale green" "beige" "orange" "magenta" "violet" "medium purple"
"turquoise")
"Background colors useful with dark foreground colors."
- :type '(repeat string)
- :group 'cpp)
+ :type '(repeat string))
(defcustom cpp-face-dark-name-list
'("dim gray" "blue" "cyan" "yellow" "red"
"dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple"
"dark turquoise")
"Background colors useful with light foreground colors."
- :type '(repeat string)
- :group 'cpp)
+ :type '(repeat string))
(defcustom cpp-face-light-list nil
"Alist of names and faces to be used for light backgrounds."
:type '(repeat (cons string (choice face
- (cons (const background-color) string))))
- :group 'cpp)
+ (cons (const background-color) string)))))
(defcustom cpp-face-dark-list nil
"Alist of names and faces to be used for dark backgrounds."
:type '(repeat (cons string (choice face
- (cons (const background-color) string))))
- :group 'cpp)
+ (cons (const background-color) string)))))
(defcustom cpp-face-mono-list
'(("bold" . bold)
@@ -190,15 +177,13 @@ or a cons cell (background-color . COLOR)."
("italic" . italic)
("underline" . underline))
"Alist of names and faces to be used for monochrome screens."
- :type '(repeat (cons string face))
- :group 'cpp)
+ :type '(repeat (cons string face)))
(defcustom cpp-face-none-list
'(("default" . default)
("invisible" . invisible))
"Alist of names and faces available even if you don't use a window system."
- :type '(repeat (cons string cpp-face))
- :group 'cpp)
+ :type '(repeat (cons string cpp-face)))
(defvar cpp-face-all-list
(append cpp-face-light-list
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 042030da396..7fd592fb2e1 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -1,4 +1,4 @@
-;;; cwarn.el --- highlight suspicious C and C++ constructions
+;;; cwarn.el --- highlight suspicious C and C++ constructions -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -128,8 +128,7 @@ on one of three forms:
See variable `cwarn-font-lock-feature-keywords-alist' for available
features."
- :type '(repeat sexp)
- :group 'cwarn)
+ :type '(repeat sexp))
(defcustom cwarn-font-lock-feature-keywords-alist
'((assign . cwarn-font-lock-assignment-keywords)
@@ -142,15 +141,13 @@ keyword list."
:type '(alist :key-type (choice (const assign)
(const semicolon)
(const reference))
- :value-type (sexp :tag "Value"))
- :group 'cwarn)
+ :value-type (sexp :tag "Value")))
(defcustom cwarn-verbose t
"When nil, CWarn mode will not generate any messages.
Currently, messages are generated when the mode is activated and
deactivated."
- :group 'cwarn
:type 'boolean)
(defcustom cwarn-mode-text " CWarn"
@@ -158,13 +155,11 @@ deactivated."
\(When the string is not empty, make sure that it has a leading space.)"
:tag "CWarn mode text" ; To separate it from `global-...'
- :group 'cwarn
:type 'string)
(defcustom cwarn-load-hook nil
"Functions to run when CWarn mode is first loaded."
:tag "Load Hook"
- :group 'cwarn
:type 'hook)
(make-obsolete-variable 'cwarn-load-hook
"use `with-eval-after-load' instead." "28.1")
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 8943d8b6d01..ed024f24344 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1,4 +1,4 @@
-;;; dcl-mode.el --- major mode for editing DCL command files
+;;; dcl-mode.el --- major mode for editing DCL command files -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
@@ -23,9 +23,11 @@
;;; Commentary:
-;; DCL mode is a package for editing DCL command files. It helps you
-;; indent lines, add leading `$' and trailing `-', move around in the
-;; code and insert lexical functions.
+;; DCL mode is a package for editing
+;; [DCL](https://en.wikipedia.org/wiki/DIGITAL_Command_Language)
+;; command files.
+;; It helps you indent lines, add leading `$' and trailing `-', move
+;; around in the code and insert lexical functions.
;;
;; Type `C-h m' when you are editing a .COM file to get more
;; information about this mode.
@@ -93,12 +95,11 @@ Presently this includes some syntax, .OP.erators, and \"f$\" lexicals.")
(defcustom dcl-basic-offset 4
"Number of columns to indent a block in DCL.
A block is the commands between THEN-ELSE-ENDIF and between the commands
-dcl-block-begin-regexp and dcl-block-end-regexp.
+`dcl-block-begin-regexp' and `dcl-block-end-regexp'.
The meaning of this variable may be changed if
-dcl-calc-command-indent-function is set to a function."
- :type 'integer
- :group 'dcl)
+`dcl-calc-command-indent-function' is set to a function."
+ :type 'integer)
(defcustom dcl-continuation-offset 6
@@ -106,9 +107,8 @@ dcl-calc-command-indent-function is set to a function."
A continuation line is a line that follows a line ending with `-'.
The meaning of this variable may be changed if
-dcl-calc-cont-indent-function is set to a function."
- :type 'integer
- :group 'dcl)
+`dcl-calc-cont-indent-function' is set to a function."
+ :type 'integer)
(defcustom dcl-margin-offset 8
@@ -117,37 +117,32 @@ The first command line in a file or after a SUBROUTINE statement is indented
this much. Other command lines are indented the same number of columns as
the preceding command line.
A command line is a line that starts with `$'."
- :type 'integer
- :group 'dcl)
+ :type 'integer)
(defcustom dcl-margin-label-offset 2
"Number of columns to indent a margin label in DCL.
A margin label is a label that doesn't begin or end a block, i.e. it
-doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
- :type 'integer
- :group 'dcl)
+doesn't match `dcl-block-begin-regexp' or `dcl-block-end-regexp'."
+ :type 'integer)
(defcustom dcl-comment-line-regexp "^\\$!"
"Regexp describing the start of a comment line in DCL.
Comment lines are not indented."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-block-begin-regexp "loop[0-9]*:"
"Regexp describing a command that begins an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-block-end-regexp "endloop[0-9]*:"
"Regexp describing a command that ends an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-calc-command-indent-function nil
@@ -176,10 +171,9 @@ If this variable is nil, the indentation is calculated as
CUR-INDENT + EXTRA-INDENT.
This package includes two functions suitable for this:
- dcl-calc-command-indent-multiple
- dcl-calc-command-indent-hang"
- :type '(choice (const nil) function)
- :group 'dcl)
+ `dcl-calc-command-indent-multiple'
+ `dcl-calc-command-indent-hang'"
+ :type '(choice (const nil) function))
(defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
@@ -195,9 +189,8 @@ If this variable is nil, the indentation is calculated as
CUR-INDENT + EXTRA-INDENT.
This package includes one function suitable for this:
- dcl-calc-cont-indent-relative"
- :type 'function
- :group 'dcl)
+ `dcl-calc-cont-indent-relative'"
+ :type 'function)
(defcustom dcl-tab-always-indent t
@@ -206,50 +199,41 @@ If t, pressing TAB always indents the current line.
If nil, pressing TAB indents the current line if point is at the left margin.
Data lines (i.e. lines not part of a command line or continuation line) are
never indented."
- :type 'boolean
- :group 'dcl)
+ :type 'boolean)
(defcustom dcl-electric-characters t
"Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
- :type 'boolean
- :group 'dcl)
+ :type 'boolean)
(defcustom dcl-tempo-comma ", "
"Text to insert when a comma is needed in a template, in DCL mode."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-tempo-left-paren "("
"Text to insert when a left parenthesis is needed in a template in DCL."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-tempo-right-paren ")"
"Text to insert when a right parenthesis is needed in a template in DCL."
- :type 'string
- :group 'dcl)
+ :type 'string)
; I couldn't decide what looked best, so I'll let you decide...
; Remember, you can also customize this with imenu-submenu-name-format.
(defcustom dcl-imenu-label-labels "Labels"
"Imenu menu title for sub-listing with label names."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-label-goto "GOTO"
"Imenu menu title for sub-listing with GOTO statements."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-label-gosub "GOSUB"
"Imenu menu title for sub-listing with GOSUB statements."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-label-call "CALL"
"Imenu menu title for sub-listing with CALL statements."
- :type 'string
- :group 'dcl)
+ :type 'string)
(defcustom dcl-imenu-generic-expression
`((nil "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):[ \t]+SUBROUTINE\\b" 1)
@@ -263,14 +247,12 @@ never indented."
The default includes SUBROUTINE labels in the main listing and
sub-listings for other labels, CALL, GOTO and GOSUB statements.
See `imenu-generic-expression' for details."
- :type '(repeat (sexp :tag "Imenu Expression"))
- :group 'dcl)
+ :type '(repeat (sexp :tag "Imenu Expression")))
(defcustom dcl-mode-hook nil
"Hook called by `dcl-mode'."
- :type 'hook
- :group 'dcl)
+ :type 'hook)
;;; *** Global variables ****************************************************
@@ -290,80 +272,59 @@ See `imenu-generic-expression' for details."
(defvar dcl-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\e\n" 'dcl-split-line)
- (define-key map "\e\t" 'tempo-complete-tag)
- (define-key map "\e^" 'dcl-delete-indentation)
- (define-key map "\em" 'dcl-back-to-indentation)
- (define-key map "\ee" 'dcl-forward-command)
- (define-key map "\ea" 'dcl-backward-command)
- (define-key map "\e\C-q" 'dcl-indent-command)
- (define-key map "\t" 'dcl-tab)
- (define-key map ":" 'dcl-electric-character)
- (define-key map "F" 'dcl-electric-character)
- (define-key map "f" 'dcl-electric-character)
- (define-key map "E" 'dcl-electric-character)
- (define-key map "e" 'dcl-electric-character)
- (define-key map "\C-c\C-o" 'dcl-set-option)
- (define-key map "\C-c\C-f" 'tempo-forward-mark)
- (define-key map "\C-c\C-b" 'tempo-backward-mark)
-
- (define-key map [menu-bar] (make-sparse-keymap))
- (define-key map [menu-bar dcl]
- (cons "DCL" (make-sparse-keymap "DCL")))
-
- ;; Define these in bottom-up order
- (define-key map [menu-bar dcl tempo-backward-mark]
- '("Previous template mark" . tempo-backward-mark))
- (define-key map [menu-bar dcl tempo-forward-mark]
- '("Next template mark" . tempo-forward-mark))
- (define-key map [menu-bar dcl tempo-complete-tag]
- '("Complete template tag" . tempo-complete-tag))
- (define-key map [menu-bar dcl dcl-separator-tempo]
- '("--"))
- (define-key map [menu-bar dcl dcl-save-all-options]
- '("Save all options" . dcl-save-all-options))
- (define-key map [menu-bar dcl dcl-save-nondefault-options]
- '("Save changed options" . dcl-save-nondefault-options))
- (define-key map [menu-bar dcl dcl-set-option]
- '("Set option" . dcl-set-option))
- (define-key map [menu-bar dcl dcl-separator-option]
- '("--"))
- (define-key map [menu-bar dcl dcl-delete-indentation]
- '("Delete indentation" . dcl-delete-indentation))
- (define-key map [menu-bar dcl dcl-split-line]
- '("Split line" . dcl-split-line))
- (define-key map [menu-bar dcl dcl-indent-command]
- '("Indent command" . dcl-indent-command))
- (define-key map [menu-bar dcl dcl-tab]
- '("Indent line/insert tab" . dcl-tab))
- (define-key map [menu-bar dcl dcl-back-to-indentation]
- '("Back to indentation" . dcl-back-to-indentation))
- (define-key map [menu-bar dcl dcl-forward-command]
- '("End of statement" . dcl-forward-command))
- (define-key map [menu-bar dcl dcl-backward-command]
- '("Beginning of statement" . dcl-backward-command))
- (define-key map [menu-bar dcl dcl-separator-movement]
- '("--"))
- (define-key map [menu-bar dcl imenu]
- '("Buffer index menu" . imenu))
+ (define-key map "\e\n" #'dcl-split-line)
+ (define-key map "\e\t" #'tempo-complete-tag)
+ (define-key map "\e^" #'dcl-delete-indentation)
+ (define-key map "\em" #'dcl-back-to-indentation)
+ (define-key map "\ee" #'dcl-forward-command)
+ (define-key map "\ea" #'dcl-backward-command)
+ (define-key map "\e\C-q" #'dcl-indent-command)
+ (define-key map "\t" #'dcl-tab)
+ (define-key map ":" #'dcl-electric-character)
+ (define-key map "F" #'dcl-electric-character)
+ (define-key map "f" #'dcl-electric-character)
+ (define-key map "E" #'dcl-electric-character)
+ (define-key map "e" #'dcl-electric-character)
+ (define-key map "\C-c\C-o" #'dcl-set-option)
+ (define-key map "\C-c\C-f" #'tempo-forward-mark)
+ (define-key map "\C-c\C-b" #'tempo-backward-mark)
map)
"Keymap used in DCL-mode buffers.")
+(easy-menu-define dcl-mode-menu dcl-mode-map
+ "Menu for DCL-mode buffers."
+ '("DCL"
+ ["Buffer index menu" imenu]
+ "---"
+ ["Beginning of statement" dcl-backward-command]
+ ["End of statement" dcl-forward-command]
+ ["Back to indentation" dcl-back-to-indentation]
+ ["Indent line/insert tab" dcl-tab]
+ ["Indent command" dcl-indent-command]
+ ["Split line" dcl-split-line]
+ ["Delete indentation" dcl-delete-indentation]
+ "---"
+ ["Set option" dcl-set-option]
+ ["Save changed options" dcl-save-nondefault-options]
+ ["Save all options" dcl-save-all-options]
+ "---"
+ ["Complete template tag" tempo-complete-tag]
+ ["Next template mark" tempo-forward-mark]
+ ["Previous template mark" tempo-backward-mark]))
+
(defcustom dcl-ws-r
"\\([ \t]*-[ \t]*\\(!.*\\)*\n\\)*[ \t]*"
"Regular expression describing white space in a DCL command line.
White space is any number of continued lines with only space,tab,endcomment
followed by space or tab."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-label-r
"[a-zA-Z0-9_$]*:\\([ \t!]\\|$\\)"
"Regular expression describing a label.
A label is a name followed by a colon followed by white-space or end-of-line."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-cmd-r
@@ -373,8 +334,7 @@ A line starting with $, optionally followed by continuation lines,
followed by the end of the command line.
A continuation line is any characters followed by `-',
optionally followed by a comment, followed by a newline."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-command-regexp
@@ -384,21 +344,19 @@ A line starting with $, optionally followed by continuation lines,
followed by the end of the command line.
A continuation line is any characters followed by `-',
optionally followed by a comment, followed by a newline."
- :type 'regexp
- :group 'dcl)
+ :type 'regexp)
(defcustom dcl-electric-reindent-regexps
(list "endif" "else" dcl-label-r)
"Regexps that can trigger an electric reindent.
A list of regexps that will trigger a reindent if the last letter
-is defined as dcl-electric-character.
+is defined as `dcl-electric-character'.
E.g.: if this list contains `endif', the key `f' is defined as
-dcl-electric-character and you have just typed the `f' in
+`dcl-electric-character' and you have just typed the `f' in
`endif', the line will be reindented."
- :type '(repeat regexp)
- :group 'dcl)
+ :type '(repeat regexp))
(defvar dcl-option-alist
@@ -420,7 +378,7 @@ dcl-electric-character and you have just typed the `f' in
(comment-start curval)
(comment-start-skip curval)
)
- "Options and default values for dcl-set-option.
+ "Options and default values for `dcl-set-option'.
An alist with option variables and functions or keywords to get a
default value for the option.
@@ -434,8 +392,8 @@ toggle the opposite of the current value (for t/nil)")
(mapcar (lambda (option-assoc)
(format "%s" (car option-assoc)))
dcl-option-alist)
- "The history list for dcl-set-option.
-Preloaded with all known option names from dcl-option-alist")
+ "The history list for `dcl-set-option'.
+Preloaded with all known option names from `dcl-option-alist'")
;; Must be defined after dcl-cmd-r
@@ -577,7 +535,7 @@ $
There is some minimal font-lock support (see vars
`dcl-font-lock-defaults' and `dcl-font-lock-keywords')."
- (setq-local indent-line-function 'dcl-indent-line)
+ (setq-local indent-line-function #'dcl-indent-line)
(setq-local comment-start "!")
(setq-local comment-end "")
(setq-local comment-multi-line nil)
@@ -591,7 +549,7 @@ There is some minimal font-lock support (see vars
(setq imenu-generic-expression dcl-imenu-generic-expression)
(setq imenu-case-fold-search t)
- (setq imenu-create-index-function 'dcl-imenu-create-index-function)
+ (setq imenu-create-index-function #'dcl-imenu-create-index-function)
(make-local-variable 'dcl-comment-line-regexp)
(make-local-variable 'dcl-block-begin-regexp)
@@ -899,7 +857,7 @@ Returns one of the following symbols:
;;;---------------------------------------------------------------------------
(defun dcl-show-line-type ()
- "Test dcl-get-line-type."
+ "Test `dcl-get-line-type'."
(interactive)
(let ((type (dcl-get-line-type)))
(cond
@@ -944,8 +902,7 @@ $ if cond
$ then
$ if cond
$ then
-$ ! etc
-"
+$ ! etc"
;; calculate indentation if it's an interesting indent-type,
;; otherwise return nil to get the default indentation
(let ((indent))
@@ -974,8 +931,7 @@ $ xxx
If you use this function you will probably want to add \"then\" to
dcl-electric-reindent-regexps and define the key \"n\" as
-dcl-electric-character.
-"
+dcl-electric-character."
(let ((case-fold-search t))
(save-excursion
(cond
@@ -1018,17 +974,17 @@ see if the current lines should be indented.
Analyze the current line to see if it should be `outdented'.
Calculate the indentation of the current line, either with the default
-method or by calling dcl-calc-command-indent-function if it is
+method or by calling `dcl-calc-command-indent-function' if it is
non-nil.
If the current line should be outdented, calculate its indentation,
either with the default method or by calling
-dcl-calc-command-indent-function if it is non-nil.
+`dcl-calc-command-indent-function' if it is non-nil.
Rules for default indentation:
-If it is the first line in the buffer, indent dcl-margin-offset.
+If it is the first line in the buffer, indent `dcl-margin-offset'.
Go to the previous command line with a command on it.
Find out how much it is indented (cur-indent).
@@ -1036,7 +992,7 @@ Look at the first word on the line to see if the indentation should be
adjusted. Skip margin-label, continuations and comments while looking for
the first word. Save this buffer position as `last-point'.
If the first word after a label is SUBROUTINE, set extra-indent to
-dcl-margin-offset.
+`dcl-margin-offset'.
First word extra-indent
THEN +dcl-basic-offset
@@ -1193,8 +1149,7 @@ Indented lines will align with either:
* the innermost nonclosed parenthesis
$ if ((a.eq.b .and. -
d.eq.c .or. f$function(xxxx, -
- yyy)))
-"
+ yyy)))"
(let ((case-fold-search t)
indent)
(save-excursion
@@ -1374,7 +1329,7 @@ Adjusts indentation on the current line. Data lines are not indented."
;;;-------------------------------------------------------------------------
(defun dcl-indent-command ()
- "Indents the complete command line that point is on.
+ "Indent the complete command line that point is on.
This includes continuation lines."
(interactive "*")
(let ((type (dcl-get-line-type)))
@@ -1421,7 +1376,7 @@ the lines indentation; otherwise insert a tab."
;;;-------------------------------------------------------------------------
(defun dcl-electric-character (arg)
- "Inserts a character and indents if necessary.
+ "Insert a character and indent if necessary.
Insert a character if the user gave a numeric argument or the flag
`dcl-electric-characters' is not set. If an argument was given,
insert that many characters.
@@ -1438,7 +1393,7 @@ regexps in `dcl-electric-reindent-regexps'."
(let ((case-fold-search t))
;; There must be a better way than (memq t ...).
;; (apply 'or ...) didn't work
- (if (memq t (mapcar 'dcl-was-looking-at dcl-electric-reindent-regexps))
+ (if (memq t (mapcar #'dcl-was-looking-at dcl-electric-reindent-regexps))
(dcl-indent-line)))))
@@ -1614,7 +1569,7 @@ Must return a string."
((fboundp action)
(funcall action option-assoc))
((eq action 'toggle)
- (not (eval option)))
+ (not (symbol-value option)))
((eq action 'curval)
(cond ((or (stringp (symbol-value option))
(numberp (symbol-value option)))
@@ -1782,7 +1737,7 @@ Set or update the value of VAR in the current buffers
(setq continue nil)
(beginning-of-line)
(insert (concat prefix-string (symbol-name var) ": "
- (prin1-to-string (eval var)) " "
+ (prin1-to-string (symbol-value var)) " "
suffix-string "\n")))
;; Is it the variable we are looking for?
(if (eq var found-var)
@@ -1795,7 +1750,7 @@ Set or update the value of VAR in the current buffers
(delete-region (point) (progn (read (current-buffer))
(point)))
(insert " ")
- (prin1 (eval var) (current-buffer))
+ (prin1 (symbol-value var) (current-buffer))
(skip-chars-backward "\n")
(skip-chars-forward " \t")
(or (if suffix (looking-at suffix) (eolp))
@@ -1828,15 +1783,15 @@ Set or update the value of VAR in the current buffers
(concat " " comment-end))))))
(insert (concat def-prefix "Local variables:" def-suffix "\n"))
(insert (concat def-prefix (symbol-name var) ": "
- (prin1-to-string (eval var)) def-suffix "\n"))
+ (prin1-to-string (symbol-value var)) def-suffix "\n"))
(insert (concat def-prefix "end:" def-suffix)))
)))
;;;-------------------------------------------------------------------------
(defun dcl-save-all-options ()
- "Save all dcl-mode options for this buffer.
-Saves or updates all dcl-mode related options in a `Local Variables:'
+ "Save all `dcl-mode' options for this buffer.
+Saves or updates all `dcl-mode' related options in a `Local Variables:'
section at the end of the current buffer."
(interactive "*")
(mapcar (lambda (option-assoc)
@@ -1862,7 +1817,8 @@ still be present in the `Local Variables:' section with its old value."
(option-name (symbol-name option)))
(if (and (string-equal "dcl-"
(substring option-name 0 4))
- (not (equal (default-value option) (eval option))))
+ (not (equal (default-value option)
+ (symbol-value option))))
(dcl-save-local-variable option "$! "))))
dcl-option-alist))
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index 9e570b6c03f..2a37110f6ae 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -1,4 +1,4 @@
-;;; ebnf-abn.el --- parser for ABNF (Augmented BNF)
+;;; ebnf-abn.el --- parser for ABNF (Augmented BNF) -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -39,10 +39,6 @@
;;
;; See the URL:
;; `https://www.ietf.org/rfc/rfc2234.txt'
-;; or
-;; `http://www.faqs.org/rfcs/rfc2234.html'
-;; or
-;; `http://www.rnp.br/ietf/rfc/rfc2234.txt'
;; ("Augmented BNF for Syntax Specifications: ABNF").
;;
;;
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index 93ebfe8654d..e6717cbdf01 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -1,4 +1,4 @@
-;;; ebnf-bnf.el --- parser for EBNF
+;;; ebnf-bnf.el --- parser for EBNF -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index 66e5dd095ea..93bae5a33c5 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -1,4 +1,4 @@
-;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML)
+;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML) -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 389049e39a9..5d8541931e1 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -1,4 +1,4 @@
-;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX)
+;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX) -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index d25ff3ecb4b..b4532c76251 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -1,4 +1,4 @@
-;;; ebnf-iso.el --- parser for ISO EBNF
+;;; ebnf-iso.el --- parser for ISO EBNF -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -38,7 +38,7 @@
;; ---------------
;;
;; See the URL:
-;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
+;; `https://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
;; ("International Standard of the ISO EBNF Notation").
;;
;;
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index b724d75a7e5..84e59cc0a51 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -1,4 +1,4 @@
-;;; ebnf-otz.el --- syntactic chart OpTimiZer
+;;; ebnf-otz.el --- syntactic chart OpTimiZer -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index 2765d03acba..816cc432d1b 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -1,4 +1,4 @@
-;;; ebnf-yac.el --- parser for Yacc/Bison
+;;; ebnf-yac.el --- parser for Yacc/Bison -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -271,13 +271,13 @@
(let ((table (make-vector 256 'error)))
;; upper & lower case letters:
(mapc
- #'(lambda (char)
- (aset table char 'non-terminal))
+ (lambda (char)
+ (aset table char 'non-terminal))
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
;; printable characters:
(mapc
- #'(lambda (char)
- (aset table char 'character))
+ (lambda (char)
+ (aset table char 'character))
"!#$&()*+-.0123456789=?@[\\]^_`~")
;; Override space characters:
(aset table ?\n 'space) ; [NL] linefeed
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index b376423c185..884104a16f7 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -330,7 +330,7 @@ Please send all bug fixes and enhancements to
;; ("Augmented BNF for Syntax Specifications: ABNF").
;;
;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
-;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
+;; `https://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
;; ("International Standard of the ISO EBNF Notation").
;; The following variables *ONLY* have effect with this
;; setting:
@@ -1783,7 +1783,7 @@ Valid values are:
(\"Augmented BNF for Syntax Specifications: ABNF\").
`iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
- `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
+ `https://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
(\"International Standard of the ISO EBNF Notation\").
The following variables *ONLY* have effect with this
setting:
@@ -2920,7 +2920,7 @@ See `ebnf-style-database' documentation."
value
(and (car value) (ebnf-apply-style1 (car value)))
(while (setq value (cdr value))
- (set (caar value) (eval (cdar value)))))))
+ (set (caar value) (eval (cdar value) t))))))
(defun ebnf-check-style-values (values)
@@ -4337,7 +4337,7 @@ end
(let ((len (1- (length str)))
(index 0)
new start fmt)
- (while (setq start (string-match "%" str index))
+ (while (setq start (string-search "%" str index))
(setq fmt (if (< start len) (aref str (1+ start)) ?\?)
new (concat new
(substring str index start)
@@ -4398,8 +4398,8 @@ end
(defun ebnf-format-float (&rest floats)
(mapconcat
- #'(lambda (float)
- (format ebnf-format-float float))
+ (lambda (float)
+ (format ebnf-format-float float))
floats
" "))
@@ -4959,8 +4959,8 @@ killed after process termination."
(defvar ebnf-map-name
(let ((map (make-vector 256 ?\_)))
- (mapc #'(lambda (char)
- (aset map char char))
+ (mapc (lambda (char)
+ (aset map char char))
(concat "#$%&+-.0123456789=?@~"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"abcdefghijklmnopqrstuvwxyz"))
@@ -5487,7 +5487,7 @@ killed after process termination."
(ebnf-shape-value ebnf-chart-shape
ebnf-terminal-shape-alist))
(format "/UserArrow{%s}def\n"
- (let ((arrow (eval ebnf-user-arrow)))
+ (let ((arrow (eval ebnf-user-arrow t)))
(if (stringp arrow)
arrow
"")))
@@ -6290,7 +6290,7 @@ killed after process termination."
(defun ebnf-log-header (format-str &rest args)
(when ebnf-log
(apply
- 'ebnf-log
+ #'ebnf-log
(concat
"\n\n===============================================================\n\n"
format-str)
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index a174d4851e5..7524c280f25 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -35,7 +35,6 @@
(require 'cl-lib)
(require 'seq)
-(require 'easymenu)
(require 'view)
(require 'ebuff-menu)
@@ -795,7 +794,7 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree."
(ebrowse-hs-version header) ebrowse-version-string))
;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to
;; prevent a GC that would not free any memory.
- (let ((gc-cons-threshold 2000000))
+ (let ((gc-cons-threshold (max gc-cons-threshold 2000000)))
(while (not (progn (skip-chars-forward " \t\n") (eobp)))
(let* ((root (read (current-buffer)))
(old-root-ptr (ebrowse-class-in-tree root tree)))
@@ -3185,8 +3184,8 @@ MEMBER-NAME is the name of the member found."
(let* ((start (point))
(name (progn (skip-chars-forward "a-zA-Z0-9_")
(buffer-substring start (point))))
- class)
- (list class name))))
+ ) ;; class
+ (list nil name)))) ;; class
(defun ebrowse-tags-choose-class (_tree header name initial-class-name)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index a0968663163..542f8ad0b1b 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -46,160 +46,149 @@ It has `lisp-mode-abbrev-table' as its parent."
"Syntax table used in `emacs-lisp-mode'.")
(defvar emacs-lisp-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Emacs-Lisp"))
- (lint-map (make-sparse-keymap))
- (prof-map (make-sparse-keymap))
- (tracing-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\t" 'completion-at-point)
(define-key map "\e\C-x" 'eval-defun)
(define-key map "\e\C-q" 'indent-pp-sexp)
- (bindings--define-key map [menu-bar emacs-lisp]
- (cons "Emacs-Lisp" menu-map))
- (bindings--define-key menu-map [eldoc]
- '(menu-item "Auto-Display Documentation Strings" eldoc-mode
- :button (:toggle . (bound-and-true-p eldoc-mode))
- :help "Display the documentation string for the item under cursor"))
- (bindings--define-key menu-map [checkdoc]
- '(menu-item "Check Documentation Strings" checkdoc
- :help "Check documentation strings for style requirements"))
- (bindings--define-key menu-map [re-builder]
- '(menu-item "Construct Regexp" re-builder
- :help "Construct a regexp interactively"))
- (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
- (bindings--define-key tracing-map [tr-a]
- '(menu-item "Untrace All" untrace-all
- :help "Untrace all currently traced functions"))
- (bindings--define-key tracing-map [tr-uf]
- '(menu-item "Untrace Function..." untrace-function
- :help "Untrace function, and possibly activate all remaining advice"))
- (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
- (bindings--define-key tracing-map [tr-q]
- '(menu-item "Trace Function Quietly..." trace-function-background
- :help "Trace the function with trace output going quietly to a buffer"))
- (bindings--define-key tracing-map [tr-f]
- '(menu-item "Trace Function..." trace-function
- :help "Trace the function given as an argument"))
- (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
- (bindings--define-key prof-map [prof-restall]
- '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
- :help "Restore the original definitions of all functions being profiled"))
- (bindings--define-key prof-map [prof-restfunc]
- '(menu-item "Remove Instrumentation for Function..." elp-restore-function
- :help "Restore an instrumented function to its original definition"))
-
- (bindings--define-key prof-map [sep-rem] menu-bar-separator)
- (bindings--define-key prof-map [prof-resall]
- '(menu-item "Reset Counters for All Functions" elp-reset-all
- :help "Reset the profiling information for all functions being profiled"))
- (bindings--define-key prof-map [prof-resfunc]
- '(menu-item "Reset Counters for Function..." elp-reset-function
- :help "Reset the profiling information for a function"))
- (bindings--define-key prof-map [prof-res]
- '(menu-item "Show Profiling Results" elp-results
- :help "Display current profiling results"))
- (bindings--define-key prof-map [prof-pack]
- '(menu-item "Instrument Package..." elp-instrument-package
- :help "Instrument for profiling all function that start with a prefix"))
- (bindings--define-key prof-map [prof-func]
- '(menu-item "Instrument Function..." elp-instrument-function
- :help "Instrument a function for profiling"))
- ;; Maybe this should be in a separate submenu from the ELP stuff?
- (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
- (bindings--define-key prof-map [prof-natprof-stop]
- '(menu-item "Stop Native Profiler" profiler-stop
- :help "Stop recording profiling information"
- :enable (and (featurep 'profiler)
- (profiler-running-p))))
- (bindings--define-key prof-map [prof-natprof-report]
- '(menu-item "Show Profiler Report" profiler-report
- :help "Show the current profiler report"
- :enable (and (featurep 'profiler)
- (profiler-running-p))))
- (bindings--define-key prof-map [prof-natprof-start]
- '(menu-item "Start Native Profiler..." profiler-start
- :help "Start recording profiling information"))
-
- (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
- (bindings--define-key lint-map [lint-di]
- '(menu-item "Lint Directory..." elint-directory
- :help "Lint a directory"))
- (bindings--define-key lint-map [lint-f]
- '(menu-item "Lint File..." elint-file
- :help "Lint a file"))
- (bindings--define-key lint-map [lint-b]
- '(menu-item "Lint Buffer" elint-current-buffer
- :help "Lint the current buffer"))
- (bindings--define-key lint-map [lint-d]
- '(menu-item "Lint Defun" elint-defun
- :help "Lint the function at point"))
- (bindings--define-key menu-map [edebug-defun]
- '(menu-item "Instrument Function for Debugging" edebug-defun
- :help "Evaluate the top level form point is in, stepping through with Edebug"
- :keys "C-u C-M-x"))
- (bindings--define-key menu-map [separator-byte] menu-bar-separator)
- (bindings--define-key menu-map [disas]
- '(menu-item "Disassemble Byte Compiled Object..." disassemble
- :help "Print disassembled code for OBJECT in a buffer"))
- (bindings--define-key menu-map [byte-recompile]
- '(menu-item "Byte-recompile Directory..." byte-recompile-directory
- :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
- (bindings--define-key menu-map [emacs-byte-compile-and-load]
- '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
- :help "Byte-compile the current file (if it has changed), then load compiled code"))
- (bindings--define-key menu-map [byte-compile]
- '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
- :help "Byte compile the file containing the current buffer"))
- (bindings--define-key menu-map [separator-eval] menu-bar-separator)
- (bindings--define-key menu-map [ielm]
- '(menu-item "Interactive Expression Evaluation" ielm
- :help "Interactively evaluate Emacs Lisp expressions"))
- (bindings--define-key menu-map [eval-buffer]
- '(menu-item "Evaluate Buffer" eval-buffer
- :help "Execute the current buffer as Lisp code"))
- (bindings--define-key menu-map [eval-region]
- '(menu-item "Evaluate Region" eval-region
- :help "Execute the region as Lisp code"
- :enable mark-active))
- (bindings--define-key menu-map [eval-sexp]
- '(menu-item "Evaluate Last S-expression" eval-last-sexp
- :help "Evaluate sexp before point; print value in echo area"))
- (bindings--define-key menu-map [separator-format] menu-bar-separator)
- (bindings--define-key menu-map [comment-region]
- '(menu-item "Comment Out Region" comment-region
- :help "Comment or uncomment each line in the region"
- :enable mark-active))
- (bindings--define-key menu-map [indent-region]
- '(menu-item "Indent Region" indent-region
- :help "Indent each nonblank line in the region"
- :enable mark-active))
- (bindings--define-key menu-map [indent-line]
- '(menu-item "Indent Line" lisp-indent-line))
map)
"Keymap for Emacs Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
+(easy-menu-define emacs-lisp-mode-menu emacs-lisp-mode-map
+ "Menu for Emacs Lisp mode."
+ '("Emacs-Lisp"
+ ["Indent Line" lisp-indent-line]
+ ["Indent Region" indent-region
+ :help "Indent each nonblank line in the region"
+ :active mark-active]
+ ["Comment Out Region" comment-region
+ :help "Comment or uncomment each line in the region"
+ :active mark-active]
+ "---"
+ ["Evaluate Last S-expression" eval-last-sexp
+ :help "Evaluate sexp before point; print value in echo area"]
+ ["Evaluate Region" eval-region
+ :help "Execute the region as Lisp code"
+ :active mark-active]
+ ["Evaluate Buffer" eval-buffer
+ :help "Execute the current buffer as Lisp code"]
+ ["Interactive Expression Evaluation" ielm
+ :help "Interactively evaluate Emacs Lisp expressions"]
+ "---"
+ ["Byte-compile This File" emacs-lisp-byte-compile
+ :help "Byte compile the file containing the current buffer"]
+ ["Byte-compile and Load" emacs-lisp-byte-compile-and-load
+ :help "Byte-compile the current file (if it has changed), then load compiled code"]
+ ["Byte-recompile Directory..." byte-recompile-directory
+ :help "Recompile every `.el' file in DIRECTORY that needs recompilation"]
+ ["Disassemble Byte Compiled Object..." disassemble
+ :help "Print disassembled code for OBJECT in a buffer"]
+ "---"
+ ["Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"]
+ ("Navigation"
+ ["Forward Sexp" forward-sexp
+ :help "Go to the next s-expression"]
+ ["Backward Sexp" backward-sexp
+ :help "Go to the previous s-expression"]
+ ["Beginning Of Defun" beginning-of-defun
+ :help "Go to the start of the current function definition"]
+ ["Up List" up-list
+ :help "Go one level up and forward"])
+ ("Linting"
+ ["Lint Defun" elint-defun
+ :help "Lint the function at point"]
+ ["Lint Buffer" elint-current-buffer
+ :help "Lint the current buffer"]
+ ["Lint File..." elint-file
+ :help "Lint a file"]
+ ["Lint Directory..." elint-directory
+ :help "Lint a directory"])
+ ("Profiling"
+ ;; Maybe this should be in a separate submenu from the ELP stuff?
+ ["Start Native Profiler..." profiler-start
+ :help "Start recording profiling information"]
+ ["Show Profiler Report" profiler-report
+ :help "Show the current profiler report"
+ :active (and (featurep 'profiler)
+ (profiler-running-p))]
+ ["Stop Native Profiler" profiler-stop
+ :help "Stop recording profiling information"
+ :active (and (featurep 'profiler)
+ (profiler-running-p))]
+ "---"
+ ["Instrument Function..." elp-instrument-function
+ :help "Instrument a function for profiling"]
+ ["Instrument Package..." elp-instrument-package
+ :help "Instrument for profiling all function that start with a prefix"]
+ ["Show Profiling Results" elp-results
+ :help "Display current profiling results"]
+ ["Reset Counters for Function..." elp-reset-function
+ :help "Reset the profiling information for a function"]
+ ["Reset Counters for All Functions" elp-reset-all
+ :help "Reset the profiling information for all functions being profiled"]
+ "---"
+ ["Remove Instrumentation for All Functions" elp-restore-all
+ :help "Restore the original definitions of all functions being profiled"]
+ ["Remove Instrumentation for Function..." elp-restore-function
+ :help "Restore an instrumented function to its original definition"])
+ ("Tracing"
+ ["Trace Function..." trace-function
+ :help "Trace the function given as an argument"]
+ ["Trace Function Quietly..." trace-function-background
+ :help "Trace the function with trace output going quietly to a buffer"]
+ "---"
+ ["Untrace All" untrace-all
+ :help "Untrace all currently traced functions"]
+ ["Untrace Function..." untrace-function
+ :help "Untrace function, and possibly activate all remaining advice"])
+ ["Construct Regexp" re-builder
+ :help "Construct a regexp interactively"]
+ ["Check Documentation Strings" checkdoc
+ :help "Check documentation strings for style requirements"]
+ ["Auto-Display Documentation Strings" eldoc-mode
+ :help "Display the documentation string for the item under cursor"
+ :style toggle
+ :selected (bound-and-true-p eldoc-mode)]))
+
(defun emacs-lisp-byte-compile ()
"Byte compile the file containing the current buffer."
- (interactive)
+ (interactive nil emacs-lisp-mode)
(if buffer-file-name
(byte-compile-file buffer-file-name)
(error "The buffer must be saved in a file first")))
-(defun emacs-lisp-byte-compile-and-load ()
- "Byte-compile the current file (if it has changed), then load compiled code."
- (interactive)
+(defun emacs-lisp--before-compile-buffer ()
+ "Make sure the buffer is saved before compiling."
(or buffer-file-name
(error "The buffer must be saved in a file first"))
- (require 'bytecomp)
;; Recompile if file or buffer has changed since last compilation.
(if (and (buffer-modified-p)
(y-or-n-p (format "Save buffer %s first? " (buffer-name))))
- (save-buffer))
+ (save-buffer)))
+
+(defun emacs-lisp-byte-compile-and-load ()
+ "Byte-compile the current file (if it has changed), then load compiled code."
+ (interactive nil emacs-lisp-mode)
+ (emacs-lisp--before-compile-buffer)
+ (require 'bytecomp)
(byte-recompile-file buffer-file-name nil 0)
(load buffer-file-name))
+(declare-function native-compile "comp")
+(defun emacs-lisp-native-compile-and-load ()
+ "Native-compile synchronously the current file (if it has changed).
+Load the compiled code when finished.
+
+Use `emacs-lisp-byte-compile-and-load' in combination with
+`native-comp-deferred-compilation' set to `t' to achieve asynchronous
+native compilation."
+ (interactive nil emacs-lisp-mode)
+ (emacs-lisp--before-compile-buffer)
+ (load (native-compile buffer-file-name)))
+
(defun emacs-lisp-macroexpand ()
"Macroexpand the form after point.
Comments in the form will be lost."
@@ -523,7 +512,7 @@ functions are annotated with \"<f>\" via the
(end
(unless (or (eq beg (point-max))
(member (char-syntax (char-after beg))
- '(?\s ?\" ?\( ?\))))
+ '(?\" ?\()))
(condition-case nil
(save-excursion
(goto-char beg)
@@ -557,6 +546,7 @@ functions are annotated with \"<f>\" via the
((elisp--expect-function-p beg)
(list nil obarray
:predicate #'fboundp
+ :company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location))
@@ -570,6 +560,7 @@ functions are annotated with \"<f>\" via the
(symbol-plist sym)))
:annotation-function
(lambda (str) (if (fboundp (intern-soft str)) " <f>"))
+ :company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location))
@@ -580,6 +571,11 @@ functions are annotated with \"<f>\" via the
obarray
#'boundp
'strict))
+ :company-kind
+ (lambda (s)
+ (if (test-completion s elisp--local-variables-completion-table)
+ 'value
+ 'variable))
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location)))
@@ -626,11 +622,13 @@ functions are annotated with \"<f>\" via the
(looking-at "\\_<let\\*?\\_>"))))
(list t obarray
:predicate #'boundp
+ :company-kind (lambda (_) 'variable)
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location))
(_ (list nil obarray
:predicate #'fboundp
+ :company-kind #'elisp--company-kind
:company-doc-buffer #'elisp--company-doc-buffer
:company-docsig #'elisp--company-doc-string
:company-location #'elisp--company-location
@@ -646,6 +644,16 @@ functions are annotated with \"<f>\" via the
" " (cadr table-etc)))
(cddr table-etc)))))))))
+(defun elisp--company-kind (str)
+ (let ((sym (intern-soft str)))
+ (cond
+ ((or (macrop sym) (special-form-p sym)) 'keyword)
+ ((fboundp sym) 'function)
+ ((boundp sym) 'variable)
+ ((featurep sym) 'module)
+ ((facep sym) 'color)
+ (t 'text))))
+
(defun lisp-completion-at-point (&optional _predicate)
(declare (obsolete elisp-completion-at-point "25.1"))
(elisp-completion-at-point))
@@ -688,7 +696,7 @@ Each function should return a list of xrefs, or nil; the first
non-nil result supersedes the xrefs produced by
`elisp--xref-find-definitions'.")
-(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier)
(require 'find-func)
;; FIXME: use information in source near point to filter results:
;; (dvc-log-edit ...) - exclude 'feature
@@ -867,7 +875,7 @@ non-nil result supersedes the xrefs produced by
(declare-function xref-apropos-regexp "xref" (pattern))
-(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) pattern)
+(cl-defmethod xref-backend-apropos ((_backend (eql 'elisp)) pattern)
(apply #'nconc
(let ((regexp (xref-apropos-regexp pattern))
lst)
@@ -885,7 +893,8 @@ non-nil result supersedes the xrefs produced by
(facep sym)))
'strict))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'elisp)))
elisp--xref-identifier-completion-table)
(cl-defstruct (xref-elisp-location
@@ -904,7 +913,13 @@ non-nil result supersedes the xrefs produced by
(point-marker)))))))
(cl-defmethod xref-location-group ((l xref-elisp-location))
- (xref-elisp-location-file l))
+ (let ((file (xref-elisp-location-file l)))
+ (defvar find-function-C-source-directory)
+ (if (and find-function-C-source-directory
+ (string-match-p "\\`src/" file))
+ (concat find-function-C-source-directory
+ (substring file 3))
+ file)))
(defun elisp-load-path-roots ()
(if (boundp 'package-user-dir)
@@ -914,35 +929,31 @@ non-nil result supersedes the xrefs produced by
;;; Elisp Interaction mode
(defvar lisp-interaction-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Lisp-Interaction")))
+ (let ((map (make-sparse-keymap)))
(set-keymap-parent map lisp-mode-shared-map)
(define-key map "\e\C-x" 'eval-defun)
(define-key map "\e\C-q" 'indent-pp-sexp)
(define-key map "\e\t" 'completion-at-point)
(define-key map "\n" 'eval-print-last-sexp)
- (bindings--define-key map [menu-bar lisp-interaction]
- (cons "Lisp-Interaction" menu-map))
- (bindings--define-key menu-map [eval-defun]
- '(menu-item "Evaluate Defun" eval-defun
- :help "Evaluate the top-level form containing point, or after point"))
- (bindings--define-key menu-map [eval-print-last-sexp]
- '(menu-item "Evaluate and Print" eval-print-last-sexp
- :help "Evaluate sexp before point; print value into current buffer"))
- (bindings--define-key menu-map [edebug-defun-lisp-interaction]
- '(menu-item "Instrument Function for Debugging" edebug-defun
- :help "Evaluate the top level form point is in, stepping through with Edebug"
- :keys "C-u C-M-x"))
- (bindings--define-key menu-map [indent-pp-sexp]
- '(menu-item "Indent or Pretty-Print" indent-pp-sexp
- :help "Indent each line of the list starting just after point, or prettyprint it"))
- (bindings--define-key menu-map [complete-symbol]
- '(menu-item "Complete Lisp Symbol" completion-at-point
- :help "Perform completion on Lisp symbol preceding point"))
map)
"Keymap for Lisp Interaction mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
+(easy-menu-define lisp-interaction-mode-menu lisp-interaction-mode-map
+ "Menu for Lisp Interaction mode."
+ '("Lisp-Interaction"
+ ["Complete Lisp Symbol" completion-at-point
+ :help "Perform completion on Lisp symbol preceding point"]
+ ["Indent or Pretty-Print" indent-pp-sexp
+ :help "Indent each line of the list starting just after point, or prettyprint it"]
+ ["Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"]
+ ["Evaluate and Print" eval-print-last-sexp
+ :help "Evaluate sexp before point; print value into current buffer"]
+ ["Evaluate Defun" eval-defun
+ :help "Evaluate the top-level form containing point, or after point"]))
+
(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
"Major mode for typing and evaluating Lisp forms.
Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
@@ -1268,9 +1279,8 @@ If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
(interactive "P")
(if (null eval-expression-debug-on-error)
- (let ((value (elisp--eval-last-sexp eval-last-sexp-arg-internal)))
- (push value values)
- value)
+ (values--store-value
+ (elisp--eval-last-sexp eval-last-sexp-arg-internal))
(let ((value
(let ((debug-on-error elisp--eval-last-sexp-fake-value))
(cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
@@ -1316,8 +1326,7 @@ Reinitialize the face according to the `defface' specification."
((eq (car form) 'custom-declare-face)
;; Reset the face.
(let ((face-symbol (eval (nth 1 form) lexical-binding)))
- (setq face-new-frame-defaults
- (assq-delete-all face-symbol face-new-frame-defaults))
+ (remhash face-symbol face--new-frame-defaults)
(put face-symbol 'face-defface-spec nil)
(put face-symbol 'face-override-spec nil))
form)
@@ -1337,9 +1346,11 @@ if it already has a value.)
Return the result of evaluation."
;; FIXME: the print-length/level bindings should only be applied while
;; printing, not while evaluating.
+ (defvar elisp--eval-defun-result)
(let ((debug-on-error eval-expression-debug-on-error)
(print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
+ (print-level eval-expression-print-level)
+ elisp--eval-defun-result)
(save-excursion
;; Arrange for eval-region to "read" the (possibly) altered form.
;; eval-region handles recording which file defines a function or
@@ -1351,21 +1362,25 @@ Return the result of evaluation."
(end-of-defun)
(beginning-of-defun)
(setq beg (point))
- (setq form (read (current-buffer)))
+ (setq form (funcall load-read-function (current-buffer)))
(setq end (point)))
;; Alter the form if necessary.
(let ((form (eval-sexp-add-defvars
- (elisp--eval-defun-1 (macroexpand form)))))
+ (elisp--eval-defun-1
+ (macroexpand form)))))
(eval-region beg end standard-output
(lambda (_ignore)
;; Skipping to the end of the specified region
;; will make eval-region return.
(goto-char end)
- form))))))
- (let ((str (eval-expression-print-format (car values))))
- (if str (princ str)))
- ;; The result of evaluation has been put onto VALUES. So return it.
- (car values))
+ ;; This `setq' needs to be added *after* passing
+ ;; form through `elisp--eval-defun-1' since it
+ ;; would otherwise "hide" forms like `defvar's and
+ ;; thus defeat their special treatment.
+ `(setq elisp--eval-defun-result ,form))))))
+ (let ((str (eval-expression-print-format elisp--eval-defun-result)))
+ (if str (princ str)))
+ elisp--eval-defun-result))
(defun eval-defun (edebug-it)
"Evaluate the top-level form containing point, or after point.
@@ -1395,6 +1410,7 @@ which see."
(interactive "P")
(cond (edebug-it
(require 'edebug)
+ (defvar edebug-all-defs)
(eval-defun (not edebug-all-defs)))
(t
(if (null eval-expression-debug-on-error)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 869529ab2db..a1f806ae8c9 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -836,11 +836,7 @@ If no tags table is loaded, do nothing and return nil."
"Read a tag name, with defaulting and completion."
(let* ((completion-ignore-case (find-tag--completion-ignore-case))
(default (find-tag--default))
- (spec (completing-read (if default
- (format "%s (default %s): "
- (substring string 0 (string-match "[ :]+\\'" string))
- default)
- string)
+ (spec (completing-read (format-prompt string default)
(tags-lazy-completion-table)
nil nil nil nil default)))
(if (equal spec "")
@@ -899,7 +895,7 @@ onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
- (interactive (find-tag-interactive "Find tag: "))
+ (interactive (find-tag-interactive "Find tag"))
(setq find-tag-history (cons tagname find-tag-history))
;; Save the current buffer's value of `find-tag-hook' before
@@ -971,7 +967,7 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
(declare (obsolete xref-find-definitions "25.1"))
- (interactive (find-tag-interactive "Find tag: "))
+ (interactive (find-tag-interactive "Find tag"))
(let* ((buf (find-tag-noselect tagname next-p regexp-p))
(pos (with-current-buffer buf (point))))
(condition-case nil
@@ -1000,7 +996,7 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
(declare (obsolete xref-find-definitions-other-window "25.1"))
- (interactive (find-tag-interactive "Find tag other window: "))
+ (interactive (find-tag-interactive "Find tag other window"))
;; This hair is to deal with the case where the tag is found in the
;; selected window's buffer; without the hair, point is moved in both
@@ -1041,7 +1037,7 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
(declare (obsolete xref-find-definitions-other-frame "25.1"))
- (interactive (find-tag-interactive "Find tag other frame: "))
+ (interactive (find-tag-interactive "Find tag other frame"))
(let ((pop-up-frames t))
(with-suppressed-warnings ((obsolete find-tag-other-window))
(find-tag-other-window tagname next-p))))
@@ -1065,7 +1061,7 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
(declare (obsolete xref-find-apropos "25.1"))
- (interactive (find-tag-interactive "Find tag regexp: " t))
+ (interactive (find-tag-interactive "Find tag regexp" t))
;; We go through find-tag-other-window to do all the display hair there.
(funcall (if other-window 'find-tag-other-window 'find-tag)
regexp next-p t))
@@ -1604,11 +1600,11 @@ that do nothing."
;; This might be a neat idea, but it's too hairy at the moment.
;;(defmacro tags-with-syntax (&rest body)
+;; (declare (debug t))
;; `(with-syntax-table
;; (with-current-buffer (find-file-noselect (file-of-tag))
;; (syntax-table))
;; ,@body))
-;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
;; exact file name match, i.e. searched tag must match complete file
;; name including directories parts if there are some.
@@ -1812,7 +1808,7 @@ argument is passed to `next-file', which see)."
(defun tags-search (regexp &optional files)
"Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
-To continue searching for next match, use command \\[tags-loop-continue].
+To continue searching for next match, use the command \\[fileloop-continue].
If FILES if non-nil should be a list or an iterator returning the
files to search. The search will be restricted to these files.
@@ -1838,7 +1834,7 @@ Also see the documentation of the `tags-file-name' variable."
"Do `query-replace-regexp' of FROM with TO on all files listed in tags table.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
-with the command \\[tags-loop-continue].
+with the command \\[fileloop-continue].
For non-interactive use, superseded by `fileloop-initialize-replace'."
(declare (advertised-calling-convention (from to &optional delimited) "27.1"))
(interactive (query-replace-read-args "Tags query replace (regexp)" t t))
@@ -2063,22 +2059,43 @@ for \\[find-tag] (which see)."
If you want `xref-find-definitions' to find the tagged files by their
file name, add `tag-partial-file-name-match-p' to the list value.")
+(defcustom etags-xref-prefer-current-file nil
+ "Non-nil means show the matches in the current file first."
+ :type 'boolean
+ :version "28.1")
+
;;;###autoload
(defun etags--xref-backend () 'etags)
-(cl-defmethod xref-backend-identifier-at-point ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'etags)))
(find-tag--default))
-(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-table ((_backend
+ (eql 'etags)))
(tags-lazy-completion-table))
-(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql etags)))
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend
+ (eql 'etags)))
(find-tag--completion-ignore-case))
-(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
- (etags--xref-find-definitions symbol))
-
-(cl-defmethod xref-backend-apropos ((_backend (eql etags)) pattern)
+(cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
+ (let ((file (and buffer-file-name (expand-file-name buffer-file-name)))
+ (definitions (etags--xref-find-definitions symbol))
+ same-file-definitions)
+ (when (and etags-xref-prefer-current-file file)
+ (cl-delete-if
+ (lambda (definition)
+ (when (equal file
+ (xref-location-group
+ (xref-item-location definition)))
+ (push definition same-file-definitions)
+ t))
+ definitions)
+ (setq definitions (nconc (nreverse same-file-definitions)
+ definitions)))
+ definitions))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
(etags--xref-find-definitions (xref-apropos-regexp pattern) t))
(defun etags--xref-find-definitions (pattern &optional regexp?)
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index fa5724a3800..0d8b09c33c1 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -1,4 +1,4 @@
-;;; executable.el --- base functionality for executable interpreter scripts
+;;; executable.el --- base functionality for executable interpreter scripts -*- lexical-binding: t -*-
;; Copyright (C) 1994-1996, 2000-2021 Free Software Foundation, Inc.
@@ -54,41 +54,31 @@
"Base functionality for executable interpreter scripts."
:group 'processes)
-;; This used to default to `other', but that doesn't seem to have any
-;; significance. fx 2000-02-11.
-(defcustom executable-insert t ; 'other
+(defcustom executable-insert t
"Non-nil means offer to add a magic number to a file.
This takes effect when you switch to certain major modes,
including Shell-script mode (`sh-mode').
When you type \\[executable-set-magic], it always offers to add or
update the magic number."
-;;; :type '(choice (const :tag "off" nil)
-;;; (const :tag "on" t)
-;;; symbol)
- :type 'boolean
- :group 'executable)
-
+ :type 'boolean)
(defcustom executable-query 'function
"If non-nil, ask user before changing an existing magic number.
When this is `function', only ask when called non-interactively."
:type '(choice (const :tag "Don't Ask" nil)
(const :tag "Ask when non-interactive" function)
- (other :tag "Ask" t))
- :group 'executable)
+ (other :tag "Ask" t)))
(defcustom executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$"
"On files with this kind of name no magic is inserted or changed."
- :type 'regexp
- :group 'executable)
+ :type 'regexp)
(defcustom executable-prefix "#!"
"Interpreter magic number prefix inserted when there was no magic number.
Use of `executable-prefix-env' is preferable to this option."
:version "26.1" ; deprecated
- :type 'string
- :group 'executable)
+ :type 'string)
(defcustom executable-prefix-env nil
"If non-nil, use \"/usr/bin/env\" in interpreter magic number.
@@ -96,8 +86,7 @@ If this variable is non-nil, the interpreter magic number inserted
by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\",
otherwise it will be \"#!/path/to/INTERPRETER\"."
:version "26.1"
- :type 'boolean
- :group 'executable)
+ :type 'boolean)
(defcustom executable-chmod 73
"After saving, if the file is not executable, set this mode.
@@ -105,8 +94,7 @@ This mode passed to `set-file-modes' is taken absolutely when negative, or
relative to the files existing modes. Do nothing if this is nil.
Typical values are 73 (+x) or -493 (rwxr-xr-x)."
:type '(choice integer
- (const nil))
- :group 'executable)
+ (const nil)))
(defvar executable-command nil)
@@ -114,8 +102,7 @@ Typical values are 73 (+x) or -493 (rwxr-xr-x)."
(defcustom executable-self-display "tail"
"Command you use with argument `-n+2' to make text files self-display.
Note that the like of `more' doesn't work too well under Emacs \\[shell]."
- :type 'string
- :group 'executable)
+ :type 'string)
(make-obsolete-variable 'executable-self-display nil "25.1" 'set)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 5d96c62b418..77a807f21ae 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -284,17 +284,17 @@ If set to nil, don't suppress any zero counters."
(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 warning. If this form is included in a 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))
+ (let* ((file (if (fboundp 'macroexp-file-name)
+ (macroexp-file-name)
+ (and (not load-file-name)
+ (bound-and-true-p byte-compile-current-file))))
+ (sublog (if file
(intern
(file-name-nondirectory
- (file-name-sans-extension compile-file))))))
+ (file-name-sans-extension file))))))
`(flymake--log-1 ,level ',sublog ,msg ,@args)))
(defun flymake-error (text &rest args)
@@ -483,7 +483,7 @@ Currently, Flymake may provide these keyword-value pairs:
* `:recent-changes', a list of recent changes since the last time
the backend function was called for the buffer. An empty list
- indicates that no changes have been reocrded. If it is the
+ indicates that no changes have been recorded. If it is the
first time that this backend function is called for this
activation of `flymake-mode', then this argument isn't provided
at all (i.e. it's not merely nil).
@@ -741,7 +741,10 @@ to handle a report even if TOKEN was not expected. REGION is
a (BEG . END) pair of buffer positions indicating that this
report applies to that region."
(let* ((state (gethash backend flymake--backend-state))
- (first-report (not (flymake--backend-state-reported-p state))))
+ first-report)
+ (unless state
+ (error "Can't find state for %s in `flymake--backend-state'" backend))
+ (setf first-report (not (flymake--backend-state-reported-p state)))
(setf (flymake--backend-state-reported-p state) t)
(let (expected-token
new-diags)
@@ -1198,7 +1201,6 @@ default) no filter is applied."
'(" " flymake-mode-line-title flymake-mode-line-exception
flymake-mode-line-counters)
"Mode line construct for customizing Flymake information."
- :group 'flymake
:type '(repeat (choice string symbol)))
(defcustom flymake-mode-line-counter-format
@@ -1210,7 +1212,6 @@ default) no filter is applied."
This is a suitable place for placing the `flymake-error-counter',
`flymake-warning-counter' and `flymake-note-counter' constructs.
Separating each of these with space is not necessary."
- :group 'flymake
:type '(repeat (choice string symbol)))
(defvar flymake-mode-line-title '(:eval (flymake--mode-line-title))
@@ -1244,13 +1245,13 @@ correctly.")
"Flymake"
mouse-face mode-line-highlight
help-echo
- (lambda (&rest whatever)
- (concat
- (format "%s known backends\n" (hash-table-count flymake--backend-state))
- (format "%s running\n" (length (flymake-running-backends)))
- (format "%s disabled\n" (length (flymake-disabled-backends)))
- "mouse-1: Display minor mode menu\n"
- "mouse-2: Show help for minor mode"))
+ ,(lambda (&rest _)
+ (concat
+ (format "%s known backends\n" (hash-table-count flymake--backend-state))
+ (format "%s running\n" (length (flymake-running-backends)))
+ (format "%s disabled\n" (length (flymake-disabled-backends)))
+ "mouse-1: Display minor mode menu\n"
+ "mouse-2: Show help for minor mode"))
keymap
,(let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1]
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 3bef3986a10..707226fb2a5 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -650,74 +650,6 @@ Used in the Fortran entry in `hs-special-modes-alist'.")
(define-key map "7" 'fortran-electric-line-number)
(define-key map "8" 'fortran-electric-line-number)
(define-key map "9" 'fortran-electric-line-number)
-
- (easy-menu-define fortran-menu map "Menu for Fortran mode."
- `("Fortran"
- ["Manual" (info "(emacs)Fortran") :active t
- :help "Read the Emacs manual chapter on Fortran mode"]
- ("Customization"
- ,(custom-menu-create 'fortran)
- ;; FIXME useless?
- ["Set" Custom-set :active t
- :help "Set current value of all edited settings in the buffer"]
- ["Save" Custom-save :active t
- :help "Set and save all edited settings"]
- ["Reset to Current" Custom-reset-current :active t
- :help "Reset all edited settings to current"]
- ["Reset to Saved" Custom-reset-saved :active t
- :help "Reset all edited or set settings to saved"]
- ["Reset to Standard Settings" Custom-reset-standard :active t
- :help "Erase all customizations in buffer"]
- )
- "--"
- ["Comment Region" fortran-comment-region mark-active]
- ["Uncomment Region"
- (fortran-comment-region (region-beginning) (region-end) 1)
- mark-active]
- ["Indent Region" indent-region mark-active]
- ["Indent Subprogram" fortran-indent-subprogram t]
- "--"
- ["Beginning of Subprogram" fortran-beginning-of-subprogram :active t
- :help "Move point to the start of the current subprogram"]
- ["End of Subprogram" fortran-end-of-subprogram :active t
- :help "Move point to the end of the current subprogram"]
- ("Mark"
- :help "Mark a region of code"
- ["Subprogram" mark-defun t]
- ["IF Block" fortran-mark-if t]
- ["DO Block" fortran-mark-do t]
- )
- ["Narrow to Subprogram" narrow-to-defun t]
- ["Widen" widen t]
- "--"
- ["Temporary Column Ruler" fortran-column-ruler :active t
- :help "Briefly display Fortran column numbers"]
- ;; May not be '72', depending on fortran-line-length, but this
- ;; seems ok for a menu item.
- ["72-column Window" fortran-window-create :active t
- :help "Set window width to Fortran line length"]
- ["Full Width Window"
- (enlarge-window-horizontally (- (frame-width) (window-width)))
- :active (not (window-full-width-p))
- :help "Make window full width"]
- ["Momentary 72-Column Window" fortran-window-create-momentarily
- :active t :help "Briefly set window width to Fortran line length"]
- "--"
- ["Break Line at Point" fortran-split-line :active t
- :help "Break the current line at point"]
- ["Join Line" fortran-join-line :active t
- :help "Join the current line to the previous one"]
- ["Fill Statement/Comment" fill-paragraph t]
- "--"
- ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function
- :style toggle
- :help "Automatically fill text while typing in this buffer"]
- ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode
- :style toggle :help "Expand abbreviations while typing in this buffer"]
- ["Add Imenu Menu" imenu-add-menubar-index
- :active (not (lookup-key (current-local-map) [menu-bar index]))
- :included (fboundp 'imenu-add-to-menubar)
- :help "Add an index menu to the menu-bar"]))
map)
"Keymap used in Fortran mode.")
@@ -2209,6 +2141,81 @@ arg DO-SPACE prevents stripping the whitespace."
(point)))))
"main"))))
+;; The menu is defined at the end because `custom-menu-create' is
+;; called at load time and will result in (recursively) loading this
+;; file otherwise.
+(easy-menu-define fortran-menu fortran-mode-map "Menu for Fortran mode."
+ `("Fortran"
+ ["Manual" (info "(emacs)Fortran") :active t
+ :help "Read the Emacs manual chapter on Fortran mode"]
+ ("Customization"
+ ,(progn
+ ;; Tell the byte compiler that `features' is lexical.
+ (with-no-warnings (defvar features))
+ (let ((features (cons 'fortran features)))
+ (custom-menu-create 'fortran)))
+ ;; FIXME useless?
+ ["Set" Custom-set :active t
+ :help "Set current value of all edited settings in the buffer"]
+ ["Save" Custom-save :active t
+ :help "Set and save all edited settings"]
+ ["Reset to Current" Custom-reset-current :active t
+ :help "Reset all edited settings to current"]
+ ["Reset to Saved" Custom-reset-saved :active t
+ :help "Reset all edited or set settings to saved"]
+ ["Reset to Standard Settings" Custom-reset-standard :active t
+ :help "Erase all customizations in buffer"]
+ )
+ "--"
+ ["Comment Region" fortran-comment-region mark-active]
+ ["Uncomment Region"
+ (fortran-comment-region (region-beginning) (region-end) 1)
+ mark-active]
+ ["Indent Region" indent-region mark-active]
+ ["Indent Subprogram" fortran-indent-subprogram t]
+ "--"
+ ["Beginning of Subprogram" fortran-beginning-of-subprogram :active t
+ :help "Move point to the start of the current subprogram"]
+ ["End of Subprogram" fortran-end-of-subprogram :active t
+ :help "Move point to the end of the current subprogram"]
+ ("Mark"
+ :help "Mark a region of code"
+ ["Subprogram" mark-defun t]
+ ["IF Block" fortran-mark-if t]
+ ["DO Block" fortran-mark-do t]
+ )
+ ["Narrow to Subprogram" narrow-to-defun t]
+ ["Widen" widen t]
+ "--"
+ ["Temporary Column Ruler" fortran-column-ruler :active t
+ :help "Briefly display Fortran column numbers"]
+ ;; May not be '72', depending on fortran-line-length, but this
+ ;; seems ok for a menu item.
+ ["72-column Window" fortran-window-create :active t
+ :help "Set window width to Fortran line length"]
+ ["Full Width Window"
+ (enlarge-window-horizontally (- (frame-width) (window-width)))
+ :active (not (window-full-width-p))
+ :help "Make window full width"]
+ ["Momentary 72-Column Window" fortran-window-create-momentarily
+ :active t :help "Briefly set window width to Fortran line length"]
+ "--"
+ ["Break Line at Point" fortran-split-line :active t
+ :help "Break the current line at point"]
+ ["Join Line" fortran-join-line :active t
+ :help "Join the current line to the previous one"]
+ ["Fill Statement/Comment" fill-paragraph t]
+ "--"
+ ["Toggle Auto Fill" auto-fill-mode :selected auto-fill-function
+ :style toggle
+ :help "Automatically fill text while typing in this buffer"]
+ ["Toggle Abbrev Mode" abbrev-mode :selected abbrev-mode
+ :style toggle :help "Expand abbreviations while typing in this buffer"]
+ ["Add Imenu Menu" imenu-add-menubar-index
+ :active (not (lookup-key (current-local-map) [menu-bar index]))
+ :included (fboundp 'imenu-add-to-menubar)
+ :help "Add an index menu to the menu-bar"]))
+
(provide 'fortran)
;;; fortran.el ends here
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 1a96755bcf0..67ad39b7f46 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -101,6 +101,19 @@
(declare-function speedbar-delete-subblock "speedbar" (indent))
(declare-function speedbar-center-buffer-smartly "speedbar" ())
+;; FIXME: The declares below are necessary because we don't call `gud-def'
+;; at toplevel, so the compiler doesn't know under which circumstances
+;; they're defined.
+(declare-function gud-until "gud" (arg))
+(declare-function gud-print "gud" (arg))
+(declare-function gud-down "gud" (arg))
+(declare-function gud-up "gud" (arg))
+(declare-function gud-jump "gud" (arg))
+(declare-function gud-finish "gud" (arg))
+(declare-function gud-next "gud" (arg))
+(declare-function gud-stepi "gud" (arg))
+(declare-function gud-tbreak "gud" (arg))
+
(defvar tool-bar-map)
(defvar speedbar-initial-expansion-list-name)
(defvar speedbar-frame)
@@ -568,6 +581,23 @@ stopped thread is already selected."
:group 'gdb-buffers
:version "23.2")
+(defcustom gdb-registers-enable-filter nil
+ "If non-nil, enable register name filter in register buffer.
+Use `gdb-registers-filter-pattern-list' to control what register to
+filter."
+ :type 'boolean
+ :group 'gdb-buffers
+ :version "28.1")
+
+(defcustom gdb-registers-filter-pattern-list nil
+ "Patterns for names that are displayed in register buffer.
+Each pattern is a regular expression. GDB displays registers
+whose name matches any pattern in the list. Refresh the register
+buffer for the change to take effect."
+ :type '(repeat regexp)
+ :group 'gdb-buffers
+ :version "28.1")
+
(defvar gdb-debug-log nil
"List of commands sent to and replies received from GDB.
Most recent commands are listed first. This list stores only the last
@@ -966,6 +996,8 @@ detailed description of this mode.
(define-key gud-minor-mode-map [left-margin C-mouse-3]
'gdb-mouse-jump)
+ (gud-set-repeat-map-property 'gud-gdb-repeat-map)
+
(setq-local gud-gdb-completion-function 'gud-gdbmi-completions)
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
@@ -1350,7 +1382,7 @@ With arg, enter name of variable to be watched in the minibuffer."
(string-match "\\(\\S-+\\)" text)
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
(varnum (car var)))
- (if (string-match "\\." (car var))
+ (if (string-search "." (car var))
(message-box "Can only delete a root expression")
(gdb-var-delete-1 var varnum)))))
@@ -1447,14 +1479,14 @@ With arg, enter name of variable to be watched in the minibuffer."
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
- (cond ((string-match "\\+" text) ;expand this node
+ (cond ((string-search "+" text) ;expand this node
(let* ((var (assoc token gdb-var-list))
(expr (nth 1 var)) (children (nth 2 var)))
(if (or (<= (string-to-number children) gdb-max-children)
(y-or-n-p
(format "%s has %s children. Continue? " expr children)))
(gdb-var-list-children token))))
- ((string-match "-" text) ;contract this node
+ ((string-search "-" text) ;contract this node
(dolist (var gdb-var-list)
(if (string-match (concat token "\\.") (car var))
(setq gdb-var-list (delq var gdb-var-list))))
@@ -1931,7 +1963,7 @@ commands to be prefixed by \"-interpreter-exec console\".")
The string is enclosed in double quotes.
All embedded quotes, newlines, and backslashes are preceded with a backslash."
(setq string (replace-regexp-in-string "\\([\"\\]\\)" "\\\\\\&" string))
- (setq string (replace-regexp-in-string "\n" "\\n" string t t))
+ (setq string (string-replace "\n" "\\n" string))
(concat "\"" string "\""))
(defun gdb-input (command handler-function &optional trigger-name)
@@ -2384,7 +2416,7 @@ rule from an incomplete data stream. The parser will stay in this state until
the end of the current result or async record is reached."
(when (< gdbmi-bnf-offset (length gud-marker-acc))
;; Search the data stream for the end of the current record:
- (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
+ (let* ((newline-pos (string-search "\n" gud-marker-acc gdbmi-bnf-offset))
(is-progressive (equal (cdr class-command) 'progressive))
(is-complete (not (null newline-pos)))
result-str)
@@ -4380,6 +4412,26 @@ member."
'gdb-registers-mode
'gdb-invalidate-registers)
+(defun gdb-header-click-event-handler (function)
+ "Return a function that handles clicking event on gdb header buttons.
+
+This function switches to the window where the header locates and
+executes FUNCTION."
+ (lambda (event)
+ (interactive "e")
+ (save-selected-window
+ ;; Make sure we are in the right buffer.
+ (select-window (posn-window (event-start event)))
+ (funcall function))))
+
+(defun gdb-registers-toggle-filter ()
+ "Toggle register filter."
+ (interactive)
+ (setq gdb-registers-enable-filter
+ (not gdb-registers-enable-filter))
+ ;; Update the register buffer.
+ (gdb-invalidate-registers 'update))
+
(defun gdb-registers-handler-custom ()
(when gdb-register-names
(let ((register-values
@@ -4390,17 +4442,27 @@ member."
(value (gdb-mi--field register 'value))
(register-name (nth (string-to-number register-number)
gdb-register-names)))
- (gdb-table-add-row
- table
- (list
- (propertize register-name
- 'font-lock-face font-lock-variable-name-face)
- (if (member register-number gdb-changed-registers)
- (propertize value 'font-lock-face font-lock-warning-face)
- value))
- `(mouse-face highlight
- help-echo "mouse-2: edit value"
- gdb-register-name ,register-name))))
+ ;; Add register if `gdb-registers-filter-pattern-list' is nil;
+ ;; or any pattern that `gdb-registers-filter-pattern-list'
+ ;; matches.
+ (when (or (null gdb-registers-enable-filter)
+ ;; Return t if any register name matches a pattern.
+ (cl-loop for pattern
+ in gdb-registers-filter-pattern-list
+ if (string-match pattern register-name)
+ return t
+ finally return nil))
+ (gdb-table-add-row
+ table
+ (list
+ (propertize register-name
+ 'font-lock-face font-lock-variable-name-face)
+ (if (member register-number gdb-changed-registers)
+ (propertize value 'font-lock-face font-lock-warning-face)
+ value))
+ `(mouse-face highlight
+ help-echo "mouse-2: edit value"
+ gdb-register-name ,register-name)))))
(insert (gdb-table-string table " ")))
(setq mode-name
(gdb-current-context-mode-name "Registers"))))
@@ -4428,6 +4490,7 @@ member."
(gdb-get-buffer-create
'gdb-locals-buffer
gdb-thread-number) t)))
+ (define-key map "f" #'gdb-registers-toggle-filter)
map))
(defvar gdb-registers-header
@@ -4437,7 +4500,31 @@ member."
mode-line-inactive)
" "
(gdb-propertize-header "Registers" gdb-registers-buffer
- nil nil mode-line)))
+ nil nil mode-line)
+ " "
+ '(:eval
+ (format
+ "[filter %s %s]"
+ (propertize
+ (if gdb-registers-enable-filter "[on]" "[off]")
+ 'face (if gdb-registers-enable-filter
+ '(:weight bold :inherit success)
+ 'shadow)
+ 'help-echo "mouse-1: toggle filter"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1 (gdb-header-click-event-handler
+ #'gdb-registers-toggle-filter)))
+ (propertize
+ "[set]"
+ 'face 'mode-line
+ 'help-echo "mouse-1: Customize filter patterns"
+ 'mouse-face 'mode-line-highlight
+ 'local-map (gdb-make-header-line-mouse-map
+ 'mouse-1 (lambda ()
+ (interactive)
+ (customize-variable-other-window
+ 'gdb-registers-filter-pattern-list))))))))
(define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
"Major mode for gdb registers."
@@ -4512,7 +4599,7 @@ overlay arrow in source buffer."
(let ((frame (gdb-mi--field (gdb-mi--partial-output) 'frame)))
(when frame
(setq gdb-selected-frame (gdb-mi--field frame 'func))
- (setq gdb-selected-file (gdb-mi--field frame 'fullname))
+ (setq gdb-selected-file (file-local-name (gdb-mi--field frame 'fullname)))
(setq gdb-frame-number (gdb-mi--field frame 'level))
(setq gdb-frame-address (gdb-mi--field frame 'addr))
(let ((line (gdb-mi--field frame 'line)))
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index a0f5d36bb65..cd92175bd61 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -321,10 +321,6 @@ separators (like underscores) at places they belong to."
(remove-hook 'write-file-functions
'glasses-convert-to-unreadable t)))))
-
-;;; Announce
-
(provide 'glasses)
-
;;; glasses.el ends here
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index d6ee8bb4236..b2a9b3e3206 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -88,9 +88,9 @@ To make grep highlight matches even into a pipe, you need the option
`always' that forces grep to use `--color=always' to unconditionally
output escape sequences.
-In interactive usage, the actual value of this variable is set up
-by `grep-compute-defaults' when the default value is `auto-detect'.
-To change the default value, use \\[customize] or call the function
+If the value is `auto-detect' (the default), `grep' will call
+`grep-compute-defaults' to compute the value. To change the
+default value, use \\[customize] or call the function
`grep-apply-setting'."
:type '(choice (const :tag "Do not highlight matches with grep markers" nil)
(const :tag "Highlight matches with grep markers" t)
@@ -279,57 +279,39 @@ See `compilation-error-screen-columns'."
(define-key map "}" 'compilation-next-file)
(define-key map "\t" 'compilation-next-error)
(define-key map [backtab] 'compilation-previous-error)
-
- ;; Set up the menu-bar
- (define-key map [menu-bar grep]
- (cons "Grep" (make-sparse-keymap "Grep")))
-
- (define-key map [menu-bar grep grep-find-toggle-abbreviation]
- '(menu-item "Toggle command abbreviation"
- grep-find-toggle-abbreviation
- :help "Toggle showing verbose command options"))
- (define-key map [menu-bar grep compilation-separator3] '("----"))
- (define-key map [menu-bar grep compilation-kill-compilation]
- '(menu-item "Kill Grep" kill-compilation
- :help "Kill the currently running grep process"))
- (define-key map [menu-bar grep compilation-separator2] '("----"))
- (define-key map [menu-bar grep compilation-compile]
- '(menu-item
- "Compile..." compile
- :help
- "Compile the program including the current buffer. Default: run `make'"))
- (define-key map [menu-bar grep compilation-rgrep]
- '(menu-item "Recursive grep..." rgrep
- :help "User-friendly recursive grep in directory tree"))
- (define-key map [menu-bar grep compilation-lgrep]
- '(menu-item "Local grep..." lgrep
- :help "User-friendly grep in a directory"))
- (define-key map [menu-bar grep compilation-grep-find]
- '(menu-item "Grep via Find..." grep-find
- :help "Run grep via find, with user-specified args"))
- (define-key map [menu-bar grep compilation-grep]
- '(menu-item
- "Another grep..." grep
- :help
- "Run grep, with user-specified args, and collect output in a buffer."))
- (define-key map [menu-bar grep compilation-recompile]
- '(menu-item "Repeat grep" recompile
- :help "Run grep again"))
- (define-key map [menu-bar grep compilation-separator1] '("----"))
- (define-key map [menu-bar grep compilation-first-error]
- '(menu-item
- "First Match" first-error
- :help "Restart at the first match, visit corresponding location"))
- (define-key map [menu-bar grep compilation-previous-error]
- '(menu-item "Previous Match" previous-error
- :help "Visit the previous match and corresponding location"))
- (define-key map [menu-bar grep compilation-next-error]
- '(menu-item "Next Match" next-error
- :help "Visit the next match and corresponding location"))
map)
"Keymap for grep buffers.
`compilation-minor-mode-map' is a cdr of this.")
+(easy-menu-define grep-menu-map grep-mode-map
+ "Menu for grep buffers."
+ '("Grep"
+ ["Next Match" next-error
+ :help "Visit the next match and corresponding location"]
+ ["Previous Match" previous-error
+ :help "Visit the previous match and corresponding location"]
+ ["First Match" first-error
+ :help "Restart at the first match, visit corresponding location"]
+ "----"
+ ["Repeat grep" recompile
+ :help "Run grep again"]
+ ["Another grep..." grep
+ :help "Run grep, with user-specified args, and collect output in a buffer."]
+ ["Grep via Find..." grep-find
+ :help "Run grep via find, with user-specified args"]
+ ["Local grep..." lgrep
+ :help "User-friendly grep in a directory"]
+ ["Recursive grep..." rgrep
+ :help "User-friendly recursive grep in directory tree"]
+ ["Compile..." compile
+ :help "Compile the program including the current buffer. Default: run `make'"]
+ "----"
+ ["Kill Grep" kill-compilation
+ :help "Kill the currently running grep process"]
+ "----"
+ ["Toggle command abbreviation" grep-find-toggle-abbreviation
+ :help "Toggle showing verbose command options"]))
+
(defvar grep-mode-tool-bar-map
;; When bootstrapping, tool-bar-map is not properly initialized yet,
;; so don't do anything.
@@ -407,7 +389,7 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(and mbeg (next-single-property-change
mbeg 'font-lock-face nil end))))
(when mend
- (- mend beg))))))
+ (- mend beg 1))))))
nil nil
(3 '(face nil display ":")))
("^Binary file \\(.+\\) matches" 1 nil nil 0 1))
@@ -491,7 +473,7 @@ buffer `default-directory'."
(1 (if (eq (char-after (match-beginning 1)) ?\0)
`(face nil display ,(match-string 2)))))
;; Hide excessive part of rgrep command
- ("^find \\(\\. -type d .*\\\\)\\)"
+ ("^find \\(\\(?:-H \\)?\\. -type d .*\\(?:\\\\)\\|\")\"\\)\\)"
(1 (if grep-find-abbreviate grep-find-abbreviate-properties
'(face nil abbreviated-command t))))
;; Hide excessive part of lgrep command
@@ -714,11 +696,12 @@ The value depends on `grep-command', `grep-template',
(when (eq grep-highlight-matches 'auto-detect)
(setq grep-highlight-matches
(with-temp-buffer
- (and (grep-probe grep-program '(nil t nil "--help"))
- (progn
- (goto-char (point-min))
- (search-forward "--color" nil t))
- ;; Windows and DOS pipes fail `isatty' detection in Grep.
+ ;; The "grep --help" exit status varies; pay no attention to it.
+ (grep-probe grep-program '(nil t nil "--help"))
+ (goto-char (point-min))
+ (and (let ((case-fold-search nil))
+ (re-search-forward (rx "--color" (not (in "a-z"))) nil t))
+ ;; Windows and DOS pipes fail `isatty' detection in Grep.
(if (memq system-type '(windows-nt ms-dos))
'always 'auto)))))
@@ -792,25 +775,24 @@ The value depends on `grep-command', `grep-template',
(let ((gcmd (format "%s <C> %s <R>"
grep-program grep-options))
(null (if grep-use-null-device
- (format "%s " (null-device))
- "")))
- (cond ((eq grep-find-use-xargs 'gnu)
- (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s"
- find-program xargs-program gcmd))
- ((eq grep-find-use-xargs 'gnu-sort)
- (format "%s <D> <X> -type f <F> -print0 | sort -z | \"%s\" -0 %s"
- find-program xargs-program gcmd))
- ((eq grep-find-use-xargs 'exec)
- (format "%s <D> <X> -type f <F> -exec %s %s %s%s"
- find-program gcmd quot-braces null quot-scolon))
- ((eq grep-find-use-xargs 'exec-plus)
- (format "%s <D> <X> -type f <F> -exec %s %s%s +"
- find-program gcmd null quot-braces))
- (t
- (format "%s <D> <X> -type f <F> -print | \"%s\" %s"
- find-program xargs-program gcmd))))))))
-
- ;; Save defaults for this host.
+ (format "%s " (null-device))
+ "")))
+ (cond ((eq grep-find-use-xargs 'gnu)
+ (format "%s -H <D> <X> -type f <F> -print0 | \"%s\" -0 %s"
+ find-program xargs-program gcmd))
+ ((eq grep-find-use-xargs 'gnu-sort)
+ (format "%s -H <D> <X> -type f <F> -print0 | sort -z | \"%s\" -0 %s"
+ find-program xargs-program gcmd))
+ ((eq grep-find-use-xargs 'exec)
+ (format "%s -H <D> <X> -type f <F> -exec %s %s %s%s"
+ find-program gcmd quot-braces null quot-scolon))
+ ((eq grep-find-use-xargs 'exec-plus)
+ (format "%s -H <D> <X> -type f <F> -exec %s %s%s +"
+ find-program gcmd null quot-braces))
+ (t
+ (format "%s -H <D> <X> -type f <F> -print | \"%s\" %s"
+ find-program xargs-program gcmd))))))))
+ ;; Save defaults for this host.
(setq grep-host-defaults-alist
(delete (assq host-id grep-host-defaults-alist)
grep-host-defaults-alist))
@@ -933,7 +915,10 @@ list is empty)."
(if current-prefix-arg default grep-command)
'grep-history
(if current-prefix-arg nil default))))))
-
+ ;; If called non-interactively, also compute the defaults if we
+ ;; haven't already.
+ (when (eq grep-highlight-matches 'auto-detect)
+ (grep-compute-defaults))
(grep--save-buffers)
;; Setting process-setup-function makes exit-message-function work
;; even when async processes aren't supported.
@@ -1149,13 +1134,13 @@ command before it's run."
(and grep-find-ignored-files
(concat " --exclude="
(mapconcat
- #'(lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument ignore))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (cdr ignore))))))
+ (lambda (ignore)
+ (cond ((stringp ignore)
+ (shell-quote-argument ignore))
+ ((consp ignore)
+ (and (funcall (car ignore) dir)
+ (shell-quote-argument
+ (cdr ignore))))))
grep-find-ignored-files
" --exclude=")))
(and (eq grep-use-directories-skip t)
@@ -1289,13 +1274,13 @@ command before it's run."
;; we should use shell-quote-argument here
" -name "
(mapconcat
- #'(lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument ignore))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (cdr ignore))))))
+ (lambda (ignore)
+ (cond ((stringp ignore)
+ (shell-quote-argument ignore))
+ ((consp ignore)
+ (and (funcall (car ignore) dir)
+ (shell-quote-argument
+ (cdr ignore))))))
grep-find-ignored-files
" -o -name ")
" "
@@ -1361,6 +1346,13 @@ command before it's run."
(grep-highlight-matches 'always))
(rgrep regexp files dir confirm)))
+(defun grep-file-at-point (point)
+ "Return the name of the file at POINT a `grep-mode' buffer.
+The returned file name is relative."
+ (when-let ((msg (get-text-property point 'compilation-message))
+ (loc (compilation--message->loc msg)))
+ (caar (compilation--loc->file-struct loc))))
+
;;;###autoload
(defalias 'rzgrep 'zrgrep)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index eb114acdabc..08814ebcaaa 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -50,6 +50,30 @@
(defvar hl-line-mode)
(defvar hl-line-sticky-flag)
+(declare-function gdb-tooltip-print "gdb-mi" (expr))
+(declare-function gdb-tooltip-print-1 "gdb-mi" (expr))
+(declare-function gud-pp "gdb-mi" (arg))
+(declare-function gdb-var-delete "gdb-mi" ())
+(declare-function speedbar-toggle-line-expansion "gud" ())
+(declare-function speedbar-edit-line "gud" ())
+;; FIXME: The declares below are necessary because we don't call `gud-def'
+;; at toplevel, so the compiler doesn't know under which circumstances
+;; they're defined.
+(declare-function gud-statement "gud" (arg))
+(declare-function gud-until "gud" (arg))
+(declare-function gud-pv "gud" (arg))
+(declare-function gud-print "gud" (arg))
+(declare-function gud-down "gud" (arg))
+(declare-function gud-up "gud" (arg))
+(declare-function gud-jump "gud" (arg))
+(declare-function gud-finish "gud" (arg))
+(declare-function gud-cont "gud" (arg))
+(declare-function gud-next "gud" (arg))
+(declare-function gud-stepi "gud" (arg))
+(declare-function gud-step "gud" (arg))
+(declare-function gud-remove "gud" (arg))
+(declare-function gud-tbreak "gud" (arg))
+(declare-function gud-break "gud" (arg))
;; ======================================================================
;; GUD commands must be visible in C buffers visited by GUD
@@ -64,10 +88,9 @@ pdb (Python), and jdb."
(defcustom gud-key-prefix "\C-x\C-a"
"Prefix of all GUD commands valid in C buffers."
- :type 'key-sequence
- :group 'gud)
+ :type 'key-sequence)
-(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh)
+(global-set-key (vconcat gud-key-prefix "\C-l") #'gud-refresh)
;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack
(defvar gud-marker-filter nil)
@@ -151,10 +174,11 @@ Used to gray out relevant toolbar icons.")
(or (not (gdb-show-run-p))
(bound-and-true-p
gdb-active-process)))))
- ([go] menu-item (if (bound-and-true-p gdb-active-process)
- "Continue" "Run") gud-go
+ ([go] . (menu-item (if (bound-and-true-p gdb-active-process)
+ "Continue" "Run")
+ gud-go
:visible (and (eq gud-minor-mode 'gdbmi)
- (gdb-show-run-p)))
+ (gdb-show-run-p))))
([stop] menu-item "Stop" gud-stop-subjob
:visible (or (not (memq gud-minor-mode '(gdbmi pdb)))
(and (eq gud-minor-mode 'gdbmi)
@@ -186,13 +210,15 @@ Used to gray out relevant toolbar icons.")
(bound-and-true-p gdb-active-process))
:visible (and (string-equal
(buffer-local-value
- 'gud-target-name gud-comint-buffer) "emacs")
+ 'gud-target-name gud-comint-buffer)
+ "emacs")
(eq gud-minor-mode 'gdbmi)))
- ([print*] menu-item (if (eq gud-minor-mode 'jdb)
- "Dump object"
- "Print Dereference") gud-pstar
+ ([print*] . (menu-item (if (eq gud-minor-mode 'jdb)
+ "Dump object"
+ "Print Dereference")
+ gud-pstar
:enable (not gud-running)
- :visible (memq gud-minor-mode '(gdbmi gdb jdb)))
+ :visible (memq gud-minor-mode '(gdbmi gdb jdb))))
([print] menu-item "Print Expression" gud-print
:enable (not gud-running))
([watch] menu-item "Watch Expression" gud-watch
@@ -294,6 +320,32 @@ Used to gray out relevant toolbar icons.")
(tool-bar-local-item-from-menu
(car x) (cdr x) map gud-minor-mode-map))))
+(defvar gud-gdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `gud-gdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
+(defun gud-set-repeat-map-property (keymap-symbol)
+ "Set the `repeat-map' property of relevant gud commands to KEYMAP-SYMBOL.
+
+KEYMAP-SYMBOL is a symbol corresponding to some
+`<FOO>-repeat-map', a keymap containing gud commands that may be
+repeated when `repeat-mode' is on."
+ (map-keymap-internal (lambda (_ cmd)
+ (put cmd 'repeat-map keymap-symbol))
+ (symbol-value keymap-symbol)))
+
+
(defun gud-file-name (f)
"Transform a relative file name to an absolute file name.
Uses `gud-<MINOR-MODE>-directories' to find the source files."
@@ -333,7 +385,7 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
(eq gud-minor-mode 'gdbmi))
(make-local-variable 'gdb-define-alist)
(unless gdb-define-alist (gdb-create-define-alist))
- (add-hook 'after-save-hook 'gdb-create-define-alist nil t))
+ (add-hook 'after-save-hook #'gdb-create-define-alist nil t))
(make-local-variable 'gud-keep-buffer))
buf)))
@@ -380,8 +432,8 @@ we're in the GUD buffer)."
`(gud-call ,cmd arg)
;; Unused lexical warning if cmd does not use "arg".
cmd))))
- ,(if key `(local-set-key ,(concat "\C-c" key) ',func))
- ,(if key `(global-set-key (vconcat gud-key-prefix ,key) ',func))))
+ ,(if key `(local-set-key ,(concat "\C-c" key) #',func))
+ ,(if key `(global-set-key (vconcat gud-key-prefix ,key) #',func))))
;; Where gud-display-frame should put the debugging arrow; a cons of
;; (filename . line-number). This is set by the marker-filter, which scans
@@ -447,12 +499,12 @@ The value t means that there is no stack, and we are in display-file mode.")
"Install those variables used by speedbar to enhance gud/gdb."
(unless gud-speedbar-key-map
(setq gud-speedbar-key-map (speedbar-make-specialized-keymap))
- (define-key gud-speedbar-key-map "j" 'speedbar-edit-line)
- (define-key gud-speedbar-key-map "e" 'speedbar-edit-line)
- (define-key gud-speedbar-key-map "\C-m" 'speedbar-edit-line)
- (define-key gud-speedbar-key-map " " 'speedbar-toggle-line-expansion)
- (define-key gud-speedbar-key-map "D" 'gdb-var-delete)
- (define-key gud-speedbar-key-map "p" 'gud-pp))
+ (define-key gud-speedbar-key-map "j" #'speedbar-edit-line)
+ (define-key gud-speedbar-key-map "e" #'speedbar-edit-line)
+ (define-key gud-speedbar-key-map "\C-m" #'speedbar-edit-line)
+ (define-key gud-speedbar-key-map " " #'speedbar-toggle-line-expansion)
+ (define-key gud-speedbar-key-map "D" #'gdb-var-delete)
+ (define-key gud-speedbar-key-map "p" #'gud-pp))
(speedbar-add-expansion-list '("GUD" gud-speedbar-menu-items
gud-speedbar-key-map
@@ -622,8 +674,7 @@ required by the caller."
(defcustom gud-gud-gdb-command-name "gdb --fullname"
"Default command to run an executable under GDB in text command mode.
The option \"--fullname\" must be included in this value."
- :type 'string
- :group 'gud)
+ :type 'string)
(defvar gud-gdb-marker-regexp
;; This used to use path-separator instead of ":";
@@ -785,11 +836,13 @@ the buffer in which this command was invoked."
(gud-def gud-until "until %l" "\C-u" "Continue to current line.")
(gud-def gud-run "run" nil "Run the program.")
+ (gud-set-repeat-map-property 'gud-gdb-repeat-map)
+
(add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point
nil 'local)
- (setq-local gud-gdb-completion-function 'gud-gdb-completions)
+ (setq-local gud-gdb-completion-function #'gud-gdb-completions)
- (local-set-key "\C-i" 'completion-at-point)
+ (local-set-key "\C-i" #'completion-at-point)
(setq comint-prompt-regexp "^(.*gdb[+]?) *")
(setq paragraph-start comint-prompt-regexp)
(setq gdb-first-prompt t)
@@ -984,6 +1037,18 @@ SKIP is the number of chars to skip on each line, it defaults to 0."
(defvar gud-sdb-lastfile nil)
+(defvar gud-sdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `sdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-sdb-marker-filter (string)
(setq gud-marker-acc
(if gud-marker-acc (concat gud-marker-acc string) string))
@@ -1054,6 +1119,8 @@ and source-file directory for your debugger."
(gud-def gud-cont "c" "\C-r" "Continue with display.")
(gud-def gud-print "%e/" "\C-p" "Evaluate C expression at point.")
+ (gud-set-repeat-map-property 'gud-sdb-repeat-map)
+
(setq comint-prompt-regexp "\\(^\\|\n\\)\\*")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'sdb-mode-hook)
@@ -1074,8 +1141,7 @@ The file names should be absolute, or relative to the directory
containing the executable being debugged."
:type '(choice (const :tag "Current Directory" nil)
(repeat :value ("")
- directory))
- :group 'gud)
+ directory)))
(defun gud-dbx-massage-args (_file args)
(nconc (let ((directories gud-dbx-directories)
@@ -1213,6 +1279,23 @@ whereby $stopformat=1 produces an output format compatible with
;; whereby `set $stopformat=1' reportedly produces output compatible
;; with `gud-dbx-marker-filter', which we prefer.
+(defvar gud-dbx-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ (when (or gud-mips-p
+ gud-irix-p)
+ (define-key map "f" 'gud-finish))
+ map)
+ "Keymap to repeat `dbx' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
;; The process filter is also somewhat
;; unreliable, sometimes not spotting the markers; I don't know
;; whether there's anything that can be done about that.]
@@ -1360,6 +1443,8 @@ and source-file directory for your debugger."
(gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
(gud-def gud-run "run" nil "Run the program.")
+ (gud-set-repeat-map-property 'gud-dbx-repeat-map)
+
(setq comint-prompt-regexp "^[^)\n]*dbx) *")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'dbx-mode-hook)
@@ -1371,6 +1456,21 @@ and source-file directory for your debugger."
;; History of argument lists passed to xdb.
(defvar gud-xdb-history nil)
+(defvar gud-xdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `xdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defcustom gud-xdb-directories nil
"A list of directories that xdb should search for source code.
If nil, only source files in the program directory
@@ -1380,8 +1480,7 @@ The file names should be absolute, or relative to the directory
containing the executable being debugged."
:type '(choice (const :tag "Current Directory" nil)
(repeat :value ("")
- directory))
- :group 'gud)
+ directory)))
(defun gud-xdb-massage-args (_file args)
(nconc (let ((directories gud-xdb-directories)
@@ -1437,6 +1536,8 @@ directories if your program contains sources from more than one directory."
(gud-def gud-finish "bu\\t" "\C-f" "Finish executing current function.")
(gud-def gud-print "p %e" "\C-p" "Evaluate C expression at point.")
+ (gud-set-repeat-map-property 'gud-xdb-repeat-map)
+
(setq comint-prompt-regexp "^>")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'xdb-mode-hook))
@@ -1447,6 +1548,17 @@ directories if your program contains sources from more than one directory."
;; History of argument lists passed to perldb.
(defvar gud-perldb-history nil)
+(defvar gud-perldb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `perldb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-perldb-massage-args (_file args)
"Convert a command line as would be typed normally to run perldb
into one that invokes an Emacs-enabled debugging session.
@@ -1563,8 +1675,7 @@ into one that invokes an Emacs-enabled debugging session.
(defcustom gud-perldb-command-name "perl -d"
"Default command to execute a Perl script under debugger."
- :type 'string
- :group 'gud)
+ :type 'string)
;;;###autoload
(defun perldb (command-line)
@@ -1590,6 +1701,7 @@ and source-file directory for your debugger."
(gud-def gud-print "p %e" "\C-p" "Evaluate perl expression at point.")
(gud-def gud-until "c %l" "\C-u" "Continue to current line.")
+ (gud-set-repeat-map-property 'gud-perldb-repeat-map)
(setq comint-prompt-regexp "^ DB<+[0-9]+>+ ")
(setq paragraph-start comint-prompt-regexp)
@@ -1618,6 +1730,20 @@ and source-file directory for your debugger."
(defvar gud-pdb-marker-regexp-start "^> ")
+(defvar gud-pdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("c" . gud-cont)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `pdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
;; There's no guarantee that Emacs will hand the filter the entire
;; marker at once; it could be broken up across several strings. We
;; might even receive a big chunk with several markers in it. If we
@@ -1677,8 +1803,7 @@ and source-file directory for your debugger."
(if (executable-find "pdb") "pdb" "python -m pdb")
"Command that executes the Python debugger."
:version "27.1"
- :type 'string
- :group 'gud)
+ :type 'string)
;;;###autoload
(defun pdb (command-line)
@@ -1708,6 +1833,8 @@ directory and source-file directory for your debugger."
(gud-def gud-print "p %e" "\C-p" "Evaluate Python expression at point.")
(gud-def gud-statement "!%e" "\C-e" "Execute Python statement at point.")
+ (gud-set-repeat-map-property 'gud-pdb-repeat-map)
+
;; (setq comint-prompt-regexp "^(.*pdb[+]?) *")
(setq comint-prompt-regexp "^(Pdb) *")
(setq paragraph-start comint-prompt-regexp)
@@ -1721,6 +1848,19 @@ directory and source-file directory for your debugger."
(defvar gud-guiler-lastfile nil)
+(defvar gud-guiler-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("l" . gud-refresh)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `guiler' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-guiler-marker-filter (string)
(setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
@@ -1759,8 +1899,7 @@ directory and source-file directory for your debugger."
"File name for executing the Guile debugger.
This should be an executable on your path, or an absolute file name."
:version "25.1"
- :type 'string
- :group 'gud)
+ :type 'string)
;;;###autoload
(defun guiler (command-line)
@@ -1787,6 +1926,8 @@ and source-file directory for your debugger."
(gud-def gud-down ",down" ">" "Down one stack frame.")
(gud-def gud-print "%e" "\C-p" "Evaluate Guile expression at point.")
+ (gud-set-repeat-map-property 'gud-guiler-repeat-map)
+
(setq comint-prompt-regexp "^scheme@([^>]+> ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'guiler-mode-hook))
@@ -1883,8 +2024,7 @@ and source-file directory for your debugger."
(defcustom gud-jdb-command-name "jdb"
"Command that executes the Java debugger."
- :type 'string
- :group 'gud)
+ :type 'string)
(defcustom gud-jdb-use-classpath t
"If non-nil, search for Java source files in classpath directories.
@@ -1899,8 +2039,7 @@ and parsing all Java files for class information.
Set to nil to use `gud-jdb-directories' to scan java sources for
class information on jdb startup (original method)."
- :type 'boolean
- :group 'gud)
+ :type 'boolean)
(defvar gud-jdb-classpath nil
"Java/jdb classpath directories list.
@@ -2175,9 +2314,9 @@ extension EXTN. Normally EXTN is given as the regular expression
(setq gud-jdb-analysis-buffer (get-buffer-create " *gud-jdb-scratch*"))
(prog1
(apply
- 'nconc
+ #'nconc
(mapcar
- 'gud-jdb-build-class-source-alist-for-file
+ #'gud-jdb-build-class-source-alist-for-file
sources))
(kill-buffer gud-jdb-analysis-buffer)
(setq gud-jdb-analysis-buffer nil)))
@@ -2234,6 +2373,21 @@ extension EXTN. Normally EXTN is given as the regular expression
;; Note: Reset to this value every time a prompt is seen
(defvar gud-jdb-lowest-stack-level 999)
+(defvar gud-jdb-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (pcase-dolist (`(,key . ,cmd) '(("n" . gud-next)
+ ("s" . gud-step)
+ ("i" . gud-stepi)
+ ("c" . gud-cont)
+ ("f" . gud-finish)
+ ("<" . gud-up)
+ (">" . gud-down)
+ ("l" . gud-refresh)))
+ (define-key map key cmd))
+ map)
+ "Keymap to repeat `jdb' stepping instructions `C-x C-a C-n n n'.
+Used in `repeat-mode'.")
+
(defun gud-jdb-find-source-using-classpath (p)
"Find source file corresponding to fully qualified class P.
Convert P from jdb's output, converted to a pathname
@@ -2244,13 +2398,14 @@ relative to a classpath directory."
;; name relative to classpath
(filename
(concat
- (mapconcat 'identity
+ (mapconcat #'identity
(split-string
;; Eliminate any subclass references in the class
;; name string. These start with a "$"
(if (string-match "\\$.*" p)
(replace-match "" t t p) p)
- "\\.") "/")
+ "\\.")
+ "/")
".java"))
(cplist (append gud-jdb-sourcepath gud-jdb-classpath))
found-file)
@@ -2272,7 +2427,7 @@ during jdb initialization depending on the value of
"Parse the classpath list and convert each item to an absolute pathname."
(mapcar (lambda (s) (if (string-match "[/\\]$" s)
(replace-match "" nil nil s) s))
- (mapcar 'file-truename
+ (mapcar #'file-truename
(split-string
string
(concat "[ \t\n\r,\"" path-separator "]+")))))
@@ -2441,6 +2596,8 @@ gud, see `gud-mode'."
(gud-def gud-print "print %e" "\C-p" "Print value of expression at point.")
(gud-def gud-pstar "dump %e" nil "Print all object information at point.")
+ (gud-set-repeat-map-property 'gud-jdb-repeat-map)
+
(setq comint-prompt-regexp "^> \\|^[^ ]+\\[[0-9]+\\] ")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'jdb-mode-hook)
@@ -2451,7 +2608,7 @@ gud, see `gud-mode'."
(if (string-match "-attach" command-line)
(gud-call "classpath"))
(fset 'gud-jdb-find-source
- 'gud-jdb-find-source-using-classpath))
+ #'gud-jdb-find-source-using-classpath))
;; Else create and bind the class/source association list as well
;; as the source file list.
@@ -2459,8 +2616,8 @@ gud, see `gud-mode'."
(gud-jdb-build-class-source-alist
(setq gud-jdb-source-files
(gud-jdb-build-source-files-list gud-jdb-directories
- "\\.java$"))))
- (fset 'gud-jdb-find-source 'gud-jdb-find-source-file)))
+ "\\.java\\'"))))
+ (fset 'gud-jdb-find-source #'gud-jdb-find-source-file)))
;;
;; End of debugger-specific information
@@ -2571,7 +2728,7 @@ Commands:
\\{gud-mode-map}"
(setq mode-line-process '(":%s"))
- (define-key (current-local-map) "\C-c\C-l" 'gud-refresh)
+ (define-key (current-local-map) "\C-c\C-l" #'gud-refresh)
(setq-local gud-last-frame nil)
(if (boundp 'tool-bar-map) ; not --without-x
(setq-local tool-bar-map gud-tool-bar-map))
@@ -2580,11 +2737,10 @@ Commands:
(setq-local comint-input-ignoredups t)
(make-local-variable 'paragraph-start)
(setq-local gud-delete-prompt-marker (make-marker))
- (add-hook 'kill-buffer-hook 'gud-kill-buffer-hook nil t))
+ (add-hook 'kill-buffer-hook #'gud-kill-buffer-hook nil t))
(defcustom gud-chdir-before-run t
"Non-nil if GUD should `cd' to the debugged executable."
- :group 'gud
:type 'boolean)
;; Perform initializations common to all debuggers.
@@ -2648,7 +2804,7 @@ Commands:
(setq w (cdr w)))
;; Tramp has already been loaded if we are here.
(if w (setcar w (setq file (file-local-name file)))))
- (apply 'make-comint (concat "gud" filepart) program nil
+ (apply #'make-comint (concat "gud" filepart) program nil
(if massage-args (funcall massage-args file args) args))
;; Since comint clobbered the mode, we don't set it until now.
(gud-mode)
@@ -2658,8 +2814,8 @@ Commands:
(if find-file (setq-local gud-find-file find-file))
(setq gud-last-last-frame nil)
- (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
- (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
+ (set-process-filter (get-buffer-process (current-buffer)) #'gud-filter)
+ (set-process-sentinel (get-buffer-process (current-buffer)) #'gud-sentinel)
(gud-set-buffer))
(defun gud-set-buffer ()
@@ -2994,7 +3150,7 @@ Obeying it means displaying in another window the specified file and line."
(buffer-substring (region-beginning) (region-end))
(apply gud-find-expr-function args))))
(save-match-data
- (if (string-match "\n" expr)
+ (if (string-search "\n" expr)
(error "Expression must not include a newline"))
(with-current-buffer gud-comint-buffer
(save-excursion
@@ -3180,10 +3336,11 @@ class of the file (using s to separate nested class ids)."
(while (and cplist (not class-found))
(if (string-match (car cplist) f)
(setq class-found
- (mapconcat 'identity
+ (mapconcat #'identity
(split-string
(substring f (+ (match-end 0) 1))
- "/") ".")))
+ "/")
+ ".")))
(setq cplist (cdr cplist)))
;; if f is visited by a java(cc-mode) buffer, walk up the
;; syntactic information chain and collect any 'inclass
@@ -3222,7 +3379,7 @@ class of the file (using s to separate nested class ids)."
))
(string-match (concat (car nclass) "$") class-found)
(setq class-found
- (replace-match (mapconcat 'identity nclass "$")
+ (replace-match (mapconcat #'identity nclass "$")
t t class-found)))))
(if (not class-found)
(message "gud-find-class: class for file %s not found!" f))
@@ -3356,7 +3513,7 @@ Treats actions as defuns."
(setq-local outline-regexp "[ \t]")
(setq-local imenu-generic-expression
'((nil "^define[ \t]+\\(\\w+\\)" 1)))
- (setq-local indent-line-function 'gdb-script-indent-line)
+ (setq-local indent-line-function #'gdb-script-indent-line)
(setq-local beginning-of-defun-function
#'gdb-script-beginning-of-defun)
(setq-local end-of-defun-function
@@ -3387,14 +3544,14 @@ Treats actions as defuns."
(require 'tooltip)
(if gud-tooltip-mode
(progn
- (add-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
- (add-hook 'pre-command-hook 'tooltip-hide)
- (add-hook 'tooltip-functions 'gud-tooltip-tips)
- (define-key global-map [mouse-movement] 'gud-tooltip-mouse-motion))
- (unless tooltip-mode (remove-hook 'pre-command-hook 'tooltip-hide)
- (remove-hook 'change-major-mode-hook 'gud-tooltip-change-major-mode)
- (remove-hook 'tooltip-functions 'gud-tooltip-tips)
- (define-key global-map [mouse-movement] 'ignore)))
+ (add-hook 'change-major-mode-hook #'gud-tooltip-change-major-mode)
+ (add-hook 'pre-command-hook #'tooltip-hide)
+ (add-hook 'tooltip-functions #'gud-tooltip-tips)
+ (define-key global-map [mouse-movement] #'gud-tooltip-mouse-motion))
+ (unless tooltip-mode (remove-hook 'pre-command-hook #'tooltip-hide)
+ (remove-hook 'change-major-mode-hook #'gud-tooltip-change-major-mode)
+ (remove-hook 'tooltip-functions #'gud-tooltip-tips)
+ (define-key global-map [mouse-movement] #'ignore)))
(gud-tooltip-activate-mouse-motions-if-enabled)
(if (and gud-comint-buffer
(buffer-name gud-comint-buffer); gud-comint-buffer might be killed
@@ -3411,15 +3568,14 @@ Treats actions as defuns."
(make-local-variable 'gdb-define-alist)
(gdb-create-define-alist)
(add-hook 'after-save-hook
- 'gdb-create-define-alist nil t))))))
+ #'gdb-create-define-alist nil t))))))
(kill-local-variable 'gdb-define-alist)
- (remove-hook 'after-save-hook 'gdb-create-define-alist t))))
+ (remove-hook 'after-save-hook #'gdb-create-define-alist t))))
(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode
python-mode)
"List of modes for which to enable GUD tooltips."
:type '(repeat (symbol :tag "Major mode"))
- :group 'gud
:group 'tooltip)
(defcustom gud-tooltip-display
@@ -3431,13 +3587,11 @@ Forms in the list are combined with AND. The default is to display
only tooltips in the buffer containing the overlay arrow."
:type 'sexp
:risky t
- :group 'gud
:group 'tooltip)
(defcustom gud-tooltip-echo-area nil
"Use the echo area instead of frames for GUD tooltips."
:type 'boolean
- :group 'gud
:group 'tooltip)
(make-obsolete-variable 'gud-tooltip-echo-area
@@ -3447,12 +3601,12 @@ only tooltips in the buffer containing the overlay arrow."
(defun gud-tooltip-change-major-mode ()
"Function added to `change-major-mode-hook' when tooltip mode is on."
- (add-hook 'post-command-hook 'gud-tooltip-activate-mouse-motions-if-enabled))
+ (add-hook 'post-command-hook #'gud-tooltip-activate-mouse-motions-if-enabled))
(defun gud-tooltip-activate-mouse-motions-if-enabled ()
"Reconsider for all buffers whether mouse motion events are desired."
(remove-hook 'post-command-hook
- 'gud-tooltip-activate-mouse-motions-if-enabled)
+ #'gud-tooltip-activate-mouse-motions-if-enabled)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(if (and gud-tooltip-mode
@@ -3561,7 +3715,7 @@ This function must return nil if it doesn't handle EVENT."
(posn-point (event-end event))
(or (and (eq gud-minor-mode 'gdbmi) (not gdb-active-process))
(progn (setq gud-tooltip-event event)
- (eval (cons 'and gud-tooltip-display)))))
+ (eval (cons 'and gud-tooltip-display) t))))
(let ((expr (tooltip-expr-to-print event)))
(when expr
(if (and (eq gud-minor-mode 'gdbmi)
@@ -3591,10 +3745,10 @@ so they have been disabled."))
(gdb-input
(concat
"server macro expand " expr "\n")
- `(lambda () (gdb-tooltip-print-1 ,expr)))
+ (lambda () (gdb-tooltip-print-1 expr)))
(gdb-input
(concat cmd "\n")
- `(lambda () (gdb-tooltip-print ,expr))))
+ (lambda () (gdb-tooltip-print expr))))
(add-function :override (process-filter process)
#'gud-tooltip-process-output)
(gud-basic-call cmd))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 923f85fd4dd..4a1da62c7e9 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -55,10 +55,10 @@
;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol.
;;
;; If you define or undefine a symbol while hide-ifdef-mode is in effect,
-;; the display will be updated. Only the define list for the current
-;; buffer will be affected. You can save changes to the local define
-;; list with hide-ifdef-set-define-alist. This adds entries
-;; to hide-ifdef-define-alist.
+;; the display will be updated. The global define list hide-ifdef-env
+;; is affected accordingly. You can save changes to this globally define
+;; list with hide-ifdef-set-define-alist. This adds entries to
+;; hide-ifdef-define-alist.
;;
;; If you have defined a hide-ifdef-mode-hook, you can set
;; up a list of symbols that may be used by hide-ifdefs as in the
@@ -68,10 +68,19 @@
;; (lambda ()
;; (unless hide-ifdef-define-alist
;; (setq hide-ifdef-define-alist
-;; '((list1 ONE TWO)
-;; (list2 TWO THREE))))
+;; '((list1 (ONE . 1) (TWO . 2))
+;; (list2 (TWO . 2) (THREE . 3)))))
;; (hide-ifdef-use-define-alist 'list2))) ; use list2 by default
;;
+;; Currently recursive #include is not yet supported, a quick and reliable
+;; way is to let the compiler generates all the #include-d defined macros
+;; into a file, then open it in Emacs with hide-ifdefs (C-c @ h).
+;; Take gcc and hello.c for example, hello.c #include-s <stdio.h>:
+;;
+;; $ gcc -dM -E hello.c -o hello.hh
+;;
+;; Then, open hello.hh and perform hide-ifdefs.
+;;
;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify
;; another list to use.
;;
@@ -99,7 +108,11 @@
;; Extensively modified by Daniel LaLiberte (while at Gould).
;;
;; Extensively modified by Luke Lee in 2013 to support complete C expression
-;; evaluation and argumented macro expansion.
+;; evaluation and argumented macro expansion; C++11, C++14, C++17, GCC
+;; extension literals and gcc/clang matching behaviours are supported in 2021.
+;; Various floating point types and operations are also supported but the
+;; actual precision is limited by the Emacs internal floating representation,
+;; which is the C data type "double" or IEEE binary64 format.
;;; Code:
@@ -136,7 +149,10 @@
:type '(choice (const nil) string)
:version "25.1")
-(defcustom hide-ifdef-expand-reinclusion-protection t
+(define-obsolete-variable-alias 'hide-ifdef-expand-reinclusion-protection
+ 'hide-ifdef-expand-reinclusion-guard "28.1")
+
+(defcustom hide-ifdef-expand-reinclusion-guard t
"Non-nil means don't hide an entire header file enclosed by #ifndef...#endif.
Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion:
@@ -161,7 +177,7 @@ outermost #if is always visible."
(defcustom hide-ifdef-header-regexp
"\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'"
"C/C++ header file name patterns to determine if current buffer is a header.
-Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
+Effective only if `hide-ifdef-expand-reinclusion-guard' is t."
:type 'regexp
:version "25.1")
@@ -195,6 +211,21 @@ Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
:type 'key-sequence
:version "27.1")
+(defcustom hide-ifdef-verbose nil
+ "Show some defining symbols on hiding for a visible feedback."
+ :type 'boolean
+ :version "28.1")
+
+(defcustom hide-ifdef-evalulate-enter-hook nil
+ "Hook function to be called when entering `hif-evaluate-macro'."
+ :type 'hook
+ :version "28.1")
+
+(defcustom hide-ifdef-evalulate-leave-hook nil
+ "Hook function to be called when leaving `hif-evaluate-macro'."
+ :type 'hook
+ :version "28.1")
+
(defvar hide-ifdef-mode-map
;; Set up the mode's main map, which leads via the prefix key to the submap.
(let ((map (make-sparse-keymap)))
@@ -306,9 +337,9 @@ Several variables affect how the hiding is done:
;; (default-value 'hide-ifdef-env))
(setq hide-ifdef-env (default-value 'hide-ifdef-env))
;; Some C/C++ headers might have other ways to prevent reinclusion and
- ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil.
- (setq-local hide-ifdef-expand-reinclusion-protection
- (default-value 'hide-ifdef-expand-reinclusion-protection))
+ ;; thus would like `hide-ifdef-expand-reinclusion-guard' to be nil.
+ (setq-local hide-ifdef-expand-reinclusion-guard
+ (default-value 'hide-ifdef-expand-reinclusion-guard))
(setq-local hide-ifdef-hiding
(default-value 'hide-ifdef-hiding))
(setq-local hif-outside-read-only buffer-read-only)
@@ -330,23 +361,42 @@ Several variables affect how the hiding is done:
(defun hif-clear-all-ifdef-defined ()
"Clears all symbols defined in `hide-ifdef-env'.
It will backup this variable to `hide-ifdef-env-backup' before clearing to
-prevent accidental clearance."
+prevent accidental clearance.
+When prefixed, it swaps current symbols with the backup ones."
(interactive)
- (when (y-or-n-p "Clear all #defined symbols? ")
- (setq hide-ifdef-env-backup hide-ifdef-env)
- (setq hide-ifdef-env nil)))
-
-(defun hif-show-all ()
- "Show all of the text in the current buffer."
- (interactive)
- (hif-show-ifdef-region (point-min) (point-max)))
+ (if current-prefix-arg
+ (if hide-ifdef-env-backup
+ (when (y-or-n-p (format
+ "Restore all %d #defined symbols just cleared? "
+ (length hide-ifdef-env-backup)))
+ (let ((tmp hide-ifdef-env-backup))
+ (setq hide-ifdef-env hide-ifdef-env-backup)
+ (setq hide-ifdef-env-backup tmp))
+ (message "Backup symbols restored."))
+ (message "No backup symbol to restore."))
+ (when (y-or-n-p (format "Clear all %d #defined symbols? "
+ (length hide-ifdef-env)))
+ (if hide-ifdef-env ;; backup only if not empty
+ (setq hide-ifdef-env-backup hide-ifdef-env))
+ (setq hide-ifdef-env nil)
+ (message "All defined symbols cleared." ))))
+
+(defun hif-show-all (&optional start end)
+ "Show all of the text in the current buffer.
+If there is a marked region from START to END it only shows the symbols within."
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
+ (hif-show-ifdef-region
+ (or start (point-min)) (or end (point-max))))
;; By putting this on after-revert-hook, we arrange that it only
;; does anything when revert-buffer avoids turning off the mode.
;; (That can happen in VC.)
(defun hif-after-revert-function ()
(and hide-ifdef-mode hide-ifdef-hiding
- (hide-ifdefs t)))
+ (hide-ifdefs nil nil t)))
(add-hook 'after-revert-hook 'hif-after-revert-function)
(defun hif-end-of-line ()
@@ -427,9 +477,17 @@ Everything including these lines is made invisible."
;;===%%SF%% evaluation (Start) ===
+(defun hif-eval (form)
+ "Evaluate hideif internal representation."
+ (let ((val (eval form)))
+ (if (stringp val)
+ (or (get-text-property 0 'hif-value val)
+ val)
+ val)))
+
;; It is not useful to set this to anything but `eval'.
;; In fact, the variable might as well be eliminated.
-(defvar hide-ifdef-evaluator 'eval
+(defvar hide-ifdef-evaluator #'hif-eval
"The function to use to evaluate a form.
The evaluator is given a canonical form and returns t if text under
that form should be displayed.")
@@ -442,23 +500,42 @@ that form should be displayed.")
"Prepend (VAR VALUE) pair to `hide-ifdef-env'."
(setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
+(defconst hif-predefine-alist
+ '((__LINE__ . hif-__LINE__)
+ (__FILE__ . hif-__FILE__)
+ (__COUNTER__ . hif-__COUNTER__)
+ (__cplusplus . hif-__cplusplus)
+ (__DATE__ . hif-__DATE__)
+ (__TIME__ . hif-__TIME__)
+ (__STDC__ . hif-__STDC__)
+ (__STDC_VERSION__ . hif-__STDC_VERSION__)
+ (__STDC_HOST__ . hif-__STDC_HOST__)
+ (__BASE_FILE__ . hif-__FILE__)))
+
(declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var))
(declare-function semantic-c-hideif-defined "semantic/bovine/c" (var))
(defun hif-lookup (var)
(or (when (bound-and-true-p semantic-c-takeover-hideif)
(semantic-c-hideif-lookup var))
- (let ((val (assoc var hide-ifdef-env)))
+ (let ((val (assq var hide-ifdef-env)))
(if val
(cdr val)
- hif-undefined-symbol))))
+ (if (setq val (assq var hif-predefine-alist))
+ (funcall (cdr val))
+ hif-undefined-symbol)))))
(defun hif-defined (var)
- (cond
- ((bound-and-true-p semantic-c-takeover-hideif)
- (semantic-c-hideif-defined var))
- ((assoc var hide-ifdef-env) 1)
- (t 0)))
+ (let (def)
+ (cond
+ ((bound-and-true-p semantic-c-takeover-hideif)
+ (semantic-c-hideif-defined var))
+ ;; Here we can't use hif-lookup as an empty definition like `#define EMPTY'
+ ;; is considered defined but is evaluated as `nil'.
+ ((assq var hide-ifdef-env) 1)
+ ((and (setq def (assq var hif-predefine-alist))
+ (funcall (cdr def))) 1)
+ (t 0))))
;;===%%SF%% evaluation (End) ===
@@ -484,7 +561,7 @@ that form should be displayed.")
(defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)"))
(defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*"))
(defconst hif-macroref-regexp
- (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp
+ (concat hif-white-regexp "\\(" hif-id-regexp "\\)"
"\\("
"(" hif-white-regexp
"\\(" hif-id-regexp "\\)?" hif-white-regexp
@@ -493,6 +570,75 @@ that form should be displayed.")
")"
"\\)?" ))
+;; The point here is *NOT* to do "syntax error checking" for C(++) compiler, but
+;; to parse and recognize *already valid* numeric literals. Therefore we don't
+;; need to worry if number like "0x12'" is invalid, leave it to the compiler.
+;; Otherwise, the runtime performance of hideif would be poor.
+;;
+;; GCC fixed-point literal extension:
+;;
+;; ‘ullk’ or ‘ULLK’ for unsigned long long _Accum and _Sat unsigned long long _Accum
+;; ‘ullr’ or ‘ULLR’ for unsigned long long _Fract and _Sat unsigned long long _Fract
+;;
+;; ‘llk’ or ‘LLK’ for long long _Accum and _Sat long long _Accum
+;; ‘llr’ or ‘LLR’ for long long _Fract and _Sat long long _Fract
+;; ‘uhk’ or ‘UHK’ for unsigned short _Accum and _Sat unsigned short _Accum
+;; ‘ulk’ or ‘ULK’ for unsigned long _Accum and _Sat unsigned long _Accum
+;; ‘uhr’ or ‘UHR’ for unsigned short _Fract and _Sat unsigned short _Fract
+;; ‘ulr’ or ‘ULR’ for unsigned long _Fract and _Sat unsigned long _Fract
+;;
+;; ‘lk’ or ‘LK’ for long _Accum and _Sat long _Accum
+;; ‘lr’ or ‘LR’ for long _Fract and _Sat long _Fract
+;; ‘uk’ or ‘UK’ for unsigned _Accum and _Sat unsigned _Accum
+;; ‘ur’ or ‘UR’ for unsigned _Fract and _Sat unsigned _Fract
+;; ‘hk’ or ‘HK’ for short _Accum and _Sat short _Accum
+;; ‘hr’ or ‘HR’ for short _Fract and _Sat short _Fract
+;;
+;; ‘r’ or ‘R’ for _Fract and _Sat _Fract
+;; ‘k’ or ‘K’ for _Accum and _Sat _Accum
+
+;; C++14 also include '0b' for binary and "'" as separator
+(defconst hif-numtype-suffix-regexp
+ ;; "\\(ll[uU]\\|LL[uU]\\|[uU]?ll\\|[uU]?LL\\|[lL][uU]\\|[uU][lL]\\|[uUlLfF]\\)"
+ (concat
+ "\\(\\(ll[uU]\\|LL[uU]\\|[uU]?ll\\|[uU]?LL\\|[lL][uU]\\|[uU][lL]\\|"
+ "[uU][hH]\\)[kKrR]?\\|" ; GCC fixed-point extension
+ "[dD][dDfFlL]\\|" ; GCC floating-point extension
+ "[uUlLfF]\\)"))
+(defconst hif-bin-regexp
+ (concat "[+-]?0[bB]\\([01']+\\)"
+ hif-numtype-suffix-regexp "?"))
+(defconst hif-hex-regexp
+ (concat "[+-]?0[xX]\\([[:xdigit:]']+\\)"
+ hif-numtype-suffix-regexp "?"))
+(defconst hif-oct-regexp
+ (concat "[+-]?0[0-7']+"
+ hif-numtype-suffix-regexp "?"))
+(defconst hif-dec-regexp
+ (concat "[+-]?\\(0\\|[1-9][0-9']*\\)"
+ hif-numtype-suffix-regexp "?"))
+
+(defconst hif-decfloat-regexp
+ ;; `hif-string-to-decfloat' relies on the number and ordering of parentheses
+ (concat
+ "\\(?:"
+ "\\([+-]?[0-9]+\\)\\([eE][+-]?[0-9]+\\)?[dD]?[fFlL]?"
+ "\\|\\([+-]?[0-9]+\\)\\.\\([eE][+-]?[0-9]+\\)?[dD]?[dDfFlL]?"
+ "\\|\\([+-]?[0-9]*\\.[0-9]+\\)\\([eE][+-]?[0-9]+\\)?[dD]?[dDfFlL]?"
+ "\\)"))
+
+;; C++17 hexadecimal floating point literal
+(defconst hif-hexfloat-regexp
+ ;; `hif-string-to-hexfloat' relies on the ordering of regexp groupings
+ (concat
+ "[+-]?\\(?:"
+ "0[xX]\\([[:xdigit:]']+\\)[pP]\\([+-]?[0-9']+\\)[fFlL]?"
+ "\\|"
+ "0[xX]\\([[:xdigit:]']+\\)\\.[pP]\\([+-]?[0-9']+\\)[fFlL]?"
+ "\\|"
+ "0[xX]\\([[:xdigit:]']*\\)\\.\\([[:xdigit:]']+\\)[pP]\\([+-]?[0-9']+\\)[fFlL]?"
+ "\\)"))
+
;; Store the current token and the whole token list during parsing.
;; Bound dynamically.
(defvar hif-token)
@@ -530,29 +676,113 @@ that form should be displayed.")
(":" . hif-colon)
("," . hif-comma)
("#" . hif-stringify)
- ("..." . hif-etc)))
+ ("..." . hif-etc)
+ ("defined" . hif-defined)))
(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
(defconst hif-token-regexp
- (concat (regexp-opt (mapcar 'car hif-token-alist))
- "\\|0x[[:xdigit:]]+\\.?[[:xdigit:]]*"
- "\\|[0-9]+\\.?[0-9]*" ;; decimal/octal
- "\\|\\w+"))
-
-(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")
+ ;; The ordering of regexp grouping is crutial to `hif-strtok'
+ (concat
+ ;; hex/binary:
+ "\\([+-]?0[xXbB]\\([[:xdigit:]']+\\)?\\.?\\([[:xdigit:]']+\\)?\\([pP]\\([+-]?[0-9]+\\)\\)?"
+ hif-numtype-suffix-regexp "?\\)"
+ ;; decimal/octal:
+ "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?"
+ hif-numtype-suffix-regexp "?\\)"
+ "\\|" (regexp-opt (mapcar 'car hif-token-alist) t)
+ "\\|\\(\\w+\\)"))
+
+;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"")
+(defconst hif-unicode-prefix-regexp "\\(?:u8R?\\|[uUL]R?\\|R\\)")
+(defconst hif-string-literal-regexp
+ (concat hif-unicode-prefix-regexp "?"
+ "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)"))
+
+;; matching and conversion
+
+(defun hif-full-match (regexp string)
+ "A full REGEXP match of STRING instead of partially match."
+ (string-match (concat "\\`" regexp "\\'") string))
+
+(defun hif-is-number (string)
+ "Check if STRING is a valid C(++) numeric literal."
+ (or (hif-full-match hif-dec-regexp string)
+ (hif-full-match hif-hex-regexp string)
+ (hif-full-match hif-oct-regexp string)
+ (hif-full-match hif-bin-regexp string)))
+
+(defun hif-is-float (string)
+ "Check if STRING is a valid C(++) floating point literal."
+ (or (hif-full-match hif-decfloat-regexp string)
+ (hif-full-match hif-hexfloat-regexp string)))
+
+(defun hif-delete-char-in-string (char string)
+ "Delete CHAR in STRING inplace."
+ (let ((i (length string))
+ (s nil))
+ (while (> i 0)
+ (setq i (1- i))
+ (unless (eq (aref string i) char)
+ (setq s (cons (aref string i) s))))
+ (concat s)))
+
+(defun hif-string-to-decfloat (string &optional fix exp)
+ "Convert a C(++) decimal floating formatted string into float.
+Assuming we've just regexp-matched with `hif-decfloat-regexp' and it matched.
+if REMATCH is t, do a rematch."
+ ;; In elisp `(string-to-number "01.e2")' will return 1 instead of the expected
+ ;; 100.0; therefore we need to write our own.
+ ;; This function relies on the regexp groups of `hif-dexfloat-regexp'
+ (if (or fix exp)
+ (setq fix (hif-delete-char-in-string ?' fix)
+ exp (hif-delete-char-in-string ?' exp))
+ ;; rematch
+ (setq string (hif-delete-char-in-string ?' string))
+ (hif-full-match hif-decfloat-regexp string)
+ (setq fix (or (match-string 1 string)
+ (match-string 3 string)
+ (match-string 5 string))
+ exp (or (match-string 2 string)
+ (match-string 4 string)
+ (match-string 6 string))))
+ (setq fix (string-to-number fix)
+ exp (if (zerop (length exp)) ;; nil or ""
+ 0 (string-to-number (substring-no-properties exp 1))))
+ (* fix (expt 10 exp)))
+
+(defun hif-string-to-hexfloat (string &optional int fra exp)
+ "Convert a C++17 hex float formatted string into float.
+Assuming we've just regexp-matched with `hif-hexfloat-regexp' and it matched.
+if REMATCH is t, do a rematch."
+ ;; This function relies on the regexp groups of `hif-hexfloat-regexp'
+ (let ((negate (if (eq ?- (aref string 0)) -1.0 1.0)))
+ (if (or int fra exp)
+ (setq int (hif-delete-char-in-string ?' int)
+ fra (hif-delete-char-in-string ?' fra)
+ exp (hif-delete-char-in-string ?' exp))
+ (setq string (hif-delete-char-in-string ?' string))
+ (hif-full-match hif-hexfloat-regexp string)
+ (setq int (or (match-string 1 string)
+ (match-string 3 string)
+ (match-string 5 string))
+ fra (or (match-string 2 string)
+ (match-string 4 string)
+ (match-string 6 string))
+ exp (match-string 7 string)))
+ (setq int (if (zerop (length int)) ;; nil or ""
+ 0 (string-to-number int 16))
+ fra (if (zerop (length fra))
+ 0 (/ (string-to-number fra 16)
+ (expt 16.0 (length fra))))
+ exp (if (zerop (length exp))
+ 0 (string-to-number exp)))
+ (* negate (+ int fra) (expt 2.0 exp))))
(defun hif-string-to-number (string &optional base)
- "Like `string-to-number', but it understands non-decimal floats."
- (if (or (not base) (= base 10))
- (string-to-number string base)
- (let* ((parts (split-string string "\\." t "[ \t]+"))
- (frac (cadr parts))
- (fraclen (length frac))
- (quot (expt (if (zerop fraclen)
- base
- (* base 1.0)) fraclen)))
- (/ (string-to-number (concat (car parts) frac) base) quot))))
+ "Like `string-to-number', but it understands C(++) literals."
+ (setq string (hif-delete-char-in-string ?' string))
+ (string-to-number string base))
;; The dynamic binding variable `hif-simple-token-only' is shared only by
;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize'
@@ -562,52 +792,204 @@ that form should be displayed.")
;; Check the long comments before `hif-find-define' for more details. [lukelee]
(defvar hif-simple-token-only)
+(defsubst hif-is-white (c)
+ (memq c '(? ?\t ?\n ?\r)))
+
+(defun hif-strtok (string &optional rematch)
+ "Convert STRING into a hideif mode internal token.
+Assuming we've just performed a `hif-token-regexp' lookup."
+ ;; This function relies on the regexp groups of `hif-token-regexp'
+ ;; New hideif internal number representation: a text string with `hif-value'
+ ;; property to keep its value. Strings without `hif-value' property is a
+ ;; normal C(++) string. This is mainly for stringification. The original
+ ;; implementation only keep the value thus a C++ number like octal 01234
+ ;; will become "668" after being stringified instead of the expected "01234".
+ (let (bufstr m1 m3 m5 m6 m8 neg ch val dec)
+ (when rematch
+ (string-match hif-token-regexp string)
+ (setq bufstr string))
+
+ (cond
+
+ ;; decimal/octal
+ ((match-string 8 bufstr)
+ (setq m6 (match-string 9 bufstr))
+ (setq val
+ (if (or (setq m8 (match-string 11 bufstr))
+ (match-string 10 bufstr)) ;; floating
+ ;; TODO: do we need to add 'hif-type property for
+ ;; type-checking, but this will slow things down
+ (hif-string-to-decfloat string m6 m8)
+ (setq ch (aref string 0))
+ (hif-string-to-number
+ string
+ ;; octal begin with `0'
+ (if (and (> (length string) 1)
+ (or (eq ch ?0)
+ ;; -0... or +0...
+ (and (memq ch '(?- ?+))
+ (eq (aref string 1) ?0))))
+ 8 (setq dec 10)))))
+ ;; Decimal integer without sign and extension is identical to its
+ ;; string form, make it as simple as possible
+ (if (and dec
+ (null (match-string 12 bufstr)) ;; no extension like 'UL'
+ (not (memq ch '(?- ?+))))
+ val
+ (add-text-properties 0 1 (list 'hif-value val) string)
+ string))
+
+ ;; hex/binary
+ ((match-string 1 bufstr)
+ (setq m3 (match-string 3 bufstr))
+ (add-text-properties
+ 0 1
+ (list 'hif-value
+ (if (or (setq m5 (match-string 5 bufstr))
+ m3)
+ (hif-string-to-hexfloat
+ string
+ (match-string 2 bufstr) m3 m5) ;; hexfloat
+ (setq neg (if (eq (aref string 0) ?-) -1 1))
+ (* neg
+ (hif-string-to-number
+ ;; (5-(-1))/2=3; (5-1)/2=2
+ (substring-no-properties string (ash (- 5 neg) -1))
+ ;; (3-(-1))/2=2; (3-1)/2=1
+ (if (or (eq (setq ch (aref string (ash (- 3 neg) -1))) ?x)
+ (eq ch ?X)) ;; hex
+ 16 2)))))
+ string) string)
+
+ ;; operator
+ ((setq m1 (match-string 14 bufstr))
+ (cdr (assoc m1 hif-token-alist #'string-equal)))
+
+ (t
+ (setq hif-simple-token-only nil)
+ (intern-safe string)))))
+
+(defun hif-backward-comment (&optional start end)
+ "If we're currently within a C(++) comment, skip them backwards."
+ ;; Ignore trailing white spaces after comment
+ (setq end (or end (point)))
+ (while (and (> (1- end) 1)
+ (hif-is-white (char-after (1- end))))
+ (cl-decf end))
+ (let ((p0 end)
+ p cmt ce ws we ;; ce:comment start, ws:white start, we whilte end
+ cmtlist) ;; pair of (start.end) of comments
+ (setq start (or start (progn (beginning-of-line) (point)))
+ p start)
+ (while (< (1+ p) end)
+ (if (char-equal ?/ (char-after p)) ; /
+ (if (char-equal ?/ (char-after (1+ p))) ; //
+ (progn
+ ;; merge whites immediately ahead
+ (setq ce (if (and we (= (1- p) we)) ws p))
+ ;; scan for end of line
+ (while (and (< (cl-incf p) end)
+ (not (char-equal ?\n (char-after p)))
+ (not (char-equal ?\r (char-after p)))))
+ ;; Merge with previous comment if immediately followed
+ (push (cons (if (and cmtlist
+ (= (cdr (car cmtlist)) ce))
+ (car (pop cmtlist)) ;; extend previous comment
+ ce)
+ p)
+ cmtlist))
+ (when (char-equal ?* (char-after (1+ p))) ; /*
+ ;; merge whites immediately ahead
+ (setq ce (if (and we (= (1- p) we)) ws p))
+ ;; Check if it immediately follows previous /*...*/ comment;
+ ;; if yes, extend and merge into previous comment
+ (setq cmt (if (and cmtlist
+ (= (cdr (car cmtlist)) ce))
+ (car (pop cmtlist)) ;; extend previous comment
+ ce))
+ (setq p (+ 2 p))
+ ;; Scanning for `*/'
+ (catch 'break
+ (while (< (1+ p) end)
+ (if (not (and (char-equal ?* (char-after p))
+ (char-equal ?/ (char-after (1+ p)))))
+ (cl-incf p)
+ ;; found `*/', mark end pos
+ (push (cons cmt (1+ (setq p (1+ p)))) cmtlist)
+ (throw 'break nil)))
+ ;; (1+ p) >= end
+ (push (cons cmt end) cmtlist))))
+ ;; Trace most recent continuous white spaces before a comment
+ (if (char-equal ? (char-after p))
+ (if (and ws (= we (1- p))) ;; continued
+ (setq we p)
+ (setq ws p
+ we p))
+ (setq ws nil
+ we nil)))
+ (cl-incf p))
+ ;; Goto beginning of the last comment, if we're within
+ (setq cmt (car cmtlist)) ;; last cmt
+ (setq cmt (if (and cmt
+ (>= p0 (car cmt))
+ (<= p0 (cdr cmt)))
+ (car cmt) ;; beginning of the last comment
+ p0))
+ ;; Ignore leading whites ahead of comment
+ (while (and (> (1- cmt) 1)
+ (hif-is-white (char-after (1- cmt))))
+ (cl-decf cmt))
+ (goto-char cmt)))
+
(defun hif-tokenize (start end)
"Separate string between START and END into a list of tokens."
- (let ((token-list nil))
+ (let ((token-list nil)
+ (white-regexp "[ \t]+")
+ token)
(setq hif-simple-token-only t)
(with-syntax-table hide-ifdef-syntax-table
(save-excursion
- (goto-char start)
- (while (progn (forward-comment (point-max)) (< (point) end))
- ;; (message "expr-start = %d" expr-start) (sit-for 1)
- (cond
- ((looking-at "\\\\\n")
- (forward-char 2))
-
- ((looking-at hif-string-literal-regexp)
- (push (substring-no-properties (match-string 1)) token-list)
- (goto-char (match-end 0)))
-
- ((looking-at hif-token-regexp)
- (let ((token (buffer-substring-no-properties
- (point) (match-end 0))))
+ (save-restriction
+ ;; Narrow down to the focusing region so that the ending white spaces
+ ;; of that line will not be treated as a white, as `looking-at' won't
+ ;; look outside the restriction; otherwise it will note the last token
+ ;; or string as one with an `hif-space' property.
+ (setq end (hif-backward-comment start end))
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (progn (forward-comment (point-max)) (< (point) end))
+ ;; (message "expr-start = %d" expr-start) (sit-for 1)
+ (cond
+ ((looking-at "\\\\\n")
+ (forward-char 2))
+
+ ((looking-at hif-string-literal-regexp)
+ (setq token (substring-no-properties (match-string 1)))
+ (goto-char (match-end 0))
+ (when (looking-at white-regexp)
+ (add-text-properties 0 1 '(hif-space t) token)
+ (goto-char (match-end 0)))
+ (push token token-list))
+
+ ((looking-at hif-token-regexp)
(goto-char (match-end 0))
- ;; (message "token: %s" token) (sit-for 1)
- (push
- (or (cdr (assoc token hif-token-alist))
- (if (string-equal token "defined") 'hif-defined)
- ;; TODO:
- ;; 1. postfix 'l', 'll', 'ul' and 'ull'
- ;; 2. floating number formats (like 1.23e4)
- ;; 3. 098 is interpreted as octal conversion error
- (if (string-match "0x\\([[:xdigit:]]+\\.?[[:xdigit:]]*\\)"
- token)
- (hif-string-to-number (match-string 1 token) 16)) ;; hex
- (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token)
- (hif-string-to-number token 8)) ;; octal
- (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'"
- token)
- (string-to-number token)) ;; decimal
- (prog1 (intern token)
- (setq hif-simple-token-only nil)))
- token-list)))
-
- ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
- (forward-char 1)) ; the source code. Let's not get stuck here.
- (t (error "Bad #if expression: %s" (buffer-string)))))))
-
- (nreverse token-list)))
+ (setq token (hif-strtok
+ (substring-no-properties (match-string 0))))
+ (push token token-list)
+ (when (looking-at white-regexp)
+ ;; We can't just append a space to the token string, otherwise
+ ;; `0xf0 ' ## `01' will become `0xf0 01' instead of the expected
+ ;; `0xf001', hence a standalone `hif-space' is placed instead.
+ (push 'hif-space token-list)
+ (goto-char (match-end 0))))
+
+ ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
+ (forward-char 1)) ; the source code. Let's not get stuck here.
+
+ (t (error "Bad #if expression: %s" (buffer-string)))))))
+ (if (eq 'hif-space (car token-list))
+ (setq token-list (cdr token-list))) ;; remove trailing white space
+ (nreverse token-list))))
;;------------------------------------------------------------------------
;; Translate C preprocessor #if expressions using recursive descent.
@@ -637,50 +1019,96 @@ that form should be displayed.")
;; | | ^= = | |
;; | Comma | , | left-to-right |
-(defsubst hif-nexttoken ()
+(defun hif-nexttoken (&optional keep-space)
"Pop the next token from token-list into the let variable `hif-token'."
- (setq hif-token (pop hif-token-list)))
+ (let ((prevtoken hif-token))
+ (while (progn
+ (setq hif-token (pop hif-token-list))
+ (if keep-space ; keep only one space
+ (and (eq prevtoken 'hif-space)
+ (eq hif-token 'hif-space))
+ (eq hif-token 'hif-space)))))
+ hif-token)
+
+(defun hif-split-signed-token ()
+ "Split current numeric token into two (hif-plus/minus num)."
+ (let* (val ch0 head)
+ (when (and (stringp hif-token)
+ (setq val (get-text-property 0 'hif-value hif-token))
+ ;; explicitly signed?
+ (memq (setq ch0 (aref hif-token 0)) '(?+ ?-)))
+ (if (eq ch0 ?+)
+ (setq head 'hif-plus)
+ (setq head 'hif-minus
+ val (- val)))
+ (setq hif-token (substring hif-token 1))
+ (add-text-properties 0 1 (list 'hif-value val) hif-token)
+ (push hif-token hif-token-list)
+ (setq hif-token head))))
(defsubst hif-if-valid-identifier-p (id)
(not (or (numberp id)
- (stringp id))))
+ (stringp id)
+ (and (atom id)
+ (eq 'defined id)))))
(defun hif-define-operator (tokens)
"\"Upgrade\" hif-define XXX to `(hif-define XXX)' so it won't be substituted."
- (let ((result nil)
- (tok nil))
- (while (setq tok (pop tokens))
- (push
- (if (eq tok 'hif-defined)
- (progn
- (setq tok (cadr tokens))
- (if (eq (car tokens) 'hif-lparen)
- (if (and (hif-if-valid-identifier-p tok)
- (eq (nth 2 tokens) 'hif-rparen))
- (setq tokens (cl-cdddr tokens))
- (error "#define followed by non-identifier: %S" tok))
- (setq tok (car tokens)
- tokens (cdr tokens))
- (unless (hif-if-valid-identifier-p tok)
- (error "#define followed by non-identifier: %S" tok)))
- (list 'hif-defined 'hif-lparen tok 'hif-rparen))
- tok)
- result))
- (nreverse result)))
+ (if (memq 'hif-defined tokens)
+ (let* ((hif-token-list tokens)
+ hif-token
+ target
+ paren)
+ (setq tokens nil) ;; now it becomes the result
+ (while (hif-nexttoken t) ;; keep `hif-space'
+ (when (eq hif-token 'hif-defined)
+ ;; defined XXX, start ignoring `hif-space'
+ (hif-nexttoken)
+ (if (setq paren (eq hif-token 'hif-lparen))
+ (hif-nexttoken))
+ (if (not (hif-if-valid-identifier-p
+ (setq target hif-token)))
+ (error "`defined' followed by non-identifier: %S" target))
+ (if (and paren
+ (not (eq (hif-nexttoken) 'hif-rparen)))
+ (error "missing right parenthesis for `defined'"))
+ (setq hif-token
+ (list 'hif-defined 'hif-lparen target 'hif-rparen)))
+ (push hif-token tokens))
+ (nreverse tokens))
+ tokens))
(define-obsolete-function-alias 'hif-flatten #'flatten-tree "27.1")
-(defun hif-expand-token-list (tokens &optional macroname expand_list)
+(defun hif-keep-single (l e)
+ "Prevent two or more consecutive E in list L."
+ (if (memq e l)
+ (let (prev curr result)
+ (while (progn
+ (setq prev curr
+ curr (car l)
+ l (cdr l))
+ curr)
+ (unless (and (eq prev e)
+ (eq curr e))
+ (push curr result)))
+ (nreverse result))
+ l))
+
+(defun hif-expand-token-list (tokens &optional macroname expand_list level)
"Perform expansion on TOKENS till everything expanded.
Self-reference (directly or indirectly) tokens are not expanded.
EXPAND_LIST is the list of macro names currently being expanded, used for
-detecting self-reference."
+detecting self-reference.
+Function-like macros with calling depth LEVEL 0 does not expand arguments,
+this is to emulate the stringification behavior of C++ preprocessor."
(catch 'self-referencing
(let ((expanded nil)
(remains (hif-define-operator
(hif-token-concatenation
(hif-token-stringification tokens))))
tok rep)
+ (setq level (if level level 0))
(if macroname
(setq expand_list (cons macroname expand_list)))
;; Expanding all tokens till list exhausted
@@ -699,21 +1127,31 @@ detecting self-reference."
(if (and (listp rep)
(eq (car rep) 'hif-define-macro)) ; A defined macro
;; Recursively expand it
+ ;; only in defined macro do we increase the nesting LEVEL
(if (cadr rep) ; Argument list is not nil
- (if (not (eq (car remains) 'hif-lparen))
+ (if (not (or (eq (car remains) 'hif-lparen)
+ ;; hif-space hif-lparen
+ (and (eq (car remains) 'hif-space)
+ (eq (cadr remains) 'hif-lparen)
+ (setq remains (cdr remains)))))
;; No argument, no invocation
tok
;; Argumented macro, get arguments and invoke it.
- ;; Dynamically bind hif-token-list and hif-token
- ;; for hif-macro-supply-arguments
+ ;; Dynamically bind `hif-token-list' and `hif-token'
+ ;; for `hif-macro-supply-arguments'
(let* ((hif-token-list (cdr remains))
(hif-token nil)
- (parmlist (mapcar #'hif-expand-token-list
- (hif-get-argument-list)))
+ (parmlist
+ (if (zerop level)
+ (hif-get-argument-list t)
+ (mapcar (lambda (a)
+ (hif-expand-token-list
+ a nil nil (1+ level)))
+ (hif-get-argument-list t))))
(result
(hif-expand-token-list
(hif-macro-supply-arguments tok parmlist)
- tok expand_list)))
+ tok expand_list (1+ level))))
(setq remains (cons hif-token hif-token-list))
result))
;; Argument list is nil, direct expansion
@@ -745,16 +1183,20 @@ detecting self-reference."
"Parse the TOKEN-LIST.
Return translated list in prefix form. MACRONAME is applied when invoking
macros to prevent self-reference."
- (let ((hif-token-list (hif-expand-token-list token-list macroname)))
+ (let ((hif-token-list (hif-expand-token-list token-list macroname nil))
+ (hif-token nil))
(hif-nexttoken)
(prog1
(and hif-token
(hif-exprlist))
(if hif-token ; is there still a token?
- (error "Error: unexpected token: %s" hif-token)))))
+ (error "Error: unexpected token at line %d: `%s'"
+ (line-number-at-pos)
+ (or (car (rassq hif-token hif-token-alist))
+ hif-token))))))
(defun hif-exprlist ()
- "Parse an exprlist: expr { `,' expr}."
+ "Parse an exprlist: expr { `,' expr }."
(let ((result (hif-expr)))
(if (eq hif-token 'hif-comma)
(let ((temp (list result)))
@@ -824,7 +1266,7 @@ expr : or-expr | or-expr `?' expr `:' expr."
(defun hif-eq-expr ()
"Parse an eq-expr : comp | eq-expr `=='|`!=' comp."
(let ((result (hif-comp-expr))
- (eq-token nil))
+ (eq-token nil))
(while (memq hif-token '(hif-equal hif-notequal))
(setq eq-token hif-token)
(hif-nexttoken)
@@ -857,7 +1299,9 @@ expr : or-expr | or-expr `?' expr `:' expr."
math : muldiv | math `+'|`-' muldiv."
(let ((result (hif-muldiv-expr))
(math-op nil))
- (while (memq hif-token '(hif-plus hif-minus))
+ (while (or (memq hif-token '(hif-plus hif-minus))
+ ;; One token lookahead
+ (hif-split-signed-token))
(setq math-op hif-token)
(hif-nexttoken)
(setq result (list math-op result (hif-muldiv-expr))))
@@ -876,7 +1320,7 @@ expr : or-expr | or-expr `?' expr `:' expr."
(defun hif-factor ()
"Parse a factor.
-factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' |
+factor : `!' factor | `~' factor | `(' exprlist `)' | `defined(' id `)' |
id `(' parmlist `)' | strings | id."
(cond
((eq hif-token 'hif-not)
@@ -908,10 +1352,14 @@ factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' |
(hif-nexttoken)
`(hif-defined (quote ,ident))))
+ ((stringp hif-token)
+ (if (get-text-property 0 'hif-value hif-token)
+ ;; new hideif internal number format for string concatenation
+ (prog1 hif-token (hif-nexttoken))
+ (hif-string-concatenation)))
+
((numberp hif-token)
(prog1 hif-token (hif-nexttoken)))
- ((stringp hif-token)
- (hif-string-concatenation))
;; Unary plus/minus.
((memq hif-token '(hif-minus hif-plus))
@@ -924,12 +1372,12 @@ factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' |
(hif-place-macro-invocation ident)
`(hif-lookup (quote ,ident)))))))
-(defun hif-get-argument-list ()
+(defun hif-get-argument-list (&optional keep-space)
(let ((nest 0)
(parmlist nil) ; A "token" list of parameters, will later be parsed
(parm nil))
- (while (or (not (eq (hif-nexttoken) 'hif-rparen))
+ (while (or (not (eq (hif-nexttoken keep-space) 'hif-rparen))
(/= nest 0))
(if (eq (car (last parm)) 'hif-comma)
(setq parm nil))
@@ -945,7 +1393,7 @@ factor : `!' factor | `~' factor | `(' expr `)' | `defined(' id `)' |
(push hif-token parm))
(push (nreverse parm) parmlist) ; Okay even if PARM is nil
- (hif-nexttoken) ; Drop the `hif-rparen', get next token
+ (hif-nexttoken keep-space) ; Drop the `hif-rparen', get next token
(nreverse parmlist)))
(defun hif-place-macro-invocation (ident)
@@ -973,10 +1421,21 @@ This macro cannot be evaluated alone without parameters input."
(cond
((numberp a)
(number-to-string a))
- ((atom a)
- (symbol-name a))
((stringp a)
- (concat "\"" a "\""))
+ ;; Remove properties here otherwise a string like "0x12 + 0x34" will be
+ ;; later evaluated as (0x12 + 0x34) and become 0x70.
+ ;; See also `hif-eval' and `hif-mathify'.
+ (concat (substring-no-properties a)
+ (if (get-text-property 0 'hif-space a) " ")))
+ ((atom a)
+ (if (memq a hif-valid-token-list)
+ (car (rassq a hif-token-alist))
+ (if (eq a 'hif-space)
+ " "
+ (symbol-name a))))
+ ((listp a) ;; stringify each element then concat
+ (cl-loop for e in a
+ concat (hif-stringify e)))
(t
(error "Invalid token to stringify"))))
@@ -984,32 +1443,34 @@ This macro cannot be evaluated alone without parameters input."
(if (stringp str)
(intern str)))
-(defun hif-token-concat (a b)
- "Concatenate two tokens into a longer token.
-Currently support only simple token concatenation. Also support weird (but
-valid) token concatenation like `>' ## `>' becomes `>>'. Here we take care only
-those that can be evaluated during preprocessing time and ignore all those that
-can only be evaluated at C(++) runtime (like `++', `--' and `+='...)."
- (if (or (memq a hif-valid-token-list)
- (memq b hif-valid-token-list))
- (let* ((ra (car (rassq a hif-token-alist)))
- (rb (car (rassq b hif-token-alist)))
- (result (and ra rb
- (cdr (assoc (concat ra rb) hif-token-alist)))))
- (or result
- ;;(error "Invalid token to concatenate")
- (error "Concatenating \"%s\" and \"%s\" does not give a valid \
-preprocessing token"
- (or ra (symbol-name a))
- (or rb (symbol-name b)))))
- (intern-safe (concat (hif-stringify a)
- (hif-stringify b)))))
+(defun hif-token-concat (l)
+ "Concatenate a list of tokens into a longer token.
+Also support weird (but valid) token concatenation like `>' ## `>' becomes `>>'.
+Here we take care only those that can be evaluated during preprocessing time and
+ignore all those that can only be evaluated at C(++) runtime (like `++', `--'
+and `+='...)."
+ (let ((str nil))
+ (dolist (i l)
+ ;;(assert (not (eq i 'hif-space)) nil ;; debug
+ ;; "Internal error: should not be concatenating `hif-space'")
+ (setq str
+ (concat str
+ (if (memq i hif-valid-token-list)
+ (car (rassq i hif-token-alist))
+ (hif-stringify i)))))
+ ;; Check if it's a number, if yes, return the number instead of a symbol.
+ ;; 'hif-value and 'hif-space properties are trimmed off by `hif-stringify'
+ (hif-strtok str t)))
(defun hif-mathify (val)
- "Treat VAL as a number: if it's t or nil, use 1 or 0."
- (cond ((eq val t) 1)
- ((null val) 0)
- (t val)))
+ "Treat VAL as a hideif number: if it's t or nil, use 1 or 0."
+ (cond
+ ((stringp val)
+ (or (get-text-property 0 'hif-value val)
+ val))
+ ((eq val t) 1)
+ ((null val) 0)
+ (t val)))
(defun hif-conditional (a b c)
(if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c)))
@@ -1053,49 +1514,108 @@ preprocessing token"
(defalias 'hif-logxor (hif-mathify-binop logxor))
(defalias 'hif-logand (hif-mathify-binop logand))
+(defun hif-__LINE__ ()
+ (line-number-at-pos))
+
+(defun hif-__FILE__ ()
+ (file-name-nondirectory (buffer-file-name)))
+
+(defvar hif-__COUNTER__ 0)
+(defun hif-__COUNTER__ ()
+ (prog1 hif-__COUNTER__ (cl-incf hif-__COUNTER__)))
+
+(defun hif-__cplusplus ()
+ (and (string-match
+ "\\.c\\(c\\|xx\\|pp\\|\\+\\+\\)\\'"
+ (buffer-file-name))
+ (memq major-mode '(c++-mode cc-mode cpp-mode))
+ 201710))
+
+(defun hif-__DATE__ ()
+ (format-time-string "%Y/%m/%d"))
+
+(defun hif-__TIME__ ()
+ (format-time-string "%H:%M:%S"))
+
+(defun hif-__STDC__ () 1)
+(defun hif-__STDC_VERSION__ () 201710)
+(defun hif-__STDC_HOST__ () 1)
(defun hif-comma (&rest expr)
"Evaluate a list of EXPR, return the result of the last item."
(let ((result nil))
- (dolist (e expr)
+ (dolist (e expr result)
(ignore-errors
- (setq result (funcall hide-ifdef-evaluator e))))
- result))
+ (setq result (funcall hide-ifdef-evaluator e))))))
(defun hif-token-stringification (l)
- "Scan token list for `hif-stringify' ('#') token and stringify the next token."
- (let (result)
- (while l
- (push (if (eq (car l) 'hif-stringify)
- (prog1
- (if (cadr l)
- (hif-stringify (cadr l))
- (error "No token to stringify"))
- (setq l (cdr l)))
- (car l))
- result)
- (setq l (cdr l)))
- (nreverse result)))
+ "Scan token list for `hif-stringify' (`#') token and stringify the next token."
+ (if (memq 'hif-stringify l)
+ (let (result)
+ (while l
+ (push (if (eq (car l) 'hif-stringify)
+ (prog1
+ (if (cadr l)
+ (hif-stringify (cadr l))
+ (error "No token to stringify"))
+ (setq l (cdr l)))
+ (car l))
+ result)
+ (setq l (cdr l)))
+ (nreverse result))
+ ;; no `#' presents
+ l))
(defun hif-token-concatenation (l)
- "Scan token list for `hif-token-concat' ('##') token and concatenate two tokens."
- (let ((prev nil)
- result)
- (while l
- (while (eq (car l) 'hif-token-concat)
- (unless prev
- (error "No token before ## to concatenate"))
- (unless (cdr l)
- (error "No token after ## to concatenate"))
- (setq prev (hif-token-concat prev (cadr l)))
- (setq l (cddr l)))
- (if prev
- (setq result (append result (list prev))))
- (setq prev (car l)
- l (cdr l)))
- (if prev
- (append result (list prev))
- result)))
+ "Scan token list for `hif-token-concat' ('##') token and concatenate tokens."
+ (if (memq 'hif-token-concat l)
+ ;; Notice that after some substitutions, there could be more than
+ ;; one `hif-space' in a list.
+ (let ((items nil)
+ (tk nil)
+ (count 0) ; count of `##'
+ result)
+ (setq l (hif-keep-single l 'hif-space))
+ (while (setq tk (car l))
+ (if (not (eq tk 'hif-token-concat))
+ ;; In reverse order so that we don't have to use `last' or
+ ;; `butlast'
+ (progn
+ (push tk result)
+ (setq l (cdr l)))
+ ;; First `##' met, start `##' sequence
+ ;; We only drop `hif-space' when doing token concatenation
+ (setq items nil
+ count 0)
+ (setq tk (pop result))
+ (if (or (null tk)
+ (and (eq tk 'hif-space)
+ (null (setq tk (pop result)))))
+ (error "No token before `##' to concatenate")
+ (push tk items) ; first item, in reverse order
+ (setq tk 'hif-token-concat))
+ (while (eq tk 'hif-token-concat)
+ (cl-incf count)
+ ;; 2+ item
+ (setq l (cdr l)
+ tk (car l))
+ ;; only one 'hif-space could appear here
+ (if (eq tk 'hif-space) ; ignore it
+ (setq l (cdr l)
+ tk (car l)))
+ (if (or (null tk)
+ (eq tk 'hif-token-concat))
+ (error
+ "No token after the %d-th `##' to concatenate at line %d"
+ count (line-number-at-pos))
+ (push tk items)
+ (setq l (cdr l)
+ tk (car l))))
+ ;; `##' sequence ended, concat them, then push into result
+ (push (hif-token-concat (nreverse items)) result)))
+ (nreverse result))
+ ;; no need to reassemble the list if no `##' presents
+ l))
(defun hif-delimit (lis atom)
(nconc (mapcan (lambda (l) (list l atom))
@@ -1105,7 +1625,7 @@ preprocessing token"
;; Perform token replacement:
(defun hif-macro-supply-arguments (macro-name actual-parms)
"Expand a macro call, replace ACTUAL-PARMS in the macro body."
- (let* ((SA (assoc macro-name hide-ifdef-env))
+ (let* ((SA (assq macro-name hide-ifdef-env))
(macro (and SA
(cdr SA)
(eq (cadr SA) 'hif-define-macro)
@@ -1156,11 +1676,14 @@ preprocessing token"
formal macro-body))
(setq actual-parms (cdr actual-parms)))
- ;; Replacement completed, flatten the whole token list
- (setq macro-body (flatten-tree macro-body))
+ ;; Replacement completed, stringifiy and concatenate the token list.
+ ;; Stringification happens must take place before flattening, otherwise
+ ;; only the first token will be stringified.
+ (setq macro-body
+ (flatten-tree (hif-token-stringification macro-body)))
- ;; Stringification and token concatenation happens here
- (hif-token-concatenation (hif-token-stringification macro-body)))))
+ ;; Token concatenation happens here, keep single 'hif-space
+ (hif-keep-single (hif-token-concatenation macro-body) 'hif-space))))
(defun hif-invoke (macro-name actual-parms)
"Invoke a macro by expanding it, reparse macro-body and finally invoke it."
@@ -1432,7 +1955,7 @@ Point is left unchanged."
;; A bit slimy.
(defun hif-hide-line (point)
- "Hide the line containing point.
+ "Hide the line containing POINT.
Does nothing if `hide-ifdef-lines' is nil."
(when hide-ifdef-lines
(save-excursion
@@ -1441,7 +1964,7 @@ Does nothing if `hide-ifdef-lines' is nil."
(line-beginning-position) (progn (hif-end-of-line) (point))))))
-;; Hif-Possibly-Hide
+;; hif-Possibly-Hide
;; There are four cases. The #ifX expression is "taken" if it
;; the hide-ifdef-evaluator returns T. Presumably, this means the code
;; inside the #ifdef would be included when the program was
@@ -1484,7 +2007,7 @@ Does nothing if `hide-ifdef-lines' is nil."
"Called at #ifX expression, this hides those parts that should be hidden.
It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag
indicating that we should expand the #ifdef even if it should be hidden.
-Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
+Refer to `hide-ifdef-expand-reinclusion-guard' for more details."
;; (message "hif-possibly-hide") (sit-for 1)
(let* ((case-fold-search nil)
(test (hif-canonicalize hif-ifx-regexp))
@@ -1564,23 +2087,83 @@ Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
(result (funcall hide-ifdef-evaluator expr)))
result))
+(defun hif-display-macro (name def &optional result)
+ (if (and def
+ (listp def)
+ (eq (car def) 'hif-define-macro))
+ (let ((cdef (concat "#define " name))
+ (parmlist (cadr def))
+ s)
+ (setq def (caddr def))
+ ;; parmlist
+ (when parmlist
+ (setq cdef (concat cdef "("))
+ (while (car parmlist)
+ (setq cdef (concat cdef (symbol-name (car parmlist))
+ (if (cdr parmlist) ","))
+ parmlist (cdr parmlist)))
+ (setq cdef (concat cdef ")")))
+ (setq cdef (concat cdef " "))
+ ;; body
+ (while def
+ (if (listp def)
+ (setq s (car def)
+ def (cdr def))
+ (setq s def
+ def nil))
+ (setq cdef
+ (concat cdef
+ (cond
+ ;;((setq tok (car (rassoc s hif-token-alist)))
+ ;; (concat tok (if (eq s 'hif-comma) " ")))
+ ((symbolp s)
+ (concat (hif-stringify s)
+ (if (eq s 'hif-comma) " ")))
+ ((stringp s)
+ (hif-stringify s))
+ (t ;; (numberp s)
+ (format "%S" s))))))
+ (if (and result
+ ;; eg: "#define RECURSIVE_SYMBOL RECURSIVE_SYMBOL"
+ (not (and (listp result)
+ (eq (car result) 'hif-define-macro))))
+ (setq cdef (concat cdef
+ (if (integerp result)
+ (format "\n=> %S (%#x)" result result)
+ (format "\n=> %S" result)))))
+ (message "%s" cdef))
+ (message "%S <= `%s'" def name)))
+
(defun hif-evaluate-macro (rstart rend)
"Evaluate the macro expansion result for the active region.
-If no region active, find the current #ifdefs and evaluate the result.
+If no region is currently active, find the current #ifdef/#define and evaluate
+the result; otherwise it looks for current word at point.
Currently it supports only math calculations, strings or argumented macros can
-not be expanded."
+not be expanded.
+This function by default ignores parsing error and return `false' on evaluating
+runtime C(++) statements or tokens that normal C(++) preprocessor can't perform;
+however, when this command is prefixed, it will display the error instead."
(interactive
- (if (use-region-p)
- (list (region-beginning) (region-end))
- '(nil nil)))
- (let ((case-fold-search nil))
+ (if (not (use-region-p))
+ '(nil nil)
+ (list (region-beginning) (region-end))))
+ (run-hooks 'hide-ifdef-evalulate-enter-hook)
+ (let ((case-fold-search nil)
+ (currpnt (point))
+ bounds)
(save-excursion
(unless (use-region-p)
(setq rstart nil rend nil)
(beginning-of-line)
- (when (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
- (string= "define" (match-string 2)))
- (re-search-forward hif-macroref-regexp nil t)))
+ (if (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
+ (= (line-number-at-pos currpnt) (line-number-at-pos)))
+ (if (string= "define" (match-string 2))
+ (re-search-forward hif-macroref-regexp nil t))
+ (goto-char currpnt)
+ (setq bounds (bounds-of-thing-at-point 'word)
+ ;; TODO: BOUNDS need a C++ syntax word boundary finder
+ rstart (car bounds)
+ rend (cdr bounds))))
(let* ((start (or rstart (point)))
(end (or rend (progn (hif-end-of-line) (point))))
(defined nil)
@@ -1588,34 +2171,61 @@ not be expanded."
(tokens (ignore-errors ; Prevent C statement things like
; 'do { ... } while (0)'
(hif-tokenize start end)))
+ ;; Note that on evaluating we can't simply define the symbol
+ ;; even if we are currently at a #define line, as this #define
+ ;; might actually be wrapped up in a #if 0 block. We can only
+ ;; define that explicitly with `hide-ifdef-define'.
(expr (or (and (<= (length tokens) 1) ; Simple token
- (setq defined (assoc (car tokens) hide-ifdef-env))
+ (setq defined
+ (or (assq (car tokens) hide-ifdef-env)
+ (assq (car tokens) hif-predefine-alist)))
(setq simple (atom (hif-lookup (car tokens))))
(hif-lookup (car tokens)))
(and tokens
- (condition-case nil
+ (condition-case err
(hif-parse-exp tokens)
(error
- nil)))))
- (result (funcall hide-ifdef-evaluator expr))
- (exprstring (replace-regexp-in-string
- ;; Trim off leading/trailing whites
- "^[ \t]*\\([^ \t]+\\)[ \t]*" "\\1"
- (replace-regexp-in-string
- "\\(//.*\\)" "" ; Trim off end-of-line comments
- (buffer-substring-no-properties start end)))))
- (cond
- ((and (<= (length tokens) 1) simple) ; Simple token
- (if defined
- (message "%S <= `%s'" result exprstring)
- (message "`%s' is not defined" exprstring)))
- ((integerp result)
- (if (or (= 0 result) (= 1 result))
- (message "%S <= `%s'" result exprstring)
- (message "%S (%#x) <= `%s'" result result exprstring)))
- ((null result) (message "%S <= `%s'" 'false exprstring))
- ((eq t result) (message "%S <= `%s'" 'true exprstring))
- (t (message "%S <= `%s'" result exprstring)))
+ ;; when prefixed, pass the error on for later
+ ;; `hide-ifdef-evaluator'
+ (if current-prefix-arg err))))))
+ (exprstring (hif-stringify tokens))
+ (result (condition-case err
+ (funcall hide-ifdef-evaluator expr)
+ ;; in case of arithmetic error or others
+ (error (error "Error: line %d %S when evaluating `%s'"
+ (line-number-at-pos) err exprstring)))))
+ (setq
+ result
+ (cond
+ ((= (length tokens) 0)
+ (message "`%s'" exprstring))
+ ((= (length tokens) 1) ; Simple token
+ (if simple
+ (if defined
+ (hif-display-macro exprstring result)
+ (if (and (hif-is-number exprstring)
+ result (numberp result))
+ (message "%S (%#x)" result result)
+ (if (and (hif-is-float exprstring)
+ result (numberp result))
+ (message "%S (%s)" result exprstring)
+ (if (string-match hif-string-literal-regexp exprstring)
+ (message "%s" exprstring)
+ (message "`%s' is not defined" exprstring)))))
+ (if defined
+ (hif-display-macro exprstring (cdr defined) result)
+ (message "`%s' is not defined" exprstring))))
+ ((integerp result)
+ (if (or (= 0 result) (= 1 result))
+ (message "%S <= `%s'" result exprstring)
+ (message "%S (%#x) <= `%s'" result result exprstring)))
+ ((null result)
+ (message "%S <= `%s'" 'false exprstring))
+ ((eq t result)
+ (message "%S <= `%s'" 'true exprstring))
+ (t
+ (message "%S <= `%s'" result exprstring))))
+ (run-hooks 'hide-ifdef-evalulate-leave-hook)
result))))
(defun hif-parse-macro-arglist (str)
@@ -1667,6 +2277,8 @@ first arg will be `hif-etc'."
;; the performance I use this `hif-simple-token-only' to notify my code and
;; save the final [value] into symbol database. [lukelee]
+(defvar hif-verbose-define-count 0)
+
(defun hif-find-define (&optional min max)
"Parse texts and retrieve all defines within the region MIN and MAX."
(interactive)
@@ -1676,8 +2288,11 @@ first arg will be `hif-etc'."
(let* ((defining (string= "define" (match-string 2)))
(name (and (re-search-forward hif-macroref-regexp max t)
(match-string 1)))
- (parmlist (and (match-string 3) ; First arg id found
- (hif-parse-macro-arglist (match-string 2)))))
+ (parmlist (or (and (match-string 3) ; First arg id found
+ (delq 'hif-space
+ (hif-parse-macro-arglist (match-string 2))))
+ (and (match-string 2) ; empty arglist
+ (list nil)))))
(if defining
;; Ignore name (still need to return 't), or define the name
(or (and hide-ifdef-exclude-define-regexp
@@ -1689,6 +2304,14 @@ first arg will be `hif-etc'."
(hif-simple-token-only nil) ; Dynamic binding
(tokens
(and name
+ (prog1 t
+ (cl-incf hif-verbose-define-count)
+ ;; only show 1/50 to not slow down to much
+ (if (and hide-ifdef-verbose
+ (= (% hif-verbose-define-count 50) 1))
+ (message "[Line %d] defining %S"
+ (line-number-at-pos (point))
+ (substring-no-properties name))))
;; `hif-simple-token-only' is set/clear
;; only in this block
(condition-case nil
@@ -1700,8 +2323,10 @@ first arg will be `hif-etc'."
;; this will stop hideif from searching
;; for more #defines.
(setq hif-simple-token-only t)
- (buffer-substring-no-properties
- start end)))))
+ (replace-regexp-in-string
+ "^[ \t]*\\|[ \t]*$" ""
+ (buffer-substring-no-properties
+ start end))))))
;; For simple tokens we save only the parsed result;
;; otherwise we save the tokens and parse it after
;; parameter replacement
@@ -1715,17 +2340,19 @@ first arg will be `hif-etc'."
`(hif-define-macro ,parmlist
,tokens))))
(SA (and name
- (assoc (intern name) hide-ifdef-env))))
+ (assq (intern name) hide-ifdef-env))))
(and name
(if SA
(or (setcdr SA expr) t)
- ;; Lazy evaluation, eval only if hif-lookup find it.
+ ;; Lazy evaluation, eval only if `hif-lookup' find it.
;; Define it anyway, even if nil it's still in list
;; and therefore considered defined.
(push (cons (intern name) expr) hide-ifdef-env)))))
;; #undef
(and name
- (hif-undefine-symbol (intern name))))))
+ (intern-soft name)
+ (hif-undefine-symbol (intern name)))
+ t)))
t))
@@ -1735,7 +2362,10 @@ first arg will be `hif-etc'."
(save-excursion
(save-restriction
;; (mark-region min max) ;; for debugging
+ (setq hif-verbose-define-count 0)
+ (forward-comment (point-max))
(while (hif-find-define min max)
+ (forward-comment (point-max))
(setf min (point)))
(if max (goto-char max)
(goto-char (point-max))))))
@@ -1743,24 +2373,33 @@ first arg will be `hif-etc'."
(defun hide-ifdef-guts ()
"Does most of the work of `hide-ifdefs'.
It does not do the work that's pointless to redo on a recursive entry."
- ;; (message "hide-ifdef-guts")
(save-excursion
(let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp'
- (expand-header (and hide-ifdef-expand-reinclusion-protection
+ (expand-header (and hide-ifdef-expand-reinclusion-guard
+ (buffer-file-name)
(string-match hide-ifdef-header-regexp
(buffer-file-name))
(zerop hif-recurse-level)))
(case-fold-search nil)
min max)
+ (setq hif-__COUNTER__ 0)
(goto-char (point-min))
(setf min (point))
- (cl-loop do
- (setf max (hif-find-any-ifX))
- (hif-add-new-defines min max)
- (if max
- (hif-possibly-hide expand-header))
- (setf min (point))
- while max))))
+ ;; Without this `condition-case' it would be easier to see which
+ ;; operation went wrong thru the backtrace `iff' user realize
+ ;; the underlying meaning of all hif-* operation; for example,
+ ;; `hif-shiftleft' refers to C(++) '<<' operator and floating
+ ;; operation arguments would be invalid.
+ (condition-case err
+ (cl-loop do
+ (setf max (hif-find-any-ifX))
+ (hif-add-new-defines min max)
+ (if max
+ (hif-possibly-hide expand-header))
+ (setf min (point))
+ while max)
+ (error (error "Error: failed at line %d %S"
+ (line-number-at-pos) err))))))
;;===%%SF%% hide-ifdef-hiding (End) ===
@@ -1821,13 +2460,17 @@ This allows #ifdef VAR to be hidden."
nil nil t nil "1")))
(list var val)))
(hif-set-var var (or val 1))
- (message "%s set to %s" var (or val 1))
- (sleep-for 1)
- (if hide-ifdef-hiding (hide-ifdefs)))
+ (if hide-ifdef-hiding (hide-ifdefs))
+ (message "%s set to %s" var (or val 1)))
(defun hif-undefine-symbol (var)
- (setq hide-ifdef-env
- (delete (assoc var hide-ifdef-env) hide-ifdef-env)))
+ (when (assq var hide-ifdef-env)
+ (setq hide-ifdef-env
+ (delete (assq var hide-ifdef-env) hide-ifdef-env))
+ ;; We can override things in `hif-predefine-alist' so keep them
+ (unless (assq var hif-predefine-alist)
+ (unintern (symbol-name var) nil))
+ t))
(defun hide-ifdef-undef (start end)
"Undefine a VAR so that #ifdef VAR would not be included."
@@ -1848,35 +2491,54 @@ This allows #ifdef VAR to be hidden."
(if hide-ifdef-hiding (hide-ifdefs))
(message "`%S' undefined" sym))))
-(defun hide-ifdefs (&optional nomsg)
+(defun hide-ifdefs (&optional start end nomsg)
"Hide the contents of some #ifdefs.
Assume that defined symbols have been added to `hide-ifdef-env'.
The text hidden is the text that would not be included by the C
preprocessor if it were given the file with those symbols defined.
With prefix command presents it will also hide the #ifdefs themselves.
+Hiding will only be performed within the marked region if there is one.
+
Turn off hiding by calling `show-ifdefs'."
- (interactive)
- (let ((hide-ifdef-lines current-prefix-arg))
- (or nomsg
- (message "Hiding..."))
- (setq hif-outside-read-only buffer-read-only)
- (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode
- (if hide-ifdef-hiding
- (show-ifdefs)) ; Otherwise, deep confusion.
- (setq hide-ifdef-hiding t)
- (hide-ifdef-guts)
- (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
- (or nomsg
- (message "Hiding done"))))
-
-
-(defun show-ifdefs ()
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
+
+ (setq current-prefix-arg (or hide-ifdef-lines current-prefix-arg))
+ (save-restriction
+ (let* ((hide-ifdef-lines current-prefix-arg)
+ (outer-hide-ifdef-verbose hide-ifdef-verbose)
+ (hide-ifdef-verbose (and outer-hide-ifdef-verbose
+ (not (or nomsg (use-region-p)))))
+ (hide-start-time (current-time)))
+ (and hide-ifdef-verbose
+ (message "Hiding..."))
+ (setq hif-outside-read-only buffer-read-only)
+ (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode
+ (if hide-ifdef-hiding
+ (show-ifdefs)) ; Otherwise, deep confusion.
+ (setq hide-ifdef-hiding t)
+ (narrow-to-region (or start (point-min)) (or end (point-max)))
+ (hide-ifdef-guts)
+ (setq buffer-read-only
+ (or hide-ifdef-read-only hif-outside-read-only))
+ (and hide-ifdef-verbose
+ (message "Hiding done, %.1f seconds elapsed"
+ (float-time (time-subtract (current-time)
+ hide-start-time)))))))
+
+
+(defun show-ifdefs (&optional start end)
"Cancel the effects of `hide-ifdef': show the contents of all #ifdefs."
- (interactive)
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max))))
(setq buffer-read-only hif-outside-read-only)
- (hif-show-all)
+ (hif-show-all (or start (point-min)) (or end (point-max)))
(setq hide-ifdef-hiding nil))
@@ -1960,21 +2622,17 @@ With optional prefix argument ARG, also hide the #ifdefs themselves."
;;; definition alist support
+;; The old implementation that match symbol only to 't is now considered
+;; obsolete.
(defvar hide-ifdef-define-alist nil
"A global assoc list of pre-defined symbol lists.")
-(defun hif-compress-define-list (env)
- "Compress the define list ENV into a list of defined symbols only."
- (let ((new-defs nil))
- (dolist (def env new-defs)
- (if (hif-lookup (car def)) (push (car def) new-defs)))))
-
(defun hide-ifdef-set-define-alist (name)
"Set the association for NAME to `hide-ifdef-env'."
(interactive "SSet define list: ")
- (push (cons name (hif-compress-define-list hide-ifdef-env))
- hide-ifdef-define-alist))
+ (push (cons name hide-ifdef-env)
+ hide-ifdef-define-alist))
(defun hide-ifdef-use-define-alist (name)
"Set `hide-ifdef-env' to the define list specified by NAME."
@@ -1986,9 +2644,8 @@ With optional prefix argument ARG, also hide the #ifdefs themselves."
(if (stringp name) (setq name (intern name)))
(let ((define-list (assoc name hide-ifdef-define-alist)))
(if define-list
- (setq hide-ifdef-env
- (mapcar (lambda (arg) (cons arg t))
- (cdr define-list)))
+ (setq hide-ifdef-env
+ (cdr define-list))
(error "No define list for %s" name))
(if hide-ifdef-hiding (hide-ifdefs))))
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 73d09e00591..b2557587c6c 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -232,13 +232,11 @@
(defcustom hs-hide-comments-when-hiding-all t
"Hide the comments too when you do an `hs-hide-all'."
- :type 'boolean
- :group 'hideshow)
+ :type 'boolean)
(defcustom hs-minor-mode-hook nil
"Hook called when hideshow minor mode is activated or deactivated."
:type 'hook
- :group 'hideshow
:version "21.1")
(defcustom hs-isearch-open 'code
@@ -254,8 +252,7 @@ This has effect only if `search-invisible' is set to `open'."
:type '(choice (const :tag "open only code blocks" code)
(const :tag "open only comment blocks" comment)
(const :tag "open both code and comment blocks" t)
- (const :tag "don't open any of them" nil))
- :group 'hideshow)
+ (const :tag "don't open any of them" nil)))
;;;###autoload
(defvar hs-special-modes-alist
@@ -313,7 +310,7 @@ a block), `hs-hide-all', `hs-hide-block' and `hs-hide-level'.")
These commands include the toggling commands (when the result is to show
a block), `hs-show-all' and `hs-show-block'.")
-(defvar hs-set-up-overlay #'ignore
+(defcustom hs-set-up-overlay #'ignore
"Function called with one arg, OV, a newly initialized overlay.
Hideshow puts a unique overlay on each range of text to be hidden
in the buffer. Here is a simple example of how to use this variable:
@@ -329,7 +326,9 @@ in the buffer. Here is a simple example of how to use this variable:
This example shows how to get information from the overlay as well
as how to set its `display' property. See `hs-make-overlay' and
-info node `(elisp)Overlays'.")
+info node `(elisp)Overlays'."
+ :type 'function
+ :version "28.1")
;;---------------------------------------------------------------------------
;; internal variables
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index 933cb333dfb..e9a21d4a0cf 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -1,4 +1,4 @@
-;;; icon.el --- mode for editing Icon code
+;;; icon.el --- mode for editing Icon code -*- lexical-binding: t -*-
;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
@@ -31,53 +31,48 @@
"Abbrev table in use in Icon-mode buffers.")
(define-abbrev-table 'icon-mode-abbrev-table ())
-(defvar icon-mode-map ()
- "Keymap used in Icon mode.")
-(if icon-mode-map
- ()
+(defvar icon-mode-map
(let ((map (make-sparse-keymap "Icon")))
- (setq icon-mode-map (make-sparse-keymap))
- (define-key icon-mode-map "{" 'electric-icon-brace)
- (define-key icon-mode-map "}" 'electric-icon-brace)
- (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
- (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
- (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
- (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
- (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
-
- (define-key icon-mode-map [menu-bar] (make-sparse-keymap "Icon"))
- (define-key icon-mode-map [menu-bar icon]
- (cons "Icon" map))
- (define-key map [beginning-of-icon-defun] '("Beginning of function" . beginning-of-icon-defun))
- (define-key map [end-of-icon-defun] '("End of function" . end-of-icon-defun))
- (define-key map [comment-region] '("Comment Out Region" . comment-region))
- (define-key map [indent-region] '("Indent Region" . indent-region))
- (define-key map [indent-line] '("Indent Line" . icon-indent-command))
- (put 'eval-region 'menu-enable 'mark-active)
- (put 'comment-region 'menu-enable 'mark-active)
- (put 'indent-region 'menu-enable 'mark-active)))
-
-(defvar icon-mode-syntax-table nil
- "Syntax table in use in Icon-mode buffers.")
+ (define-key map "{" 'electric-icon-brace)
+ (define-key map "}" 'electric-icon-brace)
+ (define-key map "\e\C-h" 'mark-icon-function)
+ (define-key map "\e\C-a" 'beginning-of-icon-defun)
+ (define-key map "\e\C-e" 'end-of-icon-defun)
+ (define-key map "\e\C-q" 'indent-icon-exp)
+ (define-key map "\177" 'backward-delete-char-untabify)
+ map)
+ "Keymap used in Icon mode.")
-(if icon-mode-syntax-table
- ()
- (setq icon-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
- (modify-syntax-entry ?# "<" icon-mode-syntax-table)
- (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
- (modify-syntax-entry ?$ "." icon-mode-syntax-table)
- (modify-syntax-entry ?/ "." icon-mode-syntax-table)
- (modify-syntax-entry ?* "." icon-mode-syntax-table)
- (modify-syntax-entry ?+ "." icon-mode-syntax-table)
- (modify-syntax-entry ?- "." icon-mode-syntax-table)
- (modify-syntax-entry ?= "." icon-mode-syntax-table)
- (modify-syntax-entry ?% "." icon-mode-syntax-table)
- (modify-syntax-entry ?< "." icon-mode-syntax-table)
- (modify-syntax-entry ?> "." icon-mode-syntax-table)
- (modify-syntax-entry ?& "." icon-mode-syntax-table)
- (modify-syntax-entry ?| "." icon-mode-syntax-table)
- (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
+(easy-menu-define icon-mode-menu icon-mode-map
+ "Menu for Icon mode."
+ '("Icon"
+ ["Beginning of function" beginning-of-icon-defun]
+ ["Comment Out Region" comment-region
+ :enable mark-active]
+ ["End of function" end-of-icon-defun]
+ ["Indent Line" icon-indent-command]
+ ["Indent Region" indent-region
+ :enable mark-active]))
+
+(defvar icon-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\\ "\\" table)
+ (modify-syntax-entry ?# "<" table)
+ (modify-syntax-entry ?\n ">" table)
+ (modify-syntax-entry ?$ "." table)
+ (modify-syntax-entry ?/ "." table)
+ (modify-syntax-entry ?* "." table)
+ (modify-syntax-entry ?+ "." table)
+ (modify-syntax-entry ?- "." table)
+ (modify-syntax-entry ?= "." table)
+ (modify-syntax-entry ?% "." table)
+ (modify-syntax-entry ?< "." table)
+ (modify-syntax-entry ?> "." table)
+ (modify-syntax-entry ?& "." table)
+ (modify-syntax-entry ?| "." table)
+ (modify-syntax-entry ?\' "\"" table)
+ table)
+ "Syntax table in use in Icon-mode buffers.")
(defgroup icon nil
"Mode for editing Icon code."
@@ -86,42 +81,35 @@
(defcustom icon-indent-level 4
"Indentation of Icon statements with respect to containing block."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-brace-imaginary-offset 0
"Imagined indentation of an Icon open brace that actually follows a statement."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-brace-offset 0
"Extra indentation for braces, compared with other text in same context."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-continued-statement-offset 4
"Extra indent for Icon lines not starting new statements."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-continued-brace-offset 0
"Extra indent for Icon substatements that start with open-braces.
This is in addition to `icon-continued-statement-offset'."
- :type 'integer
- :group 'icon)
+ :type 'integer)
(defcustom icon-auto-newline nil
"Non-nil means automatically newline before and after braces Icon code.
This applies when braces are inserted."
- :type 'boolean
- :group 'icon)
+ :type 'boolean)
(defcustom icon-tab-always-indent t
"Non-nil means TAB in Icon mode should always reindent the current line.
It will then reindent, regardless of where in the line point is
when the TAB command is used."
- :type 'boolean
- :group 'icon)
+ :type 'boolean)
(defvar icon-imenu-generic-expression
'((nil "^[ \t]*procedure[ \t]+\\(\\sw+\\)[ \t]*(" 1))
@@ -209,12 +197,11 @@ with no args, if that value is non-nil."
(progn
(insert last-command-event)
(icon-indent-line)
- (if icon-auto-newline
- (progn
- (newline)
- ;; (newline) may have done auto-fill
- (setq insertpos (- (point) 2))
- (icon-indent-line)))
+ (when icon-auto-newline
+ (newline)
+ ;; (newline) may have done auto-fill
+ (setq insertpos (- (point) 2))
+ (icon-indent-line))
(save-excursion
(if insertpos (goto-char (1+ insertpos)))
(delete-char -1))))
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index 25bc5ad881b..6d2d402e358 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -1,4 +1,4 @@
-;;; idlw-complete-structtag.el --- Completion of structure tags.
+;;; idlw-complete-structtag.el --- Completion of structure tags. -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -100,12 +100,11 @@
(defvar idlwave-sint-structtags nil)
;; Create the sintern type for structure talks
-(declare-function idlwave-sintern-structtag "idlw-complete-structtag" t t)
-(idlwave-new-sintern-type 'structtag)
+(idlwave-new-sintern-type structtag)
;; Hook the plugin into idlwave
-(add-to-list 'idlwave-complete-special 'idlwave-complete-structure-tag)
-(add-hook 'idlwave-update-rinfo-hook 'idlwave-structtag-reset)
+(add-hook 'idlwave-complete-functions #'idlwave-complete-structure-tag)
+(add-hook 'idlwave-update-rinfo-hook #'idlwave-structtag-reset)
;;; The main code follows below
(defvar idlwave-completion-help-info)
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 2e7b0aa7ef1..c53b9a4775c 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1,4 +1,4 @@
-;;; idlw-help.el --- HTML Help code for IDLWAVE
+;;; idlw-help.el --- HTML Help code for IDLWAVE -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
;;
@@ -50,7 +50,6 @@
(defcustom idlwave-html-help-pre-v6 nil
"Whether pre or post-v6.0 IDL help documents are being used."
- :group 'idlwave-online-help
:type 'boolean)
(defvar idlwave-html-link-sep
@@ -60,7 +59,6 @@
"The directory, relative to `idlwave-system-directory', where the IDL
HTML help files live, for IDL 6.2 and later. This location, if found,
is used in preference to the old `idlwave-html-help-location'."
- :group 'idlwave-online-help
:type 'directory)
(defcustom idlwave-html-help-location
@@ -69,7 +67,6 @@ is used in preference to the old `idlwave-html-help-location'."
"/usr/local/etc/")
"The directory where the idl_html_help/ dir lives. Obsolete for IDL
6.2 or later (see `idlwave-html-system-help-location')."
- :group 'idlwave-online-help
:type 'directory)
(defvar idlwave-help-use-hh nil
@@ -77,18 +74,15 @@ is used in preference to the old `idlwave-html-help-location'."
(defcustom idlwave-help-use-assistant t
"Whether to use the IDL Assistant as the help browser."
- :group 'idlwave-online-help
:type 'boolean)
(defcustom idlwave-help-browser-function browse-url-browser-function
"Function to use to display HTML help.
Defaults to `browse-url-browser-function', which see."
- :group 'idlwave-online-help
:type 'function)
(defcustom idlwave-help-browser-generic-program browse-url-generic-program
"Program to run if using `browse-url-generic-program'."
- :group 'idlwave-online-help
:type '(choice (const nil) string))
;; AFAICS, never used since it was introduced in 2004.
@@ -96,7 +90,6 @@ Defaults to `browse-url-browser-function', which see."
(if (boundp 'browse-url-generic-args)
browse-url-generic-args "")
"Program args to use if using `browse-url-generic-program'."
- :group 'idlwave-online-help
:type '(repeat string))
(defcustom idlwave-help-browser-is-local nil
@@ -106,7 +99,6 @@ external programs. If the browser name contains \"-w3\", it is
assumed to be local to Emacs. For other local browsers, this variable
must be explicitly set non-nil in order for the variable
`idlwave-help-use-dedicated-frame' to function."
- :group 'idlwave-online-help
:type 'boolean)
(defvar idlwave-help-directory ""
@@ -114,7 +106,6 @@ must be explicitly set non-nil in order for the variable
(defcustom idlwave-help-use-dedicated-frame t
"Non-nil means, use a separate frame for Online Help if possible."
- :group 'idlwave-online-help
:type 'boolean)
(defcustom idlwave-help-frame-parameters
@@ -123,14 +114,12 @@ must be explicitly set non-nil in order for the variable
See also `idlwave-help-use-dedicated-frame'.
If you do not set the frame width here, the value specified in
`idlw-help.el' will be used."
- :group 'idlwave-online-help
:type '(repeat
(cons symbol sexp)))
(defcustom idlwave-max-popup-menu-items 20
"Maximum number of items per pane in popup menus.
Currently only used for class selection during completion help."
- :group 'idlwave-online-help
:type 'integer)
(defcustom idlwave-extra-help-function 'idlwave-help-with-source
@@ -158,12 +147,10 @@ The default value for this function is `idlwave-help-with-source' which
loads the routine source file into the help buffer. If you try to write
a different function which accesses a special help file or so, it is
probably a good idea to still call this function as a fallback."
- :group 'idlwave-online-help
:type 'symbol)
(defcustom idlwave-help-fontify-source-code nil
"Non-nil means, fontify source code displayed as help like normal code."
- :group 'idlwave-online-help
:type 'boolean)
(defcustom idlwave-help-source-try-header t
@@ -173,7 +160,6 @@ help text. When this variable is non-nil, we try to find a description of
the help item in the first routine doclib header above the routine definition.
If the variable is nil, or if we cannot find/parse the header, the routine
definition is displayed instead."
- :group 'idlwave-online-help
:type 'boolean)
@@ -181,20 +167,17 @@ definition is displayed instead."
"A regexp for the heading word to search for in doclib headers
which specifies the `name' section. Can be used for localization
support."
- :group 'idlwave-online-help
:type 'regexp)
(defcustom idlwave-help-doclib-keyword "KEYWORD"
"A regexp for the heading word to search for in doclib headers
which specifies the `keywords' section. Can be used for localization
support."
- :group 'idlwave-online-help
:type 'regexp)
(defface idlwave-help-link
'((t :inherit link))
- "Face for highlighting links into IDLWAVE online help."
- :group 'idlwave-online-help)
+ "Face for highlighting links into IDLWAVE online help.")
(defvar idlwave-help-activate-links-aggressively nil
"Obsolete variable.")
@@ -219,20 +202,20 @@ support."
(defvar idlwave-help-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "q" 'idlwave-help-quit)
- (define-key map "w" 'widen)
+ (define-key map "q" #'idlwave-help-quit)
+ (define-key map "w" #'widen)
(define-key map "\C-m" (lambda (arg)
(interactive "p")
(scroll-up arg)))
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map [delete] 'scroll-down-command)
- (define-key map "h" 'idlwave-help-find-header)
- (define-key map "H" 'idlwave-help-find-first-header)
- (define-key map "." 'idlwave-help-toggle-header-match-and-def)
- (define-key map "F" 'idlwave-help-fontify)
- (define-key map "\M-?" 'idlwave-help-return-to-calling-frame)
- (define-key map "x" 'idlwave-help-return-to-calling-frame)
+ (define-key map " " #'scroll-up-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map [delete] #'scroll-down-command)
+ (define-key map "h" #'idlwave-help-find-header)
+ (define-key map "H" #'idlwave-help-find-first-header)
+ (define-key map "." #'idlwave-help-toggle-header-match-and-def)
+ (define-key map "F" #'idlwave-help-fontify)
+ (define-key map "\M-?" #'idlwave-help-return-to-calling-frame)
+ (define-key map "x" #'idlwave-help-return-to-calling-frame)
map)
"The keymap used in `idlwave-help-mode'.")
@@ -374,7 +357,7 @@ It collects and prints the diagnostics messages."
(setq idlwave-last-context-help-pos marker)
(idlwave-do-context-help1 arg)
(if idlwave-help-diagnostics
- (message "%s" (mapconcat 'identity
+ (message "%s" (mapconcat #'identity
(nreverse idlwave-help-diagnostics)
"; "))))))
@@ -384,6 +367,12 @@ It collects and prints the diagnostics messages."
(defvar idlwave-system-variables-alist)
(defvar idlwave-executive-commands-alist)
(defvar idlwave-system-class-info)
+(defvar idlwave-query-class)
+(defvar idlwave-force-class-query)
+(defvar idlw-help-name)
+(defvar idlw-help-kwd)
+(defvar idlw-help-link)
+
(defun idlwave-do-context-help1 (&optional arg)
"The work-horse version of `idlwave-context-help', which see."
(save-excursion
@@ -506,7 +495,7 @@ It collects and prints the diagnostics messages."
((and (memq cw '(function-keyword procedure-keyword))
(stringp this-word)
(string-match "\\S-" this-word)
- (not (string-match "!" this-word)))
+ (not (string-search "!" this-word)))
(cond ((or (= (char-before beg) ?/)
(save-excursion (goto-char end)
(looking-at "[ \t]*=")))
@@ -549,16 +538,16 @@ It collects and prints the diagnostics messages."
(setq mod1 (append (list t) module))))
(if mod3
(condition-case nil
- (apply 'idlwave-online-help mod1)
+ (apply #'idlwave-online-help mod1)
(error (condition-case nil
- (apply 'idlwave-online-help mod2)
- (error (apply 'idlwave-online-help mod3)))))
+ (apply #'idlwave-online-help mod2)
+ (error (apply #'idlwave-online-help mod3)))))
(if mod2
(condition-case nil
- (apply 'idlwave-online-help mod1)
- (error (apply 'idlwave-online-help mod2)))
+ (apply #'idlwave-online-help mod1)
+ (error (apply #'idlwave-online-help mod2)))
(if mod1
- (apply 'idlwave-online-help mod1)
+ (apply #'idlwave-online-help mod1)
(error "Don't know which item to show help for")))))))
(defun idlwave-do-mouse-completion-help (ev)
@@ -660,7 +649,7 @@ Those words in `idlwave-completion-help-links' have links. The
(props (list 'face 'idlwave-help-link))
(info idlwave-completion-help-info) ; global passed in
(what (nth 0 info)) ; what was completed, or a func
- (class (nth 3 info)) ; any class
+ ;; (class (nth 3 info)) ; any class
word beg end doit)
(goto-char (point-min))
(re-search-forward "possible completions are:" nil t)
@@ -685,7 +674,7 @@ Those words in `idlwave-completion-help-links' have links. The
;; Arrange for this function to be called after completion
(add-hook 'idlwave-completion-setup-hook
- 'idlwave-highlight-linked-completions)
+ #'idlwave-highlight-linked-completions)
(defvar idlwave-help-return-frame nil
"The frame to return to from the help frame.")
@@ -947,7 +936,7 @@ This function can be used as `idlwave-extra-help-function'."
(point)))
-(defun idlwave-help-find-routine-definition (name type class keyword)
+(defun idlwave-help-find-routine-definition (name type class _keyword)
"Find the definition of routine CLASS::NAME in current buffer.
Returns the point of match if successful, nil otherwise.
KEYWORD is ignored."
@@ -967,7 +956,7 @@ KEYWORD is ignored."
(defvar idlwave-doclib-start)
(defvar idlwave-doclib-end)
-(defun idlwave-help-find-in-doc-header (name type class keyword
+(defun idlwave-help-find-in-doc-header (name _type class keyword
&optional exact)
"Find the requested help in the doc-header above point.
@@ -1025,9 +1014,9 @@ If there is a match, we assume it is the keyword description."
":[ \t]*$\\)"))
;; Header start plus name
- (header-re (concat "\\(" idlwave-doclib-start "\\).*\n"
- "\\(^;+.*\n\\)*"
- "\\(" name-re "\\)"))
+ ;; (header-re (concat "\\(" idlwave-doclib-start "\\).*\n"
+ ;; "\\(^;+.*\n\\)*"
+ ;; "\\(" name-re "\\)"))
;; A keywords section
(kwds-re (concat ; forgiving
"^;+\\*?[ \t]*"
@@ -1095,8 +1084,8 @@ When DING is non-nil, ring the bell as well."
(cons string idlwave-help-diagnostics))
(if ding (ding)))))
-(defun idlwave-help-toggle-header-top-and-def (arg)
- (interactive "P")
+(defun idlwave-help-toggle-header-top-and-def (&optional _arg)
+ (interactive)
(let (pos)
(if idlwave-help-in-header
;; Header was the last thing displayed
@@ -1119,8 +1108,8 @@ When DING is non-nil, ring the bell as well."
(goto-char pos)
(recenter 0)))))
-(defun idlwave-help-find-first-header (arg)
- (interactive "P")
+(defun idlwave-help-find-first-header (&optional _arg)
+ (interactive)
(let (pos)
(save-excursion
(goto-char (point-min))
@@ -1140,8 +1129,8 @@ When DING is non-nil, ring the bell as well."
(setq idlwave-help-in-header nil)
(idlwave-help-toggle-header-match-and-def arg 'top)))
-(defun idlwave-help-toggle-header-match-and-def (arg &optional top)
- (interactive "P")
+(defun idlwave-help-toggle-header-match-and-def (&optional _arg top)
+ (interactive)
(let ((args idlwave-help-args)
pos)
(if idlwave-help-in-header
@@ -1150,7 +1139,7 @@ When DING is non-nil, ring the bell as well."
(setq idlwave-help-in-header nil)
(setq pos idlwave-help-def-pos))
;; Try to display header
- (setq pos (apply 'idlwave-help-find-in-doc-header
+ (setq pos (apply #'idlwave-help-find-in-doc-header
(if top
(list (car args) (nth 1 args) (nth 2 args) nil)
args)))
@@ -1184,7 +1173,7 @@ Useful when source code is displayed as help. See the option
(with-no-warnings (font-lock-fontify-buffer))))))
-(defun idlwave-help-error (name type class keyword)
+(defun idlwave-help-error (name _type class keyword)
(error "Can't find help on %s%s %s"
(or (and (or class name) (idlwave-make-full-name class name))
"<unknown>")
@@ -1272,11 +1261,11 @@ IDL assistant.")
(delete-process idlwave-help-assistant-socket))
(setq idlwave-help-assistant-process
- (apply 'start-process
+ (apply #'start-process
"IDL_ASSISTANT_PROC" nil command "-server" extra-args))
(set-process-filter idlwave-help-assistant-process
- (lambda (proc string)
+ (lambda (_proc string)
(setq port (string-to-number string))))
(unless (accept-process-output idlwave-help-assistant-process 15)
(error "Failed binding IDL_ASSISTANT socket"))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 4bc52247d86..eb88f25dfd6 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -1,4 +1,4 @@
-;; idlw-shell.el --- run IDL as an inferior process of Emacs. -*- lexical-binding:t -*-
+;;; idlw-shell.el --- run IDL as an inferior process of Emacs. -*- lexical-binding:t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -729,7 +729,7 @@ IDL is currently stopped.")
(defconst idlwave-shell-halt-messages-re
- (mapconcat 'identity idlwave-shell-halt-messages "\\|")
+ (mapconcat #'identity idlwave-shell-halt-messages "\\|")
"The regular expression computed from `idlwave-shell-halt-messages'.")
(defconst idlwave-shell-trace-message-re
@@ -934,8 +934,8 @@ IDL has currently stepped.")
"[ \t\n]*\\'"))
(when idlwave-shell-query-for-class
- (add-to-list (make-local-variable 'idlwave-determine-class-special)
- 'idlwave-shell-get-object-class)
+ (add-hook 'idlwave-determine-class-functions
+ #'idlwave-shell-get-object-class nil t)
(setq idlwave-store-inquired-class t))
;; Make sure comint-last-input-end does not go to beginning of
@@ -950,10 +950,10 @@ IDL has currently stepped.")
(setq idlwave-shell-default-directory default-directory)
(setq idlwave-shell-hide-output nil)
- (add-hook 'kill-buffer-hook 'idlwave-shell-kill-shell-buffer-confirm
+ (add-hook 'kill-buffer-hook #'idlwave-shell-kill-shell-buffer-confirm
nil 'local)
- (add-hook 'kill-buffer-hook 'idlwave-shell-delete-temp-files nil 'local)
- (add-hook 'kill-emacs-hook 'idlwave-shell-delete-temp-files)
+ (add-hook 'kill-buffer-hook #'idlwave-shell-delete-temp-files nil 'local)
+ (add-hook 'kill-emacs-hook #'idlwave-shell-delete-temp-files)
;; Set the optional comint variables
(when idlwave-shell-comint-settings
@@ -962,12 +962,12 @@ IDL has currently stepped.")
(set (make-local-variable (car entry)) (cdr entry)))))
- (unless (memq 'comint-carriage-motion
+ (unless (memq #'comint-carriage-motion
(default-value 'comint-output-filter-functions))
;; Strip those pesky ctrl-m's.
(add-hook 'comint-output-filter-functions
(lambda (string)
- (when (string-match "\r" string)
+ (when (string-search "\r" string)
(let ((pmark (process-mark (get-buffer-process
(current-buffer)))))
(save-excursion
@@ -976,18 +976,21 @@ IDL has currently stepped.")
(while (search-forward "\r" pmark t)
(delete-region (point) (line-beginning-position)))))))
'append 'local)
- (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m nil 'local))
+ (add-hook 'comint-output-filter-functions #'comint-strip-ctrl-m nil 'local))
;; Python-mode, bundled with many Emacs installs, quite cavalierly
;; adds this function to the global default hook. It interferes
;; with overlay-arrows.
- (remove-hook 'comint-output-filter-functions 'py-pdbtrack-track-stack-file)
+ ;; FIXME: We should fix this interference rather than globally turn it off.
+ (when (fboundp 'py-pdbtrack-track-stack-file)
+ (remove-hook 'comint-output-filter-functions
+ #'py-pdbtrack-track-stack-file))
;; IDLWAVE syntax, and turn on abbreviations
(set (make-local-variable 'comment-start) ";")
(setq abbrev-mode t)
- (add-hook 'post-command-hook 'idlwave-command-hook nil t)
+ (add-hook 'post-command-hook #'idlwave-command-hook nil t)
;; Read the command history?
(when (and idlwave-shell-save-command-history
@@ -1045,7 +1048,7 @@ IDL has currently stepped.")
(setq idlwave-path-alist old-path-alist))))
(if (not (fboundp 'idl-shell))
- (fset 'idl-shell 'idlwave-shell))
+ (defalias 'idl-shell #'idlwave-shell))
(defvar idlwave-shell-idl-wframe nil
"Frame for displaying the IDL shell window.")
@@ -1120,7 +1123,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
(and idlwave-shell-use-dedicated-frame
(setq idlwave-shell-idl-wframe (selected-frame)))
(add-hook 'idlwave-shell-sentinel-hook
- 'save-buffers-kill-emacs t))
+ #'save-buffers-kill-emacs t))
;; A non-nil arg means, we want a dedicated frame. This will last
;; for the current editing session.
@@ -1130,7 +1133,7 @@ See also the variable `idlwave-shell-prompt-pattern'.
;; Check if the process still exists. If not, create it.
(unless (comint-check-proc (idlwave-shell-buffer))
(let* ((prg (or idlwave-shell-explicit-file-name "idl"))
- (buf (apply 'make-comint
+ (buf (apply #'make-comint
idlwave-shell-process-name prg nil
(if (stringp idlwave-shell-command-line-options)
(idlwave-split-string
@@ -1138,8 +1141,8 @@ See also the variable `idlwave-shell-prompt-pattern'.
idlwave-shell-command-line-options)))
(process (get-buffer-process buf)))
(setq idlwave-idlwave_routine_info-compiled nil)
- (set-process-filter process 'idlwave-shell-filter)
- (set-process-sentinel process 'idlwave-shell-sentinel)
+ (set-process-filter process #'idlwave-shell-filter)
+ (set-process-sentinel process #'idlwave-shell-sentinel)
(set-buffer buf)
(idlwave-shell-mode)))
(let ((window (idlwave-display-buffer (idlwave-shell-buffer) nil
@@ -1315,10 +1318,7 @@ See also the variable `idlwave-shell-input-mode-spells'."
(setq idlwave-shell-char-mode-active 'exit))
((string-match (nth 1 idlwave-shell-input-mode-spells) string)
;; Set a timer which will soon start the character loop
- (if (fboundp 'start-itimer)
- (start-itimer "IDLWAVE Char Mode" 'idlwave-shell-char-mode-loop 0.5
- nil nil t 'no-error)
- (run-at-time 0.5 nil 'idlwave-shell-char-mode-loop 'no-error)))))
+ (run-at-time 0.5 nil #'idlwave-shell-char-mode-loop 'no-error))))
(defvar keyboard-quit)
(defun idlwave-shell-char-mode-loop (&optional no-error)
@@ -1396,7 +1396,7 @@ Otherwise just move the line. Move down unless UP is non-nil."
(idlwave-shell-move-or-history nil arg))
(define-obsolete-function-alias 'idlwave-shell-comint-filter
- 'comint-output-filter "25.1")
+ #'comint-output-filter "25.1")
(defun idlwave-shell-is-running ()
"Return t if the shell process is running."
@@ -1409,7 +1409,7 @@ Remove everything to the first newline, and all lines with % in front
of them, with optional follow-on lines starting with two spaces. This
works well enough, since any print output typically arrives before
error messages, etc."
- (setq output (substring output (string-match "\n" output)))
+ (setq output (substring output (string-search "\n" output)))
(while (string-match "\\(\n\\|\\`\\)%.*\\(\n .*\\)*" output)
(setq output (replace-match "" nil t output)))
(unless
@@ -1431,12 +1431,12 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(unwind-protect
(progn
;; Ring the bell if necessary
- (while (setq p (string-match "\C-G" string))
+ (while (setq p (string-search "\C-G" string))
(ding)
(aset string p ?\C-j ))
(if idlwave-shell-hide-output
(save-excursion
- (while (setq p (string-match "\C-M" string))
+ (while (setq p (string-search "\C-M" string))
(aset string p ?\ ))
(set-buffer
(get-buffer-create idlwave-shell-hidden-output-buffer))
@@ -1445,7 +1445,7 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(comint-output-filter proc string))
;; Watch for magic - need to accumulate the current line
;; since it may not be sent all at once.
- (if (string-match "\n" string)
+ (if (string-search "\n" string)
(progn
(if idlwave-shell-use-input-mode-magic
(idlwave-shell-input-mode-magic
@@ -1510,13 +1510,12 @@ and then calls `idlwave-shell-send-command' for any pending commands."
proc filtered))))))
;; Call the post-command hook
- (if (listp idlwave-shell-post-command-hook)
- (progn
- ;;(message "Calling list")
- ;;(prin1 idlwave-shell-post-command-hook)
- (eval idlwave-shell-post-command-hook))
- ;;(message "Calling command function")
- (funcall idlwave-shell-post-command-hook))
+ (if (functionp idlwave-shell-post-command-hook)
+ ;;(message "Calling command function")
+ (funcall idlwave-shell-post-command-hook)
+ ;;(message "Calling list")
+ ;;(prin1 idlwave-shell-post-command-hook)
+ (eval idlwave-shell-post-command-hook t))
;; Reset to default state for next command.
;; Also we do not want to find this prompt again.
@@ -1690,7 +1689,7 @@ the above."
(if bp
(let ((cmd (idlwave-shell-bp-get bp 'cmd)))
(if cmd ;; Execute any breakpoint command
- (if (listp cmd) (eval cmd) (funcall cmd))))
+ (if (functionp cmd) (funcall cmd) (eval cmd t))))
;; A breakpoint that we did not know about - perhaps it was
;; set by the user... Let's update our list.
(idlwave-shell-bp-query)))
@@ -1819,7 +1818,7 @@ The size is given by `idlwave-shell-graphics-window-size'."
(interactive "P")
(let ((n (if n (prefix-numeric-value n) 0)))
(idlwave-shell-send-command
- (apply 'format "window,%d,xs=%d,ys=%d"
+ (apply #'format "window,%d,xs=%d,ys=%d"
n idlwave-shell-graphics-window-size)
nil (idlwave-shell-hide-p 'misc) nil t)))
@@ -1891,7 +1890,7 @@ HEAP_GC, /VERBOSE"
(while (string-match "^PATH:[ \t]*<\\(.*\\)>[ \t]*\n" path-string start)
(push (match-string 1 path-string) dirs)
(setq start (match-end 0)))
- (setq dirs (mapcar 'file-name-as-directory dirs))
+ (setq dirs (mapcar #'file-name-as-directory dirs))
(if (string-match "^SYSDIR:[ \t]*<\\(.*\\)>[ \t]*\n" path-string)
(setq sysdir (file-name-as-directory
(match-string 1 path-string))))
@@ -1938,13 +1937,14 @@ HEAP_GC, /VERBOSE"
key (nth 4 specs)
keys (if (and (stringp key)
(not (string-match "\\` *\\'" key)))
- (mapcar 'list
+ (mapcar #'list
(delete "" (idlwave-split-string key " +")))))
(setq name (idlwave-sintern-routine-or-method name class t)
class (idlwave-sintern-class class t)
file (if (equal file "") nil file)
keys (mapcar (lambda (x)
- (list (idlwave-sintern-keyword (car x) t))) keys))
+ (list (idlwave-sintern-keyword (car x) t)))
+ keys))
;; In the following ignore routines already defined in buffers,
;; assuming that if the buffer stuff differs, it is a "new"
@@ -2053,7 +2053,7 @@ Change the default directory for the process buffer to concur."
(match-string 1 idlwave-shell-command-output)))))
(defvar idlwave-sint-sysvars nil)
-(idlwave-new-sintern-type 'execcomm)
+(idlwave-new-sintern-type execcomm)
(defun idlwave-shell-complete (&optional arg)
"Do completion in the idlwave-shell buffer.
@@ -2180,7 +2180,7 @@ overlays."
(defun idlwave-shell-parse-stack-and-display ()
(let* ((lines (delete "" (idlwave-split-string
idlwave-shell-command-output "^%")))
- (stack (delq nil (mapcar 'idlwave-shell-parse-line lines)))
+ (stack (delq nil (mapcar #'idlwave-shell-parse-line lines)))
(nmax (1- (length stack)))
(nmin 0) message)
(cond
@@ -2710,45 +2710,34 @@ Runs to the last statement and then steps 1 statement. Use the .out command."
(interactive "P")
(idlwave-shell-print arg 'help))
-(defmacro idlwave-shell-mouse-examine (help &optional ev)
- "Create a function for generic examination of expressions."
- `(lambda (event)
- "Expansion function for expression examination."
- (interactive "e")
- (let* ((drag-track (fboundp 'mouse-drag-track))
- (transient-mark-mode t)
- (tracker
- ;; Emacs 22 no longer completes the drag with
- ;; mouse-drag-region, without an additional
- ;; event. mouse-drag-track does so.
- (if drag-track 'mouse-drag-track 'mouse-drag-region)))
- (funcall tracker event)
- (idlwave-shell-print (if (region-active-p) '(4) nil)
- ,help ,ev))))
-
-;; Begin terrible hack section -- XEmacs tests for button2 explicitly
-;; on drag events, calling drag-n-drop code if detected. Ughhh...
-(defun idlwave-default-mouse-track-event-is-with-button (_event _n)
- (declare (obsolete nil "28.1"))
- t)
-
-(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track 'ignore "27.1")
+(defun idlwave-shell--mouse-examine (event help &optional ev)
+ "Expansion function for expression examination."
+ (let* ((transient-mark-mode t))
+ (mouse-drag-track event)
+ (idlwave-shell-print (if (region-active-p) '(4) nil)
+ help ev)))
+
+(define-obsolete-function-alias
+ 'idlwave-default-mouse-track-event-is-with-button #'always "28.1")
+
+(define-obsolete-function-alias 'idlwave-xemacs-hack-mouse-track
+ #'ignore "27.1")
;;; End terrible hack section
(defun idlwave-shell-mouse-print (event)
"Print value of variable at the mouse position, with `print'."
(interactive "e")
- (funcall (idlwave-shell-mouse-examine nil) event))
+ (idlwave-shell--mouse-examine event nil))
(defun idlwave-shell-mouse-help (event)
"Print value of variable at the mouse position, with `help'."
(interactive "e")
- (funcall (idlwave-shell-mouse-examine 'help) event))
+ (idlwave-shell--mouse-examine event 'help))
(defun idlwave-shell-examine-select (event)
"Pop-up a list to select from for examining the expression."
(interactive "e")
- (funcall (idlwave-shell-mouse-examine nil event) event))
+ (idlwave-shell--mouse-examine event nil event))
(defmacro idlwave-shell-examine (help)
"Create a function for key-driven expression examination."
@@ -2814,7 +2803,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
(setq beg (region-beginning)
end (region-end)))
(t
- (idlwave-with-special-syntax
+ (with-syntax-table idlwave-find-symbol-syntax-table
;; Move to beginning of current or previous expression
(if (looking-at "\\<\\|(")
;; At beginning of expression, don't move backwards unless
@@ -2847,9 +2836,9 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
(move-overlay idlwave-shell-expression-overlay beg end
(current-buffer))
(add-hook 'pre-command-hook
- 'idlwave-shell-delete-expression-overlay))
+ #'idlwave-shell-delete-expression-overlay))
(add-hook 'pre-command-hook
- 'idlwave-shell-delete-output-overlay)
+ #'idlwave-shell-delete-output-overlay)
;; Remove empty or comment-only lines
(while (string-match "\n[ \t]*\\(;.*\\)?\r*\n" expr)
@@ -2881,7 +2870,7 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
;; "Print")
(idlwave-popup-select
ev
- (mapcar 'car idlwave-shell-examine-alist)
+ (mapcar #'car idlwave-shell-examine-alist)
"Examine with"))
idlwave-shell-examine-alist))))
(setq help (cdr help-cons))
@@ -2916,9 +2905,8 @@ from `idlwave-shell-examine-alist' via mini-buffer shortcut key."
"Variable to hold the win/height pairs for all *Examine* windows.")
(defvar idlwave-shell-examine-map (make-sparse-keymap))
-(define-key idlwave-shell-examine-map "q" 'idlwave-shell-examine-display-quit)
-(define-key idlwave-shell-examine-map "c" 'idlwave-shell-examine-display-clear)
-
+(define-key idlwave-shell-examine-map "q" #'idlwave-shell-examine-display-quit)
+(define-key idlwave-shell-examine-map "c" #'idlwave-shell-examine-display-clear)
(defun idlwave-shell-check-compiled-and-display ()
"Check examine output for warning about undefined procedure/function."
@@ -3347,9 +3335,10 @@ the breakpoint overlays."
count nil condition disabled))))))
(setq idlwave-shell-bp-alist (cdr idlwave-shell-bp-alist))
;; Update breakpoint data
- (if (eq bp-re bp-re54)
- (mapc 'idlwave-shell-update-bp old-bp-alist)
- (mapc 'idlwave-shell-update-bp-command-only old-bp-alist))))
+ (mapc (if (eq bp-re bp-re54)
+ #'idlwave-shell-update-bp
+ #'idlwave-shell-update-bp-command-only)
+ old-bp-alist)))
;; Update the breakpoint overlays
(unless no-show (idlwave-shell-update-bp-overlays))
;; Return the new list
@@ -3484,7 +3473,7 @@ The actual line number for a breakpoint in IDL may be different from
the line number used with the IDL breakpoint command.
Looks for a new breakpoint index number in the list. This is
considered the new breakpoint if the file name of frame matches."
- (let ((obp-index (mapcar 'idlwave-shell-bp-get idlwave-shell-old-bp))
+ (let ((obp-index (mapcar #'idlwave-shell-bp-get idlwave-shell-old-bp))
(bpl idlwave-shell-bp-alist))
(while (and (member (idlwave-shell-bp-get (car bpl)) obp-index)
(setq bpl (cdr bpl))))
@@ -3510,7 +3499,7 @@ considered the new breakpoint if the file name of frame matches."
(defvar idlwave-shell-debug-line-map (make-sparse-keymap))
(define-key idlwave-shell-debug-line-map [mouse-3]
- 'idlwave-shell-mouse-active-bp)
+ #'idlwave-shell-mouse-active-bp)
(defun idlwave-shell-update-bp-overlays ()
"Update the overlays which mark breakpoints in the source code.
@@ -3532,7 +3521,7 @@ Existing overlays are recycled, in order to minimize consumption."
(setq ov-alist idlwave-shell-bp-overlays
idlwave-shell-bp-overlays
(if idlwave-shell-bp-glyph
- (mapcar 'list (mapcar 'car idlwave-shell-bp-glyph))
+ (mapcar #'list (mapcar #'car idlwave-shell-bp-glyph))
(list (list 'bp))))
(while (setq bp (pop bp-list))
(save-excursion
@@ -3568,7 +3557,7 @@ Existing overlays are recycled, in order to minimize consumption."
(if help-list
(concat
" - "
- (mapconcat 'identity help-list ", ")))
+ (mapconcat #'identity help-list ", ")))
(if (and (not count) (not condition))
" (use mouse-3 for breakpoint actions)")))
(full-type (if disabled
@@ -3962,73 +3951,73 @@ Otherwise, just expand the file name."
;;(define-key map "\M-?" 'comint-dynamic-list-completions)
;;(define-key map "\t" 'comint-dynamic-complete)
- (define-key map "\C-w" 'comint-kill-region)
- (define-key map "\t" 'idlwave-shell-complete)
- (define-key map "\M-\t" 'idlwave-shell-complete)
- (define-key map "\C-c\C-s" 'idlwave-shell)
- (define-key map "\C-c?" 'idlwave-routine-info)
- (define-key map "\C-g" 'idlwave-keyboard-quit)
- (define-key map "\M-?" 'idlwave-context-help)
+ (define-key map "\C-w" #'comint-kill-region)
+ (define-key map "\t" #'idlwave-shell-complete)
+ (define-key map "\M-\t" #'idlwave-shell-complete)
+ (define-key map "\C-c\C-s" #'idlwave-shell)
+ (define-key map "\C-c?" #'idlwave-routine-info)
+ (define-key map "\C-g" #'idlwave-keyboard-quit)
+ (define-key map "\M-?" #'idlwave-context-help)
(define-key map [(control meta ?\?)]
- 'idlwave-help-assistant-help-with-topic)
- (define-key map "\C-c\C-i" 'idlwave-update-routine-info)
- (define-key map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
- (define-key map "\C-c\C-x" 'idlwave-shell-send-char)
- (define-key map "\C-c=" 'idlwave-resolve)
- (define-key map "\C-c\C-v" 'idlwave-find-module)
- (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
+ #'idlwave-help-assistant-help-with-topic)
+ (define-key map "\C-c\C-i" #'idlwave-update-routine-info)
+ (define-key map "\C-c\C-y" #'idlwave-shell-char-mode-loop)
+ (define-key map "\C-c\C-x" #'idlwave-shell-send-char)
+ (define-key map "\C-c=" #'idlwave-resolve)
+ (define-key map "\C-c\C-v" #'idlwave-find-module)
+ (define-key map "\C-c\C-k" #'idlwave-kill-autoloaded-buffers)
(define-key map idlwave-shell-prefix-key
- 'idlwave-shell-debug-map)
- (define-key map [(up)] 'idlwave-shell-up-or-history)
- (define-key map [(down)] 'idlwave-shell-down-or-history)
+ #'idlwave-shell-debug-map)
+ (define-key map [(up)] #'idlwave-shell-up-or-history)
+ (define-key map [(down)] #'idlwave-shell-down-or-history)
(define-key idlwave-shell-mode-map [(shift mouse-3)]
- 'idlwave-mouse-context-help)
+ #'idlwave-mouse-context-help)
map)
"Keymap for `idlwave-mode'.")
(defvar idlwave-shell-electric-debug-mode-map
(let ((map (make-sparse-keymap)))
;; A few extras in the electric debug map
- (define-key map " " 'idlwave-shell-step)
- (define-key map "+" 'idlwave-shell-stack-up)
- (define-key map "=" 'idlwave-shell-stack-up)
- (define-key map "-" 'idlwave-shell-stack-down)
- (define-key map "_" 'idlwave-shell-stack-down)
+ (define-key map " " #'idlwave-shell-step)
+ (define-key map "+" #'idlwave-shell-stack-up)
+ (define-key map "=" #'idlwave-shell-stack-up)
+ (define-key map "-" #'idlwave-shell-stack-down)
+ (define-key map "_" #'idlwave-shell-stack-down)
(define-key map "e" (lambda () (interactive) (idlwave-shell-print '(16))))
- (define-key map "q" 'idlwave-shell-retall)
+ (define-key map "q" #'idlwave-shell-retall)
(define-key map "t"
(lambda () (interactive) (idlwave-shell-send-command "help,/TRACE")))
- (define-key map [(control ??)] 'idlwave-shell-electric-debug-help)
+ (define-key map [(control ??)] #'idlwave-shell-electric-debug-help)
(define-key map "x"
(lambda (arg) (interactive "P")
(idlwave-shell-print arg nil nil t)))
map))
(defvar idlwave-shell-mode-prefix-map (make-sparse-keymap))
-(fset 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)
+(defalias 'idlwave-shell-mode-prefix-map idlwave-shell-mode-prefix-map)
(defvar idlwave-mode-prefix-map (make-sparse-keymap))
-(fset 'idlwave-mode-prefix-map idlwave-mode-prefix-map)
+(defalias 'idlwave-mode-prefix-map idlwave-mode-prefix-map)
(defun idlwave-shell-define-key-both (key hook)
"Define a key in both the shell and buffer mode maps."
(define-key idlwave-mode-map key hook)
(define-key idlwave-shell-mode-map key hook))
-(define-key idlwave-mode-map "\C-c\C-y" 'idlwave-shell-char-mode-loop)
-(define-key idlwave-mode-map "\C-c\C-x" 'idlwave-shell-send-char)
+(define-key idlwave-mode-map "\C-c\C-y" #'idlwave-shell-char-mode-loop)
+(define-key idlwave-mode-map "\C-c\C-x" #'idlwave-shell-send-char)
;; The mouse bindings for PRINT and HELP
(idlwave-shell-define-key-both [(shift down-mouse-2)]
- 'idlwave-shell-mouse-print)
+ #'idlwave-shell-mouse-print)
(idlwave-shell-define-key-both [(control meta down-mouse-2)]
- 'idlwave-shell-mouse-help)
+ #'idlwave-shell-mouse-help)
(idlwave-shell-define-key-both [(control shift down-mouse-2)]
- 'idlwave-shell-examine-select)
+ #'idlwave-shell-examine-select)
;; We need to turn off the button release events.
-(idlwave-shell-define-key-both [(shift mouse-2)] 'ignore)
-(idlwave-shell-define-key-both [(shift control mouse-2)] 'ignore)
-(idlwave-shell-define-key-both [(control meta mouse-2)] 'ignore)
+(idlwave-shell-define-key-both [(shift mouse-2)] #'ignore)
+(idlwave-shell-define-key-both [(shift control mouse-2)] #'ignore)
+(idlwave-shell-define-key-both [(control meta mouse-2)] #'ignore)
;; The following set of bindings is used to bind the debugging keys.
@@ -4109,8 +4098,8 @@ Otherwise, just expand the file name."
cmd))))
; Enter the prefix map in two places.
-(fset 'idlwave-debug-map idlwave-mode-prefix-map)
-(fset 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)
+(defalias 'idlwave-debug-map idlwave-mode-prefix-map)
+(defalias 'idlwave-shell-debug-map idlwave-shell-mode-prefix-map)
;; The Electric Debug Minor Mode --------------------------------------------
@@ -4496,6 +4485,6 @@ static char * file[] = {
(idlwave-toolbar-toggle))
(if idlwave-shell-use-toolbar
- (add-hook 'idlwave-shell-mode-hook 'idlwave-toolbar-add-everywhere))
+ (add-hook 'idlwave-shell-mode-hook #'idlwave-toolbar-add-everywhere))
;;; idlw-shell.el ends here
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 4bd0afb2ba1..d3f47fcf45e 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -1,4 +1,4 @@
-;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE
+;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -24,8 +24,8 @@
;;; Commentary:
-;; This file implements a debugging toolbar for IDLWAVE. It requires
-;; Emacs or XEmacs with toolbar and xpm support.
+;; This file implements a debugging toolbar for IDLWAVE.
+;; It requires toolbar and xpm support.
;; New versions of IDLWAVE, documentation, and more information
;; available from:
@@ -35,22 +35,16 @@
;;; Code:
(defun idlwave-toolbar-make-button (image)
- (if (featurep 'xemacs)
- (toolbar-make-button-list image)
- (list 'image :type 'xpm :data image)))
+ (list 'image :type 'xpm :data image))
(defvar idlwave-toolbar)
(defvar default-toolbar)
(defvar idlwave-toolbar-is-possible)
-(if (not (or (and (featurep 'xemacs) ; This is XEmacs
- (featurep 'xpm) ; need xpm
- (featurep 'toolbar)) ; ... and the toolbar
- (and (not (featurep 'xemacs)) ; This is Emacs
- (boundp 'tool-bar-button-margin) ; need toolbar
- (fboundp 'image-type-available-p) ; need image stuff
- (image-type-available-p 'xpm)) ; need xpm
- ))
+(if (not (and (boundp 'tool-bar-button-margin) ; need toolbar
+ (fboundp 'image-type-available-p) ; need image stuff
+ (image-type-available-p 'xpm)) ; need xpm
+ )
;; oops - cannot do the toolbar
(message "Sorry, IDLWAVE xpm toolbar cannot be used on this version of Emacs")
;; OK, we can define a toolbar
@@ -873,23 +867,12 @@ static char * file[] = {
;; When the shell exits, arrange to remove the special toolbar everywhere.
(add-hook 'idlwave-shell-cleanup-hook
- 'idlwave-toolbar-remove-everywhere)
+ #'idlwave-toolbar-remove-everywhere)
);; End can define toolbar
-(defun idlwave-toolbar-add ()
- "Add the IDLWAVE toolbar if appropriate."
- (if (and (featurep 'xemacs) ; This is a noop on Emacs
- (boundp 'idlwave-toolbar-is-possible)
- (derived-mode-p 'idlwave-mode 'idlwave-shell-mode))
- (set-specifier default-toolbar (cons (current-buffer)
- idlwave-toolbar))))
-
-(defun idlwave-toolbar-remove ()
- "Add the IDLWAVE toolbar if appropriate."
- (if (and (featurep 'xemacs) ; This is a noop on Emacs
- (boundp 'idlwave-toolbar-is-possible)
- (derived-mode-p 'idlwave-mode 'idlwave-shell-mode))
- (remove-specifier default-toolbar (current-buffer))))
+(define-obsolete-function-alias 'idlwave-toolbar-add #'ignore "28.1")
+
+(define-obsolete-function-alias 'idlwave-toolbar-remove #'ignore "28.1")
(defvar idlwave-shell-mode-map)
(defvar idlwave-mode-map)
@@ -898,57 +881,40 @@ static char * file[] = {
"Add the toolbar in all appropriate buffers."
(when (boundp 'idlwave-toolbar-is-possible)
- ;; First make sure new buffers will get the toolbar
- (add-hook 'idlwave-mode-hook 'idlwave-toolbar-add)
;; Then add it to all existing buffers
- (if (featurep 'xemacs)
- ;; For XEmacs, map over all buffers to add toolbar
- (save-excursion
- (mapcar (lambda (buf)
- (set-buffer buf)
- (idlwave-toolbar-add))
- (buffer-list)))
- ;; For Emacs, add the key definitions to the mode maps
- (mapc (lambda (x)
- (let* ((icon (aref x 0))
- (func (aref x 1))
- (show (aref x 2))
- (help (aref x 3))
- (key (vector 'tool-bar func))
- (def (list 'menu-item
- ""
- func
- :image (symbol-value icon)
- :visible show
- :help help)))
- (define-key idlwave-mode-map key def)
- (define-key idlwave-shell-mode-map key def)))
- (reverse idlwave-toolbar)))
+ ;; For Emacs, add the key definitions to the mode maps
+ (mapc (lambda (x)
+ (let* ((icon (aref x 0))
+ (func (aref x 1))
+ (show (aref x 2))
+ (help (aref x 3))
+ (key (vector 'tool-bar func))
+ (def (list 'menu-item
+ ""
+ func
+ :image (symbol-value icon)
+ :visible show
+ :help help)))
+ (define-key idlwave-mode-map key def)
+ (define-key idlwave-shell-mode-map key def)))
+ (reverse idlwave-toolbar))
(setq idlwave-toolbar-visible t)))
(defun idlwave-toolbar-remove-everywhere ()
"Remove the toolbar in all appropriate buffers."
;; First make sure new buffers won't get the toolbar
(when idlwave-toolbar-is-possible
- (remove-hook 'idlwave-mode-hook 'idlwave-toolbar-add)
;; Then remove it in all existing buffers.
- (if (featurep 'xemacs)
- ;; For XEmacs, map over all buffers to remove toolbar
- (save-excursion
- (mapcar (lambda (buf)
- (set-buffer buf)
- (idlwave-toolbar-remove))
- (buffer-list)))
- ;; For Emacs, remove the key definitions from the mode maps
- (mapc (lambda (x)
- (let* (;;(icon (aref x 0))
- (func (aref x 1))
- ;;(show (aref x 2))
- ;;(help (aref x 3))
- (key (vector 'tool-bar func)))
- (define-key idlwave-mode-map key nil)
- (define-key idlwave-shell-mode-map key nil)))
- idlwave-toolbar))
+ ;; For Emacs, remove the key definitions from the mode maps
+ (mapc (lambda (x)
+ (let* (;;(icon (aref x 0))
+ (func (aref x 1))
+ ;;(show (aref x 2))
+ ;;(help (aref x 3))
+ (key (vector 'tool-bar func)))
+ (define-key idlwave-mode-map key nil)
+ (define-key idlwave-shell-mode-map key nil)))
+ idlwave-toolbar)
(setq idlwave-toolbar-visible nil)))
(defun idlwave-toolbar-toggle (&optional force-on)
@@ -956,11 +922,8 @@ static char * file[] = {
(if idlwave-toolbar-visible
(or force-on (idlwave-toolbar-remove-everywhere))
(idlwave-toolbar-add-everywhere))
- ;; Now make sure this
- (if (featurep 'xemacs)
- nil ; no action necessary, toolbar gets updated automatically
- ;; On Emacs, redraw the frame to make sure the Toolbar is updated.
- (redraw-frame)))
+ ;; On Emacs, redraw the frame to make sure the Toolbar is updated.
+ (redraw-frame))
(provide 'idlw-toolbar)
(provide 'idlwave-toolbar)
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index e8e55ae96d1..55e712dd77d 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1,4 +1,4 @@
-;; idlwave.el --- IDL editing mode for GNU Emacs
+;;; idlwave.el --- IDL editing mode for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -781,7 +781,7 @@ definitions, use the command `list-abbrevs', for abbrevs that move
point. Moving point is useful, for example, to place point between
parentheses of expanded functions.
-See `idlwave-check-abbrev'."
+See `idlwave-modify-abbrev'."
:group 'idlwave-abbrev-and-indent-action
:type 'boolean)
@@ -819,18 +819,19 @@ Has effect only if in abbrev-mode."
;; Example actions:
;;
;; Capitalize system vars
-;; (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)
+;; (idlwave-action-and-binding idlwave-sysvar
+;; (lambda (_) (capitalize-word 1)) t)
;;
;; Capitalize procedure name
;; (idlwave-action-and-binding "\\<\\(pro\\|function\\)\\>[ \t]*\\<"
-;; '(capitalize-word 1) t)
+;; (lambda (_) (capitalize-word 1)) t)
;;
;; Capitalize common block name
;; (idlwave-action-and-binding "\\<common\\>[ \t]+\\<"
-;; '(capitalize-word 1) t)
+;; (lambda (_) (capitalize-word 1)) t)
;; Capitalize label
;; (idlwave-action-and-binding (concat "^[ \t]*" idlwave-label)
-;; '(capitalize-word -1) t)
+;; (lambda (_) (capitalize-word 1)) t)
(defvar idlwave-indent-action-table nil
"Associated array containing action lists of search string (car),
@@ -1121,91 +1122,101 @@ As a user, you should not set this to t.")
"\\<\\(&&\\|and\\|b\\(egin\\|reak\\)\\|c\\(ase\\|o\\(mpile_opt\\|ntinue\\)\\)\\|do\\|e\\(lse\\|nd\\(case\\|else\\|for\\|if\\|rep\\|switch\\|while\\)?\\|q\\)\\|for\\(ward_function\\)?\\|g\\(oto\\|[et]\\)\\|i\\(f\\|nherits\\)\\|l[et]\\|mod\\|n\\(e\\|ot\\)\\|o\\(n_\\(error\\|ioerror\\)\\|[fr]\\)\\|re\\(peat\\|turn\\)\\|switch\\|then\\|until\\|while\\|xor\\|||\\)\\>")
-(let* (;; Procedure declarations. Fontify keyword plus procedure name.
- ;; Function declarations. Fontify keyword plus function name.
- (pros-and-functions
- '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)"
- (1 font-lock-keyword-face)
- (2 font-lock-function-name-face nil t)))
-
- ;; Common blocks
- (common-blocks
- '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
- (1 font-lock-keyword-face) ; "common"
- (2 font-lock-constant-face nil t) ; block name
- ("[ \t]*\\(\\sw+\\)[ ,]*"
- ;; Start with point after block name and comma
- nil nil (1 font-lock-variable-name-face)))) ; variable names
-
- ;; Batch files
- (batch-files
- '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face)))
-
- ;; Labels
- (label
- '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face)))
-
- ;; The goto statement and its label
- (goto
- '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)"
- (1 font-lock-keyword-face)
- (2 font-lock-constant-face)))
-
- ;; Tags in structure definitions. Note that this definition
- ;; actually collides with labels, so we have to use the same
- ;; face. It also matches named subscript ranges,
- ;; e.g. vec{bottom:top]. No good way around this.
- (structtag
- '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face)))
-
- ;; Structure names
- (structname
- '("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]"
- (2 font-lock-function-name-face)))
-
- ;; Keyword parameters, like /xlog or ,xrange=[]
- ;; This is anchored to the comma preceding the keyword.
- ;; Treats continuation lines, works only during whole buffer
- ;; fontification. Slow, use it only in fancy fontification.
- (keyword-parameters
- '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)"
- (6 font-lock-constant-face)))
-
- ;; System variables start with a bang.
- (system-variables
- '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)"
- (1 font-lock-variable-name-face)))
-
- ;; Special and unusual operators (not used because too noisy)
- ;; (special-operators
- ;; '("[<>#]" (0 font-lock-keyword-face)))
-
- ;; All operators (not used because too noisy)
- ;; (all-operators
- ;; '("[-*^#+<>/]" (0 font-lock-keyword-face)))
-
- ;; Arrows with text property `idlwave-class'
- (class-arrows
- '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))
+(defmacro idlwave--dlet (binders &rest body)
+ "Like `dlet' but without warnings about non-prefixed var names."
+ (declare (indent 1) (debug let))
+ (let ((vars (mapcar (lambda (binder)
+ (if (consp binder) (car binder) binder))
+ binders)))
+ `(with-suppressed-warnings ((lexical ,@vars))
+ (dlet ,binders ,@body))))
+
+(idlwave--dlet
+ (;; Procedure declarations. Fontify keyword plus procedure name.
+ ;; Function declarations. Fontify keyword plus function name.
+ (pros-and-functions
+ '("\\<\\(function\\|pro\\)\\>[ \t]+\\(\\sw+\\(::\\sw+\\)?\\)"
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face nil t)))
+
+ ;; Common blocks
+ (common-blocks
+ '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?"
+ (1 font-lock-keyword-face) ; "common"
+ (2 font-lock-constant-face nil t) ; block name
+ ("[ \t]*\\(\\sw+\\)[ ,]*"
+ ;; Start with point after block name and comma
+ nil nil (1 font-lock-variable-name-face)))) ; variable names
+
+ ;; Batch files
+ (batch-files
+ '("^[ \t]*\\(@[^ \t\n]+\\)" (1 font-lock-string-face)))
+
+ ;; Labels
+ (label
+ '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face)))
+
+ ;; The goto statement and its label
+ (goto
+ '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)"
+ (1 font-lock-keyword-face)
+ (2 font-lock-constant-face)))
+
+ ;; Tags in structure definitions. Note that this definition
+ ;; actually collides with labels, so we have to use the same
+ ;; face. It also matches named subscript ranges,
+ ;; e.g. vec{bottom:top]. No good way around this.
+ (structtag
+ '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face)))
+
+ ;; Structure names
+ (structname
+ '("\\({\\|\\<inherits\\s-\\)\\s-*\\([a-zA-Z][a-zA-Z0-9_]*\\)[},\t \n]"
+ (2 font-lock-function-name-face)))
+
+ ;; Keyword parameters, like /xlog or ,xrange=[]
+ ;; This is anchored to the comma preceding the keyword.
+ ;; Treats continuation lines, works only during whole buffer
+ ;; fontification. Slow, use it only in fancy fontification.
+ (keyword-parameters
+ '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)"
+ (6 font-lock-constant-face)))
+
+ ;; System variables start with a bang.
+ (system-variables
+ '("\\(![a-zA-Z_0-9]+\\(\\.\\sw+\\)?\\)"
+ (1 font-lock-variable-name-face)))
+
+ ;; Special and unusual operators (not used because too noisy)
+ ;; (special-operators
+ ;; '("[<>#]" (0 font-lock-keyword-face)))
+
+ ;; All operators (not used because too noisy)
+ ;; (all-operators
+ ;; '("[-*^#+<>/]" (0 font-lock-keyword-face)))
+
+ ;; Arrows with text property `idlwave-class'
+ (class-arrows
+ '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))
(defconst idlwave-font-lock-keywords-1
(list pros-and-functions batch-files)
"Subdued level highlighting for IDLWAVE mode.")
(defconst idlwave-font-lock-keywords-2
- (mapcar 'symbol-value idlwave-default-font-lock-items)
+ (mapcar #'symbol-value idlwave-default-font-lock-items)
"Medium level highlighting for IDLWAVE mode.")
(defconst idlwave-font-lock-keywords-3
- (list pros-and-functions
- batch-files
- idlwave-idl-keywords
- label goto
- structtag
- structname
- common-blocks
- keyword-parameters
- system-variables
+ (list pros-and-functions
+ batch-files
+ idlwave-idl-keywords
+ label goto
+ structtag
+ structname
+ common-blocks
+ keyword-parameters
+ system-variables
class-arrows)
"Gaudy level highlighting for IDLWAVE mode."))
@@ -1312,13 +1323,16 @@ blocks starting with a BEGIN statement. The matches must have associations
(cons 'call (list (concat "\\(" idlwave-variable "\\) *= *"
"\\(" idlwave-method-call "\\s *\\)?"
idlwave-identifier
- "\\s *(") nil))
+ "\\s *(")
+ nil))
(cons 'call (list (concat
"\\(" idlwave-method-call "\\s *\\)?"
idlwave-identifier
- "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil))
+ "\\( *\\($\\|\\$\\)\\|\\s *,\\)")
+ nil))
(cons 'assign (list (concat
- "\\(" idlwave-variable "\\) *=") nil)))
+ "\\(" idlwave-variable "\\) *=")
+ nil)))
"Associated list of statement matching regular expressions.
Each regular expression matches the start of an IDL statement.
@@ -1333,10 +1347,6 @@ list order matters since matching an assignment statement exactly is
not possible without parsing. Thus assignment statement become just
the leftover unidentified statements containing an equal sign.")
-;; FIXME: This var seems to only ever be set, but never actually used!
-(defvar idlwave-fill-function 'auto-fill-function
- "IDL mode auto fill function.")
-
(defvar idlwave-comment-indent-function 'comment-indent-function
"IDL mode comment indent function.")
@@ -1353,28 +1363,9 @@ Normally a space.")
(defconst idlwave-mode-version "6.1_em22")
-(defmacro idlwave-keyword-abbrev (&rest args)
- "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args."
- `(lambda ()
- ,(append '(idlwave-check-abbrev) args)))
-
-;; If I take the time I can replace idlwave-keyword-abbrev with
-;; idlwave-code-abbrev and remove the quoted abbrev check from
-;; idlwave-check-abbrev. Then, e.g, (idlwave-keyword-abbrev 0 t) becomes
-;; (idlwave-code-abbrev idlwave-check-abbrev 0 t). In fact I should change
-;; the name of idlwave-check-abbrev to something like idlwave-modify-abbrev.
-
-(defmacro idlwave-code-abbrev (&rest args)
- "Creates a function for abbrev hooks that ensures abbrevs are not quoted.
-Specifically, if the abbrev is in a comment or string it is unexpanded.
-Otherwise ARGS forms a list that is evaluated."
- ;; FIXME: it would probably be better to rely on the new :enable-function
- ;; to enforce the "don't expand in comments or strings".
- `(lambda ()
- ,(prin1-to-string args) ;; Puts the code in the doc string
- (if (idlwave-quoted)
- (progn (unexpand-abbrev) nil)
- ,(append args))))
+(defun idlwave-keyword-abbrev (&rest args)
+ "Create a function for abbrev hooks to call `idlwave-modify-abbrev' with args."
+ (lambda () (append #'idlwave-modify-abbrev args)))
(autoload 'idlwave-shell "idlw-shell"
"Run an inferior IDL, with I/O through buffer `(idlwave-shell-buffer)'." t)
@@ -1388,41 +1379,41 @@ Otherwise ARGS forms a list that is evaluated."
(autoload 'idlwave-shell-run-region "idlw-shell"
"Compile and run the region." t)
-(fset 'idlwave-debug-map (make-sparse-keymap))
+(defalias 'idlwave-debug-map (make-sparse-keymap))
(defvar idlwave-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c " 'idlwave-hard-tab)
- (define-key map [(control tab)] 'idlwave-hard-tab)
- ;;(define-key map "\C-c\C- " 'idlwave-hard-tab)
- (define-key map "'" 'idlwave-show-matching-quote)
- (define-key map "\"" 'idlwave-show-matching-quote)
- (define-key map "\C-g" 'idlwave-keyboard-quit)
- (define-key map "\C-c;" 'idlwave-toggle-comment-region)
- (define-key map "\C-\M-a" 'idlwave-beginning-of-subprogram)
- (define-key map "\C-\M-e" 'idlwave-end-of-subprogram)
- (define-key map "\C-c{" 'idlwave-beginning-of-block)
- (define-key map "\C-c}" 'idlwave-end-of-block)
- (define-key map "\C-c]" 'idlwave-close-block)
- (define-key map [(meta control h)] 'idlwave-mark-subprogram)
- (define-key map "\M-\C-n" 'idlwave-forward-block)
- (define-key map "\M-\C-p" 'idlwave-backward-block)
- (define-key map "\M-\C-d" 'idlwave-down-block)
- (define-key map "\M-\C-u" 'idlwave-backward-up-block)
- (define-key map "\M-\r" 'idlwave-split-line)
- (define-key map "\M-\C-q" 'idlwave-indent-subprogram)
- (define-key map "\C-c\C-p" 'idlwave-previous-statement)
- (define-key map "\C-c\C-n" 'idlwave-next-statement)
- ;; (define-key map "\r" 'idlwave-newline)
- ;; (define-key map "\t" 'idlwave-indent-line)
- (define-key map [(shift iso-lefttab)] 'idlwave-indent-statement)
- (define-key map "\C-c\C-a" 'idlwave-auto-fill-mode)
- (define-key map "\M-q" 'idlwave-fill-paragraph)
- (define-key map "\M-s" 'idlwave-edit-in-idlde)
- (define-key map "\C-c\C-h" 'idlwave-doc-header)
- (define-key map "\C-c\C-m" 'idlwave-doc-modification)
- (define-key map "\C-c\C-c" 'idlwave-case)
- (define-key map "\C-c\C-d" 'idlwave-debug-map)
+ (define-key map "\C-c " #'idlwave-hard-tab)
+ (define-key map [(control tab)] #'idlwave-hard-tab)
+ ;;(define-key map "\C-c\C- " #'idlwave-hard-tab)
+ (define-key map "'" #'idlwave-show-matching-quote)
+ (define-key map "\"" #'idlwave-show-matching-quote)
+ (define-key map "\C-g" #'idlwave-keyboard-quit)
+ (define-key map "\C-c;" #'idlwave-toggle-comment-region)
+ (define-key map "\C-\M-a" #'idlwave-beginning-of-subprogram)
+ (define-key map "\C-\M-e" #'idlwave-end-of-subprogram)
+ (define-key map "\C-c{" #'idlwave-beginning-of-block)
+ (define-key map "\C-c}" #'idlwave-end-of-block)
+ (define-key map "\C-c]" #'idlwave-close-block)
+ (define-key map [(meta control h)] #'idlwave-mark-subprogram)
+ (define-key map "\M-\C-n" #'idlwave-forward-block)
+ (define-key map "\M-\C-p" #'idlwave-backward-block)
+ (define-key map "\M-\C-d" #'idlwave-down-block)
+ (define-key map "\M-\C-u" #'idlwave-backward-up-block)
+ (define-key map "\M-\r" #'idlwave-split-line)
+ (define-key map "\M-\C-q" #'idlwave-indent-subprogram)
+ (define-key map "\C-c\C-p" #'idlwave-previous-statement)
+ (define-key map "\C-c\C-n" #'idlwave-next-statement)
+ ;; (define-key map "\r" #'idlwave-newline)
+ ;; (define-key map "\t" #'idlwave-indent-line)
+ (define-key map [(shift iso-lefttab)] #'idlwave-indent-statement)
+ (define-key map "\C-c\C-a" #'auto-fill-mode)
+ (define-key map "\M-q" #'idlwave-fill-paragraph)
+ (define-key map "\M-s" #'idlwave-edit-in-idlde)
+ (define-key map "\C-c\C-h" #'idlwave-doc-header)
+ (define-key map "\C-c\C-m" #'idlwave-doc-modification)
+ (define-key map "\C-c\C-c" #'idlwave-case)
+ (define-key map "\C-c\C-d" #'idlwave-debug-map)
(when (and (listp idlwave-shell-debug-modifiers)
(not (equal idlwave-shell-debug-modifiers '())))
;; Bind the debug commands also with the special modifiers.
@@ -1431,38 +1422,39 @@ Otherwise ARGS forms a list that is evaluated."
(delq 'shift (copy-sequence idlwave-shell-debug-modifiers))))
(define-key map
(vector (append mods-noshift (list (if shift ?C ?c))))
- 'idlwave-shell-save-and-run)
+ #'idlwave-shell-save-and-run)
(define-key map
(vector (append mods-noshift (list (if shift ?B ?b))))
- 'idlwave-shell-break-here)
+ #'idlwave-shell-break-here)
(define-key map
(vector (append mods-noshift (list (if shift ?E ?e))))
- 'idlwave-shell-run-region)))
- (define-key map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run)
- (define-key map "\C-c\C-d\C-b" 'idlwave-shell-break-here)
- (define-key map "\C-c\C-d\C-e" 'idlwave-shell-run-region)
- (define-key map "\C-c\C-f" 'idlwave-for)
- ;; (define-key map "\C-c\C-f" 'idlwave-function)
- ;; (define-key map "\C-c\C-p" 'idlwave-procedure)
- (define-key map "\C-c\C-r" 'idlwave-repeat)
- (define-key map "\C-c\C-w" 'idlwave-while)
- (define-key map "\C-c\C-k" 'idlwave-kill-autoloaded-buffers)
- (define-key map "\C-c\C-s" 'idlwave-shell)
- (define-key map "\C-c\C-l" 'idlwave-shell-recenter-shell-window)
- (define-key map "\C-c\C-b" 'idlwave-list-buffer-load-path-shadows)
- (define-key map "\C-c\C-v" 'idlwave-find-module)
- (define-key map "\C-c\C-t" 'idlwave-find-module-this-file)
- (define-key map "\C-c?" 'idlwave-routine-info)
- (define-key map "\M-?" 'idlwave-context-help)
+ #'idlwave-shell-run-region)))
+ (define-key map "\C-c\C-d\C-c" #'idlwave-shell-save-and-run)
+ (define-key map "\C-c\C-d\C-b" #'idlwave-shell-break-here)
+ (define-key map "\C-c\C-d\C-e" #'idlwave-shell-run-region)
+ (define-key map "\C-c\C-f" #'idlwave-for)
+ ;; (define-key map "\C-c\C-f" #'idlwave-function)
+ ;; (define-key map "\C-c\C-p" #'idlwave-procedure)
+ (define-key map "\C-c\C-r" #'idlwave-repeat)
+ (define-key map "\C-c\C-w" #'idlwave-while)
+ (define-key map "\C-c\C-k" #'idlwave-kill-autoloaded-buffers)
+ (define-key map "\C-c\C-s" #'idlwave-shell)
+ (define-key map "\C-c\C-l" #'idlwave-shell-recenter-shell-window)
+ (define-key map "\C-c\C-b" #'idlwave-list-buffer-load-path-shadows)
+ (define-key map "\C-c\C-v" #'idlwave-find-module)
+ (define-key map "\C-c\C-t" #'idlwave-find-module-this-file)
+ (define-key map "\C-c?" #'idlwave-routine-info)
+ (define-key map "\M-?" #'idlwave-context-help)
(define-key map [(control meta ?\?)]
- 'idlwave-help-assistant-help-with-topic)
+ #'idlwave-help-assistant-help-with-topic)
;; Pickup both forms of Esc/Meta binding
- (define-key map [(meta tab)] 'idlwave-complete)
- (define-key map [?\e?\t] 'idlwave-complete)
- (define-key map "\M-\C-i" 'idlwave-complete)
- (define-key map "\C-c\C-i" 'idlwave-update-routine-info)
- (define-key map "\C-c=" 'idlwave-resolve)
- (define-key map [(shift mouse-3)] 'idlwave-mouse-context-help)
+ ;; FIXME: Use `completion-at-point'!
+ (define-key map [(meta tab)] #'idlwave-complete)
+ (define-key map [?\e?\t] #'idlwave-complete)
+ (define-key map "\M-\C-i" #'idlwave-complete)
+ (define-key map "\C-c\C-i" #'idlwave-update-routine-info)
+ (define-key map "\C-c=" #'idlwave-resolve)
+ (define-key map [(shift mouse-3)] #'idlwave-mouse-context-help)
map)
"Keymap used in IDL mode.")
@@ -1501,28 +1493,15 @@ Otherwise ARGS forms a list that is evaluated."
st)
"Syntax table that treats symbol characters as word characters.")
-(defmacro idlwave-with-special-syntax (&rest body)
- "Execute BODY with a different syntax table."
- `(let ((saved-syntax (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table idlwave-find-symbol-syntax-table)
- ,@body)
- (set-syntax-table saved-syntax))))
-
-;(defmacro idlwave-with-special-syntax1 (&rest body)
-; "Execute BODY with a different syntax table."
-; `(let ((saved-syntax (syntax-table)))
-; (unwind-protect
-; (progn
-; (set-syntax-table idlwave-find-symbol-syntax-table)
-; ,@body)
-; (set-syntax-table saved-syntax))))
+;;(defmacro idlwave-with-special-syntax (&rest body)
+;; "Execute BODY with `idlwave-find-symbol-syntax-table'."
+;; `(with-syntax-table idlwave-find-symbol-syntax-table
+;; ,@body))
(defun idlwave-action-and-binding (key cmd &optional select)
"KEY and CMD are made into a key binding and an indent action.
KEY is a string - same as for the `define-key' function. CMD is a
-function of no arguments or a list to be evaluated. CMD is bound to
+function of one argument. CMD is bound to
KEY in `idlwave-mode-map' by defining an anonymous function calling
`self-insert-command' followed by CMD. If KEY contains more than one
character a binding will only be set if SELECT is `both'.
@@ -1539,62 +1518,59 @@ Otherwise, if SELECT is non-nil then only an action is created.
Some examples:
No spaces before and 1 after a comma
- (idlwave-action-and-binding \",\" \\='(idlwave-surround 0 1))
+ (idlwave-action-and-binding \",\" (lambda (_) (idlwave-surround 0 1)))
A minimum of 1 space before and after `=' (see `idlwave-expand-equal').
- (idlwave-action-and-binding \"=\" \\='(idlwave-expand-equal -1 -1))
+ (idlwave-action-and-binding \"=\" (lambda (_) (idlwave-expand-equal -1 -1)))
Capitalize system variables - action only
- (idlwave-action-and-binding idlwave-sysvar \\='(capitalize-word 1) t)"
+ (idlwave-action-and-binding idlwave-sysvar (lambda (_) (capitalize-word 1) t))"
(if (not (equal select 'noaction))
;; Add action
(let* ((table (if select 'idlwave-indent-action-table
'idlwave-indent-expand-table))
- (table-key (regexp-quote key))
- (cell (assoc table-key (eval table))))
- (if cell
- ;; Replace action command
- (setcdr cell cmd)
- ;; New action
- (set table (append (eval table) (list (cons table-key cmd)))))))
+ (table-key (regexp-quote key)))
+ (setf (alist-get table-key (symbol-value table) nil nil #'equal) cmd)))
;; Make key binding for action
- (if (or (and (null select) (= (length key) 1))
- (equal select 'noaction)
- (equal select 'both))
+ (if (if (null select) (= (length key) 1)
+ (memq select '(noaction both)))
+ ;; FIXME: Use `post-self-insert-hook'!
(define-key idlwave-mode-map key
- `(lambda ()
- (interactive)
- (self-insert-command 1)
- ,(if (listp cmd) cmd (list cmd))))))
+ (lambda ()
+ (interactive)
+ (self-insert-command 1)
+ (if (functionp cmd) (funcall cmd nil) (eval cmd t))))))
;; Set action and key bindings.
;; See description of the function `idlwave-action-and-binding'.
;; Automatically add spaces for the following characters
;; Actions for & are complicated by &&
-(idlwave-action-and-binding "&" 'idlwave-custom-ampersand-surround)
+(idlwave-action-and-binding "&" #'idlwave-custom-ampersand-surround)
;; Automatically add spaces to equal sign if not keyword. This needs
;; to go ahead of > and <, so >= and <= will be treated correctly
-(idlwave-action-and-binding "=" '(idlwave-expand-equal -1 -1))
+(idlwave-action-and-binding "=" (lambda (_) (idlwave-expand-equal -1 -1)))
;; Actions for > and < are complicated by >=, <=, and ->...
-(idlwave-action-and-binding "<" '(idlwave-custom-ltgtr-surround nil))
-(idlwave-action-and-binding ">" '(idlwave-custom-ltgtr-surround 'gtr))
+(idlwave-action-and-binding "<" (lambda (a) (idlwave-custom-ltgtr-surround nil a)))
+(idlwave-action-and-binding ">" (lambda (a) (idlwave-custom-ltgtr-surround t a)))
-(idlwave-action-and-binding "," '(idlwave-surround 0 -1 1))
+(idlwave-action-and-binding "," (lambda (a) (idlwave-surround 0 -1 1 a)))
;;;
;;; Abbrev Section
;;;
-;;; When expanding abbrevs and the abbrev hook moves backward, an extra
-;;; space is inserted (this is the space typed by the user to expanded
-;;; the abbrev).
-;;;
-(defvar idlwave-mode-abbrev-table nil
- "Abbreviation table used for IDLWAVE mode.")
-(define-abbrev-table 'idlwave-mode-abbrev-table ())
+;; When expanding abbrevs and the abbrev hook moves backward, an extra
+;; space is inserted (this is the space typed by the user to expanded
+;; the abbrev).
+;; FIXME: This can be controlled with `no-self-insert' property.
+;;
+(define-abbrev-table 'idlwave-mode-abbrev-table ()
+ "Abbreviation table used for IDLWAVE mode."
+ :enable-function (lambda () (not (idlwave-quoted))))
(defun idlwave-define-abbrev (name expansion hook &optional noprefix table)
+ ;; FIXME: `table' is never passed.
"Define-abbrev with backward compatibility.
If NOPREFIX is non-nil, don't prepend prefix character. Installs into
@@ -1605,8 +1581,8 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into
expansion
hook)))
(condition-case nil
- (apply 'define-abbrev (append args '(0 t)))
- (error (apply 'define-abbrev args)))))
+ (apply #'define-abbrev (append args '(0 t)))
+ (error (apply #'define-abbrev args)))))
(condition-case nil
(modify-syntax-entry (string-to-char idlwave-abbrev-start-char)
@@ -1616,15 +1592,15 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into
;;
;; Templates
;;
-(idlwave-define-abbrev "c" "" (idlwave-code-abbrev idlwave-case))
-(idlwave-define-abbrev "sw" "" (idlwave-code-abbrev idlwave-switch))
-(idlwave-define-abbrev "f" "" (idlwave-code-abbrev idlwave-for))
-(idlwave-define-abbrev "fu" "" (idlwave-code-abbrev idlwave-function))
-(idlwave-define-abbrev "pr" "" (idlwave-code-abbrev idlwave-procedure))
-(idlwave-define-abbrev "r" "" (idlwave-code-abbrev idlwave-repeat))
-(idlwave-define-abbrev "w" "" (idlwave-code-abbrev idlwave-while))
-(idlwave-define-abbrev "i" "" (idlwave-code-abbrev idlwave-if))
-(idlwave-define-abbrev "elif" "" (idlwave-code-abbrev idlwave-elif))
+(idlwave-define-abbrev "c" "" #'idlwave-case)
+(idlwave-define-abbrev "sw" "" #'idlwave-switch)
+(idlwave-define-abbrev "f" "" #'idlwave-for)
+(idlwave-define-abbrev "fu" "" #'idlwave-function)
+(idlwave-define-abbrev "pr" "" #'idlwave-procedure)
+(idlwave-define-abbrev "r" "" #'idlwave-repeat)
+(idlwave-define-abbrev "w" "" #'idlwave-while)
+(idlwave-define-abbrev "i" "" #'idlwave-if)
+(idlwave-define-abbrev "elif" "" #'idlwave-elif)
;;
;; Keywords, system functions, conversion routines
;;
@@ -1639,15 +1615,15 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into
(idlwave-define-abbrev "cc" "complex()" (idlwave-keyword-abbrev 1))
(idlwave-define-abbrev "cd" "double()" (idlwave-keyword-abbrev 1))
(idlwave-define-abbrev "e" "else" (idlwave-keyword-abbrev 0 t))
-(idlwave-define-abbrev "ec" "endcase" 'idlwave-show-begin)
-(idlwave-define-abbrev "es" "endswitch" 'idlwave-show-begin)
-(idlwave-define-abbrev "ee" "endelse" 'idlwave-show-begin)
-(idlwave-define-abbrev "ef" "endfor" 'idlwave-show-begin)
-(idlwave-define-abbrev "ei" "endif else if" 'idlwave-show-begin)
-(idlwave-define-abbrev "el" "endif else" 'idlwave-show-begin)
-(idlwave-define-abbrev "en" "endif" 'idlwave-show-begin)
-(idlwave-define-abbrev "er" "endrep" 'idlwave-show-begin)
-(idlwave-define-abbrev "ew" "endwhile" 'idlwave-show-begin)
+(idlwave-define-abbrev "ec" "endcase" #'idlwave-show-begin)
+(idlwave-define-abbrev "es" "endswitch" #'idlwave-show-begin)
+(idlwave-define-abbrev "ee" "endelse" #'idlwave-show-begin)
+(idlwave-define-abbrev "ef" "endfor" #'idlwave-show-begin)
+(idlwave-define-abbrev "ei" "endif else if" #'idlwave-show-begin)
+(idlwave-define-abbrev "el" "endif else" #'idlwave-show-begin)
+(idlwave-define-abbrev "en" "endif" #'idlwave-show-begin)
+(idlwave-define-abbrev "er" "endrep" #'idlwave-show-begin)
+(idlwave-define-abbrev "ew" "endwhile" #'idlwave-show-begin)
(idlwave-define-abbrev "g" "goto," (idlwave-keyword-abbrev 0 t))
(idlwave-define-abbrev "h" "help," (idlwave-keyword-abbrev 0))
(idlwave-define-abbrev "k" "keyword_set()" (idlwave-keyword-abbrev 1))
@@ -1695,15 +1671,15 @@ If NOPREFIX is non-nil, don't prepend prefix character. Installs into
(idlwave-define-abbrev "continue" "continue" (idlwave-keyword-abbrev 0 t) t)
(idlwave-define-abbrev "do" "do" (idlwave-keyword-abbrev 0 t) t)
(idlwave-define-abbrev "else" "else" (idlwave-keyword-abbrev 0 t) t)
-(idlwave-define-abbrev "end" "end" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endcase" "endcase" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endelse" "endelse" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endfor" "endfor" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endif" "endif" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endrep" "endrep" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endswitch" "endswitch" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endwhi" "endwhi" 'idlwave-show-begin-check t)
-(idlwave-define-abbrev "endwhile" "endwhile" 'idlwave-show-begin-check t)
+(idlwave-define-abbrev "end" "end" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endcase" "endcase" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endelse" "endelse" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endfor" "endfor" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endif" "endif" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endrep" "endrep" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endswitch" "endswitch" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endwhi" "endwhi" #'idlwave-show-begin-check t)
+(idlwave-define-abbrev "endwhile" "endwhile" #'idlwave-show-begin-check t)
(idlwave-define-abbrev "eq" "eq" (idlwave-keyword-abbrev 0 t) t)
(idlwave-define-abbrev "for" "for" (idlwave-keyword-abbrev 0 t) t)
(idlwave-define-abbrev "function" "function" (idlwave-keyword-abbrev 0 t) t)
@@ -1763,7 +1739,7 @@ The main features of this mode are
Use \\[idlwave-fill-paragraph] to refill a paragraph inside a
comment. The indentation of the second line of the paragraph
relative to the first will be retained. Use
- \\[idlwave-auto-fill-mode] to toggle auto-fill mode for these
+ \\[auto-fill-mode] to toggle auto-fill mode for these
comments. When the variable `idlwave-fill-comment-line-only' is
nil, code can also be auto-filled and auto-indented.
@@ -1861,7 +1837,7 @@ The main features of this mode are
(message "Emacs IDLWAVE mode version %s." idlwave-mode-version))
(setq idlwave-startup-message nil)
- (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)
+ (set (make-local-variable 'indent-line-function) #'idlwave-indent-and-action)
(set (make-local-variable idlwave-comment-indent-function)
#'idlwave-comment-hook)
@@ -1875,7 +1851,7 @@ The main features of this mode are
(setq abbrev-mode t)
- (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)
+ (set (make-local-variable 'normal-auto-fill-function) #'idlwave-auto-fill)
(setq comment-end "")
(set (make-local-variable 'comment-multi-line) nil)
(set (make-local-variable 'paragraph-separate)
@@ -1886,26 +1862,27 @@ The main features of this mode are
;; ChangeLog
(set (make-local-variable 'add-log-current-defun-function)
- 'idlwave-current-routine-fullname)
+ #'idlwave-current-routine-fullname)
;; Set tag table list to use IDLTAGS as file name.
(if (boundp 'tag-table-alist)
- (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
+ (add-to-list 'tag-table-alist '("\\.pro\\'" . "IDLTAGS")))
;; Font-lock additions
(set (make-local-variable 'font-lock-defaults) idlwave-font-lock-defaults)
(set (make-local-variable 'font-lock-mark-block-function)
- 'idlwave-mark-subprogram)
+ #'idlwave-mark-subprogram)
(set (make-local-variable 'font-lock-fontify-region-function)
- 'idlwave-font-lock-fontify-region)
+ #'idlwave-font-lock-fontify-region)
;; Imenu setup
- (set (make-local-variable 'imenu-create-index-function)
- 'imenu-default-create-index-function)
+ ;;(set (make-local-variable 'imenu-create-index-function)
+ ;; ;; FIXME: Why set it explicitly to the value it already has?
+ ;; #'imenu-default-create-index-function)
(set (make-local-variable 'imenu-extract-index-name-function)
- 'idlwave-unit-name)
+ #'idlwave-unit-name)
(set (make-local-variable 'imenu-prev-index-position-function)
- 'idlwave-prev-index-position)
+ #'idlwave-prev-index-position)
;; HideShow setup
(add-to-list 'hs-special-modes-alist
@@ -1916,12 +1893,12 @@ The main features of this mode are
'idlwave-forward-block nil))
;; Make a local post-command-hook and add our hook to it
- (add-hook 'post-command-hook 'idlwave-command-hook nil 'local)
+ (add-hook 'post-command-hook #'idlwave-command-hook nil 'local)
;; Make local hooks for buffer updates
- (add-hook 'kill-buffer-hook 'idlwave-kill-buffer-update nil 'local)
- (add-hook 'after-save-hook 'idlwave-save-buffer-update nil 'local)
- (add-hook 'after-save-hook 'idlwave-revoke-license-to-kill nil 'local)
+ (add-hook 'kill-buffer-hook #'idlwave-kill-buffer-update nil 'local)
+ (add-hook 'after-save-hook #'idlwave-save-buffer-update nil 'local)
+ (add-hook 'after-save-hook #'idlwave-revoke-license-to-kill nil 'local)
;; Setup directories and file, if necessary
(idlwave-setup)
@@ -1974,29 +1951,27 @@ The main features of this mode are
;;; This stuff is experimental
-(defvar idlwave-command-hook nil
- "If non-nil, a list that can be evaluated using `eval'.
+(defvar idlwave--command-function nil
+ "If non-nil, a function called from `post-command-hook'.
It is evaluated in the lisp function `idlwave-command-hook' which is
placed in `post-command-hook'.")
(defun idlwave-command-hook ()
"Command run after every command.
-Evaluates a non-nil value of the *variable* `idlwave-command-hook' and
+Evaluates a non-nil value of the *variable* `idlwave--command-function' and
sets the variable to zero afterwards."
- (and idlwave-command-hook
- (listp idlwave-command-hook)
- (condition-case nil
- (eval idlwave-command-hook)
- (error nil)))
- (setq idlwave-command-hook nil))
+ (and idlwave--command-function
+ (with-demoted-errors "idlwave-command-hook: %S"
+ (funcall (prog1 idlwave--command-function
+ (setq idlwave--command-function nil))))))
;;; End experiment
;; It would be better to use expand.el for better abbrev handling and
;; versatility.
-(defun idlwave-check-abbrev (arg &optional reserved)
- "Reverse abbrev expansion if in comment or string.
+(defun idlwave-modify-abbrev (arg &optional reserved)
+ "Tweak the abbrev we just expanded.
Argument ARG is the number of characters to move point
backward if `idlwave-abbrev-move' is non-nil.
If optional argument RESERVED is non-nil then the expansion
@@ -2006,21 +1981,16 @@ Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case'
is non-nil, unless its value is `down' in which case the abbrev will be
made into all lowercase.
Returns non-nil if abbrev is left expanded."
- (if (idlwave-quoted)
- (progn (unexpand-abbrev)
- nil)
- (if (and reserved idlwave-reserved-word-upcase)
- (upcase-region last-abbrev-location (point))
- (cond
- ((equal idlwave-abbrev-change-case 'down)
- (downcase-region last-abbrev-location (point)))
- (idlwave-abbrev-change-case
- (upcase-region last-abbrev-location (point)))))
- (if (and idlwave-abbrev-move (> arg 0))
- (if (boundp 'post-command-hook)
- (setq idlwave-command-hook (list 'backward-char (1+ arg)))
- (backward-char arg)))
- t))
+ (if (and reserved idlwave-reserved-word-upcase)
+ (upcase-region last-abbrev-location (point))
+ (cond
+ ((equal idlwave-abbrev-change-case 'down)
+ (downcase-region last-abbrev-location (point)))
+ (idlwave-abbrev-change-case
+ (upcase-region last-abbrev-location (point)))))
+ (if (and idlwave-abbrev-move (> arg 0))
+ (setq idlwave--command-function (lambda () (backward-char (1+ arg)))))
+ t)
(defun idlwave-in-comment ()
"Return t if point is inside a comment, nil otherwise."
@@ -2047,7 +2017,7 @@ Returns point if comment found and nil otherwise."
(backward-char 1)
(point)))))
-(define-obsolete-function-alias 'idlwave-region-active-p 'use-region-p "28.1")
+(define-obsolete-function-alias 'idlwave-region-active-p #'use-region-p "28.1")
(defun idlwave-show-matching-quote ()
"Insert quote and show matching quote if this is end of a string."
@@ -2067,13 +2037,12 @@ Returns point if comment found and nil otherwise."
(defun idlwave-show-begin-check ()
"Ensure that the previous word was a token before `idlwave-show-begin'.
An END token must be preceded by whitespace."
- (if (not (idlwave-quoted))
- (if
- (save-excursion
- (backward-word-strictly 1)
- (backward-char 1)
- (looking-at "[ \t\n\f]"))
- (idlwave-show-begin))))
+ (if
+ (save-excursion
+ (backward-word-strictly 1)
+ (backward-char 1)
+ (looking-at "[ \t\n\f]"))
+ (idlwave-show-begin)))
(defun idlwave-show-begin ()
"Find the start of current block and blinks to it for a second.
@@ -2088,7 +2057,7 @@ Also checks if the correct END statement has been used."
begin-pos end-pos end end1 )
(if idlwave-reindent-end (idlwave-indent-line))
(setq last-abbrev-location (marker-position last-abbrev-marker))
- (when (and (idlwave-check-abbrev 0 t)
+ (when (and (idlwave-modify-abbrev 0 t)
idlwave-show-block)
(save-excursion
;; Move inside current block
@@ -2178,11 +2147,11 @@ Also checks if the correct END statement has been used."
(next-char (char-after (point)))
(method-invoke (and gtr (eq prev-char ?-)))
(len (if method-invoke 2 1)))
- (unless (eq next-char ?=)
+ (unless (eq next-char ?=)
;; Key binding: pad only on left, to save for possible >=/<=
(idlwave-surround -1 (if (or is-action method-invoke) -1) len))))
-(defun idlwave-surround (&optional before after length is-action)
+(defun idlwave-surround (&optional before after length _is-action)
"Surround the LENGTH characters before point with blanks.
LENGTH defaults to 1.
Optional arguments BEFORE and AFTER affect the behavior before and
@@ -2578,7 +2547,7 @@ If there is no label point is not moved and nil is returned."
(end (idlwave-find-key ":" 1 'nomark eos)))
(if (and end
(= (nth 0 (parse-partial-sexp start end)) 0)
- (not (string-match "\\?" (buffer-substring start end)))
+ (not (string-search "?" (buffer-substring start end)))
(not (string-match "^::" (buffer-substring end eos))))
(progn
(forward-char)
@@ -2641,7 +2610,7 @@ statement."
(if st
(append st (match-end 0))))))
-(defun idlwave-expand-equal (&optional before after is-action)
+(defun idlwave-expand-equal (&optional before after _is-action)
"Pad `=' with spaces.
Two cases: Assignment statement, and keyword assignment.
Which case is determined using `idlwave-start-of-substatement' and
@@ -2749,10 +2718,10 @@ If the optional argument EXPAND is non-nil then the actions in
;; Before indenting, run action routines.
;;
(if (and expand idlwave-do-actions)
- (mapc 'idlwave-do-action idlwave-indent-expand-table))
+ (mapc #'idlwave-do-action idlwave-indent-expand-table))
;;
(if idlwave-do-actions
- (mapc 'idlwave-do-action idlwave-indent-action-table))
+ (mapc #'idlwave-do-action idlwave-indent-action-table))
;;
;; No longer expand abbrevs on the line. The user can do this
;; manually using expand-region-abbrevs.
@@ -2781,18 +2750,19 @@ If the optional argument EXPAND is non-nil then the actions in
(defun idlwave-do-action (action)
"Perform an action repeatedly on a line.
ACTION is a list (REG . FUNC). REG is a regular expression. FUNC is
-either a function name to be called with `funcall' or a list to be
-evaluated with `eval'. The action performed by FUNC should leave
-point after the match for REG - otherwise an infinite loop may be
-entered. FUNC is always passed a final argument of `is-action', so it
+either a function which will be called with one argument `is-action' or
+a list to be evaluated with `eval'.
+The action performed by FUNC should leave point after the match for REG
+- otherwise an infinite loop may be entered.
+FUNC is always passed a final argument of `is-action', so it
can discriminate between being run as an action, or a key binding."
(let ((action-key (car action))
(action-routine (cdr action)))
(beginning-of-line)
(while (idlwave-look-at action-key)
- (if (listp action-routine)
- (eval (append action-routine '('is-action)))
- (funcall action-routine 'is-action)))))
+ (if (functionp action-routine)
+ (funcall action-routine 'is-action)
+ (eval (append action-routine '('is-action)) t)))))
(defun idlwave-indent-to (col &optional min)
"Indent from point with spaces until column COL.
@@ -3053,7 +3023,7 @@ Return value is the beginning of the match or (in case of failure) nil."
(let ((case-fold-search t)
(search-func (if (> dir 0) 're-search-forward 're-search-backward))
found)
- (idlwave-with-special-syntax
+ (with-syntax-table idlwave-find-symbol-syntax-table
(save-excursion
(catch 'exit
(while (funcall search-func key-re limit t)
@@ -3181,7 +3151,7 @@ If successful leaves point after the match, otherwise, does not move point."
(if cont (idlwave-end-of-statement) (end-of-line))
(point)))
found)
- (idlwave-with-special-syntax
+ (with-syntax-table idlwave-find-symbol-syntax-table
(if beg (idlwave-beginning-of-statement))
(while (and (setq found (re-search-forward regexp eos t))
(idlwave-quoted))))
@@ -3465,25 +3435,7 @@ if `idlwave-auto-fill-split-string' is non-nil."
(idlwave-indent-line))
)))))
-(defun idlwave-auto-fill-mode (arg)
- "Toggle auto-fill mode for IDL mode.
-With arg, turn auto-fill mode on if arg is positive.
-In auto-fill mode, inserting a space at a column beyond `fill-column'
-automatically breaks the line at a previous space."
- (interactive "P")
- (prog1 (set idlwave-fill-function
- (if (if (null arg)
- (not (symbol-value idlwave-fill-function))
- (> (prefix-numeric-value arg) 0))
- 'idlwave-auto-fill
- nil))
- ;; update mode-line
- (set-buffer-modified-p (buffer-modified-p))))
-
-;(defun idlwave-fill-routine-call ()
-; "Fill a routine definition or statement, indenting appropriately."
-; (let ((where (idlwave-where)))))
-
+(define-obsolete-function-alias 'idlwave-auto-fill-mode #'auto-fill-mode "28.1")
(defun idlwave-doc-header (&optional nomark)
"Insert a documentation header at the beginning of the unit.
@@ -3578,6 +3530,7 @@ Calling from a program, arguments are START END."
(defun idlwave-quoted ()
"Return t if point is in a comment or quoted string.
Returns nil otherwise."
+ ;; FIXME: Use (nth 8 (synx-ppss))!
(and (or (idlwave-in-comment) (idlwave-in-quote)) t))
(defun idlwave-in-quote ()
@@ -3858,7 +3811,7 @@ Intended for `after-save-hook'."
(setq idlwave-outlawed-buffers
(delq entry idlwave-outlawed-buffers)))
;; Remove this function from the hook.
- (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))
+ (remove-hook 'after-save-hook #'idlwave-revoke-license-to-kill 'local)))
(defvar idlwave-path-alist)
(defun idlwave-locate-lib-file (file)
@@ -4098,10 +4051,10 @@ blank lines."
(set (idlwave-sintern-set name 'class idlwave-sint-classes set))
(name)))
-(defun idlwave-sintern-dir (dir &optional set)
+(defun idlwave-sintern-dir (dir &optional _set)
(car (or (member dir idlwave-sint-dirs)
(setq idlwave-sint-dirs (cons dir idlwave-sint-dirs)))))
-(defun idlwave-sintern-libname (name &optional set)
+(defun idlwave-sintern-libname (name &optional _set)
(car (or (member name idlwave-sint-libnames)
(setq idlwave-sint-libnames (cons name idlwave-sint-libnames)))))
@@ -4169,7 +4122,7 @@ the base of the directory."
;; Creating new sintern tables
-(defun idlwave-new-sintern-type (tag)
+(defmacro idlwave-new-sintern-type (tag)
"Define a variable and a function to sintern the new type TAG.
This defines the function `idlwave-sintern-TAG' and the variable
`idlwave-sint-TAGs'."
@@ -4177,15 +4130,15 @@ This defines the function `idlwave-sintern-TAG' and the variable
(names (concat name "s"))
(var (intern (concat "idlwave-sint-" names)))
(func (intern (concat "idlwave-sintern-" name))))
- (set var nil) ; initial value of the association list
- (fset func ; set the function
- `(lambda (name &optional set)
- (cond ((not (stringp name)) name)
- ((cdr (assoc (downcase name) ,var)))
- (set
- (setq ,var (cons (cons (downcase name) name) ,var))
- name)
- (name))))))
+ `(progn
+ (defvar ,var nil) ; initial value of the association list
+ (defun ,func (name &optional set)
+ (cond ((not (stringp name)) name)
+ ((cdr (assoc (downcase name) ,var)))
+ (set
+ (push (cons (downcase name) name) ,var)
+ name)
+ (name))))))
(defun idlwave-reset-sintern-type (tag)
"Reset the sintern variable associated with TAG."
@@ -4296,12 +4249,12 @@ will re-read the catalog."
"-l" (expand-file-name "~/.emacs")
"-l" "idlwave"
"-f" "idlwave-rescan-catalog-directories"))
- (process (apply 'start-process "idlcat"
+ (process (apply #'start-process "idlcat"
nil emacs args)))
(setq idlwave-catalog-process process)
(set-process-sentinel
process
- (lambda (pro why)
+ (lambda (_pro why)
(when (string-match "finished" why)
(setq idlwave-routines nil
idlwave-system-routines nil
@@ -4449,7 +4402,7 @@ information updated immediately, leave NO-CONCATENATE nil."
(setq idlwave-load-rinfo-idle-timer
(run-with-idle-timer
idlwave-init-rinfo-when-idle-after
- nil 'idlwave-load-rinfo-next-step)))
+ nil #'idlwave-load-rinfo-next-step)))
(error nil))))
;;------ XML Help routine info system
@@ -4935,7 +4888,7 @@ Cache to disk for quick recovery."
(setq idlwave-load-rinfo-idle-timer
(run-with-idle-timer
idlwave-init-rinfo-when-idle-after
- nil 'idlwave-load-rinfo-next-step))))))
+ nil #'idlwave-load-rinfo-next-step))))))
(defvar idlwave-after-load-rinfo-hook nil)
@@ -5109,7 +5062,7 @@ Can run from `after-save-hook'."
(error nil)))
(push res routine-lists)))))
;; Concatenate the individual lists and return the result
- (apply 'nconc routine-lists)))
+ (apply #'nconc routine-lists)))
(defun idlwave-get-buffer-routine-info ()
"Scan the current buffer for routine info. Return (PRO-LIST FUNC-LIST)."
@@ -5185,10 +5138,10 @@ Can run from `after-save-hook'."
(if args
(concat
(if (string= type "function") "(" ", ")
- (mapconcat 'identity args ", ")
+ (mapconcat #'identity args ", ")
(if (string= type "function") ")" ""))))
(if keywords
- (cons nil (mapcar 'list keywords)) ;No help file
+ (cons nil (mapcar #'list keywords)) ;No help file
nil))))
@@ -5246,7 +5199,7 @@ as last time - so no widget will pop up."
(cons x (cdr path-entry))
(list x))))
(idlwave-expand-path idlwave-library-path))
- (mapcar 'list (idlwave-expand-path idlwave-library-path)))))
+ (mapcar #'list (idlwave-expand-path idlwave-library-path)))))
;; Ask the shell for the path and then run the widget
(t
@@ -5314,7 +5267,7 @@ directories and save the routine info.
(widget-insert " ")
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(let ((path-list (widget-get idlwave-widget :path-dirs)))
(dolist (x path-list)
(unless (memq 'lib (cdr x))
@@ -5324,7 +5277,7 @@ directories and save the routine info.
(widget-insert " ")
(widget-create 'push-button
:notify
- (lambda (&rest ignore)
+ (lambda (&rest _ignore)
(let ((path-list (widget-get idlwave-widget :path-dirs)))
(dolist (x path-list)
(idlwave-path-alist-remove-flag x 'user))
@@ -5332,7 +5285,7 @@ directories and save the routine info.
"Deselect All")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(kill-buffer (current-buffer)))
"Quit")
(widget-insert "\n\n")
@@ -5340,7 +5293,7 @@ directories and save the routine info.
(widget-insert "Select Directories: \n")
(setq idlwave-widget
- (apply 'widget-create
+ (apply #'widget-create
'checklist
:value (delq nil (mapcar (lambda (x)
(if (memq 'user (cdr x))
@@ -5352,7 +5305,8 @@ directories and save the routine info.
(list 'item
(if (memq 'lib (cdr x))
(concat "[LIB] " (car x) )
- (car x)))) dirs-list)))
+ (car x))))
+ dirs-list)))
(widget-put idlwave-widget :path-dirs dirs-list)
(widget-insert "\n")
(use-local-map widget-keymap)
@@ -5360,14 +5314,14 @@ directories and save the routine info.
(goto-char (point-min))
(delete-other-windows))
-(defun idlwave-delete-user-catalog-file (&rest ignore)
+(defun idlwave-delete-user-catalog-file (&rest _ignore)
(if (yes-or-no-p
(format "Delete file %s " idlwave-user-catalog-file))
(progn
(delete-file idlwave-user-catalog-file)
(message "%s has been deleted" idlwave-user-catalog-file))))
-(defun idlwave-widget-scan-user-lib-files (&rest ignore)
+(defun idlwave-widget-scan-user-lib-files (&rest _ignore)
;; Call `idlwave-scan-user-lib-files' with data taken from the widget.
(let* ((widget idlwave-widget)
(selected-dirs (widget-value widget))
@@ -5517,7 +5471,7 @@ be set to nil to disable library catalog scanning."
(let ((dirs
(if idlwave-library-path
(idlwave-expand-path idlwave-library-path)
- (mapcar 'car idlwave-path-alist)))
+ (mapcar #'car idlwave-path-alist)))
(old-libname "")
dir-entry dir catalog all-routines)
(if message-base (message "%s" message-base))
@@ -5730,11 +5684,10 @@ end
(defvar idlwave-completion-help-info nil)
(defvar idlwave-completion-help-links nil)
(defvar idlwave-current-obj_new-class nil)
-(defvar idlwave-complete-special nil)
-(defvar method-selector)
-(defvar class-selector)
-(defvar type-selector)
-(defvar super-classes)
+(defvar idlwave--method-selector)
+(defvar idlwave--class-selector)
+(defvar idlwave--type-selector)
+(defvar idlwave--super-classes)
(defun idlwave-complete (&optional arg module class)
"Complete a function, procedure or keyword name at point.
@@ -5815,8 +5768,7 @@ When we force a method or a method keyword, CLASS can specify the class."
(idlwave-complete-filename))
;; Check for any special completion functions
- ((and idlwave-complete-special
- (idlwave-call-special idlwave-complete-special)))
+ ((run-hook-with-args-until-success 'idlwave-complete-functions))
((null what)
(error "Nothing to complete here"))
@@ -5829,22 +5781,26 @@ When we force a method or a method keyword, CLASS can specify the class."
((eq what 'procedure)
;; Complete a procedure name
(let* ((cw-list (nth 3 where-list))
- (class-selector (idlwave-determine-class cw-list 'pro))
- (super-classes (unless (idlwave-explicit-class-listed cw-list)
- (idlwave-all-class-inherits class-selector)))
- (isa (concat "procedure" (if class-selector "-method" "")))
- (type-selector 'pro))
+ (idlwave--class-selector (idlwave-determine-class cw-list 'pro))
+ (idlwave--super-classes
+ (unless (idlwave-explicit-class-listed cw-list)
+ (idlwave-all-class-inherits idlwave--class-selector)))
+ (isa (concat "procedure"
+ (if idlwave--class-selector "-method" "")))
+ (idlwave--type-selector 'pro))
(setq idlwave-completion-help-info
- (list 'routine nil type-selector class-selector nil super-classes))
+ (list 'routine nil
+ idlwave--type-selector idlwave--class-selector
+ nil idlwave--super-classes))
(idlwave-complete-in-buffer
- 'procedure (if class-selector 'method 'routine)
+ 'procedure (if idlwave--class-selector 'method 'routine)
(idlwave-routines) 'idlwave-selector
(format "Select a %s name%s"
isa
- (if class-selector
+ (if idlwave--class-selector
(format " (class is %s)"
- (if (eq class-selector t)
- "unknown" class-selector))
+ (if (eq idlwave--class-selector t)
+ "unknown" idlwave--class-selector))
""))
isa
'idlwave-attach-method-classes 'idlwave-add-file-link-selector)))
@@ -5852,22 +5808,25 @@ When we force a method or a method keyword, CLASS can specify the class."
((eq what 'function)
;; Complete a function name
(let* ((cw-list (nth 3 where-list))
- (class-selector (idlwave-determine-class cw-list 'fun))
- (super-classes (unless (idlwave-explicit-class-listed cw-list)
- (idlwave-all-class-inherits class-selector)))
- (isa (concat "function" (if class-selector "-method" "")))
- (type-selector 'fun))
+ (idlwave--class-selector (idlwave-determine-class cw-list 'fun))
+ (idlwave--super-classes
+ (unless (idlwave-explicit-class-listed cw-list)
+ (idlwave-all-class-inherits idlwave--class-selector)))
+ (isa (concat "function" (if idlwave--class-selector "-method" "")))
+ (idlwave--type-selector 'fun))
(setq idlwave-completion-help-info
- (list 'routine nil type-selector class-selector nil super-classes))
+ (list 'routine nil
+ idlwave--type-selector idlwave--class-selector
+ nil idlwave--super-classes))
(idlwave-complete-in-buffer
- 'function (if class-selector 'method 'routine)
+ 'function (if idlwave--class-selector 'method 'routine)
(idlwave-routines) 'idlwave-selector
(format "Select a %s name%s"
isa
- (if class-selector
+ (if idlwave--class-selector
(format " (class is %s)"
- (if (eq class-selector t)
- "unknown" class-selector))
+ (if (eq idlwave--class-selector t)
+ "unknown" idlwave--class-selector))
""))
isa
'idlwave-attach-method-classes 'idlwave-add-file-link-selector)))
@@ -5880,11 +5839,12 @@ When we force a method or a method keyword, CLASS can specify the class."
;; Complete a procedure keyword
(let* ((where (nth 3 where-list))
(name (car where))
- (method-selector name)
- (type-selector 'pro)
+ (idlwave--method-selector name)
+ (idlwave--type-selector 'pro)
(class (idlwave-determine-class where 'pro))
- (class-selector class)
- (super-classes (idlwave-all-class-inherits class-selector))
+ (idlwave--class-selector class)
+ (idlwave--super-classes (idlwave-all-class-inherits
+ idlwave--class-selector))
(isa (format "procedure%s-keyword" (if class "-method" "")))
(entry (idlwave-best-rinfo-assq
name 'pro class (idlwave-routines)))
@@ -5894,11 +5854,13 @@ When we force a method or a method keyword, CLASS can specify the class."
(error "Nothing known about procedure %s"
(idlwave-make-full-name class name)))
(setq list (idlwave-fix-keywords name 'pro class list
- super-classes system))
+ idlwave--super-classes system))
(unless list (error "No keywords available for procedure %s"
(idlwave-make-full-name class name)))
(setq idlwave-completion-help-info
- (list 'keyword name type-selector class-selector entry super-classes))
+ (list 'keyword name
+ idlwave--type-selector idlwave--class-selector
+ entry idlwave--super-classes))
(idlwave-complete-in-buffer
'keyword 'keyword list nil
(format "Select keyword for procedure %s%s"
@@ -5913,11 +5875,12 @@ When we force a method or a method keyword, CLASS can specify the class."
;; Complete a function keyword
(let* ((where (nth 3 where-list))
(name (car where))
- (method-selector name)
- (type-selector 'fun)
+ (idlwave--method-selector name)
+ (idlwave--type-selector 'fun)
(class (idlwave-determine-class where 'fun))
- (class-selector class)
- (super-classes (idlwave-all-class-inherits class-selector))
+ (idlwave--class-selector class)
+ (idlwave--super-classes (idlwave-all-class-inherits
+ idlwave--class-selector))
(isa (format "function%s-keyword" (if class "-method" "")))
(entry (idlwave-best-rinfo-assq
name 'fun class (idlwave-routines)))
@@ -5928,7 +5891,7 @@ When we force a method or a method keyword, CLASS can specify the class."
(error "Nothing known about function %s"
(idlwave-make-full-name class name)))
(setq list (idlwave-fix-keywords name 'fun class list
- super-classes system))
+ idlwave--super-classes system))
;; OBJ_NEW: Messages mention the proper Init method
(setq msg-name (if (and (null class)
(string= (upcase name) "OBJ_NEW"))
@@ -5938,7 +5901,9 @@ When we force a method or a method keyword, CLASS can specify the class."
(unless list (error "No keywords available for function %s"
msg-name))
(setq idlwave-completion-help-info
- (list 'keyword name type-selector class-selector nil super-classes))
+ (list 'keyword name
+ idlwave--type-selector idlwave--class-selector
+ nil idlwave--super-classes))
(idlwave-complete-in-buffer
'keyword 'keyword list nil
(format "Select keyword for function %s%s" msg-name
@@ -5950,7 +5915,9 @@ When we force a method or a method keyword, CLASS can specify the class."
(t (error "This should not happen (idlwave-complete)")))))
-(defvar idlwave-complete-special nil
+(define-obsolete-variable-alias 'idlwave-complete-special
+ 'idlwave-complete-functions "28.1")
+(defvar idlwave-complete-functions nil
"List of special completion functions.
These functions are called for each completion. Each function must
check if its own special completion context is present. If yes, it
@@ -5960,6 +5927,7 @@ complete other contexts will be done. If the function returns nil,
other completions will be tried.")
(defun idlwave-call-special (functions &rest args)
+ (declare (obsolete run-hook-with-args-until-success "28.1"))
(let ((funcs functions)
fun ret)
(catch 'exit
@@ -6002,9 +5970,9 @@ other completions will be tried.")
(list nil-list nil-list 'procedure nil-list nil))
((eq what 'procedure-keyword)
- (let* ((class-selector nil)
- (super-classes nil)
- (type-selector 'pro)
+ (let* ((idlwave--class-selector nil)
+ (idlwave--super-classes nil)
+ (idlwave--type-selector 'pro)
(pro (or module
(idlwave-completing-read
"Procedure: " (idlwave-routines) 'idlwave-selector))))
@@ -6016,9 +5984,9 @@ other completions will be tried.")
(list nil-list nil-list 'function nil-list nil))
((eq what 'function-keyword)
- (let* ((class-selector nil)
- (super-classes nil)
- (type-selector 'fun)
+ (let* ((idlwave--class-selector nil)
+ (idlwave--super-classes nil)
+ (idlwave--type-selector 'fun)
(func (or module
(idlwave-completing-read
"Function: " (idlwave-routines) 'idlwave-selector))))
@@ -6031,12 +5999,14 @@ other completions will be tried.")
((eq what 'procedure-method-keyword)
(let* ((class (idlwave-determine-class class-list 'pro))
- (class-selector class)
- (super-classes (idlwave-all-class-inherits class-selector))
- (type-selector 'pro)
+ (idlwave--class-selector class)
+ (idlwave--super-classes (idlwave-all-class-inherits
+ idlwave--class-selector))
+ (idlwave--type-selector 'pro)
(pro (or module
(idlwave-completing-read
- (format "Procedure in %s class: " class-selector)
+ (format "Procedure in %s class: "
+ idlwave--class-selector)
(idlwave-routines) 'idlwave-selector))))
(setq pro (idlwave-sintern-method pro))
(list nil-list nil-list 'procedure-keyword
@@ -6047,12 +6017,14 @@ other completions will be tried.")
((eq what 'function-method-keyword)
(let* ((class (idlwave-determine-class class-list 'fun))
- (class-selector class)
- (super-classes (idlwave-all-class-inherits class-selector))
- (type-selector 'fun)
+ (idlwave--class-selector class)
+ (idlwave--super-classes (idlwave-all-class-inherits
+ idlwave--class-selector))
+ (idlwave--type-selector 'fun)
(func (or module
(idlwave-completing-read
- (format "Function in %s class: " class-selector)
+ (format "Function in %s class: "
+ idlwave--class-selector)
(idlwave-routines) 'idlwave-selector))))
(setq func (idlwave-sintern-method func))
(list nil-list nil-list 'function-keyword
@@ -6069,14 +6041,14 @@ other completions will be tried.")
(unwind-protect
(progn
(setq-default completion-ignore-case t)
- (apply 'completing-read args))
+ (apply #'completing-read args))
(setq-default completion-ignore-case old-value))))
(defvar idlwave-shell-default-directory)
(defun idlwave-complete-filename ()
"Use the comint stuff to complete a file name."
(require 'comint)
- (let* ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-")
+ (dlet ((comint-file-name-chars "~/A-Za-z0-9+@:_.$#%={}\\-")
(comint-completion-addsuffix nil)
(default-directory
(if (and (boundp 'idlwave-shell-default-directory)
@@ -6110,7 +6082,7 @@ other completions will be tried.")
(defun idlwave-rinfo-assq-any-class (name type class list)
;; Return the first matching method on the inheritance list
(let* ((classes (cons class (idlwave-all-class-inherits class)))
- class rtn)
+ rtn) ;; class
(while classes
(if (setq rtn (idlwave-rinfo-assq name type (pop classes) list))
(setq classes nil)))
@@ -6127,7 +6099,7 @@ syslib files."
list))
syslibp)
(when (> (length twins) 1)
- (setq twins (sort twins 'idlwave-routine-entry-compare-twins))
+ (setq twins (sort twins #'idlwave-routine-entry-compare-twins))
(if (and (null keep-system)
(eq 'system (car (nth 3 (car twins))))
(setq syslibp (idlwave-any-syslib (cdr twins)))
@@ -6174,7 +6146,7 @@ If yes, return the index (>=1)."
TYPE is `fun' or `pro'.
When TYPE is not specified, both procedures and functions will be considered."
(if (null method)
- (mapcar 'car (idlwave-class-alist))
+ (mapcar #'car (idlwave-class-alist))
(let (rtn)
(mapc (lambda (x)
(and (nth 2 x)
@@ -6228,9 +6200,11 @@ INFO is as returned by `idlwave-what-function' or `-procedure'."
(save-excursion (goto-char apos)
(looking-at "->[a-zA-Z][a-zA-Z0-9$_]*::")))))
-(defvar idlwave-determine-class-special nil
- "List of special functions for determining class.
-Must accept two arguments: `apos' and `info'.")
+(define-obsolete-variable-alias 'idlwave-determine-class-special
+ 'idlwave-determine-class-functions "28.1")
+(defvar idlwave-determine-class-functions nil
+ "Special hook to determine a class.
+The functions should accept one argument, APOS.")
(defun idlwave-determine-class (info type)
;; Determine the class of a routine call.
@@ -6275,10 +6249,10 @@ Must accept two arguments: `apos' and `info'.")
;; Before prompting, try any special class determination routines
(when (and (eq t class)
- idlwave-determine-class-special
(not force-query))
(setq special-class
- (idlwave-call-special idlwave-determine-class-special apos))
+ (run-hook-with-args-until-success
+ 'idlwave-determine-class-functions apos))
(if special-class
(setq class (idlwave-sintern-class special-class)
store idlwave-store-inquired-class)))
@@ -6287,7 +6261,7 @@ Must accept two arguments: `apos' and `info'.")
(when (and (eq class t)
(or force-query query))
(setq class-alist
- (mapcar 'list (idlwave-all-method-classes (car info) type)))
+ (mapcar #'list (idlwave-all-method-classes (car info) type)))
(setq class
(idlwave-sintern-class
(cond
@@ -6321,10 +6295,10 @@ Must accept two arguments: `apos' and `info'.")
(t class))))
(defun idlwave-selector (a)
- (and (eq (nth 1 a) type-selector)
- (or (and (nth 2 a) (eq class-selector t))
- (eq (nth 2 a) class-selector)
- (memq (nth 2 a) super-classes))))
+ (and (eq (nth 1 a) idlwave--type-selector)
+ (or (and (nth 2 a) (eq idlwave--class-selector t))
+ (eq (nth 2 a) idlwave--class-selector)
+ (memq (nth 2 a) idlwave--super-classes))))
(defun idlwave-add-file-link-selector (a)
;; Record a file link, if any, for the tested names during selection.
@@ -6442,7 +6416,7 @@ ARROW: Location of the arrow"
func-point
(cnt 0)
func arrow-start class)
- (idlwave-with-special-syntax
+ (with-syntax-table idlwave-find-symbol-syntax-table
(save-restriction
(save-excursion
(narrow-to-region (max 1 (or bound 0)) (point-max))
@@ -6472,7 +6446,7 @@ ARROW: Location of the arrow"
(goto-char pos))
(throw 'exit nil)))))))
-(defun idlwave-what-procedure (&optional bound)
+(defun idlwave-what-procedure (&optional _bound)
;; Find out if point is within the argument list of a procedure.
;; The return value is ("procedure-name" class arrow-pos (point)).
@@ -6562,10 +6536,10 @@ This function is not general, can only be used for completion stuff."
(throw 'exit nil)))
(t (throw 'exit (preceding-char))))))))
-(defvar idlwave-complete-after-success-form nil
- "A form to evaluate after successful completion.")
-(defvar idlwave-complete-after-success-form-force nil
- "A form to evaluate after completion selection in *Completions* buffer.")
+(defvar idlwave--complete-after-success-function #'ignore
+ "A function to evaluate after successful completion.")
+(defvar idlwave--complete-after-success-force-function #'ignore
+ "A function to evaluate after completion selection in *Completions* buffer.")
(defconst idlwave-completion-mark (make-marker)
"A mark pointing to the beginning of the completion string.")
@@ -6590,12 +6564,12 @@ accumulate information on matching completions."
(skip-chars-backward "a-zA-Z0-9_$")
(setq slash (eq (preceding-char) ?/)
beg (point)
- idlwave-complete-after-success-form
- (list 'idlwave-after-successful-completion
- (list 'quote type) slash beg)
- idlwave-complete-after-success-form-force
- (list 'idlwave-after-successful-completion
- (list 'quote type) slash (list 'quote 'force))))
+ idlwave--complete-after-success-function
+ (lambda () (idlwave-after-successful-completion
+ type slash beg))
+ idlwave--complete-after-success-force-function
+ (lambda () (idlwave-after-successful-completion
+ type slash 'force))))
;; Try a completion
(setq part (buffer-substring beg end)
@@ -6699,19 +6673,20 @@ accumulate information on matching completions."
;; 'class-tag, for class tags, and otherwise for methods.
;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.
(if (or (null show-classes) ; don't want to see classes
- (null class-selector) ; not a method call
+ (null idlwave--class-selector) ; not a method call
(and
- (stringp class-selector) ; the class is already known
- (not super-classes))) ; no possibilities for inheritance
+ (stringp idlwave--class-selector) ; the class is already known
+ (not idlwave--super-classes))) ; no possibilities for inheritance
;; In these cases, we do not have to do anything
list
(let* ((do-prop (>= show-classes 0))
(do-buf (not (= show-classes 0)))
- (do-dots t)
- (inherit (if (and (not (eq type 'class-tag)) super-classes)
- (cons class-selector super-classes)))
+ ;; (do-dots t)
+ (inherit (if (and (not (eq type 'class-tag)) idlwave--super-classes)
+ (cons idlwave--class-selector idlwave--super-classes)))
(max (abs show-classes))
- (lmax (if do-dots (apply 'max (mapcar 'length list))))
+ (lmax ;; (if do-dots
+ (apply #'max (mapcar #'length list))) ;;)
classes nclasses class-info space)
(mapcar
(lambda (x)
@@ -6720,13 +6695,14 @@ accumulate information on matching completions."
;; Just one class for tags
(setq classes
(list
- (idlwave-class-or-superclass-with-tag class-selector x)))
+ (idlwave-class-or-superclass-with-tag
+ idlwave--class-selector x)))
;; Multiple classes for method or method-keyword
(setq classes
(if (eq type 'kwd)
(idlwave-all-method-keyword-classes
- method-selector x type-selector)
- (idlwave-all-method-classes x type-selector)))
+ idlwave--method-selector x idlwave--type-selector)
+ (idlwave-all-method-classes x idlwave--type-selector)))
(if inherit
(setq classes
(delq nil
@@ -6734,22 +6710,22 @@ accumulate information on matching completions."
classes)))))
(setq nclasses (length classes))
;; Make the separator between item and class-info
- (if do-dots
- (setq space (concat " " (make-string (- lmax (length x)) ?.)))
- (setq space " "))
+ ;; (if do-dots
+ (setq space (concat " " (make-string (- lmax (length x)) ?.)))
+ ;; (setq space " "))
(if do-buf
;; We do want info in the buffer
(if (<= nclasses max)
(setq class-info (concat
space
- "<" (mapconcat 'identity classes ",") ">"))
+ "<" (mapconcat #'identity classes ",") ">"))
(setq class-info (format "%s<%d classes>" space nclasses)))
(setq class-info nil))
(when do-prop
;; We do want properties
(setq x (copy-sequence x))
(put-text-property 0 (length x)
- 'help-echo (mapconcat 'identity classes " ")
+ 'help-echo (mapconcat #'identity classes " ")
x))
(if class-info
(list x class-info)
@@ -6839,7 +6815,7 @@ sort the list before displaying."
(nth 2 last-command))
(progn
(select-window win)
- (eval idlwave-complete-after-success-form))
+ (funcall idlwave--complete-after-success-function))
(set-window-start cwin (point-min)))))
(and message (message "%s" message)))
(select-window win))))
@@ -6882,7 +6858,7 @@ sort the list before displaying."
(skip-chars-backward "a-zA-Z0-9_")
(point))))
(remove-text-properties beg (point) '(face nil))))
- (eval idlwave-complete-after-success-form-force))
+ (funcall idlwave--complete-after-success-force-function))
(defun idlwave-keyboard-quit ()
(interactive)
@@ -6990,16 +6966,15 @@ If these don't exist, a letter in the string is automatically selected."
(defun idlwave-local-value (var &optional buffer)
"Return the value of VAR in BUFFER, but only if VAR is local to BUFFER."
- (with-current-buffer (or buffer (current-buffer))
- (and (local-variable-p var (current-buffer))
- (symbol-value var))))
+ (when (local-variable-p var buffer)
+ (buffer-local-value var (or buffer (current-buffer)))))
(defvar idlwave-completion-map nil
"Keymap for `completion-list-mode' with `idlwave-complete'.")
-(defun idlwave-default-choose-completion (&rest args)
- "Execute `default-choose-completion' and then restore the win-conf."
- (apply 'idlwave-choose 'default-choose-completion args))
+;; (defun idlwave-default-choose-completion (&rest args)
+;; "Execute `default-choose-completion' and then restore the win-conf."
+;; (apply #'idlwave-choose #'default-choose-completion args))
(define-obsolete-function-alias 'idlwave-display-completion-list-emacs
#'idlwave-display-completion-list-1 "28.1")
@@ -7021,14 +6996,14 @@ If these don't exist, a letter in the string is automatically selected."
"Replace `choose-completion' in OLD-MAP."
(let ((new-map (copy-keymap old-map)))
(substitute-key-definition
- 'choose-completion 'idlwave-choose-completion new-map)
- (define-key new-map [mouse-3] 'idlwave-mouse-completion-help)
+ #'choose-completion #'idlwave-choose-completion new-map)
+ (define-key new-map [mouse-3] #'idlwave-mouse-completion-help)
new-map))
(defun idlwave-choose-completion (&rest args)
"Choose the completion that point is in or next to."
(interactive (list last-nonmenu-event))
- (apply 'idlwave-choose 'choose-completion args))
+ (apply #'idlwave-choose #'choose-completion args))
(define-obsolete-function-alias 'idlwave-mouse-choose-completion
#'idlwave-choose-completion "28.1")
@@ -7278,8 +7253,8 @@ class/struct definition."
(defun idlwave-all-class-tags (class)
"Return a list of native and inherited tags in CLASS."
(condition-case err
- (apply 'append (mapcar 'idlwave-class-tags
- (cons class (idlwave-all-class-inherits class))))
+ (apply #'append (mapcar #'idlwave-class-tags
+ (cons class (idlwave-all-class-inherits class))))
(error
(idlwave-class-tag-reset)
(error "%s" (error-message-string err)))))
@@ -7369,10 +7344,9 @@ property indicating the link is added."
(defvar idlwave-current-class-tags nil)
(defvar idlwave-current-native-class-tags nil)
(defvar idlwave-sint-class-tags nil)
-(declare-function idlwave-sintern-class-tag "idlwave" t t)
-(idlwave-new-sintern-type 'class-tag)
-(add-to-list 'idlwave-complete-special 'idlwave-complete-class-structure-tag)
-(add-hook 'idlwave-update-rinfo-hook 'idlwave-class-tag-reset)
+(idlwave-new-sintern-type class-tag)
+(add-hook 'idlwave-complete-functions #'idlwave-complete-class-structure-tag)
+(add-hook 'idlwave-update-rinfo-hook #'idlwave-class-tag-reset)
(defun idlwave-complete-class-structure-tag ()
"Complete a structure tag on a `self' argument in an object method."
@@ -7384,25 +7358,26 @@ property indicating the link is added."
(skip-chars-backward "a-zA-Z0-9._$")
(and (< (point) (- pos 4))
(looking-at "self\\.")))
- (let* ((class-selector (nth 2 (idlwave-current-routine)))
- (super-classes (idlwave-all-class-inherits class-selector)))
+ (let* ((idlwave--class-selector (nth 2 (idlwave-current-routine)))
+ (idlwave--super-classes (idlwave-all-class-inherits
+ idlwave--class-selector)))
;; Check if we are in a class routine
- (unless class-selector
+ (unless idlwave--class-selector
(error "Not in a method procedure or function"))
;; Check if we need to update the "current" class
- (if (not (equal class-selector idlwave-current-tags-class))
- (idlwave-prepare-class-tag-completion class-selector))
+ (if (not (equal idlwave--class-selector idlwave-current-tags-class))
+ (idlwave-prepare-class-tag-completion idlwave--class-selector))
(setq idlwave-completion-help-info
(list 'idlwave-complete-class-structure-tag-help
(idlwave-sintern-routine
- (concat class-selector "__define"))
+ (concat idlwave--class-selector "__define"))
nil))
;; FIXME: idlwave-cpl-bold doesn't seem used anywhere.
- (let ((idlwave-cpl-bold idlwave-current-native-class-tags))
+ (let ((_idlwave-cpl-bold idlwave-current-native-class-tags))
(idlwave-complete-in-buffer
'class-tag 'class-tag
idlwave-current-class-tags nil
- (format "Select a tag of class %s" class-selector)
+ (format "Select a tag of class %s" idlwave--class-selector)
"class tag"
'idlwave-attach-class-tag-classes))
t) ; return t to skip other completions
@@ -7420,7 +7395,7 @@ property indicating the link is added."
(list (idlwave-sintern-class-tag x 'set)))
(idlwave-all-class-tags class)))
(setq idlwave-current-native-class-tags
- (mapcar 'downcase (idlwave-class-tags class))))
+ (mapcar #'downcase (idlwave-class-tags class))))
;===========================================================================
;;
@@ -7429,13 +7404,11 @@ property indicating the link is added."
(defvar idlwave-sint-sysvars nil)
(defvar idlwave-sint-sysvartags nil)
-(declare-function idlwave-sintern-sysvar "idlwave" t t)
-(declare-function idlwave-sintern-sysvartag "idlwave" t t)
-(idlwave-new-sintern-type 'sysvar)
-(idlwave-new-sintern-type 'sysvartag)
-(add-to-list 'idlwave-complete-special 'idlwave-complete-sysvar-or-tag)
-(add-hook 'idlwave-update-rinfo-hook 'idlwave-sysvars-reset)
-(add-hook 'idlwave-after-load-rinfo-hook 'idlwave-sintern-sysvar-alist)
+(idlwave-new-sintern-type sysvar)
+(idlwave-new-sintern-type sysvartag)
+(add-hook 'idlwave-complete-functions #'idlwave-complete-sysvar-or-tag)
+(add-hook 'idlwave-update-rinfo-hook #'idlwave-sysvars-reset)
+(add-hook 'idlwave-after-load-rinfo-hook #'idlwave-sintern-sysvar-alist)
(defun idlwave-complete-sysvar-or-tag ()
@@ -7591,7 +7564,7 @@ associated TAG, if any."
(let ((text idlwave-shell-command-output)
(start 0)
(old idlwave-system-variables-alist)
- var tags type name class link old-entry)
+ var tags link old-entry) ;; type name class
(setq idlwave-system-variables-alist nil)
(while (string-match "^IDLWAVE-SYSVAR: !\\([a-zA-Z0-9_$]+\\)\\( \\(.*\\)\\)?"
text start)
@@ -7611,7 +7584,8 @@ associated TAG, if any."
(cdr (assq
(idlwave-sintern-sysvartag x)
(cdr (assq 'tags old-entry))))))
- tags)) link)
+ tags))
+ link)
idlwave-system-variables-alist)))
;; Keep the old value if query was not successful
(setq idlwave-system-variables-alist
@@ -7627,15 +7601,6 @@ associated TAG, if any."
(put-text-property (match-beginning 0) (match-end 0)
'face 'font-lock-string-face))))))
-(defun idlwave-uniquify (list)
- (let ((ht (make-hash-table :size (length list) :test 'equal)))
- (delq nil
- (mapcar (lambda (x)
- (unless (gethash x ht)
- (puthash x t ht)
- x))
- list))))
-
(defun idlwave-after-successful-completion (type slash &optional verify)
"Add `=' or `(' after successful completion of keyword and function.
Restore the pre-completion window configuration if possible."
@@ -7700,7 +7665,7 @@ itself."
(setq this-command last-command)
(idlwave-do-mouse-completion-help ev))
-(defun idlwave-routine-info (&optional arg external)
+(defun idlwave-routine-info (&optional arg _external)
"Display a routines calling sequence and list of keywords.
When point is on the name a function or procedure, or in the argument
list of a function or procedure, this command displays a help buffer with
@@ -7712,9 +7677,9 @@ arg, the class property is cleared out."
(interactive "P")
(idlwave-routines)
- (if (string-match "->" (buffer-substring
- (max (point-min) (1- (point)))
- (min (+ 2 (point)) (point-max))))
+ (if (string-search "->" (buffer-substring
+ (max (point-min) (1- (point)))
+ (min (+ 2 (point)) (point-max))))
;; Cursor is on an arrow
(if (get-text-property (point) 'idlwave-class)
;; arrow has class property
@@ -7737,7 +7702,7 @@ arg, the class property is cleared out."
(idlwave-force-class-query (equal arg '(4)))
(module (idlwave-what-module)))
(if (car module)
- (apply 'idlwave-display-calling-sequence
+ (apply #'idlwave-display-calling-sequence
(idlwave-fix-module-if-obj_new module))
(error "Don't know which calling sequence to show")))))
@@ -7820,7 +7785,7 @@ force class query for object methods."
(name (idlwave-completing-read
(if (or (not this-buffer)
(assoc default list))
- (format "Module (Default %s): " default)
+ (format-prompt "Module" default)
(format "Module in this file: "))
list))
type class)
@@ -7954,7 +7919,7 @@ Used by `idlwave-routine-info' and `idlwave-find-module'."
(stringp class))
(list (car module)
(nth 1 module)
- (apply 'idlwave-find-inherited-class module))
+ (apply #'idlwave-find-inherited-class module))
module)))
(defun idlwave-find-inherited-class (name type class)
@@ -7979,7 +7944,7 @@ appropriate Init method."
(setq string (buffer-substring (point) pos))
(string-match "obj_new([^'\"]*['\"]\\([a-zA-Z0-9_]+\\)"
string)))
- (let ((name "Init")
+ (let (;; (name "Init")
(class (match-string 1 string)))
(setq module (list (idlwave-sintern-method "Init")
'fun
@@ -7992,7 +7957,8 @@ appropriate Init method."
Translate OBJ_NEW, adding all super-class keywords, or all keywords
from all classes if CLASS equals t. If SYSTEM is non-nil, don't
demand _EXTRA in the keyword list."
- (let ((case-fold-search t))
+ (let ((case-fold-search t)
+ (idlwave--super-classes super-classes))
;; If this is the OBJ_NEW function, try to figure out the class and use
;; the keywords from the corresponding INIT method.
@@ -8013,7 +7979,8 @@ demand _EXTRA in the keyword list."
(idlwave-sintern-method "INIT")
'fun
class
- (idlwave-routines)) 'do-link))))))
+ (idlwave-routines))
+ 'do-link))))))
;; If the class is t, combine all keywords of all methods NAME
(when (eq class t)
@@ -8030,7 +7997,7 @@ demand _EXTRA in the keyword list."
;; If we have inheritance, add all keywords from superclasses, if
;; the user indicated that method in `idlwave-keyword-class-inheritance'
(when (and
- super-classes
+ idlwave--super-classes
idlwave-keyword-class-inheritance
(stringp class)
(or
@@ -8045,7 +8012,7 @@ demand _EXTRA in the keyword list."
(cl-loop for entry in (idlwave-routines) do
(and (nth 2 entry) ; non-nil class
- (memq (nth 2 entry) super-classes) ; an inherited class
+ (memq (nth 2 entry) idlwave--super-classes) ;an inherited class
(eq (nth 1 entry) type) ; correct type
(eq (car entry) name) ; correct name
(mapc (lambda (k) (add-to-list 'keywords k))
@@ -8095,16 +8062,16 @@ If we do not know about MODULE, just return KEYWORD literally."
(defvar idlwave-rinfo-mouse-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'idlwave-mouse-active-rinfo)
- (define-key map [(shift mouse-2)] 'idlwave-mouse-active-rinfo-shift)
- (define-key map [mouse-3] 'idlwave-mouse-active-rinfo-right)
- (define-key map " " 'idlwave-active-rinfo-space)
- (define-key map "q" 'idlwave-quit-help)
+ (define-key map [mouse-2] #'idlwave-mouse-active-rinfo)
+ (define-key map [(shift mouse-2)] #'idlwave-mouse-active-rinfo-shift)
+ (define-key map [mouse-3] #'idlwave-mouse-active-rinfo-right)
+ (define-key map " " #'idlwave-active-rinfo-space)
+ (define-key map "q" #'idlwave-quit-help)
map))
(defvar idlwave-rinfo-map
(let ((map (make-sparse-keymap)))
- (define-key map "q" 'idlwave-quit-help)
+ (define-key map "q" #'idlwave-quit-help)
map))
(defvar idlwave-popup-source nil)
@@ -8151,7 +8118,7 @@ If we do not know about MODULE, just return KEYWORD literally."
(data (list name type class (current-buffer) nil initial-class))
(face 'idlwave-help-link)
beg props win cnt total)
- ;; Fix keywords, but don't add chained super-classes, since these
+ ;; Fix keywords, but don't add chained idlwave--super-classes, since these
;; are shown separately for that super-class
(setq keywords (idlwave-fix-keywords name type class keywords))
(cond
@@ -8336,7 +8303,7 @@ to it."
(add-text-properties beg (point) (list 'face 'bold)))
(when (and file (not (equal file "")))
(setq beg (point))
- (insert (apply 'abbreviate-file-name (list file)))
+ (insert (apply #'abbreviate-file-name (list file)))
(if file-props
(add-text-properties beg (point) file-props)))))
@@ -8441,9 +8408,9 @@ was pressed."
idlwave-keyword-completion-adds-equal)
(insert "=")))))
-(defun idlwave-list-buffer-load-path-shadows (&optional arg)
+(defun idlwave-list-buffer-load-path-shadows (&optional _arg)
"List the load path shadows of all routines defined in current buffer."
- (interactive "P")
+ (interactive)
(idlwave-routines)
(if (derived-mode-p 'idlwave-mode)
(idlwave-list-load-path-shadows
@@ -8451,13 +8418,13 @@ was pressed."
"in current buffer")
(error "Current buffer is not in idlwave-mode")))
-(defun idlwave-list-shell-load-path-shadows (&optional arg)
+(defun idlwave-list-shell-load-path-shadows (&optional _arg)
"List the load path shadows of all routines compiled under the shell.
This is very useful for checking an IDL application. Just compile the
application, do RESOLVE_ALL, and `C-c C-i' to compile all referenced
routines and update IDLWAVE internal info. Then check for shadowing
with this command."
- (interactive "P")
+ (interactive)
(cond
((or (not (fboundp 'idlwave-shell-is-running))
(not (idlwave-shell-is-running)))
@@ -8468,15 +8435,15 @@ with this command."
(idlwave-list-load-path-shadows nil idlwave-compiled-routines
"in the shell"))))
-(defun idlwave-list-all-load-path-shadows (&optional arg)
+(defun idlwave-list-all-load-path-shadows (&optional _arg)
"List the load path shadows of all routines known to IDLWAVE."
- (interactive "P")
+ (interactive)
(idlwave-list-load-path-shadows nil nil "globally"))
(defvar idlwave-sort-prefer-buffer-info t
"Internal variable used to influence `idlwave-routine-twin-compare'.")
-(defun idlwave-list-load-path-shadows (arg &optional special-routines loc)
+(defun idlwave-list-load-path-shadows (_arg &optional special-routines loc)
"List the routines which are defined multiple times.
Search the information IDLWAVE has about IDL routines for multiple
definitions.
@@ -8525,12 +8492,12 @@ can be used to detect possible name clashes during this process."
(lambda (ev)
(interactive "e")
(mouse-set-point ev)
- (apply 'idlwave-do-find-module
+ (apply #'idlwave-do-find-module
(get-text-property (point) 'find-args))))
(define-key keymap [(return)]
(lambda ()
(interactive)
- (apply 'idlwave-do-find-module
+ (apply #'idlwave-do-find-module
(get-text-property (point) 'find-args))))
(message "Compiling list...( 0%%)")
(with-current-buffer (get-buffer-create "*Shadows*")
@@ -8606,6 +8573,10 @@ ENTRY will also be returned, as the first item of this list."
(push candidate twins))
(cons entry (nreverse twins))))
+;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins.
+(defvar idlwave-twin-class)
+(defvar idlwave-twin-name)
+
(defun idlwave-study-twins (entries)
"Return dangerous twins of first entry in ENTRIES.
Dangerous twins are routines with same name, but in different files on
@@ -8618,7 +8589,7 @@ routines, and may have been scanned."
(type (nth 1 entry)) ; Must be bound for
(idlwave-twin-class (nth 2 entry)) ; idlwave-routine-twin-compare
(cnt 0)
- source type type-cons file alist syslibp key)
+ source type-cons file alist syslibp key)
(while (setq entry (pop entries))
(cl-incf cnt)
(setq source (nth 3 entry)
@@ -8654,12 +8625,12 @@ routines, and may have been scanned."
(when (and (idlwave-syslib-scanned-p)
(setq entry (assoc 'system alist)))
(setcar entry 'builtin))
- (sort alist 'idlwave-routine-twin-compare)))
+ (sort alist #'idlwave-routine-twin-compare)))
;; FIXME: Dynamically scoped vars need to use the `idlwave-' prefix.
;; (defvar type)
-(define-obsolete-function-alias 'idlwave-xor 'xor "27.1")
+(define-obsolete-function-alias 'idlwave-xor #'xor "27.1")
(defun idlwave-routine-entry-compare (a b)
"Compare two routine info entries for sorting.
@@ -8690,7 +8661,7 @@ names and path locations."
"Compare two routine entries, under the assumption that they are twins.
This basically calls `idlwave-routine-twin-compare' with the correct args."
(let* ((idlwave-twin-name (car a))
- (type (nth 1 a))
+ ;; (type (nth 1 a))
(idlwave-twin-class (nth 2 a)) ; used in idlwave-routine-twin-compare
(asrc (nth 3 a))
(atype (car asrc))
@@ -8706,10 +8677,6 @@ This basically calls `idlwave-routine-twin-compare' with the correct args."
(list (file-truename bfile) bfile (list btype))
(list btype bfile (list btype))))))
-;; Bound in idlwave-study-twins,idlwave-routine-entry-compare-twins.
-(defvar idlwave-twin-class)
-(defvar idlwave-twin-name)
-
(defun idlwave-routine-twin-compare (a b)
"Compare two routine twin entries for sorting.
In here, A and B are not normal routine info entries, but special
@@ -8809,9 +8776,7 @@ This expects NAME TYPE IDLWAVE-TWIN-CLASS to be bound to the right values."
(defun idlwave-path-alist-add-flag (list-entry flag)
"Add a flag to the path list entry, if not set."
- (let ((flags (cdr list-entry)))
- (add-to-list 'flags flag)
- (setcdr list-entry flags)))
+ (cl-pushnew flag (cdr list-entry) :test #'equal))
(defun idlwave-path-alist-remove-flag (list-entry flag)
"Remove a flag to the path list entry, if set."
@@ -8920,8 +8885,8 @@ Assumes that point is at the beginning of the unit as found by
["(Un)Comment Region" idlwave-toggle-comment-region t]
["Continue/Split line" idlwave-split-line t]
"--"
- ["Toggle Auto Fill" idlwave-auto-fill-mode :style toggle
- :selected (symbol-value idlwave-fill-function)])
+ ["Toggle Auto Fill" auto-fill-mode :style toggle
+ :selected auto-fill-function])
("Templates"
["Procedure" idlwave-procedure t]
["Function" idlwave-function t]
@@ -9069,7 +9034,7 @@ With arg, list all abbrevs with the corresponding hook.
This function was written since `list-abbrevs' looks terrible for IDLWAVE mode."
(interactive "P")
- (let ((table (symbol-value 'idlwave-mode-abbrev-table))
+ (let ((table idlwave-mode-abbrev-table)
abbrevs
str rpl func fmt (len-str 0) (len-rpl 0))
(mapatoms
@@ -9127,6 +9092,9 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode."
;; Run the hook
(run-hooks 'idlwave-load-hook)
+;; Obsolete.
+(define-obsolete-function-alias 'idlwave-uniquify #'seq-uniq "28.1")
+
(provide 'idlwave)
;;; idlwave.el ends here
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index ac230596240..e69a9ff394e 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -1,7 +1,6 @@
-;;; inf-lisp.el --- an inferior-lisp mode
+;;; inf-lisp.el --- an inferior-lisp mode -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1993-1994, 2001-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1988-2021 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Keywords: processes, lisp
@@ -23,13 +22,13 @@
;;; Commentary:
-;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
+;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
;; This file defines a lisp-in-a-buffer package (inferior-lisp mode)
;; built on top of comint mode. This version is more featureful,
;; robust, and uniform than the Emacs 18 version. The key bindings are
;; also more compatible with the bindings of Hemlock and Zwei (the
-;; Lisp Machine emacs).
+;; Lisp Machine Emacs).
;; Since this mode is built on top of the general command-interpreter-in-
;; a-buffer mode (comint mode), it shares a common base functionality,
@@ -40,19 +39,19 @@
;; the hooks available for customizing it, see the file comint.el.
;; For further information on inferior-lisp mode, see the comments below.
-;; Needs fixin:
+;; Needs fixing:
;; The load-file/compile-file default mechanism could be smarter -- it
;; doesn't know about the relationship between filename extensions and
-;; whether the file is source or executable. If you compile foo.lisp
+;; whether the file is source or executable. If you compile foo.lisp
;; with compile-file, then the next load-file should use foo.bin for
-;; the default, not foo.lisp. This is tricky to do right, particularly
+;; the default, not foo.lisp. This is tricky to do right, particularly
;; because the extension for executable files varies so much (.o, .bin,
;; .lbin, .mo, .vo, .ao, ...).
;;
;; It would be nice if inferior-lisp (and inferior scheme, T, ...) modes
;; had a verbose minor mode wherein sending or compiling defuns, etc.
;; would be reflected in the transcript with suitable comments, e.g.
-;; ";;; redefining fact". Several ways to do this. Which is right?
+;; ";;; redefining fact". Several ways to do this. Which is right?
;;
;; When sending text from a source file to a subprocess, the process-mark can
;; move off the window, so you can lose sight of the process interactions.
@@ -63,6 +62,7 @@
(require 'comint)
(require 'lisp-mode)
+(require 'shell)
(defgroup inferior-lisp nil
@@ -76,25 +76,24 @@
Input matching this regexp is not saved on the input history in Inferior Lisp
mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
\(as in :a, :c, etc.)"
- :type 'regexp
- :group 'inferior-lisp)
+ :type 'regexp)
(defvar inferior-lisp-mode-map
(let ((map (copy-keymap comint-mode-map)))
(set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\C-x\C-e" 'lisp-eval-last-sexp)
- (define-key map "\C-c\C-l" 'lisp-load-file)
- (define-key map "\C-c\C-k" 'lisp-compile-file)
- (define-key map "\C-c\C-a" 'lisp-show-arglist)
- (define-key map "\C-c\C-d" 'lisp-describe-sym)
- (define-key map "\C-c\C-f" 'lisp-show-function-documentation)
- (define-key map "\C-c\C-v" 'lisp-show-variable-documentation)
+ (define-key map "\C-x\C-e" #'lisp-eval-last-sexp)
+ (define-key map "\C-c\C-l" #'lisp-load-file)
+ (define-key map "\C-c\C-k" #'lisp-compile-file)
+ (define-key map "\C-c\C-a" #'lisp-show-arglist)
+ (define-key map "\C-c\C-d" #'lisp-describe-sym)
+ (define-key map "\C-c\C-f" #'lisp-show-function-documentation)
+ (define-key map "\C-c\C-v" #'lisp-show-variable-documentation)
map))
(easy-menu-define
inferior-lisp-menu
inferior-lisp-mode-map
- "Inferior Lisp Menu"
+ "Inferior Lisp Menu."
'("Inf-Lisp"
["Eval Last Sexp" lisp-eval-last-sexp t]
"--"
@@ -108,20 +107,20 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
;;; These commands augment Lisp mode, so you can process Lisp code in
;;; the source files.
-(define-key lisp-mode-map "\M-\C-x" 'lisp-eval-defun) ; GNU convention
-(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; GNU convention
-(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
-(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
-(define-key lisp-mode-map "\C-c\C-n" 'lisp-eval-form-and-next)
-(define-key lisp-mode-map "\C-c\C-p" 'lisp-eval-paragraph)
-(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
-(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
-(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-(define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file) ; "kompile" file
-(define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-(define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-(define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
-(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
+(define-key lisp-mode-map "\M-\C-x" #'lisp-eval-defun) ; GNU convention
+(define-key lisp-mode-map "\C-x\C-e" #'lisp-eval-last-sexp) ; GNU convention
+(define-key lisp-mode-map "\C-c\C-e" #'lisp-eval-defun)
+(define-key lisp-mode-map "\C-c\C-r" #'lisp-eval-region)
+(define-key lisp-mode-map "\C-c\C-n" #'lisp-eval-form-and-next)
+(define-key lisp-mode-map "\C-c\C-p" #'lisp-eval-paragraph)
+(define-key lisp-mode-map "\C-c\C-c" #'lisp-compile-defun)
+(define-key lisp-mode-map "\C-c\C-z" #'switch-to-lisp)
+(define-key lisp-mode-map "\C-c\C-l" #'lisp-load-file)
+(define-key lisp-mode-map "\C-c\C-k" #'lisp-compile-file) ; "kompile" file
+(define-key lisp-mode-map "\C-c\C-a" #'lisp-show-arglist)
+(define-key lisp-mode-map "\C-c\C-d" #'lisp-describe-sym)
+(define-key lisp-mode-map "\C-c\C-f" #'lisp-show-function-documentation)
+(define-key lisp-mode-map "\C-c\C-v" #'lisp-show-variable-documentation)
;; This function exists for backwards compatibility.
@@ -134,29 +133,27 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
;;; (with-eval-after-load 'inf-lisp 'inferior-lisp-install-letter-bindings)
;;;You can modify this function to install just the bindings you want."
(defun inferior-lisp-install-letter-bindings ()
- (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go)
- (define-key lisp-mode-map "\C-cr" 'lisp-eval-region-and-go)
- (define-key lisp-mode-map "\C-cc" 'lisp-compile-defun-and-go)
- (define-key lisp-mode-map "\C-cz" 'switch-to-lisp)
- (define-key lisp-mode-map "\C-cl" 'lisp-load-file)
- (define-key lisp-mode-map "\C-ck" 'lisp-compile-file)
- (define-key lisp-mode-map "\C-ca" 'lisp-show-arglist)
- (define-key lisp-mode-map "\C-cd" 'lisp-describe-sym)
- (define-key lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
- (define-key lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)
-
- (define-key inferior-lisp-mode-map "\C-cl" 'lisp-load-file)
- (define-key inferior-lisp-mode-map "\C-ck" 'lisp-compile-file)
- (define-key inferior-lisp-mode-map "\C-ca" 'lisp-show-arglist)
- (define-key inferior-lisp-mode-map "\C-cd" 'lisp-describe-sym)
- (define-key inferior-lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
- (define-key inferior-lisp-mode-map "\C-cv"
- 'lisp-show-variable-documentation))
+ (define-key lisp-mode-map "\C-ce" #'lisp-eval-defun-and-go)
+ (define-key lisp-mode-map "\C-cr" #'lisp-eval-region-and-go)
+ (define-key lisp-mode-map "\C-cc" #'lisp-compile-defun-and-go)
+ (define-key lisp-mode-map "\C-cz" #'switch-to-lisp)
+ (define-key lisp-mode-map "\C-cl" #'lisp-load-file)
+ (define-key lisp-mode-map "\C-ck" #'lisp-compile-file)
+ (define-key lisp-mode-map "\C-ca" #'lisp-show-arglist)
+ (define-key lisp-mode-map "\C-cd" #'lisp-describe-sym)
+ (define-key lisp-mode-map "\C-cf" #'lisp-show-function-documentation)
+ (define-key lisp-mode-map "\C-cv" #'lisp-show-variable-documentation)
+
+ (define-key inferior-lisp-mode-map "\C-cl" #'lisp-load-file)
+ (define-key inferior-lisp-mode-map "\C-ck" #'lisp-compile-file)
+ (define-key inferior-lisp-mode-map "\C-ca" #'lisp-show-arglist)
+ (define-key inferior-lisp-mode-map "\C-cd" #'lisp-describe-sym)
+ (define-key inferior-lisp-mode-map "\C-cf" #'lisp-show-function-documentation)
+ (define-key inferior-lisp-mode-map "\C-cv" #'lisp-show-variable-documentation))
(defcustom inferior-lisp-program "lisp"
"Program name for invoking an inferior Lisp in Inferior Lisp mode."
- :type 'string
- :group 'inferior-lisp)
+ :type 'string)
(defcustom inferior-lisp-load-command "(load \"%s\")\n"
"Format-string for building a Lisp expression to load a file.
@@ -166,8 +163,7 @@ to load that file. The default works acceptably on most Lisps.
The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
produces cosmetically superior output for this application,
but it works only in Common Lisp."
- :type 'string
- :group 'inferior-lisp)
+ :type 'string)
(defcustom inferior-lisp-prompt "^[^> \n]*>+:? *"
"Regexp to recognize prompts in the Inferior Lisp mode.
@@ -182,10 +178,9 @@ More precise choices:
Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
kcl: \"^>+ *\""
- :type 'regexp
- :group 'inferior-lisp)
+ :type 'regexp)
-(defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer.
+(defvar inferior-lisp-buffer nil "*The current `inferior-lisp' process buffer.
MULTIPLE PROCESS SUPPORT
===========================================================================
@@ -295,15 +290,20 @@ to continue it."
"Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
If there is a process already running in `*inferior-lisp*', just switch
to that buffer.
+
With argument, allows you to edit the command line (default is value
of `inferior-lisp-program'). Runs the hooks from
`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
+
+If any parts of the command name contains spaces, they should be
+quoted using shell quote syntax.
+
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(interactive (list (if current-prefix-arg
(read-string "Run lisp: " inferior-lisp-program)
inferior-lisp-program)))
(if (not (comint-check-proc "*inferior-lisp*"))
- (let ((cmdlist (split-string cmd)))
+ (let ((cmdlist (split-string-shell-command cmd)))
(set-buffer (apply (function make-comint)
"inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
(inferior-lisp-mode)))
@@ -330,18 +330,18 @@ Prefix argument means switch to the Lisp buffer afterwards."
(if and-go (switch-to-lisp t)))
(defun lisp-compile-string (string)
- "Send the string to the inferior Lisp process to be compiled and executed."
+ "Send STRING to the inferior Lisp process to be compiled and executed."
(comint-send-string
(inferior-lisp-proc)
(format "(funcall (compile nil (lambda () %s)))\n" string)))
(defun lisp-eval-string (string)
- "Send the string to the inferior Lisp process to be executed."
+ "Send STRING to the inferior Lisp process to be executed."
(comint-send-string (inferior-lisp-proc) (concat string "\n")))
(defun lisp-do-defun (do-string do-region)
"Send the current defun to the inferior Lisp process.
-The actually processing is done by `do-string' and `do-region'
+The actually processing is done by DO-STRING and DO-REGION
which determine whether the code is compiled before evaluation.
DEFVAR forms reset the variables to the init values."
(save-excursion
@@ -448,7 +448,7 @@ With argument, positions cursor at end of buffer."
;;; (let ((name-start (point)))
;;; (forward-sexp 1)
;;; (process-send-string "inferior-lisp"
-;;; (format "(compile '%s #'(lambda "
+;;; (format "(compile '%s (lambda "
;;; (buffer-substring name-start
;;; (point)))))
;;; (let ((body-start (point)))
@@ -464,7 +464,7 @@ With argument, positions cursor at end of buffer."
;;; (interactive "r")
;;; (save-excursion
;;; (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
-;;; (if (< (point) start) (error "region begins in middle of defun"))
+;;; (if (< (point) start) (error "Region begins in middle of defun"))
;;; (goto-char start)
;;; (let ((s start))
;;; (end-of-defun)
@@ -487,12 +487,11 @@ describing the last `lisp-load-file' or `lisp-compile-file' command.")
If it's loaded into a buffer that is in one of these major modes, it's
considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'.
Used by these commands to determine defaults."
- :type '(repeat symbol)
- :group 'inferior-lisp)
+ :type '(repeat symbol))
(defun lisp-load-file (file-name)
"Load a Lisp file into the inferior Lisp process."
- (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file
+ (interactive (comint-get-source "Load Lisp file" lisp-prev-l/c-dir/file
lisp-source-modes nil)) ; nil because LOAD
; doesn't need an exact name
(comint-check-source file-name) ; Check to see if buffer needs saved.
@@ -505,7 +504,7 @@ Used by these commands to determine defaults."
(defun lisp-compile-file (file-name)
"Compile a Lisp file in the inferior Lisp process."
- (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file
+ (interactive (comint-get-source "Compile Lisp file" lisp-prev-l/c-dir/file
lisp-source-modes nil)) ; nil = don't need
; suffix .lisp
(comint-check-source file-name) ; Check to see if buffer needs saved.
@@ -596,7 +595,7 @@ See variable `lisp-function-doc-command'."
(format lisp-function-doc-command fn)))
(defun lisp-show-variable-documentation (var)
- "Send a command to the inferior Lisp to give documentation for function FN.
+ "Send a command to the inferior Lisp to give documentation for variable VAR.
See variable `lisp-var-doc-command'."
(interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt)))
(comint-proc-query (inferior-lisp-proc) (format lisp-var-doc-command var)))
@@ -625,8 +624,8 @@ See variable `lisp-describe-sym-command'."
(error "No Lisp subprocess; see variable `inferior-lisp-buffer'"))))
-;;; Do the user's customization...
-;;;===============================
+;; Obsolete.
+
(defvar inferior-lisp-load-hook nil
"This hook is run when the library `inf-lisp' is loaded.")
(make-obsolete-variable 'inferior-lisp-load-hook
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index cdf6536fc7e..c2481f6095a 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -282,7 +282,7 @@ Match group 1 is the name of the macro.")
"continue" "debugger" "default" "delete" "do" "else"
"enum" "export" "extends" "final" "finally" "for"
"function" "goto" "if" "implements" "import" "in"
- "instanceof" "interface" "native" "new" "package"
+ "instanceof" "interface" "native" "new" "of" "package"
"private" "protected" "public" "return" "static"
"super" "switch" "synchronized" "throw"
"throws" "transient" "try" "typeof" "var" "void" "let"
@@ -427,22 +427,19 @@ Match group 1 is the name of the macro.")
(defcustom js-indent-level 4
"Number of spaces for each indentation step in `js-mode'."
:type 'integer
- :safe 'integerp
- :group 'js)
+ :safe 'integerp)
(defcustom js-expr-indent-offset 0
"Number of additional spaces for indenting continued expressions.
The value must be no less than minus `js-indent-level'."
:type 'integer
- :safe 'integerp
- :group 'js)
+ :safe 'integerp)
(defcustom js-paren-indent-offset 0
"Number of additional spaces for indenting expressions in parentheses.
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.1")
(defcustom js-square-indent-offset 0
@@ -450,7 +447,6 @@ The value must be no less than minus `js-indent-level'."
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.1")
(defcustom js-curly-indent-offset 0
@@ -458,7 +454,6 @@ The value must be no less than minus `js-indent-level'."
The value must be no less than minus `js-indent-level'."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.1")
(defcustom js-switch-indent-offset 0
@@ -466,26 +461,22 @@ The value must be no less than minus `js-indent-level'."
The value must not be negative."
:type 'integer
:safe 'integerp
- :group 'js
:version "24.4")
(defcustom js-flat-functions nil
"Treat nested functions as top-level functions in `js-mode'.
This applies to function movement, marking, and so on."
- :type 'boolean
- :group 'js)
+ :type 'boolean)
(defcustom js-indent-align-list-continuation t
"Align continuation of non-empty ([{ lines in `js-mode'."
:version "26.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-comment-lineup-func #'c-lineup-C-comments
"Lineup function for `cc-mode-style', for C comments in `js-mode'."
- :type 'function
- :group 'js)
+ :type 'function)
(defcustom js-enabled-frameworks js--available-frameworks
"Frameworks recognized by `js-mode'.
@@ -493,30 +484,27 @@ To improve performance, you may turn off some frameworks you
seldom use, either globally or on a per-buffer basis."
:type (cons 'set (mapcar (lambda (x)
(list 'const x))
- js--available-frameworks))
- :group 'js)
+ js--available-frameworks)))
(defcustom js-js-switch-tabs
(and (memq system-type '(darwin)) t)
"Whether `js-mode' should display tabs while selecting them.
This is useful only if the windowing system has a good mechanism
for preventing Firefox from stealing the keyboard focus."
- :type 'boolean
- :group 'js)
+ :type 'boolean)
(defcustom js-js-tmpdir
- "~/.emacs.d/js/js"
+ (locate-user-emacs-file "js/js")
"Temporary directory used by `js-mode' to communicate with Mozilla.
This directory must be readable and writable by both Mozilla and Emacs."
:type 'directory
- :group 'js)
+ :version "28.1")
(defcustom js-js-timeout 5
"Reply timeout for executing commands in Mozilla via `js-mode'.
The value is given in seconds. Increase this value if you are
getting timeout messages."
- :type 'integer
- :group 'js)
+ :type 'integer)
(defcustom js-indent-first-init nil
"Non-nil means specially indent the first variable declaration's initializer.
@@ -557,8 +545,7 @@ don't indent the first one's initializer; otherwise, indent it.
bar = 2;"
:version "25.1"
:type '(choice (const nil) (const t) (const dynamic))
- :safe 'symbolp
- :group 'js)
+ :safe 'symbolp)
(defcustom js-chain-indent nil
"Use \"chained\" indentation.
@@ -571,8 +558,7 @@ then the \".\"s will be lined up:
"
:version "26.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-detect-syntax t
"When non-nil, automatically detect whether JavaScript uses JSX.
@@ -581,8 +567,7 @@ t. The detection strategy can be customized by adding elements
to `js-jsx-regexps', which see."
:version "27.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-syntax nil
"When non-nil, parse JavaScript with consideration for JSX syntax.
@@ -600,8 +585,7 @@ When `js-mode' is already enabled, you should call
It is set to be buffer-local (and t) when in `js-jsx-mode'."
:version "27.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-align->-with-< t
"When non-nil, “>” will be indented to the opening “<” in JSX.
@@ -625,8 +609,7 @@ When this is disabled, JSX indentation looks like this:
/>"
:version "27.1"
:type 'boolean
- :safe 'booleanp
- :group 'js)
+ :safe 'booleanp)
(defcustom js-jsx-indent-level nil
"When non-nil, indent JSX by this value, instead of like JS.
@@ -655,8 +638,7 @@ indentation looks like this (different):
:version "27.1"
:type '(choice integer
(const :tag "Not Set" nil))
- :safe (lambda (x) (or (null x) (integerp x)))
- :group 'js)
+ :safe (lambda (x) (or (null x) (integerp x))))
;; This is how indentation behaved out-of-the-box until Emacs 27. JSX
;; indentation was controlled with `sgml-basic-offset', which defaults
;; to 2, whereas `js-indent-level' defaults to 4. Users who had the
@@ -685,8 +667,7 @@ indentation looks like this:
This variable is like `sgml-attribute-offset'."
:version "27.1"
:type 'integer
- :safe 'integerp
- :group 'js)
+ :safe 'integerp)
;;; KeyMap
@@ -1079,7 +1060,7 @@ Return the pitem of the function we went to the beginning of."
(t
(js--beginning-of-defun-nested))))))
-(defun js--flush-caches (&optional beg ignored)
+(defun js--flush-caches (&optional beg _ignored)
"Flush the `js-mode' syntax cache after position BEG.
BEG defaults to `point-min', meaning to flush the entire cache."
(interactive)
@@ -1359,7 +1340,6 @@ LIMIT defaults to point."
(defun js--end-of-defun-nested ()
"Helper function for `js-end-of-defun'."
- (message "test")
(let* (pitem
(this-end (save-excursion
(and (setq pitem (js--beginning-of-defun-nested))
@@ -1493,11 +1473,10 @@ LIMIT defaults to point."
"Helper function for building `js--font-lock-keywords'.
Create a byte-compiled function for matching a concatenation of
REGEXPS, but only if FRAMEWORK is in `js-enabled-frameworks'."
- (setq regexps (apply #'concat regexps))
- (byte-compile
- `(lambda (limit)
- (when (memq (quote ,framework) js-enabled-frameworks)
- (re-search-forward ,regexps limit t)))))
+ (let ((regexp (apply #'concat regexps)))
+ (lambda (limit)
+ (when (memq framework js-enabled-frameworks)
+ (re-search-forward regexp limit t)))))
(defvar-local js--tmp-location nil)
@@ -2881,7 +2860,11 @@ return nil."
((nth 3 parse-status) 0) ; inside string
((when (and js-jsx-syntax (not js-jsx--indent-col))
(save-excursion (js-jsx--indentation parse-status))))
- ((eq (char-after) ?#) 0)
+ ((and (eq (char-after) ?#)
+ (save-excursion
+ (forward-char 1)
+ (looking-at-p cpp-font-lock-keywords-source-directives)))
+ 0)
((save-excursion (js--beginning-of-macro)) 4)
;; Indent array comprehension continuation lines specially.
((let ((bracket (nth 1 parse-status))
@@ -3719,8 +3702,7 @@ Otherwise, use the current value of `process-mark'."
Strings and numbers are JSON-encoded. Lists (including nil) are
made into JavaScript array literals and their contents encoded
with `js--js-encode-value'."
- (cond ((stringp x) (json-encode-string x))
- ((numberp x) (json-encode-number x))
+ (cond ((or (stringp x) (numberp x)) (json-encode x))
((symbolp x) (format "{objid:%S}" (symbol-name x)))
((js--js-handle-p x)
@@ -4198,8 +4180,9 @@ browser, respectively."
"style" "")
cmds)))
- (eval (list 'with-js
- (cons 'js-list (nreverse cmds))))))
+ (eval `(with-js
+ (js-list ,@(nreverse cmds)))
+ t)))
(command-hook
()
@@ -4410,7 +4393,8 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(with-temp-buffer
(insert js--js-inserter)
(insert "(")
- (insert (json-encode-list defun-info))
+ (let ((standard-output (current-buffer)))
+ (json--print-list defun-info))
(insert ",\n")
(insert defun-body)
(insert "\n)")
@@ -4674,4 +4658,4 @@ one of the aforementioned options instead of using this mode."
(provide 'js)
-;; js.el ends here
+;;; js.el ends here
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index c4ea8e158d8..485e64e2492 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -35,8 +35,7 @@
(defvar ld-script-location-counter-face 'ld-script-location-counter)
(defface ld-script-location-counter
'((t :weight bold :inherit font-lock-builtin-face))
- "Face for location counter in GNU ld script."
- :group 'ld-script)
+ "Face for location counter in GNU ld script.")
;; Syntax rules
(defvar ld-script-mode-syntax-table
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 99f4be38721..d9c09f6fe6b 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -60,12 +60,34 @@ If m4 is not in your PATH, set this to an absolute file name."
;;or
;;(defconst m4-program-options '("--prefix-builtins"))
+;; Needed at compile-time for `m4-font-lock-keywords' below.
+(eval-and-compile
+ (defconst m4--macro-list
+ ;; From (info "(m4) Macro index")
+ '("__file__" "__gnu__" "__line__" "__os2__" "__program__" "__unix__"
+ "__windows__" "argn" "array" "array_set" "builtin" "capitalize"
+ "changecom" "changequote" "changeword" "cleardivert" "cond" "copy"
+ "curry" "debugfile" "debugmode" "decr" "define" "define_blind"
+ "defn" "divert" "divnum" "dnl" "downcase" "dquote" "dquote_elt"
+ "dumpdef" "errprint" "esyscmd" "eval" "example" "exch"
+ "fatal_error" "file" "foreach" "foreachq" "forloop" "format" "gnu"
+ "ifdef" "ifelse" "include" "incr" "index" "indir" "join" "joinall"
+ "len" "line" "m4exit" "m4wrap" "maketemp" "mkstemp" "nargs" "os2"
+ "patsubst" "popdef" "pushdef" "quote" "regexp" "rename" "reverse"
+ "shift" "sinclude" "stack_foreach" "stack_foreach_lifo"
+ "stack_foreach_sep" "stack_foreach_sep_lifo" "substr" "syscmd"
+ "sysval" "traceoff" "traceon" "translit" "undefine" "undivert"
+ "unix" "upcase" "windows")
+ "List of valid m4 macros for M4 mode."))
+
(defvar m4-font-lock-keywords
- '(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" (0 font-lock-comment-face t))
- ("\\$[*#@0-9]" . font-lock-variable-name-face)
- ("\\$@" . font-lock-variable-name-face)
- ("\\$\\*" . font-lock-variable-name-face)
- ("\\_<\\(m4_\\)?\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\_>" . font-lock-keyword-face))
+ (eval-when-compile
+ `(("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" (0 font-lock-comment-face t))
+ ("\\$[*#@0-9]" . font-lock-variable-name-face)
+ ("\\$@" . font-lock-variable-name-face)
+ ("\\$\\*" . font-lock-variable-name-face)
+ (,(concat "\\_<\\(m4_\\)?" (regexp-opt m4--macro-list) "\\_>")
+ . font-lock-keyword-face)))
"Default `font-lock-keywords' for M4 mode.")
(defcustom m4-mode-hook nil
@@ -100,22 +122,22 @@ If m4 is not in your PATH, set this to an absolute file name."
(string-to-syntax "."))))))
(defvar m4-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-b" 'm4-m4-buffer)
(define-key map "\C-c\C-r" 'm4-m4-region)
(define-key map "\C-c\C-c" 'comment-region)
- (define-key map [menu-bar m4-mode] (cons "M4" menu-map))
- (define-key menu-map [m4c]
- '(menu-item "Comment Region" comment-region
- :help "Comment Region"))
- (define-key menu-map [m4b]
- '(menu-item "M4 Buffer" m4-m4-buffer
- :help "Send contents of the current buffer to m4"))
- (define-key menu-map [m4r]
- '(menu-item "M4 Region" m4-m4-region
- :help "Send contents of the current region to m4"))
- map))
+ map)
+ "Keymap for M4 Mode.")
+
+(easy-menu-define m4-mode-menu m4-mode-map
+ "Menu for M4 Mode."
+ '("M4"
+ ["M4 Region" m4-m4-region
+ :help "Send contents of the current region to m4"]
+ ["M4 Buffer" m4-m4-buffer
+ :help "Send contents of the current buffer to m4"]
+ ["Comment Region" comment-region
+ :help "Comment Region"]))
(defun m4-m4-buffer ()
"Send contents of the current buffer to m4."
@@ -155,22 +177,4 @@ If m4 is not in your PATH, set this to an absolute file name."
;;stuff to play with for debugging
;(char-to-string (char-syntax ?`))
-;;;how I generate the nasty looking regexps at the top
-;;;(make-regexp '("builtin" "changecom" "changequote" "changeword" "debugfile"
-;;; "debugmode" "decr" "define" "defn" "divert" "divnum" "dnl"
-;;; "dumpdef" "errprint" "esyscmd" "eval" "file" "format" "gnu"
-;;; "ifdef" "ifelse" "include" "incr" "index" "indir" "len" "line"
-;;; "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef" "regexp"
-;;; "shift" "sinclude" "substr" "syscmd" "sysval" "traceoff" "traceon"
-;;; "translit" "undefine" "undivert" "unix"))
-;;;(make-regexp '("m4_builtin" "m4_changecom" "m4_changequote" "m4_changeword"
-;;; "m4_debugfile" "m4_debugmode" "m4_decr" "m4_define" "m4_defn"
-;;; "m4_divert" "m4_divnum" "m4_dnl" "m4_dumpdef" "m4_errprint"
-;;; "m4_esyscmd" "m4_eval" "m4_file" "m4_format" "m4_ifdef" "m4_ifelse"
-;;; "m4_include" "m4_incr" "m4_index" "m4_indir" "m4_len" "m4_line"
-;;; "m4_m4exit" "m4_m4wrap" "m4_maketemp" "m4_patsubst" "m4_popdef"
-;;; "m4_pushdef" "m4_regexp" "m4_shift" "m4_sinclude" "m4_substr"
-;;; "m4_syscmd" "m4_sysval" "m4_traceoff" "m4_traceon" "m4_translit"
-;;; "m4_m4_undefine" "m4_undivert"))
-
;;; m4-mode.el ends here
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index e382d6edcd2..df17b87c013 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -101,14 +101,12 @@
(defface makefile-space
'((((class color)) (:background "hotpink"))
(t (:reverse-video t)))
- "Face to use for highlighting leading spaces in Font-Lock mode."
- :group 'makefile)
+ "Face to use for highlighting leading spaces in Font-Lock mode.")
(defface makefile-targets
;; This needs to go along both with foreground and background colors (i.e. shell)
'((t (:inherit font-lock-function-name-face)))
"Face to use for additionally highlighting rule targets in Font-Lock mode."
- :group 'makefile
:version "22.1")
(defface makefile-shell
@@ -116,7 +114,6 @@
;;'((((class color) (min-colors 88) (background light)) (:background "seashell1"))
;; (((class color) (min-colors 88) (background dark)) (:background "seashell4")))
"Face to use for additionally highlighting Shell commands in Font-Lock mode."
- :group 'makefile
:version "22.1")
(defface makefile-makepp-perl
@@ -124,19 +121,16 @@
(((class color) (background dark)) (:background "DarkBlue"))
(t (:reverse-video t)))
"Face to use for additionally highlighting Perl code in Font-Lock mode."
- :group 'makefile
:version "22.1")
(defcustom makefile-browser-buffer-name "*Macros and Targets*"
"Name of the macro- and target browser buffer."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-target-colon ":"
"String to append to all target names inserted by `makefile-insert-target'.
\":\" or \"::\" are common values."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-macro-assign " = "
"String to append to all macro names inserted by `makefile-insert-macro'.
@@ -144,70 +138,58 @@ The normal value should be \" = \", since this is what
standard make expects. However, newer makes such as dmake
allow a larger variety of different macro assignments, so you
might prefer to use \" += \" or \" := \" ."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-electric-keys nil
"If non-nil, Makefile mode should install electric keybindings.
Default is nil."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-use-curly-braces-for-macros-p nil
"Controls the style of generated macro references.
Non-nil means macro references should use curly braces, like `${this}'.
nil means use parentheses, like `$(this)'."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-tab-after-target-colon t
"If non-nil, insert a TAB after a target colon.
Otherwise, a space is inserted.
The default is t."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-browser-leftmost-column 10
"Number of blanks to the left of the browser selection mark."
- :type 'integer
- :group 'makefile)
+ :type 'integer)
(defcustom makefile-browser-cursor-column 10
"Column the cursor goes to when it moves up or down in the Makefile browser."
- :type 'integer
- :group 'makefile)
+ :type 'integer)
(defcustom makefile-backslash-column 48
"Column in which `makefile-backslash-region' inserts backslashes."
- :type 'integer
- :group 'makefile)
+ :type 'integer)
(defcustom makefile-backslash-align t
"If non-nil, `makefile-backslash-region' will align backslashes."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-browser-selected-mark "+ "
"String used to mark selected entries in the Makefile browser."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-browser-unselected-mark " "
"String used to mark unselected entries in the Makefile browser."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defcustom makefile-browser-auto-advance-after-selection-p t
"If non-nil, cursor will move after item is selected in Makefile browser."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-pickup-everything-picks-up-filenames-p nil
"If non-nil, `makefile-pickup-everything' picks up filenames as targets.
This means it calls `makefile-pickup-filenames-as-targets'.
Otherwise filenames are omitted."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-cleanup-continuations nil
"If non-nil, automatically clean up continuation lines when saving.
@@ -215,13 +197,11 @@ A line is cleaned up by removing all whitespace following a trailing
backslash. This is done silently.
IMPORTANT: Please note that enabling this option causes Makefile mode
to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"."
- :type 'boolean
- :group 'makefile)
+ :type 'boolean)
(defcustom makefile-mode-hook nil
"Normal hook run by `makefile-mode'."
- :type 'hook
- :group 'makefile)
+ :type 'hook)
(defvar makefile-browser-hook '())
@@ -240,8 +220,7 @@ to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\"."
"List of special targets.
You will be offered to complete on one of those in the minibuffer whenever
you enter a \".\" at the beginning of a line in `makefile-mode'."
- :type '(repeat string)
- :group 'makefile)
+ :type '(repeat string))
(put 'makefile-special-targets-list 'risky-local-variable t)
(defcustom makefile-runtime-macros-list
@@ -250,8 +229,7 @@ you enter a \".\" at the beginning of a line in `makefile-mode'."
If you insert a macro reference using `makefile-insert-macro-ref', the name
of the macro is checked against this list. If it can be found its name will
not be enclosed in { } or ( )."
- :type '(repeat (list string))
- :group 'makefile)
+ :type '(repeat (list string)))
;; Note that the first big subexpression is used by font lock. Note
;; that if you change this regexp you might have to fix the imenu
@@ -279,7 +257,7 @@ not be enclosed in { } or ( )."
"Regex used to highlight makepp rule action lines in font lock mode.")
(defconst makefile-bsdmake-rule-action-regex
- (replace-regexp-in-string "-@" "-+@" makefile-rule-action-regex)
+ (string-replace "-@" "-+@" makefile-rule-action-regex)
"Regex used to highlight BSD rule action lines in font lock mode.")
;; Note that the first and second subexpression is used by font lock. Note
@@ -294,7 +272,7 @@ not be enclosed in { } or ( )."
"Regex used to find macro assignment lines in a makefile.")
(defconst makefile-var-use-regex
- "[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\|[@%<?^+*][FD]?\\)"
+ "\\(^\\|[^$]\\)\\$[({]\\([-a-zA-Z0-9_.]+\\|[@%<?^+*][FD]?\\)"
"Regex used to find $(macro) uses in a makefile.")
(defconst makefile-ignored-files-in-pickup-regex
@@ -368,7 +346,7 @@ not be enclosed in { } or ( )."
(3 font-lock-builtin-face prepend t))
;; Variable references even in targets/strings/comments.
- (,var 1 font-lock-variable-name-face prepend)
+ (,var 2 font-lock-variable-name-face prepend)
;; Automatic variable references and single character variable references,
;; but not shell variables references.
@@ -380,11 +358,10 @@ not be enclosed in { } or ( )."
,@(if keywords
;; Fontify conditionals and includes.
`((,(concat "^\\(?: [ \t]*\\)?"
- (replace-regexp-in-string
+ (string-replace
" " "[ \t]+"
(if (eq (car keywords) t)
- (replace-regexp-in-string "-" "[_-]"
- (regexp-opt (cdr keywords) t))
+ (string-replace "-" "[_-]" (regexp-opt (cdr keywords) t))
(regexp-opt keywords t)))
"\\>[ \t]*\\([^: \t\n#]*\\)")
(1 font-lock-keyword-face) (2 font-lock-variable-name-face))))
@@ -563,8 +540,7 @@ not be enclosed in { } or ( )."
(defcustom makefile-brave-make "make"
"How to invoke make, for `makefile-query-targets'.
This should identify a `make' command that can handle the `-q' option."
- :type 'string
- :group 'makefile)
+ :type 'string)
(defvaralias 'makefile-query-one-target-method
'makefile-query-one-target-method-function)
@@ -584,13 +560,11 @@ The function must satisfy this calling convention:
* It must return the integer value 0 (zero) if the given target
should be considered up-to-date in the context of the given
makefile, any nonzero integer value otherwise."
- :type 'function
- :group 'makefile)
+ :type 'function)
(defcustom makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
"Name of the Up-to-date overview buffer."
- :type 'string
- :group 'makefile)
+ :type 'string)
;;; --- end of up-to-date-overview configuration ------------------
@@ -598,8 +572,7 @@ The function must satisfy this calling convention:
"Abbrev table in use in Makefile buffers.")
(defvar makefile-mode-map
- (let ((map (make-sparse-keymap))
- (opt-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
;; set up the keymap
(define-key map "\C-c:" 'makefile-insert-target-ref)
(if makefile-electric-keys
@@ -624,72 +597,62 @@ The function must satisfy this calling convention:
(define-key map "\M-p" 'makefile-previous-dependency)
(define-key map "\M-n" 'makefile-next-dependency)
(define-key map "\e\t" 'completion-at-point)
-
- ;; Make menus.
- (define-key map [menu-bar makefile-mode]
- (cons "Makefile" (make-sparse-keymap "Makefile")))
-
- (define-key map [menu-bar makefile-mode makefile-type]
- (cons "Switch Makefile Type" opt-map))
- (define-key opt-map [makefile-makepp-mode]
- '(menu-item "Makepp" makefile-makepp-mode
- :help "An adapted `makefile-mode' that knows about makepp"
- :button (:radio . (eq major-mode 'makefile-makepp-mode))))
- (define-key opt-map [makefile-imake-mode]
- '(menu-item "Imake" makefile-imake-mode
- :help "An adapted `makefile-mode' that knows about imake"
- :button (:radio . (eq major-mode 'makefile-imake-mode))))
- (define-key opt-map [makefile-mode]
- '(menu-item "Classic" makefile-mode
- :help "`makefile-mode' with no special functionality"
- :button (:radio . (eq major-mode 'makefile-mode))))
- (define-key opt-map [makefile-bsdmake-mode]
- '(menu-item "BSD" makefile-bsdmake-mode
- :help "An adapted `makefile-mode' that knows about BSD make"
- :button (:radio . (eq major-mode 'makefile-bsdmake-mode))))
- (define-key opt-map [makefile-automake-mode]
- '(menu-item "Automake" makefile-automake-mode
- :help "An adapted `makefile-mode' that knows about automake"
- :button (:radio . (eq major-mode 'makefile-automake-mode))))
- (define-key opt-map [makefile-gmake-mode]
- '(menu-item "GNU make" makefile-gmake-mode
- :help "An adapted `makefile-mode' that knows about GNU make"
- :button (:radio . (eq major-mode 'makefile-gmake-mode))))
- (define-key map [menu-bar makefile-mode browse]
- '(menu-item "Pop up Makefile Browser" makefile-switch-to-browser
- ;; XXX: this needs a better string, the function is not documented...
- :help "Pop up Makefile Browser"))
- (define-key map [menu-bar makefile-mode overview]
- '(menu-item "Up To Date Overview" makefile-create-up-to-date-overview
- :help "Create a buffer containing an overview of the state of all known targets"))
- ;; Target related
- (define-key map [menu-bar makefile-mode separator1] '("----"))
- (define-key map [menu-bar makefile-mode pickup-file]
- '(menu-item "Pick File Name as Target" makefile-pickup-filenames-as-targets
- :help "Scan the current directory for filenames to use as targets"))
- (define-key map [menu-bar makefile-mode function]
- '(menu-item "Insert GNU make function" makefile-insert-gmake-function
- :help "Insert a GNU make function call"))
- (define-key map [menu-bar makefile-mode pickup]
- '(menu-item "Find Targets and Macros" makefile-pickup-everything
- :help "Notice names of all macros and targets in Makefile"))
- (define-key map [menu-bar makefile-mode complete]
- '(menu-item "Complete Target or Macro" completion-at-point
- :help "Perform completion on Makefile construct preceding point"))
- (define-key map [menu-bar makefile-mode backslash]
- '(menu-item "Backslash Region" makefile-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on the lines in the region"))
- ;; Motion
- (define-key map [menu-bar makefile-mode separator] '("----"))
- (define-key map [menu-bar makefile-mode prev]
- '(menu-item "Move to Previous Dependency" makefile-previous-dependency
- :help "Move point to the beginning of the previous dependency line"))
- (define-key map [menu-bar makefile-mode next]
- '(menu-item "Move to Next Dependency" makefile-next-dependency
- :help "Move point to the beginning of the next dependency line"))
map)
"The keymap that is used in Makefile mode.")
+(easy-menu-define makefile-mode-menu makefile-mode-map
+ "Menu for Makefile mode."
+ '("Makefile"
+ ;; Motion
+ ["Move to Next Dependency" makefile-next-dependency
+ :help "Move point to the beginning of the next dependency line"]
+ ["Move to Previous Dependency" makefile-previous-dependency
+ :help "Move point to the beginning of the previous dependency line"]
+ "----"
+ ;; Target related
+ ["Backslash Region" makefile-backslash-region
+ :help "Insert, align, or delete end-of-line backslashes on the lines in the region"]
+ ["Complete Target or Macro" completion-at-point
+ :help "Perform completion on Makefile construct preceding point"]
+ ["Find Targets and Macros" makefile-pickup-everything
+ :help "Notice names of all macros and targets in Makefile"]
+ ["Insert GNU make function" makefile-insert-gmake-function
+ :help "Insert a GNU make function call"]
+ ["Pick File Name as Target" makefile-pickup-filenames-as-targets
+ :help "Scan the current directory for filenames to use as targets"]
+ "----"
+ ;; Other.
+ ["Up To Date Overview" makefile-create-up-to-date-overview
+ :help "Create a buffer containing an overview of the state of all known targets"]
+ ["Pop up Makefile Browser" makefile-switch-to-browser
+ ;; XXX: this needs a better string, the function is not documented...
+ :help "Pop up Makefile Browser"]
+ ("Switch Makefile Type"
+ ["GNU make" makefile-gmake-mode
+ :help "An adapted `makefile-mode' that knows about GNU make"
+ :style radio
+ :selected (eq major-mode 'makefile-gmake-mode)]
+ ["Automake" makefile-automake-mode
+ :help "An adapted `makefile-mode' that knows about automake"
+ :style radio
+ :selected (eq major-mode 'makefile-automake-mode)]
+ ["BSD" makefile-bsdmake-mode
+ :help "An adapted `makefile-mode' that knows about BSD make"
+ :style radio
+ :selected (eq major-mode 'makefile-bsdmake-mode)]
+ ["Classic" makefile-mode
+ :help "`makefile-mode' with no special functionality"
+ :style radio
+ :selected (eq major-mode 'makefile-mode)]
+ ["Imake" makefile-imake-mode
+ :help "An adapted `makefile-mode' that knows about imake"
+ :style radio
+ :selected (eq major-mode 'makefile-imake-mode)]
+ ["Makepp" makefile-makepp-mode
+ :help "An adapted `makefile-mode' that knows about makepp"
+ :style radio
+ :selected (eq major-mode 'makefile-makepp-mode)])))
+
(defvar makefile-browser-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 9da968c8314..50268446025 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -88,8 +88,6 @@
;;; Code:
-(require 'easymenu)
-
(defgroup meta-font nil
"Major mode for editing Metafont or MetaPost sources."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
@@ -109,44 +107,31 @@
"\\(def\\|let\\|mode_def\\|vardef\\)")
(macro-keywords-2
"\\(primarydef\\|secondarydef\\|tertiarydef\\)")
-;(make-regexp
-; '("expr" "suffix" "text" "primary" "secondary" "tertiary") t)
(args-keywords
- (concat "\\(expr\\|primary\\|s\\(econdary\\|uffix\\)\\|"
- "te\\(rtiary\\|xt\\)\\)"))
-;(make-regexp
-; '("boolean" "color" "numeric" "pair" "path" "pen" "picture"
-; "string" "transform" "newinternal") t)
+ (eval-when-compile
+ (regexp-opt
+ '("expr" "suffix" "text" "primary" "secondary" "tertiary")
+ t)))
(type-keywords
- (concat "\\(boolean\\|color\\|n\\(ewinternal\\|umeric\\)\\|"
- "p\\(a\\(ir\\|th\\)\\|en\\|icture\\)\\|string\\|"
- "transform\\)"))
-;(make-regexp
-; '("for" "forever" "forsuffixes" "endfor"
-; "step" "until" "upto" "downto" "thru" "within"
-; "iff" "if" "elseif" "else" "fi" "exitif" "exitunless"
-; "let" "def" "vardef" "enddef" "mode_def"
-; "true" "false" "known" "unknown" "and" "or" "not"
-; "save" "interim" "inner" "outer" "relax"
-; "begingroup" "endgroup" "expandafter" "scantokens"
-; "generate" "input" "endinput" "end" "bye"
-; "message" "errmessage" "errhelp" "special" "numspecial"
-; "readstring" "readfrom" "write") t)
+ (eval-when-compile
+ (regexp-opt
+ '("boolean" "color" "numeric" "pair" "path" "pen" "picture"
+ "string" "transform" "newinternal")
+ t)))
(syntactic-keywords
- (concat "\\(and\\|b\\(egingroup\\|ye\\)\\|"
- "d\\(ef\\|ownto\\)\\|e\\(lse\\(\\|if\\)"
- "\\|nd\\(\\|def\\|for\\|group\\|input\\)"
- "\\|rr\\(help\\|message\\)"
- "\\|x\\(it\\(if\\|unless\\)\\|pandafter\\)\\)\\|"
- "f\\(alse\\|i\\|or\\(\\|ever\\|suffixes\\)\\)\\|"
- "generate\\|i\\(ff?\\|n\\(ner\\|put\\|terim\\)\\)\\|"
- "known\\|let\\|m\\(essage\\|ode_def\\)\\|"
- "n\\(ot\\|umspecial\\)\\|o\\(r\\|uter\\)\\|"
- "re\\(ad\\(from\\|string\\)\\|lax\\)\\|"
- "s\\(ave\\|cantokens\\|pecial\\|tep\\)\\|"
- "t\\(hru\\|rue\\)\\|"
- "u\\(n\\(known\\|til\\)\\|pto\\)\\|"
- "vardef\\|w\\(ithin\\|rite\\)\\)"))
+ (eval-when-compile
+ (regexp-opt
+ '("for" "forever" "forsuffixes" "endfor"
+ "step" "until" "upto" "downto" "thru" "within"
+ "iff" "if" "elseif" "else" "fi" "exitif" "exitunless"
+ "let" "def" "vardef" "enddef" "mode_def"
+ "true" "false" "known" "unknown" "and" "or" "not"
+ "save" "interim" "inner" "outer" "relax"
+ "begingroup" "endgroup" "expandafter" "scantokens"
+ "generate" "input" "endinput" "end" "bye"
+ "message" "errmessage" "errhelp" "special" "numspecial"
+ "readstring" "readfrom" "write")
+ t)))
)
(list
;; embedded TeX code in btex ... etex
@@ -463,25 +448,21 @@ If the list was changed, sort the list and remove duplicates first."
(defcustom meta-indent-level 2
"Indentation of begin-end blocks in Metafont or MetaPost mode."
- :type 'integer
- :group 'meta-font)
+ :type 'integer)
(defcustom meta-left-comment-regexp "%%+"
"Regexp matching comments that should be placed on the left margin."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-right-comment-regexp nil
"Regexp matching comments that should be placed on the right margin."
:type '(choice regexp
- (const :tag "None" nil))
- :group 'meta-font)
+ (const :tag "None" nil)))
(defcustom meta-ignore-comment-regexp "%[^%]"
"Regexp matching comments whose indentation should not be touched."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-begin-environment-regexp
@@ -489,22 +470,19 @@ If the list was changed, sort the list and remove duplicates first."
"def\\|for\\(\\|ever\\|suffixes\\)\\|if\\|mode_def\\|"
"primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)")
"Regexp matching the beginning of environments to be indented."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-end-environment-regexp
(concat "\\(end\\(char\\|def\\|f\\(ig\\|or\\)\\|gr\\(aph\\|oup\\)\\)"
"\\|fi\\)")
"Regexp matching the end of environments to be indented."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-within-environment-regexp
; (concat "\\(e\\(lse\\(\\|if\\)\\|xit\\(if\\|unless\\)\\)\\)")
(concat "\\(else\\(\\|if\\)\\)")
"Regexp matching keywords within environments not to be indented."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defun meta-comment-indent ()
@@ -689,14 +667,12 @@ If the list was changed, sort the list and remove duplicates first."
(concat "\\(begin\\(char\\|fig\\|logochar\\)\\|def\\|mode_def\\|"
"primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)")
"Regexp matching beginning of defuns in Metafont or MetaPost mode."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defcustom meta-end-defun-regexp
(concat "\\(end\\(char\\|def\\|fig\\)\\)")
"Regexp matching the end of defuns in Metafont or MetaPost mode."
- :type 'regexp
- :group 'meta-font)
+ :type 'regexp)
(defun meta-beginning-of-defun (&optional arg)
@@ -893,24 +869,21 @@ The environment marked is the one that contains point or follows point."
(defcustom meta-mode-load-hook nil
"Hook evaluated when first loading Metafont or MetaPost mode."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
(make-obsolete-variable 'meta-mode-load-hook
"use `with-eval-after-load' instead." "28.1")
(defcustom meta-common-mode-hook nil
"Hook evaluated by both `metafont-mode' and `metapost-mode'."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
(defcustom metafont-mode-hook nil
"Hook evaluated by `metafont-mode' after `meta-common-mode-hook'."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
+
(defcustom metapost-mode-hook nil
"Hook evaluated by `metapost-mode' after `meta-common-mode-hook'."
- :type 'hook
- :group 'meta-font)
+ :type 'hook)
@@ -969,9 +942,6 @@ The environment marked is the one that contains point or follows point."
(list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list)
(list "" 'ispell-complete-word))))
-
-;;; Just in case ...
-
(provide 'meta-mode)
(run-hooks 'meta-mode-load-hook)
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index a77a4e2b216..a8d644dba0e 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -1,4 +1,4 @@
-;;; modula2.el --- Modula-2 editing support package
+;;; modula2.el --- Modula-2 editing support package -*- lexical-binding: t -*-
;; Author: Michael Schmidt <michael@pbinfo.UUCP>
;; Tom Perrine <Perrin@LOGICON.ARPA>
@@ -51,62 +51,57 @@
(defcustom m2-compile-command "m2c"
"Command to compile Modula-2 programs."
- :type 'string
- :group 'modula2)
+ :type 'string)
(defcustom m2-link-command "m2l"
"Command to link Modula-2 programs."
- :type 'string
- :group 'modula2)
+ :type 'string)
(defcustom m2-link-name nil
"Name of the Modula-2 executable."
- :type '(choice (const nil) string)
- :group 'modula2)
+ :type '(choice (const nil) string))
(defcustom m2-end-comment-column 75
"Column for aligning the end of a comment, in Modula-2."
- :type 'integer
- :group 'modula2)
+ :type 'integer)
;;; Added by TEP
(defvar m2-mode-map
(let ((map (make-sparse-keymap)))
;; FIXME: Many of those bindings are contrary to coding conventions.
- (define-key map "\C-cb" 'm2-begin)
- (define-key map "\C-cc" 'm2-case)
- (define-key map "\C-cd" 'm2-definition)
- (define-key map "\C-ce" 'm2-else)
- (define-key map "\C-cf" 'm2-for)
- (define-key map "\C-ch" 'm2-header)
- (define-key map "\C-ci" 'm2-if)
- (define-key map "\C-cm" 'm2-module)
- (define-key map "\C-cl" 'm2-loop)
- (define-key map "\C-co" 'm2-or)
- (define-key map "\C-cp" 'm2-procedure)
- (define-key map "\C-c\C-w" 'm2-with)
- (define-key map "\C-cr" 'm2-record)
- (define-key map "\C-cs" 'm2-stdio)
- (define-key map "\C-ct" 'm2-type)
- (define-key map "\C-cu" 'm2-until)
- (define-key map "\C-cv" 'm2-var)
- (define-key map "\C-cw" 'm2-while)
- (define-key map "\C-cx" 'm2-export)
- (define-key map "\C-cy" 'm2-import)
- (define-key map "\C-c{" 'm2-begin-comment)
- (define-key map "\C-c}" 'm2-end-comment)
- (define-key map "\C-c\C-z" 'suspend-emacs)
- (define-key map "\C-c\C-v" 'm2-visit)
- (define-key map "\C-c\C-t" 'm2-toggle)
- (define-key map "\C-c\C-l" 'm2-link)
- (define-key map "\C-c\C-c" 'm2-compile)
+ (define-key map "\C-cb" #'m2-begin)
+ (define-key map "\C-cc" #'m2-case)
+ (define-key map "\C-cd" #'m2-definition)
+ (define-key map "\C-ce" #'m2-else)
+ (define-key map "\C-cf" #'m2-for)
+ (define-key map "\C-ch" #'m2-header)
+ (define-key map "\C-ci" #'m2-if)
+ (define-key map "\C-cm" #'m2-module)
+ (define-key map "\C-cl" #'m2-loop)
+ (define-key map "\C-co" #'m2-or)
+ (define-key map "\C-cp" #'m2-procedure)
+ (define-key map "\C-c\C-w" #'m2-with)
+ (define-key map "\C-cr" #'m2-record)
+ (define-key map "\C-cs" #'m2-stdio)
+ (define-key map "\C-ct" #'m2-type)
+ (define-key map "\C-cu" #'m2-until)
+ (define-key map "\C-cv" #'m2-var)
+ (define-key map "\C-cw" #'m2-while)
+ (define-key map "\C-cx" #'m2-export)
+ (define-key map "\C-cy" #'m2-import)
+ (define-key map "\C-c{" #'m2-begin-comment)
+ (define-key map "\C-c}" #'m2-end-comment)
+ (define-key map "\C-c\C-z" #'suspend-emacs)
+ (define-key map "\C-c\C-v" #'m2-visit)
+ (define-key map "\C-c\C-t" #'m2-toggle)
+ (define-key map "\C-c\C-l" #'m2-link)
+ (define-key map "\C-c\C-c" #'m2-compile)
map)
"Keymap used in Modula-2 mode.")
(defcustom m2-indent 5
"This variable gives the indentation in Modula-2 mode."
- :type 'integer
- :group 'modula2)
+ :type 'integer)
(put 'm2-indent 'safe-local-variable
(lambda (v) (or (null v) (integerp v))))
@@ -206,7 +201,10 @@
((zerop (length tok))
(let ((forward-sexp-function nil))
(condition-case nil
- (forward-sexp -1)
+ (let ((p (point)))
+ (forward-sexp -1)
+ (when (= p (point))
+ (setq res ":")))
(scan-error (setq res ":")))))
((member tok '("|" "OF" "..")) (setq res ":-case"))
((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE"))
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index ddcc6f5450e..b1a5f301587 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -215,9 +215,15 @@ newline or semicolon after an else or end keyword."
(concat "[^#%\n]*\\(" octave-continuation-marker-regexp
"\\)\\s-*\\(\\s<.*\\)?$"))
-;; Char \ is considered a bad decision for continuing a line.
(defconst octave-continuation-string "..."
- "Character string used for Octave continuation lines.")
+ "Character string used for Octave continuation lines.
+Joins current line with following line, except within
+double-quoted strings, where `octave-string-continuation-marker'
+is used instead.")
+
+(defconst octave-string-continuation-marker "\\"
+ "Line continuation marker for double-quoted Octave strings.
+Non-string statements use `octave-continuation-string'.")
(defvar octave-mode-imenu-generic-expression
(list
@@ -454,7 +460,8 @@ Non-nil means always go to the next Octave code line after sending."
(smie-rule-parent octave-block-offset)
;; For (invalid) code between switch and case.
;; (if (smie-rule-parent-p "switch") 4)
- nil))))
+ nil))
+ ('(:after . "=") (smie-rule-parent octave-block-offset))))
(defun octave-indent-comment ()
"A function for `smie-indent-functions' (which see)."
@@ -485,8 +492,8 @@ Non-nil means always go to the next Octave code line after sending."
'font-lock-keyword-face)
;; Note: 'end' also serves as the last index in an indexing expression,
;; and 'enumerate' is also a function.
- ;; Ref: http://www.mathworks.com/help/matlab/ref/end.html
- ;; Ref: http://www.mathworks.com/help/matlab/ref/enumeration.html
+ ;; Ref: https://www.mathworks.com/help/matlab/ref/end.html
+ ;; Ref: https://www.mathworks.com/help/matlab/ref/enumeration.html
(list (lambda (limit)
(while (re-search-forward "\\_<en\\(?:d\\|umeratio\\(n\\)\\)\\_>"
limit 'move)
@@ -888,7 +895,7 @@ startup file, `~/.emacs-octave'."
(defun inferior-octave-completion-at-point ()
"Return the data to complete the Octave symbol at point."
;; https://debbugs.gnu.org/14300
- (unless (string-match-p "/" (or (comint--match-partial-filename) ""))
+ (unless (string-search "/" (or (comint--match-partial-filename) ""))
(let ((beg (save-excursion
(skip-syntax-backward "w_" (comint-line-beginning-position))
(point)))
@@ -1032,11 +1039,11 @@ directory and makes this the current buffer's default directory."
(looking-at regexp)))
(defun octave-maybe-insert-continuation-string ()
- (if (or (octave-in-comment-p)
- (save-excursion
- (beginning-of-line)
- (looking-at octave-continuation-regexp)))
- nil
+ (declare (obsolete nil "28.1"))
+ (unless (or (octave-in-comment-p)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at octave-continuation-regexp)))
(delete-horizontal-space)
(insert (concat " " octave-continuation-string))))
@@ -1218,23 +1225,22 @@ q: Don't fix\n" func file))
(defun octave-indent-new-comment-line (&optional soft)
"Break Octave line at point, continuing comment if within one.
Insert `octave-continuation-string' before breaking the line
-unless inside a list. Signal an error if within a single-quoted
-string."
+unless inside a list. If within a double-quoted string, insert
+`octave-string-continuation-marker' instead. Signal an error if
+within a single-quoted string."
(interactive)
(funcall comment-line-break-function soft))
(defun octave--indent-new-comment-line (orig &rest args)
- (cond
- ((octave-in-comment-p) nil)
- ((eq (octave-in-string-p) ?')
- (error "Cannot split a single-quoted string"))
- ((eq (octave-in-string-p) ?\")
- (insert octave-continuation-string))
- (t
- (delete-horizontal-space)
- (unless (and (cadr (syntax-ppss))
- (eq (char-after (cadr (syntax-ppss))) ?\())
- (insert " " octave-continuation-string))))
+ (pcase (syntax-ppss)
+ ((app ppss-string-terminator ?\')
+ (user-error "Cannot split a single-quoted string"))
+ ((app ppss-string-terminator ?\")
+ (insert octave-string-continuation-marker))
+ ((pred (not ppss-comment-depth))
+ (delete-horizontal-space)
+ (unless (octave-smie--in-parens-p)
+ (insert " " octave-continuation-string))))
(apply orig args)
(indent-according-to-mode))
@@ -1663,9 +1669,7 @@ code line."
(define-button-type 'octave-help-function
'follow-link t
- 'action (lambda (b)
- (octave-help
- (buffer-substring (button-start b) (button-end b)))))
+ 'action (lambda (b) (octave-help (button-label b))))
(defvar octave-help-mode-map
(let ((map (make-sparse-keymap)))
@@ -1766,8 +1770,8 @@ sentence."
(insert "\nRetry with ")
(insert-text-button "'-all'"
'follow-link t
- 'action #'(lambda (_b)
- (octave-lookfor str '-all)))
+ 'action (lambda (_b)
+ (octave-lookfor str '-all)))
(insert ".\n"))
(octave-help-mode)))))
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 59f90d7293b..e6e6e40aa19 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -199,38 +199,32 @@
(defcustom pascal-indent-level 3
"Indentation of Pascal statements with respect to containing block."
- :type 'integer
- :group 'pascal)
+ :type 'integer)
(defcustom pascal-case-indent 2
"Indentation for case statements."
- :type 'integer
- :group 'pascal)
+ :type 'integer)
(defcustom pascal-auto-newline nil
"Non-nil means automatically insert newlines in certain cases.
These include after semicolons and after the punctuation mark after an `end'."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-indent-nested-functions t
"Non-nil means nested functions are indented."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-tab-always-indent t
"Non-nil means TAB in Pascal mode should always reindent the current line.
If this is nil, TAB inserts a tab if it is at the end of the line
and follows non-whitespace text."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-auto-endcomments t
"Non-nil means automatically insert comments after certain `end's.
Specifically, this is done after the ends of case statements and functions.
The name of the function or case is included between the braces."
- :type 'boolean
- :group 'pascal)
+ :type 'boolean)
(defcustom pascal-auto-lineup '(all)
"List of contexts where auto lineup of :'s or ='s should be done.
@@ -243,8 +237,7 @@ will do all lineups."
(const :tag "Everything" all)
(const :tag "Parameter lists" paramlist)
(const :tag "Declarations" declaration)
- (const :tag "Case statements" case))
- :group 'pascal)
+ (const :tag "Case statements" case)))
(defvar pascal-toggle-completions nil
"If non-nil, `pascal-complete-word' tries all possible completions.
@@ -260,8 +253,7 @@ completions.")
These include integer, real, char, etc.
The types defined within the Pascal program
are handled in another way, and should not be added to this list."
- :type '(repeat (string :tag "Keyword"))
- :group 'pascal)
+ :type '(repeat (string :tag "Keyword")))
(defcustom pascal-start-keywords
'("begin" "end" "function" "procedure" "repeat" "until" "while"
@@ -270,8 +262,7 @@ are handled in another way, and should not be added to this list."
These are keywords such as begin, repeat, until, readln.
The procedures and variables defined within the Pascal program
are handled in another way, and should not be added to this list."
- :type '(repeat (string :tag "Keyword"))
- :group 'pascal)
+ :type '(repeat (string :tag "Keyword")))
(defcustom pascal-separator-keywords
'("downto" "else" "mod" "div" "then")
@@ -279,8 +270,7 @@ are handled in another way, and should not be added to this list."
These are keywords such as downto, else, mod, then.
Variables and function names defined within the Pascal program
are handled in another way, and should not be added to this list."
- :type '(repeat (string :tag "Keyword"))
- :group 'pascal)
+ :type '(repeat (string :tag "Keyword")))
;;;
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 0120e4a7cd1..4e14c30bc5d 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -98,8 +98,7 @@
(defface perl-non-scalar-variable
'((t :inherit font-lock-variable-name-face :underline t))
"Face used for non-scalar variables."
- :version "28.1"
- :group 'perl)
+ :version "28.1")
(defvar perl-mode-abbrev-table nil
"Abbrev table in use in perl-mode buffers.")
@@ -171,14 +170,22 @@
;; (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t))
;;
;; Fontify function and package names in declarations.
- ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?"
+ ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\(?:\\sw\\|::\\)+\\)?"
(1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
- ("\\(^\\|[^$@%&\\]\\)\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
+ ("\\(?:^\\|[^$@%&\\]\\)\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\(?:\\sw\\|::\\)+\\)?"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t)))
"Subdued level highlighting for Perl mode.")
(defconst perl-font-lock-keywords-2
(append
+ '(;; Fontify function, variable and file name references. They have to be
+ ;; handled first because they might conflict with keywords.
+ ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
+ ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
+ ;; will underline them by default.
+ ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
+ ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
+ (2 'perl-non-scalar-variable)))
perl-font-lock-keywords-1
`( ;; Fontify keywords, except those fontified otherwise.
,(concat "\\<"
@@ -188,16 +195,7 @@
"\\>")
;;
;; Fontify declarators and prefixes as types.
- ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-type-face) ; declarators
- ;;
- ;; Fontify function, variable and file name references.
- ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
- ;; Additionally fontify non-scalar variables. `perl-non-scalar-variable'
- ;; will underline them by default.
- ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
- ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
- ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)"
- (2 'perl-non-scalar-variable))
+ ("\\<\\(has\\|local\\|my\\|our\\|state\\)\\>" . font-lock-keyword-face) ; declarators
("<\\(\\sw+\\)>" 1 font-lock-constant-face)
;;
;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
@@ -286,7 +284,7 @@
(put-text-property (match-beginning 2) (match-end 2)
'syntax-table (string-to-syntax "\""))
(perl-syntax-propertize-special-constructs end)))))
- ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)"
+ ("\\(^\\|[?:.,;=|&!~({[ \t]\\|=>\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\(?:\\s-\\|\n\\)*\\(?:\\([^])}>= \n\t]\\)\\|\\(?3:=\\)[^>]\\)"
;; Nasty cases:
;; /foo/m $a->m $#m $m @m %m
;; \s (appears often in regexps).
@@ -640,7 +638,6 @@ This is a non empty list of strings, the checker tool possibly
followed by required arguments. Once launched it will receive
the Perl source to be checked as its standard input."
:version "26.1"
- :group 'perl
:type '(repeat string))
(defvar-local perl--flymake-proc nil)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index d88d3505586..a8b608b018a 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -41,8 +41,25 @@
:type 'hook
:options '(flyspell-prog-mode abbrev-mode flymake-mode
display-line-numbers-mode
- prettify-symbols-mode)
- :group 'prog-mode)
+ prettify-symbols-mode))
+
+(defun prog-context-menu (menu)
+ (when (featurep 'xref)
+ (define-key-after menu [prog-separator] menu-bar-separator
+ 'mark-whole-buffer)
+ (define-key-after menu [xref-find-def]
+ '(menu-item "Find Definition" xref-find-definitions-at-mouse
+ :visible (save-excursion
+ (mouse-set-point last-input-event)
+ (xref-backend-identifier-at-point (xref-find-backend)))
+ :help "Find definition of function or variable")
+ 'prog-separator)
+ (define-key-after menu [xref-pop]
+ '(menu-item "Back Definition" xref-pop-marker-stack
+ :visible (not (xref-marker-stack-empty-p))
+ :help "Back to the position of the last search")
+ 'xref-find-def))
+ menu)
(defvar prog-mode-map
(let ((map (make-sparse-keymap)))
@@ -166,8 +183,7 @@ on the symbol."
:version "25.1"
:type '(choice (const :tag "Never unprettify" nil)
(const :tag "Unprettify when point is inside" t)
- (const :tag "Unprettify when point is inside or at right edge" right-edge))
- :group 'prog-mode)
+ (const :tag "Unprettify when point is inside or at right edge" right-edge)))
(defun prettify-symbols--post-command-hook ()
(cl-labels ((get-prop-as-list
@@ -251,6 +267,7 @@ support it."
"Major mode for editing programming language source code."
(setq-local require-final-newline mode-require-final-newline)
(setq-local parse-sexp-ignore-comments t)
+ (add-hook 'context-menu-functions 'prog-context-menu 10 t)
;; Any programming language is always written left to right.
(setq bidi-paragraph-direction 'left-to-right))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index abe563bec04..4620ea8f47e 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
-;; Version: 0.5.4
+;; Version: 0.6.1
;; Package-Requires: ((emacs "26.1") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -106,7 +106,7 @@
;;
;; - Write a new function that will determine the current project
;; based on the directory and add it to `project-find-functions'
-;; (which see) using `add-hook'. It is a good idea to depend on the
+;; (which see) using `add-hook'. It is a good idea to depend on the
;; directory only, and not on the current major mode, for example.
;; Because the usual expectation is that all files in the directory
;; belong to the same project (even if some/most of them are ignored).
@@ -201,20 +201,27 @@ of the project instance object."
(when maybe-prompt
(if pr
(project-remember-project pr)
- (project--remove-from-project-list directory)
+ (project--remove-from-project-list
+ directory "Project `%s' not found; removed from list")
(setq pr (cons 'transient directory))))
pr))
(defun project--find-in-directory (dir)
(run-hook-with-args-until-success 'project-find-functions dir))
+(defvar project--within-roots-fallback nil)
+
(cl-defgeneric project-root (project)
"Return root directory of the current project.
It usually contains the main build file, dependencies
configuration file, etc. Though neither is mandatory.
-The directory name must be absolute."
+The directory name must be absolute.")
+
+(cl-defmethod project-root (project
+ &context (project--within-roots-fallback
+ (eql nil)))
(car (project-roots project)))
(cl-defgeneric project-roots (project)
@@ -226,7 +233,8 @@ and the rest should be possible to express through
;; FIXME: Can we specify project's version here?
;; FIXME: Could we make this affect cl-defmethod calls too?
(declare (obsolete project-root "0.3.0"))
- (list (project-root project)))
+ (let ((project--within-roots-fallback t))
+ (list (project-root project))))
;; FIXME: Add MODE argument, like in `ede-source-paths'?
(cl-defgeneric project-external-roots (_project)
@@ -288,11 +296,11 @@ to find the list of ignores for each directory."
;; Make sure ~/ etc. in local directory name is
;; expanded and not left for the shell command
;; to interpret.
- (localdir (file-local-name (expand-file-name dir)))
- (command (format "%s %s %s -type f %s -print0"
+ (localdir (file-name-unquote (file-local-name (expand-file-name dir))))
+ (command (format "%s -H %s %s -type f %s -print0"
find-program
- ;; In case DIR is a symlink.
- (file-name-as-directory localdir)
+ (shell-quote-argument
+ (directory-file-name localdir)) ; Bug#48471
(xref--find-ignores-arguments ignores localdir)
(if files
(concat (shell-quote-argument "(")
@@ -303,16 +311,25 @@ to find the list of ignores for each directory."
(concat " -o " find-name-arg " "))
" "
(shell-quote-argument ")"))
- ""))))
+ "")))
+ (output (with-output-to-string
+ (with-current-buffer standard-output
+ (let ((status
+ (process-file-shell-command command nil t)))
+ (unless (zerop status)
+ (error "File listing failed: %s" (buffer-string))))))))
(project--remote-file-names
- (sort (split-string (shell-command-to-string command) "\0" t)
+ (sort (split-string output "\0" t)
#'string<))))
(defun project--remote-file-names (local-files)
- "Return LOCAL-FILES as if they were on the system of `default-directory'."
+ "Return LOCAL-FILES as if they were on the system of `default-directory'.
+Also quote LOCAL-FILES if `default-directory' is quoted."
(let ((remote-id (file-remote-p default-directory)))
(if (not remote-id)
- local-files
+ (if (file-name-quoted-p default-directory)
+ (mapcar #'file-name-quote local-files)
+ local-files)
(mapcar (lambda (file)
(concat remote-id file))
local-files))))
@@ -724,13 +741,14 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(interactive (list (project--read-regexp)))
(require 'xref)
(require 'grep)
- (let* ((pr (project-current t))
+ (let* ((caller-dir default-directory)
+ (pr (project-current t))
(default-directory (project-root pr))
(files
(if (not current-prefix-arg)
(project-files pr)
(let ((dir (read-directory-name "Base directory: "
- nil default-directory t)))
+ caller-dir nil t)))
(project--files-in-directory dir
nil
(grep-read-files regexp))))))
@@ -774,9 +792,12 @@ pattern to search for."
(user-error "No matches for: %s" regexp))
xrefs))
+(defvar project-regexp-history-variable 'grep-regexp-history)
+
(defun project--read-regexp ()
- (let ((sym (thing-at-point 'symbol)))
- (read-regexp "Find regexp" (and sym (regexp-quote sym)))))
+ (let ((sym (thing-at-point 'symbol t)))
+ (read-regexp "Find regexp" (and sym (regexp-quote sym))
+ project-regexp-history-variable)))
;;;###autoload
(defun project-find-file ()
@@ -858,23 +879,16 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
(defun project--completing-read-strict (prompt
collection &optional predicate
hist default)
- ;; Tried both expanding the default before showing the prompt, and
- ;; removing it when it has no matches. Neither seems natural
- ;; enough. Removal is confusing; early expansion makes the prompt
- ;; too long.
- (let* ((new-prompt (if (and default (not (string-equal default "")))
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (res (completing-read new-prompt
- collection predicate t
- nil ;; initial-input
- hist default)))
- (when (and (equal res default)
- (not (test-completion res collection predicate)))
- (setq res
- (completing-read (format "%s: " prompt)
- collection predicate t res hist nil)))
- res))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq-local minibuffer-default-add-function
+ (lambda ()
+ (let ((minibuffer-default default))
+ (minibuffer-default-add-completions)))))
+ (completing-read (format "%s: " prompt)
+ collection predicate 'confirm
+ nil
+ hist)))
;;;###autoload
(defun project-dired ()
@@ -897,14 +911,10 @@ With \\[universal-argument] prefix arg, create a new inferior shell buffer even
if one already exists."
(interactive)
(let* ((default-directory (project-root (project-current t)))
- (default-project-shell-name
- (concat "*" (file-name-nondirectory
- (directory-file-name
- (file-name-directory default-directory)))
- "-shell*"))
+ (default-project-shell-name (project-prefixed-buffer-name "shell"))
(shell-buffer (get-buffer default-project-shell-name)))
(if (and shell-buffer (not current-prefix-arg))
- (pop-to-buffer shell-buffer)
+ (pop-to-buffer-same-window shell-buffer)
(shell (generate-new-buffer-name default-project-shell-name)))))
;;;###autoload
@@ -917,14 +927,10 @@ if one already exists."
(interactive)
(defvar eshell-buffer-name)
(let* ((default-directory (project-root (project-current t)))
- (eshell-buffer-name
- (concat "*" (file-name-nondirectory
- (directory-file-name
- (file-name-directory default-directory)))
- "-eshell*"))
+ (eshell-buffer-name (project-prefixed-buffer-name "eshell"))
(eshell-buffer (get-buffer eshell-buffer-name)))
(if (and eshell-buffer (not current-prefix-arg))
- (pop-to-buffer eshell-buffer)
+ (pop-to-buffer-same-window eshell-buffer)
(eshell t))))
;;;###autoload
@@ -973,12 +979,34 @@ loop using the command \\[fileloop-continue]."
(defvar compilation-read-command)
(declare-function compilation-read-command "compile")
+(defun project-prefixed-buffer-name (mode)
+ (concat "*"
+ (file-name-nondirectory
+ (directory-file-name default-directory))
+ "-"
+ (downcase mode)
+ "*"))
+
+(defcustom project-compilation-buffer-name-function nil
+ "Function to compute the name of a project compilation buffer.
+If non-nil, it overrides `compilation-buffer-name-function' for
+`project-compile'."
+ :version "28.1"
+ :group 'project
+ :type '(choice (const :tag "Default" nil)
+ (const :tag "Prefixed with root directory name"
+ project-prefixed-buffer-name)
+ (function :tag "Custom function")))
+
;;;###autoload
(defun project-compile ()
"Run `compile' in the project root."
(declare (interactive-only compile))
(interactive)
- (let ((default-directory (project-root (project-current t))))
+ (let ((default-directory (project-root (project-current t)))
+ (compilation-buffer-name-function
+ (or project-compilation-buffer-name-function
+ compilation-buffer-name-function)))
(call-interactively #'compile)))
(defun project--read-project-buffer ()
@@ -1085,11 +1113,16 @@ current project, it will be killed."
(defun project--buffer-list (pr)
"Return the list of all buffers in project PR."
- (let (bufs)
+ (let ((conn (file-remote-p (project-root pr)))
+ bufs)
(dolist (buf (buffer-list))
- (when (equal pr
- (with-current-buffer buf
- (project-current)))
+ ;; For now we go with the assumption that a project must reside
+ ;; entirely on one host. We might relax that in the future.
+ (when (and (equal conn
+ (file-remote-p (buffer-local-value 'default-directory buf)))
+ (equal pr
+ (with-current-buffer buf
+ (project-current))))
(push buf bufs)))
(nreverse bufs)))
@@ -1210,17 +1243,27 @@ Save the result in `project-list-file' if the list of projects has changed."
(push (list dir) project--list)
(project--write-project-list))))
-(defun project--remove-from-project-list (pr-dir)
- "Remove directory PR-DIR of a missing project from the project list.
+(defun project--remove-from-project-list (project-root report-message)
+ "Remove directory PROJECT-ROOT of a missing project from the project list.
If the directory was in the list before the removal, save the
result in `project-list-file'. Announce the project's removal
-from the list."
+from the list using REPORT-MESSAGE, which is a format string
+passed to `message' as its first argument."
(project--ensure-read-project-list)
- (when-let ((ent (assoc pr-dir project--list)))
+ (when-let ((ent (assoc project-root project--list)))
(setq project--list (delq ent project--list))
- (message "Project `%s' not found; removed from list" pr-dir)
+ (message report-message project-root)
(project--write-project-list)))
+;;;###autoload
+(defun project-remove-known-project (project-root)
+ "Remove directory PROJECT-ROOT from the project list.
+PROJECT-ROOT is the root directory of a known project listed in
+the project list."
+ (interactive (list (project-prompt-project-dir)))
+ (project--remove-from-project-list
+ project-root "Project `%s' removed from known projects"))
+
(defun project-prompt-project-dir ()
"Prompt the user for a directory that is one of the known project roots.
The project is chosen among projects known from the project list,
@@ -1255,7 +1298,6 @@ It's also possible to enter an arbitrary directory not in the list."
;;; Project switching
-;;;###autoload
(defcustom project-switch-commands
'((project-find-file "Find file")
(project-find-regexp "Find regexp")
@@ -1272,6 +1314,7 @@ to distinguish the menu entries in the dispatch menu. If KEY is
absent, COMMAND must be bound in `project-prefix-map', and the
key is looked up in that map."
:version "28.1"
+ :group 'project
:package-version '(project . "0.6.0")
:type '(repeat
(list
@@ -1288,6 +1331,7 @@ listed in `project-switch-commands' and signal an error when
others are invoked. Otherwise, all keys in `project-prefix-map'
are legal even if they aren't listed in the dispatch menu."
:type 'boolean
+ :group 'project
:version "28.1")
(defun project--keymap-prompt ()
@@ -1301,7 +1345,7 @@ are legal even if they aren't listed in the dispatch menu."
key tmp)))
(let ((key (if key
(vector key)
- (where-is-internal cmd project-prefix-map t))))
+ (where-is-internal cmd (list project-prefix-map) t))))
(format "[%s] %s"
(propertize (key-description key) 'face 'bold)
label)))
@@ -1317,28 +1361,36 @@ made from `project-switch-commands'.
When called in a program, it will use the project corresponding
to directory DIR."
(interactive (list (project-prompt-project-dir)))
- (let ((commands-menu
- (mapcar
- (lambda (row)
- (if (characterp (car row))
- ;; Deprecated format.
- ;; XXX: Add a warning about it?
- (reverse row)
- row))
- project-switch-commands))
- command)
+ (let* ((commands-menu
+ (mapcar
+ (lambda (row)
+ (if (characterp (car row))
+ ;; Deprecated format.
+ ;; XXX: Add a warning about it?
+ (reverse row)
+ row))
+ project-switch-commands))
+ (commands-map
+ (let ((temp-map (make-sparse-keymap)))
+ (set-keymap-parent temp-map project-prefix-map)
+ (dolist (row commands-menu temp-map)
+ (when-let ((cmd (nth 0 row))
+ (keychar (nth 2 row)))
+ (define-key temp-map (vector keychar) cmd)))))
+ command)
(while (not command)
- (let ((choice (read-event (project--keymap-prompt))))
- (when (setq command
- (or (car
- (seq-find (lambda (row) (equal choice (nth 2 row)))
- commands-menu))
- (lookup-key project-prefix-map (vector choice))))
+ (let* ((overriding-local-map commands-map)
+ (choice (read-key-sequence (project--keymap-prompt))))
+ (when (setq command (lookup-key commands-map choice))
(unless (or project-switch-use-entire-map
(assq command commands-menu))
;; TODO: Add some hint to the prompt, like "key not
;; recognized" or something.
- (setq command nil)))))
+ (setq command nil)))
+ (let ((global-command (lookup-key (current-global-map) choice)))
+ (when (memq global-command
+ '(keyboard-quit keyboard-escape-quit))
+ (call-interactively global-command)))))
(let ((default-directory dir)
(project-current-inhibit-prompt t))
(call-interactively command))))
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 9f5f9ed6d3d..2e23c2e2cab 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -267,7 +267,6 @@
(require 'shell)
)
-(require 'easymenu)
(require 'align)
(defgroup prolog nil
@@ -1316,6 +1315,7 @@ With prefix argument ARG, restart the Prolog process if running before."
(progn
(process-send-string "prolog" "halt.\n")
(while (get-process "prolog") (sit-for 0.1))))
+ (prolog-ensure-process)
(let ((buff (buffer-name)))
(if (not (string= buff "*prolog*"))
(prolog-goto-prolog-process-buffer))
@@ -1325,7 +1325,6 @@ With prefix argument ARG, restart the Prolog process if running before."
prolog-use-sicstus-sd)
(prolog-enable-sicstus-sd))
(prolog-mode-variables)
- (prolog-ensure-process)
))
(defun prolog-inferior-guess-flavor (&optional ignored)
@@ -1350,56 +1349,57 @@ With prefix argument ARG, restart the Prolog process if running before."
"If Prolog process is not running, run it.
If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
the variable `prolog-prompt-regexp'."
- (if (null (prolog-program-name))
- (error "This Prolog system has defined no interpreter."))
- (if (comint-check-proc "*prolog*")
- ()
- (with-current-buffer (get-buffer-create "*prolog*")
- (prolog-inferior-mode)
-
- ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
- ;; which assumes it is running under Emacs if either INFERIOR=yes or
- ;; if EMACS is set to a nonempty value. The EMACS setting is
- ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should
- ;; know about INSIDE_EMACS (which replaced EMACS) and should not need
- ;; this hack.
- (let ((process-environment
- (if (getenv "INFERIOR")
- process-environment
- (cons "INFERIOR=yes" process-environment))))
- (apply 'make-comint-in-buffer "prolog" (current-buffer)
- (prolog-program-name) nil (prolog-program-switches)))
-
- (unless prolog-system
- ;; Setup auto-detection.
- (setq-local
- prolog-system
- ;; Force re-detection.
- (let* ((proc (get-buffer-process (current-buffer)))
- (pmark (and proc (marker-position (process-mark proc)))))
- (cond
- ((null pmark) (1- (point-min)))
- ;; The use of insert-before-markers in comint.el together with
- ;; the potential use of comint-truncate-buffer in the output
- ;; filter, means that it's difficult to reliably keep track of
- ;; the buffer position where the process's output started.
- ;; If possible we use a marker at "start - 1", so that
- ;; insert-before-marker at `start' won't shift it. And if not,
- ;; we fall back on using a plain integer.
- ((> pmark (point-min)) (copy-marker (1- pmark)))
- (t (1- pmark)))))
- (add-hook 'comint-output-filter-functions
- 'prolog-inferior-guess-flavor nil t))
- (if wait
- (progn
- (goto-char (point-max))
- (while
- (save-excursion
- (not
- (re-search-backward
- (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
- nil t)))
- (sit-for 0.1)))))))
+ (let ((pname (prolog-program-name))
+ (pswitches (prolog-program-switches)))
+ (if (null pname)
+ (error "This Prolog system has defined no interpreter."))
+ (unless (comint-check-proc "*prolog*")
+ (with-current-buffer (get-buffer-create "*prolog*")
+ (prolog-inferior-mode)
+
+ ;; The "INFERIOR=yes" hack is for SWI-Prolog 7.2.3 and earlier,
+ ;; which assumes it is running under Emacs if either INFERIOR=yes or
+ ;; if EMACS is set to a nonempty value. The EMACS setting is
+ ;; obsolescent, so set INFERIOR. Newer versions of SWI-Prolog should
+ ;; know about INSIDE_EMACS (which replaced EMACS) and should not need
+ ;; this hack.
+ (let ((process-environment
+ (if (getenv "INFERIOR")
+ process-environment
+ (cons "INFERIOR=yes" process-environment))))
+ (apply 'make-comint-in-buffer "prolog" (current-buffer)
+ pname nil pswitches))
+
+ (unless prolog-system
+ ;; Setup auto-detection.
+ (setq-local
+ prolog-system
+ ;; Force re-detection.
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ (cond
+ ((null pmark) (1- (point-min)))
+ ;; The use of insert-before-markers in comint.el together with
+ ;; the potential use of comint-truncate-buffer in the output
+ ;; filter, means that it's difficult to reliably keep track of
+ ;; the buffer position where the process's output started.
+ ;; If possible we use a marker at "start - 1", so that
+ ;; insert-before-marker at `start' won't shift it. And if not,
+ ;; we fall back on using a plain integer.
+ ((> pmark (point-min)) (copy-marker (1- pmark)))
+ (t (1- pmark)))))
+ (add-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor nil t))
+ (if wait
+ (progn
+ (goto-char (point-max))
+ (while
+ (save-excursion
+ (not
+ (re-search-backward
+ (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
+ nil t)))
+ (sit-for 0.1))))))))
(defun prolog-inferior-buffer (&optional dont-run)
(or (get-buffer "*prolog*")
@@ -2277,7 +2277,7 @@ between them)."
;(goto-char beg)
(if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
end t)
- (replace-regexp-in-string "/" " " (buffer-substring beg (point)))
+ (string-replace "/" " " (buffer-substring beg (point)))
(beginning-of-line)
(when (search-forward-regexp "^[ \t]+" end t)
(buffer-substring beg (point)))))))))
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 15fd2e84393..67c034d0905 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -1,4 +1,4 @@
-;;; ps-mode.el --- PostScript mode for GNU Emacs
+;;; ps-mode.el --- PostScript mode for GNU Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc.
@@ -39,7 +39,6 @@
"Peter Kleiweg <p.c.j.kleiweg@rug.nl>, bug-gnu-emacs@gnu.org")
(require 'comint)
-(require 'easymenu)
(require 'smie)
;; Define core `PostScript' group.
@@ -282,20 +281,20 @@ If nil, use `temporary-file-directory'."
(defvar ps-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-v" 'ps-run-boundingbox)
- (define-key map "\C-c\C-u" 'ps-mode-uncomment-region)
- (define-key map "\C-c\C-t" 'ps-mode-epsf-rich)
- (define-key map "\C-c\C-s" 'ps-run-start)
- (define-key map "\C-c\C-r" 'ps-run-region)
- (define-key map "\C-c\C-q" 'ps-run-quit)
- (define-key map "\C-c\C-p" 'ps-mode-print-buffer)
- (define-key map "\C-c\C-o" 'ps-mode-comment-out-region)
- (define-key map "\C-c\C-k" 'ps-run-kill)
- (define-key map "\C-c\C-j" 'ps-mode-other-newline)
- (define-key map "\C-c\C-l" 'ps-run-clear)
- (define-key map "\C-c\C-b" 'ps-run-buffer)
+ (define-key map "\C-c\C-v" #'ps-run-boundingbox)
+ (define-key map "\C-c\C-u" #'ps-mode-uncomment-region)
+ (define-key map "\C-c\C-t" #'ps-mode-epsf-rich)
+ (define-key map "\C-c\C-s" #'ps-run-start)
+ (define-key map "\C-c\C-r" #'ps-run-region)
+ (define-key map "\C-c\C-q" #'ps-run-quit)
+ (define-key map "\C-c\C-p" #'ps-mode-print-buffer)
+ (define-key map "\C-c\C-o" #'ps-mode-comment-out-region)
+ (define-key map "\C-c\C-k" #'ps-run-kill)
+ (define-key map "\C-c\C-j" #'ps-mode-other-newline)
+ (define-key map "\C-c\C-l" #'ps-run-clear)
+ (define-key map "\C-c\C-b" #'ps-run-buffer)
;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
- (define-key map "\177" 'ps-mode-backward-delete-char)
+ (define-key map "\177" #'ps-mode-backward-delete-char)
map)
"Local keymap to use in PostScript mode.")
@@ -337,10 +336,10 @@ If nil, use `temporary-file-directory'."
(defvar ps-run-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map comint-mode-map)
- (define-key map "\C-c\C-q" 'ps-run-quit)
- (define-key map "\C-c\C-k" 'ps-run-kill)
- (define-key map "\C-c\C-e" 'ps-run-goto-error)
- (define-key map [mouse-2] 'ps-run-mouse-goto-error)
+ (define-key map "\C-c\C-q" #'ps-run-quit)
+ (define-key map "\C-c\C-k" #'ps-run-kill)
+ (define-key map "\C-c\C-e" #'ps-run-goto-error)
+ (define-key map [mouse-2] #'ps-run-mouse-goto-error)
map)
"Local keymap to use in PostScript run mode.")
@@ -1093,7 +1092,7 @@ Use line numbers if `ps-run-error-line-numbers' is not nil."
;;
-(add-hook 'kill-emacs-hook 'ps-run-cleanup)
+(add-hook 'kill-emacs-hook #'ps-run-cleanup)
(provide 'ps-mode)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index afb96974b17..20299c20d28 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -54,14 +54,7 @@
;; `python-nav-backward-statement',
;; `python-nav-beginning-of-statement', `python-nav-end-of-statement',
;; `python-nav-beginning-of-block', `python-nav-end-of-block' and
-;; `python-nav-if-name-main' are included but no bound to any key. At
-;; last but not least the specialized `python-nav-forward-sexp' allows
-;; easy navigation between code blocks. If you prefer `cc-mode'-like
-;; `forward-sexp' movement, setting `forward-sexp-function' to nil is
-;; enough, You can do that using the `python-mode-hook':
-
-;; (add-hook 'python-mode-hook
-;; (lambda () (setq forward-sexp-function nil)))
+;; `python-nav-if-name-main' are included but no bound to any key.
;; Shell interaction: is provided and allows opening Python shells
;; inside Emacs and executing any block of code of your current buffer
@@ -241,14 +234,12 @@
;; 2) Add the following hook in your .emacs:
;; (add-hook 'python-mode-hook
-;; #'(lambda ()
-;; (define-key python-mode-map "\C-m" 'newline-and-indent)))
+;; (lambda ()
+;; (define-key python-mode-map "\C-m" 'newline-and-indent)))
;; I'd recommend the first one since you'll get the same behavior for
;; all modes out-of-the-box.
-;;; TODO:
-
;;; Code:
(require 'ansi-color)
@@ -3094,7 +3085,8 @@ t when called interactively."
(list (read-string "Python command: ") nil t))
(let ((process (or process (python-shell-get-process-or-error msg))))
(if (string-match ".\n+." string) ;Multiline.
- (let* ((temp-file-name (python-shell--save-temp-file string))
+ (let* ((temp-file-name (with-current-buffer (process-buffer process)
+ (python-shell--save-temp-file string)))
(file-name (or (buffer-file-name) temp-file-name)))
(python-shell-send-file file-name process temp-file-name t))
(comint-send-string process string)
@@ -3385,7 +3377,8 @@ user-friendly message if there's no process running; defaults to
t when called interactively."
(interactive "p")
(pop-to-buffer
- (process-buffer (python-shell-get-process-or-error msg)) nil t))
+ (process-buffer (python-shell-get-process-or-error msg))
+ nil 'mark-for-redisplay))
(defun python-shell-send-setup-code ()
"Send all setup code for shell.
@@ -3976,8 +3969,8 @@ Returns the tracked buffer."
"Finish tracking."
(python-pdbtrack-unset-tracked-buffer)
(when python-pdbtrack-kill-buffers
- (mapc #'(lambda (buffer)
- (ignore-errors (kill-buffer buffer)))
+ (mapc (lambda (buffer)
+ (ignore-errors (kill-buffer buffer)))
python-pdbtrack-buffers-to-kill))
(setq python-pdbtrack-buffers-to-kill nil))
@@ -4240,6 +4233,11 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(point)))))
(num-quotes (python-syntax-count-quotes
(char-after str-start-pos) str-start-pos))
+ (str-line-start-pos
+ (save-excursion
+ (goto-char str-start-pos)
+ (beginning-of-line)
+ (point-marker)))
(str-end-pos
(save-excursion
(goto-char (+ str-start-pos num-quotes))
@@ -4263,7 +4261,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
('symmetric (and multi-line-p (cons 1 1)))))
(fill-paragraph-function))
(save-restriction
- (narrow-to-region str-start-pos str-end-pos)
+ (narrow-to-region str-line-start-pos str-end-pos)
(fill-paragraph justify))
(save-excursion
(when (and (python-info-docstring-p) python-fill-docstring-style)
@@ -5501,6 +5499,13 @@ By default messages are considered errors."
:type '(alist :key-type (regexp)
:value-type (symbol)))
+(defcustom python-forward-sexp-function #'python-nav-forward-sexp
+ "Function to use when navigating between expressions."
+ :version "28.1"
+ :type '(choice (const :tag "Python blocks" python-nav-forward-sexp)
+ (const :tag "CC-mode like" nil)
+ function))
+
(defvar-local python--flymake-proc nil)
(defun python--flymake-parse-output (source proc report-fn)
@@ -5598,7 +5603,7 @@ REPORT-FN is Flymake's callback function."
(setq-local parse-sexp-lookup-properties t)
(setq-local parse-sexp-ignore-comments t)
- (setq-local forward-sexp-function #'python-nav-forward-sexp)
+ (setq-local forward-sexp-function python-forward-sexp-function)
(setq-local font-lock-defaults
`(,python-font-lock-keywords
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index e7f407b6367..c09f007a5ee 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -291,6 +291,7 @@ Only has effect when `ruby-use-smie' is nil."
(defcustom ruby-encoding-map
'((us-ascii . nil) ;; Do not put coding: us-ascii
+ (utf-8 . nil) ;; Default since Ruby 2.0
(shift-jis . cp932) ;; Emacs charset name of Shift_JIS
(shift_jis . cp932) ;; MIME charset name of Shift_JIS
(japanese-cp932 . cp932)) ;; Emacs charset name of CP932
@@ -331,7 +332,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(require 'smie)
;; Here's a simplified BNF grammar, for reference:
-;; http://www.cse.buffalo.edu/~regan/cse305/RubyBNF.pdf
+;; https://www.cse.buffalo.edu/~regan/cse305/RubyBNF.pdf
(defconst ruby-smie-grammar
(smie-prec2->grammar
(smie-merge-prec2s
@@ -678,7 +679,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
(let ((index-alist '()) (case-fold-search nil)
name next pos decl sing)
(goto-char beg)
- (while (re-search-forward "^\\s *\\(\\(class\\s +\\|\\(class\\s *<<\\s *\\)\\|module\\s +\\)\\([^(<\n ]+\\)\\|\\(def\\|alias\\)\\s +\\([^(\n ]+\\)\\)" end t)
+ (while (re-search-forward "^\\s *\\(\\(class\\s +\\|\\(class\\s *<<\\s *\\)\\|module\\s +\\)\\([^(<\n ]+\\)\\|\\(\\(?:\\(?:private\\|protected\\|public\\) +\\)?def\\|alias\\)\\s +\\([^(\n ]+\\)\\)" end t)
(setq sing (match-beginning 3))
(setq decl (match-string 5))
(setq next (match-end 0))
@@ -688,7 +689,7 @@ It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
((string= "alias" decl)
(if prefix (setq name (concat prefix name)))
(push (cons name pos) index-alist))
- ((string= "def" decl)
+ ((not (null decl))
(if prefix
(setq name
(cond
@@ -760,7 +761,7 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
(defun ruby--detect-encoding ()
(if (eq ruby-insert-encoding-magic-comment 'always-utf8)
- "utf-8"
+ 'utf-8
(let ((coding-system
(or save-buffer-coding-system
buffer-file-coding-system)))
@@ -769,12 +770,11 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
(or (coding-system-get coding-system 'mime-charset)
(coding-system-change-eol-conversion coding-system nil))))
(if coding-system
- (symbol-name
- (if ruby-use-encoding-map
- (let ((elt (assq coding-system ruby-encoding-map)))
- (if elt (cdr elt) coding-system))
- coding-system))
- "ascii-8bit"))))
+ (if ruby-use-encoding-map
+ (let ((elt (assq coding-system ruby-encoding-map)))
+ (if elt (cdr elt) coding-system))
+ coding-system)
+ 'ascii-8bit))))
(defun ruby--encoding-comment-required-p ()
(or (eq ruby-insert-encoding-magic-comment 'always-utf8)
@@ -796,7 +796,7 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
(unless (string= (match-string 2) coding-system)
(goto-char (match-beginning 2))
(delete-region (point) (match-end 2))
- (insert coding-system)))
+ (insert (symbol-name coding-system))))
((looking-at "\\s *#.*coding\\s *[:=]"))
(t (when ruby-insert-encoding-magic-comment
(ruby--insert-coding-comment coding-system))))
@@ -1788,8 +1788,8 @@ If the result is do-end block, it will always be multiline."
(buffer-substring-no-properties (1+ min) (1- max))))
(setq content
(if (equal string-quote "'")
- (replace-regexp-in-string "\\\\\"" "\"" (replace-regexp-in-string "\\(\\`\\|[^\\]\\)'" "\\1\\\\'" content))
- (replace-regexp-in-string "\\\\'" "'" (replace-regexp-in-string "\\(\\`\\|[^\\]\\)\"" "\\1\\\\\"" content))))
+ (string-replace "\\\"" "\"" (replace-regexp-in-string "\\(\\`\\|[^\\]\\)'" "\\1\\\\'" content))
+ (string-replace "\\'" "'" (replace-regexp-in-string "\\(\\`\\|[^\\]\\)\"" "\\1\\\\\"" content))))
(let ((orig-point (point)))
(delete-region min max)
(insert
@@ -1802,12 +1802,12 @@ FEATURE-NAME is a relative file name, file extension is optional.
This commands delegates to `gem which', which searches both
installed gems and the standard library. When called
interactively, defaults to the feature name in the `require'
-statement around point."
+or `gem' statement around point."
(interactive)
(unless feature-name
(let ((init (save-excursion
(forward-line 0)
- (when (looking-at "require [\"']\\(.*\\)[\"']")
+ (when (looking-at "\\(?:require\\| *gem\\) [\"']\\(.*?\\)[\"']")
(match-string 1)))))
(setq feature-name (read-string "Feature name: " init))))
(let ((out
@@ -2127,11 +2127,9 @@ It will be properly highlighted even when the call omits parens.")
"loop"
"open"
"p"
- "print"
"printf"
"proc"
"putc"
- "puts"
"require"
"require_relative"
"spawn"
@@ -2180,9 +2178,11 @@ It will be properly highlighted even when the call omits parens.")
"fork"
"global_variables"
"local_variables"
+ "print"
"private"
"protected"
"public"
+ "puts"
"raise"
"rand"
"readline"
@@ -2421,6 +2421,15 @@ If there is no Rubocop config file, Rubocop will be passed a flag
report-fn
args))
+(defconst ruby--prettify-symbols-alist
+ '(("<=" . ?≤)
+ (">=" . ?≥)
+ ("->" . ?→)
+ ("=>" . ?⇒)
+ ("::" . ?∷)
+ ("lambda" . ?λ))
+ "Value for `prettify-symbols-alist' in `ruby-mode'.")
+
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby code."
@@ -2437,6 +2446,7 @@ If there is no Rubocop config file, Rubocop will be passed a flag
(setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil
((?_ . "w"))))
+ (setq-local prettify-symbols-alist ruby--prettify-symbols-alist)
(setq-local syntax-propertize-function #'ruby-syntax-propertize))
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index f610efbfca5..57351a7308d 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -28,7 +28,7 @@
;; the Lisp mode documented in the Emacs manual. `dsssl-mode' is a
;; variant of scheme-mode for editing DSSSL specifications for SGML
;; documents. [As of Apr 1997, some pointers for DSSSL may be found,
-;; for instance, at <URL:http://www.sil.org/sgml/related.html#dsssl>.]
+;; for instance, at <URL:https://www.sil.org/sgml/related.html#dsssl>.]
;; All these Lisp-ish modes vary basically in details of the language
;; syntax they highlight/indent/index, but dsssl-mode uses "^;;;" as
;; the page-delimiter since ^L isn't normally a valid SGML character.
@@ -162,25 +162,26 @@
(defvar scheme-mode-line-process "")
(defvar scheme-mode-map
- (let ((smap (make-sparse-keymap))
- (map (make-sparse-keymap "Scheme")))
- (set-keymap-parent smap lisp-mode-shared-map)
- (define-key smap [menu-bar scheme] (cons "Scheme" map))
- (define-key map [run-scheme] '("Run Inferior Scheme" . run-scheme))
- (define-key map [uncomment-region]
- '("Uncomment Out Region" . (lambda (beg end)
- (interactive "r")
- (comment-region beg end '(4)))))
- (define-key map [comment-region] '("Comment Out Region" . comment-region))
- (define-key map [indent-region] '("Indent Region" . indent-region))
- (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
- (put 'comment-region 'menu-enable 'mark-active)
- (put 'uncomment-region 'menu-enable 'mark-active)
- (put 'indent-region 'menu-enable 'mark-active)
- smap)
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map lisp-mode-shared-map)
+ map)
"Keymap for Scheme mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
+(easy-menu-define scheme-mode-menu scheme-mode-map
+ "Menu for Scheme mode."
+ '("Scheme"
+ ["Indent Line" lisp-indent-line]
+ ["Indent Region" indent-region
+ :enable mark-active]
+ ["Comment Out Region" comment-region
+ :enable mark-active]
+ ["Uncomment Out Region" (lambda (beg end)
+ (interactive "r")
+ (comment-region beg end '(4)))
+ :enable mark-active]
+ ["Run Inferior Scheme" run-scheme]))
+
;; Used by cmuscheme
(defun scheme-mode-commands (map)
;;(define-key map "\t" 'indent-for-tab-command) ; default
@@ -215,8 +216,7 @@ Blank lines separate paragraphs. Semicolons start comments.
(defcustom scheme-mit-dialect t
"If non-nil, scheme mode is specialized for MIT Scheme.
Set this to nil if you normally use another dialect."
- :type 'boolean
- :group 'scheme)
+ :type 'boolean)
(defcustom dsssl-sgml-declaration
"<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
@@ -226,26 +226,22 @@ If it is defined as a string this will be inserted into an empty buffer
which is in `dsssl-mode'. It is typically James Clark's style-sheet
doctype, as required for Jade."
:type '(choice (string :tag "Specified string")
- (const :tag "None" :value nil))
- :group 'scheme)
+ (const :tag "None" :value nil)))
(defcustom scheme-mode-hook nil
"Normal hook run when entering `scheme-mode'.
See `run-hooks'."
- :type 'hook
- :group 'scheme)
+ :type 'hook)
(defcustom dsssl-mode-hook nil
"Normal hook run when entering `dsssl-mode'.
See `run-hooks'."
- :type 'hook
- :group 'scheme)
+ :type 'hook)
;; This is shared by cmuscheme and xscheme.
(defcustom scheme-program-name "scheme"
"Program invoked by the `run-scheme' command."
- :type 'string
- :group 'scheme)
+ :type 'string)
(defvar dsssl-imenu-generic-expression
;; Perhaps this should also look for the style-sheet DTD tags. I'm
@@ -303,7 +299,9 @@ See `run-hooks'."
(concat
"(" (regexp-opt
'("begin" "call-with-current-continuation" "call/cc"
- "call-with-input-file" "call-with-output-file" "case" "cond"
+ "call-with-input-file" "call-with-output-file"
+ "call-with-port"
+ "case" "cond"
"do" "else" "for-each" "if" "lambda" "λ"
"let" "let*" "let-syntax" "letrec" "letrec-syntax"
;; R6RS library subforms.
@@ -429,12 +427,10 @@ that variable's value is a string."
'(1 font-lock-keyword-face)
'(4 font-lock-function-name-face))
(cons
- (concat "(\\("
- ;; (make-regexp '("case" "cond" "else" "if" "lambda"
- ;; "let" "let*" "letrec" "and" "or" "map" "with-mode"))
- "and\\|c\\(ase\\|ond\\)\\|else\\|if\\|"
- "l\\(ambda\\|et\\(\\|\\*\\|rec\\)\\)\\|map\\|or\\|with-mode"
- "\\)\\>")
+ (concat "(" (regexp-opt
+ '("case" "cond" "else" "if" "lambda"
+ "let" "let*" "letrec" "and" "or" "map" "with-mode")
+ 'words))
1)
;; DSSSL syntax
'("(\\(element\\|mode\\|declare-\\w+\\)\\>[ \t]*\\(\\sw+\\)"
@@ -548,6 +544,7 @@ indentation."
(put 'library 'scheme-indent-function 1) ; R6RS
(put 'call-with-input-file 'scheme-indent-function 1)
+(put 'call-with-port 'scheme-indent-function 1)
(put 'with-input-from-file 'scheme-indent-function 1)
(put 'with-input-from-port 'scheme-indent-function 1)
(put 'call-with-output-file 'scheme-indent-function 1)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index f588ad99c9d..b6674731ddf 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -403,8 +403,7 @@ This is buffer-local in every such buffer.")
"Syntax-table used in Shell-Script mode. See `sh-feature'.")
(defvar sh-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c(" 'sh-function)
(define-key map "\C-c\C-w" 'sh-while)
(define-key map "\C-c\C-u" 'sh-until)
@@ -434,74 +433,57 @@ This is buffer-local in every such buffer.")
(define-key map "\C-c:" 'sh-set-shell)
(define-key map [remap backward-sentence] 'sh-beginning-of-command)
(define-key map [remap forward-sentence] 'sh-end-of-command)
- (define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map))
- (define-key menu-map [smie-config-guess]
- '(menu-item "Learn buffer indentation" smie-config-guess
- :help "Learn how to indent the buffer the way it currently is."))
- (define-key menu-map [smie-config-show-indent]
- '(menu-item "Show indentation" smie-config-show-indent
- :help "Show the how the current line would be indented"))
- (define-key menu-map [smie-config-set-indent]
- '(menu-item "Set indentation" smie-config-set-indent
- :help "Set the indentation for the current line"))
-
- (define-key menu-map [sh-pair]
- '(menu-item "Insert braces and quotes in pairs"
- electric-pair-mode
- :button (:toggle . (bound-and-true-p electric-pair-mode))
- :help "Inserting a brace or quote automatically inserts the matching pair"))
-
- (define-key menu-map [sh-s0] '("--"))
- ;; Insert
- (define-key menu-map [sh-function]
- '(menu-item "Function..." sh-function
- :help "Insert a function definition"))
- (define-key menu-map [sh-add]
- '(menu-item "Addition..." sh-add
- :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"))
- (define-key menu-map [sh-until]
- '(menu-item "Until Loop" sh-until
- :help "Insert an until loop"))
- (define-key menu-map [sh-repeat]
- '(menu-item "Repeat Loop" sh-repeat
- :help "Insert a repeat loop definition"))
- (define-key menu-map [sh-while]
- '(menu-item "While Loop" sh-while
- :help "Insert a while loop"))
- (define-key menu-map [sh-getopts]
- '(menu-item "Options Loop" sh-while-getopts
- :help "Insert a while getopts loop."))
- (define-key menu-map [sh-indexed-loop]
- '(menu-item "Indexed Loop" sh-indexed-loop
- :help "Insert an indexed loop from 1 to n."))
- (define-key menu-map [sh-select]
- '(menu-item "Select Statement" sh-select
- :help "Insert a select statement "))
- (define-key menu-map [sh-if]
- '(menu-item "If Statement" sh-if
- :help "Insert an if statement"))
- (define-key menu-map [sh-for]
- '(menu-item "For Loop" sh-for
- :help "Insert a for loop"))
- (define-key menu-map [sh-case]
- '(menu-item "Case Statement" sh-case
- :help "Insert a case/switch statement"))
- (define-key menu-map [sh-s1] '("--"))
- (define-key menu-map [sh-exec]
- '(menu-item "Execute region" sh-execute-region
- :help "Pass optional header and region to a subshell for noninteractive execution"))
- (define-key menu-map [sh-exec-interpret]
- '(menu-item "Execute script..." executable-interpret
- :help "Run script with user-specified args, and collect output in a buffer"))
- (define-key menu-map [sh-set-shell]
- '(menu-item "Set shell type..." sh-set-shell
- :help "Set this buffer's shell to SHELL (a string)"))
- (define-key menu-map [sh-backslash-region]
- '(menu-item "Backslash region" sh-backslash-region
- :help "Insert, align, or delete end-of-line backslashes on the lines in the region."))
map)
"Keymap used in Shell-Script mode.")
+(easy-menu-define sh-mode-menu sh-mode-map
+ "Menu for Shell-Script mode."
+ '("Sh-Script"
+ ["Backslash region" sh-backslash-region
+ :help "Insert, align, or delete end-of-line backslashes on the lines in the region."]
+ ["Set shell type..." sh-set-shell
+ :help "Set this buffer's shell to SHELL (a string)"]
+ ["Execute script..." executable-interpret
+ :help "Run script with user-specified args, and collect output in a buffer"]
+ ["Execute region" sh-execute-region
+ :help "Pass optional header and region to a subshell for noninteractive execution"]
+ "---"
+ ;; Insert
+ ["Case Statement" sh-case
+ :help "Insert a case/switch statement"]
+ ["For Loop" sh-for
+ :help "Insert a for loop"]
+ ["If Statement" sh-if
+ :help "Insert an if statement"]
+ ["Select Statement" sh-select
+ :help "Insert a select statement "]
+ ["Indexed Loop" sh-indexed-loop
+ :help "Insert an indexed loop from 1 to n."]
+ ["Options Loop" sh-while-getopts
+ :help "Insert a while getopts loop."]
+ ["While Loop" sh-while
+ :help "Insert a while loop"]
+ ["Repeat Loop" sh-repeat
+ :help "Insert a repeat loop definition"]
+ ["Until Loop" sh-until
+ :help "Insert an until loop"]
+ ["Addition..." sh-add
+ :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"]
+ ["Function..." sh-function
+ :help "Insert a function definition"]
+ "---"
+ ;; Other
+ ["Insert braces and quotes in pairs" electric-pair-mode
+ :style toggle
+ :selected (bound-and-true-p electric-pair-mode)
+ :help "Inserting a brace or quote automatically inserts the matching pair"]
+ ["Set indentation" smie-config-set-indent
+ :help "Set the indentation for the current line"]
+ ["Show indentation" smie-config-show-indent
+ :help "Show the how the current line would be indented"]
+ ["Learn buffer indentation" smie-config-guess
+ :help "Learn how to indent the buffer the way it currently is."]))
+
(defvar sh-skeleton-pair-default-alist '((?\( _ ?\)) (?\))
(?\[ ?\s _ ?\s ?\]) (?\])
(?{ _ ?}) (?\}))
@@ -1550,6 +1532,7 @@ with your script for an edit-interpret-debug cycle."
(setq-local add-log-current-defun-function #'sh-current-defun-name)
(add-hook 'completion-at-point-functions
#'sh-completion-at-point-function nil t)
+ (setq-local outline-regexp "###")
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell
@@ -1614,6 +1597,8 @@ This adds rules for comments and assignments."
;;; Completion
+(defvar sh--completion-keywords '("if" "while" "until" "for"))
+
(defun sh--vars-before-point ()
(save-excursion
(let ((vars ()))
@@ -1635,7 +1620,7 @@ This adds rules for comments and assignments."
(sh--vars-before-point))
(locate-file-completion-table
exec-path exec-suffixes string pred t)
- '("if" "while" "until" "for"))))
+ sh--completion-keywords)))
(complete-with-action action cmds string pred)))
(defun sh-completion-at-point-function ()
@@ -1646,9 +1631,17 @@ This adds rules for comments and assignments."
(start (point)))
(cond
((eq (char-before) ?$)
- (list start end (sh--vars-before-point)))
+ (list start end (sh--vars-before-point)
+ :company-kind (lambda (_) 'variable)))
((sh-smie--keyword-p)
- (list start end #'sh--cmd-completion-table))))))
+ (list start end #'sh--cmd-completion-table
+ :company-kind
+ (lambda (s)
+ (cond
+ ((member s sh--completion-keywords) 'keyword)
+ ((string-suffix-p "=" s) 'variable)
+ (t 'function)))
+ ))))))
;;; Indentation and navigation with SMIE.
@@ -2200,6 +2193,8 @@ Point should be before the newline."
When used interactively, insert the proper starting #!-line,
and make the visited file executable via `executable-set-magic',
perhaps querying depending on the value of `executable-query'.
+(If given a prefix (i.e., `C-u') don't insert any starting #!
+line.)
When this function is called noninteractively, INSERT-FLAG (the third
argument) controls whether to insert a #!-line and think about making
@@ -2223,7 +2218,7 @@ whose value is the shell name (don't quote it)."
'("csh" "rc" "sh"))
nil nil nil nil sh-shell-file)
(eq executable-query 'function)
- t))
+ (not current-prefix-arg)))
(if (string-match "\\.exe\\'" shell)
(setq shell (substring shell 0 (match-beginning 0))))
(setq sh-shell (sh-canonicalize-shell shell))
@@ -2678,7 +2673,7 @@ t means to return a list of all possible completions of STRING.
(or sh-shell-variables-initialized
(sh-shell-initialize-variables))
(nconc (mapcar (lambda (var)
- (substring var 0 (string-match "=" var)))
+ (substring var 0 (string-search "=" var)))
process-environment)
sh-shell-variables))))
(complete-with-action code vars string predicate)))
@@ -2985,7 +2980,7 @@ The document is bounded by `sh-here-document-word'."
(define-minor-mode sh-electric-here-document-mode
"Make << insert a here document skeleton."
- nil nil nil
+ :lighter nil
(if sh-electric-here-document-mode
(add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t)
(remove-hook 'post-self-insert-hook #'sh--maybe-here-document t)))
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index a863e7eb4b4..7c0de9fc359 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -1,4 +1,4 @@
-;;; simula.el --- SIMULA 87 code editing commands for Emacs
+;;; simula.el --- SIMULA 87 code editing commands for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1992, 1994, 1996, 2001-2021 Free Software Foundation,
;; Inc.
@@ -51,16 +51,15 @@ the run of whitespace at the beginning of the line.")
"Non-nil means TAB in SIMULA mode should always reindent the current line.
Otherwise TAB indents only when point is within
the run of whitespace at the beginning of the line."
- :type 'boolean
- :group 'simula)
+ :type 'boolean)
+(make-obsolete-variable 'simula-tab-always-indent 'tab-always-indent "28.1")
(defconst simula-indent-level-default 3
"Indentation of SIMULA statements with respect to containing block.")
(defcustom simula-indent-level simula-indent-level-default
"Indentation of SIMULA statements with respect to containing block."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-substatement-offset-default 3
@@ -68,8 +67,7 @@ the run of whitespace at the beginning of the line."
(defcustom simula-substatement-offset simula-substatement-offset-default
"Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-continued-statement-offset-default 3
"Extra indentation for lines not starting a statement or substatement.
@@ -83,16 +81,14 @@ the previous line of the statement.")
If value is a list, each line in a multipleline continued statement
will have the car of the list extra indentation with respect to
the previous line of the statement."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-label-offset-default -4711
"Offset of SIMULA label lines relative to usual indentation.")
(defcustom simula-label-offset simula-label-offset-default
"Offset of SIMULA label lines relative to usual indentation."
- :type 'integer
- :group 'simula)
+ :type 'integer)
(defconst simula-if-indent-default '(0 . 0)
"Extra indentation of THEN and ELSE with respect to the starting IF.
@@ -103,8 +99,7 @@ extra ELSE indentation. IF after ELSE is indented as the starting IF.")
"Extra indentation of THEN and ELSE with respect to the starting IF.
Value is a cons cell, the car is extra THEN indentation and the cdr
extra ELSE indentation. IF after ELSE is indented as the starting IF."
- :type '(cons integer integer)
- :group 'simula)
+ :type '(cons integer integer))
(defconst simula-inspect-indent-default '(0 . 0)
"Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
@@ -115,16 +110,14 @@ and the cdr extra OTHERWISE indentation.")
"Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
Value is a cons cell, the car is extra WHEN indentation
and the cdr extra OTHERWISE indentation."
- :type '(cons integer integer)
- :group 'simula)
+ :type '(cons integer integer))
(defconst simula-electric-indent-default nil
"Non-nil means `simula-indent-line' function may reindent previous line.")
(defcustom simula-electric-indent simula-electric-indent-default
"Non-nil means `simula-indent-line' function may reindent previous line."
- :type 'boolean
- :group 'simula)
+ :type 'boolean)
(defconst simula-abbrev-keyword-default 'upcase
"Specify how to convert case for SIMULA keywords.
@@ -135,8 +128,7 @@ Value is one of the symbols `upcase', `downcase', `capitalize',
"Specify how to convert case for SIMULA keywords.
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table' or nil if they should not be changed."
- :type '(choice (const upcase) (const downcase) (const capitalize)(const nil))
- :group 'simula)
+ :type '(choice (const upcase) (const downcase) (const capitalize)(const nil)))
(defconst simula-abbrev-stdproc-default 'abbrev-table
"Specify how to convert case for standard SIMULA procedure and class names.
@@ -148,18 +140,33 @@ Value is one of the symbols `upcase', `downcase', `capitalize',
Value is one of the symbols `upcase', `downcase', `capitalize',
\(as in) `abbrev-table', or nil if they should not be changed."
:type '(choice (const upcase) (const downcase) (const capitalize)
- (const abbrev-table) (const nil))
- :group 'simula)
+ (const abbrev-table) (const nil)))
(defcustom simula-abbrev-file nil
"File with extra abbrev definitions for use in SIMULA mode.
These are used together with the standard abbrev definitions for SIMULA.
Please note that the standard definitions are required
for SIMULA mode to function correctly."
- :type '(choice file (const nil))
- :group 'simula)
-
-(defvar simula-mode-syntax-table nil
+ :type '(choice file (const nil)))
+
+(defvar simula-mode-syntax-table
+ (let ((st (copy-syntax-table (standard-syntax-table))))
+ (modify-syntax-entry ?! "<" st)
+ (modify-syntax-entry ?$ "." st)
+ (modify-syntax-entry ?% "< b" st)
+ (modify-syntax-entry ?\n "> b" st)
+ (modify-syntax-entry ?' "\"" st)
+ (modify-syntax-entry ?\( "()" st)
+ (modify-syntax-entry ?\) ")(" st)
+ (modify-syntax-entry ?\; ">" st)
+ (modify-syntax-entry ?\[ "." st)
+ (modify-syntax-entry ?\\ "." st)
+ (modify-syntax-entry ?\] "." st)
+ (modify-syntax-entry ?_ "_" st)
+ (modify-syntax-entry ?\| "." st)
+ (modify-syntax-entry ?\{ "." st)
+ (modify-syntax-entry ?\} "." st)
+ st)
"Syntax table in SIMULA mode buffers.")
(defconst simula-syntax-propertize-function
@@ -248,90 +255,45 @@ for SIMULA mode to function correctly."
["Forward Statement" simula-next-statement t]
["Backward Up Level" simula-backward-up-level t]
["Forward Down Statement" simula-forward-down-level t])
- "Lucid Emacs menu for SIMULA mode.")
-
-(if simula-mode-syntax-table
- ()
- (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
- (modify-syntax-entry ?! "<" simula-mode-syntax-table)
- (modify-syntax-entry ?$ "." simula-mode-syntax-table)
- (modify-syntax-entry ?% "< b" simula-mode-syntax-table)
- (modify-syntax-entry ?\n "> b" simula-mode-syntax-table)
- (modify-syntax-entry ?' "\"" simula-mode-syntax-table)
- (modify-syntax-entry ?\( "()" simula-mode-syntax-table)
- (modify-syntax-entry ?\) ")(" simula-mode-syntax-table)
- (modify-syntax-entry ?\; ">" simula-mode-syntax-table)
- (modify-syntax-entry ?\[ "." simula-mode-syntax-table)
- (modify-syntax-entry ?\\ "." simula-mode-syntax-table)
- (modify-syntax-entry ?\] "." simula-mode-syntax-table)
- (modify-syntax-entry ?_ "_" simula-mode-syntax-table)
- (modify-syntax-entry ?\| "." simula-mode-syntax-table)
- (modify-syntax-entry ?\{ "." simula-mode-syntax-table)
- (modify-syntax-entry ?\} "." simula-mode-syntax-table))
+ "Emacs menu for SIMULA mode.")
(defvar simula-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-u" 'simula-backward-up-level)
- (define-key map "\C-c\C-p" 'simula-previous-statement)
- (define-key map "\C-c\C-d" 'simula-forward-down-level)
- (define-key map "\C-c\C-n" 'simula-next-statement)
- ;; (define-key map "\C-c\C-g" 'simula-goto-definition)
- ;; (define-key map "\C-c\C-h" 'simula-standard-help)
- (define-key map "\177" 'backward-delete-char-untabify)
- (define-key map ":" 'simula-electric-label)
- (define-key map "\e\C-q" 'simula-indent-exp)
- (define-key map "\t" 'simula-indent-command)
-
- (define-key map [menu-bar simula]
- (cons "SIMULA" (make-sparse-keymap "SIMULA")))
- (define-key map [menu-bar simula indent-exp]
- '("Indent Expression" . simula-indent-exp))
- (define-key map [menu-bar simula indent-line]
- '("Indent Line" . simula-indent-command))
- (define-key map [menu-bar simula separator-navigate]
- '("--"))
- (define-key map [menu-bar simula backward-stmt]
- '("Previous Statement" . simula-previous-statement))
- (define-key map [menu-bar simula forward-stmt]
- '("Next Statement" . simula-next-statement))
- (define-key map [menu-bar simula backward-up]
- '("Backward Up Level" . simula-backward-up-level))
- (define-key map [menu-bar simula forward-down]
- '("Forward Down Statement" . simula-forward-down-level))
-
- (put 'simula-next-statement 'menu-enable '(not (eobp)))
- (put 'simula-previous-statement 'menu-enable '(not (bobp)))
- (put 'simula-forward-down-level 'menu-enable '(not (eobp)))
- (put 'simula-backward-up-level 'menu-enable '(not (bobp)))
- (put 'simula-indent-command 'menu-enable '(not buffer-read-only))
- (put 'simula-indent-exp 'menu-enable '(not buffer-read-only))
-
- ;; RMS: mouse-3 should not select this menu. mouse-3's global
- ;; definition is useful in SIMULA mode and we should not interfere
- ;; with that. The menu is mainly for beginners, and for them,
- ;; the menubar requires less memory than a special click.
- ;; in Lucid Emacs, we want the menu to popup when the 3rd button is
- ;; hit. In 19.10 and beyond this is done automatically if we put
- ;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el]
- ;;(if (not (boundp 'mode-popup-menu))
- ;; (define-key simula-mode-map 'button3 'simula-popup-menu))
+ (define-key map "\C-c\C-u" #'simula-backward-up-level)
+ (define-key map "\C-c\C-p" #'simula-previous-statement)
+ (define-key map "\C-c\C-d" #'simula-forward-down-level)
+ (define-key map "\C-c\C-n" #'simula-next-statement)
+ ;; (define-key map "\C-c\C-g" #'simula-goto-definition)
+ ;; (define-key map "\C-c\C-h" #'simula-standard-help)
+ (define-key map "\177" #'backward-delete-char-untabify)
+ (define-key map ":" #'simula-electric-label)
+ (define-key map "\e\C-q" #'simula-indent-exp)
+ ;; (define-key map "\t" #'simula-indent-command)
map)
"Keymap used in `simula-mode'.")
-;; menus for Lucid
-(defun simula-popup-menu (_e)
- "Pops up the SIMULA menu."
- (interactive "@e")
- (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu)))
+(easy-menu-define simula-mode-menu simula-mode-map
+ "Menu for `simula-mode'."
+ '("SIMULA"
+ ["Forward Down Statement" simula-forward-down-level
+ :enable (not (eobp))]
+ ["Backward Up Level" simula-backward-up-level
+ :enable (not (bobp))]
+ ["Next Statement" simula-next-statement
+ :enable (not (eobp))]
+ ["Previous Statement" simula-previous-statement
+ :enable (not (bobp))]
+ "---"
+ ;; ["Indent Line" simula-indent-command
+ ;; :enable (not buffer-read-only)]
+ ["Indent Expression" simula-indent-exp
+ :enable (not buffer-read-only)]))
;;;###autoload
(define-derived-mode simula-mode prog-mode "Simula"
"Major mode for editing SIMULA code.
\\{simula-mode-map}
Variables controlling indentation style:
- `simula-tab-always-indent'
- Non-nil means TAB in SIMULA mode should always reindent the current line,
- regardless of where in the line point is when the TAB command is used.
`simula-indent-level'
Indentation of SIMULA statements with respect to containing block.
`simula-substatement-offset'
@@ -369,7 +331,7 @@ with no arguments, if that value is non-nil."
;; (setq-local end-comment-column 75)
(setq-local paragraph-start "[ \t]*$\\|\f")
(setq-local paragraph-separate paragraph-start)
- (setq-local indent-line-function 'simula-indent-line)
+ (setq-local indent-line-function #'simula-indent-line)
(setq-local comment-start "! ")
(setq-local comment-end " ;")
(setq-local comment-start-skip "!+ *")
@@ -449,6 +411,7 @@ A numeric argument, regardless of its value, means indent rigidly
all the lines of the SIMULA statement after point so that this line
becomes properly indented.
The relative indentation among the lines of the statement are preserved."
+ (declare (obsolete indent-for-tab-command "28.1"))
(interactive "P")
(let ((case-fold-search t))
(if (or whole-exp simula-tab-always-indent
@@ -1598,20 +1561,8 @@ If not nil and not t, move to limit of search and return nil."
(simula-install-standard-abbrevs))
;; Hilit mode support.
-(when (fboundp 'hilit-set-mode-patterns)
- (when (and (boundp 'hilit-patterns-alist)
- (not (assoc 'simula-mode hilit-patterns-alist)))
- (hilit-set-mode-patterns
- 'simula-mode
- '(
- ("^%\\([ \t\f].*\\)?$" nil comment)
- ("^%include\\>" nil include)
- ("\"[^\"\n]*\"\\|'.'\\|'![0-9]+!'" nil string)
- ("\\<\\(ACTIVATE\\|AFTER\\|AND\\|ARRAY\\|AT\\|BEFORE\\|BEGIN\\|BOOLEAN\\|CHARACTER\\|CLASS\\|DELAY\\|DO\\|ELSE\\|END\\|EQ\\|EQV\\|EXTERNAL\\|FALSE\\|FOR\\|GE\\|GO\\|GOTO\\|GT\\|HIDDEN\\|IF\\|IMP\\|IN\\|INNER\\|INSPECT\\|INTEGER\\|IS\\|LABEL\\|LE\\|LONG\\|LT\\|NAME\\|NE\\|NEW\\|NONE\\|NOT\\|NOTEXT\\|OR\\|OTHERWISE\\|PRIOR\\|PROCEDURE\\|PROTECTED\\|QUA\\|REACTIVATE\\|REAL\\|REF\\|SHORT\\|STEP\\|SWITCH\\|TEXT\\|THEN\\|THIS\\|TO\\|TRUE\\|UNTIL\\|VALUE\\|VIRTUAL\\|WHEN\\|WHILE\\)\\>" nil keyword)
- ("!\\|\\<COMMENT\\>" ";" comment))
- nil 'case-insensitive)))
-;; defuns for submitting bug reports
+;; obsolete
(defconst simula-mode-help-address "bug-gnu-emacs@gnu.org"
"Address accepting submission of `simula-mode' bug reports.")
@@ -1620,7 +1571,13 @@ If not nil and not t, move to limit of search and return nil."
"24.4")
(define-obsolete-function-alias 'simula-submit-bug-report
- 'report-emacs-bug "24.4")
+ #'report-emacs-bug "24.4")
+
+(defun simula-popup-menu (_e)
+ "Pops up the SIMULA menu."
+ (declare (obsolete simula-mode-menu "28.1"))
+ (interactive "@e")
+ (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu)))
(provide 'simula)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index f1f4d61324b..d144d68b571 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -484,6 +484,7 @@ file. Since that is a plaintext file, this could be dangerous."
:prompt-regexp "^[[:alnum:]_]*=[#>] "
:prompt-length 5
:prompt-cont-regexp "^[[:alnum:]_]*[-(][#>] "
+ :statement sql-postgres-statement-starters
:input-filter sql-remove-tabs-filter
:terminator ("\\(^\\s-*\\\\g\\|;\\)" . "\\g"))
@@ -997,20 +998,6 @@ for the first time."
:version "24.1"
:type 'hook)
-;; Customization for ANSI
-
-(defcustom sql-ansi-statement-starters
- (regexp-opt '("create" "alter" "drop"
- "select" "insert" "update" "delete" "merge"
- "grant" "revoke"))
- "Regexp of keywords that start SQL commands.
-
-All products share this list; products should define a regexp to
-identify additional keywords in a variable defined by
-the :statement feature."
- :version "24.1"
- :type 'regexp)
-
;; Customization for Oracle
(defcustom sql-oracle-program "sqlplus"
@@ -1033,12 +1020,6 @@ You will find the file in your Orant\\bin directory."
:type 'sql-login-params
:version "24.1")
-(defcustom sql-oracle-statement-starters
- (regexp-opt '("declare" "begin" "with"))
- "Additional statement starting keywords in Oracle."
- :version "24.1"
- :type 'string)
-
(defcustom sql-oracle-scan-on t
"Non-nil if placeholders should be replaced in Oracle SQLi.
@@ -1502,6 +1483,26 @@ Based on `comint-mode-map'.")
table)
"Syntax table used in `sql-mode' and `sql-interactive-mode'.")
+;; Motion Function Keywords
+
+(defvar sql-ansi-statement-starters
+ (regexp-opt '("create" "alter" "drop"
+ "select" "insert" "update" "delete" "merge"
+ "grant" "revoke"))
+ "Regexp of keywords that start SQL commands.
+
+All products share this list; products should define a regexp to
+identify additional keywords in a variable defined by
+the :statement feature.")
+
+(defvar sql-oracle-statement-starters
+ (regexp-opt '("declare" "begin" "with"))
+ "Additional statement-starting keywords in Oracle.")
+
+(defvar sql-postgres-statement-starters
+ (regexp-opt '("with"))
+ "Additional statement-starting keywords in Postgres.")
+
;; Font lock support
(defvar sql-mode-font-lock-object-name
@@ -1545,9 +1546,7 @@ statement. The format of variable should be a valid
;; `sql-font-lock-keywords-builder' function and follow the
;; implementation pattern used for the other products in this file.
-(eval-when-compile
- (defvar sql-mode-ansi-font-lock-keywords)
- (setq sql-mode-ansi-font-lock-keywords nil))
+(defvar sql-mode-ansi-font-lock-keywords)
(eval-and-compile
(defun sql-font-lock-keywords-builder (face boundaries &rest keywords)
@@ -1574,7 +1573,7 @@ statement. The format of variable should be a valid
face)))
(defun sql-regexp-abbrev (keyword)
- (let ((brk (string-match "[~]" keyword))
+ (let ((brk (string-search "~" keyword))
(len (length keyword))
(sep "\\(?:")
re i)
@@ -2992,7 +2991,7 @@ displayed."
;; (defconst sql-smie-grammar
;; (smie-prec2->grammar
;; (smie-bnf->prec2
-;; ;; Partly based on http://www.h2database.com/html/grammar.html
+;; ;; Partly based on https://www.h2database.com/html/grammar.html
;; '((cmd ("SELECT" select-exp "FROM" select-table-exp)
;; )
;; (select-exp ("*") (exp) (exp "AS" column-alias))
@@ -3725,8 +3724,7 @@ to avoid deleting non-prompt output."
;; If we've found all the expected prompts, stop looking
(if (= sql-output-newline-count 0)
- (setq sql-output-newline-count nil
- oline (concat "\n" oline))
+ (setq sql-output-newline-count nil)
;; Still more possible prompts, leave them for the next pass
(setq sql-preoutput-hold oline
@@ -3771,6 +3769,8 @@ to avoid deleting non-prompt output."
(with-current-buffer sql-buffer
(when sql-debug-send
(message ">>SQL> %S" s))
+ (insert "\n")
+ (comint-set-process-mark)
;; Send the string (trim the trailing whitespace)
(sql-input-sender (get-buffer-process (current-buffer)) s)
@@ -3843,7 +3843,7 @@ to avoid deleting non-prompt output."
(defun sql-remove-tabs-filter (str)
"Replace tab characters with spaces."
- (replace-regexp-in-string "\t" " " str nil t))
+ (string-replace "\t" " " str))
(defun sql-toggle-pop-to-buffer-after-send-region (&optional value)
"Toggle `sql-pop-to-buffer-after-send-region'.
@@ -3864,7 +3864,7 @@ If given the optional parameter VALUE, sets
"If non-nil, display messages related to the use of redirection.")
(defun sql-str-literal (s)
- (concat "'" (replace-regexp-in-string "[']" "''" s) "'"))
+ (concat "'" (string-replace "[']" "''" s) "'"))
(defun sql-redirect (sqlbuf command &optional outbuf save-prior)
"Execute the SQL command and send output to OUTBUF.
@@ -5608,7 +5608,7 @@ The default value disables the internal pager."
(provide 'sql)
-;;; sql.el ends here
-
; LocalWords: sql SQL SQLite sqlite Sybase Informix MySQL
; LocalWords: Postgres SQLServer SQLi
+
+;;; sql.el ends here
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 82e1343e057..f6a50bf1a88 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1413,7 +1413,7 @@ Prefix argument means switch to the Tcl buffer afterwards."
(list
;; car because comint-get-source returns a list holding the
;; filename.
- (car (comint-get-source "Load Tcl file: "
+ (car (comint-get-source "Load Tcl file"
(or (and
(derived-mode-p 'tcl-mode)
(buffer-file-name))
@@ -1433,7 +1433,7 @@ If an inferior Tcl process exists, it is killed first.
Prefix argument means switch to the Tcl buffer afterwards."
(interactive
(list
- (car (comint-get-source "Restart with Tcl file: "
+ (car (comint-get-source "Restart with Tcl file"
(or (and
(derived-mode-p 'tcl-mode)
(buffer-file-name))
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index c2e1719d54a..4622256bb9c 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -5,7 +5,7 @@
;; Author: Reto Zimmermann <reto@gnu.org>
;; Version: 2.28
;; Keywords: languages vera
-;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html
+;; WWW: https://guest.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 18/3/2008, and the maintainer agreed that when a bug is
@@ -119,8 +119,6 @@ If nil, TAB always indents current line."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Menu
-(require 'easymenu)
-
(easy-menu-define vera-mode-menu vera-mode-map
"Menu keymap for Vera Mode."
'("Vera"
@@ -251,7 +249,7 @@ Add a description of the problem and include a reproducible test case.
Feel free to send questions and enhancement requests to <reto@gnu.org>.
Official distribution is at
-URL `http://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html'
+URL `https://www.iis.ee.ethz.ch/~zimmi/emacs/vera-mode.html'
The Vera Mode Maintainer
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index f934ef7a80e..7c8ccea065e 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -9,7 +9,7 @@
;; Keywords: languages
;; The "Version" is the date followed by the decimal rendition of the Git
;; commit hex.
-;; Version: 2021.02.02.263931197
+;; Version: 2021.04.12.188864585
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is
@@ -124,7 +124,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2021-02-02-fbb453d-vpo-GNU"
+(defconst verilog-mode-version "2021-04-12-b41d849-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -134,7 +134,7 @@
(interactive)
(message "Using verilog-mode version %s" verilog-mode-version))
-(defmacro verilog--supressed-warnings (warnings &rest body)
+(defmacro verilog--suppressed-warnings (warnings &rest body)
(declare (indent 1) (debug t))
(cond
((fboundp 'with-suppressed-warnings)
@@ -290,7 +290,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(concat open (mapconcat 'regexp-quote strings "\\|") close)))
)
;; Emacs.
- (defalias 'verilog-regexp-opt 'regexp-opt)))
+ (defalias 'verilog-regexp-opt #'regexp-opt)))
;; emacs >=22 has looking-back, but older emacs and xemacs don't.
;; This function is lifted directly from emacs's subr.el
@@ -300,7 +300,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(eval-and-compile
(cond
((fboundp 'looking-back)
- (defalias 'verilog-looking-back 'looking-back))
+ (defalias 'verilog-looking-back #'looking-back))
(t
(defun verilog-looking-back (regexp limit &optional greedy)
"Return non-nil if text before point matches regular expression REGEXP.
@@ -340,14 +340,14 @@ wherever possible, since it is slow."
(cond
((fboundp 'restore-buffer-modified-p)
;; Faster, as does not update mode line when nothing changes
- (defalias 'verilog-restore-buffer-modified-p 'restore-buffer-modified-p))
+ (defalias 'verilog-restore-buffer-modified-p #'restore-buffer-modified-p))
(t
- (defalias 'verilog-restore-buffer-modified-p 'set-buffer-modified-p))))
+ (defalias 'verilog-restore-buffer-modified-p #'set-buffer-modified-p))))
(eval-and-compile
(cond
((fboundp 'quit-window)
- (defalias 'verilog-quit-window 'quit-window))
+ (defalias 'verilog-quit-window #'quit-window))
(t
(defun verilog-quit-window (_kill-ignored window)
"Quit WINDOW and bury its buffer. KILL-IGNORED is ignored."
@@ -379,7 +379,7 @@ wherever possible, since it is slow."
;; Added in Emacs 25.1
(condition-case nil
(unless (fboundp 'forward-word-strictly)
- (defalias 'forward-word-strictly 'forward-word))
+ (defalias 'forward-word-strictly #'forward-word))
(error nil)))
(eval-when-compile
@@ -1483,48 +1483,48 @@ If set will become buffer local.")
(defvar verilog-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map ";" 'electric-verilog-semi)
- (define-key map [(control 59)] 'electric-verilog-semi-with-comment)
- (define-key map ":" 'electric-verilog-colon)
+ (define-key map ";" #'electric-verilog-semi)
+ (define-key map [(control 59)] #'electric-verilog-semi-with-comment)
+ (define-key map ":" #'electric-verilog-colon)
;;(define-key map "=" 'electric-verilog-equal)
- (define-key map "`" 'electric-verilog-tick)
- (define-key map "\t" 'electric-verilog-tab)
- (define-key map "\r" 'electric-verilog-terminate-line)
+ (define-key map "`" #'electric-verilog-tick)
+ (define-key map "\t" #'electric-verilog-tab)
+ (define-key map "\r" #'electric-verilog-terminate-line)
;; backspace/delete key bindings
- (define-key map [backspace] 'backward-delete-char-untabify)
+ (define-key map [backspace] #'backward-delete-char-untabify)
(unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
- (define-key map [delete] 'delete-char)
- (define-key map [(meta delete)] 'kill-word))
- (define-key map "\M-\C-b" 'electric-verilog-backward-sexp)
- (define-key map "\M-\C-f" 'electric-verilog-forward-sexp)
- (define-key map "\M-\r" 'electric-verilog-terminate-and-indent)
+ (define-key map [delete] #'delete-char)
+ (define-key map [(meta delete)] #'kill-word))
+ (define-key map "\M-\C-b" #'electric-verilog-backward-sexp)
+ (define-key map "\M-\C-f" #'electric-verilog-forward-sexp)
+ (define-key map "\M-\r" #'electric-verilog-terminate-and-indent)
(define-key map "\M-\t" (if (fboundp 'completion-at-point)
- 'completion-at-point 'verilog-complete-word))
+ #'completion-at-point #'verilog-complete-word))
(define-key map "\M-?" (if (fboundp 'completion-help-at-point)
- 'completion-help-at-point 'verilog-show-completions))
+ #'completion-help-at-point #'verilog-show-completions))
;; Note \C-c and letter are reserved for users
- (define-key map "\C-c`" 'verilog-lint-off)
- (define-key map "\C-c*" 'verilog-delete-auto-star-implicit)
- (define-key map "\C-c?" 'verilog-diff-auto)
- (define-key map "\C-c\C-r" 'verilog-label-be)
- (define-key map "\C-c\C-i" 'verilog-pretty-declarations)
- (define-key map "\C-c=" 'verilog-pretty-expr)
- (define-key map "\C-c\C-b" 'verilog-submit-bug-report)
- (define-key map "\C-c/" 'verilog-star-comment)
- (define-key map "\C-c\C-c" 'verilog-comment-region)
- (define-key map "\C-c\C-u" 'verilog-uncomment-region)
+ (define-key map "\C-c`" #'verilog-lint-off)
+ (define-key map "\C-c*" #'verilog-delete-auto-star-implicit)
+ (define-key map "\C-c?" #'verilog-diff-auto)
+ (define-key map "\C-c\C-r" #'verilog-label-be)
+ (define-key map "\C-c\C-i" #'verilog-pretty-declarations)
+ (define-key map "\C-c=" #'verilog-pretty-expr)
+ (define-key map "\C-c\C-b" #'verilog-submit-bug-report)
+ (define-key map "\C-c/" #'verilog-star-comment)
+ (define-key map "\C-c\C-c" #'verilog-comment-region)
+ (define-key map "\C-c\C-u" #'verilog-uncomment-region)
(when (featurep 'xemacs)
- (define-key map [(meta control h)] 'verilog-mark-defun)
- (define-key map "\M-\C-a" 'verilog-beg-of-defun)
- (define-key map "\M-\C-e" 'verilog-end-of-defun))
- (define-key map "\C-c\C-d" 'verilog-goto-defun)
- (define-key map "\C-c\C-k" 'verilog-delete-auto)
- (define-key map "\C-c\C-a" 'verilog-auto)
- (define-key map "\C-c\C-s" 'verilog-auto-save-compile)
- (define-key map "\C-c\C-p" 'verilog-preprocess)
- (define-key map "\C-c\C-z" 'verilog-inject-auto)
- (define-key map "\C-c\C-e" 'verilog-expand-vector)
- (define-key map "\C-c\C-h" 'verilog-header)
+ (define-key map [(meta control h)] #'verilog-mark-defun)
+ (define-key map "\M-\C-a" #'verilog-beg-of-defun)
+ (define-key map "\M-\C-e" #'verilog-end-of-defun))
+ (define-key map "\C-c\C-d" #'verilog-goto-defun)
+ (define-key map "\C-c\C-k" #'verilog-delete-auto)
+ (define-key map "\C-c\C-a" #'verilog-auto)
+ (define-key map "\C-c\C-s" #'verilog-auto-save-compile)
+ (define-key map "\C-c\C-p" #'verilog-preprocess)
+ (define-key map "\C-c\C-z" #'verilog-inject-auto)
+ (define-key map "\C-c\C-e" #'verilog-expand-vector)
+ (define-key map "\C-c\C-h" #'verilog-header)
map)
"Keymap used in Verilog mode.")
@@ -1969,7 +1969,11 @@ To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'."
(unless (bolp) (insert "\n"))))
(defvar compile-command)
+;; These are known to be from other packages and may not be defined
+(defvar diff-command)
+;; There are known to be from newer versions of Emacs
(defvar create-lockfiles) ; Emacs 24
+(defvar which-func-modes)
;; compilation program
(defun verilog-set-compile-command ()
@@ -2009,9 +2013,10 @@ portion, will be substituted."
(t
(set (make-local-variable 'compile-command)
(if verilog-tool
- (if (string-match "%s" (eval verilog-tool))
- (format (eval verilog-tool) (or buffer-file-name ""))
- (concat (eval verilog-tool) " " (or buffer-file-name "")))
+ (let ((cmd (symbol-value verilog-tool)))
+ (if (string-match "%s" cmd)
+ (format cmd (or buffer-file-name ""))
+ (concat cmd " " (or buffer-file-name ""))))
""))))
(verilog-modify-compile-command))
@@ -2098,7 +2103,7 @@ find the errors."
(interactive)
(when (boundp 'compilation-error-regexp-alist-alist)
(when (not (assoc 'verilog-xl-1 compilation-error-regexp-alist-alist))
- (mapcar
+ (mapc
(lambda (item)
(push (car item) compilation-error-regexp-alist)
(push item compilation-error-regexp-alist-alist))
@@ -3602,7 +3607,7 @@ inserted using a single call to `verilog-insert'."
;; More searching
(defun verilog-declaration-end ()
- (search-forward ";"))
+ (search-forward ";" nil t))
(defun verilog-single-declaration-end (limit)
"Returns pos where current (single) declaration statement ends.
@@ -5107,7 +5112,6 @@ primitive or interface named NAME."
(;- task/function/initial et cetera
t
- (match-end 0)
(goto-char (match-end 0))
(setq there (point))
(setq err nil)
@@ -5455,8 +5459,7 @@ becomes:
(let* ((code (match-string 2))
(file (match-string 3))
(line (match-string 4))
- (buffer (get-file-buffer file))
- dir filename)
+ (buffer (get-file-buffer file)))
(unless buffer
(progn
(setq buffer
@@ -5468,9 +5471,8 @@ becomes:
(read-file-name
(format "Find this error in: (default %s) "
file)
- dir file t))))
- (if (file-directory-p name)
- (setq name (expand-file-name filename name)))
+ nil ;; dir
+ file t))))
(setq buffer
(and (file-exists-p name)
(find-file-noselect name))))))))
@@ -5550,7 +5552,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'."
;; font-lock-fontify-buffer, but IIUC the problem this is supposed to
;; solve only appears in Emacsen older than font-lock-ensure anyway.
(when fontlocked
- (verilog--supressed-warnings
+ (verilog--suppressed-warnings
((interactive-only font-lock-fontify-buffer))
(font-lock-fontify-buffer))))))))
@@ -5613,12 +5615,11 @@ Save the result unless optional NO-SAVE is t."
;; Process the files
(mapc (lambda (buf)
(when (buffer-file-name buf)
- (save-excursion
- (if (not (file-exists-p (buffer-file-name buf)))
- (error
- "File not found: %s" (buffer-file-name buf)))
- (message "Processing %s" (buffer-file-name buf))
- (set-buffer buf)
+ (if (not (file-exists-p (buffer-file-name buf)))
+ (error
+ "File not found: %s" (buffer-file-name buf)))
+ (message "Processing %s" (buffer-file-name buf))
+ (with-current-buffer buf
(funcall funref)
(verilog-star-cleanup)
(when (and (not no-save)
@@ -6648,14 +6649,9 @@ Return >0 for nested struct."
(defun verilog-at-close-struct-p ()
"If at the } that closes a struct, return true."
- (if (and
- (equal (char-after) ?\})
- (verilog-in-struct-p))
- ;; true
- (save-excursion
- (if (looking-at "}\\(?:\\s-*\\w+\\s-*\\)?;") 1))
- ;; false
- nil))
+ (and (equal (char-after) ?\})
+ (verilog-in-struct-p)
+ (looking-at "}\\(?:\\s-*\\w+\\s-*\\(?:,\\s-*\\w+\\s-*\\)*\\)?;")))
(defun verilog-parenthesis-depth ()
"Return non zero if in parenthetical-expression."
@@ -6860,16 +6856,19 @@ Only look at a few lines to determine indent level."
(indent-line-to val)))
(t
(goto-char here)
- (let ((val))
- (verilog-beg-of-statement-1)
- (if (and (< (point) here)
- (verilog-re-search-forward "=[ \t]*" here 'move)
- ;; not at a |=>, #=#, or [=n] operator
- (not (string-match "\\[=.\\|#=#\\||=>"
- (or (buffer-substring (- (point) 2) (1+ (point)))
- "")))) ; don't let buffer over/under-run spoil the party
- (setq val (current-column))
- (setq val (eval (cdr (assoc type verilog-indent-alist)))))
+ (verilog-beg-of-statement-1)
+ (let ((val
+ (if (and (< (point) here)
+ (verilog-re-search-forward "=[ \t]*" here 'move)
+ ;; not at a |=>, #=#, or [=n] operator
+ (not (string-match "\\[=.\\|#=#\\||=>"
+ (or (buffer-substring
+ (- (point) 2) (1+ (point)))
+ ;; Don't let buffer over/under
+ ;; run spoil the party.
+ ""))))
+ (current-column)
+ (eval (cdr (assoc type verilog-indent-alist))))))
(goto-char here)
(indent-line-to val))))))
@@ -7305,7 +7304,8 @@ BASEIND is the base indent to offset everything."
(if (verilog-re-search-backward
(or (and verilog-indent-declaration-macros
verilog-declaration-re-1-macro)
- verilog-declaration-re-1-no-macro) lim t)
+ verilog-declaration-re-1-no-macro)
+ lim t)
(progn
(goto-char (match-end 0))
(skip-chars-forward " \t")
@@ -7423,9 +7423,7 @@ BEG and END."
;;
(defvar verilog-str nil)
(defvar verilog-all nil)
-(defvar verilog-pred nil)
(defvar verilog-buffer-to-use nil)
-(defvar verilog-flag nil)
(defvar verilog-toggle-completions nil
"True means \\<verilog-mode-map>\\[verilog-complete-word] should try all possible completions one by one.
Repeated use of \\[verilog-complete-word] will show you all of them.
@@ -7556,27 +7554,25 @@ will be completed at runtime and should not be added to this list.")
TYPE is `module', `tf' for task or function, or t if unknown."
(if (string= verilog-str "")
(setq verilog-str "[a-zA-Z_]"))
- (let ((verilog-str (concat (cond
- ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +")
- ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
- (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
- "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
+ (let ((verilog-str
+ (concat (cond
+ ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +")
+ ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
+ (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +"))
+ "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
match)
- (if (not (looking-at verilog-defun-re))
- (verilog-re-search-backward verilog-defun-re nil t))
- (forward-char 1)
+ (save-excursion
+ (if (not (looking-at verilog-defun-re))
+ (verilog-re-search-backward verilog-defun-re nil t))
+ (forward-char 1)
- ;; Search through all reachable functions
- (goto-char (point-min))
- (while (verilog-re-search-forward verilog-str (point-max) t)
- (progn (setq match (buffer-substring (match-beginning 2)
- (match-end 2)))
- (if (or (null verilog-pred)
- (funcall verilog-pred match))
- (setq verilog-all (cons match verilog-all)))))
- (if (match-beginning 0)
- (goto-char (match-beginning 0)))))
+ ;; Search through all reachable functions
+ (goto-char (point-min))
+ (while (verilog-re-search-forward verilog-str (point-max) t)
+ (setq match (buffer-substring (match-beginning 2)
+ (match-end 2)))
+ (setq verilog-all (cons match verilog-all))))))
(defun verilog-get-completion-decl (end)
"Macro for searching through current declaration (var, type or const)
@@ -7594,9 +7590,7 @@ for matches of `str' and adding the occurrence tp `all' through point END."
(not (match-end 1)))
(setq match (buffer-substring (match-beginning 0) (match-end 0)))
(if (string-match (concat "\\<" verilog-str) match)
- (if (or (null verilog-pred)
- (funcall verilog-pred match))
- (setq verilog-all (cons match verilog-all)))))
+ (setq verilog-all (cons match verilog-all))))
(forward-line 1)))
verilog-all)
@@ -7611,28 +7605,25 @@ for matches of `str' and adding the occurrence tp `all' through point END."
(defun verilog-keyword-completion (keyword-list)
"Give list of all possible completions of keywords in KEYWORD-LIST."
- (mapcar (lambda (s)
- (if (string-match (concat "\\<" verilog-str) s)
- (if (or (null verilog-pred)
- (funcall verilog-pred s))
- (setq verilog-all (cons s verilog-all)))))
- keyword-list))
-
-
-(defun verilog-completion (verilog-str verilog-pred verilog-flag)
- "Function passed to `completing-read', `try-completion' or `all-completions'.
-Called to get completion on VERILOG-STR. If VERILOG-PRED is non-nil, it
-must be a function to be called for every match to check if this should
-really be a match. If VERILOG-FLAG is t, the function returns a list of
-all possible completions. If VERILOG-FLAG is nil it returns a string,
-the longest possible completion, or t if VERILOG-STR is an exact match.
-If VERILOG-FLAG is `lambda', the function returns t if VERILOG-STR is an
-exact match, nil otherwise."
- (save-excursion
- (let ((verilog-all nil))
- ;; Set buffer to use for searching labels. This should be set
- ;; within functions which use verilog-completions
- (set-buffer verilog-buffer-to-use)
+ (dolist (s keyword-list)
+ (if (string-match (concat "\\<" verilog-str) s)
+ (push s verilog-all))))
+
+
+(defun verilog-completion (str pred flag)
+ "Completion table for Verilog tokens.
+Function passed to `completing-read', `try-completion' or `all-completions'.
+Called to get completion on STR.
+If FLAG is t, the function returns a list of all possible completions.
+If FLAG is nil it returns a string, the longest possible completion,
+or t if STR is an exact match.
+If FLAG is `lambda', the function returns t if STR is an exact match,
+nil otherwise."
+ (let ((verilog-str str)
+ (verilog-all nil))
+ ;; Set buffer to use for searching labels. This should be set
+ ;; within functions which use verilog-completions
+ (with-current-buffer verilog-buffer-to-use
;; Determine what should be completed
(let ((state (car (verilog-calculate-indent))))
@@ -7674,43 +7665,47 @@ exact match, nil otherwise."
(verilog-keyword-completion verilog-separator-keywords))))
;; Now we have built a list of all matches. Give response to caller
- (verilog-completion-response))))
-
-(defun verilog-completion-response ()
- (cond ((or (equal verilog-flag 'lambda) (null verilog-flag))
- ;; This was not called by all-completions
- (if (null verilog-all)
- ;; Return nil if there was no matching label
- nil
- ;; Get longest string common in the labels
- ;; FIXME: Why not use `try-completion'?
- (let* ((elm (cdr verilog-all))
- (match (car verilog-all))
- (min (length match))
- tmp)
- (if (string= match verilog-str)
- ;; Return t if first match was an exact match
- (setq match t)
- (while (not (null elm))
- ;; Find longest common string
- (if (< (setq tmp (verilog-string-diff match (car elm))) min)
- (progn
- (setq min tmp)
- (setq match (substring match 0 min))))
- ;; Terminate with match=t if this is an exact match
- (if (string= (car elm) verilog-str)
- (progn
- (setq match t)
- (setq elm nil))
- (setq elm (cdr elm)))))
- ;; If this is a test just for exact match, return nil ot t
- (if (and (equal verilog-flag 'lambda) (not (equal match 't)))
- nil
- match))))
- ;; If flag is t, this was called by all-completions. Return
- ;; list of all possible completions
- (verilog-flag
- verilog-all)))
+ (verilog--complete-with-action flag verilog-all verilog-str pred))))
+
+
+(defalias 'verilog--complete-with-action
+ (if (fboundp 'complete-with-action)
+ #'complete-with-action
+ (lambda (flag collection string _predicate)
+ (cond ((or (equal flag 'lambda) (null flag))
+ ;; This was not called by all-completions
+ (if (null collection)
+ ;; Return nil if there was no matching label
+ nil
+ ;; Get longest string common in the labels
+ (let* ((elm (cdr collection))
+ (match (car collection))
+ (min (length match))
+ tmp)
+ (if (string= match string)
+ ;; Return t if first match was an exact match
+ (setq match t)
+ (while (not (null elm))
+ ;; Find longest common string
+ (if (< (setq tmp (verilog-string-diff match (car elm)))
+ min)
+ (progn
+ (setq min tmp)
+ (setq match (substring match 0 min))))
+ ;; Terminate with match=t if this is an exact match
+ (if (string= (car elm) string)
+ (progn
+ (setq match t)
+ (setq elm nil))
+ (setq elm (cdr elm)))))
+ ;; If this is a test just for exact match, return nil ot t
+ (if (and (equal flag 'lambda) (not (equal match 't)))
+ nil
+ match))))
+ ;; If flag is t, this was called by all-completions. Return
+ ;; list of all possible completions
+ (flag
+ collection)))))
(defvar verilog-last-word-numb 0)
(defvar verilog-last-word-shown nil)
@@ -7728,7 +7723,7 @@ exact match, nil otherwise."
(allcomp (if (and verilog-toggle-completions
(string= verilog-last-word-shown verilog-str))
verilog-last-completions
- (all-completions verilog-str 'verilog-completion))))
+ (all-completions verilog-str #'verilog-completion))))
(list b e allcomp)))
(defun verilog-complete-word ()
@@ -7744,9 +7739,7 @@ and `verilog-separator-keywords'.)"
(verilog-str (buffer-substring b e))
(allcomp (nth 2 comp-info))
(match (if verilog-toggle-completions
- "" (try-completion
- verilog-str (mapcar (lambda (elm)
- (cons elm 0)) allcomp)))))
+ "" (try-completion verilog-str allcomp))))
;; Delete old string
(delete-region b e)
@@ -7818,39 +7811,38 @@ With optional second ARG non-nil, STR is the complete name of the instruction."
(setq str (concat str "[a-zA-Z0-9_]*")))
(concat "^\\s-*\\(function\\|task\\|module\\)[ \t]+\\(?:\\(?:static\\|automatic\\)\\s-+\\)?\\(" str "\\)\\>"))
-(defun verilog-comp-defun (verilog-str verilog-pred verilog-flag)
- "Function passed to `completing-read', `try-completion' or `all-completions'.
-Returns a completion on any function name based on VERILOG-STR prefix. If
-VERILOG-PRED is non-nil, it must be a function to be called for every match
-to check if this should really be a match. If VERILOG-FLAG is t, the
-function returns a list of all possible completions. If it is nil it
-returns a string, the longest possible completion, or t if VERILOG-STR is
-an exact match. If VERILOG-FLAG is `lambda', the function returns t if
-VERILOG-STR is an exact match, nil otherwise."
- (save-excursion
- (let ((verilog-all nil)
- match)
-
- ;; Set buffer to use for searching labels. This should be set
- ;; within functions which use verilog-completions
- (set-buffer verilog-buffer-to-use)
+(defun verilog-comp-defun (str pred flag)
+ "Completion table for function names.
+Function passed to `completing-read', `try-completion' or `all-completions'.
+Returns a completion on any function name based on STR prefix.
+If FLAG is t, the function returns a list of all possible completions.
+If it is nil it returns a string, the longest possible completion,
+or t if STR is an exact match.
+If FLAG is `lambda', the function returns t if STR is an exact match,
+nil otherwise."
+ (let ((verilog-all nil)
+ (verilog-str str)
+ match)
+
+ ;; Set buffer to use for searching labels. This should be set
+ ;; within functions which use verilog-completions
+ (with-current-buffer verilog-buffer-to-use
(let ((verilog-str verilog-str))
;; Build regular expression for functions
- (if (string= verilog-str "")
- (setq verilog-str (verilog-build-defun-re "[a-zA-Z_]"))
- (setq verilog-str (verilog-build-defun-re verilog-str)))
+ (setq verilog-str
+ (verilog-build-defun-re (if (string= verilog-str "")
+ "[a-zA-Z_]"
+ verilog-str)))
(goto-char (point-min))
;; Build a list of all possible completions
(while (verilog-re-search-forward verilog-str nil t)
(setq match (buffer-substring (match-beginning 2) (match-end 2)))
- (if (or (null verilog-pred)
- (funcall verilog-pred match))
- (setq verilog-all (cons match verilog-all)))))
+ (setq verilog-all (cons match verilog-all))))
;; Now we have built a list of all matches. Give response to caller
- (verilog-completion-response))))
+ (verilog--complete-with-action flag verilog-all verilog-str pred))))
(defun verilog-goto-defun ()
"Move to specified Verilog module/interface/task/function.
@@ -7865,10 +7857,10 @@ If search fails, other files are checked based on
;; Do completion with default
(completing-read (concat "Goto-Label: (default "
default ") ")
- 'verilog-comp-defun nil nil "")
+ #'verilog-comp-defun nil nil "")
;; There is no default value. Complete without it
(completing-read "Goto-Label: "
- 'verilog-comp-defun nil nil "")))
+ #'verilog-comp-defun nil nil "")))
pt)
;; Make sure library paths are correct, in case need to resolve module
(verilog-auto-reeval-locals)
@@ -7927,10 +7919,9 @@ If search fails, other files are checked based on
(tag (format "%3d" linenum))
(empty (make-string (length tag) ?\ ))
tem)
- (save-excursion
- (setq tem (make-marker))
- (set-marker tem (point))
- (set-buffer standard-output)
+ (setq tem (make-marker))
+ (set-marker tem (point))
+ (with-current-buffer standard-output
(setq occur-pos-list (cons tem occur-pos-list))
(or first (zerop nlines)
(insert "--------\n"))
@@ -8648,11 +8639,6 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(defvar sigs-out-i)
(defvar sigs-out-unk)
(defvar sigs-temp)
-;; These are known to be from other packages and may not be defined
-(defvar diff-command)
-;; There are known to be from newer versions of Emacs
-(defvar create-lockfiles)
-(defvar which-func-modes)
(defun verilog-read-decls ()
"Compute signal declaration information for the current module at point.
@@ -10099,7 +10085,7 @@ If undefined, and WING-IT, return just SYMBOL without the tick, else nil."
;; variable in only one buffer returns t in another.
;; This can confuse, so check for nil.
;; Namespace intentionally short for AUTOs and compatibility
- (let ((val (eval (intern (concat "vh-" symbol)))))
+ (let ((val (symbol-value (intern (concat "vh-" symbol)))))
(if (eq val nil)
(if wing-it symbol nil)
val))
@@ -10138,7 +10124,7 @@ This function is intended for use in AUTO_TEMPLATE Lisp expressions."
;; variable in only one buffer returns t in another.
;; This can confuse, so check for nil.
;; Namespace intentionally short for AUTOs and compatibility
- (setq val (eval (intern (concat "vh-" symbol)))))
+ (setq val (symbol-value (intern (concat "vh-" symbol)))))
(setq text (replace-match val nil nil text)))
(t (setq ok nil)))))
text)
@@ -10493,7 +10479,7 @@ those clocking block's signals."
;; New scheme
;; Namespace intentionally short for AUTOs and compatibility
(let* ((enumvar (intern (concat "venum-" enum))))
- (dolist (en (and (boundp enumvar) (eval enumvar)))
+ (dolist (en (and (boundp enumvar) (symbol-value enumvar)))
(let ((sig (list en)))
(unless (member sig out-list)
(push sig out-list)))))
@@ -10698,9 +10684,7 @@ When MODI is non-null, also add to modi-cache, for tracking."
(verilog-insert "// " (verilog-sig-comment sig) "\n"))
(setq sigs (cdr sigs)))))
-(defvar indent-pt) ;; Local used by `verilog-insert-indent'.
-
-(defun verilog-insert-indent (&rest stuff)
+(defun verilog--insert-indent (indent-pt &rest stuff)
"Indent to position stored in local `indent-pt' variable, then insert STUFF.
Presumes that any newlines end a list element."
(let ((need-indent t))
@@ -10710,6 +10694,10 @@ Presumes that any newlines end a list element."
(verilog-insert (car stuff))
(setq need-indent (string-match "\n$" (car stuff))
stuff (cdr stuff)))))
+
+(defmacro verilog-insert-indent (&rest stuff)
+ `(verilog--insert-indent indent-pt ,@stuff))
+
;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n"))
(defun verilog-forward-or-insert-line ()
@@ -11518,7 +11506,8 @@ See the example in `verilog-auto-inout-modport'."
(inst-name (nth 2 params))
(regexp (nth 3 params))
(prefix (nth 4 params))
- direction-re submodi) ; direction argument not supported until requested
+ ;; direction-re ; direction argument not supported until requested
+ submodi)
;; Lookup position, etc of co-module
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
@@ -11539,11 +11528,11 @@ See the example in `verilog-auto-inout-modport'."
(setq sig-list-i (verilog-signals-edit-wire-reg
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-i regexp)
- "input" direction-re))
+ "input" nil)) ;; direction-re
sig-list-o (verilog-signals-edit-wire-reg
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-o regexp)
- "output" direction-re)))
+ "output" nil))) ;; direction-re
(setq sig-list-i (sort (copy-alist sig-list-i) #'verilog-signals-sort-compare))
(setq sig-list-o (sort (copy-alist sig-list-o) #'verilog-signals-sort-compare))
(when (or sig-list-i sig-list-o)
@@ -11571,6 +11560,7 @@ See the example in `verilog-auto-inout-modport'."
(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
+(defvar vl-memory nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-modport nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning
(defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning
@@ -11684,7 +11674,7 @@ If PAR-VALUES replace final strings with these parameter values."
(setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net)))
;; Insert it
(when (or tpl-ass (not verilog-auto-inst-template-required))
- (verilog-auto-inst-first section)
+ (verilog--auto-inst-first indent-pt section)
(indent-to indent-pt)
(insert "." port)
(unless (and verilog-auto-inst-dot-name
@@ -11723,7 +11713,7 @@ If PAR-VALUES replace final strings with these parameter values."
(defvar verilog-auto-inst-first-any nil
"Local first-in-any-section for `verilog-auto-inst-first'.")
-(defun verilog-auto-inst-first (section)
+(defun verilog--auto-inst-first (indent-pt section)
"Insert , and SECTION before port, as part of \\[verilog-auto-inst]."
;; Do we need a trailing comma?
;; There maybe an ifdef or something similar before us. What a mess. Thus
@@ -12073,6 +12063,7 @@ Lisp Templates:
vl-width Width of the input/output port (`3' for [2:0]).
May be a (...) expression if bits isn't a constant.
vl-dir Direction of the pin input/output/inout/interface.
+ vl-memory The unpacked array part of the I/O port (`[5:0]').
vl-modport The modport, if an interface with a modport.
vl-cell-type Module name/type of the cell (`InstModule').
vl-cell-name Instance name of the cell (`instName').
@@ -12957,21 +12948,25 @@ that expression are included."
(verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-i regexp)
- "input" direction-re) not-re))
+ "input" direction-re)
+ not-re))
sig-list-o (verilog-signals-edit-wire-reg
(verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-o regexp)
- "output" direction-re) not-re))
+ "output" direction-re)
+ not-re))
sig-list-io (verilog-signals-edit-wire-reg
(verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-io regexp)
- "inout" direction-re) not-re))
+ "inout" direction-re)
+ not-re))
sig-list-if (verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-if regexp)
- "interface" direction-re) not-re))
+ "interface" direction-re)
+ not-re))
(when v2k (verilog-repair-open-comma))
(when (or sig-list-i sig-list-o sig-list-io sig-list-if)
(verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
@@ -13257,7 +13252,8 @@ driver/monitor using AUTOINST in the testbench."
(modport-re (nth 1 params))
(regexp (nth 2 params))
(prefix (nth 3 params))
- direction-re submodi) ; direction argument not supported until requested
+ ;; direction-re ; direction argument not supported until requested
+ submodi)
;; Lookup position, etc of co-module
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
@@ -13288,7 +13284,7 @@ driver/monitor using AUTOINST in the testbench."
(verilog-signals-add-prefix
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-i regexp)
- "input" direction-re)
+ "input" nil) ;; direction-re
prefix)
(verilog-decls-get-ports moddecls)))
sig-list-o (verilog-signals-edit-wire-reg
@@ -13296,7 +13292,7 @@ driver/monitor using AUTOINST in the testbench."
(verilog-signals-add-prefix
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-o regexp)
- "output" direction-re)
+ "output" nil) ;; direction-re
prefix)
(verilog-decls-get-ports moddecls)))
sig-list-io (verilog-signals-edit-wire-reg
@@ -13304,7 +13300,7 @@ driver/monitor using AUTOINST in the testbench."
(verilog-signals-add-prefix
(verilog-signals-matching-dir-re
(verilog-signals-matching-regexp sig-list-io regexp)
- "inout" direction-re)
+ "inout" nil) ;; direction-re
prefix)
(verilog-decls-get-ports moddecls))))
(when v2k (verilog-repair-open-comma))
@@ -14275,37 +14271,37 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(defvar verilog-template-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'verilog-sk-always)
- (define-key map "b" 'verilog-sk-begin)
- (define-key map "c" 'verilog-sk-case)
- (define-key map "f" 'verilog-sk-for)
- (define-key map "g" 'verilog-sk-generate)
- (define-key map "h" 'verilog-sk-header)
- (define-key map "i" 'verilog-sk-initial)
- (define-key map "j" 'verilog-sk-fork)
- (define-key map "m" 'verilog-sk-module)
- (define-key map "o" 'verilog-sk-ovm-class)
- (define-key map "p" 'verilog-sk-primitive)
- (define-key map "r" 'verilog-sk-repeat)
- (define-key map "s" 'verilog-sk-specify)
- (define-key map "t" 'verilog-sk-task)
- (define-key map "u" 'verilog-sk-uvm-object)
- (define-key map "w" 'verilog-sk-while)
- (define-key map "x" 'verilog-sk-casex)
- (define-key map "z" 'verilog-sk-casez)
- (define-key map "?" 'verilog-sk-if)
- (define-key map ":" 'verilog-sk-else-if)
- (define-key map "/" 'verilog-sk-comment)
- (define-key map "A" 'verilog-sk-assign)
- (define-key map "F" 'verilog-sk-function)
- (define-key map "I" 'verilog-sk-input)
- (define-key map "O" 'verilog-sk-output)
- (define-key map "S" 'verilog-sk-state-machine)
- (define-key map "=" 'verilog-sk-inout)
- (define-key map "U" 'verilog-sk-uvm-component)
- (define-key map "W" 'verilog-sk-wire)
- (define-key map "R" 'verilog-sk-reg)
- (define-key map "D" 'verilog-sk-define-signal)
+ (define-key map "a" #'verilog-sk-always)
+ (define-key map "b" #'verilog-sk-begin)
+ (define-key map "c" #'verilog-sk-case)
+ (define-key map "f" #'verilog-sk-for)
+ (define-key map "g" #'verilog-sk-generate)
+ (define-key map "h" #'verilog-sk-header)
+ (define-key map "i" #'verilog-sk-initial)
+ (define-key map "j" #'verilog-sk-fork)
+ (define-key map "m" #'verilog-sk-module)
+ (define-key map "o" #'verilog-sk-ovm-class)
+ (define-key map "p" #'verilog-sk-primitive)
+ (define-key map "r" #'verilog-sk-repeat)
+ (define-key map "s" #'verilog-sk-specify)
+ (define-key map "t" #'verilog-sk-task)
+ (define-key map "u" #'verilog-sk-uvm-object)
+ (define-key map "w" #'verilog-sk-while)
+ (define-key map "x" #'verilog-sk-casex)
+ (define-key map "z" #'verilog-sk-casez)
+ (define-key map "?" #'verilog-sk-if)
+ (define-key map ":" #'verilog-sk-else-if)
+ (define-key map "/" #'verilog-sk-comment)
+ (define-key map "A" #'verilog-sk-assign)
+ (define-key map "F" #'verilog-sk-function)
+ (define-key map "I" #'verilog-sk-input)
+ (define-key map "O" #'verilog-sk-output)
+ (define-key map "S" #'verilog-sk-state-machine)
+ (define-key map "=" #'verilog-sk-inout)
+ (define-key map "U" #'verilog-sk-uvm-component)
+ (define-key map "W" #'verilog-sk-wire)
+ (define-key map "R" #'verilog-sk-reg)
+ (define-key map "D" #'verilog-sk-define-signal)
map)
"Keymap used in Verilog mode for smart template operations.")
@@ -14696,13 +14692,13 @@ and the case items."
(let ((map (make-sparse-keymap))) ; as described in info pages, make a map
(set-keymap-parent map verilog-mode-map)
;; mouse button bindings
- (define-key map "\r" 'verilog-load-file-at-point)
- (if (featurep 'xemacs)
- (define-key map 'button2 'verilog-load-file-at-mouse);ffap-at-mouse ?
- (define-key map [mouse-2] 'verilog-load-file-at-mouse))
+ (define-key map "\r" #'verilog-load-file-at-point)
+ (define-key map
+ (if (featurep 'xemacs) 'button2 [mouse-2])
+ #'verilog-load-file-at-mouse)
(if (featurep 'xemacs)
- (define-key map 'Sh-button2 'mouse-yank) ; you wanna paste don't you ?
- (define-key map [S-mouse-2] 'mouse-yank-at-click))
+ (define-key map 'Sh-button2 #'mouse-yank) ; you wanna paste don't you ?
+ (define-key map [S-mouse-2] #'mouse-yank-at-click))
map)
"Map containing mouse bindings for `verilog-mode'.")
@@ -14775,7 +14771,7 @@ Clicking on the middle-mouse button loads them in a buffer (as in dired)."
(verilog-highlight-region (point-min) (point-max) nil))
;; Deprecated, but was interactive, so we'll keep it around
-(defalias 'verilog-colorize-include-files-buffer 'verilog-highlight-buffer)
+(defalias 'verilog-colorize-include-files-buffer #'verilog-highlight-buffer)
;; ffap-at-mouse isn't useful for Verilog mode. It uses library paths.
;; so define this function to do more or less the same as ffap-at-mouse
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index c4de800e332..5eeac8af3b8 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,4 +1,4 @@
-;;; vhdl-mode.el --- major mode for editing VHDL code
+;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t; -*-
;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
@@ -6,12 +6,15 @@
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
;; Maintainer: Reto Zimmermann <reto@gnu.org>
;; Keywords: languages vhdl
-;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
+;; WWW: https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 18/3/2008, and the maintainer agreed that when a bug is
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
+;;
+;; Reto also said in Apr 2021 that he preferred to keep the XEmacs
+;; compatibility code.
(defconst vhdl-version "3.38.1"
"VHDL Mode version number.")
@@ -77,7 +80,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21.
+;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21.
;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
;; or into an arbitrary directory that is added to the load path by the
@@ -92,7 +95,7 @@
;; Add the following lines to the `site-start.el' file in the `site-lisp'
;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
-;; (not required in Emacs 20 and higher):
+;; (not required in Emacs):
;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
@@ -136,12 +139,9 @@
(when (< emacs-major-version 25)
(condition-case nil (require 'cl-lib) (file-missing (require 'cl))))
-;; Emacs 21+ handling
-(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
- "Non-nil if GNU Emacs 21, 22, ... is used.")
;; Emacs 22+ handling
(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
- "Non-nil if GNU Emacs 22, ... is used.")
+ "Non-nil if GNU Emacs >= 22, ... is used.")
(defvar compilation-file-regexp-alist)
(defvar conf-alist)
@@ -490,7 +490,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting
(const :tag "Upcase" upcase)
(const :tag "Downcase" downcase))))))
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-update-mode-menu))
+ (vhdl-custom-set variable value #'vhdl-update-mode-menu))
:version "24.4"
:group 'vhdl-compile)
@@ -668,8 +668,8 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project'
:format "%t\n%v\n")))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-update-mode-menu
- 'vhdl-speedbar-refresh))
+ #'vhdl-update-mode-menu
+ #'vhdl-speedbar-refresh))
:group 'vhdl-project)
(defcustom vhdl-project nil
@@ -713,7 +713,7 @@ All project setup files that match the file names specified in option
\(alphabetically) last loaded setup of the first `vhdl-project-file-name'
entry is activated.
A project setup file can be obtained by exporting a project (see menu).
- At startup: project setup file is loaded at Emacs startup"
+ At startup: project setup file is loaded at Emacs startup."
:type '(set (const :tag "At startup" startup))
:group 'vhdl-project)
@@ -751,12 +751,12 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
(const :tag "Math packages" math)))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-template-map-init
- 'vhdl-mode-abbrev-table-init
- 'vhdl-template-construct-alist-init
- 'vhdl-template-package-alist-init
- 'vhdl-update-mode-menu
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-template-map-init
+ #'vhdl-mode-abbrev-table-init
+ #'vhdl-template-construct-alist-init
+ #'vhdl-template-package-alist-init
+ #'vhdl-update-mode-menu
+ #'vhdl-words-init 'vhdl-font-lock-init))
:group 'vhdl-style)
(defcustom vhdl-basic-offset 2
@@ -770,7 +770,7 @@ This value is used by + and - symbols in `vhdl-offsets-alist'."
This is done when typed or expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-types nil
@@ -778,7 +778,7 @@ This is done when typed or expanded or by the fix case functions."
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-attributes nil
@@ -786,7 +786,7 @@ This is done when expanded or by the fix case functions."
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-enum-values nil
@@ -794,7 +794,7 @@ This is done when expanded or by the fix case functions."
This is done when expanded or by the fix case functions."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-upper-case-constants t
@@ -802,7 +802,7 @@ This is done when expanded or by the fix case functions."
This is done when expanded."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
+ (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
:group 'vhdl-style)
(defcustom vhdl-use-direct-instantiation 'standard
@@ -909,7 +909,7 @@ follows:
:type '(set (const :tag "VHDL keywords" vhdl)
(const :tag "User model keywords" user))
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))
+ (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init))
:group 'vhdl-template)
(defcustom vhdl-optional-labels 'process
@@ -1192,10 +1192,10 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
(string :tag "Keyword " :format "%t: %v\n")))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-model-map-init
- 'vhdl-model-defun
- 'vhdl-mode-abbrev-table-init
- 'vhdl-update-mode-menu))
+ #'vhdl-model-map-init
+ #'vhdl-model-defun
+ #'vhdl-mode-abbrev-table-init
+ #'vhdl-update-mode-menu))
:group 'vhdl-model)
@@ -1598,7 +1598,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-names t
@@ -1615,7 +1615,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-special-words nil
@@ -1628,7 +1628,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-forbidden-words nil
@@ -1643,7 +1643,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:type 'boolean
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-verilog-keywords nil
@@ -1656,7 +1656,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:type 'boolean
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-translate-off nil
@@ -1670,7 +1670,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
entry \"Fontify Buffer\")."
:type 'boolean
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-highlight-case-sensitive nil
@@ -1724,7 +1724,7 @@ NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
(string :tag "Color (dark) ")
(boolean :tag "In comments ")))
:set (lambda (variable value)
- (vhdl-custom-set variable value 'vhdl-font-lock-init))
+ (vhdl-custom-set variable value #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-words '()
@@ -1737,7 +1737,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:type '(repeat (string :format "%v"))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-forbidden-syntax ""
@@ -1752,7 +1752,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:type 'regexp
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
@@ -1763,7 +1763,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
:type '(repeat (string :format "%v"))
:set (lambda (variable value)
(vhdl-custom-set variable value
- 'vhdl-words-init 'vhdl-font-lock-init))
+ #'vhdl-words-init #'vhdl-font-lock-init))
:group 'vhdl-highlight)
@@ -2159,7 +2159,8 @@ your style, only those that are different from the default.")
;; mandatory
(require 'compile) ; XEmacs
-(require 'easymenu)
+(when (< emacs-major-version 28) ; preloaded in Emacs 28
+ (require 'easymenu))
(require 'hippie-exp)
;; optional (minimize warning messages during compile)
@@ -2237,11 +2238,11 @@ Ignore byte-compiler warnings you might see."
; (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
(defun regexp-opt (strings &optional paren)
(let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
- (concat open (mapconcat 'regexp-quote strings "\\|") close))))
+ (concat open (mapconcat #'regexp-quote strings "\\|") close))))
;; `match-string-no-properties' undefined (XEmacs, what else?)
(unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
+ (defalias 'match-string-no-properties #'match-string))
;; `subst-char-in-string' undefined (XEmacs)
(unless (fboundp 'subst-char-in-string)
@@ -2268,7 +2269,7 @@ Ignore byte-compiler warnings you might see."
(let* ((nondir (file-name-nondirectory pattern))
(dirpart (file-name-directory pattern))
(dirs (if (and dirpart (string-match "[[*?]" dirpart))
- (mapcar 'file-name-as-directory
+ (mapcar #'file-name-as-directory
(file-expand-wildcards (directory-file-name dirpart)))
(list dirpart)))
contents)
@@ -2295,7 +2296,7 @@ Ignore byte-compiler warnings you might see."
;; `member-ignore-case' undefined (XEmacs)
(unless (fboundp 'member-ignore-case)
- (defalias 'member-ignore-case 'member))
+ (defalias 'member-ignore-case #'member))
;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
;; behavior in XEmacs
@@ -2494,6 +2495,7 @@ current buffer if no project is defined."
"Enable case insensitive search and switch to syntax table that includes `_',
then execute BODY, and finally restore the old environment. Used for
consistent searching."
+ (declare (debug t))
`(let ((case-fold-search t)) ; case insensitive search
;; use extended syntax table
(with-syntax-table vhdl-mode-ext-syntax-table
@@ -2503,55 +2505,59 @@ consistent searching."
"Enable case insensitive search, switch to syntax table that includes `_',
arrange to ignore `intangible' overlays, then execute BODY, and finally restore
the old environment. Used for consistent searching."
+ (declare (debug t))
`(let ((case-fold-search t) ; case insensitive search
- (current-syntax-table (syntax-table))
(inhibit-point-motion-hooks t))
;; use extended syntax table
- (set-syntax-table vhdl-mode-ext-syntax-table)
- ;; execute BODY safely
- (unwind-protect
- (progn ,@body)
- ;; restore syntax table
- (set-syntax-table current-syntax-table))))
+ (with-syntax-table vhdl-mode-ext-syntax-table
+ ;; execute BODY safely
+ (progn ,@body))))
(defmacro vhdl-visit-file (file-name issue-error &rest body)
"Visit file FILE-NAME and execute BODY."
- `(if (null ,file-name)
- (progn ,@body)
- (unless (file-directory-p ,file-name)
- (let ((source-buffer (current-buffer))
- (visiting-buffer (find-buffer-visiting ,file-name))
- file-opened)
- (when (or (and visiting-buffer (set-buffer visiting-buffer))
- (condition-case ()
- (progn (set-buffer (create-file-buffer ,file-name))
- (setq file-opened t)
- (vhdl-insert-file-contents ,file-name)
- ;; FIXME: This modifies a global syntax-table!
- (modify-syntax-entry ?\- ". 12" (syntax-table))
- (modify-syntax-entry ?\n ">" (syntax-table))
- (modify-syntax-entry ?\^M ">" (syntax-table))
- (modify-syntax-entry ?_ "w" (syntax-table))
- t)
- (error
- (if ,issue-error
- (progn
- (when file-opened (kill-buffer (current-buffer)))
- (set-buffer source-buffer)
- (error "ERROR: File cannot be opened: \"%s\"" ,file-name))
- (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
- nil))))
- (condition-case info
- (progn ,@body)
- (error
- (if ,issue-error
- (progn
- (when file-opened (kill-buffer (current-buffer)))
- (set-buffer source-buffer)
- (error (cadr info)))
- (vhdl-warning (cadr info))))))
- (when file-opened (kill-buffer (current-buffer)))
- (set-buffer source-buffer)))))
+ (declare (debug t) (indent 2))
+ `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body)))
+
+(defun vhdl--visit-file (file-name issue-error body-fun)
+ (if (null file-name)
+ (funcall body-fun)
+ (unless (file-directory-p file-name)
+ (let ((source-buffer (current-buffer))
+ (visiting-buffer (find-buffer-visiting file-name))
+ file-opened)
+ (when (or (and visiting-buffer (set-buffer visiting-buffer))
+ (condition-case ()
+ (progn (set-buffer (create-file-buffer file-name))
+ (setq file-opened t)
+ (vhdl-insert-file-contents file-name)
+ (let ((st (copy-syntax-table (syntax-table))))
+ (modify-syntax-entry ?\- ". 12" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?\^M ">" st)
+ (modify-syntax-entry ?_ "w" st)
+ ;; FIXME: We should arguably reset the
+ ;; syntax-table after running `body-fun'.
+ (set-syntax-table st))
+ t)
+ (error
+ (if issue-error
+ (progn
+ (when file-opened (kill-buffer (current-buffer)))
+ (set-buffer source-buffer)
+ (error "ERROR: File cannot be opened: \"%s\"" file-name))
+ (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t)
+ nil))))
+ (condition-case info
+ (funcall body-fun)
+ (error
+ (if issue-error
+ (progn
+ (when file-opened (kill-buffer (current-buffer)))
+ (set-buffer source-buffer)
+ (error (cadr info)))
+ (vhdl-warning (cadr info))))))
+ (when file-opened (kill-buffer (current-buffer)))
+ (set-buffer source-buffer)))))
(defun vhdl-insert-file-contents (filename)
"Nicked from `insert-file-contents-literally', but allow coding system
@@ -2599,7 +2605,7 @@ conversion."
"Refresh directory or project with name KEY."
(when (and (boundp 'speedbar-frame)
(frame-live-p speedbar-frame))
- (let ((pos (point))
+ (let (;; (pos (point))
(last-frame (selected-frame)))
(if (null key)
(speedbar-refresh)
@@ -2676,96 +2682,96 @@ elements > `vhdl-menu-max-size'."
"Initialize `vhdl-template-map'."
(setq vhdl-template-map (make-sparse-keymap))
;; key bindings for VHDL templates
- (define-key vhdl-template-map "al" 'vhdl-template-alias)
- (define-key vhdl-template-map "ar" 'vhdl-template-architecture)
- (define-key vhdl-template-map "at" 'vhdl-template-assert)
- (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl)
- (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec)
- (define-key vhdl-template-map "bl" 'vhdl-template-block)
- (define-key vhdl-template-map "ca" 'vhdl-template-case-is)
- (define-key vhdl-template-map "cd" 'vhdl-template-component-decl)
- (define-key vhdl-template-map "ci" 'vhdl-template-component-inst)
- (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst)
- (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration)
- (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf)
- (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
- (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
- (define-key vhdl-template-map "co" 'vhdl-template-constant)
- (define-key vhdl-template-map "ct" 'vhdl-template-context)
- (define-key vhdl-template-map "di" 'vhdl-template-disconnect)
- (define-key vhdl-template-map "el" 'vhdl-template-else)
- (define-key vhdl-template-map "ei" 'vhdl-template-elsif)
- (define-key vhdl-template-map "en" 'vhdl-template-entity)
- (define-key vhdl-template-map "ex" 'vhdl-template-exit)
- (define-key vhdl-template-map "fi" 'vhdl-template-file)
- (define-key vhdl-template-map "fg" 'vhdl-template-for-generate)
- (define-key vhdl-template-map "fl" 'vhdl-template-for-loop)
- (define-key vhdl-template-map "\C-f" 'vhdl-template-footer)
- (define-key vhdl-template-map "fb" 'vhdl-template-function-body)
- (define-key vhdl-template-map "fd" 'vhdl-template-function-decl)
- (define-key vhdl-template-map "ge" 'vhdl-template-generic)
- (define-key vhdl-template-map "gd" 'vhdl-template-group-decl)
- (define-key vhdl-template-map "gt" 'vhdl-template-group-template)
- (define-key vhdl-template-map "\C-h" 'vhdl-template-header)
- (define-key vhdl-template-map "ig" 'vhdl-template-if-generate)
- (define-key vhdl-template-map "it" 'vhdl-template-if-then)
- (define-key vhdl-template-map "li" 'vhdl-template-library)
- (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop)
- (define-key vhdl-template-map "\C-m" 'vhdl-template-modify)
- (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date)
- (define-key vhdl-template-map "ma" 'vhdl-template-map)
- (define-key vhdl-template-map "ne" 'vhdl-template-next)
- (define-key vhdl-template-map "ot" 'vhdl-template-others)
- (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl)
- (define-key vhdl-template-map "Pb" 'vhdl-template-package-body)
- (define-key vhdl-template-map "(" 'vhdl-template-paired-parens)
- (define-key vhdl-template-map "po" 'vhdl-template-port)
- (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body)
- (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl)
- (define-key vhdl-template-map "pc" 'vhdl-template-process-comb)
- (define-key vhdl-template-map "ps" 'vhdl-template-process-seq)
- (define-key vhdl-template-map "rp" 'vhdl-template-report)
- (define-key vhdl-template-map "rt" 'vhdl-template-return)
- (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst)
- (define-key vhdl-template-map "si" 'vhdl-template-signal)
- (define-key vhdl-template-map "su" 'vhdl-template-subtype)
- (define-key vhdl-template-map "ty" 'vhdl-template-type)
- (define-key vhdl-template-map "us" 'vhdl-template-use)
- (define-key vhdl-template-map "va" 'vhdl-template-variable)
- (define-key vhdl-template-map "wa" 'vhdl-template-wait)
- (define-key vhdl-template-map "wl" 'vhdl-template-while-loop)
- (define-key vhdl-template-map "wi" 'vhdl-template-with)
- (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait)
- (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit)
- (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std)
- (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164)
- (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith)
- (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc)
- (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed)
- (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio)
- (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned)
- (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio)
- (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on)
- (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off)
- (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on)
- (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off)
- (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt)
+ (define-key vhdl-template-map "al" #'vhdl-template-alias)
+ (define-key vhdl-template-map "ar" #'vhdl-template-architecture)
+ (define-key vhdl-template-map "at" #'vhdl-template-assert)
+ (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl)
+ (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec)
+ (define-key vhdl-template-map "bl" #'vhdl-template-block)
+ (define-key vhdl-template-map "ca" #'vhdl-template-case-is)
+ (define-key vhdl-template-map "cd" #'vhdl-template-component-decl)
+ (define-key vhdl-template-map "ci" #'vhdl-template-component-inst)
+ (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst)
+ (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration)
+ (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf)
+ (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl)
+ (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec)
+ (define-key vhdl-template-map "co" #'vhdl-template-constant)
+ (define-key vhdl-template-map "ct" #'vhdl-template-context)
+ (define-key vhdl-template-map "di" #'vhdl-template-disconnect)
+ (define-key vhdl-template-map "el" #'vhdl-template-else)
+ (define-key vhdl-template-map "ei" #'vhdl-template-elsif)
+ (define-key vhdl-template-map "en" #'vhdl-template-entity)
+ (define-key vhdl-template-map "ex" #'vhdl-template-exit)
+ (define-key vhdl-template-map "fi" #'vhdl-template-file)
+ (define-key vhdl-template-map "fg" #'vhdl-template-for-generate)
+ (define-key vhdl-template-map "fl" #'vhdl-template-for-loop)
+ (define-key vhdl-template-map "\C-f" #'vhdl-template-footer)
+ (define-key vhdl-template-map "fb" #'vhdl-template-function-body)
+ (define-key vhdl-template-map "fd" #'vhdl-template-function-decl)
+ (define-key vhdl-template-map "ge" #'vhdl-template-generic)
+ (define-key vhdl-template-map "gd" #'vhdl-template-group-decl)
+ (define-key vhdl-template-map "gt" #'vhdl-template-group-template)
+ (define-key vhdl-template-map "\C-h" #'vhdl-template-header)
+ (define-key vhdl-template-map "ig" #'vhdl-template-if-generate)
+ (define-key vhdl-template-map "it" #'vhdl-template-if-then)
+ (define-key vhdl-template-map "li" #'vhdl-template-library)
+ (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop)
+ (define-key vhdl-template-map "\C-m" #'vhdl-template-modify)
+ (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date)
+ (define-key vhdl-template-map "ma" #'vhdl-template-map)
+ (define-key vhdl-template-map "ne" #'vhdl-template-next)
+ (define-key vhdl-template-map "ot" #'vhdl-template-others)
+ (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl)
+ (define-key vhdl-template-map "Pb" #'vhdl-template-package-body)
+ (define-key vhdl-template-map "(" #'vhdl-template-paired-parens)
+ (define-key vhdl-template-map "po" #'vhdl-template-port)
+ (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body)
+ (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl)
+ (define-key vhdl-template-map "pc" #'vhdl-template-process-comb)
+ (define-key vhdl-template-map "ps" #'vhdl-template-process-seq)
+ (define-key vhdl-template-map "rp" #'vhdl-template-report)
+ (define-key vhdl-template-map "rt" #'vhdl-template-return)
+ (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst)
+ (define-key vhdl-template-map "si" #'vhdl-template-signal)
+ (define-key vhdl-template-map "su" #'vhdl-template-subtype)
+ (define-key vhdl-template-map "ty" #'vhdl-template-type)
+ (define-key vhdl-template-map "us" #'vhdl-template-use)
+ (define-key vhdl-template-map "va" #'vhdl-template-variable)
+ (define-key vhdl-template-map "wa" #'vhdl-template-wait)
+ (define-key vhdl-template-map "wl" #'vhdl-template-while-loop)
+ (define-key vhdl-template-map "wi" #'vhdl-template-with)
+ (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait)
+ (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit)
+ (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std)
+ (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164)
+ (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith)
+ (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc)
+ (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed)
+ (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio)
+ (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned)
+ (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio)
+ (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on)
+ (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off)
+ (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on)
+ (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off)
+ (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt)
(when (vhdl-standard-p 'ams)
- (define-key vhdl-template-map "br" 'vhdl-template-break)
- (define-key vhdl-template-map "cu" 'vhdl-template-case-use)
- (define-key vhdl-template-map "iu" 'vhdl-template-if-use)
- (define-key vhdl-template-map "lm" 'vhdl-template-limit)
- (define-key vhdl-template-map "na" 'vhdl-template-nature)
- (define-key vhdl-template-map "pa" 'vhdl-template-procedural)
- (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free)
- (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch)
- (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source)
- (define-key vhdl-template-map "sn" 'vhdl-template-subnature)
- (define-key vhdl-template-map "te" 'vhdl-template-terminal)
+ (define-key vhdl-template-map "br" #'vhdl-template-break)
+ (define-key vhdl-template-map "cu" #'vhdl-template-case-use)
+ (define-key vhdl-template-map "iu" #'vhdl-template-if-use)
+ (define-key vhdl-template-map "lm" #'vhdl-template-limit)
+ (define-key vhdl-template-map "na" #'vhdl-template-nature)
+ (define-key vhdl-template-map "pa" #'vhdl-template-procedural)
+ (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free)
+ (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch)
+ (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source)
+ (define-key vhdl-template-map "sn" #'vhdl-template-subnature)
+ (define-key vhdl-template-map "te" #'vhdl-template-terminal)
)
(when (vhdl-standard-p 'math)
- (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex)
- (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real)
+ (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex)
+ (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real)
))
;; initialize template map for VHDL Mode
@@ -2811,119 +2817,120 @@ STRING are replaced by `-' and substrings are converted to lower case."
;; model key bindings
(define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map)
;; standard key bindings
- (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement)
- (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement)
- (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp)
- (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp)
- (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
- (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
- (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
+ (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement)
+ (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement)
+ (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp)
+ (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp)
+ (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list)
+ (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent)
+ (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent)
(unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
- (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
- (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
- (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
+ (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun))
+ (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp)
+ (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation)
;; mode specific key bindings
- (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
- (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
- (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
- (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
- (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
- (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
- (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
- (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile)
- (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make)
- (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile)
- (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
- (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
- (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
- (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component)
- (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
- (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
- (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
- (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs
- (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
- (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
- (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
- (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
- (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
- (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
- (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
- (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
- (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
- (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
- (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
- (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
- (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component)
- (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component)
- (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components)
- (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration)
- (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package)
- (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region)
- (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline)
- (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line)
- (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
- (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
- (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region)
- (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
- (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
- (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
- (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
- (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
- (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
- (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
- (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
- (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
- (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
- (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
- (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
- (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
- (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
- (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
- (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
- (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
- (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
- (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand)
- (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next)
- (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous)
- (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
- (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
- (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
- (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region)
- (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer)
- (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
- (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
- (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
- (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
- (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
- (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region)
- (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer)
- (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
- (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
- (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer)
- (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer)
- (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages)
- (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode)
- (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version)
- (define-key vhdl-mode-map "\M-\t" 'insert-tab)
+ (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode)
+ (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode)
+ (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project)
+ (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project)
+ (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project)
+ (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project)
+ (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler)
+ (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile)
+ (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make)
+ (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile)
+ (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy)
+ (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy)
+ (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity)
+ (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component)
+ (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance)
+ (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals)
+ (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants)
+ (define-key vhdl-mode-map
+ ;; `... C-g' not allowed in XEmacs.
+ (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g")
+ #'vhdl-port-paste-generic-map)
+ (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations)
+ (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench)
+ (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten)
+ (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction)
+ (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy)
+ (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy)
+ (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration)
+ (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body)
+ (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call)
+ (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten)
+ (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component)
+ (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component)
+ (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components)
+ (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration)
+ (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package)
+ (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region)
+ (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline)
+ (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line)
+ (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode)
+ (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group)
+ (define-key vhdl-mode-map "\M-\C-\\" #'indent-region)
+ (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer)
+ (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group)
+ (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group)
+ (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent)
+ (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list)
+ (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations)
+ (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region)
+ (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer)
+ (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group)
+ (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region)
+ (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list)
+ (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list)
+ (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group)
+ (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent)
+ (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region)
+ (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill)
+ (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy)
+ (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank)
+ (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand)
+ (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next)
+ (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous)
+ (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open)
+ (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line)
+ (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line)
+ (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region)
+ (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer)
+ (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause)
+ (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region)
+ (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer)
+ (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region)
+ (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer)
+ (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region)
+ (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer)
+ (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process)
+ (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer)
+ (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer)
+ (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer)
+ (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages)
+ (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode)
+ (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version)
+ (define-key vhdl-mode-map "\M-\t" #'insert-tab)
;; insert commands bindings
- (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
- (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
- (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
- (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
+ (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct)
+ (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package)
+ (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive)
+ (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert)
;; electric key bindings
- (define-key vhdl-mode-map " " 'vhdl-electric-space)
+ (define-key vhdl-mode-map " " #'vhdl-electric-space)
(when vhdl-intelligent-tab
- (define-key vhdl-mode-map "\t" 'vhdl-electric-tab))
- (define-key vhdl-mode-map "\r" 'vhdl-electric-return)
- (define-key vhdl-mode-map "-" 'vhdl-electric-dash)
- (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket)
- (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket)
- (define-key vhdl-mode-map "'" 'vhdl-electric-quote)
- (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon)
- (define-key vhdl-mode-map "," 'vhdl-electric-comma)
- (define-key vhdl-mode-map "." 'vhdl-electric-period)
+ (define-key vhdl-mode-map "\t" #'vhdl-electric-tab))
+ (define-key vhdl-mode-map "\r" #'vhdl-electric-return)
+ (define-key vhdl-mode-map "-" #'vhdl-electric-dash)
+ (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket)
+ (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket)
+ (define-key vhdl-mode-map "'" #'vhdl-electric-quote)
+ (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon)
+ (define-key vhdl-mode-map "," #'vhdl-electric-comma)
+ (define-key vhdl-mode-map "." #'vhdl-electric-period)
(when (vhdl-standard-p 'ams)
- (define-key vhdl-mode-map "=" 'vhdl-electric-equal)))
+ (define-key vhdl-mode-map "=" #'vhdl-electric-equal)))
;; initialize mode map for VHDL Mode
(vhdl-mode-map-init)
@@ -2934,7 +2941,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(when vhdl-word-completion-in-minibuffer
- (define-key map "\t" 'vhdl-minibuffer-tab))
+ (define-key map "\t" #'vhdl-minibuffer-tab))
map)
"Keymap for minibuffer used in VHDL Mode.")
@@ -3167,7 +3174,8 @@ STRING are replaced by `-' and substrings are converted to lower case."
(unless (equal keyword "")
(push (list keyword ""
(vhdl-function-name
- "vhdl-model" (nth 0 elem) "hook") 0 'system)
+ "vhdl-model" (nth 0 elem) "hook")
+ 0 'system)
abbrev-list)))
abbrev-list)))))
@@ -3574,7 +3582,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
("Indent"
["Line" indent-according-to-mode :keys "C-c C-i C-l"]
["Group" vhdl-indent-group :keys "C-c C-i C-g"]
- ["Region" vhdl-indent-region (mark)]
+ ["Region" indent-region (mark)]
["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"])
("Align"
["Group" vhdl-align-group t]
@@ -4884,7 +4892,7 @@ Key bindings:
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
+ (set (make-local-variable 'indent-line-function) #'vhdl-indent-line)
(set (make-local-variable 'comment-start) "--")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-column) vhdl-inline-comment-column)
@@ -4897,13 +4905,13 @@ Key bindings:
;; setup the comment indent variable in an Emacs version portable way
;; ignore any byte compiler warnings you might get here
(when (boundp 'comment-indent-function)
- (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent))
+ (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent))
;; initialize font locking
(set (make-local-variable 'font-lock-defaults)
(list
'(nil vhdl-font-lock-keywords) nil
- (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
+ (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line))
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(set (make-local-variable 'syntax-propertize-function)
(syntax-propertize-rules
@@ -4912,7 +4920,7 @@ Key bindings:
("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
(set (make-local-variable 'font-lock-syntactic-keywords)
vhdl-font-lock-syntactic-keywords))
- (unless vhdl-emacs-21
+ (when (featurep 'xemacs)
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
(set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
@@ -4958,10 +4966,10 @@ Key bindings:
(defun vhdl-write-file-hooks-init ()
"Add/remove hooks when buffer is saved."
(if vhdl-modify-date-on-saving
- (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t)
- (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t))
+ (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t)
+ (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t))
(if (featurep 'xemacs) (make-local-hook 'after-save-hook))
- (add-hook 'after-save-hook 'vhdl-add-modified-file nil t))
+ (add-hook 'after-save-hook #'vhdl-add-modified-file nil t))
(defun vhdl-process-command-line-option (option)
"Process command line options for VHDL Mode."
@@ -5744,7 +5752,7 @@ negative, skip forward otherwise."
;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
- (defalias 'vhdl-forward-comment 'forward-comment))
+ (defalias 'vhdl-forward-comment #'forward-comment))
(defun vhdl-back-to-indentation ()
"Move point to the first non-whitespace character on this line."
@@ -5808,7 +5816,7 @@ negative, skip forward otherwise."
state)))
(and (string-match "Win-Emacs" emacs-version)
- (fset 'vhdl-in-literal 'vhdl-win-il))
+ (fset 'vhdl-in-literal #'vhdl-win-il))
;; Skipping of "syntactic whitespace". Syntactic whitespace is
;; defined as lexical whitespace or comments. Search no farther back
@@ -5846,9 +5854,9 @@ negative, skip forward otherwise."
(t (setq stop t))))))
(and (string-match "Win-Emacs" emacs-version)
- (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
+ (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws))
-(defun vhdl-beginning-of-macro (&optional lim)
+(defun vhdl-beginning-of-macro (&optional _lim)
"Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
(let ((here (point)))
(beginning-of-line)
@@ -5861,7 +5869,7 @@ negative, skip forward otherwise."
(goto-char here)
nil)))
-(defun vhdl-beginning-of-directive (&optional lim)
+(defun vhdl-beginning-of-directive (&optional _lim)
"Go to the beginning of a directive (nicked from `cc-engine')."
(let ((here (point)))
(beginning-of-line)
@@ -5905,7 +5913,7 @@ negative, skip forward otherwise."
(t (setq stop t))))))
(and (string-match "Win-Emacs" emacs-version)
- (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
+ (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws))
;; Functions to help finding the correct indentation column:
@@ -6053,7 +6061,7 @@ keyword."
t)
))
-(defun vhdl-corresponding-mid (&optional lim)
+(defun vhdl-corresponding-mid (&optional _lim)
(cond
((looking-at "is\\|block\\|generate\\|process\\|procedural")
"begin")
@@ -6269,7 +6277,7 @@ of an identifier that just happens to contain an \"end\" keyword."
"A regular expression for searching backward that matches all known
\"statement\" keywords.")
-(defun vhdl-statement-p (&optional lim)
+(defun vhdl-statement-p (&optional _lim)
"Return t if we are looking at a real \"statement\" keyword.
Assumes that the caller will make sure that we are looking at
vhdl-statement-fwd-re, and are not inside a literal, and that we are not
@@ -6461,7 +6469,7 @@ searches."
;; internal-p controls where the statement keyword can
;; be found.
(internal-p (aref begin-vec 3))
- (last-backward (point)) last-forward
+ (last-backward (point)) ;; last-forward
foundp literal keyword)
;; Look for the statement keyword.
(while (and (not foundp)
@@ -6496,7 +6504,7 @@ searches."
(setq begin-re
(concat "\\b\\(" begin-re "\\)\\b[^_]"))
(save-excursion
- (setq last-forward (point))
+ ;; (setq last-forward (point))
;; Look for the supplementary keyword
;; (bounded by the backward search start
;; point).
@@ -6548,7 +6556,7 @@ With argument, do this that many times."
(setq target (point)))
(goto-char target)))
-(defun vhdl-end-of-defun (&optional count)
+(defun vhdl-end-of-defun (&optional _count)
"Move forward to the end of a VHDL defun."
(interactive)
(let ((case-fold-search t))
@@ -7320,7 +7328,7 @@ after the containing paren which starts the arglist."
(current-column))))
(- ce-curcol cs-curcol -1))))
-(defun vhdl-lineup-comment (langelem)
+(defun vhdl-lineup-comment (_langelem)
"Support old behavior for comment indentation. We look at
vhdl-comment-only-line-offset to decide how to indent comment
only-lines."
@@ -7382,27 +7390,13 @@ only-lines."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Progress reporting
-(defvar vhdl-progress-info nil
- "Array variable for progress information: 0 begin, 1 end, 2 time.")
-
-(defun vhdl-update-progress-info (string pos)
- "Update progress information."
- (when (and vhdl-progress-info (not noninteractive)
- (time-less-p vhdl-progress-interval
- (time-since (aref vhdl-progress-info 2))))
- (let ((delta (- (aref vhdl-progress-info 1)
- (aref vhdl-progress-info 0))))
- (message "%s... (%2d%%)" string
- (if (= 0 delta)
- 100
- (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
- delta))))
- (aset vhdl-progress-info 2 (time-convert nil 'integer))))
+(defvar vhdl--progress-reporter nil
+ "Holds the progress reporter data during long running operations.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indentation commands
-(defun vhdl-electric-tab (&optional prefix-arg)
+(defun vhdl-electric-tab (&optional arg)
"If preceding character is part of a word or a paren then hippie-expand,
else if right of non whitespace on line then insert tab,
else if last command was a tab or return then dedent one step or if a comment
@@ -7413,7 +7407,7 @@ else indent `correctly'."
(cond
;; indent region if region is active
((and (not (featurep 'xemacs)) (use-region-p))
- (vhdl-indent-region (region-beginning) (region-end) nil))
+ (indent-region (region-beginning) (region-end) nil))
;; expand word
((= (char-syntax (preceding-char)) ?w)
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
@@ -7422,12 +7416,12 @@ else indent `correctly'."
(or (and (boundp 'hippie-expand-only-buffers)
hippie-expand-only-buffers)
'(vhdl-mode))))
- (vhdl-expand-abbrev prefix-arg)))
+ (vhdl-expand-abbrev arg)))
;; expand parenthesis
((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
(case-replace nil))
- (vhdl-expand-paren prefix-arg)))
+ (vhdl-expand-paren arg)))
;; insert tab
((> (current-column) (current-indentation))
(insert-tab))
@@ -7486,7 +7480,7 @@ indentation change."
(setq syntax (vhdl-get-syntactic-context)))))
(when is-comment
(push (cons 'comment nil) syntax))
- (apply '+ (mapcar 'vhdl-get-offset syntax)))
+ (apply #'+ (mapcar #'vhdl-get-offset syntax)))
;; indent like previous nonblank line
(save-excursion (beginning-of-line)
(re-search-backward "^[^\n]" nil t)
@@ -7508,25 +7502,17 @@ indentation change."
(when (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))))
(run-hooks 'vhdl-special-indent-hook)
- (vhdl-update-progress-info "Indenting" (vhdl-current-line))
+ (when vhdl--progress-reporter
+ (progress-reporter-update vhdl--progress-reporter (point)))
shift-amt))
-(defun vhdl-indent-region (beg end &optional column)
- "Indent region as VHDL code.
-Adds progress reporting to `indent-region'."
- (interactive "r\nP")
- (when vhdl-progress-interval
- (setq vhdl-progress-info (vector (count-lines (point-min) beg)
- (count-lines (point-min) end) 0)))
- (indent-region beg end column)
- (when vhdl-progress-interval (message "Indenting...done"))
- (setq vhdl-progress-info nil))
+(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1")
(defun vhdl-indent-buffer ()
"Indent whole buffer as VHDL code.
Calls `indent-region' for whole buffer and adds progress reporting."
(interactive)
- (vhdl-indent-region (point-min) (point-max)))
+ (indent-region (point-min) (point-max)))
(defun vhdl-indent-group ()
"Indent group of lines between empty lines."
@@ -7539,7 +7525,7 @@ Calls `indent-region' for whole buffer and adds progress reporting."
(if (re-search-forward vhdl-align-group-separate nil t)
(point-marker)
(point-max-marker)))))
- (vhdl-indent-region beg end)))
+ (indent-region beg end)))
(defun vhdl-indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
@@ -7698,7 +7684,7 @@ parentheses."
;; run FUNCTION
(funcall function beg end spacing)))
-(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
+(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent)
"Attempt to align a range of lines based on the content of the
lines. The definition of `alignment-list' determines the matching
order and the manner in which the lines are aligned. If ALIGNMENT-LIST
@@ -7708,12 +7694,15 @@ indentation is done before aligning."
(setq alignment-list (or alignment-list vhdl-align-alist))
(setq spacing (or spacing 1))
(save-excursion
- (let (bol indent)
+ (let (bol) ;; indent
(goto-char end)
(setq end (point-marker))
(goto-char begin)
(setq bol (setq begin (progn (beginning-of-line) (point))))
- (when indent
+ ;; FIXME: The `indent' arg is not used, and I think it's because
+ ;; the let binding commented out above `indent' was hiding it, so
+ ;; the test below should maybe still test `indent'?
+ (when nil ;; indent
(indent-region bol end nil))))
(let ((copy (copy-alist alignment-list)))
(vhdl-prepare-search-2
@@ -7798,18 +7787,21 @@ the token in MATCH."
"Align region, treat groups of lines separately."
(interactive "r\nP")
(save-excursion
- (let (orig pos)
- (goto-char beg)
- (beginning-of-line)
- (setq orig (point-marker))
- (setq beg (point))
- (goto-char end)
- (setq end (point-marker))
- (untabify beg end)
- (unless no-message
- (when vhdl-progress-interval
- (setq vhdl-progress-info (vector (count-lines (point-min) beg)
- (count-lines (point-min) end) 0))))
+ (goto-char beg)
+ (beginning-of-line)
+ (setq beg (point))
+ (goto-char end)
+ (setq end (point-marker))
+ (untabify beg end)
+ (let ((orig (copy-marker beg))
+ pos
+ (vhdl--progress-reporter
+ (if no-message
+ ;; Preserve a potential progress reporter from
+ ;; when called from `vhdl-align-region' call.
+ vhdl--progress-reporter
+ (when vhdl-progress-interval
+ (make-progress-reporter "Aligning..." beg (copy-marker end))))))
(when (nth 0 vhdl-beautify-options)
(vhdl-fixup-whitespace-region beg end t))
(goto-char beg)
@@ -7824,19 +7816,21 @@ the token in MATCH."
(setq pos (point-marker))
(vhdl-align-region-1 beg pos spacing)
(unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
- (vhdl-update-progress-info "Aligning" (vhdl-current-line))
+ (when vhdl--progress-reporter
+ (progress-reporter-update vhdl--progress-reporter (point)))
(setq beg (1+ pos))
(goto-char beg))
;; align last group
(when (< beg end)
(vhdl-align-region-1 beg end spacing)
(unless no-comments (vhdl-align-inline-comment-region-1 beg end))
- (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
+ (when vhdl--progress-reporter
+ (progress-reporter-update vhdl--progress-reporter (point)))))
(when vhdl-indent-tabs-mode
(tabify orig end))
(unless no-message
- (when vhdl-progress-interval (message "Aligning...done"))
- (setq vhdl-progress-info nil)))))
+ (when vhdl--progress-reporter
+ (progress-reporter-done vhdl--progress-reporter))))))
(defun vhdl-align-region (beg end &optional spacing)
"Align region, treat blocks with same indent and argument lists separately."
@@ -7847,10 +7841,10 @@ the token in MATCH."
;; align blocks with same indent and argument lists
(save-excursion
(let ((cur-beg beg)
- indent cur-end)
- (when vhdl-progress-interval
- (setq vhdl-progress-info (vector (count-lines (point-min) beg)
- (count-lines (point-min) end) 0)))
+ indent cur-end
+ (vhdl--progress-reporter
+ (when vhdl-progress-interval
+ (make-progress-reporter "Aligning..." beg (copy-marker end)))))
(goto-char end)
(setq end (point-marker))
(goto-char cur-beg)
@@ -7873,15 +7867,16 @@ the token in MATCH."
(= (current-indentation) indent))
(<= (save-excursion
(nth 0 (parse-partial-sexp
- (point) (vhdl-point 'eol)))) 0))
+ (point) (vhdl-point 'eol))))
+ 0))
(unless (looking-at "^\\s-*$")
(setq cur-end (vhdl-point 'bonl)))
(beginning-of-line 2)))
;; align region
(vhdl-align-region-groups cur-beg cur-end spacing t t))
(vhdl-align-inline-comment-region beg end spacing noninteractive)
- (when vhdl-progress-interval (message "Aligning...done"))
- (setq vhdl-progress-info nil)))))
+ (when vhdl--progress-reporter
+ (progress-reporter-done vhdl--progress-reporter))))))
(defun vhdl-align-group (&optional spacing)
"Align group of lines between empty lines."
@@ -8030,7 +8025,7 @@ empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
(tabify orig end))
(unless no-message (message "Aligning inline comments...done")))))
-(defun vhdl-align-inline-comment-group (&optional spacing)
+(defun vhdl-align-inline-comment-group (&optional _spacing)
"Align inline comments within a group of lines between empty lines."
(interactive)
(save-excursion
@@ -8125,7 +8120,8 @@ end of line, do nothing in comments."
"Convert all words matching WORD-REGEXP in region to lower or upper case,
depending on parameter UPPER-CASE."
(let ((case-replace nil)
- (last-update 0))
+ (pr (when (and count vhdl-progress-interval (not noninteractive))
+ (make-progress-reporter "Fixing case..." beg (copy-marker end)))))
(vhdl-prepare-search-2
(save-excursion
(goto-char end)
@@ -8136,19 +8132,13 @@ depending on parameter UPPER-CASE."
(if upper-case
(upcase-word -1)
(downcase-word -1)))
- (when (and count vhdl-progress-interval (not noninteractive)
- (time-less-p vhdl-progress-interval
- (time-since last-update)))
- (message "Fixing case... (%2d%s)"
- (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
- "%")
- (setq last-update (time-convert nil 'integer))))
- (goto-char end)))))
-
-(defun vhdl-fix-case-region (beg end &optional arg)
+ (when pr (progress-reporter-update pr (point))))
+ (when pr (progress-reporter-done pr))))))
+
+(defun vhdl-fix-case-region (beg end &optional _arg)
"Convert all VHDL words in region to lower or upper case, depending on
options vhdl-upper-case-{keywords,types,attributes,enum-values}."
- (interactive "r\nP")
+ (interactive "r")
(vhdl-fix-case-region-1
beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
(vhdl-fix-case-region-1
@@ -8194,11 +8184,11 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}."
;; - force each statement to be on a separate line except when on same line
;; with 'end' keyword
-(defun vhdl-fix-statement-region (beg end &optional arg)
+(defun vhdl-fix-statement-region (beg end &optional _arg)
"Force statements in region on separate line except when on same line
with `end' keyword (necessary for correct indentation).
Currently supported keywords: `begin', `if'."
- (interactive "r\nP")
+ (interactive "r")
(vhdl-prepare-search-2
(let (point)
(save-excursion
@@ -8250,9 +8240,9 @@ with `end' keyword (necessary for correct indentation)."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Trailing spaces
-(defun vhdl-remove-trailing-spaces-region (beg end &optional arg)
+(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg)
"Remove trailing spaces in region."
- (interactive "r\nP")
+ (interactive "r")
(save-excursion
(goto-char end)
(setq end (point-marker))
@@ -8282,7 +8272,7 @@ case fixing to a region. Calls functions `vhdl-indent-buffer',
(replace-match "" nil t)))
(when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
(when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
- (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
+ (when (nth 2 vhdl-beautify-options) (indent-region beg end))
(when (nth 3 vhdl-beautify-options)
(let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
(when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
@@ -8515,7 +8505,7 @@ buffer."
(delete-region sens-beg sens-end)
(when read-list
(insert " ()") (backward-char)))
- (setq read-list (sort read-list 'string<))
+ (setq read-list (sort read-list #'string<))
(when read-list
(setq margin (current-column))
(insert (car read-list))
@@ -8547,7 +8537,7 @@ buffer."
(concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
"." (file-name-extension (buffer-file-name)))))
(vhdl-visit-file
- file-name t
+ file-name t
(vhdl-prepare-search-2
(goto-char (point-min))
(if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
@@ -8555,7 +8545,8 @@ buffer."
(when (setq beg (vhdl-re-search-forward
"\\<port[ \t\n\r\f]*("
(save-excursion
- (re-search-forward "^end\\>" nil t)) t))
+ (re-search-forward "^end\\>" nil t))
+ t))
(setq end (save-excursion
(backward-char) (forward-sexp) (point)))
(vhdl-forward-syntactic-ws)
@@ -8687,9 +8678,9 @@ buffer."
Used for undoing after template abortion.")
;; correct different behavior of function `unread-command-events' in XEmacs
-(defun vhdl-character-to-event (arg))
+(defun vhdl-character-to-event (_arg) nil)
(defalias 'vhdl-character-to-event
- (if (fboundp 'character-to-event) 'character-to-event 'identity))
+ (if (fboundp 'character-to-event) #'character-to-event #'identity))
(defun vhdl-work-library ()
"Return the working library name of the current project or \"work\" if no
@@ -9146,7 +9137,8 @@ a configuration declaration if not within a design unit."
(re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
(equal "CONFIGURATION" (upcase (match-string 1))))
(if (eq (vhdl-decision-query
- "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
+ "configuration" "(b)lock or (c)omponent configuration?" t)
+ ?c)
(vhdl-template-component-conf)
(vhdl-template-block-configuration)))
(t (vhdl-template-configuration-decl))))) ; otherwise
@@ -9255,7 +9247,7 @@ a configuration declaration if not within a design unit."
(interactive)
(let ((margin (current-indentation))
(start (point))
- entity-exists string name position)
+ name position) ;; entity-exists string
(vhdl-insert-keyword "CONTEXT ")
(when (setq name (vhdl-template-field "name" nil t start (point)))
(vhdl-insert-keyword " IS\n")
@@ -9411,7 +9403,8 @@ otherwise."
(re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
(equal "CONFIGURATION" (upcase (match-string 1))))
(if (eq (vhdl-decision-query
- "for" "(b)lock or (c)omponent configuration?" t) ?c)
+ "for" "(b)lock or (c)omponent configuration?" t)
+ ?c)
(vhdl-template-component-conf)
(vhdl-template-block-configuration)))
((and (save-excursion
@@ -9526,11 +9519,12 @@ otherwise."
(defun vhdl-template-group ()
"Insert group or group template declaration."
(interactive)
- (let ((start (point)))
- (if (eq (vhdl-decision-query
- "group" "(d)eclaration or (t)emplate declaration?" t) ?t)
- (vhdl-template-group-template)
- (vhdl-template-group-decl))))
+ ;; (let ((start (point)))
+ (if (eq (vhdl-decision-query
+ "group" "(d)eclaration or (t)emplate declaration?" t)
+ ?t)
+ (vhdl-template-group-template)
+ (vhdl-template-group-decl))) ;; )
(defun vhdl-template-group-decl ()
"Insert group declaration."
@@ -10471,7 +10465,8 @@ specification, if not already there."
(and (not (bobp))
(re-search-backward
(concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
- library "\\|end\\)\\>") nil t)
+ library "\\|end\\)\\>")
+ nil t)
(match-string 2))))
(equal (downcase library) "work"))
(vhdl-insert-keyword "LIBRARY ")
@@ -10831,9 +10826,9 @@ If starting after end-comment-column, start a new line."
(vhdl-line-kill-entire)))))
(goto-char final-pos))))
-(defun vhdl-comment-uncomment-region (beg end &optional arg)
+(defun vhdl-comment-uncomment-region (beg end &optional _arg)
"Comment out region if not commented out, uncomment otherwise."
- (interactive "r\nP")
+ (interactive "r")
(save-excursion
(goto-char (1- end))
(end-of-line)
@@ -10910,7 +10905,7 @@ Point is left between them."
"Read from user a procedure or function argument list."
(insert " (")
(let ((margin (current-column))
- (start (point))
+ ;; (start (point))
(end-pos (point))
not-empty interface semicolon-pos)
(unless vhdl-argument-list-indent
@@ -10919,7 +10914,8 @@ Point is left between them."
(indent-to margin))
(setq interface (vhdl-template-field
(concat "[CONSTANT | SIGNAL"
- (unless is-function " | VARIABLE") "]") " " t))
+ (unless is-function " | VARIABLE") "]")
+ " " t))
(while (vhdl-template-field "[names]" nil t)
(setq not-empty t)
(insert " : ")
@@ -10936,7 +10932,8 @@ Point is left between them."
(indent-to margin)
(setq interface (vhdl-template-field
(concat "[CONSTANT | SIGNAL"
- (unless is-function " | VARIABLE") "]") " " t)))
+ (unless is-function " | VARIABLE") "]")
+ " " t)))
(delete-region end-pos (point))
(when semicolon-pos (goto-char semicolon-pos))
(if not-empty
@@ -11156,7 +11153,7 @@ with double-quotes is to be inserted. DEFAULT specifies a default string."
"Adjust case of following NUM words."
(if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
-(defun vhdl-minibuffer-tab (&optional prefix-arg)
+(defun vhdl-minibuffer-tab (&optional arg)
"If preceding character is part of a word or a paren then hippie-expand,
else insert tab (used for word completion in VHDL minibuffer)."
(interactive "P")
@@ -11169,12 +11166,12 @@ else insert tab (used for word completion in VHDL minibuffer)."
(or (and (boundp 'hippie-expand-only-buffers)
hippie-expand-only-buffers)
'(vhdl-mode))))
- (vhdl-expand-abbrev prefix-arg)))
+ (vhdl-expand-abbrev arg)))
;; expand parenthesis
((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
(case-replace nil))
- (vhdl-expand-paren prefix-arg)))
+ (vhdl-expand-paren arg)))
;; insert tab
(t (insert-tab))))
@@ -11561,7 +11558,8 @@ but not if inside a comment or quote."
(unless (equal model-keyword "")
(eval `(defun
,(vhdl-function-name
- "vhdl-model" model-name "hook") ()
+ "vhdl-model" model-name "hook")
+ ()
(vhdl-hooked-abbrev
',(vhdl-function-name "vhdl-model" model-name)))))
(setq model-alist (cdr model-alist)))))
@@ -11857,7 +11855,7 @@ reflected in a subsequent paste operation."
(defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
"Paste a context clause."
- (let ((margin (current-indentation))
+ (let (;; (margin (current-indentation))
(clause-list (nth 3 vhdl-port-list))
clause)
(while clause-list
@@ -11867,7 +11865,8 @@ reflected in a subsequent paste operation."
(save-excursion
(re-search-backward
(concat "^\\s-*use\\s-+" (car clause)
- "." (cdr clause) "\\>") nil t)))
+ "." (cdr clause) "\\>")
+ nil t)))
(vhdl-template-standard-package (car clause) (cdr clause))
(insert "\n"))
(setq clause-list (cdr clause-list)))))
@@ -12259,7 +12258,8 @@ reflected in a subsequent paste operation."
(cond ((and vhdl-include-direction-comments (nth 2 port))
(format "%-6s" (concat "[" (nth 2 port) "] ")))
(vhdl-include-direction-comments " "))
- (when vhdl-include-port-comments (nth 4 port))) t))
+ (when vhdl-include-port-comments (nth 4 port)))
+ t))
(setq port-list (cdr port-list))
(when port-list (insert "\n") (indent-to margin)))
;; align signal list
@@ -12313,7 +12313,7 @@ reflected in a subsequent paste operation."
(let ((case-fold-search t)
(ent-name (vhdl-replace-string vhdl-testbench-entity-name
(nth 0 vhdl-port-list)))
- (source-buffer (current-buffer))
+ ;; (source-buffer (current-buffer))
arch-name config-name ent-file-name arch-file-name
ent-buffer arch-buffer position)
;; open entity file
@@ -12410,7 +12410,7 @@ reflected in a subsequent paste operation."
(insert "\n")
(setq position (point))
(vhdl-insert-string-or-file vhdl-testbench-declarations)
- (vhdl-indent-region position (point)))
+ (indent-region position (point)))
(setq position (point))
(insert "\n\n")
(vhdl-comment-display-line) (insert "\n")
@@ -12441,7 +12441,7 @@ reflected in a subsequent paste operation."
(insert "\n")
(setq position (point))
(vhdl-insert-string-or-file vhdl-testbench-statements)
- (vhdl-indent-region position (point)))
+ (indent-region position (point)))
(insert "\n")
(indent-to vhdl-basic-offset)
(unless (eq vhdl-testbench-create-files 'none)
@@ -12814,7 +12814,7 @@ expressions (e.g. for index ranges of types and signals)."
;; override `he-list-beg' from `hippie-exp'
(unless (and (boundp 'viper-mode) viper-mode)
- (defalias 'he-list-beg 'vhdl-he-list-beg))
+ (defalias 'he-list-beg #'vhdl-he-list-beg))
;; function for expanding abbrevs and dabbrevs
(defalias 'vhdl-expand-abbrev (make-hippie-expand-function
@@ -12861,14 +12861,14 @@ expressions (e.g. for index ranges of types and signals)."
(beginning-of-line)
(yank))
-(defun vhdl-line-expand (&optional prefix-arg)
+(defun vhdl-line-expand (&optional arg)
"Hippie-expand current line."
(interactive "P")
(require 'hippie-exp)
(let ((case-fold-search t) (case-replace nil)
(hippie-expand-try-functions-list
'(try-expand-line try-expand-line-all-buffers)))
- (hippie-expand prefix-arg)))
+ (hippie-expand arg)))
(defun vhdl-line-transpose-next (&optional arg)
"Interchange this line with next line."
@@ -12990,7 +12990,7 @@ File statistics: \"%s\"\n\
# total lines : %5d\n"
(buffer-file-name) no-stats no-code-lines no-empty-lines
no-comm-lines no-comments no-lines)
- (unless vhdl-emacs-21 (vhdl-show-messages))))
+ (when (featurep 'xemacs) (vhdl-show-messages))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Help functions
@@ -13039,7 +13039,7 @@ File statistics: \"%s\"\n\
(customize-set-variable 'vhdl-project vhdl-project)
(customize-save-customized))
-(defun vhdl-toggle-project (name token indent)
+(defun vhdl-toggle-project (name _token _indent)
"Set current project to NAME or unset if NAME is current project."
(vhdl-set-project (if (equal name vhdl-project) "" name)))
@@ -13243,6 +13243,7 @@ File statistics: \"%s\"\n\
"Toggle hideshow minor mode and update menu bar."
(interactive "P")
(require 'hideshow)
+ (declare-function hs-hide-all "hideshow" ())
;; check for hideshow version 5.x
(if (not (boundp 'hs-block-start-mdata-select))
(vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
@@ -13254,8 +13255,8 @@ File statistics: \"%s\"\n\
hs-special-modes-alist)))
(if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
(if vhdl-hide-all-init
- (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t)
- (remove-hook 'hs-minor-mode-hook 'hs-hide-all t))
+ (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t)
+ (remove-hook 'hs-minor-mode-hook #'hs-hide-all t))
(hs-minor-mode arg)
(force-mode-line-update))) ; hack to update menu bar
@@ -13522,6 +13523,8 @@ This does background highlighting of translate-off regions.")
(while syntax-alist
(setq name (vhdl-function-name
"vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
+ ;; FIXME: This `defvar' shouldn't be needed: just quote the face
+ ;; name when you use it.
(eval `(defvar ,name ',name
,(concat "Face name to use for "
(nth 0 (car syntax-alist)) ".")))
@@ -13734,7 +13737,7 @@ This does background highlighting of translate-off regions.")
(when (boundp 'ps-print-color-p)
(vhdl-ps-print-settings))
(if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
- (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t)))
+ (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -13906,7 +13909,7 @@ hierarchy otherwise.")
pack-list pack-body-list inst-list inst-ent-list)
;; scan file
(vhdl-visit-file
- file-name nil
+ file-name nil
(vhdl-prepare-search-2
(save-excursion
;; scan for design units
@@ -14081,7 +14084,8 @@ hierarchy otherwise.")
"component[ \t\n\r\f]+\\(\\w+\\)\\|"
"\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
- "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
+ "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)")
+ end-of-unit t)
(or (not limit-hier-inst-no)
(<= (if (or (match-string 14)
(match-string 16))
@@ -14443,12 +14447,15 @@ of PROJECT."
;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
;; comp-lib-name level)
-(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
- conf-inst-alist level indent
- &optional include-top ent-hier)
+(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key
+ conf-key-arg conf-inst-alist level indent
+ &optional include-top ent-hier)
"Get instantiation hierarchy beginning in architecture ARCH-KEY of
entity ENT-KEY."
- (let* ((ent-entry (vhdl-aget ent-alist ent-key))
+ (let* ((ent-alist ent-alist-arg)
+ (conf-alist conf-alist-arg)
+ (conf-key conf-key-arg)
+ (ent-entry (vhdl-aget ent-alist ent-key))
(arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
(cdar (last (nth 3 ent-entry)))))
(inst-alist (nth 3 arch-entry))
@@ -14580,6 +14587,8 @@ entity ENT-KEY."
(error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches")
(sit-for 2)))))
+(defvar vhdl-cache-version)
+
(defun vhdl-save-cache (key)
"Save current hierarchy cache to file."
(let* ((orig-buffer (current-buffer))
@@ -14666,7 +14675,7 @@ entity ENT-KEY."
(file-dir-name (expand-file-name file-name directory))
vhdl-cache-version)
(unless (memq 'vhdl-save-caches kill-emacs-hook)
- (add-hook 'kill-emacs-hook 'vhdl-save-caches))
+ (add-hook 'kill-emacs-hook #'vhdl-save-caches))
(when (file-exists-p file-dir-name)
(condition-case ()
(progn (load-file file-dir-name)
@@ -14706,6 +14715,8 @@ if required."
(declare-function speedbar-change-initial-expansion-list "speedbar"
(new-default))
(declare-function speedbar-add-expansion-list "speedbar" (new-list))
+(declare-function speedbar-expand-line "speedbar" (&optional arg))
+(declare-function speedbar-edit-line "speedbar" ())
(defun vhdl-speedbar-initialize ()
"Initialize speedbar."
@@ -14730,19 +14741,19 @@ if required."
;; keymap
(unless vhdl-speedbar-mode-map
(setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
- (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line)
- (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line)
- (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line)
- (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line)
- (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level)
- (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all)
- (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy)
- (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component)
- (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration)
- (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra)
- (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design)
- (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy)
- (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches)
+ (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line)
+ (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line)
+ (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line)
+ (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line)
+ (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level)
+ (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all)
+ (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy)
+ (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component)
+ (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration)
+ (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra)
+ (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design)
+ (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy)
+ (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches)
(let ((key 0))
(while (<= key 9)
(define-key vhdl-speedbar-mode-map (int-to-string key)
@@ -14813,7 +14824,7 @@ if required."
(setq speedbar-initial-expansion-list-name "vhdl directory"))
(when (eq vhdl-speedbar-display-mode 'project)
(setq speedbar-initial-expansion-list-name "vhdl project"))
- (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
+ (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy)))
(defun vhdl-speedbar (&optional arg)
"Open/close speedbar."
@@ -14831,17 +14842,17 @@ if required."
"Name of last selected project.")
;; macros must be defined in the file they are used (copied from `speedbar.el')
-;;; (defmacro speedbar-with-writable (&rest forms)
-;;; "Allow the buffer to be writable and evaluate FORMS."
-;;; (list 'let '((inhibit-read-only t))
-;;; (cons 'progn forms)))
-;;; (put 'speedbar-with-writable 'lisp-indent-function 0)
+;; (defmacro speedbar-with-writable (&rest forms)
+;; "Allow the buffer to be writable and evaluate FORMS."
+;; (declare (indent 0) (debug t))
+;; (list 'let '((inhibit-read-only t))
+;; (cons 'progn forms)))
(declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
(declare-function speedbar-directory-buttons "speedbar" (directory _index))
(declare-function speedbar-file-lists "speedbar" (directory))
-(defun vhdl-speedbar-display-directory (directory depth &optional rescan)
+(defun vhdl-speedbar-display-directory (directory depth &optional _rescan)
"Display directory and hierarchy information in speedbar."
(setq vhdl-speedbar-show-projects nil)
(setq speedbar-ignored-directory-regexp
@@ -14862,7 +14873,7 @@ if required."
(when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
(error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))))
-(defun vhdl-speedbar-display-projects (project depth &optional rescan)
+(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan)
"Display projects and hierarchy information in speedbar."
(setq vhdl-speedbar-show-projects t)
(setq speedbar-ignored-directory-regexp ".")
@@ -14878,6 +14889,8 @@ if required."
(declare-function speedbar-make-tag-line "speedbar"
(type char func data tag tfunc tdata tface depth))
+(defvar vhdl-speedbar-update-current-unit)
+
(defun vhdl-speedbar-insert-projects ()
"Insert all projects in speedbar."
(vhdl-speedbar-make-title-line "Projects:")
@@ -14888,9 +14901,9 @@ if required."
;; insert projects
(while project-alist
(speedbar-make-tag-line
- 'angle ?+ 'vhdl-speedbar-expand-project
+ 'angle ?+ #'vhdl-speedbar-expand-project
(caar project-alist) (caar project-alist)
- 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
+ #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
(setq project-alist (cdr project-alist)))
(setq project-alist vhdl-project-alist)
;; expand projects
@@ -14937,12 +14950,14 @@ otherwise use cached data."
(vhdl-speedbar-expand-units directory)
(vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
-(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
- ent-inst-list depth)
+(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist
+ ent-inst-list depth)
"Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
(if (not (or ent-alist conf-alist pack-alist))
(vhdl-speedbar-make-title-line "No VHDL design units!" depth)
- (let (ent-entry conf-entry pack-entry)
+ (let ((ent-alist ent-alist-arg)
+ (conf-alist conf-alist-arg)
+ ent-entry conf-entry pack-entry)
;; insert entities
(when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
(while ent-alist
@@ -15003,7 +15018,7 @@ otherwise use cached data."
(declare-function speedbar-goto-this-file "speedbar" (file))
-(defun vhdl-speedbar-expand-dirs (directory)
+(defun vhdl-speedbar-expand-dirs (_directory)
"Expand subdirectories in DIRECTORY according to
`speedbar-shown-directories'."
;; (nicked from `speedbar-default-directory-list')
@@ -15042,7 +15057,8 @@ otherwise use cached data."
(goto-char position)
(when (re-search-forward
(concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
- (car arch-alist) "\\>\\)") nil t)
+ (car arch-alist) "\\>\\)")
+ nil t)
(beginning-of-line)
(when (looking-at "^[0-9]+:\\s-*{")
(goto-char (match-end 0))
@@ -15411,6 +15427,7 @@ otherwise use cached data."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Display help functions
+;; FIXME: This `defvar' should be moved before its first use.
(defvar vhdl-speedbar-update-current-unit t
"Non-nil means to run `vhdl-speedbar-update-current-unit'.")
@@ -15846,7 +15863,7 @@ NO-POSITION non-nil means do not re-position cursor."
(abbreviate-file-name
(file-name-as-directory (speedbar-line-directory indent)))))
-(defun vhdl-speedbar-line-project (&optional indent)
+(defun vhdl-speedbar-line-project (&optional _indent)
"Get currently displayed project name."
(and vhdl-speedbar-show-projects
(save-excursion
@@ -15916,7 +15933,7 @@ NO-POSITION non-nil means do not re-position cursor."
;; speedbar loads dframe at runtime.
(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
-(defun vhdl-speedbar-find-file (text token indent)
+(defun vhdl-speedbar-find-file (_text token _indent)
"When user clicks on TEXT, load file with name and position in TOKEN.
Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
is already shown in a buffer."
@@ -15944,12 +15961,12 @@ is already shown in a buffer."
(let ((token (get-text-property
(match-beginning 3) 'speedbar-token)))
(vhdl-visit-file (car token) t
- (progn (goto-char (point-min))
- (forward-line (1- (cdr token)))
- (end-of-line)
- (if is-entity
- (vhdl-port-copy)
- (vhdl-subprog-copy)))))
+ (goto-char (point-min))
+ (forward-line (1- (cdr token)))
+ (end-of-line)
+ (if is-entity
+ (vhdl-port-copy)
+ (vhdl-subprog-copy))))
(error (error "ERROR: %s not scanned successfully\n (%s)"
(if is-entity "Port" "Interface") (cadr info))))
(error "ERROR: No entity/component or subprogram on current line")))))
@@ -16139,7 +16156,7 @@ expansion function)."
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
- (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize))
+ (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize))
(vhdl-speedbar-initialize)
(when speedbar-frame (vhdl-speedbar-refresh)))
@@ -16167,7 +16184,7 @@ expansion function)."
(read-from-minibuffer "architecture name: "
nil vhdl-minibuffer-local-map)
(vhdl-replace-string vhdl-compose-architecture-name ent-name)))
- ent-file-name arch-file-name ent-buffer arch-buffer project end-pos)
+ ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project
(message "Creating component \"%s(%s)\"..." ent-name arch-name)
;; open entity file
(unless (eq vhdl-compose-create-files 'none)
@@ -16367,7 +16384,7 @@ component instantiation."
(if comp-name
;; ... from component declaration
(vhdl-visit-file
- (when vhdl-use-components-package pack-file-name) t
+ (when vhdl-use-components-package pack-file-name) t
(save-excursion
(goto-char (point-min))
(unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
@@ -16378,7 +16395,7 @@ component instantiation."
(concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
"." (file-name-extension (buffer-file-name))))
(vhdl-visit-file
- comp-ent-file-name t
+ comp-ent-file-name t
(save-excursion
(goto-char (point-min))
(unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
@@ -16651,6 +16668,8 @@ component instantiation."
(vhdl-comment-insert-inline (nth 4 entry) t))
(insert "\n"))
+(defvar lazy-lock-minimum-size)
+
(defun vhdl-compose-components-package ()
"Generate a package containing component declarations for all entities in the
current project/directory."
@@ -16703,10 +16722,10 @@ current project/directory."
;; insert component declarations
(while ent-alist
(vhdl-visit-file (nth 2 (car ent-alist)) nil
- (progn (goto-char (point-min))
- (forward-line (1- (nth 3 (car ent-alist))))
- (end-of-line)
- (vhdl-port-copy)))
+ (goto-char (point-min))
+ (forward-line (1- (nth 3 (car ent-alist))))
+ (end-of-line)
+ (vhdl-port-copy))
(goto-char component-pos)
(vhdl-port-paste-component t)
(when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
@@ -16720,13 +16739,16 @@ current project/directory."
(message "Generating components package \"%s\"...done\n File created: \"%s\""
pack-name pack-file-name)))
-(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
- conf-alist inst-alist
- &optional insert-conf)
+(defun vhdl-compose-configuration-architecture ( _ent-name arch-name
+ ent-alist-arg conf-alist-arg
+ inst-alist
+ &optional insert-conf)
"Generate block configuration for architecture."
- (let ((margin (current-indentation))
+ (let ((ent-alist ent-alist-arg)
+ (conf-alist conf-alist-arg)
+ (margin (current-indentation))
(beg (point-at-bol))
- ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
+ ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key
;; insert block configuration (for architecture)
(vhdl-insert-keyword "FOR ") (insert arch-name "\n")
(setq margin (+ margin vhdl-basic-offset))
@@ -17077,7 +17099,7 @@ do not print any file names."
(file-relative-name (buffer-file-name))))
(when (and (= 0 (nth 1 (nth 10 compiler)))
(= 0 (nth 1 (nth 11 compiler))))
- (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
+ (setq compilation-process-setup-function #'vhdl-compile-print-file-name))
;; run compilation
(if options
(when command
@@ -17151,7 +17173,7 @@ specified by a target."
vhdl-error-regexp-emacs-alist)))
(when vhdl-emacs-22
- (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs))
+ (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Makefile generation
@@ -17430,7 +17452,7 @@ specified by a target."
(setq tmp-list rule-alist)
(while tmp-list ; pre-sort rule targets
(setq cell (cdar tmp-list))
- (setcar cell (sort (car cell) 'string<))
+ (setcar cell (sort (car cell) #'string<))
(setq tmp-list (cdr tmp-list)))
(setq rule-alist ; sort by first rule target
(sort rule-alist
@@ -17520,9 +17542,9 @@ specified by a target."
;; insert rule for each library unit
(insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
(while prim-list
- (setq second-list (sort (nth 1 (car prim-list)) 'string<))
+ (setq second-list (sort (nth 1 (car prim-list)) #'string<))
(setq subcomp-list
- (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
+ (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<))
(setq unit-key (caar prim-list)
unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
(nth 0 (vhdl-aget conf-alist unit-key))
@@ -17552,7 +17574,7 @@ specified by a target."
(vhdl-get-compile-options project compiler (nth 0 rule) t))
;; insert rule if file is supposed to be compiled
(setq target-list (nth 1 rule)
- depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
+ depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<))
;; insert targets
(setq tmp-list target-list)
(while target-list
@@ -17575,7 +17597,8 @@ specified by a target."
(if (eq options 'default) "$(OPTIONS)" options) " "
(nth 0 rule)
(if (equal vhdl-compile-post-command "") ""
- " $(POST-COMPILE)") "\n")
+ " $(POST-COMPILE)")
+ "\n")
(insert "\n"))
(unless (and options mapping-exist)
(setq tmp-list target-list)
@@ -17615,6 +17638,7 @@ specified by a target."
"Submit via mail a bug report on VHDL Mode."
(interactive)
;; load in reporter
+ (defvar reporter-prompt-for-summary-p)
(and
(y-or-n-p "Do you want to submit a report on VHDL Mode? ")
(let ((reporter-prompt-for-summary-p t))
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 3303257c98c..eb170baa5d8 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -1,7 +1,6 @@
;;; which-func.el --- print current function in mode line -*- lexical-binding:t -*-
-;; Copyright (C) 1994, 1997-1998, 2001-2021 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1994-2021 Free Software Foundation, Inc.
;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
;; (doesn't seem to be responsive any more)
@@ -25,17 +24,17 @@
;;; Commentary:
;; This package prints name of function where your current point is
-;; located in mode line. It assumes that you work with imenu package
-;; and imenu--index-alist is up to date.
+;; located in mode line. It assumes that you work with the imenu
+;; package and `imenu--index-alist' is up to date.
;; KNOWN BUGS
;; ----------
;; Really this package shows not "function where the current point is
;; located now", but "nearest function which defined above the current
-;; point". So if your current point is located after end of function
-;; FOO but before begin of function BAR, FOO will be displayed in mode
-;; line.
-;; - if two windows display the same buffer, both windows
+;; point". So if your current point is located after the end of
+;; function FOO but before the beginning of function BAR, FOO will be
+;; displayed in the mode line.
+;; - If two windows display the same buffer, both windows
;; show the same `which-func' information.
;; TODO LIST
@@ -44,7 +43,7 @@
;; function determination mechanism should be used to determine the end
;; of a function as well as the beginning of a function.
;; 2. This package should be realized with the help of overlay
-;; properties instead of imenu--index-alist variable.
+;; properties instead of the `imenu--index-alist' variable.
;;; History:
@@ -176,7 +175,7 @@ and you want to simplify them for the mode line
(defvar which-func-table (make-hash-table :test 'eq :weakness 'key))
(defconst which-func-current
- '(:eval (replace-regexp-in-string
+ '(:eval (string-replace
"%" "%%"
(or (gethash (selected-window) which-func-table)
which-func-unknown))))
@@ -214,7 +213,7 @@ It creates the Imenu index for the buffer, if necessary."
(setq which-func-mode nil))))
(defun which-func-update ()
- ;; "Update the Which-Function mode display for all windows."
+ "Update the Which-Function mode display for all windows."
;; (walk-windows 'which-func-update-1 nil 'visible))
(let ((non-essential t))
(which-func-update-1 (selected-window))))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 18fdd963fb1..d3780d571fc 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
-;; Version: 1.0.4
+;; Version: 1.1.0
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -24,11 +24,6 @@
;;; Commentary:
-;; NOTE: The xref API is still experimental and can change in major,
-;; backward-incompatible ways. Everyone is encouraged to try it, and
-;; report to us any problems or use cases we hadn't anticipated, by
-;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
-;;
;; This file provides a somewhat generic infrastructure for cross
;; referencing commands, in particular "find-definition".
;;
@@ -97,17 +92,13 @@ This is typically the filename.")
"Return the line number corresponding to the location."
nil)
-(cl-defgeneric xref-location-column (_location)
- "Return the exact column corresponding to the location."
- nil)
-
(cl-defgeneric xref-match-length (_item)
"Return the length of the match."
nil)
;;;; Commonly needed location classes are defined here:
-(defcustom xref-file-name-display 'abs
+(defcustom xref-file-name-display 'project-relative
"Style of file name display in *xref* buffers.
If the value is the symbol `abs', the default, show the file names
@@ -130,7 +121,7 @@ in its full absolute form."
(defclass xref-file-location (xref-location)
((file :type string :initarg :file)
(line :type fixnum :initarg :line :reader xref-location-line)
- (column :type fixnum :initarg :column :reader xref-location-column))
+ (column :type fixnum :initarg :column :reader xref-file-location-column))
:documentation "A file location is a file/line/column triple.
Line numbers start from 1 and columns from 0.")
@@ -415,6 +406,12 @@ elements is negated: these commands will NOT prompt."
"Functions called after returning to a pre-jump location."
:type 'hook)
+(defcustom xref-after-update-hook nil
+ "Functions called after the xref buffer is updated."
+ :type 'hook
+ :version "28.1"
+ :package-version '(xref . "1.0.4"))
+
(defvar xref--marker-ring (make-ring xref-marker-ring-length)
"Ring of markers to implement the marker stack.")
@@ -519,7 +516,7 @@ If SELECT is non-nil, select the target window."
"Face for displaying line numbers in the xref buffer."
:version "27.1")
-(defface xref-match '((t :inherit highlight))
+(defface xref-match '((t :inherit match))
"Face used to highlight matches in the xref buffer."
:version "27.1")
@@ -607,16 +604,26 @@ SELECT is `quit', also quit the *xref* window."
(when xref
(xref--show-location (xref-item-location xref)))))
+(defun xref-next-line-no-show ()
+ "Move to the next xref but don't display its source."
+ (interactive)
+ (xref--search-property 'xref-item))
+
(defun xref-next-line ()
"Move to the next xref and display its source in the appropriate window."
(interactive)
- (xref--search-property 'xref-item)
+ (xref-next-line-no-show)
(xref-show-location-at-point))
+(defun xref-prev-line-no-show ()
+ "Move to the previous xref but don't display its source."
+ (interactive)
+ (xref--search-property 'xref-item t))
+
(defun xref-prev-line ()
"Move to the previous xref and display its source in the appropriate window."
(interactive)
- (xref--search-property 'xref-item t)
+ (xref-prev-line-no-show)
(xref-show-location-at-point))
(defun xref-next-group ()
@@ -645,12 +652,12 @@ SELECT is `quit', also quit the *xref* window."
(defun xref-goto-xref (&optional quit)
"Jump to the xref on the current line and select its window.
-Non-interactively, non-nil QUIT, or interactively, with prefix argument
-means to first quit the *xref* buffer."
+If QUIT is non-nil (interactively, with prefix argument), also
+quit the *xref* buffer."
(interactive "P")
(let* ((buffer (current-buffer))
(xref (or (xref--item-at-point)
- (user-error "No reference at point")))
+ (user-error "Choose a reference to visit")))
(xref--current-item xref))
(xref--show-location (xref-item-location xref) (if quit 'quit t))
(if (fboundp 'next-error-found)
@@ -713,10 +720,7 @@ references displayed in the current *xref* buffer."
(push pair all-pairs)
;; Perform sanity check first.
(xref--goto-location loc)
- (if (xref--outdated-p item
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))
+ (if (xref--outdated-p item)
(message "Search result out of date, skipping")
(cond
((null file-buf)
@@ -733,18 +737,38 @@ references displayed in the current *xref* buffer."
(move-marker (car pair) nil)
(move-marker (cdr pair) nil)))))))
-(defun xref--outdated-p (item line-text)
- ;; FIXME: The check should probably be a generic function instead of
- ;; the assumption that all matches contain the full line as summary.
- (let ((summary (xref-item-summary item))
- (strip (lambda (s) (if (string-match "\r\\'" s)
- (substring-no-properties s 0 -1)
- s))))
+(defun xref--outdated-p (item)
+ "Check that the match location at current position is up-to-date.
+ITEMS is an xref item which "
+ ;; FIXME: The check should most likely be a generic function instead
+ ;; of the assumption that all matches' summaries relate to the
+ ;; buffer text in a particular way.
+ (let* ((summary (xref-item-summary item))
+ ;; Sometimes buffer contents include ^M, and sometimes Grep
+ ;; output includes it, and they don't always match.
+ (strip (lambda (s) (if (string-match "\r\\'" s)
+ (substring-no-properties s 0 -1)
+ s)))
+ (stripped-summary (funcall strip summary))
+ (lendpos (line-end-position))
+ (check (lambda ()
+ (let ((comparison-end
+ (+ (point) (length stripped-summary))))
+ (and (>= lendpos comparison-end)
+ (equal stripped-summary
+ (buffer-substring-no-properties
+ (point) comparison-end)))))))
(not
- ;; Sometimes buffer contents include ^M, and sometimes Grep
- ;; output includes it, and they don't always match.
- (equal (funcall strip line-text)
- (funcall strip summary)))))
+ (or
+ ;; Either summary contains match text and after
+ ;; (2nd+ match on the line)...
+ (funcall check)
+ ;; ...or it starts at bol, includes the match and after.
+ (and (< (point) (+ (line-beginning-position)
+ (length stripped-summary)))
+ (save-excursion
+ (forward-line 0)
+ (funcall check)))))))
;; FIXME: Write a nicer UI.
(defun xref--query-replace-1 (from to iter)
@@ -872,6 +896,44 @@ beginning of the line."
(xref--search-property 'xref-item))
(xref-show-location-at-point))
+(defcustom xref-truncation-width 400
+ "The column to visually \"truncate\" each Xref buffer line to."
+ :type '(choice
+ (integer :tag "Number of columns")
+ (const :tag "Disable truncation" nil)))
+
+(defun xref--apply-truncation ()
+ (let ((bol (line-beginning-position))
+ (eol (line-end-position))
+ (inhibit-read-only t)
+ pos adjusted-bol)
+ (when (and xref-truncation-width
+ (> (- eol bol) xref-truncation-width)
+ ;; Either truncation not applied yet, or it hides the current
+ ;; position: need to refresh.
+ (or (and (null (get-text-property (1- eol) 'invisible))
+ (null (get-text-property bol 'invisible)))
+ (get-text-property (point) 'invisible)))
+ (setq adjusted-bol
+ (cond
+ ((eq (get-text-property bol 'face) 'xref-line-number)
+ (next-single-char-property-change bol 'face))
+ (t bol)))
+ (cond
+ ((< (- (point) bol) xref-truncation-width)
+ (setq pos (+ bol xref-truncation-width))
+ (remove-text-properties bol pos '(invisible))
+ (put-text-property pos eol 'invisible 'ellipsis))
+ ((< (- eol (point)) xref-truncation-width)
+ (setq pos (- eol xref-truncation-width))
+ (remove-text-properties pos eol '(invisible))
+ (put-text-property adjusted-bol pos 'invisible 'ellipsis))
+ (t
+ (setq pos (- (point) (/ xref-truncation-width 2)))
+ (put-text-property adjusted-bol pos 'invisible 'ellipsis)
+ (remove-text-properties pos (+ pos xref-truncation-width) '(invisible))
+ (put-text-property (+ pos xref-truncation-width) eol 'invisible 'ellipsis))))))
+
(defun xref--insert-xrefs (xref-alist)
"Insert XREF-ALIST in the current-buffer.
XREF-ALIST is of the form ((GROUP . (XREF ...)) ...), where
@@ -886,30 +948,27 @@ GROUP is a string for decoration purposes and XREF is an
(length (and line (format "%d" line)))))
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
- with prev-line-key = nil
+ with prev-group = nil
+ with prev-line = nil
do
(xref--insert-propertized '(face xref-file-header xref-group t)
group "\n")
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
- (new-summary summary)
- (line-key (list (xref-location-group location) line))
(prefix
- (if line
- (propertize (format line-format line)
- 'face 'xref-line-number)
- " ")))
+ (cond
+ ((not line) " ")
+ ((and (equal line prev-line)
+ (equal prev-group group))
+ "")
+ (t (propertize (format line-format line)
+ 'face 'xref-line-number)))))
;; Render multiple matches on the same line, together.
- (when (and line (equal prev-line-key line-key))
- (when-let ((column (xref-location-column location)))
- (delete-region
- (save-excursion
- (forward-line -1)
- (move-to-column (+ (length prefix) column))
- (point))
- (point))
- (setq new-summary (substring summary column) prefix "")))
+ (when (and (equal prev-group group)
+ (or (null line)
+ (not (equal prev-line line))))
+ (insert "\n"))
(xref--insert-propertized
(list 'xref-item xref
'mouse-face 'highlight
@@ -917,9 +976,16 @@ GROUP is a string for decoration purposes and XREF is an
'help-echo
(concat "mouse-2: display in another window, "
"RET or mouse-1: follow reference"))
- prefix new-summary)
- (setq prev-line-key line-key)))
- (insert "\n"))))
+ prefix summary)
+ (setq prev-line line
+ prev-group group))))
+ (insert "\n"))
+ (add-to-invisibility-spec '(ellipsis . t))
+ (save-excursion
+ (goto-char (point-min))
+ (while (= 0 (forward-line 1))
+ (xref--apply-truncation)))
+ (run-hooks 'xref-after-update-hook))
(defun xref--analyze (xrefs)
"Find common filenames in XREFS.
@@ -956,6 +1022,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(buffer-undo-list t))
(erase-buffer)
(xref--insert-xrefs xref-alist)
+ (add-hook 'post-command-hook 'xref--apply-truncation nil t)
(goto-char (point-min))
(setq xref--original-window (assoc-default 'window alist)
xref--original-window-intent (assoc-default 'display-action alist))
@@ -1024,6 +1091,12 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'."
(define-obsolete-function-alias 'xref--show-defs-buffer-at-bottom
#'xref-show-definitions-buffer-at-bottom "28.1")
+(defun xref--completing-read-group (cand transform)
+ "Return group title of candidate CAND or TRANSFORM the candidate."
+ (if transform
+ (substring cand (1+ (next-single-property-change 0 'xref--group cand)))
+ (get-text-property 0 'xref--group cand)))
+
(defun xref-show-definitions-completing-read (fetcher alist)
"Let the user choose the target definition with completion.
@@ -1052,10 +1125,12 @@ between them by typing in the minibuffer with completion."
(format #("%d:" 0 2 (face xref-line-number))
line)
""))
+ (group-prefix
+ (substring group group-prefix-length))
(group-fmt
- (propertize
- (substring group group-prefix-length)
- 'face 'xref-file-header))
+ (propertize group-prefix
+ 'face 'xref-file-header
+ 'xref--group group-prefix))
(candidate
(format "%s:%s%s" group-fmt line-fmt summary)))
(push (cons candidate xref) xref-alist-with-line-info)))))
@@ -1067,7 +1142,9 @@ between them by typing in the minibuffer with completion."
(lambda (string pred action)
(cond
((eq action 'metadata)
- '(metadata . ((category . xref-location))))
+ `(metadata
+ . ((category . xref-location)
+ (group-function . ,#'xref--completing-read-group))))
(t
(complete-with-action action collection string pred)))))
(def (caar collection)))
@@ -1279,7 +1356,9 @@ This command is intended to be bound to a mouse event."
The argument has the same meaning as in `apropos'."
(interactive (list (read-string
"Search for pattern (word list or regexp): "
- nil 'xref--read-pattern-history)))
+ nil 'xref--read-pattern-history
+ (xref-backend-identifier-at-point
+ (xref-find-backend)))))
(require 'apropos)
(let* ((newpat
(if (and (version< emacs-version "28.0.50")
@@ -1390,8 +1469,9 @@ IGNORES is a list of glob patterns for files to ignore."
;; do that reliably enough, without creating false negatives?
(command (xref--rgrep-command (xref--regexp-to-extended regexp)
files
- (file-name-as-directory
- (file-local-name (expand-file-name dir)))
+ (directory-file-name
+ (file-name-unquote
+ (file-local-name (expand-file-name dir))))
ignores))
(def default-directory)
(buf (get-buffer-create " *xref-grep*"))
@@ -1508,6 +1588,8 @@ FILES must be a list of absolute file names."
#'tramp-file-local-name
#'file-local-name)
files)))
+ (when (file-name-quoted-p (car files))
+ (setq files (mapcar #'file-name-unquote files)))
(with-current-buffer output
(erase-buffer)
(with-temp-buffer
@@ -1647,12 +1729,14 @@ Such as the current syntax table and the applied syntax properties."
(if buf
(with-current-buffer buf
(save-excursion
- (goto-char (point-min))
- (forward-line (1- line))
- (xref--collect-matches-1 regexp file line
- (line-beginning-position)
- (line-end-position)
- syntax-needed)))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (xref--collect-matches-1 regexp file line
+ (line-beginning-position)
+ (line-end-position)
+ syntax-needed))))
;; Using the temporary buffer is both a performance and a buffer
;; management optimization.
(with-current-buffer tmp-buffer
@@ -1678,20 +1762,30 @@ Such as the current syntax table and the applied syntax properties."
syntax-needed)))))
(defun xref--collect-matches-1 (regexp file line line-beg line-end syntax-needed)
- (let (matches)
+ (let (match-pairs matches)
(when syntax-needed
(syntax-propertize line-end))
- ;; FIXME: This results in several lines with the same
- ;; summary. Solve with composite pattern?
(while (and
;; REGEXP might match an empty string. Or line.
- (or (null matches)
+ (or (null match-pairs)
(> (point) line-beg))
(re-search-forward regexp line-end t))
- (let* ((beg-column (- (match-beginning 0) line-beg))
- (end-column (- (match-end 0) line-beg))
+ (push (cons (match-beginning 0)
+ (match-end 0))
+ match-pairs))
+ (setq match-pairs (nreverse match-pairs))
+ (while match-pairs
+ (let* ((beg-end (pop match-pairs))
+ (beg-column (- (car beg-end) line-beg))
+ (end-column (- (cdr beg-end) line-beg))
(loc (xref-make-file-location file line beg-column))
- (summary (buffer-substring line-beg line-end)))
+ (summary (buffer-substring (if matches (car beg-end) line-beg)
+ (if match-pairs
+ (caar match-pairs)
+ line-end))))
+ (when matches
+ (cl-decf beg-column (- (car beg-end) line-beg))
+ (cl-decf end-column (- (car beg-end) line-beg)))
(add-face-text-property beg-column end-column 'xref-match
t summary)
(push (xref-make-match summary loc (- end-column beg-column))
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index e85e3cfdbbd..70763319840 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -104,20 +104,17 @@ reading-string reading prompt string")
(defcustom scheme-band-name nil
"Band loaded by the `run-scheme' command."
- :type '(choice (const nil) string)
- :group 'xscheme)
+ :type '(choice (const nil) string))
(defcustom scheme-program-arguments nil
"Arguments passed to the Scheme program by the `run-scheme' command."
- :type '(choice (const nil) string)
- :group 'xscheme)
+ :type '(choice (const nil) string))
(defcustom xscheme-allow-pipelined-evaluation t
"If non-nil, an expression may be transmitted while another is evaluating.
Otherwise, attempting to evaluate an expression before the previous expression
has finished evaluating will signal an error."
- :type 'boolean
- :group 'xscheme)
+ :type 'boolean)
(defcustom xscheme-startup-message
"This is the Scheme process buffer.
@@ -128,19 +125,16 @@ Type \\[describe-mode] for more information.
"
"String to insert into Scheme process buffer first time it is started.
Is processed with `substitute-command-keys' first."
- :type 'string
- :group 'xscheme)
+ :type 'string)
(defcustom xscheme-signal-death-message nil
"If non-nil, causes a message to be generated when the Scheme process dies."
- :type 'boolean
- :group 'xscheme)
+ :type 'boolean)
(defcustom xscheme-start-hook nil
"If non-nil, a procedure to call when the Scheme process is started.
When called, the current buffer will be the Scheme process-buffer."
:type 'hook
- :group 'xscheme
:version "20.3")
(defun xscheme-evaluation-commands (keymap)
@@ -942,7 +936,7 @@ the remaining input.")
(setq call-noexcursion nil)
(with-current-buffer (process-buffer proc)
(cond ((eq xscheme-process-filter-state 'idle)
- (let ((start (string-match "\e" xscheme-filter-input)))
+ (let ((start (string-search "\e" xscheme-filter-input)))
(if start
(progn
(xscheme-process-filter-output
@@ -966,7 +960,7 @@ the remaining input.")
(xscheme-process-filter-output ?\e char)
(setq xscheme-process-filter-state 'idle)))))))
((eq xscheme-process-filter-state 'reading-string)
- (let ((start (string-match "\e" xscheme-filter-input)))
+ (let ((start (string-search "\e" xscheme-filter-input)))
(if start
(let ((string
(concat xscheme-string-accumulator
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 7bf2f71822a..72cbcf8bd68 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -1,4 +1,4 @@
-;;; ps-bdf.el --- BDF font file handler for ps-print
+;;; ps-bdf.el --- BDF font file handler for ps-print -*- lexical-binding: t; -*-
;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc.
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
@@ -138,7 +138,7 @@ See the documentation of the function `bdf-read-font-info' for more detail."
(defun bdf-initialize ()
"Initialize `bdf' library."
(and (bdf-read-cache)
- (add-hook 'kill-emacs-hook 'bdf-write-cache)))
+ (add-hook 'kill-emacs-hook #'bdf-write-cache)))
(defun bdf-compact-code (code code-range)
(if (or (< code (aref code-range 4))
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index db86f9400e7..ab8af40628a 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,4 +1,4 @@
-;;; ps-mule.el --- provide multi-byte character facility to ps-print
+;;; ps-mule.el --- provide multi-byte character facility to ps-print -*- lexical-binding: t; -*-
;; Copyright (C) 1998-2021 Free Software Foundation, Inc.
@@ -612,7 +612,7 @@ f2, f3, h0, h1, and H0 respectively."
(push (/ code 256) code-list)
(push (% code 256) code-list))))
(forward-char 1)))
- (apply 'unibyte-string (nreverse code-list))))
+ (apply #'unibyte-string (nreverse code-list))))
(defun ps-mule-plot-composition (composition font-spec-table)
"Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE."
@@ -673,7 +673,7 @@ the sequence."
(not (vectorp (aref (nth 2 composition) 0))))
(car composition)
to))
- (ascii-or-latin-1 "[\000-\377]+")
+ (ascii-or-latin-1 "[\000-ÿ]+")
(run-width 0)
(endpos nil)
(font-spec-table (aref ps-mule-font-spec-tables
@@ -699,6 +699,7 @@ the sequence."
(setq composition (find-composition (point) to nil t))
(setq stop (if composition (car composition) to)))))
+ ;; We fold lines that contain ASCII or Latin-1.
((looking-at ascii-or-latin-1)
(let ((nchars (- (min (match-end 0) stop) (point))))
(setq width (* average-width nchars))
@@ -710,6 +711,7 @@ the sequence."
(setq run-width (+ run-width width))
(forward-char nchars))))
+ ;; Don't fold other lines. (But why?)
(t
(while (and (< (point) stop) (not endpos))
(setq width (char-width (following-char)))
@@ -1041,10 +1043,11 @@ Any other value is treated as \"/H0\"."
(list (ps-mule-encode-region (point-min) (point-max)
(aref ps-mule-font-spec-tables
(aref ps-mule-font-number-to-type
- (cond ((string= fonttag "/h0") 4)
- ((string= fonttag "/h1") 5)
- ((string= fonttag "/L0") 6)
- (t 0))))))))
+ (pcase fonttag
+ ("/h0" 4)
+ ("/h1" 5)
+ ("/L0" 6)
+ (_ 0))))))))
;;;###autoload
(defun ps-mule-begin-job (from to)
@@ -1055,20 +1058,17 @@ It checks if all multi-byte characters in the region are printable or not."
(goto-char from)
(= (skip-chars-forward "\x00-\x7F" to) to)))
;; All characters can be printed by normal PostScript fonts.
- (setq ps-basic-plot-string-function 'ps-basic-plot-string
+ (setq ps-basic-plot-string-function #'ps-basic-plot-string
;; FIXME: Doesn't ps-encode-header-string-function take 2 args?
- ps-encode-header-string-function 'identity)
- (setq ps-basic-plot-string-function 'ps-mule-plot-string
- ps-encode-header-string-function 'ps-mule-encode-header-string
+ ps-encode-header-string-function #'identity)
+ (setq ps-basic-plot-string-function #'ps-mule-plot-string
+ ps-encode-header-string-function #'ps-mule-encode-header-string
ps-mule-font-info-database
- (cond ((eq ps-multibyte-buffer 'non-latin-printer)
- ps-mule-font-info-database-ps)
- ((eq ps-multibyte-buffer 'bdf-font)
- ps-mule-font-info-database-bdf)
- ((eq ps-multibyte-buffer 'bdf-font-except-latin)
- ps-mule-font-info-database-ps-bdf)
- (t
- ps-mule-font-info-database-default)))
+ (pcase ps-multibyte-buffer
+ ('non-latin-printer ps-mule-font-info-database-ps)
+ ('bdf-font ps-mule-font-info-database-bdf)
+ ('bdf-font-except-latin ps-mule-font-info-database-ps-bdf)
+ (_ ps-mule-font-info-database-default)))
;; Be sure to have font information for Latin-1.
(or (assq 'iso-8859-1 ps-mule-font-info-database)
@@ -1112,10 +1112,12 @@ It checks if all multi-byte characters in the region are printable or not."
id-max (1+ id-max))
(if (ps-mule-check-font font-spec)
(aset font-spec-vec
- (cond ((eq (car e) 'normal) 0)
- ((eq (car e) 'bold) 1)
- ((eq (car e) 'italic) 2)
- (t 3)) font-spec)))
+ (pcase (car e)
+ ('normal 0)
+ ('bold 1)
+ ('italic 2)
+ (_ 3))
+ font-spec)))
(when (aref font-spec-vec 0)
(or (aref font-spec-vec 3)
(aset font-spec-vec 3 (or (aref font-spec-vec 1)
@@ -1182,7 +1184,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
(let ((output-head (list t))
(ps-mule-output-list (list t)))
(dotimes (i 4)
- (map-char-table 'ps-mule-prepare-glyph
+ (map-char-table #'ps-mule-prepare-glyph
(aref ps-mule-font-spec-tables i)))
(ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
(ps-output-prologue (cdr output-head)))
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index fcc6e1fd834..1b8654ead2b 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -6506,10 +6506,11 @@ If FACE is not a valid face name, use default face."
(and (buffer-live-p ps-buffer)
(buffer-modified-p ps-buffer)
(not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
- (error "Unprinted PostScript"))))
+ (error "Unprinted PostScript")))
+ t)
(unless noninteractive
- (add-hook 'kill-emacs-hook #'ps-kill-emacs-check))
+ (add-hook 'kill-emacs-query-functions #'ps-kill-emacs-check))
(provide 'ps-print)
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index fdff0f182db..22a29b8b4b1 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -1,4 +1,4 @@
-;;; ps-samp.el --- ps-print sample setup code
+;;; ps-samp.el --- ps-print sample setup code -*- lexical-binding: t -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/recentf.el b/lisp/recentf.el
index d39a523289f..9ae059a70dd 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1,4 +1,4 @@
-;;; recentf.el --- setup a menu of recently opened files
+;;; recentf.el --- setup a menu of recently opened files -*- lexical-binding: t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
@@ -24,20 +24,21 @@
;;; Commentary:
;; This package maintains a menu for visiting files that were operated
-;; on recently. When enabled a new "Open Recent" sub menu is
+;; on recently. When enabled a new "Open Recent" submenu is
;; displayed in the "File" menu. The recent files list is
-;; automatically saved across Emacs sessions. You can customize the
-;; number of recent files displayed, the location of the menu and
-;; others options (see the source code for details).
+;; automatically saved across Emacs sessions.
-;; To enable this package, add the following to your .emacs:
-;; (recentf-mode 1)
+;; You can customize the number of recent files displayed, the
+;; location of the menu and others options. Type:
+;;
+;; M-x customize-group RET recentf RET
-;;; History:
+;; To enable this package, add this line to your Init file:
;;
+;; (recentf-mode 1)
;;; Code:
-(require 'easymenu)
+
(require 'tree-widget)
(require 'timer)
@@ -77,7 +78,7 @@ See the command `recentf-save-list'."
:type 'file
:initialize 'custom-initialize-default
:set (lambda (symbol value)
- (let ((oldvalue (eval symbol)))
+ (let ((oldvalue (symbol-value symbol)))
(custom-set-default symbol value)
(and (not (equal value oldvalue))
recentf-mode
@@ -296,7 +297,7 @@ They are successively passed a file name to transform it."
(function :tag "Other function")))))
(defcustom recentf-show-file-shortcuts-flag t
- "Whether to show \"[N]\" for the Nth item up to 10.
+ "Non-nil means to show \"[N]\" for the Nth item up to 10.
If non-nil, `recentf-open-files' will show labels for keys that can be
used as shortcuts to open the Nth file."
:group 'recentf
@@ -331,15 +332,6 @@ Ignore case if `recentf-case-fold-search' is non-nil."
(setq list (cdr list)))
list)
-(defsubst recentf-trunc-list (l n)
- "Return from L the list of its first N elements."
- (let (nl)
- (while (and l (> n 0))
- (setq nl (cons (car l) nl)
- n (1- n)
- l (cdr l)))
- (nreverse nl)))
-
(defun recentf-dump-variable (variable &optional limit)
"Insert a \"(setq VARIABLE value)\" in the current buffer.
When the value of VARIABLE is a list, optional argument LIMIT
@@ -349,7 +341,7 @@ the full list."
(if (atom value)
(insert (format "\n(setq %S '%S)\n" variable value))
(when (and (integerp limit) (> limit 0))
- (setq value (recentf-trunc-list value limit)))
+ (setq value (seq-take value limit)))
(insert (format "\n(setq %S\n '(" variable))
(dolist (e value)
(insert (format "\n %S" e)))
@@ -520,7 +512,7 @@ filter function this variable is reset to nil.")
(defsubst recentf-elements (n)
"Return a list of the first N elements of the recent list."
- (recentf-trunc-list recentf-list n))
+ (seq-take recentf-list n))
(defsubst recentf-make-menu-element (menu-item menu-value)
"Create a new menu-element.
@@ -560,7 +552,7 @@ This a menu element (FILE . FILE)."
(defsubst recentf-menu-elements (n)
"Return a list of the first N default menu elements from the recent list.
See also `recentf-make-default-menu-element'."
- (mapcar 'recentf-make-default-menu-element
+ (mapcar #'recentf-make-default-menu-element
(recentf-elements n)))
(defun recentf-apply-menu-filter (filter l)
@@ -601,7 +593,7 @@ This is a menu filter function which ignores the MENU argument."
(let* ((recentf-menu-shortcuts 0)
(file-items
(condition-case err
- (mapcar 'recentf-make-menu-item
+ (mapcar #'recentf-make-menu-item
(recentf-apply-menu-filter
recentf-menu-filter
(recentf-menu-elements recentf-max-menu-items)))
@@ -643,7 +635,7 @@ Return nil if file NAME is not one of the ten more recent."
(let ((item (recentf-menu-element-item elt))
(value (recentf-menu-element-value elt)))
(if (recentf-sub-menu-element-p elt)
- (cons item (mapcar 'recentf-make-menu-item value))
+ (cons item (mapcar #'recentf-make-menu-item value))
(let ((k (and (< recentf-menu-shortcuts 10)
(recentf-menu-value-shortcut value))))
(vector item
@@ -768,12 +760,12 @@ This filter combines the `recentf-sort-basenames-descending' and
(defun recentf-relative-filter (l)
"Filter the list of menu-elements L to show relative filenames.
Filenames are relative to the `default-directory'."
- (mapcar #'(lambda (menu-element)
- (let* ((ful (recentf-menu-element-value menu-element))
- (rel (file-relative-name ful default-directory)))
- (if (string-match "^\\.\\." rel)
- menu-element
- (recentf-make-menu-element rel ful))))
+ (mapcar (lambda (menu-element)
+ (let* ((ful (recentf-menu-element-value menu-element))
+ (rel (file-relative-name ful default-directory)))
+ (if (string-match "^\\.\\." rel)
+ menu-element
+ (recentf-make-menu-element rel ful))))
l))
;;; Rule based menu filters
@@ -945,10 +937,10 @@ Rules obey `recentf-arrange-rules' format."
This simplified version of `recentf-show-basenames' does not handle
duplicates. It is used by `recentf-arrange-by-dir' as its
`recentf-arrange-by-rule-subfilter'."
- (mapcar #'(lambda (e)
- (recentf-make-menu-element
- (file-name-nondirectory (recentf-menu-element-value e))
- (recentf-menu-element-value e)))
+ (mapcar (lambda (e)
+ (recentf-make-menu-element
+ (file-name-nondirectory (recentf-menu-element-value e))
+ (recentf-menu-element-value e)))
l))
(defun recentf-dir-rule (file)
@@ -1001,15 +993,15 @@ Filtering of L is delegated to the selected filter in the menu."
(list
`("Show files"
,@(mapcar
- #'(lambda (f)
- `[,(cdr f)
- (setq recentf-filter-changer-current ',(car f))
- ;;:active t
- :style radio ;;radio Don't work with GTK :-(
- :selected (eq recentf-filter-changer-current
- ',(car f))
- ;;:help ,(cdr f)
- ])
+ (lambda (f)
+ `[,(cdr f)
+ (setq recentf-filter-changer-current ',(car f))
+ ;;:active t
+ :style radio ;;radio Don't work with GTK :-(
+ :selected (eq recentf-filter-changer-current
+ ',(car f))
+ ;;:help ,(cdr f)
+ ])
recentf-filter-changer-alist))))
(recentf-apply-menu-filter recentf-filter-changer-current l)))
@@ -1066,9 +1058,9 @@ Go to the beginning of buffer if not found."
(defvar recentf-dialog-mode-map
(let ((km (copy-keymap recentf--shortcuts-keymap)))
(set-keymap-parent km widget-keymap)
- (define-key km "q" 'recentf-cancel-dialog)
- (define-key km "n" 'next-line)
- (define-key km "p" 'previous-line)
+ (define-key km "q" #'recentf-cancel-dialog)
+ (define-key km "n" #'next-line)
+ (define-key km "p" #'previous-line)
km)
"Keymap used in recentf dialogs.")
@@ -1087,8 +1079,8 @@ Go to the beginning of buffer if not found."
;; Cleanup buffer
(let ((inhibit-read-only t)
(ol (overlay-lists)))
- (mapc 'delete-overlay (car ol))
- (mapc 'delete-overlay (cdr ol))
+ (mapc #'delete-overlay (car ol))
+ (mapc #'delete-overlay (cdr ol))
(erase-buffer))
(recentf-dialog-mode)
,@forms
@@ -1182,7 +1174,7 @@ IGNORE other arguments."
:node (item :tag ,(car menu-element)
:sample-face bold
:format "%{%t%}:\n")
- ,@(mapcar 'recentf-open-files-item
+ ,@(mapcar #'recentf-open-files-item
(cdr menu-element)))
;; Represent a single file with a link widget
`(link :tag ,(car menu-element)
@@ -1197,8 +1189,8 @@ IGNORE other arguments."
(defun recentf-open-files-items (files)
"Return a list of widgets to display FILES in a dialog buffer."
(setq-local recentf--files-with-key
- (recentf-trunc-list files 10))
- (mapcar 'recentf-open-files-item
+ (seq-take files 10))
+ (mapcar #'recentf-open-files-item
(append
;; When requested group the files with shortcuts together
;; at the top of the list.
@@ -1206,12 +1198,12 @@ IGNORE other arguments."
(setq files (nthcdr 10 files))
(recentf-apply-menu-filter
'recentf-show-digit-shortcut-filter
- (mapcar 'recentf-make-default-menu-element
+ (mapcar #'recentf-make-default-menu-element
recentf--files-with-key)))
;; Then the other files.
(recentf-apply-menu-filter
recentf-menu-filter
- (mapcar 'recentf-make-default-menu-element
+ (mapcar #'recentf-make-default-menu-element
files)))))
(defun recentf-open-files (&optional files buffer-name)
@@ -1232,7 +1224,7 @@ use for the dialog. It defaults to \"*`recentf-menu-title'*\"."
(format-message "Click on Cancel or type `q' to cancel.\n"))
;; Use a L&F that looks like the recentf menu.
(tree-widget-set-theme "folder")
- (apply 'widget-create
+ (apply #'widget-create
`(group
:indent 2
:format "\n%v\n"
@@ -1314,7 +1306,7 @@ empty `file-name-history' with the recent list."
(load-file file)
(and recentf-initialize-file-name-history
(not file-name-history)
- (setq file-name-history (mapcar 'abbreviate-file-name
+ (setq file-name-history (mapcar #'abbreviate-file-name
recentf-list))))))
(defun recentf-cleanup ()
@@ -1381,6 +1373,10 @@ buffers you switch to a lot, you can say something like the following:
;; continue standard unloading
nil)
+;; Obsolete.
+
+(define-obsolete-function-alias 'recentf-trunc-list #'seq-take "28.1")
+
(provide 'recentf)
(run-hooks 'recentf-load-hook)
diff --git a/lisp/rect.el b/lisp/rect.el
index cb941b46009..504be41b673 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -652,7 +652,7 @@ with a prefix argument, prompt for START-AT and FORMAT."
"Toggle the region as rectangular.
Activates the region if needed. Only lasts until the region is deactivated."
- nil nil nil
+ :lighter nil
(rectangle--reset-crutches)
(when rectangle-mark-mode
(add-hook 'deactivate-mark-hook
diff --git a/lisp/registry.el b/lisp/registry.el
index a5c30f20efc..258f7fc9046 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -1,4 +1,4 @@
-;;; registry.el --- Track and remember data items by various fields
+;;; registry.el --- Track and remember data items by various fields -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -128,7 +128,7 @@
:type hash-table
:documentation "The data hash table.")))
-(cl-defmethod initialize-instance :before ((this registry-db) slots)
+(cl-defmethod initialize-instance :before ((_this registry-db) slots)
"Check whether a registry object needs to be upgraded."
;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the
;; :max-soft slot to disappear, and the :max-hard slot to be renamed
@@ -212,7 +212,7 @@ When SET is not nil, set it for VAL (use t for an empty list)."
(:regex
(string-match (car vals)
(mapconcat
- 'prin1-to-string
+ #'prin1-to-string
(cdr-safe (assoc key entry))
"\0"))))
vals (cdr-safe vals)))
@@ -247,7 +247,7 @@ Updates the secondary ('tracked') indices as well.
With assert non-nil, errors out if the key does not exist already."
(let* ((data (oref db data))
(keys (or keys
- (apply 'registry-search db spec)))
+ (apply #'registry-search db spec)))
(tracked (oref db tracked)))
(dolist (key keys)
@@ -308,19 +308,18 @@ Errors out if the key exists already."
(let ((count 0)
(expected (* (length (oref db tracked)) (registry-size db))))
(dolist (tr (oref db tracked))
- (let (values)
- (maphash
- (lambda (key v)
- (cl-incf count)
- (when (and (< 0 expected)
- (= 0 (mod count 1000)))
- (message "reindexing: %d of %d (%.2f%%)"
- count expected (/ (* 100.0 count) expected)))
- (dolist (val (cdr-safe (assq tr v)))
- (let ((value-keys (registry-lookup-secondary-value db tr val)))
- (push key value-keys)
- (registry-lookup-secondary-value db tr val value-keys))))
- (oref db data))))))
+ (maphash
+ (lambda (key v)
+ (cl-incf count)
+ (when (and (< 0 expected)
+ (= 0 (mod count 1000)))
+ (message "reindexing: %d of %d (%.2f%%)"
+ count expected (/ (* 100.0 count) expected)))
+ (dolist (val (cdr-safe (assq tr v)))
+ (let ((value-keys (registry-lookup-secondary-value db tr val)))
+ (push key value-keys)
+ (registry-lookup-secondary-value db tr val value-keys))))
+ (oref db data)))))
(cl-defmethod registry-prune ((db registry-db) &optional sortfunc)
"Prune the registry-db object DB.
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 795577c93fc..cec3cb643a1 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -180,7 +180,7 @@ this function is always whether the value of `this-command' would've been
(= repeat-num-input-keys-at-repeat num-input-keys))
;; An example of the use of (repeat-is-really-this-command) may still be
-;; available in <http://www.eskimo.com/~seldon/dotemacs.el>; search for
+;; available in <https://www.eskimo.com/~seldon/dotemacs.el>; search for
;; "defun wm-switch-buffer".
;;;;; ******************* THE REPEAT COMMAND ITSELF ******************* ;;;;;
@@ -329,6 +329,188 @@ recently executed command not bound to an input event\"."
;;;;; ************************* EMACS CONTROL ************************* ;;;;;
+
+;; And now for something completely different.
+
+;;; repeat-mode
+
+(defcustom repeat-exit-key nil
+ "Key that stops the modal repeating of keys in sequence.
+For example, you can set it to <return> like `isearch-exit'."
+ :type '(choice (const :tag "No special key to exit repeating sequence" nil)
+ (key-sequence :tag "Key that exits repeating sequence"))
+ :group 'convenience
+ :version "28.1")
+
+(defcustom repeat-exit-timeout nil
+ "Break the repetition chain of keys after specified timeout.
+When a number, exit the repeat mode after idle time of the specified
+number of seconds."
+ :type '(choice (const :tag "No timeout to exit repeating sequence" nil)
+ (number :tag "Timeout in seconds to exit repeating"))
+ :group 'convenience
+ :version "28.1")
+
+(defvar repeat-exit-timer nil
+ "Timer activated after the last key typed in the repeating key sequence.")
+
+(defcustom repeat-keep-prefix t
+ "Keep the prefix arg of the previous command."
+ :type 'boolean
+ :group 'convenience
+ :version "28.1")
+
+(defcustom repeat-echo-function #'repeat-echo-message
+ "Function to display a hint about available keys.
+Function is called after every repeatable command with one argument:
+a repeating map, or nil after deactivating the repeat mode."
+ :type '(choice (const :tag "Show hints in the echo area"
+ repeat-echo-message)
+ (const :tag "Show indicator in the mode line"
+ repeat-echo-mode-line)
+ (const :tag "No visual feedback" ignore)
+ (function :tag "Function"))
+ :group 'convenience
+ :version "28.1")
+
+(defvar repeat-in-progress nil
+ "Non-nil when the repeating map is active.")
+
+;;;###autoload
+(defvar repeat-map nil
+ "The value of the repeating map for the next command.
+A command called from the map can set it again to the same map when
+the map can't be set on the command symbol property `repeat-map'.")
+
+;;;###autoload
+(define-minor-mode repeat-mode
+ "Toggle Repeat mode.
+When Repeat mode is enabled, and the command symbol has the property named
+`repeat-map', this map is activated temporarily for the next command."
+ :global t :group 'convenience
+ (if (not repeat-mode)
+ (remove-hook 'post-command-hook 'repeat-post-hook)
+ (add-hook 'post-command-hook 'repeat-post-hook)
+ (let* ((keymaps nil)
+ (commands (all-completions
+ "" obarray (lambda (s)
+ (and (commandp s)
+ (get s 'repeat-map)
+ (push (get s 'repeat-map) keymaps))))))
+ (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'."
+ (length commands)
+ (length (delete-dups keymaps))))))
+
+(defun repeat-post-hook ()
+ "Function run after commands to set transient keymap for repeatable keys."
+ (let ((was-in-progress repeat-in-progress))
+ (setq repeat-in-progress nil)
+ (when repeat-mode
+ (let ((rep-map (or repeat-map
+ (and (symbolp real-this-command)
+ (get real-this-command 'repeat-map)))))
+ (when rep-map
+ (when (boundp rep-map)
+ (setq rep-map (symbol-value rep-map)))
+ (let ((map (copy-keymap rep-map)))
+
+ ;; Exit when the last char is not among repeatable keys,
+ ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
+ (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
+ (or (lookup-key map (this-command-keys-vector))
+ prefix-arg))
+
+ ;; Messaging
+ (unless prefix-arg
+ (funcall repeat-echo-function map))
+
+ ;; Adding an exit key
+ (when repeat-exit-key
+ (define-key map repeat-exit-key 'ignore))
+
+ (when (and repeat-keep-prefix (not prefix-arg))
+ (setq prefix-arg current-prefix-arg))
+
+ (setq repeat-in-progress t)
+ (let ((exitfun (set-transient-map map)))
+
+ (when repeat-exit-timer
+ (cancel-timer repeat-exit-timer)
+ (setq repeat-exit-timer nil))
+
+ (when repeat-exit-timeout
+ (setq repeat-exit-timer
+ (run-with-idle-timer
+ repeat-exit-timeout nil
+ (lambda ()
+ (setq repeat-in-progress nil)
+ (funcall exitfun)
+ (funcall repeat-echo-function nil)))))))))))
+
+ (setq repeat-map nil)
+ (when (and was-in-progress (not repeat-in-progress))
+ (when repeat-exit-timer
+ (cancel-timer repeat-exit-timer)
+ (setq repeat-exit-timer nil))
+ (funcall repeat-echo-function nil))))
+
+(defun repeat-echo-message-string (keymap)
+ "Return a string with a list of repeating keys."
+ (let (keys)
+ (map-keymap (lambda (key _) (push key keys)) keymap)
+ (format-message "Repeat with %s%s"
+ (mapconcat (lambda (key)
+ (key-description (vector key)))
+ keys ", ")
+ (if repeat-exit-key
+ (format ", or exit with %s"
+ (key-description repeat-exit-key))
+ ""))))
+
+(defun repeat-echo-message (keymap)
+ "Display available repeating keys in the echo area."
+ (if keymap
+ (let ((mess (repeat-echo-message-string keymap)))
+ (if (current-message)
+ (message "%s [%s]" (current-message) mess)
+ (message mess)))
+ (when (string-prefix-p "Repeat with " (current-message))
+ (message nil))))
+
+(defvar repeat-echo-mode-line-string
+ (propertize "[Repeating...] " 'face 'mode-line-emphasis)
+ "String displayed in the mode line in repeating mode.")
+
+(defun repeat-echo-mode-line (keymap)
+ "Display the repeat indicator in the mode line."
+ (if keymap
+ (unless (assq 'repeat-in-progress mode-line-modes)
+ (add-to-list 'mode-line-modes (list 'repeat-in-progress
+ repeat-echo-mode-line-string)))
+ (force-mode-line-update t)))
+
+(defun describe-repeat-maps ()
+ "Describe mappings of commands repeatable by symbol property `repeat-map'."
+ (interactive)
+ (help-setup-xref (list #'describe-repeat-maps)
+ (called-interactively-p 'interactive))
+ (let ((keymaps nil))
+ (all-completions
+ "" obarray (lambda (s)
+ (and (commandp s)
+ (get s 'repeat-map)
+ (push s (alist-get (get s 'repeat-map) keymaps)))))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
+
+ (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b)))))
+ (princ (format-message "`%s' keymap is repeatable by these commands:\n"
+ (car keymap)))
+ (dolist (command (sort (cdr keymap) 'string-lessp))
+ (princ (format-message " `%s'\n" command)))
+ (princ "\n"))))))
+
(provide 'repeat)
;;; repeat.el ends here
diff --git a/lisp/replace.el b/lisp/replace.el
index eb7a439b54a..69bdfe1331d 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -213,7 +213,7 @@ wants to replace FROM with TO."
(when query-replace-from-to-separator
;; Check if the first non-whitespace char is displayable
(if (char-displayable-p
- (string-to-char (replace-regexp-in-string
+ (string-to-char (string-replace
" " "" query-replace-from-to-separator)))
query-replace-from-to-separator
" -> ")))
@@ -310,7 +310,7 @@ the original string if not."
;; but not after (quote foo).
(and (eq (car-safe (car pos)) 'quote)
(not (= ?\( (aref to 0)))))
- (eq (string-match " " to (cdr pos))
+ (eq (string-search " " to (cdr pos))
(cdr pos)))
(1+ (cdr pos))
(cdr pos))))
@@ -432,6 +432,9 @@ In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer's
accessible portion.
+When invoked interactively, matching a newline with `\\n' will not work;
+use `C-q C-j' instead. To match a tab character (`\\t'), just press `TAB'.
+
Use \\<minibuffer-local-map>\\[next-history-element] \
to pull the last incremental search regexp to the minibuffer
that reads REGEXP, or invoke replacements from
@@ -630,13 +633,13 @@ Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to
(if (listp to-strings)
(setq replacements to-strings)
(while (/= (length to-strings) 0)
- (if (string-match " " to-strings)
+ (if (string-search " " to-strings)
(setq replacements
(append replacements
(list (substring to-strings 0
- (string-match " " to-strings))))
+ (string-search " " to-strings))))
to-strings (substring to-strings
- (1+ (string-match " " to-strings))))
+ (1+ (string-search " " to-strings))))
(setq replacements (append replacements (list to-strings))
to-strings ""))))
(perform-replace regexp replacements t t nil n nil start end nil region-noncontiguous-p)))
@@ -789,12 +792,8 @@ which will run faster and will not set the mark or print anything."
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(defvar occur-highlight-regexp t
- "Regexp matching part of visited source lines to highlight temporarily.
-Highlight entire line if t; don't highlight source lines if nil.")
-
-(defvar occur-highlight-overlay nil
- "Overlay used to temporarily highlight occur matches.")
+(defvar occur-highlight-overlays nil
+ "Overlays used to temporarily highlight occur matches.")
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
@@ -1051,6 +1050,130 @@ also print the number."
count))
count))
+(defun kill-matching-lines (regexp &optional rstart rend interactive)
+ "Kill lines containing matches for REGEXP.
+
+When called from Lisp (and usually when called interactively as
+well, see below), applies to the part of the buffer after point.
+The line point is in is killed if and only if it contains a match
+for REGEXP starting after point.
+
+If REGEXP contains upper case characters (excluding those
+preceded by `\\') and `search-upper-case' is non-nil, the
+matching is case-sensitive.
+
+Second and third args RSTART and REND specify the region to
+operate on. Lines partially contained in this region are killed
+if and only if they contain a match entirely contained in the
+region.
+
+Interactively, in Transient Mark mode when the mark is active,
+operate on the contents of the region. Otherwise, operate from
+point to the end of (the accessible portion of) the buffer.
+
+If a match is split across lines, all the lines it lies in are
+killed. They are killed _before_ looking for the next match.
+Hence, a match starting on the same line at which another match
+ended is ignored.
+
+Return the number of killed matching lines. When called
+interactively, also print the number."
+ (interactive
+ (progn
+ (barf-if-buffer-read-only)
+ (keep-lines-read-args "Kill lines containing match for regexp")))
+ (if rstart
+ (progn
+ (goto-char (min rstart rend))
+ (setq rend (copy-marker (max rstart rend))))
+ (if (and interactive (use-region-p))
+ (setq rstart (region-beginning)
+ rend (copy-marker (region-end)))
+ (setq rstart (point)
+ rend (point-max-marker)))
+ (goto-char rstart))
+ (let ((count 0)
+ (case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
+ (save-excursion
+ (while (and (< (point) rend)
+ (re-search-forward regexp rend t))
+ (unless (zerop count)
+ (setq last-command 'kill-region))
+ (kill-region (save-excursion (goto-char (match-beginning 0))
+ (forward-line 0)
+ (point))
+ (progn (forward-line 1) (point)))
+ (setq count (1+ count))))
+ (set-marker rend nil)
+ (when interactive (message (ngettext "Killed %d matching line"
+ "Killed %d matching lines"
+ count)
+ count))
+ count))
+
+(defun copy-matching-lines (regexp &optional rstart rend interactive)
+ "Copy lines containing matches for REGEXP to the kill ring.
+
+When called from Lisp (and usually when called interactively as
+well, see below), applies to the part of the buffer after point.
+The line point is in is copied if and only if it contains a match
+for REGEXP starting after point.
+
+If REGEXP contains upper case characters (excluding those
+preceded by `\\') and `search-upper-case' is non-nil, the
+matching is case-sensitive.
+
+Second and third args RSTART and REND specify the region to
+operate on. Lines partially contained in this region are copied
+if and only if they contain a match entirely contained in the
+region.
+
+Interactively, in Transient Mark mode when the mark is active,
+operate on the contents of the region. Otherwise, operate from
+point to the end of (the accessible portion of) the buffer.
+
+If a match is split across lines, all the lines it lies in are
+copied.
+
+Return the number of copied matching lines. When called
+interactively, also print the number."
+ (interactive
+ (keep-lines-read-args "Copy lines containing match for regexp"))
+ (if rstart
+ (progn
+ (goto-char (min rstart rend))
+ (setq rend (copy-marker (max rstart rend))))
+ (if (and interactive (use-region-p))
+ (setq rstart (region-beginning)
+ rend (copy-marker (region-end)))
+ (setq rstart (point)
+ rend (point-max-marker)))
+ (goto-char rstart))
+ (let ((count 0)
+ (case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
+ (save-excursion
+ (while (and (< (point) rend)
+ (re-search-forward regexp rend t))
+ (unless (zerop count)
+ (setq last-command 'kill-region))
+ (copy-region-as-kill (save-excursion (goto-char (match-beginning 0))
+ (forward-line 0)
+ (point))
+ (progn (forward-line 1) (point)))
+ (setq count (1+ count))))
+ (set-marker rend nil)
+ (when interactive (message (ngettext "Copied %d matching line"
+ "Copied %d matching lines"
+ count)
+ count))
+ count))
+
(defun how-many (regexp &optional rstart rend interactive)
"Print and return number of matches for REGEXP following point.
When called from Lisp and INTERACTIVE is omitted or nil, just return
@@ -1086,17 +1209,17 @@ a previously found match."
rend (point-max)))
(goto-char rstart))
(let ((count 0)
- opoint
(case-fold-search
(if (and case-fold-search search-upper-case)
(isearch-no-upper-case-p regexp t)
case-fold-search)))
(while (and (< (point) rend)
- (progn (setq opoint (point))
- (re-search-forward regexp rend t)))
- (if (= opoint (point))
- (forward-char 1)
- (setq count (1+ count))))
+ (re-search-forward regexp rend t))
+ ;; Ensure forward progress on zero-length matches like "^$".
+ (when (and (= (match-beginning 0) (match-end 0))
+ (not (eobp)))
+ (forward-char 1))
+ (setq count (1+ count)))
(when interactive (message (ngettext "%d occurrence"
"%d occurrences"
count)
@@ -1104,51 +1227,39 @@ a previously found match."
count)))
-(defvar occur-menu-map
- (let ((map (make-sparse-keymap)))
- (bindings--define-key map [next-error-follow-minor-mode]
- '(menu-item "Auto Occurrence Display"
- next-error-follow-minor-mode
- :help "Display another occurrence when moving the cursor"
- :button (:toggle . (and (boundp 'next-error-follow-minor-mode)
- next-error-follow-minor-mode))))
- (bindings--define-key map [separator-1] menu-bar-separator)
- (bindings--define-key map [kill-this-buffer]
- '(menu-item "Kill Occur Buffer" kill-this-buffer
- :help "Kill the current *Occur* buffer"))
- (bindings--define-key map [quit-window]
- '(menu-item "Quit Occur Window" quit-window
- :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))
- (bindings--define-key map [revert-buffer]
- '(menu-item "Revert Occur Buffer" revert-buffer
- :help "Replace the text in the *Occur* buffer with the results of rerunning occur"))
- (bindings--define-key map [clone-buffer]
- '(menu-item "Clone Occur Buffer" clone-buffer
- :help "Create and return a twin copy of the current *Occur* buffer"))
- (bindings--define-key map [occur-rename-buffer]
- '(menu-item "Rename Occur Buffer" occur-rename-buffer
- :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))
- (bindings--define-key map [occur-edit-buffer]
- '(menu-item "Edit Occur Buffer" occur-edit-mode
- :help "Edit the *Occur* buffer and apply changes to the original buffers."))
- (bindings--define-key map [separator-2] menu-bar-separator)
- (bindings--define-key map [occur-mode-goto-occurrence-other-window]
- '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
- :help "Go to the occurrence the current line describes, in another window"))
- (bindings--define-key map [occur-mode-goto-occurrence]
- '(menu-item "Go To Occurrence" occur-mode-goto-occurrence
- :help "Go to the occurrence the current line describes"))
- (bindings--define-key map [occur-mode-display-occurrence]
- '(menu-item "Display Occurrence" occur-mode-display-occurrence
- :help "Display in another window the occurrence the current line describes"))
- (bindings--define-key map [occur-next]
- '(menu-item "Move to Next Match" occur-next
- :help "Move to the Nth (default 1) next match in an Occur mode buffer"))
- (bindings--define-key map [occur-prev]
- '(menu-item "Move to Previous Match" occur-prev
- :help "Move to the Nth (default 1) previous match in an Occur mode buffer"))
- map)
- "Menu keymap for `occur-mode'.")
+(easy-menu-define occur-menu-map nil
+ "Menu for `occur-mode'."
+ '("Occur"
+ ["Move to Previous Match" occur-prev
+ :help "Move to the Nth (default 1) previous match in an Occur mode buffer"]
+ ["Move to Next Match" occur-next
+ :help "Move to the Nth (default 1) next match in an Occur mode buffer"]
+ ["Display Occurrence" occur-mode-display-occurrence
+ :help "Display in another window the occurrence the current line describes"]
+ ["Go To Occurrence" occur-mode-goto-occurrence
+ :help "Go to the occurrence the current line describes"]
+ ["Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
+ :help "Go to the occurrence the current line describes, in another window"]
+ "---"
+ ["Edit Occur Buffer" occur-edit-mode
+ :help "Edit the *Occur* buffer and apply changes to the original buffers."]
+ ["Rename Occur Buffer" occur-rename-buffer
+ :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."]
+ ["Clone Occur Buffer" clone-buffer
+ :help "Create and return a twin copy of the current *Occur* buffer"]
+ ["Revert Occur Buffer" revert-buffer
+ :help "Replace the text in the *Occur* buffer with the results of rerunning occur"]
+ ["Quit Occur Window" quit-window
+ :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"]
+ ["Kill Occur Buffer" kill-this-buffer
+ :help "Kill the current *Occur* buffer"]
+ "---"
+ ["Auto Occurrence Display"
+ next-error-follow-minor-mode
+ :help "Display another occurrence when moving the cursor"
+ :style toggle
+ :selected (and (boundp 'next-error-follow-minor-mode)
+ next-error-follow-minor-mode)]))
(defvar occur-mode-map
(let ((map (make-sparse-keymap)))
@@ -1242,18 +1353,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
(occur-mode)
(message "Switching to Occur mode.")))
+(defun occur--targets-start (targets)
+ "First marker of the `occur-target' property value TARGETS."
+ (if (consp targets)
+ (caar targets)
+ ;; Tolerate an `occur-target' value that is a single marker for
+ ;; compatibility.
+ targets))
+
(defun occur-after-change-function (beg end length)
(save-excursion
(goto-char beg)
(let* ((line-beg (line-beginning-position))
- (m (get-text-property line-beg 'occur-target))
+ (targets (get-text-property line-beg 'occur-target))
+ (m (occur--targets-start targets))
(buf (marker-buffer m))
col)
(when (and (get-text-property line-beg 'occur-prefix)
(not (get-text-property end 'occur-prefix)))
(when (= length 0)
;; Apply occur-target property to inserted (e.g. yanked) text.
- (put-text-property beg end 'occur-target m)
+ (put-text-property beg end 'occur-target targets)
;; Did we insert a newline? Occur Edit mode can't create new
;; Occur entries; just discard everything after the newline.
(save-excursion
@@ -1278,8 +1398,27 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
(recenter line)
(if readonly
(message "Buffer `%s' is read only." buf)
- (delete-region (line-beginning-position) (line-end-position))
- (insert text))
+ ;; Replace the line, but make the change as small as
+ ;; possible by shrink-wrapping. That way, we avoid
+ ;; disturbing markers unnecessarily.
+ (let* ((beg-pos (line-beginning-position))
+ (end-pos (line-end-position))
+ (buf-str (buffer-substring-no-properties beg-pos end-pos))
+ (common-prefix
+ (lambda (s1 s2)
+ (let ((c (compare-strings s1 nil nil s2 nil nil)))
+ (if (numberp c)
+ (1- (abs c))
+ (length s1)))))
+ (prefix-len (funcall common-prefix buf-str text))
+ (suffix-len (funcall common-prefix
+ (reverse buf-str) (reverse text))))
+ (setq beg-pos (+ beg-pos prefix-len))
+ (setq end-pos (- end-pos suffix-len))
+ (setq text (substring text prefix-len (- suffix-len)))
+ (delete-region beg-pos end-pos)
+ (goto-char beg-pos)
+ (insert text)))
(move-to-column col)))))))
@@ -1287,35 +1426,56 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]."
"Handle `revert-buffer' for Occur mode buffers."
(apply #'occur-1 (append occur-revert-arguments (list (buffer-name)))))
+;; Retained for compatibility.
(defun occur-mode-find-occurrence ()
- (let ((pos (get-text-property (point) 'occur-target)))
- (unless pos
+ "Return a marker to the first match of the line at point."
+ (occur--targets-start (occur-mode--find-occurrences)))
+
+(defun occur-mode--find-occurrences ()
+ ;; The `occur-target' property value is a list of (BEG . END) for each
+ ;; match on the line, or (for compatibility) a single marker to the start
+ ;; of the first match.
+ (let* ((targets (get-text-property (point) 'occur-target))
+ (start (occur--targets-start targets)))
+ (unless targets
(error "No occurrence on this line"))
- (unless (buffer-live-p (marker-buffer pos))
+ (unless (buffer-live-p (marker-buffer start))
(error "Buffer for this occurrence was killed"))
- pos))
+ targets))
+
+(defun occur--set-arrow ()
+ "Set the overlay arrow at the first line of the occur match at point."
+ (save-excursion
+ (let ((target (get-text-property (point) 'occur-target))
+ ;; Find the start of the occur match, in case it's multi-line.
+ (prev (previous-single-property-change (point) 'occur-target)))
+ (when (and prev (eq (get-text-property prev 'occur-target) target))
+ (goto-char prev))
+ (setq overlay-arrow-position
+ (set-marker (or overlay-arrow-position (make-marker))
+ (line-beginning-position))))))
(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
(defun occur-mode-goto-occurrence (&optional event)
"Go to the occurrence specified by EVENT, a mouse click.
If not invoked by a mouse click, go to occurrence on the current line."
(interactive (list last-nonmenu-event))
- (let ((buffer (when event (current-buffer)))
- (pos
- (if (null event)
- ;; Actually `event-end' works correctly with a nil argument as
- ;; well, so we could dispense with this test, but let's not
- ;; rely on this undocumented behavior.
- (occur-mode-find-occurrence)
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (occur-mode-find-occurrence)))))
- (regexp occur-highlight-regexp))
+ (let* ((buffer (when event (current-buffer)))
+ (targets
+ (if (null event)
+ ;; Actually `event-end' works correctly with a nil argument as
+ ;; well, so we could dispense with this test, but let's not
+ ;; rely on this undocumented behavior.
+ (occur-mode--find-occurrences)
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (occur-mode--find-occurrences)))))
+ (pos (occur--targets-start targets)))
+ (occur--set-arrow)
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
- (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
- (occur--highlight-occurrence pos end-mk))
+ (occur--highlight-occurrences targets)
(when buffer (next-error-found buffer (current-buffer)))
(run-hooks 'occur-mode-find-occurrence-hook)))
@@ -1323,15 +1483,16 @@ If not invoked by a mouse click, go to occurrence on the current line."
"Go to the occurrence the current line describes, in another window."
(interactive)
(let ((buffer (current-buffer))
- (pos (occur-mode-find-occurrence)))
+ (pos (occur--targets-start (occur-mode--find-occurrences))))
+ (occur--set-arrow)
(switch-to-buffer-other-window (marker-buffer pos))
(goto-char pos)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook)))
-;; Stolen from compile.el
(defun occur-goto-locus-delete-o ()
- (delete-overlay occur-highlight-overlay)
+ (mapc #'delete-overlay occur-highlight-overlays)
+ (setq occur-highlight-overlays nil)
;; Get rid of timer and hook that would try to do this again.
(if (timerp next-error-highlight-timer)
(cancel-timer next-error-highlight-timer))
@@ -1339,64 +1500,56 @@ If not invoked by a mouse click, go to occurrence on the current line."
#'occur-goto-locus-delete-o))
;; Highlight the current visited occurrence.
-;; Adapted from `compilation-goto-locus'.
-(defun occur--highlight-occurrence (mk end-mk)
- (let ((highlight-regexp occur-highlight-regexp))
- (if (timerp next-error-highlight-timer)
- (cancel-timer next-error-highlight-timer))
- (unless occur-highlight-overlay
- (setq occur-highlight-overlay
- (make-overlay (point-min) (point-min)))
- (overlay-put occur-highlight-overlay 'face 'next-error))
- (with-current-buffer (marker-buffer mk)
- (save-excursion
- (if end-mk (goto-char end-mk) (end-of-line))
- (let ((end (point)))
- (if mk (goto-char mk) (beginning-of-line))
- (if (and (stringp highlight-regexp)
- (re-search-forward highlight-regexp end t))
- (progn
- (goto-char (match-beginning 0))
- (move-overlay occur-highlight-overlay
- (match-beginning 0) (match-end 0)
- (current-buffer)))
- (move-overlay occur-highlight-overlay
- (point) end (current-buffer)))
- (if (or (eq next-error-highlight t)
- (numberp next-error-highlight))
- ;; We want highlighting: delete overlay on next input.
- (add-hook 'pre-command-hook
- #'occur-goto-locus-delete-o)
- ;; We don't want highlighting: delete overlay now.
- (delete-overlay occur-highlight-overlay))
- ;; We want highlighting for a limited time:
- ;; set up a timer to delete it.
- (when (numberp next-error-highlight)
- (setq next-error-highlight-timer
- (run-at-time next-error-highlight nil
- 'occur-goto-locus-delete-o))))))
- (when (eq next-error-highlight 'fringe-arrow)
- ;; We want a fringe arrow (instead of highlighting).
- (setq next-error-overlay-arrow-position
- (copy-marker (line-beginning-position))))))
+(defun occur--highlight-occurrences (targets)
+ (let ((start-marker (occur--targets-start targets)))
+ (occur-goto-locus-delete-o)
+ (with-current-buffer (marker-buffer start-marker)
+ (when (or (eq next-error-highlight t)
+ (numberp next-error-highlight))
+ (setq occur-highlight-overlays
+ (mapcar (lambda (target)
+ (let ((o (make-overlay (car target) (cdr target))))
+ (overlay-put o 'face 'next-error)
+ o))
+ (if (listp targets)
+ targets
+ ;; `occur-target' compatibility: when we only
+ ;; have a single starting point, highlight the
+ ;; rest of the line.
+ (let ((end-pos (save-excursion
+ (goto-char start-marker)
+ (line-end-position))))
+ (list (cons start-marker end-pos))))))
+ (add-hook 'pre-command-hook #'occur-goto-locus-delete-o)
+ (when (numberp next-error-highlight)
+ ;; We want highlighting for a limited time:
+ ;; set up a timer to delete it.
+ (setq next-error-highlight-timer
+ (run-at-time next-error-highlight nil
+ 'occur-goto-locus-delete-o))))
+
+ (when (eq next-error-highlight 'fringe-arrow)
+ ;; We want a fringe arrow (instead of highlighting).
+ (setq next-error-overlay-arrow-position
+ (copy-marker (line-beginning-position)))))))
(defun occur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
(interactive)
- (let ((buffer (current-buffer))
- (pos (occur-mode-find-occurrence))
- (regexp occur-highlight-regexp)
- (next-error-highlight next-error-highlight-no-select)
- (display-buffer-overriding-action
- '(nil (inhibit-same-window . t)))
- window)
+ (let* ((buffer (current-buffer))
+ (targets (occur-mode--find-occurrences))
+ (pos (occur--targets-start targets))
+ (next-error-highlight next-error-highlight-no-select)
+ (display-buffer-overriding-action
+ '(nil (inhibit-same-window . t)))
+ window)
(setq window (display-buffer (marker-buffer pos) t))
+ (occur--set-arrow)
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
(goto-char pos)
- (let ((end-mk (save-excursion (re-search-forward regexp nil t))))
- (occur--highlight-occurrence pos end-mk))
+ (occur--highlight-occurrences targets)
(next-error-found buffer (current-buffer))
(run-hooks 'occur-mode-find-occurrence-hook))))
@@ -1445,7 +1598,7 @@ This is a compatibility function for \\[next-error] invocations."
(defface match
'((((class color) (min-colors 88) (background light))
- :background "yellow1")
+ :background "khaki1")
(((class color) (min-colors 88) (background dark))
:background "RoyalBlue3")
(((class color) (min-colors 8) (background light))
@@ -1489,15 +1642,22 @@ If the value is nil, don't highlight the buffer names specially."
(defcustom list-matching-lines-jump-to-current-line nil
"If non-nil, \\[list-matching-lines] shows the current line highlighted.
-Set the point right after such line when there are matches after it."
+The current line for this purpose is the line of the original buffer
+which was current when \\[list-matching-lines] was invoked.
+Point in the `*Occur*' buffer will be set right after such line when
+there are matches after it."
:type 'boolean
:group 'matching
:version "26.1")
(defcustom list-matching-lines-prefix-face 'shadow
"Face used by \\[list-matching-lines] to show the prefix column.
-If the face doesn't differ from the default face,
-don't highlight the prefix with line numbers specially."
+The prefix column is the part of display that precedes the actual
+contents of the line; it normally shows the line number. \(For
+multiline matches, the prefix column shows the line number for the
+first line and whitespace for the rest of the lines.\)
+If this face will display the same as the default face, the prefix
+column will not be highlighted speciall."
:type 'face
:group 'matching
:version "24.4")
@@ -1577,11 +1737,24 @@ REGION must be a list of (START . END) positions as returned by
`region-bounds'.
The lines are shown in a buffer named `*Occur*'.
-It serves as a menu to find any of the occurrences in this buffer.
+That buffer can serve as a menu for finding any of the matches for REGEXP
+in the current buffer.
\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
-If `list-matching-lines-jump-to-current-line' is non-nil, then show
-the current line highlighted with `list-matching-lines-current-line-face'
-and set point at the first match after such line.
+
+Matches for REGEXP are shown in the face determined by the
+variable `list-matching-lines-face'.
+Names of buffers with matched lines are shown in the face determined
+by the variable `list-matching-lines-buffer-name-face'.
+The line numbers of the matching lines are shown in the face
+determined by the variable `list-matching-lines-prefix-face'.
+
+If `list-matching-lines-jump-to-current-line' is non-nil, then the
+line in the current buffer which was current when the command was
+invoked will be shown in the `*Occur*' buffer highlighted with
+the `list-matching-lines-current-line-face', with point at the end
+of that line. (If the current line doesn't match REGEXP, it will
+nonetheless be inserted into the `*Occur*' buffer between the 2
+closest lines that do match REGEXP.)
If REGEXP contains upper case characters (excluding those preceded by `\\')
and `search-upper-case' is non-nil, the matching is case-sensitive.
@@ -1725,6 +1898,7 @@ See also `multi-occur'."
;; Make the default-directory of the *Occur* buffer match that of
;; the buffer where the occurrences come from
(setq default-directory source-buffer-default-directory)
+ (setq overlay-arrow-position nil)
(if (stringp nlines)
(fundamental-mode) ;; This is for collect operation.
(occur-mode))
@@ -1733,7 +1907,6 @@ See also `multi-occur'."
(buffer-undo-list t)
(occur--final-pos nil))
(erase-buffer)
- (setq-local occur-highlight-regexp regexp)
(let ((count
(if (stringp nlines)
;; Treat nlines as a regexp to collect.
@@ -1833,7 +2006,7 @@ See also `multi-occur'."
(origpt nil)
(begpt nil)
(endpt nil)
- (marker nil)
+ markers ; list of (BEG-MARKER . END-MARKER)
(curstring "")
(ret nil)
;; The following binding is for when case-fold-search
@@ -1859,8 +2032,7 @@ See also `multi-occur'."
(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 markers nil)
(setq curstring (occur-engine-line begpt endpt keep-props))
;; Highlight the matches
(let ((len (length curstring))
@@ -1882,6 +2054,11 @@ See also `multi-occur'."
(setq orig-line-shown-p t)))
(while (and (< start len)
(string-match regexp curstring start))
+ (push (cons (set-marker (make-marker)
+ (+ begpt (match-beginning 0)))
+ (set-marker (make-marker)
+ (+ begpt (match-end 0))))
+ markers)
(setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
@@ -1894,6 +2071,7 @@ See also `multi-occur'."
;; Avoid infloop (Bug#7593).
(let ((end (match-end 0)))
(setq start (if (= start end) (1+ start) end)))))
+ (setq markers (nreverse markers))
;; Generate the string to insert for this match
(let* ((match-prefix
;; Using 7 digits aligns tabs properly.
@@ -1907,7 +2085,7 @@ See also `multi-occur'."
;; (for Occur Edit mode).
front-sticky t
rear-nonsticky t
- occur-target ,marker
+ occur-target ,markers
follow-link t
help-echo "mouse-2: go to this occurrence"))))
(match-str
@@ -1915,7 +2093,7 @@ See also `multi-occur'."
;; because that loses. And don't put it
;; on context lines to reduce flicker.
(propertize curstring
- 'occur-target marker
+ 'occur-target markers
'follow-link t
'help-echo
"mouse-2: go to this occurrence"))
@@ -1923,19 +2101,21 @@ See also `multi-occur'."
;; Add non-numeric prefix to all non-first lines
;; of multi-line matches.
(concat
- (replace-regexp-in-string
+ (string-replace
"\n"
(if prefix-face
(propertize
- "\n :" 'font-lock-face prefix-face)
- "\n :")
+ "\n :" 'font-lock-face prefix-face
+ 'occur-target markers)
+ (propertize
+ "\n :" 'occur-target markers))
;; Add mouse face in one section to
;; ensure the prefix and the string
;; get a contiguous highlight.
(propertize (concat match-prefix match-str)
'mouse-face 'highlight))
- ;; Add marker at eol, but no mouse props.
- (propertize "\n" 'occur-target marker)))
+ ;; Add markers at eol, but no mouse props.
+ (propertize "\n" 'occur-target markers)))
(data
(if (= nlines 0)
;; The simple display style
@@ -2326,12 +2506,10 @@ a string, it is first passed through `prin1-to-string'
with the `noescape' argument set.
`match-data' is preserved across the call."
- (save-match-data
- (replace-regexp-in-string "\\\\" "\\\\"
- (if (stringp replacement)
- replacement
- (prin1-to-string replacement t))
- t t)))
+ (string-replace "\\" "\\\\"
+ (if (stringp replacement)
+ replacement
+ (prin1-to-string replacement t))))
(defun replace-loop-through-replacements (data count)
;; DATA is a vector containing the following values:
@@ -2587,9 +2765,7 @@ characters."
;; If non-nil, it is marker saying where in the buffer to stop.
(limit nil)
- ;; Use local binding in add-function below.
- (isearch-filter-predicate isearch-filter-predicate)
- (region-bounds nil)
+ (region-filter nil)
;; Data for the next match. If a cons, it has the same format as
;; (match-data); otherwise it is t if a match is possible at point.
@@ -2613,21 +2789,22 @@ characters."
;; Unless a single contiguous chunk is selected, operate on multiple chunks.
(when region-noncontiguous-p
- (setq region-bounds
- (mapcar (lambda (position)
- (cons (copy-marker (car position))
- (copy-marker (cdr position))))
- (funcall region-extract-function 'bounds)))
- (add-function :after-while isearch-filter-predicate
- (lambda (start end)
- (delq nil (mapcar
- (lambda (bounds)
- (and
- (>= start (car bounds))
- (<= start (cdr bounds))
- (>= end (car bounds))
- (<= end (cdr bounds))))
- region-bounds)))))
+ (let ((region-bounds
+ (mapcar (lambda (position)
+ (cons (copy-marker (car position))
+ (copy-marker (cdr position))))
+ (funcall region-extract-function 'bounds))))
+ (setq region-filter
+ (lambda (start end)
+ (delq nil (mapcar
+ (lambda (bounds)
+ (and
+ (>= start (car bounds))
+ (<= start (cdr bounds))
+ (>= end (car bounds))
+ (<= end (cdr bounds))))
+ region-bounds))))
+ (add-function :after-while isearch-filter-predicate region-filter)))
;; If region is active, in Transient Mark mode, operate on region.
(if backward
@@ -3060,7 +3237,9 @@ characters."
(setq next-replacement-replaced nil
search-string-replaced nil
last-was-act-and-show nil))))))
- (replace-dehighlight))
+ (replace-dehighlight)
+ (when region-filter
+ (remove-function isearch-filter-predicate region-filter)))
(or unread-command-events
(message (ngettext "Replaced %d occurrence%s"
"Replaced %d occurrences%s"
diff --git a/lisp/reposition.el b/lisp/reposition.el
index 008fa009fdc..02bee4165a8 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -38,7 +38,7 @@
;;; Code:
;;;###autoload
-(defun reposition-window (&optional arg)
+(defun reposition-window (&optional arg interactive)
"Make the current definition and/or comment visible.
Further invocations move it to the top of the window or toggle the
visibility of comments that precede it.
@@ -55,118 +55,124 @@ the comment lines.
visible (if only part could otherwise be made so), to make the defun line
visible (if point is in code and it could not be made so, or if only
comments, including the first comment line, are visible), or to make the
-first comment line visible (if point is in a comment)."
- (interactive "P")
- (let* (;; (here (line-beginning-position))
- (here (point))
- ;; change this name once I've gotten rid of references to ht.
- ;; this is actually the number of the last screen line
- (ht (- (window-height) 2))
- (line (repos-count-screen-lines (window-start) (point)))
- (comment-height
- ;; The call to max deals with the case of cursor between defuns.
- (max 0
- (repos-count-screen-lines-signed
- ;; the beginning of the preceding comment
- (save-excursion
- (if (not (eobp)) (forward-char 1))
- (end-of-defun -1)
- ;; Skip whitespace, newlines, and form feeds.
- (if (re-search-forward "[^ \t\n\f]" nil t)
- (backward-char 1))
- (point))
- here)))
- (defun-height
- (repos-count-screen-lines-signed
- (save-excursion
- (end-of-defun 1) ; so comments associate with following defuns
- (beginning-of-defun 1)
- (point))
- here))
- ;; This must be positive, so don't use the signed version.
- (defun-depth (repos-count-screen-lines here
- (save-excursion
- (end-of-defun 1)
- (point))))
- (defun-line-onscreen-p
- (and (<= defun-height line)
- (<= (- line defun-height) ht))))
- (cond ((or (= comment-height line)
- (and (= line ht)
- (> comment-height line)
- ;; if defun line offscreen, we should be in case 4
- defun-line-onscreen-p))
- ;; Either first comment line is at top of screen or (point at
- ;; bottom of screen, defun line onscreen, and first comment line
- ;; off top of screen). That is, it looks like we just did
- ;; recenter-definition, trying to fit as much of the comment
- ;; onscreen as possible. Put defun line at top of screen; that
- ;; is, show as much code, and as few comments, as possible.
-
- (if (and arg (> defun-depth (1+ ht)))
- ;; Can't fit whole defun onscreen without moving point.
- (progn (end-of-defun) (beginning-of-defun) (recenter 0))
- (recenter (max defun-height 0)))
- ;;(repos-debug-macro "1")
- )
-
- ((or (= defun-height line)
- (= line 0)
- (and (< line comment-height)
- (< defun-height 0)))
- ;; Defun line or cursor at top of screen, OR cursor in comment
- ;; whose first line is offscreen.
- ;; Avoid moving definition up even if defun runs offscreen;
- ;; we care more about getting the comment onscreen.
-
- (cond ((= line ht)
- ;; cursor on last screen line (and so in a comment)
- (if arg (progn (end-of-defun) (beginning-of-defun)))
- (recenter 0)
- ;;(repos-debug-macro "2a")
- )
-
- ;; This condition, copied from case 4, may not be quite right
-
- ((and arg (< ht comment-height))
- ;; Can't get first comment line onscreen.
- ;; Go there and try again.
- (forward-line (- comment-height))
- (beginning-of-line)
- ;; was (reposition-window)
- (recenter 0)
- ;;(repos-debug-macro "2b")
- )
- (t
- (recenter (min ht comment-height))
- ;;(repos-debug-macro "2c")
- ))
- ;; (recenter (min ht comment-height))
- )
-
- ((and (> (+ line defun-depth -1) ht)
- defun-line-onscreen-p)
- ;; Defun runs off the bottom of the screen and the defun line
- ;; is onscreen.
- ;; Move the defun up.
- (recenter (max 0 (1+ (- ht defun-depth)) defun-height))
- ;;(repos-debug-macro "3")
- )
-
- (t
- ;; If on the bottom line and comment start is offscreen
- ;; then just move all comments offscreen, or at least as
- ;; far as they'll go.
-
- ;; Try to get as much of the comments onscreen as possible.
- (if (and arg (< ht comment-height))
- ;; Can't get defun line onscreen; go there and try again.
- (progn (forward-line (- defun-height))
- (beginning-of-line)
- (reposition-window))
- (recenter (min ht comment-height)))
- ;;(repos-debug-macro "4")
- ))))
+first comment line visible (if point is in a comment).
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "P\nd")
+ (if interactive
+ (condition-case e
+ (reposition-window arg nil)
+ (scan-error (user-error (cadr e))))
+ (let* (;; (here (line-beginning-position))
+ (here (point))
+ ;; change this name once I've gotten rid of references to ht.
+ ;; this is actually the number of the last screen line
+ (ht (- (window-height) 2))
+ (line (repos-count-screen-lines (window-start) (point)))
+ (comment-height
+ ;; The call to max deals with the case of cursor between defuns.
+ (max 0
+ (repos-count-screen-lines-signed
+ ;; the beginning of the preceding comment
+ (save-excursion
+ (if (not (eobp)) (forward-char 1))
+ (end-of-defun -1)
+ ;; Skip whitespace, newlines, and form feeds.
+ (if (re-search-forward "[^ \t\n\f]" nil t)
+ (backward-char 1))
+ (point))
+ here)))
+ (defun-height
+ (repos-count-screen-lines-signed
+ (save-excursion
+ (end-of-defun 1) ; so comments associate with following defuns
+ (beginning-of-defun 1)
+ (point))
+ here))
+ ;; This must be positive, so don't use the signed version.
+ (defun-depth (repos-count-screen-lines here
+ (save-excursion
+ (end-of-defun 1)
+ (point))))
+ (defun-line-onscreen-p
+ (and (<= defun-height line)
+ (<= (- line defun-height) ht))))
+ (cond ((or (= comment-height line)
+ (and (= line ht)
+ (> comment-height line)
+ ;; if defun line offscreen, we should be in case 4
+ defun-line-onscreen-p))
+ ;; Either first comment line is at top of screen or (point at
+ ;; bottom of screen, defun line onscreen, and first comment line
+ ;; off top of screen). That is, it looks like we just did
+ ;; recenter-definition, trying to fit as much of the comment
+ ;; onscreen as possible. Put defun line at top of screen; that
+ ;; is, show as much code, and as few comments, as possible.
+
+ (if (and arg (> defun-depth (1+ ht)))
+ ;; Can't fit whole defun onscreen without moving point.
+ (progn (end-of-defun) (beginning-of-defun) (recenter 0))
+ (recenter (max defun-height 0)))
+ ;;(repos-debug-macro "1")
+ )
+
+ ((or (= defun-height line)
+ (= line 0)
+ (and (< line comment-height)
+ (< defun-height 0)))
+ ;; Defun line or cursor at top of screen, OR cursor in comment
+ ;; whose first line is offscreen.
+ ;; Avoid moving definition up even if defun runs offscreen;
+ ;; we care more about getting the comment onscreen.
+
+ (cond ((= line ht)
+ ;; cursor on last screen line (and so in a comment)
+ (if arg (progn (end-of-defun) (beginning-of-defun)))
+ (recenter 0)
+ ;;(repos-debug-macro "2a")
+ )
+
+ ;; This condition, copied from case 4, may not be quite right
+
+ ((and arg (< ht comment-height))
+ ;; Can't get first comment line onscreen.
+ ;; Go there and try again.
+ (forward-line (- comment-height))
+ (beginning-of-line)
+ ;; was (reposition-window)
+ (recenter 0)
+ ;;(repos-debug-macro "2b")
+ )
+ (t
+ (recenter (min ht comment-height))
+ ;;(repos-debug-macro "2c")
+ ))
+ ;; (recenter (min ht comment-height))
+ )
+
+ ((and (> (+ line defun-depth -1) ht)
+ defun-line-onscreen-p)
+ ;; Defun runs off the bottom of the screen and the defun line
+ ;; is onscreen.
+ ;; Move the defun up.
+ (recenter (max 0 (1+ (- ht defun-depth)) defun-height))
+ ;;(repos-debug-macro "3")
+ )
+
+ (t
+ ;; If on the bottom line and comment start is offscreen
+ ;; then just move all comments offscreen, or at least as
+ ;; far as they'll go.
+
+ ;; Try to get as much of the comments onscreen as possible.
+ (if (and arg (< ht comment-height))
+ ;; Can't get defun line onscreen; go there and try again.
+ (progn (forward-line (- defun-height))
+ (beginning-of-line)
+ (reposition-window))
+ (recenter (min ht comment-height)))
+ ;;(repos-debug-macro "4")
+ )))))
;;; Auxiliary functions
diff --git a/lisp/rot13.el b/lisp/rot13.el
index dfcf4adc179..4e4e60fea3f 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -3,6 +3,7 @@
;; Copyright (C) 1988, 2001-2021 Free Software Foundation, Inc.
;; Author: Howard Gayle
+;; Simon Josefsson
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -22,18 +23,26 @@
;;; Commentary:
-;; The entry point, `rot13-other-window', performs a Caesar cipher
-;; encrypt/decrypt on the current buffer and displays the result in another
-;; window. ROT13 encryption is sometimes used on USENET as a read-at-your-
-;; own-risk wrapper for material some might consider offensive, such as
-;; ethnic humor.
+;; "ROT13 ('rotate by 13 places') is a simple letter substitution
+;; cipher that replaces a letter with the 13th letter after it in
+;; the alphabet. ROT13 is a special case of the Caesar cipher
+;; which was developed in ancient Rome.
;;
-;; Written by Howard Gayle.
-;; This hack is mainly to show off the char table stuff.
+;; Because there are 26 letters (2×13) in the basic Latin
+;; alphabet, ROT13 is its own inverse; that is, to undo ROT13, the
+;; same algorithm is applied, so the same action can be used for
+;; encoding and decoding. The algorithm provides virtually no
+;; cryptographic security, and is often cited as a canonical
+;; example of weak encryption.
;;
-;; New entry points, `rot13', `rot13-string', and `rot13-region' that
-;; performs Caesar cipher encrypt/decrypt on buffers and strings, was
-;; added by Simon Josefsson.
+;; ROT13 is used in online forums as a means of hiding spoilers,
+;; punchlines, puzzle solutions, and offensive materials from the
+;; casual glance." - Wikipedia article on ROT13
+;;
+;; The entry points, `rot13', `rot13-string', and `rot13-region' performs ROT13
+;; encoding/decoding on buffers and strings. The entry point
+;; `rot13-other-window' performs a ROT13 encoding/decoding on the current
+;; buffer and displays the result in another window.
;;; Code:
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 38283a5c568..a0d4f6e96c2 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -1,4 +1,4 @@
-;;; ruler-mode.el --- display a ruler in the header line
+;;; ruler-mode.el --- display a ruler in the header line -*- lexical-binding: t -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -25,7 +25,7 @@
;;; Commentary:
;; This library provides a minor mode to display a ruler in the header
-;; line. It works from Emacs 21 onwards.
+;; line.
;;
;; You can use the mouse to change the `fill-column' `comment-column',
;; `goal-column', `window-margins' and `tab-stop-list' settings:
@@ -100,10 +100,7 @@
;; To automatically display the ruler in specific major modes use:
;;
;; (add-hook '<major-mode>-hook 'ruler-mode)
-;;
-;;; History:
-;;
;;; Code:
(eval-when-compile
@@ -122,7 +119,6 @@ Also allowing to visually change `tab-stop-list' setting using
<C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
<C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
- :group 'ruler-mode
:type 'boolean)
;; IMPORTANT: This function must be defined before the following
@@ -140,7 +136,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
?\¶
?\|)
"Character used at the `fill-column' location."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -148,7 +143,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defcustom ruler-mode-comment-column-char ?\#
"Character used at the `comment-column' location."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -156,7 +150,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defcustom ruler-mode-goal-column-char ?G
"Character used at the `goal-column' location."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -166,7 +159,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
?\¦
?\@)
"Character used at the `current-column' location."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -174,7 +166,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defcustom ruler-mode-tab-stop-char ?\T
"Character used at `tab-stop-list' locations."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -182,7 +173,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defcustom ruler-mode-basic-graduation-char ?\.
"Character used for basic graduations."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -190,7 +180,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defcustom ruler-mode-inter-graduation-char ?\!
"Character used for intermediate graduations."
- :group 'ruler-mode
:type '(choice
(character :tag "Character")
(integer :tag "Integer char value"
@@ -198,7 +187,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defcustom ruler-mode-set-goal-column-ding-flag t
"Non-nil means do `ding' when `goal-column' is set."
- :group 'ruler-mode
:type 'boolean)
(defface ruler-mode-default
@@ -215,8 +203,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
:line-width 1
:style released-button)
)))
- "Default face used by the ruler."
- :group 'ruler-mode)
+ "Default face used by the ruler.")
(defface ruler-mode-pad
'((((type tty))
@@ -227,64 +214,56 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(:inherit ruler-mode-default
:background "grey64"
)))
- "Face used to pad inactive ruler areas."
- :group 'ruler-mode)
+ "Face used to pad inactive ruler areas.")
(defface ruler-mode-margins
'((t
(:inherit ruler-mode-default
:foreground "white"
)))
- "Face used to highlight margin areas."
- :group 'ruler-mode)
+ "Face used to highlight margin areas.")
(defface ruler-mode-fringes
'((t
(:inherit ruler-mode-default
:foreground "green"
)))
- "Face used to highlight fringes areas."
- :group 'ruler-mode)
+ "Face used to highlight fringes areas.")
(defface ruler-mode-column-number
'((t
(:inherit ruler-mode-default
:foreground "black"
)))
- "Face used to highlight number graduations."
- :group 'ruler-mode)
+ "Face used to highlight number graduations.")
(defface ruler-mode-fill-column
'((t
(:inherit ruler-mode-default
:foreground "red"
)))
- "Face used to highlight the fill column character."
- :group 'ruler-mode)
+ "Face used to highlight the fill column character.")
(defface ruler-mode-comment-column
'((t
(:inherit ruler-mode-default
:foreground "red"
)))
- "Face used to highlight the comment column character."
- :group 'ruler-mode)
+ "Face used to highlight the comment column character.")
(defface ruler-mode-goal-column
'((t
(:inherit ruler-mode-default
:foreground "red"
)))
- "Face used to highlight the goal column character."
- :group 'ruler-mode)
+ "Face used to highlight the goal column character.")
(defface ruler-mode-tab-stop
'((t
(:inherit ruler-mode-default
:foreground "steelblue"
)))
- "Face used to highlight tab stop characters."
- :group 'ruler-mode)
+ "Face used to highlight tab stop characters.")
(defface ruler-mode-current-column
'((t
@@ -292,8 +271,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
:weight bold
:foreground "yellow"
)))
- "Face used to highlight the `current-column' character."
- :group 'ruler-mode)
+ "Face used to highlight the `current-column' character.")
(defsubst ruler-mode-full-window-width ()
@@ -547,15 +525,15 @@ START-EVENT is the mouse click event."
(define-key km [header-line (control down-mouse-2)]
#'ruler-mode-toggle-show-tab-stops)
(define-key km [header-line (shift mouse-1)]
- 'ignore)
+ #'ignore)
(define-key km [header-line (shift mouse-3)]
- 'ignore)
+ #'ignore)
(define-key km [header-line (control mouse-1)]
- 'ignore)
+ #'ignore)
(define-key km [header-line (control mouse-3)]
- 'ignore)
+ #'ignore)
(define-key km [header-line (control mouse-2)]
- 'ignore)
+ #'ignore)
km)
"Keymap for ruler minor mode.")
@@ -590,8 +568,6 @@ format first."
;;;###autoload
(define-minor-mode ruler-mode
"Toggle display of ruler in header line (Ruler mode)."
- nil nil
- ruler-mode-map
:group 'ruler-mode
:variable (ruler-mode
. (lambda (enable)
diff --git a/lisp/savehist.el b/lisp/savehist.el
index b8e9d6b427f..6745d379cb3 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -213,6 +213,7 @@ Normally invoked by calling `savehist-mode' to unset the minor mode."
(cancel-timer savehist-timer)
(setq savehist-timer nil)))
+(defvar savehist--has-given-file-warning nil)
(defun savehist-save (&optional auto-save)
"Save the values of minibuffer history variables.
Unbound symbols referenced in `savehist-additional-variables' are ignored.
@@ -286,23 +287,29 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
;; If autosaving, avoid writing if nothing has changed since the
;; last write.
(let ((checksum (md5 (current-buffer) nil nil savehist-coding-system)))
- (unless (and auto-save (equal checksum savehist-last-checksum))
- ;; Set file-precious-flag when saving the buffer because we
- ;; don't want a half-finished write ruining the entire
- ;; history. Remember that this is run from a timer and from
- ;; kill-emacs-hook, and also that multiple Emacs instances
- ;; could write to this file at once.
- (let ((file-precious-flag t)
- (coding-system-for-write savehist-coding-system)
- (dir (file-name-directory savehist-file)))
- ;; Ensure that the directory exists before saving.
- (unless (file-exists-p dir)
- (make-directory dir t))
- (write-region (point-min) (point-max) savehist-file nil
- (unless (called-interactively-p 'interactive) 'quiet)))
- (when savehist-file-modes
- (set-file-modes savehist-file savehist-file-modes))
- (setq savehist-last-checksum checksum)))))
+ (condition-case err
+ (unless (and auto-save (equal checksum savehist-last-checksum))
+ ;; Set file-precious-flag when saving the buffer because we
+ ;; don't want a half-finished write ruining the entire
+ ;; history. Remember that this is run from a timer and from
+ ;; kill-emacs-hook, and also that multiple Emacs instances
+ ;; could write to this file at once.
+ (let ((file-precious-flag t)
+ (coding-system-for-write savehist-coding-system)
+ (dir (file-name-directory savehist-file)))
+ ;; Ensure that the directory exists before saving.
+ (unless (file-exists-p dir)
+ (make-directory dir t))
+ (write-region (point-min) (point-max) savehist-file nil
+ (unless (called-interactively-p 'interactive) 'quiet)))
+ (when savehist-file-modes
+ (set-file-modes savehist-file savehist-file-modes))
+ (setq savehist-last-checksum checksum))
+ (file-error
+ (unless savehist--has-given-file-warning
+ (lwarn '(savehist-file) :warning "Error writing `%s': %s"
+ savehist-file (caddr err))
+ (setq savehist--has-given-file-warning t)))))))
(defun savehist-autosave ()
"Save the minibuffer history if it has been modified since the last save.
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index f654702def4..2a95b39da87 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -87,6 +87,11 @@ this happens automatically before saving `save-place-alist' to
`save-place-file'."
:type 'boolean)
+(defcustom save-place-abbreviate-file-names nil
+ "If non-nil, abbreviate file names before saving them."
+ :type 'boolean
+ :version "28.1")
+
(defcustom save-place-save-skipped t
"If non-nil, remember files matching `save-place-skip-check-regexp'.
@@ -177,7 +182,10 @@ file:
"Add current buffer filename and position to `save-place-alist'.
Put filename and point in a cons box and then cons that onto the
front of the `save-place-alist', if `save-place-mode' is non-nil.
-Otherwise, just delete that file from the alist."
+Otherwise, just delete that file from the alist.
+
+If `save-place-abbreviate-file-names' is non-nil, abbreviate the
+file names."
;; First check to make sure alist has been loaded in from the master
;; file. If not, do so, then feel free to modify the alist. It
;; will be saved again when Emacs is killed.
@@ -195,6 +203,8 @@ Otherwise, just delete that file from the alist."
(or (not save-place-ignore-files-regexp)
(not (string-match save-place-ignore-files-regexp
item))))
+ (when save-place-abbreviate-file-names
+ (setq item (abbreviate-file-name item)))
(let ((cell (assoc item save-place-alist))
(position (cond ((eq major-mode 'hexl-mode)
(with-no-warnings
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index 25b245e4b63..415244f9e92 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -1,4 +1,4 @@
-;;; scroll-all.el --- scroll all buffers together minor mode
+;;; scroll-all.el --- scroll all buffers together minor mode -*- lexical-binding: t -*-
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
@@ -47,38 +47,41 @@
(condition-case nil
(funcall func arg)
;; Ignore beginning- or end-of-buffer error in other windows.
- (error nil)
- )
+ (error nil))
(other-window 1)
(setq count (1+ count))))))
(defun scroll-all-scroll-down-all (arg)
- "Scroll down in all visible windows."
+ "Scroll down ARG lines in all visible windows."
(interactive "p")
(scroll-all-function-all 'next-line arg))
(defun scroll-all-scroll-up-all (arg)
- "Scroll up in all visible windows."
+ "Scroll up ARG lines in all visible windows."
(interactive "p")
(scroll-all-function-all 'previous-line arg))
(defun scroll-all-page-down-all (arg)
- "Page down in all visible windows."
+ "Page down in all visible windows.
+ARG is like in `scroll-up'."
(interactive "P")
(scroll-all-function-all 'scroll-up arg))
(defun scroll-all-page-up-all (arg)
- "Page up in all visible windows."
+ "Page up in all visible windows.
+ARG is like in `scroll-down'."
(interactive "P")
(scroll-all-function-all 'scroll-down arg))
(defun scroll-all-beginning-of-buffer-all (arg)
- "Go to the beginning of the buffer in all visible windows."
+ "Go to the beginning of the buffer in all visible windows.
+ARG is like in `beginning-of-buffer'."
(interactive "P")
(scroll-all-function-all 'beginning-of-buffer arg))
(defun scroll-all-end-of-buffer-all (arg)
- "Go to the end of the buffer in all visible windows."
+ "Go to the end of the buffer in all visible windows.
+ARG is like in `end-of-buffer'."
(interactive "P")
(scroll-all-function-all 'end-of-buffer arg))
@@ -105,7 +108,7 @@
When Scroll-All mode is enabled, scrolling commands invoked in
one window apply to all visible windows in the same frame."
- nil " *SL*" nil
+ :lighter " *SL*"
:global t
:group 'windows
(if scroll-all-mode
diff --git a/lisp/select.el b/lisp/select.el
index c39bc93deab..15e171c13f9 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -184,11 +184,17 @@ decoded. If `gui-get-selection' signals an error, return nil."
(let ((clip-text
(when select-enable-clipboard
(let ((text (gui--selection-value-internal 'CLIPBOARD)))
- (if (string= text "") (setq text nil))
-
- ;; Check the CLIPBOARD selection for 'newness', is it different
- ;; from what we remembered them to be last time we did a
- ;; cut/paste operation.
+ (when (string= text "")
+ (setq text nil))
+ ;; When `select-enable-clipboard' is non-nil,
+ ;; killing/copying text (with, say, `C-w') will push the
+ ;; text to the clipboard (and store it in
+ ;; `gui--last-selected-text-clipboard'). We check
+ ;; whether the text on the clipboard is identical to this
+ ;; text, and if so, we report that the clipboard is
+ ;; empty. See (bug#27442) for further discussion about
+ ;; this DWIM action, and possible ways to make this check
+ ;; less fragile, if so desired.
(prog1
(unless (equal text gui--last-selected-text-clipboard)
text)
@@ -490,7 +496,7 @@ two markers or an overlay. Otherwise, it is nil."
(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 str (string-replace "\0" "\\0" str))
(setq next-selection-coding-system nil)
(cons type str))))
diff --git a/lisp/server.el b/lisp/server.el
index 220694f6cbf..ac5db197f3e 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -413,9 +413,14 @@ If CLIENT is non-nil, add a description of it to the logged message."
;; for possible servers before doing anything, so it *should* be ours.
(and (process-contact proc :server)
(eq (process-status proc) 'closed)
+ ;; If this variable is non-nil, the socket was passed in to
+ ;; Emacs, and not created by Emacs itself (for instance,
+ ;; created by systemd). In that case, don't delete the socket.
+ (not internal--daemon-sockname)
(ignore-errors
(delete-file (process-get proc :server-file))))
- (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
+ (server-log (format "Status changed to %s: %s"
+ (process-status proc) msg) proc)
(server-delete-client proc))
(defun server--on-display-p (frame display)
@@ -1303,7 +1308,17 @@ The following commands are accepted by the client:
frame-parameters))
;; When resuming on a tty, tty-name is nil.
(tty-name
- (server-create-tty-frame tty-name tty-type proc))))
+ (server-create-tty-frame tty-name tty-type proc))
+
+ ;; If there won't be a current frame to use, fall
+ ;; back to trying to create a new one.
+ ((and use-current-frame
+ (daemonp)
+ (null (cdr (frame-list)))
+ (eq (selected-frame) terminal-frame)
+ display)
+ (setq tty-name nil tty-type nil)
+ (server-select-display display))))
(process-put
proc 'continuation
@@ -1598,7 +1613,9 @@ prevent a backup for it.) The variable `server-temp-file-regexp' controls
which filenames are considered temporary.
If invoked with a prefix argument, or if there is no server process running,
-starts server process and that is all. Invoked by \\[server-edit]."
+starts server process and that is all. Invoked by \\[server-edit].
+
+To abort an edit instead of saying \"Done\", use \\[server-edit-abort]."
(interactive "P")
(cond
((or arg
@@ -1608,6 +1625,17 @@ starts server process and that is all. Invoked by \\[server-edit]."
(server-clients (apply #'server-switch-buffer (server-done)))
(t (message "No server editing buffers exist"))))
+(defun server-edit-abort ()
+ "Abort editing the current client buffer."
+ (interactive)
+ (if server-clients
+ (mapc (lambda (proc)
+ (server-send-string
+ proc (concat "-error "
+ (server-quote-arg "Aborted by the user"))))
+ server-clients)
+ (message "This buffer has no clients")))
+
(defun server-switch-buffer (&optional next-buffer killed-one filepos
this-frame-only)
"Switch to another buffer, preferably one that has a client.
diff --git a/lisp/ses.el b/lisp/ses.el
index d6090f3e8d7..81c27144a54 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1,4 +1,4 @@
-;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*-
+;;; ses.el --- Simple Emacs Spreadsheet -*- lexical-binding:t -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -172,14 +172,14 @@ Each function is called with ARG=1."
(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.")
+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.")
+ "Calling buffer for SES listing help.
+Used for listing local printers or renamed cells.")
(defconst ses-mode-edit-map
@@ -332,9 +332,9 @@ column or default printer and then modify its output.")
next-line-add-newlines transient-mark-mode)
"Buffer-local variables used by SES."))
-(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t))
-(ses--metaprogramming
- `(progn ,@(mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars)))
+(defmacro ses--\,@ (exp) (declare (debug t)) (macroexp-progn (eval exp t)))
+(ses--\,@
+ (mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars))
(defun ses-set-localvars ()
"Set buffer-local and initialize some SES variables."
@@ -395,8 +395,9 @@ left-justification of the result. Set to error-signal if `ses-call-printer'
encountered an error during printing. Otherwise nil.")
(defvar ses-start-time nil
- "Time when current operation started. Used by `ses--time-check' to decide
-when to emit a progress message.")
+ "Time when current operation started.
+Used by `ses--time-check' to decide when to emit a progress
+message.")
;;----------------------------------------------------------------------------
@@ -560,9 +561,10 @@ the corresponding cell with name PROPERTY-NAME."
(eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym))))))
(defun ses--cell (sym value formula printer references)
- "Load a cell SYM from the spreadsheet file. Does not recompute VALUE from
-FORMULA, does not reprint using PRINTER, does not check REFERENCES.
-Safety-checking for FORMULA and PRINTER are deferred until first use."
+ "Load a cell SYM from the spreadsheet file.
+Does not recompute VALUE from FORMULA, does not reprint using
+PRINTER, does not check REFERENCES. Safety-checking for FORMULA
+and PRINTER are deferred until first use."
(let ((rowcol (ses-sym-rowcol sym)))
(ses-formula-record formula)
(ses-printer-record printer)
@@ -580,8 +582,7 @@ Safety-checking for FORMULA and PRINTER are deferred until first use."
(set sym value))
(defun ses-local-printer-compile (printer)
- "Convert local printer function into faster printer
-definition."
+ "Convert local printer function into faster printer definition."
(cond
((functionp printer) printer)
((stringp printer)
@@ -610,8 +611,8 @@ Return the printer info."
ses--local-printer-hashmap))
(defmacro ses-column-widths (widths)
- "Load the vector of column widths from the spreadsheet file. This is a
-macro to prevent propagate-on-load viruses."
+ "Load the vector of column widths from the spreadsheet file.
+This is a macro to prevent propagate-on-load viruses."
(or (and (vectorp widths) (= (length widths) ses--numcols))
(error "Bad column-width vector"))
;;To save time later, we also calculate the total width of each line in the
@@ -748,8 +749,8 @@ for this spreadsheet."
(intern (concat (ses-column-letter col) (number-to-string (1+ row)))))
(defun ses-decode-cell-symbol (str)
- "Decode a symbol \"A1\" => (0,0). Return nil if STR is not a
-canonical cell name."
+ "Decode a symbol \"A1\" => (0,0).
+Return nil if STR is not a canonical cell name."
(let (case-fold-search)
(and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str)
(let* ((col-str (match-string-no-properties 1 str))
@@ -840,31 +841,31 @@ and ARGS and reset `ses-start-time' to the current time."
"Install VAL as the contents for field FIELD (named by a quoted symbol) of
cell (ROW,COL). This is undoable. The cell's data will be updated through
`post-command-hook'."
- `(let ((row ,row)
- (col ,col)
- (val ,val))
- (let* ((cell (ses-get-cell row col))
+ (macroexp-let2 nil row row
+ (macroexp-let2 nil col col
+ (macroexp-let2 nil val val
+ `(let* ((cell (ses-get-cell ,row ,col))
(change
,(let ((field (progn (cl-assert (eq (car field) 'quote))
(cadr field))))
(if (eq field 'value)
- '(ses-set-with-undo (ses-cell-symbol cell) val)
+ `(ses-set-with-undo (ses-cell-symbol cell) ,val)
;; (let* ((slots (get 'ses-cell 'cl-struct-slots))
;; (slot (or (assq field slots)
;; (error "Unknown field %S" field)))
;; (idx (- (length slots)
;; (length (memq slot slots)))))
- ;; `(ses-aset-with-undo cell ,idx val))
+ ;; `(ses-aset-with-undo cell ,idx ,val))
(let ((getter (intern-soft (format "ses-cell--%s" field))))
`(ses-setter-with-undo
(eval-when-compile
(cons #',getter
(lambda (newval cell)
(setf (,getter cell) newval))))
- val cell))))))
+ ,val cell))))))
(if change
- (add-to-list 'ses--deferred-write (cons row col))))
- nil)) ; Make coverage-tester happy.
+ (add-to-list 'ses--deferred-write (cons ,row ,col)))
+ nil))))) ; Make coverage-tester happy.
(defun ses-cell-set-formula (row col formula)
"Store a new formula for (ROW . COL) and enqueue the cell for
@@ -1061,15 +1062,15 @@ the old and FORCE is nil."
(ses-cell-set-formula row col nil))
(defcustom ses-self-reference-early-detection nil
- "True if cycle detection is early for cells that refer to themselves."
+ "Non-nil if cycle detection is early for cells that refer to themselves."
:version "24.1"
:type 'boolean
:group 'ses)
(defun ses-update-cells (list &optional force)
- "Recalculate cells in LIST, checking for dependency loops. Prints
-progress messages every second. Dependent cells are not recalculated
-if the cell's value is unchanged and FORCE is nil."
+ "Recalculate cells in LIST, checking for dependency loops.
+Print progress messages every second. Dependent cells are not
+recalculated if the cell's value is unchanged and FORCE is nil."
(let ((ses--deferred-recalc list)
(nextlist list)
(pos (point))
@@ -2025,7 +2026,7 @@ Delete overlays, remove special text properties."
When you invoke SES in a new buffer, it is divided into cells
that you can enter data into. You can navigate the cells with
the arrow keys and add more cells with the tab key. The contents
-of these cells can be numbers, text, or Lisp expressions. (To
+of these cells can be numbers, text, or Lisp expressions. (To
enter text, enclose it in double quotes.)
In an expression, you can use cell coordinates to refer to the
@@ -2131,9 +2132,9 @@ formula:
(defun ses-command-hook ()
"Invoked from `post-command-hook'. If point has moved to a different cell,
-moves the underlining overlay. Performs any recalculations or cell-data
+move the underlining overlay. Perform any recalculations or cell-data
writes that have been deferred. If buffer-narrowing has been deferred,
-narrows the buffer now."
+narrow the buffer now."
(condition-case err
(when (eq major-mode 'ses-mode) ; Otherwise, not our buffer anymore.
(when ses--deferred-recalc
@@ -2251,9 +2252,8 @@ Based on the current set of columns and `window-hscroll' position."
(push (symbol-name key) names))
ses--named-cell-hashmap)
names)))))
- (if
- (string= s "")
- (error "Invalid cell name")
+ (if (string= s "")
+ (user-error "Invalid cell name")
(list (intern s)))))
(let ((rowcol (ses-sym-rowcol sym)))
(or rowcol (error "Invalid cell name"))
@@ -2267,8 +2267,8 @@ Based on the current set of columns and `window-hscroll' position."
(ses-jump cell)))
(defun ses-reprint-all (&optional nonarrow)
- "Recreate the display area. Calls all printer functions. Narrows to
-print area if NONARROW is nil."
+ "Recreate the display area. Call all printer functions.
+Narrow to print area if optional argument NONARROW is nil."
(interactive "*P")
(widen)
(unless nonarrow
@@ -2495,8 +2495,8 @@ to are recalculated first."
(and collection (list start end collection))))))
(defun ses-edit-cell (row col newval)
- "Display current cell contents in minibuffer, for editing. Returns nil if
-cell formula was unsafe and user declined confirmation."
+ "Display current cell contents in minibuffer, for editing.
+Return nil if cell formula was unsafe and user declined confirmation."
(interactive
(progn
(barf-if-buffer-read-only)
@@ -2559,8 +2559,9 @@ cell formula was unsafe and user declined confirmation."
(funcall x 1))))
(defun ses-read-symbol (row col symb)
- "Self-insert for a symbol as a cell formula. The set of all symbols that
-have been used as formulas in this spreadsheet is available for completions."
+ "Self-insert for a symbol as a cell formula.
+The set of all symbols that have been used as formulas in this
+spreadsheet is available for completions."
(interactive
(let ((rowcol (progn (ses-check-curcell) (ses-sym-rowcol ses--curcell)))
newval)
@@ -2593,7 +2594,7 @@ With prefix, deletes several cells."
(forward-char 1))))
(defun ses-clear-cell-backward (count)
- "Move to previous cell and then delete it. With prefix, deletes several
+ "Move to previous cell and then delete it. With prefix, delete several
cells."
(interactive "*p")
(if (< count 0)
@@ -2653,9 +2654,7 @@ canceled."
(barf-if-buffer-read-only)
(if (eq default t)
(setq default "")
- (setq prompt (format "%s (default %S): "
- (substring prompt 0 -2)
- default)))
+ (setq prompt (format-prompt prompt 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.
@@ -2702,7 +2701,7 @@ right-justified) or a list of one string (will be left-justified)."
;;Range contains differing printer functions
(setq default t)
(throw 'ses-read-cell-printer t))))))
- (list (ses-read-printer (format "Cell %S printer: " ses--curcell)
+ (list (ses-read-printer (format "Cell %S printer" ses--curcell)
default))))
(unless (eq newval t)
(ses-begin-change)
@@ -2716,7 +2715,7 @@ See `ses-read-cell-printer' for input forms."
(interactive
(let ((col (cdr (ses-sym-rowcol ses--curcell))))
(ses-check-curcell)
- (list col (ses-read-printer (format "Column %s printer: "
+ (list col (ses-read-printer (format "Column %s printer"
(ses-column-letter col))
(ses-col-printer col)))))
@@ -2731,7 +2730,7 @@ See `ses-read-cell-printer' for input forms."
"Set the default printer function for cells that have no other.
See `ses-read-cell-printer' for input forms."
(interactive
- (list (ses-read-printer "Default printer: " ses--default-printer)))
+ (list (ses-read-printer "Default printer" ses--default-printer)))
(unless (eq newval t)
(ses-begin-change)
(ses-set-parameter 'ses--default-printer newval)
@@ -3358,7 +3357,7 @@ is non-nil. Newlines and tabs in the export text are escaped."
(push "'" result)
(setq item (cadr item)))
(setq item (ses-prin1 item))
- (setq item (replace-regexp-in-string "\t" "\\\\t" item))
+ (setq item (string-replace "\t" "\\t" item))
(push item result)
(cond
((< col maxcol)
@@ -3373,15 +3372,15 @@ is non-nil. Newlines and tabs in the export text are escaped."
;;----------------------------------------------------------------------------
(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."
+ "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")))))
+ (t (user-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
@@ -3407,15 +3406,15 @@ buffer."
(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."
+ "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")))))
+ (t (user-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
@@ -3458,7 +3457,9 @@ With a \\[universal-argument] prefix arg, prompt the user.
The top row is row 1. Selecting row 0 displays the default header row."
(interactive
(list (if (numberp current-prefix-arg) current-prefix-arg
- (let ((currow (1+ (car (ses-sym-rowcol ses--curcell)))))
+ (let* ((curcell (or (ses--cell-at-pos (point))
+ (user-error "Invalid header-row")))
+ (currow (1+ (car (ses-sym-rowcol curcell)))))
(if current-prefix-arg
(read-number "Header row: " currow)
currow)))))
@@ -3773,7 +3774,7 @@ function is redefined."
(setq name (intern name))
(let* ((cur-printer (gethash name ses--local-printer-hashmap))
(default (and cur-printer (ses--locprn-def cur-printer))))
- (setq def (ses-read-printer (format "Enter definition of printer %S: " name)
+ (setq def (ses-read-printer (format "Enter definition of printer %S" name)
default)))
(list name def)))
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index a4f0eba4449..f67b0b9b39c 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,4 +1,4 @@
-;;; shadowfile.el --- automatic file copying
+;;; shadowfile.el --- automatic file copying -*- lexical-binding: t; -*-
;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc.
@@ -90,27 +90,23 @@
"If t, always copy shadow files without asking.
If nil (the default), always ask. If not nil and not t, ask only if there
is no buffer currently visiting the file."
- :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe))
- :group 'shadow)
+ :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)))
(defcustom shadow-inhibit-message nil
"If non-nil, do not display a message when a file needs copying."
- :type 'boolean
- :group 'shadow)
+ :type 'boolean)
(defcustom shadow-inhibit-overload nil
"If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs].
Normally it overloads the function `save-buffers-kill-emacs' to check for
files that have been changed and need to be copied to other systems."
- :type 'boolean
- :group 'shadow)
+ :type 'boolean)
(defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows")
"File to keep shadow information in.
The `shadow-info-file' should be shadowed to all your accounts to
ensure consistency. Default: ~/.emacs.d/shadows"
:type 'file
- :group 'shadow
:version "26.2")
(defcustom shadow-todo-file
@@ -122,18 +118,17 @@ remember and ask you again in your next Emacs session.
This file must NOT be shadowed to any other system, it is host-specific.
Default: ~/.emacs.d/shadow_todo"
:type 'file
- :group 'shadow
:version "26.2")
-;;; The following two variables should in most cases initialize themselves
-;;; correctly. They are provided as variables in case the defaults are wrong
-;;; on your machine (and for efficiency).
+;; The following two variables should in most cases initialize themselves
+;; correctly. They are provided as variables in case the defaults are wrong
+;; on your machine (and for efficiency).
(defvar shadow-system-name (concat "/" (system-name) ":")
"The identification for local files on this machine.")
-(defvar shadow-homedir "~"
+(defvar shadow-homedir "~/"
"Your home directory on this machine.")
;;;
@@ -160,7 +155,7 @@ created by `shadow-define-regexp-group'.")
(defvar shadow-files-to-copy nil) ; List of files that need to
; be copied to remote hosts.
-(defvar shadow-hashtable nil) ; for speed
+(defvar shadow-hashtable (make-hash-table :test #'equal)) ; for speed
(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
@@ -172,20 +167,6 @@ created by `shadow-define-regexp-group'.")
;;; Syntactic sugar; General list and string manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun shadow-union (a b)
- "Add members of list A to list B if not equal to items already in B."
- (if (null a)
- b
- (if (member (car a) b)
- (shadow-union (cdr a) b)
- (shadow-union (cdr a) (cons (car a) b)))))
-
-(defun shadow-find (func list)
- "If FUNC applied to some element of LIST is non-nil, return first such element."
- (while (and list (not (funcall func (car list))))
- (setq list (cdr list)))
- (car list))
-
(defun shadow-regexp-superquote (string)
"Like `regexp-quote', but includes the \\` and \\'.
This makes sure regexp matches nothing but STRING."
@@ -205,11 +186,11 @@ PREFIX."
;;; Clusters and sites
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; I use the term `site' to refer to a string which may be the
-;;; cluster identification "/name:", a remote identification
-;;; "/method:user@host:", or "/system-name:" (the value of
-;;; `shadow-system-name') for the location of local files. All
-;;; user-level commands should accept either.
+;; I use the term `site' to refer to a string which may be the
+;; cluster identification "/name:", a remote identification
+;; "/method:user@host:", or "/system-name:" (the value of
+;; `shadow-system-name') for the location of local files. All
+;; user-level commands should accept either.
(cl-defstruct (shadow-cluster (:type list) :named) name primary regexp)
@@ -226,7 +207,7 @@ information defining the cluster. For interactive use, call
(defun shadow-get-cluster (name)
"Return cluster named NAME, or nil."
- (shadow-find
+ (seq-find
(lambda (x) (string-equal (shadow-cluster-name x) name))
shadow-clusters))
@@ -252,7 +233,7 @@ information defining the cluster. For interactive use, call
(defun shadow-site-cluster (site)
"Given a SITE, return cluster it is in, or nil."
(or (shadow-get-cluster (shadow-site-name site))
- (shadow-find
+ (seq-find
(lambda (x)
(string-match (shadow-cluster-regexp x) (shadow-name-site site)))
shadow-clusters)))
@@ -303,9 +284,13 @@ Argument can be a simple name, remote file name, or already a
(defsubst shadow-make-fullname (hup &optional host name)
"Make a Tramp style fullname out of HUP, a `tramp-file-name' structure.
-Replace HOST, and NAME when non-nil."
+Replace HOST, and NAME when non-nil. HOST can also be a remote file name."
(let ((hup (copy-tramp-file-name hup)))
- (when host (setf (tramp-file-name-host hup) host))
+ (when host
+ (if (file-remote-p host)
+ (setq name (or name (and hup (tramp-file-name-localname hup)))
+ hup (tramp-dissect-file-name (file-remote-p host)))
+ (setf (tramp-file-name-host hup) host)))
(when name (setf (tramp-file-name-localname hup) name))
(if (null (tramp-file-name-method hup))
(format
@@ -367,15 +352,16 @@ Will return the name bare if it is a local file."
(defun shadow-contract-file-name (file)
"Simplify FILE.
-Do so by replacing (when possible) home directory with ~, and hostname
-with cluster name that includes it. Filename should be absolute and
-true."
+Do so by replacing (when possible) home directory with ~/, and
+hostname with cluster name that includes it. Filename should be
+absolute and true."
(let* ((hup (shadow-parse-name file))
(homedir (if (shadow-local-file hup)
shadow-homedir
(file-name-as-directory
(file-local-name
- (expand-file-name (shadow-make-fullname hup nil "~"))))))
+ (expand-file-name
+ (shadow-make-fullname hup nil shadow-homedir))))))
(suffix (shadow-suffix homedir (tramp-file-name-localname hup)))
(cluster (shadow-site-cluster (shadow-make-fullname hup nil ""))))
(when cluster
@@ -384,7 +370,7 @@ true."
(shadow-make-fullname
hup nil
(if suffix
- (concat "~/" suffix)
+ (concat shadow-homedir suffix)
(tramp-file-name-localname hup)))))
(defun shadow-same-site (pattern file)
@@ -594,7 +580,7 @@ be shadowed), and list of SITES."
Filename should have clusters expanded, but otherwise can have any format.
Return value is a list of dotted pairs like (from . to), where from
and to are absolute file names."
- (or (symbol-value (intern-soft file shadow-hashtable))
+ (or (gethash file shadow-hashtable)
(let* ((absolute-file (shadow-expand-file-name
(or (shadow-local-file file) file)
shadow-homedir))
@@ -612,7 +598,7 @@ and to are absolute file names."
"shadow-shadows-of: %s %s %s %s %s"
file (shadow-local-file file) shadow-homedir
absolute-file canonical-file))
- (set (intern file shadow-hashtable) shadows))))
+ (puthash file shadows shadow-hashtable))))
(defun shadow-shadows-of-1 (file groups regexp)
"Return list of FILE's shadows in GROUPS.
@@ -653,7 +639,7 @@ Consider them as regular expressions if third arg REGEXP is true."
shadows shadow-files-to-copy (with-output-to-string (backtrace))))
(when shadows
(setq shadow-files-to-copy
- (shadow-union shadows shadow-files-to-copy))
+ (nreverse (cl-union shadows shadow-files-to-copy :test #'equal)))
(when (not shadow-inhibit-message)
(message "%s" (substitute-command-keys
"Use \\[shadow-copy-files] to update shadows."))
@@ -749,7 +735,7 @@ With non-nil argument also saves the buffer."
(sit-for 1))))))
(defun shadow-invalidate-hashtable ()
- (setq shadow-hashtable (make-vector 37 0)))
+ (clrhash shadow-hashtable))
(defun shadow-insert-var (variable)
"Build a `setq' to restore VARIABLE.
@@ -758,17 +744,17 @@ will restore VARIABLE to its current setting.
VARIABLE must be the name of a variable whose value is a list."
(let ((standard-output (current-buffer)))
(insert (format "(setq %s" variable))
- (cond ((consp (eval variable))
+ (cond ((consp (symbol-value variable))
(insert "\n '(")
- (prin1 (car (eval variable)))
- (let ((rest (cdr (eval variable))))
+ (prin1 (car (symbol-value variable)))
+ (let ((rest (cdr (symbol-value variable))))
(while rest
(insert "\n ")
(prin1 (car rest))
(setq rest (cdr rest)))
(insert "))\n\n")))
(t (insert " ")
- (prin1 (eval variable))
+ (prin1 (symbol-value variable))
(insert ")\n\n")))))
(defun shadow-save-buffers-kill-emacs (&optional arg)
@@ -777,6 +763,11 @@ With prefix arg, silently save all file-visiting buffers, then kill.
Extended by shadowfile to automatically save `shadow-todo-file' and
look for files that have been changed and need to be copied to other systems."
+ (interactive "P")
+ (shadow--save-buffers-kill-emacs arg)
+ (save-buffers-kill-emacs arg))
+
+(defun shadow--save-buffers-kill-emacs (&optional arg &rest _)
;; This function is necessary because we need to get control and save
;; the todo file /after/ saving other files, but /before/ the warning
;; message about unsaved buffers (because it can get modified by the
@@ -784,27 +775,10 @@ look for files that have been changed and need to be copied to other systems."
;; because it is not called at the correct time, and also because it is
;; called when the terminal is disconnected and we cannot ask whether
;; to copy files.
- (interactive "P")
(shadow-save-todo-file)
(save-some-buffers arg t)
(shadow-copy-files)
- (shadow-save-todo-file)
- (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf)))
- (buffer-list))))
- (yes-or-no-p "Modified buffers exist; exit anyway? "))
- (or (not (fboundp 'process-list))
- ;; `process-list' is not defined on MSDOS.
- (let ((processes (process-list))
- active)
- (while processes
- (and (memq (process-status (car processes)) '(run stop open listen))
- (process-query-on-exit-flag (car processes))
- (setq active t))
- (setq processes (cdr processes)))
- (or (not active)
- (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
- (kill-emacs)))
+ (shadow-save-todo-file))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook us up
@@ -823,22 +797,29 @@ look for files that have been changed and need to be copied to other systems."
(message "Shadowfile information files not found - aborting")
(beep)
(sit-for 3))
- (when (and (not shadow-inhibit-overload)
- (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
- (defalias 'shadow-orig-save-buffers-kill-emacs
- (symbol-function 'save-buffers-kill-emacs))
- (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs))
- (add-hook 'write-file-functions 'shadow-add-to-todo)
- (define-key ctl-x-4-map "s" 'shadow-copy-files)))
+ (unless shadow-inhibit-overload
+ (advice-add 'save-buffers-kill-emacs :before
+ #'shadow--save-buffers-kill-emacs))
+ (add-hook 'write-file-functions #'shadow-add-to-todo)
+ (define-key ctl-x-4-map "s" #'shadow-copy-files)))
(defun shadowfile-unload-function ()
- (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map)
- (when (fboundp 'shadow-orig-save-buffers-kill-emacs)
- (fset 'save-buffers-kill-emacs
- (symbol-function 'shadow-orig-save-buffers-kill-emacs)))
+ (substitute-key-definition #'shadow-copy-files nil ctl-x-4-map)
+ (advice-remove 'save-buffers-kill-emacs #'shadow--save-buffers-kill-emacs)
;; continue standard unloading
nil)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Obsolete
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun shadow-union (a b)
+ "Add members of list A to list B if not equal to items already in B."
+ (declare (obsolete cl-union "28.1"))
+ (nreverse (cl-union a b :test #'equal)))
+
+(define-obsolete-function-alias 'shadow-find #'seq-find "28.1")
+
(provide 'shadowfile)
;;; shadowfile.el ends here
diff --git a/lisp/shell.el b/lisp/shell.el
index 32128241655..5cdc0385a6f 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -110,11 +110,6 @@
"Directory support in shell mode."
:group 'shell)
-;; Unused.
-;;; (defgroup shell-faces nil
-;;; "Faces in shell buffers."
-;;; :group 'shell)
-
;;;###autoload
(defcustom shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe")
"Regexp to match shells that don't save their command history, and
@@ -326,6 +321,15 @@ Thus, this does not include the shell's current directory.")
(defvar shell-dirstack-query nil
"Command used by `shell-resync-dirs' to query the shell.")
+(defcustom shell-has-auto-cd nil
+ "If non-nil, `shell-mode' handles implicit \"cd\" commands.
+Implicit \"cd\" is changing the directory if the command is a directory.
+You can make this variable buffer-local to change it, per shell-mode instance.
+Useful for shells like zsh that has this feature."
+ :type 'boolean
+ :group 'shell-directories
+ :version "28.1")
+
(defvar shell-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-f" 'shell-forward-command)
@@ -455,6 +459,16 @@ Thus, this does not include the shell's current directory.")
(push (mapconcat #'identity (nreverse arg) "") args)))
(cons (nreverse args) (nreverse begins)))))
+;;;###autoload
+(defun split-string-shell-command (string)
+ "Split STRING (a shell command) into a list of strings.
+General shell syntax, like single and double quoting, as well as
+backslash quoting, is respected."
+ (with-temp-buffer
+ (insert string)
+ (let ((comint-file-name-quote-list shell-file-name-quote-list))
+ (car (shell--parse-pcomplete-arguments)))))
+
(defun shell-command-completion-function ()
"Completion function for shell command names.
This is the value of `pcomplete-command-completion-function' for
@@ -463,7 +477,7 @@ Shell buffers. It implements `shell-completion-execonly' for
(if (pcomplete-match "/")
(pcomplete-here (pcomplete-entries nil
(if shell-completion-execonly
- 'file-executable-p)))
+ #'file-executable-p)))
(pcomplete-here
(nth 2 (shell--command-completion-data)))))
@@ -556,8 +570,7 @@ Variables `comint-output-filter-functions', a hook, and
`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
control whether input and output cause the window to scroll to the end of the
buffer."
- (when (called-interactively-p 'any)
- (error "Can't be called interactively; did you mean `shell-script-mode' instead?"))
+ :interactive nil
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
(setq-local paragraph-separate "\\'")
@@ -744,7 +757,7 @@ Make the shell buffer the current buffer, and return it.
(current-buffer)))
;; The buffer's window must be correctly set when we call comint
;; (so that comint sets the COLUMNS env var properly).
- (pop-to-buffer buffer)
+ (pop-to-buffer-same-window buffer)
(with-connection-local-variables
;; On remote hosts, the local `shell-file-name' might be useless.
@@ -756,7 +769,8 @@ Make the shell buffer the current buffer, and return it.
(file-local-name
(expand-file-name
(read-file-name "Remote shell path: " default-directory
- shell-file-name t shell-file-name)))))
+ shell-file-name t shell-file-name
+ #'file-remote-p)))))
;; Rain or shine, BUFFER must be current by now.
(unless (comint-check-proc buffer)
@@ -842,13 +856,15 @@ Environment variables are expanded, see function `substitute-in-file-name'."
str) ; skip whitespace
(match-end 0)))
(case-fold-search)
- end cmd arg1)
+ end cmd arg1 cmd-subst-fn)
(while (string-match shell-command-regexp str start)
(setq end (match-end 0)
cmd (comint-arguments (substring str start end) 0 0)
arg1 (comint-arguments (substring str start end) 1 1))
(if arg1
(setq arg1 (shell-unquote-argument arg1)))
+ (if shell-has-auto-cd
+ (setq cmd-subst-fn (comint-substitute-in-file-name cmd)))
(cond ((string-match (concat "\\`\\(" shell-popd-regexp
"\\)\\($\\|[ \t]\\)")
cmd)
@@ -865,7 +881,9 @@ Environment variables are expanded, see function `substitute-in-file-name'."
(string-match (concat "\\`\\(" shell-chdrive-regexp
"\\)\\($\\|[ \t]\\)")
cmd))
- (shell-process-cd (comint-substitute-in-file-name cmd))))
+ (shell-process-cd (comint-substitute-in-file-name cmd)))
+ ((and shell-has-auto-cd (file-directory-p cmd-subst-fn))
+ (shell-process-cd cmd-subst-fn)))
(setq start (progn (string-match shell-command-separator-regexp
str end)
;; skip again
@@ -986,7 +1004,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
The `dirtrack' package provides an alternative implementation of
this feature; see the function `dirtrack-mode'."
- nil nil nil
+ :lighter nil
(setq list-buffers-directory (if shell-dirtrack-mode default-directory))
(if shell-dirtrack-mode
(add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t)
@@ -1181,7 +1199,7 @@ Returns t if successful."
(if data
(prog2 (unless (window-minibuffer-p)
(message "Completing command name..."))
- (apply #'completion-in-region data)))))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))))
(defun shell-command-completion ()
"Return the completion data for the command at point, if any."
@@ -1234,7 +1252,7 @@ Returns t if successful."
(list
start end
(lambda (string pred action)
- (if (string-match "/" string)
+ (if (string-search "/" string)
(completion-file-name-table string pred action)
(complete-with-action action completions string pred)))
:exit-function
@@ -1296,7 +1314,7 @@ Returns non-nil if successful."
(if data
(prog2 (unless (window-minibuffer-p)
(message "Completing variable name..."))
- (apply #'completion-in-region data)))))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))))
(defun shell-environment-variable-completion ()
@@ -1310,7 +1328,7 @@ Returns non-nil if successful."
(looking-at "\\$?[({]*")
(match-end 0)))
(variables (mapcar (lambda (x)
- (substring x 0 (string-match "=" x)))
+ (substring x 0 (string-search "=" x)))
process-environment))
(suffix (pcase (char-before start) (?\{ "}") (?\( ")") (_ ""))))
(list start end variables
diff --git a/lisp/simple.el b/lisp/simple.el
index 568debaa612..7da315e8692 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -138,6 +138,10 @@ messages are highlighted; this helps to see what messages were visited."
nil
"Overlay highlighting the current error message in the `next-error' buffer.")
+(defvar global-minor-modes nil
+ "A list of the currently enabled global minor modes.
+This is a list of symbols.")
+
(defcustom next-error-hook nil
"List of hook functions run by `next-error' after visiting source file."
:type 'hook
@@ -186,7 +190,7 @@ to navigate in it.")
It takes two arguments, a buffer position in the error buffer
and a buffer position in the error locus buffer.
The buffer for the error locus should already be current.
-nil means use goto-char using the second argument position.")
+nil means use `goto-char' using the second argument position.")
(defsubst next-error-buffer-p (buffer
&optional avoid-current
@@ -234,15 +238,6 @@ all other buffers."
:group 'next-error
:version "28.1")
-(defcustom next-error-found-function #'ignore
- "Function called when a next locus is found and displayed.
-Function is called with two arguments: a FROM-BUFFER buffer
-from which next-error navigated, and a target buffer TO-BUFFER."
- :type '(choice (const :tag "No default" ignore)
- (function :tag "Other function"))
- :group 'next-error
- :version "27.1")
-
(defun next-error-buffer-on-selected-frame (&optional _avoid-current
extra-test-inclusive
extra-test-exclusive)
@@ -382,9 +377,29 @@ To control which errors are matched, customize the variable
(not (eq prev next-error-last-buffer)))
(message "Current locus from %s" next-error-last-buffer)))))
+(defun next-error-quit-window (from-buffer to-buffer)
+ "Quit window of FROM-BUFFER when the prefix arg is 0.
+Intended to be used in `next-error-found-function'."
+ (when (and (eq current-prefix-arg 0) from-buffer
+ (not (eq from-buffer to-buffer)))
+ (let ((window (get-buffer-window from-buffer)))
+ (when (window-live-p window)
+ (quit-restore-window window)))))
+
+(defcustom next-error-found-function #'ignore
+ "Function called when a next locus is found and displayed.
+Function is called with two arguments: a FROM-BUFFER buffer
+from which `next-error' navigated, and a target buffer TO-BUFFER."
+ :type '(choice (const :tag "No default" ignore)
+ (const :tag "Quit previous window with M-0"
+ next-error-quit-window)
+ (function :tag "Other function"))
+ :group 'next-error
+ :version "27.1")
+
(defun next-error-found (&optional from-buffer to-buffer)
"Function to call when the next locus is found and displayed.
-FROM-BUFFER is a buffer from which next-error navigated,
+FROM-BUFFER is a buffer from which `next-error' navigated,
and TO-BUFFER is a target buffer."
(setq next-error-last-buffer (or from-buffer (current-buffer)))
(when to-buffer
@@ -545,7 +560,7 @@ It must be called via `run-hook-with-args-until-success' with no arguments.
If any function on this hook returns a non-nil value, `delete-selection-mode'
will act on that value (see `delete-selection-helper') and will
usually delete the region. If all the functions on this hook return
-nil, it is an indiction that `self-insert-command' needs the region
+nil, it is an indication that `self-insert-command' needs the region
untouched by `delete-selection-mode' and will itself do whatever is
appropriate with the region.
Any function on `post-self-insert-hook' that acts on the region should
@@ -582,10 +597,12 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
;; Don't auto-fill if we have a prefix argument.
(auto-fill-function (if arg nil auto-fill-function))
(arg (prefix-numeric-value arg))
+ (procsym (make-symbol "newline-postproc")) ;(bug#46326)
(postproc
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
+ (remove-hook 'post-self-insert-hook procsym t)
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
@@ -604,6 +621,7 @@ 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)))))
+ (fset procsym postproc)
(if (not interactive)
;; FIXME: For non-interactive uses, many calls actually
;; just want (insert "\n"), so maybe we should do just
@@ -613,13 +631,13 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
(self-insert-command arg))
(unwind-protect
(progn
- (add-hook 'post-self-insert-hook postproc nil t)
+ (add-hook 'post-self-insert-hook procsym 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
;; protect only the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc t))))
+ (remove-hook 'post-self-insert-hook procsym t))))
nil)
(defun set-hard-newline-properties (from to)
@@ -677,6 +695,30 @@ When called from Lisp code, ARG may be a prefix string to copy."
(indent-to col 0)
(goto-char pos)))
+(defface separator-line
+ '((((type graphic) (background dark))
+ :height 0.1 :background "#505050")
+ (((type graphic) (background light))
+ :height 0.1 :background "#a0a0a0")
+ (t :foreground "ForestGreen"))
+ "Face for separator lines."
+ :version "28.1"
+ :group 'text)
+
+(defun make-separator-line (&optional length)
+ "Make a string appropriate for usage as a visual separator line.
+This uses the `separator-line' face.
+
+If LENGTH is nil, use the window width."
+ (if (display-graphic-p)
+ (if length
+ (concat (propertize (make-string length ?\s) 'face 'separator-line)
+ "\n")
+ (propertize "\n" 'face '(:inherit separator-line :extend t)))
+ (concat (propertize (make-string (or length (1- (window-width))) ?-)
+ 'face 'separator-line)
+ "\n")))
+
(defun delete-indentation (&optional arg beg end)
"Join this line to previous and fix up whitespace at join.
If there is a fill prefix, delete it from the beginning of this
@@ -821,7 +863,10 @@ In programming language modes, this is the same as TAB.
In some text modes, where TAB inserts a tab, this command indents to the
column specified by the function `current-left-margin'.
-With ARG, perform this action that many times."
+With ARG, perform this action that many times.
+
+Also see `open-line' (bound to \\[open-line]) for a command that
+just inserts a newline without doing any indentation."
(interactive "*p")
(delete-horizontal-space t)
(unless arg
@@ -1274,7 +1319,19 @@ that uses or sets the mark."
;; Counting lines, one way or another.
-(defvar-local goto-line-history nil
+(defcustom goto-line-history-local nil
+ "If this option is nil, `goto-line-history' is shared between all buffers.
+If it is non-nil, each buffer has its own value of this history list.
+
+Note that on changing from non-nil to nil, the former contents of
+`goto-line-history' for each buffer are discarded on use of
+`goto-line' in that buffer."
+ :group 'editing
+ :type 'boolean
+ :safe #'booleanp
+ :version "28.1")
+
+(defvar goto-line-history nil
"History of values entered with `goto-line'.")
(defun goto-line-read-args (&optional relative)
@@ -1292,6 +1349,11 @@ that uses or sets the mark."
(if buffer
(concat " in " (buffer-name buffer))
"")))
+ ;; Has the buffer locality of `goto-line-history' changed?
+ (cond ((and goto-line-history-local (not (local-variable-p 'goto-line-history)))
+ (make-local-variable 'goto-line-history))
+ ((and (not goto-line-history-local) (local-variable-p 'goto-line-history))
+ (kill-local-variable 'goto-line-history)))
;; Read the argument, offering that number (if any) as default.
(list (read-number (format "Goto%s line%s: "
(if (buffer-narrowed-p)
@@ -1623,6 +1685,7 @@ in *Help* buffer. See also the command `describe-char'."
(define-key m "\t" 'completion-at-point)
(define-key m "\r" 'read--expression-try-read)
(define-key m "\n" 'read--expression-try-read)
+ (define-key m "\M-g\M-c" 'read-expression-switch-to-completions)
(set-keymap-parent m minibuffer-local-map)
m))
@@ -1765,8 +1828,8 @@ moving point."
(defun eval-expression-get-print-arguments (prefix-argument)
"Get arguments for commands that print an expression result.
-Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT)
-based on PREFIX-ARG. This function determines the interpretation
+Returns a list (INSERT-VALUE NO-TRUNCATE CHAR-PRINT-LIMIT) based
+on PREFIX-ARGUMENT. This function determines the interpretation
of the prefix argument for `eval-expression' and
`eval-last-sexp'."
(let ((num (prefix-numeric-value prefix-argument)))
@@ -1809,31 +1872,34 @@ this command arranges for all errors to enter the debugger."
(cons (read--expression "Eval: ")
(eval-expression-get-print-arguments current-prefix-arg)))
- (if (null eval-expression-debug-on-error)
- (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)
- values)
- (let ((old-value (make-symbol "t")) new-value)
- ;; Bind debug-on-error to something unique so that we can
- ;; detect when evalled code changes it.
- (let ((debug-on-error old-value))
- (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)
- values)
- (setq new-value debug-on-error))
- ;; If evalled code has changed the value of debug-on-error,
- ;; propagate that change to the global binding.
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))))
-
- (let ((print-length (unless no-truncate eval-expression-print-length))
- (print-level (unless no-truncate eval-expression-print-level))
- (eval-expression-print-maximum-character char-print-limit)
- (deactivate-mark))
- (let ((out (if insert-value (current-buffer) t)))
- (prog1
- (prin1 (car values) out)
- (let ((str (and char-print-limit
- (eval-expression-print-format (car values)))))
- (when str (princ str out)))))))
+ (let (result)
+ (if (null eval-expression-debug-on-error)
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evalled code changes it.
+ (let ((debug-on-error old-value))
+ (setq result
+ (values--store-value
+ (eval (let ((lexical-binding t)) (macroexpand-all exp)) t)))
+ (setq new-value debug-on-error))
+ ;; If evalled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
+ (let ((print-length (unless no-truncate eval-expression-print-length))
+ (print-level (unless no-truncate eval-expression-print-level))
+ (eval-expression-print-maximum-character char-print-limit)
+ (deactivate-mark))
+ (let ((out (if insert-value (current-buffer) t)))
+ (prog1
+ (prin1 result out)
+ (let ((str (and char-print-limit
+ (eval-expression-print-format result))))
+ (when str (princ str out))))))))
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
@@ -1897,55 +1963,160 @@ to get different commands to edit and resubmit."
(defvar extended-command-history nil)
(defvar execute-extended-command--last-typed nil)
+(defcustom read-extended-command-predicate nil
+ "Predicate to use to determine which commands to include when completing.
+If it's nil, include all the commands.
+If it's a function, it will be called with two parameters: the
+symbol of the command and a buffer. The predicate should return
+non-nil if the command should be present when doing `M-x TAB'
+in that buffer."
+ :version "28.1"
+ :group 'completion
+ :type '(choice (const :tag "Don't exclude any commands" nil)
+ (const :tag "Exclude commands irrelevant to current buffer's mode"
+ command-completion-default-include-p)
+ (function :tag "Other function")))
+
(defun read-extended-command ()
- "Read command name to invoke in `execute-extended-command'."
- (minibuffer-with-setup-hook
- (lambda ()
- (add-hook 'post-self-insert-hook
- (lambda ()
- (setq execute-extended-command--last-typed
- (minibuffer-contents)))
- nil 'local)
- (setq-local minibuffer-default-add-function
- (lambda ()
- ;; Get a command name at point in the original buffer
- ;; to propose it after M-n.
- (let ((def (with-current-buffer
- (window-buffer (minibuffer-selected-window))
- (and (commandp (function-called-at-point))
- (format "%S" (function-called-at-point)))))
- (all (sort (minibuffer-default-add-completions)
- #'string<)))
- (if def
- (cons def (delete def all))
- all)))))
- ;; Read a string, completing from and restricting to the set of
- ;; all defined commands. Don't provide any initial input.
- ;; Save the command read on the extended-command history list.
- (completing-read
- (concat (cond
- ((eq current-prefix-arg '-) "- ")
- ((and (consp current-prefix-arg)
- (eq (car current-prefix-arg) 4)) "C-u ")
- ((and (consp current-prefix-arg)
- (integerp (car current-prefix-arg)))
- (format "%d " (car current-prefix-arg)))
- ((integerp current-prefix-arg)
- (format "%d " current-prefix-arg)))
- ;; This isn't strictly correct if `execute-extended-command'
- ;; is bound to anything else (e.g. [menu]).
- ;; It could use (key-description (this-single-command-keys)),
- ;; but actually a prompt other than "M-x" would be confusing,
- ;; because "M-x" is a well-known prompt to read a command
- ;; and it serves as a shorthand for "Extended command: ".
- "M-x ")
- (lambda (string pred action)
- (if (and suggest-key-bindings (eq action 'metadata))
- '(metadata
- (affixation-function . read-extended-command--affixation)
- (category . command))
- (complete-with-action action obarray string pred)))
- #'commandp t nil 'extended-command-history)))
+ "Read command name to invoke in `execute-extended-command'.
+This function uses the `read-extended-command-predicate' user option."
+ (let ((buffer (current-buffer)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'post-self-insert-hook
+ (lambda ()
+ (setq execute-extended-command--last-typed
+ (minibuffer-contents)))
+ nil 'local)
+ (setq-local minibuffer-default-add-function
+ (lambda ()
+ ;; Get a command name at point in the original buffer
+ ;; to propose it after M-n.
+ (let ((def
+ (with-current-buffer
+ (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format
+ "%S" (function-called-at-point)))))
+ (all (sort (minibuffer-default-add-completions)
+ #'string<)))
+ (if def
+ (cons def (delete def all))
+ all)))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Don't provide any initial input.
+ ;; Save the command read on the extended-command history list.
+ (completing-read
+ (concat (cond
+ ((eq current-prefix-arg '-) "- ")
+ ((and (consp current-prefix-arg)
+ (eq (car current-prefix-arg) 4))
+ "C-u ")
+ ((and (consp current-prefix-arg)
+ (integerp (car current-prefix-arg)))
+ (format "%d " (car current-prefix-arg)))
+ ((integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)))
+ ;; This isn't strictly correct if `execute-extended-command'
+ ;; is bound to anything else (e.g. [menu]).
+ ;; It could use (key-description (this-single-command-keys)),
+ ;; but actually a prompt other than "M-x" would be confusing,
+ ;; because "M-x" is a well-known prompt to read a command
+ ;; and it serves as a shorthand for "Extended command: ".
+ (if (memq 'shift (event-modifiers last-command-event))
+ "M-X "
+ "M-x "))
+ (lambda (string pred action)
+ (if (and suggest-key-bindings (eq action 'metadata))
+ '(metadata
+ (affixation-function . read-extended-command--affixation)
+ (category . command))
+ (let ((pred
+ (if (memq action '(nil t))
+ ;; Exclude from completions obsolete commands
+ ;; lacking a `current-name', or where `when' is
+ ;; not the current major version.
+ (lambda (sym)
+ (let ((obsolete (get sym 'byte-obsolete-info)))
+ (and (funcall pred sym)
+ (or (equal string (symbol-name sym))
+ (not obsolete)
+ (and
+ ;; Has a current-name.
+ (functionp (car obsolete))
+ ;; when >= emacs-major-version
+ (condition-case nil
+ (>= (car (version-to-list
+ (caddr obsolete)))
+ emacs-major-version)
+ ;; If the obsoletion version isn't
+ ;; valid, include the command.
+ (error t)))))))
+ pred)))
+ (complete-with-action action obarray string pred))))
+ (lambda (sym)
+ (and (commandp sym)
+ (cond ((null read-extended-command-predicate))
+ ((functionp read-extended-command-predicate)
+ ;; Don't let bugs break M-x completion; interpret
+ ;; them as the absence of a predicate.
+ (condition-case-unless-debug err
+ (funcall read-extended-command-predicate sym buffer)
+ (error (message "read-extended-command-predicate: %s: %s"
+ sym (error-message-string err))))))))
+ t nil 'extended-command-history))))
+
+(defun command-completion-using-modes-p (symbol buffer)
+ "Say whether SYMBOL has been marked as a mode-specific command in BUFFER."
+ ;; Check the modes.
+ (let ((modes (command-modes symbol)))
+ ;; Common case: Just a single mode.
+ (if (null (cdr modes))
+ (or (provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer) (car modes))
+ (memq (car modes)
+ (buffer-local-value 'local-minor-modes buffer))
+ (memq (car modes) global-minor-modes))
+ ;; Uncommon case: Multiple modes.
+ (apply #'provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ modes)
+ (seq-intersection modes
+ (buffer-local-value 'local-minor-modes buffer)
+ #'eq)
+ (seq-intersection modes global-minor-modes #'eq))))
+
+(defun command-completion-default-include-p (symbol buffer)
+ "Say whether SYMBOL should be offered as a completion.
+If there's a `completion-predicate' for SYMBOL, the result from
+calling that predicate is called. If there isn't one, this
+predicate is true if the command SYMBOL is applicable to the
+major mode in BUFFER, or any of the active minor modes in
+BUFFER."
+ (if (get symbol 'completion-predicate)
+ ;; An explicit completion predicate takes precedence.
+ (funcall (get symbol 'completion-predicate) symbol buffer)
+ (or (null (command-modes symbol))
+ (command-completion-using-modes-p symbol buffer))))
+
+(defun command-completion-with-modes-p (modes buffer)
+ "Say whether MODES are in action in BUFFER.
+This is the case if either the major mode is derived from one of MODES,
+or (if one of MODES is a minor mode), if it is switched on in BUFFER."
+ (or (apply #'provided-mode-derived-p
+ (buffer-local-value 'major-mode buffer)
+ modes)
+ ;; It's a minor mode.
+ (seq-intersection modes
+ (buffer-local-value 'local-minor-modes buffer)
+ #'eq)
+ (seq-intersection modes global-minor-modes #'eq)))
+
+(defun command-completion-button-p (category buffer)
+ "Return non-nil if there's a button of CATEGORY at point in BUFFER."
+ (with-current-buffer buffer
+ (and (get-text-property (point) 'button)
+ (eq (get-text-property (point) 'category) category))))
(defun read-extended-command--affixation (command-names)
(with-selected-window (or (minibuffer-selected-window) (selected-window))
@@ -1960,8 +2131,11 @@ to get different commands to edit and resubmit."
(obsolete
(format " (%s)" (car obsolete)))
((and binding (not (stringp binding)))
- (format " (%s)" (key-description binding))))))
- (if suffix (list command-name suffix) command-name)))
+ (format " (%s)" (key-description binding)))
+ (t ""))))
+ (put-text-property 0 (length suffix)
+ 'face 'completions-annotations suffix)
+ (list command-name "" suffix)))
command-names)))
(defcustom suggest-key-bindings t
@@ -2020,6 +2194,8 @@ Also see `suggest-key-bindings'."
(setq binding candidate))))
binding))
+(defvar execute-extended-command--binding-timer nil)
+
(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
@@ -2084,15 +2260,56 @@ invoking, give a prefix argument to `execute-extended-command'."
(setq binding (execute-extended-command--shorter
(symbol-name function) typed))))
(when binding
- (with-temp-message
- (format-message "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
- (sit-for (if (numberp suggest-key-bindings)
- suggest-key-bindings
- 2))))))))
+ ;; This is normally not necessary -- the timer should run
+ ;; immediately, but be defensive and ensure that we never
+ ;; have two of these timers in flight.
+ (when execute-extended-command--binding-timer
+ (cancel-timer execute-extended-command--binding-timer))
+ (setq execute-extended-command--binding-timer
+ (run-at-time
+ 0 nil
+ (lambda ()
+ (with-temp-message
+ (format-message "You can run the command `%s' with %s"
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
+ (sit-for (if (numberp suggest-key-bindings)
+ suggest-key-bindings
+ 2)))))))))))
+
+(defun execute-extended-command-for-buffer (prefixarg &optional
+ command-name typed)
+ "Query user for a command relevant for the current mode, and then execute it.
+This is like `execute-extended-command', but it limits the
+completions to commands that are particularly relevant to the
+current buffer. This includes commands that have been marked as
+being specially designed for the current major mode (and enabled
+minor modes), as well as commands bound in the active local key
+maps."
+ (declare (interactive-only command-execute))
+ (interactive
+ (let* ((execute-extended-command--last-typed nil)
+ (keymaps
+ ;; The major mode's keymap and any active minor modes.
+ (cons
+ (current-local-map)
+ (mapcar
+ #'cdr
+ (seq-filter
+ (lambda (elem)
+ (symbol-value (car elem)))
+ minor-mode-map-alist))))
+ (read-extended-command-predicate
+ (lambda (symbol buffer)
+ (or (command-completion-using-modes-p symbol buffer)
+ (where-is-internal symbol keymaps)))))
+ (list current-prefix-arg
+ (read-extended-command)
+ execute-extended-command--last-typed)))
+ (with-suppressed-warnings ((interactive-only execute-extended-command))
+ (execute-extended-command prefixarg command-name typed)))
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
@@ -2646,7 +2863,6 @@ or to the last history element for a backward search."
(if isearch-forward
(goto-history-element (length (minibuffer-history-value)))
(goto-history-element 0))
- (setq isearch-success t)
(goto-char (if isearch-forward (minibuffer-prompt-end) (point-max))))
(defun minibuffer-history-isearch-push-state ()
@@ -2674,8 +2890,10 @@ Go to the history element by the absolute history position HIST-POS."
The same as `command-error-default-function' but display error messages
at the end of the minibuffer using `minibuffer-message' to not obscure
the minibuffer contents."
- (discard-input)
- (ding)
+ (if (memq 'minibuffer-quit (get (car data) 'error-conditions))
+ (ding t)
+ (discard-input)
+ (ding))
(let ((string (error-message-string data)))
;; If we know from where the error was signaled, show it in
;; *Messages*.
@@ -2691,8 +2909,35 @@ the minibuffer contents."
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
-A redo record for undo-in-region maps to t.
-A redo record for ordinary undo maps to the following (earlier) undo.")
+A redo record for an undo in region maps to 'undo-in-region.
+A redo record for ordinary undo maps to the following (earlier) undo.
+A redo record that undoes to the beginning of the undo list maps to t.
+In the rare case where there are (erroneously) consecutive nil's in
+`buffer-undo-list', `undo' maps the previous valid undo record to
+'empty, if the previous record is a redo record, `undo' doesn't change
+its mapping.
+
+To be clear, a redo record is just an undo record, the only difference
+is that it is created by an undo command (instead of an ordinary buffer
+edit). Since a record used to undo ordinary change is called undo
+record, a record used to undo an undo is called redo record.
+
+`undo' uses this table to make sure the previous command is `undo'.
+`undo-redo' uses this table to set the correct `pending-undo-list'.
+
+When you undo, `pending-undo-list' shrinks and `buffer-undo-list'
+grows, and Emacs maps the tip of `buffer-undo-list' to the tip of
+`pending-undo-list' in this table.
+
+For example, consider this undo list where each node represents an
+undo record: if we undo from 4, `pending-undo-list' will be at 3,
+`buffer-undo-list' at 5, and 5 will map to 3.
+
+ |
+ 3 5
+ | /
+ |/
+ 4")
(defvar undo-in-region nil
"Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
@@ -2739,7 +2984,9 @@ as an argument limits undo to changes within the current region."
;; the next command should not be a "consecutive undo".
;; So set `this-command' to something other than `undo'.
(setq this-command 'undo-start)
-
+ ;; Here we decide whether to break the undo chain. If the
+ ;; previous command is `undo', we don't call `undo-start', i.e.,
+ ;; don't break the undo chain.
(unless (and (eq last-command 'undo)
(or (eq pending-undo-list t)
;; If something (a timer or filter?) changed the buffer
@@ -2768,7 +3015,7 @@ as an argument limits undo to changes within the current region."
;; undo-redo-undo-redo-... so skip to the very last equiv.
(while (let ((next (gethash equiv undo-equiv-table)))
(if next (setq equiv next))))
- (setq pending-undo-list equiv)))
+ (setq pending-undo-list (if (consp equiv) equiv t))))
(undo-more
(if (numberp arg)
(prefix-numeric-value arg)
@@ -2784,11 +3031,17 @@ as an argument limits undo to changes within the current region."
(while (eq (car list) nil)
(setq list (cdr list)))
(puthash list
- ;; Prevent identity mapping. This can happen if
- ;; consecutive nils are erroneously in undo list.
- (if (or undo-in-region (eq list pending-undo-list))
- t
- pending-undo-list)
+ (cond
+ (undo-in-region 'undo-in-region)
+ ;; Prevent identity mapping. This can happen if
+ ;; consecutive nils are erroneously in undo list. It
+ ;; has to map to _something_ so that the next `undo'
+ ;; command recognizes that the previous command is
+ ;; `undo' and doesn't break the undo chain.
+ ((eq list pending-undo-list)
+ (or (gethash list undo-equiv-table)
+ 'empty))
+ (t pending-undo-list))
undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
@@ -2910,8 +3163,7 @@ Return what remains of the list."
(and (consp time)
(equal (list (car time) (cdr time))
(visited-file-modtime))))
- (when (fboundp 'unlock-buffer)
- (unlock-buffer))
+ (unlock-buffer)
(set-buffer-modified-p nil)))
;; Element (nil PROP VAL BEG . END) is property change.
(`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
@@ -3102,7 +3354,7 @@ list can be applied to the current buffer."
undo-elt)
(while ulist
(when undo-no-redo
- (while (gethash ulist undo-equiv-table)
+ (while (consp (gethash ulist undo-equiv-table))
(setq ulist (gethash ulist undo-equiv-table))))
(setq undo-elt (car ulist))
(cond
@@ -3188,8 +3440,7 @@ is not *inside* the region START...END."
(> (cdr undo-elt) start)))))
(defun undo-adjust-elt (elt deltas)
- "Return adjustment of undo element ELT by the undo DELTAS
-list."
+ "Return adjustment of undo element ELT by the undo DELTAS list."
(pcase elt
;; POSITION
((pred integerp)
@@ -3233,8 +3484,7 @@ list."
;; There was no strong reason to prefer one or the other, except that
;; the first is more consistent with prior undo in region behavior.
(defun undo-adjust-beg-end (beg end deltas)
- "Return cons of adjustments to BEG and END by the undo DELTAS
-list."
+ "Return cons of adjustments to BEG and END by the undo DELTAS list."
(let ((adj-beg (undo-adjust-pos beg deltas)))
;; Note: option 2 above would be like (cons (min ...) adj-end)
(cons adj-beg
@@ -4004,12 +4254,22 @@ impose the use of a shell (with its need to quote arguments)."
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
+(defun max-mini-window-lines (&optional frame)
+ "Compute maximum number of lines for echo area in FRAME.
+As defined by `max-mini-window-height'. FRAME defaults to the
+selected frame. Result may be a floating-point number,
+i.e. include a fractional number of lines."
+ (cond ((floatp max-mini-window-height) (* (frame-height frame)
+ max-mini-window-height))
+ ((integerp max-mini-window-height) max-mini-window-height)
+ (t 1)))
+
(defun display-message-or-buffer (message &optional buffer-name action frame)
"Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
MESSAGE may be either a string or a buffer.
A pop-up buffer is displayed using `display-buffer' if MESSAGE is too long
-for maximum height of the echo area, as defined by `max-mini-window-height'
+for maximum height of the echo area, as defined by `max-mini-window-lines'
if `resize-mini-windows' is non-nil.
Returns either the string shown in the echo area, or when a pop-up
@@ -4023,11 +4283,11 @@ the contents are inserted into the buffer anyway.
Optional arguments ACTION and FRAME are as for `display-buffer',
and are used only if a pop-up buffer is displayed."
- (cond ((and (stringp message) (not (string-match "\n" message)))
+ (cond ((and (stringp message) (not (string-search "\n" message)))
;; Trivial case where we can use the echo area
(message "%s" message))
((and (stringp message)
- (= (string-match "\n" message) (1- (length message))))
+ (= (string-search "\n" message) (1- (length message))))
;; Trivial case where we can just remove single trailing newline
(message "%s" (substring message 0 (1- (length message)))))
(t
@@ -4048,14 +4308,7 @@ and are used only if a pop-up buffer is displayed."
(cond ((= lines 0))
((and (or (<= lines 1)
(<= lines
- (if resize-mini-windows
- (cond ((floatp max-mini-window-height)
- (* (frame-height)
- max-mini-window-height))
- ((integerp max-mini-window-height)
- max-mini-window-height)
- (t
- 1))
+ (if resize-mini-windows (max-mini-window-lines)
1)))
;; Don't use the echo area if the output buffer is
;; already displayed in the selected frame.
@@ -4121,7 +4374,7 @@ current buffer after START.
Optional fifth arg REPLACE, if non-nil, means to insert the
output in place of text from START to END, putting point and mark
-around it.
+around it. If REPLACE is the symbol `no-mark', don't set the mark.
Optional sixth arg ERROR-BUFFER, if non-nil, specifies a buffer
or buffer name to which to direct the command's standard error
@@ -4196,7 +4449,9 @@ characters."
(let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
- (and replace (push-mark (point) 'nomsg))
+ (when (and replace
+ (not (eq replace 'no-mark)))
+ (push-mark (point) 'nomsg))
(setq exit-status
(call-shell-region start end command replace
(if error-file
@@ -4207,7 +4462,9 @@ characters."
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
- (and replace swap (exchange-point-and-mark)))
+ (when (and replace swap
+ (not (eq replace 'no-mark)))
+ (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
(let ((buffer (get-buffer-create
@@ -4537,7 +4794,7 @@ see other processes running on the system, use `list-system-processes'."
(setq prefix-command--last-echo
(let ((strs nil))
(run-hook-wrapped 'prefix-command-echo-keystrokes-functions
- (lambda (fun) (push (funcall fun) strs)))
+ (lambda (fun) (push (funcall fun) strs) nil))
(setq strs (delq nil strs))
(when strs (mapconcat #'identity strs " "))))))
@@ -4817,12 +5074,19 @@ ring directly.")
"The tail of the kill ring whose car is the last thing yanked.")
(defcustom save-interprogram-paste-before-kill nil
- "Save existing clipboard text into kill ring before replacing it.
-A non-nil value ensures that Emacs kill operations do not
-irrevocably overwrite existing clipboard text by saving it to the
-`kill-ring' prior to the kill. Such text can subsequently be
-retrieved via \\[yank] \\[yank-pop]."
- :type 'boolean
+ "Whether to save existing clipboard text into kill ring before replacing it.
+A non-nil value means the clipboard text is saved to the `kill-ring'
+prior to any kill command. Such text can subsequently be retrieved
+via \\[yank] \\[yank-pop]. This ensures that Emacs kill operations
+do not irrevocably overwrite existing clipboard text.
+
+The value of this variable can also be a number, in which case the
+clipboard data is only saved to the `kill-ring' if it's shorter
+(in characters) than that number. Any other non-nil value will save
+the clipboard data unconditionally."
+ :type '(choice (const nil)
+ number
+ (other :tag "Always" t))
:group 'killing
:version "23.2")
@@ -4833,6 +5097,16 @@ The comparison is done using `equal-including-properties'."
:group 'killing
:version "23.2")
+(defcustom kill-transform-function nil
+ "Function to call to transform a string before it's put on the kill ring.
+The function is called with one parameter (the string that's to
+be put on the kill ring). It should return a string or nil. If
+the latter, the string is not put on the kill ring."
+ :type '(choice (const :tag "No transform" nil)
+ function)
+ :group 'killing
+ :version "28.1")
+
(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
@@ -4848,33 +5122,41 @@ When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
- (unless (and kill-do-not-save-duplicates
- ;; Due to text properties such as 'yank-handler that
- ;; can alter the contents to yank, comparison using
- ;; `equal' is unsafe.
- (equal-including-properties string (car kill-ring)))
- (if (fboundp 'menu-bar-update-yank-menu)
- (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
- (when save-interprogram-paste-before-kill
- (let ((interprogram-paste (and interprogram-paste-function
- (funcall interprogram-paste-function))))
- (when interprogram-paste
- (dolist (s (if (listp interprogram-paste)
- ;; Use `reverse' to avoid modifying external data.
- (reverse interprogram-paste)
- (list interprogram-paste)))
- (unless (and kill-do-not-save-duplicates
- (equal-including-properties s (car kill-ring)))
- (push s kill-ring))))))
- (unless (and kill-do-not-save-duplicates
- (equal-including-properties string (car kill-ring)))
- (if (and replace kill-ring)
- (setcar kill-ring string)
- (let ((history-delete-duplicates nil))
- (add-to-history 'kill-ring string kill-ring-max t))))
- (setq kill-ring-yank-pointer kill-ring)
- (if interprogram-cut-function
- (funcall interprogram-cut-function string)))
+ ;; Allow the user to transform or ignore the string.
+ (when (or (not kill-transform-function)
+ (setq string (funcall kill-transform-function string)))
+ (unless (and kill-do-not-save-duplicates
+ ;; Due to text properties such as 'yank-handler that
+ ;; can alter the contents to yank, comparison using
+ ;; `equal' is unsafe.
+ (equal-including-properties string (car kill-ring)))
+ (if (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
+ (when save-interprogram-paste-before-kill
+ (let ((interprogram-paste (and interprogram-paste-function
+ (funcall interprogram-paste-function))))
+ (when interprogram-paste
+ (setq interprogram-paste
+ (if (listp interprogram-paste)
+ ;; Use `reverse' to avoid modifying external data.
+ (reverse interprogram-paste)
+ (list interprogram-paste)))
+ (when (or (not (numberp save-interprogram-paste-before-kill))
+ (< (seq-reduce #'+ (mapcar #'length interprogram-paste) 0)
+ save-interprogram-paste-before-kill))
+ (dolist (s interprogram-paste)
+ (unless (and kill-do-not-save-duplicates
+ (equal-including-properties s (car kill-ring)))
+ (push s kill-ring)))))))
+ (unless (and kill-do-not-save-duplicates
+ (equal-including-properties string (car kill-ring)))
+ (if (and replace kill-ring)
+ (setcar kill-ring string)
+ (let ((history-delete-duplicates nil))
+ (add-to-history 'kill-ring string kill-ring-max t))))
+ (setq kill-ring-yank-pointer kill-ring)
+ (if interprogram-cut-function
+ (funcall interprogram-cut-function string))))
;; It has been argued that this should work like `self-insert-command'
;; which merges insertions in `buffer-undo-list' in groups of 20
@@ -5056,8 +5338,7 @@ region instead.
This command's old key binding has been given to `kill-ring-save'."
;; Pass mark first, then point, because the order matters when
;; calling `kill-append'.
- (interactive (list (mark) (point)
- (prefix-numeric-value current-prefix-arg)))
+ (interactive (list (mark) (point) 'region))
(let ((str (if region
(funcall region-extract-function nil)
(filter-buffer-substring beg end))))
@@ -5089,8 +5370,7 @@ This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
;; Pass mark first, then point, because the order matters when
;; calling `kill-append'.
- (interactive (list (mark) (point)
- (prefix-numeric-value current-prefix-arg)))
+ (interactive (list (mark) (point) 'region))
(copy-region-as-kill beg end region)
;; This use of called-interactively-p is correct because the code it
;; controls just gives the user visual feedback.
@@ -5356,29 +5636,29 @@ Normally set from the UNDO element of a yank-handler; see `insert-for-yank'.")
"Replace just-yanked stretch of killed text with a different stretch.
The main use of this command is immediately after a `yank' or a
`yank-pop'. At such a time, the region contains a stretch of
-reinserted previously-killed text. `yank-pop' deletes that text
-and inserts in its place a different stretch of killed text by
-traversing the value of the `kill-ring' variable.
+reinserted (\"pasted\") previously-killed text. `yank-pop' deletes
+that text and inserts in its place a different stretch of killed text
+by traversing the value of the `kill-ring' variable and selecting
+another kill from there.
With no argument, the previous kill is inserted.
With argument N, insert the Nth previous kill.
-If N is negative, this is a more recent kill.
+If N is negative, it means to use a more recent kill.
-The sequence of kills wraps around, so that after the oldest one
-comes the newest one.
+The sequence of kills wraps around, so if you keep invoking this command
+time after time, and pass the oldest kill, you get the newest one.
+
+You can also invoke this command after a command other than `yank'
+or `yank-pop'. This is the same as invoking `yank-from-kill-ring',
+including the effect of the prefix argument; see there for the details.
This command honors the `yank-handled-properties' and
`yank-excluded-properties' variables, and the `yank-handler' text
-property, in the way that `yank' does.
-
-When this command is called not immediately after a `yank' or a
-`yank-pop', then it activates the minibuffer with its completion
-and history filled with previously-killed items from the
-`kill-ring' variable, and reads a string to yank at point.
-See `yank-from-kill-ring' for more details."
+property, in the way that `yank' does."
(interactive "p")
(if (not (eq last-command 'yank))
- (yank-from-kill-ring (read-from-kill-ring) current-prefix-arg)
+ (yank-from-kill-ring (read-from-kill-ring "Yank from kill-ring: ")
+ current-prefix-arg)
(setq this-command 'yank)
(unless arg (setq arg 1))
(let ((inhibit-read-only t)
@@ -5467,11 +5747,15 @@ With ARG, rotate that many kills forward (or backward, if negative)."
(current-kill arg))
(defvar read-from-kill-ring-history)
-(defun read-from-kill-ring ()
- "Read a string from `kill-ring' using completion and minibuffer history."
+(defun read-from-kill-ring (prompt)
+ "Read a `kill-ring' entry using completion and minibuffer history.
+PROMPT is a string to prompt with."
;; `current-kill' updates `kill-ring' with a possible interprogram-paste
(current-kill 0)
(let* ((history-add-new-input nil)
+ (history-pos (when yank-from-kill-ring-rotate
+ (- (length kill-ring)
+ (length kill-ring-yank-pointer))))
(ellipsis (if (char-displayable-p ?…) "…" "..."))
;; Remove keymaps from text properties of copied string,
;; because typing RET in the minibuffer might call
@@ -5512,32 +5796,61 @@ With ARG, rotate that many kills forward (or backward, if negative)."
(define-key map "?" nil)
map)))
(completing-read
- "Yank from kill-ring: "
+ prompt
(lambda (string pred action)
(if (eq action 'metadata)
;; Keep sorted by recency
'(metadata (display-sort-function . identity))
(complete-with-action action completions string pred)))
nil nil nil
- 'read-from-kill-ring-history))))
+ (if history-pos
+ (cons 'read-from-kill-ring-history
+ (if (zerop history-pos) history-pos (1+ history-pos)))
+ 'read-from-kill-ring-history)))))
+
+(defcustom yank-from-kill-ring-rotate t
+ "Whether using `yank-from-kill-ring' should rotate `kill-ring-yank-pointer'.
+If non-nil, the kill ring is rotated after selecting previously killed text."
+ :type 'boolean
+ :group 'killing
+ :version "28.1")
(defun yank-from-kill-ring (string &optional arg)
- "Insert the `kill-ring' item selected from the minibuffer history.
-Use minibuffer navigation and search commands to browse the
-previously-killed items from the `kill-ring' variable in the
-minibuffer history before typing RET to insert the selected item,
-or use completion on the elements of `kill-ring'. You can edit
-the item in the minibuffer before inserting it.
-
-With \\[universal-argument] as argument, put point at beginning,
-and mark at end, like `yank' does."
- (interactive (list (read-from-kill-ring) current-prefix-arg))
+ "Select a stretch of previously killed text and insert (\"paste\") it.
+This command allows to choose one of the stretches of text killed
+or yanked by previous commands, which are recorded in `kill-ring',
+and reinsert the chosen kill at point.
+
+This command prompts for a previously-killed text in the minibuffer.
+Use the minibuffer history and search commands, or the minibuffer
+completion commands, to select a previously-killed text. In
+particular, typing \\<minibuffer-local-completion-map>\\[minibuffer-complete] at the prompt will pop up a buffer showing
+all the previously-killed stretches of text from which you can
+choose the one you want to reinsert.
+Once you select the text you want to reinsert, type \\<minibuffer-local-map>\\[exit-minibuffer] to actually
+insert it and exit the minibuffer.
+You can also edit the selected text in the minibuffer before
+inserting it.
+
+With \\[universal-argument] as argument, this command puts point at
+beginning of the inserted text and mark at the end, like `yank' does.
+
+When called from Lisp, insert STRING like `insert-for-yank' does."
+ (interactive (list (read-from-kill-ring "Yank from kill-ring: ")
+ current-prefix-arg))
+ (setq yank-window-start (window-start))
(push-mark)
(insert-for-yank string)
+ (when yank-from-kill-ring-rotate
+ (let ((pos (seq-position kill-ring string)))
+ (if pos
+ (setq kill-ring-yank-pointer (nthcdr pos kill-ring))
+ (kill-new string))))
(if (consp arg)
- ;; Swap point and mark like in `yank'.
+ ;; Swap point and mark like in `yank' and `yank-pop'.
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer))))))
+
;; Some kill commands.
@@ -5566,7 +5879,13 @@ Can be `untabify' -- turn a tab to many spaces, then delete one space;
(defun backward-delete-char-untabify (arg &optional killp)
"Delete characters backward, changing tabs into spaces.
The exact behavior depends on `backward-delete-char-untabify-method'.
+
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
+
+If Transient Mark mode is enabled, the mark is active, and ARG is 1,
+delete the text in the region and deactivate the mark instead.
+To disable this, set option ‘delete-active-region’ to nil.
+
Interactively, ARG is the prefix arg (default 1)
and KILLP is t if a prefix arg was specified."
(interactive "*p\nP")
@@ -5881,8 +6200,9 @@ START and END specify the portion of the current buffer to be copied."
(defvar activate-mark-hook nil
"Hook run when the mark becomes active.
-It is also run at the end of a command, if the mark is active and
-it is possible that the region may have changed.")
+It is also run when the region is reactivated, for instance after
+using a command that switches back to a buffer that has an active
+mark.")
(defvar deactivate-mark-hook nil
"Hook run when the mark becomes inactive.")
@@ -6340,9 +6660,16 @@ is temporarily turned on. Furthermore, the mark will be deactivated
by any subsequent point motion key that was not shift-translated, or
by any action that normally deactivates the mark in Transient Mark mode.
+When the value is `permanent', the mark will be deactivated by any
+action which normally does that, but not by motion keys that were
+not shift-translated.
+
See `this-command-keys-shift-translated' for the meaning of
shift-translation."
- :type 'boolean
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "Permanent" permanent)
+ (other :tag "On" t))
+ :version "28.1"
:group 'editing-basics)
(defun handle-shift-selection ()
@@ -6360,7 +6687,12 @@ translation.
Otherwise, if the region has been activated temporarily,
deactivate it, and restore the variable `transient-mark-mode' to
its earlier value."
- (cond ((and shift-select-mode this-command-keys-shift-translated)
+ (cond ((and (eq shift-select-mode 'permanent)
+ this-command-keys-shift-translated)
+ (unless mark-active
+ (push-mark nil nil t)))
+ ((and shift-select-mode
+ this-command-keys-shift-translated)
(unless (and mark-active
(eq (car-safe transient-mark-mode) 'only))
(setq-local transient-mark-mode
@@ -6399,6 +6731,10 @@ or \"mark.*active\" at the prompt."
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
:variable (default-value 'transient-mark-mode))
+(define-minor-mode indent-tabs-mode
+ "Toggle whether indentation can insert TAB characters."
+ :global t :group 'indent :variable indent-tabs-mode)
+
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
Some commands will do this in order to go to positions outside
@@ -6729,11 +7065,13 @@ 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 not too tall, move forward.
+ ;; current line is not too tall, or if there's a continuation
+ ;; line below this one, move forward.
((and (or (null this-height) (<= this-height winh))
vpos
(> vpos 0)
- (< py last-line))
+ (or (< py last-line)
+ (display--line-is-continued-p)))
nil)
;; When already vscrolled, we vscroll some more if we can,
;; or clear vscroll and move forward at end of tall image.
@@ -7502,44 +7840,53 @@ are interchanged."
(interactive "*p")
(transpose-subr 'forward-word arg))
-(defun transpose-sexps (arg)
+(defun transpose-sexps (arg &optional interactive)
"Like \\[transpose-chars] (`transpose-chars'), but applies to sexps.
Unlike `transpose-words', point must be between the two sexps and not
in the middle of a sexp to be transposed.
With non-zero prefix arg ARG, effect is to take the sexp before point
and drag it forward past ARG other sexps (backward if ARG is negative).
If ARG is zero, the sexps ending at or after point and at or after mark
-are interchanged."
- (interactive "*p")
- (transpose-subr
- (lambda (arg)
- ;; Here we should try to simulate the behavior of
- ;; (cons (progn (forward-sexp x) (point))
- ;; (progn (forward-sexp (- x)) (point)))
- ;; Except that we don't want to rely on the second forward-sexp
- ;; putting us back to where we want to be, since forward-sexp-function
- ;; might do funny things like infix-precedence.
- (if (if (> arg 0)
- (looking-at "\\sw\\|\\s_")
- (and (not (bobp))
- (save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
- ;; Jumping over a symbol. We might be inside it, mind you.
- (progn (funcall (if (> arg 0)
- 'skip-syntax-backward 'skip-syntax-forward)
- "w_")
- (cons (save-excursion (forward-sexp arg) (point)) (point)))
- ;; Otherwise, we're between sexps. Take a step back before jumping
- ;; to make sure we'll obey the same precedence no matter which direction
- ;; we're going.
- (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
- (cons (save-excursion (forward-sexp arg) (point))
- (progn (while (or (forward-comment (if (> arg 0) 1 -1))
- (not (zerop (funcall (if (> arg 0)
- 'skip-syntax-forward
- 'skip-syntax-backward)
- ".")))))
- (point)))))
- arg 'special))
+are interchanged.
+If INTERACTIVE is non-nil, as it is interactively,
+report errors as appropriate for this kind of usage."
+ (interactive "*p\nd")
+ (if interactive
+ (condition-case nil
+ (transpose-sexps arg nil)
+ (scan-error (user-error "Not between two complete sexps")))
+ (transpose-subr
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion
+ (forward-char -1)
+ (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ 'skip-syntax-backward 'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which
+ ;; direction we're going.
+ (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward)
+ " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ 'skip-syntax-forward
+ 'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ arg 'special)))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.
@@ -7819,15 +8166,19 @@ is defined.
The function should take a single optional argument, which is a flag
indicating whether it should use soft newlines.")
-(defun default-indent-new-line (&optional soft)
+(defun default-indent-new-line (&optional soft force)
"Break line at point and indent.
If a comment syntax is defined, call `comment-line-break-function'.
The inserted newline is marked hard if variable `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
- (interactive)
+ (interactive (list nil t))
(if comment-start
- (funcall comment-line-break-function soft)
+ ;; Force breaking the line when called interactively.
+ (if force
+ (let ((comment-auto-fill-only-comments nil))
+ (funcall comment-line-break-function soft))
+ (funcall comment-line-break-function soft))
;; Insert the newline before removing empty space so that markers
;; get preserved better.
(if soft (insert-and-inherit ?\n) (newline 1))
@@ -8581,6 +8932,8 @@ makes it easier to edit it."
(defvar completion-list-mode-map
(let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map "g" nil) ;; There's nothing to revert from.
(define-key map [mouse-2] 'choose-completion)
(define-key map [follow-link] 'mouse-face)
(define-key map [down-mouse-2] nil)
@@ -8590,8 +8943,10 @@ makes it easier to edit it."
(define-key map [right] 'next-completion)
(define-key map [?\t] 'next-completion)
(define-key map [backtab] 'previous-completion)
- (define-key map "q" 'quit-window)
(define-key map "z" 'kill-current-buffer)
+ (define-key map "n" 'next-completion)
+ (define-key map "p" 'previous-completion)
+ (define-key map "\M-g\M-c" 'switch-to-minibuffer)
map)
"Local map for completion list buffers.")
@@ -8678,18 +9033,17 @@ If EVENT, use EVENT's position to determine the starting position."
(choice
(save-excursion
(goto-char (posn-point (event-start event)))
- (let (beg end)
+ (let (beg)
(cond
((and (not (eobp)) (get-text-property (point) 'mouse-face))
- (setq end (point) beg (1+ (point))))
+ (setq beg (1+ (point))))
((and (not (bobp))
(get-text-property (1- (point)) 'mouse-face))
- (setq end (1- (point)) beg (point)))
+ (setq beg (point)))
(t (error "No completion here")))
(setq beg (previous-single-property-change beg 'mouse-face))
- (setq end (or (next-single-property-change end 'mouse-face)
- (point-max)))
- (buffer-substring-no-properties beg end)))))
+ (substring-no-properties
+ (get-text-property beg 'completion--string))))))
(unless (buffer-live-p buffer)
(error "Destination buffer is dead"))
@@ -8809,6 +9163,9 @@ Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
to select the completion near point.
Or click to select one with the mouse.
+See the `completions-format' user option to control how this
+buffer is formatted.
+
\\{completion-list-mode-map}")
(defun completion-list-mode-finish ()
@@ -8881,6 +9238,18 @@ select the completion near point.\n\n"))))))
;; FIXME: Perhaps this should be done in `minibuffer-completion-help'.
(when (bobp)
(next-completion 1)))))
+
+(defun read-expression-switch-to-completions ()
+ "Select the completion list window while reading an expression."
+ (interactive)
+ (completion-help-at-point)
+ (switch-to-completions))
+
+(defun switch-to-minibuffer ()
+ "Select the minibuffer window."
+ (interactive)
+ (when (active-minibuffer-window)
+ (select-window (active-minibuffer-window))))
;;; Support keyboard commands to turn on various modifiers.
@@ -9193,9 +9562,9 @@ call `normal-erase-is-backspace-mode' (which see) instead."
:set (lambda (symbol value)
;; The fboundp is because of a problem with :set when
;; dumping Emacs. It doesn't really matter.
- (if (fboundp 'normal-erase-is-backspace-mode)
- (normal-erase-is-backspace-mode (or value 0))
- (set-default symbol value))))
+ (when (fboundp 'normal-erase-is-backspace-mode)
+ (normal-erase-is-backspace-mode (or value 0)))
+ (set-default symbol value)))
(defun normal-erase-is-backspace-setup-frame (&optional frame)
"Set up `normal-erase-is-backspace-mode' on FRAME, if necessary."
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 48491e43cae..c363fb2c489 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -104,10 +104,10 @@ are integer buffer positions in the reverse order of the insertion order.")
(defvar skeleton-point)
(defvar skeleton-regions)
-(def-edebug-spec skeleton-edebug-spec
- ([&or null stringp (stringp &rest stringp) [[&not atom] sexp]]
- &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
- ("quote" def-form) skeleton-edebug-spec def-form))
+(def-edebug-elem-spec 'skeleton-edebug-spec
+ '([&or null stringp (stringp &rest stringp) [[&not atom] sexp]]
+ &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
+ ("quote" def-form) skeleton-edebug-spec def-form))
;;;###autoload
(defmacro define-skeleton (command documentation &rest skeleton)
"Define a user-configurable COMMAND that enters a statement skeleton.
@@ -290,7 +290,8 @@ i.e. we are handling the iterator of a subskeleton, returns empty string if
user didn't modify input.
While reading, the value of `minibuffer-help-form' is variable `help' if that
is non-nil or a default string."
- (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help))
+ (with-suppressed-warnings ((lexical help)) (defvar help)) ;FIXME: Prefix!
+ (let ((minibuffer-help-form (or (bound-and-true-p help)
(if recursive "\
As long as you provide input you will insert another subskeleton.
diff --git a/lisp/so-long.el b/lisp/so-long.el
index f44d41dc5eb..7bf15e85dad 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -8,7 +8,7 @@
;; Keywords: convenience
;; Created: 23 Dec 2015
;; Package-Requires: ((emacs "24.4"))
-;; Version: 1.0
+;; Version: 1.1.1
;; This file is part of GNU Emacs.
@@ -50,16 +50,17 @@
;; performance further, as well as making the so-long activity more obvious to
;; the user. These kinds of minified files are typically not intended to be
;; edited, so not providing the usual editing mode in such cases will rarely be
-;; an issue. However, you can reinstate the original state of the buffer by
-;; calling `so-long-revert' (the key binding of which is advertised when the major
-;; mode change occurs). If you prefer that the major mode not be changed, you
-;; can customize the `so-long-minor-mode' action.
+;; an issue; however you can restore the buffer to its original state by calling
+;; `so-long-revert' (the key binding of which is advertised when the major mode
+;; change occurs). If you prefer that the major mode not be changed in the
+;; first place, there is a `so-long-minor-mode' action available, which you can
+;; select by customizing the `so-long-action' user option.
;;
;; The user options `so-long-action' and `so-long-action-alist' determine what
-;; actions `so-long' and `so-long-revert' will take. This allows you to configure
-;; alternative actions (including custom actions). As well as
-;; the major and minor mode actions provided by this library, `longlines-mode'
-;; is also supported by default as an alternative action.
+;; `so-long' and `so-long-revert' will do, enabling you to configure alternative
+;; actions (including custom actions). As well as the major and minor mode
+;; actions provided by this library, `longlines-mode' is also supported by
+;; default as an alternative action.
;;
;; Note that while the measures taken can improve performance dramatically when
;; dealing with such files, this library does not have any effect on the
@@ -127,9 +128,9 @@
;; Use M-x customize-group RET so-long RET
;; (or M-x so-long-customize RET)
;;
-;; The user options `so-long-target-modes', `so-long-threshold', and
-;; `so-long-max-lines' determine whether action will be taken automatically when
-;; visiting a file, and `so-long-action' determines what will be done.
+;; The user options `so-long-target-modes' and `so-long-threshold' determine
+;; whether action will be taken automatically when visiting a file, and
+;; `so-long-action' determines what will be done.
;; * Actions and menus
;; -------------------
@@ -152,7 +153,7 @@
;; * Files with a file-local 'mode'
;; --------------------------------
;; A file-local major mode is likely to be safe even if long lines are detected
-;; (as the author of the file would otherwise be unlikely to have set that mode),
+;; (the author of the file would otherwise be unlikely to have set that mode),
;; and so these files are treated as special cases. When a file-local 'mode' is
;; present, the function defined by the `so-long-file-local-mode-function' user
;; option is called. The default value will cause the `so-long-minor-mode'
@@ -213,6 +214,24 @@
;; performance or otherwise avoid undesirable behaviours. If `so-long-revert'
;; is called, then the original values are restored.
+;; * Retaining minor modes and settings when switching to `so-long-mode'
+;; ---------------------------------------------------------------------
+;; A consequence of switching to a new major mode is that many buffer-local
+;; minor modes and variables from the original major mode will be disabled.
+;; For performance purposes this is a desirable trait of `so-long-mode', but
+;; specified modes and variables can also be preserved across the major mode
+;; transition by customizing the `so-long-mode-preserved-minor-modes' and
+;; `so-long-mode-preserved-variables' user options.
+;;
+;; When `so-long-mode' is called, the states of any modes and variables
+;; configured by these options are remembered in the original major mode, and
+;; reinstated after switching to `so-long-mode'. Likewise, if `so-long-revert'
+;; is used to switch back to the original major mode, these modes and variables
+;; are again set to the same states.
+;;
+;; The default values for these options ensure that if `view-mode' was active
+;; in the original mode, then it will also be active in `so-long-mode'.
+
;; * Hooks
;; -------
;; `so-long-hook' runs at the end of the `so-long' command, after the configured
@@ -287,8 +306,9 @@
;; the criteria for calling `so-long' in any given mode (plus its derivatives)
;; by setting buffer-local values for the variables in question. This includes
;; `so-long-predicate' itself, as well as any variables used by the predicate
-;; when determining the result. By default this means `so-long-max-lines',
-;; `so-long-skip-leading-comments', and `so-long-threshold'. E.g.:
+;; when determining the result. By default this means `so-long-threshold' and
+;; possibly also `so-long-max-lines' and `so-long-skip-leading-comments' (these
+;; latter two are not used by default starting from Emacs 28.1). E.g.:
;;
;; (add-hook 'js-mode-hook 'my-js-mode-hook)
;;
@@ -390,6 +410,14 @@
;; * Change Log:
;;
+;; 1.1.1 - Identical to 1.1, but fixing an incorrect GNU ELPA release.
+;; 1.1 - Utilise `buffer-line-statistics' in Emacs 28+, with the new
+;; `so-long-predicate' function `so-long-statistics-excessive-p'.
+;; - Increase `so-long-threshold' from 250 to 10,000.
+;; - Increase `so-long-max-lines' from 5 to 500.
+;; - Include `fundamental-mode' in `so-long-target-modes'.
+;; - New user option `so-long-mode-preserved-minor-modes'.
+;; - New user option `so-long-mode-preserved-variables'.
;; 1.0 - Included in Emacs 27.1, and in GNU ELPA for prior versions of Emacs.
;; - New global mode `global-so-long-mode' to enable/disable the library.
;; - New user option `so-long-action'.
@@ -442,13 +470,19 @@
(require 'cl-lib)
+;; Map each :package-version to the associated Emacs version.
+;; (This eliminates the need for explicit :version keywords on the
+;; custom definitions.)
(add-to-list 'customize-package-emacs-version-alist
- '(so-long ("1.0" . "27.1")))
+ '(so-long ("1.0" . "27.1")
+ ("1.1" . "28.1")))
-(defconst so-long--latest-version "1.0")
+(defconst so-long--latest-version "1.1")
+(declare-function buffer-line-statistics "fns.c" t t) ;; Emacs 28+
(declare-function longlines-mode "longlines")
(defvar longlines-mode)
+
(defvar so-long-enabled nil
;; This was initially a renaming of the old `so-long-mode-enabled' and
;; documented as "Set to nil to prevent `so-long' from being triggered
@@ -488,16 +522,24 @@
:prefix "so-long"
:group 'convenience)
-(defcustom so-long-threshold 250
+(defcustom so-long-threshold 10000
"Maximum line length permitted before invoking `so-long-function'.
-See `so-long-detected-long-line-p' for details."
+Line length is counted in either bytes or characters, depending on
+`so-long-predicate'.
+
+This is the only variable used to determine the presence of long lines if
+the `so-long-predicate' function is `so-long-statistics-excessive-p'."
:type 'integer
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
-(defcustom so-long-max-lines 5
+(defcustom so-long-max-lines 500
"Number of non-blank, non-comment lines to test for excessive length.
+This option normally has no effect in Emacs versions >= 28.1, as the default
+`so-long-predicate' sees the entire buffer. Older versions of Emacs still make
+use of this option.
+
If nil then all lines will be tested, until either a long line is detected,
or the end of the buffer is reached.
@@ -507,11 +549,15 @@ be counted.
See `so-long-detected-long-line-p' for details."
:type '(choice (integer :tag "Limit")
(const :tag "Unlimited" nil))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-skip-leading-comments t
"Non-nil to ignore all leading comments and whitespace.
+This option normally has no effect in Emacs versions >= 28.1, as the default
+`so-long-predicate' sees the entire buffer. Older versions of Emacs still make
+use of this option.
+
If the file begins with a shebang (#!), this option also causes that line to be
ignored even if it doesn't match the buffer's comment syntax, to ensure that
comments following the shebang will be ignored.
@@ -521,7 +567,7 @@ See `so-long-detected-long-line-p' for details."
:package-version '(so-long . "1.0"))
(defcustom so-long-target-modes
- '(prog-mode css-mode sgml-mode nxml-mode)
+ '(prog-mode css-mode sgml-mode nxml-mode fundamental-mode)
"`so-long' affects only these modes and their derivatives.
Our primary use-case is minified programming code, so `prog-mode' covers
@@ -534,7 +580,7 @@ files would prevent Emacs from handling them correctly."
;; Use 'symbol', as 'function' may be unknown => mismatch.
:type '(choice (repeat :tag "Specified modes" symbol)
(const :tag "All modes" t))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-invisible-buffer-function #'so-long-deferred
"Function called in place of `so-long' when the buffer is not displayed.
@@ -566,7 +612,9 @@ the mentioned options might interfere with some intended processing."
(function :tag "Custom function"))
:package-version '(so-long . "1.0"))
-(defcustom so-long-predicate 'so-long-detected-long-line-p
+(defcustom so-long-predicate (if (fboundp 'buffer-line-statistics)
+ 'so-long-statistics-excessive-p
+ 'so-long-detected-long-line-p)
"Function, called after `set-auto-mode' to decide whether action is needed.
Only called if the major mode is a member of `so-long-target-modes'.
@@ -574,10 +622,14 @@ Only called if the major mode is a member of `so-long-target-modes'.
The specified function will be called with no arguments. If it returns non-nil
then `so-long' will be invoked.
-Defaults to `so-long-detected-long-line-p'."
- :type '(radio (const so-long-detected-long-line-p)
+Defaults to `so-long-statistics-excessive-p' starting from Emacs 28.1, or
+`so-long-detected-long-line-p' in earlier versions.
+
+Note that `so-long-statistics-excessive-p' requires Emacs 28.1 or later."
+ :type '(radio (const so-long-statistics-excessive-p)
+ (const so-long-detected-long-line-p)
(function :tag "Custom function"))
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
;; Silence byte-compiler warning. `so-long-action-alist' is defined below
;; as a user option; but the definition sequence required for its setter
@@ -757,6 +809,7 @@ was established."
display-line-numbers-mode
flymake-mode
flyspell-mode
+ glasses-mode
goto-address-mode
goto-address-prog-mode
hi-lock-mode
@@ -776,6 +829,8 @@ was established."
hl-sexp-mode
idle-highlight-mode
rainbow-delimiters-mode
+ smartparens-mode
+ smartparens-strict-mode
)
;; It's not clear to me whether all of these would be problematic, but they
;; seemed like reasonable targets. Some are certainly excessive in smaller
@@ -800,7 +855,7 @@ disabled modes are re-enabled by calling them with the numeric argument 1.
Please submit bug reports to recommend additional modes for this list, whether
they are in Emacs core, GNU ELPA, or elsewhere."
:type '(repeat symbol) ;; not function, as may be unknown => mismatch.
- :package-version '(so-long . "1.0"))
+ :package-version '(so-long . "1.1"))
(defcustom so-long-variable-overrides
'((bidi-inhibit-bpa . t)
@@ -848,6 +903,44 @@ intended to be edited manually."
(which-func-mode boolean))
:package-version '(so-long . "1.0"))
+(defcustom so-long-mode-preserved-minor-modes
+ '(view-mode)
+ "List of buffer-local minor modes to preserve in `so-long-mode'.
+
+These will be enabled or disabled after switching to `so-long-mode' (by calling
+them with the numeric argument 1 or 0) in accordance with their state in the
+buffer's original major mode. Unknown modes, and modes which are already in the
+desired state, are ignored.
+
+This happens before `so-long-variable-overrides' and `so-long-minor-modes'
+have been processed.
+
+By default this happens only if `so-long-action' is set to `so-long-mode'.
+If `so-long-revert' is subsequently invoked, then the modes are again set
+to their original state after the original major mode has been called.
+
+See also `so-long-mode-preserved-variables' (processed after this)."
+ :type '(repeat symbol) ;; not function, as may be unknown => mismatch.
+ :package-version '(so-long . "1.1"))
+
+(defcustom so-long-mode-preserved-variables
+ '(view-old-buffer-read-only)
+ "List of buffer-local variables to preserve in `so-long-mode'.
+
+The original value of each variable will be maintained after switching to
+`so-long-mode'. Unknown variables are ignored.
+
+This happens before `so-long-variable-overrides' and `so-long-minor-modes'
+have been processed.
+
+By default this happens only if `so-long-action' is set to `so-long-mode'.
+If `so-long-revert' is subsequently invoked, then the variables are again
+set to their original values after the original major mode has been called.
+
+See also `so-long-mode-preserved-minor-modes' (processed before this)."
+ :type '(repeat variable)
+ :package-version '(so-long . "1.1"))
+
(defcustom so-long-hook nil
"List of functions to call after `so-long' is called.
@@ -934,10 +1027,17 @@ If RESET is non-nil, remove any existing values before storing the new ones."
(setq so-long-original-values nil))
(so-long-remember 'so-long-variable-overrides)
(so-long-remember 'so-long-minor-modes)
+ (so-long-remember 'so-long-mode-preserved-variables)
+ (so-long-remember 'so-long-mode-preserved-minor-modes)
(dolist (ovar so-long-variable-overrides)
(so-long-remember (car ovar)))
(dolist (mode so-long-minor-modes)
(when (and (boundp mode) mode)
+ (so-long-remember mode)))
+ (dolist (var so-long-mode-preserved-variables)
+ (so-long-remember var))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (and (boundp mode) mode)
(so-long-remember mode))))
(defun so-long-menu ()
@@ -1077,12 +1177,23 @@ serves the same purpose.")
;; We change automatically to faster code
;; And then I won't feel so mad
+(defun so-long-statistics-excessive-p ()
+ "Non-nil if the buffer contains a line longer than `so-long-threshold' bytes.
+
+This uses `buffer-line-statistics' (available from Emacs 28.1) to establish the
+longest line in the buffer (counted in bytes rather than characters).
+
+This is the default value of `so-long-predicate' in Emacs versions >= 28.1.
+\(In earlier versions `so-long-detected-long-line-p' is used by default.)"
+ (> (cadr (buffer-line-statistics))
+ so-long-threshold))
+
(defun so-long-detected-long-line-p ()
"Determine whether the current buffer contains long lines.
Following any initial comments and blank lines, the next N lines of the buffer
-will be tested for excessive length (where \"excessive\" means above
-`so-long-threshold', and N is `so-long-max-lines').
+will be tested for excessive length (where \"excessive\" means greater than
+`so-long-threshold' characters, and N is `so-long-max-lines').
Returns non-nil if any such excessive-length line is detected.
@@ -1090,7 +1201,9 @@ If `so-long-skip-leading-comments' is nil then the N lines will be counted
starting from the first line of the buffer. In this instance you will likely
want to increase `so-long-max-lines' to allow for possible comments.
-This is the default value of `so-long-predicate'."
+This is the default `so-long-predicate' function in Emacs versions < 28.1.
+\(Starting from 28.1, the default and recommended predicate function is
+`so-long-statistics-excessive-p', which is faster and sees the entire buffer.)"
(let ((count 0) start)
(save-excursion
(goto-char (point-min))
@@ -1185,13 +1298,14 @@ current buffer, and buffer-local values are assigned to variables in accordance
with `so-long-variable-overrides'.
This minor mode is a standard `so-long-action' option."
- nil nil nil
+ :lighter nil
(if so-long-minor-mode ;; We are enabling the mode.
(progn
;; Housekeeping. `so-long-minor-mode' might be invoked directly rather
;; than via `so-long', so replicate the necessary behaviours. The minor
;; mode also cares about whether `so-long' was already active, as we do
- ;; not want to remember values which were potentially overridden already.
+ ;; not want to remember values which were (potentially) overridden
+ ;; already.
(unless (or so-long--calling so-long--active)
(so-long--ensure-enabled)
(setq so-long--active t
@@ -1321,6 +1435,16 @@ This advice acts before `so-long-mode', with the previous mode still active."
"Run by `so-long-mode' in `after-change-major-mode-hook'.
Calls `so-long-disable-minor-modes' and `so-long-override-variables'."
+ ;; Check/set the state of 'preserved' variables and minor modes.
+ ;; (See also `so-long-mode-revert'.)
+ ;; The "modes before variables" sequence is important for the default
+ ;; preserved mode `view-mode' which remembers the `buffer-read-only' state
+ ;; (which is also permanent-local). That causes problems unless we restore
+ ;; the original value of `view-old-buffer-read-only' after; otherwise the
+ ;; sequence `view-mode' -> `so-long' -> `so-long-revert' -> `view-mode'
+ ;; results in `view-mode' being disabled but the buffer still read-only.
+ (so-long-mode-maintain-preserved-minor-modes)
+ (so-long-mode-maintain-preserved-variables)
;; Disable minor modes.
(so-long-disable-minor-modes)
;; Override variables (again). We already did this in `so-long-mode' in
@@ -1334,14 +1458,15 @@ Calls `so-long-disable-minor-modes' and `so-long-override-variables'."
(defun so-long-disable-minor-modes ()
"Disable any active minor modes listed in `so-long-minor-modes'."
(dolist (mode (so-long-original 'so-long-minor-modes))
- (when (and (boundp mode) mode)
+ (when (and (boundp mode)
+ (symbol-value mode))
(funcall mode 0))))
(defun so-long-restore-minor-modes ()
"Restore the minor modes which were disabled.
The modes are enabled in accordance with what was remembered in `so-long'."
- (dolist (mode so-long-minor-modes)
+ (dolist (mode (so-long-original 'so-long-minor-modes))
(when (and (so-long-original mode)
(boundp mode)
(not (symbol-value mode)))
@@ -1356,7 +1481,7 @@ The modes are enabled in accordance with what was remembered in `so-long'."
"Restore the remembered values for the overridden variables.
The variables are set in accordance with what was remembered in `so-long'."
- (dolist (ovar so-long-variable-overrides)
+ (dolist (ovar (so-long-original 'so-long-variable-overrides))
(so-long-restore-variable (car ovar))))
(defun so-long-restore-variable (variable)
@@ -1364,7 +1489,7 @@ The variables are set in accordance with what was remembered in `so-long'."
;; In the instance where `so-long-mode-revert' has just reverted the major
;; mode, note that `kill-all-local-variables' was already called by the
;; original mode function, and so these 'overridden' variables may now have
- ;; global rather than buffer-local values.
+ ;; global rather than buffer-local values (if they are not permanent-local).
(let* ((remembered (so-long-original variable :exists))
(originally-local (nth 2 remembered)))
(if originally-local
@@ -1380,6 +1505,24 @@ The variables are set in accordance with what was remembered in `so-long'."
;; the old value as a buffer-local value, so we keep it simple.
(kill-local-variable variable))))
+(defun so-long-mode-maintain-preserved-variables ()
+ "Set any 'preserved' variables.
+
+The variables are set in accordance with what was remembered in `so-long'."
+ (dolist (var (so-long-original 'so-long-mode-preserved-variables))
+ (so-long-restore-variable var)))
+
+(defun so-long-mode-maintain-preserved-minor-modes ()
+ "Enable or disable 'preserved' minor modes.
+
+The modes are set in accordance with what was remembered in `so-long'."
+ (dolist (mode (so-long-original 'so-long-mode-preserved-minor-modes))
+ (when (boundp mode)
+ (let ((original (so-long-original mode))
+ (current (symbol-value mode)))
+ (unless (equal current original)
+ (funcall mode (if original 1 0)))))))
+
(defun so-long-mode-revert ()
"Call the `major-mode' which was selected before `so-long-mode' replaced it.
@@ -1407,6 +1550,10 @@ This is the `so-long-revert-function' for `so-long-mode'."
;; `kill-all-local-variables' was already called by the original mode
;; function, so we may be seeing global values.
(so-long-restore-variables)
+ ;; Check/set the state of 'preserved' variables and minor modes.
+ ;; (Refer to `so-long-after-change-major-mode' regarding the sequence.)
+ (so-long-mode-maintain-preserved-minor-modes)
+ (so-long-mode-maintain-preserved-variables)
;; Restore the mode line construct.
(unless (derived-mode-p 'so-long-mode)
(setq so-long-mode-line-info (so-long-mode-line-info)))))
@@ -1892,7 +2039,7 @@ If it appears in `%s', you should remove it."
(unless global-so-long-mode
(global-so-long-mode 1)))
(makunbound 'so-long-mode-enabled))
- ;; Update to version 1.N:
+ ;; Update to version 1.N from earlier versions:
;; (when (version< so-long-version "1.N") ...)
;;
;; All updates completed.
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index e43978f4137..3cc3e276067 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,4 +1,4 @@
-;;; speedbar --- quick access to files and tags in a frame
+;;; speedbar.el --- quick access to files and tags in a frame -*- lexical-binding: t; -*-
;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
@@ -106,7 +106,6 @@
;;; TODO:
;; - Timeout directories we haven't visited in a while.
-(require 'easymenu)
(require 'dframe)
(require 'ezimage)
@@ -142,25 +141,6 @@
;;; Code:
-;; Note: `inversion-test' requires parts of the CEDET package that are
-;; not included with Emacs.
-;;
-;; (defun speedbar-require-version (major minor &optional beta)
-;; "Non-nil if this version of SPEEDBAR does not satisfy a specific version.
-;; Arguments can be:
-;;
-;; (MAJOR MINOR &optional BETA)
-;;
-;; Values MAJOR and MINOR must be integers. BETA can be an integer, or
-;; excluded if a released version is required.
-;;
-;; It is assumed that if the current version is newer than that specified,
-;; everything passes. Exceptions occur when known incompatibilities are
-;; introduced."
-;; (inversion-test 'speedbar
-;; (concat major "." minor
-;; (when beta (concat "beta" beta)))))
-
(defvar speedbar-initial-expansion-mode-alist
'(("buffers" speedbar-buffer-easymenu-definition speedbar-buffers-key-map
speedbar-buffer-buttons)
@@ -309,22 +289,6 @@ A nil value means don't show the file in the list."
:group 'speedbar
:type 'boolean)
-;;; EVENTUALLY REMOVE THESE
-
-;; When I moved to a repeating timer, I had the horrible misfortune
-;; of losing the ability for adaptive speed choice. This update
-;; speed currently causes long delays when it should have been turned off.
-(defvar speedbar-update-speed dframe-update-speed)
-(make-obsolete-variable 'speedbar-update-speed
- 'dframe-update-speed
- "speedbar 1.0pre3 (Emacs 23.1)")
-
-(defvar speedbar-navigating-speed dframe-update-speed)
-(make-obsolete-variable 'speedbar-navigating-speed
- 'dframe-update-speed
- "speedbar 1.0pre3 (Emacs 23.1)")
-;;; END REMOVE THESE
-
(defcustom speedbar-frame-parameters '((minibuffer . nil)
(width . 20)
(border-width . 0)
@@ -1640,7 +1604,7 @@ variable `speedbar-obj-alist'."
(defmacro speedbar-with-writable (&rest forms)
"Allow the buffer to be writable and evaluate FORMS."
- (declare (indent 0))
+ (declare (indent 0) (debug t))
`(let ((inhibit-read-only t))
,@forms))
@@ -1858,9 +1822,9 @@ matches the user directory ~, then it is replaced with a ~.
INDEX is not used, but is required by the caller."
(let* ((tilde (expand-file-name "~/"))
(dd (expand-file-name directory))
- (junk (string-prefix-p "~/" dd))
+ (junk (string-match (regexp-quote tilde) dd))
(displayme (if junk
- (concat "~/" (substring dd 2 nil))
+ (concat "~/" (substring dd (match-end 0)))
dd))
(p (point)))
(if (string-match "^~[/\\]?\\'" displayme) (setq displayme tilde))
@@ -2195,10 +2159,13 @@ passes some tests."
;; way by displaying the range over which we
;; have grouped them.
(setq work-list
- (cons (cons (concat short-start-name
- " to "
- short-end-name)
- short-group-list)
+ (cons (cons
+ (concat short-start-name
+ " to " short-end-name)
+ (sort (copy-sequence short-group-list)
+ (lambda (e1 e2)
+ (string< (car e1)
+ (car e2)))))
work-list))))
;; Reset short group list information every time.
(setq short-group-list nil
@@ -3280,7 +3247,7 @@ subdirectory chosen will be at INDENT level."
;; in case.
(let ((speedbar-smart-directory-expand-flag nil))
(speedbar-update-contents))
- (speedbar-set-timer speedbar-navigating-speed)
+ (speedbar-set-timer dframe-update-speed)
(setq speedbar-last-selected-file nil)
(speedbar-stealthy-updates))
@@ -3303,7 +3270,7 @@ Handles end-of-sublist smartly."
Clicking this button expands or contracts a directory. TEXT is the
button clicked which has either a + or -. TOKEN is the directory to be
expanded. INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this dir
+ (cond ((string-search "+" text) ;we have to expand this dir
(setq speedbar-shown-directories
(cons (expand-file-name
(concat (speedbar-line-directory indent) token "/"))
@@ -3316,7 +3283,7 @@ expanded. INDENT is the current indentation level."
(speedbar-default-directory-list
(concat (speedbar-line-directory indent) token "/")
(1+ indent)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-reset-scanners)
(let ((oldl speedbar-shown-directories)
(newl nil)
@@ -3343,14 +3310,14 @@ INDENT is the current indentation level and is unused."
;; update contents will change directory without
;; having to touch the attached frame.
(speedbar-update-contents)
- (speedbar-set-timer speedbar-navigating-speed))
+ (speedbar-set-timer dframe-update-speed))
(defun speedbar-tag-file (text token indent)
"The cursor is on a selected line. Expand the tags in the specified file.
The parameter TEXT and TOKEN are required, where TEXT is the button
clicked, and TOKEN is the file to expand. INDENT is the current
indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(let* ((fn (expand-file-name (concat (speedbar-line-directory indent)
token)))
(lst (speedbar-fetch-dynamic-tags fn)))
@@ -3362,7 +3329,7 @@ indentation level."
(save-excursion
(end-of-line) (forward-char 1)
(funcall (car lst) indent (cdr lst)))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -3391,14 +3358,14 @@ INDENT is the current indentation level."
"Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
Etags does not support this feature. TEXT will be the button string.
TOKEN will be the list, and INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(speedbar-insert-generic-list indent token 'speedbar-tag-expand
'speedbar-tag-find))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -4001,11 +3968,6 @@ TEXT is the buffer's name, TOKEN and INDENT are unused."
"Speedbar face for separator labels in a display."
:group 'speedbar-faces)
-;; some edebug hooks
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec speedbar-with-writable def-body)))
-
;; Fix a font lock problem for some versions of Emacs
(and (boundp 'font-lock-global-modes)
font-lock-global-modes
@@ -4093,7 +4055,6 @@ this version is not backward compatible to 0.14 or earlier.")
(provide 'speedbar)
-;; run load-time hooks
(run-hooks 'speedbar-load-hook)
-;;; speedbar ends here
+;;; speedbar.el ends here
diff --git a/lisp/startup.el b/lisp/startup.el
index 2269973bd11..f20c61bdfed 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -519,6 +519,7 @@ DIRS are relative."
xdg-dir)
(t emacs-d-dir))))
+(defvar native-comp-eln-load-path)
(defun normal-top-level ()
"Emacs calls this function when it first starts up.
It sets `command-line-processed', processes the command-line,
@@ -536,6 +537,26 @@ It is the default value of the variable `top-level'."
(setq user-emacs-directory
(startup--xdg-or-homedot startup--xdg-config-home-emacs nil))
+ (when (featurep 'native-compile)
+ ;; Form `native-comp-eln-load-path'.
+ (let ((path-env (getenv "EMACSNATIVELOADPATH")))
+ (when path-env
+ (dolist (path (split-string path-env path-separator))
+ (unless (string= "" path)
+ (push path native-comp-eln-load-path)))))
+ (push (expand-file-name "eln-cache/" user-emacs-directory)
+ native-comp-eln-load-path)
+ ;; When $HOME is set to '/nonexistent' means we are running the
+ ;; testsuite, add a temporary folder in front to produce there
+ ;; new compilations.
+ (when (and (equal (getenv "HOME") "/nonexistent")
+ ;; We may be running in a chroot environment where we
+ ;; can't write anything.
+ (file-writable-p (expand-file-name
+ (or temporary-file-directory ""))))
+ (let ((tmp-dir (make-temp-file "emacs-testsuite-" t)))
+ (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t)))
+ (push tmp-dir native-comp-eln-load-path))))
;; Look in each dir in load-path for a subdirs.el file. If we
;; find one, load it, which will add the appropriate subdirs of
;; that dir into load-path. This needs to be done before setting
@@ -622,6 +643,16 @@ It is the default value of the variable `top-level'."
(set pathsym (mapcar (lambda (dir)
(decode-coding-string dir coding t))
path)))))
+ (when (featurep 'native-compile)
+ (let ((npath (symbol-value 'native-comp-eln-load-path)))
+ (set 'native-comp-eln-load-path
+ (mapcar (lambda (dir)
+ ;; Call expand-file-name to remove all the
+ ;; pesky ".." from the directyory names in
+ ;; native-comp-eln-load-path.
+ (expand-file-name
+ (decode-coding-string dir coding t)))
+ npath))))
(dolist (filesym '(data-directory doc-directory exec-directory
installation-directory
invocation-directory invocation-name
@@ -1097,7 +1128,7 @@ please check its value")
("--no-x-resources") ("--debug-init")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")
- ("--dump-file") ("--temacs")))
+ ("--dump-file") ("--temacs") ("--seccomp")))
(argi (pop args))
(orig-argi argi)
argval)
@@ -1149,7 +1180,8 @@ please check its value")
(push '(visibility . icon) initial-frame-alist))
((member argi '("-nbc" "-no-blinking-cursor"))
(setq no-blinking-cursor t))
- ((member argi '("-dump-file" "-temacs")) ; Handled in C
+ ((member argi '("-dump-file" "-temacs" "-seccomp"))
+ ;; Handled in C
(or argval (pop args))
(setq argval nil))
;; Push the popped arg back on the list of arguments.
@@ -1169,12 +1201,12 @@ please check its value")
;; Re-evaluate predefined variables whose initial value depends on
;; the runtime context.
- (setq custom-delayed-init-variables
- ;; Initialize them in the same order they were loaded, in case there
- ;; are dependencies between them.
- (nreverse custom-delayed-init-variables))
- (mapc #'custom-reevaluate-setting custom-delayed-init-variables)
- (setq custom-delayed-init-variables nil)
+ (when (listp custom-delayed-init-variables)
+ (mapc #'custom-reevaluate-setting
+ ;; Initialize them in the same order they were loaded, in
+ ;; case there are dependencies between them.
+ (reverse custom-delayed-init-variables)))
+ (setq custom-delayed-init-variables t)
;; Warn for invalid user name.
(when init-file-user
@@ -2290,6 +2322,9 @@ A fancy display is used on graphic displays, normal otherwise."
(set-buffer-major-mode (current-buffer))
(current-buffer))))
+;; This avoids byte-compiler warning in the unexec build.
+(declare-function pdumper-stats "pdumper.c" ())
+
(defun command-line-1 (args-left)
"A subroutine of `command-line'."
(display-startup-echo-area-message)
@@ -2361,6 +2396,7 @@ nil default-directory" name)
(command-line-normalize-file-name name)
dir))
(buf (find-file-noselect file)))
+ (file-name-history--add file)
(setq displayable-buffers (cons buf displayable-buffers))
;; Set the file buffer to the current buffer so
;; that it will be used with "--eval" and
@@ -2470,7 +2506,7 @@ nil default-directory" name)
(or argval (pop command-line-args-left))))
;; Take file from default dir if it exists there;
;; otherwise let `load' search for it.
- (file-ex (expand-file-name file)))
+ (file-ex (file-truename (expand-file-name file))))
(when (file-regular-p file-ex)
(setq file file-ex))
(load file nil t)))
@@ -2481,7 +2517,7 @@ nil default-directory" name)
(let* ((file (command-line-normalize-file-name
(or argval (pop command-line-args-left))))
;; Take file from default dir.
- (file-ex (expand-file-name file)))
+ (file-ex (file-truename (expand-file-name file))))
(load file-ex nil t t)))
((equal argi "-insert")
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 55f2ae8cc47..18595cb0947 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1,4 +1,4 @@
-;;; strokes.el --- control Emacs through mouse strokes
+;;; strokes.el --- control Emacs through mouse strokes -*- lexical-binding: t; -*-
;; Copyright (C) 1997, 2000-2021 Free Software Foundation, Inc.
@@ -138,15 +138,14 @@
;; the user to enter strokes which "remove the pencil from the paper"
;; so to speak, so one character can have multiple strokes.
-;; NOTE (Oct 7, 2006): The URLs below seem to be invalid!!!
-
;; You can read more about strokes at:
-;; http://www.mit.edu/people/cadet/strokes-help.html
+;; https://web.archive.org/web/20041209171947/http://www.mit.edu/people/cadet/strokes-help.html
;; If you're interested in using strokes for writing English into Emacs
;; using strokes, then you'll want to read about it on the web page above
-;; or just download from http://www.mit.edu/people/cadet/strokes-abc.el,
+;; or just download from:
+;; https://web.archive.org/web/20041204163338/http://www.mit.edu/people/cadet/strokes-abc.el
;; which is nothing but a file with some helper commands for inserting
;; alphanumerics and punctuation.
@@ -216,14 +215,12 @@ static char * stroke_xpm[] = {
(defcustom strokes-lighter " Strokes"
"Mode line identifier for Strokes mode."
- :type 'string
- :group 'strokes)
+ :type 'string)
(defcustom strokes-character ?@
"Character used when drawing strokes in the strokes buffer.
\(The default is `@', which works well.)"
- :type 'character
- :group 'strokes)
+ :type 'character)
(defcustom strokes-minimum-match-score 1000
"Minimum score for a stroke to be considered a possible match.
@@ -239,8 +236,7 @@ then you can set `strokes-minimum-match-score' to something that works
for you. The only purpose of this variable is to insure that if you
do a bogus stroke that really doesn't match any of the predefined
ones, then strokes should NOT pick the one that came closest."
- :type 'integer
- :group 'strokes)
+ :type 'integer)
(defcustom strokes-grid-resolution 9
"Integer defining dimensions of the stroke grid.
@@ -256,14 +252,12 @@ WARNING: Changing the value of this variable will gravely affect the
figure out what it should be based on your needs and on how
quick the particular platform(s) you're operating on, and
only then start programming in your custom strokes."
- :type 'integer
- :group 'strokes)
+ :type 'integer)
(defcustom strokes-file (locate-user-emacs-file "strokes" ".strokes")
"File containing saved strokes for Strokes mode."
:version "24.4" ; added locate-user-emacs-file
- :type 'file
- :group 'strokes)
+ :type 'file)
(defvar strokes-buffer-name " *strokes*"
"The name of the buffer that the strokes take place in.")
@@ -273,8 +267,7 @@ WARNING: Changing the value of this variable will gravely affect the
If nil, strokes will be read the same, however the user will not be
able to see the strokes. This be helpful for people who don't like
the delay in switching to the strokes buffer."
- :type 'boolean
- :group 'strokes)
+ :type 'boolean)
;;; internal variables...
@@ -313,12 +306,6 @@ the corresponding interactive function.")
;;; Macros...
-;; unused
-;; (defmacro strokes-while-inhibiting-garbage-collector (&rest forms)
-;; "Execute FORMS without interference from the garbage collector."
-;; `(let ((gc-cons-threshold 134217727))
-;; ,@forms))
-
(defsubst strokes-click-p (stroke)
"Non-nil if STROKE is really click."
(< (length stroke) 2))
@@ -1044,7 +1031,7 @@ o Strokes are a bit computer-dependent in that they depend somewhat on
(help-mode)
(help-print-return-message)))
-(define-obsolete-function-alias 'strokes-report-bug 'report-emacs-bug "24.1")
+(define-obsolete-function-alias 'strokes-report-bug #'report-emacs-bug "24.1")
(defun strokes-window-configuration-changed-p ()
"Non-nil if the `strokes-window-configuration' frame properties changed.
@@ -1379,8 +1366,8 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
(defvar strokes-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [(shift down-mouse-2)] 'strokes-do-stroke)
- (define-key map [(meta down-mouse-2)] 'strokes-do-complex-stroke)
+ (define-key map [(shift down-mouse-2)] #'strokes-do-stroke)
+ (define-key map [(meta down-mouse-2)] #'strokes-do-complex-stroke)
map))
;;;###autoload
@@ -1399,8 +1386,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
\\[strokes-decode-buffer].
\\{strokes-mode-map}"
- nil strokes-lighter strokes-mode-map
- :group 'strokes :global t
+ :lighter strokes-lighter :global t
(cond ((not (display-mouse-p))
(error "Can't use Strokes without a mouse"))
(strokes-mode ; turn on strokes
@@ -1408,15 +1394,15 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
(null strokes-global-map)
(strokes-load-user-strokes))
(add-hook 'kill-emacs-query-functions
- 'strokes-prompt-user-save-strokes)
+ #'strokes-prompt-user-save-strokes)
(add-hook 'select-frame-hook
- 'strokes-update-window-configuration)
+ #'strokes-update-window-configuration)
(strokes-update-window-configuration))
(t ; turn off strokes
(if (get-buffer strokes-buffer-name)
(kill-buffer (get-buffer strokes-buffer-name)))
(remove-hook 'select-frame-hook
- 'strokes-update-window-configuration))))
+ #'strokes-update-window-configuration))))
;;;; strokes-xpm stuff (later may be separate)...
@@ -1426,74 +1412,75 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
(defface strokes-char '((t (:background "lightgray")))
"Face for strokes characters."
- :version "21.1"
- :group 'strokes)
+ :version "21.1")
(put 'strokes 'char-table-extra-slots 0)
-(defconst strokes-char-table (make-char-table 'strokes) ;
+(defconst strokes-char-table
+ (let ((ct (make-char-table 'strokes))) ;
+ (aset ct ?0 0)
+ (aset ct ?1 1)
+ (aset ct ?2 2)
+ (aset ct ?3 3)
+ (aset ct ?4 4)
+ (aset ct ?5 5)
+ (aset ct ?6 6)
+ (aset ct ?7 7)
+ (aset ct ?8 8)
+ (aset ct ?9 9)
+ (aset ct ?a 10)
+ (aset ct ?b 11)
+ (aset ct ?c 12)
+ (aset ct ?d 13)
+ (aset ct ?e 14)
+ (aset ct ?f 15)
+ (aset ct ?g 16)
+ (aset ct ?h 17)
+ (aset ct ?i 18)
+ (aset ct ?j 19)
+ (aset ct ?k 20)
+ (aset ct ?l 21)
+ (aset ct ?m 22)
+ (aset ct ?n 23)
+ (aset ct ?o 24)
+ (aset ct ?p 25)
+ (aset ct ?q 26)
+ (aset ct ?r 27)
+ (aset ct ?s 28)
+ (aset ct ?t 29)
+ (aset ct ?u 30)
+ (aset ct ?v 31)
+ (aset ct ?w 32)
+ (aset ct ?x 33)
+ (aset ct ?y 34)
+ (aset ct ?z 35)
+ (aset ct ?A 36)
+ (aset ct ?B 37)
+ (aset ct ?C 38)
+ (aset ct ?D 39)
+ (aset ct ?E 40)
+ (aset ct ?F 41)
+ (aset ct ?G 42)
+ (aset ct ?H 43)
+ (aset ct ?I 44)
+ (aset ct ?J 45)
+ (aset ct ?K 46)
+ (aset ct ?L 47)
+ (aset ct ?M 48)
+ (aset ct ?N 49)
+ (aset ct ?O 50)
+ (aset ct ?P 51)
+ (aset ct ?Q 52)
+ (aset ct ?R 53)
+ (aset ct ?S 54)
+ (aset ct ?T 55)
+ (aset ct ?U 56)
+ (aset ct ?V 57)
+ (aset ct ?W 58)
+ (aset ct ?X 59)
+ (aset ct ?Y 60)
+ (aset ct ?Z 61)
+ ct)
"The table which stores values for the character keys.")
-(aset strokes-char-table ?0 0)
-(aset strokes-char-table ?1 1)
-(aset strokes-char-table ?2 2)
-(aset strokes-char-table ?3 3)
-(aset strokes-char-table ?4 4)
-(aset strokes-char-table ?5 5)
-(aset strokes-char-table ?6 6)
-(aset strokes-char-table ?7 7)
-(aset strokes-char-table ?8 8)
-(aset strokes-char-table ?9 9)
-(aset strokes-char-table ?a 10)
-(aset strokes-char-table ?b 11)
-(aset strokes-char-table ?c 12)
-(aset strokes-char-table ?d 13)
-(aset strokes-char-table ?e 14)
-(aset strokes-char-table ?f 15)
-(aset strokes-char-table ?g 16)
-(aset strokes-char-table ?h 17)
-(aset strokes-char-table ?i 18)
-(aset strokes-char-table ?j 19)
-(aset strokes-char-table ?k 20)
-(aset strokes-char-table ?l 21)
-(aset strokes-char-table ?m 22)
-(aset strokes-char-table ?n 23)
-(aset strokes-char-table ?o 24)
-(aset strokes-char-table ?p 25)
-(aset strokes-char-table ?q 26)
-(aset strokes-char-table ?r 27)
-(aset strokes-char-table ?s 28)
-(aset strokes-char-table ?t 29)
-(aset strokes-char-table ?u 30)
-(aset strokes-char-table ?v 31)
-(aset strokes-char-table ?w 32)
-(aset strokes-char-table ?x 33)
-(aset strokes-char-table ?y 34)
-(aset strokes-char-table ?z 35)
-(aset strokes-char-table ?A 36)
-(aset strokes-char-table ?B 37)
-(aset strokes-char-table ?C 38)
-(aset strokes-char-table ?D 39)
-(aset strokes-char-table ?E 40)
-(aset strokes-char-table ?F 41)
-(aset strokes-char-table ?G 42)
-(aset strokes-char-table ?H 43)
-(aset strokes-char-table ?I 44)
-(aset strokes-char-table ?J 45)
-(aset strokes-char-table ?K 46)
-(aset strokes-char-table ?L 47)
-(aset strokes-char-table ?M 48)
-(aset strokes-char-table ?N 49)
-(aset strokes-char-table ?O 50)
-(aset strokes-char-table ?P 51)
-(aset strokes-char-table ?Q 52)
-(aset strokes-char-table ?R 53)
-(aset strokes-char-table ?S 54)
-(aset strokes-char-table ?T 55)
-(aset strokes-char-table ?U 56)
-(aset strokes-char-table ?V 57)
-(aset strokes-char-table ?W 58)
-(aset strokes-char-table ?X 59)
-(aset strokes-char-table ?Y 60)
-(aset strokes-char-table ?Z 61)
(defconst strokes-base64-chars
;; I wanted to make this a vector of individual like (vector ?0
diff --git a/lisp/subr.el b/lisp/subr.el
index f0de6d5ac92..0a31ef2b29f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -31,7 +31,8 @@
"Tell the byte-compiler that function FN is defined, in FILE.
The FILE argument is not used by the byte-compiler, but by the
`check-declare' package, which checks that FILE contains a
-definition for FN.
+definition for FN. (FILE can be nil, and that disables this
+check.)
FILE can be either a Lisp file (in which case the \".el\"
extension is optional), or a C file. C files are expanded
@@ -64,8 +65,8 @@ For more information, see Info node `(elisp)Declaring Functions'."
;;;; Basic Lisp macros.
-(defalias 'not 'null)
-(defalias 'sxhash 'sxhash-equal)
+(defalias 'not #'null)
+(defalias 'sxhash #'sxhash-equal)
(defmacro noreturn (form)
"Evaluate FORM, expecting it not to return.
@@ -82,14 +83,27 @@ Testcover will raise an error."
form)
(defmacro def-edebug-spec (symbol spec)
- "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
+ "Set the Edebug SPEC to use for sexps which have SYMBOL as head.
Both SYMBOL and SPEC are unevaluated. The SPEC can be:
0 (instrument no arguments); t (instrument all arguments);
a symbol (naming a function with an Edebug specification); or a list.
The elements of the list describe the argument types; see
Info node `(elisp)Specification List' for details."
+ (declare (indent 1))
`(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
+(defun def-edebug-elem-spec (name spec)
+ "Define a new Edebug spec element NAME as shorthand for SPEC.
+The SPEC has to be a list."
+ (declare (indent 1))
+ (when (string-match "\\`[&:]" (symbol-name name))
+ ;; & and : have special meaning in spec element names.
+ (error "Edebug spec name cannot start with '&' or ':'"))
+ (unless (consp spec)
+ (error "Edebug spec has to be a list: %S" spec))
+ (put name 'edebug-elem-spec spec))
+
+
(defmacro lambda (&rest cdr)
"Return an anonymous function.
Under dynamic binding, a call of the form (lambda ARGS DOCSTRING
@@ -182,6 +196,14 @@ buffer-local wherever it is set."
(list 'progn (list 'defvar var val docstring)
(list 'make-variable-buffer-local (list 'quote var))))
+(defun buffer-local-boundp (symbol buffer)
+ "Return non-nil if SYMBOL is bound in BUFFER.
+Also see `local-variable-p'."
+ (condition-case nil
+ (buffer-local-value symbol buffer)
+ (:success t)
+ (void-variable nil)))
+
(defmacro push (newelt place)
"Add NEWELT to the list stored in the generalized variable PLACE.
This is morally equivalent to (setf PLACE (cons NEWELT PLACE)),
@@ -233,6 +255,11 @@ value of last one, or nil if there are none.
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
+(defsubst subr-primitive-p (object)
+ "Return t if OBJECT is a built-in primitive function."
+ (and (subrp object)
+ (not (subr-native-elisp-p object))))
+
(defsubst xor (cond1 cond2)
"Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
@@ -360,10 +387,18 @@ PREFIX is a string, and defaults to \"g\"."
(defun ignore (&rest _arguments)
"Do nothing and return nil.
-This function accepts any number of ARGUMENTS, but ignores them."
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `always'."
+ (declare (completion ignore))
(interactive)
nil)
+(defun always (&rest _arguments)
+ "Do nothing and return t.
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `ignore'."
+ t)
+
;; Signal a compile-error if the first arg is missing.
(defun error (&rest args)
"Signal an error, making a message by passing ARGS to `format-message'.
@@ -772,7 +807,7 @@ If TEST is omitted or nil, `equal' is used."
(let (found (tail alist) value)
(while (and tail (not found))
(let ((elt (car tail)))
- (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+ (when (funcall (or test #'equal) (if (consp elt) (car elt) elt) key)
(setq found t value (if (consp elt) (cdr elt) default))))
(setq tail (cdr tail)))
value))
@@ -866,7 +901,9 @@ Example:
(defun remove (elt seq)
"Return a copy of SEQ with all occurrences of ELT removed.
-SEQ must be a list, vector, or string. The comparison is done with `equal'."
+SEQ must be a list, vector, or string. The comparison is done with `equal'.
+Contrary to `delete', this does not use side-effects, and the argument
+SEQ is not modified."
(declare (side-effect-free t))
(if (nlistp seq)
;; If SEQ isn't a list, there's no need to copy SEQ because
@@ -902,6 +939,7 @@ For an approximate inverse of this, see `key-description'."
(defun undefined ()
"Beep to tell the user this binding is undefined."
+ (declare (completion ignore))
(interactive)
(ding)
(if defining-kbd-macro
@@ -922,14 +960,14 @@ For an approximate inverse of this, see `key-description'."
"Make MAP override all normally self-inserting keys to be undefined.
Normally, as an exception, digits and minus-sign are set to make prefix args,
but optional second arg NODIGITS non-nil treats them like other chars."
- (define-key map [remap self-insert-command] 'undefined)
+ (define-key map [remap self-insert-command] #'undefined)
(or nodigits
(let (loop)
- (define-key map "-" 'negative-argument)
+ (define-key map "-" #'negative-argument)
;; Make plain numbers do numeric args.
(setq loop ?0)
(while (<= loop ?9)
- (define-key map (char-to-string loop) 'digit-argument)
+ (define-key map (char-to-string loop) #'digit-argument)
(setq loop (1+ loop))))))
(defun make-composed-keymap (maps &optional parent)
@@ -966,8 +1004,8 @@ a menu, so this function is not useful for non-menu keymaps."
(setq key
(if (<= (length key) 1) (aref key 0)
(setq keymap (lookup-key keymap
- (apply 'vector
- (butlast (mapcar 'identity key)))))
+ (apply #'vector
+ (butlast (mapcar #'identity key)))))
(aref key (1- (length key)))))
(let ((tail keymap) done inserted)
(while (and (not done) tail)
@@ -1095,7 +1133,7 @@ Subkeymaps may be modified but are not canonicalized."
(push (cons key item) bindings)))
map)))
;; Create the new map.
- (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt))
+ (setq map (funcall (if ranges #'make-keymap #'make-sparse-keymap) prompt))
(dolist (binding ranges)
;; Treat char-ranges specially. FIXME: need to merge as well.
(define-key map (vector (car binding)) (cdr binding)))
@@ -1285,6 +1323,7 @@ in a cleaner way with command remapping, like this:
(define-key map "l" #'downcase-word)
(define-key map "c" #'capitalize-word)
(define-key map "x" #'execute-extended-command)
+ (define-key map "X" #'execute-extended-command-for-buffer)
map)
"Default keymap for ESC (meta) commands.
The normal global definition of the character ESC indirects to this keymap.")
@@ -1655,6 +1694,12 @@ The return value has the form (WIDTH . HEIGHT). POSITION should
be a list of the form returned by `event-start' and `event-end'."
(nth 9 position))
+(defun values--store-value (value)
+ "Store VALUE in the obsolete `values' variable."
+ (with-suppressed-warnings ((obsolete values))
+ (push value values))
+ value)
+
;;;; Obsolescent names for functions.
@@ -1721,32 +1766,42 @@ be a list of the form returned by `event-start' and `event-end'."
(make-obsolete-variable 'load-dangerous-libraries
"no longer used." "27.1")
+(defvar inhibit--record-char nil
+ "Obsolete variable.
+This was used internally by quail.el and keyboard.c in Emacs 27.
+It does nothing in Emacs 28.")
+(make-obsolete-variable 'inhibit--record-char nil "28.1")
+
+;; We can't actually make `values' obsolete, because that will result
+;; in warnings when using `values' in let-bindings.
+;;(make-obsolete-variable 'values "no longer used" "28.1")
+
;;;; Alternate names for functions - these are not being phased out.
-(defalias 'send-string 'process-send-string)
-(defalias 'send-region 'process-send-region)
-(defalias 'string= 'string-equal)
-(defalias 'string< 'string-lessp)
-(defalias 'string> 'string-greaterp)
-(defalias 'move-marker 'set-marker)
-(defalias 'rplaca 'setcar)
-(defalias 'rplacd 'setcdr)
-(defalias 'beep 'ding) ;preserve lingual purity
-(defalias 'indent-to-column 'indent-to)
-(defalias 'backward-delete-char 'delete-backward-char)
+(defalias 'send-string #'process-send-string)
+(defalias 'send-region #'process-send-region)
+(defalias 'string= #'string-equal)
+(defalias 'string< #'string-lessp)
+(defalias 'string> #'string-greaterp)
+(defalias 'move-marker #'set-marker)
+(defalias 'rplaca #'setcar)
+(defalias 'rplacd #'setcdr)
+(defalias 'beep #'ding) ;preserve lingual purity
+(defalias 'indent-to-column #'indent-to)
+(defalias 'backward-delete-char #'delete-backward-char)
(defalias 'search-forward-regexp (symbol-function 're-search-forward))
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
-(defalias 'int-to-string 'number-to-string)
-(defalias 'store-match-data 'set-match-data)
-(defalias 'chmod 'set-file-modes)
-(defalias 'mkdir 'make-directory)
+(defalias 'int-to-string #'number-to-string)
+(defalias 'store-match-data #'set-match-data)
+(defalias 'chmod #'set-file-modes)
+(defalias 'mkdir #'make-directory)
;; These are the XEmacs names:
-(defalias 'point-at-eol 'line-end-position)
-(defalias 'point-at-bol 'line-beginning-position)
+(defalias 'point-at-eol #'line-end-position)
+(defalias 'point-at-bol #'line-beginning-position)
(define-obsolete-function-alias 'user-original-login-name
- 'user-login-name "28.1")
+ #'user-login-name "28.1")
;;;; Hook manipulation functions.
@@ -1775,9 +1830,15 @@ This makes the hook buffer-local, and it makes t a member of the
buffer-local value. That acts as a flag to run the hook
functions of the global value as well as in the local value.
-HOOK should be a symbol, and FUNCTION may be any valid function. If
-HOOK is void, it is first set to nil. If HOOK's value is a single
-function, it is changed to a list of functions."
+HOOK should be a symbol. If HOOK is void, it is first set to
+nil. If HOOK's value is a single function, it is changed to a
+list of functions.
+
+FUNCTION may be any valid function, but it's recommended to use a
+function symbol and not a lambda form. Using a symbol will
+ensure that the function is not re-added if the function is
+edited, and using lambda forms may also have a negative
+performance impact when running `add-hook' and `remove-hook'."
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
(unless (numberp depth) (setq depth (if depth 90 0)))
@@ -1795,12 +1856,13 @@ function, it is changed to a list of functions."
(unless (member function hook-value)
(when (stringp function) ;FIXME: Why?
(setq function (purecopy function)))
+ ;; All those `equal' tests performed between functions can end up being
+ ;; costly since those functions may be large recursive and even cyclic
+ ;; structures, so we index `hook--depth-alist' with `eq'. (bug#46326)
(when (or (get hook 'hook--depth-alist) (not (zerop depth)))
;; Note: The main purpose of the above `when' test is to avoid running
;; this `setf' before `gv' is loaded during bootstrap.
- (setf (alist-get function (get hook 'hook--depth-alist)
- 0 'remove #'equal)
- depth))
+ (push (cons function depth) (get hook 'hook--depth-alist)))
(setq hook-value
(if (< 0 depth)
(append hook-value (list function))
@@ -1810,8 +1872,8 @@ function, it is changed to a list of functions."
(setq hook-value
(sort (if (< 0 depth) hook-value (copy-sequence hook-value))
(lambda (f1 f2)
- (< (alist-get f1 depth-alist 0 nil #'equal)
- (alist-get f2 depth-alist 0 nil #'equal))))))))
+ (< (alist-get f1 depth-alist 0 nil #'eq)
+ (alist-get f2 depth-alist 0 nil #'eq))))))))
;; Set the actual variable
(if local
(progn
@@ -1860,7 +1922,7 @@ one will be removed."
(if local "Buffer-local" "Global"))
fn-alist
nil t)
- fn-alist nil nil 'string=)))
+ fn-alist nil nil #'string=)))
(list hook function local)))
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
@@ -1872,11 +1934,21 @@ one will be removed."
(not (and (consp (symbol-value hook))
(memq t (symbol-value hook)))))
(setq local t))
- (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook)))
+ (old-fun nil))
;; Remove the function, for both the list and the non-list cases.
(if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
- (if (equal hook-value function) (setq hook-value nil))
- (setq hook-value (delete function (copy-sequence hook-value))))
+ (when (equal hook-value function)
+ (setq old-fun hook-value)
+ (setq hook-value nil))
+ (when (setq old-fun (car (member function hook-value)))
+ (setq hook-value (remq old-fun hook-value))))
+ (when old-fun
+ ;; Remove auxiliary depth info to avoid leaks (bug#46414)
+ ;; and to avoid the list growing too long.
+ (let* ((depths (get hook 'hook--depth-alist))
+ (di (assq old-fun depths)))
+ (when di (put hook 'hook--depth-alist (delq di depths)))))
;; If the function is on the global hook, we need to shadow it locally
;;(when (and local (member function (default-value hook))
;; (not (member (cons 'not function) hook-value)))
@@ -1929,10 +2001,10 @@ all symbols are bound before any of the VALUEFORMs are evalled."
(t `(let* ,(nreverse seqbinds) ,nbody))))))
(defmacro dlet (binders &rest body)
- "Like `let*' but using dynamic scoping."
+ "Like `let' but using dynamic scoping."
(declare (indent 1) (debug let))
;; (defvar FOO) only affects the current scope, but in order for
- ;; this not to affect code after the `let*' we need to create a new scope,
+ ;; this not to affect code after the main `let' we need to create a new scope,
;; which is what the surrounding `let' is for.
;; FIXME: (let () ...) currently doesn't actually create a new scope,
;; which is why we use (let (_) ...).
@@ -1940,7 +2012,7 @@ all symbols are bound before any of the VALUEFORMs are evalled."
,@(mapcar (lambda (binder)
`(defvar ,(if (consp binder) (car binder) binder)))
binders)
- (let* ,binders ,@body)))
+ (let ,binders ,@body)))
(defmacro with-wrapper-hook (hook args &rest body)
@@ -1973,7 +2045,7 @@ FUN is then called once."
(defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body)
"Like (with-wrapper-hook HOOK ARGS BODY), but without warnings."
- (declare (debug (form sexp body)))
+ (declare (debug (form sexp def-body)))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
(let ((funs (make-symbol "funs"))
@@ -2064,7 +2136,7 @@ can do the job."
,(if append
`(setq ,sym (append ,sym (list ,x)))
`(push ,x ,sym))))))
- (if (not (macroexp--compiling-p))
+ (if (not (macroexp-compiling-p))
code
`(progn
(macroexp--funcall-if-compiled ',warnfun)
@@ -2072,9 +2144,9 @@ can do the job."
(if (cond
((null compare-fn)
(member element (symbol-value list-var)))
- ((eq compare-fn 'eq)
+ ((eq compare-fn #'eq)
(memq element (symbol-value list-var)))
- ((eq compare-fn 'eql)
+ ((eq compare-fn #'eql)
(memql element (symbol-value list-var)))
(t
(let ((lst (symbol-value list-var)))
@@ -2292,7 +2364,8 @@ tho trying to avoid AVOIDED-MODES."
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
"Register a new minor mode.
-This is an XEmacs-compatibility function. Use `define-minor-mode' instead.
+This function shouldn't be used directly -- use `define-minor-mode'
+instead (which will then call this function).
TOGGLE is a symbol that is the name of a buffer-local variable that
is toggled on or off to say whether the minor mode is active or not.
@@ -2412,7 +2485,11 @@ 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.
-Otherwise TYPE is assumed to be a symbol property."
+Otherwise TYPE is assumed to be a symbol property.
+
+This function only works for symbols defined in Lisp files. For
+symbols that are defined in C files, use `help-C-file-name'
+instead."
(if (and (or (null type) (eq type 'defun))
(symbolp symbol)
(autoloadp (symbol-function symbol)))
@@ -2499,13 +2576,13 @@ use `start-file-process'."
(defun process-lines-handling-status (program status-handler &rest args)
"Execute PROGRAM with ARGS, returning its output as a list of lines.
-If STATUS-HANDLER is non-NIL, it must be a function with one
+If STATUS-HANDLER is non-nil, it must be a function with one
argument, which will be called with the exit status of the
program before the output is collected. If STATUS-HANDLER is
-NIL, an error is signalled if the program returns with a non-zero
+nil, an error is signaled if the program returns with a non-zero
exit status."
(with-temp-buffer
- (let ((status (apply 'call-process program nil (current-buffer) nil args)))
+ (let ((status (apply #'call-process program nil (current-buffer) nil args)))
(if status-handler
(funcall status-handler status)
(unless (eq status 0)
@@ -2530,7 +2607,7 @@ Also see `process-lines-ignore-status'."
"Execute PROGRAM with ARGS, returning its output as a list of lines.
The exit status of the program is ignored.
Also see `process-lines'."
- (apply #'process-lines-handling-status program #'identity args))
+ (apply #'process-lines-handling-status program #'ignore args))
(defun process-live-p (process)
"Return non-nil if PROCESS is alive.
@@ -2551,7 +2628,7 @@ process."
(format "Buffer %S has a running process; kill it? "
(buffer-name (current-buffer)))))))
-(add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function)
+(add-hook 'kill-buffer-query-functions #'process-kill-buffer-query-function)
;; process plist management
@@ -2739,7 +2816,7 @@ by doing (clear-string STRING)."
(use-local-map read-passwd-map)
(setq-local inhibit-modification-hooks nil) ;bug#15501.
(setq-local show-paren-mode nil) ;bug#16091.
- (add-hook 'post-command-hook 'read-password--hide-password nil t))
+ (add-hook 'post-command-hook #'read-password--hide-password nil t))
(unwind-protect
(let ((enable-recursive-minibuffers t)
(read-hide-char (or read-hide-char ?*)))
@@ -2749,8 +2826,8 @@ by doing (clear-string STRING)."
;; Not sure why but it seems that there might be cases where the
;; minibuffer is not always properly reset later on, so undo
;; whatever we've done here (bug#11392).
- (remove-hook 'after-change-functions 'read-password--hide-password
- 'local)
+ (remove-hook 'after-change-functions
+ #'read-password--hide-password 'local)
(kill-local-variable 'post-self-insert-hook)
;; And of course, don't keep the sensitive data around.
(erase-buffer))))))))
@@ -2770,9 +2847,9 @@ This function is used by the `interactive' code letter `n'."
(when default1
(setq prompt
(if (string-match "\\(\\):[ \t]*\\'" prompt)
- (replace-match (format " (default %s)" default1) t t prompt 1)
+ (replace-match (format minibuffer-default-prompt-format default1) t t prompt 1)
(replace-regexp-in-string "[ \t]*\\'"
- (format " (default %s) " default1)
+ (format minibuffer-default-prompt-format default1)
prompt t t))))
(while
(progn
@@ -2780,7 +2857,7 @@ This function is used by the `interactive' code letter `n'."
prompt nil nil nil (or hist 'read-number-history)
(when default
(if (consp default)
- (mapcar 'number-to-string (delq nil default))
+ (mapcar #'number-to-string (delq nil default))
(number-to-string default))))))
(condition-case nil
(setq n (cond
@@ -2798,6 +2875,11 @@ This function is used by the `interactive' code letter `n'."
Otherwise, use the minibuffer.")
(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
+ (if (not read-char-choice-use-read-key)
+ (read-char-from-minibuffer prompt chars)
+ (read-char-choice-with-read-key prompt chars inhibit-keyboard-quit)))
+
+(defun read-char-choice-with-read-key (prompt chars &optional inhibit-keyboard-quit)
"Read and return one of CHARS, prompting for PROMPT.
Any input that is not one of CHARS is ignored.
@@ -2807,46 +2889,44 @@ keyboard-quit events while waiting for a valid input.
If you bind the variable `help-form' to a non-nil value
while calling this function, then pressing `help-char'
causes it to evaluate `help-form' and display the result."
- (if (not read-char-choice-use-read-key)
- (read-char-from-minibuffer prompt chars)
- (unless (consp chars)
- (error "Called `read-char-choice' without valid char choices"))
- (let (char done show-help (helpbuf " *Char Help*"))
- (let ((cursor-in-echo-area t)
- (executing-kbd-macro executing-kbd-macro)
- (esc-flag nil))
- (save-window-excursion ; in case we call help-form-show
- (while (not done)
- (unless (get-text-property 0 'face prompt)
- (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
- (setq char (let ((inhibit-quit inhibit-keyboard-quit))
- (read-key prompt)))
- (and show-help (buffer-live-p (get-buffer helpbuf))
- (kill-buffer helpbuf))
- (cond
- ((not (numberp char)))
- ;; If caller has set help-form, that's enough.
- ;; They don't explicitly have to add help-char to chars.
- ((and help-form
- (eq char help-char)
- (setq show-help t)
- (help-form-show)))
- ((memq char chars)
- (setq done t))
- ((and executing-kbd-macro (= char -1))
- ;; read-event returns -1 if we are in a kbd macro and
- ;; there are no more events in the macro. Attempt to
- ;; get an event interactively.
- (setq executing-kbd-macro nil))
- ((not inhibit-keyboard-quit)
- (cond
- ((and (null esc-flag) (eq char ?\e))
- (setq esc-flag t))
- ((memq char '(?\C-g ?\e))
- (keyboard-quit))))))))
- ;; Display the question with the answer. But without cursor-in-echo-area.
- (message "%s%s" prompt (char-to-string char))
- char)))
+ (unless (consp chars)
+ (error "Called `read-char-choice' without valid char choices"))
+ (let (char done show-help (helpbuf " *Char Help*"))
+ (let ((cursor-in-echo-area t)
+ (executing-kbd-macro executing-kbd-macro)
+ (esc-flag nil))
+ (save-window-excursion ; in case we call help-form-show
+ (while (not done)
+ (unless (get-text-property 0 'face prompt)
+ (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
+ (setq char (let ((inhibit-quit inhibit-keyboard-quit))
+ (read-key prompt)))
+ (and show-help (buffer-live-p (get-buffer helpbuf))
+ (kill-buffer helpbuf))
+ (cond
+ ((not (numberp char)))
+ ;; If caller has set help-form, that's enough.
+ ;; They don't explicitly have to add help-char to chars.
+ ((and help-form
+ (eq char help-char)
+ (setq show-help t)
+ (help-form-show)))
+ ((memq char chars)
+ (setq done t))
+ ((and executing-kbd-macro (= char -1))
+ ;; read-event returns -1 if we are in a kbd macro and
+ ;; there are no more events in the macro. Attempt to
+ ;; get an event interactively.
+ (setq executing-kbd-macro nil))
+ ((not inhibit-keyboard-quit)
+ (cond
+ ((and (null esc-flag) (eq char ?\e))
+ (setq esc-flag t))
+ ((memq char '(?\C-g ?\e))
+ (keyboard-quit))))))))
+ ;; Display the question with the answer. But without cursor-in-echo-area.
+ (message "%s%s" prompt (char-to-string char))
+ char))
(defun sit-for (seconds &optional nodisp obsolete)
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
@@ -2934,13 +3014,13 @@ If there is a natural number at point, use it as default."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
- (define-key map [remap self-insert-command] 'read-char-from-minibuffer-insert-char)
+ (define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char)
- (define-key map [remap recenter-top-bottom] 'minibuffer-recenter-top-bottom)
- (define-key map [remap scroll-up-command] 'minibuffer-scroll-up-command)
- (define-key map [remap scroll-down-command] 'minibuffer-scroll-down-command)
- (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window)
- (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down)
+ (define-key map [remap recenter-top-bottom] #'minibuffer-recenter-top-bottom)
+ (define-key map [remap scroll-up-command] #'minibuffer-scroll-up-command)
+ (define-key map [remap scroll-down-command] #'minibuffer-scroll-down-command)
+ (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
+ (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
map)
"Keymap for the `read-char-from-minibuffer' function.")
@@ -3003,9 +3083,9 @@ There is no need to explicitly add `help-char' to CHARS;
(help-form-show)))))
(dolist (char chars)
(define-key map (vector char)
- 'read-char-from-minibuffer-insert-char))
+ #'read-char-from-minibuffer-insert-char))
(define-key map [remap self-insert-command]
- 'read-char-from-minibuffer-insert-other)
+ #'read-char-from-minibuffer-insert-other)
(puthash (list help-form (cons help-char chars))
map read-char-from-minibuffer-map-hash)
map))
@@ -3038,26 +3118,26 @@ There is no need to explicitly add `help-char' to CHARS;
(set-keymap-parent map minibuffer-local-map)
(dolist (symbol '(act act-and-show act-and-exit automatic))
- (define-key map (vector 'remap symbol) 'y-or-n-p-insert-y))
+ (define-key map (vector 'remap symbol) #'y-or-n-p-insert-y))
- (define-key map [remap skip] 'y-or-n-p-insert-n)
+ (define-key map [remap skip] #'y-or-n-p-insert-n)
(dolist (symbol '(backup undo undo-all edit edit-replacement
delete-and-edit ignore self-insert-command))
- (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
+ (define-key map (vector 'remap symbol) #'y-or-n-p-insert-other))
- (define-key map [remap recenter] 'minibuffer-recenter-top-bottom)
- (define-key map [remap scroll-up] 'minibuffer-scroll-up-command)
- (define-key map [remap scroll-down] 'minibuffer-scroll-down-command)
- (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window)
- (define-key map [remap scroll-other-window-down] 'minibuffer-scroll-other-window-down)
+ (define-key map [remap recenter] #'minibuffer-recenter-top-bottom)
+ (define-key map [remap scroll-up] #'minibuffer-scroll-up-command)
+ (define-key map [remap scroll-down] #'minibuffer-scroll-down-command)
+ (define-key map [remap scroll-other-window] #'minibuffer-scroll-other-window)
+ (define-key map [remap scroll-other-window-down] #'minibuffer-scroll-other-window-down)
- (define-key map [escape] 'abort-recursive-edit)
+ (define-key map [escape] #'abort-recursive-edit)
(dolist (symbol '(quit exit exit-prefix))
- (define-key map (vector 'remap symbol) 'abort-recursive-edit))
+ (define-key map (vector 'remap symbol) #'abort-recursive-edit))
;; FIXME: try catch-all instead of explicit bindings:
- ;; (define-key map [remap t] 'y-or-n-p-insert-other)
+ ;; (define-key map [remap t] #'y-or-n-p-insert-other)
map)
"Keymap that defines additional bindings for `y-or-n-p' answers.")
@@ -3301,7 +3381,7 @@ to `accept-change-group' or `cancel-change-group'."
;; insertions are ever merged/combined, so we use such a "boundary"
;; only when the last change was an insertion and we use the position
;; of the last insertion.
- (when (numberp (caar buffer-undo-list))
+ (when (numberp (car-safe (car buffer-undo-list)))
(push (cons (caar buffer-undo-list) (caar buffer-undo-list))
buffer-undo-list))))))
@@ -3354,7 +3434,7 @@ This finishes the change group by reverting all of its changes."
;; For compatibility.
(define-obsolete-function-alias 'redraw-modeline
- 'force-mode-line-update "24.3")
+ #'force-mode-line-update "24.3")
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
@@ -3498,7 +3578,7 @@ When in a major mode that does not provide its own
symbol at point exactly."
(let ((tag (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default))))
+ #'find-tag-default))))
(if tag (regexp-quote tag))))
(defun find-tag-default-as-symbol-regexp ()
@@ -3512,8 +3592,8 @@ symbol at point exactly."
(if (and tag-regexp
(eq (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default)
- 'find-tag-default))
+ #'find-tag-default)
+ #'find-tag-default))
(format "\\_<%s\\_>" tag-regexp)
tag-regexp)))
@@ -3601,7 +3681,7 @@ See Info node `(elisp)Security Considerations'."
"''"
;; Quote everything except POSIX filename characters.
;; This should be safe enough even for really weird shells.
- (replace-regexp-in-string
+ (string-replace
"\n" "'\n'"
(replace-regexp-in-string "[^-0-9a-zA-Z_./\n]" "\\\\\\&" argument))))
))
@@ -3771,6 +3851,75 @@ Before insertion, process text properties according to
(insert-buffer-substring buffer start end)
(remove-yank-excluded-properties opoint (point))))
+(defun insert-into-buffer (buffer &optional start end)
+ "Insert the contents of the current buffer into BUFFER.
+If START/END, only insert that region from the current buffer.
+Point in BUFFER will be placed after the inserted text."
+ (let ((current (current-buffer)))
+ (with-current-buffer buffer
+ (insert-buffer-substring current start end))))
+
+(defun replace-string-in-region (string replacement &optional start end)
+ "Replace STRING with REPLACEMENT in the region from START to END.
+The number of replaced occurrences are returned, or nil if STRING
+doesn't exist in the region.
+
+If START is nil, use the current point. If END is nil, use `point-max'.
+
+Comparisons and replacements are done with fixed case."
+ (if start
+ (when (< start (point-min))
+ (error "Start before start of buffer"))
+ (setq start (point)))
+ (if end
+ (when (> end (point-max))
+ (error "End after end of buffer"))
+ (setq end (point-max)))
+ (save-excursion
+ (let ((matches 0)
+ (case-fold-search nil))
+ (goto-char start)
+ (while (search-forward string end t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert replacement)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches))))
+
+(defun replace-regexp-in-region (regexp replacement &optional start end)
+ "Replace REGEXP with REPLACEMENT in the region from START to END.
+The number of replaced occurrences are returned, or nil if REGEXP
+doesn't exist in the region.
+
+If START is nil, use the current point. If END is nil, use `point-max'.
+
+Comparisons and replacements are done with fixed case.
+
+REPLACEMENT can use the following special elements:
+
+ `\\&' in NEWTEXT means substitute original matched text.
+ `\\N' means substitute what matched the Nth `\\(...\\)'.
+ If Nth parens didn't match, substitute nothing.
+ `\\\\' means insert one `\\'.
+ `\\?' is treated literally."
+ (if start
+ (when (< start (point-min))
+ (error "Start before start of buffer"))
+ (setq start (point)))
+ (if end
+ (when (> end (point-max))
+ (error "End after end of buffer"))
+ (setq end (point-max)))
+ (save-excursion
+ (let ((matches 0)
+ (case-fold-search nil))
+ (goto-char start)
+ (while (re-search-forward regexp end t)
+ (replace-match replacement t)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches))))
+
(defun yank-handle-font-lock-face-property (face start end)
"If `font-lock-defaults' is nil, apply FACE as a `face' property.
START and END denote the start and end of the text to act on.
@@ -3847,7 +3996,7 @@ discouraged."
(call-process shell-file-name
infile buffer display
shell-command-switch
- (mapconcat 'identity (cons command args) " ")))
+ (mapconcat #'identity (cons command args) " ")))
(defun process-file-shell-command (command &optional infile buffer display
&rest args)
@@ -3859,7 +4008,7 @@ Similar to `call-process-shell-command', but calls `process-file'."
(with-connection-local-variables
(process-file
shell-file-name infile buffer display shell-command-switch
- (mapconcat 'identity (cons command args) " "))))
+ (mapconcat #'identity (cons command args) " "))))
(defun call-shell-region (start end command &optional delete buffer)
"Send text from START to END as input to an inferior shell running COMMAND.
@@ -3890,7 +4039,7 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
Within a `track-mouse' form, mouse motion generates input events that
you can read with `read-event'.
Normally, mouse motion is ignored."
- (declare (debug t) (indent 0))
+ (declare (debug (def-body)) (indent 0))
`(internal--track-mouse (lambda () ,@body)))
(defmacro with-current-buffer (buffer-or-name &rest body)
@@ -4320,6 +4469,8 @@ the specified region. It must not change
Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single (apply ...) entry containing
the function `undo--wrap-and-run-primitive-undo'."
+ (if (markerp beg) (setq beg (marker-position beg)))
+ (if (markerp end) (setq end (marker-position end)))
(let ((old-bul buffer-undo-list)
(end-marker (copy-marker end t))
result)
@@ -4392,7 +4543,7 @@ change `before-change-functions' or `after-change-functions'.
Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single \(apply ...) entry containing
the function `undo--wrap-and-run-primitive-undo'."
- (declare (debug t) (indent 2))
+ (declare (debug (form form def-body)) (indent 2))
`(combine-change-calls-1 ,beg ,end (lambda () ,@body)))
(defun undo--wrap-and-run-primitive-undo (beg end list)
@@ -4718,7 +4869,7 @@ It understands Emacs Lisp quoting within STRING, such that
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
- (i (string-match "\"" string)))
+ (i (string-search "\"" string)))
(if (null i)
(split-string string sep t) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
@@ -4745,7 +4896,7 @@ Unless optional argument INPLACE is non-nil, return a new string."
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
(declare (pure t) (side-effect-free t))
(when (equal fromstring "")
- (signal 'wrong-length-argument fromstring))
+ (signal 'wrong-length-argument '(0)))
(let ((start 0)
(result nil)
pos)
@@ -4876,8 +5027,8 @@ FILE, a string, is described in the function `eval-after-load'."
""
;; Note: regexp-opt can't be used here, since we need to call
;; this before Emacs has been fully started. 2006-05-21
- (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
- "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
+ (concat "\\(" (mapconcat #'regexp-quote load-suffixes "\\|") "\\)?"))
+ "\\(" (mapconcat #'regexp-quote jka-compr-load-suffixes "\\|")
"\\)?\\'"))
(defun load-history-filename-element (file-regexp)
@@ -4893,7 +5044,6 @@ Return nil if there isn't one."
load-elt (and loads (car loads)))))
load-elt))
-(put 'eval-after-load 'lisp-indent-function 1)
(defun eval-after-load (file form)
"Arrange that if FILE is loaded, FORM will be run immediately afterwards.
If FILE is already loaded, evaluate FORM right now.
@@ -4928,7 +5078,8 @@ like `font-lock'.
This function makes or adds to an entry on `after-load-alist'.
See also `with-eval-after-load'."
- (declare (compiler-macro
+ (declare (indent 1)
+ (compiler-macro
(lambda (whole)
(if (eq 'quote (car-safe form))
;; Quote with lambda so the compiler can look inside.
@@ -4966,7 +5117,8 @@ See also `with-eval-after-load'."
(funcall func)
(let ((lfn load-file-name)
;; Don't use letrec, because equal (in
- ;; add/remove-hook) would get trapped in a cycle.
+ ;; add/remove-hook) could get trapped in a cycle
+ ;; (bug#46326).
(fun (make-symbol "eval-after-load-helper")))
(fset fun (lambda (file)
(when (equal file lfn)
@@ -4982,7 +5134,7 @@ See also `with-eval-after-load'."
FILE is normally a feature name, but it can also be a file name,
in case that file does not provide any feature. See `eval-after-load'
for more details about the different forms of FILE and their semantics."
- (declare (indent 1) (debug t))
+ (declare (indent 1) (debug (form def-body)))
`(eval-after-load ,file (lambda () ,@body)))
(defvar after-load-functions nil
@@ -5009,14 +5161,10 @@ This function is called directly from the C code."
obarray))
(msg (format "Package %s is deprecated" package))
(fun (lambda (msg) (message "%s" msg))))
- ;; Cribbed from cl--compiling-file.
(when (or (not (fboundp 'byte-compile-warning-enabled-p))
(byte-compile-warning-enabled-p 'obsolete package))
(cond
- ((and (boundp 'byte-compile--outbuffer)
- (bufferp (symbol-value 'byte-compile--outbuffer))
- (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
- " *Compiler Output*"))
+ ((bound-and-true-p byte-compile-current-file)
;; Don't warn about obsolete files using other obsolete files.
(unless (and (stringp byte-compile-current-file)
(string-match-p "/obsolete/[^/]*\\'"
@@ -5035,7 +5183,7 @@ This function is called directly from the C code."
"Display delayed warnings from `delayed-warnings-list'.
Used from `delayed-warnings-hook' (which see)."
(dolist (warning (nreverse delayed-warnings-list))
- (apply 'display-warning warning))
+ (apply #'display-warning warning))
(setq delayed-warnings-list nil))
(defun collapse-delayed-warnings ()
@@ -5368,7 +5516,7 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
`abortfunc', and `hookvar'."
(put symbol 'composefunc composefunc)
(put symbol 'sendfunc sendfunc)
- (put symbol 'abortfunc (or abortfunc 'kill-buffer))
+ (put symbol 'abortfunc (or abortfunc #'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
@@ -5480,7 +5628,7 @@ command is called from a keyboard macro?"
;; Now `frame' should be "the function from which we were called".
(pcase (cons frame nextframe)
;; No subr calls `interactive-p', so we can rule that out.
- (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
+ (`((,_ ,(pred (lambda (f) (subr-primitive-p (indirect-function f)))) . ,_) . ,_) nil)
;; In case #<subr funcall-interactively> without going through the
;; `funcall-interactively' symbol (bug#3984).
(`(,_ . (t ,(pred (lambda (f)
@@ -5533,7 +5681,7 @@ To test whether a function can be called interactively, use
(set symbol tail)))))
(define-obsolete-function-alias
- 'set-temporary-overlay-map 'set-transient-map "24.4")
+ 'set-temporary-overlay-map #'set-transient-map "24.4")
(defun set-transient-map (map &optional keep-pred on-exit)
"Set MAP as a temporary keymap taking precedence over other keymaps.
@@ -5558,8 +5706,8 @@ to deactivate this transient map, regardless of KEEP-PRED."
(internal-pop-keymap map 'overriding-terminal-local-map)
(remove-hook 'pre-command-hook clearfun)
(when on-exit (funcall on-exit)))))
- ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
- ;; in a cycle.
+ ;; Don't use letrec, because equal (in add/remove-hook) could get trapped
+ ;; in a cycle. (bug#46326)
(fset clearfun
(lambda ()
(with-demoted-errors "set-transient-map PCH: %S"
@@ -6161,7 +6309,29 @@ returned list are in the same order as in TREE.
;; Technically, `flatten-list' is a misnomer, but we provide it here
;; for discoverability:
-(defalias 'flatten-list 'flatten-tree)
+(defalias 'flatten-list #'flatten-tree)
+
+(defun string-trim-left (string &optional regexp)
+ "Trim STRING of leading string matching REGEXP.
+
+REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
+ (substring string (match-end 0))
+ string))
+
+(defun string-trim-right (string &optional regexp)
+ "Trim STRING of trailing string matching REGEXP.
+
+REGEXP defaults to \"[ \\t\\n\\r]+\"."
+ (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
+ string)))
+ (if i (substring string 0 i) string)))
+
+(defun string-trim (string &optional trim-left trim-right)
+ "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT.
+
+TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
+ (string-trim-left (string-trim-right string trim-right) trim-left))
;; The initial anchoring is for better performance in searching matches.
(defconst regexp-unmatchable "\\`a\\`"
@@ -6203,4 +6373,12 @@ of fill.el (for example `fill-region')."
This is intended for internal use only."
(internal--fill-string-single-line (apply #'format string objects)))
+(defun json-available-p ()
+ "Return non-nil if Emacs has libjansson support."
+ (and (fboundp 'json-serialize)
+ (condition-case nil
+ (json-serialize t)
+ (:success t)
+ (json-unavailable nil))))
+
;;; subr.el ends here
diff --git a/lisp/svg.el b/lisp/svg.el
index 717c84788f0..05accf4f13f 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -41,7 +41,7 @@
;; into the buffer:
;;
;; (setq svg (svg-create 800 800 :stroke "orange" :stroke-width 5))
-;; (svg-gradient svg "gradient" 'linear '(0 . "red") '(100 . "blue"))
+;; (svg-gradient svg "gradient" 'linear '((0 . "red") (100 . "blue")))
;; (save-excursion (goto-char (point-max)) (svg-insert-image svg))
;; Then add various elements to the structure:
@@ -81,7 +81,7 @@ STOPS is a list of percentage/color pairs."
(svg--def
svg
(apply
- 'dom-node
+ #'dom-node
(if (eq type 'linear)
'linearGradient
'radialGradient)
@@ -358,8 +358,7 @@ This is in contrast to merely setting it to 0."
(plist-get command-args :default-relative))))
(intern (if relative (downcase char) (upcase char)))))
-(defun svg--elliptical-arc-coordinates
- (rx ry x y &rest args)
+(defun svg--elliptical-arc-coordinates (rx ry x y &rest args)
(list
rx ry
(or (plist-get args :x-axis-rotation) 0)
@@ -370,21 +369,19 @@ This is in contrast to merely setting it to 0."
(defun svg--elliptical-arc-command (coordinates-list &rest args)
(cons
(svg--path-command-symbol 'a args)
- (apply 'append
- (mapcar
- (lambda (coordinates)
- (apply 'svg--elliptical-arc-coordinates
- coordinates))
- coordinates-list))))
+ (mapcan
+ (lambda (coordinates)
+ (apply #'svg--elliptical-arc-coordinates
+ coordinates))
+ coordinates-list)))
(defun svg--moveto-command (coordinates-list &rest args)
(cons
(svg--path-command-symbol 'm args)
- (apply 'append
- (mapcar
- (lambda (coordinates)
- (list (car coordinates) (cdr coordinates)))
- coordinates-list))))
+ (mapcan
+ (lambda (coordinates)
+ (list (car coordinates) (cdr coordinates)))
+ coordinates-list)))
(defun svg--closepath-command (&rest args)
(list (svg--path-command-symbol 'z args)))
@@ -392,11 +389,10 @@ This is in contrast to merely setting it to 0."
(defun svg--lineto-command (coordinates-list &rest args)
(cons
(svg--path-command-symbol 'l args)
- (apply 'append
- (mapcar
- (lambda (coordinates)
- (list (car coordinates) (cdr coordinates)))
- coordinates-list))))
+ (mapcan
+ (lambda (coordinates)
+ (list (car coordinates) (cdr coordinates)))
+ coordinates-list)))
(defun svg--horizontal-lineto-command (coordinate-list &rest args)
(cons
@@ -411,24 +407,24 @@ This is in contrast to merely setting it to 0."
(defun svg--curveto-command (coordinates-list &rest args)
(cons
(svg--path-command-symbol 'c args)
- (apply 'append coordinates-list)))
+ (apply #'append coordinates-list)))
(defun svg--smooth-curveto-command (coordinates-list &rest args)
(cons
(svg--path-command-symbol 's args)
- (apply 'append coordinates-list)))
+ (apply #'append coordinates-list)))
(defun svg--quadratic-bezier-curveto-command (coordinates-list
&rest args)
(cons
(svg--path-command-symbol 'q args)
- (apply 'append coordinates-list)))
+ (apply #'append coordinates-list)))
(defun svg--smooth-quadratic-bezier-curveto-command (coordinates-list
&rest args)
(cons
(svg--path-command-symbol 't args)
- (apply 'append coordinates-list)))
+ (apply #'append coordinates-list)))
(defun svg--eval-path-command (command default-relative)
(cl-letf
@@ -450,7 +446,7 @@ This is in contrast to merely setting it to 0."
#'svg--elliptical-arc-command)
(extended-command (append command (list :default-relative
default-relative))))
- (mapconcat 'prin1-to-string (apply extended-command) " ")))
+ (mapconcat #'prin1-to-string (apply extended-command) " ")))
(defun svg-path (svg commands &rest args)
"Add the outline of a shape to SVG according to COMMANDS.
@@ -459,7 +455,7 @@ modifiers. If :relative is t, then coordinates are relative to
the last position, or -- initially -- to the origin."
(let* ((default-relative (plist-get args :relative))
(stripped-args (svg--plist-delete args :relative))
- (d (mapconcat 'identity
+ (d (mapconcat #'identity
(mapcar
(lambda (command)
(svg--eval-path-command command
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 6720d82b471..4ec1143128b 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -72,6 +72,24 @@
:version "27.1"
:group 'tab-bar-faces)
+(defface tab-bar-tab-group-current
+ '((t :inherit tab-bar-tab :box nil :weight bold))
+ "Tab bar face for current group tab."
+ :version "28.1"
+ :group 'tab-bar-faces)
+
+(defface tab-bar-tab-group-inactive
+ '((t :inherit (shadow tab-bar-tab-inactive)))
+ "Tab bar face for inactive group tab."
+ :version "28.1"
+ :group 'tab-bar-faces)
+
+(defface tab-bar-tab-ungrouped
+ '((t :inherit (shadow tab-bar-tab-inactive)))
+ "Tab bar face for ungrouped tab when tab groups are used."
+ :version "28.1"
+ :group 'tab-bar-faces)
+
(defcustom tab-bar-select-tab-modifiers '()
"List of modifier keys for selecting a tab by its index digit.
@@ -89,8 +107,9 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
:set (lambda (sym val)
(set-default sym val)
;; Reenable the tab-bar with new keybindings
- (tab-bar-mode -1)
- (tab-bar-mode 1))
+ (when tab-bar-mode
+ (tab-bar--undefine-keys)
+ (tab-bar--define-keys)))
:group 'tab-bar
:version "27.1")
@@ -99,18 +118,40 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
"Install key bindings for switching between tabs if the user has configured them."
(when tab-bar-select-tab-modifiers
(global-set-key (vector (append tab-bar-select-tab-modifiers (list ?0)))
- 'tab-bar-switch-to-recent-tab)
- (dotimes (i 9)
+ 'tab-recent)
+ (dotimes (i 8)
(global-set-key (vector (append tab-bar-select-tab-modifiers
(list (+ i 1 ?0))))
- 'tab-bar-select-tab)))
+ 'tab-bar-select-tab))
+ (global-set-key (vector (append tab-bar-select-tab-modifiers (list ?9)))
+ 'tab-last))
;; Don't override user customized key bindings
(unless (global-key-binding [(control tab)])
(global-set-key [(control tab)] 'tab-next))
(unless (global-key-binding [(control shift tab)])
(global-set-key [(control shift tab)] 'tab-previous))
(unless (global-key-binding [(control shift iso-lefttab)])
- (global-set-key [(control shift iso-lefttab)] 'tab-previous)))
+ (global-set-key [(control shift iso-lefttab)] 'tab-previous))
+
+ ;; Replace default value with a condition that supports displaying
+ ;; global-mode-string in the tab bar instead of the mode line.
+ (when (and (memq 'tab-bar-format-global tab-bar-format)
+ (member '(global-mode-string ("" global-mode-string))
+ mode-line-misc-info))
+ (setf (alist-get 'global-mode-string mode-line-misc-info)
+ '(("" (:eval (if (and tab-bar-mode
+ (memq 'tab-bar-format-global
+ tab-bar-format))
+ "" global-mode-string)))))))
+
+(defun tab-bar--undefine-keys ()
+ "Uninstall key bindings previously bound by `tab-bar--define-keys'."
+ (when (eq (global-key-binding [(control tab)]) 'tab-next)
+ (global-unset-key [(control tab)]))
+ (when (eq (global-key-binding [(control shift tab)]) 'tab-previous)
+ (global-unset-key [(control shift tab)]))
+ (when (eq (global-key-binding [(control shift iso-lefttab)]) 'tab-previous)
+ (global-unset-key [(control shift iso-lefttab)])))
(defun tab-bar--load-buttons ()
"Load the icons for the tab buttons."
@@ -134,32 +175,54 @@ Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
:ascent center))
tab-bar-close-button)))
+(defun tab-bar--tab-bar-lines-for-frame (frame)
+ "Determine and return the value of `tab-bar-lines' for FRAME.
+Return 0 if `tab-bar-mode' is not enabled. Otherwise return
+either 1 or 0 depending on the value of the customizable variable
+`tab-bar-show', which see."
+ (cond
+ ((not tab-bar-mode) 0)
+ ((not tab-bar-show) 0)
+ ((eq tab-bar-show t) 1)
+ ((natnump tab-bar-show)
+ (if (> (length (funcall tab-bar-tabs-function frame)) tab-bar-show) 1 0))))
+
+(defun tab-bar--update-tab-bar-lines (&optional frames)
+ "Update the `tab-bar-lines' frame parameter in FRAMES.
+If the optional parameter FRAMES is omitted, update only
+the currently selected frame. If it is `t', update all frames
+as well as the default for new frames. Otherwise FRAMES should be
+a list of frames to update."
+ (let ((frame-lst (cond ((null frames)
+ (list (selected-frame)))
+ ((eq frames t)
+ (frame-list))
+ (t frames))))
+ ;; Loop over all frames and update `tab-bar-lines'
+ (dolist (frame frame-lst)
+ (unless (frame-parameter frame 'tab-bar-lines-keep-state)
+ (set-frame-parameter frame 'tab-bar-lines
+ (tab-bar--tab-bar-lines-for-frame frame)))))
+ ;; Update `default-frame-alist'
+ (when (eq frames t)
+ (setq default-frame-alist
+ (cons (cons 'tab-bar-lines (if (and tab-bar-mode (eq tab-bar-show t)) 1 0))
+ (assq-delete-all 'tab-bar-lines default-frame-alist)))))
+
(define-minor-mode tab-bar-mode
"Toggle the tab bar in all graphical frames (Tab Bar mode)."
:global t
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
:variable tab-bar-mode
- (let ((val (if tab-bar-mode 1 0)))
- (dolist (frame (frame-list))
- (set-frame-parameter frame 'tab-bar-lines val))
- ;; If the user has given `default-frame-alist' a `tab-bar-lines'
- ;; parameter, replace it.
- (if (assq 'tab-bar-lines default-frame-alist)
- (setq default-frame-alist
- (cons (cons 'tab-bar-lines val)
- (assq-delete-all 'tab-bar-lines
- default-frame-alist)))))
+
+ ;; Recalculate `tab-bar-lines' for all frames
+ (tab-bar--update-tab-bar-lines t)
+
(when tab-bar-mode
(tab-bar--load-buttons))
(if tab-bar-mode
(tab-bar--define-keys)
- ;; Unset only keys bound by tab-bar
- (when (eq (global-key-binding [(control tab)]) 'tab-next)
- (global-unset-key [(control tab)]))
- (when (eq (global-key-binding [(control shift tab)]) 'tab-previous)
- (global-unset-key [(control shift tab)]))
- (when (eq (global-key-binding [(control shift iso-lefttab)]) 'tab-previous)
- (global-unset-key [(control shift iso-lefttab)]))))
+ (tab-bar--undefine-keys)))
(defun tab-bar-handle-mouse (event)
"Text-mode emulation of switching tabs on the tab bar.
@@ -206,7 +269,9 @@ new frame when the global `tab-bar-mode' is enabled, by using
(add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)"
(interactive)
(set-frame-parameter frame 'tab-bar-lines
- (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)))
+ (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1))
+ (set-frame-parameter frame 'tab-bar-lines-keep-state
+ (not (frame-parameter frame 'tab-bar-lines-keep-state))))
(defvar tab-bar-map (make-sparse-keymap)
"Keymap for the tab bar.
@@ -250,17 +315,9 @@ you can use the command `toggle-frame-tab-bar'."
:initialize 'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
- ;; Preload button images
- (tab-bar-mode 1)
- ;; Then handle each frame individually
- (dolist (frame (frame-list))
- (set-frame-parameter
- frame 'tab-bar-lines
- (if (or (eq val t)
- (and (natnump val)
- (> (length (funcall tab-bar-tabs-function frame))
- val)))
- 1 0))))
+ (if val
+ (tab-bar-mode 1)
+ (tab-bar--update-tab-bar-lines t)))
:group 'tab-bar
:version "27.1")
@@ -284,6 +341,20 @@ before calling the command that adds a new tab."
:group 'tab-bar
:version "27.1")
+(defcustom tab-bar-new-tab-group t
+ "Defines what group to assign to a new tab.
+If nil, don't set a default group automatically.
+If t, inherit the group name from the previous tab.
+If the value is a string, use it as the group name of a new tab.
+If the value is a function, call it with no arguments
+to get the group name."
+ :type '(choice (const :tag "No automatic group" nil)
+ (const :tag "Inherit group from previous tab" t)
+ (string :tag "Fixed group name")
+ (function :tag "Function that returns group name"))
+ :group 'tab-bar
+ :version "28.1")
+
(defcustom tab-bar-new-button-show t
"If non-nil, show the \"New tab\" button in the tab bar.
When this is nil, you can create new tabs with \\[tab-new]."
@@ -294,6 +365,7 @@ When this is nil, you can create new tabs with \\[tab-new]."
(force-mode-line-update))
:group 'tab-bar
:version "27.1")
+(make-obsolete-variable 'tab-bar-new-button-show 'tab-bar-format "28.1")
(defvar tab-bar-new-button " + "
"Button for creating a new tab.")
@@ -327,16 +399,6 @@ If nil, don't show it at all."
(defvar tab-bar-forward-button " > "
"Button for going forward in tab history.")
-(defcustom tab-bar-history-buttons-show t
- "Show back and forward buttons when `tab-bar-history-mode' is enabled."
- :type 'boolean
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (set-default sym val)
- (force-mode-line-update))
- :group 'tab-bar
- :version "28.1")
-
(defcustom tab-bar-tab-hints nil
"Show absolute numbers on tabs in the tab bar before the tab name.
This helps to select the tab by its number using `tab-bar-select-tab'
@@ -352,6 +414,9 @@ and `tab-bar-select-tab-modifiers'."
(defvar tab-bar-separator nil
"String that delimits tabs.")
+(defun tab-bar-separator ()
+ (or tab-bar-separator (if window-system " " "|")))
+
(defcustom tab-bar-tab-name-function #'tab-bar-tab-name-current
"Function to get a tab name.
@@ -429,13 +494,13 @@ For example, \\='((tab (name . \"Tab 1\")) (current-tab (name . \"Tab 2\")))
By default, use function `tab-bar-tabs'.")
(defun tab-bar-tabs (&optional frame)
- "Return a list of tabs belonging to the selected frame.
+ "Return a list of tabs belonging to the FRAME.
Ensure the frame parameter `tabs' is pre-populated.
Update the current tab name when it exists.
Return its existing value or a new value."
(let ((tabs (frame-parameter frame 'tabs)))
(if tabs
- (let* ((current-tab (assq 'current-tab tabs))
+ (let* ((current-tab (tab-bar--current-tab-find tabs))
(current-tab-name (assq 'name current-tab))
(current-tab-explicit-name (assq 'explicit-name current-tab)))
(when (and current-tab-name
@@ -444,11 +509,25 @@ Return its existing value or a new value."
(setf (cdr current-tab-name)
(funcall tab-bar-tab-name-function))))
;; Create default tabs
- (setq tabs (list (tab-bar--current-tab)))
- (set-frame-parameter frame 'tabs tabs))
+ (setq tabs (list (tab-bar--current-tab-make)))
+ (tab-bar-tabs-set tabs frame))
tabs))
+(defun tab-bar-tabs-set (tabs &optional frame)
+ "Set a list of TABS on the FRAME."
+ (set-frame-parameter frame 'tabs tabs))
+
+(defcustom tab-bar-tab-face-function #'tab-bar-tab-face-default
+ "Function to define a tab face.
+Function gets one argument: a tab."
+ :type 'function
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-face-default (tab)
+ (if (eq (car tab) 'current-tab) 'tab-bar-tab 'tab-bar-tab-inactive))
+
(defcustom tab-bar-tab-name-format-function #'tab-bar-tab-name-format-default
"Function to format a tab name.
Function gets two arguments, the tab and its number, and should return
@@ -471,58 +550,219 @@ the formatted tab name to display in the tab bar."
(if current-p 'non-selected 'selected)))
tab-bar-close-button)
""))
- 'face (if current-p 'tab-bar-tab 'tab-bar-tab-inactive))))
+ 'face (funcall tab-bar-tab-face-function tab))))
+
+(defcustom tab-bar-format '(tab-bar-format-history
+ tab-bar-format-tabs
+ tab-bar-separator
+ tab-bar-format-add-tab)
+ "Template for displaying tab bar items.
+Every item in the list is a function that returns
+a string, or a list of menu-item elements, or nil.
+When you add more items `tab-bar-format-align-right' and
+`tab-bar-format-global' to the end, then after enabling
+`display-time-mode' (or any other mode that uses `global-mode-string')
+it will display time aligned to the right on the tab bar instead of
+the mode line. Replacing `tab-bar-format-tabs' with
+`tab-bar-format-tabs-groups' will group tabs on the tab bar."
+ :type 'hook
+ :options '(tab-bar-format-history
+ tab-bar-format-tabs
+ tab-bar-format-tabs-groups
+ tab-bar-separator
+ tab-bar-format-add-tab
+ tab-bar-format-align-right
+ tab-bar-format-global)
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-format-history ()
+ "Show back and forward buttons when `tab-bar-history-mode' is enabled.
+You can hide these buttons by customizing `tab-bar-format' and removing
+`tab-bar-format-history' from it."
+ (when tab-bar-history-mode
+ `((sep-history-back menu-item ,(tab-bar-separator) ignore)
+ (history-back
+ menu-item ,tab-bar-back-button tab-bar-history-back
+ :help "Click to go back in tab history")
+ (sep-history-forward menu-item ,(tab-bar-separator) ignore)
+ (history-forward
+ menu-item ,tab-bar-forward-button tab-bar-history-forward
+ :help "Click to go forward in tab history"))))
+
+(defun tab-bar--format-tab (tab i)
+ (append
+ `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))
+ (cond
+ ((eq (car tab) 'current-tab)
+ `((current-tab
+ menu-item
+ ,(funcall tab-bar-tab-name-format-function tab i)
+ ignore
+ :help "Current tab")))
+ (t
+ `((,(intern (format "tab-%i" i))
+ menu-item
+ ,(funcall tab-bar-tab-name-format-function tab i)
+ ,(or
+ (alist-get 'binding tab)
+ `(lambda ()
+ (interactive)
+ (tab-bar-select-tab ,i)))
+ :help "Click to visit tab"))))
+ `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
+ menu-item ""
+ ,(or
+ (alist-get 'close-binding tab)
+ `(lambda ()
+ (interactive)
+ (tab-bar-close-tab ,i)))))))
+
+(defun tab-bar-format-tabs ()
+ (let ((i 0))
+ (mapcan
+ (lambda (tab)
+ (setq i (1+ i))
+ (tab-bar--format-tab tab i))
+ (funcall tab-bar-tabs-function))))
+
+(defcustom tab-bar-tab-group-function #'tab-bar-tab-group-default
+ "Function to get a tab group name.
+Function gets one argument: a tab."
+ :type 'function
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-group-default (tab)
+ (alist-get 'group tab))
+
+(defcustom tab-bar-tab-group-format-function #'tab-bar-tab-group-format-default
+ "Function to format a tab group name.
+Function gets two arguments, a tab with a group name and its number,
+and should return the formatted tab group name to display in the tab bar."
+ :type 'function
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-group-format-default (tab i)
+ (propertize
+ (concat (if tab-bar-tab-hints (format "%d " i) "")
+ (funcall tab-bar-tab-group-function tab))
+ 'face 'tab-bar-tab-group-inactive))
+
+(defcustom tab-bar-tab-group-face-function #'tab-bar-tab-group-face-default
+ "Function to define a tab group face.
+Function gets one argument: a tab."
+ :type 'function
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-tab-group-face-default (tab)
+ (if (not (or (eq (car tab) 'current-tab)
+ (funcall tab-bar-tab-group-function tab)))
+ 'tab-bar-tab-ungrouped
+ (tab-bar-tab-face-default tab)))
+
+(defun tab-bar--format-tab-group (tab i &optional current-p)
+ (append
+ `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))
+ `((,(intern (format "group-%i" i))
+ menu-item
+ ,(if current-p
+ (propertize (funcall tab-bar-tab-group-function tab)
+ 'face 'tab-bar-tab-group-current)
+ (funcall tab-bar-tab-group-format-function tab i))
+ ,(if current-p 'ignore
+ (or
+ (alist-get 'binding tab)
+ `(lambda ()
+ (interactive)
+ (tab-bar-select-tab ,i))))
+ :help "Click to visit group"))))
+
+(defun tab-bar-format-tabs-groups ()
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (current-group (funcall tab-bar-tab-group-function
+ (tab-bar--current-tab-find tabs)))
+ (previous-group nil)
+ (i 0))
+ (mapcan
+ (lambda (tab)
+ (let ((tab-group (funcall tab-bar-tab-group-function tab)))
+ (setq i (1+ i))
+ (prog1 (cond
+ ;; Show current group tabs and ungrouped tabs
+ ((or (equal tab-group current-group) (not tab-group))
+ (append
+ ;; Prepend current group name before first tab
+ (when (and (not (equal previous-group tab-group)) tab-group)
+ (tab-bar--format-tab-group tab i t))
+ ;; Override default tab faces to use group faces
+ (let ((tab-bar-tab-face-function tab-bar-tab-group-face-function))
+ (tab-bar--format-tab tab i))))
+ ;; Show first tab of other groups with a group name
+ ((not (equal previous-group tab-group))
+ (tab-bar--format-tab-group tab i))
+ ;; Hide other group tabs
+ (t nil))
+ (setq previous-group tab-group))))
+ tabs)))
+
+(defun tab-bar-format-add-tab ()
+ (when (and tab-bar-new-button-show tab-bar-new-button)
+ `((add-tab menu-item ,tab-bar-new-button tab-bar-new-tab
+ :help "New tab"))))
+
+(defun tab-bar-format-align-right ()
+ "Align the rest of tab bar items to the right."
+ (let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format)))
+ (rest (tab-bar-format-list rest))
+ (rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
+ (hpos (length rest))
+ (str (propertize " " 'display `(space :align-to (- right ,hpos)))))
+ `((align-right menu-item ,str ignore))))
+
+(defun tab-bar-format-global ()
+ "Format `global-mode-string' to display it in the tab bar.
+When `tab-bar-format-global' is added to `tab-bar-format'
+(possibly appended after `tab-bar-format-align-right'),
+then modes that display information on the mode line
+using `global-mode-string' will display the same text
+on the tab bar instead."
+ `((global menu-item ,(string-trim-right (format-mode-line global-mode-string)) ignore)))
+
+(defun tab-bar-format-list (format-list)
+ (let ((i 0))
+ (apply #'append
+ (mapcar
+ (lambda (format)
+ (setq i (1+ i))
+ (cond
+ ((functionp format)
+ (let ((ret (funcall format)))
+ (when (stringp ret)
+ (setq ret `((,(intern (format "str-%i" i))
+ menu-item ,ret ignore))))
+ ret))))
+ format-list))))
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
- (let* ((separator (or tab-bar-separator (if window-system " " "|")))
- (i 0)
- (tabs (funcall tab-bar-tabs-function)))
- (append
- '(keymap (mouse-1 . tab-bar-handle-mouse))
- (when (and tab-bar-history-mode tab-bar-history-buttons-show)
- `((sep-history-back menu-item ,separator ignore)
- (history-back
- menu-item ,tab-bar-back-button tab-bar-history-back
- :help "Click to go back in tab history")
- (sep-history-forward menu-item ,separator ignore)
- (history-forward
- menu-item ,tab-bar-forward-button tab-bar-history-forward
- :help "Click to go forward in tab history")))
- (mapcan
- (lambda (tab)
- (setq i (1+ i))
- (append
- `((,(intern (format "sep-%i" i)) menu-item ,separator ignore))
- (cond
- ((eq (car tab) 'current-tab)
- `((current-tab
- menu-item
- ,(funcall tab-bar-tab-name-format-function tab i)
- ignore
- :help "Current tab")))
- (t
- `((,(intern (format "tab-%i" i))
- menu-item
- ,(funcall tab-bar-tab-name-format-function tab i)
- ,(or
- (alist-get 'binding tab)
- `(lambda ()
- (interactive)
- (tab-bar-select-tab ,i)))
- :help "Click to visit tab"))))
- `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
- menu-item ""
- ,(or
- (alist-get 'close-binding tab)
- `(lambda ()
- (interactive)
- (tab-bar-close-tab ,i)))))))
- tabs)
- `((sep-add-tab menu-item ,separator ignore))
- (when (and tab-bar-new-button-show tab-bar-new-button)
- `((add-tab menu-item ,tab-bar-new-button tab-bar-new-tab
- :help "New tab"))))))
+ (append
+ '(keymap (mouse-1 . tab-bar-handle-mouse))
+ (tab-bar-format-list tab-bar-format)))
;; Some window-configuration parameters don't need to be persistent.
@@ -545,8 +785,9 @@ the formatted tab name to display in the tab bar."
(push '(tabs . frameset-filter-tabs) frameset-filter-alist)
(defun tab-bar--tab (&optional frame)
- (let* ((tab (assq 'current-tab (frame-parameter frame 'tabs)))
+ (let* ((tab (tab-bar--current-tab-find nil frame))
(tab-explicit-name (alist-get 'explicit-name tab))
+ (tab-group (alist-get 'group tab))
(bl (seq-filter #'buffer-live-p (frame-parameter frame 'buffer-list)))
(bbl (seq-filter #'buffer-live-p (frame-parameter frame 'buried-buffer-list))))
`(tab
@@ -554,6 +795,7 @@ the formatted tab name to display in the tab bar."
(alist-get 'name tab)
(funcall tab-bar-tab-name-function)))
(explicit-name . ,tab-explicit-name)
+ ,@(if tab-group `((group . ,tab-group)))
(time . ,(float-time))
(ws . ,(window-state-get
(frame-root-window (or frame (selected-frame))) 'writable))
@@ -565,16 +807,27 @@ the formatted tab name to display in the tab bar."
(wc-history-forward . ,(gethash (or frame (selected-frame)) tab-bar-history-forward)))))
(defun tab-bar--current-tab (&optional tab frame)
- ;; `tab` here is an argument meaning 'use tab as template'. This is
+ (tab-bar--current-tab-make (or tab (tab-bar--current-tab-find nil frame))))
+
+(defun tab-bar--current-tab-make (&optional tab)
+ ;; `tab' here is an argument meaning "use tab as template". This is
;; necessary when switching tabs, otherwise the destination tab
- ;; inherit the current tab's `explicit-name` parameter.
- (let* ((tab (or tab (assq 'current-tab (frame-parameter frame 'tabs))))
- (tab-explicit-name (alist-get 'explicit-name tab)))
+ ;; inherits the current tab's `explicit-name' parameter.
+ (let* ((tab-explicit-name (alist-get 'explicit-name tab))
+ (tab-group (if tab
+ (alist-get 'group tab)
+ (pcase tab-bar-new-tab-group
+ ((pred stringp) tab-bar-new-tab-group)
+ ((pred functionp) (funcall tab-bar-new-tab-group))))))
`(current-tab
(name . ,(if tab-explicit-name
(alist-get 'name tab)
(funcall tab-bar-tab-name-function)))
- (explicit-name . ,tab-explicit-name))))
+ (explicit-name . ,tab-explicit-name)
+ ,@(if tab-group `((group . ,tab-group))))))
+
+(defun tab-bar--current-tab-find (&optional tabs frame)
+ (assq 'current-tab (or tabs (funcall tab-bar-tabs-function frame))))
(defun tab-bar--current-tab-index (&optional tabs frame)
(seq-position (or tabs (funcall tab-bar-tabs-function frame))
@@ -607,7 +860,7 @@ the formatted tab name to display in the tab bar."
When this command is bound to a numeric key (with a prefix or modifier key
using `tab-bar-select-tab-modifiers'), calling it without an argument
will translate its bound numeric key to the numeric argument.
-ARG counts from 1."
+ARG counts from 1. Negative ARG counts tabs from the end of the tab bar."
(interactive "P")
(unless (integerp arg)
(let ((key (event-basic-type last-command-event)))
@@ -617,7 +870,9 @@ ARG counts from 1."
(let* ((tabs (funcall tab-bar-tabs-function))
(from-index (tab-bar--current-tab-index tabs))
- (to-index (1- (max 1 (min arg (length tabs))))))
+ (to-index (if (< arg 0) (+ (length tabs) (1+ arg)) arg))
+ (to-index (1- (max 1 (min to-index (length tabs))))))
+
(unless (eq from-index to-index)
(let* ((from-tab (tab-bar--tab))
(to-tab (nth to-index tabs))
@@ -665,13 +920,13 @@ ARG counts from 1."
tab-bar-history-forward)))
(ws
- (window-state-put ws (frame-root-window (selected-frame)) 'safe)))
+ (window-state-put ws nil 'safe)))
(setq tab-bar-history-omit t)
(when from-index
(setf (nth from-index tabs) from-tab))
- (setf (nth to-index tabs) (tab-bar--current-tab (nth to-index tabs)))
+ (setf (nth to-index tabs) (tab-bar--current-tab-make (nth to-index tabs)))
(unless tab-bar-mode
(message "Selected tab '%s'" (alist-get 'name to-tab))))
@@ -695,6 +950,12 @@ ARG counts from 1."
(setq arg 1))
(tab-bar-switch-to-next-tab (- arg)))
+(defun tab-bar-switch-to-last-tab (&optional arg)
+ "Switch to the last tab or ARGth tab from the end of the tab bar."
+ (interactive "p")
+ (tab-bar-select-tab (- (length (funcall tab-bar-tabs-function))
+ (1- (or arg 1)))))
+
(defun tab-bar-switch-to-recent-tab (&optional arg)
"Switch to ARGth most recently visited tab."
(interactive "p")
@@ -709,7 +970,8 @@ ARG counts from 1."
"Switch to the tab by NAME.
Default values are tab names sorted by recency, so you can use \
\\<minibuffer-local-map>\\[next-history-element]
-to get the name of the last visited tab, the second last, and so on."
+to get the name of the most recently visited tab, the second
+most recent, and so on."
(interactive
(let* ((recent-tabs (mapcar (lambda (tab)
(alist-get 'name tab))
@@ -725,20 +987,27 @@ to get the name of the last visited tab, the second last, and so on."
(defun tab-bar-move-tab-to (to-index &optional from-index)
"Move tab from FROM-INDEX position to new position at TO-INDEX.
FROM-INDEX defaults to the current tab index.
-FROM-INDEX and TO-INDEX count from 1."
+FROM-INDEX and TO-INDEX count from 1.
+Negative TO-INDEX counts tabs from the end of the tab bar.
+Argument addressing is absolute in contrast to `tab-bar-move-tab'
+where argument addressing is relative."
(interactive "P")
(let* ((tabs (funcall tab-bar-tabs-function))
(from-index (or from-index (1+ (tab-bar--current-tab-index tabs))))
(from-tab (nth (1- from-index) tabs))
- (to-index (max 0 (min (1- (or to-index 1)) (1- (length tabs))))))
+ (to-index (if to-index (prefix-numeric-value to-index) 1))
+ (to-index (if (< to-index 0) (+ (length tabs) (1+ to-index)) to-index))
+ (to-index (max 0 (min (1- to-index) (1- (length tabs))))))
(setq tabs (delq from-tab tabs))
(cl-pushnew from-tab (nthcdr to-index tabs))
- (set-frame-parameter nil 'tabs tabs)
+ (tab-bar-tabs-set tabs)
(force-mode-line-update)))
(defun tab-bar-move-tab (&optional arg)
"Move the current tab ARG positions to the right.
-If a negative ARG, move the current tab ARG positions to the left."
+If a negative ARG, move the current tab ARG positions to the left.
+Argument addressing is relative in contrast to `tab-bar-move-tab-to'
+where argument addressing is absolute."
(interactive "p")
(let* ((tabs (funcall tab-bar-tabs-function))
(from-index (or (tab-bar--current-tab-index tabs) 0))
@@ -773,7 +1042,7 @@ Interactively, ARG selects the ARGth different frame to move to."
(let ((inhibit-message t) ; avoid message about deleted tab
tab-bar-closed-tabs)
(tab-bar-close-tab from-index)))
- (set-frame-parameter to-frame 'tabs to-tabs)
+ (tab-bar-tabs-set to-tabs to-frame)
(force-mode-line-update t))))
@@ -795,9 +1064,8 @@ on the tab bar specifying where to insert a new tab."
(defcustom tab-bar-tab-post-open-functions nil
"List of functions to call after creating a new tab.
-The current tab is supplied as an argument. Any modifications
-made to the tab argument will be applied after all functions are
-called."
+The current tab is supplied as an argument. Any modifications made
+to the tab argument will be applied after all functions are called."
:type '(repeat function)
:group 'tab-bar
:version "27.1")
@@ -806,7 +1074,9 @@ called."
"Add a new tab at the absolute position TO-INDEX.
TO-INDEX counts from 1. If no TO-INDEX is specified, then add
a new tab at the position specified by `tab-bar-new-tab-to'.
-
+Negative TO-INDEX counts tabs from the end of the tab bar.
+Argument addressing is absolute in contrast to `tab-bar-new-tab'
+where argument addressing is relative.
After the tab is created, the hooks in
`tab-bar-tab-post-open-functions' are run."
(interactive "P")
@@ -833,35 +1103,38 @@ After the tab is created, the hooks in
(when from-index
(setf (nth from-index tabs) from-tab))
- (let ((to-tab (tab-bar--current-tab))
- (to-index (or (if to-index (1- to-index))
- (pcase tab-bar-new-tab-to
- ('leftmost 0)
- ('rightmost (length tabs))
- ('left (or from-index 1))
- ('right (1+ (or from-index 0)))
- ((pred functionp)
- (funcall tab-bar-new-tab-to))))))
+
+ (let* ((to-tab (tab-bar--current-tab-make
+ (when (eq tab-bar-new-tab-group t)
+ `((group . ,(alist-get 'group from-tab))))))
+ (to-index (and to-index (prefix-numeric-value to-index)))
+ (to-index (or (if to-index
+ (if (< to-index 0)
+ (+ (length tabs) (1+ to-index))
+ (1- to-index)))
+ (pcase tab-bar-new-tab-to
+ ('leftmost 0)
+ ('rightmost (length tabs))
+ ('left (or from-index 1))
+ ('right (1+ (or from-index 0)))
+ ((pred functionp)
+ (funcall tab-bar-new-tab-to))))))
(setq to-index (max 0 (min (or to-index 0) (length tabs))))
(cl-pushnew to-tab (nthcdr to-index tabs))
(when (eq to-index 0)
- ;; pushnew handles the head of tabs but not frame-parameter
- (set-frame-parameter nil 'tabs tabs))
+ ;; `pushnew' handles the head of tabs but not frame-parameter
+ (tab-bar-tabs-set tabs))
(run-hook-with-args 'tab-bar-tab-post-open-functions
(nth to-index tabs)))
- (cond
- ((eq tab-bar-show t)
- (tab-bar-mode 1))
- ((and (natnump tab-bar-show)
- (> (length (funcall tab-bar-tabs-function)) tab-bar-show)
- (zerop (frame-parameter nil 'tab-bar-lines)))
- (progn
- (tab-bar--load-buttons)
- (tab-bar--define-keys)
- (set-frame-parameter nil 'tab-bar-lines 1))))
+ (when tab-bar-show
+ (if (not tab-bar-mode)
+ ;; Turn on `tab-bar-mode' since a tab was created.
+ ;; Note: this also updates `tab-bar-lines'.
+ (tab-bar-mode 1)
+ (tab-bar--update-tab-bar-lines)))
(force-mode-line-update)
(unless tab-bar-mode
@@ -870,7 +1143,11 @@ After the tab is created, the hooks in
(defun tab-bar-new-tab (&optional arg)
"Create a new tab ARG positions to the right.
If a negative ARG, create a new tab ARG positions to the left.
-If ARG is zero, create a new tab in place of the current tab."
+If ARG is zero, create a new tab in place of the current tab.
+If no ARG is specified, then add a new tab at the position
+specified by `tab-bar-new-tab-to'.
+Argument addressing is relative in contrast to `tab-bar-new-tab-to'
+where argument addressing is absolute."
(interactive "P")
(if arg
(let* ((tabs (funcall tab-bar-tabs-function))
@@ -879,6 +1156,15 @@ If ARG is zero, create a new tab in place of the current tab."
(tab-bar-new-tab-to (1+ to-index)))
(tab-bar-new-tab-to)))
+(defun tab-bar-duplicate-tab (&optional arg)
+ "Duplicate the current tab to ARG positions to the right.
+If a negative ARG, duplicate the tab to ARG positions to the left.
+If ARG is zero, duplicate the tab in place of the current tab."
+ (interactive "P")
+ (let ((tab-bar-new-tab-choice nil)
+ (tab-bar-new-tab-group t))
+ (tab-bar-new-tab arg)))
+
(defvar tab-bar-closed-tabs nil
"A list of closed tabs to be able to undo their closing.")
@@ -898,10 +1184,10 @@ If `recent', select the most recently visited tab."
"Defines what to do when the last tab is closed.
If nil, do nothing and show a message, like closing the last window or frame.
If `delete-frame', delete the containing frame, as a web browser would do.
-If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show in
-the frame.
-If the value is a function, call that function with the tab to be closed as an
- argument."
+If `tab-bar-mode-disable', disable tab-bar-mode so that tabs no longer show
+in the frame.
+If the value is a function, call that function with the tab to be closed
+as an argument."
:type '(choice (const :tag "Do nothing and show message" nil)
(const :tag "Close the containing frame" delete-frame)
(const :tag "Disable tab-bar-mode" tab-bar-mode-disable)
@@ -912,7 +1198,7 @@ If the value is a function, call that function with the tab to be closed as an
(defcustom tab-bar-tab-prevent-close-functions nil
"List of functions to call to determine whether to close a tab.
The tab to be closed and a boolean indicating whether or not it
-is the only tab in the frame are supplied as arguments. If any
+is the only tab in the frame are supplied as arguments. If any
function returns a non-nil value, the tab will not be closed."
:type '(repeat function)
:group 'tab-bar
@@ -994,13 +1280,10 @@ for the last tab on a frame is determined by
(tab-bar--tab)
close-tab)))
tab-bar-closed-tabs)
- (set-frame-parameter nil 'tabs (delq close-tab tabs)))
+ (tab-bar-tabs-set (delq close-tab tabs)))
- (when (and (not (zerop (frame-parameter nil 'tab-bar-lines)))
- (natnump tab-bar-show)
- (<= (length (funcall tab-bar-tabs-function))
- tab-bar-show))
- (set-frame-parameter nil 'tab-bar-lines 0))
+ ;; Recalculate `tab-bar-lines' and update frames
+ (tab-bar--update-tab-bar-lines)
(force-mode-line-update)
(unless tab-bar-mode
@@ -1019,35 +1302,34 @@ for the last tab on a frame is determined by
"Close all tabs on the selected frame, except the selected one."
(interactive)
(let* ((tabs (funcall tab-bar-tabs-function))
- (current-index (tab-bar--current-tab-index tabs)))
- (when current-index
- (dotimes (index (length tabs))
- (unless (or (eq index current-index)
+ (current-tab (tab-bar--current-tab-find tabs))
+ (index 0))
+ (when current-tab
+ (dolist (tab tabs)
+ (unless (or (eq tab current-tab)
(run-hook-with-args-until-success
- 'tab-bar-tab-prevent-close-functions
- (nth index tabs)
- ; last-tab-p logically can't ever be true if we
- ; make it this far
+ 'tab-bar-tab-prevent-close-functions tab
+ ;; `last-tab-p' logically can't ever be true
+ ;; if we make it this far
nil))
(push `((frame . ,(selected-frame))
(index . ,index)
- (tab . ,(nth index tabs)))
+ (tab . ,tab))
tab-bar-closed-tabs)
- (run-hook-with-args 'tab-bar-tab-pre-close-functions (nth index tabs) nil)))
- (set-frame-parameter nil 'tabs (list (nth current-index tabs)))
+ (run-hook-with-args 'tab-bar-tab-pre-close-functions tab nil)
+ (setq tabs (delq tab tabs)))
+ (setq index (1+ index)))
+ (tab-bar-tabs-set tabs)
- (when (and (not (zerop (frame-parameter nil 'tab-bar-lines)))
- (natnump tab-bar-show)
- (<= (length (funcall tab-bar-tabs-function))
- tab-bar-show))
- (set-frame-parameter nil 'tab-bar-lines 0))
+ ;; Recalculate tab-bar-lines and update frames
+ (tab-bar--update-tab-bar-lines)
(force-mode-line-update)
(unless tab-bar-mode
(message "Deleted all other tabs")))))
(defun tab-bar-undo-close-tab ()
- "Restore the last closed tab."
+ "Restore the most recently closed tab."
(interactive)
;; Pop out closed tabs that were on already deleted frames
(while (and tab-bar-closed-tabs
@@ -1067,7 +1349,7 @@ for the last tab on a frame is determined by
(cl-pushnew tab (nthcdr index tabs))
(when (eq index 0)
;; pushnew handles the head of tabs but not frame-parameter
- (set-frame-parameter nil 'tabs tabs))
+ (tab-bar-tabs-set tabs))
(tab-bar-select-tab (1+ index))))
(message "No more closed tabs to undo")))
@@ -1118,6 +1400,109 @@ function `tab-bar-tab-name-function'."
(tab-bar-rename-tab new-name (1+ (tab-bar--tab-index-by-name tab-name))))
+;;; Tab groups
+
+(defun tab-bar-move-tab-to-group (&optional tab)
+ "Relocate TAB (or the current tab) closer to its group."
+ (interactive)
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (tab (or tab (tab-bar--current-tab-find tabs)))
+ (tab-index (tab-bar--tab-index tab))
+ (group (alist-get 'group tab))
+ ;; Beginning position of the same group
+ (beg (seq-position tabs group
+ (lambda (tb gr)
+ (and (not (eq tb tab))
+ (equal (alist-get 'group tb) gr)))))
+ ;; Size of the same group
+ (len (when beg
+ (seq-position (nthcdr beg tabs) group
+ (lambda (tb gr)
+ (not (equal (alist-get 'group tb) gr))))))
+ (pos (when beg
+ (cond
+ ;; Don't move tab when it's already inside group bounds
+ ((and len (>= tab-index beg) (<= tab-index (+ beg len))) nil)
+ ;; Move tab from the right to the group end
+ ((and len (> tab-index (+ beg len))) (+ beg len 1))
+ ;; Move tab from the left to the group beginning
+ ((< tab-index beg) beg)))))
+ (when pos
+ (tab-bar-move-tab-to pos (1+ tab-index)))))
+
+(defcustom tab-bar-tab-post-change-group-functions nil
+ "List of functions to call after changing a tab group.
+The current tab is supplied as an argument."
+ :type 'hook
+ :options '(tab-bar-move-tab-to-group)
+ :group 'tab-bar
+ :version "28.1")
+
+(defun tab-bar-change-tab-group (group-name &optional arg)
+ "Add the tab specified by its absolute position ARG to GROUP-NAME.
+If no ARG is specified, then set the GROUP-NAME for the current tab.
+ARG counts from 1.
+If GROUP-NAME is the empty string, then remove the tab from any group.
+While using this command, you might also want to replace
+`tab-bar-format-tabs' with `tab-bar-format-tabs-groups' in
+`tab-bar-format' to group tabs on the tab bar."
+ (interactive
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (tab-index (or current-prefix-arg
+ (1+ (tab-bar--current-tab-index tabs))))
+ (group-name (funcall tab-bar-tab-group-function
+ (nth (1- tab-index) tabs))))
+ (list (completing-read
+ "Group name for tab (leave blank to remove group): "
+ (delete-dups
+ (delq nil (cons group-name
+ (mapcar (lambda (tab)
+ (funcall tab-bar-tab-group-function tab))
+ (funcall tab-bar-tabs-function))))))
+ current-prefix-arg)))
+ (let* ((tabs (funcall tab-bar-tabs-function))
+ (tab-index (if arg
+ (1- (max 0 (min arg (length tabs))))
+ (tab-bar--current-tab-index tabs)))
+ (tab (nth tab-index tabs))
+ (group (assq 'group tab))
+ (group-new-name (and (> (length group-name) 0) group-name)))
+ (if group
+ (setcdr group group-new-name)
+ (nconc tab `((group . ,group-new-name))))
+
+ (run-hook-with-args 'tab-bar-tab-post-change-group-functions tab)
+
+ (force-mode-line-update)
+ (unless tab-bar-mode
+ (message "Set tab group to '%s'" group-new-name))))
+
+(defun tab-bar-close-group-tabs (group-name)
+ "Close all tabs that belong to GROUP-NAME on the selected frame."
+ (interactive
+ (let ((group-name (funcall tab-bar-tab-group-function
+ (tab-bar--current-tab-find))))
+ (list (completing-read
+ "Close all tabs with group name: "
+ (delete-dups
+ (delq nil (cons group-name
+ (mapcar (lambda (tab)
+ (funcall tab-bar-tab-group-function tab))
+ (funcall tab-bar-tabs-function)))))))))
+ (let* ((close-group (and (> (length group-name) 0) group-name))
+ (tab-bar-tab-prevent-close-functions
+ (cons (lambda (tab _last-tab-p)
+ (not (equal (funcall tab-bar-tab-group-function tab)
+ close-group)))
+ tab-bar-tab-prevent-close-functions)))
+ (tab-bar-close-other-tabs)
+
+ (when (equal (funcall tab-bar-tab-group-function
+ (tab-bar--current-tab-find))
+ close-group)
+ (tab-bar-close-tab))))
+
+
;;; Tab history mode
(defvar tab-bar-history-limit 10
@@ -1138,7 +1523,7 @@ function `tab-bar-tab-name-function'."
(defvar tab-bar-history-old-minibuffer-depth 0
"Minibuffer depth before the current command.")
-(defun tab-bar-history--pre-change ()
+(defun tab-bar--history-pre-change ()
(setq tab-bar-history-old-minibuffer-depth (minibuffer-depth))
;; Store wc before possibly entering the minibuffer
(when (zerop tab-bar-history-old-minibuffer-depth)
@@ -1221,29 +1606,12 @@ and can restore them."
:ascent center))
tab-bar-forward-button))
- (add-hook 'pre-command-hook 'tab-bar-history--pre-change)
+ (add-hook 'pre-command-hook 'tab-bar--history-pre-change)
(add-hook 'window-configuration-change-hook 'tab-bar--history-change))
- (remove-hook 'pre-command-hook 'tab-bar-history--pre-change)
+ (remove-hook 'pre-command-hook 'tab-bar--history-pre-change)
(remove-hook 'window-configuration-change-hook 'tab-bar--history-change)))
-;;; Short aliases
-
-(defalias 'tab-new 'tab-bar-new-tab)
-(defalias 'tab-new-to 'tab-bar-new-tab-to)
-(defalias 'tab-close 'tab-bar-close-tab)
-(defalias 'tab-close-other 'tab-bar-close-other-tabs)
-(defalias 'tab-undo 'tab-bar-undo-close-tab)
-(defalias 'tab-select 'tab-bar-select-tab)
-(defalias 'tab-next 'tab-bar-switch-to-next-tab)
-(defalias 'tab-previous 'tab-bar-switch-to-prev-tab)
-(defalias 'tab-recent 'tab-bar-switch-to-recent-tab)
-(defalias 'tab-move 'tab-bar-move-tab)
-(defalias 'tab-move-to 'tab-bar-move-tab-to)
-(defalias 'tab-rename 'tab-bar-rename-tab)
-(defalias 'tab-list 'tab-switcher)
-
-
;;; Non-graphical access to frame-local tabs (named window configurations)
(defun tab-switcher ()
@@ -1421,7 +1789,7 @@ Then move up one line. Prefix arg means move that many lines."
(index . ,(tab-bar--tab-index tab))
(tab . ,tab))
tab-bar-closed-tabs)
- (set-frame-parameter nil 'tabs (delq tab (funcall tab-bar-tabs-function))))
+ (tab-bar-tabs-set (delq tab (funcall tab-bar-tabs-function))))
(defun tab-switcher-execute ()
"Delete window configurations marked with \\<tab-switcher-mode-map>\\[tab-switcher-delete] commands."
@@ -1525,6 +1893,8 @@ a function, then it is called with two arguments: BUFFER and ALIST, and
should return the tab name. When a `tab-name' entry is omitted, create
a new tab without an explicit name.
+The ALIST entry `tab-group' (string or function) defines the tab group.
+
If ALIST contains a `reusable-frames' entry, its value determines
which frames to search for a reusable tab:
nil -- the selected frame (actually the last non-minibuffer frame)
@@ -1577,6 +1947,8 @@ then it is called with two arguments: BUFFER and ALIST, and should return
the tab name. When a `tab-name' entry is omitted, create a new tab without
an explicit name.
+The ALIST entry `tab-group' (string or function) defines the tab group.
+
This is an action function for buffer display, see Info
node `(elisp) Buffer Display Action Functions'. It should be
called only by `display-buffer' or a function directly or
@@ -1588,6 +1960,11 @@ indirectly called by the latter."
(setq tab-name (funcall tab-name buffer alist)))
(when tab-name
(tab-bar-rename-tab tab-name)))
+ (let ((tab-group (alist-get 'tab-group alist)))
+ (when (functionp tab-group)
+ (setq tab-group (funcall tab-group buffer alist)))
+ (when tab-group
+ (tab-bar-change-tab-group tab-group)))
(window--display-buffer buffer (selected-window) 'tab alist)))
(defun switch-to-buffer-other-tab (buffer-or-name &optional norecord)
@@ -1618,7 +1995,6 @@ Like \\[find-file-other-frame] (which see), but creates a new tab."
(defun find-file-read-only-other-tab (filename &optional wildcards)
"Edit file FILENAME, in another tab, but don't allow changes.
Like \\[find-file-other-frame] (which see), but creates a new tab.
-
Like \\[find-file-other-tab], but marks buffer as read-only.
Use \\[read-only-mode] to permit editing."
(interactive
@@ -1648,19 +2024,69 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
nil "[other-tab]")
(message "Display next command buffer in a new tab..."))
+
+;;; Short aliases and keybindings
+
+(defalias 'tab-new 'tab-bar-new-tab)
+(defalias 'tab-new-to 'tab-bar-new-tab-to)
+(defalias 'tab-duplicate 'tab-bar-duplicate-tab)
+(defalias 'tab-close 'tab-bar-close-tab)
+(defalias 'tab-close-other 'tab-bar-close-other-tabs)
+(defalias 'tab-close-group 'tab-bar-close-group-tabs)
+(defalias 'tab-undo 'tab-bar-undo-close-tab)
+(defalias 'tab-select 'tab-bar-select-tab)
+(defalias 'tab-switch 'tab-bar-switch-to-tab)
+(defalias 'tab-next 'tab-bar-switch-to-next-tab)
+(defalias 'tab-previous 'tab-bar-switch-to-prev-tab)
+(defalias 'tab-last 'tab-bar-switch-to-last-tab)
+(defalias 'tab-recent 'tab-bar-switch-to-recent-tab)
+(defalias 'tab-move 'tab-bar-move-tab)
+(defalias 'tab-move-to 'tab-bar-move-tab-to)
+(defalias 'tab-rename 'tab-bar-rename-tab)
+(defalias 'tab-group 'tab-bar-change-tab-group)
+(defalias 'tab-list 'tab-switcher)
+
+(define-key tab-prefix-map "n" 'tab-duplicate)
+(define-key tab-prefix-map "N" 'tab-new-to)
(define-key tab-prefix-map "2" 'tab-new)
(define-key tab-prefix-map "1" 'tab-close-other)
(define-key tab-prefix-map "0" 'tab-close)
+(define-key tab-prefix-map "u" 'tab-undo)
(define-key tab-prefix-map "o" 'tab-next)
+(define-key tab-prefix-map "O" 'tab-previous)
(define-key tab-prefix-map "m" 'tab-move)
+(define-key tab-prefix-map "M" 'tab-move-to)
+(define-key tab-prefix-map "G" 'tab-group)
(define-key tab-prefix-map "r" 'tab-rename)
-(define-key tab-prefix-map "\r" 'tab-bar-select-tab-by-name)
+(define-key tab-prefix-map "\r" 'tab-switch)
(define-key tab-prefix-map "b" 'switch-to-buffer-other-tab)
(define-key tab-prefix-map "f" 'find-file-other-tab)
(define-key tab-prefix-map "\C-f" 'find-file-other-tab)
(define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab)
(define-key tab-prefix-map "t" 'other-tab-prefix)
+(defvar tab-bar-switch-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "o" 'tab-next)
+ (define-key map "O" 'tab-previous)
+ map)
+ "Keymap to repeat tab switch key sequences `C-x t o o O'.
+Used in `repeat-mode'.")
+(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
+(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
+
+(defvar tab-bar-move-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "m" 'tab-move)
+ (define-key map "M" (lambda ()
+ (interactive)
+ (setq repeat-map 'tab-bar-move-repeat-map)
+ (tab-move -1)))
+ map)
+ "Keymap to repeat tab move key sequences `C-x t m m M'.
+Used in `repeat-mode'.")
+(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
+
(provide 'tab-bar)
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 1bdddc2c83e..d5fad353638 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -44,6 +44,7 @@ whether the tab is a buffer, and whether the tab is selected."
:type '(repeat
(choice (function-item tab-line-tab-face-special)
(function-item tab-line-tab-face-inactive-alternating)
+ (function-item tab-line-tab-face-group)
(function :tag "Custom function")))
:group 'tab-line
:version "28.1")
@@ -55,29 +56,25 @@ whether the tab is a buffer, and whether the tab is selected."
:version "27.1")
(defface tab-line-tab
- '((default
- :inherit tab-line)
+ '((default :inherit tab-line)
(((class color) (min-colors 88))
:box (:line-width 1 :style released-button))
- (t
- :inverse-video nil))
+ (t :inverse-video nil))
"Tab line face for selected tab."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-tab-inactive
- '((default
- :inherit tab-line-tab)
+ '((default :inherit tab-line-tab)
(((class color) (min-colors 88))
:background "grey75")
- (t
- :inverse-video t))
+ (t :inverse-video t))
"Tab line face for non-selected tab."
:version "27.1"
:group 'tab-line-faces)
(defface tab-line-tab-inactive-alternate
- `((t (:inherit tab-line-tab-inactive :background "grey65")))
+ '((t :inherit tab-line-tab-inactive :background "grey65"))
"Alternate face for inactive tab-line tabs.
Applied to alternating tabs when option
`tab-line-tab-face-functions' includes function
@@ -86,18 +83,25 @@ Applied to alternating tabs when option
:group 'tab-line-faces)
(defface tab-line-tab-special
- '((default (:weight bold))
+ '((default :weight bold)
(((supports :slant italic))
- (:slant italic :weight normal)))
+ :slant italic :weight normal))
"Face for special (i.e. non-file-backed) tabs.
Applied when option `tab-line-tab-face-functions' includes
function `tab-line-tab-face-special'."
:version "28.1"
:group 'tab-line-faces)
+(defface tab-line-tab-group
+ '((t :inherit tab-line :box nil))
+ "Face for group tabs.
+Applied when option `tab-line-tab-face-functions' includes
+function `tab-line-tab-face-group'."
+ :version "28.1"
+ :group 'tab-line-faces)
+
(defface tab-line-tab-current
- '((default
- :inherit tab-line-tab)
+ '((default :inherit tab-line-tab)
(((class color) (min-colors 88))
:background "grey85"))
"Tab line face for tab with current buffer in selected window."
@@ -105,7 +109,7 @@ function `tab-line-tab-face-special'."
:group 'tab-line-faces)
(defface tab-line-highlight
- '((default :inherit tab-line-tab))
+ '((t :inherit tab-line-tab))
"Tab line face for highlighting."
:version "27.1"
:group 'tab-line-faces)
@@ -178,7 +182,7 @@ If the value is a function, call it with no arguments."
(defvar tab-line-new-button
(propertize " + "
- 'display `(image :type xpm
+ 'display '(image :type xpm
:file "tabs/new.xpm"
:margin (2 . 0)
:ascent center)
@@ -206,7 +210,7 @@ If nil, don't show it at all."
(defvar tab-line-close-button
(propertize " x"
- 'display `(image :type xpm
+ 'display '(image :type xpm
:file "tabs/close.xpm"
:margin (2 . 0)
:ascent center)
@@ -217,7 +221,7 @@ If nil, don't show it at all."
(defvar tab-line-left-button
(propertize " <"
- 'display `(image :type xpm
+ 'display '(image :type xpm
:file "tabs/left-arrow.xpm"
:margin (2 . 0)
:ascent center)
@@ -228,7 +232,7 @@ If nil, don't show it at all."
(defvar tab-line-right-button
(propertize "> "
- 'display `(image :type xpm
+ 'display '(image :type xpm
:file "tabs/right-arrow.xpm"
:margin (2 . 0)
:ascent center)
@@ -294,7 +298,10 @@ be displayed, or just a list of strings to display in the tab line.
By default, use function `tab-line-tabs-window-buffers' that
returns a list of buffers associated with the selected window.
When `tab-line-tabs-mode-buffers', return a list of buffers
-with the same major mode as the current buffer."
+with the same major mode as the current buffer.
+When `tab-line-tabs-buffer-groups', return a list of buffers
+grouped either by `tab-line-tabs-buffer-group-function', when set,
+or by `tab-line-tabs-buffer-groups'."
:type '(choice (const :tag "Window buffers"
tab-line-tabs-window-buffers)
(const :tag "Same mode buffers"
@@ -356,6 +363,11 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.")
mode))))
(defun tab-line-tabs-buffer-groups ()
+ "Return a list of tabs that should be displayed in the tab line.
+By default return a list of buffers grouped by major mode,
+according to `tab-line-tabs-buffer-groups'.
+If non-nil, `tab-line-tabs-buffer-group-function' is used to
+generate the group name."
(if (window-parameter nil 'tab-line-groups)
(let* ((buffers (funcall tab-line-tabs-buffer-list-function))
(groups
@@ -385,6 +397,7 @@ If the major mode's name string matches REGEXP, use GROUPNAME instead.")
(set-window-parameter nil 'tab-line-group nil))))
(group-tab `(tab
(name . ,group)
+ (group-tab . t)
(select . ,(lambda ()
(set-window-parameter nil 'tab-line-groups t)
(set-window-parameter nil 'tab-line-group group)
@@ -430,42 +443,59 @@ variable `tab-line-tabs-function'."
next-buffers)))
+(defcustom tab-line-tab-name-format-function #'tab-line-tab-name-format-default
+ "Function to format a tab name.
+Function gets two arguments: the tab and a list of all tabs, and
+should return the formatted tab name to display in the tab line."
+ :type 'function
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (force-mode-line-update))
+ :group 'tab-line
+ :version "28.1")
+
+(defun tab-line-tab-name-format-default (tab tabs)
+ (let* ((buffer-p (bufferp tab))
+ (selected-p (if buffer-p
+ (eq tab (window-buffer))
+ (cdr (assq 'selected tab))))
+ (name (if buffer-p
+ (funcall tab-line-tab-name-function tab tabs)
+ (cdr (assq 'name tab))))
+ (face (if selected-p
+ (if (eq (selected-window) (old-selected-window))
+ 'tab-line-tab-current
+ 'tab-line-tab)
+ 'tab-line-tab-inactive)))
+ (dolist (fn tab-line-tab-face-functions)
+ (setf face (funcall fn tab tabs face buffer-p selected-p)))
+ (apply 'propertize
+ (concat (propertize name
+ 'keymap tab-line-tab-map
+ ;; Don't turn mouse-1 into mouse-2 (bug#49247)
+ 'follow-link 'ignore)
+ (or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
+ tab-line-close-button-show
+ (not (eq tab-line-close-button-show
+ (if selected-p 'non-selected 'selected)))
+ tab-line-close-button)
+ ""))
+ `(
+ tab ,tab
+ ,@(if selected-p '(selected t))
+ face ,face
+ mouse-face tab-line-highlight))))
+
(defun tab-line-format-template (tabs)
"Template for displaying tab line for selected window."
- (let* ((selected-buffer (window-buffer))
- (separator (or tab-line-separator (if window-system " " "|")))
+ (let* ((separator (or tab-line-separator (if window-system " " "|")))
(hscroll (window-parameter nil 'tab-line-hscroll))
(strings
(mapcar
(lambda (tab)
- (let* ((buffer-p (bufferp tab))
- (selected-p (if buffer-p
- (eq tab selected-buffer)
- (cdr (assq 'selected tab))))
- (name (if buffer-p
- (funcall tab-line-tab-name-function tab tabs)
- (cdr (assq 'name tab))))
- (face (if selected-p
- (if (eq (selected-window) (old-selected-window))
- 'tab-line-tab-current
- 'tab-line-tab)
- 'tab-line-tab-inactive)))
- (dolist (fn tab-line-tab-face-functions)
- (setf face (funcall fn tab tabs face buffer-p selected-p)))
- (concat
- separator
- (apply 'propertize
- (concat (propertize name 'keymap tab-line-tab-map)
- (or (and (or buffer-p (assq 'buffer tab) (assq 'close tab))
- tab-line-close-button-show
- (not (eq tab-line-close-button-show
- (if selected-p 'non-selected 'selected)))
- tab-line-close-button) ""))
- `(
- tab ,tab
- ,@(if selected-p '(selected t))
- face ,face
- mouse-face tab-line-highlight)))))
+ (concat separator
+ (funcall tab-line-tab-name-format-function tab tabs)))
tabs))
(hscroll-data (tab-line-auto-hscroll strings hscroll)))
(setq hscroll (nth 1 hscroll-data))
@@ -506,6 +536,13 @@ When TAB is a non-file-backed buffer, make FACE inherit from
(setf face `(:inherit (tab-line-tab-special ,face))))
face)
+(defun tab-line-tab-face-group (tab _tabs face _buffer-p _selected-p)
+ "Return FACE for TAB according to whether it's a group tab.
+For use in `tab-line-tab-face-functions'."
+ (when (alist-get 'group-tab tab)
+ (setf face `(:inherit (tab-line-tab-group ,face))))
+ face)
+
(defvar tab-line-auto-hscroll)
(defun tab-line-format ()
diff --git a/lisp/talk.el b/lisp/talk.el
index 473f8ac9218..56d36dd8df4 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -1,4 +1,4 @@
-;;; talk.el --- allow several users to talk to each other through Emacs
+;;; talk.el --- allow several users to talk to each other through Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
;;; Commentary:
;; This is a multi-user talk package that runs in Emacs.
-;; Use talk-connect to bring a new person into the conversation.
+;; Use `talk-connect' to bring a new person into the conversation.
;;; Code:
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 89a71ac2b87..411c71cd8c4 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -474,6 +474,7 @@ checksum before doing the check."
"Construct a `rw-r--r--' string indicating MODE.
MODE should be an integer which is a file mode value.
For instance, if mode is #o700, then it produces `rwx------'."
+ (declare (obsolete file-modes-number-to-symbolic "28.1"))
(substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
@@ -489,25 +490,26 @@ For instance, if mode is #o700, then it produces `rwx------'."
;; (ck (tar-header-checksum tar-hblock))
(type (tar-header-link-type tar-hblock))
(link-name (tar-header-link-name tar-hblock)))
- (format "%c%c%s %7s/%-7s %7s%s %s%s"
+ (format "%c%s %7s/%-7s %7s%s %s%s"
(if mod-p ?* ? )
- (cond ((or (eq type nil) (eq type 0)) ?-)
- ((eq type 1) ?h) ; link
- ((eq type 2) ?l) ; symlink
- ((eq type 3) ?c) ; char special
- ((eq type 4) ?b) ; block special
- ((eq type 5) ?d) ; directory
- ((eq type 6) ?p) ; FIFO/pipe
- ((eq type 20) ?*) ; directory listing
- ((eq type 28) ?L) ; next has longname
- ((eq type 29) ?M) ; multivolume continuation
- ((eq type 35) ?S) ; sparse
- ((eq type 38) ?V) ; volume header
- ((eq type 55) ?H) ; pax global extended header
- ((eq type 72) ?X) ; pax extended header
- (t ?\s)
- )
- (tar-grind-file-mode mode)
+ (file-modes-number-to-symbolic
+ mode
+ (cond ((or (eq type nil) (eq type 0)) ?-)
+ ((eq type 1) ?h) ; link
+ ((eq type 2) ?l) ; symlink
+ ((eq type 3) ?c) ; char special
+ ((eq type 4) ?b) ; block special
+ ((eq type 5) ?d) ; directory
+ ((eq type 6) ?p) ; FIFO/pipe
+ ((eq type 20) ?*) ; directory listing
+ ((eq type 28) ?L) ; next has longname
+ ((eq type 29) ?M) ; multivolume continuation
+ ((eq type 35) ?S) ; sparse
+ ((eq type 38) ?V) ; volume header
+ ((eq type 55) ?H) ; pax global extended header
+ ((eq type 72) ?X) ; pax extended header
+ (t ?\s)
+ ))
(if (= 0 (length uname)) uid uname)
(if (= 0 (length gname)) gid gname)
size
@@ -635,54 +637,38 @@ For instance, if mode is #o700, then it produces `rwx------'."
;; Let mouse-1 follow the link.
(define-key map [follow-link] 'mouse-face)
- ;; Make menu bar items.
-
;; Get rid of the Edit menu bar item to save space.
(define-key map [menu-bar edit] 'undefined)
- (define-key map [menu-bar immediate]
- (cons "Immediate" (make-sparse-keymap "Immediate")))
-
- (define-key map [menu-bar immediate woman]
- '("Read Man Page (WoMan)" . woman-tar-extract-file))
- (define-key map [menu-bar immediate view]
- '("View This File" . tar-view))
- (define-key map [menu-bar immediate display]
- '("Display in Other Window" . tar-display-other-window))
- (define-key map [menu-bar immediate find-file-other-window]
- '("Find in Other Window" . tar-extract-other-window))
- (define-key map [menu-bar immediate find-file]
- '("Find This File" . tar-extract))
-
- (define-key map [menu-bar mark]
- (cons "Mark" (make-sparse-keymap "Mark")))
-
- (define-key map [menu-bar mark unmark-all]
- '("Unmark All" . tar-clear-modification-flags))
- (define-key map [menu-bar mark deletion]
- '("Flag" . tar-flag-deleted))
- (define-key map [menu-bar mark unmark]
- '("Unflag" . tar-unflag))
-
- (define-key map [menu-bar operate]
- (cons "Operate" (make-sparse-keymap "Operate")))
-
- (define-key map [menu-bar operate chown]
- '("Change Owner..." . tar-chown-entry))
- (define-key map [menu-bar operate chgrp]
- '("Change Group..." . tar-chgrp-entry))
- (define-key map [menu-bar operate chmod]
- '("Change Mode..." . tar-chmod-entry))
- (define-key map [menu-bar operate rename]
- '("Rename to..." . tar-rename-entry))
- (define-key map [menu-bar operate copy]
- '("Copy to..." . tar-copy))
- (define-key map [menu-bar operate expunge]
- '("Expunge Marked Files" . tar-expunge))
-
map)
"Local keymap for Tar mode listings.")
+(easy-menu-define tar-mode-immediate-menu tar-mode-map
+ "Immediate menu for Tar mode."
+ '("Immediate"
+ ["Find This File" tar-extract]
+ ["Find in Other Window" tar-extract-other-window]
+ ["Display in Other Window" tar-display-other-window]
+ ["View This File" tar-view]
+ ["Read Man Page (WoMan)" woman-tar-extract-file]))
+
+(easy-menu-define tar-mode-mark-menu tar-mode-map
+ "Mark menu for Tar mode."
+ '("Mark"
+ ["Unflag" tar-unflag]
+ ["Flag" tar-flag-deleted]
+ ["Unmark All" tar-clear-modification-flags]))
+
+(easy-menu-define tar-mode-operate-menu tar-mode-map
+ "Operate menu for Tar mode."
+ '("Operate"
+ ["Expunge Marked Files" tar-expunge]
+ ["Copy to..." tar-copy]
+ ["Rename to..." tar-rename-entry]
+ ["Change Mode..." tar-chmod-entry]
+ ["Change Group..." tar-chgrp-entry]
+ ["Change Owner..." tar-chown-entry]))
+
;; tar mode is suitable only for specially formatted data.
(put 'tar-mode 'mode-class 'special)
@@ -701,12 +687,12 @@ For instance, if mode is #o700, then it produces `rwx------'."
(define-derived-mode tar-mode special-mode "Tar"
"Major mode for viewing a tar file as a dired-like listing of its contents.
You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the tar file and into its own buffer;
+Letters no longer insert themselves.\\<tar-mode-map>
+Type \\[tar-extract] to pull a file out of the tar file and into its own buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
-Type `c' to copy an entry from the tar file into another file on disk.
+Type \\[tar-copy] to copy an entry from the tar file into another file on disk.
-If you edit a sub-file of this archive (as with the `e' command) and
+If you edit a sub-file of this archive (as with the \\[tar-extract] command) and
save it with \\[save-buffer], the contents of that buffer will be
saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.
@@ -767,7 +753,7 @@ into the tar-file buffer that it came from. The changes will
actually appear on disk when you save the tar-file's buffer."
;; Don't do this, because it is redundant and wastes mode line space.
;; :lighter " TarFile"
- nil nil nil
+ :lighter nil
(or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
(error "This buffer is not an element of a tar file"))
(cond (tar-subfile-mode
@@ -976,7 +962,7 @@ return nil. Otherwise point is returned."
(new-buffer-file-name (expand-file-name
;; `:' is not allowed on Windows
(concat tarname "!"
- (if (string-match "/" name)
+ (if (string-search "/" name)
name
;; Make sure `name' contains a /
;; so set-auto-mode doesn't try
diff --git a/lisp/term.el b/lisp/term.el
index 6beb17fb66f..b3870a814d2 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -864,8 +864,30 @@ is buffer-local."
["Paging" term-pager-toggle :style toggle :selected term-pager-count
:help "Toggle paging feature"]))
+(defun term--update-term-menu (&optional force)
+ (when (and (lookup-key term-mode-map [menu-bar terminal])
+ (or force (frame-or-buffer-changed-p)))
+ (let ((buffer-list
+ (seq-filter
+ (lambda (buffer)
+ (provided-mode-derived-p (buffer-local-value 'major-mode buffer)
+ 'term-mode))
+ (buffer-list))))
+ (easy-menu-change
+ '("Terminal")
+ "Terminal Buffers"
+ (mapcar
+ (lambda (buffer)
+ (vector (format "%s (%s)" (buffer-name buffer)
+ (abbreviate-file-name
+ (buffer-local-value 'default-directory buffer)))
+ (lambda ()
+ (interactive)
+ (switch-to-buffer buffer))))
+ buffer-list)))))
+
(easy-menu-define term-signals-menu
- (list term-mode-map term-raw-map term-pager-break-map)
+ (list term-mode-map term-raw-map term-pager-break-map)
"Signals menu for Term mode."
'("Signals"
["BREAK" term-interrupt-subjob :active t
@@ -1076,6 +1098,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(setq-local term-pending-delete-marker (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
+ (add-hook 'menu-bar-update-hook 'term--update-term-menu)
(setq-local term-pending-frame nil)
;; Cua-mode's keybindings interfere with the term keybindings, disable it.
(setq-local cua-mode nil)
@@ -1275,7 +1298,10 @@ without any interpretation."
(defun term-char-mode ()
"Switch to char (\"raw\") sub-mode of term mode.
Each character you type is sent directly to the inferior without
-intervention from Emacs, except for the escape character (usually C-c)."
+intervention from Emacs, except for the escape character (usually C-c).
+
+This command will send existing partial lines to the terminal
+process."
(interactive)
;; FIXME: Emit message? Cfr ilisp-raw-message
(when (term-in-line-mode)
@@ -2535,7 +2561,7 @@ See `term-prompt-regexp'."
;; then the filename reader will only accept a file that exists.
;;
;; A typical use:
-;; (interactive (term-get-source "Compile file: " prev-lisp-dir/file
+;; (interactive (term-get-source "Compile file" prev-lisp-dir/file
;; '(lisp-mode) t))
;; This is pretty stupid about strings. It decides we're in a string
@@ -2566,9 +2592,7 @@ See `term-prompt-regexp'."
(car def)))
(deffile (if sfile-p (file-name-nondirectory stringfile)
(cdr def)))
- (ans (read-file-name (if deffile (format "%s(default %s) "
- prompt deffile)
- prompt)
+ (ans (read-file-name (format-prompt prompt deffile)
defdir
(concat defdir deffile)
mustmatch-p)))
@@ -3464,9 +3488,9 @@ The top-most line is line 0."
((= (aref string 0) ?\032)
;; gdb (when invoked with -fullname) prints:
;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n
- (let* ((first-colon (string-match ":" string 1))
+ (let* ((first-colon (string-search ":" string 1))
(second-colon
- (string-match ":" string (1+ first-colon)))
+ (string-search ":" string (1+ first-colon)))
(filename (substring string 1 first-colon))
(fileline (string-to-number
(substring string (1+ first-colon) second-colon))))
@@ -4283,7 +4307,7 @@ well as the newer ports COM10 and higher."
(when (or (null x) (and (stringp x) (zerop (length x))))
(error "No serial port selected"))
(when (not (or (serial-port-is-file-p)
- (string-match "\\\\" x)))
+ (string-search "\\" x)))
(setq x (concat "\\\\.\\" x)))
x))
diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el
index e38a5d34e75..1f65a46011c 100644
--- a/lisp/term/konsole.el
+++ b/lisp/term/konsole.el
@@ -9,4 +9,4 @@
(provide 'term/konsole)
-;; konsole.el ends here
+;;; konsole.el ends here
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index 35bd3ac0acb..6d43e477ac9 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -1,4 +1,6 @@
-;; The Linux console handles Latin-1 by default. -*- lexical-binding:t -*-
+;;; linux.el -*- lexical-binding:t -*-
+
+;; The Linux console handles Latin-1 by default.
(declare-function gpm-mouse-enable "t-mouse" ())
@@ -10,6 +12,9 @@
;; It can't really display underlines.
(tty-no-underline)
+ ;; Compositions confuse cursor movement.
+ (setq-default auto-composition-mode "linux")
+
(ignore-errors (when gpm-mouse-mode (require 't-mouse) (gpm-mouse-enable)))
;; Make Latin-1 input characters work, too.
diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el
index 3bcaa2ecd18..c2802477670 100644
--- a/lisp/term/lk201.el
+++ b/lisp/term/lk201.el
@@ -1,4 +1,4 @@
-;; Define function key sequences for DEC terminals. -*- lexical-binding: t -*-
+;;; lk201.el --- Define function key sequences for DEC terminals. -*- lexical-binding: t -*-
(defvar lk201-function-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 8cff2ceaeec..9e7b360b9c6 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -290,7 +290,7 @@ This is used by `msdos-show-help'.")
(not cursor-in-echo-area)) ;Don't overwrite a prompt.
(cond
((stringp help)
- (setq help (replace-regexp-in-string "\n" ", " help))
+ (setq help (string-replace "\n" ", " help))
(unless (or msdos-previous-message
(string-equal help (current-message))
(and (stringp msdos-last-help-message)
diff --git a/lisp/term/screen.el b/lisp/term/screen.el
index 04481e8358b..9655f41b6c1 100644
--- a/lisp/term/screen.el
+++ b/lisp/term/screen.el
@@ -22,4 +22,4 @@ it runs, which can change when the screen session is moved to another tty."
(provide 'term/screen)
-;; screen.el ends here
+;;; screen.el ends here
diff --git a/lisp/term/st.el b/lisp/term/st.el
index 08432c414af..f1cbad6d59f 100644
--- a/lisp/term/st.el
+++ b/lisp/term/st.el
@@ -11,10 +11,19 @@
(require 'term/xterm)
+(defcustom xterm-st-extra-capabilities '( modifyOtherKeys getSelection
+ setSelection)
+ "Extra capabilities supported under \"stterm\"."
+ :version "28.1"
+ :type xterm--extra-capabilities-type
+ :group 'xterm)
+
(defun terminal-init-st ()
"Terminal initialization function for st."
- (tty-run-terminal-initialization (selected-frame) "xterm"))
+ ;; Using `check' leads to a two-second timeout.
+ (let ((xterm-extra-capabilities xterm-st-extra-capabilities))
+ (tty-run-terminal-initialization (selected-frame) "xterm")))
(provide 'term/st)
-;; st.el ends here
+;;; st.el ends here
diff --git a/lisp/term/tmux.el b/lisp/term/tmux.el
index aa0c98364f3..4ea6f416c8c 100644
--- a/lisp/term/tmux.el
+++ b/lisp/term/tmux.el
@@ -22,4 +22,4 @@ it runs, which can change when the tmux session is moved to another tty."
(provide 'term/tmux)
-;; tmux.el ends here
+;;; tmux.el ends here
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index e8451930133..80afcb36040 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -284,7 +284,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
'(libxml2 "libxml2-2.dll" "libxml2.dll")
'(zlib "zlib1.dll" "libz-1.dll")
'(lcms2 "liblcms2-2.dll")
- '(json "libjansson-4.dll")))
+ '(json "libjansson-4.dll")
+ '(gccjit "libgccjit-0.dll")))
;;; multi-tty support
(defvar w32-initialized nil
@@ -409,7 +410,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 (replace-regexp-in-string "\0" "\\0" value t t))
+ (w32-set-clipboard-data (string-replace "\0" "\\0" value))
(put 'x-selections (or type 'PRIMARY) value)))
(defun w32--get-selection (&optional type data-type)
@@ -555,6 +556,9 @@ be found in this alist.
This alist is used by w32font.c when it looks for fonts that can display
characters from scripts for which no USBs are defined.")
+(declare-function x-list-fonts "xfaces.c"
+ (pattern &optional face frame maximum width))
+
(defun w32-find-non-USB-fonts (&optional frame size)
"Compute the value of `w32-non-USB-fonts' for specified SIZE and FRAME.
FRAME defaults to the selected frame.
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 4a925cd84c3..1a5dc05783e 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,4 +1,4 @@
-;;; w32console.el -- Setup w32 console keys and colors. -*- lexical-binding: t; -*-
+;;; w32console.el --- Setup w32 console keys and colors. -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index e4521ff1876..8c6c75e7e22 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1355,7 +1355,7 @@ This returns an error if any Emacs frames are X frames."
(declare-function x-get-selection-internal "xselect.c"
(selection-symbol target-type &optional time-stamp terminal))
-(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
+(add-to-list 'display-format-alist '("\\`.*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
(cl-defmethod handle-args-function (args &context (window-system x))
(x-handle-args args))
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index eeaf805930b..e63bf36cc3d 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -770,8 +770,7 @@ Can be nil to mean \"no timeout\".")
By not redisplaying right away for xterm queries, we can avoid
unsightly flashing during initialization. Give up and redisplay
anyway if we've been waiting a little while."
- (let ((start-time (current-time))
- (inhibit--record-char t))
+ (let ((start-time (current-time)))
(or (let ((inhibit-redisplay t))
(read-event nil nil xterm-query-redisplay-timeout))
(read-event nil nil
@@ -839,8 +838,8 @@ We run the first FUNCTION whose STRING matches the input events."
basemap
(make-composed-keymap map (keymap-parent basemap))))
-(defun terminal-init-xterm ()
- "Terminal initialization function for xterm."
+(defun xterm--init ()
+ "Initialize the terminal for xterm."
;; rxvt terminals sometimes set the TERM variable to "xterm", but
;; rxvt's keybindings are incompatible with xterm's. It is
;; better in that case to use rxvt's initialization function.
@@ -882,9 +881,18 @@ We run the first FUNCTION whose STRING matches the input events."
;; support it just ignore the sequence.
(xterm--init-bracketed-paste-mode)
;; We likewise unconditionally enable support for focus tracking.
- (xterm--init-focus-tracking)
+ (xterm--init-focus-tracking))
- (run-hooks 'terminal-init-xterm-hook))
+(defun terminal-init-xterm ()
+ "Terminal initialization function for xterm."
+ (unwind-protect
+ (progn
+ (xterm--init)
+ ;; If the terminal initialization completed without errors, clear
+ ;; the lossage to discard the responses of the terminal emulator
+ ;; during initialization; otherwise they appear in the recent keys.
+ (clear-this-command-keys))
+ (run-hooks 'terminal-init-xterm-hook)))
(defun xterm--init-modify-other-keys ()
"Terminal initialization for xterm's modifyOtherKeys support."
@@ -936,9 +944,10 @@ See `xterm--init-frame-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))
+ (unless (display-graphic-p terminal)
+ (send-string-to-terminal
+ (format "\e]2;%s\a" (format-mode-line frame-title-format))
+ terminal)))
(defun xterm--selection-char (type)
(pcase type
@@ -1007,10 +1016,9 @@ hitting screen's max DCS length."
'terminal-init-screen))
(bytes (encode-coding-string data 'utf-8-unix))
(base-64 (if screen
- (replace-regexp-in-string
+ (string-replace
"\n" "\e\\\eP"
- (base64-encode-string bytes)
- :fixedcase :literal)
+ (base64-encode-string bytes))
(base64-encode-string bytes :no-line-break)))
(length (length base-64)))
(if (> length xterm-max-cut-length)
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index e66adb43e75..d9a83c566b4 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -6,7 +6,7 @@
;; Keywords: mouse
;; Old-Version: 1.2.6
;; Release-date: 6-Aug-2004
-;; Location: http://www.lysator.liu.se/~tab/artist/
+;; Location: https://www.lysator.liu.se/~tab/artist/
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
;; file on 19/3/2008, and the maintainer agreed that when a bug is filed in
@@ -33,7 +33,7 @@
;; What is artist?
;; ---------------
;;
-;; Artist is an Emacs lisp package that allows you to draw lines,
+;; Artist is an Emacs Lisp package that allows you to draw lines,
;; rectangles and ellipses by using your mouse and/or keyboard. The
;; shapes are made up with the ascii characters |, -, / and \.
;;
@@ -106,13 +106,6 @@
;; If you add a new drawing mode, send it to me, and I would gladly
;; include in the next release!
-;;; Installation:
-
-;; To use artist, put this in your .emacs:
-;;
-;; (autoload 'artist-mode "artist" "Enter artist-mode" t)
-
-
;;; Requirements:
;; Artist requires the `rect' package (which comes with Emacs) to be
@@ -481,50 +474,6 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.")
(defvar artist-arrow-point-1 nil)
(defvar artist-arrow-point-2 nil)
-(defvar artist-menu-map
- (let ((map (make-sparse-keymap)))
- (define-key map [spray-chars]
- '(menu-item "Characters for Spray" artist-select-spray-chars
- :help "Choose characters for sprayed by the spray-can"))
- (define-key map [borders]
- '(menu-item "Draw Shape Borders" artist-toggle-borderless-shapes
- :help "Toggle whether shapes are drawn with borders"
- :button (:toggle . (not artist-borderless-shapes))))
- (define-key map [trimming]
- '(menu-item "Trim Line Endings" artist-toggle-trim-line-endings
- :help "Toggle trimming of line-endings"
- :button (:toggle . artist-trim-line-endings)))
- (define-key map [rubber-band]
- '(menu-item "Rubber-banding" artist-toggle-rubber-banding
- :help "Toggle rubber-banding"
- :button (:toggle . artist-rubber-banding)))
- (define-key map [set-erase]
- '(menu-item "Character to Erase..." artist-select-erase-char
- :help "Choose a specific character to erase"))
- (define-key map [set-line]
- '(menu-item "Character for Line..." artist-select-line-char
- :help "Choose the character to insert when drawing lines"))
- (define-key map [set-fill]
- '(menu-item "Character for Fill..." artist-select-fill-char
- :help "Choose the character to insert when filling in shapes"))
- (define-key map [artist-separator] '(menu-item "--"))
- (dolist (op '(("Vaporize" artist-select-op-vaporize-lines vaporize-lines)
- ("Erase" artist-select-op-erase-rectangle erase-rect)
- ("Spray-can" artist-select-op-spray-set-size spray-get-size)
- ("Text" artist-select-op-text-overwrite text-ovwrt)
- ("Ellipse" artist-select-op-circle circle)
- ("Poly-line" artist-select-op-straight-poly-line spolyline)
- ("Square" artist-select-op-square square)
- ("Rectangle" artist-select-op-rectangle rectangle)
- ("Line" artist-select-op-straight-line s-line)
- ("Pen" artist-select-op-pen-line pen-line)))
- (define-key map (vector (nth 2 op))
- `(menu-item ,(nth 0 op)
- ,(nth 1 op)
- :help ,(format "Draw using the %s style" (nth 0 op))
- :button (:radio . (eq artist-curr-go ',(nth 2 op))))))
- map))
-
(defvar artist-mode-map
(let ((map (make-sparse-keymap)))
(setq artist-mode-map (make-sparse-keymap))
@@ -577,10 +526,50 @@ This variable is initialized by the `artist-make-prev-next-op-alist' function.")
(define-key map "\C-c\C-a\C-y" 'artist-select-op-paste)
(define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
(define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report)
- (define-key map [menu-bar artist] (cons "Artist" artist-menu-map))
map)
"Keymap for `artist-mode'.")
+(easy-menu-define artist-menu-map artist-mode-map
+ "Menu for `artist-mode'."
+ `("Artist"
+ ,@(mapcar
+ (lambda (op)
+ `[,(nth 0 op) ,(nth 1 op)
+ :help ,(format "Draw using the %s style" (nth 0 op))
+ :style radio
+ :selected (eq artist-curr-go ',(nth 2 op))])
+ '(("Vaporize" artist-select-op-vaporize-lines vaporize-lines)
+ ("Erase" artist-select-op-erase-rectangle erase-rect)
+ ("Spray-can" artist-select-op-spray-set-size spray-get-size)
+ ("Text" artist-select-op-text-overwrite text-ovwrt)
+ ("Ellipse" artist-select-op-circle circle)
+ ("Poly-line" artist-select-op-straight-poly-line spolyline)
+ ("Square" artist-select-op-square square)
+ ("Rectangle" artist-select-op-rectangle rectangle)
+ ("Line" artist-select-op-straight-line s-line)
+ ("Pen" artist-select-op-pen-line pen-line)))
+ "---"
+ ["Character for Fill..." artist-select-fill-char
+ :help "Choose the character to insert when filling in shapes"]
+ ["Character for Line..." artist-select-line-char
+ :help "Choose the character to insert when drawing lines"]
+ ["Character to Erase..." artist-select-erase-char
+ :help "Choose a specific character to erase"]
+ ["Rubber-banding" artist-toggle-rubber-banding
+ :help "Toggle rubber-banding"
+ :style toggle
+ :selected artist-rubber-banding]
+ ["Trim Line Endings" artist-toggle-trim-line-endings
+ :help "Toggle trimming of line-endings"
+ :style toggle
+ :selected artist-trim-line-endings]
+ ["Draw Shape Borders" artist-toggle-borderless-shapes
+ :help "Toggle whether shapes are drawn with borders"
+ :style toggle
+ :selected (not artist-borderless-shapes)]
+ ["Characters for Spray" artist-select-spray-chars
+ :help "Choose characters for sprayed by the spray-can"]))
+
(defvar artist-replacement-table (make-vector 256 0)
"Replacement table for `artist-replace-char'.")
@@ -1764,13 +1753,6 @@ info-variant-part."
"Call function FN with ARGS, if FN is not nil."
`(if ,fn (funcall ,fn ,@args)))
-(defun artist-uniq (l)
- "Remove consecutive duplicates in list L. Comparison is done with `equal'."
- (cond ((null l) nil)
- ((null (cdr l)) l) ; only one element in list
- ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal
- (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
-
(defun artist-string-split (str r)
"Split string STR at occurrences of regexp R, returning a list of strings."
(let ((res nil)
@@ -2772,7 +2754,7 @@ to append to the end of the list, when doing free-hand drawing)."
Also, the `artist-key-poly-point-list' is reversed."
(setq artist-key-poly-point-list
- (artist-uniq artist-key-poly-point-list))
+ (seq-uniq artist-key-poly-point-list))
(if (>= (length artist-key-poly-point-list) 2)
@@ -3470,7 +3452,7 @@ The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
(line-char (if artist-line-char-set artist-line-char ?-))
(i 0)
(point-list nil)
- (fill-info nil)
+ ;; (fill-info nil)
(shape-info (make-vector 2 0)))
(while (< i width)
(let* ((line-x (+ left-edge i))
@@ -3483,7 +3465,7 @@ The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
(setq point-list (append point-list (list new-coord)))
(setq i (1+ i))))
(aset shape-info 0 point-list)
- (aset shape-info 1 fill-info)
+ (aset shape-info 1 nil) ;; fill-info
(artist-make-2point-object (artist-make-endpoint x1 y1)
(artist-make-endpoint x-radius y-radius)
shape-info)))
@@ -5383,10 +5365,7 @@ The event, EV, is the mouse event."
(concat "Hello Tomas,\n\n"
"I have a nice bug report on Artist for you! Here it is:")))))
-
-;;
-;; Now provide this minor mode
-;;
+(define-obsolete-function-alias 'artist-uniq #'seq-uniq "28.1")
(provide 'artist)
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 1e22287d32e..e2fd3ecaa42 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,4 +1,4 @@
-;;; bib-mode.el --- major mode for editing bib files
+;;; bib-mode.el --- major mode for editing bib files -*- lexical-binding: t -*-
;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
@@ -29,6 +29,8 @@
;; bibliography file. Keys are automagically inserted as you type,
;; and appropriate keys are presented for various kinds of entries.
+;; FIXME: Fix the namespace use of this library.
+
;;; Code:
(defgroup bib nil
@@ -39,21 +41,19 @@
(defcustom bib-file "~/my-bibliography.bib"
"Default name of file used by `addbib'."
- :type 'file
- :group 'bib)
+ :type 'file)
(defcustom unread-bib-file "~/to-be-read.bib"
"Default name of file used by `unread-bib' in Bib mode."
- :type 'file
- :group 'bib)
+ :type 'file)
(defvar bib-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
- (define-key map "\C-M" 'return-key-bib)
- (define-key map "\C-c\C-u" 'unread-bib)
- (define-key map "\C-c\C-@" 'mark-bib)
- (define-key map "\e`" 'abbrev-mode)
+ (define-key map "\C-M" #'return-key-bib)
+ (define-key map "\C-c\C-u" #'unread-bib)
+ (define-key map "\C-c\C-@" #'mark-bib)
+ (define-key map "\e`" #'abbrev-mode)
map))
(defun addbib ()
@@ -138,8 +138,7 @@ with the cdr.")
(defcustom bib-auto-capitalize t
"True to automatically capitalize appropriate fields in Bib mode."
- :type 'boolean
- :group 'bib)
+ :type 'boolean)
(defconst bib-capitalized-fields "%[AETCBIJR]")
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index 66d245f9083..27b2e0e3331 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -24,7 +24,6 @@
;; Done: font-lock, imenu, outline, commenting, indentation.
;; Todo: tab-completion.
-;; Bugs:
;;; Code:
@@ -49,7 +48,7 @@
"REVERSE" "SORT" "STRINGS"))
(defconst bibtex-style-functions
- ;; From http://www.eeng.dcu.ie/local-docs/btxdocs/btxhak/btxhak/node4.html.
+ ;; From https://www.eeng.dcu.ie/local-docs/btxdocs/btxhak/btxhak/node4.html.
'("<" ">" "=" "+" "-" "*" ":="
"add.period$" "call.type$" "change.case$" "chr.to.int$" "cite$"
"duplicate$" "empty$" "format.name$" "if$" "int.to.chr$" "int.to.str$"
@@ -70,7 +69,7 @@
(setq-local outline-regexp "^[a-z]")
(setq-local imenu-generic-expression
'((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2)))
- (setq-local indent-line-function 'bibtex-style-indent-line)
+ (setq-local indent-line-function #'bibtex-style-indent-line)
(setq-local parse-sexp-ignore-comments t)
(setq font-lock-defaults
'(bibtex-style-font-lock-keywords nil t
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index a22cd97b309..5cece1aa3c6 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1431,7 +1431,7 @@ If `bibtex-expand-strings' is non-nil, BibTeX strings are expanded
for generating the URL.
Set this variable before loading BibTeX mode.
-The following is a complex example, see URL `http://link.aps.org/'.
+The following is a complex example, see URL `https://link.aps.org/'.
(((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\")
\"http://link.aps.org/abstract/%s/v%s/p%s\"
@@ -3327,7 +3327,7 @@ Use `bibtex-summary-function' to generate summary."
(message "%s %s" key summary))))))
(defun bibtex-copy-summary-as-kill (&optional arg)
- "Push summery of current BibTeX entry to kill ring.
+ "Push summary of current BibTeX entry to kill ring.
Use `bibtex-summary-function' to generate summary.
If prefix ARG is non-nil push BibTeX entry's URL to kill ring
that is generated by calling `bibtex-url'."
@@ -3962,7 +3962,7 @@ Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for
interactive calls."
(interactive (list nil t))
(unless field (setq field (car (bibtex-find-text-internal nil nil comma))))
- (if (string-match "@" field)
+ (if (string-search "@" field)
(cond ((bibtex-string= field "@string")
(message "String definition"))
((bibtex-string= field "@preamble")
@@ -5608,8 +5608,5 @@ If APPEND is non-nil, append ENTRIES to those already displayed."
(setq buffer-read-only t)
(goto-char (point-min)))
-
-;; Make BibTeX a Feature
-
(provide 'bibtex)
;;; bibtex.el ends here
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index d88964aa4f0..5f34ae152d1 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -63,8 +63,7 @@ not align (only setting space according to `conf-assignment-space')."
:type 'boolean)
(defvar conf-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
+ (let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-u" 'conf-unix-mode)
(define-key map "\C-c\C-w" 'conf-windows-mode)
(define-key map "\C-c\C-j" 'conf-javaprop-mode)
@@ -78,52 +77,46 @@ not align (only setting space according to `conf-assignment-space')."
(define-key map "\C-c\"" 'conf-quote-normal)
(define-key map "\C-c'" 'conf-quote-normal)
(define-key map "\C-c\C-a" 'conf-align-assignments)
- (define-key map [menu-bar sh-script] (cons "Conf" menu-map))
- (define-key menu-map [conf-windows-mode]
- '(menu-item "Windows mode"
- conf-windows-mode
- :help "Conf Mode starter for Windows style Conf files"
- :button (:radio . (eq major-mode 'conf-windows-mode))))
- (define-key menu-map [conf-javaprop-mode]
- '(menu-item "Java properties mode"
- conf-javaprop-mode
- :help "Conf Mode starter for Java properties files"
- :button (:radio . (eq major-mode 'conf-javaprop-mode))))
- (define-key menu-map [conf-space-keywords]
- '(menu-item "Space keywords mode..."
- conf-space-keywords
- :help "Enter Conf Space mode using regexp KEYWORDS to match the keywords"
- :button (:radio . (eq major-mode 'conf-space-keywords))))
- (define-key menu-map [conf-ppd-mode]
- '(menu-item "PPD mode"
- conf-ppd-mode
- :help "Conf Mode starter for Adobe/CUPS PPD files"
- :button (:radio . (eq major-mode 'conf-ppd-mode))))
- (define-key menu-map [conf-colon-mode]
- '(menu-item "Colon mode"
- conf-colon-mode
- :help "Conf Mode starter for Colon files"
- :button (:radio . (eq major-mode 'conf-colon-mode))))
- (define-key menu-map [conf-unix-mode]
- '(menu-item "Unix mode"
- conf-unix-mode
- :help "Conf Mode starter for Unix style Conf files"
- :button (:radio . (eq major-mode 'conf-unix-mode))))
- (define-key menu-map [conf-xdefaults-mode]
- '(menu-item "Xdefaults mode"
- conf-xdefaults-mode
- :help "Conf Mode starter for Xdefaults files"
- :button (:radio . (eq major-mode 'conf-xdefaults-mode))))
- (define-key menu-map [c-s0] '("--"))
- (define-key menu-map [conf-quote-normal]
- '(menu-item "Set quote syntax normal" conf-quote-normal
- :help "Set the syntax of \\=' and \" to punctuation"))
- (define-key menu-map [conf-align-assignments]
- '(menu-item "Align assignments" conf-align-assignments
- :help "Align assignments"))
map)
"Local keymap for `conf-mode' buffers.")
+(easy-menu-define conf-mode-menu conf-mode-map
+ "Menu for `conf-mode'."
+ '("Conf"
+ ["Align assignments" conf-align-assignments
+ :help "Align assignments"]
+ ["Set quote syntax normal" conf-quote-normal
+ :help "Set the syntax of \\=' and \" to punctuation"]
+ "---"
+ ["Xdefaults mode" conf-xdefaults-mode
+ :help "Conf Mode starter for Xdefaults files"
+ :style radio
+ :selected (eq major-mode 'conf-xdefaults-mode)]
+ ["Unix mode" conf-unix-mode
+ :help "Conf Mode starter for Unix style Conf files"
+ :style radio
+ :selected (eq major-mode 'conf-unix-mode)]
+ ["Colon mode" conf-colon-mode
+ :help "Conf Mode starter for Colon files"
+ :style radio
+ :selected (eq major-mode 'conf-colon-mode)]
+ ["PPD mode" conf-ppd-mode
+ :help "Conf Mode starter for Adobe/CUPS PPD files"
+ :style radio
+ :selected (eq major-mode 'conf-ppd-mode)]
+ ["Space keywords mode..." conf-space-keywords
+ :help "Enter Conf Space mode using regexp KEYWORDS to match the keywords"
+ :style radio
+ :selected (eq major-mode 'conf-space-keywords)]
+ ["Java properties mode" conf-javaprop-mode
+ :help "Conf Mode starter for Java properties files"
+ :style radio
+ :selected (eq major-mode 'conf-javaprop-mode)]
+ ["Windows mode" conf-windows-mode
+ :help "Conf Mode starter for Windows style Conf files"
+ :style radio
+ :selected (eq major-mode 'conf-windows-mode)]))
+
(defvar conf-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?= "." table)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 622853da456..61a2f6b3bc0 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -427,7 +427,7 @@
"paged-y" "paged-x-controls" "paged-y-controls" "fragments")
;; CSS Text Decoration Module Level 3
- ;; (http://dev.w3.org/csswg/css-text-decor-3/#property-index)
+ ;; (https://dev.w3.org/csswg/css-text-decor-3/#property-index)
("text-decoration" text-decoration-line text-decoration-style
text-decoration-color)
("text-decoration-color" color)
@@ -1307,10 +1307,14 @@ for determining whether point is within a selector."
(let ((pos (point)))
(skip-chars-backward "-[:alnum:]")
(when (eq (char-before) ?\:)
- (list (point) pos
- (if (eq (char-before (- (point) 1)) ?\:)
- css-pseudo-element-ids
- css-pseudo-class-ids))))))
+ (let ((double-colon (eq (char-before (- (point) 1)) ?\:)))
+ (list (- (point) (if double-colon 2 1))
+ pos
+ (nconc
+ (unless double-colon
+ (mapcar (lambda (id) (concat ":" id)) css-pseudo-class-ids))
+ (mapcar (lambda (id) (concat "::" id)) css-pseudo-element-ids))
+ :company-kind (lambda (_) 'function)))))))
(defun css--complete-at-rule ()
"Complete at-rule (statement beginning with `@') at point."
@@ -1318,7 +1322,8 @@ for determining whether point is within a selector."
(let ((pos (point)))
(skip-chars-backward "-[:alnum:]")
(when (eq (char-before) ?\@)
- (list (point) pos css--at-ids)))))
+ (list (point) pos css--at-ids
+ :company-kind (lambda (_) 'keyword))))))
(defvar css--property-value-cache
(make-hash-table :test 'equal :size (length css-property-alist))
@@ -1366,7 +1371,8 @@ the string PROPERTY."
(skip-chars-backward "[:graph:]")
(list (point) end
(append '("inherit" "initial" "unset")
- (css--property-values (car property)))))))))
+ (css--property-values (car property)))
+ :company-kind (lambda (_) 'value)))))))
(defvar css--html-tags (mapcar #'car html-tag-alist)
"List of HTML tags.
@@ -1435,6 +1441,8 @@ tags, classes and IDs."
(list prop-beg prop-end)
(list sel-beg sel-end))
,(completion-table-merge prop-table sel-table)
+ :company-kind
+ ,(lambda (s) (if (test-completion s prop-table) 'property 'keyword))
:exit-function
,(lambda (string status)
(and (eq status 'finished)
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index 23a622992ad..2fa5e8de398 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -1,4 +1,4 @@
-;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
+;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files -*- lexical-binding: t -*-
;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc.
@@ -70,23 +70,19 @@
(defface dns-mode-control-entity '((t :inherit font-lock-keyword-face))
"Face used for DNS control entities, e.g. $ORIGIN."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defface dns-mode-bad-control-entity '((t :inherit font-lock-warning-face))
"Face used for non-standard DNS control entities, e.g. $FOO."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defface dns-mode-type '((t :inherit font-lock-type-face))
"Face used for DNS types, e.g., SOA."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defface dns-mode-class '((t :inherit font-lock-constant-face))
"Face used for DNS classes, e.g., IN."
- :version "26.1"
- :group 'dns-mode)
+ :version "26.1")
(defvar dns-mode-control-entity-face ''dns-mode-control-entity
"Name of face used for control entities, e.g. $ORIGIN.")
@@ -121,8 +117,7 @@
(,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face))
"Font lock keywords used to highlight text in DNS master file mode."
:version "26.1"
- :type 'sexp
- :group 'dns-mode)
+ :type 'sexp)
(defcustom dns-mode-soa-auto-increment-serial t
"Whether to increment the SOA serial number automatically.
@@ -134,8 +129,7 @@ manually with \\[dns-mode-soa-increment-serial]."
:type '(choice (const :tag "Always" t)
(const :tag "Ask" ask)
(const :tag "Never" nil))
- :safe 'symbolp
- :group 'dns-mode)
+ :safe 'symbolp)
;; Syntax table.
@@ -150,8 +144,8 @@ manually with \\[dns-mode-soa-increment-serial]."
(defvar dns-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-s" 'dns-mode-soa-increment-serial)
- (define-key map "\C-c\C-e" 'dns-mode-ipv6-to-nibbles)
+ (define-key map "\C-c\C-s" #'dns-mode-soa-increment-serial)
+ (define-key map "\C-c\C-e" #'dns-mode-ipv6-to-nibbles)
map)
"Keymap for DNS master file mode.")
@@ -183,7 +177,7 @@ Turning on DNS mode runs `dns-mode-hook'."
(setq-local comment-start-skip ";+ *")
(setq-local font-lock-defaults
'(dns-mode-font-lock-keywords nil nil ((?_ . "w"))))
- (add-hook 'before-save-hook 'dns-mode-soa-maybe-increment-serial
+ (add-hook 'before-save-hook #'dns-mode-soa-maybe-increment-serial
nil t))
;;;###autoload (defalias 'zone-mode 'dns-mode)
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index fe92d603065..877658a5a55 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -1,4 +1,4 @@
-;;; enriched.el --- read and save files in text/enriched format
+;;; enriched.el --- read and save files in text/enriched format -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1996, 2001-2021 Free Software Foundation, Inc.
@@ -38,7 +38,7 @@
;;; Code:
-(provide 'enriched)
+(require 'facemenu)
;;;
;;; Variables controlling the display
@@ -50,8 +50,7 @@
(defcustom enriched-verbose t
"If non-nil, give status messages when reading and writing files."
- :type 'boolean
- :group 'enriched)
+ :type 'boolean)
;;;
;;; Set up faces & display table
@@ -65,14 +64,12 @@
"Face used for text that must be shown in fixed width.
Currently, Emacs can only display fixed-width fonts, but this may change.
This face is used for text specifically marked as fixed-width, for example
-in text/enriched files."
- :group 'enriched)
+in text/enriched files.")
(defface excerpt
'((t (:slant italic)))
"Face used for text that is an excerpt from another document.
-This is used in Enriched mode for text explicitly marked as an excerpt."
- :group 'enriched)
+This is used in Enriched mode for text explicitly marked as an excerpt.")
(defconst enriched-display-table (or (copy-sequence standard-display-table)
(make-display-table)))
@@ -146,8 +143,7 @@ Any property that is neither on this list nor dealt with by
If you set variables in this hook, you should arrange for them to be restored
to their old values if you leave Enriched mode. One way to do this is to add
them and their old values to `enriched-old-bindings'."
- :type 'hook
- :group 'enriched)
+ :type 'hook)
(defcustom enriched-allow-eval-in-display-props nil
"If non-nil allow to evaluate arbitrary forms in display properties.
@@ -162,8 +158,7 @@ Note, however, that applying unsafe display properties could
execute malicious Lisp code, if that code came from an external source."
:risky t
:type 'boolean
- :version "26.1"
- :group 'enriched)
+ :version "26.1")
(defvar-local enriched-old-bindings nil
"Store old variable values that we change when entering mode.
@@ -186,14 +181,16 @@ The value is a list of \(VAR VALUE VAR VALUE...).")
(defvar enriched-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-m" 'reindent-then-newline-and-indent)
+ ;; FIXME: These newline/reindent bindings might be redundant now
+ ;; that we have `electric-indent-mode' enabled by default.
+ (define-key map "\C-m" #'reindent-then-newline-and-indent)
(define-key map
- [remap newline-and-indent] 'reindent-then-newline-and-indent)
+ [remap newline-and-indent] #'reindent-then-newline-and-indent)
(define-key map "\M-j" 'facemenu-justification-menu)
- (define-key map "\M-S" 'set-justification-center)
- (define-key map "\C-x\t" 'increase-left-margin)
- (define-key map "\C-c[" 'set-left-margin)
- (define-key map "\C-c]" 'set-right-margin)
+ (define-key map "\M-S" #'set-justification-center)
+ (define-key map "\C-x\t" #'increase-left-margin)
+ (define-key map "\C-c[" #'set-left-margin)
+ (define-key map "\C-c]" #'set-right-margin)
map)
"Keymap for Enriched mode.")
@@ -220,7 +217,7 @@ Commands:
(cond ((null enriched-mode)
;; Turn mode off
(remove-hook 'change-major-mode-hook
- 'enriched-before-change-major-mode 'local)
+ #'enriched-before-change-major-mode 'local)
(setq buffer-file-format (delq 'text/enriched buffer-file-format))
;; restore old variable values
(while enriched-old-bindings
@@ -237,7 +234,7 @@ Commands:
(t ; Turn mode on
(add-hook 'change-major-mode-hook
- 'enriched-before-change-major-mode nil 'local)
+ #'enriched-before-change-major-mode nil 'local)
(add-to-list 'buffer-file-format 'text/enriched)
;; Save old variable values before we change them.
;; These will be restored if we exit Enriched mode.
@@ -250,10 +247,12 @@ Commands:
(make-local-variable 'default-text-properties)
(setq buffer-display-table enriched-display-table)
(use-hard-newlines 1 (if enriched-rerun-flag 'never nil))
- (let ((sticky (plist-get default-text-properties 'front-sticky))
- (p enriched-par-props))
- (dolist (x p)
- (add-to-list 'sticky x))
+ (let* ((sticky
+ (delete-dups
+ (append
+ enriched-par-props
+ (copy-sequence
+ (plist-get default-text-properties 'front-sticky))))))
(if sticky
(setq default-text-properties
(plist-put default-text-properties
@@ -269,7 +268,7 @@ Commands:
(let ((enriched-rerun-flag t))
(enriched-mode 1))))
-(add-hook 'after-change-major-mode-hook 'enriched-after-change-major-mode)
+(add-hook 'after-change-major-mode-hook #'enriched-after-change-major-mode)
(fset 'enriched-mode-map enriched-mode-map)
@@ -347,7 +346,7 @@ the region, and the START and END of each region."
(if orig-buf (set-buffer orig-buf))
(funcall enriched-initial-annotation))))
(enriched-map-property-regions 'hard
- (lambda (v b e)
+ (lambda (v b _e)
(if (and v (= ?\n (char-after b)))
(progn (goto-char b) (insert "\n"))))
(point) nil)
@@ -391,9 +390,11 @@ which can be the value of the `face' text property."
((and (listp face) (eq (car face) :background))
(list (list "x-bg-color" (cadr face))))
((listp face)
- (apply 'append (mapcar 'enriched-face-ans face)))
+ (apply #'append (mapcar #'enriched-face-ans face)))
((let* ((fg (face-attribute face :foreground))
(bg (face-attribute face :background))
+ (weight (face-attribute face :weight))
+ (slant (face-attribute face :slant))
(props (face-font face t))
(ans (cdr (format-annotate-single-property-change
'face nil props enriched-translations))))
@@ -401,6 +402,10 @@ which can be the value of the `face' text property."
(setq ans (cons (list "x-color" fg) ans)))
(unless (eq bg 'unspecified)
(setq ans (cons (list "x-bg-color" bg) ans)))
+ (if (eq weight 'bold)
+ (setq ans (cons (list "bold") ans)))
+ (if (eq slant 'italic)
+ (setq ans (cons (list "italic") ans)))
ans))))
;;;
@@ -533,4 +538,6 @@ the range of text to assign text property SYMBOL with value VALUE."
(list start end 'display prop)
(list start end 'display (list 'disable-eval prop)))))
+(provide 'enriched)
+
;;; enriched.el ends here
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 6681b03913c..f394171fb6c 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -45,14 +45,16 @@ A value of nil means that any change in indentation starts a new paragraph."
(defcustom colon-double-space nil
"Non-nil means put two spaces after a colon when filling."
:type 'boolean)
-(put 'colon-double-space 'safe-local-variable 'booleanp)
+(put 'colon-double-space 'safe-local-variable #'booleanp)
(defcustom fill-separate-heterogeneous-words-with-space nil
"Non-nil means to use a space to separate words of a different kind.
-This will be done with a word in the end of a line and a word in
-the beginning of the next line when concatenating them for
-filling those lines. Whether to use a space depends on how the
-words are categorized."
+For example, when an English word at the end of a line and a CJK word
+at the beginning of the next line are joined into a single line, they
+will be separated by a space if this variable is non-nil.
+Whether to use a space to separate such words also depends on the entry
+in `fill-nospace-between-words-table' for the characters before and
+after the newline."
:type 'boolean
:version "26.1")
@@ -131,6 +133,8 @@ A nil return value means the function has not determined the fill prefix."
(defvar fill-indent-according-to-mode nil ;Screws up CC-mode's filling tricks.
"Whether or not filling should try to use the major mode's indentation.")
+(defvar current-fill-column--has-warned nil)
+
(defun current-fill-column ()
"Return the fill-column to use for this line.
The fill-column to use for a buffer is stored in the variable `fill-column',
@@ -156,7 +160,14 @@ number equals or exceeds the local fill-column - right-margin difference."
(< col fill-col)))
(setq here change
here-col col))
- (max here-col fill-col)))))
+ (max here-col fill-col))
+ ;; This warning was added in 28.1. It should be removed later,
+ ;; and this function changed to never return nil.
+ (unless current-fill-column--has-warned
+ (lwarn '(fill-column) :warning
+ "Setting this variable to nil is obsolete; use `(auto-fill-mode -1)' instead")
+ (setq current-fill-column--has-warned t))
+ most-positive-fixnum)))
(defun canonically-space-region (beg end)
"Remove extra spaces between words in region.
@@ -412,12 +423,12 @@ and `fill-nobreak-invisible'."
;; Register `kinsoku' for scripts HAN, KANA, BOPOMOFO, and CJK-MISC.
;; Also tell that they don't use space between words.
(map-char-table
- #'(lambda (key val)
- (when (memq val '(han kana bopomofo cjk-misc))
- (set-char-table-range fill-find-break-point-function-table
- key 'kinsoku)
- (set-char-table-range fill-nospace-between-words-table
- key t)))
+ (lambda (key val)
+ (when (memq val '(han kana bopomofo cjk-misc))
+ (set-char-table-range fill-find-break-point-function-table
+ key 'kinsoku)
+ (set-char-table-range fill-nospace-between-words-table
+ key t)))
char-script-table)
;; Do the same thing also for full width characters and half
;; width kana variants.
@@ -703,7 +714,8 @@ space does not end a sentence, so don't break a line there."
(or justify (setq justify (current-justification)))
;; Don't let Adaptive Fill mode alter the fill prefix permanently.
- (let ((fill-prefix fill-prefix))
+ (let ((actual-fill-prefix fill-prefix)
+ (fill-prefix fill-prefix))
;; Figure out how this paragraph is indented, if desired.
(when (and adaptive-fill-mode
(or (null fill-prefix) (string= fill-prefix "")))
@@ -717,7 +729,7 @@ space does not end a sentence, so don't break a line there."
(goto-char from)
(beginning-of-line)
- (if (not justify) ; filling disabled: just check indentation
+ (if (not justify) ; filling disabled: just check indentation
(progn
(goto-char from)
(while (< (point) to)
@@ -747,12 +759,14 @@ space does not end a sentence, so don't break a line there."
linebeg)
(while (< (point) to)
;; On the first line, there may be text in the fill prefix
- ;; zone. In that case, don't consider that area when
- ;; trying to find a place to put a line break (bug#45720).
+ ;; zone (when `fill-prefix' is specified externally, and
+ ;; not computed). In that case, don't consider that area
+ ;; when trying to find a place to put a line break
+ ;; (bug#45720).
(if (not first)
(setq linebeg (point))
(setq first nil
- linebeg (+ (point) (length fill-prefix))))
+ linebeg (+ (point) (length actual-fill-prefix))))
(move-to-column (current-fill-column))
(if (when (< (point) to)
;; Find the position where we'll break the line.
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 83dba7177ab..836d889a1cf 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -77,7 +77,7 @@ Detection of repeated words is not implemented in
"A list of exceptions for duplicated words.
It should be a list of (LANGUAGE . EXCEPTION-LIST).
-LANGUAGE is nil, which means the exceptions apply regardless of
+LANGUAGE can be nil, which means the exceptions apply regardless of
the current dictionary, or a regular expression matching the
dictionary name (`ispell-local-dictionary' or
`ispell-dictionary') for which the exceptions should apply.
@@ -401,18 +401,12 @@ like <img alt=\"Some thing.\">."
(let ((f (get-text-property (1- (point)) 'face)))
(memq f flyspell-prog-text-faces))))
-(defvar flyspell--prev-meta-tab-binding nil
- "Records the binding of M-TAB in effect before flyspell was activated.")
-
;;;###autoload
(defun flyspell-prog-mode ()
"Turn on `flyspell-mode' for comments and strings."
(interactive)
(setq flyspell-generic-check-word-predicate
#'flyspell-generic-progmode-verify)
- (setq-local flyspell--prev-meta-tab-binding
- (or (local-key-binding "\M-\t" t)
- (global-key-binding "\M-\t" t)))
(flyspell-mode 1)
(run-hooks 'flyspell-prog-mode-hook))
@@ -1263,14 +1257,27 @@ spell-check."
(t
(setq flyspell-word-cache-result nil)
;; Highlight the location as incorrect,
- ;; including offset specified in POSS.
+ ;; including offset specified in POSS
+ ;; and only for the length of the
+ ;; misspelled word specified by POSS.
(if flyspell-highlight-flag
- (flyspell-highlight-incorrect-region
- (if (and (consp poss)
- (integerp (nth 1 poss)))
- (+ start (nth 1 poss) -1)
- start)
- end poss)
+ (let ((hstart start)
+ (hend end)
+ offset misspelled)
+ (when (consp poss)
+ (setq misspelled (car poss)
+ offset (nth 1 poss))
+ (if (integerp offset)
+ (setq hstart (+ start offset -1)))
+ ;; POSS includes the misspelled
+ ;; word; use that to figure out
+ ;; how many characters to highlight.
+ (if (stringp misspelled)
+ (setq hend
+ (+ hstart
+ (length misspelled)))))
+ (flyspell-highlight-incorrect-region
+ hstart hend poss))
(flyspell-notify-misspell word poss))
nil))))
;; return to original location
@@ -1977,15 +1984,14 @@ spell-check."
(interactive)
;; If we are not in the construct where flyspell should be active,
;; invoke the original binding of M-TAB, if that was recorded.
- (if (and (local-variable-p 'flyspell--prev-meta-tab-binding)
- (commandp flyspell--prev-meta-tab-binding t)
- (functionp flyspell-generic-check-word-predicate)
- (not (funcall flyspell-generic-check-word-predicate))
- (equal (where-is-internal 'flyspell-auto-correct-word nil t)
- [?\M-\t]))
- (call-interactively flyspell--prev-meta-tab-binding)
- (let ((pos (point))
- (old-max (point-max)))
+ (let ((pos (point))
+ (old-max (point-max))
+ (next-cmd (and (functionp flyspell-generic-check-word-predicate)
+ (not (funcall flyspell-generic-check-word-predicate))
+ (let ((flyspell-mode nil))
+ (key-binding (this-command-keys))))))
+ (if next-cmd
+ (command-execute next-cmd)
;; Flush a possibly stale cache from previous invocations of
;; flyspell-auto-correct-word/flyspell-auto-correct-previous-word.
(if (not (memq last-command '(flyspell-auto-correct-word
@@ -2293,8 +2299,8 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
corrects)
'()))
(affix (car (cdr (cdr (cdr poss)))))
- show-affix-info
- (base-menu (let ((save (if (and (consp affix) show-affix-info)
+ ;; show-affix-info
+ (base-menu (let ((save (if nil ;; (and (consp affix) show-affix-info)
(list
(list (concat "Save affix: " (car affix))
'save)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index ea46270508e..67852998f42 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -131,8 +131,7 @@
(defcustom ispell-highlight-p 'block
"Highlight spelling errors when non-nil.
When set to `block', assumes a block cursor with TTY displays."
- :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t))
- :group 'ispell)
+ :type '(choice (const block) (const :tag "off" nil) (const :tag "on" t)))
(defcustom ispell-lazy-highlight (boundp 'lazy-highlight-cleanup)
"Controls the lazy-highlighting of spelling errors.
@@ -141,7 +140,6 @@ error is highlighted lazily using isearch lazy highlighting (see
`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
:type 'boolean
:group 'lazy-highlight
- :group 'ispell
:version "22.1")
(defcustom ispell-highlight-face (if ispell-lazy-highlight 'isearch 'highlight)
@@ -149,16 +147,14 @@ error is highlighted lazily using isearch lazy highlighting (see
This variable can be set by the user to whatever face they desire.
It's most convenient if the cursor color and highlight color are
slightly different."
- :type 'face
- :group 'ispell)
+ :type 'face)
(defcustom ispell-check-comments t
"Spelling of comments checked when non-nil.
When set to `exclusive', ONLY comments are checked. (For code comments).
Warning! Not checking comments, when a comment start is embedded in strings,
may produce undesired results."
- :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t))
- :group 'ispell)
+ :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t)))
;;;###autoload
(put 'ispell-check-comments 'safe-local-variable
(lambda (a) (memq a '(nil t exclusive))))
@@ -166,8 +162,7 @@ may produce undesired results."
(defcustom ispell-query-replace-choices nil
"Corrections made throughout region when non-nil.
Uses `query-replace' (\\[query-replace]) for corrections."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-skip-tib nil
"Does not spell check `tib' bibliography references when non-nil.
@@ -177,8 +172,7 @@ Skips any text between strings matching regular expressions
TeX users beware: Any text between [. and .] will be skipped -- even if
that's your whole buffer -- unless you set `ispell-skip-tib' to nil.
That includes the [.5mm] type of number..."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defvar ispell-tib-ref-beginning "[[<]\\."
"Regexp matching the beginning of a Tib reference.")
@@ -189,14 +183,12 @@ That includes the [.5mm] type of number..."
(defcustom ispell-keep-choices-win t
"If non-nil, keep the `*Choices*' window for the entire spelling session.
This minimizes redisplay thrashing."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-choices-win-default-height 2
"The default size of the `*Choices*' window, including the mode line.
Must be greater than 1."
- :type 'integer
- :group 'ispell)
+ :type 'integer)
(defcustom ispell-program-name
(or (executable-find "aspell")
@@ -211,8 +203,7 @@ Must be greater than 1."
:set (lambda (symbol value)
(set-default symbol value)
(if (featurep 'ispell)
- (ispell-set-spellchecker-params)))
- :group 'ispell)
+ (ispell-set-spellchecker-params))))
(defcustom ispell-alternate-dictionary
(cond ((file-readable-p "/usr/dict/web2") "/usr/dict/web2")
@@ -224,14 +215,12 @@ Must be greater than 1."
"/usr/share/lib/dict/words")
((file-readable-p "/sys/dict") "/sys/dict"))
"Alternate plain word-list dictionary for spelling help."
- :type '(choice file (const :tag "None" nil))
- :group 'ispell)
+ :type '(choice file (const :tag "None" nil)))
(defcustom ispell-complete-word-dict nil
"Plain word-list dictionary used for word completion if
different from `ispell-alternate-dictionary'."
- :type '(choice file (const :tag "None" nil))
- :group 'ispell)
+ :type '(choice file (const :tag "None" nil)))
(defcustom ispell-message-dictionary-alist nil
"List used by `ispell-message' to select a new dictionary.
@@ -241,29 +230,25 @@ DICTIONARY if `ispell-local-dictionary' is not buffer-local.
E.g. you may use the following value:
((\"^Newsgroups:[ \\t]*de\\\\.\" . \"deutsch8\")
(\"^To:[^\\n,]+\\\\.de[ \\t\\n,>]\" . \"deutsch8\"))"
- :type '(repeat (cons regexp string))
- :group 'ispell)
+ :type '(repeat (cons regexp string)))
(defcustom ispell-message-fcc-skip 50000
"Query before saving Fcc message copy if attachment larger than this value.
Always stores Fcc copy of message when nil."
- :type '(choice integer (const :tag "off" nil))
- :group 'ispell)
+ :type '(choice integer (const :tag "off" nil)))
(defcustom ispell-grep-command
"grep"
"Name of the grep command for search processes."
- :type 'string
- :group 'ispell)
+ :type 'string)
(defcustom ispell-grep-options
"-Ei"
"String of options to use when running the program in `ispell-grep-command'.
Should probably be \"-Ei\"."
- :type 'string
- :group 'ispell)
+ :type 'string)
(defcustom ispell-look-command
(cond ((file-exists-p "/bin/look") "/bin/look")
@@ -272,36 +257,30 @@ Should probably be \"-Ei\"."
(t "look"))
"Name of the look command for search processes.
This must be an absolute file name."
- :type 'file
- :group 'ispell)
+ :type 'file)
(defcustom ispell-look-p (file-exists-p ispell-look-command)
"Non-nil means use `look' rather than `grep'.
Default is based on whether `look' seems to be available."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-have-new-look nil
"Non-nil means use the `-r' option (regexp) when running `look'."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-look-options (if ispell-have-new-look "-dfr" "-df")
"String of command options for `ispell-look-command'."
- :type 'string
- :group 'ispell)
+ :type 'string)
(defcustom ispell-use-ptys-p nil
"When non-nil, Emacs uses ptys to communicate with Ispell.
When nil, Emacs uses pipes."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-following-word nil
"Non-nil means `ispell-word' checks the word around or after point.
Otherwise `ispell-word' checks the preceding word."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defcustom ispell-help-in-bufferp nil
"Non-nil means display interactive keymap help in a buffer.
@@ -312,21 +291,18 @@ The following values are supported:
for a couple of seconds.
electric Pop up a new buffer and display a long help message there.
User can browse and then exit the help mode."
- :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t))
- :group 'ispell)
+ :type '(choice (const electric) (const :tag "off" nil) (const :tag "on" t)))
(defcustom ispell-quietly nil
"Non-nil means suppress messages in `ispell-word'."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defvaralias 'ispell-format-word 'ispell-format-word-function)
(defcustom ispell-format-word-function (function upcase)
"Formatting function for displaying word being spell checked.
The function must take one string argument and return a string."
- :type 'function
- :group 'ispell)
+ :type 'function)
;; FIXME framepop.el last updated c 2003 (?),
;; use posframe.
@@ -335,21 +311,18 @@ The function must take one string argument and return a string."
You can set this variable to dynamically use framepop if you are in a
window system by evaluating the following on startup to set this variable:
(and (display-graphic-p) (require \\='framepop nil t))"
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
;;;###autoload
(defcustom ispell-personal-dictionary nil
"File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary for your spelling checker is used."
:type '(choice file
- (const :tag "default" nil))
- :group 'ispell)
+ (const :tag "default" nil)))
(defcustom ispell-silently-savep nil
"When non-nil, save personal dictionary without asking for confirmation."
- :type 'boolean
- :group 'ispell)
+ :type 'boolean)
(defvar-local ispell-local-dictionary-overridden nil
"Non-nil means the user has explicitly set this buffer's Ispell dictionary.")
@@ -366,8 +339,7 @@ calling \\[ispell-change-dictionary] with that value. This variable
is automatically set when defined in the file with either
`ispell-dictionary-keyword' or the Local Variable syntax."
:type '(choice string
- (const :tag "default" nil))
- :group 'ispell)
+ (const :tag "default" nil)))
;;;###autoload
(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
@@ -376,16 +348,14 @@ is automatically set when defined in the file with either
(defcustom ispell-dictionary nil
"Default dictionary to use if `ispell-local-dictionary' is nil."
:type '(choice string
- (const :tag "default" nil))
- :group 'ispell)
+ (const :tag "default" nil)))
(defcustom ispell-extra-args nil
"If non-nil, a list of extra switches to pass to the Ispell program.
For example, (\"-W\" \"3\") to cause it to accept all 1-3 character
words as correct. See also `ispell-dictionary-alist', which may be used
for language-specific arguments."
- :type '(repeat string)
- :group 'ispell)
+ :type '(repeat string))
@@ -400,8 +370,7 @@ such as \"&amp;\". See `ispell-html-skip-alists' for more details.
This variable affects spell-checking of HTML, XML, and SGML files."
:type '(choice (const :tag "always" t) (const :tag "never" nil)
- (const :tag "use-mode-name" use-mode-name))
- :group 'ispell)
+ (const :tag "use-mode-name" use-mode-name)))
(make-variable-buffer-local 'ispell-skip-html)
@@ -427,8 +396,7 @@ re-start Emacs."
(const "~nroff") (const "~list")
(const "~latin1") (const "~latin3")
(const :tag "default" nil))
- (coding-system :tag "Coding System")))
- :group 'ispell)
+ (coding-system :tag "Coding System"))))
(defvar ispell-dictionary-base-alist
@@ -681,11 +649,7 @@ Otherwise returns the library directory name, if that is defined."
result libvar status ispell-program-version)
(with-temp-buffer
- (setq status (ispell-call-process
- ispell-program-name nil t nil
- (let ((case-fold-search
- (memq system-type '(ms-dos windows-nt))))
- "-vv")))
+ (setq status (ispell-call-process ispell-program-name nil t nil "-vv"))
(goto-char (point-min))
(if interactivep
;; Report version information of ispell
@@ -1108,7 +1072,7 @@ dictionary from that list was found."
(split-string
(with-temp-buffer
(ispell-call-process ispell-program-name
- null-device
+ nil
t
nil
"-D"
@@ -1239,22 +1203,11 @@ If LANG is omitted, get the extra word characters for the default language."
(split-string
(ispell--call-enchant-lsmod "-list-dicts") " ([^)]+)\n" t))
(found
- (mapcar #'(lambda (lang)
- `(,lang "[[:alpha:]]" "[^[:alpha:]]"
- ,(ispell--get-extra-word-characters lang) t nil nil utf-8))
+ (mapcar (lambda (lang)
+ `(,lang "[[:alpha:]]" "[^[:alpha:]]"
+ ,(ispell--get-extra-word-characters lang) 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))))
+ (setq ispell-enchant-dictionary-alist found)))
;; Set params according to the selected spellchecker
@@ -1277,7 +1230,7 @@ aspell is used along with Emacs).")
(defun ispell-set-spellchecker-params ()
"Initialize some spellchecker parameters when changed or first used."
- (unless (eq ispell-last-program-name ispell-program-name)
+ (unless (equal ispell-last-program-name ispell-program-name)
(ispell-kill-ispell t)
(if (and (condition-case ()
(progn
@@ -1797,10 +1750,12 @@ You can set this variable in hooks in your init file -- eg:
If asynchronous subprocesses are not supported, call function `ispell-filter'
and pass it the output of the last Ispell invocation."
(if ispell-async-processp
- (let ((timeout (if timeout-msecs
- (+ (or timeout-secs 0) (/ timeout-msecs 1000.0))
- timeout-secs)))
- (accept-process-output ispell-process timeout))
+ (if (process-live-p ispell-process)
+ (let ((timeout (if timeout-msecs
+ (+ (or timeout-secs 0) (/ timeout-msecs 1000.0))
+ timeout-secs)))
+ (accept-process-output ispell-process timeout))
+ (error "No Ispell process to read output from!"))
(if (null ispell-process)
(error "No Ispell process to read output from!")
(let ((buf ispell-output-buffer)
@@ -1825,7 +1780,8 @@ Only works for Aspell and Enchant."
(defun ispell-send-string (string)
"Send the string STRING to the Ispell process."
(if ispell-async-processp
- (process-send-string ispell-process string)
+ (if (process-live-p ispell-process)
+ (process-send-string ispell-process string))
;; Asynchronous subprocesses aren't supported on this losing system.
;; We keep all the directives passed to Ispell during the entire
;; session in a buffer, and pass them anew each time we invoke
@@ -2541,7 +2497,7 @@ if defined."
"Customize `ispell-alternate-dictionary' to set yours.")))
(let* ((process-connection-type ispell-use-ptys-p)
- (wild-p (string-match "\\*" word))
+ (wild-p (string-search "*" word))
(look-p (and ispell-look-p ; Only use look for an exact match.
(or ispell-have-new-look (not wild-p))))
(prog (if look-p ispell-look-command ispell-grep-command))
@@ -2604,7 +2560,7 @@ if defined."
(continue t)
end)
(while continue
- (setq end (string-match "\n" output start)) ; get text up to the newline.
+ (setq end (string-search "\n" output start)) ; get text up to the newline.
;; If we get out of sync and ispell-filter-continue is asserted when we
;; are not continuing, treat the next item as a separate list. When
;; ispell-filter-continue is asserted, ispell-filter *should* always be a
@@ -2776,11 +2732,11 @@ Optional third arg SHIFT is an offset to apply based on previous corrections."
(if (eq type ?#)
(setq count 0) ; no misses for type #
(setq count (string-to-number output) ; get number of misses.
- output (substring output (1+ (string-match " " output 1)))))
+ output (substring output (1+ (string-search " " output 1)))))
(setq offset (string-to-number output))
(setq output (if (eq type ?#) ; No miss or guess list.
nil
- (substring output (1+ (string-match " " output 1)))))
+ (substring output (1+ (string-search " " output 1)))))
(while output
(let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess.
(setq cur-count (1+ cur-count))
@@ -3776,7 +3732,7 @@ SPC.
For spell-checking \"on the fly\", not just after typing SPC or
RET, use `flyspell-mode'."
- nil " Spell" ispell-minor-keymap)
+ :lighter " Spell" :keymap ispell-minor-keymap)
(defun ispell-minor-check ()
"Check previous word, then continue with the normal binding of this key.
@@ -4121,7 +4077,7 @@ Includes LaTeX/Nroff modes and extended character mode."
(ispell-send-string "+\n~tex\n"))
((string-match "nroff-mode" string)
(ispell-send-string "-\n~nroff\n"))
- ((string-match "~" string) ; Set extended character mode.
+ ((string-search "~" string) ; Set extended character mode.
(ispell-send-string (concat string "\n")))
(t (message "Invalid Ispell Parsing argument!")
(sit-for 2))))))))
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index 24ccb3ce980..d374cab27a4 100644
--- a/lisp/textmodes/less-css-mode.el
+++ b/lisp/textmodes/less-css-mode.el
@@ -91,7 +91,7 @@ executable, e.g.: \"~/.gem/ruby/1.8/bin/lessc\"."
"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)
+(put 'less-css-compile-at-save 'safe-local-variable #'booleanp)
(defcustom less-css-lessc-options '("--no-color")
"Command line options for Less executable.
@@ -107,7 +107,7 @@ using `expand-file-name', so both relative and absolute paths
will work as expected."
:type '(choice (const :tag "Same as Less file" nil) directory))
;;;###autoload
-(put 'less-css-output-directory 'safe-local-variable 'stringp)
+(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.
@@ -133,7 +133,7 @@ the path is relative, it will be relative to the current
directory by default."
:type '(choice (const nil) file))
;;;###autoload
-(put 'less-css-input-file-name 'safe-local-variable 'stringp)
+(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
@@ -211,7 +211,7 @@ directory by default."
(defvar less-css-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'less-css-compile)
+ (define-key map "\C-c\C-c" #'less-css-compile)
map))
;;;###autoload (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode))
@@ -226,7 +226,7 @@ Special commands:
(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))
+ (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 e48649bae37..13367a09bcf 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -1,4 +1,4 @@
-;;; makeinfo.el --- run makeinfo conveniently
+;;; makeinfo.el --- run makeinfo conveniently -*- lexical-binding: t; -*-
;; Copyright (C) 1991, 1993, 2001-2021 Free Software Foundation, Inc.
@@ -59,16 +59,14 @@
(defcustom makeinfo-run-command "makeinfo"
"Command used to run `makeinfo' subjob.
The name of the file is appended to this string, separated by a space."
- :type 'string
- :group 'makeinfo)
+ :type 'string)
(defcustom makeinfo-options "--fill-column=70"
"String containing options for running `makeinfo'.
Do not include `--footnote-style' or `--paragraph-indent';
the proper way to specify those is with the Texinfo commands
`@footnotestyle' and `@paragraphindent'."
- :type 'string
- :group 'makeinfo)
+ :type 'string)
(require 'texinfo)
@@ -87,6 +85,7 @@ the proper way to specify those is with the Texinfo commands
;;; The `makeinfo' function definitions
+;;;###autoload
(defun makeinfo-region (region-beginning region-end)
"Make Info file from region of current Texinfo file, and switch to it.
@@ -95,7 +94,7 @@ apply to a temporary file, not the original; use the `makeinfo-buffer'
command to gain use of `next-error'."
(interactive "r")
- (let (filename-or-header
+ (let (;; filename-or-header
filename-or-header-beginning
filename-or-header-end)
;; Cannot use `let' for makeinfo-temp-file or
@@ -175,7 +174,7 @@ command to gain use of `next-error'."
t
'makeinfo-compilation-sentinel-region)))))))
-(defun makeinfo-next-error (arg reset)
+(defun makeinfo-next-error (_arg _reset)
"This function is used to disable `next-error' if the user has
used `makeinfo-region'. Since the compilation process is used on
a temporary file in that case, calling `next-error' would give
@@ -224,6 +223,7 @@ nonsensical results."
(match-string 1)
"Top")))
+;;;###autoload
(defun makeinfo-buffer ()
"Make Info file from current buffer.
@@ -268,6 +268,7 @@ Use the \\[next-error] command to move to the next error
(Info-revert-find-node
makeinfo-output-file-name makeinfo-output-node-name))))
+;;;###autoload
(defun makeinfo-recenter-compilation-buffer (linenum)
"Redisplay `*compilation*' buffer so most recent output can be seen.
The last line of the buffer is displayed on
@@ -286,7 +287,10 @@ line LINE of the window, or centered if LINE is nil."
(pop-to-buffer old-buffer)
)))
-;;; Place `provide' at end of file.
(provide 'makeinfo)
+;; Local Variables:
+;; generated-autoload-file: "texinfo-loaddefs.el"
+;; End:
+
;;; makeinfo.el ends here
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index 32542d0400f..25905385685 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -313,7 +313,7 @@ Prefix arg specifies how many times to move (default 1)."
(interactive "P")
(pcase (get-text-property (point) 'mhtml-submode)
('nil (sgml-skip-tag-forward arg))
- (submode (forward-sexp arg))))
+ (_submode (forward-sexp arg))))
;;;###autoload
(define-derived-mode mhtml-mode html-mode
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index e7d852be3c8..94519c3420b 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -46,38 +46,34 @@
:type 'boolean)
(defvar nroff-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
- (define-key map "\t" 'tab-to-tab-stop)
- (define-key map "\e?" 'nroff-count-text-lines)
- (define-key map "\n" 'nroff-electric-newline)
- (define-key map "\en" 'nroff-forward-text-line)
- (define-key map "\ep" 'nroff-backward-text-line)
- (define-key map "\C-c\C-c" 'nroff-view)
- (define-key map [menu-bar nroff-mode] (cons "Nroff" menu-map))
- (define-key menu-map [nn]
- '(menu-item "Newline" nroff-electric-newline
- :help "Insert newline for nroff mode; special if nroff-electric mode"))
- (define-key menu-map [nc]
- '(menu-item "Count text lines" nroff-count-text-lines
- :help "Count lines in region, except for nroff request lines."))
- (define-key menu-map [nf]
- '(menu-item "Forward text line" nroff-forward-text-line
- :help "Go forward one nroff text line, skipping lines of nroff requests"))
- (define-key menu-map [nb]
- '(menu-item "Backward text line" nroff-backward-text-line
- :help "Go backward one nroff text line, skipping lines of nroff requests"))
- (define-key menu-map [ne]
- '(menu-item "Electric newline mode"
- nroff-electric-mode
- :help "Auto insert closing requests if necessary"
- :button (:toggle . nroff-electric-mode)))
- (define-key menu-map [npm]
- '(menu-item "Preview as man page" nroff-view
- :help "Run man on this file."))
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\t" #'tab-to-tab-stop)
+ (define-key map "\e?" #'nroff-count-text-lines)
+ (define-key map "\n" #'nroff-electric-newline)
+ (define-key map "\en" #'nroff-forward-text-line)
+ (define-key map "\ep" #'nroff-backward-text-line)
+ (define-key map "\C-c\C-c" #'nroff-view)
map)
"Major mode keymap for `nroff-mode'.")
+(easy-menu-define nroff-mode-menu nroff-mode-map
+ "Menu for `nroff-mode'."
+ '("Nroff"
+ ["Preview as man page" nroff-view
+ :help "Run man on this file."]
+ ["Electric newline mode" nroff-electric-mode
+ :help "Auto insert closing requests if necessary"
+ :style toggle
+ :selected nroff-electric-mode]
+ ["Backward text line" nroff-backward-text-line
+ :help "Go backward one nroff text line, skipping lines of nroff requests"]
+ ["Forward text line" nroff-forward-text-line
+ :help "Go forward one nroff text line, skipping lines of nroff requests"]
+ ["Count text lines" nroff-count-text-lines
+ :help "Count lines in region, except for nroff request lines."]
+ ["Newline" nroff-electric-newline
+ :help "Insert newline for nroff mode; special if nroff-electric mode"]))
+
(defvar nroff-mode-syntax-table
(let ((st (copy-syntax-table text-mode-syntax-table)))
;; " isn't given string quote syntax in text-mode but it
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index c3e1fb14bc3..87c91e8f1b7 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -293,7 +293,7 @@ Used by `pages-directory-for-addresses' function."
;; FIXME: Merely loading a package shouldn't have this kind of side-effects!
(global-unset-key "\C-x\C-p")
(define-key ctl-x-map "\C-p" #'pages-ctl-x-ctl-p-prefix)
-(define-obsolete-function-alias 'ctl-x-ctl-p-prefix 'pages-ctl-x-ctl-p-prefix "27.1")
+(define-obsolete-function-alias 'ctl-x-ctl-p-prefix #'pages-ctl-x-ctl-p-prefix "27.1")
(defalias 'pages-ctl-x-ctl-p-prefix pages--ctl-x-ctl-p-map)
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index e1d7fb7431c..b86a2f149de 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -170,8 +170,6 @@ point, respectively."
(interactive)
(apply #'message (cons "Page %d, line %d" (page--what-page))))
-
-;;; Place `provide' at end of file.
(provide 'page)
;;; page.el ends here
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 96edfd6de36..59b15e82a81 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -96,9 +96,8 @@ lines that start paragraphs from lines that separate them.
If the variable `use-hard-newlines' is non-nil, then only lines following a
hard newline are considered to match."
- :group 'paragraphs
:type 'regexp)
-(put 'paragraph-start 'safe-local-variable 'stringp)
+(put 'paragraph-start 'safe-local-variable #'stringp)
;; paragraph-start requires a hard newline, but paragraph-separate does not:
;; It is assumed that paragraph-separate is distinctive enough to be believed
@@ -114,9 +113,8 @@ This is matched against the text at the left margin, which is not necessarily
the beginning of the line, so it should not use \"^\" as an anchor. This
ensures that the paragraph functions will work equally within a region of
text indented by a margin setting."
- :group 'paragraphs
:type 'regexp)
-(put 'paragraph-separate 'safe-local-variable 'stringp)
+(put 'paragraph-separate 'safe-local-variable #'stringp)
(defcustom sentence-end-double-space t
"Non-nil means a single space does not end a sentence.
@@ -128,7 +126,7 @@ regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:type 'boolean
:group 'fill)
-(put 'sentence-end-double-space 'safe-local-variable 'booleanp)
+(put 'sentence-end-double-space 'safe-local-variable #'booleanp)
(defcustom sentence-end-without-period nil
"Non-nil means a sentence will end without a period.
@@ -140,7 +138,7 @@ regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:type 'boolean
:group 'fill)
-(put 'sentence-end-without-period 'safe-local-variable 'booleanp)
+(put 'sentence-end-without-period 'safe-local-variable #'booleanp)
(defcustom sentence-end-without-space
"。.?!"
@@ -149,9 +147,8 @@ regexp describing the end of a sentence, when the value of the variable
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
- :group 'paragraphs
:type 'string)
-(put 'sentence-end-without-space 'safe-local-variable 'stringp)
+(put 'sentence-end-without-space 'safe-local-variable #'stringp)
(defcustom sentence-end nil
"Regexp describing the end of a sentence.
@@ -161,16 +158,14 @@ All paragraph boundaries also end sentences, regardless.
The value nil means to use the default value defined by the
function `sentence-end'. You should always use this function
to obtain the value of this variable."
- :group 'paragraphs
:type '(choice regexp (const :tag "Use default value" nil)))
-(put 'sentence-end 'safe-local-variable 'string-or-null-p)
+(put 'sentence-end 'safe-local-variable #'string-or-null-p)
(defcustom sentence-end-base "[.?!…‽][]\"'”’)}»›]*"
"Regexp matching the basic end of a sentence, not including following space."
- :group 'paragraphs
:type 'regexp
:version "25.1")
-(put 'sentence-end-base 'safe-local-variable 'stringp)
+(put 'sentence-end-base 'safe-local-variable #'stringp)
(defun sentence-end ()
"Return the regexp describing the end of a sentence.
@@ -197,20 +192,16 @@ in between. See Info node `(elisp)Standard Regexps'."
(defcustom page-delimiter "^\014"
"Regexp describing line-beginnings that separate pages."
- :group 'paragraphs
:type 'regexp)
-(put 'page-delimiter 'safe-local-variable 'stringp)
+(put 'page-delimiter 'safe-local-variable #'stringp)
(defcustom paragraph-ignore-fill-prefix nil
"Non-nil means the paragraph commands are not affected by `fill-prefix'.
This is desirable in modes where blank lines are the paragraph delimiters."
- :group 'paragraphs
:type 'boolean)
-(put 'paragraph-ignore-fill-prefix 'safe-local-variable 'booleanp)
+(put 'paragraph-ignore-fill-prefix 'safe-local-variable #'booleanp)
;; Silence the compiler.
-(defvar multiple-lines)
-
(defun forward-paragraph (&optional arg)
"Move forward to end of paragraph.
With argument ARG, do it ARG times;
@@ -269,13 +260,13 @@ Returns the count of paragraphs left to move."
;; Search back for line that starts or separates paragraphs.
(if (if fill-prefix-regexp
;; There is a fill prefix; it overrides parstart.
- (let (multiple-lines)
+ (let () ;; multiple-lines
(while (and (progn (beginning-of-line) (not (bobp)))
(progn (move-to-left-margin)
(not (looking-at parsep)))
(looking-at fill-prefix-regexp))
- (unless (= (point) start)
- (setq multiple-lines t))
+ ;; (unless (= (point) start)
+ ;; (setq multiple-lines t))
(forward-line -1))
(move-to-left-margin)
;; This deleted code caused a long hanging-indent line
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 3cb1043545a..1d5d1caeabc 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -37,28 +37,22 @@
(defcustom picture-rectangle-ctl ?+
"Character `picture-draw-rectangle' uses for top left corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-ctr ?+
"Character `picture-draw-rectangle' uses for top right corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-cbr ?+
"Character `picture-draw-rectangle' uses for bottom right corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-cbl ?+
"Character `picture-draw-rectangle' uses for bottom left corners."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-v ?|
"Character `picture-draw-rectangle' uses for vertical lines."
- :type 'character
- :group 'picture)
+ :type 'character)
(defcustom picture-rectangle-h ?-
"Character `picture-draw-rectangle' uses for horizontal lines."
- :type 'character
- :group 'picture)
+ :type 'character)
;; Picture Movement Commands
@@ -409,8 +403,7 @@ character `\\' in the set it must be preceded by itself: \"\\\\\".
The command \\[picture-tab-search] is defined to move beneath (or to) a
character belonging to this set independent of the tab stops list."
- :type 'string
- :group 'picture)
+ :type 'string)
(defun picture-set-tab-stops (&optional arg)
"Set value of `tab-stop-list' according to context of this line.
@@ -456,8 +449,8 @@ If no such character is found, move to beginning of line."
(progn
(beginning-of-line)
(skip-chars-backward
- (concat "^" (replace-regexp-in-string
- "\\\\" "\\\\" picture-tab-chars nil t))
+ (concat "^" (string-replace
+ "\\" "\\\\" picture-tab-chars))
(point-min))
(not (bobp))))
(move-to-column target))
@@ -682,8 +675,7 @@ Leaves the region surrounding the rectangle."
(defcustom picture-mode-hook nil
"If non-nil, its value is called on entry to Picture mode.
Picture mode is invoked by the command \\[picture-mode]."
- :type 'hook
- :group 'picture)
+ :type 'hook)
(defvar picture-mode-old-local-map)
(defvar picture-mode-old-mode-name)
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index bff57128c51..084b17c676b 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -1,4 +1,4 @@
-;;; refbib.el --- convert refer-style references to ones usable by Latex bib
+;;; refbib.el --- convert refer-style references to ones usable by Latex bib -*- lexical-binding: t; -*-
;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc.
@@ -65,8 +65,7 @@
(defcustom r2b-trace-on nil
"Non-nil means trace conversion."
- :type 'boolean
- :group 'refbib)
+ :type 'boolean)
(defcustom r2b-journal-abbrevs
'(
@@ -83,8 +82,7 @@ letter, even if it really doesn't.
\(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
\"Artificial Intelligence\", but would replace Ijcai81 with the
BibTeX macro \"ijcai7\"."
- :type '(repeat (list string string))
- :group 'refbib)
+ :type '(repeat (list string string)))
(defcustom r2b-booktitle-abbrevs
'(
@@ -101,8 +99,7 @@ should be listed as beginning with a capital letter, even if it doesn't.
\(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
\"Artificial Intelligence\", but would replace Ijcai81 with the
BibTeX macro \"ijcai7\"."
- :type '(repeat (list string string))
- :group 'refbib)
+ :type '(repeat (list string string)))
(defcustom r2b-proceedings-list
'()
@@ -119,8 +116,7 @@ a conference, and its expansion is the BibTeX macro \"ijcai7\". Then
expansion were \"Proceedings of the Seventh International Conference
on Artificial Intelligence\", then you would NOT need to include Ijcai81
in `r2b-proceedings-list' (although it wouldn't cause an error)."
- :type '(repeat (list string string))
- :group 'refbib)
+ :type '(repeat (list string string)))
(defvar r2b-additional-stop-words
"Some\\|What"
@@ -129,8 +125,7 @@ This is in addition to the `r2b-capitalize-title-stop-words'.")
(defcustom r2b-delimit-with-quote t
"If true, then use \" to delimit fields, otherwise use braces."
- :type 'boolean
- :group 'refbib)
+ :type 'boolean)
;**********************************************************
; Utility Functions
@@ -205,13 +200,11 @@ This is in addition to the `r2b-capitalize-title-stop-words'.")
(defcustom r2b-out-buf-name "*Out*"
"Name of buffer for output from refer-to-bibtex."
- :type 'string
- :group 'refbib)
+ :type 'string)
(defcustom r2b-log-name "*Log*"
"Name of buffer for logs errors from refer-to-bibtex."
- :type 'string
- :group 'refbib)
+ :type 'string)
(defvar r2b-in-buf nil)
(defvar r2b-out-buf nil)
@@ -418,7 +411,7 @@ title if CAPITALIZE is true. Returns value of VAR."
with a comma and newline; if ABBREVS list is given, then
try to replace the {DATA} with an abbreviation."
(if data
- (let (match nodelim multi-line index)
+ (let (match nodelim index) ;; multi-line
(cond
((and abbrevs (setq match (assoc data abbrevs)))
(if (null (cdr match))
@@ -514,7 +507,7 @@ but not a publisher."
(defun r2b-barf-output ()
"Generate bibtex based on global variables."
- (let ((standard-output r2b-out-buf) (case-fold-search t) match)
+ (let ((standard-output r2b-out-buf) (case-fold-search t)) ;; match
(r2b-trace "...barfing")
(sit-for 0)
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index ae1f7781686..e710180d5f5 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -1,4 +1,4 @@
-;;; refer.el --- look up references in bibliography files
+;;; refer.el --- look up references in bibliography files -*- lexical-binding: t; -*-
;; Copyright (C) 1992, 1996, 2001-2021 Free Software Foundation, Inc.
@@ -91,8 +91,7 @@ the default search path. Since Refer does not know that default path,
it cannot search it. Include that path explicitly in your BIBINPUTS
environment if you really want it searched (which is not likely to
happen anyway)."
- :type '(choice (repeat directory) (const bibinputs) (const texinputs))
- :group 'refer)
+ :type '(choice (repeat directory) (const bibinputs) (const texinputs)))
(defcustom refer-bib-files 'dir
"List of \\.bib files to search for references,
@@ -110,16 +109,14 @@ If `refer-bib-files' is nil, auto or dir, it is setq'd to the appropriate
list of files when it is first used if `refer-cache-bib-files' is t. If
`refer-cache-bib-files' is nil, the list of \\.bib files to use is re-read
each time it is needed."
- :type '(choice (repeat file) (const nil) (const auto) (const dir))
- :group 'refer)
+ :type '(choice (repeat file) (const nil) (const auto) (const dir)))
(defcustom refer-cache-bib-files t
"Variable determining whether the value of `refer-bib-files' should be cached.
If t, initialize the value of refer-bib-files the first time it is used. If
nil, re-read the list of \\.bib files depending on the value of `refer-bib-files'
each time it is needed."
- :type 'boolean
- :group 'refer)
+ :type 'boolean)
(defcustom refer-bib-files-regexp "\\\\bibliography"
"Regexp matching a bibliography file declaration.
@@ -131,8 +128,7 @@ command is expected to specify a file name, or a list of comma-separated file
names, within curly braces.
If a specified file doesn't exist and has no extension, a \\.bib extension
is automatically tried."
- :type 'regexp
- :group 'refer)
+ :type 'regexp)
(make-variable-buffer-local 'refer-bib-files)
(make-variable-buffer-local 'refer-cache-bib-files)
@@ -180,7 +176,7 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(defun refer-find-entry-internal (keywords continue)
(let ((keywords-list (refer-convert-string-to-list-of-strings keywords))
- (old-buffer (current-buffer))
+ ;; (old-buffer (current-buffer))
(old-window (selected-window))
(new-window (selected-window))
(files (if continue
@@ -188,7 +184,7 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(setq refer-saved-pos nil)
(refer-get-bib-files)))
(n 0)
- (found nil)
+ ;; (found nil)
(file nil))
;; find window in which to display bibliography file.
;; if a bibliography file is already displayed in a window, use
@@ -249,10 +245,10 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(forward-paragraph 1)
(setq end (point))
(setq found
- (refer-every (lambda (keyword)
- (goto-char begin)
- (re-search-forward keyword end t))
- keywords-list))
+ (seq-every-p (lambda (keyword)
+ (goto-char begin)
+ (re-search-forward keyword end t))
+ keywords-list))
(if (not found)
(progn
(setq begin end)
@@ -264,12 +260,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(progn (message "Scanning %s... not found" file)
nil))))
-(defun refer-every (pred l)
- (cond ((null l) nil)
- ((funcall pred (car l))
- (or (null (cdr l))
- (refer-every pred (cdr l))))))
-
(defun refer-convert-string-to-list-of-strings (s)
(let ((current (current-buffer))
(temp-buffer (get-buffer-create "*refer-temp*")))
@@ -395,4 +385,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(setq refer-bib-files files))
files))
+(define-obsolete-function-alias 'refer-every #'seq-every-p "28.1")
+
;;; refer.el ends here
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index 8f4f3c5a231..0a0e4cc444c 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -1,4 +1,4 @@
-;;; refill.el --- `auto-fill' by refilling paragraphs on changes
+;;; refill.el --- `auto-fill' by refilling paragraphs on changes -*- lexical-binding: t -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -83,16 +83,11 @@
;;; Code:
-;; Unused.
-;;; (defgroup refill nil
-;;; "Refilling paragraphs on changes."
-;;; :group 'fill)
-
(defvar-local refill-ignorable-overlay nil
"Portion of the most recently filled paragraph not needing filling.
This is used to optimize refilling.")
-(defun refill-adjust-ignorable-overlay (overlay afterp beg end &optional len)
+(defun refill-adjust-ignorable-overlay (overlay afterp beg _end &optional _len)
"Adjust OVERLAY to not include the about-to-be-modified region."
(when (not afterp)
(save-excursion
@@ -157,7 +152,7 @@ ensures refilling is only done once per command that causes a change,
regardless of the number of after-change calls from commands doing
complex processing.")
-(defun refill-after-change-function (beg end len)
+(defun refill-after-change-function (_beg end _len)
"Function for `after-change-functions' which just sets `refill-doit'."
(unless undo-in-progress
(setq refill-doit end)))
@@ -232,9 +227,9 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead."
(kill-local-variable 'refill-saved-state))
(if refill-mode
(progn
- (add-hook 'after-change-functions 'refill-after-change-function nil t)
- (add-hook 'post-command-hook 'refill-post-command-function nil t)
- (add-hook 'pre-command-hook 'refill-pre-command-function nil t)
+ (add-hook 'after-change-functions #'refill-after-change-function nil t)
+ (add-hook 'post-command-hook #'refill-post-command-function nil t)
+ (add-hook 'pre-command-hook #'refill-pre-command-function nil t)
(setq-local refill-saved-state
(mapcar (lambda (s) (cons s (symbol-value s)))
'(fill-paragraph-function auto-fill-function)))
@@ -249,8 +244,8 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead."
(overlay-put refill-ignorable-overlay 'insert-behind-hooks
'(refill-adjust-ignorable-overlay))
(auto-fill-mode 0))
- (remove-hook 'after-change-functions 'refill-after-change-function t)
- (remove-hook 'post-command-hook 'refill-post-command-function t)
+ (remove-hook 'after-change-functions #'refill-after-change-function t)
+ (remove-hook 'post-command-hook #'refill-post-command-function t)
(kill-local-variable 'backward-delete-char-untabify-method)))
(provide 'refill)
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index ae3faec4fdc..977da700fd0 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -1,4 +1,4 @@
-;;; reftex-auc.el --- RefTeX's interface to AUCTeX
+;;; reftex-auc.el --- RefTeX's interface to AUCTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -32,11 +32,12 @@
(optional prompt default &optional complete))
(declare-function TeX-argument-insert "ext:tex"
(name optional &optional prefix))
-(declare-function LaTeX-add-labels "ext:tex" (&rest entries) t)
-(declare-function LaTeX-add-index-entries "ext:tex" (&rest entries) t)
-(declare-function LaTeX-bibitem-list "ext:tex" () t)
-(declare-function LaTeX-index-entry-list "ext:tex" () t)
-(declare-function LaTeX-label-list "ext:tex" () t)
+(declare-function LaTeX-add-labels "ext:latex" (&rest labels) t)
+(declare-function LaTeX-add-index-entries "ext:latex" (&rest index-entries) t)
+(declare-function LaTeX-add-bibitems "ext:latex" (&rest bibitems) t)
+(declare-function LaTeX-bibitem-list "ext:latex" () t)
+(declare-function LaTeX-index-entry-list "ext:latex" () t)
+(declare-function LaTeX-label-list "ext:latex" () t)
(declare-function multi-prompt "ext:multi-prompt"
(separator unique prompt table &optional
mp-predicate require-match initial history))
@@ -82,13 +83,12 @@ What is being used depends upon `reftex-plug-into-AUCTeX'."
(if prompt prompt "Add key")
" (default none): "))
(setq items (multi-prompt "," t prompt (LaTeX-bibitem-list)))))
- (apply 'LaTeX-add-bibitems items)
- (TeX-argument-insert (mapconcat 'identity items reftex-cite-key-separator)
+ (apply #'LaTeX-add-bibitems items)
+ (TeX-argument-insert (mapconcat #'identity items reftex-cite-key-separator)
optional)))
-
;;;###autoload
-(defun reftex-arg-index-tag (optional &optional prompt &rest args)
+(defun reftex-arg-index-tag (optional &optional prompt &rest _args)
"Prompt for an index tag with completion.
This is the name of an index, not the entry."
(let (tag taglist)
@@ -102,13 +102,13 @@ This is the name of an index, not the entry."
(setq taglist
(cdr (assoc 'index-tags
(symbol-value reftex-docstruct-symbol)))
- tag (completing-read prompt (mapcar 'list taglist))))
+ tag (completing-read prompt (mapcar #'list taglist))))
;; Just ask like AUCTeX does.
(setq tag (read-string prompt)))
(TeX-argument-insert tag optional)))
;;;###autoload
-(defun reftex-arg-index (optional &optional prompt &rest args)
+(defun reftex-arg-index (optional &optional prompt &rest _args)
"Prompt for an index entry completing with known entries.
Completion is specific for just one index, if the macro or a tag
argument identify one of multiple indices."
@@ -149,23 +149,27 @@ argument identify one of multiple indices."
;; `reftex-plug-into-AUCTeX'.
(if (reftex-plug-flag 0)
- (setq LaTeX-label-function 'reftex-label)
- (setq LaTeX-label-function nil))
-
- (and (or (reftex-plug-flag 1) (reftex-plug-flag 2))
- (fboundp 'TeX-arg-label)
- (fset 'TeX-arg-label 'reftex-arg-label))
-
- (and (reftex-plug-flag 3)
- (fboundp 'TeX-arg-cite)
- (fset 'TeX-arg-cite 'reftex-arg-cite))
-
- (and (reftex-plug-flag 4)
- (fboundp 'TeX-arg-index-tag)
- (fset 'TeX-arg-index-tag 'reftex-arg-index-tag))
- (and (reftex-plug-flag 4)
- (fboundp 'TeX-arg-index)
- (fset 'TeX-arg-index 'reftex-arg-index)))
+ (if (bound-and-true-p LaTeX-label-function)
+ (add-function :override LaTeX-label-function #'reftex-label)
+ (setq LaTeX-label-function #'reftex-label))
+ (if (eq #'reftex-label (bound-and-true-p LaTeX-label-function))
+ (setq LaTeX-label-function nil)
+ (remove-function LaTeX-label-function #'reftex-label)))
+
+ (if (or (reftex-plug-flag 1) (reftex-plug-flag 2))
+ (advice-add 'TeX-arg-label :override #'reftex-arg-label)
+ (advice-remove 'TeX-arg-label #'reftex-arg-label))
+
+ (if (reftex-plug-flag 3)
+ (advice-add 'TeX-arg-cite :override #'reftex-arg-cite)
+ (advice-remove 'TeX-arg-cite #'reftex-arg-cite))
+
+ (if (reftex-plug-flag 4)
+ (advice-add 'TeX-arg-index-tag :override #'reftex-arg-index-tag)
+ (advice-remove 'TeX-arg-index-tag #'reftex-arg-index-tag))
+ (if (reftex-plug-flag 4)
+ (advice-add 'TeX-arg-index :override #'reftex-arg-index)
+ (advice-remove 'TeX-arg-index #'reftex-arg-index)))
;;;###autoload
(defun reftex-toggle-plug-into-AUCTeX ()
@@ -205,7 +209,7 @@ the label information is recompiled on next use."
(when changed
(put reftex-docstruct-symbol 'reftex-label-alist-style list)))))
;;;###autoload
-(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments)
+(defalias 'reftex-add-to-label-alist #'reftex-add-label-environments)
;;;###autoload
(defun reftex-add-section-levels (entry-list)
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 5579e401790..895064b82f3 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1,4 +1,4 @@
-;;; reftex-cite.el --- creating citations with RefTeX
+;;; reftex-cite.el --- creating citations with RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -310,11 +310,11 @@ Return list with entries."
;; Sorting
(cond
((eq 'author reftex-sort-bibtex-matches)
- (sort found-list 'reftex-bib-sort-author))
+ (sort found-list #'reftex-bib-sort-author))
((eq 'year reftex-sort-bibtex-matches)
- (sort found-list 'reftex-bib-sort-year))
+ (sort found-list #'reftex-bib-sort-year))
((eq 'reverse-year reftex-sort-bibtex-matches)
- (sort found-list 'reftex-bib-sort-year-reverse))
+ (sort found-list #'reftex-bib-sort-year-reverse))
(t found-list))))
(defun reftex-bib-sort-author (e1 e2)
@@ -390,7 +390,7 @@ The environment should be located in FILES."
(when (and start end)
(setq entries
(append entries
- (mapcar 'reftex-parse-bibitem
+ (mapcar #'reftex-parse-bibitem
(delete ""
(split-string
(buffer-substring-no-properties
@@ -533,7 +533,7 @@ If FORMAT is non-nil `format' entry accordingly."
"Format a BibTeX ENTRY so that it is nice to look at."
(let*
((auth-list (reftex-get-bib-names "author" entry))
- (authors (mapconcat 'identity auth-list ", "))
+ (authors (mapconcat #'identity auth-list ", "))
(year (reftex-get-bib-field "year" entry))
(title (reftex-get-bib-field "title" entry))
(type (reftex-get-bib-field "&type" entry))
@@ -607,7 +607,7 @@ If FORMAT is non-nil `format' entry accordingly."
(push (substring text 0 (+ 60 (match-beginning 0))) lines)
(setq text (substring text (+ 61 (match-beginning 0)))))
(push text lines)
- (setq text (mapconcat 'identity (nreverse lines) "\n "))
+ (setq text (mapconcat #'identity (nreverse lines) "\n "))
(when (reftex-use-fonts)
(put-text-property 0 (length text) 'face reftex-bib-author-face text))
@@ -676,7 +676,7 @@ While entering the regexp, completion on knows citation keys is possible.
;; All keys go into a single command - we need to trick a little
;; FIXME: Unfortunately, this means that commenting does not work right.
(pop selected-entries)
- (let ((concat-keys (mapconcat 'car selected-entries
+ (let ((concat-keys (mapconcat #'car selected-entries
reftex-cite-key-separator)))
(setq insert-entries
(list (list concat-keys (cons "&key" concat-keys))))))
@@ -718,7 +718,7 @@ While entering the regexp, completion on knows citation keys is possible.
(insert string))
;; Reposition cursor?
- (when (string-match "\\?" string)
+ (when (string-search "?" string)
(search-backward "?")
(delete-char 1))
@@ -726,7 +726,7 @@ While entering the regexp, completion on knows citation keys is possible.
(when (and reftex-mode
(fboundp 'LaTeX-add-bibitems)
reftex-plug-into-AUCTeX)
- (apply 'LaTeX-add-bibitems (mapcar 'car selected-entries)))
+ (apply #'LaTeX-add-bibitems (mapcar #'car selected-entries)))
;; Produce the cite-view strings
(when (and reftex-mode reftex-cache-cite-echo cite-view)
@@ -749,7 +749,7 @@ While entering the regexp, completion on knows citation keys is possible.
(forward-char 1)))
;; Return the citation key
- (mapcar 'car selected-entries)))
+ (mapcar #'car selected-entries)))
(defun reftex-figure-out-cite-format (arg &optional no-insert format-key)
"Check if there is already a cite command at point and change cite format
@@ -815,15 +815,16 @@ in order to only add another reference in the same cite command."
(reftex-citation nil ?t))
(defvar reftex-select-bib-map)
+(defvar reftex--found-list)
(defun reftex-offer-bib-menu ()
"Offer bib menu and return list of selected items."
(let ((bibtype (reftex-bib-or-thebib))
- found-list rtn key data selected-entries)
+ reftex--found-list rtn key data selected-entries)
(while
(not
(catch 'done
;; Scan bibtex files
- (setq found-list
+ (setq reftex--found-list
(cond
((eq bibtype 'bib)
; ((assq 'bib (symbol-value reftex-docstruct-symbol))
@@ -834,7 +835,7 @@ in order to only add another reference in the same cite command."
;; using thebibliography environment.
(reftex-extract-bib-entries-from-thebibliography
(reftex-uniquify
- (mapcar 'cdr
+ (mapcar #'cdr
(reftex-all-assq
'thebib (symbol-value reftex-docstruct-symbol))))))
(reftex-default-bibliography
@@ -842,7 +843,7 @@ in order to only add another reference in the same cite command."
(reftex-extract-bib-entries (reftex-default-bibliography)))
(t (error "No valid bibliography in this document, and no default available"))))
- (unless found-list
+ (unless reftex--found-list
(error "Sorry, no matches found"))
;; Remember where we came from
@@ -854,11 +855,11 @@ in order to only add another reference in the same cite command."
(delete-other-windows)
(reftex-kill-buffer "*RefTeX Select*")
(switch-to-buffer-other-window "*RefTeX Select*")
- (unless (eq major-mode 'reftex-select-bib-mode)
+ (unless (derived-mode-p 'reftex-select-bib-mode)
(reftex-select-bib-mode))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(erase-buffer)
- (reftex-insert-bib-matches found-list))
+ (reftex-insert-bib-matches reftex--found-list))
(setq buffer-read-only t)
(if (= 0 (buffer-size))
(error "No matches found"))
@@ -881,34 +882,36 @@ in order to only add another reference in the same cite command."
(throw 'done nil))
((eq key ?r)
;; Restrict with new regular expression
- (setq found-list (reftex-restrict-bib-matches found-list))
+ (setq reftex--found-list
+ (reftex-restrict-bib-matches reftex--found-list))
(let ((buffer-read-only nil))
(erase-buffer)
- (reftex-insert-bib-matches found-list))
+ (reftex-insert-bib-matches reftex--found-list))
(goto-char 1))
((eq key ?A)
;; Take all (marked)
(setq selected-entries
(if reftex-select-marked
- (mapcar 'car (nreverse reftex-select-marked))
- found-list))
+ (mapcar #'car (nreverse reftex-select-marked))
+ reftex--found-list))
(throw 'done t))
((eq key ?a)
;; Take all (marked), and push the symbol 'concat
(setq selected-entries
(cons 'concat
(if reftex-select-marked
- (mapcar 'car (nreverse reftex-select-marked))
- found-list)))
+ (mapcar #'car (nreverse reftex-select-marked))
+ reftex--found-list)))
(throw 'done t))
((eq key ?e)
;; Take all (marked), and push the symbol 'concat
- (reftex-extract-bib-file found-list reftex-select-marked)
+ (reftex-extract-bib-file reftex--found-list
+ reftex-select-marked)
(setq selected-entries "BibTeX database file created")
(throw 'done t))
((eq key ?E)
;; Take all (marked), and push the symbol 'concat
- (reftex-extract-bib-file found-list reftex-select-marked
+ (reftex-extract-bib-file reftex--found-list reftex-select-marked
'complement)
(setq selected-entries "BibTeX database file created")
(throw 'done t))
@@ -918,7 +921,7 @@ in order to only add another reference in the same cite command."
(setq selected-entries
(if reftex-select-marked
(cons 'concat
- (mapcar 'car (nreverse reftex-select-marked)))
+ (mapcar #'car (nreverse reftex-select-marked)))
(if data (list data) nil)))
(throw 'done t))
((stringp key)
@@ -971,7 +974,7 @@ in order to only add another reference in the same cite command."
nil)
(cdr (assoc "&entry" x))))
all)))
- (insert (mapconcat 'identity all "\n\n"))
+ (insert (mapconcat #'identity all "\n\n"))
(save-buffer)
(goto-char (point-min))))
@@ -1004,7 +1007,7 @@ in order to only add another reference in the same cite command."
last (nth (1- n) namelist))
(setcdr (nthcdr (- n 2) namelist) nil)
(concat
- (mapconcat 'identity namelist (nth 0 reftex-cite-punctuation))
+ (mapconcat #'identity namelist (nth 0 reftex-cite-punctuation))
(nth 1 reftex-cite-punctuation)
last)))))
@@ -1100,7 +1103,7 @@ in order to only add another reference in the same cite command."
(put reftex-docstruct-symbol 'modified t)))
string))
-(defun reftex-bibtex-selection-callback (data ignore no-revisit)
+(defun reftex-bibtex-selection-callback (data _ignore no-revisit)
"Callback function to be called from the BibTeX selection, in
order to display context. This function is relatively slow and not
recommended for follow mode. It works OK for individual lookups."
@@ -1119,7 +1122,7 @@ recommended for follow mode. It works OK for individual lookups."
; ((assq 'thebib (symbol-value reftex-docstruct-symbol))
(setq bibfile-list
(reftex-uniquify
- (mapcar 'cdr
+ (mapcar #'cdr
(reftex-all-assq
'thebib (symbol-value reftex-docstruct-symbol))))
item t))
@@ -1163,7 +1166,7 @@ recommended for follow mode. It works OK for individual lookups."
"Return a list of BibTeX @string references that appear as values in ALIST."
(reftex-remove-if (lambda (x) (string-match "^\\([\"{]\\|[0-9]+$\\)" x))
;; get list of values, discard keys
- (mapcar 'cdr
+ (mapcar #'cdr
;; remove &key and &type entries
(reftex-remove-if (lambda (pair)
(string-match "^&" (car pair)))
@@ -1186,7 +1189,7 @@ created files in the variables `reftex-create-bibtex-header' or
(interactive "FNew BibTeX file: ")
(let ((keys (reftex-all-used-citation-keys))
(files (reftex-get-bibfile-list))
- file key entries beg end entry string-keys string-entries)
+ key entries beg end entry string-keys string-entries)
(save-current-buffer
(dolist (file files)
(set-buffer (reftex-get-file-buffer-force file 'mark))
@@ -1252,9 +1255,9 @@ created files in the variables `reftex-create-bibtex-header' or
(error "Abort")))
(erase-buffer)
(if reftex-create-bibtex-header (insert reftex-create-bibtex-header "\n\n"))
- (insert (mapconcat 'identity (reverse string-entries) "\n\n"))
+ (insert (mapconcat #'identity (reverse string-entries) "\n\n"))
(if string-entries (insert "\n\n\n"))
- (insert (mapconcat 'identity (reverse entries) "\n\n"))
+ (insert (mapconcat #'identity (reverse entries) "\n\n"))
(if reftex-create-bibtex-footer (insert "\n\n" reftex-create-bibtex-footer))
(goto-char (point-min))
(save-buffer)
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index e517cea2669..a21dd3362b0 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -1,4 +1,4 @@
-;;; reftex-dcr.el --- viewing cross references and citations with RefTeX
+;;; reftex-dcr.el --- viewing cross references and citations with RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -132,7 +132,7 @@ to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'."
((eq bibtype 'thebib)
(setq item t
files (reftex-uniquify
- (mapcar 'cdr
+ (mapcar #'cdr
(reftex-all-assq
'thebib (symbol-value reftex-docstruct-symbol))))))
(reftex-default-bibliography
@@ -161,10 +161,10 @@ to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'."
(shrink-window (1- (- (window-height) size)))
(recenter 0))
;; Arrange restoration
- (add-hook 'pre-command-hook 'reftex-restore-window-conf))
+ (add-hook 'pre-command-hook #'reftex-restore-window-conf))
;; Normal display in other window
- (add-hook 'pre-command-hook 'reftex-highlight-shall-die)
+ (add-hook 'pre-command-hook #'reftex-highlight-shall-die)
(setq pop-win (selected-window))
(select-window win)
(goto-char pos)
@@ -212,13 +212,13 @@ to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'."
(error (set-window-configuration window-conf)
(message "ref: Label %s not found" label)
(error "ref: Label %s not found" label)))) ;; 2nd is line OK
- (add-hook 'pre-command-hook 'reftex-highlight-shall-die)
+ (add-hook 'pre-command-hook #'reftex-highlight-shall-die)
(when (eq how 'tmp-window)
;; Resize window and arrange restoration
(shrink-window (1- (- (window-height) 9)))
(recenter '(4))
- (add-hook 'pre-command-hook 'reftex-restore-window-conf))
+ (add-hook 'pre-command-hook #'reftex-restore-window-conf))
(setq pop-win (selected-window))
(select-window win)
(goto-char pos)
@@ -266,7 +266,7 @@ With argument, actually select the window showing the cross reference."
(defun reftex-restore-window-conf ()
(set-window-configuration (get 'reftex-auto-view-crossref 'last-window-conf))
(put 'reftex-auto-view-crossref 'last-window-conf nil)
- (remove-hook 'pre-command-hook 'reftex-restore-window-conf))
+ (remove-hook 'pre-command-hook #'reftex-restore-window-conf))
(defun reftex-echo-ref (label entry docstruct)
;; Display crossref info in echo area.
@@ -320,10 +320,6 @@ With argument, actually select the window showing the cross reference."
(with-current-buffer buf
(run-hooks 'reftex-display-copied-context-hook)))))
-(defvar reftex-use-itimer-in-xemacs nil
- "Non-nil means use the idle timers in XEmacs for crossref display.
-Currently, idle timer restart is broken and we use the post-command-hook.")
-
;;;###autoload
(defun reftex-toggle-auto-view-crossref ()
"Toggle the automatic display of crossref information in the echo area.
@@ -332,36 +328,16 @@ will display info in the echo area."
(interactive)
(if reftex-auto-view-crossref-timer
(progn
- (if (featurep 'xemacs)
- (if reftex-use-itimer-in-xemacs
- (delete-itimer reftex-auto-view-crossref-timer)
- (remove-hook 'post-command-hook 'reftex-start-itimer-once))
- (cancel-timer reftex-auto-view-crossref-timer))
+ (cancel-timer reftex-auto-view-crossref-timer)
(setq reftex-auto-view-crossref-timer nil)
(message "Automatic display of crossref information was turned off"))
(setq reftex-auto-view-crossref-timer
- (if (featurep 'xemacs)
- (if reftex-use-itimer-in-xemacs
- (start-itimer "RefTeX Idle Timer"
- 'reftex-view-crossref-when-idle
- reftex-idle-time reftex-idle-time t)
- (add-hook 'post-command-hook 'reftex-start-itimer-once)
- t)
- (run-with-idle-timer
- reftex-idle-time t 'reftex-view-crossref-when-idle)))
+ (run-with-idle-timer
+ reftex-idle-time t #'reftex-view-crossref-when-idle))
(unless reftex-auto-view-crossref
(setq reftex-auto-view-crossref t))
(message "Automatic display of crossref information was turned on")))
-(defun reftex-start-itimer-once ()
- (and (featurep 'xemacs)
- reftex-mode
- (not (itimer-live-p reftex-auto-view-crossref-timer))
- (setq reftex-auto-view-crossref-timer
- (start-itimer "RefTeX Idle Timer"
- 'reftex-view-crossref-when-idle
- reftex-idle-time nil t))))
-
;;;###autoload
(defun reftex-view-crossref-from-bibtex (&optional arg)
"View location in a LaTeX document which cites the BibTeX entry at point.
@@ -431,7 +407,7 @@ Calling this function several times find successive citation locations."
(put 'reftex-view-regexp-match :cnt (cl-incf cnt))
(reftex-highlight 0 (match-beginning highlight-group)
(match-end highlight-group))
- (add-hook 'pre-command-hook 'reftex-highlight-shall-die)
+ (add-hook 'pre-command-hook #'reftex-highlight-shall-die)
(setq pop-window (selected-window)))
(put 'reftex-view-regexp-match :props nil)
(or cont (set-window-configuration window-conf)))
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index 4d021609019..3b7518e5c3f 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -1,4 +1,4 @@
-;;; reftex-global.el --- operations on entire documents with RefTeX
+;;; reftex-global.el --- operations on entire documents with RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -39,7 +39,7 @@ The TAGS file is also immediately visited with `visit-tags-table'."
(reftex-access-scan-info current-prefix-arg)
(let* ((master (reftex-TeX-master-file))
(files (reftex-all-document-files))
- (cmd (format "etags %s" (mapconcat 'shell-quote-argument
+ (cmd (format "etags %s" (mapconcat #'shell-quote-argument
files " "))))
(with-current-buffer (reftex-get-file-buffer-force master)
(message "Running etags to create TAGS file...")
@@ -65,7 +65,7 @@ No active TAGS table is required."
(let* ((files (reftex-all-document-files t))
(cmd (format
"%s %s" grep-cmd
- (mapconcat 'identity files " "))))
+ (mapconcat #'identity files " "))))
(grep cmd)))
;;;###autoload
@@ -160,7 +160,7 @@ No active TAGS table is required."
(when (and (car (car dlist))
(cdr (car dlist)))
(cl-incf cnt)
- (insert (mapconcat 'identity (car dlist) "\n ") "\n"))
+ (insert (mapconcat #'identity (car dlist) "\n ") "\n"))
(pop dlist))
(goto-char (point-min))
(when (= cnt 0)
@@ -208,7 +208,7 @@ one with the `xr' package."
(error "Abort"))
;; Make the translation list
(let* ((re-core (concat "\\("
- (mapconcat 'cdr reftex-typekey-to-prefix-alist "\\|")
+ (mapconcat #'cdr reftex-typekey-to-prefix-alist "\\|")
"\\)"))
(label-re (concat "\\`" re-core "\\([0-9]+\\)\\'"))
(search-re (concat "[{,]\\(" re-core "\\([0-9]+\\)\\)[,}]"))
@@ -326,7 +326,7 @@ labels."
file buffer)
(save-current-buffer
(while (setq file (pop files))
- (setq buffer (reftex-get-buffer-visiting file))
+ (setq buffer (find-buffer-visiting file))
(when buffer
(set-buffer buffer)
(save-buffer))))))
@@ -344,7 +344,7 @@ Also checks if buffers visiting the files are in read-only mode."
(ding)
(or (y-or-n-p (format "No write access to %s. Continue? " file))
(error "Abort")))
- (when (and (setq buf (reftex-get-buffer-visiting file))
+ (when (and (setq buf (find-buffer-visiting file))
(with-current-buffer buf
buffer-read-only))
(ding)
@@ -366,10 +366,10 @@ Also checks if buffers visiting the files are in read-only mode."
(goto-char (if isearch-forward (point-min) (point-max))))
(defun reftex-isearch-push-state-function ()
- `(lambda (cmd)
- (reftex-isearch-pop-state-function cmd ,(current-buffer))))
+ (let ((buf (current-buffer)))
+ (lambda (cmd) (reftex-isearch-pop-state-function cmd buf))))
-(defun reftex-isearch-pop-state-function (cmd buffer)
+(defun reftex-isearch-pop-state-function (_cmd buffer)
(switch-to-buffer buffer))
(defun reftex-isearch-isearch-search (string bound noerror)
@@ -451,17 +451,17 @@ With no argument, this command toggles
(if (boundp 'multi-isearch-next-buffer-function)
(set (make-local-variable
'multi-isearch-next-buffer-function)
- 'reftex-isearch-switch-to-next-file)
+ #'reftex-isearch-switch-to-next-file)
(set (make-local-variable 'isearch-wrap-function)
- 'reftex-isearch-wrap-function)
+ #'reftex-isearch-wrap-function)
(set (make-local-variable 'isearch-search-fun-function)
- (lambda () 'reftex-isearch-isearch-search))
+ (lambda () #'reftex-isearch-isearch-search))
(set (make-local-variable 'isearch-push-state-function)
- 'reftex-isearch-push-state-function)
+ #'reftex-isearch-push-state-function)
(set (make-local-variable 'isearch-next-buffer-function)
- 'reftex-isearch-switch-to-next-file))
+ #'reftex-isearch-switch-to-next-file))
(setq reftex-isearch-minor-mode t))))
- (add-hook 'reftex-mode-hook 'reftex-isearch-minor-mode))
+ (add-hook 'reftex-mode-hook #'reftex-isearch-minor-mode))
(dolist (crt-buf (buffer-list))
(with-current-buffer crt-buf
(when reftex-mode
@@ -472,7 +472,7 @@ With no argument, this command toggles
(kill-local-variable 'isearch-push-state-function)
(kill-local-variable 'isearch-next-buffer-function))
(setq reftex-isearch-minor-mode nil))))
- (remove-hook 'reftex-mode-hook 'reftex-isearch-minor-mode)))
+ (remove-hook 'reftex-mode-hook #'reftex-isearch-minor-mode)))
;; Force mode line redisplay.
(set-buffer-modified-p (buffer-modified-p))))
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 5049ffb64b1..28cc7db2dcd 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1,4 +1,4 @@
-;;; reftex-index.el --- index support with RefTeX
+;;; reftex-index.el --- index support with RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -30,8 +30,6 @@
(require 'reftex)
;; START remove for XEmacs release
-(defvar mark-active)
-(defvar transient-mark-mode)
(defvar TeX-master)
;; END remove for XEmacs release
@@ -49,7 +47,7 @@ which is part of AUCTeX, the string is first processed with the
(interactive "P")
(let* ((use-default (not (equal arg '(16)))) ; check for double prefix
;; check if we have an active selection
- (active (reftex-region-active-p))
+ (active (region-active-p))
(beg (if active
(region-beginning)
(save-excursion
@@ -89,7 +87,7 @@ which is part of AUCTeX, the string is first processed with the
(reftex-index def-char full-entry def-tag sel)))))
;;;###autoload
-(defun reftex-index (&optional char key tag sel no-insert)
+(defun reftex-index (&optional char key tag sel _no-insert)
"Query for an index macro and insert it along with its arguments.
The index macros available are those defined in `reftex-index-macro' or
by a call to `reftex-add-index-macros', typically from an AUCTeX style file.
@@ -178,7 +176,7 @@ will prompt for other arguments."
(format "default %s" default))
"")))
": ")))
- (tag (completing-read prompt (mapcar 'list index-tags))))
+ (tag (completing-read prompt (mapcar #'list index-tags))))
(if (and default (equal tag "")) (setq tag default))
(reftex-update-default-index tag)
tag))
@@ -239,7 +237,7 @@ will prompt for other arguments."
(format "[^M] %s (the default)\n" default)
"")
(mapconcat (lambda(x)
- (apply 'format "[%c] %s" x))
+ (apply #'format "[%c] %s" x))
tag-alist "\n")))
;; Query the user for an index-tag
(setq rpl (reftex-select-with-char prompt help 3 t))
@@ -278,56 +276,57 @@ will prompt for other arguments."
(defvar reftex-index-mode-map
(let ((map (make-sparse-keymap)))
;; Index map
- (define-key map (if (featurep 'xemacs) [(button2)] [(mouse-2)])
- 'reftex-index-mouse-goto-line-and-hide)
+ (define-key map [(mouse-2)] #'reftex-index-mouse-goto-line-and-hide)
(define-key map [follow-link] 'mouse-face)
(substitute-key-definition
- 'next-line 'reftex-index-next map global-map)
+ #'next-line #'reftex-index-next map global-map)
(substitute-key-definition
- 'previous-line 'reftex-index-previous map global-map)
-
- (define-key map "n" 'reftex-index-next)
- (define-key map "p" 'reftex-index-previous)
- (define-key map "?" 'reftex-index-show-help)
- (define-key map " " 'reftex-index-view-entry)
- (define-key map "\C-m" 'reftex-index-goto-entry-and-hide)
- (define-key map "\C-i" 'reftex-index-goto-entry)
- (define-key map "\C-k" 'reftex-index-kill)
- (define-key map "r" 'reftex-index-rescan)
- (define-key map "R" 'reftex-index-Rescan)
- (define-key map "g" 'revert-buffer)
- (define-key map "q" 'reftex-index-quit)
- (define-key map "k" 'reftex-index-quit-and-kill)
- (define-key map "f" 'reftex-index-toggle-follow)
- (define-key map "s" 'reftex-index-switch-index-tag)
- (define-key map "e" 'reftex-index-edit)
- (define-key map "^" 'reftex-index-level-up)
- (define-key map "_" 'reftex-index-level-down)
- (define-key map "}" 'reftex-index-restrict-to-section)
- (define-key map "{" 'reftex-index-widen)
- (define-key map ">" 'reftex-index-restriction-forward)
- (define-key map "<" 'reftex-index-restriction-backward)
- (define-key map "(" 'reftex-index-toggle-range-beginning)
- (define-key map ")" 'reftex-index-toggle-range-end)
- (define-key map "|" 'reftex-index-edit-attribute)
- (define-key map "@" 'reftex-index-edit-visual)
- (define-key map "*" 'reftex-index-edit-key)
- (define-key map "\C-c=" 'reftex-index-goto-toc)
- (define-key map "c" 'reftex-index-toggle-context)
+ #'previous-line #'reftex-index-previous map global-map)
+
+ (define-key map "n" #'reftex-index-next)
+ (define-key map "p" #'reftex-index-previous)
+ (define-key map "?" #'reftex-index-show-help)
+ (define-key map " " #'reftex-index-view-entry)
+ (define-key map "\C-m" #'reftex-index-goto-entry-and-hide)
+ (define-key map "\C-i" #'reftex-index-goto-entry)
+ (define-key map "\C-k" #'reftex-index-kill)
+ (define-key map "r" #'reftex-index-rescan)
+ (define-key map "R" #'reftex-index-Rescan)
+ (define-key map "g" #'revert-buffer)
+ (define-key map "q" #'reftex-index-quit)
+ (define-key map "k" #'reftex-index-quit-and-kill)
+ (define-key map "f" #'reftex-index-toggle-follow)
+ (define-key map "s" #'reftex-index-switch-index-tag)
+ (define-key map "e" #'reftex-index-edit)
+ (define-key map "^" #'reftex-index-level-up)
+ (define-key map "_" #'reftex-index-level-down)
+ (define-key map "}" #'reftex-index-restrict-to-section)
+ (define-key map "{" #'reftex-index-widen)
+ (define-key map ">" #'reftex-index-restriction-forward)
+ (define-key map "<" #'reftex-index-restriction-backward)
+ (define-key map "(" #'reftex-index-toggle-range-beginning)
+ (define-key map ")" #'reftex-index-toggle-range-end)
+ (define-key map "|" #'reftex-index-edit-attribute)
+ (define-key map "@" #'reftex-index-edit-visual)
+ (define-key map "*" #'reftex-index-edit-key)
+ (define-key map "\C-c=" #'reftex-index-goto-toc)
+ (define-key map "c" #'reftex-index-toggle-context)
;; The capital letters and the exclamation mark
- (cl-loop for key across (concat "!" reftex-index-section-letters) do
- (define-key map (vector (list key))
- (list 'lambda '() '(interactive)
- (list 'reftex-index-goto-letter key))))
+ (mapc (lambda (key)
+ (define-key map (vector (list key))
+ (lambda () (interactive)
+ (reftex-index-goto-letter key))))
+ (concat "!" reftex-index-section-letters))
(easy-menu-define reftex-index-menu map
"Menu for Index buffer"
'("Index"
["Goto section A-Z"
(message "To go to a section, just press any of: !%s"
- reftex-index-section-letters) t]
+ reftex-index-section-letters)
+ t]
["Show Entry" reftex-index-view-entry t]
["Go To Entry" reftex-index-goto-entry t]
["Exit & Go To Entry" reftex-index-goto-entry-and-hide t]
@@ -394,7 +393,7 @@ Press `?' for a summary of important key bindings, or check the menu.
Here are all local bindings.
\\{reftex-index-mode-map}"
- (set (make-local-variable 'revert-buffer-function) 'reftex-index-revert)
+ (set (make-local-variable 'revert-buffer-function) #'reftex-index-revert)
(set (make-local-variable 'reftex-index-restriction-data) nil)
(set (make-local-variable 'reftex-index-restriction-indicator) nil)
(setq mode-line-format
@@ -403,15 +402,9 @@ Here are all local bindings.
" R<" 'reftex-index-restriction-indicator ">"
" -%-"))
(setq truncate-lines t)
- (when (featurep 'xemacs)
- ;; XEmacs needs the call to make-local-hook
- (make-local-hook 'post-command-hook)
- (make-local-hook 'pre-command-hook))
(make-local-variable 'reftex-last-follow-point)
- (when (featurep 'xemacs)
- (easy-menu-add reftex-index-menu reftex-index-mode-map))
- (add-hook 'post-command-hook 'reftex-index-post-command-hook nil t)
- (add-hook 'pre-command-hook 'reftex-index-pre-command-hook nil t))
+ (add-hook 'post-command-hook #'reftex-index-post-command-hook nil t)
+ (add-hook 'pre-command-hook #'reftex-index-pre-command-hook nil t))
(defconst reftex-index-help
" AVAILABLE KEYS IN INDEX BUFFER
@@ -450,7 +443,7 @@ _ ^ Add/Remove parent key (to make this item a subitem).
(match
(cond
((or (not no-revisit)
- (reftex-get-buffer-visiting file))
+ (find-buffer-visiting file))
(switch-to-buffer-other-window
(reftex-get-file-buffer-force file nil))
(goto-char (or pos (point-min)))
@@ -567,7 +560,7 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
(run-hooks 'reftex-display-copied-context-hook)
(message "Building %s buffer...done." buffer-name)
(setq buffer-read-only t))
- (and locations (apply 'reftex-find-start-point (point) locations))
+ (and locations (apply #'reftex-find-start-point (point) locations))
(if reftex-index-restriction-indicator
(message "Index restricted: <%s>" reftex-index-restriction-indicator))))
@@ -582,7 +575,7 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
(indent " ")
(context reftex-index-include-context)
(context-indent (concat indent " "))
- (section-chars (mapcar 'identity reftex-index-section-letters))
+ (section-chars (mapcar #'identity reftex-index-section-letters))
(this-section-char 0)
(font (reftex-use-fonts))
(bor (car reftex-index-restriction-data))
@@ -733,9 +726,9 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
(if reftex-index-follow-mode
(setq reftex-index-follow-mode 1)))
-(defun reftex-index-next (&optional arg)
+(defun reftex-index-next (&optional _arg)
"Move to next selectable item."
- (interactive "p")
+ (interactive "^")
(setq reftex-callback-fwd t)
(or (eobp) (forward-char 1))
(goto-char (or (next-single-property-change (point) :data)
@@ -743,9 +736,9 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
(unless (get-text-property (point) :data)
(goto-char (or (next-single-property-change (point) :data)
(point)))))
-(defun reftex-index-previous (&optional arg)
+(defun reftex-index-previous (&optional _arg)
"Move to previous selectable item."
- (interactive "p")
+ (interactive "^")
(setq reftex-callback-fwd nil)
(goto-char (or (previous-single-property-change (point) :data)
(point)))
@@ -793,7 +786,7 @@ Label context is only displayed when the labels are there as well."
(or (one-window-p) (delete-window))
(switch-to-buffer (marker-buffer reftex-index-return-marker))
(goto-char (or (marker-position reftex-index-return-marker) (point))))
-(defun reftex-index-goto-toc (&rest ignore)
+(defun reftex-index-goto-toc (&rest _ignore)
"Switch to the table of contents of the current document.
The function will go to the section where the entry at point was defined."
(interactive)
@@ -802,7 +795,7 @@ The function will go to the section where the entry at point was defined."
(switch-to-buffer (marker-buffer reftex-index-return-marker)))
(delete-other-windows)
(reftex-toc))
-(defun reftex-index-rescan (&rest ignore)
+(defun reftex-index-rescan (&rest _ignore)
"Regenerate the *Index* buffer after reparsing file of section at point."
(interactive)
(let ((index-tag reftex-index-tag))
@@ -818,7 +811,7 @@ The function will go to the section where the entry at point was defined."
(reftex-display-index index-tag nil 'redo line)))
(reftex-index-Rescan))
(reftex-kill-temporary-buffers)))
-(defun reftex-index-Rescan (&rest ignore)
+(defun reftex-index-Rescan (&rest _ignore)
"Regenerate the *Index* buffer after reparsing the entire document."
(interactive)
(let ((index-tag reftex-index-tag)
@@ -827,7 +820,7 @@ The function will go to the section where the entry at point was defined."
(reftex-get-file-buffer-force reftex-last-index-file))
(setq current-prefix-arg '(16))
(reftex-display-index index-tag nil 'redo line)))
-(defun reftex-index-revert (&rest ignore)
+(defun reftex-index-revert (&rest _ignore)
"Regenerate the *Index* from the internal lists. No reparsing os done."
(interactive)
(let ((buf (current-buffer))
@@ -840,7 +833,7 @@ The function will go to the section where the entry at point was defined."
(setq current-prefix-arg nil
reftex-last-follow-point 1)
(reftex-display-index index-tag nil 'redo data line)))
-(defun reftex-index-switch-index-tag (&rest ignore)
+(defun reftex-index-switch-index-tag (&rest _ignore)
"Switch to a different index of the same document."
(interactive)
(switch-to-buffer
@@ -865,14 +858,14 @@ The function will go to the section where the entry at point was defined."
reftex-index-restriction-indicator (nth 6 bor) )))
(reftex-index-revert))
-(defun reftex-index-widen (&rest ignore)
+(defun reftex-index-widen (&rest _ignore)
"Show the unrestricted index (all entries)."
(interactive)
(setq reftex-index-restriction-indicator nil
reftex-index-restriction-data nil)
(reftex-index-revert)
(message "Index widened"))
-(defun reftex-index-restriction-forward (&rest ignore)
+(defun reftex-index-restriction-forward (&rest _ignore)
"Restrict to previous section.
When index is currently unrestricted, restrict it to a section.
When index is restricted, select the next section as restriction criterion."
@@ -888,7 +881,7 @@ When index is restricted, select the next section as restriction criterion."
(car (memq (assq 'toc (cdr (memq bor docstruct)))
docstruct))))
(reftex-index-revert))))
-(defun reftex-index-restriction-backward (&rest ignore)
+(defun reftex-index-restriction-backward (&rest _ignore)
"Restrict to next section.
When index is currently unrestricted, restrict it to a section.
When index is restricted, select the previous section as restriction criterion."
@@ -986,7 +979,7 @@ When index is restricted, select the previous section as restriction criterion."
(setq analyze (reftex-index-analyze-entry data)
attr (nth 2 analyze))
(setf (nth 2 analyze) (if (string= attr bor) "" bor))
- (setq new (apply 'concat analyze))
+ (setq new (apply #'concat analyze))
(reftex-index-change-entry
new (if (string= (nth 2 analyze) bor)
"Entry is now START-OF-PAGE-RANGE"
@@ -1002,7 +995,7 @@ When index is restricted, select the previous section as restriction criterion."
(setq analyze (reftex-index-analyze-entry data)
attr (nth 2 analyze))
(setf (nth 2 analyze) (if (string= attr eor) "" eor))
- (setq new (apply 'concat analyze))
+ (setq new (apply #'concat analyze))
(reftex-index-change-entry
new (if (string= (nth 2 analyze) eor)
"Entry is now END-OF-PAGE-RANGE"
@@ -1043,7 +1036,7 @@ When index is restricted, select the previous section as restriction criterion."
(error "Invalid value")
(setf (nth n analyze) npart)))
(t (setf (nth n analyze) (concat initial npart))))
- (setq new (apply 'concat analyze))
+ (setq new (apply #'concat analyze))
;; Change the entry and insert the changed version into the index.
(reftex-index-change-entry
new (if (string= npart "")
@@ -1180,27 +1173,50 @@ This gets refreshed in every phrases command.")
(defvar reftex-index-phrases-files nil
"List of document files relevant for the phrases file.")
-(defvar reftex-index-phrases-font-lock-keywords nil
- "Font lock keywords for reftex-index-phrases-mode.")
-(defvar reftex-index-phrases-font-lock-defaults nil
- "Font lock defaults for reftex-index-phrases-mode.")
+(defvar reftex-index-phrases-font-lock-keywords
+ (list
+ (cons reftex-index-phrases-comment-regexp 'font-lock-comment-face)
+ (list reftex-index-phrases-macrodef-regexp
+ '(1 font-lock-type-face)
+ '(2 font-lock-keyword-face)
+ '(3 'secondary-selection)
+ '(4 font-lock-function-name-face)
+ '(5 'secondary-selection)
+ '(6 font-lock-string-face))
+ (list reftex-index-phrases-phrase-regexp1
+ '(1 font-lock-keyword-face)
+ '(2 'secondary-selection)
+ '(3 font-lock-string-face)
+ '(4 'secondary-selection))
+ (list reftex-index-phrases-phrase-regexp2
+ '(1 font-lock-keyword-face)
+ '(2 'secondary-selection)
+ '(3 font-lock-string-face)
+ '(4 'secondary-selection)
+ '(5 font-lock-function-name-face))
+ '("^\t$" . 'secondary-selection))
+ "Font lock keywords for `reftex-index-phrases-mode'.")
+(defvar reftex-index-phrases-font-lock-defaults
+ '((reftex-index-phrases-font-lock-keywords)
+ nil t nil beginning-of-line)
+ "Font lock defaults for `reftex-index-phrases-mode'.")
(define-obsolete-variable-alias
'reftex-index-phrases-map 'reftex-index-phrases-mode-map "24.1")
(defvar reftex-index-phrases-mode-map
(let ((map (make-sparse-keymap)))
;; Keybindings and Menu for phrases buffer
- (define-key map "\C-c\C-c" 'reftex-index-phrases-save-and-return)
- (define-key map "\C-c\C-x" 'reftex-index-this-phrase)
- (define-key map "\C-c\C-f" 'reftex-index-next-phrase)
- (define-key map "\C-c\C-r" 'reftex-index-region-phrases)
- (define-key map "\C-c\C-a" 'reftex-index-all-phrases)
- (define-key map "\C-c\C-d" 'reftex-index-remaining-phrases)
- (define-key map "\C-c\C-s" 'reftex-index-sort-phrases)
- (define-key map "\C-c\C-n" 'reftex-index-new-phrase)
- (define-key map "\C-c\C-m" 'reftex-index-phrases-set-macro-key)
- (define-key map "\C-c\C-i" 'reftex-index-phrases-info)
- (define-key map "\C-c\C-t" 'reftex-index-find-next-conflict-phrase)
- (define-key map "\C-i" 'self-insert-command)
+ (define-key map "\C-c\C-c" #'reftex-index-phrases-save-and-return)
+ (define-key map "\C-c\C-x" #'reftex-index-this-phrase)
+ (define-key map "\C-c\C-f" #'reftex-index-next-phrase)
+ (define-key map "\C-c\C-r" #'reftex-index-region-phrases)
+ (define-key map "\C-c\C-a" #'reftex-index-all-phrases)
+ (define-key map "\C-c\C-d" #'reftex-index-remaining-phrases)
+ (define-key map "\C-c\C-s" #'reftex-index-sort-phrases)
+ (define-key map "\C-c\C-n" #'reftex-index-new-phrase)
+ (define-key map "\C-c\C-m" #'reftex-index-phrases-set-macro-key)
+ (define-key map "\C-c\C-i" #'reftex-index-phrases-info)
+ (define-key map "\C-c\C-t" #'reftex-index-find-next-conflict-phrase)
+ (define-key map "\C-i" #'self-insert-command)
(easy-menu-define reftex-index-phrases-menu map
"Menu for Phrases buffer"
@@ -1295,7 +1311,7 @@ If the buffer is non-empty, delete the old header first."
reftex-key-to-index-macro-alist)))
(macro-alist
(sort (copy-sequence reftex-index-macro-alist)
- (lambda (a b) (equal (car a) default-macro))))
+ (lambda (a _b) (equal (car a) default-macro))))
macro entry key repeat)
(if master (set (make-local-variable 'TeX-master)
@@ -1311,9 +1327,7 @@ If the buffer is non-empty, delete the old header first."
(beginning-of-line 2))
(while (looking-at "^[ \t]*$")
(beginning-of-line 2))
- (if (featurep 'xemacs)
- (zmacs-activate-region)
- (setq mark-active t))
+ (activate-mark)
(if (yes-or-no-p "Delete and rebuild header? ")
(delete-region (point-min) (point))))
@@ -1336,7 +1350,6 @@ If the buffer is non-empty, delete the old header first."
(if repeat "t" "nil"))))
(insert "%---------------------------------------------------------------------\n\n\n")))
-(defvar TeX-master)
(defun reftex-index-phrase-tex-master (&optional dir)
"Return the name of the master file associated with a phrase buffer."
(if (and (boundp 'TeX-master)
@@ -1387,41 +1400,8 @@ Here are all local bindings.
:syntax-table reftex-index-phrases-syntax-table
(set (make-local-variable 'font-lock-defaults)
reftex-index-phrases-font-lock-defaults)
- (when (featurep 'xemacs)
- (easy-menu-add reftex-index-phrases-menu reftex-index-phrases-mode-map))
(set (make-local-variable 'reftex-index-phrases-marker) (make-marker)))
-;; (add-hook 'reftex-index-phrases-mode-hook 'turn-on-font-lock)
-
-;; Font Locking stuff
-(let ((ss (if (featurep 'xemacs) 'secondary-selection ''secondary-selection)))
- (setq reftex-index-phrases-font-lock-keywords
- (list
- (cons reftex-index-phrases-comment-regexp 'font-lock-comment-face)
- (list reftex-index-phrases-macrodef-regexp
- '(1 font-lock-type-face)
- '(2 font-lock-keyword-face)
- (list 3 ss)
- '(4 font-lock-function-name-face)
- (list 5 ss)
- '(6 font-lock-string-face))
- (list reftex-index-phrases-phrase-regexp1
- '(1 font-lock-keyword-face)
- (list 2 ss)
- '(3 font-lock-string-face)
- (list 4 ss))
- (list reftex-index-phrases-phrase-regexp2
- '(1 font-lock-keyword-face)
- (list 2 ss)
- '(3 font-lock-string-face)
- (list 4 ss)
- '(5 font-lock-function-name-face))
- (cons "^\t$" ss)))
- (setq reftex-index-phrases-font-lock-defaults
- '((reftex-index-phrases-font-lock-keywords)
- nil t nil beginning-of-line))
- (put 'reftex-index-phrases-mode 'font-lock-defaults
- reftex-index-phrases-font-lock-defaults) ; XEmacs
- )
+;; (add-hook 'reftex-index-phrases-mode-hook #'turn-on-font-lock)
(defun reftex-index-next-phrase (&optional arg)
"Index the next ARG phrases in the phrases buffer."
@@ -1561,9 +1541,7 @@ index the new part without having to go over the unchanged parts again."
(unwind-protect
(progn
;; Hide the region highlighting
- (if (featurep 'xemacs)
- (zmacs-deactivate-region)
- (deactivate-mark))
+ (deactivate-mark)
(delete-other-windows)
(reftex-index-visit-phrases-buffer)
(reftex-index-all-phrases))
@@ -1593,7 +1571,7 @@ index the new part without having to go over the unchanged parts again."
(if (and text (stringp text))
(insert text)))
-(defun reftex-index-find-next-conflict-phrase (&optional arg)
+(defun reftex-index-find-next-conflict-phrase (&optional _arg)
"Find the next a phrase which is has conflicts in the phrase buffer.
The command helps to find possible conflicts in the phrase indexing process.
It searches downward from point for a phrase which is repeated elsewhere
@@ -1601,7 +1579,7 @@ in the buffer, or which is a subphrase of another phrase. If such a
phrase is found, the phrase info is displayed.
To check the whole buffer, start at the beginning and continue by calling
this function repeatedly."
- (interactive "P")
+ (interactive)
(if (catch 'exit
(while (re-search-forward reftex-index-phrases-phrase-regexp12 nil t)
(goto-char (match-beginning 3))
@@ -1743,6 +1721,8 @@ information about the currently selected macro."
(if repeat "with" "without")))
(error "Abort")))))
+(defvar reftex--chars-first)
+
(defun reftex-index-sort-phrases (&optional chars-first)
"Sort the phrases lines in the buffer alphabetically.
Normally, this looks only at the phrases. With a prefix arg CHARS-FIRST,
@@ -1762,19 +1742,18 @@ it first compares the macro identifying chars and then the phrases."
(if end (setq end (progn (goto-char end) (end-of-line) (point))))
;; Take the lines, sort them and re-insert.
(if (and beg end)
- (progn
+ (let ((reftex--chars-first chars-first))
(message "Sorting lines...")
(let* ((lines (split-string (buffer-substring beg end) "\n"))
- (lines1 (sort lines 'reftex-compare-phrase-lines)))
+ (lines1 (sort lines #'reftex-compare-phrase-lines)))
(message "Sorting lines...done")
(let ((inhibit-quit t)) ;; make sure we do not lose lines
(delete-region beg end)
- (insert (mapconcat 'identity lines1 "\n"))))
+ (insert (mapconcat #'identity lines1 "\n"))))
(goto-char (point-max))
(re-search-backward (concat "^" (regexp-quote line) "$") nil t))
(error "Cannot find phrases lines to sort"))))
-(defvar chars-first)
(defun reftex-compare-phrase-lines (a b)
"The comparison function used for sorting."
(let (ca cb pa pb c-p p-p)
@@ -1798,7 +1777,7 @@ it first compares the macro identifying chars and then the phrases."
p-p (string< pa pb))
;; Do the right comparison, based on the value of `chars-first'
;; `chars-first' is bound locally in the calling function
- (if chars-first
+ (if reftex--chars-first
(if (string= ca cb) p-p c-p)
(if (string= pa pb) c-p p-p)))))
;; If line a does not match, the answer we return determines
@@ -1830,14 +1809,14 @@ With optional arg ALLOW-NEWLINE, allow single newline between words."
(defun reftex-index-simplify-phrase (phrase)
"Make phrase single spaces and single line."
- (mapconcat 'identity (split-string phrase) " "))
+ (mapconcat #'identity (split-string phrase) " "))
(defun reftex-index-phrases-find-dup-re (phrase &optional sub)
"Return a regexp which matches variations of PHRASE (with additional space).
When SUB ins non-nil, the regexp will also match when PHRASE is a subphrase
of another phrase. The regexp works lonly in the phrase buffer."
(concat (if sub "^\\S-?\t\\([^\t\n]*" "^\\S-?\t")
- (mapconcat 'regexp-quote (split-string phrase) " +")
+ (mapconcat #'regexp-quote (split-string phrase) " +")
(if sub "[^\t\n]*\\)\\([\t\n]\\|$\\)" " *\\([\t\n]\\|$\\)")))
(defun reftex-index-make-replace-string (macro-fmt match index-key
@@ -1870,7 +1849,7 @@ Treats the logical `and' for index phrases."
(unless (stringp reftex-index-phrases-restrict-file)
(widen))
(goto-char (point-min))
- (apply 'reftex-query-index-phrase args))))))
+ (apply #'reftex-query-index-phrase args))))))
(reftex-unhighlight 0)
(set-window-configuration win-conf))))
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 98c61f56b48..9def10cee05 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -1,4 +1,4 @@
-;;; reftex-parse.el --- parser functions for RefTeX
+;;; reftex-parse.el --- parser functions for RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -143,7 +143,7 @@ When allowed, do only a partial scan from FILE."
(car (push (list 'is-multi is-multi) docstruct)))))
(setcdr entry (cons is-multi nil)))
(and reftex--index-tags
- (setq reftex--index-tags (sort reftex--index-tags 'string<)))
+ (setq reftex--index-tags (sort reftex--index-tags #'string<)))
(let ((index-tag-cell (assq 'index-tags docstruct)))
(if index-tag-cell
(setcdr index-tag-cell reftex--index-tags)
@@ -160,10 +160,10 @@ When allowed, do only a partial scan from FILE."
nil))
allxr))
(alist (delq nil alist))
- (allprefix (delq nil (mapcar 'car alist)))
+ (allprefix (delq nil (mapcar #'car alist)))
(regexp (if allprefix
(concat "\\`\\("
- (mapconcat 'identity allprefix "\\|")
+ (mapconcat #'identity allprefix "\\|")
"\\)")
"\\\\\\\\\\\\"))) ; this will never match
(push (list 'xr alist regexp) docstruct)))
@@ -209,7 +209,7 @@ of master file."
(catch 'exit
(setq file-found (reftex-locate-file file "tex" master-dir))
(if (and (not file-found)
- (setq buf (reftex-get-buffer-visiting file)))
+ (setq buf (find-buffer-visiting file)))
(setq file-found (buffer-file-name buf)))
(unless file-found
@@ -384,8 +384,9 @@ of master file."
(concat
;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\("
"\\(^\\)[^%\n\r]*\\\\\\("
- (mapconcat 'identity reftex-bibliography-commands "\\|")
- "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") nil t))
+ (mapconcat #'identity reftex-bibliography-commands "\\|")
+ "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)")
+ nil t))
(setq files
(append files
(split-string (reftex-match-string 4)
@@ -532,7 +533,7 @@ Careful: This function expects the match-data to be still in place!"
(key (if prefix (concat prefix rawkey) rawkey))
(sortkey (downcase key))
- (showkey (mapconcat 'identity
+ (showkey (mapconcat #'identity
(split-string key reftex-index-level-re)
" ! ")))
(goto-char end-of-args)
@@ -756,7 +757,7 @@ if the information is exact (t) or approximate (nil)."
(while (and (setq tail (memq (assq 'toc (cdr tail)) tail))
(setq entry (car tail))
(>= (nth 5 entry) level))
- (setq star (string-match "\\*" (nth 6 entry))
+ (setq star (string-search "*" (nth 6 entry))
context (nth 2 entry)
section-number
(reftex-section-number (nth 5 entry) star))
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 439c02f8089..19081825931 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -1,4 +1,4 @@
-;;; reftex-ref.el --- code to create labels and references with RefTeX
+;;; reftex-ref.el --- code to create labels and references with RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -84,10 +84,12 @@ If optional BOUND is an integer, limit backward searches to that point."
(if (or (re-search-forward
(format reftex-find-label-regexp-format
- (regexp-quote label)) nil t)
+ (regexp-quote label))
+ nil t)
(re-search-forward
(format reftex-find-label-regexp-format2
- (regexp-quote label)) nil t))
+ (regexp-quote label))
+ nil t))
(progn
(backward-char 1)
@@ -248,13 +250,13 @@ This function is controlled by the settings of reftex-insert-label-flags."
""
"POSITION UNCERTAIN. RESCAN TO FIX."))
(file (buffer-file-name))
- (text nil)
+ ;; (text nil)
(tail (memq here-I-am (symbol-value reftex-docstruct-symbol))))
(or (cdr here-I-am-info) (setq rescan-is-useful t))
(when tail
- (push (list label typekey text file nil note) (cdr tail))
+ (push (list label typekey nil file nil note) (cdr tail))
(put reftex-docstruct-symbol 'modified t)))
;; Insert the label into the buffer
@@ -286,7 +288,7 @@ also applies `reftex-translate-to-ascii-function' to the string."
(when (and reftex-translate-to-ascii-function
(fboundp reftex-translate-to-ascii-function))
(setq string (funcall reftex-translate-to-ascii-function string)))
- (apply 'reftex-convert-string string
+ (apply #'reftex-convert-string string
"[-~ \t\n\r,;]+" reftex-label-illegal-re nil nil
reftex-derive-label-parameters))
@@ -402,6 +404,8 @@ also applies `reftex-translate-to-ascii-function' to the string."
a / A Put all marked entries into one/many \\ref commands.
q / RET Quit without referencing / Accept current label (also on mouse-2).")
+(defvar reftex-refstyle)
+
;;;###autoload
(defun reftex-reference (&optional type no-insert cut)
"Make a LaTeX reference. Look only for labels of a certain TYPE.
@@ -473,7 +477,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
;; If the first entry is the symbol 'concat, concat all labels.
;; We keep the cdr of the first label for typekey etc information.
(if (eq (car labels) 'concat)
- (setq labels (list (list (mapconcat 'car (cdr labels) ",")
+ (setq labels (list (list (mapconcat #'car (cdr labels) ",")
(cdr (nth 1 labels))))))
(setq type (nth 1 (car labels))
form (or (cdr (assoc type reftex-typekey-to-format-alist))
@@ -502,7 +506,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
(setq form (substring form 1)))
;; do we have a special format?
(unless (string= reftex-refstyle "\\ref")
- (setq reftex-format-ref-function 'reftex-format-special))
+ (setq reftex-format-ref-function #'reftex-format-special))
;; ok, insert the reference
(if sep1 (insert sep1))
(insert
@@ -744,7 +748,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
;; Goto the file in another window
(setq buffer
(if no-revisit
- (reftex-get-buffer-visiting file)
+ (find-buffer-visiting file)
(reftex-get-file-buffer-force
file (not reftex-keep-temporary-buffers))))
(if buffer
@@ -794,7 +798,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
(push (cons (current-buffer) buffer-invisibility-spec)
reftex-buffers-with-changed-invisibility)
(setq buffer-invisibility-spec nil))
- ((string-match "\r" (buffer-substring beg end))
+ ((string-search "\r" (buffer-substring beg end))
;; Invisible with selective display. We need to copy it.
(let ((string (buffer-substring-no-properties beg end)))
(switch-to-buffer "*RefTeX Context Copy*")
@@ -826,14 +830,16 @@ When called with 2 C-u prefix args, disable magic word recognition."
(dolist (item (nth 2 elt))
(let ((macro (car item))
(package (nth 1 elt)))
- (eval `(defun ,(intern (format "reftex-%s-%s" package
- (substring macro 1 (length macro)))) ()
- ,(format "Insert a reference using the `%s' macro from the %s \
+ (defalias (intern (format "reftex-%s-%s" package
+ (substring macro 1 (length macro))))
+ (lambda ()
+ (:documentation
+ (format "Insert a reference using the `%s' macro from the %s \
package.\n\nThis is a generated function."
- macro package)
- (interactive)
- (let ((reftex-refstyle ,macro))
- (reftex-reference))))))))
+ macro package))
+ (interactive)
+ (let ((reftex-refstyle macro))
+ (reftex-reference))))))))
(defun reftex-format-special (label fmt refstyle)
"Apply selected reference style to format FMT and add LABEL.
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index d2e9974499b..b0a8ebf8ac0 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -1,4 +1,4 @@
-;;; reftex-sel.el --- the selection modes for RefTeX
+;;; reftex-sel.el --- the selection modes for RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2021 Free Software Foundation, Inc.
@@ -34,31 +34,29 @@
(let ((map (make-sparse-keymap)))
(set-keymap-parent map special-mode-map)
(substitute-key-definition
- 'next-line 'reftex-select-next map global-map)
+ #'next-line #'reftex-select-next map global-map)
(substitute-key-definition
- 'previous-line 'reftex-select-previous map global-map)
+ #'previous-line #'reftex-select-previous map global-map)
(substitute-key-definition
- 'keyboard-quit 'reftex-select-keyboard-quit map global-map)
+ #'keyboard-quit #'reftex-select-keyboard-quit map global-map)
(substitute-key-definition
- 'newline 'reftex-select-accept map global-map)
-
- (define-key map " " 'reftex-select-callback)
- (define-key map "n" 'reftex-select-next)
- (define-key map [(down)] 'reftex-select-next)
- (define-key map "p" 'reftex-select-previous)
- (define-key map [(up)] 'reftex-select-previous)
- (define-key map "f" 'reftex-select-toggle-follow)
- (define-key map "\C-m" 'reftex-select-accept)
- (define-key map [(return)] 'reftex-select-accept)
- (define-key map "q" 'reftex-select-quit)
- (define-key map "." 'reftex-select-show-insertion-point)
- (define-key map "?" 'reftex-select-help)
+ #'newline #'reftex-select-accept map global-map)
+
+ (define-key map " " #'reftex-select-callback)
+ (define-key map "n" #'reftex-select-next)
+ (define-key map [(down)] #'reftex-select-next)
+ (define-key map "p" #'reftex-select-previous)
+ (define-key map [(up)] #'reftex-select-previous)
+ (define-key map "f" #'reftex-select-toggle-follow)
+ (define-key map "\C-m" #'reftex-select-accept)
+ (define-key map [(return)] #'reftex-select-accept)
+ (define-key map "q" #'reftex-select-quit)
+ (define-key map "." #'reftex-select-show-insertion-point)
+ (define-key map "?" #'reftex-select-help)
;; The mouse-2 binding
- (if (featurep 'xemacs)
- (define-key map [(button2)] 'reftex-select-mouse-accept)
- (define-key map [(mouse-2)] 'reftex-select-mouse-accept)
- (define-key map [follow-link] 'mouse-face))
+ (define-key map [(mouse-2)] #'reftex-select-mouse-accept)
+ (define-key map [follow-link] 'mouse-face)
map))
(define-obsolete-variable-alias
@@ -67,25 +65,26 @@
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
- (cl-loop for key across "aAcgFlrRstx#%" do
- (define-key map (vector (list key))
- (list 'lambda '()
- "Press `?' during selection to find out about this key."
- '(interactive) (list 'throw '(quote myexit) key))))
-
- (define-key map "b" 'reftex-select-jump-to-previous)
- (define-key map "z" 'reftex-select-jump)
- (define-key map "v" 'reftex-select-cycle-ref-style-forward)
- (define-key map "V" 'reftex-select-cycle-ref-style-backward)
- (define-key map "m" 'reftex-select-mark)
- (define-key map "u" 'reftex-select-unmark)
- (define-key map "," 'reftex-select-mark-comma)
- (define-key map "-" 'reftex-select-mark-to)
- (define-key map "+" 'reftex-select-mark-and)
- (define-key map [(tab)] 'reftex-select-read-label)
- (define-key map "\C-i" 'reftex-select-read-label)
- (define-key map "\C-c\C-n" 'reftex-select-next-heading)
- (define-key map "\C-c\C-p" 'reftex-select-previous-heading)
+ (mapc (lambda (key)
+ (define-key map (vector (list key))
+ (lambda ()
+ "Press `?' during selection to find out about this key."
+ (interactive) (throw 'myexit key))))
+ "aAcgFlrRstx#%")
+
+ (define-key map "b" #'reftex-select-jump-to-previous)
+ (define-key map "z" #'reftex-select-jump)
+ (define-key map "v" #'reftex-select-cycle-ref-style-forward)
+ (define-key map "V" #'reftex-select-cycle-ref-style-backward)
+ (define-key map "m" #'reftex-select-mark)
+ (define-key map "u" #'reftex-select-unmark)
+ (define-key map "," #'reftex-select-mark-comma)
+ (define-key map "-" #'reftex-select-mark-to)
+ (define-key map "+" #'reftex-select-mark-and)
+ (define-key map [(tab)] #'reftex-select-read-label)
+ (define-key map "\C-i" #'reftex-select-read-label)
+ (define-key map "\C-c\C-n" #'reftex-select-next-heading)
+ (define-key map "\C-c\C-p" #'reftex-select-previous-heading)
map)
"Keymap used for *RefTeX Select* buffer, when selecting a label.
@@ -104,10 +103,6 @@ Press `?' for a summary of important key bindings.
During a selection process, these are the local bindings.
\\{reftex-select-label-mode-map}"
- (when (featurep 'xemacs)
- ;; XEmacs needs the call to make-local-hook
- (make-local-hook 'pre-command-hook)
- (make-local-hook 'post-command-hook))
(set (make-local-variable 'reftex-select-marked) nil)
(when (syntax-table-p reftex-latex-syntax-table)
(set-syntax-table reftex-latex-syntax-table))
@@ -120,16 +115,17 @@ During a selection process, these are the local bindings.
(let ((map (make-sparse-keymap)))
(set-keymap-parent map reftex-select-shared-map)
- (cl-loop for key across "grRaAeE" do
- (define-key map (vector (list key))
- (list 'lambda '()
- "Press `?' during selection to find out about this key."
- '(interactive) (list 'throw '(quote myexit) key))))
+ (mapc (lambda (key)
+ (define-key map (vector (list key))
+ (lambda ()
+ "Press `?' during selection to find out about this key."
+ (interactive) (throw 'myexit key))))
+ "grRaAeE")
- (define-key map "\C-i" 'reftex-select-read-cite)
- (define-key map [(tab)] 'reftex-select-read-cite)
- (define-key map "m" 'reftex-select-mark)
- (define-key map "u" 'reftex-select-unmark)
+ (define-key map "\C-i" #'reftex-select-read-cite)
+ (define-key map [(tab)] #'reftex-select-read-cite)
+ (define-key map "m" #'reftex-select-mark)
+ (define-key map "u" #'reftex-select-unmark)
map)
"Keymap used for *RefTeX Select* buffer, when selecting a BibTeX entry.
@@ -148,10 +144,6 @@ Press `?' for a summary of important key bindings.
During a selection process, these are the local bindings.
\\{reftex-select-label-mode-map}"
- (when (featurep 'xemacs)
- ;; XEmacs needs the call to make-local-hook
- (make-local-hook 'pre-command-hook)
- (make-local-hook 'post-command-hook))
(set (make-local-variable 'reftex-select-marked) nil)
;; We do not set a local map - reftex-select-item does this.
)
@@ -432,12 +424,21 @@ During a selection process, these are the local bindings.
(defvar reftex-last-data nil)
(defvar reftex-last-line nil)
(defvar reftex-select-marked nil)
+(defvar reftex-refstyle)
+
+;; The following variables are all bound dynamically in `reftex-select-item'.
+
+(defvar reftex-select-data)
+(defvar reftex-select-prompt)
+(defvar reftex--cb-flag)
+(defvar reftex--last-data)
+(defvar reftex--call-back)
+(defvar reftex--help-string)
;;;###autoload
-(defun reftex-select-item (reftex-select-prompt help-string keymap
- &optional offset
- call-back cb-flag)
- ;; Select an item, using REFTEX-SELECT-PROMPT.
+(defun reftex-select-item ( prompt help-string keymap
+ &optional offset call-back cb-flag)
+ ;; Select an item, using PROMPT.
;; The function returns a key indicating an exit status, along with a
;; data structure indicating which item was selected.
;; HELP-STRING contains help. KEYMAP is a keymap with the available
@@ -448,7 +449,12 @@ During a selection process, these are the local bindings.
;; When CALL-BACK is given, it is a function which is called with the index
;; of the element.
;; CB-FLAG is the initial value of that flag.
- (let (ev reftex-select-data last-data (selection-buffer (current-buffer)))
+ (let ((reftex-select-prompt prompt)
+ (reftex--help-string help-string)
+ (reftex--call-back call-back)
+ (reftex--cb-flag cb-flag)
+ ev reftex-select-data reftex--last-data
+ (selection-buffer (current-buffer)))
(setq reftex-select-marked nil)
@@ -466,43 +472,29 @@ During a selection process, these are the local bindings.
(unwind-protect
(progn
(use-local-map keymap)
- (add-hook 'pre-command-hook 'reftex-select-pre-command-hook nil t)
- (add-hook 'post-command-hook 'reftex-select-post-command-hook nil t)
+ (add-hook 'pre-command-hook #'reftex-select-pre-command-hook nil t)
+ (add-hook 'post-command-hook #'reftex-select-post-command-hook nil t)
(princ reftex-select-prompt)
(set-marker reftex-recursive-edit-marker (point))
- ;; XEmacs does not run post-command-hook here
- (and (featurep 'xemacs) (run-hooks 'post-command-hook))
(recursive-edit))
(set-marker reftex-recursive-edit-marker nil)
(with-current-buffer selection-buffer
(use-local-map nil)
- (remove-hook 'pre-command-hook 'reftex-select-pre-command-hook t)
+ (remove-hook 'pre-command-hook #'reftex-select-pre-command-hook t)
(remove-hook 'post-command-hook
- 'reftex-select-post-command-hook t))
+ #'reftex-select-post-command-hook t))
;; Kill the mark overlays
- (mapc (lambda (c) (reftex-delete-overlay (nth 1 c)))
+ (mapc (lambda (c) (delete-overlay (nth 1 c)))
reftex-select-marked)))))
(set (make-local-variable 'reftex-last-line)
(+ (count-lines (point-min) (point)) (if (bolp) 1 0)))
- (set (make-local-variable 'reftex-last-data) last-data)
+ (set (make-local-variable 'reftex-last-data) reftex--last-data)
(reftex-kill-buffer "*RefTeX Help*")
(setq reftex-callback-fwd (not reftex-callback-fwd)) ;; ;-)))
(message "")
- (list ev reftex-select-data last-data)))
-
-;; The following variables are all bound dynamically in `reftex-select-item'.
-;; The defvars are here only to silence the byte compiler.
-
-(defvar found-list)
-(defvar cb-flag)
-(defvar reftex-select-data)
-(defvar reftex-select-prompt)
-(defvar last-data)
-(defvar call-back)
-(defvar help-string)
-(defvar reftex-refstyle)
+ (list ev reftex-select-data reftex--last-data)))
;; The selection commands
@@ -513,12 +505,12 @@ During a selection process, these are the local bindings.
(defun reftex-select-post-command-hook ()
(let (b e)
(setq reftex-select-data (get-text-property (point) :data))
- (setq last-data (or reftex-select-data last-data))
+ (setq reftex--last-data (or reftex-select-data reftex--last-data))
- (when (and reftex-select-data cb-flag
+ (when (and reftex-select-data reftex--cb-flag
(not (equal reftex-last-follow-point (point))))
(setq reftex-last-follow-point (point))
- (funcall call-back reftex-select-data reftex-callback-fwd
+ (funcall reftex--call-back reftex-select-data reftex-callback-fwd
(not reftex-revisit-to-follow)))
(if reftex-select-data
(setq b (or (previous-single-property-change
@@ -594,7 +586,7 @@ Useful for large TOC's."
"Toggle follow mode: Other window follows with full context."
(interactive)
(setq reftex-last-follow-point -1)
- (setq cb-flag (not cb-flag)))
+ (setq reftex--cb-flag (not reftex--cb-flag)))
(defun reftex-select-cycle-ref-style-internal (&optional reverse)
"Cycle through macros used for referencing.
@@ -632,7 +624,9 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
(defun reftex-select-callback ()
"Show full context in another window."
(interactive)
- (if reftex-select-data (funcall call-back reftex-select-data reftex-callback-fwd nil) (ding)))
+ (if reftex-select-data
+ (funcall reftex--call-back reftex-select-data reftex-callback-fwd nil)
+ (ding)))
(defun reftex-select-accept ()
"Accept the currently selected item."
(interactive)
@@ -642,7 +636,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
(interactive "e")
(mouse-set-point ev)
(setq reftex-select-data (get-text-property (point) :data))
- (setq last-data (or reftex-select-data last-data))
+ (setq reftex--last-data (or reftex-select-data reftex--last-data))
(throw 'myexit 'return))
(defun reftex-select-read-label ()
"Use minibuffer to read a label to reference, with completion."
@@ -652,16 +646,19 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
nil nil reftex-prefix)))
(unless (or (equal label "") (equal label reftex-prefix))
(throw 'myexit label))))
+
+(defvar reftex--found-list)
+
(defun reftex-select-read-cite ()
"Use minibuffer to read a citation key with completion."
(interactive)
- (let* ((key (completing-read "Citation key: " found-list))
- (entry (assoc key found-list)))
+ (let* ((key (completing-read "Citation key: " reftex--found-list))
+ (entry (assoc key reftex--found-list)))
(cond
((or (null key) (equal key "")))
(entry
(setq reftex-select-data entry)
- (setq last-data reftex-select-data)
+ (setq reftex--last-data reftex-select-data)
(throw 'myexit 'return))
(t (throw 'myexit key)))))
@@ -676,14 +673,14 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
(setq boe (or (previous-single-property-change (1+ (point)) :data)
(point-min))
eoe (or (next-single-property-change (point) :data) (point-max)))
- (setq ovl (reftex-make-overlay boe eoe))
+ (setq ovl (make-overlay boe eoe))
(push (list data ovl separator) reftex-select-marked)
- (reftex-overlay-put ovl 'font-lock-face reftex-select-mark-face)
- (reftex-overlay-put ovl 'before-string
- (if separator
- (format "*%c%d* " separator
- (length reftex-select-marked))
- (format "*%d* " (length reftex-select-marked))))
+ (overlay-put ovl 'font-lock-face reftex-select-mark-face)
+ (overlay-put ovl 'before-string
+ (if separator
+ (format "*%c%d* " separator
+ (length reftex-select-marked))
+ (format "*%d* " (length reftex-select-marked))))
(message "Entry has mark no. %d" (length reftex-select-marked))))
(defun reftex-select-mark-comma ()
@@ -709,15 +706,15 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
sep)
(unless cell
(error "No marked entry at point"))
- (and ovl (reftex-delete-overlay ovl))
+ (and ovl (delete-overlay ovl))
(setq reftex-select-marked (delq cell reftex-select-marked))
(setq cnt (1+ (length reftex-select-marked)))
(mapc (lambda (c)
(setq sep (nth 2 c))
- (reftex-overlay-put (nth 1 c) 'before-string
- (if sep
- (format "*%c%d* " sep (cl-decf cnt))
- (format "*%d* " (cl-decf cnt)))))
+ (overlay-put (nth 1 c) 'before-string
+ (if sep
+ (format "*%c%d* " sep (cl-decf cnt))
+ (format "*%d* " (cl-decf cnt)))))
reftex-select-marked)
(message "Entry no longer marked")))
@@ -725,7 +722,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
"Display a summary of the special key bindings."
(interactive)
(with-output-to-temp-buffer "*RefTeX Help*"
- (princ help-string))
+ (princ reftex--help-string))
(reftex-enlarge-to-fit "*RefTeX Help*" t))
(provide 'reftex-sel)
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 3b9f970a3d2..b5643491338 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -1,4 +1,4 @@
-;;; reftex-toc.el --- RefTeX's table of contents mode
+;;; reftex-toc.el --- RefTeX's table of contents mode -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2000, 2003-2021 Free Software Foundation, Inc.
@@ -32,8 +32,7 @@
(defvar reftex-toc-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map (if (featurep 'xemacs) [(button2)] [(mouse-2)])
- 'reftex-toc-mouse-goto-line-and-hide)
+ (define-key map [(mouse-2)] #'reftex-toc-mouse-goto-line-and-hide)
(define-key map [follow-link] 'mouse-face)
(substitute-key-definition
@@ -41,34 +40,34 @@
(substitute-key-definition
'previous-line 'reftex-toc-previous map global-map)
- (define-key map "n" 'reftex-toc-next)
- (define-key map "p" 'reftex-toc-previous)
- (define-key map "?" 'reftex-toc-show-help)
- (define-key map " " 'reftex-toc-view-line)
- (define-key map "\C-m" 'reftex-toc-goto-line-and-hide)
- (define-key map "\C-i" 'reftex-toc-goto-line)
- (define-key map "\C-c>" 'reftex-toc-display-index)
- (define-key map "r" 'reftex-toc-rescan)
- (define-key map "R" 'reftex-toc-Rescan)
- (define-key map "q" 'reftex-toc-quit) ;
- (define-key map "k" 'reftex-toc-quit-and-kill)
- (define-key map "f" 'reftex-toc-toggle-follow) ;
- (define-key map "a" 'reftex-toggle-auto-toc-recenter)
- (define-key map "d" 'reftex-toc-toggle-dedicated-frame)
- (define-key map "F" 'reftex-toc-toggle-file-boundary)
- (define-key map "i" 'reftex-toc-toggle-index)
- (define-key map "l" 'reftex-toc-toggle-labels)
- (define-key map "t" 'reftex-toc-max-level)
- (define-key map "c" 'reftex-toc-toggle-context)
- ;; (define-key map "%" 'reftex-toc-toggle-commented)
- (define-key map "\M-%" 'reftex-toc-rename-label)
- (define-key map "x" 'reftex-toc-external)
- (define-key map "z" 'reftex-toc-jump)
- (define-key map "." 'reftex-toc-show-calling-point)
- (define-key map "\C-c\C-n" 'reftex-toc-next-heading)
- (define-key map "\C-c\C-p" 'reftex-toc-previous-heading)
- (define-key map ">" 'reftex-toc-demote)
- (define-key map "<" 'reftex-toc-promote)
+ (define-key map "n" #'reftex-toc-next)
+ (define-key map "p" #'reftex-toc-previous)
+ (define-key map "?" #'reftex-toc-show-help)
+ (define-key map " " #'reftex-toc-view-line)
+ (define-key map "\C-m" #'reftex-toc-goto-line-and-hide)
+ (define-key map "\C-i" #'reftex-toc-goto-line)
+ (define-key map "\C-c>" #'reftex-toc-display-index)
+ (define-key map "r" #'reftex-toc-rescan)
+ (define-key map "R" #'reftex-toc-Rescan)
+ (define-key map "q" #'reftex-toc-quit) ;
+ (define-key map "k" #'reftex-toc-quit-and-kill)
+ (define-key map "f" #'reftex-toc-toggle-follow) ;
+ (define-key map "a" #'reftex-toggle-auto-toc-recenter)
+ (define-key map "d" #'reftex-toc-toggle-dedicated-frame)
+ (define-key map "F" #'reftex-toc-toggle-file-boundary)
+ (define-key map "i" #'reftex-toc-toggle-index)
+ (define-key map "l" #'reftex-toc-toggle-labels)
+ (define-key map "t" #'reftex-toc-max-level)
+ (define-key map "c" #'reftex-toc-toggle-context)
+ ;; (define-key map "%" #'reftex-toc-toggle-commented)
+ (define-key map "\M-%" #'reftex-toc-rename-label)
+ (define-key map "x" #'reftex-toc-external)
+ (define-key map "z" #'reftex-toc-jump)
+ (define-key map "." #'reftex-toc-show-calling-point)
+ (define-key map "\C-c\C-n" #'reftex-toc-next-heading)
+ (define-key map "\C-c\C-p" #'reftex-toc-previous-heading)
+ (define-key map ">" #'reftex-toc-demote)
+ (define-key map "<" #'reftex-toc-promote)
(easy-menu-define
reftex-toc-menu map
@@ -130,9 +129,7 @@ Here are all local bindings.
\\{reftex-toc-mode-map}"
(set (make-local-variable 'transient-mark-mode) t)
- (when (featurep 'xemacs)
- (set (make-local-variable 'zmacs-regions) t))
- (set (make-local-variable 'revert-buffer-function) 'reftex-toc-revert)
+ (set (make-local-variable 'revert-buffer-function) #'reftex-toc-revert)
(set (make-local-variable 'reftex-toc-include-labels-indicator) "")
(set (make-local-variable 'reftex-toc-max-level-indicator)
(if (= reftex-toc-max-level 100)
@@ -146,15 +143,9 @@ Here are all local bindings.
" T<" 'reftex-toc-max-level-indicator ">"
" -%-"))
(setq truncate-lines t)
- (when (featurep 'xemacs)
- ;; XEmacs needs the call to make-local-hook
- (make-local-hook 'post-command-hook)
- (make-local-hook 'pre-command-hook))
(make-local-variable 'reftex-last-follow-point)
- (add-hook 'post-command-hook 'reftex-toc-post-command-hook nil t)
- (add-hook 'pre-command-hook 'reftex-toc-pre-command-hook nil t)
- (when (featurep 'xemacs)
- (easy-menu-add reftex-toc-menu reftex-toc-mode-map)))
+ (add-hook 'post-command-hook #'reftex-toc-post-command-hook nil t)
+ (add-hook 'pre-command-hook #'reftex-toc-pre-command-hook nil t))
(defvar reftex-last-toc-file nil
"Stores the file name from which `reftex-toc' was called. For redo command.")
@@ -420,7 +411,6 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(defun reftex-toc-next (&optional _arg)
"Move to next selectable item."
(interactive)
- (when (featurep 'xemacs) (setq zmacs-region-stays t))
(setq reftex-callback-fwd t)
(or (eobp) (forward-char 1))
(goto-char (or (next-single-property-change (point) :data)
@@ -428,21 +418,18 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(defun reftex-toc-previous (&optional _arg)
"Move to previous selectable item."
(interactive)
- (when (featurep 'xemacs) (setq zmacs-region-stays t))
(setq reftex-callback-fwd nil)
(goto-char (or (previous-single-property-change (point) :data)
(point))))
(defun reftex-toc-next-heading (&optional arg)
"Move to next table of contents line."
(interactive "p")
- (when (featurep 'xemacs) (setq zmacs-region-stays t))
(end-of-line)
(re-search-forward "^ " nil t arg)
(beginning-of-line))
(defun reftex-toc-previous-heading (&optional arg)
"Move to previous table of contents line."
(interactive "p")
- (when (featurep 'xemacs) (setq zmacs-region-stays t))
(re-search-backward "^ " nil t arg))
(defun reftex-toc-toggle-follow ()
"Toggle follow (other window follows with context)."
@@ -662,7 +649,7 @@ point."
(let* ((reftex--start-line (+ (count-lines (point-min) (point))
(if (bolp) 1 0)))
(reftex--mark-line
- (if (reftex-region-active-p)
+ (if (region-active-p)
(save-excursion (goto-char (mark))
(+ (count-lines (point-min) (point))
(if (bolp) 1 0)))))
@@ -671,7 +658,7 @@ point."
beg end entries data sections nsec msg)
(setq msg
(catch 'exit
- (if (reftex-region-active-p)
+ (if (region-active-p)
;; A region is dangerous, check if we have a brand new scan,
;; to make sure we are not missing any section statements.
(if (not (reftex-toc-check-docstruct))
@@ -712,7 +699,7 @@ point."
nil ; we have permission, do nothing
(error "Abort")) ; abort, we don't have permission
;; Do the changes
- (mapc 'reftex-toc-promote-action entries)
+ (mapc #'reftex-toc-promote-action entries)
;; Rescan the document and rebuilt the toc buffer
(save-window-excursion
(reftex-toc-Rescan))
@@ -734,10 +721,8 @@ point."
(forward-line (1- point-line)))
(when mpos
(set-mark mpos)
- (if (featurep 'xemacs)
- (zmacs-activate-region)
- (setq mark-active t
- deactivate-mark nil)))))
+ (setq mark-active t
+ deactivate-mark nil))))
(defun reftex-toc-promote-prepare (x delta)
"Look at a TOC entry and see if we could pro/demote it.
@@ -918,7 +903,7 @@ label prefix determines the wording of a reference."
(setq match
(let ((where (car toc))
(file (nth 1 toc)))
- (if (or (not no-revisit) (reftex-get-buffer-visiting file))
+ (if (or (not no-revisit) (find-buffer-visiting file))
(progn
(switch-to-buffer-other-window
(reftex-get-file-buffer-force file nil))
@@ -981,7 +966,7 @@ label prefix determines the wording of a reference."
reftex-section-levels-all)))
"[[{]?"))))
((or (not no-revisit)
- (reftex-get-buffer-visiting file))
+ (find-buffer-visiting file))
;; Marker is lost. Use the backup method.
(switch-to-buffer-other-window
(reftex-get-file-buffer-force file nil))
@@ -1035,18 +1020,12 @@ section."
(interactive)
(if reftex-toc-auto-recenter-timer
(progn
- (if (featurep 'xemacs)
- (delete-itimer reftex-toc-auto-recenter-timer)
- (cancel-timer reftex-toc-auto-recenter-timer))
+ (cancel-timer reftex-toc-auto-recenter-timer)
(setq reftex-toc-auto-recenter-timer nil)
(message "Automatic recentering of TOC window was turned off"))
(setq reftex-toc-auto-recenter-timer
- (if (featurep 'xemacs)
- (start-itimer "RefTeX Idle Timer for recenter"
- 'reftex-recenter-toc-when-idle
- reftex-idle-time reftex-idle-time t)
- (run-with-idle-timer
- reftex-idle-time t 'reftex-recenter-toc-when-idle)))
+ (run-with-idle-timer
+ reftex-idle-time t #'reftex-recenter-toc-when-idle))
(message "Automatic recentering of TOC window was turned on")))
(defun reftex-toc-toggle-dedicated-frame ()
@@ -1090,15 +1069,12 @@ always show the current section in connection with the option
(switch-to-buffer "*toc*")
(select-frame current-frame)
(cond ((fboundp 'x-focus-frame)
- (x-focus-frame current-frame))
- ((and (featurep 'xemacs) ; `focus-frame' is a nop in Emacs.
- (fboundp 'focus-frame))
- (focus-frame current-frame)))
+ (x-focus-frame current-frame)))
(select-window current-window)
(when (eq reftex-auto-recenter-toc 'frame)
(unless reftex-toc-auto-recenter-timer
(reftex-toggle-auto-toc-recenter))
- (add-hook 'delete-frame-functions 'reftex-toc-delete-frame-hook)))))
+ (add-hook 'delete-frame-functions #'reftex-toc-delete-frame-hook)))))
(defun reftex-toc-delete-frame-hook (frame)
(if (and reftex-toc-auto-recenter-timer
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 1b29eafabf7..96065ee69e1 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1,4 +1,4 @@
-;;; reftex-vars.el --- configuration variables for RefTeX
+;;; reftex-vars.el --- configuration variables for RefTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-1999, 2001-2021 Free Software Foundation, Inc.
@@ -121,7 +121,7 @@
(regexp "tables?" "tab\\." "Tabellen?"))
("table*" ?t nil nil caption)
- ("\\footnote[]{}" ?n "fn:" "~\\ref{%s}" 2
+ ("\\footnote[]{}" ?n "fn:" "~\\footref{%s}" 2
(regexp "footnotes?" "Fussnoten?"))
("any" ?\ " " "~\\ref{%s}" nil)
@@ -282,7 +282,7 @@ distribution. Mixed-case symbols are convenience aliases.")
The file name is expected after the command, either in braces or separated
by whitespace."
:group 'reftex-table-of-contents-browser
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type '(repeat string))
(defcustom reftex-max-section-depth 12
@@ -319,7 +319,7 @@ commands, promotion only works correctly if this list is sorted first
by set, then within each set by level. The promotion commands always
select the nearest entry with the correct new level."
:group 'reftex-table-of-contents-browser
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type '(repeat
(cons (string :tag "sectioning macro" "")
(choice
@@ -463,7 +463,7 @@ The value of this variable is a list of symbols with associations in the
constant `reftex-label-alist-builtin'. Check that constant for a full list
of options."
:group 'reftex-defining-label-environments
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type `(set
:indent 4
:inline t
@@ -611,7 +611,7 @@ Any list entry may also be a symbol. If that has an association in
list. However, builtin defaults should normally be set with the variable
`reftex-default-label-alist-entries'."
:group 'reftex-defining-label-environments
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type
`(repeat
(choice :tag "Package or Detailed "
@@ -888,50 +888,46 @@ DOWNCASE t: Downcase words before using them."
(string :tag ""))
(option (boolean :tag "Downcase words "))))
-(if (featurep 'xemacs)
- ;; XEmacs 21.5 doesn't have explicitly numbered matching groups,
- ;; so this list mustn't get any more items.
- (defconst reftex-label-regexps '("\\\\label{\\([^}]*\\)}"))
- (defcustom reftex-label-regexps
- `(;; Normal \\label{foo} labels
- "\\\\label{\\(?1:[^}]*\\)}"
- ;; keyvals [..., label = {foo}, ...] forms used by ctable,
- ;; listings, breqn, ...
- ,(concat
- ;; Make sure we search only for optional arguments of
- ;; environments/macros and don't match any other [. ctable
- ;; provides a macro called \ctable, beamer/breqn/listings have
- ;; environments. Start with a backslash and a group for names
- "\\\\\\(?:"
- ;; begin, optional spaces and opening brace
- "begin[[:space:]]*{"
- ;; Build a regexp for env names
- (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
- "darray" "frame"))
- ;; closing brace, optional spaces
- "}[[:space:]]*"
- ;; Now for macros
- "\\|"
- ;; Build a regexp for macro names; currently only \ctable
- (regexp-opt '("ctable"))
- ;; Close the group for names
- "\\)"
- ;; Match the opening [ and the following chars
- "\\[[^][]*"
- ;; Allow nested levels of chars enclosed in braces
- "\\(?:{[^}{]*"
- "\\(?:{[^}{]*"
- "\\(?:{[^}{]*}[^}{]*\\)*"
- "}[^}{]*\\)*"
- "}[^][]*\\)*"
- ;; Match the label key
- "\\<label[[:space:]]*=[[:space:]]*"
- ;; Match the label value; braces around the value are
- ;; optional.
- "{?\\(?1:[^] ,}\r\n\t%]+\\)"
- ;; We are done. Just search until the next closing bracket
- "[^]]*\\]"))
- "List of regexps matching \\label definitions.
+(defcustom reftex-label-regexps
+ `(;; Normal \\label{foo} labels
+ "\\\\label{\\(?1:[^}]*\\)}"
+ ;; keyvals [..., label = {foo}, ...] forms used by ctable,
+ ;; listings, breqn, ...
+ ,(concat
+ ;; Make sure we search only for optional arguments of
+ ;; environments/macros and don't match any other [. ctable
+ ;; provides a macro called \ctable, beamer/breqn/listings have
+ ;; environments. Start with a backslash and a group for names
+ "\\\\\\(?:"
+ ;; begin, optional spaces and opening brace
+ "begin[[:space:]]*{"
+ ;; Build a regexp for env names
+ (regexp-opt '("lstlisting" "dmath" "dseries" "dgroup"
+ "darray" "frame"))
+ ;; closing brace, optional spaces
+ "}[[:space:]]*"
+ ;; Now for macros
+ "\\|"
+ ;; Build a regexp for macro names; currently only \ctable
+ (regexp-opt '("ctable"))
+ ;; Close the group for names
+ "\\)"
+ ;; Match the opening [ and the following chars
+ "\\[[^][]*"
+ ;; Allow nested levels of chars enclosed in braces
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*"
+ "\\(?:{[^}{]*}[^}{]*\\)*"
+ "}[^}{]*\\)*"
+ "}[^][]*\\)*"
+ ;; Match the label key
+ "\\<label[[:space:]]*=[[:space:]]*"
+ ;; Match the label value; braces around the value are
+ ;; optional.
+ "{?\\(?1:[^] ,}\r\n\t%]+\\)"
+ ;; We are done. Just search until the next closing bracket
+ "[^]]*\\]"))
+ "List of regexps matching \\label definitions.
The default value matches usual \\label{...} definitions and
keyval style [..., label = {...}, ...] label definitions. The
regexp for keyval style explicitly looks for environments
@@ -946,13 +942,13 @@ you have to define it using \\(?1:...\\) when adding new regexps.
When changed from Lisp, make sure to call
`reftex-compile-variables' afterwards to make the change
effective."
- :version "28.1"
- :set (lambda (symbol value)
- (set symbol value)
- (when (fboundp 'reftex-compile-variables)
- (reftex-compile-variables)))
- :group 'reftex-defining-label-environments
- :type '(repeat (regexp :tag "Regular Expression"))))
+ :version "28.1"
+ :set (lambda (symbol value)
+ (set symbol value)
+ (when (fboundp 'reftex-compile-variables)
+ (reftex-compile-variables)))
+ :group 'reftex-defining-label-environments
+ :type '(repeat (regexp :tag "Regular Expression")))
(defcustom reftex-label-ignored-macros-and-environments nil
"List of macros and environments to be ignored when searching for labels.
@@ -1063,7 +1059,7 @@ This is used to string together whole reference sets, like
(defcustom reftex-ref-style-alist
'(("Default" t
- (("\\ref" ?\C-m) ("\\Ref" ?R) ("\\pageref" ?p)))
+ (("\\ref" ?\C-m) ("\\Ref" ?R) ("\\footref" ?n) ("\\pageref" ?p)))
("Varioref" "varioref"
(("\\vref" ?v) ("\\Vref" ?V) ("\\vpageref" ?g)))
("Fancyref" "fancyref"
@@ -1083,7 +1079,7 @@ the macro type is being prompted for. (See also
`reftex-ref-macro-prompt'.) The keys, represented as characters,
have to be unique."
:group 'reftex-referencing-labels
- :version "27.1"
+ :version "28.1"
:type '(alist :key-type (string :tag "Style name")
:value-type (group (choice :tag "Package"
(const :tag "Any package" t)
@@ -1198,7 +1194,7 @@ File names matched by these regexps will not be parsed by RefTeX.
Intended for files which contain only `@string' macro definitions and the
like, which are ignored by RefTeX anyway."
:group 'reftex-citation-support
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type '(repeat (regexp)))
(defcustom reftex-default-bibliography nil
@@ -1318,7 +1314,7 @@ macro before insertion. For example, it will change
\\cite[][Chapter 1]{Jones} -> \\cite[Chapter 1]{Jones}
\\cite[see][]{Jones} -> \\cite[see][]{Jones}
\\cite[see][Chapter 1]{Jones} -> \\cite{Jones}
-Is is possible that other packages have other conventions about which
+It is possible that other packages have other conventions about which
optional argument is interpreted how - that is why this cleaning up
can be turned off."
:group 'reftex-citation-support
@@ -1460,7 +1456,7 @@ Note that AUCTeX sets these things internally for RefTeX as well, so
with a sufficiently new version of AUCTeX, you should not set the
package here."
:group 'reftex-index-support
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type `(list
(repeat
:inline t
@@ -1728,7 +1724,7 @@ Multiple directories can be separated by the system dependent `path-separator'.
Directories ending in `//' or `!!' will be expanded recursively.
See also `reftex-use-external-file-finders'."
:group 'reftex-finding-files
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type '(repeat (string :tag "Specification")))
(defcustom reftex-bibpath-environment-variables '("BIBINPUTS" "TEXBIB")
@@ -1744,7 +1740,7 @@ Directories ending in `//' or `!!' will be expanded recursively.
See also `reftex-use-external-file-finders'."
:group 'reftex-citation-support
:group 'reftex-finding-files
- :set 'reftex-set-dirty
+ :set #'reftex-set-dirty
:type '(repeat (string :tag "Specification")))
(defcustom reftex-file-extensions '(("tex" . (".tex" ".ltx"))
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index be9b23677cb..1cb2cf40c3b 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -1,4 +1,4 @@
-;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX
+;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1997-2000, 2003-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
@@ -38,9 +38,8 @@
;;
;; 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
+;; RefTeX is bundled with Emacs.
+;; If you need to install it yourself, you can find a distribution at
;;
;; https://www.gnu.org/software/auctex/reftex.html
;;
@@ -51,7 +50,8 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(require 'easymenu)
+(when (< emacs-major-version 28) ; preloaded in Emacs 28
+ (require 'easymenu))
(defvar reftex-tables-dirty t
"Flag showing if tables need to be re-computed.")
@@ -99,37 +99,34 @@
(defvar reftex-mode-map
(let ((map (make-sparse-keymap)))
;; The default bindings in the mode map.
- (define-key map "\C-c=" 'reftex-toc)
- (define-key map "\C-c-" 'reftex-toc-recenter)
- (define-key map "\C-c(" 'reftex-label)
- (define-key map "\C-c)" 'reftex-reference)
- (define-key map "\C-c[" 'reftex-citation)
- (define-key map "\C-c<" 'reftex-index)
- (define-key map "\C-c>" 'reftex-display-index)
- (define-key map "\C-c/" 'reftex-index-selection-or-word)
- (define-key map "\C-c\\" 'reftex-index-phrase-selection-or-word)
- (define-key map "\C-c|" 'reftex-index-visit-phrases-buffer)
- (define-key map "\C-c&" 'reftex-view-crossref)
+ (define-key map "\C-c=" #'reftex-toc)
+ (define-key map "\C-c-" #'reftex-toc-recenter)
+ (define-key map "\C-c(" #'reftex-label)
+ (define-key map "\C-c)" #'reftex-reference)
+ (define-key map "\C-c[" #'reftex-citation)
+ (define-key map "\C-c<" #'reftex-index)
+ (define-key map "\C-c>" #'reftex-display-index)
+ (define-key map "\C-c/" #'reftex-index-selection-or-word)
+ (define-key map "\C-c\\" #'reftex-index-phrase-selection-or-word)
+ (define-key map "\C-c|" #'reftex-index-visit-phrases-buffer)
+ (define-key map "\C-c&" #'reftex-view-crossref)
;; Bind `reftex-mouse-view-crossref' only when the key is still free
- (if (featurep 'xemacs)
- (unless (key-binding [(shift button2)])
- (define-key map [(shift button2)] 'reftex-mouse-view-crossref))
- (unless (key-binding [(shift mouse-2)])
- (define-key map [(shift mouse-2)] 'reftex-mouse-view-crossref)))
+ (unless (key-binding [(shift mouse-2)])
+ (define-key map [(shift mouse-2)] #'reftex-mouse-view-crossref))
;; For most of these commands there are already bindings in place.
;; Setting `reftex-extra-bindings' really is only there to spare users
;; the hassle of defining bindings in the user space themselves. This
;; is why they violate the key binding recommendations.
(when reftex-extra-bindings
- (define-key map "\C-ct" 'reftex-toc)
- (define-key map "\C-cl" 'reftex-label)
- (define-key map "\C-cr" 'reftex-reference)
- (define-key map "\C-cc" 'reftex-citation)
- (define-key map "\C-cv" 'reftex-view-crossref)
- (define-key map "\C-cg" 'reftex-grep-document)
- (define-key map "\C-cs" 'reftex-search-document))
+ (define-key map "\C-ct" #'reftex-toc)
+ (define-key map "\C-cl" #'reftex-label)
+ (define-key map "\C-cr" #'reftex-reference)
+ (define-key map "\C-cc" #'reftex-citation)
+ (define-key map "\C-cv" #'reftex-view-crossref)
+ (define-key map "\C-cg" #'reftex-grep-document)
+ (define-key map "\C-cs" #'reftex-search-document))
map)
"Keymap for RefTeX mode.")
@@ -203,8 +200,6 @@ on the menu bar.
(if reftex-mode
(progn
;; Mode was turned on
- (when (featurep 'xemacs)
- (easy-menu-add reftex-mode-menu))
(and reftex-plug-into-AUCTeX
(reftex-plug-into-AUCTeX))
(unless (get 'reftex-auto-view-crossref 'initialized)
@@ -219,10 +214,7 @@ on the menu bar.
;; Prepare the special syntax tables.
(reftex--prepare-syntax-tables)
- (run-hooks 'reftex-mode-hook))
- ;; Mode was turned off
- (when (featurep 'xemacs)
- (easy-menu-remove reftex-mode-menu))))
+ (run-hooks 'reftex-mode-hook))))
(defvar reftex-docstruct-symbol)
(defun reftex-kill-buffer-hook ()
@@ -390,11 +382,11 @@ If the symbols for the current master file do not exist, they are created."
((null master)
(error "Need a filename for this buffer, please save it first"))
((or (file-exists-p (concat master ".tex"))
- (reftex-get-buffer-visiting (concat master ".tex")))
+ (find-buffer-visiting (concat master ".tex")))
;; Ahh, an extra .tex was missing...
(setq master (concat master ".tex")))
((or (file-exists-p master)
- (reftex-get-buffer-visiting master))
+ (find-buffer-visiting master))
;; We either see the file, or have a buffer on it. OK.
)
(t
@@ -821,7 +813,7 @@ This enforces rescanning the buffer on next use."
(setq wordlist (nthcdr 4 entry)))
(if (and (stringp fmt)
- (string-match "@" fmt))
+ (string-search "@" fmt))
;; Special syntax for specifying a label format
(setq fmt (split-string fmt "@+"))
(setq fmt (list "\\label{%s}" fmt)))
@@ -889,7 +881,7 @@ This enforces rescanning the buffer on next use."
;; Are the magic words regular expressions? Quote normal words.
(if (eq (car wordlist) 'regexp)
(setq wordlist (cdr wordlist))
- (setq wordlist (mapcar 'regexp-quote wordlist)))
+ (setq wordlist (mapcar #'regexp-quote wordlist)))
;; Remember the first association of each word.
(while (stringp (setq word (pop wordlist)))
(or (assoc word reftex-words-to-typekey-alist)
@@ -1016,11 +1008,11 @@ This enforces rescanning the buffer on next use."
(wbol "\\(^\\)%?[ \t]*") ; Need to keep the empty group because
; match numbers are hard coded
(label-re (concat "\\(?:"
- (mapconcat 'identity reftex-label-regexps "\\|")
+ (mapconcat #'identity reftex-label-regexps "\\|")
"\\)"))
(include-re (concat wbol
"\\\\\\("
- (mapconcat 'identity
+ (mapconcat #'identity
reftex-include-file-commands "\\|")
"\\)[{ \t]+\\([^} \t\n\r]+\\)"))
(section-re
@@ -1032,23 +1024,24 @@ This enforces rescanning the buffer on next use."
(macro-re
(if macros-with-labels
(concat "\\("
- (mapconcat 'regexp-quote macros-with-labels "\\|")
+ (mapconcat #'regexp-quote macros-with-labels "\\|")
"\\)[[{]")
""))
(index-re
(concat "\\("
- (mapconcat 'regexp-quote reftex-macros-with-index "\\|")
+ (mapconcat #'regexp-quote reftex-macros-with-index "\\|")
"\\)[[{]"))
(find-index-re-format
(concat "\\("
- (mapconcat 'regexp-quote reftex-macros-with-index "\\|")
+ (mapconcat #'regexp-quote reftex-macros-with-index "\\|")
"\\)\\([[{][^]}]*[]}]\\)*[[{]\\(%s\\)[]}]"))
(find-label-re-format
(concat "\\("
"label[[:space:]]*=[[:space:]]*"
"\\|"
- (mapconcat 'regexp-quote (append '("\\label")
- macros-with-labels) "\\|")
+ (mapconcat #'regexp-quote (append '("\\label")
+ macros-with-labels)
+ "\\|")
"\\)\\([[{][^]}]*[]}]\\)*[[{]\\(%s\\)[]}]"))
(index-level-re
(regexp-quote (nth 0 reftex-index-special-chars)))
@@ -1080,7 +1073,7 @@ This enforces rescanning the buffer on next use."
"\\([]} \t\n\r]\\)\\([[{]\\)\\(%s\\)[]}]")
(message "Compiling label environment definitions...done")))
(put reftex-docstruct-symbol 'reftex-cache
- (mapcar 'symbol-value reftex-cache-variables)))
+ (mapcar #'symbol-value reftex-cache-variables)))
(defun reftex-parse-args (macro)
;; Return a list of macro name, nargs, arg-nr which is label and a list of
@@ -1276,8 +1269,8 @@ Valid actions are: readable, restore, read, kill, write."
(- 1 xr-index))
(t
(save-excursion
- (let* ((length (apply 'max (mapcar
- (lambda(x) (length (car x))) xr-alist)))
+ (let* ((length (apply #'max (mapcar
+ (lambda(x) (length (car x))) xr-alist)))
(fmt (format " [%%c] %%-%ds %%s\n" length))
(n (1- ?0)))
(setq key
@@ -1311,7 +1304,7 @@ When DIE is non-nil, throw an error if file not found."
(extensions (cdr (assoc type reftex-file-extensions)))
(def-ext (car extensions))
(ext-re (concat "\\("
- (mapconcat 'regexp-quote extensions "\\|")
+ (mapconcat #'regexp-quote extensions "\\|")
"\\)\\'"))
(files (if (string-match ext-re file)
(cons file nil)
@@ -1353,7 +1346,7 @@ When DIE is non-nil, throw an error if file not found."
out)
(if (string-match "%f" prg)
(setq prg (replace-match file t t prg)))
- (setq out (apply 'reftex-process-string (split-string prg)))
+ (setq out (apply #'reftex-process-string (split-string prg)))
(if (string-match "[ \t\n]+\\'" out) ; chomp
(setq out (replace-match "" nil nil out)))
(cond ((equal out "") nil)
@@ -1366,7 +1359,7 @@ When DIE is non-nil, throw an error if file not found."
(with-output-to-string
(with-current-buffer standard-output
(let ((default-directory calling-dir)) ; set default directory
- (apply 'call-process program nil '(t nil) nil args))))))
+ (apply #'call-process program nil '(t nil) nil args))))))
(defun reftex-access-search-path (type &optional recurse master-dir file)
;; Access path from environment variables. TYPE is either "tex" or "bib".
@@ -1385,7 +1378,7 @@ When DIE is non-nil, throw an error if file not found."
(mapconcat
(lambda(x)
(if (string-match "^!" x)
- (apply 'reftex-process-string
+ (apply #'reftex-process-string
(split-string (substring x 1)))
(or (getenv x) x)))
;; For consistency, the next line should look like this:
@@ -1530,12 +1523,7 @@ When DIE is non-nil, throw an error if file not found."
(when (match-beginning n)
(buffer-substring-no-properties (match-beginning n) (match-end n))))
-(defun reftex-region-active-p ()
- "Should we operate on an active region?"
- (if (fboundp 'use-region-p)
- (use-region-p)
- ;; For XEmacs.
- (region-active-p)))
+(define-obsolete-function-alias 'reftex-region-active-p #'use-region-p "28.1")
(defun reftex-kill-buffer (buffer)
;; Kill buffer if it exists.
@@ -1744,26 +1732,12 @@ When DIE is non-nil, throw an error if file not found."
(setq string (replace-match "[\n\r]" nil t string)))
string))
-(defun reftex-get-buffer-visiting (file)
- ;; return a buffer visiting FILE
- (cond
- ((boundp 'find-file-compare-truenames) ; XEmacs
- (let ((find-file-compare-truenames t))
- (get-file-buffer file)))
- ((fboundp 'find-buffer-visiting) ; Emacs
- (find-buffer-visiting file))
- (t (error "This should not happen (reftex-get-buffer-visiting)"))))
-
-;; Define `current-message' for compatibility with XEmacs prior to 20.4
-(defvar message-stack)
-(if (and (featurep 'xemacs)
- (not (fboundp 'current-message)))
- (defun current-message (&optional _frame)
- (cdr (car message-stack))))
+(define-obsolete-function-alias 'reftex-get-buffer-visiting
+ #'find-buffer-visiting "28.1")
(defun reftex-visited-files (list)
;; Takes a list of filenames and returns the buffers of those already visited
- (delq nil (mapcar (lambda (x) (if (reftex-get-buffer-visiting x) x nil))
+ (delq nil (mapcar (lambda (x) (if (find-buffer-visiting x) x nil))
list)))
(defun reftex-get-file-buffer-force (file &optional mark-to-kill)
@@ -1773,7 +1747,7 @@ When DIE is non-nil, throw an error if file not found."
;; initializations according to `reftex-initialize-temporary-buffers',
;; and mark the buffer to be killed after use.
- (let ((buf (reftex-get-buffer-visiting file)))
+ (let ((buf (find-buffer-visiting file)))
(cond (buf
;; We have it already as a buffer - just return it
@@ -1865,7 +1839,7 @@ When DIE is non-nil, throw an error if file not found."
(setq list (copy-sequence list))
(if sort
(progn
- (setq list (sort list 'string<))
+ (setq list (sort list #'string<))
(let ((p list))
(while (cdr p)
(if (string= (car p) (car (cdr p)))
@@ -2002,7 +1976,7 @@ IGNORE-WORDS List of words which should be removed from the string."
(setcdr (nthcdr (1- nwords) words) nil))
;; First, try to use all words
- (setq string (mapconcat 'identity words sep))
+ (setq string (mapconcat #'identity words sep))
;; Abbreviate words if enforced by user settings or string length
(if (or (eq t abbrev)
@@ -2016,7 +1990,7 @@ IGNORE-WORDS List of words which should be removed from the string."
(match-string 1 w))
w))
words)
- string (mapconcat 'identity words sep)))
+ string (mapconcat #'identity words sep)))
;; Shorten if still to long
(setq string
@@ -2080,24 +2054,11 @@ IGNORE-WORDS List of words which should be removed from the string."
(progn
;; Rename buffer temporarily to start w/o space (because of font-lock)
(rename-buffer newname t)
- (cond
- ((fboundp 'font-lock-default-fontify-region)
- ;; Good: we have the indirection functions
- (set (make-local-variable 'font-lock-fontify-region-function)
- 'reftex-select-font-lock-fontify-region)
- (let ((major-mode 'latex-mode))
- (font-lock-mode 1)))
- ((fboundp 'font-lock-set-defaults-1)
- ;; Looks like the XEmacs font-lock stuff.
- ;; FIXME: this is still kind of a hack, but it works.
- (set (make-local-variable 'font-lock-keywords) nil)
- (let ((major-mode 'latex-mode)
- (font-lock-defaults-computed nil))
- (font-lock-set-defaults-1)
- (reftex-select-font-lock-fontify-region (point-min) (point-max))))
- (t
- ;; Oops?
- (message "Sorry: cannot refontify RefTeX Select buffer."))))
+ ;; Good: we have the indirection functions
+ (set (make-local-variable 'font-lock-fontify-region-function)
+ #'reftex-select-font-lock-fontify-region)
+ (let ((major-mode 'latex-mode))
+ (font-lock-mode 1)))
(rename-buffer oldname))))
(defun reftex-select-font-lock-fontify-region (beg end &optional _loudly)
@@ -2122,46 +2083,39 @@ IGNORE-WORDS List of words which should be removed from the string."
(let (face)
(catch 'exit
(while (setq face (pop faces))
- (if (featurep 'xemacs)
- (if (find-face face) (throw 'exit face))
- (if (facep face) (throw 'exit face)))))))
-
-;; Highlighting uses overlays. For XEmacs, we use extends.
-(defalias 'reftex-make-overlay
- (if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'reftex-overlay-put
- (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'reftex-move-overlay
- (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay))
-(defalias 'reftex-delete-overlay
- (if (featurep 'xemacs) 'detach-extent 'delete-overlay))
+ (if (facep face) (throw 'exit face))))))
+
+(define-obsolete-function-alias 'reftex-make-overlay #'make-overlay "28.1")
+(define-obsolete-function-alias 'reftex-overlay-put #'overlay-put "28.1")
+(define-obsolete-function-alias 'reftex-move-overlay #'move-overlay "28.1")
+(define-obsolete-function-alias 'reftex-delete-overlay #'delete-overlay "28.1")
;; We keep a vector with several different overlays to do our highlighting.
(defvar reftex-highlight-overlays [nil nil nil])
;; Initialize the overlays
-(aset reftex-highlight-overlays 0 (reftex-make-overlay 1 1))
-(reftex-overlay-put (aref reftex-highlight-overlays 0)
+(aset reftex-highlight-overlays 0 (make-overlay 1 1))
+(overlay-put (aref reftex-highlight-overlays 0)
'face 'highlight)
-(aset reftex-highlight-overlays 1 (reftex-make-overlay 1 1))
-(reftex-overlay-put (aref reftex-highlight-overlays 1)
+(aset reftex-highlight-overlays 1 (make-overlay 1 1))
+(overlay-put (aref reftex-highlight-overlays 1)
'face reftex-cursor-selected-face)
-(aset reftex-highlight-overlays 2 (reftex-make-overlay 1 1))
-(reftex-overlay-put (aref reftex-highlight-overlays 2)
+(aset reftex-highlight-overlays 2 (make-overlay 1 1))
+(overlay-put (aref reftex-highlight-overlays 2)
'face reftex-cursor-selected-face)
;; Two functions for activating and deactivation highlight overlays
(defun reftex-highlight (index begin end &optional buffer)
"Highlight a region with overlay INDEX."
- (reftex-move-overlay (aref reftex-highlight-overlays index)
+ (move-overlay (aref reftex-highlight-overlays index)
begin end (or buffer (current-buffer))))
(defun reftex-unhighlight (index)
"Detach overlay INDEX."
- (reftex-delete-overlay (aref reftex-highlight-overlays index)))
+ (delete-overlay (aref reftex-highlight-overlays index)))
(defun reftex-highlight-shall-die ()
;; Function used in pre-command-hook to remove highlights.
- (remove-hook 'pre-command-hook 'reftex-highlight-shall-die)
+ (remove-hook 'pre-command-hook #'reftex-highlight-shall-die)
(reftex-unhighlight 0))
;;; =========================================================================
@@ -2173,7 +2127,7 @@ IGNORE-WORDS List of words which should be removed from the string."
;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map
(eval-after-load
"bibtex"
- '(define-key bibtex-mode-map "\C-c&" 'reftex-view-crossref-from-bibtex))
+ '(define-key bibtex-mode-map "\C-c&" #'reftex-view-crossref-from-bibtex))
;;; =========================================================================
;;;
@@ -2378,9 +2332,9 @@ Your bug report will be posted to the AUCTeX bug reporting list.
;;; Install the kill-buffer and kill-emacs hooks ------------------------------
-(add-hook 'kill-buffer-hook 'reftex-kill-buffer-hook)
+(add-hook 'kill-buffer-hook #'reftex-kill-buffer-hook)
(unless noninteractive
- (add-hook 'kill-emacs-hook 'reftex-kill-emacs-hook))
+ (add-hook 'kill-emacs-hook #'reftex-kill-emacs-hook))
;;; Run Hook ------------------------------------------------------------------
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 820ee38d101..fbb66fe40e9 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,4 +1,4 @@
-;;; remember --- a mode for quickly jotting down things to remember
+;;; remember.el --- a mode for quickly jotting down things to remember -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2001, 2003-2021 Free Software Foundation, Inc.
@@ -176,14 +176,8 @@
;;
;; 2003.08.12 Sacha's birthday
-;;; History:
-
;;; Code:
-(defconst remember-version "2.0"
- "This version of remember.")
-(make-obsolete-variable 'remember-version nil "28.1")
-
(defgroup remember nil
"A mode to remember information."
:group 'data)
@@ -193,24 +187,20 @@
(defcustom remember-mode-hook nil
"Functions run upon entering `remember-mode'."
:type 'hook
- :options '(flyspell-mode turn-on-auto-fill org-remember-apply-template)
- :group 'remember)
+ :options '(flyspell-mode turn-on-auto-fill org-remember-apply-template))
(defcustom remember-in-new-frame nil
"Non-nil means use a separate frame for capturing remember data."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
(defcustom remember-register ?R
"The register in which the window configuration is stored."
- :type 'character
- :group 'remember)
+ :type 'character)
(defcustom remember-filter-functions nil
"Functions run to filter remember data.
All functions are run in the remember buffer."
- :type 'hook
- :group 'remember)
+ :type 'hook)
(defcustom remember-handler-functions '(remember-append-to-file)
"Functions run to process remember data.
@@ -223,54 +213,50 @@ recorded somewhere by that function."
remember-append-to-file
remember-store-in-files
remember-diary-extract-entries
- org-remember-handler)
- :group 'remember)
+ org-remember-handler))
(defcustom remember-all-handler-functions nil
"If non-nil every function in `remember-handler-functions' is called."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
;; See below for more user variables.
;;; Internal Variables:
-(defvar remember-buffer "*Remember*"
- "The name of the remember data entry buffer.")
+(defcustom remember-buffer "*Remember*"
+ "The name of the remember data entry buffer."
+ :version "28.1"
+ :type 'string)
(defcustom remember-save-after-remembering t
"Non-nil means automatically save after remembering."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
;;; User Functions:
(defcustom remember-annotation-functions '(buffer-file-name)
"Hook that returns an annotation to be inserted into the remember buffer."
:type 'hook
- :options '(org-remember-annotation buffer-file-name)
- :group 'remember)
+ :options '(org-remember-annotation buffer-file-name))
(defvar remember-annotation nil
"Current annotation.")
(defvar remember-initial-contents nil
- "Initial contents to place into *Remember* buffer.")
+ "Initial contents to place into `remember-buffer'.")
(defcustom remember-before-remember-hook nil
- "Functions run before switching to the *Remember* buffer."
- :type 'hook
- :group 'remember)
+ "Functions run before switching to the `remember-buffer'."
+ :type 'hook)
(defcustom remember-run-all-annotation-functions-flag nil
"Non-nil means use all annotations returned by `remember-annotation-functions'."
- :type 'boolean
- :group 'remember)
+ :type 'boolean)
;;;###autoload
(defun remember (&optional initial)
"Remember an arbitrary piece of data.
-INITIAL is the text to initially place in the *Remember* buffer,
-or nil to bring up a blank *Remember* buffer.
+INITIAL is the text to initially place in the `remember-buffer',
+or nil to bring up a blank `remember-buffer'.
With a prefix or a visible region, use the region as INITIAL."
(interactive
@@ -280,12 +266,13 @@ With a prefix or a visible region, use the region as INITIAL."
(buffer-substring (region-beginning) (region-end)))))
(funcall (if remember-in-new-frame
#'frameset-to-register
- #'window-configuration-to-register) remember-register)
+ #'window-configuration-to-register)
+ remember-register)
(let* ((annotation
(if remember-run-all-annotation-functions-flag
- (mapconcat 'identity
+ (mapconcat #'identity
(delq nil
- (mapcar 'funcall remember-annotation-functions))
+ (mapcar #'funcall remember-annotation-functions))
"\n")
(run-hook-with-args-until-success
'remember-annotation-functions)))
@@ -293,7 +280,8 @@ With a prefix or a visible region, use the region as INITIAL."
(run-hooks 'remember-before-remember-hook)
(funcall (if remember-in-new-frame
#'switch-to-buffer-other-frame
- #'switch-to-buffer-other-window) buf)
+ #'switch-to-buffer-other-window)
+ buf)
(if remember-in-new-frame
(set-window-dedicated-p
(get-buffer-window (current-buffer) (selected-frame)) t))
@@ -337,13 +325,11 @@ With a prefix or a visible region, use the region as INITIAL."
(defcustom remember-mailbox "~/Mail/remember"
"The file in which to store remember data as mail."
- :type 'file
- :group 'remember)
+ :type 'file)
(defcustom remember-default-priority "medium"
"The default priority for remembered mail messages."
- :type 'string
- :group 'remember)
+ :type 'string)
(defun remember-store-in-mailbox ()
"Store remember data as if it were incoming mail.
@@ -396,19 +382,16 @@ exists) might be changed."
(with-current-buffer buf
(set-visited-file-name
(expand-file-name remember-data-file))))))
- :initialize 'custom-initialize-default
- :group 'remember)
+ :initialize #'custom-initialize-default)
(defcustom remember-leader-text "** "
"The text used to begin each remember item."
- :type 'string
- :group 'remember)
+ :type 'string)
(defcustom remember-time-format "%a %b %d %H:%M:%S %Y"
"The format for time stamp, passed to `format-time-string'.
The default emulates `current-time-string' for backward compatibility."
:type 'string
- :group 'remember
:version "27.1")
(defcustom remember-text-format-function nil
@@ -416,7 +399,6 @@ The default emulates `current-time-string' for backward compatibility."
The function receives the remembered text as argument and should
return the text to be remembered."
:type '(choice (const nil) function)
- :group 'remember
:version "28.1")
(defun remember-append-to-file ()
@@ -442,7 +424,7 @@ return the text to be remembered."
(defun remember-region (&optional beg end)
"Remember the data from BEG to END.
-It is called from within the *Remember* buffer to save the text
+It is called from within the `remember-buffer' to save the text
that was entered.
If BEG and END are nil, the entire buffer will be remembered.
@@ -465,16 +447,14 @@ If you want to remember a region, supply a universal prefix to
"The directory in which to store remember data as files.
Used by `remember-store-in-files'."
:type 'directory
- :version "24.4"
- :group 'remember)
+ :version "24.4")
(defcustom remember-directory-file-name-format "%Y-%m-%d_%T-%z"
"Format string for the file name in which to store unprocessed data.
This is passed to `format-time-string'.
Used by `remember-store-in-files'."
:type 'string
- :version "24.4"
- :group 'remember)
+ :version "24.4")
(defun remember-store-in-files ()
"Store remember data in a file in `remember-data-directory'.
@@ -500,7 +480,7 @@ Most useful for remembering things from other applications."
(remember-region (point-min) (point-max)))
(defun remember-destroy ()
- "Destroy the current *Remember* buffer."
+ "Destroy the current `remember-buffer'."
(interactive)
(when (equal remember-buffer (buffer-name))
(kill-buffer (current-buffer))
@@ -511,8 +491,7 @@ Most useful for remembering things from other applications."
(defcustom remember-diary-file nil
"File for extracted diary entries.
If this is nil, then `diary-file' will be used instead."
- :type '(choice (const :tag "diary-file" nil) file)
- :group 'remember)
+ :type '(choice (const :tag "diary-file" nil) file))
(defvar calendar-date-style) ; calendar.el
@@ -560,7 +539,7 @@ If this is nil, then `diary-file' will be used instead."
(while (re-search-forward remember-diary-regexp nil t)
(push (remember-diary-convert-entry (match-string 1)) list))
(when list
- (diary-make-entry (mapconcat 'identity list "\n")
+ (diary-make-entry (mapconcat #'identity list "\n")
nil remember-diary-file)
(when remember-save-after-remembering
(with-current-buffer (find-buffer-visiting (or remember-diary-file
@@ -572,9 +551,9 @@ If this is nil, then `diary-file' will be used instead."
(defvar remember-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" 'remember-finalize)
- (define-key map "\C-c\C-c" 'remember-finalize)
- (define-key map "\C-c\C-k" 'remember-destroy)
+ (define-key map "\C-x\C-s" #'remember-finalize)
+ (define-key map "\C-c\C-c" #'remember-finalize)
+ (define-key map "\C-c\C-k" #'remember-destroy)
map)
"Keymap used in `remember-mode'.")
@@ -620,7 +599,7 @@ If this is nil, use `initial-major-mode'."
(defvar remember-notes-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'remember-notes-save-and-bury-buffer)
+ (define-key map "\C-c\C-c" #'remember-notes-save-and-bury-buffer)
map)
"Keymap used in `remember-notes-mode'.")
@@ -630,7 +609,7 @@ This sets `buffer-save-without-query' so that `save-some-buffers' will
save the notes buffer without asking.
\\{remember-notes-mode-map}"
- nil nil nil
+ :lighter nil
(cond
(remember-notes-mode
(add-hook 'kill-buffer-query-functions
@@ -690,6 +669,11 @@ is non-nil, bury it and return nil; otherwise return t."
nil)
t))
+;; Obsolete
+
+(defconst remember-version "2.0" "This version of remember.")
+(make-obsolete-variable 'remember-version 'emacs-version "28.1")
+
(provide 'remember)
;;; remember.el ends here
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 2b31e7ed612..1471be0ecd6 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -105,10 +105,6 @@
;; Common Lisp stuff
(require 'cl-lib)
-;; Correct wrong declaration.
-(def-edebug-spec push
- (&or [form symbolp] [form gv-place]))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support for `testcover'
@@ -558,30 +554,30 @@ After interpretation of ARGS the results are concatenated as for
`:seq'."
(apply #'concat
(mapcar
- #'(lambda (re)
- (cond
- ((stringp re)
- re)
- ((symbolp re)
- (cadr (assoc re rst-re-alist)))
- ((characterp re)
- (regexp-quote (char-to-string re)))
- ((listp re)
- (let ((nested
- (mapcar #'rst-re (cdr re))))
- (cond
- ((eq (car re) :seq)
- (mapconcat #'identity nested ""))
- ((eq (car re) :shy)
- (concat "\\(?:" (mapconcat #'identity nested "") "\\)"))
- ((eq (car re) :grp)
- (concat "\\(" (mapconcat #'identity nested "") "\\)"))
- ((eq (car re) :alt)
- (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)"))
- (t
- (error "Unknown list car: %s" (car re))))))
- (t
- (error "Unknown object type for building regex: %s" re))))
+ (lambda (re)
+ (cond
+ ((stringp re)
+ re)
+ ((symbolp re)
+ (cadr (assoc re rst-re-alist)))
+ ((characterp re)
+ (regexp-quote (char-to-string re)))
+ ((listp re)
+ (let ((nested
+ (mapcar #'rst-re (cdr re))))
+ (cond
+ ((eq (car re) :seq)
+ (mapconcat #'identity nested ""))
+ ((eq (car re) :shy)
+ (concat "\\(?:" (mapconcat #'identity nested "") "\\)"))
+ ((eq (car re) :grp)
+ (concat "\\(" (mapconcat #'identity nested "") "\\)"))
+ ((eq (car re) :alt)
+ (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)"))
+ (t
+ (error "Unknown list car: %s" (car re))))))
+ (t
+ (error "Unknown object type for building regex: %s" re))))
args)))
;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'.
@@ -620,7 +616,7 @@ After interpretation of ARGS the results are concatenated as for
(:constructor
rst-Ado-new-transition
(&aux
- (char nil)
+ ;; (char nil)
(-style 'transition)))
;; Construct a simple section header.
(:constructor
@@ -713,8 +709,8 @@ Return CHAR if so or signal an error otherwise."
;; testcover: ok.
"Return position of SELF in ADOS or nil."
(cl-check-type self rst-Ado)
- (cl-position-if #'(lambda (e)
- (rst-Ado-equal self e))
+ (cl-position-if (lambda (e)
+ (rst-Ado-equal self e))
ados))
@@ -818,8 +814,8 @@ Return ADO if so or signal an error otherwise."
"Return sublist of HDRS whose car's adornment equals that of SELF or nil."
(cl-check-type self rst-Hdr)
(let ((ado (rst-Hdr-ado self)))
- (cl-member-if #'(lambda (hdr)
- (rst-Ado-equal ado (rst-Hdr-ado hdr)))
+ (cl-member-if (lambda (hdr)
+ (rst-Ado-equal ado (rst-Hdr-ado hdr)))
hdrs)))
(defun rst-Hdr-ado-map (selves)
@@ -1281,8 +1277,8 @@ This inherits from Text mode.")
;; Abbrevs.
(define-abbrev-table 'rst-mode-abbrev-table
- (mapcar #'(lambda (x)
- (append x '(nil 0 system)))
+ (mapcar (lambda (x)
+ (append x '(nil 0 system)))
'(("contents" ".. contents::\n..\n ")
("con" ".. contents::\n..\n ")
("cont" "[...]")
@@ -1412,13 +1408,11 @@ highlighting.
When ReST minor mode is enabled, the ReST mode keybindings
are installed on top of the major mode bindings. Use this
for modes derived from Text mode, like Mail mode."
- ;; The initial value.
- nil
- ;; The indicator for the mode line.
- " ReST"
- ;; The minor mode bindings.
- rst-mode-map
- :group 'rst)
+ ;; The indicator for the mode line.
+ :lighter " ReST"
+ ;; The minor mode bindings.
+ :keymap rst-mode-map
+ :group 'rst)
;; FIXME: can I somehow install these too?
;; :abbrev-table rst-mode-abbrev-table
@@ -1505,9 +1499,9 @@ file."
:type `(repeat
(group :tag "Adornment specification"
(choice :tag "Adornment character"
- ,@(mapcar #'(lambda (char)
- (list 'const
- :tag (char-to-string char) char))
+ ,@(mapcar (lambda (char)
+ (list 'const
+ :tag (char-to-string char) char))
rst-adornment-chars))
(radio :tag "Adornment type"
(const :tag "Overline and underline" over-and-under)
@@ -1544,8 +1538,8 @@ search starts after this entry. Return nil if no new preferred
;; Start searching after the level of the previous adornment.
(cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments))))
(rst-Hdr-preferred-adornments))))
- (cl-find-if #'(lambda (cand)
- (not (rst-Hdr-member-ado cand seen)))
+ (cl-find-if (lambda (cand)
+ (not (rst-Hdr-member-ado cand seen)))
candidates)))
(defun rst-update-section (hdr)
@@ -1624,55 +1618,55 @@ returned."
(ttl-blw ; Title found below starting here.
(rst-forward-line-looking-at
+1 'ttl-beg-1
- #'(lambda (mtcd)
- (when mtcd
- (setq txt-blw (match-string-no-properties 1))
- (point)))))
+ (lambda (mtcd)
+ (when mtcd
+ (setq txt-blw (match-string-no-properties 1))
+ (point)))))
txt-abv
(ttl-abv ; Title found above starting here.
(rst-forward-line-looking-at
-1 'ttl-beg-1
- #'(lambda (mtcd)
- (when mtcd
- (setq txt-abv (match-string-no-properties 1))
- (point)))))
+ (lambda (mtcd)
+ (when mtcd
+ (setq txt-abv (match-string-no-properties 1))
+ (point)))))
(und-fnd ; Matching underline found starting here.
(and ttl-blw
(rst-forward-line-looking-at
+2 (list ado-re 'lin-end)
- #'(lambda (mtcd)
- (when mtcd
- (point))))))
+ (lambda (mtcd)
+ (when mtcd
+ (point))))))
(ovr-fnd ; Matching overline found starting here.
(and ttl-abv
(rst-forward-line-looking-at
-2 (list ado-re 'lin-end)
- #'(lambda (mtcd)
- (when mtcd
- (point))))))
+ (lambda (mtcd)
+ (when mtcd
+ (point))))))
(und-wng ; Wrong underline found starting here.
(and ttl-blw
(not und-fnd)
(rst-forward-line-looking-at
+2 'ado-beg-2-1
- #'(lambda (mtcd)
- (when mtcd
- (point))))))
+ (lambda (mtcd)
+ (when mtcd
+ (point))))))
(ovr-wng ; Wrong overline found starting here.
(and ttl-abv (not ovr-fnd)
(rst-forward-line-looking-at
-2 'ado-beg-2-1
- #'(lambda (mtcd)
- (when (and
- mtcd
- ;; An adornment above may be a legal
- ;; adornment for the line above - consider it
- ;; a wrong overline only when it is equally
- ;; long.
- (equal
- (length (match-string-no-properties 1))
- (length adornment)))
- (point)))))))
+ (lambda (mtcd)
+ (when (and
+ mtcd
+ ;; An adornment above may be a legal
+ ;; adornment for the line above - consider it
+ ;; a wrong overline only when it is equally
+ ;; long.
+ (equal
+ (length (match-string-no-properties 1))
+ (length adornment)))
+ (point)))))))
(cond
((and nxt-emp prv-emp)
;; A transition.
@@ -1712,11 +1706,11 @@ a section header or nil if no title line is found."
(rst-forward-line-strict 0))
(let* (cnd-beg ; Beginning of a title candidate.
cnd-txt ; Text of a title candidate.
- (cnd-fun #'(lambda (mtcd) ; Function setting title candidate data.
- (when mtcd
- (setq cnd-beg (match-beginning 0))
- (setq cnd-txt (match-string-no-properties 1))
- t)))
+ (cnd-fun (lambda (mtcd) ; Function setting title candidate data.
+ (when mtcd
+ (setq cnd-beg (match-beginning 0))
+ (setq cnd-txt (match-string-no-properties 1))
+ t)))
ttl)
(cond
((looking-at (rst-re 'ado-beg-2-1))
@@ -1732,10 +1726,10 @@ a section header or nil if no title line is found."
;; Title line found - check for a following underline.
(setq ttl (rst-forward-line-looking-at
1 'ado-beg-2-1
- #'(lambda (mtcd)
- (when mtcd
- (rst-classify-adornment
- (match-string-no-properties 0) (match-end 0))))))
+ (lambda (mtcd)
+ (when mtcd
+ (rst-classify-adornment
+ (match-string-no-properties 0) (match-end 0))))))
;; Title candidate found if no valid adornment found.
(funcall cnd-fun (not ttl))))
(cond
@@ -1831,15 +1825,15 @@ given."
(ignore-ttl
(if ignore-position
(cl-find-if
- #'(lambda (ttl)
- (equal (rst-Ttl-contains ttl ignore-position) 0))
+ (lambda (ttl)
+ (equal (rst-Ttl-contains ttl ignore-position) 0))
all-ttls)))
(really-ignore
(if ignore-ttl
(<= (cl-count-if
- #'(lambda (ttl)
- (rst-Ado-equal (rst-Ttl-ado ignore-ttl)
- (rst-Ttl-ado ttl)))
+ (lambda (ttl)
+ (rst-Ado-equal (rst-Ttl-ado ignore-ttl)
+ (rst-Ttl-ado ttl)))
all-ttls)
1)))
(real-ttls (delq (if really-ignore ignore-ttl) all-ttls)))
@@ -1863,14 +1857,14 @@ given."
Return a list of (`rst-Ttl' . LEVEL) with ascending line number."
(let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy))))
(mapcar
- #'(lambda (ttl)
- (cons ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)))
+ (lambda (ttl)
+ (cons ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)))
(rst-all-ttls))))
(defun rst-get-previous-hdr ()
"Return the `rst-Hdr' before point or nil if none."
- (let ((prev (cl-find-if #'(lambda (ttl)
- (< (rst-Ttl-contains ttl (point)) 0))
+ (let ((prev (cl-find-if (lambda (ttl)
+ (< (rst-Ttl-contains ttl (point)) 0))
(rst-all-ttls)
:from-end t)))
(and prev (rst-Ttl-hdr prev))))
@@ -2173,19 +2167,19 @@ hierarchy is similar to that used by `rst-adjust-section'."
(let* ((beg (region-beginning))
(end (region-end))
(ttls-reg (cl-remove-if-not
- #'(lambda (ttl)
- (and
- (>= (rst-Ttl-contains ttl beg) 0)
- (< (rst-Ttl-contains ttl end) 0)))
+ (lambda (ttl)
+ (and
+ (>= (rst-Ttl-contains ttl beg) 0)
+ (< (rst-Ttl-contains ttl end) 0)))
(rst-all-ttls))))
(save-excursion
;; Apply modifications.
(rst-destructuring-dolist
((marker &rest hdr
&aux (hier (rst-hdr-hierarchy)))
- (mapcar #'(lambda (ttl)
- (cons (copy-marker (rst-Ttl-get-title-beginning ttl))
- (rst-Ttl-hdr ttl)))
+ (mapcar (lambda (ttl)
+ (cons (copy-marker (rst-Ttl-get-title-beginning ttl))
+ (rst-Ttl-hdr ttl)))
ttls-reg))
(set-marker
(goto-char marker) nil)
@@ -2395,9 +2389,9 @@ also arranged by `rst-insert-list-new-tag'."
"List of favorite bullets."
:group 'rst
:type `(repeat
- (choice ,@(mapcar #'(lambda (char)
- (list 'const
- :tag (char-to-string char) char))
+ (choice ,@(mapcar (lambda (char)
+ (list 'const
+ :tag (char-to-string char) char))
rst-bullets)))
:package-version '(rst . "1.1.0"))
@@ -2521,13 +2515,13 @@ ordered by POINT."
(looking-at (rst-re rst-re-beg)) ; Start found
(not (rst-forward-line-looking-at
-1 'lin-end
- #'(lambda (mtcd) ; Previous line exists and is...
- (and
- (not mtcd) ; non-empty,
- (<= (current-indentation) clm) ; less indented
- (not (and (= (current-indentation) clm)
+ (lambda (mtcd) ; Previous line exists and is...
+ (and
+ (not mtcd) ; non-empty,
+ (<= (current-indentation) clm) ; less indented
+ (not (and (= (current-indentation) clm)
; not a beg at same level.
- (looking-at (rst-re rst-re-beg)))))))))
+ (looking-at (rst-re rst-re-beg)))))))))
(back-to-indentation)
(push (cons (point) clm) r)))
(1value ; At least one line is moved in this loop.
@@ -2557,8 +2551,8 @@ modified."
((bullet _clm &rest pnts)
;; Zip preferred bullets and sorted columns associating a bullet
;; with a column and all the points this column is found.
- (cl-mapcar #'(lambda (bullet clm2pnt)
- (cons bullet clm2pnt))
+ (cl-mapcar (lambda (bullet clm2pnt)
+ (cons bullet clm2pnt))
rst-preferred-bullets
(sort clm2pnts #'car-less-than-car)))
;; Replace the bullets by the preferred ones.
@@ -2618,8 +2612,8 @@ section headers at all."
(when (>= point (rst-Stn-get-title-beginning stn))
;; Point may be in this section or a child.
(let ((in-child (cl-find-if
- #'(lambda (child)
- (>= point (rst-Stn-get-title-beginning child)))
+ (lambda (child)
+ (>= point (rst-Stn-get-title-beginning child)))
(rst-Stn-children stn)
:from-end t)))
(if in-child
@@ -2833,18 +2827,18 @@ file-write hook to always make it up-to-date automatically."
(and beg
(rst-forward-line-looking-at
1 'lin-end
- #'(lambda (mtcd)
- (unless mtcd
- (rst-apply-indented-blocks
- (point) (point-max) (current-indentation)
- #'(lambda (count _in-first _in-sub in-super in-empty
- _relind)
- (cond
- ((or (> count 1) in-super))
- ((not in-empty)
- (setq fnd (line-end-position))
- nil)))))
- t)))
+ (lambda (mtcd)
+ (unless mtcd
+ (rst-apply-indented-blocks
+ (point) (point-max) (current-indentation)
+ (lambda (count _in-first _in-sub in-super in-empty
+ _relind)
+ (cond
+ ((or (> count 1) in-super))
+ ((not in-empty)
+ (setq fnd (line-end-position))
+ nil)))))
+ t)))
(when fnd
(delete-region beg fnd))
(goto-char beg)
@@ -3028,14 +3022,14 @@ direction."
(contained nil) ; Title contains point (or is after point otherwise).
(found (or (cl-position-if
;; Find a title containing or after point.
- #'(lambda (ttl)
- (let ((cmp (rst-Ttl-contains ttl pnt)))
- (cond
- ((= cmp 0) ; Title contains point.
- (setq contained t)
- t)
- ((> cmp 0) ; Title after point.
- t))))
+ (lambda (ttl)
+ (let ((cmp (rst-Ttl-contains ttl pnt)))
+ (cond
+ ((= cmp 0) ; Title contains point.
+ (setq contained t)
+ t)
+ ((> cmp 0) ; Title after point.
+ t))))
ttls)
;; Point after all titles.
count))
@@ -3294,8 +3288,8 @@ remove all indentation (CNT = 0). A tab is taken from the text
above. If no suitable tab is found `rst-indent-width' is used."
(interactive "r\np")
(let ((tabs (sort (rst-compute-tabs beg)
- #'(lambda (x y)
- (<= x y))))
+ (lambda (x y)
+ (<= x y))))
(leftmostcol (rst-find-leftmost-column beg end)))
(when (or (> leftmostcol 0) (> cnt 0))
;; Apply the indent.
@@ -3310,8 +3304,8 @@ above. If no suitable tab is found `rst-indent-width' is used."
(dir (cl-signum cnt)) ; Direction to take.
(abs (abs cnt)) ; Absolute number of steps to take.
;; Get the position of the first tab beyond leftmostcol.
- (fnd (cl-position-if #'(lambda (elt)
- (funcall cmp elt leftmostcol))
+ (fnd (cl-position-if (lambda (elt)
+ (funcall cmp elt leftmostcol))
tabs))
;; Virtual position of tab.
(pos (+ (or fnd len) (1- abs)))
@@ -3496,20 +3490,20 @@ do all lines instead of just paragraphs."
(indent ""))
(rst-apply-indented-blocks
beg end (rst-find-leftmost-column beg end)
- #'(lambda (count in-first in-sub in-super in-empty _relind)
- (cond
- (in-empty)
- (in-super)
- ((zerop count))
- (in-sub
- (insert indent))
- ((or in-first all)
- (let ((tag (format "%d. " (cl-incf enum))))
- (setq indent (make-string (length tag) ? ))
- (insert tag)))
- (t
- (insert indent)))
- nil))))
+ (lambda (count in-first in-sub in-super in-empty _relind)
+ (cond
+ (in-empty)
+ (in-super)
+ ((zerop count))
+ (in-sub
+ (insert indent))
+ ((or in-first all)
+ (let ((tag (format "%d. " (cl-incf enum))))
+ (setq indent (make-string (length tag) ? ))
+ (insert tag)))
+ (t
+ (insert indent)))
+ nil))))
;; FIXME: Does not deal with deeper indentation - although
;; `rst-apply-indented-blocks' could.
@@ -3524,18 +3518,18 @@ do all lines instead of just paragraphs."
(indent (make-string (length bul) ? )))
(rst-apply-indented-blocks
beg end (rst-find-leftmost-column beg end)
- #'(lambda (count in-first in-sub in-super in-empty _relind)
- (cond
- (in-empty)
- (in-super)
- ((zerop count))
- (in-sub
- (insert indent))
- ((or in-first all)
- (insert bul))
- (t
- (insert indent)))
- nil))))
+ (lambda (count in-first in-sub in-super in-empty _relind)
+ (cond
+ (in-empty)
+ (in-super)
+ ((zerop count))
+ (in-sub
+ (insert indent))
+ ((or in-first all)
+ (insert bul))
+ (t
+ (insert indent)))
+ nil))))
;; FIXME: Does not deal with a varying number of digits appropriately.
;; FIXME: Does not deal with multiple levels independently.
@@ -3565,11 +3559,11 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
(let ((ind (rst-find-leftmost-column beg end)))
(rst-apply-indented-blocks
beg end ind
- #'(lambda (_count _in-first _in-sub in-super in-empty _relind)
- (when (and (not in-super) (or with-empty (not in-empty)))
- (move-to-column ind t)
- (insert "| "))
- nil))))
+ (lambda (_count _in-first _in-sub in-super in-empty _relind)
+ (when (and (not in-super) (or with-empty (not in-empty)))
+ (move-to-column ind t)
+ (insert "| "))
+ nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4089,16 +4083,16 @@ end of the buffer) return nil and do not move point."
(setq fnd (rst-apply-indented-blocks
(line-beginning-position 2) ; Skip the current line
(or limit (point-max)) (or column (current-column))
- #'(lambda (_count _in-first _in-sub in-super in-empty _relind)
- (cond
- (in-empty
- (setq candidate (or candidate (line-beginning-position)))
- nil)
- (in-super
- (or candidate (line-beginning-position)))
- (t ; Non-empty, same or more indented line.
- (setq candidate nil)
- nil)))))
+ (lambda (_count _in-first _in-sub in-super in-empty _relind)
+ (cond
+ (in-empty
+ (setq candidate (or candidate (line-beginning-position)))
+ nil)
+ (in-super
+ (or candidate (line-beginning-position)))
+ (t ; Non-empty, same or more indented line.
+ (setq candidate nil)
+ nil)))))
(when fnd
(goto-char fnd))))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 7051f520b90..fda00ec367e 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -34,6 +34,7 @@
(require 'dom)
(require 'seq)
+(require 'facemenu)
(eval-when-compile (require 'subr-x))
(eval-when-compile
(require 'skeleton)
@@ -117,8 +118,7 @@ definitions. So we normally turn it off.")
This takes effect when first loading the `sgml-mode' library.")
(defvar sgml-mode-map
- (let ((map (make-keymap)) ;`sparse' doesn't allow binding to charsets.
- (menu-map (make-sparse-keymap "SGML")))
+ (let ((map (make-keymap))) ;`sparse' doesn't allow binding to charsets.
(define-key map "\C-c\C-i" 'sgml-tags-invisible)
(define-key map "/" 'sgml-slash)
(define-key map "\C-c\C-n" 'sgml-name-char)
@@ -153,26 +153,24 @@ This takes effect when first loading the `sgml-mode' library.")
(map (nth 1 map)))
(while (< (setq c (1+ c)) 256)
(aset map c 'sgml-maybe-name-self)))
- (define-key map [menu-bar sgml] (cons "SGML" menu-map))
- (define-key menu-map [sgml-validate] '("Validate" . sgml-validate))
- (define-key menu-map [sgml-name-8bit-mode]
- '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode))
- (define-key menu-map [sgml-tags-invisible]
- '("Toggle Tag Visibility" . sgml-tags-invisible))
- (define-key menu-map [sgml-tag-help]
- '("Describe Tag" . sgml-tag-help))
- (define-key menu-map [sgml-delete-tag]
- '("Delete Tag" . sgml-delete-tag))
- (define-key menu-map [sgml-skip-tag-forward]
- '("Forward Tag" . sgml-skip-tag-forward))
- (define-key menu-map [sgml-skip-tag-backward]
- '("Backward Tag" . sgml-skip-tag-backward))
- (define-key menu-map [sgml-attributes]
- '("Insert Attributes" . sgml-attributes))
- (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag))
map)
"Keymap for SGML mode. See also `sgml-specials'.")
+(easy-menu-define sgml-mode-menu sgml-mode-map
+ "Menu for SGML mode."
+ '("SGML"
+ ["Insert Tag" sgml-tag]
+ ["Insert Attributes" sgml-attributes]
+ ["Backward Tag" sgml-skip-tag-backward]
+ ["Forward Tag" sgml-skip-tag-forward]
+ ["Delete Tag" sgml-delete-tag]
+ ["Describe Tag" sgml-tag-help]
+ "---"
+ ["Toggle Tag Visibility" sgml-tags-invisible]
+ ["Toggle 8 Bit Insertion" sgml-name-8bit-mode]
+ "---"
+ ["Validate" sgml-validate]))
+
(defun sgml-make-syntax-table (specials)
(let ((table (make-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?< "(>" table)
@@ -192,8 +190,19 @@ This takes effect when first loading the `sgml-mode' library.")
"Syntax table used in SGML mode. See also `sgml-specials'.")
(defconst sgml-tag-syntax-table
- (let ((table (sgml-make-syntax-table sgml-specials)))
- (dolist (char '(?\( ?\) ?\{ ?\} ?\[ ?\] ?$ ?% ?& ?* ?+ ?/))
+ (let ((table (sgml-make-syntax-table sgml-specials))
+ brackets)
+ (map-char-table
+ (lambda (key value)
+ (setq brackets (cons (list
+ (if (consp key)
+ (list (car key) (cdr key))
+ key)
+ value)
+ brackets)))
+ (unicode-property-table-internal 'paired-bracket))
+ (setq brackets (delete-dups (flatten-tree brackets)))
+ (dolist (char (append brackets (list ?$ ?% ?& ?* ?+ ?/)))
(modify-syntax-entry char "." table))
(unless (memq ?' sgml-specials)
;; Avoid that skipping a tag backwards skips any "'" prefixing it.
@@ -625,7 +634,8 @@ Do \\[describe-key] on the following bindings to discover what they do.
(setq-local syntax-propertize-function #'sgml-syntax-propertize)
(setq-local syntax-ppss-table sgml-tag-syntax-table)
(setq-local facemenu-add-face-function 'sgml-mode-facemenu-add-face-function)
- (setq-local sgml-xml-mode (sgml-xml-guess))
+ (when (sgml-xml-guess)
+ (setq-local sgml-xml-mode t))
(unless sgml-xml-mode
(setq-local skeleton-transformation-function sgml-transformation-function))
;; This will allow existing comments within declarations to be
@@ -1788,8 +1798,7 @@ This defaults to `sgml-quick-keys'.
This takes effect when first loading the library.")
(defvar html-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "HTML")))
+ (let ((map (make-sparse-keymap)))
(set-keymap-parent map sgml-mode-map)
(define-key map "\C-c6" 'html-headline-6)
(define-key map "\C-c5" 'html-headline-5)
@@ -1826,34 +1835,35 @@ This takes effect when first loading the library.")
(define-key map "\C-cs" 'html-span))
(define-key map "\C-c\C-s" 'html-autoview-mode)
(define-key map "\C-c\C-v" 'browse-url-of-buffer)
- (define-key map [menu-bar html] (cons "HTML" menu-map))
- (define-key menu-map [html-autoview-mode]
- '("Toggle Autoviewing" . html-autoview-mode))
- (define-key menu-map [browse-url-of-buffer]
- '("View Buffer Contents" . browse-url-of-buffer))
- (define-key menu-map [nil] '("--"))
- ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
- ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
- ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
- (define-key menu-map "3" '("Heading 3" . html-headline-3))
- (define-key menu-map "2" '("Heading 2" . html-headline-2))
- (define-key menu-map "1" '("Heading 1" . html-headline-1))
- (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
- (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
- (define-key menu-map "l" '("List Item" . html-list-item))
- (define-key menu-map "u" '("Unordered List" . html-unordered-list))
- (define-key menu-map "o" '("Ordered List" . html-ordered-list))
- (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
- (define-key menu-map "\n" '("Line Break" . html-line))
- (define-key menu-map "\r" '("Paragraph" . html-paragraph))
- (define-key menu-map "i" '("Image" . html-image))
- (define-key menu-map "h" '("Href Anchor URL" . html-href-anchor))
- (define-key menu-map "f" '("Href Anchor File" . html-href-anchor-file))
- (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
- (define-key menu-map "#" '("ID Anchor" . html-id-anchor))
map)
"Keymap for commands for use in HTML mode.")
+(easy-menu-define html-mode-menu html-mode-map
+ "Menu for HTML mode."
+ '("HTML"
+ ["ID Anchor" html-id-anchor]
+ ["Name Anchor" html-name-anchor]
+ ["Href Anchor File" html-href-anchor-file]
+ ["Href Anchor URL" html-href-anchor]
+ ["Image" html-image]
+ ["Paragraph" html-paragraph]
+ ["Line Break" html-line]
+ ["Horizontal Rule" html-horizontal-rule]
+ ["Ordered List" html-ordered-list]
+ ["Unordered List" html-unordered-list]
+ ["List Item" html-list-item]
+ ["Checkboxes" html-checkboxes]
+ ["Radio Buttons" html-radio-buttons]
+ ["Heading 1" html-headline-1]
+ ["Heading 2" html-headline-2]
+ ["Heading 3" html-headline-3]
+ ;; ["Heading 4" html-headline-4]
+ ;; ["Heading 5" html-headline-5]
+ ;; ["Heading 6" html-headline-6]
+ "---"
+ ["View Buffer Contents" browse-url-of-buffer]
+ ["Toggle Autoviewing" html-autoview-mode]))
+
(defvar html-face-tag-alist
'((bold . "strong")
(italic . "em")
@@ -2370,7 +2380,7 @@ or Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
to them with <a href=\"#SOMENAME\">see also somename</a>. In the same way <a
href=\"URL\">see also URL</a> where URL is a filename relative to current
-directory, or absolute as in `http://www.cs.indiana.edu/elisp/w3/docs.html'.
+directory, or absolute as in `https://www.cs.indiana.edu/elisp/w3/docs.html'.
Images in many formats can be inlined with <img src=\"URL\">.
@@ -2442,7 +2452,7 @@ The third `match-string' will be the used in the menu.")
HTML Autoview mode is a buffer-local minor mode for use with
`html-mode'. If enabled, saving the file automatically runs
`browse-url-of-buffer' to view it."
- nil nil nil
+ :lighter nil
(if html-autoview-mode
(add-hook 'after-save-hook #'browse-url-of-buffer nil t)
(remove-hook 'after-save-hook #'browse-url-of-buffer t)))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 06785e458b2..2dd52b87b79 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -383,7 +383,7 @@
;; There is no artificial-intelligence magic in this package. The
;; definition of a table and the cells inside the table is reasonably
;; limited in order to achieve acceptable performance in the
-;; interactive operation under Emacs lisp implementation. A valid
+;; interactive operation under Emacs Lisp implementation. A valid
;; table is a rectangular text area completely filled with valid
;; cells. A valid cell is a rectangle text area, which four borders
;; consist of valid border characters. Cells can not be nested one to
@@ -1306,17 +1306,16 @@ the last cache point coordinate."
(let ((func-symbol (intern (format "*table--cell-%s" command)))
(doc-string (format "Table remapped function for `%s'." command)))
(defalias func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (let ((table-inhibit-update t)
- (deactivate-mark nil))
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (call-interactively ',command)
- (setq table-inhibit-auto-fill-paragraph t)))))
+ (lambda (&rest _args)
+ (:documentation doc-string)
+ (interactive)
+ (let ((table-inhibit-update t)
+ (deactivate-mark nil))
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (call-interactively command)
+ (setq table-inhibit-auto-fill-paragraph t)))))
(push (cons command func-symbol)
table-command-remap-alist)))
@@ -1338,17 +1337,16 @@ the last cache point coordinate."
(let ((func-symbol (intern (format "*table--cell-%s" command)))
(doc-string (format "Table remapped function for `%s'." command)))
(defalias func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (table--remove-cell-properties (point-min) (point-max))
- (table--remove-eol-spaces (point-min) (point-max))
- (call-interactively ',command))
- (table--finish-delayed-tasks)))
+ (lambda (&rest _args)
+ (:documentation doc-string)
+ (interactive)
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (table--remove-cell-properties (point-min) (point-max))
+ (table--remove-eol-spaces (point-min) (point-max))
+ (call-interactively command))
+ (table--finish-delayed-tasks)))
(push (cons command func-symbol)
table-command-remap-alist)))
@@ -1360,19 +1358,18 @@ the last cache point coordinate."
insert))
(let ((func-symbol (intern (format "*table--cell-%s" command)))
(doc-string (format "Table remapped function for `%s'." command)))
- (fset func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (call-interactively ',command)
- (table--untabify (point-min) (point-max))
- (table--fill-region (point-min) (point-max))
- (setq table-inhibit-auto-fill-paragraph t))
- (table--finish-delayed-tasks)))
+ (defalias func-symbol
+ (lambda (&rest _args)
+ (:documentation doc-string)
+ (interactive)
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (call-interactively command)
+ (table--untabify (point-min) (point-max))
+ (table--fill-region (point-min) (point-max))
+ (setq table-inhibit-auto-fill-paragraph t))
+ (table--finish-delayed-tasks)))
(push (cons command func-symbol)
table-command-remap-alist)))
@@ -1384,18 +1381,17 @@ the last cache point coordinate."
fill-paragraph))
(let ((func-symbol (intern (format "*table--cell-%s" command)))
(doc-string (format "Table remapped function for `%s'." command)))
- (fset func-symbol
- `(lambda
- (&rest args)
- ,doc-string
- (interactive)
- (table--finish-delayed-tasks)
- (table-recognize-cell 'force)
- (table-with-cache-buffer
- (let ((fill-column table-cell-info-width))
- (call-interactively ',command))
- (setq table-inhibit-auto-fill-paragraph t))
- (table--finish-delayed-tasks)))
+ (defalias func-symbol
+ (lambda (&rest _args)
+ (:documentation doc-string)
+ (interactive)
+ (table--finish-delayed-tasks)
+ (table-recognize-cell 'force)
+ (table-with-cache-buffer
+ (let ((fill-column table-cell-info-width))
+ (call-interactively command))
+ (setq table-inhibit-auto-fill-paragraph t))
+ (table--finish-delayed-tasks)))
(push (cons command func-symbol)
table-command-remap-alist)))
@@ -1492,7 +1488,7 @@ Move the point under the table as shown below.
+--------------+------+--------------------------------+
-!-
-Type M-x table-insert-row instead of \\[table-insert-row-column]. \\[table-insert-row-column] does not work
+Type \\[table-insert-row] instead of \\[table-insert-row-column]. \\[table-insert-row-column] does not work
when the point is outside of the table. This insertion at
outside of the table effectively appends a row at the end.
@@ -2915,11 +2911,11 @@ HTML:
URL `https://www.w3.org'
LaTeX:
- URL `http://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
+ URL `https://www.maths.tcd.ie/~dwilkins/LaTeXPrimer/Tables.html'
CALS (DocBook DTD):
- URL `http://www.oasis-open.org/html/a502.htm'
- URL `http://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
+ URL `https://www.oasis-open.org/html/a502.htm'
+ URL `https://www.oreilly.com/catalog/docbook/chapter/book/table.html#AEN114751'
"
(interactive
(let* ((_ (unless (table--probe-cell) (error "Table not found here")))
@@ -2975,8 +2971,8 @@ CALS (DocBook DTD):
(setq col-list (cons (car lu-coordinate) col-list)))
(unless (memq (cdr lu-coordinate) row-list)
(setq row-list (cons (cdr lu-coordinate) row-list))))))
- (setq col-list (sort col-list '<))
- (setq row-list (sort row-list '<))
+ (setq col-list (sort col-list #'<))
+ (setq row-list (sort row-list #'<))
(message "Generating source...")
;; clear the source generation property list
(setplist 'table-source-info-plist nil)
@@ -3023,7 +3019,7 @@ CALS (DocBook DTD):
"")))
((eq language 'latex)
(insert (format "%% This LaTeX table template is generated by emacs %s\n" emacs-version)
- "\\begin{tabular}{|" (apply 'concat (make-list (length col-list) "l|")) "}\n"
+ "\\begin{tabular}{|" (apply #'concat (make-list (length col-list) "l|")) "}\n"
"\\hline\n"))
((eq language 'cals)
(insert (format "<!-- This CALS table template is generated by emacs %s -->\n" emacs-version)
@@ -3054,7 +3050,7 @@ CALS (DocBook DTD):
(set-marker-insertion-type (table-get-source-info 'colspec-marker) t) ;; insert before
(save-excursion
(goto-char (table-get-source-info 'colspec-marker))
- (dolist (col (sort (table-get-source-info 'colnum-list) '<))
+ (dolist (col (sort (table-get-source-info 'colnum-list) #'<))
(insert (format " <colspec colnum=\"%d\" colname=\"c%d\"/>\n" col col))))
(insert (format " </%s>\n </tgroup>\n</table>\n" (table-get-source-info 'row-type))))
((eq language 'mediawiki)
@@ -3852,7 +3848,7 @@ converts a table into plain text without frames. It is a companion to
;; Create the keymap after running the user init file so that the user
;; modification to the global-map is accounted.
-(add-hook 'after-init-hook 'table--make-cell-map t)
+(add-hook 'after-init-hook #'table--make-cell-map t)
(defun *table--cell-self-insert-command ()
"Table cell version of `self-insert-command'."
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index d5a79ad0ac5..c53acf53e7e 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -28,7 +28,6 @@
;;; Code:
-;; Pacify the byte-compiler
(eval-when-compile
(require 'compare-w)
(require 'cl-lib)
@@ -600,11 +599,13 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; Citation args.
(list (concat slash citations opt arg) 3 'font-lock-constant-face)
;;
- ;; Text between `` quotes ''.
- (cons (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t)
- "[^'\">{]+" ;a bit pessimistic
- (regexp-opt '("''" "\">" "\"'" ">>" "»") t))
- 'font-lock-string-face)
+ ;; Text between `` quotes ''.
+ (list (concat (regexp-opt '("``" "\"<" "\"`" "<<" "«") t)
+ "\\(\\(.\\|\n\\)+?\\)"
+ (regexp-opt `("''" "\">" "\"'" ">>" "»") t))
+ '(1 font-lock-keyword-face)
+ '(2 font-lock-string-face)
+ '(4 font-lock-keyword-face))
;;
;; Command names, special and general.
(cons (concat slash specials-1) 'font-lock-warning-face)
@@ -857,11 +858,11 @@ START is the position of the \\ and DELIM is the delimiter char."
(defun tex-define-common-keys (keymap)
"Define the keys that we want defined both in TeX mode and in the TeX shell."
- (define-key keymap "\C-c\C-k" 'tex-kill-job)
- (define-key keymap "\C-c\C-l" 'tex-recenter-output-buffer)
- (define-key keymap "\C-c\C-q" 'tex-show-print-queue)
- (define-key keymap "\C-c\C-p" 'tex-print)
- (define-key keymap "\C-c\C-v" 'tex-view)
+ (define-key keymap "\C-c\C-k" #'tex-kill-job)
+ (define-key keymap "\C-c\C-l" #'tex-recenter-output-buffer)
+ (define-key keymap "\C-c\C-q" #'tex-show-print-queue)
+ (define-key keymap "\C-c\C-p" #'tex-print)
+ (define-key keymap "\C-c\C-v" #'tex-view)
(define-key keymap [menu-bar tex] (cons "TeX" (make-sparse-keymap "TeX")))
@@ -884,27 +885,27 @@ START is the position of the \\ and DELIM is the delimiter char."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
(tex-define-common-keys map)
- (define-key map "\"" 'tex-insert-quote)
- (define-key map "\n" 'tex-handle-newline)
- (define-key map "\M-\r" 'latex-insert-item)
- (define-key map "\C-c}" 'up-list)
- (define-key map "\C-c{" 'tex-insert-braces)
- (define-key map "\C-c\C-r" 'tex-region)
- (define-key map "\C-c\C-b" 'tex-buffer)
- (define-key map "\C-c\C-f" 'tex-file)
- (define-key map "\C-c\C-c" 'tex-compile)
- (define-key map "\C-c\C-i" 'tex-bibtex-file)
- (define-key map "\C-c\C-o" 'latex-insert-block)
+ (define-key map "\"" #'tex-insert-quote)
+ (define-key map "\n" #'tex-handle-newline)
+ (define-key map "\M-\r" #'latex-insert-item)
+ (define-key map "\C-c}" #'up-list)
+ (define-key map "\C-c{" #'tex-insert-braces)
+ (define-key map "\C-c\C-r" #'tex-region)
+ (define-key map "\C-c\C-b" #'tex-buffer)
+ (define-key map "\C-c\C-f" #'tex-file)
+ (define-key map "\C-c\C-c" #'tex-compile)
+ (define-key map "\C-c\C-i" #'tex-bibtex-file)
+ (define-key map "\C-c\C-o" #'latex-insert-block)
;; Redundant keybindings, for consistency with SGML mode.
- (define-key map "\C-c\C-t" 'latex-insert-block)
- (define-key map "\C-c]" 'latex-close-block)
- (define-key map "\C-c/" 'latex-close-block)
-
- (define-key map "\C-c\C-e" 'latex-close-block)
- (define-key map "\C-c\C-u" 'tex-goto-last-unclosed-latex-block)
- (define-key map "\C-c\C-m" 'tex-feed-input)
- (define-key map [(control return)] 'tex-feed-input)
+ (define-key map "\C-c\C-t" #'latex-insert-block)
+ (define-key map "\C-c]" #'latex-close-block)
+ (define-key map "\C-c/" #'latex-close-block)
+
+ (define-key map "\C-c\C-e" #'latex-close-block)
+ (define-key map "\C-c\C-u" #'tex-goto-last-unclosed-latex-block)
+ (define-key map "\C-c\C-m" #'tex-feed-input)
+ (define-key map [(control return)] #'tex-feed-input)
(define-key map [menu-bar tex tex-bibtex-file]
'("BibTeX File" . tex-bibtex-file))
(define-key map [menu-bar tex tex-validate-region]
@@ -922,7 +923,7 @@ START is the position of the \\ and DELIM is the delimiter char."
(defvar latex-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map tex-mode-map)
- (define-key map "\C-c\C-s" 'latex-split-block)
+ (define-key map "\C-c\C-s" #'latex-split-block)
map)
"Keymap for `latex-mode'. See also `tex-mode-map'.")
@@ -1033,11 +1034,11 @@ says which mode to use."
;; received them from someone using AUCTeX).
;;;###autoload
-(defalias 'TeX-mode 'tex-mode)
+(defalias 'TeX-mode #'tex-mode)
;;;###autoload
-(defalias 'plain-TeX-mode 'plain-tex-mode)
+(defalias 'plain-TeX-mode #'plain-tex-mode)
;;;###autoload
-(defalias 'LaTeX-mode 'latex-mode)
+(defalias 'LaTeX-mode #'latex-mode)
;;;###autoload
(define-derived-mode plain-tex-mode tex-mode "TeX"
@@ -1425,20 +1426,25 @@ on the line for the invalidity you want to see."
;; Skip "Mismatches:" header line.
(forward-line 1)
(setq num-matches (1+ num-matches))
- (insert-buffer-substring buffer start end)
- (let (text-beg (text-end (point-marker)))
- (forward-char (- start end))
- (setq text-beg (point-marker))
- (insert (format "%3d: " linenum))
- (add-text-properties
- text-beg (- text-end 1)
- '(mouse-face highlight
- help-echo
- "mouse-2: go to this invalidity"))
- (put-text-property text-beg (- text-end 1)
- 'occur-target tem))))))))
+ (let ((inhibit-read-only t))
+ (insert-buffer-substring buffer start end)
+ (let ((text-end (point-marker))
+ text-beg)
+ (forward-char (- start end))
+ (setq text-beg (point-marker))
+ (insert (format "%3d: " linenum))
+ (add-text-properties
+ text-beg (- text-end 1)
+ '(mouse-face highlight
+ help-echo
+ "mouse-2: go to this invalidity"))
+ (put-text-property (point) (- text-end 1)
+ 'occur-match t)
+ (put-text-property text-beg text-end
+ 'occur-target tem)))))))))
(with-current-buffer standard-output
- (let ((no-matches (zerop num-matches)))
+ (let ((no-matches (zerop num-matches))
+ (inhibit-read-only t))
(if no-matches
(insert "None!\n"))
(if (called-interactively-p 'interactive)
@@ -1560,7 +1566,7 @@ the name of the environment and SKEL-ELEM is an element to use in
a skeleton (see `skeleton-insert').")
;; Like tex-insert-braces, but for LaTeX.
-(defalias 'tex-latex-block 'latex-insert-block)
+(defalias 'tex-latex-block #'latex-insert-block)
(define-skeleton latex-insert-block
"Create a matching pair of lines \\begin{NAME} and \\end{NAME} at point.
Puts point on a blank line between them."
@@ -1866,7 +1872,7 @@ Mark is left at original location."
(with-syntax-table tex-mode-syntax-table
(forward-sexp))))))
-(defalias 'tex-close-latex-block 'latex-close-block)
+(defalias 'tex-close-latex-block #'latex-close-block)
(define-skeleton latex-close-block
"Create an \\end{...} to match the last unclosed \\begin{...}."
(save-excursion
@@ -2008,7 +2014,7 @@ Mark is left at original location."
;; Specify an interactive shell, to make sure it prompts.
"-i")
(let ((proc (get-process "tex-shell")))
- (set-process-sentinel proc 'tex-shell-sentinel)
+ (set-process-sentinel proc #'tex-shell-sentinel)
(set-process-query-on-exit-flag proc nil)
(tex-shell)
(while (zerop (buffer-size))
@@ -2063,10 +2069,10 @@ evaluates to a command string.
Return the process in which TeX is running."
(save-excursion
- (let* ((cmd (eval command))
+ (let* ((cmd (eval command t))
(proc (tex-shell-proc))
(buf (process-buffer proc))
- (star (string-match "\\*" cmd))
+ (star (string-search "*" cmd))
(string
(concat
(if (null file)
@@ -2131,6 +2137,7 @@ If NOT-ALL is non-nil, save the `.dvi' file."
(defvar tex-compile-commands
`(,@(mapcar (lambda (prefix)
`((concat ,prefix tex-command
+ " " tex-start-options
" " (if (< 0 (length tex-start-commands))
(shell-quote-argument tex-start-commands))
" %f")
@@ -2313,7 +2320,7 @@ FILE is typically the output DVI or PDF file."
executable))))))
(defun tex-command-executable (cmd)
- (let ((s (if (stringp cmd) cmd (eval (car cmd)))))
+ (let ((s (if (stringp cmd) cmd (eval (car cmd) t))))
(substring s 0 (string-match "[ \t]\\|\\'" s))))
(defun tex-command-active-p (cmd fspec)
@@ -2400,7 +2407,7 @@ Only applies the FSPEC to the args part of FORMAT."
(setq latest (nth 1 cmd) cmds (list cmd)))))))
;; Expand the command spec into the actual text.
(dolist (cmd (prog1 cmds (setq cmds nil)))
- (push (cons (eval (car cmd)) (cdr cmd)) cmds))
+ (push (cons (eval (car cmd) t) (cdr cmd)) cmds))
;; Select the favorite command from the history.
(let ((hist tex-compile-history)
re hist-cmd)
@@ -2446,7 +2453,7 @@ Only applies the FSPEC to the args part of FORMAT."
(completing-read
(format "Command [%s]: " (tex-summarize-command default))
(mapcar (lambda (x)
- (list (tex-format-cmd (eval (car x)) fspec)))
+ (list (tex-format-cmd (eval (car x) t) fspec)))
tex-compile-commands)
nil nil nil 'tex-compile-history default))))
(save-some-buffers (not compilation-ask-about-save) nil)
@@ -2467,7 +2474,7 @@ Only applies the FSPEC to the args part of FORMAT."
(defun tex-start-tex (command file &optional dir)
"Start a TeX run, using COMMAND on FILE."
- (let* ((star (string-match "\\*" command))
+ (let* ((star (string-search "*" command))
(compile-command
(if star
(concat (substring command 0 star)
@@ -2526,7 +2533,10 @@ The value of `tex-command' specifies the command to use to run TeX."
(file-name-as-directory (expand-file-name tex-directory)))
(tex-out-file (expand-file-name (concat tex-zap-file ".tex")
zap-directory))
- (main-file (expand-file-name (tex-main-file)))
+ ;; We may be running from an unsaved buffer, in which case
+ ;; there's no point in guessing for a main file name.
+ (main-file (and buffer-file-name
+ (expand-file-name (tex-main-file))))
(ismain (string-equal main-file (buffer-file-name)))
already-output)
;; Don't delete temp files if we do the same buffer twice in a row.
@@ -2535,9 +2545,11 @@ The value of `tex-command' specifies the command to use to run TeX."
(let ((default-directory zap-directory)) ; why?
;; We assume the header is fully contained in tex-main-file.
;; We use f-f-ns so we get prompted about any changes on disk.
- (with-current-buffer (find-file-noselect main-file)
- (setq already-output (tex-region-header tex-out-file
- (and ismain beg))))
+ (if (not main-file)
+ (setq already-output 0)
+ (with-current-buffer (find-file-noselect main-file)
+ (setq already-output (tex-region-header tex-out-file
+ (and ismain beg)))))
;; Write out the specified region (but don't repeat anything
;; already written in the header).
(write-region (if ismain
@@ -2740,7 +2752,7 @@ because there is no standard value that would generally work."
;; Restart the TeX shell if necessary.
(or (tex-shell-running)
(tex-start-shell))
- (let ((tex-dvi-print-command (eval tex-dvi-view-command)))
+ (let ((tex-dvi-print-command (eval tex-dvi-view-command t)))
(tex-print)))
(defun tex-append (file-name suffix)
@@ -2766,7 +2778,7 @@ so normally SUFFIX starts with one."
;; Not found, so split on first period.
(concat (file-name-directory file-name)
(substring file 0
- (string-match "\\." file))
+ (string-search "." file))
suffix)))
" "))
@@ -3330,7 +3342,6 @@ There might be text before point."
("\\oplus" . ?⊕)
("\\oslash" . ?⊘)
("\\otimes" . ?⊗)
- ("\\par" . ?
)
("\\parallel" . ?∥)
("\\partial" . ?∂)
("\\perp" . ?⊥)
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index ed0a367d01d..977f3bab6ce 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -1,4 +1,4 @@
-;;; texinfmt.el --- format Texinfo files into Info files
+;;; texinfmt.el --- format Texinfo files into Info files -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2021 Free Software
;; Foundation, Inc.
@@ -23,15 +23,17 @@
;;; Commentary:
-;;; Code:
+;;; Emacs Lisp functions to convert Texinfo files to Info files.
-;;; Emacs lisp functions to convert Texinfo files to Info files.
+;;; Code:
(defvar texinfmt-version "2.42 of 7 Jul 2006")
+(make-obsolete-variable 'texinfmt-version 'emacs-version "28.1")
(defun texinfmt-version (&optional here)
"Show the version of texinfmt.el in the minibuffer.
If optional argument HERE is non-nil, insert info at point."
+ (declare (obsolete emacs-version "28.1"))
(interactive "P")
(let ((version-string
(format-message "Version of `texinfmt.el': %s" texinfmt-version)))
@@ -184,6 +186,7 @@ containing the Texinfo file.")
;; These come from tex-mode.el.
(defvar tex-start-of-header)
(defvar tex-end-of-header)
+(defvar texinfo-example-start)
;;;###autoload
(defun texinfo-format-region (region-beginning region-end)
@@ -209,7 +212,7 @@ converted to Info is stored in a temporary buffer."
texinfo-last-node
texinfo-node-names
(texinfo-footnote-number 0)
- last-input-buffer
+ ;; last-input-buffer
(fill-column-for-info fill-column)
(input-buffer (current-buffer))
(input-directory default-directory)
@@ -345,8 +348,8 @@ converted to Info is stored in a temporary buffer."
(file-name-nondirectory
(buffer-file-name input-buffer))))
(format-message "buffer `%s'" (buffer-name input-buffer)))
- (format-message "\nusing `texinfmt.el' version ")
- texinfmt-version
+ (format-message "\nusing `texinfmt.el' on Emacs version ")
+ emacs-version
".\n\n")
;; Now convert for real.
@@ -403,7 +406,7 @@ if large. You can use `Info-split' to do this manually."
texinfo-stack
texinfo-node-names
(texinfo-footnote-number 0)
- last-input-buffer
+ ;; last-input-buffer
outfile
(fill-column-for-info fill-column)
(input-buffer (current-buffer))
@@ -489,8 +492,8 @@ if large. You can use `Info-split' to do this manually."
(file-name-nondirectory
(buffer-file-name input-buffer))))
(format-message "buffer `%s'" (buffer-name input-buffer)))
- (format-message "\nusing `texinfmt.el' version ")
- texinfmt-version
+ (format-message "\nusing `texinfmt.el' on Emacs version ")
+ emacs-version
".\n\n")
;; Return data for indices.
(list outfile
@@ -922,7 +925,7 @@ commands."
(error "Unterminated @%s" (car (car texinfo-stack)))))
;; Remove excess whitespace
- (let ((whitespace-silent t))
+ (dlet ((whitespace-silent t))
(whitespace-cleanup)))
(defvar texinfo-copying-text ""
@@ -1030,18 +1033,18 @@ Leave point after argument."
(defun texinfo-optional-braces-discard ()
"Discard braces following command, if any."
(goto-char texinfo-command-end)
- (let ((start (point)))
- (cond ((looking-at "[ \t]*\n")) ; do nothing
- ((looking-at "{") ; remove braces, if any
- (forward-list 1)
- (setq texinfo-command-end (point)))
- (t
- (error
- "Invalid `texinfo-optional-braces-discard' format (need braces?)")))
- (delete-region texinfo-command-start texinfo-command-end)))
+ ;; (let ((start (point)))
+ (cond ((looking-at "[ \t]*\n")) ; do nothing
+ ((looking-at "{") ; remove braces, if any
+ (forward-list 1)
+ (setq texinfo-command-end (point)))
+ (t
+ (error
+ "Invalid `texinfo-optional-braces-discard' format (need braces?)")))
+ (delete-region texinfo-command-start texinfo-command-end)) ;;)
(defun texinfo-format-parse-line-args ()
- (let ((start (1- (point)))
+ (let (;; (start (1- (point)))
next beg end
args)
(skip-chars-forward " ")
@@ -1062,7 +1065,7 @@ Leave point after argument."
(nreverse args)))
(defun texinfo-format-parse-args ()
- (let ((start (1- (point)))
+ (let (;; (start (1- (point)))
next beg end
args)
(search-forward "{")
@@ -2005,26 +2008,26 @@ commands that are defined in texinfo.tex for printed output.
;;
;; Case 2: {Column 1 template} {Column 2} {Column 3 example}
((looking-at "{")
- (let ((start-of-templates (point)))
- (while (not (eolp))
- (skip-chars-forward " \t")
- (let* ((start-of-template (1+ (point)))
- (end-of-template
- ;; forward-sexp works with braces in Texinfo mode
- (progn (forward-sexp 1) (1- (point)))))
- (push (- end-of-template start-of-template)
- texinfo-multitable-width-list)
- ;; Remove carriage return from within a template, if any.
- ;; 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))
- (while (search-forward "
+ ;; (let ((start-of-templates (point)))
+ (while (not (eolp))
+ (skip-chars-forward " \t")
+ (let* ((start-of-template (1+ (point)))
+ (end-of-template
+ ;; forward-sexp works with braces in Texinfo mode
+ (progn (forward-sexp 1) (1- (point)))))
+ (push (- end-of-template start-of-template)
+ texinfo-multitable-width-list)
+ ;; Remove carriage return from within a template, if any.
+ ;; 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))
+ (while (search-forward "
" nil t)
- (delete-char -1))
- (goto-char (point-max))
- (widen)
- (forward-char 1)))))
+ (delete-char -1))
+ (goto-char (point-max))
+ (widen)
+ (forward-char 1)))) ;; )
;;
;; Case 3: Trouble
(t
@@ -2038,7 +2041,7 @@ commands that are defined in texinfo.tex for printed output.
;; additional between column spaces, if any
texinfo-extra-inter-column-width
;; sum of spaces for each entry
- (apply '+ texinfo-multitable-width-list))))
+ (apply #'+ texinfo-multitable-width-list))))
(if (> desired-columns fill-column)
(error
"Multi-column table width, %d chars, is greater than page width, %d chars."
@@ -2169,9 +2172,9 @@ This command is executed when texinfmt sees @item inside @multitable."
(while (< column-number total-number-of-columns)
(setq here (point))
(insert-rectangle
- (eval (intern
- (concat texinfo-multitable-rectangle-name
- (int-to-string column-number)))))
+ (symbol-value (intern
+ (concat texinfo-multitable-rectangle-name
+ (int-to-string column-number)))))
(goto-char here)
(end-of-line)
(setq column-number (1+ column-number))))
@@ -2394,8 +2397,8 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image."
(put 'alias 'texinfo-format 'texinfo-alias)
(defun texinfo-alias ()
- (let ((start (1- (point)))
- args)
+ (let (;; (start (1- (point))
+ ) ;; args
(skip-chars-forward " ")
(setq texinfo-command-end (line-end-position))
(if (not (looking-at "\\([^=]+\\)=\\(.*\\)"))
@@ -3408,7 +3411,7 @@ Default is to leave paragraph indentation as is."
(while args
(insert " "
(if (or (= ?& (aref (car args) 0))
- (eq (eval (car texinfo-defun-type)) 'deftp-type))
+ (eq (car texinfo-defun-type) 'deftp-type))
(car args)
(upcase (car args))))
(setq args (cdr args)))))
@@ -3773,80 +3776,80 @@ Default is to leave paragraph indentation as is."
(put 'deffn 'texinfo-format 'texinfo-format-defun)
(put 'deffnx 'texinfo-format 'texinfo-format-defunx)
(put 'deffn 'texinfo-end 'texinfo-end-defun)
-(put 'deffn 'texinfo-defun-type '('deffn-type nil))
-(put 'deffnx 'texinfo-defun-type '('deffn-type nil))
+(put 'deffn 'texinfo-defun-type '(deffn-type nil))
+(put 'deffnx 'texinfo-defun-type '(deffn-type nil))
(put 'deffn 'texinfo-defun-index 'texinfo-findex)
(put 'deffnx 'texinfo-defun-index 'texinfo-findex)
(put 'defun 'texinfo-format 'texinfo-format-defun)
(put 'defunx 'texinfo-format 'texinfo-format-defunx)
(put 'defun 'texinfo-end 'texinfo-end-defun)
-(put 'defun 'texinfo-defun-type '('defun-type "Function"))
-(put 'defunx 'texinfo-defun-type '('defun-type "Function"))
+(put 'defun 'texinfo-defun-type '(defun-type "Function"))
+(put 'defunx 'texinfo-defun-type '(defun-type "Function"))
(put 'defun 'texinfo-defun-index 'texinfo-findex)
(put 'defunx 'texinfo-defun-index 'texinfo-findex)
(put 'defmac 'texinfo-format 'texinfo-format-defun)
(put 'defmacx 'texinfo-format 'texinfo-format-defunx)
(put 'defmac 'texinfo-end 'texinfo-end-defun)
-(put 'defmac 'texinfo-defun-type '('defun-type "Macro"))
-(put 'defmacx 'texinfo-defun-type '('defun-type "Macro"))
+(put 'defmac 'texinfo-defun-type '(defun-type "Macro"))
+(put 'defmacx 'texinfo-defun-type '(defun-type "Macro"))
(put 'defmac 'texinfo-defun-index 'texinfo-findex)
(put 'defmacx 'texinfo-defun-index 'texinfo-findex)
(put 'defspec 'texinfo-format 'texinfo-format-defun)
(put 'defspecx 'texinfo-format 'texinfo-format-defunx)
(put 'defspec 'texinfo-end 'texinfo-end-defun)
-(put 'defspec 'texinfo-defun-type '('defun-type "Special form"))
-(put 'defspecx 'texinfo-defun-type '('defun-type "Special form"))
+(put 'defspec 'texinfo-defun-type '(defun-type "Special form"))
+(put 'defspecx 'texinfo-defun-type '(defun-type "Special form"))
(put 'defspec 'texinfo-defun-index 'texinfo-findex)
(put 'defspecx 'texinfo-defun-index 'texinfo-findex)
(put 'defvr 'texinfo-format 'texinfo-format-defun)
(put 'defvrx 'texinfo-format 'texinfo-format-defunx)
(put 'defvr 'texinfo-end 'texinfo-end-defun)
-(put 'defvr 'texinfo-defun-type '('deffn-type nil))
-(put 'defvrx 'texinfo-defun-type '('deffn-type nil))
+(put 'defvr 'texinfo-defun-type '(deffn-type nil))
+(put 'defvrx 'texinfo-defun-type '(deffn-type nil))
(put 'defvr 'texinfo-defun-index 'texinfo-vindex)
(put 'defvrx 'texinfo-defun-index 'texinfo-vindex)
(put 'defvar 'texinfo-format 'texinfo-format-defun)
(put 'defvarx 'texinfo-format 'texinfo-format-defunx)
(put 'defvar 'texinfo-end 'texinfo-end-defun)
-(put 'defvar 'texinfo-defun-type '('defun-type "Variable"))
-(put 'defvarx 'texinfo-defun-type '('defun-type "Variable"))
+(put 'defvar 'texinfo-defun-type '(defun-type "Variable"))
+(put 'defvarx 'texinfo-defun-type '(defun-type "Variable"))
(put 'defvar 'texinfo-defun-index 'texinfo-vindex)
(put 'defvarx 'texinfo-defun-index 'texinfo-vindex)
(put 'defconst 'texinfo-format 'texinfo-format-defun)
(put 'defconstx 'texinfo-format 'texinfo-format-defunx)
(put 'defconst 'texinfo-end 'texinfo-end-defun)
-(put 'defconst 'texinfo-defun-type '('defun-type "Constant"))
-(put 'defconstx 'texinfo-defun-type '('defun-type "Constant"))
+(put 'defconst 'texinfo-defun-type '(defun-type "Constant"))
+(put 'defconstx 'texinfo-defun-type '(defun-type "Constant"))
(put 'defconst 'texinfo-defun-index 'texinfo-vindex)
(put 'defconstx 'texinfo-defun-index 'texinfo-vindex)
(put 'defcmd 'texinfo-format 'texinfo-format-defun)
(put 'defcmdx 'texinfo-format 'texinfo-format-defunx)
(put 'defcmd 'texinfo-end 'texinfo-end-defun)
-(put 'defcmd 'texinfo-defun-type '('defun-type "Command"))
-(put 'defcmdx 'texinfo-defun-type '('defun-type "Command"))
+(put 'defcmd 'texinfo-defun-type '(defun-type "Command"))
+(put 'defcmdx 'texinfo-defun-type '(defun-type "Command"))
(put 'defcmd 'texinfo-defun-index 'texinfo-findex)
(put 'defcmdx 'texinfo-defun-index 'texinfo-findex)
(put 'defopt 'texinfo-format 'texinfo-format-defun)
(put 'defoptx 'texinfo-format 'texinfo-format-defunx)
(put 'defopt 'texinfo-end 'texinfo-end-defun)
-(put 'defopt 'texinfo-defun-type '('defun-type "User Option"))
-(put 'defoptx 'texinfo-defun-type '('defun-type "User Option"))
+(put 'defopt 'texinfo-defun-type '(defun-type "User Option"))
+(put 'defoptx 'texinfo-defun-type '(defun-type "User Option"))
(put 'defopt 'texinfo-defun-index 'texinfo-vindex)
(put 'defoptx 'texinfo-defun-index 'texinfo-vindex)
(put 'deftp 'texinfo-format 'texinfo-format-defun)
(put 'deftpx 'texinfo-format 'texinfo-format-defunx)
(put 'deftp 'texinfo-end 'texinfo-end-defun)
-(put 'deftp 'texinfo-defun-type '('deftp-type nil))
-(put 'deftpx 'texinfo-defun-type '('deftp-type nil))
+(put 'deftp 'texinfo-defun-type '(deftp-type nil))
+(put 'deftpx 'texinfo-defun-type '(deftp-type nil))
(put 'deftp 'texinfo-defun-index 'texinfo-tindex)
(put 'deftpx 'texinfo-defun-index 'texinfo-tindex)
@@ -3855,32 +3858,32 @@ Default is to leave paragraph indentation as is."
(put 'defop 'texinfo-format 'texinfo-format-defun)
(put 'defopx 'texinfo-format 'texinfo-format-defunx)
(put 'defop 'texinfo-end 'texinfo-end-defun)
-(put 'defop 'texinfo-defun-type '('defop-type nil))
-(put 'defopx 'texinfo-defun-type '('defop-type nil))
+(put 'defop 'texinfo-defun-type '(defop-type nil))
+(put 'defopx 'texinfo-defun-type '(defop-type nil))
(put 'defop 'texinfo-defun-index 'texinfo-findex)
(put 'defopx 'texinfo-defun-index 'texinfo-findex)
(put 'defmethod 'texinfo-format 'texinfo-format-defun)
(put 'defmethodx 'texinfo-format 'texinfo-format-defunx)
(put 'defmethod 'texinfo-end 'texinfo-end-defun)
-(put 'defmethod 'texinfo-defun-type '('defmethod-type "Method"))
-(put 'defmethodx 'texinfo-defun-type '('defmethod-type "Method"))
+(put 'defmethod 'texinfo-defun-type '(defmethod-type "Method"))
+(put 'defmethodx 'texinfo-defun-type '(defmethod-type "Method"))
(put 'defmethod 'texinfo-defun-index 'texinfo-findex)
(put 'defmethodx 'texinfo-defun-index 'texinfo-findex)
(put 'defcv 'texinfo-format 'texinfo-format-defun)
(put 'defcvx 'texinfo-format 'texinfo-format-defunx)
(put 'defcv 'texinfo-end 'texinfo-end-defun)
-(put 'defcv 'texinfo-defun-type '('defop-type nil))
-(put 'defcvx 'texinfo-defun-type '('defop-type nil))
+(put 'defcv 'texinfo-defun-type '(defop-type nil))
+(put 'defcvx 'texinfo-defun-type '(defop-type nil))
(put 'defcv 'texinfo-defun-index 'texinfo-vindex)
(put 'defcvx 'texinfo-defun-index 'texinfo-vindex)
(put 'defivar 'texinfo-format 'texinfo-format-defun)
(put 'defivarx 'texinfo-format 'texinfo-format-defunx)
(put 'defivar 'texinfo-end 'texinfo-end-defun)
-(put 'defivar 'texinfo-defun-type '('defmethod-type "Instance variable"))
-(put 'defivarx 'texinfo-defun-type '('defmethod-type "Instance variable"))
+(put 'defivar 'texinfo-defun-type '(defmethod-type "Instance variable"))
+(put 'defivarx 'texinfo-defun-type '(defmethod-type "Instance variable"))
(put 'defivar 'texinfo-defun-index 'texinfo-vindex)
(put 'defivarx 'texinfo-defun-index 'texinfo-vindex)
@@ -3889,32 +3892,32 @@ Default is to leave paragraph indentation as is."
(put 'deftypefn 'texinfo-format 'texinfo-format-defun)
(put 'deftypefnx 'texinfo-format 'texinfo-format-defunx)
(put 'deftypefn 'texinfo-end 'texinfo-end-defun)
-(put 'deftypefn 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypefnx 'texinfo-defun-type '('deftypefn-type nil))
+(put 'deftypefn 'texinfo-defun-type '(deftypefn-type nil))
+(put 'deftypefnx 'texinfo-defun-type '(deftypefn-type nil))
(put 'deftypefn 'texinfo-defun-index 'texinfo-findex)
(put 'deftypefnx 'texinfo-defun-index 'texinfo-findex)
(put 'deftypefun 'texinfo-format 'texinfo-format-defun)
(put 'deftypefunx 'texinfo-format 'texinfo-format-defunx)
(put 'deftypefun 'texinfo-end 'texinfo-end-defun)
-(put 'deftypefun 'texinfo-defun-type '('deftypefun-type "Function"))
-(put 'deftypefunx 'texinfo-defun-type '('deftypefun-type "Function"))
+(put 'deftypefun 'texinfo-defun-type '(deftypefun-type "Function"))
+(put 'deftypefunx 'texinfo-defun-type '(deftypefun-type "Function"))
(put 'deftypefun 'texinfo-defun-index 'texinfo-findex)
(put 'deftypefunx 'texinfo-defun-index 'texinfo-findex)
(put 'deftypevr 'texinfo-format 'texinfo-format-defun)
(put 'deftypevrx 'texinfo-format 'texinfo-format-defunx)
(put 'deftypevr 'texinfo-end 'texinfo-end-defun)
-(put 'deftypevr 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypevrx 'texinfo-defun-type '('deftypefn-type nil))
+(put 'deftypevr 'texinfo-defun-type '(deftypefn-type nil))
+(put 'deftypevrx 'texinfo-defun-type '(deftypefn-type nil))
(put 'deftypevr 'texinfo-defun-index 'texinfo-vindex)
(put 'deftypevrx 'texinfo-defun-index 'texinfo-vindex)
(put 'deftypevar 'texinfo-format 'texinfo-format-defun)
(put 'deftypevarx 'texinfo-format 'texinfo-format-defunx)
(put 'deftypevar 'texinfo-end 'texinfo-end-defun)
-(put 'deftypevar 'texinfo-defun-type '('deftypevar-type "Variable"))
-(put 'deftypevarx 'texinfo-defun-type '('deftypevar-type "Variable"))
+(put 'deftypevar 'texinfo-defun-type '(deftypevar-type "Variable"))
+(put 'deftypevarx 'texinfo-defun-type '(deftypevar-type "Variable"))
(put 'deftypevar 'texinfo-defun-index 'texinfo-vindex)
(put 'deftypevarx 'texinfo-defun-index 'texinfo-vindex)
@@ -3941,7 +3944,8 @@ Default is to leave paragraph indentation as is."
"Clear the value of the flag."
(let* ((arg (texinfo-parse-arg-discard))
(flag (car (read-from-string arg)))
- (value (substring arg (cdr (read-from-string arg)))))
+ ;; (value (substring arg (cdr (read-from-string arg))))
+ )
(put flag 'texinfo-whether-setp 'flag-cleared)
(put flag 'texinfo-set-value "")))
@@ -4041,7 +4045,7 @@ the @ifeq command."
(goto-char texinfo-command-end)
(let* ((case-fold-search t)
(stop (save-excursion (forward-sexp 1) (point)))
- start end
+ start ;; end
;; @ifeq{arg1, arg2, @command{optional-args}}
(arg1
(progn
@@ -4306,8 +4310,6 @@ For example, invoke
(setq error 1))))
(kill-emacs error))))
-
-;;; Place `provide' at end of file.
(provide 'texinfmt)
;;; texinfmt.el ends here
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 7799cdb5529..11d60e1eb03 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -1,4 +1,4 @@
-;;; texinfo.el --- major mode for editing Texinfo files
+;;; texinfo.el --- major mode for editing Texinfo files -*- lexical-binding: t; -*-
;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2021 Free Software
;; Foundation, Inc.
@@ -54,220 +54,27 @@
;;;###autoload
(defcustom texinfo-open-quote (purecopy "``")
"String inserted by typing \\[texinfo-insert-quote] to open a quotation."
- :type 'string
- :group 'texinfo)
+ :type 'string)
;;;###autoload
(defcustom texinfo-close-quote (purecopy "''")
"String inserted by typing \\[texinfo-insert-quote] to close a quotation."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-mode-hook nil
"Normal hook run when entering Texinfo mode."
:type 'hook
- :options '(turn-on-auto-fill flyspell-mode)
- :group 'texinfo)
+ :options '(turn-on-auto-fill flyspell-mode))
;;; Autoloads:
-(autoload 'makeinfo-region
- "makeinfo"
- "Make Info file from region of current Texinfo file, and switch to it.
-
-This command does not offer the `next-error' feature since it would
-apply to a temporary file, not the original; use the `makeinfo-buffer'
-command to gain use of `next-error'."
- t nil)
-
-(autoload 'makeinfo-buffer
- "makeinfo"
- "Make Info file from current buffer.
-
-Use the \\[next-error] command to move to the next error
-\(if there are errors)."
- t nil)
-
(autoload 'kill-compilation
"compile"
"Kill the process made by the \\[compile] command."
t nil)
-(autoload 'makeinfo-recenter-compilation-buffer
- "makeinfo"
- "Redisplay `*compilation*' buffer so most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
- t nil)
-
-(autoload 'texinfo-update-node
- "texnfo-upd"
- "Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-The functions for creating or updating nodes and menus, and their
-keybindings, are:
-
- `texinfo-update-node' (&optional region-p) \\[texinfo-update-node]
- `texinfo-every-node-update' () \\[texinfo-every-node-update]
- `texinfo-sequential-node-update' (&optional region-p)
-
- `texinfo-make-menu' (&optional region-p) \\[texinfo-make-menu]
- `texinfo-all-menus-update' () \\[texinfo-all-menus-update]
- `texinfo-master-menu' ()
-
- `texinfo-indent-menu-description' (column &optional region-p)
-
-The `texinfo-column-for-description' variable specifies the column to
-which menu descriptions are indented. Its default value is 32."
- t nil)
-
-(autoload 'texinfo-every-node-update
- "texnfo-upd"
- "Update every node in a Texinfo file."
- t nil)
-
-(autoload 'texinfo-sequential-node-update
- "texnfo-upd"
- "Update one node (or many) in a Texinfo file with sequential pointers.
-
-This function causes the `Next' or `Previous' pointer to point to the
-immediately preceding or following node, even if it is at a higher or
-lower hierarchical level in the document. Continually pressing `n' or
-`p' takes you straight through the file.
-
-Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-This command makes it awkward to navigate among sections and
-subsections; it should be used only for those documents that are meant
-to be read like a novel rather than a reference, and for which the
-Info `g*' command is inadequate."
- t nil)
-
-(autoload 'texinfo-make-menu
- "texnfo-upd"
- "Without any prefix argument, make or update a menu.
-Make the menu for the section enclosing the node found following point.
-
-Non-nil argument (prefix, if interactive) means make or update menus
-for nodes within or part of the marked region.
-
-Whenever a menu exists, and is being updated, the descriptions that
-are associated with node names in the pre-existing menu are
-incorporated into the new menu. Otherwise, the nodes' section titles
-are inserted as descriptions."
- t nil)
-
-(autoload 'texinfo-all-menus-update
- "texnfo-upd"
- "Update every regular menu in a Texinfo file.
-Remove pre-existing master menu, if there is one.
-
-If called with a non-nil argument, this function first updates all the
-nodes in the buffer before updating the menus."
- t nil)
-
-(autoload 'texinfo-master-menu
- "texnfo-upd"
- "Make a master menu for a whole Texinfo file.
-Non-nil argument (prefix, if interactive) means first update all
-existing nodes and menus. Remove pre-existing master menu, if there is one.
-
-This function creates a master menu that follows the top node. The
-master menu includes every entry from all the other menus. It
-replaces any existing ordinary menu that follows the top node.
-
-If called with a non-nil argument, this function first updates all the
-menus in the buffer (incorporating descriptions from pre-existing
-menus) before it constructs the master menu.
-
-The function removes the detailed part of an already existing master
-menu. This action depends on the pre-existing master menu using the
-standard `texinfo-master-menu-header'.
-
-The master menu has the following format, which is adapted from the
-recommendation in the Texinfo Manual:
-
- * The first part contains the major nodes in the Texinfo file: the
- nodes for the chapters, chapter-like sections, and the major
- appendices. This includes the indices, so long as they are in
- chapter-like sections, such as unnumbered sections.
-
- * The second and subsequent parts contain a listing of the other,
- lower level menus, in order. This way, an inquirer can go
- directly to a particular node if he or she is searching for
- specific information.
-
-Each of the menus in the detailed node listing is introduced by the
-title of the section containing the menu."
- t nil)
-
-(autoload 'texinfo-indent-menu-description
- "texnfo-upd"
- "Indent every description in menu following point to COLUMN.
-Non-nil argument (prefix, if interactive) means indent every
-description in every menu in the region. Does not indent second and
-subsequent lines of a multi-line description."
- t nil)
-
-(autoload 'texinfo-insert-node-lines
- "texnfo-upd"
- "Insert missing `@node' lines in region of Texinfo file.
-Non-nil argument (prefix, if interactive) means also to insert the
-section titles as node names; and also to insert the section titles as
-node names in pre-existing @node lines that lack names."
- t nil)
-
-(autoload 'texinfo-start-menu-description
- "texnfo-upd"
- "In this menu entry, insert the node's section title as a description.
-Position point at beginning of description ready for editing.
-Do not insert a title if the line contains an existing description.
-
-You will need to edit the inserted text since a useful description
-complements the node name rather than repeats it as a title does."
- t nil)
-
-(autoload 'texinfo-multiple-files-update
- "texnfo-upd"
- "Update first node pointers in each file included in OUTER-FILE;
-create or update main menu in the outer file that refers to such nodes.
-This does not create or update menus or pointers within the included files.
-
-With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
-insert a master menu in OUTER-FILE. This does not create or update
-menus or pointers within the included files.
-
-With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
-interactive), update all the menus and all the `Next', `Previous', and
-`Up' pointers of all the files included in OUTER-FILE before inserting
-a master menu in OUTER-FILE.
-
-The command also updates the `Top' level node pointers of OUTER-FILE.
-
-Notes:
-
- * this command does NOT save any files--you must save the
- outer file and any modified, included files.
-
- * except for the `Top' node, this command does NOT handle any
- pre-existing nodes in the outer file; hence, indices must be
- enclosed in an included file.
-
-Requirements:
-
- * each of the included files must contain exactly one highest
- hierarchical level node,
- * this highest node must be the first node in the included file,
- * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one,
-chapter."
- t nil)
+(require 'texinfo-loaddefs)
;;; Code:
@@ -349,8 +156,7 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
(defface texinfo-heading
'((t (:inherit font-lock-function-name-face)))
- "Face used for section headings in `texinfo-mode'."
- :group 'texinfo)
+ "Face used for section headings in `texinfo-mode'.")
(defvar texinfo-font-lock-keywords
`(;; All but the first had an OVERRIDE of t.
@@ -377,7 +183,7 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
("@\\(end\\|itemx?\\) +\\(.+\\)" 2 font-lock-keyword-face keep)
;; (,texinfo-environment-regexp
;; 1 (texinfo-clone-environment (match-beginning 1) (match-end 1)) keep)
- (,(concat "^@" (regexp-opt (mapcar 'car texinfo-section-list) t)
+ (,(concat "^@" (regexp-opt (mapcar #'car texinfo-section-list) t)
".*\n")
0 'texinfo-heading t))
"Additional expressions to highlight in Texinfo mode.")
@@ -404,19 +210,21 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
;;; Keys common both to Texinfo mode and to TeX shell.
+(declare-function tex-show-print-queue "tex-mode" ())
+
(defun texinfo-define-common-keys (keymap)
"Define the keys both in Texinfo mode and in the texinfo-tex-shell."
- (define-key keymap "\C-c\C-t\C-k" 'tex-kill-job)
- (define-key keymap "\C-c\C-t\C-x" 'texinfo-quit-job)
- (define-key keymap "\C-c\C-t\C-l" 'tex-recenter-output-buffer)
- (define-key keymap "\C-c\C-t\C-d" 'texinfo-delete-from-print-queue)
- (define-key keymap "\C-c\C-t\C-q" 'tex-show-print-queue)
- (define-key keymap "\C-c\C-t\C-p" 'texinfo-tex-print)
- (define-key keymap "\C-c\C-t\C-v" 'texinfo-tex-view)
- (define-key keymap "\C-c\C-t\C-i" 'texinfo-texindex)
-
- (define-key keymap "\C-c\C-t\C-r" 'texinfo-tex-region)
- (define-key keymap "\C-c\C-t\C-b" 'texinfo-tex-buffer))
+ (define-key keymap "\C-c\C-t\C-k" #'tex-kill-job)
+ (define-key keymap "\C-c\C-t\C-x" #'texinfo-quit-job)
+ (define-key keymap "\C-c\C-t\C-l" #'tex-recenter-output-buffer)
+ (define-key keymap "\C-c\C-t\C-d" #'texinfo-delete-from-print-queue)
+ (define-key keymap "\C-c\C-t\C-q" #'tex-show-print-queue)
+ (define-key keymap "\C-c\C-t\C-p" #'texinfo-tex-print)
+ (define-key keymap "\C-c\C-t\C-v" #'texinfo-tex-view)
+ (define-key keymap "\C-c\C-t\C-i" #'texinfo-texindex)
+
+ (define-key keymap "\C-c\C-t\C-r" #'texinfo-tex-region)
+ (define-key keymap "\C-c\C-t\C-b" #'texinfo-tex-buffer))
;; Mode documentation displays commands in reverse order
;; from how they are listed in the texinfo-mode-map.
@@ -427,68 +235,68 @@ Subexpression 1 is what goes into the corresponding `@end' statement.")
;; bindings for `texnfo-tex.el'
(texinfo-define-common-keys map)
- (define-key map "\"" 'texinfo-insert-quote)
+ (define-key map "\"" #'texinfo-insert-quote)
;; bindings for `makeinfo.el'
- (define-key map "\C-c\C-m\C-k" 'kill-compilation)
+ (define-key map "\C-c\C-m\C-k" #'kill-compilation)
(define-key map "\C-c\C-m\C-l"
- 'makeinfo-recenter-compilation-buffer)
- (define-key map "\C-c\C-m\C-r" 'makeinfo-region)
- (define-key map "\C-c\C-m\C-b" 'makeinfo-buffer)
+ #'makeinfo-recenter-compilation-buffer)
+ (define-key map "\C-c\C-m\C-r" #'makeinfo-region)
+ (define-key map "\C-c\C-m\C-b" #'makeinfo-buffer)
;; bindings for `texinfmt.el'
- (define-key map "\C-c\C-e\C-r" 'texinfo-format-region)
- (define-key map "\C-c\C-e\C-b" 'texinfo-format-buffer)
+ (define-key map "\C-c\C-e\C-r" #'texinfo-format-region)
+ (define-key map "\C-c\C-e\C-b" #'texinfo-format-buffer)
;; AUCTeX-like bindings
- (define-key map "\e\r" 'texinfo-insert-@item)
+ (define-key map "\e\r" #'texinfo-insert-@item)
;; bindings for updating nodes and menus
- (define-key map "\C-c\C-um" 'texinfo-master-menu)
+ (define-key map "\C-c\C-um" #'texinfo-master-menu)
- (define-key map "\C-c\C-u\C-m" 'texinfo-make-menu)
- (define-key map "\C-c\C-u\C-n" 'texinfo-update-node)
- (define-key map "\C-c\C-u\C-e" 'texinfo-every-node-update)
- (define-key map "\C-c\C-u\C-a" 'texinfo-all-menus-update)
+ (define-key map "\C-c\C-u\C-m" #'texinfo-make-menu)
+ (define-key map "\C-c\C-u\C-n" #'texinfo-update-node)
+ (define-key map "\C-c\C-u\C-e" #'texinfo-every-node-update)
+ (define-key map "\C-c\C-u\C-a" #'texinfo-all-menus-update)
- (define-key map "\C-c\C-s" 'texinfo-show-structure)
+ (define-key map "\C-c\C-s" #'texinfo-show-structure)
- (define-key map "\C-c}" 'up-list)
+ (define-key map "\C-c}" #'up-list)
;; FIXME: This is often used for "close block" aka texinfo-insert-@end.
- (define-key map "\C-c]" 'up-list)
- (define-key map "\C-c/" 'texinfo-insert-@end)
- (define-key map "\C-c{" 'texinfo-insert-braces)
+ (define-key map "\C-c]" #'up-list)
+ (define-key map "\C-c/" #'texinfo-insert-@end)
+ (define-key map "\C-c{" #'texinfo-insert-braces)
;; bindings for inserting strings
- (define-key map "\C-c\C-o" 'texinfo-insert-block)
- (define-key map "\C-c\C-c\C-d" 'texinfo-start-menu-description)
- (define-key map "\C-c\C-c\C-s" 'texinfo-insert-@strong)
- (define-key map "\C-c\C-c\C-e" 'texinfo-insert-@emph)
-
- (define-key map "\C-c\C-cv" 'texinfo-insert-@var)
- (define-key map "\C-c\C-cu" 'texinfo-insert-@uref)
- (define-key map "\C-c\C-ct" 'texinfo-insert-@table)
- (define-key map "\C-c\C-cs" 'texinfo-insert-@samp)
- (define-key map "\C-c\C-cr" 'texinfo-insert-dwim-@ref)
- (define-key map "\C-c\C-cq" 'texinfo-insert-@quotation)
- (define-key map "\C-c\C-co" 'texinfo-insert-@noindent)
- (define-key map "\C-c\C-cn" 'texinfo-insert-@node)
- (define-key map "\C-c\C-cm" 'texinfo-insert-@email)
- (define-key map "\C-c\C-ck" 'texinfo-insert-@kbd)
- (define-key map "\C-c\C-ci" 'texinfo-insert-@item)
- (define-key map "\C-c\C-cf" 'texinfo-insert-@file)
- (define-key map "\C-c\C-cx" 'texinfo-insert-@example)
- (define-key map "\C-c\C-ce" 'texinfo-insert-@end)
- (define-key map "\C-c\C-cd" 'texinfo-insert-@dfn)
- (define-key map "\C-c\C-cc" 'texinfo-insert-@code)
+ (define-key map "\C-c\C-o" #'texinfo-insert-block)
+ (define-key map "\C-c\C-c\C-d" #'texinfo-start-menu-description)
+ (define-key map "\C-c\C-c\C-s" #'texinfo-insert-@strong)
+ (define-key map "\C-c\C-c\C-e" #'texinfo-insert-@emph)
+
+ (define-key map "\C-c\C-cv" #'texinfo-insert-@var)
+ (define-key map "\C-c\C-cu" #'texinfo-insert-@uref)
+ (define-key map "\C-c\C-ct" #'texinfo-insert-@table)
+ (define-key map "\C-c\C-cs" #'texinfo-insert-@samp)
+ (define-key map "\C-c\C-cr" #'texinfo-insert-dwim-@ref)
+ (define-key map "\C-c\C-cq" #'texinfo-insert-@quotation)
+ (define-key map "\C-c\C-co" #'texinfo-insert-@noindent)
+ (define-key map "\C-c\C-cn" #'texinfo-insert-@node)
+ (define-key map "\C-c\C-cm" #'texinfo-insert-@email)
+ (define-key map "\C-c\C-ck" #'texinfo-insert-@kbd)
+ (define-key map "\C-c\C-ci" #'texinfo-insert-@item)
+ (define-key map "\C-c\C-cf" #'texinfo-insert-@file)
+ (define-key map "\C-c\C-cx" #'texinfo-insert-@example)
+ (define-key map "\C-c\C-ce" #'texinfo-insert-@end)
+ (define-key map "\C-c\C-cd" #'texinfo-insert-@dfn)
+ (define-key map "\C-c\C-cc" #'texinfo-insert-@code)
;; bindings for environment movement
- (define-key map "\C-c." 'texinfo-to-environment-bounds)
- (define-key map "\C-c\C-c\C-f" 'texinfo-next-environment-end)
- (define-key map "\C-c\C-c\C-b" 'texinfo-previous-environment-end)
- (define-key map "\C-c\C-c\C-n" 'texinfo-next-environment-start)
- (define-key map "\C-c\C-c\C-p" 'texinfo-previous-environment-start)
+ (define-key map "\C-c." #'texinfo-to-environment-bounds)
+ (define-key map "\C-c\C-c\C-f" #'texinfo-next-environment-end)
+ (define-key map "\C-c\C-c\C-b" #'texinfo-previous-environment-end)
+ (define-key map "\C-c\C-c\C-n" #'texinfo-next-environment-start)
+ (define-key map "\C-c\C-c\C-p" #'texinfo-previous-environment-start)
map))
(easy-menu-define texinfo-mode-menu
@@ -628,7 +436,7 @@ value of `texinfo-mode-hook'."
(mapcar (lambda (x) (cons (concat "@" (car x)) (cadr x)))
texinfo-section-list))
(setq-local outline-regexp
- (concat (regexp-opt (mapcar 'car outline-heading-alist) t)
+ (concat (regexp-opt (mapcar #'car outline-heading-alist) t)
"\\>"))
(setq-local tex-start-of-header "%\\*\\*start")
@@ -897,7 +705,7 @@ A numeric argument says how many words the braces should surround.
The default is not to surround any existing words with the braces."
nil
"@uref{" _ "}")
-(defalias 'texinfo-insert-@url 'texinfo-insert-@uref)
+(defalias 'texinfo-insert-@url #'texinfo-insert-@uref)
;;; Texinfo file structure
@@ -962,32 +770,27 @@ to jump to the corresponding spot in the Texinfo source file."
(defcustom texinfo-texi2dvi-command "texi2dvi"
"Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-texi2dvi-options ""
"Command line options for `texinfo-texi2dvi-command'."
:type 'string
- :group 'texinfo
:version "28.1")
(defcustom texinfo-tex-command "tex"
"Command used by `texinfo-tex-region' to run TeX on a region."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-texindex-command "texindex"
"Command used by `texinfo-texindex' to sort unsorted index files."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defcustom texinfo-delete-from-print-queue-command "lprm"
"Command string used to delete a job from the line printer queue.
Command is used by \\[texinfo-delete-from-print-queue] based on
number provided by a previous \\[tex-show-print-queue]
command."
- :type 'string
- :group 'texinfo)
+ :type 'string)
(defvar texinfo-tex-trailer "@bye"
"String appended after a region sent to TeX by `texinfo-tex-region'.")
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index ea35641a6c6..f56f197c502 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1,4 +1,4 @@
-;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
+;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files -*- lexical-binding: t; -*-
;; Copyright (C) 1989-1992, 2001-2021 Free Software Foundation, Inc.
@@ -275,6 +275,7 @@ The keys are strings specifying the general hierarchical level in the
document; the values are regular expressions.")
+;;;###autoload
(defun texinfo-make-menu (&optional beginning end)
"Without any prefix argument, make or update a menu.
Make the menu for the section enclosing the node found following point.
@@ -351,6 +352,7 @@ at the level specified by LEVEL. Point is left at the end of menu."
(texinfo-delete-old-menu beginning first))
(texinfo-insert-menu new-menu-list node-name)))
+;;;###autoload
(defun texinfo-all-menus-update (&optional update-all-nodes-p)
"Update every regular menu in a Texinfo file.
Update pre-existing master menu, if there is one.
@@ -420,7 +422,7 @@ of the node if one is found; else do not move point."
"\\|" ; or
"\\(^@ifnottex[ ]*\n\\)" ; ifnottex line, if any
"\\)?" ; end of expression
- (eval (cdr (assoc level texinfo-update-menu-lower-regexps))))
+ (eval (cdr (assoc level texinfo-update-menu-lower-regexps)) t))
;; the next higher level node marks the end of this
;; section, and no lower level node will be found beyond
;; this position even if region-end is farther off
@@ -454,7 +456,7 @@ if the match is found there, the value is t and point does not move."
"\\|" ; or
"\\(^@ifnottex[ ]*\n\\)" ; ifnottex line, if any
"\\)?" ; end of expression
- (eval (cdr (assoc level texinfo-update-menu-higher-regexps))))
+ (eval (cdr (assoc level texinfo-update-menu-higher-regexps)) t))
region-end t)
(beginning-of-line) t)))))
@@ -505,7 +507,7 @@ The function finds entries of the same type. Thus `subsections' and
"\\(^@ifnottex[ ]*\n\\)" ; ifnottex line, if any
"\\)?" ; end of expression
(eval
- (cdr (assoc level texinfo-update-menu-same-level-regexps))))
+ (cdr (assoc level texinfo-update-menu-same-level-regexps)) t))
search-end
t)
(goto-char (match-beginning 1)))))
@@ -733,6 +735,7 @@ is the menu entry name, and the cdr of P is the node name."
;;; Starting menu descriptions by inserting titles
+;;;###autoload
(defun texinfo-start-menu-description ()
"In this menu entry, insert the node's section title as a description.
Position point at beginning of description ready for editing.
@@ -742,7 +745,7 @@ You will need to edit the inserted text since a useful description
complements the node name rather than repeats it as a title does."
(interactive)
- (let (beginning end node-name title)
+ (let (beginning node-name title) ;; end
(save-excursion
(beginning-of-line)
(if (search-forward "* " (line-end-position) t)
@@ -817,6 +820,7 @@ complements the node name rather than repeats it as a title does."
;; Since the make-menu functions indent descriptions, these functions
;; are useful primarily for indenting a single menu specially.
+;;;###autoload
(defun texinfo-indent-menu-description (column &optional region-p)
"Indent every description in menu following point to COLUMN.
Non-nil argument (prefix, if interactive) means indent every
@@ -872,6 +876,7 @@ second and subsequent lines of a multi-line description."
;;; Making the master menu
+;;;###autoload
(defun texinfo-master-menu (update-all-nodes-menus-p)
"Make a master menu for a whole Texinfo file.
Remove pre-existing master menu, if there is one.
@@ -1033,7 +1038,7 @@ However, there does not need to be a title field."
(save-excursion
;; `master-menu-inserted-p' is a kludge to tell
- ;; whether to insert @end detailmenu (see bleow)
+ ;; whether to insert @end detailmenu (see below)
(let (master-menu-inserted-p)
;; Handle top of menu
(insert "\n@menu\n")
@@ -1219,7 +1224,7 @@ Only argument is a string of the general type of section."
"\\(^@ifnottex[ ]*\n\\)" ; ifnottex line, if any
"\\)?" ; end of expression
(eval
- (cdr (assoc level texinfo-update-menu-higher-regexps))))
+ (cdr (assoc level texinfo-update-menu-higher-regexps)) t))
nil
'goto-beginning)
(point))))))
@@ -1243,7 +1248,7 @@ string of the general type of section."
"\\)?" ; end of expression
(eval
;; Never finds end of level above chapter so goes to end.
- (cdr (assoc level texinfo-update-menu-higher-regexps))))
+ (cdr (assoc level texinfo-update-menu-higher-regexps)) t))
nil
'goto-end)
(match-beginning 1)
@@ -1266,6 +1271,7 @@ end of that region; it limits the search."
;;; Updating a node
+;;;###autoload
(defun texinfo-update-node (&optional beginning end)
"Without any prefix argument, update the node in which point is located.
Interactively, a prefix argument means to operate on the region.
@@ -1313,6 +1319,7 @@ which menu descriptions are indented. Its default value is 32."
(goto-char (point-max))
(message "Done...nodes updated in region. You may save the buffer."))))))
+;;;###autoload
(defun texinfo-every-node-update ()
"Update every node in a Texinfo file.
@@ -1430,7 +1437,7 @@ will be at some level higher in the Texinfo file. The fourth argument
"\\(^@ifnottex[ ]*\n\\)"
"\\)?")
(eval
- (cdr (assoc level texinfo-update-menu-same-level-regexps))))
+ (cdr (assoc level texinfo-update-menu-same-level-regexps)) t))
end
t)
'normal
@@ -1451,7 +1458,7 @@ will be at some level higher in the Texinfo file. The fourth argument
"\\(^@ifnottex[ ]*\n\\)"
"\\)?")
(eval
- (cdr (assoc level texinfo-update-menu-same-level-regexps)))
+ (cdr (assoc level texinfo-update-menu-same-level-regexps)) t)
"\\|"
;; Match node line.
"\\(^@node\\).*\n"
@@ -1465,7 +1472,7 @@ will be at some level higher in the Texinfo file. The fourth argument
"\\(^@ifnottex[ ]*\n\\)"
"\\)?")
(eval
- (cdr (assoc level texinfo-update-menu-higher-regexps)))
+ (cdr (assoc level texinfo-update-menu-higher-regexps)) t)
"\\|"
;; Handle `Top' node specially.
"^@node [ \t]*top[ \t]*\\(,\\|$\\)"
@@ -1489,7 +1496,7 @@ will be at some level higher in the Texinfo file. The fourth argument
"\\|"
"\\(^@ifnottex[ ]*\n\\)"
"\\)?")
- (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
+ (eval (cdr (assoc level texinfo-update-menu-higher-regexps)) t)
"\\|"
;; Handle `Top' node specially.
"^@node [ \t]*top[ \t]*\\(,\\|$\\)"
@@ -1553,6 +1560,7 @@ towards which the pointer is directed, one of `next', `previous', or `up'."
;; (The subsection to which `Next' points will most likely be the first
;; item on the section's menu.)
+;;;###autoload
(defun texinfo-sequential-node-update (&optional region-p)
"Update one node (or many) in a Texinfo file with sequential pointers.
@@ -1662,7 +1670,7 @@ or `Up' pointer."
'no-pointer))
((eq direction 'up)
(if (re-search-backward
- (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
+ (eval (cdr (assoc level texinfo-update-menu-higher-regexps)) t)
(point-min)
t)
'normal
@@ -1676,6 +1684,7 @@ or `Up' pointer."
;; before the `@chapter', `@section', and such like lines of a region
;; in a Texinfo file.
+;;;###autoload
(defun texinfo-insert-node-lines (beginning end &optional title-p)
"Insert missing `@node' lines in region of Texinfo file.
Non-nil argument (prefix, if interactive) means also to insert the
@@ -1686,7 +1695,7 @@ node names in pre-existing `@node' lines that lack names."
;; Use marker; after inserting node lines, leave point at end of
;; region and mark at beginning.
- (let (beginning-marker end-marker title last-section-position)
+ (let (end-marker title last-section-position) ;; beginning-marker
;; Save current position on mark ring and set mark to end.
(push-mark end t)
@@ -1989,6 +1998,7 @@ be the files included within it. A main menu must already exist."
;;; The multiple-file update function
+;;;###autoload
(defun texinfo-multiple-files-update
(outer-file &optional make-master-menu update-everything)
"Update first node pointers in each file included in OUTER-FILE;
@@ -2043,8 +2053,8 @@ chapter."
(let* ((included-file-list (texinfo-multi-file-included-list outer-file))
(files included-file-list)
- next-node-name
- previous-node-name
+ ;; next-node-name
+ ;; previous-node-name
;; Update the pointers and collect the names of the nodes and titles
(main-menu-list (texinfo-multi-file-update files update-everything)))
@@ -2112,8 +2122,10 @@ chapter."
(message "Multiple files updated."))
-
-;; Place `provide' at end of file.
(provide 'texnfo-upd)
+;; Local Variables:
+;; generated-autoload-file: "texinfo-loaddefs.el"
+;; End:
+
;;; texnfo-upd.el ends here
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 1432ab6a300..74c6d412a65 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -49,7 +49,7 @@
(modify-syntax-entry ?' "w p" st)
;; UAX #29 says HEBREW PUNCTUATION GERESH behaves like a letter
;; for the purposes of finding word boundaries.
- (modify-syntax-entry #x5f3 "w ") ; GERESH
+ (modify-syntax-entry #x5f3 "w " st) ; GERESH
;; UAX #29 says HEBREW PUNCTUATION GERSHAYIM should not be a word
;; boundary when surrounded by letters. Our infrastructure for
;; finding a word boundary doesn't support 3-character
@@ -57,45 +57,44 @@
;; character. This leaves a problem of having GERSHAYIM at the
;; beginning or end of a word, where it should be a boundary;
;; FIXME.
- (modify-syntax-entry #x5f4 "w ") ; GERSHAYIM
+ (modify-syntax-entry #x5f4 "w " st) ; GERSHAYIM
;; These all should not be a word boundary when between letters,
;; according to UAX #29, so they again are prone to the same
;; problem as GERSHAYIM; FIXME.
- (modify-syntax-entry #xb7 "w ") ; MIDDLE DOT
- (modify-syntax-entry #x2027 "w ") ; HYPHENATION POINT
- (modify-syntax-entry #xff1a "w ") ; FULLWIDTH COLON
+ (modify-syntax-entry #xb7 "w " st) ; MIDDLE DOT
+ (modify-syntax-entry #x2027 "w " st) ; HYPHENATION POINT
+ (modify-syntax-entry #xff1a "w " st) ; FULLWIDTH COLON
st)
"Syntax table used while in `text-mode'.")
(defvar text-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\e\t" 'ispell-complete-word)
- (define-key map [menu-bar text]
- (cons "Text" (make-sparse-keymap "Text")))
- (bindings--define-key map [menu-bar text toggle-text-mode-auto-fill]
- '(menu-item "Auto Fill" toggle-text-mode-auto-fill
- :button (:toggle . (memq 'turn-on-auto-fill text-mode-hook))
- :help "Automatically fill text while typing in text modes (Auto Fill mode)"))
- (bindings--define-key map [menu-bar text paragraph-indent-minor-mode]
- '(menu-item "Paragraph Indent" paragraph-indent-minor-mode
- :button (:toggle . (bound-and-true-p paragraph-indent-minor-mode))
- :help "Toggle paragraph indent minor mode"))
- (bindings--define-key map [menu-bar text sep] menu-bar-separator)
- (bindings--define-key map [menu-bar text center-region]
- '(menu-item "Center Region" center-region
- :help "Center the marked region"
- :enable (region-active-p)))
- (bindings--define-key map [menu-bar text center-paragraph]
- '(menu-item "Center Paragraph" center-paragraph
- :help "Center the current paragraph"))
- (bindings--define-key map [menu-bar text center-line]
- '(menu-item "Center Line" center-line
- :help "Center the current line"))
+ (define-key map "\e\t" #'ispell-complete-word)
map)
"Keymap for `text-mode'.
Many other modes, such as `mail-mode', `outline-mode' and `indented-text-mode',
inherit all the commands defined in this map.")
+(easy-menu-define text-mode-menu text-mode-map
+ "Menu for `text-mode'."
+ '("Text"
+ ["Center Line" center-line
+ :help "Center the current line"]
+ ["Center Paragraph" center-paragraph
+ :help "Center the current paragraph"]
+ ["Center Region" center-region
+ :help "Center the marked region"
+ :enable (region-active-p)]
+ "---"
+ ["Paragraph Indent" paragraph-indent-minor-mode
+ :help "Toggle paragraph indent minor mode"
+ :style toggle
+ :selected (bound-and-true-p paragraph-indent-minor-mode)]
+ ["Auto Fill" toggle-text-mode-auto-fill
+ :help "Automatically fill text while typing in text modes (Auto Fill mode)"
+ :style toggle
+ :selected (memq 'turn-on-auto-fill text-mode-hook)]))
+
(define-derived-mode text-mode nil "Text"
"Major mode for editing text written for humans to read.
@@ -142,7 +141,7 @@ Turning on Paragraph-Indent minor mode runs the normal hook
(remove-function (local 'indent-line-function)
#'indent-to-left-margin)))
-(defalias 'indented-text-mode 'text-mode)
+(defalias 'indented-text-mode #'text-mode)
;; This can be made a no-op once all modes that use text-mode-hook
;; are "derived" from text-mode. (As of 2015/04, and probably well before,
@@ -169,8 +168,6 @@ both existing buffers and buffers that you subsequently create."
(if enable-mode "enabled" "disabled"))))
-(define-key facemenu-keymap "\eS" 'center-paragraph)
-
(defun center-paragraph ()
"Center each nonblank line in the paragraph at or after point.
See `center-line' for more info."
@@ -198,8 +195,6 @@ See `center-line' for more info."
(center-line))
(forward-line 1)))))
-(define-key facemenu-keymap "\es" 'center-line)
-
(defun center-line (&optional nlines)
"Center the line point is on, within the width specified by `fill-column'.
This means adjusting the indentation so that it equals
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index 33a976aa7b0..01e2ad72d88 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -66,7 +66,6 @@ non-capturing groups can be used for grouping prior to the part of the regexp
matching the white space). The pattern is matched case-sensitive regardless of
the value of `case-fold-search' setting."
:version "25.1"
- :group 'tildify
:type 'regexp
:safe t)
@@ -90,7 +89,6 @@ by the hard space character.
The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this
mode, the item for the mode SYMBOL is looked up in the alist instead."
- :group 'tildify
:type '(repeat (cons :tag "Entry for major mode"
(choice (const :tag "Default" t)
(symbol :tag "Major mode"))
@@ -110,7 +108,6 @@ might be used for other modes if compatible encoding is used.
If nil, current major mode has no way to represent a hard space."
:version "25.1"
- :group 'tildify
:type '(choice (const :tag "Space character (no hard-space representation)"
" ")
(const :tag "No-break space (U+00A0)" "\u00A0")
@@ -133,7 +130,6 @@ STRING defines the hard space, which is inserted at places defined by
The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this
mode, the item for the mode SYMBOL is looked up in the alist instead."
- :group 'tildify
:type '(repeat (cons :tag "Entry for major mode"
(choice (const :tag "Default" t)
(symbol :tag "Major mode"))
@@ -164,7 +160,6 @@ or better still:
See `tildify-foreach-ignore-environments' function for other ways to use the
variable."
:version "25.1"
- :group 'tildify
:type 'function)
(defcustom tildify-ignored-environments-alist ()
@@ -183,7 +178,6 @@ MAJOR-MODE defines major mode, for which the item applies. It can be either:
See `tildify-foreach-ignore-environments' function for description of BEG-REGEX
and END-REGEX."
- :group 'tildify
:type '(repeat
(cons :tag "Entry for major mode"
(choice (const :tag "Default" t)
@@ -295,7 +289,7 @@ variable. For example, for an XML file one might use:
(setq-local tildify-foreach-region-function
(apply-partially \\='tildify-foreach-ignore-environments
\\='((\"<! *--\" . \"-- *>\") (\"<\" . \">\"))))"
- (let ((beg-re (concat "\\(?:" (mapconcat 'car pairs "\\)\\|\\(?:") "\\)"))
+ (let ((beg-re (concat "\\(?:" (mapconcat #'car pairs "\\)\\|\\(?:") "\\)"))
p end-re)
(save-excursion
(save-restriction
@@ -416,19 +410,16 @@ If the pattern matches `looking-back', a hard space needs to be inserted instead
of a space at point. The regexp is always case sensitive, regardless of the
current `case-fold-search' setting."
:version "25.1"
- :group 'tildify
:type 'regexp)
(defcustom tildify-space-predicates '(tildify-space-region-predicate)
"A list of predicate functions for `tildify-space' function."
:version "25.1"
- :group 'tildify
:type '(repeat function))
(defcustom tildify-double-space-undos t
"Weather `tildify-space' should undo hard space when space is typed again."
:version "25.1"
- :group 'tildify
:type 'boolean)
;;;###autoload
@@ -495,7 +486,7 @@ that space character is replaced by a hard space specified by
When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space
representation for current major mode, the `tildify-space-string' buffer-local
variable will be set to the representation."
- nil " ~" nil
+ :lighter " ~"
(when tildify-mode
(let ((space (with-suppressed-warnings ((obsolete
tildify--pick-alist-entry))
@@ -508,12 +499,10 @@ variable will be set to the representation."
"mode won't have any effect, disabling.")))
(setq tildify-mode nil))))
(if tildify-mode
- (add-hook 'post-self-insert-hook 'tildify-space nil t)
- (remove-hook 'post-self-insert-hook 'tildify-space t)))
+ (add-hook 'post-self-insert-hook #'tildify-space nil t)
+ (remove-hook 'post-self-insert-hook #'tildify-space t)))
-;;; *** Announce ***
-
(provide 'tildify)
;;; tildify.el ends here
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index d072ab16c3c..5a3a64ad79f 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -1,4 +1,4 @@
-;;; two-column.el --- minor mode for editing of two-column text
+;;; two-column.el --- minor mode for editing of two-column text -*- lexical-binding: t; -*-
;; Copyright (C) 1992-1995, 2001-2021 Free Software Foundation, Inc.
@@ -133,26 +133,22 @@
'("-%*- %15b --" (-3 . "%p") "--%[(" mode-name
minor-mode-alist "%n" mode-line-process ")%]%-")
"Value of `mode-line-format' for a buffer in two-column minor mode."
- :type 'sexp
- :group 'two-column)
+ :type 'sexp)
(defcustom 2C-other-buffer-hook 'text-mode
"Hook run in new buffer when it is associated with current one."
- :type 'function
- :group 'two-column)
+ :type 'function)
(defcustom 2C-separator ""
"A string inserted between the two columns when merging.
This gets set locally by \\[2C-split]."
- :type 'string
- :group 'two-column)
+ :type 'string)
(put '2C-separator 'permanent-local t)
(defcustom 2C-window-width 40
"The width of the first column. (Must be at least `window-min-width'.)
This value is local for every buffer that sets it."
- :type 'integer
- :group 'two-column)
+ :type 'integer)
(make-variable-buffer-local '2C-window-width)
(put '2C-window-width 'permanent-local t)
@@ -160,21 +156,19 @@ This value is local for every buffer that sets it."
"Base for calculating `fill-column' for a buffer in two-column minor mode.
The value of `fill-column' becomes `2C-window-width' for this buffer
minus this value."
- :type 'integer
- :group 'two-column)
+ :type 'integer)
(defcustom 2C-autoscroll t
"If non-nil, Emacs attempts to keep the two column's buffers aligned."
- :type 'boolean
- :group 'two-column)
+ :type 'boolean)
(defvar 2C-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "2" '2C-two-columns)
- (define-key map [f2] '2C-two-columns)
- (define-key map "b" '2C-associate-buffer)
- (define-key map "s" '2C-split)
+ (define-key map "2" #'2C-two-columns)
+ (define-key map [f2] #'2C-two-columns)
+ (define-key map "b" #'2C-associate-buffer)
+ (define-key map "s" #'2C-split)
map)
"Keymap for commands for setting up two-column mode.")
@@ -184,19 +178,19 @@ minus this value."
;; This one is for historical reasons and simple keyboards, it is not
;; at all mnemonic. All usual sequences containing 2 were used, and
;; f2 could not be set up in a standard way under Emacs 18.
-;;;###autoload (global-set-key "\C-x6" '2C-command)
+;;;###autoload (global-set-key "\C-x6" #'2C-command)
-;;;###autoload (global-set-key [f2] '2C-command)
+;;;###autoload (global-set-key [f2] #'2C-command)
(defvar 2C-minor-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "1" '2C-merge)
- (define-key map "d" '2C-dissociate)
- (define-key map "o" '2C-associated-buffer)
- (define-key map "\^m" '2C-newline)
- (define-key map "|" '2C-toggle-autoscroll)
- (define-key map "{" '2C-shrink-window-horizontally)
- (define-key map "}" '2C-enlarge-window-horizontally)
+ (define-key map "1" #'2C-merge)
+ (define-key map "d" #'2C-dissociate)
+ (define-key map "o" #'2C-associated-buffer)
+ (define-key map "\^m" #'2C-newline)
+ (define-key map "|" #'2C-toggle-autoscroll)
+ (define-key map "{" #'2C-shrink-window-horizontally)
+ (define-key map "}" #'2C-enlarge-window-horizontally)
map)
"Keymap for commands for use in two-column mode.")
@@ -281,7 +275,7 @@ some prefix.
The appearance of the screen can be customized by the variables
`2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and
`truncate-partial-width-windows'."
- (add-hook 'post-command-hook '2C-autoscroll nil t)
+ (add-hook 'post-command-hook #'2C-autoscroll nil t)
(setq fill-column (- 2C-window-width
2C-beyond-fill-column)
mode-line-format 2C-mode-line-format
@@ -325,16 +319,17 @@ first and the associated buffer to its right."
;;;###autoload
-(defun 2C-associate-buffer ()
- "Associate another buffer with this one in two-column minor mode.
+(defun 2C-associate-buffer (buffer)
+ "Associate another BUFFER with this one in two-column minor mode.
Can also be used to associate a just previously visited file, by
accepting the proposed default buffer.
\(See \\[describe-mode] .)"
- (interactive)
+ (interactive
+ (list (or (2C-other)
+ (read-buffer "Associate buffer: " (other-buffer)))))
(let ((b1 (current-buffer))
- (b2 (or (2C-other)
- (read-buffer "Associate buffer: " (other-buffer)))))
+ (b2 buffer))
(setq 2C-mode nil)
(with-current-buffer b2
(and (2C-other)
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index c52fcfcc051..66bbfb0f9f6 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -73,8 +73,8 @@ provider functions are called with no parameters at the point in
question.
\"things\" include `symbol', `list', `sexp', `defun', `filename',
-`url', `email', `uuid', `word', `sentence', `whitespace', `line',
-and `page'.")
+`existing-filename', `url', `email', `uuid', `word', `sentence',
+`whitespace', `line', and `page'.")
;; Basic movement
@@ -156,8 +156,8 @@ positions of the thing found."
"Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
-`line', `number', and `page'.
+`filename', `existing-filename', `url', `email', `uuid', `word',
+`sentence', `whitespace', `line', `number', and `page'.
When the optional argument NO-PROPERTIES is non-nil,
strip text properties from the return value.
@@ -301,6 +301,17 @@ E.g.:
(define-thing-chars filename thing-at-point-file-name-chars)
+;; Files
+
+(defun thing-at-point-file-at-point (&optional _lax _bounds)
+ "Return the name of the existing file at point."
+ (when-let ((filename (thing-at-point 'filename)))
+ (setq filename (expand-file-name filename))
+ (and (file-exists-p filename)
+ filename)))
+
+(put 'existing-filename 'thing-at-point 'thing-at-point-file-at-point)
+
;; URIs
(defvar thing-at-point-beginning-of-url-regexp nil
@@ -481,7 +492,7 @@ looks like an email address, \"ftp://\" if it starts with
(and (string-match "\\`[[:alnum:]]+\\'" str)
(eq (char-before (car bounds)) ?<)
(eq (char-after (cdr bounds)) ?>)
- (not (string-match "~" (expand-file-name (concat "~" str))))
+ (not (string-search "~" (expand-file-name (concat "~" str))))
(setq str (concat "mailto:" str)))
;; If it looks like news.example.com, treat it as news.
(if (thing-at-point-newsgroup-p str)
@@ -600,10 +611,14 @@ with angle brackets.")
(buffer-substring-no-properties
(car boundary-pair) (cdr boundary-pair))))))
-;; Buffer
+;; Buffer and region
(put 'buffer 'end-op (lambda () (goto-char (point-max))))
(put 'buffer 'beginning-op (lambda () (goto-char (point-min))))
+(put 'region 'bounds-of-thing-at-point
+ (lambda ()
+ (when (use-region-p)
+ (cons (region-beginning) (region-end)))))
;; UUID
@@ -673,14 +688,14 @@ Signal an error if the entire string was not used."
"Return the number at point, or nil if none is found.
Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers
like \"0xBEEF09\" or \"#xBEEF09\", are recognized."
- (when (thing-at-point-looking-at
- "\\(-?[0-9]+\\.?[0-9]*\\)\\|\\(0x\\|#x\\)\\([a-zA-Z0-9]+\\)" 500)
- (if (match-beginning 1)
- (string-to-number
- (buffer-substring (match-beginning 1) (match-end 1)))
- (string-to-number
- (buffer-substring (match-beginning 3) (match-end 3))
- 16))))
+ (cond
+ ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500)
+ (string-to-number
+ (buffer-substring (match-beginning 2) (match-end 2))
+ 16))
+ ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500)
+ (string-to-number
+ (buffer-substring (match-beginning 0) (match-end 0))))))
(put 'number 'thing-at-point 'number-at-point)
;;;###autoload
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 465d097b615..4c863883ba4 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -1,4 +1,4 @@
-;;; thumbs.el --- Thumbnails previewer for images files
+;;; thumbs.el --- Thumbnails previewer for images files -*- lexical-binding: t -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
;;; Commentary:
-;; This package create two new modes: thumbs-mode and thumbs-view-image-mode.
+;; This package create two new modes: `thumbs-mode' and `thumbs-view-image-mode'.
;; It is used for basic browsing and viewing of images from within Emacs.
;; Minimal image manipulation functions are also available via external
;; programs. If you want to do more complex tasks like categorize and tag
@@ -34,7 +34,7 @@
;;
;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some
;; time. The peoples at #emacs@freenode.net for numerous help. RMS
-;; for emacs and the GNU project.
+;; for Emacs and the GNU project.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -51,9 +51,6 @@
;; In thumbs-mode, pressing <return> on an image will bring you in image view
;; mode for that image. C-h m will give you a list of available keybinding.
-;;; History:
-;;
-
;;; Code:
(require 'dired)
@@ -68,29 +65,24 @@
(defcustom thumbs-thumbsdir (locate-user-emacs-file "thumbs")
"Directory to store thumbnails."
- :type 'directory
- :group 'thumbs)
+ :type 'directory)
(defcustom thumbs-geometry "100x100"
"Size of thumbnails."
- :type 'string
- :group 'thumbs)
+ :type 'string)
(defcustom thumbs-per-line 4
"Number of thumbnails per line to show in directory."
- :type 'integer
- :group 'thumbs)
+ :type 'integer)
(defcustom thumbs-max-image-number 16
"Maximum number of images initially displayed in thumbs buffer."
- :type 'integer
- :group 'thumbs)
+ :type 'integer)
(defcustom thumbs-thumbsdir-max-size 50000000
"Maximum size for thumbnails directory.
When it reaches that size (in bytes), a warning is sent."
- :type 'integer
- :group 'thumbs)
+ :type 'integer)
;; Unfortunately Windows XP has a program called CONVERT.EXE in
;; C:/WINDOWS/SYSTEM32/ for partitioning NTFS systems. So Emacs
@@ -98,54 +90,48 @@ When it reaches that size (in bytes), a warning is sent."
;; customize this value to the absolute filename.
(defcustom thumbs-conversion-program
(if (eq system-type 'windows-nt)
+ ;; FIXME is this necessary, or can a sane PATHEXE be assumed?
+ ;; Eg find-program does not do this.
"convert.exe"
- (or (executable-find "convert")
- "/usr/X11R6/bin/convert"))
+ "convert")
"Name of conversion program for thumbnails generation.
-It must be \"convert\"."
+This must be the ImageMagick \"convert\" utility."
:type 'string
- :group 'thumbs)
+ :version "28.1")
(defcustom thumbs-setroot-command
"xloadimage -onroot -fullscreen *"
"Command to set the root window."
- :type 'string
- :group 'thumbs)
+ :type 'string)
(defcustom thumbs-relief 5
"Size of button-like border around thumbnails."
- :type 'integer
- :group 'thumbs)
+ :type 'integer)
(defcustom thumbs-margin 2
"Size of the margin around thumbnails.
This is where you see the cursor."
- :type 'integer
- :group 'thumbs)
+ :type 'integer)
(defcustom thumbs-thumbsdir-auto-clean t
"If set, delete older file in the thumbnails directory.
Deletion is done at load time when the directory size is bigger
than `thumbs-thumbsdir-max-size'."
- :type 'boolean
- :group 'thumbs)
+ :type 'boolean)
(defcustom thumbs-image-resizing-step 10
"Step by which to resize image as a percentage."
- :type 'integer
- :group 'thumbs)
+ :type 'integer)
(defcustom thumbs-temp-dir temporary-file-directory
"Temporary directory to use.
Defaults to `temporary-file-directory'. Leaving it to
this value can let another user see some of your images."
- :type 'directory
- :group 'thumbs)
+ :type 'directory)
(defcustom thumbs-temp-prefix "emacsthumbs"
"Prefix to add to temp files."
- :type 'string
- :group 'thumbs)
+ :type 'string)
;; Initialize some variable, for later use.
(defvar-local thumbs-current-tmp-filename nil
@@ -199,23 +185,24 @@ Create the thumbnails directory if it does not exist."
If the total size of all files in `thumbs-thumbsdir' is bigger than
`thumbs-thumbsdir-max-size', files are deleted until the max size is
reached."
- (let* ((files-list
- (sort
- (mapcar
- (lambda (f)
- (let ((fattribs-list (file-attributes f)))
- `(,(file-attribute-access-time fattribs-list)
- ,(file-attribute-size fattribs-list)
- ,f)))
- (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
- (lambda (l1 l2) (time-less-p (car l1) (car l2)))))
- (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list))))
- (while (> dirsize thumbs-thumbsdir-max-size)
- (progn
- (message "Deleting file %s" (cadr (cdar files-list))))
- (delete-file (cadr (cdar files-list)))
- (setq dirsize (- dirsize (car (cdar files-list))))
- (setq files-list (cdr files-list)))))
+ (when (file-directory-p thumbs-thumbsdir)
+ (let* ((files-list
+ (sort
+ (mapcar
+ (lambda (f)
+ (let ((fattribs-list (file-attributes f)))
+ `(,(file-attribute-access-time fattribs-list)
+ ,(file-attribute-size fattribs-list)
+ ,f)))
+ (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
+ (lambda (l1 l2) (time-less-p (car l1) (car l2)))))
+ (dirsize (apply #'+ (mapcar (lambda (x) (cadr x)) files-list))))
+ (while (> dirsize thumbs-thumbsdir-max-size)
+ (progn
+ (message "Deleting file %s" (cadr (cdar files-list))))
+ (delete-file (cadr (cdar files-list)))
+ (setq dirsize (- dirsize (car (cdar files-list))))
+ (setq files-list (cdr files-list))))))
;; Check the thumbnail directory size and clean it if necessary.
(when thumbs-thumbsdir-auto-clean
@@ -289,7 +276,7 @@ smaller according to whether INCREMENT is 1 or -1."
(subst-char-in-string
?\s ?\_
(apply
- 'concat
+ #'concat
(split-string filename "/")))))))
(defun thumbs-make-thumb (img)
@@ -387,7 +374,7 @@ If MARKED is non-nil, the image is marked."
"Make a preview buffer for all images in DIR.
Optional argument REG to select file matching a regexp,
and SAME-WINDOW to show thumbs in the same window."
- (interactive "DDir: ")
+ (interactive "DThumbs (directory): ")
(thumbs-show-thumbs-list
(directory-files dir t (or reg (image-file-name-regexp)))
dir same-window))
@@ -447,10 +434,10 @@ Open another window."
(defun thumbs-call-setroot-command (img)
"Call the setroot program for IMG."
(run-hooks 'thumbs-before-setroot-hook)
- (shell-command (replace-regexp-in-string
- "\\*"
+ (shell-command (string-replace
+ "*"
(shell-quote-argument (expand-file-name img))
- thumbs-setroot-command nil t))
+ thumbs-setroot-command))
(run-hooks 'thumbs-after-setroot-hook))
(defun thumbs-set-image-at-point-to-root-window ()
@@ -617,7 +604,7 @@ Open another window."
(when (eolp) (forward-char)))
;; cleaning of old temp files
-(mapc 'delete-file
+(mapc #'delete-file
(directory-files (thumbs-temp-dir) t thumbs-temp-prefix))
;; Image modification routines
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index b9eab95b232..ae911717151 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -25,7 +25,7 @@
;; A template in a file can be updated with a new time stamp when
;; you save the file. For example:
-;; static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>";
+;; static char *ts = "sdmain.c Time-stamp: <2020-04-18 14:10:21 gildea>";
;; To use time-stamping, add this line to your init file:
;; (add-hook 'before-save-hook 'time-stamp)
@@ -278,7 +278,7 @@ look like one of the following:
Time-stamp: <>
Time-stamp: \" \"
The time stamp is written between the brackets or quotes:
- Time-stamp: <2001-02-18 10:20:51 gildea>
+ Time-stamp: <2020-08-07 17:10:21 gildea>
The time stamp is updated only if the variable
`time-stamp-active' is non-nil.
@@ -422,7 +422,7 @@ Returns the end point, which is where `time-stamp' begins the next search."
;;;###autoload
(defun time-stamp-toggle-active (&optional arg)
"Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
-With ARG, turn time stamping on if and only if arg is positive."
+With ARG, turn time stamping on if and only if ARG is positive."
(interactive "P")
(setq time-stamp-active
(if (null arg)
@@ -457,200 +457,225 @@ normally the current time is used."
(defun time-stamp-string-preprocess (format &optional time)
"Use a FORMAT to format date, time, file, and user information.
Optional second argument TIME is only for testing.
-Implements non-time extensions to `format-time-string'
+Implements extensions to `format-time-string'
and all `time-stamp-format' compatibility."
(let ((fmt-len (length format))
(ind 0)
cur-char
- (prev-char nil)
- (result "")
- field-width
- field-result
- alt-form change-case upcase
- (paren-level 0))
+ (result ""))
(while (< ind fmt-len)
(setq cur-char (aref format ind))
(setq
result
- (concat result
- (cond
- ((eq cur-char ?%)
- ;; eat any additional args to allow for future expansion
- (setq alt-form 0 change-case nil upcase nil field-width "")
- (while (progn
- (setq ind (1+ ind))
- (setq cur-char (if (< ind fmt-len)
- (aref format ind)
- ?\0))
- (or (eq ?. cur-char)
- (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
- (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
- (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
- (and (eq ?\( cur-char)
- (not (eq prev-char ?\\))
- (setq paren-level (1+ paren-level)))
- (if (and (eq ?\) cur-char)
+ (concat
+ result
+ (cond
+ ((eq cur-char ?%)
+ (let ((prev-char nil)
+ (field-width "")
+ field-result
+ (alt-form 0)
+ (change-case nil)
+ (upcase nil)
+ (flag-pad-with-spaces nil)
+ (flag-pad-with-zeros nil)
+ (flag-minimize nil)
+ (paren-level 0))
+ ;; eat any additional args to allow for future expansion
+ (while (progn
+ (setq ind (1+ ind))
+ (setq cur-char (if (< ind fmt-len)
+ (aref format ind)
+ ?\0))
+ (or (eq ?. cur-char)
+ (eq ?, cur-char) (eq ?: cur-char) (eq ?@ cur-char)
+ (eq ?- cur-char) (eq ?+ cur-char) (eq ?_ cur-char)
+ (eq ?\s cur-char) (eq ?# cur-char) (eq ?^ cur-char)
+ (and (eq ?\( cur-char)
(not (eq prev-char ?\\))
- (> paren-level 0))
- (setq paren-level (1- paren-level))
- (and (> paren-level 0)
- (< ind fmt-len)))
- (if (and (<= ?0 cur-char) (>= ?9 cur-char))
- ;; get format width
- (let ((field-index ind))
- (while (progn
- (setq ind (1+ ind))
- (setq cur-char (if (< ind fmt-len)
- (aref format ind)
- ?\0))
- (and (<= ?0 cur-char) (>= ?9 cur-char))))
- (setq field-width (substring format field-index ind))
- (setq ind (1- ind))
- t))))
- (setq prev-char cur-char)
- ;; some characters we actually use
- (cond ((eq cur-char ?:)
- (setq alt-form (1+ alt-form)))
- ((eq cur-char ?#)
- (setq change-case t))
- ((eq cur-char ?^)
- (setq upcase t))
- ((eq cur-char ?-)
- (setq field-width "1"))
- ((eq cur-char ?_)
- (setq field-width "2"))))
- (setq field-result
- (cond
- ((eq cur-char ?%)
- "%")
- ((eq cur-char ?a) ;day of week
- (if (> alt-form 0)
- (if (string-equal field-width "")
- (time-stamp--format "%A" time)
- "") ;discourage "%:3a"
- (if (or change-case upcase)
- (time-stamp--format "%#a" time)
- (time-stamp--format "%a" time))))
- ((eq cur-char ?A)
- (if (or change-case upcase (not (string-equal field-width "")))
- (time-stamp--format "%#A" time)
- (time-stamp--format "%A" time)))
- ((eq cur-char ?b) ;month name
- (if (> alt-form 0)
- (if (string-equal field-width "")
- (time-stamp--format "%B" time)
- "") ;discourage "%:3b"
- (if (or change-case upcase)
- (time-stamp--format "%#b" time)
- (time-stamp--format "%b" time))))
- ((eq cur-char ?B)
- (if (or change-case upcase (not (string-equal field-width "")))
- (time-stamp--format "%#B" time)
- (time-stamp--format "%B" time)))
- ((eq cur-char ?d) ;day of month, 1-31
- (time-stamp-do-number cur-char alt-form field-width time))
- ((eq cur-char ?H) ;hour, 0-23
- (time-stamp-do-number cur-char alt-form field-width time))
- ((eq cur-char ?I) ;hour, 1-12
- (time-stamp-do-number cur-char alt-form field-width time))
- ((eq cur-char ?m) ;month number, 1-12
- (time-stamp-do-number cur-char alt-form field-width time))
- ((eq cur-char ?M) ;minute, 0-59
- (time-stamp-do-number cur-char alt-form field-width time))
- ((eq cur-char ?p) ;am or pm
- (if change-case
- (time-stamp--format "%#p" time)
- (time-stamp--format "%p" time)))
- ((eq cur-char ?P) ;AM or PM
- (time-stamp--format "%p" time))
- ((eq cur-char ?S) ;seconds, 00-60
- (time-stamp-do-number cur-char alt-form field-width time))
- ((eq cur-char ?w) ;weekday number, Sunday is 0
- (time-stamp--format "%w" time))
- ((eq cur-char ?y) ;year
- (if (> alt-form 0)
- (string-to-number (time-stamp--format "%Y" time))
- (if (or (string-equal field-width "")
- (<= (string-to-number field-width) 2))
- (string-to-number (time-stamp--format "%y" time))
- (time-stamp-conv-warn (format "%%%sy" field-width) "%Y")
- (string-to-number (time-stamp--format "%Y" time)))))
- ((eq cur-char ?Y) ;4-digit year
- (string-to-number (time-stamp--format "%Y" time)))
- ((eq cur-char ?z) ;time zone offset
- (if change-case
- "" ;discourage %z variations
- (cond ((= alt-form 0)
- (if (string-equal field-width "")
- (progn
- (time-stamp-conv-warn "%z" "%#Z")
- (time-stamp--format "%#Z" time))
- (cond ((string-equal field-width "1")
- (setq field-width "3")) ;%-z -> "+00"
- ((string-equal field-width "2")
- (setq field-width "5")) ;%_z -> "+0000"
- ((string-equal field-width "4")
- (setq field-width "0"))) ;discourage %4z
- (time-stamp--format "%z" time)))
- ((= alt-form 1)
- (time-stamp--format "%:z" time))
- ((= alt-form 2)
- (time-stamp--format "%::z" time))
- ((= alt-form 3)
- (time-stamp--format "%:::z" time)))))
- ((eq cur-char ?Z) ;time zone name
- (if change-case
- (time-stamp--format "%#Z" time)
- (time-stamp--format "%Z" time)))
- ((eq cur-char ?f) ;buffer-file-name, base name only
- (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- time-stamp-no-file))
- ((eq cur-char ?F) ;buffer-file-name, full path
- (or buffer-file-name
- time-stamp-no-file))
- ((eq cur-char ?s) ;system name, legacy
- (system-name))
- ((eq cur-char ?u) ;user name, legacy
- (user-login-name))
- ((eq cur-char ?U) ;user full name, legacy
- (user-full-name))
- ((eq cur-char ?l) ;login name
- (user-login-name))
- ((eq cur-char ?L) ;full name of logged-in user
- (user-full-name))
- ((eq cur-char ?h) ;mail host name
- (or mail-host-address (system-name)))
- ((eq cur-char ?q) ;unqualified host name
- (let ((qualname (system-name)))
- (if (string-match "\\." qualname)
- (substring qualname 0 (match-beginning 0))
- qualname)))
- ((eq cur-char ?Q) ;fully-qualified host name
- (system-name))
- ))
- (and (numberp field-result)
- (= alt-form 0)
- (string-equal field-width "")
- ;; no width provided; set width for default
- (setq field-width "02"))
- (let ((padded-result
- (format (format "%%%s%c"
- field-width
- (if (numberp field-result) ?d ?s))
- (or field-result ""))))
- (let* ((initial-length (length padded-result))
- (desired-length (if (string-equal field-width "")
- initial-length
- (string-to-number field-width))))
- (if (> initial-length desired-length)
- ;; truncate strings on right
- (if (stringp field-result)
- (substring padded-result 0 desired-length)
- padded-result) ;numbers don't truncate
- padded-result))))
- (t
- (char-to-string cur-char)))))
+ (setq paren-level (1+ paren-level)))
+ (if (and (eq ?\) cur-char)
+ (not (eq prev-char ?\\))
+ (> paren-level 0))
+ (setq paren-level (1- paren-level))
+ (and (> paren-level 0)
+ (< ind fmt-len)))
+ (if (and (<= ?0 cur-char) (>= ?9 cur-char))
+ ;; get format width
+ (let ((field-index ind)
+ (first-digit cur-char))
+ (while (progn
+ (setq ind (1+ ind))
+ (setq cur-char (if (< ind fmt-len)
+ (aref format ind)
+ ?\0))
+ (and (<= ?0 cur-char)
+ (>= ?9 cur-char))))
+ (setq field-width
+ (substring format field-index ind))
+ (setq ind (1- ind))
+ (setq cur-char first-digit)
+ t))))
+ (setq prev-char cur-char)
+ ;; some characters we actually use
+ (cond ((eq cur-char ?:)
+ (setq alt-form (1+ alt-form)))
+ ((eq cur-char ?#)
+ (setq change-case t))
+ ((eq cur-char ?^)
+ (setq upcase t))
+ ((eq cur-char ?0)
+ (setq flag-pad-with-zeros t))
+ ((eq cur-char ?-)
+ (setq field-width "1" flag-minimize t))
+ ((eq cur-char ?_)
+ (setq field-width "2" flag-pad-with-spaces t))))
+ (setq field-result
+ (cond
+ ((eq cur-char ?%)
+ "%")
+ ((eq cur-char ?a) ;day of week
+ (if (> alt-form 0)
+ (if (string-equal field-width "")
+ (time-stamp--format "%A" time)
+ "") ;discourage "%:3a"
+ (if (or change-case upcase)
+ (time-stamp--format "%#a" time)
+ (time-stamp--format "%a" time))))
+ ((eq cur-char ?A)
+ (if (or change-case upcase (not (string-equal field-width
+ "")))
+ (time-stamp--format "%#A" time)
+ (time-stamp--format "%A" time)))
+ ((eq cur-char ?b) ;month name
+ (if (> alt-form 0)
+ (if (string-equal field-width "")
+ (time-stamp--format "%B" time)
+ "") ;discourage "%:3b"
+ (if (or change-case upcase)
+ (time-stamp--format "%#b" time)
+ (time-stamp--format "%b" time))))
+ ((eq cur-char ?B)
+ (if (or change-case upcase (not (string-equal field-width
+ "")))
+ (time-stamp--format "%#B" time)
+ (time-stamp--format "%B" time)))
+ ((eq cur-char ?d) ;day of month, 1-31
+ (time-stamp-do-number cur-char alt-form field-width time))
+ ((eq cur-char ?H) ;hour, 0-23
+ (time-stamp-do-number cur-char alt-form field-width time))
+ ((eq cur-char ?I) ;hour, 1-12
+ (time-stamp-do-number cur-char alt-form field-width time))
+ ((eq cur-char ?m) ;month number, 1-12
+ (time-stamp-do-number cur-char alt-form field-width time))
+ ((eq cur-char ?M) ;minute, 0-59
+ (time-stamp-do-number cur-char alt-form field-width time))
+ ((eq cur-char ?p) ;am or pm
+ (if change-case
+ (time-stamp--format "%#p" time)
+ (time-stamp--format "%p" time)))
+ ((eq cur-char ?P) ;AM or PM
+ (time-stamp--format "%p" time))
+ ((eq cur-char ?S) ;seconds, 00-60
+ (time-stamp-do-number cur-char alt-form field-width time))
+ ((eq cur-char ?w) ;weekday number, Sunday is 0
+ (time-stamp--format "%w" time))
+ ((eq cur-char ?y) ;year
+ (if (> alt-form 0)
+ (string-to-number (time-stamp--format "%Y" time))
+ (if (or (string-equal field-width "")
+ (<= (string-to-number field-width) 2))
+ (string-to-number (time-stamp--format "%y" time))
+ (time-stamp-conv-warn (format "%%%sy" field-width) "%Y")
+ (string-to-number (time-stamp--format "%Y" time)))))
+ ((eq cur-char ?Y) ;4-digit year
+ (string-to-number (time-stamp--format "%Y" time)))
+ ((eq cur-char ?z) ;time zone offset
+ (let ((field-width-num (string-to-number field-width))
+ ;; Handle numeric time zone ourselves, because
+ ;; current-time-zone cannot handle offsets
+ ;; greater than 24 hours.
+ (offset-secs
+ (cond ((numberp time-stamp-time-zone)
+ time-stamp-time-zone)
+ ((and (consp time-stamp-time-zone)
+ (numberp (car time-stamp-time-zone)))
+ (car time-stamp-time-zone))
+ ;; interpret text time zone
+ (t (car (current-time-zone
+ time time-stamp-time-zone))))))
+ ;; we do our own padding; do not let it be updated further
+ (setq field-width "")
+ (cond (change-case
+ "") ;discourage %z variations
+ ((and (= alt-form 0)
+ (not flag-minimize)
+ (not flag-pad-with-spaces)
+ (not flag-pad-with-zeros)
+ (= field-width-num 0))
+ (time-stamp-conv-warn "%z" "%#Z")
+ (time-stamp--format "%#Z" time))
+ (t (time-stamp-formatz-from-parsed-options
+ flag-minimize
+ flag-pad-with-spaces
+ flag-pad-with-zeros
+ alt-form
+ field-width-num
+ offset-secs)))))
+ ((eq cur-char ?Z) ;time zone name
+ (if change-case
+ (time-stamp--format "%#Z" time)
+ (time-stamp--format "%Z" time)))
+ ((eq cur-char ?f) ;buffer-file-name, base name only
+ (if buffer-file-name
+ (file-name-nondirectory buffer-file-name)
+ time-stamp-no-file))
+ ((eq cur-char ?F) ;buffer-file-name, full path
+ (or buffer-file-name
+ time-stamp-no-file))
+ ((eq cur-char ?s) ;system name, legacy
+ (system-name))
+ ((eq cur-char ?u) ;user name, legacy
+ (user-login-name))
+ ((eq cur-char ?U) ;user full name, legacy
+ (user-full-name))
+ ((eq cur-char ?l) ;login name
+ (user-login-name))
+ ((eq cur-char ?L) ;full name of logged-in user
+ (user-full-name))
+ ((eq cur-char ?h) ;mail host name
+ (or mail-host-address (system-name)))
+ ((eq cur-char ?q) ;unqualified host name
+ (let ((qualname (system-name)))
+ (if (string-match "\\." qualname)
+ (substring qualname 0 (match-beginning 0))
+ qualname)))
+ ((eq cur-char ?Q) ;fully-qualified host name
+ (system-name))
+ ))
+ (and (numberp field-result)
+ (= alt-form 0)
+ (string-equal field-width "")
+ ;; no width provided; set width for default
+ (setq field-width "02"))
+ (let ((padded-result
+ (format (format "%%%s%c"
+ field-width
+ (if (numberp field-result) ?d ?s))
+ (or field-result ""))))
+ (let* ((initial-length (length padded-result))
+ (desired-length (if (string-equal field-width "")
+ initial-length
+ (string-to-number field-width))))
+ (if (> initial-length desired-length)
+ ;; truncate strings on right
+ (if (and (stringp field-result)
+ (not (eq cur-char ?z))) ;offset does not truncate
+ (substring padded-result 0 desired-length)
+ padded-result) ;numbers don't truncate
+ padded-result)))))
+ (t
+ (char-to-string cur-char)))))
(setq ind (1+ ind)))
result))
@@ -690,6 +715,176 @@ Suggests replacing OLD-FORM with NEW-FORM."
(insert "\"" old-form "\" -- use " new-form "\n"))
(display-buffer "*Time-stamp-compatibility*"))))
+;;; A principled, expressive implementation of time zone offset
+;;; formatting ("%z" and variants).
+
+;;; * Overarching principle for %z
+
+;; The output should be clear and complete.
+;;
+;; That is,
+;; a) it should be unambiguous what offset is represented, and
+;; b) it should be possible to exactly recreate the offset.
+
+;;; * Principles for %z
+
+;; - The numeric fields are HHMMSS.
+;; - The fixed point is at the left. The first 2 digits are always
+;; hours, the next 2 (if they exist) minutes, and next 2 (if they
+;; exist) seconds. "+11" is 11 hours (not 11 minutes, not 11 seconds).
+;; "+1015" is 10 hours 15 minutes (not 10 minutes 15 seconds).
+;; - Each of the three numeric fields is two digits.
+;; "+1" and "+100" are illegal. (Is that 1 hour? 10 hours? 100 hours?)
+;; - The MMSS fields may be omitted only if both are 00. Thus, the width
+;; of the field depends on the data. (This is similar to how
+;; %B is always long enough to spell the entire month name.)
+;; - The SS field may be omitted only if it is 00.
+;; - Colons between the numeric fields are an option, unless the hours
+;; field is greater than 99, when colons are needed to prevent ambiguity.
+;; - If padding with zeros, we must pad on the right, because the
+;; fixed point is at the left. (This is similar to how %N,
+;; fractional seconds, must add its zeros on the right.)
+;; - After zero-padding has filled out minutes and seconds with zeros,
+;; further padding can be blanks only.
+;; Any additional zeros would be confusing.
+
+;;; * Padding for %z
+
+;; Padding is under-specified, so we had to make choices.
+;;
+;; Principles guiding our choices:
+;;
+;; - The syntax should be easy to remember and the effect predictable.
+;; - It should be possible to produces as many useful effects as possible.
+;;
+;; Padding choices:
+;;
+;; - By default, pad with spaces, as other formats with non-digits do.
+;; The "0" flag pads first with zeros, until seconds are filled out.
+;; - If padding with spaces, pad on the right. This is consistent with
+;; how zero-padding works. Padding on the right also keeps the fixed
+;; point in the same place, as other formats do for any given width.
+;; - The %_z format always outputs seconds, allowing all added padding
+;; to be spaces. Without this rule, there would be no way to
+;; request seconds that worked for both 2- and 3-digit hours.
+;; - Conflicting options are rejected, lest users depend
+;; on incidental behavior.
+;;
+;; Padding combos that make no sense and are thus disallowed:
+;;
+;; %-:z - minus minimizes to hours, : expands to minutes
+;; %-::z - minus minimizes to hours, :: expands to seconds
+;; %_:z - underscore requires seconds, : displays minutes
+;; %_:::z - underscore requires seconds, ::: minimizes to hours
+;;
+;; Example padding effects (with offsets of 99 and 100 hours):
+;;
+;; %-7z "+99 " "+100:00"
+;; %7z "+9900 " "+100:00"
+;; %07z "+990000" "+100:00"
+;; %_7z "+990000" "+100:00:00"
+;;
+;; %7:::z "+99 " "+100:00"
+;; %7:z "+99:00 " "+100:00"
+;; %07:z "+99:00:00" "+100:00"
+;; %7::z "+99:00:00" "+100:00:00"
+
+;;; * BNF syntax of the offset string produced by %z
+
+;; <offset> ::= <sign><hours>[<minutes>[<seconds>]]<padding> |
+;; <sign><hours>[<colonminutes>[<colonseconds>]]<padding> |
+;; <sign><bighours><colonminutes>[<colonseconds>]<padding>
+;; <sign> ::= "+"|"-"
+;; <hours> ::= <2digits>
+;; <minutes> ::= <2digits>
+;; <seconds> ::= <2digits>
+;; <colonminutes> ::= ":"<minutes>
+;; <colonseconds> ::= ":"<seconds>
+;; <2digits> ::= <digit><digit>
+;; <digit> ::= "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"
+;; <bighours> ::= <digit>*<digit><2digits>
+;; <padding> ::= " "*
+
+(defun time-stamp-formatz-from-parsed-options (flag-minimize
+ flag-pad-spaces-only
+ flag-pad-zeros-first
+ colon-count
+ field-width
+ offset-secs)
+ "Formats a time offset according to a %z variation.
+The caller of this function must have already parsed the %z format
+string; this function accepts just the parts of the format.
+
+With no flags, the output includes hours and minutes: +-HHMM
+unless there is a non-zero seconds part, in which case the seconds
+are included: +-HHMMSS
+
+FLAG-MINIMIZE is whether \"-\" was specified. If non-nil, the
+output may be limited to hours if minutes and seconds are zero.
+
+FLAG-PAD-SPACES-ONLY is whether \"_\" was specified. If non-nil,
+seconds must be output, so that any padding can be spaces only.
+
+FLAG-PAD-ZEROS-FIRST is whether \"0\" was specified. If non-nil,
+padding to the requested FIELD-WIDTH (if any) is done by adding
+00 seconds before padding with spaces.
+
+COLON-COUNT is the number of colons preceding the \"z\" (0-3). One or
+two colons put that many colons in the output (+-HH:MM or +-HH:MM:SS).
+Three colons outputs only hours if minutes and seconds are zero and
+includes colon separators if minutes and seconds are output.
+
+FIELD-WIDTH is a whole number giving the minimum number of characters
+in the output; 0 specifies no minimum. Additional characters will be
+added on the right if necessary. The added characters will be spaces
+unless FLAG-PAD-ZEROS-FIRST is non-nil.
+
+OFFSET-SECS is the time zone offset (in seconds east of UTC) to be
+formatted according to the preceding parameters."
+ (let ((hrs (/ (abs offset-secs) 3600))
+ (mins (/ (% (abs offset-secs) 3600) 60))
+ (secs (% (abs offset-secs) 60))
+ (result ""))
+ ;; valid option combo?
+ (cond
+ ((not (or (and flag-minimize (> colon-count 0))
+ (and flag-pad-spaces-only (> colon-count 0))
+ (and flag-pad-spaces-only flag-minimize)
+ (and flag-pad-spaces-only flag-pad-zeros-first)
+ (and flag-pad-zeros-first flag-minimize)))
+ (setq result (concat result (if (>= offset-secs 0) "+" "-")))
+ (setq result (concat result (format "%02d" hrs)))
+ ;; Need minutes?
+ (cond
+ ((or (> hrs 99)
+ (> mins 0)
+ (> secs 0)
+ (not (or flag-minimize (= colon-count 3)))
+ (and (> field-width (length result))
+ flag-pad-zeros-first))
+ ;; Need colon before minutes?
+ (if (or (> colon-count 0)
+ (> hrs 99))
+ (setq result (concat result ":")))
+ (setq result (concat result (format "%02d" mins)))
+ ;; Need seconds, too?
+ (cond
+ ((or (> secs 0)
+ (= colon-count 2)
+ flag-pad-spaces-only
+ (and (> field-width (length result))
+ flag-pad-zeros-first))
+ ;; Need colon before seconds?
+ (if (or (> colon-count 0)
+ (> hrs 99))
+ (setq result (concat result ":")))
+ (setq result (concat result (format "%02d" secs)))))))
+ ;; Need padding?
+ (let ((needed-padding (- field-width (length result))))
+ (if (> needed-padding 0)
+ (setq result (concat result (make-string needed-padding ?\s)))))))
+ result))
+
(provide 'time-stamp)
;;; time-stamp.el ends here
diff --git a/lisp/time.el b/lisp/time.el
index 1403c4ac00a..9f25f99a149 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -205,7 +205,8 @@ depend on `display-time-day-and-date' and `display-time-24hr-format'."
'mouse-face 'mode-line-highlight
'local-map (make-mode-line-mouse-map 'mouse-2
read-mail-command)))
- ""))
+ "")
+ " ")
"List of expressions governing display of the time in the mode line.
For most purposes, you can control the time format using `display-time-format'
which is a more standard interface.
@@ -525,9 +526,16 @@ If the value is t instead of an alist, use the value of
'((t :inherit font-lock-variable-name-face))
"Face for time zone label in `world-clock' buffer.")
+(defvar world-clock-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "n" #'next-line)
+ (define-key map "p" #'previous-line)
+ map))
+
(define-derived-mode world-clock-mode special-mode "World clock"
"Major mode for buffer that displays times in various time zones.
See `world-clock'."
+ :interactive nil
(setq-local revert-buffer-function #'world-clock-update)
(setq show-trailing-whitespace nil))
@@ -591,7 +599,9 @@ To turn off the world time display, go to the window and type `\\[quit-window]'.
"Update the `world-clock' buffer."
(if (get-buffer world-clock-buffer-name)
(with-current-buffer (get-buffer world-clock-buffer-name)
- (world-clock-display (time--display-world-list)))
+ (let ((op (point)))
+ (world-clock-display (time--display-world-list))
+ (goto-char op)))
(world-clock-cancel-timer)))
;;;###autoload
@@ -614,13 +624,14 @@ point."
str))))
;;;###autoload
-(defun emacs-init-time ()
- "Return a string giving the duration of the Emacs initialization."
+(defun emacs-init-time (&optional format)
+ "Return a string giving the duration of the Emacs initialization.
+FORMAT is a string to format the result, using `format'. If nil,
+the default format \"%f seconds\" is used."
(interactive)
- (let ((str
- (format "%s seconds"
- (float-time
- (time-subtract after-init-time before-init-time)))))
+ (let ((str (format (or format "%f seconds")
+ (float-time (time-subtract after-init-time
+ before-init-time)))))
(if (called-interactively-p 'interactive)
(message "%s" str)
str)))
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 2040f522700..0d8c22d8717 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -268,7 +268,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(cdr elt)))
(t
(let* ((str (car elt))
- (paren (string-match "(" str))
+ (paren (string-search "(" str))
(pos 0) (word 0) char)
(catch 'done ; ??? is this slow?
(while (and (or (not tmm-shortcut-words) ; no limit on words
@@ -410,23 +410,15 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(if (eq elt 'undefined)
(setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
(unless (assoc event tmm-table-undef)
- (cond ((if (listp elt)
- (or (keymapp elt) (eq (car elt) 'lambda))
- (and (symbolp elt) (fboundp elt)))
+ (cond ((or (functionp elt) (keymapp elt))
(setq km elt))
- ((if (listp (cdr-safe elt))
- (or (keymapp (cdr-safe elt))
- (eq (car (cdr-safe elt)) 'lambda))
- (and (symbolp (cdr-safe elt)) (fboundp (cdr-safe elt))))
+ ((or (keymapp (cdr-safe elt)) (functionp (cdr-safe elt)))
(setq km (cdr elt))
(and (stringp (car elt)) (setq str (car elt))))
- ((if (listp (cdr-safe (cdr-safe elt)))
- (or (keymapp (cdr-safe (cdr-safe elt)))
- (eq (car (cdr-safe (cdr-safe elt))) 'lambda))
- (and (symbolp (cdr-safe (cdr-safe elt)))
- (fboundp (cdr-safe (cdr-safe elt)))))
+ ((or (keymapp (cdr-safe (cdr-safe elt)))
+ (functionp (cdr-safe (cdr-safe elt))))
(setq km (cddr elt))
(and (stringp (car elt)) (setq str (car elt))))
@@ -447,11 +439,8 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
(if enable
(setq km (if (eval enable) km 'ignore))))
- ((if (listp (cdr-safe (cdr-safe (cdr-safe elt))))
- (or (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
- (eq (car (cdr-safe (cdr-safe (cdr-safe elt)))) 'lambda))
- (and (symbolp (cdr-safe (cdr-safe (cdr-safe elt))))
- (fboundp (cdr-safe (cdr-safe (cdr-safe elt))))))
+ ((or (keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
+ (functionp (cdr-safe (cdr-safe (cdr-safe elt)))))
; New style of easy-menu
(setq km (cdr (cddr elt)))
(and (stringp (car elt)) (setq str (car elt))))
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 8e00aa5c2a9..23b67ee2cab 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -131,7 +131,11 @@ of the `tooltip' face are used instead."
:inherit variable-pitch)
(t
:inherit variable-pitch))
- "Face for tooltips."
+ "Face for tooltips.
+
+When using the GTK toolkit, this face will only be used if
+`x-gtk-use-system-tooltips' is non-nil."
+ :group 'tooltip
:group 'basic-faces)
(defcustom tooltip-use-echo-area nil
@@ -248,7 +252,12 @@ in echo area."
(setf (alist-get 'border-color params) fg))
(when (stringp bg)
(setf (alist-get 'background-color params) bg))
- (x-show-tip (propertize text 'face 'tooltip)
+ ;; Use non-nil APPEND argument below to avoid overriding any
+ ;; faces used in our TEXT. Among other things, this allows
+ ;; tooltips to use the `help-key-binding' face used in
+ ;; `substitute-command-keys' substitutions.
+ (add-face-text-property 0 (length text) 'tooltip t text)
+ (x-show-tip text
(selected-frame)
params
tooltip-hide-delay
@@ -337,7 +346,7 @@ It is also called if Tooltip mode is on, for text-only displays."
(not cursor-in-echo-area)) ;Don't overwrite a prompt.
(cond
((stringp help)
- (setq help (replace-regexp-in-string "\n" ", " help))
+ (setq help (string-replace "\n" ", " help))
(unless (or tooltip-previous-message
(equal-including-properties help (current-message))
(and (stringp tooltip-help-message)
diff --git a/lisp/transient.el b/lisp/transient.el
new file mode 100644
index 00000000000..5f441e80ddd
--- /dev/null
+++ b/lisp/transient.el
@@ -0,0 +1,3676 @@
+;;; transient.el --- Transient commands -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
+
+;; Author: Jonas Bernoulli <jonas@bernoul.li>
+;; Homepage: https://github.com/magit/transient
+;; Keywords: bindings
+
+;; Package-Requires: ((emacs "25.1"))
+;; Package-Version: 0.3.6
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;; This file is part of GNU Emacs.
+
+;;; Commentary:
+
+;; Taking inspiration from prefix keys and prefix arguments, Transient
+;; implements a similar abstraction involving a prefix command, infix
+;; arguments and suffix commands. We could call this abstraction a
+;; "transient command", but because it always involves at least two
+;; commands (a prefix and a suffix) we prefer to call it just a
+;; "transient".
+
+;; When the user calls a transient prefix command, then a transient
+;; (temporary) keymap is activated, which binds the transient's infix
+;; and suffix commands, and functions that control the transient state
+;; are added to `pre-command-hook' and `post-command-hook'. The
+;; available suffix and infix commands and their state are shown in
+;; the echo area until the transient is exited by invoking a suffix
+;; command.
+
+;; Calling an infix command causes its value to be changed, possibly
+;; by reading a new value in the minibuffer.
+
+;; Calling a suffix command usually causes the transient to be exited
+;; but suffix commands can also be configured to not exit the
+;; transient state.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'format-spec)
+(require 'seq)
+
+(eval-when-compile
+ (require 'subr-x))
+
+(declare-function info 'info)
+(declare-function Man-find-section 'man)
+(declare-function Man-next-section 'man)
+(declare-function Man-getpage-in-background 'man)
+
+(defvar Man-notify-method)
+
+(define-obsolete-function-alias 'define-transient-command
+ 'transient-define-prefix "Transient 0.3.0")
+(define-obsolete-function-alias 'define-suffix-command
+ 'transient-define-suffix "Transient 0.3.0")
+(define-obsolete-function-alias 'define-infix-command
+ 'transient-define-infix "Transient 0.3.0")
+(define-obsolete-function-alias 'define-infix-argument
+ 'transient-define-argument "Transient 0.3.0")
+
+(define-obsolete-variable-alias 'current-transient-prefix
+ 'transient-current-prefix "Transient 0.3.0")
+(define-obsolete-variable-alias 'current-transient-command
+ 'transient-current-command "Transient 0.3.0")
+(define-obsolete-variable-alias 'current-transient-suffixes
+ 'transient-current-suffixes "Transient 0.3.0")
+(define-obsolete-variable-alias 'post-transient-hook
+ 'transient-exit-hook "Transient 0.3.0")
+
+(defmacro transient--with-emergency-exit (&rest body)
+ (declare (indent defun))
+ `(condition-case err
+ (let ((debugger #'transient--exit-and-debug))
+ ,(macroexp-progn body))
+ ((debug error)
+ (transient--emergency-exit)
+ (signal (car err) (cdr err)))))
+
+(defun transient--exit-and-debug (&rest args)
+ (transient--emergency-exit)
+ (apply #'debug args))
+
+;;; Options
+
+(defgroup transient nil
+ "Transient commands."
+ :group 'extensions)
+
+(defcustom transient-show-popup t
+ "Whether to show the current transient in a popup buffer.
+
+- If t, then show the popup as soon as a transient prefix command
+ is invoked.
+
+- If nil, then do not show the popup unless the user explicitly
+ requests it, by pressing an incomplete prefix key sequence.
+
+- If a number, then delay displaying the popup and instead show
+ a brief one-line summary. If zero or negative, then suppress
+ even showing that summary and display the pressed key only.
+
+ Show the popup when the user explicitly requests it by pressing
+ an incomplete prefix key sequence. Unless zero, then also show
+ the popup after that many seconds of inactivity (using the
+ absolute value)."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type '(choice (const :tag "instantly" t)
+ (const :tag "on demand" nil)
+ (const :tag "on demand (no summary)" 0)
+ (number :tag "after delay" 1)))
+
+(defcustom transient-enable-popup-navigation nil
+ "Whether navigation commands are enabled in the transient popup.
+
+While a transient is active the transient popup buffer is not the
+current buffer, making it necessary to use dedicated commands to
+act on that buffer itself. If this non-nil, then the following
+features are available:
+
+- \"<up>\" moves the cursor to the previous suffix.
+ \"<down>\" moves the cursor to the next suffix.
+ \"RET\" invokes the suffix the cursor is on.
+- \"<mouse-1>\" invokes the clicked on suffix.
+- \"C-s\" and \"C-r\" start isearch in the popup buffer."
+ :package-version '(transient . "0.2.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-display-buffer-action
+ '(display-buffer-in-side-window
+ (side . bottom)
+ (inhibit-same-window . t))
+ "The action used to display the transient popup buffer.
+
+The transient popup buffer is displayed in a window using
+
+ \(display-buffer buf transient-display-buffer-action)
+
+The value of this option has the form (FUNCTION . ALIST),
+where FUNCTION is a function or a list of functions. Each such
+function should accept two arguments: a buffer to display and
+an alist of the same form as ALIST. See `display-buffer' for
+details.
+
+The default is:
+
+ (display-buffer-in-side-window
+ (side . bottom)
+ (inhibit-same-window . t))
+
+This displays the window at the bottom of the selected frame.
+Another useful value is (display-buffer-below-selected). This
+is what `magit-popup' used by default. For more alternatives
+see info node `(elisp)Display Action Functions'.
+
+It may be possible to display the window in another frame, but
+whether that works in practice depends on the window-manager.
+If the window manager selects the new window (Emacs frame),
+then it doesn't work.
+
+If you change the value of this option, then you might also
+want to change the value of `transient-mode-line-format'."
+ :package-version '(transient . "0.3.0")
+ :group 'transient
+ :type '(cons (choice function (repeat :tag "Functions" function))
+ alist))
+
+(defcustom transient-mode-line-format 'line
+ "The mode-line format for the transient popup buffer.
+
+If nil, then the buffer has no mode-line. If the buffer is not
+displayed right above the echo area, then this probably is not
+a good value.
+
+If `line' (the default), then the buffer also has no mode-line,
+but a thin line is drawn instead, using the background color of
+the face `transient-separator'. Termcap frames cannot display
+thin lines and therefore fallback to treating `line' like nil.
+
+Otherwise this can be any mode-line format.
+See `mode-line-format' for details."
+ :package-version '(transient . "0.2.0")
+ :group 'transient
+ :type '(choice (const :tag "hide mode-line" nil)
+ (const :tag "substitute thin line" line)
+ (const :tag "name of prefix command"
+ ("%e" mode-line-front-space
+ mode-line-buffer-identification))
+ (sexp :tag "custom mode-line format")))
+
+(defcustom transient-show-common-commands nil
+ "Whether to show common transient suffixes in the popup buffer.
+
+These commands are always shown after typing the prefix key
+\"C-x\" when a transient command is active. To toggle the value
+of this variable use \"C-x t\" when a transient is active."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-read-with-initial-input nil
+ "Whether to use the last history element as initial minibuffer input."
+ :package-version '(transient . "0.2.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-highlight-mismatched-keys nil
+ "Whether to highlight keys that do not match their argument.
+
+This only affects infix arguments that represent command-line
+arguments. When this option is non-nil, then the key binding
+for infix argument are highlighted when only a long argument
+\(e.g. \"--verbose\") is specified but no shor-thand (e.g \"-v\").
+In the rare case that a short-hand is specified but does not
+match the key binding, then it is highlighed differently.
+
+The highlighting is done using using `transient-mismatched-key'
+and `transient-nonstandard-key'."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-highlight-higher-levels nil
+ "Whether to highlight suffixes on higher levels.
+
+This is primarily intended for package authors.
+
+When non-nil then highlight the description of suffixes whose
+level is above 4, the default of `transient-default-level'.
+Assuming you have set that variable to 7, this highlights all
+suffixes that won't be available to users without them making
+the same customization."
+ :package-version '(transient . "0.3.6")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-substitute-key-function nil
+ "Function used to modify key bindings.
+
+This function is called with one argument, the prefix object,
+and must return a key binding description, either the existing
+key description it finds in the `key' slot, or a substitution.
+
+This is intended to let users replace certain prefix keys. It
+could also be used to make other substitutions, but that is
+discouraged.
+
+For example, \"=\" is hard to reach using my custom keyboard
+layout, so I substitute \"(\" for that, which is easy to reach
+using a layout optimized for lisp.
+
+ (setq transient-substitute-key-function
+ (lambda (obj)
+ (let ((key (oref obj key)))
+ (if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key)
+ (replace-match \"(\" t t key 1)
+ key)))))"
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type '(choice (const :tag "Transform no keys (nil)" nil) function))
+
+(defcustom transient-semantic-coloring nil
+ "Whether to color prefixes and suffixes in Hydra-like fashion.
+This feature is experimental.
+
+If non-nil, then the key binding of each suffix is colorized to
+indicate whether it exits the transient state or not. The color
+of the prefix is indicated using the line that is drawn when the
+value of `transient-mode-line-format' is `line'.
+
+For more information about how Hydra uses colors see
+https://github.com/abo-abo/hydra#color and
+https://oremacs.com/2015/02/19/hydra-colors-reloaded."
+ :package-version '(transient . "0.3.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-detect-key-conflicts nil
+ "Whether to detect key binding conflicts.
+
+Conflicts are detected when a transient prefix command is invoked
+and results in an error, which prevents the transient from being
+used."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-force-fixed-pitch nil
+ "Whether to force use of monospaced font in the popup buffer.
+
+Even if you use a proportional font for the `default' face,
+you might still want to use a monospaced font in transient's
+popup buffer. Setting this option to t causes `default' to
+be remapped to `fixed-pitch' in that buffer."
+ :package-version '(transient . "0.2.0")
+ :group 'transient
+ :type 'boolean)
+
+(defcustom transient-force-single-column nil
+ "Whether to force use of a single column to display suffixes.
+
+This might be useful for users with low vision who use large
+text and might otherwise have to scroll in two dimensions."
+ :package-version '(transient . "0.3.6")
+ :group 'transient
+ :type 'boolean)
+
+(defconst transient--default-child-level 1)
+
+(defconst transient--default-prefix-level 4)
+
+(defcustom transient-default-level transient--default-prefix-level
+ "Control what suffix levels are made available by default.
+
+Each suffix command is placed on a level and each prefix command
+has a level, which controls which suffix commands are available.
+Integers between 1 and 7 (inclusive) are valid levels.
+
+The levels of individual transients and/or their individual
+suffixes can be changed individually, by invoking the prefix and
+then pressing \"C-x l\".
+
+The default level for both transients and their suffixes is 4.
+This option only controls the default for transients. The default
+suffix level is always 4. The author of a transient should place
+certain suffixes on a higher level if they expect that it won't be
+of use to most users, and they should place very important suffixes
+on a lower level so that they remain available even if the user
+lowers the transient level.
+
+\(Magit currently places nearly all suffixes on level 4 and lower
+levels are not used at all yet. So for the time being you should
+not set a lower level here and using a higher level might not
+give you as many additional suffixes as you hoped.)"
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type '(choice (const :tag "1 - fewest suffixes" 1)
+ (const 2)
+ (const 3)
+ (const :tag "4 - default" 4)
+ (const 5)
+ (const 6)
+ (const :tag "7 - most suffixes" 7)))
+
+(defcustom transient-levels-file
+ (locate-user-emacs-file (convert-standard-filename "transient/levels.el"))
+ "File used to save levels of transients and their suffixes."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'file)
+
+(defcustom transient-values-file
+ (locate-user-emacs-file (convert-standard-filename "transient/values.el"))
+ "File used to save values of transients."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'file)
+
+(defcustom transient-history-file
+ (locate-user-emacs-file (convert-standard-filename "transient/history.el"))
+ "File used to save history of transients and their infixes."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'file)
+
+(defcustom transient-history-limit 10
+ "Number of history elements to keep when saving to file."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'integer)
+
+(defcustom transient-save-history t
+ "Whether to save history of transient commands when exiting Emacs."
+ :package-version '(transient . "0.1.0")
+ :group 'transient
+ :type 'boolean)
+
+;;; Faces
+
+(defgroup transient-faces nil
+ "Faces used by Transient."
+ :group 'transient)
+
+(defface transient-heading '((t :inherit font-lock-keyword-face))
+ "Face used for headings."
+ :group 'transient-faces)
+
+(defface transient-key '((t :inherit font-lock-builtin-face))
+ "Face used for keys."
+ :group 'transient-faces)
+
+(defface transient-argument '((t :inherit font-lock-warning-face))
+ "Face used for enabled arguments."
+ :group 'transient-faces)
+
+(defface transient-value '((t :inherit font-lock-string-face))
+ "Face used for values."
+ :group 'transient-faces)
+
+(defface transient-inactive-argument '((t :inherit shadow))
+ "Face used for inactive arguments."
+ :group 'transient-faces)
+
+(defface transient-inactive-value '((t :inherit shadow))
+ "Face used for inactive values."
+ :group 'transient-faces)
+
+(defface transient-unreachable '((t :inherit shadow))
+ "Face used for suffixes unreachable from the current prefix sequence."
+ :group 'transient-faces)
+
+(defface transient-active-infix '((t :inherit secondary-selection))
+ "Face used for the infix for which the value is being read."
+ :group 'transient-faces)
+
+(defface transient-unreachable-key '((t :inherit shadow))
+ "Face used for keys unreachable from the current prefix sequence."
+ :group 'transient-faces)
+
+(defface transient-nonstandard-key '((t :underline t))
+ "Face optionally used to highlight keys conflicting with short-argument.
+Also see option `transient-highlight-mismatched-keys'."
+ :group 'transient-faces)
+
+(defface transient-mismatched-key '((t :underline t))
+ "Face optionally used to highlight keys without a short-argument.
+Also see option `transient-highlight-mismatched-keys'."
+ :group 'transient-faces)
+
+(defface transient-inapt-suffix '((t :inherit shadow :italic t))
+ "Face used for suffixes that are inapt at this time."
+ :group 'transient-faces)
+
+(defface transient-enabled-suffix
+ '((t :background "green" :foreground "black" :weight bold))
+ "Face used for enabled levels while editing suffix levels.
+See info node `(transient)Enabling and Disabling Suffixes'."
+ :group 'transient-faces)
+
+(defface transient-disabled-suffix
+ '((t :background "red" :foreground "black" :weight bold))
+ "Face used for disabled levels while editing suffix levels.
+See info node `(transient)Enabling and Disabling Suffixes'."
+ :group 'transient-faces)
+
+(defface transient-higher-level '((t :underline t))
+ "Face optionally used to highlight suffixes on higher levels.
+Also see option `transient-highlight-higher-levels'."
+ :group 'transient-faces)
+
+(defface transient-separator
+ `((((class color) (background light))
+ ,@(and (>= emacs-major-version 27) '(:extend t))
+ :background "grey80")
+ (((class color) (background dark))
+ ,@(and (>= emacs-major-version 27) '(:extend t))
+ :background "grey30"))
+ "Face used to draw line below transient popup window.
+This is only used if `transient-mode-line-format' is `line'.
+Only the background color is significant."
+ :group 'transient-faces)
+
+(defgroup transient-color-faces
+ '((transient-semantic-coloring custom-variable))
+ "Faces used by Transient for Hydra-like command coloring.
+These faces are only used if `transient-semantic-coloring'
+\(which see) is non-nil."
+ :group 'transient-faces)
+
+(defface transient-red
+ '((t :inherit transient-key :foreground "red"))
+ "Face used for red prefixes and suffixes."
+ :group 'transient-color-faces)
+
+(defface transient-blue
+ '((t :inherit transient-key :foreground "blue"))
+ "Face used for blue prefixes and suffixes."
+ :group 'transient-color-faces)
+
+(defface transient-amaranth
+ '((t :inherit transient-key :foreground "#E52B50"))
+ "Face used for amaranth prefixes."
+ :group 'transient-color-faces)
+
+(defface transient-pink
+ '((t :inherit transient-key :foreground "#FF6EB4"))
+ "Face used for pink prefixes."
+ :group 'transient-color-faces)
+
+(defface transient-teal
+ '((t :inherit transient-key :foreground "#367588"))
+ "Face used for teal prefixes."
+ :group 'transient-color-faces)
+
+;;; Persistence
+
+(defun transient--read-file-contents (file)
+ (with-demoted-errors "Transient error: %S"
+ (and (file-exists-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (read (current-buffer))))))
+
+(defun transient--pp-to-file (list file)
+ (make-directory (file-name-directory file) t)
+ (setq list (cl-sort (copy-sequence list) #'string< :key #'car))
+ (with-temp-file file
+ (let ((print-level nil)
+ (print-length nil))
+ (pp list (current-buffer)))))
+
+(defvar transient-values
+ (transient--read-file-contents transient-values-file)
+ "Values of transient commands.
+The value of this variable persists between Emacs sessions
+and you usually should not change it manually.")
+
+(defun transient-save-values ()
+ (transient--pp-to-file transient-values transient-values-file))
+
+(defvar transient-levels
+ (transient--read-file-contents transient-levels-file)
+ "Levels of transient commands.
+The value of this variable persists between Emacs sessions
+and you usually should not change it manually.")
+
+(defun transient-save-levels ()
+ (transient--pp-to-file transient-levels transient-levels-file))
+
+(defvar transient-history
+ (transient--read-file-contents transient-history-file)
+ "History of transient commands and infix arguments.
+The value of this variable persists between Emacs sessions
+\(unless `transient-save-history' is nil) and you usually
+should not change it manually.")
+
+(defun transient-save-history ()
+ (setq transient-history
+ (cl-sort (mapcar (pcase-lambda (`(,key . ,val))
+ (cons key (seq-take (delete-dups val)
+ transient-history-limit)))
+ transient-history)
+ #'string< :key #'car))
+ (transient--pp-to-file transient-history transient-history-file))
+
+(defun transient-maybe-save-history ()
+ "Save the value of `transient-history'.
+If `transient-save-history' is nil, then do nothing."
+ (when transient-save-history
+ (transient-save-history)))
+
+(unless noninteractive
+ (add-hook 'kill-emacs-hook 'transient-maybe-save-history))
+
+;;; Classes
+;;;; Prefix
+
+(defclass transient-prefix ()
+ ((prototype :initarg :prototype)
+ (command :initarg :command)
+ (level :initarg :level)
+ (variable :initarg :variable :initform nil)
+ (init-value :initarg :init-value)
+ (value) (default-value :initarg :value)
+ (scope :initarg :scope :initform nil)
+ (history :initarg :history :initform nil)
+ (history-pos :initarg :history-pos :initform 0)
+ (history-key :initarg :history-key :initform nil)
+ (man-page :initarg :man-page :initform nil)
+ (info-manual :initarg :info-manual :initform nil)
+ (transient-suffix :initarg :transient-suffix :initform nil)
+ (transient-non-suffix :initarg :transient-non-suffix :initform nil)
+ (incompatible :initarg :incompatible :initform nil)
+ (suffix-description :initarg :suffix-description))
+ "Transient prefix command.
+
+Each transient prefix command consists of a command, which is
+stored in a symbol's function slot and an object, which is
+stored in the `transient--prefix' property of the same symbol.
+
+When a transient prefix command is invoked, then a clone of that
+object is stored in the global variable `transient--prefix' and
+the prototype is stored in the clone's `prototype' slot.")
+
+;;;; Suffix
+
+(defclass transient-child ()
+ ((level
+ :initarg :level
+ :initform (symbol-value 'transient--default-child-level)
+ :documentation "Enable if level of prefix is equal or greater.")
+ (if
+ :initarg :if
+ :initform nil
+ :documentation "Enable if predicate returns non-nil.")
+ (if-not
+ :initarg :if-not
+ :initform nil
+ :documentation "Enable if predicate returns nil.")
+ (if-non-nil
+ :initarg :if-non-nil
+ :initform nil
+ :documentation "Enable if variable's value is non-nil.")
+ (if-nil
+ :initarg :if-nil
+ :initform nil
+ :documentation "Enable if variable's value is nil.")
+ (if-mode
+ :initarg :if-mode
+ :initform nil
+ :documentation "Enable if major-mode matches value.")
+ (if-not-mode
+ :initarg :if-not-mode
+ :initform nil
+ :documentation "Enable if major-mode does not match value.")
+ (if-derived
+ :initarg :if-derived
+ :initform nil
+ :documentation "Enable if major-mode derives from value.")
+ (if-not-derived
+ :initarg :if-not-derived
+ :initform nil
+ :documentation "Enable if major-mode does not derive from value."))
+ "Abstract superclass for group and and suffix classes.
+
+It is undefined what happens if more than one `if*' predicate
+slot is non-nil."
+ :abstract t)
+
+(defclass transient-suffix (transient-child)
+ ((key :initarg :key)
+ (command :initarg :command)
+ (transient :initarg :transient)
+ (format :initarg :format :initform " %k %d")
+ (description :initarg :description :initform nil)
+ (inapt :initform nil)
+ (inapt-if
+ :initarg :inapt-if
+ :initform nil
+ :documentation "Inapt if predicate returns non-nil.")
+ (inapt-if-not
+ :initarg :inapt-if-not
+ :initform nil
+ :documentation "Inapt if predicate returns nil.")
+ (inapt-if-non-nil
+ :initarg :inapt-if-non-nil
+ :initform nil
+ :documentation "Inapt if variable's value is non-nil.")
+ (inapt-if-nil
+ :initarg :inapt-if-nil
+ :initform nil
+ :documentation "Inapt if variable's value is nil.")
+ (inapt-if-mode
+ :initarg :inapt-if-mode
+ :initform nil
+ :documentation "Inapt if major-mode matches value.")
+ (inapt-if-not-mode
+ :initarg :inapt-if-not-mode
+ :initform nil
+ :documentation "Inapt if major-mode does not match value.")
+ (inapt-if-derived
+ :initarg :inapt-if-derived
+ :initform nil
+ :documentation "Inapt if major-mode derives from value.")
+ (inapt-if-not-derived
+ :initarg :inapt-if-not-derived
+ :initform nil
+ :documentation "Inapt if major-mode does not derive from value."))
+ "Superclass for suffix command.")
+
+(defclass transient-infix (transient-suffix)
+ ((transient :initform t)
+ (argument :initarg :argument)
+ (shortarg :initarg :shortarg)
+ (value :initform nil)
+ (init-value :initarg :init-value)
+ (unsavable :initarg :unsavable :initform nil)
+ (multi-value :initarg :multi-value :initform nil)
+ (always-read :initarg :always-read :initform nil)
+ (allow-empty :initarg :allow-empty :initform nil)
+ (history-key :initarg :history-key :initform nil)
+ (reader :initarg :reader :initform nil)
+ (prompt :initarg :prompt :initform nil)
+ (choices :initarg :choices :initform nil)
+ (format :initform " %k %d (%v)"))
+ "Transient infix command."
+ :abstract t)
+
+(defclass transient-argument (transient-infix) ()
+ "Abstract superclass for infix arguments."
+ :abstract t)
+
+(defclass transient-switch (transient-argument) ()
+ "Class used for command-line argument that can be turned on and off.")
+
+(defclass transient-option (transient-argument) ()
+ "Class used for command-line argument that can take a value.")
+
+(defclass transient-variable (transient-infix)
+ ((variable :initarg :variable)
+ (format :initform " %k %d %v"))
+ "Abstract superclass for infix commands that set a variable."
+ :abstract t)
+
+(defclass transient-switches (transient-argument)
+ ((argument-format :initarg :argument-format)
+ (argument-regexp :initarg :argument-regexp))
+ "Class used for sets of mutually exclusive command-line switches.")
+
+(defclass transient-files (transient-infix) ()
+ "Class used for the \"--\" argument.
+All remaining arguments are treated as files.
+They become the value of this this argument.")
+
+;;;; Group
+
+(defclass transient-group (transient-child)
+ ((suffixes :initarg :suffixes :initform nil)
+ (hide :initarg :hide :initform nil)
+ (description :initarg :description :initform nil)
+ (setup-children :initarg :setup-children)
+ (pad-keys :initarg :pad-keys))
+ "Abstract superclass of all group classes."
+ :abstract t)
+
+(defclass transient-column (transient-group) ()
+ "Group class that displays each element on a separate line.")
+
+(defclass transient-row (transient-group) ()
+ "Group class that displays all elements on a single line.")
+
+(defclass transient-columns (transient-group) ()
+ "Group class that displays elements organized in columns.
+Direct elements have to be groups whose elements have to be
+commands or string. Each subgroup represents a column. This
+class takes care of inserting the subgroups' elements.")
+
+(defclass transient-subgroups (transient-group) ()
+ "Group class that wraps other groups.
+
+Direct elements have to be groups whose elements have to be
+commands or strings. This group inserts an empty line between
+subgroups. The subgroups are responsible for displaying their
+elements themselves.")
+
+;;; Define
+
+(defmacro transient-define-prefix (name arglist &rest args)
+ "Define NAME as a transient prefix command.
+
+ARGLIST are the arguments that command takes.
+DOCSTRING is the documentation string and is optional.
+
+These arguments can optionally be followed by key-value pairs.
+Each key has to be a keyword symbol, either `:class' or a keyword
+argument supported by the constructor of that class. The
+`transient-prefix' class is used if the class is not specified
+explicitly.
+
+GROUPs add key bindings for infix and suffix commands and specify
+how these bindings are presented in the popup buffer. At least
+one GROUP has to be specified. See info node `(transient)Binding
+Suffix and Infix Commands'.
+
+The BODY is optional. If it is omitted, then ARGLIST is also
+ignored and the function definition becomes:
+
+ (lambda ()
+ (interactive)
+ (transient-setup \\='NAME))
+
+If BODY is specified, then it must begin with an `interactive'
+form that matches ARGLIST, and it must call `transient-setup'.
+It may however call that function only when some condition is
+satisfied; that is one of the reason why you might want to use
+an explicit BODY.
+
+All transients have a (possibly nil) value, which is exported
+when suffix commands are called, so that they can consume that
+value. For some transients it might be necessary to have a sort
+of secondary value, called a scope. Such a scope would usually
+be set in the commands `interactive' form and has to be passed
+to the setup function:
+
+ (transient-setup \\='NAME nil nil :scope SCOPE)
+
+\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])"
+ (declare (debug (&define name lambda-list
+ [&optional lambda-doc]
+ [&rest keywordp sexp]
+ [&rest vectorp]
+ [&optional ("interactive" interactive) def-body]))
+ (indent defun)
+ (doc-string 3))
+ (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body)
+ (transient--expand-define-args args)))
+ `(progn
+ (defalias ',name
+ ,(if body
+ `(lambda ,arglist ,@body)
+ `(lambda ()
+ (interactive)
+ (transient-setup ',name))))
+ (put ',name 'interactive-only t)
+ (put ',name 'function-documentation ,docstr)
+ (put ',name 'transient--prefix
+ (,(or class 'transient-prefix) :command ',name ,@slots))
+ (put ',name 'transient--layout
+ ',(cl-mapcan (lambda (s) (transient--parse-child name s))
+ suffixes)))))
+
+(defmacro transient-define-suffix (name arglist &rest args)
+ "Define NAME as a transient suffix command.
+
+ARGLIST are the arguments that the command takes.
+DOCSTRING is the documentation string and is optional.
+
+These arguments can optionally be followed by key-value pairs.
+Each key has to be a keyword symbol, either `:class' or a
+keyword argument supported by the constructor of that class.
+The `transient-suffix' class is used if the class is not
+specified explicitly.
+
+The BODY must begin with an `interactive' form that matches
+ARGLIST. The infix arguments are usually accessed by using
+`transient-args' inside `interactive'.
+
+\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... BODY...)"
+ (declare (debug (&define name lambda-list
+ [&optional lambda-doc]
+ [&rest keywordp sexp]
+ ("interactive" interactive)
+ def-body))
+ (indent defun)
+ (doc-string 3))
+ (pcase-let ((`(,class ,slots ,_ ,docstr ,body)
+ (transient--expand-define-args args)))
+ `(progn
+ (defalias ',name (lambda ,arglist ,@body))
+ (put ',name 'interactive-only t)
+ (put ',name 'function-documentation ,docstr)
+ (put ',name 'transient--suffix
+ (,(or class 'transient-suffix) :command ',name ,@slots)))))
+
+(defmacro transient-define-infix (name _arglist &rest args)
+ "Define NAME as a transient infix command.
+
+ARGLIST is always ignored and reserved for future use.
+DOCSTRING is the documentation string and is optional.
+
+The key-value pairs are mandatory. All transient infix commands
+are equal to each other (but not eq), so it is meaningless to
+define an infix command without also setting at least `:class'
+and one other keyword (which it is depends on the used class,
+usually `:argument' or `:variable').
+
+Each key has to be a keyword symbol, either `:class' or a keyword
+argument supported by the constructor of that class. The
+`transient-switch' class is used if the class is not specified
+explicitly.
+
+The function definitions is always:
+
+ (lambda ()
+ (interactive)
+ (let ((obj (transient-suffix-object)))
+ (transient-infix-set obj (transient-infix-read obj)))
+ (transient--show))
+
+`transient-infix-read' and `transient-infix-set' are generic
+functions. Different infix commands behave differently because
+the concrete methods are different for different infix command
+classes. In rare case the above command function might not be
+suitable, even if you define your own infix command class. In
+that case you have to use `transient-suffix-command' to define
+the infix command and use t as the value of the `:transient'
+keyword.
+
+\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)"
+ (declare (debug (&define name lambda-list
+ [&optional lambda-doc]
+ [&rest keywordp sexp]))
+ (indent defun)
+ (doc-string 3))
+ (pcase-let ((`(,class ,slots ,_ ,docstr ,_)
+ (transient--expand-define-args args)))
+ `(progn
+ (defalias ',name ,(transient--default-infix-command))
+ (put ',name 'interactive-only t)
+ (put ',name 'function-documentation ,docstr)
+ (put ',name 'transient--suffix
+ (,(or class 'transient-switch) :command ',name ,@slots)))))
+
+(defalias 'transient-define-argument 'define-infix-command
+ "Define NAME as a transient infix command.
+
+Only use this alias to define an infix command that actually
+sets an infix argument. To define a infix command that, for
+example, sets a variable use `transient-define-infix' instead.
+
+\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)")
+
+(defun transient--expand-define-args (args)
+ (let (class keys suffixes docstr)
+ (when (stringp (car args))
+ (setq docstr (pop args)))
+ (while (keywordp (car args))
+ (let ((k (pop args))
+ (v (pop args)))
+ (if (eq k :class)
+ (setq class v)
+ (push k keys)
+ (push v keys))))
+ (while (let ((arg (car args)))
+ (or (vectorp arg)
+ (and arg (symbolp arg))))
+ (push (pop args) suffixes))
+ (list (if (eq (car-safe class) 'quote)
+ (cadr class)
+ class)
+ (nreverse keys)
+ (nreverse suffixes)
+ docstr
+ args)))
+
+(defun transient--parse-child (prefix spec)
+ (cl-etypecase spec
+ (symbol (let ((value (symbol-value spec)))
+ (if (and (listp value)
+ (or (listp (car value))
+ (vectorp (car value))))
+ (cl-mapcan (lambda (s) (transient--parse-child prefix s)) value)
+ (transient--parse-child prefix value))))
+ (vector (when-let ((c (transient--parse-group prefix spec))) (list c)))
+ (list (when-let ((c (transient--parse-suffix prefix spec))) (list c)))
+ (string (list spec))))
+
+(defun transient--parse-group (prefix spec)
+ (setq spec (append spec nil))
+ (cl-symbol-macrolet
+ ((car (car spec))
+ (pop (pop spec)))
+ (let (level class args)
+ (when (integerp car)
+ (setq level pop))
+ (when (stringp car)
+ (setq args (plist-put args :description pop)))
+ (while (keywordp car)
+ (let ((k pop))
+ (if (eq k :class)
+ (setq class pop)
+ (setq args (plist-put args k pop)))))
+ (vector (or level transient--default-child-level)
+ (or class
+ (if (vectorp car)
+ 'transient-columns
+ 'transient-column))
+ args
+ (cl-mapcan (lambda (s) (transient--parse-child prefix s)) spec)))))
+
+(defun transient--parse-suffix (prefix spec)
+ (let (level class args)
+ (cl-symbol-macrolet
+ ((car (car spec))
+ (pop (pop spec)))
+ (when (integerp car)
+ (setq level pop))
+ (when (or (stringp car)
+ (vectorp car))
+ (setq args (plist-put args :key pop)))
+ (when (or (stringp car)
+ (eq (car-safe car) 'lambda)
+ (and (symbolp car)
+ (not (commandp car))
+ (commandp (cadr spec))))
+ (setq args (plist-put args :description pop)))
+ (cond
+ ((keywordp car)
+ (error "Need command, got %S" car))
+ ((symbolp car)
+ (setq args (plist-put args :command pop)))
+ ((and (commandp car)
+ (not (stringp car)))
+ (let ((cmd pop)
+ (sym (intern (format "transient:%s:%s"
+ prefix
+ (or (plist-get args :description)
+ (plist-get args :key))))))
+ (defalias sym cmd)
+ (setq args (plist-put args :command sym))))
+ ((or (stringp car)
+ (and car (listp car)))
+ (let ((arg pop))
+ (cl-typecase arg
+ (list
+ (setq args (plist-put args :shortarg (car arg)))
+ (setq args (plist-put args :argument (cadr arg)))
+ (setq arg (cadr arg)))
+ (string
+ (when-let ((shortarg (transient--derive-shortarg arg)))
+ (setq args (plist-put args :shortarg shortarg)))
+ (setq args (plist-put args :argument arg))))
+ (setq args (plist-put args :command
+ (intern (format "transient:%s:%s"
+ prefix arg))))
+ (cond ((and car (not (keywordp car)))
+ (setq class 'transient-option)
+ (setq args (plist-put args :reader pop)))
+ ((not (string-suffix-p "=" arg))
+ (setq class 'transient-switch))
+ (t
+ (setq class 'transient-option)))))
+ (t
+ (error "Needed command or argument, got %S" car)))
+ (while (keywordp car)
+ (let ((k pop))
+ (cl-case k
+ (:class (setq class pop))
+ (:level (setq level pop))
+ (t (setq args (plist-put args k pop)))))))
+ (unless (plist-get args :key)
+ (when-let ((shortarg (plist-get args :shortarg)))
+ (setq args (plist-put args :key shortarg))))
+ (list (or level transient--default-child-level)
+ (or class 'transient-suffix)
+ args)))
+
+(defun transient--default-infix-command ()
+ (cons 'lambda
+ '(()
+ (interactive)
+ (let ((obj (transient-suffix-object)))
+ (transient-infix-set obj (transient-infix-read obj)))
+ (transient--show))))
+
+(defun transient--ensure-infix-command (obj)
+ (let ((cmd (oref obj command)))
+ (unless (or (commandp cmd)
+ (get cmd 'transient--infix-command))
+ (if (or (cl-typep obj 'transient-switch)
+ (cl-typep obj 'transient-option))
+ (put cmd 'transient--infix-command
+ (transient--default-infix-command))
+ ;; This is not an anonymous infix argument.
+ (error "Suffix %s is not defined or autoloaded as a command" cmd)))))
+
+(defun transient--derive-shortarg (arg)
+ (save-match-data
+ (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
+ (match-string 1 arg))))
+
+;;; Edit
+
+(defun transient--insert-suffix (prefix loc suffix action)
+ (let* ((suf (cl-etypecase suffix
+ (vector (transient--parse-group prefix suffix))
+ (list (transient--parse-suffix prefix suffix))
+ (string suffix)))
+ (mem (transient--layout-member loc prefix))
+ (elt (car mem)))
+ (cond
+ ((not mem)
+ (message "Cannot insert %S into %s; %s not found"
+ suffix prefix loc))
+ ((or (and (vectorp suffix) (not (vectorp elt)))
+ (and (listp suffix) (vectorp elt))
+ (and (stringp suffix) (vectorp elt)))
+ (message "Cannot place %S into %s at %s; %s"
+ suffix prefix loc
+ "suffixes and groups cannot be siblings"))
+ (t
+ (when (and (listp suffix)
+ (listp elt))
+ ;; Both suffixes are key bindings; not heading strings.
+ (let ((key (transient--spec-key suf)))
+ (if (equal (transient--kbd key)
+ (transient--kbd (transient--spec-key elt)))
+ ;; We must keep `mem' until after we have inserted
+ ;; behind it, which `transient-remove-suffix' does
+ ;; not allow us to do.
+ (let ((spred (transient--suffix-predicate suf))
+ (epred (transient--suffix-predicate elt)))
+ ;; If both suffixes have a predicate and they
+ ;; are not identical, then there is a high
+ ;; probability that we want to keep both.
+ (when (or (not spred)
+ (not epred)
+ (equal spred epred))
+ (setq action 'replace)))
+ (transient-remove-suffix prefix key))))
+ (cl-ecase action
+ (insert (setcdr mem (cons elt (cdr mem)))
+ (setcar mem suf))
+ (append (setcdr mem (cons suf (cdr mem))))
+ (replace (setcar mem suf)))))))
+
+;;;###autoload
+(defun transient-insert-suffix (prefix loc suffix)
+ "Insert a SUFFIX into PREFIX before LOC.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'."
+ (declare (indent defun))
+ (transient--insert-suffix prefix loc suffix 'insert))
+
+;;;###autoload
+(defun transient-append-suffix (prefix loc suffix)
+ "Insert a SUFFIX into PREFIX after LOC.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'."
+ (declare (indent defun))
+ (transient--insert-suffix prefix loc suffix 'append))
+
+;;;###autoload
+(defun transient-replace-suffix (prefix loc suffix)
+ "Replace the suffix at LOC in PREFIX with SUFFIX.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'."
+ (declare (indent defun))
+ (transient--insert-suffix prefix loc suffix 'replace))
+
+;;;###autoload
+(defun transient-remove-suffix (prefix loc)
+ "Remove the suffix or group at LOC in PREFIX.
+PREFIX is a prefix command, a symbol.
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'."
+ (declare (indent defun))
+ (transient--layout-member loc prefix 'remove))
+
+(defun transient-get-suffix (prefix loc)
+ "Return the suffix or group at LOC in PREFIX.
+PREFIX is a prefix command, a symbol.
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'."
+ (if-let ((mem (transient--layout-member loc prefix)))
+ (car mem)
+ (error "%s not found in %s" loc prefix)))
+
+(defun transient-suffix-put (prefix loc prop value)
+ "Edit the suffix at LOC in PREFIX, setting PROP to VALUE.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+LOC is a command, a key vector, a key description (a string
+ as returned by `key-description'), or a coordination list
+ (whose last element may also be a command or key).
+See info node `(transient)Modifying Existing Transients'."
+ (let ((suf (transient-get-suffix prefix loc)))
+ (setf (elt suf 2)
+ (plist-put (elt suf 2) prop value))))
+
+(defun transient--layout-member (loc prefix &optional remove)
+ (let ((val (or (get prefix 'transient--layout)
+ (error "%s is not a transient command" prefix))))
+ (when (listp loc)
+ (while (integerp (car loc))
+ (let* ((children (if (vectorp val) (aref val 3) val))
+ (mem (transient--nthcdr (pop loc) children)))
+ (if (and remove (not loc))
+ (let ((rest (delq (car mem) children)))
+ (if (vectorp val)
+ (aset val 3 rest)
+ (put prefix 'transient--layout rest))
+ (setq val nil))
+ (setq val (if loc (car mem) mem)))))
+ (setq loc (car loc)))
+ (if loc
+ (transient--layout-member-1 (transient--kbd loc) val remove)
+ val)))
+
+(defun transient--layout-member-1 (loc layout remove)
+ (cond ((listp layout)
+ (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
+ layout))
+ ((vectorp (car (aref layout 3)))
+ (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove))
+ (aref layout 3)))
+ (remove
+ (aset layout 3
+ (delq (car (transient--group-member loc layout))
+ (aref layout 3)))
+ nil)
+ (t (transient--group-member loc layout))))
+
+(defun transient--group-member (loc group)
+ (cl-member-if (lambda (suffix)
+ (and (listp suffix)
+ (let* ((def (nth 2 suffix))
+ (cmd (plist-get def :command)))
+ (if (symbolp loc)
+ (eq cmd loc)
+ (equal (transient--kbd
+ (or (plist-get def :key)
+ (transient--command-key cmd)))
+ loc)))))
+ (aref group 3)))
+
+(defun transient--kbd (keys)
+ (when (vectorp keys)
+ (setq keys (key-description keys)))
+ (when (stringp keys)
+ (setq keys (kbd keys)))
+ keys)
+
+(defun transient--spec-key (spec)
+ (let ((plist (nth 2 spec)))
+ (or (plist-get plist :key)
+ (transient--command-key
+ (plist-get plist :command)))))
+
+(defun transient--command-key (cmd)
+ (when-let ((obj (get cmd 'transient--suffix)))
+ (cond ((slot-boundp obj 'key)
+ (oref obj key))
+ ((slot-exists-p obj 'shortarg)
+ (if (slot-boundp obj 'shortarg)
+ (oref obj shortarg)
+ (transient--derive-shortarg (oref obj argument)))))))
+
+(defun transient--nthcdr (n list)
+ (nthcdr (if (< n 0) (- (length list) (abs n)) n) list))
+
+;;; Variables
+
+(defvar transient-current-prefix nil
+ "The transient from which this suffix command was invoked.
+This is an object representing that transient, use
+`transient-current-command' to get the respective command.")
+
+(defvar transient-current-command nil
+ "The transient from which this suffix command was invoked.
+This is a symbol representing that transient, use
+`current-transient-object' to get the respective object.")
+
+(defvar transient-current-suffixes nil
+ "The suffixes of the transient from which this suffix command was invoked.
+This is a list of objects. Usually it is sufficient to instead
+use the function `transient-args', which returns a list of
+values. In complex cases it might be necessary to use this
+variable instead.")
+
+(defvar transient-exit-hook nil
+ "Hook run after exiting a transient.")
+
+(defvar transient--prefix nil)
+(defvar transient--layout nil)
+(defvar transient--suffixes nil)
+
+(defconst transient--stay t "Do not exit the transient.")
+(defconst transient--exit nil "Do exit the transient.")
+
+(defvar transient--exitp nil "Whether to exit the transient.")
+(defvar transient--showp nil "Whether the transient is show in a popup buffer.")
+(defvar transient--helpp nil "Whether help-mode is active.")
+(defvar transient--editp nil "Whether edit-mode is active.")
+
+(defvar transient--active-infix nil "The active infix awaiting user input.")
+
+(defvar transient--timer nil)
+
+(defvar transient--stack nil)
+
+(defvar transient--buffer-name " *transient*"
+ "Name of the transient buffer.")
+
+(defvar transient--window nil
+ "The window used to display the transient popup.")
+
+(defvar transient--original-window nil
+ "The window that was selected before the transient was invoked.
+Usually it remains selected while the transient is active.")
+
+(define-obsolete-variable-alias 'transient--source-buffer
+ 'transient--original-buffer "Transient 0.2.0")
+
+(defvar transient--original-buffer nil
+ "The buffer that was current before the transient was invoked.
+Usually it remains current while the transient is active.")
+
+(defvar transient--debug nil "Whether put debug information into *Messages*.")
+
+(defvar transient--history nil)
+
+(defvar transient--scroll-commands
+ '(transient-scroll-up
+ transient-scroll-down
+ mwheel-scroll
+ scroll-bar-toolkit-scroll))
+
+;;; Identities
+
+(defun transient-suffix-object (&optional command)
+ "Return the object associated with the current suffix command.
+
+Each suffix commands is associated with an object, which holds
+additional information about the suffix, such as its value (in
+the case of an infix command, which is a kind of suffix command).
+
+This function is intended to be called by infix commands, whose
+command definition usually (at least when defined using
+`transient-define-infix') is this:
+
+ (lambda ()
+ (interactive)
+ (let ((obj (transient-suffix-object)))
+ (transient-infix-set obj (transient-infix-read obj)))
+ (transient--show))
+
+\(User input is read outside of `interactive' to prevent the
+command from being added to `command-history'. See #23.)
+
+Such commands need to be able to access their associated object
+to guide how `transient-infix-read' reads the new value and to
+store the read value. Other suffix commands (including non-infix
+commands) may also need the object to guide their behavior.
+
+This function attempts to return the object associated with the
+current suffix command even if the suffix command was not invoked
+from a transient. (For some suffix command that is a valid thing
+to do, for others it is not.) In that case nil may be returned
+if the command was not defined using one of the macros intended
+to define such commands.
+
+The optional argument COMMAND is intended for internal use. If
+you are contemplating using it in your own code, then you should
+probably use this instead:
+
+ (get COMMAND 'transient--suffix)"
+ (when command
+ (cl-check-type command command))
+ (if (or transient--prefix
+ transient-current-prefix)
+ (cl-find-if (lambda (obj)
+ (eq (transient--suffix-command obj)
+ (or command this-original-command)))
+ (or transient--suffixes
+ transient-current-suffixes))
+ (when-let ((obj (get (or command this-command) 'transient--suffix))
+ (obj (clone obj)))
+ (transient-init-scope obj)
+ (transient-init-value obj)
+ obj)))
+
+(defun transient--suffix-command (object)
+ "Return the command represented by OBJECT.
+
+If the value of OBJECT's `command' slot is a command, then return
+that. Otherwise it is a symbol whose `transient--infix-command'
+property holds an anonymous command, which is returned instead."
+ (cl-check-type object transient-suffix)
+ (let ((sym (oref object command)))
+ (if (commandp sym)
+ sym
+ (get sym 'transient--infix-command))))
+
+(defun transient--suffix-symbol (arg)
+ "Return a symbol representing ARG.
+
+ARG must be a command and/or a symbol. If it is a symbol,
+then just return it. Otherwise return the symbol whose
+`transient--infix-command' property's value is ARG."
+ (or (cl-typep arg 'command)
+ (cl-typep arg 'symbol)
+ (signal 'wrong-type-argument `((command symbol) ,arg)))
+ (if (symbolp arg)
+ arg
+ (let* ((obj (transient-suffix-object))
+ (sym (oref obj command)))
+ (if (eq (get sym 'transient--infix-command) arg)
+ sym
+ (catch 'found
+ (mapatoms (lambda (sym)
+ (when (eq (get sym 'transient--infix-command) arg)
+ (throw 'found sym)))))))))
+
+;;; Keymaps
+
+(defvar transient-base-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "ESC ESC ESC") 'transient-quit-all)
+ (define-key map (kbd "C-g") 'transient-quit-one)
+ (define-key map (kbd "C-q") 'transient-quit-all)
+ (define-key map (kbd "C-z") 'transient-suspend)
+ (define-key map (kbd "C-v") 'transient-scroll-up)
+ (define-key map (kbd "C-M-v") 'transient-scroll-down)
+ (define-key map [next] 'transient-scroll-up)
+ (define-key map [prior] 'transient-scroll-down)
+ map)
+ "Parent of other keymaps used by Transient.
+
+This is the parent keymap of all the keymaps that are used in
+all transients: `transient-map' (which in turn is the parent
+of the transient-specific keymaps), `transient-edit-map' and
+`transient-sticky-map'.
+
+If you change a binding here, then you might also have to edit
+`transient-sticky-map' and `transient-common-commands'. While
+the latter isn't a proper transient prefix command, it can be
+edited using the same functions as used for transients.
+
+If you add a new command here, then you must also add a binding
+to `transient-predicate-map'.")
+
+(defvar transient-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map transient-base-map)
+ (define-key map (kbd "C-p") 'universal-argument)
+ (define-key map (kbd "C--") 'negative-argument)
+ (define-key map (kbd "C-t") 'transient-show)
+ (define-key map (kbd "?") 'transient-help)
+ (define-key map (kbd "C-h") 'transient-help)
+ ;; Also bound to "C-x p" and "C-x n" in transient-common-commands.
+ (define-key map (kbd "C-M-p") 'transient-history-prev)
+ (define-key map (kbd "C-M-n") 'transient-history-next)
+ map)
+ "Top-level keymap used by all transients.
+
+If you add a new command here, then you must also add a binding
+to `transient-predicate-map'. Also see `transient-base-map'.")
+
+(defvar transient-edit-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map transient-base-map)
+ (define-key map (kbd "?") 'transient-help)
+ (define-key map (kbd "C-h") 'transient-help)
+ (define-key map (kbd "C-x l") 'transient-set-level)
+ map)
+ "Keymap that is active while a transient in is in \"edit mode\".")
+
+(defvar transient-sticky-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map transient-base-map)
+ (define-key map (kbd "C-g") 'transient-quit-seq)
+ map)
+ "Keymap that is active while an incomplete key sequence is active.")
+
+(defvar transient--common-command-prefixes '(?\C-x))
+
+(put 'transient-common-commands
+ 'transient--layout
+ (cl-mapcan
+ (lambda (s) (transient--parse-child 'transient-common-commands s))
+ '([:hide (lambda ()
+ (and (not (memq (car transient--redisplay-key)
+ transient--common-command-prefixes))
+ (not transient-show-common-commands)))
+ ["Value commands"
+ ("C-x s " "Set" transient-set)
+ ("C-x C-s" "Save" transient-save)
+ ("C-x p " "Previous value" transient-history-prev)
+ ("C-x n " "Next value" transient-history-next)]
+ ["Sticky commands"
+ ;; Like `transient-sticky-map' except that
+ ;; "C-g" has to be bound to a different command.
+ ("C-g" "Quit prefix or transient" transient-quit-one)
+ ("C-q" "Quit transient stack" transient-quit-all)
+ ("C-z" "Suspend transient stack" transient-suspend)]
+ ["Customize"
+ ("C-x t" transient-toggle-common
+ :description (lambda ()
+ (if transient-show-common-commands
+ "Hide common commands"
+ "Show common permanently")))
+ ("C-x l" "Show/hide suffixes" transient-set-level)]])))
+
+(defvar transient-predicate-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [handle-switch-frame] 'transient--do-suspend)
+ (define-key map [transient-suspend] 'transient--do-suspend)
+ (define-key map [transient-help] 'transient--do-stay)
+ (define-key map [transient-set-level] 'transient--do-stay)
+ (define-key map [transient-history-prev] 'transient--do-stay)
+ (define-key map [transient-history-next] 'transient--do-stay)
+ (define-key map [universal-argument] 'transient--do-stay)
+ (define-key map [negative-argument] 'transient--do-stay)
+ (define-key map [digit-argument] 'transient--do-stay)
+ (define-key map [transient-quit-all] 'transient--do-quit-all)
+ (define-key map [transient-quit-one] 'transient--do-quit-one)
+ (define-key map [transient-quit-seq] 'transient--do-stay)
+ (define-key map [transient-show] 'transient--do-stay)
+ (define-key map [transient-update] 'transient--do-stay)
+ (define-key map [transient-toggle-common] 'transient--do-stay)
+ (define-key map [transient-set] 'transient--do-call)
+ (define-key map [transient-save] 'transient--do-call)
+ (define-key map [describe-key-briefly] 'transient--do-stay)
+ (define-key map [describe-key] 'transient--do-stay)
+ (define-key map [transient-scroll-up] 'transient--do-stay)
+ (define-key map [transient-scroll-down] 'transient--do-stay)
+ (define-key map [mwheel-scroll] 'transient--do-stay)
+ (define-key map [scroll-bar-toolkit-scroll] 'transient--do-stay)
+ (define-key map [transient-noop] 'transient--do-noop)
+ (define-key map [transient-mouse-push-button] 'transient--do-move)
+ (define-key map [transient-push-button] 'transient--do-move)
+ (define-key map [transient-backward-button] 'transient--do-move)
+ (define-key map [transient-forward-button] 'transient--do-move)
+ (define-key map [transient-isearch-backward] 'transient--do-move)
+ (define-key map [transient-isearch-forward] 'transient--do-move)
+ map)
+ "Base keymap used to map common commands to their transient behavior.
+
+The \"transient behavior\" of a command controls, among other
+things, whether invoking the command causes the transient to be
+exited or not and whether infix arguments are exported before
+doing so.
+
+Each \"key\" is a command that is common to all transients and
+that is bound in `transient-map', `transient-edit-map',
+`transient-sticky-map' and/or `transient-common-command'.
+
+Each binding is a \"pre-command\", a function that controls the
+transient behavior of the respective command.
+
+For transient commands that are bound in individual transients,
+the transient behavior is specified using the `:transient' slot
+of the corresponding object.")
+
+(defvar transient-popup-navigation-map)
+
+(defvar transient--transient-map nil)
+(defvar transient--predicate-map nil)
+(defvar transient--redisplay-map nil)
+(defvar transient--redisplay-key nil)
+
+(defun transient--push-keymap (map)
+ (transient--debug " push %s%s" map (if (symbol-value map) "" " VOID"))
+ (with-demoted-errors "transient--push-keymap: %S"
+ (internal-push-keymap (symbol-value map) 'overriding-terminal-local-map)))
+
+(defun transient--pop-keymap (map)
+ (transient--debug " pop %s%s" map (if (symbol-value map) "" " VOID"))
+ (with-demoted-errors "transient--pop-keymap: %S"
+ (internal-pop-keymap (symbol-value map) 'overriding-terminal-local-map)))
+
+(defun transient--make-transient-map ()
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map (if transient--editp
+ transient-edit-map
+ transient-map))
+ (dolist (obj transient--suffixes)
+ (let ((key (oref obj key)))
+ (when (vectorp key)
+ (setq key (key-description key))
+ (oset obj key key))
+ (when transient-substitute-key-function
+ (setq key (save-match-data
+ (funcall transient-substitute-key-function obj)))
+ (oset obj key key))
+ (let ((kbd (kbd key))
+ (cmd (transient--suffix-command obj)))
+ (when-let ((conflict (and transient-detect-key-conflicts
+ (transient--lookup-key map kbd))))
+ (unless (eq cmd conflict)
+ (error "Cannot bind %S to %s and also %s"
+ (string-trim key)
+ cmd conflict)))
+ (define-key map kbd cmd))))
+ (when transient-enable-popup-navigation
+ (setq map
+ (make-composed-keymap (list map transient-popup-navigation-map))))
+ map))
+
+(defun transient--make-predicate-map ()
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map transient-predicate-map)
+ (dolist (obj transient--suffixes)
+ (let* ((cmd (oref obj command))
+ (sub-prefix (and (symbolp cmd) (get cmd 'transient--prefix)))
+ (sym (transient--suffix-symbol cmd)))
+ (cond
+ ((oref obj inapt)
+ (define-key map (vector sym) 'transient--do-warn-inapt))
+ ((slot-boundp obj 'transient)
+ (define-key map (vector sym)
+ (let ((do (oref obj transient)))
+ (pcase do
+ (`t (if sub-prefix
+ 'transient--do-replace
+ 'transient--do-stay))
+ (`nil 'transient--do-exit)
+ (_ do)))))
+ ((not (lookup-key transient-predicate-map (vector sym)))
+ (define-key map (vector sym)
+ (if sub-prefix
+ 'transient--do-replace
+ (or (oref transient--prefix transient-suffix)
+ 'transient--do-exit)))))))
+ map))
+
+(defun transient--make-redisplay-map ()
+ (setq transient--redisplay-key
+ (cl-case this-command
+ (transient-update
+ (setq transient--showp t)
+ (setq unread-command-events
+ (listify-key-sequence (this-single-command-raw-keys))))
+ (transient-quit-seq
+ (setq unread-command-events
+ (butlast (listify-key-sequence
+ (this-single-command-raw-keys))
+ 2))
+ (butlast transient--redisplay-key))
+ (t nil)))
+ (let ((topmap (make-sparse-keymap))
+ (submap (make-sparse-keymap)))
+ (when transient--redisplay-key
+ (define-key topmap (vconcat transient--redisplay-key) submap)
+ (set-keymap-parent submap transient-sticky-map))
+ (map-keymap-internal
+ (lambda (key def)
+ (when (and (not (eq key ?\e))
+ (listp def)
+ (keymapp def))
+ (define-key topmap (vconcat transient--redisplay-key (list key))
+ 'transient-update)))
+ (if transient--redisplay-key
+ (lookup-key transient--transient-map (vconcat transient--redisplay-key))
+ transient--transient-map))
+ topmap))
+
+;;; Setup
+
+(defun transient-setup (&optional name layout edit &rest params)
+ "Setup the transient specified by NAME.
+
+This function is called by transient prefix commands to setup the
+transient. In that case NAME is mandatory, LAYOUT and EDIT must
+be nil and PARAMS may be (but usually is not) used to set e.g. the
+\"scope\" of the transient (see `transient-define-prefix').
+
+This function is also called internally in which case LAYOUT and
+EDIT may be non-nil."
+ (transient--debug 'setup)
+ (when (> (minibuffer-depth) 0)
+ (user-error "Cannot invoke transient %s while minibuffer is active" name))
+ (transient--with-emergency-exit
+ (cond
+ ((not name)
+ ;; Switching between regular and edit mode.
+ (transient--pop-keymap 'transient--transient-map)
+ (transient--pop-keymap 'transient--redisplay-map)
+ (setq name (oref transient--prefix command))
+ (setq params (list :scope (oref transient--prefix scope))))
+ (transient--transient-map
+ ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}"
+ ;; of an outer prefix. Unlike the usual `transient--do-replace',
+ ;; these predicates fail to clean up after the outer prefix.
+ (transient--pop-keymap 'transient--transient-map)
+ (transient--pop-keymap 'transient--redisplay-map))
+ ((not (or layout ; resuming parent/suspended prefix
+ transient-current-command)) ; entering child prefix
+ (transient--stack-zap)) ; replace suspended prefix, if any
+ (edit
+ ;; Returning from help to edit.
+ (setq transient--editp t)))
+ (transient--init-objects name layout params)
+ (transient--history-init transient--prefix)
+ (setq transient--predicate-map (transient--make-predicate-map))
+ (setq transient--transient-map (transient--make-transient-map))
+ (setq transient--redisplay-map (transient--make-redisplay-map))
+ (setq transient--original-window (selected-window))
+ (setq transient--original-buffer (current-buffer))
+ (transient--redisplay)
+ (transient--init-transient)
+ (transient--suspend-which-key-mode)))
+
+(cl-defgeneric transient-setup-children (group children)
+ "Setup the CHILDREN of GROUP.
+If the value of the `setup-children' slot is non-nil, then call
+that function with CHILDREN as the only argument and return the
+value. Otherwise return CHILDREN as is."
+ (if (slot-boundp group 'setup-children)
+ (funcall (oref group setup-children) children)
+ children))
+
+(defun transient--init-objects (name layout params)
+ (setq transient--prefix (transient--init-prefix name params))
+ (setq transient--layout (or layout (transient--init-suffixes name)))
+ (setq transient--suffixes (transient--flatten-suffixes transient--layout)))
+
+(defun transient--init-prefix (name &optional params)
+ (let ((obj (let ((proto (get name 'transient--prefix)))
+ (apply #'clone proto
+ :prototype proto
+ :level (or (alist-get t (alist-get name transient-levels))
+ transient-default-level)
+ params))))
+ (transient-init-value obj)
+ obj))
+
+(defun transient--init-suffixes (name)
+ (let ((levels (alist-get name transient-levels)))
+ (cl-mapcan (lambda (c) (transient--init-child levels c))
+ (append (get name 'transient--layout)
+ (and (not transient--editp)
+ (get 'transient-common-commands
+ 'transient--layout))))))
+
+(defun transient--flatten-suffixes (layout)
+ (cl-labels ((s (def)
+ (cond
+ ((stringp def) nil)
+ ((listp def) (cl-mapcan #'s def))
+ ((transient-group--eieio-childp def)
+ (cl-mapcan #'s (oref def suffixes)))
+ ((transient-suffix--eieio-childp def)
+ (list def)))))
+ (cl-mapcan #'s layout)))
+
+(defun transient--init-child (levels spec)
+ (cl-etypecase spec
+ (vector (transient--init-group levels spec))
+ (list (transient--init-suffix levels spec))
+ (string (list spec))))
+
+(defun transient--init-group (levels spec)
+ (pcase-let ((`(,level ,class ,args ,children) (append spec nil)))
+ (when (transient--use-level-p level)
+ (let ((obj (apply class :level level args)))
+ (when (transient--use-suffix-p obj)
+ (when-let ((suffixes
+ (cl-mapcan (lambda (c) (transient--init-child levels c))
+ (transient-setup-children obj children))))
+ (oset obj suffixes suffixes)
+ (list obj)))))))
+
+(defun transient--init-suffix (levels spec)
+ (pcase-let* ((`(,level ,class ,args) spec)
+ (cmd (plist-get args :command))
+ (level (or (alist-get (transient--suffix-symbol cmd) levels)
+ level)))
+ (let ((fn (and (symbolp cmd)
+ (symbol-function cmd))))
+ (when (autoloadp fn)
+ (transient--debug " autoload %s" cmd)
+ (autoload-do-load fn)))
+ (when (transient--use-level-p level)
+ (let ((obj (if-let ((proto (and cmd
+ (symbolp cmd)
+ (get cmd 'transient--suffix))))
+ (apply #'clone proto :level level args)
+ (apply class :level level args))))
+ (transient--init-suffix-key obj)
+ (transient--ensure-infix-command obj)
+ (when (transient--use-suffix-p obj)
+ (if (transient--inapt-suffix-p obj)
+ (oset obj inapt t)
+ (transient-init-scope obj)
+ (transient-init-value obj))
+ (list obj))))))
+
+(cl-defmethod transient--init-suffix-key ((obj transient-suffix))
+ (unless (slot-boundp obj 'key)
+ (error "No key for %s" (oref obj command))))
+
+(cl-defmethod transient--init-suffix-key ((obj transient-argument))
+ (if (transient-switches--eieio-childp obj)
+ (cl-call-next-method obj)
+ (unless (slot-boundp obj 'shortarg)
+ (when-let ((shortarg (transient--derive-shortarg (oref obj argument))))
+ (oset obj shortarg shortarg)))
+ (unless (slot-boundp obj 'key)
+ (if (slot-boundp obj 'shortarg)
+ (oset obj key (oref obj shortarg))
+ (error "No key for %s" (oref obj command))))))
+
+(defun transient--use-level-p (level &optional edit)
+ (or (and transient--editp (not edit))
+ (and (>= level 1)
+ (<= level (oref transient--prefix level)))))
+
+(defun transient--use-suffix-p (obj)
+ (transient--do-suffix-p
+ (oref obj if)
+ (oref obj if-not)
+ (oref obj if-nil)
+ (oref obj if-non-nil)
+ (oref obj if-mode)
+ (oref obj if-not-mode)
+ (oref obj if-derived)
+ (oref obj if-not-derived)
+ t))
+
+(defun transient--inapt-suffix-p (obj)
+ (transient--do-suffix-p
+ (oref obj inapt-if)
+ (oref obj inapt-if-not)
+ (oref obj inapt-if-nil)
+ (oref obj inapt-if-non-nil)
+ (oref obj inapt-if-mode)
+ (oref obj inapt-if-not-mode)
+ (oref obj inapt-if-derived)
+ (oref obj inapt-if-not-derived)
+ nil))
+
+(defun transient--do-suffix-p
+ (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived
+ default)
+ (cond
+ (if (funcall if))
+ (if-not (not (funcall if-not)))
+ (if-non-nil (symbol-value if-non-nil))
+ (if-nil (not (symbol-value if-nil)))
+ (if-mode (if (atom if-mode)
+ (eq major-mode if-mode)
+ (memq major-mode if-mode)))
+ (if-not-mode (not (if (atom if-not-mode)
+ (eq major-mode if-not-mode)
+ (memq major-mode if-not-mode))))
+ (if-derived (if (atom if-derived)
+ (derived-mode-p if-derived)
+ (apply #'derived-mode-p if-derived)))
+ (if-not-derived (not (if (atom if-not-derived)
+ (derived-mode-p if-not-derived)
+ (apply #'derived-mode-p if-not-derived))))
+ (t default)))
+
+(defun transient--suffix-predicate (spec)
+ (let ((plist (nth 2 spec)))
+ (seq-some (lambda (prop)
+ (when-let ((pred (plist-get plist prop)))
+ (list prop pred)))
+ '( :if :if-not
+ :if-nil :if-non-nil
+ :if-mode :if-not-mode
+ :if-derived :if-not-derived
+ :inapt-if :inapt-if-not
+ :inapt-if-nil :inapt-if-non-nil
+ :inapt-if-mode :inapt-if-not-mode
+ :inapt-if-derived :inapt-if-not-derived))))
+
+;;; Flow-Control
+
+(defun transient--init-transient ()
+ (transient--debug 'init-transient)
+ (transient--push-keymap 'transient--transient-map)
+ (transient--push-keymap 'transient--redisplay-map)
+ (add-hook 'pre-command-hook #'transient--pre-command)
+ (add-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
+ (add-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
+ (add-hook 'post-command-hook #'transient--post-command)
+ (advice-add 'abort-recursive-edit :after #'transient--minibuffer-exit)
+ (when transient--exitp
+ ;; This prefix command was invoked as the suffix of another.
+ ;; Prevent `transient--post-command' from removing the hooks
+ ;; that we just added.
+ (setq transient--exitp 'replace)))
+
+(defun transient--pre-command ()
+ (transient--debug 'pre-command)
+ (cond
+ ((memq this-command '(transient-update transient-quit-seq))
+ (transient--pop-keymap 'transient--redisplay-map))
+ ((and transient--helpp
+ (not (memq this-command '(transient-quit-one
+ transient-quit-all))))
+ (cond
+ ((transient-help)
+ (transient--do-suspend)
+ (setq this-command 'transient-suspend)
+ (transient--pre-exit))
+ ((not (transient--edebug-command-p))
+ (setq this-command 'transient-undefined))))
+ ((and transient--editp
+ (transient-suffix-object)
+ (not (memq this-command '(transient-quit-one
+ transient-quit-all
+ transient-help))))
+ (setq this-command 'transient-set-level))
+ (t
+ (setq transient--exitp nil)
+ (when (eq (if-let ((fn (transient--get-predicate-for
+ this-original-command)))
+ (let ((action (funcall fn)))
+ (when (eq action transient--exit)
+ (setq transient--exitp (or transient--exitp t)))
+ action)
+ (if (let ((keys (this-command-keys-vector)))
+ (eq (aref keys (1- (length keys))) ?\C-g))
+ (setq this-command 'transient-noop)
+ (unless (transient--edebug-command-p)
+ (setq this-command 'transient-undefined)))
+ transient--stay)
+ transient--exit)
+ (transient--pre-exit)))))
+
+(defun transient--get-predicate-for (cmd)
+ (or (lookup-key transient--predicate-map
+ (vector (transient--suffix-symbol cmd)))
+ (oref transient--prefix transient-non-suffix)))
+
+(defun transient--pre-exit ()
+ (transient--debug 'pre-exit)
+ (transient--delete-window)
+ (transient--timer-cancel)
+ (transient--pop-keymap 'transient--transient-map)
+ (transient--pop-keymap 'transient--redisplay-map)
+ (remove-hook 'pre-command-hook #'transient--pre-command)
+ (unless transient--showp
+ (let ((message-log-max nil))
+ (message "")))
+ (setq transient--transient-map nil)
+ (setq transient--predicate-map nil)
+ (setq transient--redisplay-map nil)
+ (setq transient--redisplay-key nil)
+ (setq transient--showp nil)
+ (setq transient--helpp nil)
+ (setq transient--editp nil)
+ (setq transient--prefix nil)
+ (setq transient--layout nil)
+ (setq transient--suffixes nil)
+ (setq transient--original-window nil)
+ (setq transient--original-buffer nil)
+ (setq transient--window nil))
+
+(defun transient--delete-window ()
+ (when (window-live-p transient--window)
+ (let ((buf (window-buffer transient--window)))
+ (with-demoted-errors "Error while exiting transient: %S"
+ (delete-window transient--window))
+ (kill-buffer buf))))
+
+(defun transient--export ()
+ (setq transient-current-prefix transient--prefix)
+ (setq transient-current-command (oref transient--prefix command))
+ (setq transient-current-suffixes transient--suffixes)
+ (transient--history-push transient--prefix))
+
+(defun transient--minibuffer-setup ()
+ (transient--debug 'minibuffer-setup)
+ (unless (> (minibuffer-depth) 1)
+ (unless transient--exitp
+ (transient--pop-keymap 'transient--transient-map)
+ (transient--pop-keymap 'transient--redisplay-map)
+ (remove-hook 'pre-command-hook #'transient--pre-command))
+ (remove-hook 'post-command-hook #'transient--post-command)))
+
+(defun transient--minibuffer-exit ()
+ (transient--debug 'minibuffer-exit)
+ (unless (> (minibuffer-depth) 1)
+ (unless transient--exitp
+ (transient--push-keymap 'transient--transient-map)
+ (transient--push-keymap 'transient--redisplay-map)
+ (add-hook 'pre-command-hook #'transient--pre-command))
+ (add-hook 'post-command-hook #'transient--post-command)))
+
+(defun transient--suspend-override (&optional minibuffer-hooks)
+ (transient--debug 'suspend-override)
+ (transient--pop-keymap 'transient--transient-map)
+ (transient--pop-keymap 'transient--redisplay-map)
+ (remove-hook 'pre-command-hook #'transient--pre-command)
+ (remove-hook 'post-command-hook #'transient--post-command)
+ (when minibuffer-hooks
+ (remove-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
+ (remove-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
+ (advice-remove 'abort-recursive-edit #'transient--minibuffer-exit)))
+
+(defun transient--resume-override (&optional minibuffer-hooks)
+ (transient--debug 'resume-override)
+ (transient--push-keymap 'transient--transient-map)
+ (transient--push-keymap 'transient--redisplay-map)
+ (add-hook 'pre-command-hook #'transient--pre-command)
+ (add-hook 'post-command-hook #'transient--post-command)
+ (when minibuffer-hooks
+ (add-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
+ (add-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
+ (advice-add 'abort-recursive-edit :after #'transient--minibuffer-exit)))
+
+(defun transient--post-command ()
+ (transient--debug 'post-command)
+ (unless this-command
+ (transient--debug "-- force pre-exit from post-command")
+ (message "Quit transient!")
+ (transient--pre-exit)
+ (setq transient--exitp t))
+ (if transient--exitp
+ (progn
+ (unless (and (eq transient--exitp 'replace)
+ (or transient--prefix
+ ;; The current command could act as a prefix,
+ ;; but decided not to call `transient-setup'.
+ (prog1 nil (transient--stack-zap))))
+ (remove-hook 'minibuffer-setup-hook #'transient--minibuffer-setup)
+ (remove-hook 'minibuffer-exit-hook #'transient--minibuffer-exit)
+ (advice-remove 'abort-recursive-edit #'transient--minibuffer-exit)
+ (remove-hook 'post-command-hook #'transient--post-command))
+ (setq transient-current-prefix nil)
+ (setq transient-current-command nil)
+ (setq transient-current-suffixes nil)
+ (let ((resume (and transient--stack
+ (not (memq transient--exitp '(replace suspend))))))
+ (setq transient--exitp nil)
+ (setq transient--helpp nil)
+ (setq transient--editp nil)
+ (run-hooks 'transient-exit-hook)
+ (when resume
+ (transient--stack-pop))))
+ (transient--pop-keymap 'transient--redisplay-map)
+ (setq transient--redisplay-map (transient--make-redisplay-map))
+ (transient--push-keymap 'transient--redisplay-map)
+ (unless (eq this-command (oref transient--prefix command))
+ (transient--redisplay))))
+
+(defun transient--stack-push ()
+ (transient--debug 'stack-push)
+ (push (list (oref transient--prefix command)
+ transient--layout
+ transient--editp
+ :scope (oref transient--prefix scope))
+ transient--stack))
+
+(defun transient--stack-pop ()
+ (transient--debug 'stack-pop)
+ (and transient--stack
+ (prog1 t (apply #'transient-setup (pop transient--stack)))))
+
+(defun transient--stack-zap ()
+ (transient--debug 'stack-zap)
+ (setq transient--stack nil))
+
+(defun transient--redisplay ()
+ (if (or (eq transient-show-popup t)
+ transient--showp)
+ (unless (memq this-command transient--scroll-commands)
+ (transient--show))
+ (when (and (numberp transient-show-popup)
+ (not (zerop transient-show-popup))
+ (not transient--timer))
+ (transient--timer-start))
+ (transient--show-brief)))
+
+(defun transient--timer-start ()
+ (setq transient--timer
+ (run-at-time (abs transient-show-popup) nil
+ (lambda ()
+ (transient--timer-cancel)
+ (transient--show)
+ (let ((message-log-max nil))
+ (message ""))))))
+
+(defun transient--timer-cancel ()
+ (when transient--timer
+ (cancel-timer transient--timer)
+ (setq transient--timer nil)))
+
+(defun transient--debug (arg &rest args)
+ (when transient--debug
+ (if (symbolp arg)
+ (message "-- %-16s (cmd: %s, event: %S, exit: %s)"
+ arg
+ (or (transient--suffix-symbol this-command)
+ (list this-command this-original-command last-command))
+ (key-description (this-command-keys-vector))
+ transient--exitp)
+ (apply #'message arg args))))
+
+(defun transient--emergency-exit ()
+ "Exit the current transient command after an error occurred.
+When no transient is active (i.e. when `transient--prefix') is
+nil, then do nothing."
+ (transient--debug 'emergency-exit)
+ (when transient--prefix
+ (setq transient--stack nil)
+ (setq transient--exitp t)
+ (transient--pre-exit)
+ (transient--post-command)))
+
+;;; Pre-Commands
+
+(defun transient--do-stay ()
+ "Call the command without exporting variables and stay transient."
+ transient--stay)
+
+(defun transient--do-noop ()
+ "Call `transient-noop' and stay transient."
+ (setq this-command 'transient-noop)
+ transient--stay)
+
+(defun transient--do-warn ()
+ "Call `transient-undefined' and stay transient."
+ (setq this-command 'transient-undefined)
+ transient--stay)
+
+(defun transient--do-warn-inapt ()
+ "Call `transient-inapt' and stay transient."
+ (setq this-command 'transient-inapt)
+ transient--stay)
+
+(defun transient--do-call ()
+ "Call the command after exporting variables and stay transient."
+ (transient--export)
+ transient--stay)
+
+(defun transient--do-exit ()
+ "Call the command after exporting variables and exit the transient."
+ (transient--export)
+ (transient--stack-zap)
+ transient--exit)
+
+(defun transient--do-replace ()
+ "Call the transient prefix command, replacing the active transient."
+ (transient--export)
+ (transient--stack-push)
+ (setq transient--exitp 'replace)
+ transient--exit)
+
+(defun transient--do-suspend ()
+ "Suspend the active transient, saving the transient stack."
+ (transient--stack-push)
+ (setq transient--exitp 'suspend)
+ transient--exit)
+
+(defun transient--do-quit-one ()
+ "If active, quit help or edit mode, else exit the active transient."
+ (cond (transient--helpp
+ (setq transient--helpp nil)
+ transient--stay)
+ (transient--editp
+ (setq transient--editp nil)
+ (transient-setup)
+ transient--stay)
+ (t transient--exit)))
+
+(defun transient--do-quit-all ()
+ "Exit all transients without saving the transient stack."
+ (transient--stack-zap)
+ transient--exit)
+
+(defun transient--do-move ()
+ "Call the command if `transient-enable-popup-navigation' is non-nil.
+In that case behave like `transient--do-stay', otherwise similar
+to `transient--do-warn'."
+ (unless transient-enable-popup-navigation
+ (setq this-command 'transient-popup-navigation-help))
+ transient--stay)
+
+(put 'transient--do-stay 'transient-color 'transient-blue)
+(put 'transient--do-noop 'transient-color 'transient-blue)
+(put 'transient--do-warn 'transient-color 'transient-blue)
+(put 'transient--do-warn-inapt 'transient-color 'transient-blue)
+(put 'transient--do-call 'transient-color 'transient-blue)
+(put 'transient--do-exit 'transient-color 'transient-red)
+(put 'transient--do-replace 'transient-color 'transient-red)
+(put 'transient--do-suspend 'transient-color 'transient-red)
+(put 'transient--do-quit-one 'transient-color 'transient-red)
+(put 'transient--do-quit-all 'transient-color 'transient-red)
+(put 'transient--do-move 'transient-color 'transient-blue)
+
+;;; Commands
+
+(defun transient-noop ()
+ "Do nothing at all."
+ (interactive))
+
+(defun transient-undefined ()
+ "Warn the user that the pressed key is not bound to any suffix."
+ (interactive)
+ (transient--invalid "Unbound suffix"))
+
+(defun transient-inapt ()
+ "Warn the user that the invoked command is inapt."
+ (interactive)
+ (transient--invalid "Inapt command"))
+
+(defun transient--invalid (msg)
+ (ding)
+ (message "%s: `%s' (Use `%s' to abort, `%s' for help) [%s]"
+ msg
+ (propertize (key-description (this-single-command-keys))
+ 'face 'font-lock-warning-face)
+ (propertize "C-g" 'face 'transient-key)
+ (propertize "?" 'face 'transient-key)
+ (propertize (symbol-name (transient--suffix-symbol
+ this-original-command))
+ 'face 'font-lock-warning-face)))
+
+(defun transient-toggle-common ()
+ "Toggle whether common commands are always shown."
+ (interactive)
+ (setq transient-show-common-commands (not transient-show-common-commands)))
+
+(defun transient-suspend ()
+ "Suspend the current transient.
+It can later be resumed using `transient-resume' while no other
+transient is active."
+ (interactive))
+
+(defun transient-quit-all ()
+ "Exit all transients without saving the transient stack."
+ (interactive))
+
+(defun transient-quit-one ()
+ "Exit the current transients, possibly returning to the previous."
+ (interactive))
+
+(defun transient-quit-seq ()
+ "Abort the current incomplete key sequence."
+ (interactive))
+
+(defun transient-update ()
+ "Redraw the transient's state in the popup buffer."
+ (interactive))
+
+(defun transient-show ()
+ "Show the transient's state in the popup buffer."
+ (interactive)
+ (setq transient--showp t))
+
+(defvar-local transient--restore-winconf nil)
+
+(defvar transient-resume-mode)
+
+(defun transient-help ()
+ "Show help for the active transient or one of its suffixes."
+ (interactive)
+ (if (called-interactively-p 'any)
+ (setq transient--helpp t)
+ (with-demoted-errors "transient-help: %S"
+ (when (lookup-key transient--transient-map
+ (this-single-command-raw-keys))
+ (setq transient--helpp nil)
+ (let ((winconf (current-window-configuration)))
+ (transient-show-help
+ (if (eq this-original-command 'transient-help)
+ transient--prefix
+ (or (transient-suffix-object)
+ this-original-command)))
+ (setq transient--restore-winconf winconf))
+ (fit-window-to-buffer nil (frame-height) (window-height))
+ (transient-resume-mode)
+ (message "Type \"q\" to resume transient command.")
+ t))))
+
+(defun transient-set-level (&optional command level)
+ "Set the level of the transient or one of its suffix commands."
+ (interactive
+ (let ((command this-original-command)
+ (prefix (oref transient--prefix command)))
+ (and (or (not (eq command 'transient-set-level))
+ (and transient--editp
+ (setq command prefix)))
+ (list command
+ (let ((keys (this-single-command-raw-keys)))
+ (and (lookup-key transient--transient-map keys)
+ (string-to-number
+ (let ((transient--active-infix
+ (transient-suffix-object command)))
+ (transient--show)
+ (transient--read-number-N
+ (format "Set level for `%s': "
+ (transient--suffix-symbol command))
+ nil nil (not (eq command prefix)))))))))))
+ (cond
+ ((not command)
+ (setq transient--editp t)
+ (transient-setup))
+ (level
+ (let* ((prefix (oref transient--prefix command))
+ (alist (alist-get prefix transient-levels))
+ (sym (transient--suffix-symbol command)))
+ (if (eq command prefix)
+ (progn (oset transient--prefix level level)
+ (setq sym t))
+ (oset (transient-suffix-object command) level level))
+ (setf (alist-get sym alist) level)
+ (setf (alist-get prefix transient-levels) alist))
+ (transient-save-levels))
+ (t
+ (transient-undefined))))
+
+(defun transient-set ()
+ "Save the value of the active transient for this Emacs session."
+ (interactive)
+ (transient-set-value (or transient--prefix transient-current-prefix)))
+
+(defun transient-save ()
+ "Save the value of the active transient persistenly across Emacs sessions."
+ (interactive)
+ (transient-save-value (or transient--prefix transient-current-prefix)))
+
+(defun transient-history-next ()
+ "Switch to the next value used for the active transient."
+ (interactive)
+ (let* ((obj transient--prefix)
+ (pos (1- (oref obj history-pos)))
+ (hst (oref obj history)))
+ (if (< pos 0)
+ (user-error "End of history")
+ (oset obj history-pos pos)
+ (oset obj value (nth pos hst))
+ (mapc #'transient-init-value transient--suffixes))))
+
+(defun transient-history-prev ()
+ "Switch to the previous value used for the active transient."
+ (interactive)
+ (let* ((obj transient--prefix)
+ (pos (1+ (oref obj history-pos)))
+ (hst (oref obj history))
+ (len (length hst)))
+ (if (> pos (1- len))
+ (user-error "End of history")
+ (oset obj history-pos pos)
+ (oset obj value (nth pos hst))
+ (mapc #'transient-init-value transient--suffixes))))
+
+(defun transient-scroll-up (&optional arg)
+ "Scroll text of transient popup window upward ARG lines.
+If ARG is nil scroll near full screen. This is a wrapper
+around `scroll-up-command' (which see)."
+ (interactive "^P")
+ (with-selected-window transient--window
+ (scroll-up-command arg)))
+
+(defun transient-scroll-down (&optional arg)
+ "Scroll text of transient popup window down ARG lines.
+If ARG is nil scroll near full screen. This is a wrapper
+around `scroll-down-command' (which see)."
+ (interactive "^P")
+ (with-selected-window transient--window
+ (scroll-down-command arg)))
+
+(defun transient-resume ()
+ "Resume a previously suspended stack of transients."
+ (interactive)
+ (cond (transient--stack
+ (let ((winconf transient--restore-winconf))
+ (kill-local-variable 'transient--restore-winconf)
+ (when transient-resume-mode
+ (transient-resume-mode -1)
+ (quit-window))
+ (when winconf
+ (set-window-configuration winconf)))
+ (transient--stack-pop))
+ (transient-resume-mode
+ (kill-local-variable 'transient--restore-winconf)
+ (transient-resume-mode -1)
+ (quit-window))
+ (t
+ (message "No suspended transient command"))))
+
+;;; Value
+;;;; Init
+
+(cl-defgeneric transient-init-scope (obj)
+ "Set the scope of the suffix object OBJ.
+
+The scope is actually a property of the transient prefix, not of
+individual suffixes. However it is possible to invoke a suffix
+command directly instead of from a transient. In that case, if
+the suffix expects a scope, then it has to determine that itself
+and store it in its `scope' slot.
+
+This function is called for all suffix commands, but unless a
+concrete method is implemented this falls through to the default
+implementation, which is a noop.")
+
+(cl-defmethod transient-init-scope ((_ transient-suffix))
+ "Noop." nil)
+
+(cl-defgeneric transient-init-value (_)
+ "Set the initial value of the object OBJ.
+
+This function is called for all prefix and suffix commands.
+
+For suffix commands (including infix argument commands) the
+default implementation is a noop. Classes derived from the
+abstract `transient-infix' class must implement this function.
+Non-infix suffix commands usually don't have a value."
+ nil)
+
+(cl-defmethod transient-init-value :around ((obj transient-prefix))
+ "If bound, then call OBJ's `init-value' function.
+Otherwise call the primary method according to objects class."
+ (if (slot-boundp obj 'init-value)
+ (funcall (oref obj init-value) obj)
+ (cl-call-next-method obj)))
+
+(cl-defmethod transient-init-value :around ((obj transient-infix))
+ "If bound, then call OBJ's `init-value' function.
+Otherwise call the primary method according to objects class."
+ (if (slot-boundp obj 'init-value)
+ (funcall (oref obj init-value) obj)
+ (cl-call-next-method obj)))
+
+(cl-defmethod transient-init-value ((obj transient-prefix))
+ (if (slot-boundp obj 'value)
+ (oref obj value)
+ (oset obj value
+ (if-let ((saved (assq (oref obj command) transient-values)))
+ (cdr saved)
+ (if-let ((default (and (slot-boundp obj 'default-value)
+ (oref obj default-value))))
+ (if (functionp default)
+ (funcall default)
+ default)
+ nil)))))
+
+(cl-defmethod transient-init-value ((obj transient-switch))
+ (oset obj value
+ (car (member (oref obj argument)
+ (oref transient--prefix value)))))
+
+(cl-defmethod transient-init-value ((obj transient-option))
+ (oset obj value
+ (transient--value-match (format "\\`%s\\(.*\\)" (oref obj argument)))))
+
+(cl-defmethod transient-init-value ((obj transient-switches))
+ (oset obj value
+ (transient--value-match (oref obj argument-regexp))))
+
+(defun transient--value-match (re)
+ (when-let ((match (cl-find-if (lambda (v)
+ (and (stringp v)
+ (string-match re v)))
+ (oref transient--prefix value))))
+ (match-string 1 match)))
+
+(cl-defmethod transient-init-value ((obj transient-files))
+ (oset obj value
+ (cdr (assoc "--" (oref transient--prefix value)))))
+
+;;;; Read
+
+(cl-defgeneric transient-infix-read (obj)
+ "Determine the new value of the infix object OBJ.
+
+This function merely determines the value; `transient-infix-set'
+is used to actually store the new value in the object.
+
+For most infix classes this is done by reading a value from the
+user using the reader specified by the `reader' slot (using the
+`transient-infix' method described below).
+
+For some infix classes the value is changed without reading
+anything in the minibuffer, i.e. the mere act of invoking the
+infix command determines what the new value should be, based
+on the previous value.")
+
+(cl-defmethod transient-infix-read :around ((obj transient-infix))
+ "Highlight the infix in the popup buffer.
+
+Also arrange for the transient to be exited in case of an error
+because otherwise Emacs would get stuck in an inconsistent state,
+which might make it necessary to kill it from the outside."
+ (let ((transient--active-infix obj))
+ (transient--show))
+ (transient--with-emergency-exit
+ (cl-call-next-method obj)))
+
+(cl-defmethod transient-infix-read ((obj transient-infix))
+ "Read a value while taking care of history.
+
+This method is suitable for a wide variety of infix commands,
+including but not limited to inline arguments and variables.
+
+If you do not use this method for your own infix class, then
+you should likely replicate a lot of the behavior of this
+method. If you fail to do so, then users might not appreciate
+the lack of history, for example.
+
+Only for very simple classes that toggle or cycle through a very
+limited number of possible values should you replace this with a
+simple method that does not handle history. (E.g. for a command
+line switch the only possible values are \"use it\" and \"don't use
+it\", in which case it is pointless to preserve history.)"
+ (with-slots (value multi-value always-read allow-empty choices) obj
+ (if (and value
+ (not multi-value)
+ (not always-read)
+ transient--prefix)
+ (oset obj value nil)
+ (let* ((overriding-terminal-local-map nil)
+ (reader (oref obj reader))
+ (prompt (transient-prompt obj))
+ (value (if multi-value (mapconcat #'identity value ",") value))
+ (history-key (or (oref obj history-key)
+ (oref obj command)))
+ (transient--history (alist-get history-key transient-history))
+ (transient--history (if (or (null value)
+ (eq value (car transient--history)))
+ transient--history
+ (cons value transient--history)))
+ (initial-input (and transient-read-with-initial-input
+ (car transient--history)))
+ (history (if initial-input
+ (cons 'transient--history 1)
+ 'transient--history))
+ (value
+ (cond
+ (reader (funcall reader prompt initial-input history))
+ (multi-value
+ (completing-read-multiple prompt choices nil nil
+ initial-input history))
+ (choices
+ (completing-read prompt choices nil t initial-input history))
+ (t (read-string prompt initial-input history)))))
+ (cond ((and (equal value "") (not allow-empty))
+ (setq value nil))
+ ((and (equal value "\"\"") allow-empty)
+ (setq value "")))
+ (when value
+ (when (and (bound-and-true-p ivy-mode)
+ (stringp (car transient--history)))
+ (set-text-properties 0 (length (car transient--history)) nil
+ (car transient--history)))
+ (setf (alist-get history-key transient-history)
+ (delete-dups transient--history)))
+ value))))
+
+(cl-defmethod transient-infix-read ((obj transient-switch))
+ "Toggle the switch on or off."
+ (if (oref obj value) nil (oref obj argument)))
+
+(cl-defmethod transient-infix-read ((obj transient-switches))
+ "Cycle through the mutually exclusive switches.
+The last value is \"don't use any of these switches\"."
+ (let ((choices (mapcar (apply-partially #'format (oref obj argument-format))
+ (oref obj choices))))
+ (if-let ((value (oref obj value)))
+ (cadr (member value choices))
+ (car choices))))
+
+(cl-defmethod transient-infix-read ((command symbol))
+ "Elsewhere use the reader of the infix command COMMAND.
+Use this if you want to share an infix's history with a regular
+stand-alone command."
+ (cl-letf (((symbol-function #'transient--show) #'ignore))
+ (transient-infix-read (get command 'transient--suffix))))
+
+;;;; Readers
+
+(defun transient-read-file (prompt _initial-input _history)
+ "Read a file."
+ (file-local-name (expand-file-name (read-file-name prompt))))
+
+(defun transient-read-existing-file (prompt _initial-input _history)
+ "Read an existing file."
+ (file-local-name (expand-file-name (read-file-name prompt nil nil t))))
+
+(defun transient-read-directory (prompt _initial-input _history)
+ "Read a directory."
+ (file-local-name (expand-file-name (read-directory-name prompt))))
+
+(defun transient-read-existing-directory (prompt _initial-input _history)
+ "Read an existing directory."
+ (file-local-name (expand-file-name (read-directory-name prompt nil nil t))))
+
+(defun transient-read-number-N0 (prompt initial-input history)
+ "Read a natural number (including zero) and return it as a string."
+ (transient--read-number-N prompt initial-input history t))
+
+(defun transient-read-number-N+ (prompt initial-input history)
+ "Read a natural number (excluding zero) and return it as a string."
+ (transient--read-number-N prompt initial-input history nil))
+
+(defun transient--read-number-N (prompt initial-input history include-zero)
+ (save-match-data
+ (cl-block nil
+ (while t
+ (let ((str (read-from-minibuffer prompt initial-input nil nil history)))
+ (cond ((string-equal str "")
+ (cl-return nil))
+ ((string-match-p (if include-zero
+ "\\`\\(0\\|[1-9][0-9]*\\)\\'"
+ "\\`[1-9][0-9]*\\'")
+ str)
+ (cl-return str))))
+ (message "Please enter a natural number (%s zero)."
+ (if include-zero "including" "excluding"))
+ (sit-for 1)))))
+
+(defun transient-read-date (prompt default-time _history)
+ "Read a date using `org-read-date' (which see)."
+ (require 'org)
+ (when (fboundp 'org-read-date)
+ (org-read-date 'with-time nil nil prompt default-time)))
+
+;;;; Prompt
+
+(cl-defgeneric transient-prompt (obj)
+ "Return the prompt to be used to read infix object OBJ's value.")
+
+(cl-defmethod transient-prompt ((obj transient-infix))
+ "Return the prompt to be used to read infix object OBJ's value.
+
+This implementation should be suitable for almost all infix
+commands.
+
+If the value of OBJ's `prompt' slot is non-nil, then it must be
+a string or a function. If it is a string, then use that. If
+it is a function, then call that with OBJ as the only argument.
+That function must return a string, which is then used as the
+prompt.
+
+Otherwise, if the value of either the `argument' or `variable'
+slot of OBJ is a string, then base the prompt on that (preferring
+the former), appending either \"=\" (if it appears to be a
+command-line option) or \": \".
+
+Finally fall through to using \"(BUG: no prompt): \" as the
+prompt."
+ (if-let ((prompt (oref obj prompt)))
+ (let ((prompt (if (functionp prompt)
+ (funcall prompt obj)
+ prompt)))
+ (if (stringp prompt)
+ prompt
+ "(BUG: no prompt): "))
+ (or (when-let ((arg (and (slot-boundp obj 'argument) (oref obj argument))))
+ (if (and (stringp arg) (string-suffix-p "=" arg))
+ arg
+ (concat arg ": ")))
+ (when-let ((var (and (slot-boundp obj 'variable) (oref obj variable))))
+ (and (stringp var)
+ (concat var ": ")))
+ "(BUG: no prompt): ")))
+
+;;;; Set
+
+(defvar transient--unset-incompatible t)
+
+(cl-defgeneric transient-infix-set (obj value)
+ "Set the value of infix object OBJ to value.")
+
+(cl-defmethod transient-infix-set ((obj transient-infix) value)
+ "Set the value of infix object OBJ to value."
+ (oset obj value value))
+
+(cl-defmethod transient-infix-set :around ((obj transient-argument) value)
+ "Unset incompatible infix arguments."
+ (let ((arg (if (slot-boundp obj 'argument)
+ (oref obj argument)
+ (oref obj argument-regexp))))
+ (if-let ((sic (and value arg transient--unset-incompatible))
+ (spec (oref transient--prefix incompatible))
+ (incomp (remove arg (cl-find-if (lambda (elt) (member arg elt)) spec))))
+ (progn
+ (cl-call-next-method obj value)
+ (dolist (arg incomp)
+ (when-let ((obj (cl-find-if (lambda (obj)
+ (and (slot-boundp obj 'argument)
+ (equal (oref obj argument) arg)))
+ transient--suffixes)))
+ (let ((transient--unset-incompatible nil))
+ (transient-infix-set obj nil)))))
+ (cl-call-next-method obj value))))
+
+(cl-defmethod transient-set-value ((obj transient-prefix))
+ (oset (oref obj prototype) value (transient-get-value))
+ (transient--history-push obj))
+
+;;;; Save
+
+(cl-defmethod transient-save-value ((obj transient-prefix))
+ (let ((value (transient-get-value)))
+ (oset (oref obj prototype) value value)
+ (setf (alist-get (oref obj command) transient-values) value)
+ (transient-save-values))
+ (transient--history-push obj))
+
+;;;; Get
+
+(defun transient-args (prefix)
+ "Return the value of the transient prefix command PREFIX.
+If the current command was invoked from the transient prefix
+command PREFIX, then return the active infix arguments. If
+the current command was not invoked from PREFIX, then return
+the set, saved or default value for PREFIX."
+ (delq nil (mapcar 'transient-infix-value (transient-suffixes prefix))))
+
+(defun transient-suffixes (prefix)
+ "Return the suffix objects of the transient prefix command PREFIX."
+ (if (eq transient-current-command prefix)
+ transient-current-suffixes
+ (let ((transient--prefix (transient--init-prefix prefix)))
+ (transient--flatten-suffixes
+ (transient--init-suffixes prefix)))))
+
+(defun transient-get-value ()
+ (delq nil (mapcar (lambda (obj)
+ (and (or (not (slot-exists-p obj 'unsavable))
+ (not (oref obj unsavable)))
+ (transient-infix-value obj)))
+ transient-current-suffixes)))
+
+(cl-defgeneric transient-infix-value (obj)
+ "Return the value of the suffix object OBJ.
+
+This function is called by `transient-args' (which see), meaning
+this function is how the value of a transient is determined so
+that the invoked suffix command can use it.
+
+Currently most values are strings, but that is not set in stone.
+Nil is not a value, it means \"no value\".
+
+Usually only infixes have a value, but see the method for
+`transient-suffix'.")
+
+(cl-defmethod transient-infix-value ((_ transient-suffix))
+ "Return nil, which means \"no value\".
+
+Infix arguments contribute the the transient's value while suffix
+commands consume it. This function is called for suffixes anyway
+because a command that both contributes to the transient's value
+and also consumes it is not completely unconceivable.
+
+If you define such a command, then you must define a derived
+class and implement this function because this default method
+does nothing." nil)
+
+(cl-defmethod transient-infix-value ((obj transient-infix))
+ "Return the value of OBJ's `value' slot."
+ (oref obj value))
+
+(cl-defmethod transient-infix-value ((obj transient-option))
+ "Return (concat ARGUMENT VALUE) or nil.
+
+ARGUMENT and VALUE are the values of the respective slots of OBJ.
+If VALUE is nil, then return nil. VALUE may be the empty string,
+which is not the same as nil."
+ (when-let ((value (oref obj value)))
+ (concat (oref obj argument) value)))
+
+(cl-defmethod transient-infix-value ((_ transient-variable))
+ "Return nil, which means \"no value\".
+
+Setting the value of a variable is done by, well, setting the
+value of the variable. I.e. this is a side-effect and does not
+contribute to the value of the transient."
+ nil)
+
+(cl-defmethod transient-infix-value ((obj transient-files))
+ "Return (cons ARGUMENT VALUE) or nil.
+
+ARGUMENT and VALUE are the values of the respective slots of OBJ.
+If VALUE is nil, then return nil. VALUE may be the empty string,
+which is not the same as nil."
+ (when-let ((value (oref obj value)))
+ (cons (oref obj argument) value)))
+
+;;;; Utilities
+
+(defun transient-arg-value (arg args)
+ "Return the value of ARG as it appears in ARGS.
+
+For a switch return a boolean. For an option return the value as
+a string, using the empty string for the empty value, or nil if
+the option does not appear in ARGS."
+ (if (string-match-p "=\\'" arg)
+ (save-match-data
+ (when-let ((match (let ((re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'"
+ (substring arg 0 -1))))
+ (cl-find-if (lambda (a)
+ (and (stringp a)
+ (string-match re a)))
+ args))))
+ (or (match-string 1 match) "")))
+ (and (member arg args) t)))
+
+;;; History
+
+(cl-defgeneric transient--history-key (obj)
+ "Return OBJ's history key.
+If the value of the `history-key' slot is non-nil, then return
+that. Otherwise return the value of the `command' slot."
+ (or (oref obj history-key)
+ (oref obj command)))
+
+(cl-defgeneric transient--history-push (obj)
+ "Push the current value of OBJ to its entry in `transient-history'."
+ (let ((key (transient--history-key obj)))
+ (setf (alist-get key transient-history)
+ (let ((args (transient-get-value)))
+ (cons args (delete args (alist-get key transient-history)))))))
+
+(cl-defgeneric transient--history-init (obj)
+ "Initialize OBJ's `history' slot.
+This is the transient-wide history; many individual infixes also
+have a history of their own.")
+
+(cl-defmethod transient--history-init ((obj transient-prefix))
+ "Initialize OBJ's `history' slot from the variable `transient-history'."
+ (let ((val (oref obj value)))
+ (oset obj history
+ (cons val (delete val (alist-get (transient--history-key obj)
+ transient-history))))))
+
+;;; Draw
+
+(defun transient--show-brief ()
+ (let ((message-log-max nil))
+ (if (and transient-show-popup (<= transient-show-popup 0))
+ (message "%s-" (key-description (this-command-keys)))
+ (message
+ "%s- [%s] %s"
+ (key-description (this-command-keys))
+ (oref transient--prefix command)
+ (mapconcat
+ #'identity
+ (sort
+ (cl-mapcan
+ (lambda (suffix)
+ (let ((key (kbd (oref suffix key))))
+ ;; Don't list any common commands.
+ (and (not (memq (oref suffix command)
+ `(,(lookup-key transient-map key)
+ ,(lookup-key transient-sticky-map key)
+ ;; From transient-common-commands:
+ transient-set
+ transient-save
+ transient-history-prev
+ transient-history-next
+ transient-quit-one
+ transient-toggle-common
+ transient-set-level)))
+ (list (propertize (oref suffix key) 'face 'transient-key)))))
+ transient--suffixes)
+ #'string<)
+ (propertize "|" 'face 'transient-unreachable-key))))))
+
+(defun transient--show ()
+ (transient--timer-cancel)
+ (setq transient--showp t)
+ (let ((buf (get-buffer-create transient--buffer-name))
+ (focus nil))
+ (unless (window-live-p transient--window)
+ (setq transient--window
+ (display-buffer buf transient-display-buffer-action)))
+ (with-selected-window transient--window
+ (when transient-enable-popup-navigation
+ (setq focus (button-get (point) 'command)))
+ (erase-buffer)
+ (set-window-hscroll transient--window 0)
+ (set-window-dedicated-p transient--window t)
+ (set-window-parameter transient--window 'no-other-window t)
+ (setq window-size-fixed t)
+ (when (bound-and-true-p tab-line-format)
+ (setq tab-line-format nil))
+ (setq mode-line-format (if (eq transient-mode-line-format 'line)
+ nil
+ transient-mode-line-format))
+ (setq mode-line-buffer-identification
+ (symbol-name (oref transient--prefix command)))
+ (if transient-enable-popup-navigation
+ (setq-local cursor-in-non-selected-windows 'box)
+ (setq cursor-type nil))
+ (setq display-line-numbers nil)
+ (setq show-trailing-whitespace nil)
+ (transient--insert-groups)
+ (when (or transient--helpp transient--editp)
+ (transient--insert-help))
+ (when (and (eq transient-mode-line-format 'line)
+ window-system)
+ (let ((face
+ (if-let ((f (and (transient--semantic-coloring-p)
+ (transient--prefix-color transient--prefix))))
+ `(,@(and (>= emacs-major-version 27) '(:extend t))
+ :background ,(face-foreground f))
+ 'transient-separator)))
+ (insert (propertize "__" 'face face 'display '(space :height (1))))
+ (insert (propertize "\n" 'face face 'line-height t))))
+ (let ((window-resize-pixelwise t)
+ (window-size-fixed nil))
+ (fit-window-to-buffer nil nil 1))
+ (goto-char (point-min))
+ (when transient-force-fixed-pitch
+ (transient--force-fixed-pitch))
+ (when transient-enable-popup-navigation
+ (transient--goto-button focus)))))
+
+(defun transient--insert-groups ()
+ (let ((groups (cl-mapcan (lambda (group)
+ (let ((hide (oref group hide)))
+ (and (not (and (functionp hide)
+ (funcall hide)))
+ (list group))))
+ transient--layout))
+ group)
+ (while (setq group (pop groups))
+ (transient--insert-group group)
+ (when groups
+ (insert ?\n)))))
+
+(cl-defgeneric transient--insert-group (group)
+ "Format GROUP and its elements and insert the result.")
+
+(cl-defmethod transient--insert-group :before ((group transient-group))
+ "Insert GROUP's description, if any."
+ (when-let ((desc (transient-format-description group)))
+ (insert desc ?\n)))
+
+(cl-defmethod transient--insert-group ((group transient-row))
+ (transient--maybe-pad-keys group)
+ (dolist (suffix (oref group suffixes))
+ (insert (transient-format suffix))
+ (insert " "))
+ (insert ?\n))
+
+(cl-defmethod transient--insert-group ((group transient-column))
+ (transient--maybe-pad-keys group)
+ (dolist (suffix (oref group suffixes))
+ (let ((str (transient-format suffix)))
+ (insert str)
+ (unless (string-match-p ".\n\\'" str)
+ (insert ?\n)))))
+
+(cl-defmethod transient--insert-group ((group transient-columns))
+ (let* ((columns
+ (mapcar
+ (lambda (column)
+ (transient--maybe-pad-keys column group)
+ (let ((rows (mapcar 'transient-format (oref column suffixes))))
+ (when-let ((desc (transient-format-description column)))
+ (push desc rows))
+ rows))
+ (oref group suffixes)))
+ (rs (apply #'max (mapcar #'length columns)))
+ (cs (length columns))
+ (cw (mapcar (lambda (col) (apply #'max (mapcar #'length col)))
+ columns))
+ (cc (transient--seq-reductions-from (apply-partially #'+ 3) cw 0)))
+ (if transient-force-single-column
+ (dotimes (c cs)
+ (dotimes (r rs)
+ (when-let ((cell (nth r (nth c columns))))
+ (unless (equal cell "")
+ (insert cell ?\n))))
+ (unless (= c (1- cs))
+ (insert ?\n)))
+ (dotimes (r rs)
+ (dotimes (c cs)
+ (insert (make-string (- (nth c cc) (current-column)) ?\s))
+ (when-let ((cell (nth r (nth c columns))))
+ (insert cell))
+ (when (= c (1- cs))
+ (insert ?\n)))))))
+
+(cl-defmethod transient--insert-group ((group transient-subgroups))
+ (let* ((subgroups (oref group suffixes))
+ (n (length subgroups)))
+ (dotimes (s n)
+ (let ((subgroup (nth s subgroups)))
+ (transient--maybe-pad-keys subgroup group)
+ (transient--insert-group subgroup)
+ (when (< s (1- n))
+ (insert ?\n))))))
+
+(cl-defgeneric transient-format (obj)
+ "Format and return OBJ for display.
+
+When this function is called, then the current buffer is some
+temporary buffer. If you need the buffer from which the prefix
+command was invoked to be current, then do so by temporarily
+making `transient--original-buffer' current.")
+
+(cl-defmethod transient-format ((arg string))
+ "Return the string ARG after applying the `transient-heading' face."
+ (propertize arg 'face 'transient-heading))
+
+(cl-defmethod transient-format ((_ null))
+ "Return a string containing just the newline character."
+ "\n")
+
+(cl-defmethod transient-format ((arg integer))
+ "Return a string containing just the ARG character."
+ (char-to-string arg))
+
+(cl-defmethod transient-format :around ((obj transient-infix))
+ "When reading user input for this infix, then highlight it."
+ (let ((str (cl-call-next-method obj)))
+ (when (eq obj transient--active-infix)
+ (setq str (concat str "\n"))
+ (add-face-text-property
+ (if (eq this-command 'transient-set-level) 3 0)
+ (length str)
+ 'transient-active-infix nil str))
+ str))
+
+(cl-defmethod transient-format :around ((obj transient-suffix))
+ "When edit-mode is enabled, then prepend the level information.
+Optional support for popup buttons is also implemented here."
+ (let ((str (concat
+ (and transient--editp
+ (let ((level (oref obj level)))
+ (propertize (format " %s " level)
+ 'face (if (transient--use-level-p level t)
+ 'transient-enabled-suffix
+ 'transient-disabled-suffix))))
+ (cl-call-next-method obj))))
+ (when (oref obj inapt)
+ (add-face-text-property 0 (length str) 'transient-inapt-suffix nil str))
+ (if transient-enable-popup-navigation
+ (make-text-button str nil
+ 'type 'transient-button
+ 'command (transient--suffix-command obj))
+ str)))
+
+(cl-defmethod transient-format ((obj transient-infix))
+ "Return a string generated using OBJ's `format'.
+%k is formatted using `transient-format-key'.
+%d is formatted using `transient-format-description'.
+%v is formatted using `transient-format-value'."
+ (format-spec (oref obj format)
+ `((?k . ,(transient-format-key obj))
+ (?d . ,(transient-format-description obj))
+ (?v . ,(transient-format-value obj)))))
+
+(cl-defmethod transient-format ((obj transient-suffix))
+ "Return a string generated using OBJ's `format'.
+%k is formatted using `transient-format-key'.
+%d is formatted using `transient-format-description'."
+ (format-spec (oref obj format)
+ `((?k . ,(transient-format-key obj))
+ (?d . ,(transient-format-description obj)))))
+
+(cl-defgeneric transient-format-key (obj)
+ "Format OBJ's `key' for display and return the result.")
+
+(cl-defmethod transient-format-key ((obj transient-suffix))
+ "Format OBJ's `key' for display and return the result."
+ (let ((key (oref obj key))
+ (cmd (oref obj command)))
+ (if transient--redisplay-key
+ (let ((len (length transient--redisplay-key))
+ (seq (cl-coerce (edmacro-parse-keys key t) 'list)))
+ (cond
+ ((equal (seq-take seq len) transient--redisplay-key)
+ (let ((pre (key-description (vconcat (seq-take seq len))))
+ (suf (key-description (vconcat (seq-drop seq len)))))
+ (setq pre (string-replace "RET" "C-m" pre))
+ (setq pre (string-replace "TAB" "C-i" pre))
+ (setq suf (string-replace "RET" "C-m" suf))
+ (setq suf (string-replace "TAB" "C-i" suf))
+ ;; We use e.g. "-k" instead of the more correct "- k",
+ ;; because the former is prettier. If we did that in
+ ;; the definition, then we want to drop the space that
+ ;; is reinserted above. False-positives are possible
+ ;; for silly bindings like "-C-c C-c".
+ (unless (string-search " " key)
+ (setq pre (string-replace " " "" pre))
+ (setq suf (string-replace " " "" suf)))
+ (concat (propertize pre 'face 'default)
+ (and (string-prefix-p (concat pre " ") key) " ")
+ (transient--colorize-key suf cmd)
+ (save-excursion
+ (when (string-match " +\\'" key)
+ (match-string 0 key))))))
+ ((transient--lookup-key transient-sticky-map (kbd key))
+ (transient--colorize-key key cmd))
+ (t
+ (propertize key 'face 'transient-unreachable-key))))
+ (transient--colorize-key key cmd))))
+
+(defun transient--colorize-key (key command)
+ (propertize key 'face
+ (or (and (transient--semantic-coloring-p)
+ (transient--suffix-color command))
+ 'transient-key)))
+
+(cl-defmethod transient-format-key :around ((obj transient-argument))
+ (let ((key (cl-call-next-method obj)))
+ (cond ((not transient-highlight-mismatched-keys))
+ ((not (slot-boundp obj 'shortarg))
+ (add-face-text-property
+ 0 (length key) 'transient-nonstandard-key nil key))
+ ((not (string-equal key (oref obj shortarg)))
+ (add-face-text-property
+ 0 (length key) 'transient-mismatched-key nil key)))
+ key))
+
+(cl-defgeneric transient-format-description (obj)
+ "Format OBJ's `description' for display and return the result.")
+
+(cl-defmethod transient-format-description ((obj transient-child))
+ "The `description' slot may be a function, in which case that is
+called inside the correct buffer (see `transient-insert-group')
+and its value is returned to the caller."
+ (when-let ((desc (oref obj description)))
+ (if (functionp desc)
+ (with-current-buffer transient--original-buffer
+ (funcall desc))
+ desc)))
+
+(cl-defmethod transient-format-description ((obj transient-group))
+ "Format the description by calling the next method. If the result
+doesn't use the `face' property at all, then apply the face
+`transient-heading' to the complete string."
+ (when-let ((desc (cl-call-next-method obj)))
+ (if (text-property-not-all 0 (length desc) 'face nil desc)
+ desc
+ (propertize desc 'face 'transient-heading))))
+
+(cl-defmethod transient-format-description :around ((obj transient-suffix))
+ "Format the description by calling the next method. If the result
+is nil, then use \"(BUG: no description)\" as the description.
+If the OBJ's `key' is currently unreachable, then apply the face
+`transient-unreachable' to the complete string."
+ (let ((desc (or (cl-call-next-method obj)
+ (and (slot-boundp transient--prefix 'suffix-description)
+ (funcall (oref transient--prefix suffix-description)
+ obj))
+ (propertize "(BUG: no description)" 'face 'error))))
+ (cond ((transient--key-unreachable-p obj)
+ (propertize desc 'face 'transient-unreachable))
+ ((and transient-highlight-higher-levels
+ (> (oref obj level) transient--default-prefix-level))
+ (add-face-text-property
+ 0 (length desc) 'transient-higher-level nil desc)
+ desc)
+ (t
+ desc))))
+
+(cl-defgeneric transient-format-value (obj)
+ "Format OBJ's value for display and return the result.")
+
+(cl-defmethod transient-format-value ((obj transient-suffix))
+ (propertize (oref obj argument)
+ 'face (if (oref obj value)
+ 'transient-argument
+ 'transient-inactive-argument)))
+
+(cl-defmethod transient-format-value ((obj transient-option))
+ (let ((value (oref obj value)))
+ (propertize (concat (oref obj argument)
+ (if (listp value)
+ (mapconcat #'identity value ",")
+ value))
+ 'face (if value
+ 'transient-value
+ 'transient-inactive-value))))
+
+(cl-defmethod transient-format-value ((obj transient-switches))
+ (with-slots (value argument-format choices) obj
+ (format (propertize argument-format
+ 'face (if value
+ 'transient-value
+ 'transient-inactive-value))
+ (concat
+ (propertize "[" 'face 'transient-inactive-value)
+ (mapconcat
+ (lambda (choice)
+ (propertize choice 'face
+ (if (equal (format argument-format choice) value)
+ 'transient-value
+ 'transient-inactive-value)))
+ choices
+ (propertize "|" 'face 'transient-inactive-value))
+ (propertize "]" 'face 'transient-inactive-value)))))
+
+(cl-defmethod transient-format-value ((obj transient-files))
+ (let ((argument (oref obj argument)))
+ (if-let ((value (oref obj value)))
+ (propertize (concat argument " "
+ (mapconcat (lambda (f) (format "%S" f))
+ (oref obj value) " "))
+ 'face 'transient-argument)
+ (propertize argument 'face 'transient-inactive-argument))))
+
+(defun transient--key-unreachable-p (obj)
+ (and transient--redisplay-key
+ (let ((key (oref obj key)))
+ (not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list)
+ (length transient--redisplay-key))
+ transient--redisplay-key)
+ (transient--lookup-key transient-sticky-map (kbd key)))))))
+
+(defun transient--lookup-key (keymap key)
+ (let ((val (lookup-key keymap key)))
+ (and val (not (integerp val)) val)))
+
+(defun transient--maybe-pad-keys (group &optional parent)
+ (when-let ((pad (if (slot-boundp group 'pad-keys)
+ (oref group pad-keys)
+ (and parent
+ (slot-boundp parent 'pad-keys)
+ (oref parent pad-keys)))))
+ (let ((width (apply #'max
+ (cons (if (integerp pad) pad 0)
+ (mapcar (lambda (suffix)
+ (length (oref suffix key)))
+ (oref group suffixes))))))
+ (dolist (suffix (oref group suffixes))
+ (oset suffix key
+ (truncate-string-to-width (oref suffix key) width nil ?\s))))))
+
+(defun transient-command-summary-or-name (obj)
+ "Return the summary or name of the command represented by OBJ.
+
+If the command has a doc-string, then return the first line of
+that, else its name.
+
+Intended to be temporarily used as the `:suffix-description' of
+a prefix command, while porting a regular keymap to a transient."
+ (let ((command (transient--suffix-symbol (oref obj command))))
+ (if-let ((doc (documentation command)))
+ (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face)
+ (propertize (symbol-name command) 'face 'font-lock-function-name-face))))
+
+;;; Help
+
+(cl-defgeneric transient-show-help (obj)
+ "Show help for OBJ's command.")
+
+(cl-defmethod transient-show-help ((obj transient-prefix))
+ "Show the info manual, manpage or command doc-string.
+Show the first one that is specified."
+ (if-let ((manual (oref obj info-manual)))
+ (info manual)
+ (if-let ((manpage (oref obj man-page)))
+ (transient--show-manpage manpage)
+ (transient--describe-function (oref obj command)))))
+
+(cl-defmethod transient-show-help ((obj transient-suffix))
+ "Show the command doc-string."
+ (if (eq this-original-command 'transient-help)
+ (if-let ((manpage (oref transient--prefix man-page)))
+ (transient--show-manpage manpage)
+ (transient--describe-function (oref transient--prefix command)))
+ (if-let ((prefix (get (transient--suffix-command obj) 'transient--prefix))
+ (manpage (oref prefix man-page)))
+ (transient--show-manpage manpage)
+ (transient--describe-function this-original-command))))
+
+(cl-defmethod transient-show-help ((obj transient-infix))
+ "Show the manpage if defined or the command doc-string.
+If the manpage is specified, then try to jump to the correct
+location."
+ (if-let ((manpage (oref transient--prefix man-page)))
+ (transient--show-manpage manpage (ignore-errors (oref obj argument)))
+ (transient--describe-function this-original-command)))
+
+;; `cl-generic-generalizers' doesn't support `command' et al.
+(cl-defmethod transient-show-help (cmd)
+ "Show the command doc-string."
+ (transient--describe-function cmd))
+
+(defun transient--show-manpage (manpage &optional argument)
+ (require 'man)
+ (let* ((Man-notify-method 'meek)
+ (buf (Man-getpage-in-background manpage))
+ (proc (get-buffer-process buf)))
+ (while (and proc (eq (process-status proc) 'run))
+ (accept-process-output proc))
+ (switch-to-buffer buf)
+ (when argument
+ (transient--goto-argument-description argument))))
+
+(defun transient--describe-function (fn)
+ (describe-function fn)
+ (select-window (get-buffer-window (help-buffer))))
+
+(defun transient--goto-argument-description (arg)
+ (goto-char (point-min))
+ (let ((case-fold-search nil)
+ ;; This matches preceding/proceeding options. Options
+ ;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>"
+ ;; are matched by this regex without the shy group.
+ ;; The ". " in the shy group is for options such as
+ ;; "-m parent-number", and the "-[^[:space:]]+ " is
+ ;; for options such as "--mainline parent-number"
+ (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+"))
+ (when (re-search-forward
+ (if (equal arg "--")
+ ;; Special case.
+ "^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)"
+ ;; Should start with whitespace and may have
+ ;; any number of options before and/or after.
+ (format
+ "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$"
+ others
+ ;; Options don't necessarily end in an "="
+ ;; (e.g., "--gpg-sign[=<keyid>]")
+ (string-remove-suffix "=" arg)
+ ;; Simple options don't end in an "=". Splitting this
+ ;; into 2 cases should make getting false positives
+ ;; less likely.
+ (if (string-suffix-p "=" arg)
+ ;; "[^[:space:]]*[^.[:space:]]" matches the option
+ ;; value, which is usually after the option name
+ ;; and either '=' or '[='. The value can't end in
+ ;; a period, as that means it's being used at the
+ ;; end of a sentence. The space is for options
+ ;; such as '--mainline parent-number'.
+ "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]"
+ ;; Either this doesn't match anything (e.g., "-a"),
+ ;; or the option is followed by a value delimited
+ ;; by a "[", "<", or ":". A space might appear
+ ;; before this value, as in "-f <file>". The
+ ;; space alternative is for options such as
+ ;; "-m parent-number".
+ "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?")
+ others))
+ nil t)
+ (goto-char (match-beginning 1)))))
+
+(defun transient--insert-help ()
+ (unless (looking-back "\n\n" 2)
+ (insert "\n"))
+ (when transient--helpp
+ (insert
+ (format (propertize "\
+Type a %s to show help for that suffix command, or %s to show manual.
+Type %s to exit help.\n"
+ 'face 'transient-heading)
+ (propertize "<KEY>" 'face 'transient-key)
+ (propertize "?" 'face 'transient-key)
+ (propertize "C-g" 'face 'transient-key))))
+ (when transient--editp
+ (unless transient--helpp
+ (insert
+ (format (propertize "\
+Type a %s to set level for that suffix command.
+Type %s to set what levels are available for this prefix command.\n"
+ 'face 'transient-heading)
+ (propertize "<KEY>" 'face 'transient-key)
+ (propertize "C-x l" 'face 'transient-key))))
+ (with-slots (level) transient--prefix
+ (insert
+ (format (propertize "
+Suffixes on levels %s are available.
+Suffixes on levels %s and %s are unavailable.\n"
+ 'face 'transient-heading)
+ (propertize (format "1-%s" level)
+ 'face 'transient-enabled-suffix)
+ (propertize " 0 "
+ 'face 'transient-disabled-suffix)
+ (propertize (format ">=%s" (1+ level))
+ 'face 'transient-disabled-suffix))))))
+
+(defvar transient-resume-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap Man-quit] 'transient-resume)
+ (define-key map [remap Info-exit] 'transient-resume)
+ (define-key map [remap quit-window] 'transient-resume)
+ map)
+ "Keymap for `transient-resume-mode'.
+
+This keymap remaps every command that would usually just quit the
+documentation buffer to `transient-resume', which additionally
+resumes the suspended transient.")
+
+(define-minor-mode transient-resume-mode
+ "Auxiliary minor-mode used to resume a transient after viewing help.")
+
+;;; Compatibility
+;;;; Popup Navigation
+
+(defun transient-popup-navigation-help ()
+ "Inform the user how to enable popup navigation commands."
+ (interactive)
+ (message "This command is only available if `%s' is non-nil"
+ 'transient-enable-popup-navigation))
+
+(define-button-type 'transient-button
+ 'face nil
+ 'action (lambda (button)
+ (let ((command (button-get button 'command)))
+ ;; Yes, I know that this is wrong(tm).
+ ;; Unfortunately it is also necessary.
+ (setq this-original-command command)
+ (call-interactively command))))
+
+(defvar transient-popup-navigation-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<down-mouse-1>") 'transient-noop)
+ (define-key map (kbd "<mouse-1>") 'transient-mouse-push-button)
+ (define-key map (kbd "RET") 'transient-push-button)
+ (define-key map (kbd "<up>") 'transient-backward-button)
+ (define-key map (kbd "C-p") 'transient-backward-button)
+ (define-key map (kbd "<down>") 'transient-forward-button)
+ (define-key map (kbd "C-n") 'transient-forward-button)
+ (define-key map (kbd "C-r") 'transient-isearch-backward)
+ (define-key map (kbd "C-s") 'transient-isearch-forward)
+ map))
+
+(defun transient-mouse-push-button (&optional pos)
+ "Invoke the suffix the user clicks on."
+ (interactive (list last-command-event))
+ (push-button pos))
+
+(defun transient-push-button ()
+ "Invoke the selected suffix command."
+ (interactive)
+ (with-selected-window transient--window
+ (push-button)))
+
+(defun transient-backward-button (n)
+ "Move to the previous button in the transient popup buffer.
+See `backward-button' for information about N."
+ (interactive "p")
+ (with-selected-window transient--window
+ (backward-button n t)))
+
+(defun transient-forward-button (n)
+ "Move to the next button in the transient popup buffer.
+See `forward-button' for information about N."
+ (interactive "p")
+ (with-selected-window transient--window
+ (forward-button n t)))
+
+(defun transient--goto-button (command)
+ (if (not command)
+ (forward-button 1)
+ (while (and (ignore-errors (forward-button 1))
+ (not (eq (button-get (button-at (point)) 'command) command))))
+ (unless (eq (button-get (button-at (point)) 'command) command)
+ (goto-char (point-min))
+ (forward-button 1))))
+
+;;;; Popup Isearch
+
+(defvar transient--isearch-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map isearch-mode-map)
+ (define-key map [remap isearch-exit] 'transient-isearch-exit)
+ (define-key map [remap isearch-cancel] 'transient-isearch-cancel)
+ (define-key map [remap isearch-abort] 'transient-isearch-abort)
+ map))
+
+(defun transient-isearch-backward (&optional regexp-p)
+ "Do incremental search backward.
+With a prefix argument, do an incremental regular expression
+search instead."
+ (interactive "P")
+ (transient--isearch-setup)
+ (let ((isearch-mode-map transient--isearch-mode-map))
+ (isearch-mode nil regexp-p)))
+
+(defun transient-isearch-forward (&optional regexp-p)
+ "Do incremental search forward.
+With a prefix argument, do an incremental regular expression
+search instead."
+ (interactive "P")
+ (transient--isearch-setup)
+ (let ((isearch-mode-map transient--isearch-mode-map))
+ (isearch-mode t regexp-p)))
+
+(defun transient-isearch-exit ()
+ "Like `isearch-exit' but adapted for `transient'."
+ (interactive)
+ (isearch-exit)
+ (transient--isearch-exit))
+
+(defun transient-isearch-cancel ()
+ "Like `isearch-cancel' but adapted for `transient'."
+ (interactive)
+ (condition-case nil (isearch-cancel) (quit))
+ (transient--isearch-exit))
+
+(defun transient-isearch-abort ()
+ "Like `isearch-abort' but adapted for `transient'."
+ (interactive)
+ (condition-case nil (isearch-abort) (quit))
+ (transient--isearch-exit))
+
+(defun transient--isearch-setup ()
+ (select-window transient--window)
+ (transient--suspend-override))
+
+(defun transient--isearch-exit ()
+ (select-window transient--original-window)
+ (transient--resume-override))
+
+;;;; Hydra Color Emulation
+
+(defun transient--semantic-coloring-p ()
+ (and transient-semantic-coloring
+ (not transient--helpp)
+ (not transient--editp)))
+
+(defun transient--suffix-color (command)
+ (or (get command 'transient-color)
+ (get (transient--get-predicate-for command) 'transient-color)))
+
+(defun transient--prefix-color (command)
+ (let* ((nonsuf (or (oref command transient-non-suffix)
+ 'transient--do-warn))
+ (nonsuf (if (memq nonsuf '(transient--do-noop transient--do-warn))
+ 'disallow
+ (get nonsuf 'transient-color)))
+ (suffix (if-let ((pred (oref command transient-suffix)))
+ (get pred 'transient-color)
+ (if (eq nonsuf 'transient-red)
+ 'transient-red
+ 'transient-blue))))
+ (pcase (list suffix nonsuf)
+ (`(transient-red disallow) 'transient-amaranth)
+ (`(transient-blue disallow) 'transient-teal)
+ (`(transient-red transient-red) 'transient-pink)
+ (`(transient-red transient-blue) 'transient-red)
+ (`(transient-blue transient-blue) 'transient-blue))))
+
+;;;; Edebug
+
+(defun transient--edebug--recursive-edit (fn arg-mode)
+ (transient--debug 'edebug--recursive-edit)
+ (if (not transient--prefix)
+ (funcall fn arg-mode)
+ (transient--suspend-override t)
+ (funcall fn arg-mode)
+ (transient--resume-override t)))
+
+(advice-add 'edebug--recursive-edit :around 'transient--edebug--recursive-edit)
+
+(defun transient--abort-edebug ()
+ (when (bound-and-true-p edebug-active)
+ (transient--emergency-exit)))
+
+(advice-add 'abort-recursive-edit :before 'transient--abort-edebug)
+(advice-add 'top-level :before 'transient--abort-edebug)
+
+(defun transient--edebug-command-p ()
+ (and (bound-and-true-p edebug-active)
+ (or (memq this-command '(top-level abort-recursive-edit))
+ (string-prefix-p "edebug" (symbol-name this-command)))))
+
+;;;; Miscellaneous
+
+(declare-function which-key-mode "which-key" (&optional arg))
+
+(defun transient--suspend-which-key-mode ()
+ (when (bound-and-true-p which-key-mode)
+ (which-key-mode -1)
+ (add-hook 'transient-exit-hook 'transient--resume-which-key-mode)))
+
+(defun transient--resume-which-key-mode ()
+ (unless transient--prefix
+ (which-key-mode 1)
+ (remove-hook 'transient-exit-hook 'transient--resume-which-key-mode)))
+
+(defun transient-bind-q-to-quit ()
+ "Modify some keymaps to bind \"q\" to the appropriate quit command.
+
+\"C-g\" is the default binding for such commands now, but Transient's
+predecessor Magit-Popup used \"q\" instead. If you would like to get
+that binding back, then call this function in your init file like so:
+
+ (with-eval-after-load \\='transient
+ (transient-bind-q-to-quit))
+
+Individual transients may already bind \"q\" to something else
+and such a binding would shadow the quit binding. If that is the
+case then \"Q\" is bound to whatever \"q\" would have been bound
+to by setting `transient-substitute-key-function' to a function
+that does that. Of course \"Q\" may already be bound to something
+else, so that function binds \"M-q\" to that command instead.
+Of course \"M-q\" may already be bound to something else, but
+we stop there."
+ (define-key transient-base-map "q" 'transient-quit-one)
+ (define-key transient-sticky-map "q" 'transient-quit-seq)
+ (setq transient-substitute-key-function
+ 'transient-rebind-quit-commands))
+
+(defun transient-rebind-quit-commands (obj)
+ "See `transient-bind-q-to-quit'."
+ (let ((key (oref obj key)))
+ (cond ((string-equal key "q") "Q")
+ ((string-equal key "Q") "M-q")
+ (t key))))
+
+(defun transient--force-fixed-pitch ()
+ (require 'face-remap)
+ (face-remap-reset-base 'default)
+ (face-remap-add-relative 'default 'fixed-pitch))
+
+;;;; Missing from Emacs
+
+(defun transient--seq-reductions-from (function sequence initial-value)
+ (let ((acc (list initial-value)))
+ (seq-doseq (elt sequence)
+ (push (funcall function (car acc) elt) acc))
+ (nreverse acc)))
+
+(defun transient-plist-to-alist (plist)
+ (let (alist)
+ (while plist
+ (push (cons (let* ((symbol (pop plist))
+ (name (symbol-name symbol)))
+ (if (eq (aref name 0) ?:)
+ (intern (substring name 1))
+ symbol))
+ (pop plist))
+ alist))
+ (nreverse alist)))
+
+;;; Font-Lock
+
+(defconst transient-font-lock-keywords
+ (eval-when-compile
+ `((,(concat "("
+ (regexp-opt (list "transient-define-prefix"
+ "transient-define-infix"
+ "transient-define-argument"
+ "transient-define-suffix")
+ t)
+ "\\_>[ \t'(]*"
+ "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+ (1 'font-lock-keyword-face)
+ (2 'font-lock-function-name-face nil t)))))
+
+(font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords)
+
+;;; Auxiliary Classes
+;;;; `transient-lisp-variable'
+
+(defclass transient-lisp-variable (transient-variable)
+ ((reader :initform #'transient-lisp-variable--reader)
+ (always-read :initform t)
+ (set-value :initarg :set-value :initform #'set))
+ "[Experimental] Class used for Lisp variables.")
+
+(cl-defmethod transient-init-value ((obj transient-lisp-variable))
+ (oset obj value (symbol-value (oref obj variable))))
+
+(cl-defmethod transient-infix-set ((obj transient-lisp-variable) value)
+ (funcall (oref obj set-value)
+ (oref obj variable)
+ (oset obj value value)))
+
+(cl-defmethod transient-format-description ((obj transient-lisp-variable))
+ (or (oref obj description)
+ (symbol-name (oref obj variable))))
+
+(cl-defmethod transient-format-value ((obj transient-lisp-variable))
+ (propertize (prin1-to-string (oref obj value))
+ 'face 'transient-value))
+
+(cl-defmethod transient-prompt ((obj transient-lisp-variable))
+ (format "Set %s: " (oref obj variable)))
+
+(defun transient-lisp-variable--reader (prompt initial-input _history)
+ (read--expression prompt initial-input))
+
+;;; _
+(provide 'transient)
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
+;;; transient.el ends here
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index 44b29bffe87..d40a628b994 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -110,10 +110,8 @@
;; `tree-widget-themes-directory', and `tree-widget-theme' options for
;; more details.
-;;; History:
-;;
-
;;; Code:
+
(require 'wid-edit)
;;; Customization
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 57e5570d537..186bf35fe7e 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -1,4 +1,4 @@
-;;; tutorial.el --- tutorial for Emacs
+;;; tutorial.el --- tutorial for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2006-2021 Free Software Foundation, Inc.
@@ -25,10 +25,6 @@
;; Code for running the Emacs tutorial.
-;;; History:
-
-;; File was created 2006-09.
-
;;; Code:
(require 'help-mode) ;; for function help-buffer
@@ -517,8 +513,8 @@ where
(list "more info" 'current-binding
key-fun def-fun key where))
nil))
- (add-to-list 'changed-keys
- (list key def-fun def-fun-txt where remark nil))))))
+ (push (list key def-fun def-fun-txt where remark nil)
+ changed-keys)))))
changed-keys))
(defun tutorial--key-description (key)
@@ -768,7 +764,7 @@ Run the Viper tutorial? "))
(if (fboundp 'viper-tutorial)
(if (y-or-n-p (concat prompt1 prompt2))
(progn (message "")
- (funcall 'viper-tutorial 0))
+ (funcall #'viper-tutorial 0))
(message "Tutorial aborted by user"))
(message prompt1)))
(let* ((lang (cond
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index c1ec90e2908..ffb5ecc9024 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -175,8 +175,8 @@ contains the name of the directory which the buffer is visiting.")
(cl-defstruct (uniquify-item
(:constructor nil) (:copier nil)
(:constructor uniquify-make-item
- (base dirname buffer &optional proposed)))
- base dirname buffer proposed)
+ (base dirname buffer &optional proposed original-dirname)))
+ base dirname buffer proposed original-dirname)
;; Internal variables used free
(defvar uniquify-possibly-resolvable nil)
@@ -211,7 +211,8 @@ this rationalization."
(with-current-buffer newbuf (setq uniquify-managed nil))
(when dirname
(setq dirname (expand-file-name (directory-file-name dirname)))
- (let ((fix-list (list (uniquify-make-item base dirname newbuf)))
+ (let ((fix-list (list (uniquify-make-item base dirname newbuf
+ nil dirname)))
items)
(dolist (buffer (buffer-list))
(when (and (not (and uniquify-ignore-buffers-re
@@ -245,7 +246,14 @@ this rationalization."
(if (buffer-live-p (uniquify-item-buffer item))
item))
items)))
- (setq fix-list (append fix-list items))))
+ ;; Other buffer's `uniquify-managed' lists may share
+ ;; elements. Ensure that we don't add these elements more
+ ;; than once to this buffer's `uniquify-managed' list.
+ (let ((new-items nil))
+ (dolist (item items)
+ (unless (memq item fix-list)
+ (push item new-items)))
+ (setq fix-list (append fix-list new-items)))))
;; selects buffers whose names may need changing, and others that
;; may conflict, then bring conflicting names together
(uniquify-rationalize fix-list))))
@@ -284,7 +292,9 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
;; Refresh the dirnames and proposed names.
(setf (uniquify-item-proposed item)
(uniquify-get-proposed-name (uniquify-item-base item)
- (uniquify-item-dirname item)))
+ (uniquify-item-dirname item)
+ nil
+ (uniquify-item-original-dirname item)))
(setq uniquify-managed fix-list)))
;; Strip any shared last directory names of the dirname.
(when (and (cdr fix-list) uniquify-strip-common-suffix)
@@ -307,7 +317,8 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
(uniquify-item-dirname item))))
(and f (directory-file-name f)))
(uniquify-item-buffer item)
- (uniquify-item-proposed item))
+ (uniquify-item-proposed item)
+ (uniquify-item-original-dirname item))
fix-list)))))
;; If uniquify-min-dir-content is 0, this will end up just
;; passing fix-list to uniquify-rationalize-conflicting-sublist.
@@ -335,13 +346,14 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
(uniquify-rationalize-conflicting-sublist conflicting-sublist
old-proposed depth)))
-(defun uniquify-get-proposed-name (base dirname &optional depth)
+(defun uniquify-get-proposed-name (base dirname &optional depth
+ original-dirname)
(unless depth (setq depth uniquify-min-dir-content))
(cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash.
;; Distinguish directories by adding extra separator.
(if (and uniquify-trailing-separator-p
- (file-directory-p (expand-file-name base dirname))
+ (file-directory-p (expand-file-name base original-dirname))
(not (string-equal base "")))
(cond ((eq uniquify-buffer-name-style 'forward)
(setq base (file-name-as-directory base)))
@@ -410,7 +422,8 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
(uniquify-get-proposed-name
(uniquify-item-base item)
(uniquify-item-dirname item)
- depth)))
+ depth
+ (uniquify-item-original-dirname item))))
(uniquify-rationalize-a-list conf-list depth))
(unless (string= old-name "")
(uniquify-rename-buffer (car conf-list) old-name)))))
@@ -492,8 +505,6 @@ For use on `kill-buffer-hook'."
(file-name-directory filename) retval)))
retval))
-;;; The End
-
(defun uniquify-unload-function ()
"Unload the uniquify library."
(save-current-buffer
diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1
index 5a3bf3afd1a..cdd37a64cdd 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -2337,7 +2337,7 @@
recurse when retrieving the property lists. Returns an assoc
list keyed off of the resource, the cdr of which is a property list.
(url-dav-datatype-attribute): We support the XML-Data note
- (http://www.w3.org/TR/1998/NOTE-XML-data) to figure out what the
+ (https://www.w3.org/TR/1998/NOTE-XML-data) to figure out what the
datatypes of attributes are. Currently only date, dateTime, int,
number, float, boolean, and uri are supported.
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index f291414e81b..06cfacc99d6 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -102,10 +102,10 @@ instead of the filename inheritance method."
(byserv
(setq retval (cdr-safe (assoc file byserv)))
(if (and (not retval)
- (string-match "/" file))
+ (string-search "/" file))
(while (and byserv (not retval))
(setq data (car (car byserv)))
- (if (or (not (string-match "/" data)) ; It's a realm - take it!
+ (if (or (not (string-search "/" data)) ; It's a realm - take it!
(and
(>= (length file) (length data))
(string= data (substring file 0 (length data)))))
@@ -251,12 +251,12 @@ a match."
(assoc dirkey keylist)
;; No exact match found. Continue to look for partial match if
;; dirkey is not a realm.
- (and (string-match "/" dirkey)
+ (and (string-search "/" dirkey)
(let (match)
(while (and (null match) keylist)
(if (or
;; Any realm candidate matches. Why?
- (not (string-match "/" (caar keylist)))
+ (not (string-search "/" (caar keylist)))
;; Parent directory matches.
(string-prefix-p (caar keylist) dirkey))
(setq match (car keylist))
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 085159cb500..60388df2554 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -60,7 +60,7 @@
(defcustom url-cookie-multiple-line nil
"If nil, HTTP requests put all cookies for the server on one line.
-Some web servers, such as http://www.hotmail.com/, only accept cookies
+Some web servers, such as https://www.hotmail.com/, only accept cookies
when they are on one line. This is broken behavior, but just try
telling Microsoft that."
:type 'boolean
@@ -358,10 +358,10 @@ i.e. 1970-1-1) are loaded as expiring one year from now instead."
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-cookie-setup-save-timer' function manually."
- :set #'(lambda (var val)
- (set-default var val)
- (if (bound-and-true-p url-setup-done)
- (url-cookie-setup-save-timer)))
+ :set (lambda (var val)
+ (set-default var val)
+ (if (bound-and-true-p url-setup-done)
+ (url-cookie-setup-save-timer)))
:type 'integer
:group 'url-cookie)
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index edb1c1de9fc..192b1ac4f41 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -43,22 +43,11 @@
(defvar url-http-response-status)
(defvar url-http-end-of-headers)
-(defun url-intersection (l1 l2)
- "Return a list of the elements occurring in both of the lists L1 and L2."
- (if (null l2)
- l2
- (let (result)
- (while l1
- (if (member (car l1) l2)
- (setq result (cons (pop l1) result))
- (pop l1)))
- (nreverse result))))
-
;;;###autoload
(defun url-dav-supported-p (url)
"Return WebDAV protocol version supported by URL.
Returns nil if WebDAV is not supported."
- (url-intersection url-dav-supported-protocols
+ (seq-intersection url-dav-supported-protocols
(plist-get (url-http-options url) 'dav)))
(defun url-dav-node-text (node)
@@ -910,7 +899,9 @@ Returns nil if URL contains no name starting with FILE."
t)))
-;;; Miscellaneous stuff.
+;;; Obsolete.
+
+(define-obsolete-function-alias 'url-intersection #'seq-intersection "28.1")
(provide 'url-dav)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 68556d6aa9c..ed0402a5137 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -102,7 +102,15 @@
;;;###autoload
(define-minor-mode url-handler-mode
- "Toggle using `url' library for URL filenames (URL Handler mode)."
+ "Handle URLs as if they were file names throughout Emacs.
+After switching on this minor mode, Emacs file primitives handle
+URLs. For instance:
+
+ (file-exists-p \"https://www.gnu.org/\")
+ => t
+
+and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at
+that URL in a buffer."
:global t :group 'url
;; Remove old entry, if any.
(setq file-name-handler-alist
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 10238a46607..5dd1f099136 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -38,10 +38,10 @@
If non-nil, the URL package will keep track of all the URLs visited.
If set to t, then the list is saved to disk at the end of each Emacs
session."
- :set #'(lambda (var val)
- (set-default var val)
- (and (bound-and-true-p url-setup-done)
- (url-history-setup-save-timer)))
+ :set (lambda (var val)
+ (set-default var val)
+ (and (bound-and-true-p url-setup-done)
+ (url-history-setup-save-timer)))
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(other :tag "within session" session))
@@ -59,10 +59,10 @@ is parsed at startup and used to provide URL completion."
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-history-setup-save-timer' function manually."
- :set #'(lambda (var val)
- (set-default var val)
- (if (bound-and-true-p url-setup-done)
- (url-history-setup-save-timer)))
+ :set (lambda (var val)
+ (set-default var val)
+ (if (bound-and-true-p url-setup-done)
+ (url-history-setup-save-timer)))
:type 'integer
:group 'url-history)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 8cebd4e79f6..ba13a17a8fc 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1292,7 +1292,7 @@ passing it an updated value of CBARGS as arguments. The first
element in CBARGS should be a plist describing what has happened
so far during the request, as described in the docstring of
`url-retrieve' (if in doubt, specify nil). The current buffer
-then CALLBACK is executed is the retrieval buffer.
+when CALLBACK is executed is the retrieval buffer.
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted.
@@ -1494,17 +1494,18 @@ The return value of this function is the retrieval buffer."
;; Sometimes we get a zero-length data chunk after the process has
;; been changed to 'free', which means it has no buffer associated
;; with it. Do nothing if there is no buffer, or 0 length data.
- (and (process-buffer proc)
- (/= (length data) 0)
- (with-current-buffer (process-buffer proc)
- (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc)
- (funcall url-http-after-change-function
- (point-max)
- (progn
- (goto-char (point-max))
- (insert data)
- (point-max))
- (length data)))))
+ (let ((b (process-buffer proc)))
+ (when (and (buffer-live-p b) (not (zerop (length data))))
+ (with-current-buffer b
+ (url-http-debug "Calling after change function `%s' for `%S'"
+ url-http-after-change-function proc)
+ (funcall url-http-after-change-function
+ (point-max)
+ (progn
+ (goto-char (point-max))
+ (insert data)
+ (point-max))
+ (length data))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; file-name-handler stuff from here on out
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 72884c07cc9..4fd631d2955 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,4 +1,4 @@
-;;; url-mail.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
+;;; url-mailto.el --- Mail Uniform Resource Locator retrieval code -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1999, 2004-2021 Free Software Foundation, Inc.
@@ -104,8 +104,8 @@
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(goto-char (point-max)))
(insert (mapconcat
- #'(lambda (string)
- (replace-regexp-in-string "\r\n" "\n" string))
+ (lambda (string)
+ (string-replace "\r\n" "\n" string))
(cdar args) "\n")))
(url-mail-goto-field (caar args))
;; (setq func (intern-soft (concat "mail-" (caar args))))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 585a28291ae..4fe909cadbc 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -27,11 +27,6 @@
(require 'nntp)
(autoload 'gnus-group-read-ephemeral-group "gnus-group")
-;; Unused.
-;;; (defgroup url-news nil
-;;; "News related options."
-;;; :group 'url)
-
(defun url-news-open-host (host port user pass)
(if (fboundp 'nnheader-init-server-buffer)
(nnheader-init-server-buffer))
@@ -111,7 +106,7 @@
(article (url-unhex-string (url-filename url))))
(url-news-open-host host port (url-user url) (url-password url))
(cond
- ((string-match "@" article) ; Its a specific article
+ ((string-search "@" article) ; Its a specific article
(setq buf (url-news-fetch-message-id host article)))
((string= article "") ; List all newsgroups
(gnus))
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 8436c7a4be2..c89c1b6bc3e 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -49,14 +49,12 @@
;; Not sure how I should handle gracefully degrading from one proxy to
;; another, so for now just deal with the first one
;; (while proxies
- (if (listp proxies)
- (setq proxy (car proxies))
- (setq proxy proxies))
+ (setq proxy (if (listp proxies) (car proxies) proxies))
(cond
- ((string-match "^direct" proxy) nil)
- ((string-match "^proxy +" proxy)
+ ((string-match "^DIRECT" proxy) nil)
+ ((string-match "^PROXY +" proxy)
(concat "http://" (substring proxy (match-end 0)) "/"))
- ((string-match "^socks +" proxy)
+ ((string-match "^SOCKS +" proxy)
(concat "socks://" (substring proxy (match-end 0))))
(t
(display-warning 'url (format "Unknown proxy directive: %s" proxy) :error)
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 7c913bcb1a9..113ac2833bc 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -252,7 +252,7 @@ Will not do anything if `url-show-status' is nil."
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
- (unless (string-match "=" cur)
+ (unless (string-search "=" cur)
(setq cur (concat cur "=")))
(when (string-match "=" cur)
@@ -335,10 +335,13 @@ instead of just \"key\" as in the example above."
;;;###autoload
(defun url-unhex-string (str &optional allow-newlines)
- "Remove %XX embedded spaces, etc in a URL.
+ "Decode %XX sequences in a percent-encoded URL.
If optional second argument ALLOW-NEWLINES is non-nil, then allow the
decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
+forbidden in URL encoding.
+
+The resulting string in general requires decoding using an
+appropriate coding-system; see `decode-coding-string'."
(setq str (or str ""))
(let ((tmp "")
(case-fold-search t))
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 8c836f8f64d..2aa2e7912f5 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -22,10 +22,6 @@
;;; Code:
-(defconst url-version "Emacs"
- "Version number of URL package.")
-(make-obsolete-variable 'url-version nil "28.1")
-
(defgroup url nil
"Uniform Resource Locator tool."
:version "22.1"
@@ -427,6 +423,11 @@ Should be one of:
This should be set, e.g. by mail user agents rendering HTML to avoid
`bugs' which call home.")
+;; Obsolete
+
+(defconst url-version "Emacs" "Version number of URL package.")
+(make-obsolete-variable 'url-version 'emacs-version "28.1")
+
(provide 'url-vars)
;;; url-vars.el ends here
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 8daf9f0a8e8..ccc95a6eec4 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -208,9 +208,10 @@ URL-encoded before it's used."
(url-find-proxy-for-url url (url-host url))))
(buffer nil)
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
- (if url-using-proxy
- (setq asynch t
- loader #'url-proxy))
+ (when url-using-proxy
+ (setf asynch t
+ loader #'url-proxy
+ (url-asynchronous url) t))
(if asynch
(let ((url-current-object url))
(setq buffer (funcall loader url callback cbargs)))
@@ -234,85 +235,55 @@ If INHIBIT-COOKIES is non-nil, refuse to store cookies. If
TIMEOUT is passed, it should be a number that says (in seconds)
how long to wait for a response before giving up."
(url-do-setup)
-
- (let ((retrieval-done nil)
- (start-time (current-time))
- (url-asynchronous nil)
- (asynch-buffer nil)
- (timed-out nil))
- (setq asynch-buffer
- (url-retrieve url (lambda (&rest ignored)
- (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
- (setq retrieval-done t
- asynch-buffer (current-buffer)))
- nil silent inhibit-cookies))
- (if (null asynch-buffer)
- ;; We do not need to do anything, it was a mailto or something
- ;; similar that takes processing completely outside of the URL
- ;; package.
- nil
- (let ((proc (get-buffer-process asynch-buffer)))
- ;; If the access method was synchronous, `retrieval-done' should
- ;; hopefully already be set to t. If it is nil, and `proc' is also
- ;; nil, it implies that the async process is not running in
- ;; asynch-buffer. This happens e.g. for FTP files. In such a case
- ;; url-file.el should probably set something like a `url-process'
- ;; buffer-local variable so we can find the exact process that we
- ;; should be waiting for. In the mean time, we'll just wait for any
- ;; process output.
- (while (and (not retrieval-done)
- (or (not timeout)
- (not (setq timed-out
- (time-less-p timeout
- (time-since start-time))))))
- (url-debug 'retrieval
- "Spinning in url-retrieve-synchronously: %S (%S)"
- retrieval-done asynch-buffer)
- (if (buffer-local-value 'url-redirect-buffer asynch-buffer)
- (setq proc (get-buffer-process
- (setq asynch-buffer
- (buffer-local-value 'url-redirect-buffer
- asynch-buffer))))
- (if (and proc (memq (process-status proc)
- '(closed exit signal failed))
- ;; Make sure another process hasn't been started.
- (eq proc (or (get-buffer-process asynch-buffer) proc)))
- ;; FIXME: It's not clear whether url-retrieve's callback is
- ;; guaranteed to be called or not. It seems that url-http
- ;; decides sometimes consciously not to call it, so it's not
- ;; clear that it's a bug, but even then we need to decide how
- ;; url-http can then warn us that the download has completed.
- ;; In the mean time, we use this here workaround.
- ;; XXX: The callback must always be called. Any
- ;; exception is a bug that should be fixed, not worked
- ;; around.
- (progn ;; Call delete-process so we run any sentinel now.
- (delete-process proc)
- (setq retrieval-done t)))
- ;; We used to use `sit-for' here, but in some cases it wouldn't
- ;; work because apparently pending keyboard input would always
- ;; interrupt it before it got a chance to handle process input.
- ;; `sleep-for' was tried but it lead to other forms of
- ;; hanging. --Stef
- (unless (or (with-local-quit
- (accept-process-output proc 1))
- (null proc))
- ;; accept-process-output returned nil, maybe because the process
- ;; exited (and may have been replaced with another). If we got
- ;; a quit, just stop.
- (when quit-flag
- (delete-process proc))
- (setq proc (and (not quit-flag)
- (get-buffer-process asynch-buffer))))))
- ;; On timeouts, make sure we kill any pending processes.
- ;; There may be more than one if we had a redirect.
- (when timed-out
- (when (process-live-p proc)
- (delete-process proc))
- (when-let ((aproc (get-buffer-process asynch-buffer)))
- (when (process-live-p aproc)
- (delete-process aproc))))))
- asynch-buffer))
+ (let* (url-asynchronous
+ data-buffer
+ (callback (lambda (&rest _args)
+ (setq data-buffer (current-buffer))
+ (url-debug 'retrieval
+ "Synchronous fetching done (%S)"
+ data-buffer)))
+ (start-time (current-time))
+ (proc-buffer (url-retrieve url callback nil silent
+ inhibit-cookies)))
+ (if (not proc-buffer)
+ (url-debug 'retrieval "Synchronous fetching unnecessary %s" url)
+ (unwind-protect
+ (catch 'done
+ (while (not data-buffer)
+ (when (and timeout (time-less-p timeout
+ (time-since start-time)))
+ (url-debug 'retrieval "Timed out %s (after %ss)" url
+ (float-time (time-since start-time)))
+ (throw 'done 'timeout))
+ (url-debug 'retrieval
+ "Spinning in url-retrieve-synchronously: nil (%S)"
+ proc-buffer)
+ (when-let ((redirect-buffer
+ (buffer-local-value 'url-redirect-buffer
+ proc-buffer)))
+ (unless (eq redirect-buffer proc-buffer)
+ (url-debug
+ 'retrieval "Redirect in url-retrieve-synchronously: %S -> %S"
+ proc-buffer redirect-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer))
+ ;; Accommodate hack in commit 55d1d8b.
+ (setq proc-buffer redirect-buffer)))
+ (when-let ((proc (get-buffer-process proc-buffer)))
+ (when (memq (process-status proc)
+ '(closed exit signal failed))
+ ;; Process sentinel vagaries occasionally cause
+ ;; url-retrieve to fail calling callback.
+ (unless data-buffer
+ (url-debug 'retrieval "Dead process %s" url)
+ (throw 'done 'exception))))
+ ;; Querying over consumer internet in the US takes 100
+ ;; ms, so split the difference.
+ (accept-process-output nil 0.05)))
+ (unless (eq data-buffer proc-buffer)
+ (let (kill-buffer-query-functions)
+ (kill-buffer proc-buffer)))))
+ data-buffer))
;; url-mm-callback called from url-mm, which requires mm-decode.
(declare-function mm-dissect-buffer "mm-decode"
diff --git a/lisp/userlock.el b/lisp/userlock.el
index a340ff85b2d..38aaf6aec23 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -1,4 +1,4 @@
-;;; userlock.el --- handle file access contention between multiple users
+;;; userlock.el --- handle file access contention between multiple users -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 2001-2021 Free Software Foundation, Inc.
@@ -39,6 +39,10 @@
(define-error 'file-locked "File is locked" 'file-error)
+(defun userlock--fontify-key (key)
+ "Add the `help-key-binding' face to string KEY."
+ (propertize key 'face 'help-key-binding))
+
;;;###autoload
(defun ask-user-about-lock (file opponent)
"Ask user what to do when he wants to edit FILE but it is locked by OPPONENT.
@@ -64,8 +68,12 @@ in any way you like."
(match-string 0 opponent)))
opponent))
(while (null answer)
- (message "%s locked by %s: (s, q, p, ?)? "
- short-file short-opponent)
+ (message "%s locked by %s: (%s, %s, %s, %s)? "
+ short-file short-opponent
+ (userlock--fontify-key "s")
+ (userlock--fontify-key "q")
+ (userlock--fontify-key "p")
+ (userlock--fontify-key "?"))
(if noninteractive (error "Cannot resolve lock conflict in batch mode"))
(let ((tem (let ((inhibit-quit t)
(cursor-in-echo-area t))
@@ -80,7 +88,12 @@ in any way you like."
(?? . help))))
(cond ((null answer)
(beep)
- (message "Please type q, s, or p; or ? for help")
+ (message "Please type %s, %s, or %s; or %s for help"
+ (userlock--fontify-key "q")
+ (userlock--fontify-key "s")
+ (userlock--fontify-key "p")
+ ;; FIXME: Why do we use "?" here and "C-h" below?
+ (userlock--fontify-key "?"))
(sit-for 3))
((eq (cdr answer) 'help)
(ask-user-about-lock-help)
@@ -91,14 +104,19 @@ in any way you like."
(defun ask-user-about-lock-help ()
(with-output-to-temp-buffer "*Help*"
- (princ "It has been detected that you want to modify a file that someone else has
+ (with-current-buffer standard-output
+ (insert
+ (format
+ "It has been detected that you want to modify a file that someone else has
already started modifying in Emacs.
-You can <s>teal the file; the other user becomes the
+You can <%s>teal the file; the other user becomes the
intruder if (s)he ever unmodifies the file and then changes it again.
-You can <p>roceed; you edit at your own (and the other user's) risk.
-You can <q>uit; don't modify this file.")
- (with-current-buffer standard-output
+You can <%s>roceed; you edit at your own (and the other user's) risk.
+You can <%s>uit; don't modify this file."
+ (userlock--fontify-key "s")
+ (userlock--fontify-key "p")
+ (userlock--fontify-key "q")))
(help-mode))))
(define-error 'file-supersession nil 'file-error)
@@ -151,8 +169,13 @@ The buffer in question is current when this function is called."
(save-window-excursion
(let ((prompt
(format "%s changed on disk; \
-really edit the buffer? (y, n, r or C-h) "
- (file-name-nondirectory filename)))
+really edit the buffer? (%s, %s, %s or %s) "
+ (file-name-nondirectory filename)
+ (userlock--fontify-key "y")
+ (userlock--fontify-key "n")
+ (userlock--fontify-key "r")
+ ;; FIXME: Why do we use "C-h" here and "?" above?
+ (userlock--fontify-key "C-h")))
(choices '(?y ?n ?r ?? ?\C-h))
answer)
(when noninteractive
@@ -177,20 +200,38 @@ really edit the buffer? (y, n, r or C-h) "
(defun ask-user-about-supersession-help ()
(with-output-to-temp-buffer "*Help*"
- (princ
- (substitute-command-keys
- "You want to modify a buffer whose disk file has changed
+ (let ((revert-buffer-binding
+ ;; This takes place in the original buffer.
+ (substitute-command-keys "\\[revert-buffer]")))
+ (with-current-buffer standard-output
+ (insert
+ (format
+ "You want to modify a buffer whose disk file has changed
since you last read it in or saved it with this buffer.
-If you say `y' to go ahead and modify this buffer,
+If you say %s to go ahead and modify this buffer,
you risk ruining the work of whoever rewrote the file.
-If you say `r' to revert, the contents of the buffer are refreshed
+If you say %s to revert, the contents of the buffer are refreshed
from the file on disk.
-If you say `n', the change you started to make will be aborted.
+If you say %s, the change you started to make will be aborted.
-Usually, you should type `n' and then `\\[revert-buffer]',
-to get the latest version of the file, then make the change again."))
- (with-current-buffer standard-output
- (help-mode))))
+Usually, you should type %s and then %s,
+to get the latest version of the file, then make the change again."
+ (userlock--fontify-key "y")
+ (userlock--fontify-key "r")
+ (userlock--fontify-key "n")
+ (userlock--fontify-key "n")
+ revert-buffer-binding))
+ (help-mode)))))
+
+;;;###autoload
+(defun userlock--handle-unlock-error (error)
+ "Report an ERROR that occurred while unlocking a file."
+ (display-warning
+ '(unlock-file)
+ ;; There is no need to explain that this is an unlock error because
+ ;; ERROR is a `file-error' condition, which explains this.
+ (message "%s, ignored" (error-message-string error))
+ :warning))
;;; userlock.el ends here
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 19765e0da34..2e20284951f 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1,4 +1,4 @@
-;;; add-log.el --- change log maintenance commands for Emacs
+;;; add-log.el --- change log maintenance commands for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2021 Free
;; Software Foundation, Inc.
@@ -49,15 +49,13 @@
(defcustom change-log-default-name nil
"Name of a change log file for \\[add-change-log-entry]."
:type '(choice (const :tag "default" nil)
- string)
- :group 'change-log)
+ string))
;;;###autoload
-(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
+(put 'change-log-default-name 'safe-local-variable #'string-or-null-p)
(defcustom change-log-mode-hook nil
"Normal hook run by `change-log-mode'."
- :type 'hook
- :group 'change-log)
+ :type 'hook)
;; Many modes set this variable, so avoid warnings.
;;;###autoload
@@ -66,16 +64,14 @@
It is called by `add-log-current-defun' with no argument, and
should return the function's name as a string, or nil if point is
outside a function."
- :type '(choice (const nil) function)
- :group 'change-log)
+ :type '(choice (const nil) function))
;;;###autoload
(defcustom add-log-full-name nil
"Full name of user, for inclusion in ChangeLog daily headers.
This defaults to the value returned by the function `user-full-name'."
:type '(choice (const :tag "Default" nil)
- string)
- :group 'change-log)
+ string))
;;;###autoload
(defcustom add-log-mailing-address nil
@@ -86,8 +82,7 @@ will be recognized as referring to the same user; when creating a new
ChangeLog entry, one element will be chosen at random."
:type '(choice (const :tag "Default" nil)
(string :tag "String")
- (repeat :tag "List of Strings" string))
- :group 'change-log)
+ (repeat :tag "List of Strings" string)))
(defcustom add-log-time-format 'add-log-iso8601-time-string
"Function that defines the time format.
@@ -98,8 +93,7 @@ and `current-time-string' are two valid values."
add-log-iso8601-time-string)
(const :tag "Old format, as returned by `current-time-string'"
current-time-string)
- (function :tag "Other"))
- :group 'change-log)
+ (function :tag "Other")))
(defcustom add-log-keep-changes-together nil
"If non-nil, normally keep day's log entries for one file together.
@@ -130,14 +124,12 @@ and in the former:
The NEW-ENTRY arg to `add-change-log-entry' can override the effect of
this variable."
:version "20.3"
- :type 'boolean
- :group 'change-log)
+ :type 'boolean)
(defcustom add-log-always-start-new-record nil
"If non-nil, `add-change-log-entry' will always start a new record."
:version "22.1"
- :type 'boolean
- :group 'change-log)
+ :type 'boolean)
(defvar add-log-buffer-file-name-function 'buffer-file-name
"If non-nil, function to call to identify the full filename of a buffer.
@@ -149,15 +141,13 @@ use `buffer-file-name'.")
This function is called with one argument, the value of variable
`buffer-file-name' in that buffer. If this is nil, the default is to
use the file's name relative to the directory of the change log file."
- :type '(choice (const nil) function)
- :group 'change-log)
+ :type '(choice (const nil) function))
(defcustom change-log-version-info-enabled nil
"If non-nil, enable recording version numbers with the changes."
:version "21.1"
- :type 'boolean
- :group 'change-log)
+ :type 'boolean)
(defcustom change-log-version-number-regexp-list
(let ((re "\\([0-9]+\\.[0-9.]+\\)"))
@@ -170,64 +160,54 @@ use the file's name relative to the directory of the change log file."
The version number must be in group 1.
Note: The search is conducted only within 10%, at the beginning of the file."
:version "21.1"
- :type '(repeat regexp)
- :group 'change-log)
+ :type '(repeat regexp))
(defcustom change-log-directory-files '(".bzr" ".git" ".hg" ".svn")
"List of files that cause `find-change-log' to stop in containing directory.
This applies if no pre-existing ChangeLog is found. If nil, then in such
a case simply use the directory containing the changed file."
:version "26.1"
- :type '(repeat file)
- :group 'change-log)
+ :type '(repeat file))
(defface change-log-date
'((t (:inherit font-lock-string-face)))
"Face used to highlight dates in date lines."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-name
'((t (:inherit font-lock-constant-face)))
"Face for highlighting author names."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-email
'((t (:inherit font-lock-variable-name-face)))
"Face for highlighting author email addresses."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-file
'((t (:inherit font-lock-function-name-face)))
"Face for highlighting file names."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-list
'((t (:inherit font-lock-keyword-face)))
"Face for highlighting parenthesized lists of functions or variables."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-conditionals
'((t (:inherit font-lock-variable-name-face)))
"Face for highlighting conditionals of the form `[...]'."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-function
'((t (:inherit font-lock-variable-name-face)))
"Face for highlighting items of the form `<....>'."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(defface change-log-acknowledgment
'((t (:inherit font-lock-comment-face)))
"Face for highlighting acknowledgments."
- :version "21.1"
- :group 'change-log)
+ :version "21.1")
(define-obsolete-face-alias 'change-log-acknowledgement
'change-log-acknowledgment "24.3")
@@ -519,7 +499,7 @@ try to visit the file for the change under `point' instead."
change-log-find-tail)
(setq change-log-find-tail
(condition-case nil
- (apply 'change-log-goto-source-1
+ (apply #'change-log-goto-source-1
(append change-log-find-head change-log-find-tail))
(error
(format-message
@@ -556,7 +536,7 @@ try to visit the file for the change under `point' instead."
file (find-file-noselect file)))
(condition-case nil
(setq change-log-find-tail
- (apply 'change-log-goto-source-1 change-log-find-head))
+ (apply #'change-log-goto-source-1 change-log-find-head))
(error
(format-message "Cannot find matches for tag `%s' in file `%s'"
tag file)))))))))
@@ -569,7 +549,7 @@ Compatibility function for \\[next-error] invocations."
(count (abs argp)) ; how many cycles
(down (< argp 0)) ; are we going down? (is argp negative?)
(up (not down))
- (search-function (if up 're-search-forward 're-search-backward)))
+ (search-function (if up #'re-search-forward #'re-search-backward)))
;; set the starting position
(goto-char (cond (reset (point-min))
@@ -589,29 +569,27 @@ Compatibility function for \\[next-error] invocations."
(select-window change-log-find-window)))))
(defvar change-log-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap)))
- (define-key map [?\C-c ?\C-p] 'add-log-edit-prev-comment)
- (define-key map [?\C-c ?\C-n] 'add-log-edit-next-comment)
- (define-key map [?\C-c ?\C-f] 'change-log-find-file)
- (define-key map [?\C-c ?\C-c] 'change-log-goto-source)
- (define-key map [menu-bar changelog] (cons "ChangeLog" menu-map))
- (define-key menu-map [gs]
- '(menu-item "Go To Source" change-log-goto-source
- :help "Go to source location of ChangeLog tag near point"))
- (define-key menu-map [ff]
- '(menu-item "Find File" change-log-find-file
- :help "Visit the file for the change under point"))
- (define-key menu-map [sep] '("--"))
- (define-key menu-map [nx]
- '(menu-item "Next Log-Edit Comment" add-log-edit-next-comment
- :help "Cycle forward through Log-Edit mode comment history"))
- (define-key menu-map [pr]
- '(menu-item "Previous Log-Edit Comment" add-log-edit-prev-comment
- :help "Cycle backward through Log-Edit mode comment history"))
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-c ?\C-p] #'add-log-edit-prev-comment)
+ (define-key map [?\C-c ?\C-n] #'add-log-edit-next-comment)
+ (define-key map [?\C-c ?\C-f] #'change-log-find-file)
+ (define-key map [?\C-c ?\C-c] #'change-log-goto-source)
map)
"Keymap for Change Log major mode.")
+(easy-menu-define change-log-mode-menu change-log-mode-map
+ "Menu for Change Log major mode."
+ '("ChangeLog"
+ ["Previous Log-Edit Comment" add-log-edit-prev-comment
+ :help "Cycle backward through Log-Edit mode comment history"]
+ ["Next Log-Edit Comment" add-log-edit-next-comment
+ :help "Cycle forward through Log-Edit mode comment history"]
+ "---"
+ ["Find File" change-log-find-file
+ :help "Visit the file for the change under point"]
+ ["Go To Source" change-log-goto-source
+ :help "Go to source location of ChangeLog tag near point"]))
+
;; It used to be called change-log-time-zone-rule but really should be
;; called add-log-time-zone-rule since it's only used from add-log-* code.
(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule)
@@ -814,7 +792,7 @@ means to put log entries in a suitably named buffer."
:type 'boolean
:version "27.1")
-(put 'add-log-dont-create-changelog-file 'safe-local-variable 'booleanp)
+(put 'add-log-dont-create-changelog-file 'safe-local-variable #'booleanp)
(defun add-log--pseudo-changelog-buffer-name (changelog-file-name)
"Compute a suitable name for a non-file visiting ChangeLog buffer.
@@ -1216,12 +1194,11 @@ file were isearch was started."
(forward-paragraph n)))
(defcustom add-log-current-defun-header-regexp
- "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alpha:]]+\\)[ \t]*[:=]"
+ "^\\([[:upper:]][[:upper:]_ ]*[[:upper:]_]\\|[-_[:alnum:]]*[[:alpha:]][-_[:alnum:]]*\\)[ \t]*[:=]"
"Heuristic regexp used by `add-log-current-defun' for unknown major modes.
The regexp's first submatch is placed in the ChangeLog entry, in
parentheses."
- :type 'regexp
- :group 'change-log)
+ :type 'regexp)
(declare-function c-cpp-define-name "cc-cmds" ())
(declare-function c-defun-name "cc-cmds" ())
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index 932dcd78920..4c1d9eaad55 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -1,4 +1,4 @@
-;;; compare-w.el --- compare text between windows for Emacs
+;;; compare-w.el --- compare text between windows for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2021 Free Software
;; Foundation, Inc.
@@ -52,19 +52,16 @@ any text before that point.
If the function returns the same value for both windows, then the
whitespace is considered to match, and is skipped."
:version "24.4" ; added \240
- :type '(choice regexp function)
- :group 'compare-windows)
+ :type '(choice regexp function))
(defcustom compare-ignore-whitespace nil
"Non-nil means command `compare-windows' ignores whitespace."
:type 'boolean
- :group 'compare-windows
:version "22.1")
(defcustom compare-ignore-case nil
"Non-nil means command `compare-windows' ignores case differences."
- :type 'boolean
- :group 'compare-windows)
+ :type 'boolean)
(defcustom compare-windows-sync 'compare-windows-sync-default-function
"Function or regexp that is used to synchronize points in two
@@ -92,7 +89,6 @@ If the value of this variable is nil (option \"No sync\"), then
no synchronization is performed, and the function `ding' is called
to beep or flash the screen when points are mismatched."
:type '(choice function regexp (const :tag "No sync" nil))
- :group 'compare-windows
:version "22.1")
(defcustom compare-windows-sync-string-size 32
@@ -104,7 +100,6 @@ difference regions more coarse-grained.
The default value 32 is good for the most cases."
:type 'integer
- :group 'compare-windows
:version "22.1")
(defcustom compare-windows-recenter nil
@@ -115,7 +110,6 @@ matching points side-by-side.
The value `(-1 0)' is useful if windows are split vertically,
and the value `((4) (4))' for horizontally split windows."
:type '(list sexp sexp)
- :group 'compare-windows
:version "22.1")
(defcustom compare-windows-highlight t
@@ -127,19 +121,16 @@ out all highlighting later with the command `compare-windows-dehighlight'."
:type '(choice (const :tag "No highlighting" nil)
(const :tag "Persistent highlighting" persistent)
(other :tag "Highlight until next command" t))
- :group 'compare-windows
:version "22.1")
(defface compare-windows-removed
'((t :inherit diff-removed))
"Face for highlighting `compare-windows' differing regions in the other window."
- :group 'compare-windows
:version "25.1")
(defface compare-windows-added
'((t :inherit diff-added))
"Face for highlighting `compare-windows' differing regions in current window."
- :group 'compare-windows
:version "25.1")
(define-obsolete-face-alias 'compare-windows 'compare-windows-added "25.1")
@@ -159,7 +150,6 @@ out all highlighting later with the command `compare-windows-dehighlight'."
(function-item :tag "Next window"
compare-windows-get-next-window)
(function :tag "Your function"))
- :group 'compare-windows
:version "25.1")
(defun compare-windows-get-recent-window ()
@@ -389,7 +379,7 @@ on third call it again advances points to the next difference and so on."
(setq p1 (1+ p1)))))
(when p12s
;; use closest matching points (i.e. points with minimal sum)
- (setq p12 (cdr (assq (apply 'min (mapcar 'car p12s)) p12s)))
+ (setq p12 (cdr (assq (apply #'min (mapcar #'car p12s)) p12s)))
(goto-char (car p12))
(compare-windows-highlight op1 (car p12) (current-buffer) w1
op2 (cadr p12) b2 w2))
@@ -416,7 +406,7 @@ on third call it again advances points to the next difference and so on."
(overlay-put compare-windows-overlay2 'window w2)
(if (not (eq compare-windows-highlight 'persistent))
;; Remove highlighting before next command is executed
- (add-hook 'pre-command-hook 'compare-windows-dehighlight)
+ (add-hook 'pre-command-hook #'compare-windows-dehighlight)
(when compare-windows-overlay1
(push (copy-overlay compare-windows-overlay1) compare-windows-overlays1)
(delete-overlay compare-windows-overlay1))
@@ -427,9 +417,9 @@ on third call it again advances points to the next difference and so on."
(defun compare-windows-dehighlight ()
"Remove highlighting created by function `compare-windows-highlight'."
(interactive)
- (remove-hook 'pre-command-hook 'compare-windows-dehighlight)
- (mapc 'delete-overlay compare-windows-overlays1)
- (mapc 'delete-overlay compare-windows-overlays2)
+ (remove-hook 'pre-command-hook #'compare-windows-dehighlight)
+ (mapc #'delete-overlay compare-windows-overlays1)
+ (mapc #'delete-overlay compare-windows-overlays2)
(and compare-windows-overlay1 (delete-overlay compare-windows-overlay1))
(and compare-windows-overlay2 (delete-overlay compare-windows-overlay2)))
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index 26fb6206c80..63b886362ba 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -28,7 +28,7 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(require 'pcvs-util)
;;;
@@ -169,7 +169,7 @@
name
type)
-(defsubst cvs-status-vl-to-str (vl) (mapconcat 'number-to-string vl "."))
+(defsubst cvs-status-vl-to-str (vl) (mapconcat #'number-to-string vl "."))
(defun cvs-tag->string (tag)
(if (stringp tag) tag
@@ -283,7 +283,7 @@ BEWARE: because of stability issues, this is not a symmetric operation."
tree1 (list (cons (cvs-tag-make (butlast vl2)) tree2)))))))))
(defun cvs-tag-make-tag (tag)
- (let ((vl (mapcar 'string-to-number (split-string (nth 2 tag) "\\."))))
+ (let ((vl (mapcar #'string-to-number (split-string (nth 2 tag) "\\."))))
(cvs-tag-make vl (nth 0 tag) (intern (nth 1 tag)))))
(defun cvs-tags->tree (tags)
@@ -450,10 +450,10 @@ Optional prefix ARG chooses between two representations."
(tags nil)
(cvs-tree-nomerge (if arg (not cvs-tree-nomerge) cvs-tree-nomerge)))
(while (listp (setq tags (cvs-status-get-tags)))
- (let ((tags (mapcar 'cvs-tag-make-tag tags))
+ (let ((tags (mapcar #'cvs-tag-make-tag tags))
;;(pt (save-excursion (forward-line -1) (point)))
)
- (setq tags (sort tags 'cvs-tag-lessp))
+ (setq tags (sort tags #'cvs-tag-lessp))
(let* ((first (car tags))
(prev (if (cvs-tag-p first)
(list (car (cvs-tag->vlist first))) nil)))
@@ -472,7 +472,7 @@ Optional prefix ARG chooses between two representations."
(nprev (if (and cvs-tree-nomerge next
(equal vlist (cvs-tag->vlist next)))
prev vlist)))
- (cvs-map (lambda (v _p) v) nprev prev)))
+ (cl-mapcar (lambda (v _p) v) nprev prev)))
(after (save-excursion
(newline)
(cvs-tree-tags-insert (cdr tags) nprev)))
@@ -484,7 +484,7 @@ Optional prefix ARG chooses between two representations."
(as after (cdr as)))
((and (null as) (null vs) (null ps))
(let ((revname (cvs-status-vl-to-str vlist)))
- (if (cvs-every 'identity (cvs-map 'equal prev vlist))
+ (if (cl-every #'identity (cl-mapcar #'equal prev vlist))
(insert (make-string (+ 4 (length revname)) ? )
(or (cvs-tag->name tag) ""))
(insert " " revname ": " (or (cvs-tag->name tag) "")))))
@@ -500,7 +500,7 @@ Optional prefix ARG chooses between two representations."
(if next-eq (cons nil cvs-tree-char-space)
(cons t cvs-tree-char-eob))
(cons nil (if (and (eq (cvs-tag->type tag) 'branch)
- (cvs-every 'null as))
+ (cl-every #'null as))
cvs-tree-char-space
cvs-tree-char-hbar))))))
(insert (cdr na+char))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 7a474201811..eeb32f8fe50 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -357,6 +357,18 @@ well."
:foreground "green" :extend t))
"`diff-mode' face used to highlight added lines.")
+(defface diff-changed-unspecified
+ '((default
+ :inherit diff-changed)
+ (((class color) (min-colors 88) (background light))
+ :background "grey90" :extend t)
+ (((class color) (min-colors 88) (background dark))
+ :background "grey20" :extend t)
+ (((class color))
+ :foreground "grey" :extend t))
+ "`diff-mode' face used to highlight changed lines."
+ :version "28.1")
+
(defface diff-changed
'((t nil))
"`diff-mode' face used to highlight changed lines."
@@ -436,9 +448,10 @@ well."
(defvar diff-use-changed-face (and (face-differs-from-default-p 'diff-changed)
(not (face-equal 'diff-changed 'diff-added))
(not (face-equal 'diff-changed 'diff-removed)))
- "If non-nil, use the face `diff-changed' for changed lines in context diffs.
-Otherwise, use the face `diff-removed' for removed lines,
-and the face `diff-added' for added lines.")
+ "Controls how changed lines are fontified in context diffs.
+If non-nil, use the face `diff-changed-unspecified'. Otherwise,
+use the face `diff-removed' for removed lines, and the face
+`diff-added' for added lines.")
(defvar diff-font-lock-keywords
`((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$")
@@ -470,7 +483,7 @@ and the face `diff-added' for added lines.")
diff-indicator-added-face
diff-indicator-removed-face)))))
(2 (if diff-use-changed-face
- 'diff-changed
+ 'diff-changed-unspecified
;; Otherwise, use the same method as above.
(save-match-data
(let ((limit (save-excursion (diff-beginning-of-hunk))))
@@ -739,7 +752,7 @@ start and end positions."
"Restrict the view to the current hunk.
If the prefix ARG is given, restrict the view to the current file instead."
(interactive "P")
- (apply 'narrow-to-region
+ (apply #'narrow-to-region
(if arg (diff-bounds-of-file) (diff-bounds-of-hunk)))
(setq-local diff-narrowed-to (if arg 'file 'hunk)))
@@ -770,7 +783,7 @@ If the prefix ARG is given, restrict the view to the current file instead."
file-bounds
hunk-bounds))
(inhibit-read-only t))
- (apply 'kill-region bounds)
+ (apply #'kill-region bounds)
(goto-char (car bounds))
(ignore-errors (diff-beginning-of-hunk t)))))
@@ -828,7 +841,7 @@ data such as \"Index: ...\" and such."
(error "No hunks")
(diff-beginning-of-hunk t)
(let ((inhibit-read-only t))
- (apply 'kill-region (diff-bounds-of-file)))
+ (apply #'kill-region (diff-bounds-of-file)))
(ignore-errors (diff-beginning-of-hunk t))))
(defun diff-kill-junk ()
@@ -956,11 +969,11 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
(list (match-string 1)))
header-files
;; this assumes that there are no spaces in filenames
- (when (re-search-backward
- "^diff \\(-\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?"
- nil t)
- (list (if old (match-string 2) (match-string 4))
- (if old (match-string 4) (match-string 2)))))))))
+ (and (re-search-backward "^diff " nil t)
+ (looking-at
+ "^diff \\(-[^ \t\nL]+ +\\)*\\(-L +\\S-+ +\\)*\\(\\S-+\\)\\( +\\(\\S-+\\)\\)?")
+ (list (if old (match-string 3) (match-string 5))
+ (if old (match-string 4) (match-string 3)))))))))
(defun diff-find-file-name (&optional old noprompt prefix)
"Return the file corresponding to the current patch.
@@ -1767,13 +1780,26 @@ char-offset in TEXT."
(delete-region (point-min) keep))
;; Remove line-prefix characters, and unneeded lines (unified diffs).
;; Also skip lines like "\ No newline at end of file"
- (let ((kill-chars (list (if destp ?- ?+) ?\\)))
+ (let ((kill-chars (list (if destp ?- ?+) ?\\))
+ curr-char last-char)
(goto-char (point-min))
(while (not (eobp))
- (if (memq (char-after) kill-chars)
- (delete-region (point) (progn (forward-line 1) (point)))
+ (setq curr-char (char-after))
+ (if (memq curr-char kill-chars)
+ (delete-region
+ ;; Check for "\ No newline at end of file"
+ (if (and (eq curr-char ?\\)
+ (not (eq last-char (if destp ?- ?+)))
+ (save-excursion
+ (forward-line 1)
+ (or (eobp) (and (eq last-char ?-)
+ (eq (char-after) ?+)))))
+ (max (1- (point)) (point-min))
+ (point))
+ (progn (forward-line 1) (point)))
(delete-char num-pfx-chars)
- (forward-line 1)))))
+ (forward-line 1))
+ (setq last-char curr-char))))
(let ((text (buffer-substring-no-properties (point-min) (point-max))))
(if char-offset (cons text (- (point) (point-min))) text))))))
@@ -1810,7 +1836,7 @@ Whitespace differences are ignored."
(if (> (- (car forw) orig) (- orig (car back))) back forw)
(or back forw))))
-(define-obsolete-function-alias 'diff-xor 'xor "27.1")
+(define-obsolete-function-alias 'diff-xor #'xor "27.1")
(defun diff-find-source-location (&optional other-file reverse noprompt)
"Find current diff location within the source file.
@@ -1984,7 +2010,7 @@ With a prefix argument, try to REVERSE the hunk."
(diff-hunk-kill)
(diff-hunk-next)))))
-(defalias 'diff-mouse-goto-source 'diff-goto-source)
+(defalias 'diff-mouse-goto-source #'diff-goto-source)
(defun diff-goto-source (&optional other-file event)
"Jump to the corresponding source line.
@@ -2003,7 +2029,7 @@ revision of the file otherwise."
(if event (posn-set-point (event-end event)))
(let ((buffer (when event (current-buffer)))
(reverse (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
- (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (pcase-let ((`(,buf ,_line-offset ,pos ,src ,_dst ,_switched)
(diff-find-source-location other-file reverse)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
@@ -2080,7 +2106,7 @@ For use in `add-log-current-defun-function'."
(write-region (concat lead (car new)) nil file2 nil 'nomessage)
(with-temp-buffer
(let ((status
- (apply 'call-process
+ (apply #'call-process
`(,diff-command nil t nil
,@opts ,file1 ,file2))))
(pcase status
@@ -2252,17 +2278,20 @@ Call FUN with two args (BEG and END) for each hunk."
;; same hunk.
(goto-char (next-single-char-property-change
(point) 'diff--font-lock-refined nil max)))
- (diff--iterate-hunks
- max
- (lambda (beg end)
- (unless (get-char-property beg 'diff--font-lock-refined)
- (diff--refine-hunk beg end)
- (let ((ol (make-overlay beg end)))
- (overlay-put ol 'diff--font-lock-refined t)
- (overlay-put ol 'diff-mode 'fine)
- (overlay-put ol 'evaporate t)
- (overlay-put ol 'modification-hooks
- '(diff--overlay-auto-delete))))))))
+ ;; Ignore errors that diff cannot be found so that custom font-lock
+ ;; keywords after `diff--font-lock-refined' can still be evaluated.
+ (ignore-error file-missing
+ (diff--iterate-hunks
+ max
+ (lambda (beg end)
+ (unless (get-char-property beg 'diff--font-lock-refined)
+ (diff--refine-hunk beg end)
+ (let ((ol (make-overlay beg end)))
+ (overlay-put ol 'diff--font-lock-refined t)
+ (overlay-put ol 'diff-mode 'fine)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'modification-hooks
+ '(diff--overlay-auto-delete)))))))))
(defun diff--overlay-auto-delete (ol _after _beg _end &optional _len)
(delete-overlay ol))
@@ -2826,7 +2855,7 @@ hunk text is not found in the source file."
;;; Support for converting a diff to diff3 markers via `wiggle'.
-;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest
+;; Wiggle can be found at https://neil.brown.name/wiggle/ or in your nearest
;; Debian repository.
(defun diff-wiggle ()
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 7c4931b4b89..7bb1151602c 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -45,14 +45,12 @@ This variable is also used in the `vc-diff' command (and related
commands) if the backend-specific diff switch variable isn't
set (`vc-git-diff-switches' for git, for instance), and
`vc-diff-switches' isn't set."
- :type '(choice string (repeat string))
- :group 'diff)
+ :type '(choice string (repeat string)))
;;;###autoload
(defcustom diff-command (purecopy "diff")
"The command to use to run diff."
- :type 'string
- :group 'diff)
+ :type 'string)
;; prompt if prefix arg present
(defun diff-switches ()
@@ -60,7 +58,7 @@ set (`vc-git-diff-switches' for git, for instance), and
(read-string "Diff switches: "
(if (stringp diff-switches)
diff-switches
- (mapconcat 'identity diff-switches " ")))))
+ (mapconcat #'identity diff-switches " ")))))
(defun diff-sentinel (code &optional old-temp-file new-temp-file)
"Code run when the diff process exits.
@@ -165,7 +163,7 @@ returns the buffer used."
(let* ((old-alt (diff-file-local-copy old))
(new-alt (diff-file-local-copy new))
(command
- (mapconcat 'identity
+ (mapconcat #'identity
`(,diff-command
;; Use explicitly specified switches
,@switches
@@ -200,7 +198,7 @@ returns the buffer used."
(if (and (not no-async) (fboundp 'make-process))
(let ((proc (start-process "Diff" buf shell-file-name
shell-command-switch command)))
- (set-process-filter proc 'diff-process-filter)
+ (set-process-filter proc #'diff-process-filter)
(set-process-sentinel
proc (lambda (proc _msg)
(with-current-buffer (process-buffer proc)
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index fde9d4338f3..0965e888f06 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -87,7 +87,7 @@ options after the default ones.
This variable is not for customizing the look of the differences produced by
the command \\[ediff-show-diff-output]. Use the variable
`ediff-custom-diff-options' for that."
- :set 'ediff-set-diff-options
+ :set #'ediff-set-diff-options
:type 'string)
(ediff-defvar-local ediff-ignore-case nil
@@ -231,10 +231,7 @@ one optional arguments, diff-number to refine.")
(sit-for 2)
;; 1 is an error exit code
1)
- (t (message "Computing differences between %s and %s ..."
- (file-name-nondirectory file1)
- (file-name-nondirectory file2))
- ;; this erases the diff buffer automatically
+ (t ;; this erases the diff buffer automatically
(ediff-exec-process ediff-diff-program
diff-buffer
'synchronize
@@ -1146,7 +1143,10 @@ are ignored."
(if (string-match "buffer" (symbol-name ediff-job-name))
ediff-coding-system-for-write
ediff-coding-system-for-read))
- args)
+ (process-environment
+ ;; Avoid localization of messages so we can parse the output.
+ (cons "LC_MESSAGES=C" process-environment))
+ args)
(setq args (append (split-string options)
(mapcar (lambda (file)
(when (stringp file)
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 84bf063aedf..a5bb953b6d4 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -156,7 +156,7 @@ the value of this variable and the variables `ediff-help-message-*' in
;; the keymap that defines clicks over the quick help regions
(defvar ediff-help-region-map (make-sparse-keymap))
-(define-key ediff-help-region-map [mouse-2] 'ediff-help-for-quick-help)
+(define-key ediff-help-region-map [mouse-2] #'ediff-help-for-quick-help)
;; runs in the control buffer
(defun ediff-set-help-overlays ()
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 6e658163b91..17c4202d647 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -25,6 +25,7 @@
;;; Code:
(require 'cl-lib)
+(require 'ediff-util)
;; Start compiler pacifier
(defvar ediff-metajob-name)
@@ -980,8 +981,10 @@ this variable represents.")
(defface ediff-even-diff-A
`((((type pc))
(:foreground "green3" :background "light grey" :extend t))
- (((class color) (min-colors 88))
- (:background "light grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "light grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dark grey" :extend t))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey" :extend t))
(((class color))
@@ -999,8 +1002,10 @@ widget to customize the actual face object `ediff-even-diff-A'
this variable represents.")
(defface ediff-even-diff-B
- `((((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ `((((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1019,8 +1024,10 @@ this variable represents.")
(defface ediff-even-diff-C
`((((type pc))
(:foreground "yellow3" :background "light grey" :extend t))
- (((class color) (min-colors 88))
- (:background "light grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "light grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dark grey" :extend t))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey" :extend t))
(((class color))
@@ -1040,8 +1047,10 @@ this variable represents.")
(defface ediff-even-diff-Ancestor
`((((type pc))
(:foreground "cyan3" :background "light grey" :extend t))
- (((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1068,8 +1077,10 @@ this variable represents.")
(defface ediff-odd-diff-A
'((((type pc))
(:foreground "green3" :background "gray40" :extend t))
- (((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1088,8 +1099,10 @@ this variable represents.")
(defface ediff-odd-diff-B
'((((type pc))
(:foreground "White" :background "gray40" :extend t))
- (((class color) (min-colors 88))
- (:background "light grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "light grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dark grey" :extend t))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey" :extend t))
(((class color))
@@ -1108,8 +1121,10 @@ this variable represents.")
(defface ediff-odd-diff-C
'((((type pc))
(:foreground "yellow3" :background "gray40" :extend t))
- (((class color) (min-colors 88))
- (:background "Grey" :extend t))
+ (((class color) (min-colors 88) (background light))
+ (:distant-foreground "Black" :background "Grey" :extend t))
+ (((class color) (min-colors 88) (background dark))
+ (:distant-foreground "White" :background "dim grey" :extend t))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey" :extend t))
(((class color))
@@ -1167,8 +1182,8 @@ this variable represents.")
(put ediff-fine-diff-face-Ancestor 'ediff-help-echo
"A `refinement' of the current difference region")
-(add-hook 'ediff-quit-hook 'ediff-cleanup-mess)
-(add-hook 'ediff-suspend-hook 'ediff-default-suspend-function)
+(add-hook 'ediff-quit-hook #'ediff-cleanup-mess)
+(add-hook 'ediff-suspend-hook #'ediff-default-suspend-function)
;;; Overlays
@@ -1298,7 +1313,8 @@ This default should work without changes."
(defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight)
(let ((diff-vector
(eval (ediff-get-symbol-from-alist
- buf-type ediff-difference-vector-alist)))
+ buf-type ediff-difference-vector-alist)
+ t))
overl diff-num)
(mapcar (lambda (rec)
(setq overl (ediff-get-diff-overlay-from-diff-record rec)
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index 826cad9cc1b..ad4ef473f84 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -194,7 +194,7 @@ Buffer B."
(defun ediff-set-merge-mode ()
(normal-mode t)
- (remove-hook 'write-file-functions 'ediff-set-merge-mode t))
+ (remove-hook 'write-file-functions #'ediff-set-merge-mode t))
;; Go over all diffs starting with DIFF-NUM and copy regions into buffer C
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index d32c18be8fd..8e88b60a0bd 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -147,15 +147,15 @@ Useful commands (type ? to hide them and free up screen):
(defvar ediff-dir-diffs-buffer-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
- (define-key map "q" 'ediff-bury-dir-diffs-buffer)
- (define-key map " " 'next-line)
- (define-key map "n" 'next-line)
- (define-key map "\C-?" 'previous-line)
- (define-key map "p" 'previous-line)
- (define-key map "C" 'ediff-dir-diff-copy-file)
- (define-key map [mouse-2] 'ediff-dir-diff-copy-file)
- (define-key map [delete] 'previous-line)
- (define-key map [backspace] 'previous-line)
+ (define-key map "q" #'ediff-bury-dir-diffs-buffer)
+ (define-key map " " #'next-line)
+ (define-key map "n" #'next-line)
+ (define-key map "\C-?" #'previous-line)
+ (define-key map "p" #'previous-line)
+ (define-key map "C" #'ediff-dir-diff-copy-file)
+ (define-key map [mouse-2] #'ediff-dir-diff-copy-file)
+ (define-key map [delete] #'previous-line)
+ (define-key map [backspace] #'previous-line)
map)
"The keymap to be installed in the buffer showing differences between
directories.")
@@ -413,12 +413,11 @@ Toggled by ediff-toggle-verbose-help-meta-buffer" )
'(menu-item "Show Manual" ediff-documentation
:help "Display Ediff's manual"))
- (or (ediff-one-filegroup-metajob)
- (progn
- (define-key ediff-meta-buffer-map "=" nil)
- (define-key ediff-meta-buffer-map "==" 'ediff-meta-mark-equal-files)
- (define-key ediff-meta-buffer-map "=m" 'ediff-meta-mark-equal-files)
- (define-key ediff-meta-buffer-map "=h" 'ediff-meta-mark-equal-files)))
+ (unless (ediff-one-filegroup-metajob)
+ (define-key ediff-meta-buffer-map "=" nil)
+ (define-key ediff-meta-buffer-map "==" #'ediff-meta-mark-equal-files)
+ (define-key ediff-meta-buffer-map "=m" #'ediff-meta-mark-equal-files)
+ (define-key ediff-meta-buffer-map "=h" #'ediff-meta-mark-equal-files))
(define-key menu-map [ediff-next-meta-item]
@@ -430,7 +429,7 @@ Toggled by ediff-toggle-verbose-help-meta-buffer" )
(if ediff-no-emacs-help-in-control-buffer
- (define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item))
+ (define-key ediff-meta-buffer-map "\C-h" #'ediff-previous-meta-item))
(define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function)
(use-local-map ediff-meta-buffer-map)
@@ -621,7 +620,7 @@ behavior."
(setq common (ediff-intersection common lis3 #'string=)))
;; copying is needed because sort sorts via side effects
- (setq common (sort (ediff-copy-list common) 'string-lessp))
+ (setq common (sort (copy-sequence common) #'string-lessp))
;; compute difference list
(setq difflist (ediff-set-difference
@@ -632,8 +631,8 @@ behavior."
#'string=)
difflist (delete "." difflist)
;; copying is needed because sort sorts via side effects
- difflist (sort (ediff-copy-list (delete ".." difflist))
- 'string-lessp))
+ difflist (sort (copy-sequence (delete ".." difflist))
+ #'string-lessp))
(setq difflist (mapcar (lambda (elt) (cons elt 1)) difflist))
@@ -730,7 +729,7 @@ behavior."
)
;; copying is needed because sort sorts via side effects
- (setq common (sort (ediff-copy-list common) 'string-lessp))
+ (setq common (sort (copy-sequence common) #'string-lessp))
;; return result
(cons
@@ -837,14 +836,14 @@ behavior."
(ediff-draw-dir-diffs ediff-dir-difference-list))
(define-key
ediff-meta-buffer-map "h" 'ediff-mark-for-hiding-at-pos)
- (define-key ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions)
+ (define-key ediff-meta-buffer-map "x" #'ediff-hide-marked-sessions)
(define-key
- ediff-meta-buffer-map "m" 'ediff-mark-for-operation-at-pos)
+ ediff-meta-buffer-map "m" #'ediff-mark-for-operation-at-pos)
(define-key ediff-meta-buffer-map "u" nil)
(define-key
- ediff-meta-buffer-map "um" 'ediff-unmark-all-for-operation)
+ ediff-meta-buffer-map "um" #'ediff-unmark-all-for-operation)
(define-key
- ediff-meta-buffer-map "uh" 'ediff-unmark-all-for-hiding)
+ ediff-meta-buffer-map "uh" #'ediff-unmark-all-for-hiding)
(define-key ediff-meta-buffer-map
[menu-bar ediff-meta-mode ediff-hide-marked-sessions]
@@ -877,7 +876,7 @@ behavior."
'(menu-item "Collect diffs" ediff-collect-custom-diffs
:help "Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'"))
(define-key
- ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs))
+ ediff-meta-buffer-map "P" #'ediff-collect-custom-diffs))
((ediff-patch-metajob jobname)
(define-key ediff-meta-buffer-map
[menu-bar ediff-meta-mode ediff-meta-show-patch]
@@ -885,8 +884,8 @@ behavior."
:help "Show the multi-file patch associated with this group session"))
(define-key
ediff-meta-buffer-map "P" 'ediff-meta-show-patch)))
- (define-key ediff-meta-buffer-map "^" 'ediff-up-meta-hierarchy)
- (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs)
+ (define-key ediff-meta-buffer-map "^" #'ediff-up-meta-hierarchy)
+ (define-key ediff-meta-buffer-map "D" #'ediff-show-dir-diffs)
(define-key ediff-meta-buffer-map
[menu-bar ediff-meta-mode ediff-up-meta-hierarchy]
@@ -2128,7 +2127,7 @@ all marked sessions must be active."
))
;;;###autoload
-(defalias 'eregistry 'ediff-show-registry)
+(defalias 'eregistry #'ediff-show-registry)
;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a
;; parent meta-buf
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 9909dcd5424..0cbea2c28d7 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -123,106 +123,106 @@ to invocation.")
(setq ediff-mode-map (make-sparse-keymap))
(suppress-keymap ediff-mode-map)
- (define-key ediff-mode-map [mouse-2] 'ediff-help-for-quick-help)
- (define-key ediff-mode-map "\C-m" 'ediff-help-for-quick-help)
+ (define-key ediff-mode-map [mouse-2] #'ediff-help-for-quick-help)
+ (define-key ediff-mode-map "\C-m" #'ediff-help-for-quick-help)
- (define-key ediff-mode-map "p" 'ediff-previous-difference)
- (define-key ediff-mode-map "\C-?" 'ediff-previous-difference)
- (define-key ediff-mode-map [delete] 'ediff-previous-difference)
+ (define-key ediff-mode-map "p" #'ediff-previous-difference)
+ (define-key ediff-mode-map "\C-?" #'ediff-previous-difference)
+ (define-key ediff-mode-map [delete] #'ediff-previous-difference)
(define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer
- 'ediff-previous-difference nil))
- (define-key ediff-mode-map [backspace] 'ediff-previous-difference)
- (define-key ediff-mode-map [?\S-\ ] 'ediff-previous-difference)
- (define-key ediff-mode-map "n" 'ediff-next-difference)
- (define-key ediff-mode-map " " 'ediff-next-difference)
- (define-key ediff-mode-map "j" 'ediff-jump-to-difference)
+ #'ediff-previous-difference nil))
+ (define-key ediff-mode-map [backspace] #'ediff-previous-difference)
+ (define-key ediff-mode-map [?\S-\ ] #'ediff-previous-difference)
+ (define-key ediff-mode-map "n" #'ediff-next-difference)
+ (define-key ediff-mode-map " " #'ediff-next-difference)
+ (define-key ediff-mode-map "j" #'ediff-jump-to-difference)
(define-key ediff-mode-map "g" nil)
- (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point)
- (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point)
- (define-key ediff-mode-map "q" 'ediff-quit)
- (define-key ediff-mode-map "D" 'ediff-show-diff-output)
- (define-key ediff-mode-map "z" 'ediff-suspend)
- (define-key ediff-mode-map "\C-l" 'ediff-recenter)
- (define-key ediff-mode-map "|" 'ediff-toggle-split)
- (define-key ediff-mode-map "h" 'ediff-toggle-hilit)
+ (define-key ediff-mode-map "ga" #'ediff-jump-to-difference-at-point)
+ (define-key ediff-mode-map "gb" #'ediff-jump-to-difference-at-point)
+ (define-key ediff-mode-map "q" #'ediff-quit)
+ (define-key ediff-mode-map "D" #'ediff-show-diff-output)
+ (define-key ediff-mode-map "z" #'ediff-suspend)
+ (define-key ediff-mode-map "\C-l" #'ediff-recenter)
+ (define-key ediff-mode-map "|" #'ediff-toggle-split)
+ (define-key ediff-mode-map "h" #'ediff-toggle-hilit)
(or ediff-word-mode
- (define-key ediff-mode-map "@" 'ediff-toggle-autorefine))
+ (define-key ediff-mode-map "@" #'ediff-toggle-autorefine))
(if ediff-narrow-job
- (define-key ediff-mode-map "%" 'ediff-toggle-narrow-region))
- (define-key ediff-mode-map "~" 'ediff-swap-buffers)
- (define-key ediff-mode-map "v" 'ediff-scroll-vertically)
- (define-key ediff-mode-map "\C-v" 'ediff-scroll-vertically)
- (define-key ediff-mode-map "^" 'ediff-scroll-vertically)
- (define-key ediff-mode-map "\M-v" 'ediff-scroll-vertically)
- (define-key ediff-mode-map "V" 'ediff-scroll-vertically)
- (define-key ediff-mode-map "<" 'ediff-scroll-horizontally)
- (define-key ediff-mode-map ">" 'ediff-scroll-horizontally)
- (define-key ediff-mode-map "i" 'ediff-status-info)
- (define-key ediff-mode-map "E" 'ediff-documentation)
- (define-key ediff-mode-map "?" 'ediff-toggle-help)
- (define-key ediff-mode-map "!" 'ediff-update-diffs)
- (define-key ediff-mode-map "M" 'ediff-show-current-session-meta-buffer)
- (define-key ediff-mode-map "R" 'ediff-show-registry)
+ (define-key ediff-mode-map "%" #'ediff-toggle-narrow-region))
+ (define-key ediff-mode-map "~" #'ediff-swap-buffers)
+ (define-key ediff-mode-map "v" #'ediff-scroll-vertically)
+ (define-key ediff-mode-map "\C-v" #'ediff-scroll-vertically)
+ (define-key ediff-mode-map "^" #'ediff-scroll-vertically)
+ (define-key ediff-mode-map "\M-v" #'ediff-scroll-vertically)
+ (define-key ediff-mode-map "V" #'ediff-scroll-vertically)
+ (define-key ediff-mode-map "<" #'ediff-scroll-horizontally)
+ (define-key ediff-mode-map ">" #'ediff-scroll-horizontally)
+ (define-key ediff-mode-map "i" #'ediff-status-info)
+ (define-key ediff-mode-map "E" #'ediff-documentation)
+ (define-key ediff-mode-map "?" #'ediff-toggle-help)
+ (define-key ediff-mode-map "!" #'ediff-update-diffs)
+ (define-key ediff-mode-map "M" #'ediff-show-current-session-meta-buffer)
+ (define-key ediff-mode-map "R" #'ediff-show-registry)
(or ediff-word-mode
- (define-key ediff-mode-map "*" 'ediff-make-or-kill-fine-diffs))
+ (define-key ediff-mode-map "*" #'ediff-make-or-kill-fine-diffs))
(define-key ediff-mode-map "a" nil)
(define-key ediff-mode-map "b" nil)
(define-key ediff-mode-map "r" nil)
(cond (ediff-merge-job
;; Will barf if no ancestor
- (define-key ediff-mode-map "/" 'ediff-toggle-show-ancestor)
+ (define-key ediff-mode-map "/" #'ediff-toggle-show-ancestor)
;; In merging, we allow only A->C and B->C copying.
- (define-key ediff-mode-map "a" 'ediff-copy-A-to-C)
- (define-key ediff-mode-map "b" 'ediff-copy-B-to-C)
- (define-key ediff-mode-map "r" 'ediff-restore-diff-in-merge-buffer)
- (define-key ediff-mode-map "s" 'ediff-shrink-window-C)
- (define-key ediff-mode-map "+" 'ediff-combine-diffs)
+ (define-key ediff-mode-map "a" #'ediff-copy-A-to-C)
+ (define-key ediff-mode-map "b" #'ediff-copy-B-to-C)
+ (define-key ediff-mode-map "r" #'ediff-restore-diff-in-merge-buffer)
+ (define-key ediff-mode-map "s" #'ediff-shrink-window-C)
+ (define-key ediff-mode-map "+" #'ediff-combine-diffs)
(define-key ediff-mode-map "$" nil)
- (define-key ediff-mode-map "$$" 'ediff-toggle-show-clashes-only)
- (define-key ediff-mode-map "$*" 'ediff-toggle-skip-changed-regions)
- (define-key ediff-mode-map "&" 'ediff-re-merge))
+ (define-key ediff-mode-map "$$" #'ediff-toggle-show-clashes-only)
+ (define-key ediff-mode-map "$*" #'ediff-toggle-skip-changed-regions)
+ (define-key ediff-mode-map "&" #'ediff-re-merge))
(ediff-3way-comparison-job
- (define-key ediff-mode-map "ab" 'ediff-copy-A-to-B)
- (define-key ediff-mode-map "ba" 'ediff-copy-B-to-A)
- (define-key ediff-mode-map "ac" 'ediff-copy-A-to-C)
- (define-key ediff-mode-map "bc" 'ediff-copy-B-to-C)
+ (define-key ediff-mode-map "ab" #'ediff-copy-A-to-B)
+ (define-key ediff-mode-map "ba" #'ediff-copy-B-to-A)
+ (define-key ediff-mode-map "ac" #'ediff-copy-A-to-C)
+ (define-key ediff-mode-map "bc" #'ediff-copy-B-to-C)
(define-key ediff-mode-map "c" nil)
- (define-key ediff-mode-map "ca" 'ediff-copy-C-to-A)
- (define-key ediff-mode-map "cb" 'ediff-copy-C-to-B)
- (define-key ediff-mode-map "ra" 'ediff-restore-diff)
- (define-key ediff-mode-map "rb" 'ediff-restore-diff)
- (define-key ediff-mode-map "rc" 'ediff-restore-diff)
- (define-key ediff-mode-map "C" 'ediff-toggle-read-only))
+ (define-key ediff-mode-map "ca" #'ediff-copy-C-to-A)
+ (define-key ediff-mode-map "cb" #'ediff-copy-C-to-B)
+ (define-key ediff-mode-map "ra" #'ediff-restore-diff)
+ (define-key ediff-mode-map "rb" #'ediff-restore-diff)
+ (define-key ediff-mode-map "rc" #'ediff-restore-diff)
+ (define-key ediff-mode-map "C" #'ediff-toggle-read-only))
(t ; 2-way comparison
- (define-key ediff-mode-map "a" 'ediff-copy-A-to-B)
- (define-key ediff-mode-map "b" 'ediff-copy-B-to-A)
- (define-key ediff-mode-map "ra" 'ediff-restore-diff)
- (define-key ediff-mode-map "rb" 'ediff-restore-diff))
+ (define-key ediff-mode-map "a" #'ediff-copy-A-to-B)
+ (define-key ediff-mode-map "b" #'ediff-copy-B-to-A)
+ (define-key ediff-mode-map "ra" #'ediff-restore-diff)
+ (define-key ediff-mode-map "rb" #'ediff-restore-diff))
) ; cond
- (define-key ediff-mode-map "G" 'ediff-submit-report)
+ (define-key ediff-mode-map "G" #'ediff-submit-report)
(define-key ediff-mode-map "#" nil)
- (define-key ediff-mode-map "#h" 'ediff-toggle-regexp-match)
- (define-key ediff-mode-map "#f" 'ediff-toggle-regexp-match)
- (define-key ediff-mode-map "#c" 'ediff-toggle-ignore-case)
+ (define-key ediff-mode-map "#h" #'ediff-toggle-regexp-match)
+ (define-key ediff-mode-map "#f" #'ediff-toggle-regexp-match)
+ (define-key ediff-mode-map "#c" #'ediff-toggle-ignore-case)
(or ediff-word-mode
- (define-key ediff-mode-map "##" 'ediff-toggle-skip-similar))
+ (define-key ediff-mode-map "##" #'ediff-toggle-skip-similar))
(define-key ediff-mode-map "o" nil)
- (define-key ediff-mode-map "A" 'ediff-toggle-read-only)
- (define-key ediff-mode-map "B" 'ediff-toggle-read-only)
+ (define-key ediff-mode-map "A" #'ediff-toggle-read-only)
+ (define-key ediff-mode-map "B" #'ediff-toggle-read-only)
(define-key ediff-mode-map "w" nil)
- (define-key ediff-mode-map "wa" 'ediff-save-buffer)
- (define-key ediff-mode-map "wb" 'ediff-save-buffer)
- (define-key ediff-mode-map "wd" 'ediff-save-buffer)
- (define-key ediff-mode-map "=" 'ediff-inferior-compare-regions)
+ (define-key ediff-mode-map "wa" #'ediff-save-buffer)
+ (define-key ediff-mode-map "wb" #'ediff-save-buffer)
+ (define-key ediff-mode-map "wd" #'ediff-save-buffer)
+ (define-key ediff-mode-map "=" #'ediff-inferior-compare-regions)
(if (and (fboundp 'ediff-show-patch-diagnostics) (ediff-patch-job))
- (define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics))
+ (define-key ediff-mode-map "P" #'ediff-show-patch-diagnostics))
(if ediff-3way-job
(progn
- (define-key ediff-mode-map "wc" 'ediff-save-buffer)
- (define-key ediff-mode-map "gc" 'ediff-jump-to-difference-at-point)
+ (define-key ediff-mode-map "wc" #'ediff-save-buffer)
+ (define-key ediff-mode-map "gc" #'ediff-jump-to-difference-at-point)
))
- (define-key ediff-mode-map "m" 'ediff-toggle-wide-display)
+ (define-key ediff-mode-map "m" #'ediff-toggle-wide-display)
;; Allow ediff-mode-map to be referenced indirectly
(fset 'ediff-mode-map ediff-mode-map)
@@ -563,8 +563,9 @@ to invocation.")
(set-visited-file-name merge-buffer-file))))
(ediff-with-current-buffer ediff-buffer-C
(setq buffer-offer-save t) ; ask before killing buffer
- ;; make sure the contents is auto-saved
- (auto-save-mode 1))
+ (when make-backup-files
+ ;; make sure the contents is auto-saved
+ (auto-save-mode 1)))
))
@@ -2002,9 +2003,8 @@ ARG is a prefix argument. If nil, copy the current difference region."
(goto-char reg-to-delete-end)
(insert reg-to-copy)
- (if (> reg-to-delete-end reg-to-delete-beg)
- (kill-region reg-to-delete-beg reg-to-delete-end))
- ))
+ (when (> reg-to-delete-end reg-to-delete-beg)
+ (delete-region reg-to-delete-beg reg-to-delete-end))))
(or batch-invocation
(setq
messg
@@ -2105,8 +2105,8 @@ ARG is a prefix argument. If nil, copy the current difference region."
(goto-char reg-end)
(insert saved-diff)
- (if (> reg-end reg-beg)
- (kill-region reg-beg reg-end))
+ (when (> reg-end reg-beg)
+ (delete-region reg-beg reg-end))
(setq recovered t)
))
@@ -4188,12 +4188,7 @@ Mail anyway? (y or n) ")
(cdr result)))
(define-obsolete-function-alias 'ediff-add-to-history #'add-to-history "27.1")
-
-(defalias 'ediff-copy-list 'copy-sequence)
-
-
-;; don't report error if version control package wasn't found
-;;(ediff-load-version-control 'silent)
+(define-obsolete-function-alias 'ediff-copy-list #'copy-sequence "28.1")
(run-hooks 'ediff-load-hook)
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index 13a653b270b..9e82392725d 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -24,23 +24,9 @@
;;; Code:
-;; Compiler pacifier
-(defvar rcs-default-co-switches)
+(eval-when-compile (require 'ediff-init))
-(and noninteractive
- (eval-when-compile
- (condition-case nil
- ;; for compatibility with current stable version of xemacs
- (progn
- ;;(require 'pcvs nil 'noerror)
- ;;(require 'rcs nil 'noerror)
- (require 'pcvs)
- (require 'rcs))
- (error nil))
- (require 'vc)
- (require 'ediff-init)
- ))
-;; end pacifier
+(defvar rcs-default-co-switches)
(defcustom ediff-keep-tmp-versions nil
"If t, do not delete temporary previous versions for the files on which
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 47ef37a19ee..7c90348b5d4 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -400,7 +400,8 @@ keyboard input to go into icons."
;; skip dedicated and unsplittable frames
(ediff-destroy-control-frame control-buffer)
(let ((window-min-height 1)
- split-window-function wind-width-or-height
+ (window-combination-resize t)
+ split-window-function
three-way-comparison
wind-A-start wind-B-start wind-A wind-B wind-C)
(with-current-buffer control-buffer
@@ -419,22 +420,12 @@ keyboard input to go into icons."
(select-window (next-window nil 'ignore-minibuf)))
(delete-other-windows)
(set-window-dedicated-p (selected-window) nil)
- (split-window-vertically)
- (ediff-select-lowest-window)
- (ediff-setup-control-buffer control-buffer)
;; go to the upper window and split it betw A, B, and possibly C
(other-window 1)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
- (if three-way-comparison
- (setq wind-width-or-height
- (/ (if (eq split-window-function #'split-window-vertically)
- (window-height wind-A)
- (window-width wind-A))
- 3)))
-
- (funcall split-window-function wind-width-or-height)
+ (funcall split-window-function)
(if (eq (selected-window) wind-A)
(other-window 1))
@@ -443,7 +434,7 @@ keyboard input to go into icons."
(if three-way-comparison
(progn
- (funcall split-window-function) ; equally
+ (funcall split-window-function)
(if (eq (selected-window) wind-B)
(other-window 1))
(switch-to-buffer buf-C)
@@ -461,7 +452,9 @@ keyboard input to go into icons."
(set-window-start wind-A wind-A-start)
(set-window-start wind-B wind-B-start)))
- (ediff-select-lowest-window)
+ (select-window (display-buffer-in-direction
+ control-buffer
+ '((direction . bottom))))
(ediff-setup-control-buffer control-buffer)
))
@@ -746,6 +739,7 @@ keyboard input to go into icons."
(and (not (frame-live-p frame-A))
(or ctl-frame-exists-p
(eq frame-B (selected-frame))))))
+ (window-combination-resize t)
wind-A-start wind-B-start
designated-minibuffer-frame)
@@ -758,7 +752,7 @@ keyboard input to go into icons."
'B ediff-narrow-bounds))))
(if use-same-frame
- (let (wind-width-or-height) ; this affects 3way setups only
+ (progn
(if (and (eq frame-A frame-B) (frame-live-p frame-A))
(select-frame frame-A)
;; avoid dedicated and non-splittable windows
@@ -767,15 +761,7 @@ keyboard input to go into icons."
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
- (if three-way-comparison
- (setq wind-width-or-height
- (/
- (if (eq split-window-function #'split-window-vertically)
- (window-height wind-A)
- (window-width wind-A))
- 3)))
-
- (funcall split-window-function wind-width-or-height)
+ (funcall split-window-function)
(if (eq (selected-window) wind-A)
(other-window 1))
(switch-to-buffer buf-B)
@@ -1043,8 +1029,8 @@ create a new splittable frame if none is found."
(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))))
- (frame-A-left (eval (cdr (assoc 'left frame-A-parameters))))
+ (frame-A-top (eval (cdr (assoc 'top frame-A-parameters)) t))
+ (frame-A-left (eval (cdr (assoc 'left frame-A-parameters)) t))
(frame-A-width (frame-width frame-A))
(ctl-frame ediff-control-frame)
horizontal-adjustment upward-adjustment
@@ -1105,7 +1091,7 @@ It assumes that it is called from within the control buffer."
(cw (frame-char-width frame-A))
(wd (- (/ (display-pixel-width) cw) 5)))
(setq ediff-wide-display-orig-parameters
- (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params)))))
+ (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params)) t)))
(cons 'width (cdr (assoc 'width frame-A-params))))
ediff-wide-display-frame frame-A)
(modify-frame-parameters
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index ed375738b47..3536cbf7381 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -264,7 +264,7 @@ arguments after setting up the Ediff buffers."
'ediff-files3))
;;;###autoload
-(defalias 'ediff3 'ediff-files3)
+(defalias 'ediff3 #'ediff-files3)
(defvar-local ediff--magic-file-name nil
"Name of file where buffer's content was saved.
@@ -359,7 +359,7 @@ has been saved (if not in `buffer-file-name')."
(declare-function diff-latest-backup-file "diff" (fn))
;;;###autoload
-(defalias 'ediff 'ediff-files)
+(defalias 'ediff #'ediff-files)
;;;###autoload
(defun ediff-current-file ()
@@ -442,7 +442,7 @@ symbol describing the Ediff job type; it defaults to
(ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name))
;;;###autoload
-(defalias 'ebuffers 'ediff-buffers)
+(defalias 'ebuffers #'ediff-buffers)
;;;###autoload
@@ -479,7 +479,7 @@ symbol describing the Ediff job type; it defaults to
(ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name))
;;;###autoload
-(defalias 'ebuffers3 'ediff-buffers3)
+(defalias 'ebuffers3 #'ediff-buffers3)
@@ -556,7 +556,7 @@ the same name in both. The third argument, REGEXP, is nil or a regular
expression; only file names that match the regexp are considered."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
- (default-regexp (eval ediff-default-filtering-regexp))
+ (default-regexp (eval ediff-default-filtering-regexp t))
f)
(list (setq f (read-directory-name
"Directory A to compare: " dir-A nil 'must-match))
@@ -570,14 +570,14 @@ expression; only file names that match the regexp are considered."
default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directories-internal
dir1 dir2 nil regexp #'ediff-files 'ediff-directories
))
;;;###autoload
-(defalias 'edirs 'ediff-directories)
+(defalias 'edirs #'ediff-directories)
;;;###autoload
@@ -587,7 +587,7 @@ 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."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
- (default-regexp (eval ediff-default-filtering-regexp))
+ (default-regexp (eval ediff-default-filtering-regexp t))
)
(list (read-directory-name
"Directory to compare with revision:" dir-A nil 'must-match)
@@ -596,14 +596,14 @@ names. Only the files that are under revision control are taken into account."
"Filter filenames through regular expression" default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directory-revisions-internal
- dir1 regexp 'ediff-revision 'ediff-directory-revisions
+ dir1 regexp #'ediff-revision 'ediff-directory-revisions
))
;;;###autoload
-(defalias 'edir-revisions 'ediff-directory-revisions)
+(defalias 'edir-revisions #'ediff-directory-revisions)
;;;###autoload
@@ -614,7 +614,7 @@ regular expression; only file names that match the regexp are considered."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
- (default-regexp (eval ediff-default-filtering-regexp))
+ (default-regexp (eval ediff-default-filtering-regexp t))
f)
(list (setq f (read-directory-name "Directory A to compare:" dir-A nil))
(setq f (read-directory-name "Directory B to compare:"
@@ -632,14 +632,14 @@ regular expression; only file names that match the regexp are considered."
default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directories-internal
dir1 dir2 dir3 regexp #'ediff-files3 'ediff-directories3
))
;;;###autoload
-(defalias 'edirs3 'ediff-directories3)
+(defalias 'edirs3 #'ediff-directories3)
;;;###autoload
(defun ediff-merge-directories (dir1 dir2 regexp &optional merge-autostore-dir)
@@ -649,7 +649,7 @@ 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))
+ (default-regexp (eval ediff-default-filtering-regexp t))
f)
(list (setq f (read-directory-name "Directory A to merge:"
dir-A nil 'must-match))
@@ -663,7 +663,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directories-internal
dir1 dir2 nil regexp #'ediff-merge-files 'ediff-merge-directories
@@ -671,7 +671,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
))
;;;###autoload
-(defalias 'edirs-merge 'ediff-merge-directories)
+(defalias 'edirs-merge #'ediff-merge-directories)
;;;###autoload
(defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp
@@ -685,7 +685,7 @@ 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))
+ (default-regexp (eval ediff-default-filtering-regexp t))
f)
(list (setq f (read-directory-name "Directory A to merge:" dir-A nil))
(setq f (read-directory-name "Directory B to merge:"
@@ -703,7 +703,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directories-internal
dir1 dir2 ancestor-dir regexp
@@ -720,7 +720,7 @@ 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))
+ (default-regexp (eval ediff-default-filtering-regexp t))
)
(list (read-directory-name
"Directory to merge with revisions:" dir-A nil 'must-match)
@@ -729,15 +729,15 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directory-revisions-internal
- dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions
+ dir1 regexp #'ediff-merge-revisions 'ediff-merge-directory-revisions
nil merge-autostore-dir
))
;;;###autoload
-(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions)
+(defalias 'edir-merge-revisions #'ediff-merge-directory-revisions)
;;;###autoload
(defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp
@@ -749,7 +749,7 @@ 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))
+ (default-regexp (eval ediff-default-filtering-regexp t))
)
(list (read-directory-name
"Directory to merge with revisions and ancestors:"
@@ -759,10 +759,10 @@ MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
default-regexp)
nil
'ediff-filtering-regexp-history
- (eval ediff-default-filtering-regexp))
+ (eval ediff-default-filtering-regexp t))
)))
(ediff-directory-revisions-internal
- dir1 regexp 'ediff-merge-revisions-with-ancestor
+ dir1 regexp #'ediff-merge-revisions-with-ancestor
'ediff-merge-directory-revisions-with-ancestor
nil merge-autostore-dir
))
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index d2d419ac786..8f7affeea4e 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -79,90 +79,75 @@ but can be invoked directly in `fast' mode."
;; way they number lines of a file.
(defcustom emerge-diff-program "diff"
"Name of the program which compares two files."
- :type 'string
- :group 'emerge)
+ :type 'string)
(defcustom emerge-diff3-program "diff3"
"Name of the program which compares three files.
Its arguments are the ancestor file and the two variant files."
- :type 'string
- :group 'emerge)
+ :type 'string)
(defcustom emerge-diff-options ""
"Options to pass to `emerge-diff-program' and `emerge-diff3-program'."
- :type 'string
- :group 'emerge)
+ :type 'string)
(defcustom emerge-match-diff-line
(let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
(concat "^" x "\\([acd]\\)" x "$"))
"Pattern to match lines produced by diff that describe differences.
This is as opposed to lines from the source files."
- :type 'regexp
- :group 'emerge)
+ :type 'regexp)
(defcustom emerge-diff-ok-lines-regexp
"^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)"
"Regexp that matches normal output lines from `emerge-diff-program'.
Lines that do not match are assumed to be error messages."
- :type 'regexp
- :group 'emerge)
+ :type 'regexp)
(defcustom emerge-diff3-ok-lines-regexp
"^\\([1-3]:\\|====\\| \\)"
"Regexp that matches normal output lines from `emerge-diff3-program'.
Lines that do not match are assumed to be error messages."
- :type 'regexp
- :group 'emerge)
+ :type 'regexp)
(defcustom emerge-rcs-ci-program "ci"
"Name of the program that checks in RCS revisions."
- :type 'string
- :group 'emerge)
+ :type 'string)
(defcustom emerge-rcs-co-program "co"
"Name of the program that checks out RCS revisions."
- :type 'string
- :group 'emerge)
+ :type 'string)
(defcustom emerge-process-local-variables nil
"Non-nil if Emerge should process local-variables lists in merge buffers.
\(You can explicitly request processing the local-variables
by executing `(hack-local-variables)'.)"
- :type 'boolean
- :group 'emerge)
+ :type 'boolean)
(defcustom emerge-execute-line-deletions nil
"If non-nil: `emerge-execute-line' makes no output if an input was deleted.
It concludes that an input version has been deleted when an ancestor entry
is present, only one A or B entry is present, and an output entry is present.
If nil: In such circumstances, the A or B file that is present will be
copied to the designated output file."
- :type 'boolean
- :group 'emerge)
+ :type 'boolean)
(defcustom emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n"
"Flag placed above the highlighted block of code. Must end with newline.
Must be set before Emerge is loaded, or emerge-new-flags must be run
after setting."
- :type 'string
- :group 'emerge)
+ :type 'string)
(defcustom emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n"
"Flag placed below the highlighted block of code. Must end with newline.
Must be set before Emerge is loaded, or emerge-new-flags must be run
after setting."
- :type 'string
- :group 'emerge)
+ :type 'string)
;; Hook variables
(defcustom emerge-startup-hook nil
"Hook to run in the merge buffer after the merge has been set up."
- :type 'hook
- :group 'emerge)
+ :type 'hook)
(defcustom emerge-select-hook nil
"Hook to run after a difference has been selected.
The variable `n' holds the (internal) number of the difference."
- :type 'hook
- :group 'emerge)
+ :type 'hook)
(defcustom emerge-unselect-hook nil
"Hook to run after a difference has been unselected.
The variable `n' holds the (internal) number of the difference."
- :type 'hook
- :group 'emerge)
+ :type 'hook)
;; Variables to control the default directories of the arguments to
;; Emerge commands.
@@ -171,8 +156,7 @@ The variable `n' holds the (internal) number of the difference."
"If nil, default dir for filenames in emerge is `default-directory'.
If non-nil, filenames complete in the directory of the last argument of the
same type to an `emerge-files...' command."
- :type 'boolean
- :group 'emerge)
+ :type 'boolean)
(defvar emerge-last-dir-A nil
"Last directory for the first file of an `emerge-files...' command.")
@@ -235,15 +219,13 @@ depend on the flags."
(defcustom emerge-min-visible-lines 3
"Number of lines that we want to show above and below the flags when we are
displaying a difference."
- :type 'integer
- :group 'emerge)
+ :type 'integer)
(defcustom emerge-temp-file-prefix
(expand-file-name "emerge" temporary-file-directory)
"Prefix to put on Emerge temporary file names.
Do not start with `~/' or `~USERNAME/'."
- :type 'string
- :group 'emerge)
+ :type 'string)
(make-obsolete-variable 'emerge-temp-file-prefix
"customize `temporary-file-directory' instead."
@@ -251,8 +233,7 @@ Do not start with `~/' or `~USERNAME/'."
(defcustom emerge-temp-file-mode 384 ; u=rw only
"Mode for Emerge temporary files."
- :type 'integer
- :group 'emerge)
+ :type 'integer)
(make-obsolete-variable 'emerge-temp-file-mode
"it has no effect, temporary files are always private."
@@ -268,8 +249,7 @@ The template is inserted as a string, with the following interpolations:
Don't forget to end the template with a newline.
Note that this variable can be made local to a particular merge buffer by
giving a prefix argument to `emerge-set-combine-versions-template'."
- :type 'string
- :group 'emerge)
+ :type 'string)
;; Build keymaps
@@ -294,8 +274,7 @@ Makes Emerge commands directly available.")
(defcustom emerge-command-prefix "\C-c\C-c"
"Command prefix for Emerge commands in `edit' mode.
Must be set before Emerge is loaded."
- :type 'string
- :group 'emerge)
+ :type 'string)
;; This function sets up the fixed keymaps. It is executed when the first
;; Emerge is done to allow the user maximum time to set up the global keymap.
@@ -1245,8 +1224,7 @@ Otherwise, the A or B file present is copied to the output file."
(defcustom emerge-merge-directories-filename-regexp "[^.]"
"Regexp describing files to be processed by `emerge-merge-directories'."
- :type 'regexp
- :group 'emerge)
+ :type 'regexp)
;;;###autoload
(defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir)
@@ -3070,8 +3048,7 @@ See also `auto-save-file-name-p'."
(defcustom emerge-metachars nil
"No longer used. Emerge now uses `shell-quote-argument'."
- :type '(choice (const nil) regexp)
- :group 'emerge)
+ :type '(choice (const nil) regexp))
(make-obsolete-variable 'emerge-metachars nil "26.1")
(provide 'emerge)
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 56b31662210..46e9c97eb0a 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -191,7 +191,8 @@ when this variable is set to nil.")
(defconst log-edit-files-buf "*log-edit-files*")
(defvar log-edit-initial-files nil)
(defvar log-edit-callback nil)
-(defvar log-edit-diff-function nil)
+(defvar log-edit-diff-function
+ (lambda () (error "Diff functionality has not been setup")))
(defvar log-edit-listfun nil)
(defvar log-edit-parent-buffer nil)
@@ -202,13 +203,15 @@ when this variable is set to nil.")
;;; Originally taken from VC-Log mode
(defconst log-edit-maximum-comment-ring-size 32
- "Maximum number of saved comments in the comment ring.")
+ "Maximum number of saved commit comments in `log-edit-comment-ring'.")
(defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size))
(defvar log-edit-comment-ring-index nil)
(defvar log-edit-last-comment-match "")
(defun log-edit-new-comment-index (stride len)
- "Return the comment index STRIDE elements from the current one.
+ "Return the comment whose index is STRIDE elements away from the current one.
+This accesses `log-edit-comment-ring', which stores commit log comments,
+i.e. descriptions of changes done by commits.
LEN is the length of `log-edit-comment-ring'."
(mod (cond
(log-edit-comment-ring-index (+ log-edit-comment-ring-index stride))
@@ -220,7 +223,7 @@ LEN is the length of `log-edit-comment-ring'."
len))
(defun log-edit-previous-comment (arg)
- "Cycle backwards through comment history.
+ "Cycle backwards through VC commit comment history.
With a numeric prefix ARG, go back ARG comments."
(interactive "*p")
(let ((len (ring-length log-edit-comment-ring)))
@@ -233,15 +236,15 @@ With a numeric prefix ARG, go back ARG comments."
(insert (ring-ref log-edit-comment-ring log-edit-comment-ring-index)))))
(defun log-edit-next-comment (arg)
- "Cycle forwards through comment history.
+ "Cycle forwards through VC commit comment history.
With a numeric prefix ARG, go forward ARG comments."
(interactive "*p")
(log-edit-previous-comment (- arg)))
(defun log-edit-comment-search-backward (str &optional stride)
- "Search backwards through comment history for substring match of STR.
+ "Search backwards through VC commit comment history for a match of STR.
If the optional argument STRIDE is present, that is a step-width to use
-when going through the comment ring."
+when going through the comment ring, `log-edit-comment-ring'."
;; Why substring rather than regexp ? -sm
(interactive
(list (read-string (format-prompt "Comment substring"
@@ -261,7 +264,7 @@ when going through the comment ring."
(log-edit-previous-comment 0)))
(defun log-edit-comment-search-forward (str)
- "Search forwards through comment history for a substring match of STR."
+ "Search forwards through VC commit comment history for a match of STR."
(interactive
(list (read-string (format-prompt "Comment substring"
log-edit-last-comment-match)
@@ -269,10 +272,15 @@ when going through the comment ring."
(log-edit-comment-search-backward str -1))
(defun log-edit-comment-to-change-log (&optional whoami file-name)
- "Enter last VC comment into the change log for the current file.
-WHOAMI (interactive prefix) non-nil means prompt for user name
-and site. FILE-NAME is the name of the change log; if nil, use
-`change-log-default-name'.
+ "Insert the last VC commit comment into the change log for the current file.
+This reuses the text of the last VC commit comment in `log-edit-comment-ring'
+for the change-log entry of the current file, which is handy when several
+related changes have the same commit comment.
+WHOAMI (interactively, prefix argument) non-nil means prompt for user name
+and email address of the person to whom to attribute the change.
+FILE-NAME is the name of the change log; if nil, use `change-log-default-name'
+Interactively, with prefix argument, prompt for both the name and address of
+the person who did the change and for FILE-NAME.
This may be useful as a `vc-checkin-hook' to update change logs
automatically."
@@ -331,7 +339,7 @@ automatically."
(defconst log-edit-header-contents-regexp
"[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?"
- "Regular expression matching a header field.
+ "Regular expression matching the header field in `log-edit-mode'.
The first subexpression is the actual text of the field.")
(defun log-edit-match-to-eoh (_limit)
@@ -392,7 +400,9 @@ The first subexpression is the actual text of the field.")
(log-edit--match-first-line (0 'log-edit-summary))))
(defvar log-edit-font-lock-gnu-style nil
- "If non-nil, highlight common failures to follow the GNU coding standards.")
+ "If non-nil, highlight common failures to follow VC commit log conventions.
+The conventions checked are those described in the GNU coding standards
+document.")
(put 'log-edit-font-lock-gnu-style 'safe-local-variable 'booleanp)
(defconst log-edit-font-lock-gnu-keywords
@@ -435,28 +445,28 @@ The first subexpression is the actual text of the field.")
;;;###autoload
(defun log-edit (callback &optional setup params buffer mode &rest _ignore)
- "Setup a buffer to enter a log message.
-The buffer is put in mode MODE or `log-edit-mode' if MODE is nil.
+ "Setup a buffer to enter a VC commit log message.
+The buffer is put in mode MODE, or `log-edit-mode' if MODE is nil.
\\<log-edit-mode-map>
If SETUP is non-nil, erase the buffer and run `log-edit-hook'.
Set mark and point around the entire contents of the buffer, so
that it is easy to kill the contents of the buffer with
-\\[kill-region]. Once the user is done editing the message,
-invoking the command \\[log-edit-done] (`log-edit-done') will
-call CALLBACK to do the actual commit.
+\\[kill-region]. Once the user is done editing the message, he
+or she is expected to invoke the command \\[log-edit-done] (`log-edit-done'),
+which will call CALLBACK, a function to do the actual commit.
-PARAMS if non-nil is an alist of variables and buffer-local
-values to give them in the Log Edit buffer. Possible keys and
-associated values:
+PARAMS, if non-nil, is an alist of variables and buffer-local
+values to give to those variables in the Log Edit buffer. Possible
+keys and associated values are:
`log-edit-listfun' -- function taking no arguments that returns the list of
- files that are concerned by the current operation (using relative names);
+ files that are concerned by the current operation (using relative names);
`log-edit-diff-function' -- function taking no arguments that
- displays a diff of the files concerned by the current operation.
+ displays a diff of the files concerned by the current operation.
`vc-log-fileset' -- the VC fileset to be committed (if any).
-If BUFFER is non-nil `log-edit' will jump to that buffer, use it
+If BUFFER is non-nil, `log-edit' will switch to that buffer, use it
to edit the log message and go back to the current buffer when
-done. Otherwise, it uses the current buffer."
+done. Otherwise, this function will use the current buffer."
(let ((parent (current-buffer)))
(if buffer (pop-to-buffer buffer))
(when (and log-edit-setup-invert (not (eq setup 'force)))
@@ -482,12 +492,12 @@ done. Otherwise, it uses the current buffer."
"Press \\[log-edit-done] when you are done editing."))))
(define-derived-mode log-edit-mode text-mode "Log-Edit"
- "Major mode for editing version-control log messages.
-When done editing the log entry, just type \\[log-edit-done] which
-will trigger the actual commit of the file(s).
-Several other handy support commands are provided of course and
-the package from which this is used might also provide additional
-commands (under C-x v for VC, for example).
+ "Major mode for editing version-control (VC) commit log messages.
+When done editing the log entry, type \\[log-edit-done], which will
+trigger the actual commit of the file(s).
+Several other handy support commands are provided, and the package
+from which this is used might also provide additional commands (under
+the \"C-x v\" prefix for VC commands, for example).
\\{log-edit-mode-map}"
(setq-local font-lock-defaults '(log-edit-font-lock-keywords t))
@@ -519,7 +529,7 @@ commands (under C-x v for VC, for example).
(insert "):")))
(defun log-edit-fill-entry (&optional justify)
- "Like \\[fill-paragraph], but handle ChangeLog entries.
+ "Like \\[fill-paragraph], but for filling ChangeLog-formatted entries.
Consecutive function entries without prose (i.e., lines of the
form \"(FUNCTION):\") will be combined into \"(FUNC1, FUNC2):\"
according to `fill-column'."
@@ -569,7 +579,7 @@ according to `fill-column'."
(ring-insert log-edit-comment-ring comment)))
(defun log-edit-done ()
- "Finish editing the log message and commit the files.
+ "Finish editing the VC commit log message, and commit the files.
If you want to abort the commit, simply delete the buffer."
(interactive)
;; Clean up empty headers.
@@ -616,9 +626,9 @@ If you want to abort the commit, simply delete the buffer."
(call-interactively log-edit-callback))))
(defun log-edit-kill-buffer ()
- "Kill the current buffer.
-Also saves its contents in the comment history and hides
-`log-edit-files-buf'."
+ "Kill the current VC commit log buffer.
+This command saves the contents of the log buffer in the VC commit
+comment history, see `log-edit-comment-ring', and hides `log-edit-files-buf'."
(interactive)
(log-edit-hide-buf)
(let ((buf (current-buffer)))
@@ -659,9 +669,7 @@ Also saves its contents in the comment history and hides
(defun log-edit-show-diff ()
"Show the diff for the files to be committed."
(interactive)
- (if (functionp log-edit-diff-function)
- (funcall log-edit-diff-function)
- (error "Diff functionality has not been setup")))
+ (funcall log-edit-diff-function))
(defun log-edit-show-files ()
"Show the list of files to be committed."
@@ -700,7 +708,7 @@ different header separator appropriate for `log-edit-mode'."
(eobp))))
(defun log-edit-insert-message-template ()
- "Insert the default template with Summary and Author."
+ "Insert the default VC commit log template with Summary and Author."
(interactive)
(when (or (called-interactively-p 'interactive)
(log-edit-empty-buffer-p))
@@ -711,7 +719,7 @@ different header separator appropriate for `log-edit-mode'."
(message-position-point)))
(defun log-edit-insert-cvs-template ()
- "Insert the template specified by the CVS administrator, if any.
+ "Insert the commit log template specified by the CVS administrator, if any.
This simply uses the local CVS/Template file."
(interactive)
(when (or (called-interactively-p 'interactive)
@@ -723,7 +731,7 @@ This simply uses the local CVS/Template file."
(insert-file-contents "CVS/Template"))))
(defun log-edit-insert-cvs-rcstemplate ()
- "Insert the rcstemplate from the CVS repository.
+ "Insert the RCS commit log template from the CVS repository.
This contacts the repository to get the rcstemplate file and
can thus take some time."
(interactive)
@@ -757,7 +765,7 @@ can thus take some time."
(insert (mapconcat 'identity files ", ") ": "))))
(defun log-edit-add-to-changelog ()
- "Insert this log message into the appropriate ChangeLog file."
+ "Insert this VC commit log message into the appropriate ChangeLog file."
(interactive)
(log-edit-remember-comment)
(dolist (f (log-edit-files))
@@ -771,7 +779,7 @@ can thus take some time."
"Non-nil means rewrite (tiny change).")
(defvar log-edit-rewrite-fixes nil
- "Rule to rewrite bug numbers into Fixes: headers.
+ "Rule to rewrite bug numbers into Fixes: headers in commit log messages.
The value should be of the form (REGEXP . REPLACEMENT)
where REGEXP should match the expression referring to a bug number
in the text, and REPLACEMENT is an expression to pass to `replace-match'
@@ -789,10 +797,15 @@ to build the Fixes: header.")
(declare-function diff-add-log-current-defuns "diff-mode" ())
(defun log-edit-generate-changelog-from-diff ()
- "Insert a log message by looking at the current diff.
-This command will generate a ChangeLog entries listing the
-functions. You can then add a description where needed, and use
-\\[fill-paragraph] to join consecutive function names."
+ "Insert a VC commit log message by looking at the current diffs.
+This command is intended to be used in the \"*vc-log*\" buffer.
+This command will generate ChangeLog entries listing the modified
+files and functions changed in those files, based on the diffs
+you are about to commit. You can then add a description for each
+change where needed, and use \\[fill-paragraph] to join consecutive function
+names into a single entry where they all share the same description.
+Should you need to look at the diffs themselves, they can be found
+in the \"*vc-diff*\" buffer produced by this command."
(interactive)
(change-log-insert-entries
(with-current-buffer
@@ -810,21 +823,21 @@ functions. You can then add a description where needed, and use
(diff-add-log-current-defuns))))
(defun log-edit-insert-changelog (&optional use-first)
- "Insert a log message by looking at the ChangeLog.
+ "Insert a VC commit log message by looking at the ChangeLog.
The idea is to write your ChangeLog entries first, and then use this
-command to commit your changes.
+command to commit your changes with that log.
-To select default log text, we:
-- find the ChangeLog entries for the files to be checked in,
-- verify that the top entry in the ChangeLog is on the current date
- and by the current user; if not, we don't provide any default text,
-- search the ChangeLog entry for paragraphs containing the names of
- the files we're checking in, and finally
-- use those paragraphs as the log text.
+To select default log text, this command:
+- finds the ChangeLog entries for the files to be checked in;
+- verifies that the top entry in the ChangeLog is on the current date
+ and by the current user; if not, it doesn't provide any default text;
+- searches the ChangeLog entry for paragraphs containing the names of
+ the files to be checked in; and finally
+- uses those paragraphs as the log text.
If the optional prefix arg USE-FIRST is given (via \\[universal-argument]),
-or if the command is repeated a second time in a row, use the first log entry
-regardless of user name or time."
+or if the command is repeated, use the first log entry regardless of user
+name or time."
(interactive "P")
(save-excursion
(let ((eoh (save-excursion (rfc822-goto-eoh) (point))))
@@ -874,7 +887,7 @@ regardless of user name or time."
;;;;
(defun log-edit-narrow-changelog ()
- "Narrow to the top page of the current buffer, a ChangeLog file.
+ "Narrow to the top page of the current buffer, which visits a ChangeLog file.
Actually, the narrowed region doesn't include the date line.
A \"page\" in a ChangeLog file is the area between two dates."
(or (eq major-mode 'change-log-mode)
@@ -922,7 +935,7 @@ If we are between sub-paragraphs, return the previous subparagraph."
(defun log-edit-changelog-entry ()
"Return the bounds of the ChangeLog entry containing point.
-The variable `log-edit-changelog-full-paragraphs' decides whether an
+The variable `log-edit-changelog-full-paragraphs' determines whether an
\"entry\" is a paragraph or a subparagraph; see its documentation string
for more details."
(save-excursion
@@ -961,8 +974,8 @@ Return non-nil if it is."
(not (looking-at (format ".+ .+ <%s>"
(regexp-quote mail))))
(looking-at ".+ \\(.+ <.+>\\) *\\((tiny change)\\)?"))
- (let ((author (replace-regexp-in-string " " " "
- (match-string 1))))
+ (let ((author (string-replace " " " "
+ (match-string 1))))
(unless (and log-edit-author
(string-match (regexp-quote author)
(car log-edit-author)))
@@ -1048,8 +1061,12 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
"\\($\\|[^[:alnum:]]\\)")))))
(defun log-edit-changelog-insert-entries (buffer beg end &rest files)
- "Insert the text from BUFFER between BEG and END.
-Rename relative filenames in the ChangeLog entry as FILES."
+ "Insert the text from ChangeLog BUFFER between BEG and END.
+Rename relative filenames in the ChangeLog entry with FILES.
+FILES are supposed to name the same files whose relative filenames
+are to be replaced, and their names relative to the directory of
+BUFFER are expected to match the relative file names in the ChangeLog
+entry."
(let ((opoint (point))
(log-name (buffer-file-name buffer))
(case-fold-search nil)
@@ -1131,7 +1148,7 @@ Return t if toggled on (or TOGGLE is nil), otherwise nil."
val))
(defun log-edit-extract-headers (headers comment)
- "Extract headers from COMMENT to form command line arguments.
+ "Extract headers from VC commit COMMENT to form command line arguments.
HEADERS should be an alist with elements (HEADER . CMDARG)
or (HEADER . FUNCTION) associating headers to command line
options and the result is then a list of the form (MSG ARGUMENTS...)
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index 2ee3da70274..54ef06960f9 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -1,4 +1,4 @@
-;;; pcvs-defs.el --- variable definitions for PCL-CVS
+;;; pcvs-defs.el --- variable definitions for PCL-CVS -*- lexical-binding: t; -*-
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
@@ -71,7 +71,6 @@ versions, such as the one in SunOS-4.")
(defcustom cvs-cvsrc-file (convert-standard-filename "~/.cvsrc")
"Path to your cvsrc file."
- :group 'pcl-cvs
:type '(file))
(defvar cvs-shared-start 4
@@ -96,24 +95,20 @@ If t, they will be removed from the *cvs* buffer after every command.
If `delayed', they will be removed from the *cvs* buffer before every command.
If `status', they will only be removed after a `cvs-mode-status' command.
Else, they will never be automatically removed from the *cvs* buffer."
- :group 'pcl-cvs
:type '(choice (const nil) (const status) (const delayed) (const t)))
(defcustom cvs-auto-remove-directories 'handled
"If `all', directory entries will never be shown.
If `handled', only non-handled directories will be shown.
If `empty', only non-empty directories will be shown."
- :group 'pcl-cvs
:type '(choice (const :tag "No" nil) (const all) (const handled) (const empty)))
(defcustom cvs-auto-revert t
"Non-nil if changed files should automatically be reverted."
- :group 'pcl-cvs
:type '(boolean))
(defcustom cvs-sort-ignore-file t
"Non-nil if `cvs-mode-ignore' should sort the .cvsignore automatically."
- :group 'pcl-cvs
:type '(boolean))
(defcustom cvs-force-dir-tag t
@@ -121,7 +116,6 @@ If `empty', only non-empty directories will be shown."
Tagging should generally be applied a directory at a time, but sometimes it is
useful to be able to tag a single file. The normal way to do that is to use
`cvs-mode-force-command' so as to temporarily override the restrictions."
- :group 'pcl-cvs
:type '(boolean))
(defcustom cvs-default-ignore-marks nil
@@ -130,7 +124,6 @@ Normally they run on the files that are marked (with `cvs-mode-mark'),
or the file under the cursor if no files are marked. If this variable
is set to a non-nil value they will by default run on the file on the
current line. See also `cvs-invert-ignore-marks'."
- :group 'pcl-cvs
:type '(boolean))
(defcustom cvs-invert-ignore-marks
@@ -143,7 +136,6 @@ current line. See also `cvs-invert-ignore-marks'."
"List of cvs commands that invert the default ignore-mark behavior.
Commands in this set will use the opposite default from the one set
in `cvs-default-ignore-marks'."
- :group 'pcl-cvs
:type '(set (const "diff")
(const "tag")
(const "ignore")))
@@ -154,7 +146,6 @@ Non-nil means that PCL-CVS will ask confirmation before removing files
except for files whose content can readily be recovered from the repository.
A value of `list' means that the list of files to be deleted will be
displayed when asking for confirmation."
- :group 'pcl-cvs
:type '(choice (const list)
(const t)
(const nil)))
@@ -162,7 +153,6 @@ displayed when asking for confirmation."
(defcustom cvs-add-default-message nil
"Default message to use when adding files.
If set to nil, `cvs-mode-add' will always prompt for a message."
- :group 'pcl-cvs
:type '(choice (const :tag "Prompt" nil)
(string)))
@@ -171,7 +161,6 @@ If set to nil, `cvs-mode-add' will always prompt for a message."
If non-nil, `cvs-mode-find-file' will place the cursor at the beginning of
the modified area. If the file is not locally modified, this will obviously
have no effect."
- :group 'pcl-cvs
:type '(boolean))
(defcustom cvs-buffer-name-alist
@@ -193,7 +182,6 @@ POSTPROC is a function that should be executed when the command terminates
The CMD used for `cvs-mode-commit' is \"message\". For that special
case, POSTPROC is called just after MODE with special arguments."
- :group 'pcl-cvs
:type '(repeat
(list (choice (const "diff")
(const "status")
@@ -236,7 +224,6 @@ Output from cvs is placed here for asynchronous commands.")
'(cvs-ediff-diff . cvs-ediff-merge)
'(cvs-emerge-diff . cvs-emerge-merge))
"Pair of functions to be used for resp. diff'ing and merg'ing interactively."
- :group 'pcl-cvs
:type '(choice (const :tag "Ediff" (cvs-ediff-diff . cvs-ediff-merge))
(const :tag "Emerge" (cvs-emerge-diff . cvs-emerge-merge))))
@@ -255,7 +242,6 @@ Alternatives are:
`samedir': reuse any cvs buffer displaying the same directory
`subdir': or reuse any cvs buffer displaying any sub- or super- directory
`always': reuse any cvs buffer."
- :group 'pcl-cvs
:type '(choice (const always) (const subdir) (const samedir) (const current)))
(defvar cvs-temp-buffer nil
@@ -424,8 +410,7 @@ This variable is buffer local and only used in the *cvs* buffer.")
(defcustom cvs-minor-mode-prefix "\C-xc"
"Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'."
- :type 'string
- :group 'pcl-cvs)
+ :type 'string)
(easy-mmode-defmap cvs-minor-mode-map
`((,cvs-minor-mode-prefix . cvs-mode-map)
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index e1197176af2..21fe98dacab 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -1,4 +1,4 @@
-;;; pcvs-info.el --- internal representation of a fileinfo entry
+;;; pcvs-info.el --- internal representation of a fileinfo entry -*- lexical-binding: t; -*-
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
@@ -384,8 +384,8 @@ For use by the ewoc package."
The ordering defined by this function is such that directories are
sorted alphabetically, and inside every directory the DIRCHANGE
fileinfo will appear first, followed by all files (alphabetically)."
- (let ((subtypea (cvs-fileinfo->subtype a))
- (subtypeb (cvs-fileinfo->subtype b)))
+ (let ( ;; (subtypea (cvs-fileinfo->subtype a))
+ ) ;; (subtypeb (cvs-fileinfo->subtype b))
(cond
;; Sort according to directories.
((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t)
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 43816501bda..3a96c930544 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -1,4 +1,4 @@
-;;; pcvs-parse.el --- the CVS output parser
+;;; pcvs-parse.el --- the CVS output parser -*- lexical-binding: t; -*-
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
@@ -73,12 +73,12 @@ by `$'."
'("status" "add" "commit" "update" "remove" "checkout" "ci")
"List of CVS commands whose output is understood by the parser.")
-(defun cvs-parse-buffer (parse-spec dont-change-disc &optional subdir)
+(defun cvs-parse-buffer (parse-spec dcd &optional subdir)
"Parse current buffer according to PARSE-SPEC.
PARSE-SPEC is a function of no argument advancing the point and returning
either a fileinfo or t (if the matched text should be ignored) or
nil if it didn't match anything.
-DONT-CHANGE-DISC just indicates whether the command was changing the disc
+DCD just indicates whether the command was changing the disc
or not (useful to tell the difference between `cvs-examine' and `cvs-update'
output.
The path names should be interpreted as relative to SUBDIR (defaults
@@ -86,6 +86,7 @@ The path names should be interpreted as relative to SUBDIR (defaults
Return a list of collected entries, or t if an error occurred."
(goto-char (point-min))
(let ((fileinfos ())
+ (dont-change-disc dcd)
(cvs-current-dir "")
(case-fold-search nil)
(cvs-current-subdir (or subdir "")))
@@ -134,12 +135,12 @@ Match RE and if successful, execute MATCHES."
(defmacro cvs-or (&rest alts)
"Try each one of the ALTS alternatives until one matches."
+ (declare (debug t))
`(let ((-cvs-parse-point (point)))
,(cons 'or
(mapcar (lambda (es)
`(or ,es (ignore (goto-char -cvs-parse-point))))
alts))))
-(def-edebug-spec cvs-or t)
;; This is how parser tables should be executed
(defun cvs-parse-run-table (parse-spec)
@@ -185,17 +186,20 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(let ((type (if (consp type) (car type) type))
(subtype (if (consp type) (cdr type))))
(when dir (setq cvs-current-dir dir))
- (apply 'cvs-create-fileinfo type
+ (apply #'cvs-create-fileinfo type
(concat cvs-current-subdir (or dir cvs-current-dir))
file (cvs-parse-msg) :subtype subtype keys))))
;;;; CVS Process Parser Tables:
-;;;;
-;;;; The table for status and update could actually be merged since they
-;;;; don't conflict. But they don't overlap much either.
+;;
+;; The table for status and update could actually be merged since they
+;; don't conflict. But they don't overlap much either.
(defun cvs-parse-table ()
"Table of message objects for `cvs-parse-process'."
+ (with-suppressed-warnings ((lexical c file dir path base-rev subtype))
+ (defvar c) (defvar file) (defvar dir) (defvar path) (defvar base-rev)
+ (defvar subtype))
(let (c file dir path base-rev subtype)
(cvs-or
@@ -401,6 +405,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(defun cvs-parse-merge ()
+ (with-suppressed-warnings ((lexical path base-rev head-rev type))
+ (defvar path) (defvar base-rev) (defvar head-rev) (defvar type))
(let (path base-rev head-rev type)
;; A merge (maybe with a conflict).
(and
@@ -445,6 +451,9 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
:merge (cons base-rev head-rev))))))
(defun cvs-parse-status ()
+ (with-suppressed-warnings ((lexical nofile path base-rev head-rev type))
+ (defvar nofile) (defvar path) (defvar base-rev) (defvar head-rev)
+ (defvar type))
(let (nofile path base-rev head-rev type)
(and
(cvs-match
@@ -493,6 +502,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
:head-rev head-rev))))
(defun cvs-parse-commit ()
+ (with-suppressed-warnings ((lexical path file base-rev subtype))
+ (defvar path) (defvar file) (defvar base-rev) (defvar subtype))
(let (path file base-rev subtype)
(cvs-or
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index 57da7bf730e..75d9fe9bee1 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -1,4 +1,4 @@
-;;; pcvs-util.el --- utility functions for PCL-CVS
+;;; pcvs-util.el --- utility functions for PCL-CVS -*- lexical-binding: t; -*-
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
@@ -33,27 +33,9 @@
;;;;
(defsubst cvs-car (x) (if (consp x) (car x) x))
-(defalias 'cvs-cdr 'cdr-safe)
+(defalias 'cvs-cdr #'cdr-safe)
(defsubst cvs-append (&rest xs)
- (apply 'append (mapcar (lambda (x) (if (listp x) x (list x))) xs)))
-
-(defsubst cvs-every (-cvs-every-f -cvs-every-l)
- (while (consp -cvs-every-l)
- (unless (funcall -cvs-every-f (pop -cvs-every-l))
- (setq -cvs-every-l t)))
- (not -cvs-every-l))
-
-(defun cvs-union (xs ys)
- (let ((zs ys))
- (dolist (x xs zs)
- (unless (member x ys) (push x zs)))))
-
-(defun cvs-map (-cvs-map-f &rest -cvs-map-ls)
- (let ((accum ()))
- (while (not (cvs-every 'null -cvs-map-ls))
- (push (apply -cvs-map-f (mapcar 'car -cvs-map-ls)) accum)
- (setq -cvs-map-ls (mapcar 'cdr -cvs-map-ls)))
- (nreverse accum)))
+ (apply #'append (mapcar (lambda (x) (if (listp x) x (list x))) xs)))
(defun cvs-first (l &optional n)
(if (null n) (car l)
@@ -146,7 +128,7 @@ If NOREUSE is non-nil, always return a new buffer."
"Insert a list of STRINGS into the current buffer.
Uses columns to keep the listing readable but compact."
(when (consp strings)
- (let* ((length (apply 'max (mapcar 'length strings)))
+ (let* ((length (apply #'max (mapcar #'length strings)))
(wwidth (1- (window-width)))
(columns (min
;; At least 2 columns; at least 2 spaces between columns.
@@ -174,7 +156,7 @@ arguments. If ARGS is not a list, no argument will be passed."
(condition-case nil
(with-temp-buffer
(if args
- (apply 'call-process
+ (apply #'call-process
file nil t nil (when (listp args) args))
(insert-file-contents file))
(goto-char (point-min))
@@ -182,7 +164,7 @@ arguments. If ARGS is not a list, no argument will be passed."
(if oneline (line-end-position) (point-max))))
(file-error nil)))
-(define-obsolete-function-alias 'cvs-string-prefix-p 'string-prefix-p "24.3")
+(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3")
;;;;
;;;; file names
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 1a42c67cb1c..42f531e4f75 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -115,7 +115,7 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(require 'ewoc) ;Ewoc was once cookie
(require 'pcvs-defs)
(require 'pcvs-util)
@@ -331,7 +331,7 @@ the primary since reading the primary can deactivate it."
"This mode is used for buffers related to a main *cvs* buffer.
All the `cvs-mode' buffer operations are simply rebound under
the \\[cvs-mode-map] prefix."
- nil " CVS"
+ :lighter " CVS"
:group 'pcl-cvs)
(put 'cvs-minor-mode 'permanent-local t)
@@ -513,7 +513,7 @@ If non-nil, NEW means to create a new buffer no matter what."
(let* ((dir+files+rest
(if (or (null fis) (not single-dir))
;; not single-dir mode: just process the whole thing
- (list "" (mapcar 'cvs-fileinfo->full-name fis) nil)
+ (list "" (mapcar #'cvs-fileinfo->full-name fis) nil)
;; single-dir mode: extract the same-dir-elements
(let ((dir (cvs-fileinfo->dir (car fis))))
;; output the concerned dir so the parser can translate paths
@@ -2135,11 +2135,11 @@ Returns a list of FIS that should be `cvs remove'd."
(eq (cvs-fileinfo->type fi) 'UNKNOWN))
(cvs-mode-marked filter cmd))))
(silent (or (not cvs-confirm-removals)
- (cvs-every (lambda (fi)
- (or (not (file-exists-p
- (cvs-fileinfo->full-name fi)))
- (cvs-applicable-p fi 'safe-rm)))
- files)))
+ (cl-every (lambda (fi)
+ (or (not (file-exists-p
+ (cvs-fileinfo->full-name fi)))
+ (cvs-applicable-p fi 'safe-rm)))
+ files)))
(tmpbuf (cvs-temp-buffer)))
(when (and (not silent) (equal cvs-confirm-removals 'list))
(with-current-buffer tmpbuf
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index c66a4fb2d6a..956d9b38017 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -214,6 +214,9 @@ Used in `smerge-diff-base-upper' and related functions."
["Invoke Ediff" smerge-ediff
:help "Use Ediff to resolve the conflicts"
:active (smerge-check 1)]
+ ["Refine" smerge-refine
+ :help "Highlight different words of the conflict"
+ :active (smerge-check 1)]
["Auto Resolve" smerge-resolve
:help "Try auto-resolution heuristics"
:active (smerge-check 1)]
@@ -1450,30 +1453,31 @@ If no conflict maker is found, turn off `smerge-mode'."
First tries to go to the next conflict in the current buffer, and if not
found, uses VC to try and find the next file with conflict."
(interactive)
- (let ((buffer (current-buffer)))
- (condition-case nil
- ;; FIXME: Try again from BOB before moving to the next file.
- (smerge-next)
- (error
- (if (and (or smerge-change-buffer-confirm
- (and (buffer-modified-p) buffer-file-name))
- (not (or (eq last-command this-command)
- (eq ?\r last-command-event)))) ;Called via M-x!?
- ;; FIXME: Don't emit this message if `vc-find-conflicted-file' won't
- ;; go to another file anyway (because there are no more conflicted
- ;; files).
- (message (if (buffer-modified-p)
- "No more conflicts here. Repeat to save and go to next buffer"
- "No more conflicts here. Repeat to go to next buffer"))
- (if (and (buffer-modified-p) buffer-file-name)
- (save-buffer))
- (vc-find-conflicted-file)
- (if (eq buffer (current-buffer))
- ;; Do nothing: presumably `vc-find-conflicted-file' already
- ;; emitted a message explaining there aren't any more conflicts.
- nil
+ (condition-case nil
+ ;; FIXME: Try again from BOB before moving to the next file.
+ (smerge-next)
+ (error
+ (if (and (or smerge-change-buffer-confirm
+ (and (buffer-modified-p) buffer-file-name))
+ (not (or (eq last-command this-command)
+ (eq ?\r last-command-event)))) ;Called via M-x!?
+ ;; FIXME: Don't emit this message if `vc-find-conflicted-file' won't
+ ;; go to another file anyway (because there are no more conflicted
+ ;; files).
+ (message (if (buffer-modified-p)
+ "No more conflicts here. Repeat to save and go to next buffer"
+ "No more conflicts here. Repeat to go to next buffer"))
+ (if (and (buffer-modified-p) buffer-file-name)
+ (save-buffer))
+ (vc-find-conflicted-file)
+ ;; At this point, the caret will only be at a conflict marker
+ ;; if the file did not correspond to an opened
+ ;; buffer. Otherwise we need to jump to a marker explicitly.
+ (unless (looking-at "^<<<<<<<")
+ (let ((prev-pos (point)))
(goto-char (point-min))
- (smerge-next)))))))
+ (unless (ignore-errors (not (smerge-next)))
+ (goto-char prev-pos))))))))
(provide 'smerge-mode)
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index b0435ab53ee..07b2800c2dc 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -164,18 +164,18 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
(defvar vc-annotate-mode-map
(let ((m (make-sparse-keymap)))
- (define-key m "a" 'vc-annotate-revision-previous-to-line)
- (define-key m "d" 'vc-annotate-show-diff-revision-at-line)
- (define-key m "=" 'vc-annotate-show-diff-revision-at-line)
- (define-key m "D" 'vc-annotate-show-changeset-diff-revision-at-line)
- (define-key m "f" 'vc-annotate-find-revision-at-line)
- (define-key m "j" 'vc-annotate-revision-at-line)
- (define-key m "l" 'vc-annotate-show-log-revision-at-line)
- (define-key m "n" 'vc-annotate-next-revision)
- (define-key m "p" 'vc-annotate-prev-revision)
- (define-key m "w" 'vc-annotate-working-revision)
- (define-key m "v" 'vc-annotate-toggle-annotation-visibility)
- (define-key m "\C-m" 'vc-annotate-goto-line)
+ (define-key m "a" #'vc-annotate-revision-previous-to-line)
+ (define-key m "d" #'vc-annotate-show-diff-revision-at-line)
+ (define-key m "=" #'vc-annotate-show-diff-revision-at-line)
+ (define-key m "D" #'vc-annotate-show-changeset-diff-revision-at-line)
+ (define-key m "f" #'vc-annotate-find-revision-at-line)
+ (define-key m "j" #'vc-annotate-revision-at-line)
+ (define-key m "l" #'vc-annotate-show-log-revision-at-line)
+ (define-key m "n" #'vc-annotate-next-revision)
+ (define-key m "p" #'vc-annotate-prev-revision)
+ (define-key m "w" #'vc-annotate-working-revision)
+ (define-key m "v" #'vc-annotate-toggle-annotation-visibility)
+ (define-key m "\C-m" #'vc-annotate-goto-line)
m)
"Local keymap used for VC-Annotate mode.")
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index c495afb6ec5..5144b5d0bbb 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -45,9 +45,9 @@
;;; Code:
+(require 'vc-dispatcher)
(eval-when-compile
(require 'cl-lib)
- (require 'vc-dispatcher)
(require 'vc-dir)) ; vc-dir-at-event
(declare-function vc-deduce-fileset "vc"
@@ -66,7 +66,6 @@
(defcustom vc-bzr-program "bzr"
"Name of the bzr command (excluding any arguments)."
- :group 'vc-bzr
:type 'string)
(defcustom vc-bzr-diff-switches nil
@@ -75,8 +74,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:type '(choice (const :tag "Unspecified" nil)
(const :tag "None" t)
(string :tag "Argument String")
- (repeat :tag "Argument List" :value ("") string))
- :group 'vc-bzr)
+ (repeat :tag "Argument List" :value ("") string)))
(defcustom vc-bzr-annotate-switches nil
"String or list of strings specifying switches for bzr annotate under VC.
@@ -85,15 +83,13 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "25.1"
- :group 'vc-bzr)
+ :version "25.1")
(defcustom vc-bzr-log-switches nil
"String or list of strings specifying switches for bzr log under VC."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
- (repeat :tag "Argument List" :value ("") string))
- :group 'vc-bzr)
+ (repeat :tag "Argument List" :value ("") string)))
(defcustom vc-bzr-status-switches
(ignore-errors
@@ -108,7 +104,6 @@ The option \"--no-classify\" should be present if your bzr supports it."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :group 'vc-bzr
:version "24.1")
;; since v0.9, bzr supports removing the progress indicators
@@ -122,7 +117,7 @@ prepends `vc-bzr-status-switches' to ARGS."
`("BZR_PROGRESS_BAR=none" ; Suppress progress output (bzr >=0.9)
"LC_MESSAGES=C" ; Force English output
,@process-environment)))
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
+ (apply #'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
file-or-list bzr-command
(if (and (string-equal "status" bzr-command)
vc-bzr-status-switches)
@@ -144,7 +139,7 @@ Use the current Bzr root directory as the ROOT argument to
,@process-environment))
(root (vc-bzr-root default-directory))
(buffer (format "*vc-bzr : %s*" (expand-file-name root))))
- (apply 'vc-do-async-command buffer root
+ (apply #'vc-do-async-command buffer root
vc-bzr-program bzr-command args)
buffer))
@@ -267,7 +262,8 @@ in the repository root directory of FILE."
;; If there is no parent, this must be a new repo.
;; If file is in dirstate, can only be added (b#8025).
((or (not (match-beginning 4))
- (eq (char-after (match-beginning 4)) ?a)) 'added)
+ (eq (char-after (match-beginning 4)) ?a))
+ 'added)
((or (and (eql (string-to-number (match-string 3))
(file-attribute-size (file-attributes file)))
(equal (match-string 5)
@@ -280,7 +276,7 @@ in the repository root directory of FILE."
(memq
?x
(mapcar
- 'identity
+ #'identity
(file-attribute-modes
(file-attributes file))))))
(if (eq (char-after (match-beginning 7))
@@ -374,13 +370,13 @@ If PROMPT is non-nil, prompt for the Bzr command to run."
command (cadr args)
args (cddr args)))
(require 'vc-dispatcher)
- (let ((buf (apply 'vc-bzr-async-command command args)))
+ (let ((buf (apply #'vc-bzr-async-command command args)))
(with-current-buffer buf
(vc-run-delayed
(vc-compilation-mode 'bzr)
(setq-local compile-command
(concat vc-bzr-program " " command " "
- (if args (mapconcat 'identity args " ") "")))))
+ (if args (mapconcat #'identity args " ") "")))))
(vc-set-async-update buf))))
(defun vc-bzr-pull (prompt)
@@ -424,7 +420,7 @@ default if it is available."
(vc-bzr-program (car cmd))
(command (cadr cmd))
(args (cddr cmd)))
- (let ((buf (apply 'vc-bzr-async-command command args)))
+ (let ((buf (apply #'vc-bzr-async-command command args)))
(with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
@@ -471,7 +467,7 @@ in the branch repository (or whose status not be determined)."
;; Erase the status text that matched.
(delete-region (match-beginning 0) (match-end 0))
(setq status
- (intern (replace-regexp-in-string " " "" statusword)))))
+ (intern (string-replace " " "" statusword)))))
(when status
(goto-char (point-min))
(skip-chars-forward " \n\t") ;Throw away spaces.
@@ -512,7 +508,7 @@ in the branch repository (or whose status not be determined)."
(unless (re-search-forward "^<<<<<<< " nil t)
(vc-bzr-command "resolve" nil 0 buffer-file-name)
;; Remove the hook so that it is not called multiple times.
- (remove-hook 'after-save-hook 'vc-bzr-resolve-when-done t))))
+ (remove-hook 'after-save-hook #'vc-bzr-resolve-when-done t))))
(defun vc-bzr-find-file-hook ()
(when (and buffer-file-name
@@ -529,7 +525,7 @@ in the branch repository (or whose status not be determined)."
;; but the one in `bzr pull' isn't, so it would be good to provide an
;; elisp function to remerge from the .BASE/OTHER/THIS files.
(smerge-start-session)
- (add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
+ (add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t)
(vc-message-unresolved-conflicts buffer-file-name)))
(defun vc-bzr-version-dirstate (dir)
@@ -643,7 +639,7 @@ Returns nil if unable to find this information."
;; Could run `bzr status' in the directory and see if it succeeds, but
;; that's relatively expensive.
-(defalias 'vc-bzr-responsible-p 'vc-bzr-root
+(defalias 'vc-bzr-responsible-p #'vc-bzr-root
"Return non-nil if FILE is (potentially) controlled by bzr.
The criterion is that there is a `.bzr' directory in the same
or a superior directory.")
@@ -664,7 +660,7 @@ or a superior directory.")
(defun vc-bzr-checkin (files comment &optional _rev)
"Check FILES in to bzr with log message COMMENT."
- (apply 'vc-bzr-command "commit" nil 0 files
+ (apply #'vc-bzr-command "commit" nil 0 files
(cons "-m" (log-edit-extract-headers
`(("Author" . ,(vc-bzr--sanitize-header "--author"))
("Date" . ,(vc-bzr--sanitize-header "--commit-time"))
@@ -699,7 +695,7 @@ or a superior directory.")
(defvar log-view-expanded-log-entry-function)
(define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View"
- (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack.
+ (remove-hook 'log-view-mode-hook #'vc-bzr-log-view-mode) ;Deactivate the hack.
(require 'add-log)
(setq-local log-view-per-file-logs nil)
(setq-local log-view-file-re regexp-unmatchable)
@@ -745,7 +741,7 @@ If LIMIT is non-nil, show no more than this many entries."
;; the log display may not what the user wants - but I see no other
;; way of getting the above regexps working.
(with-current-buffer buffer
- (apply 'vc-bzr-command "log" buffer 'async files
+ (apply #'vc-bzr-command "log" buffer 'async files
(append
(if shortlog '("--line") '("--long"))
;; The extra complications here when start-revision and limit
@@ -761,7 +757,8 @@ If LIMIT is non-nil, show no more than this many entries."
;; This means we don't have to use --no-aliases.
;; Is -c any different to -r in this case?
"-r%s"
- "-r..%s") start-revision)))
+ "-r..%s")
+ start-revision)))
(if (eq vc-log-view-type 'with-diff) (list "-p"))
(when limit (list "-l" (format "%s" limit)))
;; There is no sensible way to combine --limit and --forward,
@@ -782,7 +779,7 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-bzr-expanded-log-entry (revision)
(with-temp-buffer
- (apply 'vc-bzr-command "log" t nil nil
+ (apply #'vc-bzr-command "log" t nil nil
(append
(list "--long" (format "-r%s" revision))
(if (stringp vc-bzr-log-switches)
@@ -795,11 +792,11 @@ If LIMIT is non-nil, show no more than this many entries."
(buffer-substring (match-end 0) (point-max)))))
(defun vc-bzr-log-incoming (buffer remote-location)
- (apply 'vc-bzr-command "missing" buffer 'async nil
+ (apply #'vc-bzr-command "missing" buffer 'async nil
(list "--theirs-only" (unless (string= remote-location "") remote-location))))
(defun vc-bzr-log-outgoing (buffer remote-location)
- (apply 'vc-bzr-command "missing" buffer 'async nil
+ (apply #'vc-bzr-command "missing" buffer 'async nil
(list "--mine-only" (unless (string= remote-location "") remote-location))))
(defun vc-bzr-show-log-entry (revision)
@@ -830,7 +827,7 @@ If LIMIT is non-nil, show no more than this many entries."
(append
;; Only add --diff-options if there are any diff switches.
(unless (zerop (length switches))
- (list "--diff-options" (mapconcat 'identity switches " ")))
+ (list "--diff-options" (mapconcat #'identity switches " ")))
;; This `when' is just an optimization because bzr-1.2 is *much*
;; faster when the revision argument is not given.
(when (or rev1 rev2)
@@ -995,7 +992,7 @@ stream. Standard error output is discarded."
(defun vc-bzr-dir-status-files (dir files update-function)
"Return a list of conses (file . state) for DIR."
- (apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
+ (apply #'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
(vc-run-delayed
(vc-bzr-after-dir-status update-function
;; "bzr status" results are relative to
@@ -1010,15 +1007,15 @@ stream. Standard error output is discarded."
(defvar vc-bzr-shelve-map
(let ((map (make-sparse-keymap)))
;; Turn off vc-dir marking
- (define-key map [mouse-2] 'ignore)
-
- (define-key map [down-mouse-3] 'vc-bzr-shelve-menu)
- (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point)
- (define-key map "=" 'vc-bzr-shelve-show-at-point)
- (define-key map "\C-m" 'vc-bzr-shelve-show-at-point)
- (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point)
- (define-key map "P" 'vc-bzr-shelve-apply-at-point)
- (define-key map "S" 'vc-bzr-shelve-snapshot)
+ (define-key map [mouse-2] #'ignore)
+
+ (define-key map [down-mouse-3] #'vc-bzr-shelve-menu)
+ (define-key map "\C-k" #'vc-bzr-shelve-delete-at-point)
+ (define-key map "=" #'vc-bzr-shelve-show-at-point)
+ (define-key map "\C-m" #'vc-bzr-shelve-show-at-point)
+ (define-key map "A" #'vc-bzr-shelve-apply-and-keep-at-point)
+ (define-key map "P" #'vc-bzr-shelve-apply-at-point)
+ (define-key map "S" #'vc-bzr-shelve-snapshot)
map))
(defvar vc-bzr-shelve-menu-map
@@ -1076,49 +1073,49 @@ stream. Standard error output is discarded."
(when (string-match ".+checkout of branch: \\(.+\\)$" str)
(match-string 1 str)))))
(concat
- (propertize "Parent branch : " 'face 'font-lock-type-face)
+ (propertize "Parent branch : " 'face 'vc-dir-header)
(propertize
(if (string-match "parent branch: \\(.+\\)$" str)
(match-string 1 str)
"None")
- 'face 'font-lock-variable-name-face)
+ 'face 'vc-dir-header-value)
"\n"
(when light-checkout
(concat
- (propertize "Light checkout root: " 'face 'font-lock-type-face)
- (propertize light-checkout 'face 'font-lock-variable-name-face)
+ (propertize "Light checkout root: " 'face 'vc-dir-header)
+ (propertize light-checkout 'face 'vc-dir-header-value)
"\n"))
(when light-checkout-branch
(concat
- (propertize "Checkout of branch : " 'face 'font-lock-type-face)
- (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
+ (propertize "Checkout of branch : " 'face 'vc-dir-header)
+ (propertize light-checkout-branch 'face 'vc-dir-header-value)
"\n"))
(when pending-merge
(concat
- (propertize "Warning : " 'face 'font-lock-warning-face
+ (propertize "Warning : " 'face 'vc-dir-status-warning
'help-echo pending-merge-help-echo)
(propertize "Pending merges, commit recommended before any other action"
'help-echo pending-merge-help-echo
- 'face 'font-lock-warning-face)
+ 'face 'vc-dir-status-warning)
"\n"))
(if shelve
(concat
- (propertize "Shelves :\n" 'face 'font-lock-type-face
+ (propertize "Shelves :\n" 'face 'vc-dir-header
'help-echo shelve-help-echo)
(mapconcat
(lambda (x)
(propertize x
- 'face 'font-lock-variable-name-face
+ 'face 'vc-dir-header-value
'mouse-face 'highlight
'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf"
'keymap vc-bzr-shelve-map))
shelve "\n"))
(concat
- (propertize "Shelves : " 'face 'font-lock-type-face
+ (propertize "Shelves : " 'face 'vc-dir-header
'help-echo shelve-help-echo)
(propertize "No shelved changes"
'help-echo shelve-help-echo
- 'face 'font-lock-variable-name-face))))))
+ 'face 'vc-dir-header-value))))))
;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher.
(declare-function vc-resynch-buffer "vc-dispatcher"
@@ -1211,7 +1208,7 @@ stream. Standard error output is discarded."
(let ((vc-bzr-revisions '())
(default-directory (file-name-directory (car files))))
(with-temp-buffer
- (apply 'vc-bzr-command "log" t 0 files
+ (apply #'vc-bzr-command "log" t 0 files
(append '("--line")
(if (stringp vc-bzr-log-switches)
(list vc-bzr-log-switches)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index a595cc9778b..c8f36fb76ec 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -76,8 +76,7 @@
(repeat :tag "Argument List"
:value ("")
string))
- :version "22.1"
- :group 'vc-cvs)
+ :version "22.1")
(defcustom vc-cvs-register-switches nil
"Switches for registering a file into CVS.
@@ -88,8 +87,7 @@ If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "21.1"
- :group 'vc-cvs)
+ :version "21.1")
(defcustom vc-cvs-diff-switches nil
"String or list of strings specifying switches for CVS diff under VC.
@@ -98,8 +96,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "21.1"
- :group 'vc-cvs)
+ :version "21.1")
(defcustom vc-cvs-annotate-switches nil
"String or list of strings specifying switches for cvs annotate under VC.
@@ -109,22 +106,19 @@ switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "25.1"
- :group 'vc-cvs)
+ :version "25.1")
(defcustom vc-cvs-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
- :type '(repeat string)
- :group 'vc-cvs)
+ :type '(repeat string))
(defcustom vc-cvs-use-edit t
"Non-nil means to use `cvs edit' to \"check out\" a file.
This is only meaningful if you don't use the implicit checkout model
\(i.e. if you have $CVSREAD set)."
:type 'boolean
- :version "21.1"
- :group 'vc-cvs)
+ :version "21.1")
(defcustom vc-cvs-stay-local 'only-file
"Non-nil means use local operations when possible for remote repositories.
@@ -151,16 +145,14 @@ except for hosts matched by these regular expressions."
(regexp :format " stay local,\n%t: %v"
:tag "if it matches")
(repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "23.1"
- :group 'vc-cvs)
+ :version "23.1")
(defcustom vc-cvs-sticky-date-format-string "%c"
"Format string for mode-line display of sticky date.
Format is according to `format-time-string'. Only used if
`vc-cvs-sticky-tag-display' is t."
:type '(string)
- :version "22.1"
- :group 'vc-cvs)
+ :version "22.1")
(defcustom vc-cvs-sticky-tag-display t
"Specify the mode-line display of sticky tags.
@@ -198,8 +190,7 @@ displayed. Date and time is displayed for sticky dates.
See also variable `vc-cvs-sticky-date-format-string'."
:type '(choice boolean function)
- :version "22.1"
- :group 'vc-cvs)
+ :version "22.1")
;;;
;;; Internal variables
@@ -310,7 +301,7 @@ to the CVS command."
(vc-cvs-could-register file)
(push (directory-file-name (file-name-directory file)) dirs)))
(if dirs (vc-cvs-register dirs)))
- (apply 'vc-cvs-command nil 0 files
+ (apply #'vc-cvs-command nil 0 files
"add"
(and comment (string-match "[^\t\n ]" comment)
(concat "-m" comment))
@@ -346,12 +337,12 @@ its parents."
(error "%s is not a valid symbolic tag name" rev)
;; If the input revision is a valid symbolic tag name, we create it
;; as a branch, commit and switch to it.
- (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev))
- (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev))
+ (apply #'vc-cvs-command nil 0 files "tag" "-b" (list rev))
+ (apply #'vc-cvs-command nil 0 files "update" "-r" (list rev))
(mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev))
files)))
(let ((status (apply
- 'vc-cvs-command nil 1 files
+ #'vc-cvs-command nil 1 files
"ci" (if rev (concat "-r" rev))
(concat "-m" (car (log-edit-extract-headers nil comment)))
(vc-switches 'CVS 'checkin))))
@@ -378,7 +369,7 @@ its parents."
(vc-file-setprop
(car files) 'vc-working-revision
(vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2))
- (mapc 'vc-file-clearprops files))
+ (mapc #'vc-file-clearprops files))
;; Anyway, forget the checkout model of the file, because we might have
;; guessed wrong when we found the file. After commit, we can
;; tell it from the permissions of the file (see
@@ -391,7 +382,7 @@ its parents."
(vc-cvs-command nil 0 files "update" "-A"))))
(defun vc-cvs-find-revision (file rev buffer)
- (apply 'vc-cvs-command
+ (apply #'vc-cvs-command
buffer 0 file
"-Q" ; suppress diagnostic output
"update"
@@ -416,7 +407,7 @@ REV is the revision to check out."
(if (equal file buffer-file-name) (read-only-mode -1))))
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
- (apply 'vc-cvs-command nil 0 file
+ (apply #'vc-cvs-command nil 0 file
"-w"
"update"
(when rev
@@ -600,7 +591,7 @@ Remaining arguments are ignored."
;; This used to append diff-switches and vc-diff-switches,
;; which was consistent with the vc-diff-switches doc at that
;; time, but not with the actual behavior of any other VC diff.
- (apply 'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil
+ (apply #'vc-do-command (or buffer "*vc-diff*") 1 "diff" nil
;; Not a CVS diff, does not use vc-cvs-diff-switches.
(append (vc-switches nil 'diff)
(list (file-relative-name file-oldvers)
@@ -608,7 +599,7 @@ Remaining arguments are ignored."
(setq status 0))
(push file invoke-cvs-diff-list)))))
(when invoke-cvs-diff-list
- (setq status (apply 'vc-cvs-command (or buffer "*vc-diff*")
+ (setq status (apply #'vc-cvs-command (or buffer "*vc-diff*")
(if async 'async 1)
invoke-cvs-diff-list "diff"
(and oldvers (concat "-r" oldvers))
@@ -787,7 +778,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
"A wrapper around `vc-do-command' for use in vc-cvs.el.
The difference to vc-do-command is that this function always invokes `cvs',
and that it passes `vc-cvs-global-switches' to it before FLAGS."
- (apply 'vc-do-command (or buffer "*vc*") okstatus "cvs" files
+ (apply #'vc-do-command (or buffer "*vc*") okstatus "cvs" files
(if (stringp vc-cvs-global-switches)
(cons vc-cvs-global-switches flags)
(append vc-cvs-global-switches
@@ -816,7 +807,7 @@ individually should stay local."
(setq default nil stay-local (cdr stay-local)))
(when (consp stay-local)
(setq stay-local
- (mapconcat 'identity stay-local "\\|")))
+ (mapconcat #'identity stay-local "\\|")))
(if (if (string-match stay-local hostname)
default (not default))
'yes 'no))))))))))))
@@ -1047,29 +1038,29 @@ Query all files in DIR if files is nil."
(file-error nil))))
(concat
(cond (repo
- (concat (propertize "Repository : " 'face 'font-lock-type-face)
- (propertize repo 'face 'font-lock-variable-name-face)))
+ (concat (propertize "Repository : " 'face 'vc-dir-header)
+ (propertize repo 'face 'vc-dir-header-value)))
(t ""))
(cond (module
- (concat (propertize "Module : " 'face 'font-lock-type-face)
- (propertize module 'face 'font-lock-variable-name-face)))
+ (concat (propertize "Module : " 'face 'vc-dir-header)
+ (propertize module 'face 'vc-dir-header-value)))
(t ""))
(if (file-readable-p "CVS/Tag")
(let ((tag (vc-cvs-file-to-string "CVS/Tag")))
(cond
((string-match "\\`T" tag)
- (concat (propertize "Tag : " 'face 'font-lock-type-face)
+ (concat (propertize "Tag : " 'face 'vc-dir-header)
(propertize (substring tag 1)
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
((string-match "\\`D" tag)
- (concat (propertize "Date : " 'face 'font-lock-type-face)
+ (concat (propertize "Date : " 'face 'vc-dir-header)
(propertize (substring tag 1)
- 'face 'font-lock-variable-name-face)))
+ 'face 'vc-dir-header-value)))
(t ""))))
;; In CVS, branch is a per-file property, not a per-directory property.
;; We can't really do this here without making dangerous assumptions.
- ;;(propertize "Branch: " 'face 'font-lock-type-face)
+ ;;(propertize "Branch: " 'face 'vc-dir-header)
;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
;; 'face 'font-lock-warning-face)
)))
@@ -1182,7 +1173,7 @@ is non-nil."
(mtime (file-attribute-modification-time (file-attributes file)))
(parsed-time (progn (require 'parse-time)
(parse-time-string (concat time " +0000")))))
- (cond ((and (not (string-match "\\+" time))
+ (cond ((and (not (string-search "+" time))
(decoded-time-second parsed-time)
;; Compare just the seconds part of the file time,
;; since CVS file time stamp resolution is just 1 second.
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 88f46eff059..5fd8d8e5036 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -1,4 +1,4 @@
-;;; vc-dav.el --- vc.el support for WebDAV
+;;; vc-dav.el --- vc.el support for WebDAV -*- lexical-binding: t; -*-
;; Copyright (C) 2001, 2004-2021 Free Software Foundation, Inc.
@@ -64,7 +64,7 @@ For a list of possible values, see `vc-state'."
'edited
(cdr (car locks)))))))
-(defun vc-dav-checkout-model (url)
+(defun vc-dav-checkout-model (_url)
"Indicate whether URL needs to be \"checked out\" before it can be edited.
See `vc-checkout-model' for a list of possible values."
;; The only thing we can support with webdav is 'locking
@@ -72,21 +72,21 @@ See `vc-checkout-model' for a list of possible values."
;; This should figure out the version # of the file somehow. What is
;; the most appropriate property in WebDAV to look at for this?
-(defun vc-dav-workfile-version (url)
+(defun vc-dav-workfile-version (_url)
"Return the current workfile version of URL."
"Unknown")
-(defun vc-dav-register (url &optional _comment)
+(defun vc-dav-register (_url &optional _comment)
"Register URL in the DAV backend."
;; Do we need to do anything here? FIXME?
)
-(defun vc-dav-checkin (url comment &optional _rev)
+(defun vc-dav-checkin (_url _comment &optional _rev)
"Commit changes in URL to WebDAV. COMMENT is used as a check-in comment."
;; This should PUT the resource and release any locks that we hold.
)
-(defun vc-dav-checkout (url &optional rev destfile)
+(defun vc-dav-checkout (_url &optional _rev _destfile)
"Check out revision REV of URL into the working area.
If EDITABLE is non-nil URL should be writable by the user and if
@@ -101,7 +101,7 @@ write the contents to.
;; This should LOCK the resource.
)
-(defun vc-dav-revert (url &optional contents-done)
+(defun vc-dav-revert (_url &optional _contents-done)
"Revert URL back to the current workfile version.
If optional arg CONTENTS-DONE is non-nil, then the contents of FILE
@@ -112,11 +112,11 @@ only needs to update the status of URL within the backend.
;; Should UNLOCK the file.
)
-(defun vc-dav-print-log (url)
+(defun vc-dav-print-log (_url)
"Insert the revision log of URL into the *vc* buffer."
)
-(defun vc-dav-diff (url &optional rev1 rev2 buffer async)
+(defun vc-dav-diff (_url &optional _rev1 _rev2 _buffer _async)
"Insert the diff for URL into the *vc-diff* buffer.
If REV1 and REV2 are non-nil report differences from REV1 to REV2.
If REV1 is nil, use the current workfile version as the older version.
@@ -135,11 +135,11 @@ It should return a status of either 0 (no differences found), or
;; This should use url-dav-get-properties with a depth of `1' to get
;; all the properties.
-(defun vc-dav-dir-state (url)
+(defun vc-dav-dir-state (_url)
"find the version control state of all files in DIR in a fast way."
)
-(defun vc-dav-responsible-p (url)
+(defun vc-dav-responsible-p (_url)
"Return non-nil if DAV considers itself `responsible' for URL."
;; Check for DAV support on the web server.
t)
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 14c81578b79..eb8cf8192c1 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -56,39 +56,48 @@ See `run-hooks'."
(defface vc-dir-header '((t :inherit font-lock-type-face))
"Face for headers in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-header-value '((t :inherit font-lock-variable-name-face))
"Face for header values in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face))
"Face for directories in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-file '((t :inherit font-lock-function-name-face))
"Face for files in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-mark-indicator '((t :inherit font-lock-type-face))
"Face for mark indicators in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-status-warning '((t :inherit font-lock-warning-face))
"Face for warning status in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face))
"Face for edited status in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
(defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face))
"Face for up-to-date status in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
-(defface vc-dir-ignored '((t :inherit shadow))
+(defface vc-dir-status-ignored '((t :inherit shadow))
"Face for ignored or empty values in VC-dir buffers."
- :group 'vc)
+ :group 'vc
+ :version "28.1")
;; Used to store information for the files displayed in the directory buffer.
;; Each item displayed corresponds to one of these defstructs.
@@ -293,67 +302,67 @@ See `run-hooks'."
(defvar vc-dir-mode-map
(let ((map (make-sparse-keymap)))
;; VC commands
- (define-key map "v" 'vc-next-action) ;; C-x v v
- (define-key map "=" 'vc-diff) ;; C-x v =
- (define-key map "D" 'vc-root-diff) ;; C-x v D
- (define-key map "i" 'vc-register) ;; C-x v i
- (define-key map "+" 'vc-update) ;; C-x v +
+ (define-key map "v" #'vc-next-action) ;; C-x v v
+ (define-key map "=" #'vc-diff) ;; C-x v =
+ (define-key map "D" #'vc-root-diff) ;; C-x v D
+ (define-key map "i" #'vc-register) ;; C-x v i
+ (define-key map "+" #'vc-update) ;; C-x v +
;; I'd prefer some kind of symmetry with vc-update:
- (define-key map "P" 'vc-push) ;; C-x v P
- (define-key map "l" 'vc-print-log) ;; C-x v l
- (define-key map "L" 'vc-print-root-log) ;; C-x v L
- (define-key map "I" 'vc-log-incoming) ;; C-x v I
- (define-key map "O" 'vc-log-outgoing) ;; C-x v O
+ (define-key map "P" #'vc-push) ;; C-x v P
+ (define-key map "l" #'vc-print-log) ;; C-x v l
+ (define-key map "L" #'vc-print-root-log) ;; C-x v L
+ (define-key map "I" #'vc-log-incoming) ;; C-x v I
+ (define-key map "O" #'vc-log-outgoing) ;; C-x v O
;; More confusing than helpful, probably
- ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark.
- ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer
+ ;;(define-key map "R" #'vc-revert) ;; u is taken by vc-dir-unmark.
+ ;;(define-key map "A" #'vc-annotate) ;; g is taken by revert-buffer
;; bound by `special-mode'.
;; Marking.
- (define-key map "m" 'vc-dir-mark)
- (define-key map "d" 'vc-dir-clean-files)
- (define-key map "M" 'vc-dir-mark-all-files)
- (define-key map "u" 'vc-dir-unmark)
- (define-key map "U" 'vc-dir-unmark-all-files)
- (define-key map "\C-?" 'vc-dir-unmark-file-up)
- (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
+ (define-key map "m" #'vc-dir-mark)
+ (define-key map "d" #'vc-dir-clean-files)
+ (define-key map "M" #'vc-dir-mark-all-files)
+ (define-key map "u" #'vc-dir-unmark)
+ (define-key map "U" #'vc-dir-unmark-all-files)
+ (define-key map "\C-?" #'vc-dir-unmark-file-up)
+ (define-key map "\M-\C-?" #'vc-dir-unmark-all-files)
;; Movement.
- (define-key map "n" 'vc-dir-next-line)
- (define-key map " " 'vc-dir-next-line)
- (define-key map "\t" 'vc-dir-next-directory)
- (define-key map "p" 'vc-dir-previous-line)
- (define-key map [?\S-\ ] 'vc-dir-previous-line)
- (define-key map [backtab] 'vc-dir-previous-directory)
+ (define-key map "n" #'vc-dir-next-line)
+ (define-key map " " #'vc-dir-next-line)
+ (define-key map "\t" #'vc-dir-next-directory)
+ (define-key map "p" #'vc-dir-previous-line)
+ (define-key map [?\S-\ ] #'vc-dir-previous-line)
+ (define-key map [backtab] #'vc-dir-previous-directory)
;;; Rebind paragraph-movement commands.
- (define-key map "\M-}" 'vc-dir-next-directory)
- (define-key map "\M-{" 'vc-dir-previous-directory)
- (define-key map [C-down] 'vc-dir-next-directory)
- (define-key map [C-up] 'vc-dir-previous-directory)
+ (define-key map "\M-}" #'vc-dir-next-directory)
+ (define-key map "\M-{" #'vc-dir-previous-directory)
+ (define-key map [C-down] #'vc-dir-next-directory)
+ (define-key map [C-up] #'vc-dir-previous-directory)
;; The remainder.
- (define-key map "f" 'vc-dir-find-file)
- (define-key map "e" 'vc-dir-find-file) ; dired-mode compatibility
- (define-key map "\C-m" 'vc-dir-find-file)
- (define-key map "o" 'vc-dir-find-file-other-window)
- (define-key map "\C-o" 'vc-dir-display-file)
- (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
- (define-key map [down-mouse-3] 'vc-dir-menu)
+ (define-key map "f" #'vc-dir-find-file)
+ (define-key map "e" #'vc-dir-find-file) ; dired-mode compatibility
+ (define-key map "\C-m" #'vc-dir-find-file)
+ (define-key map "o" #'vc-dir-find-file-other-window)
+ (define-key map "\C-o" #'vc-dir-display-file)
+ (define-key map "\C-c\C-c" #'vc-dir-kill-dir-status-process)
+ (define-key map [down-mouse-3] #'vc-dir-menu)
(define-key map [follow-link] 'mouse-face)
- (define-key map "x" 'vc-dir-hide-up-to-date)
- (define-key map [?\C-k] 'vc-dir-kill-line)
- (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired?
- (define-key map "Q" 'vc-dir-query-replace-regexp)
- (define-key map (kbd "M-s a C-s") 'vc-dir-isearch)
- (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp)
- (define-key map "G" 'vc-dir-ignore)
+ (define-key map "x" #'vc-dir-hide-up-to-date)
+ (define-key map [?\C-k] #'vc-dir-kill-line)
+ (define-key map "S" #'vc-dir-search) ;; FIXME: Maybe use A like dired?
+ (define-key map "Q" #'vc-dir-query-replace-regexp)
+ (define-key map (kbd "M-s a C-s") #'vc-dir-isearch)
+ (define-key map (kbd "M-s a M-C-s") #'vc-dir-isearch-regexp)
+ (define-key map "G" #'vc-dir-ignore)
(let ((branch-map (make-sparse-keymap)))
(define-key map "B" branch-map)
- (define-key branch-map "c" 'vc-create-tag)
- (define-key branch-map "l" 'vc-print-branch-log)
- (define-key branch-map "s" 'vc-retrieve-tag))
+ (define-key branch-map "c" #'vc-create-tag)
+ (define-key branch-map "l" #'vc-print-branch-log)
+ (define-key branch-map "s" #'vc-retrieve-tag))
(let ((mark-map (make-sparse-keymap)))
(define-key map "*" mark-map)
- (define-key mark-map "r" 'vc-dir-mark-registered-files))
+ (define-key mark-map "r" #'vc-dir-mark-registered-files))
;; Hook up the menu.
(define-key map [menu-bar vc-dir-mode]
@@ -497,7 +506,7 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
(t
(unless noinsert
(ewoc-enter-before vc-ewoc node
- (apply 'vc-dir-create-fileinfo entry)))
+ (apply #'vc-dir-create-fileinfo entry)))
(setq entries (cdr entries))
(setq entry (car entries))))))
(t
@@ -513,7 +522,7 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
;; Now insert the node itself.
(ewoc-enter-before vc-ewoc node
- (apply 'vc-dir-create-fileinfo entry)))
+ (apply #'vc-dir-create-fileinfo entry)))
(setq entries (cdr entries) entry (car entries))))))
;; We're past the last node, all remaining entries go to the end.
(unless (or node noinsert)
@@ -529,10 +538,10 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
;; Now insert the node itself.
(ewoc-enter-last vc-ewoc
- (apply 'vc-dir-create-fileinfo entry))))))
+ (apply #'vc-dir-create-fileinfo entry))))))
(when to-remove
(let ((inhibit-read-only t))
- (apply 'ewoc-delete vc-ewoc (nreverse to-remove)))))))
+ (apply #'ewoc-delete vc-ewoc (nreverse to-remove)))))))
(defun vc-dir-busy ()
(and (buffer-live-p vc-dir-process-buffer)
@@ -873,7 +882,7 @@ system; see `vc-dir-delete-file'."
The files will also be marked as deleted in the version control
system."
(interactive)
- (mapc 'vc-delete-file (or (vc-dir-marked-files)
+ (mapc #'vc-delete-file (or (vc-dir-marked-files)
(list (vc-dir-current-file)))))
(defun vc-dir-find-file ()
@@ -903,13 +912,13 @@ system."
"Search for a string through all marked buffers using Isearch."
(interactive)
(multi-isearch-files
- (mapcar 'car (vc-dir-marked-only-files-and-states))))
+ (mapcar #'car (vc-dir-marked-only-files-and-states))))
(defun vc-dir-isearch-regexp ()
"Search for a regexp through all marked buffers using Isearch."
(interactive)
(multi-isearch-files-regexp
- (mapcar 'car (vc-dir-marked-only-files-and-states))))
+ (mapcar #'car (vc-dir-marked-only-files-and-states))))
(defun vc-dir-search (regexp)
"Search through all marked files for a match for REGEXP.
@@ -934,13 +943,13 @@ with the command \\[tags-loop-continue]."
(query-replace-read-args
"Query replace regexp in marked files" t t)))
(list (nth 0 common) (nth 1 common) (nth 2 common))))
- (dolist (file (mapcar 'car (vc-dir-marked-only-files-and-states)))
+ (dolist (file (mapcar #'car (vc-dir-marked-only-files-and-states)))
(let ((buffer (get-file-buffer file)))
(if (and buffer (with-current-buffer buffer
buffer-read-only))
(error "File `%s' is visited read-only" file))))
(fileloop-initialize-replace
- from to (mapcar 'car (vc-dir-marked-only-files-and-states))
+ from to (mapcar #'car (vc-dir-marked-only-files-and-states))
(if (equal from (downcase from)) nil 'default)
delimited)
(fileloop-continue))
@@ -1152,7 +1161,7 @@ the *vc-dir* buffer.
(add-to-list 'vc-dir-buffers (current-buffer))
;; Make sure that if the directory buffer is killed, the update
;; process running in the background is also killed.
- (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
+ (add-hook 'kill-buffer-query-functions #'vc-dir-kill-query nil t)
(hack-dir-local-variables-non-file-buffer)
(vc-dir-refresh)))
@@ -1267,7 +1276,7 @@ Throw an error if another update process is in progress."
vc-ewoc 'vc-dir-fileinfo->needs-update)))
(if remaining
(vc-dir-refresh-files
- (mapcar 'vc-dir-fileinfo->name remaining))
+ (mapcar #'vc-dir-fileinfo->name remaining))
(setq mode-line-process nil)
(run-hooks 'vc-dir-refresh-hook))))))))))))
@@ -1321,7 +1330,7 @@ state of item at point, if any."
(ewoc-delete vc-ewoc crt))
(setq crt prev)))))
-(defalias 'vc-dir-hide-up-to-date 'vc-dir-hide-state)
+(defalias 'vc-dir-hide-up-to-date #'vc-dir-hide-state)
(defun vc-dir-kill-line ()
"Remove the current line from display."
@@ -1357,7 +1366,7 @@ state of item at point, if any."
(unless (vc-compatible-state (cdr crt) state)
(error "When applying VC operations to multiple files, the files are required\nto be in similar VC states.\n%s in state %s clashes with %s in state %s"
(car crt) (cdr crt) (caar only-files-list) state)))
- (setq only-files-list (mapcar 'car only-files-list))
+ (setq only-files-list (mapcar #'car only-files-list))
(when (and state (not (eq state 'unregistered)))
(setq model (vc-checkout-model vc-dir-backend only-files-list))))
(list vc-dir-backend files only-files-list state model)))
@@ -1428,13 +1437,13 @@ These are the commands available for use in the file status buffer:
(defvar vc-dir-status-mouse-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'vc-dir-toggle-mark)
+ (define-key map [mouse-2] #'vc-dir-toggle-mark)
map)
"Local keymap for toggling mark.")
(defvar vc-dir-filename-mouse-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'vc-dir-find-file-other-window)
+ (define-key map [mouse-2] #'vc-dir-find-file-other-window)
map)
"Local keymap for visiting a file.")
@@ -1454,10 +1463,12 @@ These are the commands available for use in the file status buffer:
" "
(propertize
(format "%-20s" state)
- 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
- ((memq state '(missing conflict)) 'vc-dir-status-warning)
- ((eq state 'edited) 'font-lock-constant-face)
- (t 'vc-dir-header-value))
+ 'face (cond
+ ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
+ ((memq state '(missing conflict needs-update unlocked-changes))
+ 'vc-dir-status-warning)
+ ((eq state 'ignored) 'vc-dir-status-ignored)
+ (t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
" "
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 2573964c42c..c29458620e9 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -1,4 +1,4 @@
-;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*-
+;;; vc-dispatcher.el --- generic command-dispatcher facility. -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -242,7 +242,7 @@ CODE should be a function of no arguments."
((or (null proc) (eq (process-status proc) 'exit))
;; Make sure we've read the process's output before going further.
(when proc (accept-process-output proc))
- (if (functionp code) (funcall code) (eval code)))
+ (if (functionp code) (funcall code) (eval code t)))
;; If a process is running, add CODE to the sentinel
((eq (process-status proc) 'run)
(vc-set-mode-line-busy-indicator)
@@ -254,7 +254,7 @@ CODE should be a function of no arguments."
nil)
(defmacro vc-run-delayed (&rest body)
- (declare (indent 0) (debug t))
+ (declare (indent 0) (debug (def-body)))
`(vc-exec-after (lambda () ,@body)))
(defvar vc-post-command-functions nil
@@ -267,7 +267,7 @@ and is passed 3 arguments: the COMMAND, the FILES and the FLAGS.")
(defun vc-delistify (filelist)
"Smash a FILELIST into a file list string suitable for info messages."
;; FIXME what about file names with spaces?
- (if (not filelist) "." (mapconcat 'identity filelist " ")))
+ (if (not filelist) "." (mapconcat #'identity filelist " ")))
(defcustom vc-tor nil
"If non-nil, communicate with the repository site via Tor.
@@ -331,7 +331,7 @@ case, and the process object in the asynchronous case."
;; Run asynchronously.
(let ((proc
(let ((process-connection-type nil))
- (apply 'start-file-process command (current-buffer)
+ (apply #'start-file-process command (current-buffer)
command squeezed))))
(when vc-command-messages
(let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
@@ -339,7 +339,7 @@ case, and the process object in the asynchronous case."
;; Get rid of the default message insertion, in case we don't
;; set a sentinel explicitly.
(set-process-sentinel proc #'ignore)
- (set-process-filter proc 'vc-process-filter)
+ (set-process-filter proc #'vc-process-filter)
(setq status proc)
(when vc-command-messages
(vc-run-delayed
@@ -351,7 +351,7 @@ case, and the process object in the asynchronous case."
(let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
(message "Running in foreground: %s" full-command)))
(let ((buffer-undo-list t))
- (setq status (apply 'process-file command nil t nil squeezed)))
+ (setq status (apply #'process-file command nil t nil squeezed)))
(when (and (not (eq t okstatus))
(or (not (integerp status))
(and okstatus (< okstatus status))))
@@ -394,7 +394,7 @@ Display the buffer in some window, but don't select it."
(insert "\"...\n")
;; Run in the original working directory.
(let ((default-directory dir))
- (apply 'vc-do-command t 'async command nil args)))
+ (apply #'vc-do-command t 'async command nil args)))
(setq window (display-buffer buffer))
(if window
(set-window-start window new-window-start))
diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el
index ee73aa6f938..254e47933d6 100644
--- a/lisp/vc/vc-filewise.el
+++ b/lisp/vc/vc-filewise.el
@@ -1,4 +1,4 @@
-;;; vc-filewise.el --- common functions for file-oriented back ends.
+;;; vc-filewise.el --- common functions for file-oriented back ends. -*- lexical-binding: t; -*-
;; Copyright (C) 1992-1996, 1998-2021 Free Software Foundation, Inc.
@@ -82,3 +82,5 @@ If the file is not registered, or the master name is not known, return nil."
nil)))) ; Not registered
(provide 'vc-filewise)
+
+;;; vc-filewise.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index e7306386fea..935dc8b9aee 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -27,14 +27,6 @@
;; system.
;;
-;;; Installation:
-
-;; To install: put this file on the load-path and add Git to the list
-;; of supported backends in `vc-handled-backends'; the following line,
-;; placed in your init file, will accomplish this:
-;;
-;; (add-to-list 'vc-handled-backends 'Git)
-
;;; Todo:
;; - check if more functions could use vc-git-command instead
;; of start-process.
@@ -106,6 +98,7 @@
;;; Code:
(require 'cl-lib)
+(require 'vc-dispatcher)
(eval-when-compile
(require 'subr-x) ; for string-trim-right
(require 'vc)
@@ -134,6 +127,13 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches."
(repeat :tag "Argument List" :value ("") string))
:version "25.1")
+(defcustom vc-git-log-switches nil
+ "String or list of strings specifying switches for Git log under VC."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "28.1")
+
(defcustom vc-git-resolve-conflicts t
"When non-nil, mark conflicted file as resolved upon saving.
That is performed after all conflict markers in it have been
@@ -242,6 +242,15 @@ included in the completions."
;;;###autoload (load "vc-git" nil t)
;;;###autoload (vc-git-registered file))))
+(defun vc-git--literal-pathspec (pathspec)
+ "Prepend :(literal) path magic to PATHSPEC."
+ ;; Good example of PATHSPEC that needs this: "test[56].xx".
+ (and pathspec (concat ":(literal)" pathspec)))
+
+(defun vc-git--literal-pathspecs (pathspecs)
+ "Prepend :(literal) path magic to PATHSPECS."
+ (mapcar #'vc-git--literal-pathspec pathspecs))
+
(defun vc-git-registered (file)
"Check whether FILE is registered with git."
(let ((dir (vc-git-root file)))
@@ -251,16 +260,16 @@ included in the completions."
;; Do not use the `file-name-directory' here: git-ls-files
;; sometimes fails to return the correct status for relative
;; path specs.
- ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
+ ;; See also: https://marc.info/?l=git&m=125787684318129&w=2
(name (file-relative-name file dir))
(str (with-demoted-errors "Error: %S"
(cd dir)
- (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+ (vc-git--out-ok "ls-files" "-c" "-z" "--" (vc-git--literal-pathspec name))
;; If result is empty, use ls-tree to check for deleted
;; file.
(when (eq (point-min) (point-max))
(vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
- "--" name))
+ "--" (vc-git--literal-pathspec name)))
(buffer-string))))
(and str
(> (length str) (length name))
@@ -342,7 +351,7 @@ in the order given by `git status'."
,@(when (version<= "1.7.6.3" (vc-git--program-version))
'("--ignored"))
"--"))
- (status (apply #'vc-git--run-command-string file args)))
+ (status (apply #'vc-git--run-command-string (vc-git--literal-pathspec file) args)))
(if (null status)
;; If status is nil, there was an error calling git, likely because
;; the file is not in a git repo.
@@ -375,7 +384,7 @@ in the order given by `git status'."
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let* ((rev (vc-working-revision file 'Git))
(disp-rev (or (vc-git--symbolic-ref file)
- (substring rev 0 7)))
+ (and rev (substring rev 0 7))))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml))
(face (get-text-property 0 'face def-ml)))
@@ -479,7 +488,8 @@ or an empty string if none."
(propertize
(format "%-12s" state)
'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date)
- ((eq state '(missing conflict)) 'vc-dir-status-warning)
+ ((memq state '(missing conflict)) 'vc-dir-status-warning)
+ ((eq state 'ignored) 'vc-dir-status-ignored)
(t 'vc-dir-status-edited))
'mouse-face 'highlight
'keymap vc-dir-status-mouse-map)
@@ -619,28 +629,28 @@ or an empty string if none."
(pcase (vc-git-dir-status-state->stage git-state)
('update-index
(if files
- (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
('ls-files-added
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-up-to-date
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
"ls-files" "-z" "-c" "-s" "--"))
('ls-files-conflict
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
"ls-files" "-z" "-u" "--"))
('ls-files-unknown
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
"ls-files" "-z" "-o" "--exclude-standard" "--"))
('ls-files-ignored
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
('diff-index
- (vc-git-command (current-buffer) 'async files
+ (vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files)
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-run-delayed
(vc-git-after-dir-status-stage git-state))))
@@ -657,29 +667,29 @@ or an empty string if none."
(defvar vc-git-stash-shared-map
(let ((map (make-sparse-keymap)))
- (define-key map "S" 'vc-git-stash-snapshot)
- (define-key map "C" 'vc-git-stash)
+ (define-key map "S" #'vc-git-stash-snapshot)
+ (define-key map "C" #'vc-git-stash)
map))
(defvar vc-git-stash-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map vc-git-stash-shared-map)
;; Turn off vc-dir marking
- (define-key map [mouse-2] 'ignore)
-
- (define-key map [down-mouse-3] 'vc-git-stash-menu)
- (define-key map "\C-k" 'vc-git-stash-delete-at-point)
- (define-key map "=" 'vc-git-stash-show-at-point)
- (define-key map "\C-m" 'vc-git-stash-show-at-point)
- (define-key map "A" 'vc-git-stash-apply-at-point)
- (define-key map "P" 'vc-git-stash-pop-at-point)
+ (define-key map [mouse-2] #'ignore)
+
+ (define-key map [down-mouse-3] #'vc-git-stash-menu)
+ (define-key map "\C-k" #'vc-git-stash-delete-at-point)
+ (define-key map "=" #'vc-git-stash-show-at-point)
+ (define-key map "\C-m" #'vc-git-stash-show-at-point)
+ (define-key map "A" #'vc-git-stash-apply-at-point)
+ (define-key map "P" #'vc-git-stash-pop-at-point)
map))
(defvar vc-git-stash-button-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map vc-git-stash-shared-map)
- (define-key map [mouse-2] 'push-button)
- (define-key map "\C-m" 'push-button)
+ (define-key map [mouse-2] #'push-button)
+ (define-key map "\C-m" #'push-button)
map))
(defconst vc-git-stash-shared-help
@@ -835,7 +845,7 @@ or an empty string if none."
(propertize "Nothing stashed"
'help-echo vc-git-stash-shared-help
'keymap vc-git-stash-shared-map
- 'face 'vc-dir-ignored))))))
+ 'face 'vc-dir-header-value))))))
(defun vc-git-branches ()
"Return the existing branches, as a list of strings.
@@ -868,12 +878,12 @@ The car of the list is the current branch."
(when flist
(vc-git-command nil 0 flist "update-index" "--add" "--"))
(when dlist
- (vc-git-command nil 0 dlist "add"))))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add"))))
-(defalias 'vc-git-responsible-p 'vc-git-root)
+(defalias 'vc-git-responsible-p #'vc-git-root)
(defun vc-git-unregister (file)
- (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--cached" "--"))
(declare-function log-edit-mode "log-edit" ())
(declare-function log-edit-toggle-header "log-edit" (header value))
@@ -904,9 +914,9 @@ If toggling on, also insert its message into the buffer."
(defvar vc-git-log-edit-mode-map
(let ((map (make-sparse-keymap "Git-Log-Edit")))
- (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
- (define-key map "\C-c\C-n" 'vc-git-log-edit-toggle-no-verify)
- (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
+ (define-key map "\C-c\C-s" #'vc-git-log-edit-toggle-signoff)
+ (define-key map "\C-c\C-n" #'vc-git-log-edit-toggle-no-verify)
+ (define-key map "\C-c\C-e" #'vc-git-log-edit-toggle-amend)
map))
(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
@@ -940,7 +950,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(lambda (value) (when (equal value "yes") (list argument)))))
;; When operating on the whole tree, better pass "-a" than ".", since "."
;; fails when we're committing a merge.
- (apply 'vc-git-command nil 0 (if only files)
+ (apply #'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files))
(nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file))
(list "commit" "-m"))
@@ -967,7 +977,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(coding-system-for-write 'binary)
(fullname
(let ((fn (vc-git--run-command-string
- file "ls-files" "-z" "--full-name" "--")))
+ (vc-git--literal-pathspec file) "ls-files" "-z" "--full-name" "--")))
;; ls-files does not return anything when looking for a
;; revision of a file that has been renamed or removed.
(if (string= fn "")
@@ -984,14 +994,14 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(vc-git-root file)))
(defun vc-git-checkout (file &optional rev)
- (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
"Revert FILE to the version stored in the git repository."
(if contents-done
(vc-git-command nil 0 file "update-index" "--")
- (vc-git-command nil 0 file "reset" "-q" "--")
- (vc-git-command nil nil file "checkout" "-q" "--")))
+ (vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--")
+ (vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q" "--")))
(defvar vc-git-error-regexp-alist
'(("^ \\(.+\\)\\> *|" 1 nil nil 0))
@@ -1023,13 +1033,13 @@ If PROMPT is non-nil, prompt for the Git command to run."
args (cddr args)))
(setq args (nconc args extra-args))
(require 'vc-dispatcher)
- (apply 'vc-do-async-command buffer root git-program command args)
+ (apply #'vc-do-async-command buffer root git-program command args)
(with-current-buffer buffer
(vc-run-delayed
(vc-compilation-mode 'git)
(setq-local compile-command
(concat git-program " " command " "
- (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'.
@@ -1067,7 +1077,7 @@ This prompts for a branch to merge from."
branches
(cons "FETCH_HEAD" branches))
nil t)))
- (apply 'vc-do-async-command buffer root vc-git-program "merge"
+ (apply #'vc-do-async-command buffer root vc-git-program "merge"
(list merge-source))
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
@@ -1075,7 +1085,7 @@ This prompts for a branch to merge from."
(defun vc-git-conflicted-files (directory)
"Return the list of files with conflicts in DIRECTORY."
(let* ((status
- (vc-git--run-command-string directory "status" "--porcelain" "--"))
+ (vc-git--run-command-string (vc-git--literal-pathspec directory) "status" "--porcelain" "--"))
(lines (when status (split-string status "\n" 'omit-nulls)))
files)
(dolist (line lines files)
@@ -1114,7 +1124,7 @@ This prompts for a branch to merge from."
(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))))
+ (remove-hook 'after-save-hook #'vc-git-resolve-when-done t))))
(defun vc-git-find-file-hook ()
"Activate `smerge-mode' if there is a conflict."
@@ -1125,7 +1135,7 @@ This prompts for a branch to merge from."
(re-search-forward "^<<<<<<< " nil 'noerror)))
(smerge-start-session)
(when vc-git-resolve-conflicts
- (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local))
+ (add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local))
(vc-message-unresolved-conflicts buffer-file-name)))
;;; HISTORY FUNCTIONS
@@ -1137,6 +1147,8 @@ This prompts for a branch to merge from."
:type 'boolean
:version "26.1")
+(autoload 'vc-switches "vc")
+
(defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
"Print commit log associated with FILES into specified BUFFER.
If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
@@ -1153,8 +1165,8 @@ If LIMIT is a revision string, use it as an end-revision."
;; read-only.
(let ((inhibit-read-only t))
(with-current-buffer buffer
- (apply 'vc-git-command buffer
- 'async files
+ (apply #'vc-git-command buffer
+ 'async (vc-git--literal-pathspecs files)
(append
'("log" "--no-color")
(when (and vc-git-print-log-follow
@@ -1168,9 +1180,10 @@ If LIMIT is a revision string, use it as an end-revision."
(when shortlog
`("--graph" "--decorate" "--date=short"
,(format "--pretty=tformat:%s"
- (car vc-git-root-log-format))
- "--abbrev-commit"))
- (when (numberp limit)
+ (car vc-git-root-log-format))
+ "--abbrev-commit"))
+ vc-git-log-switches
+ (when (numberp limit)
(list "-n" (format "%s" limit)))
(when start-revision
(if (and limit (not (numberp limit)))
@@ -1223,11 +1236,11 @@ log entries."
(read-shell-command
"Search log with command: "
(format "%s %s" vc-git-program
- (mapconcat 'identity args " "))
+ (mapconcat #'identity args " "))
'vc-git-history)
" " t))))
(vc-setup-buffer buffer)
- (apply 'vc-git-command buffer 'async nil args)))
+ (apply #'vc-git-command buffer 'async nil args)))
(defun vc-git-mergebase (rev1 &optional rev2)
(unless rev2 (setq rev2 "HEAD"))
@@ -1298,7 +1311,7 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-expanded-log-entry (revision)
(with-temp-buffer
- (apply 'vc-git-command t nil nil (list "log" revision "-1" "--"))
+ (apply #'vc-git-command t nil nil (list "log" revision "-1" "--"))
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
@@ -1318,7 +1331,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
;; but since Git is one of the two backends that support this operation
;; so far, it's hard to tell; hg doesn't need this.
(with-temp-buffer
- (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer))
+ (vc-call-backend 'git 'diff (list file) "HEAD" nil (current-buffer))
(goto-char (point-min))
(let ((last-offset 0)
(from-offset nil)
@@ -1391,8 +1404,6 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
samp coding-system-for-read t)))
(setq coding-system-for-read 'undecided)))
-(autoload 'vc-switches "vc")
-
(defun vc-git-diff (files &optional rev1 rev2 buffer _async)
"Get a difference report using Git between two revisions of FILES."
(let (process-file-side-effects
@@ -1406,7 +1417,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(if vc-git-diff-switches
(apply #'vc-git-command (or buffer "*vc-diff*")
1 ; bug#21969
- files
+ (vc-git--literal-pathspecs files)
command
"--exit-code"
(append (vc-switches 'git 'diff)
@@ -1414,7 +1425,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(vc-git-command (or buffer "*vc-diff*") 1 files
"difftool" "--exit-code" "--no-prompt" "-x"
(concat "diff "
- (mapconcat 'identity
+ (mapconcat #'identity
(vc-switches nil 'diff) " "))
rev1 rev2 "--"))))
@@ -1491,7 +1502,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(let* ((fname (file-relative-name file))
(prev-rev (with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-2" rev "--" fname)
+ (vc-git--out-ok "rev-list" "-2" rev "--" (vc-git--literal-pathspec fname))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1519,7 +1530,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "-1" rev "--" file)
+ (vc-git--out-ok "rev-list" "-1" rev "--" (vc-git--literal-pathspec file))
(goto-char (point-max))
(bolp)
(zerop (forward-line -1))
@@ -1531,7 +1542,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(and current-rev
(with-temp-buffer
(and
- (vc-git--out-ok "rev-list" "HEAD" "--" file)
+ (vc-git--out-ok "rev-list" "HEAD" "--" (vc-git--literal-pathspec file))
(goto-char (point-min))
(search-forward current-rev nil t)
(zerop (forward-line -1))
@@ -1541,13 +1552,13 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(or (vc-git-symbolic-commit next-rev) next-rev)))
(defun vc-git-delete-file (file)
- (vc-git-command nil 0 file "rm" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs file) "rm" "-f" "--"))
(defun vc-git-rename-file (old new)
- (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs (list old new)) "mv" "-f" "--"))
(defun vc-git-mark-resolved (files)
- (vc-git-command nil 0 files "add"))
+ (vc-git-command nil 0 (vc-git--literal-pathspecs files) "add"))
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
@@ -1775,7 +1786,7 @@ The difference to vc-do-command is that this function always invokes
,@(when revert-buffer-in-progress-p
'("GIT_OPTIONAL_LOCKS=0")))
process-environment)))
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
+ (apply #'vc-do-command (or buffer "*vc*") okstatus vc-git-program
;; https://debbugs.gnu.org/16897
(unless (and (not (cdr-safe file-or-list))
(let ((file (or (car-safe file-or-list)
@@ -1809,10 +1820,10 @@ The difference to vc-do-command is that this function always invokes
,@(when revert-buffer-in-progress-p
'("GIT_OPTIONAL_LOCKS=0")))
process-environment)))
- (apply 'process-file vc-git-program nil buffer nil "--no-pager" command args)))
+ (apply #'process-file vc-git-program nil buffer nil "--no-pager" command args)))
(defun vc-git--out-ok (command &rest args)
- (zerop (apply 'vc-git--call '(t nil) command args)))
+ (zerop (apply #'vc-git--call '(t nil) command args)))
(defun vc-git--run-command-string (file &rest args)
"Run a git command on FILE and return its output as string.
@@ -1820,7 +1831,7 @@ FILE can be nil."
(let* ((ok t)
(str (with-output-to-string
(with-current-buffer standard-output
- (unless (apply 'vc-git--out-ok
+ (unless (apply #'vc-git--out-ok
(if file
(append args (list (file-relative-name
file)))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1d163a64ab2..4a64caa36b8 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -26,12 +26,6 @@
;; This is a mercurial version control backend
-;;; Thanks:
-
-;;; Bugs:
-
-;;; Installation:
-
;;; Todo:
;; 1) Implement the rest of the vc interface. See the comment at the
@@ -97,9 +91,6 @@
;; without even using `hg' (this way even if you don't have `hg' installed,
;; Emacs is able to tell you this file is under mercurial's control).
-;;; History:
-;;
-
;;; Code:
(require 'cl-lib)
@@ -124,8 +115,7 @@
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "22.2"
- :group 'vc-hg)
+ :version "22.2")
(defcustom vc-hg-diff-switches t ; Hg doesn't support common args like -u
"String or list of strings specifying switches for Hg diff under VC.
@@ -134,8 +124,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "23.1"
- :group 'vc-hg)
+ :version "23.1")
(defcustom vc-hg-annotate-switches '("-u" "--follow")
"String or list of strings specifying switches for hg annotate under VC.
@@ -145,8 +134,7 @@ switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "25.1"
- :group 'vc-hg)
+ :version "25.1")
(defcustom vc-hg-revert-switches nil
"String or list of strings specifying switches for hg revert
@@ -154,13 +142,11 @@ under VC."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "27.1"
- :group 'vc-hg)
+ :version "27.1")
(defcustom vc-hg-program "hg"
"Name of the Mercurial executable (excluding any arguments)."
- :type 'string
- :group 'vc-hg)
+ :type 'string)
(defcustom vc-hg-root-log-format
`(,(concat "{rev}:{ifeq(branch, 'default','', '{branch}')}"
@@ -183,7 +169,6 @@ REGEXP is a regular expression matching the resulting Mercurial
output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
:type '(list string regexp (repeat sexp))
- :group 'vc-hg
:version "24.5")
(defcustom vc-hg-create-bookmark t
@@ -311,8 +296,7 @@ If no list entry produces a useful revision, return `nil'."
(const :tag "Active bookmark" builtin-active-bookmark)
(string :tag "Hg template")
(function :tag "Custom")))
- :version "26.1"
- :group 'vc-hg)
+ :version "26.1")
(defcustom vc-hg-use-file-version-for-mode-line-version nil
"When enabled, the modeline contains revision information for the visited file.
@@ -320,8 +304,7 @@ When not, the revision in the modeline is for the repository
working copy. `nil' is the much faster setting for
large repositories."
:type 'boolean
- :version "26.1"
- :group 'vc-hg)
+ :version "26.1")
(defun vc-hg--active-bookmark-internal (rev)
(when (equal rev ".")
@@ -413,8 +396,7 @@ specific file to query."
"String or list of strings specifying switches for hg log under VC."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
- (repeat :tag "Argument List" :value ("") string))
- :group 'vc-hg)
+ (repeat :tag "Argument List" :value ("") string)))
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -442,7 +424,7 @@ If LIMIT is non-nil, show no more than this many entries."
(let ((inhibit-read-only t))
(with-current-buffer
buffer
- (apply 'vc-hg-command buffer 'async files "log"
+ (apply #'vc-hg-command buffer 'async files "log"
(nconc
(when start-revision (list (format "-r%s:0" start-revision)))
(when limit (list "-l" (format "%s" limit)))
@@ -666,8 +648,7 @@ directly instead of always running Mercurial. We try to be safe
against Mercurial data structure format changes and always fall
back to running Mercurial directly."
:type 'boolean
- :version "26.1"
- :group 'vc-hg)
+ :version "26.1")
(defsubst vc-hg--read-u8 ()
"Read and advance over an unsigned byte.
@@ -870,8 +851,8 @@ if we don't understand a construct, we signal
(push "\\[" parts))
(t
(let ((x (substring glob i j)))
- (setf x (replace-regexp-in-string
- "\\\\" "\\\\" x t t))
+ (setf x (string-replace
+ "\\" "\\\\" x))
(setf i (1+ j))
(cond ((eq (aref x 0) ?!)
(setf (aref x 0) ?^))
@@ -1177,7 +1158,7 @@ hg binary."
"Create a new Mercurial repository."
(vc-hg-command nil 0 nil "init"))
-(defalias 'vc-hg-responsible-p 'vc-hg-root)
+(defalias 'vc-hg-responsible-p #'vc-hg-root)
(defun vc-hg-unregister (file)
"Unregister FILE from hg."
@@ -1200,7 +1181,7 @@ If toggling on, also insert its message into the buffer."
(defvar vc-hg-log-edit-mode-map
(let ((map (make-sparse-keymap "Hg-Log-Edit")))
- (define-key map "\C-c\C-e" 'vc-hg-log-edit-toggle-amend)
+ (define-key map "\C-c\C-e" #'vc-hg-log-edit-toggle-amend)
map))
(define-derived-mode vc-hg-log-edit-mode log-edit-mode "Log-Edit/hg"
@@ -1214,7 +1195,7 @@ REV is ignored."
(lambda (value)
(when (equal value "yes")
(list "--amend")))))
- (apply 'vc-hg-command nil 0 files
+ (apply #'vc-hg-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers `(("Author" . "--user")
("Date" . "--date")
@@ -1252,7 +1233,7 @@ REV is the revision to check out into WORKFILE."
(unless (re-search-forward "^<<<<<<< " nil t)
(vc-hg-command nil 0 buffer-file-name "resolve" "-m")
;; Remove the hook so that it is not called multiple times.
- (remove-hook 'after-save-hook 'vc-hg-resolve-when-done t))))
+ (remove-hook 'after-save-hook #'vc-hg-resolve-when-done t))))
(defun vc-hg-find-file-hook ()
(when (and buffer-file-name
@@ -1268,7 +1249,7 @@ REV is the revision to check out into WORKFILE."
;; Hg may not recognize "conflict" as a state, but we can do better.
(vc-file-setprop buffer-file-name 'vc-state 'conflict)
(smerge-start-session)
- (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t)
+ (add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t)
(vc-message-unresolved-conflicts buffer-file-name)))
@@ -1403,8 +1384,8 @@ This runs the command \"hg summary\"."
(cons (capitalize (match-string 1)) (match-string 2))
(cons "" (buffer-substring (point) (line-end-position))))))
(concat
- (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face)
- (propertize (cdr entry) 'face 'font-lock-variable-name-face)))
+ (propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header)
+ (propertize (cdr entry) 'face 'vc-dir-header-value)))
result)
(forward-line))
(nreverse result))
@@ -1443,7 +1424,7 @@ commands, which only operated on marked files."
(apply #'vc-hg-command
nil 0 nil
command
- (apply 'nconc
+ (apply #'nconc
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
@@ -1463,18 +1444,18 @@ commands, which only operated on marked files."
(setq hg-program (car args)
command (cadr args)
args (cddr args)))
- (apply 'vc-do-async-command buffer root hg-program command args)
+ (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))
+ (apply #'vc-do-command buffer nil hg-program nil cmd))
(vc-compilation-mode 'hg)
(setq-local compile-command
(concat hg-program " " command " "
- (mapconcat 'identity args " ")
+ (mapconcat #'identity args " ")
(mapconcat (lambda (args)
(concat " && " hg-program " "
- (mapconcat 'identity
+ (mapconcat #'identity
args " ")))
post-processing "")))
(setq-local compilation-directory root)
@@ -1525,7 +1506,7 @@ This runs the command \"hg merge\"."
;; Disable pager.
(process-environment (cons "HGPLAIN=1" process-environment))
(branch (vc-read-revision "Revision to merge: ")))
- (apply 'vc-do-async-command buffer root vc-hg-program
+ (apply #'vc-do-async-command buffer root vc-hg-program
(append '("--config" "ui.report_untrusted=0" "merge")
(unless (string= branch "") (list branch))))
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
@@ -1540,7 +1521,8 @@ This function differs from vc-do-command in that it invokes
;; Disable pager.
(let ((process-environment (cons "HGPLAIN=1" process-environment))
(flags (append '("--config" "ui.report_untrusted=0") flags)))
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list
+ (apply #'vc-do-command (or buffer "*vc*")
+ okstatus vc-hg-program file-or-list
(if (stringp vc-hg-global-switches)
(cons vc-hg-global-switches flags)
(append vc-hg-global-switches
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index f910f9d5496..4b3c829a2c6 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -50,50 +50,42 @@
(defface vc-up-to-date-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file is up to date."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-needs-update-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file needs update."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-locked-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file locked."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-locally-added-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file is locally added."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-conflict-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file contains merge conflicts."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-removed-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file was removed from the VC system."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-missing-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file is missing from the file system."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
(defface vc-edited-state
'((default :inherit vc-state-base))
"Face for VC modeline state when the file is edited."
- :version "25.1"
- :group 'vc-faces)
+ :version "25.1")
;; Customization Variables (the rest is in vc.el)
@@ -871,31 +863,31 @@ In the latter case, VC mode is deactivated for this buffer."
;; (autoload 'vc-prefix-map "vc" nil nil 'keymap)
(defvar vc-prefix-map
(let ((map (make-sparse-keymap)))
- (define-key map "a" 'vc-update-change-log)
- (define-key map "b" 'vc-switch-backend)
- (define-key map "d" 'vc-dir)
- (define-key map "g" 'vc-annotate)
- (define-key map "G" 'vc-ignore)
- (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)
- (define-key map "I" 'vc-log-incoming)
- (define-key map "O" 'vc-log-outgoing)
- (define-key map "ML" 'vc-log-mergebase)
- (define-key map "MD" 'vc-diff-mergebase)
- (define-key map "m" 'vc-merge)
- (define-key map "r" 'vc-retrieve-tag)
- (define-key map "s" 'vc-create-tag)
- (define-key map "u" 'vc-revert)
- (define-key map "v" 'vc-next-action)
- (define-key map "+" 'vc-update)
+ (define-key map "a" #'vc-update-change-log)
+ (define-key map "b" #'vc-switch-backend)
+ (define-key map "d" #'vc-dir)
+ (define-key map "g" #'vc-annotate)
+ (define-key map "G" #'vc-ignore)
+ (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)
+ (define-key map "I" #'vc-log-incoming)
+ (define-key map "O" #'vc-log-outgoing)
+ (define-key map "ML" #'vc-log-mergebase)
+ (define-key map "MD" #'vc-diff-mergebase)
+ (define-key map "m" #'vc-merge)
+ (define-key map "r" #'vc-retrieve-tag)
+ (define-key map "s" #'vc-create-tag)
+ (define-key map "u" #'vc-revert)
+ (define-key map "v" #'vc-next-action)
+ (define-key map "+" #'vc-update)
;; I'd prefer some kind of symmetry with vc-update:
- (define-key map "P" 'vc-push)
- (define-key map "=" 'vc-diff)
- (define-key map "D" 'vc-root-diff)
- (define-key map "~" 'vc-revision-other-window)
- (define-key map "x" 'vc-delete-file)
+ (define-key map "P" #'vc-push)
+ (define-key map "=" #'vc-diff)
+ (define-key map "D" #'vc-root-diff)
+ (define-key map "~" #'vc-revision-other-window)
+ (define-key map "x" #'vc-delete-file)
map))
(fset 'vc-prefix-map vc-prefix-map)
(define-key ctl-x-map "v" 'vc-prefix-map)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 3b610a1e4fe..ea69893071a 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -46,8 +46,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "23.1"
- :group 'vc-mtn)
+ :version "23.1")
(defcustom vc-mtn-annotate-switches nil
"String or list of strings specifying switches for mtn annotate under VC.
@@ -57,13 +56,11 @@ switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "25.1"
- :group 'vc-mtn)
+ :version "25.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
- :type 'string
- :group 'vc-mtn)
+ :type 'string)
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
@@ -115,7 +112,7 @@ switches."
(let ((process-environment
;; Avoid localization of messages so we can parse the output.
(cons "LC_MESSAGES=C" process-environment)))
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-mtn-program
+ (apply #'vc-do-command (or buffer "*vc*") okstatus vc-mtn-program
files flags)))
(defun vc-mtn-state (file)
@@ -176,8 +173,7 @@ switches."
'(("\\`[^:/#]*[:/#]" . "")) ;Drop the host part.
"Rewrite rules to shorten Mtn's revision names on the mode-line."
:type '(repeat (cons regexp string))
- :version "22.2"
- :group 'vc-mtn)
+ :version "22.2")
(defun vc-mtn-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
@@ -203,7 +199,7 @@ switches."
(declare-function log-edit-extract-headers "log-edit" (headers string))
(defun vc-mtn-checkin (files comment &optional _rev)
- (apply 'vc-mtn-command nil 0 files
+ (apply #'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
("Date" . "--date"))
@@ -227,7 +223,7 @@ switches."
_SHORTLOG is ignored.
If START-REVISION is non-nil, it is the newest revision to show.
If LIMIT is non-nil, show no more than this many entries."
- (apply 'vc-mtn-command buffer 0 files "log"
+ (apply #'vc-mtn-command buffer 0 files "log"
(append
(when start-revision (list "--from" (format "%s" start-revision)))
(when limit (list "--last" (format "%s" limit))))))
@@ -258,7 +254,7 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-mtn-diff (files &optional rev1 rev2 buffer _async)
"Get a difference report using monotone between two revisions of FILES."
- (apply 'vc-mtn-command (or buffer "*vc-diff*")
+ (apply #'vc-mtn-command (or buffer "*vc-diff*")
1 ; bug#21969
files "diff"
(append
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 8d64ee5cc57..6ffc1a8a2ff 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -58,8 +58,7 @@
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
(string :tag "Specified")
- (const :tag "Unknown" unknown))
- :group 'vc-rcs)
+ (const :tag "Unknown" unknown)))
(defcustom vc-rcs-register-switches nil
"Switches for registering a file in RCS.
@@ -70,8 +69,7 @@ If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "21.1"
- :group 'vc-rcs)
+ :version "21.1")
(defcustom vc-rcs-diff-switches nil
"String or list of strings specifying switches for RCS diff under VC.
@@ -80,21 +78,18 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "21.1"
- :group 'vc-rcs)
+ :version "21.1")
(defcustom vc-rcs-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
- :version "24.1" ; no longer consult the obsolete vc-header-alist
- :group 'vc-rcs)
+ :version "24.1") ; no longer consult the obsolete vc-header-alist
(defcustom vc-rcsdiff-knows-brief nil
"Indicates whether rcsdiff understands the --brief option.
The value is either `yes', `no', or nil. If it is nil, VC tries
to use --brief and sets this variable to remember whether it worked."
- :type '(choice (const :tag "Work out" nil) (const yes) (const no))
- :group 'vc-rcs)
+ :type '(choice (const :tag "Work out" nil) (const yes) (const no)))
;; This needs to be autoloaded because vc-rcs-registered uses it (via
;; vc-default-registered), and vc-hooks needs to be able to check
@@ -109,8 +104,7 @@ For a description of possible values, see `vc-check-master-templates'."
(repeat :tag "User-specified"
(choice string
function)))
- :version "21.1"
- :group 'vc-rcs)
+ :version "21.1")
;;; Properties of the backend
@@ -379,7 +373,7 @@ whether to remove it."
"Retrieve a copy of a saved version of FILE. If FILE is a directory,
attempt the checkout for all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS))
+ (mapc #'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
@@ -445,7 +439,7 @@ attempt the checkout for all registered files beneath it."
"Revert FILE to the version it was based on. If FILE is a directory,
revert all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS))
+ (mapc #'vc-rcs-revert (vc-expand-dirs (list file) 'RCS))
(vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
@@ -488,7 +482,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
If FILE is a directory, steal the lock on all registered files beneath it.
Needs RCS 5.6.2 or later for -M."
(if (file-directory-p file)
- (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS))
+ (mapc #'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS))
(vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev))
;; Do a real checkout after stealing the lock, so that we see
;; expanded headers.
@@ -539,7 +533,7 @@ Remaining arguments are ignored.
If FILE is a directory the operation is applied to all registered
files beneath it."
(vc-do-command (or buffer "*vc*") 0 "rlog"
- (mapcar 'vc-master-name (vc-expand-dirs files 'RCS)))
+ (mapcar #'vc-master-name (vc-expand-dirs files 'RCS)))
(with-current-buffer (or buffer "*vc*")
(vc-rcs-print-log-cleanup))
(when limit 'limit-unsupported))
@@ -1344,7 +1338,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
(push `(,(to-eol)
,(k-semi 'date
(lambda ()
- (let ((ls (mapcar 'string-to-number
+ (let ((ls (mapcar #'string-to-number
(split-string
(buffer-substring-no-properties
b e)
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 3d3f4048052..92cce5f13a8 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -55,8 +55,7 @@ If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "21.1"
- :group 'vc-sccs)
+ :version "21.1")
(defcustom vc-sccs-diff-switches nil
"String or list of strings specifying switches for SCCS diff under VC.
@@ -65,14 +64,12 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "21.1"
- :group 'vc-sccs)
+ :version "21.1")
(defcustom vc-sccs-header '("%W%")
"Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
- :version "24.1" ; no longer consult the obsolete vc-header-alist
- :group 'vc-sccs)
+ :version "24.1") ; no longer consult the obsolete vc-header-alist
;; This needs to be autoloaded because vc-sccs-registered uses it (via
;; vc-default-registered), and vc-hooks needs to be able to check
@@ -87,8 +84,7 @@ For a description of possible values, see `vc-check-master-templates'."
(repeat :tag "User-specified"
(choice string
function)))
- :version "21.1"
- :group 'vc-sccs)
+ :version "21.1")
;;;
@@ -163,7 +159,7 @@ For a description of possible values, see `vc-check-master-templates'."
"Write the SCCS version of input file FILE to output file OUTFILE.
Optional string REV is a revision."
(with-temp-buffer
- (apply 'vc-sccs-do-command t 0 "get" (vc-master-name file)
+ (apply #'vc-sccs-do-command t 0 "get" (vc-master-name file)
(append '("-s" "-p" "-k") ; -k: no keyword expansion
(if rev (list (concat "-r" rev)))))
(write-region nil nil outfile nil 'silent)))
@@ -185,7 +181,7 @@ Optional string REV is a revision."
(defun vc-sccs-do-command (buffer okstatus command file-or-list &rest flags)
;; (let ((load-path (append vc-sccs-path load-path)))
;; (apply 'vc-do-command buffer okstatus command file-or-list flags))
- (apply 'vc-do-command (or buffer "*vc*") okstatus "sccs" file-or-list command flags))
+ (apply #'vc-do-command (or buffer "*vc*") okstatus "sccs" file-or-list command flags))
(defun vc-sccs-create-repo ()
"Create a new SCCS repository."
@@ -207,7 +203,7 @@ to the SCCS command."
(let ((vc-master-name
(or project-file
(format (car vc-sccs-master-templates) dirname basename))))
- (apply 'vc-sccs-do-command nil 0 "admin" vc-master-name
+ (apply #'vc-sccs-do-command nil 0 "admin" vc-master-name
"-fb"
(concat "-i" (file-relative-name file))
(and comment (concat "-y" comment))
@@ -225,14 +221,14 @@ to the SCCS command."
(defun vc-sccs-checkin (files comment &optional rev)
"SCCS-specific version of `vc-backend-checkin'."
(dolist (file (vc-expand-dirs files 'SCCS))
- (apply 'vc-sccs-do-command nil 0 "delta" (vc-master-name file)
+ (apply #'vc-sccs-do-command nil 0 "delta" (vc-master-name file)
(if rev (concat "-r" rev))
(concat "-y" comment)
(vc-switches 'SCCS 'checkin))
(vc-sccs-do-command nil 0 "get" (vc-master-name file))))
(defun vc-sccs-find-revision (file rev buffer)
- (apply 'vc-sccs-do-command
+ (apply #'vc-sccs-do-command
buffer 0 "get" (vc-master-name file)
"-s" ;; suppress diagnostic output
"-p"
@@ -247,7 +243,7 @@ If FILE is a directory, all version-controlled files beneath are checked out.
EDITABLE non-nil means that the file should be writable and
locked. REV is the revision to check out."
(if (file-directory-p file)
- (mapc 'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS))
+ (mapc #'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
@@ -267,7 +263,7 @@ locked. REV is the revision to check out."
(and rev (or (string= rev "")
(not (stringp rev)))
(setq rev nil))
- (apply 'vc-sccs-do-command nil 0 "get" (vc-master-name file)
+ (apply #'vc-sccs-do-command nil 0 "get" (vc-master-name file)
"-e"
(and rev (concat "-r" (vc-sccs-lookup-triple file rev)))
switches))))
@@ -277,7 +273,7 @@ locked. REV is the revision to check out."
"Revert FILE to the version it was based on. If FILE is a directory,
revert all subfiles."
(if (file-directory-p file)
- (mapc 'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS))
+ (mapc #'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS))
(vc-sccs-do-command nil 0 "unget" (vc-master-name file))
(vc-sccs-do-command nil 0 "get" (vc-master-name file))
;; Checking out explicit revisions is not supported under SCCS, yet.
@@ -288,7 +284,7 @@ revert all subfiles."
(defun vc-sccs-steal-lock (file &optional rev)
"Steal the lock on the current workfile for FILE and revision REV."
(if (file-directory-p file)
- (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS))
+ (mapc #'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS))
(vc-sccs-do-command nil 0 "unget"
(vc-master-name file) "-n" (if rev (concat "-r" rev)))
(vc-sccs-do-command nil 0 "get"
@@ -309,7 +305,7 @@ revert all subfiles."
"Print commit log associated with FILES into specified BUFFER.
Remaining arguments are ignored."
(setq files (vc-expand-dirs files 'SCCS))
- (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-master-name files))
+ (vc-sccs-do-command buffer 0 "prs" (mapcar #'vc-master-name files))
(when limit 'limit-unsupported))
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -338,7 +334,7 @@ Remaining arguments are ignored."
(fake-command
(format "diff%s %s"
(if fake-flags
- (concat " " (mapconcat 'identity fake-flags " "))
+ (concat " " (mapconcat #'identity fake-flags " "))
"")
(vc-delistify files)))
(status 0)
@@ -362,7 +358,7 @@ Remaining arguments are ignored."
(cons "LC_MESSAGES=C" process-environment))
(w32-quote-process-args t)
(this-status
- (apply 'process-file "diff" nil t nil
+ (apply #'process-file "diff" nil t nil
(append (vc-switches 'SCCS 'diff)
(list (file-local-name oldfile)
(or newfile
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index 201d69d79a1..faba5bce2b7 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -97,13 +97,11 @@
If nil, VC itself computes this value when it is first needed."
:type '(choice (const :tag "Auto" nil)
(string :tag "Specified")
- (const :tag "Unknown" unknown))
- :group 'vc-src)
+ (const :tag "Unknown" unknown)))
(defcustom vc-src-program "src"
"Name of the SRC executable (excluding any arguments)."
- :type 'string
- :group 'vc-src)
+ :type 'string)
(defcustom vc-src-diff-switches nil
"String or list of strings specifying switches for SRC diff under VC.
@@ -111,8 +109,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:type '(choice (const :tag "Unspecified" nil)
(const :tag "None" t)
(string :tag "Argument String")
- (repeat :tag "Argument List" :value ("") string))
- :group 'vc-src)
+ (repeat :tag "Argument List" :value ("") string)))
;; This needs to be autoloaded because vc-src-registered uses it (via
;; vc-default-registered), and vc-hooks needs to be able to check
@@ -126,8 +123,7 @@ For a description of possible values, see `vc-check-master-templates'."
'("%s.src/%s,v"))
(repeat :tag "User-specified"
(choice string
- function)))
- :group 'vc-src)
+ function))))
;;; Properties of the backend
@@ -221,7 +217,7 @@ This function differs from vc-do-command in that it invokes `vc-src-program'."
(setq file-list (list "--" file-or-list)))
(file-or-list
(setq file-list (cons "--" file-or-list))))
- (apply 'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags)))
+ (apply #'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags)))
(defun vc-src-working-revision (file)
"SRC-specific version of `vc-working-revision'."
@@ -275,7 +271,7 @@ REV is the revision to check out into WORKFILE."
"Revert FILE to the version it was based on. If FILE is a directory,
revert all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-src-revert (vc-expand-dirs (list file) 'SRC))
+ (mapc #'vc-src-revert (vc-expand-dirs (list file) 'SRC))
(vc-src-command nil file "co")))
(defun vc-src-modify-change-comment (files rev comment)
@@ -290,8 +286,7 @@ directory the operation is applied to all registered files beneath it."
"String or list of strings specifying switches for src log under VC."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
- (repeat :tag "Argument List" :value ("") string))
- :group 'vc-src)
+ (repeat :tag "Argument List" :value ("") string)))
(defun vc-src-print-log (files buffer &optional shortlog _start-revision limit)
"Print commit log associated with FILES into specified BUFFER.
@@ -307,7 +302,7 @@ If LIMIT is non-nil, show no more than this many entries."
(let ((inhibit-read-only t))
(with-current-buffer
buffer
- (apply 'vc-src-command buffer files (if shortlog "list" "log")
+ (apply #'vc-src-command buffer files (if shortlog "list" "log")
(nconc
;;(when start-revision (list (format "%s-1" start-revision)))
(when limit (list "-l" (format "%s" limit)))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index da5471107d2..544a6c769fc 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -47,8 +47,7 @@
;; FIXME there is also svnadmin.
(defcustom vc-svn-program "svn"
"Name of the SVN executable."
- :type 'string
- :group 'vc-svn)
+ :type 'string)
;; Might be nice if svn defaulted to non-interactive if stdin not tty.
;; https://svn.haxx.se/dev/archive-2008-05/0762.shtml
@@ -64,8 +63,7 @@ hanging while prompting for authorization."
(repeat :tag "Argument List"
:value ("")
string))
- :version "24.4"
- :group 'vc-svn)
+ :version "24.4")
(defcustom vc-svn-register-switches nil
"Switches for registering a file into SVN.
@@ -76,8 +74,7 @@ If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "22.1"
- :group 'vc-svn)
+ :version "22.1")
(defcustom vc-svn-diff-switches
t ;`svn' doesn't support common args like -c or -b.
@@ -92,8 +89,7 @@ If you want to force an empty list of arguments, use t."
(repeat :tag "Argument List"
:value ("")
string))
- :version "22.1"
- :group 'vc-svn)
+ :version "22.1")
(defcustom vc-svn-annotate-switches nil
"String or list of strings specifying switches for svn annotate under VC.
@@ -103,14 +99,12 @@ switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "25.1"
- :group 'vc-svn)
+ :version "25.1")
(defcustom vc-svn-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
- :type '(repeat string)
- :group 'vc-svn)
+ :type '(repeat string))
;; We want to autoload it for use by the autoloaded version of
;; vc-svn-registered, but we want the value to be compiled at startup, not
@@ -198,7 +192,7 @@ switches."
(let ((state (cdr (assq (aref (match-string 1) 0) state-map)))
(propstat (cdr (assq (aref (match-string 2) 0) state-map)))
(filename (if (memq system-type '(windows-nt ms-dos))
- (replace-regexp-in-string "\\\\" "/" (match-string 4))
+ (string-replace "\\" "/" (match-string 4))
(match-string 4))))
(and (memq propstat '(conflict edited))
(not (eq state 'conflict)) ; conflict always wins
@@ -239,8 +233,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
(concat
(cond (repo
(concat
- (propertize "Repository : " 'face 'font-lock-type-face)
- (propertize repo 'face 'font-lock-variable-name-face)))
+ (propertize "Repository : " 'face 'vc-dir-header)
+ (propertize repo 'face 'vc-dir-header-value)))
(t "")))))
(defun vc-svn-working-revision (file)
@@ -305,19 +299,19 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
The COMMENT argument is ignored This does an add but not a commit.
Passes either `vc-svn-register-switches' or `vc-register-switches'
to the SVN command."
- (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
+ (apply #'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register)))
(defun vc-svn-root (file)
(vc-find-root file vc-svn-admin-directory))
-(defalias 'vc-svn-responsible-p 'vc-svn-root)
+(defalias 'vc-svn-responsible-p #'vc-svn-root)
(declare-function log-edit-extract-headers "log-edit" (headers string))
(defun vc-svn-checkin (files comment &optional _extra-args-ignored)
"SVN-specific version of `vc-backend-checkin'."
(let ((status (apply
- 'vc-svn-command nil 1 files "ci"
+ #'vc-svn-command nil 1 files "ci"
(nconc (cons "-m" (log-edit-extract-headers nil comment))
(vc-switches 'SVN 'checkin)))))
(set-buffer "*vc*")
@@ -345,7 +339,7 @@ to the SVN command."
(defun vc-svn-find-revision (file rev buffer)
"SVN-specific retrieval of a specified version into a buffer."
(let (process-file-side-effects)
- (apply 'vc-svn-command
+ (apply #'vc-svn-command
buffer 0 file
"cat"
(and rev (not (string= rev ""))
@@ -391,7 +385,7 @@ DIRECTORY or absolute."
nil
;; Check out a particular version (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
- (apply 'vc-svn-command nil 0 file
+ (apply #'vc-svn-command nil 0 file
"update"
(cond
((null rev) "-rBASE")
@@ -563,27 +557,27 @@ If LIMIT is non-nil, show no more than this many entries."
(goto-char (point-min))
(if files
(dolist (file files)
- (insert "Working file: " file "\n")
- (apply
- 'vc-svn-command
- buffer
- 'async
- (list file)
- "log"
- (append
- (list
- (if start-revision
- (format "-r%s:1" start-revision)
- ;; By default Subversion only shows the log up to the
- ;; working revision, whereas we also want the log of the
- ;; subsequent commits. At least that's what the
- ;; vc-cvs.el code does.
- "-rHEAD:0"))
- (if (eq vc-log-view-type 'with-diff)
- (list "--diff"))
- (when limit (list "--limit" (format "%s" limit))))))
+ (insert "Working file: " file "\n")
+ (apply
+ #'vc-svn-command
+ buffer
+ 'async
+ (list file)
+ "log"
+ (append
+ (list
+ (if start-revision
+ (format "-r%s:1" start-revision)
+ ;; By default Subversion only shows the log up to the
+ ;; working revision, whereas we also want the log of the
+ ;; subsequent commits. At least that's what the
+ ;; vc-cvs.el code does.
+ "-rHEAD:0"))
+ (if (eq vc-log-view-type 'with-diff)
+ (list "--diff"))
+ (when limit (list "--limit" (format "%s" limit))))))
;; Dump log for the entire directory.
- (apply 'vc-svn-command buffer 0 nil "log"
+ (apply #'vc-svn-command buffer 0 nil "log"
(append
(list
(if start-revision (format "-r%s" start-revision) "-rHEAD:0"))
@@ -611,8 +605,8 @@ If LIMIT is non-nil, show no more than this many entries."
(if vc-svn-diff-switches
(vc-switches 'SVN 'diff)
(list (concat "--diff-cmd=" diff-command) "-x"
- (mapconcat 'identity (vc-switches nil 'diff) " ")))))
- (apply 'vc-svn-command buffer
+ (mapconcat #'identity (vc-switches nil 'diff) " ")))))
+ (apply #'vc-svn-command buffer
(if async 'async 0)
files "diff"
(append
@@ -671,7 +665,7 @@ NAME is assumed to be a URL."
"A wrapper around `vc-do-command' for use in vc-svn.el.
The difference to vc-do-command is that this function always invokes `svn',
and that it passes `vc-svn-global-switches' to it before FLAGS."
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
+ (apply #'vc-do-command (or buffer "*vc*") okstatus vc-svn-program file-or-list
(if (stringp vc-svn-global-switches)
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches flags))))
@@ -683,7 +677,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
(unless (re-search-forward "^<<<<<<< " nil t)
(vc-svn-command nil 0 buffer-file-name "resolved")
;; Remove the hook so that it is not called multiple times.
- (remove-hook 'after-save-hook 'vc-svn-resolve-when-done t))))
+ (remove-hook 'after-save-hook #'vc-svn-resolve-when-done t))))
;; Inspired by vc-arch-find-file-hook.
(defun vc-svn-find-file-hook ()
@@ -696,7 +690,7 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
;; There are conflict markers.
(progn
(smerge-start-session)
- (add-hook 'after-save-hook 'vc-svn-resolve-when-done nil t))
+ (add-hook 'after-save-hook #'vc-svn-resolve-when-done nil t))
;; There are no conflict markers. This is problematic: maybe it means
;; the conflict has been resolved and we should immediately call "svn
;; resolved", or it means that the file's type does not allow Svn to
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 00976a07d42..b75862e8a52 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -486,11 +486,19 @@
;; from ignored files.
;; When called from Lisp code, if DIRECTORY is non-nil, the
;; repository to use will be deduced by DIRECTORY.
+;; The default behavior is to add or remove a line from the file
+;; returned by the `find-ignore-file' function.
;;
;; - ignore-completion-table (directory)
;;
;; Return the completion table for files ignored by the current
;; version control system, e.g., the entries in `.gitignore' and
+;; `.bzrignore'. The default behavior is to read the contents of
+;; the file returned by the `find-ignore-file' function.
+;;
+;; - find-ignore-file
+;;
+;; Return the ignore file that controls FILE, e.g. `.gitignore' or
;; `.bzrignore'.
;;
;; - previous-revision (file rev)
@@ -979,6 +987,9 @@ be reported.
If NO-ERROR is nil, signal an error that no VC backend is
responsible for the given file."
(or (and (not (file-directory-p file)) (vc-backend file))
+ ;; FIXME it would be more efficient to walk up the directory tree,
+ ;; stopping the first time a backend is responsible.
+ ;;
;; First try: find a responsible backend. If this is for registration,
;; it must be a backend under which FILE is not yet registered.
(let ((dirs (delq nil
@@ -1425,6 +1436,7 @@ first backend that could register the file is used."
(let ((vc-handled-backends (list backend)))
(call-interactively 'vc-register)))
+;;;###autoload
(defun vc-ignore (file &optional directory remove)
"Ignore FILE under the VCS of DIRECTORY.
@@ -1831,7 +1843,7 @@ Return t if the buffer had changes, nil otherwise."
(backend (car vc-fileset))
(first (car files))
(rev1-default nil)
- (rev2-default nil))
+ ) ;; (rev2-default nil)
(cond
;; someday we may be able to do revision completion on non-singleton
;; filesets, but not yet.
@@ -1855,9 +1867,10 @@ Return t if the buffer had changes, nil otherwise."
rev1-default "): ")
"Older revision: "))
(rev2-prompt (concat "Newer revision (default "
- (or rev2-default "current source") "): "))
+ ;; (or rev2-default
+ "current source): "))
(rev1 (vc-read-revision rev1-prompt files backend rev1-default))
- (rev2 (vc-read-revision rev2-prompt files backend rev2-default)))
+ (rev2 (vc-read-revision rev2-prompt files backend nil))) ;; rev2-default
(when (string= rev1 "") (setq rev1 nil))
(when (string= rev2 "") (setq rev2 nil))
(list files rev1 rev2))))
@@ -2043,7 +2056,7 @@ saving the buffer."
;; relative file names work.
(let ((default-directory rootdir))
(vc-diff-internal
- t (list backend (list rootdir) working-revision) nil nil
+ t (list backend (list (expand-file-name rootdir)) working-revision) nil nil
(called-interactively-p 'interactive))))))
;;;###autoload
@@ -2590,8 +2603,8 @@ with its diffs (if the underlying VCS supports that)."
(setq backend (vc-responsible-backend rootdir))
(unless backend
(error "Directory is not version controlled")))
- (setq default-directory rootdir)
- (vc-print-log-internal backend (list rootdir) revision revision limit
+ (setq default-directory (expand-file-name rootdir))
+ (vc-print-log-internal backend (list default-directory) revision revision limit
(when with-diff 'with-diff))))
;;;###autoload
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index 595a25381ab..e219dc2d1a5 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1,4 +1,4 @@
-;;; vcursor.el --- manipulate an alternative ("virtual") cursor
+;;; vcursor.el --- manipulate an alternative ("virtual") cursor -*- lexical-binding: t; -*-
;; Copyright (C) 1994, 1996, 1998, 2001-2021 Free Software Foundation,
;; Inc.
@@ -27,24 +27,24 @@
;; Latest changes
;; ==============
;;
-;; - *IMPORTANT* vcursor-key-bindings is now nil by default, to avoid
+;; - *IMPORTANT* `vcursor-key-bindings' is now nil by default, to avoid
;; side-effects when the package is loaded. This means no keys are
;; bound by default. Use customize to change it to t to restore
;; the old behavior. (If you do it by hand in .emacs, it
;; must come before vcursor is loaded.)
;; - You can alter the main variables and the vcursor face via
;; M-x customize: go to the Editing group and find Vcursor.
-;; - vcursor-auto-disable can now be 'copy (actually any value not nil
+;; - `vcursor-auto-disable' can now be 'copy (actually any value not nil
;; or t), which means that copying from the vcursor will be turned
;; off after any operation not involving the vcursor, but the
;; vcursor itself will be left alone.
;; - works on dumb terminals
;; - new keymap vcursor-map for binding to a prefix key
-;; - vcursor-compare-windows substantially improved
-;; - vcursor-execute-{key,command} much better about using the
+;; - `vcursor-compare-windows' substantially improved
+;; - `vcursor-execute-{key,command}' much better about using the
;; right keymaps and arranging for the correct windows to be used
-;; - vcursor-window-funcall can call functions interactively
-;; - vcursor-interpret-input for special effects
+;; - `vcursor-window-funcall' can call functions interactively
+;; - `vcursor-interpret-input' for special effects
;;
;; Introduction
;; ============
@@ -326,21 +326,18 @@
(defface vcursor
'((((class color)) (:foreground "blue" :background "cyan" :underline t))
(t (:inverse-video t :underline t)))
- "Face for the virtual cursor."
- :group 'vcursor)
+ "Face for the virtual cursor.")
(defcustom vcursor-auto-disable nil
"If non-nil, disable the virtual cursor after use.
Any non-vcursor command will force `vcursor-disable' to be called.
If non-nil but not t, just make sure copying is toggled off, but don't
disable the vcursor."
- :type '(choice (const t) (const nil) (const copy))
- :group 'vcursor)
+ :type '(choice (const t) (const nil) (const copy)))
(defcustom vcursor-modifiers (list 'control 'shift)
"A list of modifiers that are used to define vcursor key bindings."
- :type '(repeat symbol)
- :group 'vcursor)
+ :type '(repeat symbol))
;; Needed for defcustom, must be up here
(defun vcursor-cs-binding (base &optional meta)
@@ -349,112 +346,114 @@ disable the vcursor."
(cons 'meta key)
key))))
+;; (defvar vcursor)
+
(defun vcursor-bind-keys (var value)
"Alter the value of the variable VAR to VALUE, binding keys as required.
VAR is usually `vcursor-key-bindings'. Normally this function is called
on loading vcursor and from the customize package."
(set var value)
(cond
- ((not value));; don't set any key bindings
+ ((not value)) ;; Don't set any key bindings.
((or (eq value 'oemacs)
(and (eq value t) (fboundp 'oemacs-version)))
- (global-set-key [C-f1] 'vcursor-toggle-copy)
- (global-set-key [C-f2] 'vcursor-copy)
- (global-set-key [C-f3] 'vcursor-copy-word)
- (global-set-key [C-f4] 'vcursor-copy-line)
-
- (global-set-key [S-f1] 'vcursor-disable)
- (global-set-key [S-f2] 'vcursor-other-window)
- (global-set-key [S-f3] 'vcursor-goto)
- (global-set-key [S-f4] 'vcursor-swap-point)
-
- (global-set-key [C-f5] 'vcursor-backward-char)
- (global-set-key [C-f6] 'vcursor-previous-line)
- (global-set-key [C-f7] 'vcursor-next-line)
- (global-set-key [C-f8] 'vcursor-forward-char)
-
- (global-set-key [M-f5] 'vcursor-beginning-of-line)
- (global-set-key [M-f6] 'vcursor-backward-word)
- (global-set-key [M-f6] 'vcursor-forward-word)
- (global-set-key [M-f8] 'vcursor-end-of-line)
-
- (global-set-key [S-f5] 'vcursor-beginning-of-buffer)
- (global-set-key [S-f6] 'vcursor-scroll-down)
- (global-set-key [S-f7] 'vcursor-scroll-up)
- (global-set-key [S-f8] 'vcursor-end-of-buffer)
-
- (global-set-key [C-f9] 'vcursor-isearch-forward)
-
- (global-set-key [S-f9] 'vcursor-execute-key)
- (global-set-key [S-f10] 'vcursor-execute-command)
-
-;;; Partial dictionary of Oemacs key sequences for you to roll your own,
-;;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line)
-;;; Sequence: Sends:
-;;; "\M-[\C-f\M-\C-m" C-S-up
-;;; "\M-[\C-f\M-\C-q" C-S-down
-;;; "\M-[\C-fs" C-S-left
-;;; "\M-[\C-ft" C-S-right
-;;;
-;;; "\M-[\C-fw" C-S-home
-;;; "\M-[\C-b\C-o" S-tab
-;;; "\M-[\C-f\M-\C-r" C-S-insert
-;;; "\M-[\C-fu" C-S-end
-;;; "\M-[\C-f\M-\C-s" C-S-delete
-;;; "\M-[\C-f\M-\C-d" C-S-prior
-;;; "\M-[\C-fv" C-S-next
-;;;
-;;; "\M-[\C-f^" C-S-f1
-;;; "\M-[\C-f_" C-S-f2
-;;; "\M-[\C-f`" C-S-f3
-;;; "\M-[\C-fa" C-S-f4
-;;; "\M-[\C-fb" C-S-f5
-;;; "\M-[\C-fc" C-S-f6
-;;; "\M-[\C-fd" C-S-f7
-;;; "\M-[\C-fe" C-S-f8
-;;; "\M-[\C-ff" C-S-f9
-;;; "\M-[\C-fg" C-S-f10
+ (global-set-key [C-f1] #'vcursor-toggle-copy)
+ (global-set-key [C-f2] #'vcursor-copy)
+ (global-set-key [C-f3] #'vcursor-copy-word)
+ (global-set-key [C-f4] #'vcursor-copy-line)
+
+ (global-set-key [S-f1] #'vcursor-disable)
+ (global-set-key [S-f2] #'vcursor-other-window)
+ (global-set-key [S-f3] #'vcursor-goto)
+ (global-set-key [S-f4] #'vcursor-swap-point)
+
+ (global-set-key [C-f5] #'vcursor-backward-char)
+ (global-set-key [C-f6] #'vcursor-previous-line)
+ (global-set-key [C-f7] #'vcursor-next-line)
+ (global-set-key [C-f8] #'vcursor-forward-char)
+
+ (global-set-key [M-f5] #'vcursor-beginning-of-line)
+ (global-set-key [M-f6] #'vcursor-backward-word)
+ (global-set-key [M-f6] #'vcursor-forward-word)
+ (global-set-key [M-f8] #'vcursor-end-of-line)
+
+ (global-set-key [S-f5] #'vcursor-beginning-of-buffer)
+ (global-set-key [S-f6] #'vcursor-scroll-down)
+ (global-set-key [S-f7] #'vcursor-scroll-up)
+ (global-set-key [S-f8] #'vcursor-end-of-buffer)
+
+ (global-set-key [C-f9] #'vcursor-isearch-forward)
+
+ (global-set-key [S-f9] #'vcursor-execute-key)
+ (global-set-key [S-f10] #'vcursor-execute-command)
+
+ ;; Partial dictionary of Oemacs key sequences for you to roll your own,
+ ;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line)
+ ;; Sequence: Sends:
+ ;; "\M-[\C-f\M-\C-m" C-S-up
+ ;; "\M-[\C-f\M-\C-q" C-S-down
+ ;; "\M-[\C-fs" C-S-left
+ ;; "\M-[\C-ft" C-S-right
+ ;;
+ ;; "\M-[\C-fw" C-S-home
+ ;; "\M-[\C-b\C-o" S-tab
+ ;; "\M-[\C-f\M-\C-r" C-S-insert
+ ;; "\M-[\C-fu" C-S-end
+ ;; "\M-[\C-f\M-\C-s" C-S-delete
+ ;; "\M-[\C-f\M-\C-d" C-S-prior
+ ;; "\M-[\C-fv" C-S-next
+ ;;
+ ;; "\M-[\C-f^" C-S-f1
+ ;; "\M-[\C-f_" C-S-f2
+ ;; "\M-[\C-f`" C-S-f3
+ ;; "\M-[\C-fa" C-S-f4
+ ;; "\M-[\C-fb" C-S-f5
+ ;; "\M-[\C-fc" C-S-f6
+ ;; "\M-[\C-fd" C-S-f7
+ ;; "\M-[\C-fe" C-S-f8
+ ;; "\M-[\C-ff" C-S-f9
+ ;; "\M-[\C-fg" C-S-f10
)
(t
- (global-set-key (vcursor-cs-binding "up") 'vcursor-previous-line)
- (global-set-key (vcursor-cs-binding "down") 'vcursor-next-line)
- (global-set-key (vcursor-cs-binding "left") 'vcursor-backward-char)
- (global-set-key (vcursor-cs-binding "right") 'vcursor-forward-char)
-
- (global-set-key (vcursor-cs-binding "return") 'vcursor-disable)
- (global-set-key (vcursor-cs-binding "insert") 'vcursor-copy)
- (global-set-key (vcursor-cs-binding "delete") 'vcursor-copy-word)
- (global-set-key (vcursor-cs-binding "remove") 'vcursor-copy-word)
- (global-set-key (vcursor-cs-binding "tab") 'vcursor-toggle-copy)
- (global-set-key (vcursor-cs-binding "backtab") 'vcursor-toggle-copy)
- (global-set-key (vcursor-cs-binding "home") 'vcursor-beginning-of-buffer)
- (global-set-key (vcursor-cs-binding "up" t) 'vcursor-beginning-of-buffer)
- (global-set-key (vcursor-cs-binding "end") 'vcursor-end-of-buffer)
- (global-set-key (vcursor-cs-binding "down" t) 'vcursor-end-of-buffer)
- (global-set-key (vcursor-cs-binding "prior") 'vcursor-scroll-down)
- (global-set-key (vcursor-cs-binding "next") 'vcursor-scroll-up)
-
- (global-set-key (vcursor-cs-binding "f6") 'vcursor-other-window)
- (global-set-key (vcursor-cs-binding "f7") 'vcursor-goto)
+ (global-set-key (vcursor-cs-binding "up") #'vcursor-previous-line)
+ (global-set-key (vcursor-cs-binding "down") #'vcursor-next-line)
+ (global-set-key (vcursor-cs-binding "left") #'vcursor-backward-char)
+ (global-set-key (vcursor-cs-binding "right") #'vcursor-forward-char)
+
+ (global-set-key (vcursor-cs-binding "return") #'vcursor-disable)
+ (global-set-key (vcursor-cs-binding "insert") #'vcursor-copy)
+ (global-set-key (vcursor-cs-binding "delete") #'vcursor-copy-word)
+ (global-set-key (vcursor-cs-binding "remove") #'vcursor-copy-word)
+ (global-set-key (vcursor-cs-binding "tab") #'vcursor-toggle-copy)
+ (global-set-key (vcursor-cs-binding "backtab") #'vcursor-toggle-copy)
+ (global-set-key (vcursor-cs-binding "home") #'vcursor-beginning-of-buffer)
+ (global-set-key (vcursor-cs-binding "up" t) #'vcursor-beginning-of-buffer)
+ (global-set-key (vcursor-cs-binding "end") #'vcursor-end-of-buffer)
+ (global-set-key (vcursor-cs-binding "down" t) #'vcursor-end-of-buffer)
+ (global-set-key (vcursor-cs-binding "prior") #'vcursor-scroll-down)
+ (global-set-key (vcursor-cs-binding "next") #'vcursor-scroll-up)
+
+ (global-set-key (vcursor-cs-binding "f6") #'vcursor-other-window)
+ (global-set-key (vcursor-cs-binding "f7") #'vcursor-goto)
(global-set-key (vcursor-cs-binding "select")
- 'vcursor-swap-point) ; DEC keyboards
- (global-set-key (vcursor-cs-binding "tab" t) 'vcursor-swap-point)
+ #'vcursor-swap-point) ; DEC keyboards
+ (global-set-key (vcursor-cs-binding "tab" t) #'vcursor-swap-point)
(global-set-key (vcursor-cs-binding "find")
- 'vcursor-isearch-forward) ; DEC keyboards
- (global-set-key (vcursor-cs-binding "f8") 'vcursor-isearch-forward)
+ #'vcursor-isearch-forward) ; DEC keyboards
+ (global-set-key (vcursor-cs-binding "f8") #'vcursor-isearch-forward)
- (global-set-key (vcursor-cs-binding "left" t) 'vcursor-beginning-of-line)
- (global-set-key (vcursor-cs-binding "right" t) 'vcursor-end-of-line)
+ (global-set-key (vcursor-cs-binding "left" t) #'vcursor-beginning-of-line)
+ (global-set-key (vcursor-cs-binding "right" t) #'vcursor-end-of-line)
- (global-set-key (vcursor-cs-binding "prior" t) 'vcursor-backward-word)
- (global-set-key (vcursor-cs-binding "next" t) 'vcursor-forward-word)
+ (global-set-key (vcursor-cs-binding "prior" t) #'vcursor-backward-word)
+ (global-set-key (vcursor-cs-binding "next" t) #'vcursor-forward-word)
- (global-set-key (vcursor-cs-binding "return" t) 'vcursor-copy-line)
+ (global-set-key (vcursor-cs-binding "return" t) #'vcursor-copy-line)
- (global-set-key (vcursor-cs-binding "f9") 'vcursor-execute-key)
- (global-set-key (vcursor-cs-binding "f10") 'vcursor-execute-command)
+ (global-set-key (vcursor-cs-binding "f9") #'vcursor-execute-key)
+ (global-set-key (vcursor-cs-binding "f10") #'vcursor-execute-command)
)))
(defcustom vcursor-key-bindings nil
@@ -465,8 +464,7 @@ define any key bindings.
Default is nil."
:type '(choice (const t) (const nil) (const xterm) (const oemacs))
- :group 'vcursor
- :set 'vcursor-bind-keys
+ :set #'vcursor-bind-keys
:version "20.3")
(defcustom vcursor-interpret-input nil
@@ -475,13 +473,11 @@ This will cause text insertion to be much slower. Note that no special
interpretation of strings is done: \"\C-x\" is a string of four
characters. The default is simply to copy strings."
:type 'boolean
- :group 'vcursor
:version "20.3")
(defcustom vcursor-string "**>"
"String used to show the vcursor position on dumb terminals."
:type 'string
- :group 'vcursor
:version "20.3")
(defvar vcursor-overlay nil
@@ -501,42 +497,41 @@ scrolling set this. It is used by the `vcursor-auto-disable' code.")
(defcustom vcursor-copy-flag nil
"Non-nil means moving vcursor should copy characters moved over to point."
- :type 'boolean
- :group 'vcursor)
+ :type 'boolean)
(defvar vcursor-temp-goal-column nil
"Keeps track of temporary goal columns for the virtual cursor.")
(defvar vcursor-map
(let ((map (make-sparse-keymap)))
- (define-key map "t" 'vcursor-use-vcursor-map)
-
- (define-key map "\C-p" 'vcursor-previous-line)
- (define-key map "\C-n" 'vcursor-next-line)
- (define-key map "\C-b" 'vcursor-backward-char)
- (define-key map "\C-f" 'vcursor-forward-char)
-
- (define-key map "\r" 'vcursor-disable)
- (define-key map " " 'vcursor-copy)
- (define-key map "\C-y" 'vcursor-copy-word)
- (define-key map "\C-i" 'vcursor-toggle-copy)
- (define-key map "<" 'vcursor-beginning-of-buffer)
- (define-key map ">" 'vcursor-end-of-buffer)
- (define-key map "\M-v" 'vcursor-scroll-down)
- (define-key map "\C-v" 'vcursor-scroll-up)
- (define-key map "o" 'vcursor-other-window)
- (define-key map "g" 'vcursor-goto)
- (define-key map "x" 'vcursor-swap-point)
- (define-key map "\C-s" 'vcursor-isearch-forward)
- (define-key map "\C-r" 'vcursor-isearch-backward)
- (define-key map "\C-a" 'vcursor-beginning-of-line)
- (define-key map "\C-e" 'vcursor-end-of-line)
- (define-key map "\M-w" 'vcursor-forward-word)
- (define-key map "\M-b" 'vcursor-backward-word)
- (define-key map "\M-l" 'vcursor-copy-line)
- (define-key map "c" 'vcursor-compare-windows)
- (define-key map "k" 'vcursor-execute-key)
- (define-key map "\M-x" 'vcursor-execute-command)
+ (define-key map "t" #'vcursor-use-vcursor-map)
+
+ (define-key map "\C-p" #'vcursor-previous-line)
+ (define-key map "\C-n" #'vcursor-next-line)
+ (define-key map "\C-b" #'vcursor-backward-char)
+ (define-key map "\C-f" #'vcursor-forward-char)
+
+ (define-key map "\r" #'vcursor-disable)
+ (define-key map " " #'vcursor-copy)
+ (define-key map "\C-y" #'vcursor-copy-word)
+ (define-key map "\C-i" #'vcursor-toggle-copy)
+ (define-key map "<" #'vcursor-beginning-of-buffer)
+ (define-key map ">" #'vcursor-end-of-buffer)
+ (define-key map "\M-v" #'vcursor-scroll-down)
+ (define-key map "\C-v" #'vcursor-scroll-up)
+ (define-key map "o" #'vcursor-other-window)
+ (define-key map "g" #'vcursor-goto)
+ (define-key map "x" #'vcursor-swap-point)
+ (define-key map "\C-s" #'vcursor-isearch-forward)
+ (define-key map "\C-r" #'vcursor-isearch-backward)
+ (define-key map "\C-a" #'vcursor-beginning-of-line)
+ (define-key map "\C-e" #'vcursor-end-of-line)
+ (define-key map "\M-w" #'vcursor-forward-word)
+ (define-key map "\M-b" #'vcursor-backward-word)
+ (define-key map "\M-l" #'vcursor-copy-line)
+ (define-key map "c" #'vcursor-compare-windows)
+ (define-key map "k" #'vcursor-execute-key)
+ (define-key map "\M-x" #'vcursor-execute-command)
map)
"Keymap for vcursor command.")
;; This seems unused, but it was done as part of define-prefix-command,
@@ -611,7 +606,8 @@ Set `vcursor-window' to the returned value as a side effect."
(cond
(winok) ; choice 2
((and vcursor-window ; choice 3
- (not (eq thiswin vcursor-window))) vcursor-window)
+ (not (eq thiswin vcursor-window)))
+ vcursor-window)
(winbuf) ; choice 4
(new-win (display-buffer (current-buffer) t)) ; choice 5
(t nil))))))) ; default (choice 6)
@@ -719,16 +715,14 @@ not be visible otherwise, display it in another window."
The vcursor will always appear in an unselected window."
(interactive "P")
- (vcursor-window-funcall 'scroll-up n)
-)
+ (vcursor-window-funcall #'scroll-up n))
(defun vcursor-scroll-down (&optional n)
"Scroll down the vcursor window ARG lines or near full screen if none.
The vcursor will always appear in an unselected window."
(interactive "P")
- (vcursor-window-funcall 'scroll-down n)
- )
+ (vcursor-window-funcall #'scroll-down n))
(defun vcursor-isearch-forward (&optional rep norecurs)
"Perform forward incremental search in the virtual cursor window.
@@ -736,7 +730,7 @@ The virtual cursor is moved to the resulting point; the ordinary
cursor stays where it was."
(interactive "P")
- (vcursor-window-funcall 'isearch-forward rep norecurs)
+ (vcursor-window-funcall #'isearch-forward rep norecurs)
)
(defun vcursor-isearch-backward (&optional rep norecurs)
@@ -745,7 +739,7 @@ The virtual cursor is moved to the resulting point; the ordinary
cursor stays where it was."
(interactive "P")
- (vcursor-window-funcall 'isearch-backward rep norecurs)
+ (vcursor-window-funcall #'isearch-backward rep norecurs)
)
(defun vcursor-window-funcall (func &rest args)
@@ -891,7 +885,7 @@ A prefix argument, if any, means ignore changes in whitespace.
The variable `compare-windows-whitespace' controls how whitespace is skipped.
If `compare-ignore-case' is non-nil, changes in case are also ignored."
(interactive "P")
- ;; (vcursor-window-funcall 'compare-windows arg)
+ ;; (vcursor-window-funcall #'compare-windows arg)
(require 'compare-w)
(let* (p1 p2 maxp1 maxp2 b1 b2 w2
success
@@ -1005,32 +999,32 @@ If `compare-ignore-case' is non-nil, changes in case are also ignored."
(defun vcursor-forward-char (arg)
"Move the virtual cursor forward ARG characters."
(interactive "p")
- (vcursor-relative-move 'forward-char arg)
+ (vcursor-relative-move #'forward-char arg)
)
(defun vcursor-backward-char (arg)
"Move the virtual cursor backward ARG characters."
(interactive "p")
- (vcursor-relative-move 'backward-char arg)
+ (vcursor-relative-move #'backward-char arg)
)
(defun vcursor-forward-word (arg)
"Move the virtual cursor forward ARG words."
(interactive "p")
- (vcursor-relative-move 'forward-word arg)
+ (vcursor-relative-move #'forward-word arg)
)
(defun vcursor-backward-word (arg)
"Move the virtual cursor backward ARG words."
(interactive "p")
- (vcursor-relative-move 'backward-word arg)
+ (vcursor-relative-move #'backward-word arg)
)
(defun vcursor-beginning-of-line (arg)
"Move the virtual cursor to beginning of its current line.
ARG is as for `beginning-of-line'."
(interactive "P")
- (vcursor-relative-move 'beginning-of-line
+ (vcursor-relative-move #'beginning-of-line
(if arg (prefix-numeric-value arg)))
)
@@ -1038,7 +1032,7 @@ ARG is as for `beginning-of-line'."
"Move the virtual cursor to end of its current line.
ARG is as for `end-of-line'."
(interactive "P")
- (vcursor-relative-move 'end-of-line
+ (vcursor-relative-move #'end-of-line
(if arg (prefix-numeric-value arg)))
)
@@ -1110,7 +1104,7 @@ is called interactively, so prefix argument etc. are usable."
(defun vcursor-copy-word (arg)
"Copy ARG words from the virtual cursor position to point."
(interactive "p")
- (vcursor-copy (vcursor-get-char-count 'forward-word arg))
+ (vcursor-copy (vcursor-get-char-count #'forward-word arg))
)
(defun vcursor-copy-line (arg)
@@ -1123,7 +1117,7 @@ line is treated like ordinary characters."
(interactive "P")
(let* ((num (prefix-numeric-value arg))
- (count (vcursor-get-char-count 'end-of-line num)))
+ (count (vcursor-get-char-count #'end-of-line num)))
(vcursor-copy (if (or (= count 0) arg) (1+ count) count)))
)
@@ -1136,7 +1130,7 @@ line is treated like ordinary characters."
(setq vcursor-last-command nil)
)
-(add-hook 'post-command-hook 'vcursor-post-command)
+(add-hook 'post-command-hook #'vcursor-post-command)
(provide 'vcursor)
diff --git a/lisp/view.el b/lisp/view.el
index 026c1ece304..3476ced3f79 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -1,4 +1,4 @@
-;;; view.el --- peruse file or buffer without editing
+;;; view.el --- peruse file or buffer without editing -*- lexical-binding: t -*-
;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2021 Free Software
;; Foundation, Inc.
@@ -26,9 +26,9 @@
;; This package provides the `view' minor mode documented in the Emacs
;; user's manual.
-;; View mode entry and exit is done through the functions view-mode-enter
-;; and view-mode-exit. Use these functions to enter or exit view-mode from
-;; emacs lisp programs.
+;; View mode entry and exit is done through the functions `view-mode-enter'
+;; and `view-mode-exit'. Use these functions to enter or exit `view-mode' from
+;; Emacs Lisp programs.
;; We use both view- and View- as prefix for symbols. View- is used as
;; prefix for commands that have a key binding. view- is used for commands
;; without key binding. The purpose of this is to make it easier for a
@@ -36,11 +36,11 @@
;;; Suggested key bindings:
;;
-;; (define-key ctl-x-4-map "v" 'view-file-other-window) ; ^x4v
-;; (define-key ctl-x-5-map "v" 'view-file-other-frame) ; ^x5v
+;; (define-key ctl-x-4-map "v" #'view-file-other-window) ; ^x4v
+;; (define-key ctl-x-5-map "v" #'view-file-other-frame) ; ^x5v
;;
-;; You could also bind view-file, view-buffer, view-buffer-other-window and
-;; view-buffer-other-frame to keys.
+;; You could also bind `view-file', `view-buffer', `view-buffer-other-window' and
+;; `view-buffer-other-frame' to keys.
;;; Code:
@@ -51,31 +51,27 @@
:group 'text)
(defcustom view-highlight-face 'highlight
- "The face used for highlighting the match found by View mode search."
- :type 'face
- :group 'view)
+ "The face used for highlighting the match found by View mode search."
+ :type 'face)
(defcustom view-scroll-auto-exit nil
"Non-nil means scrolling past the end of buffer exits View mode.
A value of nil means attempting to scroll past the end of the buffer,
only rings the bell and gives a message on how to leave."
- :type 'boolean
- :group 'view)
+ :type 'boolean)
(defcustom view-try-extend-at-buffer-end nil
"Non-nil means try to load more of file when reaching end of buffer.
This variable is mainly intended to be temporarily set to non-nil by
-the F command in view-mode, but you can set it to t if you want the action
+the F command in `view-mode', but you can set it to t if you want the action
for all scroll commands in view mode."
- :type 'boolean
- :group 'view)
+ :type 'boolean)
;;;###autoload
(defcustom view-remove-frame-by-deleting t
"Determine how View mode removes a frame no longer needed.
If nil, make an icon of the frame. If non-nil, delete the frame."
:type 'boolean
- :group 'view
:version "23.1")
(defcustom view-exits-all-viewing-windows nil
@@ -84,15 +80,13 @@ Commands that restore windows when finished viewing a buffer,
apply to all windows that display the buffer and have restore
information. If `view-exits-all-viewing-windows' is nil, only
the selected window is considered for restoring."
- :type 'boolean
- :group 'view)
+ :type 'boolean)
(defcustom view-inhibit-help-message nil
"Non-nil inhibits the help message shown upon entering View mode.
This setting takes effect only when View mode is entered via an
interactive command; otherwise the help message is not shown."
:type 'boolean
- :group 'view
:version "22.1")
;;;###autoload
@@ -103,8 +97,7 @@ functions that enable or disable view mode.")
(defcustom view-mode-hook nil
"Normal hook run when starting to view a buffer or file."
- :type 'hook
- :group 'view)
+ :type 'hook)
(defvar-local view-old-buffer-read-only nil)
@@ -154,62 +147,62 @@ This is local in each buffer, once it is used.")
;; Some redundant "less"-like key bindings below have been commented out.
(defvar view-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "C" 'View-kill-and-leave)
- (define-key map "c" 'View-leave)
- (define-key map "Q" 'View-quit-all)
- (define-key map "E" 'View-exit-and-edit)
- ;; (define-key map "v" 'View-exit)
- (define-key map "e" 'View-exit)
- (define-key map "q" 'View-quit)
- ;; (define-key map "N" 'View-search-last-regexp-backward)
- (define-key map "p" 'View-search-last-regexp-backward)
- (define-key map "n" 'View-search-last-regexp-forward)
- ;; (define-key map "?" 'View-search-regexp-backward) ; Less does this.
- (define-key map "\\" 'View-search-regexp-backward)
- (define-key map "/" 'View-search-regexp-forward)
- (define-key map "r" 'isearch-backward)
- (define-key map "s" 'isearch-forward)
- (define-key map "m" 'point-to-register)
- (define-key map "'" 'register-to-point)
- (define-key map "x" 'exchange-point-and-mark)
- (define-key map "@" 'View-back-to-mark)
- (define-key map "." 'set-mark-command)
- (define-key map "%" 'View-goto-percent)
- ;; (define-key map "G" 'View-goto-line-last)
- (define-key map "g" 'View-goto-line)
- (define-key map "=" 'what-line)
- (define-key map "F" 'View-revert-buffer-scroll-page-forward)
- ;; (define-key map "k" 'View-scroll-line-backward)
- (define-key map "y" 'View-scroll-line-backward)
- ;; (define-key map "j" 'View-scroll-line-forward)
- (define-key map "\n" 'View-scroll-line-forward)
- (define-key map "\r" 'View-scroll-line-forward)
- (define-key map "u" 'View-scroll-half-page-backward)
- (define-key map "d" 'View-scroll-half-page-forward)
- (define-key map "z" 'View-scroll-page-forward-set-page-size)
- (define-key map "w" 'View-scroll-page-backward-set-page-size)
- ;; (define-key map "b" 'View-scroll-page-backward)
- (define-key map "\C-?" 'View-scroll-page-backward)
- ;; (define-key map "f" 'View-scroll-page-forward)
- (define-key map " " 'View-scroll-page-forward)
- (define-key map [?\S-\ ] 'View-scroll-page-backward)
- (define-key map "o" 'View-scroll-to-buffer-end)
- (define-key map ">" 'end-of-buffer)
- (define-key map "<" 'beginning-of-buffer)
- (define-key map "-" 'negative-argument)
- (define-key map "9" 'digit-argument)
- (define-key map "8" 'digit-argument)
- (define-key map "7" 'digit-argument)
- (define-key map "6" 'digit-argument)
- (define-key map "5" 'digit-argument)
- (define-key map "4" 'digit-argument)
- (define-key map "3" 'digit-argument)
- (define-key map "2" 'digit-argument)
- (define-key map "1" 'digit-argument)
- (define-key map "0" 'digit-argument)
- (define-key map "H" 'describe-mode)
- (define-key map "?" 'describe-mode) ; Maybe do as less instead? See above.
- (define-key map "h" 'describe-mode)
+ (define-key map "C" #'View-kill-and-leave)
+ (define-key map "c" #'View-leave)
+ (define-key map "Q" #'View-quit-all)
+ (define-key map "E" #'View-exit-and-edit)
+ ;; (define-key map "v" #'View-exit)
+ (define-key map "e" #'View-exit)
+ (define-key map "q" #'View-quit)
+ ;; (define-key map "N" #'View-search-last-regexp-backward)
+ (define-key map "p" #'View-search-last-regexp-backward)
+ (define-key map "n" #'View-search-last-regexp-forward)
+ ;; (define-key map "?" #'View-search-regexp-backward) ; Less does this.
+ (define-key map "\\" #'View-search-regexp-backward)
+ (define-key map "/" #'View-search-regexp-forward)
+ (define-key map "r" #'isearch-backward)
+ (define-key map "s" #'isearch-forward)
+ (define-key map "m" #'point-to-register)
+ (define-key map "'" #'register-to-point)
+ (define-key map "x" #'exchange-point-and-mark)
+ (define-key map "@" #'View-back-to-mark)
+ (define-key map "." #'set-mark-command)
+ (define-key map "%" #'View-goto-percent)
+ ;; (define-key map "G" #'View-goto-line-last)
+ (define-key map "g" #'View-goto-line)
+ (define-key map "=" #'what-line)
+ (define-key map "F" #'View-revert-buffer-scroll-page-forward)
+ ;; (define-key map "k" #'View-scroll-line-backward)
+ (define-key map "y" #'View-scroll-line-backward)
+ ;; (define-key map "j" #'View-scroll-line-forward)
+ (define-key map "\n" #'View-scroll-line-forward)
+ (define-key map "\r" #'View-scroll-line-forward)
+ (define-key map "u" #'View-scroll-half-page-backward)
+ (define-key map "d" #'View-scroll-half-page-forward)
+ (define-key map "z" #'View-scroll-page-forward-set-page-size)
+ (define-key map "w" #'View-scroll-page-backward-set-page-size)
+ ;; (define-key map "b" #'View-scroll-page-backward)
+ (define-key map "\C-?" #'View-scroll-page-backward)
+ ;; (define-key map "f" #'View-scroll-page-forward)
+ (define-key map " " #'View-scroll-page-forward)
+ (define-key map [?\S-\ ] #'View-scroll-page-backward)
+ (define-key map "o" #'View-scroll-to-buffer-end)
+ (define-key map ">" #'end-of-buffer)
+ (define-key map "<" #'beginning-of-buffer)
+ (define-key map "-" #'negative-argument)
+ (define-key map "9" #'digit-argument)
+ (define-key map "8" #'digit-argument)
+ (define-key map "7" #'digit-argument)
+ (define-key map "6" #'digit-argument)
+ (define-key map "5" #'digit-argument)
+ (define-key map "4" #'digit-argument)
+ (define-key map "3" #'digit-argument)
+ (define-key map "2" #'digit-argument)
+ (define-key map "1" #'digit-argument)
+ (define-key map "0" #'digit-argument)
+ (define-key map "H" #'describe-mode)
+ (define-key map "?" #'describe-mode) ; Maybe do as less instead? See above.
+ (define-key map "h" #'describe-mode)
map))
;;; Commands that enter or exit view mode.
@@ -220,7 +213,7 @@ This is local in each buffer, once it is used.")
;; types C-x C-q again to return to view mode.
;;;###autoload
(defun kill-buffer-if-not-modified (buf)
- "Like `kill-buffer', but does nothing if the buffer is modified."
+ "Like `kill-buffer', but does nothing if buffer BUF is modified."
(let ((buf (get-buffer buf)))
(and buf (not (buffer-modified-p buf))
(kill-buffer buf))))
@@ -305,7 +298,7 @@ file: Users may suspend viewing in order to modify the buffer.
Exiting View mode will then discard the user's edits. Setting
EXIT-ACTION to `kill-buffer-if-not-modified' avoids this.
-This function does not enable View mode if the buffer's major-mode
+This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings."
(interactive "bView buffer: ")
@@ -331,7 +324,7 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
this argument instead of explicitly setting `view-exit-action'.
-This function does not enable View mode if the buffer's major-mode
+This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings."
(interactive "bIn other window view buffer:\nP")
@@ -358,7 +351,7 @@ Optional argument EXIT-ACTION is either nil or a function with buffer as
argument. This function is called when finished viewing buffer. Use
this argument instead of explicitly setting `view-exit-action'.
-This function does not enable View mode if the buffer's major-mode
+This function does not enable View mode if the buffer's major mode
has a `special' mode-class, because such modes usually have their
own View-like bindings."
(interactive "bView buffer in other frame: \nP")
@@ -662,8 +655,8 @@ previous state and go to previous buffer or window."
(recenter '(1)))
(defun view-page-size-default (lines)
- ;; If LINES is nil, 0, or larger than `view-window-size', return nil.
- ;; Otherwise, return LINES.
+ "If LINES is nil, 0, or larger than `view-window-size', return nil.
+Otherwise, return LINES."
(and lines
(not (zerop (setq lines (prefix-numeric-value lines))))
(<= (abs lines)
@@ -671,7 +664,7 @@ previous state and go to previous buffer or window."
(abs lines)))
(defun view-set-half-page-size-default (lines)
- ;; Get and maybe set half page size.
+ "Get and maybe set half page size."
(if (not lines) (or view-half-page-size
(/ (view-window-size) 2))
(setq view-half-page-size
@@ -749,7 +742,7 @@ invocations return to earlier marks."
(if (view-really-at-end) (view-end-message)))))
(defun view-really-at-end ()
- ;; Return true if buffer end visible. Maybe revert buffer and test.
+ "Return non-nil if buffer end visible. Maybe revert buffer and test."
(and (or (null scroll-error-top-bottom) (eobp))
(pos-visible-in-window-p (point-max))
(let ((buf (current-buffer))
@@ -772,7 +765,7 @@ invocations return to earlier marks."
(pos-visible-in-window-p (point-max)))))))
(defun view-end-message ()
- ;; Tell that we are at end of buffer.
+ "Tell that we are at end of buffer."
(goto-char (point-max))
(if (window-parameter nil 'quit-restore)
(message "End of buffer. Type %s to quit viewing."
@@ -979,7 +972,7 @@ for highlighting the match that is found."
;; 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.
+If such a line is found, return non-nil and set the match data to that line.
If TIMES is negative, search backwards."
(let ((step (if (>= times 0) 1
(setq times (- times))
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index 0bd5132f7c3..bac0069b852 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -83,26 +83,24 @@
(defun vt-keypad-on (&optional tell)
"Turn on the VT applications keypad."
- (interactive)
+ (interactive "p")
(send-string-to-terminal "\e=")
(setq vt-applications-keypad-p t)
- (if (or tell (called-interactively-p 'interactive))
- (message "Applications keypad enabled.")))
+ (if tell (message "Applications keypad enabled.")))
(defun vt-keypad-off (&optional tell)
"Turn off the VT applications keypad."
(interactive "p")
(send-string-to-terminal "\e>")
(setq vt-applications-keypad-p nil)
- (if (or tell (called-interactively-p 'interactive))
- (message "Applications keypad disabled.")))
+ (if tell (message "Applications keypad disabled.")))
-(defun vt-numlock nil
+(defun vt-numlock (&optional tell)
"Toggle VT application keypad on and off."
- (interactive)
+ (interactive "p")
(if vt-applications-keypad-p
- (vt-keypad-off (called-interactively-p 'interactive))
- (vt-keypad-on (called-interactively-p 'interactive))))
+ (vt-keypad-off tell)
+ (vt-keypad-on tell)))
(provide 'vt-control)
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 9ef2da737a4..2548fa4d448 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -255,6 +255,7 @@ bit output with no translation."
(w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592)
(w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593)
(w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594)
+ (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
(w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596)
(w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597)
(w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255)
diff --git a/lisp/wdired.el b/lisp/wdired.el
index a096abd106f..fd549bac322 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -1,4 +1,4 @@
-;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; -*-
+;;; wdired.el --- Rename files editing their names in dired buffers -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -85,15 +85,13 @@
If nil, WDired doesn't require confirmation to change the file names,
and the variable `wdired-confirm-overwrite' controls whether it is ok
to overwrite files without asking."
- :type 'boolean
- :group 'wdired)
+ :type 'boolean)
(defcustom wdired-confirm-overwrite t
"If nil the renames can overwrite files without asking.
This variable has no effect at all if `wdired-use-interactive-rename'
is not nil."
- :type 'boolean
- :group 'wdired)
+ :type 'boolean)
(defcustom wdired-use-dired-vertical-movement nil
"If t, the \"up\" and \"down\" movement works as in Dired mode.
@@ -106,15 +104,13 @@ when editing several filenames.
If nil, \"up\" and \"down\" movement is done as in any other buffer."
:type '(choice (const :tag "As in any other mode" nil)
(const :tag "Smart cursor placement" sometimes)
- (other :tag "As in dired mode" t))
- :group 'wdired)
+ (other :tag "As in dired mode" t)))
(defcustom wdired-allow-to-redirect-links t
"If non-nil, the target of the symbolic links are editable.
In systems without symbolic links support, this variable has no effect
at all."
- :type 'boolean
- :group 'wdired)
+ :type 'boolean)
(defcustom wdired-allow-to-change-permissions nil
"If non-nil, the permissions bits of the files are editable.
@@ -135,8 +131,7 @@ Anyway, the real change of the permissions is done by the external
program `dired-chmod-program', which must exist."
:type '(choice (const :tag "Not allowed" nil)
(const :tag "Toggle/set bits" t)
- (other :tag "Bits freely editable" advanced))
- :group 'wdired)
+ (other :tag "Bits freely editable" advanced)))
(defcustom wdired-keep-marker-rename t
;; Use t as default so that renamed files "take their markers with them".
@@ -149,8 +144,7 @@ See `dired-keep-marker-rename' if you want to do the same for files
renamed by `dired-do-rename' and `dired-do-rename-regexp'."
:type '(choice (const :tag "Keep" t)
(character :tag "Mark" :value ?R))
- :version "24.3"
- :group 'wdired)
+ :version "24.3")
(defcustom wdired-create-parent-directories t
"If non-nil, create parent directories of destination files.
@@ -159,51 +153,47 @@ nonexistent directory, wdired will create any parent directories
necessary. When nil, attempts to rename a file into a
nonexistent directory will fail."
:version "26.1"
- :type 'boolean
- :group 'wdired)
+ :type 'boolean)
(defvar wdired-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-s" 'wdired-finish-edit)
- (define-key map "\C-c\C-c" 'wdired-finish-edit)
- (define-key map "\C-c\C-k" 'wdired-abort-changes)
- (define-key map "\C-c\C-[" 'wdired-abort-changes)
- (define-key map "\C-x\C-q" 'wdired-exit)
- (define-key map "\C-m" 'ignore)
- (define-key map "\C-j" 'ignore)
- (define-key map "\C-o" 'ignore)
- (define-key map [up] 'wdired-previous-line)
- (define-key map "\C-p" 'wdired-previous-line)
- (define-key map [down] 'wdired-next-line)
- (define-key map "\C-n" 'wdired-next-line)
-
- (define-key map [menu-bar wdired]
- (cons "WDired" (make-sparse-keymap "WDired")))
- (define-key map [menu-bar wdired wdired-customize]
- '("Options" . wdired-customize))
- (define-key map [menu-bar wdired dashes]
- '("--"))
- (define-key map [menu-bar wdired wdired-abort-changes]
- '(menu-item "Abort Changes" wdired-abort-changes
- :help "Abort changes and return to dired mode"))
- (define-key map [menu-bar wdired wdired-finish-edit]
- '("Commit Changes" . wdired-finish-edit))
-
- (define-key map [remap upcase-word] 'wdired-upcase-word)
- (define-key map [remap capitalize-word] 'wdired-capitalize-word)
- (define-key map [remap downcase-word] 'wdired-downcase-word)
-
+ (define-key map "\C-x\C-s" #'wdired-finish-edit)
+ (define-key map "\C-c\C-c" #'wdired-finish-edit)
+ (define-key map "\C-c\C-k" #'wdired-abort-changes)
+ (define-key map "\C-c\C-[" #'wdired-abort-changes)
+ (define-key map "\C-x\C-q" #'wdired-exit)
+ (define-key map "\C-m" #'undefined)
+ (define-key map "\C-j" #'undefined)
+ (define-key map "\C-o" #'undefined)
+ (define-key map [up] #'wdired-previous-line)
+ (define-key map "\C-p" #'wdired-previous-line)
+ (define-key map [down] #'wdired-next-line)
+ (define-key map "\C-n" #'wdired-next-line)
+ (define-key map [remap upcase-word] #'wdired-upcase-word)
+ (define-key map [remap capitalize-word] #'wdired-capitalize-word)
+ (define-key map [remap downcase-word] #'wdired-downcase-word)
+ (define-key map [remap self-insert-command] #'wdired--self-insert)
map)
"Keymap used in `wdired-mode'.")
+(easy-menu-define wdired-mode-menu wdired-mode-map
+ "Menu for `wdired-mode'."
+ '("WDired"
+ ["Commit Changes" wdired-finish-edit]
+ ["Abort Changes" wdired-abort-changes
+ :help "Abort changes and return to Dired mode"]
+ "---"
+ ["Options" wdired-customize]))
+
(defvar wdired-mode-hook nil
"Hooks run when changing to WDired mode.")
;; Local variables (put here to avoid compilation gripes)
-(defvar wdired-col-perm) ;; Column where the permission bits start
-(defvar wdired-old-content)
-(defvar wdired-old-point)
-(defvar wdired-old-marks)
+(defvar wdired--perm-beg) ;; Column where the permission bits start
+(defvar wdired--perm-end) ;; Column where the permission bits stop
+(defvar wdired--old-content)
+(defvar wdired--old-point)
+(defvar wdired--old-marks)
(defun wdired-mode ()
"Writable Dired (WDired) mode.
@@ -242,11 +232,12 @@ See `wdired-mode'."
(interactive)
(unless (derived-mode-p 'dired-mode)
(error "Not a Dired buffer"))
- (setq-local wdired-old-content
+ (setq-local wdired--old-content
(buffer-substring (point-min) (point-max)))
- (setq-local wdired-old-marks
+ (setq-local wdired--old-marks
(dired-remember-marks (point-min) (point-max)))
- (setq-local wdired-old-point (point))
+ (setq-local wdired--old-point (point))
+ (wdired--set-permission-bounds)
(setq-local query-replace-skip-read-only t)
(add-function :after-while (local 'isearch-filter-predicate)
#'wdired-isearch-filter-read-only)
@@ -254,21 +245,12 @@ See `wdired-mode'."
(force-mode-line-update)
(setq buffer-read-only nil)
(dired-unadvertise default-directory)
- (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
- (add-hook 'after-change-functions 'wdired--restore-properties nil t)
+ (add-hook 'kill-buffer-hook #'wdired-check-kill-buffer nil t)
+ (add-hook 'before-change-functions #'wdired--before-change-fn nil t)
+ (add-hook 'after-change-functions #'wdired--restore-properties nil t)
(setq major-mode 'wdired-mode)
(setq mode-name "Editable Dired")
- (setq revert-buffer-function 'wdired-revert)
- ;; I temp disable undo for performance: since I'm going to clear the
- ;; undo list, it can save more than a 9% of time with big
- ;; directories because setting properties modify the undo-list.
- (buffer-disable-undo)
- (wdired-preprocess-files)
- (if wdired-allow-to-change-permissions
- (wdired-preprocess-perms))
- (if (fboundp 'make-symbolic-link)
- (wdired-preprocess-symlinks))
- (buffer-enable-undo) ; Performance hack. See above.
+ (add-function :override (local 'revert-buffer-function) #'wdired-revert)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-mode-hooks 'wdired-mode-hook)
@@ -276,6 +258,68 @@ See `wdired-mode'."
"Press \\[wdired-finish-edit] when finished \
or \\[wdired-abort-changes] to abort changes")))
+(defun wdired--set-permission-bounds ()
+ (save-excursion
+ (goto-char (point-min))
+ (if (not (re-search-forward dired-re-perms nil t 1))
+ (progn
+ (setq-local wdired--perm-beg nil)
+ (setq-local wdired--perm-end nil))
+ (goto-char (match-beginning 0))
+ ;; Add 1 since the first char matched by `dired-re-perms' is the
+ ;; one describing the nature of the entry (dir/symlink/...) rather
+ ;; than its permissions.
+ (setq-local wdired--perm-beg (1+ (wdired--current-column)))
+ (goto-char (match-end 0))
+ (setq-local wdired--perm-end (wdired--current-column)))))
+
+(defun wdired--current-column ()
+ (- (point) (line-beginning-position)))
+
+(defun wdired--point-at-perms-p ()
+ (and wdired--perm-beg
+ (<= wdired--perm-beg (wdired--current-column) wdired--perm-end)))
+
+(defun wdired--line-preprocessed-p ()
+ (get-text-property (line-beginning-position) 'front-sticky))
+
+(defun wdired--self-insert ()
+ (interactive)
+ (if (wdired--line-preprocessed-p)
+ (call-interactively 'self-insert-command)
+ (wdired--before-change-fn (point) (point))
+ (let* ((map (get-text-property (point) 'keymap)))
+ (call-interactively (or (if map (lookup-key map (this-command-keys)))
+ #'self-insert-command)))))
+
+(put 'wdired--self-insert 'delete-selection 'delete-selection-uses-region-p)
+
+(defun wdired--before-change-fn (beg end)
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (widen)
+ ;; Make sure to process entire lines.
+ (goto-char end)
+ (setq end (line-end-position))
+ (goto-char beg)
+ (forward-line 0)
+
+ (while (< (point) end)
+ (unless (wdired--line-preprocessed-p)
+ (with-silent-modifications
+ (put-text-property (point) (1+ (point)) 'front-sticky t)
+ (wdired--preprocess-files)
+ (when wdired-allow-to-change-permissions
+ (wdired--preprocess-perms))
+ (when (fboundp 'make-symbolic-link)
+ (wdired--preprocess-symlinks))))
+ (forward-line))
+ (when (eobp)
+ (with-silent-modifications
+ ;; Is this good enough? Assumes no extra white lines from dired.
+ (put-text-property (1- (point-max)) (point-max) 'read-only t)))))))
+
(defun wdired-isearch-filter-read-only (beg end)
"Skip matches that have a read-only property."
(not (text-property-not-all (min beg end) (max beg end)
@@ -283,46 +327,58 @@ or \\[wdired-abort-changes] to abort changes")))
;; Protect the buffer so only the filenames can be changed, and put
;; properties so filenames (old and new) can be easily found.
-(defun wdired-preprocess-files ()
- (put-text-property (point-min) (1+ (point-min))'front-sticky t)
+(defun wdired--preprocess-files ()
(save-excursion
- (goto-char (point-min))
- (let ((b-protection (point))
- (used-F (dired-check-switches dired-actual-switches "F" "classify"))
- filename)
- (while (not (eobp))
- (setq filename (dired-get-filename nil t))
- (when (and filename
- (not (member (file-name-nondirectory filename) '("." ".."))))
- (dired-move-to-filename)
- ;; The rear-nonsticky property below shall ensure that text preceding
- ;; the filename can't be modified.
- (add-text-properties
- (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
- (put-text-property b-protection (point) 'read-only t)
- (dired-move-to-end-of-filename t)
- (put-text-property (point) (1+ (point)) 'end-name t))
- (when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
- (when (save-excursion
- (and (re-search-backward
- dired-permission-flags-regexp nil t)
- (looking-at "l")
- (search-forward " -> " (line-end-position) t)))
- (goto-char (line-end-position)))
- (setq b-protection (point))
- (forward-line))
- (put-text-property b-protection (point-max) 'read-only t))))
+ (let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
+ (beg (point))
+ (filename (dired-get-filename nil t)))
+ (when (and filename
+ (not (member (file-name-nondirectory filename) '("." ".."))))
+ (dired-move-to-filename)
+ ;; The rear-nonsticky property below shall ensure that text preceding
+ ;; the filename can't be modified.
+ (add-text-properties
+ (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
+ (put-text-property beg (point) 'read-only t)
+ (dired-move-to-end-of-filename t)
+ (put-text-property (point) (1+ (point)) 'end-name t))
+ (when (and used-F (looking-at "[*/@|=>]$")) (forward-char))
+ (when (save-excursion
+ (and (re-search-backward
+ dired-permission-flags-regexp nil t)
+ (looking-at "l")
+ (search-forward " -> " (line-end-position) t)))
+ (goto-char (line-end-position))))))
;; This code is a copy of some dired-get-filename lines.
(defsubst wdired-normalize-filename (file unquotep)
(when unquotep
- (setq file
- ;; FIXME: shouldn't we check for a `b' argument or somesuch before
- ;; doing such unquoting? --Stef
- (read (concat
- "\"" (replace-regexp-in-string
- "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
- "\""))))
+ ;; Unquote names quoted by ls or by dired-insert-directory.
+ ;; This code was written using `read' to unquote, because
+ ;; it's faster than substituting \007 (4 chars) -> ^G (1
+ ;; char) etc. in a lisp loop. Unfortunately, this decision
+ ;; has necessitated hacks such as dealing with filenames
+ ;; with quotation marks in their names.
+ (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file)
+ (setq file (replace-match "\\\"" nil t file 1)))
+ ;; Unescape any spaces escaped by ls -b (bug#10469).
+ ;; Other -b quotes, eg \t, \n, work transparently.
+ (if (dired-switches-escape-p dired-actual-switches)
+ (let ((start 0)
+ (rep "")
+ (shift -1))
+ (while (string-match "\\(\\\\\\) " file start)
+ (setq file (replace-match rep nil t file 1)
+ start (+ shift (match-end 0))))))
+ (when (eq system-type 'windows-nt)
+ (save-match-data
+ (let ((start 0))
+ (while (string-match "\\\\" file start)
+ (aset file (match-beginning 0) ?/)
+ (setq start (match-end 0))))))
+
+ ;; Hence we don't need to worry about converting `\\' back to `\'.
+ (setq file (read (concat "\"" file "\""))))
(and file buffer-file-coding-system
(not file-name-coding-system)
(not default-file-name-coding-system)
@@ -338,6 +394,7 @@ non-nil means return old filename."
;; FIXME: Use dired-get-filename's new properties.
(let ((used-F (dired-check-switches dired-actual-switches "F" "classify"))
beg end file)
+ (wdired--before-change-fn (point) (point))
(save-excursion
(setq end (line-end-position))
(beginning-of-line)
@@ -374,7 +431,6 @@ non-nil means return old filename."
(and file (> (length file) 0)
(concat (dired-current-directory) file))))))
-
(defun wdired-change-to-dired-mode ()
"Change the mode back to dired."
(or (eq major-mode 'wdired-mode)
@@ -391,18 +447,19 @@ non-nil means return old filename."
(setq major-mode 'dired-mode)
(setq mode-name "Dired")
(dired-advertise)
- (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
- (remove-hook 'after-change-functions 'wdired--restore-properties t)
- (setq-local revert-buffer-function 'dired-revert))
-
+ (remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
+ (remove-hook 'before-change-functions #'wdired--before-change-fn t)
+ (remove-hook 'after-change-functions #'wdired--restore-properties t)
+ (remove-function (local 'revert-buffer-function) #'wdired-revert))
(defun wdired-abort-changes ()
"Abort changes and return to dired mode."
(interactive)
+ (remove-hook 'before-change-functions #'wdired--before-change-fn t)
(let ((inhibit-read-only t))
(erase-buffer)
- (insert wdired-old-content)
- (goto-char wdired-old-point))
+ (insert wdired--old-content)
+ (goto-char wdired--old-point))
(wdired-change-to-dired-mode)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
@@ -424,13 +481,14 @@ non-nil means return old filename."
(setq errors (cdr tmp-value))
(setq changes (car tmp-value)))
(when (and wdired-allow-to-change-permissions
- (boundp 'wdired-col-perm)) ; could have been changed
+ wdired--perm-beg) ; could have been changed
(setq tmp-value (wdired-do-perm-changes))
(setq errors (+ errors (cdr tmp-value)))
(setq changes (or changes (car tmp-value))))
(goto-char (point-max))
(while (not (bobp))
- (setq file-old (wdired-get-filename nil t))
+ (setq file-old (and (wdired--line-preprocessed-p)
+ (wdired-get-filename nil t)))
(when file-old
(setq file-new (wdired-get-filename))
(if (equal file-new file-old)
@@ -442,11 +500,11 @@ non-nil means return old filename."
(let ((mark (cond ((integerp wdired-keep-marker-rename)
wdired-keep-marker-rename)
(wdired-keep-marker-rename
- (cdr (assoc file-old wdired-old-marks)))
+ (cdr (assoc file-old wdired--old-marks)))
(t nil))))
(when mark
(push (cons (substitute-in-file-name file-new) mark)
- wdired-old-marks))))
+ wdired--old-marks))))
(push (cons file-old (substitute-in-file-name file-new))
files-renamed))))
(forward-line -1)))
@@ -471,7 +529,7 @@ non-nil means return old filename."
;; Re-sort the buffer.
(revert-buffer)
(let ((inhibit-read-only t))
- (dired-mark-remembered wdired-old-marks)))
+ (dired-mark-remembered wdired--old-marks)))
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max)
'(old-name nil end-name nil old-link nil
@@ -542,7 +600,7 @@ non-nil means return old filename."
;; So we must ensure dired-aux is loaded.
(require 'dired-aux)
(condition-case err
- (let ((dired-backup-overwrite nil))
+ (dlet ((dired-backup-overwrite nil))
(and wdired-create-parent-directories
(wdired-create-parentdirs file-new))
(dired-rename-file file-ori file-new
@@ -644,47 +702,49 @@ Optional arguments are ignored."
(defun wdired--restore-properties (beg end _len)
(save-match-data
(save-excursion
- (let ((lep (line-end-position))
- (used-F (dired-check-switches
- dired-actual-switches
- "F" "classify")))
- ;; Deleting the space between the link name and the arrow (a
- ;; noop) also deletes the end-name property, so restore it.
- (when (and (save-excursion
- (re-search-backward dired-permission-flags-regexp nil t)
- (looking-at "l"))
- (get-text-property (1- (point)) 'dired-filename)
- (not (get-text-property (point) 'dired-filename))
- (not (get-text-property (point) 'end-name)))
+ (save-restriction
+ (widen)
+ (let ((lep (line-end-position))
+ (used-F (dired-check-switches
+ dired-actual-switches
+ "F" "classify")))
+ ;; Deleting the space between the link name and the arrow (a
+ ;; noop) also deletes the end-name property, so restore it.
+ (when (and (save-excursion
+ (re-search-backward dired-permission-flags-regexp nil t)
+ (looking-at "l"))
+ (get-text-property (1- (point)) 'dired-filename)
+ (not (get-text-property (point) 'dired-filename))
+ (not (get-text-property (point) 'end-name)))
(put-text-property (point) (1+ (point)) 'end-name t))
- (beginning-of-line)
- (when (re-search-forward
- directory-listing-before-filename-regexp lep t)
- (setq beg (point)
- end (if (or
- ;; If the file is a symlink, put the
- ;; dired-filename property only on the link
- ;; name. (Using (file-symlink-p
- ;; (dired-get-filename)) fails in
- ;; wdired-mode, bug#32673.)
- (and (re-search-backward
- dired-permission-flags-regexp nil t)
- (looking-at "l")
- ;; macOS and Ultrix adds "@" to the end
- ;; of symlinks when using -F.
- (if (and used-F
- dired-ls-F-marks-symlinks)
- (re-search-forward "@? -> " lep t)
- (search-forward " -> " lep t)))
- ;; When dired-listing-switches includes "F"
- ;; or "classify", don't treat appended
- ;; indicator characters as part of the file
- ;; name (bug#34915).
- (and used-F
- (re-search-forward "[*/@|=>]$" lep t)))
- (goto-char (match-beginning 0))
- lep))
- (put-text-property beg end 'dired-filename t))))))
+ (beginning-of-line)
+ (when (re-search-forward
+ directory-listing-before-filename-regexp lep t)
+ (setq beg (point)
+ end (if (or
+ ;; If the file is a symlink, put the
+ ;; dired-filename property only on the link
+ ;; name. (Using (file-symlink-p
+ ;; (dired-get-filename)) fails in
+ ;; wdired-mode, bug#32673.)
+ (and (re-search-backward
+ dired-permission-flags-regexp nil t)
+ (looking-at "l")
+ ;; macOS and Ultrix adds "@" to the end
+ ;; of symlinks when using -F.
+ (if (and used-F
+ dired-ls-F-marks-symlinks)
+ (re-search-forward "@? -> " lep t)
+ (search-forward " -> " lep t)))
+ ;; When dired-listing-switches includes "F"
+ ;; or "classify", don't treat appended
+ ;; indicator characters as part of the file
+ ;; name (bug#34915).
+ (and used-F
+ (re-search-forward "[*/@|=>]$" lep t)))
+ (goto-char (match-beginning 0))
+ lep))
+ (put-text-property beg end 'dired-filename t)))))))
(defun wdired-next-line (arg)
"Move down lines then position at filename or the current column.
@@ -715,21 +775,17 @@ says how many lines to move; default is one line."
(dired-move-to-filename)))
;; Put the needed properties to allow the user to change links' targets
-(defun wdired-preprocess-symlinks ()
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (looking-at dired-re-sym)
- (re-search-forward " -> \\(.*\\)$")
- (put-text-property (1- (match-beginning 1))
- (match-beginning 1) 'old-link
- (match-string-no-properties 1))
- (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
- (unless wdired-allow-to-redirect-links
- (put-text-property (match-beginning 0)
- (match-end 1) 'read-only t)))
- (forward-line)))))
+(defun wdired--preprocess-symlinks ()
+ (save-excursion
+ (when (looking-at dired-re-sym)
+ (re-search-forward " -> \\(.*\\)$")
+ (put-text-property (1- (match-beginning 1))
+ (match-beginning 1) 'old-link
+ (match-string-no-properties 1))
+ (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
+ (unless wdired-allow-to-redirect-links
+ (put-text-property (match-beginning 0)
+ (match-end 1) 'read-only t)))))
(defun wdired-get-previous-link (&optional old move)
"Return the next symlink target.
@@ -813,56 +869,49 @@ Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'capitalize-word arg))
-
;; The following code deals with changing the access bits (or
;; permissions) of the files.
(defvar wdired-perm-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map " " 'wdired-toggle-bit)
- (define-key map "r" 'wdired-set-bit)
- (define-key map "w" 'wdired-set-bit)
- (define-key map "x" 'wdired-set-bit)
- (define-key map "-" 'wdired-set-bit)
- (define-key map "S" 'wdired-set-bit)
- (define-key map "s" 'wdired-set-bit)
- (define-key map "T" 'wdired-set-bit)
- (define-key map "t" 'wdired-set-bit)
- (define-key map "s" 'wdired-set-bit)
- (define-key map "l" 'wdired-set-bit)
- (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
+ (define-key map " " #'wdired-toggle-bit)
+ (define-key map "r" #'wdired-set-bit)
+ (define-key map "w" #'wdired-set-bit)
+ (define-key map "x" #'wdired-set-bit)
+ (define-key map "-" #'wdired-set-bit)
+ (define-key map "S" #'wdired-set-bit)
+ (define-key map "s" #'wdired-set-bit)
+ (define-key map "T" #'wdired-set-bit)
+ (define-key map "t" #'wdired-set-bit)
+ (define-key map "s" #'wdired-set-bit)
+ (define-key map "l" #'wdired-set-bit)
+ (define-key map [mouse-1] #'wdired-mouse-toggle-bit)
map))
;; Put a keymap property to the permission bits of the files, and store the
;; original name and permissions as a property
-(defun wdired-preprocess-perms ()
- (let ((inhibit-read-only t))
- (setq-local wdired-col-perm nil)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (and (not (looking-at dired-re-sym))
- (wdired-get-filename)
- (re-search-forward dired-re-perms (line-end-position) 'eol))
- (let ((begin (match-beginning 0))
- (end (match-end 0)))
- (unless wdired-col-perm
- (setq wdired-col-perm (- (current-column) 9)))
- (if (eq wdired-allow-to-change-permissions 'advanced)
- (progn
- (put-text-property begin end 'read-only nil)
- ;; make first permission bit writable
- (put-text-property
- (1- begin) begin 'rear-nonsticky '(read-only)))
- ;; avoid that keymap applies to text following permissions
- (add-text-properties
- (1+ begin) end
- `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
- (put-text-property end (1+ end) 'end-perm t)
- (put-text-property
- begin (1+ begin) 'old-perm (match-string-no-properties 0))))
- (forward-line)
- (beginning-of-line)))))
+(defun wdired--preprocess-perms ()
+ (save-excursion
+ (when (and (not (looking-at dired-re-sym))
+ (wdired-get-filename)
+ (re-search-forward dired-re-perms
+ (line-end-position) 'eol))
+ (let ((begin (match-beginning 0))
+ (end (match-end 0)))
+ (if (eq wdired-allow-to-change-permissions 'advanced)
+ (progn
+ (put-text-property begin end 'read-only nil)
+ ;; make first permission bit writable
+ (put-text-property
+ (1- begin) begin 'rear-nonsticky '(read-only)))
+ ;; avoid that keymap applies to text following permissions
+ (add-text-properties
+ (1+ begin) end
+ `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
+ (put-text-property end (1+ end) 'end-perm t)
+ (put-text-property
+ begin (1+ begin)
+ 'old-perm (match-string-no-properties 0))))))
(defun wdired-perm-allowed-in-pos (char pos)
(cond
@@ -874,39 +923,30 @@ Like original function but it skips read-only words."
((memq char '(?t ?T)) (= pos 8))
((= char ?l) (= pos 5))))
-(defun wdired-set-bit ()
+(defun wdired-set-bit (&optional char)
"Set a permission bit character."
- (interactive)
- (if (wdired-perm-allowed-in-pos last-command-event
- (- (current-column) wdired-col-perm))
- (let ((new-bit (char-to-string last-command-event))
+ (interactive (list last-command-event))
+ (unless char (setq char last-command-event))
+ (if (wdired-perm-allowed-in-pos char
+ (- (wdired--current-column) wdired--perm-beg))
+ (let ((new-bit (char-to-string char))
(inhibit-read-only t)
- (pos-prop (- (point) (- (current-column) wdired-col-perm))))
- (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
- (put-text-property 0 1 'read-only t new-bit)
+ (pos-prop (+ (line-beginning-position) wdired--perm-beg)))
+ (set-text-properties 0 1 (text-properties-at (point)) new-bit)
(insert new-bit)
(delete-char 1)
- (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
- (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
+ (put-text-property (1- pos-prop) pos-prop 'perm-changed t))
(forward-char 1)))
(defun wdired-toggle-bit ()
"Toggle the permission bit at point."
(interactive)
- (let ((inhibit-read-only t)
- (new-bit "-")
- (pos-prop (- (point) (- (current-column) wdired-col-perm))))
- (if (eq (char-after (point)) ?-)
- (setq new-bit
- (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
- (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
- "x"))))
- (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
- (put-text-property 0 1 'read-only t new-bit)
- (insert new-bit)
- (delete-char 1)
- (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
- (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
+ (wdired-set-bit
+ (cond
+ ((not (eq (char-after (point)) ?-)) ?-)
+ ((= (% (- (wdired--current-column) wdired--perm-beg) 3) 0) ?r)
+ ((= (% (- (wdired--current-column) wdired--perm-beg) 3) 1) ?w)
+ (t ?x))))
(defun wdired-mouse-toggle-bit (event)
"Toggle the permission bit that was left clicked."
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 22bfae06975..a2dc6ab9814 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -593,7 +593,7 @@ Used when `whitespace-style' includes the value `empty'.")
(defface whitespace-empty
'((((class mono)) :inverse-video t :weight bold :underline t)
- (t :background "yellow" :foreground "firebrick"))
+ (t :background "yellow" :foreground "firebrick" :extend t))
"Face used to visualize empty lines at beginning and/or end of buffer."
:group 'whitespace)
@@ -1039,6 +1039,9 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
1 -1))
;; sync states (running a batch job)
(setq global-whitespace-newline-mode global-whitespace-mode)))
+(make-obsolete 'global-whitespace-newline-mode
+ "use `global-whitespace-mode' with `whitespace-style' set to `(newline-mark newline)' instead."
+ "28.1")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 0864e1b313e..7ce0633b40b 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -1,7 +1,7 @@
-;;; wid-browse.el --- functions for browsing widgets
-;;
+;;; wid-browse.el --- functions for browsing widgets -*- lexical-binding: t -*-
+
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
-;;
+
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
;; Package: emacs
@@ -22,12 +22,11 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; Widget browser. See `widget.el'.
;;; Code:
-(require 'easymenu)
(require 'wid-edit)
(defgroup widget-browse nil
@@ -39,7 +38,7 @@
(defvar widget-browse-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map widget-keymap)
- (define-key map "q" 'bury-buffer)
+ (define-key map "q" #'bury-buffer)
map)
"Keymap for `widget-browse-mode'.")
@@ -56,11 +55,10 @@
["Browse At" widget-browse-at t]))
(defcustom widget-browse-mode-hook nil
- "Hook called when entering widget-browse-mode."
- :type 'hook
- :group 'widget-browse)
+ "Hook run after entering `widget-browse-mode'."
+ :type 'hook)
-(defun widget-browse-mode ()
+(define-derived-mode widget-browse-mode special-mode "Widget Browse"
"Major mode for widget browser buffers.
The following commands are available:
@@ -68,15 +66,7 @@ The following commands are available:
\\[widget-forward] Move to next button or editable field.
\\[widget-backward] Move to previous button or editable field.
\\[widget-button-click] Activate button under the mouse pointer.
-\\[widget-button-press] Activate button under point.
-
-Entry to this mode calls the value of `widget-browse-mode-hook'
-if that value is non-nil."
- (kill-all-local-variables)
- (setq major-mode 'widget-browse-mode
- mode-name "Widget")
- (use-local-map widget-browse-mode-map)
- (run-mode-hooks 'widget-browse-mode-hook))
+\\[widget-button-press] Activate button under point.")
(put 'widget-browse-mode 'mode-class 'special)
@@ -190,11 +180,11 @@ The :value of the widget should be the widget to be browsed."
:action 'widget-browse-action)
(defun widget-browse-action (widget &optional _event)
- ;; Create widget browser for WIDGET's :value.
+ "Create widget browser for :value of WIDGET."
(widget-browse (widget-get widget :value)))
(defun widget-browse-value-create (widget)
- ;; Insert type name.
+ "Insert type name for WIDGET."
(let ((value (widget-get widget :value)))
(cond ((symbolp value)
(insert (symbol-name value)))
@@ -228,7 +218,7 @@ Nothing is assumed about value."
(error (prin1-to-string signal)))))
(when (string-match "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
- (if (cond ((string-match "\n" pp)
+ (if (cond ((string-search "\n" pp)
nil)
((> (length pp) (- (window-width) (current-column)))
nil)
@@ -273,8 +263,6 @@ VALUE is assumed to be a list of widgets."
"Minor mode for traversing widgets."
:lighter " Widget")
-;;; The End:
-
(provide 'wid-browse)
;;; wid-browse.el ends here
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index de2b5d4a7c8..9a34dc8d438 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -131,16 +131,21 @@ This exists as a variable so it can be set locally in certain buffers.")
(((class grayscale color)
(background light))
:background "gray85"
+ ;; We use negative thickness of the horizontal box border line to
+ ;; avoid making lines taller when fields become visible.
+ :box (:line-width (1 . -1) :color "gray80")
:extend t)
(((class grayscale color)
(background dark))
:background "dim gray"
+ :box (:line-width (1 . -1) :color "gray46")
:extend t)
(t
:slant italic
:extend t))
"Face used for editable fields."
- :group 'widget-faces)
+ :group 'widget-faces
+ :version "28.1")
(defface widget-single-line-field '((((type tty))
:background "green3"
@@ -745,7 +750,7 @@ automatically."
:type 'boolean)
(defcustom widget-image-conversion
- '((xpm ".xpm") (gif ".gif") (png ".png") (jpeg ".jpg" ".jpeg")
+ '((svg ".svg") (xpm ".xpm") (gif ".gif") (png ".png") (jpeg ".jpg" ".jpeg")
(xbm ".xbm"))
"Conversion alist from image formats to file name suffixes."
:group 'widgets
@@ -1873,20 +1878,9 @@ as the argument to `documentation-property'."
(let ((value (widget-get widget :value)))
(and (listp value)
(<= (length value) (length vals))
- (let ((head (widget-sublist vals 0 (length value))))
+ (let ((head (seq-subseq vals 0 (length value))))
(and (equal head value)
- (cons head (widget-sublist vals (length value))))))))
-
-(defun widget-sublist (list start &optional end)
- "Return the sublist of LIST from START to END.
-If END is omitted, it defaults to the length of LIST."
- (if (> start 0) (setq list (nthcdr start list)))
- (if end
- (unless (<= end start)
- (setq list (copy-sequence list))
- (setcdr (nthcdr (- end start 1) list) nil)
- list)
- (copy-sequence list)))
+ (cons head (seq-subseq vals (length value))))))))
(defun widget-item-action (widget &optional event)
;; Just notify itself.
@@ -2570,9 +2564,9 @@ Return an alist of (TYPE MATCH)."
:button-suffix ""
:button-prefix ""
:on "(*)"
- :on-glyph "radio1"
+ :on-glyph "radio-checked"
:off "( )"
- :off-glyph "radio0")
+ :off-glyph "radio")
(defun widget-radio-button-notify (widget _child &optional event)
;; Tell daddy.
@@ -4017,7 +4011,10 @@ is inline."
(defun widget-boolean-prompt-value (_widget prompt _value _unbound)
;; Toggle a boolean.
- (y-or-n-p prompt))
+ ;; Say what "y" means. A la
+ ;; "Set customized value for bar to true: (y or n)"
+ (y-or-n-p (concat (replace-regexp-in-string ": ?\\'" "" prompt)
+ " true: ")))
;;; The `color' Widget.
@@ -4029,7 +4026,7 @@ is inline."
(mapcar #'length (defined-colors))))
:tag "Color"
:value "black"
- :completions (or facemenu-color-alist (defined-colors))
+ :completions (defined-colors)
:sample-face-get 'widget-color-sample-face-get
:notify 'widget-color-notify
:match #'widget-color-match
@@ -4044,7 +4041,10 @@ is inline."
:tag " Choose " :action 'widget-color--choose-action)
(widget-insert " "))
+(declare-function list-colors-display "facemenu")
+
(defun widget-color--choose-action (widget &optional _event)
+ (require 'facemenu)
(list-colors-display
nil nil
(let ((cbuf (current-buffer))
@@ -4067,8 +4067,11 @@ is inline."
(list (cons 'foreground-color value))
'default)))
+(declare-function facemenu-read-color "facemenu")
+
(defun widget-color-action (widget &optional event)
"Prompt for a color."
+ (require 'facemenu)
(let* ((tag (widget-apply widget :menu-tag-get))
(prompt (concat tag ": "))
(answer (facemenu-read-color prompt)))
@@ -4106,7 +4109,9 @@ is inline."
(setq help-echo (funcall help-echo widget)))
(if help-echo (message "%s" (eval help-echo)))))
-;;; The End:
+;;; Obsolete.
+
+(define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1")
(provide 'wid-edit)
diff --git a/lisp/widget.el b/lisp/widget.el
index 401b4cf298f..d258e6fae2b 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -94,8 +94,6 @@ The third argument DOC is a documentation string for the widget."
;; This is used by external widget code (in W3, at least).
(define-obsolete-function-alias 'widget-plist-member #'plist-member "26.1")
-;;; The End.
-
(provide 'widget)
;;; widget.el ends here
diff --git a/lisp/windmove.el b/lisp/windmove.el
index e4ea8e0f693..f747c409431 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -138,17 +138,24 @@ If this variable is set to t, moving left from the leftmost window in
a frame will find the rightmost one, and similarly for the other
directions. The minibuffer is skipped over in up/down movements if it
is inactive."
- :type 'boolean
- :group 'windmove)
+ :type 'boolean)
(defcustom windmove-create-window nil
"Whether movement off the edge of the frame creates a new window.
If this variable is set to t, moving left from the leftmost window in
a frame will create a new window on the left, and similarly for the other
-directions."
- :type 'boolean
- :group 'windmove
- :version "27.1")
+directions.
+This variable may also be a function to be called in this circumstance
+by `windmove-do-window-select'. The function should accept then as
+argument the DIRECTION targeted, an interactive ARG and a WINDOW
+corresponding to the currently selected window. It should also return
+a valid window that `windmove-do-window-select' will select,
+or the symbol `no-select' to ignore that final selection."
+ :type '(choice
+ (const :tag "Don't create new windows" nil)
+ (const :tag "Create new windows" t)
+ (function :tag "Provide a function"))
+ :version "28.1")
;; If your Emacs sometimes places an empty column between two adjacent
;; windows, you may wish to set this delta to 2.
@@ -157,11 +164,18 @@ directions."
Measured in characters either horizontally or vertically; setting this
to a value larger than 1 may be useful in getting around window-
placement bugs in old versions of Emacs."
- :type 'number
- :group 'windmove)
+ :type 'number)
(make-obsolete-variable 'windmove-window-distance-delta
"no longer used." "27.1")
+(defcustom windmove-allow-all-windows nil
+ "Whether the windmove commands are allowed to target all type of windows.
+If this variable is set to non-nil, all windmove commmands will
+ignore the `no-other-window' parameter applied by `display-buffer-alist'
+or `set-window-parameter'."
+ :type 'boolean
+ :version "28.1")
+
;; Note:
;;
@@ -342,7 +356,8 @@ WINDOW must be a live window and defaults to the selected one.
Optional ARG, if negative, means to use the right or bottom edge of
WINDOW as reference position, instead of `window-point'; if positive,
use the left or top edge of WINDOW as reference point."
- (window-in-direction dir window nil arg windmove-wrap-around t))
+ (window-in-direction dir window windmove-allow-all-windows
+ arg windmove-wrap-around t))
;; Selects the window that's hopefully at the location returned by
;; `windmove-find-other-window', or screams if there's no window there.
@@ -350,19 +365,23 @@ use the left or top edge of WINDOW as reference point."
"Move to the window at direction DIR as seen from WINDOW.
DIR, ARG, and WINDOW are handled as by `windmove-find-other-window'.
If no window is at direction DIR, an error is signaled.
-If `windmove-create-window' is non-nil, try to create a new window
+If `windmove-create-window' is a function, call that function with
+DIR, ARG and WINDOW. If it is non-nil, try to create a new window
in direction DIR instead."
(let ((other-window (windmove-find-other-window dir arg window)))
(when (and windmove-create-window
(or (null other-window)
(and (window-minibuffer-p other-window)
(not (minibuffer-window-active-p other-window)))))
- (setq other-window (split-window window nil dir)))
+ (setq other-window (if (functionp windmove-create-window)
+ (funcall windmove-create-window dir arg window)
+ (split-window window nil dir))))
(cond ((null other-window)
(user-error "No window %s from selected window" dir))
((and (window-minibuffer-p other-window)
(not (minibuffer-window-active-p other-window)))
(user-error "Minibuffer is inactive"))
+ ((eq other-window 'no-select))
(t
(select-window other-window)))))
@@ -426,27 +445,72 @@ unless `windmove-create-window' is non-nil and a new window is created."
;; I don't think these bindings will work on non-X terminals; you
;; probably want to use different bindings in that case.
+(defvar windmove-mode-map (make-sparse-keymap)
+ "Map used by `windmove-install-defaults'.")
+
+(define-minor-mode windmove-mode
+ "Global minor mode for default windmove commands."
+ :keymap windmove-mode-map
+ :init-value t
+ :global t)
+
+(defun windmove-install-defaults (prefix modifiers alist &optional uninstall)
+ "Install keys as specified by ALIST.
+Every element of ALIST has the form (FN KEY), where KEY is
+appended to MODIFIERS, adding PREFIX to the beginning, before
+installing the key. Previous bindings of FN are unbound.
+If UNINSTALL is non-nil, just remove the keys from ALIST."
+ (dolist (bind alist)
+ (dolist (old (where-is-internal (car bind) windmove-mode-map))
+ (define-key windmove-mode-map old nil))
+ (unless uninstall
+ (let ((key (vconcat (if (or (equal prefix [ignore])
+ (eq prefix 'none))
+ nil prefix)
+ (list (append modifiers (cdr bind))))))
+ (when (eq (key-binding key) #'self-insert-command)
+ (warn "Command %S is shadowing self-insert-key" (car bind)))
+ (let ((old-fn (lookup-key windmove-mode-map key)))
+ (when (functionp old-fn)
+ (warn "Overriding %S with %S" old-fn (car bind))))
+ (define-key windmove-mode-map key (car bind))))))
+
;;;###autoload
(defun windmove-default-keybindings (&optional modifiers)
"Set up keybindings for `windmove'.
Keybindings are of the form MODIFIERS-{left,right,up,down},
where MODIFIERS is either a list of modifiers or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to
+the arrow keys.
Default value of MODIFIERS is `shift'."
(interactive)
(unless modifiers (setq modifiers 'shift))
+ (when (eq modifiers 'none) (setq modifiers nil))
(unless (listp modifiers) (setq modifiers (list modifiers)))
- (global-set-key (vector (append modifiers '(left))) 'windmove-left)
- (global-set-key (vector (append modifiers '(right))) 'windmove-right)
- (global-set-key (vector (append modifiers '(up))) 'windmove-up)
- (global-set-key (vector (append modifiers '(down))) 'windmove-down))
+ (windmove-install-defaults nil modifiers
+ '((windmove-left left)
+ (windmove-right right)
+ (windmove-up up)
+ (windmove-down down))))
;;; Directional window display and selection
(defcustom windmove-display-no-select nil
- "Whether the window should be selected after displaying the buffer in it."
- :type 'boolean
- :group 'windmove
+ "Whether the window should be selected after displaying the buffer in it.
+If `nil', then the new window where the buffer is displayed will be selected.
+If `ignore', then don't select a window: neither the new nor the old window,
+thus allowing the next command to decide what window it selects.
+Other non-nil values will reselect the old window that was selected before.
+
+The value of this variable can be overridden by the prefix arg of the
+windmove-display-* commands that use `windmove-display-in-direction'.
+
+When `switch-to-buffer-obey-display-actions' is non-nil,
+`switch-to-buffer' commands are also supported."
+ :type '(choice (const :tag "Select new window" nil)
+ (const :tag "Select old window" t)
+ (const :tag "Don't select a window" ignore))
:version "27.1")
(defun windmove-display-in-direction (dir &optional arg)
@@ -454,11 +518,17 @@ Default value of MODIFIERS is `shift'."
The next buffer is the buffer displayed by the next command invoked
immediately after this command (ignoring reading from the minibuffer).
Create a new window if there is no window in that direction.
-By default, select the window with a displayed buffer.
-If prefix ARG is `C-u', reselect a previously selected window.
-If `windmove-display-no-select' is non-nil, this command doesn't
-select the window with a displayed buffer, and the meaning of
-the prefix argument is reversed.
+
+By default, select the new window with a displayed buffer.
+If `windmove-display-no-select' is `ignore', then allow the next command
+to decide what window it selects. With other non-nil values of
+`windmove-display-no-select', this function reselects
+a previously selected old window.
+
+If prefix ARG is `C-u', reselect a previously selected old window.
+If `windmove-display-no-select' is non-nil, the meaning of
+the prefix argument is reversed and it selects the new window.
+
When `switch-to-buffer-obey-display-actions' is non-nil,
`switch-to-buffer' commands are also supported."
(let ((no-select (xor (consp arg) windmove-display-no-select)))
@@ -483,42 +553,47 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
((eq dir 'same-window)
(selected-window))
(t (window-in-direction
- dir nil nil
+ dir nil windmove-allow-all-windows
(and arg (prefix-numeric-value arg))
windmove-wrap-around 'nomini)))))
(unless window
(setq window (split-window nil nil dir) type 'window))
(cons window type)))
(lambda (old-window new-window)
- (when (window-live-p (if no-select old-window new-window))
+ (when (and (not (eq windmove-display-no-select 'ignore))
+ (window-live-p (if no-select old-window new-window)))
(select-window (if no-select old-window new-window))))
(format "[display-%s]" dir))))
;;;###autoload
(defun windmove-display-left (&optional arg)
"Display the next buffer in window to the left of the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'."
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'."
(interactive "P")
(windmove-display-in-direction 'left arg))
;;;###autoload
(defun windmove-display-up (&optional arg)
"Display the next buffer in window above the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'."
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'."
(interactive "P")
(windmove-display-in-direction 'up arg))
;;;###autoload
(defun windmove-display-right (&optional arg)
"Display the next buffer in window to the right of the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'."
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'."
(interactive "P")
(windmove-display-in-direction 'right arg))
;;;###autoload
(defun windmove-display-down (&optional arg)
"Display the next buffer in window below the current one.
-See the logic of the prefix ARG in `windmove-display-in-direction'."
+See the logic of the prefix ARG and `windmove-display-no-select'
+in `windmove-display-in-direction'."
(interactive "P")
(windmove-display-in-direction 'down arg))
@@ -546,17 +621,21 @@ See the logic of the prefix ARG in `windmove-display-in-direction'."
Keys are bound to commands that display the next buffer in the specified
direction. Keybindings are of the form MODIFIERS-{left,right,up,down},
where MODIFIERS is either a list of modifiers or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to
+the arrow keys.
Default value of MODIFIERS is `shift-meta'."
(interactive)
(unless modifiers (setq modifiers '(shift meta)))
+ (when (eq modifiers 'none) (setq modifiers nil))
(unless (listp modifiers) (setq modifiers (list modifiers)))
- (global-set-key (vector (append modifiers '(left))) 'windmove-display-left)
- (global-set-key (vector (append modifiers '(right))) 'windmove-display-right)
- (global-set-key (vector (append modifiers '(up))) 'windmove-display-up)
- (global-set-key (vector (append modifiers '(down))) 'windmove-display-down)
- (global-set-key (vector (append modifiers '(?0))) 'windmove-display-same-window)
- (global-set-key (vector (append modifiers '(?f))) 'windmove-display-new-frame)
- (global-set-key (vector (append modifiers '(?t))) 'windmove-display-new-tab))
+ (windmove-install-defaults nil modifiers
+ '((windmove-display-left left)
+ (windmove-display-right right)
+ (windmove-display-up up)
+ (windmove-display-down down)
+ (windmove-display-same-window ?0)
+ (windmove-display-new-frame ?f)
+ (windmove-display-new-tab ?t))))
;;; Directional window deletion
@@ -568,8 +647,8 @@ With `M-0' prefix, delete the selected window and
select the window at direction DIR.
When `windmove-wrap-around' is non-nil, takes the window
from the opposite side of the frame."
- (let ((other-window (window-in-direction dir nil nil arg
- windmove-wrap-around 'nomini)))
+ (let ((other-window (window-in-direction dir nil windmove-allow-all-windows
+ arg windmove-wrap-around 'nomini)))
(cond ((null other-window)
(user-error "No window %s from selected window" dir))
(t
@@ -618,16 +697,22 @@ select the window that was below the current one."
Keys are bound to commands that delete windows in the specified
direction. Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down},
where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or
-a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
+a single modifier.
+If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings
+are directly bound to the arrow keys.
+Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
(interactive)
(unless prefix (setq prefix '(?\C-x)))
+ (when (eq prefix 'none) (setq prefix nil))
(unless (listp prefix) (setq prefix (list prefix)))
(unless modifiers (setq modifiers '(shift)))
+ (when (eq modifiers 'none) (setq modifiers nil))
(unless (listp modifiers) (setq modifiers (list modifiers)))
- (global-set-key (vector prefix (append modifiers '(left))) 'windmove-delete-left)
- (global-set-key (vector prefix (append modifiers '(right))) 'windmove-delete-right)
- (global-set-key (vector prefix (append modifiers '(up))) 'windmove-delete-up)
- (global-set-key (vector prefix (append modifiers '(down))) 'windmove-delete-down))
+ (windmove-install-defaults prefix modifiers
+ '((windmove-delete-left left)
+ (windmove-delete-right right)
+ (windmove-delete-up up)
+ (windmove-delete-down down))))
;;; Directional window swap states
@@ -636,8 +721,8 @@ a single modifier. Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
"Swap the states of the selected window and the window at direction DIR.
When `windmove-wrap-around' is non-nil, takes the window
from the opposite side of the frame."
- (let ((other-window (window-in-direction dir nil nil nil
- windmove-wrap-around 'nomini)))
+ (let ((other-window (window-in-direction dir nil windmove-allow-all-windows
+ nil windmove-wrap-around 'nomini)))
(cond ((or (null other-window) (window-minibuffer-p other-window))
(user-error "No window %s from selected window" dir))
(t
@@ -673,14 +758,99 @@ from the opposite side of the frame."
Keys are bound to commands that swap the states of the selected window
with the window in the specified direction. Keybindings are of the form
MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers
-or a single modifier. Default value of MODIFIERS is `shift-super'."
+or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to the
+arrow keys.
+Default value of MODIFIERS is `shift-super'."
(interactive)
(unless modifiers (setq modifiers '(shift super)))
+ (when (eq modifiers 'none) (setq modifiers nil))
(unless (listp modifiers) (setq modifiers (list modifiers)))
- (global-set-key (vector (append modifiers '(left))) 'windmove-swap-states-left)
- (global-set-key (vector (append modifiers '(right))) 'windmove-swap-states-right)
- (global-set-key (vector (append modifiers '(up))) 'windmove-swap-states-up)
- (global-set-key (vector (append modifiers '(down))) 'windmove-swap-states-down))
+ (windmove-install-defaults nil modifiers
+ '((windmove-swap-states-left left)
+ (windmove-swap-states-right right)
+ (windmove-swap-states-up up)
+ (windmove-swap-states-down down))))
+
+
+
+(defconst windmove--default-keybindings-type
+ `(choice (const :tag "Don't bind" nil)
+ (cons :tag "Bind using"
+ (key-sequence :tag "Prefix")
+ (set :tag "Modifier"
+ :greedy t
+ ;; See `(elisp) Keyboard Events'
+ (const :tag "Meta" meta)
+ (const :tag "Control" control)
+ (const :tag "Shift" shift)
+ (const :tag "Hyper" hyper)
+ (const :tag "Super" super)
+ (const :tag "Alt" alt))))
+ "Customisation type for windmove modifiers.")
+
+(defcustom windmove-default-keybindings nil
+ "Default keybindings for regular windmove commands.
+See `windmove-default-keybindings' for more detail."
+ :set (lambda (sym val)
+ (windmove-install-defaults
+ (car val) (cdr val)
+ '((windmove-left left)
+ (windmove-right right)
+ (windmove-up up)
+ (windmove-down down))
+ (null val))
+ (set-default sym val))
+ :type windmove--default-keybindings-type
+ :version "28.1")
+
+(defcustom windmove-display-default-keybindings nil
+ "Default keybindings for windmove directional buffer display commands.
+See `windmove-display-default-keybindings' for more detail."
+ :set (lambda (sym val)
+ (windmove-install-defaults
+ (car val) (cdr val)
+ '((windmove-display-left left)
+ (windmove-display-right right)
+ (windmove-display-up up)
+ (windmove-display-down down)
+ (windmove-display-same-window ?0)
+ (windmove-display-new-frame ?f)
+ (windmove-display-new-tab ?t))
+ (null val))
+ (set-default sym val))
+ :type windmove--default-keybindings-type
+ :version "28.1")
+
+(defcustom windmove-delete-default-keybindings nil
+ "Default keybindings for windmove directional window deletion commands.
+See `windmove-delete-default-keybindings' for more detail."
+ :set (lambda (sym val)
+ (windmove-install-defaults
+ (car val) (cdr val)
+ '((windmove-delete-left left)
+ (windmove-delete-right right)
+ (windmove-delete-up up)
+ (windmove-delete-down down))
+ (null val))
+ (set-default sym val))
+ :type windmove--default-keybindings-type
+ :version "28.1")
+
+(defcustom windmove-swap-states-default-keybindings nil
+ "Default keybindings for windmove's directional window swap-state commands.
+See `windmove-swap-states-default-keybindings' for more detail."
+ :set (lambda (sym val)
+ (windmove-install-defaults
+ (car val) (cdr val)
+ '((windmove-swap-states-left left)
+ (windmove-swap-states-right right)
+ (windmove-swap-states-up up)
+ (windmove-swap-states-down down))
+ (null val))
+ (set-default sym val))
+ :type windmove--default-keybindings-type
+ :version "28.1")
(provide 'windmove)
diff --git a/lisp/window.el b/lisp/window.el
index 2d0a73b426d..e14d472cf3f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2499,14 +2499,16 @@ and no others."
(defalias 'some-window 'get-window-with-predicate)
-(defun get-lru-window (&optional all-frames dedicated not-selected)
+(defun get-lru-window (&optional all-frames dedicated not-selected no-other)
"Return the least recently used window on frames specified by ALL-FRAMES.
Return a full-width window if possible. A minibuffer window is
never a candidate. A dedicated window is never a candidate
unless DEDICATED is non-nil, so if all windows are dedicated, the
value is nil. Avoid returning the selected window if possible.
Optional argument NOT-SELECTED non-nil means never return the
-selected window.
+selected window. Optional argument NO-OTHER non-nil means to
+never return a window whose 'no-other-window' parameter is
+non-nil.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -2526,7 +2528,9 @@ selected frame and no others."
(let (best-window best-time second-best-window second-best-time time)
(dolist (window (window-list-1 nil 'nomini all-frames))
(when (and (or dedicated (not (window-dedicated-p window)))
- (or (not not-selected) (not (eq window (selected-window)))))
+ (or (not not-selected) (not (eq window (selected-window))))
+ (or (not no-other)
+ (not (window-parameter window 'no-other-window))))
(setq time (window-use-time window))
(if (or (eq window (selected-window))
(not (window-full-width-p window)))
@@ -2538,12 +2542,14 @@ selected frame and no others."
(setq best-window window)))))
(or best-window second-best-window)))
-(defun get-mru-window (&optional all-frames dedicated not-selected)
+(defun get-mru-window (&optional all-frames dedicated not-selected no-other)
"Return the most recently used window on frames specified by ALL-FRAMES.
A minibuffer window is never a candidate. A dedicated window is
never a candidate unless DEDICATED is non-nil, so if all windows
are dedicated, the value is nil. Optional argument NOT-SELECTED
-non-nil means never return the selected window.
+non-nil means never return the selected window. Optional
+argument NO-OTHER non-nil means to never return a window whose
+'no-other-window' parameter is non-nil.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -2565,17 +2571,21 @@ selected frame and no others."
(setq time (window-use-time window))
(when (and (or dedicated (not (window-dedicated-p window)))
(or (not not-selected) (not (eq window (selected-window))))
- (or (not best-time) (> time best-time)))
+ (or (not no-other)
+ (not (window-parameter window 'no-other-window)))
+ (or (not best-time) (> time best-time)))
(setq best-time time)
(setq best-window window)))
best-window))
-(defun get-largest-window (&optional all-frames dedicated not-selected)
+(defun get-largest-window (&optional all-frames dedicated not-selected no-other)
"Return the largest window on frames specified by ALL-FRAMES.
A minibuffer window is never a candidate. A dedicated window is
never a candidate unless DEDICATED is non-nil, so if all windows
are dedicated, the value is nil. Optional argument NOT-SELECTED
-non-nil means never return the selected window.
+non-nil means never return the selected window. Optional
+argument NO-OTHER non-nil means to never return a window whose
+'no-other-window' parameter is non-nil.
The following non-nil values of the optional argument ALL-FRAMES
have special meanings:
@@ -2596,7 +2606,9 @@ selected frame and no others."
best-window size)
(dolist (window (window-list-1 nil 'nomini all-frames))
(when (and (or dedicated (not (window-dedicated-p window)))
- (or (not not-selected) (not (eq window (selected-window)))))
+ (or (not not-selected) (not (eq window (selected-window))))
+ (or (not no-other)
+ (not (window-parameter window 'no-other-window))))
(setq size (* (window-pixel-height window)
(window-pixel-width window)))
(when (> size best-size)
@@ -3755,8 +3767,6 @@ WINDOW must be a valid window and defaults to the selected one.
If the option `window-resize-pixelwise' is non-nil minimize
WINDOW pixelwise."
(interactive)
- (when switch-to-buffer-preserve-window-point
- (window--before-delete-windows window))
(setq window (window-normalize-window window))
(window-resize
window
@@ -4119,7 +4129,7 @@ frame can be safely deleted."
(let ((minibuf (active-minibuffer-window)))
(and minibuf (eq frame (window-frame minibuf))
(not (eq (default-toplevel-value
- minibuffer-follows-selected-frame)
+ 'minibuffer-follows-selected-frame)
t)))))
'frame))
((window-minibuffer-p window)
@@ -4132,53 +4142,56 @@ frame can be safely deleted."
;; of its frame.
t))))
-(defun window--in-subtree-p (window root)
- "Return t if WINDOW is either ROOT or a member of ROOT's subtree."
- (or (eq window root)
- (let ((parent (window-parent window)))
- (catch 'done
- (while parent
- (if (eq parent root)
- (throw 'done t)
- (setq parent (window-parent parent))))))))
-
-;; This function is called by `delete-window' and
-;; `delete-other-windows' when `switch-to-buffer-preserve-window-point'
-;; evaluates non-nil: it allows `winner-undo' to restore the
-;; buffer point from deleted windows (Bug#23621).
-(defun window--before-delete-windows (&optional window)
- "Update `window-prev-buffers' before delete a window.
-Optional arg WINDOW, if non-nil, update WINDOW-START and POS
-in `window-prev-buffers' for all windows displaying same
-buffer as WINDOW. Otherwise, update `window-prev-buffers' for
-all windows.
-
-The new values for WINDOW-START and POS are those
-returned by `window-start' and `window-point' respectively.
-
-This function is called only if `switch-to-buffer-preserve-window-point'
-evaluates non-nil."
- (dolist (win (window-list))
- (let* ((buf (window-buffer (or window win)))
- (start (window-start win))
- (pos (window-point win))
- (entry (assq buf (window-prev-buffers win))))
- (cond (entry
- (let ((marker (nth 2 entry)))
- (unless (= pos marker)
- (set-marker (nth 1 entry) start buf)
- (set-marker marker pos buf))))
- (t
- (let ((prev-buf (window-prev-buffers win))
- (start-m (make-marker))
- (pos-m (make-marker)))
- (set-marker start-m start buf)
- (set-marker pos-m pos buf)
- (push (list buf start-m pos-m) prev-buf)
- (set-window-prev-buffers win prev-buf)))))))
+(defun window-at-x-y (x y &optional frame no-other)
+ "Return live window at coordinates X, Y on specified FRAME.
+X and Y are FRAME-relative pixel coordinates. A coordinate on an
+edge shared by two windows is attributed to the window on the
+right (or below). Return nil if no such window can be found.
+
+Optional argument FRAME must specify a live frame and defaults to
+the selected one. Optional argument NO-OTHER non-nil means to
+return nil if the window located at the specified coordinates has
+a non-nil `no-other-window' parameter."
+ (setq frame (window-normalize-frame frame))
+ (let* ((root-edges (window-edges (frame-root-window frame) nil nil t))
+ (root-left (nth 2 root-edges))
+ (root-bottom (nth 3 root-edges)))
+ (catch 'window
+ (walk-window-tree
+ (lambda (window)
+ (let ((edges (window-edges window nil nil t)))
+ (when (and (>= x (nth 0 edges))
+ (or (< x (nth 2 edges)) (= x root-left))
+ (>= y (nth 1 edges))
+ (or (< y (nth 3 edges)) (= y root-bottom)))
+ (if (and no-other (window-parameter window 'no-other-window))
+ (throw 'window nil)
+ (throw 'window window)))))
+ frame))))
+
+(defcustom delete-window-choose-selected 'mru
+ "How to choose a frame's selected window after window deletion.
+When a frame's selected window gets deleted, Emacs has to choose
+another live window on that frame to serve as its selected
+window. This option allows to control which window gets selected
+instead.
+
+The possible choices are 'mru' (the default) to select the most
+recently used window on that frame, and 'pos' to choose the
+window at the frame coordinates of point of the previously
+selected window. If this is nil, choose the frame's first window
+instead. A window with a non-nil `no-other-window' parameter is
+chosen only if all windows on that frame have that parameter set
+to a non-nil value."
+ :type '(choice (const :tag "Most recently used" mru)
+ (const :tag "At position of deleted" pos)
+ (const :tag "Frame's first " nil))
+ :group 'windows
+ :group 'frames
+ :version "28.1")
(defun delete-window (&optional window)
- "Delete WINDOW.
+ "Delete specified WINDOW.
WINDOW must be a valid window and defaults to the selected one.
Return nil.
@@ -4193,10 +4206,12 @@ Otherwise, if WINDOW is part of an atomic window, call
`delete-window' with the root of the atomic window as its
argument. Signal an error if WINDOW is either the only window on
its frame, the last non-side window, or part of an atomic window
-that is its frame's root window."
+that is its frame's root window.
+
+If WINDOW is the selected window on its frame, choose some other
+window as that frame's selected window according to the value of
+the option `delete-window-choose-selected'."
(interactive)
- (when switch-to-buffer-preserve-window-point
- (window--before-delete-windows))
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
(function (window-parameter window 'delete-window))
@@ -4230,11 +4245,11 @@ that is its frame's root window."
(window-combination-resize
(or window-combination-resize
(window-parameter parent 'window-side)))
- (frame-selected
- (window--in-subtree-p (frame-selected-window frame) window))
+ (frame-selected-window (frame-selected-window frame))
;; Emacs 23 preferably gives WINDOW's space to its left
;; sibling.
- (sibling (or (window-left window) (window-right window))))
+ (sibling (or (window-left window) (window-right window)))
+ frame-selected-window-edges frame-selected-window-pos)
(window--resize-reset frame horizontal)
(cond
((and (not (eq window-combination-resize t))
@@ -4250,15 +4265,63 @@ that is its frame's root window."
(t
;; Can't do without resizing fixed-size windows.
(window--resize-siblings window (- size) horizontal t)))
+
+ (when (eq delete-window-choose-selected 'pos)
+ ;; Remember edges and position of point of the selected window
+ ;; of WINDOW'S frame.
+ (setq frame-selected-window-edges
+ (window-edges frame-selected-window nil nil t))
+ (setq frame-selected-window-pos
+ (nth 2 (posn-at-point nil frame-selected-window))))
+
;; Actually delete WINDOW.
(delete-window-internal window)
(window--pixel-to-total frame horizontal)
- (when (and frame-selected
- (window-parameter
- (frame-selected-window frame) 'no-other-window))
- ;; `delete-window-internal' has selected a window that should
- ;; not be selected, fix this here.
- (other-window -1 frame))
+
+ ;; If we deleted the selected window of WINDOW's frame, choose
+ ;; another one based on `delete-window-choose-selected'. Note
+ ;; that both `window-at-x-y' and `get-mru-window' may fail to
+ ;; produce a suitable window in which case we will fall back on
+ ;; its frame's first window, chosen by `delete-window-internal'.
+ (cond
+ ((window-live-p frame-selected-window))
+ ((and frame-selected-window-pos
+ ;; We have a recorded position of point of the previously
+ ;; selected window. Try to find the window that is now
+ ;; at that position.
+ (let ((new-frame-selected-window
+ (window-at-x-y
+ (+ (nth 0 frame-selected-window-edges)
+ (car frame-selected-window-pos))
+ (+ (nth 1 frame-selected-window-edges)
+ (cdr frame-selected-window-pos))
+ frame t)))
+ (and new-frame-selected-window
+ ;; Select window at WINDOW's position at point.
+ (set-frame-selected-window
+ frame new-frame-selected-window)))))
+ ((and (eq delete-window-choose-selected 'mru)
+ ;; Try to use the most recently used window.
+ (let ((mru-window (get-mru-window frame nil nil t)))
+ (and mru-window
+ (set-frame-selected-window frame mru-window)))))
+ ((and (window-parameter
+ (frame-selected-window frame) 'no-other-window)
+ ;; If `delete-window-internal' selected a window with a
+ ;; non-nil 'no-other-window' parameter as its frame's
+ ;; selected window, try to choose another one.
+ (catch 'found
+ (walk-window-tree
+ (lambda (other)
+ (unless (window-parameter other 'no-other-window)
+ (set-frame-selected-window frame other)
+ (throw 'found t)))
+ frame))))
+ (t
+ ;; Record the window chosen by `delete-window-internal'.
+ (set-frame-selected-window
+ frame (frame-selected-window frame))))
+
(window--check frame)
;; Always return nil.
nil))))
@@ -4400,42 +4463,45 @@ This may be a useful alternative binding for \\[delete-other-windows]
;; The following function is called by `set-window-buffer' _before_ it
;; replaces the buffer of the argument window with the new buffer.
+(defun push-window-buffer-onto-prev (&optional window)
+ "Push entry for WINDOW's buffer onto WINDOW's prev-buffers list.
+WINDOW must be a live window and defaults to the selected one.
+
+Any duplicate entries for the buffer in the list are removed."
+ (let* ((window (window-normalize-window window t))
+ (buffer (window-buffer window))
+ (w-list (window-prev-buffers window))
+ (entry (assq buffer w-list)))
+ (when entry
+ (setq w-list (assq-delete-all buffer w-list)))
+ (let ((start (window-start window))
+ (point (window-point window)))
+ (setq entry
+ (cons buffer
+ (with-current-buffer buffer
+ (if entry
+ ;; We have an entry, update marker positions.
+ (list (set-marker (nth 1 entry) start)
+ (set-marker (nth 2 entry) point))
+ (list (copy-marker start)
+ (copy-marker
+ ;; Preserve window-point-insertion-type
+ ;; (Bug#12855)
+ point window-point-insertion-type))))))
+ (set-window-prev-buffers window (cons entry w-list)))))
+
(defun record-window-buffer (&optional window)
"Record WINDOW's buffer.
WINDOW must be a live window and defaults to the selected one."
(let* ((window (window-normalize-window window t))
- (buffer (window-buffer window))
- (entry (assq buffer (window-prev-buffers window))))
+ (buffer (window-buffer window)))
;; Reset WINDOW's next buffers. If needed, they are resurrected by
;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
(set-window-next-buffers window nil)
- (when entry
- ;; Remove all entries for BUFFER from WINDOW's previous buffers.
- (set-window-prev-buffers
- window (assq-delete-all buffer (window-prev-buffers window))))
-
;; Don't record insignificant buffers.
- (unless (eq (aref (buffer-name buffer) 0) ?\s)
- ;; Add an entry for buffer to WINDOW's previous buffers.
- (with-current-buffer buffer
- (let ((start (window-start window))
- (point (window-point window)))
- (setq entry
- (cons buffer
- (if entry
- ;; We have an entry, update marker positions.
- (list (set-marker (nth 1 entry) start)
- (set-marker (nth 2 entry) point))
- ;; Make new markers.
- (list (copy-marker start)
- (copy-marker
- ;; Preserve window-point-insertion-type
- ;; (Bug#12855).
- point window-point-insertion-type)))))
- (set-window-prev-buffers
- window (cons entry (window-prev-buffers window)))))
-
+ (when (not (eq (aref (buffer-name buffer) 0) ?\s))
+ (push-window-buffer-onto-prev window)
(run-hooks 'buffer-list-update-hook))))
(defun unrecord-window-buffer (&optional window buffer)
@@ -4460,8 +4526,10 @@ point to POINT. If WINDOW is selected this also sets BUFFER's
before was current this also makes BUFFER the current buffer."
(setq window (window-normalize-window window t))
(let ((selected (eq window (selected-window)))
- (current (eq (window-buffer window) (current-buffer))))
+ (current (eq (window-buffer window) (current-buffer)))
+ (dedicated-side (eq (window-dedicated-p window) 'side)))
(set-window-buffer window buffer)
+ (and dedicated-side (set-window-dedicated-p window 'side))
(when (and selected current)
(set-buffer buffer))
(when start
@@ -4595,11 +4663,11 @@ This function is called by `prev-buffer'."
;; Scan WINDOW's previous buffers first, skipping entries of next
;; buffers.
(dolist (entry (window-prev-buffers window))
- (when (and (setq new-buffer (car entry))
+ (when (and (not (eq (car entry) old-buffer))
+ (setq new-buffer (car entry))
(or (buffer-live-p new-buffer)
(not (setq killed-buffers
(cons new-buffer killed-buffers))))
- (not (eq new-buffer old-buffer))
(or (null pred) (funcall pred new-buffer))
;; When BURY-OR-KILL is nil, avoid switching to a
;; buffer in WINDOW's next buffers list.
@@ -4653,8 +4721,8 @@ This function is called by `prev-buffer'."
window new-buffer (nth 1 entry) (nth 2 entry))
(throw 'found t)))))
- (when skipped
- ;; Show first skipped buffer.
+ (when (and skipped (not (functionp switch-to-prev-buffer-skip)))
+ ;; Show first skipped buffer, unless skip was a function.
(setq new-buffer skipped)
(set-window-buffer-start-and-point window new-buffer)))
@@ -4762,11 +4830,12 @@ This function is called by `next-buffer'."
;; Scan WINDOW's reverted previous buffers last (must not use
;; nreverse here!)
(dolist (entry (reverse (window-prev-buffers window)))
- (when (and (setq new-buffer (car entry))
+ (when (and (not (eq new-buffer (car entry)))
+ (not (eq old-buffer (car entry)))
+ (setq new-buffer (car entry))
(or (buffer-live-p new-buffer)
(not (setq killed-buffers
(cons new-buffer killed-buffers))))
- (not (eq new-buffer old-buffer))
(or (null pred) (funcall pred new-buffer)))
(if (switch-to-prev-buffer-skip-p skip window new-buffer)
(setq skipped (or skipped new-buffer))
@@ -4774,8 +4843,8 @@ This function is called by `next-buffer'."
window new-buffer (nth 1 entry) (nth 2 entry))
(throw 'found t))))
- (when skipped
- ;; Show first skipped buffer.
+ (when (and skipped (not (functionp switch-to-prev-buffer-skip)))
+ ;; Show first skipped buffer, unless skip was a function.
(setq new-buffer skipped)
(set-window-buffer-start-and-point window new-buffer)))
@@ -4993,9 +5062,10 @@ window's lists of previous and next buffers."
(all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
(dolist (window (window-list-1 nil nil all-frames))
(if (eq (window-buffer window) buffer)
- (let ((deletable (window-deletable-p window)))
+ (let ((deletable (window-deletable-p window))
+ (dedicated (window-dedicated-p window)))
(cond
- ((and (eq deletable 'frame) (window-dedicated-p window))
+ ((and (eq deletable 'frame) dedicated)
;; Delete frame if and only if window is dedicated.
(delete-frame (window-frame window)))
((eq deletable t)
@@ -5004,7 +5074,10 @@ window's lists of previous and next buffers."
(t
;; In window switch to previous buffer.
(set-window-dedicated-p window nil)
- (switch-to-prev-buffer window 'bury))))
+ (switch-to-prev-buffer window 'bury)
+ ;; Restore the dedicated 'side' flag.
+ (when (eq dedicated 'side)
+ (set-window-dedicated-p window 'side)))))
;; If a window doesn't show BUFFER, unrecord BUFFER in it.
(unrecord-window-buffer window buffer)))))
@@ -5013,10 +5086,10 @@ window's lists of previous and next buffers."
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
and defaults to the current buffer.
-When a window showing BUFFER-OR-NAME is dedicated, that window is
-deleted. If that window is the only window on its frame, the
-frame is deleted too when there are other frames left. If there
-are no other frames left, some other buffer is displayed in that
+With the exception of side windows, when a window showing BUFFER-OR-NAME
+is dedicated, that window is deleted. If that window is the only window
+on its frame, the frame is deleted too when there are other frames left.
+If there are no other frames left, some other buffer is displayed in that
window.
This function removes the buffer denoted by BUFFER-OR-NAME from
@@ -5025,10 +5098,14 @@ all window-local buffer lists."
(let ((buffer (window-normalize-buffer buffer-or-name)))
(dolist (window (window-list-1 nil nil t))
(if (eq (window-buffer window) buffer)
- (unless (window--delete window t t)
- ;; Switch to another buffer in window.
- (set-window-dedicated-p window nil)
- (switch-to-prev-buffer window 'kill))
+ ;; Delete a dedicated window unless it is a side window.
+ (let ((dedicated-side (eq (window-dedicated-p window) 'side)))
+ (when (or dedicated-side (not (window--delete window t t)))
+ ;; Switch to another buffer in that window.
+ (set-window-dedicated-p window nil)
+ (if (switch-to-prev-buffer window 'kill)
+ (and dedicated-side (set-window-dedicated-p window 'side))
+ (window--delete window nil 'kill))))
;; Unrecord BUFFER in WINDOW.
(unrecord-window-buffer window buffer)))))
@@ -5050,6 +5127,10 @@ buffer. If WINDOW is not deleted, reset its `quit-restore'
parameter to nil. See Info node `(elisp) Quitting Windows' for
more details.
+If WINDOW's dedicated flag is t, try to delete WINDOW. If it
+equals the value 'side', restore that value when WINDOW is not
+deleted.
+
Optional second argument BURY-OR-KILL tells how to proceed with
the buffer of WINDOW. The following values are handled:
@@ -5072,16 +5153,16 @@ nil means to not handle the buffer in a particular way. This
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
- (prev-buffer
- (let* ((prev-buffers (window-prev-buffers window))
- (prev-buffer (caar prev-buffers)))
- (and (or (not (eq prev-buffer buffer))
- (and (cdr prev-buffers)
- (not (eq (setq prev-buffer (cadr prev-buffers))
- buffer))))
- prev-buffer)))
+ (prev-buffer (catch 'prev-buffer
+ (dolist (buf (window-prev-buffers window))
+ (unless (eq (car buf) buffer)
+ (throw 'prev-buffer (car buf))))))
+ (dedicated (window-dedicated-p window))
quad entry)
(cond
+ ;; First try to delete dedicated windows that are not side windows.
+ ((and dedicated (not (eq dedicated 'side))
+ (window--delete window 'dedicated (eq bury-or-kill 'kill))))
((and (not prev-buffer)
(eq (nth 1 quit-restore) 'tab)
(eq (nth 3 quit-restore) buffer))
@@ -5124,6 +5205,9 @@ nil means to not handle the buffer in a particular way. This
;; Restore WINDOW's previous buffer, start and point position.
(set-window-buffer-start-and-point
window (nth 0 quad) (nth 1 quad) (nth 2 quad))
+ ;; Restore the 'side' dedicated flag as well.
+ (when (eq dedicated 'side)
+ (set-window-dedicated-p window 'side))
;; Deal with the buffer we just removed from WINDOW.
(setq entry (and (eq bury-or-kill 'append)
(assq buffer (window-prev-buffers window))))
@@ -5150,7 +5234,14 @@ nil means to not handle the buffer in a particular way. This
(set-window-parameter window 'quit-restore nil)
;; Make sure that WINDOW is no more dedicated.
(set-window-dedicated-p window nil)
- (switch-to-prev-buffer window bury-or-kill)))
+ ;; Try to switch to a previous buffer. Delete the window only if
+ ;; that is not possible (Bug#48367).
+ (if (switch-to-prev-buffer window bury-or-kill)
+ (when (eq dedicated 'side)
+ (set-window-dedicated-p window 'side))
+ (window--delete window nil (eq bury-or-kill 'kill))
+ (when (window-live-p (nth 2 quit-restore))
+ (select-window (nth 2 quit-restore))))))
;; Deal with the buffer.
(cond
@@ -6171,29 +6262,27 @@ value can be also stored on disk and read back in a new session."
;; Select window if it's the selected one.
(when (cdr (assq 'selected state))
(select-window window))
- (when next-buffers
- (set-window-next-buffers
- window
- (delq nil (mapcar (lambda (buffer)
- (setq buffer (get-buffer buffer))
- (when (buffer-live-p buffer) buffer))
- next-buffers))))
- (when prev-buffers
- (set-window-prev-buffers
- window
- (delq nil (mapcar (lambda (entry)
- (let ((buffer (get-buffer (nth 0 entry)))
- (m1 (nth 1 entry))
- (m2 (nth 2 entry)))
- (when (buffer-live-p buffer)
- (list buffer
- (if (markerp m1) m1
- (set-marker (make-marker) m1
- buffer))
- (if (markerp m2) m2
- (set-marker (make-marker) m2
- buffer))))))
- prev-buffers)))))
+ (set-window-next-buffers
+ window
+ (delq nil (mapcar (lambda (buffer)
+ (setq buffer (get-buffer buffer))
+ (when (buffer-live-p buffer) buffer))
+ next-buffers)))
+ (set-window-prev-buffers
+ window
+ (delq nil (mapcar (lambda (entry)
+ (let ((buffer (get-buffer (nth 0 entry)))
+ (m1 (nth 1 entry))
+ (m2 (nth 2 entry)))
+ (when (buffer-live-p buffer)
+ (list buffer
+ (if (markerp m1) m1
+ (set-marker (make-marker) m1
+ buffer))
+ (if (markerp m2) m2
+ (set-marker (make-marker) m2
+ buffer))))))
+ prev-buffers))))
;; We don't want to raise an error in case the buffer does
;; not exist anymore, so we switch to a previous one and
;; save the window with the intention of deleting it later
@@ -7410,8 +7499,8 @@ For instance:
Buffer display can be further customized to a very high degree;
the rest of this docstring explains some of the many
-possibilities, and also see `(emacs)Window Choice' for more
-information.
+possibilities, and also see Info node `(emacs)Window Choice' for
+more information.
BUFFER-OR-NAME must be a buffer or a string naming a live buffer.
Return the window chosen for displaying that buffer, or nil if no
@@ -8645,6 +8734,13 @@ documentation for additional customization information."
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
nil. Return the buffer switched to.
+This uses the function `display-buffer' as a subroutine to
+display the buffer; see its documentation for additional
+customization information. By default, if the buffer is already
+displayed (even in the current frame), that window is selected.
+If the buffer isn't displayed in any frame, a new frame is popped
+up and the buffer is displayed there.
+
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.
@@ -8656,10 +8752,7 @@ buffer, create a new buffer with that name. If BUFFER-OR-NAME is
nil, switch to the buffer returned by `other-buffer'.
Optional second arg NORECORD non-nil means do not put this
-buffer at the front of the list of recently selected ones.
-
-This uses the function `display-buffer' as a subroutine; see its
-documentation for additional customization information."
+buffer at the front of the list of recently selected ones."
(interactive
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
@@ -8673,11 +8766,14 @@ meaning of these values in `window--display-buffer'.
Optional `post-function' is called after the buffer is displayed in the
window; the function takes two arguments: an old and new window.
Optional string argument `echo' can be used to add a prefix to the
-command echo keystrokes that should describe the current prefix state."
+command echo keystrokes that should describe the current prefix state.
+This returns an \"exit function\", which can be called with no argument
+to deactivate this overriding action."
(let* ((old-window (or (minibuffer-selected-window) (selected-window)))
(new-window nil)
(minibuffer-depth (minibuffer-depth))
(clearfun (make-symbol "clear-display-buffer-overriding-action"))
+ (postfun (make-symbol "post-display-buffer-override-next-command"))
(action (lambda (buffer alist)
(unless (> (minibuffer-depth) minibuffer-depth)
(let* ((ret (funcall pre-function buffer alist))
@@ -8686,22 +8782,24 @@ command echo keystrokes that should describe the current prefix state."
(setq new-window (window--display-buffer buffer window
type alist))
;; Reset display-buffer-overriding-action
- ;; after the first buffer display action
+ ;; after the first display-buffer action (bug#39722).
(funcall clearfun)
- (setq post-function nil)
new-window))))
(command this-command)
(echofun (when echo (lambda () echo)))
(exitfun
(lambda ()
- (setcar display-buffer-overriding-action
- (delq action (car display-buffer-overriding-action)))
- (remove-hook 'post-command-hook clearfun)
+ (funcall clearfun)
+ (remove-hook 'post-command-hook postfun)
(remove-hook 'prefix-command-echo-keystrokes-functions echofun)
(when (functionp post-function)
(funcall post-function old-window new-window)))))
(fset clearfun
(lambda ()
+ (setcar display-buffer-overriding-action
+ (delq action (car display-buffer-overriding-action)))))
+ (fset postfun
+ (lambda ()
(unless (or
;; Remove the hook immediately
;; after exiting the minibuffer.
@@ -8710,12 +8808,12 @@ command echo keystrokes that should describe the current prefix state."
;; adding the hook by the same command below.
(eq this-command command))
(funcall exitfun))))
- ;; Reset display-buffer-overriding-action
- ;; after the next command finishes
- (add-hook 'post-command-hook clearfun)
+ ;; Call post-function after the next command finishes (bug#49057).
+ (add-hook 'post-command-hook postfun)
(when echofun
(add-hook 'prefix-command-echo-keystrokes-functions echofun))
- (push action (car display-buffer-overriding-action))))
+ (push action (car display-buffer-overriding-action))
+ exitfun))
(defun set-window-text-height (window height)
@@ -8825,7 +8923,11 @@ font on WINDOW's frame."
(let* ((window (window-normalize-window window t))
(frame (window-frame window))
(default-font (face-font 'default frame)))
- (if (and (display-multi-font-p (frame-parameter frame 'display))
+ ;; Client frames can have the 'display' parameter set like for X
+ ;; frames, even though they are TTY frames, so make sure we won't
+ ;; be duped by that up front with 'framep'.
+ (if (and (not (eq (framep frame) t))
+ (display-multi-font-p (frame-parameter frame 'display))
(not (string-equal (frame-parameter frame 'font) default-font)))
(aref (font-info default-font frame) 3)
(frame-char-height frame))))
@@ -10088,6 +10190,9 @@ is active. This function is run by `mouse-autoselect-window-timer'."
;; already selected.
(and (not (eq frame (selected-frame)))
(frame-parameter frame 'no-accept-focus))
+ ;; Don't switch if window autoselection with mouse is active
+ ;; and minibuffer window is selected.
+ (and mouse-autoselect-window (window-minibuffer-p))
;; Don't switch to minibuffer window unless it's active.
(and (window-minibuffer-p window)
(not (minibuffer-window-active-p window))))
@@ -10252,6 +10357,32 @@ displaying that processes's buffer."
(define-key ctl-x-4-map "1" 'same-window-prefix)
(define-key ctl-x-4-map "4" 'other-window-prefix)
+(defvar other-window-repeat-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "o" 'other-window)
+ (define-key map "O" (lambda ()
+ (interactive)
+ (setq repeat-map 'other-window-repeat-map)
+ (other-window -1)))
+ map)
+ "Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
+(put 'other-window 'repeat-map 'other-window-repeat-map)
+
+(defvar resize-window-repeat-map
+ (let ((map (make-sparse-keymap)))
+ ;; Standard keys:
+ (define-key map "^" 'enlarge-window)
+ (define-key map "}" 'enlarge-window-horizontally)
+ (define-key map "{" 'shrink-window-horizontally)
+ ;; Additional keys:
+ (define-key map "v" 'shrink-window)
+ map)
+ "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
+(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
+(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
+(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
+(put 'shrink-window 'repeat-map 'resize-window-repeat-map)
+
(provide 'window)
;;; window.el ends here
diff --git a/lisp/winner.el b/lisp/winner.el
index 9506ac53bb2..8062fbae904 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,4 +1,4 @@
-;;; winner.el --- Restore old window configurations
+;;; winner.el --- Restore old window configurations -*- lexical-binding: t -*-
;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc.
@@ -33,14 +33,13 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'ring)
(defun winner-active-region ()
(declare (gv-setter (lambda (store)
`(if ,store (activate-mark) (deactivate-mark)))))
(region-active-p))
-(require 'ring)
-
(defgroup winner nil
"Restoring window configurations."
:group 'windows)
@@ -273,7 +272,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
(let* ((buffers nil)
(alive
;; Possibly update `winner-point-alist'
- (cl-loop for buf in (mapcar 'cdr (cdr conf))
+ (cl-loop for buf in (mapcar #'cdr (cdr conf))
for pos = (winner-get-point buf nil)
if (and pos (not (memq buf buffers)))
do (push buf buffers)
@@ -284,17 +283,8 @@ You may want to include buffer names such as *Help*, *Apropos*,
;; Restore points
(dolist (win (winner-sorted-window-list))
(unless (and (pop alive)
- (let* ((buf (window-buffer win))
- (pos (winner-get-point (window-buffer win) win))
- (entry (assq buf (window-prev-buffers win))))
- ;; Try to restore point of buffer in the selected
- ;; window (Bug#23621).
- (let ((marker (nth 2 entry)))
- (when (and switch-to-buffer-preserve-window-point
- marker
- (not (= marker pos)))
- (setq pos marker))
- (setf (window-point win) pos)))
+ (setf (window-point win)
+ (winner-get-point (window-buffer win) win))
(not (or (member (buffer-name (window-buffer win))
winner-boring-buffers)
(and winner-boring-buffers-regexp
@@ -317,7 +307,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
;; Return t if this is still a possible configuration.
(or (null xwins)
(progn
- (mapc 'delete-window (cdr xwins)) ; delete all but one
+ (mapc #'delete-window (cdr xwins)) ; delete all but one
(unless (one-window-p t)
(delete-window (car xwins))
t))))))
@@ -328,22 +318,20 @@ You may want to include buffer names such as *Help*, *Apropos*,
(defcustom winner-mode-hook nil
"Functions to run whenever Winner mode is turned on or off."
- :type 'hook
- :group 'winner)
+ :type 'hook)
(define-obsolete-variable-alias 'winner-mode-leave-hook
'winner-mode-off-hook "24.3")
(defcustom winner-mode-off-hook nil
"Functions to run whenever Winner mode is turned off."
- :type 'hook
- :group 'winner)
+ :type 'hook)
(defvar winner-mode-map
(let ((map (make-sparse-keymap)))
(unless winner-dont-bind-my-keys
- (define-key map [(control c) left] 'winner-undo)
- (define-key map [(control c) right] 'winner-redo))
+ (define-key map [(control c) left] #'winner-undo)
+ (define-key map [(control c) right] #'winner-redo))
map)
"Keymap for Winner mode.")
diff --git a/lisp/woman.el b/lisp/woman.el
index 9a03d30bb7f..fe9f8969c3e 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1,4 +1,4 @@
-;;; woman.el --- browse UN*X manual pages `wo (without) man'
+;;; woman.el --- browse UN*X manual pages `wo (without) man' -*- lexical-binding: t; -*-
;; Copyright (C) 2000-2021 Free Software Foundation, Inc.
@@ -69,13 +69,7 @@
;; Recommended use
;; ===============
-;; Put this in your .emacs:
-;; (autoload 'woman "woman"
-;; "Decode and browse a UN*X man page." t)
-;; (autoload 'woman-find-file "woman"
-;; "Find, decode and browse a specific UN*X man-page file." t)
-
-;; Then either (1 -- *RECOMMENDED*): If the `MANPATH' environment
+;; Either (1 -- *RECOMMENDED*): If the `MANPATH' environment
;; variable is set then WoMan will use it; otherwise you may need to
;; reset the Lisp variable `woman-manpath', and you may also want to
;; set the Lisp variable `woman-path'. Please see the online
@@ -139,14 +133,8 @@
;; ==============================
;; WoMan supports the GNU Emacs customization facility, and puts
-;; a customization group called `WoMan' in the `Help' group under the
-;; top-level `Emacs' group. In order to be able to customize WoMan
-;; without first loading it, add the following sexp to your .emacs:
-
-;; (defgroup woman nil
-;; "Browse UNIX manual pages `wo (without) man'."
-;; :tag "WoMan" :group 'help :load "woman")
-
+;; a customization group called `woman' in the `help' group under the
+;; top-level `emacs' group.
;; WoMan currently runs two hooks: `woman-pre-format-hook' immediately
;; before formatting a buffer and `woman-post-format-hook' immediately
@@ -400,8 +388,7 @@
;;; Code:
-(defvar woman-version "0.551 (beta)" "WoMan version information.")
-(make-obsolete-variable 'woman-version nil "28.1")
+(eval-when-compile (require 'cl-lib))
(require 'man)
(define-button-type 'WoMan-xref-man-page
@@ -430,14 +417,14 @@ As a special case, if PATHS is nil then replace it by calling
;; an empty substring of MANPATH denotes the default list.
(if (memq system-type '(windows-nt ms-dos))
(cond ((null paths)
- (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))
- ((string-match-p ";" paths)
+ (mapcar #'woman-Cyg-to-Win (woman-parse-man.conf)))
+ ((string-search ";" paths)
;; Assume DOS-style path-list...
(mapcan ; splice list into list
(lambda (x)
(if x
(list x)
- (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))))
+ (mapcar #'woman-Cyg-to-Win (woman-parse-man.conf))))
(parse-colon-path paths)))
((string-match-p "\\`[a-zA-Z]:" paths)
;; Assume single DOS-style path...
@@ -446,7 +433,7 @@ As a special case, if PATHS is nil then replace it by calling
;; Assume UNIX/Cygwin-style path-list...
(mapcan ; splice list into list
(lambda (x)
- (mapcar 'woman-Cyg-to-Win
+ (mapcar #'woman-Cyg-to-Win
(if x (list x) (woman-parse-man.conf))))
(let ((path-separator ":"))
(parse-colon-path paths)))))
@@ -521,7 +508,7 @@ Change only via `Customization' or the function `add-hook'."
(defcustom woman-man.conf-path
(let ((path '("/usr/lib" "/etc")))
(cond ((eq system-type 'windows-nt)
- (mapcar 'woman-Cyg-to-Win path))
+ (mapcar #'woman-Cyg-to-Win path))
((eq system-type 'darwin)
(cons "/usr/share/misc" path))
(t path)))
@@ -821,7 +808,7 @@ in the ncurses package include `toe.1m', `form.3x', etc.
Note: an optional compression regexp will be appended, so this regexp
MUST NOT end with any kind of string terminator such as $ or \\\\='."
:type 'regexp
- :set 'set-woman-file-regexp
+ :set #'set-woman-file-regexp
:group 'woman-interface)
(defcustom woman-file-compression-regexp
@@ -837,7 +824,7 @@ Should begin with \\. and end with \\\\=' and MUST NOT be optional."
;; not loaded by default!
:version "24.1" ; added xz
:type 'regexp
- :set 'set-woman-file-regexp
+ :set #'set-woman-file-regexp
:group 'woman-interface)
(defcustom woman-use-own-frame nil
@@ -1198,7 +1185,7 @@ Called both to generate and to check the cache!"
(setq dir (and (member (car dir) path) (cdr dir))))
(when dir
(cl-pushnew (substitute-in-file-name dir) lst :test #'equal))))
- (mapcar 'substitute-in-file-name woman-path)))
+ (mapcar #'substitute-in-file-name woman-path)))
(defun woman-read-directory-cache ()
"Load the directory and topic cache.
@@ -1287,9 +1274,11 @@ cache to be re-read."
;; Complete topic more carefully, i.e. use the completion
;; rather than the string entered by the user:
((setq files (all-completions topic woman-topic-all-completions))
- (while (/= (length topic) (length (car files)))
+ (while (and files
+ (/= (length topic) (length (car files))))
(setq files (cdr files)))
- (setq files (woman-file-name-all-completions (car files)))))
+ (when files
+ (setq files (woman-file-name-all-completions (car files))))))
(cond
((null files) nil) ; no file found for topic.
((null (cdr files)) (car (car files))) ; only 1 file for topic.
@@ -1513,14 +1502,14 @@ Also make each path-info component into a list.
(if (woman-not-member dir path) ; use each directory only once!
(setq files (nconc files
(directory-files dir t topic-regexp))))))
- (mapcar 'list files)))
+ (mapcar #'list files)))
;;; dired support
(defun woman-dired-define-key (key)
"Bind the argument KEY to the command `woman-dired-find-file'."
- (define-key dired-mode-map key 'woman-dired-find-file))
+ (define-key dired-mode-map key #'woman-dired-find-file))
(defsubst woman-dired-define-key-maybe (key)
"If KEY is undefined in Dired, bind it to command `woman-dired-find-file'."
@@ -1532,7 +1521,7 @@ Also make each path-info component into a list.
"Define dired keys to run WoMan according to `woman-dired-keys'."
(if woman-dired-keys
(if (listp woman-dired-keys)
- (mapc 'woman-dired-define-key woman-dired-keys)
+ (mapc #'woman-dired-define-key woman-dired-keys)
(woman-dired-define-key-maybe "w")
(woman-dired-define-key-maybe "W")))
(define-key-after (lookup-key dired-mode-map [menu-bar immediate])
@@ -1540,7 +1529,7 @@ Also make each path-info component into a list.
(if (featurep 'dired)
(woman-dired-define-keys)
- (add-hook 'dired-mode-hook 'woman-dired-define-keys))
+ (add-hook 'dired-mode-hook #'woman-dired-define-keys))
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
@@ -1766,15 +1755,15 @@ Leave point at end of new text. Return length of inserted text."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map Man-mode-map)
- (define-key map "R" 'woman-reformat-last-file)
- (define-key map "w" 'woman)
- (define-key map "\en" 'WoMan-next-manpage)
- (define-key map "\ep" 'WoMan-previous-manpage)
- (define-key map [M-mouse-2] 'woman-follow-word)
+ (define-key map "R" #'woman-reformat-last-file)
+ (define-key map "w" #'woman)
+ (define-key map "\en" #'WoMan-next-manpage)
+ (define-key map "\ep" #'WoMan-previous-manpage)
+ (define-key map [M-mouse-2] #'woman-follow-word)
;; We don't need to call `man' when we are in `woman-mode'.
- (define-key map [remap man] 'woman)
- (define-key map [remap man-follow] 'woman-follow)
+ (define-key map [remap man] #'woman)
+ (define-key map [remap man-follow] #'woman-follow)
map)
"Keymap for `woman-mode'.")
@@ -1868,30 +1857,22 @@ Argument EVENT is the invoking mouse event."
(defvar bookmark-make-record-function)
-(define-derived-mode woman-mode special-mode "WoMan"
+(define-derived-mode woman-mode man-common "WoMan"
"Turn on (most of) Man mode to browse a buffer formatted by WoMan.
WoMan is an ELisp emulation of much of the functionality of the Emacs
`man' command running the standard UN*X man and ?roff programs.
WoMan author: F.J.Wright@Maths.QMW.ac.uk
See `Man-mode' for additional details.
\\{woman-mode-map}"
- (let ((Man-build-page-list (symbol-function 'Man-build-page-list))
- (Man-strip-page-headers (symbol-function 'Man-strip-page-headers))
- (Man-unindent (symbol-function 'Man-unindent))
- (Man-goto-page (symbol-function 'Man-goto-page)))
+ ;; FIXME: Should all this just be re-arranged so that this can just
+ ;; inherit `man-common' and be done with it?
+ (cl-letf (((symbol-function 'Man-build-page-list) #'ignore)
+ ((symbol-function 'Man-strip-page-headers) #'ignore)
+ ((symbol-function 'Man-unindent) #'ignore)
+ ((symbol-function 'Man-goto-page) #'ignore))
;; Prevent inappropriate operations:
- (fset 'Man-build-page-list 'ignore)
- (fset 'Man-strip-page-headers 'ignore)
- (fset 'Man-unindent 'ignore)
- (fset 'Man-goto-page 'ignore)
- (unwind-protect
- (delay-mode-hooks (Man-mode))
- ;; Restore the status quo:
- (fset 'Man-build-page-list Man-build-page-list)
- (fset 'Man-strip-page-headers Man-strip-page-headers)
- (fset 'Man-unindent Man-unindent)
- (fset 'Man-goto-page Man-goto-page)
- (setq tab-width woman-tab-width)))
+ (delay-mode-hooks (Man-mode)))
+ (setq tab-width woman-tab-width)
(setq major-mode 'woman-mode
mode-name "WoMan")
;; Don't show page numbers like Man-mode does. (Online documents do
@@ -1902,7 +1883,7 @@ See `Man-mode' for additional details.
(setq imenu-generic-expression woman-imenu-generic-expression)
(setq-local imenu-space-replacement " ")
;; Bookmark support.
- (setq-local bookmark-make-record-function 'woman-bookmark-make-record)
+ (setq-local bookmark-make-record-function #'woman-bookmark-make-record)
;; For reformat ...
;; necessary when reformatting a file in its old buffer:
(setq imenu--last-menubar-index-alist nil)
@@ -1958,12 +1939,12 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(setq symbol (car p)) ; 1. name
(if (functionp symbol) ; 2. command doc
(if (setq doc (documentation symbol t))
- (substring doc 0 (string-match "\n" doc))
+ (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(if (custom-variable-p symbol) ; 3. variable doc
(if (setq doc (documentation-property
symbol 'variable-documentation t))
- (substring doc 0 (string-match "\n" doc))))))
+ (substring doc 0 (string-search "\n" doc))))))
(setq p (cdr p))))
;; Output the result:
(and (apropos-print t nil)
@@ -1974,7 +1955,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(defun WoMan-getpage-in-background (topic)
"Use TOPIC to start WoMan from `Man-follow-manual-reference'."
;; topic is a string, generally of the form "section topic"
- (let ((s (string-match " " topic)))
+ (let ((s (string-search " " topic)))
(if s (setq topic (substring topic (1+ s))))
(woman topic)))
@@ -2441,6 +2422,10 @@ Preserves location of `point'."
(defvar woman0-rename-alist) ; bound in woman0-roff-buffer
+;; Bound locally by woman[012]-roff-buffer, and woman0-macro.
+;; Use dynamically in woman-unquote and woman-forward-arg.
+(defvar woman-request)
+
(defun woman0-roff-buffer (from)
"Process conditional-type requests and user-defined macros.
Start at FROM and re-scan new text as appropriate."
@@ -2760,15 +2745,16 @@ Optional argument APPEND, if non-nil, means append macro."
;; request may be used dynamically (woman-interpolate-macro calls
;; woman-forward-arg).
-(defun woman0-macro (woman-request)
- "Process the macro call named WOMAN-REQUEST."
+(defun woman0-macro (request)
+ "Process the macro call named REQUEST."
;; Leaves point at start of new text.
- (let ((macro (assoc woman-request woman0-macro-alist)))
+ (let ((woman-request request)
+ (macro (assoc request woman0-macro-alist)))
(if macro
(woman-interpolate-macro (cdr macro))
;; SHOULD DELETE THE UNINTERPRETED REQUEST!!!!!
;; Output this message once only per call (cf. strings)?
- (WoMan-warn "Undefined macro %s not interpolated!" woman-request))))
+ (WoMan-warn "Undefined macro %s not interpolated!" request))))
(defun woman-interpolate-macro (macro)
"Interpolate (.de) or append (.am) expansion of MACRO into the buffer."
@@ -2992,11 +2978,6 @@ Useful for constructing the alist variable `woman-special-characters'."
;;; Formatting macros that do not cause a break:
-;; Bound locally by woman[012]-roff-buffer, and also, annoyingly and
-;; confusingly, as a function argument. Use dynamically in
-;; woman-unquote and woman-forward-arg.
-(defvar woman-request)
-
(defun woman-unquote (to)
"Delete any double-quote characters between point and TO.
Leave point at TO (which should be a marker)."
@@ -3077,7 +3058,7 @@ B-OR-I is the appropriate complete control line."
".SM -- Set the current line in small font, i.e. IGNORE!"
nil)
-(defalias 'woman1-SB 'woman1-B)
+(defalias 'woman1-SB #'woman1-B)
;; .SB -- Set the current line in small bold font, i.e. just embolden!
;; (This is what /usr/local/share/groff/tmac/tmac.an does. The
;; Linux man.7 is wrong about this!)
@@ -3207,27 +3188,27 @@ If optional arg CONCAT is non-nil then join arguments."
;;; Other non-breaking requests correctly ignored by nroff:
(put 'woman1-ps 'notfont t)
-(defalias 'woman1-ps 'woman-delete-whole-line)
+(defalias 'woman1-ps #'woman-delete-whole-line)
;; .ps -- Point size -- IGNORE!
(put 'woman1-ss 'notfont t)
-(defalias 'woman1-ss 'woman-delete-whole-line)
+(defalias 'woman1-ss #'woman-delete-whole-line)
;; .ss -- Space-character size -- IGNORE!
(put 'woman1-cs 'notfont t)
-(defalias 'woman1-cs 'woman-delete-whole-line)
+(defalias 'woman1-cs #'woman-delete-whole-line)
;; .cs -- Constant character space (width) mode -- IGNORE!
(put 'woman1-ne 'notfont t)
-(defalias 'woman1-ne 'woman-delete-whole-line)
+(defalias 'woman1-ne #'woman-delete-whole-line)
;; .ne -- Need vertical space -- IGNORE!
(put 'woman1-vs 'notfont t)
-(defalias 'woman1-vs 'woman-delete-whole-line)
+(defalias 'woman1-vs #'woman-delete-whole-line)
;; .vs -- Vertical base line spacing -- IGNORE!
(put 'woman1-bd 'notfont t)
-(defalias 'woman1-bd 'woman-delete-whole-line)
+(defalias 'woman1-bd #'woman-delete-whole-line)
;; .bd -- Embolden font -- IGNORE!
;;; Non-breaking SunOS-specific macros:
@@ -3238,7 +3219,7 @@ If optional arg CONCAT is non-nil then join arguments."
(woman-forward-arg 'unquote 'concat))
(put 'woman1-IX 'notfont t)
-(defalias 'woman1-IX 'woman-delete-whole-line)
+(defalias 'woman1-IX #'woman-delete-whole-line)
;; .IX -- Index macro, for Sun internal use -- IGNORE!
@@ -3587,7 +3568,7 @@ expression in parentheses. Leaves point after the value."
inc (cdr value)
;; eval internal (.X) registers
;; stored as lisp variable names:
- value (eval (car value)))
+ value (eval (car value) t))
(if (and pm inc) ; auto-increment
(setq value
(funcall (intern-soft pm) value inc)
@@ -3647,64 +3628,55 @@ expression in parentheses. Leaves point after the value."
"Process breaks. Format paragraphs and headings."
(let ((case-fold-search t)
(to (make-marker))
- (canonically-space-region
- (symbol-function 'canonically-space-region))
- (insert-and-inherit (symbol-function 'insert-and-inherit))
- (set-text-properties (symbol-function 'set-text-properties))
(woman-registers woman-registers)
fn woman-request woman-translations
tab-stop-list)
(set-marker-insertion-type to t)
;; ?roff does not squeeze multiple spaces, but does fill, so...
- (fset 'canonically-space-region 'ignore)
- ;; Try to avoid spaces inheriting underlines from preceding text!
- (fset 'insert-and-inherit (symbol-function 'insert))
- (fset 'set-text-properties 'ignore)
- (unwind-protect
- (progn
- (while
- ;; Find next control line:
- (re-search-forward woman-request-regexp nil t)
- (cond
- ;; Construct woman function to call:
- ((setq fn (intern-soft
- (concat "woman2-"
- (setq woman-request (match-string 1)))))
- ;; Delete request or macro name:
- (woman-delete-match 0))
- ;; Unrecognized request:
- ((prog1 nil
- ;; (WoMan-warn ".%s request ignored!" woman-request)
- (WoMan-warn-ignored woman-request "ignored!")
- ;; (setq fn 'woman2-LP)
- ;; AVOID LEAVING A BLANK LINE!
- ;; (setq fn 'woman2-format-paragraphs)
- ))
- ;; .LP assumes it is at eol and leaves a (blank) line,
- ;; so leave point at end of line before paragraph:
- ((or (looking-at "[ \t]*$") ; no argument
- woman-ignore) ; ignore all
- ;; (beginning-of-line) (kill-line)
- ;; AVOID LEAVING A BLANK LINE!
- (beginning-of-line) (woman-delete-line 1))
- (t (end-of-line) (insert ?\n)))
- (if (not (or fn
- (and (not (memq (following-char) '(?. ?')))
- (setq fn 'woman2-format-paragraphs))))
- ()
- ;; Find next control line:
- (if (equal woman-request "TS")
- (set-marker to (woman-find-next-control-line "TE"))
- (set-marker to (woman-find-next-control-line)))
- ;; Call the appropriate function:
- (funcall fn to)))
- (if (not (eobp)) ; This should not happen, but ...
- (woman2-format-paragraphs (copy-marker (point-max) t)
- woman-left-margin)))
- (fset 'canonically-space-region canonically-space-region)
- (fset 'set-text-properties set-text-properties)
- (fset 'insert-and-inherit insert-and-inherit)
- (set-marker to nil))))
+ (cl-letf (((symbol-function 'canonically-space-region) #'ignore)
+ ;; Try to avoid spaces inheriting underlines from preceding text!
+ ((symbol-function 'insert-and-inherit) #'insert)
+ ((symbol-function 'set-text-properties) #'ignore))
+ (while
+ ;; Find next control line:
+ (re-search-forward woman-request-regexp nil t)
+ (cond
+ ;; Construct woman function to call:
+ ((setq fn (intern-soft
+ (concat "woman2-"
+ (setq woman-request (match-string 1)))))
+ ;; Delete request or macro name:
+ (woman-delete-match 0))
+ ;; Unrecognized request:
+ ((prog1 nil
+ ;; (WoMan-warn ".%s request ignored!" woman-request)
+ (WoMan-warn-ignored woman-request "ignored!")
+ ;; (setq fn 'woman2-LP)
+ ;; AVOID LEAVING A BLANK LINE!
+ ;; (setq fn 'woman2-format-paragraphs)
+ ))
+ ;; .LP assumes it is at eol and leaves a (blank) line,
+ ;; so leave point at end of line before paragraph:
+ ((or (looking-at "[ \t]*$") ; no argument
+ woman-ignore) ; ignore all
+ ;; (beginning-of-line) (kill-line)
+ ;; AVOID LEAVING A BLANK LINE!
+ (beginning-of-line) (woman-delete-line 1))
+ (t (end-of-line) (insert ?\n)))
+ (if (not (or fn
+ (and (not (memq (following-char) '(?. ?')))
+ (setq fn 'woman2-format-paragraphs))))
+ ()
+ ;; Find next control line:
+ (if (equal woman-request "TS")
+ (set-marker to (woman-find-next-control-line "TE"))
+ (set-marker to (woman-find-next-control-line)))
+ ;; Call the appropriate function:
+ (funcall fn to)))
+ (if (not (eobp)) ; This should not happen, but ...
+ (woman2-format-paragraphs (copy-marker (point-max) t)
+ woman-left-margin)))
+ (set-marker to nil)))
(defun woman-find-next-control-line (&optional pat)
"Find and return start of next control line.
@@ -3815,8 +3787,8 @@ Leave 1 blank line. Format paragraphs upto TO."
(setq woman-prevailing-indent woman-default-indent)
(woman2-format-paragraphs to woman-left-margin))
-(defalias 'woman2-PP 'woman2-LP)
-(defalias 'woman2-P 'woman2-LP)
+(defalias 'woman2-PP #'woman2-LP)
+(defalias 'woman2-P #'woman2-LP)
(defun woman2-ns (to)
".ns -- Turn on no-space mode. Format paragraphs upto TO."
@@ -3868,7 +3840,7 @@ Leave 1 blank line. Format paragraphs upto TO."
((eolp) ; extend line
;; Insert character INCLUDING TEXT PROPERTIES:
;; (insert (substring overlap i (1+ i)))
- (let ((eol (string-match "\n" overlap i)))
+ (let ((eol (string-search "\n" overlap i)))
(insert (substring overlap i eol))
(setq i (or eol imax)))
)
@@ -4287,16 +4259,16 @@ Set prevailing indent to amount of starting .RS."
If no argument then use value of optional arg PREVIOUS if non-nil,
otherwise set PREVIOUS. Delete the whole remaining control line."
(if (eolp) ; space already skipped
- (set arg (if previous (eval previous) 0))
- (if previous (set previous (eval arg)))
+ (set arg (if previous (symbol-value previous) 0))
+ (if previous (set previous (symbol-value arg)))
(woman2-process-escapes-to-eol 'numeric)
(let ((pm (if (looking-at "[+-]")
(prog1 (following-char)
(forward-char 1))))
(i (woman-parse-numeric-arg)))
(cond ((null pm) (set arg i))
- ((= pm ?+) (set arg (+ (eval arg) i)))
- ((= pm ?-) (set arg (- (eval arg) i)))
+ ((= pm ?+) (set arg (+ (symbol-value arg) i)))
+ ((= pm ?-) (set arg (- (symbol-value arg) i)))
))
(beginning-of-line))
(woman-delete-line 1)) ; ignore any remaining arguments
@@ -4493,7 +4465,7 @@ Format paragraphs upto TO."
(setq woman-nofill t)
(woman2-format-paragraphs to))
-(defalias 'woman2-TE 'woman2-fi)
+(defalias 'woman2-TE #'woman2-fi)
;; ".TE -- End of table code for the tbl processor."
;; Turn filling and adjusting back on.
@@ -4607,6 +4579,11 @@ logging the message."
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))
+;; Obsolete.
+
+(defvar woman-version "0.551 (beta)" "WoMan version information.")
+(make-obsolete-variable 'woman-version 'emacs-version "28.1")
+
(provide 'woman)
;;; woman.el ends here
diff --git a/lisp/xdg.el b/lisp/xdg.el
index 0f0df53d27e..e5165bbd86a 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -208,8 +208,8 @@ Optional argument GROUP defaults to the string \"Desktop Entry\"."
"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))
+ (dolist (x (split-string (string-replace "\\;" "\0" value) ";"))
+ (push (string-replace "\0" ";" x) res))
(when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
(nreverse res)))
@@ -231,7 +231,7 @@ admin config, and finally system cached associations."
(desktop (getenv "XDG_CURRENT_DESKTOP"))
res)
(when desktop
- (setq desktop (format "%s-mimeapps.list" desktop)))
+ (setq desktop (list (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))
@@ -256,8 +256,8 @@ which is expected to be ordered by priority as in
(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))
+ (let () ;; end
+ (while (not (or (eobp))) ;; end
(if (= (following-char) ?\[)
(progn (setq sec (char-after (1+ (point))))
(forward-line))
diff --git a/lisp/xml.el b/lisp/xml.el
index 4e2dd13ecbd..1b2d6557388 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -922,11 +922,11 @@ references and parameter-entity references."
(progn
(setq elem (match-string-no-properties 1 string)
modifier (match-string-no-properties 2 string))
- (if (string-match-p "|" elem)
+ (if (string-search "|" elem)
(setq elem (cons 'choice
(mapcar 'xml-parse-elem-type
(split-string elem "|"))))
- (if (string-match-p "," elem)
+ (if (string-search "," elem)
(setq elem (cons 'seq
(mapcar 'xml-parse-elem-type
(split-string elem ",")))))))
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index 28c16acbabc..fb0ae0e1c21 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -26,6 +26,7 @@ all: liblw.a
.PHONY: all
srcdir=@srcdir@
+top_builddir=@top_builddir@
# MinGW CPPFLAGS may use this.
abs_top_srcdir=@abs_top_srcdir@
VPATH=@srcdir@
@@ -56,23 +57,7 @@ TOOLKIT_OBJS = $(@X_TOOLKIT_TYPE@_OBJS)
OBJS = lwlib.o $(TOOLKIT_OBJS) lwlib-utils.o
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index cd6f7b4bbdf..05e7faa9937 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -89,6 +89,7 @@ AC_DEFUN([gl_EARLY],
# Code from module fcntl:
# Code from module fcntl-h:
# Code from module fdopendir:
+ # Code from module file-has-acl:
# Code from module filemode:
# Code from module filename:
# Code from module filevercmp:
@@ -287,6 +288,7 @@ AC_DEFUN([gl_INIT],
fi
gl_DIRENT_MODULE_INDICATOR([fdopendir])
gl_MODULE_INDICATOR([fdopendir])
+ gl_FILE_HAS_ACL
gl_FILEMODE
AC_C_FLEXIBLE_ARRAY_MEMBER
gl_FUNC_FPENDING
@@ -1045,6 +1047,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/fcntl.c
lib/fcntl.in.h
lib/fdopendir.c
+ lib/file-has-acl.c
lib/filemode.c
lib/filemode.h
lib/filename.h
diff --git a/make-dist b/make-dist
index 606fdd9e3a0..7074bb801be 100755
--- a/make-dist
+++ b/make-dist
@@ -52,7 +52,6 @@ make_tar=no
default_gzip=gzip
newer=""
with_info=yes
-with_tests=yes
changelog=yes
verbose=no
@@ -109,16 +108,10 @@ while [ $# -gt 0 ]; do
update=no
;;
- ## Include the test/ directory.
- ## This is for backward compatibility to when --no-tests was the default.
- "--tests")
- with_tests=yes
+ "--tests"|"--no-tests")
+ echo "The option $1 no longer does anything"
;;
- ## Exclude the test/ directory.
- "--no-tests")
- with_tests=no
- ;;
"--verbose")
verbose=yes
@@ -136,7 +129,6 @@ while [ $# -gt 0 ]; do
echo " --no-update don't recompile or do analogous things"
echo " --no-changelog don't generate the top-level ChangeLog"
echo " --no-info don't include info files"
- echo " --no-tests don't include the test/ directory"
echo " --snapshot same as --clean-up --no-update --tar"
echo " --tar make a tar file"
echo " --verbose noisier output"
@@ -402,11 +394,7 @@ manifest=MANIFEST
# if .git is present.
if ( [ $update = yes ] || [ ! -f $manifest ] ) && [ -r .git ]; then
echo "Updating $manifest"
- if [ $with_tests = yes ]; then
- git ls-files > $manifest
- else
- git ls-files | grep -v '^test' >$manifest
- fi || exit
+ git ls-files > $manifest || exit
printf '%s\n' $possibly_non_vc_files $info_files >>$manifest || exit
sort -u -o $manifest $manifest || exit
fi
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
index 3168fee76c0..42b2ab2715d 100644
--- a/nextstep/Makefile.in
+++ b/nextstep/Makefile.in
@@ -36,6 +36,7 @@ MKDIR_P = @MKDIR_P@
ns_appdir = @ns_appdir@
## GNUstep: ns_appdir; macOS: ns_appdir/Contents/MacOS
ns_appbindir = @ns_appbindir@
+ns_applibexecdir = @ns_applibexecdir@
## GNUstep/Emacs.base or Cocoa/Emacs.base.
ns_appsrc = @ns_appsrc@
## GNUstep: GNUstep/Emacs.base/Resources/Info-gnustep.plist
@@ -44,7 +45,7 @@ ns_check_file = @ns_appdir@/@ns_check_file@
.PHONY: all
-all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_appbindir}/Emacs.pdmp
+all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_applibexecdir}/Emacs.pdmp
${ns_check_file} ${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc}
rm -rf ${ns_appdir}
@@ -63,8 +64,10 @@ ${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}
${MKDIR_P} ${ns_appbindir}
cp -f ../src/emacs${EXEEXT} $@
-${ns_appbindir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp
- ${MKDIR_P} ${ns_appbindir}
+# FIXME: Don't install the dump file into the app bundle when
+# self-contained install is disabled.
+${ns_applibexecdir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp
+ ${MKDIR_P} ${ns_applibexecdir}
cp -f ../src/emacs${EXEEXT}.pdmp $@
.PHONY: FORCE
@@ -85,9 +88,8 @@ links: ../src/emacs${EXEEXT}
ln -s $(top_srcdir_abs)/info ${ns_appdir}/Contents/Resources
${MKDIR_P} ${ns_appbindir}
ln -s $(abs_top_builddir)/src/emacs${EXEEXT} ${ns_appbindir}/Emacs
- ln -s $(abs_top_builddir)/src/emacs${EXEEXT}.pdmp ${ns_appbindir}/Emacs.pdmp
ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/bin
- ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/libexec
+ ln -s $(abs_top_builddir)/lib-src ${ns_applibexecdir}
${MKDIR_P} ${ns_appdir}/Contents/Resources/etc
for f in $(shell cd $(top_srcdir_abs)/etc; ls); do ln -s $(top_srcdir_abs)/etc/$$f ${ns_appdir}/Contents/Resources/etc; done
ln -s $(abs_top_builddir)/etc/DOC ${ns_appdir}/Contents/Resources/etc
diff --git a/nt/Makefile.in b/nt/Makefile.in
index aa3a76280ef..3274ff924f9 100644
--- a/nt/Makefile.in
+++ b/nt/Makefile.in
@@ -41,23 +41,8 @@ WERROR_CFLAGS = @WERROR_CFLAGS@
# Program name transformation.
TRANSFORM = @program_transform_name@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_RC = $(am__v_RC_@AM_V@)
-am__v_RC_ = $(am__v_RC_@AM_DEFAULT_V@)
-am__v_RC_0 = @echo " RC " $@;
-am__v_RC_1 =
+top_builddir = @top_builddir@
+-include ${top_builddir}/src/verbose.mk
# ==================== Where To Install Things ====================
@@ -185,7 +170,7 @@ $(DESTDIR)${archlibdir}: all
fi
.PHONY: install uninstall mostlyclean clean distclean maintainer-clean
-.PHONY: bootstrap-clean extraclean check tags
+.PHONY: bootstrap-clean check tags
install: $(DESTDIR)${archlibdir}
@echo
@@ -218,9 +203,6 @@ distclean: clean
bootstrap-clean maintainer-clean: distclean
true
-extraclean: maintainer-clean
- -rm -f *~ \#*
-
## Test the contents of the directory.
check:
@echo "We don't have any tests for the nt/ directory yet."
diff --git a/nt/epaths.nt b/nt/epaths.nt
index ad60f6c6fa0..a75ed52a34a 100644
--- a/nt/epaths.nt
+++ b/nt/epaths.nt
@@ -49,6 +49,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
*/
#define PATH_SITELOADSEARCH "%emacs_dir%/share/emacs/@VER@/site-lisp;%emacs_dir%/share/emacs/site-lisp"
+/* Like PATH_LOADSEARCH, but contains the relative path from the
+ installation directory.
+*/
+#define PATH_REL_LOADSEARCH ""
+
/* Like PATH_LOADSEARCH, but used only during the build process
when Emacs is dumping. Configure (using "make epaths-force-w32") sets
this to $buildlisppath, which normally has the value: <srcdir>/lisp.
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index 5cdbde6bb5b..c85b9150f0c 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -68,3 +68,4 @@ OMIT_GNULIB_MODULE_fchmodat = true
OMIT_GNULIB_MODULE_lchmod = true
OMIT_GNULIB_MODULE_futimens = true
OMIT_GNULIB_MODULE_utimensat = true
+OMIT_GNULIB_MODULE_file-has-acl = true
diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site
index 96300774871..6ab81e943f1 100644
--- a/nt/mingw-cfg.site
+++ b/nt/mingw-cfg.site
@@ -90,8 +90,9 @@ ac_cv_func_readlinkat=yes
ac_cv_func_faccessat=yes
# Avoid compiling Gnulib's canonicalize-lgpl.c, which fails
ac_cv_func_canonicalize_file_name=yes
-ac_cv_func_realpath="not-needed"
-gl_cv_func_realpath_works="no-but-not-needed-so-yes"
+# Implemented in w32.c
+ac_cv_func_realpath=yes
+gl_cv_func_realpath_works=yes
# Implemented in w32.c
ac_cv_func_fcntl=yes
gl_cv_func_fcntl_f_dupfd_cloexec=yes
@@ -158,6 +159,10 @@ gl_cv_func_copy_file_range=yes
# We don't want to build Emacs so it depends on bcrypt.dll, since then
# it will refuse to start on systems where that DLL is absent.
gl_cv_lib_assume_bcrypt=no
+# Force 'ac_cv_func_strsignal' to no as mingw64 libgccjit exports this
+# symbol erroneously
+# <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=45303#83>.
+ac_cv_func_strsignal=no
# Don't build the Gnulib free.c: it is not needed, since the w32
# implementation of 'free' doesn't touch errno, and it emits a
# compilation warning.
diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c
index 7eb17c508d5..e209bbeceeb 100644
--- a/oldXMenu/Create.c
+++ b/oldXMenu/Create.c
@@ -598,6 +598,8 @@ XMenuCreate(Display *display, Window parent, register char const *def_env)
* Create pane, active, and inactive GC's.
*/
values = (XGCValues *)malloc(sizeof(XGCValues));
+ if (!values)
+ return NULL;
valuemask = (GCForeground | GCBackground | GCFont | GCLineWidth);
/*
diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c
index f489e27beab..3e97f9ab3f1 100644
--- a/oldXMenu/Internal.c
+++ b/oldXMenu/Internal.c
@@ -534,7 +534,6 @@ _XMRecomputePane(register Display *display, register XMenu *menu, register XMPan
register int window_y; /* Recomputed window Y coordinate. */
unsigned long change_mask; /* Value mask to reconfigure window. */
- XWindowChanges *changes; /* Values to use in configure window. */
register Bool config_p = False; /* Reconfigure pane window? */
@@ -612,21 +611,19 @@ _XMRecomputePane(register Display *display, register XMenu *menu, register XMPan
* it for creation with the new configuration.
*/
if (p_ptr->window) {
+ XWindowChanges changes;
change_mask = (CWX | CWY | CWWidth | CWHeight);
- changes = (XWindowChanges *)malloc(sizeof(XWindowChanges));
- changes->x = p_ptr->window_x;
- changes->y = p_ptr->window_y;
- changes->width = p_ptr->window_w;
- changes->height = p_ptr->window_h;
+ changes.x = p_ptr->window_x;
+ changes.y = p_ptr->window_y;
+ changes.width = p_ptr->window_w;
+ changes.height = p_ptr->window_h;
XConfigureWindow(
display,
p_ptr->window,
change_mask,
- changes
+ &changes
);
- free(changes);
-
}
else {
if (_XMWinQueAddPane(display, menu, p_ptr) == _FAILURE) {
@@ -681,7 +678,6 @@ _XMRecomputeSelection(register Display *display, register XMenu *menu, register
/* Selection sequence number. */
{
register Bool config_s = False; /* Reconfigure selection window? */
- XWindowChanges *changes; /* Values to change in configure. */
unsigned long change_mask; /* Value mask for XConfigureWindow. */
/*
@@ -738,22 +734,19 @@ _XMRecomputeSelection(register Display *display, register XMenu *menu, register
* for creation with the new configuration.
*/
if (s_ptr->window) {
- changes = (XWindowChanges *)malloc(sizeof(XWindowChanges));
+ XWindowChanges changes;
change_mask = (CWX | CWY | CWWidth | CWHeight);
- changes = (XWindowChanges *)malloc(sizeof(XWindowChanges));
- changes->x = s_ptr->window_x;
- changes->y = s_ptr->window_y;
- changes->width = s_ptr->window_w;
- changes->height = s_ptr->window_h;
+ changes.x = s_ptr->window_x;
+ changes.y = s_ptr->window_y;
+ changes.width = s_ptr->window_w;
+ changes.height = s_ptr->window_h;
XConfigureWindow(
display,
s_ptr->window,
change_mask,
- changes
+ &changes
);
- free(changes);
-
}
else {
if (_XMWinQueAddSelection(display, menu, s_ptr) == _FAILURE) {
diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in
index 7ae355b568d..39fd155735a 100644
--- a/oldXMenu/Makefile.in
+++ b/oldXMenu/Makefile.in
@@ -43,6 +43,7 @@
### Code:
srcdir=@srcdir@
+top_builddir = @top_builddir@
# MinGW CPPFLAGS may use this.
abs_top_srcdir=@abs_top_srcdir@
VPATH=@srcdir@
@@ -93,23 +94,7 @@ OBJS = Activate.o \
all: libXMenu11.a
.PHONY: all
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
diff --git a/oldXMenu/XMakeAssoc.c b/oldXMenu/XMakeAssoc.c
index 9bbde2cf94d..2530e8e507b 100644
--- a/oldXMenu/XMakeAssoc.c
+++ b/oldXMenu/XMakeAssoc.c
@@ -69,6 +69,8 @@ XMakeAssoc(register Display *dpy, register XAssocTable *table, register XID x_id
/* before the current value of "Entry". */
/* Create a new XAssoc and load it with new provided data. */
new_entry = (XAssoc *) malloc(sizeof(XAssoc));
+ if (!new_entry)
+ return; /* This obsolete API has no way to report failure! */
new_entry->display = dpy;
new_entry->x_id = x_id;
new_entry->data = data;
diff --git a/src/Makefile.in b/src/Makefile.in
index 4100edf4712..732cd8f0998 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -29,6 +29,7 @@ SHELL = @SHELL@
# We use $(srcdir) explicitly in dependencies so as not to depend on VPATH.
srcdir = @srcdir@
top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
# MinGW CPPFLAGS may use this.
abs_top_srcdir=@abs_top_srcdir@
VPATH = $(srcdir)
@@ -54,7 +55,7 @@ lwlibdir = ../lwlib
# Configuration files for .o files to depend on.
config_h = config.h $(srcdir)/conf_post.h
-## ns-app if HAVE_NS, else empty.
+## ns-app if NS self contained app, else empty.
OTHER_FILES = @OTHER_FILES@
## Flags to pass for profiling builds
@@ -241,7 +242,7 @@ LIBZ = @LIBZ@
## system-specific libs for dynamic modules, else empty
LIBMODULES = @LIBMODULES@
-## dynlib.o emacs-module.o if modules enabled, else empty
+## emacs-module.o if modules enabled, else empty
MODULES_OBJ = @MODULES_OBJ@
XRANDR_LIBS = @XRANDR_LIBS@
@@ -325,6 +326,12 @@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
LIBGMP = @LIBGMP@
+LIBGCCJIT_LIBS = @LIBGCCJIT_LIBS@
+LIBGCCJIT_CFLAGS = @LIBGCCJIT_CFLAGS@
+
+## dynlib.o if necessary, else empty
+DYNLIB_OBJ = @DYNLIB_OBJ@
+
RUN_TEMACS = ./temacs
# Whether builds should contain details. '--no-build-details' or empty.
@@ -336,37 +343,11 @@ DUMPING=@DUMPING@
CHECK_STRUCTS = @CHECK_STRUCTS@
HAVE_PDUMPER = @HAVE_PDUMPER@
-## ARM Macs require that all code have a valid signature. Since pump
+## ARM Macs require that all code have a valid signature. Since pdump
## invalidates the signature, we must re-sign to fix it.
DO_CODESIGN=$(patsubst aarch64-apple-darwin%,yes,@configuration@)
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
-
-AM_V_CC = $(am__v_CC_@AM_V@)
-am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
-am__v_CC_0 = @echo " CC " $@;
-am__v_CC_1 =
-
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
-
-AM_V_NO_PD = $(am__v_NO_PD_@AM_V@)
-am__v_NO_PD_ = $(am__v_NO_PD_@AM_DEFAULT_V@)
-am__v_NO_PD_0 = --no-print-directory
-am__v_NO_PD_1 =
+-include ${top_builddir}/src/verbose.mk
bootstrap_exe = ../src/bootstrap-emacs$(EXEEXT)
ifeq ($(DUMPING),pdumper)
@@ -387,7 +368,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \
-I$(lib) -I$(top_srcdir)/lib \
$(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
- $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
+ $(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(LIBGCCJIT_CFLAGS) $(DBUS_CFLAGS) \
$(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) $(XDBE_CFLAGS) \
$(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
@@ -417,7 +398,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
alloc.o pdumper.o data.o doc.o editfns.o callint.o \
eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \
- syntax.o $(UNEXEC_OBJ) bytecode.o \
+ syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
process.o gnutls.o callproc.o \
region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
@@ -426,7 +407,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
thread.o systhread.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
- $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) $(GMP_OBJ)
+ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
@@ -520,6 +501,7 @@ shortlisp := $(filter-out ${shortlisp_filter},${shortlisp})
## the critical path (relevant in parallel compilations).
## We don't really need to sort, but may as well use it to remove duplicates.
shortlisp := loaddefs.el loadup.el $(sort ${shortlisp})
+export LISP_PRELOADED = ${shortlisp}
lisp = $(addprefix ${lispsource}/,${shortlisp})
## Construct full set of libraries to be linked.
@@ -535,7 +517,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
- $(JSON_LIBS) $(LIBGMP)
+ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
@@ -585,7 +567,8 @@ endif
ifeq ($(DUMPING),pdumper)
$(pdmp): emacs$(EXEEXT)
- LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump
+ LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \
+ --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR)
cp -f $@ $(bootstrap_pdmp)
endif
@@ -621,11 +604,6 @@ buildobj.h: Makefile
GLOBAL_SOURCES = $(base_obj:.o=.c) $(NS_OBJC_OBJ:.o=.m)
-AM_V_GLOBALS = $(am__v_GLOBALS_@AM_V@)
-am__v_GLOBALS_ = $(am__v_GLOBALS_@AM_DEFAULT_V@)
-am__v_GLOBALS_0 = @echo " GEN " globals.h;
-am__v_GLOBALS_1 =
-
gl-stamp: $(libsrc)/make-docfile$(EXEEXT) $(GLOBAL_SOURCES)
$(AM_V_GLOBALS)$(libsrc)/make-docfile -d $(srcdir) -g $(obj) > globals.tmp
$(AM_V_at)$(top_srcdir)/build-aux/move-if-change globals.tmp globals.h
@@ -694,7 +672,7 @@ ns-app: emacs$(EXEEXT) $(pdmp)
$(MAKE) -C ../nextstep all
.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean
-.PHONY: versionclean extraclean
+.PHONY: versionclean
mostlyclean:
rm -f temacs$(EXEEXT) core ./*.core \#* ./*.o
@@ -724,14 +702,11 @@ bootstrap-clean: clean
fi
distclean: bootstrap-clean
- rm -f Makefile lisp.mk
+ rm -f Makefile lisp.mk verbose.mk
rm -fr $(DEPDIR)
maintainer-clean: distclean
rm -f TAGS
-extraclean: distclean
- rm -f ./*~ \#* TAGS config.in
-
ETAGS = ../lib-src/etags${EXEEXT}
@@ -821,7 +796,8 @@ endif
ifeq ($(DUMPING),pdumper)
$(bootstrap_pdmp): bootstrap-emacs$(EXEEXT)
rm -f $@
- $(RUN_TEMACS) --batch $(BUILD_DETAILS) -l loadup --temacs=pbootstrap
+ $(RUN_TEMACS) --batch $(BUILD_DETAILS) -l loadup --temacs=pbootstrap \
+ --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR)
@: Compile some files earlier to speed up further compilation.
$(MAKE) -C ../lisp compile-first EMACS="$(bootstrap_exe)"
endif
diff --git a/src/alloc.c b/src/alloc.c
index b86ed4ed262..4ea337ddbaa 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3152,6 +3152,26 @@ cleanup_vector (struct Lisp_Vector *vector)
module_finalize_function (function);
}
#endif
+ else if (NATIVE_COMP_FLAG
+ && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT))
+ {
+ struct Lisp_Native_Comp_Unit *cu =
+ PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
+ unload_comp_unit (cu);
+ }
+ else if (NATIVE_COMP_FLAG
+ && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR))
+ {
+ struct Lisp_Subr *subr =
+ PSEUDOVEC_STRUCT (vector, Lisp_Subr);
+ if (!NILP (subr->native_comp_u[0]))
+ {
+ /* FIXME Alternative and non invasive solution to this
+ cast? */
+ xfree ((char *)subr->symbol_name);
+ xfree (subr->native_c_name[0]);
+ }
+ }
}
/* Reclaim space used by unmarked vectors. */
@@ -3498,6 +3518,38 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
return val;
}
+DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0,
+ doc: /* Create a byte-code closure from PROTOTYPE and CLOSURE-VARS.
+Return a copy of PROTOTYPE, a byte-code object, with CLOSURE-VARS
+replacing the elements in the beginning of the constant-vector.
+usage: (make-closure PROTOTYPE &rest CLOSURE-VARS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ Lisp_Object protofun = args[0];
+ CHECK_TYPE (COMPILEDP (protofun), Qbyte_code_function_p, protofun);
+
+ /* Create a copy of the constant vector, filling it with the closure
+ variables in the beginning. (The overwritten part should just
+ contain placeholder values.) */
+ Lisp_Object proto_constvec = AREF (protofun, COMPILED_CONSTANTS);
+ ptrdiff_t constsize = ASIZE (proto_constvec);
+ ptrdiff_t nvars = nargs - 1;
+ if (nvars > constsize)
+ error ("Closure vars do not fit in constvec");
+ Lisp_Object constvec = make_uninit_vector (constsize);
+ memcpy (XVECTOR (constvec)->contents, args + 1, nvars * word_size);
+ memcpy (XVECTOR (constvec)->contents + nvars,
+ XVECTOR (proto_constvec)->contents + nvars,
+ (constsize - nvars) * word_size);
+
+ /* Return a copy of the prototype function with the new constant vector. */
+ ptrdiff_t protosize = PVSIZE (protofun);
+ struct Lisp_Vector *v = allocate_vectorlike (protosize, false);
+ v->header = XVECTOR (protofun)->header;
+ memcpy (v->contents, XVECTOR (protofun)->contents, protosize * word_size);
+ v->contents[COMPILED_CONSTANTS] = constvec;
+ return make_lisp_ptr (v, Lisp_Vectorlike);
+}
/***********************************************************************
@@ -4688,7 +4740,7 @@ live_small_vector_p (struct mem_node *m, void *p)
marked. */
static void
-mark_maybe_pointer (void *p)
+mark_maybe_pointer (void *p, bool symbol_only)
{
struct mem_node *m;
@@ -4703,14 +4755,32 @@ mark_maybe_pointer (void *p)
definitely _don't_ have an object. */
if (pdumper_object_p (p))
{
+ /* FIXME: This code assumes that every reachable pdumper object
+ is addressed either by a pointer to the object start, or by
+ the same pointer with an LSB-style tag. This assumption
+ fails if a pdumper object is reachable only via machine
+ addresses of non-initial object components. Although such
+ addressing is rare in machine code generated by C compilers
+ from Emacs source code, it can occur in some cases. To fix
+ this problem, the pdumper code should grok non-initial
+ addresses, as the non-pdumper code does. */
+ uintptr_t mask = VALMASK & UINTPTR_MAX;
+ uintptr_t masked_p = (uintptr_t) p & mask;
+ void *po = (void *) masked_p;
+ char *cp = p;
+ char *cpo = po;
/* Don't use pdumper_object_p_precise here! It doesn't check the
tag bits. OBJ here might be complete garbage, so we need to
verify both the pointer and the tag. */
- int type = pdumper_find_object_type (p);
- if (pdumper_valid_object_type_p (type))
- mark_object (type == Lisp_Symbol
- ? make_lisp_symbol (p)
- : make_lisp_ptr (p, type));
+ int type = pdumper_find_object_type (po);
+ if (pdumper_valid_object_type_p (type)
+ && (!USE_LSB_TAG || p == po || cp - cpo == type))
+ {
+ if (type == Lisp_Symbol)
+ mark_object (make_lisp_symbol (po));
+ else if (!symbol_only)
+ mark_object (make_lisp_ptr (po, type));
+ }
return;
}
@@ -4728,6 +4798,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_CONS:
{
+ if (symbol_only)
+ return;
struct Lisp_Cons *h = live_cons_holding (m, p);
if (!h)
return;
@@ -4737,6 +4809,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_STRING:
{
+ if (symbol_only)
+ return;
struct Lisp_String *h = live_string_holding (m, p);
if (!h)
return;
@@ -4755,6 +4829,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_FLOAT:
{
+ if (symbol_only)
+ return;
struct Lisp_Float *h = live_float_holding (m, p);
if (!h)
return;
@@ -4764,6 +4840,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_VECTORLIKE:
{
+ if (symbol_only)
+ return;
struct Lisp_Vector *h = live_large_vector_holding (m, p);
if (!h)
return;
@@ -4773,6 +4851,8 @@ mark_maybe_pointer (void *p)
case MEM_TYPE_VECTOR_BLOCK:
{
+ if (symbol_only)
+ return;
struct Lisp_Vector *h = live_small_vector_holding (m, p);
if (!h)
return;
@@ -4834,7 +4914,7 @@ mark_memory (void const *start, void const *end)
for (pp = start; (void const *) pp < end; pp += GC_POINTER_ALIGNMENT)
{
void *p = *(void *const *) pp;
- mark_maybe_pointer (p);
+ mark_maybe_pointer (p, false);
/* Unmask any struct Lisp_Symbol pointer that make_lisp_symbol
previously disguised by adding the address of 'lispsym'.
@@ -4843,7 +4923,7 @@ mark_memory (void const *start, void const *end)
non-adjacent words and P might be the low-order word's value. */
intptr_t ip;
INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip);
- mark_maybe_pointer ((void *) ip);
+ mark_maybe_pointer ((void *) ip, true);
}
}
@@ -6216,7 +6296,7 @@ For further details, see Info node `(elisp)Garbage Collection'. */)
}
DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe,
-Sgarbage_collect_maybe, 1, 1, "",
+Sgarbage_collect_maybe, 1, 1, 0,
doc: /* Call `garbage-collect' if enough allocation happened.
FACTOR determines what "enough" means here:
If FACTOR is a positive number N, it means to run GC if more than
@@ -6693,6 +6773,15 @@ mark_object (Lisp_Object arg)
break;
case PVEC_SUBR:
+ if (SUBR_NATIVE_COMPILEDP (obj))
+ {
+ set_vector_marked (ptr);
+ struct Lisp_Subr *subr = XSUBR (obj);
+ mark_object (subr->native_intspec);
+ mark_object (subr->native_comp_u[0]);
+ mark_object (subr->lambda_list[0]);
+ mark_object (subr->type[0]);
+ }
break;
case PVEC_FREE:
@@ -6837,7 +6926,9 @@ survives_gc_p (Lisp_Object obj)
break;
case Lisp_Vectorlike:
- survives_p = SUBRP (obj) || vector_marked_p (XVECTOR (obj));
+ survives_p =
+ (SUBRP (obj) && !SUBR_NATIVE_COMPILEDP (obj)) ||
+ vector_marked_p (XVECTOR (obj));
break;
case Lisp_Cons:
@@ -7227,7 +7318,7 @@ Frames, windows, buffers, and subprocesses count as vectors
make_int (strings_consed));
}
-#ifdef GNU_LINUX
+#if defined GNU_LINUX && defined __GLIBC__
DEFUN ("malloc-info", Fmalloc_info, Smalloc_info, 0, 0, "",
doc: /* Report malloc information to stderr.
This function outputs to stderr an XML-formatted
@@ -7573,6 +7664,7 @@ N should be nonnegative. */);
defsubr (&Srecord);
defsubr (&Sbool_vector);
defsubr (&Smake_byte_code);
+ defsubr (&Smake_closure);
defsubr (&Smake_list);
defsubr (&Smake_vector);
defsubr (&Smake_record);
@@ -7586,7 +7678,7 @@ N should be nonnegative. */);
defsubr (&Sgarbage_collect_maybe);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
-#ifdef GNU_LINUX
+#if defined GNU_LINUX && defined __GLIBC__
defsubr (&Smalloc_info);
#endif
defsubr (&Ssuspicious_object);
@@ -7596,14 +7688,14 @@ N should be nonnegative. */);
static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
{{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
{ .a4 = watch_gc_cons_threshold },
- 4, 4, "watch_gc_cons_threshold", 0, 0}};
+ 4, 4, "watch_gc_cons_threshold", {0}, 0}};
XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
Fadd_variable_watcher (Qgc_cons_threshold, watcher);
static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
{{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
{ .a4 = watch_gc_cons_percentage },
- 4, 4, "watch_gc_cons_percentage", 0, 0}};
+ 4, 4, "watch_gc_cons_percentage", {0}, 0}};
XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
Fadd_variable_watcher (Qgc_cons_percentage, watcher);
}
diff --git a/src/buffer.c b/src/buffer.c
index 80c799e719b..7e4c84911bb 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -292,6 +292,11 @@ bset_major_mode (struct buffer *b, Lisp_Object val)
b->major_mode_ = val;
}
static void
+bset_local_minor_modes (struct buffer *b, Lisp_Object val)
+{
+ b->local_minor_modes_ = val;
+}
+static void
bset_mark (struct buffer *b, Lisp_Object val)
{
b->mark_ = val;
@@ -776,15 +781,22 @@ fetch_buffer_markers (struct buffer *b)
DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer,
- 2, 3,
+ 2, 4,
"bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
doc: /* Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.
BASE-BUFFER should be a live buffer, or the name of an existing buffer.
+
NAME should be a string which is not the name of an existing buffer.
Optional argument CLONE non-nil means preserve BASE-BUFFER's state,
such as major and minor modes, in the indirect buffer.
-CLONE nil means the indirect buffer's state is reset to default values. */)
- (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone)
+
+CLONE nil means the indirect buffer's state is reset to default values.
+
+If optional argument INHIBIT-BUFFER-HOOKS is non-nil, the new buffer
+does not run the hooks `kill-buffer-hook',
+`kill-buffer-query-functions', and `buffer-list-update-hook'. */)
+ (Lisp_Object base_buffer, Lisp_Object name, Lisp_Object clone,
+ Lisp_Object inhibit_buffer_hooks)
{
Lisp_Object buf, tem;
struct buffer *b;
@@ -829,6 +841,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
b->pt_byte = b->base_buffer->pt_byte;
b->begv_byte = b->base_buffer->begv_byte;
b->zv_byte = b->base_buffer->zv_byte;
+ b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks);
b->newline_cache = 0;
b->width_run_cache = 0;
@@ -893,6 +906,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */)
bset_file_truename (b, Qnil);
bset_display_count (b, make_fixnum (0));
bset_backed_up (b, Qnil);
+ bset_local_minor_modes (b, Qnil);
bset_auto_save_file_name (b, Qnil);
set_buffer_internal_1 (b);
Fset (intern ("buffer-save-without-query"), Qnil);
@@ -967,6 +981,7 @@ reset_buffer (register struct buffer *b)
b->clip_changed = 0;
b->prevent_redisplay_optimizations_p = 1;
bset_backed_up (b, Qnil);
+ bset_local_minor_modes (b, Qnil);
BUF_AUTOSAVE_MODIFF (b) = 0;
b->auto_save_failure_time = 0;
bset_auto_save_file_name (b, Qnil);
@@ -1069,12 +1084,12 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
for (newlist = Qnil; CONSP (list); list = XCDR (list))
{
Lisp_Object elt = XCAR (list);
- /* Preserve element ELT if it's t,
- if it is a function with a `permanent-local-hook' property,
- or if it's not a symbol. */
- if (! SYMBOLP (elt)
- || EQ (elt, Qt)
- || !NILP (Fget (elt, Qpermanent_local_hook)))
+ /* Preserve element ELT if it's t, or if it is a
+ function with a `permanent-local-hook'
+ property. */
+ if (EQ (elt, Qt)
+ || (SYMBOLP (elt)
+ && !NILP (Fget (elt, Qpermanent_local_hook))))
newlist = Fcons (elt, newlist);
}
newlist = Fnreverse (newlist);
@@ -1442,9 +1457,9 @@ state of the current buffer. Use with care. */)
{
bool already = SAVE_MODIFF < MODIFF;
if (!already && !NILP (flag))
- lock_file (fn);
+ Flock_file (fn);
else if (already && NILP (flag))
- unlock_file (fn);
+ Funlock_file (fn);
}
}
@@ -1750,7 +1765,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
if (thread_check_current_buffer (b))
return Qnil;
- /* Run hooks with the buffer to be killed the current buffer. */
+ /* Run hooks with the buffer to be killed as the current buffer. */
{
ptrdiff_t count = SPECPDL_INDEX ();
@@ -1935,8 +1950,8 @@ cleaning up all windows currently displaying the buffer to be killed. */)
}
/* Since we've unlinked the markers, the overlays can't be here any more
either. */
- b->overlays_before = NULL;
- b->overlays_after = NULL;
+ set_buffer_overlays_before (b, NULL);
+ set_buffer_overlays_after (b, NULL);
/* Reset the local variables, so that this buffer's local values
won't be protected from GC. They would be protected
@@ -2412,6 +2427,7 @@ results, see Info node `(elisp)Swapping Text'. */)
swapfield (overlay_center, ptrdiff_t);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
+ swapfield_ (mark_active, Lisp_Object); /* Belongs with the `mark'. */
swapfield_ (enable_multibyte_characters, Lisp_Object);
swapfield_ (bidi_display_reordering, Lisp_Object);
swapfield_ (bidi_paragraph_direction, Lisp_Object);
@@ -2979,7 +2995,7 @@ overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
ptrdiff_t next = ZV;
ptrdiff_t prev = BEGV;
bool inhibit_storing = 0;
- bool end_is_Z = end == Z;
+ bool end_is_Z = end == ZV;
for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
tail; tail = tail->next)
@@ -4206,7 +4222,11 @@ OVERLAY. */)
DEFUN ("overlays-at", Foverlays_at, Soverlays_at, 1, 2, 0,
doc: /* Return a list of the overlays that contain the character at POS.
-If SORTED is non-nil, then sort them by decreasing priority. */)
+If SORTED is non-nil, then sort them by decreasing priority.
+
+Zero-length overlays that start and stop at POS are not included in
+the return value. Instead use `overlays-in' if those overlays are of
+interest. */)
(Lisp_Object pos, Lisp_Object sorted)
{
ptrdiff_t len, noverlays;
@@ -4248,9 +4268,10 @@ DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
doc: /* Return a list of the overlays that overlap the region BEG ... END.
Overlap means that at least one character is contained within the overlay
and also contained within the specified region.
+
Empty overlays are included in the result if they are located at BEG,
between BEG and END, or at END provided END denotes the position at the
-end of the buffer. */)
+end of the accessible part of the buffer. */)
(Lisp_Object beg, Lisp_Object end)
{
ptrdiff_t len, noverlays;
@@ -5151,6 +5172,7 @@ init_buffer_once (void)
bset_auto_save_file_name (&buffer_local_flags, make_fixnum (-1));
bset_read_only (&buffer_local_flags, make_fixnum (-1));
bset_major_mode (&buffer_local_flags, make_fixnum (-1));
+ bset_local_minor_modes (&buffer_local_flags, make_fixnum (-1));
bset_mode_name (&buffer_local_flags, make_fixnum (-1));
bset_undo_list (&buffer_local_flags, make_fixnum (-1));
bset_mark_active (&buffer_local_flags, make_fixnum (-1));
@@ -5381,17 +5403,24 @@ init_buffer (void)
recorded by temacs, that cannot be used by the dumped Emacs.
We map new memory for their text here.
- Implementation note: the buffers we carry from temacs are:
+ Implementation notes: the buffers we carry from temacs are:
" prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and
" *code-conversion-work*". They are created by
init_buffer_once and init_window_once (which are not called
- in the dumped Emacs), and by the first call to coding.c routines. */
+ in the dumped Emacs), and by the first call to coding.c
+ routines. Since FOR_EACH_LIVE_BUFFER only walks the buffers
+ in Vbuffer_alist, any buffer we carry from temacs that is
+ not in the alist (a.k.a. "magic invisible buffers") should
+ be handled here explicitly. */
FOR_EACH_LIVE_BUFFER (tail, buffer)
{
struct buffer *b = XBUFFER (buffer);
b->text->beg = NULL;
enlarge_buffer_text (b, 0);
}
+ /* The " prin1" buffer is not in Vbuffer_alist. */
+ XBUFFER (Vprin1_to_string_buffer)->text->beg = NULL;
+ enlarge_buffer_text (XBUFFER (Vprin1_to_string_buffer), 0);
}
#endif /* USE_MMAP_FOR_BUFFERS */
@@ -5617,6 +5646,12 @@ The default value (normally `fundamental-mode') affects new buffers.
A value of nil means to use the current buffer's major mode, provided
it is not marked as "special". */);
+ DEFVAR_PER_BUFFER ("local-minor-modes",
+ &BVAR (current_buffer, local_minor_modes),
+ Qnil,
+ doc: /* Minor modes currently active in the current buffer.
+This is a list of symbols, or nil if there are no minor modes active. */);
+
DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name),
Qnil,
doc: /* Pretty name of current buffer's major mode.
@@ -5651,15 +5686,18 @@ Linefeed indents to this column in Fundamental mode. */);
DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width),
Qintegerp,
doc: /* Distance between tab stops (for display of tab characters), in columns.
-NOTE: This controls the display width of a TAB character, and not
-the size of an indentation step.
-This should be an integer greater than zero. */);
+This controls the width of a TAB character on display.
+The value should be a positive integer.
+Note that this variable doesn't necessarily affect the size of the
+indentation step. However, if the major mode's indentation facility
+inserts one or more TAB characters, this variable will affect the
+indentation step as well, even if `indent-tabs-mode' is non-nil. */);
DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil,
- doc: /* Non-nil means display control chars with uparrow.
-A value of nil means use backslash and octal digits.
-This variable does not apply to characters whose display is specified
-in the current display table (if there is one). */);
+ doc: /* Non-nil means display control chars with uparrow `^'.
+A value of nil means use backslash `\\' and octal digits.
+This variable does not apply to characters whose display is specified in
+the current display table (if there is one; see `standard-display-table'). */);
DEFVAR_PER_BUFFER ("enable-multibyte-characters",
&BVAR (current_buffer, enable_multibyte_characters),
diff --git a/src/buffer.h b/src/buffer.h
index 790291f1185..24e9c3fcbc8 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -338,6 +338,9 @@ struct buffer
/* Symbol naming major mode (e.g., lisp-mode). */
Lisp_Object major_mode_;
+ /* Symbol listing all currently enabled minor modes. */
+ Lisp_Object local_minor_modes_;
+
/* Pretty name of major mode (e.g., "Lisp"). */
Lisp_Object mode_name_;
diff --git a/src/callint.c b/src/callint.c
index d3f49bc35d1..6f8a7f13f61 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -104,7 +104,14 @@ If the string begins with `^' and `shift-select-mode' is non-nil,
Emacs first calls the function `handle-shift-selection'.
You may use `@', `*', and `^' together. They are processed in the
order that they appear, before reading any arguments.
-usage: (interactive &optional ARG-DESCRIPTOR) */
+
+If MODES is present, it should be a list of mode names (symbols) that
+this command is applicable for. The main effect of this is that
+`M-x TAB' (by default) won't list this command if the current buffer's
+mode doesn't match the list. That is, if either the major mode isn't
+derived from them, or (when it's a minor mode) the mode isn't in effect.
+
+usage: (interactive &optional ARG-DESCRIPTOR &rest MODES) */
attributes: const)
(Lisp_Object args)
{
@@ -885,7 +892,10 @@ behave as if the mark were still active. */);
Vmark_even_if_inactive = Qt;
DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
- doc: /* Hook to run when about to switch windows with a mouse command.
+ doc: /* Hook run when the user mouse-clicks in a window.
+It can be run both before and after switching windows, or even when
+not actually switching windows.
+
Its purpose is to give temporary modes such as Isearch mode
a way to turn themselves off when a mouse command switches windows. */);
Vmouse_leave_buffer_hook = Qnil;
diff --git a/src/callproc.c b/src/callproc.c
index cb72b070b7b..675b78daf3e 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -116,11 +116,13 @@ static CHILD_SETUP_TYPE child_setup (int, int, int, char **, char **,
const char *);
/* Return the current buffer's working directory, or the home
- directory if it's unreachable, as a string suitable for a system call.
- Signal an error if the result would not be an accessible directory. */
+ directory if it's unreachable. If ENCODE is true, return as a string
+ suitable for a system call; otherwise, return a string in its
+ internal representation. Signal an error if the result would not be
+ an accessible directory. */
Lisp_Object
-encode_current_directory (void)
+get_current_directory (bool encode)
{
Lisp_Object curdir = BVAR (current_buffer, directory);
Lisp_Object dir = Funhandled_file_name_directory (curdir);
@@ -131,12 +133,12 @@ encode_current_directory (void)
dir = build_string ("~");
dir = expand_and_dir_to_file (dir);
- dir = ENCODE_FILE (remove_slash_colon (dir));
+ Lisp_Object encoded_dir = ENCODE_FILE (remove_slash_colon (dir));
- if (! file_accessible_directory_p (dir))
+ if (! file_accessible_directory_p (encoded_dir))
report_file_error ("Setting current directory", curdir);
- return dir;
+ return encode ? encoded_dir : dir;
}
/* If P is reapable, record it as a deleted process and kill it.
@@ -225,8 +227,9 @@ DEFUN ("call-process", Fcall_process, Scall_process, 1, MANY, 0,
The remaining arguments are optional.
The program's input comes from file INFILE (nil means `null-device').
-If you want to make the input come from an Emacs buffer, use
-`call-process-region' instead.
+If INFILE is a relative path, it will be looked for relative to the
+directory where the process is run (see below). If you want to make the
+input come from an Emacs buffer, use `call-process-region' instead.
Third argument DESTINATION specifies how to handle program's output.
If DESTINATION is a buffer, or t that stands for the current buffer,
@@ -270,12 +273,17 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) *
if (nargs >= 2 && ! NILP (args[1]))
{
- infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory));
+ /* Expand infile relative to the current buffer's current
+ directory, or its unhandled equivalent ("~"). */
+ infile = Fexpand_file_name (args[1], get_current_directory (false));
CHECK_STRING (infile);
}
else
infile = build_string (NULL_DEVICE);
+ /* Remove "/:" from INFILE. */
+ infile = remove_slash_colon (infile);
+
encoded_infile = ENCODE_FILE (infile);
filefd = emacs_open (SSDATA (encoded_infile), O_RDONLY, 0);
@@ -411,7 +419,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
/* If the buffer is (still) a list, it might be a (:file "file") spec. */
if (CONSP (buffer) && EQ (XCAR (buffer), QCfile))
{
- output_file = Fexpand_file_name (XCAR (XCDR (buffer)),
+ Lisp_Object ofile = XCDR (buffer);
+ if (CONSP (ofile))
+ ofile = XCAR (ofile);
+ CHECK_STRING (ofile);
+ output_file = Fexpand_file_name (ofile,
BVAR (current_buffer, directory));
CHECK_STRING (output_file);
buffer = Qnil;
@@ -432,12 +444,18 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
chdir, since it's in a vfork. */
- current_dir = encode_current_directory ();
+ current_dir = get_current_directory (true);
if (STRINGP (error_file))
- error_file = ENCODE_FILE (error_file);
+ {
+ error_file = remove_slash_colon (error_file);
+ error_file = ENCODE_FILE (error_file);
+ }
if (STRINGP (output_file))
- output_file = ENCODE_FILE (output_file);
+ {
+ output_file = remove_slash_colon (output_file);
+ output_file = ENCODE_FILE (output_file);
+ }
display_p = INTERACTIVE && nargs >= 4 && !NILP (args[3]);
@@ -453,7 +471,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
int ok;
ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
- make_fixnum (X_OK), false);
+ make_fixnum (X_OK), false, false);
if (ok < 0)
report_file_error ("Searching for program", args[0]);
}
@@ -1648,32 +1666,15 @@ make_environment_block (Lisp_Object current_dir)
void
init_callproc_1 (void)
{
-#ifdef HAVE_NS
- const char *etc_dir = ns_etc_directory ();
- const char *path_exec = ns_exec_path ();
-#endif
-
- Vdata_directory = decode_env_path ("EMACSDATA",
-#ifdef HAVE_NS
- etc_dir ? etc_dir :
-#endif
- PATH_DATA, 0);
+ Vdata_directory = decode_env_path ("EMACSDATA", PATH_DATA, 0);
Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory));
- Vdoc_directory = decode_env_path ("EMACSDOC",
-#ifdef HAVE_NS
- etc_dir ? etc_dir :
-#endif
- PATH_DOC, 0);
+ Vdoc_directory = decode_env_path ("EMACSDOC", PATH_DOC, 0);
Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory));
/* Check the EMACSPATH environment variable, defaulting to the
PATH_EXEC path from epaths.h. */
- Vexec_path = decode_env_path ("EMACSPATH",
-#ifdef HAVE_NS
- path_exec ? path_exec :
-#endif
- PATH_EXEC, 0);
+ Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC, 0);
Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path));
/* FIXME? For ns, path_exec should go at the front? */
Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
@@ -1688,10 +1689,6 @@ init_callproc (void)
char *sh;
Lisp_Object tempdir;
-#ifdef HAVE_NS
- if (data_dir == 0)
- data_dir = ns_etc_directory () != 0;
-#endif
if (!NILP (Vinstallation_directory))
{
@@ -1703,15 +1700,8 @@ init_callproc (void)
/* MSDOS uses wrapped binaries, so don't do this. */
if (NILP (Fmember (tem, Vexec_path)))
{
-#ifdef HAVE_NS
- const char *path_exec = ns_exec_path ();
-#endif
/* Running uninstalled, so default to tem rather than PATH_EXEC. */
- Vexec_path = decode_env_path ("EMACSPATH",
-#ifdef HAVE_NS
- path_exec ? path_exec :
-#endif
- SSDATA (tem), 0);
+ Vexec_path = decode_env_path ("EMACSPATH", SSDATA (tem), 0);
Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path);
}
diff --git a/src/character.c b/src/character.c
index a599a0355f4..38a81d36b09 100644
--- a/src/character.c
+++ b/src/character.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "character.h"
#include "buffer.h"
+#include "frame.h"
#include "dispextern.h"
#include "composite.h"
#include "disptab.h"
@@ -321,28 +322,41 @@ strwidth (const char *str, ptrdiff_t len)
return c_string_width ((const unsigned char *) str, len, -1, NULL, NULL);
}
-/* Return width of Lisp string STRING when displayed in the current
- buffer. The width is measured by how many columns it occupies on
- the screen while paying attention to compositions. If PRECISION >
- 0, return the width of longest substring that doesn't exceed
- PRECISION, and set number of characters and bytes of the substring
- in *NCHARS and *NBYTES respectively. */
+/* Return width of a (substring of a) Lisp string STRING when
+ displayed in the current buffer. The width is measured by how many
+ columns it occupies on the screen while paying attention to
+ compositions. If PRECISION > 0, return the width of longest
+ substring that doesn't exceed PRECISION, and set number of
+ characters and bytes of the substring in *NCHARS and *NBYTES
+ respectively. FROM and TO are zero-based character indices that
+ define the substring of STRING to consider. If AUTO_COMP is
+ non-zero, account for automatic compositions in STRING. */
ptrdiff_t
-lisp_string_width (Lisp_Object string, ptrdiff_t precision,
- ptrdiff_t *nchars, ptrdiff_t *nbytes)
+lisp_string_width (Lisp_Object string, ptrdiff_t from, ptrdiff_t to,
+ ptrdiff_t precision, ptrdiff_t *nchars, ptrdiff_t *nbytes,
+ bool auto_comp)
{
- ptrdiff_t len = SCHARS (string);
/* This set multibyte to 0 even if STRING is multibyte when it
contains only ascii and eight-bit-graphic, but that's
intentional. */
- bool multibyte = len < SBYTES (string);
- unsigned char *str = SDATA (string);
- ptrdiff_t i = 0, i_byte = 0;
+ bool multibyte = SCHARS (string) < SBYTES (string);
+ ptrdiff_t i = from, i_byte = from ? string_char_to_byte (string, from) : 0;
+ ptrdiff_t from_byte = i_byte;
ptrdiff_t width = 0;
struct Lisp_Char_Table *dp = buffer_display_table ();
+#ifdef HAVE_WINDOW_SYSTEM
+ struct frame *f =
+ (FRAMEP (selected_frame) && FRAME_LIVE_P (XFRAME (selected_frame)))
+ ? XFRAME (selected_frame)
+ : NULL;
+ int font_width = -1;
+ Lisp_Object default_font, frame_font;
+#endif
- while (i < len)
+ eassert (precision <= 0 || (nchars && nbytes));
+
+ while (i < to)
{
ptrdiff_t chars, bytes, thiswidth;
Lisp_Object val;
@@ -357,9 +371,53 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision,
chars = end - i;
bytes = string_char_to_byte (string, end) - i_byte;
}
+#ifdef HAVE_WINDOW_SYSTEM
+ else if (auto_comp
+ && f && FRAME_WINDOW_P (f)
+ && multibyte
+ && find_automatic_composition (i, -1, i, &ignore,
+ &end, &val, string)
+ && end > i)
+ {
+ int j;
+ for (j = 0; j < LGSTRING_GLYPH_LEN (val); j++)
+ if (NILP (LGSTRING_GLYPH (val, j)))
+ break;
+
+ int pixelwidth = composition_gstring_width (val, 0, j, NULL);
+
+ /* The below is somewhat expensive, so compute it only once
+ for the entire loop, and only if needed. */
+ if (font_width < 0)
+ {
+ font_width = FRAME_COLUMN_WIDTH (f);
+ default_font = Fface_font (Qdefault, Qnil, Qnil);
+ frame_font = Fframe_parameter (Qnil, Qfont);
+
+ if (STRINGP (default_font) && STRINGP (frame_font)
+ && (SCHARS (default_font) != SCHARS (frame_font)
+ || SBYTES (default_font) != SBYTES (frame_font)
+ || memcmp (SDATA (default_font), SDATA (frame_font),
+ SBYTES (default_font))))
+ {
+ Lisp_Object font_info = Ffont_info (default_font, Qnil);
+ if (VECTORP (font_info))
+ {
+ font_width = XFIXNUM (AREF (font_info, 11));
+ if (font_width <= 0)
+ font_width = XFIXNUM (AREF (font_info, 10));
+ }
+ }
+ }
+ thiswidth = (double) pixelwidth / font_width + 0.5;
+ chars = end - i;
+ bytes = string_char_to_byte (string, end) - i_byte;
+ }
+#endif /* HAVE_WINDOW_SYSTEM */
else
{
int c;
+ unsigned char *str = SDATA (string);
if (multibyte)
{
@@ -375,8 +433,8 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision,
if (0 < precision && precision - width < thiswidth)
{
- *nchars = i;
- *nbytes = i_byte;
+ *nchars = i - from;
+ *nbytes = i_byte - from_byte;
return width;
}
if (INT_ADD_WRAPV (thiswidth, width, &width))
@@ -387,27 +445,37 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision,
if (precision > 0)
{
- *nchars = i;
- *nbytes = i_byte;
+ *nchars = i - from;
+ *nbytes = i_byte - from_byte;
}
return width;
}
-DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
+DEFUN ("string-width", Fstring_width, Sstring_width, 1, 3, 0,
doc: /* Return width of STRING when displayed in the current buffer.
Width is measured by how many columns it occupies on the screen.
+Optional arguments FROM and TO specify the substring of STRING to
+consider, and are interpreted as in `substring'.
+
When calculating width of a multibyte character in STRING,
only the base leading-code is considered; the validity of
the following bytes is not checked. Tabs in STRING are always
-taken to occupy `tab-width' columns.
-usage: (string-width STRING) */)
- (Lisp_Object str)
+taken to occupy `tab-width' columns. The effect of faces and fonts
+used for non-Latin and other unusual characters (such as emoji) is
+ignored as well, as are display properties and invisible text.
+For these reasons, the results are not generally reliable;
+for accurate dimensions of text as it will be displayed,
+use `window-text-pixel-size' instead.
+usage: (string-width STRING &optional FROM TO) */)
+ (Lisp_Object str, Lisp_Object from, Lisp_Object to)
{
Lisp_Object val;
+ ptrdiff_t ifrom, ito;
CHECK_STRING (str);
- XSETFASTINT (val, lisp_string_width (str, -1, NULL, NULL));
+ validate_subarray (str, from, to, SCHARS (str), &ifrom, &ito);
+ XSETFASTINT (val, lisp_string_width (str, ifrom, ito, -1, NULL, NULL, true));
return val;
}
diff --git a/src/character.h b/src/character.h
index cbf43097ae2..1a745484daa 100644
--- a/src/character.h
+++ b/src/character.h
@@ -42,7 +42,7 @@ INLINE_HEADER_BEGIN
F9..FF 11111yyy
In each bit pattern, 'x' and 'y' each represent a single bit of the
- character code payload, and least one 'y' must be a 1 bit.
+ character code payload, and at least one 'y' must be a 1 bit.
In the 5-byte sequence, the 22-bit payload cannot exceed 3FFF7F.
*/
@@ -572,8 +572,8 @@ extern ptrdiff_t str_to_unibyte (const unsigned char *, unsigned char *,
extern ptrdiff_t strwidth (const char *, ptrdiff_t);
extern ptrdiff_t c_string_width (const unsigned char *, ptrdiff_t, int,
ptrdiff_t *, ptrdiff_t *);
-extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t,
- ptrdiff_t *, ptrdiff_t *);
+extern ptrdiff_t lisp_string_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t, ptrdiff_t *, ptrdiff_t *, bool);
extern Lisp_Object Vchar_unify_table;
extern Lisp_Object string_escape_byte8 (Lisp_Object);
diff --git a/src/charset.c b/src/charset.c
index eb388d1868b..7cd0fa78f04 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -486,7 +486,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect_nothing ();
specbind (Qfile_name_handler_alist, Qnil);
- fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false);
+ fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false, false);
fp = fd < 0 ? 0 : fdopen (fd, "r");
if (!fp)
{
diff --git a/src/chartab.c b/src/chartab.c
index 331e8595ebe..6f0bc28f31b 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -62,6 +62,9 @@ typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object);
static Lisp_Object uniprop_table_uncompress (Lisp_Object, int);
static uniprop_decoder_t uniprop_get_decoder (Lisp_Object);
+static Lisp_Object
+sub_char_table_ref_and_range (Lisp_Object, int, int *, int *,
+ Lisp_Object, bool);
/* 1 iff TABLE is a uniprop table. */
#define UNIPROP_TABLE_P(TABLE) \
@@ -247,6 +250,23 @@ char_table_ref (Lisp_Object table, int c)
return val;
}
+static inline Lisp_Object
+char_table_ref_simple (Lisp_Object table, int idx, int c, int *from, int *to,
+ Lisp_Object defalt, bool is_uniprop, bool is_subtable)
+{
+ Lisp_Object val = is_subtable ?
+ XSUB_CHAR_TABLE (table)->contents[idx]:
+ XCHAR_TABLE (table)->contents[idx];
+ if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
+ val = uniprop_table_uncompress (table, idx);
+ if (SUB_CHAR_TABLE_P (val))
+ val = sub_char_table_ref_and_range (val, c, from, to,
+ defalt, is_uniprop);
+ else if (NILP (val))
+ val = defalt;
+ return val;
+}
+
static Lisp_Object
sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
Lisp_Object defalt, bool is_uniprop)
@@ -254,31 +274,18 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = tbl->depth, min_char = tbl->min_char;
int chartab_idx = CHARTAB_IDX (c, depth, min_char), idx;
- Lisp_Object val;
-
- val = tbl->contents[chartab_idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
- val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop);
- else if (NILP (val))
- val = defalt;
+ Lisp_Object val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ defalt, is_uniprop, true);
idx = chartab_idx;
while (idx > 0 && *from < min_char + idx * chartab_chars[depth])
{
- Lisp_Object this_val;
-
c = min_char + idx * chartab_chars[depth] - 1;
idx--;
- this_val = tbl->contents[idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
- is_uniprop);
- else if (NILP (this_val))
- this_val = defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, idx, c, from, to,
+ defalt, is_uniprop, true);
if (! EQ (this_val, val))
{
@@ -290,17 +297,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to,
< chartab_chars[depth - 1])
&& (c += min_char) <= *to)
{
- Lisp_Object this_val;
-
chartab_idx++;
- this_val = tbl->contents[chartab_idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt,
- is_uniprop);
- else if (NILP (this_val))
- this_val = defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ defalt, is_uniprop, true);
+
if (! EQ (this_val, val))
{
*to = c - 1;
@@ -321,37 +322,26 @@ Lisp_Object
char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
{
struct Lisp_Char_Table *tbl = XCHAR_TABLE (table);
- int chartab_idx = CHARTAB_IDX (c, 0, 0), idx;
- Lisp_Object val;
+ int chartab_idx = CHARTAB_IDX (c, 0, 0);
bool is_uniprop = UNIPROP_TABLE_P (table);
- val = tbl->contents[chartab_idx];
if (*from < 0)
*from = 0;
if (*to < 0)
*to = MAX_CHAR;
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val))
- val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (val))
- val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt,
- is_uniprop);
- else if (NILP (val))
- val = tbl->defalt;
- idx = chartab_idx;
+
+ Lisp_Object val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ tbl->defalt, is_uniprop, false);
+
+ int idx = chartab_idx;
while (*from < idx * chartab_chars[0])
{
- Lisp_Object this_val;
-
c = idx * chartab_chars[0] - 1;
idx--;
- this_val = tbl->contents[idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to,
- tbl->defalt, is_uniprop);
- else if (NILP (this_val))
- this_val = tbl->defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, idx, c, from, to,
+ tbl->defalt, is_uniprop, false);
if (! EQ (this_val, val))
{
@@ -361,18 +351,12 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to)
}
while (*to >= (chartab_idx + 1) * chartab_chars[0])
{
- Lisp_Object this_val;
-
chartab_idx++;
c = chartab_idx * chartab_chars[0];
- this_val = tbl->contents[chartab_idx];
- if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val))
- this_val = uniprop_table_uncompress (table, chartab_idx);
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = sub_char_table_ref_and_range (this_val, c, from, to,
- tbl->defalt, is_uniprop);
- else if (NILP (this_val))
- this_val = tbl->defalt;
+ Lisp_Object this_val
+ = char_table_ref_simple (table, chartab_idx, c, from, to,
+ tbl->defalt, is_uniprop, false);
+
if (! EQ (this_val, val))
{
*to = c - 1;
diff --git a/src/cmds.c b/src/cmds.c
index c8a96d918cd..00fde0ef79b 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -455,7 +455,7 @@ internal_self_insert (int c, EMACS_INT n)
ptrdiff_t to;
if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
to = PTRDIFF_MAX;
- replace_range (PT, to, string, 1, 1, 1, 0);
+ replace_range (PT, to, string, 1, 1, 1, 0, false);
Fforward_char (make_fixnum (n));
}
else if (n > 1)
diff --git a/src/coding.c b/src/coding.c
index 739dd6adcb5..d027c7d5399 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -7799,7 +7799,13 @@ encode_coding (struct coding_system *coding)
coding_set_source (coding);
consume_chars (coding, translation_table, max_lookup);
coding_set_destination (coding);
+ /* The CODING_MODE_LAST_BLOCK flag should be set only for the last
+ iteration of the encoding. */
+ unsigned saved_mode = coding->mode;
+ if (coding->consumed_char < coding->src_chars)
+ coding->mode &= ~CODING_MODE_LAST_BLOCK;
(*(coding->encoder)) (coding);
+ coding->mode = saved_mode;
} while (coding->consumed_char < coding->src_chars);
if (BUFFERP (coding->dst_object) && coding->produced_char > 0)
@@ -8244,6 +8250,39 @@ decode_coding_object (struct coding_system *coding,
}
+/* Encode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
+ SRC_OBJECT into DST_OBJECT by coding context CODING.
+
+ SRC_OBJECT is a buffer, a string, or Qnil.
+
+ If it is a buffer, the text is at point of the buffer. FROM and TO
+ are positions in the buffer.
+
+ If it is a string, the text is at the beginning of the string.
+ FROM and TO are indices into the string.
+
+ If it is nil, the text is at coding->source. FROM and TO are
+ indices into coding->source.
+
+ DST_OBJECT is a buffer, Qt, or Qnil.
+
+ If it is a buffer, the encoded text is inserted at point of the
+ buffer. If the buffer is the same as SRC_OBJECT, the source text
+ is replaced with the encoded text.
+
+ If it is Qt, a string is made from the encoded text, and set in
+ CODING->dst_object. However, if CODING->raw_destination is non-zero,
+ the encoded text is instead returned in CODING->destination as a C string,
+ and the caller is responsible for freeing CODING->destination. This
+ feature is meant to be used when the caller doesn't need the result as
+ a Lisp string, and wants to avoid unnecessary consing of large strings.
+
+ If it is Qnil, the encoded text is stored at CODING->destination.
+ The caller must allocate CODING->dst_bytes bytes at
+ CODING->destination by xmalloc. If the encoded text is longer than
+ CODING->dst_bytes, CODING->destination is reallocated by xrealloc
+ (and CODING->dst_bytes is enlarged accordingly). */
+
void
encode_coding_object (struct coding_system *coding,
Lisp_Object src_object,
@@ -8269,11 +8308,14 @@ encode_coding_object (struct coding_system *coding,
attrs = CODING_ID_ATTRS (coding->id);
- if (EQ (src_object, dst_object))
+ bool same_buffer = false;
+ if (EQ (src_object, dst_object) && BUFFERP (src_object))
{
struct Lisp_Marker *tail;
- for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
+ same_buffer = true;
+
+ for (tail = BUF_MARKERS (XBUFFER (src_object)); tail; tail = tail->next)
{
tail->need_adjustment
= tail->charpos == (tail->insertion_type ? from : to);
@@ -8292,7 +8334,7 @@ encode_coding_object (struct coding_system *coding,
else
insert_1_both ((char *) coding->source + from, chars, bytes, 0, 0, 0);
- if (EQ (src_object, dst_object))
+ if (same_buffer)
{
set_buffer_internal (XBUFFER (src_object));
saved_pt = PT, saved_pt_byte = PT_BYTE;
@@ -8323,7 +8365,7 @@ encode_coding_object (struct coding_system *coding,
{
code_conversion_save (0, 0);
set_buffer_internal (XBUFFER (src_object));
- if (EQ (src_object, dst_object))
+ if (same_buffer)
{
saved_pt = PT, saved_pt_byte = PT_BYTE;
coding->src_object = del_range_1 (from, to, 1, 1);
@@ -9470,7 +9512,7 @@ not fully specified.) */)
}
/* Whether STRING only contains chars in the 0..127 range. */
-static bool
+bool
string_ascii_p (Lisp_Object string)
{
ptrdiff_t nbytes = SBYTES (string);
diff --git a/src/comp.c b/src/comp.c
new file mode 100644
index 00000000000..c3803464827
--- /dev/null
+++ b/src/comp.c
@@ -0,0 +1,5440 @@
+/* Compile Emacs Lisp into native code.
+ Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+Author: Andrea Corallo <akrl@sdf.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/>. */
+
+#include <config.h>
+
+#include "lisp.h"
+
+#ifdef HAVE_NATIVE_COMP
+
+#include <setjmp.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <signal.h>
+#include <libgccjit.h>
+#include <epaths.h>
+
+#include "puresize.h"
+#include "window.h"
+#include "dynlib.h"
+#include "buffer.h"
+#include "blockinput.h"
+#include "coding.h"
+#include "md5.h"
+#include "sysstdio.h"
+#include "zlib.h"
+
+
+/********************************/
+/* Dynamic loading of libgccjit */
+/********************************/
+
+#ifdef WINDOWSNT
+# include "w32common.h"
+
+#undef gcc_jit_block_add_assignment
+#undef gcc_jit_block_add_comment
+#undef gcc_jit_block_add_eval
+#undef gcc_jit_block_end_with_conditional
+#undef gcc_jit_block_end_with_jump
+#undef gcc_jit_block_end_with_return
+#undef gcc_jit_block_end_with_void_return
+#undef gcc_jit_context_acquire
+#undef gcc_jit_context_add_command_line_option
+#undef gcc_jit_context_add_driver_option
+#undef gcc_jit_context_compile_to_file
+#undef gcc_jit_context_dump_reproducer_to_file
+#undef gcc_jit_context_dump_to_file
+#undef gcc_jit_context_get_builtin_function
+#undef gcc_jit_context_get_first_error
+#undef gcc_jit_context_get_int_type
+#undef gcc_jit_context_get_type
+#undef gcc_jit_context_new_array_access
+#undef gcc_jit_context_new_array_type
+#undef gcc_jit_context_new_binary_op
+#undef gcc_jit_context_new_call
+#undef gcc_jit_context_new_call_through_ptr
+#undef gcc_jit_context_new_comparison
+#undef gcc_jit_context_new_field
+#undef gcc_jit_context_new_function
+#undef gcc_jit_context_new_function_ptr_type
+#undef gcc_jit_context_new_global
+#undef gcc_jit_context_new_opaque_struct
+#undef gcc_jit_context_new_param
+#undef gcc_jit_context_new_rvalue_from_int
+#undef gcc_jit_context_new_rvalue_from_long
+#undef gcc_jit_context_new_rvalue_from_ptr
+#undef gcc_jit_context_new_string_literal
+#undef gcc_jit_context_new_struct_type
+#undef gcc_jit_context_new_unary_op
+#undef gcc_jit_context_new_union_type
+#undef gcc_jit_context_release
+#undef gcc_jit_context_set_bool_option
+#undef gcc_jit_context_set_int_option
+#undef gcc_jit_context_set_logfile
+#undef gcc_jit_context_set_str_option
+#undef gcc_jit_function_get_param
+#undef gcc_jit_function_new_block
+#undef gcc_jit_function_new_local
+#undef gcc_jit_global_set_initializer
+#undef gcc_jit_lvalue_access_field
+#undef gcc_jit_lvalue_as_rvalue
+#undef gcc_jit_lvalue_get_address
+#undef gcc_jit_param_as_lvalue
+#undef gcc_jit_param_as_rvalue
+#undef gcc_jit_rvalue_access_field
+#undef gcc_jit_rvalue_dereference
+#undef gcc_jit_rvalue_dereference_field
+#undef gcc_jit_rvalue_get_type
+#undef gcc_jit_struct_as_type
+#undef gcc_jit_struct_set_fields
+#undef gcc_jit_type_get_const
+#undef gcc_jit_type_get_pointer
+#undef gcc_jit_version_major
+#undef gcc_jit_version_minor
+#undef gcc_jit_version_patchlevel
+
+/* In alphabetical order */
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_int,
+ (gcc_jit_context *ctxt, gcc_jit_type *numeric_type, int value));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_lvalue_as_rvalue,
+ (gcc_jit_lvalue *lvalue));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_rvalue_access_field,
+ (gcc_jit_rvalue *struct_or_union, gcc_jit_location *loc,
+ gcc_jit_field *field));
+DEF_DLL_FN (void, gcc_jit_block_add_comment,
+ (gcc_jit_block *block, gcc_jit_location *loc, const char *text));
+DEF_DLL_FN (void, gcc_jit_context_release, (gcc_jit_context *ctxt));
+DEF_DLL_FN (const char *, gcc_jit_context_get_first_error,
+ (gcc_jit_context *ctxt));
+DEF_DLL_FN (gcc_jit_block *, gcc_jit_function_new_block,
+ (gcc_jit_function *func, const char *name));
+DEF_DLL_FN (gcc_jit_context *, gcc_jit_context_acquire, (void));
+DEF_DLL_FN (void, gcc_jit_context_add_command_line_option,
+ (gcc_jit_context *ctxt, const char *optname));
+DEF_DLL_FN (void, gcc_jit_context_add_driver_option,
+ (gcc_jit_context *ctxt, const char *optname));
+DEF_DLL_FN (gcc_jit_field *, gcc_jit_context_new_field,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_function *, gcc_jit_context_get_builtin_function,
+ (gcc_jit_context *ctxt, const char *name));
+DEF_DLL_FN (gcc_jit_function *, gcc_jit_context_new_function,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_function_kind kind, gcc_jit_type *return_type,
+ const char *name, int num_params, gcc_jit_param **params,
+ int is_variadic));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_array_access,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_rvalue *ptr,
+ gcc_jit_rvalue *index));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_global,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_global_kind kind, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_function_new_local,
+ (gcc_jit_function *func, gcc_jit_location *loc, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_global_set_initializer,
+ (gcc_jit_lvalue *global, const void *blob, size_t num_bytes));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_lvalue_access_field,
+ (gcc_jit_lvalue *struct_or_union, gcc_jit_location *loc,
+ gcc_jit_field *field));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_param_as_lvalue, (gcc_jit_param *param));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_rvalue_dereference,
+ (gcc_jit_rvalue *rvalue, gcc_jit_location *loc));
+DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_rvalue_dereference_field,
+ (gcc_jit_rvalue *ptr, gcc_jit_location *loc, gcc_jit_field *field));
+DEF_DLL_FN (gcc_jit_param *, gcc_jit_context_new_param,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_type *type,
+ const char *name));
+DEF_DLL_FN (gcc_jit_param *, gcc_jit_function_get_param,
+ (gcc_jit_function *func, int index));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_binary_op,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_binary_op op, gcc_jit_type *result_type,
+ gcc_jit_rvalue *a, gcc_jit_rvalue *b));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_function *func, int numargs , gcc_jit_rvalue **args));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call_through_ptr,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_rvalue *fn_ptr, int numargs, gcc_jit_rvalue **args));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_comparison,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_comparison op, gcc_jit_rvalue *a, gcc_jit_rvalue *b));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_long,
+ (gcc_jit_context *ctxt, gcc_jit_type *numeric_type, long value));
+#if LISP_WORDS_ARE_POINTERS
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_ptr,
+ (gcc_jit_context *ctxt, gcc_jit_type *pointer_type, void *value));
+#endif
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_string_literal,
+ (gcc_jit_context *ctxt, const char *value));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_unary_op,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ enum gcc_jit_unary_op op, gcc_jit_type *result_type,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_lvalue_get_address,
+ (gcc_jit_lvalue *lvalue, gcc_jit_location *loc));
+DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_param_as_rvalue, (gcc_jit_param *param));
+DEF_DLL_FN (gcc_jit_struct *, gcc_jit_context_new_opaque_struct,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name));
+DEF_DLL_FN (gcc_jit_struct *, gcc_jit_context_new_struct_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name,
+ int num_fields, gcc_jit_field **fields));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_get_int_type,
+ (gcc_jit_context *ctxt, int num_bytes, int is_signed));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_get_type,
+ (gcc_jit_context *ctxt, enum gcc_jit_types type_));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_array_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_type *element_type, int num_elements));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_function_ptr_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc,
+ gcc_jit_type *return_type, int num_params,
+ gcc_jit_type **param_types, int is_variadic));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_union_type,
+ (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name,
+ int num_fields, gcc_jit_field **fields));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_rvalue_get_type, (gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_struct_as_type,
+ (gcc_jit_struct *struct_type));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_get_const, (gcc_jit_type *type));
+DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_get_pointer, (gcc_jit_type *type));
+DEF_DLL_FN (void, gcc_jit_block_add_assignment,
+ (gcc_jit_block *block, gcc_jit_location *loc, gcc_jit_lvalue *lvalue,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (void, gcc_jit_block_add_eval,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (void, gcc_jit_block_end_with_conditional,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_rvalue *boolval, gcc_jit_block *on_true,
+ gcc_jit_block *on_false));
+DEF_DLL_FN (void, gcc_jit_block_end_with_jump,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_block *target));
+DEF_DLL_FN (void, gcc_jit_block_end_with_return,
+ (gcc_jit_block *block, gcc_jit_location *loc,
+ gcc_jit_rvalue *rvalue));
+DEF_DLL_FN (void, gcc_jit_block_end_with_void_return,
+ (gcc_jit_block *block, gcc_jit_location *loc));
+DEF_DLL_FN (void, gcc_jit_context_compile_to_file,
+ (gcc_jit_context *ctxt, enum gcc_jit_output_kind output_kind,
+ const char *output_path));
+DEF_DLL_FN (void, gcc_jit_context_dump_reproducer_to_file,
+ (gcc_jit_context *ctxt, const char *path));
+DEF_DLL_FN (void, gcc_jit_context_dump_to_file,
+ (gcc_jit_context *ctxt, const char *path, int update_locations));
+DEF_DLL_FN (void, gcc_jit_context_set_bool_option,
+ (gcc_jit_context *ctxt, enum gcc_jit_bool_option opt, int value));
+DEF_DLL_FN (void, gcc_jit_context_set_int_option,
+ (gcc_jit_context *ctxt, enum gcc_jit_int_option opt, int value));
+DEF_DLL_FN (void, gcc_jit_context_set_logfile,
+ (gcc_jit_context *ctxt, FILE *logfile, int flags, int verbosity));
+DEF_DLL_FN (void, gcc_jit_context_set_str_option,
+ (gcc_jit_context *ctxt, enum gcc_jit_str_option opt,
+ const char *value));
+DEF_DLL_FN (void, gcc_jit_struct_set_fields,
+ (gcc_jit_struct *struct_type, gcc_jit_location *loc, int num_fields,
+ gcc_jit_field **fields));
+DEF_DLL_FN (int, gcc_jit_version_major, (void));
+DEF_DLL_FN (int, gcc_jit_version_minor, (void));
+DEF_DLL_FN (int, gcc_jit_version_patchlevel, (void));
+
+static bool
+init_gccjit_functions (void)
+{
+ HMODULE library = w32_delayed_load (Qgccjit);
+
+ if (!library)
+ return false;
+
+ /* In alphabetical order */
+ LOAD_DLL_FN (library, gcc_jit_block_add_assignment);
+ LOAD_DLL_FN (library, gcc_jit_block_add_comment);
+ LOAD_DLL_FN (library, gcc_jit_block_add_eval);
+ LOAD_DLL_FN (library, gcc_jit_block_end_with_conditional);
+ LOAD_DLL_FN (library, gcc_jit_block_end_with_jump);
+ LOAD_DLL_FN (library, gcc_jit_block_end_with_return);
+ LOAD_DLL_FN (library, gcc_jit_block_end_with_void_return);
+ LOAD_DLL_FN (library, gcc_jit_context_acquire);
+ LOAD_DLL_FN (library, gcc_jit_context_compile_to_file);
+ LOAD_DLL_FN (library, gcc_jit_context_dump_reproducer_to_file);
+ LOAD_DLL_FN (library, gcc_jit_context_dump_to_file);
+ LOAD_DLL_FN (library, gcc_jit_context_get_builtin_function);
+ LOAD_DLL_FN (library, gcc_jit_context_get_first_error);
+ LOAD_DLL_FN (library, gcc_jit_context_get_int_type);
+ LOAD_DLL_FN (library, gcc_jit_context_get_type);
+ LOAD_DLL_FN (library, gcc_jit_context_new_array_access);
+ LOAD_DLL_FN (library, gcc_jit_context_new_array_type);
+ LOAD_DLL_FN (library, gcc_jit_context_new_binary_op);
+ LOAD_DLL_FN (library, gcc_jit_context_new_call);
+ LOAD_DLL_FN (library, gcc_jit_context_new_call_through_ptr);
+ LOAD_DLL_FN (library, gcc_jit_context_new_comparison);
+ LOAD_DLL_FN (library, gcc_jit_context_new_field);
+ LOAD_DLL_FN (library, gcc_jit_context_new_function);
+ LOAD_DLL_FN (library, gcc_jit_context_new_function_ptr_type);
+ LOAD_DLL_FN (library, gcc_jit_context_new_global);
+ LOAD_DLL_FN (library, gcc_jit_context_new_opaque_struct);
+ LOAD_DLL_FN (library, gcc_jit_context_new_param);
+ LOAD_DLL_FN (library, gcc_jit_context_new_rvalue_from_int);
+ LOAD_DLL_FN (library, gcc_jit_context_new_rvalue_from_long);
+#if LISP_WORDS_ARE_POINTERS
+ LOAD_DLL_FN (library, gcc_jit_context_new_rvalue_from_ptr);
+#endif
+ LOAD_DLL_FN (library, gcc_jit_context_new_string_literal);
+ LOAD_DLL_FN (library, gcc_jit_context_new_struct_type);
+ LOAD_DLL_FN (library, gcc_jit_context_new_unary_op);
+ LOAD_DLL_FN (library, gcc_jit_context_new_union_type);
+ LOAD_DLL_FN (library, gcc_jit_context_release);
+ LOAD_DLL_FN (library, gcc_jit_context_set_bool_option);
+ LOAD_DLL_FN (library, gcc_jit_context_set_int_option);
+ LOAD_DLL_FN (library, gcc_jit_context_set_logfile);
+ LOAD_DLL_FN (library, gcc_jit_context_set_str_option);
+ LOAD_DLL_FN (library, gcc_jit_function_get_param);
+ LOAD_DLL_FN (library, gcc_jit_function_new_block);
+ LOAD_DLL_FN (library, gcc_jit_function_new_local);
+ LOAD_DLL_FN (library, gcc_jit_lvalue_access_field);
+ LOAD_DLL_FN (library, gcc_jit_lvalue_as_rvalue);
+ LOAD_DLL_FN (library, gcc_jit_lvalue_get_address);
+ LOAD_DLL_FN (library, gcc_jit_param_as_lvalue);
+ LOAD_DLL_FN (library, gcc_jit_param_as_rvalue);
+ LOAD_DLL_FN (library, gcc_jit_rvalue_access_field);
+ LOAD_DLL_FN (library, gcc_jit_rvalue_dereference);
+ LOAD_DLL_FN (library, gcc_jit_rvalue_dereference_field);
+ LOAD_DLL_FN (library, gcc_jit_rvalue_get_type);
+ LOAD_DLL_FN (library, gcc_jit_struct_as_type);
+ LOAD_DLL_FN (library, gcc_jit_struct_set_fields);
+ LOAD_DLL_FN (library, gcc_jit_type_get_const);
+ LOAD_DLL_FN (library, gcc_jit_type_get_pointer);
+ LOAD_DLL_FN_OPT (library, gcc_jit_context_add_command_line_option);
+ LOAD_DLL_FN_OPT (library, gcc_jit_context_add_driver_option);
+ LOAD_DLL_FN_OPT (library, gcc_jit_global_set_initializer);
+ LOAD_DLL_FN_OPT (library, gcc_jit_version_major);
+ LOAD_DLL_FN_OPT (library, gcc_jit_version_minor);
+ LOAD_DLL_FN_OPT (library, gcc_jit_version_patchlevel);
+
+ return true;
+}
+
+/* In alphabetical order */
+#define gcc_jit_block_add_assignment fn_gcc_jit_block_add_assignment
+#define gcc_jit_block_add_comment fn_gcc_jit_block_add_comment
+#define gcc_jit_block_add_eval fn_gcc_jit_block_add_eval
+#define gcc_jit_block_end_with_conditional fn_gcc_jit_block_end_with_conditional
+#define gcc_jit_block_end_with_jump fn_gcc_jit_block_end_with_jump
+#define gcc_jit_block_end_with_return fn_gcc_jit_block_end_with_return
+#define gcc_jit_block_end_with_void_return fn_gcc_jit_block_end_with_void_return
+#define gcc_jit_context_acquire fn_gcc_jit_context_acquire
+#define gcc_jit_context_add_command_line_option fn_gcc_jit_context_add_command_line_option
+#define gcc_jit_context_add_driver_option fn_gcc_jit_context_add_driver_option
+#define gcc_jit_context_compile_to_file fn_gcc_jit_context_compile_to_file
+#define gcc_jit_context_dump_reproducer_to_file fn_gcc_jit_context_dump_reproducer_to_file
+#define gcc_jit_context_dump_to_file fn_gcc_jit_context_dump_to_file
+#define gcc_jit_context_get_builtin_function fn_gcc_jit_context_get_builtin_function
+#define gcc_jit_context_get_first_error fn_gcc_jit_context_get_first_error
+#define gcc_jit_context_get_int_type fn_gcc_jit_context_get_int_type
+#define gcc_jit_context_get_type fn_gcc_jit_context_get_type
+#define gcc_jit_context_new_array_access fn_gcc_jit_context_new_array_access
+#define gcc_jit_context_new_array_type fn_gcc_jit_context_new_array_type
+#define gcc_jit_context_new_binary_op fn_gcc_jit_context_new_binary_op
+#define gcc_jit_context_new_call fn_gcc_jit_context_new_call
+#define gcc_jit_context_new_call_through_ptr fn_gcc_jit_context_new_call_through_ptr
+#define gcc_jit_context_new_comparison fn_gcc_jit_context_new_comparison
+#define gcc_jit_context_new_field fn_gcc_jit_context_new_field
+#define gcc_jit_context_new_function fn_gcc_jit_context_new_function
+#define gcc_jit_context_new_function_ptr_type fn_gcc_jit_context_new_function_ptr_type
+#define gcc_jit_context_new_global fn_gcc_jit_context_new_global
+#define gcc_jit_context_new_opaque_struct fn_gcc_jit_context_new_opaque_struct
+#define gcc_jit_context_new_param fn_gcc_jit_context_new_param
+#define gcc_jit_context_new_rvalue_from_int fn_gcc_jit_context_new_rvalue_from_int
+#define gcc_jit_context_new_rvalue_from_long fn_gcc_jit_context_new_rvalue_from_long
+#if LISP_WORDS_ARE_POINTERS
+# define gcc_jit_context_new_rvalue_from_ptr fn_gcc_jit_context_new_rvalue_from_ptr
+#endif
+#define gcc_jit_context_new_string_literal fn_gcc_jit_context_new_string_literal
+#define gcc_jit_context_new_struct_type fn_gcc_jit_context_new_struct_type
+#define gcc_jit_context_new_unary_op fn_gcc_jit_context_new_unary_op
+#define gcc_jit_context_new_union_type fn_gcc_jit_context_new_union_type
+#define gcc_jit_context_release fn_gcc_jit_context_release
+#define gcc_jit_context_set_bool_option fn_gcc_jit_context_set_bool_option
+#define gcc_jit_context_set_int_option fn_gcc_jit_context_set_int_option
+#define gcc_jit_context_set_logfile fn_gcc_jit_context_set_logfile
+#define gcc_jit_context_set_str_option fn_gcc_jit_context_set_str_option
+#define gcc_jit_function_get_param fn_gcc_jit_function_get_param
+#define gcc_jit_function_new_block fn_gcc_jit_function_new_block
+#define gcc_jit_function_new_local fn_gcc_jit_function_new_local
+#define gcc_jit_global_set_initializer fn_gcc_jit_global_set_initializer
+#define gcc_jit_lvalue_access_field fn_gcc_jit_lvalue_access_field
+#define gcc_jit_lvalue_as_rvalue fn_gcc_jit_lvalue_as_rvalue
+#define gcc_jit_lvalue_get_address fn_gcc_jit_lvalue_get_address
+#define gcc_jit_param_as_lvalue fn_gcc_jit_param_as_lvalue
+#define gcc_jit_param_as_rvalue fn_gcc_jit_param_as_rvalue
+#define gcc_jit_rvalue_access_field fn_gcc_jit_rvalue_access_field
+#define gcc_jit_rvalue_dereference fn_gcc_jit_rvalue_dereference
+#define gcc_jit_rvalue_dereference_field fn_gcc_jit_rvalue_dereference_field
+#define gcc_jit_rvalue_get_type fn_gcc_jit_rvalue_get_type
+#define gcc_jit_struct_as_type fn_gcc_jit_struct_as_type
+#define gcc_jit_struct_set_fields fn_gcc_jit_struct_set_fields
+#define gcc_jit_type_get_const fn_gcc_jit_type_get_const
+#define gcc_jit_type_get_pointer fn_gcc_jit_type_get_pointer
+#define gcc_jit_version_major fn_gcc_jit_version_major
+#define gcc_jit_version_minor fn_gcc_jit_version_minor
+#define gcc_jit_version_patchlevel fn_gcc_jit_version_patchlevel
+
+#endif
+
+static bool
+load_gccjit_if_necessary (bool mandatory)
+{
+#ifdef WINDOWSNT
+ static bool tried_to_initialize_once;
+ static bool gccjit_initialized;
+
+ if (!tried_to_initialize_once)
+ {
+ tried_to_initialize_once = true;
+ Lisp_Object status;
+ gccjit_initialized = init_gccjit_functions ();
+ status = gccjit_initialized ? Qt : Qnil;
+ Vlibrary_cache = Fcons (Fcons (Qgccjit, status), Vlibrary_cache);
+ }
+
+ if (mandatory && !gccjit_initialized)
+ xsignal1 (Qnative_compiler_error, build_string ("libgccjit not found"));
+
+ return gccjit_initialized;
+#else
+ return true;
+#endif
+}
+
+
+/* Increase this number to force a new Vcomp_abi_hash to be generated. */
+#define ABI_VERSION "4"
+
+/* Length of the hashes used for eln file naming. */
+#define HASH_LENGTH 8
+
+/* C symbols emitted for the load relocation mechanism. */
+#define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
+#define PURE_RELOC_SYM "pure_reloc"
+#define DATA_RELOC_SYM "d_reloc"
+#define DATA_RELOC_IMPURE_SYM "d_reloc_imp"
+#define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph"
+
+#define FUNC_LINK_TABLE_SYM "freloc_link_table"
+#define LINK_TABLE_HASH_SYM "freloc_hash"
+#define COMP_UNIT_SYM "comp_unit"
+#define TEXT_DATA_RELOC_SYM "text_data_reloc"
+#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp"
+#define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph"
+
+#define TEXT_OPTIM_QLY_SYM "text_optim_qly"
+#define TEXT_FDOC_SYM "text_data_fdoc"
+
+#define STR_VALUE(s) #s
+#define STR(s) STR_VALUE (s)
+
+#define FIRST(x) \
+ XCAR(x)
+#define SECOND(x) \
+ XCAR (XCDR (x))
+#define THIRD(x) \
+ XCAR (XCDR (XCDR (x)))
+
+/* Like call1 but stringify and intern. */
+#define CALL1I(fun, arg) \
+ CALLN (Ffuncall, intern_c_string (STR (fun)), arg)
+
+/* Like call2 but stringify and intern. */
+#define CALL2I(fun, arg1, arg2) \
+ CALLN (Ffuncall, intern_c_string (STR (fun)), arg1, arg2)
+
+#define DECL_BLOCK(name, func) \
+ gcc_jit_block *(name) = \
+ gcc_jit_function_new_block ((func), STR (name))
+
+#ifndef WINDOWSNT
+# ifdef HAVE__SETJMP
+# define SETJMP _setjmp
+# else
+# define SETJMP setjmp
+# endif
+#else
+/* snippet from MINGW-64 setjmp.h */
+# define SETJMP _setjmp
+#endif
+#define SETJMP_NAME SETJMP
+
+/* Max number function importable by native compiled code. */
+#define F_RELOC_MAX_SIZE 1500
+
+typedef struct {
+ void *link_table[F_RELOC_MAX_SIZE];
+ ptrdiff_t size;
+} f_reloc_t;
+
+sigset_t saved_sigset;
+
+static f_reloc_t freloc;
+
+#define NUM_CAST_TYPES 15
+
+enum cast_kind_of_type
+ {
+ kind_unsigned,
+ kind_signed,
+ kind_pointer
+ };
+
+typedef struct {
+ EMACS_INT len;
+ gcc_jit_rvalue *r_val;
+} reloc_array_t;
+
+/* C side of the compiler context. */
+
+typedef struct {
+ EMACS_INT speed;
+ EMACS_INT debug;
+ Lisp_Object driver_options;
+ gcc_jit_context *ctxt;
+ gcc_jit_type *void_type;
+ gcc_jit_type *bool_type;
+ gcc_jit_type *char_type;
+ gcc_jit_type *int_type;
+ gcc_jit_type *unsigned_type;
+ gcc_jit_type *long_type;
+ gcc_jit_type *unsigned_long_type;
+ gcc_jit_type *long_long_type;
+ gcc_jit_type *unsigned_long_long_type;
+ gcc_jit_type *emacs_int_type;
+ gcc_jit_type *emacs_uint_type;
+ gcc_jit_type *void_ptr_type;
+ gcc_jit_type *char_ptr_type;
+ gcc_jit_type *ptrdiff_type;
+ gcc_jit_type *uintptr_type;
+ gcc_jit_type *size_t_type;
+ gcc_jit_type *lisp_word_type;
+ gcc_jit_type *lisp_word_tag_type;
+#ifdef LISP_OBJECT_IS_STRUCT
+ gcc_jit_field *lisp_obj_i;
+ gcc_jit_struct *lisp_obj_s;
+#endif
+ gcc_jit_type *lisp_obj_type;
+ gcc_jit_type *lisp_obj_ptr_type;
+ /* struct Lisp_Cons */
+ gcc_jit_struct *lisp_cons_s;
+ gcc_jit_field *lisp_cons_u;
+ gcc_jit_field *lisp_cons_u_s;
+ gcc_jit_field *lisp_cons_u_s_car;
+ gcc_jit_field *lisp_cons_u_s_u;
+ gcc_jit_field *lisp_cons_u_s_u_cdr;
+ gcc_jit_type *lisp_cons_type;
+ gcc_jit_type *lisp_cons_ptr_type;
+ /* struct jmp_buf. */
+ gcc_jit_struct *jmp_buf_s;
+ /* struct handler. */
+ gcc_jit_struct *handler_s;
+ gcc_jit_field *handler_jmp_field;
+ gcc_jit_field *handler_val_field;
+ gcc_jit_field *handler_next_field;
+ gcc_jit_type *handler_ptr_type;
+ gcc_jit_lvalue *loc_handler;
+ /* struct thread_state. */
+ gcc_jit_struct *thread_state_s;
+ gcc_jit_field *m_handlerlist;
+ gcc_jit_type *thread_state_ptr_type;
+ gcc_jit_rvalue *current_thread_ref;
+ /* Other globals. */
+ gcc_jit_rvalue *pure_ptr;
+ /* libgccjit has really limited support for casting therefore this union will
+ be used for the scope. */
+ gcc_jit_type *cast_union_type;
+ gcc_jit_function *cast_functions_from_to[NUM_CAST_TYPES][NUM_CAST_TYPES];
+ /* We add one to make space for the last member which is the "biggest_type"
+ member. */
+ gcc_jit_type *cast_types[NUM_CAST_TYPES + 1];
+ size_t cast_type_sizes[NUM_CAST_TYPES + 1];
+ enum cast_kind_of_type cast_type_kind[NUM_CAST_TYPES + 1];
+ const char *cast_type_names[NUM_CAST_TYPES + 1];
+ gcc_jit_field *cast_union_fields[NUM_CAST_TYPES + 1];
+ size_t cast_union_field_biggest_type;
+ gcc_jit_function *func; /* Current function being compiled. */
+ bool func_has_non_local; /* From comp-func has-non-local slot. */
+ EMACS_INT func_speed; /* From comp-func speed slot. */
+ gcc_jit_block *block; /* Current basic block being compiled. */
+ gcc_jit_lvalue *scratch; /* Used as scratch slot for some code sequence (switch). */
+ ptrdiff_t frame_size; /* Size of the following array in elements. */
+ gcc_jit_lvalue **frame; /* Frame slot n -> gcc_jit_lvalue *. */
+ gcc_jit_rvalue *zero;
+ gcc_jit_rvalue *one;
+ gcc_jit_rvalue *inttypebits;
+ gcc_jit_rvalue *lisp_int0;
+ gcc_jit_function *pseudovectorp;
+ gcc_jit_function *bool_to_lisp_obj;
+ gcc_jit_function *add1;
+ gcc_jit_function *sub1;
+ gcc_jit_function *negate;
+ gcc_jit_function *car;
+ gcc_jit_function *cdr;
+ gcc_jit_function *setcar;
+ gcc_jit_function *setcdr;
+ gcc_jit_function *check_type;
+ gcc_jit_function *check_impure;
+ gcc_jit_function *maybe_gc_or_quit;
+ Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */
+ Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *. */
+ Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field. */
+ Lisp_Object emitter_dispatcher;
+ /* Synthesized struct holding data relocs. */
+ reloc_array_t data_relocs;
+ /* Same as before but can't go in pure space. */
+ reloc_array_t data_relocs_impure;
+ /* Same as before but content does not survive load phase. */
+ reloc_array_t data_relocs_ephemeral;
+ /* Global structure holding function relocations. */
+ gcc_jit_lvalue *func_relocs;
+ gcc_jit_type *func_relocs_ptr_type;
+ /* Pointer to this structure local to each function. */
+ gcc_jit_lvalue *func_relocs_local;
+ gcc_jit_function *memcpy;
+ Lisp_Object d_default_idx;
+ Lisp_Object d_impure_idx;
+ Lisp_Object d_ephemeral_idx;
+} comp_t;
+
+static comp_t comp;
+
+FILE *logfile = NULL;
+
+/* This is used for serialized objects by the reload mechanism. */
+typedef struct {
+ ptrdiff_t len;
+ char data[];
+} static_obj_t;
+
+typedef struct {
+ reloc_array_t array;
+ gcc_jit_rvalue *idx;
+} imm_reloc_t;
+
+
+/*
+ Helper functions called by the run-time.
+*/
+
+void helper_unwind_protect (Lisp_Object handler);
+Lisp_Object helper_temp_output_buffer_setup (Lisp_Object x);
+Lisp_Object helper_unbind_n (Lisp_Object n);
+void helper_save_restriction (void);
+bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code);
+
+void *helper_link_table[] =
+ { wrong_type_argument,
+ helper_PSEUDOVECTOR_TYPEP_XUNTAG,
+ pure_write_error,
+ push_handler,
+ record_unwind_protect_excursion,
+ helper_unbind_n,
+ helper_save_restriction,
+ record_unwind_current_buffer,
+ set_internal,
+ helper_unwind_protect,
+ specbind,
+ maybe_gc,
+ maybe_quit };
+
+
+static char * ATTRIBUTE_FORMAT_PRINTF (1, 2)
+format_string (const char *format, ...)
+{
+ static char scratch_area[512];
+ va_list va;
+ va_start (va, format);
+ int res = vsnprintf (scratch_area, sizeof (scratch_area), format, va);
+ if (res >= sizeof (scratch_area))
+ {
+ scratch_area[sizeof (scratch_area) - 4] = '.';
+ scratch_area[sizeof (scratch_area) - 3] = '.';
+ scratch_area[sizeof (scratch_area) - 2] = '.';
+ }
+ va_end (va);
+ return scratch_area;
+}
+
+static Lisp_Object
+comp_hash_string (Lisp_Object string)
+{
+ Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2);
+ md5_buffer (SSDATA (string), SCHARS (string), SSDATA (digest));
+ hexbuf_digest (SSDATA (digest), SDATA (digest), MD5_DIGEST_SIZE);
+
+ return Fsubstring (digest, Qnil, make_fixnum (HASH_LENGTH));
+}
+
+static Lisp_Object
+comp_hash_source_file (Lisp_Object filename)
+{
+ /* Can't use Finsert_file_contents + Fbuffer_hash as this is called
+ by Fcomp_el_to_eln_filename too early during bootstrap. */
+ bool is_gz = suffix_p (filename, ".gz");
+ Lisp_Object encoded_filename = ENCODE_FILE (filename);
+ FILE *f = emacs_fopen (SSDATA (encoded_filename), is_gz ? "rb" : "r");
+
+ if (!f)
+ report_file_error ("Opening source file", filename);
+
+ Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2);
+
+ int res = is_gz
+ ? md5_gz_stream (f, SSDATA (digest))
+ : md5_stream (f, SSDATA (digest));
+ fclose (f);
+
+ if (res)
+ xsignal2 (Qfile_notify_error, build_string ("hashing failed"), filename);
+
+ hexbuf_digest (SSDATA (digest), SSDATA (digest), MD5_DIGEST_SIZE);
+
+ return Fsubstring (digest, Qnil, make_fixnum (HASH_LENGTH));
+}
+
+DEFUN ("comp--subr-signature", Fcomp__subr_signature,
+ Scomp__subr_signature, 1, 1, 0,
+ doc: /* Support function to 'hash_native_abi'.
+For internal use. */)
+ (Lisp_Object subr)
+{
+ return concat2 (Fsubr_name (subr),
+ Fprin1_to_string (Fsubr_arity (subr), Qnil));
+}
+
+/* Produce a key hashing Vcomp_subr_list. */
+
+void
+hash_native_abi (void)
+{
+ /* Check runs once. */
+ eassert (NILP (Vcomp_abi_hash));
+
+ Vcomp_abi_hash =
+ comp_hash_string (
+ concat3 (build_string (ABI_VERSION),
+ concat3 (Vemacs_version, Vsystem_configuration,
+ Vsystem_configuration_options),
+ Fmapconcat (intern_c_string ("comp--subr-signature"),
+ Vcomp_subr_list, build_string (""))));
+
+ Lisp_Object version = Vemacs_version;
+
+#ifdef NS_SELF_CONTAINED
+ /* MacOS self contained app bundles do not like having dots in the
+ directory names under the Contents/Frameworks directory, so
+ convert them to underscores. */
+ version = STRING_MULTIBYTE (Vemacs_version)
+ ? make_uninit_multibyte_string (SCHARS (Vemacs_version),
+ SBYTES (Vemacs_version))
+ : make_uninit_string (SBYTES (Vemacs_version));
+
+ const unsigned char *from = SDATA (Vemacs_version);
+ unsigned char *to = SDATA (version);
+
+ while (from < SDATA (Vemacs_version) + SBYTES (Vemacs_version))
+ {
+ unsigned char c = *from++;
+
+ if (c == '.')
+ c = '_';
+
+ *to++ = c;
+ }
+#endif
+
+ Vcomp_native_version_dir =
+ concat3 (version, build_string ("-"), Vcomp_abi_hash);
+}
+
+static void
+freloc_check_fill (void)
+{
+ if (freloc.size)
+ return;
+
+ eassert (!NILP (Vcomp_subr_list));
+
+ if (ARRAYELTS (helper_link_table) > F_RELOC_MAX_SIZE)
+ goto overflow;
+ memcpy (freloc.link_table, helper_link_table, sizeof (helper_link_table));
+ freloc.size = ARRAYELTS (helper_link_table);
+
+ Lisp_Object subr_l = Vcomp_subr_list;
+ FOR_EACH_TAIL (subr_l)
+ {
+ if (freloc.size == F_RELOC_MAX_SIZE)
+ goto overflow;
+ struct Lisp_Subr *subr = XSUBR (XCAR (subr_l));
+ freloc.link_table[freloc.size] = subr->function.a0;
+ freloc.size++;
+ }
+ return;
+
+ overflow:
+ fatal ("Overflowing function relocation table, increase F_RELOC_MAX_SIZE");
+}
+
+static void
+bcall0 (Lisp_Object f)
+{
+ Ffuncall (1, &f);
+}
+
+static gcc_jit_block *
+retrive_block (Lisp_Object block_name)
+{
+ Lisp_Object value = Fgethash (block_name, comp.func_blocks_h, Qnil);
+
+ if (NILP (value))
+ xsignal2 (Qnative_ice, build_string ("missing basic block"), block_name);
+
+ return (gcc_jit_block *) xmint_pointer (value);
+}
+
+static void
+declare_block (Lisp_Object block_name)
+{
+ char *name_str = SSDATA (SYMBOL_NAME (block_name));
+ gcc_jit_block *block = gcc_jit_function_new_block (comp.func, name_str);
+ Lisp_Object value = make_mint_ptr (block);
+
+ if (!NILP (Fgethash (block_name, comp.func_blocks_h, Qnil)))
+ xsignal1 (Qnative_ice, build_string ("double basic block declaration"));
+
+ Fputhash (block_name, value, comp.func_blocks_h);
+}
+
+static gcc_jit_lvalue *
+emit_mvar_lval (Lisp_Object mvar)
+{
+ Lisp_Object mvar_slot = CALL1I (comp-mvar-slot, mvar);
+
+ if (EQ (mvar_slot, Qscratch))
+ {
+ if (!comp.scratch)
+ comp.scratch = gcc_jit_function_new_local (comp.func,
+ NULL,
+ comp.lisp_obj_type,
+ "scratch");
+ return comp.scratch;
+ }
+
+ EMACS_INT slot_n = XFIXNUM (mvar_slot);
+ eassert (slot_n < comp.frame_size);
+ return comp.frame[slot_n];
+}
+
+static void
+register_emitter (Lisp_Object key, void *func)
+{
+ Lisp_Object value = make_mint_ptr (func);
+ Fputhash (key, value, comp.emitter_dispatcher);
+}
+
+static imm_reloc_t
+obj_to_reloc (Lisp_Object obj)
+{
+ imm_reloc_t reloc;
+ Lisp_Object idx;
+
+ idx = Fgethash (obj, comp.d_default_idx, Qnil);
+ if (!NILP (idx)) {
+ reloc.array = comp.data_relocs;
+ goto found;
+ }
+
+ idx = Fgethash (obj, comp.d_impure_idx, Qnil);
+ if (!NILP (idx))
+ {
+ reloc.array = comp.data_relocs_impure;
+ goto found;
+ }
+
+ idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil);
+ if (!NILP (idx))
+ {
+ reloc.array = comp.data_relocs_ephemeral;
+ goto found;
+ }
+
+ xsignal1 (Qnative_ice,
+ build_string ("cant't find data in relocation containers"));
+ assume (false);
+
+ found:
+ eassert (XFIXNUM (idx) < reloc.array.len);
+ if (!FIXNUMP (idx))
+ xsignal1 (Qnative_ice,
+ build_string ("inconsistent data relocation container"));
+ reloc.idx = gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.ptrdiff_type,
+ XFIXNUM (idx));
+ return reloc;
+}
+
+static void
+emit_comment (const char *str)
+{
+ if (comp.debug)
+ gcc_jit_block_add_comment (comp.block,
+ NULL,
+ str);
+}
+
+/*
+ Declare an imported function.
+ When nargs is MANY (ptrdiff_t nargs, Lisp_Object *args) signature is assumed.
+ When types is NULL args are assumed to be all Lisp_Objects.
+*/
+static gcc_jit_field *
+declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type,
+ int nargs, gcc_jit_type **types)
+{
+ USE_SAFE_ALLOCA;
+ /* Don't want to declare the same function two times. */
+ if (!NILP (Fgethash (subr_sym, comp.imported_funcs_h, Qnil)))
+ xsignal2 (Qnative_ice,
+ build_string ("unexpected double function declaration"),
+ subr_sym);
+
+ if (nargs == MANY)
+ {
+ nargs = 2;
+ types = SAFE_ALLOCA (nargs * sizeof (* types));
+ types[0] = comp.ptrdiff_type;
+ types[1] = comp.lisp_obj_ptr_type;
+ }
+ else if (nargs == UNEVALLED)
+ {
+ nargs = 1;
+ types = SAFE_ALLOCA (nargs * sizeof (* types));
+ types[0] = comp.lisp_obj_type;
+ }
+ else if (!types)
+ {
+ types = SAFE_ALLOCA (nargs * sizeof (* types));
+ for (ptrdiff_t i = 0; i < nargs; i++)
+ types[i] = comp.lisp_obj_type;
+ }
+
+ /* String containing the function ptr name. */
+ Lisp_Object f_ptr_name =
+ CALLN (Ffuncall, intern_c_string ("comp-c-func-name"),
+ subr_sym, make_string ("R", 1));
+
+ gcc_jit_type *f_ptr_type =
+ gcc_jit_type_get_const (
+ gcc_jit_context_new_function_ptr_type (comp.ctxt,
+ NULL,
+ ret_type,
+ nargs,
+ types,
+ 0));
+ gcc_jit_field *field =
+ gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ f_ptr_type,
+ SSDATA (f_ptr_name));
+
+ Fputhash (subr_sym, make_mint_ptr (field), comp.imported_funcs_h);
+ SAFE_FREE ();
+ return field;
+}
+
+/* Emit calls fetching from existing declarations. */
+
+static gcc_jit_rvalue *
+emit_call (Lisp_Object func, gcc_jit_type *ret_type, ptrdiff_t nargs,
+ gcc_jit_rvalue **args, bool direct)
+{
+ Lisp_Object gcc_func =
+ Fgethash (func,
+ direct ? comp.exported_funcs_h : comp.imported_funcs_h,
+ Qnil);
+
+ if (NILP (gcc_func))
+ xsignal2 (Qnative_ice,
+ build_string ("missing function declaration"),
+ func);
+
+ if (direct)
+ {
+ emit_comment (format_string ("direct call to: %s",
+ SSDATA (func)));
+ return gcc_jit_context_new_call (comp.ctxt,
+ NULL,
+ xmint_pointer (gcc_func),
+ nargs,
+ args);
+ }
+ else
+ {
+ /* Inline functions so far don't have a local variable for
+ function reloc table so we fall back to the global one. Even
+ if this is not aesthetic calling into C from open-code is
+ always a fallback and therefore not be performance critical.
+ To fix this could think do the inline our-self without
+ relying on GCC. */
+ gcc_jit_lvalue *f_ptr =
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (comp.func_relocs_local
+ ? comp.func_relocs_local
+ : comp.func_relocs),
+ NULL,
+ (gcc_jit_field *) xmint_pointer (gcc_func));
+
+ if (!f_ptr)
+ xsignal2 (Qnative_ice,
+ build_string ("missing function relocation"),
+ func);
+ emit_comment (format_string ("calling subr: %s",
+ SSDATA (SYMBOL_NAME (func))));
+ return gcc_jit_context_new_call_through_ptr (comp.ctxt,
+ NULL,
+ gcc_jit_lvalue_as_rvalue (f_ptr),
+ nargs,
+ args);
+ }
+}
+
+static gcc_jit_rvalue *
+emit_call_ref (Lisp_Object func, ptrdiff_t nargs,
+ gcc_jit_lvalue *base_arg, bool direct)
+{
+ gcc_jit_rvalue *args[] =
+ { gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.ptrdiff_type,
+ nargs),
+ gcc_jit_lvalue_get_address (base_arg, NULL) };
+ return emit_call (func, comp.lisp_obj_type, 2, args, direct);
+}
+
+/* Close current basic block emitting a conditional. */
+
+static void
+emit_cond_jump (gcc_jit_rvalue *test,
+ gcc_jit_block *then_target, gcc_jit_block *else_target)
+{
+ if (gcc_jit_rvalue_get_type (test) == comp.bool_type)
+ gcc_jit_block_end_with_conditional (comp.block,
+ NULL,
+ test,
+ then_target,
+ else_target);
+ else
+ /* In case test is not bool we do a logical negation to obtain a bool as
+ result. */
+ gcc_jit_block_end_with_conditional (
+ comp.block,
+ NULL,
+ gcc_jit_context_new_unary_op (comp.ctxt,
+ NULL,
+ GCC_JIT_UNARY_OP_LOGICAL_NEGATE,
+ comp.bool_type,
+ test),
+ else_target,
+ then_target);
+
+}
+
+static int
+type_to_cast_index (gcc_jit_type * type)
+{
+ for (int i = 0; i < NUM_CAST_TYPES; ++i)
+ if (type == comp.cast_types[i])
+ return i;
+
+ xsignal1 (Qnative_ice, build_string ("unsupported cast"));
+}
+
+static gcc_jit_rvalue *
+emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
+{
+ gcc_jit_type *old_type = gcc_jit_rvalue_get_type (obj);
+
+ if (new_type == old_type)
+ return obj;
+
+#ifdef LISP_OBJECT_IS_STRUCT
+ if (old_type == comp.lisp_obj_type)
+ {
+ gcc_jit_rvalue *lwordobj =
+ gcc_jit_rvalue_access_field (obj, NULL, comp.lisp_obj_i);
+ return emit_coerce (new_type, lwordobj);
+ }
+
+ if (new_type == comp.lisp_obj_type)
+ {
+ gcc_jit_rvalue *lwordobj =
+ emit_coerce (comp.lisp_word_type, obj);
+
+ static ptrdiff_t i;
+ gcc_jit_lvalue *tmp_s =
+ gcc_jit_function_new_local (comp.func, NULL, comp.lisp_obj_type,
+ format_string ("lisp_obj_%td", i++));
+
+ gcc_jit_block_add_assignment (
+ comp.block, NULL,
+ gcc_jit_lvalue_access_field (tmp_s, NULL,
+ comp.lisp_obj_i),
+ lwordobj);
+ return gcc_jit_lvalue_as_rvalue (tmp_s);
+ }
+#endif
+
+ int old_index = type_to_cast_index (old_type);
+ int new_index = type_to_cast_index (new_type);
+
+ if (comp.cast_type_sizes[old_index] < comp.cast_type_sizes[new_index]
+ && comp.cast_type_kind[new_index] == kind_signed)
+ xsignal3 (Qnative_ice,
+ build_string ("FIXME: sign extension not implemented"),
+ build_string (comp.cast_type_names[old_index]),
+ build_string (comp.cast_type_names[new_index]));
+
+ /* Lookup the appropriate cast function in the cast matrix. */
+ return gcc_jit_context_new_call (comp.ctxt,
+ NULL,
+ comp.cast_functions_from_to[old_index][new_index],
+ 1, &obj);
+}
+
+static gcc_jit_rvalue *
+emit_binary_op (enum gcc_jit_binary_op op,
+ gcc_jit_type *result_type,
+ gcc_jit_rvalue *a, gcc_jit_rvalue *b)
+{
+ /* FIXME Check here for possible UB. */
+ return gcc_jit_context_new_binary_op (comp.ctxt, NULL,
+ op,
+ result_type,
+ emit_coerce (result_type, a),
+ emit_coerce (result_type, b));
+}
+
+/* Should come with libgccjit. */
+
+static gcc_jit_rvalue *
+emit_rvalue_from_long_long (gcc_jit_type *type, long long n)
+{
+ emit_comment (format_string ("emit long long: %lld", n));
+
+ gcc_jit_rvalue *high =
+ gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.unsigned_long_long_type,
+ (unsigned long long)n >> 32);
+ gcc_jit_rvalue *low =
+ emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT,
+ comp.unsigned_long_long_type,
+ emit_binary_op (GCC_JIT_BINARY_OP_LSHIFT,
+ comp.unsigned_long_long_type,
+ gcc_jit_context_new_rvalue_from_long (
+ comp.ctxt,
+ comp.unsigned_long_long_type,
+ n),
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_long_long_type,
+ 32)),
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_long_long_type,
+ 32));
+
+ return
+ emit_coerce (type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_BITWISE_OR,
+ comp.unsigned_long_long_type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_LSHIFT,
+ comp.unsigned_long_long_type,
+ high,
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.unsigned_long_long_type,
+ 32)),
+ low));
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_emacs_uint (EMACS_UINT val)
+{
+#ifdef WIDE_EMACS_INT
+ if (val > ULONG_MAX)
+ return emit_rvalue_from_long_long (comp.emacs_uint_type, val);
+#endif
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.emacs_uint_type,
+ val);
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_emacs_int (EMACS_INT val)
+{
+ if (val > LONG_MAX || val < LONG_MIN)
+ return emit_rvalue_from_long_long (comp.emacs_int_type, val);
+ else
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.emacs_int_type, val);
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_lisp_word_tag (Lisp_Word_tag val)
+{
+#ifdef WIDE_EMACS_INT
+ if (val > ULONG_MAX)
+ return emit_rvalue_from_long_long (comp.lisp_word_tag_type, val);
+#endif
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.lisp_word_tag_type,
+ val);
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_lisp_word (Lisp_Word val)
+{
+#if LISP_WORDS_ARE_POINTERS
+ return gcc_jit_context_new_rvalue_from_ptr (comp.ctxt,
+ comp.lisp_word_type,
+ val);
+#else
+ if (val > LONG_MAX || val < LONG_MIN)
+ return emit_rvalue_from_long_long (comp.lisp_word_type, val);
+ else
+ return gcc_jit_context_new_rvalue_from_long (comp.ctxt,
+ comp.lisp_word_type,
+ val);
+#endif
+}
+
+static gcc_jit_rvalue *
+emit_rvalue_from_lisp_obj (Lisp_Object obj)
+{
+#ifdef LISP_OBJECT_IS_STRUCT
+ return emit_coerce (comp.lisp_obj_type,
+ emit_rvalue_from_lisp_word (obj.i));
+#else
+ return emit_rvalue_from_lisp_word (obj);
+#endif
+}
+
+/*
+ Emit the equivalent of:
+ (typeof_ptr) ((uintptr) ptr + size_of_ptr_ref * i)
+*/
+
+static gcc_jit_rvalue *
+emit_ptr_arithmetic (gcc_jit_rvalue *ptr, gcc_jit_type *ptr_type,
+ int size_of_ptr_ref, gcc_jit_rvalue *i)
+{
+ emit_comment ("ptr_arithmetic");
+
+ gcc_jit_rvalue *offset =
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_MULT,
+ comp.uintptr_type,
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.uintptr_type,
+ size_of_ptr_ref),
+ i);
+
+ return
+ emit_coerce (
+ ptr_type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_PLUS,
+ comp.uintptr_type,
+ ptr,
+ offset));
+}
+
+static gcc_jit_rvalue *
+emit_XLI (gcc_jit_rvalue *obj)
+{
+ emit_comment ("XLI");
+ return emit_coerce (comp.emacs_int_type, obj);
+}
+
+static gcc_jit_rvalue *
+emit_XLP (gcc_jit_rvalue *obj)
+{
+ emit_comment ("XLP");
+
+ return emit_coerce (comp.void_ptr_type, obj);
+}
+
+static gcc_jit_rvalue *
+emit_XUNTAG (gcc_jit_rvalue *a, gcc_jit_type *type, Lisp_Word_tag lisp_word_tag)
+{
+ /* #define XUNTAG(a, type, ctype) ((ctype *)
+ ((char *) XLP (a) - LISP_WORD_TAG (type))) */
+ emit_comment ("XUNTAG");
+
+ return emit_coerce (
+ gcc_jit_type_get_pointer (type),
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_MINUS,
+ comp.uintptr_type,
+ emit_XLP (a),
+ emit_rvalue_from_lisp_word_tag (lisp_word_tag)));
+}
+
+static gcc_jit_rvalue *
+emit_XCONS (gcc_jit_rvalue *a)
+{
+ emit_comment ("XCONS");
+
+ return emit_XUNTAG (a,
+ gcc_jit_struct_as_type (comp.lisp_cons_s),
+ LISP_WORD_TAG (Lisp_Cons));
+}
+
+static gcc_jit_rvalue *
+emit_EQ (gcc_jit_rvalue *x, gcc_jit_rvalue *y)
+{
+ emit_comment ("EQ");
+
+ return gcc_jit_context_new_comparison (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_COMPARISON_EQ,
+ emit_XLI (x),
+ emit_XLI (y));
+}
+
+static gcc_jit_rvalue *
+emit_TAGGEDP (gcc_jit_rvalue *obj, Lisp_Word_tag tag)
+{
+ /* (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
+ - (unsigned) (tag)) \
+ & ((1 << GCTYPEBITS) - 1))) */
+ emit_comment ("TAGGEDP");
+
+ gcc_jit_rvalue *sh_res =
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_RSHIFT,
+ comp.emacs_int_type,
+ emit_XLI (obj),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.emacs_int_type,
+ (USE_LSB_TAG ? 0 : VALBITS)));
+
+ gcc_jit_rvalue *minus_res =
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_MINUS,
+ comp.unsigned_type,
+ sh_res,
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_type,
+ tag));
+
+ gcc_jit_rvalue *res =
+ gcc_jit_context_new_unary_op (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_UNARY_OP_LOGICAL_NEGATE,
+ comp.int_type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_BITWISE_AND,
+ comp.unsigned_type,
+ minus_res,
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_type,
+ ((1 << GCTYPEBITS) - 1))));
+
+ return res;
+}
+
+static gcc_jit_rvalue *
+emit_VECTORLIKEP (gcc_jit_rvalue *obj)
+{
+ emit_comment ("VECTORLIKEP");
+
+ return emit_TAGGEDP (obj, Lisp_Vectorlike);
+}
+
+static gcc_jit_rvalue *
+emit_CONSP (gcc_jit_rvalue *obj)
+{
+ emit_comment ("CONSP");
+
+ return emit_TAGGEDP (obj, Lisp_Cons);
+}
+
+static gcc_jit_rvalue *
+emit_FLOATP (gcc_jit_rvalue *obj)
+{
+ emit_comment ("FLOATP");
+
+ return emit_TAGGEDP (obj, Lisp_Float);
+}
+
+static gcc_jit_rvalue *
+emit_BIGNUMP (gcc_jit_rvalue *obj)
+{
+ /* PSEUDOVECTORP (x, PVEC_BIGNUM); */
+ emit_comment ("BIGNUMP");
+
+ gcc_jit_rvalue *args[] =
+ { obj,
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.int_type,
+ PVEC_BIGNUM) };
+
+ return gcc_jit_context_new_call (comp.ctxt,
+ NULL,
+ comp.pseudovectorp,
+ 2,
+ args);
+}
+
+static gcc_jit_rvalue *
+emit_FIXNUMP (gcc_jit_rvalue *obj)
+{
+ /* (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS))
+ - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG))
+ & ((1 << INTTYPEBITS) - 1))) */
+ emit_comment ("FIXNUMP");
+
+ gcc_jit_rvalue *sh_res =
+ USE_LSB_TAG ? obj
+ : emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT,
+ comp.emacs_int_type,
+ emit_XLI (obj),
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.emacs_int_type,
+ FIXNUM_BITS));
+
+ gcc_jit_rvalue *minus_res =
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_MINUS,
+ comp.unsigned_type,
+ sh_res,
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_type,
+ (Lisp_Int0 >> !USE_LSB_TAG)));
+
+ gcc_jit_rvalue *res =
+ gcc_jit_context_new_unary_op (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_UNARY_OP_LOGICAL_NEGATE,
+ comp.int_type,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_BITWISE_AND,
+ comp.unsigned_type,
+ minus_res,
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.unsigned_type,
+ ((1 << INTTYPEBITS) - 1))));
+
+ return res;
+}
+
+static gcc_jit_rvalue *
+emit_XFIXNUM (gcc_jit_rvalue *obj)
+{
+ emit_comment ("XFIXNUM");
+ gcc_jit_rvalue *i = emit_coerce (comp.emacs_uint_type, emit_XLI (obj));
+
+ /* FIXME: Implementation dependent (both RSHIFT are arithmetic). */
+
+ if (!USE_LSB_TAG)
+ {
+ i = emit_binary_op (GCC_JIT_BINARY_OP_LSHIFT,
+ comp.emacs_uint_type,
+ i,
+ comp.inttypebits);
+
+ return emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT,
+ comp.emacs_int_type,
+ i,
+ comp.inttypebits);
+ }
+ else
+ return emit_coerce (comp.emacs_int_type,
+ emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT,
+ comp.emacs_int_type,
+ i,
+ comp.inttypebits));
+}
+
+static gcc_jit_rvalue *
+emit_INTEGERP (gcc_jit_rvalue *obj)
+{
+ emit_comment ("INTEGERP");
+
+ return emit_binary_op (GCC_JIT_BINARY_OP_LOGICAL_OR,
+ comp.bool_type,
+ emit_FIXNUMP (obj),
+ emit_BIGNUMP (obj));
+}
+
+static gcc_jit_rvalue *
+emit_NUMBERP (gcc_jit_rvalue *obj)
+{
+ emit_comment ("NUMBERP");
+
+ return emit_binary_op (GCC_JIT_BINARY_OP_LOGICAL_OR,
+ comp.bool_type,
+ emit_INTEGERP (obj),
+ emit_FLOATP (obj));
+}
+
+static gcc_jit_rvalue *
+emit_make_fixnum_LSB_TAG (gcc_jit_rvalue *n)
+{
+ /*
+ EMACS_UINT u = n;
+ n = u << INTTYPEBITS;
+ n += int0;
+ */
+
+ gcc_jit_rvalue *tmp =
+ emit_binary_op (GCC_JIT_BINARY_OP_LSHIFT,
+ comp.emacs_int_type,
+ n, comp.inttypebits);
+
+ tmp = emit_binary_op (GCC_JIT_BINARY_OP_PLUS,
+ comp.emacs_int_type,
+ tmp, comp.lisp_int0);
+
+ return emit_coerce (comp.lisp_obj_type, tmp);
+}
+
+static gcc_jit_rvalue *
+emit_make_fixnum_MSB_TAG (gcc_jit_rvalue *n)
+{
+ /*
+ n &= INTMASK;
+ n += (int0 << VALBITS);
+ return XIL (n);
+ */
+
+ gcc_jit_rvalue *intmask = emit_rvalue_from_emacs_uint (INTMASK);
+
+ n = emit_binary_op (GCC_JIT_BINARY_OP_BITWISE_AND,
+ comp.emacs_uint_type,
+ intmask, n);
+
+ n =
+ emit_binary_op (GCC_JIT_BINARY_OP_PLUS,
+ comp.emacs_uint_type,
+ emit_binary_op (GCC_JIT_BINARY_OP_LSHIFT,
+ comp.emacs_uint_type,
+ comp.lisp_int0,
+ emit_rvalue_from_emacs_uint (VALBITS)),
+ n);
+
+ return emit_coerce (comp.lisp_obj_type, n);
+}
+
+
+static gcc_jit_rvalue *
+emit_make_fixnum (gcc_jit_rvalue *obj)
+{
+ emit_comment ("make_fixnum");
+ return USE_LSB_TAG
+ ? emit_make_fixnum_LSB_TAG (obj)
+ : emit_make_fixnum_MSB_TAG (obj);
+}
+
+static gcc_jit_lvalue *
+emit_lisp_obj_reloc_lval (Lisp_Object obj)
+{
+ emit_comment (format_string ("l-value for lisp obj: %s",
+ SSDATA (Fprin1_to_string (obj, Qnil))));
+
+ imm_reloc_t reloc = obj_to_reloc (obj);
+ return gcc_jit_context_new_array_access (comp.ctxt,
+ NULL,
+ reloc.array.r_val,
+ reloc.idx);
+}
+
+static gcc_jit_rvalue *
+emit_lisp_obj_rval (Lisp_Object obj)
+{
+ emit_comment (format_string ("const lisp obj: %s",
+ SSDATA (Fprin1_to_string (obj, Qnil))));
+
+ if (EQ (obj, Qnil))
+ {
+ gcc_jit_rvalue *n;
+ n = emit_rvalue_from_lisp_word ((Lisp_Word) iQnil);
+ return emit_coerce (comp.lisp_obj_type, n);
+ }
+
+ return gcc_jit_lvalue_as_rvalue (emit_lisp_obj_reloc_lval (obj));
+}
+
+static gcc_jit_rvalue *
+emit_NILP (gcc_jit_rvalue *x)
+{
+ emit_comment ("NILP");
+ return emit_EQ (x, emit_lisp_obj_rval (Qnil));
+}
+
+static gcc_jit_rvalue *
+emit_XCAR (gcc_jit_rvalue *c)
+{
+ emit_comment ("XCAR");
+
+ /* XCONS (c)->u.s.car */
+ return
+ gcc_jit_rvalue_access_field (
+ /* XCONS (c)->u.s */
+ gcc_jit_rvalue_access_field (
+ /* XCONS (c)->u */
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference_field (
+ emit_XCONS (c),
+ NULL,
+ comp.lisp_cons_u)),
+ NULL,
+ comp.lisp_cons_u_s),
+ NULL,
+ comp.lisp_cons_u_s_car);
+}
+
+static gcc_jit_lvalue *
+emit_lval_XCAR (gcc_jit_rvalue *c)
+{
+ emit_comment ("lval_XCAR");
+
+ /* XCONS (c)->u.s.car */
+ return
+ gcc_jit_lvalue_access_field (
+ /* XCONS (c)->u.s */
+ gcc_jit_lvalue_access_field (
+ /* XCONS (c)->u */
+ gcc_jit_rvalue_dereference_field (
+ emit_XCONS (c),
+ NULL,
+ comp.lisp_cons_u),
+ NULL,
+ comp.lisp_cons_u_s),
+ NULL,
+ comp.lisp_cons_u_s_car);
+}
+
+static gcc_jit_rvalue *
+emit_XCDR (gcc_jit_rvalue *c)
+{
+ emit_comment ("XCDR");
+ /* XCONS (c)->u.s.u.cdr */
+ return
+ gcc_jit_rvalue_access_field (
+ /* XCONS (c)->u.s.u */
+ gcc_jit_rvalue_access_field (
+ /* XCONS (c)->u.s */
+ gcc_jit_rvalue_access_field (
+ /* XCONS (c)->u */
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference_field (
+ emit_XCONS (c),
+ NULL,
+ comp.lisp_cons_u)),
+ NULL,
+ comp.lisp_cons_u_s),
+ NULL,
+ comp.lisp_cons_u_s_u),
+ NULL,
+ comp.lisp_cons_u_s_u_cdr);
+}
+
+static gcc_jit_lvalue *
+emit_lval_XCDR (gcc_jit_rvalue *c)
+{
+ emit_comment ("lval_XCDR");
+
+ /* XCONS (c)->u.s.u.cdr */
+ return
+ gcc_jit_lvalue_access_field (
+ /* XCONS (c)->u.s.u */
+ gcc_jit_lvalue_access_field (
+ /* XCONS (c)->u.s */
+ gcc_jit_lvalue_access_field (
+ /* XCONS (c)->u */
+ gcc_jit_rvalue_dereference_field (
+ emit_XCONS (c),
+ NULL,
+ comp.lisp_cons_u),
+ NULL,
+ comp.lisp_cons_u_s),
+ NULL,
+ comp.lisp_cons_u_s_u),
+ NULL,
+ comp.lisp_cons_u_s_u_cdr);
+}
+
+static void
+emit_CHECK_CONS (gcc_jit_rvalue *x)
+{
+ emit_comment ("CHECK_CONS");
+
+ gcc_jit_rvalue *args[] =
+ { emit_CONSP (x),
+ emit_lisp_obj_rval (Qconsp),
+ x };
+
+ gcc_jit_block_add_eval (
+ comp.block,
+ NULL,
+ gcc_jit_context_new_call (comp.ctxt,
+ NULL,
+ comp.check_type,
+ 3,
+ args));
+}
+
+static gcc_jit_rvalue *
+emit_car_addr (gcc_jit_rvalue *c)
+{
+ emit_comment ("car_addr");
+
+ return gcc_jit_lvalue_get_address (emit_lval_XCAR (c), NULL);
+}
+
+static gcc_jit_rvalue *
+emit_cdr_addr (gcc_jit_rvalue *c)
+{
+ emit_comment ("cdr_addr");
+
+ return gcc_jit_lvalue_get_address (emit_lval_XCDR (c), NULL);
+}
+
+static void
+emit_XSETCAR (gcc_jit_rvalue *c, gcc_jit_rvalue *n)
+{
+ emit_comment ("XSETCAR");
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ gcc_jit_rvalue_dereference (
+ emit_car_addr (c),
+ NULL),
+ n);
+}
+
+static void
+emit_XSETCDR (gcc_jit_rvalue *c, gcc_jit_rvalue *n)
+{
+ emit_comment ("XSETCDR");
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ gcc_jit_rvalue_dereference (
+ emit_cdr_addr (c),
+ NULL),
+ n);
+}
+
+static gcc_jit_rvalue *
+emit_PURE_P (gcc_jit_rvalue *ptr)
+{
+
+ emit_comment ("PURE_P");
+
+ return
+ gcc_jit_context_new_comparison (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_COMPARISON_LE,
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_MINUS,
+ comp.uintptr_type,
+ ptr,
+ comp.pure_ptr),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.uintptr_type,
+ PURESIZE));
+}
+
+
+/*************************************/
+/* Code emitted by LIMPLE statemes. */
+/*************************************/
+
+/* Emit an r-value from an mvar meta variable.
+ In case this is a constant that was propagated return it otherwise load it
+ from frame. */
+
+static gcc_jit_rvalue *
+emit_mvar_rval (Lisp_Object mvar)
+{
+ Lisp_Object const_vld = CALL1I (comp-cstr-imm-vld-p, mvar);
+
+ if (!NILP (const_vld))
+ {
+ Lisp_Object value = CALL1I (comp-cstr-imm, mvar);
+ if (comp.debug > 1)
+ {
+ Lisp_Object func =
+ Fgethash (value,
+ CALL1I (comp-ctxt-byte-func-to-func-h, Vcomp_ctxt),
+ Qnil);
+
+ emit_comment (
+ SSDATA (
+ Fprin1_to_string (
+ NILP (func) ? value : CALL1I (comp-func-c-name, func),
+ Qnil)));
+ }
+ if (FIXNUMP (value))
+ {
+ /* We can still emit directly objects that are self-contained in a
+ word (read fixnums). */
+ return emit_rvalue_from_lisp_obj (value);
+ }
+ /* Other const objects are fetched from the reloc array. */
+ return emit_lisp_obj_rval (value);
+ }
+
+ return gcc_jit_lvalue_as_rvalue (emit_mvar_lval (mvar));
+}
+
+static void
+emit_frame_assignment (Lisp_Object dst_mvar, gcc_jit_rvalue *val)
+{
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ emit_mvar_lval (dst_mvar),
+ val);
+}
+
+static gcc_jit_rvalue *
+emit_set_internal (Lisp_Object args)
+{
+ /*
+ Ex: (set_internal #s(comp-mvar nil nil t comp-test-up-val nil nil)
+ #s(comp-mvar 1 4 t nil symbol nil)).
+ */
+ /* TODO: Inline the most common case. */
+ if (list_length (args) != 3)
+ xsignal2 (Qnative_ice,
+ build_string ("unexpected arg length for insns"),
+ args);
+
+ args = XCDR (args);
+ int i = 0;
+ gcc_jit_rvalue *gcc_args[4];
+ FOR_EACH_TAIL (args)
+ gcc_args[i++] = emit_mvar_rval (XCAR (args));
+ gcc_args[2] = emit_lisp_obj_rval (Qnil);
+ gcc_args[3] = gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.int_type,
+ SET_INTERNAL_SET);
+ return emit_call (intern_c_string ("set_internal"), comp.void_type , 4,
+ gcc_args, false);
+}
+
+/* This is for a regular function with arguments as m-var. */
+
+static gcc_jit_rvalue *
+emit_simple_limple_call (Lisp_Object args, gcc_jit_type *ret_type, bool direct)
+{
+ USE_SAFE_ALLOCA;
+ int i = 0;
+ Lisp_Object callee = FIRST (args);
+ args = XCDR (args);
+ ptrdiff_t nargs = list_length (args);
+ gcc_jit_rvalue **gcc_args = SAFE_ALLOCA (nargs * sizeof (*gcc_args));
+ FOR_EACH_TAIL (args)
+ gcc_args[i++] = emit_mvar_rval (XCAR (args));
+
+ SAFE_FREE ();
+ return emit_call (callee, ret_type, nargs, gcc_args, direct);
+}
+
+static gcc_jit_rvalue *
+emit_simple_limple_call_lisp_ret (Lisp_Object args)
+{
+ /*
+ Ex: (call Fcons #s(comp-mvar 3 0 t 1 nil) #s(comp-mvar 4 nil t nil nil)).
+ */
+ return emit_simple_limple_call (args, comp.lisp_obj_type, false);
+}
+
+static gcc_jit_rvalue *
+emit_simple_limple_call_void_ret (Lisp_Object args)
+{
+ return emit_simple_limple_call (args, comp.void_type, false);
+}
+
+/* Entry point to dispatch emitting (call fun ...). */
+
+static gcc_jit_rvalue *
+emit_limple_call (Lisp_Object insn)
+{
+ Lisp_Object callee_sym = FIRST (insn);
+ Lisp_Object emitter = Fgethash (callee_sym, comp.emitter_dispatcher, Qnil);
+
+ if (!NILP (emitter))
+ {
+ gcc_jit_rvalue * (* emitter_ptr) (Lisp_Object) = xmint_pointer (emitter);
+ return emitter_ptr (insn);
+ }
+
+ return emit_simple_limple_call_lisp_ret (insn);
+}
+
+static gcc_jit_rvalue *
+emit_limple_call_ref (Lisp_Object insn, bool direct)
+{
+ /* Ex: (funcall #s(comp-mvar 1 5 t eql symbol t)
+ #s(comp-mvar 2 6 nil nil nil t)
+ #s(comp-mvar 3 7 t 0 fixnum t)). */
+ static int i = 0;
+ Lisp_Object callee = FIRST (insn);
+ EMACS_INT nargs = XFIXNUM (Flength (CDR (insn)));
+
+ if (!nargs)
+ return emit_call_ref (callee, 0, comp.frame[0], direct);
+
+ if (comp.func_has_non_local || !comp.func_speed)
+ {
+ /* FIXME: See bug#42360. */
+ Lisp_Object first_arg = SECOND (insn);
+ EMACS_INT first_slot = XFIXNUM (CALL1I (comp-mvar-slot, first_arg));
+ return emit_call_ref (callee, nargs, comp.frame[first_slot], direct);
+ }
+
+ gcc_jit_lvalue *tmp_arr =
+ gcc_jit_function_new_local (
+ comp.func,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ nargs),
+ format_string ("call_arr_%d", i++));
+
+ ptrdiff_t j = 0;
+ Lisp_Object arg = CDR (insn);
+ FOR_EACH_TAIL (arg)
+ {
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ gcc_jit_context_new_array_access (
+ comp.ctxt,
+ NULL,
+ gcc_jit_lvalue_as_rvalue (tmp_arr),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.int_type,
+ j)),
+ emit_mvar_rval (XCAR (arg)));
+ ++j;
+ }
+
+ return emit_call_ref (
+ callee,
+ nargs,
+ gcc_jit_context_new_array_access (comp.ctxt,
+ NULL,
+ gcc_jit_lvalue_as_rvalue (tmp_arr),
+ comp.zero),
+ direct);
+}
+
+static gcc_jit_rvalue *
+emit_setjmp (gcc_jit_rvalue *buf)
+{
+#ifndef WINDOWSNT
+ gcc_jit_rvalue *args[] = {buf};
+ gcc_jit_param *params[] =
+ {
+ gcc_jit_context_new_param (comp.ctxt, NULL, comp.void_ptr_type, "buf"),
+ };
+ /* Don't call setjmp through a function pointer (Bug#46824) */
+ gcc_jit_function *f =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_IMPORTED,
+ comp.int_type, STR (SETJMP_NAME),
+ ARRAYELTS (params), params,
+ false);
+
+ return gcc_jit_context_new_call (comp.ctxt, NULL, f, 1, args);
+#else
+ /* _setjmp (buf, __builtin_frame_address (0)) */
+ gcc_jit_param *params[] =
+ {
+ gcc_jit_context_new_param (comp.ctxt, NULL, comp.void_ptr_type, "buf"),
+ gcc_jit_context_new_param (comp.ctxt, NULL, comp.void_ptr_type, "frame"),
+ };
+ gcc_jit_rvalue *args[2];
+
+ args[0] =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt, comp.unsigned_type, 0);
+
+ args[1] =
+ gcc_jit_context_new_call (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_get_builtin_function (comp.ctxt,
+ "__builtin_frame_address"),
+ 1, args);
+ args[0] = buf;
+ gcc_jit_function *f =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_IMPORTED,
+ comp.int_type, STR (SETJMP_NAME),
+ ARRAYELTS (params), params,
+ false);
+
+ return gcc_jit_context_new_call (comp.ctxt, NULL, f, 2, args);
+#endif
+}
+
+/* Register an handler for a non local exit. */
+
+static void
+emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
+ gcc_jit_block *handler_bb, gcc_jit_block *guarded_bb,
+ Lisp_Object clobbered_mvar)
+{
+ /* struct handler *c = push_handler (POP, type); */
+
+ gcc_jit_rvalue *args[] = { handler, handler_type };
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ comp.loc_handler,
+ emit_call (intern_c_string ("push_handler"),
+ comp.handler_ptr_type, 2, args, false));
+
+ args[0] =
+ gcc_jit_lvalue_get_address (
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (comp.loc_handler),
+ NULL,
+ comp.handler_jmp_field),
+ NULL);
+
+ gcc_jit_rvalue *res;
+ res = emit_setjmp (args[0]);
+ emit_cond_jump (res, handler_bb, guarded_bb);
+}
+
+static void
+emit_limple_insn (Lisp_Object insn)
+{
+ Lisp_Object op = XCAR (insn);
+ Lisp_Object args = XCDR (insn);
+ gcc_jit_rvalue *res;
+ Lisp_Object arg[6];
+
+ Lisp_Object p = XCDR (insn);
+ ptrdiff_t i = 0;
+ FOR_EACH_TAIL (p)
+ {
+ if (i == sizeof (arg) / sizeof (Lisp_Object))
+ break;
+ arg[i++] = XCAR (p);
+ }
+
+ if (EQ (op, Qjump))
+ {
+ /* Unconditional branch. */
+ gcc_jit_block *target = retrive_block (arg[0]);
+ gcc_jit_block_end_with_jump (comp.block, NULL, target);
+ }
+ else if (EQ (op, Qcond_jump))
+ {
+ /* Conditional branch. */
+ gcc_jit_rvalue *a = emit_mvar_rval (arg[0]);
+ gcc_jit_rvalue *b = emit_mvar_rval (arg[1]);
+ gcc_jit_block *target1 = retrive_block (arg[2]);
+ gcc_jit_block *target2 = retrive_block (arg[3]);
+
+ emit_cond_jump (emit_EQ (a, b), target1, target2);
+ }
+ else if (EQ (op, Qcond_jump_narg_leq))
+ {
+ /*
+ Limple: (cond-jump-narg-less 2 entry_2 entry_fallback_2)
+ C: if (nargs < 2) goto entry2_fallback; else goto entry_2;
+ */
+ gcc_jit_lvalue *nargs =
+ gcc_jit_param_as_lvalue (gcc_jit_function_get_param (comp.func, 0));
+ eassert (XFIXNUM (arg[0]) < INT_MAX);
+ gcc_jit_rvalue *n =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.ptrdiff_type,
+ XFIXNUM (arg[0]));
+ gcc_jit_block *target1 = retrive_block (arg[1]);
+ gcc_jit_block *target2 = retrive_block (arg[2]);
+ gcc_jit_rvalue *test = gcc_jit_context_new_comparison (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_COMPARISON_LE,
+ gcc_jit_lvalue_as_rvalue (nargs),
+ n);
+ emit_cond_jump (test, target1, target2);
+ }
+ else if (EQ (op, Qphi) || EQ (op, Qassume))
+ {
+ /* Nothing to do for phis or assumes in the backend. */
+ }
+ else if (EQ (op, Qpush_handler))
+ {
+ /* (push-handler condition-case #s(comp-mvar 0 3 t (arith-error) cons nil) 1 bb_2 bb_1) */
+ int h_num UNINIT;
+ Lisp_Object handler_spec = arg[0];
+ gcc_jit_rvalue *handler = emit_mvar_rval (arg[1]);
+ if (EQ (handler_spec, Qcatcher))
+ h_num = CATCHER;
+ else if (EQ (handler_spec, Qcondition_case))
+ h_num = CONDITION_CASE;
+ else
+ xsignal2 (Qnative_ice, build_string ("incoherent insn"), insn);
+ gcc_jit_rvalue *handler_type =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.int_type,
+ h_num);
+ gcc_jit_block *handler_bb = retrive_block (arg[2]);
+ gcc_jit_block *guarded_bb = retrive_block (arg[3]);
+ emit_limple_push_handler (handler, handler_type, handler_bb, guarded_bb,
+ arg[0]);
+ }
+ else if (EQ (op, Qpop_handler))
+ {
+ /*
+ C: current_thread->m_handlerlist =
+ current_thread->m_handlerlist->next;
+ */
+ gcc_jit_lvalue *m_handlerlist =
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference (comp.current_thread_ref, NULL)),
+ NULL,
+ comp.m_handlerlist);
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ m_handlerlist,
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (m_handlerlist),
+ NULL,
+ comp.handler_next_field)));
+
+ }
+ else if (EQ (op, Qfetch_handler))
+ {
+ gcc_jit_lvalue *m_handlerlist =
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference (comp.current_thread_ref, NULL)),
+ NULL,
+ comp.m_handlerlist);
+ gcc_jit_block_add_assignment (comp.block,
+ NULL,
+ comp.loc_handler,
+ gcc_jit_lvalue_as_rvalue (m_handlerlist));
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ m_handlerlist,
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (comp.loc_handler),
+ NULL,
+ comp.handler_next_field)));
+ emit_frame_assignment (
+ arg[0],
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_rvalue_dereference_field (
+ gcc_jit_lvalue_as_rvalue (comp.loc_handler),
+ NULL,
+ comp.handler_val_field)));
+ }
+ else if (EQ (op, Qcall))
+ {
+ gcc_jit_block_add_eval (comp.block, NULL,
+ emit_limple_call (args));
+ }
+ else if (EQ (op, Qcallref))
+ {
+ gcc_jit_block_add_eval (comp.block, NULL,
+ emit_limple_call_ref (args, false));
+ }
+ else if (EQ (op, Qdirect_call))
+ {
+ gcc_jit_block_add_eval (
+ comp.block, NULL,
+ emit_simple_limple_call (XCDR (insn), comp.lisp_obj_type, true));
+ }
+ else if (EQ (op, Qdirect_callref))
+ {
+ gcc_jit_block_add_eval (comp.block, NULL,
+ emit_limple_call_ref (XCDR (insn), true));
+ }
+ else if (EQ (op, Qset))
+ {
+ Lisp_Object arg1 = arg[1];
+
+ if (EQ (Ftype_of (arg1), Qcomp_mvar))
+ res = emit_mvar_rval (arg1);
+ else if (EQ (FIRST (arg1), Qcall))
+ res = emit_limple_call (XCDR (arg1));
+ else if (EQ (FIRST (arg1), Qcallref))
+ res = emit_limple_call_ref (XCDR (arg1), false);
+ else if (EQ (FIRST (arg1), Qdirect_call))
+ res = emit_simple_limple_call (XCDR (arg1), comp.lisp_obj_type, true);
+ else if (EQ (FIRST (arg1), Qdirect_callref))
+ res = emit_limple_call_ref (XCDR (arg1), true);
+ else
+ xsignal2 (Qnative_ice,
+ build_string ("LIMPLE inconsistent arg1 for insn"),
+ insn);
+
+ if (!res)
+ xsignal1 (Qnative_ice,
+ build_string (gcc_jit_context_get_first_error (comp.ctxt)));
+
+ emit_frame_assignment (arg[0], res);
+ }
+ else if (EQ (op, Qset_par_to_local))
+ {
+ /* Ex: (set-par-to-local #s(comp-mvar 0 3 nil nil nil nil) 0). */
+ EMACS_INT param_n = XFIXNUM (arg[1]);
+ eassert (param_n < INT_MAX);
+ gcc_jit_rvalue *param =
+ gcc_jit_param_as_rvalue (gcc_jit_function_get_param (comp.func,
+ param_n));
+ emit_frame_assignment (arg[0], param);
+ }
+ else if (EQ (op, Qset_args_to_local))
+ {
+ /*
+ Ex: (set-args-to-local #s(comp-mvar 1 6 nil nil nil nil))
+ C: local[1] = *args;
+ */
+ gcc_jit_rvalue *gcc_args =
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_param_as_lvalue (gcc_jit_function_get_param (comp.func, 1)));
+
+ gcc_jit_rvalue *res =
+ gcc_jit_lvalue_as_rvalue (gcc_jit_rvalue_dereference (gcc_args, NULL));
+
+ emit_frame_assignment (arg[0], res);
+ }
+ else if (EQ (op, Qset_rest_args_to_local))
+ {
+ /*
+ Ex: (set-rest-args-to-local #s(comp-mvar 2 9 nil nil nil nil))
+ C: local[2] = list (nargs - 2, args);
+ */
+
+ EMACS_INT slot_n = XFIXNUM (CALL1I (comp-mvar-slot, arg[0]));
+ eassert (slot_n < INT_MAX);
+ gcc_jit_rvalue *n =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.ptrdiff_type,
+ slot_n);
+ gcc_jit_lvalue *nargs =
+ gcc_jit_param_as_lvalue (gcc_jit_function_get_param (comp.func, 0));
+ gcc_jit_lvalue *args =
+ gcc_jit_param_as_lvalue (gcc_jit_function_get_param (comp.func, 1));
+
+ gcc_jit_rvalue *list_args[] =
+ { emit_binary_op (GCC_JIT_BINARY_OP_MINUS,
+ comp.ptrdiff_type,
+ gcc_jit_lvalue_as_rvalue (nargs),
+ n),
+ gcc_jit_lvalue_as_rvalue (args) };
+
+ res = emit_call (Qlist, comp.lisp_obj_type, 2,
+ list_args, false);
+
+ emit_frame_assignment (arg[0], res);
+ }
+ else if (EQ (op, Qinc_args))
+ {
+ /*
+ Ex: (inc-args)
+ C: ++args;
+ */
+ gcc_jit_lvalue *args =
+ gcc_jit_param_as_lvalue (gcc_jit_function_get_param (comp.func, 1));
+
+ gcc_jit_block_add_assignment (comp.block,
+ NULL,
+ args,
+ emit_ptr_arithmetic (
+ gcc_jit_lvalue_as_rvalue (args),
+ comp.lisp_obj_ptr_type,
+ sizeof (Lisp_Object),
+ comp.one));
+ }
+ else if (EQ (op, Qsetimm))
+ {
+ /* Ex: (setimm #s(comp-mvar 9 1 t 3 nil) a). */
+ emit_comment (SSDATA (Fprin1_to_string (arg[1], Qnil)));
+ imm_reloc_t reloc = obj_to_reloc (arg[1]);
+ emit_frame_assignment (
+ arg[0],
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_context_new_array_access (comp.ctxt,
+ NULL,
+ reloc.array.r_val,
+ reloc.idx)));
+ }
+ else if (EQ (op, Qcomment))
+ {
+ /* Ex: (comment "Function: foo"). */
+ emit_comment (SSDATA (arg[0]));
+ }
+ else if (EQ (op, Qreturn))
+ {
+ gcc_jit_block_end_with_return (comp.block,
+ NULL,
+ emit_mvar_rval (arg[0]));
+ }
+ else if (EQ (op, Qunreachable))
+ {
+ /* Libgccjit has no __builtin_unreachable. */
+ gcc_jit_block_end_with_return (comp.block,
+ NULL,
+ emit_lisp_obj_rval (Qnil));
+ }
+ else
+ {
+ xsignal2 (Qnative_ice,
+ build_string ("LIMPLE op inconsistent"),
+ op);
+ }
+}
+
+
+/**************/
+/* Inliners. */
+/**************/
+
+static gcc_jit_rvalue *
+emit_call_with_type_hint (gcc_jit_function *func, Lisp_Object insn,
+ Lisp_Object type)
+{
+ bool hint_match =
+ !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
+ gcc_jit_rvalue *args[] =
+ { emit_mvar_rval (SECOND (insn)),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.bool_type,
+ hint_match) };
+
+ return gcc_jit_context_new_call (comp.ctxt, NULL, func, 2, args);
+}
+
+/* Same as before but with two args. The type hint is on the 2th. */
+static gcc_jit_rvalue *
+emit_call2_with_type_hint (gcc_jit_function *func, Lisp_Object insn,
+ Lisp_Object type)
+{
+ bool hint_match =
+ !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
+ gcc_jit_rvalue *args[] =
+ { emit_mvar_rval (SECOND (insn)),
+ emit_mvar_rval (THIRD (insn)),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.bool_type,
+ hint_match) };
+
+ return gcc_jit_context_new_call (comp.ctxt, NULL, func, 3, args);
+}
+
+
+static gcc_jit_rvalue *
+emit_add1 (Lisp_Object insn)
+{
+ return emit_call_with_type_hint (comp.add1, insn, Qfixnum);
+}
+
+static gcc_jit_rvalue *
+emit_sub1 (Lisp_Object insn)
+{
+ return emit_call_with_type_hint (comp.sub1, insn, Qfixnum);
+}
+
+static gcc_jit_rvalue *
+emit_negate (Lisp_Object insn)
+{
+ return emit_call_with_type_hint (comp.negate, insn, Qfixnum);
+}
+
+static gcc_jit_rvalue *
+emit_consp (Lisp_Object insn)
+{
+ gcc_jit_rvalue *x = emit_mvar_rval (SECOND (insn));
+ gcc_jit_rvalue *res = emit_coerce (comp.bool_type,
+ emit_CONSP (x));
+ return gcc_jit_context_new_call (comp.ctxt,
+ NULL,
+ comp.bool_to_lisp_obj,
+ 1, &res);
+}
+
+static gcc_jit_rvalue *
+emit_car (Lisp_Object insn)
+{
+ return emit_call_with_type_hint (comp.car, insn, Qcons);
+}
+
+static gcc_jit_rvalue *
+emit_cdr (Lisp_Object insn)
+{
+ return emit_call_with_type_hint (comp.cdr, insn, Qcons);
+}
+
+static gcc_jit_rvalue *
+emit_setcar (Lisp_Object insn)
+{
+ return emit_call2_with_type_hint (comp.setcar, insn, Qcons);
+}
+
+static gcc_jit_rvalue *
+emit_setcdr (Lisp_Object insn)
+{
+ return emit_call2_with_type_hint (comp.setcdr, insn, Qcons);
+}
+
+static gcc_jit_rvalue *
+emit_numperp (Lisp_Object insn)
+{
+ gcc_jit_rvalue *x = emit_mvar_rval (SECOND (insn));
+ gcc_jit_rvalue *res = emit_NUMBERP (x);
+ return gcc_jit_context_new_call (comp.ctxt, NULL, comp.bool_to_lisp_obj, 1,
+ &res);
+}
+
+static gcc_jit_rvalue *
+emit_integerp (Lisp_Object insn)
+{
+ gcc_jit_rvalue *x = emit_mvar_rval (SECOND (insn));
+ gcc_jit_rvalue *res = emit_INTEGERP (x);
+ return gcc_jit_context_new_call (comp.ctxt, NULL, comp.bool_to_lisp_obj, 1,
+ &res);
+}
+
+static gcc_jit_rvalue *
+emit_maybe_gc_or_quit (Lisp_Object insn)
+{
+ return gcc_jit_context_new_call (comp.ctxt, NULL, comp.maybe_gc_or_quit, 0,
+ NULL);
+}
+
+/* This is in charge of serializing an object and export a function to
+ retrieve it at load time. */
+#pragma GCC diagnostic ignored "-Waddress"
+static void
+emit_static_object (const char *name, Lisp_Object obj)
+{
+ /* libgccjit has no support for initialized static data.
+ The mechanism below is certainly not aesthetic but I assume the bottle neck
+ in terms of performance at load time will still be the reader.
+ NOTE: we can not rely on libgccjit even for valid NULL terminated C
+ strings cause of this funny bug that will affect all pre gcc10 era gccs:
+ https://gcc.gnu.org/ml/jit/2019-q3/msg00013.html */
+
+ ptrdiff_t count = SPECPDL_INDEX ();
+ /* Preserve uninterned symbols, this is specifically necessary for
+ CL macro expansion in dynamic scope code (bug#42088). See
+ `byte-compile-output-file-form'. */
+ specbind (intern_c_string ("print-escape-newlines"), Qt);
+ specbind (intern_c_string ("print-length"), Qnil);
+ specbind (intern_c_string ("print-level"), Qnil);
+ specbind (intern_c_string ("print-quoted"), Qt);
+ specbind (intern_c_string ("print-gensym"), Qt);
+ specbind (intern_c_string ("print-circle"), Qt);
+ Lisp_Object str = Fprin1_to_string (obj, Qnil);
+ unbind_to (count, Qnil);
+
+ ptrdiff_t len = SBYTES (str);
+ const char *p = SSDATA (str);
+
+#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) \
+ || defined (WINDOWSNT)
+ if (gcc_jit_global_set_initializer)
+ {
+ ptrdiff_t str_size = len + 1;
+ ptrdiff_t size = sizeof (static_obj_t) + str_size;
+ static_obj_t *static_obj = xmalloc (size);
+ static_obj->len = str_size;
+ memcpy (static_obj->data, p, str_size);
+ gcc_jit_lvalue *blob =
+ gcc_jit_context_new_global (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_EXPORTED,
+ gcc_jit_context_new_array_type (comp.ctxt, NULL,
+ comp.char_type,
+ size),
+ format_string ("%s_blob", name));
+ gcc_jit_global_set_initializer (blob, static_obj, size);
+ xfree (static_obj);
+
+ return;
+ }
+#endif
+
+ gcc_jit_type *a_type =
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ len + 1);
+ gcc_jit_field *fields[] =
+ { gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.ptrdiff_type,
+ "len"),
+ gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ a_type,
+ "data") };
+
+ gcc_jit_type *data_struct_t =
+ gcc_jit_struct_as_type (
+ gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ format_string ("%s_struct", name),
+ ARRAYELTS (fields), fields));
+
+ gcc_jit_lvalue *data_struct =
+ gcc_jit_context_new_global (comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_INTERNAL,
+ data_struct_t,
+ format_string ("%s_s", name));
+
+ gcc_jit_function *f =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_EXPORTED,
+ gcc_jit_type_get_pointer (data_struct_t),
+ name,
+ 0, NULL, 0);
+ DECL_BLOCK (block, f);
+
+ if (comp.debug > 1)
+ {
+ char *comment = memcpy (xmalloc (len), p, len);
+ for (ptrdiff_t i = 0; i < len - 1; i++)
+ if (!comment[i])
+ comment[i] = '\n';
+ gcc_jit_block_add_comment (block, NULL, comment);
+ xfree (comment);
+ }
+
+ gcc_jit_lvalue *arr =
+ gcc_jit_lvalue_access_field (data_struct, NULL, fields[1]);
+
+ gcc_jit_lvalue *ptrvar = gcc_jit_function_new_local (f, NULL,
+ comp.char_ptr_type,
+ "ptr");
+
+ gcc_jit_block_add_assignment (
+ block,
+ NULL,
+ ptrvar,
+ gcc_jit_lvalue_get_address (
+ gcc_jit_context_new_array_access (
+ comp.ctxt,
+ NULL,
+ gcc_jit_lvalue_as_rvalue (arr),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt, comp.int_type, 0)),
+ NULL));
+
+ /* We can't use always string literals longer that 200 bytes because
+ they cause a crash in pre GCC 10 libgccjit.
+ <https://gcc.gnu.org/ml/jit/2019-q3/msg00013.html>.
+
+ Adjust if possible to reduce the number of function calls. */
+ size_t chunck_size = NILP (Fcomp_libgccjit_version ()) ? 200 : 1024;
+ char *buff = xmalloc (chunck_size);
+ for (ptrdiff_t i = 0; i < len;)
+ {
+ strncpy (buff, p, chunck_size);
+ buff[chunck_size - 1] = 0;
+ uintptr_t l = strlen (buff);
+
+ if (l != 0)
+ {
+ p += l;
+ i += l;
+
+ gcc_jit_rvalue *args[] =
+ { gcc_jit_lvalue_as_rvalue (ptrvar),
+ gcc_jit_context_new_string_literal (comp.ctxt, buff),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.size_t_type,
+ l) };
+
+ gcc_jit_block_add_eval (block, NULL,
+ gcc_jit_context_new_call (comp.ctxt, NULL,
+ comp.memcpy,
+ ARRAYELTS (args),
+ args));
+ gcc_jit_block_add_assignment (block, NULL, ptrvar,
+ gcc_jit_lvalue_get_address (
+ gcc_jit_context_new_array_access (comp.ctxt, NULL,
+ gcc_jit_lvalue_as_rvalue (ptrvar),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.uintptr_type,
+ l)),
+ NULL));
+ }
+ else
+ {
+ /* If strlen returned 0 that means that the static object
+ contains a NULL byte. In that case just move over to the
+ next block. We can rely on the byte being zero because
+ of the previous call to bzero and because the dynamic
+ linker cleared it. */
+ p++;
+ i++;
+ gcc_jit_block_add_assignment (
+ block, NULL, ptrvar,
+ gcc_jit_lvalue_get_address (
+ gcc_jit_context_new_array_access (
+ comp.ctxt, NULL, gcc_jit_lvalue_as_rvalue (ptrvar),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.uintptr_type, 1)),
+ NULL));
+ }
+ }
+ xfree (buff);
+
+ gcc_jit_block_add_assignment (
+ block,
+ NULL,
+ gcc_jit_lvalue_access_field (data_struct, NULL, fields[0]),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.ptrdiff_type,
+ len));
+ gcc_jit_rvalue *res = gcc_jit_lvalue_get_address (data_struct, NULL);
+ gcc_jit_block_end_with_return (block, NULL, res);
+}
+#pragma GCC diagnostic pop
+
+static reloc_array_t
+declare_imported_data_relocs (Lisp_Object container, const char *code_symbol,
+ const char *text_symbol)
+{
+ /* Imported objects. */
+ reloc_array_t res;
+ res.len =
+ XFIXNUM (CALL1I (hash-table-count,
+ CALL1I (comp-data-container-idx, container)));
+ Lisp_Object d_reloc = CALL1I (comp-data-container-l, container);
+ d_reloc = Fvconcat (1, &d_reloc);
+
+ res.r_val =
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_context_new_global (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_EXPORTED,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ res.len),
+ code_symbol));
+
+ emit_static_object (text_symbol, d_reloc);
+
+ return res;
+}
+
+static void
+declare_imported_data (void)
+{
+ /* Imported objects. */
+ comp.data_relocs =
+ declare_imported_data_relocs (CALL1I (comp-ctxt-d-default, Vcomp_ctxt),
+ DATA_RELOC_SYM,
+ TEXT_DATA_RELOC_SYM);
+ comp.data_relocs_impure =
+ declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt),
+ DATA_RELOC_IMPURE_SYM,
+ TEXT_DATA_RELOC_IMPURE_SYM);
+ comp.data_relocs_ephemeral =
+ declare_imported_data_relocs (CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt),
+ DATA_RELOC_EPHEMERAL_SYM,
+ TEXT_DATA_RELOC_EPHEMERAL_SYM);
+}
+
+/*
+ Declare as imported all the functions that are requested from the runtime.
+ These are either subrs or not.
+*/
+static Lisp_Object
+declare_runtime_imported_funcs (void)
+{
+ Lisp_Object field_list = Qnil;
+
+#define ADD_IMPORTED(f_name, ret_type, nargs, args) \
+ do { \
+ Lisp_Object name = intern_c_string (STR (f_name)); \
+ Lisp_Object field = \
+ make_mint_ptr (declare_imported_func (name, ret_type, nargs, args)); \
+ Lisp_Object el = Fcons (name, field); \
+ field_list = Fcons (el, field_list); \
+ } while (0)
+
+ gcc_jit_type *args[4];
+
+ ADD_IMPORTED (wrong_type_argument, comp.void_type, 2, NULL);
+
+ args[0] = comp.lisp_obj_type;
+ args[1] = comp.int_type;
+ ADD_IMPORTED (helper_PSEUDOVECTOR_TYPEP_XUNTAG, comp.bool_type, 2, args);
+
+ ADD_IMPORTED (pure_write_error, comp.void_type, 1, NULL);
+
+ args[0] = comp.lisp_obj_type;
+ args[1] = comp.int_type;
+ ADD_IMPORTED (push_handler, comp.handler_ptr_type, 2, args);
+
+ ADD_IMPORTED (record_unwind_protect_excursion, comp.void_type, 0, NULL);
+
+ args[0] = comp.lisp_obj_type;
+ ADD_IMPORTED (helper_unbind_n, comp.lisp_obj_type, 1, args);
+
+ ADD_IMPORTED (helper_save_restriction, comp.void_type, 0, NULL);
+
+ ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL);
+
+ args[0] = args[1] = args[2] = comp.lisp_obj_type;
+ args[3] = comp.int_type;
+ ADD_IMPORTED (set_internal, comp.void_type, 4, args);
+
+ args[0] = comp.lisp_obj_type;
+ ADD_IMPORTED (helper_unwind_protect, comp.void_type, 1, args);
+
+ args[0] = args[1] = comp.lisp_obj_type;
+ ADD_IMPORTED (specbind, comp.void_type, 2, args);
+
+ ADD_IMPORTED (maybe_gc, comp.void_type, 0, NULL);
+
+ ADD_IMPORTED (maybe_quit, comp.void_type, 0, NULL);
+
+#undef ADD_IMPORTED
+
+ return Freverse (field_list);
+}
+
+/*
+ This emit the code needed by every compilation unit to be loaded.
+*/
+static void
+emit_ctxt_code (void)
+{
+ /* Emit optimize qualities. */
+ Lisp_Object opt_qly[] =
+ { Fcons (Qnative_comp_speed, make_fixnum (comp.speed)),
+ Fcons (Qnative_comp_debug, make_fixnum (comp.debug)),
+ Fcons (Qgccjit,
+ Fcomp_libgccjit_version ()) };
+ emit_static_object (TEXT_OPTIM_QLY_SYM, Flist (ARRAYELTS (opt_qly), opt_qly));
+
+ emit_static_object (TEXT_FDOC_SYM,
+ CALL1I (comp-ctxt-function-docs, Vcomp_ctxt));
+
+ comp.current_thread_ref =
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_context_new_global (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_EXPORTED,
+ gcc_jit_type_get_pointer (comp.thread_state_ptr_type),
+ CURRENT_THREAD_RELOC_SYM));
+
+ comp.pure_ptr =
+ gcc_jit_lvalue_as_rvalue (
+ gcc_jit_context_new_global (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_EXPORTED,
+ comp.void_ptr_type,
+ PURE_RELOC_SYM));
+
+ gcc_jit_context_new_global (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_EXPORTED,
+ comp.lisp_obj_type,
+ COMP_UNIT_SYM);
+
+ declare_imported_data ();
+
+ /* Functions imported from Lisp code. */
+ freloc_check_fill ();
+ gcc_jit_field **fields = xmalloc (freloc.size * sizeof (*fields));
+ ptrdiff_t n_frelocs = 0;
+ Lisp_Object f_runtime = declare_runtime_imported_funcs ();
+ FOR_EACH_TAIL (f_runtime)
+ {
+ Lisp_Object el = XCAR (f_runtime);
+ eassert (n_frelocs < freloc.size);
+ fields[n_frelocs++] = xmint_pointer (XCDR (el));
+ }
+
+ /* Sign the .eln for the exposed ABI it expects at load. */
+ eassert (!NILP (Vcomp_abi_hash));
+ emit_static_object (LINK_TABLE_HASH_SYM, Vcomp_abi_hash);
+
+ Lisp_Object subr_l = Vcomp_subr_list;
+ FOR_EACH_TAIL (subr_l)
+ {
+ struct Lisp_Subr *subr = XSUBR (XCAR (subr_l));
+ Lisp_Object subr_sym = intern_c_string (subr->symbol_name);
+ eassert (n_frelocs < freloc.size);
+ fields[n_frelocs++] = declare_imported_func (subr_sym, comp.lisp_obj_type,
+ subr->max_args, NULL);
+ }
+
+ gcc_jit_struct *f_reloc_struct =
+ gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ "freloc_link_table",
+ n_frelocs, fields);
+ comp.func_relocs_ptr_type =
+ gcc_jit_type_get_pointer (
+ gcc_jit_struct_as_type (f_reloc_struct));
+
+ comp.func_relocs =
+ gcc_jit_context_new_global (comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_EXPORTED,
+ comp.func_relocs_ptr_type,
+ FUNC_LINK_TABLE_SYM);
+
+ xfree (fields);
+}
+
+
+/****************************************************************/
+/* Inline function definition and lisp data structure follows. */
+/****************************************************************/
+
+/* struct Lisp_Cons definition. */
+
+static void
+define_lisp_cons (void)
+{
+ /*
+ union cdr_u
+ {
+ Lisp_Object cdr;
+ struct Lisp_Cons *chain;
+ };
+
+ struct cons_s
+ {
+ Lisp_Object car;
+ union cdr_u u;
+ };
+
+ union cons_u
+ {
+ struct cons_s s;
+ char align_pad[sizeof (struct Lisp_Cons)];
+ };
+
+ struct Lisp_Cons
+ {
+ union cons_u u;
+ };
+ */
+
+ comp.lisp_cons_s =
+ gcc_jit_context_new_opaque_struct (comp.ctxt,
+ NULL,
+ "comp_Lisp_Cons");
+ comp.lisp_cons_type =
+ gcc_jit_struct_as_type (comp.lisp_cons_s);
+ comp.lisp_cons_ptr_type =
+ gcc_jit_type_get_pointer (comp.lisp_cons_type);
+
+ comp.lisp_cons_u_s_u_cdr =
+ gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "cdr");
+
+ gcc_jit_field *cdr_u_fields[] =
+ { comp.lisp_cons_u_s_u_cdr,
+ gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_cons_ptr_type,
+ "chain") };
+
+ gcc_jit_type *cdr_u =
+ gcc_jit_context_new_union_type (comp.ctxt,
+ NULL,
+ "comp_cdr_u",
+ ARRAYELTS (cdr_u_fields),
+ cdr_u_fields);
+
+ comp.lisp_cons_u_s_car = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "car");
+ comp.lisp_cons_u_s_u = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ cdr_u,
+ "u");
+ gcc_jit_field *cons_s_fields[] =
+ { comp.lisp_cons_u_s_car,
+ comp.lisp_cons_u_s_u };
+
+ gcc_jit_struct *cons_s =
+ gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ "comp_cons_s",
+ ARRAYELTS (cons_s_fields),
+ cons_s_fields);
+
+ comp.lisp_cons_u_s = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ gcc_jit_struct_as_type (cons_s),
+ "s");
+
+ gcc_jit_field *cons_u_fields[] =
+ { comp.lisp_cons_u_s,
+ gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ sizeof (struct Lisp_Cons)),
+ "align_pad") };
+
+ gcc_jit_type *lisp_cons_u_type =
+ gcc_jit_context_new_union_type (comp.ctxt,
+ NULL,
+ "comp_cons_u",
+ ARRAYELTS (cons_u_fields),
+ cons_u_fields);
+
+ comp.lisp_cons_u =
+ gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ lisp_cons_u_type,
+ "u");
+ gcc_jit_struct_set_fields (comp.lisp_cons_s,
+ NULL, 1, &comp.lisp_cons_u);
+
+}
+
+/* Opaque jmp_buf definition. */
+
+static void
+define_jmp_buf (void)
+{
+ gcc_jit_field *field =
+ gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ sizeof (sys_jmp_buf)),
+ "stuff");
+ comp.jmp_buf_s =
+ gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ "comp_jmp_buf",
+ 1, &field);
+}
+
+static void
+define_memcpy (void)
+{
+
+ gcc_jit_param *params[] =
+ { gcc_jit_context_new_param (comp.ctxt, NULL, comp.void_ptr_type, "dest"),
+ gcc_jit_context_new_param (comp.ctxt, NULL, comp.void_ptr_type, "src"),
+ gcc_jit_context_new_param (comp.ctxt, NULL, comp.size_t_type, "n") };
+
+ comp.memcpy =
+ gcc_jit_context_new_function (comp.ctxt, NULL, GCC_JIT_FUNCTION_IMPORTED,
+ comp.void_ptr_type, "memcpy",
+ ARRAYELTS (params), params, false);
+}
+
+/* struct handler definition */
+
+static void
+define_handler_struct (void)
+{
+ comp.handler_s =
+ gcc_jit_context_new_opaque_struct (comp.ctxt, NULL, "comp_handler");
+ comp.handler_ptr_type =
+ gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.handler_s));
+
+ comp.handler_jmp_field = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ gcc_jit_struct_as_type (
+ comp.jmp_buf_s),
+ "jmp");
+ comp.handler_val_field = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "val");
+ comp.handler_next_field = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.handler_ptr_type,
+ "next");
+ gcc_jit_field *fields[] =
+ { gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ offsetof (struct handler, val)),
+ "pad0"),
+ comp.handler_val_field,
+ comp.handler_next_field,
+ gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ offsetof (struct handler, jmp)
+ - offsetof (struct handler, next)
+ - sizeof (((struct handler *) 0)->next)),
+ "pad1"),
+ comp.handler_jmp_field,
+ gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ sizeof (struct handler)
+ - offsetof (struct handler, jmp)
+ - sizeof (((struct handler *) 0)->jmp)),
+ "pad2") };
+ gcc_jit_struct_set_fields (comp.handler_s,
+ NULL,
+ ARRAYELTS (fields),
+ fields);
+
+}
+
+static void
+define_thread_state_struct (void)
+{
+ /* Partially opaque definition for `thread_state'.
+ Because we need to access just m_handlerlist hopefully this is requires
+ less manutention then the full deifnition. */
+
+ comp.m_handlerlist = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.handler_ptr_type,
+ "m_handlerlist");
+ gcc_jit_field *fields[] =
+ { gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.char_type,
+ offsetof (struct thread_state,
+ m_handlerlist)),
+ "pad0"),
+ comp.m_handlerlist,
+ gcc_jit_context_new_field (
+ comp.ctxt,
+ NULL,
+ gcc_jit_context_new_array_type (
+ comp.ctxt,
+ NULL,
+ comp.char_type,
+ sizeof (struct thread_state)
+ - offsetof (struct thread_state,
+ m_handlerlist)
+ - sizeof (((struct thread_state *) 0)->m_handlerlist)),
+ "pad1") };
+
+ comp.thread_state_s =
+ gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ "comp_thread_state",
+ ARRAYELTS (fields),
+ fields);
+ comp.thread_state_ptr_type =
+ gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.thread_state_s));
+}
+
+struct cast_type
+{
+ gcc_jit_type *type;
+ const char *name;
+ size_t bytes_size;
+ enum cast_kind_of_type kind;
+};
+
+static gcc_jit_function *
+define_cast_from_to (struct cast_type from, int from_index, struct cast_type to,
+ int to_index)
+{
+ /* FIXME: sign extension not implemented. */
+ if (comp.cast_type_sizes[from_index] < comp.cast_type_sizes[to_index]
+ && comp.cast_type_kind[to_index] == kind_signed)
+ return NULL;
+
+ char *name = format_string ("cast_from_%s_to_%s", from.name, to.name);
+ gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL,
+ from.type, "arg");
+ gcc_jit_function *result = gcc_jit_context_new_function (comp.ctxt,
+ NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ to.type,
+ name,
+ 1,
+ &param,
+ 0);
+
+ DECL_BLOCK (entry_block, result);
+
+ gcc_jit_lvalue *tmp_union
+ = gcc_jit_function_new_local (result,
+ NULL,
+ comp.cast_union_type,
+ "union_cast");
+
+ /* Zero the union first. */
+ gcc_jit_block_add_assignment (entry_block, NULL,
+ gcc_jit_lvalue_access_field (tmp_union, NULL,
+ comp.cast_union_fields[NUM_CAST_TYPES]),
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.cast_types[NUM_CAST_TYPES],
+ 0));
+
+ gcc_jit_block_add_assignment (entry_block, NULL,
+ gcc_jit_lvalue_access_field (tmp_union, NULL,
+ comp.cast_union_fields[from_index]),
+ gcc_jit_param_as_rvalue (param));
+
+ gcc_jit_block_end_with_return (entry_block,
+ NULL,
+ gcc_jit_rvalue_access_field (
+ gcc_jit_lvalue_as_rvalue (tmp_union),
+ NULL,
+ comp.cast_union_fields[to_index]));
+
+ return result;
+}
+
+static void
+define_cast_functions (void)
+{
+ struct cast_type cast_types[NUM_CAST_TYPES]
+ = { { comp.bool_type, "bool", sizeof (bool), kind_unsigned },
+ { comp.char_ptr_type, "char_ptr", sizeof (char *), kind_pointer },
+ { comp.int_type, "int", sizeof (int), kind_signed },
+ { comp.lisp_cons_ptr_type, "cons_ptr", sizeof (struct Lisp_Cons *),
+ kind_pointer },
+ { comp.lisp_obj_ptr_type, "lisp_obj_ptr", sizeof (Lisp_Object *),
+ kind_pointer },
+ { comp.lisp_word_tag_type, "lisp_word_tag", sizeof (Lisp_Word_tag),
+ kind_unsigned },
+ { comp.lisp_word_type, "lisp_word", sizeof (Lisp_Word),
+ LISP_WORDS_ARE_POINTERS ? kind_pointer : kind_signed },
+ { comp.long_long_type, "long_long", sizeof (long long), kind_signed },
+ { comp.long_type, "long", sizeof (long), kind_signed },
+ { comp.ptrdiff_type, "ptrdiff", sizeof (ptrdiff_t), kind_signed },
+ { comp.uintptr_type, "uintptr", sizeof (uintptr_t), kind_unsigned },
+ { comp.unsigned_long_long_type, "unsigned_long_long",
+ sizeof (unsigned long long), kind_unsigned },
+ { comp.unsigned_long_type, "unsigned_long", sizeof (unsigned long),
+ kind_unsigned },
+ { comp.unsigned_type, "unsigned", sizeof (unsigned), kind_unsigned },
+ { comp.void_ptr_type, "void_ptr", sizeof (void*), kind_pointer } };
+
+ /* Find the biggest size. It should be unsigned long long, but to be
+ sure we find it programmatically. */
+ size_t biggest_size = 0;
+ for (int i = 0; i < NUM_CAST_TYPES; ++i)
+ biggest_size = max (biggest_size, cast_types[i].bytes_size);
+
+ /* Define the union used for casting. */
+ for (int i = 0; i < NUM_CAST_TYPES; ++i)
+ {
+ comp.cast_types[i] = cast_types[i].type;
+ comp.cast_union_fields[i] = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ cast_types[i].type,
+ cast_types[i].name);
+ comp.cast_type_names[i] = cast_types[i].name;
+ comp.cast_type_sizes[i] = cast_types[i].bytes_size;
+ comp.cast_type_kind[i] = cast_types[i].kind;
+ }
+
+ gcc_jit_type *biggest_type = gcc_jit_context_get_int_type (comp.ctxt,
+ biggest_size,
+ false);
+ comp.cast_types[NUM_CAST_TYPES] = biggest_type;
+ comp.cast_union_fields[NUM_CAST_TYPES] =
+ gcc_jit_context_new_field (comp.ctxt, NULL, biggest_type, "biggest_type");
+ comp.cast_type_names[NUM_CAST_TYPES] = "biggest_type";
+ comp.cast_type_sizes[NUM_CAST_TYPES] = biggest_size;
+ comp.cast_type_kind[NUM_CAST_TYPES] = kind_unsigned;
+
+ comp.cast_union_type =
+ gcc_jit_context_new_union_type (comp.ctxt,
+ NULL,
+ "cast_union",
+ NUM_CAST_TYPES + 1,
+ comp.cast_union_fields);
+
+ /* Define the cast functions using a matrix. */
+ for (int i = 0; i < NUM_CAST_TYPES; ++i)
+ for (int j = 0; j < NUM_CAST_TYPES; ++j)
+ comp.cast_functions_from_to[i][j] =
+ define_cast_from_to (cast_types[i], i, cast_types[j], j);
+}
+
+static void
+define_CHECK_TYPE (void)
+{
+ gcc_jit_param *param[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.int_type,
+ "ok"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "predicate"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "x") };
+ comp.check_type =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.void_type,
+ "CHECK_TYPE",
+ 3,
+ param,
+ 0);
+ gcc_jit_rvalue *ok = gcc_jit_param_as_rvalue (param[0]);
+ gcc_jit_rvalue *predicate = gcc_jit_param_as_rvalue (param[1]);
+ gcc_jit_rvalue *x = gcc_jit_param_as_rvalue (param[2]);
+
+ DECL_BLOCK (entry_block, comp.check_type);
+ DECL_BLOCK (ok_block, comp.check_type);
+ DECL_BLOCK (not_ok_block, comp.check_type);
+
+ comp.block = entry_block;
+ comp.func = comp.check_type;
+
+ emit_cond_jump (ok, ok_block, not_ok_block);
+
+ gcc_jit_block_end_with_void_return (ok_block, NULL);
+
+ comp.block = not_ok_block;
+
+ gcc_jit_rvalue *wrong_type_args[] = { predicate, x };
+
+ gcc_jit_block_add_eval (comp.block,
+ NULL,
+ emit_call (intern_c_string ("wrong_type_argument"),
+ comp.void_type, 2, wrong_type_args,
+ false));
+
+ gcc_jit_block_end_with_void_return (not_ok_block, NULL);
+}
+
+/* Define a substitute for CAR as always inlined function. */
+
+static void
+define_CAR_CDR (void)
+{
+ gcc_jit_function *func[2];
+ char const *f_name[] = { "CAR", "CDR" };
+ for (int i = 0; i < 2; i++)
+ {
+ gcc_jit_param *param[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "c"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.bool_type,
+ "cert_cons") };
+ /* TODO: understand why after ipa-prop pass gcc is less keen on inlining
+ and as consequence can refuse to compile these. (see dhrystone.el)
+ Flag this and all the one involved in ipa-prop as
+ GCC_JIT_FUNCTION_INTERNAL not to fail compilation in case.
+ This seems at least to have no perf downside. */
+ func[i] =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.lisp_obj_type,
+ f_name[i],
+ 2, param, 0);
+
+ gcc_jit_rvalue *c = gcc_jit_param_as_rvalue (param[0]);
+ DECL_BLOCK (entry_block, func[i]);
+ DECL_BLOCK (is_cons_b, func[i]);
+ DECL_BLOCK (not_a_cons_b, func[i]);
+ comp.block = entry_block;
+ comp.func = func[i];
+ emit_cond_jump (emit_binary_op (GCC_JIT_BINARY_OP_LOGICAL_OR,
+ comp.bool_type,
+ gcc_jit_param_as_rvalue (param[1]),
+ emit_CONSP (c)),
+ is_cons_b,
+ not_a_cons_b);
+ comp.block = is_cons_b;
+ if (i == 0)
+ gcc_jit_block_end_with_return (comp.block, NULL, emit_XCAR (c));
+ else
+ gcc_jit_block_end_with_return (comp.block, NULL, emit_XCDR (c));
+
+ comp.block = not_a_cons_b;
+
+ DECL_BLOCK (is_nil_b, func[i]);
+ DECL_BLOCK (not_nil_b, func[i]);
+
+ emit_cond_jump (emit_NILP (c), is_nil_b, not_nil_b);
+
+ comp.block = is_nil_b;
+ gcc_jit_block_end_with_return (comp.block,
+ NULL,
+ emit_lisp_obj_rval (Qnil));
+
+ comp.block = not_nil_b;
+ gcc_jit_rvalue *wrong_type_args[] =
+ { emit_lisp_obj_rval (Qlistp), c };
+
+ gcc_jit_block_add_eval (comp.block,
+ NULL,
+ emit_call (intern_c_string ("wrong_type_argument"),
+ comp.void_type, 2, wrong_type_args,
+ false));
+ gcc_jit_block_end_with_return (comp.block,
+ NULL,
+ emit_lisp_obj_rval (Qnil));
+ }
+ comp.car = func[0];
+ comp.cdr = func[1];
+}
+
+static void
+define_setcar_setcdr (void)
+{
+ char const *f_name[] = { "setcar", "setcdr" };
+ char const *par_name[] = { "new_car", "new_cdr" };
+
+ for (int i = 0; i < 2; i++)
+ {
+ gcc_jit_param *cell =
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "cell");
+ gcc_jit_param *new_el =
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ par_name[i]);
+
+ gcc_jit_param *param[] =
+ { cell,
+ new_el,
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.bool_type,
+ "cert_cons") };
+
+ gcc_jit_function **f_ref = !i ? &comp.setcar : &comp.setcdr;
+ *f_ref = gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.lisp_obj_type,
+ f_name[i],
+ 3, param, 0);
+ DECL_BLOCK (entry_block, *f_ref);
+ comp.func = *f_ref;
+ comp.block = entry_block;
+
+ /* CHECK_CONS (cell); */
+ emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell));
+
+ /* CHECK_IMPURE (cell, XCONS (cell)); */
+ gcc_jit_rvalue *args[] =
+ { gcc_jit_param_as_rvalue (cell),
+ emit_XCONS (gcc_jit_param_as_rvalue (cell)) };
+
+ gcc_jit_block_add_eval (entry_block,
+ NULL,
+ gcc_jit_context_new_call (comp.ctxt,
+ NULL,
+ comp.check_impure,
+ 2,
+ args));
+
+ /* XSETCDR (cell, newel); */
+ if (!i)
+ emit_XSETCAR (gcc_jit_param_as_rvalue (cell),
+ gcc_jit_param_as_rvalue (new_el));
+ else
+ emit_XSETCDR (gcc_jit_param_as_rvalue (cell),
+ gcc_jit_param_as_rvalue (new_el));
+
+ /* return newel; */
+ gcc_jit_block_end_with_return (entry_block,
+ NULL,
+ gcc_jit_param_as_rvalue (new_el));
+ }
+}
+
+/*
+ Define a substitute for Fadd1 Fsub1.
+ Currently expose just fixnum arithmetic.
+*/
+
+static void
+define_add1_sub1 (void)
+{
+ gcc_jit_block *bb_orig = comp.block;
+ gcc_jit_function *func[2];
+ char const *f_name[] = { "add1", "sub1" };
+ char const *fall_back_func[] = { "1+", "1-" };
+ enum gcc_jit_binary_op op[] =
+ { GCC_JIT_BINARY_OP_PLUS, GCC_JIT_BINARY_OP_MINUS };
+ for (ptrdiff_t i = 0; i < 2; i++)
+ {
+ gcc_jit_param *param[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "n"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.bool_type,
+ "cert_fixnum") };
+ comp.func = func[i] =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.lisp_obj_type,
+ f_name[i],
+ 2,
+ param, 0);
+ DECL_BLOCK (entry_block, func[i]);
+ DECL_BLOCK (inline_block, func[i]);
+ DECL_BLOCK (fcall_block, func[i]);
+
+ comp.block = entry_block;
+
+ /* cert_fixnum ||
+ ((FIXNUMP (n) && XFIXNUM (n) != MOST_POSITIVE_FIXNUM
+ ? (XFIXNUM (n) + 1)
+ : Fadd1 (n)) */
+
+ gcc_jit_rvalue *n = gcc_jit_param_as_rvalue (param[0]);
+ gcc_jit_rvalue *n_fixnum = emit_XFIXNUM (n);
+ gcc_jit_rvalue *sure_fixnum =
+ emit_binary_op (GCC_JIT_BINARY_OP_LOGICAL_OR,
+ comp.bool_type,
+ gcc_jit_param_as_rvalue (param[1]),
+ emit_FIXNUMP (n));
+ emit_cond_jump (
+ emit_binary_op (
+ GCC_JIT_BINARY_OP_LOGICAL_AND,
+ comp.bool_type,
+ sure_fixnum,
+ gcc_jit_context_new_comparison (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_COMPARISON_NE,
+ n_fixnum,
+ i == 0
+ ? emit_rvalue_from_emacs_int (MOST_POSITIVE_FIXNUM)
+ : emit_rvalue_from_emacs_int (MOST_NEGATIVE_FIXNUM))),
+ inline_block,
+ fcall_block);
+
+ comp.block = inline_block;
+ gcc_jit_rvalue *inline_res =
+ emit_binary_op (op[i], comp.emacs_int_type, n_fixnum, comp.one);
+
+ gcc_jit_block_end_with_return (inline_block,
+ NULL,
+ emit_make_fixnum (inline_res));
+
+ comp.block = fcall_block;
+ gcc_jit_rvalue *call_res = emit_call (intern_c_string (fall_back_func[i]),
+ comp.lisp_obj_type, 1, &n, false);
+ gcc_jit_block_end_with_return (fcall_block,
+ NULL,
+ call_res);
+ }
+ comp.block = bb_orig;
+ comp.add1 = func[0];
+ comp.sub1 = func[1];
+}
+
+static void
+define_negate (void)
+{
+ gcc_jit_block *bb_orig = comp.block;
+ gcc_jit_param *param[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "n"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.bool_type,
+ "cert_fixnum") };
+
+ comp.func = comp.negate =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.lisp_obj_type,
+ "negate",
+ 2, param, 0);
+
+ DECL_BLOCK (entry_block, comp.negate);
+ DECL_BLOCK (inline_block, comp.negate);
+ DECL_BLOCK (fcall_block, comp.negate);
+
+ comp.block = entry_block;
+
+ /* (cert_fixnum || FIXNUMP (TOP)) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM
+ ? make_fixnum (- XFIXNUM (TOP)) : Fminus (1, &TOP)) */
+
+ gcc_jit_lvalue *n = gcc_jit_param_as_lvalue (param[0]);
+ gcc_jit_rvalue *n_fixnum = emit_XFIXNUM (gcc_jit_lvalue_as_rvalue (n));
+ gcc_jit_rvalue *sure_fixnum =
+ emit_binary_op (GCC_JIT_BINARY_OP_LOGICAL_OR,
+ comp.bool_type,
+ gcc_jit_param_as_rvalue (param[1]),
+ emit_FIXNUMP (gcc_jit_lvalue_as_rvalue (n)));
+
+ emit_cond_jump (emit_binary_op (GCC_JIT_BINARY_OP_LOGICAL_AND,
+ comp.bool_type,
+ sure_fixnum,
+ gcc_jit_context_new_comparison (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_COMPARISON_NE,
+ n_fixnum,
+ emit_rvalue_from_emacs_int (
+ MOST_NEGATIVE_FIXNUM))),
+ inline_block,
+ fcall_block);
+
+ comp.block = inline_block;
+ gcc_jit_rvalue *inline_res =
+ gcc_jit_context_new_unary_op (comp.ctxt,
+ NULL,
+ GCC_JIT_UNARY_OP_MINUS,
+ comp.emacs_int_type,
+ n_fixnum);
+
+ gcc_jit_block_end_with_return (inline_block,
+ NULL,
+ emit_make_fixnum (inline_res));
+
+ comp.block = fcall_block;
+ gcc_jit_rvalue *call_res = emit_call_ref (Qminus, 1, n, false);
+ gcc_jit_block_end_with_return (fcall_block,
+ NULL,
+ call_res);
+ comp.block = bb_orig;
+}
+
+/* Define a substitute for PSEUDOVECTORP as always inlined function. */
+
+static void
+define_PSEUDOVECTORP (void)
+{
+ gcc_jit_param *param[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "a"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.int_type,
+ "code") };
+
+ comp.pseudovectorp =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.bool_type,
+ "PSEUDOVECTORP",
+ 2,
+ param,
+ 0);
+
+ DECL_BLOCK (entry_block, comp.pseudovectorp);
+ DECL_BLOCK (ret_false_b, comp.pseudovectorp);
+ DECL_BLOCK (call_pseudovector_typep_b, comp.pseudovectorp);
+
+ comp.block = entry_block;
+ comp.func = comp.pseudovectorp;
+
+ emit_cond_jump (emit_VECTORLIKEP (gcc_jit_param_as_rvalue (param[0])),
+ call_pseudovector_typep_b,
+ ret_false_b);
+
+ comp.block = ret_false_b;
+ gcc_jit_block_end_with_return (ret_false_b,
+ NULL,
+ gcc_jit_context_new_rvalue_from_int (
+ comp.ctxt,
+ comp.bool_type,
+ false));
+
+ gcc_jit_rvalue *args[] =
+ { gcc_jit_param_as_rvalue (param[0]),
+ gcc_jit_param_as_rvalue (param[1]) };
+ comp.block = call_pseudovector_typep_b;
+ /* FIXME use XUNTAG now that's available. */
+ gcc_jit_block_end_with_return (
+ call_pseudovector_typep_b,
+ NULL,
+ emit_call (intern_c_string ("helper_PSEUDOVECTOR_TYPEP_XUNTAG"),
+ comp.bool_type, 2, args, false));
+}
+
+static void
+define_CHECK_IMPURE (void)
+{
+ gcc_jit_param *param[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ "obj"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.void_ptr_type,
+ "ptr") };
+ comp.check_impure =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.void_type,
+ "CHECK_IMPURE",
+ 2,
+ param,
+ 0);
+
+ DECL_BLOCK (entry_block, comp.check_impure);
+ DECL_BLOCK (err_block, comp.check_impure);
+ DECL_BLOCK (ok_block, comp.check_impure);
+
+ comp.block = entry_block;
+ comp.func = comp.check_impure;
+
+ emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */
+ err_block,
+ ok_block);
+ gcc_jit_block_end_with_void_return (ok_block, NULL);
+
+ gcc_jit_rvalue *pure_write_error_arg =
+ gcc_jit_param_as_rvalue (param[0]);
+
+ comp.block = err_block;
+ gcc_jit_block_add_eval (comp.block,
+ NULL,
+ emit_call (intern_c_string ("pure_write_error"),
+ comp.void_type, 1,&pure_write_error_arg,
+ false));
+
+ gcc_jit_block_end_with_void_return (err_block, NULL);
+}
+
+static void
+define_maybe_gc_or_quit (void)
+{
+
+ /*
+ void
+ maybe_gc_or_quit (void)
+ {
+ static unsigned quitcounter;
+ inc:
+ quitcounter++;
+ if (quitcounter >> 14) goto maybe_do_it else goto pass;
+ maybe_do_it:
+ quitcounter = 0;
+ maybe_gc ();
+ maybe_quit ();
+ return;
+ pass:
+ return;
+ }
+ */
+
+ gcc_jit_block *bb_orig = comp.block;
+
+ gcc_jit_lvalue *quitcounter =
+ gcc_jit_context_new_global (
+ comp.ctxt,
+ NULL,
+ GCC_JIT_GLOBAL_INTERNAL,
+ comp.unsigned_type,
+ "quitcounter");
+
+ comp.func = comp.maybe_gc_or_quit =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.void_type,
+ "maybe_gc_quit",
+ 0, NULL, 0);
+ DECL_BLOCK (increment_block, comp.maybe_gc_or_quit);
+ DECL_BLOCK (maybe_do_it_block, comp.maybe_gc_or_quit);
+ DECL_BLOCK (pass_block, comp.maybe_gc_or_quit);
+
+ comp.block = increment_block;
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ quitcounter,
+ emit_binary_op (GCC_JIT_BINARY_OP_PLUS,
+ comp.unsigned_type,
+ gcc_jit_lvalue_as_rvalue (quitcounter),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.unsigned_type,
+ 1)));
+ emit_cond_jump (
+ emit_binary_op (GCC_JIT_BINARY_OP_RSHIFT,
+ comp.unsigned_type,
+ gcc_jit_lvalue_as_rvalue (quitcounter),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.unsigned_type,
+ 9)),
+ /* 9 translates into checking for GC or quit every 512 calls to
+ 'maybe_gc_quit'. This is the smallest value I could find with
+ no performance impact running elisp-banechmarks and the same
+ used by the byte interpreter (see 'exec_byte_code'). */
+ maybe_do_it_block,
+ pass_block);
+
+ comp.block = maybe_do_it_block;
+
+ gcc_jit_block_add_assignment (
+ comp.block,
+ NULL,
+ quitcounter,
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.unsigned_type,
+ 0));
+ gcc_jit_block_add_eval (comp.block, NULL,
+ emit_call (intern_c_string ("maybe_gc"),
+ comp.void_type, 0, NULL, false));
+ gcc_jit_block_add_eval (comp.block, NULL,
+ emit_call (intern_c_string ("maybe_quit"),
+ comp.void_type, 0, NULL, false));
+ gcc_jit_block_end_with_void_return (comp.block, NULL);
+
+ gcc_jit_block_end_with_void_return (pass_block, NULL);
+
+ comp.block = bb_orig;
+}
+
+/* Define a function to convert boolean into t or nil */
+
+static void
+define_bool_to_lisp_obj (void)
+{
+ /* x ? Qt : Qnil */
+ gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.bool_type,
+ "x");
+ comp.bool_to_lisp_obj =
+ gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_INTERNAL,
+ comp.lisp_obj_type,
+ "bool_to_lisp_obj",
+ 1,
+ &param,
+ 0);
+ DECL_BLOCK (entry_block, comp.bool_to_lisp_obj);
+ DECL_BLOCK (ret_t_block, comp.bool_to_lisp_obj);
+ DECL_BLOCK (ret_nil_block, comp.bool_to_lisp_obj);
+ comp.block = entry_block;
+ comp.func = comp.bool_to_lisp_obj;
+
+ emit_cond_jump (gcc_jit_param_as_rvalue (param),
+ ret_t_block,
+ ret_nil_block);
+
+ comp.block = ret_t_block;
+ gcc_jit_block_end_with_return (ret_t_block,
+ NULL,
+ emit_lisp_obj_rval (Qt));
+
+ comp.block = ret_nil_block;
+ gcc_jit_block_end_with_return (ret_nil_block,
+ NULL,
+ emit_lisp_obj_rval (Qnil));
+}
+
+static gcc_jit_function *
+declare_lex_function (Lisp_Object func)
+{
+ gcc_jit_function *res;
+ Lisp_Object c_name = CALL1I (comp-func-c-name, func);
+ Lisp_Object args = CALL1I (comp-func-l-args, func);
+ bool nargs = !NILP (CALL1I (comp-nargs-p, args));
+ USE_SAFE_ALLOCA;
+
+ if (!nargs)
+ {
+ EMACS_INT max_args = XFIXNUM (CALL1I (comp-args-max, args));
+ eassert (max_args < INT_MAX);
+ gcc_jit_type **type = SAFE_ALLOCA (max_args * sizeof (*type));
+ for (ptrdiff_t i = 0; i < max_args; i++)
+ type[i] = comp.lisp_obj_type;
+
+ gcc_jit_param **params = SAFE_ALLOCA (max_args * sizeof (*params));
+ for (int i = 0; i < max_args; ++i)
+ params[i] = gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ type[i],
+ format_string ("par_%d", i));
+ res = gcc_jit_context_new_function (comp.ctxt, NULL,
+ GCC_JIT_FUNCTION_EXPORTED,
+ comp.lisp_obj_type,
+ SSDATA (c_name),
+ max_args,
+ params,
+ 0);
+ }
+ else
+ {
+ gcc_jit_param *params[] =
+ { gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.ptrdiff_type,
+ "nargs"),
+ gcc_jit_context_new_param (comp.ctxt,
+ NULL,
+ comp.lisp_obj_ptr_type,
+ "args") };
+ res =
+ gcc_jit_context_new_function (comp.ctxt,
+ NULL,
+ GCC_JIT_FUNCTION_EXPORTED,
+ comp.lisp_obj_type,
+ SSDATA (c_name),
+ ARRAYELTS (params), params, 0);
+ }
+ SAFE_FREE ();
+ return res;
+}
+
+/* Declare a function being compiled and add it to comp.exported_funcs_h. */
+
+static void
+declare_function (Lisp_Object func)
+{
+ gcc_jit_function *gcc_func =
+ !NILP (CALL1I (comp-func-l-p, func))
+ ? declare_lex_function (func)
+ : gcc_jit_context_new_function (comp.ctxt,
+ NULL,
+ GCC_JIT_FUNCTION_EXPORTED,
+ comp.lisp_obj_type,
+ SSDATA (CALL1I (comp-func-c-name, func)),
+ 0, NULL, 0);
+ Fputhash (CALL1I (comp-func-c-name, func),
+ make_mint_ptr (gcc_func),
+ comp.exported_funcs_h);
+}
+
+static void
+compile_function (Lisp_Object func)
+{
+ USE_SAFE_ALLOCA;
+ comp.frame_size = XFIXNUM (CALL1I (comp-func-frame-size, func));
+ eassert (comp.frame_size < INT_MAX);
+
+ comp.func = xmint_pointer (Fgethash (CALL1I (comp-func-c-name, func),
+ comp.exported_funcs_h, Qnil));
+
+ comp.func_has_non_local = !NILP (CALL1I (comp-func-has-non-local, func));
+ comp.func_speed = XFIXNUM (CALL1I (comp-func-speed, func));
+
+ comp.func_relocs_local =
+ gcc_jit_function_new_local (comp.func,
+ NULL,
+ comp.func_relocs_ptr_type,
+ "freloc");
+
+ comp.frame = SAFE_ALLOCA (comp.frame_size * sizeof (*comp.frame));
+ if (comp.func_has_non_local || !comp.func_speed)
+ {
+ /* FIXME: See bug#42360. */
+ gcc_jit_lvalue *arr =
+ gcc_jit_function_new_local (
+ comp.func,
+ NULL,
+ gcc_jit_context_new_array_type (comp.ctxt,
+ NULL,
+ comp.lisp_obj_type,
+ comp.frame_size),
+ "frame");
+
+ for (ptrdiff_t i = 0; i < comp.frame_size; ++i)
+ comp.frame[i] =
+ gcc_jit_context_new_array_access (
+ comp.ctxt,
+ NULL,
+ gcc_jit_lvalue_as_rvalue (arr),
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.int_type,
+ i));
+ }
+ else
+ for (ptrdiff_t i = 0; i < comp.frame_size; ++i)
+ comp.frame[i] =
+ gcc_jit_function_new_local (comp.func,
+ NULL,
+ comp.lisp_obj_type,
+ format_string ("slot_%td", i));
+
+ comp.scratch = NULL;
+
+ comp.loc_handler = gcc_jit_function_new_local (comp.func,
+ NULL,
+ comp.handler_ptr_type,
+ "c");
+
+ comp.func_blocks_h = CALLN (Fmake_hash_table);
+
+ /* Pre-declare all basic blocks to gcc.
+ The "entry" block must be declared as first. */
+ declare_block (Qentry);
+ Lisp_Object blocks = CALL1I (comp-func-blocks, func);
+ struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks);
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+ {
+ Lisp_Object block_name = HASH_KEY (ht, i);
+ if (!EQ (block_name, Qentry)
+ && !EQ (block_name, Qunbound))
+ declare_block (block_name);
+ }
+
+ gcc_jit_block_add_assignment (retrive_block (Qentry),
+ NULL,
+ comp.func_relocs_local,
+ gcc_jit_lvalue_as_rvalue (comp.func_relocs));
+
+
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+ {
+ Lisp_Object block_name = HASH_KEY (ht, i);
+ if (!EQ (block_name, Qunbound))
+ {
+ Lisp_Object block = HASH_VALUE (ht, i);
+ Lisp_Object insns = CALL1I (comp-block-insns, block);
+ if (NILP (block) || NILP (insns))
+ xsignal1 (Qnative_ice,
+ build_string ("basic block is missing or empty"));
+
+ comp.block = retrive_block (block_name);
+ while (CONSP (insns))
+ {
+ Lisp_Object insn = XCAR (insns);
+ emit_limple_insn (insn);
+ insns = XCDR (insns);
+ }
+ }
+ }
+ const char *err = gcc_jit_context_get_first_error (comp.ctxt);
+ if (err)
+ xsignal3 (Qnative_ice,
+ build_string ("failing to compile function"),
+ CALL1I (comp-func-name, func),
+ build_string (err));
+ SAFE_FREE ();
+}
+
+
+/**********************************/
+/* Entry points exposed to lisp. */
+/**********************************/
+
+/* In use by Fcomp_el_to_eln_filename. */
+static Lisp_Object loadsearch_re_list;
+
+static Lisp_Object
+make_directory_wrapper (Lisp_Object directory)
+{
+ CALL2I (make-directory, directory, Qt);
+ return Qnil;
+}
+
+static Lisp_Object
+make_directory_wrapper_1 (Lisp_Object ignore)
+{
+ return Qt;
+}
+
+DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename,
+ Scomp_el_to_eln_rel_filename, 1, 1, 0,
+ doc: /* Return the corresponding .eln relative filename. */)
+ (Lisp_Object filename)
+{
+ CHECK_STRING (filename);
+
+ /* Resolve possible symlinks in FILENAME, so that path_hash below
+ always compares equal. (Bug#44701). */
+ filename = Fexpand_file_name (filename, Qnil);
+ char *file_normalized = realpath (SSDATA (ENCODE_FILE (filename)), NULL);
+ if (file_normalized)
+ {
+ filename = DECODE_FILE (make_unibyte_string (file_normalized,
+ strlen (file_normalized)));
+ xfree (file_normalized);
+ }
+
+ if (NILP (Ffile_exists_p (filename)))
+ xsignal1 (Qfile_missing, filename);
+
+#ifdef WINDOWSNT
+ filename = Fw32_long_file_name (filename);
+#endif
+
+ Lisp_Object content_hash = comp_hash_source_file (filename);
+
+ if (suffix_p (filename, ".gz"))
+ filename = Fsubstring (filename, Qnil, make_fixnum (-3));
+
+ /* We create eln filenames with an hash in order to look-up these
+ starting from the source filename, IOW have a relation
+
+ /absolute/path/filename.el + content ->
+ eln-cache/filename-path_hash-content_hash.eln.
+
+ 'dlopen' can return the same handle if two shared with the same
+ filename are loaded in two different times (even if the first was
+ deleted!). To prevent this scenario the source file content is
+ included in the hashing algorithm.
+
+ As at any point in time no more then one file can exist with the
+ same filename, should be possible to clean up all
+ filename-path_hash-* except the most recent one (or the new one
+ being recompiled).
+
+ As installing .eln files compiled during the build changes their
+ absolute path we need an hashing mechanism that is not sensitive
+ to that. For this we replace if match PATH_DUMPLOADSEARCH or
+ *PATH_REL_LOADSEARCH with '//' before computing the hash. */
+
+ if (NILP (loadsearch_re_list))
+ {
+ Lisp_Object sys_re =
+ concat2 (build_string ("\\`[[:ascii:]]+"),
+ Fregexp_quote (build_string ("/" PATH_REL_LOADSEARCH "/")));
+ Lisp_Object dump_load_search =
+ Fexpand_file_name (build_string (PATH_DUMPLOADSEARCH "/"), Qnil);
+#ifdef WINDOWSNT
+ dump_load_search = Fw32_long_file_name (dump_load_search);
+#endif
+ loadsearch_re_list = list2 (sys_re, Fregexp_quote (dump_load_search));
+ }
+
+ Lisp_Object lds_re_tail = loadsearch_re_list;
+ FOR_EACH_TAIL (lds_re_tail)
+ {
+ Lisp_Object match_idx =
+ Fstring_match (XCAR (lds_re_tail), filename, Qnil);
+ if (EQ (match_idx, make_fixnum (0)))
+ {
+ filename =
+ Freplace_match (build_string ("//"), Qt, Qt, filename, Qnil);
+ break;
+ }
+ }
+ Lisp_Object separator = build_string ("-");
+ Lisp_Object path_hash = comp_hash_string (filename);
+ filename = concat2 (Ffile_name_nondirectory (Fsubstring (filename, Qnil,
+ make_fixnum (-3))),
+ separator);
+ Lisp_Object hash = concat3 (path_hash, separator, content_hash);
+ return concat3 (filename, hash, build_string (NATIVE_ELISP_SUFFIX));
+}
+
+DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename,
+ Scomp_el_to_eln_filename, 1, 2, 0,
+ doc: /* Return the .eln filename for source FILENAME to used
+for new compilations.
+If BASE-DIR is non-nil use it as a base directory, look for a suitable
+directory in `comp-eln-load-path' otherwise. */)
+ (Lisp_Object filename, Lisp_Object base_dir)
+{
+ Lisp_Object source_filename = filename;
+ filename = Fcomp_el_to_eln_rel_filename (filename);
+
+ /* If base_dir was not specified search inside Vnative_comp_eln_load_path
+ for the first directory where we have write access. */
+ if (NILP (base_dir))
+ {
+ Lisp_Object eln_load_paths = Vnative_comp_eln_load_path;
+ FOR_EACH_TAIL (eln_load_paths)
+ {
+ Lisp_Object dir = XCAR (eln_load_paths);
+ if (!NILP (Ffile_exists_p (dir)))
+ {
+ if (!NILP (Ffile_writable_p (dir)))
+ {
+ base_dir = dir;
+ break;
+ }
+ }
+ else
+ {
+ /* Try to create the directory and if succeeds use it. */
+ if (NILP (internal_condition_case_1 (make_directory_wrapper,
+ dir, Qt,
+ make_directory_wrapper_1)))
+ {
+ base_dir = dir;
+ break;
+ }
+ }
+ }
+ if (NILP (base_dir))
+ error ("Cannot find suitable directory for output in "
+ "`comp-native-load-path'.");
+ }
+
+ if (!file_name_absolute_p (SSDATA (base_dir)))
+ base_dir = Fexpand_file_name (base_dir, Vinvocation_directory);
+
+ /* In case the file being compiled is found in 'LISP_PRELOADED' or
+ `comp-file-preloaded-p' is non-nil target for output the
+ 'preloaded' subfolder. */
+ Lisp_Object lisp_preloaded =
+ Fgetenv_internal (build_string ("LISP_PRELOADED"), Qnil);
+ base_dir = Fexpand_file_name (Vcomp_native_version_dir, base_dir);
+ if (comp_file_preloaded_p
+ || (!NILP (lisp_preloaded)
+ && !NILP (Fmember (CALL1I (file-name-base, source_filename),
+ Fmapcar (intern_c_string ("file-name-base"),
+ CALL1I (split-string, lisp_preloaded))))))
+ base_dir = Fexpand_file_name (build_string ("preloaded"), base_dir);
+
+ return Fexpand_file_name (filename, base_dir);
+}
+
+DEFUN ("comp--install-trampoline", Fcomp__install_trampoline,
+ Scomp__install_trampoline, 2, 2, 0,
+ doc: /* Install a TRAMPOLINE for primitive SUBR-NAME. */)
+ (Lisp_Object subr_name, Lisp_Object trampoline)
+{
+ CHECK_SYMBOL (subr_name);
+ CHECK_SUBR (trampoline);
+ Lisp_Object orig_subr = Fsymbol_function (subr_name);
+ CHECK_SUBR (orig_subr);
+
+ /* FIXME: add a post dump load trampoline machinery to remove this
+ check. */
+ if (will_dump_p ())
+ signal_error ("Trying to advice unexpected primitive before dumping",
+ subr_name);
+
+ Lisp_Object subr_l = Vcomp_subr_list;
+ ptrdiff_t i = ARRAYELTS (helper_link_table);
+ FOR_EACH_TAIL (subr_l)
+ {
+ Lisp_Object subr = XCAR (subr_l);
+ if (EQ (subr, orig_subr))
+ {
+ freloc.link_table[i] = XSUBR (trampoline)->function.a0;
+ Fputhash (subr_name, trampoline, Vcomp_installed_trampolines_h);
+ return Qt;
+ }
+ i++;
+ }
+ signal_error ("Trying to install trampoline for non existent subr",
+ subr_name);
+ return Qnil;
+}
+
+DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt,
+ 0, 0, 0,
+ doc: /* Initialize the native compiler context.
+Return t on success. */)
+ (void)
+{
+ load_gccjit_if_necessary (true);
+
+ if (comp.ctxt)
+ {
+ xsignal1 (Qnative_ice,
+ build_string ("compiler context already taken"));
+ return Qnil;
+ }
+
+ if (NILP (comp.emitter_dispatcher))
+ {
+ /* Move this into syms_of_comp the day will be dumpable. */
+ comp.emitter_dispatcher = CALLN (Fmake_hash_table);
+ register_emitter (Qset_internal, emit_set_internal);
+ register_emitter (Qhelper_unbind_n, emit_simple_limple_call_lisp_ret);
+ register_emitter (Qhelper_unwind_protect,
+ emit_simple_limple_call_void_ret);
+ register_emitter (Qrecord_unwind_current_buffer,
+ emit_simple_limple_call_lisp_ret);
+ register_emitter (Qrecord_unwind_protect_excursion,
+ emit_simple_limple_call_void_ret);
+ register_emitter (Qhelper_save_restriction,
+ emit_simple_limple_call_void_ret);
+ /* Inliners. */
+ register_emitter (Qadd1, emit_add1);
+ register_emitter (Qsub1, emit_sub1);
+ register_emitter (Qconsp, emit_consp);
+ register_emitter (Qcar, emit_car);
+ register_emitter (Qcdr, emit_cdr);
+ register_emitter (Qsetcar, emit_setcar);
+ register_emitter (Qsetcdr, emit_setcdr);
+ register_emitter (Qnegate, emit_negate);
+ register_emitter (Qnumberp, emit_numperp);
+ register_emitter (Qintegerp, emit_integerp);
+ register_emitter (Qcomp_maybe_gc_or_quit, emit_maybe_gc_or_quit);
+ }
+
+ comp.ctxt = gcc_jit_context_acquire ();
+
+ comp.void_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_VOID);
+ comp.void_ptr_type =
+ gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_VOID_PTR);
+ comp.bool_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_BOOL);
+ comp.char_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_CHAR);
+ comp.int_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_INT);
+ comp.unsigned_type = gcc_jit_context_get_type (comp.ctxt,
+ GCC_JIT_TYPE_UNSIGNED_INT);
+ comp.long_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_LONG);
+ comp.unsigned_long_type =
+ gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_UNSIGNED_LONG);
+ comp.long_long_type =
+ gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_LONG_LONG);
+ comp.unsigned_long_long_type =
+ gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_UNSIGNED_LONG_LONG);
+ comp.char_ptr_type = gcc_jit_type_get_pointer (comp.char_type);
+ comp.emacs_int_type = gcc_jit_context_get_int_type (comp.ctxt,
+ sizeof (EMACS_INT),
+ true);
+ comp.emacs_uint_type = gcc_jit_context_get_int_type (comp.ctxt,
+ sizeof (EMACS_UINT),
+ false);
+#if LISP_WORDS_ARE_POINTERS
+ comp.lisp_word_type =
+ gcc_jit_type_get_pointer (
+ gcc_jit_struct_as_type (
+ gcc_jit_context_new_opaque_struct (comp.ctxt,
+ NULL,
+ "Lisp_X")));
+#else
+ comp.lisp_word_type = comp.emacs_int_type;
+#endif
+ comp.lisp_word_tag_type
+ = gcc_jit_context_get_int_type (comp.ctxt, sizeof (Lisp_Word_tag), false);
+#ifdef LISP_OBJECT_IS_STRUCT
+ comp.lisp_obj_i = gcc_jit_context_new_field (comp.ctxt,
+ NULL,
+ comp.lisp_word_type,
+ "i");
+ comp.lisp_obj_s = gcc_jit_context_new_struct_type (comp.ctxt,
+ NULL,
+ "Lisp_Object",
+ 1,
+ &comp.lisp_obj_i);
+ comp.lisp_obj_type = gcc_jit_struct_as_type (comp.lisp_obj_s);
+#else
+ comp.lisp_obj_type = comp.lisp_word_type;
+#endif
+ comp.lisp_obj_ptr_type = gcc_jit_type_get_pointer (comp.lisp_obj_type);
+ comp.zero =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.emacs_int_type,
+ 0);
+ comp.one =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.emacs_int_type,
+ 1);
+ comp.inttypebits =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.emacs_uint_type,
+ INTTYPEBITS);
+ comp.lisp_int0 =
+ gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+ comp.emacs_int_type,
+ Lisp_Int0);
+ comp.ptrdiff_type = gcc_jit_context_get_int_type (comp.ctxt,
+ sizeof (void *),
+ true);
+ comp.uintptr_type = gcc_jit_context_get_int_type (comp.ctxt,
+ sizeof (void *),
+ false);
+ comp.size_t_type = gcc_jit_context_get_int_type (comp.ctxt,
+ sizeof (size_t),
+ false);
+
+ comp.exported_funcs_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+ /*
+ Always reinitialize this cause old function definitions are garbage
+ collected by libgccjit when the ctxt is released.
+ */
+ comp.imported_funcs_h = CALLN (Fmake_hash_table);
+
+ define_memcpy ();
+
+ /* Define data structures. */
+
+ define_lisp_cons ();
+ define_jmp_buf ();
+ define_handler_struct ();
+ define_thread_state_struct ();
+ define_cast_functions ();
+
+ return Qt;
+}
+
+DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt,
+ 0, 0, 0,
+ doc: /* Release the native compiler context. */)
+ (void)
+{
+ load_gccjit_if_necessary (true);
+
+ if (comp.ctxt)
+ gcc_jit_context_release (comp.ctxt);
+
+ if (logfile)
+ fclose (logfile);
+ comp.ctxt = NULL;
+
+ return Qt;
+}
+
+#pragma GCC diagnostic ignored "-Waddress"
+DEFUN ("comp-native-driver-options-effective-p",
+ Fcomp_native_driver_options_effective_p,
+ Scomp_native_driver_options_effective_p,
+ 0, 0, 0,
+ doc: /* Return t if `comp-native-driver-options' is effective. */)
+ (void)
+{
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \
+ || defined (WINDOWSNT)
+ if (gcc_jit_context_add_driver_option)
+ return Qt;
+#endif
+ return Qnil;
+}
+#pragma GCC diagnostic pop
+
+static void
+add_driver_options (void)
+{
+ Lisp_Object options = Fsymbol_value (Qnative_comp_driver_options);
+
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \
+ || defined (WINDOWSNT)
+ load_gccjit_if_necessary (true);
+ if (!NILP (Fcomp_native_driver_options_effective_p ()))
+ FOR_EACH_TAIL (options)
+ gcc_jit_context_add_driver_option (comp.ctxt,
+ /* FIXME: Need to encode
+ this, but how? either
+ ENCODE_FILE or
+ ENCODE_SYSTEM. */
+ SSDATA (XCAR (options)));
+#endif
+ if (CONSP (options))
+ xsignal1 (Qnative_compiler_error,
+ build_string ("Customizing native compiler options"
+ " via `comp-native-driver-options' is"
+ " only available on libgccjit version 9"
+ " and above."));
+
+ /* Captured `comp-native-driver-options' because file-local. */
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \
+ || defined (WINDOWSNT)
+ options = comp.driver_options;
+ if (!NILP (Fcomp_native_driver_options_effective_p ()))
+ FOR_EACH_TAIL (options)
+ gcc_jit_context_add_driver_option (comp.ctxt,
+ /* FIXME: Need to encode
+ this, but how? either
+ ENCODE_FILE or
+ ENCODE_SYSTEM. */
+ SSDATA (XCAR (options)));
+#endif
+}
+
+DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
+ Scomp__compile_ctxt_to_file,
+ 1, 1, 0,
+ doc: /* Compile the current context as native code to file FILENAME. */)
+ (Lisp_Object filename)
+{
+ load_gccjit_if_necessary (true);
+
+ CHECK_STRING (filename);
+ Lisp_Object base_name = Fsubstring (filename, Qnil, make_fixnum (-4));
+ Lisp_Object ebase_name = ENCODE_FILE (base_name);
+
+ comp.func_relocs_local = NULL;
+
+#ifdef WINDOWSNT
+ ebase_name = ansi_encode_filename (ebase_name);
+ /* Tell libgccjit the actual file name of the loaded DLL, otherwise
+ it will use 'libgccjit.so', which is not useful. */
+ Lisp_Object libgccjit_loaded_from = Fget (Qgccjit, QCloaded_from);
+ Lisp_Object libgccjit_fname;
+
+ if (CONSP (libgccjit_loaded_from))
+ {
+ /* Use the absolute file name if available, otherwise the name
+ we looked for in w32_delayed_load. */
+ libgccjit_fname = XCDR (libgccjit_loaded_from);
+ if (NILP (libgccjit_fname))
+ libgccjit_fname = XCAR (libgccjit_loaded_from);
+ /* Must encode to ANSI, as libgccjit will not be able to handle
+ UTF-8 encoded file names. */
+ libgccjit_fname = ENCODE_FILE (libgccjit_fname);
+ libgccjit_fname = ansi_encode_filename (libgccjit_fname);
+ gcc_jit_context_set_str_option (comp.ctxt, GCC_JIT_STR_OPTION_PROGNAME,
+ SSDATA (libgccjit_fname));
+ }
+ else /* this should never happen */
+ gcc_jit_context_set_str_option (comp.ctxt, GCC_JIT_STR_OPTION_PROGNAME,
+ "libgccjit-0.dll");
+#endif
+
+ comp.speed = XFIXNUM (CALL1I (comp-ctxt-speed, Vcomp_ctxt));
+ eassert (comp.speed < INT_MAX);
+ comp.debug = XFIXNUM (CALL1I (comp-ctxt-debug, Vcomp_ctxt));
+ eassert (comp.debug < INT_MAX);
+ comp.driver_options = CALL1I (comp-ctxt-driver-options, Vcomp_ctxt);
+
+ if (comp.debug)
+ gcc_jit_context_set_bool_option (comp.ctxt,
+ GCC_JIT_BOOL_OPTION_DEBUGINFO,
+ 1);
+ if (comp.debug >= 3)
+ {
+ logfile = emacs_fopen ("libgccjit.log", "w");
+ gcc_jit_context_set_logfile (comp.ctxt,
+ logfile,
+ 0, 0);
+ gcc_jit_context_set_bool_option (comp.ctxt,
+ GCC_JIT_BOOL_OPTION_KEEP_INTERMEDIATES,
+ 1);
+ gcc_jit_context_set_bool_option (comp.ctxt,
+ GCC_JIT_BOOL_OPTION_DUMP_EVERYTHING,
+ 1);
+ }
+
+ gcc_jit_context_set_int_option (comp.ctxt,
+ GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL,
+ comp.speed < 0 ? 0
+ : (comp.speed > 3 ? 3 : comp.speed));
+ comp.d_default_idx =
+ CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt));
+ comp.d_impure_idx =
+ CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-impure, Vcomp_ctxt));
+ comp.d_ephemeral_idx =
+ CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt));
+
+ emit_ctxt_code ();
+
+ /* Define inline functions. */
+ define_CAR_CDR ();
+ define_PSEUDOVECTORP ();
+ define_CHECK_TYPE ();
+ define_CHECK_IMPURE ();
+ define_bool_to_lisp_obj ();
+ define_setcar_setcdr ();
+ define_add1_sub1 ();
+ define_negate ();
+ define_maybe_gc_or_quit ();
+
+ struct Lisp_Hash_Table *func_h =
+ XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt));
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++)
+ if (!EQ (HASH_VALUE (func_h, i), Qunbound))
+ declare_function (HASH_VALUE (func_h, i));
+ /* Compile all functions. Can't be done before because the
+ relocation structs has to be already defined. */
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++)
+ if (!EQ (HASH_VALUE (func_h, i), Qunbound))
+ compile_function (HASH_VALUE (func_h, i));
+
+ /* Work around bug#46495 (GCC PR99126). */
+#if defined (WIDE_EMACS_INT) \
+ && (defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) \
+ || defined (WINDOWSNT))
+ Lisp_Object version = Fcomp_libgccjit_version ();
+ if (NILP (version)
+ || XFIXNUM (XCAR (version)) < 11)
+ gcc_jit_context_add_command_line_option (comp.ctxt,
+ "-fdisable-tree-isolate-paths");
+#endif
+
+ add_driver_options ();
+
+ if (comp.debug > 1)
+ gcc_jit_context_dump_to_file (comp.ctxt,
+ format_string ("%s.c", SSDATA (ebase_name)),
+ 1);
+ if (!NILP (Fsymbol_value (Qcomp_libgccjit_reproducer)))
+ gcc_jit_context_dump_reproducer_to_file (
+ comp.ctxt,
+ format_string ("%s_libgccjit_repro.c", SSDATA (ebase_name)));
+
+ Lisp_Object tmp_file =
+ Fmake_temp_file_internal (base_name, Qnil, build_string (".eln.tmp"), Qnil);
+ Lisp_Object encoded_tmp_file = ENCODE_FILE (tmp_file);
+#ifdef WINDOWSNT
+ encoded_tmp_file = ansi_encode_filename (encoded_tmp_file);
+#endif
+ gcc_jit_context_compile_to_file (comp.ctxt,
+ GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY,
+ SSDATA (encoded_tmp_file));
+
+ const char *err = gcc_jit_context_get_first_error (comp.ctxt);
+ if (err)
+ xsignal3 (Qnative_ice,
+ build_string ("failed to compile"),
+ filename,
+ build_string (err));
+
+ CALL1I (comp-clean-up-stale-eln, filename);
+ CALL2I (comp-delete-or-replace-file, filename, tmp_file);
+
+ return filename;
+}
+
+#pragma GCC diagnostic ignored "-Waddress"
+DEFUN ("comp-libgccjit-version", Fcomp_libgccjit_version,
+ Scomp_libgccjit_version, 0, 0, 0,
+ doc: /* Return libgccjit version in use.
+
+The return value has the form (MAJOR MINOR PATCHLEVEL) or nil if
+unknown (before GCC version 10). */)
+ (void)
+{
+#if defined (LIBGCCJIT_HAVE_gcc_jit_version) || defined (WINDOWSNT)
+ load_gccjit_if_necessary (true);
+
+ return gcc_jit_version_major
+ ? list3 (make_fixnum (gcc_jit_version_major ()),
+ make_fixnum (gcc_jit_version_minor ()),
+ make_fixnum (gcc_jit_version_patchlevel ()))
+ : Qnil;
+#else
+ return Qnil;
+#endif
+}
+#pragma GCC diagnostic pop
+
+
+/******************************************************************************/
+/* Helper functions called from the run-time. */
+/* These can't be statics till shared mechanism is used to solve relocations. */
+/* Note: this are all potentially definable directly to gcc and are here just */
+/* for laziness. Change this if a performance impact is measured. */
+/******************************************************************************/
+
+void
+helper_unwind_protect (Lisp_Object handler)
+{
+ /* Support for a function here is new in 24.4. */
+ record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore,
+ handler);
+}
+
+Lisp_Object
+helper_temp_output_buffer_setup (Lisp_Object x)
+{
+ CHECK_STRING (x);
+ temp_output_buffer_setup (SSDATA (x));
+ return Vstandard_output;
+}
+
+Lisp_Object
+helper_unbind_n (Lisp_Object n)
+{
+ return unbind_to (SPECPDL_INDEX () - XFIXNUM (n), Qnil);
+}
+
+void
+helper_save_restriction (void)
+{
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+}
+
+bool
+helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code)
+{
+ return PSEUDOVECTOR_TYPEP (XUNTAG (a, Lisp_Vectorlike,
+ union vectorlike_header),
+ code);
+}
+
+
+/* `comp-eln-load-path' clean-up support code. */
+
+static Lisp_Object all_loaded_comp_units_h;
+
+#ifdef WINDOWSNT
+static Lisp_Object
+return_nil (Lisp_Object arg)
+{
+ return Qnil;
+}
+#endif
+
+/* Windows does not let us delete a .eln file that is currently loaded
+ by a process. The strategy is to rename .eln files into .old.eln
+ instead of removing them when this is not possible and clean-up
+ `comp-eln-load-path' when exiting.
+
+ Any error is ignored because it may be due to the file being loaded
+ in another Emacs instance. */
+void
+eln_load_path_final_clean_up (void)
+{
+#ifdef WINDOWSNT
+ Lisp_Object dir_tail = Vnative_comp_eln_load_path;
+ FOR_EACH_TAIL (dir_tail)
+ {
+ Lisp_Object files_in_dir =
+ internal_condition_case_5 (Fdirectory_files,
+ Fexpand_file_name (Vcomp_native_version_dir,
+ XCAR (dir_tail)),
+ Qt, build_string ("\\.eln\\.old\\'"), Qnil,
+ Qnil, Qt, return_nil);
+ FOR_EACH_TAIL (files_in_dir)
+ internal_delete_file (XCAR (files_in_dir));
+ }
+#endif
+}
+
+/* This function puts the compilation unit in the
+ `all_loaded_comp_units_h` hashmap. */
+static void
+register_native_comp_unit (Lisp_Object comp_u)
+{
+ Fputhash (XNATIVE_COMP_UNIT (comp_u)->file, comp_u, all_loaded_comp_units_h);
+}
+
+
+/***********************************/
+/* Deferred compilation mechanism. */
+/***********************************/
+
+/* List of sources we'll compile and load after having conventionally
+ loaded the compiler and its dependencies. */
+static Lisp_Object delayed_sources;
+
+/* Queue an asynchronous compilation for the source file defining
+ FUNCTION_NAME and perform a late load.
+
+ NOTE: ideally would be nice to move its call simply into Fload but
+ we need DEFINITION to guard against function redefinition while
+ async compilation happen. */
+
+void
+maybe_defer_native_compilation (Lisp_Object function_name,
+ Lisp_Object definition)
+{
+#if 0
+#include <sys/types.h>
+#include <unistd.h>
+ if (!NILP (function_name) &&
+ STRINGP (Vload_true_file_name))
+ {
+ static FILE *f;
+ if (!f)
+ {
+ char str[128];
+ sprintf (str, "log_%d", getpid ());
+ f = fopen (str, "w");
+ }
+ if (!f)
+ exit (1);
+ fprintf (f, "function %s file %s\n",
+ SSDATA (Fsymbol_name (function_name)),
+ SSDATA (Vload_true_file_name));
+ fflush (f);
+ }
+#endif
+ if (!load_gccjit_if_necessary (false))
+ return;
+
+ if (!native_comp_deferred_compilation
+ || noninteractive
+ || !NILP (Vpurify_flag)
+ || !COMPILEDP (definition)
+ || !STRINGP (Vload_true_file_name)
+ || !suffix_p (Vload_true_file_name, ".elc")
+ || !NILP (Fgethash (Vload_true_file_name, V_comp_no_native_file_h, Qnil)))
+ return;
+
+ Lisp_Object src =
+ concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name),
+ build_pure_c_string (".el"));
+ if (NILP (Ffile_exists_p (src)))
+ {
+ src = concat2 (src, build_pure_c_string (".gz"));
+ if (NILP (Ffile_exists_p (src)))
+ return;
+ }
+
+ /* This is so deferred compilation is able to compile comp
+ dependencies breaking circularity. */
+ if (!NILP (Ffeaturep (Qcomp, Qnil)))
+ {
+ /* Comp already loaded. */
+ if (!NILP (delayed_sources))
+ {
+ CALLN (Ffuncall, intern_c_string ("native--compile-async"),
+ delayed_sources, Qnil, Qlate);
+ delayed_sources = Qnil;
+ }
+ Fputhash (function_name, definition, Vcomp_deferred_pending_h);
+ CALLN (Ffuncall, intern_c_string ("native--compile-async"),
+ src, Qnil, Qlate);
+ }
+ else
+ {
+ delayed_sources = Fcons (src, delayed_sources);
+ /* Require comp only once. */
+ static bool comp_required = false;
+ if (!comp_required)
+ {
+ comp_required = true;
+ Frequire (Qcomp, Qnil, Qnil);
+ }
+ }
+}
+
+
+/**************************************/
+/* Functions used to load eln files. */
+/**************************************/
+
+/* Fixup the system eln-cache directory, which is the last entry in
+ `comp-eln-load-path'. Argument is a .eln file in that directory. */
+void
+fixup_eln_load_path (Lisp_Object eln_filename)
+{
+ Lisp_Object last_cell = Qnil;
+ Lisp_Object tem = Vnative_comp_eln_load_path;
+ FOR_EACH_TAIL (tem)
+ if (CONSP (tem))
+ last_cell = tem;
+
+ const char preloaded[] = "/preloaded/";
+ Lisp_Object eln_cache_sys = Ffile_name_directory (eln_filename);
+ const char *p_preloaded =
+ SSDATA (eln_cache_sys) + SBYTES (eln_cache_sys) - sizeof (preloaded) + 1;
+ bool preloaded_p = strcmp (p_preloaded, preloaded) == 0;
+
+ /* One or two directories up... */
+ for (int i = 0; i < (preloaded_p ? 2 : 1); i++)
+ eln_cache_sys =
+ Ffile_name_directory (Fsubstring_no_properties (eln_cache_sys, Qnil,
+ make_fixnum (-1)));
+ Fsetcar (last_cell, eln_cache_sys);
+}
+
+typedef char *(*comp_lit_str_func) (void);
+
+/* Deserialize read and return static object. */
+static Lisp_Object
+load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name)
+{
+ static_obj_t *blob =
+ dynlib_sym (comp_u->handle, format_string ("%s_blob", name));
+ if (blob)
+ /* New blob format. */
+ return Fread (make_string (blob->data, blob->len));
+
+ static_obj_t *(*f)(void) = dynlib_sym (comp_u->handle, name);
+ if (!f)
+ xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
+
+ blob = f ();
+ return Fread (make_string (blob->data, blob->len));
+
+}
+
+/* Return false when something is wrong or true otherwise. */
+
+static bool
+check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u)
+{
+ dynlib_handle_ptr handle = comp_u->handle;
+ Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
+ Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
+
+ EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
+ for (ptrdiff_t i = 0; i < d_vec_len; i++)
+ if (!EQ (data_relocs[i], AREF (comp_u->data_vec, i)))
+ return false;
+
+ d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
+ for (ptrdiff_t i = 0; i < d_vec_len; i++)
+ {
+ Lisp_Object x = data_imp_relocs[i];
+ if (EQ (x, Qlambda_fixup))
+ return false;
+ else if (SUBR_NATIVE_COMPILEDP (x))
+ {
+ if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil)))
+ return false;
+ }
+ else if (!EQ (data_imp_relocs[i], AREF (comp_u->data_impure_vec, i)))
+ return false;
+ }
+ return true;
+}
+
+static void
+unset_cu_load_ongoing (Lisp_Object comp_u)
+{
+ XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false;
+}
+
+Lisp_Object
+load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
+ bool late_load)
+{
+ Lisp_Object res = Qnil;
+ dynlib_handle_ptr handle = comp_u->handle;
+ Lisp_Object comp_u_lisp_obj;
+ XSETNATIVE_COMP_UNIT (comp_u_lisp_obj, comp_u);
+
+ Lisp_Object *saved_cu = dynlib_sym (handle, COMP_UNIT_SYM);
+ if (!saved_cu)
+ xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
+ comp_u->loaded_once = !NILP (*saved_cu);
+ Lisp_Object *data_eph_relocs =
+ dynlib_sym (handle, DATA_RELOC_EPHEMERAL_SYM);
+
+ /* While resurrecting from an image dump loading more than once the
+ same compilation unit does not make any sense. */
+ eassert (!(loading_dump && comp_u->loaded_once));
+
+ if (comp_u->loaded_once)
+ /* 'dlopen' returns the same handle when trying to load two times
+ the same shared. In this case touching 'd_reloc' etc leads to
+ fails in case a frame with a reference to it in a live reg is
+ active (native-comp-speed > 0).
+
+ We must *never* mess with static pointers in an already loaded
+ eln. */
+ {
+ comp_u_lisp_obj = *saved_cu;
+ comp_u = XNATIVE_COMP_UNIT (comp_u_lisp_obj);
+ comp_u->loaded_once = true;
+ }
+ else
+ *saved_cu = comp_u_lisp_obj;
+
+ /* Once we are sure to have the right compilation unit we want to
+ identify is we have at least another load active on it. */
+ bool recursive_load = comp_u->load_ongoing;
+ comp_u->load_ongoing = true;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ if (!recursive_load)
+ record_unwind_protect (unset_cu_load_ongoing, comp_u_lisp_obj);
+
+ freloc_check_fill ();
+
+ Lisp_Object (*top_level_run)(Lisp_Object)
+ = dynlib_sym (handle,
+ late_load ? "late_top_level_run" : "top_level_run");
+
+ /* Always set data_imp_relocs pointer in the compilation unit (in can be
+ used in 'dump_do_dump_relocation'). */
+ comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
+
+ if (!comp_u->loaded_once)
+ {
+ struct thread_state ***current_thread_reloc =
+ dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM);
+ void **pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM);
+ Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
+ Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs;
+ void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM);
+
+ if (!(current_thread_reloc
+ && pure_reloc
+ && data_relocs
+ && data_imp_relocs
+ && data_eph_relocs
+ && freloc_link_table
+ && top_level_run)
+ || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM),
+ Vcomp_abi_hash)))
+ xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
+
+ *current_thread_reloc = &current_thread;
+ *pure_reloc = pure;
+
+ /* Imported functions. */
+ *freloc_link_table = freloc.link_table;
+
+ /* Imported data. */
+ if (!loading_dump)
+ {
+ comp_u->optimize_qualities =
+ load_static_obj (comp_u, TEXT_OPTIM_QLY_SYM);
+ comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
+ comp_u->data_impure_vec =
+ load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM);
+
+ if (!NILP (Vpurify_flag))
+ /* Non impure can be copied into pure space. */
+ comp_u->data_vec = Fpurecopy (comp_u->data_vec);
+ }
+
+ EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
+ for (EMACS_INT i = 0; i < d_vec_len; i++)
+ data_relocs[i] = AREF (comp_u->data_vec, i);
+
+ d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
+ for (EMACS_INT i = 0; i < d_vec_len; i++)
+ data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
+ }
+
+ if (!loading_dump)
+ {
+ /* Note: data_ephemeral_vec is not GC protected except than by
+ this function frame. After this functions will be
+ deactivated GC will be free to collect it, but it MUST
+ survive till 'top_level_run' has finished his job. We store
+ into the ephemeral allocation class only objects that we know
+ are necessary exclusively during the first load. Once these
+ are collected we don't have to maintain them in the heap
+ forever. */
+ Lisp_Object volatile data_ephemeral_vec;
+ /* In case another load of the same CU is active on the stack
+ all ephemeral data is hold by that frame. Re-writing
+ 'data_ephemeral_vec' would be not only a waste of cycles but
+ more importantly would lead to crashes if the contained data
+ is not cons hashed. */
+ if (!recursive_load)
+ {
+ data_ephemeral_vec =
+ load_static_obj (comp_u, TEXT_DATA_RELOC_EPHEMERAL_SYM);
+
+ EMACS_INT d_vec_len = XFIXNUM (Flength (data_ephemeral_vec));
+ for (EMACS_INT i = 0; i < d_vec_len; i++)
+ data_eph_relocs[i] = AREF (data_ephemeral_vec, i);
+ }
+ /* Executing this will perform all the expected environment
+ modifications. */
+ res = top_level_run (comp_u_lisp_obj);
+ /* Make sure data_ephemeral_vec still exists after top_level_run has run.
+ Guard against sibling call optimization (or any other). */
+ data_ephemeral_vec = data_ephemeral_vec;
+ eassert (check_comp_unit_relocs (comp_u));
+ }
+
+ if (!recursive_load)
+ /* Clean-up the load ongoing flag in case. */
+ unbind_to (count, Qnil);
+
+ register_native_comp_unit (comp_u_lisp_obj);
+
+ return res;
+}
+
+void
+unload_comp_unit (struct Lisp_Native_Comp_Unit *cu)
+{
+ if (cu->handle == NULL)
+ return;
+
+ Lisp_Object *saved_cu = dynlib_sym (cu->handle, COMP_UNIT_SYM);
+ Lisp_Object this_cu;
+ XSETNATIVE_COMP_UNIT (this_cu, cu);
+ if (EQ (this_cu, *saved_cu))
+ *saved_cu = Qnil;
+ dynlib_close (cu->handle);
+}
+
+Lisp_Object
+native_function_doc (Lisp_Object function)
+{
+ struct Lisp_Native_Comp_Unit *cu =
+ XNATIVE_COMP_UNIT (Fsubr_native_comp_unit (function));
+
+ if (NILP (cu->data_fdoc_v))
+ cu->data_fdoc_v = load_static_obj (cu, TEXT_FDOC_SYM);
+ if (!VECTORP (cu->data_fdoc_v))
+ xsignal2 (Qnative_lisp_file_inconsistent, cu->file,
+ build_string ("missing documentation vector"));
+ return AREF (cu->data_fdoc_v, XSUBR (function)->doc);
+}
+
+static Lisp_Object
+make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg,
+ Lisp_Object c_name, Lisp_Object type, Lisp_Object doc_idx,
+ Lisp_Object intspec, Lisp_Object comp_u)
+{
+ struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u);
+ dynlib_handle_ptr handle = cu->handle;
+ if (!handle)
+ xsignal0 (Qwrong_register_subr_call);
+
+ void *func = dynlib_sym (handle, SSDATA (c_name));
+ eassert (func);
+ union Aligned_Lisp_Subr *x =
+ (union Aligned_Lisp_Subr *) allocate_pseudovector (
+ VECSIZE (union Aligned_Lisp_Subr),
+ 0, VECSIZE (union Aligned_Lisp_Subr),
+ PVEC_SUBR);
+ if (CONSP (minarg))
+ {
+ /* Dynamic code. */
+ x->s.lambda_list[0] = maxarg;
+ maxarg = XCDR (minarg);
+ minarg = XCAR (minarg);
+ }
+ else
+ x->s.lambda_list[0] = Qnil;
+ x->s.function.a0 = func;
+ x->s.min_args = XFIXNUM (minarg);
+ x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
+ x->s.symbol_name = xstrdup (SSDATA (symbol_name));
+ x->s.native_intspec = intspec;
+ x->s.doc = XFIXNUM (doc_idx);
+ x->s.native_comp_u[0] = comp_u;
+ x->s.native_c_name[0] = xstrdup (SSDATA (c_name));
+ x->s.type[0] = type;
+ Lisp_Object tem;
+ XSETSUBR (tem, &x->s);
+
+ return tem;
+}
+
+DEFUN ("comp--register-lambda", Fcomp__register_lambda, Scomp__register_lambda,
+ 7, 7, 0,
+ doc: /* Register anonymous lambda.
+This gets called by top_level_run during the load phase. */)
+ (Lisp_Object reloc_idx, Lisp_Object c_name, Lisp_Object minarg,
+ Lisp_Object maxarg, Lisp_Object type, Lisp_Object rest,
+ Lisp_Object comp_u)
+{
+ Lisp_Object doc_idx = FIRST (rest);
+ Lisp_Object intspec = SECOND (rest);
+ struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u);
+ if (cu->loaded_once)
+ return Qnil;
+
+ Lisp_Object tem =
+ make_subr (c_name, minarg, maxarg, c_name, type, doc_idx, intspec, comp_u);
+
+ /* We must protect it against GC because the function is not
+ reachable through symbols. */
+ Fputhash (tem, Qt, cu->lambda_gc_guard_h);
+ /* This is for fixing up the value in d_reloc while resurrecting
+ from dump. See 'dump_do_dump_relocation'. */
+ eassert (NILP (Fgethash (c_name, cu->lambda_c_name_idx_h, Qnil)));
+ Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h);
+ /* Do the real relocation fixup. */
+ cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem;
+
+ return tem;
+}
+
+DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr,
+ 7, 7, 0,
+ doc: /* Register exported subr.
+This gets called by top_level_run during the load phase. */)
+ (Lisp_Object name, Lisp_Object c_name, Lisp_Object minarg,
+ Lisp_Object maxarg, Lisp_Object type, Lisp_Object rest,
+ Lisp_Object comp_u)
+{
+ Lisp_Object doc_idx = FIRST (rest);
+ Lisp_Object intspec = SECOND (rest);
+ Lisp_Object tem =
+ make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx,
+ intspec, comp_u);
+
+ if (AUTOLOADP (XSYMBOL (name)->u.s.function))
+ /* Remember that the function was already an autoload. */
+ LOADHIST_ATTACH (Fcons (Qt, name));
+ LOADHIST_ATTACH (Fcons (Qdefun, name));
+
+ { /* Handle automatic advice activation (bug#42038).
+ See `defalias'. */
+ Lisp_Object hook = Fget (name, Qdefalias_fset_function);
+ if (!NILP (hook))
+ call2 (hook, name, tem);
+ else
+ Ffset (name, tem);
+ }
+
+ return tem;
+}
+
+DEFUN ("comp--late-register-subr", Fcomp__late_register_subr,
+ Scomp__late_register_subr, 7, 7, 0,
+ doc: /* Register exported subr.
+This gets called by late_top_level_run during the load phase. */)
+ (Lisp_Object name, Lisp_Object c_name, Lisp_Object minarg,
+ Lisp_Object maxarg, Lisp_Object type, Lisp_Object rest,
+ Lisp_Object comp_u)
+{
+ if (!NILP (Fequal (Fsymbol_function (name),
+ Fgethash (name, Vcomp_deferred_pending_h, Qnil))))
+ Fcomp__register_subr (name, c_name, minarg, maxarg, type, rest, comp_u);
+ Fremhash (name, Vcomp_deferred_pending_h);
+ return Qnil;
+}
+
+static bool
+file_in_eln_sys_dir (Lisp_Object filename)
+{
+ Lisp_Object eln_sys_dir = Qnil;
+ Lisp_Object tmp = Vnative_comp_eln_load_path;
+ FOR_EACH_TAIL (tmp)
+ eln_sys_dir = XCAR (tmp);
+ return !NILP (Fstring_match (Fregexp_quote (Fexpand_file_name (eln_sys_dir,
+ Qnil)),
+ Fexpand_file_name (filename, Qnil), Qnil));
+}
+
+/* Load related routines. */
+DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
+ doc: /* Load native elisp code FILENAME.
+LATE_LOAD has to be non-nil when loading for deferred compilation. */)
+ (Lisp_Object filename, Lisp_Object late_load)
+{
+ CHECK_STRING (filename);
+ if (NILP (Ffile_exists_p (filename)))
+ xsignal2 (Qnative_lisp_load_failed, build_string ("file does not exists"),
+ filename);
+ struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit ();
+ Lisp_Object encoded_filename = ENCODE_FILE (filename);
+
+ if (!NILP (Fgethash (filename, all_loaded_comp_units_h, Qnil))
+ && !file_in_eln_sys_dir (filename)
+ && !NILP (Ffile_writable_p (filename)))
+ {
+ /* If in this session there was ever a file loaded with this
+ name, rename it before loading, to make sure we always get a
+ new handle! */
+ Lisp_Object tmp_filename =
+ Fmake_temp_file_internal (filename, Qnil, build_string (".eln.tmp"),
+ Qnil);
+ if (NILP (Ffile_writable_p (tmp_filename)))
+ comp_u->handle = dynlib_open (SSDATA (encoded_filename));
+ else
+ {
+ Frename_file (filename, tmp_filename, Qt);
+ comp_u->handle = dynlib_open (SSDATA (ENCODE_FILE (tmp_filename)));
+ Frename_file (tmp_filename, filename, Qnil);
+ }
+ }
+ else
+ comp_u->handle = dynlib_open (SSDATA (encoded_filename));
+
+ if (!comp_u->handle)
+ xsignal2 (Qnative_lisp_load_failed, filename,
+ build_string (dynlib_error ()));
+ comp_u->file = filename;
+ comp_u->data_vec = Qnil;
+ comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq);
+ comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+ return load_comp_unit (comp_u, false, !NILP (late_load));
+}
+
+#endif /* HAVE_NATIVE_COMP */
+
+DEFUN ("native-comp-available-p", Fnative_comp_available_p,
+ Snative_comp_available_p, 0, 0, 0,
+ doc: /* Return non-nil if native compilation support is built-in. */)
+ (void)
+{
+#ifdef HAVE_NATIVE_COMP
+ return load_gccjit_if_necessary (false) ? Qt : Qnil;
+#else
+ return Qnil;
+#endif
+}
+
+
+void
+syms_of_comp (void)
+{
+#ifdef HAVE_NATIVE_COMP
+ /* Compiler control customizes. */
+ DEFVAR_BOOL ("native-comp-deferred-compilation",
+ native_comp_deferred_compilation,
+ doc: /* If non-nil compile loaded .elc files asynchronously.
+
+After compilation, each function definition is updated to the native
+compiled one. */);
+ native_comp_deferred_compilation = true;
+
+ DEFSYM (Qnative_comp_speed, "native-comp-speed");
+ DEFSYM (Qnative_comp_debug, "native-comp-debug");
+ DEFSYM (Qnative_comp_driver_options, "native-comp-driver-options");
+ DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer");
+
+ /* Limple instruction set. */
+ DEFSYM (Qcomment, "comment");
+ DEFSYM (Qjump, "jump");
+ DEFSYM (Qcall, "call");
+ DEFSYM (Qcallref, "callref");
+ DEFSYM (Qdirect_call, "direct-call");
+ DEFSYM (Qdirect_callref, "direct-callref");
+ DEFSYM (Qassume, "assume");
+ DEFSYM (Qsetimm, "setimm");
+ DEFSYM (Qreturn, "return");
+ DEFSYM (Qunreachable, "unreachable");
+ DEFSYM (Qcomp_mvar, "comp-mvar");
+ DEFSYM (Qcond_jump, "cond-jump");
+ DEFSYM (Qphi, "phi");
+ /* Ops in use for prologue emission. */
+ DEFSYM (Qset_par_to_local, "set-par-to-local");
+ DEFSYM (Qset_args_to_local, "set-args-to-local");
+ DEFSYM (Qset_rest_args_to_local, "set-rest-args-to-local");
+ DEFSYM (Qinc_args, "inc-args");
+ DEFSYM (Qcond_jump_narg_leq, "cond-jump-narg-leq");
+ /* Others. */
+ DEFSYM (Qpush_handler, "push-handler");
+ DEFSYM (Qpop_handler, "pop-handler");
+ DEFSYM (Qfetch_handler, "fetch-handler");
+ DEFSYM (Qcondition_case, "condition-case");
+ /* call operands. */
+ DEFSYM (Qcatcher, "catcher");
+ DEFSYM (Qentry, "entry");
+ DEFSYM (Qset_internal, "set_internal");
+ DEFSYM (Qrecord_unwind_current_buffer, "record_unwind_current_buffer");
+ DEFSYM (Qrecord_unwind_protect_excursion, "record_unwind_protect_excursion");
+ DEFSYM (Qhelper_unbind_n, "helper_unbind_n");
+ DEFSYM (Qhelper_unwind_protect, "helper_unwind_protect");
+ DEFSYM (Qhelper_save_restriction, "helper_save_restriction");
+ /* Inliners. */
+ DEFSYM (Qadd1, "1+");
+ DEFSYM (Qsub1, "1-");
+ DEFSYM (Qconsp, "consp");
+ DEFSYM (Qcar, "car");
+ DEFSYM (Qcdr, "cdr");
+ DEFSYM (Qsetcar, "setcar");
+ DEFSYM (Qsetcdr, "setcdr");
+ DEFSYM (Qnegate, "negate");
+ DEFSYM (Qnumberp, "numberp");
+ DEFSYM (Qintegerp, "integerp");
+ DEFSYM (Qcomp_maybe_gc_or_quit, "comp-maybe-gc-or-quit");
+
+ /* Allocation classes. */
+ DEFSYM (Qd_default, "d-default");
+ DEFSYM (Qd_impure, "d-impure");
+ DEFSYM (Qd_ephemeral, "d-ephemeral");
+
+ /* Others. */
+ DEFSYM (Qcomp, "comp");
+ DEFSYM (Qfixnum, "fixnum");
+ DEFSYM (Qscratch, "scratch");
+ DEFSYM (Qlate, "late");
+ DEFSYM (Qlambda_fixup, "lambda-fixup");
+ DEFSYM (Qgccjit, "gccjit");
+ DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install");
+ DEFSYM (Qnative_comp_warning_on_missing_source,
+ "native-comp-warning-on-missing-source");
+
+ /* To be signaled by the compiler. */
+ DEFSYM (Qnative_compiler_error, "native-compiler-error");
+ Fput (Qnative_compiler_error, Qerror_conditions,
+ pure_list (Qnative_compiler_error, Qerror));
+ Fput (Qnative_compiler_error, Qerror_message,
+ build_pure_c_string ("Native compiler error"));
+
+ DEFSYM (Qnative_ice, "native-ice");
+ Fput (Qnative_ice, Qerror_conditions,
+ pure_list (Qnative_ice, Qnative_compiler_error, Qerror));
+ Fput (Qnative_ice, Qerror_message,
+ build_pure_c_string ("Internal native compiler error"));
+
+ /* By the load machinery. */
+ DEFSYM (Qnative_lisp_load_failed, "native-lisp-load-failed");
+ Fput (Qnative_lisp_load_failed, Qerror_conditions,
+ pure_list (Qnative_lisp_load_failed, Qerror));
+ Fput (Qnative_lisp_load_failed, Qerror_message,
+ build_pure_c_string ("Native elisp load failed"));
+
+ DEFSYM (Qnative_lisp_wrong_reloc, "native-lisp-wrong-reloc");
+ Fput (Qnative_lisp_wrong_reloc, Qerror_conditions,
+ pure_list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror));
+ Fput (Qnative_lisp_wrong_reloc, Qerror_message,
+ build_pure_c_string ("Primitive redefined or wrong relocation"));
+
+ DEFSYM (Qwrong_register_subr_call, "wrong-register-subr-call");
+ Fput (Qwrong_register_subr_call, Qerror_conditions,
+ pure_list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror));
+ Fput (Qwrong_register_subr_call, Qerror_message,
+ build_pure_c_string ("comp--register-subr can only be called during "
+ "native lisp load phase."));
+
+ DEFSYM (Qnative_lisp_file_inconsistent, "native-lisp-file-inconsistent");
+ Fput (Qnative_lisp_file_inconsistent, Qerror_conditions,
+ pure_list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror));
+ Fput (Qnative_lisp_file_inconsistent, Qerror_message,
+ build_pure_c_string ("eln file inconsistent with current runtime "
+ "configuration, please recompile"));
+
+ defsubr (&Scomp__subr_signature);
+ defsubr (&Scomp_el_to_eln_rel_filename);
+ defsubr (&Scomp_el_to_eln_filename);
+ defsubr (&Scomp_native_driver_options_effective_p);
+ defsubr (&Scomp__install_trampoline);
+ defsubr (&Scomp__init_ctxt);
+ defsubr (&Scomp__release_ctxt);
+ defsubr (&Scomp__compile_ctxt_to_file);
+ defsubr (&Scomp_libgccjit_version);
+ defsubr (&Scomp__register_lambda);
+ defsubr (&Scomp__register_subr);
+ defsubr (&Scomp__late_register_subr);
+ defsubr (&Snative_elisp_load);
+
+ staticpro (&comp.exported_funcs_h);
+ comp.exported_funcs_h = Qnil;
+ staticpro (&comp.imported_funcs_h);
+ comp.imported_funcs_h = Qnil;
+ staticpro (&comp.func_blocks_h);
+ staticpro (&comp.emitter_dispatcher);
+ comp.emitter_dispatcher = Qnil;
+ staticpro (&delayed_sources);
+ delayed_sources = Qnil;
+ staticpro (&loadsearch_re_list);
+ loadsearch_re_list = Qnil;
+
+ staticpro (&all_loaded_comp_units_h);
+ all_loaded_comp_units_h =
+ CALLN (Fmake_hash_table, QCweakness, Qkey_and_value, QCtest, Qequal);
+
+ DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt,
+ doc: /* The compiler context. */);
+ Vcomp_ctxt = Qnil;
+
+ /* FIXME should be initialized but not here... Plus this don't have
+ to be necessarily exposed to lisp but can easy debug for now. */
+ DEFVAR_LISP ("comp-subr-list", Vcomp_subr_list,
+ doc: /* List of all defined subrs. */);
+ DEFVAR_LISP ("comp-abi-hash", Vcomp_abi_hash,
+ doc: /* String signing the .eln files ABI. */);
+ Vcomp_abi_hash = Qnil;
+ DEFVAR_LISP ("comp-native-version-dir", Vcomp_native_version_dir,
+ doc: /* Directory in use to disambiguate eln compatibility. */);
+ Vcomp_native_version_dir = Qnil;
+
+ DEFVAR_LISP ("comp-deferred-pending-h", Vcomp_deferred_pending_h,
+ doc: /* Hash table symbol-name -> function-value.
+For internal use. */);
+ Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq);
+
+ DEFVAR_LISP ("comp-eln-to-el-h", Vcomp_eln_to_el_h,
+ doc: /* Hash table eln-filename -> el-filename. */);
+ Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+
+ DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path,
+ doc: /* List of eln cache directories.
+
+If a directory is non absolute is assumed to be relative to
+`invocation-directory'.
+`comp-native-version-dir' value is used as a sub-folder name inside
+each eln cache directory.
+The last directory of this list is assumed to be the system one. */);
+
+ /* Temporary value in use for bootstrap. We can't do better as
+ `invocation-directory' is still unset, will be fixed up during
+ dump reload. */
+ Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
+
+ DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines,
+ doc: /* If non-nil enable primitive trampoline synthesis.
+This makes primitive functions redefinable or advisable effectively. */);
+
+ DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
+ doc: /* Hash table subr-name -> installed trampoline.
+This is used to prevent double trampoline instantiation but also to
+protect the trampolines against GC. */);
+ Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table);
+
+ DEFVAR_LISP ("comp-no-native-file-h", V_comp_no_native_file_h,
+ doc: /* Files for which no deferred compilation has to
+be performed because the bytecode version was explicitly requested by
+the user during load.
+For internal use. */);
+ V_comp_no_native_file_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+
+ DEFVAR_BOOL ("comp-file-preloaded-p", comp_file_preloaded_p,
+ doc: /* When non-nil assume the file being compiled to
+be preloaded. */);
+
+ Fprovide (intern_c_string ("native-compile"), Qnil);
+#endif /* #ifdef HAVE_NATIVE_COMP */
+
+ defsubr (&Snative_comp_available_p);
+}
diff --git a/src/comp.h b/src/comp.h
new file mode 100644
index 00000000000..c4af4193d0b
--- /dev/null
+++ b/src/comp.h
@@ -0,0 +1,114 @@
+/* Elisp native compiler definitions
+
+Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(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/>. */
+
+#ifndef COMP_H
+#define COMP_H
+
+/* To keep ifdefs under control. */
+enum {
+ NATIVE_COMP_FLAG =
+#ifdef HAVE_NATIVE_COMP
+ 1
+#else
+ 0
+#endif
+};
+
+#include <dynlib.h>
+
+struct Lisp_Native_Comp_Unit
+{
+ union vectorlike_header header;
+ /* The original eln file loaded. In the pdumper file this is stored
+ as a cons cell of 2 alternative file names: the car is the
+ filename relative to the directory of an installed binary, the
+ cdr is the filename relative to the directory of an uninstalled
+ binary. This is arranged in loadup.el. */
+ Lisp_Object file;
+ Lisp_Object optimize_qualities;
+ /* Guard anonymous lambdas against Garbage Collection and serve
+ sanity checks. */
+ Lisp_Object lambda_gc_guard_h;
+ /* Hash c_name -> d_reloc_imp index. */
+ Lisp_Object lambda_c_name_idx_h;
+ /* Hash doc-idx -> function documentation. */
+ Lisp_Object data_fdoc_v;
+ /* Analogous to the constant vector but per compilation unit. */
+ Lisp_Object data_vec;
+ /* 'data_impure_vec' must be last (see allocate_native_comp_unit).
+ Same as data_vec but for data that cannot be moved to pure space. */
+ Lisp_Object data_impure_vec;
+ /* STUFFS WE DO NOT DUMP!! */
+ Lisp_Object *data_imp_relocs;
+ bool loaded_once;
+ bool load_ongoing;
+ dynlib_handle_ptr handle;
+} GCALIGNED_STRUCT;
+
+#ifdef HAVE_NATIVE_COMP
+
+INLINE bool
+NATIVE_COMP_UNITP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_NATIVE_COMP_UNIT);
+}
+
+INLINE struct Lisp_Native_Comp_Unit *
+XNATIVE_COMP_UNIT (Lisp_Object a)
+{
+ eassert (NATIVE_COMP_UNITP (a));
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Native_Comp_Unit);
+}
+
+/* Defined in comp.c. */
+
+extern void hash_native_abi (void);
+
+extern Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u,
+ bool loading_dump, bool late_load);
+
+extern void unload_comp_unit (struct Lisp_Native_Comp_Unit *);
+
+extern Lisp_Object native_function_doc (Lisp_Object function);
+
+extern void syms_of_comp (void);
+
+extern void maybe_defer_native_compilation (Lisp_Object function_name,
+ Lisp_Object definition);
+
+extern void eln_load_path_final_clean_up (void);
+
+extern void fixup_eln_load_path (Lisp_Object directory);
+
+#else /* #ifdef HAVE_NATIVE_COMP */
+
+static inline void
+maybe_defer_native_compilation (Lisp_Object function_name,
+ Lisp_Object definition)
+{}
+
+static inline
+void unload_comp_unit (struct Lisp_Native_Comp_Unit *cu)
+{}
+
+extern void syms_of_comp (void);
+
+#endif /* #ifdef HAVE_NATIVE_COMP */
+
+#endif /* #ifndef COMP_H */
diff --git a/src/composite.c b/src/composite.c
index f1c011223b2..e97f8e2b4cd 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -953,8 +953,29 @@ char_composable_p (int c)
Lisp_Object val;
return (c >= ' '
&& (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
- || (val = CHAR_TABLE_REF (Vunicode_category_table, c),
- (FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs)))));
+ /* unicode-category-table may not be available during
+ dumping. */
+ || (CHAR_TABLE_P (Vunicode_category_table)
+ && (val = CHAR_TABLE_REF (Vunicode_category_table, c),
+ (FIXNUMP (val)
+ && (XFIXNUM (val) <= UNICODE_CATEGORY_Zs))))));
+}
+
+static inline bool
+inhibit_auto_composition (void)
+{
+ if (NILP (Vauto_composition_mode))
+ return true;
+
+ if (STRINGP (Vauto_composition_mode))
+ {
+ char *name = tty_type_name (Qnil);
+
+ if (name && ! strcmp (SSDATA (Vauto_composition_mode), name))
+ return true;
+ }
+
+ return false;
}
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
@@ -1011,7 +1032,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
cmp_it->ch = -1;
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- || NILP (Vauto_composition_mode))
+ || inhibit_auto_composition ())
return;
if (bytepos < 0)
{
@@ -1469,14 +1490,60 @@ struct position_record
(POSITION).pos--; \
} while (0)
-/* This is like find_composition, but find an automatic composition
- instead. It is assured that POS is not within a static
- composition. If found, set *GSTRING to the glyph-string
- representing the composition, and return true. Otherwise, *GSTRING to
- Qnil, and return false. */
+/* Similar to find_composition, but find an automatic composition instead.
+
+ This function looks for automatic composition at or near position
+ POS of OBJECT (a buffer or a string). OBJECT defaults to the
+ current buffer. It must be assured that POS is not within a static
+ composition. Also, the current buffer must be displayed in some
+ window, otherwise the function will return FALSE.
+
+ If LIMIT is negative, and there's no composition that includes POS
+ (i.e. starts at or before POS and ends at or after POS), return
+ FALSE. In this case, the function is allowed to look from POS as
+ far back as BACKLIM, and as far forward as POS+1 plus
+ MAX_AUTO_COMPOSITION_LOOKBACK, the maximum number of look-back for
+ automatic compositions (3) -- this is a limitation imposed by
+ composition rules in composition-function-table, which see. If
+ BACKLIM is negative, it stands for the beginning of OBJECT: BEGV
+ for a buffer or position zero for a string.
+
+ If LIMIT is positive, search for a composition forward (LIMIT >
+ POS) or backward (LIMIT < POS). In this case, LIMIT bounds the
+ search for the first character of a composed sequence.
+ (LIMIT == POS is the same as LIMIT < 0.) If LIMIT > POS, the
+ function can find a composition that starts after POS.
+
+ BACKLIM limits how far back is the function allowed to look in
+ OBJECT while trying to find a position where it is safe to start
+ searching forward for compositions. Such a safe place is generally
+ the position after a character that can never be composed.
+
+ If BACKLIM is negative, that means the first character position of
+ OBJECT; this is useful when calling the function for the first time
+ for a given buffer or string, since it is possible that a
+ composition begins before POS. However, if POS is very far from
+ the beginning of OBJECT, a negative value of BACKLIM could make the
+ function slow. Also, in this case the function may return START
+ and END that do not include POS, something that is not necessarily
+ wanted, and needs to be explicitly checked by the caller.
+
+ When calling the function in a loop for the same buffer/string, the
+ caller should generally set BACKLIM equal to POS, to avoid costly
+ repeated searches backward. This is because if the previous
+ positions were already checked for compositions, there should be no
+ reason to re-check them.
+
+ If BACKLIM is positive, it must be less or equal to LIMIT.
+
+ If an automatic composition satisfying the above conditions is
+ found, set *GSTRING to the Lispy glyph-string representing the
+ composition, set *START and *END to the start and end of the
+ composed sequence, and return TRUE. Otherwise, set *GSTRING to
+ nil, and return FALSE. */
-static bool
-find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
+bool
+find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit, ptrdiff_t backlim,
ptrdiff_t *start, ptrdiff_t *end,
Lisp_Object *gstring, Lisp_Object string)
{
@@ -1498,13 +1565,13 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
cur.pos = pos;
if (NILP (string))
{
- head = BEGV, tail = ZV, stop = GPT;
+ head = backlim < 0 ? BEGV : backlim, tail = ZV, stop = GPT;
cur.pos_byte = CHAR_TO_BYTE (cur.pos);
cur.p = BYTE_POS_ADDR (cur.pos_byte);
}
else
{
- head = 0, tail = SCHARS (string), stop = -1;
+ head = backlim < 0 ? 0 : backlim, tail = SCHARS (string), stop = -1;
cur.pos_byte = string_char_to_byte (string, cur.pos);
cur.p = SDATA (string) + cur.pos_byte;
}
@@ -1512,6 +1579,9 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
/* Finding a composition covering the character after POS is the
same as setting LIMIT to POS. */
limit = pos;
+
+ eassert (backlim < 0 || backlim <= limit);
+
if (limit <= pos)
fore_check_limit = min (tail, pos + 1 + MAX_AUTO_COMPOSITION_LOOKBACK);
else
@@ -1688,12 +1758,12 @@ composition_adjust_point (ptrdiff_t last_pt, ptrdiff_t new_pt)
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters))
- || NILP (Vauto_composition_mode))
+ || inhibit_auto_composition ())
return new_pt;
/* Next check the automatic composition. */
- if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, &beg, &end, &val,
- Qnil)
+ if (! find_automatic_composition (new_pt, (ptrdiff_t) -1, (ptrdiff_t) -1,
+ &beg, &end, &val, Qnil)
|| beg == new_pt)
return new_pt;
for (i = 0; i < LGSTRING_GLYPH_LEN (val); i++)
@@ -1888,9 +1958,9 @@ See `find-composition' for more details. */)
if (!find_composition (from, to, &start, &end, &prop, string))
{
if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! NILP (Vauto_composition_mode)
- && find_automatic_composition (from, to, &start, &end, &gstring,
- string))
+ && ! inhibit_auto_composition ()
+ && find_automatic_composition (from, to, (ptrdiff_t) -1,
+ &start, &end, &gstring, string))
return list3 (make_fixnum (start), make_fixnum (end), gstring);
return Qnil;
}
@@ -1898,7 +1968,8 @@ See `find-composition' for more details. */)
{
ptrdiff_t s, e;
- if (find_automatic_composition (from, to, &s, &e, &gstring, string)
+ if (find_automatic_composition (from, to, (ptrdiff_t) -1,
+ &s, &e, &gstring, string)
&& (e <= fixed_pos ? e > end : s < start))
return list3 (make_fixnum (s), make_fixnum (e), gstring);
}
@@ -1986,7 +2057,10 @@ The default value is the function `compose-chars-after'. */);
DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode,
doc: /* Non-nil if Auto-Composition mode is enabled.
-Use the command `auto-composition-mode' to change this variable. */);
+Use the command `auto-composition-mode' to change this variable.
+
+If this variable is a string, `auto-composition-mode' will be disabled in
+buffers displayed on a terminal whose type compares equal to this string. */);
Vauto_composition_mode = Qt;
DEFVAR_LISP ("auto-composition-function", Vauto_composition_function,
diff --git a/src/composite.h b/src/composite.h
index c5d3c0faabb..67e87201bf2 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -246,6 +246,11 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop)
/* Macros for lispy glyph-string. This is completely different from
struct glyph_string. */
+/* LGSTRING is a string of font glyphs, LGLYPHs. It is represented as
+ a Lisp vector, with components shown below. Once LGSTRING was
+ processed by a shaping engine, it holds font glyphs for one or more
+ grapheme clusters. */
+
#define LGSTRING_HEADER(lgs) AREF (lgs, 0)
#define LGSTRING_SET_HEADER(lgs, header) ASET (lgs, 0, header)
@@ -259,6 +264,10 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop)
#define LGSTRING_ID(lgs) AREF (lgs, 1)
#define LGSTRING_SET_ID(lgs, id) ASET (lgs, 1, id)
+/* LGSTRING_GLYPH_LEN is the maximum number of LGLYPHs that the
+ LGSTRING can hold. This is NOT the actual number of valid LGLYPHs;
+ to find the latter, walk the glyphs returned by LGSTRING_GLYPH
+ until the first one that is nil. */
#define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2)
#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2)
#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val))
@@ -278,6 +287,14 @@ enum lglyph_indices
LGLYPH_SIZE
};
+/* Each LGLYPH is a single font glyph, whose font code is in
+ LGLYPH_CODE.
+ LGLYPH_FROM and LGLYPH_TO are indices into LGSTRING; all the
+ LGLYPHs that share the same values of LGLYPH_FROM and LGLYPH_TO
+ belong to the same grapheme cluster.
+ LGLYPH_CHAR is one of the characters, usually the first one, that
+ contributed to the glyph (since there isn't a 1:1 correspondence
+ between composed characters and the font glyphs). */
#define LGLYPH_NEW() make_nil_vector (LGLYPH_SIZE)
#define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM))
#define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO))
@@ -320,6 +337,10 @@ extern bool composition_gstring_p (Lisp_Object);
extern int composition_gstring_width (Lisp_Object, ptrdiff_t, ptrdiff_t,
struct font_metrics *);
+extern bool find_automatic_composition (ptrdiff_t, ptrdiff_t, ptrdiff_t,
+ ptrdiff_t *, ptrdiff_t *,
+ Lisp_Object *, Lisp_Object);
+
extern void composition_compute_stop_pos (struct composition_it *,
ptrdiff_t, ptrdiff_t, ptrdiff_t,
Lisp_Object);
diff --git a/src/conf_post.h b/src/conf_post.h
index 176ab28b21a..8558dc466cc 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -99,10 +99,28 @@ typedef bool bool_bf;
# define ADDRESS_SANITIZER false
#endif
+#ifdef emacs
+/* We include stdlib.h here, because Gnulib's stdlib.h might redirect
+ 'free' to its replacement, and we want to avoid that in unexec
+ builds. Inclduing it here will render its inclusion after config.h
+ a no-op. */
+# if (defined DARWIN_OS && defined HAVE_UNEXEC) || defined HYBRID_MALLOC
+# include <stdlib.h>
+# endif
+#endif
+
#if defined DARWIN_OS && defined emacs && defined HAVE_UNEXEC
+# undef malloc
# define malloc unexec_malloc
+# undef realloc
# define realloc unexec_realloc
+# undef free
# define free unexec_free
+
+extern void *unexec_malloc (size_t);
+extern void *unexec_realloc (void *, size_t);
+extern void unexec_free (void *);
+
#endif
/* If HYBRID_MALLOC is defined (e.g., on Cygwin), emacs will use
@@ -111,12 +129,23 @@ typedef bool bool_bf;
accomplish this. */
#ifdef HYBRID_MALLOC
#ifdef emacs
+#undef malloc
#define malloc hybrid_malloc
+#undef realloc
#define realloc hybrid_realloc
+#undef aligned_alloc
#define aligned_alloc hybrid_aligned_alloc
+#undef calloc
#define calloc hybrid_calloc
+#undef free
#define free hybrid_free
-#endif
+
+extern void *hybrid_malloc (size_t);
+extern void *hybrid_calloc (size_t, size_t);
+extern void hybrid_free (void *);
+extern void *hybrid_aligned_alloc (size_t, size_t);
+extern void *hybrid_realloc (void *, size_t);
+#endif /* emacs */
#endif /* HYBRID_MALLOC */
/* We have to go this route, rather than the old hpux9 approach of
diff --git a/src/data.c b/src/data.c
index 38cde0ff8b2..ffca7e75355 100644
--- a/src/data.c
+++ b/src/data.c
@@ -88,12 +88,6 @@ XOBJFWD (lispfwd a)
}
static void
-CHECK_SUBR (Lisp_Object x)
-{
- CHECK_TYPE (SUBRP (x), Qsubrp, x);
-}
-
-static void
set_blv_found (struct Lisp_Buffer_Local_Value *blv, int found)
{
eassert (found == !EQ (blv->defcell, blv->valcell));
@@ -259,6 +253,8 @@ for example, (type-of 1) returns `integer'. */)
}
case PVEC_MODULE_FUNCTION:
return Qmodule_function;
+ case PVEC_NATIVE_COMP_UNIT:
+ return Qnative_comp_unit;
case PVEC_XWIDGET:
return Qxwidget;
case PVEC_XWIDGET_VIEW:
@@ -585,8 +581,8 @@ DEFUN ("condition-variable-p", Fcondition_variable_p, Scondition_variable_p,
/* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0,
- doc: /* Return the car of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `car-safe'.
+ doc: /* Return the car of LIST. If LIST is nil, return nil.
+Error if LIST is not nil and not a cons cell. See also `car-safe'.
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as car, cdr, cons cell and list. */)
@@ -603,8 +599,8 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
}
DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
- doc: /* Return the cdr of LIST. If arg is nil, return nil.
-Error if arg is not nil and not a cons cell. See also `cdr-safe'.
+ doc: /* Return the cdr of LIST. If LIST is nil, return nil.
+Error if LIST is not nil and not a cons cell. See also `cdr-safe'.
See Info node `(elisp)Cons Cells' for a discussion of related basic
Lisp concepts such as cdr, car, cons cell and list. */)
@@ -779,6 +775,13 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
eassert (valid_lisp_object_p (definition));
+#ifdef HAVE_NATIVE_COMP
+ if (comp_enable_subr_trampolines
+ && SUBRP (function)
+ && !SUBR_NATIVE_COMPILEDP (function))
+ CALLN (Ffuncall, Qcomp_subr_trampoline_install, symbol);
+#endif
+
set_symbol_function (symbol, definition);
return definition;
@@ -824,6 +827,8 @@ The return value is undefined. */)
Ffset (symbol, definition);
}
+ maybe_defer_native_compilation (symbol, definition);
+
if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring);
/* We used to return `definition', but now that `defun' and `defmacro' expand
@@ -870,6 +875,72 @@ SUBR must be a built-in function. */)
return build_string (name);
}
+DEFUN ("subr-native-elisp-p", Fsubr_native_elisp_p, Ssubr_native_elisp_p, 1, 1,
+ 0, doc: /* Return t if the object is native compiled lisp
+function, nil otherwise. */)
+ (Lisp_Object object)
+{
+ return SUBR_NATIVE_COMPILEDP (object) ? Qt : Qnil;
+}
+
+DEFUN ("subr-native-lambda-list", Fsubr_native_lambda_list,
+ Ssubr_native_lambda_list, 1, 1, 0,
+ doc: /* Return the lambda list for a native compiled lisp/d
+function or t otherwise. */)
+ (Lisp_Object subr)
+{
+ CHECK_SUBR (subr);
+
+ return SUBR_NATIVE_COMPILED_DYNP (subr)
+ ? XSUBR (subr)->lambda_list[0]
+ : Qt;
+}
+
+DEFUN ("subr-type", Fsubr_type,
+ Ssubr_type, 1, 1, 0,
+ doc: /* Return the type of SUBR. */)
+ (Lisp_Object subr)
+{
+ CHECK_SUBR (subr);
+#ifdef HAVE_NATIVE_COMP
+ return SUBR_TYPE (subr);
+#else
+ return Qnil;
+#endif
+}
+
+#ifdef HAVE_NATIVE_COMP
+
+DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit,
+ Ssubr_native_comp_unit, 1, 1, 0,
+ doc: /* Return the native compilation unit. */)
+ (Lisp_Object subr)
+{
+ CHECK_SUBR (subr);
+ return XSUBR (subr)->native_comp_u[0];
+}
+
+DEFUN ("native-comp-unit-file", Fnative_comp_unit_file,
+ Snative_comp_unit_file, 1, 1, 0,
+ doc: /* Return the file of the native compilation unit. */)
+ (Lisp_Object comp_unit)
+{
+ CHECK_TYPE (NATIVE_COMP_UNITP (comp_unit), Qnative_comp_unit, comp_unit);
+ return XNATIVE_COMP_UNIT (comp_unit)->file;
+}
+
+DEFUN ("native-comp-unit-set-file", Fnative_comp_unit_set_file,
+ Snative_comp_unit_set_file, 2, 2, 0,
+ doc: /* Return the file of the native compilation unit. */)
+ (Lisp_Object comp_unit, Lisp_Object new_file)
+{
+ CHECK_TYPE (NATIVE_COMP_UNITP (comp_unit), Qnative_comp_unit, comp_unit);
+ XNATIVE_COMP_UNIT (comp_unit)->file = new_file;
+ return comp_unit;
+}
+
+#endif
+
DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
doc: /* Return the interactive form of CMD or nil if none.
If CMD is not a command, the return value is nil.
@@ -895,6 +966,9 @@ Value, if non-nil, is a list (interactive SPEC). */)
if (SUBRP (fun))
{
+ if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->native_intspec))
+ return XSUBR (fun)->native_intspec;
+
const char *spec = XSUBR (fun)->intspec;
if (spec)
return list2 (Qinteractive,
@@ -904,7 +978,17 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (COMPILEDP (fun))
{
if (PVSIZE (fun) > COMPILED_INTERACTIVE)
- return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
+ {
+ Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ if (VECTORP (form))
+ /* The vector form is the new form, where the first
+ element is the interactive spec, and the second is the
+ command modes. */
+ return list2 (Qinteractive, AREF (form, 0));
+ else
+ /* Old form -- just the interactive spec. */
+ return list2 (Qinteractive, form);
+ }
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
@@ -920,10 +1004,83 @@ Value, if non-nil, is a list (interactive SPEC). */)
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qclosure))
- return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
- else if (EQ (funcar, Qlambda))
- return Fassq (Qinteractive, Fcdr (XCDR (fun)));
+ if (EQ (funcar, Qclosure)
+ || EQ (funcar, Qlambda))
+ {
+ Lisp_Object form = Fcdr (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ form = Fcdr (form);
+ Lisp_Object spec = Fassq (Qinteractive, form);
+ if (NILP (Fcdr (Fcdr (spec))))
+ return spec;
+ else
+ return list2 (Qinteractive, Fcar (Fcdr (spec)));
+ }
+ }
+ return Qnil;
+}
+
+DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0,
+ doc: /* Return the modes COMMAND is defined for.
+If COMMAND is not a command, the return value is nil.
+The value, if non-nil, is a list of mode name symbols. */)
+ (Lisp_Object command)
+{
+ Lisp_Object fun = indirect_function (command); /* Check cycles. */
+
+ if (NILP (fun))
+ return Qnil;
+
+ /* Use a `command-modes' property if present, analogous to the
+ function-documentation property. */
+ fun = command;
+ while (SYMBOLP (fun))
+ {
+ Lisp_Object modes = Fget (fun, Qcommand_modes);
+ if (!NILP (modes))
+ return modes;
+ else
+ fun = Fsymbol_function (fun);
+ }
+
+ if (COMPILEDP (fun))
+ {
+ Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
+ if (VECTORP (form))
+ /* New form -- the second element is the command modes. */
+ return AREF (form, 1);
+ else
+ /* Old .elc file -- no command modes. */
+ return Qnil;
+ }
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (fun))
+ {
+ Lisp_Object form
+ = module_function_command_modes (XMODULE_FUNCTION (fun));
+ if (! NILP (form))
+ return form;
+ }
+#endif
+ else if (AUTOLOADP (fun))
+ {
+ Lisp_Object modes = Fnth (make_int (3), fun);
+ if (CONSP (modes))
+ return modes;
+ else
+ return Qnil;
+ }
+ else if (CONSP (fun))
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qclosure)
+ || EQ (funcar, Qlambda))
+ {
+ Lisp_Object form = Fcdr (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ form = Fcdr (form);
+ return Fcdr (Fcdr (Fassq (Qinteractive, form)));
+ }
}
return Qnil;
}
@@ -1506,6 +1663,7 @@ All writes to aliases of SYMBOL will call WATCH-FUNCTION too. */)
(Lisp_Object symbol, Lisp_Object watch_function)
{
symbol = Findirect_variable (symbol);
+ CHECK_SYMBOL (symbol);
set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
map_obarray (Vobarray, harmonize_variable_watchers, symbol);
@@ -2042,7 +2200,9 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
1, 2, 0,
doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
-BUFFER defaults to the current buffer. */)
+BUFFER defaults to the current buffer.
+
+Also see `buffer-local-boundp'.*/)
(Lisp_Object variable, Lisp_Object buffer)
{
struct buffer *buf = decode_buffer (buffer);
@@ -3741,6 +3901,7 @@ syms_of_data (void)
DEFSYM (Qerror, "error");
DEFSYM (Quser_error, "user-error");
DEFSYM (Qquit, "quit");
+ DEFSYM (Qminibuffer_quit, "minibuffer-quit");
DEFSYM (Qwrong_length_argument, "wrong-length-argument");
DEFSYM (Qwrong_type_argument, "wrong-type-argument");
DEFSYM (Qargs_out_of_range, "args-out-of-range");
@@ -3813,6 +3974,7 @@ syms_of_data (void)
Fput (sym, Qerror_message, build_pure_c_string (msg))
PUT_ERROR (Qquit, Qnil, "Quit");
+ PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit");
PUT_ERROR (Quser_error, error_tail, "");
PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");
@@ -3877,6 +4039,7 @@ syms_of_data (void)
DEFSYM (Qoverlay, "overlay");
DEFSYM (Qfinalizer, "finalizer");
DEFSYM (Qmodule_function, "module-function");
+ DEFSYM (Qnative_comp_unit, "native-comp-unit");
DEFSYM (Quser_ptr, "user-ptr");
DEFSYM (Qfloat, "float");
DEFSYM (Qwindow_configuration, "window-configuration");
@@ -3906,8 +4069,11 @@ syms_of_data (void)
DEFSYM (Qinteractive_form, "interactive-form");
DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
+ DEFSYM (Qbyte_code_function_p, "byte-code-function-p");
+
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
+ defsubr (&Scommand_modes);
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
@@ -3998,6 +4164,14 @@ syms_of_data (void)
defsubr (&Sbyteorder);
defsubr (&Ssubr_arity);
defsubr (&Ssubr_name);
+ defsubr (&Ssubr_native_elisp_p);
+ defsubr (&Ssubr_native_lambda_list);
+ defsubr (&Ssubr_type);
+#ifdef HAVE_NATIVE_COMP
+ defsubr (&Ssubr_native_comp_unit);
+ defsubr (&Snative_comp_unit_file);
+ defsubr (&Snative_comp_unit_set_file);
+#endif
#ifdef HAVE_MODULES
defsubr (&Suser_ptrp);
#endif
@@ -4030,6 +4204,7 @@ This variable cannot be set; trying to do so will signal an error. */);
DEFSYM (Qunlet, "unlet");
DEFSYM (Qset, "set");
DEFSYM (Qset_default, "set-default");
+ DEFSYM (Qcommand_modes, "command-modes");
defsubr (&Sadd_variable_watcher);
defsubr (&Sremove_variable_watcher);
defsubr (&Sget_variable_watchers);
diff --git a/src/decompress.c b/src/decompress.c
index 48392499eaf..17224f61234 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -25,6 +25,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "buffer.h"
#include "composite.h"
+#include "md5.h"
#include <verify.h>
@@ -66,6 +67,107 @@ init_zlib_functions (void)
#endif /* WINDOWSNT */
+
+#define MD5_BLOCKSIZE 32768 /* From md5.c */
+
+static char acc_buff[2 * MD5_BLOCKSIZE];
+static size_t acc_size;
+
+static void
+accumulate_and_process_md5 (void *data, size_t len, struct md5_ctx *ctxt)
+{
+ eassert (len <= MD5_BLOCKSIZE);
+ /* We may optimize this saving some of these memcpy/move using
+ directly the outer buffers but so far don't bother. */
+ memcpy (acc_buff + acc_size, data, len);
+ acc_size += len;
+ if (acc_size >= MD5_BLOCKSIZE)
+ {
+ acc_size -= MD5_BLOCKSIZE;
+ md5_process_block (acc_buff, MD5_BLOCKSIZE, ctxt);
+ memmove (acc_buff, acc_buff + MD5_BLOCKSIZE, acc_size);
+ }
+}
+
+static void
+final_process_md5 (struct md5_ctx *ctxt)
+{
+ if (acc_size)
+ {
+ md5_process_bytes (acc_buff, acc_size, ctxt);
+ acc_size = 0;
+ }
+}
+
+int
+md5_gz_stream (FILE *source, void *resblock)
+{
+ z_stream stream;
+ unsigned char in[MD5_BLOCKSIZE];
+ unsigned char out[MD5_BLOCKSIZE];
+
+#ifdef WINDOWSNT
+ if (!zlib_initialized)
+ zlib_initialized = init_zlib_functions ();
+ if (!zlib_initialized)
+ {
+ message1 ("zlib library not found");
+ return -1;
+ }
+#endif
+
+ eassert (!acc_size);
+
+ struct md5_ctx ctx;
+ md5_init_ctx (&ctx);
+
+ /* allocate inflate state */
+ stream.zalloc = Z_NULL;
+ stream.zfree = Z_NULL;
+ stream.opaque = Z_NULL;
+ stream.avail_in = 0;
+ stream.next_in = Z_NULL;
+ int res = inflateInit2 (&stream, MAX_WBITS + 32);
+ if (res != Z_OK)
+ return -1;
+
+ do {
+ stream.avail_in = fread (in, 1, MD5_BLOCKSIZE, source);
+ if (ferror (source)) {
+ inflateEnd (&stream);
+ return -1;
+ }
+ if (stream.avail_in == 0)
+ break;
+ stream.next_in = in;
+
+ do {
+ stream.avail_out = MD5_BLOCKSIZE;
+ stream.next_out = out;
+ res = inflate (&stream, Z_NO_FLUSH);
+
+ if (res != Z_OK && res != Z_STREAM_END)
+ return -1;
+
+ accumulate_and_process_md5 (out, MD5_BLOCKSIZE - stream.avail_out, &ctx);
+ } while (!stream.avail_out);
+
+ } while (res != Z_STREAM_END);
+
+ final_process_md5 (&ctx);
+ inflateEnd (&stream);
+
+ if (res != Z_STREAM_END)
+ return -1;
+
+ md5_finish_ctx (&ctx, resblock);
+
+ return 0;
+}
+#undef MD5_BLOCKSIZE
+
+
+
struct decompress_unwind_data
{
ptrdiff_t old_point, orig, start, nbytes;
diff --git a/src/dispextern.h b/src/dispextern.h
index f4e872644db..33fcaa4c078 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1262,8 +1262,6 @@ extern struct glyph space_glyph;
/* True means last display completed. False means it was preempted. */
extern bool display_completed;
-
-
/************************************************************************
Glyph Strings
@@ -3066,6 +3064,11 @@ struct image
is created. */
unsigned long face_foreground, face_background;
+ /* Details of the font, only really relevant for types like SVG that
+ allow us to draw text. */
+ int face_font_size;
+ char *face_font_family;
+
/* True if this image has a `transparent' background -- that is, is
uses an image mask. The accessor macro for this is
`IMAGE_BACKGROUND_TRANSPARENT'. */
@@ -3636,7 +3639,7 @@ extern void gui_update_window_begin (struct window *);
extern void gui_update_window_end (struct window *, bool, bool);
#endif
void do_pending_window_change (bool);
-void change_frame_size (struct frame *, int, int, bool, bool, bool, bool);
+void change_frame_size (struct frame *, int, int, bool, bool, bool);
void init_display (void);
void syms_of_display (void);
extern void spec_glyph_lookup_face (struct window *, GLYPH *);
diff --git a/src/dispnew.c b/src/dispnew.c
index e603c671363..0c313199173 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -473,6 +473,10 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
= row->glyphs[LEFT_MARGIN_AREA] + left;
row->glyphs[RIGHT_MARGIN_AREA]
= row->glyphs[TEXT_AREA] + dim.width - left - right;
+ /* Leave room for a border glyph. */
+ if (!FRAME_WINDOW_P (XFRAME (w->frame))
+ && !WINDOW_RIGHTMOST_P (w))
+ row->glyphs[RIGHT_MARGIN_AREA] -= 1;
row->glyphs[LAST_AREA]
= row->glyphs[LEFT_MARGIN_AREA] + dim.width;
}
@@ -1140,7 +1144,13 @@ prepare_desired_row (struct window *w, struct glyph_row *row, bool mode_line_p)
row->glyphs[TEXT_AREA] = row->glyphs[LEFT_MARGIN_AREA] + left;
if (w->right_margin_cols > 0
&& (right != row->glyphs[LAST_AREA] - row->glyphs[RIGHT_MARGIN_AREA]))
- row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right;
+ {
+ row->glyphs[RIGHT_MARGIN_AREA] = row->glyphs[LAST_AREA] - right;
+ /* Leave room for a border glyph. */
+ if (!FRAME_WINDOW_P (XFRAME (w->frame))
+ && !WINDOW_RIGHTMOST_P (w))
+ row->glyphs[RIGHT_MARGIN_AREA] -= 1;
+ }
}
}
@@ -3328,7 +3338,7 @@ update_frame_with_menu (struct frame *f, int row, int col)
}
/* Update the mouse position for a frame F. This handles both
- updating the display for mouse-face propreties and updating the
+ updating the display for mouse-face properties and updating the
help echo text.
Returns the number of events generated. */
@@ -3588,6 +3598,7 @@ update_window (struct window *w, bool force_p)
int yb;
bool changed_p = 0, mouse_face_overwritten_p = 0;
int n_updated = 0;
+ bool invisible_rows_marked = false;
#ifdef HAVE_WINDOW_SYSTEM
gui_update_window_begin (w);
@@ -3679,13 +3690,36 @@ update_window (struct window *w, bool force_p)
tempted to optimize redisplay based on lines displayed
in the first redisplay. */
if (MATRIX_ROW_BOTTOM_Y (row) >= yb)
- for (i = vpos + 1; i < w->current_matrix->nrows - 1; ++i)
- SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false);
+ {
+ for (i = vpos + 1; i < w->current_matrix->nrows - 1; ++i)
+ SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false);
+ invisible_rows_marked = true;
+ }
}
/* Was display preempted? */
paused_p = row < end;
+ if (!paused_p && !invisible_rows_marked)
+ {
+ /* If we didn't mark the invisible rows in the current
+ matrix as invalid above, do that now. This can happen if
+ scrolling_window updates the last visible rows of the
+ current matrix, in which case the above loop doesn't get
+ to examine the last visible row. */
+ int i;
+ for (i = 0; i < w->current_matrix->nrows - 1; ++i)
+ {
+ struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, i);
+ if (current_row->enabled_p
+ && MATRIX_ROW_BOTTOM_Y (current_row) >= yb)
+ {
+ for (++i ; i < w->current_matrix->nrows - 1; ++i)
+ SET_MATRIX_ROW_ENABLED_P (w->current_matrix, i, false);
+ }
+ }
+ }
+
set_cursor:
/* Update the tab line after scrolling because a new tab
@@ -5746,32 +5780,34 @@ handle_window_change_signal (int sig)
termcap-controlled terminal, but we can't decide which.
Therefore, we resize the frames corresponding to each tty.
*/
- for (tty = tty_list; tty; tty = tty->next) {
+ for (tty = tty_list; tty; tty = tty->next)
+ {
+ if (! tty->term_initted)
+ continue;
- if (! tty->term_initted)
- continue;
+ /* Suspended tty frames have tty->input == NULL avoid trying to
+ use it. */
+ if (!tty->input)
+ continue;
- /* Suspended tty frames have tty->input == NULL avoid trying to
- use it. */
- if (!tty->input)
- continue;
+ get_tty_size (fileno (tty->input), &width, &height);
- get_tty_size (fileno (tty->input), &width, &height);
+ if (width > 5 && height > 2)
+ {
+ Lisp_Object tail, frame;
- if (width > 5 && height > 2) {
- Lisp_Object tail, frame;
+ FOR_EACH_FRAME (tail, frame)
+ {
+ struct frame *f = XFRAME (frame);
- FOR_EACH_FRAME (tail, frame)
- if (FRAME_TERMCAP_P (XFRAME (frame)) && FRAME_TTY (XFRAME (frame)) == tty)
- /* Record the new sizes, but don't reallocate the data
- structures now. Let that be done later outside of the
- signal handler. */
- change_frame_size (XFRAME (frame), width,
- height - FRAME_MENU_BAR_LINES (XFRAME (frame))
- - FRAME_TAB_BAR_LINES (XFRAME (frame)),
- 0, 1, 0, 0);
+ if (FRAME_TERMCAP_P (f) && FRAME_TTY (f) == tty)
+ /* Record the new sizes, but don't reallocate the data
+ structures now. Let that be done later outside of the
+ signal handler. */
+ change_frame_size (f, width, height, false, true, false);
+ }
+ }
}
- }
}
static void
@@ -5789,7 +5825,6 @@ deliver_window_change_signal (int sig)
void
do_pending_window_change (bool safe)
{
- /* If window change signal handler should have run before, run it now. */
if (redisplaying_p && !safe)
return;
@@ -5797,15 +5832,20 @@ do_pending_window_change (bool safe)
{
Lisp_Object tail, frame;
- delayed_size_change = 0;
+ delayed_size_change = false;
FOR_EACH_FRAME (tail, frame)
{
struct frame *f = XFRAME (frame);
- if (f->new_height != 0 || f->new_width != 0)
+ /* Negative new_width or new_height values mean no change is
+ required (a native size can never drop below zero). If
+ new_size_p is not set, this means the size change was
+ requested by adjust_frame_size but has not been honored by
+ the window manager yet. */
+ if (f->new_size_p && (f->new_height >= 0 || f->new_width >= 0))
change_frame_size (f, f->new_width, f->new_height,
- 0, 0, safe, f->new_pixelwise);
+ false, false, safe);
}
}
}
@@ -5813,47 +5853,46 @@ do_pending_window_change (bool safe)
static void
change_frame_size_1 (struct frame *f, int new_width, int new_height,
- bool pretend, bool delay, bool safe, bool pixelwise)
+ bool pretend, bool delay, bool safe)
{
- /* If we can't deal with the change now, queue it for later. */
if (delay || (redisplaying_p && !safe))
{
+ if (CONSP (frame_size_history)
+ && ((new_width != f->new_width
+ || new_height != f->new_height
+ || new_width != FRAME_PIXEL_WIDTH (f)
+ || new_height != FRAME_PIXEL_HEIGHT (f))))
+ frame_size_history_extra
+ (f, build_string ("change_frame_size_1, delayed"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ new_width, new_height, f->new_width, f->new_height);
+
+ /* We can't deal with the change now, queue it for later. */
f->new_width = new_width;
f->new_height = new_height;
- f->new_pixelwise = pixelwise;
- delayed_size_change = 1;
+ f->new_size_p = true;
+ delayed_size_change = true;
}
else
{
- /* This size-change overrides any pending one for this frame. */
- f->new_height = 0;
- f->new_width = 0;
- f->new_pixelwise = 0;
-
- /* If an argument is zero, set it to the current value. */
- if (pixelwise)
- {
- new_width = (new_width <= 0) ? FRAME_TEXT_WIDTH (f) : new_width;
- new_height = (new_height <= 0) ? FRAME_TEXT_HEIGHT (f) : new_height;
- }
- else
- {
- new_width = (((new_width <= 0) ? FRAME_COLS (f) : new_width)
- * FRAME_COLUMN_WIDTH (f));
- new_height = (((new_height <= 0) ? FRAME_LINES (f) : new_height)
- * FRAME_LINE_HEIGHT (f));
- }
-
- /* Adjust frame size but make sure set_window_size_hook does not
- get called. */
- adjust_frame_size (f, new_width, new_height, 5, pretend,
- Qchange_frame_size);
+ /* Storing -1 in the new_width/new_height slots means that no size
+ change is pending. Native sizes are always non-negative.
+ Reset the new_size_p slot as well. */
+ f->new_height = -1;
+ f->new_width = -1;
+ f->new_size_p = false;
+ /* adjust_frame_size wants its arguments in terms of text_width
+ and text_height, so convert them here. For pathologically
+ small frames, the resulting values may be negative though. */
+ adjust_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, new_width),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (f, new_height), 5,
+ pretend, Qchange_frame_size);
}
}
-/* Change text height/width of frame F. Values may be given as zero to
- indicate that no change is needed.
+/* Change native height/width of frame F to NEW_WIDTH/NEW_HEIGHT pixels.
+ Values may be given as -1 to indicate that no change is needed.
If DELAY, assume we're being called from a signal handler, and queue
the change for later - perhaps the next redisplay. Since this tries
@@ -5863,7 +5902,7 @@ change_frame_size_1 (struct frame *f, int new_width, int new_height,
change frame sizes while a redisplay is in progress. */
void
change_frame_size (struct frame *f, int new_width, int new_height,
- bool pretend, bool delay, bool safe, bool pixelwise)
+ bool pretend, bool delay, bool safe)
{
Lisp_Object tail, frame;
@@ -5873,13 +5912,12 @@ change_frame_size (struct frame *f, int new_width, int new_height,
size affects all frames. Termcap now supports multiple
ttys. */
FOR_EACH_FRAME (tail, frame)
- if (! FRAME_WINDOW_P (XFRAME (frame)))
+ if (!FRAME_WINDOW_P (XFRAME (frame)))
change_frame_size_1 (XFRAME (frame), new_width, new_height,
- pretend, delay, safe, pixelwise);
+ pretend, delay, safe);
}
else
- change_frame_size_1 (f, new_width, new_height, pretend, delay, safe,
- pixelwise);
+ change_frame_size_1 (f, new_width, new_height, pretend, delay, safe);
}
/***********************************************************************
@@ -6468,9 +6506,8 @@ init_display_interactive (void)
t->display_info.tty->top_frame = selected_frame;
change_frame_size (XFRAME (selected_frame),
FrameCols (t->display_info.tty),
- FrameRows (t->display_info.tty)
- - FRAME_MENU_BAR_LINES (f)
- - FRAME_TAB_BAR_LINES (f), 0, 0, 1, 0);
+ FrameRows (t->display_info.tty),
+ false, false, true);
/* Delete the initial terminal. */
if (--initial_terminal->reference_count == 0
diff --git a/src/doc.c b/src/doc.c
index 1307aa5ee92..6be023bb934 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -327,6 +327,11 @@ string is passed through `substitute-command-keys'. */)
xsignal1 (Qvoid_function, function);
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
+#ifdef HAVE_NATIVE_COMP
+ if (!NILP (Fsubr_native_elisp_p (fun)))
+ doc = native_function_doc (fun);
+ else
+#endif
if (SUBRP (fun))
doc = make_fixnum (XSUBR (fun)->doc);
#ifdef HAVE_MODULES
@@ -495,10 +500,11 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
XSETCAR (tem, make_fixnum (offset));
}
}
-
/* Lisp_Subrs have a slot for it. */
- else if (SUBRP (fun))
- XSUBR (fun)->doc = offset;
+ else if (SUBRP (fun) && !SUBR_NATIVE_COMPILEDP (fun))
+ {
+ XSUBR (fun)->doc = offset;
+ }
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
@@ -544,7 +550,7 @@ the same file name is found in the `doc-directory'. */)
Lisp_Object delayed_init =
find_symbol_value (intern ("custom-delayed-init-variables"));
- if (EQ (delayed_init, Qunbound)) delayed_init = Qnil;
+ if (!CONSP (delayed_init)) delayed_init = Qnil;
CHECK_STRING (filename);
@@ -713,17 +719,19 @@ syms_of_doc (void)
DEFVAR_LISP ("text-quoting-style", Vtext_quoting_style,
doc: /* Style to use for single quotes in help and messages.
-Its value should be a symbol. It works by substituting certain single
-quotes for grave accent and apostrophe. This is done in help output
-\(but not for display of Info manuals) and in functions like `message'
-and `format-message'. It is not done in `format'.
-
-`curve' means quote with curved single quotes ‘like this’.
-`straight' means quote with straight apostrophes \\='like this\\='.
-`grave' means quote with grave accent and apostrophe \\=`like this\\=';
-i.e., do not alter quote marks. The default value nil acts like
-`curve' if curved single quotes are displayable, and like `grave'
-otherwise. */);
+
+The value of this variable determines substitution of grave accents
+and apostrophes in help output (but not for display of Info
+manuals) and in functions like `message' and `format-message', but not
+in `format'.
+
+The value should be one of these symbols:
+ `curve': quote with curved single quotes ‘like this’.
+ `straight': quote with straight apostrophes \\='like this\\='.
+ `grave': quote with grave accent and apostrophe \\=`like this\\=';
+ i.e., do not alter the original quote marks.
+ nil: like `curve' if curved single quotes are displayable,
+ and like `grave' otherwise. This is the default. */);
Vtext_quoting_style = Qnil;
DEFVAR_BOOL ("internal--text-quoting-flag", text_quoting_flag,
diff --git a/src/doprnt.c b/src/doprnt.c
index b6b5978c891..fe484b8e766 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -563,7 +563,7 @@ esprintf (char *buf, char const *format, ...)
BUFSIZE_MAX. */
ptrdiff_t
exprintf (char **buf, ptrdiff_t *bufsize,
- char const *nonheapbuf, ptrdiff_t bufsize_max,
+ char *nonheapbuf, ptrdiff_t bufsize_max,
char const *format, ...)
{
ptrdiff_t nbytes;
@@ -579,7 +579,7 @@ exprintf (char **buf, ptrdiff_t *bufsize,
/* Act like exprintf, except take a va_list. */
ptrdiff_t
evxprintf (char **buf, ptrdiff_t *bufsize,
- char const *nonheapbuf, ptrdiff_t bufsize_max,
+ char *nonheapbuf, ptrdiff_t bufsize_max,
char const *format, va_list ap)
{
for (;;)
diff --git a/src/dynlib.c b/src/dynlib.c
index 86f8b7e2063..a8c88439615 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -135,7 +135,7 @@ dynlib_addr (void (*funcptr) (void), const char **fname, const char **symname)
void *addr = (void *) funcptr;
/* Step 1: Find the handle of the module where ADDR lives. */
- if (os_subtype == OS_9X
+ if (os_subtype == OS_SUBTYPE_9X
/* Windows NT family version before XP (v5.1). */
|| ((w32_major_version + (w32_minor_version > 0)) < 6))
{
@@ -301,15 +301,11 @@ dynlib_error (void)
return dlerror ();
}
-/* FIXME: Currently there is no way to unload a module, so this
- function is never used. */
-#if false
int
dynlib_close (dynlib_handle_ptr h)
{
return dlclose (h) == 0;
}
-#endif
#else
diff --git a/src/editfns.c b/src/editfns.c
index 991f79abac7..c8219decb06 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1452,8 +1452,8 @@ DEFUN ("insert-char", Finsert_char, Sinsert_char, 1, 3,
(prefix-numeric-value current-prefix-arg)\
t))",
doc: /* Insert COUNT copies of CHARACTER.
-Interactively, prompt for CHARACTER. You can specify CHARACTER in one
-of these ways:
+Interactively, prompt for CHARACTER using `read-char-by-name'.
+You can specify CHARACTER in one of these ways:
- As its Unicode character name, e.g. \"LATIN SMALL LETTER A\".
Completion is available; if you type a substring of the name
@@ -1697,7 +1697,11 @@ they can be in either order. */)
DEFUN ("buffer-string", Fbuffer_string, Sbuffer_string, 0, 0, 0,
doc: /* Return the contents of the current buffer as a string.
If narrowing is in effect, this function returns only the visible part
-of the buffer. */)
+of the buffer.
+
+This function copies the text properties of that part of the buffer
+into the result string; if you don’t want the text properties,
+use `buffer-substring-no-properties' instead. */)
(void)
{
return make_buffer_string_both (BEGV, BEGV_BYTE, ZV, ZV_BYTE, 1);
@@ -2133,7 +2137,7 @@ nil. */)
the file now. */
if (SAVE_MODIFF == MODIFF
&& STRINGP (BVAR (a, file_truename)))
- unlock_file (BVAR (a, file_truename));
+ Funlock_file (BVAR (a, file_truename));
}
return Qt;
@@ -2367,7 +2371,7 @@ Both characters must have the same length of multi-byte form. */)
/* replace_range is less efficient, because it moves the gap,
but it handles combining correctly. */
replace_range (pos, pos + 1, string,
- false, false, true, false);
+ false, false, true, false, false);
pos_byte_next = CHAR_TO_BYTE (pos);
if (pos_byte_next > pos_byte)
/* Before combining happened. We should not increment
@@ -2574,7 +2578,7 @@ It returns the number of characters changed. */)
but it should handle multibyte characters correctly. */
string = make_multibyte_string ((char *) str, 1, str_len);
replace_range (pos, pos + 1, string,
- true, false, true, false);
+ true, false, true, false, false);
len = str_len;
}
else
@@ -2609,7 +2613,8 @@ It returns the number of characters changed. */)
= (VECTORP (val)
? Fconcat (1, &val)
: Fmake_string (make_fixnum (1), val, Qnil));
- replace_range (pos, pos + len, string, true, false, true, false);
+ replace_range (pos, pos + len, string, true, false, true, false,
+ false);
pos_byte += SBYTES (string);
pos += SCHARS (string);
characters_changed += SCHARS (string);
@@ -2937,6 +2942,8 @@ DEFUN ("propertize", Fpropertize, Spropertize, 1, MANY, 0,
First argument is the string to copy.
Remaining arguments form a sequence of PROPERTY VALUE pairs for text
properties to add to the result.
+
+See Info node `(elisp) Text Properties' for more information.
usage: (propertize STRING &rest PROPERTIES) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
@@ -2945,7 +2952,7 @@ usage: (propertize STRING &rest PROPERTIES) */)
/* Number of args must be odd. */
if ((nargs & 1) == 0)
- error ("Wrong number of arguments");
+ xsignal2 (Qwrong_number_of_arguments, Qpropertize, make_fixnum (nargs));
properties = string = Qnil;
@@ -3134,7 +3141,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
char *format_start = SSDATA (args[0]);
bool multibyte_format = STRING_MULTIBYTE (args[0]);
ptrdiff_t formatlen = SBYTES (args[0]);
- bool fmt_props = string_intervals (args[0]);
+ bool fmt_props = !!string_intervals (args[0]);
/* Upper bound on number of format specs. Each uses at least 2 chars. */
ptrdiff_t nspec_bound = SCHARS (args[0]) >> 1;
@@ -3382,12 +3389,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
else
{
ptrdiff_t nch, nby;
- width = lisp_string_width (arg, prec, &nch, &nby);
+ nchars_string = SCHARS (arg);
+ width = lisp_string_width (arg, 0, nchars_string, prec,
+ &nch, &nby, false);
if (prec < 0)
- {
- nchars_string = SCHARS (arg);
- nbytes = SBYTES (arg);
- }
+ nbytes = SBYTES (arg);
else
{
nchars_string = nch;
@@ -4448,6 +4454,7 @@ syms_of_editfns (void)
{
DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions");
DEFSYM (Qwall, "wall");
+ DEFSYM (Qpropertize, "propertize");
DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion,
doc: /* Non-nil means text motion commands don't notice fields. */);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 894dffcf21e..f8fb54c0728 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -549,7 +549,7 @@ struct Lisp_Module_Function
union vectorlike_header header;
/* Fields traced by GC; these must come first. */
- Lisp_Object documentation, interactive_form;
+ Lisp_Object documentation, interactive_form, command_modes;
/* Fields ignored by GC. */
ptrdiff_t min_arity, max_arity;
@@ -646,6 +646,12 @@ module_function_interactive_form (const struct Lisp_Module_Function *fun)
return fun->interactive_form;
}
+Lisp_Object
+module_function_command_modes (const struct Lisp_Module_Function *fun)
+{
+ return fun->command_modes;
+}
+
static emacs_value
module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
emacs_value *args)
diff --git a/src/emacs.c b/src/emacs.c
index fd08667f3fd..866e43fda94 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -37,6 +37,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <fcntl.h>
#include <sys/socket.h>
#include <mbstring.h>
+#include <filename.h> /* for IS_ABSOLUTE_FILE_NAME */
#include "w32.h"
#include "w32heap.h"
#endif
@@ -61,6 +62,21 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
# include <sys/socket.h>
#endif
+#if defined HAVE_LINUX_SECCOMP_H && defined HAVE_LINUX_FILTER_H \
+ && HAVE_DECL_SECCOMP_SET_MODE_FILTER \
+ && HAVE_DECL_SECCOMP_FILTER_FLAG_TSYNC
+# define SECCOMP_USABLE 1
+#else
+# define SECCOMP_USABLE 0
+#endif
+
+#if SECCOMP_USABLE
+# include <linux/seccomp.h>
+# include <linux/filter.h>
+# include <sys/prctl.h>
+# include <sys/syscall.h>
+#endif
+
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
@@ -241,6 +257,11 @@ Initialization options:\n\
--dump-file FILE read dumped state from FILE\n\
",
#endif
+#if SECCOMP_USABLE
+ "\
+--sandbox=FILE read Seccomp BPF filter from FILE\n\
+"
+#endif
"\
--no-build-details do not add build details such as time stamps\n\
--no-desktop do not load a saved desktop\n\
@@ -418,9 +439,9 @@ terminate_due_to_signal (int sig, int backtrace_limit)
/* This shouldn't be executed, but it prevents a warning. */
exit (1);
}
+
/* Code for dealing with Lisp access to the Unix command line. */
-
static void
init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd)
{
@@ -462,8 +483,8 @@ init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd)
if (NILP (Vinvocation_directory))
{
Lisp_Object found;
- int yes = openp (Vexec_path, Vinvocation_name,
- Vexec_suffixes, &found, make_fixnum (X_OK), false);
+ int yes = openp (Vexec_path, Vinvocation_name, Vexec_suffixes,
+ &found, make_fixnum (X_OK), false, false);
if (yes == 1)
{
/* Add /: to the front of the name
@@ -649,7 +670,9 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr,
}
arglen = (valptr != NULL && (p = strchr (arg, '=')) != NULL
? p - arg : strlen (arg));
- if (lstr == 0 || arglen < minlen || strncmp (arg, lstr, arglen) != 0)
+ if (!lstr)
+ return 0;
+ if (arglen < minlen || strncmp (arg, lstr, arglen) != 0)
return 0;
else if (valptr == NULL)
{
@@ -718,15 +741,29 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size)
implementation of malloc, since the caller calls our free. */
#ifdef WINDOWSNT
char *prog_fname = w32_my_exename ();
+ if (prog_fname)
+ *candidate_size = strlen (prog_fname) + 1;
return prog_fname ? xstrdup (prog_fname) : NULL;
#else /* !WINDOWSNT */
char *candidate = NULL;
/* If the executable name contains a slash, we have some kind of
- path already, so just copy it. */
+ path already, so just resolve symlinks and return the result. */
eassert (argv0);
if (strchr (argv0, DIRECTORY_SEP))
- return xstrdup (argv0);
+ {
+ char *real_name = realpath (argv0, NULL);
+
+ if (real_name)
+ {
+ *candidate_size = strlen (real_name) + 1;
+ return real_name;
+ }
+
+ char *val = xstrdup (argv0);
+ *candidate_size = strlen (val) + 1;
+ return val;
+ }
ptrdiff_t argv0_length = strlen (argv0);
const char *path = getenv ("PATH");
@@ -763,7 +800,22 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size)
struct stat st;
if (file_access_p (candidate, X_OK)
&& stat (candidate, &st) == 0 && S_ISREG (st.st_mode))
- return candidate;
+ {
+ /* People put on PATH a symlink to the real Emacs
+ executable, with all the auxiliary files where the real
+ executable lives. Support that. */
+ if (lstat (candidate, &st) == 0 && S_ISLNK (st.st_mode))
+ {
+ char *real_name = realpath (candidate, NULL);
+
+ if (real_name)
+ {
+ *candidate_size = strlen (real_name) + 1;
+ return real_name;
+ }
+ }
+ return candidate;
+ }
*candidate = '\0';
}
while (*path++ != '\0');
@@ -777,6 +829,7 @@ load_pdump (int argc, char **argv)
{
const char *const suffix = ".pdmp";
int result;
+ char *emacs_executable = argv[0];
const char *strip_suffix =
#if defined DOS_NT || defined CYGWIN
".exe"
@@ -784,6 +837,13 @@ load_pdump (int argc, char **argv)
NULL
#endif
;
+ const char *argv0_base =
+#ifdef NS_SELF_CONTAINED
+ "Emacs"
+#else
+ "emacs"
+#endif
+ ;
/* TODO: maybe more thoroughly scrub process environment in order to
make this use case (loading a dump file in an unexeced emacs)
@@ -806,9 +866,19 @@ load_pdump (int argc, char **argv)
skip_args++;
}
+ /* Where's our executable? */
+ ptrdiff_t bufsize, exec_bufsize;
+ emacs_executable = load_pdump_find_executable (argv[0], &bufsize);
+ exec_bufsize = bufsize;
+
+ /* If we couldn't find our executable, go straight to looking for
+ the dump in the hardcoded location. */
+ if (!(emacs_executable && *emacs_executable))
+ goto hardcoded;
+
if (dump_file)
{
- result = pdumper_load (dump_file);
+ result = pdumper_load (dump_file, emacs_executable);
if (result != PDUMPER_LOAD_SUCCESS)
fatal ("could not load dump file \"%s\": %s",
@@ -822,65 +892,46 @@ load_pdump (int argc, char **argv)
so we can't use decode_env_path. We're working in whatever
encoding the system natively uses for filesystem access, so
there's no need for character set conversion. */
- ptrdiff_t bufsize;
- dump_file = load_pdump_find_executable (argv[0], &bufsize);
-
- /* If we couldn't find our executable, go straight to looking for
- the dump in the hardcoded location. */
- if (dump_file && *dump_file)
+ ptrdiff_t exenamelen = strlen (emacs_executable);
+ if (strip_suffix)
{
-#ifdef WINDOWSNT
- /* w32_my_exename resolves symlinks internally, so no need to
- call realpath. */
-#else
- char *real_exename = realpath (dump_file, NULL);
- if (!real_exename)
- fatal ("could not resolve realpath of \"%s\": %s",
- dump_file, strerror (errno));
- xfree (dump_file);
- dump_file = real_exename;
-#endif
- ptrdiff_t exenamelen = strlen (dump_file);
-#ifndef WINDOWSNT
- bufsize = exenamelen + 1;
-#endif
- if (strip_suffix)
- {
- ptrdiff_t strip_suffix_length = strlen (strip_suffix);
- ptrdiff_t prefix_length = exenamelen - strip_suffix_length;
- if (0 <= prefix_length
- && !memcmp (&dump_file[prefix_length], strip_suffix,
- strip_suffix_length))
- exenamelen = prefix_length;
- }
- ptrdiff_t needed = exenamelen + strlen (suffix) + 1;
- if (bufsize < needed)
- dump_file = xpalloc (dump_file, &bufsize, needed - bufsize, -1, 1);
- strcpy (dump_file + exenamelen, suffix);
- result = pdumper_load (dump_file);
- if (result == PDUMPER_LOAD_SUCCESS)
- goto out;
-
- if (result != PDUMPER_LOAD_FILE_NOT_FOUND)
- fatal ("could not load dump file \"%s\": %s",
- dump_file, dump_error_to_string (result));
+ ptrdiff_t strip_suffix_length = strlen (strip_suffix);
+ ptrdiff_t prefix_length = exenamelen - strip_suffix_length;
+ if (0 <= prefix_length
+ && !memcmp (&emacs_executable[prefix_length], strip_suffix,
+ strip_suffix_length))
+ exenamelen = prefix_length;
}
+ ptrdiff_t needed = exenamelen + strlen (suffix) + 1;
+ dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1);
+ memcpy (dump_file, emacs_executable, exenamelen);
+ strcpy (dump_file + exenamelen, suffix);
+ result = pdumper_load (dump_file, emacs_executable);
+ if (result == PDUMPER_LOAD_SUCCESS)
+ goto out;
+
+ if (result != PDUMPER_LOAD_FILE_NOT_FOUND)
+ fatal ("could not load dump file \"%s\": %s",
+ dump_file, dump_error_to_string (result));
+
+ hardcoded:
#ifdef WINDOWSNT
/* On MS-Windows, PATH_EXEC normally starts with a literal
"%emacs_dir%", so it will never work without some tweaking. */
path_exec = w32_relocate (path_exec);
+#elif defined (HAVE_NS)
+ path_exec = ns_relocate (path_exec);
#endif
/* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in
"emacs.pdmp" so that the Emacs binary still works if the user
copies and renames it. */
- const char *argv0_base = "emacs";
- ptrdiff_t needed = (strlen (path_exec)
- + 1
- + strlen (argv0_base)
- + strlen (suffix)
- + 1);
+ needed = (strlen (path_exec)
+ + 1
+ + strlen (argv0_base)
+ + strlen (suffix)
+ + 1);
if (bufsize < needed)
{
xfree (dump_file);
@@ -888,7 +939,23 @@ load_pdump (int argc, char **argv)
}
sprintf (dump_file, "%s%c%s%s",
path_exec, DIRECTORY_SEP, argv0_base, suffix);
- result = pdumper_load (dump_file);
+#if !defined (NS_SELF_CONTAINED)
+ /* Assume the Emacs binary lives in a sibling directory as set up by
+ the default installation configuration. */
+ const char *go_up = "../../../../bin/";
+ needed += (strip_suffix ? strlen (strip_suffix) : 0)
+ - strlen (suffix) + strlen (go_up);
+ if (exec_bufsize < needed)
+ {
+ xfree (emacs_executable);
+ emacs_executable = xpalloc (NULL, &exec_bufsize, needed - exec_bufsize,
+ -1, 1);
+ }
+ sprintf (emacs_executable, "%s%c%s%s%s",
+ path_exec, DIRECTORY_SEP, go_up, argv0_base,
+ strip_suffix ? strip_suffix : "");
+#endif
+ result = pdumper_load (dump_file, emacs_executable);
if (result == PDUMPER_LOAD_FILE_NOT_FOUND)
{
@@ -923,7 +990,7 @@ load_pdump (int argc, char **argv)
#endif
sprintf (dump_file, "%s%c%s%s",
path_exec, DIRECTORY_SEP, argv0_base, suffix);
- result = pdumper_load (dump_file);
+ result = pdumper_load (dump_file, emacs_executable);
}
if (result != PDUMPER_LOAD_SUCCESS)
@@ -935,9 +1002,185 @@ load_pdump (int argc, char **argv)
out:
xfree (dump_file);
+ xfree (emacs_executable);
}
#endif /* HAVE_PDUMPER */
+#if SECCOMP_USABLE
+
+/* Wrapper function for the `seccomp' system call on GNU/Linux. This
+ system call usually doesn't have a wrapper function. See the
+ manual page of `seccomp' for the signature. */
+
+static int
+emacs_seccomp (unsigned int operation, unsigned int flags, void *args)
+{
+#ifdef SYS_seccomp
+ return syscall (SYS_seccomp, operation, flags, args);
+#else
+ errno = ENOSYS;
+ return -1;
+#endif
+}
+
+/* Read SIZE bytes into BUFFER. Return the number of bytes read, or
+ -1 if reading failed altogether. */
+
+static ptrdiff_t
+read_full (int fd, void *buffer, ptrdiff_t size)
+{
+ eassert (0 <= fd);
+ eassert (buffer != NULL);
+ eassert (0 <= size);
+ enum
+ {
+ /* See MAX_RW_COUNT in sysdep.c. */
+#ifdef MAX_RW_COUNT
+ max_size = MAX_RW_COUNT
+#else
+ max_size = INT_MAX >> 18 << 18
+#endif
+ };
+ if (PTRDIFF_MAX < size || max_size < size)
+ {
+ errno = EFBIG;
+ return -1;
+ }
+ char *ptr = buffer;
+ ptrdiff_t read = 0;
+ while (size != 0)
+ {
+ ptrdiff_t n = emacs_read (fd, ptr, size);
+ if (n < 0)
+ return -1;
+ if (n == 0)
+ break; /* Avoid infinite loop on encountering EOF. */
+ eassert (n <= size);
+ size -= n;
+ ptr += n;
+ read += n;
+ }
+ return read;
+}
+
+/* Attempt to load Secure Computing filters from FILE. Return false
+ if that doesn't work for some reason. */
+
+static bool
+load_seccomp (const char *file)
+{
+ bool success = false;
+ void *buffer = NULL;
+ int fd
+ = emacs_open_noquit (file, O_RDONLY | O_CLOEXEC | O_BINARY, 0);
+ if (fd < 0)
+ {
+ emacs_perror ("open");
+ goto out;
+ }
+ struct stat stat;
+ if (fstat (fd, &stat) != 0)
+ {
+ emacs_perror ("fstat");
+ goto out;
+ }
+ if (! S_ISREG (stat.st_mode))
+ {
+ fprintf (stderr, "seccomp file %s is not regular\n", file);
+ goto out;
+ }
+ struct sock_fprog program;
+ if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size
+ || PTRDIFF_MAX <= stat.st_size
+ || stat.st_size % sizeof *program.filter != 0)
+ {
+ fprintf (stderr, "seccomp filter %s has invalid size %ld\n",
+ file, (long) stat.st_size);
+ goto out;
+ }
+ size_t size = stat.st_size;
+ size_t count = size / sizeof *program.filter;
+ eassert (0 < count && count < SIZE_MAX);
+ if (USHRT_MAX < count)
+ {
+ fprintf (stderr, "seccomp filter %s is too big\n", file);
+ goto out;
+ }
+ /* Try reading one more byte to detect file size changes. */
+ buffer = malloc (size + 1);
+ if (buffer == NULL)
+ {
+ emacs_perror ("malloc");
+ goto out;
+ }
+ ptrdiff_t read = read_full (fd, buffer, size + 1);
+ if (read < 0)
+ {
+ emacs_perror ("read");
+ goto out;
+ }
+ eassert (read <= SIZE_MAX);
+ if (read != size)
+ {
+ fprintf (stderr,
+ "seccomp filter %s changed size while reading\n",
+ file);
+ goto out;
+ }
+ if (emacs_close (fd) != 0)
+ emacs_perror ("close"); /* not a fatal error */
+ fd = -1;
+ program.len = count;
+ program.filter = buffer;
+
+ /* See man page of `seccomp' why this is necessary. Note that we
+ intentionally don't check the return value: a parent process
+ might have made this call before, in which case it would fail;
+ or, if enabling privilege-restricting mode fails, the `seccomp'
+ syscall will fail anyway. */
+ prctl (PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0);
+ /* Install the filter. Make sure that potential other threads can't
+ escape it. */
+ if (emacs_seccomp (SECCOMP_SET_MODE_FILTER,
+ SECCOMP_FILTER_FLAG_TSYNC, &program)
+ != 0)
+ {
+ emacs_perror ("seccomp");
+ goto out;
+ }
+ success = true;
+
+ out:
+ if (0 <= fd)
+ emacs_close (fd);
+ free (buffer);
+ return success;
+}
+
+/* Load Secure Computing filter from file specified with the --seccomp
+ option. Exit if that fails. */
+
+static void
+maybe_load_seccomp (int argc, char **argv)
+{
+ int skip_args = 0;
+ char *file = NULL;
+ while (skip_args < argc - 1)
+ {
+ if (argmatch (argv, argc, "-seccomp", "--seccomp", 9, &file,
+ &skip_args)
+ || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
+ break;
+ ++skip_args;
+ }
+ if (file == NULL)
+ return;
+ if (! load_seccomp (file))
+ fatal ("cannot enable seccomp filter from %s", file);
+}
+
+#endif /* SECCOMP_USABLE */
+
int
main (int argc, char **argv)
{
@@ -945,6 +1188,13 @@ main (int argc, char **argv)
for pointers. */
void *stack_bottom_variable;
+ /* First, check whether we should apply a seccomp filter. This
+ should come at the very beginning to allow the filter to protect
+ the initialization phase. */
+#if SECCOMP_USABLE
+ maybe_load_seccomp (argc, argv);
+#endif
+
bool no_loadup = false;
char *junk = 0;
char *dname_arg = 0;
@@ -1607,6 +1857,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_json ();
#endif
+ if (!initialized)
+ syms_of_comp ();
+
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
@@ -1778,7 +2031,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* Init buffer storage and default directory of main buffer. */
init_buffer ();
- init_callproc_1 (); /* Must precede init_cmdargs and init_sys_modes. */
+ /* Must precede init_cmdargs and init_sys_modes. */
+ init_callproc_1 ();
/* Must precede init_lread. */
init_cmdargs (argc, argv, skip_args, original_pwd);
@@ -1958,6 +2212,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#endif
keys_of_keyboard ();
+
+#ifdef HAVE_NATIVE_COMP
+ /* Must be after the last defsubr has run. */
+ hash_native_abi ();
+#endif
}
else
{
@@ -2047,6 +2306,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
Vdump_mode = build_string (dump_mode);
/* Enter editor command loop. This never returns. */
+ set_initial_minibuffer_mode ();
Frecursive_edit ();
eassume (false);
}
@@ -2133,12 +2393,15 @@ static const struct standard_args standard_args[] =
{ "-color", "--color", 5, 0},
{ "-no-splash", "--no-splash", 3, 0 },
{ "-no-desktop", "--no-desktop", 3, 0 },
- /* The following two must be just above the file-name args, to get
+ /* The following three must be just above the file-name args, to get
them out of our way, but without mixing them with file names. */
{ "-temacs", "--temacs", 1, 1 },
#ifdef HAVE_PDUMPER
{ "-dump-file", "--dump-file", 1, 1 },
#endif
+#if SECCOMP_USABLE
+ { "-seccomp", "--seccomp", 1, 1 },
+#endif
#ifdef HAVE_NS
{ "-NSAutoLaunch", 0, 5, 1 },
{ "-NXAutoLaunch", 0, 5, 1 },
@@ -2393,6 +2656,10 @@ all of which are called before Emacs is actually killed. */
unlink (SSDATA (listfile));
}
+#ifdef HAVE_NATIVE_COMP
+ eln_load_path_final_clean_up ();
+#endif
+
if (FIXNUMP (arg))
exit_code = (XFIXNUM (arg) < 0
? XFIXNUM (arg) | INT_MIN
@@ -2705,7 +2972,11 @@ decode_env_path (const char *evarname, const char *defalt, bool empty)
path = 0;
if (!path)
{
+#ifdef NS_SELF_CONTAINED
+ path = ns_relocate (defalt);
+#else
path = defalt;
+#endif
#ifdef WINDOWSNT
defaulted = 1;
#endif
@@ -3043,7 +3314,18 @@ because they do not depend on external libraries and are always available.
Also note that this is not a generic facility for accessing external
libraries; only those already known by Emacs will be loaded. */);
+#ifdef WINDOWSNT
+ /* FIXME: We may need to load libgccjit when dumping before
+ term/w32-win.el defines `dynamic-library-alist`. This will fail
+ if that variable is empty, so add libgccjit-0.dll to it. */
+ if (will_dump_p ())
+ Vdynamic_library_alist = list1 (list2 (Qgccjit,
+ build_string ("libgccjit-0.dll")));
+ else
+ Vdynamic_library_alist = Qnil;
+#else
Vdynamic_library_alist = Qnil;
+#endif
Fput (intern_c_string ("dynamic-library-alist"), Qrisky_local_variable, Qt);
#ifdef WINDOWSNT
diff --git a/src/epaths.in b/src/epaths.in
index 1de1e05f253..0c72610c6c1 100644
--- a/src/epaths.in
+++ b/src/epaths.in
@@ -27,6 +27,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
*/
#define PATH_LOADSEARCH "/usr/local/share/emacs/lisp"
+/* Like PATH_LOADSEARCH, but contains the relative path from the
+ installation directory.
+*/
+#define PATH_REL_LOADSEARCH ""
/* Like PATH_LOADSEARCH, but contains the non-standard pieces.
These are the site-lisp directories. Configure sets this to
diff --git a/src/eval.c b/src/eval.c
index 3aff3b56d52..48104bd0f45 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -219,8 +219,17 @@ void
init_eval_once (void)
{
/* Don't forget to update docs (lispref node "Local Variables"). */
- max_specpdl_size = 1600; /* 1500 is not enough for cl-generic.el. */
- max_lisp_eval_depth = 800;
+ if (!NATIVE_COMP_FLAG)
+ {
+ max_specpdl_size = 1800; /* See bug#46818. */
+ max_lisp_eval_depth = 800;
+ }
+ else
+ {
+ /* Original values increased for comp.el. */
+ max_specpdl_size = 2500;
+ max_lisp_eval_depth = 1600;
+ }
Vrun_hooks = Qnil;
pdumper_do_now_and_after_load (init_eval_once_for_pdumper);
}
@@ -453,7 +462,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
usage: (progn BODY...) */)
(Lisp_Object body)
{
- Lisp_Object val = Qnil;
+ Lisp_Object CACHEABLE val = Qnil;
while (CONSP (body))
{
@@ -1165,21 +1174,23 @@ usage: (catch TAG BODY...) */)
FUNC should return a Lisp_Object.
This is how catches are done from within C code. */
+/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
+ throwing t to tag `exit'.
+ 0 means there is no (throw 'exit t) in progress, or it wasn't from
+ a minibuffer which isn't the most nested;
+ N > 0 means the `throw' was done from the minibuffer at level N which
+ wasn't the most nested. */
+EMACS_INT minibuffer_quit_level = 0;
+
Lisp_Object
internal_catch (Lisp_Object tag,
Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
- /* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
- throwing t to tag `exit'.
- Value -1 means there is no (throw 'exit t) in progress;
- 0 means the `throw' wasn't done from an active minibuffer;
- N > 0 means the `throw' was done from the minibuffer at level N. */
- static EMACS_INT minibuffer_quit_level = -1;
/* This structure is made part of the chain `catchlist'. */
struct handler *c = push_handler (tag, CATCHER);
if (EQ (tag, Qexit))
- minibuffer_quit_level = -1;
+ minibuffer_quit_level = 0;
/* Call FUNC. */
if (! sys_setjmp (c->jmp))
@@ -1194,22 +1205,16 @@ internal_catch (Lisp_Object tag,
Lisp_Object val = handlerlist->val;
clobbered_eassert (handlerlist == c);
handlerlist = handlerlist->next;
- if (EQ (tag, Qexit) && EQ (val, Qt))
+ if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0)
/* If we've thrown t to tag `exit' from within a minibuffer, we
exit all minibuffers more deeply nested than the current
one. */
{
- EMACS_INT mini_depth = this_minibuffer_depth (Qnil);
- if (mini_depth && mini_depth != minibuffer_quit_level)
- {
- if (minibuffer_quit_level == -1)
- minibuffer_quit_level = mini_depth;
- if (minibuffer_quit_level
- && (minibuf_level > minibuffer_quit_level))
- Fthrow (Qexit, Qt);
- }
+ if (minibuf_level > minibuffer_quit_level
+ && !NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
+ Fthrow (Qexit, Qt);
else
- minibuffer_quit_level = -1;
+ minibuffer_quit_level = 0;
}
return val;
}
@@ -1305,7 +1310,7 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
doc: /* Regain control when an error is signaled.
Executes BODYFORM and returns its value if no error happens.
Each element of HANDLERS looks like (CONDITION-NAME BODY...)
-where the BODY is made of Lisp expressions.
+or (:success BODY...), where the BODY is made of Lisp expressions.
A handler is applicable to an error if CONDITION-NAME is one of the
error's condition names. Handlers may also apply when non-error
@@ -1327,6 +1332,10 @@ with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
Then the value of the last BODY form is returned from the `condition-case'
expression.
+The special handler (:success BODY...) is invoked if BODYFORM terminated
+without signalling an error. BODY is then evaluated with VAR bound to
+the value returned by BODYFORM.
+
See also the function `signal' for more info.
usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
(Lisp_Object args)
@@ -1350,16 +1359,21 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
CHECK_SYMBOL (var);
+ Lisp_Object success_handler = Qnil;
+
for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object tem = XCAR (tail);
- clausenb++;
if (! (NILP (tem)
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
error ("Invalid condition handler: %s",
SDATA (Fprin1_to_string (tem, Qt)));
+ if (CONSP (tem) && EQ (XCAR (tem), QCsuccess))
+ success_handler = XCDR (tem);
+ else
+ clausenb++;
}
/* The first clause is the one that should be checked first, so it
@@ -1373,7 +1387,11 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
clauses += clausenb;
for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
- *--clauses = XCAR (tail);
+ {
+ Lisp_Object tem = XCAR (tail);
+ if (!(CONSP (tem) && EQ (XCAR (tem), QCsuccess)))
+ *--clauses = tem;
+ }
for (ptrdiff_t i = 0; i < clausenb; i++)
{
Lisp_Object clause = clauses[i];
@@ -1411,8 +1429,25 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
}
}
- Lisp_Object result = eval_sub (bodyform);
+ Lisp_Object CACHEABLE result = eval_sub (bodyform);
handlerlist = oldhandlerlist;
+ if (!NILP (success_handler))
+ {
+ if (NILP (var))
+ return Fprogn (success_handler);
+
+ Lisp_Object handler_var = var;
+ if (!NILP (Vinternal_interpreter_environment))
+ {
+ result = Fcons (Fcons (var, result),
+ Vinternal_interpreter_environment);
+ handler_var = Qinternal_interpreter_environment;
+ }
+
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (handler_var, result);
+ return unbind_to (count, Fprogn (success_handler));
+ }
return result;
}
@@ -1498,6 +1533,90 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
}
}
+/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3 as
+ its arguments. */
+
+Lisp_Object
+internal_condition_case_3 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object,
+ Lisp_Object),
+ Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
+{
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg1, arg2, arg3);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+}
+
+/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, ARG4 as
+ its arguments. */
+
+Lisp_Object
+internal_condition_case_4 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object),
+ Lisp_Object arg1, Lisp_Object arg2,
+ Lisp_Object arg3, Lisp_Object arg4,
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
+{
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg1, arg2, arg3, arg4);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+}
+
+/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3,
+ ARG4, ARG5 as its arguments. */
+
+Lisp_Object
+internal_condition_case_5 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object,
+ Lisp_Object),
+ Lisp_Object arg1, Lisp_Object arg2,
+ Lisp_Object arg3, Lisp_Object arg4,
+ Lisp_Object arg5, Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
+{
+ struct handler *c = push_handler (handlers, CONDITION_CASE);
+ if (sys_setjmp (c->jmp))
+ {
+ Lisp_Object val = handlerlist->val;
+ clobbered_eassert (handlerlist == c);
+ handlerlist = handlerlist->next;
+ return hfun (val);
+ }
+ else
+ {
+ Lisp_Object val = bfun (arg1, arg2, arg3, arg4, arg5);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+}
+
/* Like internal_condition_case but call BFUN with NARGS as first,
and ARGS as second argument. */
@@ -1907,6 +2026,18 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
return 0;
}
+/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */
+bool
+signal_quit_p (Lisp_Object signal)
+{
+ Lisp_Object list;
+
+ return EQ (signal, Qquit)
+ || (!NILP (Fsymbolp (signal))
+ && CONSP (list = Fget (signal, Qerror_conditions))
+ && !NILP (Fmemq (Qquit, list)));
+}
+
/* Call the debugger if calling it is currently enabled for CONDITIONS.
SIG and DATA describe the signal. There are two ways to pass them:
= SIG is the error symbol, and DATA is the rest of the data.
@@ -1925,7 +2056,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
! input_blocked_p ()
&& NILP (Vinhibit_debugger)
/* Does user want to enter debugger for this kind of error? */
- && (EQ (sig, Qquit)
+ && (signal_quit_p (sig)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
&& ! skip_debugger (conditions, combined_data)
@@ -2084,14 +2215,21 @@ then strings and vectors are not accepted. */)
DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
doc: /* Define FUNCTION to autoload from FILE.
FUNCTION is a symbol; FILE is a file name string to pass to `load'.
+
Third arg DOCSTRING is documentation for the function.
-Fourth arg INTERACTIVE if non-nil says function can be called interactively.
+
+Fourth arg INTERACTIVE if non-nil says function can be called
+interactively. If INTERACTIVE is a list, it is interpreted as a list
+of modes the function is applicable for.
+
Fifth arg TYPE indicates the type of the object:
nil or omitted says FUNCTION is a function,
`keymap' says FUNCTION is really a keymap, and
`macro' or t says FUNCTION is really a macro.
+
Third through fifth args give info about the real definition.
They default to nil.
+
If FUNCTION is already defined other than as an autoload,
this does nothing and returns nil. */)
(Lisp_Object function, Lisp_Object file, Lisp_Object docstring, Lisp_Object interactive, Lisp_Object type)
@@ -2326,7 +2464,7 @@ eval_sub (Lisp_Object form)
else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
fun = indirect_function (fun);
- if (SUBRP (fun))
+ if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
{
Lisp_Object args_left = original_args;
ptrdiff_t numargs = list_length (args_left);
@@ -2429,7 +2567,9 @@ eval_sub (Lisp_Object form)
}
}
}
- else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun))
+ else if (COMPILEDP (fun)
+ || SUBR_NATIVE_COMPILED_DYNP (fun)
+ || MODULE_FUNCTIONP (fun))
return apply_lambda (fun, original_args, count);
else
{
@@ -2907,9 +3047,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
&& (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
fun = indirect_function (fun);
- if (SUBRP (fun))
+ if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
val = funcall_subr (XSUBR (fun), numargs, args + 1);
- else if (COMPILEDP (fun) || MODULE_FUNCTIONP (fun))
+ else if (COMPILEDP (fun)
+ || SUBR_NATIVE_COMPILED_DYNP (fun)
+ || MODULE_FUNCTIONP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
@@ -3119,6 +3261,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
else if (MODULE_FUNCTIONP (fun))
return funcall_module (fun, nargs, arg_vector);
#endif
+ else if (SUBR_NATIVE_COMPILED_DYNP (fun))
+ {
+ syms_left = XSUBR (fun)->lambda_list[0];
+ lexenv = Qnil;
+ }
else
emacs_abort ();
@@ -3179,6 +3326,13 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (CONSP (fun))
val = Fprogn (XCDR (XCDR (fun)));
+ else if (SUBR_NATIVE_COMPILEDP (fun))
+ {
+ eassert (SUBR_NATIVE_COMPILED_DYNP (fun));
+ /* No need to use funcall_subr as we have zero arguments by
+ construction. */
+ val = XSUBR (fun)->function.a0 ();
+ }
else
val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL);
@@ -4378,6 +4532,7 @@ alist of active lexical bindings. */);
defsubr (&Sthrow);
defsubr (&Sunwind_protect);
defsubr (&Scondition_case);
+ DEFSYM (QCsuccess, ":success");
defsubr (&Ssignal);
defsubr (&Scommandp);
defsubr (&Sautoload);
diff --git a/src/fileio.c b/src/fileio.c
index 741e297d29c..13c99bee109 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -749,6 +749,114 @@ For that reason, you should normally use `make-temp-file' instead. */)
empty_unibyte_string, Qnil);
}
+DEFUN ("file-name-concat", Ffile_name_concat, Sfile_name_concat, 1, MANY, 0,
+ doc: /* Append COMPONENTS to DIRECTORY and return the resulting string.
+Elements in COMPONENTS must be a string or nil.
+DIRECTORY or the non-final elements in COMPONENTS may or may not end
+with a slash -- if they don't end with a slash, a slash will be
+inserted before contatenating.
+usage: (record DIRECTORY &rest COMPONENTS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
+ Lisp_Object *elements = args;
+ Lisp_Object result;
+ ptrdiff_t i;
+
+ /* First go through the list to check the types and see whether
+ they're all of the same multibytedness. */
+ for (i = 0; i < nargs; i++)
+ {
+ Lisp_Object arg = args[i];
+ /* Skip empty and nil elements. */
+ if (NILP (arg))
+ continue;
+ CHECK_STRING (arg);
+ if (SCHARS (arg) == 0)
+ continue;
+ eargs++;
+ /* Multibyte and non-ASCII. */
+ if (STRING_MULTIBYTE (arg) && SCHARS (arg) != SBYTES (arg))
+ multibytes++;
+ /* We're not adding a slash to the final part. */
+ if (i == nargs - 1
+ || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
+ {
+ bytes += SBYTES (arg);
+ chars += SCHARS (arg);
+ }
+ else
+ {
+ bytes += SBYTES (arg) + 1;
+ chars += SCHARS (arg) + 1;
+ }
+ }
+
+ /* Convert if needed. */
+ if ((multibytes != 0 && multibytes != nargs)
+ || eargs != nargs)
+ {
+ int j = 0;
+ elements = xmalloc (eargs * sizeof *elements);
+ bytes = 0;
+ chars = 0;
+
+ /* Filter out nil/"". */
+ for (i = 0; i < nargs; i++)
+ {
+ Lisp_Object arg = args[i];
+ if (!NILP (arg) && SCHARS (arg) != 0)
+ elements[j++] = arg;
+ }
+
+ for (i = 0; i < eargs; i++)
+ {
+ Lisp_Object arg = elements[i];
+ /* Use multibyte or all-ASCII strings as is. */
+ if (!STRING_MULTIBYTE (arg) && !string_ascii_p (arg))
+ elements[i] = Fstring_to_multibyte (arg);
+ arg = elements[i];
+ /* We have to recompute the number of bytes. */
+ if (i == eargs - 1
+ || IS_DIRECTORY_SEP (*(SSDATA (arg) + SBYTES (arg) - 1)))
+ {
+ bytes += SBYTES (arg);
+ chars += SCHARS (arg);
+ }
+ else
+ {
+ bytes += SBYTES (arg) + 1;
+ chars += SCHARS (arg) + 1;
+ }
+ }
+ }
+
+ /* Allocate an empty string. */
+ if (multibytes == 0)
+ result = make_uninit_string (chars);
+ else
+ result = make_uninit_multibyte_string (chars, bytes);
+ /* Null-terminate the string. */
+ *(SSDATA (result) + SBYTES (result)) = 0;
+
+ /* Copy over the data. */
+ char *p = SSDATA (result);
+ for (i = 0; i < eargs; i++)
+ {
+ Lisp_Object arg = elements[i];
+ memcpy (p, SSDATA (arg), SBYTES (arg));
+ p += SBYTES (arg);
+ /* The last element shouldn't have a slash added at the end. */
+ if (i < eargs - 1 && !IS_DIRECTORY_SEP (*(p - 1)))
+ *p++ = DIRECTORY_SEP;
+ }
+
+ if (elements != args)
+ xfree (elements);
+
+ return result;
+}
+
/* NAME must be a string. */
static bool
file_name_absolute_no_tilde_p (Lisp_Object name)
@@ -1830,6 +1938,9 @@ the value of that variable. The variable name should be terminated
with a character not a letter, digit or underscore; otherwise, enclose
the entire variable name in braces.
+If FOO is not defined in the environment, `$FOO' is left unchanged in
+the value of this function.
+
If `/~' appears, all of FILENAME through that `/' is discarded.
If `//' appears, everything up to and including the first of
those `/' is discarded. */)
@@ -2987,12 +3098,16 @@ file_directory_p (Lisp_Object file)
DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
Sfile_accessible_directory_p, 1, 1, 0,
doc: /* Return t if FILENAME names a directory you can open.
-For the value to be t, FILENAME must specify the name of a directory
-as a file, and the directory must allow you to open files in it. In
-order to use a directory as a buffer's current directory, this
-predicate must return true. A directory name spec may be given
-instead; then the value is t if the directory so specified exists and
-really is a readable and searchable directory. */)
+This means that FILENAME must specify the name of a directory, and the
+directory must allow you to open files in it. If this isn't the case,
+return nil.
+
+FILENAME can either be a directory name (eg. \"/tmp/foo/\") or the
+file name of a file which is a directory (eg. \"/tmp/foo\", without
+the final slash).
+
+In order to use a directory as a buffer's current directory, this
+predicate must return true. */)
(Lisp_Object filename)
{
Lisp_Object absname;
@@ -4537,7 +4652,7 @@ by calling `format-decode', which see. */)
if (inserted == 0)
{
if (we_locked_file)
- unlock_file (BVAR (current_buffer, file_truename));
+ Funlock_file (BVAR (current_buffer, file_truename));
Vdeactivate_mark = old_Vdeactivate_mark;
}
else
@@ -4699,8 +4814,8 @@ by calling `format-decode', which see. */)
if (NILP (handler))
{
if (!NILP (BVAR (current_buffer, file_truename)))
- unlock_file (BVAR (current_buffer, file_truename));
- unlock_file (filename);
+ Funlock_file (BVAR (current_buffer, file_truename));
+ Funlock_file (filename);
}
if (not_regular)
xsignal2 (Qfile_error,
@@ -5161,7 +5276,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
if (open_and_close_file && !auto_saving)
{
- lock_file (lockname);
+ Flock_file (lockname);
file_locked = 1;
}
@@ -5186,7 +5301,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
{
int open_errno = errno;
if (file_locked)
- unlock_file (lockname);
+ Funlock_file (lockname);
report_file_errno ("Opening output file", filename, open_errno);
}
@@ -5201,7 +5316,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
{
int lseek_errno = errno;
if (file_locked)
- unlock_file (lockname);
+ Funlock_file (lockname);
report_file_errno ("Lseek error", filename, lseek_errno);
}
}
@@ -5338,7 +5453,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
unbind_to (count, Qnil);
if (file_locked)
- unlock_file (lockname);
+ Funlock_file (lockname);
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
@@ -5363,14 +5478,14 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
bset_filename (current_buffer, visit_file);
update_mode_lines = 14;
if (auto_saving_into_visited_file)
- unlock_file (lockname);
+ Funlock_file (lockname);
}
else if (quietly)
{
if (auto_saving_into_visited_file)
{
SAVE_MODIFF = MODIFF;
- unlock_file (lockname);
+ Funlock_file (lockname);
}
return Qnil;
@@ -6481,6 +6596,7 @@ This includes interactive calls to `delete-file' and
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_file_internal);
defsubr (&Smake_temp_name);
+ defsubr (&Sfile_name_concat);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);
diff --git a/src/filelock.c b/src/filelock.c
index 35baa0c6668..cc185d96cdf 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -51,7 +51,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
#include <share.h>
#include <sys/socket.h> /* for fcntl */
-#include "w32.h" /* for dostounix_filename */
#endif
#ifndef MSDOS
@@ -294,25 +293,6 @@ typedef struct
char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
} lock_info_type;
-/* Write the name of the lock file for FNAME into LOCKNAME. Length
- will be that of FNAME plus two more for the leading ".#", plus one
- for the null. */
-#define MAKE_LOCK_NAME(lockname, fname) \
- (lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \
- fill_in_lock_file_name (lockname, fname))
-
-static void
-fill_in_lock_file_name (char *lockfile, Lisp_Object fn)
-{
- char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn));
- char *base = last_slash + 1;
- ptrdiff_t dirlen = base - SSDATA (fn);
- memcpy (lockfile, SSDATA (fn), dirlen);
- lockfile[dirlen] = '.';
- lockfile[dirlen + 1] = '#';
- strcpy (lockfile + dirlen + 2, base);
-}
-
/* For some reason Linux kernels return EPERM on file systems that do
not support hard or symbolic links. This symbol documents the quirk.
There is no way to tell whether a symlink call fails due to
@@ -532,7 +512,7 @@ current_lock_owner (lock_info_type *owner, char *lfname)
/* If nonexistent lock file, all is well; otherwise, got strange error. */
lfinfolen = read_lock_data (lfname, owner->user);
if (lfinfolen < 0)
- return errno == ENOENT ? 0 : errno;
+ return errno == ENOENT || errno == ENOTDIR ? 0 : errno;
if (MAX_LFINFO < lfinfolen)
return ENAMETOOLONG;
owner->user[lfinfolen] = 0;
@@ -639,6 +619,12 @@ lock_if_free (lock_info_type *clasher, char *lfname)
return err;
}
+static Lisp_Object
+make_lock_file_name (Lisp_Object fn)
+{
+ return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil));
+}
+
/* lock_file locks file FN,
meaning it serves notice on the world that you intend to edit that file.
This should be done only when about to modify a file-visiting
@@ -657,97 +643,86 @@ lock_if_free (lock_info_type *clasher, char *lfname)
This function can signal an error, or return t meaning
take away the lock, or return nil meaning ignore the lock. */
-void
+static Lisp_Object
lock_file (Lisp_Object fn)
{
- Lisp_Object orig_fn, encoded_fn;
- char *lfname = NULL;
lock_info_type lock_info;
- USE_SAFE_ALLOCA;
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
if (will_dump_p ())
- return;
+ return Qnil;
- orig_fn = fn;
- fn = Fexpand_file_name (fn, Qnil);
-#ifdef WINDOWSNT
- /* Ensure we have only '/' separators, to avoid problems with
- looking (inside fill_in_lock_file_name) for backslashes in file
- names encoded by some DBCS codepage. */
- dostounix_filename (SSDATA (fn));
-#endif
- encoded_fn = ENCODE_FILE (fn);
- if (create_lockfiles)
- /* Create the name of the lock-file for file fn */
- MAKE_LOCK_NAME (lfname, encoded_fn);
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (fn, Qlock_file);
+ if (!NILP (handler))
+ {
+ return call2 (handler, Qlock_file, fn);
+ }
+
+ Lisp_Object lock_filename = make_lock_file_name (fn);
+ if (NILP (lock_filename))
+ return Qnil;
+ char *lfname = SSDATA (ENCODE_FILE (lock_filename));
/* See if this file is visited and has changed on disk since it was
visited. */
- Lisp_Object subject_buf = get_truename_buffer (orig_fn);
+ Lisp_Object subject_buf = get_truename_buffer (fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn))
- && !(lfname && current_lock_owner (NULL, lfname) == -2))
+ && current_lock_owner (NULL, lfname) != -2)
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
- /* Don't do locking if the user has opted out. */
- if (lfname)
+ /* Try to lock the lock. FIXME: This ignores errors when
+ lock_if_free returns a positive errno value. */
+ if (lock_if_free (&lock_info, lfname) < 0)
{
- /* Try to lock the lock. FIXME: This ignores errors when
- lock_if_free returns a positive errno value. */
- if (lock_if_free (&lock_info, lfname) < 0)
- {
- /* Someone else has the lock. Consider breaking it. */
- Lisp_Object attack;
- char *dot = lock_info.dot;
- ptrdiff_t pidlen = lock_info.colon - (dot + 1);
- static char const replacement[] = " (pid ";
- int replacementlen = sizeof replacement - 1;
- memmove (dot + replacementlen, dot + 1, pidlen);
- strcpy (dot + replacementlen + pidlen, ")");
- memcpy (dot, replacement, replacementlen);
- attack = call2 (intern ("ask-user-about-lock"), fn,
- build_string (lock_info.user));
- /* Take the lock if the user said so. */
- if (!NILP (attack))
- lock_file_1 (lfname, 1);
- }
- SAFE_FREE ();
+ /* Someone else has the lock. Consider breaking it. */
+ Lisp_Object attack;
+ char *dot = lock_info.dot;
+ ptrdiff_t pidlen = lock_info.colon - (dot + 1);
+ static char const replacement[] = " (pid ";
+ int replacementlen = sizeof replacement - 1;
+ memmove (dot + replacementlen, dot + 1, pidlen);
+ strcpy (dot + replacementlen + pidlen, ")");
+ memcpy (dot, replacement, replacementlen);
+ attack = call2 (intern ("ask-user-about-lock"), fn,
+ build_string (lock_info.user));
+ /* Take the lock if the user said so. */
+ if (!NILP (attack))
+ lock_file_1 (lfname, 1);
}
+ return Qnil;
}
-void
+static Lisp_Object
unlock_file (Lisp_Object fn)
{
char *lfname;
- USE_SAFE_ALLOCA;
-
- Lisp_Object filename = Fexpand_file_name (fn, Qnil);
- fn = ENCODE_FILE (filename);
- MAKE_LOCK_NAME (lfname, fn);
+ Lisp_Object lock_filename = make_lock_file_name (fn);
+ if (NILP (lock_filename))
+ return Qnil;
+ lfname = SSDATA (ENCODE_FILE (lock_filename));
int err = current_lock_owner (0, lfname);
if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
err = errno;
if (0 < err)
- report_file_errno ("Unlocking file", filename, err);
-
- SAFE_FREE ();
-}
+ report_file_errno ("Unlocking file", fn, err);
-#else /* MSDOS */
-void
-lock_file (Lisp_Object fn)
-{
+ return Qnil;
}
-void
-unlock_file (Lisp_Object fn)
+static Lisp_Object
+unlock_file_handle_error (Lisp_Object err)
{
+ call1 (intern ("userlock--handle-unlock-error"), err);
+ return Qnil;
}
#endif /* MSDOS */
@@ -763,10 +738,51 @@ unlock_all_files (void)
b = XBUFFER (buf);
if (STRINGP (BVAR (b, file_truename))
&& BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
- unlock_file (BVAR (b, file_truename));
+ Funlock_file (BVAR (b, file_truename));
}
}
+DEFUN ("lock-file", Flock_file, Slock_file, 1, 1, 0,
+ doc: /* Lock FILE.
+If the option `create-lockfiles' is nil, this does nothing. */)
+ (Lisp_Object file)
+{
+#ifndef MSDOS
+ /* Don't do locking if the user has opted out. */
+ if (create_lockfiles)
+ {
+ CHECK_STRING (file);
+ lock_file (file);
+ }
+#endif /* MSDOS */
+ return Qnil;
+}
+
+DEFUN ("unlock-file", Funlock_file, Sunlock_file, 1, 1, 0,
+ doc: /* Unlock FILE. */)
+ (Lisp_Object file)
+{
+#ifndef MSDOS
+ CHECK_STRING (file);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (file, Qunlock_file);
+ if (!NILP (handler))
+ {
+ call2 (handler, Qunlock_file, file);
+ return Qnil;
+ }
+
+ internal_condition_case_1 (unlock_file,
+ file,
+ list1 (Qfile_error),
+ unlock_file_handle_error);
+#endif /* MSDOS */
+ return Qnil;
+}
+
DEFUN ("lock-buffer", Flock_buffer, Slock_buffer,
0, 1, 0,
doc: /* Lock FILE, if current buffer is modified.
@@ -782,7 +798,7 @@ If the option `create-lockfiles' is nil, this does nothing. */)
CHECK_STRING (file);
if (SAVE_MODIFF < MODIFF
&& !NILP (file))
- lock_file (file);
+ Flock_file (file);
return Qnil;
}
@@ -790,12 +806,15 @@ DEFUN ("unlock-buffer", Funlock_buffer, Sunlock_buffer,
0, 0, 0,
doc: /* Unlock the file visited in the current buffer.
If the buffer is not modified, this does nothing because the file
-should not be locked in that case. */)
+should not be locked in that case. It also does nothing if the
+current buffer is not visiting a file, or is not locked. Handles file
+system errors by calling `display-warning' and continuing as if the
+error did not occur. */)
(void)
{
if (SAVE_MODIFF < MODIFF
&& STRINGP (BVAR (current_buffer, file_truename)))
- unlock_file (BVAR (current_buffer, file_truename));
+ Funlock_file (BVAR (current_buffer, file_truename));
return Qnil;
}
@@ -806,7 +825,7 @@ unlock_buffer (struct buffer *buffer)
{
if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer)
&& STRINGP (BVAR (buffer, file_truename)))
- unlock_file (BVAR (buffer, file_truename));
+ Funlock_file (BVAR (buffer, file_truename));
}
DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0,
@@ -819,14 +838,22 @@ t if it is locked by you, else a string saying which user has locked it. */)
return Qnil;
#else
Lisp_Object ret;
- char *lfname;
int owner;
lock_info_type locker;
- USE_SAFE_ALLOCA;
- filename = Fexpand_file_name (filename, Qnil);
- Lisp_Object encoded_filename = ENCODE_FILE (filename);
- MAKE_LOCK_NAME (lfname, encoded_filename);
+ /* If the file name has special constructs in it,
+ call the corresponding file name handler. */
+ Lisp_Object handler;
+ handler = Ffind_file_name_handler (filename, Qfile_locked_p);
+ if (!NILP (handler))
+ {
+ return call2 (handler, Qfile_locked_p, filename);
+ }
+
+ Lisp_Object lock_filename = make_lock_file_name (filename);
+ if (NILP (lock_filename))
+ return Qnil;
+ char *lfname = SSDATA (ENCODE_FILE (lock_filename));
owner = current_lock_owner (&locker, lfname);
switch (owner)
@@ -837,7 +864,6 @@ t if it is locked by you, else a string saying which user has locked it. */)
default: report_file_errno ("Testing file lock", filename, owner);
}
- SAFE_FREE ();
return ret;
#endif
}
@@ -856,7 +882,14 @@ The name of the (per-buffer) lockfile is constructed by prepending a
Info node `(emacs)Interlocking'. */);
create_lockfiles = true;
- defsubr (&Sunlock_buffer);
+ DEFSYM (Qlock_file, "lock-file");
+ DEFSYM (Qunlock_file, "unlock-file");
+ DEFSYM (Qfile_locked_p, "file-locked-p");
+ DEFSYM (Qmake_lock_file_name, "make-lock-file-name");
+
+ defsubr (&Slock_file);
+ defsubr (&Sunlock_file);
defsubr (&Slock_buffer);
+ defsubr (&Sunlock_buffer);
defsubr (&Sfile_locked_p);
}
diff --git a/src/fns.c b/src/fns.c
index 02743c62a57..5126439fd66 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -39,8 +39,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "puresize.h"
#include "gnutls.h"
-static void sort_vector_copy (Lisp_Object, ptrdiff_t,
- Lisp_Object *restrict, Lisp_Object *restrict);
+static void sort_vector_copy (Lisp_Object pred, ptrdiff_t len,
+ Lisp_Object src[restrict VLA_ELEMS (len)],
+ Lisp_Object dest[restrict VLA_ELEMS (len)]);
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
enum equal_kind, int, Lisp_Object);
@@ -54,10 +55,55 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
return argument;
}
+static Lisp_Object
+ccall2 (Lisp_Object (f) (ptrdiff_t nargs, Lisp_Object *args),
+ Lisp_Object arg1, Lisp_Object arg2)
+{
+ Lisp_Object args[2] = {arg1, arg2};
+ return f (2, args);
+}
+
+static Lisp_Object
+get_random_bignum (Lisp_Object limit)
+{
+ /* This is a naive transcription into bignums of the fixnum algorithm.
+ I'd be quite surprised if that's anywhere near the best algorithm
+ for it. */
+ while (true)
+ {
+ Lisp_Object val = make_fixnum (0);
+ Lisp_Object lim = limit;
+ int bits = 0;
+ int bitsperiteration = FIXNUM_BITS - 1;
+ do
+ {
+ /* Shift by one so it is a valid positive fixnum. */
+ EMACS_INT rand = get_random () >> 1;
+ Lisp_Object lrand = make_fixnum (rand);
+ bits += bitsperiteration;
+ val = ccall2 (Flogior,
+ Fash (val, make_fixnum (bitsperiteration)),
+ lrand);
+ lim = Fash (lim, make_fixnum (- bitsperiteration));
+ }
+ while (!EQ (lim, make_fixnum (0)));
+ /* Return the remainder, except reject the rare case where
+ get_random returns a number so close to INTMASK that the
+ remainder isn't random. */
+ Lisp_Object remainder = Frem (val, limit);
+ if (!NILP (ccall2 (Fleq,
+ ccall2 (Fminus, val, remainder),
+ ccall2 (Fminus,
+ Fash (make_fixnum (1), make_fixnum (bits)),
+ limit))))
+ return remainder;
+ }
+}
+
DEFUN ("random", Frandom, Srandom, 0, 1, 0,
doc: /* Return a pseudo-random integer.
By default, return a fixnum; all fixnums are equally likely.
-With positive fixnum LIMIT, return random integer in interval [0,LIMIT).
+With positive integer LIMIT, return random integer in interval [0,LIMIT).
With argument t, set the random number seed from the system's entropy
pool if available, otherwise from less-random volatile data such as the time.
With a string argument, set the seed based on the string's contents.
@@ -71,6 +117,12 @@ See Info node `(elisp)Random Numbers' for more details. */)
init_random ();
else if (STRINGP (limit))
seed_random (SSDATA (limit), SBYTES (limit));
+ if (BIGNUMP (limit))
+ {
+ if (0 > mpz_sgn (*xbignum_val (limit)))
+ xsignal2 (Qwrong_type_argument, Qnatnump, limit);
+ return get_random_bignum (limit);
+ }
val = get_random ();
if (FIXNUMP (limit) && 0 < XFIXNUM (limit))
@@ -1703,7 +1755,8 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
doc: /* Return non-nil if KEY is equal to the car of an element of ALIST.
The value is actually the first element of ALIST whose car equals KEY.
-Equality is defined by TESTFN if non-nil or by `equal' if nil. */)
+Equality is defined by the function TESTFN, defaulting to `equal'.
+TESTFN is called with 2 arguments: a car of an alist element and KEY. */)
(Lisp_Object key, Lisp_Object alist, Lisp_Object testfn)
{
if (eq_comparable_value (key) && NILP (testfn))
@@ -1816,7 +1869,8 @@ If SEQ is not a list, deletion is never performed destructively;
instead this function creates and returns a new vector or string.
Write `(setq foo (delete element foo))' to be sure of correctly
-changing the value of a sequence `foo'. */)
+changing the value of a sequence `foo'. See also `remove', which
+does not modify the argument. */)
(Lisp_Object elt, Lisp_Object seq)
{
if (VECTORP (seq))
@@ -2227,6 +2281,52 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
}
}
+Lisp_Object
+merge_c (Lisp_Object org_l1, Lisp_Object org_l2, bool (*less) (Lisp_Object, Lisp_Object))
+{
+ Lisp_Object l1 = org_l1;
+ Lisp_Object l2 = org_l2;
+ Lisp_Object tail = Qnil;
+ Lisp_Object value = Qnil;
+
+ while (1)
+ {
+ if (NILP (l1))
+ {
+ if (NILP (tail))
+ return l2;
+ Fsetcdr (tail, l2);
+ return value;
+ }
+ if (NILP (l2))
+ {
+ if (NILP (tail))
+ return l1;
+ Fsetcdr (tail, l1);
+ return value;
+ }
+
+ Lisp_Object tem;
+ if (less (Fcar (l1), Fcar (l2)))
+ {
+ tem = l1;
+ l1 = Fcdr (l1);
+ org_l1 = l1;
+ }
+ else
+ {
+ tem = l2;
+ l2 = Fcdr (l2);
+ org_l2 = l2;
+ }
+ if (NILP (tail))
+ value = tem;
+ else
+ Fsetcdr (tail, tem);
+ tail = tem;
+ }
+}
+
/* This does not check for quits. That is safe since it must terminate. */
@@ -2271,7 +2371,10 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
doc: /* Change value in PLIST of PROP to VAL.
PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol and VAL is any object.
+\(PROP1 VALUE1 PROP2 VALUE2 ...).
+
+The comparison with PROP is done using `eq'.
+
If PROP is already a property on the list, its value is set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (plist-put x prop val))' to be sure to use the new value.
@@ -2873,6 +2976,9 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
return obj;
}
+ if (use_short_answers)
+ return call1 (intern ("y-or-n-p"), prompt);
+
AUTO_STRING (yes_or_no, "(yes or no) ");
prompt = CALLN (Fconcat, prompt, yes_or_no);
@@ -3110,7 +3216,10 @@ suppressed. */)
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
doc: /* Return non-nil if PLIST has the property PROP.
PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol.
+\(PROP1 VALUE1 PROP2 VALUE2 ...).
+
+The comparison with PROP is done using `eq'.
+
Unlike `plist-get', this allows you to distinguish between a missing
property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
@@ -3847,7 +3956,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t length,
if (c == '=')
continue;
- if (v1 < 0)
+ if (v1 == 0)
return -1;
value += v1 - 1;
@@ -4385,6 +4494,15 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h)
eassert (!PURE_P (h));
}
+static void
+collect_interval (INTERVAL interval, Lisp_Object collector)
+{
+ nconc2 (collector,
+ list1(list3 (make_fixnum (interval->position),
+ make_fixnum (interval->position + LENGTH (interval)),
+ interval->plist)));
+}
+
/* Put an entry into hash table H that associates KEY with VALUE.
HASH is a previously computed hash code of KEY.
Value is the index of the entry in H matching KEY. */
@@ -4842,6 +4960,30 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */)
return hashfn_equal (obj, NULL);
}
+DEFUN ("sxhash-equal-including-properties", Fsxhash_equal_including_properties,
+ Ssxhash_equal_including_properties, 1, 1, 0,
+ doc: /* Return an integer hash code for OBJ suitable for
+`equal-including-properties'.
+If (sxhash-equal-including-properties A B), then
+(= (sxhash-equal-including-properties A) (sxhash-equal-including-properties B)).
+
+Hash codes are not guaranteed to be preserved across Emacs sessions. */)
+ (Lisp_Object obj)
+{
+ if (STRINGP (obj))
+ {
+ Lisp_Object collector = Fcons (Qnil, Qnil);
+ traverse_intervals (string_intervals (obj), 0, collect_interval,
+ collector);
+ return
+ make_ufixnum (
+ SXHASH_REDUCE (sxhash_combine (sxhash (obj),
+ sxhash (CDR (collector)))));
+ }
+
+ return hashfn_equal (obj, NULL);
+}
+
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
doc: /* Create and return a new hash table.
@@ -5628,16 +5770,6 @@ characters. */ )
return list3 (make_int (lines), make_int (longest), make_float (mean));
}
-static bool
-string_ascii_p (Lisp_Object string)
-{
- ptrdiff_t nbytes = SBYTES (string);
- for (ptrdiff_t i = 0; i < nbytes; i++)
- if (SREF (string, i) > 127)
- return false;
- return true;
-}
-
DEFUN ("string-search", Fstring_search, Sstring_search, 2, 3, 0,
doc: /* Search for the string NEEDLE in the string HAYSTACK.
The return value is the position of the first occurrence of NEEDLE in
@@ -5725,15 +5857,6 @@ Case is always significant and text properties are ignored. */)
return make_int (string_byte_to_char (haystack, res - SSDATA (haystack)));
}
-static void
-collect_interval (INTERVAL interval, Lisp_Object collector)
-{
- nconc2 (collector,
- list1(list3 (make_fixnum (interval->position),
- make_fixnum (interval->position + LENGTH (interval)),
- interval->plist)));
-}
-
DEFUN ("object-intervals", Fobject_intervals, Sobject_intervals, 1, 1, 0,
doc: /* Return a copy of the text properties of OBJECT.
OBJECT must be a buffer or a string.
@@ -5761,15 +5884,17 @@ in OBJECT. */)
DEFUN ("line-number-at-pos", Fline_number_at_pos,
Sline_number_at_pos, 0, 2, 0,
- doc: /* Return the line number at POSITION.
-If POSITION is nil, use the current buffer location.
-
-If the buffer is narrowed, the position returned is the position in the
-visible part of the buffer. If ABSOLUTE is non-nil, count the lines
-from the absolute start of the buffer. */)
+ doc: /* Return the line number at POSITION in the current buffer.
+If POSITION is nil or omitted, it defaults to point's position in the
+current buffer.
+
+If the buffer is narrowed, the return value by default counts the lines
+from the beginning of the accessible portion of the buffer. But if the
+second optional argument ABSOLUTE is non-nil, the value counts the lines
+from the absolute start of the buffer, disregarding the narrowing. */)
(register Lisp_Object position, Lisp_Object absolute)
{
- ptrdiff_t pos, start = BEGV;
+ ptrdiff_t pos, start = BEGV_BYTE;
if (MARKERP (position))
pos = marker_position (position);
@@ -5784,9 +5909,9 @@ from the absolute start of the buffer. */)
if (!NILP (absolute))
start = BEG_BYTE;
- /* Check that POSITION is n the visible range of the buffer. */
+ /* Check that POSITION is in the accessible range of the buffer. */
if (pos < BEGV || pos > ZV)
- args_out_of_range (make_int (start), make_int (ZV));
+ args_out_of_range_3 (make_int (pos), make_int (BEGV), make_int (ZV));
return make_int (count_lines (start, CHAR_TO_BYTE (pos)) + 1);
}
@@ -5815,6 +5940,7 @@ syms_of_fns (void)
defsubr (&Ssxhash_eq);
defsubr (&Ssxhash_eql);
defsubr (&Ssxhash_equal);
+ defsubr (&Ssxhash_equal_including_properties);
defsubr (&Smake_hash_table);
defsubr (&Scopy_hash_table);
defsubr (&Shash_table_count);
@@ -5904,6 +6030,15 @@ that disables the use of a file dialog, regardless of the value of
this variable. */);
use_file_dialog = true;
+ DEFVAR_BOOL ("use-short-answers", use_short_answers,
+ doc: /* Non-nil means `yes-or-no-p' uses shorter answers "y" or "n".
+When non-nil, `yes-or-no-p' will use `y-or-n-p' to read the answer.
+We recommend against setting this variable non-nil, because `yes-or-no-p'
+is intended to be used when users are expected not to respond too
+quickly, but to take their time and perhaps think about the answer.
+The same variable also affects the function `read-answer'. */);
+ use_short_answers = false;
+
defsubr (&Sidentity);
defsubr (&Srandom);
defsubr (&Slength);
diff --git a/src/font.c b/src/font.c
index a59ebe216b8..e043ef8d01b 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1029,8 +1029,8 @@ font_expand_wildcards (Lisp_Object *field, int n)
X font backend driver, it is a font-entity. In that case, NAME is
a fully specified XLFD. */
-int
-font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
+static int
+font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments)
{
int i, j, n;
char *f[XLFD_LAST_INDEX + 1];
@@ -1040,17 +1040,27 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
if (len > 255 || !len)
/* Maximum XLFD name length is 255. */
return -1;
+
/* Accept "*-.." as a fully specified XLFD. */
if (name[0] == '*' && (len == 1 || name[1] == '-'))
i = 1, f[XLFD_FOUNDRY_INDEX] = name;
else
i = 0;
+
+ /* Split into segments. */
for (p = name + i; *p; p++)
if (*p == '-')
{
- f[i++] = p + 1;
- if (i == XLFD_LAST_INDEX)
- break;
+ /* If we have too many segments, then gather them up into the
+ FAMILY part of the name. This allows using fonts with
+ dashes in the FAMILY bit. */
+ if (segments > XLFD_LAST_INDEX && i == XLFD_WEIGHT_INDEX)
+ segments--;
+ else {
+ f[i++] = p + 1;
+ if (i == XLFD_LAST_INDEX)
+ break;
+ }
}
f[i] = name + len;
@@ -1215,6 +1225,28 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
return 0;
}
+int
+font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
+{
+ int found = font_parse_xlfd_1 (name, len, font, -1);
+ if (found > -1)
+ return found;
+
+ int segments = 0;
+ /* Count how many segments we have. */
+ for (char *p = name; *p; p++)
+ if (*p == '-')
+ segments++;
+
+ /* If we have a surplus of segments, then we try to parse again, in
+ case there's a font with dashes in the family name. */
+ if (segments > XLFD_LAST_INDEX)
+ return font_parse_xlfd_1 (name, len, font, segments);
+ else
+ return -1;
+}
+
+
/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
length), and return the name length. If FONT_SIZE_INDEX of FONT is
0, use PIXEL_SIZE instead. */
@@ -4122,7 +4154,7 @@ representing the OpenType features supported by the font by this form:
SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
Layout tags.
-In addition to the keys listed abobe, the following keys are reserved
+In addition to the keys listed above, the following keys are reserved
for the specific meanings as below:
The value of :combining-capability is non-nil if the font-backend of
diff --git a/src/fontset.c b/src/fontset.c
index 332be6c39d1..7d4bd65f70c 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1361,7 +1361,11 @@ check_fontset_name (Lisp_Object name, Lisp_Object *frame)
if (EQ (name, Qt))
return Vdefault_fontset;
if (NILP (name))
- id = FRAME_FONTSET (f);
+ {
+ if (!FRAME_WINDOW_P (f))
+ error ("Can't use fontsets in non-GUI frames");
+ id = FRAME_FONTSET (f);
+ }
else
{
CHECK_STRING (name);
diff --git a/src/frame.c b/src/frame.c
index 635fc945604..b105268d423 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -150,29 +150,6 @@ get_frame_param (struct frame *frame, Lisp_Object prop)
}
-void
-frame_size_history_add (struct frame *f, Lisp_Object fun_symbol,
- int width, int height, Lisp_Object rest)
-{
- Lisp_Object frame;
-
- XSETFRAME (frame, f);
- if (CONSP (frame_size_history)
- && FIXNUMP (XCAR (frame_size_history))
- && 0 < XFIXNUM (XCAR (frame_size_history)))
- frame_size_history =
- Fcons (make_fixnum (XFIXNUM (XCAR (frame_size_history)) - 1),
- Fcons (list4
- (frame, fun_symbol,
- ((width > 0)
- ? list4i (FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
- width, height)
- : Qnil),
- rest),
- XCDR (frame_size_history)));
-}
-
-
/* Return 1 if `frame-inhibit-implied-resize' is non-nil or fullscreen
state of frame F would be affected by a vertical (horizontal if
HORIZONTAL is true) resize. PARAMETER is the symbol of the frame
@@ -193,78 +170,54 @@ frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter)
|| FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
: ((horizontal && f->inhibit_horizontal_resize)
|| (!horizontal && f->inhibit_vertical_resize)));
- if (inhibit && !FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
- frame_size_history_add
- (f, Qframe_inhibit_resize, 0, 0,
- list5 (horizontal ? Qt : Qnil, parameter,
- f->after_make_frame ? Qt : Qnil,
- frame_inhibit_implied_resize,
- fullscreen));
return inhibit;
}
+
+/** Set menu bar lines for a TTY frame. */
static void
set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
- int nlines;
int olines = FRAME_MENU_BAR_LINES (f);
+ int nlines = TYPE_RANGED_FIXNUMP (int, value) ? XFIXNUM (value) : 0;
/* Right now, menu bars don't work properly in minibuf-only frames;
most of the commands try to apply themselves to the minibuffer
frame itself, and get an error because you can't switch buffers
in or split the minibuffer window. */
- if (FRAME_MINIBUF_ONLY_P (f))
- return;
-
- if (TYPE_RANGED_FIXNUMP (int, value))
- nlines = XFIXNUM (value);
- else
- nlines = 0;
-
- if (nlines != olines)
+ if (!FRAME_MINIBUF_ONLY_P (f) && nlines != olines)
{
windows_or_buffers_changed = 14;
- FRAME_MENU_BAR_LINES (f) = nlines;
- FRAME_MENU_BAR_HEIGHT (f) = nlines * FRAME_LINE_HEIGHT (f);
- change_frame_size (f, FRAME_COLS (f),
- FRAME_LINES (f) + olines - nlines,
- 0, 1, 0, 0);
+ FRAME_MENU_BAR_LINES (f) = FRAME_MENU_BAR_HEIGHT (f) = nlines;
+ change_frame_size (f, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ false, true, false);
}
}
+
+/** Set tab bar lines for a TTY frame. */
static void
set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
- int nlines;
int olines = FRAME_TAB_BAR_LINES (f);
+ int nlines = TYPE_RANGED_FIXNUMP (int, value) ? XFIXNUM (value) : 0;
/* Right now, tab bars don't work properly in minibuf-only frames;
most of the commands try to apply themselves to the minibuffer
frame itself, and get an error because you can't switch buffers
in or split the minibuffer window. */
- if (FRAME_MINIBUF_ONLY_P (f))
- return;
-
- if (TYPE_RANGED_FIXNUMP (int, value))
- nlines = XFIXNUM (value);
- else
- nlines = 0;
-
- if (nlines != olines)
+ if (!FRAME_MINIBUF_ONLY_P (f) && nlines != olines)
{
windows_or_buffers_changed = 14;
- FRAME_TAB_BAR_LINES (f) = nlines;
- FRAME_TAB_BAR_HEIGHT (f) = nlines * FRAME_LINE_HEIGHT (f);
- change_frame_size (f, FRAME_COLS (f),
- FRAME_LINES (f) + olines - nlines,
- 0, 1, 0, 0);
+ FRAME_TAB_BAR_LINES (f) = FRAME_TAB_BAR_HEIGHT (f) = nlines;
+ change_frame_size (f, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ false, true, false);
}
}
Lisp_Object Vframe_list;
-
DEFUN ("framep", Fframep, Sframep, 1, 1, 0,
doc: /* Return non-nil if OBJECT is a frame.
Value is:
@@ -366,14 +319,15 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
*
* If `frame-windows-min-size' is called, it will make sure that the
* return value accommodates all windows of FRAME respecting the values
- * of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil).
- * With IGNORE non-nil the values of these variables are ignored.
+ * of `window-min-height' (`window-min-width' if HORIZONTAL is
+ * non-nil) and `window-safe-min-height' (`window-safe-min-width')
+ * according to IGNORE (see `window-min-size').
*
* In either case, never return a value less than 1. For TTY frames,
* additionally limit the minimum frame height to a value large enough
- * to support the menu bar, the mode line, and the echo area.
+ * to support menu bar, tab bar, mode line and echo area.
*/
-static int
+int
frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
Lisp_Object ignore, Lisp_Object pixelwise)
{
@@ -405,6 +359,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
else
retval = XFIXNUM (call4 (Qframe_windows_min_size, frame, horizontal,
ignore, pixelwise));
+
/* Don't allow too small height of text-mode frames, or else cm.c
might abort in cmcheckmagic. */
if ((FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) && NILP (horizontal))
@@ -413,6 +368,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
+ FRAME_TAB_BAR_LINES (f)
+ FRAME_WANTS_MODELINE_P (f)
+ 2); /* one text line and one echo-area line */
+
if (retval < min_height)
retval = min_height;
}
@@ -474,9 +430,10 @@ keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height,
if (CONSP (keep_ratio)
&& (NILP (Fcar (keep_ratio))
|| EQ (Fcar (keep_ratio), Qheight_only))
- && p->pixel_width - f->pixel_width < pos_x)
+ && FRAME_PIXEL_WIDTH (p) - FRAME_PIXEL_WIDTH (f) < pos_x)
{
- int p_f_width = p->pixel_width - f->pixel_width;
+ int p_f_width
+ = FRAME_PIXEL_WIDTH (p) - FRAME_PIXEL_WIDTH (f);
if (p_f_width <= 0)
pos_x = 0;
@@ -496,14 +453,15 @@ keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height,
if (CONSP (keep_ratio)
&& (NILP (Fcar (keep_ratio))
|| EQ (Fcar (keep_ratio), Qwidth_only))
- && p->pixel_height - f->pixel_height < pos_y)
+ && FRAME_PIXEL_HEIGHT (p) - FRAME_PIXEL_HEIGHT (f) < 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;
+ int p_f_height
+ = FRAME_PIXEL_HEIGHT (p) - FRAME_PIXEL_HEIGHT (f);
if (p_f_height <= 0)
pos_y = 0;
@@ -523,211 +481,326 @@ keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height,
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);
- }
+ pixel_width
+ = (int)(FRAME_PIXEL_WIDTH (f) * width_factor + 0.5);
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);
- }
+ pixel_height
+ = (int)(FRAME_PIXEL_HEIGHT (f) * height_factor + 0.5);
- adjust_frame_size (f, pixel_width, pixel_height, 1, 0,
- Qkeep_ratio);
+ adjust_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, pixel_width),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixel_height), 1,
+ false, Qkeep_ratio);
}
}
}
#endif
+static void
+frame_size_history_adjust (struct frame *f, int inhibit, Lisp_Object parameter,
+ int old_text_width, int old_text_height,
+ int new_text_width, int new_text_height,
+ int old_text_cols, int old_text_lines,
+ int new_text_cols, int new_text_lines,
+ int old_native_width, int old_native_height,
+ int new_native_width, int new_native_height,
+ int old_inner_width, int old_inner_height,
+ int new_inner_width, int new_inner_height,
+ int min_inner_width, int min_inner_height,
+ bool inhibit_horizontal, bool inhibit_vertical)
+{
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ if (CONSP (frame_size_history)
+ && FIXNUMP (XCAR (frame_size_history))
+ && 0 < XFIXNUM (XCAR (frame_size_history)))
+ frame_size_history =
+ Fcons (make_fixnum (XFIXNUM (XCAR (frame_size_history)) - 1),
+ Fcons (Fcons (list4 (frame, make_fixnum (5),
+ make_fixnum (inhibit), parameter),
+ list5 (list4i (old_text_width, old_text_height,
+ new_text_width, new_text_height),
+ list4i (old_text_cols, old_text_lines,
+ new_text_cols, new_text_lines),
+ list4i (old_native_width, old_native_height,
+ new_native_width, new_native_height),
+ list4i (old_inner_width, old_inner_height,
+ new_inner_width, new_inner_height),
+ list4 (make_fixnum (min_inner_width),
+ make_fixnum (min_inner_height),
+ inhibit_horizontal ? Qt : Qnil,
+ inhibit_vertical ? Qt : Qnil))),
+ XCDR (frame_size_history)));
+}
+
+
+void
+frame_size_history_plain (struct frame *f, Lisp_Object parameter)
+{
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ if (CONSP (frame_size_history)
+ && FIXNUMP (XCAR (frame_size_history))
+ && 0 < XFIXNUM (XCAR (frame_size_history)))
+ frame_size_history =
+ Fcons (make_fixnum (XFIXNUM (XCAR (frame_size_history)) - 1),
+ Fcons (Fcons (list3 (frame, make_fixnum (1), parameter), Qt),
+ XCDR (frame_size_history)));
+}
+
+
+void
+frame_size_history_extra (struct frame *f, Lisp_Object parameter,
+ int pixel_width, int pixel_height,
+ int extra_width, int extra_height,
+ int delayed_width, int delayed_height)
+{
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ if (CONSP (frame_size_history)
+ && FIXNUMP (XCAR (frame_size_history))
+ && 0 < XFIXNUM (XCAR (frame_size_history)))
+ frame_size_history =
+ Fcons (make_fixnum (XFIXNUM (XCAR (frame_size_history)) - 1),
+ Fcons (Fcons (list3 (frame, make_fixnum (2), parameter),
+ list2 (list4i (pixel_width, pixel_height,
+ extra_width, extra_height),
+ list2i (delayed_width, delayed_height))),
+ XCDR (frame_size_history)));
+}
+
+
/**
* 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 set_window_size_hook), to
- * resize the frame internally (via resize_frame_windows) or do nothing
- * at all.
+ * Adjust size of frame F. NEW_TEXT_WIDTH and NEW_TEXT_HEIGHT specify
+ * the new text size of F in pixels. When INHIBIT equals 2, 3 or 4, a
+ * value of -1 means to leave the text size of F unchanged and adjust,
+ * if necessary and possible, F's native size accordingly. When INHIBIT
+ * equals 0, 1 or 5, a negative value means that the frame has been (or
+ * should be) made pathologically small which usually means that parts
+ * of the frame's windows may not be entirely visible.
+ *
+ * The effect of calling this function can be to either issue a request
+ * to resize the frame externally (via set_window_size_hook), to resize
+ * the frame internally (via resize_frame_windows) or to do nothing.
*
- * The argument INHIBIT can assume the following values:
+ * The argument INHIBIT controls whether set_window_size_hook may be
+ * called and can assume the following values:
*
* 0 means to unconditionally call set_window_size_hook 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 set_window_size_hook if the native frame size really
- * changes. Fset_frame_size, Fset_frame_height, ... use this.
+ * 1 means to call set_window_size_hook if the native frame size should
+ * change. Fset_frame_size and friends and width and height parameter
+ * changes use this.
*
* 2 means to call set_window_size_hook 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).
+ * allows it. The code updating external menu and tool bars uses this
+ * to keep the height of the native frame unaltered when one of these
+ * bars is added or removed. This means that Emacs has to work
+ * against the window manager which usually tries to keep the combined
+ * height (native frame plus bar) unaltered.
*
- * 3 means call set_window_size_hook if window minimum sizes must be
- * preserved or frame_inhibit_resize allows it.
- * gui_set_left_fringe, gui_set_scroll_bar_width, gui_new_font
- * ... use (or should use) this.
+ * 3 means to call set_window_size_hook if window minimum sizes must be
+ * preserved or frame_inhibit_resize allows it. This is the default
+ * for parameters accounted for in a frame's text size like fringes,
+ * scroll bars, internal border, tab bar, internal tool and menu bars.
+ * It's also used when the frame's default font changes.
*
- * 4 means call set_window_size_hook 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.
+ * 4 means to call set_window_size_hook only if window minimum sizes
+ * must be preserved. The code for setting up window dividers and
+ * that responsible for wrapping the (internal) tool bar use this.
*
- * 5 means to never call set_window_size_hook. change_frame_size uses
- * this.
- *
- * Note that even when set_window_size_hook is not called, individual
- * windows may have to be resized (via `window--sanitize-window-sizes')
- * in order to support minimum size constraints.
+ * 5 means to never call set_window_size_hook. Usually this means to
+ * call resize_frame_windows. change_frame_size uses this.
*
* 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.
+ * a case-by-case basis whether set_window_size_hook should be called.
*/
void
-adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
- bool pretend, Lisp_Object parameter)
+adjust_frame_size (struct frame *f, int new_text_width, int new_text_height,
+ int inhibit, bool pretend, Lisp_Object parameter)
{
int unit_width = FRAME_COLUMN_WIDTH (f);
int unit_height = FRAME_LINE_HEIGHT (f);
- int old_pixel_width = FRAME_PIXEL_WIDTH (f);
- int old_pixel_height = FRAME_PIXEL_HEIGHT (f);
- int old_cols = FRAME_COLS (f);
- int old_lines = FRAME_LINES (f);
- int new_pixel_width, new_pixel_height;
- /* The following two values are calculated from the old frame pixel
- sizes and any "new" settings for tool bar, menu bar and internal
- borders. We do it this way to detect whether we have to call
- set_window_size_hook as consequence of the new settings. */
- int windows_width = FRAME_WINDOWS_WIDTH (f);
- int windows_height = FRAME_WINDOWS_HEIGHT (f);
- int min_windows_width, min_windows_height;
- /* These are a bit tedious, maybe we should use a macro. */
+ int old_native_width = FRAME_PIXEL_WIDTH (f);
+ int old_native_height = FRAME_PIXEL_HEIGHT (f);
+ int new_native_width, new_native_height;
+ /* The desired minimum inner width and height of the frame calculated
+ via 'frame-windows-min-size'. */
+ int min_inner_width, min_inner_height;
+ /* Get the "old" inner width, height and position of F via its root
+ window and the minibuffer window. We cannot use FRAME_INNER_WIDTH
+ and FRAME_INNER_HEIGHT here since the internal border and the top
+ margin may have been already set to new values. */
struct window *r = XWINDOW (FRAME_ROOT_WINDOW (f));
- int old_windows_width = WINDOW_PIXEL_WIDTH (r);
- int old_windows_height
+ int old_inner_width = WINDOW_PIXEL_WIDTH (r);
+ int old_inner_height
= (WINDOW_PIXEL_HEIGHT (r)
+ ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f))
? WINDOW_PIXEL_HEIGHT (XWINDOW (FRAME_MINIBUF_WINDOW (f)))
: 0));
- int new_windows_width, new_windows_height;
+ int new_inner_width, new_inner_height;
+ int old_text_cols = FRAME_COLS (f);
+ int old_text_lines = FRAME_LINES (f);
+ int new_text_cols, new_text_lines;
int old_text_width = FRAME_TEXT_WIDTH (f);
int old_text_height = FRAME_TEXT_HEIGHT (f);
- /* If a size is < 0 use the old value. */
- int new_text_width = (new_width >= 0) ? new_width : old_text_width;
- int new_text_height = (new_height >= 0) ? new_height : old_text_height;
- int new_cols, new_lines;
bool inhibit_horizontal, inhibit_vertical;
Lisp_Object frame;
XSETFRAME (frame, f);
- frame_size_history_add
- (f, Qadjust_frame_size_1, new_text_width, new_text_height,
- list2 (parameter, make_fixnum (inhibit)));
-
- /* The following two values are calculated from the old window body
- sizes and any "new" settings for scroll bars, dividers, fringes and
- margins (though the latter should have been processed already). */
- min_windows_width
- = frame_windows_min_size (frame, Qt, (inhibit == 5) ? Qt : Qnil, Qt);
- min_windows_height
- = frame_windows_min_size (frame, Qnil, (inhibit == 5) ? Qt : Qnil, Qt);
+ min_inner_width
+ = frame_windows_min_size (frame, Qt, (inhibit == 5) ? Qsafe : Qnil, Qt);
+ min_inner_height
+ = frame_windows_min_size (frame, Qnil, (inhibit == 5) ? Qsafe : Qnil, Qt);
if (inhibit >= 2 && inhibit <= 4)
/* When INHIBIT is in [2..4] inhibit if the "old" window sizes stay
within the limits and either resizing is inhibited or INHIBIT
equals 4. */
{
- inhibit_horizontal = (windows_width >= min_windows_width
+ if (new_text_width == -1)
+ new_text_width = FRAME_TEXT_WIDTH (f);
+ if (new_text_height == -1)
+ new_text_height = FRAME_TEXT_HEIGHT (f);
+
+ inhibit_horizontal = (FRAME_INNER_WIDTH (f) >= min_inner_width
&& (inhibit == 4
|| frame_inhibit_resize (f, true, parameter)));
- inhibit_vertical = (windows_height >= min_windows_height
+ inhibit_vertical = (FRAME_INNER_HEIGHT (f) >= min_inner_height
&& (inhibit == 4
|| frame_inhibit_resize (f, false, parameter)));
}
else
- /* Otherwise inhibit if INHIBIT equals 5. */
+ /* Otherwise inhibit if INHIBIT equals 5. If we wanted to overrule
+ the WM do that here (could lead to some sort of eternal fight
+ with the WM). */
inhibit_horizontal = inhibit_vertical = inhibit == 5;
- new_pixel_width = ((inhibit_horizontal && (inhibit < 5))
- ? old_pixel_width
- : max (FRAME_TEXT_TO_PIXEL_WIDTH (f, new_text_width),
- min_windows_width
- + 2 * FRAME_INTERNAL_BORDER_WIDTH (f)));
- new_windows_width = new_pixel_width - 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
- new_text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, new_pixel_width);
- new_cols = new_text_width / unit_width;
-
- new_pixel_height = ((inhibit_vertical && (inhibit < 5))
- ? old_pixel_height
- : max (FRAME_TEXT_TO_PIXEL_HEIGHT (f, new_text_height),
- min_windows_height
- + FRAME_TOP_MARGIN_HEIGHT (f)
+ new_native_width = ((inhibit_horizontal && inhibit < 5)
+ ? old_native_width
+ : max (FRAME_TEXT_TO_PIXEL_WIDTH (f, new_text_width),
+ min_inner_width
+ 2 * FRAME_INTERNAL_BORDER_WIDTH (f)));
- new_windows_height = (new_pixel_height
- - FRAME_TOP_MARGIN_HEIGHT (f)
- - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
- new_text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, new_pixel_height);
- new_lines = new_text_height / unit_height;
+ new_inner_width = new_native_width - 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
+ new_text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, new_native_width);
+ new_text_cols = new_text_width / unit_width;
+
+ new_native_height = ((inhibit_vertical && inhibit < 5)
+ ? old_native_height
+ : max (FRAME_TEXT_TO_PIXEL_HEIGHT (f, new_text_height),
+ min_inner_height
+ + FRAME_TOP_MARGIN_HEIGHT (f)
+ + 2 * FRAME_INTERNAL_BORDER_WIDTH (f)));
+ new_inner_height = (new_native_height
+ - FRAME_TOP_MARGIN_HEIGHT (f)
+ - 2 * FRAME_INTERNAL_BORDER_WIDTH (f));
+ new_text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, new_native_height);
+ new_text_lines = new_text_height / unit_height;
-#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f)
&& f->can_set_window_size
+ /* For inhibit == 1 call the window_size_hook only if a native
+ size changes. For inhibit == 0 or inhibit == 2 always call
+ it. */
&& ((!inhibit_horizontal
- && (new_pixel_width != old_pixel_width
+ && (new_native_width != old_native_width
|| inhibit == 0 || inhibit == 2))
|| (!inhibit_vertical
- && (new_pixel_height != old_pixel_height
+ && (new_native_height != old_native_height
|| inhibit == 0 || inhibit == 2))))
- /* We are either allowed to change the frame size or the minimum
- sizes request such a change. Do not care for fixing minimum
- sizes here, we do that eventually when we're called from
- change_frame_size. */
{
- /* Make sure we respect fullheight and fullwidth. */
- if (inhibit_horizontal)
- new_text_width = old_text_width;
- else if (inhibit_vertical)
- new_text_height = old_text_height;
+ if (inhibit == 2
+#ifdef USE_MOTIF
+ && !EQ (parameter, Qmenu_bar_lines)
+#endif
+ && (f->new_width >= 0 || f->new_height >= 0))
+ /* For implied resizes with inhibit 2 (external menu and tool
+ bar) pick up any new sizes the display engine has not
+ processed yet. Otherwsie, we would request the old sizes
+ which will make this request appear as a request to set new
+ sizes and have the WM react accordingly which is not TRT.
+
+ We don't that for the external menu bar on Motif.
+ Otherwise, switching off the menu bar will shrink the frame
+ and switching it on will not enlarge it. */
+ {
+ if (f->new_width >= 0)
+ new_native_width = f->new_width;
+ if (f->new_height >= 0)
+ new_native_height = f->new_height;
+ }
- frame_size_history_add
- (f, Qadjust_frame_size_2, new_text_width, new_text_height,
- list2 (inhibit_horizontal ? Qt : Qnil,
- inhibit_vertical ? Qt : Qnil));
+ if (CONSP (frame_size_history))
+ frame_size_history_adjust (f, inhibit, parameter,
+ old_text_width, old_text_height,
+ new_text_width, new_text_height,
+ old_text_cols, old_text_lines,
+ new_text_cols, new_text_lines,
+ old_native_width, old_native_height,
+ new_native_width, new_native_height,
+ old_inner_width, old_inner_height,
+ new_inner_width, new_inner_height,
+ min_inner_width, min_inner_height,
+ inhibit_horizontal, inhibit_vertical);
+
+ if (inhibit == 0 || inhibit == 1)
+ {
+ f->new_width = new_native_width;
+ f->new_height = new_native_height;
+ /* Resetting f->new_size_p is controversial: It might cause
+ do_pending_window_change drop a previous request and we are
+ in troubles when the window manager does not honor the
+ request we issue here. */
+ f->new_size_p = false;
+ }
if (FRAME_TERMINAL (f)->set_window_size_hook)
FRAME_TERMINAL (f)->set_window_size_hook
- (f, 0, new_text_width, new_text_height, 1);
+ (f, 0, new_native_width, new_native_height);
f->resized_p = true;
return;
}
-#endif
+
+ if (CONSP (frame_size_history))
+ frame_size_history_adjust (f, inhibit, parameter,
+ old_text_width, old_text_height,
+ new_text_width, new_text_height,
+ old_text_cols, old_text_lines,
+ new_text_cols, new_text_lines,
+ old_native_width, old_native_height,
+ new_native_width, new_native_height,
+ old_inner_width, old_inner_height,
+ new_inner_width, new_inner_height,
+ min_inner_width, min_inner_height,
+ inhibit_horizontal, inhibit_vertical);
if ((XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top
== FRAME_TOP_MARGIN_HEIGHT (f))
&& new_text_width == old_text_width
&& new_text_height == old_text_height
- && new_windows_width == old_windows_width
- && new_windows_height == old_windows_height
- && new_pixel_width == old_pixel_width
- && new_pixel_height == old_pixel_height
- && new_cols == old_cols
- && new_lines == old_lines)
- /* No change. Sanitize window sizes and return. */
- {
- sanitize_window_sizes (Qt);
- sanitize_window_sizes (Qnil);
-
- return;
- }
+ && new_inner_width == old_inner_width
+ && new_inner_height == old_inner_height
+ /* We might be able to drop these but some doubts remain. */
+ && new_native_width == old_native_width
+ && new_native_height == old_native_height
+ && new_text_cols == old_text_cols
+ && new_text_lines == old_text_lines)
+ /* No change. */
+ return;
block_input ();
@@ -736,69 +809,67 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
our video hardware. Try to find the smallest size greater or
equal to the requested dimensions, while accounting for the fact
that the menu-bar lines are not counted in the frame height. */
- int dos_new_lines = new_lines + FRAME_TOP_MARGIN (f);
- dos_set_window_size (&dos_new_lines, &new_cols);
- new_lines = dos_new_lines - FRAME_TOP_MARGIN (f);
+ int dos_new_text_lines = new_text_lines + FRAME_TOP_MARGIN (f);
+
+ dos_set_window_size (&dos_new_text_lines, &new_text_cols);
+ new_text_lines = dos_new_text_lines - FRAME_TOP_MARGIN (f);
#endif
- if (new_windows_width != old_windows_width)
+ if (new_inner_width != old_inner_width)
{
- resize_frame_windows (f, new_windows_width, true);
+ resize_frame_windows (f, new_inner_width, true);
/* MSDOS frames cannot PRETEND, as they change frame size by
manipulating video hardware. */
if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f))
- FrameCols (FRAME_TTY (f)) = new_cols;
+ FrameCols (FRAME_TTY (f)) = new_text_cols;
#if defined (HAVE_WINDOW_SYSTEM)
if (WINDOWP (f->tab_bar_window))
{
- XWINDOW (f->tab_bar_window)->pixel_width = new_windows_width;
+ XWINDOW (f->tab_bar_window)->pixel_width = new_inner_width;
XWINDOW (f->tab_bar_window)->total_cols
- = new_windows_width / unit_width;
+ = new_inner_width / unit_width;
}
#endif
#if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR)
if (WINDOWP (f->tool_bar_window))
{
- XWINDOW (f->tool_bar_window)->pixel_width = new_windows_width;
+ XWINDOW (f->tool_bar_window)->pixel_width = new_inner_width;
XWINDOW (f->tool_bar_window)->total_cols
- = new_windows_width / unit_width;
+ = new_inner_width / unit_width;
}
#endif
}
- else if (new_cols != old_cols)
+ else if (new_text_cols != old_text_cols)
call2 (Qwindow__pixel_to_total, frame, Qt);
- if (new_windows_height != old_windows_height
+ if (new_inner_height != old_inner_height
/* When the top margin has changed we have to recalculate the top
edges of all windows. No such calculation is necessary for the
left edges. */
|| WINDOW_TOP_PIXEL_EDGE (r) != FRAME_TOP_MARGIN_HEIGHT (f))
{
- resize_frame_windows (f, new_windows_height, false);
+ resize_frame_windows (f, new_inner_height, false);
/* MSDOS frames cannot PRETEND, as they change frame size by
manipulating video hardware. */
if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f))
- FrameRows (FRAME_TTY (f)) = new_lines + FRAME_TOP_MARGIN (f);
+ FrameRows (FRAME_TTY (f)) = new_text_lines + FRAME_TOP_MARGIN (f);
}
- else if (new_lines != old_lines)
+ else if (new_text_lines != old_text_lines)
call2 (Qwindow__pixel_to_total, frame, Qnil);
- frame_size_history_add
- (f, Qadjust_frame_size_3, new_text_width, new_text_height,
- list4i (old_pixel_width, old_pixel_height,
- new_pixel_width, new_pixel_height));
-
/* Assign new sizes. */
+ FRAME_COLS (f) = new_text_cols;
+ FRAME_LINES (f) = new_text_lines;
FRAME_TEXT_WIDTH (f) = new_text_width;
FRAME_TEXT_HEIGHT (f) = new_text_height;
- FRAME_PIXEL_WIDTH (f) = new_pixel_width;
- FRAME_PIXEL_HEIGHT (f) = new_pixel_height;
- SET_FRAME_COLS (f, new_cols);
- SET_FRAME_LINES (f, new_lines);
+ FRAME_PIXEL_WIDTH (f) = new_native_width;
+ FRAME_PIXEL_HEIGHT (f) = new_native_height;
+ FRAME_TOTAL_COLS (f) = FRAME_PIXEL_WIDTH (f) / FRAME_COLUMN_WIDTH (f);
+ FRAME_TOTAL_LINES (f) = FRAME_PIXEL_HEIGHT (f) / FRAME_LINE_HEIGHT (f);
{
struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
@@ -812,18 +883,18 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
w->cursor.vpos = w->cursor.y = 0;
}
- /* Sanitize window sizes. */
- sanitize_window_sizes (Qt);
- sanitize_window_sizes (Qnil);
-
adjust_frame_glyphs (f);
calculate_costs (f);
SET_FRAME_GARBAGED (f);
+ /* We now say here that F was resized instead of using the old
+ condition below. Some resizing must have taken place and if it was
+ only shifting the root window's position (paranoia?). */
+ f->resized_p = true;
- /* A frame was "resized" if one of its pixelsizes changed, even if its
- X window wasn't resized at all. */
- f->resized_p = (new_pixel_width != old_pixel_width
- || new_pixel_height != old_pixel_height);
+/** /\* A frame was "resized" if its native size changed, even if its X **/
+/** window wasn't resized at all. *\/ **/
+/** f->resized_p = (new_native_width != old_native_width **/
+/** || new_native_height != old_native_height); **/
unblock_input ();
@@ -834,8 +905,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
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);
+ keep_ratio (XFRAME (frame1), f, old_native_width, old_native_height,
+ new_native_width, new_native_height);
}
#endif
}
@@ -884,6 +955,8 @@ make_frame (bool mini_p)
f->tool_bar_resized = false;
f->column_width = 1; /* !FRAME_WINDOW_P value. */
f->line_height = 1; /* !FRAME_WINDOW_P value. */
+ f->new_width = -1;
+ f->new_height = -1;
#ifdef HAVE_WINDOW_SYSTEM
f->vertical_scroll_bar_type = vertical_scroll_bar_none;
f->horizontal_scroll_bars = false;
@@ -898,6 +971,7 @@ make_frame (bool mini_p)
f->no_accept_focus = false;
f->z_group = z_group_none;
f->tooltip = false;
+ f->was_invisible = false;
f->child_frame_border_width = -1;
f->last_tab_bar_item = -1;
#ifndef HAVE_EXT_TOOL_BAR
@@ -908,6 +982,7 @@ make_frame (bool mini_p)
f->ns_transparent_titlebar = false;
#endif
#endif
+ f->select_mini_window_flag = false;
/* This one should never be zero. */
f->change_stamp = 1;
root_window = make_window ();
@@ -932,20 +1007,21 @@ make_frame (bool mini_p)
wset_frame (rw, frame);
- /* 80/25 is arbitrary,
- just so that there is "something there."
+ /* 80/25 is arbitrary, just so that there is "something there."
Correct size will be set up later with adjust_frame_size. */
+ FRAME_COLS (f) = FRAME_TOTAL_COLS (f) = rw->total_cols = 80;
+ FRAME_TEXT_WIDTH (f) = FRAME_PIXEL_WIDTH (f) = rw->pixel_width
+ = 80 * FRAME_COLUMN_WIDTH (f);
+ FRAME_LINES (f) = FRAME_TOTAL_LINES (f) = 25;
+ FRAME_TEXT_HEIGHT (f) = FRAME_PIXEL_HEIGHT (f) = 25 * FRAME_LINE_HEIGHT (f);
- SET_FRAME_COLS (f, 80);
- SET_FRAME_LINES (f, 25);
- SET_FRAME_WIDTH (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f));
- SET_FRAME_HEIGHT (f, FRAME_LINES (f) * FRAME_LINE_HEIGHT (f));
-
- rw->total_cols = FRAME_COLS (f);
- rw->pixel_width = rw->total_cols * FRAME_COLUMN_WIDTH (f);
rw->total_lines = FRAME_LINES (f) - (mini_p ? 1 : 0);
rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
+ fset_face_hash_table
+ (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false));
+
if (mini_p)
{
mw->top_line = rw->total_lines;
@@ -1254,7 +1330,7 @@ affects all frames on the same terminal device. */)
{
struct frame *f;
struct terminal *t = NULL;
- Lisp_Object frame, tem;
+ Lisp_Object frame;
struct frame *sf = SELECTED_FRAME ();
#ifdef MSDOS
@@ -1316,8 +1392,8 @@ affects all frames on the same terminal device. */)
{
int width, height;
get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
- adjust_frame_size (f, width, height - FRAME_MENU_BAR_LINES (f)
- - FRAME_TAB_BAR_LINES (f),
+ /* With INHIBIT 5 pass correct text height to adjust_frame_size. */
+ adjust_frame_size (f, width, height - FRAME_TOP_MARGIN (f),
5, 0, Qterminal_frame);
}
@@ -1336,14 +1412,16 @@ affects all frames on the same terminal device. */)
store_in_alist (&parms, Qminibuffer, Qt);
Fmodify_frame_parameters (frame, parms);
- /* Make the frame face alist be frame-specific, so that each
+ /* Make the frame face hash be frame-specific, so that each
frame could change its face definitions independently. */
- fset_face_alist (f, Fcopy_alist (sf->face_alist));
- /* Simple Fcopy_alist isn't enough, because we need the contents of
- the vectors which are the CDRs of associations in face_alist to
+ fset_face_hash_table (f, Fcopy_hash_table (sf->face_hash_table));
+ /* Simple copy_hash_table isn't enough, because we need the contents of
+ the vectors which are the values in face_hash_table to
be copied as well. */
- for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
- XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
+ ptrdiff_t idx = 0;
+ struct Lisp_Hash_Table *table = XHASH_TABLE (f->face_hash_table);
+ for (idx = 0; idx < table->count; ++idx)
+ set_hash_value_slot (table, idx, Fcopy_sequence (HASH_VALUE (table, idx)));
f->can_set_window_size = true;
f->after_make_frame = true;
@@ -1384,7 +1462,8 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
especially when deleting the initial frame during startup. */
CHECK_FRAME (frame);
f = XFRAME (frame);
- if (!FRAME_LIVE_P (f))
+ /* Silently ignore dead and tooltip frames (Bug#47207). */
+ if (!FRAME_LIVE_P (f) || FRAME_TOOLTIP_P (f))
return Qnil;
else if (f == sf)
return frame;
@@ -1470,7 +1549,17 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
tty->top_frame = frame;
}
+ sf->select_mini_window_flag = MINI_WINDOW_P (XWINDOW (sf->selected_window));
+
selected_frame = frame;
+
+ move_minibuffers_onto_frame (sf, for_deletion);
+
+ if (f->select_mini_window_flag
+ && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
+ f->selected_window = f->minibuffer_window;
+ f->select_mini_window_flag = false;
+
if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
last_nonminibuf_frame = XFRAME (selected_frame);
@@ -1487,7 +1576,6 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor
#endif
internal_last_event_frame = Qnil;
- move_minibuffer_onto_frame ();
return frame;
}
@@ -1508,7 +1596,16 @@ redisplay will display FRAME.
This function returns FRAME, or nil if FRAME has been deleted. */)
(Lisp_Object frame, Lisp_Object norecord)
{
- return do_switch_frame (frame, 1, 0, norecord);
+ struct frame *f;
+
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
+
+ if (FRAME_TOOLTIP_P (f))
+ /* Do not select a tooltip frame (Bug#47207). */
+ error ("Cannot select a tooltip frame");
+ else
+ return do_switch_frame (frame, 1, 0, norecord);
}
DEFUN ("handle-switch-frame", Fhandle_switch_frame,
@@ -1523,6 +1620,7 @@ necessarily represent user-visible input focus. */)
/* Preserve prefix arg that the command loop just cleared. */
kset_prefix_arg (current_kboard, Vcurrent_prefix_arg);
run_hook (Qmouse_leave_buffer_hook);
+
return do_switch_frame (event, 0, 0, Qnil);
}
@@ -1848,52 +1946,6 @@ other_frames (struct frame *f, bool invisible, bool force)
return false;
}
-/* Make sure that minibuf_window doesn't refer to FRAME's minibuffer
- window. Preferably use the selected frame's minibuffer window
- instead. If the selected frame doesn't have one, get some other
- frame's minibuffer window. SELECT non-zero means select the new
- minibuffer window. */
-static void
-check_minibuf_window (Lisp_Object frame, int select)
-{
- struct frame *f = decode_live_frame (frame);
-
- XSETFRAME (frame, f);
-
- if (WINDOWP (minibuf_window) && EQ (f->minibuffer_window, minibuf_window))
- {
- Lisp_Object frames, this, window = make_fixnum (0);
-
- if (!EQ (frame, selected_frame)
- && FRAME_HAS_MINIBUF_P (XFRAME (selected_frame)))
- window = FRAME_MINIBUF_WINDOW (XFRAME (selected_frame));
- else
- FOR_EACH_FRAME (frames, this)
- {
- if (!EQ (this, frame) && FRAME_HAS_MINIBUF_P (XFRAME (this)))
- {
- window = FRAME_MINIBUF_WINDOW (XFRAME (this));
- break;
- }
- }
-
- /* Don't abort if no window was found (Bug#15247). */
- if (WINDOWP (window))
- {
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (window, XWINDOW (minibuf_window)->contents, 0, 0);
- minibuf_window = window;
-
- /* SELECT non-zero usually means that FRAME's minibuffer
- window was selected; select the new one. */
- if (select)
- Fselect_window (minibuf_window, Qnil);
- }
- }
-}
-
-
/**
* delete_frame:
*
@@ -1908,7 +1960,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
struct frame *sf;
struct kboard *kb;
Lisp_Object frames, frame1;
- int minibuffer_selected, is_tooltip_frame;
+ int is_tooltip_frame;
bool nochild = !FRAME_PARENT_FRAME (f);
Lisp_Object minibuffer_child_frame = Qnil;
@@ -2016,7 +2068,6 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
/* At this point, we are committed to deleting the frame.
There is no more chance for errors to prevent it. */
- minibuffer_selected = EQ (minibuf_window, selected_window);
sf = SELECTED_FRAME ();
/* Don't let the frame remain selected. */
if (f == sf)
@@ -2074,9 +2125,10 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
do_switch_frame (frame1, 0, 1, Qnil);
sf = SELECTED_FRAME ();
}
-
- /* Don't allow minibuf_window to remain on a deleted frame. */
- check_minibuf_window (frame, minibuffer_selected);
+ else
+ /* Ensure any minibuffers on FRAME are moved onto the selected
+ frame. */
+ move_minibuffers_onto_frame (f, true);
/* Don't let echo_area_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, echo_area_window))
@@ -2707,9 +2759,6 @@ displayed in the terminal. */)
if (NILP (force) && !other_frames (f, true, false))
error ("Attempt to make invisible the sole visible or iconified frame");
- /* Don't allow minibuf_window to remain on an invisible frame. */
- check_minibuf_window (frame, EQ (minibuf_window, selected_window));
-
if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->frame_visible_invisible_hook)
FRAME_TERMINAL (f)->frame_visible_invisible_hook (f, false);
@@ -2752,9 +2801,6 @@ for how to proceed. */)
}
#endif /* HAVE_WINDOW_SYSTEM */
- /* Don't allow minibuf_window to remain on an iconified frame. */
- check_minibuf_window (frame, EQ (minibuf_window, selected_window));
-
if (FRAME_WINDOW_P (f) && FRAME_TERMINAL (f)->iconify_frame_hook)
FRAME_TERMINAL (f)->iconify_frame_hook (f);
@@ -3209,21 +3255,26 @@ If FRAME is omitted or nil, return information on the currently selected frame.
: FRAME_W32_P (f) ? "w32term"
:"tty"));
}
+
store_in_alist (&alist, Qname, f->name);
- height = (f->new_height
- ? (f->new_pixelwise
- ? (f->new_height / FRAME_LINE_HEIGHT (f))
- : f->new_height)
+ /* It's questionable whether here we should report the value of
+ f->new_height (and f->new_width below) but we've done that in the
+ past, so let's keep it. Note that a value of -1 for either of
+ these means that no new size was requested.
+
+ But check f->new_size before to make sure that f->new_height and
+ f->new_width are not ones requested by adjust_frame_size. */
+ height = ((f->new_size_p && f->new_height >= 0)
+ ? f->new_height / FRAME_LINE_HEIGHT (f)
: FRAME_LINES (f));
store_in_alist (&alist, Qheight, make_fixnum (height));
- width = (f->new_width
- ? (f->new_pixelwise
- ? (f->new_width / FRAME_COLUMN_WIDTH (f))
- : f->new_width)
- : FRAME_COLS (f));
+ width = ((f->new_size_p && f->new_width >= 0)
+ ? f->new_width / FRAME_COLUMN_WIDTH (f)
+ : FRAME_COLS(f));
store_in_alist (&alist, Qwidth, make_fixnum (width));
- store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
- store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
+
+ store_in_alist (&alist, Qmodeline, FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil);
+ store_in_alist (&alist, Qunsplittable, FRAME_NO_SPLIT_P (f) ? Qt : Qnil);
store_in_alist (&alist, Qbuffer_list, f->buffer_list);
store_in_alist (&alist, Qburied_buffer_list, f->buried_buffer_list);
@@ -3236,6 +3287,7 @@ If FRAME is omitted or nil, return information on the currently selected frame.
{
/* This ought to be correct in f->param_alist for an X frame. */
Lisp_Object lines;
+
XSETFASTINT (lines, FRAME_MENU_BAR_LINES (f));
store_in_alist (&alist, Qmenu_bar_lines, lines);
XSETFASTINT (lines, FRAME_TAB_BAR_LINES (f));
@@ -3582,20 +3634,23 @@ DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_widt
static int
check_frame_pixels (Lisp_Object size, Lisp_Object pixelwise, int item_size)
{
+ intmax_t sz;
+ int pixel_size; /* size * item_size */
+
CHECK_INTEGER (size);
if (!NILP (pixelwise))
item_size = 1;
- intmax_t sz;
- int pixel_size; /* size * item_size */
- if (! integer_to_intmax (size, &sz)
+
+ if (!integer_to_intmax (size, &sz)
|| INT_MULTIPLY_WRAPV (sz, item_size, &pixel_size))
args_out_of_range_3 (size, make_int (INT_MIN / item_size),
make_int (INT_MAX / item_size));
+
return pixel_size;
}
DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4,
- "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
+ "(set-frame-property--interactive \"Frame height: \" (frame-height))",
doc: /* Set text height of frame FRAME to HEIGHT lines.
Optional third arg PRETEND non-nil means that redisplay should use
HEIGHT lines but that the idea of the actual height of the frame should
@@ -3613,14 +3668,18 @@ If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_height = check_frame_pixels (height, pixelwise,
- FRAME_LINE_HEIGHT (f));
- adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight);
+ int text_height
+ = check_frame_pixels (height, pixelwise, FRAME_LINE_HEIGHT (f));
+
+ /* With INHIBIT 1 pass correct text width to adjust_frame_size. */
+ adjust_frame_size
+ (f, FRAME_TEXT_WIDTH (f), text_height, 1, !NILP (pretend), Qheight);
+
return Qnil;
}
DEFUN ("set-frame-width", Fset_frame_width, Sset_frame_width, 2, 4,
- "(list (selected-frame) (prefix-numeric-value current-prefix-arg))",
+ "(set-frame-property--interactive \"Frame width: \" (frame-width))",
doc: /* Set text width of frame FRAME to WIDTH columns.
Optional third arg PRETEND non-nil means that redisplay should use WIDTH
columns but that the idea of the actual width of the frame should not
@@ -3638,9 +3697,13 @@ If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_width = check_frame_pixels (width, pixelwise,
- FRAME_COLUMN_WIDTH (f));
- adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth);
+ int text_width
+ = check_frame_pixels (width, pixelwise, FRAME_COLUMN_WIDTH (f));
+
+ /* With INHIBIT 1 pass correct text height to adjust_frame_size. */
+ adjust_frame_size
+ (f, text_width, FRAME_TEXT_HEIGHT (f), 1, !NILP (pretend), Qwidth);
+
return Qnil;
}
@@ -3656,11 +3719,14 @@ If FRAME is nil, it defaults to the selected frame. */)
(Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise)
{
struct frame *f = decode_live_frame (frame);
- int pixel_width = check_frame_pixels (width, pixelwise,
- FRAME_COLUMN_WIDTH (f));
- int pixel_height = check_frame_pixels (height, pixelwise,
- FRAME_LINE_HEIGHT (f));
- adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize);
+ int text_width
+ = check_frame_pixels (width, pixelwise, FRAME_COLUMN_WIDTH (f));
+ int text_height
+ = check_frame_pixels (height, pixelwise, FRAME_LINE_HEIGHT (f));
+
+ /* PRETEND is always false here. */
+ adjust_frame_size (f, text_width, text_height, 1, false, Qsize);
+
return Qnil;
}
@@ -3744,6 +3810,18 @@ window state change flag is reset. */)
return (FRAME_WINDOW_STATE_CHANGE (f) = !NILP (arg)) ? Qt : Qnil;
}
+DEFUN ("frame-scale-factor", Fframe_scale_factor, Sframe_scale_factor,
+ 0, 1, 0,
+ doc: /* Return FRAMEs scale factor.
+If FRAME is omitted or nil, the selected frame is used.
+The scale factor is the amount by which a logical pixel size must be
+multiplied to find the real number of pixels. */)
+ (Lisp_Object frame)
+{
+ struct frame *f = decode_live_frame (frame);
+
+ return (make_float (f ? FRAME_SCALE_FACTOR (f) : 1));
+}
/***********************************************************************
Frame Parameters
@@ -3890,7 +3968,7 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
Lisp_Object frame;
XSETFRAME (frame, f);
- monitor_attributes = Fcar (call1 (Qdisplay_monitor_attributes_list, frame));
+ monitor_attributes = call1 (Qframe_monitor_attributes, frame);
if (NILP (monitor_attributes))
{
/* No monitor attributes available. */
@@ -4012,11 +4090,9 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
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
- entire list before we set them. */
- int width = -1, height = -1; /* -1 denotes they were not changed. */
+ /* Neither of these values should be used. */
+ int width = -1, height = -1;
+ bool width_change = false, height_change = false;
/* Same here. */
Lisp_Object left, top;
@@ -4094,6 +4170,8 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
if (EQ (prop, Qwidth))
{
+ width_change = true;
+
if (RANGED_FIXNUMP (0, val, INT_MAX))
width = XFIXNAT (val) * FRAME_COLUMN_WIDTH (f) ;
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
@@ -4102,9 +4180,13 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
else if (FLOATP (val))
width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done,
&outer_done, -1);
+ else
+ width_change = false;
}
else if (EQ (prop, Qheight))
{
+ height_change = true;
+
if (RANGED_FIXNUMP (0, val, INT_MAX))
height = XFIXNAT (val) * FRAME_LINE_HEIGHT (f);
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
@@ -4113,6 +4195,8 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
else if (FLOATP (val))
height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done,
&outer_done, -1);
+ else
+ height_change = false;
}
else if (EQ (prop, Qtop))
top = val;
@@ -4181,23 +4265,28 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
XSETINT (icon_top, 0);
}
- /* Don't set these parameters unless they've been explicitly
- specified. The window might be mapped or resized while we're in
- this function, and we don't want to override that unless the lisp
- code has asked for it.
-
- Don't set these parameters unless they actually differ from the
- window's current parameters; the window may not actually exist
- yet. */
- 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_set_window_size && (f->new_height || f->new_width))) **/
- adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
+ if (width_change || height_change)
+ {
+ Lisp_Object parameter;
+
+ if (width_change)
+ {
+ if (height_change)
+ parameter = Qsize;
+ else
+ {
+ height = FRAME_TEXT_HEIGHT (f);
+ parameter = Qwidth;
+ }
+ }
+ else
+ {
+ width = FRAME_TEXT_WIDTH (f);
+ parameter = Qheight;
+ }
+
+ adjust_frame_size (f, width, height, 1, 0, parameter);
+ }
if ((!NILP (left) || !NILP (top))
&& ! (left_no_change && top_no_change)
@@ -4270,9 +4359,6 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
Lisp_Object old_value = get_frame_param (f, Qfullscreen);
- 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))
gui_set_fullscreen (f, fullscreen, old_value);
@@ -5481,25 +5567,16 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
This function does not make the coordinates positive. */
-#define DEFAULT_ROWS 36
-#define DEFAULT_COLS 80
-
long
gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
- bool toolbar_p, int *x_width, int *x_height)
+ bool toolbar_p)
{
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
- window manager prompting. */
- SET_FRAME_WIDTH (f, DEFAULT_COLS * FRAME_COLUMN_WIDTH (f));
- SET_FRAME_COLS (f, DEFAULT_COLS);
- SET_FRAME_HEIGHT (f, DEFAULT_ROWS * FRAME_LINE_HEIGHT (f));
- SET_FRAME_LINES (f, DEFAULT_ROWS);
+ int text_width = 80 * FRAME_COLUMN_WIDTH (f);
+ int text_height = 36 * FRAME_LINE_HEIGHT (f);
/* Window managers expect that if program-specified
positions are not (0,0), they're intentional, not defaults. */
@@ -5514,8 +5591,12 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
if (tabbar_p && FRAME_TAB_BAR_LINES (f))
{
if (frame_default_tab_bar_height)
+ /* A default tab bar height was already set by the display code
+ for some other frame, use that. */
FRAME_TAB_BAR_HEIGHT (f) = frame_default_tab_bar_height;
else
+ /* Calculate the height from various other settings. For some
+ reason, these are usually off by 2 hence of no use. */
{
int margin, relief;
@@ -5568,7 +5649,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
/* Ensure that earlier new_width and new_height settings won't
override what we specify below. */
- f->new_width = f->new_height = 0;
+ f->new_width = f->new_height = -1;
height = gui_display_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
width = gui_display_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
@@ -5582,9 +5663,8 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
if ((XFIXNUM (XCDR (width)) < 0 || XFIXNUM (XCDR (width)) > INT_MAX))
xsignal1 (Qargs_out_of_range, XCDR (width));
- SET_FRAME_WIDTH (f, XFIXNUM (XCDR (width)));
+ text_width = XFIXNUM (XCDR (width));
f->inhibit_horizontal_resize = true;
- *x_width = XFIXNUM (XCDR (width));
}
else if (FLOATP (width))
{
@@ -5598,7 +5678,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
&parent_done, &outer_done, -1);
if (new_width > -1)
- SET_FRAME_WIDTH (f, new_width);
+ text_width = new_width;
}
}
else
@@ -5607,7 +5687,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
if ((XFIXNUM (width) < 0 || XFIXNUM (width) > INT_MAX))
xsignal1 (Qargs_out_of_range, width);
- SET_FRAME_WIDTH (f, XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
+ text_width = XFIXNUM (width) * FRAME_COLUMN_WIDTH (f);
}
}
@@ -5619,9 +5699,8 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
if ((XFIXNUM (XCDR (height)) < 0 || XFIXNUM (XCDR (height)) > INT_MAX))
xsignal1 (Qargs_out_of_range, XCDR (height));
- SET_FRAME_HEIGHT (f, XFIXNUM (XCDR (height)));
+ text_height = XFIXNUM (XCDR (height));
f->inhibit_vertical_resize = true;
- *x_height = XFIXNUM (XCDR (height));
}
else if (FLOATP (height))
{
@@ -5635,7 +5714,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
&parent_done, &outer_done, -1);
if (new_height > -1)
- SET_FRAME_HEIGHT (f, new_height);
+ text_height = new_height;
}
}
else
@@ -5644,7 +5723,7 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
if ((XFIXNUM (height) < 0) || (XFIXNUM (height) > INT_MAX))
xsignal1 (Qargs_out_of_range, height);
- SET_FRAME_HEIGHT (f, XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
+ text_height = XFIXNUM (height) * FRAME_LINE_HEIGHT (f);
}
}
@@ -5656,6 +5735,9 @@ gui_figure_window_size (struct frame *f, Lisp_Object parms, bool tabbar_p,
window_prompting |= PSize;
}
+ adjust_frame_size (f, text_width, text_height, 5, false,
+ Qgui_figure_window_size);
+
top = gui_display_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
left = gui_display_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
user_position = gui_display_get_arg (dpyinfo, parms, Quser_position, 0, 0,
@@ -5790,7 +5872,18 @@ selected frame. This is useful when `make-pointer-invisible' is set. */)
return decode_any_frame (frame)->pointer_invisible ? Qnil : Qt;
}
+DEFUN ("frame--set-was-invisible", Fframe__set_was_invisible,
+ Sframe__set_was_invisible, 2, 2, 0,
+ doc: /* Set FRAME's was-invisible flag if WAS-INVISIBLE is non-nil.
+This function is for internal use only. */)
+ (Lisp_Object frame, Lisp_Object was_invisible)
+{
+ struct frame *f = decode_live_frame (frame);
+
+ f->was_invisible = !NILP (was_invisible);
+ return f->was_invisible ? Qt : Qnil;
+}
/***********************************************************************
Multimonitor data
@@ -5890,7 +5983,7 @@ syms_of_frame (void)
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
- DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list");
+ DEFSYM (Qframe_monitor_attributes, "frame-monitor-attributes");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
@@ -5963,39 +6056,17 @@ syms_of_frame (void)
DEFSYM (Qtab_bar_size, "tab-bar-size");
DEFSYM (Qtool_bar_external, "tool-bar-external");
DEFSYM (Qtool_bar_size, "tool-bar-size");
- /* The following are used for frame_size_history. */
- DEFSYM (Qadjust_frame_size_1, "adjust-frame-size-1");
- DEFSYM (Qadjust_frame_size_2, "adjust-frame-size-2");
- DEFSYM (Qadjust_frame_size_3, "adjust-frame-size-3");
- DEFSYM (Qx_set_frame_parameters, "x-set-frame-parameters");
- DEFSYM (QEmacsFrameResize, "EmacsFrameResize");
- DEFSYM (Qset_frame_size, "set-frame-size");
- DEFSYM (Qframe_inhibit_resize, "frame-inhibit-resize");
- DEFSYM (Qx_set_fullscreen, "x-set-fullscreen");
- DEFSYM (Qx_check_fullscreen, "x-check-fullscreen");
- DEFSYM (Qxg_frame_resized, "xg-frame-resized");
- DEFSYM (Qxg_frame_set_char_size_1, "xg-frame-set-char-size-1");
- DEFSYM (Qxg_frame_set_char_size_2, "xg-frame-set-char-size-2");
- DEFSYM (Qxg_frame_set_char_size_3, "xg-frame-set-char-size-3");
- DEFSYM (Qxg_frame_set_char_size_4, "xg-frame-set-char-size-4");
- DEFSYM (Qx_set_window_size_1, "x-set-window-size-1");
- DEFSYM (Qx_set_window_size_2, "x-set-window-size-2");
- DEFSYM (Qx_set_window_size_3, "x-set-window-size-3");
- DEFSYM (Qxg_change_toolbar_position, "xg-change-toolbar-position");
- DEFSYM (Qx_net_wm_state, "x-net-wm-state");
- DEFSYM (Qx_handle_net_wm_state, "x-handle-net-wm-state");
- DEFSYM (Qtb_size_cb, "tb-size-cb");
- DEFSYM (Qupdate_frame_tab_bar, "update-frame-tab-bar");
- DEFSYM (Qupdate_frame_tool_bar, "update-frame-tool-bar");
- DEFSYM (Qfree_frame_tab_bar, "free-frame-tab-bar");
- DEFSYM (Qfree_frame_tool_bar, "free-frame-tool-bar");
- DEFSYM (Qx_set_menu_bar_lines, "x-set-menu-bar-lines");
- DEFSYM (Qchange_frame_size, "change-frame-size");
- DEFSYM (Qxg_frame_set_char_size, "xg-frame-set-char-size");
- DEFSYM (Qset_window_configuration, "set-window-configuration");
- DEFSYM (Qx_create_frame_1, "x-create-frame-1");
- DEFSYM (Qx_create_frame_2, "x-create-frame-2");
- DEFSYM (Qterminal_frame, "terminal-frame");
+ /* The following are passed to adjust_frame_size. */
+ DEFSYM (Qx_set_menu_bar_lines, "x_set_menu_bar_lines");
+ DEFSYM (Qchange_frame_size, "change_frame_size");
+ DEFSYM (Qxg_frame_set_char_size, "xg_frame_set_char_size");
+ DEFSYM (Qx_set_window_size_1, "x_set_window_size_1");
+ DEFSYM (Qset_window_configuration, "set_window_configuration");
+ DEFSYM (Qx_create_frame_1, "x_create_frame_1");
+ DEFSYM (Qx_create_frame_2, "x_create_frame_2");
+ DEFSYM (Qgui_figure_window_size, "gui_figure_window_size");
+ DEFSYM (Qtip_frame, "tip_frame");
+ DEFSYM (Qterminal_frame, "terminal_frame");
#ifdef HAVE_NS
DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
@@ -6024,9 +6095,7 @@ syms_of_frame (void)
DEFSYM (Qleft_fringe, "left-fringe");
DEFSYM (Qline_spacing, "line-spacing");
DEFSYM (Qmenu_bar_lines, "menu-bar-lines");
- DEFSYM (Qupdate_frame_menubar, "update-frame-menubar");
- DEFSYM (Qfree_frame_menubar_1, "free-frame-menubar-1");
- DEFSYM (Qfree_frame_menubar_2, "free-frame-menubar-2");
+ DEFSYM (Qtab_bar_lines, "tab-bar-lines");
DEFSYM (Qmouse_color, "mouse-color");
DEFSYM (Qname, "name");
DEFSYM (Qright_divider_width, "right-divider-width");
@@ -6038,7 +6107,6 @@ syms_of_frame (void)
DEFSYM (Qscroll_bar_width, "scroll-bar-width");
DEFSYM (Qsticky, "sticky");
DEFSYM (Qtitle, "title");
- DEFSYM (Qtab_bar_lines, "tab-bar-lines");
DEFSYM (Qtool_bar_lines, "tool-bar-lines");
DEFSYM (Qtool_bar_position, "tool-bar-position");
DEFSYM (Qunsplittable, "unsplittable");
@@ -6455,8 +6523,10 @@ iconify the top level frame instead. */);
defsubr (&Sframe_position);
defsubr (&Sset_frame_position);
defsubr (&Sframe_pointer_visible_p);
+ defsubr (&Sframe__set_was_invisible);
defsubr (&Sframe_window_state_change);
defsubr (&Sset_frame_window_state_change);
+ defsubr (&Sframe_scale_factor);
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sx_get_resource);
diff --git a/src/frame.h b/src/frame.h
index 9ddcb4c6810..a8ad011889d 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -158,8 +158,8 @@ struct frame
There are four additional elements of nil at the end, to terminate. */
Lisp_Object menu_bar_items;
- /* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */
- Lisp_Object face_alist;
+ /* Hash table of FACE-NAME keys and FACE-VECTOR-DATA values. */
+ Lisp_Object face_hash_table;
/* A vector that records the entire structure of this frame's menu bar.
For the format of the data, see extensive comments in xmenu.c.
@@ -256,8 +256,8 @@ struct frame
be used for output. */
bool_bf glyphs_initialized_p : 1;
- /* Set to true in change_frame_size when size of frame changed
- Clear the frame in clear_garbaged_frames if set. */
+ /* Set to true in adjust_frame_size when one of the frame's sizes
+ changed. Clear the frame in clear_garbaged_frames if set. */
bool_bf resized_p : 1;
/* Set to true if the default face for the frame has been
@@ -415,10 +415,6 @@ struct frame
bool_bf no_special_glyphs : 1;
#endif /* HAVE_WINDOW_SYSTEM */
- /* Whether new_height and new_width shall be interpreted
- in pixels. */
- bool_bf new_pixelwise : 1;
-
/* True means set_window_size_hook requests can be processed for
this frame. */
bool_bf can_set_window_size : 1;
@@ -426,11 +422,23 @@ struct frame
/* Set to true after this frame was made by `make-frame'. */
bool_bf after_make_frame : 1;
- /* Whether the tab bar height change should be taken into account. */
+ /* Two sticky flags, that are both false when a frame is created.
+ 'display_tab_bar' sets the former to true the first time it
+ displays the tab bar. When the former is true, the next call of
+ 'x_change_tab_bar_height' and associates sets the latter true and
+ tries to adjust the frame height in a way that the now valid pixel
+ height of the tab bar is taken into account by the frame's native
+ height. */
bool_bf tab_bar_redisplayed : 1;
bool_bf tab_bar_resized : 1;
- /* Whether the tool bar height change should be taken into account. */
+ /* Two sticky flags, that are both false when a frame is created.
+ 'redisplay_tool_bar' sets the former to true the first time it
+ displays the tool bar. When the former is true, the next call of
+ 'x_change_tool_bar_height' and associates sets the latter true and
+ tries to adjust the frame height in a way that the now valid pixel
+ height of the tool bar is taken into account by the frame's native
+ height. */
bool_bf tool_bar_redisplayed : 1;
bool_bf tool_bar_resized : 1;
@@ -445,6 +453,20 @@ struct frame
frame is in the process of being redisplayed. */
bool_bf inhibit_clear_image_cache : 1;
+ /* True when new_width or new_height were set by change_frame_size,
+ false when they were set by adjust_frame_size internally or not
+ set. */
+ bool_bf new_size_p : 1;
+
+ /* True when frame was invisible before first MapNotify event. Used
+ in X builds only. */
+ bool_bf was_invisible : 1;
+
+ /* True when the frame isn't selected, and selecting it in the
+ future should select the mini-window rather than the currently
+ selected window in the frame, assuming there is still an active
+ minibuffer in that mini-window. */
+ bool_bf select_mini_window_flag : 1;
/* Bitfield area ends here. */
/* This frame's change stamp, set the last time window change
@@ -461,7 +483,7 @@ struct frame
last time run_window_change_functions was called on it. */
ptrdiff_t number_of_windows;
- /* Number of lines (rounded up) of tab bar. REMOVE THIS */
+ /* Number of frame lines (rounded up) of tab bar. */
int tab_bar_lines;
/* Height of frame internal tab bar in pixels. */
@@ -470,7 +492,7 @@ struct frame
int n_tab_bar_rows;
int n_tab_bar_items;
- /* Number of lines (rounded up) of tool bar. REMOVE THIS */
+ /* Number of frame lines (rounded up) of tool bar. */
int tool_bar_lines;
/* Height of frame internal tool bar in pixels. */
@@ -492,39 +514,24 @@ struct frame
/* Cost of deleting n lines on this frame. */
int *delete_n_lines_cost;
- /* Text width of this frame (excluding fringes, vertical scroll bar
- and internal border widths) and text height (excluding menu bar,
- tool bar, horizontal scroll bar and internal border widths) in
- units of canonical characters. */
+ /* Text width and height of this frame in (and maybe rounded to) frame
+ columns and lines. */
int text_cols, text_lines;
-
- /* Total width of this frame (including fringes, vertical scroll bar
- and internal border widths) and total height (including menu bar,
- tool bar, horizontal scroll bar and internal border widths) in
- units of canonical characters. */
- int total_cols, total_lines;
-
- /* Text width of this frame (excluding fringes, vertical scroll bar
- and internal border widths) and text height (excluding menu bar,
- tool bar, horizontal scroll bar and internal border widths) in
- pixels. */
+ /* Text width and height of this frame in pixels. */
int text_width, text_height;
- /* 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
- text width/height of the frame. */
+ /* Native width of this frame in (and maybe rounded to) frame columns
+ and lines. */
+ int total_cols, total_lines;
+ /* Native width and height of this frame in pixels. */
+ int pixel_width, pixel_height;
+ /* New native width and height of this frame for pending size change,
+ in pixels. -1 if no change pending. */
int new_width, new_height;
/* Pixel position of the frame window (x and y offsets in root window). */
int left_pos, top_pos;
- /* Total width of this frame (including fringes, vertical scroll bar
- and internal border widths) and total height (including internal
- menu and tool bars, horizontal scroll bar and internal border
- widths) in pixels. */
- int pixel_width, pixel_height;
-
/* This is the gravity value for the specified window position. */
int win_gravity;
@@ -665,9 +672,9 @@ fset_condemned_scroll_bars (struct frame *f, Lisp_Object val)
f->condemned_scroll_bars = val;
}
INLINE void
-fset_face_alist (struct frame *f, Lisp_Object val)
+fset_face_hash_table (struct frame *f, Lisp_Object val)
{
- f->face_alist = val;
+ f->face_hash_table = val;
}
#if defined (HAVE_WINDOW_SYSTEM)
INLINE void
@@ -848,7 +855,6 @@ default_pixels_per_inch_y (void)
/* FRAME_WINDOW_P tests whether the frame is a graphical window system
frame. */
-
#ifdef HAVE_X_WINDOWS
#define FRAME_WINDOW_P(f) FRAME_X_P (f)
#endif
@@ -907,45 +913,43 @@ default_pixels_per_inch_y (void)
(WINDOWP (f->minibuffer_window) \
&& XFRAME (XWINDOW (f->minibuffer_window)->frame) == f)
-/* Pixel width of frame F. */
-#define FRAME_PIXEL_WIDTH(f) ((f)->pixel_width)
+/* Scale factor of frame F. */
+#if defined HAVE_NS
+# define FRAME_SCALE_FACTOR(f) (FRAME_NS_P (f) ? ns_frame_scale_factor (f) : 1)
+#else
+# define FRAME_SCALE_FACTOR(f) 1
+#endif
-/* Pixel height of frame F. */
+/* Native width and height of frame F, in pixels and frame
+ columns/lines. */
+#define FRAME_PIXEL_WIDTH(f) ((f)->pixel_width)
#define FRAME_PIXEL_HEIGHT(f) ((f)->pixel_height)
+#define FRAME_TOTAL_COLS(f) ((f)->total_cols)
+#define FRAME_TOTAL_LINES(f) ((f)->total_lines)
-/* Width of frame F, measured in canonical character columns,
- not including scroll bars if any. */
-#define FRAME_COLS(f) (f)->text_cols
-
-/* Height of frame F, measured in canonical lines, including
- non-toolkit menu bar and non-toolkit tool bar lines. */
-#define FRAME_LINES(f) (f)->text_lines
-
-/* Width of frame F, measured in pixels not including the width for
- fringes, scroll bar, and internal borders. */
+/* Text width and height of frame F, in pixels and frame
+ columns/lines. */
#define FRAME_TEXT_WIDTH(f) (f)->text_width
-
-/* Height of frame F, measured in pixels not including the height
- for scroll bar and internal borders. */
#define FRAME_TEXT_HEIGHT(f) (f)->text_height
+#define FRAME_COLS(f) ((f)->text_cols)
+#define FRAME_LINES(f) ((f)->text_lines)
-/* Number of lines of frame F used for menu bar.
- This is relevant on terminal frames and on
- X Windows when not using the X toolkit.
- These lines are counted in FRAME_LINES. */
-#define FRAME_MENU_BAR_LINES(f) (f)->menu_bar_lines
+/* True if this frame should display an external menu bar. */
+#ifdef HAVE_EXT_MENU_BAR
+#define FRAME_EXTERNAL_MENU_BAR(f) (f)->external_menu_bar
+#else
+#define FRAME_EXTERNAL_MENU_BAR(f) false
+#endif
-/* Pixel height of frame F's menu bar. */
+/* Size of frame F's internal menu bar in frame lines and pixels. */
+#define FRAME_MENU_BAR_LINES(f) (f)->menu_bar_lines
#define FRAME_MENU_BAR_HEIGHT(f) (f)->menu_bar_height
-/* Number of lines of frame F used for the tab-bar. */
+/* Size of frame F's tab bar in frame lines and pixels. */
#define FRAME_TAB_BAR_LINES(f) (f)->tab_bar_lines
-
-/* Pixel height of frame F's tab-bar. */
#define FRAME_TAB_BAR_HEIGHT(f) (f)->tab_bar_height
-/* True if this frame should display a tool bar
- in a way that does not use any text lines. */
+/* True if this frame should display an external tool bar. */
#ifdef HAVE_EXT_TOOL_BAR
#define FRAME_EXTERNAL_TOOL_BAR(f) (f)->external_tool_bar
#else
@@ -959,27 +963,21 @@ default_pixels_per_inch_y (void)
#define FRAME_TOOL_BAR_POSITION(f) ((void) (f), Qtop)
#endif
-/* Number of lines of frame F used for the tool-bar. */
+/* Size of frame F's internal tool bar in frame lines and pixels. */
#define FRAME_TOOL_BAR_LINES(f) (f)->tool_bar_lines
-
-/* Pixel height of frame F's tool-bar. */
#define FRAME_TOOL_BAR_HEIGHT(f) (f)->tool_bar_height
-/* Lines above the top-most window in frame F. */
-#define FRAME_TOP_MARGIN(F) \
- (FRAME_MENU_BAR_LINES (F) + FRAME_TAB_BAR_LINES (F) + FRAME_TOOL_BAR_LINES (F))
+/* Height of frame F's top margin in frame lines. */
+#define FRAME_TOP_MARGIN(F) \
+ (FRAME_MENU_BAR_LINES (F) \
+ + FRAME_TAB_BAR_LINES (F) \
+ + FRAME_TOOL_BAR_LINES (F))
/* Pixel height of frame F's top margin. */
-#define FRAME_TOP_MARGIN_HEIGHT(F) \
- (FRAME_MENU_BAR_HEIGHT (F) + FRAME_TAB_BAR_HEIGHT (F) + FRAME_TOOL_BAR_HEIGHT (F))
-
-/* True if this frame should display a menu bar
- in a way that does not use any text lines. */
-#ifdef HAVE_EXT_MENU_BAR
-#define FRAME_EXTERNAL_MENU_BAR(f) (f)->external_menu_bar
-#else
-#define FRAME_EXTERNAL_MENU_BAR(f) false
-#endif
+#define FRAME_TOP_MARGIN_HEIGHT(F) \
+ (FRAME_MENU_BAR_HEIGHT (F) \
+ + FRAME_TAB_BAR_HEIGHT (F) \
+ + FRAME_TOOL_BAR_HEIGHT (F))
/* True if frame F is currently visible. */
#define FRAME_VISIBLE_P(f) (f)->visible
@@ -1176,48 +1174,6 @@ default_pixels_per_inch_y (void)
? FRAME_CONFIG_SCROLL_BAR_LINES (f) \
: 0)
-/* Total width of frame F, in columns (characters),
- including the width used by scroll bars if any. */
-#define FRAME_TOTAL_COLS(f) ((f)->total_cols)
-
-/* Total height of frame F, in lines (characters),
- including the height used by scroll bars if any. */
-#define FRAME_TOTAL_LINES(f) ((f)->total_lines)
-
-/* Set the character widths of frame F. WIDTH specifies a nominal
- character text width. */
-#define SET_FRAME_COLS(f, width) \
- ((f)->text_cols = (width), \
- (f)->total_cols = ((width) \
- + FRAME_SCROLL_BAR_COLS (f) \
- + FRAME_FRINGE_COLS (f)))
-
-/* Set the character heights of frame F. HEIGHT specifies a nominal
- character text height. */
-#define SET_FRAME_LINES(f, height) \
- ((f)->text_lines = (height), \
- (f)->total_lines = ((height) \
- + FRAME_TOP_MARGIN (f) \
- + FRAME_SCROLL_BAR_LINES (f)))
-
-/* Set the widths of frame F. WIDTH specifies a nominal pixel text
- width. */
-#define SET_FRAME_WIDTH(f, width) \
- ((f)->text_width = (width), \
- (f)->pixel_width = ((width) \
- + FRAME_SCROLL_BAR_AREA_WIDTH (f) \
- + FRAME_TOTAL_FRINGE_WIDTH (f) \
- + 2 * FRAME_INTERNAL_BORDER_WIDTH (f)))
-
-/* Set the heights of frame F. HEIGHT specifies a nominal pixel text
- height. */
-#define SET_FRAME_HEIGHT(f, height) \
- ((f)->text_height = (height), \
- (f)->pixel_height = ((height) \
- + FRAME_TOP_MARGIN_HEIGHT (f) \
- + FRAME_SCROLL_BAR_AREA_HEIGHT (f) \
- + 2 * FRAME_INTERNAL_BORDER_WIDTH (f)))
-
/* Maximum + 1 legitimate value for FRAME_CURSOR_X. */
#define FRAME_CURSOR_X_LIMIT(f) \
(FRAME_COLS (f) + FRAME_LEFT_SCROLL_BAR_COLS (f))
@@ -1238,7 +1194,6 @@ default_pixels_per_inch_y (void)
#define FRAME_BACKGROUND_PIXEL(f) ((f)->background_pixel)
/* Return a pointer to the face cache of frame F. */
-
#define FRAME_FACE_CACHE(F) (F)->face_cache
/* Return the size of message_buf of the frame F. We multiply the
@@ -1264,15 +1219,13 @@ default_pixels_per_inch_y (void)
This macro is a holdover from a time when multiple frames weren't always
supported. An alternate definition of the macro would expand to
something which executes the statement once. */
-
-#define FOR_EACH_FRAME(list_var, frame_var) \
- for ((list_var) = Vframe_list; \
- (CONSP (list_var) \
+#define FOR_EACH_FRAME(list_var, frame_var) \
+ for ((list_var) = Vframe_list; \
+ (CONSP (list_var) \
&& (frame_var = XCAR (list_var), true)); \
list_var = XCDR (list_var))
/* Reflect mouse movement when a complete frame update is performed. */
-
#define FRAME_MOUSE_UPDATE(frame) \
do { \
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (frame); \
@@ -1287,8 +1240,7 @@ default_pixels_per_inch_y (void)
} while (false)
/* Handy macro to construct an argument to Fmodify_frame_parameters. */
-
-#define AUTO_FRAME_ARG(name, parameter, value) \
+#define AUTO_FRAME_ARG(name, parameter, value) \
AUTO_LIST1 (name, AUTO_CONS_EXPR (parameter, value))
/* False means there are no visible garbaged frames. */
@@ -1298,7 +1250,6 @@ extern bool frame_garbaged;
We call redisplay_other_windows to make sure the frame gets redisplayed
if some changes were applied to it while it wasn't visible (and hence
wasn't redisplayed). */
-
INLINE void
SET_FRAME_VISIBLE (struct frame *f, int v)
{
@@ -1313,9 +1264,8 @@ SET_FRAME_VISIBLE (struct frame *f, int v)
f->visible = v;
}
-/* Set iconify of frame F. */
-
-#define SET_FRAME_ICONIFIED(f, i) \
+/* Set iconified status of frame F. */
+#define SET_FRAME_ICONIFIED(f, i) \
(f)->iconified = (eassert (0 <= (i) && (i) <= 1), (i))
extern Lisp_Object selected_frame;
@@ -1362,11 +1312,14 @@ extern void frame_make_pointer_invisible (struct frame *);
extern void frame_make_pointer_visible (struct frame *);
extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object);
extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object);
-extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object);
-extern void frame_size_history_add (struct frame *f, Lisp_Object fun_symbol,
- int width, int height, Lisp_Object rest);
+extern void adjust_frame_size (struct frame *, int, int, int, bool,
+ Lisp_Object);
extern Lisp_Object mouse_position (bool);
-
+extern int frame_windows_min_size (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object);
+extern void frame_size_history_plain (struct frame *, Lisp_Object);
+extern void frame_size_history_extra (struct frame *, Lisp_Object,
+ int, int, int, int, int, int);
extern Lisp_Object Vframe_list;
/* Value is a pointer to the selected frame. If the selected frame
@@ -1645,12 +1598,11 @@ IMAGE_OPT_FROM_ID (struct frame *f, int id)
- FRAME_SCROLL_BAR_AREA_HEIGHT (f) \
- 2 * FRAME_INTERNAL_BORDER_WIDTH (f))
-/* Return the width/height reserved for the windows of frame F. */
-#define FRAME_WINDOWS_WIDTH(f) \
+#define FRAME_INNER_WIDTH(f) \
(FRAME_PIXEL_WIDTH (f) \
- 2 * FRAME_INTERNAL_BORDER_WIDTH (f))
-#define FRAME_WINDOWS_HEIGHT(f) \
+#define FRAME_INNER_HEIGHT(f) \
(FRAME_PIXEL_HEIGHT (f) \
- FRAME_TOP_MARGIN_HEIGHT (f) \
- 2 * FRAME_INTERNAL_BORDER_WIDTH (f))
@@ -1694,7 +1646,7 @@ extern void gui_set_horizontal_scroll_bars (struct frame *, Lisp_Object, Lisp_Ob
extern void gui_set_scroll_bar_width (struct frame *, Lisp_Object, Lisp_Object);
extern void gui_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object);
-extern long gui_figure_window_size (struct frame *, Lisp_Object, bool, bool, int *, int *);
+extern long gui_figure_window_size (struct frame *, Lisp_Object, bool, bool);
extern void gui_set_alpha (struct frame *, Lisp_Object, Lisp_Object);
extern void gui_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object);
diff --git a/src/fringe.c b/src/fringe.c
index 65c9a84ac99..b651a4eb0d9 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -969,6 +969,14 @@ update_window_fringes (struct window *w, bool keep_current_p)
if (w->pseudo_window_p)
return 0;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* This function could be called for redisplaying non-selected
+ windows, in which case point has been temporarily moved to that
+ window's window-point. So we cannot afford quitting out of here,
+ as point is restored after this function returns. */
+ specbind (Qinhibit_quit, Qt);
+
if (!MINI_WINDOW_P (w)
&& (ind = BVAR (XBUFFER (w->contents), indicate_buffer_boundaries), !NILP (ind)))
{
@@ -1331,6 +1339,8 @@ update_window_fringes (struct window *w, bool keep_current_p)
row->fringe_bitmap_periodic_p = periodic_p;
}
+ unbind_to (count, Qnil);
+
return redraw_p && !keep_current_p;
}
@@ -1776,14 +1786,15 @@ gui_init_fringe (struct redisplay_interface *rif)
for (bt = NO_FRINGE_BITMAP + 1; bt < MAX_STANDARD_FRINGE_BITMAPS; bt++)
{
struct fringe_bitmap *fb = &standard_bitmaps[bt];
- rif->define_fringe_bitmap (bt, fb->bits, fb->height, fb->width);
+ if (!fringe_bitmaps[bt])
+ rif->define_fringe_bitmap (bt, fb->bits, fb->height, fb->width);
}
/* Set up user-defined fringe bitmaps that might have been defined
before the frame of this kind was initialized. This can happen
if Emacs is started as a daemon and the init files define fringe
bitmaps. */
- for ( ; bt < max_used_fringe_bitmap; bt++)
+ for (bt = NO_FRINGE_BITMAP + 1; bt < max_used_fringe_bitmap; bt++)
{
struct fringe_bitmap *fb = fringe_bitmaps[bt];
if (fb)
diff --git a/src/ftfont.c b/src/ftfont.c
index 0603dd9ce68..12d0d72d276 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -2798,10 +2798,31 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
if (gstring.used > LGSTRING_GLYPH_LEN (lgstring))
return Qnil;
+
+ /* mflt_run may fail to set g->g.to (which must be a valid index
+ into lgstring) correctly if the font has an OTF table that is
+ different from what the m17n library expects. */
for (i = 0; i < gstring.used; i++)
{
MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i;
+ if (g->g.to >= len)
+ {
+ /* Invalid g->g.to. */
+ g->g.to = len - 1;
+ int from = g->g.from;
+ /* Fix remaining glyphs. */
+ for (++i; i < gstring.used; i++)
+ {
+ g = (MFLTGlyphFT *) (gstring.glyphs) + i;
+ g->g.from = from;
+ g->g.to = len - 1;
+ }
+ }
+ }
+ for (i = 0; i < gstring.used; i++)
+ {
+ MFLTGlyphFT *g = (MFLTGlyphFT *) (gstring.glyphs) + i;
g->g.from = LGLYPH_FROM (LGSTRING_GLYPH (lgstring, g->g.from));
g->g.to = LGLYPH_TO (LGSTRING_GLYPH (lgstring, g->g.to));
}
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 66008ea69b2..55ae7365d99 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -1690,16 +1690,6 @@ valloc (size_t size)
#undef free
#ifdef HYBRID_MALLOC
-/* Declare system malloc and friends. */
-extern void *malloc (size_t size);
-extern void *realloc (void *ptr, size_t size);
-extern void *calloc (size_t nmemb, size_t size);
-extern void free (void *ptr);
-#ifdef HAVE_ALIGNED_ALLOC
-extern void *aligned_alloc (size_t alignment, size_t size);
-#elif defined HAVE_POSIX_MEMALIGN
-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
@@ -1736,8 +1726,8 @@ hybrid_calloc (size_t nmemb, size_t size)
return gcalloc (nmemb, size);
}
-void
-hybrid_free (void *ptr)
+static void
+hybrid_free_1 (void *ptr)
{
if (allocated_via_gmalloc (ptr))
gfree (ptr);
@@ -1745,6 +1735,24 @@ hybrid_free (void *ptr)
free (ptr);
}
+void
+hybrid_free (void *ptr)
+{
+ /* Stolen from Gnulib, to make sure we preserve errno. */
+#if defined __GNUC__ && !defined __clang__
+ int err[2];
+ err[0] = errno;
+ err[1] = errno;
+ errno = 0;
+ hybrid_free_1 (ptr);
+ errno = err[errno == 0];
+#else
+ int err = errno;
+ hybrid_free_1 (ptr);
+ errno = err;
+#endif
+}
+
#if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
void *
hybrid_aligned_alloc (size_t alignment, size_t size)
diff --git a/src/gnutls.c b/src/gnutls.c
index aa245ee5c39..22e7f2cbc17 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -625,14 +625,11 @@ gnutls_try_handshake (struct Lisp_Process *proc)
while ((ret = gnutls_handshake (state)) < 0)
{
- do
- ret = gnutls_handshake (state);
- while (ret == GNUTLS_E_INTERRUPTED);
-
- if (0 <= ret || emacs_gnutls_handle_error (state, ret) == 0
- || non_blocking)
+ if (emacs_gnutls_handle_error (state, ret) == 0) /* fatal */
break;
maybe_quit ();
+ if (non_blocking && ret != GNUTLS_E_INTERRUPTED)
+ break;
}
proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 11e59b9fae5..313cfc82c26 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -81,8 +81,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
gtk_font_selection_dialog_set_font_name (x, y)
#endif
-#define gdk_window_get_geometry(w, a, b, c, d) \
- gdk_window_get_geometry (w, a, b, c, d, 0)
#define gtk_box_new(ori, spacing) \
((ori) == GTK_ORIENTATION_HORIZONTAL \
? gtk_hbox_new (FALSE, (spacing)) : gtk_vbox_new (FALSE, (spacing)))
@@ -910,70 +908,60 @@ xg_set_geometry (struct frame *f)
}
}
-/* 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.
- F is the frame to resize.
- PIXELWIDTH, PIXELHEIGHT is the new size in pixels. */
-
+/** Function to handle resize of native frame F to WIDTH and HEIGHT
+ pixels after we got a ConfigureNotify event. */
void
-xg_frame_resized (struct frame *f, int pixelwidth, int pixelheight)
+xg_frame_resized (struct frame *f, int width, int height)
{
- int width, height;
-
- if (pixelwidth == -1 && pixelheight == -1)
+ /* Ignore case where size of native rectangle didn't change. */
+ if (width != FRAME_PIXEL_WIDTH (f)
+ || height != FRAME_PIXEL_HEIGHT (f)
+ || (f->new_size_p
+ && ((f->new_width >= 0 && width != f->new_width)
+ || (f->new_height >= 0 && height != f->new_height))))
{
- if (FRAME_GTK_WIDGET (f) && gtk_widget_get_mapped (FRAME_GTK_WIDGET (f)))
- gdk_window_get_geometry (gtk_widget_get_window (FRAME_GTK_WIDGET (f)),
- 0, 0, &pixelwidth, &pixelheight);
- else
- return;
- }
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("xg_frame_resized, changed"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), width, height,
+ f->new_size_p ? f->new_width : -1,
+ f->new_size_p ? f->new_height : -1);
- width = FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth);
- height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight);
-
- frame_size_history_add
- (f, Qxg_frame_resized, width, height, Qnil);
-
- if (width != FRAME_TEXT_WIDTH (f)
- || height != FRAME_TEXT_HEIGHT (f)
- || pixelwidth != FRAME_PIXEL_WIDTH (f)
- || pixelheight != FRAME_PIXEL_HEIGHT (f))
- {
FRAME_RIF (f)->clear_under_internal_border (f);
- change_frame_size (f, width, height, 0, 1, 0, 1);
+ change_frame_size (f, width, height, false, true, false);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
}
+ else if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("xg_frame_resized, unchanged"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), width, height,
+ f->new_size_p ? f->new_width : -1,
+ f->new_size_p ? f->new_height : -1);
+
}
/** Resize the outer window of frame F. WIDTH and HEIGHT are the new
- pixel sizes of F's text area. */
+ native pixel sizes of F. */
void
xg_frame_set_char_size (struct frame *f, int width, int height)
{
- int pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
- int pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
gint gwidth, gheight;
- int totalheight
- = pixelheight + FRAME_TOOLBAR_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f);
- int totalwidth = pixelwidth + FRAME_TOOLBAR_WIDTH (f);
+ int outer_height
+ = height + FRAME_TOOLBAR_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f);
+ int outer_width = width + FRAME_TOOLBAR_WIDTH (f);
bool was_visible = false;
bool hide_child_frame;
- if (FRAME_PIXEL_HEIGHT (f) == 0)
- return;
-
gtk_window_get_size (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
&gwidth, &gheight);
/* Do this before resize, as we don't know yet if we will be resized. */
FRAME_RIF (f)->clear_under_internal_border (f);
- totalheight /= xg_get_scale (f);
- totalwidth /= xg_get_scale (f);
+ outer_height /= xg_get_scale (f);
+ outer_width /= xg_get_scale (f);
x_wm_set_size_hint (f, 0, 0);
@@ -986,35 +974,19 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
manager will abolish it. At least the respective size should
remain unchanged but giving the frame back its normal size will
be broken ... */
- if (EQ (fullscreen, Qfullwidth) && width == FRAME_TEXT_WIDTH (f))
- {
- frame_size_history_add
- (f, Qxg_frame_set_char_size_1, width, height,
- list2i (gheight, totalheight));
-
- gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- gwidth, totalheight);
- }
- else if (EQ (fullscreen, Qfullheight) && height == FRAME_TEXT_HEIGHT (f))
- {
- frame_size_history_add
- (f, Qxg_frame_set_char_size_2, width, height,
- list2i (gwidth, totalwidth));
-
- gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- totalwidth, gheight);
- }
+ if (EQ (fullscreen, Qfullwidth) && width == FRAME_PIXEL_WIDTH (f))
+ gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ gwidth, outer_height);
+ else if (EQ (fullscreen, Qfullheight) && height == FRAME_PIXEL_HEIGHT (f))
+ gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ outer_width, gheight);
else if (FRAME_PARENT_FRAME (f) && FRAME_VISIBLE_P (f))
{
was_visible = true;
hide_child_frame = EQ (x_gtk_resize_child_frames, Qhide);
- if (totalwidth != gwidth || totalheight != gheight)
+ if (outer_width != gwidth || outer_height != gheight)
{
- frame_size_history_add
- (f, Qxg_frame_set_char_size_4, width, height,
- list2i (totalwidth, totalheight));
-
if (hide_child_frame)
{
block_input ();
@@ -1023,7 +995,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
}
gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- totalwidth, totalheight);
+ outer_width, outer_height);
if (hide_child_frame)
{
@@ -1037,11 +1009,8 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
}
else
{
- frame_size_history_add
- (f, Qxg_frame_set_char_size_3, width, height,
- list2i (totalwidth, totalheight));
gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- totalwidth, totalheight);
+ outer_width, outer_height);
fullscreen = Qnil;
}
@@ -1057,6 +1026,12 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
the frame is mapped again we will (hopefully) get the correct size. */
if (FRAME_VISIBLE_P (f) && !was_visible)
{
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("xg_frame_set_char_size, visible"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), width, height,
+ f->new_width, f->new_height);
+
/* Must call this to flush out events */
(void)gtk_events_pending ();
gdk_flush ();
@@ -1070,8 +1045,17 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
}
}
else
- adjust_frame_size (f, width, height, 5, 0, Qxg_frame_set_char_size);
-
+ {
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("xg_frame_set_char_size, invisible"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), width, height,
+ f->new_width, f->new_height);
+
+ adjust_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, width),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (f, height),
+ 5, 0, Qxg_frame_set_char_size);
+ }
}
/* Handle height/width changes (i.e. add/remove/move menu/toolbar).
@@ -1186,7 +1170,8 @@ style_changed_cb (GObject *go,
{
FRAME_TERMINAL (f)->set_scroll_bar_default_width_hook (f);
FRAME_TERMINAL (f)->set_scroll_bar_default_height_hook (f);
- xg_frame_set_char_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f));
+ xg_frame_set_char_size (f, FRAME_PIXEL_WIDTH (f),
+ FRAME_PIXEL_HEIGHT (f));
}
}
}
@@ -3236,7 +3221,7 @@ xg_update_menu_item (widget_value *val,
gtk_label_set_text (wkey, utf8_key);
}
- if (! old_label || strcmp (utf8_label, old_label) != 0)
+ if (utf8_label && (! old_label || strcmp (utf8_label, old_label) != 0))
{
label_changed = true;
gtk_label_set_text (wlbl, utf8_label);
@@ -4589,10 +4574,7 @@ tb_size_cb (GtkWidget *widget,
struct frame *f = user_data;
if (xg_update_tool_bar_sizes (f))
- {
- frame_size_history_add (f, Qtb_size_cb, 0, 0, Qnil);
- adjust_frame_size (f, -1, -1, 5, 0, Qtool_bar_lines);
- }
+ adjust_frame_size (f, -1, -1, 2, false, Qtool_bar_lines);
}
/* Create a tool bar for frame F. */
@@ -5014,11 +4996,10 @@ update_frame_tool_bar (struct frame *f)
GtkWidget *wbutton = NULL;
Lisp_Object specified_file;
bool vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY));
- const char *label
- = (EQ (style, Qimage) || (vert_only && horiz)) ? NULL
- : STRINGP (PROP (TOOL_BAR_ITEM_LABEL))
- ? SSDATA (PROP (TOOL_BAR_ITEM_LABEL))
- : "";
+ Lisp_Object label
+ = (EQ (style, Qimage) || (vert_only && horiz))
+ ? Qnil
+ : PROP (TOOL_BAR_ITEM_LABEL);
ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), j);
@@ -5131,8 +5112,11 @@ update_frame_tool_bar (struct frame *f)
/* If there is an existing widget, check if it's stale; if so,
remove it and make a new tool item from scratch. */
- if (ti && xg_tool_item_stale_p (wbutton, stock_name, icon_name,
- img, label, horiz))
+ if (ti && xg_tool_item_stale_p (wbutton, stock_name, icon_name, img,
+ NILP (label)
+ ? NULL
+ : STRINGP (label) ? SSDATA (label) : "",
+ horiz))
{
gtk_container_remove (GTK_CONTAINER (wtoolbar),
GTK_WIDGET (ti));
@@ -5189,7 +5173,11 @@ update_frame_tool_bar (struct frame *f)
#else
if (w) gtk_misc_set_padding (GTK_MISC (w), hmargin, vmargin);
#endif
- ti = xg_make_tool_item (f, w, &wbutton, label, i, horiz, text_image);
+ ti = xg_make_tool_item (f, w, &wbutton,
+ NILP (label)
+ ? NULL
+ : STRINGP (label) ? SSDATA (label) : "",
+ i, horiz, text_image);
gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, j);
}
@@ -5213,23 +5201,10 @@ update_frame_tool_bar (struct frame *f)
xg_pack_tool_bar (f, FRAME_TOOL_BAR_POSITION (f));
gtk_widget_show_all (x->toolbar_widget);
if (xg_update_tool_bar_sizes (f))
- {
- int inhibit
- = ((f->after_make_frame
- && !f->tool_bar_resized
- && (EQ (frame_inhibit_implied_resize, Qt)
- || (CONSP (frame_inhibit_implied_resize)
- && !NILP (Fmemq (Qtool_bar_lines,
- frame_inhibit_implied_resize))))
- /* This will probably fail to DTRT in the
- fullheight/-width cases. */
- && NILP (get_frame_param (f, Qfullscreen)))
- ? 0
- : 2);
-
- frame_size_history_add (f, Qupdate_frame_tool_bar, 0, 0, Qnil);
- adjust_frame_size (f, -1, -1, inhibit, 0, Qtool_bar_lines);
- }
+ /* It's not entirely clear whether here we want a treatment
+ similar to that for frames with internal tool bar. */
+ adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
+
f->tool_bar_resized = f->tool_bar_redisplayed;
}
@@ -5278,7 +5253,6 @@ free_frame_tool_bar (struct frame *f)
NULL);
}
- frame_size_history_add (f, Qfree_frame_tool_bar, 0, 0, Qnil);
adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
unblock_input ();
@@ -5310,11 +5284,7 @@ xg_change_toolbar_position (struct frame *f, Lisp_Object pos)
g_object_unref (top_widget);
if (xg_update_tool_bar_sizes (f))
- {
- frame_size_history_add (f, Qxg_change_toolbar_position, 0, 0, Qnil);
- adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
- }
-
+ adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
unblock_input ();
}
diff --git a/src/image.c b/src/image.c
index a124cf91ba0..bcd45eb4514 100644
--- a/src/image.c
+++ b/src/image.c
@@ -511,7 +511,7 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file)
/* Search bitmap-file-path for the file, if appropriate. */
if (openp (Vx_bitmap_file_path, file, Qnil, &found,
- make_fixnum (R_OK), false)
+ make_fixnum (R_OK), false, false)
< 0)
return -1;
@@ -1199,6 +1199,7 @@ free_image (struct frame *f, struct image *img)
/* Free resources, then free IMG. */
img->type->free_img (f, img);
+ xfree (img->face_font_family);
xfree (img);
}
}
@@ -1597,7 +1598,7 @@ make_image_cache (void)
static struct image *
search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash,
unsigned long foreground, unsigned long background,
- bool ignore_colors)
+ int font_size, char *font_family, bool ignore_colors)
{
struct image *img;
struct image_cache *c = FRAME_IMAGE_CACHE (f);
@@ -1621,7 +1622,10 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash,
if (img->hash == hash
&& !NILP (Fequal (img->spec, spec))
&& (ignore_colors || (img->face_foreground == foreground
- && img->face_background == background)))
+ && img->face_background == background
+ && img->face_font_size == font_size
+ && (font_family
+ &&!strcmp (font_family, img->face_font_family)))))
break;
return img;
}
@@ -1639,7 +1643,7 @@ uncache_image (struct frame *f, Lisp_Object spec)
can have multiple copies of an image with the same spec. We want
to remove them all to ensure the user doesn't see an old version
of the image when the face changes. */
- while ((img = search_image_cache (f, spec, hash, 0, 0, true)))
+ while ((img = search_image_cache (f, spec, hash, 0, 0, 0, NULL, true)))
{
free_image (f, img);
/* As display glyphs may still be referring to the image ID, we
@@ -1983,46 +1987,68 @@ scale_image_size (int size, size_t divisor, size_t multiplier)
return INT_MAX;
}
+/* Return a size, in pixels, from the value specified by SYMBOL, which
+ may be an integer or a pair of the form (VALUE . 'em) where VALUE
+ is a float that is multiplied by the font size to get the final
+ dimension.
+
+ If the value doesn't exist in the image spec, or is invalid, return
+ -1.
+*/
+static int
+image_get_dimension (struct image *img, Lisp_Object symbol)
+{
+ Lisp_Object value = image_spec_value (img->spec, symbol, NULL);
+
+ if (FIXNATP (value))
+ return min (XFIXNAT (value), INT_MAX);
+ if (CONSP (value) && NUMBERP (CAR (value)) && EQ (Qem, CDR (value)))
+ return min (img->face_font_size * XFLOATINT (CAR (value)), INT_MAX);
+
+ return -1;
+}
+
/* Compute the desired size of an image with native size WIDTH x HEIGHT.
Use SPEC to deduce the size. Store the desired size into
*D_WIDTH x *D_HEIGHT. Store -1 x -1 if the native size is OK. */
static void
compute_image_size (size_t width, size_t height,
- Lisp_Object spec,
+ struct image *img,
int *d_width, int *d_height)
{
Lisp_Object value;
+ int int_value;
int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1;
double scale = 1;
- value = image_spec_value (spec, QCscale, NULL);
+ value = image_spec_value (img->spec, QCscale, NULL);
if (NUMBERP (value))
scale = XFLOATINT (value);
- value = image_spec_value (spec, QCmax_width, NULL);
- if (FIXNATP (value))
- max_width = min (XFIXNAT (value), INT_MAX);
+ int_value = image_get_dimension (img, QCmax_width);
+ if (int_value >= 0)
+ max_width = int_value;
- value = image_spec_value (spec, QCmax_height, NULL);
- if (FIXNATP (value))
- max_height = min (XFIXNAT (value), INT_MAX);
+ int_value = image_get_dimension (img, QCmax_height);
+ if (int_value >= 0)
+ max_height = int_value;
/* 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);
- if (FIXNATP (value))
+ int_value = image_get_dimension (img, QCwidth);
+ if (int_value >= 0)
{
- desired_width = min (XFIXNAT (value) * scale, INT_MAX);
+ desired_width = int_value * scale;
/* :width overrides :max-width. */
max_width = -1;
}
- value = image_spec_value (spec, QCheight, NULL);
- if (FIXNATP (value))
+ int_value = image_get_dimension (img, QCheight);
+ if (int_value >= 0)
{
- desired_height = min (XFIXNAT (value) * scale, INT_MAX);
+ desired_height = int_value * scale;
/* :height overrides :max-height. */
max_height = -1;
}
@@ -2207,24 +2233,29 @@ image_set_transform (struct frame *f, struct image *img)
/* SVGs are pre-scaled to the correct size. */
if (EQ (image_spec_value (img->spec, QCtype, NULL), Qsvg))
{
- width = img->width;
- height = img->height;
+ width = img->width / FRAME_SCALE_FACTOR (f);
+ height = img->height / FRAME_SCALE_FACTOR (f);
}
else
#endif
- compute_image_size (img->width, img->height, img->spec, &width, &height);
+ compute_image_size (img->width, img->height, img, &width, &height);
/* Determine rotation. */
double rotation = 0.0;
compute_image_rotation (img, &rotation);
# if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS
- /* We want scale up operations to use a nearest neighbour filter to
+ /* We want scale up operations to use a nearest neighbor filter to
show real pixels instead of munging them, but scale down
operations to use a blended filter, to avoid aliasing and the like.
TODO: implement for Windows. */
- bool scale_down = (width < img->width) || (height < img->height);
+ bool smoothing;
+ Lisp_Object s = image_spec_value (img->spec, QCtransform_smoothing, NULL);
+ if (NILP (s))
+ smoothing = (width < img->width) || (height < img->height);
+ else
+ smoothing = !NILP (s);
# endif
/* Perform scale transformation. */
@@ -2338,13 +2369,13 @@ image_set_transform (struct frame *f, struct image *img)
/* Under NS the transform is applied to the drawing surface at
drawing time, so store it for later. */
ns_image_set_transform (img->pixmap, matrix);
- ns_image_set_smoothing (img->pixmap, scale_down);
+ ns_image_set_smoothing (img->pixmap, smoothing);
# elif defined USE_CAIRO
cairo_matrix_t cr_matrix = {matrix[0][0], matrix[0][1], matrix[1][0],
matrix[1][1], matrix[2][0], matrix[2][1]};
cairo_pattern_t *pattern = cairo_pattern_create_rgb (0, 0, 0);
cairo_pattern_set_matrix (pattern, &cr_matrix);
- cairo_pattern_set_filter (pattern, scale_down
+ cairo_pattern_set_filter (pattern, smoothing
? CAIRO_FILTER_BEST : CAIRO_FILTER_NEAREST);
/* Dummy solid color pattern just to record pattern matrix. */
img->cr_data = pattern;
@@ -2363,13 +2394,13 @@ image_set_transform (struct frame *f, struct image *img)
XDoubleToFixed (matrix[2][2])}}};
XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture,
- scale_down ? FilterBest : FilterNearest, 0, 0);
+ smoothing ? FilterBest : FilterNearest, 0, 0);
XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat);
if (img->mask_picture)
{
XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->mask_picture,
- scale_down ? FilterBest : FilterNearest, 0, 0);
+ smoothing ? FilterBest : FilterNearest, 0, 0);
XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->mask_picture,
&tmat);
}
@@ -2406,6 +2437,8 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id)
struct face *face = FACE_FROM_ID (f, face_id);
unsigned long foreground = FACE_COLOR_TO_PIXEL (face->foreground, f);
unsigned long background = FACE_COLOR_TO_PIXEL (face->background, f);
+ int font_size = face->font->pixel_size;
+ char *font_family = SSDATA (face->lface[LFACE_FAMILY_INDEX]);
/* F must be a window-system frame, and SPEC must be a valid image
specification. */
@@ -2414,7 +2447,8 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id)
/* Look up SPEC in the hash table of the image cache. */
hash = sxhash (spec);
- img = search_image_cache (f, spec, hash, foreground, background, false);
+ img = search_image_cache (f, spec, hash, foreground, background,
+ font_size, font_family, false);
if (img && img->load_failed_p)
{
free_image (f, img);
@@ -2429,6 +2463,9 @@ lookup_image (struct frame *f, Lisp_Object spec, int face_id)
cache_image (f, img);
img->face_foreground = foreground;
img->face_background = background;
+ img->face_font_size = font_size;
+ img->face_font_family = xmalloc (strlen (font_family) + 1);
+ strcpy (img->face_font_family, font_family);
img->load_failed_p = ! img->type->load_img (f, img);
/* If we can't load the image, and we don't have a width and
@@ -3115,20 +3152,17 @@ image_find_image_fd (Lisp_Object file, int *pfd)
/* Try to find FILE in data-directory/images, then x-bitmap-file-path. */
fd = openp (search_path, file, Qnil, &file_found,
- pfd ? Qt : make_fixnum (R_OK), false);
- if (fd >= 0 || fd == -2)
+ pfd ? Qt : make_fixnum (R_OK), false, false);
+ if (fd == -2)
{
- file_found = ENCODE_FILE (file_found);
- if (fd == -2)
- {
- /* The file exists locally, but has a file name handler.
- (This happens, e.g., under Auto Image File Mode.)
- 'openp' didn't open the file, so we should, because the
- caller expects that. */
- fd = emacs_open (SSDATA (file_found), O_RDONLY, 0);
- }
+ /* The file exists locally, but has a file name handler.
+ (This happens, e.g., under Auto Image File Mode.)
+ 'openp' didn't open the file, so we should, because the
+ caller expects that. */
+ Lisp_Object encoded_name = ENCODE_FILE (file_found);
+ fd = emacs_open (SSDATA (encoded_name), O_RDONLY, 0);
}
- else /* fd < 0, but not -2 */
+ else if (fd < 0)
return Qnil;
if (pfd)
*pfd = fd;
@@ -3136,8 +3170,8 @@ image_find_image_fd (Lisp_Object file, int *pfd)
}
/* Find image file FILE. Look in data-directory/images, then
- x-bitmap-file-path. Value is the encoded full name of the file
- found, or nil if not found. */
+ x-bitmap-file-path. Value is the full name of the file found, or
+ nil if not found. */
Lisp_Object
image_find_image_file (Lisp_Object file)
@@ -3379,6 +3413,7 @@ static int
xbm_scan (char **s, char *end, char *sval, int *ival)
{
unsigned char c UNINIT;
+ char *sval_end = sval + BUFSIZ;
loop:
@@ -3438,7 +3473,7 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
else if (c_isalpha (c) || c == '_')
{
*sval++ = c;
- while (*s < end
+ while (*s < end && sval < sval_end
&& (c = *(*s)++, (c_isalnum (c) || c == '_')))
*sval++ = c;
*sval = 0;
@@ -4023,6 +4058,7 @@ enum xpm_keyword_index
XPM_LAST
};
+#if defined HAVE_XPM || defined HAVE_NS
/* Vector of image_keyword structures describing the format
of valid XPM image specifications. */
@@ -4040,6 +4076,7 @@ static const struct image_keyword xpm_format[XPM_LAST] =
{":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
{":background", IMAGE_STRING_OR_NIL_VALUE, 0}
};
+#endif /* HAVE_XPM || HAVE_NS */
#if defined HAVE_X_WINDOWS && !defined USE_CAIRO
@@ -4263,6 +4300,7 @@ init_xpm_functions (void)
#endif /* WINDOWSNT */
+#if defined HAVE_XPM || defined HAVE_NS
/* Value is true if COLOR_SYMBOLS is a valid color symbols list
for XPM images. Such a list must consist of conses whose car and
cdr are strings. */
@@ -4283,7 +4321,6 @@ xpm_valid_color_symbols_p (Lisp_Object color_symbols)
return NILP (color_symbols);
}
-
/* Value is true if OBJECT is a valid XPM image specification. */
static bool
@@ -4299,6 +4336,7 @@ xpm_image_p (Lisp_Object object)
&& (! fmt[XPM_COLOR_SYMBOLS].count
|| xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
}
+#endif /* HAVE_XPM || HAVE_NS */
#endif /* HAVE_XPM || USE_CAIRO || HAVE_NS */
@@ -4668,10 +4706,11 @@ xpm_load (struct frame *f, struct image *img)
#endif /* HAVE_XPM && !USE_CAIRO */
-#if defined USE_CAIRO || (defined HAVE_NS && !defined HAVE_XPM)
+#if (defined USE_CAIRO && defined HAVE_XPM) \
+ || (defined HAVE_NS && !defined HAVE_XPM)
-/* XPM support functions for NS where libxpm is not available.
- Only XPM version 3 (without any extensions) is supported. */
+/* XPM support functions for NS where libxpm is not available, and for
+ Cairo. Only XPM version 3 (without any extensions) is supported. */
static void xpm_put_color_table_v (Lisp_Object, const char *,
int, Lisp_Object);
@@ -4952,7 +4991,7 @@ xpm_load_image (struct frame *f,
while (num_colors-- > 0)
{
- char *color, *max_color;
+ char *color, *max_color = NULL;
int key, next_key, max_key = 0;
Lisp_Object symbol_color = Qnil, color_val;
Emacs_Color cdef;
@@ -5013,7 +5052,7 @@ xpm_load_image (struct frame *f,
cdef.blue));
}
}
- if (NILP (color_val) && max_key > 0)
+ if (NILP (color_val) && max_color)
{
if (xstrcasecmp (max_color, "None") == 0)
color_val = Qt;
@@ -7735,6 +7774,13 @@ tiff_image_p (Lisp_Object object)
# include <tiffio.h>
+/* libtiff version 4.3.0 deprecated uint32 typedef. */
+#if TIFFLIB_VERSION >= 20210416
+# define UINT32 uint32_t
+#else
+# define UINT32 uint32
+#endif
+
# ifdef WINDOWSNT
/* TIFF library details. */
@@ -7746,7 +7792,7 @@ DEF_DLL_FN (TIFF *, TIFFClientOpen,
TIFFReadWriteProc, TIFFSeekProc, TIFFCloseProc, TIFFSizeProc,
TIFFMapFileProc, TIFFUnmapFileProc));
DEF_DLL_FN (int, TIFFGetField, (TIFF *, ttag_t, ...));
-DEF_DLL_FN (int, TIFFReadRGBAImage, (TIFF *, uint32, uint32, uint32 *, int));
+DEF_DLL_FN (int, TIFFReadRGBAImage, (TIFF *, UINT32, UINT32, UINT32 *, int));
DEF_DLL_FN (void, TIFFClose, (TIFF *));
DEF_DLL_FN (int, TIFFSetDirectory, (TIFF *, tdir_t));
@@ -7938,7 +7984,7 @@ tiff_load (struct frame *f, struct image *img)
Lisp_Object specified_data;
TIFF *tiff;
int width, height, x, y, count;
- uint32 *buf;
+ UINT32 *buf;
int rc;
Emacs_Pix_Container ximg;
tiff_memory_source memsrc;
@@ -8064,11 +8110,11 @@ tiff_load (struct frame *f, struct image *img)
/* Process the pixel raster. Origin is in the lower-left corner. */
for (y = 0; y < height; ++y)
{
- uint32 *row = buf + y * width;
+ UINT32 *row = buf + y * width;
for (x = 0; x < width; ++x)
{
- uint32 abgr = row[x];
+ UINT32 abgr = row[x];
int r = TIFFGetR (abgr) << 8;
int g = TIFFGetG (abgr) << 8;
int b = TIFFGetB (abgr) << 8;
@@ -9194,7 +9240,7 @@ imagemagick_load_image (struct frame *f, struct image *img,
compute_image_size (MagickGetImageWidth (image_wand),
MagickGetImageHeight (image_wand),
- img->spec, &desired_width, &desired_height);
+ img, &desired_width, &desired_height);
if (desired_width != -1 && desired_height != -1)
{
@@ -9526,6 +9572,7 @@ enum svg_keyword_index
SVG_DATA,
SVG_FILE,
SVG_BASE_URI,
+ SVG_CSS,
SVG_ASCENT,
SVG_MARGIN,
SVG_RELIEF,
@@ -9546,6 +9593,7 @@ static const struct image_keyword svg_format[SVG_LAST] =
{":data", IMAGE_STRING_VALUE, 0},
{":file", IMAGE_STRING_VALUE, 0},
{":base-uri", IMAGE_STRING_VALUE, 0},
+ {":css", IMAGE_STRING_VALUE, 0},
{":ascent", IMAGE_ASCENT_VALUE, 0},
{":margin", IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR, 0},
{":relief", IMAGE_INTEGER_VALUE, 0},
@@ -9629,6 +9677,11 @@ DEF_DLL_FN (gboolean, rsvg_handle_get_geometry_for_layer,
(RsvgHandle *, const char *, const RsvgRectangle *,
RsvgRectangle *, RsvgRectangle *, GError **));
# endif
+
+# if LIBRSVG_CHECK_VERSION (2, 48, 0)
+DEF_DLL_FN (gboolean, rsvg_handle_set_stylesheet,
+ (RsvgHandle *, const guint8 *, gsize, GError **));
+# endif
DEF_DLL_FN (void, rsvg_handle_get_dimensions,
(RsvgHandle *, RsvgDimensionData *));
DEF_DLL_FN (GdkPixbuf *, rsvg_handle_get_pixbuf, (RsvgHandle *));
@@ -9682,6 +9735,9 @@ init_svg_functions (void)
LOAD_DLL_FN (library, rsvg_handle_get_intrinsic_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_geometry_for_layer);
#endif
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ LOAD_DLL_FN (library, rsvg_handle_set_stylesheet);
+#endif
LOAD_DLL_FN (library, rsvg_handle_get_dimensions);
LOAD_DLL_FN (library, rsvg_handle_get_pixbuf);
@@ -9722,6 +9778,9 @@ init_svg_functions (void)
# undef rsvg_handle_get_geometry_for_layer
# endif
# undef rsvg_handle_get_dimensions
+# if LIBRSVG_CHECK_VERSION (2, 48, 0)
+# undef rsvg_handle_set_stylesheet
+# endif
# undef rsvg_handle_get_pixbuf
# if LIBRSVG_CHECK_VERSION (2, 32, 0)
# undef g_file_new_for_path
@@ -9755,6 +9814,9 @@ init_svg_functions (void)
fn_rsvg_handle_get_geometry_for_layer
# endif
# define rsvg_handle_get_dimensions fn_rsvg_handle_get_dimensions
+# if LIBRSVG_CHECK_VERSION (2, 48, 0)
+# define rsvg_handle_set_stylesheet fn_rsvg_handle_set_stylesheet
+# endif
# define rsvg_handle_get_pixbuf fn_rsvg_handle_get_pixbuf
# if LIBRSVG_CHECK_VERSION (2, 32, 0)
# define g_file_new_for_path fn_g_file_new_for_path
@@ -9832,7 +9894,7 @@ svg_load (struct frame *f, struct image *img)
#if LIBRSVG_CHECK_VERSION (2, 46, 0)
static double
-svg_css_length_to_pixels (RsvgLength length, double dpi)
+svg_css_length_to_pixels (RsvgLength length, double dpi, int font_size)
{
double value = length.length;
@@ -9860,9 +9922,16 @@ svg_css_length_to_pixels (RsvgLength length, double dpi)
case RSVG_UNIT_IN:
value *= dpi;
break;
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ /* We don't know exactly what font size is used on older librsvg
+ versions. */
+ case RSVG_UNIT_EM:
+ value *= font_size;
+ break;
+#endif
default:
- /* Probably one of em, ex, or %. We can't know what the pixel
- value is without more information. */
+ /* Probably ex or %. We can't know what the pixel value is
+ without more information. */
value = 0;
}
@@ -9892,6 +9961,10 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
char *wrapped_contents = NULL;
ptrdiff_t wrapped_size;
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ char *css = NULL;
+#endif
+
#if ! GLIB_CHECK_VERSION (2, 36, 0)
/* g_type_init is a glib function that must be called prior to
using gnome type library functions (obsolete since 2.36.0). */
@@ -9917,6 +9990,26 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
FRAME_DISPLAY_INFO (f)->resy);
+
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ Lisp_Object lcss = image_spec_value (img->spec, QCcss, NULL);
+ if (!STRINGP (lcss))
+ {
+ /* Generate the CSS for the SVG image. */
+ const char *css_spec = "svg{font-family:\"%s\";font-size:%4dpx}";
+ int css_len = strlen (css_spec) + strlen (img->face_font_family);
+ css = xmalloc (css_len);
+ snprintf (css, css_len, css_spec, img->face_font_family, img->face_font_size);
+ rsvg_handle_set_stylesheet (rsvg_handle, (guint8 *)css, strlen (css), NULL);
+ }
+ else
+ {
+ css = xmalloc (SBYTES (lcss) + 1);
+ strncpy (css, SSDATA (lcss), SBYTES (lcss));
+ *(css + SBYTES (lcss) + 1) = 0;
+ }
+#endif
+
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
@@ -9959,20 +10052,20 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
if (has_width && has_height)
{
/* Success! We can use these values directly. */
- viewbox_width = svg_css_length_to_pixels (iwidth, dpi);
- viewbox_height = svg_css_length_to_pixels (iheight, dpi);
+ viewbox_width = svg_css_length_to_pixels (iwidth, dpi, img->face_font_size);
+ viewbox_height = svg_css_length_to_pixels (iheight, dpi, img->face_font_size);
}
else if (has_width && has_viewbox)
{
- viewbox_width = svg_css_length_to_pixels (iwidth, dpi);
- viewbox_height = svg_css_length_to_pixels (iwidth, dpi)
- * viewbox.width / viewbox.height;
+ viewbox_width = svg_css_length_to_pixels (iwidth, dpi, img->face_font_size);
+ viewbox_height = svg_css_length_to_pixels (iwidth, dpi, img->face_font_size)
+ * viewbox.height / viewbox.width;
}
else if (has_height && has_viewbox)
{
- viewbox_height = svg_css_length_to_pixels (iheight, dpi);
- viewbox_width = svg_css_length_to_pixels (iheight, dpi)
- * viewbox.height / viewbox.width;
+ viewbox_height = svg_css_length_to_pixels (iheight, dpi, img->face_font_size);
+ viewbox_width = svg_css_length_to_pixels (iheight, dpi, img->face_font_size)
+ * viewbox.width / viewbox.height;
}
else if (has_viewbox)
{
@@ -10005,9 +10098,12 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
viewbox_height = dimension_data.height;
}
- compute_image_size (viewbox_width, viewbox_height, img->spec,
+ compute_image_size (viewbox_width, viewbox_height, img,
&width, &height);
+ width *= FRAME_SCALE_FACTOR (f);
+ height *= FRAME_SCALE_FACTOR (f);
+
if (! check_image_size (f, width, height))
{
image_size_error ();
@@ -10090,6 +10186,10 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
rsvg_handle_set_dpi_x_y (rsvg_handle, FRAME_DISPLAY_INFO (f)->resx,
FRAME_DISPLAY_INFO (f)->resy);
+
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ rsvg_handle_set_stylesheet (rsvg_handle, (guint8 *)css, strlen (css), NULL);
+#endif
#else
/* Make a handle to a new rsvg object. */
rsvg_handle = rsvg_handle_new ();
@@ -10123,6 +10223,11 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
g_object_unref (rsvg_handle);
xfree (wrapped_contents);
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ if (!STRINGP (lcss))
+ xfree (css);
+#endif
+
/* Extract some meta data from the svg handle. */
width = gdk_pixbuf_get_width (pixbuf);
height = gdk_pixbuf_get_height (pixbuf);
@@ -10193,6 +10298,10 @@ svg_load_image (struct frame *f, struct image *img, char *contents,
g_object_unref (rsvg_handle);
if (wrapped_contents)
xfree (wrapped_contents);
+#if LIBRSVG_CHECK_VERSION (2, 48, 0)
+ if (css && !STRINGP (lcss))
+ xfree (css);
+#endif
/* FIXME: Use error->message so the user knows what is the actual
problem with the image. */
image_error ("Error parsing SVG image `%s'", img->spec);
@@ -10684,6 +10793,7 @@ non-numeric, there is no explicit limit on the size of images. */);
DEFSYM (QCrotation, ":rotation");
DEFSYM (QCmatrix, ":matrix");
DEFSYM (QCscale, ":scale");
+ DEFSYM (QCtransform_smoothing, ":transform-smoothing");
DEFSYM (QCcolor_adjustment, ":color-adjustment");
DEFSYM (QCmask, ":mask");
@@ -10697,6 +10807,8 @@ non-numeric, there is no explicit limit on the size of images. */);
DEFSYM (QCmax_width, ":max-width");
DEFSYM (QCmax_height, ":max-height");
+ DEFSYM (Qem, "em");
+
#ifdef HAVE_NATIVE_TRANSFORMS
DEFSYM (Qscale, "scale");
DEFSYM (Qrotate, "rotate");
@@ -10783,6 +10895,7 @@ non-numeric, there is no explicit limit on the size of images. */);
#if defined (HAVE_RSVG)
DEFSYM (Qsvg, "svg");
DEFSYM (QCbase_uri, ":base-uri");
+ DEFSYM (QCcss, ":css");
add_image_type (Qsvg);
#ifdef HAVE_NTGUI
/* Other libraries used directly by svg code. */
diff --git a/src/indent.c b/src/indent.c
index 0a6b460f753..de6b4895616 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -1315,7 +1315,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
j ^---- next after the point
^--- next char. after the point.
----------
- In case of sigle-column character
+ In case of single-column character
----------
abcdefgh\\
@@ -1967,9 +1967,13 @@ line_number_display_width (struct window *w, int *width, int *pixel_width)
struct it it;
struct text_pos startpos;
bool saved_restriction = false;
+ struct buffer *old_buf = current_buffer;
ptrdiff_t count = SPECPDL_INDEX ();
SET_TEXT_POS_FROM_MARKER (startpos, w->start);
void *itdata = bidi_shelve_cache ();
+
+ /* Make sure W's buffer is the current one. */
+ set_buffer_internal_1 (XBUFFER (w->contents));
/* 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
@@ -1998,6 +2002,7 @@ line_number_display_width (struct window *w, int *width, int *pixel_width)
*pixel_width = it.lnum_pixel_width;
if (saved_restriction)
unbind_to (count, Qnil);
+ set_buffer_internal_1 (old_buf);
bidi_unshelve_cache (itdata, 0);
}
}
diff --git a/src/insdel.c b/src/insdel.c
index e38b091f542..40674e15e45 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1392,7 +1392,7 @@ adjust_after_insert (ptrdiff_t from, ptrdiff_t from_byte,
void
replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
bool prepare, bool inherit, bool markers,
- bool adjust_match_data)
+ bool adjust_match_data, bool inhibit_mod_hooks)
{
ptrdiff_t inschars = SCHARS (new);
ptrdiff_t insbytes = SBYTES (new);
@@ -1552,8 +1552,11 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new,
if (adjust_match_data)
update_search_regs (from, to, from + SCHARS (new));
- signal_after_change (from, nchars_del, GPT - from);
- update_compositions (from, GPT, CHECK_BORDER);
+ if (!inhibit_mod_hooks)
+ {
+ signal_after_change (from, nchars_del, GPT - from);
+ update_compositions (from, GPT, CHECK_BORDER);
+ }
}
/* Replace the text from character positions FROM to TO with
@@ -1989,7 +1992,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
/* Make binding buffer-file-name to nil effective. */
&& !NILP (BVAR (base_buffer, filename))
&& SAVE_MODIFF >= MODIFF)
- lock_file (BVAR (base_buffer, file_truename));
+ Flock_file (BVAR (base_buffer, file_truename));
/* If `select-active-regions' is non-nil, save the region text. */
/* FIXME: Move this to Elisp (via before-change-functions). */
diff --git a/src/json.c b/src/json.c
index 2901a20811a..b0779b912a8 100644
--- a/src/json.c
+++ b/src/json.c
@@ -327,13 +327,14 @@ struct json_configuration {
Lisp_Object false_object;
};
-static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf);
+static json_t *lisp_to_json (Lisp_Object,
+ const struct json_configuration *conf);
-/* Convert a Lisp object to a toplevel JSON object (array or object). */
+/* Convert a Lisp object to a nonscalar JSON object (array or object). */
static json_t *
-lisp_to_json_toplevel_1 (Lisp_Object lisp,
- struct json_configuration *conf)
+lisp_to_json_nonscalar_1 (Lisp_Object lisp,
+ const struct json_configuration *conf)
{
json_t *json;
ptrdiff_t count;
@@ -448,16 +449,17 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp,
return json;
}
-/* Convert LISP to a toplevel JSON object (array or object). Signal
+/* Convert LISP to a nonscalar JSON object (array or object). Signal
an error of type `wrong-type-argument' if LISP is not a vector,
hashtable, alist, or plist. */
static json_t *
-lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json_nonscalar (Lisp_Object lisp,
+ const struct json_configuration *conf)
{
if (++lisp_eval_depth > max_lisp_eval_depth)
xsignal0 (Qjson_object_too_deep);
- json_t *json = lisp_to_json_toplevel_1 (lisp, conf);
+ json_t *json = lisp_to_json_nonscalar_1 (lisp, conf);
--lisp_eval_depth;
return json;
}
@@ -467,7 +469,7 @@ lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
JSON object. */
static json_t *
-lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json (Lisp_Object lisp, const struct json_configuration *conf)
{
if (EQ (lisp, conf->null_object))
return json_check (json_null ());
@@ -499,7 +501,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration *conf)
}
/* LISP now must be a vector, hashtable, alist, or plist. */
- return lisp_to_json_toplevel (lisp, conf);
+ return lisp_to_json_nonscalar (lisp, conf);
}
static void
@@ -557,15 +559,15 @@ DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY,
NULL,
doc: /* Return the JSON representation of OBJECT as a string.
-OBJECT must be a vector, hashtable, alist, or plist and its elements
-can recursively contain the Lisp equivalents to the JSON null and
-false values, t, numbers, strings, or other vectors hashtables, alists
-or plists. t will be converted to the JSON true value. Vectors will
-be converted to JSON arrays, whereas hashtables, alists and plists are
-converted to JSON objects. Hashtable keys must be strings without
-embedded null characters and must be unique within each object. Alist
-and plist keys must be symbols; if a key is duplicate, the first
-instance is used.
+OBJECT must be t, a number, string, vector, hashtable, alist, plist,
+or the Lisp equivalents to the JSON null and false values, and its
+elements must recursively consist of the same kinds of values. t will
+be converted to the JSON true value. Vectors will be converted to
+JSON arrays, whereas hashtables, alists and plists are converted to
+JSON objects. Hashtable keys must be strings without embedded null
+characters and must be unique within each object. Alist and plist
+keys must be symbols; if a key is duplicate, the first instance is
+used.
The Lisp equivalents to the JSON null and false values are
configurable in the arguments ARGS, a list of keyword/argument pairs:
@@ -593,22 +595,18 @@ usage: (json-serialize OBJECT &rest ARGS) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
struct json_configuration conf =
{json_object_hashtable, json_array_array, QCnull, QCfalse};
json_parse_args (nargs - 1, args + 1, &conf, false);
- json_t *json = lisp_to_json_toplevel (args[0], &conf);
+ json_t *json = lisp_to_json (args[0], &conf);
record_unwind_protect_ptr (json_release_object, json);
- /* If desired, we might want to add the following flags:
- JSON_DECODE_ANY, JSON_ALLOW_NUL. */
- char *string = json_dumps (json, JSON_COMPACT);
+ char *string = json_dumps (json, JSON_COMPACT | JSON_ENCODE_ANY);
if (string == NULL)
json_out_of_memory ();
record_unwind_protect_ptr (json_free, string);
@@ -706,10 +704,8 @@ usage: (json-insert OBJECT &rest ARGS) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
struct json_configuration conf =
@@ -723,12 +719,10 @@ usage: (json-insert OBJECT &rest ARGS) */)
move_gap_both (PT, PT_BYTE);
struct json_insert_data data;
data.inserted_bytes = 0;
- /* If desired, we might want to add the following flags:
- JSON_DECODE_ANY, JSON_ALLOW_NUL. */
- int status
- /* Could have used json_dumpb, but that became available only in
- Jansson 2.10, whereas we want to support 2.7 and upward. */
- = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT);
+ /* Could have used json_dumpb, but that became available only in
+ Jansson 2.10, whereas we want to support 2.7 and upward. */
+ int status = json_dump_callback (json, json_insert_callback, &data,
+ JSON_COMPACT | JSON_ENCODE_ANY);
if (status == -1)
{
if (CONSP (data.error))
@@ -791,7 +785,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
/* Convert a JSON object to a Lisp object. */
static Lisp_Object ARG_NONNULL ((1))
-json_to_lisp (json_t *json, struct json_configuration *conf)
+json_to_lisp (json_t *json, const struct json_configuration *conf)
{
switch (json_typeof (json))
{
@@ -932,12 +926,12 @@ DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
NULL,
doc: /* Parse the JSON STRING into a Lisp object.
This is essentially the reverse operation of `json-serialize', which
-see. The returned object will be a vector, list, hashtable, alist, or
-plist. Its elements will be the JSON null value, the JSON false
-value, t, numbers, strings, or further vectors, hashtables, alists, or
-plists. If there are duplicate keys in an object, all but the last
-one are ignored. If STRING doesn't contain a valid JSON object, this
-function signals an error of type `json-parse-error'.
+see. The returned object will be the JSON null value, the JSON false
+value, t, a number, a string, a vector, a list, a hashtable, an alist,
+or a plist. Its elements will be further objects of these types. If
+there are duplicate keys in an object, all but the last one are
+ignored. If STRING doesn't contain a valid JSON object, this function
+signals an error of type `json-parse-error'.
The arguments ARGS are a list of keyword/argument pairs:
@@ -967,10 +961,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
Lisp_Object string = args[0];
@@ -982,7 +974,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
json_parse_args (nargs - 1, args + 1, &conf, true);
json_error_t error;
- json_t *object = json_loads (SSDATA (encoded), 0, &error);
+ json_t *object
+ = json_loads (SSDATA (encoded), JSON_DECODE_ANY, &error);
if (object == NULL)
json_parse_error (&error);
@@ -1065,10 +1058,8 @@ usage: (json-parse-buffer &rest args) */)
Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
}
if (!json_initialized)
- {
- message1 ("jansson library not found");
- return Qnil;
- }
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
#endif
struct json_configuration conf =
@@ -1078,8 +1069,10 @@ usage: (json-parse-buffer &rest args) */)
ptrdiff_t point = PT_BYTE;
struct json_read_buffer_data data = {.point = point};
json_error_t error;
- json_t *object = json_load_callback (json_read_buffer_callback, &data,
- JSON_DISABLE_EOF_CHECK, &error);
+ json_t *object
+ = json_load_callback (json_read_buffer_callback, &data,
+ JSON_DECODE_ANY | JSON_DISABLE_EOF_CHECK,
+ &error);
if (object == NULL)
json_parse_error (&error);
@@ -1128,6 +1121,7 @@ syms_of_json (void)
DEFSYM (Qjson_end_of_file, "json-end-of-file");
DEFSYM (Qjson_trailing_content, "json-trailing-content");
DEFSYM (Qjson_object_too_deep, "json-object-too-deep");
+ DEFSYM (Qjson_unavailable, "json-unavailable");
define_error (Qjson_error, "generic JSON error", Qerror);
define_error (Qjson_out_of_memory,
"not enough memory for creating JSON object", Qjson_error);
diff --git a/src/keyboard.c b/src/keyboard.c
index 9ee4c4f6d68..2e4c4e6aabf 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -725,6 +725,9 @@ recursive_edit_1 (void)
if (STRINGP (val))
xsignal1 (Qerror, val);
+ if (FUNCTIONP (val))
+ call0 (val);
+
return unbind_to (count, Qnil);
}
@@ -921,6 +924,8 @@ static Lisp_Object
cmd_error (Lisp_Object data)
{
Lisp_Object old_level, old_length;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ Lisp_Object conditions;
char macroerror[sizeof "After..kbd macro iterations: "
+ INT_STRLEN_BOUND (EMACS_INT)];
@@ -940,10 +945,15 @@ cmd_error (Lisp_Object data)
else
*macroerror = 0;
- Vstandard_output = Qt;
- Vstandard_input = Qt;
- Vexecuting_kbd_macro = Qnil;
- executing_kbd_macro = Qnil;
+ conditions = Fget (XCAR (data), Qerror_conditions);
+ if (NILP (Fmemq (Qminibuffer_quit, conditions)))
+ {
+ Vexecuting_kbd_macro = Qnil;
+ executing_kbd_macro = Qnil;
+ }
+
+ specbind (Qstandard_output, Qt);
+ specbind (Qstandard_input, Qt);
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
cancel_echoing ();
@@ -960,6 +970,7 @@ cmd_error (Lisp_Object data)
Vquit_flag = Qnil;
Vinhibit_quit = Qnil;
+ unbind_to (count, Qnil);
return make_fixnum (0);
}
@@ -976,7 +987,7 @@ cmd_error_internal (Lisp_Object data, const char *context)
{
/* The immediate context is not interesting for Quits,
since they are asynchronous. */
- if (EQ (XCAR (data), Qquit))
+ if (signal_quit_p (XCAR (data)))
Vsignaling_function = Qnil;
Vquit_flag = Qnil;
@@ -998,6 +1009,7 @@ Default value of `command-error-function'. */)
(Lisp_Object data, Lisp_Object context, Lisp_Object signal)
{
struct frame *sf = SELECTED_FRAME ();
+ Lisp_Object conditions;
CHECK_STRING (context);
@@ -1024,17 +1036,27 @@ Default value of `command-error-function'. */)
}
else
{
+ conditions = Fget (XCAR (data), Qerror_conditions);
+
clear_message (1, 0);
- Fdiscard_input ();
message_log_maybe_newline ();
- bitch_at_user ();
+
+ if (!NILP (Fmemq (Qminibuffer_quit, conditions)))
+ {
+ Fding (Qt);
+ }
+ else
+ {
+ Fdiscard_input ();
+ bitch_at_user ();
+ }
print_error_message (data, Qt, SSDATA (context), signal);
}
return Qnil;
}
-static Lisp_Object command_loop_2 (Lisp_Object);
+static Lisp_Object command_loop_1 (void);
static Lisp_Object top_level_1 (Lisp_Object);
/* Entry to editor-command-loop.
@@ -1062,7 +1084,7 @@ command_loop (void)
if (command_loop_level > 0 || minibuf_level > 0)
{
Lisp_Object val;
- val = internal_catch (Qexit, command_loop_2, Qnil);
+ val = internal_catch (Qexit, command_loop_2, Qerror);
executing_kbd_macro = Qnil;
return val;
}
@@ -1070,7 +1092,7 @@ command_loop (void)
while (1)
{
internal_catch (Qtop_level, top_level_1, Qnil);
- internal_catch (Qtop_level, command_loop_2, Qnil);
+ internal_catch (Qtop_level, command_loop_2, Qerror);
executing_kbd_macro = Qnil;
/* End of file in -batch run causes exit here. */
@@ -1083,15 +1105,16 @@ command_loop (void)
editing loop, and reenter the editing loop.
When there is an error, cmd_error runs and returns a non-nil
value to us. A value of nil means that command_loop_1 itself
- returned due to end of file (or end of kbd macro). */
+ returned due to end of file (or end of kbd macro). HANDLERS is a
+ list of condition names, passed to internal_condition_case. */
-static Lisp_Object
-command_loop_2 (Lisp_Object ignore)
+Lisp_Object
+command_loop_2 (Lisp_Object handlers)
{
register Lisp_Object val;
do
- val = internal_condition_case (command_loop_1, Qerror, cmd_error);
+ val = internal_condition_case (command_loop_1, handlers, cmd_error);
while (!NILP (val));
return Qnil;
@@ -1234,7 +1257,7 @@ static int read_key_sequence (Lisp_Object *, Lisp_Object,
bool, bool, bool, bool);
static void adjust_point_for_property (ptrdiff_t, bool);
-Lisp_Object
+static Lisp_Object
command_loop_1 (void)
{
modiff_count prev_modiff = 0;
@@ -2121,7 +2144,7 @@ read_char_help_form_unwind (void)
Lisp_Object window_config = XCAR (help_form_saved_window_configs);
help_form_saved_window_configs = XCDR (help_form_saved_window_configs);
if (!NILP (window_config))
- Fset_window_configuration (window_config, Qnil);
+ Fset_window_configuration (window_config, Qnil, Qnil);
}
#define STOP_POLLING \
@@ -2254,8 +2277,17 @@ read_decoded_event_from_main_queue (struct timespec *end_time,
{
int i;
if (meta_key != 2)
- for (i = 0; i < n; i++)
- events[i] = make_fixnum (XFIXNUM (events[i]) & ~0x80);
+ {
+ for (i = 0; i < n; i++)
+ {
+ int c = XFIXNUM (events[i]);
+ int modifier =
+ (meta_key == 3 && c < 0x100 && (c & 0x80))
+ ? meta_modifier
+ : 0;
+ events[i] = make_fixnum ((c & ~0x80) | modifier);
+ }
+ }
}
else
{
@@ -2264,7 +2296,7 @@ read_decoded_event_from_main_queue (struct timespec *end_time,
int i;
for (i = 0; i < n; i++)
src[i] = XFIXNUM (events[i]);
- if (meta_key != 2)
+ if (meta_key < 2) /* input-meta-mode is t or nil */
for (i = 0; i < n; i++)
src[i] &= ~0x80;
coding->destination = dest;
@@ -2282,7 +2314,18 @@ read_decoded_event_from_main_queue (struct timespec *end_time,
eassert (coding->carryover_bytes == 0);
n = 0;
while (n < coding->produced_char)
- events[n++] = make_fixnum (string_char_advance (&p));
+ {
+ int c = string_char_advance (&p);
+ if (meta_key == 3)
+ {
+ int modifier
+ = (c < 0x100 && (c & 0x80)
+ ? meta_modifier
+ : 0);
+ c = (c & ~0x80) | modifier;
+ }
+ events[n++] = make_fixnum (c);
+ }
}
}
}
@@ -3233,10 +3276,6 @@ help_char_p (Lisp_Object c)
static void
record_char (Lisp_Object c)
{
- /* quail.el binds this to avoid recording keys twice. */
- if (inhibit_record_char)
- return;
-
int recorded = 0;
if (CONSP (c) && (EQ (XCAR (c), Qhelp_echo) || EQ (XCAR (c), Qmouse_movement)))
@@ -3614,6 +3653,12 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event,
case ICONIFY_EVENT: ignore_event = Qiconify_frame; break;
case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break;
case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break;
+#ifdef USE_FILE_NOTIFY
+ case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break;
+#endif
+#ifdef HAVE_DBUS
+ case DBUS_EVENT: ignore_event = Qdbus_event; break;
+#endif
default: ignore_event = Qnil; break;
}
@@ -5016,6 +5061,10 @@ static short const internal_border_parts[] = {
static Lisp_Object button_down_location;
+/* A cons recording the original frame-relative x and y coordinates of
+ the down mouse event. */
+static Lisp_Object frame_relative_event_pos;
+
/* Information about the most recent up-going button event: Which
button, what location, and what time. */
@@ -5667,6 +5716,7 @@ make_lispy_event (struct input_event *event)
double_click_count = 1;
button_down_time = event->timestamp;
*start_pos_ptr = Fcopy_alist (position);
+ frame_relative_event_pos = Fcons (event->x, event->y);
ignore_mouse_drag_p = false;
}
@@ -5689,20 +5739,12 @@ make_lispy_event (struct input_event *event)
ignore_mouse_drag_p = false;
else
{
- Lisp_Object new_down, down;
intmax_t xdiff = double_click_fuzz, ydiff = double_click_fuzz;
- /* The third element of every position
- should be the (x,y) pair. */
- down = Fcar (Fcdr (Fcdr (start_pos)));
- new_down = Fcar (Fcdr (Fcdr (position)));
-
- if (CONSP (down)
- && FIXNUMP (XCAR (down)) && FIXNUMP (XCDR (down)))
- {
- xdiff = XFIXNUM (XCAR (new_down)) - XFIXNUM (XCAR (down));
- ydiff = XFIXNUM (XCDR (new_down)) - XFIXNUM (XCDR (down));
- }
+ xdiff = XFIXNUM (event->x)
+ - XFIXNUM (XCAR (frame_relative_event_pos));
+ ydiff = XFIXNUM (event->y)
+ - XFIXNUM (XCDR (frame_relative_event_pos));
if (! (0 < double_click_fuzz
&& - double_click_fuzz < xdiff
@@ -5719,12 +5761,51 @@ make_lispy_event (struct input_event *event)
a click. But mouse-drag-region completely ignores
this case and it hasn't caused any real problem, so
it's probably OK to ignore it as well. */
- && EQ (Fcar (Fcdr (start_pos)), Fcar (Fcdr (position)))))
+ && (EQ (Fcar (Fcdr (start_pos)),
+ Fcar (Fcdr (position))) /* Same buffer pos */
+ || !EQ (Fcar (start_pos),
+ Fcar (position))))) /* Different window */
{
/* Mouse has moved enough. */
button_down_time = 0;
click_or_drag_modifier = drag_modifier;
}
+ else if (((!EQ (Fcar (start_pos), Fcar (position)))
+ || (!EQ (Fcar (Fcdr (start_pos)),
+ Fcar (Fcdr (position)))))
+ /* Was the down event in a window body? */
+ && FIXNUMP (Fcar (Fcdr (start_pos)))
+ && WINDOW_LIVE_P (Fcar (start_pos))
+ && !NILP (Ffboundp (Qwindow_edges)))
+ /* If the window (etc.) at the mouse position has
+ changed between the down event and the up event,
+ we assume there's been a redisplay between the
+ two events, and we pretend the mouse is still in
+ the old window to prevent a spurious drag event
+ being generated. */
+ {
+ Lisp_Object edges
+ = call4 (Qwindow_edges, Fcar (start_pos), Qt, Qnil, Qt);
+ int new_x = XFIXNUM (Fcar (frame_relative_event_pos));
+ int new_y = XFIXNUM (Fcdr (frame_relative_event_pos));
+
+ /* If the up-event is outside the down-event's
+ window, use coordinates that are within it. */
+ if (new_x < XFIXNUM (Fcar (edges)))
+ new_x = XFIXNUM (Fcar (edges));
+ else if (new_x >= XFIXNUM (Fcar (Fcdr (Fcdr (edges)))))
+ new_x = XFIXNUM (Fcar (Fcdr (Fcdr (edges)))) - 1;
+ if (new_y < XFIXNUM (Fcar (Fcdr (edges))))
+ new_y = XFIXNUM (Fcar (Fcdr (edges)));
+ else if (new_y
+ >= XFIXNUM (Fcar (Fcdr (Fcdr (Fcdr (edges))))))
+ new_y = XFIXNUM (Fcar (Fcdr (Fcdr (Fcdr (edges))))) - 1;
+
+ position = make_lispy_position
+ (XFRAME (event->frame_or_window),
+ make_fixnum (new_x), make_fixnum (new_y),
+ event->timestamp);
+ }
}
/* Don't check is_double; treat this as multiple if the
@@ -6564,8 +6645,11 @@ DEFUN ("event-convert-list", Fevent_convert_list, Sevent_convert_list, 1, 1, 0,
EVENT-DESC should contain one base event type (a character or symbol)
and zero or more modifier names (control, meta, hyper, super, shift, alt,
drag, down, double or triple). The base must be last.
-The return value is an event type (a character or symbol) which
-has the same base event type and all the specified modifiers. */)
+
+The return value is an event type (a character or symbol) which has
+essentially the same base event type and all the specified modifiers.
+(Some compatibility base types, like symbols that represent a
+character, are not returned verbatim.) */)
(Lisp_Object event_desc)
{
Lisp_Object base = Qnil;
@@ -6679,6 +6763,7 @@ parse_solitary_modifier (Lisp_Object symbol)
case 'c':
MULTI_LETTER_MOD (ctrl_modifier, "ctrl", 4);
MULTI_LETTER_MOD (ctrl_modifier, "control", 7);
+ MULTI_LETTER_MOD (click_modifier, "click", 5);
break;
case 'H':
@@ -7029,7 +7114,7 @@ tty_read_avail_input (struct terminal *terminal,
buf.modifiers = 0;
if (tty->meta_key == 1 && (cbuf[i] & 0x80))
buf.modifiers = meta_modifier;
- if (tty->meta_key != 2)
+ if (tty->meta_key < 2)
cbuf[i] &= ~0x80;
buf.code = cbuf[i];
@@ -7551,7 +7636,7 @@ menu_item_eval_property_1 (Lisp_Object arg)
{
/* If we got a quit from within the menu computation,
quit all the way out of it. This takes care of C-] in the debugger. */
- if (CONSP (arg) && EQ (XCAR (arg), Qquit))
+ if (CONSP (arg) && signal_quit_p (XCAR (arg)))
quit ();
return Qnil;
@@ -9536,17 +9621,23 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt,
(interrupted_kboard,
Fcons (make_lispy_switch_frame (frame),
KVAR (interrupted_kboard, kbd_queue)));
+ mock_input = 0;
+ }
+ else
+ {
+ if (FIXNUMP (key) && XFIXNUM (key) != -2)
+ {
+ /* If interrupted while initializing terminal, we
+ need to replay the interrupting key. See
+ Bug#5095 and Bug#37782. */
+ mock_input = 1;
+ keybuf[0] = key;
+ }
+ else
+ {
+ mock_input = 0;
+ }
}
- if (FIXNUMP (key) && XFIXNUM (key) != -2)
- {
- /* If interrupted while initializing terminal, we
- need to replay the interrupting key. See
- Bug#5095 and Bug#37782. */
- mock_input = 1;
- keybuf[0] = key;
- }
- else
- mock_input = 0;
goto replay_entire_sequence;
}
}
@@ -10372,7 +10463,7 @@ update_recent_keys (int new_size, int kept_keys)
}
DEFUN ("lossage-size", Flossage_size, Slossage_size, 0, 1,
- "(list (read-number \"new-size: \" (lossage-size)))",
+ "(list (read-number \"Set maximum keystrokes to: \" (lossage-size)))",
doc: /* Return or set the maximum number of keystrokes to save.
If called with a non-nil ARG, set the limit to ARG and return it.
Otherwise, return the current limit.
@@ -10658,10 +10749,7 @@ On such systems, Emacs starts a subshell instead of suspending. */)
with a window system; but suspend should be disabled in that case. */
get_tty_size (fileno (CURTTY ()->input), &width, &height);
if (width != old_width || height != old_height)
- change_frame_size (SELECTED_FRAME (), width,
- height - FRAME_MENU_BAR_LINES (SELECTED_FRAME ())
- - FRAME_TAB_BAR_LINES (SELECTED_FRAME ()),
- 0, 0, 0, 0);
+ change_frame_size (SELECTED_FRAME (), width, height, false, false, false);
run_hook (intern ("suspend-resume-hook"));
@@ -11039,7 +11127,10 @@ See also `current-input-mode'. */)
DEFUN ("set-input-meta-mode", Fset_input_meta_mode, Sset_input_meta_mode, 1, 2, 0,
doc: /* Enable or disable 8-bit input on TERMINAL.
If META is t, Emacs will accept 8-bit input, and interpret the 8th
-bit as the Meta modifier.
+bit as the Meta modifier before it decodes the characters.
+
+If META is `encoded', Emacs will interpret the 8th bit of single-byte
+characters after decoding the characters.
If META is nil, Emacs will ignore the top bit, on the assumption it is
parity.
@@ -11068,6 +11159,8 @@ See also `current-input-mode'. */)
new_meta = 0;
else if (EQ (meta, Qt))
new_meta = 1;
+ else if (EQ (meta, Qencoded))
+ new_meta = 3;
else
new_meta = 2;
@@ -11130,6 +11223,8 @@ Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
(no effect except in CBREAK mode).
Third arg META t means accept 8-bit input (for a Meta key).
META nil means ignore the top bit, on the assumption it is parity.
+ META `encoded' means accept 8-bit input and interpret Meta after
+ decoding the input characters.
Otherwise, accept 8-bit input and don't use the top bit for Meta.
Optional fourth arg QUIT if non-nil specifies character to use for quitting.
See also `current-input-mode'. */)
@@ -11150,9 +11245,12 @@ The value is a list of the form (INTERRUPT FLOW META QUIT), where
nil, Emacs is using CBREAK mode.
FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
terminal; this does not apply if Emacs uses interrupt-driven input.
- META is t if accepting 8-bit input with 8th bit as Meta flag.
- META nil means ignoring the top bit, on the assumption it is parity.
- META is neither t nor nil if accepting 8-bit input and using
+ META is t if accepting 8-bit unencoded input with 8th bit as Meta flag.
+ META is `encoded' if accepting 8-bit encoded input with 8th bit as
+ Meta flag which has to be interpreted after decoding the input.
+ META is nil if ignoring the top bit of input, on the assumption that
+ it is a parity bit.
+ META is neither t nor nil if accepting 8-bit input and using
all 8 bits as the character code.
QUIT is the character Emacs currently uses to quit.
The elements of this list correspond to the arguments of
@@ -11168,7 +11266,9 @@ The elements of this list correspond to the arguments of
flow = FRAME_TTY (sf)->flow_control ? Qt : Qnil;
meta = (FRAME_TTY (sf)->meta_key == 2
? make_fixnum (0)
- : (CURTTY ()->meta_key == 1 ? Qt : Qnil));
+ : (CURTTY ()->meta_key == 1
+ ? Qt
+ : (CURTTY ()->meta_key == 3 ? Qencoded : Qnil)));
}
else
{
@@ -11645,6 +11745,7 @@ syms_of_keyboard (void)
DEFSYM (Qmake_frame_visible, "make-frame-visible");
DEFSYM (Qselect_window, "select-window");
DEFSYM (Qselection_request, "selection-request");
+ DEFSYM (Qwindow_edges, "window-edges");
{
int i;
@@ -11658,9 +11759,11 @@ syms_of_keyboard (void)
}
}
DEFSYM (Qno_record, "no-record");
+ DEFSYM (Qencoded, "encoded");
button_down_location = make_nil_vector (5);
staticpro (&button_down_location);
+ staticpro (&frame_relative_event_pos);
mouse_syms = make_nil_vector (5);
staticpro (&mouse_syms);
wheel_syms = make_nil_vector (ARRAYELTS (lispy_wheel_names));
@@ -12070,10 +12173,11 @@ terminal device. See Info node `(elisp)Multiple Terminals'. */);
DEFVAR_LISP ("overriding-local-map", Voverriding_local_map,
doc: /* Keymap that replaces (overrides) local keymaps.
If this variable is non-nil, Emacs looks up key bindings in this
-keymap INSTEAD OF the keymap char property, minor mode maps, and the
-buffer's local map. Hence, the only active keymaps would be
-`overriding-terminal-local-map', this keymap, and `global-keymap', in
-order of precedence. */);
+keymap INSTEAD OF `keymap' text properties, `local-map' and `keymap'
+overlay properties, minor mode maps, and the buffer's local map.
+
+Hence, the only active keymaps would be `overriding-terminal-local-map',
+this keymap, and `global-keymap', in order of precedence. */);
Voverriding_local_map = Qnil;
DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag,
@@ -12265,7 +12369,10 @@ Called with three arguments:
- the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA)
such as what `condition-case' would bind its variable to,
- the context (a string which normally goes at the start of the message),
-- the Lisp function within which the error was signaled. */);
+- the Lisp function within which the error was signaled.
+
+Also see `set-message-function' (which controls how non-error messages
+are displayed). */);
Vcommand_error_function = intern ("command-error-default-function");
DEFVAR_LISP ("enable-disabled-menus-and-buttons",
@@ -12339,13 +12446,6 @@ If nil, Emacs crashes immediately in response to fatal signals. */);
Vwhile_no_input_ignore_events,
doc: /* Ignored events from while-no-input. */);
- DEFVAR_BOOL ("inhibit--record-char",
- inhibit_record_char,
- doc: /* If non-nil, don't record input events.
-This inhibits recording input events for the purposes of keyboard
-macros, dribble file, and `recent-keys'.
-Internal use only. */);
-
pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper);
}
@@ -12379,10 +12479,6 @@ syms_of_keyboard_for_pdumper (void)
/* Create the initial keyboard. Qt means 'unset'. */
eassert (initial_kboard == NULL);
initial_kboard = allocate_kboard (Qt);
-
- Vwhile_no_input_ignore_events = Qnil;
-
- inhibit_record_char = false;
}
void
diff --git a/src/keymap.c b/src/keymap.c
index 782931fadff..fb8eceaec18 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -2846,6 +2846,21 @@ DESCRIBER is the output function used; nil means use `princ'. */)
return unbind_to (count, Qnil);
}
+static Lisp_Object fontify_key_properties;
+
+static Lisp_Object
+describe_key_maybe_fontify (Lisp_Object str, Lisp_Object prefix,
+ bool keymap_p)
+{
+ Lisp_Object key_desc = Fkey_description (str, prefix);
+ if (keymap_p)
+ Fadd_text_properties (make_fixnum (0),
+ make_fixnum (SCHARS (key_desc)),
+ fontify_key_properties,
+ key_desc);
+ return key_desc;
+}
+
DEFUN ("help--describe-vector", Fhelp__describe_vector, Shelp__describe_vector, 7, 7, 0,
doc: /* Insert in the current buffer a description of the contents of VECTOR.
Call DESCRIBER to insert the description of one value found in VECTOR.
@@ -3021,7 +3036,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- insert1 (Fkey_description (kludge, prefix));
+ insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
/* Find all consecutive characters or rows that have the same
definition. But, if VECTOR is a char-table, we had better
@@ -3071,7 +3086,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- insert1 (Fkey_description (kludge, prefix));
+ insert1 (describe_key_maybe_fontify (kludge, prefix, keymap_p));
}
/* Print a description of the definition of this character.
@@ -3133,12 +3148,6 @@ syms_of_keymap (void)
doc: /* Default keymap to use when reading from the minibuffer. */);
Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
- DEFVAR_LISP ("minibuffer-local-ns-map", Vminibuffer_local_ns_map,
- doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
- Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
- Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
-
-
DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
doc: /* Alist of keymaps to use for minor modes.
Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
@@ -3200,6 +3209,12 @@ be preferred. */);
staticpro (&where_is_cache);
staticpro (&where_is_cache_keymaps);
+ DEFSYM (Qfont_lock_face, "font-lock-face");
+ DEFSYM (Qhelp_key_binding, "help-key-binding");
+ staticpro (&fontify_key_properties);
+ fontify_key_properties = Fcons (Qfont_lock_face,
+ Fcons (Qhelp_key_binding, Qnil));
+
defsubr (&Skeymapp);
defsubr (&Skeymap_parent);
defsubr (&Skeymap_prompt);
diff --git a/src/lisp.h b/src/lisp.h
index 409a1e70608..7bfc69b647b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -294,12 +294,12 @@ DEFINE_GDB_SYMBOL_END (VALMASK)
/* Lisp_Word is a scalar word suitable for holding a tagged pointer or
integer. Usually it is a pointer to a deliberately-incomplete type
- 'union Lisp_X'. However, it is EMACS_INT when Lisp_Objects and
+ 'struct Lisp_X'. However, it is EMACS_INT when Lisp_Objects and
pointers differ in width. */
#define LISP_WORDS_ARE_POINTERS (EMACS_INT_MAX == INTPTR_MAX)
#if LISP_WORDS_ARE_POINTERS
-typedef union Lisp_X *Lisp_Word;
+typedef struct Lisp_X *Lisp_Word;
#else
typedef EMACS_INT Lisp_Word;
#endif
@@ -563,6 +563,7 @@ enum Lisp_Fwd_Type
#ifdef CHECK_LISP_OBJECT_TYPE
typedef struct Lisp_Object { Lisp_Word i; } Lisp_Object;
+# define LISP_OBJECT_IS_STRUCT
# define LISP_INITIALLY(w) {w}
# undef CHECK_LISP_OBJECT_TYPE
enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = true };
@@ -1068,6 +1069,7 @@ enum pvec_type
PVEC_MUTEX,
PVEC_CONDVAR,
PVEC_MODULE_FUNCTION,
+ PVEC_NATIVE_COMP_UNIT,
/* These should be last, for internal_equal and sxhash_obj. */
PVEC_COMPILED,
@@ -1313,6 +1315,7 @@ dead_object (void)
#define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD))
#define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX))
#define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR))
+#define XSETNATIVE_COMP_UNIT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT))
/* Efficiently convert a pointer to a Lisp object and back. The
pointer is represented as a fixnum, so the garbage collector
@@ -2036,6 +2039,8 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
char_table_set (ct, idx, val);
}
+#include "comp.h"
+
/* This structure describes a built-in function.
It is generated by the DEFUN macro only.
defsubr makes it into a Lisp object. */
@@ -2058,8 +2063,15 @@ struct Lisp_Subr
} function;
short min_args, max_args;
const char *symbol_name;
- const char *intspec;
+ union {
+ const char *intspec;
+ Lisp_Object native_intspec;
+ };
EMACS_INT doc;
+ Lisp_Object native_comp_u[NATIVE_COMP_FLAG];
+ char *native_c_name[NATIVE_COMP_FLAG];
+ Lisp_Object lambda_list[NATIVE_COMP_FLAG];
+ Lisp_Object type[NATIVE_COMP_FLAG];
} GCALIGNED_STRUCT;
union Aligned_Lisp_Subr
{
@@ -2972,6 +2984,12 @@ CHECK_INTEGER (Lisp_Object x)
{
CHECK_TYPE (INTEGERP (x), Qnumberp, x);
}
+
+INLINE void
+CHECK_SUBR (Lisp_Object x)
+{
+ CHECK_TYPE (SUBRP (x), Qsubrp, x);
+}
/* If we're not dumping using the legacy dumper and we might be using
@@ -3019,7 +3037,7 @@ CHECK_INTEGER (Lisp_Object x)
static union Aligned_Lisp_Subr sname = \
{{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
{ .a ## maxargs = fnname }, \
- minargs, maxargs, lname, intspec, 0}}; \
+ minargs, maxargs, lname, {intspec}, 0}}; \
Lisp_Object fnname
/* defsubr (Sname);
@@ -3568,6 +3586,7 @@ extern Lisp_Object detect_coding_system (const unsigned char *, ptrdiff_t,
extern void init_coding (void);
extern void init_coding_once (void);
extern void syms_of_coding (void);
+extern bool string_ascii_p (Lisp_Object);
/* Defined in character.c. */
extern ptrdiff_t chars_in_text (const unsigned char *, ptrdiff_t);
@@ -3610,6 +3629,7 @@ extern void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object,
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object);
+extern Lisp_Object merge_c (Lisp_Object, Lisp_Object, bool (*) (Lisp_Object, Lisp_Object));
extern Lisp_Object do_yes_or_no_p (Lisp_Object);
extern int string_version_cmp (Lisp_Object, Lisp_Object);
extern Lisp_Object concat2 (Lisp_Object, Lisp_Object);
@@ -3697,7 +3717,8 @@ extern void adjust_markers_for_delete (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t);
extern void adjust_markers_bytepos (ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t, int);
-extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool, bool, bool);
+extern void replace_range (ptrdiff_t, ptrdiff_t, Lisp_Object, bool, bool,
+ bool, bool, bool);
extern void replace_range_2 (ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t,
const char *, ptrdiff_t, ptrdiff_t, bool);
extern void syms_of_insdel (void);
@@ -4045,10 +4066,10 @@ extern ptrdiff_t doprnt (char *, ptrdiff_t, const char *, const char *,
va_list);
extern ptrdiff_t esprintf (char *, char const *, ...)
ATTRIBUTE_FORMAT_PRINTF (2, 3);
-extern ptrdiff_t exprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
+extern ptrdiff_t exprintf (char **, ptrdiff_t *, char *, ptrdiff_t,
char const *, ...)
ATTRIBUTE_FORMAT_PRINTF (5, 6);
-extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char const *, ptrdiff_t,
+extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t,
char const *, va_list)
ATTRIBUTE_FORMAT_PRINTF (5, 0);
@@ -4065,10 +4086,11 @@ LOADHIST_ATTACH (Lisp_Object x)
if (initialized)
Vcurrent_load_list = Fcons (x, Vcurrent_load_list);
}
+extern bool suffix_p (Lisp_Object, const char *);
extern Lisp_Object save_match_data_load (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
extern int openp (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object *, Lisp_Object, bool);
+ Lisp_Object *, Lisp_Object, bool, bool);
enum { S2N_IGNORE_TRAILING = 1 };
extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *);
extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object),
@@ -4091,10 +4113,12 @@ intern_c_string (const char *str)
}
/* Defined in eval.c. */
+extern EMACS_INT minibuffer_quit_level;
extern Lisp_Object Vautoload_queue;
extern Lisp_Object Vrun_hooks;
extern Lisp_Object Vsignaling_function;
extern Lisp_Object inhibit_lisp_code;
+extern bool signal_quit_p (Lisp_Object);
/* To run a normal hook, use the appropriate function from the list below.
The calling convention:
@@ -4138,6 +4162,9 @@ extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_
extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_3 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_4 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
+extern Lisp_Object internal_condition_case_5 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object));
extern Lisp_Object internal_condition_case_n
(Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
@@ -4220,6 +4247,8 @@ extern Lisp_Object module_function_documentation
(struct Lisp_Module_Function const *);
extern Lisp_Object module_function_interactive_form
(const struct Lisp_Module_Function *);
+extern Lisp_Object module_function_command_modes
+ (const struct Lisp_Module_Function *);
extern module_funcptr module_function_address
(struct Lisp_Module_Function const *);
extern void *module_function_data (const struct Lisp_Module_Function *);
@@ -4345,12 +4374,13 @@ extern void clear_regexp_cache (void);
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
-extern void move_minibuffer_onto_frame (void);
+extern void move_minibuffers_onto_frame (struct frame *, bool);
extern bool is_minibuffer (EMACS_INT, Lisp_Object);
extern EMACS_INT this_minibuffer_depth (Lisp_Object);
extern EMACS_INT minibuf_level;
extern Lisp_Object get_minibuffer (EMACS_INT);
extern void init_minibuf_once (void);
+extern void set_initial_minibuffer_mode (void);
extern void syms_of_minibuf (void);
extern void barf_if_interaction_inhibited (void);
@@ -4369,6 +4399,7 @@ extern void syms_of_casetab (void);
/* Defined in keyboard.c. */
+extern EMACS_INT command_loop_level;
extern Lisp_Object echo_message_buffer;
extern struct kboard *echo_kboard;
extern void cancel_echoing (void);
@@ -4389,7 +4420,7 @@ extern bool detect_input_pending_ignore_squeezables (void);
extern bool detect_input_pending_run_timers (bool);
extern void safe_run_hooks (Lisp_Object);
extern void cmd_error_internal (Lisp_Object, const char *);
-extern Lisp_Object command_loop_1 (void);
+extern Lisp_Object command_loop_2 (Lisp_Object);
extern Lisp_Object read_menu_command (void);
extern Lisp_Object recursive_edit_1 (void);
extern void record_auto_save (void);
@@ -4593,8 +4624,6 @@ extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern void syms_of_sysdep (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);
@@ -4623,6 +4652,7 @@ extern AVOID fatal (const char *msgid, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
/* Defined in terminal.c. */
extern void syms_of_terminal (void);
+extern char * tty_type_name (Lisp_Object);
/* Defined in font.c. */
extern void syms_of_font (void);
@@ -4700,7 +4730,11 @@ extern void syms_of_lcms2 (void);
#endif
#ifdef HAVE_ZLIB
+
+#include <stdio.h>
+
/* Defined in decompress.c. */
+extern int md5_gz_stream (FILE *, void *);
extern void syms_of_decompress (void);
#endif
@@ -4722,6 +4756,46 @@ extern void syms_of_profiler (void);
extern char *emacs_root_dir (void);
#endif /* DOS_NT */
+#ifdef HAVE_NATIVE_COMP
+INLINE bool
+SUBR_NATIVE_COMPILEDP (Lisp_Object a)
+{
+ return SUBRP (a) && !NILP (XSUBR (a)->native_comp_u[0]);
+}
+
+INLINE bool
+SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a)
+{
+ return SUBR_NATIVE_COMPILEDP (a) && !NILP (XSUBR (a)->lambda_list[0]);
+}
+
+INLINE Lisp_Object
+SUBR_TYPE (Lisp_Object a)
+{
+ return XSUBR (a)->type[0];
+}
+
+INLINE struct Lisp_Native_Comp_Unit *
+allocate_native_comp_unit (void)
+{
+ return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit,
+ data_impure_vec, PVEC_NATIVE_COMP_UNIT);
+}
+#else
+INLINE bool
+SUBR_NATIVE_COMPILEDP (Lisp_Object a)
+{
+ return false;
+}
+
+INLINE bool
+SUBR_NATIVE_COMPILED_DYNP (Lisp_Object a)
+{
+ return false;
+}
+
+#endif
+
/* Defined in lastfile.c. */
extern char my_edata[];
extern char my_endbss[];
diff --git a/src/lread.c b/src/lread.c
index 010194c34ea..a6c2db5d994 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1119,7 +1119,7 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
}
/* Return true if STRING ends with SUFFIX. */
-static bool
+bool
suffix_p (Lisp_Object string, const char *suffix)
{
ptrdiff_t suffix_len = strlen (suffix);
@@ -1138,6 +1138,24 @@ close_infile_unwind (void *arg)
infile = prev_infile;
}
+/* Compute the filename we want in `load-history' and `load-file-name'. */
+
+static Lisp_Object
+compute_found_effective (Lisp_Object found)
+{
+ /* Reconstruct the .elc filename. */
+ Lisp_Object src_name =
+ Fgethash (Ffile_name_nondirectory (found), Vcomp_eln_to_el_h, Qnil);
+
+ if (NILP (src_name))
+ /* Manual eln load. */
+ return found;
+
+ if (suffix_p (src_name, "el.gz"))
+ src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3));
+ return concat2 (src_name, build_string ("c"));
+}
+
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
@@ -1222,6 +1240,8 @@ Return t if the file exists and loads successfully. */)
else
file = Fsubstitute_in_file_name (file);
+ bool no_native = suffix_p (file, ".elc");
+
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file. */
if (SCHARS (file) == 0)
@@ -1245,7 +1265,7 @@ Return t if the file exists and loads successfully. */)
|| suffix_p (file, MODULES_SECONDARY_SUFFIX)
#endif
#endif
- )
+ || (NATIVE_COMP_FLAG && suffix_p (file, NATIVE_ELISP_SUFFIX)))
must_suffix = Qnil;
/* Don't insist on adding a suffix
if the argument includes a directory name. */
@@ -1262,7 +1282,9 @@ Return t if the file exists and loads successfully. */)
suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
}
- fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
+ fd =
+ openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer,
+ no_native);
}
if (fd == -1)
@@ -1323,6 +1345,9 @@ Return t if the file exists and loads successfully. */)
bool is_module = false;
#endif
+ bool is_native_elisp =
+ NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false;
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
@@ -1349,11 +1374,15 @@ Return t if the file exists and loads successfully. */)
Vload_source_file_function. */
specbind (Qlexical_binding, Qnil);
- /* Get the name for load-history. */
+ Lisp_Object found_eff =
+ is_native_elisp
+ ? compute_found_effective (found)
+ : found;
+
hist_file_name = (! NILP (Vpurify_flag)
? concat2 (Ffile_name_directory (file),
- Ffile_name_nondirectory (found))
- : found) ;
+ Ffile_name_nondirectory (found_eff))
+ : found_eff);
version = -1;
@@ -1417,7 +1446,7 @@ Return t if the file exists and loads successfully. */)
} /* !load_prefer_newer */
}
}
- else if (!is_module)
+ else if (!is_module && !is_native_elisp)
{
/* We are loading a source file (*.el). */
if (!NILP (Vload_source_file_function))
@@ -1444,7 +1473,7 @@ Return t if the file exists and loads successfully. */)
stream = NULL;
errno = EINVAL;
}
- else if (!is_module)
+ else if (!is_module && !is_native_elisp)
{
#ifdef WINDOWSNT
emacs_close (fd);
@@ -1460,7 +1489,7 @@ Return t if the file exists and loads successfully. */)
might be accessed by the unbind_to call below. */
struct infile input;
- if (is_module)
+ if (is_module || is_native_elisp)
{
/* `module-load' uses the file name, so we can close the stream
now. */
@@ -1487,6 +1516,8 @@ Return t if the file exists and loads successfully. */)
{
if (is_module)
message_with_string ("Loading %s (module)...", file, 1);
+ else if (is_native_elisp)
+ message_with_string ("Loading %s (native compiled elisp)...", file, 1);
else if (!compiled)
message_with_string ("Loading %s (source)...", file, 1);
else if (newer)
@@ -1496,7 +1527,8 @@ Return t if the file exists and loads successfully. */)
message_with_string ("Loading %s...", file, 1);
}
- specbind (Qload_file_name, found);
+ specbind (Qload_file_name, found_eff);
+ specbind (Qload_true_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
@@ -1512,6 +1544,19 @@ Return t if the file exists and loads successfully. */)
emacs_abort ();
#endif
}
+ else if (is_native_elisp)
+ {
+#ifdef HAVE_NATIVE_COMP
+ specbind (Qcurrent_load_list, Qnil);
+ LOADHIST_ATTACH (hist_file_name);
+ Fnative_elisp_load (found, Qnil);
+ build_load_history (hist_file_name, true);
+#else
+ /* This cannot happen. */
+ emacs_abort ();
+#endif
+
+ }
else
{
if (lisp_file_lexically_bound_p (Qget_file_char))
@@ -1547,6 +1592,8 @@ Return t if the file exists and loads successfully. */)
{
if (is_module)
message_with_string ("Loading %s (module)...done", file, 1);
+ else if (is_native_elisp)
+ message_with_string ("Loading %s (native compiled elisp)...done", file, 1);
else if (!compiled)
message_with_string ("Loading %s (source)...done", file, 1);
else if (newer)
@@ -1592,12 +1639,109 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */)
(Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
{
Lisp_Object file;
- int fd = openp (path, filename, suffixes, &file, predicate, false);
+ int fd = openp (path, filename, suffixes, &file, predicate, false, false);
if (NILP (predicate) && fd >= 0)
emacs_close (fd);
return file;
}
+#ifdef HAVE_NATIVE_COMP
+static bool
+maybe_swap_for_eln1 (Lisp_Object src_name, Lisp_Object eln_name,
+ Lisp_Object *filename, int *fd, struct timespec mtime)
+{
+ struct stat eln_st;
+ int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0);
+
+ if (eln_fd > 0)
+ {
+ if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode))
+ emacs_close (eln_fd);
+ else
+ {
+ struct timespec eln_mtime = get_stat_mtime (&eln_st);
+ if (timespec_cmp (eln_mtime, mtime) >= 0)
+ {
+ emacs_close (*fd);
+ *fd = eln_fd;
+ *filename = eln_name;
+ /* Store the eln -> el relation. */
+ Fputhash (Ffile_name_nondirectory (eln_name),
+ src_name, Vcomp_eln_to_el_h);
+ return true;
+ }
+ else
+ emacs_close (eln_fd);
+ }
+ }
+
+ return false;
+}
+#endif
+
+/* Look for a suitable .eln file to be loaded in place of FILENAME.
+ If found replace the content of FILENAME and FD. */
+
+static void
+maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd,
+ struct timespec mtime)
+{
+#ifdef HAVE_NATIVE_COMP
+
+ if (no_native
+ || load_no_native)
+ Fputhash (*filename, Qt, V_comp_no_native_file_h);
+ else
+ Fremhash (*filename, V_comp_no_native_file_h);
+
+ if (no_native
+ || load_no_native
+ || !suffix_p (*filename, ".elc"))
+ return;
+
+ /* Search eln in the eln-cache directories. */
+ Lisp_Object eln_path_tail = Vnative_comp_eln_load_path;
+ Lisp_Object src_name =
+ Fsubstring (*filename, Qnil, make_fixnum (-1));
+ if (NILP (Ffile_exists_p (src_name)))
+ {
+ src_name = concat2 (src_name, build_string (".gz"));
+ if (NILP (Ffile_exists_p (src_name)))
+ {
+ if (!NILP (find_symbol_value (
+ Qnative_comp_warning_on_missing_source)))
+ call2 (intern_c_string ("display-warning"),
+ Qcomp,
+ CALLN (Fformat,
+ build_string ("Cannot look-up eln file as no source "
+ "file was found for %s"),
+ *filename));
+ return;
+ }
+ }
+ Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name);
+
+ Lisp_Object dir = Qnil;
+ FOR_EACH_TAIL_SAFE (eln_path_tail)
+ {
+ dir = XCAR (eln_path_tail);
+ Lisp_Object eln_name =
+ Fexpand_file_name (eln_rel_name,
+ Fexpand_file_name (Vcomp_native_version_dir, dir));
+ if (maybe_swap_for_eln1 (src_name, eln_name, filename, fd, mtime))
+ return;
+ }
+
+ /* Look also in preloaded subfolder of the last entry in
+ `comp-eln-load-path'. */
+ dir = Fexpand_file_name (build_string ("preloaded"),
+ Fexpand_file_name (Vcomp_native_version_dir,
+ dir));
+ maybe_swap_for_eln1 (src_name, Fexpand_file_name (eln_rel_name, dir),
+ filename, fd, mtime);
+#endif
+}
+
/* Search for a file whose name is STR, looking in directories
in the Lisp list PATH, and trying suffixes from SUFFIX.
On success, return a file descriptor (or 1 or -2 as described below).
@@ -1622,11 +1766,14 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */)
If NEWER is true, try all SUFFIXes and return the result for the
newest file that exists. Does not apply to remote files,
- or if a non-nil and non-t PREDICATE is specified. */
+ or if a non-nil and non-t PREDICATE is specified.
+
+ if NO_NATIVE is true do not try to load native code. */
int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
- Lisp_Object *storeptr, Lisp_Object predicate, bool newer)
+ Lisp_Object *storeptr, Lisp_Object predicate, bool newer,
+ bool no_native)
{
ptrdiff_t fn_size = 100;
char buf[100];
@@ -1798,7 +1945,17 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
else
{
- fd = emacs_open (pfn, O_RDONLY, 0);
+ /* In some systems (like Windows) finding out if a
+ file exists is cheaper to do than actually opening
+ it. Only open the file when we are sure that it
+ exists. */
+#ifdef WINDOWSNT
+ if (faccessat (AT_FDCWD, pfn, R_OK, AT_EACCESS))
+ fd = -1;
+ else
+#endif
+ fd = emacs_open (pfn, O_RDONLY, 0);
+
if (fd < 0)
{
if (! (errno == ENOENT || errno == ENOTDIR))
@@ -1836,6 +1993,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
else
{
+ maybe_swap_for_eln (no_native, &string, &fd,
+ get_stat_mtime (&st));
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = string;
@@ -1847,6 +2006,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
/* No more suffixes. Return the newest. */
if (0 <= save_fd && ! CONSP (XCDR (tail)))
{
+ maybe_swap_for_eln (no_native, &save_string, &save_fd,
+ save_mtime);
if (storeptr)
*storeptr = save_string;
SAFE_FREE ();
@@ -1942,8 +2103,8 @@ readevalloop_1 (int old)
static AVOID
end_of_file_error (void)
{
- if (STRINGP (Vload_file_name))
- xsignal1 (Qend_of_file, Vload_file_name);
+ if (STRINGP (Vload_true_file_name))
+ xsignal1 (Qend_of_file, Vload_true_file_name);
xsignal0 (Qend_of_file);
}
@@ -3777,8 +3938,7 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
bool signedp = negative | positive;
cp += signedp;
- enum { INTOVERFLOW = 1, LEAD_INT = 2, DOT_CHAR = 4, TRAIL_INT = 8,
- E_EXP = 16 };
+ enum { INTOVERFLOW = 1, LEAD_INT = 2, TRAIL_INT = 4, E_EXP = 16 };
int state = 0;
int leading_digit = digit_to_number (*cp, base);
uintmax_t n = leading_digit;
@@ -3798,7 +3958,6 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
char const *after_digits = cp;
if (*cp == '.')
{
- state |= DOT_CHAR;
cp++;
}
@@ -3847,8 +4006,10 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
cp = ecp;
}
- float_syntax = ((state & (DOT_CHAR|TRAIL_INT)) == (DOT_CHAR|TRAIL_INT)
- || (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP));
+ /* A float has digits after the dot or an exponent.
+ This excludes numbers like "1." which are lexed as integers. */
+ float_syntax = ((state & TRAIL_INT)
+ || ((state & LEAD_INT) && (state & E_EXP)));
}
if (plen)
@@ -4204,10 +4365,14 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
if (!SYMBOLP (tem))
{
- /* Creating a non-pure string from a string literal not implemented yet.
- We could just use make_string here and live with the extra copy. */
- eassert (!NILP (Vpurify_flag));
- tem = intern_driver (make_pure_c_string (str, len), obarray, tem);
+ Lisp_Object string;
+
+ if (NILP (Vpurify_flag))
+ string = make_string (str, len);
+ else
+ string = make_pure_c_string (str, len);
+
+ tem = intern_driver (string, obarray, tem);
}
return tem;
}
@@ -4467,6 +4632,10 @@ defsubr (union Aligned_Lisp_Subr *aname)
XSETPVECTYPE (sname, PVEC_SUBR);
XSETSUBR (tem, sname);
set_symbol_function (sym, tem);
+#ifdef HAVE_NATIVE_COMP
+ eassert (NILP (Vcomp_abi_hash));
+ Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list));
+#endif
}
#ifdef NOTDEF /* Use fset in subr.el now! */
@@ -4600,14 +4769,8 @@ load_path_default (void)
return decode_env_path (0, PATH_DUMPLOADSEARCH, 0);
Lisp_Object lpath = Qnil;
- const char *normal = PATH_LOADSEARCH;
- const char *loadpath = NULL;
-#ifdef HAVE_NS
- loadpath = ns_load_path ();
-#endif
-
- lpath = decode_env_path (0, loadpath ? loadpath : normal, 0);
+ lpath = decode_env_path (0, PATH_LOADSEARCH, 0);
if (!NILP (Vinstallation_directory))
{
@@ -4767,6 +4930,7 @@ init_lread (void)
load_in_progress = 0;
Vload_file_name = Qnil;
+ Vload_true_file_name = Qnil;
Vstandard_input = Qt;
Vloads_in_progress = Qnil;
}
@@ -4833,7 +4997,8 @@ to find all the symbols in an obarray, use `mapatoms'. */);
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed.
-Order is reverse chronological. */);
+Order is reverse chronological.
+This variable is obsolete as of Emacs 28.1 and should not be used. */);
XSYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
@@ -4890,20 +5055,15 @@ This list includes suffixes for both compiled and source Emacs Lisp files.
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a suffix is allowed or required. */);
+ Vload_suffixes = list2 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"));
#ifdef HAVE_MODULES
+ Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes);
#ifdef MODULES_SECONDARY_SUFFIX
- Vload_suffixes = list4 (build_pure_c_string (".elc"),
- build_pure_c_string (".el"),
- build_pure_c_string (MODULES_SUFFIX),
- build_pure_c_string (MODULES_SECONDARY_SUFFIX));
-#else
- Vload_suffixes = list3 (build_pure_c_string (".elc"),
- build_pure_c_string (".el"),
- build_pure_c_string (MODULES_SUFFIX));
+ Vload_suffixes =
+ Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes);
#endif
-#else
- Vload_suffixes = list2 (build_pure_c_string (".elc"),
- build_pure_c_string (".el"));
+
#endif
DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
doc: /* Suffix of loadable module file, or nil if modules are not supported. */);
@@ -4970,9 +5130,17 @@ directory. These file names are converted to absolute at startup. */);
Vload_history = Qnil;
DEFVAR_LISP ("load-file-name", Vload_file_name,
- doc: /* Full name of file being loaded by `load'. */);
+ doc: /* Full name of file being loaded by `load'.
+
+In case of native code being loaded this is indicating the
+corresponding bytecode filename. Use `load-true-file-name' to obtain
+the .eln filename. */);
Vload_file_name = Qnil;
+ DEFVAR_LISP ("load-true-file-name", Vload_true_file_name,
+ doc: /* Full name of file being loaded by `load'. */);
+ Vload_true_file_name = Qnil;
+
DEFVAR_LISP ("user-init-file", Vuser_init_file,
doc: /* File name, including directory, of user's initialization file.
If the file loaded had extension `.elc', and the corresponding source file
@@ -5092,6 +5260,10 @@ Note that if you customize this, obviously it will not affect files
that are loaded before your customizations are read! */);
load_prefer_newer = 0;
+ DEFVAR_BOOL ("load-no-native", load_no_native,
+ doc: /* Non-nil means not to load a .eln file when a .elc was requested. */);
+ load_no_native = false;
+
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");
@@ -5114,6 +5286,7 @@ that are loaded before your customizations are read! */);
DEFSYM (Qfunction, "function");
DEFSYM (Qload, "load");
DEFSYM (Qload_file_name, "load-file-name");
+ DEFSYM (Qload_true_file_name, "load-true-file-name");
DEFSYM (Qeval_buffer_list, "eval-buffer-list");
DEFSYM (Qdir_ok, "dir-ok");
DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
diff --git a/src/macros.c b/src/macros.c
index 60d0766a754..0752a5bb6f6 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -324,7 +324,7 @@ buffer before the macro is executed. */)
break;
}
- command_loop_1 ();
+ command_loop_2 (list1 (Qminibuffer_quit));
executing_kbd_macro_iterations = ++success_count;
diff --git a/src/marker.c b/src/marker.c
index 59791513170..2b137b14c8f 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -634,16 +634,15 @@ set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
/* Detach a marker so that it no longer points anywhere and no longer
slows down editing. Do not free the marker, though, as a change
function could have inserted it into an undo list (Bug#30931). */
+
void
detach_marker (Lisp_Object marker)
{
Fset_marker (marker, Qnil, Qnil);
}
-/* Remove MARKER from the chain of whatever buffer it is in,
- leaving it points to nowhere. This is called during garbage
- collection, so we must be careful to ignore and preserve
- mark bits, including those in chain fields of markers. */
+/* Remove MARKER from the chain of whatever buffer it is in. Set its
+ buffer NULL. */
void
unchain_marker (register struct Lisp_Marker *marker)
diff --git a/src/minibuf.c b/src/minibuf.c
index 949c3d989d5..c9134eff67f 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -41,6 +41,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
minibuffer recursions are encountered. */
Lisp_Object Vminibuffer_list;
+Lisp_Object Vcommand_loop_level_list;
/* Data to remember during recursive minibuffer invocations. */
@@ -58,12 +59,21 @@ Lisp_Object last_minibuf_string;
static Lisp_Object minibuf_prompt;
+/* The frame containinug the most recently opened Minibuffer. This is
+ used only when `minibuffer-follows-selected-frame' is neither nil
+ nor t. */
+
+static Lisp_Object MB_frame;
+
/* Width of current mini-buffer prompt. Only set after display_line
of the line that contains the prompt. */
static ptrdiff_t minibuf_prompt_width;
static Lisp_Object nth_minibuffer (EMACS_INT depth);
+static EMACS_INT minibuf_c_loop_level (EMACS_INT depth);
+static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth);
+static bool live_minibuffer_p (Lisp_Object);
/* Return TRUE when a frame switch causes a minibuffer on the old
@@ -75,6 +85,7 @@ minibuf_follows_frame (void)
Qt);
}
+#if 0
/* Return TRUE when a minibuffer always remains on the frame where it
was first invoked. */
static bool
@@ -82,6 +93,7 @@ minibuf_stays_put (void)
{
return NILP (Fdefault_toplevel_value (Qminibuffer_follows_selected_frame));
}
+#endif
/* Return TRUE when opening a (recursive) minibuffer causes
minibuffers on other frames to move to the selected frame. */
@@ -100,88 +112,105 @@ choose_minibuf_frame (void)
{
if (FRAMEP (selected_frame)
&& FRAME_LIVE_P (XFRAME (selected_frame))
+ && WINDOW_LIVE_P (XFRAME (selected_frame)->minibuffer_window)
&& !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
{
struct frame *sf = XFRAME (selected_frame);
- /* I don't think that any frames may validly have a null minibuffer
- window anymore. */
- if (NILP (sf->minibuffer_window))
- emacs_abort ();
+ /* I don't think that any frames may validly have a null
+ minibuffer window anymore. (2021-04-15): Tooltip frames have
+ a null MB. Comment out the following. */
+ /* if (NILP (sf->minibuffer_window)) */
+ /* emacs_abort (); */
minibuf_window = sf->minibuffer_window;
- /* If we've still got another minibuffer open, use its mini-window
- instead. */
- if (minibuf_level > 1 && minibuf_stays_put ())
- {
- Lisp_Object buffer = get_minibuffer (minibuf_level);
- Lisp_Object tail, frame;
-
- FOR_EACH_FRAME (tail, frame)
- if (EQ (XWINDOW (XFRAME (frame)->minibuffer_window)->contents,
- buffer))
- {
- minibuf_window = XFRAME (frame)->minibuffer_window;
- break;
- }
- }
}
+}
- if (minibuf_moves_frame_when_opened ()
- && FRAMEP (selected_frame)
- && FRAME_LIVE_P (XFRAME (selected_frame)))
- /* Make sure no other frame has a minibuffer as its selected window,
- because the text would not be displayed in it, and that would be
- confusing. Only allow the selected frame to do this,
- and that only if the minibuffer is active. */
- {
- Lisp_Object tail, frame;
- struct frame *of;
-
- FOR_EACH_FRAME (tail, frame)
- if (!EQ (frame, selected_frame)
- && minibuf_level > 1
- /* The frame's minibuffer can be on a different frame. */
- && ! EQ (XWINDOW ((of = XFRAME (frame))->minibuffer_window)->frame,
- selected_frame))
- {
- if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
- Fset_frame_selected_window (frame, Fframe_first_window (frame),
- Qnil);
-
- if (!EQ (XWINDOW (of->minibuffer_window)->contents,
- nth_minibuffer (0)))
- set_window_buffer (of->minibuffer_window,
- nth_minibuffer (0), 0, 0);
- }
- }
+/* If ENT1 has a higher minibuffer index than ENT2, return true. More
+precisely, compare the buffer components of each window->prev_buffers
+entry. */
+static bool
+minibuffer_ent_greater (Lisp_Object ent1, Lisp_Object ent2)
+{
+ return this_minibuffer_depth (Fcar (ent1))
+ > this_minibuffer_depth (Fcar (ent2)) ;
}
-/* If `minibuffer_follows_selected_frame' is t and we have a
- minibuffer, move it from its current frame to the selected frame.
- This function is intended to be called from `do_switch_frame' in
- frame.c. */
-void move_minibuffer_onto_frame (void)
+/* Move the ordered "stack" of minibuffers from SOURCE_WINDOW to
+ DEST_WINDOW, interleaving those minibuffers with any in DEST_WINDOW
+ to produce an ordered combination. The ordering is by minibuffer
+ depth. A stack of minibuffers consists of the minibuffer currently
+ in DEST/SOURCE_WINDOW together with any recorded in the
+ ->prev_buffers field of the struct window. */
+static void
+zip_minibuffer_stacks (Lisp_Object dest_window, Lisp_Object source_window)
{
- if (!minibuf_level)
- return;
- if (!minibuf_follows_frame ())
- return;
- if (FRAMEP (selected_frame)
- && FRAME_LIVE_P (XFRAME (selected_frame))
- && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window))
+ struct window *dw = XWINDOW (dest_window);
+ struct window *sw = XWINDOW (source_window);
+ Lisp_Object acc;
+ Lisp_Object d_ent; /* Entry from dw->prev_buffers */
+
+ if (!live_minibuffer_p (dw->contents)
+ && NILP (dw->prev_buffers))
{
- EMACS_INT i;
- struct frame *sf = XFRAME (selected_frame);
- Lisp_Object old_frame = XWINDOW (minibuf_window)->frame;
- struct frame *of = XFRAME (old_frame);
+ set_window_buffer (dest_window, sw->contents, 0, 0);
+ Fset_window_start (dest_window, Fwindow_start (source_window), Qnil);
+ Fset_window_point (dest_window, Fwindow_point (source_window));
+ dw->prev_buffers = sw->prev_buffers;
+ set_window_buffer (source_window, nth_minibuffer (0), 0, 0);
+ sw->prev_buffers = Qnil;
+ return;
+ }
- /* Stack up all the (recursively) open minibuffers on the selected
- mini_window. */
- for (i = 1; i <= minibuf_level; i++)
- set_window_buffer (sf->minibuffer_window, nth_minibuffer (i), 0, 0);
- minibuf_window = sf->minibuffer_window;
- if (of != sf)
- set_window_buffer (of->minibuffer_window, get_minibuffer (0), 0, 0);
+ if (live_minibuffer_p (dw->contents))
+ call1 (Qpush_window_buffer_onto_prev, dest_window);
+ if (live_minibuffer_p (sw->contents))
+ call1 (Qpush_window_buffer_onto_prev, source_window);
+ acc = merge_c (dw->prev_buffers, sw->prev_buffers, minibuffer_ent_greater);
+
+ if (!NILP (acc))
+ {
+ d_ent = Fcar (acc);
+ acc = Fcdr (acc);
+ set_window_buffer (dest_window, Fcar (d_ent), 0, 0);
+ Fset_window_start (dest_window, Fcar (Fcdr (d_ent)), Qnil);
+ Fset_window_point (dest_window, Fcar (Fcdr (Fcdr (d_ent))));
+ }
+ dw->prev_buffers = acc;
+ sw->prev_buffers = Qnil;
+ set_window_buffer (source_window, nth_minibuffer (0), 0, 0);
+}
+
+/* If `minibuffer_follows_selected_frame' is t, or we're about to
+ delete a frame which potentially "contains" minibuffers, move them
+ from the old frame to the selected frame. This function is
+ intended to be called from `do_switch_frame' in frame.c. OF is the
+ old frame, FOR_DELETION is true if OF is about to be deleted. */
+void
+move_minibuffers_onto_frame (struct frame *of, bool for_deletion)
+{
+ struct frame *f = XFRAME (selected_frame);
+
+ minibuf_window = f->minibuffer_window;
+ if (!(minibuf_level
+ && (for_deletion || minibuf_follows_frame () || FRAME_INITIAL_P (of))))
+ return;
+ if (FRAME_LIVE_P (f)
+ && !EQ (f->minibuffer_window, of->minibuffer_window)
+ && WINDOW_LIVE_P (f->minibuffer_window) /* F not a tootip frame */
+ && WINDOW_LIVE_P (of->minibuffer_window))
+ {
+ zip_minibuffer_stacks (f->minibuffer_window, of->minibuffer_window);
+ if (for_deletion && XFRAME (MB_frame) != of)
+ MB_frame = selected_frame;
+ if (!for_deletion
+ && MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
+ {
+ Lisp_Object old_frame;
+ XSETFRAME (old_frame, of);
+ Fset_frame_selected_window (old_frame,
+ Fframe_first_window (old_frame), Qnil);
+ }
}
}
@@ -190,7 +219,25 @@ DEFUN ("active-minibuffer-window", Factive_minibuffer_window,
doc: /* Return the currently active minibuffer window, or nil if none. */)
(void)
{
- return minibuf_level ? minibuf_window : Qnil;
+ Lisp_Object frames, frame;
+ struct frame *f;
+ Lisp_Object innermost_MB;
+
+ if (!minibuf_level)
+ return Qnil;
+
+ innermost_MB = nth_minibuffer (minibuf_level);
+ if (NILP (innermost_MB))
+ emacs_abort ();
+ FOR_EACH_FRAME (frames, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_LIVE_P (f)
+ && WINDOW_LIVE_P (f->minibuffer_window)
+ && EQ (XWINDOW (f->minibuffer_window)->contents, innermost_MB))
+ return f->minibuffer_window;
+ }
+ return minibuf_window; /* "Can't happen." */
}
DEFUN ("set-minibuffer-window", Fset_minibuffer_window,
@@ -213,6 +260,7 @@ without invoking the usual minibuffer commands. */)
/* Actual minibuffer invocation. */
static void read_minibuf_unwind (void);
+static void minibuffer_unwind (void);
static void run_exit_minibuf_hook (void);
@@ -389,6 +437,21 @@ No argument or nil as argument means use the current buffer as BUFFER. */)
: Qnil;
}
+DEFUN ("minibuffer-innermost-command-loop-p", Fminibuffer_innermost_command_loop_p,
+ Sminibuffer_innermost_command_loop_p, 0, 1, 0,
+ doc: /* Return t if BUFFER is a minibuffer at the current command loop level.
+No argument or nil as argument means use the current buffer as BUFFER. */)
+ (Lisp_Object buffer)
+{
+ EMACS_INT depth;
+ if (NILP (buffer))
+ buffer = Fcurrent_buffer ();
+ depth = this_minibuffer_depth (buffer);
+ return depth && minibuf_c_loop_level (depth) == command_loop_level
+ ? Qt
+ : Qnil;
+}
+
/* Return the nesting depth of the active minibuffer BUFFER, or 0 if
BUFFER isn't such a thing. If BUFFER is nil, this means use the current
buffer. */
@@ -420,15 +483,20 @@ confirm the aborting of the current minibuffer and all contained ones. */)
if (!minibuf_depth)
error ("Not in a minibuffer");
+ if (NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
+ error ("Not in most nested command loop");
if (minibuf_depth < minibuf_level)
{
array[0] = fmt;
array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
if (!NILP (Fyes_or_no_p (Fformat (2, array))))
- Fthrow (Qexit, Qt);
+ {
+ minibuffer_quit_level = minibuf_depth;
+ Fthrow (Qexit, Qt);
+ }
}
else
- Fthrow (Qexit, Qt);
+ CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"));
return Qnil;
}
@@ -508,6 +576,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object mini_frame, ambient_dir, minibuffer, input_method;
Lisp_Object calling_frame = selected_frame;
+ Lisp_Object calling_window = selected_window;
Lisp_Object enable_multibyte;
EMACS_INT pos = 0;
/* String to add to the history. */
@@ -515,7 +584,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Lisp_Object histval;
Lisp_Object empty_minibuf;
- Lisp_Object dummy, frame;
specbind (Qminibuffer_default, defalt);
specbind (Qinhibit_read_only, Qnil);
@@ -524,7 +592,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
in previous recursive minibuffer, but was not set explicitly
to t for this invocation, so set it to nil in this minibuffer.
Save the old value now, before we change it. */
- specbind (intern ("minibuffer-completing-file-name"),
+ specbind (Qminibuffer_completing_file_name,
Vminibuffer_completing_file_name);
if (EQ (Vminibuffer_completing_file_name, Qlambda))
Vminibuffer_completing_file_name = Qnil;
@@ -585,7 +653,12 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
return unbind_to (count, val);
}
- minibuf_level++; /* Before calling choose_minibuf_frame. */
+ /* Ensure now that the latest minibuffer has been created and pushed
+ onto Vminibuffer_list before incrementing minibuf_level, in case
+ a hook called during the minibuffer creation calls
+ Factive_minibuffer_window. */
+ minibuffer = get_minibuffer (minibuf_level + 1);
+ minibuf_level++; /* Before calling choose_minibuf_frame. */
/* Choose the minibuffer window and frame, and take action on them. */
@@ -597,30 +670,37 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window));
if (minibuf_level > 1
+ && WINDOW_LIVE_P (XFRAME (MB_frame)->minibuffer_window)
+ && !EQ (XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame,
+ MB_frame)
&& minibuf_moves_frame_when_opened ()
- && !minibuf_follows_frame ())
+ && (!minibuf_follows_frame ()))
{
- EMACS_INT i;
+ struct frame *of = XFRAME (MB_frame);
- /* Stack up the existing minibuffers on the current mini-window */
- for (i = 1; i < minibuf_level; i++)
- set_window_buffer (minibuf_window, nth_minibuffer (i), 0, 0);
+ zip_minibuffer_stacks (minibuf_window, of->minibuffer_window);
+ /* MB_frame's minibuffer can be on a different frame. */
+ if (MINI_WINDOW_P (XWINDOW (FRAME_SELECTED_WINDOW (of))))
+ Fset_frame_selected_window (MB_frame,
+ Fframe_first_window (MB_frame), Qnil);
}
+ MB_frame = XWINDOW (XFRAME (selected_frame)->minibuffer_window)->frame;
+ if (live_minibuffer_p (XWINDOW (minibuf_window)->contents))
+ call1 (Qpush_window_buffer_onto_prev, minibuf_window);
- record_unwind_protect_void (choose_minibuf_frame);
-
- record_unwind_protect (restore_window_configuration,
- Fcons (Qt, Fcurrent_window_configuration (Qnil)));
+ record_unwind_protect_void (minibuffer_unwind);
+ if (read_minibuffer_restore_windows)
+ record_unwind_protect (restore_window_configuration,
+ list3 (Fcurrent_window_configuration (Qnil),
+ Qt, Qt));
/* If the minibuffer window is on a different frame, save that
frame's configuration too. */
- if (!EQ (mini_frame, selected_frame))
+ if (read_minibuffer_restore_windows &&
+ !EQ (mini_frame, selected_frame))
record_unwind_protect (restore_window_configuration,
- Fcons (/* Arrange for the frame later to be
- switched back to the calling
- frame. */
- Qnil,
- Fcurrent_window_configuration (mini_frame)));
+ list3 (Fcurrent_window_configuration (mini_frame),
+ Qnil, Qt));
/* If the minibuffer is on an iconified or invisible frame,
make it visible now. */
@@ -640,7 +720,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
minibuf_save_list
= Fcons (Voverriding_local_map,
Fcons (minibuf_window,
- minibuf_save_list));
+ Fcons (calling_frame,
+ Fcons (calling_window,
+ minibuf_save_list))));
minibuf_save_list
= Fcons (minibuf_prompt,
Fcons (make_fixnum (minibuf_prompt_width),
@@ -676,10 +758,10 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Vminibuffer_completing_file_name = Qlambda;
/* If variable is unbound, make it nil. */
- histval = find_symbol_value (Vminibuffer_history_variable);
+ histval = find_symbol_value (histvar);
if (EQ (histval, Qunbound))
{
- Fset (Vminibuffer_history_variable, Qnil);
+ Fset (histvar, Qnil);
histval = Qnil;
}
@@ -693,17 +775,13 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Switch to the minibuffer. */
- minibuffer = get_minibuffer (minibuf_level);
+ set_minibuffer_mode (minibuffer, minibuf_level);
Fset_buffer (minibuffer);
/* Defeat (setq-default truncate-lines t), since truncated lines do
not work correctly in minibuffers. (Bug#5715, etc) */
bset_truncate_lines (current_buffer, Qnil);
- /* If appropriate, copy enable-multibyte-characters into the minibuffer. */
- if (inherit_input_method)
- bset_enable_multibyte_characters (current_buffer, enable_multibyte);
-
/* The current buffer's default directory is usually the right thing
for our minibuffer here. However, if you're typing a command at
a minibuffer-only frame when minibuf_level is zero, then buf IS
@@ -737,24 +815,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
/* Empty out the minibuffers of all frames, except those frames
where there is an active minibuffer.
Set them to point to ` *Minibuf-0*', which is always empty. */
- empty_minibuf = get_minibuffer (0);
-
- FOR_EACH_FRAME (dummy, frame)
- {
- Lisp_Object root_window = Fframe_root_window (frame);
- Lisp_Object mini_window = XWINDOW (root_window)->next;
- Lisp_Object buffer;
-
- if (!NILP (mini_window) && !EQ (mini_window, minibuf_window)
- && !NILP (Fwindow_minibuffer_p (mini_window)))
- {
- buffer = XWINDOW (mini_window)->contents;
- if (!live_minibuffer_p (buffer))
- /* Use set_window_buffer instead of Fset_window_buffer (see
- discussion of bug#11984, bug#12025, bug#12026). */
- set_window_buffer (mini_window, empty_minibuf, 0, 0);
- }
- }
+ empty_minibuf = nth_minibuffer (0);
+ set_minibuffer_mode (empty_minibuf, 0);
/* Display this minibuffer in the proper window. */
/* Use set_window_buffer instead of Fset_window_buffer (see
@@ -771,9 +833,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
- if (!NILP (BVAR (current_buffer, enable_multibyte_characters))
- && ! STRING_MULTIBYTE (minibuf_prompt))
- minibuf_prompt = Fstring_make_multibyte (minibuf_prompt);
+ /* If appropriate, copy enable-multibyte-characters into the minibuffer.
+ In any case don't blindly inherit the multibyteness used previously. */
+ bset_enable_multibyte_characters (current_buffer,
+ inherit_input_method ? enable_multibyte
+ : Qt);
/* Insert the prompt, record where it ends. */
Finsert (1, &minibuf_prompt);
@@ -837,20 +901,6 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
recursive_edit_1 ();
- /* We've exited the recursive edit without an error, so switch the
- current window away from the expired minibuffer window. */
- {
- Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
- /* PREV can be on a different frame when we have a minibuffer only
- frame, the other frame's minibuffer window is MINIBUF_WINDOW,
- and its "focus window" is also MINIBUF_WINDOW. */
- while (!EQ (prev, minibuf_window)
- && !EQ (selected_frame, WINDOW_FRAME (XWINDOW (prev))))
- prev = Fprevious_window (prev, Qnil, Qnil);
- if (!EQ (prev, minibuf_window))
- Fset_frame_selected_window (selected_frame, prev, Qnil);
- }
-
/* If cursor is on the minibuffer line,
show the user we have exited by putting it in column 0. */
if (XWINDOW (minibuf_window)->cursor.vpos >= 0
@@ -890,16 +940,20 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
unbind_to (count, Qnil);
/* Switch the frame back to the calling frame. */
- if (!EQ (selected_frame, calling_frame)
- && FRAMEP (calling_frame)
- && FRAME_LIVE_P (XFRAME (calling_frame)))
- call2 (intern ("select-frame-set-input-focus"), calling_frame, Qnil);
+ if (FRAMEP (calling_frame)
+ && FRAME_LIVE_P (XFRAME (calling_frame))
+ && (!EQ (selected_frame, calling_frame)
+ || (WINDOW_LIVE_P (XFRAME (calling_frame)->minibuffer_window)
+ && !EQ (XWINDOW (XFRAME (calling_frame)->minibuffer_window)
+ ->frame,
+ calling_frame))))
+ call2 (Qselect_frame_set_input_focus, calling_frame, Qnil);
/* Add the value to the appropriate history list, if any. This is
done after the previous buffer has been made current again, in
case the history variable is buffer-local. */
if (! (NILP (Vhistory_add_new_input) || NILP (histstring)))
- call2 (intern ("add-to-history"), histvar, histstring);
+ call2 (Qadd_to_history, histvar, histstring);
/* If Lisp form desired instead of string, parse it. */
if (expflag)
@@ -923,7 +977,7 @@ static Lisp_Object
nth_minibuffer (EMACS_INT depth)
{
Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
- return XCAR (tail);
+ return Fcar (tail);
}
/* Set the major mode of the minibuffer BUF, depending on DEPTH, the
@@ -938,13 +992,13 @@ set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth)
Fset_buffer (buf);
if (depth > 0)
{
- if (!NILP (Ffboundp (intern ("fundamental-mode"))))
- call0 (intern ("fundamental-mode"));
+ if (!NILP (Ffboundp (Qminibuffer_mode)))
+ call0 (Qminibuffer_mode);
}
else
{
- if (!NILP (Ffboundp (intern ("minibuffer-inactive-mode"))))
- call0 (intern ("minibuffer-inactive-mode"));
+ if (!NILP (Ffboundp (Qminibuffer_inactive_mode)))
+ call0 (Qminibuffer_inactive_mode);
else
Fkill_all_local_variables ();
}
@@ -959,11 +1013,16 @@ Lisp_Object
get_minibuffer (EMACS_INT depth)
{
Lisp_Object tail = Fnthcdr (make_fixnum (depth), Vminibuffer_list);
+ Lisp_Object cll_tail = Fnthcdr (make_fixnum (depth),
+ Vcommand_loop_level_list);
if (NILP (tail))
{
tail = list1 (Qnil);
Vminibuffer_list = nconc2 (Vminibuffer_list, tail);
+ cll_tail = list1 (Qnil);
+ Vcommand_loop_level_list = nconc2 (Vcommand_loop_level_list, cll_tail);
}
+ XSETCAR (cll_tail, make_fixnum (depth ? command_loop_level : 0));
Lisp_Object buf = Fcar (tail);
if (NILP (buf) || !BUFFER_LIVE_P (XBUFFER (buf)))
{
@@ -973,7 +1032,6 @@ get_minibuffer (EMACS_INT depth)
buf = Fget_buffer_create (lname, Qnil);
/* Do this before set_minibuffer_mode. */
XSETCAR (tail, buf);
- set_minibuffer_mode (buf, depth);
/* Although the buffer's name starts with a space, undo should be
enabled in it. */
Fbuffer_enable_undo (buf);
@@ -985,18 +1043,33 @@ get_minibuffer (EMACS_INT depth)
while the buffer doesn't know about them any more. */
delete_all_overlays (XBUFFER (buf));
reset_buffer (XBUFFER (buf));
- set_minibuffer_mode (buf, depth);
}
return buf;
}
+static EMACS_INT minibuf_c_loop_level (EMACS_INT depth)
+{
+ Lisp_Object cll = Fnth (make_fixnum (depth), Vcommand_loop_level_list);
+ if (FIXNUMP (cll))
+ return XFIXNUM (cll);
+ return 0;
+}
+
static void
run_exit_minibuf_hook (void)
{
safe_run_hooks (Qminibuffer_exit_hook);
}
+/* This variable records the expired minibuffer's frame between the
+ calls of `read_minibuf_unwind' and `minibuffer_unwind'. It should
+ be used only by these two functions. Note that the same search
+ method for the MB's frame won't always work in `minibuffer_unwind'
+ because the intervening `restore-window-configuration' will have
+ changed the buffer in the mini-window. */
+static Lisp_Object exp_MB_frame;
+
/* This function is called on exiting minibuffer, whether normally or
not, and it restores the current window, buffer, etc. */
@@ -1004,17 +1077,45 @@ static void
read_minibuf_unwind (void)
{
Lisp_Object old_deactivate_mark;
- Lisp_Object window;
+ Lisp_Object calling_frame;
+ Lisp_Object calling_window;
Lisp_Object future_mini_window;
+ Lisp_Object saved_selected_frame = selected_frame;
+ Lisp_Object window, frames;
+ Lisp_Object expired_MB = nth_minibuffer (minibuf_level);
+ struct window *w;
+ struct frame *f;
- /* If this was a recursive minibuffer,
- tie the minibuffer window back to the outer level minibuffer buffer. */
- minibuf_level--;
+ if (NILP (expired_MB))
+ emacs_abort ();
+
+ /* Locate the expired minibuffer. */
+ FOR_EACH_FRAME (frames, exp_MB_frame)
+ {
+ f = XFRAME (exp_MB_frame);
+ window = f->minibuffer_window;
+ if (WINDOW_LIVE_P (window))
+ {
+ w = XWINDOW (window);
+ if (EQ (w->frame, exp_MB_frame)
+ && EQ (w->contents, expired_MB))
+ goto found;
+ }
+ }
+ exp_MB_frame = Qnil; /* "Can't happen." */
+
+ found:
+ if (!EQ (exp_MB_frame, saved_selected_frame)
+ && !NILP (exp_MB_frame))
+ do_switch_frame (exp_MB_frame, 0, 0, Qt); /* This also sets
+ minibuf_window */
- window = minibuf_window;
/* To keep things predictable, in case it matters, let's be in the
- minibuffer when we reset the relevant variables. */
- Fset_buffer (XWINDOW (window)->contents);
+ minibuffer when we reset the relevant variables. Don't depend on
+ `minibuf_window' here. This could by now be the mini-window of any
+ frame. */
+ Fset_buffer (expired_MB);
+ minibuf_level--;
/* Restore prompt, etc, from outer minibuffer level. */
Lisp_Object key_vec = Fcar (minibuf_save_list);
@@ -1042,6 +1143,10 @@ read_minibuf_unwind (void)
#endif
future_mini_window = Fcar (minibuf_save_list);
minibuf_save_list = Fcdr (minibuf_save_list);
+ calling_frame = Fcar (minibuf_save_list);
+ minibuf_save_list = Fcdr (minibuf_save_list);
+ calling_window = Fcar (minibuf_save_list);
+ minibuf_save_list = Fcdr (minibuf_save_list);
/* Erase the minibuffer we were using at this level. */
{
@@ -1059,7 +1164,7 @@ read_minibuf_unwind (void)
mini-window back to its normal size. */
if (minibuf_level == 0
|| !EQ (selected_frame, WINDOW_FRAME (XWINDOW (future_mini_window))))
- resize_mini_window (XWINDOW (window), 0);
+ resize_mini_window (XWINDOW (minibuf_window), 0);
/* Deal with frames that should be removed when exiting the
minibuffer. */
@@ -1089,8 +1194,69 @@ read_minibuf_unwind (void)
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
made sense during the read_minibuf invocation. */
- call0 (intern ("minibuffer-inactive-mode"));
+ call0 (Qminibuffer_inactive_mode);
+
+ /* We've exited the recursive edit, so switch the current windows
+ away from the expired minibuffer window, both in the current
+ minibuffer's frame and the original calling frame. */
+ choose_minibuf_frame ();
+ if (NILP (XWINDOW (minibuf_window)->prev_buffers))
+ {
+ if (!EQ (WINDOW_FRAME (XWINDOW (minibuf_window)), calling_frame))
+ {
+ Lisp_Object prev = Fprevious_window (minibuf_window, Qnil, Qnil);
+ /* PREV can be on a different frame when we have a minibuffer only
+ frame, the other frame's minibuffer window is MINIBUF_WINDOW,
+ and its "focus window" is also MINIBUF_WINDOW. */
+ if (!EQ (prev, minibuf_window)
+ && EQ (WINDOW_FRAME (XWINDOW (prev)),
+ WINDOW_FRAME (XWINDOW (minibuf_window))))
+ Fset_frame_selected_window (selected_frame, prev, Qnil);
+ }
+ else if (WINDOW_LIVE_P (calling_window))
+ Fset_frame_selected_window (calling_frame, calling_window, Qnil);
+ }
+
+ /* Restore the selected frame. */
+ if (!EQ (exp_MB_frame, saved_selected_frame)
+ && !NILP (exp_MB_frame))
+ do_switch_frame (saved_selected_frame, 0, 0, Qt);
}
+
+/* Replace the expired minibuffer in frame exp_MB_frame with the next less
+ nested minibuffer in that frame, if any. Otherwise, replace it
+ with the null minibuffer. MINIBUF_WINDOW is not changed. */
+static void
+minibuffer_unwind (void)
+{
+ struct frame *f;
+ struct window *w;
+ Lisp_Object window;
+ Lisp_Object entry;
+
+ if (NILP (exp_MB_frame)) return; /* "Can't happen." */
+ f = XFRAME (exp_MB_frame);
+ window = f->minibuffer_window;
+ w = XWINDOW (window);
+ if (FRAME_LIVE_P (f))
+ {
+ /* minibuf_window = sf->minibuffer_window; */
+ if (!NILP (w->prev_buffers))
+ {
+ entry = Fcar (w->prev_buffers);
+ w->prev_buffers = Fcdr (w->prev_buffers);
+ set_window_buffer (window, Fcar (entry), 0, 0);
+ Fset_window_start (window, Fcar (Fcdr (entry)), Qnil);
+ Fset_window_point (window, Fcar (Fcdr (Fcdr (entry))));
+ /* set-window-configuration may/will have unselected the
+ mini-window as the selected window. Restore it. */
+ Fset_frame_selected_window (exp_MB_frame, window, Qnil);
+ }
+ else
+ set_window_buffer (window, nth_minibuffer (0), 0, 0);
+ }
+}
+
void
@@ -1229,30 +1395,6 @@ Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
return unbind_to (count, val);
}
-DEFUN ("read-no-blanks-input", Fread_no_blanks_input, Sread_no_blanks_input, 1, 3, 0,
- doc: /* Read a string from the terminal, not allowing blanks.
-Prompt with PROMPT. Whitespace terminates the input. If INITIAL is
-non-nil, it should be a string, which is used as initial input, with
-point positioned at the end, so that SPACE will accept the input.
-\(Actually, INITIAL can also be a cons of a string and an integer.
-Such values are treated as in `read-from-minibuffer', but are normally
-not useful in this function.)
-
-Third arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
-the current input method and the setting of`enable-multibyte-characters'.
-
-If `inhibit-interaction' is non-nil, this function will signal an
-`inhibited-interaction' error. */)
- (Lisp_Object prompt, Lisp_Object initial, Lisp_Object inherit_input_method)
-{
- CHECK_STRING (prompt);
- barf_if_interaction_inhibited ();
-
- return read_minibuf (Vminibuffer_local_ns_map, initial, prompt,
- 0, Qminibuffer_history, make_fixnum (0), Qnil, 0,
- !NILP (inherit_input_method));
-}
-
DEFUN ("read-command", Fread_command, Sread_command, 1, 2, 0,
doc: /* Read the name of a command and return as a symbol.
Prompt with PROMPT. By default, return DEFAULT-VALUE or its first element
@@ -1367,8 +1509,8 @@ function, instead of the usual behavior. */)
STRING_MULTIBYTE (prompt));
}
- AUTO_STRING (format, "%s (default %s): ");
- prompt = CALLN (Fformat, format, prompt,
+ prompt = CALLN (Ffuncall, intern("format-prompt"),
+ prompt,
CONSP (def) ? XCAR (def) : def);
}
@@ -1890,7 +2032,8 @@ HIST, if non-nil, specifies a history list and optionally the initial
(This is the only case in which you should use INITIAL-INPUT instead
of DEF.) Positions are counted starting from 1 at the beginning of
the list. The variable `history-length' controls the maximum length
- of a history list.
+ of a history list. If HIST is the symbol `t', history is not
+ recorded.
DEF, if non-nil, is the default value or the list of default values.
@@ -2131,13 +2274,23 @@ If no minibuffer is active, return nil. */)
+void
+set_initial_minibuffer_mode (void)
+{
+ Lisp_Object minibuf = get_minibuffer (0);
+ set_minibuffer_mode (minibuf, 0);
+}
+
static void init_minibuf_once_for_pdumper (void);
void
init_minibuf_once (void)
{
staticpro (&Vminibuffer_list);
+ staticpro (&Vcommand_loop_level_list);
pdumper_do_now_and_after_load (init_minibuf_once_for_pdumper);
+ /* Ensure our inactive minibuffer exists. */
+ get_minibuffer (0);
}
static void
@@ -2150,6 +2303,7 @@ init_minibuf_once_for_pdumper (void)
restore from a dump file. pdumper doesn't try to preserve
frames, windows, and so on, so reset everything related here. */
Vminibuffer_list = Qnil;
+ Vcommand_loop_level_list = Qnil;
minibuf_level = 0;
minibuf_prompt = Qnil;
minibuf_save_list = Qnil;
@@ -2161,6 +2315,9 @@ syms_of_minibuf (void)
{
staticpro (&minibuf_prompt);
staticpro (&minibuf_save_list);
+ staticpro (&MB_frame);
+ MB_frame = Qnil;
+ staticpro (&exp_MB_frame);
DEFSYM (Qminibuffer_follows_selected_frame,
"minibuffer-follows-selected-frame");
@@ -2194,6 +2351,13 @@ syms_of_minibuf (void)
/* A frame parameter. */
DEFSYM (Qminibuffer_exit, "minibuffer-exit");
+ DEFSYM (Qminibuffer_mode, "minibuffer-mode");
+ DEFSYM (Qminibuffer_inactive_mode, "minibuffer-inactive-mode");
+ DEFSYM (Qminibuffer_completing_file_name, "minibuffer-completing-file-name");
+ DEFSYM (Qselect_frame_set_input_focus, "select-frame-set-input-focus");
+ DEFSYM (Qadd_to_history, "add-to-history");
+ DEFSYM (Qpush_window_buffer_onto_prev, "push-window-buffer-onto-prev");
+
DEFVAR_LISP ("read-expression-history", Vread_expression_history,
doc: /* A history list for arguments that are Lisp expressions to evaluate.
For example, `eval-expression' uses this. */);
@@ -2224,7 +2388,7 @@ default top level value is used. */);
Vminibuffer_setup_hook = Qnil;
DEFVAR_LISP ("minibuffer-exit-hook", Vminibuffer_exit_hook,
- doc: /* Normal hook run just after exit from minibuffer. */);
+ doc: /* Normal hook run whenever a minibuffer is exited. */);
Vminibuffer_exit_hook = Qnil;
DEFVAR_LISP ("history-length", Vhistory_length,
@@ -2366,6 +2530,19 @@ for instance when running a headless Emacs server. Functions like
instead. */);
inhibit_interaction = 0;
+ DEFVAR_BOOL ("read-minibuffer-restore-windows", read_minibuffer_restore_windows,
+ doc: /* Non-nil means restore window configurations on exit from minibuffer.
+If this is non-nil (the default), reading input with the minibuffer will
+restore, on exit, the window configurations of the frame where the
+minibuffer was entered from and, if it is different, the frame that owns
+the associated minibuffer window.
+
+If this is nil, window configurations are not restored upon exiting
+the minibuffer. However, if `minibuffer-restore-windows' is present
+in `minibuffer-exit-hook', exiting the minibuffer will remove the window
+showing the *Completions* buffer, if any. */);
+ read_minibuffer_restore_windows = true;
+
defsubr (&Sactive_minibuffer_window);
defsubr (&Sset_minibuffer_window);
defsubr (&Sread_from_minibuffer);
@@ -2374,12 +2551,12 @@ instead. */);
defsubr (&Sread_variable);
defsubr (&Sinternal_complete_buffer);
defsubr (&Sread_buffer);
- defsubr (&Sread_no_blanks_input);
defsubr (&Sminibuffer_depth);
defsubr (&Sminibuffer_prompt);
defsubr (&Sminibufferp);
defsubr (&Sinnermost_minibuffer_p);
+ defsubr (&Sminibuffer_innermost_command_loop_p);
defsubr (&Sabort_minibuffers);
defsubr (&Sminibuffer_prompt_end);
defsubr (&Sminibuffer_contents);
diff --git a/src/nsfns.m b/src/nsfns.m
index 5c4cc915e7c..c40367703db 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -668,23 +668,7 @@ ns_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
}
}
- {
- int inhibit
- = ((f->after_make_frame
- && !f->tool_bar_resized
- && (EQ (frame_inhibit_implied_resize, Qt)
- || (CONSP (frame_inhibit_implied_resize)
- && !NILP (Fmemq (Qtool_bar_lines,
- frame_inhibit_implied_resize))))
- && NILP (get_frame_param (f, Qfullscreen)))
- ? 0
- : 2);
-
- NSTRACE_MSG ("inhibit:%d", inhibit);
-
- frame_size_history_add (f, Qupdate_frame_tool_bar, 0, 0, Qnil);
- adjust_frame_size (f, -1, -1, inhibit, 0, Qtool_bar_lines);
- }
+ adjust_frame_size (f, -1, -1, 2, false, Qtool_bar_lines);
}
static void
@@ -963,11 +947,7 @@ frame_parm_handler ns_frame_parm_handlers[] =
0, /* x_set_sticky */
0, /* x_set_tool_bar_position */
0, /* x_set_inhibit_double_buffering */
-#ifdef NS_IMPL_COCOA
ns_set_undecorated,
-#else
- 0, /* ns_set_undecorated */
-#endif
ns_set_parent_frame,
0, /* x_set_skip_taskbar */
ns_set_no_focus_on_map,
@@ -1082,7 +1062,6 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
Lisp_Object parent, parent_frame;
struct kboard *kb;
static int desc_ctr = 1;
- int x_width = 0, x_height = 0;
/* gui_display_get_arg modifies parms. */
parms = Fcopy_alist (parms);
@@ -1332,8 +1311,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
RES_TYPE_STRING);
parms = get_geometry_from_preferences (dpyinfo, parms);
- window_prompting = gui_figure_window_size (f, parms, false, true,
- &x_width, &x_height);
+ window_prompting = gui_figure_window_size (f, parms, false, true);
tem = gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0,
RES_TYPE_BOOLEAN);
@@ -1400,13 +1378,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
/* Allow set_window_size_hook, now. */
f->can_set_window_size = true;
- if (x_width > 0)
- SET_FRAME_WIDTH (f, x_width);
- if (x_height > 0)
- SET_FRAME_HEIGHT (f, x_height);
-
- adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, 1,
- Qx_create_frame_2);
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 0, true, Qx_create_frame_2);
if (! f->output_data.ns->explicit_parent)
{
@@ -1427,6 +1400,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
else
{
/* Must have been Qnil. */
+ f->was_invisible = true;
}
}
@@ -1975,8 +1949,11 @@ DEFUN ("ns-hide-emacs", Fns_hide_emacs, Sns_hide_emacs,
doc: /* If ON is non-nil, the entire Emacs application is hidden.
Otherwise if Emacs is hidden, it is unhidden.
If ON is equal to `activate', Emacs is unhidden and becomes
-the active application. */)
- (Lisp_Object on)
+the active application.
+If ON is equal to `activate-front', Emacs is unhidden and
+becomes the active application, but only the selected frame
+is layered in front of the windows of other applications. */)
+ (Lisp_Object on)
{
check_window_system (NULL);
if (EQ (on, intern ("activate")))
@@ -1984,6 +1961,12 @@ the active application. */)
[NSApp unhide: NSApp];
[NSApp activateIgnoringOtherApps: YES];
}
+ else if (EQ (on, intern ("activate-front")))
+ {
+ [NSApp unhide: NSApp];
+ [[NSRunningApplication currentApplication]
+ activateWithOptions: NSApplicationActivateIgnoringOtherApps];
+ }
else if (NILP (on))
[NSApp unhide: NSApp];
else
@@ -3046,7 +3029,8 @@ all_nonzero_ascii (unsigned char *str, ptrdiff_t n)
}
@implementation NSString (EmacsString)
-/* Make an NSString from a Lisp string. */
+/* Make an NSString from a Lisp string. STRING must not be in an
+ encoded form (e.g. UTF-8). */
+ (NSString *)stringWithLispString:(Lisp_Object)string
{
/* Shortcut for the common case. */
diff --git a/src/nsfont.m b/src/nsfont.m
index f4f0d281674..5a9cdfebc01 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -277,30 +277,36 @@ ns_ascii_average_width (NSFont *sfont)
/* Return whether set1 covers set2 to a reasonable extent given by pct.
- We check, out of each 16 Unicode char range containing chars in set2,
- whether at least one character is present in set1.
- This must be true for pct of the pairs to consider it covering. */
+
+ The GNUstep bitmap representation doesn't match Apple's
+ description. It appears to be a single block of bytes, not broken
+ up into planes, where the last byte contains the highest character
+ the character set supports. */
static BOOL
ns_charset_covers(NSCharacterSet *set1, NSCharacterSet *set2, float pct)
{
- const unsigned short *bytes1 = [[set1 bitmapRepresentation] bytes];
- const unsigned short *bytes2 = [[set2 bitmapRepresentation] bytes];
- int i, off = 0, tot = 0;
+ NSData *font = [set1 bitmapRepresentation];
+ NSData *script = [set2 bitmapRepresentation];
- /* Work around what appears to be a GNUstep bug.
- See <https://bugs.gnu.org/11853>. */
- if (! (bytes1 && bytes2))
- return NO;
+ uint8_t *fontPlane = (uint8_t *)[font bytes];
+ uint8_t *scriptPlane = (uint8_t *)[script bytes];
- for (i=0; i<4096; i++, bytes1++, bytes2++)
- if (*bytes2)
- {
- tot++;
- if (*bytes1 == 0) // *bytes1 & *bytes2 != *bytes2
- off++;
- }
- // fprintf(stderr, "off = %d\ttot = %d\n", off,tot);
- return (float)off / tot < 1.0F - pct;
+ int covered = 0, total = 0;
+
+ for (ptrdiff_t b = 0 ; b < [script length] ; b++)
+ for (int i = 0 ; i < 8 ; i++)
+ {
+ if (*(scriptPlane + b) & (1 << i))
+ {
+ total++;
+
+ if (b < [font length]
+ && *(fontPlane + b) & (1 << i))
+ covered++;
+ }
+ }
+
+ return (float)covered / total >= 1.0F - pct;
}
@@ -700,7 +706,7 @@ nsfont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
when setting family in ns_spec_to_descriptor(). */
if (ns_attribute_fvalue (fontDesc, NSFontWeightTrait) > 0.50F)
traits |= NSBoldFontMask;
- if (fabs (ns_attribute_fvalue (fontDesc, NSFontSlantTrait) > 0.05F))
+ if (ns_attribute_fvalue (fontDesc, NSFontSlantTrait) > 0.05F)
traits |= NSItalicFontMask;
/* see https://web.archive.org/web/20100201175731/http://cocoadev.com/forums/comments.php?DiscussionID=74 */
diff --git a/src/nsimage.m b/src/nsimage.m
index fa81a41a519..dd2bb3b0d7b 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -254,31 +254,26 @@ ns_image_size_in_bytes (void *img)
NSImageRep *imgRep;
Lisp_Object found;
EmacsImage *image;
+ NSString *filename;
/* Search bitmap-file-path for the file, if appropriate. */
found = image_find_image_file (file);
if (!STRINGP (found))
return nil;
- found = ENCODE_FILE (found);
+ filename = [NSString stringWithLispString:found];
- image = [[EmacsImage alloc] initByReferencingFile:
- [NSString stringWithLispString: found]];
+ image = [[EmacsImage alloc] initByReferencingFile:filename];
image->bmRep = nil;
-#ifdef NS_IMPL_COCOA
- imgRep = [NSBitmapImageRep imageRepWithData:[image TIFFRepresentation]];
-#else
- imgRep = [image bestRepresentationForDevice: nil];
-#endif
- if (imgRep == nil)
+ if (![image isValid])
{
[image release];
return nil;
}
+ imgRep = [[image representations] firstObject];
[image setSize: NSMakeSize([imgRep pixelsWide], [imgRep pixelsHigh])];
-
- [image setName: [NSString stringWithLispString: file]];
+ [image setName:filename];
return image;
}
@@ -382,51 +377,10 @@ ns_image_size_in_bytes (void *img)
}
}
- xbm_fg = fg;
[self addRepresentation: bmRep];
return self;
}
-/* Set color for a bitmap image. */
-- (instancetype)setXBMColor: (NSColor *)color
-{
- NSSize s = [self size];
- unsigned char *planes[5];
- EmacsCGFloat r, g, b, a;
- NSColor *rgbColor;
-
- if (bmRep == nil || color == nil)
- return self;
-
- if ([color colorSpace] != [NSColorSpace genericRGBColorSpace])
- rgbColor = [color colorUsingColorSpace:[NSColorSpace genericRGBColorSpace]];
- else
- rgbColor = color;
-
- [rgbColor getRed: &r green: &g blue: &b alpha: &a];
-
- [bmRep getBitmapDataPlanes: planes];
-
- {
- int i, len = s.width*s.height;
- int rr = r * 0xff, gg = g * 0xff, bb = b * 0xff;
- unsigned char fgr = (xbm_fg >> 16) & 0xff;
- unsigned char fgg = (xbm_fg >> 8) & 0xff;
- unsigned char fgb = xbm_fg & 0xff;
-
- for (i = 0; i < len; ++i)
- if (planes[0][i] == fgr && planes[1][i] == fgg && planes[2][i] == fgb)
- {
- planes[0][i] = rr;
- planes[1][i] = gg;
- planes[2][i] = bb;
- }
- xbm_fg = ((rr << 16) & 0xff0000) + ((gg << 8) & 0xff00) + (bb & 0xff);
- }
-
- return self;
-}
-
- (instancetype)initForXPMWithDepth: (int)depth width: (int)width height: (int)height
{
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 24aa5a0ac11..bb0dd2634d8 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -73,7 +73,7 @@ free_frame_menubar (struct frame *f)
id menu = [NSApp mainMenu];
for (int i = [menu numberOfItems] - 1 ; i >= 0; i--)
{
- NSMenuItem *item = [menu itemAtIndex:i];
+ NSMenuItem *item = (NSMenuItem *)[menu itemAtIndex:i];
NSString *title = [item title];
if ([ns_app_name isEqualToString:title])
@@ -358,8 +358,12 @@ ns_update_menubar (struct frame *f, bool deep_p)
if (i < [menu numberOfItems])
{
NSString *titleStr = [NSString stringWithUTF8String: wv->name];
- NSMenuItem *item = [menu itemAtIndex:i];
- submenu = (EmacsMenu*)[item submenu];
+ NSMenuItem *item = (NSMenuItem *)[menu itemAtIndex:i];
+ submenu = (EmacsMenu *)[item submenu];
+
+#ifdef NS_IMPL_GNUSTEP
+ [submenu close];
+#endif
[item setTitle:titleStr];
[submenu setTitle:titleStr];
@@ -368,8 +372,10 @@ ns_update_menubar (struct frame *f, bool deep_p)
else
submenu = [menu addSubmenuWithTitle: wv->name];
+#ifdef NS_IMPL_COCOA
if ([[submenu title] isEqualToString:@"Help"])
[NSApp setHelpMenu:submenu];
+#endif
if (deep_p)
[submenu fillWithWidgetValue: wv->contents];
@@ -380,6 +386,12 @@ ns_update_menubar (struct frame *f, bool deep_p)
while (i < [menu numberOfItems])
{
/* Remove any extra items. */
+#ifdef NS_IMPL_GNUSTEP
+ NSMenuItem *item = (NSMenuItem *)[menu itemAtIndex:i];
+ EmacsMenu *submenu = (EmacsMenu *)[item submenu];
+ [submenu close];
+#endif
+
[menu removeItemAtIndex:i];
}
@@ -472,7 +484,7 @@ set_frame_menubar (struct frame *f, bool deep_p)
if (menu_separator_name_p (wv->name))
{
- item = [NSMenuItem separatorItem];
+ item = (NSMenuItem *)[NSMenuItem separatorItem];
}
else
{
@@ -534,7 +546,7 @@ set_frame_menubar (struct frame *f, bool deep_p)
needsUpdate = YES;
}
-
+#ifdef NS_IMPL_COCOA
typedef struct {
const char *from, *to;
} subst_t;
@@ -591,17 +603,18 @@ prettify_key (const char *key)
xfree (buf);
return SSDATA (result);
}
+#endif /* NS_IMPL_COCOA */
- (void)fillWithWidgetValue: (void *)wvptr
{
widget_value *first_wv = (widget_value *)wvptr;
- NSFont *menuFont = [NSFont menuFontOfSize:0];
NSDictionary *attributes = nil;
#ifdef NS_IMPL_COCOA
/* Cocoa doesn't allow multi-key sequences in its menu display, so
work around it by using tabs to split the title into two
columns. */
+ NSFont *menuFont = [NSFont menuFontOfSize:0];
NSDictionary *font_attribs = @{NSFontAttributeName: menuFont};
CGFloat maxNameWidth = 0;
CGFloat maxKeyWidth = 0;
@@ -672,9 +685,9 @@ prettify_key (const char *key)
- (EmacsMenu *)addSubmenuWithTitle: (const char *)title
{
NSString *titleStr = [NSString stringWithUTF8String: title];
- NSMenuItem *item = [self addItemWithTitle: titleStr
- action: (SEL)nil /*@selector (menuDown:) */
- keyEquivalent: @""];
+ NSMenuItem *item = (NSMenuItem *)[self addItemWithTitle: titleStr
+ action: (SEL)nil
+ keyEquivalent: @""];
EmacsMenu *submenu = [[EmacsMenu alloc] initWithTitle: titleStr];
[self setSubmenu: submenu forItem: item];
[submenu release];
@@ -711,6 +724,44 @@ prettify_key (const char *key)
: Qnil;
}
+#ifdef NS_IMPL_GNUSTEP
+- (void) close
+{
+ /* Close all the submenus. This has the unfortunate side-effect of
+ breaking tear-off menus, however if we don't do this then we get
+ a crash when the menus are removed during updates. */
+ for (int i = 0 ; i < [self numberOfItems] ; i++)
+ {
+ NSMenuItem *item = [self itemAtIndex:i];
+ if ([item hasSubmenu])
+ [(EmacsMenu *)[item submenu] close];
+ }
+
+ [super close];
+}
+
+/* GNUstep seems to have a number of required methods in
+ NSMenuDelegate that are optional in Cocoa. */
+
+- (void) menuWillOpen:(NSMenu *)menu
+{
+}
+
+- (void) menuDidClose:(NSMenu *)menu
+{
+}
+
+- (NSRect)confinementRectForMenu:(NSMenu *)menu
+ onScreen:(NSScreen *)screen
+{
+ return NSZeroRect;
+}
+
+- (void)menu:(NSMenu *)menu willHighlightItem:(NSMenuItem *)item
+{
+}
+#endif
+
@end /* EmacsMenu */
@@ -940,12 +991,11 @@ free_frame_tool_bar (struct frame *f)
NSTRACE ("free_frame_tool_bar");
block_input ();
- view->wait_for_tool_bar = NO;
/* Note: This triggers an animation, which calls windowDidResize
repeatedly. */
f->output_data.ns->in_animation = 1;
- [[view toolbar] setVisible: NO];
+ [[[view window] toolbar] setVisible: NO];
f->output_data.ns->in_animation = 0;
unblock_input ();
@@ -958,12 +1008,12 @@ update_frame_tool_bar (struct frame *f)
-------------------------------------------------------------------------- */
{
int i, k = 0;
- EmacsView *view = FRAME_NS_VIEW (f);
- EmacsToolbar *toolbar = [view toolbar];
+ NSWindow *window = [FRAME_NS_VIEW (f) window];
+ EmacsToolbar *toolbar = (EmacsToolbar *)[window toolbar];
NSTRACE ("update_frame_tool_bar");
- if (view == nil || toolbar == nil) return;
+ if (window == nil || toolbar == nil) return;
block_input ();
#ifdef NS_IMPL_COCOA
@@ -1039,10 +1089,10 @@ update_frame_tool_bar (struct frame *f)
#undef TOOLPROP
}
- if (![toolbar isVisible])
+ if ([toolbar isVisible] != FRAME_EXTERNAL_TOOL_BAR (f))
{
f->output_data.ns->in_animation = 1;
- [toolbar setVisible: YES];
+ [toolbar setVisible: FRAME_EXTERNAL_TOOL_BAR (f)];
f->output_data.ns->in_animation = 0;
}
@@ -1069,13 +1119,6 @@ update_frame_tool_bar (struct frame *f)
[newDict release];
}
#endif
-
- if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0)
- {
- view->wait_for_tool_bar = NO;
- [view setNeedsDisplay: YES];
- }
-
unblock_input ();
}
diff --git a/src/nsterm.h b/src/nsterm.h
index eae1d0725ea..404c7140056 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -348,16 +348,6 @@ typedef id instancetype;
#endif
-/* macOS 10.14 and above cannot draw directly "to the glass" and
- therefore we draw to an offscreen buffer and swap it in when the
- toolkit wants to draw the frame. GNUstep and macOS 10.7 and below
- do not support this method, so we revert to drawing directly to the
- glass. */
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101400
-#define NS_DRAW_TO_BUFFER 1
-#endif
-
-
/* ==========================================================================
NSColor, EmacsColor category.
@@ -416,6 +406,25 @@ typedef id instancetype;
@end
#endif
+/* EmacsWindow */
+@interface EmacsWindow : NSWindow
+{
+ NSPoint grabOffset;
+}
+
+#ifdef NS_IMPL_GNUSTEP
+- (NSInteger) orderedIndex;
+#endif
+
+- (instancetype)initWithEmacsFrame:(struct frame *)f;
+- (instancetype)initWithEmacsFrame:(struct frame *)f fullscreen:(BOOL)fullscreen screen:(NSScreen *)screen;
+- (void)setParentChildRelationships;
+- (NSInteger)borderWidth;
+- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
+- (void)setAppearance;
+@end
+
+
/* ==========================================================================
The main Emacs view
@@ -423,7 +432,7 @@ typedef id instancetype;
========================================================================== */
@class EmacsToolbar;
-@class EmacsSurface;
+@class EmacsLayer;
#ifdef NS_IMPL_COCOA
@interface EmacsView : NSView <NSTextInput, NSWindowDelegate>
@@ -439,20 +448,13 @@ typedef id instancetype;
NSString *workingText;
BOOL processingCompose;
int fs_state, fs_before_fs, next_maximized;
- int bwidth;
int maximized_width, maximized_height;
- NSWindow *nonfs_window;
+ EmacsWindow *nonfs_window;
BOOL fs_is_native;
- BOOL in_fullscreen_transition;
-#ifdef NS_DRAW_TO_BUFFER
- EmacsSurface *surface;
-#endif
@public
struct frame *emacsframe;
int scrollbarsNeedingUpdate;
- EmacsToolbar *toolbar;
NSRect ns_userRect;
- BOOL wait_for_tool_bar;
}
/* AppKit-side interface */
@@ -466,17 +468,13 @@ typedef id instancetype;
/* Emacs-side interface */
- (instancetype) initFrameFromEmacs: (struct frame *) f;
-- (void) createToolbar: (struct frame *)f;
- (void) setWindowClosing: (BOOL)closing;
-- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
- (void) handleFS;
- (void) setFSValue: (int)value;
- (void) toggleFullScreen: (id) sender;
- (BOOL) fsIsNative;
- (BOOL) isFullscreen;
-- (BOOL) inFullScreenTransition;
-- (void) waitFullScreenTransition;
#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- (void) updateCollectionBehavior;
#endif
@@ -486,9 +484,9 @@ typedef id instancetype;
#endif
- (int)fullscreenState;
-#ifdef NS_DRAW_TO_BUFFER
-- (void)focusOnDrawingBuffer;
-- (void)unfocusDrawingBuffer;
+#ifdef NS_IMPL_COCOA
+- (void)lockFocus;
+- (void)unlockFocus;
#endif
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect;
@@ -501,23 +499,6 @@ typedef id instancetype;
@end
-/* Small utility used for processing resize events under Cocoa. */
-@interface EmacsWindow : NSWindow
-{
- NSPoint grabOffset;
-}
-
-- (BOOL)restackWindow:(NSWindow *)win above:(BOOL)above;
-- (void)setAppearance;
-@end
-
-
-/* Fullscreen version of the above. */
-@interface EmacsFSWindow : EmacsWindow
-{
-}
-@end
-
/* ==========================================================================
The main menu implementation
@@ -646,7 +627,6 @@ typedef id instancetype;
NSBitmapImageRep *bmRep; /* used for accessing pixel data */
unsigned char *pixmapData[5]; /* shortcut to access pixel data */
NSColor *stippleMask;
- unsigned long xbm_fg;
@public
NSAffineTransform *transform;
BOOL smoothing;
@@ -656,7 +636,6 @@ typedef id instancetype;
- (instancetype)initFromXBM: (unsigned char *)bits width: (int)w height: (int)h
fg: (unsigned long)fg bg: (unsigned long)bg
reverseBytes: (BOOL)reverse;
-- (instancetype)setXBMColor: (NSColor *)color;
- (instancetype)initForXPMWithDepth: (int)depth width: (int)width height: (int)height;
- (void)setPixmapData;
- (unsigned long)getPixelAtX: (int)x Y: (int)y;
@@ -715,22 +694,17 @@ typedef id instancetype;
+ (CGFloat)scrollerWidth;
@end
-#ifdef NS_DRAW_TO_BUFFER
-@interface EmacsSurface : NSObject
+#ifdef NS_IMPL_COCOA
+@interface EmacsLayer : CALayer
{
NSMutableArray *cache;
- NSSize size;
CGColorSpaceRef colorSpace;
IOSurfaceRef currentSurface;
- IOSurfaceRef lastSurface;
CGContextRef context;
}
-- (id) initWithSize: (NSSize)s ColorSpace: (CGColorSpaceRef)cs;
-- (void) dealloc;
-- (NSSize) getSize;
+- (id) initWithColorSpace: (CGColorSpaceRef)cs;
+- (void) setColorSpace: (CGColorSpaceRef)cs;
- (CGContextRef) getContext;
-- (void) releaseContext;
-- (IOSurfaceRef) getSurface;
@end
#endif
@@ -1188,9 +1162,7 @@ extern void ns_run_ascript (void);
#define NSAPP_DATA2_RUNFILEDIALOG 11
extern void ns_run_file_dialog (void);
-extern const char *ns_etc_directory (void);
-extern const char *ns_exec_path (void);
-extern const char *ns_load_path (void);
+extern const char *ns_relocate (const char *epath);
extern void syms_of_nsterm (void);
extern void syms_of_nsfns (void);
extern void syms_of_nsmenu (void);
@@ -1252,6 +1224,7 @@ struct input_event;
extern void ns_init_events (struct input_event *);
extern void ns_finish_events (void);
+extern double ns_frame_scale_factor (struct frame *);
#ifdef NS_IMPL_GNUSTEP
extern char gnustep_base_version[]; /* version tracking */
diff --git a/src/nsterm.m b/src/nsterm.m
index 1b2328628ee..ba5d81fb6cd 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -70,9 +70,6 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
#ifdef NS_IMPL_COCOA
#include "macfont.h"
#include <Carbon/Carbon.h>
-#endif
-
-#ifdef NS_DRAW_TO_BUFFER
#include <IOSurface/IOSurface.h>
#endif
@@ -272,16 +269,11 @@ long context_menu_value = 0;
/* display update */
static struct frame *ns_updating_frame;
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
-static NSView *focus_view = NULL;
-#endif
static int ns_window_num = 0;
static BOOL gsaved = NO;
-static BOOL ns_fake_keydown = NO;
#ifdef NS_IMPL_COCOA
static BOOL ns_menu_bar_is_hidden = NO;
#endif
-/* static int debug_lock = 0; */
/* event loop */
static BOOL send_appdefined = YES;
@@ -499,118 +491,37 @@ append2 (Lisp_Object list, Lisp_Object item)
const char *
-ns_etc_directory (void)
-/* If running as a self-contained app bundle, return as a string the
- filename of the etc directory, if present; else nil. */
-{
- NSBundle *bundle = [NSBundle mainBundle];
- NSString *resourceDir = [bundle resourcePath];
- NSString *resourcePath;
- NSFileManager *fileManager = [NSFileManager defaultManager];
- BOOL isDir;
-
- resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"];
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- {
- if (isDir) return [resourcePath UTF8String];
- }
- return NULL;
-}
+ns_relocate (const char *epath)
+/* If we're running in a self-contained app bundle some hard-coded
+ paths are relative to the root of the bundle, so work out the full
+ path.
-
-const char *
-ns_exec_path (void)
-/* If running as a self-contained app bundle, return as a path string
- the filenames of the libexec and bin directories, ie libexec:bin.
- Otherwise, return nil.
- Normally, Emacs does not add its own bin/ directory to the PATH.
- However, a self-contained NS build has a different layout, with
- bin/ and libexec/ subdirectories in the directory that contains
- Emacs.app itself.
- We put libexec first, because init_callproc_1 uses the first
- element to initialize exec-directory. An alternative would be
- for init_callproc to check for invocation-directory/libexec.
-*/
+ FIXME: I think this should be able to handle cases where multiple
+ directories are separated by colons. */
{
+#ifdef NS_SELF_CONTAINED
NSBundle *bundle = [NSBundle mainBundle];
- NSString *resourceDir = [bundle resourcePath];
- NSString *binDir = [bundle bundlePath];
- NSString *resourcePath, *resourcePaths;
- NSRange range;
- NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR];
+ NSString *root = [bundle bundlePath];
+ NSString *original = [NSString stringWithUTF8String:epath];
+ NSString *fixedPath = [NSString pathWithComponents:
+ [NSArray arrayWithObjects:
+ root, original, nil]];
NSFileManager *fileManager = [NSFileManager defaultManager];
- NSArray *paths;
- NSEnumerator *pathEnum;
- BOOL isDir;
-
- range = [resourceDir rangeOfString: @"Contents"];
- if (range.location != NSNotFound)
- {
- binDir = [binDir stringByAppendingPathComponent: @"Contents"];
-#ifdef NS_IMPL_COCOA
- binDir = [binDir stringByAppendingPathComponent: @"MacOS"];
-#endif
- }
-
- paths = [binDir stringsByAppendingPaths:
- [NSArray arrayWithObjects: @"libexec", @"bin", nil]];
- pathEnum = [paths objectEnumerator];
- resourcePaths = @"";
- while ((resourcePath = [pathEnum nextObject]))
- {
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- if (isDir)
- {
- if ([resourcePaths length] > 0)
- resourcePaths
- = [resourcePaths stringByAppendingString: pathSeparator];
- resourcePaths
- = [resourcePaths stringByAppendingString: resourcePath];
- }
- }
- if ([resourcePaths length] > 0) return [resourcePaths UTF8String];
-
- return NULL;
-}
+ if (![original isAbsolutePath]
+ && [fileManager fileExistsAtPath:fixedPath isDirectory:NULL])
+ return [fixedPath UTF8String];
+ /* If we reach here either the path is absolute and therefore we
+ don't need to complete it, or we're unable to relocate the
+ file/directory. If it's the latter it may be because the user is
+ trying to use a bundled app as though it's a Unix style install
+ and we have no way to guess what was intended, so return the
+ original string unaltered. */
-const char *
-ns_load_path (void)
-/* If running as a self-contained app bundle, return as a path string
- the filenames of the site-lisp and lisp directories.
- Ie, site-lisp:lisp. Otherwise, return nil. */
-{
- NSBundle *bundle = [NSBundle mainBundle];
- NSString *resourceDir = [bundle resourcePath];
- NSString *resourcePath, *resourcePaths;
- NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR];
- NSFileManager *fileManager = [NSFileManager defaultManager];
- BOOL isDir;
- NSArray *paths = [resourceDir stringsByAppendingPaths:
- [NSArray arrayWithObjects:
- @"site-lisp", @"lisp", nil]];
- NSEnumerator *pathEnum = [paths objectEnumerator];
- resourcePaths = @"";
-
- /* Hack to skip site-lisp. */
- if (no_site_lisp) resourcePath = [pathEnum nextObject];
-
- while ((resourcePath = [pathEnum nextObject]))
- {
- if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir])
- if (isDir)
- {
- if ([resourcePaths length] > 0)
- resourcePaths
- = [resourcePaths stringByAppendingString: pathSeparator];
- resourcePaths
- = [resourcePaths stringByAppendingString: resourcePath];
- }
- }
- if ([resourcePaths length] > 0) return [resourcePaths UTF8String];
+#endif
- return NULL;
+ return epath;
}
@@ -857,6 +768,17 @@ ns_row_rect (struct window *w, struct glyph_row *row,
}
+double
+ns_frame_scale_factor (struct frame *f)
+{
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060
+ return [[FRAME_NS_VIEW (f) window] backingScaleFactor];
+#else
+ return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor];
+#endif
+}
+
+
/* ==========================================================================
Focus (clipping) and screen update
@@ -1104,33 +1026,14 @@ ns_update_begin (struct frame *f)
{
// Fix reappearing tool bar in fullscreen for Mac OS X 10.7
BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (f) ? YES : NO;
- NSToolbar *toolbar = [FRAME_NS_VIEW (f) toolbar];
+ NSToolbar *toolbar = [[FRAME_NS_VIEW (f) window] toolbar];
if (! tbar_visible != ! [toolbar isVisible])
[toolbar setVisible: tbar_visible];
}
#endif
ns_updating_frame = f;
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [view focusOnDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- [view lockFocus];
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
-
+ [view lockFocus];
}
@@ -1141,39 +1044,21 @@ ns_update_end (struct frame *f)
external (RIF) call; for whole frame, called after gui_update_window_end
-------------------------------------------------------------------------- */
{
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
EmacsView *view = FRAME_NS_VIEW (f);
-#endif
NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end");
/* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- block_input ();
-
- [view unlockFocus];
- [[view window] flushWindow];
+ block_input ();
- unblock_input ();
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
+ [view unlockFocus];
+#if defined (NS_IMPL_GNUSTEP)
+ [[view window] flushWindow];
#endif
+
+ unblock_input ();
ns_updating_frame = NULL;
}
@@ -1188,8 +1073,6 @@ ns_focus (struct frame *f, NSRect *r, int n)
the entire window.
-------------------------------------------------------------------------- */
{
- EmacsView *view = FRAME_NS_VIEW (f);
-
NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus");
if (r != NULL)
{
@@ -1198,39 +1081,10 @@ ns_focus (struct frame *f, NSRect *r, int n)
if (f != ns_updating_frame)
{
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- [view focusOnDrawingBuffer];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (view != focus_view)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- }
-
- if (view)
- [view lockFocus];
- focus_view = view;
- }
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
+ EmacsView *view = FRAME_NS_VIEW (f);
+ [view lockFocus];
}
-
/* clipping */
if (r)
{
@@ -1258,35 +1112,14 @@ ns_unfocus (struct frame *f)
gsaved = NO;
}
-#ifdef NS_DRAW_TO_BUFFER
- #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
- {
-#endif
- if (! ns_updating_frame)
- [FRAME_NS_VIEW (f) unfocusDrawingBuffer];
- [FRAME_NS_VIEW (f) setNeedsDisplay:YES];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
+ if (f != ns_updating_frame)
{
+ EmacsView *view = FRAME_NS_VIEW (f);
+ [view unlockFocus];
+#if defined (NS_IMPL_GNUSTEP)
+ [[view window] flushWindow];
#endif
-#endif /* NS_DRAW_TO_BUFFER */
-
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (f != ns_updating_frame)
- {
- if (focus_view != NULL)
- {
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- focus_view = NULL;
- }
- }
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
-#endif
}
@@ -1453,7 +1286,7 @@ ns_ring_bell (struct frame *f)
}
}
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
static void
hide_bell (void)
/* --------------------------------------------------------------------------
@@ -1620,7 +1453,7 @@ ns_make_frame_visible (struct frame *f)
if (!FRAME_VISIBLE_P (f))
{
EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
+ EmacsWindow *window = (EmacsWindow *)[view window];
SET_FRAME_VISIBLE (f, 1);
ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f));
@@ -1629,8 +1462,6 @@ ns_make_frame_visible (struct frame *f)
fullscreen also. So skip handleFS as this will print an error. */
if ([view fsIsNative] && [view isFullscreen])
{
- // maybe it is not necessary to wait
- [view waitFullScreenTransition];
return;
}
@@ -1645,11 +1476,8 @@ ns_make_frame_visible (struct frame *f)
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];
+ [window setParentChildRelationships];
unblock_input ();
/* If the parent frame moved while the child frame was
@@ -1806,52 +1634,35 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int change_grav)
block_input ();
- if (FRAME_PARENT_FRAME (f))
- {
- /* Convert the parent frame's view rectangle into screen
- coords. */
- EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f));
- NSRect parentRect = [parentView convertRect:[parentView frame]
- toView:nil];
- parentRect = [[parentView window] convertRectToScreen:parentRect];
+ /* If there is no parent frame then just convert to screen
+ coordinates, UNLESS we have negative values, in which case I
+ think it's best to position from the bottom and right of the
+ current screen rather than the main screen or whole display. */
- if (f->size_hint_flags & XNegative)
- topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
- else
- topLeft.x = NSMinX (parentRect) + xoff;
+ NSRect parentRect = ns_parent_window_rect (f);
- if (f->size_hint_flags & YNegative)
- topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
- else
- topLeft.y = NSMaxY (parentRect) - yoff;
- }
+ if (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
+ else if (FRAME_PARENT_FRAME (f))
+ topLeft.x = NSMinX (parentRect) + xoff;
else
- {
- /* If there is no parent frame then just convert to screen
- coordinates, UNLESS we have negative values, in which case I
- think it's best to position from the bottom and right of the
- current screen rather than the main screen or whole
- display. */
- NSRect screenFrame = [[[view window] screen] frame];
-
- if (f->size_hint_flags & XNegative)
- topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff;
- else
- topLeft.x = xoff;
+ topLeft.x = xoff;
- if (f->size_hint_flags & YNegative)
- topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff;
- else
- topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff;
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
+ else if (FRAME_PARENT_FRAME (f))
+ topLeft.y = NSMaxY (parentRect) - yoff;
+ else
+ topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) - yoff;
#ifdef NS_IMPL_GNUSTEP
- /* Don't overlap the menu.
+ /* Don't overlap the menu.
- FIXME: Surely there's a better way than just hardcoding 100
- in here? */
- topLeft.x = 100;
+ FIXME: Surely there's a better way than just hardcoding 100 in
+ here? */
+ if (topLeft.x < 100)
+ topLeft.x = 100;
#endif
- }
NSTRACE_POINT ("setFrameTopLeftPoint", topLeft);
[[view window] setFrameTopLeftPoint:topLeft];
@@ -1865,78 +1676,47 @@ static void
ns_set_window_size (struct frame *f,
bool change_gravity,
int width,
- int height,
- bool pixelwise)
+ int height)
/* --------------------------------------------------------------------------
- Adjust window pixel size based on given character grid size
+ Adjust window pixel size based on native sizes WIDTH and HEIGHT.
Impl is a bit more complex than other terms, need to do some
internal clipping.
-------------------------------------------------------------------------- */
{
EmacsView *view = FRAME_NS_VIEW (f);
NSWindow *window = [view window];
- NSRect wr = [window frame];
- int pixelwidth, pixelheight;
- int orig_height = wr.size.height;
+ NSRect frameRect;
NSTRACE ("ns_set_window_size");
if (view == nil)
return;
- NSTRACE_RECT ("current", wr);
- NSTRACE_MSG ("Width:%d Height:%d Pixelwise:%d", width, height, pixelwise);
+ NSTRACE_RECT ("current", [window frame]);
+ NSTRACE_MSG ("Width:%d Height:%d", width, height);
NSTRACE_MSG ("Font %d x %d", FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f));
block_input ();
- if (pixelwise)
- {
- pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
- pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
- }
- else
- {
- pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
- pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
- }
-
- wr.size.width = pixelwidth + f->border_width;
- wr.size.height = pixelheight;
- if (! [view isFullscreen])
- wr.size.height += FRAME_NS_TITLEBAR_HEIGHT (f)
- + FRAME_TOOLBAR_HEIGHT (f);
-
- /* Do not try to constrain to this screen. We may have multiple
- screens, and want Emacs to span those. Constraining to screen
- prevents that, and that is not nice to the user. */
- if (f->output_data.ns->zooming)
- f->output_data.ns->zooming = 0;
- else
- wr.origin.y += orig_height - wr.size.height;
-
- frame_size_history_add
- (f, Qx_set_window_size_1, width, height,
- list5 (Fcons (make_fixnum (pixelwidth), make_fixnum (pixelheight)),
- Fcons (make_fixnum (wr.size.width), make_fixnum (wr.size.height)),
- make_fixnum (f->border_width),
- make_fixnum (FRAME_NS_TITLEBAR_HEIGHT (f)),
- make_fixnum (FRAME_TOOLBAR_HEIGHT (f))));
-
- /* Usually it seems safe to delay changing the frame size, but when a
- series of actions are taken with no redisplay between them then we
- can end up using old values so don't delay here. */
- change_frame_size (f,
- FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth),
- FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight),
- 0, NO, 0, 1);
-
- [window setFrame:wr display:NO];
+ frameRect = [window frameRectForContentRect:NSMakeRect (0, 0, width, height)];
+
+ /* Set the origin so the top left of the frame doesn't move. */
+ frameRect.origin = [window frame].origin;
+ frameRect.origin.y += NSHeight ([view frame]) - height;
+
+ if (f->output_data.ns->zooming)
+ f->output_data.ns->zooming = 0;
+
+ /* Usually it seems safe to delay changing the frame size, but when a
+ series of actions are taken with no redisplay between them then we
+ can end up using old values so don't delay here. */
+ change_frame_size (f, width, height, false, NO, false);
+
+ [window setFrame:frameRect display:NO];
unblock_input ();
}
-#ifdef NS_IMPL_COCOA
void
ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
/* --------------------------------------------------------------------------
@@ -1946,45 +1726,34 @@ ns_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
dragged, resized, iconified, maximized or deleted with the mouse. If
nil, draw the frame with all the elements listed above unless these
have been suspended via window manager settings.
-
- GNUStep cannot change an existing window's style.
-------------------------------------------------------------------------- */
{
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
-
NSTRACE ("ns_set_undecorated");
if (!EQ (new_value, old_value))
{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *oldWindow = [view window];
+ NSWindow *newWindow;
+
block_input ();
- if (NILP (new_value))
- {
- FRAME_UNDECORATED (f) = false;
- [window setStyleMask: ((window.styleMask | FRAME_DECORATED_FLAGS)
- ^ FRAME_UNDECORATED_FLAGS)];
+ FRAME_UNDECORATED (f) = !NILP (new_value);
- [view createToolbar: f];
- }
- else
- {
- [window setToolbar: nil];
- /* Do I need to release the toolbar here? */
+ newWindow = [[EmacsWindow alloc] initWithEmacsFrame:f];
- FRAME_UNDECORATED (f) = true;
- [window setStyleMask: ((window.styleMask | FRAME_UNDECORATED_FLAGS)
- ^ FRAME_DECORATED_FLAGS)];
- }
+ if ([oldWindow isKeyWindow])
+ [newWindow makeKeyAndOrderFront:NSApp];
- /* At this point it seems we don't have an active NSResponder,
- so some key presses (TAB) are swallowed by the system. */
- [window makeFirstResponder: view];
+ [newWindow setIsVisible:[oldWindow isVisible]];
+ if ([oldWindow isMiniaturized])
+ [newWindow miniaturize:NSApp];
+
+ [oldWindow close];
unblock_input ();
}
}
-#endif /* NS_IMPL_COCOA */
void
ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
@@ -2011,7 +1780,6 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val
-------------------------------------------------------------------------- */
{
struct frame *p = NULL;
- NSWindow *parent, *child;
NSTRACE ("ns_set_parent_frame");
@@ -2024,76 +1792,11 @@ ns_set_parent_frame (struct frame *f, Lisp_Object new_value, Lisp_Object old_val
error ("Invalid specification of `parent-frame'");
}
- if (p != FRAME_PARENT_FRAME (f))
- {
- block_input ();
- child = [FRAME_NS_VIEW (f) window];
+ fset_parent_frame (f, new_value);
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
-#endif
-
- if ([child parentWindow] != nil)
- {
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- parent = [child parentWindow];
-#endif
-
- [[child parentWindow] removeChildWindow:child];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
- if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
-#endif
- [child setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole];
-#endif
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- if (NILP (new_value))
- {
- NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary");
- [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
- // if current parent in fullscreen and no new parent make child fullscreen
- while (parent) {
- if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0)
- {
- [view toggleFullScreen:child];
- break;
- }
- // check all parents
- parent = [parent parentWindow];
- }
- }
-#endif
- }
-
- if (!NILP (new_value))
- {
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- // child frame must not be in fullscreen
- if ([view fsIsNative] && [view isFullscreen])
- {
- // in case child is going fullscreen
- [view waitFullScreenTransition];
- [view toggleFullScreen:child];
- }
- NSTRACE ("child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary");
- [child setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
-#endif
- parent = [FRAME_NS_VIEW (p) window];
-
- [parent addChildWindow: child
- ordered: NSWindowAbove];
-#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
- if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
-#endif
- [child setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole];
-#endif
- }
-
- unblock_input ();
-
- fset_parent_frame (f, new_value);
- }
+ block_input ();
+ [(EmacsWindow *)[FRAME_NS_VIEW (f) window] setParentChildRelationships];
+ unblock_input ();
}
void
@@ -2535,12 +2238,10 @@ ns_set_frame_alpha (struct frame *f)
else if (0.0 <= alpha && alpha < alpha_min && alpha_min <= 1.0)
alpha = alpha_min;
-#ifdef NS_IMPL_COCOA
{
EmacsView *view = FRAME_NS_VIEW (f);
- [[view window] setAlphaValue: alpha];
+ [[view window] setAlphaValue: alpha];
}
-#endif
}
@@ -3194,8 +2895,40 @@ ns_compute_glyph_string_overhangs (struct glyph_string *s)
========================================================================== */
+static NSMutableDictionary *fringe_bmp;
+
+static void
+ns_define_fringe_bitmap (int which, unsigned short *bits, int h, int w)
+{
+ NSBezierPath *p = [NSBezierPath bezierPath];
+
+ if (!fringe_bmp)
+ fringe_bmp = [[NSMutableDictionary alloc] initWithCapacity:25];
+
+ [p moveToPoint:NSMakePoint (0, 0)];
+
+ for (int y = 0 ; y < h ; y++)
+ for (int x = 0 ; x < w ; x++)
+ {
+ /* XBM rows are always round numbers of bytes, with any unused
+ bits ignored. */
+ int byte = y * (w/8 + (w%8 ? 1 : 0)) + x/8;
+ bool bit = bits[byte] & (0x80 >> x%8);
+ if (bit)
+ [p appendBezierPathWithRect:NSMakeRect (x, y, 1, 1)];
+ }
+
+ [fringe_bmp setObject:p forKey:[NSNumber numberWithInt:which]];
+}
+
+
+static void
+ns_destroy_fringe_bitmap (int which)
+{
+ [fringe_bmp removeObjectForKey:[NSNumber numberWithInt:which]];
+}
+
-extern int max_used_fringe_bitmap;
static void
ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
struct draw_fringe_bitmap_params *p)
@@ -3221,41 +2954,18 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
struct frame *f = XFRAME (WINDOW_FRAME (w));
struct face *face = p->face;
- static EmacsImage **bimgs = NULL;
- static int nBimgs = 0;
NSRect clearRect = NSZeroRect;
- NSRect imageRect = NSZeroRect;
NSRect rowRect = ns_row_rect (w, row, ANY_AREA);
NSTRACE_WHEN (NSTRACE_GROUP_FRINGE, "ns_draw_fringe_bitmap");
NSTRACE_MSG ("which:%d cursor:%d overlay:%d width:%d height:%d period:%d",
p->which, p->cursor_p, p->overlay_p, p->wd, p->h, p->dh);
- /* grow bimgs if needed */
- if (nBimgs < max_used_fringe_bitmap)
- {
- bimgs = xrealloc (bimgs, max_used_fringe_bitmap * sizeof *bimgs);
- memset (bimgs + nBimgs, 0,
- (max_used_fringe_bitmap - nBimgs) * sizeof *bimgs);
- nBimgs = max_used_fringe_bitmap;
- }
-
- /* Work out the rectangle we will composite into. */
- if (p->which)
- imageRect = NSMakeRect (p->x, p->y, p->wd, p->h);
+ /* Work out the rectangle we will need to clear. */
+ clearRect = NSMakeRect (p->x, p->y, p->wd, p->h);
- /* Work out the rectangle we will need to clear. Because we're
- compositing rather than blitting, we need to clear the area under
- the image regardless of anything else. */
if (p->bx >= 0 && !p->overlay_p)
- {
- clearRect = NSMakeRect (p->bx, p->by, p->nx, p->ny);
- clearRect = NSUnionRect (clearRect, imageRect);
- }
- else
- {
- clearRect = imageRect;
- }
+ clearRect = NSUnionRect (clearRect, NSMakeRect (p->bx, p->by, p->nx, p->ny));
/* Handle partially visible rows. */
clearRect = NSIntersectionRect (clearRect, rowRect);
@@ -3271,53 +2981,29 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
NSRectFill (clearRect);
}
- if (p->which)
+ NSBezierPath *bmp = [fringe_bmp objectForKey:[NSNumber numberWithInt:p->which]];
+ if (bmp)
{
- EmacsImage *img = bimgs[p->which - 1];
+ NSAffineTransform *transform = [NSAffineTransform transform];
+ NSColor *bm_color;
- if (!img)
- {
- // Note: For "periodic" images, allocate one EmacsImage for
- // the base image, and use it for all dh:s.
- unsigned short *bits = p->bits;
- int full_height = p->h + p->dh;
- int i;
- unsigned char *cbits = xmalloc (full_height);
-
- for (i = 0; i < full_height; i++)
- cbits[i] = bits[i];
- img = [[EmacsImage alloc] initFromXBM: cbits width: 8
- height: full_height
- fg: 0 bg: 0
- reverseBytes: NO];
- bimgs[p->which - 1] = img;
- xfree (cbits);
- }
+ /* Because the image is defined at (0, 0) we need to take a copy
+ and then transform that copy to the new origin. */
+ bmp = [bmp copy];
+ [transform translateXBy:p->x yBy:p->y - p->dh];
+ [bmp transformUsingAffineTransform:transform];
+ if (!p->cursor_p)
+ bm_color = ns_lookup_indexed_color(face->foreground, f);
+ else if (p->overlay_p)
+ bm_color = ns_lookup_indexed_color(face->background, f);
+ else
+ bm_color = f->output_data.ns->cursor_color;
- {
- NSColor *bm_color;
- if (!p->cursor_p)
- bm_color = ns_lookup_indexed_color(face->foreground, f);
- else if (p->overlay_p)
- bm_color = ns_lookup_indexed_color(face->background, f);
- else
- bm_color = f->output_data.ns->cursor_color;
- [img setXBMColor: bm_color];
- }
-
- // Note: For periodic images, the full image height is "h + hd".
- // By using the height h, a suitable part of the image is used.
- NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h);
-
- NSTRACE_RECT ("fromRect", fromRect);
+ [bm_color set];
+ [bmp fill];
- [img drawInRect: imageRect
- fromRect: fromRect
- operation: NSCompositingOperationSourceOver
- fraction: 1.0
- respectFlipped: YES
- hints: nil];
+ [bmp release];
}
ns_unfocus (f);
}
@@ -3792,7 +3478,7 @@ ns_draw_box (NSRect r, CGFloat hthickness, CGFloat vthickness,
static void
-ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
+ns_draw_relief (NSRect outer, int hthickness, int vthickness, char raised_p,
char top_p, char bottom_p, char left_p, char right_p,
struct glyph_string *s)
/* --------------------------------------------------------------------------
@@ -3803,7 +3489,7 @@ ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
{
static NSColor *baseCol = nil, *lightCol = nil, *darkCol = nil;
NSColor *newBaseCol = nil;
- NSRect sr = r;
+ NSRect inner;
NSTRACE ("ns_draw_relief");
@@ -3837,33 +3523,50 @@ ns_draw_relief (NSRect r, int hthickness, int vthickness, char raised_p,
darkCol = [[baseCol shadowWithLevel: 0.3] retain];
}
- [(raised_p ? lightCol : darkCol) set];
-
- /* TODO: mitering. Using NSBezierPath doesn't work because of color switch. */
+ /* Calculate the inner rectangle. */
+ inner = NSInsetRect (outer, hthickness, vthickness);
- /* top */
- sr.size.height = hthickness;
- if (top_p) NSRectFill (sr);
+ [(raised_p ? lightCol : darkCol) set];
- /* left */
- sr.size.height = r.size.height;
- sr.size.width = vthickness;
- if (left_p) NSRectFill (sr);
+ if (top_p || left_p)
+ {
+ NSBezierPath *p = [NSBezierPath bezierPath];
+ [p moveToPoint:NSMakePoint (NSMinX (outer), NSMinY (outer))];
+ if (top_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))];
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))];
+ }
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMinY (inner))];
+ if (left_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))];
+ [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))];
+ }
+ [p closePath];
+ [p fill];
+ }
[(raised_p ? darkCol : lightCol) set];
- /* bottom */
- sr.size.width = r.size.width;
- sr.size.height = hthickness;
- sr.origin.y += r.size.height - hthickness;
- if (bottom_p) NSRectFill (sr);
-
- /* right */
- sr.size.height = r.size.height;
- sr.origin.y = r.origin.y;
- sr.size.width = vthickness;
- sr.origin.x += r.size.width - vthickness;
- if (right_p) NSRectFill (sr);
+ if (bottom_p || right_p)
+ {
+ NSBezierPath *p = [NSBezierPath bezierPath];
+ [p moveToPoint:NSMakePoint (NSMaxX (outer), NSMaxY (outer))];
+ if (right_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMaxX (outer), NSMinY (outer))];
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMinY (inner))];
+ }
+ [p lineToPoint:NSMakePoint (NSMaxX (inner), NSMaxY (inner))];
+ if (bottom_p)
+ {
+ [p lineToPoint:NSMakePoint (NSMinX (inner), NSMaxY (inner))];
+ [p lineToPoint:NSMakePoint (NSMinX (outer), NSMaxY (outer))];
+ }
+ [p closePath];
+ [p fill];
+ }
}
@@ -5272,8 +4975,8 @@ static struct redisplay_interface ns_redisplay_interface =
gui_get_glyph_overhangs,
gui_fix_overlapping_area,
ns_draw_fringe_bitmap,
- 0, /* define_fringe_bitmap */ /* FIXME: simplify ns_draw_fringe_bitmap */
- 0, /* destroy_fringe_bitmap */
+ ns_define_fringe_bitmap,
+ ns_destroy_fringe_bitmap,
ns_compute_glyph_string_overhangs,
ns_draw_glyph_string,
ns_define_frame_cursor,
@@ -5459,6 +5162,8 @@ ns_term_init (Lisp_Object display_name)
terminal->name = xlispstrdup (display_name);
+ gui_init_fringe (terminal->rif);
+
unblock_input ();
if (!inhibit_x_resources)
@@ -6300,11 +6005,6 @@ not_in_argv (NSString *arg)
name:NSViewFrameDidChangeNotification
object:nil];
-#ifdef NS_DRAW_TO_BUFFER
- [surface release];
-#endif
-
- [toolbar release];
if (fs_state == FULLSCREEN_BOTH)
[nonfs_window release];
[super dealloc];
@@ -6393,9 +6093,7 @@ not_in_argv (NSString *arg)
NSTRACE ("[EmacsView keyDown:]");
/* Rhapsody and macOS give up and down events for the arrow keys. */
- if (ns_fake_keydown == YES)
- ns_fake_keydown = NO;
- else if ([theEvent type] != NSEventTypeKeyDown)
+ if ([theEvent type] != NSEventTypeKeyDown)
return;
if (!emacs_event)
@@ -7252,43 +6950,6 @@ not_in_argv (NSString *arg)
}
-- (void)windowDidResize: (NSNotification *)notification
-{
- NSTRACE ("[EmacsView windowDidResize:]");
- if (!FRAME_LIVE_P (emacsframe))
- {
- NSTRACE_MSG ("Ignored (frame dead)");
- return;
- }
- if (emacsframe->output_data.ns->in_animation)
- {
- NSTRACE_MSG ("Ignored (in animation)");
- return;
- }
-
- if (! [self fsIsNative])
- {
- NSWindow *theWindow = [notification object];
- /* We can get notification on the non-FS window when in
- fullscreen mode. */
- if ([self window] != theWindow) return;
- }
-
- NSTRACE_RECT ("frame", [[notification object] frame]);
-
-#ifdef NS_IMPL_GNUSTEP
- NSWindow *theWindow = [notification object];
-
- /* In GNUstep, at least currently, it's possible to get a didResize
- without getting a willResize, therefore we need to act as if we got
- the willResize now. */
- NSSize sz = [theWindow frame].size;
- sz = [self windowWillResize: theWindow toSize: sz];
-#endif /* NS_IMPL_GNUSTEP */
-
- ns_send_appdefined (-1);
-}
-
#ifdef NS_IMPL_COCOA
- (void)viewDidEndLiveResize
{
@@ -7306,53 +6967,30 @@ not_in_argv (NSString *arg)
#endif /* NS_IMPL_COCOA */
-- (void)viewDidResize:(NSNotification *)notification
+- (void)resizeWithOldSuperviewSize: (NSSize)oldSize
{
- NSRect frame = [self frame];
- int neww, newh;
-
- if (! FRAME_LIVE_P (emacsframe))
- return;
+ NSRect frame;
+ int width, height;
- NSTRACE ("[EmacsView viewDidResize]");
+ NSTRACE ("[EmacsView resizeWithOldSuperviewSize:]");
- neww = (int)NSWidth (frame);
- newh = (int)NSHeight (frame);
- NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
+ [super resizeWithOldSuperviewSize:oldSize];
-#ifdef NS_DRAW_TO_BUFFER
- if ([self wantsUpdateLayer])
- {
- CGFloat scale = [[self window] backingScaleFactor];
- NSSize size = [surface getSize];
- int oldw = size.width / scale;
- int oldh = size.height / scale;
-
- NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
+ if (! FRAME_LIVE_P (emacsframe))
+ return;
- /* Don't want to do anything when the view size hasn't changed. */
- if ((oldh == newh && oldw == neww))
- {
- NSTRACE_MSG ("No change");
- return;
- }
+ frame = [self frame];
+ width = (int)NSWidth (frame);
+ height = (int)NSHeight (frame);
- [surface release];
- surface = nil;
- }
-#endif
+ NSTRACE_SIZE ("New size", NSMakeSize (width, height));
+ NSTRACE_SIZE ("Original size", size);
- /* I'm not sure if it's safe to call this every time the view
- changes size, as Emacs may already know about the change.
- Unfortunately there doesn't seem to be a bullet-proof method of
- determining whether we need to call it or not. */
- change_frame_size (emacsframe,
- FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww),
- FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh),
- 0, YES, 0, 1);
+ change_frame_size (emacsframe, width, height, false, YES, false);
SET_FRAME_GARBAGED (emacsframe);
cancel_mouse_face (emacsframe);
+ ns_send_appdefined (-1);
}
@@ -7447,42 +7085,8 @@ not_in_argv (NSString *arg)
}
-- (void)createToolbar: (struct frame *)f
-{
- EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
- NSWindow *window = [view window];
-
- toolbar = [[EmacsToolbar alloc] initForView: self withIdentifier:
- [NSString stringWithFormat: @"Emacs Frame %d",
- ns_window_num]];
- [toolbar setVisible: NO];
- [window setToolbar: toolbar];
-
- /* Don't set frame garbaged until tool bar is up to date?
- This avoids an extra clear and redraw (flicker) at frame creation. */
- if (FRAME_EXTERNAL_TOOL_BAR (f)) wait_for_tool_bar = YES;
- else wait_for_tool_bar = NO;
-
-
-#ifdef NS_IMPL_COCOA
- {
- NSButton *toggleButton;
- toggleButton = [window standardWindowButton: NSWindowToolbarButton];
- [toggleButton setTarget: self];
- [toggleButton setAction: @selector (toggleToolbar: )];
- }
-#endif
-}
-
-
- (instancetype) initFrameFromEmacs: (struct frame *)f
{
- NSRect r, wr;
- Lisp_Object tem;
- EmacsWindow *win;
- NSColor *col;
- NSString *name;
-
NSTRACE ("[EmacsView initFrameFromEmacs:]");
NSTRACE_MSG ("cols:%d lines:%d", f->text_cols, f->text_lines);
@@ -7499,15 +7103,14 @@ not_in_argv (NSString *arg)
#endif
fs_is_native = ns_use_native_fullscreen;
#endif
- in_fullscreen_transition = NO;
maximized_width = maximized_height = -1;
nonfs_window = nil;
ns_userRect = NSMakeRect (0, 0, 0, 0);
- r = NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
- FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines));
- [self initWithFrame: r];
+ [self initWithFrame:
+ NSMakeRect (0, 0, FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines))];
[self setAutoresizingMask: NSViewWidthSizable | NSViewHeightSizable];
FRAME_NS_VIEW (f) = self;
@@ -7517,100 +7120,22 @@ not_in_argv (NSString *arg)
maximizing_resize = NO;
#endif
- win = [[EmacsWindow alloc]
- initWithContentRect: r
- styleMask: (FRAME_UNDECORATED (f)
- ? FRAME_UNDECORATED_FLAGS
- : FRAME_DECORATED_FLAGS)
- backing: NSBackingStoreBuffered
- defer: YES];
+ [[EmacsWindow alloc] initWithEmacsFrame:f];
-#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
- if (FRAME_PARENT_FRAME (f))
- [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenAuxiliary];
- else
- [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
-#endif
-
- wr = [win frame];
- bwidth = f->border_width = wr.size.width - r.size.width;
-
- [win setAcceptsMouseMovedEvents: YES];
- [win setDelegate: self];
-#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];
+#ifdef NS_IMPL_COCOA
+ /* These settings mean AppKit will retain the contents of the frame
+ on resize. Unfortunately it also means the frame will not be
+ automatically marked for display, but we can do that ourselves in
+ resizeWithOldSuperviewSize. */
+ [self setWantsLayer:YES];
+ [self setLayerContentsRedrawPolicy:
+ NSViewLayerContentsRedrawOnSetNeedsDisplay];
+ [self setLayerContentsPlacement:NSViewLayerContentsPlacementTopLeft];
#endif
- [[win contentView] addSubview: self];
-
if (ns_drag_types)
[self registerForDraggedTypes: ns_drag_types];
- tem = f->name;
- name = NILP (tem) ? @"Emacs" : [NSString stringWithLispString:tem];
- [win setTitle: name];
-
- /* toolbar support */
- if (! FRAME_UNDECORATED (f))
- [self createToolbar: f];
-
-
- [win setAppearance];
-
-#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:
- [NSString stringWithLispString:tem]];
-
- if (FRAME_PARENT_FRAME (f) != NULL)
- {
- NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
- [parent addChildWindow: win
- ordered: NSWindowAbove];
- }
-
- if (FRAME_Z_GROUP (f) != z_group_none)
- win.level = NSNormalWindowLevel
- + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1);
-
- {
- NSScreen *screen = [win screen];
-
- if (screen != 0)
- {
- NSPoint pt = NSMakePoint
- (IN_BOUND (-SCREENMAX, f->left_pos
- + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX),
- IN_BOUND (-SCREENMAX,
- NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos,
- SCREENMAX));
-
- [win setFrameTopLeftPoint: pt];
-
- NSTRACE_RECT ("new frame", [win frame]);
- }
- }
-
- [win makeFirstResponder: self];
-
- col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
- (FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID)),
- emacsframe);
- [win setBackgroundColor: col];
- if ([col alphaComponent] != (EmacsCGFloat) 1.0)
- [win setOpaque: NO];
-
#if !defined (NS_IMPL_COCOA) \
|| MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
@@ -7621,21 +7146,6 @@ not_in_argv (NSString *arg)
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
- /* Set up view resize notifications. */
- [self setPostsFrameChangedNotifications:YES];
- [[NSNotificationCenter defaultCenter]
- addObserver:self
- selector:@selector (viewDidResize:)
- name:NSViewFrameDidChangeNotification object:nil];
-
- /* 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. */
-#ifdef NS_IMPL_COCOA
- if ([win respondsToSelector: @selector(setTabbingMode:)])
- [win setTabbingMode: NSWindowTabbingModeDisallowed];
-#endif
-
ns_window_num++;
return self;
}
@@ -7862,7 +7372,6 @@ not_in_argv (NSString *arg)
- (void)windowWillEnterFullScreen:(NSNotification *)notification
{
NSTRACE ("[EmacsView windowWillEnterFullScreen:]");
- in_fullscreen_transition = YES;
[self windowWillEnterFullScreen];
}
- (void)windowWillEnterFullScreen /* provided for direct calls */
@@ -7875,7 +7384,6 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView windowDidEnterFullScreen:]");
[self windowDidEnterFullScreen];
- in_fullscreen_transition = NO;
}
- (void)windowDidEnterFullScreen /* provided for direct calls */
@@ -7907,14 +7415,13 @@ not_in_argv (NSString *arg)
[NSApp setPresentationOptions: options];
}
#endif
- [toolbar setVisible:tbar_visible];
+ [[[self window]toolbar] setVisible:tbar_visible];
}
}
- (void)windowWillExitFullScreen:(NSNotification *)notification
{
NSTRACE ("[EmacsView windowWillExitFullScreen:]");
- in_fullscreen_transition = YES;
[self windowWillExitFullScreen];
}
@@ -7934,7 +7441,6 @@ not_in_argv (NSString *arg)
{
NSTRACE ("[EmacsView windowDidExitFullScreen:]");
[self windowDidExitFullScreen];
- in_fullscreen_transition = NO;
}
- (void)windowDidExitFullScreen /* provided for direct calls */
@@ -7952,33 +7458,17 @@ not_in_argv (NSString *arg)
#endif
if (FRAME_EXTERNAL_TOOL_BAR (emacsframe))
{
- [toolbar setVisible:YES];
+ [[[self window] toolbar] setVisible:YES];
update_frame_tool_bar (emacsframe);
[[self window] display];
}
else
- [toolbar setVisible:NO];
+ [[[self window] toolbar] setVisible:NO];
if (next_maximized != -1)
[[self window] performZoom:self];
}
-- (BOOL)inFullScreenTransition
-{
- return in_fullscreen_transition;
-}
-
-- (void)waitFullScreenTransition
-{
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- while ([self inFullScreenTransition])
- {
- NSTRACE ("wait for fullscreen");
- wait_reading_process_output (0, 300000000, 0, 1, Qnil, NULL, 0);
- }
-#endif
-}
-
- (BOOL)fsIsNative
{
return fs_is_native;
@@ -8018,7 +7508,7 @@ not_in_argv (NSString *arg)
NSWindowCollectionBehavior b = [win collectionBehavior];
if (ns_use_native_fullscreen)
{
- if ([win parentWindow])
+ if (FRAME_PARENT_FRAME (emacsframe))
{
b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
b |= NSWindowCollectionBehaviorFullScreenAuxiliary;
@@ -8045,7 +7535,7 @@ not_in_argv (NSString *arg)
- (void)toggleFullScreen: (id)sender
{
- NSWindow *w, *fw;
+ EmacsWindow *w, *fw;
BOOL onFirstScreen;
struct frame *f;
NSRect r, wr;
@@ -8058,19 +7548,13 @@ not_in_argv (NSString *arg)
#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];
- // wait for fullscreen animation complete (bug#28496)
- [self waitFullScreenTransition];
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
- }
#endif
+ [[self window] toggleFullScreen:sender];
#endif
return;
}
- w = [self window];
+ w = (EmacsWindow *)[self window];
onFirstScreen = [[w screen] isEqual:[[NSScreen screens] objectAtIndex:0]];
f = emacsframe;
wr = [w frame];
@@ -8105,27 +7589,9 @@ not_in_argv (NSString *arg)
#endif
}
- fw = [[EmacsFSWindow alloc]
- initWithContentRect:[w contentRectForFrameRect:wr]
- styleMask:NSWindowStyleMaskBorderless
- backing:NSBackingStoreBuffered
- defer:YES
- screen:screen];
-
- [fw setContentView:[w contentView]];
- [fw setTitle:[w title]];
- [fw setDelegate:self];
- [fw setAcceptsMouseMovedEvents: 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)
- [fw setOpaque: NO];
+ fw = [[EmacsWindow alloc] initWithEmacsFrame:emacsframe
+ fullscreen:YES
+ screen:screen];
f->border_width = 0;
@@ -8133,7 +7599,6 @@ not_in_argv (NSString *arg)
[self windowWillEnterFullScreen];
[fw makeKeyAndOrderFront:NSApp];
- [fw makeFirstResponder:self];
[w orderOut:self];
r = [fw frameRectForContentRect:[screen frame]];
[fw setFrame: r display:YES animate:ns_use_fullscreen_animation];
@@ -8160,7 +7625,7 @@ not_in_argv (NSString *arg)
if ([col alphaComponent] != (EmacsCGFloat) 1.0)
[w setOpaque: NO];
- f->border_width = bwidth;
+ f->border_width = [w borderWidth];
// To do: consider using [NSNotificationCenter postNotificationName:] to
// send notifications.
@@ -8297,12 +7762,6 @@ not_in_argv (NSString *arg)
}
-- (EmacsToolbar *)toolbar
-{
- return toolbar;
-}
-
-
/* This gets called on toolbar button click. */
- (instancetype)toolbarClicked: (id)item
{
@@ -8339,42 +7798,54 @@ not_in_argv (NSString *arg)
}
-#ifdef NS_DRAW_TO_BUFFER
-- (void)focusOnDrawingBuffer
+#ifdef NS_IMPL_COCOA
+- (CALayer *)makeBackingLayer;
{
- CGFloat scale = [[self window] backingScaleFactor];
+ EmacsLayer *l = [[EmacsLayer alloc]
+ initWithColorSpace:[[[self window] colorSpace] CGColorSpace]];
+ [l setDelegate:(id)self];
+ [l setContentsScale:[[self window] backingScaleFactor]];
- NSTRACE ("[EmacsView focusOnDrawingBuffer]");
+ return l;
+}
- if (! surface)
- {
- NSRect frame = [self frame];
- NSSize s = NSMakeSize (NSWidth (frame) * scale, NSHeight (frame) * scale);
- surface = [[EmacsSurface alloc] initWithSize:s
- ColorSpace:[[[self window] colorSpace]
- CGColorSpace]];
- }
-
- CGContextRef context = [surface getContext];
+- (void)lockFocus
+{
+ NSTRACE ("[EmacsView lockFocus]");
- CGContextTranslateCTM(context, 0, [surface getSize].height);
- CGContextScaleCTM(context, scale, -scale);
+ if ([self wantsLayer])
+ {
+ CGContextRef context = [(EmacsLayer*)[self layer] getContext];
- [NSGraphicsContext
- setCurrentContext:[NSGraphicsContext
- graphicsContextWithCGContext:context
- flipped:YES]];
+ [NSGraphicsContext
+ setCurrentContext:[NSGraphicsContext
+ graphicsContextWithCGContext:context
+ flipped:YES]];
+ }
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ else
+ [super lockFocus];
+#endif
}
-- (void)unfocusDrawingBuffer
+- (void)unlockFocus
{
- NSTRACE ("[EmacsView unfocusDrawingBuffer]");
+ NSTRACE ("[EmacsView unlockFocus]");
- [NSGraphicsContext setCurrentContext:nil];
- [surface releaseContext];
- [self setNeedsDisplay:YES];
+ if ([self wantsLayer])
+ {
+ [NSGraphicsContext setCurrentContext:nil];
+ [self setNeedsDisplay:YES];
+ }
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ else
+ {
+ [super unlockFocus];
+ [super flushWindow];
+ }
+#endif
}
@@ -8383,15 +7854,19 @@ not_in_argv (NSString *arg)
{
NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
- NSRect frame = [self frame];
+ if ([self wantsLayer])
+ {
+ NSRect frame = [self frame];
+ EmacsLayer *layer = (EmacsLayer *)[self layer];
- [surface release];
- surface = nil;
+ [layer setContentsScale:[[notification object] backingScaleFactor]];
+ [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]];
- ns_clear_frame (emacsframe);
- expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
+ ns_clear_frame (emacsframe);
+ expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
+ }
}
-#endif /* NS_DRAW_TO_BUFFER */
+#endif /* NS_IMPL_COCOA */
- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect
@@ -8400,11 +7875,9 @@ not_in_argv (NSString *arg)
NSTRACE_RECT ("Source", srcRect);
NSTRACE_RECT ("Destination", dstRect);
-#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if ([self wantsUpdateLayer])
+#ifdef NS_IMPL_COCOA
+ if ([self wantsLayer])
{
-#endif
double scale = [[self window] backingScaleFactor];
CGContextRef context = [[NSGraphicsContext currentContext] CGContext];
int bpp = CGBitmapContextGetBitsPerPixel (context) / 8;
@@ -8430,14 +7903,14 @@ not_in_argv (NSString *arg)
(char *) srcPixels + y * rowSize,
srcRowSize);
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
else
{
#endif
-#endif /* NS_DRAW_TO_BUFFER */
+#endif /* NS_IMPL_COCOA */
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
hide_bell(); // Ensure the bell image isn't scrolled.
ns_focus (emacsframe, &dstRect, 1);
@@ -8446,39 +7919,44 @@ not_in_argv (NSString *arg)
dstRect.origin.y - srcRect.origin.y)];
ns_unfocus (emacsframe);
#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
#endif
}
-#ifdef NS_DRAW_TO_BUFFER
-- (BOOL)wantsUpdateLayer
-{
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- if (NSAppKitVersionNumber < 1671)
- return NO;
-#endif
-
- /* Running on macOS 10.14 or above. */
- return YES;
-}
-
+#ifdef NS_IMPL_COCOA
+/* If the frame has been garbaged but the toolkit wants to draw, for
+ example when resizing the frame, we end up with a blank screen.
+ Sometimes this results in an unpleasant flicker, so try to
+ redisplay before drawing.
+
+ This used to be done in viewWillDraw, but with the custom layer
+ that method is not called. We cannot call redisplay directly from
+ [NSView layout], because it may trigger another round of layout by
+ changing the frame size and recursive layout calls are banned. It
+ appears to be safe to call redisplay here. */
+- (void)layoutSublayersOfLayer:(CALayer *)layer
+{
+ if (!redisplaying_p && FRAME_GARBAGED_P (emacsframe))
+ {
+ /* If there is IO going on when redisplay is run here Emacs
+ crashes. I think it's because this code will always be run
+ within the run loop and for whatever reason processing input
+ is dangerous. This technique was stolen wholesale from
+ nsmenu.m and seems to work. */
+ bool owfi = waiting_for_input;
+ waiting_for_input = 0;
+ block_input ();
-- (void)updateLayer
-{
- NSTRACE ("[EmacsView updateLayer]");
+ redisplay ();
- /* This can fail to update the screen if the same surface is
- provided twice in a row, even if its contents have changed.
- There's a private method, -[CALayer setContentsChanged], that we
- could use to force it, but we shouldn't often get the same
- surface twice in a row. */
- [[self layer] setContents:(id)[surface getSurface]];
+ unblock_input ();
+ waiting_for_input = owfi;
+ }
}
#endif
-
- (void)drawRect: (NSRect)rect
{
NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]",
@@ -8722,6 +8200,242 @@ not_in_argv (NSString *arg)
@implementation EmacsWindow
+
+- (instancetype) initWithEmacsFrame:(struct frame *)f
+{
+ return [self initWithEmacsFrame:f fullscreen:NO screen:nil];
+}
+
+
+- (instancetype) initWithEmacsFrame:(struct frame *)f
+ fullscreen:(BOOL)fullscreen
+ screen:(NSScreen *)screen
+{
+ NSWindowStyleMask styleMask;
+
+ NSTRACE ("[EmacsWindow initWithEmacsFrame:fullscreen:screen:]");
+
+ if (fullscreen)
+ styleMask = NSWindowStyleMaskBorderless;
+ else if (FRAME_UNDECORATED (f))
+ styleMask = FRAME_UNDECORATED_FLAGS;
+ else
+ styleMask = FRAME_DECORATED_FLAGS;
+
+
+ self = [super initWithContentRect:
+ NSMakeRect (0, 0,
+ FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, f->text_cols),
+ FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, f->text_lines))
+ styleMask:styleMask
+ backing:NSBackingStoreBuffered
+ defer:YES
+ screen:screen];
+ if (self)
+ {
+ NSString *name;
+ NSColor *col;
+ NSScreen *screen = [self screen];
+ EmacsView *view = FRAME_NS_VIEW (f);
+
+ [self setDelegate:view];
+ [[self contentView] addSubview:view];
+ [self makeFirstResponder:view];
+
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
+ if ([self respondsToSelector: @selector(useOptimizedDrawing:)])
+#endif
+ [self useOptimizedDrawing:YES];
+#endif
+
+ [self setAcceptsMouseMovedEvents:YES];
+
+ name = NILP (f->name) ? @"Emacs" : [NSString stringWithLispString:f->name];
+ [self setTitle:name];
+
+ if (!NILP (f->icon_name))
+ [self setMiniwindowTitle:
+ [NSString stringWithLispString:f->icon_name]];
+
+ [self setAppearance];
+
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ if ([self respondsToSelector:@selector(titlebarAppearsTransparent)])
+ [self setTitlebarAppearsTransparent:FRAME_NS_TRANSPARENT_TITLEBAR (f)];
+#endif
+
+ [self setParentChildRelationships];
+
+ if (FRAME_Z_GROUP (f) != z_group_none)
+ [self setLevel:NSNormalWindowLevel + (FRAME_Z_GROUP_BELOW (f) ? -1 : 1)];
+
+ if (screen != 0)
+ {
+ NSPoint pt = NSMakePoint
+ (IN_BOUND (-SCREENMAX, f->left_pos
+ + NS_PARENT_WINDOW_LEFT_POS (f), SCREENMAX),
+ IN_BOUND (-SCREENMAX,
+ NS_PARENT_WINDOW_TOP_POS (f) - f->top_pos,
+ SCREENMAX));
+
+ [self setFrameTopLeftPoint:pt];
+
+ NSTRACE_RECT ("new frame", [self frame]);
+ }
+
+ f->border_width = [self borderWidth];
+
+ col = ns_lookup_indexed_color (NS_FACE_BACKGROUND
+ (FACE_FROM_ID (f, DEFAULT_FACE_ID)),
+ f);
+ [self setBackgroundColor:col];
+ if ([col alphaComponent] != (EmacsCGFloat) 1.0)
+ [self setOpaque:NO];
+
+ /* toolbar support */
+ if (! FRAME_UNDECORATED (f))
+ [self createToolbar:f];
+
+ /* 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. */
+#ifdef NS_IMPL_COCOA
+ if ([self respondsToSelector:@selector(setTabbingMode:)])
+ [self setTabbingMode:NSWindowTabbingModeDisallowed];
+#endif
+ }
+
+ return self;
+}
+
+
+- (void)createToolbar: (struct frame *)f
+{
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+
+ EmacsToolbar *toolbar = [[EmacsToolbar alloc]
+ initForView:view
+ withIdentifier:[NSString stringWithLispString:f->name]];
+ [self setToolbar:toolbar];
+
+ update_frame_tool_bar (f);
+
+#ifdef NS_IMPL_COCOA
+ {
+ NSButton *toggleButton;
+ toggleButton = [self standardWindowButton:NSWindowToolbarButton];
+ [toggleButton setTarget:view];
+ [toggleButton setAction:@selector (toggleToolbar:)];
+ }
+#endif
+}
+
+- (void)dealloc
+{
+ NSTRACE ("[EmacsWindow dealloc]");
+
+ /* We need to release the toolbar ourselves. */
+ [[self toolbar] release];
+ [super dealloc];
+}
+
+- (NSInteger) borderWidth
+{
+ return NSWidth ([self frame]) - NSWidth ([[self contentView] frame]);
+}
+
+
+- (void)setParentChildRelationships
+ /* After certain operations, for example making a frame visible or
+ resetting the NSWindow through modifying the undecorated status,
+ the parent/child relationship may be broken. We can also use
+ this method to set them, as long as the frame struct already has
+ the correct relationship set. */
+{
+ NSTRACE ("[EmacsWindow setParentChildRelationships]");
+
+ Lisp_Object frame, tail;
+ EmacsView *ourView = (EmacsView *)[self delegate];
+ struct frame *ourFrame = ourView->emacsframe;
+ struct frame *parentFrame = FRAME_PARENT_FRAME (ourFrame);
+ EmacsWindow *oldParentWindow = (EmacsWindow *)[self parentWindow];
+
+
+#ifdef NS_IMPL_COCOA
+ /* We have to set the accesibility subroles and/or the collection
+ behaviors early otherwise child windows may not go fullscreen as
+ expected later. */
+
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101000
+ if ([child respondsToSelector:@selector(setAccessibilitySubrole:)])
+#endif
+ /* Set the accessibilty subroles. */
+ if (parentFrame)
+ [self setAccessibilitySubrole:NSAccessibilityFloatingWindowSubrole];
+ else
+ [self setAccessibilitySubrole:NSAccessibilityStandardWindowSubrole];
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ [ourView updateCollectionBehavior];
+#endif
+#endif
+
+
+ /* Check if we have an incorrectly set parent. */
+ if ((! parentFrame && oldParentWindow)
+ || (parentFrame && oldParentWindow
+ && ((EmacsView *)[oldParentWindow delegate])->emacsframe != parentFrame))
+ {
+ [[self parentWindow] removeChildWindow:self];
+
+#ifdef NS_IMPL_COCOA
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([ourView respondsToSelector:@selector (toggleFullScreen)]
+#endif
+ /* If we are the descendent of a fullscreen window and we
+ have no new parent, go fullscreen. */
+ {
+ NSWindow *parent = (NSWindow *)oldParentWindow;
+ while (parent)
+ {
+ if (([parent styleMask] & NSWindowStyleMaskFullScreen) != 0)
+ {
+ [ourView toggleFullScreen:self];
+ break;
+ }
+ parent = [parent parentWindow];
+ }
+ }
+#endif
+ }
+
+ if (parentFrame)
+ {
+ NSWindow *parentWindow = [FRAME_NS_VIEW (parentFrame) window];
+
+#ifdef NS_IMPL_COCOA
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([ourView respondsToSelector:@selector (toggleFullScreen)]
+#endif
+ /* Child frames must not be fullscreen. */
+ if ([ourView fsIsNative] && [ourView isFullscreen])
+ [ourView toggleFullScreen:self];
+#endif
+
+ [parentWindow addChildWindow:self
+ ordered:NSWindowAbove];
+ }
+
+ /* Check our child windows are configured correctly. */
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_PARENT_FRAME (XFRAME (frame)) == ourFrame)
+ [(EmacsWindow *)[FRAME_NS_VIEW (XFRAME (frame)) window] setParentChildRelationships];
+ }
+}
+
+
/* It seems the only way to reorder child frames is by removing them
from the parent and then reattaching them in the correct order. */
@@ -8753,6 +8467,16 @@ not_in_argv (NSString *arg)
}
+#ifdef NS_IMPL_GNUSTEP
+/* orderedIndex isn't yet available in GNUstep, but it seems pretty
+ easy to implement. */
+- (NSInteger) orderedIndex
+{
+ return [[NSApp orderedWindows] indexOfObjectIdenticalTo:self];
+}
+#endif
+
+
/* The array returned by [NSWindow parentWindow] may already be
sorted, but the documentation doesn't tell us whether or not it is,
so to be safe we'll sort it. */
@@ -9121,22 +8845,15 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
{
return !FRAME_NO_ACCEPT_FOCUS (((EmacsView *)[self delegate])->emacsframe);
}
-@end /* EmacsWindow */
-
-
-@implementation EmacsFSWindow
-
-- (BOOL)canBecomeKeyWindow
-{
- return YES;
-}
- (BOOL)canBecomeMainWindow
+ /* Required for fullscreen and undecorated windows. */
{
return YES;
}
-@end
+@end /* EmacsWindow */
+
/* ==========================================================================
@@ -9635,7 +9352,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
@end /* EmacsScroller */
-#ifdef NS_DRAW_TO_BUFFER
+#ifdef NS_IMPL_COCOA
/* ==========================================================================
@@ -9643,7 +9360,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
========================================================================== */
-@implementation EmacsSurface
+@implementation EmacsLayer
/* An IOSurface is a pixel buffer that is efficiently copied to VRAM
@@ -9656,116 +9373,159 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
ability to draw to the screen at any time, we need to keep a cache
of multiple surfaces that we can use at will.
- The EmacsSurface class maintains this cache of surfaces, and
+ The EmacsLayer class maintains this cache of surfaces, and
handles the conversion to a CGGraphicsContext that AppKit can use
to draw on.
The cache is simple: if a free surface is found it is removed from
- the cache and set as the "current" surface. Once Emacs is done
- with drawing to the current surface, the previous surface that was
- drawn to is added to the cache for reuse, and the current one is
- set as the last surface. If no free surfaces are found in the
- cache then a new one is created.
+ the cache and set as the "current" surface. Emacs draws to the
+ surface and when the layer wants to update the screen we set it's
+ contents to the surface and then add it back on to the end of the
+ cache. If no free surfaces are found in the cache then a new one
+ is created. */
- When AppKit wants to update the screen, we provide it with the last
- surface, as that has the most recent data.
+#define CACHE_MAX_SIZE 2
- FIXME: It is possible for the cache to grow if Emacs draws faster
- than the surfaces can be drawn to the screen, so there should
- probably be some sort of pruning job that removes excess
- surfaces. */
+- (id) initWithColorSpace: (CGColorSpaceRef)cs
+{
+ NSTRACE ("[EmacsLayer initWithColorSpace:]");
+ self = [super init];
+ if (self)
+ {
+ cache = [[NSMutableArray arrayWithCapacity:CACHE_MAX_SIZE] retain];
+ colorSpace = cs;
+ }
+ else
+ {
+ return nil;
+ }
-- (id) initWithSize: (NSSize)s
- ColorSpace: (CGColorSpaceRef)cs
-{
- NSTRACE ("[EmacsSurface initWithSize:ColorSpace:]");
+ return self;
+}
- [super init];
- cache = [[NSMutableArray arrayWithCapacity:3] retain];
- size = s;
+- (void) setColorSpace: (CGColorSpaceRef)cs
+{
+ /* We don't need to clear the cache because the new colorspace will
+ be used next time we create a new context. */
colorSpace = cs;
-
- return self;
}
- (void) dealloc
{
- if (context)
- CGContextRelease (context);
+ [self releaseSurfaces];
+ [cache release];
- if (currentSurface)
- CFRelease (currentSurface);
- if (lastSurface)
- CFRelease (lastSurface);
+ [super dealloc];
+}
- for (id object in cache)
- CFRelease ((IOSurfaceRef)object);
- [cache removeAllObjects];
+- (void) releaseSurfaces
+{
+ [self setContents:nil];
+ [self releaseContext];
- [super dealloc];
+ if (currentSurface)
+ {
+ CFRelease (currentSurface);
+ currentSurface = nil;
+ }
+
+ if (cache)
+ {
+ for (id object in cache)
+ CFRelease ((IOSurfaceRef)object);
+
+ [cache removeAllObjects];
+ }
}
-/* Return the size values our cached data is using. */
-- (NSSize) getSize
+/* Check whether the current bounds match the IOSurfaces we are using.
+ If they do return YES, otherwise NO. */
+- (BOOL) checkDimensions
{
- return size;
+ int width = NSWidth ([self bounds]) * [self contentsScale];
+ int height = NSHeight ([self bounds]) * [self contentsScale];
+ IOSurfaceRef s = currentSurface ? currentSurface
+ : (IOSurfaceRef)[cache firstObject];
+
+ return !s || (IOSurfaceGetWidth (s) == width
+ && IOSurfaceGetHeight (s) == height);
}
-/* Return a CGContextRef that can be used for drawing to the screen.
- This must ALWAYS be paired with a call to releaseContext, and the
- calls cannot be nested. */
+/* Return a CGContextRef that can be used for drawing to the screen. */
- (CGContextRef) getContext
{
- IOSurfaceRef surface = NULL;
+ CGFloat scale = [self contentsScale];
- NSTRACE ("[EmacsSurface getContextWithSize:]");
- NSTRACE_MSG (@"IOSurface count: %lu", [cache count] + (lastSurface ? 1 : 0));
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer getContext]");
+ NSTRACE_MSG ("IOSurface count: %lu", [cache count] + (currentSurface ? 1 : 0));
- for (id object in cache)
- {
- if (!IOSurfaceIsInUse ((IOSurfaceRef)object))
- {
- surface = (IOSurfaceRef)object;
- [cache removeObject:object];
- break;
- }
- }
+ if (![self checkDimensions])
+ [self releaseSurfaces];
- if (!surface)
+ if (!context)
{
- int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow,
- size.width * 4);
+ IOSurfaceRef surface = NULL;
+ int width = NSWidth ([self bounds]) * scale;
+ int height = NSHeight ([self bounds]) * scale;
- surface = IOSurfaceCreate
- ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:size.width],
- (id)kIOSurfaceHeight:[NSNumber numberWithInt:size.height],
- (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow],
- (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4],
- (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']});
- }
+ for (id object in cache)
+ {
+ if (!IOSurfaceIsInUse ((IOSurfaceRef)object))
+ {
+ surface = (IOSurfaceRef)object;
+ [cache removeObject:object];
+ break;
+ }
+ }
- IOReturn lockStatus = IOSurfaceLock (surface, 0, nil);
- if (lockStatus != kIOReturnSuccess)
- NSLog (@"Failed to lock surface: %x", lockStatus);
+ if (!surface && [cache count] >= CACHE_MAX_SIZE)
+ {
+ /* Just grab the first one off the cache. This may result
+ in tearing effects. The alternative is to wait for one
+ of the surfaces to become free. */
+ surface = (IOSurfaceRef)[cache firstObject];
+ [cache removeObject:(id)surface];
+ }
+ else if (!surface)
+ {
+ int bytesPerRow = IOSurfaceAlignProperty (kIOSurfaceBytesPerRow,
+ width * 4);
+
+ surface = IOSurfaceCreate
+ ((CFDictionaryRef)@{(id)kIOSurfaceWidth:[NSNumber numberWithInt:width],
+ (id)kIOSurfaceHeight:[NSNumber numberWithInt:height],
+ (id)kIOSurfaceBytesPerRow:[NSNumber numberWithInt:bytesPerRow],
+ (id)kIOSurfaceBytesPerElement:[NSNumber numberWithInt:4],
+ (id)kIOSurfacePixelFormat:[NSNumber numberWithUnsignedInt:'BGRA']});
+ }
- [self copyContentsTo:surface];
+ IOReturn lockStatus = IOSurfaceLock (surface, 0, nil);
+ if (lockStatus != kIOReturnSuccess)
+ NSLog (@"Failed to lock surface: %x", lockStatus);
- currentSurface = surface;
+ [self copyContentsTo:surface];
+
+ currentSurface = surface;
+
+ context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface),
+ IOSurfaceGetWidth (currentSurface),
+ IOSurfaceGetHeight (currentSurface),
+ 8,
+ IOSurfaceGetBytesPerRow (currentSurface),
+ colorSpace,
+ (kCGImageAlphaPremultipliedFirst
+ | kCGBitmapByteOrder32Host));
+
+ CGContextTranslateCTM(context, 0, IOSurfaceGetHeight (currentSurface));
+ CGContextScaleCTM(context, scale, -scale);
+ }
- context = CGBitmapContextCreate (IOSurfaceGetBaseAddress (currentSurface),
- IOSurfaceGetWidth (currentSurface),
- IOSurfaceGetHeight (currentSurface),
- 8,
- IOSurfaceGetBytesPerRow (currentSurface),
- colorSpace,
- (kCGImageAlphaPremultipliedFirst
- | kCGBitmapByteOrder32Host));
return context;
}
@@ -9774,7 +9534,10 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
IOSurface, so it will be sent to VRAM. */
- (void) releaseContext
{
- NSTRACE ("[EmacsSurface releaseContextAndGetSurface]");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer releaseContext]");
+
+ if (!context)
+ return;
CGContextRelease (context);
context = NULL;
@@ -9782,22 +9545,34 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
IOReturn lockStatus = IOSurfaceUnlock (currentSurface, 0, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to unlock surface: %x", lockStatus);
-
- /* Put lastSurface back on the end of the cache. It may not have
- been displayed on the screen yet, but we probably want the new
- data and not some stale data anyway. */
- if (lastSurface)
- [cache addObject:(id)lastSurface];
- lastSurface = currentSurface;
- currentSurface = NULL;
}
-/* Get the IOSurface that we want to draw to the screen. */
-- (IOSurfaceRef) getSurface
+- (void) display
{
- /* lastSurface always contains the most up-to-date and complete data. */
- return lastSurface;
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer display]");
+
+ if (context)
+ {
+ [self releaseContext];
+
+#if CACHE_MAX_SIZE == 1
+ /* This forces the layer to see the surface as updated. */
+ [self setContents:nil];
+#endif
+
+ [self setContents:(id)currentSurface];
+
+ /* Put currentSurface back on the end of the cache. */
+ [cache addObject:(id)currentSurface];
+ currentSurface = NULL;
+
+ /* Schedule a run of getContext so that if Emacs is idle it will
+ perform the buffer copy, etc. */
+ [self performSelectorOnMainThread:@selector (getContext)
+ withObject:nil
+ waitUntilDone:NO];
+ }
}
@@ -9807,19 +9582,20 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
- (void) copyContentsTo: (IOSurfaceRef) destination
{
IOReturn lockStatus;
+ IOSurfaceRef source = (IOSurfaceRef)[self contents];
void *sourceData, *destinationData;
int numBytes = IOSurfaceGetAllocSize (destination);
- NSTRACE ("[EmacsSurface copyContentsTo:]");
+ NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "[EmacsLayer copyContentsTo:]");
- if (! lastSurface)
+ if (!source || source == destination)
return;
- lockStatus = IOSurfaceLock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ lockStatus = IOSurfaceLock (source, kIOSurfaceLockReadOnly, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to lock source surface: %x", lockStatus);
- sourceData = IOSurfaceGetBaseAddress (lastSurface);
+ sourceData = IOSurfaceGetBaseAddress (source);
destinationData = IOSurfaceGetBaseAddress (destination);
/* Since every IOSurface should have the exact same settings, a
@@ -9827,16 +9603,17 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c)
the other. */
memcpy (destinationData, sourceData, numBytes);
- lockStatus = IOSurfaceUnlock (lastSurface, kIOSurfaceLockReadOnly, nil);
+ lockStatus = IOSurfaceUnlock (source, kIOSurfaceLockReadOnly, nil);
if (lockStatus != kIOReturnSuccess)
NSLog (@"Failed to unlock source surface: %x", lockStatus);
}
+#undef CACHE_MAX_SIZE
-@end /* EmacsSurface */
+@end /* EmacsLayer */
-#endif
+#endif /* NS_IMPL_COCOA */
#ifdef NS_IMPL_GNUSTEP
diff --git a/src/pdumper.c b/src/pdumper.c
index c1388ebbb37..7730ea3d061 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -121,6 +121,9 @@ static const char dump_magic[16] = {
static pdumper_hook dump_hooks[24];
static int nr_dump_hooks = 0;
+static pdumper_hook dump_late_hooks[24];
+static int nr_dump_late_hooks = 0;
+
static struct
{
void *mem;
@@ -162,11 +165,7 @@ ptrdiff_t_to_dump_off (ptrdiff_t value)
static int
dump_get_page_size (void)
{
-#if defined (WINDOWSNT) || defined (CYGWIN)
- return 64 * 1024; /* Worst-case allocation granularity. */
-#else
- return getpagesize ();
-#endif
+ return 64 * 1024;
}
#define dump_offsetof(type, member) \
@@ -179,6 +178,8 @@ enum dump_reloc_type
/* dump_ptr = dump_ptr + dump_base */
RELOC_DUMP_TO_DUMP_PTR_RAW,
/* dump_mpz = [rebuild bignum] */
+ RELOC_NATIVE_COMP_UNIT,
+ RELOC_NATIVE_SUBR,
RELOC_BIGNUM,
/* dump_lv = make_lisp_ptr (dump_lv + dump_base,
type - RELOC_DUMP_TO_DUMP_LV)
@@ -321,6 +322,20 @@ dump_fingerprint (char const *label,
fprintf (stderr, "%s: %.*s\n", label, hexbuf_size, hexbuf);
}
+/* To be used if some order in the relocation process has to be enforced. */
+enum reloc_phase
+ {
+ /* First to run. Place every relocation with no dependency here. */
+ EARLY_RELOCS,
+ /* Late and very late relocs are relocated at the very last after
+ all hooks has been run. All lisp machinery is at disposal
+ (memory allocation allowed too). */
+ LATE_RELOCS,
+ VERY_LATE_RELOCS,
+ /* Fake, must be last. */
+ RELOC_NUM_PHASES
+ };
+
/* Format of an Emacs dump file. All offsets are relative to
the beginning of the file. An Emacs dump file is coupled
to exactly the Emacs binary that produced it, so details of
@@ -348,7 +363,7 @@ struct dump_header
/* Relocation table for the dump file; each entry is a
struct dump_reloc. */
- struct dump_table_locator dump_relocs;
+ struct dump_table_locator dump_relocs[RELOC_NUM_PHASES];
/* "Relocation" table we abuse to hold information about the
location and type of each lisp object in the dump. We need for
@@ -429,6 +444,7 @@ enum cold_op
COLD_OP_CHARSET,
COLD_OP_BUFFER,
COLD_OP_BIGNUM,
+ COLD_OP_NATIVE_SUBR,
};
/* This structure controls what operations we perform inside
@@ -473,6 +489,10 @@ struct dump_context
{
/* Header we'll write to the dump file when done. */
struct dump_header header;
+ /* Data that will be written to the dump file. */
+ void *buf;
+ dump_off buf_size;
+ dump_off max_offset;
Lisp_Object old_purify_flag;
Lisp_Object old_post_gc_hook;
@@ -528,7 +548,7 @@ struct dump_context
Lisp_Object cold_queue;
/* Relocations in the dump. */
- Lisp_Object dump_relocs;
+ Lisp_Object dump_relocs[RELOC_NUM_PHASES];
/* Object starts. */
Lisp_Object object_starts;
@@ -581,6 +601,13 @@ static struct link_weight const
/* Dump file creation */
+static void dump_grow_buffer (struct dump_context *ctx)
+{
+ ctx->buf = xrealloc (ctx->buf, ctx->buf_size = (ctx->buf_size ?
+ (ctx->buf_size * 2)
+ : 8 * 1024 * 1024));
+}
+
static dump_off dump_object (struct dump_context *ctx, Lisp_Object object);
static dump_off dump_object_for_offset (struct dump_context *ctx,
Lisp_Object object);
@@ -747,8 +774,9 @@ dump_write (struct dump_context *ctx, const void *buf, dump_off nbyte)
eassert (nbyte == 0 || buf != NULL);
eassert (ctx->obj_offset == 0);
eassert (ctx->flags.dump_object_contents);
- if (emacs_write (ctx->fd, buf, nbyte) < nbyte)
- report_file_error ("Could not write to dump file", ctx->dump_filename);
+ while (ctx->offset + nbyte > ctx->buf_size)
+ dump_grow_buffer (ctx);
+ memcpy ((char *)ctx->buf + ctx->offset, buf, nbyte);
ctx->offset += nbyte;
}
@@ -828,10 +856,9 @@ dump_tailq_pop (struct dump_tailq *tailq)
static void
dump_seek (struct dump_context *ctx, dump_off offset)
{
+ if (ctx->max_offset < ctx->offset)
+ ctx->max_offset = ctx->offset;
eassert (ctx->obj_offset == 0);
- if (lseek (ctx->fd, offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- ctx->dump_filename);
ctx->offset = offset;
}
@@ -923,7 +950,7 @@ dump_note_reachable (struct dump_context *ctx, Lisp_Object object)
static void *
dump_object_emacs_ptr (Lisp_Object lv)
{
- if (SUBRP (lv))
+ if (SUBRP (lv) && !SUBR_NATIVE_COMPILEDP (lv))
return XSUBR (lv);
if (dump_builtin_symbol_p (lv))
return XSYMBOL (lv);
@@ -1409,7 +1436,7 @@ dump_reloc_dump_to_emacs_ptr_raw (struct dump_context *ctx,
dump_off dump_offset)
{
if (ctx->flags.dump_object_contents)
- dump_push (&ctx->dump_relocs,
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
list2 (make_fixnum (RELOC_DUMP_TO_EMACS_PTR_RAW),
dump_off_to_lisp (dump_offset)));
}
@@ -1442,7 +1469,7 @@ dump_reloc_dump_to_dump_lv (struct dump_context *ctx,
emacs_abort ();
}
- dump_push (&ctx->dump_relocs,
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
list2 (make_fixnum (reloc_type),
dump_off_to_lisp (dump_offset)));
}
@@ -1458,7 +1485,7 @@ dump_reloc_dump_to_dump_ptr_raw (struct dump_context *ctx,
dump_off dump_offset)
{
if (ctx->flags.dump_object_contents)
- dump_push (&ctx->dump_relocs,
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
list2 (make_fixnum (RELOC_DUMP_TO_DUMP_PTR_RAW),
dump_off_to_lisp (dump_offset)));
}
@@ -1491,7 +1518,7 @@ dump_reloc_dump_to_emacs_lv (struct dump_context *ctx,
emacs_abort ();
}
- dump_push (&ctx->dump_relocs,
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
list2 (make_fixnum (reloc_type),
dump_off_to_lisp (dump_offset)));
}
@@ -2204,7 +2231,7 @@ dump_bignum (struct dump_context *ctx, Lisp_Object object)
Lisp_Bignum instead of the actual mpz field so that the
relocation offset is aligned. The relocation-application
code knows to actually advance past the header. */
- dump_push (&ctx->dump_relocs,
+ dump_push (&ctx->dump_relocs[EARLY_RELOCS],
list2 (make_fixnum (RELOC_BIGNUM),
dump_off_to_lisp (bignum_offset)));
}
@@ -2692,7 +2719,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_99D642C1CB
+#if CHECK_STRUCTS && !defined HASH_buffer_F8FE65D42F
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2703,6 +2730,7 @@ dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
buffer->window_count = 0;
else
eassert (buffer->window_count == -1);
+ buffer->local_minor_modes_ = Qnil;
buffer->last_selected_window_ = Qnil;
buffer->display_count_ = make_fixnum (0);
buffer->clip_changed = 0;
@@ -2843,20 +2871,73 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v)
static dump_off
dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_594AB72B54)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_AA236F7759)
# error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h."
#endif
struct Lisp_Subr out;
dump_object_start (ctx, &out, sizeof (out));
DUMP_FIELD_COPY (&out, subr, header.size);
- dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
+ if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0]))
+ out.function.a0 = NULL;
+ else
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
DUMP_FIELD_COPY (&out, subr, min_args);
DUMP_FIELD_COPY (&out, subr, max_args);
- dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
- dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
+ if (NATIVE_COMP_FLAG && !NILP (subr->native_comp_u[0]))
+ {
+ dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
+ dump_remember_cold_op (ctx,
+ COLD_OP_NATIVE_SUBR,
+ make_lisp_ptr ((void *) subr, Lisp_Vectorlike));
+ dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL);
+ }
+ else
+ {
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
+ dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
+ }
DUMP_FIELD_COPY (&out, subr, doc);
- return dump_object_finish (ctx, &out, sizeof (out));
+ if (NATIVE_COMP_FLAG)
+ {
+ dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL);
+ if (!NILP (subr->native_comp_u[0]))
+ dump_field_fixup_later (ctx, &out, subr, &subr->native_c_name[0]);
+
+ dump_field_lv (ctx, &out, subr, &subr->lambda_list[0], WEIGHT_NORMAL);
+ dump_field_lv (ctx, &out, subr, &subr->type[0], WEIGHT_NORMAL);
+ }
+ dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out));
+ if (NATIVE_COMP_FLAG
+ && ctx->flags.dump_object_contents
+ && !NILP (subr->native_comp_u[0]))
+ /* We'll do the final addr relocation during VERY_LATE_RELOCS time
+ after the compilation units has been loaded. */
+ dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS],
+ list2 (make_fixnum (RELOC_NATIVE_SUBR),
+ dump_off_to_lisp (subr_off)));
+ return subr_off;
+}
+
+#ifdef HAVE_NATIVE_COMP
+static dump_off
+dump_native_comp_unit (struct dump_context *ctx,
+ struct Lisp_Native_Comp_Unit *comp_u)
+{
+ /* Have function documentation always lazy loaded to optimize load-time. */
+ comp_u->data_fdoc_v = Qnil;
+ START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header);
+ out->handle = NULL;
+
+ dump_off comp_u_off = finish_dump_pvec (ctx, &out->header);
+ if (ctx->flags.dump_object_contents)
+ /* We'll do the real elf load during LATE_RELOCS relocation time. */
+ dump_push (&ctx->dump_relocs[LATE_RELOCS],
+ list2 (make_fixnum (RELOC_NATIVE_COMP_UNIT),
+ dump_off_to_lisp (comp_u_off)));
+ return comp_u_off;
}
+#endif
static void
fill_pseudovec (union vectorlike_header *header, Lisp_Object item)
@@ -2882,7 +2963,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D
+#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@@ -2935,6 +3016,11 @@ dump_vectorlike (struct dump_context *ctx,
case PVEC_BIGNUM:
offset = dump_bignum (ctx, lv);
break;
+#ifdef HAVE_NATIVE_COMP
+ case PVEC_NATIVE_COMP_UNIT:
+ offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
+ break;
+#endif
case PVEC_WINDOW_CONFIGURATION:
error_unsupported_dump_object (ctx, lv, "window configuration");
case PVEC_OTHER:
@@ -3170,6 +3256,12 @@ dump_metadata_for_pdumper (struct dump_context *ctx)
(void const *) dump_hooks[i]);
dump_emacs_reloc_immediate_int (ctx, &nr_dump_hooks, nr_dump_hooks);
+ for (int i = 0; i < nr_dump_late_hooks; ++i)
+ dump_emacs_reloc_to_emacs_ptr_raw (ctx, &dump_late_hooks[i],
+ (void const *) dump_late_hooks[i]);
+ dump_emacs_reloc_immediate_int (ctx, &nr_dump_late_hooks,
+ nr_dump_late_hooks);
+
for (int i = 0; i < nr_remembered_data; ++i)
{
dump_emacs_reloc_to_emacs_ptr_raw (ctx, &remembered_data[i].mem,
@@ -3331,6 +3423,29 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
}
}
+#ifdef HAVE_NATIVE_COMP
+static void
+dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr)
+{
+ /* Dump subr contents. */
+ dump_off subr_offset = dump_recall_object (ctx, subr);
+ eassert (subr_offset > 0);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ subr_offset + dump_offsetof (struct Lisp_Subr, symbol_name),
+ ctx->offset);
+ const char *symbol_name = XSUBR (subr)->symbol_name;
+ dump_write (ctx, symbol_name, 1 + strlen (symbol_name));
+
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ subr_offset + dump_offsetof (struct Lisp_Subr, native_c_name[0]),
+ ctx->offset);
+ const char *c_name = XSUBR (subr)->native_c_name[0];
+ dump_write (ctx, c_name, 1 + strlen (c_name));
+}
+#endif
+
static void
dump_drain_cold_data (struct dump_context *ctx)
{
@@ -3374,6 +3489,11 @@ dump_drain_cold_data (struct dump_context *ctx)
case COLD_OP_BIGNUM:
dump_cold_bignum (ctx, data);
break;
+#ifdef HAVE_NATIVE_COMP
+ case COLD_OP_NATIVE_SUBR:
+ dump_cold_native_subr (ctx, data);
+ break;
+#endif
default:
emacs_abort ();
}
@@ -3782,7 +3902,7 @@ dump_do_fixup (struct dump_context *ctx,
/* Dump wants a pointer to a Lisp object.
If DUMP_FIXUP_LISP_OBJECT_RAW, we should stick a C pointer in
the dump; otherwise, a Lisp_Object. */
- if (SUBRP (arg))
+ if (SUBRP (arg) && !SUBR_NATIVE_COMPILEDP (arg))
{
dump_value = emacs_offset (XSUBR (arg));
if (type == DUMP_FIXUP_LISP_OBJECT)
@@ -3963,7 +4083,8 @@ types. */)
ctx->symbol_aux = Qnil;
ctx->copied_queue = Qnil;
ctx->cold_queue = Qnil;
- ctx->dump_relocs = Qnil;
+ for (int i = 0; i < RELOC_NUM_PHASES; ++i)
+ ctx->dump_relocs[i] = Qnil;
ctx->object_starts = Qnil;
ctx->emacs_relocs = Qnil;
ctx->bignum_data = make_eq_hash_table ();
@@ -4131,8 +4252,9 @@ types. */)
/* Emit instructions for Emacs to execute when loading the dump.
Note that this relocation information ends up in the cold section
of the dump. */
- drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
- &ctx->dump_relocs, &ctx->header.dump_relocs);
+ for (int i = 0; i < RELOC_NUM_PHASES; ++i)
+ drain_reloc_list (ctx, dump_emit_dump_reloc, emacs_reloc_merger,
+ &ctx->dump_relocs[i], &ctx->header.dump_relocs[i]);
dump_off number_hot_relocations = ctx->number_hot_relocations;
ctx->number_hot_relocations = 0;
dump_off number_discardable_relocations = ctx->number_discardable_relocations;
@@ -4150,7 +4272,8 @@ types. */)
eassert (NILP (ctx->deferred_symbols));
eassert (NILP (ctx->deferred_hash_tables));
eassert (NILP (ctx->fixups));
- eassert (NILP (ctx->dump_relocs));
+ for (int i = 0; i < RELOC_NUM_PHASES; ++i)
+ eassert (NILP (ctx->dump_relocs[i]));
eassert (NILP (ctx->emacs_relocs));
/* Dump is complete. Go back to the header and write the magic
@@ -4158,6 +4281,12 @@ types. */)
ctx->header.magic[0] = dump_magic[0];
dump_seek (ctx, 0);
dump_write (ctx, &ctx->header, sizeof (ctx->header));
+ if (emacs_write (ctx->fd, ctx->buf, ctx->max_offset) < ctx->max_offset)
+ report_file_error ("Could not write to dump file", ctx->dump_filename);
+ xfree (ctx->buf);
+ ctx->buf = NULL;
+ ctx->buf_size = 0;
+ ctx->max_offset = 0;
dump_off
header_bytes = header_end - header_start,
@@ -4210,6 +4339,15 @@ pdumper_do_now_and_after_load_impl (pdumper_hook hook)
hook ();
}
+void
+pdumper_do_now_and_after_late_load_impl (pdumper_hook hook)
+{
+ if (nr_dump_late_hooks == ARRAYELTS (dump_late_hooks))
+ fatal ("out of dump hooks: make dump_late_hooks[] bigger");
+ dump_late_hooks[nr_dump_late_hooks++] = hook;
+ hook ();
+}
+
static void
pdumper_remember_user_data_1 (void *mem, int nbytes)
{
@@ -4235,6 +4373,16 @@ pdumper_remember_lv_ptr_raw_impl (void *ptr, enum Lisp_Type type)
}
+#ifdef HAVE_NATIVE_COMP
+/* This records the directory where the Emacs executable lives, to be
+ used for locating the native-lisp directory from which we need to
+ load the preloaded *.eln files. See pdumper_set_emacs_execdir
+ below. */
+static char *emacs_execdir;
+static ptrdiff_t execdir_size;
+static ptrdiff_t execdir_len;
+#endif
+
/* Dump runtime */
enum dump_memory_protection
{
@@ -5141,6 +5289,117 @@ dump_do_dump_relocation (const uintptr_t dump_base,
dump_write_word_to_dump (dump_base, reloc_offset, value);
break;
}
+#ifdef HAVE_NATIVE_COMP
+ case RELOC_NATIVE_COMP_UNIT:
+ {
+ static enum { UNKNOWN, LOCAL_BUILD, INSTALLED } installation_state;
+ struct Lisp_Native_Comp_Unit *comp_u =
+ dump_ptr (dump_base, reloc_offset);
+ comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq);
+ if (STRINGP (comp_u->file))
+ error ("Trying to load incoherent dumped eln file %s",
+ SSDATA (comp_u->file));
+
+ /* emacs_execdir is always unibyte, but the file names in
+ comp_u->file could be multibyte, so we need to encode
+ them. */
+ Lisp_Object cu_file1 = ENCODE_FILE (XCAR (comp_u->file));
+ Lisp_Object cu_file2 = ENCODE_FILE (XCDR (comp_u->file));
+ ptrdiff_t fn1_len = SBYTES (cu_file1), fn2_len = SBYTES (cu_file2);
+ Lisp_Object eln_fname;
+ char *fndata;
+
+ /* Check just once if this is a local build or Emacs was installed. */
+ /* Can't use expand-file-name here, because we are too early
+ in the startup, and we will crash at least on WINDOWSNT. */
+ if (installation_state == UNKNOWN)
+ {
+ eln_fname = make_uninit_string (execdir_len + fn1_len);
+ fndata = SSDATA (eln_fname);
+ memcpy (fndata, emacs_execdir, execdir_len);
+ memcpy (fndata + execdir_len, SSDATA (cu_file1), fn1_len);
+ if (file_access_p (fndata, F_OK))
+ installation_state = INSTALLED;
+ else
+ {
+ eln_fname = make_uninit_string (execdir_len + fn2_len);
+ fndata = SSDATA (eln_fname);
+ memcpy (fndata, emacs_execdir, execdir_len);
+ memcpy (fndata + execdir_len, SSDATA (cu_file2), fn2_len);
+ installation_state = LOCAL_BUILD;
+ }
+ fixup_eln_load_path (eln_fname);
+ }
+ else
+ {
+ ptrdiff_t fn_len =
+ installation_state == INSTALLED ? fn1_len : fn2_len;
+ Lisp_Object cu_file =
+ installation_state == INSTALLED ? cu_file1 : cu_file2;
+ eln_fname = make_uninit_string (execdir_len + fn_len);
+ fndata = SSDATA (eln_fname);
+ memcpy (fndata, emacs_execdir, execdir_len);
+ memcpy (fndata + execdir_len, SSDATA (cu_file), fn_len);
+ }
+
+ /* FIXME: This records the names of the *.eln files in an
+ unexpanded form, with one or more ".." elements (and on
+ Windows with the first part using backslashes). The file
+ names are also unibyte. If we care about this, we need to
+ loop in startup.el over all the preloaded modules and run
+ their file names through expand-file-name and
+ decode-coding-string. */
+ comp_u->file = eln_fname;
+ comp_u->handle = dynlib_open (SSDATA (eln_fname));
+ if (!comp_u->handle)
+ {
+ fprintf (stderr, "Error using execdir %s:\n",
+ emacs_execdir);
+ error ("%s", dynlib_error ());
+ }
+ load_comp_unit (comp_u, true, false);
+ break;
+ }
+ case RELOC_NATIVE_SUBR:
+ {
+ if (!NATIVE_COMP_FLAG)
+ /* This cannot happen. */
+ emacs_abort ();
+
+ /* When resurrecting from a dump given non all the original
+ native compiled subrs may be still around we can't rely on
+ a 'top_level_run' mechanism, we revive them one-by-one
+ here. */
+ struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
+ struct Lisp_Native_Comp_Unit *comp_u =
+ XNATIVE_COMP_UNIT (subr->native_comp_u[0]);
+ if (!comp_u->handle)
+ error ("NULL handle in compilation unit %s", SSDATA (comp_u->file));
+ const char *c_name = subr->native_c_name[0];
+ eassert (c_name);
+ void *func = dynlib_sym (comp_u->handle, c_name);
+ if (!func)
+ error ("can't find function \"%s\" in compilation unit %s", c_name,
+ SSDATA (comp_u->file));
+ subr->function.a0 = func;
+ Lisp_Object lambda_data_idx =
+ Fgethash (build_string (c_name), comp_u->lambda_c_name_idx_h, Qnil);
+ if (!NILP (lambda_data_idx))
+ {
+ /* This is an anonymous lambda.
+ We must fixup d_reloc_imp so the lambda can be referenced
+ by code. */
+ Lisp_Object tem;
+ XSETSUBR (tem, subr);
+ Lisp_Object *fixup =
+ &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]);
+ eassert (EQ (*fixup, Qlambda_fixup));
+ *fixup = tem;
+ Fputhash (tem, Qt, comp_u->lambda_gc_guard_h);
+ }
+ break;
+ }
+#endif
case RELOC_BIGNUM:
{
struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset);
@@ -5163,11 +5422,12 @@ dump_do_dump_relocation (const uintptr_t dump_base,
}
static void
-dump_do_all_dump_relocations (const struct dump_header *const header,
- const uintptr_t dump_base)
+dump_do_all_dump_reloc_for_phase (const struct dump_header *const header,
+ const uintptr_t dump_base,
+ const enum reloc_phase phase)
{
- struct dump_reloc *r = dump_ptr (dump_base, header->dump_relocs.offset);
- dump_off nr_entries = header->dump_relocs.nr_entries;
+ struct dump_reloc *r = dump_ptr (dump_base, header->dump_relocs[phase].offset);
+ dump_off nr_entries = header->dump_relocs[phase].nr_entries;
for (dump_off i = 0; i < nr_entries; ++i)
dump_do_dump_relocation (dump_base, r[i]);
}
@@ -5232,6 +5492,26 @@ dump_do_all_emacs_relocations (const struct dump_header *const header,
dump_do_emacs_relocation (dump_base, r[i]);
}
+#ifdef HAVE_NATIVE_COMP
+/* Compute and record the directory of the Emacs executable given the
+ file name of that executable. */
+static void
+pdumper_set_emacs_execdir (char *emacs_executable)
+{
+ char *p = emacs_executable + strlen (emacs_executable);
+
+ while (p > emacs_executable
+ && !IS_DIRECTORY_SEP (p[-1]))
+ --p;
+ eassert (p > emacs_executable);
+ emacs_execdir = xpalloc (emacs_execdir, &execdir_size,
+ p - emacs_executable + 1 - execdir_size, -1, 1);
+ memcpy (emacs_execdir, emacs_executable, p - emacs_executable);
+ execdir_len = p - emacs_executable;
+ emacs_execdir[execdir_len] = '\0';
+}
+#endif
+
enum dump_section
{
DS_HOT,
@@ -5248,7 +5528,7 @@ static Lisp_Object *pdumper_hashes = &zero_vector;
N.B. We run very early in initialization, so we can't use lisp,
unwinding, xmalloc, and so on. */
int
-pdumper_load (const char *dump_filename)
+pdumper_load (const char *dump_filename, char *argv0)
{
intptr_t dump_size;
struct stat stat;
@@ -5383,7 +5663,7 @@ pdumper_load (const char *dump_filename)
dump_public.start = dump_base;
dump_public.end = dump_public.start + dump_size;
- dump_do_all_dump_relocations (header, dump_base);
+ dump_do_all_dump_reloc_for_phase (header, dump_base, EARLY_RELOCS);
dump_do_all_emacs_relocations (header, dump_base);
dump_mmap_discard_contents (&sections[DS_DISCARDABLE]);
@@ -5403,6 +5683,21 @@ pdumper_load (const char *dump_filename)
initialization. */
for (int i = 0; i < nr_dump_hooks; ++i)
dump_hooks[i] ();
+
+#ifdef HAVE_NATIVE_COMP
+ pdumper_set_emacs_execdir (argv0);
+#else
+ (void) argv0;
+#endif
+
+ dump_do_all_dump_reloc_for_phase (header, dump_base, LATE_RELOCS);
+ dump_do_all_dump_reloc_for_phase (header, dump_base, VERY_LATE_RELOCS);
+
+ /* Run the functions Emacs registered for doing post-dump-load
+ initialization. */
+ for (int i = 0; i < nr_dump_late_hooks; ++i)
+ dump_late_hooks[i] ();
+
initialized = true;
struct timespec load_timespec =
@@ -5466,9 +5761,6 @@ Value is nil if this session was not started using a dump file.*/)
Fcons (Qdump_file_name, dump_fn));
}
-#endif /* HAVE_PDUMPER */
-
-
static void
thaw_hash_tables (void)
{
@@ -5477,10 +5769,15 @@ thaw_hash_tables (void)
hash_table_thaw (AREF (hash_tables, i));
}
+#endif /* HAVE_PDUMPER */
+
+
void
init_pdumper_once (void)
{
+#ifdef HAVE_PDUMPER
pdumper_do_now_and_after_load (thaw_hash_tables);
+#endif
}
void
diff --git a/src/pdumper.h b/src/pdumper.h
index ed665ac6c2f..deec9af046d 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -81,6 +81,7 @@ pdumper_remember_lv_ptr_raw (void *ptr, enum Lisp_Type type)
typedef void (*pdumper_hook)(void);
extern void pdumper_do_now_and_after_load_impl (pdumper_hook hook);
+extern void pdumper_do_now_and_after_late_load_impl (pdumper_hook hook);
INLINE void
pdumper_do_now_and_after_load (pdumper_hook hook)
@@ -92,6 +93,18 @@ pdumper_do_now_and_after_load (pdumper_hook hook)
#endif
}
+/* Same as 'pdumper_do_now_and_after_load' but for hooks running code
+ that can call into Lisp. */
+INLINE void
+pdumper_do_now_and_after_late_load (pdumper_hook hook)
+{
+#ifdef HAVE_PDUMPER
+ pdumper_do_now_and_after_late_load_impl (hook);
+#else
+ hook ();
+#endif
+}
+
/* Macros useful in pdumper callback functions. Assign a value if
we're loading a dump and the value needs to be reset to its
original value, and if we're initializing for the first time,
@@ -127,7 +140,7 @@ enum pdumper_load_result
PDUMPER_LOAD_ERROR /* Must be last, as errno may be added. */
};
-int pdumper_load (const char *dump_filename);
+int pdumper_load (const char *dump_filename, char *argv0);
struct pdumper_loaded_dump
{
diff --git a/src/print.c b/src/print.c
index 14af9195475..d4301fd7b64 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1841,7 +1841,18 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
}
break;
#endif
-
+#ifdef HAVE_NATIVE_COMP
+ case PVEC_NATIVE_COMP_UNIT:
+ {
+ struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (obj);
+ print_c_string ("#<native compilation unit: ", printcharfun);
+ print_string (cu->file, printcharfun);
+ printchar (' ', printcharfun);
+ print_object (cu->optimize_qualities, printcharfun, escapeflag);
+ printchar ('>', printcharfun);
+ }
+ break;
+#endif
default:
emacs_abort ();
}
diff --git a/src/process.c b/src/process.c
index 3beb9cf7146..c3186eed750 100644
--- a/src/process.c
+++ b/src/process.c
@@ -473,8 +473,15 @@ add_read_fd (int fd, fd_callback func, void *data)
fd_callback_info[fd].data = data;
}
+void
+add_non_keyboard_read_fd (int fd, fd_callback func, void *data)
+{
+ add_read_fd(fd, func, data);
+ fd_callback_info[fd].flags &= ~KEYBOARD_FD;
+}
+
static void
-add_non_keyboard_read_fd (int fd)
+add_process_read_fd (int fd)
{
eassert (fd >= 0 && fd < FD_SETSIZE);
eassert (fd_callback_info[fd].func == NULL);
@@ -483,12 +490,6 @@ add_non_keyboard_read_fd (int fd)
fd_callback_info[fd].flags |= FOR_READ;
if (fd > max_desc)
max_desc = fd;
-}
-
-static void
-add_process_read_fd (int fd)
-{
- add_non_keyboard_read_fd (fd);
eassert (0 <= fd && fd < FD_SETSIZE);
fd_callback_info[fd].flags |= PROCESS_FD;
}
@@ -1754,7 +1755,7 @@ usage: (make-process &rest ARGS) */)
buffer's current directory, or its unhandled equivalent. We
can't just have the child check for an error when it does the
chdir, since it's in a vfork. */
- current_dir = encode_current_directory ();
+ current_dir = get_current_directory (true);
name = Fplist_get (contact, QCname);
CHECK_STRING (name);
@@ -1936,7 +1937,7 @@ usage: (make-process &rest ARGS) */)
{
tem = Qnil;
openp (Vexec_path, program, Vexec_suffixes, &tem,
- make_fixnum (X_OK), false);
+ make_fixnum (X_OK), false, false);
if (NILP (tem))
report_file_error ("Searching for program", program);
tem = Fexpand_file_name (tem, Qnil);
@@ -5133,6 +5134,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
Lisp_Object wait_for_cell,
struct Lisp_Process *wait_proc, int just_wait_proc)
{
+ static int last_read_channel = -1;
int channel, nfds;
fd_set Available;
fd_set Writeok;
@@ -5187,6 +5189,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
while (1)
{
bool process_skipped = false;
+ bool wrapped;
+ int channel_start;
/* If calling from keyboard input, do not quit
since we want to return C-g as an input character.
@@ -5228,7 +5232,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
#ifdef HAVE_GNUTLS
/* Continue TLS negotiation. */
if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
- && p->is_non_blocking_client)
+ && p->is_non_blocking_client
+ /* Don't proceed until we have established a connection. */
+ && !(fd_callback_info[p->outfd].flags
+ & NON_BLOCKING_CONNECT_FD))
{
gnutls_try_handshake (p);
p->gnutls_handshakes_tried++;
@@ -5721,8 +5728,21 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
d->func (channel, d->data);
}
- for (channel = 0; channel <= max_desc; channel++)
+ /* Do round robin if `process-pritoritize-lower-fds' is nil. */
+ channel_start
+ = process_prioritize_lower_fds ? 0 : last_read_channel + 1;
+
+ for (channel = channel_start, wrapped = false;
+ !wrapped || (channel < channel_start && channel <= max_desc);
+ channel++)
{
+ if (channel > max_desc)
+ {
+ wrapped = true;
+ channel = -1;
+ continue;
+ }
+
if (FD_ISSET (channel, &Available)
&& ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
== PROCESS_FD))
@@ -5760,6 +5780,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
don't try to read from any other processes
before doing the select again. */
FD_ZERO (&Available);
+ last_read_channel = channel;
if (do_display)
redisplay_preserve_echo_area (12);
@@ -8255,7 +8276,7 @@ init_process_emacs (int sockfd)
private SIGCHLD handler, allowing catch_child_signal to copy
it into lib_child_handler.
- Unfortunatly in glib commit 2e471acf, the behavior changed to
+ Unfortunately in glib commit 2e471acf, the behavior changed to
always install a signal handler when g_child_watch_source_new
is called and not just the first time it's called. Glib also
now resets signal handlers to SIG_DFL when it no longer has a
@@ -8476,6 +8497,16 @@ 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_BOOL ("process-prioritize-lower-fds", process_prioritize_lower_fds,
+ doc: /* Whether to start checking for subprocess output from first file descriptor.
+Emacs loops through file descriptors to check for output from subprocesses.
+If this variable is nil, the default, then after accepting output from a
+subprocess, Emacs will continue checking the rest of descriptors, starting
+from the one following the descriptor it just read. If this variable is
+non-nil, Emacs will always restart the loop from the first file descriptor,
+thus favoring processes with lower descriptors. */);
+ process_prioritize_lower_fds = 0;
+
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'.
diff --git a/src/process.h b/src/process.h
index d041ada5867..4a25d13d268 100644
--- a/src/process.h
+++ b/src/process.h
@@ -264,7 +264,7 @@ enum
/* Defined in callproc.c. */
-extern Lisp_Object encode_current_directory (void);
+extern Lisp_Object get_current_directory (bool);
extern void record_kill_process (struct Lisp_Process *, Lisp_Object);
/* Defined in sysdep.c. */
@@ -284,6 +284,7 @@ extern bool kbd_on_hold_p (void);
typedef void (*fd_callback) (int fd, void *data);
extern void add_read_fd (int fd, fd_callback func, void *data);
+extern void add_non_keyboard_read_fd (int fd, fd_callback func, void *data);
extern void delete_read_fd (int fd);
extern void add_write_fd (int fd, fd_callback func, void *data);
extern void delete_write_fd (int fd);
diff --git a/src/search.c b/src/search.c
index c757bf3d1f2..14adeb58e96 100644
--- a/src/search.c
+++ b/src/search.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "intervals.h"
#include "pdumper.h"
+#include "composite.h"
#include "regex-emacs.h"
@@ -2723,10 +2724,9 @@ since only regular expressions have distinguished subexpressions. */)
}
newpoint = sub_start + SCHARS (newtext);
- ptrdiff_t newstart = sub_start == sub_end ? newpoint : sub_start;
/* Replace the old text with the new in the cleanest possible way. */
- replace_range (sub_start, sub_end, newtext, 1, 0, 1, true);
+ replace_range (sub_start, sub_end, newtext, 1, 0, 1, true, true);
if (case_action == all_caps)
Fupcase_region (make_fixnum (search_regs.start[sub]),
@@ -2739,11 +2739,11 @@ since only regular expressions have distinguished subexpressions. */)
/* The replace_range etc. functions can trigger modification hooks
(see signal_before_change and signal_after_change). Try to error
out if these hooks clobber the match data since clobbering can
- result in confusing bugs. Although this sanity check does not
- catch all possible clobberings, it should catch many of them. */
- if (! (search_regs.num_regs == num_regs
- && search_regs.start[sub] == newstart
- && search_regs.end[sub] == newpoint))
+ result in confusing bugs. We used to check for changes in
+ search_regs start and end, but that fails if modification hooks
+ remove or add text earlier in the buffer, so just check num_regs
+ now. */
+ if (search_regs.num_regs != num_regs)
error ("Match data clobbered by buffer modification hooks");
/* Put point back where it was in the text, if possible. */
@@ -2751,6 +2751,9 @@ since only regular expressions have distinguished subexpressions. */)
/* Now move point "officially" to the end of the inserted replacement. */
move_if_not_intangible (newpoint);
+ signal_after_change (sub_start, sub_end - sub_start, SCHARS (newtext));
+ update_compositions (sub_start, newpoint, CHECK_BORDER);
+
return Qnil;
}
diff --git a/src/sound.c b/src/sound.c
index e5f66f8f529..9041076bdc0 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -1370,8 +1370,9 @@ Internal use only, use `play-sound' instead. */)
if (STRINGP (attrs[SOUND_FILE]))
{
/* Open the sound file. */
- current_sound->fd = openp (list1 (Vdata_directory),
- attrs[SOUND_FILE], Qnil, &file, Qnil, false);
+ current_sound->fd =
+ openp (list1 (Vdata_directory), attrs[SOUND_FILE], Qnil, &file, Qnil,
+ false, false);
if (current_sound->fd < 0)
sound_perror ("Could not open sound file");
diff --git a/src/syntax.c b/src/syntax.c
index 9fbf88535f3..7bba336744a 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -1109,6 +1109,23 @@ this is probably the wrong function to use, because it can't take
return make_fixnum (syntax_code_spec[SYNTAX (char_int)]);
}
+DEFUN ("syntax-class-to-char", Fsyntax_class_to_char,
+ Ssyntax_class_to_char, 1, 1, 0,
+ doc: /* Return the syntax char of CLASS, described by an integer.
+For example, if SYNTAX is word constituent (the integer 2), the
+character `w' (119) is returned. */)
+ (Lisp_Object syntax)
+{
+ int syn;
+ CHECK_FIXNUM (syntax);
+ syn = XFIXNUM (syntax);
+
+ if (syn < 0 || syn >= sizeof syntax_code_spec)
+ args_out_of_range (make_fixnum (sizeof syntax_code_spec - 1),
+ syntax);
+ return make_fixnum (syntax_code_spec[syn]);
+}
+
DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0,
doc: /* Return the matching parenthesis of CHARACTER, or nil if none. */)
(Lisp_Object character)
@@ -3782,6 +3799,7 @@ In both cases, LIMIT bounds the search. */);
defsubr (&Scopy_syntax_table);
defsubr (&Sset_syntax_table);
defsubr (&Schar_syntax);
+ defsubr (&Ssyntax_class_to_char);
defsubr (&Smatching_paren);
defsubr (&Sstring_to_syntax);
defsubr (&Smodify_syntax_entry);
diff --git a/src/sysdep.c b/src/sysdep.c
index 941b4e2fa24..8eaee224987 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -657,7 +657,7 @@ sys_subshell (void)
#endif
pid_t pid;
struct save_signal saved_handlers[5];
- char *str = SSDATA (encode_current_directory ());
+ char *str = SSDATA (get_current_directory (true));
#ifdef DOS_NT
pid = 0;
@@ -1785,7 +1785,15 @@ handle_arith_signal (int sig)
/* Alternate stack used by SIGSEGV handler below. */
-static unsigned char sigsegv_stack[SIGSTKSZ];
+/* Storage for the alternate signal stack.
+ 64 KiB is not too large for Emacs, and is large enough
+ for all known platforms. Smaller sizes may run into trouble.
+ For example, libsigsegv 2.6 through 2.8 have a bug where some
+ architectures use more than the Linux default of an 8 KiB alternate
+ stack when deciding if a fault was caused by stack overflow. */
+static max_align_t sigsegv_stack[(64 * 1024
+ + sizeof (max_align_t) - 1)
+ / sizeof (max_align_t)];
/* Return true if SIGINFO indicates a stack overflow. */
@@ -2662,6 +2670,13 @@ void
errputc (int c)
{
fputc_unlocked (c, errstream ());
+
+#ifdef WINDOWSNT
+ /* Flush stderr after outputting a newline since stderr is fully
+ buffered when redirected to a pipe, contrary to POSIX. */
+ if (c == '\n')
+ fflush_unlocked (stderr);
+#endif
}
void
@@ -2729,6 +2744,138 @@ cfsetspeed (struct termios *termios_p, speed_t vitesse)
}
#endif
+/* The following is based on the glibc implementation of cfsetspeed. */
+
+struct speed_struct
+{
+ speed_t value;
+ speed_t internal;
+};
+
+static const struct speed_struct speeds[] =
+ {
+#ifdef B0
+ { 0, B0 },
+#endif
+#ifdef B50
+ { 50, B50 },
+#endif
+#ifdef B75
+ { 75, B75 },
+#endif
+#ifdef B110
+ { 110, B110 },
+#endif
+#ifdef B134
+ { 134, B134 },
+#endif
+#ifdef B150
+ { 150, B150 },
+#endif
+#ifdef B200
+ { 200, B200 },
+#endif
+#ifdef B300
+ { 300, B300 },
+#endif
+#ifdef B600
+ { 600, B600 },
+#endif
+#ifdef B1200
+ { 1200, B1200 },
+#endif
+#ifdef B1200
+ { 1200, B1200 },
+#endif
+#ifdef B1800
+ { 1800, B1800 },
+#endif
+#ifdef B2400
+ { 2400, B2400 },
+#endif
+#ifdef B4800
+ { 4800, B4800 },
+#endif
+#ifdef B9600
+ { 9600, B9600 },
+#endif
+#ifdef B19200
+ { 19200, B19200 },
+#endif
+#ifdef B38400
+ { 38400, B38400 },
+#endif
+#ifdef B57600
+ { 57600, B57600 },
+#endif
+#ifdef B76800
+ { 76800, B76800 },
+#endif
+#ifdef B115200
+ { 115200, B115200 },
+#endif
+#ifdef B153600
+ { 153600, B153600 },
+#endif
+#ifdef B230400
+ { 230400, B230400 },
+#endif
+#ifdef B307200
+ { 307200, B307200 },
+#endif
+#ifdef B460800
+ { 460800, B460800 },
+#endif
+#ifdef B500000
+ { 500000, B500000 },
+#endif
+#ifdef B576000
+ { 576000, B576000 },
+#endif
+#ifdef B921600
+ { 921600, B921600 },
+#endif
+#ifdef B1000000
+ { 1000000, B1000000 },
+#endif
+#ifdef B1152000
+ { 1152000, B1152000 },
+#endif
+#ifdef B1500000
+ { 1500000, B1500000 },
+#endif
+#ifdef B2000000
+ { 2000000, B2000000 },
+#endif
+#ifdef B2500000
+ { 2500000, B2500000 },
+#endif
+#ifdef B3000000
+ { 3000000, B3000000 },
+#endif
+#ifdef B3500000
+ { 3500000, B3500000 },
+#endif
+#ifdef B4000000
+ { 4000000, B4000000 },
+#endif
+ };
+
+/* Convert a numerical speed (e.g., 9600) to a Bnnn constant (e.g.,
+ B9600); see bug#49524. */
+static speed_t
+convert_speed (speed_t speed)
+{
+ for (size_t i = 0; i < sizeof speeds / sizeof speeds[0]; i++)
+ {
+ if (speed == speeds[i].internal)
+ return speed;
+ else if (speed == speeds[i].value)
+ return speeds[i].internal;
+ }
+ return speed;
+}
+
/* For serial-process-configure */
void
serial_configure (struct Lisp_Process *p,
@@ -2760,7 +2907,7 @@ serial_configure (struct Lisp_Process *p,
else
tem = Fplist_get (p->childp, QCspeed);
CHECK_FIXNUM (tem);
- err = cfsetspeed (&attr, XFIXNUM (tem));
+ err = cfsetspeed (&attr, convert_speed (XFIXNUM (tem)));
if (err != 0)
report_file_error ("Failed cfsetspeed", tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
@@ -3611,7 +3758,7 @@ system_process_attributes (Lisp_Object pid)
ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR);
unblock_input ();
if (ttyname)
- attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
+ attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.ki_tpgid)), attrs);
attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.ki_rusage.ru_minflt)),
@@ -3883,20 +4030,19 @@ system_process_attributes (Lisp_Object pid)
Lisp_Object
system_process_attributes (Lisp_Object pid)
{
- int proc_id;
+ int proc_id, i;
struct passwd *pw;
struct group *gr;
char *ttyname;
struct timeval starttime;
struct timespec t, now;
- struct rusage *rusage;
dev_t tdev;
uid_t uid;
gid_t gid;
int mib[4] = {CTL_KERN, KERN_PROC, KERN_PROC_PID};
struct kinfo_proc proc;
- size_t proclen = sizeof proc;
+ size_t len = sizeof proc;
Lisp_Object attrs = Qnil;
Lisp_Object decoded_comm;
@@ -3905,7 +4051,7 @@ system_process_attributes (Lisp_Object pid)
CONS_TO_INTEGER (pid, int, proc_id);
mib[3] = proc_id;
- if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0 || proclen == 0)
+ if (sysctl (mib, 4, &proc, &len, NULL, 0) != 0 || len == 0)
return attrs;
uid = proc.kp_eproc.e_ucred.cr_uid;
@@ -3942,8 +4088,8 @@ system_process_attributes (Lisp_Object pid)
decoded_comm = (code_convert_string_norecord
(build_unibyte_string (comm),
Vlocale_coding_system, 0));
-
attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
+
{
char state[2] = {'\0', '\0'};
switch (proc.kp_proc.p_stat)
@@ -3979,27 +4125,24 @@ system_process_attributes (Lisp_Object pid)
ttyname = tdev == NODEV ? NULL : devname (tdev, S_IFCHR);
unblock_input ();
if (ttyname)
- attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
+ attrs = Fcons (Fcons (Qttname, build_string (ttyname)), attrs);
attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)),
attrs);
- rusage = proc.kp_proc.p_ru;
- if (rusage)
+ rusage_info_current ri;
+ if (proc_pid_rusage(proc_id, RUSAGE_INFO_CURRENT, (rusage_info_t *) &ri) == 0)
{
- attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)),
- attrs);
- attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)),
- attrs);
-
- attrs = Fcons (Fcons (Qutime, make_lisp_timeval (rusage->ru_utime)),
- attrs);
- attrs = Fcons (Fcons (Qstime, make_lisp_timeval (rusage->ru_stime)),
- attrs);
- t = timespec_add (timeval_to_timespec (rusage->ru_utime),
- timeval_to_timespec (rusage->ru_stime));
- attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs);
- }
+ struct timespec utime = make_timespec (ri.ri_user_time / TIMESPEC_HZ,
+ ri.ri_user_time % TIMESPEC_HZ);
+ struct timespec stime = make_timespec (ri.ri_system_time / TIMESPEC_HZ,
+ ri.ri_system_time % TIMESPEC_HZ);
+ attrs = Fcons (Fcons (Qutime, make_lisp_time (utime)), attrs);
+ attrs = Fcons (Fcons (Qstime, make_lisp_time (stime)), attrs);
+ attrs = Fcons (Fcons (Qtime, make_lisp_time (timespec_add (utime, stime))), attrs);
+
+ attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (ri.ri_pageins)), attrs);
+ }
starttime = proc.kp_proc.p_starttime;
attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs);
@@ -4009,6 +4152,50 @@ system_process_attributes (Lisp_Object pid)
t = timespec_sub (now, timeval_to_timespec (starttime));
attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs);
+ struct proc_taskinfo taskinfo;
+ if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0)
+ {
+ attrs = Fcons (Fcons (Qvsize, make_fixnum (taskinfo.pti_virtual_size / 1024)), attrs);
+ attrs = Fcons (Fcons (Qrss, make_fixnum (taskinfo.pti_resident_size / 1024)), attrs);
+ attrs = Fcons (Fcons (Qthcount, make_fixnum (taskinfo.pti_threadnum)), attrs);
+ }
+
+#ifdef KERN_PROCARGS2
+ char args[ARG_MAX];
+ mib[1] = KERN_PROCARGS2;
+ mib[2] = proc_id;
+ len = sizeof args;
+
+ if (sysctl (mib, 3, &args, &len, NULL, 0) == 0 && len != 0)
+ {
+ char *start, *end;
+
+ int argc = *(int*)args; /* argc is the first int */
+ start = args + sizeof (int);
+
+ start += strlen (start) + 1; /* skip executable name and any '\0's */
+ while ((start - args < len) && ! *start) start++;
+
+ /* skip argv to find real end */
+ for (i = 0, end = start; i < argc && (end - args) < len; i++)
+ {
+ end += strlen (end) + 1;
+ }
+
+ len = end - start;
+ for (int i = 0; i < len; i++)
+ {
+ if (! start[i] && i < len - 1)
+ start[i] = ' ';
+ }
+
+ AUTO_STRING (comm, start);
+ decoded_comm = code_convert_string_norecord (comm,
+ Vlocale_coding_system, 0);
+ attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
+ }
+#endif /* KERN_PROCARGS2 */
+
return attrs;
}
diff --git a/src/term.c b/src/term.c
index 1059b0669a7..6651b967927 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2169,6 +2169,14 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f)
#endif /* !DOS_NT */
+char *
+tty_type_name (Lisp_Object terminal)
+{
+ struct terminal *t = decode_tty_terminal (terminal);
+
+ return t? t->display_info.tty->type: NULL;
+}
+
DEFUN ("tty-type", Ftty_type, Stty_type, 0, 1, 0,
doc: /* Return the type of the tty device that TERMINAL uses.
Returns nil if TERMINAL is not on a tty device.
@@ -2177,10 +2185,9 @@ TERMINAL can be a terminal object, a frame, or nil (meaning the
selected frame's terminal). */)
(Lisp_Object terminal)
{
- struct terminal *t = decode_tty_terminal (terminal);
+ char *name = tty_type_name (terminal);
- return (t && t->display_info.tty->type
- ? build_string (t->display_info.tty->type) : Qnil);
+ return (name? build_string (name) : Qnil);
}
DEFUN ("controlling-tty-p", Fcontrolling_tty_p, Scontrolling_tty_p, 0, 1, 0,
@@ -2356,9 +2363,7 @@ frame's terminal). */)
was suspended. */
get_tty_size (fileno (t->display_info.tty->input), &width, &height);
if (width != old_width || height != old_height)
- change_frame_size (f, width, height - FRAME_MENU_BAR_LINES (f)
- - FRAME_TAB_BAR_LINES (f),
- 0, 0, 0, 0);
+ change_frame_size (f, width, height, false, false, false);
SET_FRAME_VISIBLE (XFRAME (t->display_info.tty->top_frame), 1);
}
diff --git a/src/termhooks.h b/src/termhooks.h
index 3800679e803..1d3cdc8fe8d 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -583,7 +583,7 @@ struct terminal
window gravity for this size change and subsequent size changes.
Otherwise we leave the window gravity unchanged. */
void (*set_window_size_hook) (struct frame *f, bool change_gravity,
- int width, int height, bool pixelwise);
+ int width, int height);
/* CHANGE_GRAVITY is 1 when calling from Fset_frame_position,
to really change the position, and 0 when calling from
diff --git a/src/thread.c b/src/thread.c
index f74f6111486..714b1cd903a 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -28,6 +28,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "pdumper.h"
#include "keyboard.h"
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#if defined HAVE_GLIB && ! defined (HAVE_NS)
#include <xgselect.h>
#else
@@ -735,6 +739,15 @@ run_thread (void *state)
struct thread_state *self = state;
struct thread_state **iter;
+#ifdef HAVE_NS
+ /* Allocate an autorelease pool in case this thread calls any
+ Objective C code.
+
+ FIXME: In long running threads we may want to drain the pool
+ regularly instead of just at the end. */
+ void *pool = ns_alloc_autorelease_pool ();
+#endif
+
self->m_stack_bottom = self->stack_top = &stack_pos.c;
self->thread_id = sys_thread_self ();
@@ -777,6 +790,10 @@ run_thread (void *state)
current_thread = NULL;
sys_cond_broadcast (&self->thread_condvar);
+#ifdef HAVE_NS
+ ns_release_autorelease_pool (pool);
+#endif
+
/* Unlink this thread from the list of all threads. Note that we
have to do this very late, after broadcasting our death.
Otherwise the GC may decide to reap the thread_state object,
diff --git a/src/verbose.mk.in b/src/verbose.mk.in
new file mode 100644
index 00000000000..50d6ea32000
--- /dev/null
+++ b/src/verbose.mk.in
@@ -0,0 +1,50 @@
+### verbose.mk --- Makefile fragment for GNU Emacs
+
+## Copyright (C) 2021 Free Software Foundation, Inc.
+
+## This file is part of GNU Emacs.
+
+## GNU Emacs is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 3 of the License, or
+## (at your option) any later version.
+##
+## GNU Emacs is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+# 'make' verbosity.
+V = @AM_DEFAULT_VERBOSITY@
+ifeq (${V},1)
+AM_V_AR =
+AM_V_at =
+AM_V_CC =
+AM_V_CCLD =
+AM_V_ELC =
+AM_V_GEN =
+AM_V_GLOBALS =
+AM_V_NO_PD =
+AM_V_RC =
+else
+AM_V_AR = @echo " AR " $@;
+AM_V_at = @
+AM_V_CC = @echo " CC " $@;
+AM_V_CCLD = @echo " CCLD " $@;
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ifeq ($(NATIVE_DISABLED),1)
+AM_V_ELC = @echo " ELC " $@;
+else
+AM_V_ELC = @echo " ELC+ELN " $@;
+endif
+else
+AM_V_ELC = @echo " ELC " $@;
+endif
+AM_V_GEN = @echo " GEN " $@;
+AM_V_GLOBALS = @echo " GEN " globals.h;
+AM_V_NO_PD = --no-print-directory
+AM_V_RC = @echo " RC " $@;
+endif
diff --git a/src/w32.c b/src/w32.c
index a3c247b8b0d..0eb69d4b1d1 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -346,6 +346,7 @@ static BOOL g_b_init_get_adapters_addresses;
static BOOL g_b_init_reg_open_key_ex_w;
static BOOL g_b_init_reg_query_value_ex_w;
static BOOL g_b_init_expand_environment_strings_w;
+static BOOL g_b_init_get_user_default_ui_language;
BOOL g_b_init_compare_string_w;
BOOL g_b_init_debug_break_process;
@@ -533,6 +534,7 @@ DWORD multiByteToWideCharFlags;
typedef LONG (WINAPI *RegOpenKeyExW_Proc) (HKEY,LPCWSTR,DWORD,REGSAM,PHKEY);
typedef LONG (WINAPI *RegQueryValueExW_Proc) (HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYTE,LPDWORD);
typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD);
+typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void);
/* ** A utility function ** */
static BOOL
@@ -1489,6 +1491,28 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR lpDst, DWORD nSize)
return s_pfn_Expand_Environment_Strings_w (lpSrc, lpDst, nSize);
}
+static LANGID WINAPI
+get_user_default_ui_language (void)
+{
+ static GetUserDefaultUILanguage_Proc s_pfn_GetUserDefaultUILanguage = NULL;
+ HMODULE hm_kernel32 = NULL;
+
+ if (is_windows_9x () == TRUE)
+ return 0;
+
+ if (g_b_init_get_user_default_ui_language == 0)
+ {
+ g_b_init_get_user_default_ui_language = 1;
+ hm_kernel32 = LoadLibrary ("Kernel32.dll");
+ if (hm_kernel32)
+ s_pfn_GetUserDefaultUILanguage = (GetUserDefaultUILanguage_Proc)
+ get_proc_addr (hm_kernel32, "GetUserDefaultUILanguage");
+ }
+ if (s_pfn_GetUserDefaultUILanguage == NULL)
+ return 0;
+ return s_pfn_GetUserDefaultUILanguage ();
+}
+
/* Return 1 if P is a valid pointer to an object of size SIZE. Return
@@ -1917,11 +1941,10 @@ buf_prev (int from)
return prev_idx;
}
-static void
-sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user)
+unsigned
+w32_get_nproc (void)
{
SYSTEM_INFO sysinfo;
- FILETIME ft_idle, ft_user, ft_kernel;
/* Initialize the number of processors on this machine. */
if (num_of_processors <= 0)
@@ -1936,6 +1959,15 @@ sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user)
if (num_of_processors <= 0)
num_of_processors = 1;
}
+ return num_of_processors;
+}
+
+static void
+sample_system_load (ULONGLONG *idle, ULONGLONG *kernel, ULONGLONG *user)
+{
+ FILETIME ft_idle, ft_user, ft_kernel;
+
+ (void) w32_get_nproc ();
/* TODO: Take into account threads that are ready to run, by
sampling the "\System\Processor Queue Length" performance
@@ -2357,8 +2389,13 @@ rand_as183 (void)
int
random (void)
{
- /* rand_as183 () gives us 15 random bits...hack together 30 bits. */
+ /* rand_as183 () gives us 15 random bits...hack together 30 bits for
+ Emacs with 32-bit EMACS_INT, and at least 31 bit for wider EMACS_INT. */
+#if EMACS_INT_MAX > INT_MAX
+ return ((rand_as183 () << 30) | (rand_as183 () << 15) | rand_as183 ());
+#else
return ((rand_as183 () << 15) | rand_as183 ());
+#endif
}
void
@@ -2947,6 +2984,32 @@ init_environment (char ** argv)
LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
locale_name, sizeof (locale_name)))
{
+ /* Microsoft are migrating away of locale IDs, replacing them
+ with locale names, such as "en-US", and are therefore
+ deprecating the APIs which use LCID etc. As part of that
+ deprecation, they don't bother inventing LCID and LANGID
+ codes for new locales and language/culture combinations;
+ instead, those get LCID of 0xC000 and LANGID of 0x2000, for
+ which the LCID/LANGID oriented APIs return "ZZZ" as the
+ "language name". Such "language name" is useless for our
+ purposes. So we instead use the default UI language, in the
+ hope of getting something usable. */
+ if (strcmp (locale_name, "ZZZ") == 0)
+ {
+ LANGID lang_id = get_user_default_ui_language ();
+
+ if (lang_id != 0)
+ {
+ /* Disregard the sorting order differences between cultures. */
+ LCID def_lcid = MAKELCID (lang_id, SORT_DEFAULT);
+ char locale_name_def[32];
+
+ if (GetLocaleInfo (def_lcid,
+ LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
+ locale_name_def, sizeof (locale_name_def)))
+ strcpy (locale_name, locale_name_def);
+ }
+ }
for (i = 0; i < N_ENV_VARS; i++)
{
if (strcmp (env_vars[i].name, "LANG") == 0)
@@ -4689,7 +4752,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force)
/* volume_info is set indirectly by map_w32_filename. */
oldname_dev = volume_info.serialnum;
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
{
char * o;
char * p;
@@ -8695,7 +8758,7 @@ int
_sys_read_ahead (int fd)
{
child_process * cp;
- int rc;
+ int rc = 0;
if (fd < 0 || fd >= MAXDESC)
return STATUS_READ_ERROR;
@@ -10197,7 +10260,8 @@ check_windows_init_file (void)
need to ENCODE_FILE here, but we do need to convert the file
names from UTF-8 to ANSI. */
init_file = build_string ("term/w32-win");
- fd = openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil, 0);
+ fd =
+ openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil, 0, 0);
if (fd < 0)
{
Lisp_Object load_path_print = Fprin1_to_string (Vload_path, Qnil);
@@ -10389,6 +10453,13 @@ shutdown_handler (DWORD type)
|| type == CTRL_LOGOFF_EVENT /* User logs off. */
|| type == CTRL_SHUTDOWN_EVENT) /* User shutsdown. */
{
+ /* If we are being shut down in noninteractive mode, we don't
+ care about the message stack, so clear it to avoid abort in
+ shut_down_emacs. This happens when an noninteractive Emacs
+ is invoked as a subprocess of Emacs, and the parent wants to
+ kill us, e.g. because it's about to exit. */
+ if (noninteractive)
+ clear_message_stack ();
/* Shut down cleanly, making sure autosave files are up to date. */
shut_down_emacs (0, Qnil);
}
@@ -10402,7 +10473,7 @@ shutdown_handler (DWORD type)
HANDLE
maybe_load_unicows_dll (void)
{
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
{
HANDLE ret = LoadLibrary ("Unicows.dll");
if (ret)
@@ -10521,6 +10592,45 @@ w32_my_exename (void)
return exename;
}
+/* Emulate Posix 'realpath'. This is needed in
+ comp-el-to-eln-rel-filename. */
+char *
+realpath (const char *file_name, char *resolved_name)
+{
+ char *tgt = chase_symlinks (file_name);
+ char target[MAX_UTF8_PATH];
+
+ if (tgt == file_name)
+ {
+ /* If FILE_NAME is not a symlink, chase_symlinks returns its
+ argument, possibly not in canonical absolute form. Make sure
+ we return a canonical file name. */
+ if (w32_unicode_filenames)
+ {
+ wchar_t file_w[MAX_PATH], tgt_w[MAX_PATH];
+
+ filename_to_utf16 (file_name, file_w);
+ if (GetFullPathNameW (file_w, MAX_PATH, tgt_w, NULL) == 0)
+ return NULL;
+ filename_from_utf16 (tgt_w, target);
+ }
+ else
+ {
+ char file_a[MAX_PATH], tgt_a[MAX_PATH];
+
+ filename_to_ansi (file_name, file_a);
+ if (GetFullPathNameA (file_a, MAX_PATH, tgt_a, NULL) == 0)
+ return NULL;
+ filename_from_ansi (tgt_a, target);
+ }
+ tgt = target;
+ }
+
+ if (resolved_name)
+ return strcpy (resolved_name, tgt);
+ return xstrdup (tgt);
+}
+
/*
globals_of_w32 is used to initialize those global variables that
must always be initialized on startup even when the global variable
@@ -10580,6 +10690,7 @@ globals_of_w32 (void)
g_b_init_expand_environment_strings_w = 0;
g_b_init_compare_string_w = 0;
g_b_init_debug_break_process = 0;
+ g_b_init_get_user_default_ui_language = 0;
num_of_processors = 0;
/* The following sets a handler for shutdown notifications for
console apps. This actually applies to Emacs in both console and
@@ -10606,6 +10717,10 @@ globals_of_w32 (void)
#endif
w32_crypto_hprov = (HCRYPTPROV)0;
+
+ /* We need to forget about libraries that were loaded during the
+ dumping process (e.g. libgccjit) */
+ Vlibrary_cache = Qnil;
}
/* For make-serial-process */
diff --git a/src/w32.h b/src/w32.h
index 3f8eb250cc1..ffa145b1484 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -187,6 +187,7 @@ extern DWORD multiByteToWideCharFlags;
extern char *w32_my_exename (void);
extern const char *w32_relocate (const char *);
+extern char *realpath (const char *, char *);
extern void init_environment (char **);
extern void check_windows_init_file (void);
@@ -233,6 +234,9 @@ extern int w32_memory_info (unsigned long long *, unsigned long long *,
/* Compare 2 UTF-8 strings in locale-dependent fashion. */
extern int w32_compare_strings (const char *, const char *, char *, int);
+/* Return the number of processor execution units on this system. */
+extern unsigned w32_get_nproc (void);
+
/* Return a cryptographically secure seed for PRNG. */
extern int w32_init_random (void *, ptrdiff_t);
diff --git a/src/w32common.h b/src/w32common.h
index 714a2386a68..6493b9c88d5 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -41,8 +41,8 @@ extern int w32_minor_version;
extern int w32_build_number;
enum {
- OS_9X = 1,
- OS_NT
+ OS_SUBTYPE_9X = 1,
+ OS_SUBTYPE_NT
};
extern int os_subtype;
@@ -86,6 +86,14 @@ get_proc_addr (HINSTANCE handle, LPCSTR fname)
} \
while (false)
+/* Load a function from the DLL, and don't fail if it does not exist. */
+#define LOAD_DLL_FN_OPT(lib, func) \
+ do \
+ { \
+ fn_##func = (W32_PFN_##func) get_proc_addr (lib, #func); \
+ } \
+ while (false)
+
#ifdef HAVE_HARFBUZZ
extern bool hbfont_init_w32_funcs (HMODULE);
#endif
diff --git a/src/w32console.c b/src/w32console.c
index cb9e288e880..99546c2d754 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -803,7 +803,7 @@ initialize_w32_display (struct terminal *term, int *width, int *height)
ceol_initialized = FALSE;
}
- if (os_subtype == OS_NT)
+ if (os_subtype == OS_SUBTYPE_NT)
w32_console_unicode_input = 1;
else
w32_console_unicode_input = 0;
diff --git a/src/w32fns.c b/src/w32fns.c
index 86c3db64e7b..14d1154a2bc 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1701,7 +1701,7 @@ w32_change_tab_bar_height (struct frame *f, int height)
int unit = FRAME_LINE_HEIGHT (f);
int old_height = FRAME_TAB_BAR_HEIGHT (f);
int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen;
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -1728,25 +1728,21 @@ w32_change_tab_bar_height (struct frame *f, int height)
if ((height < old_height) && WINDOWP (f->tab_bar_window))
clear_glyph_matrix (XWINDOW (f->tab_bar_window)->current_matrix);
- /* Recalculate tabbar height. */
- f->n_tab_bar_rows = 0;
- if (old_height == 0
- && (!f->after_make_frame
- || NILP (frame_inhibit_implied_resize)
- || (CONSP (frame_inhibit_implied_resize)
- && NILP (Fmemq (Qtab_bar_lines, frame_inhibit_implied_resize)))))
- f->tab_bar_redisplayed = f->tab_bar_resized = false;
-
- adjust_frame_size (f, -1, -1,
- ((!f->tab_bar_resized
- && (NILP (fullscreen =
- get_frame_param (f, Qfullscreen))
- || EQ (fullscreen, Qfullwidth))) ? 1
- : (old_height == 0 || height == 0) ? 2
- : 4),
- false, Qtab_bar_lines);
-
- f->tab_bar_resized = f->tab_bar_redisplayed;
+ if (!f->tab_bar_resized)
+ {
+ /* As long as tab_bar_resized is false, effectively try to change
+ F's native height. */
+ if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth))
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 1, false, Qtab_bar_lines);
+ else
+ adjust_frame_size (f, -1, -1, 4, false, Qtab_bar_lines);
+
+ f->tab_bar_resized = f->tab_bar_redisplayed;
+ }
+ else
+ /* Any other change may leave the native size of F alone. */
+ adjust_frame_size (f, -1, -1, 3, false, Qtab_bar_lines);
/* adjust_frame_size might not have done anything, garbage frame
here. */
@@ -1790,7 +1786,7 @@ w32_change_tool_bar_height (struct frame *f, int height)
int unit = FRAME_LINE_HEIGHT (f);
int old_height = FRAME_TOOL_BAR_HEIGHT (f);
int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen;
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
/* Make sure we redisplay all windows in this frame. */
windows_or_buffers_changed = 23;
@@ -1811,25 +1807,21 @@ w32_change_tool_bar_height (struct frame *f, int height)
if ((height < old_height) && WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
- /* Recalculate toolbar height. */
- f->n_tool_bar_rows = 0;
- if (old_height == 0
- && (!f->after_make_frame
- || NILP (frame_inhibit_implied_resize)
- || (CONSP (frame_inhibit_implied_resize)
- && NILP (Fmemq (Qtool_bar_lines, frame_inhibit_implied_resize)))))
- f->tool_bar_redisplayed = f->tool_bar_resized = false;
-
- adjust_frame_size (f, -1, -1,
- ((!f->tool_bar_resized
- && (NILP (fullscreen =
- get_frame_param (f, Qfullscreen))
- || EQ (fullscreen, Qfullwidth))) ? 1
- : (old_height == 0 || height == 0) ? 2
- : 4),
- false, Qtool_bar_lines);
-
- f->tool_bar_resized = f->tool_bar_redisplayed;
+ if (!f->tool_bar_resized)
+ {
+ /* As long as tool_bar_resized is false, effectively try to change
+ F's native height. */
+ if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth))
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 1, false, Qtool_bar_lines);
+ else
+ adjust_frame_size (f, -1, -1, 4, false, Qtool_bar_lines);
+
+ f->tool_bar_resized = f->tool_bar_redisplayed;
+ }
+ else
+ /* Any other change may leave the native size of F alone. */
+ adjust_frame_size (f, -1, -1, 3, false, Qtool_bar_lines);
/* adjust_frame_size might not have done anything, garbage frame
here. */
@@ -3893,7 +3885,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam,
Essentially, we have no information about the "role" of
modifiers on this key: which contribute into the
produced character (so "are consumed"), and which are
- "extra" (must attache to bindable events).
+ "extra" (must attach to bindable events).
The default above would consume ALL modifiers, so the
character is reported "as is". However, on many layouts
@@ -5718,7 +5710,6 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
struct w32_display_info *dpyinfo = NULL;
Lisp_Object parent, parent_frame;
struct kboard *kb;
- int x_width = 0, x_height = 0;
if (!FRAME_W32_P (SELECTED_FRAME ())
&& !FRAME_INITIAL_P (SELECTED_FRAME ()))
@@ -6045,8 +6036,7 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
- window_prompting = gui_figure_window_size (f, parameters, true, true,
- &x_width, &x_height);
+ window_prompting = gui_figure_window_size (f, parameters, true, true);
tem = gui_display_get_arg (dpyinfo, parameters, Qunsplittable, 0, 0,
RES_TYPE_BOOLEAN);
@@ -6081,11 +6071,6 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
/* Allow set_window_size_hook, now. */
f->can_set_window_size = true;
- if (x_width > 0)
- SET_FRAME_WIDTH (f, x_width);
- if (x_height > 0)
- SET_FRAME_HEIGHT (f, x_height);
-
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
@@ -6093,8 +6078,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
w32_wm_set_size_hint (f, window_prompting, false);
unblock_input ();
- adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true,
- Qx_create_frame_2);
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 0, true, Qx_create_frame_2);
/* Process fullscreen parameter here in the hope that normalizing a
fullheight/fullwidth frame will produce the size set by the last
@@ -6122,6 +6107,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
if (!NILP (visibility))
w32_make_frame_visible (f);
+ else
+ f->was_invisible = true;
}
store_frame_param (f, Qvisibility, visibility);
@@ -6888,11 +6875,9 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
struct frame *f;
Lisp_Object frame;
Lisp_Object name;
- int width, height;
ptrdiff_t count = SPECPDL_INDEX ();
struct kboard *kb;
bool face_change_before = face_change;
- int x_width = 0, x_height = 0;
/* Use this general default value to start with until we know if
this frame has a specified name. */
@@ -7013,7 +6998,7 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
f->output_data.w32->explicit_parent = false;
- gui_figure_window_size (f, parms, true, true, &x_width, &x_height);
+ gui_figure_window_size (f, parms, true, true);
/* No fringes on tip frame. */
f->fringe_cols = 0;
@@ -7039,15 +7024,6 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
gui_default_parameter (f, parms, Qalpha, Qnil,
"alpha", "Alpha", RES_TYPE_NUMBER);
- /* Dimensions, especially FRAME_LINES (f), must be done via
- change_frame_size. Change will not be effected unless different
- from the current FRAME_LINES (f). */
- width = FRAME_COLS (f);
- height = FRAME_LINES (f);
- SET_FRAME_COLS (f, 0);
- SET_FRAME_LINES (f, 0);
- adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
- height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil));
@@ -7088,6 +7064,8 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
visible won't work. */
Vframe_list = Fcons (frame, Vframe_list);
f->can_set_window_size = true;
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 0, true, Qtip_frame);
/* Setting attributes of faces of the tooltip frame from resources
and similar will set face_change, which leads to the
@@ -7434,6 +7412,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
set_window_buffer (window, tip_buf, false, false);
w = XWINDOW (window);
w->pseudo_window_p = true;
+ /* Try to avoid that `other-window' select us (Bug#47207). */
+ Fset_window_parameter (window, Qno_other_window, Qt);
/* Set up the frame's root window. Note: The following code does not
try to size the window or its frame correctly. Its only purpose is
@@ -8013,7 +7993,7 @@ DEFUN ("system-move-file-to-trash", Fsystem_move_file_to_trash,
/* The Unicode version of SHFileOperation is not supported on
Windows 9X. */
- if (w32_unicode_filenames && os_subtype != OS_9X)
+ if (w32_unicode_filenames && os_subtype != OS_SUBTYPE_9X)
{
SHFILEOPSTRUCTW file_op_w;
/* We need one more element beyond MAX_PATH because this is
@@ -9142,7 +9122,7 @@ The coordinates X and Y are interpreted in pixels relative to a position
/* When "mouse trails" are in effect, moving the mouse cursor
sometimes leaves behind an annoying "ghost" of the pointer.
Avoid that by momentarily switching off mouse trails. */
- if (os_subtype == OS_NT
+ if (os_subtype == OS_SUBTYPE_NT
&& w32_major_version + w32_minor_version >= 6)
ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
SetCursorPos (xval, yval);
@@ -9317,7 +9297,7 @@ DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
if (!OpenPrinter (pname_buf, &hPrn, NULL))
return Qnil;
/* GetPrinterW is not supported by unicows.dll. */
- if (w32_unicode_filenames && os_subtype != OS_9X)
+ if (w32_unicode_filenames && os_subtype != OS_SUBTYPE_9X)
GetPrinterW (hPrn, 2, NULL, 0, &dwNeeded);
else
GetPrinterA (hPrn, 2, NULL, 0, &dwNeeded);
@@ -9327,7 +9307,7 @@ DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
return Qnil;
}
/* Call GetPrinter again with big enough memory block. */
- if (w32_unicode_filenames && os_subtype != OS_9X)
+ if (w32_unicode_filenames && os_subtype != OS_SUBTYPE_9X)
{
/* Allocate memory for the PRINTER_INFO_2 struct. */
ppi2w = xmalloc (dwNeeded);
@@ -9463,9 +9443,9 @@ cache_system_info (void)
w32_minor_version = version.info.minor;
if (version.info.platform & 0x8000)
- os_subtype = OS_9X;
+ os_subtype = OS_SUBTYPE_9X;
else
- os_subtype = OS_NT;
+ os_subtype = OS_SUBTYPE_NT;
/* Cache page size, allocation unit, processor type, etc. */
GetSystemInfo (&sysinfo_cache);
@@ -9476,7 +9456,7 @@ cache_system_info (void)
GetVersionEx (&osinfo_cache);
w32_build_number = osinfo_cache.dwBuildNumber;
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
w32_build_number &= 0xffff;
w32_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS);
@@ -9655,7 +9635,7 @@ w32_kbd_patch_key (KEY_EVENT_RECORD *event, int cpId)
/* On NT, call ToUnicode instead and then convert to the current
console input codepage. */
- if (os_subtype == OS_NT)
+ if (os_subtype == OS_SUBTYPE_NT)
{
WCHAR buf[128];
@@ -11069,7 +11049,7 @@ see `w32-ansi-code-page'. */);
w32_multibyte_code_page = _getmbcp ();
#endif
- if (os_subtype == OS_NT)
+ if (os_subtype == OS_SUBTYPE_NT)
w32_unicode_gui = 1;
else
w32_unicode_gui = 0;
diff --git a/src/w32heap.c b/src/w32heap.c
index e002f72608a..0f228bfb221 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -269,7 +269,7 @@ init_heap (bool use_dynamic_heap)
}
#endif
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
{
the_malloc_fn = malloc_after_dump_9x;
the_realloc_fn = realloc_after_dump_9x;
@@ -312,7 +312,7 @@ init_heap (bool use_dynamic_heap)
}
heap = s_pfn_Rtl_Create_Heap (0, data_region_base, 0, 0, NULL, &params);
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
{
fprintf (stderr, "Cannot dump Emacs on Windows 9X; exiting.\n");
exit (-1);
diff --git a/src/w32inevt.c b/src/w32inevt.c
index 1a80a001974..1255072b7f3 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -608,9 +608,7 @@ resize_event (WINDOW_BUFFER_SIZE_RECORD *event)
{
struct frame *f = get_frame ();
- change_frame_size (f, event->dwSize.X, event->dwSize.Y
- - FRAME_MENU_BAR_LINES (f)
- - FRAME_TAB_BAR_LINES (f), 0, 1, 0, 0);
+ change_frame_size (f, event->dwSize.X, event->dwSize.Y, false, true, false);
SET_FRAME_GARBAGED (f);
}
@@ -624,11 +622,9 @@ maybe_generate_resize_event (void)
/* It is okay to call this unconditionally, since it will do nothing
if the size hasn't actually changed. */
- change_frame_size (f,
- 1 + info.srWindow.Right - info.srWindow.Left,
- 1 + info.srWindow.Bottom - info.srWindow.Top
- - FRAME_MENU_BAR_LINES (f)
- - FRAME_TAB_BAR_LINES (f), 0, 1, 0, 0);
+ change_frame_size (f, 1 + info.srWindow.Right - info.srWindow.Left,
+ 1 + info.srWindow.Bottom - info.srWindow.Top,
+ false, true, false);
}
#if HAVE_W32NOTIFY
diff --git a/src/w32notify.c b/src/w32notify.c
index b9e90633923..889fd9f3c9f 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -566,7 +566,7 @@ generate notifications correctly, though. */)
CHECK_LIST (filter);
/* The underlying features are available only since XP. */
- if (os_subtype == OS_9X
+ if (os_subtype == OS_SUBTYPE_9X
|| (w32_major_version == 5 && w32_minor_version < 1))
{
errno = ENOSYS;
diff --git a/src/w32proc.c b/src/w32proc.c
index 2b6cb9c1e1d..702ea122e65 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -623,7 +623,7 @@ init_timers (void)
need to probe for its availability dynamically, and call it
through a pointer. */
s_pfn_Get_Thread_Times = NULL; /* in case dumped Emacs comes with a value */
- if (os_subtype != OS_9X)
+ if (os_subtype != OS_SUBTYPE_9X)
s_pfn_Get_Thread_Times = (GetThreadTimes_Proc)
get_proc_addr (GetModuleHandle ("kernel32.dll"), "GetThreadTimes");
@@ -1918,7 +1918,8 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp)
{
program = build_string (cmdname);
full = Qnil;
- openp (Vexec_path, program, Vexec_suffixes, &full, make_fixnum (X_OK), 0);
+ openp (Vexec_path, program, Vexec_suffixes, &full, make_fixnum (X_OK),
+ 0, 0);
if (NILP (full))
{
errno = EINVAL;
@@ -2653,7 +2654,7 @@ find_child_console (HWND hwnd, LPARAM arg)
GetClassName (hwnd, window_class, sizeof (window_class));
if (strcmp (window_class,
- (os_subtype == OS_9X)
+ (os_subtype == OS_SUBTYPE_9X)
? "tty"
: "ConsoleWindowClass") == 0)
{
@@ -2877,7 +2878,7 @@ sys_kill (pid_t pid, int sig)
if (NILP (Vw32_start_process_share_console) && cp && cp->hwnd)
{
#if 1
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
{
/*
Another possibility is to try terminating the VDM out-right by
@@ -3792,7 +3793,7 @@ w32_compare_strings (const char *s1, const char *s2, char *locname,
if (!g_b_init_compare_string_w)
{
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
{
pCompareStringW = (CompareStringW_Proc)
get_proc_addr (LoadLibrary ("Unicows.dll"),
@@ -3877,6 +3878,14 @@ w32_compare_strings (const char *s1, const char *s2, char *locname,
return val - 2;
}
+DEFUN ("w32-get-nproc", Fw32_get_nproc,
+ Sw32_get_nproc, 0, 0, 0,
+ doc: /* Return the number of system's processor execution units. */)
+ (void)
+{
+ return make_fixnum (w32_get_nproc ());
+}
+
void
syms_of_ntproc (void)
@@ -3911,6 +3920,8 @@ syms_of_ntproc (void)
defsubr (&Sw32_get_keyboard_layout);
defsubr (&Sw32_set_keyboard_layout);
+ defsubr (&Sw32_get_nproc);
+
DEFVAR_LISP ("w32-quote-process-args", Vw32_quote_process_args,
doc: /* Non-nil enables quoting of process arguments to ensure correct parsing.
Because Windows does not directly pass argv arrays to child processes,
diff --git a/src/w32select.c b/src/w32select.c
index 85f8e5556a2..f19b85a2aec 100644
--- a/src/w32select.c
+++ b/src/w32select.c
@@ -1207,7 +1207,7 @@ globals_of_w32select (void)
QANSICP = coding_from_cp (ANSICP);
QOEMCP = coding_from_cp (OEMCP);
- if (os_subtype == OS_NT)
+ if (os_subtype == OS_SUBTYPE_NT)
Vselection_coding_system = Qutf_16le_dos;
else if (inhibit_window_system)
Vselection_coding_system = QOEMCP;
diff --git a/src/w32term.c b/src/w32term.c
index 0ee805a8526..ad4d1a32829 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -1916,7 +1916,7 @@ w32_draw_image_foreground (struct glyph_string *s)
/* HALFTONE produces better results, especially when
scaling to a larger size, but Windows 9X doesn't
support HALFTONE. */
- if (os_subtype == OS_NT
+ if (os_subtype == OS_SUBTYPE_NT
&& (pmode = SetStretchBltMode (s->hdc, HALFTONE)) != 0)
SetBrushOrgEx (s->hdc, 0, 0, NULL);
StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height,
@@ -1952,7 +1952,7 @@ w32_draw_image_foreground (struct glyph_string *s)
{
int pmode = 0;
/* Windows 9X doesn't support HALFTONE. */
- if (os_subtype == OS_NT
+ if (os_subtype == OS_SUBTYPE_NT
&& (pmode = SetStretchBltMode (s->hdc, HALFTONE)) != 0)
SetBrushOrgEx (s->hdc, 0, 0, NULL);
StretchBlt (s->hdc, x, y, s->slice.width, s->slice.height,
@@ -2031,8 +2031,11 @@ w32_draw_image_relief (struct glyph_string *s)
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
{
- thick = tool_bar_button_relief >= 0 ? tool_bar_button_relief
- : DEFAULT_TOOL_BAR_BUTTON_RELIEF;
+ thick = (tab_bar_button_relief < 0
+ ? DEFAULT_TAB_BAR_BUTTON_RELIEF
+ : (tool_bar_button_relief < 0
+ ? DEFAULT_TOOL_BAR_BUTTON_RELIEF
+ : min (tool_bar_button_relief, 1000000)));
raised_p = s->hl == DRAW_IMAGE_RAISED;
}
else
@@ -2045,6 +2048,19 @@ w32_draw_image_relief (struct glyph_string *s)
y1 = y + s->slice.height - 1;
extra_x = extra_y = 0;
+ if (s->face->id == TAB_BAR_FACE_ID)
+ {
+ if (CONSP (Vtab_bar_button_margin)
+ && FIXNUMP (XCAR (Vtab_bar_button_margin))
+ && FIXNUMP (XCDR (Vtab_bar_button_margin)))
+ {
+ extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin));
+ extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin));
+ }
+ else if (FIXNUMP (Vtab_bar_button_margin))
+ extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin);
+ }
+
if (s->face->id == TOOL_BAR_FACE_ID)
{
if (CONSP (Vtool_bar_button_margin)
@@ -5336,7 +5352,7 @@ w32_read_socket (struct terminal *terminal,
if (f)
{
RECT rect;
- int /* rows, columns, */ width, height, text_width, text_height;
+ int /* rows, columns, */ width, height;
if (GetClientRect (msg.msg.hwnd, &rect)
/* GetClientRect evidently returns (0, 0, 0, 0) if
@@ -5349,23 +5365,11 @@ w32_read_socket (struct terminal *terminal,
{
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))
+ || height != FRAME_PIXEL_HEIGHT (f))
{
- change_frame_size (f, text_width, text_height, 0, 1, 0, 1);
+ change_frame_size
+ (f, width, height, false, true, false);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
f->win_gravity = NorthWestGravity;
@@ -5549,7 +5553,7 @@ w32_read_socket (struct terminal *terminal,
if (f && !FRAME_ICONIFIED_P (f) && msg.msg.wParam != SIZE_MINIMIZED)
{
RECT rect;
- int /* rows, columns, */ width, height, text_width, text_height;
+ int /* rows, columns, */ width, height;
if (GetClientRect (msg.msg.hwnd, &rect)
/* GetClientRect evidently returns (0, 0, 0, 0) if
@@ -5562,23 +5566,12 @@ w32_read_socket (struct terminal *terminal,
{
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))
+ || height != FRAME_PIXEL_HEIGHT (f))
{
- change_frame_size (f, text_width, text_height, 0, 1, 0, 1);
+ change_frame_size
+ (f, width, height, false, true, false);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
f->win_gravity = NorthWestGravity;
@@ -6251,17 +6244,15 @@ w32_new_font (struct frame *f, Lisp_Object font_object, int fontset)
FRAME_CONFIG_SCROLL_BAR_COLS (f) * unit;
}
- /* Now make the frame display the given font. */
- if (FRAME_NATIVE_WINDOW (f) != 0)
- {
- /* 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 (!FRAME_TOOLTIP_P (f))
- adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
- FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3,
- false, Qfont);
- }
+ FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f);
+
+/* 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 (FRAME_NATIVE_WINDOW (f) != 0 && !FRAME_TOOLTIP_P (f))
+ adjust_frame_size
+ (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
+ FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3, false, Qfont);
/* X version sets font of input methods here also. */
@@ -6474,7 +6465,8 @@ w32fullscreen_hook (struct frame *f)
ShowWindow (hwnd, SW_SHOWNORMAL);
else if (f->want_fullscreen == FULLSCREEN_MAXIMIZED)
{
- if (prev_fsmode == FULLSCREEN_BOTH || prev_fsmode == FULLSCREEN_WIDTH
+ if (prev_fsmode == FULLSCREEN_BOTH
+ || prev_fsmode == FULLSCREEN_WIDTH
|| prev_fsmode == FULLSCREEN_HEIGHT)
/* Make window normal since otherwise the subsequent
maximization might fail in some cases. */
@@ -6483,52 +6475,31 @@ w32fullscreen_hook (struct frame *f)
}
else if (f->want_fullscreen == FULLSCREEN_BOTH)
{
- int menu_bar_height = GetSystemMetrics (SM_CYMENU);
-
- w32_fullscreen_rect (hwnd, f->want_fullscreen,
- FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
+ w32_fullscreen_rect
+ (hwnd, f->want_fullscreen,
+ FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
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);
change_frame_size
- (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, rect.right - rect.left),
- FRAME_PIXEL_TO_TEXT_HEIGHT (f, (rect.bottom - rect.top
- - menu_bar_height)),
- 0, 1, 0, 1);
+ (f, rect.right - rect.left, rect.bottom - rect.top,
+ false, true, false);
}
else
{
ShowWindow (hwnd, SW_SHOWNORMAL);
- w32_fullscreen_rect (hwnd, f->want_fullscreen,
- FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
+ w32_fullscreen_rect
+ (hwnd, f->want_fullscreen,
+ FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top,
rect.right - rect.left, rect.bottom - rect.top, 0);
- if (f->want_fullscreen == FULLSCREEN_WIDTH)
- {
- int border_width = GetSystemMetrics (SM_CXFRAME);
-
- change_frame_size
- (f, (FRAME_PIXEL_TO_TEXT_WIDTH
- (f, rect.right - rect.left - 2 * border_width)),
- 0, 0, 1, 0, 1);
- }
- else
- {
- int border_height = GetSystemMetrics (SM_CYFRAME);
- /* Won't work for wrapped menu bar. */
- int menu_bar_height = GetSystemMetrics (SM_CYMENU);
- int title_height = GetSystemMetrics (SM_CYCAPTION);
-
- change_frame_size
- (f, 0, (FRAME_PIXEL_TO_TEXT_HEIGHT
- (f, rect.bottom - rect.top - 2 * border_height
- - title_height - menu_bar_height)),
- 0, 1, 0, 1);
- }
- }
+ change_frame_size
+ (f, rect.right - rect.left, rect.bottom - rect.top,
+ false, true, false);
+ }
f->want_fullscreen = FULLSCREEN_NONE;
unblock_input ();
@@ -6543,16 +6514,14 @@ w32fullscreen_hook (struct frame *f)
f->want_fullscreen |= FULLSCREEN_WAIT;
}
-/* Call this to change the size of frame F's native window.
- If CHANGE_GRAVITY, change to top-left-corner window gravity
- for this size change and subsequent size changes.
- Otherwise we leave the window gravity unchanged. */
-
+/* Change the size of frame F's Windows window to WIDTH and HEIGHT
+ pixels. If CHANGE_GRAVITY, change to top-left-corner window gravity
+ for this size change and subsequent size changes. Otherwise leave
+ the window gravity unchanged. */
static void
w32_set_window_size (struct frame *f, bool change_gravity,
- int width, int height, bool pixelwise)
+ int width, int height)
{
- int pixelwidth, pixelheight;
Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
RECT rect;
MENUBARINFO info;
@@ -6568,17 +6537,6 @@ w32_set_window_size (struct frame *f, bool change_gravity,
GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &info);
menu_bar_height = info.rcBar.bottom - info.rcBar.top;
- if (pixelwise)
- {
- pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
- pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
- }
- else
- {
- pixelwidth = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width);
- pixelheight = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height);
- }
-
if (w32_add_wrapped_menu_bar_lines)
{
/* When the menu bar wraps sending a SetWindowPos shrinks the
@@ -6594,15 +6552,15 @@ w32_set_window_size (struct frame *f, bool change_gravity,
if ((default_menu_bar_height > 0)
&& (menu_bar_height > default_menu_bar_height)
&& ((menu_bar_height % default_menu_bar_height) == 0))
- pixelheight = pixelheight + menu_bar_height - default_menu_bar_height;
+ height = height + menu_bar_height - default_menu_bar_height;
}
f->win_gravity = NorthWestGravity;
w32_wm_set_size_hint (f, (long) 0, false);
rect.left = rect.top = 0;
- rect.right = pixelwidth;
- rect.bottom = pixelheight;
+ rect.right = width;
+ rect.bottom = height;
AdjustWindowRect (&rect, f->output_data.w32->dwStyle, menu_bar_height > 0);
@@ -6620,7 +6578,7 @@ w32_set_window_size (struct frame *f, bool change_gravity,
{
rect.left = window_rect.left;
rect.right = window_rect.right;
- pixelwidth = 0;
+ width = -1;
}
if (EQ (fullscreen, Qmaximized)
|| EQ (fullscreen, Qfullboth)
@@ -6628,19 +6586,12 @@ w32_set_window_size (struct frame *f, bool change_gravity,
{
rect.top = window_rect.top;
rect.bottom = window_rect.bottom;
- pixelheight = 0;
+ height = -1;
}
}
- if (pixelwidth > 0 || pixelheight > 0)
+ if (width > 0 || height > 0)
{
- frame_size_history_add
- (f, Qx_set_window_size_1, width, height,
- list2 (Fcons (make_fixnum (pixelwidth),
- make_fixnum (pixelheight)),
- Fcons (make_fixnum (rect.right - rect.left),
- make_fixnum (rect.bottom - rect.top))));
-
if (!FRAME_PARENT_FRAME (f))
my_set_window_pos (FRAME_W32_WINDOW (f), NULL,
0, 0,
@@ -6654,12 +6605,7 @@ w32_set_window_size (struct frame *f, bool change_gravity,
rect.bottom - rect.top,
SWP_NOMOVE | SWP_NOACTIVATE);
- change_frame_size (f,
- ((pixelwidth == 0)
- ? 0 : FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth)),
- ((pixelheight == 0)
- ? 0 : FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight)),
- 0, 1, 0, 1);
+ change_frame_size (f, width, height, false, true, false);
SET_FRAME_GARBAGED (f);
/* If cursor was outside the new size, mark it as off. */
@@ -6698,7 +6644,7 @@ frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y)
/* When "mouse trails" are in effect, moving the mouse cursor
sometimes leaves behind an annoying "ghost" of the pointer.
Avoid that by momentarily switching off mouse trails. */
- if (os_subtype == OS_NT
+ if (os_subtype == OS_SUBTYPE_NT
&& w32_major_version + w32_minor_version >= 6)
ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0);
SetCursorPos (pt.x, pt.y);
@@ -7692,7 +7638,7 @@ specified by `file-name-coding-system'.
This variable is set to non-nil by default when Emacs runs on Windows
systems of the NT family, including W2K, XP, Vista, Windows 7 and
Windows 8. It is set to nil on Windows 9X. */);
- if (os_subtype == OS_9X)
+ if (os_subtype == OS_SUBTYPE_9X)
w32_unicode_filenames = 0;
else
w32_unicode_filenames = 1;
diff --git a/src/w32term.h b/src/w32term.h
index 7d351df871d..160be357821 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -761,7 +761,7 @@ extern bool w32_image_rotations_p (void);
extern void setup_w32_kbdhook (void);
extern void remove_w32_kbdhook (void);
extern int check_w32_winkey_state (int);
-#define w32_kbdhook_active (os_subtype != OS_9X)
+#define w32_kbdhook_active (os_subtype != OS_SUBTYPE_9X)
#else
#define w32_kbdhook_active 0
#endif
diff --git a/src/widget.c b/src/widget.c
index 43f0307b4e0..dd43fd1c466 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -169,14 +169,6 @@ pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height
}
static void
-pixel_to_text_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *text_width, int *text_height)
-{
- struct frame *f = ew->emacs_frame.frame;
- *text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, (int) pixel_width);
- *text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, (int) pixel_height);
-}
-
-static void
char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height)
{
struct frame *f = ew->emacs_frame.frame;
@@ -257,27 +249,14 @@ set_frame_size (EmacsFrame ew)
*/
- /* Hairily merged geometry */
struct frame *f = ew->emacs_frame.frame;
- int w = FRAME_COLS (f);
- int h = FRAME_LINES (f);
- Widget wmshell = get_wm_shell ((Widget) ew);
- Dimension pixel_width, pixel_height;
- /* Each Emacs shell is now independent and top-level. */
-
- if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
-
- char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
- ew->core.width = (frame_resize_pixelwise
- ? FRAME_PIXEL_WIDTH (f)
- : pixel_width);
- ew->core.height = (frame_resize_pixelwise
- ? FRAME_PIXEL_HEIGHT (f)
- : pixel_height);
-
- frame_size_history_add
- (f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
- list2i (ew->core.width, ew->core.height));
+
+ ew->core.width = FRAME_PIXEL_WIDTH (f);
+ ew->core.height = FRAME_PIXEL_HEIGHT (f);
+
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("set_frame_size"));
}
static void
@@ -350,6 +329,13 @@ update_from_various_frame_slots (EmacsFrame ew)
ew->emacs_frame.foreground_pixel = FRAME_FOREGROUND_PIXEL (f);
ew->emacs_frame.cursor_color = x->cursor_pixel;
ew->core.border_pixel = x->border_pixel;
+
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("update_from_various_frame_slots"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ ew->core.width, ew->core.height,
+ f->new_width, f->new_height);
}
static void
@@ -381,6 +367,7 @@ static void
EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs)
{
EmacsFrame ew = (EmacsFrame) widget;
+ struct frame *f = ew->emacs_frame.frame;
/* This used to contain SubstructureRedirectMask, but this turns out
to be a problem with XIM on Solaris, and events from that mask
@@ -394,6 +381,11 @@ EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs
/* Some ConfigureNotify events does not end up in EmacsFrameResize so
make sure we get them all. Seen with xfcwm4 for example. */
XtAddRawEventHandler (widget, StructureNotifyMask, False, resize_cb, NULL);
+
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("EmacsFrameRealize"));
+
update_wm_hints (ew);
}
@@ -408,18 +400,15 @@ EmacsFrameResize (Widget widget)
{
EmacsFrame ew = (EmacsFrame) widget;
struct frame *f = ew->emacs_frame.frame;
- int width, height;
-
- pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
- frame_size_history_add
- (f, QEmacsFrameResize, width, height,
- list5 (make_fixnum (ew->core.width), make_fixnum (ew->core.height),
- make_fixnum (FRAME_TOP_MARGIN_HEIGHT (f)),
- make_fixnum (FRAME_SCROLL_BAR_AREA_HEIGHT (f)),
- make_fixnum (2 * FRAME_INTERNAL_BORDER_WIDTH (f))));
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("EmacsFrameResize"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ ew->core.width, ew->core.height,
+ f->new_width, f->new_height);
- change_frame_size (f, width, height, 0, 1, 0, 1);
+ change_frame_size (f, ew->core.width, ew->core.height, false, true, false);
update_wm_hints (ew);
update_various_frame_slots (ew);
@@ -463,9 +452,17 @@ EmacsFrameSetCharSize (Widget widget, int columns, int rows)
EmacsFrame ew = (EmacsFrame) widget;
struct frame *f = ew->emacs_frame.frame;
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("EmacsFrameSetCharSize"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ columns, rows,
+ f->new_width, f->new_height);
+
if (!frame_inhibit_resize (f, 0, Qfont)
&& !frame_inhibit_resize (f, 1, Qfont))
- x_set_window_size (f, 0, columns, rows, 0);
+ x_set_window_size (f, 0, columns * FRAME_COLUMN_WIDTH (f),
+ rows * FRAME_LINE_HEIGHT (f));
}
diff --git a/src/window.c b/src/window.c
index eb16e2a4338..a6e8ee0d534 100644
--- a/src/window.c
+++ b/src/window.c
@@ -215,20 +215,6 @@ wset_combination (struct window *w, bool horflag, Lisp_Object val)
w->horizontal = horflag;
}
-static void
-wset_update_mode_line (struct window *w)
-{
- /* If this window is the selected window on its frame, set the
- global variable update_mode_lines, so that gui_consider_frame_title
- will consider this frame's title for redisplay. */
- Lisp_Object fselected_window = XFRAME (WINDOW_FRAME (w))->selected_window;
-
- if (WINDOWP (fselected_window) && XWINDOW (fselected_window) == w)
- update_mode_lines = 42;
- else
- w->update_mode_line = true;
-}
-
/* True if leaf window W doesn't reflect the actual state
of displayed buffer due to its text or overlays change. */
@@ -482,6 +468,7 @@ Return WINDOW. */)
else
{
fset_selected_window (XFRAME (frame), window);
+ /* Don't clear FRAME's select_mini_window_flag here. */
return window;
}
}
@@ -518,10 +505,21 @@ select_window (Lisp_Object window, Lisp_Object norecord,
{
struct window *w;
struct frame *sf;
+ Lisp_Object frame;
+ struct frame *f;
CHECK_LIVE_WINDOW (window);
w = XWINDOW (window);
+ frame = WINDOW_FRAME (w);
+ f = XFRAME (frame);
+
+ if (FRAME_TOOLTIP_P (f))
+ /* Do not select a tooltip window (Bug#47207). */
+ error ("Cannot select a tooltip window");
+
+ /* We deinitely want to select WINDOW, not the mini-window. */
+ f->select_mini_window_flag = false;
/* Make the selected window's buffer current. */
Fset_buffer (w->contents);
@@ -542,14 +540,14 @@ select_window (Lisp_Object window, Lisp_Object norecord,
redisplay_other_windows ();
sf = SELECTED_FRAME ();
- if (XFRAME (WINDOW_FRAME (w)) != sf)
+ if (f != sf)
{
- fset_selected_window (XFRAME (WINDOW_FRAME (w)), window);
+ fset_selected_window (f, window);
/* Use this rather than Fhandle_switch_frame
so that FRAME_FOCUS_FRAME is moved appropriately as we
move around in the state where a minibuffer in a separate
frame is active. */
- Fselect_frame (WINDOW_FRAME (w), norecord);
+ Fselect_frame (frame, norecord);
/* Fselect_frame called us back so we've done all the work already. */
eassert (EQ (window, selected_window));
return window;
@@ -1725,14 +1723,16 @@ have been if redisplay had finished, do this:
DEFUN ("window-end", Fwindow_end, Swindow_end, 0, 2, 0,
doc: /* Return position at which display currently ends in WINDOW.
-WINDOW must be a live window and defaults to the selected one.
-This is updated by redisplay, when it runs to completion.
-Simply changing the buffer text or setting `window-start'
-does not update this value.
+This is the position after the final character in WINDOW.
+
+WINDOW must be a live window and defaults to the selected one. This
+is updated by redisplay, when it runs to completion. Simply changing
+the buffer text or setting `window-start' does not update this value.
+
Return nil if there is no recorded value. (This can happen if the
-last redisplay of WINDOW was preempted, and did not finish.)
-If UPDATE is non-nil, compute the up-to-date position
-if it isn't already recorded. */)
+last redisplay of WINDOW was preempted, and did not finish.) If
+UPDATE is non-nil, compute the up-to-date position if it isn't already
+recorded. */)
(Lisp_Object window, Lisp_Object update)
{
Lisp_Object value;
@@ -2556,8 +2556,13 @@ window_list (void)
if (!CONSP (Vwindow_list))
{
Lisp_Object tail, frame;
+ ptrdiff_t count = SPECPDL_INDEX ();
Vwindow_list = Qnil;
+ /* Don't allow quitting in Fnconc. Otherwise we might end up
+ with a too short Vwindow_list and Fkill_buffer not being able
+ to replace a buffer in all windows showing it (Bug#47244). */
+ specbind (Qinhibit_quit, Qt);
FOR_EACH_FRAME (tail, frame)
{
Lisp_Object arglist = Qnil;
@@ -2569,6 +2574,8 @@ window_list (void)
arglist = Fnreverse (arglist);
Vwindow_list = nconc2 (Vwindow_list, arglist);
}
+
+ unbind_to (count, Qnil);
}
return Vwindow_list;
@@ -2603,7 +2610,7 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow,
candidate_p = false;
else if (MINI_WINDOW_P (w)
&& (EQ (minibuf, Qlambda)
- || (WINDOWP (minibuf) && !EQ (minibuf, window))))
+ || (WINDOW_LIVE_P (minibuf) && !EQ (minibuf, window))))
{
/* If MINIBUF is `lambda' don't consider any mini-windows.
If it is a window, consider only that one. */
@@ -2647,7 +2654,8 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow,
candidate_p = ((EQ (XWINDOW (all_frames)->frame, w->frame)
|| (EQ (f->minibuffer_window, all_frames)
&& EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f))))
- && !is_minibuffer (0, XWINDOW (all_frames)->contents));
+ && (EQ (minibuf, Qt)
+ || !is_minibuffer (0, XWINDOW (all_frames)->contents)));
else if (FRAMEP (all_frames))
candidate_p = EQ (all_frames, w->frame);
@@ -2666,12 +2674,12 @@ decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object
Lisp_Object miniwin = XFRAME (w->frame)->minibuffer_window;
XSETWINDOW (*window, w);
- /* MINIBUF nil may or may not include minibuffers. Decide if it
- does. */
- if (NILP (*minibuf))
- *minibuf = this_minibuffer_depth (XWINDOW (miniwin)->contents)
- ? miniwin
- : Qlambda;
+ /* MINIBUF nil may or may not include minibuffer windows. Decide if
+ it does. But first make sure that this frame's minibuffer window
+ is live (Bug#47207). */
+ if (WINDOW_LIVE_P (miniwin) && NILP (*minibuf))
+ *minibuf = (this_minibuffer_depth (XWINDOW (miniwin)->contents)
+ ? miniwin : Qlambda);
else if (!EQ (*minibuf, Qt))
*minibuf = Qlambda;
@@ -2682,9 +2690,10 @@ decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object
/* ALL_FRAMES nil doesn't specify which frames to include. */
if (NILP (*all_frames))
*all_frames
- = (!EQ (*minibuf, Qlambda)
- ? FRAME_MINIBUF_WINDOW (XFRAME (w->frame))
- : Qnil);
+ /* Once more make sure that this frame's minibuffer window is live
+ before including it (Bug#47207). */
+ = ((WINDOW_LIVE_P (miniwin) && !EQ (*minibuf, Qlambda))
+ ? miniwin : Qnil);
else if (EQ (*all_frames, Qvisible))
;
else if (EQ (*all_frames, make_fixnum (0)))
@@ -2705,6 +2714,8 @@ static Lisp_Object
next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames,
bool next_p)
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
decode_next_window_args (&window, &minibuf, &all_frames);
/* If ALL_FRAMES is a frame, and WINDOW isn't on that frame, just
@@ -2713,6 +2724,9 @@ next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames,
&& !EQ (all_frames, XWINDOW (window)->frame))
return Fframe_first_window (all_frames);
+ /* Don't allow quitting in Fmemq. */
+ specbind (Qinhibit_quit, Qt);
+
if (next_p)
{
Lisp_Object list;
@@ -2762,6 +2776,8 @@ next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames,
window = candidate;
}
+ unbind_to (count, Qnil);
+
return window;
}
@@ -2852,10 +2868,14 @@ static Lisp_Object
window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
{
Lisp_Object tail, list, rest;
+ ptrdiff_t count = SPECPDL_INDEX ();
decode_next_window_args (&window, &minibuf, &all_frames);
list = Qnil;
+ /* Don't allow quitting in Fmemq and Fnconc. */
+ specbind (Qinhibit_quit, Qt);
+
for (tail = window_list (); CONSP (tail); tail = XCDR (tail))
if (candidate_window_p (XCAR (tail), window, minibuf, all_frames))
list = Fcons (XCAR (tail), list);
@@ -2870,6 +2890,9 @@ window_list_1 (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames)
XSETCDR (tail, Qnil);
list = nconc2 (rest, list);
}
+
+ unbind_to (count, Qnil);
+
return list;
}
@@ -3225,6 +3248,9 @@ window-start value is reasonable when this function is called. */)
if (EQ (selected_frame, w->frame))
Fselect_window (window, Qnil);
else
+ /* Do not clear f->select_mini_window_flag here. If the
+ last selected window on F was an active minibuffer, we
+ want to return to it on a later Fselect_frame. */
fset_selected_window (f, window);
}
}
@@ -5124,37 +5150,23 @@ Signal an error when WINDOW is the only window on its frame. */)
adjust_frame_glyphs (f);
if (!WINDOW_LIVE_P (FRAME_SELECTED_WINDOW (f)))
- /* We deleted the frame's selected window. */
+ /* We apparently deleted the frame's selected window; use the
+ frame's first window as substitute but don't record it yet.
+ `delete-window' may have something better up its sleeves. */
{
/* Use the frame's first window as fallback ... */
Lisp_Object new_selected_window = Fframe_first_window (frame);
- /* ... but preferably use its most recently used window. */
- Lisp_Object mru_window;
- /* `get-mru-window' might fail for some reason so play it safe
- - promote the first window _without recording it_ first. */
if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
Fselect_window (new_selected_window, Qt);
else
- fset_selected_window (f, new_selected_window);
-
- unblock_input ();
-
- /* Now look whether `get-mru-window' gets us something. */
- mru_window = call1 (Qget_mru_window, frame);
- if (WINDOW_LIVE_P (mru_window)
- && EQ (XWINDOW (mru_window)->frame, frame))
- new_selected_window = mru_window;
-
- /* If all ended up well, we now promote the mru window. */
- if (EQ (FRAME_SELECTED_WINDOW (f), selected_window))
- Fselect_window (new_selected_window, Qnil);
- else
+ /* Do not clear f->select_mini_window_flag here. If the
+ last selected window on F was an active minibuffer, we
+ want to return to it on a later Fselect_frame. */
fset_selected_window (f, new_selected_window);
}
- else
- unblock_input ();
+ unblock_input ();
FRAME_WINDOW_CHANGE (f) = true;
}
else
@@ -6864,19 +6876,22 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config
}
DEFUN ("set-window-configuration", Fset_window_configuration,
- Sset_window_configuration, 1, 2, 0,
+ Sset_window_configuration, 1, 3, 0,
doc: /* Set the configuration of windows and buffers as specified by CONFIGURATION.
CONFIGURATION must be a value previously returned
by `current-window-configuration' (which see).
Normally, this function selects the frame of the CONFIGURATION, but if
DONT-SET-FRAME is non-nil, it leaves selected the frame which was
-current at the start of the function.
+current at the start of the function. If DONT-SET-MINIWINDOW is non-nil,
+the mini-window of the frame doesn't get set to the corresponding element
+of CONFIGURATION.
If CONFIGURATION was made from a frame that is now deleted,
only frame-independent values can be restored. In this case,
the return value is nil. Otherwise the value is t. */)
- (Lisp_Object configuration, Lisp_Object dont_set_frame)
+ (Lisp_Object configuration, Lisp_Object dont_set_frame,
+ Lisp_Object dont_set_miniwindow)
{
register struct save_window_data *data;
struct Lisp_Vector *saved_windows;
@@ -6958,7 +6973,8 @@ the return value is nil. Otherwise the value is t. */)
if (BUFFERP (w->contents)
&& !EQ (w->contents, p->buffer)
- && BUFFER_LIVE_P (XBUFFER (p->buffer)))
+ && BUFFER_LIVE_P (XBUFFER (p->buffer))
+ && (NILP (Fminibufferp (p->buffer, Qnil))))
/* If a window we restore gets another buffer, record the
window's old buffer. */
call1 (Qrecord_window_buffer, window);
@@ -7086,8 +7102,10 @@ the return value is nil. Otherwise the value is t. */)
}
}
- if (BUFFERP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
- /* If saved buffer is alive, install it. */
+ if ((NILP (dont_set_miniwindow) || !MINI_WINDOW_P (w))
+ && BUFFERP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
+ /* If saved buffer is alive, install it, unless it's a
+ minibuffer we explicitly prohibit. */
{
wset_buffer (w, p->buffer);
w->start_at_line_beg = !NILP (p->start_at_line_beg);
@@ -7240,9 +7258,11 @@ void
restore_window_configuration (Lisp_Object configuration)
{
if (CONSP (configuration))
- Fset_window_configuration (XCDR (configuration), XCAR (configuration));
+ Fset_window_configuration (XCAR (configuration),
+ Fcar_safe (XCDR (configuration)),
+ Fcar_safe (Fcdr_safe (XCDR (configuration))));
else
- Fset_window_configuration (configuration, Qnil);
+ Fset_window_configuration (configuration, Qnil, Qnil);
}
@@ -8134,7 +8154,7 @@ init_window_once (void)
minibuf_selected_window = Qnil;
staticpro (&minibuf_selected_window);
- pdumper_do_now_and_after_load (init_window_once_for_pdumper);
+ pdumper_do_now_and_after_late_load (init_window_once_for_pdumper);
}
static void init_window_once_for_pdumper (void)
@@ -8224,6 +8244,7 @@ syms_of_window (void)
DEFSYM (Qmode_line_format, "mode-line-format");
DEFSYM (Qheader_line_format, "header-line-format");
DEFSYM (Qtab_line_format, "tab-line-format");
+ DEFSYM (Qno_other_window, "no-other-window");
DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function,
doc: /* Non-nil means call as function to display a help buffer.
diff --git a/src/window.h b/src/window.h
index 79eb44e7a38..2400c422c15 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1120,10 +1120,6 @@ void set_window_buffer (Lisp_Object window, Lisp_Object buffer,
extern Lisp_Object echo_area_window;
-/* Depth in recursive edits. */
-
-extern EMACS_INT command_loop_level;
-
/* Non-zero if we should redraw the mode lines on the next redisplay.
Usually set to a unique small integer so we can track the main causes of
full redisplays in `redisplay--mode-lines-cause'. */
@@ -1145,6 +1141,7 @@ extern void wset_redisplay (struct window *w);
extern void fset_redisplay (struct frame *f);
extern void bset_redisplay (struct buffer *b);
extern void bset_update_mode_line (struct buffer *b);
+extern void wset_update_mode_line (struct window *w);
/* Call this to tell redisplay to look for other windows than selected-window
that need to be redisplayed. Calling one of the *set_redisplay functions
above already does it, so it's only needed in unusual cases. */
diff --git a/src/xdisp.c b/src/xdisp.c
index 1815f986781..e853c8c2232 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -869,6 +869,19 @@ bset_update_mode_line (struct buffer *b)
b->text->redisplay = true;
}
+void
+wset_update_mode_line (struct window *w)
+{
+ w->update_mode_line = true;
+ /* When a window's mode line needs to be updated, the window's frame's
+ title may also need to be updated, but we don't need to worry about it
+ here. Instead, `gui_consider_frame_title' is automatically called
+ whenever w->update_mode_line is set for that frame's selected window.
+ But for this to work reliably, we have to make sure the window
+ is considered, so we have to mark it for redisplay. */
+ wset_redisplay (w);
+}
+
DEFUN ("set-buffer-redisplay", Fset_buffer_redisplay,
Sset_buffer_redisplay, 4, 4, 0,
doc: /* Mark the current buffer for redisplay.
@@ -4459,7 +4472,13 @@ face_at_pos (const struct it *it, enum lface_attribute_index attr_filter)
static enum prop_handled
handle_face_prop (struct it *it)
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ /* Don't allow the user to quit out of face-merging code, in case
+ this is called when redisplaying a non-selected window, with
+ point temporarily moved to window-point. */
+ specbind (Qinhibit_quit, Qt);
const int new_face_id = face_at_pos (it, 0);
+ unbind_to (count, Qnil);
/* Is this a start of a run of characters with box face?
@@ -4544,11 +4563,13 @@ face_before_or_after_it_pos (struct it *it, bool before_p)
ptrdiff_t bufpos, charpos;
int base_face_id;
- /* No face change past the end of the string (for the case
- we are padding with spaces). No face change before the
- string start. */
+ /* No face change past the end of the string (for the case we
+ are padding with spaces). No face change before the string
+ start. Ignore face changes before the first visible
+ character on this display line. */
if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string)
- || (IT_STRING_CHARPOS (*it) == 0 && before_p))
+ || (IT_STRING_CHARPOS (*it) == 0 && before_p)
+ || it->current_x <= it->first_visible_x)
return it->face_id;
if (!it->bidi_p)
@@ -4567,51 +4588,48 @@ face_before_or_after_it_pos (struct it *it, bool before_p)
}
else
{
- if (before_p)
- {
- /* With bidi iteration, the character before the current
- in the visual order cannot be found by simple
- iteration, because "reverse" reordering is not
- supported. Instead, we need to start from the string
- beginning and go all the way to the current string
- position, remembering the previous position. */
- /* Ignore face changes before the first visible
- character on this display line. */
- if (it->current_x <= it->first_visible_x)
- return it->face_id;
- SAVE_IT (it_copy, *it, it_copy_data);
- IT_STRING_CHARPOS (it_copy) = 0;
- bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it);
+ /* With bidi iteration, the character before the current in
+ the visual order cannot be found by simple iteration,
+ because "reverse" reordering is not supported. Instead,
+ we need to start from the string beginning and go all the
+ way to the current string position, remembering the
+ visually-previous position. We need to start from the
+ string beginning for the character after the current as
+ well, since the iterator state in IT may have been
+ pushed, and the bidi cache is no longer coherent with the
+ string's text. */
+ SAVE_IT (it_copy, *it, it_copy_data);
+ IT_STRING_CHARPOS (it_copy) = 0;
+ bidi_init_it (0, 0, FRAME_WINDOW_P (it_copy.f), &it_copy.bidi_it);
+ it_copy.bidi_it.scan_dir = 0;
- do
- {
- charpos = IT_STRING_CHARPOS (it_copy);
- if (charpos >= SCHARS (it->string))
- break;
- bidi_move_to_visually_next (&it_copy.bidi_it);
- }
- while (IT_STRING_CHARPOS (it_copy) != IT_STRING_CHARPOS (*it));
-
- RESTORE_IT (it, it, it_copy_data);
+ do
+ {
+ charpos = it_copy.bidi_it.charpos;
+ if (charpos >= SCHARS (it->string))
+ break;
+ bidi_move_to_visually_next (&it_copy.bidi_it);
}
- else
+ while (it_copy.bidi_it.charpos != IT_STRING_CHARPOS (*it));
+
+ if (!before_p)
{
/* Set charpos to the string position of the character
that comes after IT's current position in the visual
order. */
int n = (it->what == IT_COMPOSITION ? it->cmp_it.nchars : 1);
-
- it_copy = *it;
- /* If this is the first display element,
+ /* If this is the first string character,
bidi_move_to_visually_next will deliver character at
current position without moving, so we need to enlarge N. */
- if (it->bidi_it.first_elt)
+ if (it_copy.bidi_it.first_elt)
n++;
while (n--)
bidi_move_to_visually_next (&it_copy.bidi_it);
charpos = it_copy.bidi_it.charpos;
}
+
+ RESTORE_IT (it, it, it_copy_data);
}
eassert (0 <= charpos && charpos <= SCHARS (it->string));
@@ -5770,8 +5788,15 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
#ifdef HAVE_WINDOW_SYSTEM
else
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
it->what = IT_IMAGE;
+ /* Don't allow quitting from lookup_image, for when we are
+ displaying a non-selected window, and the buffer's point
+ was temporarily moved to the window-point. */
+ specbind (Qinhibit_quit, Qt);
it->image_id = lookup_image (it->f, value, it->face_id);
+ unbind_to (count, Qnil);
it->position = start_pos;
it->object = NILP (object) ? it->w->contents : object;
it->method = GET_FROM_IMAGE;
@@ -9227,10 +9252,10 @@ move_it_in_display_line_to (struct it *it,
|| prev_method == GET_FROM_STRING)
/* Passed TO_CHARPOS from left to right. */
&& ((prev_pos < to_charpos
- && IT_CHARPOS (*it) > to_charpos)
+ && IT_CHARPOS (*it) >= to_charpos)
/* Passed TO_CHARPOS from right to left. */
|| (prev_pos > to_charpos
- && IT_CHARPOS (*it) < to_charpos)))))
+ && IT_CHARPOS (*it) <= to_charpos)))))
{
if (it->line_wrap != WORD_WRAP || wrap_it.sp < 0)
{
@@ -10049,7 +10074,22 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos
it->continuation_lines_width = 0;
reseat_at_next_visible_line_start (it, false);
if ((op & MOVE_TO_POS) != 0
- && IT_CHARPOS (*it) > to_charpos)
+ && (IT_CHARPOS (*it) > to_charpos
+ || (IT_CHARPOS (*it) == to_charpos
+ /* Consider TO_CHARPOS as REACHED if we are at
+ EOB that ends in something other than a newline. */
+ && to_charpos == ZV
+ && (ZV_BYTE <= 1 || FETCH_BYTE (ZV_BYTE - 1) != '\n')
+ /* But if we have a display or an overlay string
+ at EOB, keep going until we exhaust all the
+ characters of the string(s). */
+ && (it->sp == 0
+ || (STRINGP (it->string)
+ && (it->current.overlay_string_index < 0
+ || (it->current.overlay_string_index >= 0
+ && it->current.overlay_string_index
+ >= it->n_overlay_strings - 1))
+ && IT_STRING_CHARPOS (*it) >= it->end_charpos)))))
{
reached = 9;
goto out;
@@ -10767,6 +10807,9 @@ include the height of both, if present, in the return value. */)
it.max_descent = max (it.max_descent, it.descent);
}
}
+ else
+ bidi_unshelve_cache (it2data, true);
+
if (!NILP (x_limit))
{
/* Don't return more than X-LIMIT. */
@@ -10810,6 +10853,47 @@ include the height of both, if present, in the return value. */)
return Fcons (make_fixnum (x - start_x), make_fixnum (y));
}
+
+DEFUN ("display--line-is-continued-p", Fdisplay__line_is_continued_p,
+ Sdisplay__line_is_continued_p, 0, 0, 0,
+ doc: /* Return non-nil if the current screen line is continued on display. */)
+ (void)
+{
+ struct buffer *oldb = current_buffer;
+ struct window *w = XWINDOW (selected_window);
+ enum move_it_result rc = MOVE_POS_MATCH_OR_ZV;
+
+ set_buffer_internal_1 (XBUFFER (w->contents));
+
+ if (PT < ZV)
+ {
+ struct text_pos startpos;
+ struct it it;
+ void *itdata;
+ /* Use a marker, since vertical-motion enters redisplay, which can
+ trigger fontifications, which in turn could modify buffer text. */
+ Lisp_Object opoint = Fpoint_marker ();
+
+ /* Make sure to start from the beginning of the current screen
+ line, so that move_it_in_display_line_to counts pixels correctly. */
+ Fvertical_motion (make_fixnum (0), selected_window, Qnil);
+ SET_TEXT_POS (startpos, PT, PT_BYTE);
+ itdata = bidi_shelve_cache ();
+ start_display (&it, w, startpos);
+ /* If lines are truncated, no line is continued. */
+ if (it.line_wrap != TRUNCATE)
+ {
+ it.glyph_row = NULL;
+ rc = move_it_in_display_line_to (&it, ZV, -1, MOVE_TO_POS);
+ }
+ SET_PT_BOTH (marker_position (opoint), marker_byte_position (opoint));
+ bidi_unshelve_cache (itdata, false);
+ }
+ set_buffer_internal_1 (oldb);
+
+ return rc == MOVE_LINE_CONTINUED ? Qt : Qnil;
+}
+
/***********************************************************************
Messages
@@ -11687,7 +11771,7 @@ display_echo_area (struct window *w)
/* If there is no message, we must call display_echo_area_1
nevertheless because it resizes the window. But we will have to
reset the echo_area_buffer in question to nil at the end because
- with_echo_area_buffer will sets it to an empty buffer. */
+ with_echo_area_buffer will set it to an empty buffer. */
bool i = display_last_displayed_message_p;
/* According to the C99, C11 and C++11 standards, the integral value
of a "bool" is always 0 or 1, so this array access is safe here,
@@ -11832,7 +11916,7 @@ resize_mini_window (struct window *w, bool exact_p)
int height, max_height;
struct text_pos start;
struct buffer *old_current_buffer = NULL;
- int windows_height = FRAME_WINDOWS_HEIGHT (f);
+ int windows_height = FRAME_INNER_HEIGHT (f);
if (current_buffer != XBUFFER (w->contents))
{
@@ -11854,18 +11938,27 @@ resize_mini_window (struct window *w, bool exact_p)
max_height = clip_to_bounds (unit, max_height, windows_height);
/* Find out the height of the text in the window. */
- if (it.line_wrap == TRUNCATE)
- height = unit;
- else
- {
- last_height = 0;
- move_it_to (&it, ZV, -1, -1, -1, MOVE_TO_POS);
- if (it.max_ascent == 0 && it.max_descent == 0)
- height = it.current_y + last_height;
- else
- height = it.current_y + it.max_ascent + it.max_descent;
- height -= min (it.extra_line_spacing, it.max_extra_line_spacing);
+ last_height = 0;
+ move_it_to (&it, ZV, -1, -1, -1, MOVE_TO_POS);
+ /* If move_it_to moved to the next visible line after EOB,
+ account for the height of the last full line. */
+ if (it.max_ascent == 0 && it.max_descent == 0)
+ {
+ height = it.current_y;
+ /* Don't add the last line's height if lines are truncated
+ and the text doesn't end in a newline.
+ FIXME: if the text ends in a newline from a display
+ property or an overlay string, they lose: the mini-window
+ might not show the last empty line. */
+ if (!(it.line_wrap == TRUNCATE
+ && it.current_x <= it.first_visible_x
+ && ZV_BYTE > 1
+ && FETCH_BYTE (ZV_BYTE - 1) != '\n'))
+ height += last_height;
}
+ else
+ height = it.current_y + it.max_ascent + it.max_descent;
+ height -= min (it.extra_line_spacing, it.max_extra_line_spacing);
/* Compute a suitable window start. */
if (height > max_height)
@@ -12638,9 +12731,8 @@ gui_consider_frame_title (Lisp_Object frame)
mode_line_noprop_buf; then display the title. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (f, current_buffer, selected_window, false));
+ (NULL, current_buffer, Qnil, false));
- Fselect_window (f->selected_window, Qt);
set_buffer_internal_1
(XBUFFER (XWINDOW (f->selected_window)->contents));
fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
@@ -13441,8 +13533,6 @@ PIXELWISE non-nil means return the height of the tab bar in pixels. */)
static bool
redisplay_tab_bar (struct frame *f)
{
- f->tab_bar_redisplayed = true;
-
struct window *w;
struct it it;
struct glyph_row *row;
@@ -13456,6 +13546,8 @@ redisplay_tab_bar (struct frame *f)
WINDOW_TOTAL_LINES (w) == 0))
return false;
+ f->tab_bar_redisplayed = true;
+
/* Set up an iterator for the tab-bar window. */
init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TAB_BAR_FACE_ID);
it.first_visible_x = 0;
@@ -13596,8 +13688,9 @@ redisplay_tab_bar (struct frame *f)
/* Get information about the tab-bar item which is displayed in GLYPH
on frame F. Return in *PROP_IDX the index where tab-bar item
- properties start in F->tab_bar_items. Value is false if
- GLYPH doesn't display a tab-bar item. */
+ properties start in F->tab_bar_items. Return in CLOSE_P an
+ indication whether the click was on the close-tab icon of the tab.
+ Value is false if GLYPH doesn't display a tab-bar item. */
static bool
tab_bar_item_info (struct frame *f, struct glyph *glyph,
@@ -13643,7 +13736,6 @@ static int
get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
int *hpos, int *vpos, int *prop_idx, bool *close_p)
{
- Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
struct window *w = XWINDOW (f->tab_bar_window);
int area;
@@ -13657,18 +13749,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph,
if (!tab_bar_item_info (f, *glyph, prop_idx, close_p))
return -1;
- /* Is mouse on the highlighted item? */
- if (EQ (f->tab_bar_window, hlinfo->mouse_face_window)
- && *vpos >= hlinfo->mouse_face_beg_row
- && *vpos <= hlinfo->mouse_face_end_row
- && (*vpos > hlinfo->mouse_face_beg_row
- || *hpos >= hlinfo->mouse_face_beg_col)
- && (*vpos < hlinfo->mouse_face_end_row
- || *hpos < hlinfo->mouse_face_end_col
- || hlinfo->mouse_face_past_end))
- return 0;
-
- return 1;
+ return *prop_idx == f->last_tab_bar_item ? 0 : 1;
}
@@ -13690,25 +13771,14 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
Lisp_Object enabled_p;
int ts;
- /* If not on the highlighted tab-bar item, and mouse-highlight is
- non-nil, return. This is so we generate the tab-bar button
- click only when the mouse button is released on the same item as
- where it was pressed. However, when mouse-highlight is disabled,
- generate the click when the button is released regardless of the
- highlight, since tab-bar items are not highlighted in that
- case. */
frame_to_window_pixel_xy (w, &x, &y);
ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
if (ts == -1
- || (ts != 0 && !NILP (Vmouse_highlight)))
+ /* If the button is released on a tab other than the one where
+ it was pressed, don't generate the tab-bar button click event. */
+ || (ts != 0 && !down_p))
return;
- /* When mouse-highlight is off, generate the click for the item
- where the button was pressed, disregarding where it was
- released. */
- if (NILP (Vmouse_highlight) && !down_p)
- prop_idx = f->last_tab_bar_item;
-
/* If item is disabled, do nothing. */
enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P);
if (NILP (enabled_p))
@@ -13716,10 +13786,10 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
if (down_p)
{
- /* Show item in pressed state. */
+ /* Show the clicked button in pressed state. */
if (!NILP (Vmouse_highlight))
show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN);
- f->last_tab_bar_item = prop_idx;
+ f->last_tab_bar_item = prop_idx; /* record the pressed tab */
}
else
{
@@ -14388,21 +14458,13 @@ PIXELWISE non-nil means return the height of the tool bar in pixels. */)
return make_fixnum (height);
}
+#ifndef HAVE_EXT_TOOL_BAR
-/* Display the tool-bar of frame F. Value is true if tool-bar's
- height should be changed. */
+/* Display the internal tool-bar of frame F. Value is true if
+ tool-bar's height should be changed. */
static bool
redisplay_tool_bar (struct frame *f)
{
- f->tool_bar_redisplayed = true;
-#ifdef HAVE_EXT_TOOL_BAR
-
- if (FRAME_EXTERNAL_TOOL_BAR (f))
- update_frame_tool_bar (f);
- return false;
-
-#else /* ! (HAVE_EXT_TOOL_BAR) */
-
struct window *w;
struct it it;
struct glyph_row *row;
@@ -14416,6 +14478,8 @@ redisplay_tool_bar (struct frame *f)
WINDOW_TOTAL_LINES (w) == 0))
return false;
+ f->tool_bar_redisplayed = true;
+
/* Set up an iterator for the tool-bar window. */
init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TOOL_BAR_FACE_ID);
it.first_visible_x = 0;
@@ -14551,13 +14615,10 @@ redisplay_tool_bar (struct frame *f)
}
f->minimize_tool_bar_window_p = false;
- return false;
-#endif /* HAVE_EXT_TOOL_BAR */
+ return false;
}
-#ifndef HAVE_EXT_TOOL_BAR
-
/* Get information about the tool-bar item which is displayed in GLYPH
on frame F. Return in *PROP_IDX the index where tool-bar item
properties start in F->tool_bar_items. Value is false if
@@ -14837,7 +14898,15 @@ hscroll_window_tree (Lisp_Object window)
if (WINDOWP (w->contents))
hscrolled_p |= hscroll_window_tree (w->contents);
- else if (w->cursor.vpos >= 0)
+ else if (w->cursor.vpos >= 0
+ /* Don't allow hscroll in mini-windows that display
+ echo-area messages. This is because desired_matrix
+ of such windows was prepared while momentarily
+ switched to an echo-area buffer, which is different
+ from w->contents, and we simply cannot hscroll such
+ windows safely. */
+ && !(w == XWINDOW (echo_area_window)
+ && !NILP (echo_area_buffer[0])))
{
int h_margin;
int text_area_width;
@@ -15035,11 +15104,12 @@ hscroll_window_tree (Lisp_Object window)
else
{
if (hscroll_relative_p)
- wanted_x = text_area_width * hscroll_step_rel
- + h_margin;
+ wanted_x =
+ text_area_width * hscroll_step_rel + h_margin + x_offset;
else
- wanted_x = hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
- + h_margin;
+ wanted_x =
+ hscroll_step_abs * FRAME_COLUMN_WIDTH (it.f)
+ + h_margin + x_offset;
hscroll
= max (0, it.current_x - wanted_x) / FRAME_COLUMN_WIDTH (it.f);
}
@@ -17227,8 +17297,11 @@ run_window_scroll_functions (Lisp_Object window, struct text_pos startp)
if (!NILP (Vwindow_scroll_functions))
{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
run_hook_with_args_2 (Qwindow_scroll_functions, window,
make_fixnum (CHARPOS (startp)));
+ unbind_to (count, Qnil);
SET_TEXT_POS_FROM_MARKER (startp, w->start);
/* In case the hook functions switch buffers. */
set_buffer_internal (XBUFFER (w->contents));
@@ -19221,7 +19294,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
w->start_at_line_beg = (CHARPOS (startp) == BEGV
|| FETCH_BYTE (BYTEPOS (startp) - 1) == '\n');
- /* Display the mode line, if we must. */
+ /* Display the mode line, header line, and tab-line, if we must. */
if ((update_mode_line
/* If window not full width, must redo its mode line
if (a) the window to its side is being redone and
@@ -19240,8 +19313,11 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
|| window_wants_header_line (w)
|| window_wants_tab_line (w)))
{
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
display_mode_lines (w);
+ unbind_to (count1, Qnil);
/* If mode line height has changed, arrange for a thorough
immediate redisplay using the correct mode line height. */
@@ -19289,7 +19365,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
finish_menu_bars:
/* When we reach a frame's selected window, redo the frame's menu
- bar and the frame's title. */
+ bar, tool bar, tab-bar, and the frame's title. */
if (update_mode_line
&& EQ (FRAME_SELECTED_WINDOW (f), window))
{
@@ -19320,7 +19396,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
#ifdef HAVE_EXT_TOOL_BAR
if (FRAME_EXTERNAL_TOOL_BAR (f))
- redisplay_tool_bar (f);
+ update_frame_tool_bar (f);
#else
if (WINDOWP (f->tool_bar_window)
&& (FRAME_TOOL_BAR_LINES (f) > 0
@@ -19452,8 +19528,11 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
'start_display' again. */
ptrdiff_t it_charpos = IT_CHARPOS (it);
- /* Don't let the cursor end in the scroll margins. */
+ /* Don't let the cursor end in the scroll margins. However, when
+ the window is vscrolled, we leave it to vscroll to handle the
+ margins, see window_scroll_pixel_based. */
if ((flags & TRY_WINDOW_CHECK_MARGINS)
+ && w->vscroll == 0
&& !MINI_WINDOW_P (w))
{
int top_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
@@ -19462,7 +19541,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags)
top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
start_display (&it, w, pos);
- if ((w->cursor.y >= 0 /* not vscrolled */
+ if ((w->cursor.y >= 0
&& w->cursor.y < top_scroll_margin
&& CHARPOS (pos) > BEGV)
/* rms: considering make_cursor_line_fully_visible_p here
@@ -22054,10 +22133,17 @@ extend_face_to_end_of_line (struct it *it)
|| WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0))
return;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* Don't allow the user to quit out of face-merging code, in case
+ this is called when redisplaying a non-selected window, with
+ point temporarily moved to window-point. */
+ specbind (Qinhibit_quit, Qt);
const int extend_face_id = (it->face_id == DEFAULT_FACE_ID
|| it->s != NULL)
? DEFAULT_FACE_ID
: face_at_pos (it, LFACE_EXTEND_INDEX);
+ unbind_to (count, Qnil);
/* Face extension extends the background and box of IT->extend_face_id
to the end of the line. If the background equals the background
@@ -22337,15 +22423,23 @@ extend_face_to_end_of_line (struct it *it)
it->face_id = (it->glyph_row->ends_at_zv_p ?
default_face->id : face->id);
- /* Display fill-column indicator if needed. */
- const int indicator_column = fill_column_indicator_column (it, 1);
-
/* Make sure our idea of current_x is in sync with the glyphs
actually in the glyph row. They might differ because
append_space_for_newline can insert one glyph without
updating current_x. */
it->current_x = it->glyph_row->used[TEXT_AREA];
+ /* The above assignment causes the code below to use a
+ non-standard semantics of it->current_x: it is measured
+ relative to the beginning of the text-area, thus disregarding
+ the window's hscroll. That is why we need to correct the
+ indicator column for the hscroll, otherwise the indicator
+ will not move together with the text as result of horizontal
+ scrolling. */
+ const int indicator_column =
+ fill_column_indicator_column (it, 1) - it->first_visible_x;
+
+ /* Display fill-column indicator if needed. */
while (it->current_x <= it->last_visible_x)
{
if (it->current_x != indicator_column)
@@ -22705,6 +22799,22 @@ get_it_property (struct it *it, Lisp_Object prop)
return Fget_char_property (position, prop, object);
}
+/* Return the line-prefix/wrap-prefix property, checking both the
+ current IT->OBJECT and the underlying buffer text. */
+
+static Lisp_Object
+get_line_prefix_it_property (struct it *it, Lisp_Object prop)
+{
+ Lisp_Object prefix = get_it_property (it, prop);
+
+ /* If we are looking at a display or overlay string, check also the
+ underlying buffer text. */
+ if (NILP (prefix) && it->sp > 0 && STRINGP (it->object))
+ return Fget_char_property (make_fixnum (IT_CHARPOS (*it)), prop,
+ it->w->contents);
+ return prefix;
+}
+
/* See if there's a line- or wrap-prefix, and if so, push it on IT. */
static void
@@ -22714,13 +22824,13 @@ handle_line_prefix (struct it *it)
if (it->continuation_lines_width > 0)
{
- prefix = get_it_property (it, Qwrap_prefix);
+ prefix = get_line_prefix_it_property (it, Qwrap_prefix);
if (NILP (prefix))
prefix = Vwrap_prefix;
}
else
{
- prefix = get_it_property (it, Qline_prefix);
+ prefix = get_line_prefix_it_property (it, Qline_prefix);
if (NILP (prefix))
prefix = Vline_prefix;
}
@@ -24103,7 +24213,8 @@ display_line (struct it *it, int cursor_vpos)
the logical order. */
if (IT_BYTEPOS (*it) > BEG_BYTE)
row->ends_at_zv_p =
- IT_BYTEPOS (*it) >= ZV_BYTE && FETCH_BYTE (ZV_BYTE - 1) != '\n';
+ IT_BYTEPOS (*it) >= ZV_BYTE
+ && (ZV_BYTE <= 1 || FETCH_BYTE (ZV_BYTE - 1) != '\n');
else
row->ends_at_zv_p = false;
break;
@@ -25352,8 +25463,9 @@ redisplay_mode_lines (Lisp_Object window, bool force)
}
-/* Display the mode and/or header line of window W. Value is the
- sum number of mode lines and header lines displayed. */
+/* Display the mode line, the header line, and the tab-line of window
+ W. Value is the sum number of mode lines, header lines, and tab
+ lines actually displayed. */
static int
display_mode_lines (struct window *w)
@@ -26933,7 +27045,7 @@ decode_mode_spec (struct window *w, register int c, int field_width,
Lisp_Object val = Qnil;
if (STRINGP (curdir))
- val = call1 (intern ("file-remote-p"), curdir);
+ val = safe_call1 (intern ("file-remote-p"), curdir);
val = unbind_to (count, val);
@@ -30240,7 +30352,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym)
/* +4 is for vertical bars of a box plus 1-pixel spaces at both side. */
width = max (metrics_upper.width, metrics_lower.width) + 4;
- upper_xoff = upper_yoff = 2; /* the typical case */
+ upper_xoff = lower_xoff = 2; /* the typical case */
if (base_width >= width)
{
/* Align the upper to the left, the lower to the right. */
@@ -30254,13 +30366,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym)
if (metrics_upper.width >= metrics_lower.width)
lower_xoff = (width - metrics_lower.width) / 2;
else
- {
- /* FIXME: This code doesn't look right. It formerly was
- missing the "lower_xoff = 0;", which couldn't have
- been right since it left lower_xoff uninitialized. */
- lower_xoff = 0;
- upper_xoff = (width - metrics_upper.width) / 2;
- }
+ upper_xoff = (width - metrics_upper.width) / 2;
}
/* +5 is for horizontal bars of a box plus 1-pixel spaces at
@@ -31968,6 +32074,11 @@ draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row,
static void
show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw)
{
+ /* Don't bother doing anything if the mouse-face window is not set
+ up. */
+ if (!WINDOWP (hlinfo->mouse_face_window))
+ return;
+
struct window *w = XWINDOW (hlinfo->mouse_face_window);
struct frame *f = XFRAME (WINDOW_FRAME (w));
@@ -33176,7 +33287,8 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
of the mode line without any text (e.g. past the right edge of
the mode line text), use that windows's mode line help echo if it
has been set. */
- if (STRINGP (string) || area == ON_MODE_LINE)
+ if (STRINGP (string) || area == ON_MODE_LINE || area == ON_HEADER_LINE
+ || area == ON_TAB_LINE)
{
/* Arrange to display the help by setting the global variables
help_echo_string, help_echo_object, and help_echo_pos. */
@@ -33233,6 +33345,19 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
}
else if (draggable && area == ON_MODE_LINE)
cursor = FRAME_OUTPUT_DATA (f)->vertical_drag_cursor;
+ else if ((area == ON_MODE_LINE
+ && WINDOW_BOTTOMMOST_P (w)
+ && !FRAME_HAS_MINIBUF_P (f)
+ && !NILP (Fframe_parameter
+ (w->frame, Qdrag_with_mode_line)))
+ || (((area == ON_HEADER_LINE
+ && !NILP (Fframe_parameter
+ (w->frame, Qdrag_with_header_line)))
+ || (area == ON_TAB_LINE
+ && !NILP (Fframe_parameter
+ (w->frame, Qdrag_with_tab_line))))
+ && WINDOW_TOPMOST_P (w)))
+ cursor = FRAME_OUTPUT_DATA (f)->hand_cursor;
else
cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor;
}
@@ -34320,7 +34445,7 @@ gui_draw_bottom_divider (struct window *w)
&& !NILP (XWINDOW (p->parent)->next))))
x1 -= WINDOW_RIGHT_DIVIDER_WIDTH (w);
- FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
+ FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
}
}
@@ -34725,6 +34850,7 @@ be let-bound around code that needs to disable messages temporarily. */);
defsubr (&Swindow_text_pixel_size);
defsubr (&Smove_point_visually);
defsubr (&Sbidi_find_overridden_directionality);
+ defsubr (&Sdisplay__line_is_continued_p);
DEFSYM (Qmenu_bar_update_hook, "menu-bar-update-hook");
DEFSYM (Qoverriding_terminal_local_map, "overriding-terminal-local-map");
@@ -34821,6 +34947,10 @@ be let-bound around code that needs to disable messages temporarily. */);
DEFSYM (Qdragging, "dragging");
DEFSYM (Qdropping, "dropping");
+ DEFSYM (Qdrag_with_mode_line, "drag-with-mode-line");
+ DEFSYM (Qdrag_with_header_line, "drag-with-header-line");
+ DEFSYM (Qdrag_with_tab_line, "drag-with-tab-line");
+
DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces");
list_of_error = list1 (list2 (Qerror, Qvoid_variable));
@@ -35315,7 +35445,7 @@ and `scroll-right' overrides this variable's effect. */);
Vhscroll_step = make_fixnum (0);
DEFVAR_BOOL ("message-truncate-lines", message_truncate_lines,
- doc: /* If non-nil, messages are truncated instead of resizing the echo area.
+ doc: /* If non-nil, messages are truncated when displaying the echo area.
Bind this around calls to `message' to let it take effect. */);
message_truncate_lines = false;
@@ -35589,8 +35719,10 @@ as usual. If the function returns a string, the returned string is
displayed in the echo area. If this function returns any other non-nil
value, this means that the message was already handled, and the original
message text will not be displayed in the echo area.
-See also `clear-message-function' that can be used to clear the
-message displayed by this function. */);
+
+Also see `clear-message-function' (which can be used to clear the
+message displayed by this function), and `command-error-function'
+(which controls how error messages are displayed). */);
Vset_message_function = Qnil;
DEFVAR_LISP ("clear-message-function", Vclear_message_function,
diff --git a/src/xfaces.c b/src/xfaces.c
index 12087138e51..207f0d6a36e 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -95,9 +95,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
with the symbol `face' in slot 0, and a slot for each of the face
attributes mentioned above.
- There is also a global face alist `Vface_new_frame_defaults'. Face
- definitions from this list are used to initialize faces of newly
- created frames.
+ There is also a global face map `Vface_new_frame_defaults',
+ containing conses of (FACE_ID . FACE_DEFINITION). Face definitions
+ from this table are used to initialize faces of newly created
+ frames.
A face doesn't have to specify all attributes. Those not specified
have a value of `unspecified'. Faces specifying all attributes but
@@ -289,7 +290,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Size of hash table of realized faces in face caches (should be a
prime number). */
-#define FACE_CACHE_BUCKETS_SIZE 1001
+#define FACE_CACHE_BUCKETS_SIZE 1009
char unspecified_fg[] = "unspecified-fg", unspecified_bg[] = "unspecified-bg";
@@ -353,10 +354,13 @@ static bool menu_face_changed_default;
struct named_merge_point;
-static struct face *realize_face (struct face_cache *, Lisp_Object *,
+static struct face *realize_face (struct face_cache *,
+ Lisp_Object [LFACE_VECTOR_SIZE],
int);
-static struct face *realize_gui_face (struct face_cache *, Lisp_Object *);
-static struct face *realize_tty_face (struct face_cache *, Lisp_Object *);
+static struct face *realize_gui_face (struct face_cache *,
+ Lisp_Object [LFACE_VECTOR_SIZE]);
+static struct face *realize_tty_face (struct face_cache *,
+ Lisp_Object [LFACE_VECTOR_SIZE]);
static bool realize_basic_faces (struct frame *);
static bool realize_default_face (struct frame *);
static void realize_named_face (struct frame *, Lisp_Object, int);
@@ -1962,13 +1966,11 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name,
Lisp_Object lface;
if (f)
- lface = assq_no_quit (face_name, f->face_alist);
+ lface = Fgethash (face_name, f->face_hash_table, Qnil);
else
- lface = assq_no_quit (face_name, Vface_new_frame_defaults);
+ lface = CDR (Fgethash (face_name, Vface_new_frame_defaults, Qnil));
- if (CONSP (lface))
- lface = XCDR (lface);
- else if (signal_p)
+ if (signal_p && NILP (lface))
signal_error ("Invalid face", face_name);
check_lface (lface);
@@ -2867,11 +2869,6 @@ Value is a vector of face attributes. */)
/* Add a global definition if there is none. */
if (NILP (global_lface))
{
- global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
- ASET (global_lface, 0, Qface);
- Vface_new_frame_defaults = Fcons (Fcons (face, global_lface),
- Vface_new_frame_defaults);
-
/* Assign the new Lisp face a unique ID. The mapping from Lisp
face id to Lisp face is given by the vector lface_id_to_name.
The mapping from Lisp face to Lisp face id is given by the
@@ -2881,9 +2878,14 @@ Value is a vector of face attributes. */)
xpalloc (lface_id_to_name, &lface_id_to_name_size, 1, MAX_FACE_ID,
sizeof *lface_id_to_name);
+ Lisp_Object face_id = make_fixnum (next_lface_id);
lface_id_to_name[next_lface_id] = face;
- Fput (face, Qface, make_fixnum (next_lface_id));
+ Fput (face, Qface, face_id);
++next_lface_id;
+
+ global_lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
+ ASET (global_lface, 0, Qface);
+ Fputhash (face, Fcons (face_id, global_lface), Vface_new_frame_defaults);
}
else if (f == NULL)
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -2896,7 +2898,7 @@ Value is a vector of face attributes. */)
{
lface = make_vector (LFACE_VECTOR_SIZE, Qunspecified);
ASET (lface, 0, Qface);
- fset_face_alist (f, Fcons (Fcons (face, lface), f->face_alist));
+ Fputhash (face, lface, f->face_hash_table);
}
else
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
@@ -3057,7 +3059,7 @@ FRAME 0 means change the face on all frames, and change the default
f = NULL;
lface = lface_from_face_name (NULL, face, true);
- /* When updating face-new-frame-defaults, we put :ignore-defface
+ /* When updating face--new-frame-defaults, we put :ignore-defface
where the caller wants `unspecified'. This forces the frame
defaults to ignore the defface value. Otherwise, the defface
will take effect, which is generally not what is intended.
@@ -3642,7 +3644,7 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param,
/* If there are no faces yet, give up. This is the case when called
from Fx_create_frame, and we do the necessary things later in
face-set-after-frame-defaults. */
- if (NILP (f->face_alist))
+ if (XFIXNAT (Fhash_table_count (f->face_hash_table)) == 0)
return;
if (EQ (param, Qforeground_color))
@@ -4308,14 +4310,13 @@ If FRAME is omitted or nil, use the selected frame. */)
return i == LFACE_VECTOR_SIZE ? Qt : Qnil;
}
-
-DEFUN ("frame-face-alist", Fframe_face_alist, Sframe_face_alist,
+DEFUN ("frame--face-hash-table", Fframe_face_hash_table, Sframe_face_hash_table,
0, 1, 0,
- doc: /* Return an alist of frame-local faces defined on FRAME.
+ doc: /* Return a hash table of frame-local faces defined on FRAME.
For internal use only. */)
(Lisp_Object frame)
{
- return decode_live_frame (frame)->face_alist;
+ return decode_live_frame (frame)->face_hash_table;
}
@@ -6034,10 +6035,11 @@ realize_gui_face (struct face_cache *cache, Lisp_Object attrs[LFACE_VECTOR_SIZE]
face->box = FACE_RAISED_BOX;
else if (EQ (value, Qpressed_button))
face->box = FACE_SUNKEN_BOX;
- else if (EQ (value, Qflat_button)) {
- face->box = FACE_SIMPLE_BOX;
- face->box_color = face->background;
- }
+ else if (EQ (value, Qflat_button))
+ {
+ face->box = FACE_SIMPLE_BOX;
+ face->box_color = face->background;
+ }
}
}
}
@@ -6831,30 +6833,32 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources,
#ifdef HAVE_PDUMPER
/* All the faces defined during loadup are recorded in
- face-new-frame-defaults, with the last face first in the list. We
- need to set next_lface_id to the next face ID number, so that any
- new faces defined in this session will have face IDs different from
- those defined during loadup. We also need to set up the
- lface_id_to_name[] array for the faces that were defined during
- loadup. */
+ face-new-frame-defaults. We need to set next_lface_id to the next
+ face ID number, so that any new faces defined in this session will
+ have face IDs different from those defined during loadup. We also
+ need to set up the lface_id_to_name[] array for the faces that were
+ defined during loadup. */
void
init_xfaces (void)
{
- if (CONSP (Vface_new_frame_defaults))
+ int nfaces = XFIXNAT (Fhash_table_count (Vface_new_frame_defaults));
+ if (nfaces > 0)
{
/* Allocate the lface_id_to_name[] array. */
- lface_id_to_name_size = next_lface_id =
- XFIXNAT (Flength (Vface_new_frame_defaults));
+ lface_id_to_name_size = next_lface_id = nfaces;
lface_id_to_name = xnmalloc (next_lface_id, sizeof *lface_id_to_name);
/* Store the faces. */
- Lisp_Object tail;
- int i = next_lface_id - 1;
- for (tail = Vface_new_frame_defaults; CONSP (tail); tail = XCDR (tail))
+ struct Lisp_Hash_Table* table = XHASH_TABLE (Vface_new_frame_defaults);
+ for (ptrdiff_t idx = 0; idx < nfaces; ++idx)
{
- Lisp_Object lface = XCAR (tail);
- eassert (i >= 0);
- lface_id_to_name[i--] = XCAR (lface);
+ Lisp_Object lface = HASH_KEY (table, idx);
+ Lisp_Object face_id = CAR (HASH_VALUE (table, idx));
+ if (FIXNATP (face_id)) {
+ int id = XFIXNAT (face_id);
+ eassert (id >= 0);
+ lface_id_to_name[id] = lface;
+ }
}
}
face_attr_sym[0] = Qface;
@@ -7010,7 +7014,7 @@ syms_of_xfaces (void)
defsubr (&Sinternal_copy_lisp_face);
defsubr (&Sinternal_merge_in_global_face);
defsubr (&Sface_font);
- defsubr (&Sframe_face_alist);
+ defsubr (&Sframe_face_hash_table);
defsubr (&Sdisplay_supports_face_attributes_p);
defsubr (&Scolor_distance);
defsubr (&Sinternal_set_font_selection_order);
@@ -7034,9 +7038,12 @@ This variable is intended for use only by code that evaluates
the "specifity" of a face specification and should be let-bound
only for this purpose. */);
- DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults,
- doc: /* List of global face definitions (for internal use only.) */);
- Vface_new_frame_defaults = Qnil;
+ DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults,
+ doc: /* Hash table of global face definitions (for internal use only.) */);
+ Vface_new_frame_defaults =
+ /* 33 entries is enough to fit all basic faces */
+ make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false);
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
doc: /* Default stipple pattern used on monochrome displays.
diff --git a/src/xfns.c b/src/xfns.c
index 481ee0e2255..81349d0b50d 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1563,7 +1563,6 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
#else /* not USE_X_TOOLKIT && not USE_GTK */
FRAME_MENU_BAR_LINES (f) = nlines;
FRAME_MENU_BAR_HEIGHT (f) = nlines * FRAME_LINE_HEIGHT (f);
- adjust_frame_size (f, -1, -1, 2, true, Qx_set_menu_bar_lines);
if (FRAME_X_WINDOW (f))
x_clear_under_internal_border (f);
@@ -1577,6 +1576,8 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
int width = FRAME_PIXEL_WIDTH (f);
int y;
+ adjust_frame_size (f, -1, -1, 3, true, Qmenu_bar_lines);
+
/* height can be zero here. */
if (FRAME_X_WINDOW (f) && height > 0 && width > 0)
{
@@ -1607,13 +1608,15 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
/* Set the number of lines used for the tab bar of frame F to VALUE.
VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
- is the old number of tab bar lines. This function changes the
+ is the old number of tab bar lines. This function may change the
height of all windows on frame F to match the new tab bar height.
- The frame's height doesn't change. */
+ The frame's height may change if frame_inhibit_implied_resize was
+ set accordingly. */
static void
x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
{
+ int olines = FRAME_TAB_BAR_LINES (f);
int nlines;
/* Treat tab bars like menu bars. */
@@ -1626,7 +1629,8 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
else
nlines = 0;
- x_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f));
+ if (nlines != olines && (olines == 0 || nlines == 0))
+ x_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f));
}
@@ -1637,7 +1641,7 @@ x_change_tab_bar_height (struct frame *f, int height)
int unit = FRAME_LINE_HEIGHT (f);
int old_height = FRAME_TAB_BAR_HEIGHT (f);
int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen;
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -1645,16 +1649,8 @@ x_change_tab_bar_height (struct frame *f, int height)
/* Recalculate tab bar and frame text sizes. */
FRAME_TAB_BAR_HEIGHT (f) = height;
FRAME_TAB_BAR_LINES (f) = lines;
- /* Store the `tab-bar-lines' and `height' frame parameters. */
store_frame_param (f, Qtab_bar_lines, make_fixnum (lines));
- store_frame_param (f, Qheight, make_fixnum (FRAME_LINES (f)));
-
- /* We also have to make sure that the internal border at the top of
- the frame, below the menu bar or tab bar, is redrawn when the
- tab bar disappears. This is so because the internal border is
- below the tab bar if one is displayed, but is below the menu bar
- if there isn't a tab bar. The tab bar draws into the area
- below the menu bar. */
+
if (FRAME_X_WINDOW (f) && FRAME_TAB_BAR_HEIGHT (f) == 0)
{
clear_frame (f);
@@ -1664,25 +1660,21 @@ x_change_tab_bar_height (struct frame *f, int height)
if ((height < old_height) && WINDOWP (f->tab_bar_window))
clear_glyph_matrix (XWINDOW (f->tab_bar_window)->current_matrix);
- /* Recalculate tabbar height. */
- f->n_tab_bar_rows = 0;
- if (old_height == 0
- && (!f->after_make_frame
- || NILP (frame_inhibit_implied_resize)
- || (CONSP (frame_inhibit_implied_resize)
- && NILP (Fmemq (Qtab_bar_lines, frame_inhibit_implied_resize)))))
- f->tab_bar_redisplayed = f->tab_bar_resized = false;
-
- adjust_frame_size (f, -1, -1,
- ((!f->tab_bar_resized
- && (NILP (fullscreen =
- get_frame_param (f, Qfullscreen))
- || EQ (fullscreen, Qfullwidth))) ? 1
- : (old_height == 0 || height == 0) ? 2
- : 4),
- false, Qtab_bar_lines);
-
- f->tab_bar_resized = f->tab_bar_redisplayed;
+ if (!f->tab_bar_resized)
+ {
+ /* As long as tab_bar_resized is false, effectively try to change
+ F's native height. */
+ if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth))
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 1, false, Qtab_bar_lines);
+ else
+ adjust_frame_size (f, -1, -1, 4, false, Qtab_bar_lines);
+
+ f->tab_bar_resized = f->tab_bar_redisplayed;
+ }
+ else
+ /* Any other change may leave the native size of F alone. */
+ adjust_frame_size (f, -1, -1, 3, false, Qtab_bar_lines);
/* adjust_frame_size might not have done anything, garbage frame
here. */
@@ -1743,24 +1735,15 @@ x_change_tool_bar_height (struct frame *f, int height)
int unit = FRAME_LINE_HEIGHT (f);
int old_height = FRAME_TOOL_BAR_HEIGHT (f);
int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen;
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
- /* Recalculate tool bar and frame text sizes. */
FRAME_TOOL_BAR_HEIGHT (f) = height;
FRAME_TOOL_BAR_LINES (f) = lines;
- /* Store the `tool-bar-lines' and `height' frame parameters. */
store_frame_param (f, Qtool_bar_lines, make_fixnum (lines));
- store_frame_param (f, Qheight, make_fixnum (FRAME_LINES (f)));
-
- /* We also have to make sure that the internal border at the top of
- the frame, below the menu bar or tool bar, is redrawn when the
- tool bar disappears. This is so because the internal border is
- below the tool bar if one is displayed, but is below the menu bar
- if there isn't a tool bar. The tool bar draws into the area
- below the menu bar. */
+
if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0)
{
clear_frame (f);
@@ -1770,25 +1753,21 @@ x_change_tool_bar_height (struct frame *f, int height)
if ((height < old_height) && WINDOWP (f->tool_bar_window))
clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
- /* Recalculate toolbar height. */
- f->n_tool_bar_rows = 0;
- if (old_height == 0
- && (!f->after_make_frame
- || NILP (frame_inhibit_implied_resize)
- || (CONSP (frame_inhibit_implied_resize)
- && NILP (Fmemq (Qtool_bar_lines, frame_inhibit_implied_resize)))))
- f->tool_bar_redisplayed = f->tool_bar_resized = false;
-
- adjust_frame_size (f, -1, -1,
- ((!f->tool_bar_resized
- && (NILP (fullscreen =
- get_frame_param (f, Qfullscreen))
- || EQ (fullscreen, Qfullwidth))) ? 1
- : (old_height == 0 || height == 0) ? 2
- : 4),
- false, Qtool_bar_lines);
-
- f->tool_bar_resized = f->tool_bar_redisplayed;
+ if (!f->tool_bar_resized)
+ {
+ /* As long as tool_bar_resized is false, effectively try to change
+ F's native height. */
+ if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth))
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 1, false, Qtool_bar_lines);
+ else
+ adjust_frame_size (f, -1, -1, 4, false, Qtool_bar_lines);
+
+ f->tool_bar_resized = f->tool_bar_redisplayed;
+ }
+ else
+ /* Any other change may leave the native size of F alone. */
+ adjust_frame_size (f, -1, -1, 3, false, Qtool_bar_lines);
/* adjust_frame_size might not have done anything, garbage frame
here. */
@@ -2783,7 +2762,7 @@ xic_set_preeditarea (struct window *w, int x, int y)
XVaNestedList attr;
XPoint spot;
- spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
+ spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w) + WINDOW_LEFT_MARGIN_WIDTH(w);
spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
@@ -3382,17 +3361,19 @@ x_icon (struct frame *f, Lisp_Object parms)
= gui_frame_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
int icon_xval, icon_yval;
- if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
+ bool xgiven = !EQ (icon_x, Qunbound);
+ bool ygiven = !EQ (icon_y, Qunbound);
+ if (xgiven != ygiven)
+ error ("Both left and top icon corners of icon must be specified");
+ if (xgiven)
{
icon_xval = check_integer_range (icon_x, INT_MIN, INT_MAX);
icon_yval = check_integer_range (icon_y, INT_MIN, INT_MAX);
}
- else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
- error ("Both left and top icon corners of icon must be specified");
block_input ();
- if (! EQ (icon_x, Qunbound))
+ if (xgiven)
x_wm_set_icon_position (f, icon_xval, icon_yval);
#if false /* gui_display_get_arg removes the visibility parameter as a
@@ -3687,7 +3668,6 @@ This function is an internal primitive--use `make-frame' instead. */)
struct x_display_info *dpyinfo = NULL;
Lisp_Object parent, parent_frame;
struct kboard *kb;
- int x_width = 0, x_height = 0;
parms = Fcopy_alist (parms);
@@ -3999,18 +3979,6 @@ This function is an internal primitive--use `make-frame' instead. */)
init_iterator with a null face cache, which should not happen. */
init_frame_faces (f);
- /* We have to call adjust_frame_size here since otherwise
- x_set_tool_bar_lines will already work with the character sizes
- installed by init_frame_faces while the frame's pixel size is still
- calculated from a character size of 1 and we subsequently hit the
- (height >= 0) assertion in window_box_height.
-
- The non-pixelwise code apparently worked around this because it
- had one frame line vs one toolbar line which left us with a zero
- root window height which was obviously wrong as well ...
-
- Also process `min-width' and `min-height' parameters right here
- because `frame-windows-min-size' needs them. */
tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL,
RES_TYPE_NUMBER);
if (FIXNUMP (tem))
@@ -4019,6 +3987,7 @@ This function is an internal primitive--use `make-frame' instead. */)
RES_TYPE_NUMBER);
if (FIXNUMP (tem))
store_frame_param (f, Qmin_height, tem);
+
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
Qx_create_frame_1);
@@ -4055,8 +4024,7 @@ This function is an internal primitive--use `make-frame' instead. */)
RES_TYPE_BOOLEAN);
/* Compute the size of the X window. */
- window_prompting = gui_figure_window_size (f, parms, true, true,
- &x_width, &x_height);
+ window_prompting = gui_figure_window_size (f, parms, true, true);
tem = gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0,
RES_TYPE_BOOLEAN);
@@ -4140,11 +4108,6 @@ This function is an internal primitive--use `make-frame' instead. */)
/* Consider frame official, now. */
f->can_set_window_size = true;
- if (x_width > 0)
- SET_FRAME_WIDTH (f, x_width);
- if (x_height > 0)
- SET_FRAME_HEIGHT (f, x_height);
-
/* Tell the server what size and position, etc, we want, and how
badly we want them. This should be done after we have the menu
bar so that its size can be taken into account. */
@@ -4166,12 +4129,21 @@ This function is an internal primitive--use `make-frame' instead. */)
cannot control visibility, so don't try. */
if (!f->output_data.x->explicit_parent)
{
+ /* When called from `x-create-frame-with-faces' visibility is
+ always explicitly nil. */
Lisp_Object visibility
= gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
RES_TYPE_SYMBOL);
+ Lisp_Object height
+ = gui_display_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
+ Lisp_Object width
+ = gui_display_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
if (EQ (visibility, Qicon))
- x_iconify_frame (f);
+ {
+ f->was_invisible = true;
+ x_iconify_frame (f);
+ }
else
{
if (EQ (visibility, Qunbound))
@@ -4179,8 +4151,17 @@ This function is an internal primitive--use `make-frame' instead. */)
if (!NILP (visibility))
x_make_frame_visible (f);
+ else
+ f->was_invisible = true;
}
+ /* Leave f->was_invisible true only if height or width were
+ specified too. This takes effect only when we are not called
+ from `x-create-frame-with-faces' (see above comment). */
+ f->was_invisible
+ = (f->was_invisible
+ && (!EQ (height, Qunbound) || !EQ (width, Qunbound)));
+
store_frame_param (f, Qvisibility, visibility);
}
@@ -4599,7 +4580,7 @@ On MS Windows, this just returns nil. */)
return Qnil;
}
-#if !defined USE_GTK || !defined HAVE_GTK3
+#if !(defined USE_GTK && defined HAVE_GTK3)
/* Store the geometry of the workarea on display DPYINFO into *RECT.
Return false if and only if the workarea information cannot be
@@ -4662,6 +4643,9 @@ x_get_net_workarea (struct x_display_info *dpyinfo, XRectangle *rect)
return result;
}
+#endif /* !(USE_GTK && HAVE_GTK3) */
+
+#ifndef USE_GTK
/* Return monitor number where F is "most" or closest to. */
static int
@@ -4877,6 +4861,8 @@ x_get_monitor_attributes_xrandr (struct x_display_info *dpyinfo)
pxid = XRRGetOutputPrimary (dpy, dpyinfo->root_window);
#endif
+#undef RANDR13_LIBRARY
+
for (i = 0; i < n_monitors; ++i)
{
XRROutputInfo *info = XRRGetOutputInfo (dpy, resources,
@@ -6286,10 +6272,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
struct frame *f;
Lisp_Object frame;
Lisp_Object name;
- int width, height;
ptrdiff_t count = SPECPDL_INDEX ();
bool face_change_before = face_change;
- int x_width = 0, x_height = 0;
if (!dpyinfo->terminal->name)
error ("Terminal is not live, can't create new frames on it");
@@ -6413,7 +6397,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
gui_default_parameter (f, parms, Qborder_width, make_fixnum (0),
"borderWidth", "BorderWidth", RES_TYPE_NUMBER);
- /* This defaults to 2 in order to match xterm. We recognize either
+ /* This defaults to 1 in order to match xterm. We recognize either
internalBorderWidth or internalBorder (which is what xterm calls
it). */
if (NILP (Fassq (Qinternal_border_width, parms)))
@@ -6461,7 +6445,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
"inhibitDoubleBuffering", "InhibitDoubleBuffering",
RES_TYPE_BOOLEAN);
- gui_figure_window_size (f, parms, false, false, &x_width, &x_height);
+ gui_figure_window_size (f, parms, false, false);
{
XSetWindowAttributes attrs;
@@ -6513,15 +6497,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
gui_default_parameter (f, parms, Qalpha, Qnil,
"alpha", "Alpha", RES_TYPE_NUMBER);
- /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
- Change will not be effected unless different from the current
- FRAME_LINES (f). */
- width = FRAME_COLS (f);
- height = FRAME_LINES (f);
- SET_FRAME_COLS (f, 0);
- SET_FRAME_LINES (f, 0);
- change_frame_size (f, width, height, true, false, false, false);
-
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
{
@@ -6583,6 +6558,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
visible won't work. */
Vframe_list = Fcons (frame, Vframe_list);
f->can_set_window_size = true;
+ adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
+ 0, true, Qtip_frame);
/* Setting attributes of faces of the tooltip frame from resources
and similar will set face_change, which leads to the clearing of
@@ -7071,6 +7048,8 @@ Text larger than the specified size is clipped. */)
set_window_buffer (window, tip_buf, false, false);
w = XWINDOW (window);
w->pseudo_window_p = true;
+ /* Try to avoid that `other-window' select us (Bug#47207). */
+ Fset_window_parameter (window, Qno_other_window, Qt);
/* Set up the frame's root window. Note: The following code does not
try to size the window or its frame correctly. Its only purpose is
diff --git a/src/xfont.c b/src/xfont.c
index 0570ee96a90..81d356175a4 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -596,7 +596,10 @@ xfont_list_family (struct frame *f)
char **names;
int num_fonts, i;
Lisp_Object list;
- char *last_family UNINIT;
+ char const *last_family;
+#if defined GCC_LINT || defined lint
+ last_family = "";
+#endif
int last_len;
block_input ();
diff --git a/src/xftfont.c b/src/xftfont.c
index f7349316366..d8ad4035481 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -33,6 +33,12 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "ftfont.h"
#include "pdumper.h"
+#ifndef FC_LCD_FILTER
+/* Older fontconfig versions don't have FC_LCD_FILTER. */
+# define FC_LCD_FILTER "lcdfilter"
+#endif
+
+
/* Xft font driver. */
/* Structure pointed by (struct face *)->extra */
diff --git a/src/xgselect.c b/src/xgselect.c
index 0d91d55bad6..92b118b9559 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -34,12 +34,27 @@ static GMainContext *glib_main_context;
void release_select_lock (void)
{
+#if GNUC_PREREQ (4, 7, 0)
+ if (__atomic_sub_fetch (&threads_holding_glib_lock, 1, __ATOMIC_ACQ_REL) == 0)
+ g_main_context_release (glib_main_context);
+#else
if (--threads_holding_glib_lock == 0)
g_main_context_release (glib_main_context);
+#endif
}
static void acquire_select_lock (GMainContext *context)
{
+#if GNUC_PREREQ (4, 7, 0)
+ if (__atomic_fetch_add (&threads_holding_glib_lock, 1, __ATOMIC_ACQ_REL) == 0)
+ {
+ glib_main_context = context;
+ while (!g_main_context_acquire (context))
+ {
+ /* Spin. */
+ }
+ }
+#else
if (threads_holding_glib_lock++ == 0)
{
glib_main_context = context;
@@ -48,6 +63,7 @@ static void acquire_select_lock (GMainContext *context)
/* Spin. */
}
}
+#endif
}
/* `xg_select' is a `pselect' replacement. Why do we need a separate function?
diff --git a/src/xmenu.c b/src/xmenu.c
index a83fffbf1ce..a6762236bc4 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -641,7 +641,7 @@ update_frame_menubar (struct frame *f)
lw_refigure_widget (x->column_widget, True);
/* Force the pane widget to resize itself. */
- adjust_frame_size (f, -1, -1, 2, false, Qupdate_frame_menubar);
+ adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines);
unblock_input ();
#endif /* USE_GTK */
}
@@ -1044,6 +1044,7 @@ free_frame_menubar (struct frame *f)
/* Motif automatically shrinks the frame in lw_destroy_all_widgets.
If we want to preserve the old height, calculate it now so we can
restore it below. */
+ int old_width = FRAME_TEXT_WIDTH (f);
int old_height = FRAME_TEXT_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f);
#endif
@@ -1077,26 +1078,43 @@ free_frame_menubar (struct frame *f)
lw_destroy_all_widgets ((LWLIB_ID) f->output_data.x->id);
f->output_data.x->menubar_widget = NULL;
+ /* When double-buffering is enabled and the frame shall not be
+ resized either because resizing is inhibited or the frame is
+ fullheight, some (usually harmless) display artifacts like a
+ doubled mode line may show up. Sometimes the configuration
+ gets messed up in a more serious fashion though and you may
+ have to resize the frame to get it back in a normal state. */
if (f->output_data.x->widget)
{
#ifdef USE_MOTIF
XtVaGetValues (f->output_data.x->widget, XtNx, &x1, XtNy, &y1, NULL);
if (x1 == 0 && y1 == 0)
XtVaSetValues (f->output_data.x->widget, XtNx, x0, XtNy, y0, NULL);
- if (frame_inhibit_resize (f, false, Qmenu_bar_lines))
- adjust_frame_size (f, -1, old_height, 1, false, Qfree_frame_menubar_1);
+ /* When resizing is inhibited and a normal Motif frame is not
+ fullheight, we have to explicitly request its old sizes
+ here since otherwise turning off the menu bar will shrink
+ the frame but turning them on again will not resize it
+ back. For a fullheight frame we let the window manager
+ deal with this problem. */
+ if (frame_inhibit_resize (f, false, Qmenu_bar_lines)
+ && !EQ (get_frame_param (f, Qfullscreen), Qfullheight))
+ adjust_frame_size (f, old_width, old_height, 1, false,
+ Qmenu_bar_lines);
else
- adjust_frame_size (f, -1, -1, 2, false, Qfree_frame_menubar_1);
+ adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines);
#else
- adjust_frame_size (f, -1, -1, 2, false, Qfree_frame_menubar_1);
+ adjust_frame_size (f, -1, -1, 2, false, Qmenu_bar_lines);
#endif /* USE_MOTIF */
}
else
{
#ifdef USE_MOTIF
if (WINDOWP (FRAME_ROOT_WINDOW (f))
- && frame_inhibit_resize (f, false, Qmenu_bar_lines))
- adjust_frame_size (f, -1, old_height, 1, false, Qfree_frame_menubar_2);
+ /* See comment above. */
+ && frame_inhibit_resize (f, false, Qmenu_bar_lines)
+ && !EQ (get_frame_param (f, Qfullscreen), Qfullheight))
+ adjust_frame_size (f, old_width, old_height, 1, false,
+ Qmenu_bar_lines);
#endif
}
diff --git a/src/xselect.c b/src/xselect.c
index 030f6240712..cd6d86bdf4c 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1482,14 +1482,21 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo,
= XGetSelectionOwner (display, selection_atom) != 0;
unblock_input ();
if (there_is_a_selection_owner)
- signal_error ("Selection owner couldn't convert",
- actual_type
- ? list2 (target_type,
- x_atom_to_symbol (dpyinfo, actual_type))
- : target_type);
+ {
+ AUTO_STRING (format, "Selection owner couldn't convert: %s");
+ CALLN (Fmessage, format,
+ actual_type
+ ? list2 (target_type,
+ x_atom_to_symbol (dpyinfo, actual_type))
+ : target_type);
+ return Qnil;
+ }
else
- signal_error ("No selection",
- x_atom_to_symbol (dpyinfo, selection_atom));
+ {
+ AUTO_STRING (format, "No selection: %s");
+ CALLN (Fmessage, format, x_atom_to_symbol (dpyinfo, selection_atom));
+ return Qnil;
+ }
}
if (actual_type == dpyinfo->Xatom_INCR)
diff --git a/src/xsmfns.c b/src/xsmfns.c
index 10565a4b25f..ddb86d82fe1 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -357,7 +357,7 @@ ice_conn_watch_CB (IceConn iceConn, IcePointer clientData,
}
ice_fd = IceConnectionNumber (iceConn);
- add_read_fd (ice_fd, x_session_check_input, NULL);
+ add_non_keyboard_read_fd (ice_fd, x_session_check_input, NULL);
}
/* Create the client leader window. */
diff --git a/src/xterm.c b/src/xterm.c
index 744b80c68a0..1887c3255d4 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -6223,7 +6223,7 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
/* But only if we have a small colormap. Xaw3d can allocate nice
colors itself. */
{
- XtSetArg (av[ac], XtNbeNiceToColormap,
+ XtSetArg (av[ac], (String) XtNbeNiceToColormap,
DefaultDepthOfScreen (FRAME_X_SCREEN (f)) < 16);
++ac;
}
@@ -6234,20 +6234,20 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
{
/* This tells Xaw3d to use real colors instead of dithering for
the shadows. */
- XtSetArg (av[ac], XtNbeNiceToColormap, False);
+ XtSetArg (av[ac], (String) XtNbeNiceToColormap, False);
++ac;
/* Specify the colors. */
pixel = f->output_data.x->scroll_bar_top_shadow_pixel;
if (pixel != -1)
{
- XtSetArg (av[ac], XtNtopShadowPixel, pixel);
+ XtSetArg (av[ac], (String) XtNtopShadowPixel, pixel);
++ac;
}
pixel = f->output_data.x->scroll_bar_bottom_shadow_pixel;
if (pixel != -1)
{
- XtSetArg (av[ac], XtNbottomShadowPixel, pixel);
+ XtSetArg (av[ac], (String) XtNbottomShadowPixel, pixel);
++ac;
}
}
@@ -6424,7 +6424,7 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
/* But only if we have a small colormap. Xaw3d can allocate nice
colors itself. */
{
- XtSetArg (av[ac], XtNbeNiceToColormap,
+ XtSetArg (av[ac], (String) XtNbeNiceToColormap,
DefaultDepthOfScreen (FRAME_X_SCREEN (f)) < 16);
++ac;
}
@@ -6435,20 +6435,20 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar)
{
/* This tells Xaw3d to use real colors instead of dithering for
the shadows. */
- XtSetArg (av[ac], XtNbeNiceToColormap, False);
+ XtSetArg (av[ac], (String) XtNbeNiceToColormap, False);
++ac;
/* Specify the colors. */
pixel = f->output_data.x->scroll_bar_top_shadow_pixel;
if (pixel != -1)
{
- XtSetArg (av[ac], XtNtopShadowPixel, pixel);
+ XtSetArg (av[ac], (String) XtNtopShadowPixel, pixel);
++ac;
}
pixel = f->output_data.x->scroll_bar_bottom_shadow_pixel;
if (pixel != -1)
{
- XtSetArg (av[ac], XtNbottomShadowPixel, pixel);
+ XtSetArg (av[ac], (String) XtNbottomShadowPixel, pixel);
++ac;
}
}
@@ -7833,10 +7833,6 @@ x_net_wm_state (struct frame *f, Window window)
break;
}
- frame_size_history_add
- (f, Qx_net_wm_state, 0, 0,
- list2 (get_frame_param (f, Qfullscreen), lval));
-
store_frame_param (f, Qfullscreen, lval);
/** store_frame_param (f, Qsticky, sticky ? Qt : Qnil); **/
}
@@ -8167,19 +8163,39 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (f && event->xproperty.atom == dpyinfo->Xatom_net_wm_state)
{
bool not_hidden = x_handle_net_wm_state (f, &event->xproperty);
+
if (not_hidden && FRAME_ICONIFIED_P (f))
{
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("PropertyNotify, not hidden & iconified"));
+
/* Gnome shell does not iconify us when C-z is pressed.
It hides the frame. So if our state says we aren't
hidden anymore, treat it as deiconified. */
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, false);
+
f->output_data.x->has_been_visible = true;
inev.ie.kind = DEICONIFY_EVENT;
+#if defined USE_GTK && defined HAVE_GTK3
+ /* If GTK3 wants to impose some old size here (Bug#24526),
+ tell it that the current size is what we want. */
+ if (f->was_invisible)
+ {
+ xg_frame_set_char_size
+ (f, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f));
+ f->was_invisible = false;
+ }
+#endif
XSETFRAME (inev.ie.frame_or_window, f);
}
- else if (! not_hidden && ! FRAME_ICONIFIED_P (f))
+ else if (!not_hidden && !FRAME_ICONIFIED_P (f))
{
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("PropertyNotify, hidden & not iconified"));
+
SET_FRAME_VISIBLE (f, 0);
SET_FRAME_ICONIFIED (f, true);
inev.ie.kind = ICONIFY_EVENT;
@@ -8226,33 +8242,36 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!FRAME_VISIBLE_P (f))
{
block_input ();
- SET_FRAME_VISIBLE (f, 1);
- SET_FRAME_ICONIFIED (f, false);
- if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ /* The following two are commented out to avoid that a
+ plain invisible frame gets reported as iconified. That
+ problem occurred first for Emacs 26 and is described in
+ https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html. */
+/** SET_FRAME_VISIBLE (f, 1); **/
+/** SET_FRAME_ICONIFIED (f, false); **/
+
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
font_drop_xrender_surfaces (f);
f->output_data.x->has_been_visible = true;
SET_FRAME_GARBAGED (f);
unblock_input ();
}
else if (FRAME_GARBAGED_P (f))
- {
+ {
#ifdef USE_GTK
- /* Go around the back buffer and manually clear the
- window the first time we show it. This way, we avoid
- showing users the sanity-defying horror of whatever
- GtkWindow is rendering beneath us. We've garbaged
- the frame, so we'll redraw the whole thing on next
- redisplay anyway. Yuck. */
- x_clear_area1 (
- FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
- event->xexpose.x, event->xexpose.y,
- event->xexpose.width, event->xexpose.height,
- 0);
+ /* Go around the back buffer and manually clear the
+ window the first time we show it. This way, we avoid
+ showing users the sanity-defying horror of whatever
+ GtkWindow is rendering beneath us. We've garbaged
+ the frame, so we'll redraw the whole thing on next
+ redisplay anyway. Yuck. */
+ x_clear_area1 (FRAME_X_DISPLAY (f),
+ FRAME_X_WINDOW (f),
+ event->xexpose.x, event->xexpose.y,
+ event->xexpose.width, event->xexpose.height,
+ 0);
x_clear_under_internal_border (f);
#endif
- }
-
+ }
if (!FRAME_GARBAGED_P (f))
{
@@ -8345,7 +8364,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
the frame was deleted. */
{
bool visible = FRAME_VISIBLE_P (f);
- /* While a frame is unmapped, display generation is
+
+ /* While a frame is unmapped, display generation is
disabled; you don't want to spend time updating a
display that won't ever be seen. */
SET_FRAME_VISIBLE (f, 0);
@@ -8357,10 +8377,17 @@ handle_one_xevent (struct x_display_info *dpyinfo,
and that way, we know the window is not iconified now. */
if (visible || FRAME_ICONIFIED_P (f))
{
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("UnmapNotify, visible | iconified"));
+
SET_FRAME_ICONIFIED (f, true);
- inev.ie.kind = ICONIFY_EVENT;
+ inev.ie.kind = ICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
}
+ else if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("UnmapNotify, not visible & not iconified"));
}
goto OTHER;
@@ -8372,8 +8399,24 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (f)
{
bool iconified = FRAME_ICONIFIED_P (f);
-
- /* Check if fullscreen was specified before we where mapped the
+ int value;
+ bool sticky;
+ bool not_hidden = x_get_current_wm_state (f, event->xmap.window, &value, &sticky);
+
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f,
+ iconified
+ ? (not_hidden
+ ? build_string ("MapNotify, not hidden & iconified")
+ : build_string ("MapNotify, hidden & iconified"))
+ : (not_hidden
+ ? build_string ("MapNotify, not hidden & not iconified")
+ : build_string ("MapNotify, hidden & not iconified")),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ -1, -1, f->new_width, f->new_height);
+
+ /* Check if fullscreen was specified before we where mapped the
first time, i.e. from the command line. */
if (!f->output_data.x->has_been_visible)
{
@@ -8397,11 +8440,24 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_set_z_group (f, Qbelow, Qnil);
}
- SET_FRAME_VISIBLE (f, 1);
- SET_FRAME_ICONIFIED (f, false);
- f->output_data.x->has_been_visible = true;
+ if (not_hidden)
+ {
+ SET_FRAME_VISIBLE (f, 1);
+ SET_FRAME_ICONIFIED (f, false);
+#if defined USE_GTK && defined HAVE_GTK3
+ /* If GTK3 wants to impose some old size here (Bug#24526),
+ tell it that the current size is what we want. */
+ if (f->was_invisible)
+ {
+ xg_frame_set_char_size
+ (f, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f));
+ f->was_invisible = false;
+ }
+#endif
+ f->output_data.x->has_been_visible = true;
+ }
- if (iconified)
+ if (not_hidden && iconified)
{
inev.ie.kind = DEICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
@@ -8779,10 +8835,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case FocusIn:
+#ifndef USE_GTK
/* Some WMs (e.g. Mutter in Gnome Shell), don't unmap
minimized/iconified windows; thus, for those WMs we won't get
a MapNotify when unminimizing/deconifying. Check here if we
- are deconizing a window (Bug42655). */
+ are deiconizing a window (Bug42655).
+
+ But don't do that on GTK since it may cause a plain invisible
+ frame get reported as iconified, compare
+ https://lists.gnu.org/archive/html/emacs-devel/2017-02/msg00133.html.
+ That is fixed above but bites us here again. */
f = any;
if (f && FRAME_ICONIFIED_P (f))
{
@@ -8792,6 +8854,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
inev.ie.kind = DEICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
}
+#endif /* USE_GTK */
x_detect_focus_change (dpyinfo, any, event, &inev.ie);
goto OTHER;
@@ -8974,7 +9037,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| !(configureEvent.xconfigure.width <= 1
&& configureEvent.xconfigure.height <= 1)))
{
- block_input ();
+
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("ConfigureNotify"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ configureEvent.xconfigure.width,
+ configureEvent.xconfigure.height,
+ f->new_width, f->new_height);
+
+ block_input ();
if (FRAME_X_DOUBLE_BUFFERED_P (f))
font_drop_xrender_surfaces (f);
unblock_input ();
@@ -9015,24 +9087,29 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#ifndef USE_X_TOOLKIT
#ifndef USE_GTK
- int width =
- FRAME_PIXEL_TO_TEXT_WIDTH (f, configureEvent.xconfigure.width);
- int height =
- FRAME_PIXEL_TO_TEXT_HEIGHT (f, configureEvent.xconfigure.height);
+ int width = configureEvent.xconfigure.width;
+ int height = configureEvent.xconfigure.height;
- /* In the toolkit version, change_frame_size
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("ConfigureNotify"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f),
+ width, height, f->new_width, f->new_height);
+
+ /* In the toolkit version, change_frame_size
is called by the code that handles resizing
of the EmacsFrame widget. */
/* 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_TEXT_WIDTH (f)
- || height != FRAME_TEXT_HEIGHT (f)
- || configureEvent.xconfigure.width != FRAME_PIXEL_WIDTH (f)
- || configureEvent.xconfigure.height != FRAME_PIXEL_HEIGHT (f))
+ if (width != FRAME_PIXEL_WIDTH (f)
+ || height != FRAME_PIXEL_HEIGHT (f)
+ || (f->new_size_p
+ && ((f->new_width >= 0 && width != f->new_width)
+ || (f->new_height >= 0 && height != f->new_height))))
{
- change_frame_size (f, width, height, false, true, false, true);
+ change_frame_size (f, width, height, false, true, false);
x_clear_under_internal_border (f);
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
@@ -9266,6 +9343,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case VisibilityNotify:
+ f = x_top_window_to_frame (dpyinfo, event->xvisibility.window);
+ if (f && (event->xvisibility.state == VisibilityUnobscured
+ || event->xvisibility.state == VisibilityPartiallyObscured))
+ SET_FRAME_VISIBLE (f, 1);
+
goto OTHER;
case MappingNotify:
@@ -9522,11 +9604,12 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row)
/* The foreground of cursor_gc is typically the same as the normal
background color, which can cause the cursor box to be invisible. */
xgcv.foreground = f->output_data.x->cursor_pixel;
+ xgcv.line_width = 1;
if (dpyinfo->scratch_cursor_gc)
- XChangeGC (dpy, dpyinfo->scratch_cursor_gc, GCForeground, &xgcv);
+ XChangeGC (dpy, dpyinfo->scratch_cursor_gc, GCForeground | GCLineWidth, &xgcv);
else
dpyinfo->scratch_cursor_gc = XCreateGC (dpy, FRAME_X_DRAWABLE (f),
- GCForeground, &xgcv);
+ GCForeground | GCLineWidth, &xgcv);
gc = dpyinfo->scratch_cursor_gc;
/* When on R2L character, show cursor at the right edge of the
@@ -10217,11 +10300,6 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset)
{
struct font *font = XFONT_OBJECT (font_object);
int unit, font_ascent, font_descent;
-#ifndef USE_X_TOOLKIT
- int old_menu_bar_height = FRAME_MENU_BAR_HEIGHT (f);
- int old_tab_bar_height = FRAME_TAB_BAR_HEIGHT (f);
- Lisp_Object fullscreen;
-#endif
if (fontset < 0)
fontset = fontset_from_font (font_object);
@@ -10239,8 +10317,9 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset)
#ifndef USE_X_TOOLKIT
FRAME_MENU_BAR_HEIGHT (f) = FRAME_MENU_BAR_LINES (f) * FRAME_LINE_HEIGHT (f);
- FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f);
#endif
+ /* We could use a more elaborate calculation here. */
+ FRAME_TAB_BAR_HEIGHT (f) = FRAME_TAB_BAR_LINES (f) * FRAME_LINE_HEIGHT (f);
/* Compute character columns occupied by scrollbar.
@@ -10253,34 +10332,14 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset)
else
FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + unit - 1) / unit;
- if (FRAME_X_WINDOW (f) != 0)
- {
- /* 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 (!FRAME_TOOLTIP_P (f))
- {
- adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
- FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3,
- false, Qfont);
-#ifndef USE_X_TOOLKIT
- if ((FRAME_MENU_BAR_HEIGHT (f) != old_menu_bar_height
- || FRAME_TAB_BAR_HEIGHT (f) != old_tab_bar_height)
- && !f->after_make_frame
- && (EQ (frame_inhibit_implied_resize, Qt)
- || (CONSP (frame_inhibit_implied_resize)
- && NILP (Fmemq (Qfont, frame_inhibit_implied_resize))))
- && (NILP (fullscreen = get_frame_param (f, Qfullscreen))
- || EQ (fullscreen, Qfullwidth)))
- /* If the menu/tab bar height changes, try to keep text height
- constant. */
- adjust_frame_size
- (f, -1, FRAME_TEXT_HEIGHT (f) + FRAME_MENU_BAR_HEIGHT (f)
- + FRAME_TAB_BAR_HEIGHT (f)
- - old_menu_bar_height - old_tab_bar_height, 1, false, Qfont);
-#endif /* USE_X_TOOLKIT */
- }
- }
+
+ /* 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 (FRAME_X_WINDOW (f) != 0 && !FRAME_TOOLTIP_P (f))
+ adjust_frame_size
+ (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
+ FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3, false, Qfont);
#ifdef HAVE_X_I18N
if (FRAME_XIC (f)
@@ -11164,10 +11223,6 @@ x_handle_net_wm_state (struct frame *f, const XPropertyEvent *event)
break;
}
- frame_size_history_add
- (f, Qx_handle_net_wm_state, 0, 0,
- list2 (get_frame_param (f, Qfullscreen), lval));
-
store_frame_param (f, Qfullscreen, lval);
store_frame_param (f, Qsticky, sticky ? Qt : Qnil);
@@ -11222,9 +11277,6 @@ x_check_fullscreen (struct frame *f)
emacs_abort ();
}
- frame_size_history_add
- (f, Qx_check_fullscreen, width, height, Qnil);
-
x_wm_set_size_hint (f, 0, false);
XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
@@ -11234,8 +11286,7 @@ x_check_fullscreen (struct frame *f)
x_wait_for_event (f, ConfigureNotify);
else
{
- change_frame_size (f, width, height - FRAME_MENUBAR_HEIGHT (f),
- false, true, false, true);
+ change_frame_size (f, width, height, false, true, false);
x_sync (f);
}
}
@@ -11389,57 +11440,12 @@ static void
x_set_window_size_1 (struct frame *f, bool change_gravity,
int width, int height)
{
- int pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
- int pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
- int old_width = FRAME_PIXEL_WIDTH (f);
- int old_height = FRAME_PIXEL_HEIGHT (f);
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
-
if (change_gravity)
f->win_gravity = NorthWestGravity;
x_wm_set_size_hint (f, 0, false);
- /* When the frame is fullheight and we only want to change the width
- or it is fullwidth and we only want to change the height we should
- be able to preserve the fullscreen property. However, due to the
- fact that we have to send a resize request anyway, the window
- manager will abolish it. At least the respective size should
- remain unchanged but giving the frame back its normal size will
- be broken ... */
- if (EQ (fullscreen, Qfullwidth) && width == FRAME_TEXT_WIDTH (f))
- {
- frame_size_history_add
- (f, Qx_set_window_size_1, width, height,
- list2i (old_height, pixelheight + FRAME_MENUBAR_HEIGHT (f)));
-
- XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- old_width, pixelheight + FRAME_MENUBAR_HEIGHT (f));
- }
- else if (EQ (fullscreen, Qfullheight) && height == FRAME_TEXT_HEIGHT (f))
- {
- frame_size_history_add
- (f, Qx_set_window_size_2, width, height,
- list2i (old_width, pixelwidth));
-
- XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- pixelwidth, old_height);
- }
-
- else
- {
- frame_size_history_add
- (f, Qx_set_window_size_3, width, height,
- list3i (pixelwidth + FRAME_TOOLBAR_WIDTH (f),
- (pixelheight + FRAME_TOOLBAR_HEIGHT (f)
- + FRAME_MENUBAR_HEIGHT (f)),
- FRAME_MENUBAR_HEIGHT (f)));
-
- XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- pixelwidth, pixelheight + FRAME_MENUBAR_HEIGHT (f));
- fullscreen = Qnil;
- }
-
-
+ XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ width, height + FRAME_MENUBAR_HEIGHT (f));
/* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to
receive in the ConfigureNotify event; if we get what we asked
@@ -11468,66 +11474,42 @@ x_set_window_size_1 (struct frame *f, bool change_gravity,
{
x_wait_for_event (f, ConfigureNotify);
- if (!NILP (fullscreen))
- /* Try to restore fullscreen state. */
- {
- store_frame_param (f, Qfullscreen, fullscreen);
- gui_set_fullscreen (f, fullscreen, fullscreen);
- }
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("x_set_window_size_1, visible"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), width, height,
+ f->new_width, f->new_height);
}
else
{
- change_frame_size (f, width, height, false, true, false, true);
+ if (CONSP (frame_size_history))
+ frame_size_history_extra
+ (f, build_string ("x_set_window_size_1, invisible"),
+ FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), width, height,
+ f->new_width, f->new_height);
+
+ /* Call adjust_frame_size right away as with GTK. It might be
+ tempting to clear out f->new_width and f->new_height here. */
+ adjust_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, width),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (f, height),
+ 5, 0, Qx_set_window_size_1);
+
x_sync (f);
}
}
-/* Call this to change the size of frame F's x-window.
- If CHANGE_GRAVITY, change to top-left-corner window gravity
- for this size change and subsequent size changes.
- Otherwise we leave the window gravity unchanged. */
+/* Change the size of frame F's X window to WIDTH and HEIGHT pixels. If
+ CHANGE_GRAVITY, change to top-left-corner window gravity for this
+ size change and subsequent size changes. Otherwise we leave the
+ window gravity unchanged. */
void
x_set_window_size (struct frame *f, bool change_gravity,
- int width, int height, bool pixelwise)
+ int width, int height)
{
block_input ();
- /* The following breaks our calculations. If it's really needed,
- think of something else. */
-#if false
- if (!FRAME_TOOLTIP_P (f))
- {
- int text_width, text_height;
-
- /* When the frame is maximized/fullscreen or running under for
- example Xmonad, x_set_window_size_1 will be a no-op.
- In that case, the right thing to do is extend rows/width to
- the current frame size. We do that first if x_set_window_size_1
- turns out to not be a no-op (there is no way to know).
- The size will be adjusted again if the frame gets a
- ConfigureNotify event as a result of x_set_window_size. */
- int pixelh = FRAME_PIXEL_HEIGHT (f);
-#ifdef USE_X_TOOLKIT
- /* The menu bar is not part of text lines. The tool bar
- is however. */
- pixelh -= FRAME_MENUBAR_HEIGHT (f);
-#endif
- text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, FRAME_PIXEL_WIDTH (f));
- text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelh);
-
- change_frame_size (f, text_width, text_height, false, true, false, true);
- }
-#endif
-
- /* Pixelize width and height, if necessary. */
- if (! pixelwise)
- {
- width = width * FRAME_COLUMN_WIDTH (f);
- height = height * FRAME_LINE_HEIGHT (f);
- }
-
#ifdef USE_GTK
if (FRAME_GTK_WIDGET (f))
xg_frame_set_char_size (f, width, height);
@@ -11880,8 +11862,15 @@ x_make_frame_visible (struct frame *f)
poll_for_input_1 ();
poll_suppress_count = old_poll_suppress_count;
#endif
- if (! FRAME_VISIBLE_P (f))
- x_wait_for_event (f, MapNotify);
+
+ if (!FRAME_VISIBLE_P (f))
+ {
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("x_make_frame_visible"));
+
+ x_wait_for_event (f, MapNotify);
+ }
}
}
@@ -11937,6 +11926,10 @@ x_make_frame_invisible (struct frame *f)
SET_FRAME_VISIBLE (f, 0);
SET_FRAME_ICONIFIED (f, false);
+ if (CONSP (frame_size_history))
+ frame_size_history_plain
+ (f, build_string ("x_make_frame_invisible"));
+
unblock_input ();
}
diff --git a/src/xterm.h b/src/xterm.h
index ebc42b7dd55..de6ea50385d 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1079,7 +1079,7 @@ extern bool x_had_errors_p (Display *);
extern void x_uncatch_errors (void);
extern void x_uncatch_errors_after_check (void);
extern void x_clear_errors (Display *);
-extern void x_set_window_size (struct frame *f, bool, int, int, bool);
+extern void x_set_window_size (struct frame *f, bool, int, int);
extern void x_make_frame_visible (struct frame *f);
extern void x_make_frame_invisible (struct frame *f);
extern void x_iconify_frame (struct frame *f);
diff --git a/test/Makefile.in b/test/Makefile.in
index f907602a622..a3412d6b53a 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -32,6 +32,7 @@ SHELL = @SHELL@
srcdir = @srcdir@
abs_top_srcdir=@abs_top_srcdir@
+top_builddir = @top_builddir@
VPATH = $(srcdir)
FIND_DELETE = @FIND_DELETE@
@@ -46,30 +47,20 @@ SO = @MODULES_SUFFIX@
SEPCHAR = @SEPCHAR@
+HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@
-# 'make' verbosity.
-AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+REPLACE_FREE = @REPLACE_FREE@
-AM_V_CCLD = $(am__v_CCLD_@AM_V@)
-am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
-am__v_CCLD_0 = @echo " CCLD " $@;
-am__v_CCLD_1 =
-
-AM_V_ELC = $(am__v_ELC_@AM_V@)
-am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
-am__v_ELC_0 = @echo " ELC " $@;
-am__v_ELC_1 =
-
-AM_V_GEN = $(am__v_GEN_@AM_V@)
-am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
-am__v_GEN_0 = @echo " GEN " $@;
-am__v_GEN_1 =
-
-AM_V_at = $(am__v_at_@AM_V@)
-am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
-am__v_at_0 = @
-am__v_at_1 =
+-include ${top_builddir}/src/verbose.mk
+# Load any GNU ELPA dependencies that are present, for optional tests.
+GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa
+# Keep elpa_dependencies dependency-ordered.
+elpa_dependencies = \
+ url-http-ntlm/url-http-ntlm.el \
+ web-server/web-server.el
+elpa_els = $(addprefix $(GNU_ELPA_DIRECTORY)/packages/,$(elpa_dependencies))
+elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el)) -l $(el)))
# We never change directory before running Emacs, so a relative file
# name is fine, and makes life easier. If we need to change
@@ -81,7 +72,7 @@ EMACS_EXTRAOPT=
# Command line flags for Emacs.
# Apparently MSYS bash would convert "-L :" to "-L ;" anyway,
# but we might as well be explicit.
-EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT)
+EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(elpa_opts) $(EMACS_EXTRAOPT)
# Prevent any settings in the user environment causing problems.
unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS
@@ -105,7 +96,7 @@ export TEST_LOAD_EL ?= \
$(if $(findstring $(MAKECMDGOALS), all check check-maybe),no,yes)
# Additional settings for ert.
-ert_opts =
+ert_opts += $(elpa_opts)
# Maximum length of lines in ert backtraces; nil for no limit.
# (if empty, use the default ert-batch-backtrace-right-margin).
@@ -131,6 +122,8 @@ emacs = LANG=C EMACSLOADPATH= \
# Set HOME to a nonexistent directory to prevent tests from accessing
# it accidentally (e.g., popping up a gnupg dialog if ~/.authinfo.gpg
# exists, or writing to ~/.bzr.log when running bzr commands).
+# NOTE if the '/nonexistent' name is changed `normal-top-level' in
+# startup.el must be updated too.
TEST_HOME = /nonexistent
test_module_dir := src/emacs-module-resources
@@ -139,9 +132,15 @@ test_module_dir := src/emacs-module-resources
all: check
+ifeq ($(HAVE_NATIVE_COMP),yes)
SELECTOR_DEFAULT = (not (or (tag :expensive-test) (tag :unstable)))
SELECTOR_EXPENSIVE = (not (tag :unstable))
SELECTOR_ALL = t
+else
+SELECTOR_DEFAULT = (not (or (tag :expensive-test) (tag :unstable) (tag :nativecomp)))
+SELECTOR_EXPENSIVE = (not (or (tag :unstable) (tag :nativecomp)))
+SELECTOR_ALL = (not (tag :nativecomp))
+endif
ifdef SELECTOR
SELECTOR_ACTUAL=$(SELECTOR)
else ifndef MAKECMDGOALS
@@ -164,7 +163,7 @@ endif
WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
## On Hydra or Emba, always show logs for certain problematic tests.
ifdef EMACS_HYDRA_CI
-lisp/net/tramp-tests.log \
+lisp/net/tramp-tests.log lisp/electric-tests.log \
: WRITE_LOG = 2>&1 | tee $@
endif
ifdef EMACS_EMBA_CI
@@ -248,13 +247,13 @@ endef
$(foreach test,${TESTS},$(eval $(call test_template,${test})))
## Get the tests for only a specific directory.
-SUBDIRS = $(sort $(shell find lib-src lisp src -type d ! -path "*resources*" -print))
+SUBDIRS = $(sort $(shell cd ${srcdir} && find lib-src lisp misc src -type d ! -path "*resources*" -print))
define subdir_template
.PHONY: check-$(subst /,-,$(1))
check-$(subst /,-,$(1)):
@${MAKE} check LOGFILES="$(patsubst %.el,%.log, \
- $(patsubst $(srcdir)/%,%,$(wildcard $(1)/*.el)))"
+ $(patsubst $(srcdir)/%,%,$(wildcard ${srcdir}/$(1)/*.el)))"
endef
$(foreach subdir, $(SUBDIRS), $(eval $(call subdir_template,$(subdir))))
@@ -277,6 +276,9 @@ MODULE_CFLAGS = -I../src -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib \
test_module = $(test_module_dir)/mod-test${SO}
src/emacs-module-tests.log src/emacs-module-tests.elc: $(test_module)
+FREE_SOURCE_0 =
+FREE_SOURCE_1 = $(srcdir)/../lib/free.c
+
# In the compilation command, we can't use any object or archive file
# as source because those are not compiled with -fPIC. Therefore we
# use only source files.
@@ -285,10 +287,12 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h
$(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \
-o $@ $< $(LIBGMP) \
$(and $(GMP_H),$(srcdir)/../lib/mini-gmp-gnulib.c) \
- $(if $(OMIT_GNULIB_MODULE_free-posix),,$(srcdir)/../lib/free.c) \
+ $(FREE_SOURCE_$(REPLACE_FREE)) \
$(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c
endif
+src/emacs-tests.log: ../lib-src/seccomp-filter.c
+
## Check that there is no 'automated' subdirectory, which would
## indicate an incomplete merge from an older version of Emacs where
## the tests were arranged differently.
@@ -341,6 +345,7 @@ mostlyclean:
clean:
find . '(' -name '*.log' -o -name '*.log~' ')' $(FIND_DELETE)
+ rm -f ${srcdir}/lisp/gnus/mml-sec-resources/random_seed
rm -f $(test_module_dir)/*.o $(test_module_dir)/*.so \
$(test_module_dir)/*.dll
diff --git a/test/README b/test/README
index 5f3c10adbe1..97611cf8644 100644
--- a/test/README
+++ b/test/README
@@ -7,6 +7,9 @@ Emacs's functionality. Please help add tests!
See the file file-organization.org for the details of the directory
structure and file-naming conventions.
+For tests in the manual/ subdirectory, look there for separate README
+files, or look for instructions in the test files themselves.
+
Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See (info
"(ert)") or https://www.gnu.org/software/emacs/manual/html_node/ert/
for more information on writing and running tests.
@@ -22,7 +25,10 @@ following tags are recognized:
* :unstable
The test is under development. It shall run on demand only.
-The Makefile in this directory supports the following targets:
+The Makefile sets the environment variable $EMACS_TEST_DIRECTORY,
+which points to this directory. This environment variable does not
+exist when the tests are run outside make. The Makefile supports the
+following targets:
* make check
Run all tests as defined in the directory. Expensive and unstable
@@ -99,6 +105,11 @@ debugging. To do that, use
make TEST_INTERACTIVE=yes ...
+By default, ERT test failure summaries are quite brief in batch
+mode--only the names of the failed tests are listed. If the
+$EMACS_TEST_VERBOSE environment variable is set, the failure summaries
+will also include the data from the failing test.
+
Some of the tests require a remote temporary directory
(autorevert-tests.el, filenotify-tests.el, shadowfile-tests.el and
tramp-tests.el). Per default, a mock-up connection method is used
@@ -106,7 +117,13 @@ tramp-tests.el). Per default, a mock-up connection method is used
to test a real remote connection, set $REMOTE_TEMPORARY_FILE_DIRECTORY
to a suitable value in order to overwrite the default value:
- env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ...
+ env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ...
+
+Some optional tests require packages from GNU ELPA. By default
+../../elpa will be checked for these packages. If GNU ELPA is checked
+out somewhere else, use
+
+ make GNU_ELPA_DIRECTORY=/path/to/elpa ...
There are also continuous integration tests on
diff --git a/test/file-organization.org b/test/file-organization.org
index 7cf5b88d6d0..d1f92da4324 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -43,6 +43,10 @@ Similarly, tests of features implemented in C should reside in
~-tests.el~ added to the base-name of the tested source file. Thus,
tests for ~src/fileio.c~ should be in ~test/src/fileio-tests.el~.
+Some tests do not belong to any one particular file. Such tests
+should be put in the ~misc~ directory and be given a descriptive name
+that does /not/ end with ~-tests.el~.
+
There are also some test materials that cannot be run automatically
(i.e. via ert). These should be placed in ~/test/manual~; they are
not run by the "make check" command and its derivatives.
diff --git a/test/infra/Dockerfile.emba b/test/infra/Dockerfile.emba
index 421264db9c9..9f03482c3fd 100644
--- a/test/infra/Dockerfile.emba
+++ b/test/infra/Dockerfile.emba
@@ -28,7 +28,7 @@ FROM debian:stretch as emacs-base
RUN apt-get update && \
apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
- libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git \
+ libc-dev gcc g++ make autoconf automake libncurses-dev gnutls-dev git texinfo \
&& rm -rf /var/lib/apt/lists/*
FROM emacs-base as emacs-inotify
@@ -40,21 +40,22 @@ RUN apt-get update && \
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --without-makeinfo
+RUN ./configure
RUN make -j4 bootstrap
RUN make -j4
FROM emacs-base as emacs-filenotify-gio
RUN apt-get update && \
- apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 libglib2.0-dev libglib2.0-bin libglib2.0-0 \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 \
+ libglib2.0-dev libglib2.0-bin libglib2.0-0 \
&& rm -rf /var/lib/apt/lists/*
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --without-makeinfo --with-file-notification=gfile
-RUN make bootstrap
+RUN ./configure --with-file-notification=gfile
+RUN make -j4 bootstrap
RUN make -j4
FROM emacs-base as emacs-gnustep
@@ -66,6 +67,21 @@ RUN apt-get update && \
COPY . /checkout
WORKDIR /checkout
RUN ./autogen.sh autoconf
-RUN ./configure --without-makeinfo --with-ns
+RUN ./configure --with-ns
RUN make bootstrap
RUN make -j4
+
+FROM emacs-base as emacs-native-comp-speed0
+
+RUN apt-get update && \
+ apt-get install -y --no-install-recommends -o=Dpkg::Use-Pty=0 libgccjit-6-dev \
+ && rm -rf /var/lib/apt/lists/*
+
+ARG make_bootstrap_params=""
+
+COPY . /checkout
+WORKDIR /checkout
+RUN ./autogen.sh autoconf
+RUN ./configure --with-nativecomp
+RUN make bootstrap -j2 NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"'
+RUN make -j4
diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml
index 5a0ab54e4b9..6876a8b11d8 100644
--- a/test/infra/gitlab-ci.yml
+++ b/test/infra/gitlab-ci.yml
@@ -44,6 +44,7 @@ workflow:
variables:
GIT_STRATEGY: fetch
EMACS_EMBA_CI: 1
+ EMACS_TEST_VERBOSE: 1
# # Use TLS https://docs.gitlab.com/ee/ci/docker/using_docker_build.html#tls-enabled
# DOCKER_HOST: tcp://docker:2376
# DOCKER_TLS_CERTDIR: "/certs"
@@ -61,6 +62,8 @@ default:
- docker login -u ${CI_REGISTRY_USER} -p ${CI_REGISTRY_PASSWORD} ${CI_REGISTRY}
.job-template:
+ variables:
+ test_name: ${CI_JOB_NAME}-${CI_COMMIT_SHORT_SHA}
rules:
- changes:
- "**/Makefile.in"
@@ -95,14 +98,18 @@ default:
artifacts:
expire_in: 24 hrs
paths: []
- # - "test/**/*.log"
- # - "**/*.log"
# using the variables for each job
script:
- docker pull ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}
# TODO: with make -j4 several of the tests were failing, for example shadowfile-tests, but passed without it
- 'export PWD=$(pwd)'
- - 'docker run -i --rm -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"'
+ - 'docker run -i -e EMACS_EMBA_CI=${EMACS_EMBA_CI} --volumes-from $(docker ps -q -f "label=com.gitlab.gitlab-runner.job.id=${CI_JOB_ID}"):ro --name ${test_name} ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} /bin/bash -c "git fetch ${PWD} HEAD && echo checking out these updated files && git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && make -j4 && make ${make_params}"'
+ after_script:
+ # - docker ps -a
+ # - printenv
+ # - test -n "$(docker ps -aq -f name=${test_name})" && ( docker export ${test_name} | tar -tvf - )
+ - test -n "$(docker ps -aq -f name=${test_name})" && docker cp ${test_name}:checkout/test ${test_name}
+ - test -n "$(docker ps -aq -f name=${test_name})" && docker rm ${test_name}
.build-template:
rules:
@@ -133,6 +140,19 @@ default:
- docker build --pull --target ${target} -t ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG} -f test/infra/Dockerfile.emba .
- docker push ${CI_REGISTRY_IMAGE}:${target}-${BUILD_TAG}
+.test-template:
+ # Do not run fast and normal test jobs when scheduled
+ rules:
+ - if: '$CI_JOB_STAGE =~ "fast|normal" && $CI_PIPELINE_SOURCE == "schedule"'
+ when: never
+ - when: always
+ artifacts:
+ name: ${test_name}
+ public: true
+ expire_in: 1 week
+ paths:
+ - "${test_name}/**/*.log"
+
.gnustep-template:
rules:
- if: '$CI_PIPELINE_SOURCE == "web"'
@@ -162,6 +182,21 @@ default:
- test/lisp/autorevert-tests.el
- test/lisp/filenotify-tests.el
+.native-comp-template:
+ rules:
+ - if: '$CI_PIPELINE_SOURCE == "web"'
+ - if: '$CI_PIPELINE_SOURCE == "schedule"'
+ changes:
+ - "**/Makefile.in"
+ - .gitlab-ci.yml
+ - lisp/emacs-lisp/comp.el
+ - lisp/emacs-lisp/comp-cstr.el
+ - src/comp.{h,m}
+ - test/infra/*
+ - test/src/comp-resources/*.el
+ - test/src/comp-tests.el
+ timeout: 8 hours
+
stages:
- prep-images
- build-images
@@ -169,6 +204,8 @@ stages:
- normal
- platform-images
- platforms
+ - native-comp-images
+ - native-comp
- slow
prep-image-base:
@@ -180,62 +217,106 @@ prep-image-base:
build-image-inotify:
stage: build-images
extends: [.job-template, .build-template]
+ needs: [prep-image-base]
variables:
target: emacs-inotify
test-fast-inotify:
stage: fast
- extends: [.job-template]
+ extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check"
-build-image-filenotify-gio:
- stage: platform-images
- extends: [.job-template, .build-template, .filenotify-gio-template]
- variables:
- target: emacs-filenotify-gio
-
-build-image-gnustep:
- stage: platform-images
- extends: [.job-template, .build-template, .gnustep-template]
- variables:
- target: emacs-gnustep
-
test-lisp-inotify:
stage: normal
- extends: [.job-template]
+ extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check-lisp"
test-lisp-net-inotify:
stage: normal
- extends: [.job-template]
+ extends: [.job-template, .test-template]
variables:
target: emacs-inotify
make_params: "-C test check-lisp-net"
+build-image-filenotify-gio:
+ stage: platform-images
+ extends: [.job-template, .build-template, .filenotify-gio-template]
+ needs: [prep-image-base]
+ variables:
+ target: emacs-filenotify-gio
+
+build-image-gnustep:
+ stage: platform-images
+ extends: [.job-template, .build-template, .gnustep-template]
+ needs: [prep-image-base]
+ variables:
+ target: emacs-gnustep
+
test-filenotify-gio:
# This tests file monitor libraries gfilemonitor and gio.
stage: platforms
- extends: [.job-template, .filenotify-gio-template]
+ needs: [build-image-filenotify-gio]
+ extends: [.job-template, .test-template, .filenotify-gio-template]
variables:
target: emacs-filenotify-gio
- make_params: "-k -C test autorevert-tests filenotify-tests"
+ make_params: "-k -C test autorevert-tests.log filenotify-tests.log"
test-gnustep:
# This tests the GNUstep build process
stage: platforms
+ needs: [build-image-gnustep]
extends: [.job-template, .gnustep-template]
variables:
target: emacs-gnustep
make_params: install
+build-native-bootstrap-speed0:
+ stage: native-comp-images
+ extends: [.job-template, .build-template, .native-comp-template]
+ needs: [prep-image-base]
+ variables:
+ target: emacs-native-comp-speed0
+
+# build-native-bootstrap-speed0:
+# # Test a full native bootstrap
+# # Run for now only speed 0 to limit memory usage and compilation time.
+# stage: native-comp-images
+# # Uncomment the following to run it only when scheduled.
+# # only:
+# # - schedules
+# script:
+# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev
+# - ./autogen.sh autoconf
+# - ./configure --with-nativecomp
+# - make bootstrap NATIVE_FULL_AOT=1 BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 0)"' -j2
+# timeout: 8 hours
+
+# build-native-bootstrap-speed1:
+# stage: native-comp-images
+# script:
+# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev
+# - ./autogen.sh autoconf
+# - ./configure --with-nativecomp
+# - make bootstrap BYTE_COMPILE_EXTRA_FLAGS='--eval "(setq comp-speed 1)"'
+# timeout: 8 hours
+
+# build-native-bootstrap-speed2:
+# stage: native-comp-images
+# script:
+# - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libgccjit-6-dev
+# - ./autogen.sh autoconf
+# - ./configure --with-nativecomp
+# - make bootstrap
+# timeout: 8 hours
+
test-all-inotify:
# This tests also file monitor libraries inotify and inotifywatch.
stage: slow
- extends: [.job-template]
+ extends: [.job-template, .test-template]
rules:
# note there's no "changes" section, so this always runs on a schedule
- if: '$CI_PIPELINE_SOURCE == "web"'
@@ -243,3 +324,7 @@ test-all-inotify:
variables:
target: emacs-inotify
make_params: check-expensive
+
+# Local Variables:
+# add-log-current-defun-header-regexp: "^\\([-_.[:alnum:]]+\\)[ \t]*:"
+# End:
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index bfbef53db97..d050ac5b695 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -49,6 +49,12 @@
'(("key1" . "val1")
("key2" . "val2"))))))
+(ert-deftest auth-source-pass-parse-with-colons-in-data ()
+ (let ((content "pass\n--\nkey1 :val1\nkey2: please: keep my space after colon\n\n"))
+ (should (equal (auth-source-pass--parse-data content)
+ '(("key1" . "val1")
+ ("key2" . "please: keep my space after colon"))))))
+
(defvar auth-source-pass--debug-log nil
"Contains a list of all messages passed to `auth-source-do-debug`.")
@@ -424,21 +430,37 @@ HOSTNAME, USER and PORT are passed unchanged to
(auth-source-pass--with-store-find-foo
'(("foo" ("secret" . "foo password")))
(let ((result (auth-source-pass--build-result "foo" 512 "user")))
+ (should (equal (plist-get result :host) "foo"))
(should (equal (plist-get result :port) 512))
(should (equal (plist-get result :user) "user")))))
(ert-deftest auth-source-pass-build-result-return-entry-values ()
(auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser")))
(let ((result (auth-source-pass--build-result "foo" nil nil)))
+ (should (equal (plist-get result :host) "foo"))
(should (equal (plist-get result :port) 512))
(should (equal (plist-get result :user) "anuser")))))
(ert-deftest auth-source-pass-build-result-entry-takes-precedence ()
- (auth-source-pass--with-store-find-foo '(("foo" ("port" . 512) ("user" . "anuser")))
+ (auth-source-pass--with-store-find-foo '(("foo" ("host" . "bar") ("port" . 512) ("user" . "anuser")))
(let ((result (auth-source-pass--build-result "foo" 1024 "anotheruser")))
+ (should (equal (plist-get result :host) "bar"))
(should (equal (plist-get result :port) 512))
(should (equal (plist-get result :user) "anuser")))))
+(ert-deftest auth-source-pass-build-result-with-multiple-hosts ()
+ (auth-source-pass--with-store-find-foo
+ '(("foo" ("secret" . "foo password")))
+ (let ((result (auth-source-pass--build-result '("bar" "foo") 512 "user")))
+ (should (equal (plist-get result :host) "foo"))
+ (should (equal (plist-get result :port) 512))
+ (should (equal (plist-get result :user) "user")))))
+
+(ert-deftest auth-source-pass-build-result-with-multiple-hosts-no-match ()
+ (auth-source-pass--with-store-find-foo
+ '(("foo" ("secret" . "foo password")))
+ (should-not (auth-source-pass--build-result '("bar" "baz") 512 "user"))))
+
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
(auth-source-pass-enable)
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 4f0d9949af5..1c4bd8d36d4 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -320,7 +320,9 @@
;; Redefine `read-*' in order to avoid interactive input.
(cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
((symbol-function 'read-string)
- (lambda (_prompt _initial _history default) default)))
+ (lambda (_prompt &optional _initial _history default
+ _inherit-input-method)
+ default)))
(setq auth-info
(car (auth-source-search
:max 1 :host host :require '(:user :secret) :create t))))
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 45cf6353960..96169c75d3d 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -1,4 +1,4 @@
-;;; auto-revert-tests.el --- Tests of auto-revert -*- lexical-binding: t -*-
+;;; autorevert-tests.el --- Tests of auto-revert -*- lexical-binding: t -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
@@ -133,7 +133,9 @@ This expects `auto-revert--messages' to be bound by
(format-message
"Reverting buffer `%s'\\." (buffer-name buffer))
(or auto-revert--messages ""))))
- (if (with-current-buffer buffer auto-revert-use-notify)
+ (if (and (or file-notify--library
+ (file-remote-p temporary-file-directory))
+ (with-current-buffer buffer auto-revert-use-notify))
(read-event nil nil 0.05)
(sleep-for 0.05)))))
@@ -284,7 +286,7 @@ This expects `auto-revert--messages' to be bound by
;; Repeated unpredictable failures, bug#32645.
;; Unlikely to be hydra-specific?
; (skip-unless (not (getenv "EMACS_HYDRA_CI")))
-
+ :tags '(:unstable)
(with-auto-revert-test
(let ((tmpfile (make-temp-file "auto-revert-test"))
;; Try to catch bug#32645.
@@ -669,6 +671,12 @@ This expects `auto-revert--messages' to be bound by
(auto-revert--deftest-remote auto-revert-test07-auto-revert-several-buffers
"Check autorevert for several buffers visiting the same remote file.")
+;; Mark all tests as unstable on Cygwin (bug#49665).
+(when (eq system-type 'cygwin)
+ (dolist (test (apropos-internal "^auto-revert" #'ert-test-boundp))
+ (setf (ert-test-tags (ert-get-test test))
+ (cons :unstable (ert-test-tags (ert-get-test test))))))
+
(defun auto-revert-test-all (&optional interactive)
"Run all tests for \\[auto-revert]."
(interactive "p")
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index bdcf78e020a..13dd228d3b3 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -191,6 +191,33 @@ An existing calc stack is reused, otherwise a new one is created."
(let ((calc-number-radix 36))
(should (equal (math-format-number 12345678901) "36#5,O6A,QT1")))))
+(ert-deftest calc-digit-after-point ()
+ "Test display of trailing 0 after decimal point (bug#47302)."
+ (let ((calc-digit-after-point nil))
+ ;; Integral floats have no digits after the decimal point (default).
+ (should (equal (math-format-number '(float 0 0)) "0."))
+ (should (equal (math-format-number '(float 5 0)) "5."))
+ (should (equal (math-format-number '(float 3 1)) "30."))
+ (should (equal (math-format-number '(float 23 0)) "23."))
+ (should (equal (math-format-number '(float 123 0)) "123."))
+ (should (equal (math-format-number '(float 1 -1)) "0.1"))
+ (should (equal (math-format-number '(float 54 -1)) "5.4"))
+ (should (equal (math-format-number '(float 1 -4)) "1e-4"))
+ (should (equal (math-format-number '(float 1 14)) "1e14"))
+ (should (equal (math-format-number 12) "12")))
+ (let ((calc-digit-after-point t))
+ ;; Integral floats have at least one digit after the decimal point.
+ (should (equal (math-format-number '(float 0 0)) "0.0"))
+ (should (equal (math-format-number '(float 5 0)) "5.0"))
+ (should (equal (math-format-number '(float 3 1)) "30.0"))
+ (should (equal (math-format-number '(float 23 0)) "23.0"))
+ (should (equal (math-format-number '(float 123 0)) "123.0"))
+ (should (equal (math-format-number '(float 1 -1)) "0.1"))
+ (should (equal (math-format-number '(float 54 -1)) "5.4"))
+ (should (equal (math-format-number '(float 1 -4)) "1e-4"))
+ (should (equal (math-format-number '(float 1 14)) "1e14"))
+ (should (equal (math-format-number 12) "12"))))
+
(ert-deftest calc-calendar ()
"Test calendar conversions (bug#36822)."
(should (equal (calcFunc-julian (math-parse-date "2019-07-27")) 2458692))
@@ -707,6 +734,82 @@ An existing calc stack is reused, otherwise a new one is created."
(var c var-c))))))
(calc-set-language nil)))
+(defvar var-g)
+
+;; Test `let'.
+(defmath test1 (x)
+ (let ((x (+ x 1))
+ (y (+ x 3)))
+ (let ((z (+ y 6)))
+ (* x y z g))))
+
+;; Test `let*'.
+(defmath test2 (x)
+ (let* ((y (+ x 1))
+ (z (+ y 3)))
+ (let* ((u (+ z 6)))
+ (* x y z u g))))
+
+;; Test `for'.
+(defmath test3 (x)
+ (let ((s 0))
+ (for ((ii 1 x)
+ (jj 1 ii))
+ (setq s (+ s (* ii jj))))
+ s))
+
+;; Test `for' with non-unit stride.
+(defmath test4 (x)
+ (let ((l nil))
+ (for ((ii 1 x 1)
+ (jj 1 10 ii))
+ (setq l ('cons jj l))) ; Use Lisp `cons', not `calcFunc-cons'.
+ (reverse l)))
+
+;; Test `foreach'.
+(defmath test5 (x)
+ (let ((s 0))
+ (foreach ((a x)
+ (b a))
+ (setq s (+ s b)))
+ s))
+
+;; Test `break'.
+(defmath test6 (x)
+ (let ((a (for ((ii 1 10))
+ (when (= ii x)
+ (break (* ii 2)))))
+ (b (foreach ((e '(9 3 6)))
+ (when (= e x)
+ (break (- e 1))))))
+ (* a b)))
+
+;; Test `return' from `for'.
+(defmath test7 (x)
+ (for ((ii 1 10))
+ (when (= ii x)
+ (return (* ii 2))))
+ 5)
+
+(ert-deftest calc-defmath ()
+ (let ((var-g 17))
+ (should (equal (calcFunc-test1 2) (* 3 5 11 17)))
+ (should (equal (calcFunc-test2 2) (* 2 3 6 12 17))))
+ (should (equal (calcFunc-test3 3)
+ (+ (* 1 1)
+ (* 2 1) (* 2 2)
+ (* 3 1) (* 3 2) (* 3 3))))
+ (should (equal (calcFunc-test4 5)
+ '( 1 2 3 4 5 6 7 8 9 10
+ 1 3 5 7 9
+ 1 4 7 10
+ 1 5 9
+ 1 6)))
+ (should (equal (calcFunc-test5 '((2 3) (5) (7 11 13)))
+ (+ 2 3 5 7 11 13)))
+ (should (equal (calcFunc-test6 3) (* (* 3 2) (- 3 1))))
+ (should (equal (calcFunc-test7 3) (* 3 2))))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/calculator-tests.el b/test/lisp/calculator-tests.el
new file mode 100644
index 00000000000..9551b1a4c61
--- /dev/null
+++ b/test/lisp/calculator-tests.el
@@ -0,0 +1,51 @@
+;;; calculator-tests.el --- Test suite for calculator. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+(require 'ert)
+(require 'calculator)
+
+(ert-deftest calculator-test-calculator-string-to-number ()
+ (dolist (x '(("" 0.0)
+ ("+" 0.0)
+ ("-" 0.0)
+ ("." 0.0)
+ ("+." 0.0)
+ ("-." -0.0)
+ (".-" 0.0)
+ ("--." 0.0)
+ ("-0.0e" -0.0)
+ ("1e1" 10.0)
+ ("1e+1" 10.0)
+ ("1e-1" 0.1)
+ ("+1e1" 10.0)
+ ("-1e1" -10.0)
+ ("+1e-1" 0.1)
+ ("-1e-1" -0.1)
+ (".1.e1" 0.1)
+ (".1..e1" 0.1)
+ ("1e+1.1" 10.0)
+ ("-2e-1.1" -0.2)))
+ (pcase x
+ (`(,str ,expected)
+ (let ((calculator-input-radix nil))
+ (should (equal (calculator-string-to-number str) expected)))))))
+
+(provide 'calculator-tests)
+;; calculator-tests.el ends here
diff --git a/test/lisp/calendar/cal-french-tests.el b/test/lisp/calendar/cal-french-tests.el
new file mode 100644
index 00000000000..ab62c1e6fc1
--- /dev/null
+++ b/test/lisp/calendar/cal-french-tests.el
@@ -0,0 +1,113 @@
+;;; cal-french-tests.el --- tests for cal-french.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'cal-french)
+
+(defconst cal-french-test-cases
+ '(
+ (1792 9 22 "Primidi 1 Vendémiaire an 1 de la Révolution, jour du Raisin")
+ (1793 10 23 "Duodi 2 Brumaire an 2 de la Révolution, jour du Céleri")
+ (1794 7 27 "Nonidi 9 Thermidor an 2 de la Révolution, jour de la Mûre")
+ (1794 11 23 "Tridi 3 Frimaire an 3 de la Révolution, jour de la Chicorée")
+ (1795 10 5 "Tridi 13 Vendémiaire an 4 de la Révolution, jour du Potiron")
+ (1795 12 25 "Quartidi 4 Nivôse an 4 de la Révolution, jour du Soufre")
+ (1797 1 24 "Quintidi 5 Pluviôse an 5 de la Révolution, jour du Taureau")
+ (1798 2 24 "Sextidi 6 Ventôse an 6 de la Révolution, jour de l'Asaret")
+ (1799 11 9 "Octidi 18 Brumaire an 8 de la Révolution, jour de la Dentelaire")
+ (1801 3 29 "Octidi 8 Germinal an 9 de la Révolution, jour de la Jonquille")
+ (1804 4 30 "Décadi 10 Floréal an 12 de la Révolution, jour du Rateau")
+ (1807 6 1 "Duodi 12 Prairial an 15 de la Révolution, jour de la Bétoine")
+ (1810 7 3 "Quartidi 14 Messidor an 18 de la Révolution, jour de la Lavande")
+ (1813 8 4 "Sextidi 16 Thermidor an 21 de la Révolution, jour de la Guimauve")
+ (1816 9 4 "Octidi 18 Fructidor an 24 de la Révolution, jour du Nerprun")
+ (2000 1 1 "Duodi 12 Nivôse an 208 de la Révolution, jour de l'Argile")
+ (2021 7 11 "Tridi 23 Messidor an 229 de la Révolution, jour du Haricot")
+ (2001 5 11 "Duodi 22 Floréal an 209 de la Révolution, jour de la Fritillaire")
+ (1792 9 22 "Primidi 1 Vendémiaire an 1 de la Révolution, jour du Raisin")
+ (1793 9 21 "Quintidi 5 jour complémentaire an 1 de la Révolution, jour des Récompenses")
+ (1793 9 22 "Primidi 1 Vendémiaire an 2 de la Révolution, jour du Raisin")
+ (1794 9 21 "Quintidi 5 jour complémentaire an 2 de la Révolution, jour des Récompenses")
+ (1794 9 22 "Primidi 1 Vendémiaire an 3 de la Révolution, jour du Raisin")
+ (1795 9 22 "Sextidi 6 jour complémentaire an 3 de la Révolution, jour de la Révolution")
+ (1795 9 23 "Primidi 1 Vendémiaire an 4 de la Révolution, jour du Raisin")
+ (1796 9 21 "Quintidi 5 jour complémentaire an 4 de la Révolution, jour des Récompenses")
+ (1796 9 22 "Primidi 1 Vendémiaire an 5 de la Révolution, jour du Raisin")
+ (1797 9 21 "Quintidi 5 jour complémentaire an 5 de la Révolution, jour des Récompenses")
+ (1797 9 22 "Primidi 1 Vendémiaire an 6 de la Révolution, jour du Raisin")
+ (1799 9 22 "Sextidi 6 jour complémentaire an 7 de la Révolution, jour de la Révolution")
+ (1799 9 23 "Primidi 1 Vendémiaire an 8 de la Révolution, jour du Raisin")
+ (1800 9 22 "Quintidi 5 jour complémentaire an 8 de la Révolution, jour des Récompenses")
+ (1800 9 23 "Primidi 1 Vendémiaire an 9 de la Révolution, jour du Raisin")
+ (1801 9 22 "Quintidi 5 jour complémentaire an 9 de la Révolution, jour des Récompenses")
+ (1801 9 23 "Primidi 1 Vendémiaire an 10 de la Révolution, jour du Raisin")
+ (1823 9 22 "Quintidi 5 jour complémentaire an 31 de la Révolution, jour des Récompenses")
+ (1823 9 23 "Primidi 1 Vendémiaire an 32 de la Révolution, jour du Raisin")
+ (1824 9 22 "Sextidi 6 jour complémentaire an 32 de la Révolution, jour de la Révolution")
+ (1824 9 23 "Primidi 1 Vendémiaire an 33 de la Révolution, jour du Raisin")
+ (1825 9 22 "Quintidi 5 jour complémentaire an 33 de la Révolution, jour des Récompenses")
+ (1825 9 23 "Primidi 1 Vendémiaire an 34 de la Révolution, jour du Raisin")
+ (1892 9 21 "Quintidi 5 jour complémentaire an 100 de la Révolution, jour des Récompenses")
+ (1892 9 22 "Primidi 1 Vendémiaire an 101 de la Révolution, jour du Raisin")
+ (1900 9 22 "Sextidi 6 jour complémentaire an 108 de la Révolution, jour de la Révolution")
+ (1900 9 23 "Primidi 1 Vendémiaire an 109 de la Révolution, jour du Raisin")
+ (1992 9 21 "Quintidi 5 jour complémentaire an 200 de la Révolution, jour des Récompenses")
+ (1992 9 22 "Primidi 1 Vendémiaire an 201 de la Révolution, jour du Raisin")
+ (2000 9 21 "Sextidi 6 jour complémentaire an 208 de la Révolution, jour de la Révolution")
+ (2000 9 22 "Primidi 1 Vendémiaire an 209 de la Révolution, jour du Raisin")
+ (2092 9 20 "Quintidi 5 jour complémentaire an 300 de la Révolution, jour des Récompenses")
+ (2092 9 21 "Primidi 1 Vendémiaire an 301 de la Révolution, jour du Raisin")
+ (2100 9 21 "Sextidi 6 jour complémentaire an 308 de la Révolution, jour de la Révolution")
+ (2100 9 22 "Primidi 1 Vendémiaire an 309 de la Révolution, jour du Raisin")
+ (2192 9 21 "Sextidi 6 jour complémentaire an 400 de la Révolution, jour de la Révolution")
+ (2192 9 22 "Primidi 1 Vendémiaire an 401 de la Révolution, jour du Raisin")
+ (2193 9 21 "Quintidi 5 jour complémentaire an 401 de la Révolution, jour des Récompenses")
+ (2199 9 22 "Primidi 1 Vendémiaire an 408 de la Révolution, jour du Raisin")
+ (2200 9 22 "Sextidi 6 jour complémentaire an 408 de la Révolution, jour de la Révolution")
+ (2791 9 23 "Primidi 1 Vendémiaire an 1000 de la Révolution, jour du Raisin")
+ (2792 9 22 "Primidi 1 Vendémiaire an 1001 de la Révolution, jour du Raisin")
+ (3000 1 1 "Duodi 12 Nivôse an 1208 de la Révolution, jour de l'Argile")
+ (3001 1 1 "Primidi 11 Nivôse an 1209 de la Révolution, jour du Granit")
+ (3791 9 22 "Primidi 1 Vendémiaire an 2000 de la Révolution, jour du Raisin")
+ (3792 9 22 "Primidi 1 Vendémiaire an 2001 de la Révolution, jour du Raisin")
+ (4000 1 1 "Duodi 12 Nivôse an 2208 de la Révolution, jour de l'Argile")
+ (4001 1 1 "Duodi 12 Nivôse an 2209 de la Révolution, jour de l'Argile")
+ (4320 9 10 "Quartidi 24 Fructidor an 2528 de la Révolution, jour du Sorgho")
+ (4320 9 11 "Quintidi 25 Fructidor an 2528 de la Révolution, jour de l'Écrevisse")
+ (4791 9 23 "Primidi 1 Vendémiaire an 3000 de la Révolution, jour du Raisin")
+ (4792 9 22 "Primidi 1 Vendémiaire an 3001 de la Révolution, jour du Raisin")
+ (5000 1 1 "Duodi 12 Nivôse an 3208 de la Révolution, jour de l'Argile")
+ (5001 1 1 "Primidi 11 Nivôse an 3209 de la Révolution, jour du Granit")
+ (5791 9 22 "Primidi 1 Vendémiaire an 4000 de la Révolution, jour du Raisin")
+ (5792 9 21 "Primidi 1 Vendémiaire an 4001 de la Révolution, jour du Raisin")
+ (6000 1 1 "Tridi 13 Nivôse an 4208 de la Révolution, jour de l'Ardoise")
+ (6001 1 1 "Tridi 13 Nivôse an 4209 de la Révolution, jour de l'Ardoise")
+ (6791 9 22 "Primidi 1 Vendémiaire an 5000 de la Révolution, jour du Raisin")
+ (6792 9 21 "Primidi 1 Vendémiaire an 5001 de la Révolution, jour du Raisin")
+ (7791 9 21 "Primidi 1 Vendémiaire an 6000 de la Révolution, jour du Raisin")
+ (7792 9 21 "Primidi 1 Vendémiaire an 6001 de la Révolution, jour du Raisin")
+ ))
+
+(ert-deftest cal-french-tests ()
+ (pcase-dolist (`(,y ,m ,d ,str) cal-french-test-cases)
+ (should (equal (calendar-french-date-string (list m d y)) str))))
+
+(provide 'cal-french-tests)
diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
index 7b86b554dd4..2f7026a0bde 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-american
@@ -1 +1 @@
-&%%(and (diary-anniversary 8 15 2004)) Maria Himmelfahrt
+&%%(diary-anniversary 8 15 2003) Maria Himmelfahrt
diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
index 3b82ec09fd5..fa652dbb92e 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-european
@@ -1 +1 @@
-&%%(and (diary-anniversary 15 8 2004)) Maria Himmelfahrt
+&%%(diary-anniversary 15 8 2003) Maria Himmelfahrt
diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
index 7fc99478d4e..803dd36de0a 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-anniversary.diary-iso
@@ -1 +1 @@
-&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt
+&%%(diary-anniversary 2003 8 15) Maria Himmelfahrt
diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
index a54780b9699..bc485d8a6c4 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-american
@@ -1 +1 @@
-&%%(and (diary-anniversary 9 19 2003)) 09:00-11:30 rrule yearly
+&%%(diary-anniversary 9 19 2002) 09:00-11:30 rrule yearly
diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
index a4bd81d6f2b..42509d42bc8 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-european
@@ -1 +1 @@
-&%%(and (diary-anniversary 19 9 2003)) 09:00-11:30 rrule yearly
+&%%(diary-anniversary 19 9 2002) 09:00-11:30 rrule yearly
diff --git a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
index 65a7abe0344..72fe6e12cbd 100644
--- a/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
+++ b/test/lisp/calendar/icalendar-resources/import-rrule-yearly.diary-iso
@@ -1 +1 @@
-&%%(and (diary-anniversary 2003 9 19)) 09:00-11:30 rrule yearly
+&%%(diary-anniversary 2002 9 19) 09:00-11:30 rrule yearly
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index 7993a1fd806..6973f7e5c95 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1,4 +1,4 @@
-;; icalendar-tests.el --- Test suite for icalendar.el -*- lexical-binding:t -*-
+;;; icalendar-tests.el --- Test suite for icalendar.el -*- lexical-binding:t -*-
;; Copyright (C) 2005, 2008-2021 Free Software Foundation, Inc.
@@ -87,7 +87,7 @@
(let* ((calendar-date-style 'iso)
result)
(setq result (icalendar--convert-anniversary-to-ical
- "" "%%(diary-anniversary 1964 6 30) g"))
+ "" "%%(diary-anniversary 1963 6 30) g"))
(should (consp result))
(should (string= (concat
"\nDTSTART;VALUE=DATE:19640630"
@@ -353,7 +353,7 @@ END:VTIMEZONE
(let ((calendar-date-style 'iso))
;; numeric iso
(should (string= "20080511"
- (icalendar--datestring-to-isodate "2008 05 11")))
+ (icalendar--datestring-to-isodate "2008 05 11")))
(should (string= "20080531"
(icalendar--datestring-to-isodate "2008 05 31")))
(should (string= "20080602"
@@ -384,7 +384,19 @@ END:VTIMEZONE
(should (string= "20081105"
(icalendar--datestring-to-isodate "05 Nov 2008")))
(should (string= "20081105"
- (icalendar--datestring-to-isodate "2008 Nov 05")))))
+ (icalendar--datestring-to-isodate "2008 Nov 05")))
+
+ ;; non-numeric with day-shift and year-shift
+ (setq calendar-date-style nil) ;not necessary for conversion
+ (should (string= "20210212"
+ (icalendar--datestring-to-isodate "2021 Feb 11" 1)))
+ (should (string= "20210131"
+ (icalendar--datestring-to-isodate "2021 Feb 11" -11)))
+ (should (string= "20200211"
+ (icalendar--datestring-to-isodate "2021 Feb 11" nil -1)))
+ (should (string= "21010211"
+ (icalendar--datestring-to-isodate "2021 Feb 11" nil 80)))
+ ))
(ert-deftest icalendar--first-weekday-of-year ()
"Test method for `icalendar-first-weekday-of-year'."
@@ -569,10 +581,10 @@ END:VEVENT
;; testcase: dtstart is mandatory
(should (null (icalendar--convert-tz-offset
- '((TZOFFSETFROM nil "+0100")
- (TZOFFSETTO nil "+0200")
- (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU"))
- t)))
+ '((TZOFFSETFROM nil "+0100")
+ (TZOFFSETTO nil "+0200")
+ (RRULE nil "FREQ=YEARLY;BYMONTH=3;BYDAY=-1SU"))
+ t)))
;; FIXME: rrule and rdate are NOT mandatory! Must fix code
;; before activating these testcases
@@ -830,18 +842,18 @@ SUMMARY:yearly no time
"Perform export test."
;; anniversaries
(icalendar-tests--test-export
- "%%(diary-anniversary 1989 10 3) anniversary no time"
- "%%(diary-anniversary 3 10 1989) anniversary no time"
- "%%(diary-anniversary 10 3 1989) anniversary no time"
+ "%%(diary-anniversary 1988 10 3) anniversary no time"
+ "%%(diary-anniversary 3 10 1988) anniversary no time"
+ "%%(diary-anniversary 10 3 1988) anniversary no time"
"DTSTART;VALUE=DATE:19891003
DTEND;VALUE=DATE:19891004
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03
SUMMARY:anniversary no time
")
(icalendar-tests--test-export
- "%%(diary-anniversary 1989 10 3) 19:00-20:00 anniversary with time"
- "%%(diary-anniversary 3 10 1989) 19:00-20:00 anniversary with time"
- "%%(diary-anniversary 10 3 1989) 19:00-20:00 anniversary with time"
+ "%%(diary-anniversary 1988 10 3) 19:00-20:00 anniversary with time"
+ "%%(diary-anniversary 3 10 1988) 19:00-20:00 anniversary with time"
+ "%%(diary-anniversary 10 3 1988) 19:00-20:00 anniversary with time"
"DTSTART;VALUE=DATE-TIME:19891003T190000
DTEND;VALUE=DATE-TIME:19891004T200000
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03
@@ -891,12 +903,12 @@ SUMMARY:no alarm
"
nil)
- ;; 10 minutes in advance, audio
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 audio alarm"
- "17 Nov 2014 19:30 audio alarm"
- "Nov 17 2014 19:30 audio alarm"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 10 minutes in advance, audio
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 audio alarm"
+ "17 Nov 2014 19:30 audio alarm"
+ "Nov 17 2014 19:30 audio alarm"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:audio alarm
BEGIN:VALARM
@@ -904,14 +916,14 @@ ACTION:AUDIO
TRIGGER:-PT10M
END:VALARM
"
- '(10 ((audio))))
+ '(10 ((audio))))
- ;; 20 minutes in advance, display
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 display alarm"
- "17 Nov 2014 19:30 display alarm"
- "Nov 17 2014 19:30 display alarm"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 20 minutes in advance, display
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 display alarm"
+ "17 Nov 2014 19:30 display alarm"
+ "Nov 17 2014 19:30 display alarm"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:display alarm
BEGIN:VALARM
@@ -920,14 +932,14 @@ TRIGGER:-PT20M
DESCRIPTION:display alarm
END:VALARM
"
- '(20 ((display))))
+ '(20 ((display))))
- ;; 66 minutes in advance, email
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 email alarm"
- "17 Nov 2014 19:30 email alarm"
- "Nov 17 2014 19:30 email alarm"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 66 minutes in advance, email
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 email alarm"
+ "17 Nov 2014 19:30 email alarm"
+ "Nov 17 2014 19:30 email alarm"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:email alarm
BEGIN:VALARM
@@ -939,14 +951,14 @@ ATTENDEE:MAILTO:att.one@email.com
ATTENDEE:MAILTO:att.two@email.com
END:VALARM
"
- '(66 ((email ("att.one@email.com" "att.two@email.com")))))
+ '(66 ((email ("att.one@email.com" "att.two@email.com")))))
- ;; 2 minutes in advance, all alarms
- (icalendar-tests--test-export
- "2014 Nov 17 19:30 all alarms"
- "17 Nov 2014 19:30 all alarms"
- "Nov 17 2014 19:30 all alarms"
- "DTSTART;VALUE=DATE-TIME:20141117T193000
+ ;; 2 minutes in advance, all alarms
+ (icalendar-tests--test-export
+ "2014 Nov 17 19:30 all alarms"
+ "17 Nov 2014 19:30 all alarms"
+ "Nov 17 2014 19:30 all alarms"
+ "DTSTART;VALUE=DATE-TIME:20141117T193000
DTEND;VALUE=DATE-TIME:20141117T203000
SUMMARY:all alarms
BEGIN:VALARM
@@ -967,7 +979,7 @@ TRIGGER:-PT2M
DESCRIPTION:all alarms
END:VALARM
"
- '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display)))))
+ '(2 ((email ("att.one@email.com" "att.two@email.com")) (audio) (display)))))
;; ======================================================================
;; Import tests
@@ -1247,7 +1259,7 @@ Argument INPUT icalendar event string."
(find-file temp-ics)
(goto-char (point-min))
;;(when (re-search-forward "\nUID:.*\n" nil t)
- ;;(replace-match "\n"))
+ ;;(replace-match "\n"))
(let ((cycled (buffer-substring-no-properties (point-min) (point-max))))
(should (string= org-input cycled)))))
;; clean up
@@ -1276,8 +1288,8 @@ DESCRIPTION:beschreibung!
LOCATION:nowhere
ORGANIZER:ulf
")
- (icalendar-tests--test-cycle
- "UID:4711
+ (icalendar-tests--test-cycle
+ "UID:4711
DTSTART;VALUE=DATE:19190909
DTEND;VALUE=DATE:19190910
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09
@@ -1377,7 +1389,7 @@ SUMMARY:ff")
"
>>> anniversaries:
-%%(diary-anniversary 3 28 1991) aa birthday (%d years old)"
+%%(diary-anniversary 3 28 1990) aa birthday (%d years old)"
"DTSTART;VALUE=DATE:19910328
DTEND;VALUE=DATE:19910329
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=03;BYMONTHDAY=28
@@ -1387,7 +1399,7 @@ SUMMARY:aa birthday (%d years old)
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 5 17 1957) bb birthday (%d years old)"
+ "%%(diary-anniversary 5 17 1956) bb birthday (%d years old)"
"DTSTART;VALUE=DATE:19570517
DTEND;VALUE=DATE:19570518
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=05;BYMONTHDAY=17
@@ -1396,7 +1408,7 @@ SUMMARY:bb birthday (%d years old)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 6 8 1997) cc birthday (%d years old)"
+ "%%(diary-anniversary 6 8 1996) cc birthday (%d years old)"
"DTSTART;VALUE=DATE:19970608
DTEND;VALUE=DATE:19970609
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=08
@@ -1405,7 +1417,7 @@ SUMMARY:cc birthday (%d years old)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 7 22 1983) dd (%d years ago...!)"
+ "%%(diary-anniversary 7 22 1982) dd (%d years ago...!)"
"DTSTART;VALUE=DATE:19830722
DTEND;VALUE=DATE:19830723
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=07;BYMONTHDAY=22
@@ -1414,7 +1426,7 @@ SUMMARY:dd (%d years ago...!)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 8 1 1988) ee birthday (%d years old)"
+ "%%(diary-anniversary 8 1 1987) ee birthday (%d years old)"
"DTSTART;VALUE=DATE:19880801
DTEND;VALUE=DATE:19880802
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=08;BYMONTHDAY=01
@@ -1423,7 +1435,7 @@ SUMMARY:ee birthday (%d years old)")
(icalendar-tests--test-export
nil
nil
- "%%(diary-anniversary 9 21 1957) ff birthday (%d years old)"
+ "%%(diary-anniversary 9 21 1956) ff birthday (%d years old)"
"DTSTART;VALUE=DATE:19570921
DTEND;VALUE=DATE:19570922
RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=21
diff --git a/test/lisp/calendar/iso8601-tests.el b/test/lisp/calendar/iso8601-tests.el
index 618e5b12386..c4d038ab68c 100644
--- a/test/lisp/calendar/iso8601-tests.el
+++ b/test/lisp/calendar/iso8601-tests.el
@@ -183,7 +183,15 @@
(should (equal (iso8601-parse-time "15:27:35.123" t)
'((35123 . 1000) 27 15 nil nil nil nil -1 nil)))
(should (equal (iso8601-parse-time "15:27:35.123456789" t)
- '((35123456789 . 1000000000) 27 15 nil nil nil nil -1 nil))))
+ '((35123456789 . 1000000000) 27 15 nil nil nil nil -1 nil)))
+ (should (equal (iso8601-parse-time "15:27:35.012345678" t)
+ '((35012345678 . 1000000000) 27 15 nil nil nil nil -1 nil)))
+ (should (equal (iso8601-parse-time "15:27:35.00001" t)
+ '((3500001 . 100000) 27 15 nil nil nil nil -1 nil)))
+ (should (equal (iso8601-parse-time "15:27:35.0000100" t)
+ '((3500001 . 100000) 27 15 nil nil nil nil -1 nil)))
+ (should (equal (iso8601-parse-time "15:27:35.0" t)
+ '(35 27 15 nil nil nil nil -1 nil))))
(ert-deftest standard-test-time-of-day-beginning-of-day ()
(should (equal (iso8601-parse-time "000000")
diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el
index b90fe0bd85b..b706b73570d 100644
--- a/test/lisp/calendar/parse-time-tests.el
+++ b/test/lisp/calendar/parse-time-tests.el
@@ -1,4 +1,4 @@
-;; parse-time-tests.el --- Test suite for parse-time.el -*- lexical-binding:t -*-
+;;; parse-time-tests.el --- Test suite for parse-time.el -*- lexical-binding:t -*-
;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/cedet/cedet-files-tests.el b/test/lisp/cedet/cedet-files-tests.el
new file mode 100644
index 00000000000..5502d424314
--- /dev/null
+++ b/test/lisp/cedet/cedet-files-tests.el
@@ -0,0 +1,54 @@
+;;; cedet-files-tests.el --- Tests for cedet-files.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/cedet-utests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'cedet-files)
+
+(defvar cedet-files-utest-list
+ '(
+ ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
+ ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
+ ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
+ ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
+ )
+ "List of different file names to test.
+Each entry is a cons cell of ( FNAME . CONVERTED )
+where FNAME is some file name, and CONVERTED is what it should be
+converted into.")
+
+(ert-deftest cedet-files-utest ()
+ "Test out some file name conversions."
+ (interactive)
+ (dolist (FT cedet-files-utest-list)
+ (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
+ (file->dir (cedet-file-name-to-directory-name (cdr FT) t)))
+ (should (string= (cdr FT) dir->file))
+ (should (string= file->dir (car FT))))))
+
+(provide 'cedet-files-tests)
+
+;;; cedet-files-tests.el ends here
diff --git a/test/lisp/cedet/semantic-utest-c.el b/test/lisp/cedet/semantic-utest-c.el
index a7cbe116c2e..d08c79cad3e 100644
--- a/test/lisp/cedet/semantic-utest-c.el
+++ b/test/lisp/cedet/semantic-utest-c.el
@@ -43,7 +43,6 @@
(defvar semantic-lex-c-nested-namespace-ignore-second)
;;; Code:
-;;;###autoload
(ert-deftest semantic-test-c-preprocessor-simulation ()
"Run parsing test for C from the test directory."
:tags '(:expensive-test)
diff --git a/test/lisp/cedet/semantic-utest-fmt.el b/test/lisp/cedet/semantic-utest-fmt.el
deleted file mode 100644
index d6e5ce7a0fd..00000000000
--- a/test/lisp/cedet/semantic-utest-fmt.el
+++ /dev/null
@@ -1,127 +0,0 @@
-;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*- lexical-binding:t -*-
-
-;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
-
-;; Author: Eric M. Ludlam <zappo@gnu.org>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Unit tests for the formatting feature.
-;;
-;; Using test code from the tests source directory, parse the source
-;; file. After parsing, read the comments for each signature, and
-;; make sure that the semantic-tag-format-* functions in question
-;; created the desired output.
-
-(require 'semantic)
-(require 'semantic/format)
-
-;;; Code:
-
-(defvar cedet-utest-directory
- (let* ((C (file-name-directory (locate-library "cedet")))
- (D (expand-file-name "../../test/manual/cedet/" C)))
- D)
- "Location of test files for this test suite.")
-
-(defvar semantic-fmt-utest-file-list
- '("tests/test-fmt.cpp"
- ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs
- )
- "List of files to run unit tests in.")
-
-(defvar semantic-fmt-utest-error-log-list nil
- "Log errors during testing in this variable.")
-
-(ert-deftest semantic-fmt-utest ()
- "Visit all file entries, and run formatting test.
-Files to visit are in `semantic-fmt-utest-file-list'."
- (save-current-buffer
- (semantic-mode 1)
- (let ((fl semantic-fmt-utest-file-list)
- (fname nil)
- )
-
- (dolist (FILE fl)
-
- (save-current-buffer
- (setq fname (expand-file-name FILE cedet-utest-directory))
-
- ;; Make sure we have the files we think we have.
- (should (file-exists-p fname))
- ;; (error "Cannot find unit test file: %s" fname))
-
- ;; Run the tests.
- (let ((fb (find-buffer-visiting fname))
- (b (semantic-find-file-noselect fname))
- (tags nil))
-
- (save-current-buffer
- (set-buffer b)
- (should (semantic-active-p))
- ;;(error "Cannot open %s for format tests" fname))
-
- ;; This will force a reparse, removing any chance of semanticdb cache
- ;; using stale data.
- (semantic-clear-toplevel-cache)
- ;; Force the reparse
- (setq tags (semantic-fetch-tags))
-
- (save-excursion
- (while tags
- (let* ((T (car tags))
- (start (semantic-tag-end T))
- (end (if (cdr tags)
- (semantic-tag-start (car (cdr tags)))
- (point-max)))
- (TESTS nil)
- )
- (goto-char start)
- ;; Scan the space between tags for all test condition matches.
- (while (re-search-forward "## \\([a-z-]+\\) \"\\([^\n\"]+\\)\"$" end t)
- (push (cons (match-string 1) (match-string 2)) TESTS))
- (setq TESTS (nreverse TESTS))
-
- (dolist (TST TESTS)
- (let* ( ;; For each test, convert CAR into a semantic-format-tag* fcn
- (sym (intern (concat "semantic-format-tag-" (car TST))))
- ;; Convert the desired result from a string syntax to a string.
- (desired (cdr TST))
- ;; What does the fmt function do?
- (actual (funcall sym T))
- )
- (when (not (string= desired actual))
- (should-not (list "Desired" desired
- "Actual" actual
- "Formatter" (car TST))))
- )))
- (setq tags (cdr tags)))
-
- ))
-
- ;; If it wasn't already in memory, whack it.
- (when (and b (not fb))
- (kill-buffer b)))
- ))
-
- )))
-
-
-(provide 'cedet/semantic/fmt-utest)
-
-;;; semantic-fmt-utest.el ends here
diff --git a/test/manual/cedet/tests/test.mk b/test/lisp/cedet/semantic-utest-ia-resources/test.mk
index edea97e7b98..edea97e7b98 100644
--- a/test/manual/cedet/tests/test.mk
+++ b/test/lisp/cedet/semantic-utest-ia-resources/test.mk
diff --git a/test/manual/cedet/tests/test.srt b/test/lisp/cedet/semantic-utest-ia-resources/test.srt
index 38e6f9ed7b7..38e6f9ed7b7 100644
--- a/test/manual/cedet/tests/test.srt
+++ b/test/lisp/cedet/semantic-utest-ia-resources/test.srt
diff --git a/test/manual/cedet/tests/test.texi b/test/lisp/cedet/semantic-utest-ia-resources/test.texi
index 37d303c8b48..37d303c8b48 100644
--- a/test/manual/cedet/tests/test.texi
+++ b/test/lisp/cedet/semantic-utest-ia-resources/test.texi
diff --git a/test/manual/cedet/tests/testdoublens.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp
index ea3afc72a69..ea3afc72a69 100644
--- a/test/manual/cedet/tests/testdoublens.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.cpp
diff --git a/test/manual/cedet/tests/testdoublens.hpp b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp
index e8c9b345b28..e8c9b345b28 100644
--- a/test/manual/cedet/tests/testdoublens.hpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testdoublens.hpp
diff --git a/test/manual/cedet/tests/testfriends.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
index 20425f93afa..f84ed5a2190 100644
--- a/test/manual/cedet/tests/testfriends.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testfriends.cpp
@@ -35,4 +35,3 @@ int B::testB() {
int B::testAB() { // %1% ( ( "testfriends.cpp" ) ( "B" "B::testAB" ) )
}
-
diff --git a/test/manual/cedet/tests/testjavacomp.java b/test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java
index bfc016903c8..bfc016903c8 100644
--- a/test/manual/cedet/tests/testjavacomp.java
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testjavacomp.java
diff --git a/test/manual/cedet/tests/testlocalvars.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp
index 9d2329a0fa8..9d2329a0fa8 100644
--- a/test/manual/cedet/tests/testlocalvars.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testlocalvars.cpp
diff --git a/test/manual/cedet/tests/testnsp.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp
index db1603cead2..db1603cead2 100644
--- a/test/manual/cedet/tests/testnsp.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testnsp.cpp
diff --git a/test/manual/cedet/tests/testsppcomplete.c b/test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c
index 084d6a8687d..084d6a8687d 100644
--- a/test/manual/cedet/tests/testsppcomplete.c
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testsppcomplete.c
diff --git a/test/manual/cedet/tests/teststruct.cpp b/test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp
index 6659b5557b8..6659b5557b8 100644
--- a/test/manual/cedet/tests/teststruct.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/teststruct.cpp
diff --git a/test/manual/cedet/tests/testsubclass.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp
index 409950cce2f..409950cce2f 100644
--- a/test/manual/cedet/tests/testsubclass.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.cpp
diff --git a/test/manual/cedet/tests/testsubclass.hh b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh
index 5d795b32b10..5d795b32b10 100644
--- a/test/manual/cedet/tests/testsubclass.hh
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testsubclass.hh
diff --git a/test/manual/cedet/tests/testtemplates.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp
index ed7a057df0b..ed7a057df0b 100644
--- a/test/manual/cedet/tests/testtemplates.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testtemplates.cpp
diff --git a/test/manual/cedet/tests/testtypedefs.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp
index c82535f9581..c82535f9581 100644
--- a/test/manual/cedet/tests/testtypedefs.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testtypedefs.cpp
diff --git a/test/manual/cedet/tests/testusing.cpp b/test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp
index 6f6c8542633..6f6c8542633 100644
--- a/test/manual/cedet/tests/testusing.cpp
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testusing.cpp
diff --git a/test/manual/cedet/tests/testusing.hh b/test/lisp/cedet/semantic-utest-ia-resources/testusing.hh
index d3b690f8542..d3b690f8542 100644
--- a/test/manual/cedet/tests/testusing.hh
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testusing.hh
diff --git a/test/manual/cedet/tests/testvarnames.c b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c
index e796eb285c6..e796eb285c6 100644
--- a/test/manual/cedet/tests/testvarnames.c
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.c
diff --git a/test/manual/cedet/tests/testvarnames.java b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java
index 7ed9785fc07..7ed9785fc07 100644
--- a/test/manual/cedet/tests/testvarnames.java
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testvarnames.java
diff --git a/test/manual/cedet/tests/testwisent.wy b/test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy
index 49eb5780f4b..49eb5780f4b 100644
--- a/test/manual/cedet/tests/testwisent.wy
+++ b/test/lisp/cedet/semantic-utest-ia-resources/testwisent.wy
diff --git a/test/lisp/cedet/semantic-utest-ia.el b/test/lisp/cedet/semantic-utest-ia.el
index 7210f66b0a7..122c431d472 100644
--- a/test/lisp/cedet/semantic-utest-ia.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -30,121 +30,94 @@
;; (Replace // with contents of comment-start for the language being tested.)
;;; Code:
+(require 'ert)
+(require 'ert-x)
(require 'semantic)
(require 'semantic/analyze)
(require 'semantic/analyze/refs)
(require 'semantic/symref)
(require 'semantic/symref/filter)
-(defvar cedet-utest-directory
- (let* ((C (file-name-directory (locate-library "cedet")))
- (D (expand-file-name "../../test/manual/cedet/" C)))
- D)
- "Location of test files for this test suite.")
-
-(defvar semantic-utest-test-directory (expand-file-name "tests" cedet-utest-directory)
- "Location of test files.")
-
(ert-deftest semantic-utest-ia-doublens.cpp ()
- (let ((tst (expand-file-name "testdoublens.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testdoublens.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-subclass.cpp ()
- (let ((tst (expand-file-name "testsubclass.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testsubclass.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-typedefs.cpp ()
- (let ((tst (expand-file-name "testtypedefs.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testtypedefs.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-struct.cpp ()
- (let ((tst (expand-file-name "teststruct.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "teststruct.cpp")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-union.cpp ()
-;; (let ((tst (expand-file-name "testunion.cpp" semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testunion.cpp")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-templates.cpp ()
- (let ((tst (expand-file-name "testtemplates.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testtemplates.cpp")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-friends.cpp ()
-;; (let ((tst (expand-file-name "testfriends.cpp" semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testfriends.cpp")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-using.cpp ()
- (let ((tst (expand-file-name "testusing.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testusing.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-nsp.cpp ()
(skip-unless (executable-find "g++"))
- (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testnsp.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-localvars.cpp ()
- (let ((tst (expand-file-name "testlocalvars.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testlocalvars.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-namespace.cpp ()
(skip-unless (executable-find "g++"))
- (let ((tst (expand-file-name "testnsp.cpp" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testnsp.cpp")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-sppcomplete.c ()
- (let ((tst (expand-file-name "testsppcomplete.c" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testsppcomplete.c")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-varnames.c ()
- (let ((tst (expand-file-name "testvarnames.c" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testvarnames.c")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-javacomp.java ()
- (let ((tst (expand-file-name "testjavacomp.java" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testjavacomp.java")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-varnames.java ()
- (let ((tst (expand-file-name "testvarnames.java" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testvarnames.java")))
(should-not (semantic-ia-utest tst))))
;;(ert-deftest semantic-utest-ia-f90.f90 ()
-;; (let ((tst (expand-file-name "testf90.f90" semantic-utest-test-directory)))
-;; (should (file-exists-p tst))
+;; (let ((tst (ert-resource-file "testf90.f90")))
;; (should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-wisent.wy ()
- (let ((tst (expand-file-name "testwisent.wy" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "testwisent.wy")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-texi ()
- (let ((tst (expand-file-name "test.texi" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.texi")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-make ()
- (let ((tst (expand-file-name "test.mk" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.mk")))
(should-not (semantic-ia-utest tst))))
(ert-deftest semantic-utest-ia-srecoder ()
- (let ((tst (expand-file-name "test.srt" semantic-utest-test-directory)))
- (should (file-exists-p tst))
+ (let ((tst (ert-resource-file "test.srt")))
(should-not (semantic-ia-utest tst))))
;;; Core testing utility
diff --git a/test/lisp/cedet/semantic-utest.el b/test/lisp/cedet/semantic-utest.el
index 67de4a5b02d..172ab62f895 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -1,6 +1,6 @@
;;; semantic-utest.el --- Tests for semantic's parsing system. -*- lexical-binding:t -*-
-;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/cedet/semantic/bovine/gcc-tests.el b/test/lisp/cedet/semantic/bovine/gcc-tests.el
new file mode 100644
index 00000000000..93677d6c871
--- /dev/null
+++ b/test/lisp/cedet/semantic/bovine/gcc-tests.el
@@ -0,0 +1,129 @@
+;;; gcc-tests.el --- Tests for semantic/bovine/gcc.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/semantic-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'semantic/bovine/gcc)
+
+;;; From bovine-gcc:
+
+;; Example output of "gcc -v"
+(defvar semantic-gcc-test-strings
+ '(;; My old box:
+ "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux
+Thread model: posix
+gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
+ ;; Alex Ott:
+ "Using built-in specs.
+Target: i486-linux-gnu
+Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu
+Thread model: posix
+gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
+ ;; My debian box:
+ "Using built-in specs.
+Target: x86_64-unknown-linux-gnu
+Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
+Thread model: posix
+gcc version 4.2.3"
+ ;; My mac:
+ "Using built-in specs.
+Target: i686-apple-darwin8
+Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
+Thread model: posix
+gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
+ ;; Ubuntu Intrepid
+ "Using built-in specs.
+Target: x86_64-linux-gnu
+Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu
+Thread model: posix
+gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
+ ;; Red Hat EL4
+ "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
+Thread model: posix
+gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
+ ;; Red Hat EL5
+ "Using built-in specs.
+Target: x86_64-redhat-linux
+Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux
+Thread model: posix
+gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
+ ;; David Engster's german gcc on ubuntu 4.3
+ "Es werden eingebaute Spezifikationen verwendet.
+Ziel: i486-linux-gnu
+Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu
+Thread-Modell: posix
+gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
+ ;; Damien Deville bsd
+ "Using built-in specs.
+Target: i386-undermydesk-freebsd
+Configured with: FreeBSD/i386 system compiler
+Thread model: posix
+gcc version 4.2.1 20070719 [FreeBSD]"
+ )
+ "A bunch of sample gcc -v outputs from different machines.")
+
+(defvar semantic-gcc-test-strings-fail
+ '(;; A really old solaris box I found
+ "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
+gcc version 2.95.2 19991024 (release)"
+ )
+ "A bunch of sample gcc -v outputs that fail to provide the info we want.")
+
+(defun semantic-gcc-test-output-parser ()
+ "Test the output parser against some collected strings."
+ (dolist (S semantic-gcc-test-strings)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc 'target fields))
+ (cdr (assoc '--target fields))
+ (cdr (assoc '--host fields))))
+ (p (cdr (assoc '--prefix fields))))
+ ;; No longer test for prefixes.
+ (when (not (and v h))
+ (let ((strs (split-string S "\n")))
+ (error "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)))))
+ (dolist (S semantic-gcc-test-strings-fail)
+ (let* ((fields (semantic-gcc-fields S))
+ (v (cdr (assoc 'version fields)))
+ (h (or (cdr (assoc '--host fields))
+ (cdr (assoc 'target fields))))
+ (p (cdr (assoc '--prefix fields)))
+ )
+ (when (and v h p)
+ (error "Negative test failed on %S" S)))))
+
+(ert-deftest semantic-gcc-test-output-parser ()
+ (semantic-gcc-test-output-parser))
+
+(ert-deftest semantic-gcc-test-output-parser-this-machine ()
+ "Test the output parser against the machine currently running Emacs."
+ (skip-unless (executable-find "gcc"))
+ (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
+ (semantic-gcc-test-output-parser)))
+
+;;; gcc-tests.el ends here
diff --git a/test/manual/cedet/tests/test-fmt.cpp b/test/lisp/cedet/semantic/format-resources/test-fmt.cpp
index ab869c1ce00..ab869c1ce00 100644
--- a/test/manual/cedet/tests/test-fmt.cpp
+++ b/test/lisp/cedet/semantic/format-resources/test-fmt.cpp
diff --git a/test/manual/cedet/tests/test-fmt.el b/test/lisp/cedet/semantic/format-resources/test-fmt.el
index 122571323b2..8458a8e6510 100644
--- a/test/manual/cedet/tests/test-fmt.el
+++ b/test/lisp/cedet/semantic/format-resources/test-fmt.el
@@ -1,6 +1,6 @@
-;;; test-fmt.el --- test semantic tag formatting
+;;; test-fmt.el --- test semantic tag formatting -*- lexical-binding: t -*-
-;;; Copyright (C) 2012, 2019-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/test/lisp/cedet/semantic/format-tests.el b/test/lisp/cedet/semantic/format-tests.el
new file mode 100644
index 00000000000..149f408af15
--- /dev/null
+++ b/test/lisp/cedet/semantic/format-tests.el
@@ -0,0 +1,95 @@
+;;; semantic/format-tests.el --- Parsing / Formatting tests -*- lexical-binding:t -*-
+
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for the formatting feature.
+;;
+;; Using test code from the tests source directory, parse the source
+;; file. After parsing, read the comments for each signature, and
+;; make sure that the semantic-tag-format-* functions in question
+;; created the desired output.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'semantic/format)
+
+(defvar semantic-fmt-utest-file-list
+ (list (ert-resource-file "test-fmt.cpp")
+ ;; "tests/test-fmt.el" - add this when elisp is support by dflt in Emacs
+ )
+ "List of files to run unit tests in.")
+
+(ert-deftest semantic-fmt-utest ()
+ "Visit all file entries, and run formatting test. "
+ (save-current-buffer
+ (semantic-mode 1)
+ (dolist (fname semantic-fmt-utest-file-list)
+ (let ((fb (find-buffer-visiting fname))
+ (b (semantic-find-file-noselect fname))
+ (tags nil))
+ (save-current-buffer
+ (set-buffer b)
+ (should (semantic-active-p))
+ ;;(error "Cannot open %s for format tests" fname))
+
+ ;; This will force a reparse, removing any chance of semanticdb cache
+ ;; using stale data.
+ (semantic-clear-toplevel-cache)
+ ;; Force the reparse
+ (setq tags (semantic-fetch-tags))
+
+ (save-excursion
+ (while tags
+ (let* ((T (car tags))
+ (start (semantic-tag-end T))
+ (end (if (cdr tags)
+ (semantic-tag-start (car (cdr tags)))
+ (point-max)))
+ (TESTS nil))
+ (goto-char start)
+ ;; Scan the space between tags for all test condition matches.
+ (while (re-search-forward "## \\([a-z-]+\\) \"\\([^\n\"]+\\)\"$" end t)
+ (push (cons (match-string 1) (match-string 2)) TESTS))
+ (setq TESTS (nreverse TESTS))
+
+ (dolist (TST TESTS)
+ (let* ( ;; For each test, convert CAR into a semantic-format-tag* fcn
+ (sym (intern (concat "semantic-format-tag-" (car TST))))
+ ;; Convert the desired result from a string syntax to a string.
+ (desired (cdr TST))
+ ;; What does the fmt function do?
+ (actual (funcall sym T)))
+ (when (not (string= desired actual))
+ (should-not (list "Desired" desired
+ "Actual" actual
+ "Formatter" (car TST)))))))
+ (setq tags (cdr tags)))))
+
+ ;; If it wasn't already in memory, whack it.
+ (when (and b (not fb))
+ (kill-buffer b))))))
+
+(provide 'format-tests)
+
+;;; format-tests.el ends here
diff --git a/test/lisp/cedet/semantic/fw-tests.el b/test/lisp/cedet/semantic/fw-tests.el
new file mode 100644
index 00000000000..7b1cd21bd1b
--- /dev/null
+++ b/test/lisp/cedet/semantic/fw-tests.el
@@ -0,0 +1,45 @@
+;;; fw-tests.el --- Tests for semantic/fw.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/semantic-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'semantic/fw)
+
+;;; From semantic-fw:
+
+(ert-deftest semantic-test-data-cache ()
+ "Test the data cache."
+ (let ((data '(a b c)))
+ (with-current-buffer (get-buffer-create " *semantic-test-data-cache*")
+ (erase-buffer)
+ (insert "The Moose is Loose")
+ (goto-char (point-min))
+ (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
+ data 'moose 'exit-cache-zone)
+ ;; retrieve cached data
+ (should (equal (semantic-get-cache-data 'moose) data)))))
+
+;;; gw-tests.el ends here
diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el
index f97ff18320e..087dcfd8996 100644
--- a/test/lisp/cedet/srecode-utest-template.el
+++ b/test/lisp/cedet/srecode-utest-template.el
@@ -1,4 +1,4 @@
-;;; srecode/test.el --- SRecode Core Template tests. -*- lexical-binding:t -*-
+;;; srecode-utest-template.el --- SRecode Core Template tests. -*- lexical-binding:t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/cedet/srecode/document-tests.el b/test/lisp/cedet/srecode/document-tests.el
new file mode 100644
index 00000000000..0bc6e10d7a7
--- /dev/null
+++ b/test/lisp/cedet/srecode/document-tests.el
@@ -0,0 +1,80 @@
+;;; document-tests.el --- Tests for srecode/document.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Extracted from srecode-document.el in the CEDET distribution.
+
+;; Converted to ert from test/manual/cedet/srecode-tests.el
+
+;;; Code:
+
+(require 'ert)
+(require 'srecode/document)
+
+;; FIXME: This test fails even before conversion to ert.
+(ert-deftest srecode-document-function-comment-extract-test ()
+ "Test old comment extraction.
+Dump out the extracted dictionary."
+ :tags '(:unstable)
+ (interactive)
+
+ (srecode-load-tables-for-mode major-mode)
+ (srecode-load-tables-for-mode major-mode 'document)
+
+ (should (srecode-table))
+ ;; (error "No template table found for mode %s" major-mode)
+
+ (let* ((temp (srecode-template-get-table (srecode-table)
+ "function-comment"
+ "declaration"
+ 'document))
+ (fcn-in (semantic-current-tag)))
+
+ (should temp)
+ ;; (error "No templates for function comments")
+
+ ;; Try to figure out the tag we want to use.
+ (should fcn-in)
+ (should (semantic-tag-of-class-p fcn-in 'function))
+ ;; (error "No tag of class 'function to insert comment for")
+
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex)))
+
+ (should lextok)
+ ;; (error "No comment to attempt an extraction")
+
+ (let ((s (semantic-lex-token-start lextok))
+ (e (semantic-lex-token-end lextok))
+ (extract nil))
+
+ (pulse-momentary-highlight-region s e)
+
+ ;; Extract text from the existing comment.
+ (setq extract (srecode-extract temp s e))
+
+ (with-output-to-temp-buffer "*SRECODE DUMP*"
+ (princ "EXTRACTED DICTIONARY FOR ")
+ (princ (semantic-tag-name fcn-in))
+ (princ "\n--------------------------------------------\n")
+ (srecode-dump extract))))))
+
+;;; document-tests.el ends here
diff --git a/test/manual/cedet/srecode-tests.el b/test/lisp/cedet/srecode/fields-tests.el
index ebc3261f817..5f634a5e4ce 100644
--- a/test/manual/cedet/srecode-tests.el
+++ b/test/lisp/cedet/srecode/fields-tests.el
@@ -1,4 +1,4 @@
-;;; srecode-tests.el --- Some tests for CEDET's srecode
+;;; srecode/fields-tests.el --- Tests for srecode/fields.el -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -21,13 +21,15 @@
;;; Commentary:
-;; Extracted from srecode-fields.el and srecode-document.el in the
-;; CEDET distribution.
+;; Extracted from srecode-fields.el in the CEDET distribution.
+
+;; Converted to ert from test/manual/cedet/srecode-tests.el
;;; Code:
;;; From srecode-fields:
+(require 'ert)
(require 'srecode/fields)
(defvar srecode-field-utest-text
@@ -36,13 +38,10 @@
It is filled with some text."
"Text for tests.")
-(defun srecode-field-utest ()
- "Test the srecode field manager."
- (interactive)
- (srecode-field-utest-impl))
-
-(defun srecode-field-utest-impl ()
+;; FIXME: This test fails even before conversion to ert.
+(ert-deftest srecode-field-utest-impl ()
"Implementation of the SRecode field utest."
+ :tags '(:unstable)
(save-excursion
(find-file "/tmp/srecode-field-test.txt")
@@ -131,15 +130,15 @@ It is filled with some text."
;; Various sizes
(mapc (lambda (T)
- (if (string= (object-name-string T) "Test4")
+ (if (string= (eieio-object-name-string T) "Test4")
(progn
(when (not (srecode-empty-region-p T))
(error "Field %s is not empty"
- (object-name T)))
+ (eieio-object-name T)))
)
(when (not (= (srecode-region-size T) 5))
(error "Calculated size of %s was not 5"
- (object-name T)))))
+ (eieio-object-name T)))))
fields)
;; Make sure things stay up after a 'command'.
@@ -151,21 +150,21 @@ It is filled with some text."
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 0 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 0 fields))))
+ (eieio-object-name (nth 0 fields))))
(srecode-field-next)
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 1 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 1 fields))))
+ (eieio-object-name (nth 1 fields))))
(srecode-field-prev)
(when (not (eq (srecode-overlaid-at-point 'srecode-field)
(nth 0 fields)))
(error "Region Test: Field %s not under point"
- (object-name (nth 0 fields))))
+ (eieio-object-name (nth 0 fields))))
;; Move cursor out of the region and have everything cleaned up.
(goto-char 42)
@@ -176,7 +175,7 @@ It is filled with some text."
(mapc (lambda (T)
(when (slot-boundp T 'overlay)
(error "Overlay did not clear off of field %s"
- (object-name T))))
+ (eieio-object-name T))))
fields)
;; End of LET
@@ -187,8 +186,7 @@ It is filled with some text."
(f1 (srecode-field "Test1" :name "TEST" :start 6 :end 8))
(f2 (srecode-field "Test2" :name "TEST" :start 28 :end 30))
(f3 (srecode-field "Test3" :name "NOTTEST" :start 35 :end 40))
- (reg (srecode-template-inserted-region "REG" :start 4 :end 40))
- )
+ (reg (srecode-template-inserted-region "REG" :start 4 :end 40)))
(srecode-overlaid-activate reg)
(when (not (string= (srecode-overlaid-text f1)
@@ -233,62 +231,8 @@ It is filled with some text."
(error "Linkage Test: tail-insert string on dissimilar fields is now the same"))
;; Cleanup
- (srecode-delete reg)
- )
-
- (set-buffer-modified-p nil)
-
- (message " All field tests passed.")
- ))
-
-;;; From srecode-document:
-
-(require 'srecode/document)
-
-(defun srecode-document-function-comment-extract-test ()
- "Test old comment extraction.
-Dump out the extracted dictionary."
- (interactive)
-
- (srecode-load-tables-for-mode major-mode)
- (srecode-load-tables-for-mode major-mode 'document)
-
- (if (not (srecode-table))
- (error "No template table found for mode %s" major-mode))
-
- (let* ((temp (srecode-template-get-table (srecode-table)
- "function-comment"
- "declaration"
- 'document))
- (fcn-in (semantic-current-tag)))
-
- (if (not temp)
- (error "No templates for function comments"))
-
- ;; Try to figure out the tag we want to use.
- (when (or (not fcn-in)
- (not (semantic-tag-of-class-p fcn-in 'function)))
- (error "No tag of class 'function to insert comment for"))
-
- (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
- )
-
- (when (not lextok)
- (error "No comment to attempt an extraction"))
-
- (let ((s (semantic-lex-token-start lextok))
- (e (semantic-lex-token-end lextok))
- (extract nil))
-
- (pulse-momentary-highlight-region s e)
-
- ;; Extract text from the existing comment.
- (setq extract (srecode-extract temp s e))
+ (srecode-delete reg))
- (with-output-to-temp-buffer "*SRECODE DUMP*"
- (princ "EXTRACTED DICTIONARY FOR ")
- (princ (semantic-tag-name fcn-in))
- (princ "\n--------------------------------------------\n")
- (srecode-dump extract))))))
+ (set-buffer-modified-p nil)))
-;;; srecode-tests.el ends here
+;;; srecode/fields-tests.el ends here
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index de1bc548e18..8a9a41f452f 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -44,6 +44,7 @@
"Password (again):"
"Enter password:"
"Enter Auth Password:" ; OpenVPN (Bug#35724)
+ "Verify password: " ; zip -e zipfile.zip ... (Bug#47209)
"Mot de Passe :" ; localized (Bug#29729)
"Passwort:") ; localized
"List of strings that should match `comint-password-prompt-regexp'.")
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
index 95f62e0d7ea..97b3349000c 100644
--- a/test/lisp/cus-edit-tests.el
+++ b/test/lisp/cus-edit-tests.el
@@ -53,9 +53,9 @@
(customize-apropos "cus-edit-tests")
(should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
-(ert-deftest cus-edit-tests-customize-changed-options/hide-obsolete ()
+(ert-deftest cus-edit-tests-customize-changed/hide-obsolete ()
(with-cus-edit-test "*Customize Changed Options*"
- (customize-changed-options "917.2") ; some future version
+ (customize-changed "917.2") ;; Some future version.
(should-not (search-forward cus-edit-tests--obsolete-option-tag nil t))))
(ert-deftest cus-edit-tests-customize-group/hide-obsolete ()
diff --git a/test/lisp/custom-resources/custom--test-theme.el b/test/lisp/custom-resources/custom--test-theme.el
index 4ced98a50bc..36424cdfcc3 100644
--- a/test/lisp/custom-resources/custom--test-theme.el
+++ b/test/lisp/custom-resources/custom--test-theme.el
@@ -1,4 +1,4 @@
-;;; custom--test-theme.el -- A test theme. -*- lexical-binding:t -*-
+;;; custom--test-theme.el --- A test theme. -*- lexical-binding:t -*-
(deftheme custom--test
"A test theme.")
@@ -6,6 +6,8 @@
(custom-theme-set-variables
'custom--test
'(custom--test-user-option 'bar)
- '(custom--test-variable 'bar))
+ '(custom--test-variable 'bar)
+ '(custom--test-bug-21355-before 'before)
+ '(custom--test-bug-21355-after 'after))
(provide-theme 'custom--test)
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 10854c71d56..e93c96e1d93 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -24,70 +24,108 @@
(require 'wid-edit)
(require 'cus-edit)
-(require 'seq) ; For `seq-find'.
+
+(defmacro custom-tests--with-temp-dir (&rest body)
+ "Eval BODY with `temporary-file-directory' bound to a fresh directory.
+Ensure the directory is recursively deleted after the fact."
+ (declare (debug t) (indent 0))
+ (let ((dir (make-symbol "dir")))
+ `(let ((,dir (file-name-as-directory (make-temp-file "custom-tests-" t))))
+ (unwind-protect
+ (let ((temporary-file-directory ,dir))
+ ,@body)
+ (delete-directory ,dir t)))))
(ert-deftest custom-theme--load-path ()
"Test `custom-theme--load-path' behavior."
- (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t))))
- (unwind-protect
- ;; Create all temporary files under the same deletable parent.
- (let ((temporary-file-directory tmpdir))
- ;; Path is empty.
- (let ((custom-theme-load-path ()))
- (should (null (custom-theme--load-path))))
-
- ;; Path comprises non-existent file.
- (let* ((name (make-temp-name tmpdir))
- (custom-theme-load-path (list name)))
- (should (not (file-exists-p name)))
- (should (null (custom-theme--load-path))))
-
- ;; Path comprises existing file.
- (let* ((file (make-temp-file "file"))
- (custom-theme-load-path (list file)))
- (should (file-exists-p file))
- (should (not (file-directory-p file)))
- (should (null (custom-theme--load-path))))
-
- ;; Path comprises existing directory.
- (let* ((dir (make-temp-file "dir" t))
- (custom-theme-load-path (list dir)))
- (should (file-directory-p dir))
- (should (equal (custom-theme--load-path) custom-theme-load-path)))
-
- ;; Expand `custom-theme-directory' path element.
- (let ((custom-theme-load-path '(custom-theme-directory)))
- (let ((custom-theme-directory (make-temp-name tmpdir)))
- (should (not (file-exists-p custom-theme-directory)))
- (should (null (custom-theme--load-path))))
- (let ((custom-theme-directory (make-temp-file "file")))
- (should (file-exists-p custom-theme-directory))
- (should (not (file-directory-p custom-theme-directory)))
- (should (null (custom-theme--load-path))))
- (let ((custom-theme-directory (make-temp-file "dir" t)))
- (should (file-directory-p custom-theme-directory))
- (should (equal (custom-theme--load-path)
- (list custom-theme-directory)))))
-
- ;; Expand t path element.
- (let ((custom-theme-load-path '(t)))
- (let ((data-directory (make-temp-name tmpdir)))
- (should (not (file-exists-p data-directory)))
- (should (null (custom-theme--load-path))))
- (let ((data-directory tmpdir)
- (themedir (expand-file-name "themes" tmpdir)))
- (should (not (file-exists-p themedir)))
- (should (null (custom-theme--load-path)))
- (with-temp-file themedir)
- (should (file-exists-p themedir))
- (should (not (file-directory-p themedir)))
- (should (null (custom-theme--load-path)))
- (delete-file themedir)
- (make-directory themedir)
- (should (file-directory-p themedir))
- (should (equal (custom-theme--load-path) (list themedir))))))
- (when (file-directory-p tmpdir)
- (delete-directory tmpdir t)))))
+ (custom-tests--with-temp-dir
+ ;; Path is empty.
+ (let ((custom-theme-load-path ()))
+ (should (null (custom-theme--load-path))))
+
+ ;; Path comprises non-existent file.
+ (let* ((name (make-temp-name temporary-file-directory))
+ (custom-theme-load-path (list name)))
+ (should (not (file-exists-p name)))
+ (should (null (custom-theme--load-path))))
+
+ ;; Path comprises existing file.
+ (let* ((file (make-temp-file "file"))
+ (custom-theme-load-path (list file)))
+ (should (file-exists-p file))
+ (should (not (file-directory-p file)))
+ (should (null (custom-theme--load-path))))
+
+ ;; Path comprises existing directory.
+ (let* ((dir (make-temp-file "dir" t))
+ (custom-theme-load-path (list dir)))
+ (should (file-directory-p dir))
+ (should (equal (custom-theme--load-path) custom-theme-load-path)))
+
+ ;; Expand `custom-theme-directory' path element.
+ (let ((custom-theme-load-path '(custom-theme-directory)))
+ (let ((custom-theme-directory (make-temp-name temporary-file-directory)))
+ (should (not (file-exists-p custom-theme-directory)))
+ (should (null (custom-theme--load-path))))
+ (let ((custom-theme-directory (make-temp-file "file")))
+ (should (file-exists-p custom-theme-directory))
+ (should (not (file-directory-p custom-theme-directory)))
+ (should (null (custom-theme--load-path))))
+ (let ((custom-theme-directory (make-temp-file "dir" t)))
+ (should (file-directory-p custom-theme-directory))
+ (should (equal (custom-theme--load-path)
+ (list custom-theme-directory)))))
+
+ ;; Expand t path element.
+ (let ((custom-theme-load-path '(t)))
+ (let ((data-directory (make-temp-name temporary-file-directory)))
+ (should (not (file-exists-p data-directory)))
+ (should (null (custom-theme--load-path))))
+ (let ((data-directory temporary-file-directory)
+ (themedir (expand-file-name "themes" temporary-file-directory)))
+ (should (not (file-exists-p themedir)))
+ (should (null (custom-theme--load-path)))
+ (with-temp-file themedir)
+ (should (file-exists-p themedir))
+ (should (not (file-directory-p themedir)))
+ (should (null (custom-theme--load-path)))
+ (delete-file themedir)
+ (make-directory themedir)
+ (should (file-directory-p themedir))
+ (should (equal (custom-theme--load-path) (list themedir)))))))
+
+(ert-deftest custom-tests-require-theme ()
+ "Test `require-theme'."
+ (custom-tests--with-temp-dir
+ (let* ((default-directory temporary-file-directory)
+ (custom-theme-load-path (list default-directory))
+ (load-path ()))
+ ;; Generate some `.el' and `.elc' files.
+ (with-temp-file "custom-tests--a.el"
+ (insert "(provide 'custom-tests--a)"))
+ (make-empty-file "custom-tests--b.el")
+ (with-temp-file "custom-tests--b.elc"
+ (byte-compile-insert-header nil (current-buffer))
+ (insert "(provide 'custom-tests--b)"))
+ (make-empty-file "custom-tests--c.el")
+ (with-temp-file "custom-tests--d.elc"
+ (byte-compile-insert-header nil (current-buffer)))
+ ;; Load them.
+ (dolist (feature '(a b c d e))
+ (should-not (featurep (intern (format "custom-tests--%s" feature)))))
+ (should (eq (require-theme 'custom-tests--a) 'custom-tests--a))
+ (delete-file "custom-tests--a.el")
+ (dolist (feature '(custom-tests--a custom-tests--b))
+ (should (eq (require-theme feature) feature))
+ (should (featurep feature)))
+ (dolist (feature '(custom-tests--c custom-tests--d))
+ (dolist (noerror '(nil t))
+ (let ((err (should-error (require-theme feature noerror))))
+ (should (string-search "failed to provide feature" (cadr err))))))
+ (should-error (require-theme 'custom-tests--e) :type 'file-missing)
+ (should-not (require-theme 'custom-tests--e t))
+ (dolist (feature '(custom-tests--c custom-tests--d custom-tests--e))
+ (should-not (featurep feature))))))
(defcustom custom--test-user-option 'foo
"User option for test."
@@ -145,17 +183,6 @@
(widget-apply field :value-to-internal origvalue)
"bar"))))))
-(defconst custom-test-admin-cus-test
- (expand-file-name "admin/cus-test.el" source-directory))
-
-(declare-function cus-test-opts custom-test-admin-cus-test)
-
-(ert-deftest check-for-wrong-custom-types ()
- :tags '(:expensive-test)
- (skip-unless (file-readable-p custom-test-admin-cus-test))
- (load custom-test-admin-cus-test)
- (should (null (cus-test-opts t))))
-
(ert-deftest custom-test-enable-theme-keeps-settings ()
"Test that enabling a theme doesn't change its settings."
(let* ((custom-theme-load-path `(,(ert-resource-directory)))
@@ -203,4 +230,108 @@
(should (eq (default-value 'custom--test-local-option) 'initial))
(should (eq (default-value 'custom--test-permanent-option) 'initial)))))
+;; The following three tests demonstrate Bug#21355.
+;; In this one, we set an user option for the current session and then
+;; we enable a theme that doesn't have a setting for it, ending up with
+;; a non-nil saved-value property. Since the `caar' of the theme-value
+;; property is user (i.e., the user theme setting is active), we might
+;; save the setting to the custom-file, even though it was meant for the
+;; current session only. So there should be a nil saved-value property
+;; for this test to pass.
+(ert-deftest custom-test-no-saved-value-after-enabling-theme ()
+ "Test that we don't record a saved-value property when we shouldn't."
+ (let ((custom-theme-load-path `(,(ert-resource-directory))))
+ (customize-option 'mark-ring-max)
+ (let* ((field (seq-find (lambda (widget)
+ (eq mark-ring-max (widget-value widget)))
+ widget-field-list))
+ (parent (widget-get field :parent)))
+ ;; Move to the editable widget, modify the value and save it.
+ (goto-char (widget-field-text-end field))
+ (insert "0")
+ (widget-apply parent :custom-set)
+ ;; Just setting for the current session should not store a saved-value
+ ;; property.
+ (should-not (get 'mark-ring-max 'saved-value))
+ ;; Now enable and disable the test theme.
+ (load-theme 'custom--test 'no-confirm)
+ (disable-theme 'custom--test)
+ ;; Since the user customized the option, this is OK.
+ (should (eq (caar (get 'mark-ring-max 'theme-value)) 'user))
+ ;; The saved-value property should still be nil.
+ (should-not (get 'mark-ring-max 'saved-value)))))
+
+;; In this second test, we load a theme that has a setting for the user option
+;; above. We must check that we don't end up with a non-nil saved-value
+;; property and a user setting active in the theme-value property, which
+;; means we might inadvertently save the session setting in the custom-file.
+(defcustom custom--test-bug-21355-before 'foo
+ "User option for `custom-test-no-saved-value-after-enabling-theme-2'."
+ :type 'symbol :group 'emacs)
+
+(ert-deftest custom-test-no-saved-value-after-enabling-theme-2 ()
+ "Test that we don't record a saved-value property when we shouldn't."
+ (let ((custom-theme-load-path `(,(ert-resource-directory))))
+ (customize-option 'custom--test-bug-21355-before)
+ (let* ((field (seq-find
+ (lambda (widget)
+ (eq custom--test-bug-21355-before (widget-value widget)))
+ widget-field-list))
+ (parent (widget-get field :parent)))
+ ;; Move to the editable widget, modify the value and save it.
+ (goto-char (widget-field-text-end field))
+ (insert "bar")
+ (widget-apply parent :custom-set)
+ ;; Just setting for the current session should not store a saved-value
+ ;; property.
+ (should-not (get 'custom--test-bug-21355-before 'saved-value))
+ ;; Now load our test theme, which has a setting for
+ ;; `custom--test-bug-21355-before'.
+ (load-theme 'custom--test 'no-confirm 'no-enable)
+ (enable-theme 'custom--test)
+ ;; Since the user customized the option, this is OK.
+ (should (eq (caar (get 'custom--test-bug-21355-before 'theme-value))
+ 'user))
+ ;; But the saved-value property has to be nil, since the user didn't mark
+ ;; this variable to save for future sessions.
+ (should-not (get 'custom--test-bug-21355-before 'saved-value)))))
+
+(defvar custom--test-bug-21355-after)
+
+;; In this test, we check that stashing a theme value for a not yet defined
+;; option works, but that later on if the user customizes the option for the
+;; current session, we might save the theme setting in the custom file.
+(ert-deftest custom-test-no-saved-value-after-customizing-option ()
+ "Test for a nil saved-value after setting an option for the current session."
+ (let ((custom-theme-load-path `(,(ert-resource-directory))))
+ ;; Check that we correctly stashed the value.
+ (load-theme 'custom--test 'no-confirm 'no-enable)
+ (enable-theme 'custom--test)
+ (should (and (not (boundp 'custom--test-bug-21355-after))
+ (eq (eval
+ (car (get 'custom--test-bug-21355-after 'saved-value)))
+ 'after)))
+ ;; Now Emacs finds the defcustom.
+ (defcustom custom--test-bug-21355-after 'initially "..."
+ :type 'symbol :group 'emacs)
+ ;; And we used the stashed value correctly.
+ (should (and (boundp 'custom--test-bug-21355-after)
+ (eq custom--test-bug-21355-after 'after)))
+ ;; Now customize it.
+ (customize-option 'custom--test-bug-21355-after)
+ (let* ((field (seq-find (lambda (widget)
+ (eq custom--test-bug-21355-after
+ (widget-value widget)))
+ widget-field-list))
+ (parent (widget-get field :parent)))
+ ;; Move to the editable widget, modify the value and save it.
+ (goto-char (widget-field-text-end field))
+ (insert "bar")
+ (widget-apply parent :custom-set)
+ ;; The user customized the variable, so this is OK.
+ (should (eq (caar (get 'custom--test-bug-21355-after 'theme-value))
+ 'user))
+ ;; But it was only for the current session, so this should not happen.
+ (should-not (get 'custom--test-bug-21355-after 'saved-value)))))
+
;;; custom-tests.el ends here
diff --git a/test/lisp/descr-text-tests.el b/test/lisp/descr-text-tests.el
index 6ba455b50d4..2052dc0e38c 100644
--- a/test/lisp/descr-text-tests.el
+++ b/test/lisp/descr-text-tests.el
@@ -1,4 +1,4 @@
-;;; descr-text-test.el --- ERT tests for descr-text.el -*- lexical-binding: t -*-
+;;; descr-text-tests.el --- ERT tests for descr-text.el -*- lexical-binding: t -*-
;; Copyright (C) 2014, 2016-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el
index 5b51c997e36..003923d60fa 100644
--- a/test/lisp/dired-x-tests.el
+++ b/test/lisp/dired-x-tests.el
@@ -49,5 +49,18 @@
(sort (dired-get-marked-files 'local) #'string<))))
(delete-directory dir 'recursive))))
+(ert-deftest dired-guess-default ()
+ (let ((dired-guess-shell-alist-user nil)
+ (dired-guess-shell-alist-default
+ '(("\\.png\\'" "display")
+ ("\\.gif\\'" "display" "xloadimage")
+ ("\\.gif\\'" "feh")
+ ("\\.jpe?g\\'" "xloadimage"))))
+ (should (equal (dired-guess-default '("/tmp/foo.png")) "display"))
+ (should (equal (dired-guess-default '("/tmp/foo.gif"))
+ '("display" "xloadimage" "feh")))
+ (should (equal (dired-guess-default '("/tmp/foo.png" "/tmp/foo.txt"))
+ nil))))
+
(provide 'dired-x-tests)
;; dired-x-tests.el ends here
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index dbe3a15dac1..b55982c1a15 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -5,6 +5,8 @@
;; Author: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords:
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
@@ -207,5 +209,13 @@ child results in an error."
(dom-pp node t)
(should (equal (buffer-string) "(\"foo\" nil)")))))
+(ert-deftest dom-test-search ()
+ (let ((dom '(a nil (b nil (c nil)))))
+ (should (equal (dom-search dom (lambda (d) (eq (dom-tag d) 'a)))
+ (list dom)))
+ (should (equal (dom-search dom (lambda (d) (memq (dom-tag d) '(b c))))
+ (list (car (dom-children dom))
+ (car (dom-children (car (dom-children dom)))))))))
+
(provide 'dom-tests)
;;; dom-tests.el ends here
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 62a42b7fe44..c5124aca5ee 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -47,10 +47,11 @@
(defmacro save-electric-modes (&rest body)
(declare (indent defun) (debug t))
- `(call-with-saved-electric-modes #'(lambda () ,@body)))
+ `(call-with-saved-electric-modes (lambda () ,@body)))
(defun electric-pair-test-for (fixture where char expected-string
- expected-point mode bindings fixture-fn)
+ expected-point mode bindings
+ fixture-fn &optional doc-string)
(with-temp-buffer
(funcall mode)
(insert fixture)
@@ -63,6 +64,14 @@
(mapcar #'car bindings)
(mapcar #'cdr bindings)
(call-interactively (key-binding `[,last-command-event])))))
+ (when
+ (and doc-string
+ (not
+ (and
+ (equal (buffer-substring-no-properties (point-min) (point-max))
+ expected-string)
+ (equal (point) expected-point))))
+ (message "\n%s\n" doc-string))
(should (equal (buffer-substring-no-properties (point-min) (point-max))
expected-string))
(should (equal (point)
@@ -109,14 +118,9 @@
(fixture (format "%s%s%s" prefix fixture suffix))
(expected-string (format "%s%s%s" prefix expected-string suffix))
(expected-point (+ (length prefix) expected-point))
- (pos (+ (length prefix) pos)))
- `(ert-deftest ,(intern (format "electric-pair-%s-at-point-%s-in-%s%s"
- name
- (1+ pos)
- mode
- extra-desc))
- ()
- ,(format "Electricity test in a `%s' buffer.\n
+ (pos (+ (length prefix) pos))
+ (doc-string
+ (format "Electricity test in a `%s' buffer.\n
Start with point at %d in a %d-char-long buffer
like this one:
@@ -142,8 +146,15 @@ The buffer's contents should %s:
"")
char
(if (string= fixture expected-string) "stay" "become")
- (replace-regexp-in-string "\n" "\\\\n" expected-string)
- expected-point)
+ (string-replace "\n" "\\n" expected-string)
+ expected-point)))
+ `(ert-deftest ,(intern (format "electric-pair-%s-at-point-%s-in-%s%s"
+ name
+ (1+ pos)
+ mode
+ extra-desc))
+ ()
+ ,doc-string
(electric-pair-test-for ,fixture
,(1+ pos)
,char
@@ -151,7 +162,8 @@ The buffer's contents should %s:
,expected-point
',mode
,bindings
- ,fixture-fn)))))
+ ,fixture-fn
+ ,doc-string)))))
(cl-defmacro define-electric-pair-test
(name fixture
@@ -347,7 +359,7 @@ baz\"\""
# \"
#
baz\"\""
- :fixture-fn #'(lambda () (goto-char (point-min)) (search-forward "bar")))
+ :fixture-fn (lambda () (goto-char (point-min)) (search-forward "bar")))
(define-electric-pair-test inhibit-in-mismatched-string-inside-c-comments
"foo\"\"/*
@@ -366,7 +378,7 @@ baz\"\""
\" \"
\"
*/baz\"\""
- :fixture-fn #'(lambda () (goto-char (point-min)) (search-forward "bar")))
+ :fixture-fn (lambda () (goto-char (point-min)) (search-forward "bar")))
;;; More quotes, but now don't bind `electric-pair-text-syntax-table'
@@ -508,8 +520,8 @@ baz\"\""
(define-electric-pair-test js-mode-braces
"" "{" :expected-string "{}" :expected-point 2
:modes '(js-mode)
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)))
(define-electric-pair-test js-mode-braces-with-layout
@@ -517,29 +529,29 @@ baz\"\""
:modes '(js-mode)
:test-in-comments nil
:test-in-strings nil
- :fixture-fn #'(lambda ()
- (electric-layout-mode 1)
- (electric-pair-mode 1)))
+ :fixture-fn (lambda ()
+ (electric-layout-mode 1)
+ (electric-pair-mode 1)))
(define-electric-pair-test js-mode-braces-with-layout-and-indent
"" "{" :expected-string "{\n \n}" :expected-point 7
:modes '(js-mode)
:test-in-comments nil
:test-in-strings nil
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (electric-indent-mode 1)
- (electric-layout-mode 1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (electric-indent-mode 1)
+ (electric-layout-mode 1)))
(define-electric-pair-test js-mode-braces-with-layout-and-indent
"" "{" :expected-string "{\n \n}" :expected-point 7
:modes '(js-mode)
:test-in-comments nil
:test-in-strings nil
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (electric-indent-mode 1)
- (electric-layout-mode 1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (electric-indent-mode 1)
+ (electric-layout-mode 1)))
;;; Backspacing
@@ -575,6 +587,7 @@ baz\"\""
;;; Electric newlines between pairs
;;; TODO: better tests
(ert-deftest electric-pair-open-extra-newline ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(save-electric-modes
(with-temp-buffer
(c-mode)
@@ -594,55 +607,55 @@ baz\"\""
;;;
(define-electric-pair-test autowrapping-1
"foo" "(" :expected-string "(foo)" :expected-point 2
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (mark-sexp 1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (mark-sexp 1)))
(define-electric-pair-test autowrapping-2
"foo" ")" :expected-string "(foo)" :expected-point 6
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (mark-sexp 1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (mark-sexp 1)))
(define-electric-pair-test autowrapping-3
"foo" ")" :expected-string "(foo)" :expected-point 6
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (goto-char (point-max))
- (skip-chars-backward "\"")
- (mark-sexp -1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (goto-char (point-max))
+ (skip-chars-backward "\"")
+ (mark-sexp -1)))
(define-electric-pair-test autowrapping-4
"foo" "(" :expected-string "(foo)" :expected-point 2
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (goto-char (point-max))
- (skip-chars-backward "\"")
- (mark-sexp -1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (goto-char (point-max))
+ (skip-chars-backward "\"")
+ (mark-sexp -1)))
(define-electric-pair-test autowrapping-5
"foo" "\"" :expected-string "\"foo\"" :expected-point 2
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (mark-sexp 1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (mark-sexp 1)))
(define-electric-pair-test autowrapping-6
"foo" "\"" :expected-string "\"foo\"" :expected-point 6
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (goto-char (point-max))
- (skip-chars-backward "\"")
- (mark-sexp -1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (goto-char (point-max))
+ (skip-chars-backward "\"")
+ (mark-sexp -1)))
(define-electric-pair-test autowrapping-7
"foo" "\"" :expected-string "``foo''" :expected-point 8
:modes '(tex-mode)
:test-in-comments nil
- :fixture-fn #'(lambda ()
- (electric-pair-mode 1)
- (goto-char (point-max))
- (skip-chars-backward "\"")
- (mark-sexp -1)))
+ :fixture-fn (lambda ()
+ (electric-pair-mode 1)
+ (goto-char (point-max))
+ (skip-chars-backward "\"")
+ (mark-sexp -1)))
;;; Electric quotes
@@ -859,12 +872,14 @@ baz\"\""
(defun electric-layout-for-c-style-du-jour (inserted)
"A function to use in `electric-layout-rules'"
- (when (memq inserted '(?{ ?}))
+ (when (memq inserted '(?\{ ?\}))
(save-excursion
(backward-char 2) (c-point-syntax) (forward-char) ; silly, but needed
(c-brace-newlines (c-point-syntax)))))
(ert-deftest electric-layout-plainer-c-mode-use-c-style ()
+ ;; FIXME hangs since c4d34d2
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
@@ -878,6 +893,7 @@ baz\"\""
(should (equal (buffer-string) "int main ()\n{\n \n}\n"))))
(ert-deftest electric-layout-int-main-kernel-style ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
@@ -894,6 +910,7 @@ baz\"\""
(ert-deftest electric-layout-control-reindentation ()
"Same as `emacs-lisp-int-main-kernel-style', but checking
Bug#35254."
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
@@ -912,6 +929,7 @@ Bug#35254."
(should (equal (buffer-string) "int main () {\n\n \n}"))))
(ert-deftest electric-modes-int-main-allman-style ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
@@ -926,6 +944,7 @@ Bug#35254."
(should (equal (buffer-string) "int main ()\n{\n \n}"))))
(ert-deftest electric-pair-mode-newline-between-parens ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode -1) ;; ensure e-l-m mode is off
@@ -937,6 +956,7 @@ Bug#35254."
(should (equal (buffer-string) "int main () {\n \n}"))))
(ert-deftest electric-layout-mode-newline-between-parens-without-e-p-m ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
@@ -958,6 +978,7 @@ Bug#35254."
(should (equal (buffer-string) "int main () {\n \n}"))))
(ert-deftest electric-layout-mode-newline-between-parens-without-e-p-m-2 ()
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(ert-with-test-buffer ()
(plainer-c-mode)
(electric-layout-local-mode 1)
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index a9a881987c0..911a5f0c7b1 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -1,4 +1,4 @@
-;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*-
+;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t -*-
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
@@ -23,44 +23,50 @@
(require 'bindat)
(require 'cl-lib)
-(defvar header-bindat-spec
- '((dest-ip ip)
+(bindat-defmacro ip () "An IPv4 address" '(vec 4 byte))
+
+(defconst header-bindat-spec
+ (bindat-type
+ (dest-ip ip)
(src-ip ip)
- (dest-port u16)
- (src-port u16)))
+ (dest-port uint 16)
+ (src-port uint 16)))
-(defvar data-bindat-spec
- '((type u8)
+(defconst data-bindat-spec
+ (bindat-type
+ (type u8)
(opcode u8)
- (length u16r) ;; little endian order
+ (length uintr 16) ;; little endian order
(id strz 8)
- (data vec (length))
- (align 4)))
+ (data vec length)
+ (_ align 4)))
+
-(defvar packet-bindat-spec
- '((header struct header-bindat-spec)
+(defconst packet-bindat-spec
+ (bindat-type
+ (header type header-bindat-spec)
(items u8)
- (fill 3)
- (item repeat (items)
- (struct data-bindat-spec))))
+ (_ fill 3)
+ (item repeat items
+ (_ type data-bindat-spec))))
-(defvar struct-bindat
+(defconst struct-bindat
'((header
(dest-ip . [192 168 1 100])
(src-ip . [192 168 1 101])
(dest-port . 284)
(src-port . 5408))
(items . 2)
- (item ((data . [1 2 3 4 5])
- (id . "ABCDEF")
- (length . 5)
+ (item ((type . 2)
(opcode . 3)
- (type . 2))
- ((data . [6 7 8 9 10 11 12])
- (id . "BCDEFG")
- (length . 7)
+ (length . 5)
+ (id . "ABCDEF")
+ (data . [1 2 3 4 5]))
+ ((type . 1)
(opcode . 4)
- (type . 1)))))
+ (length . 7)
+ (id . "BCDEFG")
+ (data . [6 7 8 9 10 11 12])))))
(ert-deftest bindat-test-pack ()
(should (equal
@@ -74,27 +80,7 @@
(should (equal
(bindat-unpack packet-bindat-spec
(bindat-pack packet-bindat-spec struct-bindat))
- '((item
- ((data .
- [1 2 3 4 5])
- (id . "ABCDEF")
- (length . 5)
- (opcode . 3)
- (type . 2))
- ((data .
- [6 7 8 9 10 11 12])
- (id . "BCDEFG")
- (length . 7)
- (opcode . 4)
- (type . 1)))
- (items . 2)
- (header
- (src-port . 5408)
- (dest-port . 284)
- (src-ip .
- [192 168 1 101])
- (dest-ip .
- [192 168 1 100]))))))
+ struct-bindat)))
(ert-deftest bindat-test-pack/multibyte-string-fails ()
(should-error (bindat-pack nil nil "ö")))
@@ -118,4 +104,62 @@
(should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1"))
(should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1")))
+(defconst bindat-test--int-websocket-type
+ (bindat-type
+ :pack-var value
+ (n1 u8
+ :pack-val (if (< value 126) value (if (< value 65536) 126 127)))
+ (n2 uint (pcase n1 (127 64) (126 16) (_ 0))
+ :pack-val value)
+ :unpack-val (if (< n1 126) n1 n2)))
+
+(ert-deftest bindat-test--pack-val ()
+ ;; This is intended to test the :(un)pack-val feature that offers
+ ;; control over the unpacked representation of the data.
+ (dolist (n '(0 42 125 126 127 128 150 255 5000 65535 65536 8769786876))
+ (should
+ (equal (bindat-unpack bindat-test--int-websocket-type
+ (bindat-pack bindat-test--int-websocket-type n))
+ n))))
+
+(ert-deftest bindat-test--sint ()
+ (dotimes (kind 32)
+ (let ((bitlen (* 8 (/ kind 2)))
+ (r (zerop (% kind 2))))
+ (dotimes (_ 100)
+ (let* ((n (random (ash 1 bitlen)))
+ (i (- n (ash 1 (1- bitlen)))))
+ (should (equal (bindat-unpack
+ (bindat-type sint bitlen r)
+ (bindat-pack (bindat-type sint bitlen r) i))
+ i))
+ (when (>= i 0)
+ (should (equal (bindat-pack
+ (bindat-type if r (uintr bitlen) (uint bitlen)) i)
+ (bindat-pack (bindat-type sint bitlen r) i)))
+ (should (equal (bindat-unpack
+ (bindat-type if r (uintr bitlen) (uint bitlen))
+ (bindat-pack (bindat-type sint bitlen r) i))
+ i))))))))
+
+(defconst bindat-test--LEB128
+ (bindat-type
+ letrec ((loop
+ (struct :pack-var n
+ (head u8
+ :pack-val (+ (logand n 127) (if (> n 127) 128 0)))
+ (tail if (< head 128) (unit 0) loop
+ :pack-val (ash n -7))
+ :unpack-val (+ (logand head 127) (ash tail 7)))))
+ loop))
+
+(ert-deftest bindat-test--recursive ()
+ (dotimes (n 10)
+ (let ((max (ash 1 (* n 10))))
+ (dotimes (_ 10)
+ (let ((n (random max)))
+ (should (equal (bindat-unpack bindat-test--LEB128
+ (bindat-pack bindat-test--LEB128 n))
+ n)))))))
+
;;; bindat-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/bc-test-alpha.el b/test/lisp/emacs-lisp/bytecomp-resources/bc-test-alpha.el
new file mode 100644
index 00000000000..6997d91b26a
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/bc-test-alpha.el
@@ -0,0 +1,9 @@
+;;; -*- lexical-binding: t -*-
+
+(require 'bc-test-beta)
+
+(defun bc-test-alpha-f (x)
+ (let ((y nil))
+ (list y (bc-test-beta-f x))))
+
+(provide 'bc-test-alpha)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/bc-test-beta.el b/test/lisp/emacs-lisp/bytecomp-resources/bc-test-beta.el
new file mode 100644
index 00000000000..9205a13d7d5
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/bc-test-beta.el
@@ -0,0 +1,6 @@
+;;; -*- lexical-binding: t -*-
+
+(defsubst bc-test-beta-f (y)
+ y)
+
+(provide 'bc-test-beta)
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
new file mode 100644
index 00000000000..3a29128cf3a
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
@@ -0,0 +1,5 @@
+;;; -*- lexical-binding: t -*-
+(defsubst warn-callargs-defsubst-f1 (_x)
+ nil)
+(defun warn-callargs-defsubst-f2 ()
+ (warn-callargs-defsubst-f1 1 2))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index bc623d3efca..80003c264a2 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -41,7 +41,7 @@
"Identity, but hidden from some optimisations."
x)
-(defconst byte-opt-testsuite-arith-data
+(defconst bytecomp-tests--test-cases
'(
;; some functional tests
(let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c))
@@ -364,17 +364,17 @@
'((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c)
(t c) (x "a") (x "c") (x c) (x d) (x e)))
- (mapcar (lambda (x) (cond ((member '(a . b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1)
+ ((equal x '(c)) 2))))
'(((a . b)) a b (c) (d)))
- (mapcar (lambda (x) (cond ((memq '(a . b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1)
+ ((equal x '(c)) 2))))
'(((a . b)) a b (c) (d)))
- (mapcar (lambda (x) (cond ((member '(a b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1)
+ ((equal x '(c)) 2))))
'(((a b)) a b (c) (d)))
- (mapcar (lambda (x) (cond ((memq '(a b) x) 1)
- ((equal x '(c)) 2)))
+ (mapcar (lambda (x) (ignore-errors (cond ((memq '(a b) x) 1)
+ ((equal x '(c)) 2))))
'(((a b)) a b (c) (d)))
(assoc 'b '((a 1) (b 2) (c 3)))
@@ -396,7 +396,7 @@
x)
(let ((x 1) (bytecomp-test-var 2) (y 3))
- (list x bytecomp-test-var (bytecomp-get-test-var) y))
+ (list x bytecomp-test-var (bytecomp-test-get-var) y))
(progn
(defvar d)
@@ -430,71 +430,162 @@
(list s x i))
(let ((x 2))
- (list (or (bytecomp-identity 'a) (setq x 3)) x)))
- "List of expression for test.
-Each element will be executed by interpreter and with
-bytecompiled code, and their results compared.")
+ (list (or (bytecomp-test-identity 'a) (setq x 3)) x))
+
+ (mapcar (lambda (b)
+ (let ((a nil))
+ (+ 0
+ (progn
+ (setq a b)
+ (setq b 1)
+ a))))
+ '(10))
+
+ (let* ((x 1)
+ (y (condition-case x
+ (/ 1 0)
+ (arith-error x))))
+ (list x y))
-(defun bytecomp-check-1 (pat)
- "Return non-nil if PAT is the same whether directly evalled or compiled."
- (let ((warning-minimum-log-level :emergency)
- (byte-compile-warnings nil)
- (v0 (condition-case err
- (eval pat)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (byte-compile (list 'lambda nil pat)))
- (error (list 'bytecomp-check-error (car err))))))
- (equal v0 v1)))
-
-(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1)
-
-(defun bytecomp-explain-1 (pat)
- (let ((v0 (condition-case err
- (eval pat)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (byte-compile (list 'lambda nil pat)))
- (error (list 'bytecomp-check-error (car err))))))
- (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
- pat v0 v1)))
-
-(ert-deftest bytecomp-tests ()
- "Test the Emacs byte compiler."
- (dolist (pat byte-opt-testsuite-arith-data)
- (should (bytecomp-check-1 pat))))
-
-(defun test-byte-opt-arithmetic (&optional arg)
- "Unit test for byte-opt arithmetic operations.
-Subtests signal errors if something goes wrong."
- (interactive "P")
- (switch-to-buffer (generate-new-buffer "*Font Pase Test*"))
+ (funcall
+ (condition-case x
+ (/ 1 0)
+ (arith-error (prog1 (lambda (y) (+ y x))
+ (setq x 10))))
+ 4)
+
+ ;; No error, no success handler.
+ (condition-case x
+ (list 42)
+ (error (cons 'bad x)))
+ ;; Error, no success handler.
+ (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x)))
+ ;; No error, success handler.
+ (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ ;; Error, success handler.
+ (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ ;; Verify that the success code is not subject to the error handlers.
+ (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (/ (car x) 0)))
+ ;; Check variable scoping on success.
+ (let ((x 2))
+ (condition-case x
+ (list x)
+ (error (list 'bad x))
+ (:success (list 'good x))))
+ ;; Check variable scoping on failure.
+ (let ((x 2))
+ (condition-case x
+ (/ 1 0)
+ (error (list 'bad x))
+ (:success (list 'good x))))
+ ;; Check capture of mutated result variable.
+ (funcall
+ (condition-case x
+ 3
+ (:success (prog1 (lambda (y) (+ y x))
+ (setq x 10))))
+ 4)
+ ;; Check for-effect context, on error.
+ (let ((f (lambda (x)
+ (condition-case nil
+ (/ 1 0)
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ ;; Check for-effect context, on success.
+ (let ((f (lambda (x)
+ (condition-case nil
+ nil
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+
+ ;; Check `not' in cond switch (bug#49746).
+ (mapcar (lambda (x) (cond ((equal x "a") 1)
+ ((member x '("b" "c")) 2)
+ ((not x) 3)))
+ '("a" "b" "c" "d" nil))
+
+ ;; `let' and `let*' optimisations with body being constant or variable
+ (let* (a
+ (b (progn (setq a (cons 1 a)) 2))
+ (c (1+ b))
+ (d (list a c)))
+ d)
+ (let ((a nil))
+ (let ((b (progn (setq a (cons 1 a)) 2))
+ (c (progn (setq a (cons 3 a))))
+ (d (list a)))
+ d))
+ (let* ((_a 1)
+ (_b 2))
+ 'z)
+ (let ((_a 1)
+ (_b 2))
+ 'z)
+ )
+ "List of expressions for cross-testing interpreted and compiled code.")
+
+(defconst bytecomp-tests--test-cases-lexbind-only
+ `(
+ ;; This would infloop (and exhaust stack) with dynamic binding.
+ (let ((f #'car))
+ (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
+ (funcall f '(1 . 2))))
+ )
+ "List of expressions for cross-testing interpreted and compiled code.
+These are only tested with lexical binding.")
+
+(defun bytecomp-tests--eval-interpreted (form)
+ "Evaluate FORM using the Lisp interpreter, returning errors as a
+special value."
+ (condition-case err
+ (eval form lexical-binding)
+ (error (list 'bytecomp-check-error (car err)))))
+
+(defun bytecomp-tests--eval-compiled (form)
+ "Evaluate FORM using the Lisp byte-code compiler, returning errors as a
+special value."
(let ((warning-minimum-log-level :emergency)
- (byte-compile-warnings nil)
- (pass-face '((t :foreground "green")))
- (fail-face '((t :foreground "red")))
- (print-escape-nonascii t)
- (print-escape-newlines t)
- (print-quoted t)
- v0 v1)
- (dolist (pat byte-opt-testsuite-arith-data)
- (condition-case err
- (setq v0 (eval pat))
- (error (setq v0 (list 'bytecomp-check-error (car err)))))
- (condition-case err
- (setq v1 (funcall (byte-compile (list 'lambda nil pat))))
- (error (setq v1 (list 'bytecomp-check-error (car err)))))
- (insert (format "%s" pat))
- (indent-to-column 65)
- (if (equal v0 v1)
- (insert (propertize "OK" 'face pass-face))
- (insert (propertize "FAIL\n" 'face fail-face))
- (indent-to-column 55)
- (insert (propertize (format "[%s] vs [%s]" v0 v1)
- 'face fail-face)))
- (insert "\n"))))
+ (byte-compile-warnings nil))
+ (condition-case err
+ (funcall (byte-compile (list 'lambda nil form)))
+ (error (list 'bytecomp-check-error (car err))))))
+
+(ert-deftest bytecomp-tests-lexbind ()
+ "Check that various expressions behave the same when interpreted and
+byte-compiled. Run with lexical binding."
+ (let ((lexical-binding t))
+ (dolist (form (append bytecomp-tests--test-cases-lexbind-only
+ bytecomp-tests--test-cases))
+ (ert-info ((prin1-to-string form) :prefix "form: ")
+ (should (equal (bytecomp-tests--eval-interpreted form)
+ (bytecomp-tests--eval-compiled form)))))))
+
+(ert-deftest bytecomp-tests-dynbind ()
+ "Check that various expressions behave the same when interpreted and
+byte-compiled. Run with dynamic binding."
+ (let ((lexical-binding nil))
+ (dolist (form bytecomp-tests--test-cases)
+ (ert-info ((prin1-to-string form) :prefix "form: ")
+ (should (equal (bytecomp-tests--eval-interpreted form)
+ (bytecomp-tests--eval-compiled form)))))))
(defun test-byte-comp-compile-and-load (compile &rest forms)
+ (declare (indent 1))
(let ((elfile nil)
(elcfile nil))
(unwind-protect
@@ -513,7 +604,6 @@ Subtests signal errors if something goes wrong."
(load elfile nil 'nomessage))
(when elfile (delete-file elfile))
(when elcfile (delete-file elcfile)))))
-(put 'test-byte-comp-compile-and-load 'lisp-indent-function 1)
(ert-deftest test-byte-comp-macro-expansion ()
(test-byte-comp-compile-and-load t
@@ -584,8 +674,8 @@ Subtests signal errors if something goes wrong."
`(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer))
(byte-compile ,@form)
- (ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward ,re-warning)))))
+ (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ")
+ (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning))))))
(ert-deftest bytecomp-warn-wrong-args ()
(bytecomp--with-warning-test "remq.*3.*2"
@@ -611,12 +701,13 @@ Subtests signal errors if something goes wrong."
(defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse)
`(ert-deftest ,(intern (format "bytecomp/%s" file)) ()
- :expected-result ,(if reverse :failed :passed)
(with-current-buffer (get-buffer-create "*Compile-Log*")
(let ((inhibit-read-only t)) (erase-buffer))
(byte-compile-file ,(ert-resource-file file))
(ert-info ((buffer-string) :prefix "buffer: ")
- (should (re-search-forward ,re-warning))))))
+ (,(if reverse 'should-not 'should)
+ (re-search-forward ,(string-replace " " "[ \n]+" re-warning)
+ nil t))))))
(bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el"
"add-hook.*lexical var")
@@ -642,6 +733,9 @@ Subtests signal errors if something goes wrong."
(bytecomp--define-warning-file-test "warn-callargs.el"
"with 2 arguments, but accepts only 1")
+(bytecomp--define-warning-file-test "warn-callargs-defsubst.el"
+ "with 2 arguments, but accepts only 1")
+
(bytecomp--define-warning-file-test "warn-defcustom-nogroup.el"
"fails to specify containing group")
@@ -658,10 +752,10 @@ Subtests signal errors if something goes wrong."
"free.*foo")
(bytecomp--define-warning-file-test "warn-free-variable-reference.el"
- "free.*bar")
+ "free variable .bar")
(bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el"
- "make-variable-buffer-local.*not called at toplevel")
+ "make-variable-buffer-local. not called at toplevel")
(bytecomp--define-warning-file-test "warn-interactive-only.el"
"next-line.*interactive use only.*forward-line")
@@ -670,19 +764,19 @@ Subtests signal errors if something goes wrong."
"malformed interactive spec")
(bytecomp--define-warning-file-test "warn-obsolete-defun.el"
- "foo-obsolete.*obsolete function.*99.99")
+ "foo-obsolete. is an obsolete function (as of 99.99)")
(defvar bytecomp--tests-obsolete-var nil)
(make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99")
(bytecomp--define-warning-file-test "warn-obsolete-hook.el"
- "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
+ "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
(bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el"
"foo-obs.*obsolete.*99.99" t)
(bytecomp--define-warning-file-test "warn-obsolete-variable.el"
- "bytecomp--tests-obs.*obsolete[^z-a]*99.99")
+ "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)")
(bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el"
"bytecomp--tests-obs.*obsolete.*99.99" t)
@@ -713,64 +807,64 @@ Subtests signal errors if something goes wrong."
(bytecomp--define-warning-file-test
"warn-wide-docstring-autoload.el"
- "autoload.*foox.*wider than.*characters")
+ "autoload .foox. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-custom-declare-variable.el"
- "custom-declare-variable.*foo.*wider than.*characters")
+ "custom-declare-variable .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-defalias.el"
- "defalias.*foo.*wider than.*characters")
+ "defalias .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-defconst.el"
- "defconst.*foo.*wider than.*characters")
+ "defconst .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-define-abbrev-table.el"
- "define-abbrev.*foo.*wider than.*characters")
+ "define-abbrev-table .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-define-obsolete-function-alias.el"
- "defalias.*foo.*wider than.*characters")
+ "defalias .foo. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-define-obsolete-variable-alias.el"
- "defvaralias.*foo.*wider than.*characters")
+ "defvaralias .foo. docstring wider than .* characters")
;; TODO: We don't yet issue warnings for defuns.
(bytecomp--define-warning-file-test
"warn-wide-docstring-defun.el"
- "wider than.*characters" 'reverse)
+ "wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-defvar.el"
- "defvar.*foo.*wider than.*characters")
+ "defvar .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-defvaralias.el"
- "defvaralias.*foo.*wider than.*characters")
+ "defvaralias .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore-fill-column.el"
- "defvar.*foo.*wider than.*characters" 'reverse)
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore-override.el"
- "defvar.*foo.*wider than.*characters" 'reverse)
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-ignore.el"
- "defvar.*foo.*wider than.*characters" 'reverse)
+ "defvar .foo-bar. docstring wider than .* characters" 'reverse)
(bytecomp--define-warning-file-test
"warn-wide-docstring-multiline-first.el"
- "defvar.*foo.*wider than.*characters")
+ "defvar .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"warn-wide-docstring-multiline.el"
- "defvar.*foo.*wider than.*characters")
+ "defvar .foo-bar. docstring wider than .* characters")
(bytecomp--define-warning-file-test
"nowarn-inline-after-defvar.el"
@@ -813,47 +907,6 @@ Subtests signal errors if something goes wrong."
(defun def () (m))))
(should (equal (funcall 'def) 4)))
-(defconst bytecomp-lexbind-tests
- `(
- (let ((f #'car))
- (let ((f (lambda (x) (cons (funcall f x) (cdr x)))))
- (funcall f '(1 . 2))))
- )
- "List of expression for test.
-Each element will be executed by interpreter and with
-bytecompiled code, and their results compared.")
-
-(defun bytecomp-lexbind-check-1 (pat)
- "Return non-nil if PAT is the same whether directly evalled or compiled."
- (let ((warning-minimum-log-level :emergency)
- (byte-compile-warnings nil)
- (v0 (condition-case err
- (eval pat t)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (let ((lexical-binding t))
- (byte-compile `(lambda nil ,pat))))
- (error (list 'bytecomp-check-error (car err))))))
- (equal v0 v1)))
-
-(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1)
-
-(defun bytecomp-lexbind-explain-1 (pat)
- (let ((v0 (condition-case err
- (eval pat t)
- (error (list 'bytecomp-check-error (car err)))))
- (v1 (condition-case err
- (funcall (let ((lexical-binding t))
- (byte-compile (list 'lambda nil pat))))
- (error (list 'bytecomp-check-error (car err))))))
- (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
- pat v0 v1)))
-
-(ert-deftest bytecomp-lexbind-tests ()
- "Test the Emacs byte compiler lexbind handling."
- (dolist (pat bytecomp-lexbind-tests)
- (should (bytecomp-lexbind-check-1 pat))))
-
(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body)
(declare (indent 1))
(cl-check-type file-name-var symbol)
@@ -1168,6 +1221,151 @@ mountpoint (Bug#44631)."
(with-demoted-errors "Error cleaning up directory: %s"
(delete-directory directory :recursive)))))
+(defun bytecomp-tests--get-vars ()
+ (list (ignore-errors (symbol-value 'bytecomp-tests--var1))
+ (ignore-errors (symbol-value 'bytecomp-tests--var2))))
+
+(ert-deftest bytecomp-local-defvar ()
+ "Check that local `defvar' declarations work correctly, both
+interpreted and compiled."
+ (let ((lexical-binding t))
+ (let ((fun '(lambda ()
+ (defvar bytecomp-tests--var1)
+ (let ((bytecomp-tests--var1 'a) ; dynamic
+ (bytecomp-tests--var2 'b)) ; still lexical
+ (ignore bytecomp-tests--var2) ; avoid warning
+ (bytecomp-tests--get-vars)))))
+ (should (listp fun)) ; Guard against overzealous refactoring!
+ (should (equal (funcall (eval fun t)) '(a nil)))
+ (should (equal (funcall (byte-compile fun)) '(a nil)))
+ )
+
+ ;; `progn' does not constitute a lexical scope for `defvar' (bug#46387).
+ (let ((fun '(lambda ()
+ (progn
+ (defvar bytecomp-tests--var1)
+ (defvar bytecomp-tests--var2))
+ (let ((bytecomp-tests--var1 'c)
+ (bytecomp-tests--var2 'd))
+ (bytecomp-tests--get-vars)))))
+ (should (listp fun))
+ (should (equal (funcall (eval fun t)) '(c d)))
+ (should (equal (funcall (byte-compile fun)) '(c d))))))
+
+(ert-deftest bytecomp-reify-function ()
+ "Check that closures that modify their bound variables are
+compiled correctly."
+ (cl-letf ((lexical-binding t)
+ ((symbol-function 'counter) nil))
+ (let ((x 0))
+ (defun counter () (cl-incf x))
+ (should (equal (counter) 1))
+ (should (equal (counter) 2))
+ ;; byte compiling should not cause counter to always return the
+ ;; same value (bug#46834)
+ (byte-compile 'counter)
+ (should (equal (counter) 3))
+ (should (equal (counter) 4)))
+ (let ((x 0))
+ (let ((x 1))
+ (defun counter () x)
+ (should (equal (counter) 1))
+ ;; byte compiling should not cause the outer binding to shadow
+ ;; the inner one (bug#46834)
+ (byte-compile 'counter)
+ (should (equal (counter) 1))))))
+
+(ert-deftest bytecomp-string-vs-docstring ()
+ ;; Don't confuse a string return value for a docstring.
+ (let ((lexical-binding t))
+ (should (equal (funcall (byte-compile '(lambda (x) "foo")) 'dummy) "foo"))))
+
+(ert-deftest bytecomp-condition-case-success ()
+ ;; No error, no success handler.
+ (should (equal (condition-case x
+ (list 42)
+ (error (cons 'bad x)))
+ '(42)))
+ ;; Error, no success handler.
+ (should (equal (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x)))
+ '(bad arith-error)))
+ ;; No error, success handler.
+ (should (equal (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ '(good 42)))
+ ;; Error, success handler.
+ (should (equal (condition-case x
+ (/ 1 0)
+ (error (cons 'bad x))
+ (:success (cons 'good x)))
+ '(bad arith-error)))
+ ;; Verify that the success code is not subject to the error handlers.
+ (should-error (condition-case x
+ (list 42)
+ (error (cons 'bad x))
+ (:success (/ (car x) 0)))
+ :type 'arith-error)
+ ;; Check variable scoping.
+ (let ((x 2))
+ (should (equal (condition-case x
+ (list x)
+ (error (list 'bad x))
+ (:success (list 'good x)))
+ '(good (2))))
+ (should (equal (condition-case x
+ (/ 1 0)
+ (error (list 'bad x))
+ (:success (list 'good x)))
+ '(bad (arith-error)))))
+ ;; Check capture of mutated result variable.
+ (should (equal (funcall
+ (condition-case x
+ 3
+ (:success (prog1 (lambda (y) (+ y x))
+ (setq x 10))))
+ 4)
+ 14))
+ ;; Check for-effect context, on error.
+ (should (equal (let ((f (lambda (x)
+ (condition-case nil
+ (/ 1 0)
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ 4))
+ ;; Check for-effect context, on success.
+ (should (equal (let ((f (lambda (x)
+ (condition-case nil
+ nil
+ (error 'bad)
+ (:success 'good))
+ (1+ x))))
+ (funcall f 3))
+ 4)))
+
+(declare-function bc-test-alpha-f (ert-resource-file "bc-test-alpha.el"))
+
+(ert-deftest bytecomp-defsubst ()
+ ;; Check that lexical variables don't leak into inlined code. See
+ ;; https://lists.gnu.org/archive/html/emacs-devel/2021-05/msg01227.html
+
+ ;; First, remove any trace of the functions and package defined:
+ (fmakunbound 'bc-test-alpha-f)
+ (fmakunbound 'bc-test-beta-f)
+ (setq features (delq 'bc-test-beta features))
+ ;; Byte-compile one file that uses a function from another file that isn't
+ ;; compiled.
+ (let ((file (ert-resource-file "bc-test-alpha.el"))
+ (load-path (cons (ert-resource-directory) load-path)))
+ (byte-compile-file file)
+ (load-file (concat file "c"))
+ (should (equal (bc-test-alpha-f 'a) '(nil a)))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 517373386e3..5aeed0cc155 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -182,7 +182,14 @@
(should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result)))
(ert-deftest cconv-convert-lambda-lifted ()
- "Bug#30872."
+ ;; Verify that lambda-lifting is actually performed at all.
+ (should (equal (cconv-closure-convert
+ '#'(lambda (x) (let ((f #'(lambda () (+ x 1))))
+ (funcall f))))
+ '#'(lambda (x) (let ((f #'(lambda (x) (+ x 1))))
+ (funcall f x)))))
+
+ ;; Bug#30872.
(should
(equal (funcall
(byte-compile
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el b/test/lisp/emacs-lisp/check-declare-tests.el
index 9552bf0e397..276530fb4d3 100644
--- a/test/lisp/emacs-lisp/check-declare-tests.el
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -106,11 +106,11 @@
(let ((res (buffer-string)))
;; Don't care too much about the format of the output, but
;; check that key information is present.
- (should (string-match-p "foo-file" res))
- (should (string-match-p "foo-fun" res))
- (should (string-match-p "bar-file" res))
- (should (string-match-p "it wasn't" res))
- (should (string-match-p "999" res))))))
+ (should (string-search "foo-file" res))
+ (should (string-search "foo-fun" res))
+ (should (string-search "bar-file" res))
+ (should (string-search "it wasn't" res))
+ (should (string-search "999" res))))))
(provide 'check-declare-tests)
;;; check-declare-tests.el ends here
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el
index cf7baf4ce44..2a1d8b27636 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -49,52 +49,34 @@
(with-temp-buffer
(emacs-lisp-mode)
;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo ((a (eql 'smthg)) (b list)) \"Return A+B.\")")
(checkdoc-defun)))
-(ert-deftest checkdoc-cl-defun-with-key-ok ()
- "Checkdoc should be happy with a cl-defun using &key."
+(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
+ "Checkdoc should be happy with a `cl-defmethod' using qualifiers."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defun foo (&key a (b 27)) \"Return :A+:B.\")")
+ (insert "(cl-defmethod test :around ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
-(ert-deftest checkdoc-cl-defun-with-allow-other-keys-ok ()
- "Checkdoc should be happy with a cl-defun using &allow-other-keys."
+(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
+ "Checkdoc should be happy with a :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defun foo (&key a &allow-other-keys) \"Return :A.\")")
- (checkdoc-defun)))
+ (insert "(cl-defmethod foo :extra \"foo\" ((a (eql 'smthg))) \"Return A.\")")
+ (checkdoc-defun))
-(ert-deftest checkdoc-cl-defun-with-default-optional-value-ok ()
- "Checkdoc should be happy with a cl-defun using default values for optional args."
(with-temp-buffer
(emacs-lisp-mode)
- ;; B is optional and equals 1+a if not provided. HAS-BS is non-nil
- ;; if B was provided in the call:
- (insert "(cl-defun foo (a &optional (b (1+ a) has-bs)) \"Return A + B.\")")
+ (insert
+ "(cl-defmethod foo :extra \"foo\" :after ((a (eql 'smthg))) \"Return A.\")")
(checkdoc-defun)))
-(ert-deftest checkdoc-cl-defun-with-destructuring-ok ()
- "Checkdoc should be happy with a cl-defun destructuring its arguments."
+(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
+ "Checkdoc should be happy with a 0-arity :extra qualified `cl-defmethod'."
(with-temp-buffer
(emacs-lisp-mode)
- (insert "(cl-defun foo ((a b &optional c) d) \"Return A+B+C+D.\")")
- (checkdoc-defun)))
-
-(ert-deftest checkdoc-cl-defmethod-ok ()
- "Checkdoc should be happy with a simple correct cl-defmethod."
- (with-temp-buffer
- (emacs-lisp-mode)
- (insert "(cl-defmethod foo (a) \"Return A.\")")
- (checkdoc-defun)))
-
-(ert-deftest checkdoc-cl-defmethod-with-types-ok ()
- "Checkdoc should be happy with a cl-defmethod using types."
- (with-temp-buffer
- (emacs-lisp-mode)
- ;; this method matches if A is the symbol `smthg' and if b is a list:
- (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
+ (insert "(cl-defmethod foo :extra \"foo\" () \"Return A.\")")
(checkdoc-defun)))
(ert-deftest checkdoc-cl-defun-with-key-ok ()
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index f3c308725ac..91f0a1e2014 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 4a01623cb88..dd7511e9afe 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -56,7 +56,14 @@
(should (equal (cl--generic-1 'a nil) '(a)))
(should (equal (cl--generic-1 4 nil) '("quatre" 4)))
(should (equal (cl--generic-1 5 nil) '("cinq" 5)))
- (should (equal (cl--generic-1 6 nil) '("six" a))))
+ (should (equal (cl--generic-1 6 nil) '("six" a)))
+ (defvar cl--generic-fooval 41)
+ (cl-defmethod cl--generic-1 ((_x (eql (+ cl--generic-fooval 1))) _y)
+ "forty-two")
+ (cl-defmethod cl--generic-1 (_x (_y (eql 42)))
+ "FORTY-TWO")
+ (should (equal (cl--generic-1 42 nil) "forty-two"))
+ (should (equal (cl--generic-1 nil 42) "FORTY-TWO")))
(cl-defstruct cl-generic-struct-parent a b)
(cl-defstruct (cl-generic-struct-child1 (:include cl-generic-struct-parent)) c)
@@ -269,9 +276,7 @@ Edebug symbols (Bug#42672)."
(when (memq name instrumented-names)
(error "Duplicate definition of `%s'" name))
(push name instrumented-names)
- (edebug-new-definition name)))
- ;; Make generated symbols reproducible.
- (gensym-counter 10000))
+ (edebug-new-definition name))))
(eval-buffer)
(should (equal
(reverse instrumented-names)
@@ -280,11 +285,11 @@ Edebug symbols (Bug#42672)."
;; FIXME: We'd rather have names such as
;; `cl-defgeneric/edebug/method/1 ((_ number))', but
;; that requires further changes to Edebug.
- (list (intern "cl-generic-:method@10000 ((_ number))")
- (intern "cl-generic-:method@10001 ((_ string))")
- (intern "cl-generic-:method@10002 :around ((_ number))")
+ (list (intern "cl-defgeneric/edebug/method/1 (number)")
+ (intern "cl-defgeneric/edebug/method/1 (string)")
+ (intern "cl-defgeneric/edebug/method/1 :around (number)")
'cl-defgeneric/edebug/method/1
- (intern "cl-generic-:method@10003 ((_ number))")
+ (intern "cl-defgeneric/edebug/method/2 (number)")
'cl-defgeneric/edebug/method/2))))))
(provide 'cl-generic-tests)
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 065ca4fa651..a5ec62b9c42 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index bcd63f73a3c..f4e2e46a019 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -617,11 +617,37 @@ collection clause."
(cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
(should (equal (len (make-list 42 t)) 42)))
- ;; Simple tail-recursive function.
- (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)))
- (should (equal (len (make-list 42 t) 0) 42))
- ;; Should not bump into stack depth limits.
- (should (equal (len (make-list 42000 t) 0) 42000)))
+ (let ((list-42 (make-list 42 t))
+ (list-42k (make-list 42000 t)))
+
+ (cl-labels
+ ;; Simple tail-recursive function.
+ ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))
+ ;; Slightly obfuscated version to exercise tail calls from
+ ;; `let', `progn', `and' and `or'.
+ (len2 (xs n) (or (and (not xs) n)
+ (let (n1)
+ (and xs
+ (progn (setq n1 (1+ n))
+ (len2 (cdr xs) n1))))))
+ ;; Tail calls in error and success handlers.
+ (len3 (xs n)
+ (if xs
+ (condition-case k
+ (/ 1 (logand n 1))
+ (arith-error (len3 (cdr xs) (1+ n)))
+ (:success (len3 (cdr xs) (+ n k))))
+ n)))
+ (should (equal (len nil 0) 0))
+ (should (equal (len2 nil 0) 0))
+ (should (equal (len3 nil 0) 0))
+ (should (equal (len list-42 0) 42))
+ (should (equal (len2 list-42 0) 42))
+ (should (equal (len3 list-42 0) 42))
+ ;; Should not bump into stack depth limits.
+ (should (equal (len list-42k 0) 42000))
+ (should (equal (len2 list-42k 0) 42000))
+ (should (equal (len3 list-42k 0) 42000))))
;; Check that non-recursive functions are handled more efficiently.
(should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
@@ -633,4 +659,9 @@ collection clause."
#'len))
(`(function (lambda (,_ ,_) . ,_)) t))))
+(ert-deftest cl-macs--progv ()
+ (should (= (cl-progv '(test test) '(1 2) test) 2))
+ (should (equal (cl-progv '(test1 test2) '(1 2) (list test1 test2))
+ '(1 2))))
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el
new file mode 100644
index 00000000000..59e1b6982e1
--- /dev/null
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -0,0 +1,233 @@
+;;; comp-cstr-tests.el --- unit tests for src/comp.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for lisp/emacs-lisp/comp-cstr.el
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+(require 'comp-cstr)
+
+(cl-eval-when (compile eval load)
+
+ (defun comp-cstr-test-ts (type-spec)
+ "Create a constraint from TYPE-SPEC and convert it back to type specifier."
+ (let ((comp-ctxt (make-comp-cstr-ctxt)))
+ (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
+
+ (defun comp-cstr-typespec-test (number type-spec expected-type-spec)
+ `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) ()
+ (should (equal (comp-cstr-test-ts ',type-spec)
+ ',expected-type-spec))))
+
+ (defconst comp-cstr-typespec-tests-alist
+ `(;; 1
+ (symbol . symbol)
+ ;; 2
+ ((or string array) . array)
+ ;; 3
+ ((or symbol number) . (or number symbol))
+ ;; 4
+ ((or cons atom) . (or atom cons)) ;; SBCL return T
+ ;; 5
+ ((or integer number) . number)
+ ;; 6
+ ((or (or integer symbol) number) . (or number symbol))
+ ;; 7
+ ((or (or integer symbol) (or number list)) . (or list number symbol))
+ ;; 8
+ ((or (or integer number) nil) . number)
+ ;; 9
+ ((member foo) . (member foo))
+ ;; 10
+ ((member foo bar) . (member bar foo))
+ ;; 11
+ ((or (member foo) (member bar)) . (member bar foo))
+ ;; 12
+ ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
+ ;; 13
+ ((or (member foo) number) . (or (member foo) number))
+ ;; 14
+ ((or (integer 1 3) number) . number)
+ ;; 15
+ (integer . integer)
+ ;; 16
+ ((integer 1 2) . (integer 1 2))
+ ;; 17
+ ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
+ ;; 18
+ ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
+ ;; 19
+ ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
+ ;; 20
+ ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
+ ;; 21
+ ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
+ ;; 22
+ ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
+ ;; 23
+ ((or (integer -1 2) (integer * 4)) . (integer * 4))
+ ;; 24
+ ((and string array) . string)
+ ;; 25
+ ((and cons atom) . nil)
+ ;; 26
+ ((and (member foo) (member foo bar baz)) . (member foo))
+ ;; 27
+ ((and (member foo) (member bar)) . nil)
+ ;; 28
+ ((and (member foo) symbol) . (member foo))
+ ;; 29
+ ((and (member foo) string) . nil)
+ ;; 30
+ ((and (member foo) (integer 1 2)) . nil)
+ ;; 31
+ ((and (member 1 2) (member 3 2)) . (integer 2 2))
+ ;; 32
+ ((and number (integer 1 2)) . (integer 1 2))
+ ;; 33
+ ((and integer (integer 1 2)) . (integer 1 2))
+ ;; 34
+ ((and (integer -1 0) (integer 3 5)) . nil)
+ ;; 35
+ ((and (integer -1 2) (integer 3 5)) . nil)
+ ;; 36
+ ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
+ ;; 37
+ ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
+ ;; 38
+ ((and (integer -1 5) nil) . nil)
+ ;; 39
+ ((not symbol) . (not symbol))
+ ;; 40
+ ((or (member foo) (not (member foo bar))) . (not (member bar)))
+ ;; 41
+ ((or (member foo bar) (not (member foo))) . t)
+ ;; 42
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 43
+ ((or symbol (not symbol)) . t)
+ ;; 44
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 45 Conservative.
+ ((or vector (not sequence)) . t)
+ ;; 46
+ ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 47
+ ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 48
+ ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
+ ;; 49
+ ((or symbol (not (member foo))) . (not (member foo)))
+ ;; 50
+ ((or (not symbol) (not (member foo))) . (not symbol))
+ ;; 51 Conservative.
+ ((or (not (member foo)) string) . (not (member foo)))
+ ;; 52 Conservative.
+ ((or (member foo) (not string)) . (not string))
+ ;; 53
+ ((or (not (integer 1 2)) integer) . t)
+ ;; 54
+ ((or (not (integer 1 2)) (not integer)) . (not integer))
+ ;; 55
+ ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
+ ;; 56
+ ((or number (not (integer 1 2))) . t)
+ ;; 57
+ ((or atom (not (integer 1 2))) . t)
+ ;; 58
+ ((or atom (not (member foo))) . t)
+ ;; 59
+ ((and symbol (not cons)) . symbol)
+ ;; 60
+ ((and symbol (not symbol)) . nil)
+ ;; 61
+ ((and atom (not symbol)) . atom)
+ ;; 62
+ ((and atom (not string)) . (or array sequence atom))
+ ;; 63 Conservative
+ ((and symbol (not (member foo))) . symbol)
+ ;; 64 Conservative
+ ((and symbol (not (member 3))) . symbol)
+ ;; 65
+ ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
+ ;; 66
+ ((and (member foo) (not (integer 1 10))) . (member foo))
+ ;; 67
+ ((and t (not (member foo))) . (not (member foo)))
+ ;; 68
+ ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
+ ;; 69
+ ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
+ ;; 70
+ ((and (not (member a)) (not (member b))) . (not (member a b)))
+ ;; 71
+ ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
+ ;; 72
+ ((and t (integer 1 1)) . (integer 1 1))
+ ;; 73
+ ((not (integer -1 5)) . (not (integer -1 5)))
+ ;; 74
+ ((and boolean (or number marker)) . nil)
+ ;; 75
+ ((and atom (or number marker)) . (or marker number))
+ ;; 76
+ ((and symbol (or number marker)) . nil)
+ ;; 77
+ ((and (or symbol string) (or number marker)) . nil)
+ ;; 78
+ ((and t t) . t)
+ ;; 79
+ ((and (or marker number) (integer 0 0)) . (integer 0 0))
+ ;; 80
+ ((and t (not t)) . nil)
+ ;; 81
+ ((or (integer 1 1) (not (integer 1 1))) . t)
+ ;; 82
+ ((not t) . nil)
+ ;; 83
+ ((not nil) . t)
+ ;; 84
+ ((or (not string) t) . t)
+ ;; 85
+ ((or (not vector) sequence) . sequence)
+ ;; 86
+ ((or (not symbol) null) . t)
+ ;; 87
+ ((and (or null integer) (not (or null integer))) . nil)
+ ;; 88
+ ((and (or (member a b c)) (not (or (member a b)))) . (member c)))
+ "Alist type specifier -> expected type specifier."))
+
+(defmacro comp-cstr-synthesize-tests ()
+ "Generate all tests from `comp-cstr-typespec-tests-alist'."
+ `(progn
+ ,@(cl-loop
+ for i from 1
+ for (ts . exp-ts) in comp-cstr-typespec-tests-alist
+ append (list (comp-cstr-typespec-test i ts exp-ts)))))
+
+(comp-cstr-synthesize-tests)
+
+;;; comp-cstr-tests.el ends here
diff --git a/test/lisp/emacs-lisp/copyright-tests.el b/test/lisp/emacs-lisp/copyright-tests.el
index 7deb8b53a2e..6bb6e350d17 100644
--- a/test/lisp/emacs-lisp/copyright-tests.el
+++ b/test/lisp/emacs-lisp/copyright-tests.el
@@ -37,8 +37,12 @@
. ";; Copyright (C) 2017, 2019 Free Software Foundation, Inc.")
(";; Copyright (C) 2017-2018 Free Software Foundation, Inc."
. ";; Copyright (C) 2017-2019 Free Software Foundation, Inc.")
+ (";; Copyright (C) 2017–2018 Free Software Foundation, Inc."
+ . ";; Copyright (C) 2017–2019 Free Software Foundation, Inc.")
(";; Copyright (C) 2005-2006, 2015, 2017-2018 Free Software Foundation, Inc."
. ";; Copyright (C) 2005-2006, 2015, 2017-2019 Free Software Foundation, Inc.")
+ (";; Copyright (C) 2005–2006, 2015, 2017–2018 Free Software Foundation, Inc."
+ . ";; Copyright (C) 2005–2006, 2015, 2017–2019 Free Software Foundation, Inc.")
(";; copyright '18 FSF"
. ";; copyright '18, '19 FSF")))
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index a3010f9e354..9257f167d67 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -62,12 +62,12 @@
(defun edebug-test-code-format-vector-node (node)
!start!(concat "["
- (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
"]"))
(defun edebug-test-code-format-list-node (node)
!start!(concat "{"
- (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ (apply #'concat (mapcar #'edebug-test-code-format-node node))!apply!
"}"))
(defun edebug-test-code-format-node (node)
@@ -137,5 +137,21 @@
,(cons func args))))
(wrap + 1 x)))
+(defun edebug-test-code-cl-flet1 ()
+ (cl-flet
+ ;; This `&rest' sexp head should not collide with
+ ;; the Edebug spec elem of the same name.
+ ((f (&rest x) x)
+ (gate (x) (+ x 5)))
+ ;; This call to `gate' shouldn't collide with the Edebug spec elem
+ ;; of the same name.
+ (message "Hi %s" (gate 7))))
+
+(defun edebug-test-code-use-gv-expander (x)
+ (declare (gv-expander
+ (lambda (do)
+ (funcall do `(car ,x) (lambda (v) `(setcar ,x ,v))))))
+ (car x))
+
(provide 'edebug-test-code)
;;; edebug-test-code.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index d60a6cb3d50..2f45050e2eb 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -219,16 +219,16 @@ index."
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(setq saved-local-map overriding-local-map)
(setq overriding-local-map edebug-tests-keymap)
- (add-hook 'post-command-hook 'edebug-tests-post-command))
+ (add-hook 'post-command-hook #'edebug-tests-post-command))
(advice-add 'exit-recursive-edit
- :around 'edebug-tests-preserve-keyboard-macro-state)
+ :around #'edebug-tests-preserve-keyboard-macro-state)
(unwind-protect
(kmacro-call-macro nil nil nil kbdmac)
(advice-remove 'exit-recursive-edit
- 'edebug-tests-preserve-keyboard-macro-state)
+ #'edebug-tests-preserve-keyboard-macro-state)
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
(setq overriding-local-map saved-local-map)
- (remove-hook 'post-command-hook 'edebug-tests-post-command)))))
+ (remove-hook 'post-command-hook #'edebug-tests-post-command)))))
(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args)
"Call ORIG with ARGS preserving the value of `executing-kbd-macro'.
@@ -857,12 +857,14 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-trivial-backquote ()
"Edebug can instrument a trivial backquote expression (Bug#23651)."
(edebug-tests-with-normal-env
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert "`1")
- (read-only-mode)
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert "`1"))
(edebug-eval-defun nil)
- (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)")
+ ;; `eval-defun' outputs its message to the echo area in a rather
+ ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
+ ;; there in separate pieces (via `print' rather than via `message').
+ (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
edebug-tests-messages))
(setq edebug-tests-messages "")
@@ -912,13 +914,17 @@ test and possibly others should be updated."
(ert-deftest edebug-tests-cl-macrolet ()
"Edebug can instrument `cl-macrolet' expressions. (Bug#29919)"
(edebug-tests-with-normal-env
- (edebug-tests-setup-@ "use-cl-macrolet" '(10) t)
+ (edebug-tests-locate-def "use-cl-macrolet")
(edebug-tests-run-kbd-macro
- "@ SPC SPC"
+ "C-u C-M-x SPC"
(edebug-tests-should-be-at "use-cl-macrolet" "func")
- (edebug-tests-should-match-result-in-messages "+")
- "g"
- (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11")))))
+ (edebug-tests-should-match-result-in-messages "+"))
+ (let ((edebug-initial-mode 'Go-nonstop))
+ (edebug-tests-setup-@ "use-cl-macrolet" '(10) t))
+ (edebug-tests-run-kbd-macro
+ "@ SPC g"
+ (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11"))
+ )))
(ert-deftest edebug-tests-backtrace-goto-source ()
"Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer."
@@ -951,8 +957,41 @@ primary ones (Bug#42671)."
(should
(equal
defined-symbols
- (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))")
- (intern "edebug-cl-defmethod-qualifier ((_ number))")))))))
+ (list (intern "edebug-cl-defmethod-qualifier :around (number)")
+ (intern "edebug-cl-defmethod-qualifier (number)")))))))
+
+(ert-deftest edebug-tests--conflicting-internal-names ()
+ "Check conflicts between form's head symbols and Edebug spec elements."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "cl-flet1" '(10) t)))
+
+(ert-deftest edebug-tests-gv-expander ()
+ "Edebug can instrument `gv-expander' expressions."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "use-gv-expander" nil t)
+ (should (equal
+ (catch 'text
+ (run-at-time 0 nil
+ (lambda () (throw 'text (buffer-substring (point) (+ (point) 5)))))
+ (eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) t))
+ "(func"))))
+
+(defun edebug-tests--read (form spec)
+ (with-temp-buffer
+ (print form (current-buffer))
+ (goto-char (point-min))
+ (cl-letf ((edebug-all-forms t)
+ ((get (car form) 'edebug-form-spec) spec))
+ (edebug--read nil (current-buffer)))))
+
+(ert-deftest edebug-tests--&rest-behavior ()
+ ;; `&rest' is documented to allow the last "repetition" to be aborted early.
+ (should (edebug-tests--read '(dummy x 1 y 2 z)
+ '(&rest symbolp integerp)))
+ ;; `&rest' should notice here that the "symbolp integerp" sequence
+ ;; is not respected.
+ (should-error (edebug-tests--read '(dummy x 1 2 y)
+ '(&rest symbolp integerp))))
(ert-deftest edebug-tests-cl-flet ()
"Check that Edebug can instrument `cl-flet' forms without name
@@ -976,32 +1015,35 @@ clashes (Bug#41853)."
;; Make generated symbols reproducible.
(gensym-counter 10000))
(eval-buffer)
- (should (equal (reverse instrumented-names)
+ ;; Use `format' so as to throw away differences due to
+ ;; interned/uninterned symbols.
+ (should (equal (format "%s" (reverse instrumented-names))
;; The outer definitions come after the inner
;; ones because their body ends later.
- ;; FIXME: There are twice as many inner
- ;; definitions as expected due to Bug#41988.
- ;; Once that bug is fixed, remove the duplicates.
;; FIXME: We'd rather have names such as
;; `edebug-tests-cl-flet-1@inner@cl-flet@10000',
;; but that requires further changes to Edebug.
- '(inner@cl-flet@10000
- inner@cl-flet@10001
- inner@cl-flet@10002
- inner@cl-flet@10003
- edebug-tests-cl-flet-1
- inner@cl-flet@10004
- inner@cl-flet@10005
- edebug-tests-cl-flet-2))))))
+ (format "%s" '(inner@cl-flet@10000
+ inner@cl-flet@10001
+ edebug-tests-cl-flet-1
+ inner@cl-flet@10002
+ edebug-tests-cl-flet-2)))))))
+
+(defmacro edebug-tests--duplicate-symbol-backtrack (arg)
+ "Helper macro that exemplifies Bug#42701.
+ARG is either (FORM) or (FORM IGNORED)."
+ (declare (debug ([&or (form) (form sexp)])))
+ (car arg))
(ert-deftest edebug-tests-duplicate-symbol-backtrack ()
"Check that Edebug doesn't create duplicate symbols when
backtracking (Bug#42701)."
(with-temp-buffer
- (dolist (form '((require 'subr-x)
- (defun edebug-tests-duplicate-symbol-backtrack ()
- (if-let (x (funcall (lambda (y) 1) 2)) 3 4))))
- (print form (current-buffer)))
+ (print '(defun edebug-tests-duplicate-symbol-backtrack ()
+ (edebug-tests--duplicate-symbol-backtrack
+ ;; Passing (FORM IGNORED) forces backtracking.
+ ((lambda () 123) ignored)))
+ (current-buffer))
(let* ((edebug-all-defs t)
(edebug-initial-mode 'Go-nonstop)
(instrumented-names ())
@@ -1026,5 +1068,30 @@ backtracking (Bug#42701)."
"edebug-anon10001"
"edebug-tests-duplicate-symbol-backtrack"))))))
+(defmacro edebug-tests--duplicate-&define (_arg)
+ "Helper macro for the ERT test `edebug-tests-duplicate-&define'.
+The Edebug specification is similar to the one used by `cl-flet'
+previously; see Bug#41988."
+ (declare (debug (&or (&define name function-form) (defun)))))
+
+(ert-deftest edebug-tests-duplicate-&define ()
+ "Check that Edebug doesn't backtrack out of `&define' forms.
+This avoids potential duplicate definitions (Bug#41988)."
+ (with-temp-buffer
+ (print '(defun edebug-tests-duplicate-&define ()
+ (edebug-tests--duplicate-&define
+ (edebug-tests-duplicate-&define-inner () nil)))
+ (current-buffer))
+ (let* ((edebug-all-defs t)
+ (edebug-initial-mode 'Go-nonstop)
+ (instrumented-names ())
+ (edebug-new-definition-function
+ (lambda (name)
+ (when (memq name instrumented-names)
+ (error "Duplicate definition of `%s'" name))
+ (push name instrumented-names)
+ (edebug-new-definition name))))
+ (should-error (eval-buffer) :type 'invalid-read-syntax))))
+
(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 285616a7806..9f9bb73133c 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -1,4 +1,4 @@
-;;; eieio-testsinvoke.el -- eieio tests for method invocation -*- lexical-binding:t -*-
+;;; eieio-test-methodinvoke.el --- eieio tests for method invocation -*- lexical-binding:t -*-
;; Copyright (C) 2005, 2008, 2010, 2013-2021 Free Software Foundation,
;; Inc.
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index a47fb8053b9..3ec42343443 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -1,4 +1,4 @@
-;;; eieio-tests.el -- eieio test routines -*- lexical-binding: t -*-
+;;; eieio-tests.el --- eieio test routines -*- lexical-binding: t -*-
;; Copyright (C) 1999-2003, 2005-2010, 2012-2021 Free Software
;; Foundation, Inc.
@@ -574,7 +574,21 @@ METHOD is the method that was attempting to be called."
(setf (get-slot-3 eitest-t1) 'setf-emu)
(should (eq (get-slot-3 eitest-t1) 'setf-emu))
;; Roll back
- (setf (get-slot-3 eitest-t1) 'emu))
+ (setf (get-slot-3 eitest-t1) 'emu)
+ (defvar eieio-tests-initform-was-evaluated)
+ (defclass eieio-tests-initform-not-evaluated-when-initarg-is-present ()
+ ((slot-with-initarg-and-initform
+ :initarg :slot-with-initarg-and-initform
+ :initform (setf eieio-tests-initform-was-evaluated t))))
+ (setq eieio-tests-initform-was-evaluated nil)
+ (make-instance
+ 'eieio-tests-initform-not-evaluated-when-initarg-is-present)
+ (should eieio-tests-initform-was-evaluated)
+ (setq eieio-tests-initform-was-evaluated nil)
+ (make-instance
+ 'eieio-tests-initform-not-evaluated-when-initarg-is-present
+ :slot-with-initarg-and-initform t)
+ (should-not eieio-tests-initform-was-evaluated))
(defvar eitest-t2 nil)
(ert-deftest eieio-test-26-default-inheritance ()
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 40cb432708e..5c9696105e9 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -814,7 +814,7 @@ This macro is used to test if macroexpansion in `should' works."
:body (lambda () (should (integerp (ert-fail "Boo"))))))))
(should (ert-test-failed-p result))
(should (equal (ert-test-failed-condition result)
- '(ert-test-failed ("Boo"))))))
+ '(ert-test-failed "Boo")))))
(provide 'ert-tests)
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index f46fa63e4ce..9f40a18d343 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -7,18 +7,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index ffcd16ad094..a1b9f64fdb1 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -45,6 +45,7 @@
BODY twice: once using ordinary `eval' and once using
lambda-generators. The test ensures that the two forms produce
identical output."
+ (declare (indent 1))
`(progn
(ert-deftest ,name ()
(should
@@ -62,8 +63,6 @@ identical output."
(let ((cps-inhibit-atomic-optimization t))
(iter-lambda () (iter-yield (progn ,@body)))))))))))
-(put 'cps-testcase 'lisp-indent-function 1)
-
(defvar *cps-test-i* nil)
(defun cps-get-test-i ()
*cps-test-i*)
diff --git a/test/lisp/emacs-lisp/lisp-mnt-tests.el b/test/lisp/emacs-lisp/lisp-mnt-tests.el
new file mode 100644
index 00000000000..84cdc7205f2
--- /dev/null
+++ b/test/lisp/emacs-lisp/lisp-mnt-tests.el
@@ -0,0 +1,36 @@
+;;; lisp-mnt-tests.el --- Tests for lisp-mnt -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; 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 'lisp-mnt)
+
+(ert-deftest lm--tests-crack-address ()
+ (should (equal (lm-crack-address
+ "Bob Weiner <rsw@gnu.org>, Mats Lidell <matsl@gnu.org>")
+ '(("Bob Weiner" . "rsw@gnu.org")
+ ("Mats Lidell" . "matsl@gnu.org")))))
+
+(provide 'lisp-mnt-tests)
+;;; lisp-mnt-tests.el ends here
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el
index 85db3a00c8e..e2cecdf6b01 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el
index fd07011137a..78ecf3ff03d 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -8,6 +8,8 @@
;; Author: Marcin Borkowski <mbork@mbork.pl>
;; Keywords: internal
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/emacs-lisp/macroexp-resources/m1.el b/test/lisp/emacs-lisp/macroexp-resources/m1.el
new file mode 100644
index 00000000000..96b5f7091af
--- /dev/null
+++ b/test/lisp/emacs-lisp/macroexp-resources/m1.el
@@ -0,0 +1,36 @@
+;;; m1.el --- Some sample code for macroexp-tests -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defconst macroexp--m1-tests-filename (macroexp-file-name))
+
+(eval-when-compile
+ (defconst macroexp--m1-tests-comp-filename (macroexp-file-name)))
+
+(defun macroexp--m1-tests-file-name ()
+ (macroexp--test-get-file-name))
+
+(provide 'm1)
+;;; m1.el ends here
diff --git a/test/lisp/emacs-lisp/macroexp-resources/m2.el b/test/lisp/emacs-lisp/macroexp-resources/m2.el
new file mode 100644
index 00000000000..4f2b96d8ca0
--- /dev/null
+++ b/test/lisp/emacs-lisp/macroexp-resources/m2.el
@@ -0,0 +1,33 @@
+;;; m2.el --- More sample code for macroexp-tests -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defconst macroexp--m2-tests-filename (macroexp-file-name))
+
+(byte-compile-file (expand-file-name
+ "m1.el" (file-name-directory macroexp--m2-tests-filename)))
+
+(provide 'm2)
+;;; m2.el ends here
diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el
new file mode 100644
index 00000000000..89d3882d1da
--- /dev/null
+++ b/test/lisp/emacs-lisp/macroexp-tests.el
@@ -0,0 +1,72 @@
+;;; macroexp-tests.el --- Tests for macroexp.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(ert-deftest macroexp--tests-fgrep ()
+ (should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u))))
+ '((x))))
+ (should (equal (macroexp--fgrep '((x) (y)) '#2=([y] ((y #2#))))
+ '((y))))
+ (should (equal (macroexp--fgrep '((x) (y)) '#2=([r] ((a x)) a b c d . #2#))
+ '((x)))))
+
+(defconst macroexp--tests-filename (macroexp-file-name))
+
+(defmacro macroexp--test-get-file-name () (macroexp-file-name))
+
+(ert-deftest macroexp--tests-file-name ()
+ (should (string-match
+ "\\`macroexp-tests.elc?\\'"
+ (file-name-nondirectory macroexp--tests-filename)))
+ (let ((rsrc-dir (expand-file-name
+ "macroexp-resources"
+ (file-name-directory macroexp--tests-filename))))
+ (with-current-buffer
+ (find-file-noselect (expand-file-name "m1.el" rsrc-dir))
+ (defvar macroexp--m1-tests-filename)
+ (declare-function macroexp--m1-tests-file-name "m1" ())
+ ;; `macroexp-file-name' should work with `eval-buffer'.
+ (eval-buffer)
+ (should (equal "m1.el"
+ (file-name-nondirectory macroexp--m1-tests-filename)))
+ (should (equal "m1.el"
+ (file-name-nondirectory (macroexp--m1-tests-file-name))))
+ (search-forward "macroexp--m1-tests-filename")
+ (makunbound 'macroexp--m1-tests-filename)
+ ;; `macroexp-file-name' should also work with `eval-defun'.
+ (eval-defun nil)
+ (should (equal "m1.el"
+ (file-name-nondirectory macroexp--m1-tests-filename))))
+
+ ;; Test the case where we load a file which byte-compiles another.
+ (defvar macroexp--m1-tests-comp-filename)
+ (makunbound 'macroexp--m1-tests-comp-filename)
+ (load (expand-file-name "m2.el" rsrc-dir))
+ (should (equal "m1.el"
+ (file-name-nondirectory macroexp--m1-tests-comp-filename)))))
+
+
+(provide 'macroexp-tests)
+;;; macroexp-tests.el ends here
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 9a2cd42a211..658ed2e7119 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -22,7 +22,7 @@
;;; Commentary:
-;; Tests for map.el
+;; Tests for map.el.
;;; Code:
@@ -30,12 +30,10 @@
(require 'map)
(defmacro with-maps-do (var &rest body)
- "Successively bind VAR to an alist, vector and hash-table.
+ "Successively bind VAR to an alist, plist, vector, and hash-table.
Each map is built from the following alist data:
-'((0 . 3) (1 . 4) (2 . 5)).
-Evaluate BODY for each created map.
-
-\(fn (var map) body)"
+ \\='((0 . 3) (1 . 4) (2 . 5)).
+Evaluate BODY for each created map."
(declare (indent 1) (debug (symbolp body)))
(let ((alist (make-symbol "alist"))
(plist (make-symbol "plist"))
@@ -53,43 +51,62 @@ Evaluate BODY for each created map.
(dolist (,var (list ,alist ,plist ,vec ,ht))
,@body))))
+(defmacro with-empty-maps-do (var &rest body)
+ "Like `with-maps-do', but with empty maps."
+ (declare (indent 1) (debug (symbolp body)))
+ `(dolist (,var (list (list) (vector) (make-hash-table)))
+ ,@body))
+
+(ert-deftest test-map-plist-p ()
+ "Test `map--plist-p'."
+ (with-empty-maps-do map
+ (should-not (map--plist-p map)))
+ (should-not (map--plist-p ""))
+ (should-not (map--plist-p '((()))))
+ (should (map--plist-p '(:a)))
+ (should (map--plist-p '(a)))
+ (should (map--plist-p '(nil)))
+ (should (map--plist-p '(""))))
+
(ert-deftest test-map-elt ()
(with-maps-do map
(should (= 3 (map-elt map 0)))
(should (= 4 (map-elt map 1)))
(should (= 5 (map-elt map 2)))
- (should (null (map-elt map -1)))
- (should (null (map-elt map 4)))))
+ (should-not (map-elt map -1))
+ (should-not (map-elt map 4))
+ (should-not (map-elt map 0.1))))
(ert-deftest test-map-elt-default ()
(with-maps-do map
- (should (= 5 (map-elt map 7 5)))))
+ (should (= 5 (map-elt map 7 5)))
+ (should (= 5 (map-elt map 0.1 5))))
+ (with-empty-maps-do map
+ (should (= 5 (map-elt map 0 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))))
+ (should (map-elt map noneq-key nil #'equal))))
(ert-deftest test-map-elt-with-nil-value ()
- (should (null (map-elt '((a . 1)
- (b))
- 'b
- '2))))
+ (should-not (map-elt '((a . 1) (b)) 'b 2)))
(ert-deftest test-map-put! ()
(with-maps-do map
(setf (map-elt map 2) 'hello)
(should (eq (map-elt map 2) 'hello)))
(with-maps-do map
- (map-put map 2 'hello)
+ (with-suppressed-warnings ((obsolete map-put))
+ (map-put map 2 'hello))
(should (eq (map-elt map 2) 'hello)))
(with-maps-do map
(map-put! map 2 'hello)
(should (eq (map-elt map 2) 'hello))
(if (not (or (hash-table-p map)
- (and (listp map) (not (listp (car map)))))) ;plist!
+ (map--plist-p map)))
(should-error (map-put! map 5 'value)
;; For vectors, it could arguably signal
;; map-not-inplace as well, but it currently doesn't.
@@ -97,49 +114,88 @@ Evaluate BODY for each created map.
'map-not-inplace
'error))
(map-put! map 5 'value)
- (should (eq (map-elt map 5) 'value))))
- (let ((ht (make-hash-table)))
- (setf (map-elt ht 2) 'a)
- (should (eq (map-elt ht 2)
- 'a)))
- (let ((alist '((0 . a) (1 . b) (2 . c))))
- (setf (map-elt alist 2) 'a)
- (should (eq (map-elt alist 2)
- 'a)))
- (let ((vec [3 4 5]))
- (should-error (setf (map-elt vec 3) 6))))
+ (should (eq (map-elt map 5) 'value)))))
+
+(ert-deftest test-map-put!-new-keys ()
+ "Test `map-put!' with new keys."
+ (with-maps-do map
+ (let ((size (map-length map)))
+ (if (arrayp map)
+ (progn
+ (should-error (setf (map-elt map 'k) 'v))
+ (should-error (setf (map-elt map size) 'v)))
+ (setf (map-elt map 'k) 'v)
+ (should (eq (map-elt map 'k) 'v))
+ (setf (map-elt map size) 'v)
+ (should (eq (map-elt map size) 'v))))))
(ert-deftest test-map-put-alist-new-key ()
"Regression test for Bug#23105."
- (let ((alist '((0 . a))))
- (map-put alist 2 'b)
- (should (eq (map-elt alist 2)
- 'b))))
+ (let ((alist (list (cons 0 'a))))
+ (with-suppressed-warnings ((obsolete map-put))
+ (map-put alist 2 'b))
+ (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 #'eql)
- (should (cddr alist))))
+ (with-suppressed-warnings ((obsolete map-put))
+ (map-put alist noneq-key 3 #'equal)
+ (should-not (cddr alist))
+ (map-put alist noneq-key 9 #'eql)
+ (should (cddr alist)))))
(ert-deftest test-map-put-return-value ()
(let ((ht (make-hash-table)))
- (should (eq (map-put ht 'a 'hello) 'hello))))
+ (with-suppressed-warnings ((obsolete map-put))
+ (should (eq (map-put ht 'a 'hello) 'hello)))))
+
+(ert-deftest test-map-insert-empty ()
+ "Test `map-insert' on empty maps."
+ (with-empty-maps-do map
+ (if (arrayp map)
+ (should-error (map-insert map 0 6))
+ (let ((new (map-insert map 0 6)))
+ (should-not (eq map new))
+ (should-not (map-pairs map))
+ (should (= (map-elt new 0) 6))))))
+
+(ert-deftest test-map-insert ()
+ "Test `map-insert'."
+ (with-maps-do map
+ (let ((pairs (map-pairs map))
+ (size (map-length map))
+ (new (map-insert map 0 6)))
+ (should-not (eq map new))
+ (should (equal (map-pairs map) pairs))
+ (should (= (map-elt new 0) 6))
+ (if (arrayp map)
+ (should-error (map-insert map size 7))
+ (setq new (map-insert map size 7))
+ (should-not (eq map new))
+ (should (equal (map-pairs map) pairs))
+ (should (= (map-elt new size) 7))))))
(ert-deftest test-map-delete ()
(with-maps-do map
- (map-delete map 1)
- (should (null (map-elt map 1))))
+ (should (map-elt map 1))
+ (should (eq map (map-delete map 1)))
+ (should-not (map-elt map 1)))
+ (with-maps-do map
+ (should-not (map-elt map -2))
+ (should (eq map (map-delete map -2)))
+ (should-not (map-elt map -2)))
(with-maps-do map
- (map-delete map -2)
- (should (null (map-elt map -2)))))
+ ;; Check for OBOE.
+ (let ((key (map-length map)))
+ (should-not (map-elt map key))
+ (should (eq map (map-delete map key)))
+ (should-not (map-elt map key)))))
-(ert-deftest test-map-delete-return-value ()
- (let ((ht (make-hash-table)))
- (should (eq (map-delete ht 'a) ht))))
+(ert-deftest test-map-delete-empty ()
+ (with-empty-maps-do map
+ (should (eq map (map-delete map t)))))
(ert-deftest test-map-nested-elt ()
(let ((vec [a b [c d [e f]]]))
@@ -149,8 +205,9 @@ Evaluate BODY for each created map.
(d . 3)
(e . ((f . 4)
(g . 5))))))))
- (should (eq (map-nested-elt alist '(b e f))
- 4)))
+ (should (eq (map-nested-elt alist '(b e f)) 4)))
+ (let ((plist '(a 1 b (c 2 d 3 e (f 4 g 5)))))
+ (should (eq (map-nested-elt plist '(b e f)) 4)))
(let ((ht (make-hash-table)))
(setf (map-elt ht 'a) 1)
(setf (map-elt ht 'b) (make-hash-table))
@@ -160,221 +217,266 @@ Evaluate BODY for each created map.
(ert-deftest test-map-nested-elt-default ()
(let ((vec [a b [c d]]))
- (should (null (map-nested-elt vec '(2 3))))
- (should (null (map-nested-elt vec '(2 1 1))))
+ (should-not (map-nested-elt vec '(2 3)))
+ (should-not (map-nested-elt vec '(2 1 1)))
(should (= 4 (map-nested-elt vec '(2 1 1) 4)))))
(ert-deftest test-mapp ()
- (should (mapp nil))
- (should (mapp '((a . b) (c . d))))
- (should (mapp '(a b c d)))
- (should (mapp []))
- (should (mapp [1 2 3]))
- (should (mapp (make-hash-table)))
+ (with-empty-maps-do map
+ (should (mapp map)))
+ (with-maps-do map
+ (should (mapp map)))
+ (should (mapp ""))
(should (mapp "hello"))
- (should (not (mapp 1)))
- (should (not (mapp 'hello))))
+ (should-not (mapp 1))
+ (should-not (mapp 'hello)))
(ert-deftest test-map-keys ()
(with-maps-do map
(should (equal (map-keys map) '(0 1 2))))
- (should (null (map-keys nil)))
- (should (null (map-keys []))))
+ (with-empty-maps-do map
+ (should-not (map-keys map))))
(ert-deftest test-map-values ()
(with-maps-do map
- (should (equal (map-values map) '(3 4 5)))))
+ (should (equal (map-values map) '(3 4 5))))
+ (with-empty-maps-do map
+ (should-not (map-values map))))
(ert-deftest test-map-pairs ()
(with-maps-do map
- (should (equal (map-pairs map) '((0 . 3)
- (1 . 4)
- (2 . 5))))))
+ (should (equal (map-pairs map)
+ '((0 . 3)
+ (1 . 4)
+ (2 . 5)))))
+ (with-empty-maps-do map
+ (should-not (map-pairs map))))
(ert-deftest test-map-length ()
- (let ((ht (make-hash-table)))
- (puthash 'a 1 ht)
- (puthash 'b 2 ht)
- (puthash 'c 3 ht)
- (puthash 'd 4 ht)
- (should (= 0 (map-length nil)))
- (should (= 0 (map-length [])))
- (should (= 0 (map-length (make-hash-table))))
- (should (= 5 (map-length [0 1 2 3 4])))
- (should (= 2 (map-length '((a . 1) (b . 2)))))
- (should (= 4 (map-length ht)))))
+ (with-empty-maps-do map
+ (should (zerop (map-length map))))
+ (with-maps-do map
+ (should (= 3 (map-length map))))
+ (should (= 1 (map-length '(nil 1))))
+ (should (= 2 (map-length '(nil 1 t 2))))
+ (should (= 2 (map-length '((a . 1) (b . 2)))))
+ (should (= 5 (map-length [0 1 2 3 4])))
+ (should (= 4 (map-length #s(hash-table data (a 1 b 2 c 3 d 4))))))
(ert-deftest test-map-copy ()
(with-maps-do map
(let ((copy (map-copy map)))
- (should (equal (map-keys map) (map-keys copy)))
- (should (equal (map-values map) (map-values copy)))
- (should (not (eq map copy))))))
+ (should (equal (map-pairs map) (map-pairs copy)))
+ (should-not (eq map copy))
+ (map-put! map 0 0)
+ (should-not (equal (map-pairs map) (map-pairs copy)))))
+ (with-empty-maps-do map
+ (should-not (map-pairs (map-copy map)))))
+
+(ert-deftest test-map-copy-alist ()
+ "Test use of `copy-alist' for alists."
+ (let* ((cons (list 'a 1 2))
+ (alist (list cons))
+ (copy (map-copy alist)))
+ (setcar cons 'b)
+ (should (equal alist '((b 1 2))))
+ (should (equal copy '((a 1 2))))
+ (setcar (cdr cons) 0)
+ (should (equal alist '((b 0 2))))
+ (should (equal copy '((a 0 2))))
+ (setcdr cons 3)
+ (should (equal alist '((b . 3))))
+ (should (equal copy '((a 0 2))))))
(ert-deftest test-map-apply ()
- (with-maps-do map
- (should (equal (map-apply (lambda (k v) (cons (int-to-string k) v))
- map)
- '(("0" . 3) ("1" . 4) ("2" . 5)))))
- (let ((vec [a b c]))
- (should (equal (map-apply (lambda (k v) (cons (1+ k) v))
- vec)
- '((1 . a)
- (2 . b)
- (3 . c))))))
+ (let ((fn (lambda (k v) (cons (number-to-string k) v))))
+ (with-maps-do map
+ (should (equal (map-apply fn map)
+ '(("0" . 3) ("1" . 4) ("2" . 5)))))
+ (with-empty-maps-do map
+ (should-not (map-apply fn map)))))
(ert-deftest test-map-do ()
- (with-maps-do map
- (let ((result nil))
- (map-do (lambda (k v)
- (push (list (int-to-string k) v) result))
- map)
- (should (equal result '(("2" 5) ("1" 4) ("0" 3)))))))
+ (let* (res
+ (fn (lambda (k v)
+ (push (list (number-to-string k) v) res))))
+ (with-empty-maps-do map
+ (should-not (map-do fn map))
+ (should-not res))
+ (with-maps-do map
+ (setq res nil)
+ (should-not (map-do fn map))
+ (should (equal res '(("2" 5) ("1" 4) ("0" 3)))))))
(ert-deftest test-map-keys-apply ()
(with-maps-do map
- (should (equal (map-keys-apply (lambda (k) (int-to-string k))
- map)
- '("0" "1" "2"))))
- (let ((vec [a b c]))
- (should (equal (map-keys-apply (lambda (k) (1+ k))
- vec)
- '(1 2 3)))))
+ (should (equal (map-keys-apply #'1+ map) '(1 2 3))))
+ (with-empty-maps-do map
+ (let (ks)
+ (should-not (map-keys-apply (lambda (k) (push k ks)) map))
+ (should-not ks))))
(ert-deftest test-map-values-apply ()
(with-maps-do map
- (should (equal (map-values-apply (lambda (v) (1+ v))
- map)
- '(4 5 6))))
- (let ((vec [a b c]))
- (should (equal (map-values-apply (lambda (v) (symbol-name v))
- vec)
- '("a" "b" "c")))))
+ (should (equal (map-values-apply #'1+ map) '(4 5 6))))
+ (with-empty-maps-do map
+ (let (vs)
+ (should-not (map-values-apply (lambda (v) (push v vs)) map))
+ (should-not vs))))
(ert-deftest test-map-filter ()
(with-maps-do map
- (should (equal (map-keys (map-filter (lambda (_k v)
- (<= 4 v))
- map))
- '(1 2)))
- (should (null (map-filter (lambda (k _v)
- (eq 'd k))
- map))))
- (should (null (map-filter (lambda (_k v)
- (eq 3 v))
- [1 2 4 5])))
- (should (equal (map-filter (lambda (k _v)
- (eq 3 k))
- [1 2 4 5])
- '((3 . 5)))))
+ (should (equal (map-filter (lambda (_k v) (> v 3)) map)
+ '((1 . 4) (2 . 5))))
+ (should (equal (map-filter #'always map) (map-pairs map)))
+ (should-not (map-filter #'ignore map)))
+ (with-empty-maps-do map
+ (should-not (map-filter #'always map))
+ (should-not (map-filter #'ignore map))))
(ert-deftest test-map-remove ()
(with-maps-do map
- (should (equal (map-keys (map-remove (lambda (_k v)
- (>= v 4))
- map))
- '(0)))
- (should (equal (map-keys (map-remove (lambda (k _v)
- (eq 'd k))
- map))
- (map-keys map))))
- (should (equal (map-remove (lambda (_k v)
- (eq 3 v))
- [1 2 4 5])
- '((0 . 1)
- (1 . 2)
- (2 . 4)
- (3 . 5))))
- (should (null (map-remove (lambda (k _v)
- (>= k 0))
- [1 2 4 5]))))
+ (should (equal (map-remove (lambda (_k v) (> v 3)) map)
+ '((0 . 3))))
+ (should (equal (map-remove #'ignore map) (map-pairs map)))
+ (should-not (map-remove #'always map)))
+ (with-empty-maps-do map
+ (should-not (map-remove #'always map))
+ (should-not (map-remove #'ignore map))))
(ert-deftest test-map-empty-p ()
- (should (map-empty-p nil))
- (should (not (map-empty-p '((a . b) (c . d)))))
- (should (map-empty-p []))
- (should (not (map-empty-p [1 2 3])))
- (should (map-empty-p (make-hash-table)))
- (should (not (map-empty-p "hello")))
- (should (map-empty-p "")))
+ (with-empty-maps-do map
+ (should (map-empty-p map)))
+ (should (map-empty-p ""))
+ (should-not (map-empty-p '((a . b) (c . d))))
+ (should-not (map-empty-p [1 2 3]))
+ (should-not (map-empty-p "hello")))
(ert-deftest test-map-contains-key ()
- (should (map-contains-key '((a . 1) (b . 2)) 'a))
- (should (not (map-contains-key '((a . 1) (b . 2)) 'c)))
- (should (map-contains-key '(("a" . 1)) "a"))
- (should (not (map-contains-key '(("a" . 1)) "a" #'eq)))
- (should (map-contains-key [a b c] 2))
- (should (not (map-contains-key [a b c] 3))))
+ (with-empty-maps-do map
+ (should-not (map-contains-key map -1))
+ (should-not (map-contains-key map 0))
+ (should-not (map-contains-key map 1))
+ (should-not (map-contains-key map (map-length map))))
+ (with-maps-do map
+ (should-not (map-contains-key map -1))
+ (should (map-contains-key map 0))
+ (should (map-contains-key map 1))
+ (should-not (map-contains-key map (map-length map)))))
+
+(ert-deftest test-map-contains-key-testfn ()
+ "Test `map-contains-key' under different equalities."
+ (let ((key (string ?a))
+ (plist '("a" 1 a 2))
+ (alist '(("a" . 1) (a . 2))))
+ (should (map-contains-key alist 'a))
+ (should (map-contains-key plist 'a))
+ (should (map-contains-key alist 'a #'eq))
+ (should (map-contains-key plist 'a #'eq))
+ (should (map-contains-key alist key))
+ (should-not (map-contains-key plist key))
+ (should-not (map-contains-key alist key #'eq))
+ (should-not (map-contains-key plist key #'eq))))
(ert-deftest test-map-some ()
(with-maps-do map
- (should (map-some (lambda (k _v)
- (eq 1 k))
- map))
- (should-not (map-some (lambda (k _v)
- (eq 'd k))
- map)))
- (let ((vec [a b c]))
- (should (map-some (lambda (k _v)
- (> k 1))
- vec))
- (should-not (map-some (lambda (k _v)
- (> k 3))
- vec))))
+ (should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map)
+ 'found))
+ (should-not (map-some #'ignore map)))
+ (with-empty-maps-do map
+ (should-not (map-some #'always map))
+ (should-not (map-some #'ignore map))))
(ert-deftest test-map-every-p ()
(with-maps-do map
- (should (map-every-p (lambda (k _v)
- k)
- map))
- (should (not (map-every-p (lambda (_k _v)
- nil)
- map))))
- (let ((vec [a b c]))
- (should (map-every-p (lambda (k _v)
- (>= k 0))
- vec))
- (should (not (map-every-p (lambda (k _v)
- (> k 3))
- vec)))))
+ (should (map-every-p #'always map))
+ (should-not (map-every-p #'ignore map))
+ (should-not (map-every-p (lambda (k _v) (zerop k)) map)))
+ (with-empty-maps-do map
+ (should (map-every-p #'always map))
+ (should (map-every-p #'ignore map))
+ (should (map-every-p (lambda (k _v) (zerop k)) map))))
(ert-deftest test-map-into ()
- (let* ((alist '((a . 1) (b . 2)))
+ (let* ((plist '(a 1 b 2))
+ (alist '((a . 1) (b . 2)))
(ht (map-into alist 'hash-table))
(ht2 (map-into alist '(hash-table :test equal))))
(should (hash-table-p ht))
- (should (equal (map-into (map-into alist 'hash-table) 'list)
- alist))
- (should (listp (map-into ht 'list)))
- (should (equal (map-keys (map-into (map-into ht 'list) 'hash-table))
- (map-keys ht)))
- (should (equal (map-values (map-into (map-into ht 'list) 'hash-table))
- (map-values ht)))
+ (should (equal (map-into ht 'list) alist))
+ (should (equal (map-pairs (map-into (map-into ht 'list) 'hash-table))
+ (map-pairs ht)))
(should (equal (map-into ht 'alist) (map-into ht2 'alist)))
- (should (eq (hash-table-test ht2) 'equal))
- (should (null (map-into nil 'list)))
- (should (map-empty-p (map-into nil 'hash-table)))
- (should-error (map-into [1 2 3] 'string))))
+ (should (equal (map-into alist 'list) alist))
+ (should (equal (map-into alist 'alist) alist))
+ (should (equal (map-into alist 'plist) plist))
+ (should (equal (map-into plist 'alist) alist))
+ (should (equal (map-into plist 'plist) plist)))
+ (should-error (map-into [1 2 3] 'string) :type 'cl-no-applicable-method))
+
+(ert-deftest test-map-into-hash-test ()
+ "Test `map-into' with different hash-table test functions."
+ (should (eq (hash-table-test (map-into () 'hash-table)) #'equal))
+ (should (eq (hash-table-test (map-into () '(hash-table))) #'eql))
+ (should (eq (hash-table-test (map-into () '(hash-table :test eq))) #'eq))
+ (should (eq (hash-table-test (map-into () '(hash-table :test eql))) #'eql))
+ (should (eq (hash-table-test (map-into () '(hash-table :test equal)))
+ #'equal)))
+
+(ert-deftest test-map-into-empty ()
+ "Test `map-into' with empty maps."
+ (with-empty-maps-do map
+ (should-not (map-into map 'list))
+ (should-not (map-into map 'alist))
+ (should-not (map-into map 'plist))
+ (should (map-empty-p (map-into map 'hash-table)))))
(ert-deftest test-map-let ()
(map-let (foo bar baz) '((foo . 1) (bar . 2))
(should (= foo 1))
(should (= bar 2))
- (should (null baz)))
+ (should-not baz))
(map-let (('foo a)
('bar b)
('baz c))
'((foo . 1) (bar . 2))
(should (= a 1))
(should (= b 2))
- (should (null c))))
+ (should-not c)))
+
+(ert-deftest test-map-merge ()
+ "Test `map-merge'."
+ (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
+ #s(hash-table data (c 4)))
+ (lambda (x y) (string< (car x) (car y))))
+ '((a . 1) (b . 2) (c . 4))))
+ (should (equal (map-merge 'list () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge 'alist () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge 'plist () '(:a 1)) '(:a 1))))
(ert-deftest test-map-merge-with ()
- (should (equal (map-merge-with 'list #'+
- '((1 . 2))
- '((1 . 3) (2 . 4))
- '((1 . 1) (2 . 5) (3 . 0)))
- '((3 . 0) (2 . 9) (1 . 6)))))
+ (should (equal (sort (map-merge-with 'list #'+
+ '((1 . 2))
+ '((1 . 3) (2 . 4))
+ '((1 . 1) (2 . 5) (3 . 0)))
+ #'car-less-than-car)
+ '((1 . 6) (2 . 9) (3 . 0))))
+ (should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1))))
+ (should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1))))
+
+(ert-deftest test-map-merge-empty ()
+ "Test merging of empty maps."
+ (should-not (map-merge 'list))
+ (should-not (map-merge 'alist))
+ (should-not (map-merge 'plist))
+ (should-not (map-merge-with 'list #'+))
+ (should-not (map-merge-with 'alist #'+))
+ (should-not (map-merge-with 'plist #'+))
+ (should (map-empty-p (map-merge 'hash-table)))
+ (should (map-empty-p (map-merge-with 'hash-table #'+)))
+ (should-error (map-merge 'array) :type 'cl-no-applicable-method)
+ (should-error (map-merge-with 'array #'+) :type 'cl-no-applicable-method))
(ert-deftest test-map-plist-pcase ()
(let ((plist '(:one 1 :two 2)))
@@ -382,5 +484,42 @@ Evaluate BODY for each created map.
(list one two))
'(1 2)))))
+(ert-deftest test-map-setf-alist-insert-key ()
+ (let ((alist))
+ (should (equal (setf (map-elt alist 'key) 'value)
+ 'value))
+ (should (equal alist '((key . value))))))
+
+(ert-deftest test-map-setf-alist-overwrite-key ()
+ (let ((alist '((key . value1))))
+ (should (equal (setf (map-elt alist 'key) 'value2)
+ 'value2))
+ (should (equal alist '((key . value2))))))
+
+(ert-deftest test-map-setf-plist-insert-key ()
+ (let ((plist '(key value)))
+ (should (equal (setf (map-elt plist 'key2) 'value2)
+ 'value2))
+ (should (equal plist '(key value key2 value2)))))
+
+(ert-deftest test-map-setf-plist-overwrite-key ()
+ (let ((plist '(key value)))
+ (should (equal (setf (map-elt plist 'key) 'value2)
+ 'value2))
+ (should (equal plist '(key value2)))))
+
+(ert-deftest test-hash-table-setf-insert-key ()
+ (let ((ht (make-hash-table)))
+ (should (equal (setf (map-elt ht 'key) 'value)
+ 'value))
+ (should (equal (map-elt ht 'key) 'value))))
+
+(ert-deftest test-hash-table-setf-overwrite-key ()
+ (let ((ht (make-hash-table)))
+ (puthash 'key 'value1 ht)
+ (should (equal (setf (map-elt ht 'key) 'value2)
+ 'value2))
+ (should (equal (map-elt ht 'key) 'value2))))
+
(provide 'map-tests)
;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el
index da5f4f5700f..0c0297b5fce 100644
--- a/test/lisp/emacs-lisp/memory-report-tests.el
+++ b/test/lisp/emacs-lisp/memory-report-tests.el
@@ -45,6 +45,7 @@
(should (equal (memory-report-object-size (list 'foo)) 16))
+ (should (equal (memory-report-object-size (vector 1 2 3)) 64))
(should (equal (memory-report-object-size (vector 1 2 3 4)) 80))
(should (equal (memory-report-object-size "") 32))
@@ -52,6 +53,21 @@
(should (equal (memory-report-object-size (propertize "a" 'face 'foo))
81)))
+(ert-deftest memory-report-sizes-vectors ()
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ ["long string that should be at least 40 bytes"])
+ 108))
+ (let ((string "long string that should be at least 40 bytes"))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string))
+ 108))
+ (should (= (memory-report--object-size
+ (make-hash-table :test #'eq)
+ (vector string string))
+ 124))))
+
(provide 'memory-report-tests)
;;; memory-report-tests.el ends here
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index 67d647d3b9e..29435799555 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -263,6 +263,74 @@ Must called from within a `tar-mode' buffer."
(should (file-exists-p autoloads-file))
(should-not (get-file-buffer autoloads-file)))))
+(ert-deftest package-test-install-file ()
+ "Install files with `package-install-file'."
+ (with-package-test (:basedir (ert-resource-directory))
+ (package-initialize)
+ (let* ((pkg-el "simple-single-1.3.el")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (should-not (package-installed-p 'simple-single))
+ (package-install-file source-file)
+ (should (package-installed-p 'simple-single))
+ (package-delete (cadr (assq 'simple-single package-alist)))
+ (should-not (package-installed-p 'simple-single)))
+
+ (let* ((pkg-el "multi-file-0.2.3.tar")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (package-initialize)
+ (should-not (package-installed-p 'multie-file))
+ (package-install-file source-file)
+ (should (package-installed-p 'multi-file))
+ (package-delete (cadr (assq 'multi-file package-alist))))
+ ))
+
+(ert-deftest package-test-install-file-EOLs ()
+ "Install same file multiple time with `package-install-file'
+but with a different end of line convention (bug#48137)."
+ (with-package-test (:basedir (ert-resource-directory))
+ (package-initialize)
+ (let* ((pkg-el "simple-single-1.3.el")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+
+ (with-temp-buffer
+ (insert-file-contents source-file)
+
+ (let (hashes)
+ (dolist (coding '(unix dos mac) hashes)
+ (let* ((eol-file (expand-file-name pkg-el package-test-user-dir)))
+ ;; save package with this EOL convention.
+ (set-buffer-file-coding-system coding)
+ (write-region (point-min) (point-max) eol-file)
+
+ (should-not (package-installed-p 'simple-single))
+ (package-install-file eol-file)
+ (should (package-installed-p 'simple-single))
+
+ ;; check the package file has been installed unmodified.
+ (let ((eol-hash (with-temp-buffer
+ (insert-file-contents-literally eol-file)
+ (buffer-hash))))
+ ;; also perform an additional check that the package
+ ;; file created with this EOL convention is different
+ ;; than all the others created so far.
+ (should-not (member eol-hash hashes))
+ (setq hashes (cons eol-hash hashes))
+
+ (let* ((descr (cadr (assq 'simple-single package-alist)))
+ (pkg-dir (package-desc-dir descr))
+ (dest-file (expand-file-name "simple-single.el" pkg-dir ))
+ (dest-hash (with-temp-buffer
+ (insert-file-contents-literally dest-file)
+ (buffer-hash))))
+
+ (should (string= dest-hash eol-hash))))
+
+ (package-delete (cadr (assq 'simple-single package-alist)))
+ (should-not (package-installed-p 'simple-single))
+ (delete-file eol-file)
+ (should-not (file-exists-p eol-file))
+ )))))))
+
(ert-deftest package-test-install-dependency ()
"Install a package which includes a dependency."
(with-package-test ()
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index e6f4c097504..7ad01e7aef7 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -75,8 +75,86 @@
(ert-deftest pcase-tests-vectors ()
(should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+(ert-deftest pcase-tests-bug14773 ()
+ (let ((f (lambda (x)
+ (pcase 'dummy
+ ((and (let var x) (guard var)) 'left)
+ ((and (let var (not x)) (guard var)) 'right)))))
+ (should (equal (funcall f t) 'left))
+ (should (equal (funcall f nil) 'right))))
+
+(ert-deftest pcase-tests-bug46786 ()
+ (let ((self 'outer))
+ (ignore self)
+ (should (equal (cl-macrolet ((show-self () `(list 'self self)))
+ (pcase-let ((`(,self ,_self2) '(inner "2")))
+ (show-self)))
+ '(self inner)))))
+
+(ert-deftest pcase-tests-or-vars ()
+ (let ((f (lambda (v)
+ (pcase v
+ ((or (and 'b1 (let x1 4) (let x2 5))
+ (and 'b2 (let y1 8) (let y2 9)))
+ (list x1 x2 y1 y2))))))
+ (should (equal (funcall f 'b1) '(4 5 nil nil)))
+ (should (equal (funcall f 'b2) '(nil nil 8 9)))))
+
+(ert-deftest pcase-tests-cl-type ()
+ (should (equal (pcase 1
+ ((cl-type integer) 'integer))
+ 'integer))
+ (should (equal (pcase 1
+ ((cl-type (integer 0 2)) 'integer-0<=n<=2))
+ 'integer-0<=n<=2))
+ (should-error (pcase 1
+ ((cl-type notatype) 'integer))))
+
+(ert-deftest pcase-tests-setq ()
+ (should (equal (let (a b)
+ (pcase-setq `((,a) (,b)) '((1) (2)))
+ (list a b))
+ (list 1 2)))
+
+ (should (equal (list nil nil)
+ (let ((a 'unset)
+ (b 'unset))
+ (pcase-setq `(head ,a ,b) nil)
+ (list a b))))
+
+ (should (equal (let (a b)
+ (pcase-setq `[,a ,b] [1 2])
+ (list a b))
+ '(1 2)))
+
+ (should-error (let (a b)
+ (pcase-setq `[,a ,b] nil)
+ (list a b)))
+
+ (should (equal (let (a b)
+ (pcase-setq a 1 b 2)
+ (list a b))
+ '(1 2)))
+
+ (should (= (let (a)
+ (pcase-setq a 1 `(,a) '(2))
+ a)
+ 2))
+
+ (should (equal (let (array list-item array-copy)
+ (pcase-setq (or `(,list-item) array) [1 2 3]
+ array-copy array
+ ;; This re-sets `array' to nil.
+ (or `(,list-item) array) '(4))
+ (list array array-copy list-item))
+ '(nil [1 2 3] 4)))
+
+ (let ((a nil))
+ (should-error (pcase-setq a 1 b)
+ :type '(wrong-number-of-arguments))
+ (should (eq a nil)))
+
+ (should-error (pcase-setq a)
+ :type '(wrong-number-of-arguments)))
;;; pcase-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 63d7c7b91ea..4828df0de92 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -156,6 +156,8 @@
".....")))
(ert-deftest rx-pcase ()
+ (should (equal (pcase "i18n" ((rx (let x (+ digit))) (list 'ok x)))
+ '(ok "18")))
(should (equal (pcase "a 1 2 3 1 1 b"
((rx (let u (+ digit)) space
(let v (+ digit)) space
@@ -164,6 +166,20 @@
(backref 1))
(list u v)))
'("1" "3")))
+ (should (equal (pcase "bz"
+ ((rx "a" (let x nonl)) (list 1 x))
+ (_ 'no))
+ 'no))
+ (should (equal (pcase "az"
+ ((rx "a" (let x nonl)) (list 1 x))
+ ((rx "b" (let x nonl)) (list 2 x))
+ (_ 'no))
+ '(1 "z")))
+ (should (equal (pcase "bz"
+ ((rx "a" (let x nonl)) (list 1 x))
+ ((rx "b" (let x nonl)) (list 2 x))
+ (_ 'no))
+ '(2 "z")))
(let ((k "blue"))
(should (equal (pcase "<blue>"
((rx "<" (literal k) ">") 'ok))
@@ -171,7 +187,23 @@
(should (equal (pcase "abc"
((rx (? (let x alpha)) (?? (let y alnum)) ?c)
(list x y)))
- '("a" "b"))))
+ '("a" "b")))
+ (should (equal (pcase 'not-a-string
+ ((rx nonl) 'wrong)
+ (_ 'correct))
+ 'correct))
+ (should (equal (pcase "PQR"
+ ((and (rx (let a nonl)) (rx ?z))
+ (list 'one a))
+ ((rx (let b ?Q))
+ (list 'two b)))
+ '(two "Q")))
+ (should (equal (pcase-let (((rx ?B (let z nonl)) "ABC"))
+ (list 'ok z))
+ '(ok "C")))
+ (should (equal (pcase-let* (((rx ?E (let z nonl)) "DEF"))
+ (list 'ok z))
+ '(ok "F"))))
(ert-deftest rx-kleene ()
"Test greedy and non-greedy repetition operators."
@@ -388,6 +420,8 @@
(ert-deftest rx-regexp ()
(should (equal (rx (regexp "abc") (regex "[de]"))
"\\(?:abc\\)[de]"))
+ (should (equal (rx "a" (regexp "$"))
+ "a\\(?:$\\)"))
(let ((x "a*"))
(should (equal (rx (regexp x) "b")
"\\(?:a*\\)b"))
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index 05c7fbe781e..44e855e2cfa 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -383,6 +383,30 @@ Evaluate BODY for each created sequence.
(should (null b))
(should (null c)))))
+(ert-deftest test-seq-setq ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (let (a b c d e)
+ (seq-setq (a b c d e) seq)
+ (should (= a 1))
+ (should (= b 2))
+ (should (= c 3))
+ (should (= d 4))
+ (should (null e)))
+ (let (a b others)
+ (seq-setq (a b &rest others) seq)
+ (should (= a 1))
+ (should (= b 2))
+ (should (same-contents-p others (seq-drop seq 2)))))
+ (let ((a)
+ (seq '(1 (2 (3 (4))))))
+ (seq-setq (_ (_ (_ (a)))) seq)
+ (should (= a 4)))
+ (let (seq a b c)
+ (seq-setq (a b c) seq)
+ (should (null a))
+ (should (null b))
+ (should (null c))))
+
(ert-deftest test-seq-min-max ()
(with-test-sequences (seq '(4 5 3 2 0 4))
(should (= (seq-min seq) 0))
diff --git a/test/lisp/emacs-lisp/shortdoc-tests.el b/test/lisp/emacs-lisp/shortdoc-tests.el
new file mode 100644
index 00000000000..3bb3185649b
--- /dev/null
+++ b/test/lisp/emacs-lisp/shortdoc-tests.el
@@ -0,0 +1,45 @@
+;;; shortdoc-tests.el --- tests for shortdoc.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'ert)
+(require 'shortdoc)
+
+(defun shortdoc-tests--tree-contains (tree fun)
+ "Whether TREE contains a call to FUN."
+ (and (proper-list-p tree)
+ (or (eq (car tree) fun)
+ (cl-some (lambda (x) (shortdoc-tests--tree-contains x fun)) tree))))
+
+(ert-deftest shortdoc-examples ()
+ "Check that each example actually contains the corresponding form."
+ (dolist (group shortdoc--groups)
+ (dolist (item group)
+ (when (consp item)
+ (let ((fun (car item))
+ (props (cdr item)))
+ (while props
+ (when (memq (car props) '(:eval :no-eval :no-eval* :no-value))
+ (let* ((example (cadr props))
+ (expr (cond
+ ((consp example) example)
+ ((stringp example) (read example)))))
+ (should (shortdoc-tests--tree-contains expr fun))))
+ (setq props (cddr props))))))))
+
+(provide 'shortdoc-tests)
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 112f3c1dac1..ef04cde3867 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -607,18 +607,21 @@
(should (equal (string-limit "foó" 4 nil 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóa" 4 nil 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóá" 4 nil 'utf-8) "fo\303\263"))
+ (should (equal (string-limit "foóá" 4 nil 'utf-8-with-signature)
+ "fo\303\263"))
(should (equal (string-limit "foóa" 4 nil 'iso-8859-1) "fo\363a"))
(should (equal (string-limit "foóá" 4 nil 'iso-8859-1) "fo\363\341"))
- (should (equal (string-limit "foóá" 4 nil 'utf-16) "\376\377\000f"))
+ (should (equal (string-limit "foóá" 4 nil 'utf-16) "\000f\000o"))
(should (equal (string-limit "foó" 10 t 'utf-8) "fo\303\263"))
(should (equal (string-limit "foó" 3 t 'utf-8) "o\303\263"))
(should (equal (string-limit "foó" 4 t 'utf-8) "fo\303\263"))
(should (equal (string-limit "foóa" 4 t 'utf-8) "o\303\263a"))
(should (equal (string-limit "foóá" 4 t 'utf-8) "\303\263\303\241"))
+ (should (equal (string-limit "foóá" 2 t 'utf-8-with-signature) "\303\241"))
(should (equal (string-limit "foóa" 4 t 'iso-8859-1) "fo\363a"))
(should (equal (string-limit "foóá" 4 t 'iso-8859-1) "fo\363\341"))
- (should (equal (string-limit "foóá" 4 t 'utf-16) "\376\377\000\341")))
+ (should (equal (string-limit "foóá" 4 t 'utf-16) "\000\363\000\341")))
(ert-deftest subr-string-lines ()
(should (equal (string-lines "foo") '("foo")))
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index 5dbf2272b1a..7ced257c6f9 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
index 9f0312d85ff..7854e33e77d 100644
--- a/test/lisp/emacs-lisp/testcover-tests.el
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -6,18 +6,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/epg-config-tests.el b/test/lisp/epg-config-tests.el
new file mode 100644
index 00000000000..fba61e573c3
--- /dev/null
+++ b/test/lisp/epg-config-tests.el
@@ -0,0 +1,47 @@
+;;; epg-config-tests.el --- Test suite for epg.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'epg-config)
+
+(ert-deftest epg-config-test-epg-find-configuration ()
+ (skip-unless (executable-find "gpg2"))
+ (should (assq 'version (epg-find-configuration 'OpenPGP))))
+
+(ert-deftest epg-config-test-epg-find-configuration/unknown-protocol ()
+ (should-error (epg-find-configuration 'does-not-exist)))
+
+(ert-deftest epg-config-test-epg-check-configuration ()
+ (should (epg-check-configuration '((version . "1.0")) "0.9"))
+ (should (epg-check-configuration '((version . "1.0")) "1.0"))
+ (should-error (epg-check-configuration '((version . "1.0")) "1.1"))
+ (should-error (epg-check-configuration '((version . "1.0")) 'foo))
+ (should-error (epg-check-configuration '((version . "1.0")) "foo")))
+
+(ert-deftest epg-config-test-epg-required-version-p ()
+ (skip-unless (executable-find "gpg2"))
+ (should (epg-required-version-p 'OpenPGP "1.0")))
+
+(provide 'epg-config-tests)
+
+;;; epg-config-tests.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 26e14b98e91..d13397274aa 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -23,6 +23,7 @@
(require 'ert)
(require 'erc)
+(require 'erc-ring)
(ert-deftest erc--read-time-period ()
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
@@ -45,3 +46,66 @@
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
(should (equal (erc--read-time-period "foo: ") 86400))))
+
+(ert-deftest erc-ring-previous-command-base-case ()
+ (ert-info ("Create ring when nonexistent and do nothing")
+ (let (erc-input-ring
+ erc-input-ring-index)
+ (erc-previous-command)
+ (should (ring-p erc-input-ring))
+ (should (zerop (ring-length erc-input-ring)))
+ (should-not erc-input-ring-index)))
+ (should-not erc-input-ring))
+
+(ert-deftest erc-ring-previous-command ()
+ (with-current-buffer (get-buffer-create "*#fake*")
+ (erc-mode)
+ (insert "\n\n")
+ (setq erc-input-marker (make-marker) ; these are all local
+ erc-insert-marker (make-marker)
+ erc-send-completed-hook nil)
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+ (should (= (point) erc-input-marker))
+ (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring nil t)
+ ;;
+ (cl-letf (((symbol-function 'erc-process-input-line)
+ (lambda (&rest _)
+ (insert-before-markers
+ (erc-display-message-highlight 'notice "echo: one\n"))))
+ ((symbol-function 'erc-command-no-process-p)
+ (lambda (&rest _) t)))
+ (ert-info ("Create ring, populate, recall")
+ (insert "/one")
+ (erc-send-current-line)
+ (should (ring-p erc-input-ring))
+ (should (zerop (ring-member erc-input-ring "/one"))) ; equal
+ (should (save-excursion (forward-line -1) (goto-char (point-at-bol))
+ (looking-at-p "[*]+ echo: one")))
+ (should-not erc-input-ring-index)
+ (erc-bol)
+ (should (looking-at "$"))
+ (erc-previous-command)
+ (erc-bol)
+ (should (looking-at "/one"))
+ (should (zerop erc-input-ring-index)))
+ (ert-info ("Back to one")
+ (should (= (ring-length erc-input-ring) (1+ erc-input-ring-index)))
+ (erc-previous-command)
+ (should-not erc-input-ring-index)
+ (erc-bol)
+ (should (looking-at "$"))
+ (should (equal (ring-ref erc-input-ring 0) "/one")))
+ (ert-info ("Swap input after prompt with previous (#bug46339)")
+ (insert "abc")
+ (erc-previous-command)
+ (should (= 1 erc-input-ring-index))
+ (erc-bol)
+ (should (looking-at "/one"))
+ (should (equal (ring-ref erc-input-ring 0) "abc"))
+ (should (equal (ring-ref erc-input-ring 1) "/one"))
+ (erc-next-command)
+ (erc-bol)
+ (should (looking-at "abc")))))
+ (when noninteractive
+ (kill-buffer "*#fake*")))
diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el
index ec65397fd63..31967a61c3c 100644
--- a/test/lisp/eshell/em-hist-tests.el
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -1,4 +1,4 @@
-;;; tests/em-hist-tests.el --- em-hist test suite -*- lexical-binding:t -*-
+;;; em-hist-tests.el --- em-hist test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
index fc2cd9c8e14..5d1742b76fd 100644
--- a/test/lisp/eshell/em-ls-tests.el
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -1,4 +1,4 @@
-;;; tests/em-ls-tests.el --- em-ls test suite -*- lexical-binding:t -*-
+;;; em-ls-tests.el --- em-ls test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/esh-opt-tests.el b/test/lisp/eshell/esh-opt-tests.el
index 0c99da64b2e..e2a0ea59d1c 100644
--- a/test/lisp/eshell/esh-opt-tests.el
+++ b/test/lisp/eshell/esh-opt-tests.el
@@ -1,4 +1,4 @@
-;;; tests/esh-opt-tests.el --- esh-opt test suite -*- lexical-binding:t -*-
+;;; esh-opt-tests.el --- esh-opt test suite -*- lexical-binding:t -*-
;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 4dac7024f41..4f0cc9b6785 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -1,4 +1,4 @@
-;;; tests/eshell-tests.el --- Eshell test suite -*- lexical-binding:t -*-
+;;; eshell-tests.el --- Eshell test suite -*- lexical-binding:t -*-
;; Copyright (C) 1999-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 3ceb392d7fb..f8113bffc1a 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -123,6 +123,25 @@ left alone when opening a URL in an external browser."
(save-excursion (insert "type="))
(ffap-guess-file-name-at-point))))
+(ert-deftest ffap-ido-mode ()
+ (require 'ido)
+ (with-temp-buffer
+ (let ((ido-mode t)
+ (read-file-name-function read-file-name-function)
+ (read-buffer-function read-buffer-function))
+ ;; Says ert-deftest:
+ ;; Macros in BODY are expanded when the test is defined, not when it
+ ;; is run. If a macro (possibly with side effects) is to be tested,
+ ;; it has to be wrapped in `(eval (quote ...))'.
+ (eval (quote (ido-everywhere)))
+ (let ((read-file-name-function (lambda (&rest args)
+ (expand-file-name
+ (nth 4 args)
+ (nth 1 args)))))
+ (save-excursion (insert "ffap-tests.el"))
+ (let (kill-buffer-query-functions)
+ (kill-buffer (call-interactively #'find-file-at-point)))))))
+
(provide 'ffap-tests)
;;; ffap-tests.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index d73b072661a..6125069c6b3 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -107,19 +107,20 @@ There are different timeouts for local and remote file notification libraries."
(cond
;; gio/gpollfilemonitor.c declares POLL_TIME_SECS 5. So we must
;; wait at least this time in the GPollFileMonitor case. A
- ;; similar timeout seems to be needed in the GFamFileMonitor case,
- ;; at least on cygwin.
- ((memq (file-notify--test-monitor) '(GFamFileMonitor GPollFileMonitor)) 7)
- ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe") 1)
+ ;; similar timeout seems to be needed in the
+ ;; GFam{File,Directory}Monitor case. So we use a large timeout
+ ;; for any monitor.
+ ((file-notify--test-monitor) 7)
((file-remote-p temporary-file-directory) 0.1)
(t 0.01))))
(defun file-notify--test-timeout ()
"Timeout to wait for arriving a bunch of events, in seconds."
(cond
- ((file-remote-p temporary-file-directory) 6)
+ ((file-remote-p temporary-file-directory) 20)
+ ((eq system-type 'cygwin) 10)
+ ((getenv "EMACS_EMBA_CI") 10)
((string-equal (file-notify--test-library) "w32notify") 4)
- ((eq system-type 'cygwin) 6)
(t 3)))
(defmacro file-notify--test-wait-for-events (timeout until)
@@ -199,7 +200,10 @@ Return nil when any other file notification watch is still active."
(setq file-notify-debug nil
password-cache-expiry nil
- tramp-verbose 0)
+ tramp-verbose 0
+ ;; When the remote user id is 0, Tramp refuses unsafe temporary files.
+ tramp-allow-unsafe-temporary-files
+ (or tramp-allow-unsafe-temporary-files noninteractive))
;; This should happen on hydra only.
(when (getenv "EMACS_HYDRA_CI")
@@ -256,24 +260,37 @@ remote host, or nil."
(defun file-notify--test-monitor ()
"The used monitor for the test, as a symbol.
-This returns only for the local case and gfilenotify; otherwise it is nil.
-`file-notify--test-desc' must be a valid watch descriptor."
+This returns only for (local) gfilenotify or (remote) gio library;
+otherwise it is nil. `file-notify--test-desc' must be a valid
+watch descriptor."
;; We cache the result, because after `file-notify-rm-watch',
;; `gfile-monitor-name' does not return a proper result anymore.
- ;; But we still need this information.
- ;; So far, we know the monitors GFamFileMonitor, GFenFileMonitor,
- ;; GInotifyFileMonitor, GKqueueFileMonitor and GPollFileMonitor.
- (or (cdr (assq file-notify--test-desc file-notify--test-monitors))
- (progn
- (add-to-list
- 'file-notify--test-monitors
- (cons file-notify--test-desc
- (if (file-remote-p temporary-file-directory)
- (tramp-get-connection-property
- file-notify--test-desc "gio-file-monitor" nil)
- (and (functionp 'gfile-monitor-name)
- (gfile-monitor-name file-notify--test-desc)))))
- (cdr (assq file-notify--test-desc file-notify--test-monitors)))))
+ ;; But we still need this information. So far, we know the monitors
+ ;; GFamFileMonitor (gfilenotify on cygwin), GFamDirectoryMonitor
+ ;; (gfilenotify on Solaris), GInotifyFileMonitor (gfilenotify and
+ ;; gio on GNU/Linux), GKqueueFileMonitor (gfilenotify and gio on
+ ;; FreeBSD) and GPollFileMonitor (gio on cygwin).
+ (when file-notify--test-desc
+ (or (alist-get file-notify--test-desc file-notify--test-monitors)
+ (when (member (file-notify--test-library) '("gfilenotify" "gio"))
+ (add-to-list
+ 'file-notify--test-monitors
+ (cons file-notify--test-desc
+ (if (file-remote-p temporary-file-directory)
+ ;; `file-notify--test-desc' is the connection process.
+ (progn
+ (while (not (tramp-connection-property-p
+ file-notify--test-desc "gio-file-monitor"))
+ (accept-process-output file-notify--test-desc 0))
+ (tramp-get-connection-property
+ file-notify--test-desc "gio-file-monitor" nil))
+ (and (functionp 'gfile-monitor-name)
+ (gfile-monitor-name file-notify--test-desc)))))
+ ;; If we don't know the monitor, there are good chances the
+ ;; test will fail. We let it fail already here, in order to
+ ;; know the real reason.
+ (should (alist-get file-notify--test-desc file-notify--test-monitors)))
+ (alist-get file-notify--test-desc file-notify--test-monitors))))
(defmacro file-notify--deftest-remote (test docstring &optional unstable)
"Define ert `TEST-remote' for remote files.
@@ -484,6 +501,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(file-notify-add-watch
file-notify--test-tmpfile
'(change) #'second-callback)))
+ ;; `file-notify-rm-watch' confuses `file-notify--test-monitor'.
+ ;; Initialize it in time.
+ (file-notify--test-monitor)
;; Remove first watch.
(file-notify-rm-watch file-notify--test-desc)
;; Only the second callback shall run.
@@ -547,6 +567,10 @@ and the event to `file-notify--test-events'."
file-notify--test-results
(append file-notify--test-results `(,result))))))
+(defun file-notify--test-event-actions ()
+ "Helper function to return retrieved actions, as list."
+ (mapcar #'file-notify--test-event-action file-notify--test-events))
+
(defun file-notify--test-with-actions-check (actions)
"Check whether received actions match one of the ACTIONS alternatives."
(let (result)
@@ -555,22 +579,25 @@ and the event to `file-notify--test-events'."
(or result
(if (eq (car elt) :random)
(equal (sort (cdr elt) 'string-lessp)
- (sort (mapcar #'file-notify--test-event-action
- file-notify--test-events)
+ (sort (file-notify--test-event-actions)
'string-lessp))
- (equal elt (mapcar #'file-notify--test-event-action
- file-notify--test-events))))))))
+ (equal elt (file-notify--test-event-actions))))))
+ ;; Do not report result in case we debug. Write messages instead.
+ (if file-notify-debug
+ (prog1 t
+ (if result
+ (message "Success\n%s" (file-notify--test-event-actions))
+ (message (file-notify--test-with-actions-explainer actions))))
+ result)))
(defun file-notify--test-with-actions-explainer (actions)
"Explain why `file-notify--test-with-actions-check' fails."
(if (null (cdr actions))
(format "Received actions do not match expected actions\n%s\n%s"
- (mapcar #'file-notify--test-event-action file-notify--test-events)
- (car actions))
+ (file-notify--test-event-actions) (car actions))
(format
"Received actions do not match any sequence of expected actions\n%s\n%s"
- (mapcar #'file-notify--test-event-action file-notify--test-events)
- actions)))
+ (file-notify--test-event-actions) actions)))
(put 'file-notify--test-with-actions-check 'ert-explainer
'file-notify--test-with-actions-explainer)
@@ -592,6 +619,9 @@ delivered."
(mapcar
(lambda (x) (length (if (eq (car x) :random) (cdr x) x)))
actions)))
+ ;; Don't stop while debugging.
+ (while-no-input-ignore-events
+ (cons 'file-notify while-no-input-ignore-events))
create-lockfiles)
;; Flush pending actions.
(file-notify--test-read-event)
@@ -632,16 +662,11 @@ delivered."
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-actions
(cond
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `created' event reliably.
- ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
- '((deleted stopped)
- (created deleted stopped)))
- ;; cygwin does not raise a `changed' event.
- ((eq system-type 'cygwin)
- '(created deleted stopped))
- ;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ;; GFam{File,Directory}Monitor, GKqueueFileMonitor and
+ ;; GPollFileMonitor do not report the `changed' event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor
+ GKqueueFileMonitor GPollFileMonitor))
'(created deleted stopped))
(t '(created changed deleted stopped)))
(write-region
@@ -668,13 +693,14 @@ delivered."
'(change) #'file-notify--test-event-handler)))
(file-notify--test-with-actions
(cond
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `changed' event reliably.
- ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
+ ;; GFam{File,Directory}Monitor and GPollFileMonitor do
+ ;; not detect the `changed' event reliably.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'((deleted stopped)
(changed deleted stopped)))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
@@ -709,25 +735,22 @@ delivered."
;; events for the watched directory.
((string-equal (file-notify--test-library) "w32notify")
'(created changed deleted))
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `created' event reliably.
- ((string-equal
- (file-notify--test-library) "gvfs-monitor-dir.exe")
- '((deleted stopped)
- (created deleted stopped)))
;; On emba, `deleted' and `stopped' events of the
;; directory are not detected.
((getenv "EMACS_EMBA_CI")
'(created changed deleted))
;; There are two `deleted' events, for the file and for
- ;; the directory. Except for cygwin and kqueue. And
- ;; cygwin does not raise a `changed' event.
- ((eq system-type 'cygwin)
+ ;; the directory. Except for
+ ;; GFam{File,Directory}Monitor, GPollFileMonitor and
+ ;; kqueue. And GFam{File,Directory}Monitor and
+ ;; GPollFileMonitordo not raise a `changed' event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
@@ -762,15 +785,12 @@ delivered."
'(created changed created changed
changed changed changed
deleted deleted))
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `created' event reliably.
- ((string-equal
- (file-notify--test-library) "gvfs-monitor-dir.exe")
- '((deleted stopped)
- (created created deleted stopped)))
;; There are three `deleted' events, for two files and
- ;; for the directory. Except for cygwin and kqueue.
- ((eq system-type 'cygwin)
+ ;; for the directory. Except for
+ ;; GFam{File,Directory}Monitor, GPollFileMonitor and
+ ;; kqueue.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created created changed changed deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed created changed deleted stopped))
@@ -779,7 +799,7 @@ delivered."
((getenv "EMACS_EMBA_CI")
'(created changed created changed deleted deleted))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created created deleted deleted deleted stopped))
(t '(created changed created changed
deleted deleted deleted stopped)))
@@ -819,26 +839,23 @@ delivered."
;; events for the watched directory.
((string-equal (file-notify--test-library) "w32notify")
'(created changed renamed deleted))
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `created' event reliably.
- ((string-equal
- (file-notify--test-library) "gvfs-monitor-dir.exe")
- '((deleted stopped)
- (created deleted stopped)))
;; On emba, `deleted' and `stopped' events of the
;; directory are not detected.
((getenv "EMACS_EMBA_CI")
'(created changed renamed deleted))
;; There are two `deleted' events, for the file and for
- ;; the directory. Except for cygwin and kqueue. And
- ;; cygwin raises `created' and `deleted' events instead
- ;; of a `renamed' event.
- ((eq system-type 'cygwin)
+ ;; the directory. Except for
+ ;; GFam{File,Directory}Monitor, GPollfileMonitor and
+ ;; kqueue. And GFam{File,Directory}Monitor and
+ ;; GPollFileMonitor raise `created' and `deleted' events
+ ;; instead of a `renamed' event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created created deleted deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed renamed deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created renamed deleted deleted stopped))
(t '(created changed renamed deleted deleted stopped)))
(write-region
@@ -857,8 +874,8 @@ delivered."
(file-notify--test-cleanup))
(unwind-protect
- ;; Check attribute change. Does not work for cygwin.
- (unless (eq system-type 'cygwin)
+ ;; Check attribute change.
+ (progn
(setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
(write-region
"any text" nil file-notify--test-tmpfile nil 'no-message)
@@ -876,12 +893,21 @@ delivered."
((string-equal (file-notify--test-library) "w32notify")
'((changed changed)
(changed changed changed changed)))
- ;; GKqueueFileMonitor does not report the `attribute-changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
- ;; For kqueue and in the remote case, `write-region'
- ;; raises also an `attribute-changed' event.
- ((or (string-equal (file-notify--test-library) "kqueue")
- (file-remote-p temporary-file-directory))
+ ;; GFam{File,Directory}Monitor, GKqueueFileMonitor and
+ ;; GPollFileMonitor do not report the `attribute-changed'
+ ;; event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor
+ GKqueueFileMonitor GPollFileMonitor))
+ '())
+ ;; For GInotifyFileMonitor,`write-region' raises
+ ;; also an `attribute-changed' event on gio.
+ ((and (string-equal (file-notify--test-library) "gio")
+ (eq (file-notify--test-monitor) 'GInotifyFileMonitor))
+ '(attribute-changed attribute-changed attribute-changed))
+ ;; For kqueue, `write-region' raises also an
+ ;; `attribute-changed' event.
+ ((string-equal (file-notify--test-library) "kqueue")
'(attribute-changed attribute-changed attribute-changed))
(t '(attribute-changed attribute-changed)))
(write-region
@@ -901,7 +927,7 @@ delivered."
(file-notify--test-cleanup)))
(file-notify--deftest-remote file-notify-test03-events
- "Check file creation/change/removal notifications for remote files.")
+ "Check file creation/change/removal notifications for remote files." t)
(require 'autorevert)
(setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"
@@ -946,7 +972,7 @@ delivered."
;; GKqueueFileMonitor does not report the `changed' event.
(skip-unless
- (not (equal (file-notify--test-monitor) 'GKqueueFileMonitor)))
+ (not (eq (file-notify--test-monitor) 'GKqueueFileMonitor)))
;; Check, that file notification has been used.
(should auto-revert-mode)
@@ -1046,13 +1072,14 @@ delivered."
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-actions
(cond
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `changed' event reliably.
- ((string-equal (file-notify--test-library) "gvfs-monitor-dir.exe")
+ ;; GFam{File,Directory}Monitor do not
+ ;; detect the `changed' event reliably.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor))
'((deleted stopped)
(changed deleted stopped)))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(deleted stopped))
;; There could be one or two `changed' events.
(t '((changed deleted stopped)
@@ -1090,21 +1117,18 @@ delivered."
;; events for the watched directory.
((string-equal (file-notify--test-library) "w32notify")
'(created changed deleted))
- ;; gvfs-monitor-dir on cygwin does not detect the
- ;; `created' event reliably.
- ((string-equal
- (file-notify--test-library) "gvfs-monitor-dir.exe")
- '((deleted stopped)
- (created deleted stopped)))
;; There are two `deleted' events, for the file and for
- ;; the directory. Except for cygwin and kqueue. And
- ;; cygwin does not raise a `changed' event.
- ((eq system-type 'cygwin)
+ ;; the directory. Except for
+ ;; GFam{File,Directory}Monitor, GPollFileMonitor and
+ ;; kqueue. And GFam{File,Directory}Monitor and
+ ;; GPollfileMonitor do not raise a `changed' event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
'(created deleted stopped))
((string-equal (file-notify--test-library) "kqueue")
'(created changed deleted stopped))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(created deleted deleted stopped))
(t '(created changed deleted deleted stopped)))
(write-region
@@ -1205,7 +1229,7 @@ delivered."
file-notify--test-tmpfile
'(change) #'file-notify--test-event-handler)))
(unwind-protect
- (let ((n 1000)
+ (let ((n 10);00)
source-file-list target-file-list
(default-directory file-notify--test-tmpfile))
(dotimes (i n)
@@ -1234,9 +1258,11 @@ delivered."
(dotimes (_i n)
(setq r (append '(deleted renamed) r)))
r))
- ;; cygwin fires `changed' and `deleted' events, sometimes
- ;; in random order.
- ((eq system-type 'cygwin)
+ ;; GFam{File,Directory}Monitor and GPollFileMonitor fire
+ ;; `changed' and `deleted' events, sometimes in random
+ ;; order.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
(let (r)
(dotimes (_i n)
(setq r (append '(changed deleted) r)))
@@ -1285,7 +1311,7 @@ delivered."
(file-notify--test-with-actions
(cond
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor) nil)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor) '())
;; There could be one or two `changed' events.
(t '((changed)
(changed changed))))
@@ -1323,11 +1349,13 @@ delivered."
(should (file-notify-valid-p file-notify--test-desc))
(file-notify--test-with-actions
(cond
- ;; On cygwin we only get the `changed' event.
- ((eq system-type 'cygwin)
- '(changed))
+ ;; GFam{File,Directory}Monitor and GPollFileMonitor
+ ;; report only the `changed' event.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
+ '(changed))
;; GKqueueFileMonitor does not report the `changed' event.
- ((equal (file-notify--test-monitor) 'GKqueueFileMonitor)
+ ((eq (file-notify--test-monitor) 'GKqueueFileMonitor)
'(renamed created))
(t '(renamed created changed)))
;; The file is renamed when creating a backup. It shall
@@ -1398,7 +1426,7 @@ the file watch."
(should (file-notify-valid-p file-notify--test-desc1))
(should (file-notify-valid-p file-notify--test-desc2))
(should-not (equal file-notify--test-desc1 file-notify--test-desc2))
- (let ((n 100))
+ (let ((n 10));0))
;; Run the test.
(file-notify--test-with-actions
;; There could be one or two `changed' events.
@@ -1455,10 +1483,13 @@ the file watch."
;; Now we delete the directory.
(file-notify--test-with-actions
(cond
- ;; In kqueue and for cygwin, just one `deleted' event for
- ;; the directory is received.
- ((or (eq system-type 'cygwin)
- (string-equal (file-notify--test-library) "kqueue"))
+ ;; GFam{File,Directory}Monitor, GPollFileMonitor and
+ ;; kqueue raise just one `deleted' event for the
+ ;; directory.
+ ((memq (file-notify--test-monitor)
+ '(GFamFileMonitor GFamDirectoryMonitor GPollFileMonitor))
+ '(deleted stopped))
+ ((string-equal (file-notify--test-library) "kqueue")
'(deleted stopped))
(t (append
;; The directory monitor raises a `deleted' event for
diff --git a/test/lisp/files-resources/.dir-locals.el b/test/lisp/files-resources/.dir-locals.el
new file mode 100644
index 00000000000..84393aa54d5
--- /dev/null
+++ b/test/lisp/files-resources/.dir-locals.el
@@ -0,0 +1,5 @@
+;; This is used by files-tests.el.
+((auto-mode-alist . (("\\.quux\\'" . tcl-mode)
+ ("\\.zot1\\'" . foobar)
+ ("\\.zot2\\'" . (lambda ()))
+ ("\\.zot3\\'" . dired-mode))))
diff --git a/test/lisp/files-resources/auto-test.zot1 b/test/lisp/files-resources/auto-test.zot1
new file mode 100644
index 00000000000..80acfcc9f7a
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot1
@@ -0,0 +1 @@
+zot1
diff --git a/test/lisp/files-resources/auto-test.zot2 b/test/lisp/files-resources/auto-test.zot2
new file mode 100644
index 00000000000..975fc765513
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot2
@@ -0,0 +1 @@
+zot2
diff --git a/test/lisp/files-resources/auto-test.zot3 b/test/lisp/files-resources/auto-test.zot3
new file mode 100644
index 00000000000..faa07151606
--- /dev/null
+++ b/test/lisp/files-resources/auto-test.zot3
@@ -0,0 +1 @@
+zot3
diff --git a/test/lisp/files-resources/whatever.quux b/test/lisp/files-resources/whatever.quux
new file mode 100644
index 00000000000..595583b911e
--- /dev/null
+++ b/test/lisp/files-resources/whatever.quux
@@ -0,0 +1,2 @@
+# Used by files-test.el.
+# Due to .dir-locals.el this should end up in Tcl mode.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 149cc689ae9..fb24b98595b 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -151,6 +151,19 @@ form.")
(dolist (subtest (cdr test))
(should (file-test--do-local-variables-test str subtest)))))))
+(ert-deftest files-tests-permanent-local-variables ()
+ (let ((enable-local-variables nil))
+ (with-temp-buffer
+ (insert ";;; test-test.el --- tests -*- lexical-binding: t; -*-\n\n")
+ (hack-local-variables)
+ (should (eq lexical-binding t))))
+ (let ((enable-local-variables nil)
+ (permanently-enabled-local-variables nil))
+ (with-temp-buffer
+ (insert ";;; test-test.el --- tests -*- lexical-binding: t; -*-\n\n")
+ (hack-local-variables)
+ (should (eq lexical-binding nil)))))
+
(defvar files-test-bug-18141-file
(ert-resource-file "files-bug18141.el.gz")
"Test file for bug#18141.")
@@ -192,14 +205,37 @@ form.")
(ert-deftest files-tests-bug-21454 ()
"Test for https://debbugs.gnu.org/21454 ."
(let ((input-result
- '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/"))
- ("/foo/bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("//foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo/bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo//bar/:/bar/qux/:/qux/foo/" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo//bar/:/bar/qux/:/qux/foo" nil ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
- ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
- ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))))
+ (if (memq system-type '(windows-nt ms-dos))
+ '(("/foo/bar//baz/;/bar/foo/baz//" nil
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
+ ("x:/foo/bar/;y:/bar/qux/;z:/qux/foo" nil
+ ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x://foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
+ ("x://foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
+ ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo//bar/;y:/bar/qux/;z:/qux/foo/" nil
+ ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo//bar/;y:/bar/qux/;z:/qux/foo" nil
+ ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo/bar" "$FOO/baz/;z:/qux/foo/"
+ ("x:/foo/bar/baz/" "z:/qux/foo/"))
+ ("//foo/bar/" "$FOO/baz/;/qux/foo/"
+ ("/foo/bar//baz/" "/qux/foo/")))
+ '(("/foo/bar//baz/:/bar/foo/baz//" nil
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
+ ("/foo/bar/:/bar/qux/:/qux/foo" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("//foo/bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo/bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/:/bar/qux/:/qux/foo/" nil
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/:/bar/qux/:/qux/foo" nil
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
+ ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar//baz/" "/qux/foo/")))))
(foo-env (getenv "FOO"))
(bar-env (getenv "BAR")))
(unwind-protect
@@ -279,12 +315,17 @@ be $HOME."
(file-name-unquote temporary-file-directory))))))
(ert-deftest files-tests-file-name-non-special--subprocess ()
- "Check that Bug#25949 is fixed."
- (skip-unless (executable-find "true"))
- (let ((default-directory (file-name-quote temporary-file-directory)))
- (should (zerop (process-file "true")))
- (should (processp (start-file-process "foo" nil "true")))
- (should (zerop (shell-command "true")))))
+ "Check that Bug#25949 and Bug#48177 are fixed."
+ (skip-unless (and (executable-find "true") (file-exists-p null-device)
+ ;; These systems cannot set date of the null device.
+ (not (memq system-type '(windows-nt ms-dos)))))
+ (let ((default-directory (file-name-quote temporary-file-directory))
+ (true (file-name-quote (executable-find "true")))
+ (null (file-name-quote null-device)))
+ (should (zerop (process-file true null `((:file ,null) ,null))))
+ (should (processp (start-file-process "foo" nil true)))
+ (should (zerop (shell-command true)))
+ (should (processp (make-process :name "foo" :command `(,true))))))
(defmacro files-tests--with-advice (symbol where function &rest body)
(declare (indent 3))
@@ -569,7 +610,7 @@ unquoted file names."
(ert-deftest files-tests-file-name-non-special-dired-compress-handler ()
;; `dired-compress-file' can get confused by filenames with ":" in
;; them, which causes this to fail on `windows-nt' systems.
- (when (string-match-p ":" (expand-file-name temporary-file-directory))
+ (when (string-search ":" (expand-file-name temporary-file-directory))
(ert-skip "FIXME: `dired-compress-file' unreliable when filenames contain `:'."))
(files-tests--with-temp-non-special (tmpfile nospecial)
(let ((compressed (dired-compress-file nospecial)))
@@ -692,9 +733,8 @@ unquoted file names."
(file (file-name-nondirectory tmpfile))
(nospecial-file (file-name-nondirectory nospecial)))
(should-not (string-equal file nospecial-file))
- (should-not (equal (file-name-all-completions
- nospecial-file nospecial-tempdir)
- (file-name-all-completions file tmpdir)))
+ (should (equal (file-name-all-completions nospecial-file nospecial-tempdir)
+ (file-name-all-completions file tmpdir)))
(should (equal (file-name-all-completions file nospecial-tempdir)
(file-name-all-completions file tmpdir)))
(should (equal (file-name-all-completions nospecial-file tmpdir)
@@ -736,8 +776,8 @@ unquoted file names."
(file (file-name-nondirectory tmpfile))
(nospecial-file (file-name-nondirectory nospecial)))
(should-not (string-equal file nospecial-file))
- (should-not (equal (file-name-completion nospecial-file nospecial-tempdir)
- (file-name-completion file tmpdir)))
+ (should (equal (file-name-completion nospecial-file nospecial-tempdir)
+ (file-name-completion file tmpdir)))
(should (equal (file-name-completion file nospecial-tempdir)
(file-name-completion file tmpdir)))
(should (equal (file-name-completion nospecial-file tmpdir)
@@ -857,10 +897,15 @@ unquoted file names."
(find-backup-file-name tmpfile)))))))
(ert-deftest files-tests-file-name-non-special-get-file-buffer ()
+ ;; Make sure these buffers don't exist.
(files-tests--with-temp-non-special (tmpfile nospecial)
- (should-not (get-file-buffer nospecial)))
+ (let ((fbuf (get-file-buffer nospecial)))
+ (if fbuf (kill-buffer fbuf))
+ (should-not (get-file-buffer nospecial))))
(files-tests--with-temp-non-special-and-file-name-handler (tmpfile nospecial)
- (should-not (get-file-buffer nospecial))))
+ (let ((fbuf (get-file-buffer nospecial)))
+ (if fbuf (kill-buffer fbuf))
+ (should-not (get-file-buffer nospecial)))))
(ert-deftest files-tests-file-name-non-special-insert-directory ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t)
@@ -906,6 +951,55 @@ unquoted file names."
(make-auto-save-file-name)
(kill-buffer)))))))
+(ert-deftest files-test-auto-save-name-default ()
+ (with-temp-buffer
+ (let ((auto-save-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (setq buffer-file-name "/tmp/foo.txt")
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/tmp/#foo.txt#")))))
+
+(ert-deftest files-test-auto-save-name-transform ()
+ (with-temp-buffer
+ (setq buffer-file-name "/tmp/foo.txt")
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#foo.txt#")))))
+
+(ert-deftest files-test-auto-save-name-unique ()
+ (with-temp-buffer
+ (setq buffer-file-name "/tmp/foo.txt")
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#!tmp!foo.txt#")))
+ (let ((auto-save-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
+
+(ert-deftest files-test-lock-name-default ()
+ (let ((lock-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/tmp/.#foo.txt"))))
+
+(ert-deftest files-test-lock-name-unique ()
+ (let ((lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/var/tmp/.#!tmp!foo.txt")))
+ (let ((lock-file-name-transforms
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
+
(ert-deftest files-tests-file-name-non-special-make-directory ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t)
(let ((default-directory nospecial-dir))
@@ -1363,8 +1457,13 @@ See <https://debbugs.gnu.org/36401>."
(should (not (eq major-mode 'text-mode))))))
(ert-deftest files-colon-path ()
- (should (equal (parse-colon-path "/foo//bar/baz")
- '("/foo/bar/baz/"))))
+ (if (memq system-type '(windows-nt ms-dos))
+ (should (equal (parse-colon-path "x:/foo//bar/baz")
+ '("x:/foo//bar/baz/")))
+ (should (equal (parse-colon-path "/foo//bar/baz")
+ '("/foo//bar/baz/"))))
+ (should (equal (parse-colon-path (concat "." path-separator "/tmp"))
+ '("./" "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
@@ -1432,5 +1531,34 @@ The door of all subtleties!
(buffer-substring (point-min) (point-max))
nil nil)))))
+(ert-deftest files-tests-file-name-with-extension-good ()
+ "Test that `file-name-with-extension' succeeds with reasonable input."
+ (should (string= (file-name-with-extension "Jack" "css") "Jack.css"))
+ (should (string= (file-name-with-extension "Jack" ".css") "Jack.css"))
+ (should (string= (file-name-with-extension "Jack.scss" "css") "Jack.css"))
+ (should (string= (file-name-with-extension "/path/to/Jack.md" "org") "/path/to/Jack.org")))
+
+(ert-deftest files-tests-file-name-with-extension-bad ()
+ "Test that `file-name-with-extension' fails on malformed input."
+ (should-error (file-name-with-extension nil nil))
+ (should-error (file-name-with-extension "Jack" nil))
+ (should-error (file-name-with-extension nil "css"))
+ (should-error (file-name-with-extension "" ""))
+ (should-error (file-name-with-extension "" "css"))
+ (should-error (file-name-with-extension "Jack" ""))
+ (should-error (file-name-with-extension "Jack" "."))
+ (should-error (file-name-with-extension "/is/a/directory/" "css")))
+
+(ert-deftest files-test-dir-locals-auto-mode-alist ()
+ "Test an `auto-mode-alist' entry in `.dir-locals.el'"
+ (find-file (ert-resource-file "whatever.quux"))
+ (should (eq major-mode 'tcl-mode))
+ (find-file (ert-resource-file "auto-test.zot1"))
+ (should (eq major-mode 'fundamental-mode))
+ (find-file (ert-resource-file "auto-test.zot2"))
+ (should (eq major-mode 'fundamental-mode))
+ (find-file (ert-resource-file "auto-test.zot3"))
+ (should (eq major-mode 'fundamental-mode)))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/gnus/gnus-search-tests.el b/test/lisp/gnus/gnus-search-tests.el
index 63469f8d518..6148da65621 100644
--- a/test/lisp/gnus/gnus-search-tests.el
+++ b/test/lisp/gnus/gnus-search-tests.el
@@ -5,18 +5,20 @@
;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
;; Keywords:
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -47,7 +49,9 @@
(default-value 'gnus-search-expandable-keys))
(pairs
'(("su" . "subject")
- ("sin" . "since"))))
+ ("sin" . "since")
+ ("body" . "body")
+ ("list-id" . "list-id"))))
(dolist (p pairs)
(should (equal (gnus-search-query-expand-key (car p))
(cdr p))))
diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el
index 7f64b96303f..f8d30f6373e 100644
--- a/test/lisp/gnus/gnus-util-tests.el
+++ b/test/lisp/gnus/gnus-util-tests.el
@@ -3,12 +3,12 @@
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -132,41 +132,4 @@
(should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2))))
(should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2)))))
-(ert-deftest gnus-base64-repad ()
- (should-error (gnus-base64-repad 1)
- :type 'wrong-type-argument)
-
- ;; RFC4648 test vectors
- (should (equal "" (gnus-base64-repad "")))
- (should (equal "Zg==" (gnus-base64-repad "Zg==")))
- (should (equal "Zm8=" (gnus-base64-repad "Zm8=")))
- (should (equal "Zm9v" (gnus-base64-repad "Zm9v")))
- (should (equal "Zm9vYg==" (gnus-base64-repad "Zm9vYg==")))
- (should (equal "Zm9vYmE=" (gnus-base64-repad "Zm9vYmE=")))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy")))
-
- (should (equal "Zm8=" (gnus-base64-repad "Zm8")))
- (should (equal "Zg==" (gnus-base64-repad "Zg")))
- (should (equal "Zg==" (gnus-base64-repad "Zg====")))
-
- (should-error (gnus-base64-repad " ")
- :type 'error)
- (should-error (gnus-base64-repad "Zg== ")
- :type 'error)
- (should-error (gnus-base64-repad "Z?\x00g==")
- :type 'error)
- ;; line-length
- (should-error (gnus-base64-repad "Zg====" nil 4)
- :type 'error)
- ;; reject-newlines
- (should-error (gnus-base64-repad "Zm9v\r\nYmFy" t)
- :type 'error)
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9vYmFy" t)))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy")))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\nYmFy\n")))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v\r\n YmFy\r\n")))
- (should (equal "Zm9vYmFy" (gnus-base64-repad "Zm9v \r\n\tYmFy")))
- (should-error (gnus-base64-repad "Zm9v\r\nYmFy" nil 3)
- :type 'error))
-
;;; gnustest-gnus-util.el ends here
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el
index 8650053b682..b4f2b7f675d 100644
--- a/test/lisp/gnus/message-tests.el
+++ b/test/lisp/gnus/message-tests.el
@@ -1,4 +1,4 @@
-;;; message-mode-tests.el --- Tests for message-mode -*- lexical-binding: t; -*-
+;;; message-tests.el --- Tests for message-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
@@ -154,6 +154,35 @@
"\"larsi@gnus.org\" <larsi@gnus.org>")
"larsi@gnus.org")))
+(ert-deftest message-replace-header ()
+ (with-temp-buffer
+ (save-excursion
+ (insert "From: dang@gnus.org
+To: user1,
+ user2
+Cc: user3,
+ user4
+--text follows this line--
+Hello.
+"))
+ (save-excursion
+ (message-replace-header "From" "ding@gnus.org")
+ (should (cl-search "ding" (message-field-value "From"))))
+ (save-excursion
+ (message-replace-header "From" "dong@gnus.org" "To")
+ (should (cl-search "dong" (message-field-value "From")))
+ (should (re-search-forward "From:"))
+ (should-error (re-search-forward "To:"))
+ (should (re-search-forward "Cc:")))
+ (save-excursion
+ (message-replace-header "From" "dang@gnus.org" (split-string "To Cc"))
+ (should (cl-search "dang" (message-field-value "From")))
+ (should (re-search-forward "From:"))
+ (should-error (re-search-forward "To:"))
+ ;; That this isn't so is probably a bug from 1997.
+ ;; (should-error (re-search-forward "Cc:"))
+ )))
+
(provide 'message-mode-tests)
;;; message-mode-tests.el ends here
diff --git a/test/lisp/gnus/mm-decode-tests.el b/test/lisp/gnus/mm-decode-tests.el
index 7d059cb3f87..586097aaf31 100644
--- a/test/lisp/gnus/mm-decode-tests.el
+++ b/test/lisp/gnus/mm-decode-tests.el
@@ -4,10 +4,10 @@
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el
index b743187030f..a7ed7d3975b 100644
--- a/test/lisp/gnus/mml-sec-tests.el
+++ b/test/lisp/gnus/mml-sec-tests.el
@@ -1,14 +1,15 @@
;;; mml-sec-tests.el --- Tests mml-sec.el, see README-mml-secure.txt. -*- lexical-binding:t -*-
+
;; Copyright (C) 2015, 2020-2021 Free Software Foundation, Inc.
;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org>
-;; This file is not part of GNU Emacs.
+;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
diff --git a/test/lisp/gnus/nnrss-tests.el b/test/lisp/gnus/nnrss-tests.el
index 9821ec76fb4..92b7dacf180 100644
--- a/test/lisp/gnus/nnrss-tests.el
+++ b/test/lisp/gnus/nnrss-tests.el
@@ -26,4 +26,20 @@
(should (equal (nnrss-normalize-date "2004-09-17T05:09:49.001+00:00")
"Fri, 17 Sep 2004 05:09:49 +0000")))
+(defconst test-nnrss-xml
+ '((rss
+ ((version . "2.0")
+ (xmlns:dc . "http://purl.org/dc/elements/1.1/"))
+ (channel
+ ((xmlns:content . "http://purl.org/rss/1.0/modules/content/"))))))
+
+(ert-deftest test-nnrss-namespace-top ()
+ (should (equal (nnrss-get-namespace-prefix
+ test-nnrss-xml "http://purl.org/dc/elements/1.1/")
+ "dc:")))
+(ert-deftest test-nnrss-namespace-inner ()
+ (should (equal (nnrss-get-namespace-prefix
+ test-nnrss-xml "http://purl.org/rss/1.0/modules/content/")
+ "content:")))
+
;;; nnrss-tests.el ends here
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 80d90daaf91..513a0c2daea 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -62,7 +62,9 @@ Return first line of the output of (describe-function-1 FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defun ()
- (let ((regexp "a compiled Lisp function in .+subr\\.el")
+ (let ((regexp (if (featurep 'native-compile)
+ "a native compiled Lisp function in .+subr\\.el"
+ "a compiled Lisp function in .+subr\\.el"))
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))))
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 8034764741c..871417da3d2 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -26,6 +26,7 @@
(require 'ert)
(eval-when-compile (require 'cl-lib))
+(require 'text-property-search) ; for `text-property-search-forward'
(ert-deftest help-split-fundoc-SECTION ()
"Test new optional arg SECTION."
@@ -60,9 +61,8 @@
(defmacro with-substitute-command-keys-test (&rest body)
`(cl-flet* ((test
(lambda (orig result)
- (should (equal-including-properties
- (substitute-command-keys orig)
- result))))
+ (should (equal (substitute-command-keys orig)
+ result))))
(test-re
(lambda (orig regexp)
(should (string-match (concat "^" regexp "$")
@@ -110,14 +110,19 @@ C-<tab> file-cache-minibuffer-complete
<prior> switch-to-completions
<up> previous-line-or-history-element
+M-g Prefix Command
M-v switch-to-completions
+M-g ESC Prefix Command
+
M-< minibuffer-beginning-of-buffer
M-n next-history-element
M-p previous-history-element
M-r previous-matching-history-element
M-s next-matching-history-element
+M-g M-c switch-to-completions
+
")))
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
@@ -222,6 +227,24 @@ M-s next-matching-history-element
(define-minor-mode help-tests-minor-mode
"Minor mode for testing shadowing.")
+(ert-deftest help-tests-substitute-command-keys/add-key-face ()
+ (should (equal (substitute-command-keys "\\[next-line]")
+ (propertize "C-n"
+ 'face 'help-key-binding
+ 'font-lock-face 'help-key-binding))))
+
+(ert-deftest help-tests-substitute-command-keys/add-key-face-listing ()
+ (with-temp-buffer
+ (insert (substitute-command-keys "\\{help-tests-minor-mode-map}"))
+ (goto-char (point-min))
+ (text-property-search-forward 'face 'help-key-binding)
+ (should (looking-at "C-e"))
+ ;; Don't fontify trailing whitespace.
+ (should-not (get-text-property (+ (point) 3) 'face))
+ (text-property-search-forward 'face 'help-key-binding)
+ (should (looking-at "x"))
+ (should-not (get-text-property (+ (point) 1) 'face))))
+
(ert-deftest help-tests-substitute-command-keys/test-mode ()
(with-substitute-command-keys-test
(with-temp-buffer
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index ab7585ca050..aa8600609c4 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -25,7 +25,7 @@
(require 'cl-lib))
(defconst image-tests--emacs-images-directory
- (expand-file-name "../etc/images" (getenv "EMACS_TEST_DIRECTORY"))
+ (expand-file-name "images" data-directory)
"Directory containing Emacs images.")
(ert-deftest image--set-property ()
@@ -48,6 +48,20 @@
(setf (image-property image :width) nil)
(should (equal image '(image)))))
+(ert-deftest image-find-image ()
+ (find-image '((:type xpm :file "undo.xpm")))
+ (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center))))
+
+(ert-deftest image-type-from-file-name ()
+ (should (eq (image-type-from-file-name "foo.jpg") 'jpeg))
+ (should (eq (image-type-from-file-name "foo.png") 'png)))
+
+(ert-deftest image-type/from-filename ()
+ ;; On emba, `image-types' and `image-load-path' do not exist.
+ (skip-unless (and (bound-and-true-p image-types)
+ (bound-and-true-p image-load-path)))
+ (should (eq (image-type "foo.jpg") 'jpeg)))
+
(ert-deftest image-type-from-file-header-test ()
"Test image-type-from-file-header."
(should (eq (if (image-type-available-p 'svg) 'svg)
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 95af21fb591..ecba86146f1 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -1,4 +1,4 @@
-;;; info-xref.el --- tests for info-xref.el -*- lexical-binding:t -*-
+;;; info-xref-tests.el --- tests for info-xref.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/international/mule-util-resources/utf-8.txt b/test/lisp/international/mule-util-resources/utf-8.txt
new file mode 100644
index 00000000000..385bbb4ba80
--- /dev/null
+++ b/test/lisp/international/mule-util-resources/utf-8.txt
@@ -0,0 +1,2 @@
+Thís is a test line 1.
+Line 2.
diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el
index 6518be66dbe..0fcff9d02dd 100644
--- a/test/lisp/international/mule-util-tests.el
+++ b/test/lisp/international/mule-util-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'mule-util)
(defconst mule-util-test-truncate-data
@@ -82,4 +83,43 @@
(dotimes (i (length mule-util-test-truncate-data))
(mule-util-test-truncate-create i))
+(ert-deftest filepos/bufferpos-tests-utf-8 ()
+ (let ((coding-system-for-read 'utf-8-unix))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "utf-8.txt"))
+ (should (eq buffer-file-coding-system 'utf-8-unix))
+ ;; First line is "Thís is a test line 1.".
+ ;; Bytes start counting at 0; chars at 1.
+ (should (= (filepos-to-bufferpos 1 'exact) 2))
+ (should (= (bufferpos-to-filepos 2 'exact) 1))
+ ;; After non-ASCII.
+ (should (= (filepos-to-bufferpos 4 'exact) 4))
+ (should (= (bufferpos-to-filepos 4 'exact) 4)))))
+
+(ert-deftest filepos/bufferpos-tests-binary ()
+ (let ((coding-system-for-read 'binary))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "utf-8.txt"))
+ (should (eq buffer-file-coding-system 'no-conversion))
+ ;; First line is "Thís is a test line 1.".
+ ;; Bytes start counting at 0; chars at 1.
+ (should (= (filepos-to-bufferpos 1 'exact) 2))
+ (should (= (bufferpos-to-filepos 2 'exact) 1))
+ ;; After non-ASCII.
+ (should (= (filepos-to-bufferpos 4 'exact) 5))
+ (should (= (bufferpos-to-filepos 5 'exact) 4)))))
+
+(ert-deftest filepos/bufferpos-tests-undecided ()
+ (let ((coding-system-for-read 'binary))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "utf-8.txt"))
+ (setq buffer-file-coding-system 'undecided)
+ (should-error (filepos-to-bufferpos 1 'exact))
+ (should-error (bufferpos-to-filepos 2 'exact))
+ (should (= (filepos-to-bufferpos 1 'approximate) 2))
+ (should (= (bufferpos-to-filepos 2 'approximate) 1))
+ ;; After non-ASCII.
+ (should (= (filepos-to-bufferpos 4 'approximate) 5))
+ (should (= (bufferpos-to-filepos 5 'approximate) 4)))))
+
;;; mule-util-tests.el ends here
diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el
index a2da73767bc..51f4ed3a80e 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -1,4 +1,4 @@
-;;; ucs-normalize --- tests for international/ucs-normalize.el -*- lexical-binding: t -*-
+;;; ucs-normalize-tests.el --- tests for international/ucs-normalize.el -*- lexical-binding: t -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 11b61d8b47e..f400fb064a6 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -329,13 +329,13 @@ Point is moved to beginning of the buffer."
(should (equal (read str) res)))))))
(ert-deftest test-json-encode-number ()
- (should (equal (json-encode-number 0) "0"))
- (should (equal (json-encode-number -0) "0"))
- (should (equal (json-encode-number 3) "3"))
- (should (equal (json-encode-number -5) "-5"))
- (should (equal (json-encode-number 123.456) "123.456"))
+ (should (equal (json-encode 0) "0"))
+ (should (equal (json-encode -0) "0"))
+ (should (equal (json-encode 3) "3"))
+ (should (equal (json-encode -5) "-5"))
+ (should (equal (json-encode 123.456) "123.456"))
(let ((bignum (1+ most-positive-fixnum)))
- (should (equal (json-encode-number bignum)
+ (should (equal (json-encode bignum)
(number-to-string bignum)))))
;;; Strings
@@ -404,6 +404,8 @@ Point is moved to beginning of the buffer."
(should (equal (json-read-string) "abcαβγ")))
(json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\""
(should (equal (json-read-string) "\nasdфывfgh\t")))
+ (json-tests--with-temp-buffer "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\""
+ (should (equal (json-read-string) "abc\uFFFFαβγ𝔸𝐁𝖢\"\\")))
;; Bug#24784
(json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
(should (equal (json-read-string) "\U0001D11E")))
@@ -418,21 +420,37 @@ Point is moved to beginning of the buffer."
(should (equal (json-encode-string "foo") "\"foo\""))
(should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\""))
(should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
- "\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
+ "\"\\nasdфыв\\u001f\u007ffgh\\t\""))
+ ;; Bug#43549.
+ (should (equal (json-encode-string (propertize "foo" 'read-only t))
+ "\"foo\""))
+ (should (equal (json-encode-string "a\0b") "\"a\\u0000b\""))
+ (should (equal (json-encode-string "abc\uFFFFαβγ𝔸𝐁𝖢\"\\")
+ "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"")))
(ert-deftest test-json-encode-key ()
- (should (equal (json-encode-key "") "\"\""))
- (should (equal (json-encode-key '##) "\"\""))
- (should (equal (json-encode-key :) "\"\""))
- (should (equal (json-encode-key "foo") "\"foo\""))
- (should (equal (json-encode-key 'foo) "\"foo\""))
- (should (equal (json-encode-key :foo) "\"foo\""))
- (should (equal (should-error (json-encode-key 5))
- '(json-key-format 5)))
- (should (equal (should-error (json-encode-key ["foo"]))
- '(json-key-format ["foo"])))
- (should (equal (should-error (json-encode-key '("foo")))
- '(json-key-format ("foo")))))
+ (with-suppressed-warnings ((obsolete json-encode-key))
+ (should (equal (json-encode-key '##) "\"\""))
+ (should (equal (json-encode-key :) "\"\""))
+ (should (equal (json-encode-key "") "\"\""))
+ (should (equal (json-encode-key 'a) "\"a\""))
+ (should (equal (json-encode-key :a) "\"a\""))
+ (should (equal (json-encode-key "a") "\"a\""))
+ (should (equal (json-encode-key t) "\"t\""))
+ (should (equal (json-encode-key :t) "\"t\""))
+ (should (equal (json-encode-key "t") "\"t\""))
+ (should (equal (json-encode-key nil) "\"nil\""))
+ (should (equal (json-encode-key :nil) "\"nil\""))
+ (should (equal (json-encode-key "nil") "\"nil\""))
+ (should (equal (json-encode-key ":a") "\":a\""))
+ (should (equal (json-encode-key ":t") "\":t\""))
+ (should (equal (json-encode-key ":nil") "\":nil\""))
+ (should (equal (should-error (json-encode-key 5))
+ '(json-key-format 5)))
+ (should (equal (should-error (json-encode-key ["foo"]))
+ '(json-key-format ["foo"])))
+ (should (equal (should-error (json-encode-key '("foo")))
+ '(json-key-format ("foo"))))))
;;; Objects
@@ -569,12 +587,32 @@ Point is moved to beginning of the buffer."
(ert-deftest test-json-encode-hash-table ()
(let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
- (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
+ (should (equal (json-encode #s(hash-table)) "{}"))
+ (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}"))
+ (should (equal (json-encode #s(hash-table data (t 1))) "{\"t\":1}"))
+ (should (equal (json-encode #s(hash-table data (nil 1))) "{\"nil\":1}"))
+ (should (equal (json-encode #s(hash-table data (:a 1))) "{\"a\":1}"))
+ (should (equal (json-encode #s(hash-table data (:t 1))) "{\"t\":1}"))
+ (should (equal (json-encode #s(hash-table data (:nil 1))) "{\"nil\":1}"))
+ (should (equal (json-encode #s(hash-table test equal data ("a" 1)))
"{\"a\":1}"))
- (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+ (should (equal (json-encode #s(hash-table test equal data ("t" 1)))
+ "{\"t\":1}"))
+ (should (equal (json-encode #s(hash-table test equal data ("nil" 1)))
+ "{\"nil\":1}"))
+ (should (equal (json-encode #s(hash-table test equal data (":a" 1)))
+ "{\":a\":1}"))
+ (should (equal (json-encode #s(hash-table test equal data (":t" 1)))
+ "{\":t\":1}"))
+ (should (equal (json-encode #s(hash-table test equal data (":nil" 1)))
+ "{\":nil\":1}"))
+ (should (member (json-encode #s(hash-table data (t 2 :nil 1)))
+ '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}")))
+ (should (member (json-encode #s(hash-table test equal data (:t 2 ":t" 1)))
+ '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}")))
+ (should (member (json-encode #s(hash-table data (b 2 a 1)))
'("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}")))
- (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+ (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
'("{\"a\":1,\"b\":2,\"c\":3}"
"{\"a\":1,\"c\":3,\"b\":2}"
"{\"b\":2,\"a\":1,\"c\":3}"
@@ -587,13 +625,12 @@ Point is moved to beginning of the buffer."
(json-encoding-pretty-print t)
(json-encoding-default-indentation " ")
(json-encoding-lisp-style-closings nil))
- (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
- (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
- "{\n \"a\": 1\n}"))
- (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+ (should (equal (json-encode #s(hash-table)) "{}"))
+ (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1\n}"))
+ (should (member (json-encode #s(hash-table data (b 2 a 1)))
'("{\n \"a\": 1,\n \"b\": 2\n}"
"{\n \"b\": 2,\n \"a\": 1\n}")))
- (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+ (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
'("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}"
"{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}"
"{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}"
@@ -606,13 +643,12 @@ Point is moved to beginning of the buffer."
(json-encoding-pretty-print t)
(json-encoding-default-indentation " ")
(json-encoding-lisp-style-closings t))
- (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
- (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
- "{\n \"a\": 1}"))
- (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+ (should (equal (json-encode #s(hash-table)) "{}"))
+ (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1}"))
+ (should (member (json-encode #s(hash-table data (b 2 a 1)))
'("{\n \"a\": 1,\n \"b\": 2}"
"{\n \"b\": 2,\n \"a\": 1}")))
- (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+ (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
'("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}"
"{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}"
"{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}"
@@ -630,7 +666,7 @@ Point is moved to beginning of the buffer."
(#s(hash-table data (c 3 b 2 a 1))
. "{\"a\":1,\"b\":2,\"c\":3}")))
(let ((copy (map-pairs in)))
- (should (equal (json-encode-hash-table in) out))
+ (should (equal (json-encode in) out))
;; Ensure sorting isn't destructive.
(should (seq-set-equal-p (map-pairs in) copy))))))
@@ -638,7 +674,16 @@ Point is moved to beginning of the buffer."
(let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
(should (equal (json-encode-alist ()) "{}"))
- (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode-alist '((a . 1) (t . 2) (nil . 3)))
+ "{\"a\":1,\"t\":2,\"nil\":3}"))
+ (should (equal (json-encode-alist '((:a . 1) (:t . 2) (:nil . 3)))
+ "{\"a\":1,\"t\":2,\"nil\":3}"))
+ (should (equal (json-encode-alist '(("a" . 1) ("t" . 2) ("nil" . 3)))
+ "{\"a\":1,\"t\":2,\"nil\":3}"))
+ (should (equal (json-encode-alist '((":a" . 1) (":t" . 2) (":nil" . 3)))
+ "{\":a\":1,\":t\":2,\":nil\":3}"))
+ (should (equal (json-encode-alist '((t . 1) (:nil . 2) (":nil" . 3)))
+ "{\"t\":1,\"nil\":2,\":nil\":3}"))
(should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
(should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
"{\"c\":3,\"b\":2,\"a\":1}"))))
@@ -687,8 +732,14 @@ Point is moved to beginning of the buffer."
(should (equal (json-encode-plist ()) "{}"))
(should (equal (json-encode-plist '(:a 1)) "{\"a\":1}"))
(should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
- (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
- "{\"c\":3,\"b\":2,\"a\":1}"))))
+ (should (equal (json-encode-plist '(":d" 4 "c" 3 b 2 :a 1))
+ "{\":d\":4,\"c\":3,\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-plist '(nil 2 t 1))
+ "{\"nil\":2,\"t\":1}"))
+ (should (equal (json-encode-plist '(:nil 2 :t 1))
+ "{\"nil\":2,\"t\":1}"))
+ (should (equal (json-encode-plist '(":nil" 4 "nil" 3 ":t" 2 "t" 1))
+ "{\":nil\":4,\"nil\":3,\":t\":2,\"t\":1}"))))
(ert-deftest test-json-encode-plist-pretty ()
(let ((json-encoding-object-sort-predicate nil)
@@ -728,38 +779,42 @@ Point is moved to beginning of the buffer."
(should (equal in copy))))))
(ert-deftest test-json-encode-list ()
+ "Test `json-encode-list' or its more moral equivalents."
(let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode-list ()) "{}"))
- (should (equal (json-encode-list '(a)) "[\"a\"]"))
- (should (equal (json-encode-list '(:a)) "[\"a\"]"))
- (should (equal (json-encode-list '("a")) "[\"a\"]"))
- (should (equal (json-encode-list '(a 1)) "[\"a\",1]"))
- (should (equal (json-encode-list '("a" 1)) "[\"a\",1]"))
- (should (equal (json-encode-list '(:a 1)) "{\"a\":1}"))
- (should (equal (json-encode-list '((a . 1))) "{\"a\":1}"))
- (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}"))
- (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]"))
- (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]"))
- (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
- (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
- (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
- (should (equal (json-encode-list '((:b . 2) (:a . 1)))
+ ;; Trick `json-encode' into using `json--print-list'.
+ (let ((json-null (list nil)))
+ (should (equal (json-encode ()) "{}")))
+ (should (equal (json-encode '(a)) "[\"a\"]"))
+ (should (equal (json-encode '(:a)) "[\"a\"]"))
+ (should (equal (json-encode '("a")) "[\"a\"]"))
+ (should (equal (json-encode '(a 1)) "[\"a\",1]"))
+ (should (equal (json-encode '("a" 1)) "[\"a\",1]"))
+ (should (equal (json-encode '(:a 1)) "{\"a\":1}"))
+ (should (equal (json-encode '((a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode '((:a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode '(:b 2 :a)) "[\"b\",2,\"a\"]"))
+ (should (equal (json-encode '(4 3 2 1)) "[4,3,2,1]"))
+ (should (equal (json-encode '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
+ (should (equal (json-encode '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode '((:b . 2) (:a . 1)))
"{\"b\":2,\"a\":1}"))
- (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]"))
- (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]"))
- (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]"))
- (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]"))
- (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]"))
- (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]"))
- (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
- (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
- (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument)
- (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument)
- (should (equal (should-error (json-encode-list []))
- '(json-error [])))
- (should (equal (should-error (json-encode-list [a]))
- '(json-error [a])))))
+ (should (equal (json-encode '((a) 1)) "[[\"a\"],1]"))
+ (should (equal (json-encode '((:a) 1)) "[[\"a\"],1]"))
+ (should (equal (json-encode '(("a") 1)) "[[\"a\"],1]"))
+ (should (equal (json-encode '((a 1) 2)) "[[\"a\",1],2]"))
+ (should (equal (json-encode '((:a 1) 2)) "[{\"a\":1},2]"))
+ (should (equal (json-encode '(((a . 1)) 2)) "[{\"a\":1},2]"))
+ (should (equal (json-encode '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
+ (should (equal (json-encode '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
+ (should-error (json-encode '(a . 1)) :type 'wrong-type-argument)
+ (should-error (json-encode '((a . 1) 2)) :type 'wrong-type-argument)
+ (with-suppressed-warnings ((obsolete json-encode-list))
+ (should (equal (should-error (json-encode-list []))
+ '(json-error [])))
+ (should (equal (should-error (json-encode-list [a]))
+ '(json-error [a]))))))
;;; Arrays
@@ -950,7 +1005,13 @@ nil, ORIGINAL should stay unchanged by pretty-printing."
;; Nested array.
(json-tests-equal-pretty-print
"{\"key\":[1,2]}"
- "{\n \"key\": [\n 1,\n 2\n ]\n}"))
+ "{\n \"key\": [\n 1,\n 2\n ]\n}")
+ ;; Confusable keys (bug#24252, bug#42545).
+ (json-tests-equal-pretty-print
+ (concat "{\"t\":1,\"nil\":2,\":t\":3,\":nil\":4,"
+ "\"null\":5,\":json-null\":6,\":json-false\":7}")
+ (concat "{\n \"t\": 1,\n \"nil\": 2,\n \":t\": 3,\n \":nil\": 4,"
+ "\n \"null\": 5,\n \":json-null\": 6,\n \":json-false\": 7\n}")))
(ert-deftest test-json-pretty-print-array ()
;; Empty.
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index ea340c370d1..92306d1c7e5 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -244,7 +244,7 @@
:timeout 1)
;; Wait another 0.5 secs just in case the success handlers of
;; one of these last two requests didn't quite have a chance to
- ;; run (Emacs 25.2 apparentely needs this).
+ ;; run (Emacs 25.2 apparently needs this).
(accept-process-output nil 0.5)
(should second-deferred-went-through-p)
(should (eq 1 n-deferred-1))
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
index c8910720763..8736f7fd2dc 100644
--- a/test/lisp/kmacro-tests.el
+++ b/test/lisp/kmacro-tests.el
@@ -519,7 +519,7 @@ This is a regression test for: Bug#3412, Bug#11817."
(should (eq saved-binding (key-binding "\C-a")))))
(kmacro-tests-deftest kmacro-tests-name-or-bind-to-key-when-no-macro ()
- "Bind to key, symbol or register fails when when no macro exists."
+ "Bind to key, symbol or register fails when no macro exists."
(should-error (kmacro-bind-to-key nil))
(should-error (kmacro-name-last-macro 'kmacro-tests-symbol-for-test))
(should-error (kmacro-to-register)))
diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el
new file mode 100644
index 00000000000..b29796da42d
--- /dev/null
+++ b/test/lisp/loadhist-tests.el
@@ -0,0 +1,57 @@
+;;; loadhist-tests.el --- Tests for loadhist.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'loadhist)
+
+(ert-deftest loadhist-tests-feature-symbols ()
+ (should (equal (file-name-base (car (feature-symbols 'loadhist))) "loadhist"))
+ (should-not (feature-symbols 'non-existent-feature)))
+
+(ert-deftest loadhist-tests-feature-file ()
+ (should (equal (file-name-base (feature-file 'loadhist)) "loadhist"))
+ (should-error (feature-file 'non-existent-feature)))
+
+(ert-deftest loadhist-tests-file-loadhist-lookup ()
+ ;; This should probably be extended...
+ (should (listp (file-loadhist-lookup "loadhist"))))
+
+(ert-deftest loadhist-tests-file-provides ()
+ (should (eq (car (file-provides "loadhist")) 'loadhist)))
+
+(ert-deftest loadhist-tests-file-requires ()
+ (should-not (file-requires "loadhist")))
+
+(ert-deftest loadhist-tests-file-dependents ()
+ (require 'dired-x)
+ (let ((deps (file-dependents "dired")))
+ (should (member "dired-x" (mapcar #'file-name-base deps)))))
+
+(ert-deftest loadhist-tests-unload-feature ()
+ (require 'dired-x)
+ (should-error (unload-feature 'dired))
+ (unload-feature 'dired-x))
+
+;;; loadhist-tests.el ends here
diff --git a/test/lisp/lpr-tests.el b/test/lisp/lpr-tests.el
new file mode 100644
index 00000000000..bc31982a11d
--- /dev/null
+++ b/test/lisp/lpr-tests.el
@@ -0,0 +1,41 @@
+;;; lpr-tests.el --- Tests for lpr.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'lpr)
+
+(ert-deftest lpr-test-printify-region ()
+ (with-temp-buffer
+ (insert "foo\^@-\^h\^k\^n-\^_\177bar")
+ (printify-region (point-min) (point-max))
+ (should (equal (buffer-string) "foo\\^@-\\^H\\^K\\^N-\\^_\\7fbar"))))
+
+(ert-deftest lpr-test-lpr-eval-switch ()
+ (should (equal (lpr-eval-switch "foo") "foo"))
+ (should (equal (lpr-eval-switch (lambda () "foo")) "foo"))
+ (let ((v "foo"))
+ (should (equal (lpr-eval-switch v) "foo")))
+ (should (equal (lpr-eval-switch (list #'identity "foo")) "foo"))
+ (should (equal (lpr-eval-switch 1) nil)))
+
+;;; lpr-tests.el ends here
diff --git a/test/lisp/mail/mail-parse-tests.el b/test/lisp/mail/mail-parse-tests.el
new file mode 100644
index 00000000000..70de92df45a
--- /dev/null
+++ b/test/lisp/mail/mail-parse-tests.el
@@ -0,0 +1,54 @@
+;;; mail-parse-tests.el --- tests for mail-parse.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'mail-parse)
+(require 'subr-x)
+
+(ert-deftest test-mail-header-parse-address-lax ()
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen <larsi@gnus.org>")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen larsi@gnus.org>")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "Lars Ingebrigtsen larsi@gnus.org")
+ '("larsi@gnus.org" . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax
+ "larsi@gnus.org (Lars Ingebrigtsen)")
+ '("larsi@gnus.org " . "Lars Ingebrigtsen")))
+ (should (equal (mail-header-parse-address-lax "larsi@gnus.org")
+ '("larsi@gnus.org")))
+ (should (equal (mail-header-parse-address-lax "foo")
+ nil)))
+
+(ert-deftest test-mail-header-parse-addresses-lax ()
+ (should (equal (mail-header-parse-addresses-lax
+ "Bob Weiner <rsw@gnu.org>, Mats Lidell <matsl@gnu.org>")
+ '(("rsw@gnu.org" . "Bob Weiner")
+ ("matsl@gnu.org" . "Mats Lidell")))))
+
+(provide 'mail-parse-tests)
+
+;;; mail-parse-tests.el ends here
diff --git a/test/lisp/mail/mail-utils-tests.el b/test/lisp/mail/mail-utils-tests.el
new file mode 100644
index 00000000000..5b54f2440c7
--- /dev/null
+++ b/test/lisp/mail/mail-utils-tests.el
@@ -0,0 +1,104 @@
+;;; mail-utils-tests.el --- tests for mail-utils.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'sasl)
+(require 'mail-utils)
+
+(ert-deftest mail-utils-tests-mail-quote-printable ()
+ (should (equal (mail-quote-printable "abc") "abc"))
+ (should (equal (mail-quote-printable "åäö") "=E5=E4=F6"))
+ (should (equal (mail-quote-printable "åäö" t) "=?ISO-8859-1?Q?=E5=E4=F6?=")))
+
+(ert-deftest mail-utils-tests-mail-quote-printable-region ()
+ (with-temp-buffer
+ (insert "?=\"\"")
+ (mail-quote-printable-region (point-min) (point-max))
+ (should (equal (buffer-string) "=3F=3D=22=22")))
+ (with-temp-buffer
+ (insert "x")
+ (mail-quote-printable-region (point-min) (point-max) t)
+ (should (equal (buffer-string) "=?=?ISO-8859-1?Q?x"))))
+
+(ert-deftest mail-utils-tests-mail-unquote-printable ()
+ (should (equal (mail-unquote-printable "=E5=E4=F6") "åäö"))
+ (should (equal (mail-unquote-printable "=?ISO-8859-1?Q?=E5=E4=F6?=" t) "åäö")))
+
+(ert-deftest mail-utils-tests-mail-unquote-printable-region ()
+ (with-temp-buffer
+ (insert "=E5=E4=F6")
+ (mail-unquote-printable-region (point-min) (point-max))
+ (should (equal (buffer-string) "åäö")))
+ (with-temp-buffer
+ (insert "=?ISO-8859-1?Q?=E5=E4=F6?=")
+ (mail-unquote-printable-region (point-min) (point-max) t)
+ (should (equal (buffer-string) "åäö"))))
+
+(ert-deftest mail-utils-tests-mail-strip-quoted-names ()
+ (should (equal (mail-strip-quoted-names
+ "\"foo\" <foo@example.org>, bar@example.org")
+ "foo@example.org, bar@example.org")))
+
+(ert-deftest mail-utils-tests-mail-dont-reply-to ()
+ (let ((mail-dont-reply-to-names "foo@example.org"))
+ (should (equal (mail-dont-reply-to "foo@example.org, bar@example.org")
+ "bar@example.org"))))
+
+
+(ert-deftest mail-utils-tests-mail-fetch-field ()
+ (with-temp-buffer
+ (insert "Foo: bar\nBaz: zut")
+ (should (equal (mail-fetch-field "Foo") "bar"))))
+
+(ert-deftest mail-utils-tests-mail-parse-comma-list ()
+ (with-temp-buffer
+ (insert "foo@example.org,bar@example.org,baz@example.org")
+ (goto-char (point-min))
+ (should (equal (mail-parse-comma-list)
+ '("baz@example.org" "bar@example.org" "foo@example.org")))))
+
+(ert-deftest mail-utils-tests-mail-comma-list-regexp ()
+ (should (equal (mail-comma-list-regexp
+ "foo@example.org,bar@example.org,baz@example.org")
+ "foo@example.org\\|bar@example.org\\|baz@example.org")))
+
+(ert-deftest mail-utils-tests-mail-rfc822-time-zone ()
+ (should (stringp (mail-rfc822-time-zone (current-time)))))
+
+(ert-deftest mail-utils-test-mail-rfc822-date/contains-year ()
+ (should (string-match (rx " 20" digit digit " ")
+ (mail-rfc822-date))))
+
+(ert-deftest mail-utils-test-mail-mbox-from ()
+ (with-temp-buffer
+ (insert "Subject: Hello
+From: jrh@example.org
+To: emacs-devel@gnu.org
+Date: Sun, 07 Feb 2021 22:46:37 -0500")
+ (should (equal (mail-mbox-from)
+ "From jrh@example.org Sun Feb 7 22:46:37 2021\n"))))
+
+(provide 'mail-utils-tests)
+;;; mail-utils-tests.el ends here
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 7349b191caf..c3ba8f9a926 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -83,7 +83,12 @@
(let* ((origtable '("A-hello" "A-there"))
(subvtable (completion-table-subvert origtable "B" "A")))
(should (equal (try-completion "B-hel" subvtable)
- "B-hello"))))
+ "B-hello"))
+ (should (equal (all-completions "B-hel" subvtable) '("-hello")))
+ (should (test-completion "B-hello" subvtable))
+ (should (equal (completion-boundaries "B-hel" subvtable
+ nil "suffix")
+ '(1 . 6)))))
(ert-deftest completion-table-test-quoting ()
(let ((process-environment
@@ -125,5 +130,206 @@
'(("completion1" "prefix1" #("suffix1" 0 7 (face shadow)))))
(should (equal (get-text-property 19 'face) 'shadow))))
+(ert-deftest completion-pcm--optimize-pattern ()
+ (should (equal (completion-pcm--optimize-pattern '("buf" point "f"))
+ '("buf" point "f")))
+ (should (equal (completion-pcm--optimize-pattern '(any "" any))
+ '(any))))
+
+(defun test-completion-all-sorted-completions (base def history-var history-list)
+ (with-temp-buffer
+ (insert base)
+ (cl-letf (((symbol-function #'minibufferp) (lambda (&rest _) t)))
+ (let ((completion-styles '(basic))
+ (completion-category-defaults nil)
+ (completion-category-overrides nil)
+ (minibuffer-history-variable history-var)
+ (minibuffer-history history-list)
+ (minibuffer-default def)
+ (minibuffer-completion-table
+ (lambda (str pred action)
+ (pcase action
+ (`(boundaries . ,_) `(boundaries ,(length base) . 0))
+ (_ (complete-with-action
+ action
+ '("epsilon" "alpha" "gamma" "beta" "delta")
+ (substring str (length base)) pred))))))
+ (completion-all-sorted-completions)))))
+
+(ert-deftest completion-all-sorted-completions ()
+ ;; No base, disabled history, no default
+ (should (equal (test-completion-all-sorted-completions
+ "" nil t nil)
+ `("beta" "alpha" "delta" "gamma" "epsilon" . 0)))
+ ;; No base, disabled history, default string
+ (should (equal (test-completion-all-sorted-completions
+ "" "gamma" t nil)
+ `("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
+ ;; No base, empty history, default string
+ (should (equal (test-completion-all-sorted-completions
+ "" "gamma" 'minibuffer-history nil)
+ `("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
+ ;; No base, empty history, default list
+ (should (equal (test-completion-all-sorted-completions
+ "" '("gamma" "zeta") 'minibuffer-history nil)
+ `("gamma" "beta" "alpha" "delta" "epsilon" . 0)))
+ ;; No base, history, default string
+ (should (equal (test-completion-all-sorted-completions
+ "" "gamma" 'minibuffer-history '("other" "epsilon" "delta"))
+ `("gamma" "epsilon" "delta" "beta" "alpha" . 0)))
+ ;; Base, history, default string
+ (should (equal (test-completion-all-sorted-completions
+ "base/" "base/gamma" 'minibuffer-history
+ '("some/alpha" "base/epsilon" "base/delta"))
+ `("gamma" "epsilon" "delta" "beta" "alpha" . 5)))
+ ;; Base, history, default string
+ (should (equal (test-completion-all-sorted-completions
+ "base/" "gamma" 'minibuffer-history
+ '("some/alpha" "base/epsilon" "base/delta"))
+ `("epsilon" "delta" "beta" "alpha" "gamma" . 5))))
+
+(defun completion--pcm-score (comp)
+ "Get `completion-score' from COMP."
+ (get-text-property 0 'completion-score comp))
+
+(defun completion--pcm-first-difference-pos (comp)
+ "Get `completions-first-difference' from COMP."
+ (cl-loop for pos = (next-single-property-change 0 'face comp)
+ then (next-single-property-change pos 'face comp)
+ while pos
+ when (eq (get-text-property pos 'face comp)
+ 'completions-first-difference)
+ return pos))
+
+(ert-deftest completion-pcm-test-1 ()
+ ;; Point is at end, this does not match anything
+ (should (null
+ (completion-pcm-all-completions
+ "foo" '("hello" "world" "barfoobar") nil 3))))
+
+(ert-deftest completion-pcm-test-2 ()
+ ;; Point is at beginning, this matches "barfoobar"
+ (should (equal
+ (car (completion-pcm-all-completions
+ "foo" '("hello" "world" "barfoobar") nil 0))
+ "barfoobar")))
+
+(ert-deftest completion-pcm-test-3 ()
+ ;; Full match!
+ (should (eql
+ (completion--pcm-score
+ (car (completion-pcm-all-completions
+ "R" '("R" "hello") nil 1)))
+ 1.0)))
+
+(ert-deftest completion-pcm-test-4 ()
+ ;; One fourth of a match and no match due to point being at the end
+ (should (eql
+ (completion--pcm-score
+ (car (completion-pcm-all-completions
+ "RO" '("RaOb") nil 1)))
+ (/ 1.0 4.0)))
+ (should (null
+ (completion-pcm-all-completions
+ "RO" '("RaOb") nil 2))))
+
+(ert-deftest completion-pcm-test-5 ()
+ ;; Since point is at the beginning, there is nothing that can really
+ ;; be typed anymore
+ (should (null
+ (completion--pcm-first-difference-pos
+ (car (completion-pcm-all-completions
+ "f" '("few" "many") nil 0))))))
+
+(ert-deftest completion-pcm-test-6 ()
+ ;; Wildcards and delimiters work
+ (should (equal
+ (car (completion-pcm-all-completions
+ "li-pac*" '("list-packages") nil 7))
+ "list-packages"))
+ (should (null
+ (car (completion-pcm-all-completions
+ "li-pac*" '("do-not-list-packages") nil 7)))))
+
+(ert-deftest completion-substring-test-1 ()
+ ;; One third of a match!
+ (should (equal
+ (car (completion-substring-all-completions
+ "foo" '("hello" "world" "barfoobar") nil 3))
+ "barfoobar"))
+ (should (eql
+ (completion--pcm-score
+ (car (completion-substring-all-completions
+ "foo" '("hello" "world" "barfoobar") nil 3)))
+ (/ 1.0 3.0))))
+
+(ert-deftest completion-substring-test-2 ()
+ ;; Full match!
+ (should (eql
+ (completion--pcm-score
+ (car (completion-substring-all-completions
+ "R" '("R" "hello") nil 1)))
+ 1.0)))
+
+(ert-deftest completion-substring-test-3 ()
+ ;; Substring match
+ (should (equal
+ (car (completion-substring-all-completions
+ "custgroup" '("customize-group") nil 4))
+ "customize-group"))
+ (should (null
+ (car (completion-substring-all-completions
+ "custgroup" '("customize-group") nil 5)))))
+
+(ert-deftest completion-substring-test-4 ()
+ ;; `completions-first-difference' should be at the right place
+ (should (eql
+ (completion--pcm-first-difference-pos
+ (car (completion-substring-all-completions
+ "jab" '("dabjobstabby" "many") nil 1)))
+ 4))
+ (should (null
+ (completion--pcm-first-difference-pos
+ (car (completion-substring-all-completions
+ "jab" '("dabjabstabby" "many") nil 1)))))
+ (should (equal
+ (completion--pcm-first-difference-pos
+ (car (completion-substring-all-completions
+ "jab" '("dabjabstabby" "many") nil 3)))
+ 6)))
+
+(ert-deftest completion-flex-test-1 ()
+ ;; Fuzzy match
+ (should (equal
+ (car (completion-flex-all-completions
+ "foo" '("hello" "world" "fabrobazo") nil 3))
+ "fabrobazo")))
+
+(ert-deftest completion-flex-test-2 ()
+ ;; Full match!
+ (should (eql
+ (completion--pcm-score
+ (car (completion-flex-all-completions
+ "R" '("R" "hello") nil 1)))
+ 1.0)))
+
+(ert-deftest completion-flex-test-3 ()
+ ;; Another fuzzy match, but more of a "substring" one
+ (should (equal
+ (car (completion-flex-all-completions
+ "custgroup" '("customize-group-other-window") nil 4))
+ "customize-group-other-window"))
+ ;; `completions-first-difference' should be at the right place
+ (should (equal
+ (completion--pcm-first-difference-pos
+ (car (completion-flex-all-completions
+ "custgroup" '("customize-group-other-window") nil 4)))
+ 4))
+ (should (equal
+ (completion--pcm-first-difference-pos
+ (car (completion-flex-all-completions
+ "custgroup" '("customize-group-other-window") nil 9)))
+ 15)))
+
(provide 'minibuffer-tests)
;;; minibuffer-tests.el ends here
diff --git a/test/lisp/net/netrc-resources/netrc-folding b/test/lisp/net/netrc-resources/netrc-folding
new file mode 100644
index 00000000000..85e5e324cdf
--- /dev/null
+++ b/test/lisp/net/netrc-resources/netrc-folding
@@ -0,0 +1,6 @@
+# Foo
+machine XM login XL password XP
+
+machine YM
+ login YL
+ password YP
diff --git a/test/lisp/net/netrc-tests.el b/test/lisp/net/netrc-tests.el
index 1328b191494..f75328a59f7 100644
--- a/test/lisp/net/netrc-tests.el
+++ b/test/lisp/net/netrc-tests.el
@@ -48,6 +48,13 @@
(should (equal (netrc-credentials "ftp.example.org")
'("jrh" "*baz*")))))
+(ert-deftest test-netrc-credentials ()
+ (let ((netrc-file (ert-resource-file "netrc-folding")))
+ (should
+ (equal (netrc-parse netrc-file)
+ '((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
+ (("machine" . "YM")) (("login" . "YL")) (("password" . "YP")))))))
+
(provide 'netrc-tests)
;;; netrc-tests.el ends here
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index e0a06a28eec..4a0b23dd26f 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -128,7 +128,7 @@
(when prev
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
- (if (and (not (string-match "\n" string))
+ (if (and (not (string-search "\n" string))
(> (length string) 0))
(process-put proc 'previous-string string))
(let ((command (split-string string)))
@@ -307,6 +307,7 @@
:name "bar"
:buffer (generate-new-buffer "*foo*")
:nowait t
+ :family 'ipv4
:tls-parameters
(cons 'gnutls-x509pki
(gnutls-boot-parameters
diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
index ff453319b37..1a35ec34cb9 100644
--- a/test/lisp/net/nsm-tests.el
+++ b/test/lisp/net/nsm-tests.el
@@ -1,4 +1,4 @@
-;;; network-stream-tests.el --- tests for network security manager -*- lexical-binding: t; -*-
+;;; nsm-tests.el --- tests for network security manager -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/net/ntlm-resources/authinfo b/test/lisp/net/ntlm-resources/authinfo
new file mode 100644
index 00000000000..698391e9313
--- /dev/null
+++ b/test/lisp/net/ntlm-resources/authinfo
@@ -0,0 +1 @@
+machine localhost port http user ntlm password ntlm
diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el
index 6408ac13349..2420b3b48a9 100644
--- a/test/lisp/net/ntlm-tests.el
+++ b/test/lisp/net/ntlm-tests.el
@@ -17,11 +17,26 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+;;; Commentary:
+
+;; Run this with `NTLM_TESTS_VERBOSE=1' to get verbose debugging.
+
+;;; Code:
+
(require 'ert)
+(require 'ert-x)
(require 'ntlm)
+(defsubst ntlm-tests-message (format-string &rest arguments)
+ "Print a message conditional on an environment variable being set.
+FORMAT-STRING and ARGUMENTS are passed to the message function."
+ (when (getenv "NTLM_TESTS_VERBOSE")
+ (apply #'message (concat "ntlm-tests: " format-string) arguments)))
+
+
;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp',
;; for reference.
+
(defun ntlm-tests--time-to-timestamp (time)
"Convert TIME to an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
@@ -49,4 +64,357 @@ signed integer. TIME must be on the form (HIGH LOW USEC PSEC)."
(should (equal (ntlm--time-to-timestamp time)
(ntlm-tests--time-to-timestamp time)))))
+(defvar ntlm-tests--username-oem "ntlm"
+ "The username for NTLM authentication tests, in OEM string encoding.")
+(defvar ntlm-tests--username-unicode
+ (ntlm-ascii2unicode ntlm-tests--username-oem
+ (length ntlm-tests--username-oem))
+ "The username for NTLM authentication tests, in Unicode string encoding.")
+
+(defvar ntlm-tests--password "ntlm"
+ "The password used for NTLM authentication tests.")
+
+(defvar ntlm-tests--client-supports-unicode nil
+ "Non-nil if client supports Unicode strings.
+If client only supports OEM strings, nil.")
+
+(defvar ntlm-tests--challenge nil "The global random challenge.")
+
+(defun ntlm-server-build-type-2 ()
+ "Return an NTLM Type 2 message as a string.
+This string will be returned from the NTLM server to the NTLM client."
+ (let ((target (if ntlm-tests--client-supports-unicode
+ (ntlm-ascii2unicode "DOMAIN" (length "DOMAIN"))
+ "DOMAIN"))
+ (target-information ntlm-tests--password)
+ ;; Flag byte 1 flags.
+ (_negotiate-unicode 1)
+ (negotiate-oem 2)
+ (request-target 4)
+ ;; Flag byte 2 flags.
+ (negotiate-ntlm 2)
+ (_negotiate-local-call 4)
+ (_negotiate-always-sign 8)
+ ;; Flag byte 3 flags.
+ (_target-type-domain 1)
+ (_target-type-server 2)
+ (target-type-share 4)
+ (_negotiate-ntlm2-key 8)
+ (negotiate-target-information 128)
+ ;; Flag byte 4 flags, unused.
+ (_negotiate-128 32)
+ (_negotiate-56 128))
+ (concat
+ ;; Signature.
+ "NTLMSSP" (unibyte-string 0)
+ ;; Type 2.
+ (unibyte-string 2 0 0 0)
+ ;; Target length
+ (unibyte-string (length target) 0)
+ ;; Target allocated space.
+ (unibyte-string (length target) 0)
+ ;; Target offset.
+ (unibyte-string 48 0 0 0)
+ ;; Flags.
+ ;; Flag byte 1.
+ ;; Tell the client that this test server only supports OEM
+ ;; strings. This test server will handle Unicode strings
+ ;; anyway though.
+ (unibyte-string (logior negotiate-oem request-target))
+ ;; Flag byte 2.
+ (unibyte-string negotiate-ntlm)
+ ;; Flag byte 3.
+ (unibyte-string (logior negotiate-target-information target-type-share))
+ ;; Flag byte 4. Not sure what 2 means here.
+ (unibyte-string 2)
+ ;; Challenge. Set this to (unibyte-string 1 2 3 4 5 6 7 8)
+ ;; instead of (ntlm-generate-nonce) to hold constant for
+ ;; debugging.
+ (setq ntlm-tests--challenge (ntlm-generate-nonce))
+ ;; Context.
+ (make-string 8 0)
+ (unibyte-string (length target-information) 0)
+ (unibyte-string (length target-information) 0)
+ (unibyte-string 54 0 0 0)
+ target
+ target-information)))
+
+(defun ntlm-server-hash (challenge blob username password)
+ "Hash CHALLENGE, BLOB, USERNAME and PASSWORD for a Type 3 check."
+ (hmac-md5 (concat challenge blob)
+ (hmac-md5 (concat
+ (upcase
+ ;; This calculation always uses
+ ;; Unicode username, even when the
+ ;; server only supports OEM strings.
+ (ntlm-ascii2unicode username (length username))) "")
+ (cadr (ntlm-get-password-hashes password)))))
+
+(defun ntlm-server-check-authorization (authorization-string)
+ "Return t if AUTHORIZATION-STRING correctly authenticates the user."
+ (let* ((binary (base64-decode-string
+ (caddr (split-string authorization-string " "))))
+ (_lm-response-length (md4-unpack-int16 (substring binary 12 14)))
+ (_lm-response-offset
+ (cdr (md4-unpack-int32 (substring binary 16 20))))
+ (ntlm-response-length (md4-unpack-int16 (substring binary 20 22)))
+ (ntlm-response-offset
+ (cdr (md4-unpack-int32 (substring binary 24 28))))
+ (ntlm-hash
+ (substring binary ntlm-response-offset (+ ntlm-response-offset 16)))
+ (username-length (md4-unpack-int16 (substring binary 36 38)))
+ (username-offset (cdr (md4-unpack-int32 (substring binary 40 44))))
+ (username (substring binary username-offset
+ (+ username-offset username-length))))
+ (if (equal ntlm-response-length 24)
+ (let* ((expected
+ (ntlm-smb-owf-encrypt
+ (cadr (ntlm-get-password-hashes ntlm-tests--password))
+ ntlm-tests--challenge))
+ (received (substring binary ntlm-response-offset
+ (+ ntlm-response-offset
+ ntlm-response-length))))
+ (ntlm-tests-message "Got NTLMv1 response:")
+ (ntlm-tests-message "Expected hash: ===%S===" expected)
+ (ntlm-tests-message "Got hash: ===%S===" received)
+ (ntlm-tests-message "Expected username: ===%S==="
+ ntlm-tests--username-oem)
+ (ntlm-tests-message "Got username: ===%S===" username)
+ (and (or (equal username ntlm-tests--username-oem)
+ (equal username ntlm-tests--username-unicode))
+ (equal expected received)))
+ (let* ((ntlm-response-blob
+ (substring binary (+ ntlm-response-offset 16)
+ (+ (+ ntlm-response-offset 16)
+ (- ntlm-response-length 16))))
+ (_ntlm-timestamp (substring ntlm-response-blob 8 16))
+ (_ntlm-nonce (substring ntlm-response-blob 16 24))
+ (_target-length (md4-unpack-int16 (substring binary 28 30)))
+ (_target-offset
+ (cdr (md4-unpack-int32 (substring binary 32 36))))
+ (_workstation-length (md4-unpack-int16 (substring binary 44 46)))
+ (_workstation-offset
+ (cdr (md4-unpack-int32 (substring binary 48 52)))))
+ (cond
+ ;; This test server claims to only support OEM strings,
+ ;; but also checks Unicode strings.
+ ((or (equal username ntlm-tests--username-oem)
+ (equal username ntlm-tests--username-unicode))
+ (let* ((password ntlm-tests--password)
+ (ntlm-hash-from-type-3 (ntlm-server-hash
+ ntlm-tests--challenge
+ ntlm-response-blob
+ ;; Always -oem since
+ ;; `ntlm-server-hash'
+ ;; always converts it to
+ ;; Unicode.
+ ntlm-tests--username-oem
+ password)))
+ (ntlm-tests-message "Got NTLMv2 response:")
+ (ntlm-tests-message "Expected hash: ==%S==" ntlm-hash)
+ (ntlm-tests-message "Got hash: ==%S==" ntlm-hash-from-type-3)
+ (ntlm-tests-message "Expected username: ===%S==="
+ ntlm-tests--username-oem)
+ (ntlm-tests-message " or username: ===%S==="
+ ntlm-tests--username-unicode)
+ (ntlm-tests-message "Got username: ===%S===" username)
+ (equal ntlm-hash ntlm-hash-from-type-3)))
+ (t
+ nil))))))
+
+(require 'eieio)
+(require 'cl-lib)
+
+;; Silence some byte-compiler warnings that occur when
+;; web-server/web-server.el is not found.
+(declare-function ws-send nil)
+(declare-function ws-parse-request nil)
+(declare-function ws-start nil)
+(declare-function ws-stop-all nil)
+
+(require 'web-server nil t)
+(require 'url-http-ntlm nil t)
+
+(defun ntlm-server-do-token (request _process)
+ "Process an NTLM client's REQUEST.
+PROCESS is unused."
+ (with-slots (process headers) request
+ (let* ((header-alist (cdr headers))
+ (authorization-header (assoc ':AUTHORIZATION header-alist))
+ (authorization-string (cdr authorization-header)))
+ (if (and (stringp authorization-string)
+ (string-match "NTLM " authorization-string))
+ (let* ((challenge (substring authorization-string (match-end 0)))
+ (binary (base64-decode-string challenge))
+ (type (aref binary 8))
+ ;; Flag byte 1 flags.
+ (negotiate-unicode 1)
+ (negotiate-oem 2)
+ (flags-byte-1 (aref binary 12))
+ (client-supports-unicode
+ (not (zerop (logand flags-byte-1 negotiate-unicode))))
+ (client-supports-oem
+ (not (zerop (logand flags-byte-1 negotiate-oem))))
+ (connection-header (assoc ':CONNECTION header-alist))
+ (_keep-alive
+ (when connection-header (cdr connection-header)))
+ (response
+ (cl-case type
+ (1
+ ;; Return Type 2 message.
+ (when (and (not client-supports-unicode)
+ (not client-supports-oem))
+ (warn (concat
+ "Weird client supports neither Unicode"
+ " nor OEM strings, using OEM.")))
+ (setq ntlm-tests--client-supports-unicode
+ client-supports-unicode)
+ (concat
+ "HTTP/1.1 401 Unauthorized\r\n"
+ "WWW-Authenticate: NTLM "
+ (base64-encode-string
+ (ntlm-server-build-type-2) t) "\r\n"
+ "WWW-Authenticate: Negotiate\r\n"
+ "WWW-Authenticate: Basic realm=\"domain\"\r\n"
+ "Content-Length: 0\r\n\r\n"))
+ (3
+ (if (ntlm-server-check-authorization
+ authorization-string)
+ "HTTP/1.1 200 OK\r\n\r\nAuthenticated.\r\n"
+ (progn
+ (if process
+ (set-process-filter process nil)
+ (error "Type 3 message found first?"))
+ (concat "HTTP/1.1 401 Unauthorized\r\n\r\n"
+ "Access Denied.\r\n")))))))
+ (if response
+ (ws-send process response)
+ (when process
+ (set-process-filter process nil)))
+ (when (equal type 3)
+ (set-process-filter process nil)
+ (process-send-eof process)))
+ (progn
+ ;; Did not get NTLM anything.
+ (set-process-filter process nil)
+ (process-send-eof process)
+ (concat "HTTP/1.1 401 Unauthorized\r\n\r\n"
+ "Access Denied.\r\n"))))))
+
+(defun ntlm-server-filter (process string)
+ "Read from PROCESS a STRING and treat it as a request from an NTLM client."
+ (let ((request (make-instance 'ws-request
+ :process process :pending string)))
+ (if (ws-parse-request request)
+ (ntlm-server-do-token request process)
+ (error "Failed to parse request"))))
+
+(defun ntlm-server-handler (request)
+ "Handle an HTTP REQUEST."
+ (with-slots (process headers) request
+ (let* ((header-alist (cdr headers))
+ (authorization-header (assoc ':AUTHORIZATION header-alist))
+ (connection-header (assoc ':CONNECTION header-alist))
+ (keep-alive (when connection-header (cdr connection-header)))
+ (response (concat
+ "HTTP/1.1 401 Unauthorized\r\n"
+ "WWW-Authenticate: Negotiate\r\n"
+ "WWW-Authenticate: NTLM\r\n"
+ "WWW-Authenticate: Basic realm=\"domain\"\r\n"
+ "Content-Length: 0\r\n\r\n")))
+ (if (null authorization-header)
+ ;; Tell client to use NTLM. Firefox will create a new
+ ;; connection.
+ (progn
+ (process-send-string process response)
+ (process-send-eof process))
+ (progn
+ (ntlm-server-do-token request nil)
+ (set-process-filter process #'ntlm-server-filter)
+ (if (equal (upcase keep-alive) "KEEP-ALIVE")
+ :keep-alive
+ (error "NTLM server expects keep-alive connection header")))))))
+
+(defun ntlm-server-start ()
+ "Start an NTLM server on port 8080 for testing."
+ (ws-start 'ntlm-server-handler 8080))
+
+(defun ntlm-server-stop ()
+ "Stop the NTLM server."
+ (ws-stop-all))
+
+(defvar ntlm-tests--result-buffer nil "Final NTLM result buffer.")
+
+(require 'url)
+
+(defun ntlm-tests--url-retrieve-internal-around (original &rest arguments)
+ "Save the result buffer from a `url-retrieve-internal' to a global variable.
+ORIGINAL is the original `url-retrieve-internal' function and
+ARGUMENTS are passed to it."
+ (setq ntlm-tests--result-buffer (apply original arguments)))
+
+(defun ntlm-tests--authenticate ()
+ "Authenticate using credentials from the authinfo resource file."
+ (setq ntlm-tests--result-buffer nil)
+ (let ((auth-sources (list (ert-resource-file "authinfo")))
+ (auth-source-do-cache nil)
+ (auth-source-debug (when (getenv "NTLM_TESTS_VERBOSE") 'trivia)))
+ (ntlm-tests-message "Using auth-sources: %S" auth-sources)
+ (url-retrieve-synchronously "http://localhost:8080"))
+ (sleep-for 0.1)
+ (ntlm-tests-message "Results are in: %S" ntlm-tests--result-buffer)
+ (with-current-buffer ntlm-tests--result-buffer
+ (buffer-string)))
+
+(defun ntlm-tests--start-server-authenticate-stop-server ()
+ "Start an NTLM server, authenticate against it, then stop the server."
+ (advice-add #'url-retrieve-internal
+ :around #'ntlm-tests--url-retrieve-internal-around)
+ (ntlm-server-stop)
+ (ntlm-server-start)
+ (let ((result (ntlm-tests--authenticate)))
+ (advice-remove #'url-retrieve-internal
+ #'ntlm-tests--url-retrieve-internal-around)
+ (ntlm-server-stop)
+ result))
+
+(defvar ntlm-tests--successful-result
+ (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n")
+ "Expected result of successful NTLM authentication.")
+
+(require 'find-func)
+(defun ntlm-tests--ensure-ws-parse-ntlm-support ()
+ "Ensure NTLM special-case in `ws-parse'."
+ (let* ((hit (find-function-search-for-symbol
+ 'ws-parse nil (locate-file "web-server.el" load-path)))
+ (buffer (car hit))
+ (position (cdr hit)))
+ (with-current-buffer buffer
+ (goto-char position)
+ (search-forward-regexp
+ ":NTLM" (save-excursion (forward-sexp) (point)) t))))
+
+(require 'lisp-mnt)
+(defvar ntlm-tests--dependencies-present
+ (and (featurep 'url-http-ntlm)
+ (version<= "2.0.4"
+ (lm-version (locate-file "url-http-ntlm.el" load-path)))
+ (featurep 'web-server)
+ (ntlm-tests--ensure-ws-parse-ntlm-support))
+ "Non-nil if GNU ELPA test dependencies were loaded.")
+
+(ert-deftest ntlm-authentication ()
+ "Check ntlm.el's implementation of NTLM authentication over HTTP."
+ (skip-unless ntlm-tests--dependencies-present)
+ (should (equal (ntlm-tests--start-server-authenticate-stop-server)
+ ntlm-tests--successful-result)))
+
+(ert-deftest ntlm-authentication-old-compatibility-level ()
+ (skip-unless ntlm-tests--dependencies-present)
+ (setq ntlm-compatibility-level 0)
+ (should (equal (ntlm-tests--start-server-authenticate-stop-server)
+ ntlm-tests--successful-result)))
+
(provide 'ntlm-tests)
+
+;;; ntlm-tests.el ends here
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el
index b37168f5ca7..28c0d49cbee 100644
--- a/test/lisp/net/puny-tests.el
+++ b/test/lisp/net/puny-tests.el
@@ -39,10 +39,12 @@
(should (string= (puny-decode-string "xn--9dbdkw") "חנוך")))
(ert-deftest puny-test-encode-domain ()
- (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se")))
+ (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se"))
+ (should (string= (puny-encode-domain "яндекс.рф") "xn--d1acpjx3f.xn--p1ai")))
(ert-deftest puny-test-decode-domain ()
- (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se")))
+ (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se"))
+ (should (string= (puny-decode-domain "xn--d1acpjx3f.xn--p1ai") "яндекс.рф")))
(ert-deftest puny-highly-restrictive-domain-p ()
(should (puny-highly-restrictive-domain-p "foo.bar.org"))
diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el
index 3e9879a49d4..dfd4cf0e7ac 100644
--- a/test/lisp/net/sasl-scram-rfc-tests.el
+++ b/test/lisp/net/sasl-scram-rfc-tests.el
@@ -4,6 +4,8 @@
;; Author: Magnus Henoch <magnus.henoch@gmail.com>
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index a06e31a4f88..ed532af657a 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -1,4 +1,4 @@
-;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*-
+;;; shr-tests.el --- tests for shr.el -*- lexical-binding: t; -*-
;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el
index b378ed2964e..71bdd74890a 100644
--- a/test/lisp/net/socks-tests.el
+++ b/test/lisp/net/socks-tests.el
@@ -21,68 +21,151 @@
;;; Code:
+(require 'ert)
(require 'socks)
(require 'url-http)
-(defvar socks-tests-canned-server-port nil)
+(ert-deftest socks-tests-auth-registration-and-suite-offer ()
+ (ert-info ("Default favors user/pass auth")
+ (should (equal socks-authentication-methods
+ '((2 "Username/Password" . socks-username/password-auth)
+ (0 "No authentication" . identity))))
+ (should (equal "\2\0\2" (socks-build-auth-list)))) ; length [offer ...]
+ (let (socks-authentication-methods)
+ (ert-info ("Empty selection/no methods offered")
+ (should (equal "\0" (socks-build-auth-list))))
+ (ert-info ("Simulate library defaults")
+ (socks-register-authentication-method 0 "No authentication"
+ 'identity)
+ (should (equal socks-authentication-methods
+ '((0 "No authentication" . identity))))
+ (should (equal "\1\0" (socks-build-auth-list)))
+ (socks-register-authentication-method 2 "Username/Password"
+ 'socks-username/password-auth)
+ (should (equal socks-authentication-methods
+ '((2 "Username/Password" . socks-username/password-auth)
+ (0 "No authentication" . identity))))
+ (should (equal "\2\0\2" (socks-build-auth-list))))
+ (ert-info ("Removal")
+ (socks-unregister-authentication-method 2)
+ (should (equal socks-authentication-methods
+ '((0 "No authentication" . identity))))
+ (should (equal "\1\0" (socks-build-auth-list)))
+ (socks-unregister-authentication-method 0)
+ (should-not socks-authentication-methods)
+ (should (equal "\0" (socks-build-auth-list))))))
-(defun socks-tests-canned-server-create (verbatim patterns)
- "Create a fake SOCKS server and return the process.
+(ert-deftest socks-tests-filter-response-parsing-v4 ()
+ "Ensure new chunks added on right (Bug#45162)."
+ (let* ((buf (generate-new-buffer "*test-socks-filter*"))
+ (proc (start-process "test-socks-filter" buf "sleep" "1")))
+ (process-put proc 'socks t)
+ (process-put proc 'socks-state socks-state-waiting)
+ (process-put proc 'socks-server-protocol 4)
+ (ert-info ("Receive initial incomplete segment")
+ (socks-filter proc (concat [0 90 0 0 93 184 216]))
+ ;; From example.com: OK status ^ ^ msg start
+ (ert-info ("State still set to waiting")
+ (should (eq (process-get proc 'socks-state) socks-state-waiting)))
+ (ert-info ("Response field is nil because processing incomplete")
+ (should-not (process-get proc 'socks-response)))
+ (ert-info ("Scratch field holds stashed partial payload")
+ (should (string= (concat [0 90 0 0 93 184 216])
+ (process-get proc 'socks-scratch)))))
+ (ert-info ("Last part arrives")
+ (socks-filter proc "\42") ; ?\" 34
+ (ert-info ("State transitions to complete (length check passes)")
+ (should (eq (process-get proc 'socks-state) socks-state-connected)))
+ (ert-info ("Scratch and response fields hold stash w. last chunk")
+ (should (string= (concat [0 90 0 0 93 184 216 34])
+ (process-get proc 'socks-response)))
+ (should (string= (process-get proc 'socks-response)
+ (process-get proc 'socks-scratch)))))
+ (delete-process proc)
+ (kill-buffer buf)))
-`VERBATIM' and `PATTERNS' are dotted alists containing responses.
-Requests are tried in order. On failure, an error is raised."
- (let* ((buf (generate-new-buffer "*canned-socks-server*"))
+(ert-deftest socks-tests-filter-response-parsing-v5 ()
+ "Ensure new chunks added on right (Bug#45162)."
+ (let* ((buf (generate-new-buffer "*test-socks-filter*"))
+ (proc (start-process "test-socks-filter" buf "sleep" "1")))
+ (process-put proc 'socks t)
+ (process-put proc 'socks-state socks-state-waiting)
+ (process-put proc 'socks-server-protocol 5)
+ (ert-info ("Receive initial incomplete segment")
+ ;; From fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9
+ ;; 5004 ~~> Version Status (OK) NOOP Addr-Type (4 -> IPv6)
+ (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60")
+ (ert-info ("State still waiting and response emtpy")
+ (should (eq (process-get proc 'socks-state) socks-state-waiting))
+ (should-not (process-get proc 'socks-response)))
+ (ert-info ("Scratch field holds partial payload of pending msg")
+ (should (string= "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60"
+ (process-get proc 'socks-scratch)))))
+ (ert-info ("Middle chunk arrives")
+ (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+ (ert-info ("State and response fields still untouched")
+ (should (eq (process-get proc 'socks-state) socks-state-waiting))
+ (should-not (process-get proc 'socks-response)))
+ (ert-info ("Scratch contains new arrival appended (on RHS)")
+ (should (string= (concat "\5\0\0\4"
+ "\x26\x05\xbc\x80\x30\x10\x00\x60"
+ "\xde\xad\xbe\xef\xca\xfe\xfe\xd9")
+ (process-get proc 'socks-scratch)))))
+ (ert-info ("Final part arrives (port number)")
+ (socks-filter proc "\0\0")
+ (ert-info ("State transitions to complete")
+ (should (eq (process-get proc 'socks-state) socks-state-connected)))
+ (ert-info ("Scratch and response fields show last chunk appended")
+ (should (string= (concat "\5\0\0\4"
+ "\x26\x05\xbc\x80\x30\x10\x00\x60"
+ "\xde\xad\xbe\xef\xca\xfe\xfe\xd9"
+ "\0\0")
+ (process-get proc 'socks-scratch)))
+ (should (string= (process-get proc 'socks-response)
+ (process-get proc 'socks-scratch)))))
+ (delete-process proc)
+ (kill-buffer buf)))
+
+(defvar socks-tests-canned-server-patterns nil
+ "Alist containing request/response cons pairs to be tried in order.
+Vectors must match verbatim. Strings are considered regex patterns.")
+
+(defun socks-tests-canned-server-create ()
+ "Create and return a fake SOCKS server."
+ (let* ((port (nth 2 socks-server))
+ (name (format "socks-server:%d" port))
+ (pats socks-tests-canned-server-patterns)
(filt (lambda (proc line)
- (let ((resp (or (assoc-default line verbatim
- (lambda (k s) ; s is line
- (string= (concat k) s)))
- (assoc-default line patterns
- (lambda (p s)
- (string-match-p p s))))))
- (unless resp
+ (pcase-let ((`(,pat . ,resp) (pop pats)))
+ (unless (or (and (vectorp pat) (equal pat (vconcat line)))
+ (string-match-p pat line))
(error "Unknown request: %s" line))
(let ((print-escape-control-characters t))
- (princ (format "<- %s\n" (prin1-to-string line)) buf)
- (princ (format "-> %s\n" (prin1-to-string resp)) buf))
+ (message "[%s] <- %s" name (prin1-to-string line))
+ (message "[%s] -> %s" name (prin1-to-string resp)))
(process-send-string proc (concat resp)))))
- (srv (make-network-process :server 1
- :buffer buf
- :filter filt
- :name "server"
- :family 'ipv4
- :host 'local
- :service socks-tests-canned-server-port)))
- (set-process-query-on-exit-flag srv nil)
- (princ (format "[%s] Listening on localhost:10080\n" srv) buf)
- srv))
-
-;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate
-;; against curl 7.71 with the following options:
-;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
-;;
-;; If later implementing version 4a, try these:
-;; [4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 0 0 0 0]
-;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com
+ (serv (make-network-process :server 1
+ :buffer (get-buffer-create name)
+ :filter filt
+ :name name
+ :family 'ipv4
+ :host 'local
+ :coding 'binary
+ :service port)))
+ (set-process-query-on-exit-flag serv nil)
+ serv))
-(ert-deftest socks-tests-auth-filter-url-http ()
- "Verify correct handling of SOCKS5 user/pass authentication."
- (let* ((socks-server '("server" "127.0.0.1" 10080 5))
- (socks-username "foo")
- (socks-password "bar")
- (url-gateway-method 'socks)
+(defvar socks-tests--hello-world-http-request-pattern
+ (cons "^GET /" (concat "HTTP/1.1 200 OK\r\n"
+ "Content-Type: text/plain\r\n"
+ "Content-Length: 13\r\n\r\n"
+ "Hello World!\n")))
+
+(defun socks-tests-perform-hello-world-http-request ()
+ "Start canned server, validate hello-world response, and finalize."
+ (let* ((url-gateway-method 'socks)
(url (url-generic-parse-url "http://example.com"))
- (verbatim '(([5 2 0 2] . [5 2])
- ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
- ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
- . [5 0 0 1 0 0 0 0 0 0])))
- (patterns
- `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n"
- "Content-Type: text/plain; charset=UTF-8\r\n"
- "Content-Length: 13\r\n\r\n"
- "Hello World!\n"))))
- (socks-tests-canned-server-port 10080)
- (server (socks-tests-canned-server-create verbatim patterns))
- (tries 10)
+ (server (socks-tests-canned-server-create))
;;
done
;;
@@ -90,14 +173,112 @@ Requests are tried in order. On failure, an error is raised."
(goto-char (point-min))
(should (search-forward "Hello World" nil t))
(setq done t)))
- (buf (url-http url cb '(nil))))
- (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method")
- (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http
- (sleep-for 0.1)))
+ (inhibit-message noninteractive)
+ (buf (url-http url cb '(nil)))
+ (proc (get-buffer-process buf))
+ (attempts 10))
+ (while (and (not done) (< 0 (cl-decf attempts)))
+ (sleep-for 0.1))
(should done)
(delete-process server)
+ (delete-process proc) ; otherwise seems client proc is sometimes reused
(kill-buffer (process-buffer server))
(kill-buffer buf)
(ignore url-gateway-method)))
+;; Unlike curl, socks.el includes the ID field (but otherwise matches):
+;; $ curl --proxy socks4://127.0.0.1:1080 example.com
+
+(ert-deftest socks-tests-v4-basic ()
+ "Show correct preparation of SOCKS4 connect command (Bug#46342)."
+ (let ((socks-server '("server" "127.0.0.1" 10079 4))
+ (url-user-agent "Test/4-basic")
+ (socks-tests-canned-server-patterns
+ `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern))
+ socks-nslookup-program)
+ (ert-info ("Make HTTP request over SOCKS4")
+ (cl-letf (((symbol-function 'socks-nslookup-host)
+ (lambda (host)
+ (should (equal host "example.com"))
+ (list 93 184 216 34)))
+ ((symbol-function 'user-full-name)
+ (lambda () "foo")))
+ (socks-tests-perform-hello-world-http-request)))))
+
+;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com
+
+(ert-deftest socks-tests-v5-auth-user-pass ()
+ "Verify correct handling of SOCKS5 user/pass authentication."
+ (should (assq 2 socks-authentication-methods))
+ (let ((socks-server '("server" "127.0.0.1" 10080 5))
+ (socks-username "foo")
+ (socks-password "bar")
+ (url-user-agent "Test/auth-user-pass")
+ (socks-tests-canned-server-patterns
+ `(([5 2 0 2] . [5 2])
+ ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method")
+ (socks-tests-perform-hello-world-http-request))))
+
+;; Services (like Tor) may be configured without auth but for some
+;; reason still prefer the user/pass method over none when offered both.
+;; Given this library's defaults, the scenario below is possible.
+;;
+;; FYI: RFC 1929 doesn't say that a username or password is required
+;; but notes that the length of both fields should be at least one.
+;; However, both socks.el and curl send zero-length fields (though
+;; curl drops the user part too when the password is empty).
+;;
+;; From Tor's docs /socks-extensions.txt, 1.1 Extent of support:
+;; > We allow username/password fields of this message to be empty ...
+;; line 41 in blob 5fd1f828f3e9d014f7b65fa3bd1d33c39e4129e2
+;; https://gitweb.torproject.org/torspec.git/tree/socks-extensions.txt
+;;
+;; To verify against curl 7.71, swap out the first two pattern pairs
+;; with ([5 3 0 1 2] . [5 2]) and ([1 0 0] . [1 0]), then run:
+;; $ curl verbose -U "foo:" --proxy socks5h://127.0.0.1:10081 example.com
+
+(ert-deftest socks-tests-v5-auth-user-pass-blank ()
+ "Verify correct SOCKS5 user/pass authentication with empty pass."
+ (should (assq 2 socks-authentication-methods))
+ (let ((socks-server '("server" "127.0.0.1" 10081 5))
+ (socks-username "foo") ; defaults to (user-login-name)
+ (socks-password "") ; simulate user hitting enter when prompted
+ (url-user-agent "Test/auth-user-pass-blank")
+ (socks-tests-canned-server-patterns
+ `(([5 2 0 2] . [5 2])
+ ([1 3 ?f ?o ?o 0] . [1 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method")
+ (socks-tests-perform-hello-world-http-request))))
+
+;; Swap out ([5 2 0 1] . [5 0]) with the first pattern below to validate
+;; against curl 7.71 with the following options:
+;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com
+
+(ert-deftest socks-tests-v5-auth-none ()
+ "Verify correct handling of SOCKS5 when auth method 0 requested."
+ (let ((socks-server '("server" "127.0.0.1" 10082 5))
+ (socks-authentication-methods (append socks-authentication-methods
+ nil))
+ (url-user-agent "Test/auth-none")
+ (socks-tests-canned-server-patterns
+ `(([5 1 0] . [5 0])
+ ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80]
+ . [5 0 0 1 0 0 0 0 0 0])
+ ,socks-tests--hello-world-http-request-pattern)))
+ (socks-unregister-authentication-method 2)
+ (should-not (assq 2 socks-authentication-methods))
+ (ert-info ("Make HTTP request over SOCKS5 with no auth method")
+ (socks-tests-perform-hello-world-http-request)))
+ (should (assq 2 socks-authentication-methods)))
+
;;; socks-tests.el ends here
diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el
index 6a6b56f4a1d..aac1b13bd0e 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -292,15 +292,26 @@ variables, so we check the Emacs version directly."
"Check `expand-file-name'."
(should
(string-equal
- (expand-file-name "/foo.tar/path/./file") "/foo.tar/path/file"))
+ (expand-file-name (concat tramp-archive-test-archive "path/./file"))
+ (concat tramp-archive-test-archive "path/file")))
(should
- (string-equal (expand-file-name "/foo.tar/path/../file") "/foo.tar/file"))
+ (string-equal
+ (expand-file-name (concat tramp-archive-test-archive "path/../file"))
+ (concat tramp-archive-test-archive "file")))
;; `expand-file-name' does not care "~/" in archive file names.
(should
- (string-equal (expand-file-name "/foo.tar/~/file") "/foo.tar/~/file"))
+ (string-equal
+ (expand-file-name (concat tramp-archive-test-archive "~/file"))
+ (concat tramp-archive-test-archive "~/file")))
;; `expand-file-name' does not care file archive boundaries.
- (should (string-equal (expand-file-name "/foo.tar/./file") "/foo.tar/file"))
- (should (string-equal (expand-file-name "/foo.tar/../file") "/file")))
+ (should
+ (string-equal
+ (expand-file-name (concat tramp-archive-test-archive "./file"))
+ (concat tramp-archive-test-archive "file")))
+ (should
+ (string-equal
+ (expand-file-name (concat tramp-archive-test-archive "../file"))
+ (concat (ert-resource-directory) "file"))))
;; This test is inspired by Bug#30293.
(ert-deftest tramp-archive-test05-expand-file-name-non-archive-directory ()
@@ -325,38 +336,59 @@ This checks also `file-name-as-directory', `file-name-directory',
(should
(string-equal
- (directory-file-name "/foo.tar/path/to/file") "/foo.tar/path/to/file"))
+ (directory-file-name (concat tramp-archive-test-archive "path/to/file"))
+ (concat tramp-archive-test-archive "path/to/file")))
(should
(string-equal
- (directory-file-name "/foo.tar/path/to/file/") "/foo.tar/path/to/file"))
+ (directory-file-name (concat tramp-archive-test-archive "path/to/file/"))
+ (concat tramp-archive-test-archive "path/to/file")))
;; `directory-file-name' does not leave file archive boundaries.
- (should (string-equal (directory-file-name "/foo.tar/") "/foo.tar/"))
+ (should
+ (string-equal
+ (directory-file-name tramp-archive-test-archive) tramp-archive-test-archive))
(should
(string-equal
- (file-name-as-directory "/foo.tar/path/to/file") "/foo.tar/path/to/file/"))
+ (file-name-as-directory (concat tramp-archive-test-archive "path/to/file"))
+ (concat tramp-archive-test-archive "path/to/file/")))
(should
(string-equal
- (file-name-as-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
- (should (string-equal (file-name-as-directory "/foo.tar/") "/foo.tar/"))
- (should (string-equal (file-name-as-directory "/foo.tar") "/foo.tar/"))
+ (file-name-as-directory (concat tramp-archive-test-archive "path/to/file/"))
+ (concat tramp-archive-test-archive "path/to/file/")))
+ (should
+ (string-equal
+ (file-name-as-directory tramp-archive-test-archive)
+ tramp-archive-test-archive))
+ (should
+ (string-equal
+ (file-name-as-directory tramp-archive-test-file-archive)
+ tramp-archive-test-archive))
(should
(string-equal
- (file-name-directory "/foo.tar/path/to/file") "/foo.tar/path/to/"))
+ (file-name-directory (concat tramp-archive-test-archive "path/to/file"))
+ (concat tramp-archive-test-archive "path/to/")))
(should
(string-equal
- (file-name-directory "/foo.tar/path/to/file/") "/foo.tar/path/to/file/"))
- (should (string-equal (file-name-directory "/foo.tar/") "/foo.tar/"))
+ (file-name-directory (concat tramp-archive-test-archive "path/to/file/"))
+ (concat tramp-archive-test-archive "path/to/file/")))
+ (should
+ (string-equal
+ (file-name-directory tramp-archive-test-archive) tramp-archive-test-archive))
(should
- (string-equal (file-name-nondirectory "/foo.tar/path/to/file") "file"))
+ (string-equal
+ (file-name-nondirectory (concat tramp-archive-test-archive "path/to/file"))
+ "file"))
(should
- (string-equal (file-name-nondirectory "/foo.tar/path/to/file/") ""))
- (should (string-equal (file-name-nondirectory "/foo.tar/") ""))
+ (string-equal
+ (file-name-nondirectory (concat tramp-archive-test-archive "path/to/file/"))
+ ""))
+ (should (string-equal (file-name-nondirectory tramp-archive-test-archive) ""))
(should-not
- (unhandled-file-name-directory "/foo.tar/path/to/file")))
+ (unhandled-file-name-directory
+ (concat tramp-archive-test-archive "path/to/file"))))
(ert-deftest tramp-archive-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
@@ -824,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(tramp-archive-cleanup-hash))))
;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-archive-test39-make-nearby-temp-file ()
+(ert-deftest tramp-archive-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless tramp-archive-enabled)
;; Since Emacs 26.1.
@@ -861,7 +893,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
-(ert-deftest tramp-archive-test42-file-system-info ()
+(ert-deftest tramp-archive-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless tramp-archive-enabled)
;; Since Emacs 27.1.
@@ -887,27 +919,35 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
;; tramp-archive is neither loaded at Emacs startup, nor when
;; loading a file like "/mock::foo" (which loads Tramp).
- (let ((default-directory (expand-file-name temporary-file-directory))
- (code
+ (let ((code
"(progn \
- (message \"tramp-archive loaded: %%s %%s\" \
- (featurep 'tramp) (featurep 'tramp-archive)) \
+ (message \"tramp-archive loaded: %%s\" \
+ (featurep 'tramp-archive)) \
(file-attributes %S \"/\") \
- (message \"tramp-archive loaded: %%s %%s\" \
- (featurep 'tramp) (featurep 'tramp-archive)))"))
- (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
- (should
- (string-match
- (format
- "tramp-archive loaded: nil nil[[:ascii:]]+tramp-archive loaded: t %s"
- (tramp-archive-file-name-p file))
- (shell-command-to-string
- (format
- "%s -batch -Q -L %s --eval %s"
- (shell-quote-argument
- (expand-file-name invocation-name invocation-directory))
- (mapconcat #'shell-quote-argument load-path " -L ")
- (shell-quote-argument (format code file)))))))))
+ (message \"tramp-archive loaded: %%s\" \
+ (featurep 'tramp-archive)))"))
+ (dolist (default-directory
+ `(,temporary-file-directory
+ ;; Starting Emacs in a directory which has
+ ;; `tramp-archive-file-name-regexp' syntax is
+ ;; supported only with Emacs > 27.2 (sigh!).
+ ;; (Bug#48476)
+ ,(file-name-as-directory tramp-archive-test-directory)))
+ (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
+ (should
+ (string-match
+ (format
+ "tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s"
+ (tramp-archive-file-name-p default-directory)
+ (or (tramp-archive-file-name-p default-directory)
+ (tramp-archive-file-name-p file)))
+ (shell-command-to-string
+ (format
+ "%s -batch -Q -L %s --eval %s"
+ (shell-quote-argument
+ (expand-file-name invocation-name invocation-directory))
+ (mapconcat #'shell-quote-argument load-path " -L ")
+ (shell-quote-argument (format code file))))))))))
(ert-deftest tramp-archive-test45-delay-load ()
"Check that `tramp-archive' is loaded lazily, only when needed."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index f4883923f6a..3008861f22b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -33,7 +33,7 @@
;; remote host, set this environment variable to "/dev/null" or
;; whatever is appropriate on your system.
-;; For slow remote connections, `tramp-test43-asynchronous-requests'
+;; For slow remote connections, `tramp-test44-asynchronous-requests'
;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
;; value less than 10 could help.
@@ -59,9 +59,12 @@
(declare-function tramp-get-remote-perl "tramp-sh")
(declare-function tramp-get-remote-stat "tramp-sh")
(declare-function tramp-list-tramp-buffers "tramp-cmds")
+(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
+(defvar lock-file-name-transforms)
+(defvar remote-file-name-inhibit-locks)
(defvar tramp-connection-properties)
(defvar tramp-copy-size-limit)
(defvar tramp-display-escape-sequence-regexp)
@@ -121,6 +124,7 @@
(setq auth-source-save-behavior nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
+ tramp-allow-unsafe-temporary-files t
tramp-cache-read-persistent-data t ;; For auth-sources.
tramp-copy-size-limit nil
tramp-persistency-file-name nil
@@ -178,6 +182,11 @@ The temporary file is not created."
"Whether `tramp--test-instrument-test-case' run.
This shall used dynamically bound only.")
+;; When `tramp-verbose' is greater than 10, and you want to trace
+;; other functions as well, do something like
+;; (let ((tramp-trace-functions '(file-name-non-special)))
+;; (tramp--test-instrument-test-case 11
+;; ...))
(defmacro tramp--test-instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
Print the content of the Tramp connection and debug buffers, if
@@ -186,31 +195,22 @@ is greater than 10.
`should-error' is not handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
`(let* ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
- (trace-buffer
- (when (> tramp-verbose 10) (generate-new-buffer " *temp*")))
+ (trace-buffer (tramp-trace-buffer-name tramp-test-vec))
(debug-ignored-errors
(append
'("^make-symbolic-link not supported$"
"^error with add-name-to-file")
debug-ignored-errors))
inhibit-message)
- (when trace-buffer
- (dolist (elt (all-completions "tramp-" obarray 'functionp))
- (trace-function-background (intern elt))))
(unwind-protect
(let ((tramp--test-instrument-test-case-p t)) ,@body)
;; Unwind forms.
- (when trace-buffer
- (untrace-all))
(when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
- (dolist
- (buf (if trace-buffer
- (cons (get-buffer trace-buffer) (tramp-list-tramp-buffers))
- (tramp-list-tramp-buffers)))
+ (untrace-all)
+ (dolist (buf (tramp-list-tramp-buffers))
(with-current-buffer buf
- (message ";; %s\n%s" buf (buffer-string)))))
- (when trace-buffer
- (kill-buffer trace-buffer)))))
+ (message ";; %s\n%s" buf (buffer-string)))
+ (kill-buffer buf))))))
(defsubst tramp--test-message (fmt-string &rest arguments)
"Emit a message into ERT *Messages*."
@@ -232,6 +232,16 @@ is greater than 10.
"%s %f sec"
,message (float-time (time-subtract (current-time) start))))))
+;; `always' is introduced with Emacs 28.1.
+(defalias 'tramp--test-always
+ (if (fboundp 'always)
+ #'always
+ (lambda (&rest _arguments)
+ "Do nothing and return t.
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `ignore'."
+ t)))
+
(ert-deftest tramp-test00-availability ()
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
@@ -2182,6 +2192,16 @@ is greater than 10.
(expand-file-name ".." "./"))
(concat (file-remote-p tramp-test-temporary-file-directory) "/"))))
+(ert-deftest tramp-test05-expand-file-name-top ()
+ "Check `expand-file-name'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+
+ (let ((dir (concat (file-remote-p tramp-test-temporary-file-directory) "/")))
+ (dolist (local '("." ".."))
+ (should (string-equal (expand-file-name local dir) dir))
+ (should (string-equal (expand-file-name (concat dir local)) dir)))))
+
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory',
@@ -2446,10 +2466,13 @@ This checks also `file-name-as-directory', `file-name-directory',
"^\\'")
tramp--test-messages))))))))
+ ;; We do not test lockname here. See
+ ;; `tramp-test39-make-lock-file-name'.
+
;; Do not overwrite if excluded.
- (cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t))
+ (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
;; Ange-FTP.
- ((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
+ ((symbol-function 'yes-or-no-p) #'tramp--test-always))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
;; `mustbenew' is passed to Tramp since Emacs 26.1.
(when (tramp--test-emacs26-p)
@@ -2814,9 +2837,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(should (file-exists-p (expand-file-name "bla" tmp-name2)))
(should-error
(delete-directory tmp-name1 nil 'trash)
- ;; tramp-rclone.el calls the local `delete-directory'.
- ;; This raises another error.
- :type (if (tramp--test-rclone-p) 'error 'file-error))
+ ;; tramp-rclone.el and tramp-sshfs.el call the local
+ ;; `delete-directory'. This raises another error.
+ :type (if (tramp--test-fuse-p) 'error 'file-error))
(delete-directory tmp-name1 'recursive 'trash)
(should-not (file-directory-p tmp-name1))
(should
@@ -3244,8 +3267,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(ignore-errors (delete-directory tmp-name1 'recursive))))))
;; Method "smb" supports `make-symbolic-link' only if the remote host
-;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el and
-;; tramp-rclone.el do not support symbolic links at all.
+;; has CIFS capabilities. tramp-adb.el, tramp-gvfs.el, tramp-rclone.el
+;; and tramp-sshfs.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 (body)))
@@ -3526,7 +3549,7 @@ They might differ only in time attributes or directory size."
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
(skip-unless
- (or (tramp--test-sh-p) (tramp--test-sudoedit-p)
+ (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
;; Not all tramp-gvfs.el methods support changing the file mode.
(and
(tramp--test-gvfs-p)
@@ -3663,7 +3686,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(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)))
+ (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
(make-symbolic-link tmp-name1 tmp-name2 0)
(should
(string-equal
@@ -3739,7 +3762,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(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)))
+ (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
(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)
@@ -4073,7 +4096,7 @@ 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))
(should (file-selinux-context tmp-name1))
- (copy-file tmp-name1 tmp-name2)
+ (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
(should (file-selinux-context tmp-name2))
(should
(equal
@@ -4357,11 +4380,15 @@ 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))))))
+(defun tramp--test-shell-file-name ()
+ "Return default remote shell."
+ (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+
(ert-deftest tramp-test28-process-file ()
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4378,25 +4405,27 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should-not (zerop (process-file "binary-does-not-exist")))
;; Return exit code.
(should (= 42 (process-file
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
+ (tramp--test-shell-file-name)
nil nil nil "-c" "exit 42")))
;; Return exit code in case the process is interrupted,
;; and there's no indication for a signal describing string.
- (let (process-file-return-signal-string)
- (should
- (= (+ 128 2)
- (process-file
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
- nil nil nil "-c" "kill -2 $$"))))
+ (unless (tramp--test-sshfs-p)
+ (let (process-file-return-signal-string)
+ (should
+ (= (+ 128 2)
+ (process-file
+ (tramp--test-shell-file-name)
+ nil nil nil "-c" "kill -2 $$")))))
;; Return string in case the process is interrupted and
;; there's an indication for a signal describing string.
- (let ((process-file-return-signal-string t))
- (should
- (string-match-p
- "Interrupt\\|Signal 2"
- (process-file
- (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
- nil nil nil "-c" "kill -2 $$"))))
+ (unless (tramp--test-sshfs-p)
+ (let ((process-file-return-signal-string t))
+ (should
+ (string-match-p
+ "Interrupt\\|Signal 2"
+ (process-file
+ (tramp--test-shell-file-name)
+ nil nil nil "-c" "kill -2 $$")))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
@@ -4440,7 +4469,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4531,7 +4560,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(declare (indent 1))
;; `make-process' supports file name handlers since Emacs 27.
- (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
+ (when (let ((file-name-handler-alist '(("" . #'tramp--test-always))))
(ignore-errors (make-process :file-handler t)))
`(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
,docstring
@@ -4547,7 +4576,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; `file-truename' does it by side-effect. Suppress
;; `tramp--test-enabled', in order to keep the connection.
;; Suppress "Process ... finished" messages.
- (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t))
+ (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always)
((symbol-function #'internal-default-process-sentinel)
#'ignore))
(file-truename tramp-test-temporary-file-directory)
@@ -4560,15 +4589,14 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
(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))
- (tmp-name2 (tramp--test-make-temp-name 'local quoted))
+ (tmp-name (tramp--test-make-temp-name nil quoted))
kill-buffer-query-functions proc)
(with-no-warnings (should-not (make-process)))
@@ -4596,13 +4624,13 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Simple process using a file.
(unwind-protect
(with-temp-buffer
- (write-region "foo" nil tmp-name1)
- (should (file-exists-p tmp-name1))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
(setq proc
(with-no-warnings
(make-process
:name "test2" :buffer (current-buffer)
- :command `("cat" ,(file-name-nondirectory tmp-name1))
+ :command `("cat" ,(file-name-nondirectory tmp-name))
:file-handler t)))
(should (processp proc))
;; Read output.
@@ -4614,7 +4642,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Cleanup.
(ignore-errors
(delete-process proc)
- (delete-file tmp-name1)))
+ (delete-file tmp-name)))
;; Process filter.
(unwind-protect
@@ -4678,11 +4706,17 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
:stderr stderr
:file-handler t)))
(should (processp proc))
- ;; Read stderr.
+ ;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
- (delete-process proc)
+ ;; Read stderr.
(with-current-buffer stderr
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (not (string-match-p
+ "No such file or directory" (buffer-string)))
+ (while (accept-process-output
+ (get-buffer-process stderr) 0 nil t))))
+ (delete-process proc)
(should
(string-match-p
"cat:.* No such file or directory" (buffer-string)))))
@@ -4693,30 +4727,67 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; Process with stderr file.
(unless (tramp-direct-async-process-p)
- (dolist (tmpfile `(,tmp-name1 ,tmp-name2))
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc
+ (with-no-warnings
+ (make-process
+ :name "test6" :buffer (current-buffer)
+ :command '("cat" "/does-not-exist")
+ :stderr tmp-name
+ :file-handler t)))
+ (should (processp proc))
+ ;; Read stderr.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc nil nil t)))
+ (delete-process proc)
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should
+ (string-match-p
+ "cat:.* No such file or directory" (buffer-string)))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc))
+ (ignore-errors (delete-file tmp-name))))
+
+ ;; Process connection type.
+ (when (and (tramp--test-sh-p)
+ ;; `executable-find' has changed the number of
+ ;; parameters in Emacs 27.1, so we use `apply' for
+ ;; older Emacsen.
+ (ignore-errors
+ (with-no-warnings
+ (apply #'executable-find '("hexdump" remote)))))
+ (dolist (connection-type '(nil pipe t pty))
(unwind-protect
(with-temp-buffer
(setq proc
(with-no-warnings
(make-process
- :name "test6" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
- :stderr tmpfile
+ :name (format "test7-%s" connection-type)
+ :buffer (current-buffer)
+ :connection-type connection-type
+ :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
:file-handler t)))
(should (processp proc))
- ;; Read stderr.
+ (should (equal (process-status proc) 'run))
+ (process-send-string proc "foo\r\n")
+ (process-send-eof proc)
+ ;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc nil nil t)))
- (delete-process proc)
- (with-temp-buffer
- (insert-file-contents tmpfile)
- (should
- (string-match-p
- "cat:.* No such file or directory" (buffer-string)))))
+ (while (< (- (point-max) (point-min))
+ (length "66\n6F\n6F\n0D\n0A\n"))
+ (while (accept-process-output proc 0 nil t))))
+ (should
+ (string-match-p
+ (if (memq connection-type '(nil pipe))
+ "66\n6F\n6F\n0D\n0A\n"
+ "66\n6F\n6F\n0A\n0A\n")
+ (buffer-string))))
;; Cleanup.
- (ignore-errors (delete-process proc))
- (ignore-errors (delete-file tmpfile))))))))
+ (ignore-errors (delete-process proc))))))))
(tramp--test--deftest-direct-async-process tramp-test30-make-process
"Check direct async `make-process'.")
@@ -4788,7 +4859,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
- (tramp--test-sh-p)))
+ (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -4887,7 +4958,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless nil)
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
(skip-unless (tramp--test-emacs27-p))
@@ -5092,8 +5163,10 @@ INPUT, if non-nil, is a string sent to the process."
(string-match-p
(regexp-quote envvar)
;; We must remove PS1, the output is truncated otherwise.
+ ;; We must suppress "_=VAR...".
(funcall
- this-shell-command-to-string "printenv | grep -v PS1")))))))))
+ this-shell-command-to-string
+ "printenv | grep -v PS1 | grep -v _=")))))))))
(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
"Check that remote processes set / unset environment variables properly.
@@ -5210,7 +5283,7 @@ Use direct async.")
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
- (tramp--test-sh-p)))
+ (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
@@ -5232,8 +5305,7 @@ Use direct async.")
(with-no-warnings
(connection-local-set-profile-variables
'remote-sh
- `((explicit-shell-file-name
- . ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+ `((explicit-shell-file-name . ,(tramp--test-shell-file-name))
(explicit-sh-args . ("-c" "echo foo"))))
(connection-local-set-profiles
`(:application tramp
@@ -5267,7 +5339,7 @@ Use direct async.")
(ert-deftest tramp-test35-exec-path ()
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
- (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
+ (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@@ -5451,7 +5523,8 @@ Use direct async.")
(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)))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ tramp-allow-unsafe-temporary-files)
(unwind-protect
(progn
@@ -5535,11 +5608,37 @@ Use direct async.")
("]" . "_r"))
(tramp-compat-file-name-unquote tmp-name1)))
tmp-name2)))
- (should (file-directory-p tmp-name2))))))
+ (should (file-directory-p tmp-name2)))))
+
+ ;; Create temporary file. This shall check for sensible
+ ;; files, owned by root.
+ (let ((tramp-auto-save-directory temporary-file-directory))
+ (write-region "foo" nil tmp-name1)
+ (when (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes tmp-name1))
+ tramp-unknown-id-integer))
+ (with-temp-buffer
+ (setq buffer-file-name tmp-name1)
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (let ((tramp-allow-unsafe-temporary-files t))
+ (should (stringp (make-auto-save-file-name))))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+ (should-error
+ (make-auto-save-file-name)
+ :type 'file-error))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ #'tramp--test-always))
+ (should (stringp (make-auto-save-file-name))))))))
;; Cleanup.
(ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-directory tmp-name2 'recursive))))))
+ (ignore-errors (delete-directory tmp-name2 'recursive))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
(ert-deftest tramp-test38-find-backup-file-name ()
"Check `find-backup-file-name'."
@@ -5549,6 +5648,7 @@ Use direct async.")
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(ange-ftp-make-backup-files t)
+ tramp-allow-unsafe-temporary-files
;; 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))
@@ -5653,10 +5753,175 @@ Use direct async.")
(should (file-directory-p tmp-name2))))
;; Cleanup.
- (ignore-errors (delete-directory tmp-name2 'recursive))))))
+ (ignore-errors (delete-directory tmp-name2 'recursive)))
+
+ (unwind-protect
+ ;; Create temporary file. This shall check for sensible
+ ;; files, owned by root.
+ (let ((backup-directory-alist `(("." . ,temporary-file-directory)))
+ tramp-backup-directory-alist)
+ (write-region "foo" nil tmp-name1)
+ (when (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes tmp-name1))
+ tramp-unknown-id-integer))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (let ((tramp-allow-unsafe-temporary-files t))
+ (should (stringp (car (find-backup-file-name tmp-name1)))))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+ (should-error
+ (find-backup-file-name tmp-name1)
+ :type 'file-error))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ #'tramp--test-always))
+ (should (stringp (car (find-backup-file-name tmp-name1)))))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
+
+;; The functions were introduced in Emacs 28.1.
+(ert-deftest tramp-test39-make-lock-file-name ()
+ "Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+ ;; Since Emacs 28.1.
+ (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file)))
+ (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name)))
+
+ ;; `lock-file', `unlock-file', `file-locked-p' and
+ ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to
+ ;; see compiler warnings for older Emacsen.
+ (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))
+ (remote-file-name-inhibit-cache t)
+ (remote-file-name-inhibit-locks nil)
+ (create-lockfiles t)
+ tramp-allow-unsafe-temporary-files
+ (inhibit-message t)
+ ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
+ (tramp-cleanup-connection-hook
+ (append
+ (and (tramp--test-fuse-p) '(tramp-fuse-unmount))
+ tramp-cleanup-connection-hook))
+ auto-save-default
+ noninteractive)
+
+ (unwind-protect
+ (progn
+ ;; A simple file lock.
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; If it is locked already, nothing changes.
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; `save-buffer' removes the lock.
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (save-buffer))
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; A new connection changes process id, and also the
+ ;; lockname contents.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; When `remote-file-name-inhibit-locks' is set, nothing happens.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (let ((remote-file-name-inhibit-locks t))
+ (with-no-warnings (lock-file tmp-name1))
+ (should-not (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; When `lock-file-name-transforms' is set, another lock
+ ;; file is used.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (let ((lock-file-name-transforms `((".*" ,tmp-name2))))
+ (should
+ (string-equal
+ (with-no-warnings (make-lock-file-name tmp-name1))
+ (with-no-warnings (make-lock-file-name tmp-name2))))
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-no-warnings (unlock-file tmp-name1))
+ (should-not (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; Steal the file lock.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
+ (with-no-warnings (lock-file tmp-name1)))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+
+ ;; Ignore the file lock.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
+ (with-no-warnings (lock-file tmp-name1)))
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
+
+ ;; Quit the file lock machinery.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
+ (with-no-warnings
+ (should-error
+ (lock-file tmp-name1)
+ :type 'file-locked))
+ ;; The same for `write-region'.
+ (should-error
+ (write-region "foo" nil tmp-name1)
+ :type 'file-locked)
+ (should-error
+ (write-region "foo" nil tmp-name1 nil nil tmp-name1)
+ :type 'file-locked)
+ ;; The same for `set-visited-file-name'.
+ (with-temp-buffer
+ (should-error
+ (set-visited-file-name tmp-name1)
+ :type 'file-locked)))
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (with-no-warnings (unlock-file tmp-name1))
+ (with-no-warnings (unlock-file tmp-name2))
+ (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ (should-not (with-no-warnings (file-locked-p tmp-name2))))
+
+ (unwind-protect
+ ;; Create temporary file. This shall check for sensible
+ ;; files, owned by root.
+ (let ((lock-file-name-transforms auto-save-file-name-transforms))
+ (write-region "foo" nil tmp-name1)
+ (when (zerop (or (tramp-compat-file-attribute-user-id
+ (file-attributes tmp-name1))
+ tramp-unknown-id-integer))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+ (should-error
+ (write-region "foo" nil tmp-name1)
+ :type 'file-error))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ #'tramp--test-always))
+ (write-region "foo" nil tmp-name1))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-test39-make-nearby-temp-file ()
+(ert-deftest tramp-test40-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-ange-ftp-p)))
@@ -5739,6 +6004,10 @@ This does not support globbing characters in file names (yet)."
(string-match-p
"ftp$" (file-remote-p tramp-test-temporary-file-directory 'method)))
+(defun tramp--test-fuse-p ()
+ "Check, whether an FUSE file system isused."
+ (or (tramp--test-rclone-p) (tramp--test-sshfs-p)))
+
(defun tramp--test-gdrive-p ()
"Check, whether the gdrive method is used."
(string-equal
@@ -5807,6 +6076,11 @@ Additionally, ls does not support \"--dired\"."
"^\\(afp\\|davs?\\|smb\\)$"
(file-remote-p tramp-test-temporary-file-directory 'method))))
+(defun tramp--test-sshfs-p ()
+ "Check, whether the remote host is offered by sshfs.
+This requires restrictions of file name syntax."
+ (tramp-sshfs-file-name-p tramp-test-temporary-file-directory))
+
(defun tramp--test-sudoedit-p ()
"Check, whether the sudoedit method is used."
(tramp-sudoedit-file-name-p tramp-test-temporary-file-directory))
@@ -5815,18 +6089,11 @@ Additionally, ls does not support \"--dired\"."
"Check, whether the locale host runs MS Windows."
(eq system-type 'windows-nt))
-(defun tramp--test-windows-nt-and-batch-p ()
- "Check, whether the locale host runs MS Windows in batch mode.
-This does not support special characters."
- (and (eq system-type 'windows-nt) noninteractive))
-
-(defun tramp--test-windows-nt-and-pscp-psftp-p ()
- "Check, whether the locale host runs MS Windows, and ps{cp,ftp} is used.
+(defun tramp--test-windows-nt-and-out-of-band-p ()
+ "Check, whether the locale host runs MS Windows and an out-of-band method.
This does not support utf8 based file transfer."
(and (eq system-type 'windows-nt)
- (string-match-p
- (regexp-opt '("pscp" "psftp"))
- (file-remote-p tramp-test-temporary-file-directory 'method))))
+ (tramp-method-out-of-band-p tramp-test-vec 1)))
(defun tramp--test-windows-nt-or-smb-p ()
"Check, whether the locale or remote host runs MS Windows.
@@ -5851,7 +6118,9 @@ This requires restrictions of file name syntax."
(file-truename tramp-test-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
- (files (delq nil files))
+ (files
+ (delq
+ nil (mapcar (lambda (x) (unless (string-empty-p x) x)) files)))
(process-environment process-environment)
(sorted-files (sort (copy-sequence files) #'string-lessp))
buffer)
@@ -5861,6 +6130,7 @@ This requires restrictions of file name syntax."
(make-directory tmp-name2)
(dolist (elt files)
+ ;(tramp--test-message "'%s'" elt)
(let* ((file1 (expand-file-name elt tmp-name1))
(file2 (expand-file-name elt tmp-name2))
(file3 (expand-file-name (concat elt "foo") tmp-name1)))
@@ -6028,7 +6298,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-test40-special-characters*'."
+ "Perform the test in `tramp-test41-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
@@ -6050,9 +6320,9 @@ This requires restrictions of file name syntax."
"\tfoo bar baz\t")
(t " foo\tbar baz\t"))
"@foo@bar@baz@"
- "$foo$bar$$baz$"
+ (unless (tramp--test-windows-nt-and-out-of-band-p) "$foo$bar$$baz$")
"-foo-bar-baz-"
- "%foo%bar%baz%"
+ (unless (tramp--test-windows-nt-and-out-of-band-p) "%foo%bar%baz%")
"&foo&bar&baz&"
(unless (or (tramp--test-ftp-p)
(tramp--test-gvfs-p)
@@ -6066,9 +6336,10 @@ This requires restrictions of file name syntax."
"'foo'bar'baz'"
"'foo\"bar'baz\"")
"#foo~bar#baz~"
- (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
- "!foo!bar!baz!"
- "!foo|bar!baz|")
+ (unless (tramp--test-windows-nt-and-out-of-band-p)
+ (if (or (tramp--test-gvfs-p) (tramp--test-windows-nt-or-smb-p))
+ "!foo!bar!baz!"
+ "!foo|bar!baz|"))
(if (or (tramp--test-gvfs-p)
(tramp--test-rclone-p)
(tramp--test-windows-nt-or-smb-p))
@@ -6085,24 +6356,21 @@ This requires restrictions of file name syntax."
files (list (mapconcat #'identity files ""))))))
;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test40-special-characters ()
+(ert-deftest tramp-test41-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(tramp--test-special-characters))
-(ert-deftest tramp-test40-special-characters-with-stat ()
+(ert-deftest tramp-test41-special-characters-with-stat ()
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6114,15 +6382,13 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test40-special-characters-with-perl ()
+(ert-deftest tramp-test41-special-characters-with-perl ()
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6137,15 +6403,13 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test40-special-characters-with-ls ()
+(ert-deftest tramp-test41-special-characters-with-ls ()
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6160,7 +6424,7 @@ Use the `ls' command."
(tramp--test-special-characters)))
(defun tramp--test-utf8 ()
- "Perform the test in `tramp-test41-utf8*'."
+ "Perform the test in `tramp-test42-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
@@ -6201,17 +6465,17 @@ Use the `ls' command."
x ""))
(not (string-empty-p x))
;; ?\n and ?/ shouldn't be part of any file name. ?\t,
- ;; ?. and ?? do not work for "smb" method.
- (replace-regexp-in-string "[\t\n/.?]" "" x)))
+ ;; ?. and ?? do not work for "smb" method. " " does not
+ ;; work at begin or end of the string for MS Windows.
+ (replace-regexp-in-string "[ \t\n/.?]" "" x)))
language-info-alist)))))))
-(ert-deftest tramp-test41-utf8 ()
+(ert-deftest tramp-test42-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-gdrive-p)))
(skip-unless (not (tramp--test-crypt-p)))
@@ -6219,7 +6483,7 @@ Use the `ls' command."
(tramp--test-utf8))
-(ert-deftest tramp-test41-utf8-with-stat ()
+(ert-deftest tramp-test42-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
@@ -6227,11 +6491,9 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@@ -6243,7 +6505,7 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test41-utf8-with-perl ()
+(ert-deftest tramp-test42-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
@@ -6251,11 +6513,9 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@@ -6270,7 +6530,7 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test41-utf8-with-ls ()
+(ert-deftest tramp-test42-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
@@ -6278,11 +6538,9 @@ Use the `ls' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-rsync-p)))
- (skip-unless (not (tramp--test-windows-nt-and-batch-p)))
- (skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
+ (skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
- (skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@@ -6296,7 +6554,7 @@ Use the `ls' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test42-file-system-info ()
+(ert-deftest tramp-test43-file-system-info ()
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
;; Since Emacs 27.1.
@@ -6313,16 +6571,17 @@ Use the `ls' command."
(numberp (nth 1 fsi))
(numberp (nth 2 fsi))))))
-;; `tramp-test43-asynchronous-requests' could be blocked. So we set a
+;; `tramp-test44-asynchronous-requests' could be blocked. So we set a
;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300
;; seconds. Similar check is performed in the timer function.
(defconst tramp--test-asynchronous-requests-timeout 300
- "Timeout for `tramp-test43-asynchronous-requests'.")
+ "Timeout for `tramp-test44-asynchronous-requests'.")
(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
"Set \"process-name\" and \"process-buffer\" connection properties.
The values are derived from PROC. Run BODY.
This is needed in timer functions as well as process filters and sentinels."
+ ;; FIXME: For tramp-sshfs.el, `processp' does not work.
(declare (indent 1) (debug (processp body)))
`(let* ((v (tramp-get-connection-property ,proc "vector" nil))
(pname (tramp-get-connection-property v "process-name" nil))
@@ -6352,7 +6611,7 @@ This is needed in timer functions as well as process filters and sentinels."
(tramp-flush-connection-property v "process-buffer")))))
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test43-asynchronous-requests ()
+(ert-deftest tramp-test44-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@@ -6372,7 +6631,7 @@ process sentinels. They shall not disturb each other."
(define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
(let* (;; For the watchdog.
(default-directory (expand-file-name temporary-file-directory))
- (shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
+ (shell-file-name (tramp--test-shell-file-name))
;; It doesn't work on w32 systems.
(watchdog
(start-process-shell-command
@@ -6552,11 +6811,11 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
-;; (tramp--test--deftest-direct-async-process tramp-test43-asynchronous-requests
+;; (tramp--test--deftest-direct-async-process tramp-test44-asynchronous-requests
;; "Check parallel direct asynchronous requests." 'unstable)
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test44-auto-load ()
+(ert-deftest tramp-test45-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
@@ -6581,7 +6840,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test44-delay-load ()
+(ert-deftest tramp-test45-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
@@ -6614,7 +6873,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
-(ert-deftest tramp-test44-recursive-load ()
+(ert-deftest tramp-test45-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -6638,7 +6897,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test44-remote-load-path ()
+(ert-deftest tramp-test45-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; The autoloaded Tramp objects are different since Emacs 26.1. We
;; cannot test older Emacsen, therefore.
@@ -6667,7 +6926,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test45-unload ()
+(ert-deftest tramp-test46-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@@ -6730,8 +6989,8 @@ Since it unloads Tramp, it shall be the last test to run."
If INTERACTIVE is non-nil, the tests are run interactively."
(interactive "p")
(funcall
- (if interactive
- #'ert-run-tests-interactively #'ert-run-tests-batch) "^tramp"))
+ (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
+ "^tramp"))
;; TODO:
@@ -6747,9 +7006,10 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
-;; * Implement `tramp-test31-interrupt-process' for `adb' and for
-;; direct async processes.
-;; * Fix `tramp-test44-threads'.
+;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and
+;; for direct async processes.
+;; * Check, why direct async processes do not work for
+;; `tramp-test44-asynchronous-requests'.
(provide 'tramp-tests)
diff --git a/test/lisp/nxml/nxml-mode-tests.el b/test/lisp/nxml/nxml-mode-tests.el
index 4baab1f7600..7824691333e 100644
--- a/test/lisp/nxml/nxml-mode-tests.el
+++ b/test/lisp/nxml/nxml-mode-tests.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/nxml/xsd-regexp-tests.el b/test/lisp/nxml/xsd-regexp-tests.el
index 4dbc8999247..2194602dbec 100644
--- a/test/lisp/nxml/xsd-regexp-tests.el
+++ b/test/lisp/nxml/xsd-regexp-tests.el
@@ -2,6 +2,8 @@
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; This file is part of GNU Emacs.
+
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el
index 4a5f4f872b6..0e02e1ca1bc 100644
--- a/test/lisp/obsolete/cl-tests.el
+++ b/test/lisp/obsolete/cl-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/obsolete/inversion-tests.el b/test/lisp/obsolete/inversion-tests.el
new file mode 100644
index 00000000000..c8b45d67ea1
--- /dev/null
+++ b/test/lisp/obsolete/inversion-tests.el
@@ -0,0 +1,81 @@
+;;; inversion-tests.el --- Tests for inversion.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Moved here from test/manual/cedet/cedet-utests.el
+
+;;; Code:
+
+(require 'inversion)
+(require 'ert)
+
+(ert-deftest inversion-unit-test ()
+ "Test inversion to make sure it can identify different version strings."
+ (interactive)
+ (let ((c1 (inversion-package-version 'inversion))
+ (c1i (inversion-package-incompatibility-version 'inversion))
+ (c2 (inversion-decode-version "1.3alpha2"))
+ (c3 (inversion-decode-version "1.3beta4"))
+ (c4 (inversion-decode-version "1.3 beta5"))
+ (c5 (inversion-decode-version "1.3.4"))
+ (c6 (inversion-decode-version "2.3alpha"))
+ (c7 (inversion-decode-version "1.3"))
+ (c8 (inversion-decode-version "1.3pre1"))
+ (c9 (inversion-decode-version "2.4 (patch 2)"))
+ (c10 (inversion-decode-version "2.4 (patch 3)"))
+ (c11 (inversion-decode-version "2.4.2.1"))
+ (c12 (inversion-decode-version "2.4.2.2")))
+ (should (inversion-= c1 c1))
+ (should (inversion-< c1i c1))
+ (should (inversion-< c2 c3))
+ (should (inversion-< c3 c4))
+ (should (inversion-< c4 c5))
+ (should (inversion-< c5 c6))
+ (should (inversion-< c2 c4))
+ (should (inversion-< c2 c5))
+ (should (inversion-< c2 c6))
+ (should (inversion-< c3 c5))
+ (should (inversion-< c3 c6))
+ (should (inversion-< c7 c6))
+ (should (inversion-< c4 c7))
+ (should (inversion-< c2 c7))
+ (should (inversion-< c8 c6))
+ (should (inversion-< c8 c7))
+ (should (inversion-< c4 c8))
+ (should (inversion-< c2 c8))
+ (should (inversion-< c9 c10))
+ (should (inversion-< c10 c11))
+ (should (inversion-< c11 c12))
+ ;; Negatives
+ (should-not (inversion-< c3 c2))
+ (should-not (inversion-< c4 c3))
+ (should-not (inversion-< c5 c4))
+ (should-not (inversion-< c6 c5))
+ (should-not (inversion-< c7 c2))
+ (should-not (inversion-< c7 c8))
+ (should-not (inversion-< c12 c11))
+ ;; Test the tester on inversion
+ (should-not (inversion-test 'inversion inversion-version))
+ (should (stringp (inversion-test 'inversion "0.0.0")))
+ (should (stringp (inversion-test 'inversion "1000.0")))))
+
+;;; inversion-tests.el ends here
diff --git a/test/lisp/play/cookie1-resources/cookies b/test/lisp/play/cookie1-resources/cookies
new file mode 100644
index 00000000000..7bf569fa7d6
--- /dev/null
+++ b/test/lisp/play/cookie1-resources/cookies
@@ -0,0 +1,8 @@
+This fortune intentionally left blank.
+%
+This fortune intentionally not included.
+%
+This fortune intentionally says nothing.
+%
+This fortune is false.
+%
diff --git a/test/lisp/play/cookie1-tests.el b/test/lisp/play/cookie1-tests.el
new file mode 100644
index 00000000000..75dea4e5ef0
--- /dev/null
+++ b/test/lisp/play/cookie1-tests.el
@@ -0,0 +1,40 @@
+;;; cookie1-tests.el --- Tests for cookie1.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'cookie1)
+
+(ert-deftest cookie1-tests-cookie ()
+ (let ((fortune-file (ert-resource-file "cookies")))
+ (should (string-match "\\`This fortune"
+ (cookie fortune-file)))))
+
+(ert-deftest cookie1-testss-cookie-apropos ()
+ (let ((fortune-file (ert-resource-file "cookies")))
+ (should (string-match "\\`This fortune"
+ (car (cookie-apropos "false" fortune-file))))
+ (should (= (length (cookie-apropos "false" fortune-file)) 1))))
+
+(provide 'fortune-tests)
+;;; fortune-tests.el ends here
diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el
index da6a1e641c7..2a3bb3dafae 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -31,9 +31,6 @@
(require 'compile)
(defconst compile-tests--test-regexps-data
- ;; The computed column numbers are zero-indexed, so subtract 1 from
- ;; what's reported in the string. The end column numbers are for
- ;; the character after, so it matches what's reported in the string.
'(;; absoft
(absoft
"Error on line 3 of t.f: Execution error unclassifiable statement"
@@ -61,7 +58,7 @@
(ant "[javac] /src/DataBaseTestCase.java:49: warning: finally clause cannot complete normally"
13 nil 49 "/src/DataBaseTestCase.java" 1)
(ant "[jikes] foo.java:3:5:7:9: blah blah"
- 14 (5 . 10) (3 . 7) "foo.java" 2)
+ 14 (5 . 9) (3 . 7) "foo.java" 2)
(ant "[javac] c:/cygwin/Test.java:12: error: foo: bar"
9 nil 12 "c:/cygwin/Test.java" 2)
(ant "[javac] c:\\cygwin\\Test.java:87: error: foo: bar"
@@ -86,10 +83,10 @@
;; caml
(python-tracebacks-and-caml
"File \"foobar.ml\", lines 5-8, characters 20-155: blah blah"
- 1 (20 . 156) (5 . 8) "foobar.ml")
+ 1 (20 . 155) (5 . 8) "foobar.ml")
(python-tracebacks-and-caml
"File \"F:\\ocaml\\sorting.ml\", line 65, characters 2-145:\nWarning 26: unused variable equ."
- 1 (2 . 146) 65 "F:\\ocaml\\sorting.ml")
+ 1 (2 . 145) 65 "F:\\ocaml\\sorting.ml")
(python-tracebacks-and-caml
"File \"/usr/share/gdesklets/display/TargetGauge.py\", line 41, in add_children"
1 nil 41 "/usr/share/gdesklets/display/TargetGauge.py")
@@ -231,12 +228,12 @@
(gnu "foo.c:8.23: note: message" 1 23 8 "foo.c")
(gnu "foo.c:8.23: info: message" 1 23 8 "foo.c")
(gnu "foo.c:8:23:information: message" 1 23 8 "foo.c")
- (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 46) (8 . nil) "foo.c")
+ (gnu "foo.c:8.23-45: Informational: message" 1 (23 . 45) (8 . nil) "foo.c")
(gnu "foo.c:8-23: message" 1 nil (8 . 23) "foo.c")
;; The next one is not in the GNU standards AFAICS.
;; Here we seem to interpret it as LINE1-LINE2.COL2.
- (gnu "foo.c:8-45.3: message" 1 (nil . 4) (8 . 45) "foo.c")
- (gnu "foo.c:8.23-9.1: message" 1 (23 . 2) (8 . 9) "foo.c")
+ (gnu "foo.c:8-45.3: message" 1 (nil . 3) (8 . 45) "foo.c")
+ (gnu "foo.c:8.23-9.1: message" 1 (23 . 1) (8 . 9) "foo.c")
(gnu "jade:dbcommon.dsl:133:17:E: missing argument for function call"
1 17 133 "dbcommon.dsl")
(gnu "G:/cygwin/dev/build-myproj.xml:54: Compiler Adapter 'javac' can't be found."
@@ -472,8 +469,11 @@ can only work with the NUL byte to disambiguate colons.")
(when file
(should (equal (caar (compilation--loc->file-struct loc)) file)))
(when end-col
+ ;; The computed END-COL is exclusive; subtract one to get the
+ ;; number in the error message.
(should (equal
- (car (cadr (nth 2 (compilation--loc->file-struct loc))))
+ (1- (car (cadr
+ (nth 2 (compilation--loc->file-struct loc)))))
end-col)))
(should (equal (car (nth 2 (compilation--loc->file-struct loc)))
(or end-line line)))
@@ -515,4 +515,31 @@ The test data is in `compile-tests--grep-regexp-testcases'."
(compile--test-error-line testcase))
(should (eq compilation-num-errors-found 8))))
+(ert-deftest compile-test-functions ()
+ "Test rules using functions instead of regexp group numbers."
+ (let* ((file-fun (lambda () '("my-file")))
+ (line-start-fun (lambda () 123))
+ (line-end-fun (lambda () 134))
+ (col-start-fun (lambda () 39))
+ (col-end-fun (lambda () 24))
+ (compilation-error-regexp-alist-alist
+ `((my-rule
+ ,(rx bol "My error message")
+ ,file-fun
+ (,line-start-fun . ,line-end-fun)
+ (,col-start-fun . ,col-end-fun))))
+ (compilation-error-regexp-alist '(my-rule)))
+ (with-temp-buffer
+ (font-lock-mode -1)
+ (let ((compilation-num-errors-found 0)
+ (compilation-num-warnings-found 0)
+ (compilation-num-infos-found 0))
+ (compile--test-error-line
+ '(my-rule
+ "My error message"
+ 1 (39 . 24) (123 . 134) "my-file" 2))
+ (should (eq compilation-num-errors-found 1))
+ (should (eq compilation-num-warnings-found 0))
+ (should (eq compilation-num-infos-found 0))))))
+
;;; compile-tests.el ends here
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl
new file mode 100644
index 00000000000..f54d55241df
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-22355.pl
@@ -0,0 +1,14 @@
+# The source file contains non-ASCII characters, supposed to be saved
+# in UTF-8 encoding. Tell Perl about that, just in case.
+use utf8;
+
+# Following code is the example from the report Bug#22355 which needed
+# attention in perl-mode.
+
+printf qq
+{<?xml version="1.0" encoding="UTF-8"?>
+<kml xmlns="http://www.opengis.net/kml/2.2">
+ <Document>
+ <Folder><name>台灣 %s 廣播電台</name>
+ <description><![CDATA[http://radioscanningtw.wikia.com/wiki/台描:地圖 %d-%02d-%02d]]></description>
+}, uc( substr( $ARGV[0], 0, 2 ) ), $year + 1900, $mon + 1, $mday;
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl
new file mode 100644
index 00000000000..1db639c6aa2
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-23992.pl
@@ -0,0 +1,10 @@
+# Test file for Bug#23992
+#
+# The "||" case is directly from the report,
+# the "&&" case has been added for symmetry.
+
+s/LEFT/L/g || s/RIGHT/R/g || s/aVALUE\D+//g;
+s/LEFT/L/g||s/RIGHT/R/g||s/aVALUE\D+//g;
+
+s/LEFT/L/g && s/RIGHT/R/g && s/aVALUE\D+//g;
+s/LEFT/L/g&&s/RIGHT/R/g&&s/aVALUE\D+//g;
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl
new file mode 100644
index 00000000000..0987b4e02c0
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-25098.pl
@@ -0,0 +1,21 @@
+# Code from the bug report Bug#25098
+
+my $good = XML::LibXML->load_xml( string => q{<div class="clearfix">});
+my $bad = XML::LibXML->load_xml( string =>q{<div class="clearfix">});
+
+# Related: Method calls are no quotelike operators. That's why you
+# can't just add '>' to the character class.
+
+my $method_call = $object->q(argument);
+
+# Also related, still not fontified correctly:
+#
+# my $method_call = $object -> q (argument);
+#
+# perl-mode interprets the method call as a quotelike op (because it
+# is preceded by a space).
+# cperl-mode gets the argument right, but marks q as a quotelike op.
+#
+# my $greater = 2>q/1/;
+#
+# perl-mode doesn't identify this as a quotelike op.
diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl
new file mode 100644
index 00000000000..c05fd7efc2a
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl
@@ -0,0 +1,158 @@
+use 5.024;
+use strict;
+use warnings;
+
+sub outside {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}'";
+}
+
+package Package;
+
+=head1 NAME
+
+grammar - A Test resource for regular expressions
+
+=head1 SYNOPSIS
+
+A Perl file showing a variety of declarations
+
+=head1 DESCRIPTION
+
+This file offers several syntactical constructs for packages,
+subroutines, and POD to test the imenu capabilities of CPerl mode.
+
+Perl offers syntactical variations for package and subroutine
+declarations. Packages may, or may not, have a version and may, or
+may not, have a block of code attached to them. Subroutines can have
+old-style prototypes, attributes, and signatures which are still
+experimental but widely accepted.
+
+Various Extensions and future Perl versions will probably add new
+keywords for "class" and "method", both with syntactical extras of
+their own.
+
+This test file tries to keep up with them.
+
+=head2 Details
+
+The code is supposed to identify and exclude false positives,
+e.g. declarations in a string or in POD, as well as POD in a string.
+These should not go into the imenu index.
+
+=cut
+
+our $VERSION = 3.1415;
+say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+sub in_package {
+ # Special test for POD: A line which looks like POD, but actually
+ # is part of a multiline string. In the case shown here, the
+ # semicolon is not part of the string, but POD headings go to the
+ # end of the line. The code needs to distinguish between a POD
+ # heading "This Is Not A Pod/;" and a multiline string.
+ my $not_a_pod = q/Another false positive:
+
+=head1 This Is Not A Pod/;
+
+}
+
+sub Shoved::elsewhere {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', sub Shoved::elsewhere";
+}
+
+sub prototyped ($$) {
+ ...;
+}
+
+package Versioned::Package 0.07;
+say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+sub versioned {
+ # This sub is in package Versioned::Package
+ say "sub 'versioned' in package '", __PACKAGE__, "'";
+}
+
+versioned();
+
+my $false_positives = <<'EOH';
+The following declarations are not supposed to be recorded for imenu.
+They are in a HERE-doc, which is a generic comment in CPerl mode.
+
+package Don::T::Report::This;
+sub this_is_no_sub {
+ my $self = shuffle;
+}
+
+And this is not a POD heading:
+
+=head1 Not a POD heading, just a string.
+
+EOH
+
+package Block {
+ our $VERSION = 2.7182;
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+ sub attr:lvalue {
+ say "sub 'attr' in package '", __PACKAGE__, "'";
+ }
+
+ attr();
+
+ package Block::Inner {
+ # This hopefully doesn't happen too often.
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+ }
+
+ # Now check that we're back to package "Block"
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+}
+
+sub outer {
+ # This is in package Versioned::Package
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+}
+
+outer();
+
+package Versioned::Block 42 {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+ my sub lexical {
+ say "sub 'lexical' in package '", __PACKAGE__, "'";
+ }
+
+ lexical();
+
+ use experimental 'signatures';
+ sub signatured :prototype($@) ($self,@rest)
+ {
+ ...;
+ }
+}
+
+# After all is said and done, we're back in package Versioned::Package.
+say "We're in package '", __PACKAGE__, "' now.";
+say "Now try to call a subroutine which went out of scope:";
+eval { lexical() };
+say $@ if $@;
+
+# Now back to Package. This must not appear separately in the
+# hierarchy list.
+package Package;
+
+our sub in_package_again {
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+}
+
+
+package :: {
+ # This is just a weird, but legal, package name.
+ say "Line @{[__LINE__]}: package '@{[__PACKAGE__]}', version $VERSION";
+
+ in_package_again(); # weird, but calls the sub from above
+}
+
+Shoved::elsewhere();
+
+1;
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
index 943c454445c..4d2bac6ee47 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -1,4 +1,4 @@
-;;; cperl-mode-tests --- Test for cperl-mode -*- lexical-binding: t -*-
+;;; cperl-mode-tests.el --- Test for cperl-mode -*- lexical-binding: t -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
@@ -37,7 +37,7 @@
;;; Utilities
(defun cperl-test-ppss (text regexp)
- "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
+ "Return the `syntax-ppss' after the last character matched by REGEXP in TEXT."
(interactive)
(with-temp-buffer
(insert text)
@@ -135,6 +135,28 @@ point in the distant past, and is still broken in perl-mode. "
(should (equal (nth 3 (syntax-ppss)) nil))
(should (equal (nth 4 (syntax-ppss)) t))))))
+(ert-deftest cperl-test-fontify-declarations ()
+ "Test that declarations and package usage use consistent fontification."
+ (with-temp-buffer
+ (funcall cperl-test-mode)
+ (insert "package Foo::Bar;\n")
+ (insert "use Fee::Fie::Foe::Foo\n;")
+ (insert "my $xyzzy = 'PLUGH';\n")
+ (goto-char (point-min))
+ (font-lock-ensure)
+ (search-forward "Bar")
+ (should (equal (get-text-property (match-beginning 0) 'face)
+ 'font-lock-function-name-face))
+ (search-forward "use") ; This was buggy in perl-mode
+ (should (equal (get-text-property (match-beginning 0) 'face)
+ 'font-lock-keyword-face))
+ (search-forward "my")
+ (should (equal (get-text-property (match-beginning 0) 'face)
+ 'font-lock-keyword-face))))
+
+(defvar perl-continued-statement-offset)
+(defvar perl-indent-level)
+
(ert-deftest cperl-test-heredocs ()
"Test that HERE-docs are fontified with the appropriate face."
(require 'perl-mode)
@@ -166,6 +188,101 @@ point in the distant past, and is still broken in perl-mode. "
(if (match-beginning 3) 0
perl-indent-level)))))))
+;;; Grammar based tests: unit tests
+
+(defun cperl-test--validate-regexp (regexp valid &optional invalid)
+ "Runs tests for elements of VALID and INVALID lists against REGEXP.
+Tests with elements from VALID must match, tests with elements
+from INVALID must not match. The match string must be equal to
+the whole string."
+ (funcall cperl-test-mode)
+ (dolist (string valid)
+ (should (string-match regexp string))
+ (should (string= (match-string 0 string) string)))
+ (when invalid
+ (dolist (string invalid)
+ (should-not
+ (and (string-match regexp string)
+ (string= (match-string 0 string) string))))))
+
+(ert-deftest cperl-test-ws-regexp ()
+ "Tests capture of very simple regular expressions (yawn)."
+ (let ((valid
+ '(" " "\t" "\n"))
+ (invalid
+ '("a" " " "")))
+ (cperl-test--validate-regexp cperl--ws-regexp
+ valid invalid)))
+
+(ert-deftest cperl-test-ws-or-comment-regexp ()
+ "Tests sequences of whitespace and comment lines."
+ (let ((valid
+ `(" " "\t#\n" "\n# \n"
+ ,(concat "# comment\n" "# comment\n" "\n" "#comment\n")))
+ (invalid
+ '("=head1 NAME\n" )))
+ (cperl-test--validate-regexp cperl--ws-or-comment-regexp
+ valid invalid)))
+
+(ert-deftest cperl-test-version-regexp ()
+ "Tests the regexp for recommended syntax of versions in Perl."
+ (let ((valid
+ '("1" "1.1" "1.1_1" "5.032001"
+ "v120.100.103"))
+ (invalid
+ '("alpha" "0." ".123" "1E2"
+ "v1.1" ; a "v" version string needs at least 3 components
+ ;; bad examples from "Version numbers should be boring"
+ ;; by xdg AKA David A. Golden
+ "1.20alpha" "2.34beta2" "2.00R3")))
+ (cperl-test--validate-regexp cperl--version-regexp
+ valid invalid)))
+
+(ert-deftest cperl-test-package-regexp ()
+ "Tests the regular expression of Perl package names with versions.
+Also includes valid cases with whitespace in strange places."
+ (let ((valid
+ '("package Foo"
+ "package Foo::Bar"
+ "package Foo::Bar v1.2.3"
+ "package Foo::Bar::Baz 1.1"
+ "package \nFoo::Bar\n 1.00"))
+ (invalid
+ '("package Foo;" ; semicolon must not be included
+ "package Foo 1.1 {" ; nor the opening brace
+ "packageFoo" ; not a package declaration
+ "package Foo1.1" ; invalid package name
+ "class O3D::Sphere"))) ; class not yet supported
+ (cperl-test--validate-regexp cperl--package-regexp
+ valid invalid)))
+
+;;; Function test: Building an index for imenu
+
+(ert-deftest cperl-test-imenu-index ()
+ "Test index creation for imenu.
+This test relies on the specific layout of the index alist as
+created by CPerl mode, so skip it for Perl mode."
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "grammar.pl"))
+ (cperl-mode)
+ (let ((index (cperl-imenu--create-perl-index))
+ current-list)
+ (setq current-list (assoc-string "+Unsorted List+..." index))
+ (should current-list)
+ (let ((expected '("(main)::outside"
+ "Package::in_package"
+ "Shoved::elsewhere"
+ "Package::prototyped"
+ "Versioned::Package::versioned"
+ "Block::attr"
+ "Versioned::Package::outer"
+ "lexical"
+ "Versioned::Block::signatured"
+ "Package::in_package_again")))
+ (dolist (sub expected)
+ (should (assoc-string sub index)))))))
+
;;; Tests for issues reported in the Bug Tracker
(defun cperl-test--run-bug-10483 ()
@@ -260,6 +377,55 @@ documentation it does the right thing anyway."
(cperl-indent-command)
(forward-line 1))))
+(ert-deftest cperl-test-bug-22355 ()
+ "Verify that substitutions are fontified directly after \"|&\".
+Regular expressions are strings in both perl-mode and cperl-mode."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-22355.pl"))
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ ;; Just check for the start of the string
+ (search-forward "{")
+ (should (nth 3 (syntax-ppss)))))
+
+(ert-deftest cperl-test-bug-23992 ()
+ "Verify that substitutions are fontified directly after \"|&\".
+Regular expressions are strings in both perl-mode and cperl-mode."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-23992.pl"))
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ ;; "or" operator, with spaces
+ (search-forward "RIGHT")
+ (should (nth 3 (syntax-ppss)))
+ ;; "or" operator, without spaces
+ (search-forward "RIGHT")
+ (should (nth 3 (syntax-ppss)))
+ ;; "and" operator, with spaces
+ (search-forward "RIGHT")
+ (should (nth 3 (syntax-ppss)))
+ ;; "and" operator, without spaces
+ (search-forward "RIGHT")
+ (should (nth 3 (syntax-ppss)))))
+
+(ert-deftest cperl-test-bug-25098 ()
+ "Verify that a quotelike operator is recognized after a fat comma \"=>\".
+Related, check that calling a method named q is not mistaken as a
+quotelike operator."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-25098.pl"))
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ ;; good example from the bug report, with a space
+ (search-forward "q{")
+ (should (nth 3 (syntax-ppss)))
+ ;; bad (but now fixed) example from the bug report, without space
+ (search-forward "q{")
+ (should (nth 3 (syntax-ppss)))
+ ;; calling a method "q" (parens instead of braces to make it valid)
+ (search-forward "q(")
+ (should-not (nth 3 (syntax-ppss)))))
+
(ert-deftest cperl-test-bug-28650 ()
"Verify that regular expressions are recognized after 'return'.
The test uses the syntax property \"inside a string\" for the
@@ -331,14 +497,14 @@ If seen as regular expression, then the slash is displayed using
font-lock-constant-face. If seen as a division, then it doesn't
have a face property."
:tags '(:fontification)
- ;; The next two Perl expressions have divisions. Perl "punctuation"
- ;; operators don't get a face.
+ ;; The next two Perl expressions have divisions. The slash does not
+ ;; start a string.
(let ((code "{ $a++ / $b }"))
(should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
(let ((code "{ $a-- / $b }"))
(should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
- ;; The next two Perl expressions have regular expressions. The
- ;; delimiter of a RE is fontified with font-lock-constant-face.
+ ;; The next two Perl expressions have regular expressions. The slash
+ ;; starts a string.
(let ((code "{ $a+ / $b } # /"))
(should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
(let ((code "{ $a- / $b } # /"))
@@ -352,4 +518,86 @@ have a face property."
;; The yadda-yadda operator should not be in a string.
(should (equal (nth 8 (cperl-test-ppss code "\\.")) nil))))
+(ert-deftest cperl-test-bug-47112 ()
+ "Check that in a bareword starting with a quote-like operator
+followed by an underscore is not interpreted as that quote-like
+operator. Also check that a quote-like operator followed by a
+colon (which is, like ?_, a symbol in CPerl mode) _is_ identified
+as that quote like operator."
+ (with-temp-buffer
+ (funcall cperl-test-mode)
+ (insert "sub y_max { q:bar:; y _bar_foo_; }")
+ (goto-char (point-min))
+ (syntax-propertize (point-max))
+ (font-lock-ensure)
+ (search-forward "max")
+ (should (equal (get-text-property (match-beginning 0) 'face)
+ 'font-lock-function-name-face))
+ (search-forward "bar")
+ (should (equal (get-text-property (match-beginning 0) 'face)
+ 'font-lock-string-face))
+ ; perl-mode doesn't highlight
+ (when (eq cperl-test-mode #'cperl-mode)
+ (search-forward "_")
+ (should (equal (get-text-property (match-beginning 0) 'face)
+ (if (eq cperl-test-mode #'cperl-mode)
+ 'font-lock-constant-face
+ font-lock-string-face))))))
+
+(ert-deftest cperl-test-hyperactive-electric-else ()
+ "Demonstrate cperl-electric-else behavior.
+If `cperl-electric-keywords' is true, keywords like \"else\" and
+\"continue\" are expanded by a following empty block, with the
+cursor in the appropriate position to write that block. This,
+however, must not happen when the keyword occurs in a variable
+\"$else\" or \"$continue\"."
+ (skip-unless (eq cperl-test-mode #'cperl-mode))
+ ;; `self-insert-command' takes a second argument only since Emacs 27
+ (skip-unless (not (< emacs-major-version 27)))
+ (with-temp-buffer
+ (setq cperl-electric-keywords t)
+ (cperl-mode)
+ (insert "continue")
+ (self-insert-command 1 ?\ )
+ (indent-region (point-min) (point-max))
+ (goto-char (point-min))
+ ;; cperl-mode creates a block here
+ (should (search-forward-regexp "continue {\n[[:blank:]]+\n}")))
+ (with-temp-buffer
+ (setq cperl-electric-keywords t)
+ (cperl-mode)
+ (insert "$continue")
+ (self-insert-command 1 ?\ )
+ (indent-region (point-min) (point-max))
+ (goto-char (point-min))
+ ;; No block should have been created here
+ (should-not (search-forward-regexp "{" nil t))))
+
+(ert-deftest cperl-test-bug-47598 ()
+ "Check that a file test followed by ? is no longer interpreted
+as a regex."
+ ;; Testing the text from the bug report
+ (with-temp-buffer
+ (insert "my $f = -f ? 'file'\n")
+ (insert " : -l ? [readlink]\n")
+ (insert " : -d ? 'dir'\n")
+ (insert " : 'unknown';\n")
+ (funcall cperl-test-mode)
+ ;; Perl mode doesn't highlight file tests as functions, so we
+ ;; can't test for the function's face. But we can verify that the
+ ;; function is not a string.
+ (goto-char (point-min))
+ (search-forward "?")
+ (should-not (nth 3 (syntax-ppss (point)))))
+ ;; Testing the actual targets for the regexp: m?foo? (still valid)
+ ;; and ?foo? (invalid since Perl 5.22)
+ (with-temp-buffer
+ (insert "m?foo?;")
+ (funcall cperl-test-mode)
+ (should (nth 3 (syntax-ppss 3))))
+ (with-temp-buffer
+ (insert " ?foo?;")
+ (funcall cperl-test-mode)
+ (should-not (nth 3 (syntax-ppss 3)))))
+
;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index badcad670c2..f47d54e59c0 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -398,18 +398,21 @@ to (xref-elisp-test-descr-to-target xref)."
"(cl-defstruct (xref-elisp-location")
))
+(require 'em-xtra)
+(require 'find-dired)
(xref-elisp-deftest find-defs-defalias-defun-el
- (elisp--xref-find-definitions 'Buffer-menu-sort)
+ (elisp--xref-find-definitions 'eshell/ff)
(list
- (xref-make "(defalias Buffer-menu-sort)"
+ (xref-make "(defalias eshell/ff)"
(xref-make-elisp-location
- 'Buffer-menu-sort 'defalias
- (expand-file-name "../../../lisp/buff-menu.elc" emacs-test-dir)))
- (xref-make "(defun tabulated-list-sort)"
+ 'eshell/ff 'defalias
+ (expand-file-name "../../../lisp/eshell/em-xtra.elc"
+ emacs-test-dir)))
+ (xref-make "(defun find-name-dired)"
(xref-make-elisp-location
- 'tabulated-list-sort nil
- (expand-file-name "../../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir)))
- ))
+ 'find-name-dired nil
+ (expand-file-name "../../../lisp/find-dired.el"
+ emacs-test-dir)))))
;; FIXME: defconst
diff --git a/test/lisp/progmodes/executable-tests.el b/test/lisp/progmodes/executable-tests.el
new file mode 100644
index 00000000000..4f0fa699f72
--- /dev/null
+++ b/test/lisp/progmodes/executable-tests.el
@@ -0,0 +1,51 @@
+;;; executable-tests.el --- Tests for executable.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'executable)
+
+(ert-deftest executable-tests-set-magic ()
+ (with-temp-buffer
+ (insert "#!/foo/bar")
+ (executable-set-magic "/bin/bash" nil t t)
+ (should (equal (buffer-string) "#!/bin/bash"))))
+
+(ert-deftest executable-tests-set-magic/with-argument ()
+ (with-temp-buffer
+ (insert "#!/foo/bar")
+ (executable-set-magic "/bin/bash" "--norc" t t)
+ (should (equal (buffer-string) "#!/bin/bash --norc"))))
+
+(ert-deftest executable-tests-set-magic/executable-insert-nil ()
+ (let ((executable-insert nil))
+ (with-temp-buffer
+ (insert "#!/foo/bar")
+ (executable-set-magic "/bin/bash" nil t nil)
+ (should (equal (buffer-string) "#!/foo/bar"))))
+ (let ((executable-insert nil))
+ (with-temp-buffer
+ (insert "#!/foo/bar")
+ (executable-set-magic "/bin/bash" nil t t)
+ (should (equal (buffer-string) "#!/bin/bash")))))
+
+;;; executable-tests.el ends here
diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el
index b3d12229d8f..330eab38c41 100644
--- a/test/lisp/progmodes/f90-tests.el
+++ b/test/lisp/progmodes/f90-tests.el
@@ -22,9 +22,6 @@
;;; Commentary:
-;; This file does not have "test" in the name, because it lives under
-;; a test/ directory, so that would be superfluous.
-
;;; Code:
(require 'ert)
diff --git a/test/lisp/progmodes/grep-tests.el b/test/lisp/progmodes/grep-tests.el
new file mode 100644
index 00000000000..205982238f2
--- /dev/null
+++ b/test/lisp/progmodes/grep-tests.el
@@ -0,0 +1,69 @@
+;;; grep-tests.el --- Test suite for grep.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'grep)
+
+(defconst grep-tests--ellipsis (if (char-displayable-p ?…) "[…]" "[...]")
+ "The form that the ellipsis takes in `grep-find-abbreviate-properties'.")
+
+(defun grep-tests--get-rgrep-abbreviation ()
+ "Get the `display' property of the excessive part of the rgrep command."
+ (with-temp-buffer
+ (grep-compute-defaults)
+ (insert (rgrep-default-command "search" "*" nil))
+ (grep-mode)
+ (font-lock-mode)
+ (font-lock-ensure)
+ (goto-char (point-min))
+ (re-search-forward "find ")
+ (get-text-property (point) 'display)))
+
+(defun grep-tests--check-rgrep-abbreviation ()
+ "Check that the excessive part of the rgrep command is abbreviated iff
+`grep-find-abbreviate' is non-nil."
+ (let ((grep-find-abbreviate t))
+ (should (equal (grep-tests--get-rgrep-abbreviation)
+ grep-tests--ellipsis)))
+ (let ((grep-find-abbreviate nil))
+ (should-not (grep-tests--get-rgrep-abbreviation))))
+
+(ert-deftest grep-tests--rgrep-abbreviate-properties-gnu-linux ()
+ (let ((system-type 'gnu/linux))
+ (grep-tests--check-rgrep-abbreviation)))
+
+(ert-deftest grep-tests--rgrep-abbreviate-properties-darwin ()
+ (let ((system-type 'darwin))
+ (grep-tests--check-rgrep-abbreviation)))
+
+(ert-deftest grep-tests--rgrep-abbreviate-properties-windows-nt-dos-semantics ()
+ (let ((system-type 'windows-nt))
+ (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'always))
+ (grep-tests--check-rgrep-abbreviation))))
+
+(ert-deftest grep-tests--rgrep-abbreviate-properties-windows-nt-sh-semantics ()
+ (let ((system-type 'windows-nt))
+ (cl-letf (((symbol-function 'w32-shell-dos-semantics) #'ignore))
+ (grep-tests--check-rgrep-abbreviation))))
+
+;;; grep-tests.el ends here
diff --git a/test/lisp/progmodes/octave-tests.el b/test/lisp/progmodes/octave-tests.el
new file mode 100644
index 00000000000..e28fe73b836
--- /dev/null
+++ b/test/lisp/progmodes/octave-tests.el
@@ -0,0 +1,49 @@
+;;; octave-tests.el --- Test suite for octave.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'octave)
+
+(defun octave-test--indent (string)
+ (with-temp-buffer
+ (octave-mode)
+ (insert string)
+ (indent-region (point-min) (point-max))
+ (buffer-string)))
+
+(ert-deftest octave-tests--continuation-indentation ()
+ (should
+ (equal (octave-test--indent "a = b + a * \\
+c;
+")
+ "a = b + a * \\
+ c;
+"))
+ (should (equal (octave-test--indent "a = \\
+b;
+")
+ "a = \\
+ b;
+")))
+
+;;; octave-tests.el ends here
diff --git a/test/lisp/progmodes/perl-mode-tests.el b/test/lisp/progmodes/perl-mode-tests.el
index 9f6800ccd63..3f4af5e1f61 100644
--- a/test/lisp/progmodes/perl-mode-tests.el
+++ b/test/lisp/progmodes/perl-mode-tests.el
@@ -1,4 +1,4 @@
-;;; perl-mode-tests --- Test for perl-mode -*- lexical-binding: t -*-
+;;; perl-mode-tests.el --- Test for perl-mode -*- lexical-binding: t -*-
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
@@ -21,6 +21,13 @@
(require 'perl-mode)
+(ert-deftest perl-test-lock ()
+ (with-temp-buffer
+ (perl-mode)
+ (insert "$package = foo;")
+ (font-lock-ensure (point-min) (point-max))
+ (should (equal (get-text-property 4 'face) 'font-lock-variable-name-face))))
+
;;;; Re-use cperl-mode tests
(defvar cperl-test-mode)
diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el
new file mode 100644
index 00000000000..68460a9fa5b
--- /dev/null
+++ b/test/lisp/progmodes/project-tests.el
@@ -0,0 +1,110 @@
+;;; project-tests.el --- tests for project.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; 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:
+
+;; Unit tests for progmodes/project.el.
+
+;;; Code:
+
+(require 'project)
+
+(require 'cl-lib)
+(require 'ert)
+(require 'grep)
+(require 'xref)
+
+(defmacro project-tests--with-temporary-directory (var &rest body)
+ "Create a new temporary directory.
+Bind VAR to the name of the directory, and evaluate BODY. Delete
+the directory after BODY exits."
+ (declare (debug (symbolp body)) (indent 1))
+ (cl-check-type var symbol)
+ (let ((directory (make-symbol "directory")))
+ `(let ((,directory (make-temp-file "project-tests-" :directory)))
+ (unwind-protect
+ (let ((,var ,directory))
+ ,@body)
+ (delete-directory ,directory :recursive)))))
+
+(ert-deftest project/quoted-directory ()
+ "Check that `project-files' and `project-find-regexp' deal with
+quoted directory names (Bug#47799)."
+ (skip-unless (executable-find find-program))
+ (skip-unless (executable-find "xargs"))
+ (skip-unless (executable-find "grep"))
+ (project-tests--with-temporary-directory directory
+ (let ((default-directory directory)
+ (project-current-inhibit-prompt t)
+ (project-find-functions nil)
+ (project-list-file
+ (expand-file-name "projects" directory))
+ (project (cons 'transient (file-name-quote directory)))
+ (file (expand-file-name "file" directory)))
+ (add-hook 'project-find-functions (lambda (_dir) project))
+ (should (eq (project-current) project))
+ (write-region "contents" nil file nil nil nil 'excl)
+ (should (equal (project-files project)
+ (list (file-name-quote file))))
+ (let* ((references nil)
+ (xref-search-program 'grep)
+ (xref-show-xrefs-function
+ (lambda (fetcher _display)
+ (push (funcall fetcher) references))))
+ (project-find-regexp "tent")
+ (pcase references
+ (`((,item))
+ ;; FIXME: Shouldn't `xref-match-item' be a subclass of
+ ;; `xref-item'?
+ (should (cl-typep item '(or xref-item xref-match-item)))
+ (should (file-equal-p
+ (xref-location-group (xref-item-location item))
+ file)))
+ (otherwise
+ (ert-fail (format-message "Unexpected references: %S"
+ otherwise))))))))
+
+(cl-defstruct project-tests--trivial root ignores)
+
+(cl-defmethod project-root ((project project-tests--trivial))
+ (project-tests--trivial-root project))
+
+(cl-defmethod project-ignores ((project project-tests--trivial) _dir)
+ (project-tests--trivial-ignores project))
+
+(ert-deftest project-ignores ()
+ "Check that `project-files' correctly ignores the files
+returned by `project-ignores' if the root directory is a
+directory name (Bug#48471)."
+ (skip-unless (executable-find find-program))
+ (project-tests--with-temporary-directory dir
+ (make-empty-file (expand-file-name "some-file" dir))
+ (make-empty-file (expand-file-name "ignored-file" dir))
+ (let* ((project (make-project-tests--trivial
+ :root (file-name-as-directory dir)
+ :ignores '("./ignored-file")))
+ (files (project-files project))
+ (relative-files
+ (cl-loop for file in files
+ collect (file-relative-name file dir))))
+ (should (equal relative-files '("some-file"))))))
+
+;;; project-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 3e653cb568a..1af579bb7a4 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -5432,6 +5432,30 @@ buffer with overlapping strings."
(run-python nil nil 'show)
(should (eq buffer (current-buffer)))))
+(ert-deftest python-tests--fill-long-first-line ()
+ (should
+ (equal
+ (with-temp-buffer
+ (insert "def asdf():
+ \"\"\"123 123 123 123 123 123 123 123 123 123 123 123 123 SHOULDBEWRAPPED 123 123 123 123
+
+ \"\"\"
+ a = 1
+")
+ (python-mode)
+ (goto-char (point-min))
+ (forward-line 1)
+ (end-of-line)
+ (fill-paragraph)
+ (buffer-substring-no-properties (point-min) (point-max)))
+ "def asdf():
+ \"\"\"123 123 123 123 123 123 123 123 123 123 123 123 123
+ SHOULDBEWRAPPED 123 123 123 123
+
+ \"\"\"
+ a = 1
+")))
+
(provide 'python-tests)
;; Local Variables:
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el
index 42a011c8bcd..8bdfdc310f3 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -32,6 +32,13 @@
(ruby-mode)
,@body))
+(defmacro ruby-with-temp-file (contents &rest body)
+ `(ruby-with-temp-buffer ,contents
+ (set-visited-file-name "ruby-mode-tests")
+ ,@body
+ (set-buffer-modified-p nil)
+ (delete-file buffer-file-name)))
+
(defun ruby-should-indent (content column)
"Assert indentation COLUMN on the last line of CONTENT."
(ruby-with-temp-buffer content
@@ -844,6 +851,52 @@ VALUES-PLIST is a list with alternating index and value elements."
(ruby--insert-coding-comment "utf-8")
(should (string= "# encoding: utf-8\n\n" (buffer-string))))))
+(ert-deftest ruby--set-encoding-when-ascii ()
+ (ruby-with-temp-file "ascii"
+ (let ((ruby-encoding-magic-comment-style 'ruby)
+ (ruby-insert-encoding-magic-comment t))
+ (setq save-buffer-coding-system 'us-ascii)
+ (ruby-mode-set-encoding)
+ (should (string= "ascii" (buffer-string))))))
+
+(ert-deftest ruby--set-encoding-when-utf8 ()
+ (ruby-with-temp-file "💎"
+ (let ((ruby-encoding-magic-comment-style 'ruby)
+ (ruby-insert-encoding-magic-comment t))
+ (setq save-buffer-coding-system 'utf-8)
+ (ruby-mode-set-encoding)
+ (should (string= "💎" (buffer-string))))))
+
+(ert-deftest ruby--set-encoding-when-latin-15 ()
+ (ruby-with-temp-file "Ⓡ"
+ (let ((ruby-encoding-magic-comment-style 'ruby)
+ (ruby-insert-encoding-magic-comment t))
+ (setq save-buffer-coding-system 'iso-8859-15)
+ (ruby-mode-set-encoding)
+ (should (string= "# coding: iso-8859-15\nⓇ" (buffer-string))))))
+
+(ert-deftest ruby-imenu-with-private-modifier ()
+ (ruby-with-temp-buffer
+ (ruby-test-string
+ "class Blub
+ | def hi
+ | 'Hi!'
+ | end
+ |
+ | def bye
+ | 'Bye!'
+ | end
+ |
+ | private def hiding
+ | 'You can't see me'
+ | end
+ |end")
+ (should (equal (mapcar #'car (ruby-imenu-create-index))
+ '("Blub"
+ "Blub#hi"
+ "Blub#bye"
+ "Blub#hiding")))))
+
(ert-deftest ruby--indent/converted-from-manual-test ()
:tags '(:expensive-test)
;; Converted from manual test.
diff --git a/test/lisp/progmodes/xref-resources/file1.txt b/test/lisp/progmodes/xref-resources/file1.txt
index 5d7cc544443..85b92f11566 100644
--- a/test/lisp/progmodes/xref-resources/file1.txt
+++ b/test/lisp/progmodes/xref-resources/file1.txt
@@ -1,2 +1,2 @@
-foo foo
+ foo foo
bar
diff --git a/test/lisp/progmodes/xref-resources/file3.txt b/test/lisp/progmodes/xref-resources/file3.txt
new file mode 100644
index 00000000000..6283185910d
--- /dev/null
+++ b/test/lisp/progmodes/xref-resources/file3.txt
@@ -0,0 +1 @@
+ match some words match more match ends here
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el
index b4b5e4db5d6..d29452243b2 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -59,15 +59,33 @@
(should (string-match-p "file1\\.txt\\'" (xref-location-group (nth 1 locs))))
(should (equal 1 (xref-location-line (nth 0 locs))))
(should (equal 1 (xref-location-line (nth 1 locs))))
- (should (equal 0 (xref-location-column (nth 0 locs))))
- (should (equal 4 (xref-location-column (nth 1 locs))))))
+ (should (equal 1 (xref-file-location-column (nth 0 locs))))
+ (should (equal 5 (xref-file-location-column (nth 1 locs))))))
(ert-deftest xref-matches-in-directory-finds-an-empty-line-regexp-match ()
(let ((locs (xref-tests--locations-in-data-dir "^$")))
(should (= 1 (length locs)))
(should (string-match-p "file2\\.txt\\'" (xref-location-group (nth 0 locs))))
(should (equal 1 (xref-location-line (nth 0 locs))))
- (should (equal 0 (xref-location-column (nth 0 locs))))))
+ (should (equal 0 (xref-file-location-column (nth 0 locs))))))
+
+(ert-deftest xref-matches-in-files-includes-matches-from-all-the-files ()
+ (let ((matches (xref-matches-in-files "bar"
+ (directory-files xref-tests--data-dir t
+ "\\`[^.]"))))
+ (should (= 2 (length matches)))
+ (should (cl-every
+ (lambda (match) (equal (xref-item-summary match) "bar"))
+ matches))))
+
+(ert-deftest xref-matches-in-files-trims-summary-for-matches-on-same-line ()
+ (let ((matches (xref-matches-in-files "match"
+ (directory-files xref-tests--data-dir t
+ "\\`[^.]"))))
+ (should (= 3 (length matches)))
+ (should
+ (equal (mapcar #'xref-item-summary matches)
+ '(" match some words " "match more " "match ends here")))))
(ert-deftest xref--buf-pairs-iterator-groups-markers-by-buffers-1 ()
(let* ((xrefs (xref-tests--matches-in-data-dir "foo"))
@@ -99,18 +117,14 @@
(should (null (marker-position (cdr (nth 0 (cdr cons2))))))))
(ert-deftest xref--xref-file-name-display-is-abs ()
- (let ((xref-file-name-display 'abs)
- ;; Some older BSD find versions can produce '//' in the output.
- (expected (list
- (concat xref-tests--data-dir "/?file1.txt")
- (concat xref-tests--data-dir "/?file2.txt")))
- (actual (delete-dups
- (mapcar 'xref-location-group
- (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))))
- (should (and (= (length expected) (length actual))
- (cl-every (lambda (e1 e2)
- (string-match-p e1 e2))
- expected actual)))))
+ (let ((xref-file-name-display 'abs))
+ (should (equal
+ (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))
+ (list
+ (concat xref-tests--data-dir "file1.txt")
+ (concat xref-tests--data-dir "file2.txt"))))))
(ert-deftest xref--xref-file-name-display-is-nondirectory ()
(let ((xref-file-name-display 'nondirectory))
@@ -125,16 +139,14 @@
(let* ((data-parent-dir
(file-name-directory (directory-file-name xref-tests--data-dir)))
(project-find-functions
- #'(lambda (_) (cons 'transient data-parent-dir)))
- (xref-file-name-display 'project-relative)
- ;; Some older BSD find versions can produce '//' in the output.
- (expected (list
- "xref-resources//?file1.txt"
- "xref-resources//?file2.txt"))
- (actual (delete-dups
- (mapcar 'xref-location-group
- (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))))
- (should (and (= (length expected) (length actual))
- (cl-every (lambda (e1 e2)
- (string-match-p e1 e2))
- expected actual)))))
+ (lambda (_) (cons 'transient data-parent-dir)))
+ (xref-file-name-display 'project-relative))
+ (should (equal
+ (delete-dups
+ (mapcar 'xref-location-group
+ (xref-tests--locations-in-data-dir "\\(bar\\|foo\\)")))
+ (list
+ "xref-resources/file1.txt"
+ "xref-resources/file2.txt")))))
+
+;;; xref-tests.el ends here
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 2db570c97dd..7f62a417a02 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -465,7 +465,12 @@ Return the last evalled form in BODY."
;; isearch-lazy-highlight-new-loop and sit-for (bug#36328)
((symbol-function 'replace-highlight)
(lambda (&rest _args)
- (string-match "[A-Z ]" "ForestGreen"))))
+ (string-match "[A-Z ]" "ForestGreen")))
+ ;; Override `sit-for' and `ding' so that we don't have
+ ;; to wait and listen to bells when running the test.
+ ((symbol-function 'sit-for)
+ (lambda (&rest _args) (redisplay)))
+ ((symbol-function 'ding) 'ignore))
(perform-replace ,from ,to t replace-tests-perform-replace-regexp-flag nil))
,@body))))
@@ -584,7 +589,7 @@ bound to HIGHLIGHT-LOCUS."
(replace-tests-with-highlighted-occurrence highlight-locus
(occur-mode-display-occurrence)
(with-current-buffer (marker-buffer
- (get-text-property (point) 'occur-target))
+ (caar (get-text-property (point) 'occur-target)))
(should (funcall check-overlays has-overlay)))))))
(ert-deftest replace-regexp-bug45973 ()
@@ -601,4 +606,15 @@ bound to HIGHLIGHT-LOCUS."
(if (match-string 2) "R" "L")))
(should (equal (buffer-string) after)))))
+(ert-deftest test-count-matches ()
+ (with-temp-buffer
+ (insert "oooooooooo")
+ (goto-char (point-min))
+ (should (= (count-matches "oo") 5))
+ (should (= (count-matches "o+") 1)))
+ (with-temp-buffer
+ (insert "o\n\n\n\no\n\n")
+ (goto-char (point-min))
+ (should (= (count-matches "^$") 4))))
+
;;; replace-tests.el ends here
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index 0c2d7123dd7..c571dc3e14b 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -69,8 +69,14 @@
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
-(setq password-cache-expiry nil
- shadow-debug (getenv "EMACS_HYDRA_CI")
+(setq auth-source-save-behavior nil
+ password-cache-expiry nil
+ shadow-debug (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI"))
+ ;; When the remote user id is 0, Tramp refuses unsafe temporary files.
+ tramp-allow-unsafe-temporary-files
+ (or tramp-allow-unsafe-temporary-files noninteractive)
+ tramp-cache-read-persistent-data t ;; For auth-sources.
+ tramp-persistency-file-name nil
tramp-verbose 0
;; On macOS, `temporary-file-directory' is a symlinked directory.
temporary-file-directory (file-truename temporary-file-directory)
@@ -117,8 +123,8 @@
(ignore-errors (delete-file shadow-info-file))
(ignore-errors (delete-file shadow-todo-file))
;; Reset variables.
+ (shadow-invalidate-hashtable)
(setq shadow-info-buffer nil
- shadow-hashtable nil
shadow-todo-buffer nil
shadow-files-to-copy nil))
@@ -640,7 +646,9 @@ guaranteed by the originator of a cluster definition."
(expand-file-name
"shadowfile-tests"
shadow-test-remote-temporary-file-directory))
- mocked-input `(,cluster1 ,file1 ,cluster2 ,file2 ,(kbd "RET")))
+ mocked-input
+ `(,cluster1 ,file1 ,cluster2 ,file2
+ ,primary ,file1 ,(kbd "RET")))
(with-temp-buffer
(set-visited-file-name file1)
(call-interactively #'shadow-define-literal-group)
@@ -654,7 +662,9 @@ guaranteed by the originator of a cluster definition."
(should (member (format "/%s:%s" cluster1 (file-local-name file1))
(car shadow-literal-groups)))
(should (member (format "/%s:%s" cluster2 (file-local-name file2))
- (car shadow-literal-groups))))
+ (car shadow-literal-groups)))
+ ;; Bug#49596.
+ (should (member (concat primary file1) (car shadow-literal-groups))))
;; Cleanup.
(shadow--tests-cleanup))))
@@ -729,6 +739,7 @@ guaranteed by the originator of a cluster definition."
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
(let ((backup-inhibited t)
+ create-lockfiles
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
@@ -874,6 +885,7 @@ guaranteed by the originator of a cluster definition."
(skip-unless (file-writable-p shadow-test-remote-temporary-file-directory))
(let ((backup-inhibited t)
+ create-lockfiles
(shadow-info-file shadow-test-info-file)
(shadow-todo-file shadow-test-todo-file)
(shadow-inhibit-message t)
diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el
index d918de771b7..223a18590b1 100644
--- a/test/lisp/shell-tests.el
+++ b/test/lisp/shell-tests.el
@@ -45,4 +45,23 @@
(should (equal (shell--parse-pcomplete-arguments)
'(("cd" "ba" "") 1 4 7)))))
+(ert-deftest shell-tests-split-string ()
+ (should (equal (split-string-shell-command "ls /tmp")
+ '("ls" "/tmp")))
+ (should (equal (split-string-shell-command "ls '/tmp/foo bar'")
+ '("ls" "/tmp/foo bar")))
+ (should (equal (split-string-shell-command "ls \"/tmp/foo bar\"")
+ '("ls" "/tmp/foo bar")))
+ (should (equal (split-string-shell-command "ls /tmp/'foo bar'")
+ '("ls" "/tmp/foo bar")))
+ (should (equal (split-string-shell-command "ls /tmp/'foo\"bar'")
+ '("ls" "/tmp/foo\"bar")))
+ (should (equal (split-string-shell-command "ls /tmp/\"foo''bar\"")
+ '("ls" "/tmp/foo''bar")))
+ (should (equal (split-string-shell-command "ls /tmp/'foo\\ bar'")
+ '("ls" "/tmp/foo\\ bar")))
+ (unless (memq system-type '(windows-nt ms-dos))
+ (should (equal (split-string-shell-command "ls /tmp/foo\\ bar")
+ '("ls" "/tmp/foo bar")))))
+
;;; shell-tests.el ends here
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index b4007a6c3f3..3ece61290bc 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -1,4 +1,4 @@
-;;; simple-test.el --- Tests for simple.el -*- lexical-binding: t; -*-
+;;; simple-tests.el --- Tests for simple.el -*- lexical-binding: t; -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
@@ -67,6 +67,11 @@
(insert (propertize "\nbar\nbaz\nzut" 'invisible t))
(should (= (count-lines (point-min) (point-max) t) 2))))
+(ert-deftest simple-text-count-lines-non-ascii ()
+ (with-temp-buffer
+ (insert "あ\nい\nう\nえ\nお\n")
+ (should (= (count-lines (point) (point)) 0))))
+
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
@@ -460,8 +465,124 @@ See bug#35036."
(simple-tests--exec '(backward-char undo-redo undo-redo))
(should (equal (buffer-string) "abc"))
(simple-tests--exec '(backward-char undo-redo undo-redo))
+ (should (equal (buffer-string) "abcde"))))
+
+(ert-deftest simple-tests--undo-in-region ()
+ ;; Test undo/redo in region.
+ (with-temp-buffer
+ ;; Enable `transient-mark-mode' so `region-active-p' works as
+ ;; expected. `region-active-p' is used to determine whether to
+ ;; perform regional undo in `undo'.
+ (transient-mark-mode)
+ (buffer-enable-undo)
+ (dolist (x '("a" "b" "c" "d" "e"))
+ (insert x)
+ (undo-boundary))
+ (should (equal (buffer-string) "abcde"))
+ ;; The test does this: activate region, `undo', break the undo
+ ;; chain (by deactivating and reactivating the region), then
+ ;; `undo-only'. There used to be a bug in
+ ;; `undo-make-selective-list' that makes `undo-only' error out in
+ ;; that case, which is fixed by in the same commit as this change.
+ (simple-tests--exec '(move-beginning-of-line
+ push-mark-command
+ forward-char
+ forward-char
+ undo))
+ (should (equal (buffer-string) "acde"))
+ (simple-tests--exec '(move-beginning-of-line
+ push-mark-command
+ forward-char
+ forward-char
+ undo-only))
(should (equal (buffer-string) "abcde"))
- ))
+ ;; Rest are simple redo in region tests.
+ (simple-tests--exec '(undo-redo))
+ (should (equal (buffer-string) "acde"))
+ (simple-tests--exec '(undo-redo))
+ (should (equal (buffer-string) "abcde"))))
+
+(defun simple-tests--sans-leading-nil (lst)
+ "Return LST sans the leading nils."
+ (while (and (consp lst) (null (car lst)))
+ (setq lst (cdr lst)))
+ lst)
+
+(ert-deftest simple-tests--undo-equiv-table ()
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (transient-mark-mode)
+ (let ((ul-hash-table (make-hash-table :test #'equal)))
+ (dolist (x '("a" "b" "c"))
+ (insert x)
+ (puthash x (simple-tests--sans-leading-nil buffer-undo-list)
+ ul-hash-table)
+ (undo-boundary))
+ (should (equal (buffer-string) "abc"))
+ ;; Tests mappings in `undo-equiv-table'.
+ (simple-tests--exec '(undo))
+ (should (equal (buffer-string) "ab"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ (gethash "b" ul-hash-table)))
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "abc"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ (gethash "c" ul-hash-table)))
+ ;; Undo in region should map to 'undo-in-region.
+ (simple-tests--exec '(backward-char
+ push-mark-command
+ move-end-of-line
+ undo))
+ (should (equal (buffer-string) "ab"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ 'undo-in-region))
+ ;; The undo that undoes to the beginning should map to t.
+ (deactivate-mark 'force)
+ (simple-tests--exec '(backward-char
+ undo undo undo
+ undo undo undo))
+ (should (equal (buffer-string) ""))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ t))
+ ;; Erroneous nil undo should map to 'empty.
+ (insert "a")
+ (undo-boundary)
+ (push nil buffer-undo-list)
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "a"))
+ (should (eq (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ 'empty))
+ ;; But if the previous record is a redo record, its mapping
+ ;; shouldn't change.
+ (insert "e")
+ (undo-boundary)
+ (should (equal (buffer-string) "ea"))
+ (puthash "e" (simple-tests--sans-leading-nil buffer-undo-list)
+ ul-hash-table)
+ (insert "a")
+ (undo-boundary)
+ (simple-tests--exec '(backward-char undo))
+ (should (equal (buffer-string) "ea"))
+ (push nil buffer-undo-list)
+ (simple-tests--exec '(forward-char undo))
+ ;; Buffer content should change since we just undid a nil
+ ;; record.
+ (should (equal (buffer-string) "ea"))
+ ;; The previous redo record shouldn't map to empty.
+ (should (equal (gethash (simple-tests--sans-leading-nil
+ buffer-undo-list)
+ undo-equiv-table)
+ (gethash "e" ul-hash-table))))))
;;; undo auto-boundary tests
(ert-deftest undo-auto-boundary-timer ()
@@ -838,6 +959,17 @@ See Bug#21722."
(with-shell-command-dont-erase-buffer str output-buffer-is-current
(should (= (point) (alist-get shell-command-dont-erase-buffer expected-point)))))))
+(ert-deftest test-undo-region ()
+ (with-temp-buffer
+ (insert "This is a test\n")
+ (goto-char (point-min))
+ (setq buffer-undo-list nil)
+ (downcase-word 1)
+ (should (= (length (delq nil (undo-make-selective-list 1 9))) 2))
+ (should (= (length (delq nil (undo-make-selective-list 4 9))) 1))
+ ;; FIXME this is the off-by-one error case.
+ ;;(should (= (length (delq nil (undo-make-selective-list 5 9))) 0))
+ (should (= (length (delq nil (undo-make-selective-list 6 9))) 0))))
(provide 'simple-test)
;;; simple-test.el ends here
diff --git a/test/lisp/so-long-tests/so-long-tests-helpers.el b/test/lisp/so-long-tests/so-long-tests-helpers.el
index ab4d9c6c137..dd2331e6e4a 100644
--- a/test/lisp/so-long-tests/so-long-tests-helpers.el
+++ b/test/lisp/so-long-tests/so-long-tests-helpers.el
@@ -43,7 +43,8 @@
(cl-case action
('so-long-mode
(should (eq major-mode 'so-long-mode))
- (so-long-tests-assert-overrides))
+ (so-long-tests-assert-overrides)
+ (so-long-tests-assert-preserved))
('so-long-minor-mode
(should (eq so-long-minor-mode t))
(so-long-tests-assert-overrides))
@@ -62,7 +63,8 @@
(cl-case action
('so-long-mode
(should-not (eq major-mode 'so-long-mode))
- (so-long-tests-assert-overrides-reverted))
+ (so-long-tests-assert-overrides-reverted)
+ (so-long-tests-assert-preserved))
('so-long-minor-mode
(should-not (eq so-long-minor-mode t))
(so-long-tests-assert-overrides-reverted))
@@ -90,6 +92,17 @@
(when (boundp (car ovar))
(should (equal (symbol-value (car ovar)) (cdr ovar))))))
+(defun so-long-tests-assert-preserved ()
+ "Assert that preserved modes and variables have their expected values."
+ (dolist (var so-long-mode-preserved-variables)
+ (when (boundp var)
+ (should (equal (symbol-value var)
+ (alist-get var so-long-tests-memory)))))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (boundp mode)
+ (should (equal (symbol-value mode)
+ (alist-get mode so-long-tests-memory))))))
+
(defun so-long-tests-remember ()
"Remember the original states of modes and variables.
@@ -107,7 +120,22 @@ state against this remembered state."
(dolist (mode so-long-minor-modes)
(when (boundp mode)
(push (cons mode (symbol-value mode))
+ so-long-tests-memory)))
+ (dolist (var so-long-mode-preserved-variables)
+ (when (boundp var)
+ (push (cons var (symbol-value var))
+ so-long-tests-memory)))
+ (dolist (mode so-long-mode-preserved-minor-modes)
+ (when (boundp mode)
+ (push (cons mode (symbol-value mode))
so-long-tests-memory))))
+(defun so-long-tests-predicates ()
+ "Return the list of testable predicate functions."
+ (if (fboundp 'buffer-line-statistics)
+ '(so-long-statistics-excessive-p
+ so-long-detected-long-line-p)
+ '(so-long-detected-long-line-p)))
+
(provide 'so-long-tests-helpers)
;;; so-long-tests-helpers.el ends here
diff --git a/test/lisp/so-long-tests/so-long-tests.el b/test/lisp/so-long-tests/so-long-tests.el
index a6d8721ffc8..8e4597c946c 100644
--- a/test/lisp/so-long-tests/so-long-tests.el
+++ b/test/lisp/so-long-tests/so-long-tests.el
@@ -57,101 +57,131 @@
(declare-function so-long-tests-assert-active "so-long-tests-helpers")
(declare-function so-long-tests-assert-reverted "so-long-tests-helpers")
(declare-function so-long-tests-assert-and-revert "so-long-tests-helpers")
+(declare-function so-long-tests-predicates "so-long-tests-helpers")
-;; Enable the automated behavior for all tests.
+;; Enable the automated behaviour for all tests.
(global-so-long-mode 1)
(ert-deftest so-long-tests-threshold-under ()
"Under line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1- so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1- so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-threshold-at ()
"At line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1- so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1- so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-threshold-over ()
"Over line length threshold."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (normal-mode)
- (so-long-tests-remember)
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (so-long-tests-assert-and-revert 'so-long-mode)))
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ (so-long-tests-remember)
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (normal-mode)
+ (so-long-tests-assert-and-revert 'so-long-mode))))
(ert-deftest so-long-tests-skip-comments ()
"Skip leading shebang, whitespace, and comments."
- ;; Long comment, no newline.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with newline.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with short text following.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (insert (make-string so-long-threshold ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Long comment, with long text following.
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- (insert (make-string (1+ so-long-threshold) ?\;))
- (insert "\n")
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'so-long-mode))))
+ ;; Only for `so-long-detected-long-line-p' -- comments are not
+ ;; treated differently when using `so-long-statistics-excessive-p'.
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ ;; Long comment, no newline.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate #'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with newline.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate #'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with short text following.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (insert (make-string so-long-threshold ?x))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate #'so-long-statistics-excessive-p)
+ 'so-long-mode)))))
+ ;; Long comment, with long text following.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?\;))
+ (insert "\n")
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (normal-mode)
+ (should (eq major-mode 'so-long-mode)))))
(ert-deftest so-long-tests-max-lines ()
"Give up after `so-long-max-lines'."
- (with-temp-buffer
- (display-buffer (current-buffer))
- (insert "#!emacs\n")
- ;; Insert exactly `so-long-max-lines' non-comment lines, followed
- ;; by a long line.
- (dotimes (_ so-long-max-lines)
- (insert "x\n"))
- (insert (make-string (1+ so-long-threshold) ?x))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))
- ;; If `so-long-max-lines' is nil, don't give up the search.
- (let ((so-long-max-lines nil))
- (normal-mode)
- (should (eq major-mode 'so-long-mode)))
- ;; If `so-long-skip-leading-comments' is nil, all lines are
- ;; counted, and so the shebang line counts, which makes the
- ;; long line one line further away.
- (let ((so-long-skip-leading-comments nil)
- (so-long-max-lines (1+ so-long-max-lines)))
+ ;; Only for `so-long-detected-long-line-p' -- the whole buffer is
+ ;; 'seen' when using `so-long-statistics-excessive-p'.
+ (dolist (so-long-predicate (so-long-tests-predicates))
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ ;; Insert exactly `so-long-max-lines' non-comment lines, followed
+ ;; by a long line.
+ (dotimes (_ so-long-max-lines)
+ (insert "x\n"))
+ (insert (make-string (1+ so-long-threshold) ?x))
(normal-mode)
- (should (eq major-mode 'emacs-lisp-mode))
- (let ((so-long-max-lines (1+ so-long-max-lines)))
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate #'so-long-statistics-excessive-p)
+ 'so-long-mode))))
+ ;; If `so-long-max-lines' is nil, don't give up the search.
+ (let ((so-long-max-lines nil))
(normal-mode)
- (should (eq major-mode 'so-long-mode))))))
+ (should (eq major-mode 'so-long-mode)))
+ ;; If `so-long-skip-leading-comments' is nil, all lines are
+ ;; counted, and so the shebang line counts, which makes the
+ ;; long line one line further away.
+ (let ((so-long-skip-leading-comments nil)
+ (so-long-max-lines (1+ so-long-max-lines)))
+ (normal-mode)
+ (should (eq major-mode
+ (cond ((eq so-long-predicate #'so-long-detected-long-line-p)
+ 'emacs-lisp-mode)
+ ((eq so-long-predicate #'so-long-statistics-excessive-p)
+ 'so-long-mode))))
+ (let ((so-long-max-lines (1+ so-long-max-lines)))
+ (normal-mode)
+ (should (eq major-mode 'so-long-mode)))))))
(ert-deftest so-long-tests-invisible-buffer-function ()
"Call `so-long-invisible-buffer-function' in invisible buffers."
@@ -180,7 +210,7 @@
;; From Emacs 27 the `display-buffer' call is insufficient.
;; The various 'window change functions' are now invoked by the
;; redisplay, and redisplay does nothing at all in batch mode,
- ;; so we cannot test under this revised behavior. Refer to:
+ ;; so we cannot test under this revised behaviour. Refer to:
;; https://lists.gnu.org/r/emacs-devel/2019-10/msg00971.html
;; For interactive (non-batch) test runs, calling `redisplay'
;; does do the trick; so do that first.
@@ -195,7 +225,9 @@
;; Emacs adds the framework necessary to make `redisplay' work
;; in batch mode.
(unless (eq so-long--active t)
- (run-window-configuration-change-hook))))
+ (with-suppressed-warnings
+ ((obsolete run-window-configuration-change-hook))
+ (run-window-configuration-change-hook)))))
(so-long-tests-assert-and-revert 'so-long-mode))
;; `so-long-invisible-buffer-function' is `nil'.
(with-temp-buffer
@@ -230,7 +262,9 @@
(redisplay)
(when noninteractive
(unless (eq so-long--active t)
- (run-window-configuration-change-hook))))
+ (with-suppressed-warnings
+ ((obsolete run-window-configuration-change-hook))
+ (run-window-configuration-change-hook)))))
(should (eq major-mode 'emacs-lisp-mode))))
(ert-deftest so-long-tests-actions ()
@@ -323,20 +357,76 @@
(normal-mode)
(should (eq major-mode 'so-long-mode)))))
+(ert-deftest so-long-tests-preserved-variables-and-modes ()
+ "Preserved variables and minor modes when using `so-long-mode'."
+ ;; Test the user options `so-long-mode-preserved-variables' and
+ ;; `so-long-mode-preserved-minor-modes'. The minor mode `view-mode'
+ ;; is 'preserved' by default (using both options).
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ ;; We enable `view-mode' before triggering `so-long'.
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (view-mode 1)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ (so-long-tests-remember)
+ (let ((so-long-action 'so-long-mode)
+ (menu (so-long-menu)))
+ (so-long)
+ (so-long-tests-assert-active 'so-long-mode)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ ;; Revert.
+ (funcall (lookup-key menu [so-long-revert]))
+ (so-long-tests-assert-reverted 'so-long-mode)
+ (should (eq view-mode t))
+ (should (eq buffer-read-only t))
+ ;; Disable `view-mode'. Note that without the preserved
+ ;; variables, the conflict between how `view-mode' and `so-long'
+ ;; each deal with the buffer's original `buffer-read-only' value
+ ;; would lead to a situation whereby the buffer would still be
+ ;; read-only after `view-mode' had been disabled.
+ (view-mode 0)
+ (should (eq view-mode nil))
+ (should (eq buffer-read-only nil))))
+ ;; Without `view-mode'.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (normal-mode)
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (should (eq view-mode nil))
+ (so-long-tests-remember)
+ (let ((so-long-action 'so-long-mode)
+ (menu (so-long-menu)))
+ (so-long)
+ (so-long-tests-assert-active 'so-long-mode)
+ (should (eq view-mode nil))
+ ;; Revert.
+ (funcall (lookup-key menu [so-long-revert]))
+ (so-long-tests-assert-reverted 'so-long-mode)
+ (should (eq view-mode nil)))))
+
(ert-deftest so-long-tests-predicate ()
"Custom predicate function."
;; Test the `so-long-predicate' user option.
+ ;; Always true. Trigger when we normally wouldn't.
(with-temp-buffer
(display-buffer (current-buffer))
(insert "#!emacs\n")
- ;; Always false.
- (let ((so-long-predicate #'ignore))
- (normal-mode)
- (should (eq major-mode 'emacs-lisp-mode)))
- ;; Always true.
(let ((so-long-predicate (lambda () t)))
(normal-mode)
- (should (eq major-mode 'so-long-mode)))))
+ (should (eq major-mode 'so-long-mode))))
+ ;; Always false. Don't trigger when we normally would.
+ (with-temp-buffer
+ (display-buffer (current-buffer))
+ (insert "#!emacs\n")
+ (insert (make-string (1+ so-long-threshold) ?x))
+ (let ((so-long-predicate #'ignore))
+ (normal-mode)
+ (should (eq major-mode 'emacs-lisp-mode)))))
(ert-deftest so-long-tests-file-local-action ()
"File-local action."
@@ -405,7 +495,10 @@
(insert ,local-vars)
(normal-mode)
;; Remember the `emacs-lisp-mode' state. The other cases
- ;; will validate the 'reverted' state against this.
+ ;; will validate the 'reverted' state against this. (Note
+ ;; that we haven't displayed the buffer, and therefore only
+ ;; `so-long-invisible-buffer-function' has acted, so we are
+ ;; still remembering the 'before' state.)
(so-long-tests-remember)
(should (eq major-mode 'emacs-lisp-mode)))
;; Downgrade the action from major mode to minor mode.
diff --git a/test/lisp/so-long-tests/spelling-tests.el b/test/lisp/so-long-tests/spelling-tests.el
index 0be8555bdd2..f778b646635 100644
--- a/test/lisp/so-long-tests/spelling-tests.el
+++ b/test/lisp/so-long-tests/spelling-tests.el
@@ -57,7 +57,7 @@
(unwind-protect
(cl-letf (((symbol-function 'ispell-command-loop)
(lambda (_miss _guess word _start _end)
- (message "Unrecognized word: %s." word)
+ (message "Unrecognised word: %s." word)
(throw 'mistake t))))
(catch 'mistake
(find-library "so-long")
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index fc5a1eba6d8..21b8a27858e 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -78,10 +78,14 @@
(ert-deftest subr-test-define-prefix-command ()
(define-prefix-command 'foo-prefix-map)
+ (defvar foo-prefix-map)
+ (declare-function foo-prefix-map "subr-tests")
(should (keymapp foo-prefix-map))
(should (fboundp #'foo-prefix-map))
;; With optional argument.
(define-prefix-command 'bar-prefix 'bar-prefix-map)
+ (defvar bar-prefix-map)
+ (declare-function bar-prefix "subr-tests")
(should (keymapp bar-prefix-map))
(should (fboundp #'bar-prefix))
;; Returns the symbol.
@@ -378,7 +382,7 @@ cf. Bug#25477."
"Test for https://debbugs.gnu.org/22027 ."
(let ((default "foo") res)
(cl-letf (((symbol-function 'read-string)
- (lambda (_prompt _init _hist def) def)))
+ (lambda (_prompt &optional _init _hist def _inher-input) def)))
(setq res (read-passwd "pass: " 'confirm (mapconcat #'string default "")))
(should (string= default res)))))
@@ -473,7 +477,7 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(add-hook 'subr-tests--hook 'f7 90)
(add-hook 'subr-tests--hook 'f8 t)
(should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3 f7 f8)))
- ;; Make sue `nil' is equivalent to 0.
+ ;; Make sure `nil' is equivalent to 0.
(add-hook 'subr-tests--hook 'f9 0)
(add-hook 'subr-tests--hook 'f10)
(should (equal subr-tests--hook '(f5 f10 f9 f6 f2 f1 f4 f3 f7 f8)))
@@ -531,7 +535,8 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should (equal (string-replace "a" "aa" "aaa") "aaaaaa"))
(should (equal (string-replace "abc" "defg" "abc") "defg"))
- (should-error (string-replace "" "x" "abc")))
+ (should (equal (should-error (string-replace "" "x" "abc"))
+ '(wrong-length-argument 0))))
(ert-deftest subr-replace-regexp-in-string ()
(should (equal (replace-regexp-in-string "a+" "xy" "abaabbabaaba")
@@ -679,5 +684,61 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should (>= (length (apropos-internal "^help" #'commandp)) 15))
(should-not (apropos-internal "^next-line$" #'keymapp)))
+
+(ert-deftest test-buffer-local-boundp ()
+ (let ((buf (generate-new-buffer "boundp")))
+ (with-current-buffer buf
+ (setq-local test-boundp t))
+ (setq test-global-boundp t)
+ (should (buffer-local-boundp 'test-boundp buf))
+ (should-not (buffer-local-boundp 'test-not-boundp buf))
+ (should (buffer-local-boundp 'test-global-boundp buf))))
+
+(ert-deftest test-replace-string-in-region ()
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-string-in-region "foo" "new" (point-min) (point-max))
+ 2))
+ (should (equal (buffer-string) "new bar zot newbar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-string-in-region "foo" "new" (point-min) 14)
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should-error (replace-string-in-region "foo" "new" (point-min) 30)))
+
+ (with-temp-buffer
+ (insert "Foo bar zot foobar")
+ (should (= (replace-string-in-region "Foo" "new" (point-min))
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar"))))
+
+(ert-deftest test-replace-regexp-in-region ()
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-regexp-in-region "fo+" "new" (point-min) (point-max))
+ 2))
+ (should (equal (buffer-string) "new bar zot newbar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should (= (replace-regexp-in-region "fo+" "new" (point-min) 14)
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar")))
+
+ (with-temp-buffer
+ (insert "foo bar zot foobar")
+ (should-error (replace-regexp-in-region "fo+" "new" (point-min) 30)))
+
+ (with-temp-buffer
+ (insert "Foo bar zot foobar")
+ (should (= (replace-regexp-in-region "Fo+" "new" (point-min))
+ 1))
+ (should (equal (buffer-string) "new bar zot foobar"))))
+
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/term-tests.el b/test/lisp/term-tests.el
index 503cb5d7aab..50ac370b5b5 100644
--- a/test/lisp/term-tests.el
+++ b/test/lisp/term-tests.el
@@ -56,7 +56,7 @@
first line\r
next line\r\n"))
(should (equal (term-test-screen-from-input 40 12 str)
- (replace-regexp-in-string "\r" "" str)))))
+ (string-replace "\r" "" str)))))
(ert-deftest term-carriage-return ()
(skip-unless (not (memq system-type '(windows-nt ms-dos))))
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index 97f5abf1156..abf85dbff43 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -143,20 +143,20 @@
(css-mode)
(insert "body:a")
(let ((completions (css-mode-tests--completions)))
- (should (member "active" completions))
- (should-not (member "disabled" completions))
+ (should (member ":active" completions))
+ (should-not (member ":disabled" completions))
;; Don't include pseudo-elements
- (should-not (member "after" completions)))))
+ (should-not (member "::after" completions)))))
(ert-deftest css-test-complete-pseudo-element ()
(with-temp-buffer
(css-mode)
(insert "body::a")
(let ((completions (css-mode-tests--completions)))
- (should (member "after" completions))
- (should-not (member "disabled" completions))
+ (should (member "::after" completions))
+ (should-not (member "::disabled" completions))
;; Don't include pseudo-classes
- (should-not (member "active" completions)))))
+ (should-not (member ":active" completions)))))
(ert-deftest css-test-complete-at-rule ()
(with-temp-buffer
diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el
index 694d683d546..8bc48732c62 100644
--- a/test/lisp/textmodes/dns-mode-tests.el
+++ b/test/lisp/textmodes/dns-mode-tests.el
@@ -25,6 +25,27 @@
(require 'ert)
(require 'dns-mode)
+(ert-deftest dns-mode-tests-dns-mode-soa-increment-serial ()
+ (with-temp-buffer
+ (insert "$TTL 86400
+@ IN SOA ns.icann.org. noc.dns.icann.org. (
+ 2015080302 ;Serial
+ 7200 ;Refresh
+ 3600 ;Retry
+ 1209600 ;Expire
+ 3600 ;Negative response caching TTL\n)")
+ (dns-mode-soa-increment-serial)
+ ;; Number is updated from 2015080302 to the current date
+ ;; (actually, just ensure the year part is later than 2020).
+ (should (string-match "\\$TTL 86400
+@ IN SOA ns.icann.org. noc.dns.icann.org. (
+ 20[2-9][0-9]+ ;Serial
+ 7200 ;Refresh
+ 3600 ;Retry
+ 1209600 ;Expire
+ 3600 ;Negative response caching TTL\n)"
+ (buffer-string)))))
+
;;; IPv6 reverse zones
(ert-deftest dns-mode-ipv6-conversion ()
(let ((address "2001:db8::42"))
diff --git a/test/lisp/textmodes/fill-tests.el b/test/lisp/textmodes/fill-tests.el
index 21efe620999..a4c7f447b59 100644
--- a/test/lisp/textmodes/fill-tests.el
+++ b/test/lisp/textmodes/fill-tests.el
@@ -1,4 +1,4 @@
-;;; fill-test.el --- ERT tests for fill.el -*- lexical-binding: t -*-
+;;; fill-tests.el --- ERT tests for fill.el -*- lexical-binding: t -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el
index 697c96c78e5..b4c0186aace 100644
--- a/test/lisp/textmodes/sgml-mode-tests.el
+++ b/test/lisp/textmodes/sgml-mode-tests.el
@@ -204,5 +204,32 @@ The point is set to the beginning of the buffer."
(should (= 1 (- (car (syntax-ppss (1- (point-max))))
(car (syntax-ppss (point-max))))))))
+(ert-deftest sgml-test-brackets ()
+ "Test fontification of apostrophe preceded by paired-bracket character."
+ (let (brackets)
+ (map-char-table
+ (lambda (key value)
+ (setq brackets (cons (list
+ (if (consp key)
+ (list (car key) (cdr key))
+ key)
+ value)
+ brackets)))
+ (unicode-property-table-internal 'paired-bracket))
+ (setq brackets (delete-dups (flatten-tree brackets)))
+ (setq brackets (append brackets (list ?$ ?% ?& ?* ?+ ?/)))
+ (with-temp-buffer
+ (while brackets
+ (let ((char (string (pop brackets))))
+ (insert (concat "<p>" char "'s</p>\n"))))
+ (html-mode)
+ (font-lock-ensure (point-min) (point-max))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (goto-char (next-single-char-property-change (point) 'face))
+ (let ((val (get-text-property (point) 'face)))
+ (when val
+ (should-not (eq val 'font-lock-string-face))))))))
+
(provide 'sgml-mode-tests)
;;; sgml-mode-tests.el ends here
diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el
index 59c23943304..3ee3cd6fb17 100644
--- a/test/lisp/textmodes/tildify-tests.el
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -1,4 +1,4 @@
-;;; tildify-test.el --- ERT tests for tildify.el -*- lexical-binding: t -*-
+;;; tildify-tests.el --- ERT tests for tildify.el -*- lexical-binding: t -*-
;; Copyright (C) 2014-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index 62a27f09cbd..fba6f21d5dc 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -1,4 +1,4 @@
-;;; thingatpt.el --- tests for thing-at-point. -*- lexical-binding:t -*-
+;;; thingatpt-tests.el --- tests for thing-at-point. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -190,4 +190,37 @@ position to retrieve THING.")
(goto-char 2)
(should (eq (symbol-at-point) nil))))
+(defun test--number (number pos)
+ (with-temp-buffer
+ (insert (format "%s\n" number))
+ (goto-char (point-min))
+ (forward-char pos)
+ (number-at-point)))
+
+(ert-deftest test-numbers-none ()
+ (should (equal (test--number "foo" 0) nil)))
+
+(ert-deftest test-numbers-decimal ()
+ (should (equal (test--number "42" 0) 42))
+ (should (equal (test--number "42" 1) 42))
+ (should (equal (test--number "42" 2) 42)))
+
+(ert-deftest test-numbers-hex-lisp ()
+ (should (equal (test--number "#x42" 0) 66))
+ (should (equal (test--number "#x42" 1) 66))
+ (should (equal (test--number "#x42" 2) 66))
+ (should (equal (test--number "#xf00" 0) 3840))
+ (should (equal (test--number "#xf00" 1) 3840))
+ (should (equal (test--number "#xf00" 2) 3840))
+ (should (equal (test--number "#xf00" 3) 3840)))
+
+(ert-deftest test-numbers-hex-c ()
+ (should (equal (test--number "0x42" 0) 66))
+ (should (equal (test--number "0x42" 1) 66))
+ (should (equal (test--number "0x42" 2) 66))
+ (should (equal (test--number "0xf00" 0) 3840))
+ (should (equal (test--number "0xf00" 1) 3840))
+ (should (equal (test--number "0xf00" 2) 3840))
+ (should (equal (test--number "0xf00" 3) 3840)))
+
;;; thingatpt.el ends here
diff --git a/test/lisp/thumbs-tests.el b/test/lisp/thumbs-tests.el
new file mode 100644
index 00000000000..ee096138453
--- /dev/null
+++ b/test/lisp/thumbs-tests.el
@@ -0,0 +1,34 @@
+;;; thumbs-tests.el --- tests for thumbs.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'thumbs)
+
+(ert-deftest thumbs-tests-thumbsdir/create-if-missing ()
+ (let ((thumbs-thumbsdir (make-temp-file "thumbs-test" t)))
+ (unwind-protect
+ (progn
+ (delete-directory thumbs-thumbsdir)
+ (should (file-directory-p (thumbs-thumbsdir))))
+ (delete-directory thumbs-thumbsdir))))
+
+(provide 'thumbs-tests)
+;;; thumbs-tests.el ends here
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index 4ae3c1917dd..4e6fbbba923 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -486,7 +486,10 @@
"Test time-stamp format %Y."
(with-time-stamp-test-env
;; implemented since 1997, documented since 2019
- (should (equal (time-stamp-string "%Y" ref-time1) "2006"))))
+ (should (equal (time-stamp-string "%Y" ref-time1) "2006"))
+ ;; numbers do not truncate
+ (should (equal (time-stamp-string "%2Y" ref-time1) "2006"))
+ (should (equal (time-stamp-string "%02Y" ref-time1) "2006"))))
(ert-deftest time-stamp-format-am-pm ()
"Test time-stamp formats for AM and PM strings."
@@ -522,7 +525,7 @@
(should (equal (time-stamp-string "%#Z" ref-time1) utc-abbr)))))
(ert-deftest time-stamp-format-time-zone-offset ()
- "Test time-stamp format %z."
+ "Tests time-stamp legacy format %z and spot tests of new offset format %5z."
(with-time-stamp-test-env
(let ((utc-abbr (format-time-string "%#Z" ref-time1 t)))
;; documented 1995-2019, warned since 2019, will change
@@ -537,10 +540,12 @@
(let ((time-stamp-time-zone "CET-1"))
(should (equal (time-stamp-string "%5z" ref-time1) "+0100")))
;; implemented since 2019, verify that these don't warn
+ ;; See also the "formatz" tests below, which since 2021 test more
+ ;; variants with more offsets.
(should (equal (time-stamp-string "%-z" ref-time1) "+00"))
- (should (equal (time-stamp-string "%_z" ref-time1) "+0000"))
(should (equal (time-stamp-string "%:z" ref-time1) "+00:00"))
(should (equal (time-stamp-string "%::z" ref-time1) "+00:00:00"))
+ (should (equal (time-stamp-string "%9::z" ref-time1) "+00:00:00"))
(should (equal (time-stamp-string "%:::z" ref-time1) "+00"))))
(ert-deftest time-stamp-format-non-date-conversions ()
@@ -586,6 +591,9 @@
(should (equal (time-stamp-string "%(st(u)ff)B" ref-time3) May))
;; escaped parens do not change the nesting level
(should (equal (time-stamp-string "%(st\\)u\\(ff)B" ref-time3) May))
+ ;; incorrectly nested parens do not crash us
+ (should-not (equal (time-stamp-string "%(stuffB" ref-time3) May))
+ (should-not (equal (time-stamp-string "%)B" ref-time3) May))
;; not all punctuation is allowed
(should-not (equal (time-stamp-string "%&B" ref-time3) May)))))
@@ -594,6 +602,41 @@
(with-time-stamp-test-env
(should (equal (time-stamp-string "No percent" ref-time1) "No percent"))))
+(ert-deftest time-stamp-format-multiple-conversions ()
+ "Tests that multiple %-conversions are independent."
+ (with-time-stamp-test-env
+ (let ((Mon (format-time-string "%a" ref-time1 t))
+ (MON (format-time-string "%^a" ref-time1 t))
+ (Monday (format-time-string "%A" ref-time1 t)))
+ ;; change-case flag is independent
+ (should (equal (time-stamp-string "%a.%#a.%a" ref-time1)
+ (concat Mon "." MON "." Mon)))
+ ;; up-case flag is independent
+ (should (equal (time-stamp-string "%a.%^a.%a" ref-time1)
+ (concat Mon "." MON "." Mon)))
+ ;; underscore flag is independent
+ (should (equal (time-stamp-string "%_d.%d.%_d" ref-time1) " 2.02. 2"))
+ (should (equal (time-stamp-string "%_7z.%7z.%_7z" ref-time1)
+ "+000000.+0000 .+000000"))
+ ;; minus flag is independent
+ (should (equal (time-stamp-string "%d.%-d.%d" ref-time1) "02.2.02"))
+ (should (equal (time-stamp-string "%3z.%-3z.%3z" ref-time1)
+ "+0000.+00.+0000"))
+ ;; 0 flag is independent
+ (should (equal (time-stamp-string "%2d.%02d.%2d" ref-time1) " 2.02. 2"))
+ (should (equal (time-stamp-string "%6:::z.%06:::z.%6:::z" ref-time1)
+ "+00 .+00:00.+00 "))
+ ;; field width is independent
+ (should (equal
+ (time-stamp-string "%6Y.%Y.%6Y" ref-time1) " 2006.2006. 2006"))
+ ;; colon modifier is independent
+ (should (equal (time-stamp-string "%a.%:a.%a" ref-time1)
+ (concat Mon "." Monday "." Mon)))
+ (should (equal (time-stamp-string "%5z.%5::z.%5z" ref-time1)
+ "+0000.+00:00:00.+0000"))
+ ;; format letter is independent
+ (should (equal (time-stamp-string "%H:%M" ref-time1) "15:04")))))
+
(ert-deftest time-stamp-format-string-width ()
"Test time-stamp string width modifiers."
(with-time-stamp-test-env
@@ -657,4 +700,408 @@
(should (safe-local-variable-p 'time-stamp-pattern "a string"))
(should-not (safe-local-variable-p 'time-stamp-pattern 17)))
+;;;; Setup for tests of time offset formatting with %z
+
+(defun formatz (format zone)
+ "Uses time FORMAT string to format the offset of ZONE, returning the result.
+FORMAT is \"%z\" or a variation.
+ZONE is as the ZONE argument of the `format-time-string' function."
+ (with-time-stamp-test-env
+ (let ((time-stamp-time-zone zone))
+ ;; Call your favorite time formatter here.
+ ;; For narrower-scope unit testing,
+ ;; instead of calling time-stamp-string here,
+ ;; we could directly call (format-time-offset format zone)
+ (time-stamp-string format)
+ )))
+
+(defun format-time-offset (format offset-secs)
+ "Uses FORMAT to format the time zone represented by OFFSET-SECS.
+FORMAT must be \"%z\", possibly with a flag and padding.
+This function is a wrapper around `time-stamp-formatz-from-parsed-options'
+and is used for testing."
+ ;; This wrapper adds a simple regexp-based parser that handles only
+ ;; %z and variants. In normal use, time-stamp-formatz-from-parsed-options
+ ;; is called from a parser that handles all time string formats.
+ (string-match
+ "\\`\\([^%]*\\)%\\([-_]?\\)\\(0?\\)\\([1-9][0-9]*\\)?\\([EO]?\\)\\(:*\\)\\([^a-zA-Z]+\\)?z\\(.*\\)"
+ format)
+ (let ((leading-string (match-string 1 format))
+ (flag-minimize (seq-find (lambda (x) (eq x ?-))
+ (match-string 2 format)))
+ (flag-pad-with-spaces (seq-find (lambda (x) (eq x ?_))
+ (match-string 2 format)))
+ (flag-pad-with-zeros (equal (match-string 3 format) "0"))
+ (field-width (string-to-number (or (match-string 4 format) "")))
+ (colon-count (length (match-string 6 format)))
+ (garbage (match-string 7 format))
+ (trailing-string (match-string 8 format)))
+ (concat leading-string
+ (if garbage
+ ""
+ (time-stamp-formatz-from-parsed-options flag-minimize
+ flag-pad-with-spaces
+ flag-pad-with-zeros
+ colon-count
+ field-width
+ offset-secs))
+ trailing-string)))
+
+(defun fz-make+zone (h &optional m s)
+ "Creates a non-negative offset."
+ (let ((m (or m 0))
+ (s (or s 0)))
+ (+ (* 3600 h) (* 60 m) s)))
+
+(defun fz-make-zone (h &optional m s)
+ "Creates a negative offset. The arguments are all non-negative."
+ (- (fz-make+zone h m s)))
+
+(defmacro formatz-should-equal (zone expect)
+ "Formats ZONE and compares it to EXPECT.
+Uses the free variables `form-string' and `pattern-mod'.
+The functions in `pattern-mod' are composed left to right."
+ `(let ((result ,expect))
+ (dolist (fn pattern-mod)
+ (setq result (funcall fn result)))
+ (should (equal (formatz form-string ,zone) result))))
+
+;; These test cases have zeros in all places (first, last, none, both)
+;; for hours, minutes, and seconds.
+
+(defun formatz-hours-exact-helper (form-string pattern-mod)
+ "Tests format %z with whole hours."
+ (formatz-should-equal (fz-make+zone 0) "+00") ;0 sign always +, both digits
+ (formatz-should-equal (fz-make+zone 10) "+10")
+ (formatz-should-equal (fz-make-zone 10) "-10")
+ (formatz-should-equal (fz-make+zone 2) "+02")
+ (formatz-should-equal (fz-make-zone 2) "-02")
+ (formatz-should-equal (fz-make+zone 13) "+13")
+ (formatz-should-equal (fz-make-zone 13) "-13")
+ )
+
+(defun formatz-nonzero-minutes-helper (form-string pattern-mod)
+ "Tests format %z with whole minutes."
+ (formatz-should-equal (fz-make+zone 0 30) "+00:30") ;has hours even though 0
+ (formatz-should-equal (fz-make-zone 0 30) "-00:30")
+ (formatz-should-equal (fz-make+zone 0 4) "+00:04")
+ (formatz-should-equal (fz-make-zone 0 4) "-00:04")
+ (formatz-should-equal (fz-make+zone 8 40) "+08:40")
+ (formatz-should-equal (fz-make-zone 8 40) "-08:40")
+ (formatz-should-equal (fz-make+zone 0 15) "+00:15")
+ (formatz-should-equal (fz-make-zone 0 15) "-00:15")
+ (formatz-should-equal (fz-make+zone 11 30) "+11:30")
+ (formatz-should-equal (fz-make-zone 11 30) "-11:30")
+ (formatz-should-equal (fz-make+zone 3 17) "+03:17")
+ (formatz-should-equal (fz-make-zone 3 17) "-03:17")
+ (formatz-should-equal (fz-make+zone 12 45) "+12:45")
+ (formatz-should-equal (fz-make-zone 12 45) "-12:45")
+ )
+
+(defun formatz-nonzero-seconds-helper (form-string pattern-mod)
+ "Tests format %z with non-0 seconds."
+ ;; non-0 seconds are always included
+ (formatz-should-equal (fz-make+zone 0 0 50) "+00:00:50")
+ (formatz-should-equal (fz-make-zone 0 0 50) "-00:00:50")
+ (formatz-should-equal (fz-make+zone 0 0 06) "+00:00:06")
+ (formatz-should-equal (fz-make-zone 0 0 06) "-00:00:06")
+ (formatz-should-equal (fz-make+zone 0 7 50) "+00:07:50")
+ (formatz-should-equal (fz-make-zone 0 7 50) "-00:07:50")
+ (formatz-should-equal (fz-make+zone 0 0 16) "+00:00:16")
+ (formatz-should-equal (fz-make-zone 0 0 16) "-00:00:16")
+ (formatz-should-equal (fz-make+zone 0 12 36) "+00:12:36")
+ (formatz-should-equal (fz-make-zone 0 12 36) "-00:12:36")
+ (formatz-should-equal (fz-make+zone 0 3 45) "+00:03:45")
+ (formatz-should-equal (fz-make-zone 0 3 45) "-00:03:45")
+ (formatz-should-equal (fz-make+zone 8 45 30) "+08:45:30")
+ (formatz-should-equal (fz-make-zone 8 45 30) "-08:45:30")
+ (formatz-should-equal (fz-make+zone 0 11 45) "+00:11:45")
+ (formatz-should-equal (fz-make-zone 0 11 45) "-00:11:45")
+ (formatz-should-equal (fz-make+zone 3 20 15) "+03:20:15")
+ (formatz-should-equal (fz-make-zone 3 20 15) "-03:20:15")
+ (formatz-should-equal (fz-make+zone 11 14 30) "+11:14:30")
+ (formatz-should-equal (fz-make-zone 11 14 30) "-11:14:30")
+ (formatz-should-equal (fz-make+zone 12 30 49) "+12:30:49")
+ (formatz-should-equal (fz-make-zone 12 30 49) "-12:30:49")
+ (formatz-should-equal (fz-make+zone 12 0 34) "+12:00:34")
+ (formatz-should-equal (fz-make-zone 12 0 34) "-12:00:34")
+ )
+
+(defun formatz-hours-big-helper (form-string pattern-mod)
+ "Tests format %z with hours that don't fit in two digits."
+ (formatz-should-equal (fz-make+zone 101) "+101:00")
+ (formatz-should-equal (fz-make+zone 123 10) "+123:10")
+ (formatz-should-equal (fz-make-zone 123 10) "-123:10")
+ (formatz-should-equal (fz-make+zone 123 2) "+123:02")
+ (formatz-should-equal (fz-make-zone 123 2) "-123:02")
+ )
+
+(defun formatz-seconds-big-helper (form-string pattern-mod)
+ "Tests format %z with hours greater than 99 and non-zero seconds."
+ (formatz-should-equal (fz-make+zone 123 0 30) "+123:00:30")
+ (formatz-should-equal (fz-make-zone 123 0 30) "-123:00:30")
+ (formatz-should-equal (fz-make+zone 120 0 4) "+120:00:04")
+ (formatz-should-equal (fz-make-zone 120 0 4) "-120:00:04")
+ )
+
+;; Functions that modify the expected output string, so that we can
+;; use the above test cases for multiple formats.
+
+(defun formatz-mod-del-colons (string)
+ "Returns STRING with any colons removed."
+ (string-replace ":" "" string))
+
+(defun formatz-mod-add-00 (string)
+ "Returns STRING with \"00\" appended."
+ (concat string "00"))
+
+(defun formatz-mod-add-colon00 (string)
+ "Returns STRING with \":00\" appended."
+ (concat string ":00"))
+
+(defun formatz-mod-pad-r10 (string)
+ "Returns STRING padded on the right to 10 characters."
+ (concat string (make-string (- 10 (length string)) ?\s)))
+
+(defun formatz-mod-pad-r12 (string)
+ "Returns STRING padded on the right to 12 characters."
+ (concat string (make-string (- 12 (length string)) ?\s)))
+
+;; Convenience macro for generating groups of test cases.
+
+(defmacro formatz-generate-tests
+ (form-strings hour-mod mins-mod secs-mod big-mod secbig-mod)
+ "Defines ert-deftest tests for time formats FORM-STRINGS.
+FORM-STRINGS is a list of formats, each \"%z\" or some variation thereof.
+
+Each of the remaining arguments is an unquoted list of the form
+(SAMPLE-OUTPUT . MODIFIERS). SAMPLE-OUTPUT is the result of the
+FORM-STRINGS for a particular offset, detailed below for each argument.
+The remaining elements of the list, the MODIFIERS, are the names of
+functions to modify the expected results for sets of tests.
+The MODIFIERS do not modify the SAMPLE-OUTPUT.
+
+The one, literal sample output is given in the call to this macro
+to provide a visual check at the call site that the format
+behaves as expected.
+
+HOUR-MOD is the result for offset 0 and modifiers for the other
+expected results for whole hours.
+MINS-MOD is the result for offset +30 minutes and modifiers for the
+other expected results for whole minutes.
+SECS-MOD is the result for offset +30 seconds and modifiers for the
+other expected results for offsets with non-zero seconds.
+BIG-MOD is the result for offset +100 hours and modifiers for the other
+expected results for hours greater than 99 with a whole number of minutes.
+SECBIG-MOD is the result for offset +100 hours 30 seconds and modifiers for
+the other expected results for hours greater than 99 with non-zero seconds."
+ (declare (indent 1))
+ ;; Generate a form to create a list of tests to define. When this
+ ;; macro is called, the form is evaluated, thus defining the tests.
+ (let ((ert-test-list '(list)))
+ (dolist (form-string form-strings ert-test-list)
+ (nconc
+ ert-test-list
+ (list
+ `(ert-deftest ,(intern (concat "formatz-" form-string "-hhmm")) ()
+ ,(concat "Tests time-stamp format " form-string
+ " with whole hours or minutes.")
+ (should (equal (formatz ,form-string (fz-make+zone 0))
+ ,(car hour-mod)))
+ (formatz-hours-exact-helper ,form-string ',(cdr hour-mod))
+ (should (equal (formatz ,form-string (fz-make+zone 0 30))
+ ,(car mins-mod)))
+ (formatz-nonzero-minutes-helper ,form-string ',(cdr mins-mod)))
+ `(ert-deftest ,(intern (concat "formatz-" form-string "-seconds")) ()
+ ,(concat "Tests time-stamp format " form-string
+ " with offsets that have non-zero seconds.")
+ (should (equal (formatz ,form-string (fz-make+zone 0 0 30))
+ ,(car secs-mod)))
+ (formatz-nonzero-seconds-helper ,form-string ',(cdr secs-mod)))
+ `(ert-deftest ,(intern (concat "formatz-" form-string "-threedigit")) ()
+ ,(concat "Tests time-stamp format " form-string
+ " with offsets that are 100 hours or greater.")
+ (should (equal (formatz ,form-string (fz-make+zone 100))
+ ,(car big-mod)))
+ (formatz-hours-big-helper ,form-string ',(cdr big-mod))
+ (should (equal (formatz ,form-string (fz-make+zone 100 0 30))
+ ,(car secbig-mod)))
+ (formatz-seconds-big-helper ,form-string ',(cdr secbig-mod)))
+ )))))
+
+;;;; The actual test cases for %z
+
+;;; %z formats without colons.
+
+;; Option character "-" (minus) minimizes; it removes "00" minutes.
+(formatz-generate-tests ("%-z" "%-3z")
+ ("+00")
+ ("+0030" formatz-mod-del-colons)
+ ("+000030" formatz-mod-del-colons)
+ ("+100:00")
+ ("+100:00:30"))
+;; Tests that minus with padding pads with spaces.
+(formatz-generate-tests ("%-12z")
+ ("+00 " formatz-mod-pad-r12)
+ ("+0030 " formatz-mod-del-colons formatz-mod-pad-r12)
+ ("+000030 " formatz-mod-del-colons formatz-mod-pad-r12)
+ ("+100:00 " formatz-mod-pad-r12)
+ ("+100:00:30 " formatz-mod-pad-r12))
+;; Tests that 0 after other digits becomes padding of ten, not zero flag.
+(formatz-generate-tests ("%-10z")
+ ("+00 " formatz-mod-pad-r10)
+ ("+0030 " formatz-mod-del-colons formatz-mod-pad-r10)
+ ("+000030 " formatz-mod-del-colons formatz-mod-pad-r10)
+ ("+100:00 " formatz-mod-pad-r10)
+ ("+100:00:30"))
+
+;; Although time-stamp doesn't call us for %z, we do want to spot-check
+;; it here, to verify the implementation we will eventually use.
+;; The legacy exception for %z in time-stamp will need to remain
+;; through at least 2024 and Emacs 28.
+(ert-deftest formatz-%z-spotcheck ()
+ "Spot-checks internal implementation of time-stamp format %z."
+ (should (equal (format-time-offset "%z" (fz-make+zone 0)) "+0000"))
+ (should (equal (format-time-offset "%z" (fz-make+zone 0 30)) "+0030"))
+ (should (equal (format-time-offset "%z" (fz-make+zone 0 0 30)) "+000030"))
+ (should (equal (format-time-offset "%z" (fz-make+zone 100)) "+100:00"))
+ (should (equal (format-time-offset "%z" (fz-make+zone 100 0 30)) "+100:00:30"))
+ )
+
+;; Basic %z outputs 4 digits.
+;; Small padding values do not extend the result.
+(formatz-generate-tests (;; We don't check %z here because time-stamp
+ ;; has a legacy behavior for it.
+ ;;"%z"
+ "%5z" "%0z" "%05z")
+ ("+0000" formatz-mod-add-00)
+ ("+0030" formatz-mod-del-colons)
+ ("+000030" formatz-mod-del-colons)
+ ("+100:00")
+ ("+100:00:30"))
+
+;; Tests that padding adds spaces.
+(formatz-generate-tests ("%12z")
+ ("+0000 " formatz-mod-add-00 formatz-mod-pad-r12)
+ ("+0030 " formatz-mod-del-colons formatz-mod-pad-r12)
+ ("+000030 " formatz-mod-del-colons formatz-mod-pad-r12)
+ ("+100:00 " formatz-mod-pad-r12)
+ ("+100:00:30 " formatz-mod-pad-r12))
+
+;; Requiring 0-padding to 6 adds seconds (only) as needed.
+(formatz-generate-tests ("%06z")
+ ("+000000" formatz-mod-add-00 formatz-mod-add-00)
+ ("+003000" formatz-mod-del-colons formatz-mod-add-00)
+ ("+000030" formatz-mod-del-colons)
+ ("+100:00")
+ ("+100:00:30"))
+
+;; Option character "_" always adds seconds.
+(formatz-generate-tests ("%_z" "%_7z")
+ ("+000000" formatz-mod-add-00 formatz-mod-add-00)
+ ("+003000" formatz-mod-del-colons formatz-mod-add-00)
+ ("+000030" formatz-mod-del-colons)
+ ("+100:00:00" formatz-mod-add-colon00)
+ ("+100:00:30"))
+
+;; Enough 0-padding adds seconds, then adds spaces.
+(formatz-generate-tests ("%012z" "%_12z")
+ ("+000000 " formatz-mod-add-00 formatz-mod-add-00 formatz-mod-pad-r12)
+ ("+003000 " formatz-mod-del-colons formatz-mod-add-00 formatz-mod-pad-r12)
+ ("+000030 " formatz-mod-del-colons formatz-mod-pad-r12)
+ ("+100:00:00 " formatz-mod-add-colon00 formatz-mod-pad-r12)
+ ("+100:00:30 " formatz-mod-pad-r12))
+
+;;; %z formats with colons
+
+;; Three colons can output hours only,
+;; like %-z, but uses colons with non-zero minutes and seconds.
+(formatz-generate-tests ("%:::z" "%0:::z"
+ "%3:::z" "%03:::z")
+ ("+00")
+ ("+00:30")
+ ("+00:00:30")
+ ("+100:00")
+ ("+100:00:30"))
+
+;; Padding with three colons adds spaces
+(formatz-generate-tests ("%12:::z")
+ ("+00 " formatz-mod-pad-r12)
+ ("+00:30 " formatz-mod-pad-r12)
+ ("+00:00:30 " formatz-mod-pad-r12)
+ ("+100:00 " formatz-mod-pad-r12)
+ ("+100:00:30 " formatz-mod-pad-r12))
+;; Tests that 0 after other digits becomes padding of ten, not zero flag.
+(formatz-generate-tests ("%10:::z")
+ ("+00 " formatz-mod-pad-r10)
+ ("+00:30 " formatz-mod-pad-r10)
+ ("+00:00:30 " formatz-mod-pad-r10)
+ ("+100:00 " formatz-mod-pad-r10)
+ ("+100:00:30"))
+
+;; One colon outputs minutes, like %z but with colon.
+(formatz-generate-tests ("%:z" "%6:z" "%0:z" "%06:z" "%06:::z")
+ ("+00:00" formatz-mod-add-colon00)
+ ("+00:30")
+ ("+00:00:30")
+ ("+100:00")
+ ("+100:00:30"))
+
+;; Padding with one colon adds spaces
+(formatz-generate-tests ("%12:z")
+ ("+00:00 " formatz-mod-add-colon00 formatz-mod-pad-r12)
+ ("+00:30 " formatz-mod-pad-r12)
+ ("+00:00:30 " formatz-mod-pad-r12)
+ ("+100:00 " formatz-mod-pad-r12)
+ ("+100:00:30 " formatz-mod-pad-r12))
+
+;; Requiring 0-padding to 7 adds seconds (only) as needed.
+(formatz-generate-tests ("%07:z" "%07:::z")
+ ("+00:00:00" formatz-mod-add-colon00 formatz-mod-add-colon00)
+ ("+00:30:00" formatz-mod-add-colon00)
+ ("+00:00:30")
+ ("+100:00")
+ ("+100:00:30"))
+
+;; Two colons outputs HH:MM:SS, like %_z but with colons.
+(formatz-generate-tests ("%::z" "%9::z" "%0::z" "%09::z")
+ ("+00:00:00" formatz-mod-add-colon00 formatz-mod-add-colon00)
+ ("+00:30:00" formatz-mod-add-colon00)
+ ("+00:00:30")
+ ("+100:00:00" formatz-mod-add-colon00)
+ ("+100:00:30"))
+
+;; Enough padding adds minutes and seconds, then adds spaces.
+(formatz-generate-tests ("%012:z" "%012::z" "%12::z" "%012:::z")
+ ("+00:00:00 " formatz-mod-add-colon00 formatz-mod-add-colon00
+ formatz-mod-pad-r12)
+ ("+00:30:00 " formatz-mod-add-colon00 formatz-mod-pad-r12)
+ ("+00:00:30 " formatz-mod-pad-r12)
+ ("+100:00:00 " formatz-mod-add-colon00 formatz-mod-pad-r12)
+ ("+100:00:30 " formatz-mod-pad-r12))
+
+;;; Illegal %z formats
+
+(ert-deftest formatz-illegal-options ()
+ "Tests that illegal/nonsensical/ambiguous %z formats don't produce output."
+ ;; multiple options
+ (should (equal "" (formatz "%_-z" 0)))
+ (should (equal "" (formatz "%-_z" 0)))
+ (should (equal "" (formatz "%_0z" 0)))
+ (should (equal "" (formatz "%0_z" 0)))
+ (should (equal "" (formatz "%0-z" 0)))
+ (should (equal "" (formatz "%-0z" 0)))
+ ;; inconsistent to both minimize and require mins or secs
+ (should (equal "" (formatz "%-:z" 0)))
+ (should (equal "" (formatz "%-::z" 0)))
+ ;; consistent, but redundant
+ (should (equal "" (formatz "%-:::z" 0)))
+ (should (equal "" (formatz "%_::z" 0)))
+ ;; inconsistent to both pre-expand and default to hours or mins
+ (should (equal "" (formatz "%_:::z" 0)))
+ (should (equal "" (formatz "%_:z" 0)))
+ ;; options that don't make sense with %z
+ (should (equal "" (formatz "%#z" 0)))
+ )
+
;;; time-stamp-tests.el ends here
diff --git a/test/lisp/time-tests.el b/test/lisp/time-tests.el
index 3cf8b540cbc..88b7638d91d 100644
--- a/test/lisp/time-tests.el
+++ b/test/lisp/time-tests.el
@@ -50,6 +50,7 @@
(? (| "AM" "PM"))
" " (+ (| digit "."))
(? " Mail")
+ " "
string-end)
display-time-string))))
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index f4e5c89afb4..fefe50d5173 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -203,6 +203,148 @@ youthfulness
(kill-buffer buf2)
(delete-directory temp-dir 'recursive))))))
+(ert-deftest diff-mode-test-hunk-text-no-newline ()
+ "Check output of `diff-hunk-text' with no newline at end of file."
+
+ ;; First check unified change/remove/add cases with newline
+ (let ((hunk "\
+@@ -1 +1 @@
+-foo
++bar
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo
+"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar
+")))
+
+ (let ((hunk "\
+@@ -1 +0,0 @@
+-foo
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo
+"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+")))
+
+ (let ((hunk "\
+@@ -0,0 +1 @@
++bar
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar
+")))
+
+ ;; Check unified change/remove cases with no newline in old file
+ (let ((hunk "\
+@@ -1 +1 @@
+-foo
+\\ No newline at end of file
++bar
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar
+")))
+
+ (let ((hunk "\
+@@ -1 +0,0 @@
+-foo
+\\ No newline at end of file
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+")))
+
+ ;; Check unified change/add cases with no newline in new file
+ (let ((hunk "\
+@@ -1 +1 @@
+-foo
++bar
+\\ No newline at end of file
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo
+"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar")))
+
+ (let ((hunk "\
+@@ -0,0 +1 @@
++bar
+\\ No newline at end of file
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar")))
+
+ ;; Check unified change case with no newline in both old/new file
+ (let ((hunk "\
+@@ -1 +1 @@
+-foo
+\\ No newline at end of file
++bar
+\\ No newline at end of file
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar")))
+
+ ;; Check context-after unified change case with no newline in both old/new file
+ (let ((hunk "\
+@@ -1,2 +1,2 @@
+-foo
++bar
+ baz
+\\ No newline at end of file
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo
+baz"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar
+baz")))
+
+ (let ((hunk "\
+@@ -1,2 +1,2 @@
+-foo
+-baz
+\\ No newline at end of file
++bar
++baz
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo
+baz"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar
+baz
+")))
+
+ (let ((hunk "\
+@@ -1,2 +1,2 @@
+-foo
+-baz
++bar
++baz
+\\ No newline at end of file
+"))
+ (should (equal (diff-hunk-text hunk nil nil) "\
+foo
+baz
+"))
+ (should (equal (diff-hunk-text hunk t nil) "\
+bar
+baz"))))
+
(ert-deftest diff-mode-test-font-lock ()
"Check font-locking of diff hunks."
;; See comments in diff-hunk-file-names about nonascii.
@@ -326,4 +468,16 @@ youthfulness
(114 131 (diff-mode syntax face font-lock-string-face))
(134 140 (diff-mode syntax face font-lock-keyword-face))))))))
+(ert-deftest test-hunk-file-names ()
+ (with-temp-buffer
+ (insert "diff -c /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n")
+ (goto-char (point-min))
+ (should (equal (diff-hunk-file-names)
+ '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))
+ (with-temp-buffer
+ (insert "diff -c -L /ftp:slbhao:/home/albinus/src/tramp/lisp/tramp.el -L /ftp:slbhao:/home/albinus/src/emacs/lisp/net/tramp.el /tmp/ange-ftp13518wvE.el /tmp/ange-ftp1351895K.el\n")
+ (goto-char (point-min))
+ (should (equal (diff-hunk-file-names)
+ '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))))
+
(provide 'diff-mode-tests)
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index aeab51ec261..b02dce8f707 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -1,4 +1,4 @@
-;;; vc-bzr.el --- tests for vc/vc-bzr.el -*- lexical-binding: t -*-
+;;; vc-bzr-tests.el --- tests for vc/vc-bzr.el -*- lexical-binding: t -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index ba276e24d96..96a01fc2c7b 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -31,7 +31,7 @@ Partially modifying a file name should succeed."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
- (new-file (replace-regexp-in-string "foo" replace test-file))
+ (new-file (string-replace "foo" replace test-file))
(wdired-use-interactive-rename t))
(write-region "" nil test-file nil 'silent)
(advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
@@ -109,7 +109,7 @@ wdired-mode."
(let* ((test-dir (make-temp-file "test-dir-" t))
(test-file (concat (file-name-as-directory test-dir) "foo.c"))
(replace "bar")
- (new-file (replace-regexp-in-string "foo" replace test-file)))
+ (new-file (string-replace "foo" replace test-file)))
(write-region "" nil test-file nil 'silent)
(let ((buf (find-file-noselect test-dir)))
(unwind-protect
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index cd3e1138f4b..b00b58acfc5 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -1,4 +1,4 @@
-;;; xml-parse-tests.el --- Test suite for XML parsing. -*- lexical-binding:t -*-
+;;; xml-tests.el --- Test suite for XML parsing. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
diff --git a/test/manual/biditest.el b/test/manual/biditest.el
index dc78ef55b03..a77fc158807 100644
--- a/test/manual/biditest.el
+++ b/test/manual/biditest.el
@@ -1,4 +1,4 @@
-;;; biditest.el --- test bidi reordering in GNU Emacs display engine.
+;;; biditest.el --- test bidi reordering in GNU Emacs display engine. -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -54,7 +54,7 @@ The resulting file should be viewed with `inhibit-bidi-mirroring' set to t."
(resolved-paragraph (match-string 3))
;; FIXME: Should compare LEVELS with what the display
;; engine actually produced.
- (levels (match-string 4))
+ ;;(levels (match-string 4))
(indices (match-string 5)))
(setq codes (split-string codes " ")
indices (split-string indices " "))
@@ -120,4 +120,4 @@ BidiCharacterTest.txt file."
(interactive)
(message "%s" (bidi-resolved-levels)))
-(define-key global-map [f8] 'bidi-levels)
+(define-key global-map [f8] #'bidi-levels)
diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el
index 7805fce2d12..d68b5b8c090 100644
--- a/test/manual/cedet/cedet-utests.el
+++ b/test/manual/cedet/cedet-utests.el
@@ -1,4 +1,4 @@
-;;; cedet-utests.el --- Run all unit tests in the CEDET suite.
+;;; cedet-utests.el --- Run all unit tests in the CEDET suite. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -26,7 +26,6 @@
;; into one command.
(require 'cedet)
-(require 'inversion)
(defvar cedet-utest-directory
(let* ((C (file-name-directory (locate-library "cedet")))
@@ -36,7 +35,6 @@
(defvar cedet-utest-libs '("ede-tests"
"semantic-tests"
- "srecode-tests"
)
"List of test srcs that need to be loaded.")
@@ -48,7 +46,7 @@
;;
;; Test inversion
- ("inversion" . inversion-unit-test)
+ ;; ("inversion" . inversion-unit-test) ; moved to automated suite
;; EZ Image dumping.
("ezimage associations" . ezimage-image-association-dump)
@@ -60,7 +58,7 @@
("pulse interactive test" . (lambda () (pulse-test t)))
;; Files
- ("cedet file conversion" . cedet-files-utest)
+ ;; ("cedet file conversion" . cedet-files-utest) ; moved to automated suite
;;
;; EIEIO
@@ -100,14 +98,14 @@
(message " ** Skipping test in noninteractive mode.")
(semantic-test-throw-on-input))))
- ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser)
+ ;;("semantic: gcc: output parse test" . semantic-gcc-test-output-parser) ; moved to automated suite
;;
;; SRECODE
;;
;; TODO - fix the fields test
- ;;("srecode: fields" . srecode-field-utest)
+ ;;("srecode: fields" . srecode-field-utest) ; moved to automated suite
;;("srecode: templates" . srecode-utest-template-output)
("srecode: show maps" . srecode-get-maps)
;;("srecode: getset" . srecode-utest-getset-output)
@@ -122,9 +120,9 @@
EXIT-ON-ERROR causes the test suite to exit on an error, instead
of just logging the error."
(interactive)
- (if (or (not (featurep 'semantic/db-mode))
- (not (semanticdb-minor-mode-p)))
- (error "CEDET Tests require semantic-mode to be enabled"))
+ (unless (and (fboundp 'semanticdb-minor-mode-p)
+ (semanticdb-minor-mode-p))
+ (error "CEDET Tests require semantic-mode to be enabled"))
(dolist (L cedet-utest-libs)
(load-file (expand-file-name (concat L ".el") cedet-utest-directory)))
(cedet-utest-log-setup "ALL TESTS")
@@ -172,6 +170,8 @@ of just logging the error."
(declare (obsolete nil "27.1"))
noninteractive)
+(defvar srecode-map-save-file)
+
;;;###autoload
(defun cedet-utest-batch ()
"Run the CEDET unit test in BATCH mode."
@@ -180,6 +180,7 @@ of just logging the error."
(condition-case err
(when (catch 'cedet-utest-exit-on-error
;; Get basic semantic features up.
+ ;; FIXME: I can't see any such function in our code!
(semantic-load-enable-minimum-features)
;; Disables all caches related to semantic DB so all
;; tests run as if we have bootstrapped CEDET for the
@@ -233,8 +234,7 @@ Optional argument TITLE is the title of this testing session."
(setq cedet-utest-frame (make-frame cedet-utest-frame-parameters)))
(when (or (not cedet-utest-buffer) (not (buffer-live-p cedet-utest-buffer)))
(setq cedet-utest-buffer (get-buffer-create "*CEDET utest log*")))
- (save-excursion
- (set-buffer cedet-utest-buffer)
+ (with-current-buffer cedet-utest-buffer
(setq cedet-utest-last-log-item nil)
(when (not cedet-running-master-tests)
(erase-buffer))
@@ -256,7 +256,7 @@ Argument START and END bound the time being calculated."
(- (car (cdr end)) (car (cdr start)))
(/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
-(defun cedet-utest-log-shutdown (title &optional errorcondition)
+(defun cedet-utest-log-shutdown (title &optional _errorcondition)
"Shut-down a larger test suite.
TITLE is the section that is done.
ERRORCONDITION is some error that may have occurred during testing."
@@ -276,8 +276,7 @@ ERRORCONDITION is some error that may have occurred during testing."
(message " Elapsed Time %.2f Seconds\n"
(cedet-utest-elapsed-time startime endtime)))
- (save-excursion
- (set-buffer cedet-utest-buffer)
+ (with-current-buffer cedet-utest-buffer
(goto-char (point-max))
(insert "\n>> Test Suite " title " ended at @ "
(format-time-string "%c" endtime) "\n"
@@ -307,12 +306,11 @@ ERRORCONDITION is some error that may have occurred during testing."
"Hook run after the current log command was run."
(if noninteractive
(message "")
- (save-excursion
- (set-buffer cedet-utest-buffer)
+ (with-current-buffer cedet-utest-buffer
(goto-char (point-max))
(insert "\n\n")))
(setq cedet-utest-last-log-item nil)
- (remove-hook 'post-command-hook 'cedet-utest-post-command-hook)
+ (remove-hook 'post-command-hook #'cedet-utest-post-command-hook)
)
(defun cedet-utest-add-log-item-start (item)
@@ -320,12 +318,11 @@ ERRORCONDITION is some error that may have occurred during testing."
(unless (equal item cedet-utest-last-log-item)
(setq cedet-utest-last-log-item item)
;; This next line makes sure we clear out status during logging.
- (add-hook 'post-command-hook 'cedet-utest-post-command-hook)
+ (add-hook 'post-command-hook #'cedet-utest-post-command-hook)
(if noninteractive
(message " - Running %s ..." item)
- (save-excursion
- (set-buffer cedet-utest-buffer)
+ (with-current-buffer cedet-utest-buffer
(goto-char (point-max))
(when (not (bolp)) (insert "\n"))
(insert "Running " item " ... ")
@@ -345,8 +342,7 @@ Optional argument PRECR indicates to prefix the done msg w/ a newline."
(message " * %s {%s}" (or err "done") notes)
(message " * %s" (or err "done")))
;; Interactive-mode - insert into the buffer.
- (save-excursion
- (set-buffer cedet-utest-buffer)
+ (with-current-buffer cedet-utest-buffer
(goto-char (point-max))
(when precr (insert "\n"))
(if err
@@ -376,126 +372,36 @@ Optional argument PRECR indicates to prefix the done msg w/ a newline."
(cedet-utest-add-log-item-start testname)
))
-(defun cedet-utest-log(format &rest args)
+(defun cedet-utest-log (format &rest args)
"Log the text string FORMAT.
The rest of the ARGS are used to fill in FORMAT with `format'."
(if noninteractive
- (apply 'message format args)
- (save-excursion
- (set-buffer cedet-utest-buffer)
+ (apply #'message format args)
+ (with-current-buffer cedet-utest-buffer
(goto-char (point-max))
(when (not (bolp)) (insert "\n"))
- (insert (apply 'format format args))
+ (insert (apply #'format format args))
(insert "\n")
(sit-for 0)
))
(cedet-utest-show-log-end)
)
-;;; Inversion tests
-
-(defun inversion-unit-test ()
- "Test inversion to make sure it can identify different version strings."
- (interactive)
- (let ((c1 (inversion-package-version 'inversion))
- (c1i (inversion-package-incompatibility-version 'inversion))
- (c2 (inversion-decode-version "1.3alpha2"))
- (c3 (inversion-decode-version "1.3beta4"))
- (c4 (inversion-decode-version "1.3 beta5"))
- (c5 (inversion-decode-version "1.3.4"))
- (c6 (inversion-decode-version "2.3alpha"))
- (c7 (inversion-decode-version "1.3"))
- (c8 (inversion-decode-version "1.3pre1"))
- (c9 (inversion-decode-version "2.4 (patch 2)"))
- (c10 (inversion-decode-version "2.4 (patch 3)"))
- (c11 (inversion-decode-version "2.4.2.1"))
- (c12 (inversion-decode-version "2.4.2.2"))
- )
- (if (not (and
- (inversion-= c1 c1)
- (inversion-< c1i c1)
- (inversion-< c2 c3)
- (inversion-< c3 c4)
- (inversion-< c4 c5)
- (inversion-< c5 c6)
- (inversion-< c2 c4)
- (inversion-< c2 c5)
- (inversion-< c2 c6)
- (inversion-< c3 c5)
- (inversion-< c3 c6)
- (inversion-< c7 c6)
- (inversion-< c4 c7)
- (inversion-< c2 c7)
- (inversion-< c8 c6)
- (inversion-< c8 c7)
- (inversion-< c4 c8)
- (inversion-< c2 c8)
- (inversion-< c9 c10)
- (inversion-< c10 c11)
- (inversion-< c11 c12)
- ;; Negatives
- (not (inversion-< c3 c2))
- (not (inversion-< c4 c3))
- (not (inversion-< c5 c4))
- (not (inversion-< c6 c5))
- (not (inversion-< c7 c2))
- (not (inversion-< c7 c8))
- (not (inversion-< c12 c11))
- ;; Test the tester on inversion
- (not (inversion-test 'inversion inversion-version))
- ;; Test that we throw an error
- (inversion-test 'inversion "0.0.0")
- (inversion-test 'inversion "1000.0")
- ))
- (error "Inversion tests failed")
- (message "Inversion tests passed."))))
-
-;;; cedet-files unit test
-
-(defvar cedet-files-utest-list
- '(
- ( "/home/me/src/myproj/src/foo.c" . "!home!me!src!myproj!src!foo.c" )
- ( "c:/work/myproj/foo.el" . "!drive_c!work!myproj!foo.el" )
- ( "//windows/proj/foo.java" . "!!windows!proj!foo.java" )
- ( "/home/me/proj!bang/foo.c" . "!home!me!proj!!bang!foo.c" )
- )
- "List of different file names to test.
-Each entry is a cons cell of ( FNAME . CONVERTED )
-where FNAME is some file name, and CONVERTED is what it should be
-converted into.")
-
-(defun cedet-files-utest ()
- "Test out some file name conversions."
- (interactive)
- (let ((idx 0))
- (dolist (FT cedet-files-utest-list)
-
- (setq idx (+ idx 1))
-
- (let ((dir->file (cedet-directory-name-to-file-name (car FT) t))
- (file->dir (cedet-file-name-to-directory-name (cdr FT) t))
- )
-
- (unless (string= (cdr FT) dir->file)
- (error "Failed: %d. Found: %S Wanted: %S"
- idx dir->file (cdr FT))
- )
-
- (unless (string= file->dir (car FT))
- (error "Failed: %d. Found: %S Wanted: %S"
- idx file->dir (car FT)))))))
-
;;; pulse test
(defun pulse-test (&optional no-error)
"Test the lightening function for pulsing a line.
When optional NO-ERROR don't throw an error if we can't run tests."
(interactive)
- (if (or (not pulse-flag) (not (pulse-available-p)))
+ (if (not (and (bound-and-true-p pulse-flag)
+ (fboundp 'pulse-available-p)
+ (pulse-available-p)))
(if no-error
nil
(error (concat "Pulse test only works on versions of Emacs"
" that support pulsing")))
+ (declare-function pulse-momentary-highlight-overlay
+ "pulse.el" (o &optional face))
;; Run the tests
(when (called-interactively-p 'interactive)
(message "<Press a key> Pulse one line.")
diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el
index eb3132398a6..2af50860c60 100644
--- a/test/manual/cedet/ede-tests.el
+++ b/test/manual/cedet/ede-tests.el
@@ -1,4 +1,4 @@
-;;; ede-tests.el --- Some tests for the Emacs Development Environment
+;;; ede-tests.el --- Some tests for the Emacs Development Environment -*- lexical-binding: t -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -42,8 +42,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-global (file)
"Test EDE Locate on FILE using GNU Global type.
@@ -55,8 +54,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-idutils (file)
"Test EDE Locate on FILE using ID Utils type.
@@ -68,8 +66,7 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
(defun ede-locate-test-cscope (file)
"Test EDE Locate on FILE using CScope type.
@@ -81,7 +78,6 @@ The search is done with the current EDE root."
(ede-toplevel)))))
(data-debug-new-buffer "*EDE Locate ADEBUG*")
(ede-locate-file-in-project loc file)
- (data-debug-insert-object-slots loc "]"))
- )
+ (data-debug-insert-object-slots loc "]")))
;;; ede-test.el ends here
diff --git a/test/manual/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el
index 716bcc7abed..1561c18dd68 100644
--- a/test/manual/cedet/semantic-tests.el
+++ b/test/manual/cedet/semantic-tests.el
@@ -1,6 +1,6 @@
-;;; semantic-utest.el --- Miscellaneous Semantic tests.
+;;; semantic-tests.el --- Miscellaneous Semantic tests. -*- lexical-binding: t; -*-
-;;; Copyright (C) 2003-2004, 2007-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2021 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -64,10 +64,12 @@ run the test again")))
"Find the first loaded ebrowse table, and dump out the contents."
(interactive)
(let ((db semanticdb-database-list)
- (ab nil))
+ ;; (ab nil)
+ )
(while db
(when (semanticdb-project-database-ebrowse-p (car db))
- (setq ab (data-debug-new-buffer "*EBROWSE Database*"))
+ ;; (setq ab
+ (data-debug-new-buffer "*EBROWSE Database*") ;;)
(data-debug-insert-thing (car db) "*" "")
(setq db nil)
)
@@ -100,7 +102,7 @@ If optional arg STANDARDFILE is non-nil, use a standard file w/ global enabled."
(set-buffer (find-file-noselect semanticdb-test-gnu-global-startfile)))
(semanticdb-enable-gnu-global-in-buffer))))
- (let* ((db (semanticdb-project-database-global "global"))
+ (let* ((db (semanticdb-project-database-global)) ;; "global"
(tab (semanticdb-file-table db (buffer-file-name)))
(result (semanticdb-deep-find-tags-for-completion-method tab searchfor))
)
@@ -127,8 +129,7 @@ Optional argument ARG specifies not to use color."
(princ (car fns))
(princ ":\n ")
(let ((s (funcall (car fns) tag par (not arg))))
- (save-excursion
- (set-buffer "*format-tag*")
+ (with-current-buffer "*format-tag*"
(goto-char (point-max))
(insert s)))
(setq fns (cdr fns))))
@@ -138,21 +139,6 @@ Optional argument ARG specifies not to use color."
(require 'semantic/fw)
-(defun semantic-test-data-cache ()
- "Test the data cache."
- (interactive)
- (let ((data '(a b c)))
- (save-excursion
- (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
- (erase-buffer)
- (insert "The Moose is Loose")
- (goto-char (point-min))
- (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
- data 'moose 'exit-cache-zone)
- (if (equal (semantic-get-cache-data 'moose) data)
- (message "Successfully retrieved cached data.")
- (error "Failed to retrieve cached data")))))
-
(defun semantic-test-throw-on-input ()
"Test that throw on input will work."
(interactive)
@@ -178,7 +164,7 @@ 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)))
+ (_junk (semantic-idle-scheduler-work-parse-neighboring-files)))
(message "Work took %.2f seconds." (semantic-elapsed-time start nil))))
;;; From semantic-lex:
@@ -225,6 +211,8 @@ Analyze the area between BEG and END."
(semantic-lex-spp-table-write-slot-value
(semantic-lex-spp-save-table))))
+(defvar cedet-utest-directory) ;From test/manual/cedet/cedet-utests.el?
+
(defun semantic-lex-spp-write-utest ()
"Unit test using the test spp file to test the slot write fcn."
(interactive)
@@ -273,7 +261,7 @@ tag that contains point, and return that."
(Lcount 0))
(when (semantic-tag-p target)
(semantic-symref-hits-in-region
- target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
+ target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount)))
(semantic-tag-start tag)
(semantic-tag-end tag))
(when (called-interactively-p 'interactive)
@@ -281,110 +269,3 @@ tag that contains point, and return that."
Lcount (semantic-tag-name target)
(semantic-elapsed-time start nil)))
Lcount)))
-
-;;; From bovine-gcc:
-
-(require 'semantic/bovine/gcc)
-
-;; Example output of "gcc -v"
-(defvar semantic-gcc-test-strings
- '(;; My old box:
- "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux
-Thread model: posix
-gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
- ;; Alex Ott:
- "Using built-in specs.
-Target: i486-linux-gnu
-Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu
-Thread model: posix
-gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
- ;; My debian box:
- "Using built-in specs.
-Target: x86_64-unknown-linux-gnu
-Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib
-Thread model: posix
-gcc version 4.2.3"
- ;; My mac:
- "Using built-in specs.
-Target: i686-apple-darwin8
-Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8
-Thread model: posix
-gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
- ;; Ubuntu Intrepid
- "Using built-in specs.
-Target: x86_64-linux-gnu
-Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu
-Thread model: posix
-gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
- ;; Red Hat EL4
- "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux
-Thread model: posix
-gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
- ;; Red Hat EL5
- "Using built-in specs.
-Target: x86_64-redhat-linux
-Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux
-Thread model: posix
-gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
- ;; David Engster's german gcc on ubuntu 4.3
- "Es werden eingebaute Spezifikationen verwendet.
-Ziel: i486-linux-gnu
-Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu
-Thread-Modell: posix
-gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
- ;; Damien Deville bsd
- "Using built-in specs.
-Target: i386-undermydesk-freebsd
-Configured with: FreeBSD/i386 system compiler
-Thread model: posix
-gcc version 4.2.1 20070719 [FreeBSD]"
- )
- "A bunch of sample gcc -v outputs from different machines.")
-
-(defvar semantic-gcc-test-strings-fail
- '(;; A really old solaris box I found
- "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
-gcc version 2.95.2 19991024 (release)"
- )
- "A bunch of sample gcc -v outputs that fail to provide the info we want.")
-
-(defun semantic-gcc-test-output-parser ()
- "Test the output parser against some collected strings."
- (interactive)
- (let ((fail nil))
- (dolist (S semantic-gcc-test-strings)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc 'target fields))
- (cdr (assoc '--target fields))
- (cdr (assoc '--host fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- ;; No longer test for prefixes.
- (when (not (and v h))
- (let ((strs (split-string S "\n")))
- (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))
- (setq fail t))
- ))
- (dolist (S semantic-gcc-test-strings-fail)
- (let* ((fields (semantic-gcc-fields S))
- (v (cdr (assoc 'version fields)))
- (h (or (cdr (assoc '--host fields))
- (cdr (assoc 'target fields))))
- (p (cdr (assoc '--prefix fields)))
- )
- (when (and v h p)
- (message "Negative test failed on %S" S)
- (setq fail t))
- ))
- (if (not fail) (message "Tests passed."))
- ))
-
-(defun semantic-gcc-test-output-parser-this-machine ()
- "Test the output parser against the machine currently running Emacs."
- (interactive)
- (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
- (semantic-gcc-test-output-parser))
- )
diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el
index 3bc945d89f8..d1d0d1602f4 100644
--- a/test/manual/cedet/tests/test.el
+++ b/test/manual/cedet/tests/test.el
@@ -1,4 +1,4 @@
-;;; test.el --- Unit test file for Semantic Emacs Lisp support.
+;;; test.el --- Unit test file for Semantic Emacs Lisp support. -*- lexical-binding: t -*-
;; Copyright (C) 2005-2021 Free Software Foundation, Inc.
@@ -153,7 +153,4 @@
(defvar-mode-local emacs-lisp-mode a-mode-local-def
"some value")
-
-;;; Provide
-;;
(provide 'test)
diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good
index 5e582434a62..84a56b23cfa 100644
--- a/test/manual/etags/CTAGS.good
+++ b/test/manual/etags/CTAGS.good
@@ -759,6 +759,7 @@ Install_Abort_Handler/p ada-src/2ataspri.ads /^ procedure Install_Abort_Handle
Install_Error_Handler/p ada-src/2ataspri.adb /^ procedure Install_Error_Handler (Handler : Syst/
Install_Error_Handler/p ada-src/2ataspri.ads /^ procedure Install_Error_Handler (Handler : Syst/
Invoking gzip tex-src/gzip.texi /^@node Invoking gzip, Advanced usage, Sample, Top$/
+IpAddrKind rs-src/test.rs 3
IsControlChar pas-src/common.pas /^function IsControlChar; (*($/
IsControlCharName pas-src/common.pas /^function IsControlCharName($/
Is_Set/f ada-src/2ataspri.adb /^ function Is_Set (Cell : in TAS_Cell) return Bo/
@@ -984,6 +985,7 @@ MoveLayerBottom lua-src/allegro.lua /^function MoveLayerBottom ()$/
MoveLayerTop lua-src/allegro.lua /^function MoveLayerTop ()$/
Mtest.go go-src/test.go 1
Mtest.go go-src/test.go /^func main() {$/
+Mtest.rs rs-src/test.rs /^fn main() {$/
Mtest1.go go-src/test1.go 1
Mtest1.go go-src/test1.go /^func main() {$/
Mx.cc cp-src/x.cc /^main(int argc, char *argv[])$/
@@ -1153,7 +1155,6 @@ Python_help c-src/etags.c 660
Python_suffixes c-src/etags.c 658
QUIT c-src/emacs/src/lisp.h 3101
QUITP c-src/emacs/src/lisp.h 3112
-Qpre_abbrev_expand_hook c-src/abbrev.c 83
RANGED_INTEGERP c-src/emacs/src/lisp.h /^RANGED_INTEGERP (intmax_t lo, Lisp_Object x, intma/
RCSid objc-src/PackInsp.m 30
READABLE_EVENTS_DO_TIMERS_NOW c-src/emacs/src/keyboard.c 346
@@ -1498,7 +1499,6 @@ Vglobal_abbrev_table c-src/abbrev.c 48
Vlast_abbrev c-src/abbrev.c 70
Vlast_abbrev_text c-src/abbrev.c 75
Vlispy_mouse_stem c-src/emacs/src/keyboard.c 5172
-Vpre_abbrev_expand_hook c-src/abbrev.c 83
WAIT_READING_MAX c-src/emacs/src/lisp.h 4281
WAIT_READING_MAX c-src/emacs/src/lisp.h 4283
WARNINGS make-src/Makefile /^WARNINGS=-pedantic -Wall -Wpointer-arith -Winline /
@@ -1732,7 +1732,6 @@ Z c-src/h.h 100
\1 c-src/abbrev.c /^ DEFVAR_PER_BUFFER ("local-abbrev-table", &curren/
\1 c-src/abbrev.c /^ DEFVAR_BOOL ("abbrevs-changed", &abbrevs_changed/
\1 c-src/abbrev.c /^ DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps/
-\1 c-src/abbrev.c /^ DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abb/
\1 c-src/emacs/src/keyboard.c /^ DEFVAR_LISP ("internal--top-level-message", Vint/
\1 c-src/emacs/src/keyboard.c /^ DEFVAR_LISP ("last-command-event", last_command_/
\1 c-src/emacs/src/keyboard.c /^ DEFVAR_LISP ("last-nonmenu-event", last_nonmenu_/
@@ -2462,8 +2461,47 @@ abs/f ada-src/etags-test-for.ada /^ function "abs" (Right : Complex) return
absolute_dirname c-src/etags.c /^absolute_dirname (char *file, char *dir)$/
absolute_filename c-src/etags.c /^absolute_filename (char *file, char *dir)$/
abt cp-src/c.C 55
+acc_pred_info merc-src/accumulator.m /^:- pred acc_pred_info(list(mer_type)::in, list(pro/
+acc_proc_info merc-src/accumulator.m /^:- pred acc_proc_info(list(prog_var)::in, prog_var/
+acc_unification merc-src/accumulator.m /^:- pred acc_unification(pair(prog_var)::in, hlds_g/
+acc_var_subst_init merc-src/accumulator.m /^:- pred acc_var_subst_init(list(prog_var)::in,$/
accent_key_syms c-src/emacs/src/keyboard.c 4625
access_keymap_keyremap c-src/emacs/src/keyboard.c /^access_keymap_keyremap (Lisp_Object map, Lisp_Obje/
+accu_assoc merc-src/accumulator.m /^:- pred accu_assoc(module_info::in, vartypes::in, /
+accu_assoc merc-src/accumulator.m /^:- type accu_assoc$/
+accu_base merc-src/accumulator.m /^:- type accu_base$/
+accu_before merc-src/accumulator.m /^:- pred accu_before(module_info::in, vartypes::in,/
+accu_case merc-src/accumulator.m /^:- type accu_case$/
+accu_construct merc-src/accumulator.m /^:- pred accu_construct(module_info::in, vartypes::/
+accu_construct_assoc merc-src/accumulator.m /^:- pred accu_construct_assoc(module_info::in, vart/
+accu_create_goal merc-src/accumulator.m /^:- pred accu_create_goal(accu_goal_id::in, list(pr/
+accu_divide_base_case merc-src/accumulator.m /^:- pred accu_divide_base_case(module_info::in, var/
+accu_goal_id merc-src/accumulator.m /^:- type accu_goal_id$/
+accu_goal_list merc-src/accumulator.m /^:- func accu_goal_list(list(accu_goal_id), accu_go/
+accu_goal_store merc-src/accumulator.m /^:- type accu_goal_store == goal_store(accu_goal_id/
+accu_has_heuristic merc-src/accumulator.m /^:- pred accu_has_heuristic(module_name::in, string/
+accu_heuristic merc-src/accumulator.m /^:- pred accu_heuristic(module_name::in, string::in/
+accu_is_associative merc-src/accumulator.m /^:- pred accu_is_associative(module_info::in, pred_/
+accu_is_update merc-src/accumulator.m /^:- pred accu_is_update(module_info::in, pred_id::i/
+accu_process_assoc_set merc-src/accumulator.m /^:- pred accu_process_assoc_set(module_info::in, ac/
+accu_process_update_set merc-src/accumulator.m /^:- pred accu_process_update_set(module_info::in, a/
+accu_related merc-src/accumulator.m /^:- pred accu_related(module_info::in, vartypes::in/
+accu_rename merc-src/accumulator.m /^:- func accu_rename(list(accu_goal_id), accu_subst/
+accu_sets merc-src/accumulator.m /^:- type accu_sets$/
+accu_sets_init merc-src/accumulator.m /^:- pred accu_sets_init(accu_sets::out) is det.$/
+accu_stage1 merc-src/accumulator.m /^:- pred accu_stage1(module_info::in, vartypes::in,/
+accu_stage1_2 merc-src/accumulator.m /^:- pred accu_stage1_2(module_info::in, vartypes::i/
+accu_stage2 merc-src/accumulator.m /^:- pred accu_stage2(module_info::in, proc_info::in/
+accu_stage3 merc-src/accumulator.m /^:- pred accu_stage3(accu_goal_id::in, list(prog_va/
+accu_standardize merc-src/accumulator.m /^:- pred accu_standardize(hlds_goal::in, hlds_goal:/
+accu_store merc-src/accumulator.m /^:- pred accu_store(accu_case::in, hlds_goal::in,$/
+accu_subst merc-src/accumulator.m /^:- type accu_subst == map(prog_var, prog_var).$/
+accu_substs merc-src/accumulator.m /^:- type accu_substs$/
+accu_substs_init merc-src/accumulator.m /^:- pred accu_substs_init(list(prog_var)::in, prog_/
+accu_top_level merc-src/accumulator.m /^:- pred accu_top_level(top_level::in, hlds_goal::i/
+accu_transform_proc merc-src/accumulator.m /^:- pred accu_transform_proc(pred_proc_id::in, pred/
+accu_update merc-src/accumulator.m /^:- pred accu_update(module_info::in, vartypes::in,/
+accu_warning merc-src/accumulator.m /^:- type accu_warning$/
act prol-src/natded.prolog /^act(OutForm,OutSyn,Ws):-$/
action prol-src/natded.prolog /^action(KeyVals):-$/
active_maps c-src/emacs/src/keyboard.c /^active_maps (Lisp_Object first_event)$/
@@ -2535,6 +2573,8 @@ assemby-code-word forth-src/test-forth.fth /^code assemby-code-word ( dunno what
assert c-src/etags.c 135
assert c-src/etags.c /^# define assert(x) ((void) 0)$/
assign_neighbor cp-src/clheir.hpp /^ void assign_neighbor(int direction, location */
+assoc_list merc-src/accumulator.m /^:- import_module assoc_list.$/
+associativity_assertion merc-src/accumulator.m /^:- pred associativity_assertion(module_info::in, l/
at_end c-src/etags.c 249
at_filename c-src/etags.c 247
at_language c-src/etags.c 245
@@ -2568,6 +2608,8 @@ bas_syn prol-src/natded.prolog /^bas_syn(n(_)).$/
base c-src/emacs/src/lisp.h 2188
base cp-src/c.C /^double base (void) const { return rng_base; }$/
base cp-src/Range.h /^ double base (void) const { return rng_base; }$/
+base_case_ids merc-src/accumulator.m /^:- func base_case_ids(accu_goal_store) = list(accu/
+base_case_ids_set merc-src/accumulator.m /^:- func base_case_ids_set(accu_goal_store) = set(a/
baz= ruby-src/test1.ru /^ :baz,$/
bb c.c 275
bbb c.c 251
@@ -2605,6 +2647,7 @@ bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/
bodyindent tex-src/texinfo.tex /^\\advance\\leftskip by \\defbodyindent \\advance \\righ/
bodyindent tex-src/texinfo.tex /^\\exdentamount=\\defbodyindent$/
bool c.c 222
+bool merc-src/accumulator.m /^:- import_module bool.$/
bool_header_size c-src/emacs/src/lisp.h 1472
bool_vector_bitref c-src/emacs/src/lisp.h /^bool_vector_bitref (Lisp_Object a, EMACS_INT i)$/
bool_vector_bytes c-src/emacs/src/lisp.h /^bool_vector_bytes (EMACS_INT size)$/
@@ -2646,6 +2689,7 @@ c_ext c-src/etags.c 2271
caccacacca c.c /^caccacacca (a,b,c,d,e,f,g)$/
cacheLRUEntry_s c.c 172
cacheLRUEntry_t c.c 177
+calculate_goal_info merc-src/accumulator.m /^:- pred calculate_goal_info(hlds_goal_expr::in, hl/
calloc c-src/emacs/src/gmalloc.c 66
calloc c-src/emacs/src/gmalloc.c 70
calloc c-src/emacs/src/gmalloc.c /^calloc (size_t nmemb, size_t size)$/
@@ -2666,6 +2710,8 @@ cgrep html-src/software.html /^cgrep$/
chain c-src/emacs/src/lisp.h 1162
chain c-src/emacs/src/lisp.h 2206
chain c-src/emacs/src/lisp.h 2396
+chain_subst merc-src/accumulator.m /^:- func chain_subst(accu_subst, accu_subst) = accu/
+chain_subst_2 merc-src/accumulator.m /^:- pred chain_subst_2(list(A)::in, map(A, B)::in, /
char_bits c-src/emacs/src/lisp.h 2443
char_table_specials c-src/emacs/src/lisp.h 1692
charpos c-src/emacs/src/lisp.h 2011
@@ -2708,6 +2754,7 @@ command_loop_1 c-src/emacs/src/keyboard.c /^command_loop_1 (void)$/
command_loop_2 c-src/emacs/src/keyboard.c /^command_loop_2 (Lisp_Object ignore)$/
command_loop_level c-src/emacs/src/keyboard.c 195
comment php-src/lce_functions.php /^ function comment($line, $class)$/
+commutativity_assertion merc-src/accumulator.m /^:- pred commutativity_assertion(module_info::in,li/
compile_empty prol-src/natded.prolog /^compile_empty:-$/
compile_lex prol-src/natded.prolog /^compile_lex(File):-$/
complete prol-src/natded.prolog /^complete(Cat):-$/
@@ -2741,6 +2788,13 @@ create-bar forth-src/test-forth.fth /^: create-bar foo ;$/
createPOEntries php-src/lce_functions.php /^ function createPOEntries()$/
createWidgets pyt-src/server.py /^ def createWidgets(self, host):$/
createWidgets pyt-src/server.py /^ def createWidgets(self):$/
+create_acc_call merc-src/accumulator.m /^:- func create_acc_call(hlds_goal::in(goal_plain_c/
+create_acc_goal merc-src/accumulator.m /^:- pred create_acc_goal(hlds_goal::in, accu_substs/
+create_new_base_goals merc-src/accumulator.m /^:- func create_new_base_goals(set(accu_goal_id), a/
+create_new_orig_recursive_goals merc-src/accumulator.m /^:- func create_new_orig_recursive_goals(set(accu_g/
+create_new_recursive_goals merc-src/accumulator.m /^:- func create_new_recursive_goals(set(accu_goal_i/
+create_new_var merc-src/accumulator.m /^:- pred create_new_var(prog_var::in, string::in, p/
+create_orig_goal merc-src/accumulator.m /^:- pred create_orig_goal(hlds_goal::in, accu_subst/
cscInitTime cp-src/c.C 7
cscSegmentationTime cp-src/c.C 8
cstack c-src/etags.c 2523
@@ -3048,6 +3102,7 @@ foperator c-src/etags.c 2411
force_auto_save_soon c-src/emacs/src/keyboard.c /^force_auto_save_soon (void)$/
force_explicit_name c-src/etags.c 265
force_quit_count c-src/emacs/src/keyboard.c 10387
+foreign_export merc-src/accumulator.m /^:- pragma foreign_export("C", unravel_univ(in, out/
formatSize objc-src/PackInsp.m /^-(const char *)formatSize:(const char *)size inBuf/
found c-src/emacs/src/lisp.h 2344
fracas html-src/software.html /^Fracas$/
@@ -3105,6 +3160,8 @@ gcpro c-src/emacs/src/lisp.h 3042
gcpro c-src/emacs/src/lisp.h 3132
gen_help_event c-src/emacs/src/keyboard.c /^gen_help_event (Lisp_Object help, Lisp_Object fram/
genalgorithm html-src/algrthms.html /^Generating the Data<\/font><\/i><\/b>$/
+generate_warning merc-src/accumulator.m /^:- pred generate_warning(module_info::in, prog_var/
+generate_warnings merc-src/accumulator.m /^:- pred generate_warnings(module_info::in, prog_va/
generic_object cp-src/clheir.cpp /^generic_object::generic_object(void)$/
generic_object cp-src/clheir.hpp 13
getArchs objc-src/PackInsp.m /^-(void)getArchs$/
@@ -3173,6 +3230,7 @@ help_char_p c-src/emacs/src/keyboard.c /^help_char_p (Lisp_Object c)$/
help_form_saved_window_configs c-src/emacs/src/keyboard.c 2156
helpwin pyt-src/server.py /^def helpwin(helpdict):$/
hide_cursor cp-src/screen.cpp /^void hide_cursor(void)$/
+hlds merc-src/accumulator.m /^:- import_module hlds.$/
htmltreelist prol-src/natded.prolog /^htmltreelist([]).$/
hybrid_aligned_alloc c-src/emacs/src/gmalloc.c /^hybrid_aligned_alloc (size_t alignment, size_t siz/
hybrid_calloc c-src/emacs/src/gmalloc.c /^hybrid_calloc (size_t nmemb, size_t size)$/
@@ -3192,12 +3250,16 @@ ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\
ialpage tex-src/texinfo.tex /^ \\availdimen@=\\pageheight \\advance\\availdimen@ by/
ialpage tex-src/texinfo.tex /^ \\dimen@=\\pageheight \\advance\\dimen@ by-\\ht\\pa/
ialpage= tex-src/texinfo.tex /^ \\output={\\global\\setbox\\partialpage=$/
+identify_goal_type merc-src/accumulator.m /^:- pred identify_goal_type(pred_id::in, proc_id::i/
+identify_out_and_out_prime merc-src/accumulator.m /^:- pred identify_out_and_out_prime(module_info::in/
+identify_recursive_calls merc-src/accumulator.m /^:- pred identify_recursive_calls(pred_id::in, proc/
idx c-src/emacs/src/lisp.h 3150
ignore_case c-src/etags.c 266
ignore_mouse_drag_p c-src/emacs/src/keyboard.c 1256
ill=\relax tex-src/texinfo.tex /^\\let\\refill=\\relax$/
immediate_quit c-src/emacs/src/keyboard.c 174
impatto html-src/softwarelibero.html /^Impatto pratico del software libero$/
+implementation merc-src/accumulator.m /^:- implementation.$/
in_word_set c-src/etags.c /^in_word_set (register const char *str, register un/
inattribute c-src/etags.c 2400
inc cp-src/Range.h /^ double inc (void) const { return rng_inc; }$/
@@ -3221,6 +3283,7 @@ inita c.c /^static void inita () {}$/
initb c.c /^static void initb () {}$/
initial_kboard c-src/emacs/src/keyboard.c 84
initialize-new-tags-table el-src/emacs/lisp/progmodes/etags.el /^(defun initialize-new-tags-table ()$/
+initialize_goal_store merc-src/accumulator.m /^:- func initialize_goal_store(list(hlds_goal), ins/
initialize_random_junk y-src/cccp.y /^initialize_random_junk ()$/
input-pending-p c-src/emacs/src/keyboard.c /^DEFUN ("input-pending-p", Finput_pending_p, Sinput/
input_available_clear_time c-src/emacs/src/keyboard.c 324
@@ -3236,6 +3299,7 @@ instance_method_exclamation! ruby-src/test.rb /^ def instance_method_excl
instance_method_question? ruby-src/test.rb /^ def instance_method_question?$/
instr y-src/parse.y 81
instruct c-src/etags.c 2527
+int merc-src/accumulator.m /^:- import_module int.$/
intNumber go-src/test1.go 13
integer c-src/emacs/src/lisp.h 2127
integer y-src/cccp.y 112
@@ -3244,6 +3308,7 @@ integertonmstr pas-src/common.pas /^function integertonmstr; (* (TheInteger : in
intensity1 f-src/entry.for /^ & intensity1(efv,fv,svin,svquad,sfpv,maxp,val/
intensity1 f-src/entry.strange_suffix /^ & intensity1(efv,fv,svin,svquad,sfpv,maxp,val/
intensity1 f-src/entry.strange /^ & intensity1(efv,fv,svin,svquad,sfpv,maxp,val/
+interface merc-src/accumulator.m /^:- interface.$/
interface_locate c-src/c.c /^interface_locate(void)$/
intern c-src/emacs/src/lisp.h /^intern (const char *str)$/
intern_c_string c-src/emacs/src/lisp.h /^intern_c_string (const char *str)$/
@@ -3258,6 +3323,7 @@ intoken c-src/etags.c /^#define intoken(c) (_itk[CHAR (c)]) \/* c can be in/
intspec c-src/emacs/src/lisp.h 1688
intvar c-src/emacs/src/lisp.h 2277
invalidate_nodes c-src/etags.c /^invalidate_nodes (fdesc *badfdp, node **npp)$/
+io merc-src/accumulator.m /^:- import_module io.$/
ipc3dCSC19 cp-src/c.C 6
ipc3dChannelType cp-src/c.C 1
ipc3dIslandHierarchy cp-src/c.C 1
@@ -3267,6 +3333,7 @@ irregular_location cp-src/clheir.hpp /^ irregular_location(double xi, double
isComment php-src/lce_functions.php /^ function isComment($class)$/
isHoliday cp-src/functions.cpp /^bool isHoliday ( Date d ){$/
isLeap cp-src/functions.cpp /^bool isLeap ( int year ){$/
+is_associative_construction merc-src/accumulator.m /^:- pred is_associative_construction(module_info::i/
is_curly_brace_form c-src/h.h 54
is_explicit c-src/h.h 49
is_func c-src/etags.c 221
@@ -3275,6 +3342,7 @@ is_idchar y-src/cccp.y 948
is_idstart y-src/cccp.y 950
is_muldiv_operation cp-src/c.C /^is_muldiv_operation(pc)$/
is_ordset prol-src/ordsets.prolog /^is_ordset(X) :- var(X), !, fail.$/
+is_recursive_case merc-src/accumulator.m /^:- pred is_recursive_case(list(hlds_goal)::in, pre/
iso_lispy_function_keys c-src/emacs/src/keyboard.c 5151
isoperator prol-src/natded.prolog /^isoperator(Char):-$/
isoptab prol-src/natded.prolog /^isoptab('%').$/
@@ -3371,6 +3439,7 @@ letter: tex-src/texinfo.tex /^\\xdef\\thischapter{Appendix \\appendixletter: \\n
level c-src/emacs/src/lisp.h 3153
lex prol-src/natded.prolog /^lex(W,SynOut,Sem):-$/
lexptr y-src/cccp.y 332
+libs merc-src/accumulator.m /^:- import_module libs.$/
licenze html-src/softwarelibero.html /^Licenze d'uso di un programma$/
limit cp-src/Range.h /^ double limit (void) const { return rng_limit; }$/
line c-src/etags.c 2493
@@ -3428,6 +3497,7 @@ lispy_modifier_list c-src/emacs/src/keyboard.c /^lispy_modifier_list (int modifi
lispy_multimedia_keys c-src/emacs/src/keyboard.c 4962
lispy_wheel_names c-src/emacs/src/keyboard.c 5174
list c-src/emacs/src/gmalloc.c 186
+list merc-src/accumulator.m /^:- import_module list.$/
list-tags el-src/emacs/lisp/progmodes/etags.el /^(defun list-tags (file &optional _next-match)$/
list-tags-function el-src/emacs/lisp/progmodes/etags.el /^(defvar list-tags-function nil$/
list2i c-src/emacs/src/lisp.h /^list2i (EMACS_INT x, EMACS_INT y)$/
@@ -3444,6 +3514,7 @@ local_if_set c-src/emacs/src/lisp.h 2338
location cp-src/clheir.hpp 33
location cp-src/clheir.hpp /^ location() { }$/
lookup y-src/cccp.y /^lookup (name, len, hash)$/
+lookup_call merc-src/accumulator.m /^:- pred lookup_call(accu_goal_store::in, accu_goal/
lowcase c-src/etags.c /^#define lowcase(c) tolower (CHAR (c))$/
lucid_event_type_list_p c-src/emacs/src/keyboard.c /^lucid_event_type_list_p (Lisp_Object object)$/
mabort c-src/emacs/src/gmalloc.c /^mabort (enum mcheck_status status)$/
@@ -3489,6 +3560,7 @@ mallochook c-src/emacs/src/gmalloc.c /^mallochook (size_t size)$/
man manpage make-src/Makefile /^man manpage: etags.1.man$/
mao c-src/h.h 101
map c-src/emacs/src/keyboard.c 8748
+map merc-src/accumulator.m /^:- import_module map.$/
map_word prol-src/natded.prolog /^map_word([[_]|Ws],Exp):-$/
mapping html-src/algrthms.html /^Mapping the Channel Symbols$/
mapsyn prol-src/natded.prolog /^mapsyn(A\/B,AM\/BM):-$/
@@ -3502,15 +3574,18 @@ max_args c-src/emacs/src/lisp.h 1686
max_num_directions cp-src/clheir.hpp 31
max_num_generic_objects cp-src/clheir.cpp 9
maxargs c-src/emacs/src/lisp.h 2831
+maybe merc-src/accumulator.m /^:- import_module maybe.$/
maybe_gc c-src/emacs/src/lisp.h /^maybe_gc (void)$/
mcCSC cp-src/c.C 6
mcheck c-src/emacs/src/gmalloc.c /^mcheck (void (*func) (enum mcheck_status))$/
mcheck_status c-src/emacs/src/gmalloc.c 283
mcheck_used c-src/emacs/src/gmalloc.c 2012
+mdbcomp merc-src/accumulator.m /^:- import_module mdbcomp.$/
me22b lua-src/test.lua /^ local function test.me22b (one)$/
me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/
memalign c-src/emacs/src/gmalloc.c /^memalign (size_t alignment, size_t size)$/
member prol-src/natded.prolog /^member(X,[X|_]).$/
+member_lessthan_goalid merc-src/accumulator.m /^:- pred member_lessthan_goalid(accu_goal_store::in/
memclear c-src/emacs/src/lisp.h /^memclear (void *p, ptrdiff_t nbytes)$/
menu_bar_item c-src/emacs/src/keyboard.c /^menu_bar_item (Lisp_Object key, Lisp_Object item, /
menu_bar_items c-src/emacs/src/keyboard.c /^menu_bar_items (Lisp_Object old)$/
@@ -3781,6 +3856,7 @@ pMu c-src/emacs/src/lisp.h 151
pMu c-src/emacs/src/lisp.h 156
p_next c-src/etags.c 258
pagesize c-src/emacs/src/gmalloc.c 1703
+pair merc-src/accumulator.m /^:- import_module pair.$/
parent c-src/emacs/src/keyboard.c 8745
parent c-src/emacs/src/lisp.h 1590
parse prol-src/natded.prolog /^parse(Ws,Cat):-$/
@@ -3798,6 +3874,7 @@ parse_return y-src/parse.y 74
parse_return_error y-src/cccp.y 70
parse_solitary_modifier c-src/emacs/src/keyboard.c /^parse_solitary_modifier (Lisp_Object symbol)$/
parse_tool_bar_item c-src/emacs/src/keyboard.c /^parse_tool_bar_item (Lisp_Object key, Lisp_Object /
+parse_tree merc-src/accumulator.m /^:- import_module parse_tree.$/
pat c-src/etags.c 262
pattern c-src/etags.c 260
pdlcount c-src/emacs/src/lisp.h 3046
@@ -3990,6 +4067,7 @@ removeexp prol-src/natded.prolog /^removeexp(E,E,'NIL'):-!.$/
reorder_modifiers c-src/emacs/src/keyboard.c /^reorder_modifiers (Lisp_Object symbol)$/
request c.c /^request request (a, b)$/
requeued_events_pending_p c-src/emacs/src/keyboard.c /^requeued_events_pending_p (void)$/
+require merc-src/accumulator.m /^:- import_module require.$/
required_argument c-src/getopt.h 90
reset-this-command-lengths c-src/emacs/src/keyboard.c /^DEFUN ("reset-this-command-lengths", Freset_this_c/
restore_getcjmp c-src/emacs/src/keyboard.c /^restore_getcjmp (sys_jmp_buf temp)$/
@@ -4062,6 +4140,7 @@ separator_names c-src/emacs/src/keyboard.c 7372
serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/
serializeToVars php-src/lce_functions.php /^ function serializeToVars($prefix)$/
set cp-src/conway.hpp /^ void set(void) { alive = 1; }$/
+set merc-src/accumulator.m /^:- import_module set.$/
set-input-interrupt-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-interrupt-mode", Fset_input_inte/
set-input-meta-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-meta-mode", Fset_input_meta_mode/
set-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("set-input-mode", Fset_input_mode, Sset_inp/
@@ -4089,11 +4168,14 @@ set_sub_char_table_contents c-src/emacs/src/lisp.h /^set_sub_char_table_contents
set_symbol_function c-src/emacs/src/lisp.h /^set_symbol_function (Lisp_Object sym, Lisp_Object /
set_symbol_next c-src/emacs/src/lisp.h /^set_symbol_next (Lisp_Object sym, struct Lisp_Symb/
set_symbol_plist c-src/emacs/src/lisp.h /^set_symbol_plist (Lisp_Object sym, Lisp_Object pli/
+set_upto merc-src/accumulator.m /^:- func set_upto(accu_case, int) = set(accu_goal_i/
set_waiting_for_input c-src/emacs/src/keyboard.c /^set_waiting_for_input (struct timespec *time_to_cl/
setref tex-src/texinfo.tex /^\\expandafter\\expandafter\\expandafter\\appendixsetre/
setup cp-src/c.C 5
shift cp-src/functions.cpp /^void Date::shift ( void ){\/\/Shift this date to pre/
shouldLoad objc-src/PackInsp.m /^-(BOOL)shouldLoad$/
+should_attempt_accu_transform merc-src/accumulator.m /^:- pred should_attempt_accu_transform(module_info:/
+should_attempt_accu_transform_2 merc-src/accumulator.m /^:- pred should_attempt_accu_transform_2(module_inf/
should_see_this_array_type cp-src/c.C 156
should_see_this_function_pointer cp-src/c.C 153
should_see_this_one_enclosed_in_extern_C cp-src/c.C 149
@@ -4123,6 +4205,7 @@ skip_non_spaces c-src/etags.c /^skip_non_spaces (char *cp)$/
skip_spaces c-src/etags.c /^skip_spaces (char *cp)$/
snarf-tag-function el-src/emacs/lisp/progmodes/etags.el /^(defvar snarf-tag-function nil$/
snone c-src/etags.c 2443
+solutions merc-src/accumulator.m /^:- import_module solutions.$/
some_mouse_moved c-src/emacs/src/keyboard.c /^some_mouse_moved (void)$/
space tex-src/texinfo.tex /^ {#2\\labelspace #1}\\dotfill\\doshortpageno{#3}}%/
space tex-src/texinfo.tex /^ \\dosubsubsecentry{#2.#3.#4.#5\\labelspace#1}{#6}}/
@@ -4172,10 +4255,13 @@ step cp-src/conway.hpp /^ void step(void) { alive = next_alive; }$/
step cp-src/clheir.hpp /^ virtual void step(void) { }$/
step_everybody cp-src/clheir.cpp /^void step_everybody(void)$/
stop_polling c-src/emacs/src/keyboard.c /^stop_polling (void)$/
+store_info merc-src/accumulator.m /^:- type store_info$/
store_user_signal_events c-src/emacs/src/keyboard.c /^store_user_signal_events (void)$/
+stored_goal_plain_call merc-src/accumulator.m /^:- inst stored_goal_plain_call for goal_store.stor/
str go-src/test1.go 9
strcaseeq c-src/etags.c /^#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=/
streq c-src/etags.c /^#define streq(s,t) (assert ((s)!=NULL || (t)!=NULL/
+string merc-src/accumulator.m /^:- import_module string.$/
string_intervals c-src/emacs/src/lisp.h /^string_intervals (Lisp_Object s)$/
stripLine php-src/lce_functions.php /^ function stripLine($line, $class)$/
stripname pas-src/common.pas /^function stripname; (* ($/
@@ -4315,6 +4401,7 @@ tee ruby-src/test1.ru /^ attr_accessor :tee$/
tee= ruby-src/test1.ru /^ attr_accessor :tee$/
temporarily_switch_to_single_kboard c-src/emacs/src/keyboard.c /^temporarily_switch_to_single_kboard (struct frame /
tend c-src/etags.c 2432
+term merc-src/accumulator.m /^:- import_module term.$/
terminate objc-src/Subprocess.m /^- terminate:sender$/
terminateInput objc-src/Subprocess.m /^- terminateInput$/
test c-src/emacs/src/lisp.h 1871
@@ -4326,6 +4413,7 @@ 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)$/
+test1 rs-src/test.rs /^fn test1() {$/
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)$/
@@ -4365,6 +4453,7 @@ tool_bar_items c-src/emacs/src/keyboard.c /^tool_bar_items (Lisp_Object reuse, i
tool_bar_items_vector c-src/emacs/src/keyboard.c 7965
toolkit_menubar_in_use c-src/emacs/src/keyboard.c /^toolkit_menubar_in_use (struct frame *f)$/
top-level c-src/emacs/src/keyboard.c /^DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, /
+top_level merc-src/accumulator.m /^:- type top_level$/
top_level_1 c-src/emacs/src/keyboard.c /^top_level_1 (Lisp_Object ignore)$/
top_level_2 c-src/emacs/src/keyboard.c /^top_level_2 (void)$/
total_keys c-src/emacs/src/keyboard.c 97
@@ -4421,12 +4510,15 @@ unblock_input c-src/emacs/src/keyboard.c /^unblock_input (void)$/
unblock_input_to c-src/emacs/src/keyboard.c /^unblock_input_to (int level)$/
unchar c-src/h.h 99
unexpand-abbrev c-src/abbrev.c /^DEFUN ("unexpand-abbrev", Funexpand_abbrev, Sunexp/
+univ merc-src/accumulator.m /^:- import_module univ.$/
+unravel_univ merc-src/accumulator.m /^:- some [T] pred unravel_univ(univ::in, T::out) is/
unread_switch_frame c-src/emacs/src/keyboard.c 204
unsignedp y-src/cccp.y 112
unwind c-src/emacs/src/lisp.h 2962
unwind_int c-src/emacs/src/lisp.h 2972
unwind_ptr c-src/emacs/src/lisp.h 2967
unwind_void c-src/emacs/src/lisp.h 2976
+update_accumulator_pred merc-src/accumulator.m /^:- pred update_accumulator_pred(pred_id::in, proc_/
uprintmax_t c-src/emacs/src/lisp.h 149
uprintmax_t c-src/emacs/src/lisp.h 154
usage perl-src/yagrip.pl /^sub usage {$/
@@ -4458,6 +4550,7 @@ varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/
varargs tex-src/texinfo.tex /^\\defvarargs {#3}\\endgroup %$/
varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/
varargs tex-src/texinfo.tex /^\\defvarargs {#2}\\endgroup %$/
+varset merc-src/accumulator.m /^:- import_module varset.$/
vcopy c-src/emacs/src/lisp.h /^vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Objec/
vectorlike_header c-src/emacs/src/lisp.h 1343
verde cp-src/c.C 40
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 3de15514e79..4eae68b5c25 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -175,7 +175,7 @@ package body Truc.Bidule Truc.Bidule/b138,2153
protected body Bidule Bidule/b139,2181
protected body Machin_T Machin_T/b146,2281
-c-src/abbrev.c,2072
+c-src/abbrev.c,1957
Lisp_Object Vabbrev_table_name_list;43,1429
Lisp_Object Vglobal_abbrev_table;48,1574
Lisp_Object Vfundamental_mode_abbrev_table;52,1685
@@ -186,33 +186,31 @@ Lisp_Object Vabbrev_start_location_buffer;66,2046
Lisp_Object Vlast_abbrev;70,2155
Lisp_Object Vlast_abbrev_text;75,2324
int last_abbrev_point;79,2414
-Lisp_Object Vpre_abbrev_expand_hook,83,2487
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;83,2487
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,85,2551
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table85,2551
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,92,2743
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table92,2743
-DEFUN ("define-abbrev", Fdefine_abbrev,107,3124
-DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev107,3124
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,149,4443
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev149,4443
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,160,4814
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev160,4814
-DEFUN ("abbrev-symbol", Fabbrev_symbol,174,5282
-DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol174,5282
-DEFUN ("abbrev-expansion", Fabbrev_expansion,202,6246
-DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion202,6246
-DEFUN ("expand-abbrev", Fexpand_abbrev,218,6761
-DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev218,6761
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,389,11682
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev389,11682
-write_abbrev 426,12889
-describe_abbrev 445,13324
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,466,13839
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description466,13839
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,506,14995
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table506,14995
-syms_of_abbrev 540,16072
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,82,2440
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table82,2440
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,89,2632
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table89,2632
+DEFUN ("define-abbrev", Fdefine_abbrev,104,3013
+DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev104,3013
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,146,4332
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev146,4332
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,157,4703
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev157,4703
+DEFUN ("abbrev-symbol", Fabbrev_symbol,171,5171
+DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol171,5171
+DEFUN ("abbrev-expansion", Fabbrev_expansion,199,6135
+DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion199,6135
+DEFUN ("expand-abbrev", Fexpand_abbrev,215,6650
+DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev215,6650
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,383,11495
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev383,11495
+write_abbrev 420,12702
+describe_abbrev 439,13137
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,460,13652
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description460,13652
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,500,14808
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table500,14808
+syms_of_abbrev 534,15885
c-src/torture.c,197
(*tag1 tag118,452
@@ -1039,155 +1037,155 @@ make_lispy_position 5228,157391
toolkit_menubar_in_use 5456,163954
make_scroll_bar_position 5469,164322
make_lispy_event 5485,164968
-make_lispy_movement 6104,183532
-make_lispy_switch_frame 6131,184263
-make_lispy_focus_in 6137,184370
-make_lispy_focus_out 6145,184496
-parse_modifiers_uncached 6163,184946
-#define SINGLE_LETTER_MOD(6185,185466
-#undef SINGLE_LETTER_MOD6212,185907
-#define MULTI_LETTER_MOD(6214,185933
-#undef MULTI_LETTER_MOD6231,186401
-apply_modifiers_uncached 6273,187575
-static const char *const modifier_names[modifier_names6319,189194
-#define NUM_MOD_NAMES 6325,189400
-static Lisp_Object modifier_symbols;6327,189450
-lispy_modifier_list 6331,189587
-#define KEY_TO_CHAR(6353,190253
-parse_modifiers 6356,190329
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191518
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191518
-apply_modifiers 6422,192392
-reorder_modifiers 6491,194721
-modify_event_symbol 6536,196529
-DEFUN ("event-convert-list", Fevent_convert_list,6628,199245
-DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199245
-parse_solitary_modifier 6695,201136
-#define SINGLE_LETTER_MOD(6701,201259
-#define MULTI_LETTER_MOD(6705,201344
-#undef SINGLE_LETTER_MOD6763,202642
-#undef MULTI_LETTER_MOD6764,202667
-lucid_event_type_list_p 6775,202890
-get_input_pending 6814,203961
-record_asynch_buffer_change 6834,204580
-gobble_input 6872,205703
-tty_read_avail_input 6967,208311
-handle_async_input 7149,214040
-process_pending_signals 7165,214360
-unblock_input_to 7177,214646
-unblock_input 7200,215278
-totally_unblock_input 7209,215446
-handle_input_available_signal 7217,215530
-deliver_input_available_signal 7226,215701
-struct user_signal_info7235,215866
-static struct user_signal_info *user_signals user_signals7250,216091
-add_user_signal 7253,216150
-handle_user_signal 7275,216599
-deliver_user_signal 7316,217559
-find_user_signal_name 7322,217660
-store_user_signal_events 7334,217842
-static Lisp_Object menu_bar_one_keymap_changed_items;7363,218417
-static Lisp_Object menu_bar_items_vector;7368,218631
-static int menu_bar_items_index;7369,218673
-static const char *separator_names[separator_names7372,218708
-menu_separator_name_p 7393,219149
-menu_bar_items 7426,219853
-Lisp_Object item_properties;7568,224604
-menu_bar_item 7571,224646
-menu_item_eval_property_1 7647,227176
-eval_dyn 7658,227466
-menu_item_eval_property 7666,227676
-parse_menu_item 7686,228342
-static Lisp_Object tool_bar_items_vector;7965,236337
-static Lisp_Object tool_bar_item_properties;7970,236511
-static int ntool_bar_items;7974,236607
-tool_bar_items 7990,237084
-process_tool_bar_item 8075,239893
-#define PROP(8112,240970
-set_prop 8114,241039
-parse_tool_bar_item 8167,242454
-#undef PROP8379,248845
-init_tool_bar_items 8387,248970
-append_tool_bar_item 8401,249262
-read_char_x_menu_prompt 8443,250772
-read_char_minibuf_menu_prompt 8503,252446
-#define PUSH_C_STR(8527,253015
-follow_key 8726,258554
-active_maps 8733,258696
-typedef struct keyremap8742,259022
-} keyremap;8754,259465
-access_keymap_keyremap 8764,259809
-keyremap_step 8811,261451
-test_undefined 8867,262935
-read_key_sequence 8916,264862
-read_key_sequence_vs 9826,295822
-DEFUN ("read-key-sequence", Fread_key_sequence,9885,297295
-DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297295
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299983
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299983
-detect_input_pending 9950,300489
-detect_input_pending_ignore_squeezables 9959,300655
-detect_input_pending_run_timers 9967,300871
-clear_input_pending 9985,301363
-requeued_events_pending_p 9997,301733
-DEFUN ("input-pending-p", Finput_pending_p,10002,301814
-DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301814
-DEFUN ("recent-keys", Frecent_keys,10024,302597
-DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302597
-DEFUN ("this-command-keys", Fthis_command_keys,10055,303518
-DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303518
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303959
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303959
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304381
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304381
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304956
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304956
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305496
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305496
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306511
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306511
-DEFUN ("recursion-depth", Frecursion_depth,10158,307070
-DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307070
-DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307407
-DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307407
-DEFUN ("discard-input", Fdiscard_input,10203,308448
-DEFUN ("discard-input", Fdiscard_input,discard-input10203,308448
-DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308950
-DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308950
-stuff_buffered_input 10285,311046
-set_waiting_for_input 10323,312017
-clear_waiting_for_input 10337,312391
-handle_interrupt_signal 10351,312755
-deliver_interrupt_signal 10378,313643
-static int volatile force_quit_count;10387,313933
-handle_interrupt 10401,314415
-quit_throw_to_read_char 10541,318712
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319289
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319289
-DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320517
-DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320517
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321433
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321433
-DEFUN ("set-quit-char", Fset_quit_char,10694,322707
-DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322707
-DEFUN ("set-input-mode", Fset_input_mode,10729,323571
-DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323571
-DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324460
-DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324460
-DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325838
-DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325838
-DEFUN ("posn-at-point", Fposn_at_point,10824,327061
-DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327061
-init_kboard 10861,328215
-allocate_kboard 10893,329285
-wipe_kboard 10909,329638
-delete_kboard 10917,329752
-init_keyboard 10942,330282
-struct event_head11021,332697
-static const struct event_head head_table[head_table11027,332748
-syms_of_keyboard 11045,333578
-keys_of_keyboard 11841,367116
-mark_kboards 11916,370435
+make_lispy_movement 6104,183531
+make_lispy_switch_frame 6131,184262
+make_lispy_focus_in 6137,184369
+make_lispy_focus_out 6145,184495
+parse_modifiers_uncached 6163,184945
+#define SINGLE_LETTER_MOD(6185,185465
+#undef SINGLE_LETTER_MOD6212,185906
+#define MULTI_LETTER_MOD(6214,185932
+#undef MULTI_LETTER_MOD6231,186400
+apply_modifiers_uncached 6273,187574
+static const char *const modifier_names[modifier_names6319,189193
+#define NUM_MOD_NAMES 6325,189399
+static Lisp_Object modifier_symbols;6327,189449
+lispy_modifier_list 6331,189586
+#define KEY_TO_CHAR(6353,190252
+parse_modifiers 6356,190328
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191517
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191517
+apply_modifiers 6422,192391
+reorder_modifiers 6491,194720
+modify_event_symbol 6536,196528
+DEFUN ("event-convert-list", Fevent_convert_list,6628,199244
+DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199244
+parse_solitary_modifier 6695,201135
+#define SINGLE_LETTER_MOD(6701,201258
+#define MULTI_LETTER_MOD(6705,201343
+#undef SINGLE_LETTER_MOD6763,202641
+#undef MULTI_LETTER_MOD6764,202666
+lucid_event_type_list_p 6775,202889
+get_input_pending 6814,203960
+record_asynch_buffer_change 6834,204579
+gobble_input 6872,205702
+tty_read_avail_input 6967,208310
+handle_async_input 7149,214039
+process_pending_signals 7165,214359
+unblock_input_to 7177,214645
+unblock_input 7200,215277
+totally_unblock_input 7209,215445
+handle_input_available_signal 7217,215529
+deliver_input_available_signal 7226,215700
+struct user_signal_info7235,215865
+static struct user_signal_info *user_signals user_signals7250,216090
+add_user_signal 7253,216149
+handle_user_signal 7275,216598
+deliver_user_signal 7316,217558
+find_user_signal_name 7322,217659
+store_user_signal_events 7334,217841
+static Lisp_Object menu_bar_one_keymap_changed_items;7363,218416
+static Lisp_Object menu_bar_items_vector;7368,218630
+static int menu_bar_items_index;7369,218672
+static const char *separator_names[separator_names7372,218707
+menu_separator_name_p 7393,219148
+menu_bar_items 7426,219852
+Lisp_Object item_properties;7568,224603
+menu_bar_item 7571,224645
+menu_item_eval_property_1 7647,227175
+eval_dyn 7658,227465
+menu_item_eval_property 7666,227675
+parse_menu_item 7686,228341
+static Lisp_Object tool_bar_items_vector;7965,236336
+static Lisp_Object tool_bar_item_properties;7970,236510
+static int ntool_bar_items;7974,236606
+tool_bar_items 7990,237083
+process_tool_bar_item 8075,239892
+#define PROP(8112,240969
+set_prop 8114,241038
+parse_tool_bar_item 8167,242453
+#undef PROP8379,248844
+init_tool_bar_items 8387,248969
+append_tool_bar_item 8401,249261
+read_char_x_menu_prompt 8443,250771
+read_char_minibuf_menu_prompt 8503,252445
+#define PUSH_C_STR(8527,253014
+follow_key 8726,258553
+active_maps 8733,258695
+typedef struct keyremap8742,259021
+} keyremap;8754,259464
+access_keymap_keyremap 8764,259808
+keyremap_step 8811,261450
+test_undefined 8867,262934
+read_key_sequence 8916,264861
+read_key_sequence_vs 9826,295821
+DEFUN ("read-key-sequence", Fread_key_sequence,9885,297294
+DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297294
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299982
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299982
+detect_input_pending 9950,300488
+detect_input_pending_ignore_squeezables 9959,300654
+detect_input_pending_run_timers 9967,300870
+clear_input_pending 9985,301362
+requeued_events_pending_p 9997,301732
+DEFUN ("input-pending-p", Finput_pending_p,10002,301813
+DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301813
+DEFUN ("recent-keys", Frecent_keys,10024,302596
+DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302596
+DEFUN ("this-command-keys", Fthis_command_keys,10055,303517
+DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303517
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303958
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303958
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304380
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304380
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304955
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304955
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305495
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305495
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306510
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306510
+DEFUN ("recursion-depth", Frecursion_depth,10158,307069
+DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307069
+DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307406
+DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307406
+DEFUN ("discard-input", Fdiscard_input,10203,308447
+DEFUN ("discard-input", Fdiscard_input,discard-input10203,308447
+DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308949
+DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308949
+stuff_buffered_input 10285,311045
+set_waiting_for_input 10323,312016
+clear_waiting_for_input 10337,312390
+handle_interrupt_signal 10351,312754
+deliver_interrupt_signal 10378,313642
+static int volatile force_quit_count;10387,313932
+handle_interrupt 10401,314414
+quit_throw_to_read_char 10541,318711
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319288
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319288
+DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320516
+DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320516
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321432
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321432
+DEFUN ("set-quit-char", Fset_quit_char,10694,322706
+DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322706
+DEFUN ("set-input-mode", Fset_input_mode,10729,323570
+DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323570
+DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324459
+DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324459
+DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325837
+DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325837
+DEFUN ("posn-at-point", Fposn_at_point,10824,327060
+DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327060
+init_kboard 10861,328214
+allocate_kboard 10893,329284
+wipe_kboard 10909,329637
+delete_kboard 10917,329751
+init_keyboard 10942,330281
+struct event_head11021,332696
+static const struct event_head head_table[head_table11027,332747
+syms_of_keyboard 11045,333577
+keys_of_keyboard 11841,367115
+mark_kboards 11916,370434
c-src/emacs/src/lisp.h,20276
#define EMACS_LISP_H22,801
@@ -2143,11 +2141,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1035
@@ -2906,22 +2904,22 @@ ord_add_element(71,1867
ord_del_element(85,2344
ord_disjoint(100,2783
ord_intersect(108,2953
-ord_intersection(126,3552
-ord_intersection3(130,3691
-ord_intersection(150,4531
-ord_intersection4(154,4703
-ord_intersection(176,5664
-ord_intersection2(181,5812
-ord_member(200,6318
-ord_seteq(216,6683
-ord_setproduct(225,6971
-ord_subset(240,7377
-ord_subtract(257,7861
-ord_symdiff(265,8054
-ord_union(288,8887
-ord_union4(303,9352
-ord_union(324,10171
-ord_union_all(329,10313
+ord_intersection(126,3553
+ord_intersection3(130,3692
+ord_intersection(150,4533
+ord_intersection4(154,4705
+ord_intersection(176,5666
+ord_intersection2(181,5814
+ord_member(200,6320
+ord_seteq(216,6685
+ord_setproduct(225,6973
+ord_subset(240,7379
+ord_subtract(257,7863
+ord_symdiff(265,8056
+ord_union(288,8889
+ord_union4(303,9354
+ord_union(324,10173
+ord_union_all(329,10315
prol-src/natded.prolog,2319
expandmng(100,2879
@@ -3136,6 +3134,11 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+rs-src/test.rs,52
+enum IpAddrKind 3,11
+fn test1(8,48
+fn main(12,88
+
scm-src/test.scm,260
(define hello 1,0
(set! hello 3,32
@@ -3350,533 +3353,628 @@ tex-src/texinfo.tex,30627
\def\vritemindex #1{\vritemindex1068,35482
\def\tablez #1#2#3#4#5#6{\tablez1074,35631
\def\Edescription{\Edescription1077,35689
-\def\itemfont{\itemfont1082,35891
-\def\Etable{\Etable1090,36117
-\def\itemize{\itemize1103,36441
-\def\itemizezzz #1{\itemizezzz1105,36477
-\def\itemizey #1#2{\itemizey1110,36572
-\def#2{1119,36818
-\def\itemcontents{\itemcontents1120,36859
-\def\bullet{\bullet1123,36907
-\def\minus{\minus1124,36934
-\def\frenchspacing{\frenchspacing1128,37042
-\def\splitoff#1#2\endmark{\splitoff1134,37267
-\def\enumerate{\enumerate1140,37497
-\def\enumeratezzz #1{\enumeratezzz1141,37536
-\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37589
- \def\thearg{\thearg1146,37736
- \ifx\thearg\empty \def\thearg{\thearg1147,37755
-\def\numericenumerate{\numericenumerate1184,39089
-\def\lowercaseenumerate{\lowercaseenumerate1190,39219
-\def\uppercaseenumerate{\uppercaseenumerate1203,39566
-\def\startenumeration#1{\startenumeration1219,40056
-\def\alphaenumerate{\alphaenumerate1227,40238
-\def\capsenumerate{\capsenumerate1228,40273
-\def\Ealphaenumerate{\Ealphaenumerate1229,40307
-\def\Ecapsenumerate{\Ecapsenumerate1230,40341
-\def\itemizeitem{\itemizeitem1234,40421
-\def\newindex #1{\newindex1259,41278
-\def\defindex{\defindex1268,41567
-\def\newcodeindex #1{\newcodeindex1272,41675
-\def\defcodeindex{\defcodeindex1279,41935
-\def\synindex #1 #2 {\synindex1283,42115
-\def\syncodeindex #1 #2 {\syncodeindex1292,42455
-\def\doindex#1{\doindex1309,43134
-\def\singleindexer #1{\singleindexer1310,43193
-\def\docodeindex#1{\docodeindex1313,43305
-\def\singlecodeindexer #1{\singlecodeindexer1314,43372
-\def\indexdummies{\indexdummies1316,43430
-\def\_{\_1317,43450
-\def\w{\w1318,43478
-\def\bf{\bf1319,43505
-\def\rm{\rm1320,43534
-\def\sl{\sl1321,43563
-\def\sf{\sf1322,43592
-\def\tt{\tt1323,43620
-\def\gtr{\gtr1324,43648
-\def\less{\less1325,43678
-\def\hat{\hat1326,43710
-\def\char{\char1327,43740
-\def\TeX{\TeX1328,43772
-\def\dots{\dots1329,43802
-\def\copyright{\copyright1330,43835
-\def\tclose##1{\tclose1331,43878
-\def\code##1{\code1332,43923
-\def\samp##1{\samp1333,43964
-\def\t##1{\t1334,44005
-\def\r##1{\r1335,44040
-\def\i##1{\i1336,44075
-\def\b##1{\b1337,44110
-\def\cite##1{\cite1338,44145
-\def\key##1{\key1339,44186
-\def\file##1{\file1340,44225
-\def\var##1{\var1341,44266
-\def\kbd##1{\kbd1342,44305
-\def\indexdummyfont#1{\indexdummyfont1347,44461
-\def\indexdummytex{\indexdummytex1348,44487
-\def\indexdummydots{\indexdummydots1349,44511
-\def\indexnofonts{\indexnofonts1351,44537
-\let\w=\indexdummyfontdummyfont1352,44557
-\let\t=\indexdummyfontdummyfont1353,44580
-\let\r=\indexdummyfontdummyfont1354,44603
-\let\i=\indexdummyfontdummyfont1355,44626
-\let\b=\indexdummyfontdummyfont1356,44649
-\let\emph=\indexdummyfontdummyfont1357,44672
-\let\strong=\indexdummyfontdummyfont1358,44698
-\let\cite=\indexdummyfont=\indexdummyfont1359,44726
-\let\sc=\indexdummyfontdummyfont1360,44752
-\let\tclose=\indexdummyfontdummyfont1364,44924
-\let\code=\indexdummyfontdummyfont1365,44952
-\let\file=\indexdummyfontdummyfont1366,44978
-\let\samp=\indexdummyfontdummyfont1367,45004
-\let\kbd=\indexdummyfontdummyfont1368,45030
-\let\key=\indexdummyfontdummyfont1369,45055
-\let\var=\indexdummyfontdummyfont1370,45080
-\let\TeX=\indexdummytexdummytex1371,45105
-\let\dots=\indexdummydotsdummydots1372,45129
-\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45381
-\def\doind #1#2{\doind1384,45437
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45480
-\def\rawbackslashxx{\rawbackslashxx1389,45620
-{\indexnofontsnofonts1394,45882
-\def\dosubind #1#2#3{\dosubind1405,46193
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46241
-\def\rawbackslashxx{\rawbackslashxx1410,46345
-{\indexnofontsnofonts1414,46499
-\def\findex {\findex1443,47430
-\def\kindex {\kindex1444,47453
-\def\cindex {\cindex1445,47476
-\def\vindex {\vindex1446,47499
-\def\tindex {\tindex1447,47522
-\def\pindex {\pindex1448,47545
-\def\cindexsub {\cindexsub1450,47569
-\def\printindex{\printindex1462,47896
-\def\doprintindex#1{\doprintindex1464,47937
- \def\indexbackslash{\indexbackslash1481,48422
- \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48461
-\def\initial #1{\initial1517,49533
-\def\entry #1#2{\entry1523,49740
- \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50387
-\def\indexdotfill{\indexdotfill1549,50715
-\def\primary #1{\primary1552,50821
-\def\secondary #1#2{\secondary1556,50903
-\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50985
-\newbox\partialpageialpage1566,51158
-\def\begindoublecolumns{\begindoublecolumns1572,51316
- \output={\global\setbox\partialpage=ialpage=1573,51352
-\def\enddoublecolumns{\enddoublecolumns1577,51540
-\def\doublecolumnout{\doublecolumnout1580,51625
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51694
-\def\pagesofar{\pagesofar1584,51872
-\def\balancecolumns{\balancecolumns1588,52109
- \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52280
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52541
-\newcount \appendixno \appendixno = `\@no1627,53446
-\def\appendixletter{\appendixletter1628,53487
-\def\opencontents{\opencontents1632,53590
-\def\thischapter{\thischapter1637,53771
-\def\seccheck#1{\seccheck1638,53809
-\def\chapternofonts{\chapternofonts1643,53913
-\def\result{\result1646,53988
-\def\equiv{\equiv1647,54023
-\def\expansion{\expansion1648,54056
-\def\print{\print1649,54097
-\def\TeX{\TeX1650,54130
-\def\dots{\dots1651,54159
-\def\copyright{\copyright1652,54190
-\def\tt{\tt1653,54231
-\def\bf{\bf1654,54258
-\def\w{\w1655,54286
-\def\less{\less1656,54311
-\def\gtr{\gtr1657,54342
-\def\hat{\hat1658,54371
-\def\char{\char1659,54400
-\def\tclose##1{\tclose1660,54431
-\def\code##1{\code1661,54475
-\def\samp##1{\samp1662,54515
-\def\r##1{\r1663,54555
-\def\b##1{\b1664,54589
-\def\key##1{\key1665,54623
-\def\file##1{\file1666,54661
-\def\kbd##1{\kbd1667,54701
-\def\i##1{\i1669,54809
-\def\cite##1{\cite1670,54843
-\def\var##1{\var1671,54883
-\def\emph##1{\emph1672,54921
-\def\dfn##1{\dfn1673,54961
-\def\thischaptername{\thischaptername1676,55002
-\outer\def\chapter{\chapter1677,55041
-\def\chapterzzz #1{\chapterzzz1678,55082
-{\chapternofonts%nofonts%1687,55478
-\global\let\section = \numberedsec=1692,55631
-\global\let\subsection = \numberedsubsec=1693,55666
-\global\let\subsubsection = \numberedsubsubsec=1694,55707
-\outer\def\appendix{\appendix1697,55758
-\def\appendixzzz #1{\appendixzzz1698,55801
-\global\advance \appendixno by 1 \message{no1700,55878
-\chapmacro {#1}{Appendix \appendixletter}letter1701,55947
-\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56040
-{\chapternofonts%nofonts%1705,56112
- {#1}{Appendix \appendixletter}letter1707,56168
-\appendixnoderef %noderef1710,56268
-\global\let\section = \appendixsec=1711,56287
-\global\let\subsection = \appendixsubsec=1712,56322
-\global\let\subsubsection = \appendixsubsubsec=1713,56363
-\outer\def\top{\top1716,56414
-\outer\def\unnumbered{\unnumbered1717,56454
-\def\unnumberedzzz #1{\unnumberedzzz1718,56501
-{\chapternofonts%nofonts%1722,56664
-\global\let\section = \unnumberedsec=1727,56814
-\global\let\subsection = \unnumberedsubsec=1728,56851
-\global\let\subsubsection = \unnumberedsubsubsec=1729,56894
-\outer\def\numberedsec{\numberedsec1732,56947
-\def\seczzz #1{\seczzz1733,56988
-{\chapternofonts%nofonts%1736,57144
-\outer\def\appendixsection{\appendixsection1745,57330
-\outer\def\appendixsec{\appendixsec1746,57387
-\def\appendixsectionzzz #1{\appendixsectionzzz1747,57440
-\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57552
-{\chapternofonts%nofonts%1750,57620
-{#1}{\appendixletter}letter1752,57676
-\appendixnoderef %noderef1755,57776
-\outer\def\unnumberedsec{\unnumberedsec1759,57816
-\def\unnumberedseczzz #1{\unnumberedseczzz1760,57869
-{\chapternofonts%nofonts%1762,57964
-\outer\def\numberedsubsec{\numberedsubsec1770,58132
-\def\numberedsubseczzz #1{\numberedsubseczzz1771,58187
-{\chapternofonts%nofonts%1774,58366
-\outer\def\appendixsubsec{\appendixsubsec1783,58570
-\def\appendixsubseczzz #1{\appendixsubseczzz1784,58625
-\subsecheading {#1}{\appendixletter}letter1786,58747
-{\chapternofonts%nofonts%1787,58812
-{#1}{\appendixletter}letter1789,58871
-\appendixnoderef %noderef1792,58986
-\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59026
-\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59085
-{\chapternofonts%nofonts%1799,59186
-\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59357
-\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59418
-{\chapternofonts%nofonts%1812,59615
-\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59848
-\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59909
- {\appendixletter}letter1827,60048
-{\chapternofonts%nofonts%1828,60114
- {\appendixletter}letter1830,60179
-\appendixnoderef %noderef1834,60313
-\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60353
-\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60418
-{\chapternofonts%nofonts%1841,60525
-\def\infotop{\infotop1851,60854
-\def\infounnumbered{\infounnumbered1852,60892
-\def\infounnumberedsec{\infounnumberedsec1853,60937
-\def\infounnumberedsubsec{\infounnumberedsubsec1854,60988
-\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61045
-\def\infoappendix{\infoappendix1857,61109
-\def\infoappendixsec{\infoappendixsec1858,61150
-\def\infoappendixsubsec{\infoappendixsubsec1859,61197
-\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61250
-\def\infochapter{\infochapter1862,61310
-\def\infosection{\infosection1863,61349
-\def\infosubsection{\infosubsection1864,61388
-\def\infosubsubsection{\infosubsubsection1865,61433
-\global\let\section = \numberedsec=1870,61670
-\global\let\subsection = \numberedsubsec=1871,61705
-\global\let\subsubsection = \numberedsubsubsec=1872,61746
-\def\majorheading{\majorheading1886,62253
-\def\majorheadingzzz #1{\majorheadingzzz1887,62298
-\def\chapheading{\chapheading1893,62531
-\def\chapheadingzzz #1{\chapheadingzzz1894,62574
-\def\heading{\heading1899,62769
-\def\subheading{\subheading1901,62806
-\def\subsubheading{\subsubheading1903,62849
-\def\dobreak#1#2{\dobreak1910,63126
-\def\setchapterstyle #1 {\setchapterstyle1912,63204
-\def\chapbreak{\chapbreak1919,63459
-\def\chappager{\chappager1920,63509
-\def\chapoddpage{\chapoddpage1921,63547
-\def\setchapternewpage #1 {\setchapternewpage1923,63626
-\def\CHAPPAGoff{\CHAPPAGoff1925,63683
-\def\CHAPPAGon{\CHAPPAGon1929,63777
-\global\def\HEADINGSon{\HEADINGSon1932,63868
-\def\CHAPPAGodd{\CHAPPAGodd1934,63910
-\global\def\HEADINGSon{\HEADINGSon1937,64006
-\def\CHAPFplain{\CHAPFplain1941,64060
-\def\chfplain #1#2{\chfplain1945,64152
-\def\unnchfplain #1{\unnchfplain1956,64375
-\def\unnchfopen #1{\unnchfopen1964,64604
-\def\chfopen #1#2{\chfopen1970,64812
-\def\CHAPFopen{\CHAPFopen1975,64956
-\def\subsecheadingbreak{\subsecheadingbreak1982,65174
-\def\secheadingbreak{\secheadingbreak1985,65303
-\def\secheading #1#2#3{\secheading1993,65585
-\def\plainsecheading #1{\plainsecheading1994,65641
-\def\secheadingi #1{\secheadingi1995,65684
-\def\subsecheading #1#2#3#4{\subsecheading2006,66052
-\def\subsecheadingi #1{\subsecheadingi2007,66119
-\def\subsubsecfonts{\subsubsecfonts2014,66416
-\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66539
-\def\subsubsecheadingi #1{\subsubsecheadingi2018,66617
-\def\startcontents#1{\startcontents2032,67089
- \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67362
-\outer\def\contents{\contents2049,67721
-\outer\def\summarycontents{\summarycontents2057,67865
- \def\secentry ##1##2##3##4{\secentry2067,68236
- \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68271
- \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68306
- \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68347
- \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68385
- \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68432
-\def\chapentry#1#2#3{\chapentry2085,68866
-\def\shortchapentry#1#2#3{\shortchapentry2088,68983
- {#2\labelspace #1}space2091,69093
-\def\unnumbchapentry#1#2{\unnumbchapentry2094,69147
-\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69194
-\def\secentry#1#2#3#4{\secentry2102,69358
-\def\unnumbsecentry#1#2{\unnumbsecentry2103,69417
-\def\subsecentry#1#2#3#4#5{\subsecentry2106,69478
-\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69548
-\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69622
- \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69656
-\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69707
-\def\dochapentry#1#2{\dochapentry2123,70081
-\def\dosecentry#1#2{\dosecentry2138,70686
-\def\dosubsecentry#1#2{\dosubsecentry2145,70864
-\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71049
-\def\labelspace{\labelspace2160,71300
-\def\dopageno#1{\dopageno2162,71335
-\def\doshortpageno#1{\doshortpageno2163,71361
-\def\chapentryfonts{\chapentryfonts2165,71393
-\def\secentryfonts{\secentryfonts2166,71428
-\def\point{\point2192,72387
-\def\result{\result2194,72408
-\def\expansion{\expansion2195,72481
-\def\print{\print2196,72552
-\def\equiv{\equiv2198,72619
-\def\error{\error2218,73392
-\def\tex{\tex2224,73621
-\def\@{\@2242,74004
-\gdef\sepspaces{\def {\ }}}\2265,74736
-\def\aboveenvbreak{\aboveenvbreak2268,74818
-\def\afterenvbreak{\afterenvbreak2272,74984
-\def\ctl{\ctl2286,75495
-\def\ctr{\ctr2287,75567
-\def\cbl{\cbl2288,75606
-\def\cbr{\cbr2289,75646
-\def\carttop{\carttop2290,75685
-\def\cartbot{\cartbot2293,75793
-\long\def\cartouche{\cartouche2299,75933
-\def\Ecartouche{\Ecartouche2326,76721
-\def\lisp{\lisp2338,76856
-\def\Elisp{\Elisp2348,77203
-\def\next##1{\next2360,77529
-\def\Eexample{\Eexample2364,77571
-\def\Esmallexample{\Esmallexample2367,77618
-\def\smalllispx{\smalllispx2373,77796
-\def\Esmalllisp{\Esmalllisp2383,78150
-\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78506
-\def\next##1{\next2397,78563
-\def\display{\display2401,78643
-\def\Edisplay{\Edisplay2410,78962
-\def\next##1{\next2422,79273
-\def\format{\format2426,79376
-\def\Eformat{\Eformat2434,79672
-\def\next##1{\next2437,79761
-\def\flushleft{\flushleft2441,79813
-\def\Eflushleft{\Eflushleft2451,80184
-\def\next##1{\next2454,80277
-\def\flushright{\flushright2456,80299
-\def\Eflushright{\Eflushright2466,80671
-\def\next##1{\next2470,80802
-\def\quotation{\quotation2474,80860
-\def\Equotation{\Equotation2480,81052
-\def\setdeffont #1 {\setdeffont2493,81450
-\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81496
-\newskip\defargsindent \defargsindent=50ptargsindent2496,81539
-\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81582
-\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81625
-\def\activeparens{\activeparens2503,81823
-\def\opnr{\opnr2529,83035
-\def\lbrb{\lbrb2530,83100
-\def\defname #1#2{\defname2536,83301
-\advance\dimen2 by -\defbodyindentbodyindent2540,83419
-\advance\dimen3 by -\defbodyindentbodyindent2542,83473
-\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83527
-\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83669
-\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83744
-\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84113
-\advance\leftskip by -\defbodyindentbodyindent2557,84247
-\exdentamount=\defbodyindentbodyindent2558,84284
-\def\defparsebody #1#2#3{\defparsebody2568,84643
-\def#1{2572,84827
-\def#2{2573,84863
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84935
-\exdentamount=\defbodyindentbodyindent2576,85009
-\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85113
-\def#1{2585,85274
-\def#2##1 {2586,85310
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85393
-\exdentamount=\defbodyindentbodyindent2589,85467
-\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85552
-\def#1{2596,85713
-\def#2##1 ##2 {2597,85749
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85849
-\exdentamount=\defbodyindentbodyindent2601,85923
-\def\defvarparsebody #1#2#3{\defvarparsebody2608,86194
-\def#1{2612,86381
-\def#2{2613,86417
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86476
-\exdentamount=\defbodyindentbodyindent2616,86550
-\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86641
-\def#1{2625,86800
-\def#2##1 {2626,86836
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86906
-\exdentamount=\defbodyindentbodyindent2629,86980
-\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87052
-\def#1{2636,87216
-\def#2##1 ##2 {2637,87252
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87339
-\exdentamount=\defbodyindentbodyindent2641,87413
-\def\defunargs #1{\defunargs2664,88173
-\def\deftypefunargs #1{\deftypefunargs2676,88555
-\def\deffn{\deffn2690,88937
-\def\deffnheader #1#2#3{\deffnheader2692,88994
-\begingroup\defname {name2693,89042
-\def\defun{\defun2699,89187
-\def\defunheader #1#2{\defunheader2701,89240
-\begingroup\defname {name2702,89315
-\defunargs {unargs2703,89351
-\def\deftypefun{\deftypefun2709,89499
-\def\deftypefunheader #1#2{\deftypefunheader2712,89621
-\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89730
-\begingroup\defname {name2716,89822
-\deftypefunargs {typefunargs2717,89868
-\def\deftypefn{\deftypefn2723,90039
-\def\deftypefnheader #1#2#3{\deftypefnheader2726,90188
-\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90324
-\begingroup\defname {name2730,90417
-\deftypefunargs {typefunargs2731,90457
-\def\defmac{\defmac2737,90578
-\def\defmacheader #1#2{\defmacheader2739,90635
-\begingroup\defname {name2740,90711
-\defunargs {unargs2741,90744
-\def\defspec{\defspec2747,90868
-\def\defspecheader #1#2{\defspecheader2749,90929
-\begingroup\defname {name2750,91006
-\defunargs {unargs2751,91046
-\def\deffnx #1 {\deffnx2758,91241
-\def\defunx #1 {\defunx2759,91298
-\def\defmacx #1 {\defmacx2760,91355
-\def\defspecx #1 {\defspecx2761,91414
-\def\deftypefnx #1 {\deftypefnx2762,91475
-\def\deftypeunx #1 {\deftypeunx2763,91540
-\def\defop #1 {\defop2769,91686
-\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91721
-\def\defopheader #1#2#3{\defopheader2772,91775
-\begingroup\defname {name2774,91864
-\defunargs {unargs2775,91910
-\def\defmethod{\defmethod2780,91971
-\def\defmethodheader #1#2#3{\defmethodheader2782,92044
-\begingroup\defname {name2784,92132
-\defunargs {unargs2785,92172
-\def\defcv #1 {\defcv2790,92246
-\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92281
-\def\defcvarheader #1#2#3{\defcvarheader2793,92340
-\begingroup\defname {name2795,92426
-\defvarargs {varargs2796,92472
-\def\defivar{\defivar2801,92545
-\def\defivarheader #1#2#3{\defivarheader2803,92608
-\begingroup\defname {name2805,92694
-\defvarargs {varargs2806,92745
-\def\defopx #1 {\defopx2812,92894
-\def\defmethodx #1 {\defmethodx2813,92951
-\def\defcvx #1 {\defcvx2814,93016
-\def\defivarx #1 {\defivarx2815,93073
-\def\defvarargs #1{\defvarargs2822,93344
-\def\defvr{\defvr2828,93488
-\def\defvrheader #1#2#3{\defvrheader2830,93543
-\begingroup\defname {name2831,93591
-\def\defvar{\defvar2835,93676
-\def\defvarheader #1#2{\defvarheader2837,93736
-\begingroup\defname {name2838,93807
-\defvarargs {varargs2839,93843
-\def\defopt{\defopt2844,93909
-\def\defoptheader #1#2{\defoptheader2846,93969
-\begingroup\defname {name2847,94040
-\defvarargs {varargs2848,94079
-\def\deftypevar{\deftypevar2853,94136
-\def\deftypevarheader #1#2{\deftypevarheader2856,94252
-\begingroup\defname {name2858,94335
-\def\deftypevr{\deftypevr2865,94509
-\def\deftypevrheader #1#2#3{\deftypevrheader2867,94580
-\begingroup\defname {name2868,94632
-\def\defvrx #1 {\defvrx2876,94869
-\def\defvarx #1 {\defvarx2877,94926
-\def\defoptx #1 {\defoptx2878,94985
-\def\deftypevarx #1 {\deftypevarx2879,95044
-\def\deftypevrx #1 {\deftypevrx2880,95111
-\def\deftpargs #1{\deftpargs2885,95260
-\def\deftp{\deftp2889,95340
-\def\deftpheader #1#2#3{\deftpheader2891,95395
-\begingroup\defname {name2892,95443
-\def\deftpx #1 {\deftpx2897,95602
-\def\setref#1{\setref2908,95923
-\def\unnumbsetref#1{\unnumbsetref2913,96037
-\def\appendixsetref#1{\appendixsetref2918,96144
-\def\pxref#1{\pxref2929,96555
-\def\xref#1{\xref2930,96591
-\def\ref#1{\ref2931,96626
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96656
-\def\printedmanual{\printedmanual2933,96699
-\def\printednodename{\printednodename2934,96737
-\def\printednodename{\printednodename2939,96862
-section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97495
-\refx{x2957,97573
-\def\dosetq #1#2{\dosetq2965,97793
-\def\internalsetq #1#2{\internalsetq2973,98051
-\def\Ypagenumber{\Ypagenumber2977,98152
-\def\Ytitle{\Ytitle2979,98178
-\def\Ynothing{\Ynothing2981,98205
-\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98222
-\def\Yappendixletterandtype{\Yappendixletterandtype2992,98538
-\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98568
-\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98623
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98727
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98798
- \def\linenumber{\linenumber3009,99137
-\def\refx#1#2{\refx3015,99321
-\def\xrdef #1#2{\xrdef3037,99947
-\def\readauxfile{\readauxfile3040,100032
-\def\supereject{\supereject3110,101813
-\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102498
-\def\openindices{\openindices3139,102684
-\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102909
-\parindent = \defaultparindentaultparindent3152,102961
-\def\smallbook{\smallbook3175,103685
-\global\def\Esmallexample{\Esmallexample3192,104112
-\def\afourpaper{\afourpaper3196,104203
-\def\finalout{\finalout3224,105011
-\def\normaldoublequote{\normaldoublequote3235,105272
-\def\normaltilde{\normaltilde3236,105298
-\def\normalcaret{\normalcaret3237,105318
-\def\normalunderscore{\normalunderscore3238,105338
-\def\normalverticalbar{\normalverticalbar3239,105363
-\def\normalless{\normalless3240,105389
-\def\normalgreater{\normalgreater3241,105408
-\def\normalplus{\normalplus3242,105430
-\def\ifusingtt#1#2{\ifusingtt3253,105922
-\def\activedoublequote{\activedoublequote3261,106250
-\def~{~3264,106336
-\def^{^3267,106397
-\def_{_3270,106436
-\def\_{\_3272,106510
-\def\lvvmode{\lvvmode3279,106847
-\def|{|3282,106897
-\def<{<3285,106960
-\def>{>3288,107017
-\def+{+3290,107055
-\def\turnoffactive{\turnoffactive3296,107216
-\global\def={=3307,107502
-\def\normalbackslash{\normalbackslash3321,107884
+\def\itemfont{\itemfont1082,35890
+\def\Etable{\Etable1090,36116
+\def\itemize{\itemize1103,36440
+\def\itemizezzz #1{\itemizezzz1105,36476
+\def\itemizey #1#2{\itemizey1110,36571
+\def#2{1119,36817
+\def\itemcontents{\itemcontents1120,36858
+\def\bullet{\bullet1123,36906
+\def\minus{\minus1124,36933
+\def\frenchspacing{\frenchspacing1128,37041
+\def\splitoff#1#2\endmark{\splitoff1134,37266
+\def\enumerate{\enumerate1140,37496
+\def\enumeratezzz #1{\enumeratezzz1141,37535
+\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37588
+ \def\thearg{\thearg1146,37735
+ \ifx\thearg\empty \def\thearg{\thearg1147,37754
+\def\numericenumerate{\numericenumerate1184,39088
+\def\lowercaseenumerate{\lowercaseenumerate1190,39218
+\def\uppercaseenumerate{\uppercaseenumerate1203,39565
+\def\startenumeration#1{\startenumeration1219,40055
+\def\alphaenumerate{\alphaenumerate1227,40237
+\def\capsenumerate{\capsenumerate1228,40272
+\def\Ealphaenumerate{\Ealphaenumerate1229,40306
+\def\Ecapsenumerate{\Ecapsenumerate1230,40340
+\def\itemizeitem{\itemizeitem1234,40420
+\def\newindex #1{\newindex1259,41277
+\def\defindex{\defindex1268,41566
+\def\newcodeindex #1{\newcodeindex1272,41674
+\def\defcodeindex{\defcodeindex1279,41934
+\def\synindex #1 #2 {\synindex1283,42114
+\def\syncodeindex #1 #2 {\syncodeindex1292,42454
+\def\doindex#1{\doindex1309,43133
+\def\singleindexer #1{\singleindexer1310,43192
+\def\docodeindex#1{\docodeindex1313,43304
+\def\singlecodeindexer #1{\singlecodeindexer1314,43371
+\def\indexdummies{\indexdummies1316,43429
+\def\_{\_1317,43449
+\def\w{\w1318,43477
+\def\bf{\bf1319,43504
+\def\rm{\rm1320,43533
+\def\sl{\sl1321,43562
+\def\sf{\sf1322,43591
+\def\tt{\tt1323,43619
+\def\gtr{\gtr1324,43647
+\def\less{\less1325,43677
+\def\hat{\hat1326,43709
+\def\char{\char1327,43739
+\def\TeX{\TeX1328,43771
+\def\dots{\dots1329,43801
+\def\copyright{\copyright1330,43834
+\def\tclose##1{\tclose1331,43877
+\def\code##1{\code1332,43922
+\def\samp##1{\samp1333,43963
+\def\t##1{\t1334,44004
+\def\r##1{\r1335,44039
+\def\i##1{\i1336,44074
+\def\b##1{\b1337,44109
+\def\cite##1{\cite1338,44144
+\def\key##1{\key1339,44185
+\def\file##1{\file1340,44224
+\def\var##1{\var1341,44265
+\def\kbd##1{\kbd1342,44304
+\def\indexdummyfont#1{\indexdummyfont1347,44460
+\def\indexdummytex{\indexdummytex1348,44486
+\def\indexdummydots{\indexdummydots1349,44510
+\def\indexnofonts{\indexnofonts1351,44536
+\let\w=\indexdummyfontdummyfont1352,44556
+\let\t=\indexdummyfontdummyfont1353,44579
+\let\r=\indexdummyfontdummyfont1354,44602
+\let\i=\indexdummyfontdummyfont1355,44625
+\let\b=\indexdummyfontdummyfont1356,44648
+\let\emph=\indexdummyfontdummyfont1357,44671
+\let\strong=\indexdummyfontdummyfont1358,44697
+\let\cite=\indexdummyfont=\indexdummyfont1359,44725
+\let\sc=\indexdummyfontdummyfont1360,44751
+\let\tclose=\indexdummyfontdummyfont1364,44923
+\let\code=\indexdummyfontdummyfont1365,44951
+\let\file=\indexdummyfontdummyfont1366,44977
+\let\samp=\indexdummyfontdummyfont1367,45003
+\let\kbd=\indexdummyfontdummyfont1368,45029
+\let\key=\indexdummyfontdummyfont1369,45054
+\let\var=\indexdummyfontdummyfont1370,45079
+\let\TeX=\indexdummytexdummytex1371,45104
+\let\dots=\indexdummydotsdummydots1372,45128
+\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45380
+\def\doind #1#2{\doind1384,45436
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45479
+\def\rawbackslashxx{\rawbackslashxx1389,45619
+{\indexnofontsnofonts1394,45881
+\def\dosubind #1#2#3{\dosubind1405,46192
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46240
+\def\rawbackslashxx{\rawbackslashxx1410,46344
+{\indexnofontsnofonts1414,46498
+\def\findex {\findex1443,47429
+\def\kindex {\kindex1444,47452
+\def\cindex {\cindex1445,47475
+\def\vindex {\vindex1446,47498
+\def\tindex {\tindex1447,47521
+\def\pindex {\pindex1448,47544
+\def\cindexsub {\cindexsub1450,47568
+\def\printindex{\printindex1462,47895
+\def\doprintindex#1{\doprintindex1464,47936
+ \def\indexbackslash{\indexbackslash1481,48421
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48460
+\def\initial #1{\initial1517,49532
+\def\entry #1#2{\entry1523,49739
+ \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50386
+\def\indexdotfill{\indexdotfill1549,50714
+\def\primary #1{\primary1552,50820
+\def\secondary #1#2{\secondary1556,50902
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50984
+\newbox\partialpageialpage1566,51157
+\def\begindoublecolumns{\begindoublecolumns1572,51315
+ \output={\global\setbox\partialpage=ialpage=1573,51351
+\def\enddoublecolumns{\enddoublecolumns1577,51539
+\def\doublecolumnout{\doublecolumnout1580,51624
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51693
+\def\pagesofar{\pagesofar1584,51871
+\def\balancecolumns{\balancecolumns1588,52108
+ \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52279
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52540
+\newcount \appendixno \appendixno = `\@no1627,53445
+\def\appendixletter{\appendixletter1628,53486
+\def\opencontents{\opencontents1632,53589
+\def\thischapter{\thischapter1637,53770
+\def\seccheck#1{\seccheck1638,53808
+\def\chapternofonts{\chapternofonts1643,53912
+\def\result{\result1646,53987
+\def\equiv{\equiv1647,54022
+\def\expansion{\expansion1648,54055
+\def\print{\print1649,54096
+\def\TeX{\TeX1650,54129
+\def\dots{\dots1651,54158
+\def\copyright{\copyright1652,54189
+\def\tt{\tt1653,54230
+\def\bf{\bf1654,54257
+\def\w{\w1655,54285
+\def\less{\less1656,54310
+\def\gtr{\gtr1657,54341
+\def\hat{\hat1658,54370
+\def\char{\char1659,54399
+\def\tclose##1{\tclose1660,54430
+\def\code##1{\code1661,54474
+\def\samp##1{\samp1662,54514
+\def\r##1{\r1663,54554
+\def\b##1{\b1664,54588
+\def\key##1{\key1665,54622
+\def\file##1{\file1666,54660
+\def\kbd##1{\kbd1667,54700
+\def\i##1{\i1669,54808
+\def\cite##1{\cite1670,54842
+\def\var##1{\var1671,54882
+\def\emph##1{\emph1672,54920
+\def\dfn##1{\dfn1673,54960
+\def\thischaptername{\thischaptername1676,55001
+\outer\def\chapter{\chapter1677,55040
+\def\chapterzzz #1{\chapterzzz1678,55081
+{\chapternofonts%nofonts%1687,55477
+\global\let\section = \numberedsec=1692,55630
+\global\let\subsection = \numberedsubsec=1693,55665
+\global\let\subsubsection = \numberedsubsubsec=1694,55706
+\outer\def\appendix{\appendix1697,55757
+\def\appendixzzz #1{\appendixzzz1698,55800
+\global\advance \appendixno by 1 \message{no1700,55877
+\chapmacro {#1}{Appendix \appendixletter}letter1701,55946
+\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56039
+{\chapternofonts%nofonts%1705,56111
+ {#1}{Appendix \appendixletter}letter1707,56167
+\appendixnoderef %noderef1710,56267
+\global\let\section = \appendixsec=1711,56286
+\global\let\subsection = \appendixsubsec=1712,56321
+\global\let\subsubsection = \appendixsubsubsec=1713,56362
+\outer\def\top{\top1716,56413
+\outer\def\unnumbered{\unnumbered1717,56453
+\def\unnumberedzzz #1{\unnumberedzzz1718,56500
+{\chapternofonts%nofonts%1722,56663
+\global\let\section = \unnumberedsec=1727,56813
+\global\let\subsection = \unnumberedsubsec=1728,56850
+\global\let\subsubsection = \unnumberedsubsubsec=1729,56893
+\outer\def\numberedsec{\numberedsec1732,56946
+\def\seczzz #1{\seczzz1733,56987
+{\chapternofonts%nofonts%1736,57143
+\outer\def\appendixsection{\appendixsection1745,57329
+\outer\def\appendixsec{\appendixsec1746,57386
+\def\appendixsectionzzz #1{\appendixsectionzzz1747,57439
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57551
+{\chapternofonts%nofonts%1750,57619
+{#1}{\appendixletter}letter1752,57675
+\appendixnoderef %noderef1755,57775
+\outer\def\unnumberedsec{\unnumberedsec1759,57815
+\def\unnumberedseczzz #1{\unnumberedseczzz1760,57868
+{\chapternofonts%nofonts%1762,57963
+\outer\def\numberedsubsec{\numberedsubsec1770,58131
+\def\numberedsubseczzz #1{\numberedsubseczzz1771,58186
+{\chapternofonts%nofonts%1774,58365
+\outer\def\appendixsubsec{\appendixsubsec1783,58569
+\def\appendixsubseczzz #1{\appendixsubseczzz1784,58624
+\subsecheading {#1}{\appendixletter}letter1786,58746
+{\chapternofonts%nofonts%1787,58811
+{#1}{\appendixletter}letter1789,58870
+\appendixnoderef %noderef1792,58985
+\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59025
+\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59084
+{\chapternofonts%nofonts%1799,59185
+\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59356
+\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59417
+{\chapternofonts%nofonts%1812,59614
+\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59847
+\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59908
+ {\appendixletter}letter1827,60047
+{\chapternofonts%nofonts%1828,60113
+ {\appendixletter}letter1830,60178
+\appendixnoderef %noderef1834,60312
+\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60352
+\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60417
+{\chapternofonts%nofonts%1841,60524
+\def\infotop{\infotop1851,60853
+\def\infounnumbered{\infounnumbered1852,60891
+\def\infounnumberedsec{\infounnumberedsec1853,60936
+\def\infounnumberedsubsec{\infounnumberedsubsec1854,60987
+\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61044
+\def\infoappendix{\infoappendix1857,61108
+\def\infoappendixsec{\infoappendixsec1858,61149
+\def\infoappendixsubsec{\infoappendixsubsec1859,61196
+\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61249
+\def\infochapter{\infochapter1862,61309
+\def\infosection{\infosection1863,61348
+\def\infosubsection{\infosubsection1864,61387
+\def\infosubsubsection{\infosubsubsection1865,61432
+\global\let\section = \numberedsec=1870,61669
+\global\let\subsection = \numberedsubsec=1871,61704
+\global\let\subsubsection = \numberedsubsubsec=1872,61745
+\def\majorheading{\majorheading1886,62252
+\def\majorheadingzzz #1{\majorheadingzzz1887,62297
+\def\chapheading{\chapheading1893,62530
+\def\chapheadingzzz #1{\chapheadingzzz1894,62573
+\def\heading{\heading1899,62768
+\def\subheading{\subheading1901,62805
+\def\subsubheading{\subsubheading1903,62848
+\def\dobreak#1#2{\dobreak1910,63125
+\def\setchapterstyle #1 {\setchapterstyle1912,63203
+\def\chapbreak{\chapbreak1919,63458
+\def\chappager{\chappager1920,63508
+\def\chapoddpage{\chapoddpage1921,63546
+\def\setchapternewpage #1 {\setchapternewpage1923,63625
+\def\CHAPPAGoff{\CHAPPAGoff1925,63682
+\def\CHAPPAGon{\CHAPPAGon1929,63776
+\global\def\HEADINGSon{\HEADINGSon1932,63867
+\def\CHAPPAGodd{\CHAPPAGodd1934,63909
+\global\def\HEADINGSon{\HEADINGSon1937,64005
+\def\CHAPFplain{\CHAPFplain1941,64059
+\def\chfplain #1#2{\chfplain1945,64151
+\def\unnchfplain #1{\unnchfplain1956,64374
+\def\unnchfopen #1{\unnchfopen1964,64603
+\def\chfopen #1#2{\chfopen1970,64811
+\def\CHAPFopen{\CHAPFopen1975,64955
+\def\subsecheadingbreak{\subsecheadingbreak1982,65173
+\def\secheadingbreak{\secheadingbreak1985,65302
+\def\secheading #1#2#3{\secheading1993,65584
+\def\plainsecheading #1{\plainsecheading1994,65640
+\def\secheadingi #1{\secheadingi1995,65683
+\def\subsecheading #1#2#3#4{\subsecheading2006,66051
+\def\subsecheadingi #1{\subsecheadingi2007,66118
+\def\subsubsecfonts{\subsubsecfonts2014,66415
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66538
+\def\subsubsecheadingi #1{\subsubsecheadingi2018,66616
+\def\startcontents#1{\startcontents2032,67088
+ \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67361
+\outer\def\contents{\contents2049,67720
+\outer\def\summarycontents{\summarycontents2057,67864
+ \def\secentry ##1##2##3##4{\secentry2067,68235
+ \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68270
+ \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68305
+ \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68346
+ \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68384
+ \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68431
+\def\chapentry#1#2#3{\chapentry2085,68865
+\def\shortchapentry#1#2#3{\shortchapentry2088,68982
+ {#2\labelspace #1}space2091,69092
+\def\unnumbchapentry#1#2{\unnumbchapentry2094,69146
+\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69193
+\def\secentry#1#2#3#4{\secentry2102,69357
+\def\unnumbsecentry#1#2{\unnumbsecentry2103,69416
+\def\subsecentry#1#2#3#4#5{\subsecentry2106,69477
+\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69547
+\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69621
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69655
+\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69706
+\def\dochapentry#1#2{\dochapentry2123,70080
+\def\dosecentry#1#2{\dosecentry2138,70685
+\def\dosubsecentry#1#2{\dosubsecentry2145,70863
+\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71048
+\def\labelspace{\labelspace2160,71299
+\def\dopageno#1{\dopageno2162,71334
+\def\doshortpageno#1{\doshortpageno2163,71360
+\def\chapentryfonts{\chapentryfonts2165,71392
+\def\secentryfonts{\secentryfonts2166,71427
+\def\point{\point2192,72386
+\def\result{\result2194,72407
+\def\expansion{\expansion2195,72480
+\def\print{\print2196,72551
+\def\equiv{\equiv2198,72618
+\def\error{\error2218,73391
+\def\tex{\tex2224,73620
+\def\@{\@2242,74003
+\gdef\sepspaces{\def {\ }}}\2265,74735
+\def\aboveenvbreak{\aboveenvbreak2268,74817
+\def\afterenvbreak{\afterenvbreak2272,74983
+\def\ctl{\ctl2286,75494
+\def\ctr{\ctr2287,75566
+\def\cbl{\cbl2288,75605
+\def\cbr{\cbr2289,75645
+\def\carttop{\carttop2290,75684
+\def\cartbot{\cartbot2293,75792
+\long\def\cartouche{\cartouche2299,75932
+\def\Ecartouche{\Ecartouche2326,76720
+\def\lisp{\lisp2338,76855
+\def\Elisp{\Elisp2348,77202
+\def\next##1{\next2360,77528
+\def\Eexample{\Eexample2364,77570
+\def\Esmallexample{\Esmallexample2367,77617
+\def\smalllispx{\smalllispx2373,77795
+\def\Esmalllisp{\Esmalllisp2383,78149
+\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78505
+\def\next##1{\next2397,78562
+\def\display{\display2401,78642
+\def\Edisplay{\Edisplay2410,78961
+\def\next##1{\next2422,79272
+\def\format{\format2426,79375
+\def\Eformat{\Eformat2434,79671
+\def\next##1{\next2437,79760
+\def\flushleft{\flushleft2441,79812
+\def\Eflushleft{\Eflushleft2451,80183
+\def\next##1{\next2454,80276
+\def\flushright{\flushright2456,80298
+\def\Eflushright{\Eflushright2466,80670
+\def\next##1{\next2470,80801
+\def\quotation{\quotation2474,80859
+\def\Equotation{\Equotation2480,81051
+\def\setdeffont #1 {\setdeffont2493,81449
+\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81495
+\newskip\defargsindent \defargsindent=50ptargsindent2496,81538
+\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81581
+\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81624
+\def\activeparens{\activeparens2503,81822
+\def\opnr{\opnr2529,83034
+\def\lbrb{\lbrb2530,83099
+\def\defname #1#2{\defname2536,83300
+\advance\dimen2 by -\defbodyindentbodyindent2540,83418
+\advance\dimen3 by -\defbodyindentbodyindent2542,83472
+\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83526
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83668
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83743
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84112
+\advance\leftskip by -\defbodyindentbodyindent2557,84246
+\exdentamount=\defbodyindentbodyindent2558,84283
+\def\defparsebody #1#2#3{\defparsebody2568,84642
+\def#1{2572,84826
+\def#2{2573,84862
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84934
+\exdentamount=\defbodyindentbodyindent2576,85008
+\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85112
+\def#1{2585,85273
+\def#2##1 {2586,85309
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85392
+\exdentamount=\defbodyindentbodyindent2589,85466
+\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85551
+\def#1{2596,85712
+\def#2##1 ##2 {2597,85748
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85848
+\exdentamount=\defbodyindentbodyindent2601,85922
+\def\defvarparsebody #1#2#3{\defvarparsebody2608,86193
+\def#1{2612,86380
+\def#2{2613,86416
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86475
+\exdentamount=\defbodyindentbodyindent2616,86549
+\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86640
+\def#1{2625,86799
+\def#2##1 {2626,86835
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86905
+\exdentamount=\defbodyindentbodyindent2629,86979
+\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87051
+\def#1{2636,87215
+\def#2##1 ##2 {2637,87251
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87338
+\exdentamount=\defbodyindentbodyindent2641,87412
+\def\defunargs #1{\defunargs2664,88172
+\def\deftypefunargs #1{\deftypefunargs2676,88554
+\def\deffn{\deffn2690,88936
+\def\deffnheader #1#2#3{\deffnheader2692,88993
+\begingroup\defname {name2693,89041
+\def\defun{\defun2699,89186
+\def\defunheader #1#2{\defunheader2701,89239
+\begingroup\defname {name2702,89314
+\defunargs {unargs2703,89350
+\def\deftypefun{\deftypefun2709,89498
+\def\deftypefunheader #1#2{\deftypefunheader2712,89620
+\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89729
+\begingroup\defname {name2716,89821
+\deftypefunargs {typefunargs2717,89867
+\def\deftypefn{\deftypefn2723,90038
+\def\deftypefnheader #1#2#3{\deftypefnheader2726,90187
+\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90323
+\begingroup\defname {name2730,90416
+\deftypefunargs {typefunargs2731,90456
+\def\defmac{\defmac2737,90577
+\def\defmacheader #1#2{\defmacheader2739,90634
+\begingroup\defname {name2740,90710
+\defunargs {unargs2741,90743
+\def\defspec{\defspec2747,90867
+\def\defspecheader #1#2{\defspecheader2749,90928
+\begingroup\defname {name2750,91005
+\defunargs {unargs2751,91045
+\def\deffnx #1 {\deffnx2758,91240
+\def\defunx #1 {\defunx2759,91297
+\def\defmacx #1 {\defmacx2760,91354
+\def\defspecx #1 {\defspecx2761,91413
+\def\deftypefnx #1 {\deftypefnx2762,91474
+\def\deftypeunx #1 {\deftypeunx2763,91539
+\def\defop #1 {\defop2769,91685
+\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91720
+\def\defopheader #1#2#3{\defopheader2772,91774
+\begingroup\defname {name2774,91863
+\defunargs {unargs2775,91909
+\def\defmethod{\defmethod2780,91970
+\def\defmethodheader #1#2#3{\defmethodheader2782,92043
+\begingroup\defname {name2784,92131
+\defunargs {unargs2785,92171
+\def\defcv #1 {\defcv2790,92245
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92280
+\def\defcvarheader #1#2#3{\defcvarheader2793,92339
+\begingroup\defname {name2795,92425
+\defvarargs {varargs2796,92471
+\def\defivar{\defivar2801,92544
+\def\defivarheader #1#2#3{\defivarheader2803,92607
+\begingroup\defname {name2805,92693
+\defvarargs {varargs2806,92744
+\def\defopx #1 {\defopx2812,92893
+\def\defmethodx #1 {\defmethodx2813,92950
+\def\defcvx #1 {\defcvx2814,93015
+\def\defivarx #1 {\defivarx2815,93072
+\def\defvarargs #1{\defvarargs2822,93343
+\def\defvr{\defvr2828,93487
+\def\defvrheader #1#2#3{\defvrheader2830,93542
+\begingroup\defname {name2831,93590
+\def\defvar{\defvar2835,93675
+\def\defvarheader #1#2{\defvarheader2837,93735
+\begingroup\defname {name2838,93806
+\defvarargs {varargs2839,93842
+\def\defopt{\defopt2844,93908
+\def\defoptheader #1#2{\defoptheader2846,93968
+\begingroup\defname {name2847,94039
+\defvarargs {varargs2848,94078
+\def\deftypevar{\deftypevar2853,94135
+\def\deftypevarheader #1#2{\deftypevarheader2856,94251
+\begingroup\defname {name2858,94334
+\def\deftypevr{\deftypevr2865,94508
+\def\deftypevrheader #1#2#3{\deftypevrheader2867,94579
+\begingroup\defname {name2868,94631
+\def\defvrx #1 {\defvrx2876,94868
+\def\defvarx #1 {\defvarx2877,94925
+\def\defoptx #1 {\defoptx2878,94984
+\def\deftypevarx #1 {\deftypevarx2879,95043
+\def\deftypevrx #1 {\deftypevrx2880,95110
+\def\deftpargs #1{\deftpargs2885,95259
+\def\deftp{\deftp2889,95339
+\def\deftpheader #1#2#3{\deftpheader2891,95394
+\begingroup\defname {name2892,95442
+\def\deftpx #1 {\deftpx2897,95601
+\def\setref#1{\setref2908,95922
+\def\unnumbsetref#1{\unnumbsetref2913,96036
+\def\appendixsetref#1{\appendixsetref2918,96143
+\def\pxref#1{\pxref2929,96554
+\def\xref#1{\xref2930,96590
+\def\ref#1{\ref2931,96625
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96655
+\def\printedmanual{\printedmanual2933,96698
+\def\printednodename{\printednodename2934,96736
+\def\printednodename{\printednodename2939,96861
+section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97493
+\refx{x2957,97571
+\def\dosetq #1#2{\dosetq2965,97791
+\def\internalsetq #1#2{\internalsetq2973,98049
+\def\Ypagenumber{\Ypagenumber2977,98150
+\def\Ytitle{\Ytitle2979,98176
+\def\Ynothing{\Ynothing2981,98203
+\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98220
+\def\Yappendixletterandtype{\Yappendixletterandtype2992,98536
+\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98566
+\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98621
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98725
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98796
+ \def\linenumber{\linenumber3009,99135
+\def\refx#1#2{\refx3015,99319
+\def\xrdef #1#2{\xrdef3037,99945
+\def\readauxfile{\readauxfile3040,100030
+\def\supereject{\supereject3110,101811
+\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102496
+\def\openindices{\openindices3139,102682
+\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102907
+\parindent = \defaultparindentaultparindent3152,102959
+\def\smallbook{\smallbook3175,103683
+\global\def\Esmallexample{\Esmallexample3192,104110
+\def\afourpaper{\afourpaper3196,104201
+\def\finalout{\finalout3224,105009
+\def\normaldoublequote{\normaldoublequote3235,105270
+\def\normaltilde{\normaltilde3236,105296
+\def\normalcaret{\normalcaret3237,105316
+\def\normalunderscore{\normalunderscore3238,105336
+\def\normalverticalbar{\normalverticalbar3239,105361
+\def\normalless{\normalless3240,105387
+\def\normalgreater{\normalgreater3241,105406
+\def\normalplus{\normalplus3242,105428
+\def\ifusingtt#1#2{\ifusingtt3253,105920
+\def\activedoublequote{\activedoublequote3261,106248
+\def~{~3264,106334
+\def^{^3267,106395
+\def_{_3270,106434
+\def\_{\_3272,106508
+\def\lvvmode{\lvvmode3279,106845
+\def|{|3282,106895
+\def<{<3285,106958
+\def>{>3288,107015
+\def+{+3290,107053
+\def\turnoffactive{\turnoffactive3296,107214
+\global\def={=3307,107500
+\def\normalbackslash{\normalbackslash3321,107882
+
+merc-src/accumulator.m,3228
+:- interface146,5371
+:- import_module hlds148,5386
+:- import_module univ152,5478
+:- pred accu_transform_proc159,5793
+:- implementation166,6115
+:- import_module libs180,6552
+:- import_module mdbcomp184,6681
+:- import_module parse_tree186,6742
+:- import_module assoc_list194,7013
+:- import_module bool195,7042
+:- import_module int196,7065
+:- import_module io197,7087
+:- import_module list198,7108
+:- import_module map199,7131
+:- import_module maybe200,7153
+:- import_module pair201,7177
+:- import_module require202,7200
+:- import_module set203,7226
+:- import_module solutions204,7248
+:- import_module string205,7276
+:- import_module term206,7301
+:- import_module varset207,7324
+:- type top_level213,7499
+:- type accu_goal_id225,7900
+:- type accu_case228,7964
+:- type accu_goal_store234,8091
+:- type accu_subst238,8216
+:- type accu_warning240,8264
+:- pred generate_warnings334,12550
+:- pred generate_warning342,12895
+:- pred should_attempt_accu_transform365,13886
+:- pred should_attempt_accu_transform_2398,15406
+:- pred accu_standardize440,17390
+:- pred identify_goal_type465,18169
+:- pred is_recursive_case549,21175
+:- type store_info560,21713
+:- func initialize_goal_store570,22060
+:- pred accu_store580,22421
+:- pred identify_recursive_calls601,23288
+:- pred identify_out_and_out_prime626,24396
+:- type accu_sets676,26425
+:- pred accu_stage1689,26977
+:- pred accu_stage1_2727,28347
+:- pred accu_sets_init781,30557
+:- func set_upto796,30984
+:- pred accu_before812,31498
+:- pred accu_assoc835,32477
+:- pred accu_construct862,33712
+:- pred accu_construct_assoc896,35307
+:- pred accu_update938,37069
+:- pred member_lessthan_goalid964,38219
+:- type accu_assoc975,38652
+:- pred accu_is_associative986,39138
+:- pred associativity_assertion1014,40263
+:- pred commutativity_assertion1037,41242
+:- pred accu_is_update1057,41952
+:- pred is_associative_construction1078,42802
+:- type accu_substs1095,43480
+:- type accu_base1103,43744
+:- pred accu_stage21124,44605
+:- pred accu_substs_init1179,46957
+:- pred acc_var_subst_init1194,47573
+:- pred create_new_var1207,48147
+:- pred accu_process_assoc_set1223,48862
+:- pred accu_has_heuristic1297,52081
+:- pred accu_heuristic1304,52336
+:- pred accu_process_update_set1318,52906
+:- pred accu_divide_base_case1380,55844
+:- pred accu_related1412,57146
+:- inst stored_goal_plain_call1444,58415
+:- pred lookup_call1449,58601
+:- pred accu_stage31470,59432
+:- pred acc_proc_info1508,61326
+:- pred acc_pred_info1556,63449
+:- pred accu_create_goal1600,65285
+:- func create_acc_call1621,66400
+:- pred create_orig_goal1634,66987
+:- pred create_acc_goal1662,68157
+:- func create_new_orig_recursive_goals1709,70225
+:- func create_new_recursive_goals1723,70918
+:- func create_new_base_goals1738,71717
+:- pred acc_unification1749,72156
+:- pred accu_top_level1766,72896
+:- pred update_accumulator_pred1856,76290
+:- func accu_rename1876,77253
+:- func base_case_ids1889,77784
+:- func base_case_ids_set1898,78048
+:- func accu_goal_list1905,78269
+:- pred calculate_goal_info1916,78680
+:- func chain_subst1932,79319
+:- pred chain_subst_21938,79482
+:- some [T] pred unravel_univ1956,80060
+:- pragma foreign_export1957,80116
c-src/c.c,76
T f(1,0
@@ -3984,13 +4082,13 @@ yyerror FUN1(286,5948
make_list FUN2(293,6028
#define ERROR 304,6228
yylex FUN0(315,6405
-parse_cell_or_range FUN2(587,11771
-#define CK_ABS_R(671,13213
-#define CK_REL_R(675,13292
-#define CK_ABS_C(680,13421
-#define CK_REL_C(684,13500
-#define MAYBEREL(689,13629
-str_to_col FUN1(847,16830
+parse_cell_or_range FUN2(587,11772
+#define CK_ABS_R(671,13214
+#define CK_REL_R(675,13293
+#define CK_ABS_C(680,13422
+#define CK_REL_C(684,13501
+#define MAYBEREL(689,13630
+str_to_col FUN1(847,16831
y-src/parse.c,520
#define YYBISON 4,64
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index ddb8d19540b..45979d6a763 100644
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -175,7 +175,7 @@ package body Truc.Bidule Truc.Bidule/b138,2153
protected body Bidule Bidule/b139,2181
protected body Machin_T Machin_T/b146,2281
-c-src/abbrev.c,2072
+c-src/abbrev.c,1957
Lisp_Object Vabbrev_table_name_list;43,1429
Lisp_Object Vglobal_abbrev_table;48,1574
Lisp_Object Vfundamental_mode_abbrev_table;52,1685
@@ -186,33 +186,31 @@ Lisp_Object Vabbrev_start_location_buffer;66,2046
Lisp_Object Vlast_abbrev;70,2155
Lisp_Object Vlast_abbrev_text;75,2324
int last_abbrev_point;79,2414
-Lisp_Object Vpre_abbrev_expand_hook,83,2487
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;83,2487
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,85,2551
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table85,2551
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,92,2743
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table92,2743
-DEFUN ("define-abbrev", Fdefine_abbrev,107,3124
-DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev107,3124
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,149,4443
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev149,4443
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,160,4814
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev160,4814
-DEFUN ("abbrev-symbol", Fabbrev_symbol,174,5282
-DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol174,5282
-DEFUN ("abbrev-expansion", Fabbrev_expansion,202,6246
-DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion202,6246
-DEFUN ("expand-abbrev", Fexpand_abbrev,218,6761
-DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev218,6761
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,389,11682
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev389,11682
-write_abbrev 426,12889
-describe_abbrev 445,13324
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,466,13839
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description466,13839
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,506,14995
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table506,14995
-syms_of_abbrev 540,16072
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,82,2440
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table82,2440
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,89,2632
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table89,2632
+DEFUN ("define-abbrev", Fdefine_abbrev,104,3013
+DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev104,3013
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,146,4332
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev146,4332
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,157,4703
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev157,4703
+DEFUN ("abbrev-symbol", Fabbrev_symbol,171,5171
+DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol171,5171
+DEFUN ("abbrev-expansion", Fabbrev_expansion,199,6135
+DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion199,6135
+DEFUN ("expand-abbrev", Fexpand_abbrev,215,6650
+DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev215,6650
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,383,11495
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev383,11495
+write_abbrev 420,12702
+describe_abbrev 439,13137
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,460,13652
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description460,13652
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,500,14808
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table500,14808
+syms_of_abbrev 534,15885
c-src/torture.c,197
(*tag1 tag118,452
@@ -1228,160 +1226,160 @@ make_lispy_position 5228,157391
toolkit_menubar_in_use 5456,163954
make_scroll_bar_position 5469,164322
make_lispy_event 5485,164968
-make_lispy_movement 6104,183532
-make_lispy_switch_frame 6131,184263
-make_lispy_focus_in 6137,184370
-make_lispy_focus_out 6145,184496
-parse_modifiers_uncached 6163,184946
-#define SINGLE_LETTER_MOD(6185,185466
-#undef SINGLE_LETTER_MOD6212,185907
-#define MULTI_LETTER_MOD(6214,185933
-#undef MULTI_LETTER_MOD6231,186401
-apply_modifiers_uncached 6273,187575
-static const char *const modifier_names[modifier_names6319,189194
-#define NUM_MOD_NAMES 6325,189400
-static Lisp_Object modifier_symbols;6327,189450
-lispy_modifier_list 6331,189587
-#define KEY_TO_CHAR(6353,190253
-parse_modifiers 6356,190329
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191518
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191518
-apply_modifiers 6422,192392
-reorder_modifiers 6491,194721
-modify_event_symbol 6536,196529
-DEFUN ("event-convert-list", Fevent_convert_list,6628,199245
-DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199245
-parse_solitary_modifier 6695,201136
-#define SINGLE_LETTER_MOD(6701,201259
-#define MULTI_LETTER_MOD(6705,201344
-#undef SINGLE_LETTER_MOD6763,202642
-#undef MULTI_LETTER_MOD6764,202667
-lucid_event_type_list_p 6775,202890
-get_input_pending 6814,203961
-record_asynch_buffer_change 6834,204580
-gobble_input 6872,205703
-tty_read_avail_input 6967,208311
-handle_async_input 7149,214040
-process_pending_signals 7165,214360
-unblock_input_to 7177,214646
-unblock_input 7200,215278
-totally_unblock_input 7209,215446
-handle_input_available_signal 7217,215530
-deliver_input_available_signal 7226,215701
-struct user_signal_info7235,215866
-static struct user_signal_info *user_signals user_signals7250,216091
-add_user_signal 7253,216150
-handle_user_signal 7275,216599
-deliver_user_signal 7316,217559
-find_user_signal_name 7322,217660
-store_user_signal_events 7334,217842
-static void menu_bar_item 7362,218342
-static Lisp_Object menu_bar_one_keymap_changed_items;7363,218417
-static Lisp_Object menu_bar_items_vector;7368,218631
-static int menu_bar_items_index;7369,218673
-static const char *separator_names[separator_names7372,218708
-menu_separator_name_p 7393,219149
-menu_bar_items 7426,219853
-Lisp_Object item_properties;7568,224604
-menu_bar_item 7571,224646
-menu_item_eval_property_1 7647,227176
-eval_dyn 7658,227466
-menu_item_eval_property 7666,227676
-parse_menu_item 7686,228342
-static Lisp_Object tool_bar_items_vector;7965,236337
-static Lisp_Object tool_bar_item_properties;7970,236511
-static int ntool_bar_items;7974,236607
-static void init_tool_bar_items 7978,236665
-static void process_tool_bar_item 7979,236712
-static bool parse_tool_bar_item 7981,236802
-static void append_tool_bar_item 7982,236862
-tool_bar_items 7990,237084
-process_tool_bar_item 8075,239893
-#define PROP(8112,240970
-set_prop 8114,241039
-parse_tool_bar_item 8167,242454
-#undef PROP8379,248845
-init_tool_bar_items 8387,248970
-append_tool_bar_item 8401,249262
-read_char_x_menu_prompt 8443,250772
-read_char_minibuf_menu_prompt 8503,252446
-#define PUSH_C_STR(8527,253015
-follow_key 8726,258554
-active_maps 8733,258696
-typedef struct keyremap8742,259022
-} keyremap;8754,259465
-access_keymap_keyremap 8764,259809
-keyremap_step 8811,261451
-test_undefined 8867,262935
-read_key_sequence 8916,264862
-read_key_sequence_vs 9826,295822
-DEFUN ("read-key-sequence", Fread_key_sequence,9885,297295
-DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297295
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299983
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299983
-detect_input_pending 9950,300489
-detect_input_pending_ignore_squeezables 9959,300655
-detect_input_pending_run_timers 9967,300871
-clear_input_pending 9985,301363
-requeued_events_pending_p 9997,301733
-DEFUN ("input-pending-p", Finput_pending_p,10002,301814
-DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301814
-DEFUN ("recent-keys", Frecent_keys,10024,302597
-DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302597
-DEFUN ("this-command-keys", Fthis_command_keys,10055,303518
-DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303518
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303959
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303959
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304381
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304381
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304956
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304956
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305496
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305496
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306511
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306511
-DEFUN ("recursion-depth", Frecursion_depth,10158,307070
-DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307070
-DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307407
-DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307407
-DEFUN ("discard-input", Fdiscard_input,10203,308448
-DEFUN ("discard-input", Fdiscard_input,discard-input10203,308448
-DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308950
-DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308950
-stuff_buffered_input 10285,311046
-set_waiting_for_input 10323,312017
-clear_waiting_for_input 10337,312391
-handle_interrupt_signal 10351,312755
-deliver_interrupt_signal 10378,313643
-static int volatile force_quit_count;10387,313933
-handle_interrupt 10401,314415
-quit_throw_to_read_char 10541,318712
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319289
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319289
-DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320517
-DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320517
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321433
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321433
-DEFUN ("set-quit-char", Fset_quit_char,10694,322707
-DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322707
-DEFUN ("set-input-mode", Fset_input_mode,10729,323571
-DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323571
-DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324460
-DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324460
-DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325838
-DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325838
-DEFUN ("posn-at-point", Fposn_at_point,10824,327061
-DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327061
-init_kboard 10861,328215
-allocate_kboard 10893,329285
-wipe_kboard 10909,329638
-delete_kboard 10917,329752
-init_keyboard 10942,330282
-struct event_head11021,332697
-static const struct event_head head_table[head_table11027,332748
-syms_of_keyboard 11045,333578
-keys_of_keyboard 11841,367116
-mark_kboards 11916,370435
+make_lispy_movement 6104,183531
+make_lispy_switch_frame 6131,184262
+make_lispy_focus_in 6137,184369
+make_lispy_focus_out 6145,184495
+parse_modifiers_uncached 6163,184945
+#define SINGLE_LETTER_MOD(6185,185465
+#undef SINGLE_LETTER_MOD6212,185906
+#define MULTI_LETTER_MOD(6214,185932
+#undef MULTI_LETTER_MOD6231,186400
+apply_modifiers_uncached 6273,187574
+static const char *const modifier_names[modifier_names6319,189193
+#define NUM_MOD_NAMES 6325,189399
+static Lisp_Object modifier_symbols;6327,189449
+lispy_modifier_list 6331,189586
+#define KEY_TO_CHAR(6353,190252
+parse_modifiers 6356,190328
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191517
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191517
+apply_modifiers 6422,192391
+reorder_modifiers 6491,194720
+modify_event_symbol 6536,196528
+DEFUN ("event-convert-list", Fevent_convert_list,6628,199244
+DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199244
+parse_solitary_modifier 6695,201135
+#define SINGLE_LETTER_MOD(6701,201258
+#define MULTI_LETTER_MOD(6705,201343
+#undef SINGLE_LETTER_MOD6763,202641
+#undef MULTI_LETTER_MOD6764,202666
+lucid_event_type_list_p 6775,202889
+get_input_pending 6814,203960
+record_asynch_buffer_change 6834,204579
+gobble_input 6872,205702
+tty_read_avail_input 6967,208310
+handle_async_input 7149,214039
+process_pending_signals 7165,214359
+unblock_input_to 7177,214645
+unblock_input 7200,215277
+totally_unblock_input 7209,215445
+handle_input_available_signal 7217,215529
+deliver_input_available_signal 7226,215700
+struct user_signal_info7235,215865
+static struct user_signal_info *user_signals user_signals7250,216090
+add_user_signal 7253,216149
+handle_user_signal 7275,216598
+deliver_user_signal 7316,217558
+find_user_signal_name 7322,217659
+store_user_signal_events 7334,217841
+static void menu_bar_item 7362,218341
+static Lisp_Object menu_bar_one_keymap_changed_items;7363,218416
+static Lisp_Object menu_bar_items_vector;7368,218630
+static int menu_bar_items_index;7369,218672
+static const char *separator_names[separator_names7372,218707
+menu_separator_name_p 7393,219148
+menu_bar_items 7426,219852
+Lisp_Object item_properties;7568,224603
+menu_bar_item 7571,224645
+menu_item_eval_property_1 7647,227175
+eval_dyn 7658,227465
+menu_item_eval_property 7666,227675
+parse_menu_item 7686,228341
+static Lisp_Object tool_bar_items_vector;7965,236336
+static Lisp_Object tool_bar_item_properties;7970,236510
+static int ntool_bar_items;7974,236606
+static void init_tool_bar_items 7978,236664
+static void process_tool_bar_item 7979,236711
+static bool parse_tool_bar_item 7981,236801
+static void append_tool_bar_item 7982,236861
+tool_bar_items 7990,237083
+process_tool_bar_item 8075,239892
+#define PROP(8112,240969
+set_prop 8114,241038
+parse_tool_bar_item 8167,242453
+#undef PROP8379,248844
+init_tool_bar_items 8387,248969
+append_tool_bar_item 8401,249261
+read_char_x_menu_prompt 8443,250771
+read_char_minibuf_menu_prompt 8503,252445
+#define PUSH_C_STR(8527,253014
+follow_key 8726,258553
+active_maps 8733,258695
+typedef struct keyremap8742,259021
+} keyremap;8754,259464
+access_keymap_keyremap 8764,259808
+keyremap_step 8811,261450
+test_undefined 8867,262934
+read_key_sequence 8916,264861
+read_key_sequence_vs 9826,295821
+DEFUN ("read-key-sequence", Fread_key_sequence,9885,297294
+DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297294
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299982
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299982
+detect_input_pending 9950,300488
+detect_input_pending_ignore_squeezables 9959,300654
+detect_input_pending_run_timers 9967,300870
+clear_input_pending 9985,301362
+requeued_events_pending_p 9997,301732
+DEFUN ("input-pending-p", Finput_pending_p,10002,301813
+DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301813
+DEFUN ("recent-keys", Frecent_keys,10024,302596
+DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302596
+DEFUN ("this-command-keys", Fthis_command_keys,10055,303517
+DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303517
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303958
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303958
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304380
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304380
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304955
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304955
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305495
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305495
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306510
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306510
+DEFUN ("recursion-depth", Frecursion_depth,10158,307069
+DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307069
+DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307406
+DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307406
+DEFUN ("discard-input", Fdiscard_input,10203,308447
+DEFUN ("discard-input", Fdiscard_input,discard-input10203,308447
+DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308949
+DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308949
+stuff_buffered_input 10285,311045
+set_waiting_for_input 10323,312016
+clear_waiting_for_input 10337,312390
+handle_interrupt_signal 10351,312754
+deliver_interrupt_signal 10378,313642
+static int volatile force_quit_count;10387,313932
+handle_interrupt 10401,314414
+quit_throw_to_read_char 10541,318711
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319288
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319288
+DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320516
+DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320516
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321432
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321432
+DEFUN ("set-quit-char", Fset_quit_char,10694,322706
+DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322706
+DEFUN ("set-input-mode", Fset_input_mode,10729,323570
+DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323570
+DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324459
+DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324459
+DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325837
+DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325837
+DEFUN ("posn-at-point", Fposn_at_point,10824,327060
+DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327060
+init_kboard 10861,328214
+allocate_kboard 10893,329284
+wipe_kboard 10909,329637
+delete_kboard 10917,329751
+init_keyboard 10942,330281
+struct event_head11021,332696
+static const struct event_head head_table[head_table11027,332747
+syms_of_keyboard 11045,333577
+keys_of_keyboard 11841,367115
+mark_kboards 11916,370434
c-src/emacs/src/lisp.h,33840
#define EMACS_LISP_H22,801
@@ -2712,11 +2710,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5188
(defvar tags-file-name 34,1035
@@ -3479,22 +3477,22 @@ ord_add_element(71,1867
ord_del_element(85,2344
ord_disjoint(100,2783
ord_intersect(108,2953
-ord_intersection(126,3552
-ord_intersection3(130,3691
-ord_intersection(150,4531
-ord_intersection4(154,4703
-ord_intersection(176,5664
-ord_intersection2(181,5812
-ord_member(200,6318
-ord_seteq(216,6683
-ord_setproduct(225,6971
-ord_subset(240,7377
-ord_subtract(257,7861
-ord_symdiff(265,8054
-ord_union(288,8887
-ord_union4(303,9352
-ord_union(324,10171
-ord_union_all(329,10313
+ord_intersection(126,3553
+ord_intersection3(130,3692
+ord_intersection(150,4533
+ord_intersection4(154,4705
+ord_intersection(176,5666
+ord_intersection2(181,5814
+ord_member(200,6320
+ord_seteq(216,6685
+ord_setproduct(225,6973
+ord_subset(240,7379
+ord_subtract(257,7863
+ord_symdiff(265,8056
+ord_union(288,8889
+ord_union4(303,9354
+ord_union(324,10173
+ord_union_all(329,10315
prol-src/natded.prolog,2319
expandmng(100,2879
@@ -3709,6 +3707,11 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+rs-src/test.rs,52
+enum IpAddrKind 3,11
+fn test1(8,48
+fn main(12,88
+
scm-src/test.scm,260
(define hello 1,0
(set! hello 3,32
@@ -3923,533 +3926,687 @@ tex-src/texinfo.tex,30627
\def\vritemindex #1{\vritemindex1068,35482
\def\tablez #1#2#3#4#5#6{\tablez1074,35631
\def\Edescription{\Edescription1077,35689
-\def\itemfont{\itemfont1082,35891
-\def\Etable{\Etable1090,36117
-\def\itemize{\itemize1103,36441
-\def\itemizezzz #1{\itemizezzz1105,36477
-\def\itemizey #1#2{\itemizey1110,36572
-\def#2{1119,36818
-\def\itemcontents{\itemcontents1120,36859
-\def\bullet{\bullet1123,36907
-\def\minus{\minus1124,36934
-\def\frenchspacing{\frenchspacing1128,37042
-\def\splitoff#1#2\endmark{\splitoff1134,37267
-\def\enumerate{\enumerate1140,37497
-\def\enumeratezzz #1{\enumeratezzz1141,37536
-\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37589
- \def\thearg{\thearg1146,37736
- \ifx\thearg\empty \def\thearg{\thearg1147,37755
-\def\numericenumerate{\numericenumerate1184,39089
-\def\lowercaseenumerate{\lowercaseenumerate1190,39219
-\def\uppercaseenumerate{\uppercaseenumerate1203,39566
-\def\startenumeration#1{\startenumeration1219,40056
-\def\alphaenumerate{\alphaenumerate1227,40238
-\def\capsenumerate{\capsenumerate1228,40273
-\def\Ealphaenumerate{\Ealphaenumerate1229,40307
-\def\Ecapsenumerate{\Ecapsenumerate1230,40341
-\def\itemizeitem{\itemizeitem1234,40421
-\def\newindex #1{\newindex1259,41278
-\def\defindex{\defindex1268,41567
-\def\newcodeindex #1{\newcodeindex1272,41675
-\def\defcodeindex{\defcodeindex1279,41935
-\def\synindex #1 #2 {\synindex1283,42115
-\def\syncodeindex #1 #2 {\syncodeindex1292,42455
-\def\doindex#1{\doindex1309,43134
-\def\singleindexer #1{\singleindexer1310,43193
-\def\docodeindex#1{\docodeindex1313,43305
-\def\singlecodeindexer #1{\singlecodeindexer1314,43372
-\def\indexdummies{\indexdummies1316,43430
-\def\_{\_1317,43450
-\def\w{\w1318,43478
-\def\bf{\bf1319,43505
-\def\rm{\rm1320,43534
-\def\sl{\sl1321,43563
-\def\sf{\sf1322,43592
-\def\tt{\tt1323,43620
-\def\gtr{\gtr1324,43648
-\def\less{\less1325,43678
-\def\hat{\hat1326,43710
-\def\char{\char1327,43740
-\def\TeX{\TeX1328,43772
-\def\dots{\dots1329,43802
-\def\copyright{\copyright1330,43835
-\def\tclose##1{\tclose1331,43878
-\def\code##1{\code1332,43923
-\def\samp##1{\samp1333,43964
-\def\t##1{\t1334,44005
-\def\r##1{\r1335,44040
-\def\i##1{\i1336,44075
-\def\b##1{\b1337,44110
-\def\cite##1{\cite1338,44145
-\def\key##1{\key1339,44186
-\def\file##1{\file1340,44225
-\def\var##1{\var1341,44266
-\def\kbd##1{\kbd1342,44305
-\def\indexdummyfont#1{\indexdummyfont1347,44461
-\def\indexdummytex{\indexdummytex1348,44487
-\def\indexdummydots{\indexdummydots1349,44511
-\def\indexnofonts{\indexnofonts1351,44537
-\let\w=\indexdummyfontdummyfont1352,44557
-\let\t=\indexdummyfontdummyfont1353,44580
-\let\r=\indexdummyfontdummyfont1354,44603
-\let\i=\indexdummyfontdummyfont1355,44626
-\let\b=\indexdummyfontdummyfont1356,44649
-\let\emph=\indexdummyfontdummyfont1357,44672
-\let\strong=\indexdummyfontdummyfont1358,44698
-\let\cite=\indexdummyfont=\indexdummyfont1359,44726
-\let\sc=\indexdummyfontdummyfont1360,44752
-\let\tclose=\indexdummyfontdummyfont1364,44924
-\let\code=\indexdummyfontdummyfont1365,44952
-\let\file=\indexdummyfontdummyfont1366,44978
-\let\samp=\indexdummyfontdummyfont1367,45004
-\let\kbd=\indexdummyfontdummyfont1368,45030
-\let\key=\indexdummyfontdummyfont1369,45055
-\let\var=\indexdummyfontdummyfont1370,45080
-\let\TeX=\indexdummytexdummytex1371,45105
-\let\dots=\indexdummydotsdummydots1372,45129
-\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45381
-\def\doind #1#2{\doind1384,45437
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45480
-\def\rawbackslashxx{\rawbackslashxx1389,45620
-{\indexnofontsnofonts1394,45882
-\def\dosubind #1#2#3{\dosubind1405,46193
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46241
-\def\rawbackslashxx{\rawbackslashxx1410,46345
-{\indexnofontsnofonts1414,46499
-\def\findex {\findex1443,47430
-\def\kindex {\kindex1444,47453
-\def\cindex {\cindex1445,47476
-\def\vindex {\vindex1446,47499
-\def\tindex {\tindex1447,47522
-\def\pindex {\pindex1448,47545
-\def\cindexsub {\cindexsub1450,47569
-\def\printindex{\printindex1462,47896
-\def\doprintindex#1{\doprintindex1464,47937
- \def\indexbackslash{\indexbackslash1481,48422
- \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48461
-\def\initial #1{\initial1517,49533
-\def\entry #1#2{\entry1523,49740
- \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50387
-\def\indexdotfill{\indexdotfill1549,50715
-\def\primary #1{\primary1552,50821
-\def\secondary #1#2{\secondary1556,50903
-\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50985
-\newbox\partialpageialpage1566,51158
-\def\begindoublecolumns{\begindoublecolumns1572,51316
- \output={\global\setbox\partialpage=ialpage=1573,51352
-\def\enddoublecolumns{\enddoublecolumns1577,51540
-\def\doublecolumnout{\doublecolumnout1580,51625
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51694
-\def\pagesofar{\pagesofar1584,51872
-\def\balancecolumns{\balancecolumns1588,52109
- \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52280
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52541
-\newcount \appendixno \appendixno = `\@no1627,53446
-\def\appendixletter{\appendixletter1628,53487
-\def\opencontents{\opencontents1632,53590
-\def\thischapter{\thischapter1637,53771
-\def\seccheck#1{\seccheck1638,53809
-\def\chapternofonts{\chapternofonts1643,53913
-\def\result{\result1646,53988
-\def\equiv{\equiv1647,54023
-\def\expansion{\expansion1648,54056
-\def\print{\print1649,54097
-\def\TeX{\TeX1650,54130
-\def\dots{\dots1651,54159
-\def\copyright{\copyright1652,54190
-\def\tt{\tt1653,54231
-\def\bf{\bf1654,54258
-\def\w{\w1655,54286
-\def\less{\less1656,54311
-\def\gtr{\gtr1657,54342
-\def\hat{\hat1658,54371
-\def\char{\char1659,54400
-\def\tclose##1{\tclose1660,54431
-\def\code##1{\code1661,54475
-\def\samp##1{\samp1662,54515
-\def\r##1{\r1663,54555
-\def\b##1{\b1664,54589
-\def\key##1{\key1665,54623
-\def\file##1{\file1666,54661
-\def\kbd##1{\kbd1667,54701
-\def\i##1{\i1669,54809
-\def\cite##1{\cite1670,54843
-\def\var##1{\var1671,54883
-\def\emph##1{\emph1672,54921
-\def\dfn##1{\dfn1673,54961
-\def\thischaptername{\thischaptername1676,55002
-\outer\def\chapter{\chapter1677,55041
-\def\chapterzzz #1{\chapterzzz1678,55082
-{\chapternofonts%nofonts%1687,55478
-\global\let\section = \numberedsec=1692,55631
-\global\let\subsection = \numberedsubsec=1693,55666
-\global\let\subsubsection = \numberedsubsubsec=1694,55707
-\outer\def\appendix{\appendix1697,55758
-\def\appendixzzz #1{\appendixzzz1698,55801
-\global\advance \appendixno by 1 \message{no1700,55878
-\chapmacro {#1}{Appendix \appendixletter}letter1701,55947
-\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56040
-{\chapternofonts%nofonts%1705,56112
- {#1}{Appendix \appendixletter}letter1707,56168
-\appendixnoderef %noderef1710,56268
-\global\let\section = \appendixsec=1711,56287
-\global\let\subsection = \appendixsubsec=1712,56322
-\global\let\subsubsection = \appendixsubsubsec=1713,56363
-\outer\def\top{\top1716,56414
-\outer\def\unnumbered{\unnumbered1717,56454
-\def\unnumberedzzz #1{\unnumberedzzz1718,56501
-{\chapternofonts%nofonts%1722,56664
-\global\let\section = \unnumberedsec=1727,56814
-\global\let\subsection = \unnumberedsubsec=1728,56851
-\global\let\subsubsection = \unnumberedsubsubsec=1729,56894
-\outer\def\numberedsec{\numberedsec1732,56947
-\def\seczzz #1{\seczzz1733,56988
-{\chapternofonts%nofonts%1736,57144
-\outer\def\appendixsection{\appendixsection1745,57330
-\outer\def\appendixsec{\appendixsec1746,57387
-\def\appendixsectionzzz #1{\appendixsectionzzz1747,57440
-\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57552
-{\chapternofonts%nofonts%1750,57620
-{#1}{\appendixletter}letter1752,57676
-\appendixnoderef %noderef1755,57776
-\outer\def\unnumberedsec{\unnumberedsec1759,57816
-\def\unnumberedseczzz #1{\unnumberedseczzz1760,57869
-{\chapternofonts%nofonts%1762,57964
-\outer\def\numberedsubsec{\numberedsubsec1770,58132
-\def\numberedsubseczzz #1{\numberedsubseczzz1771,58187
-{\chapternofonts%nofonts%1774,58366
-\outer\def\appendixsubsec{\appendixsubsec1783,58570
-\def\appendixsubseczzz #1{\appendixsubseczzz1784,58625
-\subsecheading {#1}{\appendixletter}letter1786,58747
-{\chapternofonts%nofonts%1787,58812
-{#1}{\appendixletter}letter1789,58871
-\appendixnoderef %noderef1792,58986
-\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59026
-\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59085
-{\chapternofonts%nofonts%1799,59186
-\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59357
-\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59418
-{\chapternofonts%nofonts%1812,59615
-\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59848
-\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59909
- {\appendixletter}letter1827,60048
-{\chapternofonts%nofonts%1828,60114
- {\appendixletter}letter1830,60179
-\appendixnoderef %noderef1834,60313
-\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60353
-\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60418
-{\chapternofonts%nofonts%1841,60525
-\def\infotop{\infotop1851,60854
-\def\infounnumbered{\infounnumbered1852,60892
-\def\infounnumberedsec{\infounnumberedsec1853,60937
-\def\infounnumberedsubsec{\infounnumberedsubsec1854,60988
-\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61045
-\def\infoappendix{\infoappendix1857,61109
-\def\infoappendixsec{\infoappendixsec1858,61150
-\def\infoappendixsubsec{\infoappendixsubsec1859,61197
-\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61250
-\def\infochapter{\infochapter1862,61310
-\def\infosection{\infosection1863,61349
-\def\infosubsection{\infosubsection1864,61388
-\def\infosubsubsection{\infosubsubsection1865,61433
-\global\let\section = \numberedsec=1870,61670
-\global\let\subsection = \numberedsubsec=1871,61705
-\global\let\subsubsection = \numberedsubsubsec=1872,61746
-\def\majorheading{\majorheading1886,62253
-\def\majorheadingzzz #1{\majorheadingzzz1887,62298
-\def\chapheading{\chapheading1893,62531
-\def\chapheadingzzz #1{\chapheadingzzz1894,62574
-\def\heading{\heading1899,62769
-\def\subheading{\subheading1901,62806
-\def\subsubheading{\subsubheading1903,62849
-\def\dobreak#1#2{\dobreak1910,63126
-\def\setchapterstyle #1 {\setchapterstyle1912,63204
-\def\chapbreak{\chapbreak1919,63459
-\def\chappager{\chappager1920,63509
-\def\chapoddpage{\chapoddpage1921,63547
-\def\setchapternewpage #1 {\setchapternewpage1923,63626
-\def\CHAPPAGoff{\CHAPPAGoff1925,63683
-\def\CHAPPAGon{\CHAPPAGon1929,63777
-\global\def\HEADINGSon{\HEADINGSon1932,63868
-\def\CHAPPAGodd{\CHAPPAGodd1934,63910
-\global\def\HEADINGSon{\HEADINGSon1937,64006
-\def\CHAPFplain{\CHAPFplain1941,64060
-\def\chfplain #1#2{\chfplain1945,64152
-\def\unnchfplain #1{\unnchfplain1956,64375
-\def\unnchfopen #1{\unnchfopen1964,64604
-\def\chfopen #1#2{\chfopen1970,64812
-\def\CHAPFopen{\CHAPFopen1975,64956
-\def\subsecheadingbreak{\subsecheadingbreak1982,65174
-\def\secheadingbreak{\secheadingbreak1985,65303
-\def\secheading #1#2#3{\secheading1993,65585
-\def\plainsecheading #1{\plainsecheading1994,65641
-\def\secheadingi #1{\secheadingi1995,65684
-\def\subsecheading #1#2#3#4{\subsecheading2006,66052
-\def\subsecheadingi #1{\subsecheadingi2007,66119
-\def\subsubsecfonts{\subsubsecfonts2014,66416
-\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66539
-\def\subsubsecheadingi #1{\subsubsecheadingi2018,66617
-\def\startcontents#1{\startcontents2032,67089
- \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67362
-\outer\def\contents{\contents2049,67721
-\outer\def\summarycontents{\summarycontents2057,67865
- \def\secentry ##1##2##3##4{\secentry2067,68236
- \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68271
- \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68306
- \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68347
- \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68385
- \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68432
-\def\chapentry#1#2#3{\chapentry2085,68866
-\def\shortchapentry#1#2#3{\shortchapentry2088,68983
- {#2\labelspace #1}space2091,69093
-\def\unnumbchapentry#1#2{\unnumbchapentry2094,69147
-\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69194
-\def\secentry#1#2#3#4{\secentry2102,69358
-\def\unnumbsecentry#1#2{\unnumbsecentry2103,69417
-\def\subsecentry#1#2#3#4#5{\subsecentry2106,69478
-\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69548
-\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69622
- \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69656
-\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69707
-\def\dochapentry#1#2{\dochapentry2123,70081
-\def\dosecentry#1#2{\dosecentry2138,70686
-\def\dosubsecentry#1#2{\dosubsecentry2145,70864
-\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71049
-\def\labelspace{\labelspace2160,71300
-\def\dopageno#1{\dopageno2162,71335
-\def\doshortpageno#1{\doshortpageno2163,71361
-\def\chapentryfonts{\chapentryfonts2165,71393
-\def\secentryfonts{\secentryfonts2166,71428
-\def\point{\point2192,72387
-\def\result{\result2194,72408
-\def\expansion{\expansion2195,72481
-\def\print{\print2196,72552
-\def\equiv{\equiv2198,72619
-\def\error{\error2218,73392
-\def\tex{\tex2224,73621
-\def\@{\@2242,74004
-\gdef\sepspaces{\def {\ }}}\2265,74736
-\def\aboveenvbreak{\aboveenvbreak2268,74818
-\def\afterenvbreak{\afterenvbreak2272,74984
-\def\ctl{\ctl2286,75495
-\def\ctr{\ctr2287,75567
-\def\cbl{\cbl2288,75606
-\def\cbr{\cbr2289,75646
-\def\carttop{\carttop2290,75685
-\def\cartbot{\cartbot2293,75793
-\long\def\cartouche{\cartouche2299,75933
-\def\Ecartouche{\Ecartouche2326,76721
-\def\lisp{\lisp2338,76856
-\def\Elisp{\Elisp2348,77203
-\def\next##1{\next2360,77529
-\def\Eexample{\Eexample2364,77571
-\def\Esmallexample{\Esmallexample2367,77618
-\def\smalllispx{\smalllispx2373,77796
-\def\Esmalllisp{\Esmalllisp2383,78150
-\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78506
-\def\next##1{\next2397,78563
-\def\display{\display2401,78643
-\def\Edisplay{\Edisplay2410,78962
-\def\next##1{\next2422,79273
-\def\format{\format2426,79376
-\def\Eformat{\Eformat2434,79672
-\def\next##1{\next2437,79761
-\def\flushleft{\flushleft2441,79813
-\def\Eflushleft{\Eflushleft2451,80184
-\def\next##1{\next2454,80277
-\def\flushright{\flushright2456,80299
-\def\Eflushright{\Eflushright2466,80671
-\def\next##1{\next2470,80802
-\def\quotation{\quotation2474,80860
-\def\Equotation{\Equotation2480,81052
-\def\setdeffont #1 {\setdeffont2493,81450
-\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81496
-\newskip\defargsindent \defargsindent=50ptargsindent2496,81539
-\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81582
-\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81625
-\def\activeparens{\activeparens2503,81823
-\def\opnr{\opnr2529,83035
-\def\lbrb{\lbrb2530,83100
-\def\defname #1#2{\defname2536,83301
-\advance\dimen2 by -\defbodyindentbodyindent2540,83419
-\advance\dimen3 by -\defbodyindentbodyindent2542,83473
-\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83527
-\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83669
-\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83744
-\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84113
-\advance\leftskip by -\defbodyindentbodyindent2557,84247
-\exdentamount=\defbodyindentbodyindent2558,84284
-\def\defparsebody #1#2#3{\defparsebody2568,84643
-\def#1{2572,84827
-\def#2{2573,84863
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84935
-\exdentamount=\defbodyindentbodyindent2576,85009
-\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85113
-\def#1{2585,85274
-\def#2##1 {2586,85310
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85393
-\exdentamount=\defbodyindentbodyindent2589,85467
-\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85552
-\def#1{2596,85713
-\def#2##1 ##2 {2597,85749
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85849
-\exdentamount=\defbodyindentbodyindent2601,85923
-\def\defvarparsebody #1#2#3{\defvarparsebody2608,86194
-\def#1{2612,86381
-\def#2{2613,86417
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86476
-\exdentamount=\defbodyindentbodyindent2616,86550
-\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86641
-\def#1{2625,86800
-\def#2##1 {2626,86836
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86906
-\exdentamount=\defbodyindentbodyindent2629,86980
-\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87052
-\def#1{2636,87216
-\def#2##1 ##2 {2637,87252
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87339
-\exdentamount=\defbodyindentbodyindent2641,87413
-\def\defunargs #1{\defunargs2664,88173
-\def\deftypefunargs #1{\deftypefunargs2676,88555
-\def\deffn{\deffn2690,88937
-\def\deffnheader #1#2#3{\deffnheader2692,88994
-\begingroup\defname {name2693,89042
-\def\defun{\defun2699,89187
-\def\defunheader #1#2{\defunheader2701,89240
-\begingroup\defname {name2702,89315
-\defunargs {unargs2703,89351
-\def\deftypefun{\deftypefun2709,89499
-\def\deftypefunheader #1#2{\deftypefunheader2712,89621
-\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89730
-\begingroup\defname {name2716,89822
-\deftypefunargs {typefunargs2717,89868
-\def\deftypefn{\deftypefn2723,90039
-\def\deftypefnheader #1#2#3{\deftypefnheader2726,90188
-\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90324
-\begingroup\defname {name2730,90417
-\deftypefunargs {typefunargs2731,90457
-\def\defmac{\defmac2737,90578
-\def\defmacheader #1#2{\defmacheader2739,90635
-\begingroup\defname {name2740,90711
-\defunargs {unargs2741,90744
-\def\defspec{\defspec2747,90868
-\def\defspecheader #1#2{\defspecheader2749,90929
-\begingroup\defname {name2750,91006
-\defunargs {unargs2751,91046
-\def\deffnx #1 {\deffnx2758,91241
-\def\defunx #1 {\defunx2759,91298
-\def\defmacx #1 {\defmacx2760,91355
-\def\defspecx #1 {\defspecx2761,91414
-\def\deftypefnx #1 {\deftypefnx2762,91475
-\def\deftypeunx #1 {\deftypeunx2763,91540
-\def\defop #1 {\defop2769,91686
-\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91721
-\def\defopheader #1#2#3{\defopheader2772,91775
-\begingroup\defname {name2774,91864
-\defunargs {unargs2775,91910
-\def\defmethod{\defmethod2780,91971
-\def\defmethodheader #1#2#3{\defmethodheader2782,92044
-\begingroup\defname {name2784,92132
-\defunargs {unargs2785,92172
-\def\defcv #1 {\defcv2790,92246
-\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92281
-\def\defcvarheader #1#2#3{\defcvarheader2793,92340
-\begingroup\defname {name2795,92426
-\defvarargs {varargs2796,92472
-\def\defivar{\defivar2801,92545
-\def\defivarheader #1#2#3{\defivarheader2803,92608
-\begingroup\defname {name2805,92694
-\defvarargs {varargs2806,92745
-\def\defopx #1 {\defopx2812,92894
-\def\defmethodx #1 {\defmethodx2813,92951
-\def\defcvx #1 {\defcvx2814,93016
-\def\defivarx #1 {\defivarx2815,93073
-\def\defvarargs #1{\defvarargs2822,93344
-\def\defvr{\defvr2828,93488
-\def\defvrheader #1#2#3{\defvrheader2830,93543
-\begingroup\defname {name2831,93591
-\def\defvar{\defvar2835,93676
-\def\defvarheader #1#2{\defvarheader2837,93736
-\begingroup\defname {name2838,93807
-\defvarargs {varargs2839,93843
-\def\defopt{\defopt2844,93909
-\def\defoptheader #1#2{\defoptheader2846,93969
-\begingroup\defname {name2847,94040
-\defvarargs {varargs2848,94079
-\def\deftypevar{\deftypevar2853,94136
-\def\deftypevarheader #1#2{\deftypevarheader2856,94252
-\begingroup\defname {name2858,94335
-\def\deftypevr{\deftypevr2865,94509
-\def\deftypevrheader #1#2#3{\deftypevrheader2867,94580
-\begingroup\defname {name2868,94632
-\def\defvrx #1 {\defvrx2876,94869
-\def\defvarx #1 {\defvarx2877,94926
-\def\defoptx #1 {\defoptx2878,94985
-\def\deftypevarx #1 {\deftypevarx2879,95044
-\def\deftypevrx #1 {\deftypevrx2880,95111
-\def\deftpargs #1{\deftpargs2885,95260
-\def\deftp{\deftp2889,95340
-\def\deftpheader #1#2#3{\deftpheader2891,95395
-\begingroup\defname {name2892,95443
-\def\deftpx #1 {\deftpx2897,95602
-\def\setref#1{\setref2908,95923
-\def\unnumbsetref#1{\unnumbsetref2913,96037
-\def\appendixsetref#1{\appendixsetref2918,96144
-\def\pxref#1{\pxref2929,96555
-\def\xref#1{\xref2930,96591
-\def\ref#1{\ref2931,96626
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96656
-\def\printedmanual{\printedmanual2933,96699
-\def\printednodename{\printednodename2934,96737
-\def\printednodename{\printednodename2939,96862
-section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97495
-\refx{x2957,97573
-\def\dosetq #1#2{\dosetq2965,97793
-\def\internalsetq #1#2{\internalsetq2973,98051
-\def\Ypagenumber{\Ypagenumber2977,98152
-\def\Ytitle{\Ytitle2979,98178
-\def\Ynothing{\Ynothing2981,98205
-\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98222
-\def\Yappendixletterandtype{\Yappendixletterandtype2992,98538
-\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98568
-\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98623
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98727
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98798
- \def\linenumber{\linenumber3009,99137
-\def\refx#1#2{\refx3015,99321
-\def\xrdef #1#2{\xrdef3037,99947
-\def\readauxfile{\readauxfile3040,100032
-\def\supereject{\supereject3110,101813
-\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102498
-\def\openindices{\openindices3139,102684
-\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102909
-\parindent = \defaultparindentaultparindent3152,102961
-\def\smallbook{\smallbook3175,103685
-\global\def\Esmallexample{\Esmallexample3192,104112
-\def\afourpaper{\afourpaper3196,104203
-\def\finalout{\finalout3224,105011
-\def\normaldoublequote{\normaldoublequote3235,105272
-\def\normaltilde{\normaltilde3236,105298
-\def\normalcaret{\normalcaret3237,105318
-\def\normalunderscore{\normalunderscore3238,105338
-\def\normalverticalbar{\normalverticalbar3239,105363
-\def\normalless{\normalless3240,105389
-\def\normalgreater{\normalgreater3241,105408
-\def\normalplus{\normalplus3242,105430
-\def\ifusingtt#1#2{\ifusingtt3253,105922
-\def\activedoublequote{\activedoublequote3261,106250
-\def~{~3264,106336
-\def^{^3267,106397
-\def_{_3270,106436
-\def\_{\_3272,106510
-\def\lvvmode{\lvvmode3279,106847
-\def|{|3282,106897
-\def<{<3285,106960
-\def>{>3288,107017
-\def+{+3290,107055
-\def\turnoffactive{\turnoffactive3296,107216
-\global\def={=3307,107502
-\def\normalbackslash{\normalbackslash3321,107884
+\def\itemfont{\itemfont1082,35890
+\def\Etable{\Etable1090,36116
+\def\itemize{\itemize1103,36440
+\def\itemizezzz #1{\itemizezzz1105,36476
+\def\itemizey #1#2{\itemizey1110,36571
+\def#2{1119,36817
+\def\itemcontents{\itemcontents1120,36858
+\def\bullet{\bullet1123,36906
+\def\minus{\minus1124,36933
+\def\frenchspacing{\frenchspacing1128,37041
+\def\splitoff#1#2\endmark{\splitoff1134,37266
+\def\enumerate{\enumerate1140,37496
+\def\enumeratezzz #1{\enumeratezzz1141,37535
+\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37588
+ \def\thearg{\thearg1146,37735
+ \ifx\thearg\empty \def\thearg{\thearg1147,37754
+\def\numericenumerate{\numericenumerate1184,39088
+\def\lowercaseenumerate{\lowercaseenumerate1190,39218
+\def\uppercaseenumerate{\uppercaseenumerate1203,39565
+\def\startenumeration#1{\startenumeration1219,40055
+\def\alphaenumerate{\alphaenumerate1227,40237
+\def\capsenumerate{\capsenumerate1228,40272
+\def\Ealphaenumerate{\Ealphaenumerate1229,40306
+\def\Ecapsenumerate{\Ecapsenumerate1230,40340
+\def\itemizeitem{\itemizeitem1234,40420
+\def\newindex #1{\newindex1259,41277
+\def\defindex{\defindex1268,41566
+\def\newcodeindex #1{\newcodeindex1272,41674
+\def\defcodeindex{\defcodeindex1279,41934
+\def\synindex #1 #2 {\synindex1283,42114
+\def\syncodeindex #1 #2 {\syncodeindex1292,42454
+\def\doindex#1{\doindex1309,43133
+\def\singleindexer #1{\singleindexer1310,43192
+\def\docodeindex#1{\docodeindex1313,43304
+\def\singlecodeindexer #1{\singlecodeindexer1314,43371
+\def\indexdummies{\indexdummies1316,43429
+\def\_{\_1317,43449
+\def\w{\w1318,43477
+\def\bf{\bf1319,43504
+\def\rm{\rm1320,43533
+\def\sl{\sl1321,43562
+\def\sf{\sf1322,43591
+\def\tt{\tt1323,43619
+\def\gtr{\gtr1324,43647
+\def\less{\less1325,43677
+\def\hat{\hat1326,43709
+\def\char{\char1327,43739
+\def\TeX{\TeX1328,43771
+\def\dots{\dots1329,43801
+\def\copyright{\copyright1330,43834
+\def\tclose##1{\tclose1331,43877
+\def\code##1{\code1332,43922
+\def\samp##1{\samp1333,43963
+\def\t##1{\t1334,44004
+\def\r##1{\r1335,44039
+\def\i##1{\i1336,44074
+\def\b##1{\b1337,44109
+\def\cite##1{\cite1338,44144
+\def\key##1{\key1339,44185
+\def\file##1{\file1340,44224
+\def\var##1{\var1341,44265
+\def\kbd##1{\kbd1342,44304
+\def\indexdummyfont#1{\indexdummyfont1347,44460
+\def\indexdummytex{\indexdummytex1348,44486
+\def\indexdummydots{\indexdummydots1349,44510
+\def\indexnofonts{\indexnofonts1351,44536
+\let\w=\indexdummyfontdummyfont1352,44556
+\let\t=\indexdummyfontdummyfont1353,44579
+\let\r=\indexdummyfontdummyfont1354,44602
+\let\i=\indexdummyfontdummyfont1355,44625
+\let\b=\indexdummyfontdummyfont1356,44648
+\let\emph=\indexdummyfontdummyfont1357,44671
+\let\strong=\indexdummyfontdummyfont1358,44697
+\let\cite=\indexdummyfont=\indexdummyfont1359,44725
+\let\sc=\indexdummyfontdummyfont1360,44751
+\let\tclose=\indexdummyfontdummyfont1364,44923
+\let\code=\indexdummyfontdummyfont1365,44951
+\let\file=\indexdummyfontdummyfont1366,44977
+\let\samp=\indexdummyfontdummyfont1367,45003
+\let\kbd=\indexdummyfontdummyfont1368,45029
+\let\key=\indexdummyfontdummyfont1369,45054
+\let\var=\indexdummyfontdummyfont1370,45079
+\let\TeX=\indexdummytexdummytex1371,45104
+\let\dots=\indexdummydotsdummydots1372,45128
+\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45380
+\def\doind #1#2{\doind1384,45436
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45479
+\def\rawbackslashxx{\rawbackslashxx1389,45619
+{\indexnofontsnofonts1394,45881
+\def\dosubind #1#2#3{\dosubind1405,46192
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46240
+\def\rawbackslashxx{\rawbackslashxx1410,46344
+{\indexnofontsnofonts1414,46498
+\def\findex {\findex1443,47429
+\def\kindex {\kindex1444,47452
+\def\cindex {\cindex1445,47475
+\def\vindex {\vindex1446,47498
+\def\tindex {\tindex1447,47521
+\def\pindex {\pindex1448,47544
+\def\cindexsub {\cindexsub1450,47568
+\def\printindex{\printindex1462,47895
+\def\doprintindex#1{\doprintindex1464,47936
+ \def\indexbackslash{\indexbackslash1481,48421
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48460
+\def\initial #1{\initial1517,49532
+\def\entry #1#2{\entry1523,49739
+ \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50386
+\def\indexdotfill{\indexdotfill1549,50714
+\def\primary #1{\primary1552,50820
+\def\secondary #1#2{\secondary1556,50902
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50984
+\newbox\partialpageialpage1566,51157
+\def\begindoublecolumns{\begindoublecolumns1572,51315
+ \output={\global\setbox\partialpage=ialpage=1573,51351
+\def\enddoublecolumns{\enddoublecolumns1577,51539
+\def\doublecolumnout{\doublecolumnout1580,51624
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51693
+\def\pagesofar{\pagesofar1584,51871
+\def\balancecolumns{\balancecolumns1588,52108
+ \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52279
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52540
+\newcount \appendixno \appendixno = `\@no1627,53445
+\def\appendixletter{\appendixletter1628,53486
+\def\opencontents{\opencontents1632,53589
+\def\thischapter{\thischapter1637,53770
+\def\seccheck#1{\seccheck1638,53808
+\def\chapternofonts{\chapternofonts1643,53912
+\def\result{\result1646,53987
+\def\equiv{\equiv1647,54022
+\def\expansion{\expansion1648,54055
+\def\print{\print1649,54096
+\def\TeX{\TeX1650,54129
+\def\dots{\dots1651,54158
+\def\copyright{\copyright1652,54189
+\def\tt{\tt1653,54230
+\def\bf{\bf1654,54257
+\def\w{\w1655,54285
+\def\less{\less1656,54310
+\def\gtr{\gtr1657,54341
+\def\hat{\hat1658,54370
+\def\char{\char1659,54399
+\def\tclose##1{\tclose1660,54430
+\def\code##1{\code1661,54474
+\def\samp##1{\samp1662,54514
+\def\r##1{\r1663,54554
+\def\b##1{\b1664,54588
+\def\key##1{\key1665,54622
+\def\file##1{\file1666,54660
+\def\kbd##1{\kbd1667,54700
+\def\i##1{\i1669,54808
+\def\cite##1{\cite1670,54842
+\def\var##1{\var1671,54882
+\def\emph##1{\emph1672,54920
+\def\dfn##1{\dfn1673,54960
+\def\thischaptername{\thischaptername1676,55001
+\outer\def\chapter{\chapter1677,55040
+\def\chapterzzz #1{\chapterzzz1678,55081
+{\chapternofonts%nofonts%1687,55477
+\global\let\section = \numberedsec=1692,55630
+\global\let\subsection = \numberedsubsec=1693,55665
+\global\let\subsubsection = \numberedsubsubsec=1694,55706
+\outer\def\appendix{\appendix1697,55757
+\def\appendixzzz #1{\appendixzzz1698,55800
+\global\advance \appendixno by 1 \message{no1700,55877
+\chapmacro {#1}{Appendix \appendixletter}letter1701,55946
+\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56039
+{\chapternofonts%nofonts%1705,56111
+ {#1}{Appendix \appendixletter}letter1707,56167
+\appendixnoderef %noderef1710,56267
+\global\let\section = \appendixsec=1711,56286
+\global\let\subsection = \appendixsubsec=1712,56321
+\global\let\subsubsection = \appendixsubsubsec=1713,56362
+\outer\def\top{\top1716,56413
+\outer\def\unnumbered{\unnumbered1717,56453
+\def\unnumberedzzz #1{\unnumberedzzz1718,56500
+{\chapternofonts%nofonts%1722,56663
+\global\let\section = \unnumberedsec=1727,56813
+\global\let\subsection = \unnumberedsubsec=1728,56850
+\global\let\subsubsection = \unnumberedsubsubsec=1729,56893
+\outer\def\numberedsec{\numberedsec1732,56946
+\def\seczzz #1{\seczzz1733,56987
+{\chapternofonts%nofonts%1736,57143
+\outer\def\appendixsection{\appendixsection1745,57329
+\outer\def\appendixsec{\appendixsec1746,57386
+\def\appendixsectionzzz #1{\appendixsectionzzz1747,57439
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57551
+{\chapternofonts%nofonts%1750,57619
+{#1}{\appendixletter}letter1752,57675
+\appendixnoderef %noderef1755,57775
+\outer\def\unnumberedsec{\unnumberedsec1759,57815
+\def\unnumberedseczzz #1{\unnumberedseczzz1760,57868
+{\chapternofonts%nofonts%1762,57963
+\outer\def\numberedsubsec{\numberedsubsec1770,58131
+\def\numberedsubseczzz #1{\numberedsubseczzz1771,58186
+{\chapternofonts%nofonts%1774,58365
+\outer\def\appendixsubsec{\appendixsubsec1783,58569
+\def\appendixsubseczzz #1{\appendixsubseczzz1784,58624
+\subsecheading {#1}{\appendixletter}letter1786,58746
+{\chapternofonts%nofonts%1787,58811
+{#1}{\appendixletter}letter1789,58870
+\appendixnoderef %noderef1792,58985
+\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59025
+\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59084
+{\chapternofonts%nofonts%1799,59185
+\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59356
+\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59417
+{\chapternofonts%nofonts%1812,59614
+\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59847
+\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59908
+ {\appendixletter}letter1827,60047
+{\chapternofonts%nofonts%1828,60113
+ {\appendixletter}letter1830,60178
+\appendixnoderef %noderef1834,60312
+\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60352
+\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60417
+{\chapternofonts%nofonts%1841,60524
+\def\infotop{\infotop1851,60853
+\def\infounnumbered{\infounnumbered1852,60891
+\def\infounnumberedsec{\infounnumberedsec1853,60936
+\def\infounnumberedsubsec{\infounnumberedsubsec1854,60987
+\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61044
+\def\infoappendix{\infoappendix1857,61108
+\def\infoappendixsec{\infoappendixsec1858,61149
+\def\infoappendixsubsec{\infoappendixsubsec1859,61196
+\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61249
+\def\infochapter{\infochapter1862,61309
+\def\infosection{\infosection1863,61348
+\def\infosubsection{\infosubsection1864,61387
+\def\infosubsubsection{\infosubsubsection1865,61432
+\global\let\section = \numberedsec=1870,61669
+\global\let\subsection = \numberedsubsec=1871,61704
+\global\let\subsubsection = \numberedsubsubsec=1872,61745
+\def\majorheading{\majorheading1886,62252
+\def\majorheadingzzz #1{\majorheadingzzz1887,62297
+\def\chapheading{\chapheading1893,62530
+\def\chapheadingzzz #1{\chapheadingzzz1894,62573
+\def\heading{\heading1899,62768
+\def\subheading{\subheading1901,62805
+\def\subsubheading{\subsubheading1903,62848
+\def\dobreak#1#2{\dobreak1910,63125
+\def\setchapterstyle #1 {\setchapterstyle1912,63203
+\def\chapbreak{\chapbreak1919,63458
+\def\chappager{\chappager1920,63508
+\def\chapoddpage{\chapoddpage1921,63546
+\def\setchapternewpage #1 {\setchapternewpage1923,63625
+\def\CHAPPAGoff{\CHAPPAGoff1925,63682
+\def\CHAPPAGon{\CHAPPAGon1929,63776
+\global\def\HEADINGSon{\HEADINGSon1932,63867
+\def\CHAPPAGodd{\CHAPPAGodd1934,63909
+\global\def\HEADINGSon{\HEADINGSon1937,64005
+\def\CHAPFplain{\CHAPFplain1941,64059
+\def\chfplain #1#2{\chfplain1945,64151
+\def\unnchfplain #1{\unnchfplain1956,64374
+\def\unnchfopen #1{\unnchfopen1964,64603
+\def\chfopen #1#2{\chfopen1970,64811
+\def\CHAPFopen{\CHAPFopen1975,64955
+\def\subsecheadingbreak{\subsecheadingbreak1982,65173
+\def\secheadingbreak{\secheadingbreak1985,65302
+\def\secheading #1#2#3{\secheading1993,65584
+\def\plainsecheading #1{\plainsecheading1994,65640
+\def\secheadingi #1{\secheadingi1995,65683
+\def\subsecheading #1#2#3#4{\subsecheading2006,66051
+\def\subsecheadingi #1{\subsecheadingi2007,66118
+\def\subsubsecfonts{\subsubsecfonts2014,66415
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66538
+\def\subsubsecheadingi #1{\subsubsecheadingi2018,66616
+\def\startcontents#1{\startcontents2032,67088
+ \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67361
+\outer\def\contents{\contents2049,67720
+\outer\def\summarycontents{\summarycontents2057,67864
+ \def\secentry ##1##2##3##4{\secentry2067,68235
+ \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68270
+ \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68305
+ \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68346
+ \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68384
+ \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68431
+\def\chapentry#1#2#3{\chapentry2085,68865
+\def\shortchapentry#1#2#3{\shortchapentry2088,68982
+ {#2\labelspace #1}space2091,69092
+\def\unnumbchapentry#1#2{\unnumbchapentry2094,69146
+\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69193
+\def\secentry#1#2#3#4{\secentry2102,69357
+\def\unnumbsecentry#1#2{\unnumbsecentry2103,69416
+\def\subsecentry#1#2#3#4#5{\subsecentry2106,69477
+\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69547
+\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69621
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69655
+\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69706
+\def\dochapentry#1#2{\dochapentry2123,70080
+\def\dosecentry#1#2{\dosecentry2138,70685
+\def\dosubsecentry#1#2{\dosubsecentry2145,70863
+\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71048
+\def\labelspace{\labelspace2160,71299
+\def\dopageno#1{\dopageno2162,71334
+\def\doshortpageno#1{\doshortpageno2163,71360
+\def\chapentryfonts{\chapentryfonts2165,71392
+\def\secentryfonts{\secentryfonts2166,71427
+\def\point{\point2192,72386
+\def\result{\result2194,72407
+\def\expansion{\expansion2195,72480
+\def\print{\print2196,72551
+\def\equiv{\equiv2198,72618
+\def\error{\error2218,73391
+\def\tex{\tex2224,73620
+\def\@{\@2242,74003
+\gdef\sepspaces{\def {\ }}}\2265,74735
+\def\aboveenvbreak{\aboveenvbreak2268,74817
+\def\afterenvbreak{\afterenvbreak2272,74983
+\def\ctl{\ctl2286,75494
+\def\ctr{\ctr2287,75566
+\def\cbl{\cbl2288,75605
+\def\cbr{\cbr2289,75645
+\def\carttop{\carttop2290,75684
+\def\cartbot{\cartbot2293,75792
+\long\def\cartouche{\cartouche2299,75932
+\def\Ecartouche{\Ecartouche2326,76720
+\def\lisp{\lisp2338,76855
+\def\Elisp{\Elisp2348,77202
+\def\next##1{\next2360,77528
+\def\Eexample{\Eexample2364,77570
+\def\Esmallexample{\Esmallexample2367,77617
+\def\smalllispx{\smalllispx2373,77795
+\def\Esmalllisp{\Esmalllisp2383,78149
+\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78505
+\def\next##1{\next2397,78562
+\def\display{\display2401,78642
+\def\Edisplay{\Edisplay2410,78961
+\def\next##1{\next2422,79272
+\def\format{\format2426,79375
+\def\Eformat{\Eformat2434,79671
+\def\next##1{\next2437,79760
+\def\flushleft{\flushleft2441,79812
+\def\Eflushleft{\Eflushleft2451,80183
+\def\next##1{\next2454,80276
+\def\flushright{\flushright2456,80298
+\def\Eflushright{\Eflushright2466,80670
+\def\next##1{\next2470,80801
+\def\quotation{\quotation2474,80859
+\def\Equotation{\Equotation2480,81051
+\def\setdeffont #1 {\setdeffont2493,81449
+\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81495
+\newskip\defargsindent \defargsindent=50ptargsindent2496,81538
+\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81581
+\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81624
+\def\activeparens{\activeparens2503,81822
+\def\opnr{\opnr2529,83034
+\def\lbrb{\lbrb2530,83099
+\def\defname #1#2{\defname2536,83300
+\advance\dimen2 by -\defbodyindentbodyindent2540,83418
+\advance\dimen3 by -\defbodyindentbodyindent2542,83472
+\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83526
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83668
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83743
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84112
+\advance\leftskip by -\defbodyindentbodyindent2557,84246
+\exdentamount=\defbodyindentbodyindent2558,84283
+\def\defparsebody #1#2#3{\defparsebody2568,84642
+\def#1{2572,84826
+\def#2{2573,84862
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84934
+\exdentamount=\defbodyindentbodyindent2576,85008
+\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85112
+\def#1{2585,85273
+\def#2##1 {2586,85309
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85392
+\exdentamount=\defbodyindentbodyindent2589,85466
+\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85551
+\def#1{2596,85712
+\def#2##1 ##2 {2597,85748
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85848
+\exdentamount=\defbodyindentbodyindent2601,85922
+\def\defvarparsebody #1#2#3{\defvarparsebody2608,86193
+\def#1{2612,86380
+\def#2{2613,86416
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86475
+\exdentamount=\defbodyindentbodyindent2616,86549
+\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86640
+\def#1{2625,86799
+\def#2##1 {2626,86835
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86905
+\exdentamount=\defbodyindentbodyindent2629,86979
+\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87051
+\def#1{2636,87215
+\def#2##1 ##2 {2637,87251
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87338
+\exdentamount=\defbodyindentbodyindent2641,87412
+\def\defunargs #1{\defunargs2664,88172
+\def\deftypefunargs #1{\deftypefunargs2676,88554
+\def\deffn{\deffn2690,88936
+\def\deffnheader #1#2#3{\deffnheader2692,88993
+\begingroup\defname {name2693,89041
+\def\defun{\defun2699,89186
+\def\defunheader #1#2{\defunheader2701,89239
+\begingroup\defname {name2702,89314
+\defunargs {unargs2703,89350
+\def\deftypefun{\deftypefun2709,89498
+\def\deftypefunheader #1#2{\deftypefunheader2712,89620
+\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89729
+\begingroup\defname {name2716,89821
+\deftypefunargs {typefunargs2717,89867
+\def\deftypefn{\deftypefn2723,90038
+\def\deftypefnheader #1#2#3{\deftypefnheader2726,90187
+\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90323
+\begingroup\defname {name2730,90416
+\deftypefunargs {typefunargs2731,90456
+\def\defmac{\defmac2737,90577
+\def\defmacheader #1#2{\defmacheader2739,90634
+\begingroup\defname {name2740,90710
+\defunargs {unargs2741,90743
+\def\defspec{\defspec2747,90867
+\def\defspecheader #1#2{\defspecheader2749,90928
+\begingroup\defname {name2750,91005
+\defunargs {unargs2751,91045
+\def\deffnx #1 {\deffnx2758,91240
+\def\defunx #1 {\defunx2759,91297
+\def\defmacx #1 {\defmacx2760,91354
+\def\defspecx #1 {\defspecx2761,91413
+\def\deftypefnx #1 {\deftypefnx2762,91474
+\def\deftypeunx #1 {\deftypeunx2763,91539
+\def\defop #1 {\defop2769,91685
+\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91720
+\def\defopheader #1#2#3{\defopheader2772,91774
+\begingroup\defname {name2774,91863
+\defunargs {unargs2775,91909
+\def\defmethod{\defmethod2780,91970
+\def\defmethodheader #1#2#3{\defmethodheader2782,92043
+\begingroup\defname {name2784,92131
+\defunargs {unargs2785,92171
+\def\defcv #1 {\defcv2790,92245
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92280
+\def\defcvarheader #1#2#3{\defcvarheader2793,92339
+\begingroup\defname {name2795,92425
+\defvarargs {varargs2796,92471
+\def\defivar{\defivar2801,92544
+\def\defivarheader #1#2#3{\defivarheader2803,92607
+\begingroup\defname {name2805,92693
+\defvarargs {varargs2806,92744
+\def\defopx #1 {\defopx2812,92893
+\def\defmethodx #1 {\defmethodx2813,92950
+\def\defcvx #1 {\defcvx2814,93015
+\def\defivarx #1 {\defivarx2815,93072
+\def\defvarargs #1{\defvarargs2822,93343
+\def\defvr{\defvr2828,93487
+\def\defvrheader #1#2#3{\defvrheader2830,93542
+\begingroup\defname {name2831,93590
+\def\defvar{\defvar2835,93675
+\def\defvarheader #1#2{\defvarheader2837,93735
+\begingroup\defname {name2838,93806
+\defvarargs {varargs2839,93842
+\def\defopt{\defopt2844,93908
+\def\defoptheader #1#2{\defoptheader2846,93968
+\begingroup\defname {name2847,94039
+\defvarargs {varargs2848,94078
+\def\deftypevar{\deftypevar2853,94135
+\def\deftypevarheader #1#2{\deftypevarheader2856,94251
+\begingroup\defname {name2858,94334
+\def\deftypevr{\deftypevr2865,94508
+\def\deftypevrheader #1#2#3{\deftypevrheader2867,94579
+\begingroup\defname {name2868,94631
+\def\defvrx #1 {\defvrx2876,94868
+\def\defvarx #1 {\defvarx2877,94925
+\def\defoptx #1 {\defoptx2878,94984
+\def\deftypevarx #1 {\deftypevarx2879,95043
+\def\deftypevrx #1 {\deftypevrx2880,95110
+\def\deftpargs #1{\deftpargs2885,95259
+\def\deftp{\deftp2889,95339
+\def\deftpheader #1#2#3{\deftpheader2891,95394
+\begingroup\defname {name2892,95442
+\def\deftpx #1 {\deftpx2897,95601
+\def\setref#1{\setref2908,95922
+\def\unnumbsetref#1{\unnumbsetref2913,96036
+\def\appendixsetref#1{\appendixsetref2918,96143
+\def\pxref#1{\pxref2929,96554
+\def\xref#1{\xref2930,96590
+\def\ref#1{\ref2931,96625
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96655
+\def\printedmanual{\printedmanual2933,96698
+\def\printednodename{\printednodename2934,96736
+\def\printednodename{\printednodename2939,96861
+section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97493
+\refx{x2957,97571
+\def\dosetq #1#2{\dosetq2965,97791
+\def\internalsetq #1#2{\internalsetq2973,98049
+\def\Ypagenumber{\Ypagenumber2977,98150
+\def\Ytitle{\Ytitle2979,98176
+\def\Ynothing{\Ynothing2981,98203
+\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98220
+\def\Yappendixletterandtype{\Yappendixletterandtype2992,98536
+\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98566
+\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98621
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98725
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98796
+ \def\linenumber{\linenumber3009,99135
+\def\refx#1#2{\refx3015,99319
+\def\xrdef #1#2{\xrdef3037,99945
+\def\readauxfile{\readauxfile3040,100030
+\def\supereject{\supereject3110,101811
+\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102496
+\def\openindices{\openindices3139,102682
+\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102907
+\parindent = \defaultparindentaultparindent3152,102959
+\def\smallbook{\smallbook3175,103683
+\global\def\Esmallexample{\Esmallexample3192,104110
+\def\afourpaper{\afourpaper3196,104201
+\def\finalout{\finalout3224,105009
+\def\normaldoublequote{\normaldoublequote3235,105270
+\def\normaltilde{\normaltilde3236,105296
+\def\normalcaret{\normalcaret3237,105316
+\def\normalunderscore{\normalunderscore3238,105336
+\def\normalverticalbar{\normalverticalbar3239,105361
+\def\normalless{\normalless3240,105387
+\def\normalgreater{\normalgreater3241,105406
+\def\normalplus{\normalplus3242,105428
+\def\ifusingtt#1#2{\ifusingtt3253,105920
+\def\activedoublequote{\activedoublequote3261,106248
+\def~{~3264,106334
+\def^{^3267,106395
+\def_{_3270,106434
+\def\_{\_3272,106508
+\def\lvvmode{\lvvmode3279,106845
+\def|{|3282,106895
+\def<{<3285,106958
+\def>{>3288,107015
+\def+{+3290,107053
+\def\turnoffactive{\turnoffactive3296,107214
+\global\def={=3307,107500
+\def\normalbackslash{\normalbackslash3321,107882
+
+merc-src/accumulator.m,4915
+:- interface146,5371
+:- import_module hlds148,5386
+:- import_module univ152,5478
+:- pred accu_transform_proc159,5793
+:- implementation166,6115
+:- import_module libs180,6552
+:- import_module mdbcomp184,6681
+:- import_module parse_tree186,6742
+:- import_module assoc_list194,7013
+:- import_module bool195,7042
+:- import_module int196,7065
+:- import_module io197,7087
+:- import_module list198,7108
+:- import_module map199,7131
+:- import_module maybe200,7153
+:- import_module pair201,7177
+:- import_module require202,7200
+:- import_module set203,7226
+:- import_module solutions204,7248
+:- import_module string205,7276
+:- import_module term206,7301
+:- import_module varset207,7324
+:- type top_level213,7499
+:- type accu_goal_id225,7900
+:- type accu_case228,7964
+:- type accu_goal_store234,8091
+:- type accu_subst238,8216
+:- type accu_warning240,8264
+accu_transform_proc247,8578
+:- pred generate_warnings334,12550
+generate_warnings337,12669
+:- pred generate_warning342,12895
+generate_warning345,13001
+:- pred should_attempt_accu_transform365,13886
+should_attempt_accu_transform370,14123
+:- pred should_attempt_accu_transform_2398,15406
+should_attempt_accu_transform_2405,15763
+:- pred accu_standardize440,17390
+accu_standardize442,17455
+:- pred identify_goal_type465,18169
+identify_goal_type469,18359
+:- pred is_recursive_case549,21175
+is_recursive_case551,21253
+:- type store_info560,21713
+:- func initialize_goal_store570,22060
+initialize_goal_store573,22166
+:- pred accu_store580,22421
+accu_store584,22576
+:- pred identify_recursive_calls601,23288
+identify_recursive_calls604,23406
+:- pred identify_out_and_out_prime626,24396
+identify_out_and_out_prime631,24631
+:- type accu_sets676,26425
+:- pred accu_stage1689,26977
+accu_stage1693,27155
+:- pred accu_stage1_2727,28347
+accu_stage1_2731,28515
+:- pred accu_sets_init781,30557
+accu_sets_init783,30605
+:- func set_upto796,30984
+set_upto798,31039
+:- pred accu_before812,31498
+accu_before815,31639
+:- pred accu_assoc835,32477
+accu_assoc838,32617
+:- pred accu_construct862,33712
+accu_construct865,33856
+:- pred accu_construct_assoc896,35307
+accu_construct_assoc899,35457
+:- pred accu_update938,37069
+accu_update941,37210
+:- pred member_lessthan_goalid964,38219
+member_lessthan_goalid967,38342
+:- type accu_assoc975,38652
+:- pred accu_is_associative986,39138
+accu_is_associative989,39250
+:- pred associativity_assertion1014,40263
+associativity_assertion1017,40404
+:- pred commutativity_assertion1037,41242
+commutativity_assertion1040,41369
+:- pred accu_is_update1057,41952
+accu_is_update1060,42066
+:- pred is_associative_construction1078,42802
+is_associative_construction1081,42898
+:- type accu_substs1095,43480
+:- type accu_base1103,43744
+:- pred accu_stage21124,44605
+accu_stage21131,44946
+:- pred accu_substs_init1179,46957
+accu_substs_init1182,47097
+:- pred acc_var_subst_init1194,47573
+acc_var_subst_init1198,47718
+:- pred create_new_var1207,48147
+create_new_var1210,48288
+:- pred accu_process_assoc_set1223,48862
+accu_process_assoc_set1229,49150
+:- pred accu_has_heuristic1297,52081
+accu_has_heuristic1299,52161
+:- pred accu_heuristic1304,52336
+accu_heuristic1307,52457
+:- pred accu_process_update_set1318,52906
+accu_process_update_set1325,53221
+:- pred accu_divide_base_case1380,55844
+accu_divide_base_case1385,56059
+:- pred accu_related1412,57146
+accu_related1415,57270
+:- inst stored_goal_plain_call1444,58415
+:- pred lookup_call1449,58601
+lookup_call1452,58715
+:- pred accu_stage31470,59432
+accu_stage31477,59826
+:- pred acc_proc_info1508,61326
+acc_proc_info1512,61485
+:- pred acc_pred_info1556,63449
+acc_pred_info1559,63597
+:- pred accu_create_goal1600,65285
+accu_create_goal1607,65628
+:- func create_acc_call1621,66400
+create_acc_call1625,66569
+:- pred create_orig_goal1634,66987
+create_orig_goal1638,67176
+:- pred create_acc_goal1662,68157
+create_acc_goal1667,68380
+:- func create_new_orig_recursive_goals1709,70225
+create_new_orig_recursive_goals1712,70368
+:- func create_new_recursive_goals1723,70918
+create_new_recursive_goals1727,71108
+:- func create_new_base_goals1738,71717
+create_new_base_goals1741,71831
+:- pred acc_unification1749,72156
+acc_unification1751,72225
+:- pred accu_top_level1766,72896
+accu_top_level1770,73058
+:- pred update_accumulator_pred1856,76290
+update_accumulator_pred1859,76411
+:- func accu_rename1876,77253
+accu_rename1879,77363
+:- func base_case_ids1889,77784
+base_case_ids1891,77846
+:- func base_case_ids_set1898,78048
+base_case_ids_set1900,78113
+:- func accu_goal_list1905,78269
+accu_goal_list1907,78349
+:- pred calculate_goal_info1916,78680
+calculate_goal_info1918,78753
+:- func chain_subst1932,79319
+chain_subst1934,79378
+:- pred chain_subst_21938,79482
+chain_subst_21941,79576
+:- some [T] pred unravel_univ1956,80060
+:- pragma foreign_export1957,80116
+unravel_univ1961,80340
c-src/c.c,76
T f(1,0
@@ -4574,13 +4731,13 @@ extern struct node *yylval;yylval306,6246
unsigned char parse_cell_or_range 309,6291
unsigned char parse_cell_or_range 311,6355
yylex FUN0(315,6405
-parse_cell_or_range FUN2(587,11771
-#define CK_ABS_R(671,13213
-#define CK_REL_R(675,13292
-#define CK_ABS_C(680,13421
-#define CK_REL_C(684,13500
-#define MAYBEREL(689,13629
-str_to_col FUN1(847,16830
+parse_cell_or_range FUN2(587,11772
+#define CK_ABS_R(671,13214
+#define CK_REL_R(675,13293
+#define CK_ABS_C(680,13422
+#define CK_REL_C(684,13501
+#define MAYBEREL(689,13630
+str_to_col FUN1(847,16831
y-src/parse.c,520
#define YYBISON 4,64
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index 40be768aacb..36edc389617 100644
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -175,7 +175,7 @@ package body Truc.Bidule Truc.Bidule/b138,2153
protected body Bidule Bidule/b139,2181
protected body Machin_T Machin_T/b146,2281
-c-src/abbrev.c,2072
+c-src/abbrev.c,1957
Lisp_Object Vabbrev_table_name_list;43,1429
Lisp_Object Vglobal_abbrev_table;48,1574
Lisp_Object Vfundamental_mode_abbrev_table;52,1685
@@ -186,33 +186,31 @@ Lisp_Object Vabbrev_start_location_buffer;66,2046
Lisp_Object Vlast_abbrev;70,2155
Lisp_Object Vlast_abbrev_text;75,2324
int last_abbrev_point;79,2414
-Lisp_Object Vpre_abbrev_expand_hook,83,2487
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;83,2487
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,85,2551
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table85,2551
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,92,2743
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table92,2743
-DEFUN ("define-abbrev", Fdefine_abbrev,107,3124
-DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev107,3124
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,149,4443
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev149,4443
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,160,4814
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev160,4814
-DEFUN ("abbrev-symbol", Fabbrev_symbol,174,5282
-DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol174,5282
-DEFUN ("abbrev-expansion", Fabbrev_expansion,202,6246
-DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion202,6246
-DEFUN ("expand-abbrev", Fexpand_abbrev,218,6761
-DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev218,6761
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,389,11682
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev389,11682
-write_abbrev 426,12889
-describe_abbrev 445,13324
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,466,13839
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description466,13839
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,506,14995
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table506,14995
-syms_of_abbrev 540,16072
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,82,2440
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table82,2440
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,89,2632
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table89,2632
+DEFUN ("define-abbrev", Fdefine_abbrev,104,3013
+DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev104,3013
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,146,4332
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev146,4332
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,157,4703
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev157,4703
+DEFUN ("abbrev-symbol", Fabbrev_symbol,171,5171
+DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol171,5171
+DEFUN ("abbrev-expansion", Fabbrev_expansion,199,6135
+DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion199,6135
+DEFUN ("expand-abbrev", Fexpand_abbrev,215,6650
+DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev215,6650
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,383,11495
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev383,11495
+write_abbrev 420,12702
+describe_abbrev 439,13137
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,460,13652
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description460,13652
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,500,14808
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table500,14808
+syms_of_abbrev 534,15885
c-src/torture.c,197
(*tag1 tag118,452
@@ -1155,165 +1153,165 @@ make_lispy_position 5228,157391
toolkit_menubar_in_use 5456,163954
make_scroll_bar_position 5469,164322
make_lispy_event 5485,164968
-make_lispy_movement 6104,183532
-make_lispy_switch_frame 6131,184263
-make_lispy_focus_in 6137,184370
-make_lispy_focus_out 6145,184496
-parse_modifiers_uncached 6163,184946
-#define SINGLE_LETTER_MOD(6185,185466
-#undef SINGLE_LETTER_MOD6212,185907
-#define MULTI_LETTER_MOD(6214,185933
-#undef MULTI_LETTER_MOD6231,186401
-apply_modifiers_uncached 6273,187575
-static const char *const modifier_names[modifier_names6319,189194
-#define NUM_MOD_NAMES 6325,189400
-static Lisp_Object modifier_symbols;6327,189450
-lispy_modifier_list 6331,189587
-#define KEY_TO_CHAR(6353,190253
-parse_modifiers 6356,190329
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191518
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191518
-apply_modifiers 6422,192392
-reorder_modifiers 6491,194721
-modify_event_symbol 6536,196529
-DEFUN ("event-convert-list", Fevent_convert_list,6628,199245
-DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199245
-parse_solitary_modifier 6695,201136
-#define SINGLE_LETTER_MOD(6701,201259
-#define MULTI_LETTER_MOD(6705,201344
-#undef SINGLE_LETTER_MOD6763,202642
-#undef MULTI_LETTER_MOD6764,202667
-lucid_event_type_list_p 6775,202890
-get_input_pending 6814,203961
-record_asynch_buffer_change 6834,204580
-gobble_input 6872,205703
-tty_read_avail_input 6967,208311
-handle_async_input 7149,214040
-process_pending_signals 7165,214360
-unblock_input_to 7177,214646
-unblock_input 7200,215278
-totally_unblock_input 7209,215446
-handle_input_available_signal 7217,215530
-deliver_input_available_signal 7226,215701
-struct user_signal_info7235,215866
- int sig;7238,215916
- char *name;name7241,215957
- int npending;7244,216008
- struct user_signal_info *next;next7246,216025
-static struct user_signal_info *user_signals user_signals7250,216091
-add_user_signal 7253,216150
-handle_user_signal 7275,216599
-deliver_user_signal 7316,217559
-find_user_signal_name 7322,217660
-store_user_signal_events 7334,217842
-static Lisp_Object menu_bar_one_keymap_changed_items;7363,218417
-static Lisp_Object menu_bar_items_vector;7368,218631
-static int menu_bar_items_index;7369,218673
-static const char *separator_names[separator_names7372,218708
-menu_separator_name_p 7393,219149
-menu_bar_items 7426,219853
-Lisp_Object item_properties;7568,224604
-menu_bar_item 7571,224646
-menu_item_eval_property_1 7647,227176
-eval_dyn 7658,227466
-menu_item_eval_property 7666,227676
-parse_menu_item 7686,228342
-static Lisp_Object tool_bar_items_vector;7965,236337
-static Lisp_Object tool_bar_item_properties;7970,236511
-static int ntool_bar_items;7974,236607
-tool_bar_items 7990,237084
-process_tool_bar_item 8075,239893
-#define PROP(8112,240970
-set_prop 8114,241039
-parse_tool_bar_item 8167,242454
-#undef PROP8379,248845
-init_tool_bar_items 8387,248970
-append_tool_bar_item 8401,249262
-read_char_x_menu_prompt 8443,250772
-read_char_minibuf_menu_prompt 8503,252446
-#define PUSH_C_STR(8527,253015
-follow_key 8726,258554
-active_maps 8733,258696
-typedef struct keyremap8742,259022
- Lisp_Object parent;8745,259108
- Lisp_Object map;8748,259225
- int start,8753,259447
- int start, end;8753,259447
-} keyremap;8754,259465
-access_keymap_keyremap 8764,259809
-keyremap_step 8811,261451
-test_undefined 8867,262935
-read_key_sequence 8916,264862
-read_key_sequence_vs 9826,295822
-DEFUN ("read-key-sequence", Fread_key_sequence,9885,297295
-DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297295
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299983
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299983
-detect_input_pending 9950,300489
-detect_input_pending_ignore_squeezables 9959,300655
-detect_input_pending_run_timers 9967,300871
-clear_input_pending 9985,301363
-requeued_events_pending_p 9997,301733
-DEFUN ("input-pending-p", Finput_pending_p,10002,301814
-DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301814
-DEFUN ("recent-keys", Frecent_keys,10024,302597
-DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302597
-DEFUN ("this-command-keys", Fthis_command_keys,10055,303518
-DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303518
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303959
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303959
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304381
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304381
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304956
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304956
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305496
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305496
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306511
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306511
-DEFUN ("recursion-depth", Frecursion_depth,10158,307070
-DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307070
-DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307407
-DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307407
-DEFUN ("discard-input", Fdiscard_input,10203,308448
-DEFUN ("discard-input", Fdiscard_input,discard-input10203,308448
-DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308950
-DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308950
-stuff_buffered_input 10285,311046
-set_waiting_for_input 10323,312017
-clear_waiting_for_input 10337,312391
-handle_interrupt_signal 10351,312755
-deliver_interrupt_signal 10378,313643
-static int volatile force_quit_count;10387,313933
-handle_interrupt 10401,314415
-quit_throw_to_read_char 10541,318712
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319289
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319289
-DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320517
-DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320517
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321433
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321433
-DEFUN ("set-quit-char", Fset_quit_char,10694,322707
-DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322707
-DEFUN ("set-input-mode", Fset_input_mode,10729,323571
-DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323571
-DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324460
-DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324460
-DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325838
-DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325838
-DEFUN ("posn-at-point", Fposn_at_point,10824,327061
-DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327061
-init_kboard 10861,328215
-allocate_kboard 10893,329285
-wipe_kboard 10909,329638
-delete_kboard 10917,329752
-init_keyboard 10942,330282
-struct event_head11021,332697
- short var;11023,332717
- short kind;11024,332730
-static const struct event_head head_table[head_table11027,332748
-syms_of_keyboard 11045,333578
-keys_of_keyboard 11841,367116
-mark_kboards 11916,370435
+make_lispy_movement 6104,183531
+make_lispy_switch_frame 6131,184262
+make_lispy_focus_in 6137,184369
+make_lispy_focus_out 6145,184495
+parse_modifiers_uncached 6163,184945
+#define SINGLE_LETTER_MOD(6185,185465
+#undef SINGLE_LETTER_MOD6212,185906
+#define MULTI_LETTER_MOD(6214,185932
+#undef MULTI_LETTER_MOD6231,186400
+apply_modifiers_uncached 6273,187574
+static const char *const modifier_names[modifier_names6319,189193
+#define NUM_MOD_NAMES 6325,189399
+static Lisp_Object modifier_symbols;6327,189449
+lispy_modifier_list 6331,189586
+#define KEY_TO_CHAR(6353,190252
+parse_modifiers 6356,190328
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191517
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191517
+apply_modifiers 6422,192391
+reorder_modifiers 6491,194720
+modify_event_symbol 6536,196528
+DEFUN ("event-convert-list", Fevent_convert_list,6628,199244
+DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199244
+parse_solitary_modifier 6695,201135
+#define SINGLE_LETTER_MOD(6701,201258
+#define MULTI_LETTER_MOD(6705,201343
+#undef SINGLE_LETTER_MOD6763,202641
+#undef MULTI_LETTER_MOD6764,202666
+lucid_event_type_list_p 6775,202889
+get_input_pending 6814,203960
+record_asynch_buffer_change 6834,204579
+gobble_input 6872,205702
+tty_read_avail_input 6967,208310
+handle_async_input 7149,214039
+process_pending_signals 7165,214359
+unblock_input_to 7177,214645
+unblock_input 7200,215277
+totally_unblock_input 7209,215445
+handle_input_available_signal 7217,215529
+deliver_input_available_signal 7226,215700
+struct user_signal_info7235,215865
+ int sig;7238,215915
+ char *name;name7241,215956
+ int npending;7244,216007
+ struct user_signal_info *next;next7246,216024
+static struct user_signal_info *user_signals user_signals7250,216090
+add_user_signal 7253,216149
+handle_user_signal 7275,216598
+deliver_user_signal 7316,217558
+find_user_signal_name 7322,217659
+store_user_signal_events 7334,217841
+static Lisp_Object menu_bar_one_keymap_changed_items;7363,218416
+static Lisp_Object menu_bar_items_vector;7368,218630
+static int menu_bar_items_index;7369,218672
+static const char *separator_names[separator_names7372,218707
+menu_separator_name_p 7393,219148
+menu_bar_items 7426,219852
+Lisp_Object item_properties;7568,224603
+menu_bar_item 7571,224645
+menu_item_eval_property_1 7647,227175
+eval_dyn 7658,227465
+menu_item_eval_property 7666,227675
+parse_menu_item 7686,228341
+static Lisp_Object tool_bar_items_vector;7965,236336
+static Lisp_Object tool_bar_item_properties;7970,236510
+static int ntool_bar_items;7974,236606
+tool_bar_items 7990,237083
+process_tool_bar_item 8075,239892
+#define PROP(8112,240969
+set_prop 8114,241038
+parse_tool_bar_item 8167,242453
+#undef PROP8379,248844
+init_tool_bar_items 8387,248969
+append_tool_bar_item 8401,249261
+read_char_x_menu_prompt 8443,250771
+read_char_minibuf_menu_prompt 8503,252445
+#define PUSH_C_STR(8527,253014
+follow_key 8726,258553
+active_maps 8733,258695
+typedef struct keyremap8742,259021
+ Lisp_Object parent;8745,259107
+ Lisp_Object map;8748,259224
+ int start,8753,259446
+ int start, end;8753,259446
+} keyremap;8754,259464
+access_keymap_keyremap 8764,259808
+keyremap_step 8811,261450
+test_undefined 8867,262934
+read_key_sequence 8916,264861
+read_key_sequence_vs 9826,295821
+DEFUN ("read-key-sequence", Fread_key_sequence,9885,297294
+DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297294
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299982
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299982
+detect_input_pending 9950,300488
+detect_input_pending_ignore_squeezables 9959,300654
+detect_input_pending_run_timers 9967,300870
+clear_input_pending 9985,301362
+requeued_events_pending_p 9997,301732
+DEFUN ("input-pending-p", Finput_pending_p,10002,301813
+DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301813
+DEFUN ("recent-keys", Frecent_keys,10024,302596
+DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302596
+DEFUN ("this-command-keys", Fthis_command_keys,10055,303517
+DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303517
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303958
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303958
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304380
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304380
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304955
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304955
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305495
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305495
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306510
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306510
+DEFUN ("recursion-depth", Frecursion_depth,10158,307069
+DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307069
+DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307406
+DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307406
+DEFUN ("discard-input", Fdiscard_input,10203,308447
+DEFUN ("discard-input", Fdiscard_input,discard-input10203,308447
+DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308949
+DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308949
+stuff_buffered_input 10285,311045
+set_waiting_for_input 10323,312016
+clear_waiting_for_input 10337,312390
+handle_interrupt_signal 10351,312754
+deliver_interrupt_signal 10378,313642
+static int volatile force_quit_count;10387,313932
+handle_interrupt 10401,314414
+quit_throw_to_read_char 10541,318711
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319288
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319288
+DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320516
+DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320516
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321432
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321432
+DEFUN ("set-quit-char", Fset_quit_char,10694,322706
+DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322706
+DEFUN ("set-input-mode", Fset_input_mode,10729,323570
+DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323570
+DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324459
+DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324459
+DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325837
+DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325837
+DEFUN ("posn-at-point", Fposn_at_point,10824,327060
+DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327060
+init_kboard 10861,328214
+allocate_kboard 10893,329284
+wipe_kboard 10909,329637
+delete_kboard 10917,329751
+init_keyboard 10942,330281
+struct event_head11021,332696
+ short var;11023,332716
+ short kind;11024,332729
+static const struct event_head head_table[head_table11027,332747
+syms_of_keyboard 11045,333577
+keys_of_keyboard 11841,367115
+mark_kboards 11916,370434
c-src/emacs/src/lisp.h,27827
#define EMACS_LISP_H22,801
@@ -2520,11 +2518,11 @@ main(37,571
D(43,659
int x;44,694
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1035
@@ -3313,22 +3311,22 @@ ord_add_element(71,1867
ord_del_element(85,2344
ord_disjoint(100,2783
ord_intersect(108,2953
-ord_intersection(126,3552
-ord_intersection3(130,3691
-ord_intersection(150,4531
-ord_intersection4(154,4703
-ord_intersection(176,5664
-ord_intersection2(181,5812
-ord_member(200,6318
-ord_seteq(216,6683
-ord_setproduct(225,6971
-ord_subset(240,7377
-ord_subtract(257,7861
-ord_symdiff(265,8054
-ord_union(288,8887
-ord_union4(303,9352
-ord_union(324,10171
-ord_union_all(329,10313
+ord_intersection(126,3553
+ord_intersection3(130,3692
+ord_intersection(150,4533
+ord_intersection4(154,4705
+ord_intersection(176,5666
+ord_intersection2(181,5814
+ord_member(200,6320
+ord_seteq(216,6685
+ord_setproduct(225,6973
+ord_subset(240,7379
+ord_subtract(257,7863
+ord_symdiff(265,8056
+ord_union(288,8889
+ord_union4(303,9354
+ord_union(324,10173
+ord_union_all(329,10315
prol-src/natded.prolog,2319
expandmng(100,2879
@@ -3543,6 +3541,11 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+rs-src/test.rs,52
+enum IpAddrKind 3,11
+fn test1(8,48
+fn main(12,88
+
scm-src/test.scm,260
(define hello 1,0
(set! hello 3,32
@@ -3757,533 +3760,628 @@ tex-src/texinfo.tex,30627
\def\vritemindex #1{\vritemindex1068,35482
\def\tablez #1#2#3#4#5#6{\tablez1074,35631
\def\Edescription{\Edescription1077,35689
-\def\itemfont{\itemfont1082,35891
-\def\Etable{\Etable1090,36117
-\def\itemize{\itemize1103,36441
-\def\itemizezzz #1{\itemizezzz1105,36477
-\def\itemizey #1#2{\itemizey1110,36572
-\def#2{1119,36818
-\def\itemcontents{\itemcontents1120,36859
-\def\bullet{\bullet1123,36907
-\def\minus{\minus1124,36934
-\def\frenchspacing{\frenchspacing1128,37042
-\def\splitoff#1#2\endmark{\splitoff1134,37267
-\def\enumerate{\enumerate1140,37497
-\def\enumeratezzz #1{\enumeratezzz1141,37536
-\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37589
- \def\thearg{\thearg1146,37736
- \ifx\thearg\empty \def\thearg{\thearg1147,37755
-\def\numericenumerate{\numericenumerate1184,39089
-\def\lowercaseenumerate{\lowercaseenumerate1190,39219
-\def\uppercaseenumerate{\uppercaseenumerate1203,39566
-\def\startenumeration#1{\startenumeration1219,40056
-\def\alphaenumerate{\alphaenumerate1227,40238
-\def\capsenumerate{\capsenumerate1228,40273
-\def\Ealphaenumerate{\Ealphaenumerate1229,40307
-\def\Ecapsenumerate{\Ecapsenumerate1230,40341
-\def\itemizeitem{\itemizeitem1234,40421
-\def\newindex #1{\newindex1259,41278
-\def\defindex{\defindex1268,41567
-\def\newcodeindex #1{\newcodeindex1272,41675
-\def\defcodeindex{\defcodeindex1279,41935
-\def\synindex #1 #2 {\synindex1283,42115
-\def\syncodeindex #1 #2 {\syncodeindex1292,42455
-\def\doindex#1{\doindex1309,43134
-\def\singleindexer #1{\singleindexer1310,43193
-\def\docodeindex#1{\docodeindex1313,43305
-\def\singlecodeindexer #1{\singlecodeindexer1314,43372
-\def\indexdummies{\indexdummies1316,43430
-\def\_{\_1317,43450
-\def\w{\w1318,43478
-\def\bf{\bf1319,43505
-\def\rm{\rm1320,43534
-\def\sl{\sl1321,43563
-\def\sf{\sf1322,43592
-\def\tt{\tt1323,43620
-\def\gtr{\gtr1324,43648
-\def\less{\less1325,43678
-\def\hat{\hat1326,43710
-\def\char{\char1327,43740
-\def\TeX{\TeX1328,43772
-\def\dots{\dots1329,43802
-\def\copyright{\copyright1330,43835
-\def\tclose##1{\tclose1331,43878
-\def\code##1{\code1332,43923
-\def\samp##1{\samp1333,43964
-\def\t##1{\t1334,44005
-\def\r##1{\r1335,44040
-\def\i##1{\i1336,44075
-\def\b##1{\b1337,44110
-\def\cite##1{\cite1338,44145
-\def\key##1{\key1339,44186
-\def\file##1{\file1340,44225
-\def\var##1{\var1341,44266
-\def\kbd##1{\kbd1342,44305
-\def\indexdummyfont#1{\indexdummyfont1347,44461
-\def\indexdummytex{\indexdummytex1348,44487
-\def\indexdummydots{\indexdummydots1349,44511
-\def\indexnofonts{\indexnofonts1351,44537
-\let\w=\indexdummyfontdummyfont1352,44557
-\let\t=\indexdummyfontdummyfont1353,44580
-\let\r=\indexdummyfontdummyfont1354,44603
-\let\i=\indexdummyfontdummyfont1355,44626
-\let\b=\indexdummyfontdummyfont1356,44649
-\let\emph=\indexdummyfontdummyfont1357,44672
-\let\strong=\indexdummyfontdummyfont1358,44698
-\let\cite=\indexdummyfont=\indexdummyfont1359,44726
-\let\sc=\indexdummyfontdummyfont1360,44752
-\let\tclose=\indexdummyfontdummyfont1364,44924
-\let\code=\indexdummyfontdummyfont1365,44952
-\let\file=\indexdummyfontdummyfont1366,44978
-\let\samp=\indexdummyfontdummyfont1367,45004
-\let\kbd=\indexdummyfontdummyfont1368,45030
-\let\key=\indexdummyfontdummyfont1369,45055
-\let\var=\indexdummyfontdummyfont1370,45080
-\let\TeX=\indexdummytexdummytex1371,45105
-\let\dots=\indexdummydotsdummydots1372,45129
-\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45381
-\def\doind #1#2{\doind1384,45437
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45480
-\def\rawbackslashxx{\rawbackslashxx1389,45620
-{\indexnofontsnofonts1394,45882
-\def\dosubind #1#2#3{\dosubind1405,46193
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46241
-\def\rawbackslashxx{\rawbackslashxx1410,46345
-{\indexnofontsnofonts1414,46499
-\def\findex {\findex1443,47430
-\def\kindex {\kindex1444,47453
-\def\cindex {\cindex1445,47476
-\def\vindex {\vindex1446,47499
-\def\tindex {\tindex1447,47522
-\def\pindex {\pindex1448,47545
-\def\cindexsub {\cindexsub1450,47569
-\def\printindex{\printindex1462,47896
-\def\doprintindex#1{\doprintindex1464,47937
- \def\indexbackslash{\indexbackslash1481,48422
- \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48461
-\def\initial #1{\initial1517,49533
-\def\entry #1#2{\entry1523,49740
- \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50387
-\def\indexdotfill{\indexdotfill1549,50715
-\def\primary #1{\primary1552,50821
-\def\secondary #1#2{\secondary1556,50903
-\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50985
-\newbox\partialpageialpage1566,51158
-\def\begindoublecolumns{\begindoublecolumns1572,51316
- \output={\global\setbox\partialpage=ialpage=1573,51352
-\def\enddoublecolumns{\enddoublecolumns1577,51540
-\def\doublecolumnout{\doublecolumnout1580,51625
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51694
-\def\pagesofar{\pagesofar1584,51872
-\def\balancecolumns{\balancecolumns1588,52109
- \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52280
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52541
-\newcount \appendixno \appendixno = `\@no1627,53446
-\def\appendixletter{\appendixletter1628,53487
-\def\opencontents{\opencontents1632,53590
-\def\thischapter{\thischapter1637,53771
-\def\seccheck#1{\seccheck1638,53809
-\def\chapternofonts{\chapternofonts1643,53913
-\def\result{\result1646,53988
-\def\equiv{\equiv1647,54023
-\def\expansion{\expansion1648,54056
-\def\print{\print1649,54097
-\def\TeX{\TeX1650,54130
-\def\dots{\dots1651,54159
-\def\copyright{\copyright1652,54190
-\def\tt{\tt1653,54231
-\def\bf{\bf1654,54258
-\def\w{\w1655,54286
-\def\less{\less1656,54311
-\def\gtr{\gtr1657,54342
-\def\hat{\hat1658,54371
-\def\char{\char1659,54400
-\def\tclose##1{\tclose1660,54431
-\def\code##1{\code1661,54475
-\def\samp##1{\samp1662,54515
-\def\r##1{\r1663,54555
-\def\b##1{\b1664,54589
-\def\key##1{\key1665,54623
-\def\file##1{\file1666,54661
-\def\kbd##1{\kbd1667,54701
-\def\i##1{\i1669,54809
-\def\cite##1{\cite1670,54843
-\def\var##1{\var1671,54883
-\def\emph##1{\emph1672,54921
-\def\dfn##1{\dfn1673,54961
-\def\thischaptername{\thischaptername1676,55002
-\outer\def\chapter{\chapter1677,55041
-\def\chapterzzz #1{\chapterzzz1678,55082
-{\chapternofonts%nofonts%1687,55478
-\global\let\section = \numberedsec=1692,55631
-\global\let\subsection = \numberedsubsec=1693,55666
-\global\let\subsubsection = \numberedsubsubsec=1694,55707
-\outer\def\appendix{\appendix1697,55758
-\def\appendixzzz #1{\appendixzzz1698,55801
-\global\advance \appendixno by 1 \message{no1700,55878
-\chapmacro {#1}{Appendix \appendixletter}letter1701,55947
-\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56040
-{\chapternofonts%nofonts%1705,56112
- {#1}{Appendix \appendixletter}letter1707,56168
-\appendixnoderef %noderef1710,56268
-\global\let\section = \appendixsec=1711,56287
-\global\let\subsection = \appendixsubsec=1712,56322
-\global\let\subsubsection = \appendixsubsubsec=1713,56363
-\outer\def\top{\top1716,56414
-\outer\def\unnumbered{\unnumbered1717,56454
-\def\unnumberedzzz #1{\unnumberedzzz1718,56501
-{\chapternofonts%nofonts%1722,56664
-\global\let\section = \unnumberedsec=1727,56814
-\global\let\subsection = \unnumberedsubsec=1728,56851
-\global\let\subsubsection = \unnumberedsubsubsec=1729,56894
-\outer\def\numberedsec{\numberedsec1732,56947
-\def\seczzz #1{\seczzz1733,56988
-{\chapternofonts%nofonts%1736,57144
-\outer\def\appendixsection{\appendixsection1745,57330
-\outer\def\appendixsec{\appendixsec1746,57387
-\def\appendixsectionzzz #1{\appendixsectionzzz1747,57440
-\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57552
-{\chapternofonts%nofonts%1750,57620
-{#1}{\appendixletter}letter1752,57676
-\appendixnoderef %noderef1755,57776
-\outer\def\unnumberedsec{\unnumberedsec1759,57816
-\def\unnumberedseczzz #1{\unnumberedseczzz1760,57869
-{\chapternofonts%nofonts%1762,57964
-\outer\def\numberedsubsec{\numberedsubsec1770,58132
-\def\numberedsubseczzz #1{\numberedsubseczzz1771,58187
-{\chapternofonts%nofonts%1774,58366
-\outer\def\appendixsubsec{\appendixsubsec1783,58570
-\def\appendixsubseczzz #1{\appendixsubseczzz1784,58625
-\subsecheading {#1}{\appendixletter}letter1786,58747
-{\chapternofonts%nofonts%1787,58812
-{#1}{\appendixletter}letter1789,58871
-\appendixnoderef %noderef1792,58986
-\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59026
-\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59085
-{\chapternofonts%nofonts%1799,59186
-\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59357
-\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59418
-{\chapternofonts%nofonts%1812,59615
-\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59848
-\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59909
- {\appendixletter}letter1827,60048
-{\chapternofonts%nofonts%1828,60114
- {\appendixletter}letter1830,60179
-\appendixnoderef %noderef1834,60313
-\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60353
-\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60418
-{\chapternofonts%nofonts%1841,60525
-\def\infotop{\infotop1851,60854
-\def\infounnumbered{\infounnumbered1852,60892
-\def\infounnumberedsec{\infounnumberedsec1853,60937
-\def\infounnumberedsubsec{\infounnumberedsubsec1854,60988
-\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61045
-\def\infoappendix{\infoappendix1857,61109
-\def\infoappendixsec{\infoappendixsec1858,61150
-\def\infoappendixsubsec{\infoappendixsubsec1859,61197
-\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61250
-\def\infochapter{\infochapter1862,61310
-\def\infosection{\infosection1863,61349
-\def\infosubsection{\infosubsection1864,61388
-\def\infosubsubsection{\infosubsubsection1865,61433
-\global\let\section = \numberedsec=1870,61670
-\global\let\subsection = \numberedsubsec=1871,61705
-\global\let\subsubsection = \numberedsubsubsec=1872,61746
-\def\majorheading{\majorheading1886,62253
-\def\majorheadingzzz #1{\majorheadingzzz1887,62298
-\def\chapheading{\chapheading1893,62531
-\def\chapheadingzzz #1{\chapheadingzzz1894,62574
-\def\heading{\heading1899,62769
-\def\subheading{\subheading1901,62806
-\def\subsubheading{\subsubheading1903,62849
-\def\dobreak#1#2{\dobreak1910,63126
-\def\setchapterstyle #1 {\setchapterstyle1912,63204
-\def\chapbreak{\chapbreak1919,63459
-\def\chappager{\chappager1920,63509
-\def\chapoddpage{\chapoddpage1921,63547
-\def\setchapternewpage #1 {\setchapternewpage1923,63626
-\def\CHAPPAGoff{\CHAPPAGoff1925,63683
-\def\CHAPPAGon{\CHAPPAGon1929,63777
-\global\def\HEADINGSon{\HEADINGSon1932,63868
-\def\CHAPPAGodd{\CHAPPAGodd1934,63910
-\global\def\HEADINGSon{\HEADINGSon1937,64006
-\def\CHAPFplain{\CHAPFplain1941,64060
-\def\chfplain #1#2{\chfplain1945,64152
-\def\unnchfplain #1{\unnchfplain1956,64375
-\def\unnchfopen #1{\unnchfopen1964,64604
-\def\chfopen #1#2{\chfopen1970,64812
-\def\CHAPFopen{\CHAPFopen1975,64956
-\def\subsecheadingbreak{\subsecheadingbreak1982,65174
-\def\secheadingbreak{\secheadingbreak1985,65303
-\def\secheading #1#2#3{\secheading1993,65585
-\def\plainsecheading #1{\plainsecheading1994,65641
-\def\secheadingi #1{\secheadingi1995,65684
-\def\subsecheading #1#2#3#4{\subsecheading2006,66052
-\def\subsecheadingi #1{\subsecheadingi2007,66119
-\def\subsubsecfonts{\subsubsecfonts2014,66416
-\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66539
-\def\subsubsecheadingi #1{\subsubsecheadingi2018,66617
-\def\startcontents#1{\startcontents2032,67089
- \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67362
-\outer\def\contents{\contents2049,67721
-\outer\def\summarycontents{\summarycontents2057,67865
- \def\secentry ##1##2##3##4{\secentry2067,68236
- \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68271
- \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68306
- \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68347
- \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68385
- \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68432
-\def\chapentry#1#2#3{\chapentry2085,68866
-\def\shortchapentry#1#2#3{\shortchapentry2088,68983
- {#2\labelspace #1}space2091,69093
-\def\unnumbchapentry#1#2{\unnumbchapentry2094,69147
-\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69194
-\def\secentry#1#2#3#4{\secentry2102,69358
-\def\unnumbsecentry#1#2{\unnumbsecentry2103,69417
-\def\subsecentry#1#2#3#4#5{\subsecentry2106,69478
-\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69548
-\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69622
- \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69656
-\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69707
-\def\dochapentry#1#2{\dochapentry2123,70081
-\def\dosecentry#1#2{\dosecentry2138,70686
-\def\dosubsecentry#1#2{\dosubsecentry2145,70864
-\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71049
-\def\labelspace{\labelspace2160,71300
-\def\dopageno#1{\dopageno2162,71335
-\def\doshortpageno#1{\doshortpageno2163,71361
-\def\chapentryfonts{\chapentryfonts2165,71393
-\def\secentryfonts{\secentryfonts2166,71428
-\def\point{\point2192,72387
-\def\result{\result2194,72408
-\def\expansion{\expansion2195,72481
-\def\print{\print2196,72552
-\def\equiv{\equiv2198,72619
-\def\error{\error2218,73392
-\def\tex{\tex2224,73621
-\def\@{\@2242,74004
-\gdef\sepspaces{\def {\ }}}\2265,74736
-\def\aboveenvbreak{\aboveenvbreak2268,74818
-\def\afterenvbreak{\afterenvbreak2272,74984
-\def\ctl{\ctl2286,75495
-\def\ctr{\ctr2287,75567
-\def\cbl{\cbl2288,75606
-\def\cbr{\cbr2289,75646
-\def\carttop{\carttop2290,75685
-\def\cartbot{\cartbot2293,75793
-\long\def\cartouche{\cartouche2299,75933
-\def\Ecartouche{\Ecartouche2326,76721
-\def\lisp{\lisp2338,76856
-\def\Elisp{\Elisp2348,77203
-\def\next##1{\next2360,77529
-\def\Eexample{\Eexample2364,77571
-\def\Esmallexample{\Esmallexample2367,77618
-\def\smalllispx{\smalllispx2373,77796
-\def\Esmalllisp{\Esmalllisp2383,78150
-\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78506
-\def\next##1{\next2397,78563
-\def\display{\display2401,78643
-\def\Edisplay{\Edisplay2410,78962
-\def\next##1{\next2422,79273
-\def\format{\format2426,79376
-\def\Eformat{\Eformat2434,79672
-\def\next##1{\next2437,79761
-\def\flushleft{\flushleft2441,79813
-\def\Eflushleft{\Eflushleft2451,80184
-\def\next##1{\next2454,80277
-\def\flushright{\flushright2456,80299
-\def\Eflushright{\Eflushright2466,80671
-\def\next##1{\next2470,80802
-\def\quotation{\quotation2474,80860
-\def\Equotation{\Equotation2480,81052
-\def\setdeffont #1 {\setdeffont2493,81450
-\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81496
-\newskip\defargsindent \defargsindent=50ptargsindent2496,81539
-\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81582
-\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81625
-\def\activeparens{\activeparens2503,81823
-\def\opnr{\opnr2529,83035
-\def\lbrb{\lbrb2530,83100
-\def\defname #1#2{\defname2536,83301
-\advance\dimen2 by -\defbodyindentbodyindent2540,83419
-\advance\dimen3 by -\defbodyindentbodyindent2542,83473
-\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83527
-\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83669
-\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83744
-\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84113
-\advance\leftskip by -\defbodyindentbodyindent2557,84247
-\exdentamount=\defbodyindentbodyindent2558,84284
-\def\defparsebody #1#2#3{\defparsebody2568,84643
-\def#1{2572,84827
-\def#2{2573,84863
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84935
-\exdentamount=\defbodyindentbodyindent2576,85009
-\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85113
-\def#1{2585,85274
-\def#2##1 {2586,85310
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85393
-\exdentamount=\defbodyindentbodyindent2589,85467
-\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85552
-\def#1{2596,85713
-\def#2##1 ##2 {2597,85749
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85849
-\exdentamount=\defbodyindentbodyindent2601,85923
-\def\defvarparsebody #1#2#3{\defvarparsebody2608,86194
-\def#1{2612,86381
-\def#2{2613,86417
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86476
-\exdentamount=\defbodyindentbodyindent2616,86550
-\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86641
-\def#1{2625,86800
-\def#2##1 {2626,86836
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86906
-\exdentamount=\defbodyindentbodyindent2629,86980
-\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87052
-\def#1{2636,87216
-\def#2##1 ##2 {2637,87252
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87339
-\exdentamount=\defbodyindentbodyindent2641,87413
-\def\defunargs #1{\defunargs2664,88173
-\def\deftypefunargs #1{\deftypefunargs2676,88555
-\def\deffn{\deffn2690,88937
-\def\deffnheader #1#2#3{\deffnheader2692,88994
-\begingroup\defname {name2693,89042
-\def\defun{\defun2699,89187
-\def\defunheader #1#2{\defunheader2701,89240
-\begingroup\defname {name2702,89315
-\defunargs {unargs2703,89351
-\def\deftypefun{\deftypefun2709,89499
-\def\deftypefunheader #1#2{\deftypefunheader2712,89621
-\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89730
-\begingroup\defname {name2716,89822
-\deftypefunargs {typefunargs2717,89868
-\def\deftypefn{\deftypefn2723,90039
-\def\deftypefnheader #1#2#3{\deftypefnheader2726,90188
-\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90324
-\begingroup\defname {name2730,90417
-\deftypefunargs {typefunargs2731,90457
-\def\defmac{\defmac2737,90578
-\def\defmacheader #1#2{\defmacheader2739,90635
-\begingroup\defname {name2740,90711
-\defunargs {unargs2741,90744
-\def\defspec{\defspec2747,90868
-\def\defspecheader #1#2{\defspecheader2749,90929
-\begingroup\defname {name2750,91006
-\defunargs {unargs2751,91046
-\def\deffnx #1 {\deffnx2758,91241
-\def\defunx #1 {\defunx2759,91298
-\def\defmacx #1 {\defmacx2760,91355
-\def\defspecx #1 {\defspecx2761,91414
-\def\deftypefnx #1 {\deftypefnx2762,91475
-\def\deftypeunx #1 {\deftypeunx2763,91540
-\def\defop #1 {\defop2769,91686
-\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91721
-\def\defopheader #1#2#3{\defopheader2772,91775
-\begingroup\defname {name2774,91864
-\defunargs {unargs2775,91910
-\def\defmethod{\defmethod2780,91971
-\def\defmethodheader #1#2#3{\defmethodheader2782,92044
-\begingroup\defname {name2784,92132
-\defunargs {unargs2785,92172
-\def\defcv #1 {\defcv2790,92246
-\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92281
-\def\defcvarheader #1#2#3{\defcvarheader2793,92340
-\begingroup\defname {name2795,92426
-\defvarargs {varargs2796,92472
-\def\defivar{\defivar2801,92545
-\def\defivarheader #1#2#3{\defivarheader2803,92608
-\begingroup\defname {name2805,92694
-\defvarargs {varargs2806,92745
-\def\defopx #1 {\defopx2812,92894
-\def\defmethodx #1 {\defmethodx2813,92951
-\def\defcvx #1 {\defcvx2814,93016
-\def\defivarx #1 {\defivarx2815,93073
-\def\defvarargs #1{\defvarargs2822,93344
-\def\defvr{\defvr2828,93488
-\def\defvrheader #1#2#3{\defvrheader2830,93543
-\begingroup\defname {name2831,93591
-\def\defvar{\defvar2835,93676
-\def\defvarheader #1#2{\defvarheader2837,93736
-\begingroup\defname {name2838,93807
-\defvarargs {varargs2839,93843
-\def\defopt{\defopt2844,93909
-\def\defoptheader #1#2{\defoptheader2846,93969
-\begingroup\defname {name2847,94040
-\defvarargs {varargs2848,94079
-\def\deftypevar{\deftypevar2853,94136
-\def\deftypevarheader #1#2{\deftypevarheader2856,94252
-\begingroup\defname {name2858,94335
-\def\deftypevr{\deftypevr2865,94509
-\def\deftypevrheader #1#2#3{\deftypevrheader2867,94580
-\begingroup\defname {name2868,94632
-\def\defvrx #1 {\defvrx2876,94869
-\def\defvarx #1 {\defvarx2877,94926
-\def\defoptx #1 {\defoptx2878,94985
-\def\deftypevarx #1 {\deftypevarx2879,95044
-\def\deftypevrx #1 {\deftypevrx2880,95111
-\def\deftpargs #1{\deftpargs2885,95260
-\def\deftp{\deftp2889,95340
-\def\deftpheader #1#2#3{\deftpheader2891,95395
-\begingroup\defname {name2892,95443
-\def\deftpx #1 {\deftpx2897,95602
-\def\setref#1{\setref2908,95923
-\def\unnumbsetref#1{\unnumbsetref2913,96037
-\def\appendixsetref#1{\appendixsetref2918,96144
-\def\pxref#1{\pxref2929,96555
-\def\xref#1{\xref2930,96591
-\def\ref#1{\ref2931,96626
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96656
-\def\printedmanual{\printedmanual2933,96699
-\def\printednodename{\printednodename2934,96737
-\def\printednodename{\printednodename2939,96862
-section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97495
-\refx{x2957,97573
-\def\dosetq #1#2{\dosetq2965,97793
-\def\internalsetq #1#2{\internalsetq2973,98051
-\def\Ypagenumber{\Ypagenumber2977,98152
-\def\Ytitle{\Ytitle2979,98178
-\def\Ynothing{\Ynothing2981,98205
-\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98222
-\def\Yappendixletterandtype{\Yappendixletterandtype2992,98538
-\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98568
-\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98623
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98727
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98798
- \def\linenumber{\linenumber3009,99137
-\def\refx#1#2{\refx3015,99321
-\def\xrdef #1#2{\xrdef3037,99947
-\def\readauxfile{\readauxfile3040,100032
-\def\supereject{\supereject3110,101813
-\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102498
-\def\openindices{\openindices3139,102684
-\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102909
-\parindent = \defaultparindentaultparindent3152,102961
-\def\smallbook{\smallbook3175,103685
-\global\def\Esmallexample{\Esmallexample3192,104112
-\def\afourpaper{\afourpaper3196,104203
-\def\finalout{\finalout3224,105011
-\def\normaldoublequote{\normaldoublequote3235,105272
-\def\normaltilde{\normaltilde3236,105298
-\def\normalcaret{\normalcaret3237,105318
-\def\normalunderscore{\normalunderscore3238,105338
-\def\normalverticalbar{\normalverticalbar3239,105363
-\def\normalless{\normalless3240,105389
-\def\normalgreater{\normalgreater3241,105408
-\def\normalplus{\normalplus3242,105430
-\def\ifusingtt#1#2{\ifusingtt3253,105922
-\def\activedoublequote{\activedoublequote3261,106250
-\def~{~3264,106336
-\def^{^3267,106397
-\def_{_3270,106436
-\def\_{\_3272,106510
-\def\lvvmode{\lvvmode3279,106847
-\def|{|3282,106897
-\def<{<3285,106960
-\def>{>3288,107017
-\def+{+3290,107055
-\def\turnoffactive{\turnoffactive3296,107216
-\global\def={=3307,107502
-\def\normalbackslash{\normalbackslash3321,107884
+\def\itemfont{\itemfont1082,35890
+\def\Etable{\Etable1090,36116
+\def\itemize{\itemize1103,36440
+\def\itemizezzz #1{\itemizezzz1105,36476
+\def\itemizey #1#2{\itemizey1110,36571
+\def#2{1119,36817
+\def\itemcontents{\itemcontents1120,36858
+\def\bullet{\bullet1123,36906
+\def\minus{\minus1124,36933
+\def\frenchspacing{\frenchspacing1128,37041
+\def\splitoff#1#2\endmark{\splitoff1134,37266
+\def\enumerate{\enumerate1140,37496
+\def\enumeratezzz #1{\enumeratezzz1141,37535
+\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37588
+ \def\thearg{\thearg1146,37735
+ \ifx\thearg\empty \def\thearg{\thearg1147,37754
+\def\numericenumerate{\numericenumerate1184,39088
+\def\lowercaseenumerate{\lowercaseenumerate1190,39218
+\def\uppercaseenumerate{\uppercaseenumerate1203,39565
+\def\startenumeration#1{\startenumeration1219,40055
+\def\alphaenumerate{\alphaenumerate1227,40237
+\def\capsenumerate{\capsenumerate1228,40272
+\def\Ealphaenumerate{\Ealphaenumerate1229,40306
+\def\Ecapsenumerate{\Ecapsenumerate1230,40340
+\def\itemizeitem{\itemizeitem1234,40420
+\def\newindex #1{\newindex1259,41277
+\def\defindex{\defindex1268,41566
+\def\newcodeindex #1{\newcodeindex1272,41674
+\def\defcodeindex{\defcodeindex1279,41934
+\def\synindex #1 #2 {\synindex1283,42114
+\def\syncodeindex #1 #2 {\syncodeindex1292,42454
+\def\doindex#1{\doindex1309,43133
+\def\singleindexer #1{\singleindexer1310,43192
+\def\docodeindex#1{\docodeindex1313,43304
+\def\singlecodeindexer #1{\singlecodeindexer1314,43371
+\def\indexdummies{\indexdummies1316,43429
+\def\_{\_1317,43449
+\def\w{\w1318,43477
+\def\bf{\bf1319,43504
+\def\rm{\rm1320,43533
+\def\sl{\sl1321,43562
+\def\sf{\sf1322,43591
+\def\tt{\tt1323,43619
+\def\gtr{\gtr1324,43647
+\def\less{\less1325,43677
+\def\hat{\hat1326,43709
+\def\char{\char1327,43739
+\def\TeX{\TeX1328,43771
+\def\dots{\dots1329,43801
+\def\copyright{\copyright1330,43834
+\def\tclose##1{\tclose1331,43877
+\def\code##1{\code1332,43922
+\def\samp##1{\samp1333,43963
+\def\t##1{\t1334,44004
+\def\r##1{\r1335,44039
+\def\i##1{\i1336,44074
+\def\b##1{\b1337,44109
+\def\cite##1{\cite1338,44144
+\def\key##1{\key1339,44185
+\def\file##1{\file1340,44224
+\def\var##1{\var1341,44265
+\def\kbd##1{\kbd1342,44304
+\def\indexdummyfont#1{\indexdummyfont1347,44460
+\def\indexdummytex{\indexdummytex1348,44486
+\def\indexdummydots{\indexdummydots1349,44510
+\def\indexnofonts{\indexnofonts1351,44536
+\let\w=\indexdummyfontdummyfont1352,44556
+\let\t=\indexdummyfontdummyfont1353,44579
+\let\r=\indexdummyfontdummyfont1354,44602
+\let\i=\indexdummyfontdummyfont1355,44625
+\let\b=\indexdummyfontdummyfont1356,44648
+\let\emph=\indexdummyfontdummyfont1357,44671
+\let\strong=\indexdummyfontdummyfont1358,44697
+\let\cite=\indexdummyfont=\indexdummyfont1359,44725
+\let\sc=\indexdummyfontdummyfont1360,44751
+\let\tclose=\indexdummyfontdummyfont1364,44923
+\let\code=\indexdummyfontdummyfont1365,44951
+\let\file=\indexdummyfontdummyfont1366,44977
+\let\samp=\indexdummyfontdummyfont1367,45003
+\let\kbd=\indexdummyfontdummyfont1368,45029
+\let\key=\indexdummyfontdummyfont1369,45054
+\let\var=\indexdummyfontdummyfont1370,45079
+\let\TeX=\indexdummytexdummytex1371,45104
+\let\dots=\indexdummydotsdummydots1372,45128
+\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45380
+\def\doind #1#2{\doind1384,45436
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45479
+\def\rawbackslashxx{\rawbackslashxx1389,45619
+{\indexnofontsnofonts1394,45881
+\def\dosubind #1#2#3{\dosubind1405,46192
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46240
+\def\rawbackslashxx{\rawbackslashxx1410,46344
+{\indexnofontsnofonts1414,46498
+\def\findex {\findex1443,47429
+\def\kindex {\kindex1444,47452
+\def\cindex {\cindex1445,47475
+\def\vindex {\vindex1446,47498
+\def\tindex {\tindex1447,47521
+\def\pindex {\pindex1448,47544
+\def\cindexsub {\cindexsub1450,47568
+\def\printindex{\printindex1462,47895
+\def\doprintindex#1{\doprintindex1464,47936
+ \def\indexbackslash{\indexbackslash1481,48421
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48460
+\def\initial #1{\initial1517,49532
+\def\entry #1#2{\entry1523,49739
+ \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50386
+\def\indexdotfill{\indexdotfill1549,50714
+\def\primary #1{\primary1552,50820
+\def\secondary #1#2{\secondary1556,50902
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50984
+\newbox\partialpageialpage1566,51157
+\def\begindoublecolumns{\begindoublecolumns1572,51315
+ \output={\global\setbox\partialpage=ialpage=1573,51351
+\def\enddoublecolumns{\enddoublecolumns1577,51539
+\def\doublecolumnout{\doublecolumnout1580,51624
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51693
+\def\pagesofar{\pagesofar1584,51871
+\def\balancecolumns{\balancecolumns1588,52108
+ \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52279
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52540
+\newcount \appendixno \appendixno = `\@no1627,53445
+\def\appendixletter{\appendixletter1628,53486
+\def\opencontents{\opencontents1632,53589
+\def\thischapter{\thischapter1637,53770
+\def\seccheck#1{\seccheck1638,53808
+\def\chapternofonts{\chapternofonts1643,53912
+\def\result{\result1646,53987
+\def\equiv{\equiv1647,54022
+\def\expansion{\expansion1648,54055
+\def\print{\print1649,54096
+\def\TeX{\TeX1650,54129
+\def\dots{\dots1651,54158
+\def\copyright{\copyright1652,54189
+\def\tt{\tt1653,54230
+\def\bf{\bf1654,54257
+\def\w{\w1655,54285
+\def\less{\less1656,54310
+\def\gtr{\gtr1657,54341
+\def\hat{\hat1658,54370
+\def\char{\char1659,54399
+\def\tclose##1{\tclose1660,54430
+\def\code##1{\code1661,54474
+\def\samp##1{\samp1662,54514
+\def\r##1{\r1663,54554
+\def\b##1{\b1664,54588
+\def\key##1{\key1665,54622
+\def\file##1{\file1666,54660
+\def\kbd##1{\kbd1667,54700
+\def\i##1{\i1669,54808
+\def\cite##1{\cite1670,54842
+\def\var##1{\var1671,54882
+\def\emph##1{\emph1672,54920
+\def\dfn##1{\dfn1673,54960
+\def\thischaptername{\thischaptername1676,55001
+\outer\def\chapter{\chapter1677,55040
+\def\chapterzzz #1{\chapterzzz1678,55081
+{\chapternofonts%nofonts%1687,55477
+\global\let\section = \numberedsec=1692,55630
+\global\let\subsection = \numberedsubsec=1693,55665
+\global\let\subsubsection = \numberedsubsubsec=1694,55706
+\outer\def\appendix{\appendix1697,55757
+\def\appendixzzz #1{\appendixzzz1698,55800
+\global\advance \appendixno by 1 \message{no1700,55877
+\chapmacro {#1}{Appendix \appendixletter}letter1701,55946
+\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56039
+{\chapternofonts%nofonts%1705,56111
+ {#1}{Appendix \appendixletter}letter1707,56167
+\appendixnoderef %noderef1710,56267
+\global\let\section = \appendixsec=1711,56286
+\global\let\subsection = \appendixsubsec=1712,56321
+\global\let\subsubsection = \appendixsubsubsec=1713,56362
+\outer\def\top{\top1716,56413
+\outer\def\unnumbered{\unnumbered1717,56453
+\def\unnumberedzzz #1{\unnumberedzzz1718,56500
+{\chapternofonts%nofonts%1722,56663
+\global\let\section = \unnumberedsec=1727,56813
+\global\let\subsection = \unnumberedsubsec=1728,56850
+\global\let\subsubsection = \unnumberedsubsubsec=1729,56893
+\outer\def\numberedsec{\numberedsec1732,56946
+\def\seczzz #1{\seczzz1733,56987
+{\chapternofonts%nofonts%1736,57143
+\outer\def\appendixsection{\appendixsection1745,57329
+\outer\def\appendixsec{\appendixsec1746,57386
+\def\appendixsectionzzz #1{\appendixsectionzzz1747,57439
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57551
+{\chapternofonts%nofonts%1750,57619
+{#1}{\appendixletter}letter1752,57675
+\appendixnoderef %noderef1755,57775
+\outer\def\unnumberedsec{\unnumberedsec1759,57815
+\def\unnumberedseczzz #1{\unnumberedseczzz1760,57868
+{\chapternofonts%nofonts%1762,57963
+\outer\def\numberedsubsec{\numberedsubsec1770,58131
+\def\numberedsubseczzz #1{\numberedsubseczzz1771,58186
+{\chapternofonts%nofonts%1774,58365
+\outer\def\appendixsubsec{\appendixsubsec1783,58569
+\def\appendixsubseczzz #1{\appendixsubseczzz1784,58624
+\subsecheading {#1}{\appendixletter}letter1786,58746
+{\chapternofonts%nofonts%1787,58811
+{#1}{\appendixletter}letter1789,58870
+\appendixnoderef %noderef1792,58985
+\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59025
+\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59084
+{\chapternofonts%nofonts%1799,59185
+\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59356
+\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59417
+{\chapternofonts%nofonts%1812,59614
+\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59847
+\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59908
+ {\appendixletter}letter1827,60047
+{\chapternofonts%nofonts%1828,60113
+ {\appendixletter}letter1830,60178
+\appendixnoderef %noderef1834,60312
+\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60352
+\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60417
+{\chapternofonts%nofonts%1841,60524
+\def\infotop{\infotop1851,60853
+\def\infounnumbered{\infounnumbered1852,60891
+\def\infounnumberedsec{\infounnumberedsec1853,60936
+\def\infounnumberedsubsec{\infounnumberedsubsec1854,60987
+\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61044
+\def\infoappendix{\infoappendix1857,61108
+\def\infoappendixsec{\infoappendixsec1858,61149
+\def\infoappendixsubsec{\infoappendixsubsec1859,61196
+\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61249
+\def\infochapter{\infochapter1862,61309
+\def\infosection{\infosection1863,61348
+\def\infosubsection{\infosubsection1864,61387
+\def\infosubsubsection{\infosubsubsection1865,61432
+\global\let\section = \numberedsec=1870,61669
+\global\let\subsection = \numberedsubsec=1871,61704
+\global\let\subsubsection = \numberedsubsubsec=1872,61745
+\def\majorheading{\majorheading1886,62252
+\def\majorheadingzzz #1{\majorheadingzzz1887,62297
+\def\chapheading{\chapheading1893,62530
+\def\chapheadingzzz #1{\chapheadingzzz1894,62573
+\def\heading{\heading1899,62768
+\def\subheading{\subheading1901,62805
+\def\subsubheading{\subsubheading1903,62848
+\def\dobreak#1#2{\dobreak1910,63125
+\def\setchapterstyle #1 {\setchapterstyle1912,63203
+\def\chapbreak{\chapbreak1919,63458
+\def\chappager{\chappager1920,63508
+\def\chapoddpage{\chapoddpage1921,63546
+\def\setchapternewpage #1 {\setchapternewpage1923,63625
+\def\CHAPPAGoff{\CHAPPAGoff1925,63682
+\def\CHAPPAGon{\CHAPPAGon1929,63776
+\global\def\HEADINGSon{\HEADINGSon1932,63867
+\def\CHAPPAGodd{\CHAPPAGodd1934,63909
+\global\def\HEADINGSon{\HEADINGSon1937,64005
+\def\CHAPFplain{\CHAPFplain1941,64059
+\def\chfplain #1#2{\chfplain1945,64151
+\def\unnchfplain #1{\unnchfplain1956,64374
+\def\unnchfopen #1{\unnchfopen1964,64603
+\def\chfopen #1#2{\chfopen1970,64811
+\def\CHAPFopen{\CHAPFopen1975,64955
+\def\subsecheadingbreak{\subsecheadingbreak1982,65173
+\def\secheadingbreak{\secheadingbreak1985,65302
+\def\secheading #1#2#3{\secheading1993,65584
+\def\plainsecheading #1{\plainsecheading1994,65640
+\def\secheadingi #1{\secheadingi1995,65683
+\def\subsecheading #1#2#3#4{\subsecheading2006,66051
+\def\subsecheadingi #1{\subsecheadingi2007,66118
+\def\subsubsecfonts{\subsubsecfonts2014,66415
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66538
+\def\subsubsecheadingi #1{\subsubsecheadingi2018,66616
+\def\startcontents#1{\startcontents2032,67088
+ \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67361
+\outer\def\contents{\contents2049,67720
+\outer\def\summarycontents{\summarycontents2057,67864
+ \def\secentry ##1##2##3##4{\secentry2067,68235
+ \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68270
+ \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68305
+ \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68346
+ \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68384
+ \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68431
+\def\chapentry#1#2#3{\chapentry2085,68865
+\def\shortchapentry#1#2#3{\shortchapentry2088,68982
+ {#2\labelspace #1}space2091,69092
+\def\unnumbchapentry#1#2{\unnumbchapentry2094,69146
+\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69193
+\def\secentry#1#2#3#4{\secentry2102,69357
+\def\unnumbsecentry#1#2{\unnumbsecentry2103,69416
+\def\subsecentry#1#2#3#4#5{\subsecentry2106,69477
+\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69547
+\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69621
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69655
+\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69706
+\def\dochapentry#1#2{\dochapentry2123,70080
+\def\dosecentry#1#2{\dosecentry2138,70685
+\def\dosubsecentry#1#2{\dosubsecentry2145,70863
+\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71048
+\def\labelspace{\labelspace2160,71299
+\def\dopageno#1{\dopageno2162,71334
+\def\doshortpageno#1{\doshortpageno2163,71360
+\def\chapentryfonts{\chapentryfonts2165,71392
+\def\secentryfonts{\secentryfonts2166,71427
+\def\point{\point2192,72386
+\def\result{\result2194,72407
+\def\expansion{\expansion2195,72480
+\def\print{\print2196,72551
+\def\equiv{\equiv2198,72618
+\def\error{\error2218,73391
+\def\tex{\tex2224,73620
+\def\@{\@2242,74003
+\gdef\sepspaces{\def {\ }}}\2265,74735
+\def\aboveenvbreak{\aboveenvbreak2268,74817
+\def\afterenvbreak{\afterenvbreak2272,74983
+\def\ctl{\ctl2286,75494
+\def\ctr{\ctr2287,75566
+\def\cbl{\cbl2288,75605
+\def\cbr{\cbr2289,75645
+\def\carttop{\carttop2290,75684
+\def\cartbot{\cartbot2293,75792
+\long\def\cartouche{\cartouche2299,75932
+\def\Ecartouche{\Ecartouche2326,76720
+\def\lisp{\lisp2338,76855
+\def\Elisp{\Elisp2348,77202
+\def\next##1{\next2360,77528
+\def\Eexample{\Eexample2364,77570
+\def\Esmallexample{\Esmallexample2367,77617
+\def\smalllispx{\smalllispx2373,77795
+\def\Esmalllisp{\Esmalllisp2383,78149
+\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78505
+\def\next##1{\next2397,78562
+\def\display{\display2401,78642
+\def\Edisplay{\Edisplay2410,78961
+\def\next##1{\next2422,79272
+\def\format{\format2426,79375
+\def\Eformat{\Eformat2434,79671
+\def\next##1{\next2437,79760
+\def\flushleft{\flushleft2441,79812
+\def\Eflushleft{\Eflushleft2451,80183
+\def\next##1{\next2454,80276
+\def\flushright{\flushright2456,80298
+\def\Eflushright{\Eflushright2466,80670
+\def\next##1{\next2470,80801
+\def\quotation{\quotation2474,80859
+\def\Equotation{\Equotation2480,81051
+\def\setdeffont #1 {\setdeffont2493,81449
+\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81495
+\newskip\defargsindent \defargsindent=50ptargsindent2496,81538
+\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81581
+\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81624
+\def\activeparens{\activeparens2503,81822
+\def\opnr{\opnr2529,83034
+\def\lbrb{\lbrb2530,83099
+\def\defname #1#2{\defname2536,83300
+\advance\dimen2 by -\defbodyindentbodyindent2540,83418
+\advance\dimen3 by -\defbodyindentbodyindent2542,83472
+\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83526
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83668
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83743
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84112
+\advance\leftskip by -\defbodyindentbodyindent2557,84246
+\exdentamount=\defbodyindentbodyindent2558,84283
+\def\defparsebody #1#2#3{\defparsebody2568,84642
+\def#1{2572,84826
+\def#2{2573,84862
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84934
+\exdentamount=\defbodyindentbodyindent2576,85008
+\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85112
+\def#1{2585,85273
+\def#2##1 {2586,85309
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85392
+\exdentamount=\defbodyindentbodyindent2589,85466
+\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85551
+\def#1{2596,85712
+\def#2##1 ##2 {2597,85748
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85848
+\exdentamount=\defbodyindentbodyindent2601,85922
+\def\defvarparsebody #1#2#3{\defvarparsebody2608,86193
+\def#1{2612,86380
+\def#2{2613,86416
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86475
+\exdentamount=\defbodyindentbodyindent2616,86549
+\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86640
+\def#1{2625,86799
+\def#2##1 {2626,86835
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86905
+\exdentamount=\defbodyindentbodyindent2629,86979
+\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87051
+\def#1{2636,87215
+\def#2##1 ##2 {2637,87251
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87338
+\exdentamount=\defbodyindentbodyindent2641,87412
+\def\defunargs #1{\defunargs2664,88172
+\def\deftypefunargs #1{\deftypefunargs2676,88554
+\def\deffn{\deffn2690,88936
+\def\deffnheader #1#2#3{\deffnheader2692,88993
+\begingroup\defname {name2693,89041
+\def\defun{\defun2699,89186
+\def\defunheader #1#2{\defunheader2701,89239
+\begingroup\defname {name2702,89314
+\defunargs {unargs2703,89350
+\def\deftypefun{\deftypefun2709,89498
+\def\deftypefunheader #1#2{\deftypefunheader2712,89620
+\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89729
+\begingroup\defname {name2716,89821
+\deftypefunargs {typefunargs2717,89867
+\def\deftypefn{\deftypefn2723,90038
+\def\deftypefnheader #1#2#3{\deftypefnheader2726,90187
+\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90323
+\begingroup\defname {name2730,90416
+\deftypefunargs {typefunargs2731,90456
+\def\defmac{\defmac2737,90577
+\def\defmacheader #1#2{\defmacheader2739,90634
+\begingroup\defname {name2740,90710
+\defunargs {unargs2741,90743
+\def\defspec{\defspec2747,90867
+\def\defspecheader #1#2{\defspecheader2749,90928
+\begingroup\defname {name2750,91005
+\defunargs {unargs2751,91045
+\def\deffnx #1 {\deffnx2758,91240
+\def\defunx #1 {\defunx2759,91297
+\def\defmacx #1 {\defmacx2760,91354
+\def\defspecx #1 {\defspecx2761,91413
+\def\deftypefnx #1 {\deftypefnx2762,91474
+\def\deftypeunx #1 {\deftypeunx2763,91539
+\def\defop #1 {\defop2769,91685
+\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91720
+\def\defopheader #1#2#3{\defopheader2772,91774
+\begingroup\defname {name2774,91863
+\defunargs {unargs2775,91909
+\def\defmethod{\defmethod2780,91970
+\def\defmethodheader #1#2#3{\defmethodheader2782,92043
+\begingroup\defname {name2784,92131
+\defunargs {unargs2785,92171
+\def\defcv #1 {\defcv2790,92245
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92280
+\def\defcvarheader #1#2#3{\defcvarheader2793,92339
+\begingroup\defname {name2795,92425
+\defvarargs {varargs2796,92471
+\def\defivar{\defivar2801,92544
+\def\defivarheader #1#2#3{\defivarheader2803,92607
+\begingroup\defname {name2805,92693
+\defvarargs {varargs2806,92744
+\def\defopx #1 {\defopx2812,92893
+\def\defmethodx #1 {\defmethodx2813,92950
+\def\defcvx #1 {\defcvx2814,93015
+\def\defivarx #1 {\defivarx2815,93072
+\def\defvarargs #1{\defvarargs2822,93343
+\def\defvr{\defvr2828,93487
+\def\defvrheader #1#2#3{\defvrheader2830,93542
+\begingroup\defname {name2831,93590
+\def\defvar{\defvar2835,93675
+\def\defvarheader #1#2{\defvarheader2837,93735
+\begingroup\defname {name2838,93806
+\defvarargs {varargs2839,93842
+\def\defopt{\defopt2844,93908
+\def\defoptheader #1#2{\defoptheader2846,93968
+\begingroup\defname {name2847,94039
+\defvarargs {varargs2848,94078
+\def\deftypevar{\deftypevar2853,94135
+\def\deftypevarheader #1#2{\deftypevarheader2856,94251
+\begingroup\defname {name2858,94334
+\def\deftypevr{\deftypevr2865,94508
+\def\deftypevrheader #1#2#3{\deftypevrheader2867,94579
+\begingroup\defname {name2868,94631
+\def\defvrx #1 {\defvrx2876,94868
+\def\defvarx #1 {\defvarx2877,94925
+\def\defoptx #1 {\defoptx2878,94984
+\def\deftypevarx #1 {\deftypevarx2879,95043
+\def\deftypevrx #1 {\deftypevrx2880,95110
+\def\deftpargs #1{\deftpargs2885,95259
+\def\deftp{\deftp2889,95339
+\def\deftpheader #1#2#3{\deftpheader2891,95394
+\begingroup\defname {name2892,95442
+\def\deftpx #1 {\deftpx2897,95601
+\def\setref#1{\setref2908,95922
+\def\unnumbsetref#1{\unnumbsetref2913,96036
+\def\appendixsetref#1{\appendixsetref2918,96143
+\def\pxref#1{\pxref2929,96554
+\def\xref#1{\xref2930,96590
+\def\ref#1{\ref2931,96625
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96655
+\def\printedmanual{\printedmanual2933,96698
+\def\printednodename{\printednodename2934,96736
+\def\printednodename{\printednodename2939,96861
+section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97493
+\refx{x2957,97571
+\def\dosetq #1#2{\dosetq2965,97791
+\def\internalsetq #1#2{\internalsetq2973,98049
+\def\Ypagenumber{\Ypagenumber2977,98150
+\def\Ytitle{\Ytitle2979,98176
+\def\Ynothing{\Ynothing2981,98203
+\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98220
+\def\Yappendixletterandtype{\Yappendixletterandtype2992,98536
+\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98566
+\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98621
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98725
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98796
+ \def\linenumber{\linenumber3009,99135
+\def\refx#1#2{\refx3015,99319
+\def\xrdef #1#2{\xrdef3037,99945
+\def\readauxfile{\readauxfile3040,100030
+\def\supereject{\supereject3110,101811
+\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102496
+\def\openindices{\openindices3139,102682
+\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102907
+\parindent = \defaultparindentaultparindent3152,102959
+\def\smallbook{\smallbook3175,103683
+\global\def\Esmallexample{\Esmallexample3192,104110
+\def\afourpaper{\afourpaper3196,104201
+\def\finalout{\finalout3224,105009
+\def\normaldoublequote{\normaldoublequote3235,105270
+\def\normaltilde{\normaltilde3236,105296
+\def\normalcaret{\normalcaret3237,105316
+\def\normalunderscore{\normalunderscore3238,105336
+\def\normalverticalbar{\normalverticalbar3239,105361
+\def\normalless{\normalless3240,105387
+\def\normalgreater{\normalgreater3241,105406
+\def\normalplus{\normalplus3242,105428
+\def\ifusingtt#1#2{\ifusingtt3253,105920
+\def\activedoublequote{\activedoublequote3261,106248
+\def~{~3264,106334
+\def^{^3267,106395
+\def_{_3270,106434
+\def\_{\_3272,106508
+\def\lvvmode{\lvvmode3279,106845
+\def|{|3282,106895
+\def<{<3285,106958
+\def>{>3288,107015
+\def+{+3290,107053
+\def\turnoffactive{\turnoffactive3296,107214
+\global\def={=3307,107500
+\def\normalbackslash{\normalbackslash3321,107882
+
+merc-src/accumulator.m,3228
+:- interface146,5371
+:- import_module hlds148,5386
+:- import_module univ152,5478
+:- pred accu_transform_proc159,5793
+:- implementation166,6115
+:- import_module libs180,6552
+:- import_module mdbcomp184,6681
+:- import_module parse_tree186,6742
+:- import_module assoc_list194,7013
+:- import_module bool195,7042
+:- import_module int196,7065
+:- import_module io197,7087
+:- import_module list198,7108
+:- import_module map199,7131
+:- import_module maybe200,7153
+:- import_module pair201,7177
+:- import_module require202,7200
+:- import_module set203,7226
+:- import_module solutions204,7248
+:- import_module string205,7276
+:- import_module term206,7301
+:- import_module varset207,7324
+:- type top_level213,7499
+:- type accu_goal_id225,7900
+:- type accu_case228,7964
+:- type accu_goal_store234,8091
+:- type accu_subst238,8216
+:- type accu_warning240,8264
+:- pred generate_warnings334,12550
+:- pred generate_warning342,12895
+:- pred should_attempt_accu_transform365,13886
+:- pred should_attempt_accu_transform_2398,15406
+:- pred accu_standardize440,17390
+:- pred identify_goal_type465,18169
+:- pred is_recursive_case549,21175
+:- type store_info560,21713
+:- func initialize_goal_store570,22060
+:- pred accu_store580,22421
+:- pred identify_recursive_calls601,23288
+:- pred identify_out_and_out_prime626,24396
+:- type accu_sets676,26425
+:- pred accu_stage1689,26977
+:- pred accu_stage1_2727,28347
+:- pred accu_sets_init781,30557
+:- func set_upto796,30984
+:- pred accu_before812,31498
+:- pred accu_assoc835,32477
+:- pred accu_construct862,33712
+:- pred accu_construct_assoc896,35307
+:- pred accu_update938,37069
+:- pred member_lessthan_goalid964,38219
+:- type accu_assoc975,38652
+:- pred accu_is_associative986,39138
+:- pred associativity_assertion1014,40263
+:- pred commutativity_assertion1037,41242
+:- pred accu_is_update1057,41952
+:- pred is_associative_construction1078,42802
+:- type accu_substs1095,43480
+:- type accu_base1103,43744
+:- pred accu_stage21124,44605
+:- pred accu_substs_init1179,46957
+:- pred acc_var_subst_init1194,47573
+:- pred create_new_var1207,48147
+:- pred accu_process_assoc_set1223,48862
+:- pred accu_has_heuristic1297,52081
+:- pred accu_heuristic1304,52336
+:- pred accu_process_update_set1318,52906
+:- pred accu_divide_base_case1380,55844
+:- pred accu_related1412,57146
+:- inst stored_goal_plain_call1444,58415
+:- pred lookup_call1449,58601
+:- pred accu_stage31470,59432
+:- pred acc_proc_info1508,61326
+:- pred acc_pred_info1556,63449
+:- pred accu_create_goal1600,65285
+:- func create_acc_call1621,66400
+:- pred create_orig_goal1634,66987
+:- pred create_acc_goal1662,68157
+:- func create_new_orig_recursive_goals1709,70225
+:- func create_new_recursive_goals1723,70918
+:- func create_new_base_goals1738,71717
+:- pred acc_unification1749,72156
+:- pred accu_top_level1766,72896
+:- pred update_accumulator_pred1856,76290
+:- func accu_rename1876,77253
+:- func base_case_ids1889,77784
+:- func base_case_ids_set1898,78048
+:- func accu_goal_list1905,78269
+:- pred calculate_goal_info1916,78680
+:- func chain_subst1932,79319
+:- pred chain_subst_21938,79482
+:- some [T] pred unravel_univ1956,80060
+:- pragma foreign_export1957,80116
c-src/c.c,76
T f(1,0
@@ -4406,13 +4504,13 @@ yyerror FUN1(286,5948
make_list FUN2(293,6028
#define ERROR 304,6228
yylex FUN0(315,6405
-parse_cell_or_range FUN2(587,11771
-#define CK_ABS_R(671,13213
-#define CK_REL_R(675,13292
-#define CK_ABS_C(680,13421
-#define CK_REL_C(684,13500
-#define MAYBEREL(689,13629
-str_to_col FUN1(847,16830
+parse_cell_or_range FUN2(587,11772
+#define CK_ABS_R(671,13214
+#define CK_REL_R(675,13293
+#define CK_ABS_C(680,13422
+#define CK_REL_C(684,13501
+#define MAYBEREL(689,13630
+str_to_col FUN1(847,16831
y-src/parse.c,520
#define YYBISON 4,64
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 15f67c5d28a..e726a993a91 100644
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -175,7 +175,7 @@ package body Truc.Bidule Truc.Bidule/b138,2153
protected body Bidule Bidule/b139,2181
protected body Machin_T Machin_T/b146,2281
-c-src/abbrev.c,3274
+c-src/abbrev.c,3055
Lisp_Object Vabbrev_table_name_list;43,1429
Lisp_Object Vglobal_abbrev_table;48,1574
Lisp_Object Vfundamental_mode_abbrev_table;52,1685
@@ -186,57 +186,53 @@ Lisp_Object Vabbrev_start_location_buffer;66,2046
Lisp_Object Vlast_abbrev;70,2155
Lisp_Object Vlast_abbrev_text;75,2324
int last_abbrev_point;79,2414
-Lisp_Object Vpre_abbrev_expand_hook,83,2487
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;83,2487
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,85,2551
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table85,2551
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,92,2743
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table92,2743
-DEFUN ("define-abbrev", Fdefine_abbrev,107,3124
-DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev107,3124
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,149,4443
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev149,4443
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,160,4814
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev160,4814
-DEFUN ("abbrev-symbol", Fabbrev_symbol,174,5282
-DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol174,5282
-DEFUN ("abbrev-expansion", Fabbrev_expansion,202,6246
-DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion202,6246
-DEFUN ("expand-abbrev", Fexpand_abbrev,218,6761
-DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev218,6761
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,389,11682
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev389,11682
-write_abbrev 426,12889
-describe_abbrev 445,13324
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,466,13839
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description466,13839
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,506,14995
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table506,14995
-syms_of_abbrev 540,16072
- DEFVAR_LISP ("abbrev-table-name-list"542,16092
- DEFVAR_LISP ("global-abbrev-table"548,16354
- DEFVAR_LISP ("fundamental-mode-abbrev-table"555,16676
- DEFVAR_LISP ("last-abbrev"561,17018
- DEFVAR_LISP ("last-abbrev-text"564,17141
- DEFVAR_INT ("last-abbrev-location"568,17299
- DEFVAR_LISP ("abbrev-start-location"575,17498
- DEFVAR_LISP ("abbrev-start-location-buffer"581,17775
- DEFVAR_PER_BUFFER ("local-abbrev-table"586,18039
- DEFVAR_BOOL ("abbrevs-changed"589,18182
- DEFVAR_BOOL ("abbrev-all-caps"594,18385
- DEFVAR_LISP ("pre-abbrev-expand-hook"598,18541
- DEFVAR_LISP ("abbrev-table-name-list",\1542,16092
- DEFVAR_LISP ("global-abbrev-table",\1548,16354
- DEFVAR_LISP ("fundamental-mode-abbrev-table",\1555,16676
- DEFVAR_LISP ("last-abbrev",\1561,17018
- DEFVAR_LISP ("last-abbrev-text",\1564,17141
- DEFVAR_INT ("last-abbrev-location",\1568,17299
- DEFVAR_LISP ("abbrev-start-location",\1575,17498
- DEFVAR_LISP ("abbrev-start-location-buffer",\1581,17775
- DEFVAR_PER_BUFFER ("local-abbrev-table",\1586,18039
- DEFVAR_BOOL ("abbrevs-changed",\1589,18182
- DEFVAR_BOOL ("abbrev-all-caps",\1594,18385
- DEFVAR_LISP ("pre-abbrev-expand-hook",\1598,18541
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,82,2440
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table82,2440
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,89,2632
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table89,2632
+DEFUN ("define-abbrev", Fdefine_abbrev,104,3013
+DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev104,3013
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,146,4332
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev146,4332
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,157,4703
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev157,4703
+DEFUN ("abbrev-symbol", Fabbrev_symbol,171,5171
+DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol171,5171
+DEFUN ("abbrev-expansion", Fabbrev_expansion,199,6135
+DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion199,6135
+DEFUN ("expand-abbrev", Fexpand_abbrev,215,6650
+DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev215,6650
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,383,11495
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev383,11495
+write_abbrev 420,12702
+describe_abbrev 439,13137
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,460,13652
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description460,13652
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,500,14808
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table500,14808
+syms_of_abbrev 534,15885
+ DEFVAR_LISP ("abbrev-table-name-list"536,15905
+ DEFVAR_LISP ("global-abbrev-table"542,16167
+ DEFVAR_LISP ("fundamental-mode-abbrev-table"549,16489
+ DEFVAR_LISP ("last-abbrev"555,16831
+ DEFVAR_LISP ("last-abbrev-text"558,16954
+ DEFVAR_INT ("last-abbrev-location"562,17112
+ DEFVAR_LISP ("abbrev-start-location"569,17311
+ DEFVAR_LISP ("abbrev-start-location-buffer"575,17588
+ DEFVAR_PER_BUFFER ("local-abbrev-table"580,17852
+ DEFVAR_BOOL ("abbrevs-changed"583,17995
+ DEFVAR_BOOL ("abbrev-all-caps"588,18198
+ DEFVAR_LISP ("abbrev-table-name-list",\1536,15905
+ DEFVAR_LISP ("global-abbrev-table",\1542,16167
+ DEFVAR_LISP ("fundamental-mode-abbrev-table",\1549,16489
+ DEFVAR_LISP ("last-abbrev",\1555,16831
+ DEFVAR_LISP ("last-abbrev-text",\1558,16954
+ DEFVAR_INT ("last-abbrev-location",\1562,17112
+ DEFVAR_LISP ("abbrev-start-location",\1569,17311
+ DEFVAR_LISP ("abbrev-start-location-buffer",\1575,17588
+ DEFVAR_PER_BUFFER ("local-abbrev-table",\1580,17852
+ DEFVAR_BOOL ("abbrevs-changed",\1583,17995
+ DEFVAR_BOOL ("abbrev-all-caps",\1588,18198
c-src/torture.c,197
(*tag1 tag118,452
@@ -1063,295 +1059,295 @@ make_lispy_position 5228,157391
toolkit_menubar_in_use 5456,163954
make_scroll_bar_position 5469,164322
make_lispy_event 5485,164968
-make_lispy_movement 6104,183532
-make_lispy_switch_frame 6131,184263
-make_lispy_focus_in 6137,184370
-make_lispy_focus_out 6145,184496
-parse_modifiers_uncached 6163,184946
-#define SINGLE_LETTER_MOD(6185,185466
-#undef SINGLE_LETTER_MOD6212,185907
-#define MULTI_LETTER_MOD(6214,185933
-#undef MULTI_LETTER_MOD6231,186401
-apply_modifiers_uncached 6273,187575
-static const char *const modifier_names[modifier_names6319,189194
-#define NUM_MOD_NAMES 6325,189400
-static Lisp_Object modifier_symbols;6327,189450
-lispy_modifier_list 6331,189587
-#define KEY_TO_CHAR(6353,190253
-parse_modifiers 6356,190329
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191518
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191518
-apply_modifiers 6422,192392
-reorder_modifiers 6491,194721
-modify_event_symbol 6536,196529
-DEFUN ("event-convert-list", Fevent_convert_list,6628,199245
-DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199245
-parse_solitary_modifier 6695,201136
-#define SINGLE_LETTER_MOD(6701,201259
-#define MULTI_LETTER_MOD(6705,201344
-#undef SINGLE_LETTER_MOD6763,202642
-#undef MULTI_LETTER_MOD6764,202667
-lucid_event_type_list_p 6775,202890
-get_input_pending 6814,203961
-record_asynch_buffer_change 6834,204580
-gobble_input 6872,205703
-tty_read_avail_input 6967,208311
-handle_async_input 7149,214040
-process_pending_signals 7165,214360
-unblock_input_to 7177,214646
-unblock_input 7200,215278
-totally_unblock_input 7209,215446
-handle_input_available_signal 7217,215530
-deliver_input_available_signal 7226,215701
-struct user_signal_info7235,215866
-static struct user_signal_info *user_signals user_signals7250,216091
-add_user_signal 7253,216150
-handle_user_signal 7275,216599
-deliver_user_signal 7316,217559
-find_user_signal_name 7322,217660
-store_user_signal_events 7334,217842
-static Lisp_Object menu_bar_one_keymap_changed_items;7363,218417
-static Lisp_Object menu_bar_items_vector;7368,218631
-static int menu_bar_items_index;7369,218673
-static const char *separator_names[separator_names7372,218708
-menu_separator_name_p 7393,219149
-menu_bar_items 7426,219853
-Lisp_Object item_properties;7568,224604
-menu_bar_item 7571,224646
-menu_item_eval_property_1 7647,227176
-eval_dyn 7658,227466
-menu_item_eval_property 7666,227676
-parse_menu_item 7686,228342
-static Lisp_Object tool_bar_items_vector;7965,236337
-static Lisp_Object tool_bar_item_properties;7970,236511
-static int ntool_bar_items;7974,236607
-tool_bar_items 7990,237084
-process_tool_bar_item 8075,239893
-#define PROP(8112,240970
-set_prop 8114,241039
-parse_tool_bar_item 8167,242454
-#undef PROP8379,248845
-init_tool_bar_items 8387,248970
-append_tool_bar_item 8401,249262
-read_char_x_menu_prompt 8443,250772
-read_char_minibuf_menu_prompt 8503,252446
-#define PUSH_C_STR(8527,253015
-follow_key 8726,258554
-active_maps 8733,258696
-typedef struct keyremap8742,259022
-} keyremap;8754,259465
-access_keymap_keyremap 8764,259809
-keyremap_step 8811,261451
-test_undefined 8867,262935
-read_key_sequence 8916,264862
-read_key_sequence_vs 9826,295822
-DEFUN ("read-key-sequence", Fread_key_sequence,9885,297295
-DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297295
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299983
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299983
-detect_input_pending 9950,300489
-detect_input_pending_ignore_squeezables 9959,300655
-detect_input_pending_run_timers 9967,300871
-clear_input_pending 9985,301363
-requeued_events_pending_p 9997,301733
-DEFUN ("input-pending-p", Finput_pending_p,10002,301814
-DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301814
-DEFUN ("recent-keys", Frecent_keys,10024,302597
-DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302597
-DEFUN ("this-command-keys", Fthis_command_keys,10055,303518
-DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303518
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303959
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303959
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304381
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304381
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304956
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304956
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305496
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305496
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306511
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306511
-DEFUN ("recursion-depth", Frecursion_depth,10158,307070
-DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307070
-DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307407
-DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307407
-DEFUN ("discard-input", Fdiscard_input,10203,308448
-DEFUN ("discard-input", Fdiscard_input,discard-input10203,308448
-DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308950
-DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308950
-stuff_buffered_input 10285,311046
-set_waiting_for_input 10323,312017
-clear_waiting_for_input 10337,312391
-handle_interrupt_signal 10351,312755
-deliver_interrupt_signal 10378,313643
-static int volatile force_quit_count;10387,313933
-handle_interrupt 10401,314415
-quit_throw_to_read_char 10541,318712
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319289
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319289
-DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320517
-DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320517
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321433
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321433
-DEFUN ("set-quit-char", Fset_quit_char,10694,322707
-DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322707
-DEFUN ("set-input-mode", Fset_input_mode,10729,323571
-DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323571
-DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324460
-DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324460
-DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325838
-DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325838
-DEFUN ("posn-at-point", Fposn_at_point,10824,327061
-DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327061
-init_kboard 10861,328215
-allocate_kboard 10893,329285
-wipe_kboard 10909,329638
-delete_kboard 10917,329752
-init_keyboard 10942,330282
-struct event_head11021,332697
-static const struct event_head head_table[head_table11027,332748
-syms_of_keyboard 11045,333578
- DEFVAR_LISP ("internal--top-level-message"11058,333973
- DEFVAR_LISP ("last-command-event"11312,342174
- DEFVAR_LISP ("last-nonmenu-event"11315,342298
- DEFVAR_LISP ("last-input-event"11321,342637
- DEFVAR_LISP ("unread-command-events"11324,342731
- DEFVAR_LISP ("unread-post-input-method-events"11332,343191
- DEFVAR_LISP ("unread-input-method-events"11338,343530
- DEFVAR_LISP ("meta-prefix-char"11346,343899
- DEFVAR_KBOARD ("last-command"11351,344107
- DEFVAR_KBOARD ("real-last-command"11368,344788
- DEFVAR_KBOARD ("last-repeatable-command"11372,344974
- DEFVAR_LISP ("this-command"11378,345262
- DEFVAR_LISP ("real-this-command"11384,345499
- DEFVAR_LISP ("this-command-keys-shift-translated"11388,345681
- DEFVAR_LISP ("this-original-command"11396,346124
- DEFVAR_INT ("auto-save-interval"11403,346521
- DEFVAR_LISP ("auto-save-timeout"11408,346735
- DEFVAR_LISP ("echo-keystrokes"11415,347080
- DEFVAR_INT ("polling-period"11421,347351
- DEFVAR_LISP ("double-click-time"11428,347694
- DEFVAR_INT ("double-click-fuzz"11435,348030
- DEFVAR_INT ("num-input-keys"11446,348520
- DEFVAR_INT ("num-nonmacro-input-events"11452,348795
- DEFVAR_LISP ("last-event-frame"11457,349033
- DEFVAR_LISP ("tty-erase-char"11463,349312
- DEFVAR_LISP ("help-char"11466,349435
- DEFVAR_LISP ("help-event-list"11472,349718
- DEFVAR_LISP ("help-form"11477,349929
- DEFVAR_LISP ("prefix-help-command"11483,350177
- DEFVAR_LISP ("top-level"11489,350455
- DEFVAR_KBOARD ("keyboard-translate-table"11495,350676
- DEFVAR_BOOL ("cannot-suspend"11511,351489
- DEFVAR_BOOL ("menu-prompting"11516,351716
- DEFVAR_LISP ("menu-prompt-more-char"11526,352146
- DEFVAR_INT ("extra-keyboard-modifiers"11531,352392
- DEFVAR_LISP ("deactivate-mark"11545,353118
- DEFVAR_LISP ("pre-command-hook"11553,353487
- DEFVAR_LISP ("post-command-hook"11560,353842
- DEFVAR_LISP ("echo-area-clear-hook"11568,354205
- DEFVAR_LISP ("lucid-menu-bar-dirty-flag"11574,354420
- DEFVAR_LISP ("menu-bar-final-items"11578,354623
- DEFVAR_LISP ("tool-bar-separator-image-expression"11583,354873
- DEFVAR_KBOARD ("overriding-terminal-local-map"11589,355231
- DEFVAR_LISP ("overriding-local-map"11598,355653
- DEFVAR_LISP ("overriding-local-map-menu-flag"11607,356104
- DEFVAR_LISP ("special-event-map"11613,356443
- DEFVAR_LISP ("track-mouse"11617,356631
- DEFVAR_KBOARD ("system-key-alist"11620,356758
- DEFVAR_KBOARD ("local-function-key-map"11629,357139
- DEFVAR_KBOARD ("input-decode-map"11658,358598
- DEFVAR_LISP ("function-key-map"11675,359386
- DEFVAR_LISP ("key-translation-map"11683,359802
- DEFVAR_LISP ("deferred-action-list"11689,360146
- DEFVAR_LISP ("deferred-action-function"11694,360394
- DEFVAR_LISP ("delayed-warnings-list"11700,360693
- DEFVAR_LISP ("timer-list"11708,361101
- DEFVAR_LISP ("timer-idle-list"11712,361253
- DEFVAR_LISP ("input-method-function"11716,361416
- DEFVAR_LISP ("input-method-previous-message"11737,362385
- DEFVAR_LISP ("show-help-function"11744,362746
- DEFVAR_LISP ("disable-point-adjustment"11749,362978
- DEFVAR_LISP ("global-disable-point-adjustment"11761,363528
- DEFVAR_LISP ("minibuffer-message-timeout"11770,363894
- DEFVAR_LISP ("throw-on-input"11775,364172
- DEFVAR_LISP ("command-error-function"11781,364423
- DEFVAR_LISP ("enable-disabled-menus-and-buttons"11790,364910
- DEFVAR_LISP ("select-active-regions"11798,365237
- DEFVAR_LISP ("saved-region-selection"11807,365629
- DEFVAR_LISP ("selection-inhibit-update-commands"11815,366014
- DEFVAR_LISP ("debug-on-event"11825,366555
-keys_of_keyboard 11841,367116
-mark_kboards 11916,370435
- DEFVAR_LISP ("internal--top-level-message",\111058,333973
- DEFVAR_LISP ("last-command-event",\111312,342174
- DEFVAR_LISP ("last-nonmenu-event",\111315,342298
- DEFVAR_LISP ("last-input-event",\111321,342637
- DEFVAR_LISP ("unread-command-events",\111324,342731
- DEFVAR_LISP ("unread-post-input-method-events",\111332,343191
- DEFVAR_LISP ("unread-input-method-events",\111338,343530
- DEFVAR_LISP ("meta-prefix-char",\111346,343899
- DEFVAR_KBOARD ("last-command",\111351,344107
- DEFVAR_KBOARD ("real-last-command",\111368,344788
- DEFVAR_KBOARD ("last-repeatable-command",\111372,344974
- DEFVAR_LISP ("this-command",\111378,345262
- DEFVAR_LISP ("real-this-command",\111384,345499
- DEFVAR_LISP ("this-command-keys-shift-translated",\111388,345681
- DEFVAR_LISP ("this-original-command",\111396,346124
- DEFVAR_INT ("auto-save-interval",\111403,346521
- DEFVAR_LISP ("auto-save-timeout",\111408,346735
- DEFVAR_LISP ("echo-keystrokes",\111415,347080
- DEFVAR_INT ("polling-period",\111421,347351
- DEFVAR_LISP ("double-click-time",\111428,347694
- DEFVAR_INT ("double-click-fuzz",\111435,348030
- DEFVAR_INT ("num-input-keys",\111446,348520
- DEFVAR_INT ("num-nonmacro-input-events",\111452,348795
- DEFVAR_LISP ("last-event-frame",\111457,349033
- DEFVAR_LISP ("tty-erase-char",\111463,349312
- DEFVAR_LISP ("help-char",\111466,349435
- DEFVAR_LISP ("help-event-list",\111472,349718
- DEFVAR_LISP ("help-form",\111477,349929
- DEFVAR_LISP ("prefix-help-command",\111483,350177
- DEFVAR_LISP ("top-level",\111489,350455
- DEFVAR_KBOARD ("keyboard-translate-table",\111495,350676
- DEFVAR_BOOL ("cannot-suspend",\111511,351489
- DEFVAR_BOOL ("menu-prompting",\111516,351716
- DEFVAR_LISP ("menu-prompt-more-char",\111526,352146
- DEFVAR_INT ("extra-keyboard-modifiers",\111531,352392
- DEFVAR_LISP ("deactivate-mark",\111545,353118
- DEFVAR_LISP ("pre-command-hook",\111553,353487
- DEFVAR_LISP ("post-command-hook",\111560,353842
- DEFVAR_LISP ("echo-area-clear-hook",\111568,354205
- DEFVAR_LISP ("lucid-menu-bar-dirty-flag",\111574,354420
- DEFVAR_LISP ("menu-bar-final-items",\111578,354623
- DEFVAR_LISP ("tool-bar-separator-image-expression",\111583,354873
- DEFVAR_KBOARD ("overriding-terminal-local-map",\111589,355231
- DEFVAR_LISP ("overriding-local-map",\111598,355653
- DEFVAR_LISP ("overriding-local-map-menu-flag",\111607,356104
- DEFVAR_LISP ("special-event-map",\111613,356443
- DEFVAR_LISP ("track-mouse",\111617,356631
- DEFVAR_KBOARD ("system-key-alist",\111620,356758
- DEFVAR_KBOARD ("local-function-key-map",\111629,357139
- DEFVAR_KBOARD ("input-decode-map",\111658,358598
- DEFVAR_LISP ("function-key-map",\111675,359386
- DEFVAR_LISP ("key-translation-map",\111683,359802
- DEFVAR_LISP ("deferred-action-list",\111689,360146
- DEFVAR_LISP ("deferred-action-function",\111694,360394
- DEFVAR_LISP ("delayed-warnings-list",\111700,360693
- DEFVAR_LISP ("timer-list",\111708,361101
- DEFVAR_LISP ("timer-idle-list",\111712,361253
- DEFVAR_LISP ("input-method-function",\111716,361416
- DEFVAR_LISP ("input-method-previous-message",\111737,362385
- DEFVAR_LISP ("show-help-function",\111744,362746
- DEFVAR_LISP ("disable-point-adjustment",\111749,362978
- DEFVAR_LISP ("global-disable-point-adjustment",\111761,363528
- DEFVAR_LISP ("minibuffer-message-timeout",\111770,363894
- DEFVAR_LISP ("throw-on-input",\111775,364172
- DEFVAR_LISP ("command-error-function",\111781,364423
- DEFVAR_LISP ("enable-disabled-menus-and-buttons",\111790,364910
- DEFVAR_LISP ("select-active-regions",\111798,365237
- DEFVAR_LISP ("saved-region-selection",\111807,365629
- DEFVAR_LISP ("selection-inhibit-update-commands",\111815,366014
- DEFVAR_LISP ("debug-on-event",\111825,366555
+make_lispy_movement 6104,183531
+make_lispy_switch_frame 6131,184262
+make_lispy_focus_in 6137,184369
+make_lispy_focus_out 6145,184495
+parse_modifiers_uncached 6163,184945
+#define SINGLE_LETTER_MOD(6185,185465
+#undef SINGLE_LETTER_MOD6212,185906
+#define MULTI_LETTER_MOD(6214,185932
+#undef MULTI_LETTER_MOD6231,186400
+apply_modifiers_uncached 6273,187574
+static const char *const modifier_names[modifier_names6319,189193
+#define NUM_MOD_NAMES 6325,189399
+static Lisp_Object modifier_symbols;6327,189449
+lispy_modifier_list 6331,189586
+#define KEY_TO_CHAR(6353,190252
+parse_modifiers 6356,190328
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191517
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191517
+apply_modifiers 6422,192391
+reorder_modifiers 6491,194720
+modify_event_symbol 6536,196528
+DEFUN ("event-convert-list", Fevent_convert_list,6628,199244
+DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199244
+parse_solitary_modifier 6695,201135
+#define SINGLE_LETTER_MOD(6701,201258
+#define MULTI_LETTER_MOD(6705,201343
+#undef SINGLE_LETTER_MOD6763,202641
+#undef MULTI_LETTER_MOD6764,202666
+lucid_event_type_list_p 6775,202889
+get_input_pending 6814,203960
+record_asynch_buffer_change 6834,204579
+gobble_input 6872,205702
+tty_read_avail_input 6967,208310
+handle_async_input 7149,214039
+process_pending_signals 7165,214359
+unblock_input_to 7177,214645
+unblock_input 7200,215277
+totally_unblock_input 7209,215445
+handle_input_available_signal 7217,215529
+deliver_input_available_signal 7226,215700
+struct user_signal_info7235,215865
+static struct user_signal_info *user_signals user_signals7250,216090
+add_user_signal 7253,216149
+handle_user_signal 7275,216598
+deliver_user_signal 7316,217558
+find_user_signal_name 7322,217659
+store_user_signal_events 7334,217841
+static Lisp_Object menu_bar_one_keymap_changed_items;7363,218416
+static Lisp_Object menu_bar_items_vector;7368,218630
+static int menu_bar_items_index;7369,218672
+static const char *separator_names[separator_names7372,218707
+menu_separator_name_p 7393,219148
+menu_bar_items 7426,219852
+Lisp_Object item_properties;7568,224603
+menu_bar_item 7571,224645
+menu_item_eval_property_1 7647,227175
+eval_dyn 7658,227465
+menu_item_eval_property 7666,227675
+parse_menu_item 7686,228341
+static Lisp_Object tool_bar_items_vector;7965,236336
+static Lisp_Object tool_bar_item_properties;7970,236510
+static int ntool_bar_items;7974,236606
+tool_bar_items 7990,237083
+process_tool_bar_item 8075,239892
+#define PROP(8112,240969
+set_prop 8114,241038
+parse_tool_bar_item 8167,242453
+#undef PROP8379,248844
+init_tool_bar_items 8387,248969
+append_tool_bar_item 8401,249261
+read_char_x_menu_prompt 8443,250771
+read_char_minibuf_menu_prompt 8503,252445
+#define PUSH_C_STR(8527,253014
+follow_key 8726,258553
+active_maps 8733,258695
+typedef struct keyremap8742,259021
+} keyremap;8754,259464
+access_keymap_keyremap 8764,259808
+keyremap_step 8811,261450
+test_undefined 8867,262934
+read_key_sequence 8916,264861
+read_key_sequence_vs 9826,295821
+DEFUN ("read-key-sequence", Fread_key_sequence,9885,297294
+DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297294
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299982
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299982
+detect_input_pending 9950,300488
+detect_input_pending_ignore_squeezables 9959,300654
+detect_input_pending_run_timers 9967,300870
+clear_input_pending 9985,301362
+requeued_events_pending_p 9997,301732
+DEFUN ("input-pending-p", Finput_pending_p,10002,301813
+DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301813
+DEFUN ("recent-keys", Frecent_keys,10024,302596
+DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302596
+DEFUN ("this-command-keys", Fthis_command_keys,10055,303517
+DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303517
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303958
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303958
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304380
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304380
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304955
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304955
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305495
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305495
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306510
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306510
+DEFUN ("recursion-depth", Frecursion_depth,10158,307069
+DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307069
+DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307406
+DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307406
+DEFUN ("discard-input", Fdiscard_input,10203,308447
+DEFUN ("discard-input", Fdiscard_input,discard-input10203,308447
+DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308949
+DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308949
+stuff_buffered_input 10285,311045
+set_waiting_for_input 10323,312016
+clear_waiting_for_input 10337,312390
+handle_interrupt_signal 10351,312754
+deliver_interrupt_signal 10378,313642
+static int volatile force_quit_count;10387,313932
+handle_interrupt 10401,314414
+quit_throw_to_read_char 10541,318711
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319288
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319288
+DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320516
+DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320516
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321432
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321432
+DEFUN ("set-quit-char", Fset_quit_char,10694,322706
+DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322706
+DEFUN ("set-input-mode", Fset_input_mode,10729,323570
+DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323570
+DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324459
+DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324459
+DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325837
+DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325837
+DEFUN ("posn-at-point", Fposn_at_point,10824,327060
+DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327060
+init_kboard 10861,328214
+allocate_kboard 10893,329284
+wipe_kboard 10909,329637
+delete_kboard 10917,329751
+init_keyboard 10942,330281
+struct event_head11021,332696
+static const struct event_head head_table[head_table11027,332747
+syms_of_keyboard 11045,333577
+ DEFVAR_LISP ("internal--top-level-message"11058,333972
+ DEFVAR_LISP ("last-command-event"11312,342173
+ DEFVAR_LISP ("last-nonmenu-event"11315,342297
+ DEFVAR_LISP ("last-input-event"11321,342636
+ DEFVAR_LISP ("unread-command-events"11324,342730
+ DEFVAR_LISP ("unread-post-input-method-events"11332,343190
+ DEFVAR_LISP ("unread-input-method-events"11338,343529
+ DEFVAR_LISP ("meta-prefix-char"11346,343898
+ DEFVAR_KBOARD ("last-command"11351,344106
+ DEFVAR_KBOARD ("real-last-command"11368,344787
+ DEFVAR_KBOARD ("last-repeatable-command"11372,344973
+ DEFVAR_LISP ("this-command"11378,345261
+ DEFVAR_LISP ("real-this-command"11384,345498
+ DEFVAR_LISP ("this-command-keys-shift-translated"11388,345680
+ DEFVAR_LISP ("this-original-command"11396,346123
+ DEFVAR_INT ("auto-save-interval"11403,346520
+ DEFVAR_LISP ("auto-save-timeout"11408,346734
+ DEFVAR_LISP ("echo-keystrokes"11415,347079
+ DEFVAR_INT ("polling-period"11421,347350
+ DEFVAR_LISP ("double-click-time"11428,347693
+ DEFVAR_INT ("double-click-fuzz"11435,348029
+ DEFVAR_INT ("num-input-keys"11446,348519
+ DEFVAR_INT ("num-nonmacro-input-events"11452,348794
+ DEFVAR_LISP ("last-event-frame"11457,349032
+ DEFVAR_LISP ("tty-erase-char"11463,349311
+ DEFVAR_LISP ("help-char"11466,349434
+ DEFVAR_LISP ("help-event-list"11472,349717
+ DEFVAR_LISP ("help-form"11477,349928
+ DEFVAR_LISP ("prefix-help-command"11483,350176
+ DEFVAR_LISP ("top-level"11489,350454
+ DEFVAR_KBOARD ("keyboard-translate-table"11495,350675
+ DEFVAR_BOOL ("cannot-suspend"11511,351488
+ DEFVAR_BOOL ("menu-prompting"11516,351715
+ DEFVAR_LISP ("menu-prompt-more-char"11526,352145
+ DEFVAR_INT ("extra-keyboard-modifiers"11531,352391
+ DEFVAR_LISP ("deactivate-mark"11545,353117
+ DEFVAR_LISP ("pre-command-hook"11553,353486
+ DEFVAR_LISP ("post-command-hook"11560,353841
+ DEFVAR_LISP ("echo-area-clear-hook"11568,354204
+ DEFVAR_LISP ("lucid-menu-bar-dirty-flag"11574,354419
+ DEFVAR_LISP ("menu-bar-final-items"11578,354622
+ DEFVAR_LISP ("tool-bar-separator-image-expression"11583,354872
+ DEFVAR_KBOARD ("overriding-terminal-local-map"11589,355230
+ DEFVAR_LISP ("overriding-local-map"11598,355652
+ DEFVAR_LISP ("overriding-local-map-menu-flag"11607,356103
+ DEFVAR_LISP ("special-event-map"11613,356442
+ DEFVAR_LISP ("track-mouse"11617,356630
+ DEFVAR_KBOARD ("system-key-alist"11620,356757
+ DEFVAR_KBOARD ("local-function-key-map"11629,357138
+ DEFVAR_KBOARD ("input-decode-map"11658,358597
+ DEFVAR_LISP ("function-key-map"11675,359385
+ DEFVAR_LISP ("key-translation-map"11683,359801
+ DEFVAR_LISP ("deferred-action-list"11689,360145
+ DEFVAR_LISP ("deferred-action-function"11694,360393
+ DEFVAR_LISP ("delayed-warnings-list"11700,360692
+ DEFVAR_LISP ("timer-list"11708,361100
+ DEFVAR_LISP ("timer-idle-list"11712,361252
+ DEFVAR_LISP ("input-method-function"11716,361415
+ DEFVAR_LISP ("input-method-previous-message"11737,362384
+ DEFVAR_LISP ("show-help-function"11744,362745
+ DEFVAR_LISP ("disable-point-adjustment"11749,362977
+ DEFVAR_LISP ("global-disable-point-adjustment"11761,363527
+ DEFVAR_LISP ("minibuffer-message-timeout"11770,363893
+ DEFVAR_LISP ("throw-on-input"11775,364171
+ DEFVAR_LISP ("command-error-function"11781,364422
+ DEFVAR_LISP ("enable-disabled-menus-and-buttons"11790,364909
+ DEFVAR_LISP ("select-active-regions"11798,365236
+ DEFVAR_LISP ("saved-region-selection"11807,365628
+ DEFVAR_LISP ("selection-inhibit-update-commands"11815,366013
+ DEFVAR_LISP ("debug-on-event"11825,366554
+keys_of_keyboard 11841,367115
+mark_kboards 11916,370434
+ DEFVAR_LISP ("internal--top-level-message",\111058,333972
+ DEFVAR_LISP ("last-command-event",\111312,342173
+ DEFVAR_LISP ("last-nonmenu-event",\111315,342297
+ DEFVAR_LISP ("last-input-event",\111321,342636
+ DEFVAR_LISP ("unread-command-events",\111324,342730
+ DEFVAR_LISP ("unread-post-input-method-events",\111332,343190
+ DEFVAR_LISP ("unread-input-method-events",\111338,343529
+ DEFVAR_LISP ("meta-prefix-char",\111346,343898
+ DEFVAR_KBOARD ("last-command",\111351,344106
+ DEFVAR_KBOARD ("real-last-command",\111368,344787
+ DEFVAR_KBOARD ("last-repeatable-command",\111372,344973
+ DEFVAR_LISP ("this-command",\111378,345261
+ DEFVAR_LISP ("real-this-command",\111384,345498
+ DEFVAR_LISP ("this-command-keys-shift-translated",\111388,345680
+ DEFVAR_LISP ("this-original-command",\111396,346123
+ DEFVAR_INT ("auto-save-interval",\111403,346520
+ DEFVAR_LISP ("auto-save-timeout",\111408,346734
+ DEFVAR_LISP ("echo-keystrokes",\111415,347079
+ DEFVAR_INT ("polling-period",\111421,347350
+ DEFVAR_LISP ("double-click-time",\111428,347693
+ DEFVAR_INT ("double-click-fuzz",\111435,348029
+ DEFVAR_INT ("num-input-keys",\111446,348519
+ DEFVAR_INT ("num-nonmacro-input-events",\111452,348794
+ DEFVAR_LISP ("last-event-frame",\111457,349032
+ DEFVAR_LISP ("tty-erase-char",\111463,349311
+ DEFVAR_LISP ("help-char",\111466,349434
+ DEFVAR_LISP ("help-event-list",\111472,349717
+ DEFVAR_LISP ("help-form",\111477,349928
+ DEFVAR_LISP ("prefix-help-command",\111483,350176
+ DEFVAR_LISP ("top-level",\111489,350454
+ DEFVAR_KBOARD ("keyboard-translate-table",\111495,350675
+ DEFVAR_BOOL ("cannot-suspend",\111511,351488
+ DEFVAR_BOOL ("menu-prompting",\111516,351715
+ DEFVAR_LISP ("menu-prompt-more-char",\111526,352145
+ DEFVAR_INT ("extra-keyboard-modifiers",\111531,352391
+ DEFVAR_LISP ("deactivate-mark",\111545,353117
+ DEFVAR_LISP ("pre-command-hook",\111553,353486
+ DEFVAR_LISP ("post-command-hook",\111560,353841
+ DEFVAR_LISP ("echo-area-clear-hook",\111568,354204
+ DEFVAR_LISP ("lucid-menu-bar-dirty-flag",\111574,354419
+ DEFVAR_LISP ("menu-bar-final-items",\111578,354622
+ DEFVAR_LISP ("tool-bar-separator-image-expression",\111583,354872
+ DEFVAR_KBOARD ("overriding-terminal-local-map",\111589,355230
+ DEFVAR_LISP ("overriding-local-map",\111598,355652
+ DEFVAR_LISP ("overriding-local-map-menu-flag",\111607,356103
+ DEFVAR_LISP ("special-event-map",\111613,356442
+ DEFVAR_LISP ("track-mouse",\111617,356630
+ DEFVAR_KBOARD ("system-key-alist",\111620,356757
+ DEFVAR_KBOARD ("local-function-key-map",\111629,357138
+ DEFVAR_KBOARD ("input-decode-map",\111658,358597
+ DEFVAR_LISP ("function-key-map",\111675,359385
+ DEFVAR_LISP ("key-translation-map",\111683,359801
+ DEFVAR_LISP ("deferred-action-list",\111689,360145
+ DEFVAR_LISP ("deferred-action-function",\111694,360393
+ DEFVAR_LISP ("delayed-warnings-list",\111700,360692
+ DEFVAR_LISP ("timer-list",\111708,361100
+ DEFVAR_LISP ("timer-idle-list",\111712,361252
+ DEFVAR_LISP ("input-method-function",\111716,361415
+ DEFVAR_LISP ("input-method-previous-message",\111737,362384
+ DEFVAR_LISP ("show-help-function",\111744,362745
+ DEFVAR_LISP ("disable-point-adjustment",\111749,362977
+ DEFVAR_LISP ("global-disable-point-adjustment",\111761,363527
+ DEFVAR_LISP ("minibuffer-message-timeout",\111770,363893
+ DEFVAR_LISP ("throw-on-input",\111775,364171
+ DEFVAR_LISP ("command-error-function",\111781,364422
+ DEFVAR_LISP ("enable-disabled-menus-and-buttons",\111790,364909
+ DEFVAR_LISP ("select-active-regions",\111798,365236
+ DEFVAR_LISP ("saved-region-selection",\111807,365628
+ DEFVAR_LISP ("selection-inhibit-update-commands",\111815,366013
+ DEFVAR_LISP ("debug-on-event",\111825,366554
c-src/emacs/src/lisp.h,20276
#define EMACS_LISP_H22,801
@@ -2307,11 +2303,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1035
@@ -3070,22 +3066,22 @@ ord_add_element(71,1867
ord_del_element(85,2344
ord_disjoint(100,2783
ord_intersect(108,2953
-ord_intersection(126,3552
-ord_intersection3(130,3691
-ord_intersection(150,4531
-ord_intersection4(154,4703
-ord_intersection(176,5664
-ord_intersection2(181,5812
-ord_member(200,6318
-ord_seteq(216,6683
-ord_setproduct(225,6971
-ord_subset(240,7377
-ord_subtract(257,7861
-ord_symdiff(265,8054
-ord_union(288,8887
-ord_union4(303,9352
-ord_union(324,10171
-ord_union_all(329,10313
+ord_intersection(126,3553
+ord_intersection3(130,3692
+ord_intersection(150,4533
+ord_intersection4(154,4705
+ord_intersection(176,5666
+ord_intersection2(181,5814
+ord_member(200,6320
+ord_seteq(216,6685
+ord_setproduct(225,6973
+ord_subset(240,7379
+ord_subtract(257,7863
+ord_symdiff(265,8056
+ord_union(288,8889
+ord_union4(303,9354
+ord_union(324,10173
+ord_union_all(329,10315
prol-src/natded.prolog,2319
expandmng(100,2879
@@ -3300,6 +3296,11 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+rs-src/test.rs,52
+enum IpAddrKind 3,11
+fn test1(8,48
+fn main(12,88
+
scm-src/test.scm,260
(define hello 1,0
(set! hello 3,32
@@ -3514,533 +3515,628 @@ tex-src/texinfo.tex,30627
\def\vritemindex #1{\vritemindex1068,35482
\def\tablez #1#2#3#4#5#6{\tablez1074,35631
\def\Edescription{\Edescription1077,35689
-\def\itemfont{\itemfont1082,35891
-\def\Etable{\Etable1090,36117
-\def\itemize{\itemize1103,36441
-\def\itemizezzz #1{\itemizezzz1105,36477
-\def\itemizey #1#2{\itemizey1110,36572
-\def#2{1119,36818
-\def\itemcontents{\itemcontents1120,36859
-\def\bullet{\bullet1123,36907
-\def\minus{\minus1124,36934
-\def\frenchspacing{\frenchspacing1128,37042
-\def\splitoff#1#2\endmark{\splitoff1134,37267
-\def\enumerate{\enumerate1140,37497
-\def\enumeratezzz #1{\enumeratezzz1141,37536
-\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37589
- \def\thearg{\thearg1146,37736
- \ifx\thearg\empty \def\thearg{\thearg1147,37755
-\def\numericenumerate{\numericenumerate1184,39089
-\def\lowercaseenumerate{\lowercaseenumerate1190,39219
-\def\uppercaseenumerate{\uppercaseenumerate1203,39566
-\def\startenumeration#1{\startenumeration1219,40056
-\def\alphaenumerate{\alphaenumerate1227,40238
-\def\capsenumerate{\capsenumerate1228,40273
-\def\Ealphaenumerate{\Ealphaenumerate1229,40307
-\def\Ecapsenumerate{\Ecapsenumerate1230,40341
-\def\itemizeitem{\itemizeitem1234,40421
-\def\newindex #1{\newindex1259,41278
-\def\defindex{\defindex1268,41567
-\def\newcodeindex #1{\newcodeindex1272,41675
-\def\defcodeindex{\defcodeindex1279,41935
-\def\synindex #1 #2 {\synindex1283,42115
-\def\syncodeindex #1 #2 {\syncodeindex1292,42455
-\def\doindex#1{\doindex1309,43134
-\def\singleindexer #1{\singleindexer1310,43193
-\def\docodeindex#1{\docodeindex1313,43305
-\def\singlecodeindexer #1{\singlecodeindexer1314,43372
-\def\indexdummies{\indexdummies1316,43430
-\def\_{\_1317,43450
-\def\w{\w1318,43478
-\def\bf{\bf1319,43505
-\def\rm{\rm1320,43534
-\def\sl{\sl1321,43563
-\def\sf{\sf1322,43592
-\def\tt{\tt1323,43620
-\def\gtr{\gtr1324,43648
-\def\less{\less1325,43678
-\def\hat{\hat1326,43710
-\def\char{\char1327,43740
-\def\TeX{\TeX1328,43772
-\def\dots{\dots1329,43802
-\def\copyright{\copyright1330,43835
-\def\tclose##1{\tclose1331,43878
-\def\code##1{\code1332,43923
-\def\samp##1{\samp1333,43964
-\def\t##1{\t1334,44005
-\def\r##1{\r1335,44040
-\def\i##1{\i1336,44075
-\def\b##1{\b1337,44110
-\def\cite##1{\cite1338,44145
-\def\key##1{\key1339,44186
-\def\file##1{\file1340,44225
-\def\var##1{\var1341,44266
-\def\kbd##1{\kbd1342,44305
-\def\indexdummyfont#1{\indexdummyfont1347,44461
-\def\indexdummytex{\indexdummytex1348,44487
-\def\indexdummydots{\indexdummydots1349,44511
-\def\indexnofonts{\indexnofonts1351,44537
-\let\w=\indexdummyfontdummyfont1352,44557
-\let\t=\indexdummyfontdummyfont1353,44580
-\let\r=\indexdummyfontdummyfont1354,44603
-\let\i=\indexdummyfontdummyfont1355,44626
-\let\b=\indexdummyfontdummyfont1356,44649
-\let\emph=\indexdummyfontdummyfont1357,44672
-\let\strong=\indexdummyfontdummyfont1358,44698
-\let\cite=\indexdummyfont=\indexdummyfont1359,44726
-\let\sc=\indexdummyfontdummyfont1360,44752
-\let\tclose=\indexdummyfontdummyfont1364,44924
-\let\code=\indexdummyfontdummyfont1365,44952
-\let\file=\indexdummyfontdummyfont1366,44978
-\let\samp=\indexdummyfontdummyfont1367,45004
-\let\kbd=\indexdummyfontdummyfont1368,45030
-\let\key=\indexdummyfontdummyfont1369,45055
-\let\var=\indexdummyfontdummyfont1370,45080
-\let\TeX=\indexdummytexdummytex1371,45105
-\let\dots=\indexdummydotsdummydots1372,45129
-\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45381
-\def\doind #1#2{\doind1384,45437
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45480
-\def\rawbackslashxx{\rawbackslashxx1389,45620
-{\indexnofontsnofonts1394,45882
-\def\dosubind #1#2#3{\dosubind1405,46193
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46241
-\def\rawbackslashxx{\rawbackslashxx1410,46345
-{\indexnofontsnofonts1414,46499
-\def\findex {\findex1443,47430
-\def\kindex {\kindex1444,47453
-\def\cindex {\cindex1445,47476
-\def\vindex {\vindex1446,47499
-\def\tindex {\tindex1447,47522
-\def\pindex {\pindex1448,47545
-\def\cindexsub {\cindexsub1450,47569
-\def\printindex{\printindex1462,47896
-\def\doprintindex#1{\doprintindex1464,47937
- \def\indexbackslash{\indexbackslash1481,48422
- \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48461
-\def\initial #1{\initial1517,49533
-\def\entry #1#2{\entry1523,49740
- \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50387
-\def\indexdotfill{\indexdotfill1549,50715
-\def\primary #1{\primary1552,50821
-\def\secondary #1#2{\secondary1556,50903
-\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50985
-\newbox\partialpageialpage1566,51158
-\def\begindoublecolumns{\begindoublecolumns1572,51316
- \output={\global\setbox\partialpage=ialpage=1573,51352
-\def\enddoublecolumns{\enddoublecolumns1577,51540
-\def\doublecolumnout{\doublecolumnout1580,51625
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51694
-\def\pagesofar{\pagesofar1584,51872
-\def\balancecolumns{\balancecolumns1588,52109
- \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52280
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52541
-\newcount \appendixno \appendixno = `\@no1627,53446
-\def\appendixletter{\appendixletter1628,53487
-\def\opencontents{\opencontents1632,53590
-\def\thischapter{\thischapter1637,53771
-\def\seccheck#1{\seccheck1638,53809
-\def\chapternofonts{\chapternofonts1643,53913
-\def\result{\result1646,53988
-\def\equiv{\equiv1647,54023
-\def\expansion{\expansion1648,54056
-\def\print{\print1649,54097
-\def\TeX{\TeX1650,54130
-\def\dots{\dots1651,54159
-\def\copyright{\copyright1652,54190
-\def\tt{\tt1653,54231
-\def\bf{\bf1654,54258
-\def\w{\w1655,54286
-\def\less{\less1656,54311
-\def\gtr{\gtr1657,54342
-\def\hat{\hat1658,54371
-\def\char{\char1659,54400
-\def\tclose##1{\tclose1660,54431
-\def\code##1{\code1661,54475
-\def\samp##1{\samp1662,54515
-\def\r##1{\r1663,54555
-\def\b##1{\b1664,54589
-\def\key##1{\key1665,54623
-\def\file##1{\file1666,54661
-\def\kbd##1{\kbd1667,54701
-\def\i##1{\i1669,54809
-\def\cite##1{\cite1670,54843
-\def\var##1{\var1671,54883
-\def\emph##1{\emph1672,54921
-\def\dfn##1{\dfn1673,54961
-\def\thischaptername{\thischaptername1676,55002
-\outer\def\chapter{\chapter1677,55041
-\def\chapterzzz #1{\chapterzzz1678,55082
-{\chapternofonts%nofonts%1687,55478
-\global\let\section = \numberedsec=1692,55631
-\global\let\subsection = \numberedsubsec=1693,55666
-\global\let\subsubsection = \numberedsubsubsec=1694,55707
-\outer\def\appendix{\appendix1697,55758
-\def\appendixzzz #1{\appendixzzz1698,55801
-\global\advance \appendixno by 1 \message{no1700,55878
-\chapmacro {#1}{Appendix \appendixletter}letter1701,55947
-\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56040
-{\chapternofonts%nofonts%1705,56112
- {#1}{Appendix \appendixletter}letter1707,56168
-\appendixnoderef %noderef1710,56268
-\global\let\section = \appendixsec=1711,56287
-\global\let\subsection = \appendixsubsec=1712,56322
-\global\let\subsubsection = \appendixsubsubsec=1713,56363
-\outer\def\top{\top1716,56414
-\outer\def\unnumbered{\unnumbered1717,56454
-\def\unnumberedzzz #1{\unnumberedzzz1718,56501
-{\chapternofonts%nofonts%1722,56664
-\global\let\section = \unnumberedsec=1727,56814
-\global\let\subsection = \unnumberedsubsec=1728,56851
-\global\let\subsubsection = \unnumberedsubsubsec=1729,56894
-\outer\def\numberedsec{\numberedsec1732,56947
-\def\seczzz #1{\seczzz1733,56988
-{\chapternofonts%nofonts%1736,57144
-\outer\def\appendixsection{\appendixsection1745,57330
-\outer\def\appendixsec{\appendixsec1746,57387
-\def\appendixsectionzzz #1{\appendixsectionzzz1747,57440
-\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57552
-{\chapternofonts%nofonts%1750,57620
-{#1}{\appendixletter}letter1752,57676
-\appendixnoderef %noderef1755,57776
-\outer\def\unnumberedsec{\unnumberedsec1759,57816
-\def\unnumberedseczzz #1{\unnumberedseczzz1760,57869
-{\chapternofonts%nofonts%1762,57964
-\outer\def\numberedsubsec{\numberedsubsec1770,58132
-\def\numberedsubseczzz #1{\numberedsubseczzz1771,58187
-{\chapternofonts%nofonts%1774,58366
-\outer\def\appendixsubsec{\appendixsubsec1783,58570
-\def\appendixsubseczzz #1{\appendixsubseczzz1784,58625
-\subsecheading {#1}{\appendixletter}letter1786,58747
-{\chapternofonts%nofonts%1787,58812
-{#1}{\appendixletter}letter1789,58871
-\appendixnoderef %noderef1792,58986
-\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59026
-\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59085
-{\chapternofonts%nofonts%1799,59186
-\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59357
-\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59418
-{\chapternofonts%nofonts%1812,59615
-\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59848
-\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59909
- {\appendixletter}letter1827,60048
-{\chapternofonts%nofonts%1828,60114
- {\appendixletter}letter1830,60179
-\appendixnoderef %noderef1834,60313
-\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60353
-\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60418
-{\chapternofonts%nofonts%1841,60525
-\def\infotop{\infotop1851,60854
-\def\infounnumbered{\infounnumbered1852,60892
-\def\infounnumberedsec{\infounnumberedsec1853,60937
-\def\infounnumberedsubsec{\infounnumberedsubsec1854,60988
-\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61045
-\def\infoappendix{\infoappendix1857,61109
-\def\infoappendixsec{\infoappendixsec1858,61150
-\def\infoappendixsubsec{\infoappendixsubsec1859,61197
-\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61250
-\def\infochapter{\infochapter1862,61310
-\def\infosection{\infosection1863,61349
-\def\infosubsection{\infosubsection1864,61388
-\def\infosubsubsection{\infosubsubsection1865,61433
-\global\let\section = \numberedsec=1870,61670
-\global\let\subsection = \numberedsubsec=1871,61705
-\global\let\subsubsection = \numberedsubsubsec=1872,61746
-\def\majorheading{\majorheading1886,62253
-\def\majorheadingzzz #1{\majorheadingzzz1887,62298
-\def\chapheading{\chapheading1893,62531
-\def\chapheadingzzz #1{\chapheadingzzz1894,62574
-\def\heading{\heading1899,62769
-\def\subheading{\subheading1901,62806
-\def\subsubheading{\subsubheading1903,62849
-\def\dobreak#1#2{\dobreak1910,63126
-\def\setchapterstyle #1 {\setchapterstyle1912,63204
-\def\chapbreak{\chapbreak1919,63459
-\def\chappager{\chappager1920,63509
-\def\chapoddpage{\chapoddpage1921,63547
-\def\setchapternewpage #1 {\setchapternewpage1923,63626
-\def\CHAPPAGoff{\CHAPPAGoff1925,63683
-\def\CHAPPAGon{\CHAPPAGon1929,63777
-\global\def\HEADINGSon{\HEADINGSon1932,63868
-\def\CHAPPAGodd{\CHAPPAGodd1934,63910
-\global\def\HEADINGSon{\HEADINGSon1937,64006
-\def\CHAPFplain{\CHAPFplain1941,64060
-\def\chfplain #1#2{\chfplain1945,64152
-\def\unnchfplain #1{\unnchfplain1956,64375
-\def\unnchfopen #1{\unnchfopen1964,64604
-\def\chfopen #1#2{\chfopen1970,64812
-\def\CHAPFopen{\CHAPFopen1975,64956
-\def\subsecheadingbreak{\subsecheadingbreak1982,65174
-\def\secheadingbreak{\secheadingbreak1985,65303
-\def\secheading #1#2#3{\secheading1993,65585
-\def\plainsecheading #1{\plainsecheading1994,65641
-\def\secheadingi #1{\secheadingi1995,65684
-\def\subsecheading #1#2#3#4{\subsecheading2006,66052
-\def\subsecheadingi #1{\subsecheadingi2007,66119
-\def\subsubsecfonts{\subsubsecfonts2014,66416
-\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66539
-\def\subsubsecheadingi #1{\subsubsecheadingi2018,66617
-\def\startcontents#1{\startcontents2032,67089
- \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67362
-\outer\def\contents{\contents2049,67721
-\outer\def\summarycontents{\summarycontents2057,67865
- \def\secentry ##1##2##3##4{\secentry2067,68236
- \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68271
- \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68306
- \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68347
- \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68385
- \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68432
-\def\chapentry#1#2#3{\chapentry2085,68866
-\def\shortchapentry#1#2#3{\shortchapentry2088,68983
- {#2\labelspace #1}space2091,69093
-\def\unnumbchapentry#1#2{\unnumbchapentry2094,69147
-\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69194
-\def\secentry#1#2#3#4{\secentry2102,69358
-\def\unnumbsecentry#1#2{\unnumbsecentry2103,69417
-\def\subsecentry#1#2#3#4#5{\subsecentry2106,69478
-\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69548
-\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69622
- \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69656
-\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69707
-\def\dochapentry#1#2{\dochapentry2123,70081
-\def\dosecentry#1#2{\dosecentry2138,70686
-\def\dosubsecentry#1#2{\dosubsecentry2145,70864
-\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71049
-\def\labelspace{\labelspace2160,71300
-\def\dopageno#1{\dopageno2162,71335
-\def\doshortpageno#1{\doshortpageno2163,71361
-\def\chapentryfonts{\chapentryfonts2165,71393
-\def\secentryfonts{\secentryfonts2166,71428
-\def\point{\point2192,72387
-\def\result{\result2194,72408
-\def\expansion{\expansion2195,72481
-\def\print{\print2196,72552
-\def\equiv{\equiv2198,72619
-\def\error{\error2218,73392
-\def\tex{\tex2224,73621
-\def\@{\@2242,74004
-\gdef\sepspaces{\def {\ }}}\2265,74736
-\def\aboveenvbreak{\aboveenvbreak2268,74818
-\def\afterenvbreak{\afterenvbreak2272,74984
-\def\ctl{\ctl2286,75495
-\def\ctr{\ctr2287,75567
-\def\cbl{\cbl2288,75606
-\def\cbr{\cbr2289,75646
-\def\carttop{\carttop2290,75685
-\def\cartbot{\cartbot2293,75793
-\long\def\cartouche{\cartouche2299,75933
-\def\Ecartouche{\Ecartouche2326,76721
-\def\lisp{\lisp2338,76856
-\def\Elisp{\Elisp2348,77203
-\def\next##1{\next2360,77529
-\def\Eexample{\Eexample2364,77571
-\def\Esmallexample{\Esmallexample2367,77618
-\def\smalllispx{\smalllispx2373,77796
-\def\Esmalllisp{\Esmalllisp2383,78150
-\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78506
-\def\next##1{\next2397,78563
-\def\display{\display2401,78643
-\def\Edisplay{\Edisplay2410,78962
-\def\next##1{\next2422,79273
-\def\format{\format2426,79376
-\def\Eformat{\Eformat2434,79672
-\def\next##1{\next2437,79761
-\def\flushleft{\flushleft2441,79813
-\def\Eflushleft{\Eflushleft2451,80184
-\def\next##1{\next2454,80277
-\def\flushright{\flushright2456,80299
-\def\Eflushright{\Eflushright2466,80671
-\def\next##1{\next2470,80802
-\def\quotation{\quotation2474,80860
-\def\Equotation{\Equotation2480,81052
-\def\setdeffont #1 {\setdeffont2493,81450
-\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81496
-\newskip\defargsindent \defargsindent=50ptargsindent2496,81539
-\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81582
-\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81625
-\def\activeparens{\activeparens2503,81823
-\def\opnr{\opnr2529,83035
-\def\lbrb{\lbrb2530,83100
-\def\defname #1#2{\defname2536,83301
-\advance\dimen2 by -\defbodyindentbodyindent2540,83419
-\advance\dimen3 by -\defbodyindentbodyindent2542,83473
-\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83527
-\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83669
-\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83744
-\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84113
-\advance\leftskip by -\defbodyindentbodyindent2557,84247
-\exdentamount=\defbodyindentbodyindent2558,84284
-\def\defparsebody #1#2#3{\defparsebody2568,84643
-\def#1{2572,84827
-\def#2{2573,84863
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84935
-\exdentamount=\defbodyindentbodyindent2576,85009
-\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85113
-\def#1{2585,85274
-\def#2##1 {2586,85310
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85393
-\exdentamount=\defbodyindentbodyindent2589,85467
-\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85552
-\def#1{2596,85713
-\def#2##1 ##2 {2597,85749
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85849
-\exdentamount=\defbodyindentbodyindent2601,85923
-\def\defvarparsebody #1#2#3{\defvarparsebody2608,86194
-\def#1{2612,86381
-\def#2{2613,86417
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86476
-\exdentamount=\defbodyindentbodyindent2616,86550
-\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86641
-\def#1{2625,86800
-\def#2##1 {2626,86836
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86906
-\exdentamount=\defbodyindentbodyindent2629,86980
-\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87052
-\def#1{2636,87216
-\def#2##1 ##2 {2637,87252
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87339
-\exdentamount=\defbodyindentbodyindent2641,87413
-\def\defunargs #1{\defunargs2664,88173
-\def\deftypefunargs #1{\deftypefunargs2676,88555
-\def\deffn{\deffn2690,88937
-\def\deffnheader #1#2#3{\deffnheader2692,88994
-\begingroup\defname {name2693,89042
-\def\defun{\defun2699,89187
-\def\defunheader #1#2{\defunheader2701,89240
-\begingroup\defname {name2702,89315
-\defunargs {unargs2703,89351
-\def\deftypefun{\deftypefun2709,89499
-\def\deftypefunheader #1#2{\deftypefunheader2712,89621
-\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89730
-\begingroup\defname {name2716,89822
-\deftypefunargs {typefunargs2717,89868
-\def\deftypefn{\deftypefn2723,90039
-\def\deftypefnheader #1#2#3{\deftypefnheader2726,90188
-\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90324
-\begingroup\defname {name2730,90417
-\deftypefunargs {typefunargs2731,90457
-\def\defmac{\defmac2737,90578
-\def\defmacheader #1#2{\defmacheader2739,90635
-\begingroup\defname {name2740,90711
-\defunargs {unargs2741,90744
-\def\defspec{\defspec2747,90868
-\def\defspecheader #1#2{\defspecheader2749,90929
-\begingroup\defname {name2750,91006
-\defunargs {unargs2751,91046
-\def\deffnx #1 {\deffnx2758,91241
-\def\defunx #1 {\defunx2759,91298
-\def\defmacx #1 {\defmacx2760,91355
-\def\defspecx #1 {\defspecx2761,91414
-\def\deftypefnx #1 {\deftypefnx2762,91475
-\def\deftypeunx #1 {\deftypeunx2763,91540
-\def\defop #1 {\defop2769,91686
-\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91721
-\def\defopheader #1#2#3{\defopheader2772,91775
-\begingroup\defname {name2774,91864
-\defunargs {unargs2775,91910
-\def\defmethod{\defmethod2780,91971
-\def\defmethodheader #1#2#3{\defmethodheader2782,92044
-\begingroup\defname {name2784,92132
-\defunargs {unargs2785,92172
-\def\defcv #1 {\defcv2790,92246
-\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92281
-\def\defcvarheader #1#2#3{\defcvarheader2793,92340
-\begingroup\defname {name2795,92426
-\defvarargs {varargs2796,92472
-\def\defivar{\defivar2801,92545
-\def\defivarheader #1#2#3{\defivarheader2803,92608
-\begingroup\defname {name2805,92694
-\defvarargs {varargs2806,92745
-\def\defopx #1 {\defopx2812,92894
-\def\defmethodx #1 {\defmethodx2813,92951
-\def\defcvx #1 {\defcvx2814,93016
-\def\defivarx #1 {\defivarx2815,93073
-\def\defvarargs #1{\defvarargs2822,93344
-\def\defvr{\defvr2828,93488
-\def\defvrheader #1#2#3{\defvrheader2830,93543
-\begingroup\defname {name2831,93591
-\def\defvar{\defvar2835,93676
-\def\defvarheader #1#2{\defvarheader2837,93736
-\begingroup\defname {name2838,93807
-\defvarargs {varargs2839,93843
-\def\defopt{\defopt2844,93909
-\def\defoptheader #1#2{\defoptheader2846,93969
-\begingroup\defname {name2847,94040
-\defvarargs {varargs2848,94079
-\def\deftypevar{\deftypevar2853,94136
-\def\deftypevarheader #1#2{\deftypevarheader2856,94252
-\begingroup\defname {name2858,94335
-\def\deftypevr{\deftypevr2865,94509
-\def\deftypevrheader #1#2#3{\deftypevrheader2867,94580
-\begingroup\defname {name2868,94632
-\def\defvrx #1 {\defvrx2876,94869
-\def\defvarx #1 {\defvarx2877,94926
-\def\defoptx #1 {\defoptx2878,94985
-\def\deftypevarx #1 {\deftypevarx2879,95044
-\def\deftypevrx #1 {\deftypevrx2880,95111
-\def\deftpargs #1{\deftpargs2885,95260
-\def\deftp{\deftp2889,95340
-\def\deftpheader #1#2#3{\deftpheader2891,95395
-\begingroup\defname {name2892,95443
-\def\deftpx #1 {\deftpx2897,95602
-\def\setref#1{\setref2908,95923
-\def\unnumbsetref#1{\unnumbsetref2913,96037
-\def\appendixsetref#1{\appendixsetref2918,96144
-\def\pxref#1{\pxref2929,96555
-\def\xref#1{\xref2930,96591
-\def\ref#1{\ref2931,96626
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96656
-\def\printedmanual{\printedmanual2933,96699
-\def\printednodename{\printednodename2934,96737
-\def\printednodename{\printednodename2939,96862
-section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97495
-\refx{x2957,97573
-\def\dosetq #1#2{\dosetq2965,97793
-\def\internalsetq #1#2{\internalsetq2973,98051
-\def\Ypagenumber{\Ypagenumber2977,98152
-\def\Ytitle{\Ytitle2979,98178
-\def\Ynothing{\Ynothing2981,98205
-\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98222
-\def\Yappendixletterandtype{\Yappendixletterandtype2992,98538
-\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98568
-\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98623
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98727
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98798
- \def\linenumber{\linenumber3009,99137
-\def\refx#1#2{\refx3015,99321
-\def\xrdef #1#2{\xrdef3037,99947
-\def\readauxfile{\readauxfile3040,100032
-\def\supereject{\supereject3110,101813
-\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102498
-\def\openindices{\openindices3139,102684
-\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102909
-\parindent = \defaultparindentaultparindent3152,102961
-\def\smallbook{\smallbook3175,103685
-\global\def\Esmallexample{\Esmallexample3192,104112
-\def\afourpaper{\afourpaper3196,104203
-\def\finalout{\finalout3224,105011
-\def\normaldoublequote{\normaldoublequote3235,105272
-\def\normaltilde{\normaltilde3236,105298
-\def\normalcaret{\normalcaret3237,105318
-\def\normalunderscore{\normalunderscore3238,105338
-\def\normalverticalbar{\normalverticalbar3239,105363
-\def\normalless{\normalless3240,105389
-\def\normalgreater{\normalgreater3241,105408
-\def\normalplus{\normalplus3242,105430
-\def\ifusingtt#1#2{\ifusingtt3253,105922
-\def\activedoublequote{\activedoublequote3261,106250
-\def~{~3264,106336
-\def^{^3267,106397
-\def_{_3270,106436
-\def\_{\_3272,106510
-\def\lvvmode{\lvvmode3279,106847
-\def|{|3282,106897
-\def<{<3285,106960
-\def>{>3288,107017
-\def+{+3290,107055
-\def\turnoffactive{\turnoffactive3296,107216
-\global\def={=3307,107502
-\def\normalbackslash{\normalbackslash3321,107884
+\def\itemfont{\itemfont1082,35890
+\def\Etable{\Etable1090,36116
+\def\itemize{\itemize1103,36440
+\def\itemizezzz #1{\itemizezzz1105,36476
+\def\itemizey #1#2{\itemizey1110,36571
+\def#2{1119,36817
+\def\itemcontents{\itemcontents1120,36858
+\def\bullet{\bullet1123,36906
+\def\minus{\minus1124,36933
+\def\frenchspacing{\frenchspacing1128,37041
+\def\splitoff#1#2\endmark{\splitoff1134,37266
+\def\enumerate{\enumerate1140,37496
+\def\enumeratezzz #1{\enumeratezzz1141,37535
+\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37588
+ \def\thearg{\thearg1146,37735
+ \ifx\thearg\empty \def\thearg{\thearg1147,37754
+\def\numericenumerate{\numericenumerate1184,39088
+\def\lowercaseenumerate{\lowercaseenumerate1190,39218
+\def\uppercaseenumerate{\uppercaseenumerate1203,39565
+\def\startenumeration#1{\startenumeration1219,40055
+\def\alphaenumerate{\alphaenumerate1227,40237
+\def\capsenumerate{\capsenumerate1228,40272
+\def\Ealphaenumerate{\Ealphaenumerate1229,40306
+\def\Ecapsenumerate{\Ecapsenumerate1230,40340
+\def\itemizeitem{\itemizeitem1234,40420
+\def\newindex #1{\newindex1259,41277
+\def\defindex{\defindex1268,41566
+\def\newcodeindex #1{\newcodeindex1272,41674
+\def\defcodeindex{\defcodeindex1279,41934
+\def\synindex #1 #2 {\synindex1283,42114
+\def\syncodeindex #1 #2 {\syncodeindex1292,42454
+\def\doindex#1{\doindex1309,43133
+\def\singleindexer #1{\singleindexer1310,43192
+\def\docodeindex#1{\docodeindex1313,43304
+\def\singlecodeindexer #1{\singlecodeindexer1314,43371
+\def\indexdummies{\indexdummies1316,43429
+\def\_{\_1317,43449
+\def\w{\w1318,43477
+\def\bf{\bf1319,43504
+\def\rm{\rm1320,43533
+\def\sl{\sl1321,43562
+\def\sf{\sf1322,43591
+\def\tt{\tt1323,43619
+\def\gtr{\gtr1324,43647
+\def\less{\less1325,43677
+\def\hat{\hat1326,43709
+\def\char{\char1327,43739
+\def\TeX{\TeX1328,43771
+\def\dots{\dots1329,43801
+\def\copyright{\copyright1330,43834
+\def\tclose##1{\tclose1331,43877
+\def\code##1{\code1332,43922
+\def\samp##1{\samp1333,43963
+\def\t##1{\t1334,44004
+\def\r##1{\r1335,44039
+\def\i##1{\i1336,44074
+\def\b##1{\b1337,44109
+\def\cite##1{\cite1338,44144
+\def\key##1{\key1339,44185
+\def\file##1{\file1340,44224
+\def\var##1{\var1341,44265
+\def\kbd##1{\kbd1342,44304
+\def\indexdummyfont#1{\indexdummyfont1347,44460
+\def\indexdummytex{\indexdummytex1348,44486
+\def\indexdummydots{\indexdummydots1349,44510
+\def\indexnofonts{\indexnofonts1351,44536
+\let\w=\indexdummyfontdummyfont1352,44556
+\let\t=\indexdummyfontdummyfont1353,44579
+\let\r=\indexdummyfontdummyfont1354,44602
+\let\i=\indexdummyfontdummyfont1355,44625
+\let\b=\indexdummyfontdummyfont1356,44648
+\let\emph=\indexdummyfontdummyfont1357,44671
+\let\strong=\indexdummyfontdummyfont1358,44697
+\let\cite=\indexdummyfont=\indexdummyfont1359,44725
+\let\sc=\indexdummyfontdummyfont1360,44751
+\let\tclose=\indexdummyfontdummyfont1364,44923
+\let\code=\indexdummyfontdummyfont1365,44951
+\let\file=\indexdummyfontdummyfont1366,44977
+\let\samp=\indexdummyfontdummyfont1367,45003
+\let\kbd=\indexdummyfontdummyfont1368,45029
+\let\key=\indexdummyfontdummyfont1369,45054
+\let\var=\indexdummyfontdummyfont1370,45079
+\let\TeX=\indexdummytexdummytex1371,45104
+\let\dots=\indexdummydotsdummydots1372,45128
+\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45380
+\def\doind #1#2{\doind1384,45436
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45479
+\def\rawbackslashxx{\rawbackslashxx1389,45619
+{\indexnofontsnofonts1394,45881
+\def\dosubind #1#2#3{\dosubind1405,46192
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46240
+\def\rawbackslashxx{\rawbackslashxx1410,46344
+{\indexnofontsnofonts1414,46498
+\def\findex {\findex1443,47429
+\def\kindex {\kindex1444,47452
+\def\cindex {\cindex1445,47475
+\def\vindex {\vindex1446,47498
+\def\tindex {\tindex1447,47521
+\def\pindex {\pindex1448,47544
+\def\cindexsub {\cindexsub1450,47568
+\def\printindex{\printindex1462,47895
+\def\doprintindex#1{\doprintindex1464,47936
+ \def\indexbackslash{\indexbackslash1481,48421
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48460
+\def\initial #1{\initial1517,49532
+\def\entry #1#2{\entry1523,49739
+ \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50386
+\def\indexdotfill{\indexdotfill1549,50714
+\def\primary #1{\primary1552,50820
+\def\secondary #1#2{\secondary1556,50902
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50984
+\newbox\partialpageialpage1566,51157
+\def\begindoublecolumns{\begindoublecolumns1572,51315
+ \output={\global\setbox\partialpage=ialpage=1573,51351
+\def\enddoublecolumns{\enddoublecolumns1577,51539
+\def\doublecolumnout{\doublecolumnout1580,51624
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51693
+\def\pagesofar{\pagesofar1584,51871
+\def\balancecolumns{\balancecolumns1588,52108
+ \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52279
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52540
+\newcount \appendixno \appendixno = `\@no1627,53445
+\def\appendixletter{\appendixletter1628,53486
+\def\opencontents{\opencontents1632,53589
+\def\thischapter{\thischapter1637,53770
+\def\seccheck#1{\seccheck1638,53808
+\def\chapternofonts{\chapternofonts1643,53912
+\def\result{\result1646,53987
+\def\equiv{\equiv1647,54022
+\def\expansion{\expansion1648,54055
+\def\print{\print1649,54096
+\def\TeX{\TeX1650,54129
+\def\dots{\dots1651,54158
+\def\copyright{\copyright1652,54189
+\def\tt{\tt1653,54230
+\def\bf{\bf1654,54257
+\def\w{\w1655,54285
+\def\less{\less1656,54310
+\def\gtr{\gtr1657,54341
+\def\hat{\hat1658,54370
+\def\char{\char1659,54399
+\def\tclose##1{\tclose1660,54430
+\def\code##1{\code1661,54474
+\def\samp##1{\samp1662,54514
+\def\r##1{\r1663,54554
+\def\b##1{\b1664,54588
+\def\key##1{\key1665,54622
+\def\file##1{\file1666,54660
+\def\kbd##1{\kbd1667,54700
+\def\i##1{\i1669,54808
+\def\cite##1{\cite1670,54842
+\def\var##1{\var1671,54882
+\def\emph##1{\emph1672,54920
+\def\dfn##1{\dfn1673,54960
+\def\thischaptername{\thischaptername1676,55001
+\outer\def\chapter{\chapter1677,55040
+\def\chapterzzz #1{\chapterzzz1678,55081
+{\chapternofonts%nofonts%1687,55477
+\global\let\section = \numberedsec=1692,55630
+\global\let\subsection = \numberedsubsec=1693,55665
+\global\let\subsubsection = \numberedsubsubsec=1694,55706
+\outer\def\appendix{\appendix1697,55757
+\def\appendixzzz #1{\appendixzzz1698,55800
+\global\advance \appendixno by 1 \message{no1700,55877
+\chapmacro {#1}{Appendix \appendixletter}letter1701,55946
+\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56039
+{\chapternofonts%nofonts%1705,56111
+ {#1}{Appendix \appendixletter}letter1707,56167
+\appendixnoderef %noderef1710,56267
+\global\let\section = \appendixsec=1711,56286
+\global\let\subsection = \appendixsubsec=1712,56321
+\global\let\subsubsection = \appendixsubsubsec=1713,56362
+\outer\def\top{\top1716,56413
+\outer\def\unnumbered{\unnumbered1717,56453
+\def\unnumberedzzz #1{\unnumberedzzz1718,56500
+{\chapternofonts%nofonts%1722,56663
+\global\let\section = \unnumberedsec=1727,56813
+\global\let\subsection = \unnumberedsubsec=1728,56850
+\global\let\subsubsection = \unnumberedsubsubsec=1729,56893
+\outer\def\numberedsec{\numberedsec1732,56946
+\def\seczzz #1{\seczzz1733,56987
+{\chapternofonts%nofonts%1736,57143
+\outer\def\appendixsection{\appendixsection1745,57329
+\outer\def\appendixsec{\appendixsec1746,57386
+\def\appendixsectionzzz #1{\appendixsectionzzz1747,57439
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57551
+{\chapternofonts%nofonts%1750,57619
+{#1}{\appendixletter}letter1752,57675
+\appendixnoderef %noderef1755,57775
+\outer\def\unnumberedsec{\unnumberedsec1759,57815
+\def\unnumberedseczzz #1{\unnumberedseczzz1760,57868
+{\chapternofonts%nofonts%1762,57963
+\outer\def\numberedsubsec{\numberedsubsec1770,58131
+\def\numberedsubseczzz #1{\numberedsubseczzz1771,58186
+{\chapternofonts%nofonts%1774,58365
+\outer\def\appendixsubsec{\appendixsubsec1783,58569
+\def\appendixsubseczzz #1{\appendixsubseczzz1784,58624
+\subsecheading {#1}{\appendixletter}letter1786,58746
+{\chapternofonts%nofonts%1787,58811
+{#1}{\appendixletter}letter1789,58870
+\appendixnoderef %noderef1792,58985
+\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59025
+\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59084
+{\chapternofonts%nofonts%1799,59185
+\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59356
+\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59417
+{\chapternofonts%nofonts%1812,59614
+\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59847
+\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59908
+ {\appendixletter}letter1827,60047
+{\chapternofonts%nofonts%1828,60113
+ {\appendixletter}letter1830,60178
+\appendixnoderef %noderef1834,60312
+\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60352
+\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60417
+{\chapternofonts%nofonts%1841,60524
+\def\infotop{\infotop1851,60853
+\def\infounnumbered{\infounnumbered1852,60891
+\def\infounnumberedsec{\infounnumberedsec1853,60936
+\def\infounnumberedsubsec{\infounnumberedsubsec1854,60987
+\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61044
+\def\infoappendix{\infoappendix1857,61108
+\def\infoappendixsec{\infoappendixsec1858,61149
+\def\infoappendixsubsec{\infoappendixsubsec1859,61196
+\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61249
+\def\infochapter{\infochapter1862,61309
+\def\infosection{\infosection1863,61348
+\def\infosubsection{\infosubsection1864,61387
+\def\infosubsubsection{\infosubsubsection1865,61432
+\global\let\section = \numberedsec=1870,61669
+\global\let\subsection = \numberedsubsec=1871,61704
+\global\let\subsubsection = \numberedsubsubsec=1872,61745
+\def\majorheading{\majorheading1886,62252
+\def\majorheadingzzz #1{\majorheadingzzz1887,62297
+\def\chapheading{\chapheading1893,62530
+\def\chapheadingzzz #1{\chapheadingzzz1894,62573
+\def\heading{\heading1899,62768
+\def\subheading{\subheading1901,62805
+\def\subsubheading{\subsubheading1903,62848
+\def\dobreak#1#2{\dobreak1910,63125
+\def\setchapterstyle #1 {\setchapterstyle1912,63203
+\def\chapbreak{\chapbreak1919,63458
+\def\chappager{\chappager1920,63508
+\def\chapoddpage{\chapoddpage1921,63546
+\def\setchapternewpage #1 {\setchapternewpage1923,63625
+\def\CHAPPAGoff{\CHAPPAGoff1925,63682
+\def\CHAPPAGon{\CHAPPAGon1929,63776
+\global\def\HEADINGSon{\HEADINGSon1932,63867
+\def\CHAPPAGodd{\CHAPPAGodd1934,63909
+\global\def\HEADINGSon{\HEADINGSon1937,64005
+\def\CHAPFplain{\CHAPFplain1941,64059
+\def\chfplain #1#2{\chfplain1945,64151
+\def\unnchfplain #1{\unnchfplain1956,64374
+\def\unnchfopen #1{\unnchfopen1964,64603
+\def\chfopen #1#2{\chfopen1970,64811
+\def\CHAPFopen{\CHAPFopen1975,64955
+\def\subsecheadingbreak{\subsecheadingbreak1982,65173
+\def\secheadingbreak{\secheadingbreak1985,65302
+\def\secheading #1#2#3{\secheading1993,65584
+\def\plainsecheading #1{\plainsecheading1994,65640
+\def\secheadingi #1{\secheadingi1995,65683
+\def\subsecheading #1#2#3#4{\subsecheading2006,66051
+\def\subsecheadingi #1{\subsecheadingi2007,66118
+\def\subsubsecfonts{\subsubsecfonts2014,66415
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66538
+\def\subsubsecheadingi #1{\subsubsecheadingi2018,66616
+\def\startcontents#1{\startcontents2032,67088
+ \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67361
+\outer\def\contents{\contents2049,67720
+\outer\def\summarycontents{\summarycontents2057,67864
+ \def\secentry ##1##2##3##4{\secentry2067,68235
+ \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68270
+ \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68305
+ \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68346
+ \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68384
+ \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68431
+\def\chapentry#1#2#3{\chapentry2085,68865
+\def\shortchapentry#1#2#3{\shortchapentry2088,68982
+ {#2\labelspace #1}space2091,69092
+\def\unnumbchapentry#1#2{\unnumbchapentry2094,69146
+\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69193
+\def\secentry#1#2#3#4{\secentry2102,69357
+\def\unnumbsecentry#1#2{\unnumbsecentry2103,69416
+\def\subsecentry#1#2#3#4#5{\subsecentry2106,69477
+\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69547
+\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69621
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69655
+\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69706
+\def\dochapentry#1#2{\dochapentry2123,70080
+\def\dosecentry#1#2{\dosecentry2138,70685
+\def\dosubsecentry#1#2{\dosubsecentry2145,70863
+\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71048
+\def\labelspace{\labelspace2160,71299
+\def\dopageno#1{\dopageno2162,71334
+\def\doshortpageno#1{\doshortpageno2163,71360
+\def\chapentryfonts{\chapentryfonts2165,71392
+\def\secentryfonts{\secentryfonts2166,71427
+\def\point{\point2192,72386
+\def\result{\result2194,72407
+\def\expansion{\expansion2195,72480
+\def\print{\print2196,72551
+\def\equiv{\equiv2198,72618
+\def\error{\error2218,73391
+\def\tex{\tex2224,73620
+\def\@{\@2242,74003
+\gdef\sepspaces{\def {\ }}}\2265,74735
+\def\aboveenvbreak{\aboveenvbreak2268,74817
+\def\afterenvbreak{\afterenvbreak2272,74983
+\def\ctl{\ctl2286,75494
+\def\ctr{\ctr2287,75566
+\def\cbl{\cbl2288,75605
+\def\cbr{\cbr2289,75645
+\def\carttop{\carttop2290,75684
+\def\cartbot{\cartbot2293,75792
+\long\def\cartouche{\cartouche2299,75932
+\def\Ecartouche{\Ecartouche2326,76720
+\def\lisp{\lisp2338,76855
+\def\Elisp{\Elisp2348,77202
+\def\next##1{\next2360,77528
+\def\Eexample{\Eexample2364,77570
+\def\Esmallexample{\Esmallexample2367,77617
+\def\smalllispx{\smalllispx2373,77795
+\def\Esmalllisp{\Esmalllisp2383,78149
+\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78505
+\def\next##1{\next2397,78562
+\def\display{\display2401,78642
+\def\Edisplay{\Edisplay2410,78961
+\def\next##1{\next2422,79272
+\def\format{\format2426,79375
+\def\Eformat{\Eformat2434,79671
+\def\next##1{\next2437,79760
+\def\flushleft{\flushleft2441,79812
+\def\Eflushleft{\Eflushleft2451,80183
+\def\next##1{\next2454,80276
+\def\flushright{\flushright2456,80298
+\def\Eflushright{\Eflushright2466,80670
+\def\next##1{\next2470,80801
+\def\quotation{\quotation2474,80859
+\def\Equotation{\Equotation2480,81051
+\def\setdeffont #1 {\setdeffont2493,81449
+\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81495
+\newskip\defargsindent \defargsindent=50ptargsindent2496,81538
+\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81581
+\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81624
+\def\activeparens{\activeparens2503,81822
+\def\opnr{\opnr2529,83034
+\def\lbrb{\lbrb2530,83099
+\def\defname #1#2{\defname2536,83300
+\advance\dimen2 by -\defbodyindentbodyindent2540,83418
+\advance\dimen3 by -\defbodyindentbodyindent2542,83472
+\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83526
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83668
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83743
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84112
+\advance\leftskip by -\defbodyindentbodyindent2557,84246
+\exdentamount=\defbodyindentbodyindent2558,84283
+\def\defparsebody #1#2#3{\defparsebody2568,84642
+\def#1{2572,84826
+\def#2{2573,84862
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84934
+\exdentamount=\defbodyindentbodyindent2576,85008
+\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85112
+\def#1{2585,85273
+\def#2##1 {2586,85309
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85392
+\exdentamount=\defbodyindentbodyindent2589,85466
+\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85551
+\def#1{2596,85712
+\def#2##1 ##2 {2597,85748
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85848
+\exdentamount=\defbodyindentbodyindent2601,85922
+\def\defvarparsebody #1#2#3{\defvarparsebody2608,86193
+\def#1{2612,86380
+\def#2{2613,86416
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86475
+\exdentamount=\defbodyindentbodyindent2616,86549
+\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86640
+\def#1{2625,86799
+\def#2##1 {2626,86835
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86905
+\exdentamount=\defbodyindentbodyindent2629,86979
+\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87051
+\def#1{2636,87215
+\def#2##1 ##2 {2637,87251
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87338
+\exdentamount=\defbodyindentbodyindent2641,87412
+\def\defunargs #1{\defunargs2664,88172
+\def\deftypefunargs #1{\deftypefunargs2676,88554
+\def\deffn{\deffn2690,88936
+\def\deffnheader #1#2#3{\deffnheader2692,88993
+\begingroup\defname {name2693,89041
+\def\defun{\defun2699,89186
+\def\defunheader #1#2{\defunheader2701,89239
+\begingroup\defname {name2702,89314
+\defunargs {unargs2703,89350
+\def\deftypefun{\deftypefun2709,89498
+\def\deftypefunheader #1#2{\deftypefunheader2712,89620
+\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89729
+\begingroup\defname {name2716,89821
+\deftypefunargs {typefunargs2717,89867
+\def\deftypefn{\deftypefn2723,90038
+\def\deftypefnheader #1#2#3{\deftypefnheader2726,90187
+\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90323
+\begingroup\defname {name2730,90416
+\deftypefunargs {typefunargs2731,90456
+\def\defmac{\defmac2737,90577
+\def\defmacheader #1#2{\defmacheader2739,90634
+\begingroup\defname {name2740,90710
+\defunargs {unargs2741,90743
+\def\defspec{\defspec2747,90867
+\def\defspecheader #1#2{\defspecheader2749,90928
+\begingroup\defname {name2750,91005
+\defunargs {unargs2751,91045
+\def\deffnx #1 {\deffnx2758,91240
+\def\defunx #1 {\defunx2759,91297
+\def\defmacx #1 {\defmacx2760,91354
+\def\defspecx #1 {\defspecx2761,91413
+\def\deftypefnx #1 {\deftypefnx2762,91474
+\def\deftypeunx #1 {\deftypeunx2763,91539
+\def\defop #1 {\defop2769,91685
+\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91720
+\def\defopheader #1#2#3{\defopheader2772,91774
+\begingroup\defname {name2774,91863
+\defunargs {unargs2775,91909
+\def\defmethod{\defmethod2780,91970
+\def\defmethodheader #1#2#3{\defmethodheader2782,92043
+\begingroup\defname {name2784,92131
+\defunargs {unargs2785,92171
+\def\defcv #1 {\defcv2790,92245
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92280
+\def\defcvarheader #1#2#3{\defcvarheader2793,92339
+\begingroup\defname {name2795,92425
+\defvarargs {varargs2796,92471
+\def\defivar{\defivar2801,92544
+\def\defivarheader #1#2#3{\defivarheader2803,92607
+\begingroup\defname {name2805,92693
+\defvarargs {varargs2806,92744
+\def\defopx #1 {\defopx2812,92893
+\def\defmethodx #1 {\defmethodx2813,92950
+\def\defcvx #1 {\defcvx2814,93015
+\def\defivarx #1 {\defivarx2815,93072
+\def\defvarargs #1{\defvarargs2822,93343
+\def\defvr{\defvr2828,93487
+\def\defvrheader #1#2#3{\defvrheader2830,93542
+\begingroup\defname {name2831,93590
+\def\defvar{\defvar2835,93675
+\def\defvarheader #1#2{\defvarheader2837,93735
+\begingroup\defname {name2838,93806
+\defvarargs {varargs2839,93842
+\def\defopt{\defopt2844,93908
+\def\defoptheader #1#2{\defoptheader2846,93968
+\begingroup\defname {name2847,94039
+\defvarargs {varargs2848,94078
+\def\deftypevar{\deftypevar2853,94135
+\def\deftypevarheader #1#2{\deftypevarheader2856,94251
+\begingroup\defname {name2858,94334
+\def\deftypevr{\deftypevr2865,94508
+\def\deftypevrheader #1#2#3{\deftypevrheader2867,94579
+\begingroup\defname {name2868,94631
+\def\defvrx #1 {\defvrx2876,94868
+\def\defvarx #1 {\defvarx2877,94925
+\def\defoptx #1 {\defoptx2878,94984
+\def\deftypevarx #1 {\deftypevarx2879,95043
+\def\deftypevrx #1 {\deftypevrx2880,95110
+\def\deftpargs #1{\deftpargs2885,95259
+\def\deftp{\deftp2889,95339
+\def\deftpheader #1#2#3{\deftpheader2891,95394
+\begingroup\defname {name2892,95442
+\def\deftpx #1 {\deftpx2897,95601
+\def\setref#1{\setref2908,95922
+\def\unnumbsetref#1{\unnumbsetref2913,96036
+\def\appendixsetref#1{\appendixsetref2918,96143
+\def\pxref#1{\pxref2929,96554
+\def\xref#1{\xref2930,96590
+\def\ref#1{\ref2931,96625
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96655
+\def\printedmanual{\printedmanual2933,96698
+\def\printednodename{\printednodename2934,96736
+\def\printednodename{\printednodename2939,96861
+section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97493
+\refx{x2957,97571
+\def\dosetq #1#2{\dosetq2965,97791
+\def\internalsetq #1#2{\internalsetq2973,98049
+\def\Ypagenumber{\Ypagenumber2977,98150
+\def\Ytitle{\Ytitle2979,98176
+\def\Ynothing{\Ynothing2981,98203
+\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98220
+\def\Yappendixletterandtype{\Yappendixletterandtype2992,98536
+\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98566
+\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98621
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98725
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98796
+ \def\linenumber{\linenumber3009,99135
+\def\refx#1#2{\refx3015,99319
+\def\xrdef #1#2{\xrdef3037,99945
+\def\readauxfile{\readauxfile3040,100030
+\def\supereject{\supereject3110,101811
+\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102496
+\def\openindices{\openindices3139,102682
+\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102907
+\parindent = \defaultparindentaultparindent3152,102959
+\def\smallbook{\smallbook3175,103683
+\global\def\Esmallexample{\Esmallexample3192,104110
+\def\afourpaper{\afourpaper3196,104201
+\def\finalout{\finalout3224,105009
+\def\normaldoublequote{\normaldoublequote3235,105270
+\def\normaltilde{\normaltilde3236,105296
+\def\normalcaret{\normalcaret3237,105316
+\def\normalunderscore{\normalunderscore3238,105336
+\def\normalverticalbar{\normalverticalbar3239,105361
+\def\normalless{\normalless3240,105387
+\def\normalgreater{\normalgreater3241,105406
+\def\normalplus{\normalplus3242,105428
+\def\ifusingtt#1#2{\ifusingtt3253,105920
+\def\activedoublequote{\activedoublequote3261,106248
+\def~{~3264,106334
+\def^{^3267,106395
+\def_{_3270,106434
+\def\_{\_3272,106508
+\def\lvvmode{\lvvmode3279,106845
+\def|{|3282,106895
+\def<{<3285,106958
+\def>{>3288,107015
+\def+{+3290,107053
+\def\turnoffactive{\turnoffactive3296,107214
+\global\def={=3307,107500
+\def\normalbackslash{\normalbackslash3321,107882
+
+merc-src/accumulator.m,3228
+:- interface146,5371
+:- import_module hlds148,5386
+:- import_module univ152,5478
+:- pred accu_transform_proc159,5793
+:- implementation166,6115
+:- import_module libs180,6552
+:- import_module mdbcomp184,6681
+:- import_module parse_tree186,6742
+:- import_module assoc_list194,7013
+:- import_module bool195,7042
+:- import_module int196,7065
+:- import_module io197,7087
+:- import_module list198,7108
+:- import_module map199,7131
+:- import_module maybe200,7153
+:- import_module pair201,7177
+:- import_module require202,7200
+:- import_module set203,7226
+:- import_module solutions204,7248
+:- import_module string205,7276
+:- import_module term206,7301
+:- import_module varset207,7324
+:- type top_level213,7499
+:- type accu_goal_id225,7900
+:- type accu_case228,7964
+:- type accu_goal_store234,8091
+:- type accu_subst238,8216
+:- type accu_warning240,8264
+:- pred generate_warnings334,12550
+:- pred generate_warning342,12895
+:- pred should_attempt_accu_transform365,13886
+:- pred should_attempt_accu_transform_2398,15406
+:- pred accu_standardize440,17390
+:- pred identify_goal_type465,18169
+:- pred is_recursive_case549,21175
+:- type store_info560,21713
+:- func initialize_goal_store570,22060
+:- pred accu_store580,22421
+:- pred identify_recursive_calls601,23288
+:- pred identify_out_and_out_prime626,24396
+:- type accu_sets676,26425
+:- pred accu_stage1689,26977
+:- pred accu_stage1_2727,28347
+:- pred accu_sets_init781,30557
+:- func set_upto796,30984
+:- pred accu_before812,31498
+:- pred accu_assoc835,32477
+:- pred accu_construct862,33712
+:- pred accu_construct_assoc896,35307
+:- pred accu_update938,37069
+:- pred member_lessthan_goalid964,38219
+:- type accu_assoc975,38652
+:- pred accu_is_associative986,39138
+:- pred associativity_assertion1014,40263
+:- pred commutativity_assertion1037,41242
+:- pred accu_is_update1057,41952
+:- pred is_associative_construction1078,42802
+:- type accu_substs1095,43480
+:- type accu_base1103,43744
+:- pred accu_stage21124,44605
+:- pred accu_substs_init1179,46957
+:- pred acc_var_subst_init1194,47573
+:- pred create_new_var1207,48147
+:- pred accu_process_assoc_set1223,48862
+:- pred accu_has_heuristic1297,52081
+:- pred accu_heuristic1304,52336
+:- pred accu_process_update_set1318,52906
+:- pred accu_divide_base_case1380,55844
+:- pred accu_related1412,57146
+:- inst stored_goal_plain_call1444,58415
+:- pred lookup_call1449,58601
+:- pred accu_stage31470,59432
+:- pred acc_proc_info1508,61326
+:- pred acc_pred_info1556,63449
+:- pred accu_create_goal1600,65285
+:- func create_acc_call1621,66400
+:- pred create_orig_goal1634,66987
+:- pred create_acc_goal1662,68157
+:- func create_new_orig_recursive_goals1709,70225
+:- func create_new_recursive_goals1723,70918
+:- func create_new_base_goals1738,71717
+:- pred acc_unification1749,72156
+:- pred accu_top_level1766,72896
+:- pred update_accumulator_pred1856,76290
+:- func accu_rename1876,77253
+:- func base_case_ids1889,77784
+:- func base_case_ids_set1898,78048
+:- func accu_goal_list1905,78269
+:- pred calculate_goal_info1916,78680
+:- func chain_subst1932,79319
+:- pred chain_subst_21938,79482
+:- some [T] pred unravel_univ1956,80060
+:- pragma foreign_export1957,80116
c-src/c.c,76
T f(1,0
@@ -4148,13 +4244,13 @@ yyerror FUN1(286,5948
make_list FUN2(293,6028
#define ERROR 304,6228
yylex FUN0(315,6405
-parse_cell_or_range FUN2(587,11771
-#define CK_ABS_R(671,13213
-#define CK_REL_R(675,13292
-#define CK_ABS_C(680,13421
-#define CK_REL_C(684,13500
-#define MAYBEREL(689,13629
-str_to_col FUN1(847,16830
+parse_cell_or_range FUN2(587,11772
+#define CK_ABS_R(671,13214
+#define CK_REL_R(675,13293
+#define CK_ABS_C(680,13422
+#define CK_REL_C(684,13501
+#define MAYBEREL(689,13630
+str_to_col FUN1(847,16831
y-src/parse.c,520
#define YYBISON 4,64
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index 583de5cbe22..5133cc9e2b5 100644
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -175,7 +175,7 @@ package body Truc.Bidule Truc.Bidule/b138,2153
protected body Bidule Bidule/b139,2181
protected body Machin_T Machin_T/b146,2281
-c-src/abbrev.c,3274
+c-src/abbrev.c,3055
Lisp_Object Vabbrev_table_name_list;43,1429
Lisp_Object Vglobal_abbrev_table;48,1574
Lisp_Object Vfundamental_mode_abbrev_table;52,1685
@@ -186,57 +186,53 @@ Lisp_Object Vabbrev_start_location_buffer;66,2046
Lisp_Object Vlast_abbrev;70,2155
Lisp_Object Vlast_abbrev_text;75,2324
int last_abbrev_point;79,2414
-Lisp_Object Vpre_abbrev_expand_hook,83,2487
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;83,2487
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,85,2551
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table85,2551
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,92,2743
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table92,2743
-DEFUN ("define-abbrev", Fdefine_abbrev,107,3124
-DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev107,3124
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,149,4443
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev149,4443
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,160,4814
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev160,4814
-DEFUN ("abbrev-symbol", Fabbrev_symbol,174,5282
-DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol174,5282
-DEFUN ("abbrev-expansion", Fabbrev_expansion,202,6246
-DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion202,6246
-DEFUN ("expand-abbrev", Fexpand_abbrev,218,6761
-DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev218,6761
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,389,11682
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev389,11682
-write_abbrev 426,12889
-describe_abbrev 445,13324
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,466,13839
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description466,13839
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,506,14995
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table506,14995
-syms_of_abbrev 540,16072
- DEFVAR_LISP ("abbrev-table-name-list"542,16092
- DEFVAR_LISP ("global-abbrev-table"548,16354
- DEFVAR_LISP ("fundamental-mode-abbrev-table"555,16676
- DEFVAR_LISP ("last-abbrev"561,17018
- DEFVAR_LISP ("last-abbrev-text"564,17141
- DEFVAR_INT ("last-abbrev-location"568,17299
- DEFVAR_LISP ("abbrev-start-location"575,17498
- DEFVAR_LISP ("abbrev-start-location-buffer"581,17775
- DEFVAR_PER_BUFFER ("local-abbrev-table"586,18039
- DEFVAR_BOOL ("abbrevs-changed"589,18182
- DEFVAR_BOOL ("abbrev-all-caps"594,18385
- DEFVAR_LISP ("pre-abbrev-expand-hook"598,18541
- DEFVAR_LISP ("abbrev-table-name-list",\1542,16092
- DEFVAR_LISP ("global-abbrev-table",\1548,16354
- DEFVAR_LISP ("fundamental-mode-abbrev-table",\1555,16676
- DEFVAR_LISP ("last-abbrev",\1561,17018
- DEFVAR_LISP ("last-abbrev-text",\1564,17141
- DEFVAR_INT ("last-abbrev-location",\1568,17299
- DEFVAR_LISP ("abbrev-start-location",\1575,17498
- DEFVAR_LISP ("abbrev-start-location-buffer",\1581,17775
- DEFVAR_PER_BUFFER ("local-abbrev-table",\1586,18039
- DEFVAR_BOOL ("abbrevs-changed",\1589,18182
- DEFVAR_BOOL ("abbrev-all-caps",\1594,18385
- DEFVAR_LISP ("pre-abbrev-expand-hook",\1598,18541
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,82,2440
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table82,2440
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,89,2632
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table89,2632
+DEFUN ("define-abbrev", Fdefine_abbrev,104,3013
+DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev104,3013
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,146,4332
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev146,4332
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,157,4703
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev157,4703
+DEFUN ("abbrev-symbol", Fabbrev_symbol,171,5171
+DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol171,5171
+DEFUN ("abbrev-expansion", Fabbrev_expansion,199,6135
+DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion199,6135
+DEFUN ("expand-abbrev", Fexpand_abbrev,215,6650
+DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev215,6650
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,383,11495
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev383,11495
+write_abbrev 420,12702
+describe_abbrev 439,13137
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,460,13652
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description460,13652
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,500,14808
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table500,14808
+syms_of_abbrev 534,15885
+ DEFVAR_LISP ("abbrev-table-name-list"536,15905
+ DEFVAR_LISP ("global-abbrev-table"542,16167
+ DEFVAR_LISP ("fundamental-mode-abbrev-table"549,16489
+ DEFVAR_LISP ("last-abbrev"555,16831
+ DEFVAR_LISP ("last-abbrev-text"558,16954
+ DEFVAR_INT ("last-abbrev-location"562,17112
+ DEFVAR_LISP ("abbrev-start-location"569,17311
+ DEFVAR_LISP ("abbrev-start-location-buffer"575,17588
+ DEFVAR_PER_BUFFER ("local-abbrev-table"580,17852
+ DEFVAR_BOOL ("abbrevs-changed"583,17995
+ DEFVAR_BOOL ("abbrev-all-caps"588,18198
+ DEFVAR_LISP ("abbrev-table-name-list",\1536,15905
+ DEFVAR_LISP ("global-abbrev-table",\1542,16167
+ DEFVAR_LISP ("fundamental-mode-abbrev-table",\1549,16489
+ DEFVAR_LISP ("last-abbrev",\1555,16831
+ DEFVAR_LISP ("last-abbrev-text",\1558,16954
+ DEFVAR_INT ("last-abbrev-location",\1562,17112
+ DEFVAR_LISP ("abbrev-start-location",\1569,17311
+ DEFVAR_LISP ("abbrev-start-location-buffer",\1575,17588
+ DEFVAR_PER_BUFFER ("local-abbrev-table",\1580,17852
+ DEFVAR_BOOL ("abbrevs-changed",\1583,17995
+ DEFVAR_BOOL ("abbrev-all-caps",\1588,18198
c-src/torture.c,197
(*tag1 tag118,452
@@ -1368,310 +1364,310 @@ make_lispy_position 5228,157391
toolkit_menubar_in_use 5456,163954
make_scroll_bar_position 5469,164322
make_lispy_event 5485,164968
-make_lispy_movement 6104,183532
-make_lispy_switch_frame 6131,184263
-make_lispy_focus_in 6137,184370
-make_lispy_focus_out 6145,184496
-parse_modifiers_uncached 6163,184946
-#define SINGLE_LETTER_MOD(6185,185466
-#undef SINGLE_LETTER_MOD6212,185907
-#define MULTI_LETTER_MOD(6214,185933
-#undef MULTI_LETTER_MOD6231,186401
-apply_modifiers_uncached 6273,187575
-static const char *const modifier_names[modifier_names6319,189194
-#define NUM_MOD_NAMES 6325,189400
-static Lisp_Object modifier_symbols;6327,189450
-lispy_modifier_list 6331,189587
-#define KEY_TO_CHAR(6353,190253
-parse_modifiers 6356,190329
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191518
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191518
-apply_modifiers 6422,192392
-reorder_modifiers 6491,194721
-modify_event_symbol 6536,196529
-DEFUN ("event-convert-list", Fevent_convert_list,6628,199245
-DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199245
-parse_solitary_modifier 6695,201136
-#define SINGLE_LETTER_MOD(6701,201259
-#define MULTI_LETTER_MOD(6705,201344
-#undef SINGLE_LETTER_MOD6763,202642
-#undef MULTI_LETTER_MOD6764,202667
-lucid_event_type_list_p 6775,202890
-get_input_pending 6814,203961
-record_asynch_buffer_change 6834,204580
-gobble_input 6872,205703
-tty_read_avail_input 6967,208311
-handle_async_input 7149,214040
-process_pending_signals 7165,214360
-unblock_input_to 7177,214646
-unblock_input 7200,215278
-totally_unblock_input 7209,215446
-handle_input_available_signal 7217,215530
-deliver_input_available_signal 7226,215701
-struct user_signal_info7235,215866
- int sig;7238,215916
- char *name;name7241,215957
- int npending;7244,216008
- struct user_signal_info *next;next7246,216025
-static struct user_signal_info *user_signals user_signals7250,216091
-add_user_signal 7253,216150
-handle_user_signal 7275,216599
-deliver_user_signal 7316,217559
-find_user_signal_name 7322,217660
-store_user_signal_events 7334,217842
-static void menu_bar_item 7362,218342
-static Lisp_Object menu_bar_one_keymap_changed_items;7363,218417
-static Lisp_Object menu_bar_items_vector;7368,218631
-static int menu_bar_items_index;7369,218673
-static const char *separator_names[separator_names7372,218708
-menu_separator_name_p 7393,219149
-menu_bar_items 7426,219853
-Lisp_Object item_properties;7568,224604
-menu_bar_item 7571,224646
-menu_item_eval_property_1 7647,227176
-eval_dyn 7658,227466
-menu_item_eval_property 7666,227676
-parse_menu_item 7686,228342
-static Lisp_Object tool_bar_items_vector;7965,236337
-static Lisp_Object tool_bar_item_properties;7970,236511
-static int ntool_bar_items;7974,236607
-static void init_tool_bar_items 7978,236665
-static void process_tool_bar_item 7979,236712
-static bool parse_tool_bar_item 7981,236802
-static void append_tool_bar_item 7982,236862
-tool_bar_items 7990,237084
-process_tool_bar_item 8075,239893
-#define PROP(8112,240970
-set_prop 8114,241039
-parse_tool_bar_item 8167,242454
-#undef PROP8379,248845
-init_tool_bar_items 8387,248970
-append_tool_bar_item 8401,249262
-read_char_x_menu_prompt 8443,250772
-read_char_minibuf_menu_prompt 8503,252446
-#define PUSH_C_STR(8527,253015
-follow_key 8726,258554
-active_maps 8733,258696
-typedef struct keyremap8742,259022
- Lisp_Object parent;8745,259108
- Lisp_Object map;8748,259225
- int start,8753,259447
- int start, end;8753,259447
-} keyremap;8754,259465
-access_keymap_keyremap 8764,259809
-keyremap_step 8811,261451
-test_undefined 8867,262935
-read_key_sequence 8916,264862
-read_key_sequence_vs 9826,295822
-DEFUN ("read-key-sequence", Fread_key_sequence,9885,297295
-DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297295
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299983
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299983
-detect_input_pending 9950,300489
-detect_input_pending_ignore_squeezables 9959,300655
-detect_input_pending_run_timers 9967,300871
-clear_input_pending 9985,301363
-requeued_events_pending_p 9997,301733
-DEFUN ("input-pending-p", Finput_pending_p,10002,301814
-DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301814
-DEFUN ("recent-keys", Frecent_keys,10024,302597
-DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302597
-DEFUN ("this-command-keys", Fthis_command_keys,10055,303518
-DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303518
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303959
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303959
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304381
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304381
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304956
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304956
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305496
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305496
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306511
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306511
-DEFUN ("recursion-depth", Frecursion_depth,10158,307070
-DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307070
-DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307407
-DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307407
-DEFUN ("discard-input", Fdiscard_input,10203,308448
-DEFUN ("discard-input", Fdiscard_input,discard-input10203,308448
-DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308950
-DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308950
-stuff_buffered_input 10285,311046
-set_waiting_for_input 10323,312017
-clear_waiting_for_input 10337,312391
-handle_interrupt_signal 10351,312755
-deliver_interrupt_signal 10378,313643
-static int volatile force_quit_count;10387,313933
-handle_interrupt 10401,314415
-quit_throw_to_read_char 10541,318712
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319289
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319289
-DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320517
-DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320517
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321433
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321433
-DEFUN ("set-quit-char", Fset_quit_char,10694,322707
-DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322707
-DEFUN ("set-input-mode", Fset_input_mode,10729,323571
-DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323571
-DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324460
-DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324460
-DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325838
-DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325838
-DEFUN ("posn-at-point", Fposn_at_point,10824,327061
-DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327061
-init_kboard 10861,328215
-allocate_kboard 10893,329285
-wipe_kboard 10909,329638
-delete_kboard 10917,329752
-init_keyboard 10942,330282
-struct event_head11021,332697
- short var;11023,332717
- short kind;11024,332730
-static const struct event_head head_table[head_table11027,332748
-syms_of_keyboard 11045,333578
- DEFVAR_LISP ("internal--top-level-message"11058,333973
- DEFVAR_LISP ("last-command-event"11312,342174
- DEFVAR_LISP ("last-nonmenu-event"11315,342298
- DEFVAR_LISP ("last-input-event"11321,342637
- DEFVAR_LISP ("unread-command-events"11324,342731
- DEFVAR_LISP ("unread-post-input-method-events"11332,343191
- DEFVAR_LISP ("unread-input-method-events"11338,343530
- DEFVAR_LISP ("meta-prefix-char"11346,343899
- DEFVAR_KBOARD ("last-command"11351,344107
- DEFVAR_KBOARD ("real-last-command"11368,344788
- DEFVAR_KBOARD ("last-repeatable-command"11372,344974
- DEFVAR_LISP ("this-command"11378,345262
- DEFVAR_LISP ("real-this-command"11384,345499
- DEFVAR_LISP ("this-command-keys-shift-translated"11388,345681
- DEFVAR_LISP ("this-original-command"11396,346124
- DEFVAR_INT ("auto-save-interval"11403,346521
- DEFVAR_LISP ("auto-save-timeout"11408,346735
- DEFVAR_LISP ("echo-keystrokes"11415,347080
- DEFVAR_INT ("polling-period"11421,347351
- DEFVAR_LISP ("double-click-time"11428,347694
- DEFVAR_INT ("double-click-fuzz"11435,348030
- DEFVAR_INT ("num-input-keys"11446,348520
- DEFVAR_INT ("num-nonmacro-input-events"11452,348795
- DEFVAR_LISP ("last-event-frame"11457,349033
- DEFVAR_LISP ("tty-erase-char"11463,349312
- DEFVAR_LISP ("help-char"11466,349435
- DEFVAR_LISP ("help-event-list"11472,349718
- DEFVAR_LISP ("help-form"11477,349929
- DEFVAR_LISP ("prefix-help-command"11483,350177
- DEFVAR_LISP ("top-level"11489,350455
- DEFVAR_KBOARD ("keyboard-translate-table"11495,350676
- DEFVAR_BOOL ("cannot-suspend"11511,351489
- DEFVAR_BOOL ("menu-prompting"11516,351716
- DEFVAR_LISP ("menu-prompt-more-char"11526,352146
- DEFVAR_INT ("extra-keyboard-modifiers"11531,352392
- DEFVAR_LISP ("deactivate-mark"11545,353118
- DEFVAR_LISP ("pre-command-hook"11553,353487
- DEFVAR_LISP ("post-command-hook"11560,353842
- DEFVAR_LISP ("echo-area-clear-hook"11568,354205
- DEFVAR_LISP ("lucid-menu-bar-dirty-flag"11574,354420
- DEFVAR_LISP ("menu-bar-final-items"11578,354623
- DEFVAR_LISP ("tool-bar-separator-image-expression"11583,354873
- DEFVAR_KBOARD ("overriding-terminal-local-map"11589,355231
- DEFVAR_LISP ("overriding-local-map"11598,355653
- DEFVAR_LISP ("overriding-local-map-menu-flag"11607,356104
- DEFVAR_LISP ("special-event-map"11613,356443
- DEFVAR_LISP ("track-mouse"11617,356631
- DEFVAR_KBOARD ("system-key-alist"11620,356758
- DEFVAR_KBOARD ("local-function-key-map"11629,357139
- DEFVAR_KBOARD ("input-decode-map"11658,358598
- DEFVAR_LISP ("function-key-map"11675,359386
- DEFVAR_LISP ("key-translation-map"11683,359802
- DEFVAR_LISP ("deferred-action-list"11689,360146
- DEFVAR_LISP ("deferred-action-function"11694,360394
- DEFVAR_LISP ("delayed-warnings-list"11700,360693
- DEFVAR_LISP ("timer-list"11708,361101
- DEFVAR_LISP ("timer-idle-list"11712,361253
- DEFVAR_LISP ("input-method-function"11716,361416
- DEFVAR_LISP ("input-method-previous-message"11737,362385
- DEFVAR_LISP ("show-help-function"11744,362746
- DEFVAR_LISP ("disable-point-adjustment"11749,362978
- DEFVAR_LISP ("global-disable-point-adjustment"11761,363528
- DEFVAR_LISP ("minibuffer-message-timeout"11770,363894
- DEFVAR_LISP ("throw-on-input"11775,364172
- DEFVAR_LISP ("command-error-function"11781,364423
- DEFVAR_LISP ("enable-disabled-menus-and-buttons"11790,364910
- DEFVAR_LISP ("select-active-regions"11798,365237
- DEFVAR_LISP ("saved-region-selection"11807,365629
- DEFVAR_LISP ("selection-inhibit-update-commands"11815,366014
- DEFVAR_LISP ("debug-on-event"11825,366555
-keys_of_keyboard 11841,367116
-mark_kboards 11916,370435
- DEFVAR_LISP ("internal--top-level-message",\111058,333973
- DEFVAR_LISP ("last-command-event",\111312,342174
- DEFVAR_LISP ("last-nonmenu-event",\111315,342298
- DEFVAR_LISP ("last-input-event",\111321,342637
- DEFVAR_LISP ("unread-command-events",\111324,342731
- DEFVAR_LISP ("unread-post-input-method-events",\111332,343191
- DEFVAR_LISP ("unread-input-method-events",\111338,343530
- DEFVAR_LISP ("meta-prefix-char",\111346,343899
- DEFVAR_KBOARD ("last-command",\111351,344107
- DEFVAR_KBOARD ("real-last-command",\111368,344788
- DEFVAR_KBOARD ("last-repeatable-command",\111372,344974
- DEFVAR_LISP ("this-command",\111378,345262
- DEFVAR_LISP ("real-this-command",\111384,345499
- DEFVAR_LISP ("this-command-keys-shift-translated",\111388,345681
- DEFVAR_LISP ("this-original-command",\111396,346124
- DEFVAR_INT ("auto-save-interval",\111403,346521
- DEFVAR_LISP ("auto-save-timeout",\111408,346735
- DEFVAR_LISP ("echo-keystrokes",\111415,347080
- DEFVAR_INT ("polling-period",\111421,347351
- DEFVAR_LISP ("double-click-time",\111428,347694
- DEFVAR_INT ("double-click-fuzz",\111435,348030
- DEFVAR_INT ("num-input-keys",\111446,348520
- DEFVAR_INT ("num-nonmacro-input-events",\111452,348795
- DEFVAR_LISP ("last-event-frame",\111457,349033
- DEFVAR_LISP ("tty-erase-char",\111463,349312
- DEFVAR_LISP ("help-char",\111466,349435
- DEFVAR_LISP ("help-event-list",\111472,349718
- DEFVAR_LISP ("help-form",\111477,349929
- DEFVAR_LISP ("prefix-help-command",\111483,350177
- DEFVAR_LISP ("top-level",\111489,350455
- DEFVAR_KBOARD ("keyboard-translate-table",\111495,350676
- DEFVAR_BOOL ("cannot-suspend",\111511,351489
- DEFVAR_BOOL ("menu-prompting",\111516,351716
- DEFVAR_LISP ("menu-prompt-more-char",\111526,352146
- DEFVAR_INT ("extra-keyboard-modifiers",\111531,352392
- DEFVAR_LISP ("deactivate-mark",\111545,353118
- DEFVAR_LISP ("pre-command-hook",\111553,353487
- DEFVAR_LISP ("post-command-hook",\111560,353842
- DEFVAR_LISP ("echo-area-clear-hook",\111568,354205
- DEFVAR_LISP ("lucid-menu-bar-dirty-flag",\111574,354420
- DEFVAR_LISP ("menu-bar-final-items",\111578,354623
- DEFVAR_LISP ("tool-bar-separator-image-expression",\111583,354873
- DEFVAR_KBOARD ("overriding-terminal-local-map",\111589,355231
- DEFVAR_LISP ("overriding-local-map",\111598,355653
- DEFVAR_LISP ("overriding-local-map-menu-flag",\111607,356104
- DEFVAR_LISP ("special-event-map",\111613,356443
- DEFVAR_LISP ("track-mouse",\111617,356631
- DEFVAR_KBOARD ("system-key-alist",\111620,356758
- DEFVAR_KBOARD ("local-function-key-map",\111629,357139
- DEFVAR_KBOARD ("input-decode-map",\111658,358598
- DEFVAR_LISP ("function-key-map",\111675,359386
- DEFVAR_LISP ("key-translation-map",\111683,359802
- DEFVAR_LISP ("deferred-action-list",\111689,360146
- DEFVAR_LISP ("deferred-action-function",\111694,360394
- DEFVAR_LISP ("delayed-warnings-list",\111700,360693
- DEFVAR_LISP ("timer-list",\111708,361101
- DEFVAR_LISP ("timer-idle-list",\111712,361253
- DEFVAR_LISP ("input-method-function",\111716,361416
- DEFVAR_LISP ("input-method-previous-message",\111737,362385
- DEFVAR_LISP ("show-help-function",\111744,362746
- DEFVAR_LISP ("disable-point-adjustment",\111749,362978
- DEFVAR_LISP ("global-disable-point-adjustment",\111761,363528
- DEFVAR_LISP ("minibuffer-message-timeout",\111770,363894
- DEFVAR_LISP ("throw-on-input",\111775,364172
- DEFVAR_LISP ("command-error-function",\111781,364423
- DEFVAR_LISP ("enable-disabled-menus-and-buttons",\111790,364910
- DEFVAR_LISP ("select-active-regions",\111798,365237
- DEFVAR_LISP ("saved-region-selection",\111807,365629
- DEFVAR_LISP ("selection-inhibit-update-commands",\111815,366014
- DEFVAR_LISP ("debug-on-event",\111825,366555
+make_lispy_movement 6104,183531
+make_lispy_switch_frame 6131,184262
+make_lispy_focus_in 6137,184369
+make_lispy_focus_out 6145,184495
+parse_modifiers_uncached 6163,184945
+#define SINGLE_LETTER_MOD(6185,185465
+#undef SINGLE_LETTER_MOD6212,185906
+#define MULTI_LETTER_MOD(6214,185932
+#undef MULTI_LETTER_MOD6231,186400
+apply_modifiers_uncached 6273,187574
+static const char *const modifier_names[modifier_names6319,189193
+#define NUM_MOD_NAMES 6325,189399
+static Lisp_Object modifier_symbols;6327,189449
+lispy_modifier_list 6331,189586
+#define KEY_TO_CHAR(6353,190252
+parse_modifiers 6356,190328
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191517
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191517
+apply_modifiers 6422,192391
+reorder_modifiers 6491,194720
+modify_event_symbol 6536,196528
+DEFUN ("event-convert-list", Fevent_convert_list,6628,199244
+DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199244
+parse_solitary_modifier 6695,201135
+#define SINGLE_LETTER_MOD(6701,201258
+#define MULTI_LETTER_MOD(6705,201343
+#undef SINGLE_LETTER_MOD6763,202641
+#undef MULTI_LETTER_MOD6764,202666
+lucid_event_type_list_p 6775,202889
+get_input_pending 6814,203960
+record_asynch_buffer_change 6834,204579
+gobble_input 6872,205702
+tty_read_avail_input 6967,208310
+handle_async_input 7149,214039
+process_pending_signals 7165,214359
+unblock_input_to 7177,214645
+unblock_input 7200,215277
+totally_unblock_input 7209,215445
+handle_input_available_signal 7217,215529
+deliver_input_available_signal 7226,215700
+struct user_signal_info7235,215865
+ int sig;7238,215915
+ char *name;name7241,215956
+ int npending;7244,216007
+ struct user_signal_info *next;next7246,216024
+static struct user_signal_info *user_signals user_signals7250,216090
+add_user_signal 7253,216149
+handle_user_signal 7275,216598
+deliver_user_signal 7316,217558
+find_user_signal_name 7322,217659
+store_user_signal_events 7334,217841
+static void menu_bar_item 7362,218341
+static Lisp_Object menu_bar_one_keymap_changed_items;7363,218416
+static Lisp_Object menu_bar_items_vector;7368,218630
+static int menu_bar_items_index;7369,218672
+static const char *separator_names[separator_names7372,218707
+menu_separator_name_p 7393,219148
+menu_bar_items 7426,219852
+Lisp_Object item_properties;7568,224603
+menu_bar_item 7571,224645
+menu_item_eval_property_1 7647,227175
+eval_dyn 7658,227465
+menu_item_eval_property 7666,227675
+parse_menu_item 7686,228341
+static Lisp_Object tool_bar_items_vector;7965,236336
+static Lisp_Object tool_bar_item_properties;7970,236510
+static int ntool_bar_items;7974,236606
+static void init_tool_bar_items 7978,236664
+static void process_tool_bar_item 7979,236711
+static bool parse_tool_bar_item 7981,236801
+static void append_tool_bar_item 7982,236861
+tool_bar_items 7990,237083
+process_tool_bar_item 8075,239892
+#define PROP(8112,240969
+set_prop 8114,241038
+parse_tool_bar_item 8167,242453
+#undef PROP8379,248844
+init_tool_bar_items 8387,248969
+append_tool_bar_item 8401,249261
+read_char_x_menu_prompt 8443,250771
+read_char_minibuf_menu_prompt 8503,252445
+#define PUSH_C_STR(8527,253014
+follow_key 8726,258553
+active_maps 8733,258695
+typedef struct keyremap8742,259021
+ Lisp_Object parent;8745,259107
+ Lisp_Object map;8748,259224
+ int start,8753,259446
+ int start, end;8753,259446
+} keyremap;8754,259464
+access_keymap_keyremap 8764,259808
+keyremap_step 8811,261450
+test_undefined 8867,262934
+read_key_sequence 8916,264861
+read_key_sequence_vs 9826,295821
+DEFUN ("read-key-sequence", Fread_key_sequence,9885,297294
+DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297294
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299982
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299982
+detect_input_pending 9950,300488
+detect_input_pending_ignore_squeezables 9959,300654
+detect_input_pending_run_timers 9967,300870
+clear_input_pending 9985,301362
+requeued_events_pending_p 9997,301732
+DEFUN ("input-pending-p", Finput_pending_p,10002,301813
+DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301813
+DEFUN ("recent-keys", Frecent_keys,10024,302596
+DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302596
+DEFUN ("this-command-keys", Fthis_command_keys,10055,303517
+DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303517
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303958
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303958
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304380
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304380
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304955
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304955
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305495
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305495
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306510
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306510
+DEFUN ("recursion-depth", Frecursion_depth,10158,307069
+DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307069
+DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307406
+DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307406
+DEFUN ("discard-input", Fdiscard_input,10203,308447
+DEFUN ("discard-input", Fdiscard_input,discard-input10203,308447
+DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308949
+DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308949
+stuff_buffered_input 10285,311045
+set_waiting_for_input 10323,312016
+clear_waiting_for_input 10337,312390
+handle_interrupt_signal 10351,312754
+deliver_interrupt_signal 10378,313642
+static int volatile force_quit_count;10387,313932
+handle_interrupt 10401,314414
+quit_throw_to_read_char 10541,318711
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319288
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319288
+DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320516
+DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320516
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321432
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321432
+DEFUN ("set-quit-char", Fset_quit_char,10694,322706
+DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322706
+DEFUN ("set-input-mode", Fset_input_mode,10729,323570
+DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323570
+DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324459
+DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324459
+DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325837
+DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325837
+DEFUN ("posn-at-point", Fposn_at_point,10824,327060
+DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327060
+init_kboard 10861,328214
+allocate_kboard 10893,329284
+wipe_kboard 10909,329637
+delete_kboard 10917,329751
+init_keyboard 10942,330281
+struct event_head11021,332696
+ short var;11023,332716
+ short kind;11024,332729
+static const struct event_head head_table[head_table11027,332747
+syms_of_keyboard 11045,333577
+ DEFVAR_LISP ("internal--top-level-message"11058,333972
+ DEFVAR_LISP ("last-command-event"11312,342173
+ DEFVAR_LISP ("last-nonmenu-event"11315,342297
+ DEFVAR_LISP ("last-input-event"11321,342636
+ DEFVAR_LISP ("unread-command-events"11324,342730
+ DEFVAR_LISP ("unread-post-input-method-events"11332,343190
+ DEFVAR_LISP ("unread-input-method-events"11338,343529
+ DEFVAR_LISP ("meta-prefix-char"11346,343898
+ DEFVAR_KBOARD ("last-command"11351,344106
+ DEFVAR_KBOARD ("real-last-command"11368,344787
+ DEFVAR_KBOARD ("last-repeatable-command"11372,344973
+ DEFVAR_LISP ("this-command"11378,345261
+ DEFVAR_LISP ("real-this-command"11384,345498
+ DEFVAR_LISP ("this-command-keys-shift-translated"11388,345680
+ DEFVAR_LISP ("this-original-command"11396,346123
+ DEFVAR_INT ("auto-save-interval"11403,346520
+ DEFVAR_LISP ("auto-save-timeout"11408,346734
+ DEFVAR_LISP ("echo-keystrokes"11415,347079
+ DEFVAR_INT ("polling-period"11421,347350
+ DEFVAR_LISP ("double-click-time"11428,347693
+ DEFVAR_INT ("double-click-fuzz"11435,348029
+ DEFVAR_INT ("num-input-keys"11446,348519
+ DEFVAR_INT ("num-nonmacro-input-events"11452,348794
+ DEFVAR_LISP ("last-event-frame"11457,349032
+ DEFVAR_LISP ("tty-erase-char"11463,349311
+ DEFVAR_LISP ("help-char"11466,349434
+ DEFVAR_LISP ("help-event-list"11472,349717
+ DEFVAR_LISP ("help-form"11477,349928
+ DEFVAR_LISP ("prefix-help-command"11483,350176
+ DEFVAR_LISP ("top-level"11489,350454
+ DEFVAR_KBOARD ("keyboard-translate-table"11495,350675
+ DEFVAR_BOOL ("cannot-suspend"11511,351488
+ DEFVAR_BOOL ("menu-prompting"11516,351715
+ DEFVAR_LISP ("menu-prompt-more-char"11526,352145
+ DEFVAR_INT ("extra-keyboard-modifiers"11531,352391
+ DEFVAR_LISP ("deactivate-mark"11545,353117
+ DEFVAR_LISP ("pre-command-hook"11553,353486
+ DEFVAR_LISP ("post-command-hook"11560,353841
+ DEFVAR_LISP ("echo-area-clear-hook"11568,354204
+ DEFVAR_LISP ("lucid-menu-bar-dirty-flag"11574,354419
+ DEFVAR_LISP ("menu-bar-final-items"11578,354622
+ DEFVAR_LISP ("tool-bar-separator-image-expression"11583,354872
+ DEFVAR_KBOARD ("overriding-terminal-local-map"11589,355230
+ DEFVAR_LISP ("overriding-local-map"11598,355652
+ DEFVAR_LISP ("overriding-local-map-menu-flag"11607,356103
+ DEFVAR_LISP ("special-event-map"11613,356442
+ DEFVAR_LISP ("track-mouse"11617,356630
+ DEFVAR_KBOARD ("system-key-alist"11620,356757
+ DEFVAR_KBOARD ("local-function-key-map"11629,357138
+ DEFVAR_KBOARD ("input-decode-map"11658,358597
+ DEFVAR_LISP ("function-key-map"11675,359385
+ DEFVAR_LISP ("key-translation-map"11683,359801
+ DEFVAR_LISP ("deferred-action-list"11689,360145
+ DEFVAR_LISP ("deferred-action-function"11694,360393
+ DEFVAR_LISP ("delayed-warnings-list"11700,360692
+ DEFVAR_LISP ("timer-list"11708,361100
+ DEFVAR_LISP ("timer-idle-list"11712,361252
+ DEFVAR_LISP ("input-method-function"11716,361415
+ DEFVAR_LISP ("input-method-previous-message"11737,362384
+ DEFVAR_LISP ("show-help-function"11744,362745
+ DEFVAR_LISP ("disable-point-adjustment"11749,362977
+ DEFVAR_LISP ("global-disable-point-adjustment"11761,363527
+ DEFVAR_LISP ("minibuffer-message-timeout"11770,363893
+ DEFVAR_LISP ("throw-on-input"11775,364171
+ DEFVAR_LISP ("command-error-function"11781,364422
+ DEFVAR_LISP ("enable-disabled-menus-and-buttons"11790,364909
+ DEFVAR_LISP ("select-active-regions"11798,365236
+ DEFVAR_LISP ("saved-region-selection"11807,365628
+ DEFVAR_LISP ("selection-inhibit-update-commands"11815,366013
+ DEFVAR_LISP ("debug-on-event"11825,366554
+keys_of_keyboard 11841,367115
+mark_kboards 11916,370434
+ DEFVAR_LISP ("internal--top-level-message",\111058,333972
+ DEFVAR_LISP ("last-command-event",\111312,342173
+ DEFVAR_LISP ("last-nonmenu-event",\111315,342297
+ DEFVAR_LISP ("last-input-event",\111321,342636
+ DEFVAR_LISP ("unread-command-events",\111324,342730
+ DEFVAR_LISP ("unread-post-input-method-events",\111332,343190
+ DEFVAR_LISP ("unread-input-method-events",\111338,343529
+ DEFVAR_LISP ("meta-prefix-char",\111346,343898
+ DEFVAR_KBOARD ("last-command",\111351,344106
+ DEFVAR_KBOARD ("real-last-command",\111368,344787
+ DEFVAR_KBOARD ("last-repeatable-command",\111372,344973
+ DEFVAR_LISP ("this-command",\111378,345261
+ DEFVAR_LISP ("real-this-command",\111384,345498
+ DEFVAR_LISP ("this-command-keys-shift-translated",\111388,345680
+ DEFVAR_LISP ("this-original-command",\111396,346123
+ DEFVAR_INT ("auto-save-interval",\111403,346520
+ DEFVAR_LISP ("auto-save-timeout",\111408,346734
+ DEFVAR_LISP ("echo-keystrokes",\111415,347079
+ DEFVAR_INT ("polling-period",\111421,347350
+ DEFVAR_LISP ("double-click-time",\111428,347693
+ DEFVAR_INT ("double-click-fuzz",\111435,348029
+ DEFVAR_INT ("num-input-keys",\111446,348519
+ DEFVAR_INT ("num-nonmacro-input-events",\111452,348794
+ DEFVAR_LISP ("last-event-frame",\111457,349032
+ DEFVAR_LISP ("tty-erase-char",\111463,349311
+ DEFVAR_LISP ("help-char",\111466,349434
+ DEFVAR_LISP ("help-event-list",\111472,349717
+ DEFVAR_LISP ("help-form",\111477,349928
+ DEFVAR_LISP ("prefix-help-command",\111483,350176
+ DEFVAR_LISP ("top-level",\111489,350454
+ DEFVAR_KBOARD ("keyboard-translate-table",\111495,350675
+ DEFVAR_BOOL ("cannot-suspend",\111511,351488
+ DEFVAR_BOOL ("menu-prompting",\111516,351715
+ DEFVAR_LISP ("menu-prompt-more-char",\111526,352145
+ DEFVAR_INT ("extra-keyboard-modifiers",\111531,352391
+ DEFVAR_LISP ("deactivate-mark",\111545,353117
+ DEFVAR_LISP ("pre-command-hook",\111553,353486
+ DEFVAR_LISP ("post-command-hook",\111560,353841
+ DEFVAR_LISP ("echo-area-clear-hook",\111568,354204
+ DEFVAR_LISP ("lucid-menu-bar-dirty-flag",\111574,354419
+ DEFVAR_LISP ("menu-bar-final-items",\111578,354622
+ DEFVAR_LISP ("tool-bar-separator-image-expression",\111583,354872
+ DEFVAR_KBOARD ("overriding-terminal-local-map",\111589,355230
+ DEFVAR_LISP ("overriding-local-map",\111598,355652
+ DEFVAR_LISP ("overriding-local-map-menu-flag",\111607,356103
+ DEFVAR_LISP ("special-event-map",\111613,356442
+ DEFVAR_LISP ("track-mouse",\111617,356630
+ DEFVAR_KBOARD ("system-key-alist",\111620,356757
+ DEFVAR_KBOARD ("local-function-key-map",\111629,357138
+ DEFVAR_KBOARD ("input-decode-map",\111658,358597
+ DEFVAR_LISP ("function-key-map",\111675,359385
+ DEFVAR_LISP ("key-translation-map",\111683,359801
+ DEFVAR_LISP ("deferred-action-list",\111689,360145
+ DEFVAR_LISP ("deferred-action-function",\111694,360393
+ DEFVAR_LISP ("delayed-warnings-list",\111700,360692
+ DEFVAR_LISP ("timer-list",\111708,361100
+ DEFVAR_LISP ("timer-idle-list",\111712,361252
+ DEFVAR_LISP ("input-method-function",\111716,361415
+ DEFVAR_LISP ("input-method-previous-message",\111737,362384
+ DEFVAR_LISP ("show-help-function",\111744,362745
+ DEFVAR_LISP ("disable-point-adjustment",\111749,362977
+ DEFVAR_LISP ("global-disable-point-adjustment",\111761,363527
+ DEFVAR_LISP ("minibuffer-message-timeout",\111770,363893
+ DEFVAR_LISP ("throw-on-input",\111775,364171
+ DEFVAR_LISP ("command-error-function",\111781,364422
+ DEFVAR_LISP ("enable-disabled-menus-and-buttons",\111790,364909
+ DEFVAR_LISP ("select-active-regions",\111798,365236
+ DEFVAR_LISP ("saved-region-selection",\111807,365628
+ DEFVAR_LISP ("selection-inhibit-update-commands",\111815,366013
+ DEFVAR_LISP ("debug-on-event",\111825,366554
c-src/emacs/src/lisp.h,41391
#define EMACS_LISP_H22,801
@@ -3253,11 +3249,11 @@ main(37,571
D(43,659
int x;44,694
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5188
(defvar tags-file-name 34,1035
@@ -4050,22 +4046,22 @@ ord_add_element(71,1867
ord_del_element(85,2344
ord_disjoint(100,2783
ord_intersect(108,2953
-ord_intersection(126,3552
-ord_intersection3(130,3691
-ord_intersection(150,4531
-ord_intersection4(154,4703
-ord_intersection(176,5664
-ord_intersection2(181,5812
-ord_member(200,6318
-ord_seteq(216,6683
-ord_setproduct(225,6971
-ord_subset(240,7377
-ord_subtract(257,7861
-ord_symdiff(265,8054
-ord_union(288,8887
-ord_union4(303,9352
-ord_union(324,10171
-ord_union_all(329,10313
+ord_intersection(126,3553
+ord_intersection3(130,3692
+ord_intersection(150,4533
+ord_intersection4(154,4705
+ord_intersection(176,5666
+ord_intersection2(181,5814
+ord_member(200,6320
+ord_seteq(216,6685
+ord_setproduct(225,6973
+ord_subset(240,7379
+ord_subtract(257,7863
+ord_symdiff(265,8056
+ord_union(288,8889
+ord_union4(303,9354
+ord_union(324,10173
+ord_union_all(329,10315
prol-src/natded.prolog,2319
expandmng(100,2879
@@ -4280,6 +4276,11 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+rs-src/test.rs,52
+enum IpAddrKind 3,11
+fn test1(8,48
+fn main(12,88
+
scm-src/test.scm,260
(define hello 1,0
(set! hello 3,32
@@ -4494,533 +4495,687 @@ tex-src/texinfo.tex,30627
\def\vritemindex #1{\vritemindex1068,35482
\def\tablez #1#2#3#4#5#6{\tablez1074,35631
\def\Edescription{\Edescription1077,35689
-\def\itemfont{\itemfont1082,35891
-\def\Etable{\Etable1090,36117
-\def\itemize{\itemize1103,36441
-\def\itemizezzz #1{\itemizezzz1105,36477
-\def\itemizey #1#2{\itemizey1110,36572
-\def#2{1119,36818
-\def\itemcontents{\itemcontents1120,36859
-\def\bullet{\bullet1123,36907
-\def\minus{\minus1124,36934
-\def\frenchspacing{\frenchspacing1128,37042
-\def\splitoff#1#2\endmark{\splitoff1134,37267
-\def\enumerate{\enumerate1140,37497
-\def\enumeratezzz #1{\enumeratezzz1141,37536
-\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37589
- \def\thearg{\thearg1146,37736
- \ifx\thearg\empty \def\thearg{\thearg1147,37755
-\def\numericenumerate{\numericenumerate1184,39089
-\def\lowercaseenumerate{\lowercaseenumerate1190,39219
-\def\uppercaseenumerate{\uppercaseenumerate1203,39566
-\def\startenumeration#1{\startenumeration1219,40056
-\def\alphaenumerate{\alphaenumerate1227,40238
-\def\capsenumerate{\capsenumerate1228,40273
-\def\Ealphaenumerate{\Ealphaenumerate1229,40307
-\def\Ecapsenumerate{\Ecapsenumerate1230,40341
-\def\itemizeitem{\itemizeitem1234,40421
-\def\newindex #1{\newindex1259,41278
-\def\defindex{\defindex1268,41567
-\def\newcodeindex #1{\newcodeindex1272,41675
-\def\defcodeindex{\defcodeindex1279,41935
-\def\synindex #1 #2 {\synindex1283,42115
-\def\syncodeindex #1 #2 {\syncodeindex1292,42455
-\def\doindex#1{\doindex1309,43134
-\def\singleindexer #1{\singleindexer1310,43193
-\def\docodeindex#1{\docodeindex1313,43305
-\def\singlecodeindexer #1{\singlecodeindexer1314,43372
-\def\indexdummies{\indexdummies1316,43430
-\def\_{\_1317,43450
-\def\w{\w1318,43478
-\def\bf{\bf1319,43505
-\def\rm{\rm1320,43534
-\def\sl{\sl1321,43563
-\def\sf{\sf1322,43592
-\def\tt{\tt1323,43620
-\def\gtr{\gtr1324,43648
-\def\less{\less1325,43678
-\def\hat{\hat1326,43710
-\def\char{\char1327,43740
-\def\TeX{\TeX1328,43772
-\def\dots{\dots1329,43802
-\def\copyright{\copyright1330,43835
-\def\tclose##1{\tclose1331,43878
-\def\code##1{\code1332,43923
-\def\samp##1{\samp1333,43964
-\def\t##1{\t1334,44005
-\def\r##1{\r1335,44040
-\def\i##1{\i1336,44075
-\def\b##1{\b1337,44110
-\def\cite##1{\cite1338,44145
-\def\key##1{\key1339,44186
-\def\file##1{\file1340,44225
-\def\var##1{\var1341,44266
-\def\kbd##1{\kbd1342,44305
-\def\indexdummyfont#1{\indexdummyfont1347,44461
-\def\indexdummytex{\indexdummytex1348,44487
-\def\indexdummydots{\indexdummydots1349,44511
-\def\indexnofonts{\indexnofonts1351,44537
-\let\w=\indexdummyfontdummyfont1352,44557
-\let\t=\indexdummyfontdummyfont1353,44580
-\let\r=\indexdummyfontdummyfont1354,44603
-\let\i=\indexdummyfontdummyfont1355,44626
-\let\b=\indexdummyfontdummyfont1356,44649
-\let\emph=\indexdummyfontdummyfont1357,44672
-\let\strong=\indexdummyfontdummyfont1358,44698
-\let\cite=\indexdummyfont=\indexdummyfont1359,44726
-\let\sc=\indexdummyfontdummyfont1360,44752
-\let\tclose=\indexdummyfontdummyfont1364,44924
-\let\code=\indexdummyfontdummyfont1365,44952
-\let\file=\indexdummyfontdummyfont1366,44978
-\let\samp=\indexdummyfontdummyfont1367,45004
-\let\kbd=\indexdummyfontdummyfont1368,45030
-\let\key=\indexdummyfontdummyfont1369,45055
-\let\var=\indexdummyfontdummyfont1370,45080
-\let\TeX=\indexdummytexdummytex1371,45105
-\let\dots=\indexdummydotsdummydots1372,45129
-\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45381
-\def\doind #1#2{\doind1384,45437
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45480
-\def\rawbackslashxx{\rawbackslashxx1389,45620
-{\indexnofontsnofonts1394,45882
-\def\dosubind #1#2#3{\dosubind1405,46193
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46241
-\def\rawbackslashxx{\rawbackslashxx1410,46345
-{\indexnofontsnofonts1414,46499
-\def\findex {\findex1443,47430
-\def\kindex {\kindex1444,47453
-\def\cindex {\cindex1445,47476
-\def\vindex {\vindex1446,47499
-\def\tindex {\tindex1447,47522
-\def\pindex {\pindex1448,47545
-\def\cindexsub {\cindexsub1450,47569
-\def\printindex{\printindex1462,47896
-\def\doprintindex#1{\doprintindex1464,47937
- \def\indexbackslash{\indexbackslash1481,48422
- \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48461
-\def\initial #1{\initial1517,49533
-\def\entry #1#2{\entry1523,49740
- \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50387
-\def\indexdotfill{\indexdotfill1549,50715
-\def\primary #1{\primary1552,50821
-\def\secondary #1#2{\secondary1556,50903
-\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50985
-\newbox\partialpageialpage1566,51158
-\def\begindoublecolumns{\begindoublecolumns1572,51316
- \output={\global\setbox\partialpage=ialpage=1573,51352
-\def\enddoublecolumns{\enddoublecolumns1577,51540
-\def\doublecolumnout{\doublecolumnout1580,51625
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51694
-\def\pagesofar{\pagesofar1584,51872
-\def\balancecolumns{\balancecolumns1588,52109
- \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52280
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52541
-\newcount \appendixno \appendixno = `\@no1627,53446
-\def\appendixletter{\appendixletter1628,53487
-\def\opencontents{\opencontents1632,53590
-\def\thischapter{\thischapter1637,53771
-\def\seccheck#1{\seccheck1638,53809
-\def\chapternofonts{\chapternofonts1643,53913
-\def\result{\result1646,53988
-\def\equiv{\equiv1647,54023
-\def\expansion{\expansion1648,54056
-\def\print{\print1649,54097
-\def\TeX{\TeX1650,54130
-\def\dots{\dots1651,54159
-\def\copyright{\copyright1652,54190
-\def\tt{\tt1653,54231
-\def\bf{\bf1654,54258
-\def\w{\w1655,54286
-\def\less{\less1656,54311
-\def\gtr{\gtr1657,54342
-\def\hat{\hat1658,54371
-\def\char{\char1659,54400
-\def\tclose##1{\tclose1660,54431
-\def\code##1{\code1661,54475
-\def\samp##1{\samp1662,54515
-\def\r##1{\r1663,54555
-\def\b##1{\b1664,54589
-\def\key##1{\key1665,54623
-\def\file##1{\file1666,54661
-\def\kbd##1{\kbd1667,54701
-\def\i##1{\i1669,54809
-\def\cite##1{\cite1670,54843
-\def\var##1{\var1671,54883
-\def\emph##1{\emph1672,54921
-\def\dfn##1{\dfn1673,54961
-\def\thischaptername{\thischaptername1676,55002
-\outer\def\chapter{\chapter1677,55041
-\def\chapterzzz #1{\chapterzzz1678,55082
-{\chapternofonts%nofonts%1687,55478
-\global\let\section = \numberedsec=1692,55631
-\global\let\subsection = \numberedsubsec=1693,55666
-\global\let\subsubsection = \numberedsubsubsec=1694,55707
-\outer\def\appendix{\appendix1697,55758
-\def\appendixzzz #1{\appendixzzz1698,55801
-\global\advance \appendixno by 1 \message{no1700,55878
-\chapmacro {#1}{Appendix \appendixletter}letter1701,55947
-\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56040
-{\chapternofonts%nofonts%1705,56112
- {#1}{Appendix \appendixletter}letter1707,56168
-\appendixnoderef %noderef1710,56268
-\global\let\section = \appendixsec=1711,56287
-\global\let\subsection = \appendixsubsec=1712,56322
-\global\let\subsubsection = \appendixsubsubsec=1713,56363
-\outer\def\top{\top1716,56414
-\outer\def\unnumbered{\unnumbered1717,56454
-\def\unnumberedzzz #1{\unnumberedzzz1718,56501
-{\chapternofonts%nofonts%1722,56664
-\global\let\section = \unnumberedsec=1727,56814
-\global\let\subsection = \unnumberedsubsec=1728,56851
-\global\let\subsubsection = \unnumberedsubsubsec=1729,56894
-\outer\def\numberedsec{\numberedsec1732,56947
-\def\seczzz #1{\seczzz1733,56988
-{\chapternofonts%nofonts%1736,57144
-\outer\def\appendixsection{\appendixsection1745,57330
-\outer\def\appendixsec{\appendixsec1746,57387
-\def\appendixsectionzzz #1{\appendixsectionzzz1747,57440
-\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57552
-{\chapternofonts%nofonts%1750,57620
-{#1}{\appendixletter}letter1752,57676
-\appendixnoderef %noderef1755,57776
-\outer\def\unnumberedsec{\unnumberedsec1759,57816
-\def\unnumberedseczzz #1{\unnumberedseczzz1760,57869
-{\chapternofonts%nofonts%1762,57964
-\outer\def\numberedsubsec{\numberedsubsec1770,58132
-\def\numberedsubseczzz #1{\numberedsubseczzz1771,58187
-{\chapternofonts%nofonts%1774,58366
-\outer\def\appendixsubsec{\appendixsubsec1783,58570
-\def\appendixsubseczzz #1{\appendixsubseczzz1784,58625
-\subsecheading {#1}{\appendixletter}letter1786,58747
-{\chapternofonts%nofonts%1787,58812
-{#1}{\appendixletter}letter1789,58871
-\appendixnoderef %noderef1792,58986
-\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59026
-\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59085
-{\chapternofonts%nofonts%1799,59186
-\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59357
-\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59418
-{\chapternofonts%nofonts%1812,59615
-\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59848
-\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59909
- {\appendixletter}letter1827,60048
-{\chapternofonts%nofonts%1828,60114
- {\appendixletter}letter1830,60179
-\appendixnoderef %noderef1834,60313
-\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60353
-\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60418
-{\chapternofonts%nofonts%1841,60525
-\def\infotop{\infotop1851,60854
-\def\infounnumbered{\infounnumbered1852,60892
-\def\infounnumberedsec{\infounnumberedsec1853,60937
-\def\infounnumberedsubsec{\infounnumberedsubsec1854,60988
-\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61045
-\def\infoappendix{\infoappendix1857,61109
-\def\infoappendixsec{\infoappendixsec1858,61150
-\def\infoappendixsubsec{\infoappendixsubsec1859,61197
-\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61250
-\def\infochapter{\infochapter1862,61310
-\def\infosection{\infosection1863,61349
-\def\infosubsection{\infosubsection1864,61388
-\def\infosubsubsection{\infosubsubsection1865,61433
-\global\let\section = \numberedsec=1870,61670
-\global\let\subsection = \numberedsubsec=1871,61705
-\global\let\subsubsection = \numberedsubsubsec=1872,61746
-\def\majorheading{\majorheading1886,62253
-\def\majorheadingzzz #1{\majorheadingzzz1887,62298
-\def\chapheading{\chapheading1893,62531
-\def\chapheadingzzz #1{\chapheadingzzz1894,62574
-\def\heading{\heading1899,62769
-\def\subheading{\subheading1901,62806
-\def\subsubheading{\subsubheading1903,62849
-\def\dobreak#1#2{\dobreak1910,63126
-\def\setchapterstyle #1 {\setchapterstyle1912,63204
-\def\chapbreak{\chapbreak1919,63459
-\def\chappager{\chappager1920,63509
-\def\chapoddpage{\chapoddpage1921,63547
-\def\setchapternewpage #1 {\setchapternewpage1923,63626
-\def\CHAPPAGoff{\CHAPPAGoff1925,63683
-\def\CHAPPAGon{\CHAPPAGon1929,63777
-\global\def\HEADINGSon{\HEADINGSon1932,63868
-\def\CHAPPAGodd{\CHAPPAGodd1934,63910
-\global\def\HEADINGSon{\HEADINGSon1937,64006
-\def\CHAPFplain{\CHAPFplain1941,64060
-\def\chfplain #1#2{\chfplain1945,64152
-\def\unnchfplain #1{\unnchfplain1956,64375
-\def\unnchfopen #1{\unnchfopen1964,64604
-\def\chfopen #1#2{\chfopen1970,64812
-\def\CHAPFopen{\CHAPFopen1975,64956
-\def\subsecheadingbreak{\subsecheadingbreak1982,65174
-\def\secheadingbreak{\secheadingbreak1985,65303
-\def\secheading #1#2#3{\secheading1993,65585
-\def\plainsecheading #1{\plainsecheading1994,65641
-\def\secheadingi #1{\secheadingi1995,65684
-\def\subsecheading #1#2#3#4{\subsecheading2006,66052
-\def\subsecheadingi #1{\subsecheadingi2007,66119
-\def\subsubsecfonts{\subsubsecfonts2014,66416
-\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66539
-\def\subsubsecheadingi #1{\subsubsecheadingi2018,66617
-\def\startcontents#1{\startcontents2032,67089
- \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67362
-\outer\def\contents{\contents2049,67721
-\outer\def\summarycontents{\summarycontents2057,67865
- \def\secentry ##1##2##3##4{\secentry2067,68236
- \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68271
- \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68306
- \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68347
- \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68385
- \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68432
-\def\chapentry#1#2#3{\chapentry2085,68866
-\def\shortchapentry#1#2#3{\shortchapentry2088,68983
- {#2\labelspace #1}space2091,69093
-\def\unnumbchapentry#1#2{\unnumbchapentry2094,69147
-\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69194
-\def\secentry#1#2#3#4{\secentry2102,69358
-\def\unnumbsecentry#1#2{\unnumbsecentry2103,69417
-\def\subsecentry#1#2#3#4#5{\subsecentry2106,69478
-\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69548
-\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69622
- \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69656
-\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69707
-\def\dochapentry#1#2{\dochapentry2123,70081
-\def\dosecentry#1#2{\dosecentry2138,70686
-\def\dosubsecentry#1#2{\dosubsecentry2145,70864
-\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71049
-\def\labelspace{\labelspace2160,71300
-\def\dopageno#1{\dopageno2162,71335
-\def\doshortpageno#1{\doshortpageno2163,71361
-\def\chapentryfonts{\chapentryfonts2165,71393
-\def\secentryfonts{\secentryfonts2166,71428
-\def\point{\point2192,72387
-\def\result{\result2194,72408
-\def\expansion{\expansion2195,72481
-\def\print{\print2196,72552
-\def\equiv{\equiv2198,72619
-\def\error{\error2218,73392
-\def\tex{\tex2224,73621
-\def\@{\@2242,74004
-\gdef\sepspaces{\def {\ }}}\2265,74736
-\def\aboveenvbreak{\aboveenvbreak2268,74818
-\def\afterenvbreak{\afterenvbreak2272,74984
-\def\ctl{\ctl2286,75495
-\def\ctr{\ctr2287,75567
-\def\cbl{\cbl2288,75606
-\def\cbr{\cbr2289,75646
-\def\carttop{\carttop2290,75685
-\def\cartbot{\cartbot2293,75793
-\long\def\cartouche{\cartouche2299,75933
-\def\Ecartouche{\Ecartouche2326,76721
-\def\lisp{\lisp2338,76856
-\def\Elisp{\Elisp2348,77203
-\def\next##1{\next2360,77529
-\def\Eexample{\Eexample2364,77571
-\def\Esmallexample{\Esmallexample2367,77618
-\def\smalllispx{\smalllispx2373,77796
-\def\Esmalllisp{\Esmalllisp2383,78150
-\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78506
-\def\next##1{\next2397,78563
-\def\display{\display2401,78643
-\def\Edisplay{\Edisplay2410,78962
-\def\next##1{\next2422,79273
-\def\format{\format2426,79376
-\def\Eformat{\Eformat2434,79672
-\def\next##1{\next2437,79761
-\def\flushleft{\flushleft2441,79813
-\def\Eflushleft{\Eflushleft2451,80184
-\def\next##1{\next2454,80277
-\def\flushright{\flushright2456,80299
-\def\Eflushright{\Eflushright2466,80671
-\def\next##1{\next2470,80802
-\def\quotation{\quotation2474,80860
-\def\Equotation{\Equotation2480,81052
-\def\setdeffont #1 {\setdeffont2493,81450
-\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81496
-\newskip\defargsindent \defargsindent=50ptargsindent2496,81539
-\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81582
-\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81625
-\def\activeparens{\activeparens2503,81823
-\def\opnr{\opnr2529,83035
-\def\lbrb{\lbrb2530,83100
-\def\defname #1#2{\defname2536,83301
-\advance\dimen2 by -\defbodyindentbodyindent2540,83419
-\advance\dimen3 by -\defbodyindentbodyindent2542,83473
-\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83527
-\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83669
-\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83744
-\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84113
-\advance\leftskip by -\defbodyindentbodyindent2557,84247
-\exdentamount=\defbodyindentbodyindent2558,84284
-\def\defparsebody #1#2#3{\defparsebody2568,84643
-\def#1{2572,84827
-\def#2{2573,84863
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84935
-\exdentamount=\defbodyindentbodyindent2576,85009
-\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85113
-\def#1{2585,85274
-\def#2##1 {2586,85310
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85393
-\exdentamount=\defbodyindentbodyindent2589,85467
-\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85552
-\def#1{2596,85713
-\def#2##1 ##2 {2597,85749
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85849
-\exdentamount=\defbodyindentbodyindent2601,85923
-\def\defvarparsebody #1#2#3{\defvarparsebody2608,86194
-\def#1{2612,86381
-\def#2{2613,86417
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86476
-\exdentamount=\defbodyindentbodyindent2616,86550
-\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86641
-\def#1{2625,86800
-\def#2##1 {2626,86836
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86906
-\exdentamount=\defbodyindentbodyindent2629,86980
-\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87052
-\def#1{2636,87216
-\def#2##1 ##2 {2637,87252
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87339
-\exdentamount=\defbodyindentbodyindent2641,87413
-\def\defunargs #1{\defunargs2664,88173
-\def\deftypefunargs #1{\deftypefunargs2676,88555
-\def\deffn{\deffn2690,88937
-\def\deffnheader #1#2#3{\deffnheader2692,88994
-\begingroup\defname {name2693,89042
-\def\defun{\defun2699,89187
-\def\defunheader #1#2{\defunheader2701,89240
-\begingroup\defname {name2702,89315
-\defunargs {unargs2703,89351
-\def\deftypefun{\deftypefun2709,89499
-\def\deftypefunheader #1#2{\deftypefunheader2712,89621
-\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89730
-\begingroup\defname {name2716,89822
-\deftypefunargs {typefunargs2717,89868
-\def\deftypefn{\deftypefn2723,90039
-\def\deftypefnheader #1#2#3{\deftypefnheader2726,90188
-\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90324
-\begingroup\defname {name2730,90417
-\deftypefunargs {typefunargs2731,90457
-\def\defmac{\defmac2737,90578
-\def\defmacheader #1#2{\defmacheader2739,90635
-\begingroup\defname {name2740,90711
-\defunargs {unargs2741,90744
-\def\defspec{\defspec2747,90868
-\def\defspecheader #1#2{\defspecheader2749,90929
-\begingroup\defname {name2750,91006
-\defunargs {unargs2751,91046
-\def\deffnx #1 {\deffnx2758,91241
-\def\defunx #1 {\defunx2759,91298
-\def\defmacx #1 {\defmacx2760,91355
-\def\defspecx #1 {\defspecx2761,91414
-\def\deftypefnx #1 {\deftypefnx2762,91475
-\def\deftypeunx #1 {\deftypeunx2763,91540
-\def\defop #1 {\defop2769,91686
-\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91721
-\def\defopheader #1#2#3{\defopheader2772,91775
-\begingroup\defname {name2774,91864
-\defunargs {unargs2775,91910
-\def\defmethod{\defmethod2780,91971
-\def\defmethodheader #1#2#3{\defmethodheader2782,92044
-\begingroup\defname {name2784,92132
-\defunargs {unargs2785,92172
-\def\defcv #1 {\defcv2790,92246
-\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92281
-\def\defcvarheader #1#2#3{\defcvarheader2793,92340
-\begingroup\defname {name2795,92426
-\defvarargs {varargs2796,92472
-\def\defivar{\defivar2801,92545
-\def\defivarheader #1#2#3{\defivarheader2803,92608
-\begingroup\defname {name2805,92694
-\defvarargs {varargs2806,92745
-\def\defopx #1 {\defopx2812,92894
-\def\defmethodx #1 {\defmethodx2813,92951
-\def\defcvx #1 {\defcvx2814,93016
-\def\defivarx #1 {\defivarx2815,93073
-\def\defvarargs #1{\defvarargs2822,93344
-\def\defvr{\defvr2828,93488
-\def\defvrheader #1#2#3{\defvrheader2830,93543
-\begingroup\defname {name2831,93591
-\def\defvar{\defvar2835,93676
-\def\defvarheader #1#2{\defvarheader2837,93736
-\begingroup\defname {name2838,93807
-\defvarargs {varargs2839,93843
-\def\defopt{\defopt2844,93909
-\def\defoptheader #1#2{\defoptheader2846,93969
-\begingroup\defname {name2847,94040
-\defvarargs {varargs2848,94079
-\def\deftypevar{\deftypevar2853,94136
-\def\deftypevarheader #1#2{\deftypevarheader2856,94252
-\begingroup\defname {name2858,94335
-\def\deftypevr{\deftypevr2865,94509
-\def\deftypevrheader #1#2#3{\deftypevrheader2867,94580
-\begingroup\defname {name2868,94632
-\def\defvrx #1 {\defvrx2876,94869
-\def\defvarx #1 {\defvarx2877,94926
-\def\defoptx #1 {\defoptx2878,94985
-\def\deftypevarx #1 {\deftypevarx2879,95044
-\def\deftypevrx #1 {\deftypevrx2880,95111
-\def\deftpargs #1{\deftpargs2885,95260
-\def\deftp{\deftp2889,95340
-\def\deftpheader #1#2#3{\deftpheader2891,95395
-\begingroup\defname {name2892,95443
-\def\deftpx #1 {\deftpx2897,95602
-\def\setref#1{\setref2908,95923
-\def\unnumbsetref#1{\unnumbsetref2913,96037
-\def\appendixsetref#1{\appendixsetref2918,96144
-\def\pxref#1{\pxref2929,96555
-\def\xref#1{\xref2930,96591
-\def\ref#1{\ref2931,96626
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96656
-\def\printedmanual{\printedmanual2933,96699
-\def\printednodename{\printednodename2934,96737
-\def\printednodename{\printednodename2939,96862
-section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97495
-\refx{x2957,97573
-\def\dosetq #1#2{\dosetq2965,97793
-\def\internalsetq #1#2{\internalsetq2973,98051
-\def\Ypagenumber{\Ypagenumber2977,98152
-\def\Ytitle{\Ytitle2979,98178
-\def\Ynothing{\Ynothing2981,98205
-\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98222
-\def\Yappendixletterandtype{\Yappendixletterandtype2992,98538
-\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98568
-\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98623
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98727
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98798
- \def\linenumber{\linenumber3009,99137
-\def\refx#1#2{\refx3015,99321
-\def\xrdef #1#2{\xrdef3037,99947
-\def\readauxfile{\readauxfile3040,100032
-\def\supereject{\supereject3110,101813
-\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102498
-\def\openindices{\openindices3139,102684
-\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102909
-\parindent = \defaultparindentaultparindent3152,102961
-\def\smallbook{\smallbook3175,103685
-\global\def\Esmallexample{\Esmallexample3192,104112
-\def\afourpaper{\afourpaper3196,104203
-\def\finalout{\finalout3224,105011
-\def\normaldoublequote{\normaldoublequote3235,105272
-\def\normaltilde{\normaltilde3236,105298
-\def\normalcaret{\normalcaret3237,105318
-\def\normalunderscore{\normalunderscore3238,105338
-\def\normalverticalbar{\normalverticalbar3239,105363
-\def\normalless{\normalless3240,105389
-\def\normalgreater{\normalgreater3241,105408
-\def\normalplus{\normalplus3242,105430
-\def\ifusingtt#1#2{\ifusingtt3253,105922
-\def\activedoublequote{\activedoublequote3261,106250
-\def~{~3264,106336
-\def^{^3267,106397
-\def_{_3270,106436
-\def\_{\_3272,106510
-\def\lvvmode{\lvvmode3279,106847
-\def|{|3282,106897
-\def<{<3285,106960
-\def>{>3288,107017
-\def+{+3290,107055
-\def\turnoffactive{\turnoffactive3296,107216
-\global\def={=3307,107502
-\def\normalbackslash{\normalbackslash3321,107884
+\def\itemfont{\itemfont1082,35890
+\def\Etable{\Etable1090,36116
+\def\itemize{\itemize1103,36440
+\def\itemizezzz #1{\itemizezzz1105,36476
+\def\itemizey #1#2{\itemizey1110,36571
+\def#2{1119,36817
+\def\itemcontents{\itemcontents1120,36858
+\def\bullet{\bullet1123,36906
+\def\minus{\minus1124,36933
+\def\frenchspacing{\frenchspacing1128,37041
+\def\splitoff#1#2\endmark{\splitoff1134,37266
+\def\enumerate{\enumerate1140,37496
+\def\enumeratezzz #1{\enumeratezzz1141,37535
+\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37588
+ \def\thearg{\thearg1146,37735
+ \ifx\thearg\empty \def\thearg{\thearg1147,37754
+\def\numericenumerate{\numericenumerate1184,39088
+\def\lowercaseenumerate{\lowercaseenumerate1190,39218
+\def\uppercaseenumerate{\uppercaseenumerate1203,39565
+\def\startenumeration#1{\startenumeration1219,40055
+\def\alphaenumerate{\alphaenumerate1227,40237
+\def\capsenumerate{\capsenumerate1228,40272
+\def\Ealphaenumerate{\Ealphaenumerate1229,40306
+\def\Ecapsenumerate{\Ecapsenumerate1230,40340
+\def\itemizeitem{\itemizeitem1234,40420
+\def\newindex #1{\newindex1259,41277
+\def\defindex{\defindex1268,41566
+\def\newcodeindex #1{\newcodeindex1272,41674
+\def\defcodeindex{\defcodeindex1279,41934
+\def\synindex #1 #2 {\synindex1283,42114
+\def\syncodeindex #1 #2 {\syncodeindex1292,42454
+\def\doindex#1{\doindex1309,43133
+\def\singleindexer #1{\singleindexer1310,43192
+\def\docodeindex#1{\docodeindex1313,43304
+\def\singlecodeindexer #1{\singlecodeindexer1314,43371
+\def\indexdummies{\indexdummies1316,43429
+\def\_{\_1317,43449
+\def\w{\w1318,43477
+\def\bf{\bf1319,43504
+\def\rm{\rm1320,43533
+\def\sl{\sl1321,43562
+\def\sf{\sf1322,43591
+\def\tt{\tt1323,43619
+\def\gtr{\gtr1324,43647
+\def\less{\less1325,43677
+\def\hat{\hat1326,43709
+\def\char{\char1327,43739
+\def\TeX{\TeX1328,43771
+\def\dots{\dots1329,43801
+\def\copyright{\copyright1330,43834
+\def\tclose##1{\tclose1331,43877
+\def\code##1{\code1332,43922
+\def\samp##1{\samp1333,43963
+\def\t##1{\t1334,44004
+\def\r##1{\r1335,44039
+\def\i##1{\i1336,44074
+\def\b##1{\b1337,44109
+\def\cite##1{\cite1338,44144
+\def\key##1{\key1339,44185
+\def\file##1{\file1340,44224
+\def\var##1{\var1341,44265
+\def\kbd##1{\kbd1342,44304
+\def\indexdummyfont#1{\indexdummyfont1347,44460
+\def\indexdummytex{\indexdummytex1348,44486
+\def\indexdummydots{\indexdummydots1349,44510
+\def\indexnofonts{\indexnofonts1351,44536
+\let\w=\indexdummyfontdummyfont1352,44556
+\let\t=\indexdummyfontdummyfont1353,44579
+\let\r=\indexdummyfontdummyfont1354,44602
+\let\i=\indexdummyfontdummyfont1355,44625
+\let\b=\indexdummyfontdummyfont1356,44648
+\let\emph=\indexdummyfontdummyfont1357,44671
+\let\strong=\indexdummyfontdummyfont1358,44697
+\let\cite=\indexdummyfont=\indexdummyfont1359,44725
+\let\sc=\indexdummyfontdummyfont1360,44751
+\let\tclose=\indexdummyfontdummyfont1364,44923
+\let\code=\indexdummyfontdummyfont1365,44951
+\let\file=\indexdummyfontdummyfont1366,44977
+\let\samp=\indexdummyfontdummyfont1367,45003
+\let\kbd=\indexdummyfontdummyfont1368,45029
+\let\key=\indexdummyfontdummyfont1369,45054
+\let\var=\indexdummyfontdummyfont1370,45079
+\let\TeX=\indexdummytexdummytex1371,45104
+\let\dots=\indexdummydotsdummydots1372,45128
+\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45380
+\def\doind #1#2{\doind1384,45436
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45479
+\def\rawbackslashxx{\rawbackslashxx1389,45619
+{\indexnofontsnofonts1394,45881
+\def\dosubind #1#2#3{\dosubind1405,46192
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46240
+\def\rawbackslashxx{\rawbackslashxx1410,46344
+{\indexnofontsnofonts1414,46498
+\def\findex {\findex1443,47429
+\def\kindex {\kindex1444,47452
+\def\cindex {\cindex1445,47475
+\def\vindex {\vindex1446,47498
+\def\tindex {\tindex1447,47521
+\def\pindex {\pindex1448,47544
+\def\cindexsub {\cindexsub1450,47568
+\def\printindex{\printindex1462,47895
+\def\doprintindex#1{\doprintindex1464,47936
+ \def\indexbackslash{\indexbackslash1481,48421
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48460
+\def\initial #1{\initial1517,49532
+\def\entry #1#2{\entry1523,49739
+ \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50386
+\def\indexdotfill{\indexdotfill1549,50714
+\def\primary #1{\primary1552,50820
+\def\secondary #1#2{\secondary1556,50902
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50984
+\newbox\partialpageialpage1566,51157
+\def\begindoublecolumns{\begindoublecolumns1572,51315
+ \output={\global\setbox\partialpage=ialpage=1573,51351
+\def\enddoublecolumns{\enddoublecolumns1577,51539
+\def\doublecolumnout{\doublecolumnout1580,51624
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51693
+\def\pagesofar{\pagesofar1584,51871
+\def\balancecolumns{\balancecolumns1588,52108
+ \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52279
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52540
+\newcount \appendixno \appendixno = `\@no1627,53445
+\def\appendixletter{\appendixletter1628,53486
+\def\opencontents{\opencontents1632,53589
+\def\thischapter{\thischapter1637,53770
+\def\seccheck#1{\seccheck1638,53808
+\def\chapternofonts{\chapternofonts1643,53912
+\def\result{\result1646,53987
+\def\equiv{\equiv1647,54022
+\def\expansion{\expansion1648,54055
+\def\print{\print1649,54096
+\def\TeX{\TeX1650,54129
+\def\dots{\dots1651,54158
+\def\copyright{\copyright1652,54189
+\def\tt{\tt1653,54230
+\def\bf{\bf1654,54257
+\def\w{\w1655,54285
+\def\less{\less1656,54310
+\def\gtr{\gtr1657,54341
+\def\hat{\hat1658,54370
+\def\char{\char1659,54399
+\def\tclose##1{\tclose1660,54430
+\def\code##1{\code1661,54474
+\def\samp##1{\samp1662,54514
+\def\r##1{\r1663,54554
+\def\b##1{\b1664,54588
+\def\key##1{\key1665,54622
+\def\file##1{\file1666,54660
+\def\kbd##1{\kbd1667,54700
+\def\i##1{\i1669,54808
+\def\cite##1{\cite1670,54842
+\def\var##1{\var1671,54882
+\def\emph##1{\emph1672,54920
+\def\dfn##1{\dfn1673,54960
+\def\thischaptername{\thischaptername1676,55001
+\outer\def\chapter{\chapter1677,55040
+\def\chapterzzz #1{\chapterzzz1678,55081
+{\chapternofonts%nofonts%1687,55477
+\global\let\section = \numberedsec=1692,55630
+\global\let\subsection = \numberedsubsec=1693,55665
+\global\let\subsubsection = \numberedsubsubsec=1694,55706
+\outer\def\appendix{\appendix1697,55757
+\def\appendixzzz #1{\appendixzzz1698,55800
+\global\advance \appendixno by 1 \message{no1700,55877
+\chapmacro {#1}{Appendix \appendixletter}letter1701,55946
+\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56039
+{\chapternofonts%nofonts%1705,56111
+ {#1}{Appendix \appendixletter}letter1707,56167
+\appendixnoderef %noderef1710,56267
+\global\let\section = \appendixsec=1711,56286
+\global\let\subsection = \appendixsubsec=1712,56321
+\global\let\subsubsection = \appendixsubsubsec=1713,56362
+\outer\def\top{\top1716,56413
+\outer\def\unnumbered{\unnumbered1717,56453
+\def\unnumberedzzz #1{\unnumberedzzz1718,56500
+{\chapternofonts%nofonts%1722,56663
+\global\let\section = \unnumberedsec=1727,56813
+\global\let\subsection = \unnumberedsubsec=1728,56850
+\global\let\subsubsection = \unnumberedsubsubsec=1729,56893
+\outer\def\numberedsec{\numberedsec1732,56946
+\def\seczzz #1{\seczzz1733,56987
+{\chapternofonts%nofonts%1736,57143
+\outer\def\appendixsection{\appendixsection1745,57329
+\outer\def\appendixsec{\appendixsec1746,57386
+\def\appendixsectionzzz #1{\appendixsectionzzz1747,57439
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57551
+{\chapternofonts%nofonts%1750,57619
+{#1}{\appendixletter}letter1752,57675
+\appendixnoderef %noderef1755,57775
+\outer\def\unnumberedsec{\unnumberedsec1759,57815
+\def\unnumberedseczzz #1{\unnumberedseczzz1760,57868
+{\chapternofonts%nofonts%1762,57963
+\outer\def\numberedsubsec{\numberedsubsec1770,58131
+\def\numberedsubseczzz #1{\numberedsubseczzz1771,58186
+{\chapternofonts%nofonts%1774,58365
+\outer\def\appendixsubsec{\appendixsubsec1783,58569
+\def\appendixsubseczzz #1{\appendixsubseczzz1784,58624
+\subsecheading {#1}{\appendixletter}letter1786,58746
+{\chapternofonts%nofonts%1787,58811
+{#1}{\appendixletter}letter1789,58870
+\appendixnoderef %noderef1792,58985
+\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59025
+\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59084
+{\chapternofonts%nofonts%1799,59185
+\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59356
+\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59417
+{\chapternofonts%nofonts%1812,59614
+\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59847
+\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59908
+ {\appendixletter}letter1827,60047
+{\chapternofonts%nofonts%1828,60113
+ {\appendixletter}letter1830,60178
+\appendixnoderef %noderef1834,60312
+\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60352
+\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60417
+{\chapternofonts%nofonts%1841,60524
+\def\infotop{\infotop1851,60853
+\def\infounnumbered{\infounnumbered1852,60891
+\def\infounnumberedsec{\infounnumberedsec1853,60936
+\def\infounnumberedsubsec{\infounnumberedsubsec1854,60987
+\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61044
+\def\infoappendix{\infoappendix1857,61108
+\def\infoappendixsec{\infoappendixsec1858,61149
+\def\infoappendixsubsec{\infoappendixsubsec1859,61196
+\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61249
+\def\infochapter{\infochapter1862,61309
+\def\infosection{\infosection1863,61348
+\def\infosubsection{\infosubsection1864,61387
+\def\infosubsubsection{\infosubsubsection1865,61432
+\global\let\section = \numberedsec=1870,61669
+\global\let\subsection = \numberedsubsec=1871,61704
+\global\let\subsubsection = \numberedsubsubsec=1872,61745
+\def\majorheading{\majorheading1886,62252
+\def\majorheadingzzz #1{\majorheadingzzz1887,62297
+\def\chapheading{\chapheading1893,62530
+\def\chapheadingzzz #1{\chapheadingzzz1894,62573
+\def\heading{\heading1899,62768
+\def\subheading{\subheading1901,62805
+\def\subsubheading{\subsubheading1903,62848
+\def\dobreak#1#2{\dobreak1910,63125
+\def\setchapterstyle #1 {\setchapterstyle1912,63203
+\def\chapbreak{\chapbreak1919,63458
+\def\chappager{\chappager1920,63508
+\def\chapoddpage{\chapoddpage1921,63546
+\def\setchapternewpage #1 {\setchapternewpage1923,63625
+\def\CHAPPAGoff{\CHAPPAGoff1925,63682
+\def\CHAPPAGon{\CHAPPAGon1929,63776
+\global\def\HEADINGSon{\HEADINGSon1932,63867
+\def\CHAPPAGodd{\CHAPPAGodd1934,63909
+\global\def\HEADINGSon{\HEADINGSon1937,64005
+\def\CHAPFplain{\CHAPFplain1941,64059
+\def\chfplain #1#2{\chfplain1945,64151
+\def\unnchfplain #1{\unnchfplain1956,64374
+\def\unnchfopen #1{\unnchfopen1964,64603
+\def\chfopen #1#2{\chfopen1970,64811
+\def\CHAPFopen{\CHAPFopen1975,64955
+\def\subsecheadingbreak{\subsecheadingbreak1982,65173
+\def\secheadingbreak{\secheadingbreak1985,65302
+\def\secheading #1#2#3{\secheading1993,65584
+\def\plainsecheading #1{\plainsecheading1994,65640
+\def\secheadingi #1{\secheadingi1995,65683
+\def\subsecheading #1#2#3#4{\subsecheading2006,66051
+\def\subsecheadingi #1{\subsecheadingi2007,66118
+\def\subsubsecfonts{\subsubsecfonts2014,66415
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66538
+\def\subsubsecheadingi #1{\subsubsecheadingi2018,66616
+\def\startcontents#1{\startcontents2032,67088
+ \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67361
+\outer\def\contents{\contents2049,67720
+\outer\def\summarycontents{\summarycontents2057,67864
+ \def\secentry ##1##2##3##4{\secentry2067,68235
+ \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68270
+ \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68305
+ \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68346
+ \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68384
+ \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68431
+\def\chapentry#1#2#3{\chapentry2085,68865
+\def\shortchapentry#1#2#3{\shortchapentry2088,68982
+ {#2\labelspace #1}space2091,69092
+\def\unnumbchapentry#1#2{\unnumbchapentry2094,69146
+\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69193
+\def\secentry#1#2#3#4{\secentry2102,69357
+\def\unnumbsecentry#1#2{\unnumbsecentry2103,69416
+\def\subsecentry#1#2#3#4#5{\subsecentry2106,69477
+\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69547
+\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69621
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69655
+\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69706
+\def\dochapentry#1#2{\dochapentry2123,70080
+\def\dosecentry#1#2{\dosecentry2138,70685
+\def\dosubsecentry#1#2{\dosubsecentry2145,70863
+\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71048
+\def\labelspace{\labelspace2160,71299
+\def\dopageno#1{\dopageno2162,71334
+\def\doshortpageno#1{\doshortpageno2163,71360
+\def\chapentryfonts{\chapentryfonts2165,71392
+\def\secentryfonts{\secentryfonts2166,71427
+\def\point{\point2192,72386
+\def\result{\result2194,72407
+\def\expansion{\expansion2195,72480
+\def\print{\print2196,72551
+\def\equiv{\equiv2198,72618
+\def\error{\error2218,73391
+\def\tex{\tex2224,73620
+\def\@{\@2242,74003
+\gdef\sepspaces{\def {\ }}}\2265,74735
+\def\aboveenvbreak{\aboveenvbreak2268,74817
+\def\afterenvbreak{\afterenvbreak2272,74983
+\def\ctl{\ctl2286,75494
+\def\ctr{\ctr2287,75566
+\def\cbl{\cbl2288,75605
+\def\cbr{\cbr2289,75645
+\def\carttop{\carttop2290,75684
+\def\cartbot{\cartbot2293,75792
+\long\def\cartouche{\cartouche2299,75932
+\def\Ecartouche{\Ecartouche2326,76720
+\def\lisp{\lisp2338,76855
+\def\Elisp{\Elisp2348,77202
+\def\next##1{\next2360,77528
+\def\Eexample{\Eexample2364,77570
+\def\Esmallexample{\Esmallexample2367,77617
+\def\smalllispx{\smalllispx2373,77795
+\def\Esmalllisp{\Esmalllisp2383,78149
+\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78505
+\def\next##1{\next2397,78562
+\def\display{\display2401,78642
+\def\Edisplay{\Edisplay2410,78961
+\def\next##1{\next2422,79272
+\def\format{\format2426,79375
+\def\Eformat{\Eformat2434,79671
+\def\next##1{\next2437,79760
+\def\flushleft{\flushleft2441,79812
+\def\Eflushleft{\Eflushleft2451,80183
+\def\next##1{\next2454,80276
+\def\flushright{\flushright2456,80298
+\def\Eflushright{\Eflushright2466,80670
+\def\next##1{\next2470,80801
+\def\quotation{\quotation2474,80859
+\def\Equotation{\Equotation2480,81051
+\def\setdeffont #1 {\setdeffont2493,81449
+\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81495
+\newskip\defargsindent \defargsindent=50ptargsindent2496,81538
+\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81581
+\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81624
+\def\activeparens{\activeparens2503,81822
+\def\opnr{\opnr2529,83034
+\def\lbrb{\lbrb2530,83099
+\def\defname #1#2{\defname2536,83300
+\advance\dimen2 by -\defbodyindentbodyindent2540,83418
+\advance\dimen3 by -\defbodyindentbodyindent2542,83472
+\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83526
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83668
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83743
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84112
+\advance\leftskip by -\defbodyindentbodyindent2557,84246
+\exdentamount=\defbodyindentbodyindent2558,84283
+\def\defparsebody #1#2#3{\defparsebody2568,84642
+\def#1{2572,84826
+\def#2{2573,84862
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84934
+\exdentamount=\defbodyindentbodyindent2576,85008
+\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85112
+\def#1{2585,85273
+\def#2##1 {2586,85309
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85392
+\exdentamount=\defbodyindentbodyindent2589,85466
+\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85551
+\def#1{2596,85712
+\def#2##1 ##2 {2597,85748
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85848
+\exdentamount=\defbodyindentbodyindent2601,85922
+\def\defvarparsebody #1#2#3{\defvarparsebody2608,86193
+\def#1{2612,86380
+\def#2{2613,86416
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86475
+\exdentamount=\defbodyindentbodyindent2616,86549
+\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86640
+\def#1{2625,86799
+\def#2##1 {2626,86835
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86905
+\exdentamount=\defbodyindentbodyindent2629,86979
+\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87051
+\def#1{2636,87215
+\def#2##1 ##2 {2637,87251
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87338
+\exdentamount=\defbodyindentbodyindent2641,87412
+\def\defunargs #1{\defunargs2664,88172
+\def\deftypefunargs #1{\deftypefunargs2676,88554
+\def\deffn{\deffn2690,88936
+\def\deffnheader #1#2#3{\deffnheader2692,88993
+\begingroup\defname {name2693,89041
+\def\defun{\defun2699,89186
+\def\defunheader #1#2{\defunheader2701,89239
+\begingroup\defname {name2702,89314
+\defunargs {unargs2703,89350
+\def\deftypefun{\deftypefun2709,89498
+\def\deftypefunheader #1#2{\deftypefunheader2712,89620
+\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89729
+\begingroup\defname {name2716,89821
+\deftypefunargs {typefunargs2717,89867
+\def\deftypefn{\deftypefn2723,90038
+\def\deftypefnheader #1#2#3{\deftypefnheader2726,90187
+\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90323
+\begingroup\defname {name2730,90416
+\deftypefunargs {typefunargs2731,90456
+\def\defmac{\defmac2737,90577
+\def\defmacheader #1#2{\defmacheader2739,90634
+\begingroup\defname {name2740,90710
+\defunargs {unargs2741,90743
+\def\defspec{\defspec2747,90867
+\def\defspecheader #1#2{\defspecheader2749,90928
+\begingroup\defname {name2750,91005
+\defunargs {unargs2751,91045
+\def\deffnx #1 {\deffnx2758,91240
+\def\defunx #1 {\defunx2759,91297
+\def\defmacx #1 {\defmacx2760,91354
+\def\defspecx #1 {\defspecx2761,91413
+\def\deftypefnx #1 {\deftypefnx2762,91474
+\def\deftypeunx #1 {\deftypeunx2763,91539
+\def\defop #1 {\defop2769,91685
+\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91720
+\def\defopheader #1#2#3{\defopheader2772,91774
+\begingroup\defname {name2774,91863
+\defunargs {unargs2775,91909
+\def\defmethod{\defmethod2780,91970
+\def\defmethodheader #1#2#3{\defmethodheader2782,92043
+\begingroup\defname {name2784,92131
+\defunargs {unargs2785,92171
+\def\defcv #1 {\defcv2790,92245
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92280
+\def\defcvarheader #1#2#3{\defcvarheader2793,92339
+\begingroup\defname {name2795,92425
+\defvarargs {varargs2796,92471
+\def\defivar{\defivar2801,92544
+\def\defivarheader #1#2#3{\defivarheader2803,92607
+\begingroup\defname {name2805,92693
+\defvarargs {varargs2806,92744
+\def\defopx #1 {\defopx2812,92893
+\def\defmethodx #1 {\defmethodx2813,92950
+\def\defcvx #1 {\defcvx2814,93015
+\def\defivarx #1 {\defivarx2815,93072
+\def\defvarargs #1{\defvarargs2822,93343
+\def\defvr{\defvr2828,93487
+\def\defvrheader #1#2#3{\defvrheader2830,93542
+\begingroup\defname {name2831,93590
+\def\defvar{\defvar2835,93675
+\def\defvarheader #1#2{\defvarheader2837,93735
+\begingroup\defname {name2838,93806
+\defvarargs {varargs2839,93842
+\def\defopt{\defopt2844,93908
+\def\defoptheader #1#2{\defoptheader2846,93968
+\begingroup\defname {name2847,94039
+\defvarargs {varargs2848,94078
+\def\deftypevar{\deftypevar2853,94135
+\def\deftypevarheader #1#2{\deftypevarheader2856,94251
+\begingroup\defname {name2858,94334
+\def\deftypevr{\deftypevr2865,94508
+\def\deftypevrheader #1#2#3{\deftypevrheader2867,94579
+\begingroup\defname {name2868,94631
+\def\defvrx #1 {\defvrx2876,94868
+\def\defvarx #1 {\defvarx2877,94925
+\def\defoptx #1 {\defoptx2878,94984
+\def\deftypevarx #1 {\deftypevarx2879,95043
+\def\deftypevrx #1 {\deftypevrx2880,95110
+\def\deftpargs #1{\deftpargs2885,95259
+\def\deftp{\deftp2889,95339
+\def\deftpheader #1#2#3{\deftpheader2891,95394
+\begingroup\defname {name2892,95442
+\def\deftpx #1 {\deftpx2897,95601
+\def\setref#1{\setref2908,95922
+\def\unnumbsetref#1{\unnumbsetref2913,96036
+\def\appendixsetref#1{\appendixsetref2918,96143
+\def\pxref#1{\pxref2929,96554
+\def\xref#1{\xref2930,96590
+\def\ref#1{\ref2931,96625
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96655
+\def\printedmanual{\printedmanual2933,96698
+\def\printednodename{\printednodename2934,96736
+\def\printednodename{\printednodename2939,96861
+section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97493
+\refx{x2957,97571
+\def\dosetq #1#2{\dosetq2965,97791
+\def\internalsetq #1#2{\internalsetq2973,98049
+\def\Ypagenumber{\Ypagenumber2977,98150
+\def\Ytitle{\Ytitle2979,98176
+\def\Ynothing{\Ynothing2981,98203
+\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98220
+\def\Yappendixletterandtype{\Yappendixletterandtype2992,98536
+\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98566
+\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98621
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98725
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98796
+ \def\linenumber{\linenumber3009,99135
+\def\refx#1#2{\refx3015,99319
+\def\xrdef #1#2{\xrdef3037,99945
+\def\readauxfile{\readauxfile3040,100030
+\def\supereject{\supereject3110,101811
+\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102496
+\def\openindices{\openindices3139,102682
+\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102907
+\parindent = \defaultparindentaultparindent3152,102959
+\def\smallbook{\smallbook3175,103683
+\global\def\Esmallexample{\Esmallexample3192,104110
+\def\afourpaper{\afourpaper3196,104201
+\def\finalout{\finalout3224,105009
+\def\normaldoublequote{\normaldoublequote3235,105270
+\def\normaltilde{\normaltilde3236,105296
+\def\normalcaret{\normalcaret3237,105316
+\def\normalunderscore{\normalunderscore3238,105336
+\def\normalverticalbar{\normalverticalbar3239,105361
+\def\normalless{\normalless3240,105387
+\def\normalgreater{\normalgreater3241,105406
+\def\normalplus{\normalplus3242,105428
+\def\ifusingtt#1#2{\ifusingtt3253,105920
+\def\activedoublequote{\activedoublequote3261,106248
+\def~{~3264,106334
+\def^{^3267,106395
+\def_{_3270,106434
+\def\_{\_3272,106508
+\def\lvvmode{\lvvmode3279,106845
+\def|{|3282,106895
+\def<{<3285,106958
+\def>{>3288,107015
+\def+{+3290,107053
+\def\turnoffactive{\turnoffactive3296,107214
+\global\def={=3307,107500
+\def\normalbackslash{\normalbackslash3321,107882
+
+merc-src/accumulator.m,4915
+:- interface146,5371
+:- import_module hlds148,5386
+:- import_module univ152,5478
+:- pred accu_transform_proc159,5793
+:- implementation166,6115
+:- import_module libs180,6552
+:- import_module mdbcomp184,6681
+:- import_module parse_tree186,6742
+:- import_module assoc_list194,7013
+:- import_module bool195,7042
+:- import_module int196,7065
+:- import_module io197,7087
+:- import_module list198,7108
+:- import_module map199,7131
+:- import_module maybe200,7153
+:- import_module pair201,7177
+:- import_module require202,7200
+:- import_module set203,7226
+:- import_module solutions204,7248
+:- import_module string205,7276
+:- import_module term206,7301
+:- import_module varset207,7324
+:- type top_level213,7499
+:- type accu_goal_id225,7900
+:- type accu_case228,7964
+:- type accu_goal_store234,8091
+:- type accu_subst238,8216
+:- type accu_warning240,8264
+accu_transform_proc247,8578
+:- pred generate_warnings334,12550
+generate_warnings337,12669
+:- pred generate_warning342,12895
+generate_warning345,13001
+:- pred should_attempt_accu_transform365,13886
+should_attempt_accu_transform370,14123
+:- pred should_attempt_accu_transform_2398,15406
+should_attempt_accu_transform_2405,15763
+:- pred accu_standardize440,17390
+accu_standardize442,17455
+:- pred identify_goal_type465,18169
+identify_goal_type469,18359
+:- pred is_recursive_case549,21175
+is_recursive_case551,21253
+:- type store_info560,21713
+:- func initialize_goal_store570,22060
+initialize_goal_store573,22166
+:- pred accu_store580,22421
+accu_store584,22576
+:- pred identify_recursive_calls601,23288
+identify_recursive_calls604,23406
+:- pred identify_out_and_out_prime626,24396
+identify_out_and_out_prime631,24631
+:- type accu_sets676,26425
+:- pred accu_stage1689,26977
+accu_stage1693,27155
+:- pred accu_stage1_2727,28347
+accu_stage1_2731,28515
+:- pred accu_sets_init781,30557
+accu_sets_init783,30605
+:- func set_upto796,30984
+set_upto798,31039
+:- pred accu_before812,31498
+accu_before815,31639
+:- pred accu_assoc835,32477
+accu_assoc838,32617
+:- pred accu_construct862,33712
+accu_construct865,33856
+:- pred accu_construct_assoc896,35307
+accu_construct_assoc899,35457
+:- pred accu_update938,37069
+accu_update941,37210
+:- pred member_lessthan_goalid964,38219
+member_lessthan_goalid967,38342
+:- type accu_assoc975,38652
+:- pred accu_is_associative986,39138
+accu_is_associative989,39250
+:- pred associativity_assertion1014,40263
+associativity_assertion1017,40404
+:- pred commutativity_assertion1037,41242
+commutativity_assertion1040,41369
+:- pred accu_is_update1057,41952
+accu_is_update1060,42066
+:- pred is_associative_construction1078,42802
+is_associative_construction1081,42898
+:- type accu_substs1095,43480
+:- type accu_base1103,43744
+:- pred accu_stage21124,44605
+accu_stage21131,44946
+:- pred accu_substs_init1179,46957
+accu_substs_init1182,47097
+:- pred acc_var_subst_init1194,47573
+acc_var_subst_init1198,47718
+:- pred create_new_var1207,48147
+create_new_var1210,48288
+:- pred accu_process_assoc_set1223,48862
+accu_process_assoc_set1229,49150
+:- pred accu_has_heuristic1297,52081
+accu_has_heuristic1299,52161
+:- pred accu_heuristic1304,52336
+accu_heuristic1307,52457
+:- pred accu_process_update_set1318,52906
+accu_process_update_set1325,53221
+:- pred accu_divide_base_case1380,55844
+accu_divide_base_case1385,56059
+:- pred accu_related1412,57146
+accu_related1415,57270
+:- inst stored_goal_plain_call1444,58415
+:- pred lookup_call1449,58601
+lookup_call1452,58715
+:- pred accu_stage31470,59432
+accu_stage31477,59826
+:- pred acc_proc_info1508,61326
+acc_proc_info1512,61485
+:- pred acc_pred_info1556,63449
+acc_pred_info1559,63597
+:- pred accu_create_goal1600,65285
+accu_create_goal1607,65628
+:- func create_acc_call1621,66400
+create_acc_call1625,66569
+:- pred create_orig_goal1634,66987
+create_orig_goal1638,67176
+:- pred create_acc_goal1662,68157
+create_acc_goal1667,68380
+:- func create_new_orig_recursive_goals1709,70225
+create_new_orig_recursive_goals1712,70368
+:- func create_new_recursive_goals1723,70918
+create_new_recursive_goals1727,71108
+:- func create_new_base_goals1738,71717
+create_new_base_goals1741,71831
+:- pred acc_unification1749,72156
+acc_unification1751,72225
+:- pred accu_top_level1766,72896
+accu_top_level1770,73058
+:- pred update_accumulator_pred1856,76290
+update_accumulator_pred1859,76411
+:- func accu_rename1876,77253
+accu_rename1879,77363
+:- func base_case_ids1889,77784
+base_case_ids1891,77846
+:- func base_case_ids_set1898,78048
+base_case_ids_set1900,78113
+:- func accu_goal_list1905,78269
+accu_goal_list1907,78349
+:- pred calculate_goal_info1916,78680
+calculate_goal_info1918,78753
+:- func chain_subst1932,79319
+chain_subst1934,79378
+:- pred chain_subst_21938,79482
+chain_subst_21941,79576
+:- some [T] pred unravel_univ1956,80060
+:- pragma foreign_export1957,80116
+unravel_univ1961,80340
c-src/c.c,76
T f(1,0
@@ -5160,13 +5315,13 @@ extern struct node *yylval;yylval306,6246
unsigned char parse_cell_or_range 309,6291
unsigned char parse_cell_or_range 311,6355
yylex FUN0(315,6405
-parse_cell_or_range FUN2(587,11771
-#define CK_ABS_R(671,13213
-#define CK_REL_R(675,13292
-#define CK_ABS_C(680,13421
-#define CK_REL_C(684,13500
-#define MAYBEREL(689,13629
-str_to_col FUN1(847,16830
+parse_cell_or_range FUN2(587,11772
+#define CK_ABS_R(671,13214
+#define CK_REL_R(675,13293
+#define CK_ABS_C(680,13422
+#define CK_REL_C(684,13501
+#define MAYBEREL(689,13630
+str_to_col FUN1(847,16831
y-src/parse.c,520
#define YYBISON 4,64
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index 86df93afab1..75047951a8a 100644
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -175,7 +175,7 @@ package body Truc.Bidule Truc.Bidule/b138,2153
protected body Bidule Bidule/b139,2181
protected body Machin_T Machin_T/b146,2281
-c-src/abbrev.c,3274
+c-src/abbrev.c,3055
Lisp_Object Vabbrev_table_name_list;43,1429
Lisp_Object Vglobal_abbrev_table;48,1574
Lisp_Object Vfundamental_mode_abbrev_table;52,1685
@@ -186,57 +186,53 @@ Lisp_Object Vabbrev_start_location_buffer;66,2046
Lisp_Object Vlast_abbrev;70,2155
Lisp_Object Vlast_abbrev_text;75,2324
int last_abbrev_point;79,2414
-Lisp_Object Vpre_abbrev_expand_hook,83,2487
-Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;83,2487
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,85,2551
-DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table85,2551
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,92,2743
-DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table92,2743
-DEFUN ("define-abbrev", Fdefine_abbrev,107,3124
-DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev107,3124
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,149,4443
-DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev149,4443
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,160,4814
-DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev160,4814
-DEFUN ("abbrev-symbol", Fabbrev_symbol,174,5282
-DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol174,5282
-DEFUN ("abbrev-expansion", Fabbrev_expansion,202,6246
-DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion202,6246
-DEFUN ("expand-abbrev", Fexpand_abbrev,218,6761
-DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev218,6761
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,389,11682
-DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev389,11682
-write_abbrev 426,12889
-describe_abbrev 445,13324
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,466,13839
-DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description466,13839
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,506,14995
-DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table506,14995
-syms_of_abbrev 540,16072
- DEFVAR_LISP ("abbrev-table-name-list"542,16092
- DEFVAR_LISP ("global-abbrev-table"548,16354
- DEFVAR_LISP ("fundamental-mode-abbrev-table"555,16676
- DEFVAR_LISP ("last-abbrev"561,17018
- DEFVAR_LISP ("last-abbrev-text"564,17141
- DEFVAR_INT ("last-abbrev-location"568,17299
- DEFVAR_LISP ("abbrev-start-location"575,17498
- DEFVAR_LISP ("abbrev-start-location-buffer"581,17775
- DEFVAR_PER_BUFFER ("local-abbrev-table"586,18039
- DEFVAR_BOOL ("abbrevs-changed"589,18182
- DEFVAR_BOOL ("abbrev-all-caps"594,18385
- DEFVAR_LISP ("pre-abbrev-expand-hook"598,18541
- DEFVAR_LISP ("abbrev-table-name-list",\1542,16092
- DEFVAR_LISP ("global-abbrev-table",\1548,16354
- DEFVAR_LISP ("fundamental-mode-abbrev-table",\1555,16676
- DEFVAR_LISP ("last-abbrev",\1561,17018
- DEFVAR_LISP ("last-abbrev-text",\1564,17141
- DEFVAR_INT ("last-abbrev-location",\1568,17299
- DEFVAR_LISP ("abbrev-start-location",\1575,17498
- DEFVAR_LISP ("abbrev-start-location-buffer",\1581,17775
- DEFVAR_PER_BUFFER ("local-abbrev-table",\1586,18039
- DEFVAR_BOOL ("abbrevs-changed",\1589,18182
- DEFVAR_BOOL ("abbrev-all-caps",\1594,18385
- DEFVAR_LISP ("pre-abbrev-expand-hook",\1598,18541
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,82,2440
+DEFUN ("make-abbrev-table", Fmake_abbrev_table,make-abbrev-table82,2440
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,89,2632
+DEFUN ("clear-abbrev-table", Fclear_abbrev_table,clear-abbrev-table89,2632
+DEFUN ("define-abbrev", Fdefine_abbrev,104,3013
+DEFUN ("define-abbrev", Fdefine_abbrev,define-abbrev104,3013
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,146,4332
+DEFUN ("define-global-abbrev", Fdefine_global_abbrev,define-global-abbrev146,4332
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,157,4703
+DEFUN ("define-mode-abbrev", Fdefine_mode_abbrev,define-mode-abbrev157,4703
+DEFUN ("abbrev-symbol", Fabbrev_symbol,171,5171
+DEFUN ("abbrev-symbol", Fabbrev_symbol,abbrev-symbol171,5171
+DEFUN ("abbrev-expansion", Fabbrev_expansion,199,6135
+DEFUN ("abbrev-expansion", Fabbrev_expansion,abbrev-expansion199,6135
+DEFUN ("expand-abbrev", Fexpand_abbrev,215,6650
+DEFUN ("expand-abbrev", Fexpand_abbrev,expand-abbrev215,6650
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,383,11495
+DEFUN ("unexpand-abbrev", Funexpand_abbrev,unexpand-abbrev383,11495
+write_abbrev 420,12702
+describe_abbrev 439,13137
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,460,13652
+DEFUN ("insert-abbrev-table-description", Finsert_abbrev_table_description,insert-abbrev-table-description460,13652
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,500,14808
+DEFUN ("define-abbrev-table", Fdefine_abbrev_table,define-abbrev-table500,14808
+syms_of_abbrev 534,15885
+ DEFVAR_LISP ("abbrev-table-name-list"536,15905
+ DEFVAR_LISP ("global-abbrev-table"542,16167
+ DEFVAR_LISP ("fundamental-mode-abbrev-table"549,16489
+ DEFVAR_LISP ("last-abbrev"555,16831
+ DEFVAR_LISP ("last-abbrev-text"558,16954
+ DEFVAR_INT ("last-abbrev-location"562,17112
+ DEFVAR_LISP ("abbrev-start-location"569,17311
+ DEFVAR_LISP ("abbrev-start-location-buffer"575,17588
+ DEFVAR_PER_BUFFER ("local-abbrev-table"580,17852
+ DEFVAR_BOOL ("abbrevs-changed"583,17995
+ DEFVAR_BOOL ("abbrev-all-caps"588,18198
+ DEFVAR_LISP ("abbrev-table-name-list",\1536,15905
+ DEFVAR_LISP ("global-abbrev-table",\1542,16167
+ DEFVAR_LISP ("fundamental-mode-abbrev-table",\1549,16489
+ DEFVAR_LISP ("last-abbrev",\1555,16831
+ DEFVAR_LISP ("last-abbrev-text",\1558,16954
+ DEFVAR_INT ("last-abbrev-location",\1562,17112
+ DEFVAR_LISP ("abbrev-start-location",\1569,17311
+ DEFVAR_LISP ("abbrev-start-location-buffer",\1575,17588
+ DEFVAR_PER_BUFFER ("local-abbrev-table",\1580,17852
+ DEFVAR_BOOL ("abbrevs-changed",\1583,17995
+ DEFVAR_BOOL ("abbrev-all-caps",\1588,18198
c-src/torture.c,197
(*tag1 tag118,452
@@ -1368,310 +1364,310 @@ make_lispy_position 5228,157391
toolkit_menubar_in_use 5456,163954
make_scroll_bar_position 5469,164322
make_lispy_event 5485,164968
-make_lispy_movement 6104,183532
-make_lispy_switch_frame 6131,184263
-make_lispy_focus_in 6137,184370
-make_lispy_focus_out 6145,184496
-parse_modifiers_uncached 6163,184946
-#define SINGLE_LETTER_MOD(6185,185466
-#undef SINGLE_LETTER_MOD6212,185907
-#define MULTI_LETTER_MOD(6214,185933
-#undef MULTI_LETTER_MOD6231,186401
-apply_modifiers_uncached 6273,187575
-static const char *const modifier_names[modifier_names6319,189194
-#define NUM_MOD_NAMES 6325,189400
-static Lisp_Object modifier_symbols;6327,189450
-lispy_modifier_list 6331,189587
-#define KEY_TO_CHAR(6353,190253
-parse_modifiers 6356,190329
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191518
-DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191518
-apply_modifiers 6422,192392
-reorder_modifiers 6491,194721
-modify_event_symbol 6536,196529
-DEFUN ("event-convert-list", Fevent_convert_list,6628,199245
-DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199245
-parse_solitary_modifier 6695,201136
-#define SINGLE_LETTER_MOD(6701,201259
-#define MULTI_LETTER_MOD(6705,201344
-#undef SINGLE_LETTER_MOD6763,202642
-#undef MULTI_LETTER_MOD6764,202667
-lucid_event_type_list_p 6775,202890
-get_input_pending 6814,203961
-record_asynch_buffer_change 6834,204580
-gobble_input 6872,205703
-tty_read_avail_input 6967,208311
-handle_async_input 7149,214040
-process_pending_signals 7165,214360
-unblock_input_to 7177,214646
-unblock_input 7200,215278
-totally_unblock_input 7209,215446
-handle_input_available_signal 7217,215530
-deliver_input_available_signal 7226,215701
-struct user_signal_info7235,215866
- int sig;7238,215916
- char *name;name7241,215957
- int npending;7244,216008
- struct user_signal_info *next;next7246,216025
-static struct user_signal_info *user_signals user_signals7250,216091
-add_user_signal 7253,216150
-handle_user_signal 7275,216599
-deliver_user_signal 7316,217559
-find_user_signal_name 7322,217660
-store_user_signal_events 7334,217842
-static void menu_bar_item 7362,218342
-static Lisp_Object menu_bar_one_keymap_changed_items;7363,218417
-static Lisp_Object menu_bar_items_vector;7368,218631
-static int menu_bar_items_index;7369,218673
-static const char *separator_names[separator_names7372,218708
-menu_separator_name_p 7393,219149
-menu_bar_items 7426,219853
-Lisp_Object item_properties;7568,224604
-menu_bar_item 7571,224646
-menu_item_eval_property_1 7647,227176
-eval_dyn 7658,227466
-menu_item_eval_property 7666,227676
-parse_menu_item 7686,228342
-static Lisp_Object tool_bar_items_vector;7965,236337
-static Lisp_Object tool_bar_item_properties;7970,236511
-static int ntool_bar_items;7974,236607
-static void init_tool_bar_items 7978,236665
-static void process_tool_bar_item 7979,236712
-static bool parse_tool_bar_item 7981,236802
-static void append_tool_bar_item 7982,236862
-tool_bar_items 7990,237084
-process_tool_bar_item 8075,239893
-#define PROP(8112,240970
-set_prop 8114,241039
-parse_tool_bar_item 8167,242454
-#undef PROP8379,248845
-init_tool_bar_items 8387,248970
-append_tool_bar_item 8401,249262
-read_char_x_menu_prompt 8443,250772
-read_char_minibuf_menu_prompt 8503,252446
-#define PUSH_C_STR(8527,253015
-follow_key 8726,258554
-active_maps 8733,258696
-typedef struct keyremap8742,259022
- Lisp_Object parent;8745,259108
- Lisp_Object map;8748,259225
- int start,8753,259447
- int start, end;8753,259447
-} keyremap;8754,259465
-access_keymap_keyremap 8764,259809
-keyremap_step 8811,261451
-test_undefined 8867,262935
-read_key_sequence 8916,264862
-read_key_sequence_vs 9826,295822
-DEFUN ("read-key-sequence", Fread_key_sequence,9885,297295
-DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297295
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299983
-DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299983
-detect_input_pending 9950,300489
-detect_input_pending_ignore_squeezables 9959,300655
-detect_input_pending_run_timers 9967,300871
-clear_input_pending 9985,301363
-requeued_events_pending_p 9997,301733
-DEFUN ("input-pending-p", Finput_pending_p,10002,301814
-DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301814
-DEFUN ("recent-keys", Frecent_keys,10024,302597
-DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302597
-DEFUN ("this-command-keys", Fthis_command_keys,10055,303518
-DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303518
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303959
-DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303959
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304381
-DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304381
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304956
-DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304956
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305496
-DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305496
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306511
-DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306511
-DEFUN ("recursion-depth", Frecursion_depth,10158,307070
-DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307070
-DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307407
-DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307407
-DEFUN ("discard-input", Fdiscard_input,10203,308448
-DEFUN ("discard-input", Fdiscard_input,discard-input10203,308448
-DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308950
-DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308950
-stuff_buffered_input 10285,311046
-set_waiting_for_input 10323,312017
-clear_waiting_for_input 10337,312391
-handle_interrupt_signal 10351,312755
-deliver_interrupt_signal 10378,313643
-static int volatile force_quit_count;10387,313933
-handle_interrupt 10401,314415
-quit_throw_to_read_char 10541,318712
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319289
-DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319289
-DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320517
-DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320517
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321433
-DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321433
-DEFUN ("set-quit-char", Fset_quit_char,10694,322707
-DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322707
-DEFUN ("set-input-mode", Fset_input_mode,10729,323571
-DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323571
-DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324460
-DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324460
-DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325838
-DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325838
-DEFUN ("posn-at-point", Fposn_at_point,10824,327061
-DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327061
-init_kboard 10861,328215
-allocate_kboard 10893,329285
-wipe_kboard 10909,329638
-delete_kboard 10917,329752
-init_keyboard 10942,330282
-struct event_head11021,332697
- short var;11023,332717
- short kind;11024,332730
-static const struct event_head head_table[head_table11027,332748
-syms_of_keyboard 11045,333578
- DEFVAR_LISP ("internal--top-level-message"11058,333973
- DEFVAR_LISP ("last-command-event"11312,342174
- DEFVAR_LISP ("last-nonmenu-event"11315,342298
- DEFVAR_LISP ("last-input-event"11321,342637
- DEFVAR_LISP ("unread-command-events"11324,342731
- DEFVAR_LISP ("unread-post-input-method-events"11332,343191
- DEFVAR_LISP ("unread-input-method-events"11338,343530
- DEFVAR_LISP ("meta-prefix-char"11346,343899
- DEFVAR_KBOARD ("last-command"11351,344107
- DEFVAR_KBOARD ("real-last-command"11368,344788
- DEFVAR_KBOARD ("last-repeatable-command"11372,344974
- DEFVAR_LISP ("this-command"11378,345262
- DEFVAR_LISP ("real-this-command"11384,345499
- DEFVAR_LISP ("this-command-keys-shift-translated"11388,345681
- DEFVAR_LISP ("this-original-command"11396,346124
- DEFVAR_INT ("auto-save-interval"11403,346521
- DEFVAR_LISP ("auto-save-timeout"11408,346735
- DEFVAR_LISP ("echo-keystrokes"11415,347080
- DEFVAR_INT ("polling-period"11421,347351
- DEFVAR_LISP ("double-click-time"11428,347694
- DEFVAR_INT ("double-click-fuzz"11435,348030
- DEFVAR_INT ("num-input-keys"11446,348520
- DEFVAR_INT ("num-nonmacro-input-events"11452,348795
- DEFVAR_LISP ("last-event-frame"11457,349033
- DEFVAR_LISP ("tty-erase-char"11463,349312
- DEFVAR_LISP ("help-char"11466,349435
- DEFVAR_LISP ("help-event-list"11472,349718
- DEFVAR_LISP ("help-form"11477,349929
- DEFVAR_LISP ("prefix-help-command"11483,350177
- DEFVAR_LISP ("top-level"11489,350455
- DEFVAR_KBOARD ("keyboard-translate-table"11495,350676
- DEFVAR_BOOL ("cannot-suspend"11511,351489
- DEFVAR_BOOL ("menu-prompting"11516,351716
- DEFVAR_LISP ("menu-prompt-more-char"11526,352146
- DEFVAR_INT ("extra-keyboard-modifiers"11531,352392
- DEFVAR_LISP ("deactivate-mark"11545,353118
- DEFVAR_LISP ("pre-command-hook"11553,353487
- DEFVAR_LISP ("post-command-hook"11560,353842
- DEFVAR_LISP ("echo-area-clear-hook"11568,354205
- DEFVAR_LISP ("lucid-menu-bar-dirty-flag"11574,354420
- DEFVAR_LISP ("menu-bar-final-items"11578,354623
- DEFVAR_LISP ("tool-bar-separator-image-expression"11583,354873
- DEFVAR_KBOARD ("overriding-terminal-local-map"11589,355231
- DEFVAR_LISP ("overriding-local-map"11598,355653
- DEFVAR_LISP ("overriding-local-map-menu-flag"11607,356104
- DEFVAR_LISP ("special-event-map"11613,356443
- DEFVAR_LISP ("track-mouse"11617,356631
- DEFVAR_KBOARD ("system-key-alist"11620,356758
- DEFVAR_KBOARD ("local-function-key-map"11629,357139
- DEFVAR_KBOARD ("input-decode-map"11658,358598
- DEFVAR_LISP ("function-key-map"11675,359386
- DEFVAR_LISP ("key-translation-map"11683,359802
- DEFVAR_LISP ("deferred-action-list"11689,360146
- DEFVAR_LISP ("deferred-action-function"11694,360394
- DEFVAR_LISP ("delayed-warnings-list"11700,360693
- DEFVAR_LISP ("timer-list"11708,361101
- DEFVAR_LISP ("timer-idle-list"11712,361253
- DEFVAR_LISP ("input-method-function"11716,361416
- DEFVAR_LISP ("input-method-previous-message"11737,362385
- DEFVAR_LISP ("show-help-function"11744,362746
- DEFVAR_LISP ("disable-point-adjustment"11749,362978
- DEFVAR_LISP ("global-disable-point-adjustment"11761,363528
- DEFVAR_LISP ("minibuffer-message-timeout"11770,363894
- DEFVAR_LISP ("throw-on-input"11775,364172
- DEFVAR_LISP ("command-error-function"11781,364423
- DEFVAR_LISP ("enable-disabled-menus-and-buttons"11790,364910
- DEFVAR_LISP ("select-active-regions"11798,365237
- DEFVAR_LISP ("saved-region-selection"11807,365629
- DEFVAR_LISP ("selection-inhibit-update-commands"11815,366014
- DEFVAR_LISP ("debug-on-event"11825,366555
-keys_of_keyboard 11841,367116
-mark_kboards 11916,370435
- DEFVAR_LISP ("internal--top-level-message",\111058,333973
- DEFVAR_LISP ("last-command-event",\111312,342174
- DEFVAR_LISP ("last-nonmenu-event",\111315,342298
- DEFVAR_LISP ("last-input-event",\111321,342637
- DEFVAR_LISP ("unread-command-events",\111324,342731
- DEFVAR_LISP ("unread-post-input-method-events",\111332,343191
- DEFVAR_LISP ("unread-input-method-events",\111338,343530
- DEFVAR_LISP ("meta-prefix-char",\111346,343899
- DEFVAR_KBOARD ("last-command",\111351,344107
- DEFVAR_KBOARD ("real-last-command",\111368,344788
- DEFVAR_KBOARD ("last-repeatable-command",\111372,344974
- DEFVAR_LISP ("this-command",\111378,345262
- DEFVAR_LISP ("real-this-command",\111384,345499
- DEFVAR_LISP ("this-command-keys-shift-translated",\111388,345681
- DEFVAR_LISP ("this-original-command",\111396,346124
- DEFVAR_INT ("auto-save-interval",\111403,346521
- DEFVAR_LISP ("auto-save-timeout",\111408,346735
- DEFVAR_LISP ("echo-keystrokes",\111415,347080
- DEFVAR_INT ("polling-period",\111421,347351
- DEFVAR_LISP ("double-click-time",\111428,347694
- DEFVAR_INT ("double-click-fuzz",\111435,348030
- DEFVAR_INT ("num-input-keys",\111446,348520
- DEFVAR_INT ("num-nonmacro-input-events",\111452,348795
- DEFVAR_LISP ("last-event-frame",\111457,349033
- DEFVAR_LISP ("tty-erase-char",\111463,349312
- DEFVAR_LISP ("help-char",\111466,349435
- DEFVAR_LISP ("help-event-list",\111472,349718
- DEFVAR_LISP ("help-form",\111477,349929
- DEFVAR_LISP ("prefix-help-command",\111483,350177
- DEFVAR_LISP ("top-level",\111489,350455
- DEFVAR_KBOARD ("keyboard-translate-table",\111495,350676
- DEFVAR_BOOL ("cannot-suspend",\111511,351489
- DEFVAR_BOOL ("menu-prompting",\111516,351716
- DEFVAR_LISP ("menu-prompt-more-char",\111526,352146
- DEFVAR_INT ("extra-keyboard-modifiers",\111531,352392
- DEFVAR_LISP ("deactivate-mark",\111545,353118
- DEFVAR_LISP ("pre-command-hook",\111553,353487
- DEFVAR_LISP ("post-command-hook",\111560,353842
- DEFVAR_LISP ("echo-area-clear-hook",\111568,354205
- DEFVAR_LISP ("lucid-menu-bar-dirty-flag",\111574,354420
- DEFVAR_LISP ("menu-bar-final-items",\111578,354623
- DEFVAR_LISP ("tool-bar-separator-image-expression",\111583,354873
- DEFVAR_KBOARD ("overriding-terminal-local-map",\111589,355231
- DEFVAR_LISP ("overriding-local-map",\111598,355653
- DEFVAR_LISP ("overriding-local-map-menu-flag",\111607,356104
- DEFVAR_LISP ("special-event-map",\111613,356443
- DEFVAR_LISP ("track-mouse",\111617,356631
- DEFVAR_KBOARD ("system-key-alist",\111620,356758
- DEFVAR_KBOARD ("local-function-key-map",\111629,357139
- DEFVAR_KBOARD ("input-decode-map",\111658,358598
- DEFVAR_LISP ("function-key-map",\111675,359386
- DEFVAR_LISP ("key-translation-map",\111683,359802
- DEFVAR_LISP ("deferred-action-list",\111689,360146
- DEFVAR_LISP ("deferred-action-function",\111694,360394
- DEFVAR_LISP ("delayed-warnings-list",\111700,360693
- DEFVAR_LISP ("timer-list",\111708,361101
- DEFVAR_LISP ("timer-idle-list",\111712,361253
- DEFVAR_LISP ("input-method-function",\111716,361416
- DEFVAR_LISP ("input-method-previous-message",\111737,362385
- DEFVAR_LISP ("show-help-function",\111744,362746
- DEFVAR_LISP ("disable-point-adjustment",\111749,362978
- DEFVAR_LISP ("global-disable-point-adjustment",\111761,363528
- DEFVAR_LISP ("minibuffer-message-timeout",\111770,363894
- DEFVAR_LISP ("throw-on-input",\111775,364172
- DEFVAR_LISP ("command-error-function",\111781,364423
- DEFVAR_LISP ("enable-disabled-menus-and-buttons",\111790,364910
- DEFVAR_LISP ("select-active-regions",\111798,365237
- DEFVAR_LISP ("saved-region-selection",\111807,365629
- DEFVAR_LISP ("selection-inhibit-update-commands",\111815,366014
- DEFVAR_LISP ("debug-on-event",\111825,366555
+make_lispy_movement 6104,183531
+make_lispy_switch_frame 6131,184262
+make_lispy_focus_in 6137,184369
+make_lispy_focus_out 6145,184495
+parse_modifiers_uncached 6163,184945
+#define SINGLE_LETTER_MOD(6185,185465
+#undef SINGLE_LETTER_MOD6212,185906
+#define MULTI_LETTER_MOD(6214,185932
+#undef MULTI_LETTER_MOD6231,186400
+apply_modifiers_uncached 6273,187574
+static const char *const modifier_names[modifier_names6319,189193
+#define NUM_MOD_NAMES 6325,189399
+static Lisp_Object modifier_symbols;6327,189449
+lispy_modifier_list 6331,189586
+#define KEY_TO_CHAR(6353,190252
+parse_modifiers 6356,190328
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,6399,191517
+DEFUN ("internal-event-symbol-parse-modifiers", Fevent_symbol_parse_modifiers,event-symbol-parse-modifiers6399,191517
+apply_modifiers 6422,192391
+reorder_modifiers 6491,194720
+modify_event_symbol 6536,196528
+DEFUN ("event-convert-list", Fevent_convert_list,6628,199244
+DEFUN ("event-convert-list", Fevent_convert_list,event-convert-list6628,199244
+parse_solitary_modifier 6695,201135
+#define SINGLE_LETTER_MOD(6701,201258
+#define MULTI_LETTER_MOD(6705,201343
+#undef SINGLE_LETTER_MOD6763,202641
+#undef MULTI_LETTER_MOD6764,202666
+lucid_event_type_list_p 6775,202889
+get_input_pending 6814,203960
+record_asynch_buffer_change 6834,204579
+gobble_input 6872,205702
+tty_read_avail_input 6967,208310
+handle_async_input 7149,214039
+process_pending_signals 7165,214359
+unblock_input_to 7177,214645
+unblock_input 7200,215277
+totally_unblock_input 7209,215445
+handle_input_available_signal 7217,215529
+deliver_input_available_signal 7226,215700
+struct user_signal_info7235,215865
+ int sig;7238,215915
+ char *name;name7241,215956
+ int npending;7244,216007
+ struct user_signal_info *next;next7246,216024
+static struct user_signal_info *user_signals user_signals7250,216090
+add_user_signal 7253,216149
+handle_user_signal 7275,216598
+deliver_user_signal 7316,217558
+find_user_signal_name 7322,217659
+store_user_signal_events 7334,217841
+static void menu_bar_item 7362,218341
+static Lisp_Object menu_bar_one_keymap_changed_items;7363,218416
+static Lisp_Object menu_bar_items_vector;7368,218630
+static int menu_bar_items_index;7369,218672
+static const char *separator_names[separator_names7372,218707
+menu_separator_name_p 7393,219148
+menu_bar_items 7426,219852
+Lisp_Object item_properties;7568,224603
+menu_bar_item 7571,224645
+menu_item_eval_property_1 7647,227175
+eval_dyn 7658,227465
+menu_item_eval_property 7666,227675
+parse_menu_item 7686,228341
+static Lisp_Object tool_bar_items_vector;7965,236336
+static Lisp_Object tool_bar_item_properties;7970,236510
+static int ntool_bar_items;7974,236606
+static void init_tool_bar_items 7978,236664
+static void process_tool_bar_item 7979,236711
+static bool parse_tool_bar_item 7981,236801
+static void append_tool_bar_item 7982,236861
+tool_bar_items 7990,237083
+process_tool_bar_item 8075,239892
+#define PROP(8112,240969
+set_prop 8114,241038
+parse_tool_bar_item 8167,242453
+#undef PROP8379,248844
+init_tool_bar_items 8387,248969
+append_tool_bar_item 8401,249261
+read_char_x_menu_prompt 8443,250771
+read_char_minibuf_menu_prompt 8503,252445
+#define PUSH_C_STR(8527,253014
+follow_key 8726,258553
+active_maps 8733,258695
+typedef struct keyremap8742,259021
+ Lisp_Object parent;8745,259107
+ Lisp_Object map;8748,259224
+ int start,8753,259446
+ int start, end;8753,259446
+} keyremap;8754,259464
+access_keymap_keyremap 8764,259808
+keyremap_step 8811,261450
+test_undefined 8867,262934
+read_key_sequence 8916,264861
+read_key_sequence_vs 9826,295821
+DEFUN ("read-key-sequence", Fread_key_sequence,9885,297294
+DEFUN ("read-key-sequence", Fread_key_sequence,read-key-sequence9885,297294
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,9938,299982
+DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector,read-key-sequence-vector9938,299982
+detect_input_pending 9950,300488
+detect_input_pending_ignore_squeezables 9959,300654
+detect_input_pending_run_timers 9967,300870
+clear_input_pending 9985,301362
+requeued_events_pending_p 9997,301732
+DEFUN ("input-pending-p", Finput_pending_p,10002,301813
+DEFUN ("input-pending-p", Finput_pending_p,input-pending-p10002,301813
+DEFUN ("recent-keys", Frecent_keys,10024,302596
+DEFUN ("recent-keys", Frecent_keys,recent-keys10024,302596
+DEFUN ("this-command-keys", Fthis_command_keys,10055,303517
+DEFUN ("this-command-keys", Fthis_command_keys,this-command-keys10055,303517
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,10068,303958
+DEFUN ("this-command-keys-vector", Fthis_command_keys_vector,this-command-keys-vector10068,303958
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,10080,304380
+DEFUN ("this-single-command-keys", Fthis_single_command_keys,this-single-command-keys10080,304380
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,10096,304955
+DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys,this-single-command-raw-keys10096,304955
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,10109,305495
+DEFUN ("reset-this-command-lengths", Freset_this_command_lengths,reset-this-command-lengths10109,305495
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,10136,306510
+DEFUN ("clear-this-command-keys", Fclear_this_command_keys,clear-this-command-keys10136,306510
+DEFUN ("recursion-depth", Frecursion_depth,10158,307069
+DEFUN ("recursion-depth", Frecursion_depth,recursion-depth10158,307069
+DEFUN ("open-dribble-file", Fopen_dribble_file,10169,307406
+DEFUN ("open-dribble-file", Fopen_dribble_file,open-dribble-file10169,307406
+DEFUN ("discard-input", Fdiscard_input,10203,308447
+DEFUN ("discard-input", Fdiscard_input,discard-input10203,308447
+DEFUN ("suspend-emacs", Fsuspend_emacs,10225,308949
+DEFUN ("suspend-emacs", Fsuspend_emacs,suspend-emacs10225,308949
+stuff_buffered_input 10285,311045
+set_waiting_for_input 10323,312016
+clear_waiting_for_input 10337,312390
+handle_interrupt_signal 10351,312754
+deliver_interrupt_signal 10378,313642
+static int volatile force_quit_count;10387,313932
+handle_interrupt 10401,314414
+quit_throw_to_read_char 10541,318711
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,10562,319288
+DEFUN ("set-input-interrupt-mode", Fset_input_interrupt_mode,set-input-interrupt-mode10562,319288
+DEFUN ("set-output-flow-control", Fset_output_flow_control,10609,320516
+DEFUN ("set-output-flow-control", Fset_output_flow_control,set-output-flow-control10609,320516
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,10643,321432
+DEFUN ("set-input-meta-mode", Fset_input_meta_mode,set-input-meta-mode10643,321432
+DEFUN ("set-quit-char", Fset_quit_char,10694,322706
+DEFUN ("set-quit-char", Fset_quit_char,set-quit-char10694,322706
+DEFUN ("set-input-mode", Fset_input_mode,10729,323570
+DEFUN ("set-input-mode", Fset_input_mode,set-input-mode10729,323570
+DEFUN ("current-input-mode", Fcurrent_input_mode,10750,324459
+DEFUN ("current-input-mode", Fcurrent_input_mode,current-input-mode10750,324459
+DEFUN ("posn-at-x-y", Fposn_at_x_y,10787,325837
+DEFUN ("posn-at-x-y", Fposn_at_x_y,posn-at-x-y10787,325837
+DEFUN ("posn-at-point", Fposn_at_point,10824,327060
+DEFUN ("posn-at-point", Fposn_at_point,posn-at-point10824,327060
+init_kboard 10861,328214
+allocate_kboard 10893,329284
+wipe_kboard 10909,329637
+delete_kboard 10917,329751
+init_keyboard 10942,330281
+struct event_head11021,332696
+ short var;11023,332716
+ short kind;11024,332729
+static const struct event_head head_table[head_table11027,332747
+syms_of_keyboard 11045,333577
+ DEFVAR_LISP ("internal--top-level-message"11058,333972
+ DEFVAR_LISP ("last-command-event"11312,342173
+ DEFVAR_LISP ("last-nonmenu-event"11315,342297
+ DEFVAR_LISP ("last-input-event"11321,342636
+ DEFVAR_LISP ("unread-command-events"11324,342730
+ DEFVAR_LISP ("unread-post-input-method-events"11332,343190
+ DEFVAR_LISP ("unread-input-method-events"11338,343529
+ DEFVAR_LISP ("meta-prefix-char"11346,343898
+ DEFVAR_KBOARD ("last-command"11351,344106
+ DEFVAR_KBOARD ("real-last-command"11368,344787
+ DEFVAR_KBOARD ("last-repeatable-command"11372,344973
+ DEFVAR_LISP ("this-command"11378,345261
+ DEFVAR_LISP ("real-this-command"11384,345498
+ DEFVAR_LISP ("this-command-keys-shift-translated"11388,345680
+ DEFVAR_LISP ("this-original-command"11396,346123
+ DEFVAR_INT ("auto-save-interval"11403,346520
+ DEFVAR_LISP ("auto-save-timeout"11408,346734
+ DEFVAR_LISP ("echo-keystrokes"11415,347079
+ DEFVAR_INT ("polling-period"11421,347350
+ DEFVAR_LISP ("double-click-time"11428,347693
+ DEFVAR_INT ("double-click-fuzz"11435,348029
+ DEFVAR_INT ("num-input-keys"11446,348519
+ DEFVAR_INT ("num-nonmacro-input-events"11452,348794
+ DEFVAR_LISP ("last-event-frame"11457,349032
+ DEFVAR_LISP ("tty-erase-char"11463,349311
+ DEFVAR_LISP ("help-char"11466,349434
+ DEFVAR_LISP ("help-event-list"11472,349717
+ DEFVAR_LISP ("help-form"11477,349928
+ DEFVAR_LISP ("prefix-help-command"11483,350176
+ DEFVAR_LISP ("top-level"11489,350454
+ DEFVAR_KBOARD ("keyboard-translate-table"11495,350675
+ DEFVAR_BOOL ("cannot-suspend"11511,351488
+ DEFVAR_BOOL ("menu-prompting"11516,351715
+ DEFVAR_LISP ("menu-prompt-more-char"11526,352145
+ DEFVAR_INT ("extra-keyboard-modifiers"11531,352391
+ DEFVAR_LISP ("deactivate-mark"11545,353117
+ DEFVAR_LISP ("pre-command-hook"11553,353486
+ DEFVAR_LISP ("post-command-hook"11560,353841
+ DEFVAR_LISP ("echo-area-clear-hook"11568,354204
+ DEFVAR_LISP ("lucid-menu-bar-dirty-flag"11574,354419
+ DEFVAR_LISP ("menu-bar-final-items"11578,354622
+ DEFVAR_LISP ("tool-bar-separator-image-expression"11583,354872
+ DEFVAR_KBOARD ("overriding-terminal-local-map"11589,355230
+ DEFVAR_LISP ("overriding-local-map"11598,355652
+ DEFVAR_LISP ("overriding-local-map-menu-flag"11607,356103
+ DEFVAR_LISP ("special-event-map"11613,356442
+ DEFVAR_LISP ("track-mouse"11617,356630
+ DEFVAR_KBOARD ("system-key-alist"11620,356757
+ DEFVAR_KBOARD ("local-function-key-map"11629,357138
+ DEFVAR_KBOARD ("input-decode-map"11658,358597
+ DEFVAR_LISP ("function-key-map"11675,359385
+ DEFVAR_LISP ("key-translation-map"11683,359801
+ DEFVAR_LISP ("deferred-action-list"11689,360145
+ DEFVAR_LISP ("deferred-action-function"11694,360393
+ DEFVAR_LISP ("delayed-warnings-list"11700,360692
+ DEFVAR_LISP ("timer-list"11708,361100
+ DEFVAR_LISP ("timer-idle-list"11712,361252
+ DEFVAR_LISP ("input-method-function"11716,361415
+ DEFVAR_LISP ("input-method-previous-message"11737,362384
+ DEFVAR_LISP ("show-help-function"11744,362745
+ DEFVAR_LISP ("disable-point-adjustment"11749,362977
+ DEFVAR_LISP ("global-disable-point-adjustment"11761,363527
+ DEFVAR_LISP ("minibuffer-message-timeout"11770,363893
+ DEFVAR_LISP ("throw-on-input"11775,364171
+ DEFVAR_LISP ("command-error-function"11781,364422
+ DEFVAR_LISP ("enable-disabled-menus-and-buttons"11790,364909
+ DEFVAR_LISP ("select-active-regions"11798,365236
+ DEFVAR_LISP ("saved-region-selection"11807,365628
+ DEFVAR_LISP ("selection-inhibit-update-commands"11815,366013
+ DEFVAR_LISP ("debug-on-event"11825,366554
+keys_of_keyboard 11841,367115
+mark_kboards 11916,370434
+ DEFVAR_LISP ("internal--top-level-message",\111058,333972
+ DEFVAR_LISP ("last-command-event",\111312,342173
+ DEFVAR_LISP ("last-nonmenu-event",\111315,342297
+ DEFVAR_LISP ("last-input-event",\111321,342636
+ DEFVAR_LISP ("unread-command-events",\111324,342730
+ DEFVAR_LISP ("unread-post-input-method-events",\111332,343190
+ DEFVAR_LISP ("unread-input-method-events",\111338,343529
+ DEFVAR_LISP ("meta-prefix-char",\111346,343898
+ DEFVAR_KBOARD ("last-command",\111351,344106
+ DEFVAR_KBOARD ("real-last-command",\111368,344787
+ DEFVAR_KBOARD ("last-repeatable-command",\111372,344973
+ DEFVAR_LISP ("this-command",\111378,345261
+ DEFVAR_LISP ("real-this-command",\111384,345498
+ DEFVAR_LISP ("this-command-keys-shift-translated",\111388,345680
+ DEFVAR_LISP ("this-original-command",\111396,346123
+ DEFVAR_INT ("auto-save-interval",\111403,346520
+ DEFVAR_LISP ("auto-save-timeout",\111408,346734
+ DEFVAR_LISP ("echo-keystrokes",\111415,347079
+ DEFVAR_INT ("polling-period",\111421,347350
+ DEFVAR_LISP ("double-click-time",\111428,347693
+ DEFVAR_INT ("double-click-fuzz",\111435,348029
+ DEFVAR_INT ("num-input-keys",\111446,348519
+ DEFVAR_INT ("num-nonmacro-input-events",\111452,348794
+ DEFVAR_LISP ("last-event-frame",\111457,349032
+ DEFVAR_LISP ("tty-erase-char",\111463,349311
+ DEFVAR_LISP ("help-char",\111466,349434
+ DEFVAR_LISP ("help-event-list",\111472,349717
+ DEFVAR_LISP ("help-form",\111477,349928
+ DEFVAR_LISP ("prefix-help-command",\111483,350176
+ DEFVAR_LISP ("top-level",\111489,350454
+ DEFVAR_KBOARD ("keyboard-translate-table",\111495,350675
+ DEFVAR_BOOL ("cannot-suspend",\111511,351488
+ DEFVAR_BOOL ("menu-prompting",\111516,351715
+ DEFVAR_LISP ("menu-prompt-more-char",\111526,352145
+ DEFVAR_INT ("extra-keyboard-modifiers",\111531,352391
+ DEFVAR_LISP ("deactivate-mark",\111545,353117
+ DEFVAR_LISP ("pre-command-hook",\111553,353486
+ DEFVAR_LISP ("post-command-hook",\111560,353841
+ DEFVAR_LISP ("echo-area-clear-hook",\111568,354204
+ DEFVAR_LISP ("lucid-menu-bar-dirty-flag",\111574,354419
+ DEFVAR_LISP ("menu-bar-final-items",\111578,354622
+ DEFVAR_LISP ("tool-bar-separator-image-expression",\111583,354872
+ DEFVAR_KBOARD ("overriding-terminal-local-map",\111589,355230
+ DEFVAR_LISP ("overriding-local-map",\111598,355652
+ DEFVAR_LISP ("overriding-local-map-menu-flag",\111607,356103
+ DEFVAR_LISP ("special-event-map",\111613,356442
+ DEFVAR_LISP ("track-mouse",\111617,356630
+ DEFVAR_KBOARD ("system-key-alist",\111620,356757
+ DEFVAR_KBOARD ("local-function-key-map",\111629,357138
+ DEFVAR_KBOARD ("input-decode-map",\111658,358597
+ DEFVAR_LISP ("function-key-map",\111675,359385
+ DEFVAR_LISP ("key-translation-map",\111683,359801
+ DEFVAR_LISP ("deferred-action-list",\111689,360145
+ DEFVAR_LISP ("deferred-action-function",\111694,360393
+ DEFVAR_LISP ("delayed-warnings-list",\111700,360692
+ DEFVAR_LISP ("timer-list",\111708,361100
+ DEFVAR_LISP ("timer-idle-list",\111712,361252
+ DEFVAR_LISP ("input-method-function",\111716,361415
+ DEFVAR_LISP ("input-method-previous-message",\111737,362384
+ DEFVAR_LISP ("show-help-function",\111744,362745
+ DEFVAR_LISP ("disable-point-adjustment",\111749,362977
+ DEFVAR_LISP ("global-disable-point-adjustment",\111761,363527
+ DEFVAR_LISP ("minibuffer-message-timeout",\111770,363893
+ DEFVAR_LISP ("throw-on-input",\111775,364171
+ DEFVAR_LISP ("command-error-function",\111781,364422
+ DEFVAR_LISP ("enable-disabled-menus-and-buttons",\111790,364909
+ DEFVAR_LISP ("select-active-regions",\111798,365236
+ DEFVAR_LISP ("saved-region-selection",\111807,365628
+ DEFVAR_LISP ("selection-inhibit-update-commands",\111815,366013
+ DEFVAR_LISP ("debug-on-event",\111825,366554
c-src/emacs/src/lisp.h,41391
#define EMACS_LISP_H22,801
@@ -3253,11 +3249,11 @@ main(37,571
D(D::D43,659
int x;D::x44,694
-el-src/TAGTEST.EL,179
-(foo::defmumble bletch 1,0
-(defun foo==bar foo==bar2,33
-(defalias 'pending-delete-mode pending-delete-mode6,149
-(defalias (quote explicitly-quoted-pending-delete-mode)9,222
+el-src/TAGTEST.EL,181
+(foo::defmumble bletch 3,33
+(defun foo==bar foo==bar4,66
+(defalias 'pending-delete-mode pending-delete-mode8,182
+(defalias (quote explicitly-quoted-pending-delete-mode)11,255
el-src/emacs/lisp/progmodes/etags.el,5188
(defvar tags-file-name 34,1035
@@ -4050,22 +4046,22 @@ ord_add_element(71,1867
ord_del_element(85,2344
ord_disjoint(100,2783
ord_intersect(108,2953
-ord_intersection(126,3552
-ord_intersection3(130,3691
-ord_intersection(150,4531
-ord_intersection4(154,4703
-ord_intersection(176,5664
-ord_intersection2(181,5812
-ord_member(200,6318
-ord_seteq(216,6683
-ord_setproduct(225,6971
-ord_subset(240,7377
-ord_subtract(257,7861
-ord_symdiff(265,8054
-ord_union(288,8887
-ord_union4(303,9352
-ord_union(324,10171
-ord_union_all(329,10313
+ord_intersection(126,3553
+ord_intersection3(130,3692
+ord_intersection(150,4533
+ord_intersection4(154,4705
+ord_intersection(176,5666
+ord_intersection2(181,5814
+ord_member(200,6320
+ord_seteq(216,6685
+ord_setproduct(225,6973
+ord_subset(240,7379
+ord_subtract(257,7863
+ord_symdiff(265,8056
+ord_union(288,8889
+ord_union4(303,9354
+ord_union(324,10173
+ord_union_all(329,10315
prol-src/natded.prolog,2319
expandmng(100,2879
@@ -4280,6 +4276,11 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+rs-src/test.rs,52
+enum IpAddrKind 3,11
+fn test1(8,48
+fn main(12,88
+
scm-src/test.scm,260
(define hello 1,0
(set! hello 3,32
@@ -4494,533 +4495,687 @@ tex-src/texinfo.tex,30627
\def\vritemindex #1{\vritemindex1068,35482
\def\tablez #1#2#3#4#5#6{\tablez1074,35631
\def\Edescription{\Edescription1077,35689
-\def\itemfont{\itemfont1082,35891
-\def\Etable{\Etable1090,36117
-\def\itemize{\itemize1103,36441
-\def\itemizezzz #1{\itemizezzz1105,36477
-\def\itemizey #1#2{\itemizey1110,36572
-\def#2{1119,36818
-\def\itemcontents{\itemcontents1120,36859
-\def\bullet{\bullet1123,36907
-\def\minus{\minus1124,36934
-\def\frenchspacing{\frenchspacing1128,37042
-\def\splitoff#1#2\endmark{\splitoff1134,37267
-\def\enumerate{\enumerate1140,37497
-\def\enumeratezzz #1{\enumeratezzz1141,37536
-\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37589
- \def\thearg{\thearg1146,37736
- \ifx\thearg\empty \def\thearg{\thearg1147,37755
-\def\numericenumerate{\numericenumerate1184,39089
-\def\lowercaseenumerate{\lowercaseenumerate1190,39219
-\def\uppercaseenumerate{\uppercaseenumerate1203,39566
-\def\startenumeration#1{\startenumeration1219,40056
-\def\alphaenumerate{\alphaenumerate1227,40238
-\def\capsenumerate{\capsenumerate1228,40273
-\def\Ealphaenumerate{\Ealphaenumerate1229,40307
-\def\Ecapsenumerate{\Ecapsenumerate1230,40341
-\def\itemizeitem{\itemizeitem1234,40421
-\def\newindex #1{\newindex1259,41278
-\def\defindex{\defindex1268,41567
-\def\newcodeindex #1{\newcodeindex1272,41675
-\def\defcodeindex{\defcodeindex1279,41935
-\def\synindex #1 #2 {\synindex1283,42115
-\def\syncodeindex #1 #2 {\syncodeindex1292,42455
-\def\doindex#1{\doindex1309,43134
-\def\singleindexer #1{\singleindexer1310,43193
-\def\docodeindex#1{\docodeindex1313,43305
-\def\singlecodeindexer #1{\singlecodeindexer1314,43372
-\def\indexdummies{\indexdummies1316,43430
-\def\_{\_1317,43450
-\def\w{\w1318,43478
-\def\bf{\bf1319,43505
-\def\rm{\rm1320,43534
-\def\sl{\sl1321,43563
-\def\sf{\sf1322,43592
-\def\tt{\tt1323,43620
-\def\gtr{\gtr1324,43648
-\def\less{\less1325,43678
-\def\hat{\hat1326,43710
-\def\char{\char1327,43740
-\def\TeX{\TeX1328,43772
-\def\dots{\dots1329,43802
-\def\copyright{\copyright1330,43835
-\def\tclose##1{\tclose1331,43878
-\def\code##1{\code1332,43923
-\def\samp##1{\samp1333,43964
-\def\t##1{\t1334,44005
-\def\r##1{\r1335,44040
-\def\i##1{\i1336,44075
-\def\b##1{\b1337,44110
-\def\cite##1{\cite1338,44145
-\def\key##1{\key1339,44186
-\def\file##1{\file1340,44225
-\def\var##1{\var1341,44266
-\def\kbd##1{\kbd1342,44305
-\def\indexdummyfont#1{\indexdummyfont1347,44461
-\def\indexdummytex{\indexdummytex1348,44487
-\def\indexdummydots{\indexdummydots1349,44511
-\def\indexnofonts{\indexnofonts1351,44537
-\let\w=\indexdummyfontdummyfont1352,44557
-\let\t=\indexdummyfontdummyfont1353,44580
-\let\r=\indexdummyfontdummyfont1354,44603
-\let\i=\indexdummyfontdummyfont1355,44626
-\let\b=\indexdummyfontdummyfont1356,44649
-\let\emph=\indexdummyfontdummyfont1357,44672
-\let\strong=\indexdummyfontdummyfont1358,44698
-\let\cite=\indexdummyfont=\indexdummyfont1359,44726
-\let\sc=\indexdummyfontdummyfont1360,44752
-\let\tclose=\indexdummyfontdummyfont1364,44924
-\let\code=\indexdummyfontdummyfont1365,44952
-\let\file=\indexdummyfontdummyfont1366,44978
-\let\samp=\indexdummyfontdummyfont1367,45004
-\let\kbd=\indexdummyfontdummyfont1368,45030
-\let\key=\indexdummyfontdummyfont1369,45055
-\let\var=\indexdummyfontdummyfont1370,45080
-\let\TeX=\indexdummytexdummytex1371,45105
-\let\dots=\indexdummydotsdummydots1372,45129
-\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45381
-\def\doind #1#2{\doind1384,45437
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45480
-\def\rawbackslashxx{\rawbackslashxx1389,45620
-{\indexnofontsnofonts1394,45882
-\def\dosubind #1#2#3{\dosubind1405,46193
-{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46241
-\def\rawbackslashxx{\rawbackslashxx1410,46345
-{\indexnofontsnofonts1414,46499
-\def\findex {\findex1443,47430
-\def\kindex {\kindex1444,47453
-\def\cindex {\cindex1445,47476
-\def\vindex {\vindex1446,47499
-\def\tindex {\tindex1447,47522
-\def\pindex {\pindex1448,47545
-\def\cindexsub {\cindexsub1450,47569
-\def\printindex{\printindex1462,47896
-\def\doprintindex#1{\doprintindex1464,47937
- \def\indexbackslash{\indexbackslash1481,48422
- \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48461
-\def\initial #1{\initial1517,49533
-\def\entry #1#2{\entry1523,49740
- \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50387
-\def\indexdotfill{\indexdotfill1549,50715
-\def\primary #1{\primary1552,50821
-\def\secondary #1#2{\secondary1556,50903
-\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50985
-\newbox\partialpageialpage1566,51158
-\def\begindoublecolumns{\begindoublecolumns1572,51316
- \output={\global\setbox\partialpage=ialpage=1573,51352
-\def\enddoublecolumns{\enddoublecolumns1577,51540
-\def\doublecolumnout{\doublecolumnout1580,51625
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51694
-\def\pagesofar{\pagesofar1584,51872
-\def\balancecolumns{\balancecolumns1588,52109
- \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52280
- \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52541
-\newcount \appendixno \appendixno = `\@no1627,53446
-\def\appendixletter{\appendixletter1628,53487
-\def\opencontents{\opencontents1632,53590
-\def\thischapter{\thischapter1637,53771
-\def\seccheck#1{\seccheck1638,53809
-\def\chapternofonts{\chapternofonts1643,53913
-\def\result{\result1646,53988
-\def\equiv{\equiv1647,54023
-\def\expansion{\expansion1648,54056
-\def\print{\print1649,54097
-\def\TeX{\TeX1650,54130
-\def\dots{\dots1651,54159
-\def\copyright{\copyright1652,54190
-\def\tt{\tt1653,54231
-\def\bf{\bf1654,54258
-\def\w{\w1655,54286
-\def\less{\less1656,54311
-\def\gtr{\gtr1657,54342
-\def\hat{\hat1658,54371
-\def\char{\char1659,54400
-\def\tclose##1{\tclose1660,54431
-\def\code##1{\code1661,54475
-\def\samp##1{\samp1662,54515
-\def\r##1{\r1663,54555
-\def\b##1{\b1664,54589
-\def\key##1{\key1665,54623
-\def\file##1{\file1666,54661
-\def\kbd##1{\kbd1667,54701
-\def\i##1{\i1669,54809
-\def\cite##1{\cite1670,54843
-\def\var##1{\var1671,54883
-\def\emph##1{\emph1672,54921
-\def\dfn##1{\dfn1673,54961
-\def\thischaptername{\thischaptername1676,55002
-\outer\def\chapter{\chapter1677,55041
-\def\chapterzzz #1{\chapterzzz1678,55082
-{\chapternofonts%nofonts%1687,55478
-\global\let\section = \numberedsec=1692,55631
-\global\let\subsection = \numberedsubsec=1693,55666
-\global\let\subsubsection = \numberedsubsubsec=1694,55707
-\outer\def\appendix{\appendix1697,55758
-\def\appendixzzz #1{\appendixzzz1698,55801
-\global\advance \appendixno by 1 \message{no1700,55878
-\chapmacro {#1}{Appendix \appendixletter}letter1701,55947
-\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56040
-{\chapternofonts%nofonts%1705,56112
- {#1}{Appendix \appendixletter}letter1707,56168
-\appendixnoderef %noderef1710,56268
-\global\let\section = \appendixsec=1711,56287
-\global\let\subsection = \appendixsubsec=1712,56322
-\global\let\subsubsection = \appendixsubsubsec=1713,56363
-\outer\def\top{\top1716,56414
-\outer\def\unnumbered{\unnumbered1717,56454
-\def\unnumberedzzz #1{\unnumberedzzz1718,56501
-{\chapternofonts%nofonts%1722,56664
-\global\let\section = \unnumberedsec=1727,56814
-\global\let\subsection = \unnumberedsubsec=1728,56851
-\global\let\subsubsection = \unnumberedsubsubsec=1729,56894
-\outer\def\numberedsec{\numberedsec1732,56947
-\def\seczzz #1{\seczzz1733,56988
-{\chapternofonts%nofonts%1736,57144
-\outer\def\appendixsection{\appendixsection1745,57330
-\outer\def\appendixsec{\appendixsec1746,57387
-\def\appendixsectionzzz #1{\appendixsectionzzz1747,57440
-\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57552
-{\chapternofonts%nofonts%1750,57620
-{#1}{\appendixletter}letter1752,57676
-\appendixnoderef %noderef1755,57776
-\outer\def\unnumberedsec{\unnumberedsec1759,57816
-\def\unnumberedseczzz #1{\unnumberedseczzz1760,57869
-{\chapternofonts%nofonts%1762,57964
-\outer\def\numberedsubsec{\numberedsubsec1770,58132
-\def\numberedsubseczzz #1{\numberedsubseczzz1771,58187
-{\chapternofonts%nofonts%1774,58366
-\outer\def\appendixsubsec{\appendixsubsec1783,58570
-\def\appendixsubseczzz #1{\appendixsubseczzz1784,58625
-\subsecheading {#1}{\appendixletter}letter1786,58747
-{\chapternofonts%nofonts%1787,58812
-{#1}{\appendixletter}letter1789,58871
-\appendixnoderef %noderef1792,58986
-\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59026
-\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59085
-{\chapternofonts%nofonts%1799,59186
-\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59357
-\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59418
-{\chapternofonts%nofonts%1812,59615
-\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59848
-\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59909
- {\appendixletter}letter1827,60048
-{\chapternofonts%nofonts%1828,60114
- {\appendixletter}letter1830,60179
-\appendixnoderef %noderef1834,60313
-\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60353
-\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60418
-{\chapternofonts%nofonts%1841,60525
-\def\infotop{\infotop1851,60854
-\def\infounnumbered{\infounnumbered1852,60892
-\def\infounnumberedsec{\infounnumberedsec1853,60937
-\def\infounnumberedsubsec{\infounnumberedsubsec1854,60988
-\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61045
-\def\infoappendix{\infoappendix1857,61109
-\def\infoappendixsec{\infoappendixsec1858,61150
-\def\infoappendixsubsec{\infoappendixsubsec1859,61197
-\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61250
-\def\infochapter{\infochapter1862,61310
-\def\infosection{\infosection1863,61349
-\def\infosubsection{\infosubsection1864,61388
-\def\infosubsubsection{\infosubsubsection1865,61433
-\global\let\section = \numberedsec=1870,61670
-\global\let\subsection = \numberedsubsec=1871,61705
-\global\let\subsubsection = \numberedsubsubsec=1872,61746
-\def\majorheading{\majorheading1886,62253
-\def\majorheadingzzz #1{\majorheadingzzz1887,62298
-\def\chapheading{\chapheading1893,62531
-\def\chapheadingzzz #1{\chapheadingzzz1894,62574
-\def\heading{\heading1899,62769
-\def\subheading{\subheading1901,62806
-\def\subsubheading{\subsubheading1903,62849
-\def\dobreak#1#2{\dobreak1910,63126
-\def\setchapterstyle #1 {\setchapterstyle1912,63204
-\def\chapbreak{\chapbreak1919,63459
-\def\chappager{\chappager1920,63509
-\def\chapoddpage{\chapoddpage1921,63547
-\def\setchapternewpage #1 {\setchapternewpage1923,63626
-\def\CHAPPAGoff{\CHAPPAGoff1925,63683
-\def\CHAPPAGon{\CHAPPAGon1929,63777
-\global\def\HEADINGSon{\HEADINGSon1932,63868
-\def\CHAPPAGodd{\CHAPPAGodd1934,63910
-\global\def\HEADINGSon{\HEADINGSon1937,64006
-\def\CHAPFplain{\CHAPFplain1941,64060
-\def\chfplain #1#2{\chfplain1945,64152
-\def\unnchfplain #1{\unnchfplain1956,64375
-\def\unnchfopen #1{\unnchfopen1964,64604
-\def\chfopen #1#2{\chfopen1970,64812
-\def\CHAPFopen{\CHAPFopen1975,64956
-\def\subsecheadingbreak{\subsecheadingbreak1982,65174
-\def\secheadingbreak{\secheadingbreak1985,65303
-\def\secheading #1#2#3{\secheading1993,65585
-\def\plainsecheading #1{\plainsecheading1994,65641
-\def\secheadingi #1{\secheadingi1995,65684
-\def\subsecheading #1#2#3#4{\subsecheading2006,66052
-\def\subsecheadingi #1{\subsecheadingi2007,66119
-\def\subsubsecfonts{\subsubsecfonts2014,66416
-\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66539
-\def\subsubsecheadingi #1{\subsubsecheadingi2018,66617
-\def\startcontents#1{\startcontents2032,67089
- \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67362
-\outer\def\contents{\contents2049,67721
-\outer\def\summarycontents{\summarycontents2057,67865
- \def\secentry ##1##2##3##4{\secentry2067,68236
- \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68271
- \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68306
- \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68347
- \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68385
- \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68432
-\def\chapentry#1#2#3{\chapentry2085,68866
-\def\shortchapentry#1#2#3{\shortchapentry2088,68983
- {#2\labelspace #1}space2091,69093
-\def\unnumbchapentry#1#2{\unnumbchapentry2094,69147
-\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69194
-\def\secentry#1#2#3#4{\secentry2102,69358
-\def\unnumbsecentry#1#2{\unnumbsecentry2103,69417
-\def\subsecentry#1#2#3#4#5{\subsecentry2106,69478
-\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69548
-\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69622
- \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69656
-\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69707
-\def\dochapentry#1#2{\dochapentry2123,70081
-\def\dosecentry#1#2{\dosecentry2138,70686
-\def\dosubsecentry#1#2{\dosubsecentry2145,70864
-\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71049
-\def\labelspace{\labelspace2160,71300
-\def\dopageno#1{\dopageno2162,71335
-\def\doshortpageno#1{\doshortpageno2163,71361
-\def\chapentryfonts{\chapentryfonts2165,71393
-\def\secentryfonts{\secentryfonts2166,71428
-\def\point{\point2192,72387
-\def\result{\result2194,72408
-\def\expansion{\expansion2195,72481
-\def\print{\print2196,72552
-\def\equiv{\equiv2198,72619
-\def\error{\error2218,73392
-\def\tex{\tex2224,73621
-\def\@{\@2242,74004
-\gdef\sepspaces{\def {\ }}}\2265,74736
-\def\aboveenvbreak{\aboveenvbreak2268,74818
-\def\afterenvbreak{\afterenvbreak2272,74984
-\def\ctl{\ctl2286,75495
-\def\ctr{\ctr2287,75567
-\def\cbl{\cbl2288,75606
-\def\cbr{\cbr2289,75646
-\def\carttop{\carttop2290,75685
-\def\cartbot{\cartbot2293,75793
-\long\def\cartouche{\cartouche2299,75933
-\def\Ecartouche{\Ecartouche2326,76721
-\def\lisp{\lisp2338,76856
-\def\Elisp{\Elisp2348,77203
-\def\next##1{\next2360,77529
-\def\Eexample{\Eexample2364,77571
-\def\Esmallexample{\Esmallexample2367,77618
-\def\smalllispx{\smalllispx2373,77796
-\def\Esmalllisp{\Esmalllisp2383,78150
-\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78506
-\def\next##1{\next2397,78563
-\def\display{\display2401,78643
-\def\Edisplay{\Edisplay2410,78962
-\def\next##1{\next2422,79273
-\def\format{\format2426,79376
-\def\Eformat{\Eformat2434,79672
-\def\next##1{\next2437,79761
-\def\flushleft{\flushleft2441,79813
-\def\Eflushleft{\Eflushleft2451,80184
-\def\next##1{\next2454,80277
-\def\flushright{\flushright2456,80299
-\def\Eflushright{\Eflushright2466,80671
-\def\next##1{\next2470,80802
-\def\quotation{\quotation2474,80860
-\def\Equotation{\Equotation2480,81052
-\def\setdeffont #1 {\setdeffont2493,81450
-\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81496
-\newskip\defargsindent \defargsindent=50ptargsindent2496,81539
-\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81582
-\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81625
-\def\activeparens{\activeparens2503,81823
-\def\opnr{\opnr2529,83035
-\def\lbrb{\lbrb2530,83100
-\def\defname #1#2{\defname2536,83301
-\advance\dimen2 by -\defbodyindentbodyindent2540,83419
-\advance\dimen3 by -\defbodyindentbodyindent2542,83473
-\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83527
-\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83669
-\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83744
-\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84113
-\advance\leftskip by -\defbodyindentbodyindent2557,84247
-\exdentamount=\defbodyindentbodyindent2558,84284
-\def\defparsebody #1#2#3{\defparsebody2568,84643
-\def#1{2572,84827
-\def#2{2573,84863
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84935
-\exdentamount=\defbodyindentbodyindent2576,85009
-\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85113
-\def#1{2585,85274
-\def#2##1 {2586,85310
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85393
-\exdentamount=\defbodyindentbodyindent2589,85467
-\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85552
-\def#1{2596,85713
-\def#2##1 ##2 {2597,85749
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85849
-\exdentamount=\defbodyindentbodyindent2601,85923
-\def\defvarparsebody #1#2#3{\defvarparsebody2608,86194
-\def#1{2612,86381
-\def#2{2613,86417
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86476
-\exdentamount=\defbodyindentbodyindent2616,86550
-\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86641
-\def#1{2625,86800
-\def#2##1 {2626,86836
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86906
-\exdentamount=\defbodyindentbodyindent2629,86980
-\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87052
-\def#1{2636,87216
-\def#2##1 ##2 {2637,87252
-\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87339
-\exdentamount=\defbodyindentbodyindent2641,87413
-\def\defunargs #1{\defunargs2664,88173
-\def\deftypefunargs #1{\deftypefunargs2676,88555
-\def\deffn{\deffn2690,88937
-\def\deffnheader #1#2#3{\deffnheader2692,88994
-\begingroup\defname {name2693,89042
-\def\defun{\defun2699,89187
-\def\defunheader #1#2{\defunheader2701,89240
-\begingroup\defname {name2702,89315
-\defunargs {unargs2703,89351
-\def\deftypefun{\deftypefun2709,89499
-\def\deftypefunheader #1#2{\deftypefunheader2712,89621
-\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89730
-\begingroup\defname {name2716,89822
-\deftypefunargs {typefunargs2717,89868
-\def\deftypefn{\deftypefn2723,90039
-\def\deftypefnheader #1#2#3{\deftypefnheader2726,90188
-\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90324
-\begingroup\defname {name2730,90417
-\deftypefunargs {typefunargs2731,90457
-\def\defmac{\defmac2737,90578
-\def\defmacheader #1#2{\defmacheader2739,90635
-\begingroup\defname {name2740,90711
-\defunargs {unargs2741,90744
-\def\defspec{\defspec2747,90868
-\def\defspecheader #1#2{\defspecheader2749,90929
-\begingroup\defname {name2750,91006
-\defunargs {unargs2751,91046
-\def\deffnx #1 {\deffnx2758,91241
-\def\defunx #1 {\defunx2759,91298
-\def\defmacx #1 {\defmacx2760,91355
-\def\defspecx #1 {\defspecx2761,91414
-\def\deftypefnx #1 {\deftypefnx2762,91475
-\def\deftypeunx #1 {\deftypeunx2763,91540
-\def\defop #1 {\defop2769,91686
-\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91721
-\def\defopheader #1#2#3{\defopheader2772,91775
-\begingroup\defname {name2774,91864
-\defunargs {unargs2775,91910
-\def\defmethod{\defmethod2780,91971
-\def\defmethodheader #1#2#3{\defmethodheader2782,92044
-\begingroup\defname {name2784,92132
-\defunargs {unargs2785,92172
-\def\defcv #1 {\defcv2790,92246
-\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92281
-\def\defcvarheader #1#2#3{\defcvarheader2793,92340
-\begingroup\defname {name2795,92426
-\defvarargs {varargs2796,92472
-\def\defivar{\defivar2801,92545
-\def\defivarheader #1#2#3{\defivarheader2803,92608
-\begingroup\defname {name2805,92694
-\defvarargs {varargs2806,92745
-\def\defopx #1 {\defopx2812,92894
-\def\defmethodx #1 {\defmethodx2813,92951
-\def\defcvx #1 {\defcvx2814,93016
-\def\defivarx #1 {\defivarx2815,93073
-\def\defvarargs #1{\defvarargs2822,93344
-\def\defvr{\defvr2828,93488
-\def\defvrheader #1#2#3{\defvrheader2830,93543
-\begingroup\defname {name2831,93591
-\def\defvar{\defvar2835,93676
-\def\defvarheader #1#2{\defvarheader2837,93736
-\begingroup\defname {name2838,93807
-\defvarargs {varargs2839,93843
-\def\defopt{\defopt2844,93909
-\def\defoptheader #1#2{\defoptheader2846,93969
-\begingroup\defname {name2847,94040
-\defvarargs {varargs2848,94079
-\def\deftypevar{\deftypevar2853,94136
-\def\deftypevarheader #1#2{\deftypevarheader2856,94252
-\begingroup\defname {name2858,94335
-\def\deftypevr{\deftypevr2865,94509
-\def\deftypevrheader #1#2#3{\deftypevrheader2867,94580
-\begingroup\defname {name2868,94632
-\def\defvrx #1 {\defvrx2876,94869
-\def\defvarx #1 {\defvarx2877,94926
-\def\defoptx #1 {\defoptx2878,94985
-\def\deftypevarx #1 {\deftypevarx2879,95044
-\def\deftypevrx #1 {\deftypevrx2880,95111
-\def\deftpargs #1{\deftpargs2885,95260
-\def\deftp{\deftp2889,95340
-\def\deftpheader #1#2#3{\deftpheader2891,95395
-\begingroup\defname {name2892,95443
-\def\deftpx #1 {\deftpx2897,95602
-\def\setref#1{\setref2908,95923
-\def\unnumbsetref#1{\unnumbsetref2913,96037
-\def\appendixsetref#1{\appendixsetref2918,96144
-\def\pxref#1{\pxref2929,96555
-\def\xref#1{\xref2930,96591
-\def\ref#1{\ref2931,96626
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96656
-\def\printedmanual{\printedmanual2933,96699
-\def\printednodename{\printednodename2934,96737
-\def\printednodename{\printednodename2939,96862
-section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97495
-\refx{x2957,97573
-\def\dosetq #1#2{\dosetq2965,97793
-\def\internalsetq #1#2{\internalsetq2973,98051
-\def\Ypagenumber{\Ypagenumber2977,98152
-\def\Ytitle{\Ytitle2979,98178
-\def\Ynothing{\Ynothing2981,98205
-\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98222
-\def\Yappendixletterandtype{\Yappendixletterandtype2992,98538
-\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98568
-\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98623
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98727
-Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98798
- \def\linenumber{\linenumber3009,99137
-\def\refx#1#2{\refx3015,99321
-\def\xrdef #1#2{\xrdef3037,99947
-\def\readauxfile{\readauxfile3040,100032
-\def\supereject{\supereject3110,101813
-\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102498
-\def\openindices{\openindices3139,102684
-\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102909
-\parindent = \defaultparindentaultparindent3152,102961
-\def\smallbook{\smallbook3175,103685
-\global\def\Esmallexample{\Esmallexample3192,104112
-\def\afourpaper{\afourpaper3196,104203
-\def\finalout{\finalout3224,105011
-\def\normaldoublequote{\normaldoublequote3235,105272
-\def\normaltilde{\normaltilde3236,105298
-\def\normalcaret{\normalcaret3237,105318
-\def\normalunderscore{\normalunderscore3238,105338
-\def\normalverticalbar{\normalverticalbar3239,105363
-\def\normalless{\normalless3240,105389
-\def\normalgreater{\normalgreater3241,105408
-\def\normalplus{\normalplus3242,105430
-\def\ifusingtt#1#2{\ifusingtt3253,105922
-\def\activedoublequote{\activedoublequote3261,106250
-\def~{~3264,106336
-\def^{^3267,106397
-\def_{_3270,106436
-\def\_{\_3272,106510
-\def\lvvmode{\lvvmode3279,106847
-\def|{|3282,106897
-\def<{<3285,106960
-\def>{>3288,107017
-\def+{+3290,107055
-\def\turnoffactive{\turnoffactive3296,107216
-\global\def={=3307,107502
-\def\normalbackslash{\normalbackslash3321,107884
+\def\itemfont{\itemfont1082,35890
+\def\Etable{\Etable1090,36116
+\def\itemize{\itemize1103,36440
+\def\itemizezzz #1{\itemizezzz1105,36476
+\def\itemizey #1#2{\itemizey1110,36571
+\def#2{1119,36817
+\def\itemcontents{\itemcontents1120,36858
+\def\bullet{\bullet1123,36906
+\def\minus{\minus1124,36933
+\def\frenchspacing{\frenchspacing1128,37041
+\def\splitoff#1#2\endmark{\splitoff1134,37266
+\def\enumerate{\enumerate1140,37496
+\def\enumeratezzz #1{\enumeratezzz1141,37535
+\def\enumeratey #1 #2\endenumeratey{\enumeratey1142,37588
+ \def\thearg{\thearg1146,37735
+ \ifx\thearg\empty \def\thearg{\thearg1147,37754
+\def\numericenumerate{\numericenumerate1184,39088
+\def\lowercaseenumerate{\lowercaseenumerate1190,39218
+\def\uppercaseenumerate{\uppercaseenumerate1203,39565
+\def\startenumeration#1{\startenumeration1219,40055
+\def\alphaenumerate{\alphaenumerate1227,40237
+\def\capsenumerate{\capsenumerate1228,40272
+\def\Ealphaenumerate{\Ealphaenumerate1229,40306
+\def\Ecapsenumerate{\Ecapsenumerate1230,40340
+\def\itemizeitem{\itemizeitem1234,40420
+\def\newindex #1{\newindex1259,41277
+\def\defindex{\defindex1268,41566
+\def\newcodeindex #1{\newcodeindex1272,41674
+\def\defcodeindex{\defcodeindex1279,41934
+\def\synindex #1 #2 {\synindex1283,42114
+\def\syncodeindex #1 #2 {\syncodeindex1292,42454
+\def\doindex#1{\doindex1309,43133
+\def\singleindexer #1{\singleindexer1310,43192
+\def\docodeindex#1{\docodeindex1313,43304
+\def\singlecodeindexer #1{\singlecodeindexer1314,43371
+\def\indexdummies{\indexdummies1316,43429
+\def\_{\_1317,43449
+\def\w{\w1318,43477
+\def\bf{\bf1319,43504
+\def\rm{\rm1320,43533
+\def\sl{\sl1321,43562
+\def\sf{\sf1322,43591
+\def\tt{\tt1323,43619
+\def\gtr{\gtr1324,43647
+\def\less{\less1325,43677
+\def\hat{\hat1326,43709
+\def\char{\char1327,43739
+\def\TeX{\TeX1328,43771
+\def\dots{\dots1329,43801
+\def\copyright{\copyright1330,43834
+\def\tclose##1{\tclose1331,43877
+\def\code##1{\code1332,43922
+\def\samp##1{\samp1333,43963
+\def\t##1{\t1334,44004
+\def\r##1{\r1335,44039
+\def\i##1{\i1336,44074
+\def\b##1{\b1337,44109
+\def\cite##1{\cite1338,44144
+\def\key##1{\key1339,44185
+\def\file##1{\file1340,44224
+\def\var##1{\var1341,44265
+\def\kbd##1{\kbd1342,44304
+\def\indexdummyfont#1{\indexdummyfont1347,44460
+\def\indexdummytex{\indexdummytex1348,44486
+\def\indexdummydots{\indexdummydots1349,44510
+\def\indexnofonts{\indexnofonts1351,44536
+\let\w=\indexdummyfontdummyfont1352,44556
+\let\t=\indexdummyfontdummyfont1353,44579
+\let\r=\indexdummyfontdummyfont1354,44602
+\let\i=\indexdummyfontdummyfont1355,44625
+\let\b=\indexdummyfontdummyfont1356,44648
+\let\emph=\indexdummyfontdummyfont1357,44671
+\let\strong=\indexdummyfontdummyfont1358,44697
+\let\cite=\indexdummyfont=\indexdummyfont1359,44725
+\let\sc=\indexdummyfontdummyfont1360,44751
+\let\tclose=\indexdummyfontdummyfont1364,44923
+\let\code=\indexdummyfontdummyfont1365,44951
+\let\file=\indexdummyfontdummyfont1366,44977
+\let\samp=\indexdummyfontdummyfont1367,45003
+\let\kbd=\indexdummyfontdummyfont1368,45029
+\let\key=\indexdummyfontdummyfont1369,45054
+\let\var=\indexdummyfontdummyfont1370,45079
+\let\TeX=\indexdummytexdummytex1371,45104
+\let\dots=\indexdummydotsdummydots1372,45128
+\let\indexbackslash=0 %overridden during \printindex.backslash=01382,45380
+\def\doind #1#2{\doind1384,45436
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1386,45479
+\def\rawbackslashxx{\rawbackslashxx1389,45619
+{\indexnofontsnofonts1394,45881
+\def\dosubind #1#2#3{\dosubind1405,46192
+{\indexdummies % Must do this here, since \bf, etc expand at this stagedummies1407,46240
+\def\rawbackslashxx{\rawbackslashxx1410,46344
+{\indexnofontsnofonts1414,46498
+\def\findex {\findex1443,47429
+\def\kindex {\kindex1444,47452
+\def\cindex {\cindex1445,47475
+\def\vindex {\vindex1446,47498
+\def\tindex {\tindex1447,47521
+\def\pindex {\pindex1448,47544
+\def\cindexsub {\cindexsub1450,47568
+\def\printindex{\printindex1462,47895
+\def\doprintindex#1{\doprintindex1464,47936
+ \def\indexbackslash{\indexbackslash1481,48421
+ \indexfonts\rm \tolerance=9500 \advance\baselineskip -1ptfonts\rm1482,48460
+\def\initial #1{\initial1517,49532
+\def\entry #1#2{\entry1523,49739
+ \null\nobreak\indexdotfill % Have leaders before the page number.dotfill1540,50386
+\def\indexdotfill{\indexdotfill1549,50714
+\def\primary #1{\primary1552,50820
+\def\secondary #1#2{\secondary1556,50902
+\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\pardotfill1559,50984
+\newbox\partialpageialpage1566,51157
+\def\begindoublecolumns{\begindoublecolumns1572,51315
+ \output={\global\setbox\partialpage=ialpage=1573,51351
+\def\enddoublecolumns{\enddoublecolumns1577,51539
+\def\doublecolumnout{\doublecolumnout1580,51624
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1581,51693
+\def\pagesofar{\pagesofar1584,51871
+\def\balancecolumns{\balancecolumns1588,52108
+ \availdimen@=\pageheight \advance\availdimen@ by-\ht\partialpageialpage1594,52279
+ \dimen@=\pageheight \advance\dimen@ by-\ht\partialpageialpage1600,52540
+\newcount \appendixno \appendixno = `\@no1627,53445
+\def\appendixletter{\appendixletter1628,53486
+\def\opencontents{\opencontents1632,53589
+\def\thischapter{\thischapter1637,53770
+\def\seccheck#1{\seccheck1638,53808
+\def\chapternofonts{\chapternofonts1643,53912
+\def\result{\result1646,53987
+\def\equiv{\equiv1647,54022
+\def\expansion{\expansion1648,54055
+\def\print{\print1649,54096
+\def\TeX{\TeX1650,54129
+\def\dots{\dots1651,54158
+\def\copyright{\copyright1652,54189
+\def\tt{\tt1653,54230
+\def\bf{\bf1654,54257
+\def\w{\w1655,54285
+\def\less{\less1656,54310
+\def\gtr{\gtr1657,54341
+\def\hat{\hat1658,54370
+\def\char{\char1659,54399
+\def\tclose##1{\tclose1660,54430
+\def\code##1{\code1661,54474
+\def\samp##1{\samp1662,54514
+\def\r##1{\r1663,54554
+\def\b##1{\b1664,54588
+\def\key##1{\key1665,54622
+\def\file##1{\file1666,54660
+\def\kbd##1{\kbd1667,54700
+\def\i##1{\i1669,54808
+\def\cite##1{\cite1670,54842
+\def\var##1{\var1671,54882
+\def\emph##1{\emph1672,54920
+\def\dfn##1{\dfn1673,54960
+\def\thischaptername{\thischaptername1676,55001
+\outer\def\chapter{\chapter1677,55040
+\def\chapterzzz #1{\chapterzzz1678,55081
+{\chapternofonts%nofonts%1687,55477
+\global\let\section = \numberedsec=1692,55630
+\global\let\subsection = \numberedsubsec=1693,55665
+\global\let\subsubsection = \numberedsubsubsec=1694,55706
+\outer\def\appendix{\appendix1697,55757
+\def\appendixzzz #1{\appendixzzz1698,55800
+\global\advance \appendixno by 1 \message{no1700,55877
+\chapmacro {#1}{Appendix \appendixletter}letter1701,55946
+\xdef\thischapter{Appendix \appendixletter: \noexpand\thischaptername}letter:1704,56039
+{\chapternofonts%nofonts%1705,56111
+ {#1}{Appendix \appendixletter}letter1707,56167
+\appendixnoderef %noderef1710,56267
+\global\let\section = \appendixsec=1711,56286
+\global\let\subsection = \appendixsubsec=1712,56321
+\global\let\subsubsection = \appendixsubsubsec=1713,56362
+\outer\def\top{\top1716,56413
+\outer\def\unnumbered{\unnumbered1717,56453
+\def\unnumberedzzz #1{\unnumberedzzz1718,56500
+{\chapternofonts%nofonts%1722,56663
+\global\let\section = \unnumberedsec=1727,56813
+\global\let\subsection = \unnumberedsubsec=1728,56850
+\global\let\subsubsection = \unnumberedsubsubsec=1729,56893
+\outer\def\numberedsec{\numberedsec1732,56946
+\def\seczzz #1{\seczzz1733,56987
+{\chapternofonts%nofonts%1736,57143
+\outer\def\appendixsection{\appendixsection1745,57329
+\outer\def\appendixsec{\appendixsec1746,57386
+\def\appendixsectionzzz #1{\appendixsectionzzz1747,57439
+\gdef\thissection{#1}\secheading {#1}{\appendixletter}letter1749,57551
+{\chapternofonts%nofonts%1750,57619
+{#1}{\appendixletter}letter1752,57675
+\appendixnoderef %noderef1755,57775
+\outer\def\unnumberedsec{\unnumberedsec1759,57815
+\def\unnumberedseczzz #1{\unnumberedseczzz1760,57868
+{\chapternofonts%nofonts%1762,57963
+\outer\def\numberedsubsec{\numberedsubsec1770,58131
+\def\numberedsubseczzz #1{\numberedsubseczzz1771,58186
+{\chapternofonts%nofonts%1774,58365
+\outer\def\appendixsubsec{\appendixsubsec1783,58569
+\def\appendixsubseczzz #1{\appendixsubseczzz1784,58624
+\subsecheading {#1}{\appendixletter}letter1786,58746
+{\chapternofonts%nofonts%1787,58811
+{#1}{\appendixletter}letter1789,58870
+\appendixnoderef %noderef1792,58985
+\outer\def\unnumberedsubsec{\unnumberedsubsec1796,59025
+\def\unnumberedsubseczzz #1{\unnumberedsubseczzz1797,59084
+{\chapternofonts%nofonts%1799,59185
+\outer\def\numberedsubsubsec{\numberedsubsubsec1807,59356
+\def\numberedsubsubseczzz #1{\numberedsubsubseczzz1808,59417
+{\chapternofonts%nofonts%1812,59614
+\outer\def\appendixsubsubsec{\appendixsubsubsec1823,59847
+\def\appendixsubsubseczzz #1{\appendixsubsubseczzz1824,59908
+ {\appendixletter}letter1827,60047
+{\chapternofonts%nofonts%1828,60113
+ {\appendixletter}letter1830,60178
+\appendixnoderef %noderef1834,60312
+\outer\def\unnumberedsubsubsec{\unnumberedsubsubsec1838,60352
+\def\unnumberedsubsubseczzz #1{\unnumberedsubsubseczzz1839,60417
+{\chapternofonts%nofonts%1841,60524
+\def\infotop{\infotop1851,60853
+\def\infounnumbered{\infounnumbered1852,60891
+\def\infounnumberedsec{\infounnumberedsec1853,60936
+\def\infounnumberedsubsec{\infounnumberedsubsec1854,60987
+\def\infounnumberedsubsubsec{\infounnumberedsubsubsec1855,61044
+\def\infoappendix{\infoappendix1857,61108
+\def\infoappendixsec{\infoappendixsec1858,61149
+\def\infoappendixsubsec{\infoappendixsubsec1859,61196
+\def\infoappendixsubsubsec{\infoappendixsubsubsec1860,61249
+\def\infochapter{\infochapter1862,61309
+\def\infosection{\infosection1863,61348
+\def\infosubsection{\infosubsection1864,61387
+\def\infosubsubsection{\infosubsubsection1865,61432
+\global\let\section = \numberedsec=1870,61669
+\global\let\subsection = \numberedsubsec=1871,61704
+\global\let\subsubsection = \numberedsubsubsec=1872,61745
+\def\majorheading{\majorheading1886,62252
+\def\majorheadingzzz #1{\majorheadingzzz1887,62297
+\def\chapheading{\chapheading1893,62530
+\def\chapheadingzzz #1{\chapheadingzzz1894,62573
+\def\heading{\heading1899,62768
+\def\subheading{\subheading1901,62805
+\def\subsubheading{\subsubheading1903,62848
+\def\dobreak#1#2{\dobreak1910,63125
+\def\setchapterstyle #1 {\setchapterstyle1912,63203
+\def\chapbreak{\chapbreak1919,63458
+\def\chappager{\chappager1920,63508
+\def\chapoddpage{\chapoddpage1921,63546
+\def\setchapternewpage #1 {\setchapternewpage1923,63625
+\def\CHAPPAGoff{\CHAPPAGoff1925,63682
+\def\CHAPPAGon{\CHAPPAGon1929,63776
+\global\def\HEADINGSon{\HEADINGSon1932,63867
+\def\CHAPPAGodd{\CHAPPAGodd1934,63909
+\global\def\HEADINGSon{\HEADINGSon1937,64005
+\def\CHAPFplain{\CHAPFplain1941,64059
+\def\chfplain #1#2{\chfplain1945,64151
+\def\unnchfplain #1{\unnchfplain1956,64374
+\def\unnchfopen #1{\unnchfopen1964,64603
+\def\chfopen #1#2{\chfopen1970,64811
+\def\CHAPFopen{\CHAPFopen1975,64955
+\def\subsecheadingbreak{\subsecheadingbreak1982,65173
+\def\secheadingbreak{\secheadingbreak1985,65302
+\def\secheading #1#2#3{\secheading1993,65584
+\def\plainsecheading #1{\plainsecheading1994,65640
+\def\secheadingi #1{\secheadingi1995,65683
+\def\subsecheading #1#2#3#4{\subsecheading2006,66051
+\def\subsecheadingi #1{\subsecheadingi2007,66118
+\def\subsubsecfonts{\subsubsecfonts2014,66415
+\def\subsubsecheading #1#2#3#4#5{\subsubsecheading2017,66538
+\def\subsubsecheadingi #1{\subsubsecheadingi2018,66616
+\def\startcontents#1{\startcontents2032,67088
+ \unnumbchapmacro{#1}\def\thischapter{\thischapter2040,67361
+\outer\def\contents{\contents2049,67720
+\outer\def\summarycontents{\summarycontents2057,67864
+ \def\secentry ##1##2##3##4{\secentry2067,68235
+ \def\unnumbsecentry ##1##2{\unnumbsecentry2068,68270
+ \def\subsecentry ##1##2##3##4##5{\subsecentry2069,68305
+ \def\unnumbsubsecentry ##1##2{\unnumbsubsecentry2070,68346
+ \def\subsubsecentry ##1##2##3##4##5##6{\subsubsecentry2071,68384
+ \def\unnumbsubsubsecentry ##1##2{\unnumbsubsubsecentry2072,68431
+\def\chapentry#1#2#3{\chapentry2085,68865
+\def\shortchapentry#1#2#3{\shortchapentry2088,68982
+ {#2\labelspace #1}space2091,69092
+\def\unnumbchapentry#1#2{\unnumbchapentry2094,69146
+\def\shortunnumberedentry#1#2{\shortunnumberedentry2095,69193
+\def\secentry#1#2#3#4{\secentry2102,69357
+\def\unnumbsecentry#1#2{\unnumbsecentry2103,69416
+\def\subsecentry#1#2#3#4#5{\subsecentry2106,69477
+\def\unnumbsubsecentry#1#2{\unnumbsubsecentry2107,69547
+\def\subsubsecentry#1#2#3#4#5#6{\subsubsecentry2110,69621
+ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}space2111,69655
+\def\unnumbsubsubsecentry#1#2{\unnumbsubsubsecentry2112,69706
+\def\dochapentry#1#2{\dochapentry2123,70080
+\def\dosecentry#1#2{\dosecentry2138,70685
+\def\dosubsecentry#1#2{\dosubsecentry2145,70863
+\def\dosubsubsecentry#1#2{\dosubsubsecentry2152,71048
+\def\labelspace{\labelspace2160,71299
+\def\dopageno#1{\dopageno2162,71334
+\def\doshortpageno#1{\doshortpageno2163,71360
+\def\chapentryfonts{\chapentryfonts2165,71392
+\def\secentryfonts{\secentryfonts2166,71427
+\def\point{\point2192,72386
+\def\result{\result2194,72407
+\def\expansion{\expansion2195,72480
+\def\print{\print2196,72551
+\def\equiv{\equiv2198,72618
+\def\error{\error2218,73391
+\def\tex{\tex2224,73620
+\def\@{\@2242,74003
+\gdef\sepspaces{\def {\ }}}\2265,74735
+\def\aboveenvbreak{\aboveenvbreak2268,74817
+\def\afterenvbreak{\afterenvbreak2272,74983
+\def\ctl{\ctl2286,75494
+\def\ctr{\ctr2287,75566
+\def\cbl{\cbl2288,75605
+\def\cbr{\cbr2289,75645
+\def\carttop{\carttop2290,75684
+\def\cartbot{\cartbot2293,75792
+\long\def\cartouche{\cartouche2299,75932
+\def\Ecartouche{\Ecartouche2326,76720
+\def\lisp{\lisp2338,76855
+\def\Elisp{\Elisp2348,77202
+\def\next##1{\next2360,77528
+\def\Eexample{\Eexample2364,77570
+\def\Esmallexample{\Esmallexample2367,77617
+\def\smalllispx{\smalllispx2373,77795
+\def\Esmalllisp{\Esmalllisp2383,78149
+\obeyspaces \obeylines \ninett \indexfonts \rawbackslashfonts2396,78505
+\def\next##1{\next2397,78562
+\def\display{\display2401,78642
+\def\Edisplay{\Edisplay2410,78961
+\def\next##1{\next2422,79272
+\def\format{\format2426,79375
+\def\Eformat{\Eformat2434,79671
+\def\next##1{\next2437,79760
+\def\flushleft{\flushleft2441,79812
+\def\Eflushleft{\Eflushleft2451,80183
+\def\next##1{\next2454,80276
+\def\flushright{\flushright2456,80298
+\def\Eflushright{\Eflushright2466,80670
+\def\next##1{\next2470,80801
+\def\quotation{\quotation2474,80859
+\def\Equotation{\Equotation2480,81051
+\def\setdeffont #1 {\setdeffont2493,81449
+\newskip\defbodyindent \defbodyindent=.4inbodyindent2495,81495
+\newskip\defargsindent \defargsindent=50ptargsindent2496,81538
+\newskip\deftypemargin \deftypemargin=12pttypemargin2497,81581
+\newskip\deflastargmargin \deflastargmargin=18ptlastargmargin2498,81624
+\def\activeparens{\activeparens2503,81822
+\def\opnr{\opnr2529,83034
+\def\lbrb{\lbrb2530,83099
+\def\defname #1#2{\defname2536,83300
+\advance\dimen2 by -\defbodyindentbodyindent2540,83418
+\advance\dimen3 by -\defbodyindentbodyindent2542,83472
+\setbox0=\hbox{\hskip \deflastargmargin{lastargmargin2544,83526
+\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuationsargsindent2546,83668
+\parshape 2 0in \dimen0 \defargsindent \dimen1 %argsindent2547,83743
+\rlap{\rightline{{\rm #2}\hskip \deftypemargin}typemargin2554,84112
+\advance\leftskip by -\defbodyindentbodyindent2557,84246
+\exdentamount=\defbodyindentbodyindent2558,84283
+\def\defparsebody #1#2#3{\defparsebody2568,84642
+\def#1{2572,84826
+\def#2{2573,84862
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2575,84934
+\exdentamount=\defbodyindentbodyindent2576,85008
+\def\defmethparsebody #1#2#3#4 {\defmethparsebody2581,85112
+\def#1{2585,85273
+\def#2##1 {2586,85309
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2588,85392
+\exdentamount=\defbodyindentbodyindent2589,85466
+\def\defopparsebody #1#2#3#4#5 {\defopparsebody2592,85551
+\def#1{2596,85712
+\def#2##1 ##2 {2597,85748
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2600,85848
+\exdentamount=\defbodyindentbodyindent2601,85922
+\def\defvarparsebody #1#2#3{\defvarparsebody2608,86193
+\def#1{2612,86380
+\def#2{2613,86416
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2615,86475
+\exdentamount=\defbodyindentbodyindent2616,86549
+\def\defvrparsebody #1#2#3#4 {\defvrparsebody2621,86640
+\def#1{2625,86799
+\def#2##1 {2626,86835
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2628,86905
+\exdentamount=\defbodyindentbodyindent2629,86979
+\def\defopvarparsebody #1#2#3#4#5 {\defopvarparsebody2632,87051
+\def#1{2636,87215
+\def#2##1 ##2 {2637,87251
+\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindentbodyindent2640,87338
+\exdentamount=\defbodyindentbodyindent2641,87412
+\def\defunargs #1{\defunargs2664,88172
+\def\deftypefunargs #1{\deftypefunargs2676,88554
+\def\deffn{\deffn2690,88936
+\def\deffnheader #1#2#3{\deffnheader2692,88993
+\begingroup\defname {name2693,89041
+\def\defun{\defun2699,89186
+\def\defunheader #1#2{\defunheader2701,89239
+\begingroup\defname {name2702,89314
+\defunargs {unargs2703,89350
+\def\deftypefun{\deftypefun2709,89498
+\def\deftypefunheader #1#2{\deftypefunheader2712,89620
+\def\deftypefunheaderx #1#2 #3\relax{\deftypefunheaderx2714,89729
+\begingroup\defname {name2716,89821
+\deftypefunargs {typefunargs2717,89867
+\def\deftypefn{\deftypefn2723,90038
+\def\deftypefnheader #1#2#3{\deftypefnheader2726,90187
+\def\deftypefnheaderx #1#2#3 #4\relax{\deftypefnheaderx2728,90323
+\begingroup\defname {name2730,90416
+\deftypefunargs {typefunargs2731,90456
+\def\defmac{\defmac2737,90577
+\def\defmacheader #1#2{\defmacheader2739,90634
+\begingroup\defname {name2740,90710
+\defunargs {unargs2741,90743
+\def\defspec{\defspec2747,90867
+\def\defspecheader #1#2{\defspecheader2749,90928
+\begingroup\defname {name2750,91005
+\defunargs {unargs2751,91045
+\def\deffnx #1 {\deffnx2758,91240
+\def\defunx #1 {\defunx2759,91297
+\def\defmacx #1 {\defmacx2760,91354
+\def\defspecx #1 {\defspecx2761,91413
+\def\deftypefnx #1 {\deftypefnx2762,91474
+\def\deftypeunx #1 {\deftypeunx2763,91539
+\def\defop #1 {\defop2769,91685
+\defopparsebody\Edefop\defopx\defopheader\defoptype}opparsebody\Edefop\defopx\defopheader\defoptype2770,91720
+\def\defopheader #1#2#3{\defopheader2772,91774
+\begingroup\defname {name2774,91863
+\defunargs {unargs2775,91909
+\def\defmethod{\defmethod2780,91970
+\def\defmethodheader #1#2#3{\defmethodheader2782,92043
+\begingroup\defname {name2784,92131
+\defunargs {unargs2785,92171
+\def\defcv #1 {\defcv2790,92245
+\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype}opvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype2791,92280
+\def\defcvarheader #1#2#3{\defcvarheader2793,92339
+\begingroup\defname {name2795,92425
+\defvarargs {varargs2796,92471
+\def\defivar{\defivar2801,92544
+\def\defivarheader #1#2#3{\defivarheader2803,92607
+\begingroup\defname {name2805,92693
+\defvarargs {varargs2806,92744
+\def\defopx #1 {\defopx2812,92893
+\def\defmethodx #1 {\defmethodx2813,92950
+\def\defcvx #1 {\defcvx2814,93015
+\def\defivarx #1 {\defivarx2815,93072
+\def\defvarargs #1{\defvarargs2822,93343
+\def\defvr{\defvr2828,93487
+\def\defvrheader #1#2#3{\defvrheader2830,93542
+\begingroup\defname {name2831,93590
+\def\defvar{\defvar2835,93675
+\def\defvarheader #1#2{\defvarheader2837,93735
+\begingroup\defname {name2838,93806
+\defvarargs {varargs2839,93842
+\def\defopt{\defopt2844,93908
+\def\defoptheader #1#2{\defoptheader2846,93968
+\begingroup\defname {name2847,94039
+\defvarargs {varargs2848,94078
+\def\deftypevar{\deftypevar2853,94135
+\def\deftypevarheader #1#2{\deftypevarheader2856,94251
+\begingroup\defname {name2858,94334
+\def\deftypevr{\deftypevr2865,94508
+\def\deftypevrheader #1#2#3{\deftypevrheader2867,94579
+\begingroup\defname {name2868,94631
+\def\defvrx #1 {\defvrx2876,94868
+\def\defvarx #1 {\defvarx2877,94925
+\def\defoptx #1 {\defoptx2878,94984
+\def\deftypevarx #1 {\deftypevarx2879,95043
+\def\deftypevrx #1 {\deftypevrx2880,95110
+\def\deftpargs #1{\deftpargs2885,95259
+\def\deftp{\deftp2889,95339
+\def\deftpheader #1#2#3{\deftpheader2891,95394
+\begingroup\defname {name2892,95442
+\def\deftpx #1 {\deftpx2897,95601
+\def\setref#1{\setref2908,95922
+\def\unnumbsetref#1{\unnumbsetref2913,96036
+\def\appendixsetref#1{\appendixsetref2918,96143
+\def\pxref#1{\pxref2929,96554
+\def\xref#1{\xref2930,96590
+\def\ref#1{\ref2931,96625
+\def\xrefX[#1,#2,#3,#4,#5,#6]{\xrefX[2932,96655
+\def\printedmanual{\printedmanual2933,96698
+\def\printednodename{\printednodename2934,96736
+\def\printednodename{\printednodename2939,96861
+section ``\printednodename'' in \cite{\printedmanual}\printedmanual2954,97493
+\refx{x2957,97571
+\def\dosetq #1#2{\dosetq2965,97791
+\def\internalsetq #1#2{\internalsetq2973,98049
+\def\Ypagenumber{\Ypagenumber2977,98150
+\def\Ytitle{\Ytitle2979,98176
+\def\Ynothing{\Ynothing2981,98203
+\def\Ysectionnumberandtype{\Ysectionnumberandtype2983,98220
+\def\Yappendixletterandtype{\Yappendixletterandtype2992,98536
+\ifnum\secno=0 Appendix\xreftie'char\the\appendixno{no2993,98566
+\else \ifnum \subsecno=0 Section\xreftie'char\the\appendixno.\the\secno %no.\the\secno2994,98621
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno %no.\the\secno.\the\subsecno2996,98725
+Section\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno %no.\the\secno.\the\subsecno.\the\subsubsecno2998,98796
+ \def\linenumber{\linenumber3009,99135
+\def\refx#1#2{\refx3015,99319
+\def\xrdef #1#2{\xrdef3037,99945
+\def\readauxfile{\readauxfile3040,100030
+\def\supereject{\supereject3110,101811
+\footstrut\parindent=\defaultparindent\hang\textindent{aultparindent\hang\textindent3131,102496
+\def\openindices{\openindices3139,102682
+\newdimen\defaultparindent \defaultparindent = 15ptaultparindent3151,102907
+\parindent = \defaultparindentaultparindent3152,102959
+\def\smallbook{\smallbook3175,103683
+\global\def\Esmallexample{\Esmallexample3192,104110
+\def\afourpaper{\afourpaper3196,104201
+\def\finalout{\finalout3224,105009
+\def\normaldoublequote{\normaldoublequote3235,105270
+\def\normaltilde{\normaltilde3236,105296
+\def\normalcaret{\normalcaret3237,105316
+\def\normalunderscore{\normalunderscore3238,105336
+\def\normalverticalbar{\normalverticalbar3239,105361
+\def\normalless{\normalless3240,105387
+\def\normalgreater{\normalgreater3241,105406
+\def\normalplus{\normalplus3242,105428
+\def\ifusingtt#1#2{\ifusingtt3253,105920
+\def\activedoublequote{\activedoublequote3261,106248
+\def~{~3264,106334
+\def^{^3267,106395
+\def_{_3270,106434
+\def\_{\_3272,106508
+\def\lvvmode{\lvvmode3279,106845
+\def|{|3282,106895
+\def<{<3285,106958
+\def>{>3288,107015
+\def+{+3290,107053
+\def\turnoffactive{\turnoffactive3296,107214
+\global\def={=3307,107500
+\def\normalbackslash{\normalbackslash3321,107882
+
+merc-src/accumulator.m,4915
+:- interface146,5371
+:- import_module hlds148,5386
+:- import_module univ152,5478
+:- pred accu_transform_proc159,5793
+:- implementation166,6115
+:- import_module libs180,6552
+:- import_module mdbcomp184,6681
+:- import_module parse_tree186,6742
+:- import_module assoc_list194,7013
+:- import_module bool195,7042
+:- import_module int196,7065
+:- import_module io197,7087
+:- import_module list198,7108
+:- import_module map199,7131
+:- import_module maybe200,7153
+:- import_module pair201,7177
+:- import_module require202,7200
+:- import_module set203,7226
+:- import_module solutions204,7248
+:- import_module string205,7276
+:- import_module term206,7301
+:- import_module varset207,7324
+:- type top_level213,7499
+:- type accu_goal_id225,7900
+:- type accu_case228,7964
+:- type accu_goal_store234,8091
+:- type accu_subst238,8216
+:- type accu_warning240,8264
+accu_transform_proc247,8578
+:- pred generate_warnings334,12550
+generate_warnings337,12669
+:- pred generate_warning342,12895
+generate_warning345,13001
+:- pred should_attempt_accu_transform365,13886
+should_attempt_accu_transform370,14123
+:- pred should_attempt_accu_transform_2398,15406
+should_attempt_accu_transform_2405,15763
+:- pred accu_standardize440,17390
+accu_standardize442,17455
+:- pred identify_goal_type465,18169
+identify_goal_type469,18359
+:- pred is_recursive_case549,21175
+is_recursive_case551,21253
+:- type store_info560,21713
+:- func initialize_goal_store570,22060
+initialize_goal_store573,22166
+:- pred accu_store580,22421
+accu_store584,22576
+:- pred identify_recursive_calls601,23288
+identify_recursive_calls604,23406
+:- pred identify_out_and_out_prime626,24396
+identify_out_and_out_prime631,24631
+:- type accu_sets676,26425
+:- pred accu_stage1689,26977
+accu_stage1693,27155
+:- pred accu_stage1_2727,28347
+accu_stage1_2731,28515
+:- pred accu_sets_init781,30557
+accu_sets_init783,30605
+:- func set_upto796,30984
+set_upto798,31039
+:- pred accu_before812,31498
+accu_before815,31639
+:- pred accu_assoc835,32477
+accu_assoc838,32617
+:- pred accu_construct862,33712
+accu_construct865,33856
+:- pred accu_construct_assoc896,35307
+accu_construct_assoc899,35457
+:- pred accu_update938,37069
+accu_update941,37210
+:- pred member_lessthan_goalid964,38219
+member_lessthan_goalid967,38342
+:- type accu_assoc975,38652
+:- pred accu_is_associative986,39138
+accu_is_associative989,39250
+:- pred associativity_assertion1014,40263
+associativity_assertion1017,40404
+:- pred commutativity_assertion1037,41242
+commutativity_assertion1040,41369
+:- pred accu_is_update1057,41952
+accu_is_update1060,42066
+:- pred is_associative_construction1078,42802
+is_associative_construction1081,42898
+:- type accu_substs1095,43480
+:- type accu_base1103,43744
+:- pred accu_stage21124,44605
+accu_stage21131,44946
+:- pred accu_substs_init1179,46957
+accu_substs_init1182,47097
+:- pred acc_var_subst_init1194,47573
+acc_var_subst_init1198,47718
+:- pred create_new_var1207,48147
+create_new_var1210,48288
+:- pred accu_process_assoc_set1223,48862
+accu_process_assoc_set1229,49150
+:- pred accu_has_heuristic1297,52081
+accu_has_heuristic1299,52161
+:- pred accu_heuristic1304,52336
+accu_heuristic1307,52457
+:- pred accu_process_update_set1318,52906
+accu_process_update_set1325,53221
+:- pred accu_divide_base_case1380,55844
+accu_divide_base_case1385,56059
+:- pred accu_related1412,57146
+accu_related1415,57270
+:- inst stored_goal_plain_call1444,58415
+:- pred lookup_call1449,58601
+lookup_call1452,58715
+:- pred accu_stage31470,59432
+accu_stage31477,59826
+:- pred acc_proc_info1508,61326
+acc_proc_info1512,61485
+:- pred acc_pred_info1556,63449
+acc_pred_info1559,63597
+:- pred accu_create_goal1600,65285
+accu_create_goal1607,65628
+:- func create_acc_call1621,66400
+create_acc_call1625,66569
+:- pred create_orig_goal1634,66987
+create_orig_goal1638,67176
+:- pred create_acc_goal1662,68157
+create_acc_goal1667,68380
+:- func create_new_orig_recursive_goals1709,70225
+create_new_orig_recursive_goals1712,70368
+:- func create_new_recursive_goals1723,70918
+create_new_recursive_goals1727,71108
+:- func create_new_base_goals1738,71717
+create_new_base_goals1741,71831
+:- pred acc_unification1749,72156
+acc_unification1751,72225
+:- pred accu_top_level1766,72896
+accu_top_level1770,73058
+:- pred update_accumulator_pred1856,76290
+update_accumulator_pred1859,76411
+:- func accu_rename1876,77253
+accu_rename1879,77363
+:- func base_case_ids1889,77784
+base_case_ids1891,77846
+:- func base_case_ids_set1898,78048
+base_case_ids_set1900,78113
+:- func accu_goal_list1905,78269
+accu_goal_list1907,78349
+:- pred calculate_goal_info1916,78680
+calculate_goal_info1918,78753
+:- func chain_subst1932,79319
+chain_subst1934,79378
+:- pred chain_subst_21938,79482
+chain_subst_21941,79576
+:- some [T] pred unravel_univ1956,80060
+:- pragma foreign_export1957,80116
+unravel_univ1961,80340
c-src/c.c,76
T f(1,0
@@ -5160,13 +5315,13 @@ extern struct node *yylval;yylval306,6246
unsigned char parse_cell_or_range 309,6291
unsigned char parse_cell_or_range 311,6355
yylex FUN0(315,6405
-parse_cell_or_range FUN2(587,11771
-#define CK_ABS_R(671,13213
-#define CK_REL_R(675,13292
-#define CK_ABS_C(680,13421
-#define CK_REL_C(684,13500
-#define MAYBEREL(689,13629
-str_to_col FUN1(847,16830
+parse_cell_or_range FUN2(587,11772
+#define CK_ABS_R(671,13214
+#define CK_REL_R(675,13293
+#define CK_ABS_C(680,13422
+#define CK_REL_C(684,13501
+#define MAYBEREL(689,13630
+str_to_col FUN1(847,16831
y-src/parse.c,520
#define YYBISON 4,64
diff --git a/test/manual/etags/Makefile b/test/manual/etags/Makefile
index c1df703905e..b3a82fdba8d 100644
--- a/test/manual/etags/Makefile
+++ b/test/manual/etags/Makefile
@@ -16,6 +16,7 @@ HTMLSRC=$(addprefix ./html-src/,softwarelibero.html index.shtml algrthms.html so
#JAVASRC=$(addprefix ./java-src/, )
LUASRC=$(addprefix ./lua-src/,allegro.lua test.lua)
MAKESRC=$(addprefix ./make-src/,Makefile)
+MERCSRC=$(addprefix ./merc-src/,accumulator.m)
OBJCSRC=$(addprefix ./objc-src/,Subprocess.h Subprocess.m PackInsp.h PackInsp.m)
OBJCPPSRC=$(addprefix ./objcpp-src/,SimpleCalc.H SimpleCalc.M)
PASSRC=$(addprefix ./pas-src/,common.pas)
@@ -25,13 +26,14 @@ 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)
+RSSRC=$(addprefix ./rs-src/,test.rs)
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} ${SCMSRC} ${TEXSRC} ${YSRC}
+ ${PROLSRC} ${PYTSRC} ${RBSRC} ${RSSRC} ${SCMSRC} ${TEXSRC} ${YSRC} ${MERCSRC}
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/README b/test/manual/etags/README
new file mode 100644
index 00000000000..7bce861030b
--- /dev/null
+++ b/test/manual/etags/README
@@ -0,0 +1,60 @@
+This directory contains the test suite for the 'etags' and 'ctags'
+programs.
+
+The input files, which include source files in various languages
+supported by the programs, are in the *-src/ directories (e.g., c-src
+for C sources, ada-src for Ada, tex-src for TeX, etc.).
+
+The expected results are slightly different for each of the 7 commands
+(see below) run by the test suite, and are on files ETAGS.good_N
+(where N is between 1 and 6) and CTAGS.good.
+
+To run the tests, say
+
+ make check
+
+in this directory. This should run the programs 7 times with various
+command line switches, and should not show any differences between the
+produced file ETAGS/CTAGS and the corresponding expected results. Any
+diffs shown by the 'diff' utility should be examined for potential
+regressions in 'etags' or 'ctags'.
+
+In some cases, diffs should be expected. These include:
+
+ . adding new input files in the *-src/ directories
+ . routine changes in the existing input files, such as the yearly
+ update of copyright years, spelling changes, etc.
+ . adding new features to etags.c
+
+When the diffs are expected, they should be examined to make sure
+there are no regressions. To do so, compare the line numbers and byte
+offsets shown in the new ETAGS/CTAGS files against the up-to-date
+input files, and make sure the new values match, whereas the old one
+don't. Also make sure there no new or missing entries in the
+ETAGS/CTAGS files as compared with the expected results. (When new
+input files are added, there obviously will be new entries -- these
+should be compared to the input files to verify correctness.)
+
+Once the differences are deemed to be justified, i.e. you decide that
+the new ETAGS/CTAGS file should become the new expected result, you
+should copy the ETAGS/CTAGS files produced by the test run to the
+corresponding "good" files, one by one. Like this:
+
+ $ make check
+ $ cp ETAGS ETAGS.good_1
+ $ make check
+ $ cp ETAGS ETAGS.good_2
+ $ make check
+ $ cp ETAGS ETAGS.good_3
+ ...
+ $ make check
+ $ cp ETAGS ETAGS.good_6
+ $ make check
+ $ cp CTAGS CTAGS.good
+
+This uses the fact that "make check" will stop after the first
+failure, i.e. after the first time 'diff' reports any diffs, and then
+the ETAGS/CTAGS file from the last invocation is available for
+becoming the new expected-result file. Alternatively, you can see the
+name of the expected-result file which needs to be updated in the
+output of the 'diff' utility.
diff --git a/test/manual/etags/el-src/TAGTEST.EL b/test/manual/etags/el-src/TAGTEST.EL
index 89a67913771..3e6599a4a45 100644
--- a/test/manual/etags/el-src/TAGTEST.EL
+++ b/test/manual/etags/el-src/TAGTEST.EL
@@ -1,3 +1,5 @@
+;;; -*- lexical-binding: t -*-
+
(foo::defmumble bletch beuarghh)
(defun foo==bar () (message "hi")) ; Bug#5624
;;; Ctags test file for lisp mode.
diff --git a/test/manual/etags/merc-src/accumulator.m b/test/manual/etags/merc-src/accumulator.m
new file mode 100644
index 00000000000..c82dbf58ff8
--- /dev/null
+++ b/test/manual/etags/merc-src/accumulator.m
@@ -0,0 +1,1962 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 1999-2000,2002-2007, 2009-2012 The University of Melbourne.
+% Copyright (C) 2015 The Mercury team.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% Module: accumulator.m.
+% Main authors: petdr.
+%
+% Attempts to transform a single proc to a tail recursive form by
+% introducing accumulators. The algorithm can do this if the code after
+% the recursive call has either the order independent state update or
+% associative property.
+%
+% /* Order independent State update property */
+% :- promise all [A,B,S0,S]
+% (
+% (some[SA] (update(A, S0, SA), update(B, SA, S)))
+% <=>
+% (some[SB] (update(B, S0, SB), update(A, SB, S)))
+% ).
+%
+% /* Associativity property */
+% :- promise all [A,B,C,ABC]
+% (
+% (some[AB] (assoc(A, B, AB), assoc(AB, C, ABC)))
+% <=>
+% (some[BC] (assoc(B, C, BC), assoc(A, BC, ABC)))
+% ).
+%
+% XXX What about exceptions and non-termination?
+%
+% The promise declarations above only provide promises about the declarative
+% semantics, but in order to apply this optimization, we ought to check that
+% it will preserve the operational semantics (modulo whatever changes are
+% allowed by the language semantics options).
+%
+% Currently we check and respect the --fully-strict option, but not the
+% --no-reorder-conj option. XXX we should check --no-reorder-conj!
+% If --no-reorder-conj was set, it would still be OK to apply this
+% transformation, but ONLY in cases where the goals which get reordered
+% are guaranteed not to throw any exceptions.
+%
+% The algorithm implemented is a combination of the algorithms from
+% "Making Mercury Programs Tail Recursive" and
+% "State Update Transformation", which can be found at
+% <http://www.cs.mu.oz.au/research/mercury/information/papers.html>.
+%
+% Note that currently "State Update Transformation" paper only resides
+% in CVS papers archive in the directory update, but has been submitted
+% to PPDP '00.
+%
+% The transformation recognises predicates in the form
+%
+% p(In, OutUpdate, OutAssoc) :-
+% minimal(In),
+% initialize(OutUpdate),
+% base(OutAssoc).
+% p(In, OutUpdate, OutAssoc) :-
+% decompose(In, Current, Rest),
+% p(Rest, OutUpdate0, OutAssoc0),
+% update(Current, OutUpdate0, OutUpdate),
+% assoc(Current, OutAssoc0, OutAssoc).
+%
+% which can be transformed by the algorithm in "State Update Transformation" to
+%
+% p(In, OutUpdate, OutAssoc) :-
+% initialize(AccUpdate),
+% p_acc(In, OutUpdate, OutAssoc, AccUpdate).
+%
+% p_acc(In, OutUpdate, OutAssoc, AccUpdate) :-
+% minimal(In),
+% base(OutAssoc),
+% OutUpdate = AccUpdate.
+% p_acc(In, OutUpdate, OutAssoc, AccUpdate0) :-
+% decompose(In, Current, Rest),
+% update(Current, AccUpdate0, AccUpdate),
+% p_acc(Rest, OutUpdate, OutAssoc0, AccUpdate),
+% assoc(Current, OutAssoc0, OutAssoc).
+%
+% we then apply the algorithm from "Making Mercury Programs Tail Recursive"
+% to p_acc to obtain
+%
+% p_acc(In, OutUpdate, OutAssoc, AccUpdate) :-
+% minimal(In),
+% base(OutAssoc),
+% OutUpdate = AccUpdate.
+% p_acc(In, OutUpdate, OutAssoc, AccUpdate0) :-
+% decompose(In, Current, Rest),
+% update(Current, AccUpdate0, AccUpdate),
+% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, Current).
+%
+% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :-
+% minimal(In),
+% base(Base),
+% assoc(AccAssoc0, Base, OutAssoc),
+% OutUpdate = AccUpdate0.
+% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :-
+% decompose(In, Current, Rest),
+% update(Current, AccUpdate0, AccUpdate),
+% assoc(AccAssoc0, Current, AccAssoc),
+% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, AccAssoc).
+%
+% p_acc is no longer recursive and is only ever called from p, so we
+% inline p_acc into p to obtain the final schema.
+%
+% p(In, OutUpdate, OutAssoc) :-
+% minimal(In),
+% base(OutAssoc),
+% initialize(AccUpdate),
+% OutUpdate = AccUpdate.
+% p(In, OutUpdate, OutAssoc) :-
+% decompose(In, Current, Rest),
+% initialize(AccUpdate0),
+% update(Current, AccUpdate0, AccUpdate),
+% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, Current).
+%
+% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :-
+% minimal(In),
+% base(Base),
+% assoc(AccAssoc0, Base, OutAssoc),
+% OutUpdate = AccUpdate0.
+% p_acc2(In, OutUpdate, OutAssoc, AccUpdate0, AccAssoc0) :-
+% decompose(In, Current, Rest),
+% update(Current, AccUpdate0, AccUpdate),
+% assoc(AccAssoc0, Current, AccAssoc),
+% p_acc2(Rest, OutUpdate, OutAssoc, AccUpdate, AccAssoc).
+%
+% The only real difficulty in this new transformation is identifying the
+% initialize/1 and base/1 goals from the original base case.
+%
+% Note that if the recursive clause contains multiple calls to p, the
+% transformation attempts to move each recursive call to the end
+% until one succeeds. This makes the order of independent recursive
+% calls in the body irrelevant.
+%
+% XXX Replace calls to can_reorder_goals with calls to the version that
+% use the intermodule-analysis framework.
+%
+%---------------------------------------------------------------------------%
+
+:- module transform_hlds.accumulator.
+:- interface.
+
+:- import_module hlds.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+
+:- import_module univ.
+
+ % Attempt to transform a procedure into accumulator recursive form.
+ % If we succeed, we will add the recursive version of the procedure
+ % to the module_info. However, we may also encounter errors, which
+ % we will add to the list of error_specs in the univ accumulator.
+ %
+:- pred accu_transform_proc(pred_proc_id::in, pred_info::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ univ::in, univ::out) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module hlds.assertion.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_error_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_out.
+:- import_module hlds.hlds_out.hlds_out_util.
+:- import_module hlds.hlds_promise.
+:- import_module hlds.instmap.
+:- import_module hlds.pred_table.
+:- import_module hlds.quantification.
+:- import_module hlds.status.
+:- import_module hlds.vartypes.
+:- import_module libs.
+:- import_module libs.globals.
+:- import_module libs.optimization_options.
+:- import_module libs.options.
+:- import_module mdbcomp.
+:- import_module mdbcomp.sym_name.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_mode.
+:- import_module parse_tree.prog_util.
+:- import_module parse_tree.set_of_var.
+:- import_module transform_hlds.goal_store.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module require.
+:- import_module set.
+:- import_module solutions.
+:- import_module string.
+:- import_module term.
+:- import_module varset.
+
+%---------------------------------------------------------------------------%
+
+ % The form of the goal around the base and recursive cases.
+ %
+:- type top_level
+ ---> switch_base_rec
+ ; switch_rec_base
+ ; disj_base_rec
+ ; disj_rec_base
+ ; ite_base_rec
+ ; ite_rec_base.
+
+ % An accu_goal_id represents a goal. The first field says which conjunction
+ % the goal came from (the base case or the recursive case), and the second
+ % gives the location of the goal in that conjunction.
+ %
+:- type accu_goal_id
+ ---> accu_goal_id(accu_case, int).
+
+:- type accu_case
+ ---> accu_base
+ ; accu_rec.
+
+ % The goal_store associates a goal with each goal_id.
+ %
+:- type accu_goal_store == goal_store(accu_goal_id).
+
+ % A substitution from the first variable name to the second.
+ %
+:- type accu_subst == map(prog_var, prog_var).
+
+:- type accu_warning
+ ---> accu_warn(prog_context, pred_id, prog_var, prog_var).
+ % Warn that two prog_vars in a call to pred_id at the given context
+ % were swapped, which may cause an efficiency problem.
+
+%---------------------------------------------------------------------------%
+
+accu_transform_proc(proc(PredId, ProcId), PredInfo, !ProcInfo, !ModuleInfo,
+ !Cookie) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.get_opt_tuple(Globals, OptTuple),
+ DoLCMC = OptTuple ^ ot_opt_lcmc_accumulator,
+ globals.lookup_bool_option(Globals, fully_strict, FullyStrict),
+ ( if
+ should_attempt_accu_transform(!ModuleInfo, PredId, ProcId, PredInfo,
+ !ProcInfo, FullyStrict, DoLCMC, Warnings)
+ then
+ globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
+ (
+ VeryVerbose = yes,
+ trace [io(!IO)] (
+ module_info_get_name(!.ModuleInfo, ModuleName),
+ get_progress_output_stream(Globals, ModuleName,
+ ProgressStream, !IO),
+ PredStr = pred_id_to_string(!.ModuleInfo, PredId),
+ io.format(ProgressStream,
+ "%% Accumulators introduced into %s\n", [s(PredStr)], !IO)
+ )
+ ;
+ VeryVerbose = no
+ ),
+
+ (
+ Warnings = []
+ ;
+ Warnings = [_ | _],
+ pred_info_get_context(PredInfo, Context),
+ PredPieces = describe_one_pred_name(!.ModuleInfo,
+ should_module_qualify, PredId),
+ InPieces = [words("In") | PredPieces] ++ [suffix(":"), nl],
+ InMsg = simple_msg(Context,
+ [option_is_set(warn_accumulator_swaps, yes,
+ [always(InPieces)])]),
+
+ proc_info_get_varset(!.ProcInfo, VarSet),
+ generate_warnings(!.ModuleInfo, VarSet, Warnings, WarnMsgs),
+ (
+ Warnings = [_],
+ EnsurePieces = [words("Please ensure that this"),
+ words("argument rearrangement does not introduce"),
+ words("performance problems.")]
+ ;
+ Warnings = [_, _ | _],
+ EnsurePieces = [words("Please ensure that these"),
+ words("argument rearrangements do not introduce"),
+ words("performance problems.")]
+ ),
+ SuppressPieces =
+ [words("These warnings can be suppressed by"),
+ quote("--no-warn-accumulator-swaps"), suffix(".")],
+ VerbosePieces = [words("If a predicate has been declared"),
+ words("associative"),
+ words("via a"), quote("promise"), words("declaration,"),
+ words("the compiler will rearrange the order of"),
+ words("the arguments in calls to that predicate,"),
+ words("if by so doing it makes the containing predicate"),
+ words("tail recursive. In such situations, the compiler"),
+ words("will issue this warning. If this reordering"),
+ words("changes the performance characteristics"),
+ words("of the call to the predicate, use"),
+ quote("--no-accumulator-introduction"),
+ words("to turn the optimization off, or "),
+ quote("--no-warn-accumulator-swaps"),
+ words("to turn off the warnings.")],
+ EnsureSuppressMsg = simple_msg(Context,
+ [option_is_set(warn_accumulator_swaps, yes,
+ [always(EnsurePieces), always(SuppressPieces)]),
+ verbose_only(verbose_once, VerbosePieces)]),
+ Severity = severity_conditional(warn_accumulator_swaps, yes,
+ severity_warning, no),
+ Msgs = [InMsg | WarnMsgs] ++ [EnsureSuppressMsg],
+ Spec = error_spec($pred, Severity, phase_accumulator_intro, Msgs),
+
+ det_univ_to_type(!.Cookie, Specs0),
+ Specs = [Spec | Specs0],
+ type_to_univ(Specs, !:Cookie)
+ )
+ else
+ true
+ ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- pred generate_warnings(module_info::in, prog_varset::in,
+ list(accu_warning)::in, list(error_msg)::out) is det.
+
+generate_warnings(_, _, [], []).
+generate_warnings(ModuleInfo, VarSet, [Warning | Warnings], [Msg | Msgs]) :-
+ generate_warning(ModuleInfo, VarSet, Warning, Msg),
+ generate_warnings(ModuleInfo, VarSet, Warnings, Msgs).
+
+:- pred generate_warning(module_info::in, prog_varset::in, accu_warning::in,
+ error_msg::out) is det.
+
+generate_warning(ModuleInfo, VarSet, Warning, Msg) :-
+ Warning = accu_warn(Context, PredId, VarA, VarB),
+ PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId),
+
+ varset.lookup_name(VarSet, VarA, VarAName),
+ varset.lookup_name(VarSet, VarB, VarBName),
+
+ Pieces = [words("warning: the call to")] ++ PredPieces ++
+ [words("has had the location of the variables"),
+ quote(VarAName), words("and"), quote(VarBName),
+ words("swapped to allow accumulator introduction."), nl],
+ Msg = simplest_msg(Context, Pieces).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % should_attempt_accu_transform is only true iff the current proc
+ % has been transformed to call the newly created accumulator proc.
+ %
+:- pred should_attempt_accu_transform(module_info::in, module_info::out,
+ pred_id::in, proc_id::in, pred_info::in, proc_info::in, proc_info::out,
+ bool::in, maybe_opt_lcmc_accumulator::in,
+ list(accu_warning)::out) is semidet.
+
+should_attempt_accu_transform(!ModuleInfo, PredId, ProcId, PredInfo,
+ !ProcInfo, FullyStrict, DoLCMC, Warnings) :-
+ proc_info_get_goal(!.ProcInfo, Goal0),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InitialInstMap),
+ accu_standardize(Goal0, Goal),
+ identify_goal_type(PredId, ProcId, Goal, InitialInstMap,
+ TopLevel, Base, BaseInstMap, Rec, RecInstMap),
+
+ C = initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap),
+ identify_recursive_calls(PredId, ProcId, C, RecCallIds),
+ list.length(Rec, M),
+
+ should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, !ProcInfo,
+ HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC,
+ RecCallIds, C, M, Rec, Warnings).
+
+ % should_attempt_accu_transform_2 takes a list of locations of the
+ % recursive calls, and attempts to introduce accumulator into each of the
+ % recursive calls, stopping at the first one that succeeds.
+ % This catches the following case, as selecting the first recursive call
+ % allows the second recursive call to be moved before it, and
+ % OutA is in the correct spot in list.append.
+ %
+ % p(InA, OutA),
+ % p(InB, OutB),
+ % list.append(OutB, OutA, Out)
+ %
+:- pred should_attempt_accu_transform_2(module_info::in, module_info::out,
+ pred_id::in, pred_info::in, proc_info::in, proc_info::out,
+ list(prog_var)::in, instmap::in, top_level::in, bool::in,
+ maybe_opt_lcmc_accumulator::in,
+ list(accu_goal_id)::in, accu_goal_store::in, int::in, list(hlds_goal)::in,
+ list(accu_warning)::out) is semidet.
+
+should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo, !ProcInfo,
+ HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC,
+ [Id | Ids], C, M, Rec, Warnings) :-
+ proc_info_get_vartypes(!.ProcInfo, VarTypes0),
+ identify_out_and_out_prime(!.ModuleInfo, VarTypes0, InitialInstMap,
+ Id, Rec, HeadVars, Out, OutPrime, HeadToCallSubst, CallToHeadSubst),
+ ( if
+ accu_stage1(!.ModuleInfo, VarTypes0, FullyStrict, DoLCMC, Id, M, C,
+ Sets),
+ accu_stage2(!.ModuleInfo, !.ProcInfo, Id, C, Sets, OutPrime, Out,
+ VarSet, VarTypes, Accs, BaseCase, BasePairs, Substs, CS,
+ WarningsPrime),
+ accu_stage3(Id, Accs, VarSet, VarTypes, C, CS, Substs,
+ HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, Out,
+ TopLevel, PredId, PredInfo, !ProcInfo, !ModuleInfo)
+ then
+ Warnings = WarningsPrime
+ else
+ should_attempt_accu_transform_2(!ModuleInfo, PredId, PredInfo,
+ !ProcInfo, HeadVars, InitialInstMap, TopLevel, FullyStrict, DoLCMC,
+ Ids, C, M, Rec, Warnings)
+ ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % Transform the goal into a standard form that is amenable to
+ % introducing accumulators.
+ %
+ % At the moment all this does is remove any extra disj/conj wrappers
+ % around the top level goal.
+ %
+ % Future work is for this code to rearrange code with multiple base
+ % and recursive cases into a single base and recursive case.
+ %
+:- pred accu_standardize(hlds_goal::in, hlds_goal::out) is det.
+
+accu_standardize(Goal0, Goal) :-
+ ( if
+ Goal0 = hlds_goal(GoalExpr0, _),
+ (
+ GoalExpr0 = conj(plain_conj, [Goal1])
+ ;
+ GoalExpr0 = disj([Goal1])
+ )
+ then
+ accu_standardize(Goal1, Goal)
+ else
+ Goal = Goal0
+ ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % This predicate takes the original goal and identifies the `shape'
+ % of the goal around the recursive and base cases.
+ %
+ % Note that the base case can contain a recursive call, as the
+ % transformation doesn't depend on what is in the base case.
+ %
+:- pred identify_goal_type(pred_id::in, proc_id::in, hlds_goal::in,
+ instmap::in, top_level::out, list(hlds_goal)::out, instmap::out,
+ list(hlds_goal)::out, instmap::out) is semidet.
+
+identify_goal_type(PredId, ProcId, Goal, InitialInstMap, Type,
+ Base, BaseInstMap, Rec, RecInstMap) :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ (
+ GoalExpr = switch(_Var, _CanFail, Cases),
+ ( if
+ Cases = [case(_IdA, [], GoalA), case(_IdB, [], GoalB)],
+ goal_to_conj_list(GoalA, GoalAList),
+ goal_to_conj_list(GoalB, GoalBList)
+ then
+ ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then
+ Type = switch_rec_base,
+ Base = GoalBList,
+ Rec = GoalAList
+ else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then
+ Type = switch_base_rec,
+ Base = GoalAList,
+ Rec = GoalBList
+ else
+ fail
+ ),
+ BaseInstMap = InitialInstMap,
+ RecInstMap = InitialInstMap
+ else
+ fail
+ )
+ ;
+ GoalExpr = disj(Goals),
+ ( if
+ Goals = [GoalA, GoalB],
+ goal_to_conj_list(GoalA, GoalAList),
+ goal_to_conj_list(GoalB, GoalBList)
+ then
+ ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then
+ Type = disj_rec_base,
+ Base = GoalBList,
+ Rec = GoalAList
+ else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then
+ Type = disj_base_rec,
+ Base = GoalAList,
+ Rec = GoalBList
+ else
+ fail
+ ),
+ BaseInstMap = InitialInstMap,
+ RecInstMap = InitialInstMap
+ else
+ fail
+ )
+ ;
+ GoalExpr = if_then_else(_Vars, Cond, Then, Else),
+ Cond = hlds_goal(_CondGoalExpr, CondGoalInfo),
+ CondInstMapDelta = goal_info_get_instmap_delta(CondGoalInfo),
+
+ goal_to_conj_list(Then, GoalAList),
+ goal_to_conj_list(Else, GoalBList),
+ ( if is_recursive_case(GoalAList, proc(PredId, ProcId)) then
+ Type = ite_rec_base,
+ Base = GoalBList,
+ Rec = GoalAList,
+
+ BaseInstMap = InitialInstMap,
+ apply_instmap_delta(CondInstMapDelta, InitialInstMap, RecInstMap)
+ else if is_recursive_case(GoalBList, proc(PredId, ProcId)) then
+ Type = ite_base_rec,
+ Base = GoalAList,
+ Rec = GoalBList,
+
+ RecInstMap = InitialInstMap,
+ apply_instmap_delta(CondInstMapDelta, InitialInstMap, BaseInstMap)
+ else
+ fail
+ )
+ ).
+
+ % is_recursive_case(Gs, Id) is true iff the list of goals, Gs,
+ % contains a call to the procedure specified by Id, where the call
+ % is located in a position that can be used by the transformation
+ % (i.e. not hidden in a compound goal).
+ %
+:- pred is_recursive_case(list(hlds_goal)::in, pred_proc_id::in) is semidet.
+
+is_recursive_case(Goals, proc(PredId, ProcId)) :-
+ list.append(_Initial, [RecursiveCall | _Final], Goals),
+ RecursiveCall = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % The store info is folded over the list of goals which
+ % represent the base and recursive case conjunctions.
+:- type store_info
+ ---> store_info(
+ store_loc :: int,
+ % The location of the goal in the conjunction.
+ store_instmap :: instmap,
+ store_goals :: accu_goal_store
+ ).
+
+ % Initialise the goal_store, which will hold the C_{a,b} goals.
+ %
+:- func initialize_goal_store(list(hlds_goal), instmap,
+ list(hlds_goal), instmap) = accu_goal_store.
+
+initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap) = C :-
+ goal_store_init(C0),
+ list.foldl3(accu_store(accu_rec), Rec,
+ 1, _, RecInstMap, _, C0, C1),
+ list.foldl3(accu_store(accu_base), Base,
+ 1, _, BaseInstMap, _, C1, C).
+
+:- pred accu_store(accu_case::in, hlds_goal::in,
+ int::in, int::out, instmap::in, instmap::out,
+ accu_goal_store::in, accu_goal_store::out) is det.
+
+accu_store(Case, Goal, !N, !InstMap, !GoalStore) :-
+ Id = accu_goal_id(Case, !.N),
+ goal_store_det_insert(Id, stored_goal(Goal, !.InstMap), !GoalStore),
+
+ !:N = !.N + 1,
+ Goal = hlds_goal(_, GoalInfo),
+ InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
+ apply_instmap_delta(InstMapDelta, !InstMap).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % Determine the k's which are recursive calls.
+ % Note that this doesn't find recursive calls which are `hidden'
+ % in compound goals, this is not a problem as currently we can't use
+ % these to do transformation.
+ %
+:- pred identify_recursive_calls(pred_id::in, proc_id::in,
+ accu_goal_store::in, list(accu_goal_id)::out) is det.
+
+identify_recursive_calls(PredId, ProcId, GoalStore, Ids) :-
+ P =
+ ( pred(Key::out) is nondet :-
+ goal_store_member(GoalStore, Key, stored_goal(Goal, _InstMap)),
+ Key = accu_goal_id(accu_rec, _),
+ Goal = hlds_goal(plain_call(PredId, ProcId, _, _, _, _), _)
+ ),
+ solutions.solutions(P, Ids).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % Determine the variables which are members of the sets Out and Out',
+ % and initialize the substitutions between the two sets.
+ %
+ % This is done by identifing those variables whose instantiatedness change
+ % in the goals after the recursive call and are headvars.
+ %
+ % Note that we are only identifying the output variables which will need
+ % to be accumulated, as there may be other output variables which are
+ % produced prior to the recursive call.
+ %
+:- pred identify_out_and_out_prime(module_info::in, vartypes::in, instmap::in,
+ accu_goal_id::in, list(hlds_goal)::in,
+ list(prog_var)::in, list(prog_var)::out, list(prog_var)::out,
+ accu_subst::out, accu_subst::out) is det.
+
+identify_out_and_out_prime(ModuleInfo, VarTypes, InitialInstMap, GoalId,
+ Rec, HeadVars, Out, OutPrime, HeadToCallSubst, CallToHeadSubst) :-
+ GoalId = accu_goal_id(_Case, K),
+ ( if
+ list.take(K, Rec, InitialGoals),
+ list.drop(K-1, Rec, FinalGoals),
+ FinalGoals = [hlds_goal(plain_call(_, _, Args, _, _, _), _) | Rest]
+ then
+ goal_list_instmap_delta(InitialGoals, InitInstMapDelta),
+ apply_instmap_delta( InitInstMapDelta,
+ InitialInstMap, InstMapBeforeRest),
+
+ goal_list_instmap_delta(Rest, InstMapDelta),
+ apply_instmap_delta(InstMapDelta, InstMapBeforeRest, InstMapAfterRest),
+
+ instmap_changed_vars(ModuleInfo, VarTypes,
+ InstMapBeforeRest, InstMapAfterRest, ChangedVars),
+
+ assoc_list.from_corresponding_lists(HeadVars, Args, HeadArg0),
+
+ Member =
+ ( pred(M::in) is semidet :-
+ M = HeadVar - _,
+ set_of_var.member(ChangedVars, HeadVar)
+ ),
+ list.filter(Member, HeadArg0, HeadArg),
+ list.map(fst, HeadArg, Out),
+ list.map(snd, HeadArg, OutPrime),
+
+ map.from_assoc_list(HeadArg, HeadToCallSubst),
+
+ list.map((pred(X-Y::in, Y-X::out) is det), HeadArg, ArgHead),
+ map.from_assoc_list(ArgHead, CallToHeadSubst)
+ else
+ unexpected($pred, "test failed")
+ ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % For each goal after the recursive call, we place that goal
+ % into a set according to what properties that goal has.
+ % For the definition of what goes into each set, inspect the documentation
+ % for the functions named before, assoc, and so on.
+ %
+:- type accu_sets
+ ---> accu_sets(
+ as_before :: set(accu_goal_id),
+ as_assoc :: set(accu_goal_id),
+ as_construct_assoc :: set(accu_goal_id),
+ as_construct :: set(accu_goal_id),
+ as_update :: set(accu_goal_id),
+ as_reject :: set(accu_goal_id)
+ ).
+
+ % Stage 1 is responsible for identifying which goals are associative,
+ % which can be moved before the recursive call and so on.
+ %
+:- pred accu_stage1(module_info::in, vartypes::in, bool::in,
+ maybe_opt_lcmc_accumulator::in, accu_goal_id::in, int::in,
+ accu_goal_store::in, accu_sets::out) is semidet.
+
+accu_stage1(ModuleInfo, VarTypes, FullyStrict, DoLCMC, GoalId, M, GoalStore,
+ Sets) :-
+ GoalId = accu_goal_id(Case, K),
+ NextGoalId = accu_goal_id(Case, K + 1),
+ accu_sets_init(Sets0),
+ accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M,
+ GoalStore, Sets0, Sets1),
+ Sets1 = accu_sets(Before, Assoc,
+ ConstructAssoc, Construct, Update, Reject),
+ Sets = accu_sets(Before `set.union` set_upto(Case, K - 1), Assoc,
+ ConstructAssoc, Construct, Update, Reject),
+
+ % Continue the transformation only if the set reject is empty and
+ % the set assoc or update contains something that needs to be moved
+ % before the recursive call.
+ set.is_empty(Reject),
+ (
+ not set.is_empty(Assoc)
+ ;
+ not set.is_empty(Update)
+ ),
+ (
+ DoLCMC = do_not_opt_lcmc_accumulator,
+ % If LCMC is not turned on, then there must be no construction
+ % unifications after the recursive call.
+ set.is_empty(Construct),
+ set.is_empty(ConstructAssoc)
+ ;
+ DoLCMC = opt_lcmc_accumulator
+ ).
+
+ % For each goal after the recursive call decide which set
+ % the goal belongs to.
+ %
+:- pred accu_stage1_2(module_info::in, vartypes::in, bool::in,
+ accu_goal_id::in, int::in, int::in, accu_goal_store::in,
+ accu_sets::in, accu_sets::out) is det.
+
+accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, GoalId, K, M, GoalStore,
+ !Sets) :-
+ GoalId = accu_goal_id(Case, I),
+ NextGoalId = accu_goal_id(Case, I + 1),
+ ( if I > M then
+ true
+ else
+ ( if
+ accu_before(ModuleInfo, VarTypes, FullyStrict, GoalId, K,
+ GoalStore, !.Sets)
+ then
+ !Sets ^ as_before := set.insert(!.Sets ^ as_before, GoalId),
+ accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M,
+ GoalStore, !Sets)
+ else if
+ accu_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K,
+ GoalStore, !.Sets)
+ then
+ !Sets ^ as_assoc := set.insert(!.Sets ^ as_assoc, GoalId),
+ accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M,
+ GoalStore, !Sets)
+ else if
+ accu_construct(ModuleInfo, VarTypes, FullyStrict, GoalId, K,
+ GoalStore, !.Sets)
+ then
+ !Sets ^ as_construct := set.insert(!.Sets ^ as_construct, GoalId),
+ accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M,
+ GoalStore, !Sets)
+ else if
+ accu_construct_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K,
+ GoalStore, !.Sets)
+ then
+ !Sets ^ as_construct_assoc :=
+ set.insert(!.Sets ^ as_construct_assoc, GoalId),
+ accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M,
+ GoalStore, !Sets)
+ else if
+ accu_update(ModuleInfo, VarTypes, FullyStrict, GoalId, K,
+ GoalStore, !.Sets)
+ then
+ !Sets ^ as_update := set.insert(!.Sets ^ as_update, GoalId),
+ accu_stage1_2(ModuleInfo, VarTypes, FullyStrict, NextGoalId, K, M,
+ GoalStore, !Sets)
+ else
+ !Sets ^ as_reject := set.insert(!.Sets ^ as_reject, GoalId)
+ )
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- pred accu_sets_init(accu_sets::out) is det.
+
+accu_sets_init(Sets) :-
+ set.init(EmptySet),
+ Before = EmptySet,
+ Assoc = EmptySet,
+ ConstructAssoc = EmptySet,
+ Construct = EmptySet,
+ Update = EmptySet,
+ Reject = EmptySet,
+ Sets = accu_sets(Before, Assoc, ConstructAssoc, Construct, Update, Reject).
+
+ % set_upto(Case, K) returns the set
+ % {accu_goal_id(Case, 1) .. accu_goal_id(Case, K)}.
+ %
+:- func set_upto(accu_case, int) = set(accu_goal_id).
+
+set_upto(Case, K) = Set :-
+ ( if K =< 0 then
+ set.init(Set)
+ else
+ Set0 = set_upto(Case, K - 1),
+ set.insert(accu_goal_id(Case, K), Set0, Set)
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % A goal is a member of the before set iff the goal only depends on goals
+ % which are before the recursive call or can be moved before the recursive
+ % call (member of the before set).
+ %
+:- pred accu_before(module_info::in, vartypes::in, bool::in,
+ accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet.
+
+accu_before(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :-
+ GoalId = accu_goal_id(Case, _I),
+ Before = Sets ^ as_before,
+ goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)),
+ (
+ member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId,
+ stored_goal(EarlierGoal, EarlierInstMap)),
+ not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
+ EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
+ )
+ =>
+ (
+ set.member(LessThanGoalId, set_upto(Case, K - 1) `union` Before)
+ ).
+
+ % A goal is a member of the assoc set iff the goal only depends on goals
+ % upto and including the recursive call and goals which can be moved
+ % before the recursive call (member of the before set) AND the goal
+ % is associative.
+ %
+:- pred accu_assoc(module_info::in, vartypes::in, bool::in,
+ accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet.
+
+accu_assoc(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :-
+ GoalId = accu_goal_id(Case, _I),
+ Before = Sets ^ as_before,
+ goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)),
+ LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _),
+ accu_is_associative(ModuleInfo, PredId, Args, _),
+ (
+ % XXX LessThanGoalId was _N - J, not N - J: it ignored the case.
+ % See the diff with the previous version.
+ member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId,
+ stored_goal(EarlierGoal, EarlierInstMap)),
+ not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
+ EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
+ )
+ =>
+ (
+ set.member(LessThanGoalId, set_upto(Case, K) `union` Before)
+ ).
+
+ % A goal is a member of the construct set iff the goal only depends
+ % on goals upto and including the recursive call and goals which
+ % can be moved before the recursive call (member of the before set)
+ % AND the goal is construction unification.
+ %
+:- pred accu_construct(module_info::in, vartypes::in, bool::in,
+ accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet.
+
+accu_construct(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore,
+ Sets) :-
+ GoalId = accu_goal_id(Case, _I),
+ Before = Sets ^ as_before,
+ Construct = Sets ^ as_construct,
+ goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)),
+ LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo),
+ Unify = construct(_, _, _, _, _, _, _),
+ (
+ % XXX LessThanGoalId was _N - J, not N - J: it ignored the case.
+ % See the diff with the previous version.
+ member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId,
+ stored_goal(EarlierGoal, EarlierInstMap)),
+ not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
+ EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
+ )
+ =>
+ (
+ set.member(LessThanGoalId,
+ set_upto(Case, K) `union` Before `union` Construct)
+ ).
+
+ % A goal is a member of the construct_assoc set iff the goal depends only
+ % on goals upto and including the recursive call and goals which can be
+ % moved before the recursive call (member of the before set) and goals
+ % which are associative AND the goal is construction unification AND
+ % there is only one member of the assoc set which the construction
+ % unification depends on AND the construction unification can be expressed
+ % as a call to the member of the assoc set which the construction
+ % unification depends on.
+ %
+:- pred accu_construct_assoc(module_info::in, vartypes::in, bool::in,
+ accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet.
+
+accu_construct_assoc(ModuleInfo, VarTypes, FullyStrict,
+ GoalId, K, GoalStore, Sets) :-
+ GoalId = accu_goal_id(Case, _I),
+ Before = Sets ^ as_before,
+ Assoc = Sets ^ as_assoc,
+ ConstructAssoc = Sets ^ as_construct_assoc,
+ goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)),
+ LaterGoal = hlds_goal(unify(_, _, _, Unify, _), _GoalInfo),
+ Unify = construct(_, ConsId, _, _, _, _, _),
+
+ goal_store_all_ancestors(GoalStore, GoalId, VarTypes, ModuleInfo,
+ FullyStrict, Ancestors),
+
+ set.is_singleton(Assoc `intersect` Ancestors, AssocId),
+ goal_store_lookup(GoalStore, AssocId,
+ stored_goal(AssocGoal, _AssocInstMap)),
+ AssocGoal = hlds_goal(plain_call(PredId, _, _, _, _, _), _),
+
+ is_associative_construction(ModuleInfo, PredId, ConsId),
+ (
+ % XXX LessThanGoalId was _N - J, not N - J: it ignored the case.
+ % See the diff with the previous version.
+ member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId,
+ stored_goal(EarlierGoal, EarlierInstMap)),
+ not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
+ EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
+ )
+ =>
+ (
+ set.member(LessThanGoalId,
+ set_upto(Case, K) `union` Before `union` Assoc
+ `union` ConstructAssoc)
+ ).
+
+ % A goal is a member of the update set iff the goal only depends
+ % on goals upto and including the recursive call and goals which
+ % can be moved before the recursive call (member of the before set)
+ % AND the goal updates some state.
+ %
+:- pred accu_update(module_info::in, vartypes::in, bool::in,
+ accu_goal_id::in, int::in, accu_goal_store::in, accu_sets::in) is semidet.
+
+accu_update(ModuleInfo, VarTypes, FullyStrict, GoalId, K, GoalStore, Sets) :-
+ GoalId = accu_goal_id(Case, _I),
+ Before = Sets ^ as_before,
+ goal_store_lookup(GoalStore, GoalId, stored_goal(LaterGoal, LaterInstMap)),
+ LaterGoal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _),
+ accu_is_update(ModuleInfo, PredId, Args, _),
+ (
+ % XXX LessThanGoalId was _N - J, not N - J: it ignored the case.
+ % See the diff with the previous version.
+ member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId,
+ stored_goal(EarlierGoal, EarlierInstMap)),
+ not can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
+ EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal)
+ )
+ =>
+ (
+ set.member(LessThanGoalId, set_upto(Case, K) `union` Before)
+ ).
+
+ % member_lessthan_goalid(GS, IdA, IdB, GB) is true iff the goal_id, IdB,
+ % and its associated goal, GB, is a member of the goal_store, GS,
+ % and IdB is less than IdA.
+ %
+:- pred member_lessthan_goalid(accu_goal_store::in,
+ accu_goal_id::in, accu_goal_id::out, stored_goal::out) is nondet.
+
+member_lessthan_goalid(GoalStore, GoalId, LessThanGoalId, LessThanGoal) :-
+ goal_store_member(GoalStore, LessThanGoalId, LessThanGoal),
+ GoalId = accu_goal_id(Case, I),
+ LessThanGoalId = accu_goal_id(Case, J),
+ J < I.
+
+%---------------------------------------------------------------------------%
+
+:- type accu_assoc
+ ---> accu_assoc(
+ set_of_progvar, % the associative input args
+ prog_var, % the corresponding output arg
+ bool % is the predicate commutative?
+ ).
+
+ % If accu_is_associative is true, it returns the two arguments which are
+ % associative and the variable which depends on those two arguments,
+ % and an indicator of whether or not the predicate is commutative.
+ %
+:- pred accu_is_associative(module_info::in, pred_id::in, list(prog_var)::in,
+ accu_assoc::out) is semidet.
+
+accu_is_associative(ModuleInfo, PredId, Args, Result) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_assertions(PredInfo, Assertions),
+ AssertionsList = set.to_sorted_list(Assertions),
+ associativity_assertion(ModuleInfo, AssertionsList, Args,
+ AssociativeVarsOutputVar),
+ ( if
+ commutativity_assertion(ModuleInfo, AssertionsList, Args,
+ _CommutativeVars)
+ then
+ IsCommutative = yes
+ else
+ IsCommutative = no
+ ),
+ AssociativeVarsOutputVar =
+ associative_vars_output_var(AssociativeVars, OutputVar),
+ Result = accu_assoc(AssociativeVars, OutputVar, IsCommutative).
+
+ % Does there exist one (and only one) associativity assertion for the
+ % current predicate?
+ % The 'and only one condition' is required because we currently
+ % do not handle the case of predicates which have individual parts
+ % which are associative, because then we do not know which variable
+ % is descended from which.
+ %
+:- pred associativity_assertion(module_info::in, list(assert_id)::in,
+ list(prog_var)::in, associative_vars_output_var::out) is semidet.
+
+associativity_assertion(ModuleInfo, [AssertId | AssertIds], Args0,
+ AssociativeVarsOutputVar) :-
+ ( if
+ assertion.is_associativity_assertion(ModuleInfo, AssertId,
+ Args0, AssociativeVarsOutputVarPrime)
+ then
+ AssociativeVarsOutputVar = AssociativeVarsOutputVarPrime,
+ not associativity_assertion(ModuleInfo, AssertIds, Args0, _)
+ else
+ associativity_assertion(ModuleInfo, AssertIds, Args0,
+ AssociativeVarsOutputVar)
+ ).
+
+ % Does there exist one (and only one) commutativity assertion for the
+ % current predicate?
+ % The 'and only one condition' is required because we currently
+ % do not handle the case of predicates which have individual
+ % parts which are commutative, because then we do not know which variable
+ % is descended from which.
+ %
+:- pred commutativity_assertion(module_info::in,list(assert_id)::in,
+ list(prog_var)::in, set_of_progvar::out) is semidet.
+
+commutativity_assertion(ModuleInfo, [AssertId | AssertIds], Args0,
+ CommutativeVars) :-
+ ( if
+ assertion.is_commutativity_assertion(ModuleInfo, AssertId,
+ Args0, CommutativeVarsPrime)
+ then
+ CommutativeVars = CommutativeVarsPrime,
+ not commutativity_assertion(ModuleInfo, AssertIds, Args0, _)
+ else
+ commutativity_assertion(ModuleInfo, AssertIds, Args0,
+ CommutativeVars)
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % Does the current predicate update some state?
+ %
+:- pred accu_is_update(module_info::in, pred_id::in, list(prog_var)::in,
+ state_update_vars::out) is semidet.
+
+accu_is_update(ModuleInfo, PredId, Args, ResultStateVars) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_assertions(PredInfo, Assertions),
+ list.filter_map(
+ ( pred(AssertId::in, StateVars::out) is semidet :-
+ assertion.is_update_assertion(ModuleInfo, AssertId,
+ PredId, Args, StateVars)
+ ),
+ set.to_sorted_list(Assertions), Result),
+ % XXX Maybe we should just match on the first result,
+ % just in case there are duplicate promises.
+ Result = [ResultStateVars].
+
+%---------------------------------------------------------------------------%
+
+ % Can the construction unification be expressed as a call to the
+ % specified predicate.
+ %
+:- pred is_associative_construction(module_info::in, pred_id::in, cons_id::in)
+ is semidet.
+
+is_associative_construction(ModuleInfo, PredId, ConsId) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_assertions(PredInfo, Assertions),
+ list.filter(
+ ( pred(AssertId::in) is semidet :-
+ assertion.is_construction_equivalence_assertion(ModuleInfo,
+ AssertId, ConsId, PredId)
+ ),
+ set.to_sorted_list(Assertions), Result),
+ Result = [_ | _].
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- type accu_substs
+ ---> accu_substs(
+ acc_var_subst :: accu_subst,
+ rec_call_subst :: accu_subst,
+ assoc_call_subst :: accu_subst,
+ update_subst :: accu_subst
+ ).
+
+:- type accu_base
+ ---> accu_base(
+ % goals which initialize update
+ init_update :: set(accu_goal_id),
+
+ % goals which initialize assoc
+ init_assoc :: set(accu_goal_id),
+
+ % other goals
+ other :: set(accu_goal_id)
+ ).
+
+ % Stage 2 is responsible for identifying the substitutions which
+ % are needed to mimic the unfold/fold process that was used as
+ % the justification of the algorithm in the paper.
+ % It is also responsible for ensuring that the reordering of arguments
+ % doesn't worsen the big-O complexity of the procedure.
+ % It also divides the base case into goals that initialize the
+ % variables used by the update goals, and those used by the assoc
+ % goals and then all the rest.
+ %
+:- pred accu_stage2(module_info::in, proc_info::in,
+ accu_goal_id::in, accu_goal_store::in, accu_sets::in,
+ list(prog_var)::in, list(prog_var)::in, prog_varset::out, vartypes::out,
+ list(prog_var)::out, accu_base::out, list(pair(prog_var))::out,
+ accu_substs::out, accu_goal_store::out, list(accu_warning)::out)
+ is semidet.
+
+accu_stage2(ModuleInfo, ProcInfo0, GoalId, GoalStore, Sets, OutPrime, Out,
+ !:VarSet, !:VarTypes, Accs, BaseCase, BasePairs, !:Substs,
+ CS, Warnings) :-
+ Sets = accu_sets(Before0, Assoc, ConstructAssoc, Construct, Update, _),
+ GoalId = accu_goal_id(Case, K),
+ Before = Before0 `union` set_upto(Case, K-1),
+
+ % Note Update set is not placed in the after set, as the after set is used
+ % to determine the variables that need to be accumulated for the
+ % associative calls.
+ After = Assoc `union` ConstructAssoc `union` Construct,
+
+ P =
+ ( pred(Id::in, Set0::in, Set::out) is det :-
+ goal_store_lookup(GoalStore, Id, stored_goal(Goal, _InstMap)),
+ Goal = hlds_goal(_GoalExpr, GoalInfo),
+ NonLocals = goal_info_get_nonlocals(GoalInfo),
+ set_of_var.union(NonLocals, Set0, Set)
+ ),
+ list.foldl(P, set.to_sorted_list(Before),
+ set_of_var.init, BeforeNonLocals),
+ list.foldl(P, set.to_sorted_list(After),
+ set_of_var.init, AfterNonLocals),
+ InitAccs = set_of_var.intersect(BeforeNonLocals, AfterNonLocals),
+
+ proc_info_get_varset(ProcInfo0, !:VarSet),
+ proc_info_get_vartypes(ProcInfo0, !:VarTypes),
+
+ accu_substs_init(set_of_var.to_sorted_list(InitAccs), !VarSet, !VarTypes,
+ !:Substs),
+
+ set_of_var.list_to_set(OutPrime, OutPrimeSet),
+ accu_process_assoc_set(ModuleInfo, GoalStore, set.to_sorted_list(Assoc),
+ OutPrimeSet, !Substs, !VarSet, !VarTypes, CS, Warnings),
+
+ accu_process_update_set(ModuleInfo, GoalStore, set.to_sorted_list(Update),
+ OutPrimeSet, !Substs, !VarSet, !VarTypes, UpdateOut, UpdateAccOut,
+ BasePairs),
+
+ Accs = set_of_var.to_sorted_list(InitAccs) ++ UpdateAccOut,
+
+ accu_divide_base_case(ModuleInfo, !.VarTypes, GoalStore, UpdateOut, Out,
+ UpdateBase, AssocBase, OtherBase),
+
+ BaseCase = accu_base(UpdateBase, AssocBase, OtherBase).
+
+%---------------------------------------------------------------------------%
+
+:- pred accu_substs_init(list(prog_var)::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, accu_substs::out) is det.
+
+accu_substs_init(InitAccs, !VarSet, !VarTypes, Substs) :-
+ map.init(Subst),
+ acc_var_subst_init(InitAccs, !VarSet, !VarTypes, AccVarSubst),
+ RecCallSubst = Subst,
+ AssocCallSubst = Subst,
+ UpdateSubst = Subst,
+ Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ UpdateSubst).
+
+ % Initialise the acc_var_subst to be from Var to A_Var where Var is a
+ % member of InitAccs and A_Var is a fresh variable of the same type of Var.
+ %
+:- pred acc_var_subst_init(list(prog_var)::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ accu_subst::out) is det.
+
+acc_var_subst_init([], !VarSet, !VarTypes, map.init).
+acc_var_subst_init([Var | Vars], !VarSet, !VarTypes, Subst) :-
+ create_new_var(Var, "A_", AccVar, !VarSet, !VarTypes),
+ acc_var_subst_init(Vars, !VarSet, !VarTypes, Subst0),
+ map.det_insert(Var, AccVar, Subst0, Subst).
+
+ % Create a fresh variable which is the same type as the old variable
+ % and has the same name except that it begins with the prefix.
+ %
+:- pred create_new_var(prog_var::in, string::in, prog_var::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
+
+create_new_var(OldVar, Prefix, NewVar, !VarSet, !VarTypes) :-
+ varset.lookup_name(!.VarSet, OldVar, OldName),
+ string.append(Prefix, OldName, NewName),
+ varset.new_named_var(NewName, NewVar, !VarSet),
+ lookup_var_type(!.VarTypes, OldVar, Type),
+ add_var_type(NewVar, Type, !VarTypes).
+
+%---------------------------------------------------------------------------%
+
+ % For each member of the assoc set determine the substitutions needed,
+ % and also check the efficiency of the procedure isn't worsened
+ % by reordering the arguments to a call.
+ %
+:- pred accu_process_assoc_set(module_info::in, accu_goal_store::in,
+ list(accu_goal_id)::in, set_of_progvar::in,
+ accu_substs::in, accu_substs::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ accu_goal_store::out, list(accu_warning)::out) is semidet.
+
+accu_process_assoc_set(_ModuleInfo, _GS, [], _OutPrime, !Substs,
+ !VarSet, !VarTypes, CS, []) :-
+ goal_store_init(CS).
+accu_process_assoc_set(ModuleInfo, GS, [Id | Ids], OutPrime, !Substs,
+ !VarSet, !VarTypes, CS, Warnings) :-
+ !.Substs = accu_substs(AccVarSubst, RecCallSubst0, AssocCallSubst0,
+ UpdateSubst),
+
+ lookup_call(GS, Id, stored_goal(Goal, InstMap)),
+
+ Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), GoalInfo),
+ accu_is_associative(ModuleInfo, PredId, Args, AssocInfo),
+ AssocInfo = accu_assoc(Vars, AssocOutput, IsCommutative),
+ OutPrimeVars = set_of_var.intersect(Vars, OutPrime),
+ set_of_var.is_singleton(OutPrimeVars, DuringAssocVar),
+ set_of_var.is_singleton(set_of_var.difference(Vars, OutPrimeVars),
+ BeforeAssocVar),
+
+ map.lookup(AccVarSubst, BeforeAssocVar, AccVar),
+ create_new_var(BeforeAssocVar, "NewAcc_", NewAcc, !VarSet, !VarTypes),
+
+ map.det_insert(DuringAssocVar, AccVar, AssocCallSubst0, AssocCallSubst1),
+ map.det_insert(AssocOutput, NewAcc, AssocCallSubst1, AssocCallSubst),
+ map.det_insert(DuringAssocVar, AssocOutput, RecCallSubst0, RecCallSubst1),
+ map.det_insert(BeforeAssocVar, NewAcc, RecCallSubst1, RecCallSubst),
+
+ !:Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ UpdateSubst),
+
+ % ONLY swap the order of the variables if the goal is
+ % associative and not commutative.
+ (
+ IsCommutative = yes,
+ CSGoal = stored_goal(Goal, InstMap),
+ CurWarnings = []
+ ;
+ IsCommutative = no,
+
+ % Ensure that the reordering doesn't cause a efficiency problem.
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ ModuleName = pred_info_module(PredInfo),
+ PredName = pred_info_name(PredInfo),
+ Arity = pred_info_orig_arity(PredInfo),
+ ( if accu_has_heuristic(ModuleName, PredName, Arity) then
+ % Only do the transformation if the accumulator variable is
+ % *not* in a position where it will control the running time
+ % of the predicate.
+ accu_heuristic(ModuleName, PredName, Arity, Args,
+ PossibleDuringAssocVars),
+ set_of_var.member(PossibleDuringAssocVars, DuringAssocVar),
+ CurWarnings = []
+ else
+ ProgContext = goal_info_get_context(GoalInfo),
+ CurWarnings = [accu_warn(ProgContext, PredId, BeforeAssocVar,
+ DuringAssocVar)]
+ ),
+ % Swap the arguments.
+ [A, B] = set_of_var.to_sorted_list(Vars),
+ map.from_assoc_list([A - B, B - A], Subst),
+ rename_some_vars_in_goal(Subst, Goal, SwappedGoal),
+ CSGoal = stored_goal(SwappedGoal, InstMap)
+ ),
+
+ accu_process_assoc_set(ModuleInfo, GS, Ids, OutPrime, !Substs,
+ !VarSet, !VarTypes, CS0, Warnings0),
+ goal_store_det_insert(Id, CSGoal, CS0, CS),
+ Warnings = Warnings0 ++ CurWarnings.
+
+:- pred accu_has_heuristic(module_name::in, string::in, arity::in) is semidet.
+
+accu_has_heuristic(unqualified("list"), "append", 3).
+
+ % heuristic returns the set of which head variables are important
+ % in the running time of the predicate.
+ %
+:- pred accu_heuristic(module_name::in, string::in, arity::in,
+ list(prog_var)::in, set_of_progvar::out) is semidet.
+
+accu_heuristic(unqualified("list"), "append", 3, [_Typeinfo, A, _B, _C],
+ Set) :-
+ set_of_var.make_singleton(A, Set).
+
+%---------------------------------------------------------------------------%
+
+ % For each member of the update set determine the substitutions needed
+ % (creating the accumulator variables when needed).
+ % Also associate with each Output variable which accumulator variable
+ % to get the result from.
+ %
+:- pred accu_process_update_set(module_info::in, accu_goal_store::in,
+ list(accu_goal_id)::in, set_of_progvar::in,
+ accu_substs::in, accu_substs::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ list(prog_var)::out, list(prog_var)::out, list(pair(prog_var))::out)
+ is semidet.
+
+accu_process_update_set(_ModuleInfo, _GS, [], _OutPrime, !Substs,
+ !VarSet, !VarTypes, [], [], []).
+accu_process_update_set(ModuleInfo, GS, [Id | Ids], OutPrime, !Substs,
+ !VarSet, !VarTypes, StateOutputVars, Accs, BasePairs) :-
+ !.Substs = accu_substs(AccVarSubst0, RecCallSubst0, AssocCallSubst,
+ UpdateSubst0),
+ lookup_call(GS, Id, stored_goal(Goal, _InstMap)),
+
+ Goal = hlds_goal(plain_call(PredId, _, Args, _, _, _), _GoalInfo),
+ accu_is_update(ModuleInfo, PredId, Args, StateVars),
+ StateVars = state_update_vars(StateVarA, StateVarB),
+
+ ( if set_of_var.member(OutPrime, StateVarA) then
+ StateInputVar = StateVarA,
+ StateOutputVar = StateVarB
+ else
+ StateInputVar = StateVarB,
+ StateOutputVar = StateVarA
+ ),
+
+ create_new_var(StateInputVar, "Acc_", Acc0, !VarSet, !VarTypes),
+ create_new_var(StateOutputVar, "Acc_", Acc, !VarSet, !VarTypes),
+
+ map.det_insert(StateInputVar, Acc0, UpdateSubst0, UpdateSubst1),
+ map.det_insert(StateOutputVar, Acc, UpdateSubst1, UpdateSubst),
+ map.det_insert(StateInputVar, StateOutputVar, RecCallSubst0, RecCallSubst),
+ map.det_insert(Acc, Acc0, AccVarSubst0, AccVarSubst),
+ !:Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ UpdateSubst),
+
+ accu_process_update_set(ModuleInfo, GS, Ids, OutPrime, !Substs,
+ !VarSet, !VarTypes, StateOutputVars0, Accs0, BasePairs0),
+
+ % Rather then concatenating to start of the list we concatenate to the end
+ % of the list. This allows the accumulator introduction to be applied
+ % as the heuristic will succeed (remember after transforming the two
+ % input variables will have their order swapped, so they must be in the
+ % inefficient order to start with)
+
+ StateOutputVars = StateOutputVars0 ++ [StateOutputVar],
+ Accs = Accs0 ++ [Acc],
+ BasePairs = BasePairs0 ++ [StateOutputVar - Acc0].
+
+%---------------------------------------------------------------------------%
+
+ % divide_base_case(UpdateOut, Out, U, A, O) is true iff given the output
+ % variables which are instantiated by update goals, UpdateOut, and all
+ % the variables that need to be accumulated, Out, divide the base case up
+ % into three sets, those base case goals which initialize the variables
+ % used by update calls, U, those which initialize variables used by
+ % assoc calls, A, and the rest of the goals, O. Note that the sets
+ % are not necessarily disjoint, as the result of a goal may be used
+ % to initialize a variable in both U and A, so both U and A will contain
+ % the same goal_id.
+ %
+:- pred accu_divide_base_case(module_info::in, vartypes::in,
+ accu_goal_store::in, list(prog_var)::in, list(prog_var)::in,
+ set(accu_goal_id)::out, set(accu_goal_id)::out, set(accu_goal_id)::out)
+ is det.
+
+accu_divide_base_case(ModuleInfo, VarTypes, C, UpdateOut, Out,
+ UpdateBase, AssocBase, OtherBase) :-
+ list.delete_elems(Out, UpdateOut, AssocOut),
+
+ list.map(accu_related(ModuleInfo, VarTypes, C), UpdateOut, UpdateBaseList),
+ list.map(accu_related(ModuleInfo, VarTypes, C), AssocOut, AssocBaseList),
+ UpdateBase = set.power_union(set.list_to_set(UpdateBaseList)),
+ AssocBase = set.power_union(set.list_to_set(AssocBaseList)),
+
+ Set = base_case_ids_set(C) `difference` (UpdateBase `union` AssocBase),
+ set.to_sorted_list(Set, List),
+
+ list.map(
+ ( pred(GoalId::in, Ancestors::out) is det :-
+ goal_store_all_ancestors(C, GoalId, VarTypes,
+ ModuleInfo, no, Ancestors)
+ ), List, OtherBaseList),
+
+ OtherBase = set.list_to_set(List) `union`
+ (base_case_ids_set(C) `intersect`
+ set.power_union(set.list_to_set(OtherBaseList))).
+
+ % accu_related(ModuleInfo, VarTypes, GoalStore, Var, Related):
+ %
+ % From GoalStore, return all the goal_ids, Related, which are needed
+ % to initialize Var.
+ %
+:- pred accu_related(module_info::in, vartypes::in, accu_goal_store::in,
+ prog_var::in, set(accu_goal_id)::out) is det.
+
+accu_related(ModuleInfo, VarTypes, GoalStore, Var, Related) :-
+ solutions.solutions(
+ ( pred(Key::out) is nondet :-
+ goal_store_member(GoalStore, Key, stored_goal(Goal, InstMap0)),
+ Key = accu_goal_id(accu_base, _),
+ Goal = hlds_goal(_GoalExpr, GoalInfo),
+ InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
+ apply_instmap_delta(InstMapDelta, InstMap0, InstMap),
+ instmap_changed_vars(ModuleInfo, VarTypes,
+ InstMap0, InstMap, ChangedVars),
+ set_of_var.is_singleton(ChangedVars, Var)
+ ), Ids),
+ (
+ Ids = [],
+ unexpected($pred, "no Id")
+ ;
+ Ids = [Id],
+ goal_store_all_ancestors(GoalStore, Id, VarTypes, ModuleInfo, no,
+ Ancestors),
+ list.filter((pred(accu_goal_id(accu_base, _)::in) is semidet),
+ set.to_sorted_list(set.insert(Ancestors, Id)), RelatedList),
+ Related = set.list_to_set(RelatedList)
+ ;
+ Ids = [_, _ | _],
+ unexpected($pred, "more than one Id")
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- inst stored_goal_plain_call for goal_store.stored_goal/0
+ ---> stored_goal(goal_plain_call, ground).
+
+ % Do a goal_store_lookup where the result is known to be a call.
+ %
+:- pred lookup_call(accu_goal_store::in, accu_goal_id::in,
+ stored_goal::out(stored_goal_plain_call)) is det.
+
+lookup_call(GoalStore, Id, stored_goal(Call, InstMap)) :-
+ goal_store_lookup(GoalStore, Id, stored_goal(Goal, InstMap)),
+ ( if
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ GoalExpr = plain_call(_, _, _, _, _, _)
+ then
+ Call = hlds_goal(GoalExpr, GoalInfo)
+ else
+ unexpected($pred, "not a call")
+ ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % accu_stage3 creates the accumulator version of the predicate using
+ % the substitutions determined in stage2. It also redefines the
+ % original procedure to call the accumulator version of the procedure.
+ %
+:- pred accu_stage3(accu_goal_id::in, list(prog_var)::in, prog_varset::in,
+ vartypes::in, accu_goal_store::in, accu_goal_store::in,
+ accu_substs::in, accu_subst::in, accu_subst::in,
+ accu_base::in, list(pair(prog_var))::in, accu_sets::in,
+ list(prog_var)::in, top_level::in, pred_id::in, pred_info::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
+
+accu_stage3(RecCallId, Accs, VarSet, VarTypes, C, CS, Substs,
+ HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, Out,
+ TopLevel, OrigPredId, OrigPredInfo, !OrigProcInfo, !ModuleInfo) :-
+ acc_proc_info(Accs, VarSet, VarTypes, Substs, !.OrigProcInfo,
+ AccTypes, AccProcInfo),
+ acc_pred_info(AccTypes, Out, AccProcInfo, OrigPredId, OrigPredInfo,
+ AccProcId, AccPredInfo),
+ AccName = unqualified(pred_info_name(AccPredInfo)),
+
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+ predicate_table_insert(AccPredInfo, AccPredId, PredTable0, PredTable),
+ module_info_set_predicate_table(PredTable, !ModuleInfo),
+ accu_create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
+ HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs, Sets, C, CS,
+ OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal),
+
+ proc_info_get_goal(!.OrigProcInfo, OrigGoal0),
+ accu_top_level(TopLevel, OrigGoal0, OrigBaseGoal, OrigRecGoal,
+ AccBaseGoal, AccRecGoal, OrigGoal, AccGoal),
+
+ proc_info_set_goal(OrigGoal, !OrigProcInfo),
+ proc_info_set_varset(VarSet, !OrigProcInfo),
+ proc_info_set_vartypes(VarTypes, !OrigProcInfo),
+
+ requantify_proc_general(ordinary_nonlocals_no_lambda, !OrigProcInfo),
+ update_accumulator_pred(AccPredId, AccProcId, AccGoal, !ModuleInfo).
+
+%---------------------------------------------------------------------------%
+
+ % Construct a proc_info for the introduced predicate.
+ %
+:- pred acc_proc_info(list(prog_var)::in, prog_varset::in, vartypes::in,
+ accu_substs::in, proc_info::in, list(mer_type)::out, proc_info::out)
+ is det.
+
+acc_proc_info(Accs0, VarSet, VarTypes, Substs, OrigProcInfo,
+ AccTypes, AccProcInfo) :-
+ % ProcInfo Stuff that must change.
+ proc_info_get_headvars(OrigProcInfo, HeadVars0),
+ proc_info_get_argmodes(OrigProcInfo, HeadModes0),
+
+ proc_info_get_inst_varset(OrigProcInfo, InstVarSet),
+ proc_info_get_inferred_determinism(OrigProcInfo, Detism),
+ proc_info_get_goal(OrigProcInfo, Goal),
+ proc_info_get_context(OrigProcInfo, Context),
+ proc_info_get_rtti_varmaps(OrigProcInfo, RttiVarMaps),
+ proc_info_get_is_address_taken(OrigProcInfo, IsAddressTaken),
+ proc_info_get_has_parallel_conj(OrigProcInfo, HasParallelConj),
+ proc_info_get_var_name_remap(OrigProcInfo, VarNameRemap),
+
+ Substs = accu_substs(AccVarSubst, _RecCallSubst, _AssocCallSubst,
+ _UpdateSubst),
+ list.map(map.lookup(AccVarSubst), Accs0, Accs),
+
+ % We place the extra accumulator variables at the start, because placing
+ % them at the end breaks the convention that the last variable of a
+ % function is the output variable.
+ HeadVars = Accs ++ HeadVars0,
+
+ % XXX we don't want to use the inst of the var as it can be more specific
+ % than it should be. ie int_const(1) when it should be any integer.
+ % However this will no longer handle partially instantiated data
+ % structures.
+ Inst = ground(shared, none_or_default_func),
+ inst_lists_to_mode_list([Inst], [Inst], Mode),
+ list.duplicate(list.length(Accs), list.det_head(Mode), AccModes),
+ HeadModes = AccModes ++ HeadModes0,
+
+ lookup_var_types(VarTypes, Accs, AccTypes),
+
+ SeqNum = item_no_seq_num,
+ proc_info_create(Context, SeqNum, VarSet, VarTypes, HeadVars,
+ InstVarSet, HeadModes, detism_decl_none, Detism, Goal, RttiVarMaps,
+ IsAddressTaken, HasParallelConj, VarNameRemap, AccProcInfo).
+
+%---------------------------------------------------------------------------%
+
+ % Construct the pred_info for the introduced predicate.
+ %
+:- pred acc_pred_info(list(mer_type)::in, list(prog_var)::in, proc_info::in,
+ pred_id::in, pred_info::in, proc_id::out, pred_info::out) is det.
+
+acc_pred_info(NewTypes, OutVars, NewProcInfo, OrigPredId, OrigPredInfo,
+ NewProcId, NewPredInfo) :-
+ % PredInfo stuff that must change.
+ pred_info_get_arg_types(OrigPredInfo, TypeVarSet, ExistQVars, Types0),
+
+ ModuleName = pred_info_module(OrigPredInfo),
+ Name = pred_info_name(OrigPredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(OrigPredInfo),
+ pred_info_get_context(OrigPredInfo, PredContext),
+ pred_info_get_markers(OrigPredInfo, Markers),
+ pred_info_get_class_context(OrigPredInfo, ClassContext),
+ pred_info_get_origin(OrigPredInfo, OldOrigin),
+ pred_info_get_var_name_remap(OrigPredInfo, VarNameRemap),
+
+ set.init(Assertions),
+
+ proc_info_get_context(NewProcInfo, Context),
+ term.context_line(Context, Line),
+ Counter = 0,
+
+ Types = NewTypes ++ Types0,
+
+ make_pred_name_with_context(ModuleName, "AccFrom", PredOrFunc, Name,
+ Line, Counter, SymName),
+
+ OutVarNums = list.map(term.var_to_int, OutVars),
+ Origin = origin_transformed(transform_accumulator(OutVarNums),
+ OldOrigin, OrigPredId),
+ GoalType = goal_not_for_promise(np_goal_type_none),
+ pred_info_create(ModuleName, SymName, PredOrFunc, PredContext, Origin,
+ pred_status(status_local), Markers, Types, TypeVarSet,
+ ExistQVars, ClassContext, Assertions, VarNameRemap, GoalType,
+ NewProcInfo, NewProcId, NewPredInfo).
+
+%---------------------------------------------------------------------------%
+
+ % create_goal creates the new base and recursive case of the
+ % original procedure (OrigBaseGoal and OrigRecGoal) and the base
+ % and recursive cases of accumulator version (AccBaseGoal and
+ % AccRecGoal).
+ %
+:- pred accu_create_goal(accu_goal_id::in, list(prog_var)::in,
+ pred_id::in, proc_id::in, sym_name::in, accu_substs::in,
+ accu_subst::in, accu_subst::in, accu_base::in,
+ list(pair(prog_var))::in, accu_sets::in,
+ accu_goal_store::in, accu_goal_store::in,
+ hlds_goal::out, hlds_goal::out, hlds_goal::out, hlds_goal::out) is det.
+
+accu_create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
+ HeadToCallSubst, CallToHeadSubst, BaseIds, BasePairs,
+ Sets, C, CS, OrigBaseGoal, OrigRecGoal, AccBaseGoal, AccRecGoal) :-
+ lookup_call(C, RecCallId, stored_goal(OrigCall, _InstMap)),
+ Call = create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName),
+ create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst,
+ BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal),
+ create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs,
+ Sets, C, CS, AccBaseGoal, AccRecGoal).
+
+ % create_acc_call takes the original call and generates a call to the
+ % accumulator version of the call, which can have the substitutions
+ % applied to it easily.
+ %
+:- func create_acc_call(hlds_goal::in(goal_plain_call), list(prog_var)::in,
+ pred_id::in, proc_id::in, sym_name::in) = (hlds_goal::out(goal_plain_call))
+ is det.
+
+create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName) = Call :-
+ OrigCall = hlds_goal(OrigCallExpr, GoalInfo),
+ OrigCallExpr = plain_call(_PredId, _ProcId, Args, Builtin, Context, _Name),
+ CallExpr = plain_call(AccPredId, AccProcId, Accs ++ Args, Builtin,
+ Context, AccName),
+ Call = hlds_goal(CallExpr, GoalInfo).
+
+ % Create the goals which are to replace the original predicate.
+ %
+:- pred create_orig_goal(hlds_goal::in, accu_substs::in,
+ accu_subst::in, accu_subst::in, accu_base::in, accu_sets::in,
+ accu_goal_store::in, hlds_goal::out, hlds_goal::out) is det.
+
+create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst,
+ BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal) :-
+ Substs = accu_substs(_AccVarSubst, _RecCallSubst, _AssocCallSubst,
+ UpdateSubst),
+
+ BaseIds = accu_base(UpdateBase, _AssocBase, _OtherBase),
+ Before = Sets ^ as_before,
+ Update = Sets ^ as_update,
+
+ U = create_new_orig_recursive_goals(UpdateBase, Update,
+ HeadToCallSubst, UpdateSubst, C),
+
+ rename_some_vars_in_goal(CallToHeadSubst, Call, BaseCall),
+ Cbefore = accu_goal_list(set.to_sorted_list(Before), C),
+ Uupdate = accu_goal_list(set.to_sorted_list(UpdateBase) ++
+ set.to_sorted_list(Update), U),
+ Cbase = accu_goal_list(base_case_ids(C), C),
+ calculate_goal_info(conj(plain_conj, Cbefore ++ Uupdate ++ [BaseCall]),
+ OrigRecGoal),
+ calculate_goal_info(conj(plain_conj, Cbase), OrigBaseGoal).
+
+ % Create the goals which are to go in the new accumulator version
+ % of the predicate.
+ %
+:- pred create_acc_goal(hlds_goal::in, accu_substs::in, accu_subst::in,
+ accu_base::in, list(pair(prog_var))::in, accu_sets::in,
+ accu_goal_store::in, accu_goal_store::in,
+ hlds_goal::out, hlds_goal::out) is det.
+
+create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs, Sets,
+ C, CS, AccBaseGoal, AccRecGoal) :-
+ Substs = accu_substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ UpdateSubst),
+
+ BaseIds = accu_base(_UpdateBase, AssocBase, OtherBase),
+ Sets = accu_sets(Before, Assoc, ConstructAssoc, Construct, Update,
+ _Reject),
+
+ rename_some_vars_in_goal(RecCallSubst, Call, RecCall),
+
+ Cbefore = accu_goal_list(set.to_sorted_list(Before), C),
+
+ % Create the goals which will be used in the new recursive case.
+ R = create_new_recursive_goals(Assoc, Construct `union` ConstructAssoc,
+ Update, AssocCallSubst, AccVarSubst, UpdateSubst, C, CS),
+
+ Rassoc = accu_goal_list(set.to_sorted_list(Assoc), R),
+ Rupdate = accu_goal_list(set.to_sorted_list(Update), R),
+ Rconstruct = accu_goal_list(set.to_sorted_list(Construct `union`
+ ConstructAssoc), R),
+
+ % Create the goals which will be used in the new base case.
+ B = create_new_base_goals(Assoc `union` Construct `union`
+ ConstructAssoc, C, AccVarSubst, HeadToCallSubst),
+ Bafter = set.to_sorted_list(Assoc `union`
+ Construct `union` ConstructAssoc),
+
+ BaseCase = accu_goal_list(set.to_sorted_list(AssocBase `union` OtherBase)
+ ++ Bafter, B),
+
+ list.map(acc_unification, BasePairs, UpdateBase),
+
+ calculate_goal_info(conj(plain_conj, Cbefore ++ Rassoc ++ Rupdate
+ ++ [RecCall] ++ Rconstruct), AccRecGoal),
+ calculate_goal_info(conj(plain_conj, UpdateBase ++ BaseCase), AccBaseGoal).
+
+ % Create the U set of goals (those that will be used in the original
+ % recursive case) by renaming all the goals which are used to initialize
+ % the update state variable using the head_to_call followed by the
+ % update_subst, and rename all the update goals using the update_subst.
+ %
+:- func create_new_orig_recursive_goals(set(accu_goal_id), set(accu_goal_id),
+ accu_subst, accu_subst, accu_goal_store) = accu_goal_store.
+
+create_new_orig_recursive_goals(UpdateBase, Update, HeadToCallSubst,
+ UpdateSubst, C)
+ = accu_rename(set.to_sorted_list(Update), UpdateSubst, C, Ubase) :-
+ Ubase = accu_rename(set.to_sorted_list(UpdateBase),
+ chain_subst(HeadToCallSubst, UpdateSubst), C, goal_store_init).
+
+ % Create the R set of goals (those that will be used in the new
+ % recursive case) by renaming all the members of assoc in CS
+ % using assoc_call_subst and all the members of (construct U
+ % construct_assoc) in C with acc_var_subst.
+ %
+:- func create_new_recursive_goals(set(accu_goal_id), set(accu_goal_id),
+ set(accu_goal_id), accu_subst, accu_subst, accu_subst,
+ accu_goal_store, accu_goal_store) = accu_goal_store.
+
+create_new_recursive_goals(Assoc, Constructs, Update,
+ AssocCallSubst, AccVarSubst, UpdateSubst, C, CS)
+ = accu_rename(set.to_sorted_list(Constructs), AccVarSubst, C, RBase) :-
+ RBase0 = accu_rename(set.to_sorted_list(Assoc), AssocCallSubst, CS,
+ goal_store_init),
+ RBase = accu_rename(set.to_sorted_list(Update), UpdateSubst, C, RBase0).
+
+ % Create the B set of goals (those that will be used in the new base case)
+ % by renaming all the base case goals of C with head_to_call and all the
+ % members of (assoc U construct U construct_assoc) of C with acc_var_subst.
+ %
+:- func create_new_base_goals(set(accu_goal_id), accu_goal_store,
+ accu_subst, accu_subst) = accu_goal_store.
+
+create_new_base_goals(Ids, C, AccVarSubst, HeadToCallSubst)
+ = accu_rename(set.to_sorted_list(Ids), AccVarSubst, C, Bbase) :-
+ Bbase = accu_rename(base_case_ids(C), HeadToCallSubst, C, goal_store_init).
+
+ % acc_unification(O-A, G):
+ %
+ % is true if G represents the assignment unification Out = Acc.
+ %
+:- pred acc_unification(pair(prog_var)::in, hlds_goal::out) is det.
+
+acc_unification(Out - Acc, Goal) :-
+ UnifyMode = unify_modes_li_lf_ri_rf(free, ground_inst,
+ ground_inst, ground_inst),
+ Context = unify_context(umc_explicit, []),
+ Expr = unify(Out, rhs_var(Acc), UnifyMode, assign(Out,Acc), Context),
+ set_of_var.list_to_set([Out, Acc], NonLocalVars),
+ InstMapDelta = instmap_delta_bind_var(Out),
+ goal_info_init(NonLocalVars, InstMapDelta, detism_det, purity_pure, Info),
+ Goal = hlds_goal(Expr, Info).
+
+%---------------------------------------------------------------------------%
+
+ % Given the top level structure of the goal create new version
+ % with new base and recursive cases plugged in.
+ %
+:- pred accu_top_level(top_level::in, hlds_goal::in,
+ hlds_goal::in, hlds_goal::in, hlds_goal::in,
+ hlds_goal::in, hlds_goal::out, hlds_goal::out) is det.
+
+accu_top_level(TopLevel, Goal, OrigBaseGoal, OrigRecGoal,
+ NewBaseGoal, NewRecGoal, OrigGoal, NewGoal) :-
+ (
+ TopLevel = switch_base_rec,
+ ( if
+ Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo),
+ Cases0 = [case(IdA, [], _), case(IdB, [], _)]
+ then
+ OrigCases = [case(IdA, [], OrigBaseGoal),
+ case(IdB, [], OrigRecGoal)],
+ OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo),
+
+ NewCases = [case(IdA, [], NewBaseGoal), case(IdB, [], NewRecGoal)],
+ NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo)
+ else
+ unexpected($pred, "not the correct top level")
+ )
+ ;
+ TopLevel = switch_rec_base,
+ ( if
+ Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo),
+ Cases0 = [case(IdA, [], _), case(IdB, [], _)]
+ then
+ OrigCases = [case(IdA, [], OrigRecGoal),
+ case(IdB, [], OrigBaseGoal)],
+ OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo),
+
+ NewCases = [case(IdA, [], NewRecGoal), case(IdB, [], NewBaseGoal)],
+ NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo)
+ else
+ unexpected($pred, "not the correct top level")
+ )
+ ;
+ TopLevel = disj_base_rec,
+ ( if
+ Goal = hlds_goal(disj(Goals), GoalInfo),
+ Goals = [_, _]
+ then
+ OrigGoals = [OrigBaseGoal, OrigRecGoal],
+ OrigGoal = hlds_goal(disj(OrigGoals), GoalInfo),
+
+ NewGoals = [NewBaseGoal, NewRecGoal],
+ NewGoal = hlds_goal(disj(NewGoals), GoalInfo)
+ else
+ unexpected($pred, "not the correct top level")
+ )
+ ;
+ TopLevel = disj_rec_base,
+ ( if
+ Goal = hlds_goal(disj(Goals), GoalInfo),
+ Goals = [_, _]
+ then
+ OrigGoals = [OrigRecGoal, OrigBaseGoal],
+ OrigGoal = hlds_goal(disj(OrigGoals), GoalInfo),
+
+ NewGoals = [NewRecGoal, NewBaseGoal],
+ NewGoal = hlds_goal(disj(NewGoals), GoalInfo)
+ else
+ unexpected($pred, "not the correct top level")
+ )
+ ;
+ TopLevel = ite_base_rec,
+ ( if Goal = hlds_goal(if_then_else(Vars, Cond, _, _), GoalInfo) then
+ OrigGoal = hlds_goal(if_then_else(Vars, Cond,
+ OrigBaseGoal, OrigRecGoal), GoalInfo),
+ NewGoal = hlds_goal(if_then_else(Vars, Cond,
+ NewBaseGoal, NewRecGoal), GoalInfo)
+ else
+ unexpected($pred, "not the correct top level")
+ )
+ ;
+ TopLevel = ite_rec_base,
+ ( if Goal = hlds_goal(if_then_else(Vars, Cond, _, _), GoalInfo) then
+ OrigGoal = hlds_goal(if_then_else(Vars, Cond,
+ OrigRecGoal, OrigBaseGoal), GoalInfo),
+ NewGoal = hlds_goal(if_then_else(Vars, Cond,
+ NewRecGoal, NewBaseGoal), GoalInfo)
+ else
+ unexpected($pred, "not the correct top level")
+ )
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % Place the accumulator version of the predicate in the HLDS.
+ %
+:- pred update_accumulator_pred(pred_id::in, proc_id::in,
+ hlds_goal::in, module_info::in, module_info::out) is det.
+
+update_accumulator_pred(NewPredId, NewProcId, AccGoal, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, NewPredId, NewProcId,
+ PredInfo, ProcInfo0),
+ proc_info_set_goal(AccGoal, ProcInfo0, ProcInfo1),
+ requantify_proc_general(ordinary_nonlocals_no_lambda, ProcInfo1, ProcInfo),
+ module_info_set_pred_proc_info(NewPredId, NewProcId,
+ PredInfo, ProcInfo, !ModuleInfo).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+ % accu_rename(Ids, Subst, From, Initial):
+ %
+ % Return a goal_store, Final, which is the result of looking up each
+ % member of set of goal_ids, Ids, in the goal_store, From, applying
+ % the substitution and then storing the goal into the goal_store, Initial.
+ %
+:- func accu_rename(list(accu_goal_id), accu_subst,
+ accu_goal_store, accu_goal_store) = accu_goal_store.
+
+accu_rename(Ids, Subst, From, Initial) = Final :-
+ list.foldl(
+ ( pred(Id::in, GS0::in, GS::out) is det :-
+ goal_store_lookup(From, Id, stored_goal(Goal0, InstMap)),
+ rename_some_vars_in_goal(Subst, Goal0, Goal),
+ goal_store_det_insert(Id, stored_goal(Goal, InstMap), GS0, GS)
+ ), Ids, Initial, Final).
+
+ % Return all the goal_ids which belong in the base case.
+ %
+:- func base_case_ids(accu_goal_store) = list(accu_goal_id).
+
+base_case_ids(GS) = Base :-
+ solutions.solutions(
+ ( pred(Key::out) is nondet :-
+ goal_store_member(GS, Key, _Goal),
+ Key = accu_goal_id(accu_base, _)
+ ), Base).
+
+:- func base_case_ids_set(accu_goal_store) = set(accu_goal_id).
+
+base_case_ids_set(GS) = set.list_to_set(base_case_ids(GS)).
+
+ % Given a list of goal_ids, return the list of hlds_goals from
+ % the goal_store.
+ %
+:- func accu_goal_list(list(accu_goal_id), accu_goal_store) = list(hlds_goal).
+
+accu_goal_list(Ids, GS) = Goals :-
+ list.map(
+ ( pred(Key::in, G::out) is det :-
+ goal_store_lookup(GS, Key, stored_goal(G, _))
+ ), Ids, Goals).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- pred calculate_goal_info(hlds_goal_expr::in, hlds_goal::out) is det.
+
+calculate_goal_info(GoalExpr, hlds_goal(GoalExpr, GoalInfo)) :-
+ ( if GoalExpr = conj(plain_conj, GoalList) then
+ goal_list_nonlocals(GoalList, NonLocals),
+ goal_list_instmap_delta(GoalList, InstMapDelta),
+ goal_list_determinism(GoalList, Detism),
+
+ goal_info_init(NonLocals, InstMapDelta, Detism, purity_pure, GoalInfo)
+ else
+ unexpected($pred, "not a conj")
+ ).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- func chain_subst(accu_subst, accu_subst) = accu_subst.
+
+chain_subst(AtoB, BtoC) = AtoC :-
+ map.keys(AtoB, Keys),
+ chain_subst_2(Keys, AtoB, BtoC, AtoC).
+
+:- pred chain_subst_2(list(A)::in, map(A, B)::in, map(B, C)::in,
+ map(A, C)::out) is det.
+
+chain_subst_2([], _, _, AtoC) :-
+ map.init(AtoC).
+chain_subst_2([A | As], AtoB, BtoC, AtoC) :-
+ chain_subst_2(As, AtoB, BtoC, AtoC0),
+ map.lookup(AtoB, A, B),
+ ( if map.search(BtoC, B, C) then
+ map.det_insert(A, C, AtoC0, AtoC)
+ else
+ AtoC = AtoC0
+ ).
+
+%---------------------------------------------------------------------------%
+:- end_module transform_hlds.accumulator.
+%---------------------------------------------------------------------------%
+
+:- some [T] pred unravel_univ(univ::in, T::out) is det.
+:- pragma foreign_export("C", unravel_univ(in, out), "ML_unravel_univ").
+:- pragma foreign_export("C#", unravel_univ(in, out), "ML_unravel_univ").
+:- pragma foreign_export("Java", unravel_univ(in, out), "ML_unravel_univ").
+
+unravel_univ(Univ, X) :-
+ univ_value(Univ) = X.
diff --git a/test/manual/etags/rs-src/test.rs b/test/manual/etags/rs-src/test.rs
new file mode 100644
index 00000000000..081d0d7d4df
--- /dev/null
+++ b/test/manual/etags/rs-src/test.rs
@@ -0,0 +1,14 @@
+mod test;
+
+enum IpAddrKind {
+ V4,
+ V6,
+}
+
+fn test1() {
+ println!("Testing");
+}
+
+fn main() {
+ test::test1();
+}
diff --git a/test/manual/image-circular-tests.el b/test/manual/image-circular-tests.el
index 3d1d23234b7..7abb94dee6e 100644
--- a/test/manual/image-circular-tests.el
+++ b/test/manual/image-circular-tests.el
@@ -1,4 +1,4 @@
-;;; image-circular-tests.el --- test image functions with circular objects
+;;; image-circular-tests.el --- test image functions with circular objects -*- lexical-binding: t; -*-
;; Copyright (C) 2019, 2021 Free Software Foundation, Inc.
diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el
index 489b3972932..44846a7a67a 100644
--- a/test/manual/image-size-tests.el
+++ b/test/manual/image-size-tests.el
@@ -1,4 +1,4 @@
-;;; image-size-tests.el -- tests for image scaling
+;;; image-size-tests.el --- tests for image scaling -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
@@ -45,7 +45,8 @@
(= (cdr size) height))))
(defun image-size-tests ()
- (unless (imagemagick-types)
+ (unless (and (fboundp 'imagemagick-types)
+ (imagemagick-types))
(error "This only makes sense if ImageMagick is installed"))
;; Test the image that's wider than it is tall.
;; Default sizes.
diff --git a/test/manual/image-transforms-tests.el b/test/manual/image-transforms-tests.el
index 5342b5edcae..debb74f2edb 100644
--- a/test/manual/image-transforms-tests.el
+++ b/test/manual/image-transforms-tests.el
@@ -1,4 +1,4 @@
-;;; image-transform-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*-
+;;; image-transforms-tests.el --- Test suite for image transforms. -*- lexical-binding: t -*-
;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
new file mode 100644
index 00000000000..9053a8743e4
--- /dev/null
+++ b/test/manual/indent/scheme.scm
@@ -0,0 +1,23 @@
+;; Testing sexp-comments
+
+(define a #;(hello) there)
+
+(define a #;1 there)
+
+(define a #;"asdf" there)
+
+(define a ;; #;(hello
+ there)
+
+(define a #;(hello
+ there) 2)
+
+(define a #;(hello
+ #;(world))
+ and)
+ there) 2)
+
+(define a #;(hello
+ #;"asdf" (world
+ and)
+ there) 2)
diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss
index 189ec4e22ac..2cd4adb8d55 100644
--- a/test/manual/indent/scss-mode.scss
+++ b/test/manual/indent/scss-mode.scss
@@ -1,5 +1,7 @@
// Comment!
+@use "sass:math";
+
nav {
ul {
margin: 0; /* More comment */
@@ -44,8 +46,8 @@ article[role="main"] {
$var_with_underscores: #fff;
$_var-starting-with-underscore: none;
float: left !important;
- width: 600px / 888px * 100%;
- height: 100px / 888px * 100%;
+ width: math.div(600px, 888px) * 100%;
+ height: math.div(100px, 888px) * 100%;
color: $var_with_underscores;
display: $_var-starting-with-underscore;
}
diff --git a/test/manual/redisplay-testsuite.el b/test/manual/redisplay-testsuite.el
index 48f3788b54e..8e90f2d7a5c 100644
--- a/test/manual/redisplay-testsuite.el
+++ b/test/manual/redisplay-testsuite.el
@@ -1,4 +1,4 @@
-;;; redisplay-testsuite.el --- Test suite for redisplay.
+;;; redisplay-testsuite.el --- Test suite for redisplay. -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el
index 2f40b2bb696..dd15d54fa88 100644
--- a/test/manual/scroll-tests.el
+++ b/test/manual/scroll-tests.el
@@ -1,4 +1,4 @@
-;;; scroll-tests.el -- tests for scrolling -*- lexical-binding: t -*-
+;;; scroll-tests.el --- tests for scrolling -*- lexical-binding: t -*-
;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
diff --git a/test/misc/test-custom-deps.el b/test/misc/test-custom-deps.el
new file mode 100644
index 00000000000..f072adddcb0
--- /dev/null
+++ b/test/misc/test-custom-deps.el
@@ -0,0 +1,42 @@
+;;; test-custom-deps.el --- Test custom deps -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The command `cus-test-deps' loads all (!) custom dependencies and
+;; reports about load errors.
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-deps custom-test-admin-cus-test)
+(defvar cus-test-deps-errors) ; from admin/cus-tests.el
+
+(ert-deftest test-custom-deps ()
+ :tags '(:expensive-test)
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (cus-test-deps)
+ (should-not cus-test-deps-errors))
+
+;;; test-custom-deps.el ends here
diff --git a/test/misc/test-custom-libs.el b/test/misc/test-custom-libs.el
new file mode 100644
index 00000000000..cc2be99dea8
--- /dev/null
+++ b/test/misc/test-custom-libs.el
@@ -0,0 +1,48 @@
+;;; test-custom-libs.el --- Test custom loads -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file runs for all libraries with autoloads separate emacs
+;; processes of the form "emacs -batch -l LIB".
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-libs custom-test-admin-cus-test)
+(defvar cus-test-libs-errors) ; from admin/cus-tests.el
+
+;; FIXME: Currently fails for:
+;; - lisp/term/ns-win.el
+;; - lisp/org/org-num.el
+(ert-deftest test-custom-libs ()
+ :tags '(:expensive-test)
+ :expected-result :failed ; FIXME: See above.
+ ;; This test is very slow, and IMO not worth the time it takes.
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (cus-test-libs t)
+ (should-not cus-test-libs-errors))
+
+;;; test-custom-deps.el ends here
diff --git a/test/misc/test-custom-noloads.el b/test/misc/test-custom-noloads.el
new file mode 100644
index 00000000000..5e95e7d7740
--- /dev/null
+++ b/test/misc/test-custom-noloads.el
@@ -0,0 +1,45 @@
+;;; test-custom-noloads.el --- Test custom noloads -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The command `cus-test-noloads' returns a list of variables which
+;; are somewhere declared as custom options, but not loaded by
+;; `custom-load-symbol'.
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-noloads custom-test-admin-cus-test)
+(defvar cus-test-vars-not-cus-loaded) ; from admin/cus-tests.el
+
+;; FIXME: Multiple failures here.
+(ert-deftest custom-test-load ()
+ :tags '(:expensive-test :unstable)
+ :expected-result :failed ; FIXME: See above.
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (cus-test-noloads)
+ (should-not cus-test-vars-not-cus-loaded))
+
+;;; test-custom-noloads.el ends here
diff --git a/test/misc/test-custom-opts.el b/test/misc/test-custom-opts.el
new file mode 100644
index 00000000000..fa6b9e66aef
--- /dev/null
+++ b/test/misc/test-custom-opts.el
@@ -0,0 +1,39 @@
+;;; test-custom-opts.el --- Test custom opts -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The command `cus-test-opts' tests many (all?) custom options.
+
+;;; Code:
+
+(require 'ert)
+
+(defconst custom-test-admin-cus-test
+ (expand-file-name "admin/cus-test.el" source-directory))
+
+(declare-function cus-test-opts custom-test-admin-cus-test)
+
+(ert-deftest check-for-wrong-custom-opts ()
+ :tags '(:expensive-test)
+ (skip-unless (file-readable-p custom-test-admin-cus-test))
+ (load custom-test-admin-cus-test)
+ (should (null (cus-test-opts t))))
+
+;;; test-custom-opts.el ends here
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 123f2e8eabb..118311c4d26 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -754,7 +754,7 @@ with parameters from the *Messages* buffer modification."
(should-length 2 (overlays-in 1 (point-max)))
(should-length 1 (overlays-in (point-max) (point-max)))
(narrow-to-region 1 50)
- (should-length 0 (overlays-in 1 (point-max)))
+ (should-length 1 (overlays-in 1 (point-max)))
(should-length 1 (overlays-in (point-max) (point-max))))))
@@ -1345,8 +1345,8 @@ with parameters from the *Messages* buffer modification."
(add-hook 'kill-buffer-hook kbh nil t)
(add-hook 'kill-buffer-query-functions kbqf nil t)
(kill-buffer))
- (with-temp-buffer)
- (with-output-to-string)
+ (with-temp-buffer (ignore))
+ (with-output-to-string (ignore))
(should-not run-bluh)
(should-not run-kbh)
(should-not run-kbqf)
@@ -1361,4 +1361,63 @@ with parameters from the *Messages* buffer modification."
(should run-kbqf))
(remove-hook 'buffer-list-update-hook bluh))))
+(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
+ "Indirect buffers do not call `get-buffer-create'."
+ (dolist (inhibit '(nil t))
+ (let ((base (get-buffer-create "foo" inhibit)))
+ (unwind-protect
+ (dotimes (_i 11)
+ (let* (flag*
+ (flag (lambda () (prog1 t (setq flag* t))))
+ (indirect (make-indirect-buffer base "foo[indirect]" nil
+ inhibit)))
+ (unwind-protect
+ (progn
+ (with-current-buffer indirect
+ (add-hook 'kill-buffer-query-functions flag nil t))
+ (kill-buffer indirect)
+ (if inhibit
+ (should-not flag*)
+ (should flag*)))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p indirect)
+ (kill-buffer indirect))))))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p base)
+ (kill-buffer base)))))))
+
+(ert-deftest zero-length-overlays-and-not ()
+ (with-temp-buffer
+ (insert "hello")
+ (let ((long-overlay (make-overlay 2 4))
+ (zero-overlay (make-overlay 3 3)))
+ ;; Exclude.
+ (should (= (length (overlays-at 3)) 1))
+ (should (eq (car (overlays-at 3)) long-overlay))
+ ;; Include.
+ (should (= (length (overlays-in 3 3)) 2))
+ (should (memq long-overlay (overlays-in 3 3)))
+ (should (memq zero-overlay (overlays-in 3 3))))))
+
+(ert-deftest test-remove-overlays ()
+ (with-temp-buffer
+ (insert "foo")
+ (make-overlay (point) (point))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0)))
+
+ (with-temp-buffer
+ (insert "foo")
+ (goto-char 2)
+ (make-overlay (point) (point))
+ ;; We only count zero-length overlays at the end of the buffer.
+ (should (= (length (overlays-in 1 2)) 0))
+ (narrow-to-region 1 2)
+ ;; We've now narrowed, so the zero-length overlay is at the end of
+ ;; the (accessible part of the) buffer.
+ (should (= (length (overlays-in 1 2)) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/character-tests.el b/test/src/character-tests.el
new file mode 100644
index 00000000000..f630b32a5ee
--- /dev/null
+++ b/test/src/character-tests.el
@@ -0,0 +1,45 @@
+;;; character-tests.el --- tests for character.c -*- lexical-binding:t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest character-test-string-width ()
+ "Test `string-width' with and without compositions."
+ (should (= (string-width "1234") 4))
+ (should (= (string-width "12\t34") (+ 4 tab-width)))
+ (should (= (string-width "áëòç") 4))
+ (should (= (string-width "áëòç") 4))
+ (should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
+ (should (= (string-width "1234" 1 3) 2))
+ (should (= (string-width "1234" nil -1) 3))
+ (should (= (string-width "1234" 2) 2))
+ (should-error (string-width "1234" nil 5))
+ (should-error (string-width "1234" -5))
+ (should (= (string-width "12\t34") (+ 4 tab-width)))
+ (should (= (string-width "1234\t56") (+ 6 tab-width)))
+ (should (= (string-width "áëòç") 4))
+ (should (= (string-width "áëòç" nil 3) 3))
+ (should (= (string-width "áëòç" 1 3) 2))
+ (should (= (string-width "áëòç" nil 2) 1))
+ (should (= (string-width "áëòç" nil 3) 2))
+ (should (= (string-width "áëòç" nil 4) 2))
+ (should (= (string-width "הַרְבֵּה אַהֲבָה") 9))
+ (should (= (string-width "הַרְבֵּה אַהֲבָה" nil 8) 4)))
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 0bdcff22ce5..134f5676709 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -56,7 +56,7 @@
(set-buffer-multibyte nil)
(insert (encode-coding-string "あ" 'euc-jp) "\xd" "\n")
(decode-coding-region (point-min) (point-max) 'euc-jp-dos)
- (should-not (string-match-p "\^M" (buffer-string)))))
+ (should-not (string-search "\^M" (buffer-string)))))
;; Return the contents (specified by CONTENT-TYPE; ascii, latin, or
;; binary) of a test file.
@@ -359,7 +359,7 @@
(delete-region (point-min) (point))))))
(defun benchmark-decoder ()
- (let ((gc-cons-threshold 4000000))
+ (let ((gc-cons-threshold (max gc-cons-threshold 4000000)))
(insert "Without optimization:\n")
(dolist (files test-file-list)
(dolist (file (cdr files))
diff --git a/test/src/comp-resources/comp-test-45603.el b/test/src/comp-resources/comp-test-45603.el
new file mode 100644
index 00000000000..f1c0dafb68d
--- /dev/null
+++ b/test/src/comp-resources/comp-test-45603.el
@@ -0,0 +1,28 @@
+;;; -*- lexical-binding: t; -*-
+
+;; Reduced from ivy.el.
+
+(defvar comp-test-45603-last)
+(defvar comp-test-45603-mark-prefix)
+(defvar comp-test-45603-directory)
+(defvar comp-test-45603-marked-candidates)
+
+(defun comp-test-45603--call-marked (action)
+ (let* ((prefix-len (length comp-test-45603-mark-prefix))
+ (marked-candidates
+ (mapcar
+ (lambda (s)
+ (let ((cand (substring s prefix-len)))
+ (if comp-test-45603-directory
+ (expand-file-name cand comp-test-45603-directory)
+ cand)))
+ comp-test-45603-marked-candidates))
+ (multi-action (comp-test-45603--get-multi-action comp-test-45603-last)))))
+
+(defalias 'comp-test-45603--file-local-name
+ (if (fboundp 'file-local-name)
+ #'file-local-name
+ (lambda (file)
+ (or (file-remote-p file 'localname) file))))
+
+(provide 'comp-test-45603)
diff --git a/test/src/comp-resources/comp-test-funcs-dyn.el b/test/src/comp-resources/comp-test-funcs-dyn.el
new file mode 100644
index 00000000000..3118455e3f6
--- /dev/null
+++ b/test/src/comp-resources/comp-test-funcs-dyn.el
@@ -0,0 +1,50 @@
+;;; comp-test-funcs-dyn.el --- compilation unit tested by comp-tests.el -*- lexical-binding: nil; -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.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 'cl-lib)
+
+(defun comp-tests-ffuncall-callee-dyn-f (a b)
+ (list a b))
+
+(defun comp-tests-ffuncall-callee-opt-dyn-f (a b &optional c d)
+ (list a b c d))
+
+(defun comp-tests-ffuncall-callee-rest-dyn-f (a b &rest c)
+ (list a b c))
+
+(defun comp-tests-ffuncall-callee-opt-rest-dyn-f (a b &optional c &rest d)
+ (list a b c d))
+
+(defun comp-tests-cl-macro-exp-f ()
+ (cl-loop for xxx in '(a b)
+ for yyy = xxx
+ collect xxx))
+
+(cl-defun comp-tests-cl-uninterned-arg-parse-f (a &optional b &aux)
+ (list a b))
+
+(provide 'comp-test-dyn-funcs)
+
+;;; comp-test-funcs-dyn.el ends here
diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
new file mode 100644
index 00000000000..f2a246320ac
--- /dev/null
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -0,0 +1,710 @@
+;;; comp-test-funcs.el --- compilation unit tested by comp-tests.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.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:
+
+(defvar comp-tests-var1 3)
+
+(defun comp-tests-varref-f ()
+ comp-tests-var1)
+
+(defun comp-tests-list-f ()
+ (list 1 2 3))
+(defun comp-tests-list2-f (a b c)
+ (list a b c))
+(defun comp-tests-car-f (x)
+ ;; Bcar
+ (car x))
+(defun comp-tests-cdr-f (x)
+ ;; Bcdr
+ (cdr x))
+(defun comp-tests-car-safe-f (x)
+ ;; Bcar_safe
+ (car-safe x))
+(defun comp-tests-cdr-safe-f (x)
+ ;; Bcdr_safe
+ (cdr-safe x))
+
+(defun comp-tests-cons-car-f ()
+ (car (cons 1 2)))
+(defun comp-tests-cons-cdr-f (x)
+ (cdr (cons 'foo x)))
+
+(defun comp-tests-hint-fixnum-f (n)
+ (1+ (comp-hint-fixnum n)))
+
+(defun comp-tests-hint-cons-f (c)
+ (car (comp-hint-cons c)))
+
+(defun comp-tests-varset0-f ()
+ (setq comp-tests-var1 55))
+(defun comp-tests-varset1-f ()
+ (setq comp-tests-var1 66)
+ 4)
+
+(defun comp-tests-length-f ()
+ (length '(1 2 3)))
+
+(defun comp-tests-aref-aset-f ()
+ (let ((vec (make-vector 3 0)))
+ (aset vec 2 100)
+ (aref vec 2)))
+
+(defvar comp-tests-var2 3)
+(defun comp-tests-symbol-value-f ()
+ (symbol-value 'comp-tests-var2))
+
+(defun comp-tests-concat-f (x)
+ (concat "a" "b" "c" "d"
+ (concat "a" "b" "c" (concat "a" "b" (concat "foo" x)))))
+
+(defun comp-tests-ffuncall-callee-f (x y z)
+ (list x y z))
+
+(defun comp-tests-ffuncall-callee-optional-f (a b &optional c d)
+ (list a b c d))
+
+(defun comp-tests-ffuncall-callee-rest-f (a b &rest c)
+ (list a b c))
+
+(defun comp-tests-ffuncall-callee-more8-f (p1 p2 p3 p4 p5 p6 p7 p8 p9 p10)
+ ;; More then 8 args.
+ (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10))
+
+(defun comp-tests-ffuncall-callee-more8-rest-f (p1 p2 p3 p4 p5 p6 p7 p8 p9 &rest p10)
+ ;; More then 8 args.
+ (list p1 p2 p3 p4 p5 p6 p7 p8 p9 p10))
+
+(defun comp-tests-ffuncall-native-f ()
+ "Call a primitive with no dedicate op."
+ (make-vector 1 nil))
+
+(defun comp-tests-ffuncall-native-rest-f ()
+ "Call a primitive with no dedicate op with &rest."
+ (vector 1 2 3))
+
+(defun comp-tests-ffuncall-apply-many-f (x)
+ (apply #'list x))
+
+(defun comp-tests-ffuncall-lambda-f (x)
+ (let ((fun (lambda (x)
+ (1+ x))))
+ (funcall fun x)))
+
+(defun comp-tests-jump-table-1-f (x)
+ (pcase x
+ ('x 'a)
+ ('y 'b)
+ (_ 'c)))
+
+(defun comp-tests-jump-table-2-f (x)
+ (pcase x
+ ("aaa" 'a)
+ ("bbb" 'b)))
+
+(defun comp-tests-conditionals-1-f (x)
+ ;; Generate goto-if-nil
+ (if x 1 2))
+(defun comp-tests-conditionals-2-f (x)
+ ;; Generate goto-if-nil-else-pop
+ (when x
+ 1340))
+
+(defun comp-tests-fixnum-1-minus-f (x)
+ ;; Bsub1
+ (1- x))
+(defun comp-tests-fixnum-1-plus-f (x)
+ ;; Badd1
+ (1+ x))
+(defun comp-tests-fixnum-minus-f (x)
+ ;; Bnegate
+ (- x))
+
+(defun comp-tests-eqlsign-f (x y)
+ ;; Beqlsign
+ (= x y))
+(defun comp-tests-gtr-f (x y)
+ ;; Bgtr
+ (> x y))
+(defun comp-tests-lss-f (x y)
+ ;; Blss
+ (< x y))
+(defun comp-tests-les-f (x y)
+ ;; Bleq
+ (<= x y))
+(defun comp-tests-geq-f (x y)
+ ;; Bgeq
+ (>= x y))
+
+(defun comp-tests-setcar-f (x y)
+ (setcar x y)
+ x)
+(defun comp-tests-setcdr-f (x y)
+ (setcdr x y)
+ x)
+
+(defun comp-bubble-sort-f (list)
+ (let ((i (length list)))
+ (while (> i 1)
+ (let ((b list))
+ (while (cdr b)
+ (when (< (cadr b) (car b))
+ (setcar b (prog1 (cadr b)
+ (setcdr b (cons (car b) (cddr b))))))
+ (setq b (cdr b))))
+ (setq i (1- i)))
+ list))
+
+(defun comp-tests-consp-f (x)
+ ;; Bconsp
+ (consp x))
+(defun comp-tests-setcar2-f (x)
+ ;; Bsetcar
+ (setcar x 3))
+
+(defun comp-tests-integerp-f (x)
+ ;; Bintegerp
+ (integerp x))
+(defun comp-tests-numberp-f (x)
+ ;; Bnumberp
+ (numberp x))
+
+(defun comp-tests-discardn-f (x)
+ ;; BdiscardN
+ (1+ (let ((a 1)
+ (_b)
+ (_c))
+ a)))
+(defun comp-tests-insertn-f (a b c d)
+ ;; Binsert
+ (insert a b c d))
+
+(defun comp-tests-err-arith-f ()
+ (/ 1 0))
+(defun comp-tests-err-foo-f ()
+ (error "foo"))
+
+(defun comp-tests-condition-case-0-f ()
+ ;; Bpushhandler Bpophandler
+ (condition-case
+ err
+ (comp-tests-err-arith-f)
+ (arith-error (concat "arith-error "
+ (error-message-string err)
+ " catched"))
+ (error (concat "error "
+ (error-message-string err)
+ " catched"))))
+(defun comp-tests-condition-case-1-f ()
+ ;; Bpushhandler Bpophandler
+ (condition-case
+ err
+ (comp-tests-err-foo-f)
+ (arith-error (concat "arith-error "
+ (error-message-string err)
+ " catched"))
+ (error (concat "error "
+ (error-message-string err)
+ " catched"))))
+(defun comp-tests-catch-f (f)
+ (catch 'foo
+ (funcall f)))
+(defun comp-tests-throw-f (x)
+ (throw 'foo x))
+
+(defun comp-tests-buff0-f ()
+ (with-temp-buffer
+ (insert "foo")
+ (buffer-string)))
+
+(defun comp-tests-lambda-return-f ()
+ (lambda (x) (1+ x)))
+
+(defun comp-tests-fib-f (n)
+ (cond ((= n 0) 0)
+ ((= n 1) 1)
+ (t (+ (comp-tests-fib-f (- n 1))
+ (comp-tests-fib-f (- n 2))))))
+
+(defmacro comp-tests-macro-m (x)
+ x)
+
+(defun comp-tests-string-trim-f (url)
+ (string-trim url))
+
+(defun comp-tests-trampoline-removal-f ()
+ (make-hash-table))
+
+(defun comp-tests-signal-f ()
+ (signal 'foo t))
+
+(defun comp-tests-func-call-removal-f ()
+ (let ((a 10)
+ (b 3))
+ (% a b)))
+
+(defun comp-tests-doc-f ()
+ "A nice docstring"
+ t)
+
+(defun comp-test-interactive-form0-f (dir)
+ (interactive "D")
+ dir)
+
+(defun comp-test-interactive-form1-f (x y)
+ (interactive '(1 2))
+ (+ x y))
+
+(defun comp-test-interactive-form2-f ()
+ (interactive))
+
+(defun comp-test-40187-2-f ()
+ 'foo)
+
+(defalias 'comp-test-40187-1-f (symbol-function 'comp-test-40187-2-f))
+
+(defun comp-test-40187-2-f ()
+ 'bar)
+
+(defun comp-test-speed--1-f ()
+ (declare (speed -1))
+ 3)
+
+(defun comp-test-42360-f (str end-column
+ &optional start-column padding ellipsis
+ ellipsis-text-property)
+ ;; From `truncate-string-to-width'. A large enough function to
+ ;; potentially use all registers and that is modifying local
+ ;; variables inside condition-case.
+ (let ((str-len (length str))
+ (str-width 14)
+ (ellipsis-width 3)
+ (idx 0)
+ (column 0)
+ (head-padding "") (tail-padding "")
+ ch last-column last-idx from-idx)
+ (condition-case nil
+ (while (< column start-column)
+ (setq ch (aref str idx)
+ column (+ column (char-width ch))
+ idx (1+ idx)))
+ (args-out-of-range (setq idx str-len)))
+ (if (< column start-column)
+ (if padding (make-string end-column padding) "")
+ (when (and padding (> column start-column))
+ (setq head-padding (make-string (- column start-column) padding)))
+ (setq from-idx idx)
+ (when (>= end-column column)
+ (condition-case nil
+ (while (< column end-column)
+ (setq last-column column
+ last-idx idx
+ ch (aref str idx)
+ column (+ column (char-width ch))
+ idx (1+ idx)))
+ (args-out-of-range (setq idx str-len)))
+ (when (> column end-column)
+ (setq column last-column
+ idx last-idx))
+ (when (and padding (< column end-column))
+ (setq tail-padding (make-string (- end-column column) padding))))
+ (if (and ellipsis-text-property
+ (not (equal ellipsis ""))
+ idx)
+ (concat head-padding
+ (substring str from-idx idx)
+ (propertize (substring str idx) 'display (or ellipsis "")))
+ (concat head-padding (substring str from-idx idx)
+ tail-padding ellipsis)))))
+
+(defun comp-test-primitive-advice-f (x y)
+ (declare (speed 2))
+ (+ x y))
+
+(defun comp-test-primitive-redefine-f (x y)
+ (declare (speed 2))
+ (- x y))
+
+(defsubst comp-test-defsubst-f ()
+ t)
+
+(defvar comp-test-and-3-var 1)
+(defun comp-test-and-3-f (x)
+ (and (atom x)
+ comp-test-and-3-var
+ 2))
+
+(defun comp-test-copy-insn-f (insn)
+ ;; From `comp-copy-insn'.
+ (if (consp insn)
+ (let (result)
+ (while (consp insn)
+ (let ((newcar (car insn)))
+ (if (or (consp (car insn)) (comp-mvar-p (car insn)))
+ (setf newcar (comp-copy-insn (car insn))))
+ (push newcar result))
+ (setf insn (cdr insn)))
+ (nconc (nreverse result)
+ (if (comp-mvar-p insn) (comp-copy-insn insn) insn)))
+ (if (comp-mvar-p insn)
+ (copy-comp-mvar insn)
+ insn)))
+
+(defun comp-test-cond-rw-1-1-f ())
+
+(defun comp-test-cond-rw-1-2-f ()
+ (let ((it (comp-test-cond-rw-1-1-f))
+ (key 't))
+ (if (or (equal it key)
+ (eq key t))
+ it
+ nil)))
+
+(defun comp-test-44968-f (start end)
+ (let ((dirlist)
+ (dir (expand-file-name start))
+ (end (expand-file-name end)))
+ (while (not (or (equal dir (car dirlist))
+ (file-equal-p dir end)))
+ (push dir dirlist)
+ (setq dir (directory-file-name (file-name-directory dir))))
+ (nreverse dirlist)))
+
+(defun comp-test-45342-f (n)
+ (pcase n
+ (1 " ➊") (2 " ➋") (3 " ➌") (4 " ➍") (5 " ➎") (6 " ➏")
+ (7 " ➐") (8 " ➑") (9 " ➒") (10 " ➓") (_ "")))
+
+(defun comp-test-assume-double-neg-f (collection value)
+ ;; Reduced from `auth-source-search-collection'.
+ (when (atom collection)
+ (setq collection (list collection)))
+ (or (eq value t)
+ ;; value is (not (member t))
+ (eq collection value)
+ ;; collection is t, not (member t)!
+ (member value collection)))
+
+(defun comp-test-assume-in-loop-1-f (arg)
+ ;; Reduced from `comint-delim-arg'.
+ (let ((args nil)
+ (pos 0)
+ (len (length arg)))
+ (while (< pos len)
+ (let ((start pos))
+ (while (< pos len)
+ (setq pos (1+ pos)))
+ (setq args (cons (substring arg start pos) args))))
+ args))
+
+(defun comp-test-45376-1-f ()
+ ;; Reduced from `eshell-ls-find-column-lengths'.
+ (let* (res
+ (len 2)
+ (i 0)
+ (j 0))
+ (while (< j len)
+ (if (= i len)
+ (setq i 0))
+ (setq res (cons i res)
+ j (1+ j)
+ i (1+ i)))
+ res))
+
+(defun comp-test-45376-2-f ()
+ ;; Also reduced from `eshell-ls-find-column-lengths'.
+ (let* ((x 1)
+ res)
+ (while x
+ (let* ((y 4)
+ (i 0))
+ (while (> y 0)
+ (when (= i x)
+ (setq i 0))
+ (setf res (cons i res))
+ (setq y (1- y)
+ i (1+ i)))
+ (if (>= x 3)
+ (setq x nil)
+ (setq x (1+ x)))))
+ res))
+
+(defun comp-test-not-cons-f (x)
+ ;; Reduced from `cl-copy-list'.
+ (if (consp x)
+ (print x)
+ (car x)))
+
+(defun comp-test-45576-f ()
+ ;; Reduced from `eshell-find-alias-function'.
+ (let ((sym (intern-soft "eval")))
+ (if (and (functionp sym)
+ '(eshell-ls eshell-pred eshell-prompt eshell-script
+ eshell-term eshell-unix))
+ sym)))
+
+(defun comp-test-45635-f (&rest args)
+ ;; Reduced from `set-face-attribute'.
+ (let ((spec args)
+ family)
+ (while spec
+ (cond ((eq (car spec) :family)
+ (setq family (cadr spec))))
+ (setq spec (cddr spec)))
+ (when (and (stringp family)
+ (string-match "\\([^-]*\\)-\\([^-]*\\)" family))
+ (setq family (match-string 2 family)))
+ (when (or (stringp family)
+ (eq family 'unspecified))
+ family)))
+
+(defun comp-test-46670-1-f (_)
+ "foo")
+
+(defun comp-test-46670-2-f (s)
+ (and (equal (comp-test-46670-1-f (length s)) s)
+ s))
+
+(cl-defun comp-test-46824-1-f ()
+ (let ((next-repos '(1)))
+ (while t
+ (let ((recipe (car next-repos)))
+ (cl-block loop
+ (while t
+ (let ((err
+ (condition-case e
+ (progn
+ (setq next-repos
+ (cdr next-repos))
+ (cl-return-from loop))
+ (error e))))
+ (format "%S"
+ (error-message-string err))))))
+ (cl-return-from comp-test-46824-1-f))))
+
+(defun comp-test-47868-1-f ()
+ " ")
+
+(defun comp-test-47868-2-f ()
+ #(" " 0 1 (face font-lock-keyword-face)))
+
+(defun comp-test-47868-3-f ()
+ " ")
+
+(defun comp-test-47868-4-f ()
+ #(" " 0 1 (face font-lock-keyword-face)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;
+;; Tromey's tests ;;
+;;;;;;;;;;;;;;;;;;;;
+
+;; Test Bconsp.
+(defun comp-test-consp (x) (consp x))
+
+;; Test Blistp.
+(defun comp-test-listp (x) (listp x))
+
+;; Test Bstringp.
+(defun comp-test-stringp (x) (stringp x))
+
+;; Test Bsymbolp.
+(defun comp-test-symbolp (x) (symbolp x))
+
+;; Test Bintegerp.
+(defun comp-test-integerp (x) (integerp x))
+
+;; Test Bnumberp.
+(defun comp-test-numberp (x) (numberp x))
+
+;; Test Badd1.
+(defun comp-test-add1 (x) (1+ x))
+
+;; Test Bsub1.
+(defun comp-test-sub1 (x) (1- x))
+
+;; Test Bneg.
+(defun comp-test-negate (x) (- x))
+
+;; Test Bnot.
+(defun comp-test-not (x) (not x))
+
+;; Test Bbobp, Beobp, Bpoint, Bpoint_min, Bpoint_max.
+(defun comp-test-bobp () (bobp))
+(defun comp-test-eobp () (eobp))
+(defun comp-test-point () (point))
+(defun comp-test-point-min () (point-min))
+(defun comp-test-point-max () (point-max))
+
+;; Test Bcar and Bcdr.
+(defun comp-test-car (x) (car x))
+(defun comp-test-cdr (x) (cdr x))
+
+;; Test Bcar_safe and Bcdr_safe.
+(defun comp-test-car-safe (x) (car-safe x))
+(defun comp-test-cdr-safe (x) (cdr-safe x))
+
+;; Test Beq.
+(defun comp-test-eq (x y) (eq x y))
+
+;; Test Bgotoifnil.
+(defun comp-test-if (x y) (if x x y))
+
+;; Test Bgotoifnilelsepop.
+(defun comp-test-and (x y) (and x y))
+
+;; Test Bgotoifnonnilelsepop.
+(defun comp-test-or (x y) (or x y))
+
+;; Test Bsave_excursion.
+(defun comp-test-save-excursion ()
+ (save-excursion
+ (insert "XYZ")))
+
+;; Test Bcurrent_buffer.
+(defun comp-test-current-buffer () (current-buffer))
+
+;; Test Bgtr.
+(defun comp-test-> (a b)
+ (> a b))
+
+;; Test Bpushcatch.
+(defun comp-test-catch (&rest l)
+ (catch 'done
+ (dolist (v l)
+ (when (> v 23)
+ (throw 'done v)))))
+
+;; Test Bmemq.
+(defun comp-test-memq (val list)
+ (memq val list))
+
+;; Test BlistN.
+(defun comp-test-listN (x)
+ (list x x x x x x x x x x x x x x x x))
+
+;; Test BconcatN.
+(defun comp-test-concatN (x)
+ (concat x x x x x x))
+
+;; Test optional and rest arguments.
+(defun comp-test-opt-rest (a &optional b &rest c)
+ (list a b c))
+
+;; Test for too many arguments.
+(defun comp-test-opt (a &optional b)
+ (cons a b))
+
+;; Test for unwind-protect.
+(defvar comp-test-up-val nil)
+(defun comp-test-unwind-protect (fun)
+ (setq comp-test-up-val nil)
+ (unwind-protect
+ (progn
+ (setq comp-test-up-val 23)
+ (funcall fun)
+ (setq comp-test-up-val 24))
+ (setq comp-test-up-val 999)))
+
+;; Non tested functions that proved just to be difficult to compile.
+
+(defun comp-test-callee (_ __) t)
+(defun comp-test-silly-frame1 (x)
+ ;; Check robustness against dead code.
+ (cl-case x
+ (0 (comp-test-callee
+ (pcase comp-tests-var1
+ (1 1)
+ (2 2))
+ 3))))
+
+(defun comp-test-silly-frame2 (token)
+ ;; Check robustness against dead code.
+ (while c
+ (cl-case c
+ (?< 1)
+ (?> 2))))
+
+(defun comp-test-big-interactive (filename &optional force arg load)
+ ;; Check non trivial interactive form using `byte-recompile-file'.
+ (interactive
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
+ (derived-mode-p 'emacs-lisp-mode)
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
+ (list (read-file-name (if current-prefix-arg
+ "Byte compile file: "
+ "Byte recompile file: ")
+ file-dir file-name nil)
+ current-prefix-arg)))
+ (let ((dest (byte-compile-dest-file filename))
+ ;; Expand now so we get the current buffer's defaults
+ (filename (expand-file-name filename)))
+ (if (if (file-exists-p dest)
+ ;; File was already compiled
+ ;; Compile if forced to, or filename newer
+ (or force
+ (file-newer-than-file-p filename dest))
+ (and arg
+ (or (eq 0 arg)
+ (y-or-n-p (concat "Compile "
+ filename "? ")))))
+ (progn
+ (if (and noninteractive (not byte-compile-verbose))
+ (message "Compiling %s..." filename))
+ (byte-compile-file filename load))
+ (when load
+ (load (if (file-exists-p dest) dest filename)))
+ 'no-byte-compile)))
+
+(defun comp-test-no-return-1 (x)
+ (while x
+ (error "foo")))
+
+(defun comp-test-no-return-2 (x)
+ (cond
+ ((eql x '2) t)
+ ((error "bar") nil)))
+
+(defun comp-test-no-return-3 ())
+(defun comp-test-no-return-4 (x)
+ (when x
+ (error "foo")
+ (while (comp-test-no-return-3)
+ (comp-test-no-return-3))))
+
+(defun comp-test-=-nan (x)
+ (when (= x 0.0e+NaN)
+ x))
+
+(defun comp-test-=-infinity (x)
+ (when (= x 1.0e+INF)
+ x))
+
+(provide 'comp-test-funcs)
+
+;;; comp-test-funcs.el ends here
diff --git a/test/src/comp-resources/comp-test-pure.el b/test/src/comp-resources/comp-test-pure.el
new file mode 100644
index 00000000000..5c1d2d17472
--- /dev/null
+++ b/test/src/comp-resources/comp-test-pure.el
@@ -0,0 +1,40 @@
+;;; comp-test-pure.el --- compilation unit tested by comp-tests.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.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:
+
+(defun comp-tests-pure-callee-f (x)
+ (1+ x))
+
+(defun comp-tests-pure-caller-f ()
+ (comp-tests-pure-callee-f 3))
+
+(defun comp-tests-pure-fibn-f (a b count)
+ (if (= count 0)
+ b
+ (comp-tests-pure-fibn-f (+ a b) a (- count 1))))
+
+(defun comp-tests-pure-fibn-entry-f ()
+ (comp-tests-pure-fibn-f 1 0 20))
+
+;;; comp-test-pure.el ends here
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
new file mode 100644
index 00000000000..fb9441eb66e
--- /dev/null
+++ b/test/src/comp-tests.el
@@ -0,0 +1,1443 @@
+;;; comp-tests.el --- unit tests for src/comp.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+
+;; Author: Andrea Corallo <akrl@sdf.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for src/comp.c.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'cl-lib)
+
+(defconst comp-test-src (ert-resource-file "comp-test-funcs.el"))
+
+(defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el"))
+
+(when (featurep 'native-compile)
+ (require 'comp)
+ (message "Compiling tests...")
+ (load (native-compile comp-test-src))
+ (load (native-compile comp-test-dyn-src)))
+
+(defmacro comp-deftest (name args &rest docstring-and-body)
+ "Define a test for the native compiler tagging it as :nativecomp."
+ (declare (indent defun)
+ (doc-string 3))
+ `(ert-deftest ,(intern (concat "comp-tests-" (symbol-name name))) ,args
+ :tags '(:nativecomp)
+ ,@docstring-and-body))
+
+
+
+(ert-deftest comp-tests-bootstrap ()
+ "Compile the compiler and load it to compile it-self.
+Check that the resulting binaries do not differ."
+ :tags '(:expensive-test :nativecomp)
+ (let* ((byte+native-compile t) ; FIXME HACK
+ (comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el"
+ (ert-resource-directory)))
+ (comp1-src (make-temp-file "stage1-" nil ".el"))
+ (comp2-src (make-temp-file "stage2-" nil ".el"))
+ ;; Can't use debug symbols.
+ (native-comp-debug 0))
+ (copy-file comp-src comp1-src t)
+ (copy-file comp-src comp2-src t)
+ (let ((load-no-native t))
+ (load (concat comp-src "c") nil nil t t))
+ (should-not (subr-native-elisp-p (symbol-function #'native-compile)))
+ (message "Compiling stage1...")
+ (let* ((t0 (current-time))
+ (comp1-eln (native-compile comp1-src)))
+ (message "Done in %d secs" (float-time (time-since t0)))
+ (load comp1-eln nil nil t t)
+ (should (subr-native-elisp-p (symbol-function 'native-compile)))
+ (message "Compiling stage2...")
+ (let ((t0 (current-time))
+ (comp2-eln (native-compile comp2-src)))
+ (message "Done in %d secs" (float-time (time-since t0)))
+ (message "Comparing %s %s" comp1-eln comp2-eln)
+ (should (= (call-process "cmp" nil nil nil comp1-eln comp2-eln) 0))))))
+
+(comp-deftest provide ()
+ "Testing top level provide."
+ (should (featurep 'comp-test-funcs)))
+
+(comp-deftest varref ()
+ "Testing varref."
+ (should (= (comp-tests-varref-f) 3)))
+
+(comp-deftest list ()
+ "Testing cons car cdr."
+ (should (equal (comp-tests-list-f) '(1 2 3)))
+ (should (equal (comp-tests-list2-f 1 2 3) '(1 2 3)))
+ (should (= (comp-tests-car-f '(1 . 2)) 1))
+ (should (null (comp-tests-car-f nil)))
+ (should-error (comp-tests-car-f 3)
+ :type 'wrong-type-argument)
+ (should (= (comp-tests-cdr-f '(1 . 2)) 2))
+ (should (null (comp-tests-cdr-f nil)))
+ (should-error (comp-tests-cdr-f 3)
+ :type 'wrong-type-argument)
+ (should (= (comp-tests-car-safe-f '(1 . 2)) 1))
+ (should (null (comp-tests-car-safe-f 'a)))
+ (should (= (comp-tests-cdr-safe-f '(1 . 2)) 2))
+ (should (null (comp-tests-cdr-safe-f 'a))))
+
+(comp-deftest comp-tests-cons-car-cdr ()
+ "Testing cons car cdr."
+ (should (= (comp-tests-cons-car-f) 1))
+ (should (= (comp-tests-cons-cdr-f 3) 3)))
+
+(comp-deftest varset ()
+ "Testing varset."
+ (comp-tests-varset0-f)
+ (should (= comp-tests-var1 55))
+
+ (should (= (comp-tests-varset1-f) 4))
+ (should (= comp-tests-var1 66)))
+
+(comp-deftest length ()
+ "Testing length."
+ (should (= (comp-tests-length-f) 3)))
+
+(comp-deftest aref-aset ()
+ "Testing aref and aset."
+ (should (= (comp-tests-aref-aset-f) 100)))
+
+(comp-deftest symbol-value ()
+ "Testing aref and aset."
+ (should (= (comp-tests-symbol-value-f) 3)))
+
+(comp-deftest concat ()
+ "Testing concatX opcodes."
+ (should (string= (comp-tests-concat-f "bar") "abcdabcabfoobar")))
+
+(comp-deftest ffuncall ()
+ "Test calling conventions."
+
+ ;; (defun comp-tests-ffuncall-caller-f ()
+ ;; (comp-tests-ffuncall-callee-f 1 2 3))
+
+ ;; (should (equal (comp-tests-ffuncall-caller-f) '(1 2 3)))
+
+ ;; ;; After it gets compiled
+ ;; (native-compile #'comp-tests-ffuncall-callee-f)
+ ;; (should (equal (comp-tests-ffuncall-caller-f) '(1 2 3)))
+
+ ;; ;; Recompiling the caller once with callee already compiled
+ ;; (defun comp-tests-ffuncall-caller-f ()
+ ;; (comp-tests-ffuncall-callee-f 1 2 3))
+ ;; (should (equal (comp-tests-ffuncall-caller-f) '(1 2 3)))
+
+ (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3 4)
+ '(1 2 3 4)))
+ (should (equal (comp-tests-ffuncall-callee-optional-f 1 2 3)
+ '(1 2 3 nil)))
+ (should (equal (comp-tests-ffuncall-callee-optional-f 1 2)
+ '(1 2 nil nil)))
+
+ (should (equal (comp-tests-ffuncall-callee-rest-f 1 2)
+ '(1 2 nil)))
+ (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3)
+ '(1 2 (3))))
+ (should (equal (comp-tests-ffuncall-callee-rest-f 1 2 3 4)
+ '(1 2 (3 4))))
+
+ (should (equal (comp-tests-ffuncall-callee-more8-f 1 2 3 4 5 6 7 8 9 10)
+ '(1 2 3 4 5 6 7 8 9 10)))
+
+ (should (equal (comp-tests-ffuncall-callee-more8-rest-f 1 2 3 4 5 6 7 8 9 10 11)
+ '(1 2 3 4 5 6 7 8 9 (10 11))))
+
+ (should (equal (comp-tests-ffuncall-native-f) [nil]))
+
+ (should (equal (comp-tests-ffuncall-native-rest-f) [1 2 3]))
+
+ (should (equal (comp-tests-ffuncall-apply-many-f '(1 2 3))
+ '(1 2 3)))
+
+ (should (= (comp-tests-ffuncall-lambda-f 1) 2)))
+
+(comp-deftest jump-table ()
+ "Testing jump tables"
+ (should (eq (comp-tests-jump-table-1-f 'x) 'a))
+ (should (eq (comp-tests-jump-table-1-f 'y) 'b))
+ (should (eq (comp-tests-jump-table-1-f 'xxx) 'c))
+
+ ;; Jump table not with eq as test
+ (should (eq (comp-tests-jump-table-2-f "aaa") 'a))
+ (should (eq (comp-tests-jump-table-2-f "bbb") 'b)))
+
+(comp-deftest conditionals ()
+ "Testing conditionals."
+ (should (= (comp-tests-conditionals-1-f t) 1))
+ (should (= (comp-tests-conditionals-1-f nil) 2))
+ (should (= (comp-tests-conditionals-2-f t) 1340))
+ (should (eq (comp-tests-conditionals-2-f nil) nil)))
+
+(comp-deftest fixnum ()
+ "Testing some fixnum inline operation."
+ (should (= (comp-tests-fixnum-1-minus-f 10) 9))
+ (should (= (comp-tests-fixnum-1-minus-f most-negative-fixnum)
+ (1- most-negative-fixnum)))
+ (should-error (comp-tests-fixnum-1-minus-f 'a)
+ :type 'wrong-type-argument)
+ (should (= (comp-tests-fixnum-1-plus-f 10) 11))
+ (should (= (comp-tests-fixnum-1-plus-f most-positive-fixnum)
+ (1+ most-positive-fixnum)))
+ (should-error (comp-tests-fixnum-1-plus-f 'a)
+ :type 'wrong-type-argument)
+ (should (= (comp-tests-fixnum-minus-f 10) -10))
+ (should (= (comp-tests-fixnum-minus-f most-negative-fixnum)
+ (- most-negative-fixnum)))
+ (should-error (comp-tests-fixnum-minus-f 'a)
+ :type 'wrong-type-argument))
+
+(comp-deftest type-hints ()
+ "Just test compiler hints are transparent in this case."
+ ;; FIXME we should really check they are also effective.
+ (should (= (comp-tests-hint-fixnum-f 3) 4))
+ (should (= (comp-tests-hint-cons-f (cons 1 2)) 1)))
+
+(comp-deftest arith-comp ()
+ "Testing arithmetic comparisons."
+ (should (eq (comp-tests-eqlsign-f 4 3) nil))
+ (should (eq (comp-tests-eqlsign-f 3 3) t))
+ (should (eq (comp-tests-eqlsign-f 2 3) nil))
+ (should (eq (comp-tests-gtr-f 4 3) t))
+ (should (eq (comp-tests-gtr-f 3 3) nil))
+ (should (eq (comp-tests-gtr-f 2 3) nil))
+ (should (eq (comp-tests-lss-f 4 3) nil))
+ (should (eq (comp-tests-lss-f 3 3) nil))
+ (should (eq (comp-tests-lss-f 2 3) t))
+ (should (eq (comp-tests-les-f 4 3) nil))
+ (should (eq (comp-tests-les-f 3 3) t))
+ (should (eq (comp-tests-les-f 2 3) t))
+ (should (eq (comp-tests-geq-f 4 3) t))
+ (should (eq (comp-tests-geq-f 3 3) t))
+ (should (eq (comp-tests-geq-f 2 3) nil)))
+
+(comp-deftest setcarcdr ()
+ "Testing setcar setcdr."
+ (should (equal (comp-tests-setcar-f '(10 . 10) 3) '(3 . 10)))
+ (should (equal (comp-tests-setcdr-f '(10 . 10) 3) '(10 . 3)))
+ (should-error (comp-tests-setcar-f 3 10)
+ :type 'wrong-type-argument)
+ (should-error (comp-tests-setcdr-f 3 10)
+ :type 'wrong-type-argument))
+
+(comp-deftest bubble-sort ()
+ "Run bubble sort."
+ (let* ((list1 (mapcar #'random (make-list 1000 most-positive-fixnum)))
+ (list2 (copy-sequence list1)))
+ (should (equal (comp-bubble-sort-f list1)
+ (sort list2 #'<)))))
+
+(comp-deftest apply ()
+ "Test some inlined list functions."
+ (should (eq (comp-tests-consp-f '(1)) t))
+ (should (eq (comp-tests-consp-f 1) nil))
+ (let ((x (cons 1 2)))
+ (should (= (comp-tests-setcar2-f x) 3))
+ (should (equal x '(3 . 2)))))
+
+(comp-deftest num-inline ()
+ "Test some inlined number functions."
+ (should (eq (comp-tests-integerp-f 1) t))
+ (should (eq (comp-tests-integerp-f '(1)) nil))
+ (should (eq (comp-tests-integerp-f 3.5) nil))
+ (should (eq (comp-tests-integerp-f (1+ most-negative-fixnum)) t))
+
+ (should (eq (comp-tests-numberp-f 1) t))
+ (should (eq (comp-tests-numberp-f 'a) nil))
+ (should (eq (comp-tests-numberp-f 3.5) t)))
+
+(comp-deftest stack ()
+ "Test some stack operation."
+ (should (= (comp-tests-discardn-f 10) 2))
+ (should (string= (with-temp-buffer
+ (comp-tests-insertn-f "a" "b" "c" "d")
+ (buffer-string))
+ "abcd")))
+
+(comp-deftest non-locals ()
+ "Test non locals."
+ (should (string= (comp-tests-condition-case-0-f)
+ "arith-error Arithmetic error catched"))
+ (should (string= (comp-tests-condition-case-1-f)
+ "error foo catched"))
+ (should (= (comp-tests-catch-f
+ (lambda () (throw 'foo 3)))
+ 3))
+ (should (= (catch 'foo
+ (comp-tests-throw-f 3)))))
+
+(comp-deftest gc ()
+ "Try to do some longer computation to let the GC kick in."
+ (dotimes (_ 100000)
+ (comp-tests-cons-cdr-f 3))
+ (should (= (comp-tests-cons-cdr-f 3) 3)))
+
+(comp-deftest buffer ()
+ (should (string= (comp-tests-buff0-f) "foo")))
+
+(comp-deftest lambda-return ()
+ (let ((f (comp-tests-lambda-return-f)))
+ (should (subr-native-elisp-p f))
+ (should (= (funcall f 3) 4))))
+
+(comp-deftest recursive ()
+ (should (= (comp-tests-fib-f 10) 55)))
+
+(comp-deftest macro ()
+ "Just check we can define macros"
+ (should (macrop (symbol-function 'comp-tests-macro-m))))
+
+(comp-deftest string-trim ()
+ (should (string= (comp-tests-string-trim-f "dsaf ") "dsaf")))
+
+(comp-deftest trampoline-removal ()
+ ;; This tests that we can call primitives with no dedicated bytecode.
+ ;; At speed >= 2 the trampoline will not be used.
+ (should (hash-table-p (comp-tests-trampoline-removal-f))))
+
+(comp-deftest signal ()
+ (should (equal (condition-case err
+ (comp-tests-signal-f)
+ (t err))
+ '(foo . t))))
+
+(comp-deftest func-call-removal ()
+ ;; See `comp-propagate-insn' `comp-function-call-remove'.
+ (should (= (comp-tests-func-call-removal-f) 1)))
+
+(comp-deftest doc ()
+ (should (string= (documentation #'comp-tests-doc-f)
+ "A nice docstring"))
+ ;; Check a preloaded function, we can't use `comp-tests-doc-f' now
+ ;; as this is loaded manually with no .elc.
+ (should (string-match "\\.*.elc\\'" (symbol-file #'error))))
+
+(comp-deftest interactive-form ()
+ (should (equal (interactive-form #'comp-test-interactive-form0-f)
+ '(interactive "D")))
+ (should (equal (interactive-form #'comp-test-interactive-form1-f)
+ '(interactive '(1 2))))
+ (should (equal (interactive-form #'comp-test-interactive-form2-f)
+ '(interactive nil)))
+ (should (cl-every #'commandp '(comp-test-interactive-form0-f
+ comp-test-interactive-form1-f
+ comp-test-interactive-form2-f)))
+ (should-not (commandp #'comp-tests-doc-f)))
+
+(comp-deftest free-fun ()
+ "Check we are able to compile a single function."
+ (eval '(defun comp-tests-free-fun-f ()
+ "Some doc."
+ (interactive)
+ 3)
+ t)
+ (native-compile #'comp-tests-free-fun-f)
+
+ (should (subr-native-elisp-p (symbol-function #'comp-tests-free-fun-f)))
+ (should (= (comp-tests-free-fun-f) 3))
+ (should (string= (documentation #'comp-tests-free-fun-f)
+ "Some doc."))
+ (should (commandp #'comp-tests-free-fun-f))
+ (should (equal (interactive-form #'comp-tests-free-fun-f)
+ '(interactive))))
+
+(comp-deftest free-fun-silly-name ()
+ "Check we are able to compile a single function."
+ (eval '(defun comp-tests/free\fun-f ()) t)
+ (native-compile #'comp-tests/free\fun-f)
+ (should (subr-native-elisp-p (symbol-function #'comp-tests/free\fun-f))))
+
+(comp-deftest bug-40187 ()
+ "Check function name shadowing.
+https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
+ (should (eq (comp-test-40187-1-f) 'foo))
+ (should (eq (comp-test-40187-2-f) 'bar)))
+
+(comp-deftest speed--1 ()
+ "Check that at speed -1 we do not native compile."
+ (should (= (comp-test-speed--1-f) 3))
+ (should-not (subr-native-elisp-p (symbol-function #'comp-test-speed--1-f))))
+
+(comp-deftest bug-42360 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-07/msg00418.html>."
+ (should (string= (comp-test-42360-f "Nel mezzo del " 18 0 32 "yyy" nil)
+ "Nel mezzo del yyy")))
+
+(comp-deftest bug-44968 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-11/msg02357.html>"
+ (comp-test-44968-f "/tmp/test/foo" "/tmp"))
+
+(comp-deftest bug-45342 ()
+ "Preserve multibyte immediate strings.
+<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01771.html>"
+ (should (string= " ➊" (comp-test-45342-f 1))))
+
+(comp-deftest assume-double-neg ()
+ "In fwprop assumptions (not (not (member x))) /= (member x)."
+ (should-not (comp-test-assume-double-neg-f "bar" "foo")))
+
+(comp-deftest assume-in-loop-1 ()
+ "Broken call args assumptions lead to infinite loop."
+ (should (equal (comp-test-assume-in-loop-1-f "cd") '("cd"))))
+
+(comp-deftest bug-45376-1 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
+ (should (equal (comp-test-45376-1-f) '(1 0))))
+
+(comp-deftest bug-45376-2 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
+ (should (equal (comp-test-45376-2-f) '(0 2 1 0 1 0 1 0 0 0 0 0))))
+
+(defvar comp-test-primitive-advice)
+(comp-deftest primitive-advice ()
+ "Test effectiveness of primitive advising."
+ (let (comp-test-primitive-advice
+ (f (lambda (&rest args)
+ (setq comp-test-primitive-advice args))))
+ (advice-add #'+ :before f)
+ (unwind-protect
+ (progn
+ (should (= (comp-test-primitive-advice-f 3 4) 7))
+ (should (equal comp-test-primitive-advice '(3 4))))
+ (advice-remove #'+ f))))
+
+(defvar comp-test-primitive-redefine-args)
+(comp-deftest primitive-redefine ()
+ "Test effectiveness of primitive redefinition."
+ (cl-letf ((comp-test-primitive-redefine-args nil)
+ ((symbol-function #'-)
+ (lambda (&rest args)
+ (setq comp-test-primitive-redefine-args args)
+ 'xxx)))
+ (should (eq (comp-test-primitive-redefine-f 10 2) 'xxx))
+ (should (equal comp-test-primitive-redefine-args '(10 2)))))
+
+(comp-deftest compile-forms ()
+ "Verify lambda form native compilation."
+ (should-error (native-compile '(+ 1 foo)))
+ (let ((lexical-binding t)
+ (f (native-compile '(lambda (x) (1+ x)))))
+ (should (subr-native-elisp-p f))
+ (should (= (funcall f 2) 3)))
+ (let* ((lexical-binding nil)
+ (f (native-compile '(lambda (x) (1+ x)))))
+ (should (subr-native-elisp-p f))
+ (should (= (funcall f 2) 3))))
+
+(comp-deftest comp-test-defsubst ()
+ ;; Bug#42664, Bug#43280, Bug#44209.
+ (should-not (subr-native-elisp-p (symbol-function #'comp-test-defsubst-f))))
+
+(comp-deftest primitive-redefine-compile-44221 ()
+ "Test the compiler still works while primitives are redefined (bug#44221)."
+ (cl-letf (((symbol-function #'delete-region)
+ (lambda (_ _))))
+ (should (subr-native-elisp-p
+ (native-compile
+ '(lambda ()
+ (delete-region (point-min) (point-max))))))))
+
+(comp-deftest and-3 ()
+ (should (= (comp-test-and-3-f t) 2))
+ (should (null (comp-test-and-3-f '(1 2)))))
+
+(comp-deftest copy-insn ()
+ (should (equal (comp-test-copy-insn-f '(1 2 3 (4 5 6)))
+ '(1 2 3 (4 5 6))))
+ (should (null (comp-test-copy-insn-f nil))))
+
+(comp-deftest cond-rw-1 ()
+ "Check cond-rw does not break target blocks with multiple predecessor."
+ (should (null (comp-test-cond-rw-1-2-f))))
+
+(comp-deftest not-cons-1 ()
+ (should-not (comp-test-not-cons-f nil)))
+
+(comp-deftest 45576-1 ()
+ "Functionp satisfies also symbols.
+<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-01/msg00029.html>."
+ (should (eq (comp-test-45576-f) 'eval)))
+
+(comp-deftest 45635-1 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-01/msg00158.html>."
+ (should (string= (comp-test-45635-f :height 180 :family "PragmataPro Liga")
+ "PragmataPro Liga")))
+
+(comp-deftest 45603-1 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01994.html>"
+ (load (native-compile (ert-resource-file "comp-test-45603.el")))
+ (should (fboundp #'comp-test-45603--file-local-name)))
+
+(comp-deftest 46670-1 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-02/msg01413.html>"
+ (should (string= (comp-test-46670-2-f "foo") "foo"))
+ (should (equal (subr-type (symbol-function #'comp-test-46670-2-f))
+ '(function (t) t))))
+
+(comp-deftest 46824-1 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-02/msg01949.html>"
+ (should (equal (comp-test-46824-1-f) nil)))
+
+(comp-deftest comp-test-47868-1 ()
+ "Verify string hash consing strategy.
+
+<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-04/msg00921.html>"
+ (should-not (equal-including-properties (comp-test-47868-1-f)
+ (comp-test-47868-2-f)))
+ (should (eq (comp-test-47868-1-f) (comp-test-47868-3-f)))
+ (should (eq (comp-test-47868-2-f) (comp-test-47868-4-f))))
+
+
+;;;;;;;;;;;;;;;;;;;;;
+;; Tromey's tests. ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(comp-deftest consp ()
+ (should-not (comp-test-consp 23))
+ (should-not (comp-test-consp nil))
+ (should (comp-test-consp '(1 . 2))))
+
+(comp-deftest listp ()
+ (should-not (comp-test-listp 23))
+ (should (comp-test-listp nil))
+ (should (comp-test-listp '(1 . 2))))
+
+(comp-deftest stringp ()
+ (should-not (comp-test-stringp 23))
+ (should-not (comp-test-stringp nil))
+ (should (comp-test-stringp "hi")))
+
+(comp-deftest symbolp ()
+ (should-not (comp-test-symbolp 23))
+ (should-not (comp-test-symbolp "hi"))
+ (should (comp-test-symbolp 'whatever)))
+
+(comp-deftest integerp ()
+ (should (comp-test-integerp 23))
+ (should-not (comp-test-integerp 57.5))
+ (should-not (comp-test-integerp "hi"))
+ (should-not (comp-test-integerp 'whatever)))
+
+(comp-deftest numberp ()
+ (should (comp-test-numberp 23))
+ (should (comp-test-numberp 57.5))
+ (should-not (comp-test-numberp "hi"))
+ (should-not (comp-test-numberp 'whatever)))
+
+(comp-deftest add1 ()
+ (should (eq (comp-test-add1 23) 24))
+ (should (eq (comp-test-add1 -17) -16))
+ (should (eql (comp-test-add1 1.0) 2.0))
+ (should-error (comp-test-add1 nil)
+ :type 'wrong-type-argument))
+
+(comp-deftest sub1 ()
+ (should (eq (comp-test-sub1 23) 22))
+ (should (eq (comp-test-sub1 -17) -18))
+ (should (eql (comp-test-sub1 1.0) 0.0))
+ (should-error (comp-test-sub1 nil)
+ :type 'wrong-type-argument))
+
+(comp-deftest negate ()
+ (should (eq (comp-test-negate 23) -23))
+ (should (eq (comp-test-negate -17) 17))
+ (should (eql (comp-test-negate 1.0) -1.0))
+ (should-error (comp-test-negate nil)
+ :type 'wrong-type-argument))
+
+(comp-deftest not ()
+ (should (eq (comp-test-not 23) nil))
+ (should (eq (comp-test-not nil) t))
+ (should (eq (comp-test-not t) nil)))
+
+(comp-deftest bobp-and-eobp ()
+ (with-temp-buffer
+ (should (comp-test-bobp))
+ (should (comp-test-eobp))
+ (insert "hi")
+ (goto-char (point-min))
+ (should (eq (comp-test-point-min) (point-min)))
+ (should (eq (comp-test-point) (point-min)))
+ (should (comp-test-bobp))
+ (should-not (comp-test-eobp))
+ (goto-char (point-max))
+ (should (eq (comp-test-point-max) (point-max)))
+ (should (eq (comp-test-point) (point-max)))
+ (should-not (comp-test-bobp))
+ (should (comp-test-eobp))))
+
+(comp-deftest car-cdr ()
+ (let ((pair '(1 . b)))
+ (should (eq (comp-test-car pair) 1))
+ (should (eq (comp-test-car nil) nil))
+ (should-error (comp-test-car 23)
+ :type 'wrong-type-argument)
+ (should (eq (comp-test-cdr pair) 'b))
+ (should (eq (comp-test-cdr nil) nil))
+ (should-error (comp-test-cdr 23)
+ :type 'wrong-type-argument)))
+
+(comp-deftest car-cdr-safe ()
+ (let ((pair '(1 . b)))
+ (should (eq (comp-test-car-safe pair) 1))
+ (should (eq (comp-test-car-safe nil) nil))
+ (should (eq (comp-test-car-safe 23) nil))
+ (should (eq (comp-test-cdr-safe pair) 'b))
+ (should (eq (comp-test-cdr-safe nil) nil))
+ (should (eq (comp-test-cdr-safe 23) nil))))
+
+(comp-deftest eq ()
+ (should (comp-test-eq 'a 'a))
+ (should (comp-test-eq 5 5))
+ (should-not (comp-test-eq 'a 'b)))
+
+(comp-deftest if ()
+ (should (eq (comp-test-if 'a 'b) 'a))
+ (should (eq (comp-test-if 0 23) 0))
+ (should (eq (comp-test-if nil 'b) 'b)))
+
+(comp-deftest and ()
+ (should (eq (comp-test-and 'a 'b) 'b))
+ (should (eq (comp-test-and 0 23) 23))
+ (should (eq (comp-test-and nil 'b) nil)))
+
+(comp-deftest or ()
+ (should (eq (comp-test-or 'a 'b) 'a))
+ (should (eq (comp-test-or 0 23) 0))
+ (should (eq (comp-test-or nil 'b) 'b)))
+
+(comp-deftest save-excursion ()
+ (with-temp-buffer
+ (comp-test-save-excursion)
+ (should (eq (point) (point-min)))
+ (should (eq (comp-test-current-buffer) (current-buffer)))))
+
+(comp-deftest > ()
+ (should (eq (comp-test-> 0 23) nil))
+ (should (eq (comp-test-> 23 0) t)))
+
+(comp-deftest catch ()
+ (should (eq (comp-test-catch 0 1 2 3 4) nil))
+ (should (eq (comp-test-catch 20 21 22 23 24 25 26 27 28) 24)))
+
+(comp-deftest memq ()
+ (should (equal (comp-test-memq 0 '(5 4 3 2 1 0)) '(0)))
+ (should (eq (comp-test-memq 72 '(5 4 3 2 1 0)) nil)))
+
+(comp-deftest listN ()
+ (should (equal (comp-test-listN 57)
+ '(57 57 57 57 57 57 57 57 57 57 57 57 57 57 57 57))))
+
+(comp-deftest concatN ()
+ (should (equal (comp-test-concatN "x") "xxxxxx")))
+
+(comp-deftest opt-rest ()
+ (should (equal (comp-test-opt-rest 1) '(1 nil nil)))
+ (should (equal (comp-test-opt-rest 1 2) '(1 2 nil)))
+ (should (equal (comp-test-opt-rest 1 2 3) '(1 2 (3))))
+ (should (equal (comp-test-opt-rest 1 2 56 57 58)
+ '(1 2 (56 57 58)))))
+
+(comp-deftest opt ()
+ (should (equal (comp-test-opt 23) '(23)))
+ (should (equal (comp-test-opt 23 24) '(23 . 24)))
+ (should-error (comp-test-opt)
+ :type 'wrong-number-of-arguments)
+ (should-error (comp-test-opt nil 24 97)
+ :type 'wrong-number-of-arguments))
+
+(comp-deftest unwind-protect ()
+ (comp-test-unwind-protect 'ignore)
+ (should (eq comp-test-up-val 999))
+ (condition-case nil
+ (comp-test-unwind-protect (lambda () (error "HI")))
+ (error
+ nil))
+ (should (eq comp-test-up-val 999)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests for dynamic scope. ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(comp-deftest dynamic-ffuncall ()
+ "Test calling convention for dynamic binding."
+
+ (should (equal (comp-tests-ffuncall-callee-dyn-f 1 2)
+ '(1 2)))
+
+ (should (equal (comp-tests-ffuncall-callee-opt-dyn-f 1 2 3 4)
+ '(1 2 3 4)))
+ (should (equal (comp-tests-ffuncall-callee-opt-dyn-f 1 2 3)
+ '(1 2 3 nil)))
+ (should (equal (comp-tests-ffuncall-callee-opt-dyn-f 1 2)
+ '(1 2 nil nil)))
+
+ (should (equal (comp-tests-ffuncall-callee-rest-dyn-f 1 2)
+ '(1 2 nil)))
+ (should (equal (comp-tests-ffuncall-callee-rest-dyn-f 1 2 3)
+ '(1 2 (3))))
+ (should (equal (comp-tests-ffuncall-callee-rest-dyn-f 1 2 3 4)
+ '(1 2 (3 4))))
+
+ (should (equal (comp-tests-ffuncall-callee-opt-rest-dyn-f 1 2)
+ '(1 2 nil nil)))
+ (should (equal (comp-tests-ffuncall-callee-opt-rest-dyn-f 1 2 3)
+ '(1 2 3 nil)))
+ (should (equal (comp-tests-ffuncall-callee-opt-rest-dyn-f 1 2 3 4)
+ '(1 2 3 (4)))))
+
+(comp-deftest dynamic-arity ()
+ "Test func-arity on dynamic scope functions."
+ (should (equal '(2 . 2)
+ (func-arity #'comp-tests-ffuncall-callee-dyn-f)))
+ (should (equal '(2 . 4)
+ (func-arity #'comp-tests-ffuncall-callee-opt-dyn-f)))
+ (should (equal '(2 . many)
+ (func-arity #'comp-tests-ffuncall-callee-rest-dyn-f)))
+ (should (equal '(2 . many)
+ (func-arity #'comp-tests-ffuncall-callee-opt-rest-dyn-f))))
+
+(comp-deftest dynamic-help-arglist ()
+ "Test `help-function-arglist' works on lisp/d (bug#42572)."
+ (should (equal (help-function-arglist
+ (symbol-function #'comp-tests-ffuncall-callee-opt-rest-dyn-f)
+ t)
+ '(a b &optional c &rest d))))
+
+(comp-deftest cl-macro-exp ()
+ "Verify CL macro expansion (bug#42088)."
+ (should (equal (comp-tests-cl-macro-exp-f) '(a b))))
+
+(comp-deftest cl-uninterned-arg-parse-f ()
+ "Verify the parsing of a lambda list with uninterned symbols (bug#42120)."
+ (should (equal (comp-tests-cl-uninterned-arg-parse-f 1 2)
+ '(1 2))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Middle-end specific tests. ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun comp-tests-mentioned-p-1 (x insn)
+ (cl-loop for y in insn
+ when (cond
+ ((consp y) (comp-tests-mentioned-p x y))
+ ((and (comp-mvar-p y) (comp-cstr-imm-vld-p y))
+ (equal (comp-cstr-imm y) x))
+ (t (equal x y)))
+ return t))
+
+(defun comp-tests-mentioned-p (x insn)
+ "Check if X is actively mentioned in INSN."
+ (unless (eq (car-safe insn)
+ 'comment)
+ (comp-tests-mentioned-p-1 x insn)))
+
+(defun comp-tests-map-checker (func-name checker)
+ "Apply CHECKER to each insn of FUNC-NAME.
+Return a list of results."
+ (cl-loop
+ with func-c-name = (comp-c-func-name (or func-name 'anonymous-lambda) "F" t)
+ with f = (gethash func-c-name (comp-ctxt-funcs-h comp-ctxt))
+ for bb being each hash-value of (comp-func-blocks f)
+ nconc
+ (cl-loop
+ for insn in (comp-block-insns bb)
+ collect (funcall checker insn))))
+
+(defun comp-tests-tco-checker (_)
+ "Check that inside `comp-tests-tco-f' we have no recursion."
+ (should
+ (cl-notany
+ #'identity
+ (comp-tests-map-checker
+ 'comp-tests-tco-f
+ (lambda (insn)
+ (or (comp-tests-mentioned-p 'comp-tests-tco-f insn)
+ (comp-tests-mentioned-p (comp-c-func-name 'comp-tests-tco-f "F" t)
+ insn)))))))
+
+(comp-deftest tco ()
+ "Check for tail recursion elimination."
+ (let ((native-comp-speed 3)
+ ;; Disable ipa-pure otherwise `comp-tests-tco-f' gets
+ ;; optimized-out.
+ (comp-disabled-passes '(comp-ipa-pure))
+ (comp-post-pass-hooks '((comp-tco comp-tests-tco-checker)
+ (comp-final comp-tests-tco-checker))))
+ (eval '(defun comp-tests-tco-f (a b count)
+ (if (= count 0)
+ b
+ (comp-tests-tco-f (+ a b) a (- count 1))))
+ t)
+ (native-compile #'comp-tests-tco-f)
+ (should (subr-native-elisp-p (symbol-function #'comp-tests-tco-f)))
+ (should (= (comp-tests-tco-f 1 0 10) 55))))
+
+(defun comp-tests-fw-prop-checker-1 (_)
+ "Check that inside `comp-tests-fw-prop-f' `concat' and `length' are folded."
+ (should
+ (cl-notany
+ #'identity
+ (comp-tests-map-checker
+ 'comp-tests-fw-prop-1-f
+ (lambda (insn)
+ (or (comp-tests-mentioned-p 'concat insn)
+ (comp-tests-mentioned-p 'length insn)))))))
+
+(comp-deftest fw-prop-1 ()
+ "Some tests for forward propagation."
+ (let ((native-comp-speed 2)
+ (comp-post-pass-hooks '((comp-final comp-tests-fw-prop-checker-1))))
+ (eval '(defun comp-tests-fw-prop-1-f ()
+ (let* ((a "xxx")
+ (b "yyy")
+ (c (concat a b))) ; <= has to optimize
+ (length c))) ; <= has to optimize
+ t)
+ (native-compile #'comp-tests-fw-prop-1-f)
+ (should (subr-native-elisp-p (symbol-function #'comp-tests-fw-prop-1-f)))
+ (should (= (comp-tests-fw-prop-1-f) 6))))
+
+(defun comp-tests-check-ret-type-spec (func-form ret-type)
+ (let ((lexical-binding t)
+ (native-comp-speed 2)
+ (f-name (cl-second func-form)))
+ (eval func-form t)
+ (native-compile f-name)
+ (should (equal (cl-third (subr-type (symbol-function f-name)))
+ ret-type))))
+
+(cl-eval-when (compile eval load)
+ (defconst comp-tests-type-spec-tests
+ `(
+ ;; 1
+ ((defun comp-tests-ret-type-spec-f (x)
+ x)
+ t)
+
+ ;; 2
+ ((defun comp-tests-ret-type-spec-f ()
+ 1)
+ (integer 1 1))
+
+ ;; 3
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if x 1 3))
+ (or (integer 1 1) (integer 3 3)))
+
+ ;; 4
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let (y)
+ (if x
+ (setf y 1)
+ (setf y 2))
+ y))
+ (integer 1 2))
+
+ ;; 5
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let (y)
+ (if x
+ (setf y 1)
+ (setf y 3))
+ y))
+ (or (integer 1 1) (integer 3 3)))
+
+ ;; 6
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if x
+ (list x)
+ 3))
+ (or cons (integer 3 3)))
+
+ ;; 7
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if x
+ 'foo
+ 3))
+ (or (member foo) (integer 3 3)))
+
+ ;; 8
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eq x 3)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 9
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eq 3 x)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 10
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eql x 3)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 11
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eql 3 x)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 12
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eql x 3)
+ 'foo
+ x))
+ (not (integer 3 3)))
+
+ ;; 13
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (if (= x y)
+ x
+ 'foo))
+ (or (member foo) marker number))
+
+ ;; 14
+ ((defun comp-tests-ret-type-spec-f (x)
+ (comp-hint-fixnum x))
+ (integer ,most-negative-fixnum ,most-positive-fixnum))
+
+ ;; 15
+ ((defun comp-tests-ret-type-spec-f (x)
+ (comp-hint-cons x))
+ cons)
+
+ ;; 16
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let (y)
+ (when x
+ (setf y 4))
+ y))
+ (or null (integer 4 4)))
+
+ ;; 17
+ ((defun comp-tests-ret-type-spec-f ()
+ (let (x
+ (y 3))
+ (setf x y)
+ y))
+ (integer 3 3))
+
+ ;; 18
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let ((y 3))
+ (when x
+ (setf y x))
+ y))
+ t)
+
+ ;; 19
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (eq x y))
+ boolean)
+
+ ;; 20
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when x
+ 'foo))
+ (or (member foo) null))
+
+ ;; 21
+ ((defun comp-tests-ret-type-spec-f (x)
+ (unless x
+ 'foo))
+ (or (member foo) null))
+
+ ;; 22
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (> x 3)
+ x))
+ (or null float (integer 4 *)))
+
+ ;; 23
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (>= x 3)
+ x))
+ (or null float (integer 3 *)))
+
+ ;; 24
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (< x 3)
+ x))
+ (or null float (integer * 2)))
+
+ ;; 25
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (<= x 3)
+ x))
+ (or null float (integer * 3)))
+
+ ;; 26
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (> 3 x)
+ x))
+ (or null float (integer * 2)))
+
+ ;; 27
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (>= 3 x)
+ x))
+ (or null float (integer * 3)))
+
+ ;; 28
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (< 3 x)
+ x))
+ (or null float (integer 4 *)))
+
+ ;; 29
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (<= 3 x)
+ x))
+ (or null float (integer 3 *)))
+
+ ;; 30
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let ((y 3))
+ (when (> x y)
+ x)))
+ (or null float (integer 4 *)))
+
+ ;; 31
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let ((y 3))
+ (when (> y x)
+ x)))
+ (or null float (integer * 2)))
+
+ ;; 32
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (and (> x 3)
+ (< x 10))
+ x))
+ (or null float (integer 4 9)))
+
+ ;; 33
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (or (> x 3)
+ (< x 10))
+ x))
+ (or null float integer))
+
+ ;; 34
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (or (< x 3)
+ (> x 10))
+ x))
+ (or null float (integer * 2) (integer 11 *)))
+
+ ;; 35 No float range support.
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (> x 1.0)
+ x))
+ (or null marker number))
+
+ ;; 36
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (> x 3)
+ (> y 2))
+ (+ x y)))
+ (or null float (integer 7 *)))
+
+ ;; 37
+ ;; SBCL: (OR REAL NULL)
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= x 3)
+ (<= y 2))
+ (+ x y)))
+ (or null float (integer * 5)))
+
+ ;; 38
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (< 1 x 5)
+ (< 1 y 5))
+ (+ x y)))
+ (or null float (integer 4 8)))
+
+ ;; 39
+ ;; SBCL gives: (OR REAL NULL)
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= 1 x 10)
+ (<= 2 y 3))
+ (+ x y)))
+ (or null float (integer 3 13)))
+
+ ;; 40
+ ;; SBCL: (OR REAL NULL)
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= 1 x 10)
+ (<= 2 y 3))
+ (- x y)))
+ (or null float (integer -2 8)))
+
+ ;; 41
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= 1 x)
+ (<= 2 y 3))
+ (- x y)))
+ (or null float (integer -2 *)))
+
+ ;; 42
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= 1 x 10)
+ (<= 2 y))
+ (- x y)))
+ (or null float (integer * 8)))
+
+ ;; 43
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= x 10)
+ (<= 2 y))
+ (- x y)))
+ (or null float (integer * 8)))
+
+ ;; 44
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= x 10)
+ (<= y 3))
+ (- x y)))
+ (or null float integer))
+
+ ;; 45
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (when (and (<= 2 x)
+ (<= 3 y))
+ (- x y)))
+ (or null float integer))
+
+ ;; 46
+ ;; SBCL: (OR (RATIONAL (6) (30)) (SINGLE-FLOAT 6.0 30.0)
+ ;; (DOUBLE-FLOAT 6.0d0 30.0d0) NULL)
+ ((defun comp-tests-ret-type-spec-f (x y z i j k)
+ (when (and (< 1 x 5)
+ (< 1 y 5)
+ (< 1 z 5)
+ (< 1 i 5)
+ (< 1 j 5)
+ (< 1 k 5))
+ (+ x y z i j k)))
+ (or null float (integer 12 24)))
+
+ ;; 47
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (<= 1 x 5)
+ (1+ x)))
+ (or null float (integer 2 6)))
+
+ ;;48
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (<= 1 x 5)
+ (1- x)))
+ (or null float (integer 0 4)))
+
+ ;; 49
+ ((defun comp-tests-ret-type-spec-f ()
+ (error "foo"))
+ nil)
+
+ ;; 50
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (stringp x)
+ x
+ 'bar))
+ (or (member bar) string))
+
+ ;; 51
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (stringp x)
+ 'bar
+ x))
+ (not string))
+
+ ;; 52
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (integerp x)
+ x
+ 'bar))
+ (or (member bar) integer))
+
+ ;; 53
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (integerp x)
+ x))
+ (or null integer))
+
+ ;; 54
+ ((defun comp-tests-ret-type-spec-f (x)
+ (unless (symbolp x)
+ x))
+ t)
+
+ ;; 55
+ ((defun comp-tests-ret-type-spec-f (x)
+ (unless (integerp x)
+ x))
+ (not integer))
+
+ ;; 56
+ ((defun comp-tests-ret-type-spec-f (x)
+ (cl-ecase x
+ (1 (message "one"))
+ (5 (message "five")))
+ x)
+ t
+ ;; FIXME improve `comp-cond-cstrs-target-mvar' to cross block
+ ;; boundary if necessary as this should return:
+ ;; (or (integer 1 1) (integer 5 5))
+ )
+
+ ;; 57
+ ((defun comp-tests-ret-type-spec-f (x)
+ (unless (or (eq x 'foo)
+ (eql x 3))
+ (error "Not foo or 3"))
+ x)
+ (or (member foo) (integer 3 3)))
+
+ ;;58
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (if (and (natnump x)
+ (natnump y)
+ (<= x y))
+ x
+ (error "")))
+ (integer 0 *))
+
+ ;; 59
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (if (and (>= x 3)
+ (<= y 10)
+ (<= x y))
+ x
+ (error "")))
+ (or float (integer 3 10)))
+
+ ;; 60
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (if (and (<= x 10)
+ (>= y 3)
+ (>= x y))
+ x
+ (error "")))
+ (or float (integer 3 10)))
+
+ ;; 61
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 1.0)
+ x
+ (error "")))
+ (or (member 1.0) (integer 1 1)))
+
+ ;; 62
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 1.0)
+ x
+ (error "")))
+ (or (member 1.0) (integer 1 1)))
+
+ ;; 63
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 1.1)
+ x
+ (error "")))
+ (member 1.1))
+
+ ;; 64
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 1)
+ x
+ (error "")))
+ (or (member 1.0) (integer 1 1)))
+
+ ;; 65
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 1)
+ x
+ (error "")))
+ (or (member 1.0) (integer 1 1)))
+
+ ;; 66
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eql x 0.0)
+ x
+ (error "")))
+ float)
+
+ ;; 67
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (equal x '(1 2 3))
+ x
+ (error "")))
+ cons)
+
+ ;; 68
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (and (floatp x)
+ (= x 1))
+ x
+ (error "")))
+ ;; Conservative (see cstr relax in `comp-cstr-=').
+ (or (member 1.0) (integer 1 1)))
+
+ ;; 69
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (and (integer x)
+ (= x 1))
+ x
+ (error "")))
+ ;; Conservative (see cstr relax in `comp-cstr-=').
+ (or (member 1.0) (integer 1 1)))
+
+ ;; 70
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (if (and (floatp x)
+ (integerp y)
+ (= x y))
+ x
+ (error "")))
+ (or float integer))
+
+ ;; 71
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 0.0)
+ x
+ (error "")))
+ (or (member -0.0 0.0) (integer 0 0)))
+
+ ;; 72
+ ((defun comp-tests-ret-type-spec-f (x)
+ (unless (= x 0.0)
+ (error ""))
+ (unless (eql x -0.0)
+ (error ""))
+ x)
+ float)
+
+ ;; 73
+ ((defun comp-tests-ret-type-spec-f (x)
+ (when (eql x 1.0)
+ (error ""))
+ x)
+ t)))
+
+ (defun comp-tests-define-type-spec-test (number x)
+ `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
+ ,(format "Type specifier test number %d." number)
+ (let ((comp-ctxt (make-comp-cstr-ctxt)))
+ (comp-tests-check-ret-type-spec ',(car x) ',(cadr x))))))
+
+(defmacro comp-tests-define-type-spec-tests ()
+ "Define all type specifier tests."
+ `(progn
+ ,@(cl-loop
+ for test in comp-tests-type-spec-tests
+ for n from 1
+ collect (comp-tests-define-type-spec-test n test))))
+
+(comp-tests-define-type-spec-tests)
+
+(defun comp-tests-pure-checker-1 (_)
+ "Check that inside `comp-tests-pure-caller-f' `comp-tests-pure-callee-f' is
+ folded."
+ (should
+ (cl-notany
+ #'identity
+ (comp-tests-map-checker
+ 'comp-tests-pure-caller-f
+ (lambda (insn)
+ (or (comp-tests-mentioned-p 'comp-tests-pure-callee-f insn)
+ (comp-tests-mentioned-p (comp-c-func-name
+ 'comp-tests-pure-callee-f "F" t)
+ insn)))))))
+
+(defun comp-tests-pure-checker-2 (_)
+ "Check that `comp-tests-pure-fibn-f' is folded."
+ (should
+ (cl-notany
+ #'identity
+ (comp-tests-map-checker
+ 'comp-tests-pure-fibn-entry-f
+ (lambda (insn)
+ (or (comp-tests-mentioned-p 'comp-tests-pure-fibn-f insn)
+ (comp-tests-mentioned-p (comp-c-func-name 'comp-tests-pure-fibn-f "F" t)
+ insn)))))))
+
+(comp-deftest pure ()
+ "Some tests for pure functions optimization."
+ (let ((native-comp-speed 3)
+ (comp-post-pass-hooks '((comp-final comp-tests-pure-checker-1
+ comp-tests-pure-checker-2))))
+ (load (native-compile (ert-resource-file "comp-test-pure.el")))
+
+ (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-caller-f)))
+ (should (= (comp-tests-pure-caller-f) 4))
+
+ (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-fibn-entry-f)))
+ (should (= (comp-tests-pure-fibn-entry-f) 6765))))
+
+(defvar comp-tests-cond-rw-checked-function nil
+ "Function to be checked.")
+(defun comp-tests-cond-rw-checker-val (_)
+ "Check we manage to propagate the correct return value."
+ (should
+ (cl-some
+ #'identity
+ (comp-tests-map-checker
+ comp-tests-cond-rw-checked-function
+ (lambda (insn)
+ (pcase insn
+ (`(return ,mvar)
+ (and (comp-cstr-imm-vld-p mvar)
+ (eql (comp-cstr-imm mvar) 123)))))))))
+
+(defvar comp-tests-cond-rw-expected-type nil
+ "Type to expect in `comp-tests-cond-rw-checker-type'.")
+(defun comp-tests-cond-rw-checker-type (_)
+ "Check we manage to propagate the correct return type."
+ (should
+ (cl-some
+ #'identity
+ (comp-tests-map-checker
+ comp-tests-cond-rw-checked-function
+ (lambda (insn)
+ (pcase insn
+ (`(return ,mvar)
+ (equal (comp-mvar-typeset mvar)
+ comp-tests-cond-rw-expected-type))))))))
+
+;;; comp-tests.el ends here
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 03d867f18a8..b1e5fa0767c 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -358,12 +358,35 @@ comparing the subr with a much slower lisp implementation."
(should (equal (symbol-value var) 42))
(should (equal (default-value var) (symbol-value var)))
(set var 123)
+ (should (not (local-variable-p var)))
(should (equal (symbol-value var) 123))
(should (equal (default-value var) (symbol-value var)))) ;bug#44733
(should (equal (symbol-value var) def))
(should (equal (default-value var) (symbol-value var))))
(should (equal (default-value var) def))))))
+(ert-deftest data-tests--let-buffer-local-no-unwind-other-buffers ()
+ "Test that a let-binding for a buffer-local unwinds only current-buffer."
+ (let ((blvar (make-symbol "blvar")))
+ (set-default blvar 0)
+ (make-variable-buffer-local blvar)
+ (dolist (var (list blvar 'left-margin))
+ (let* ((def (default-value var))
+ (newdef (+ def 1))
+ (otherbuf (generate-new-buffer "otherbuf")))
+ (with-temp-buffer
+ (cl-progv (list var) (list newdef)
+ (with-current-buffer otherbuf
+ (set var 123)
+ (should (local-variable-p var))
+ (should (equal (symbol-value var) 123))
+ (should (equal (default-value var) newdef))))
+ (with-current-buffer otherbuf
+ (should (local-variable-p var))
+ (should (equal (symbol-value var) 123))
+ (should (equal (default-value var) def)))
+ )))))
+
(ert-deftest binding-test-makunbound ()
"Tests of makunbound, from the manual."
(with-current-buffer binding-test-buffer-B
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index dcec971c12e..a731a95ccf0 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -1,4 +1,4 @@
-;;; editfns-tests.el -- tests for editfns.c -*- lexical-binding:t -*-
+;;; editfns-tests.el --- tests for editfns.c -*- lexical-binding:t -*-
;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
@@ -128,6 +128,10 @@
(format (concat "%-3d/" s) 12)
#("12 /X" 4 5 (prop "val"))))))
+(ert-deftest propertize/error-even-number-of-args ()
+ "Number of args for `propertize' must be odd."
+ (should-error (propertize "foo" 'bar) :type 'wrong-number-of-arguments))
+
;; Tests for bug#5131.
(defun transpose-test-reverse-word (start end)
"Reverse characters in a word by transposing pairs of characters."
diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c
index ad59cfc18cd..5720af8c605 100644
--- a/test/src/emacs-module-resources/mod-test.c
+++ b/test/src/emacs-module-resources/mod-test.c
@@ -288,6 +288,8 @@ struct super_struct
char large_unused_buffer[512];
};
+static void signal_errno (emacs_env *, char const *);
+
/* Return a new user-pointer to a super_struct, with amazing_int set
to the passed parameter. */
static emacs_value
@@ -295,6 +297,8 @@ Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
void *data)
{
struct super_struct *p = calloc (1, sizeof *p);
+ if (!p)
+ signal_errno (env, "calloc");
p->amazing_int = env->extract_integer (env, args[0]);
return env->make_user_ptr (env, free, p);
}
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index af5bc2a0baf..a4d858113ed 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -1,4 +1,4 @@
-;;; emacs-module-tests --- Test GNU Emacs modules. -*- lexical-binding: t; -*-
+;;; emacs-module-tests.el --- Test GNU Emacs modules. -*- lexical-binding: t; -*-
;; Copyright 2015-2021 Free Software Foundation, Inc.
@@ -37,7 +37,9 @@
"File name of the Emacs binary currently running.")
(eval-and-compile
- (defconst mod-test-file (ert-resource-file "mod-test")
+ (defconst mod-test-file
+ (expand-file-name "../test/src/emacs-module-resources/mod-test"
+ invocation-directory)
"File name of the module test file."))
(require 'mod-test mod-test-file)
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
new file mode 100644
index 00000000000..ac08e055b55
--- /dev/null
+++ b/test/src/emacs-tests.el
@@ -0,0 +1,263 @@
+;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for src/emacs.c.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+(require 'rx)
+(require 'subr-x)
+
+(defconst emacs-tests--lib-src
+ (substitute-in-file-name "$EMACS_TEST_DIRECTORY/../lib-src/")
+ "Location of the lib-src directory.")
+
+(ert-deftest emacs-tests/seccomp/absent-file ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (should-not (file-exists-p "/does-not-exist.bpf"))
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ "--seccomp=/does-not-exist.bpf")
+ 0))))
+
+(cl-defmacro emacs-tests--with-temp-file
+ (var (prefix &optional suffix text) &rest body)
+ "Evaluate BODY while a new temporary file exists.
+Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT
+to `make-temp-file', which see."
+ (declare (indent 2) (debug (symbolp (form form form) body)))
+ (cl-check-type var symbol)
+ ;; Use an uninterned symbol so that the code still works if BODY
+ ;; changes VAR.
+ (let ((filename (make-symbol "filename")))
+ `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text)))
+ (unwind-protect
+ (let ((,var ,filename))
+ ,@body)
+ (delete-file ,filename)))))
+
+(ert-deftest emacs-tests/seccomp/empty-file ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf")
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't
+ ;; work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ ;; According to the Seccomp man page, a filter must have at
+ ;; least one element, so Emacs should reject an empty file.
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter))
+ 0)))))
+
+(ert-deftest emacs-tests/seccomp/file-too-large ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil)
+ ;; This value should be correct on all supported systems.
+ (ushort-max #xFFFF)
+ ;; Either 8 or 16, but 16 should be large enough in all cases.
+ (filter-size 16))
+ (skip-unless (file-executable-p emacs))
+ (emacs-tests--with-temp-file
+ filter ("seccomp-too-large-" ".bpf"
+ (make-string (* (1+ ushort-max) filter-size) ?a))
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't
+ ;; work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ ;; The filter count must fit into an `unsigned short'. A bigger
+ ;; file should be rejected.
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter))
+ 0)))))
+
+(ert-deftest emacs-tests/seccomp/invalid-file-size ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf"
+ "123456")
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't
+ ;; work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ ;; The Seccomp filter file must have a file size that's a
+ ;; multiple of the size of struct sock_filter, which is 8 or 16,
+ ;; but never 6.
+ (should-not
+ (eql (call-process emacs nil nil nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter))
+ 0)))))
+
+(ert-deftest emacs-tests/seccomp/allows-stdout ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (filter (expand-file-name "seccomp-filter.bpf"
+ emacs-tests--lib-src))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (file-readable-p filter))
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ (with-temp-buffer
+ (let ((start-time (current-time))
+ (status (call-process
+ emacs nil t nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter)
+ (format "--eval=%S" '(message "Hi"))))
+ (end-time (current-time)))
+ (ert-info ((emacs-tests--seccomp-debug start-time end-time))
+ (should (eql status 0)))
+ (should (equal (string-trim (buffer-string)) "Hi"))))))
+
+(ert-deftest emacs-tests/seccomp/forbids-subprocess ()
+ (skip-unless (string-match-p (rx bow "SECCOMP" eow)
+ system-configuration-features))
+ (let ((emacs
+ (expand-file-name invocation-name invocation-directory))
+ (filter (expand-file-name "seccomp-filter.bpf"
+ emacs-tests--lib-src))
+ (process-environment nil))
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (file-readable-p filter))
+ ;; The --seccomp option is processed early, without filename
+ ;; handlers. Therefore remote or quoted filenames wouldn't work.
+ (should-not (file-remote-p filter))
+ (cl-callf file-name-unquote filter)
+ (with-temp-buffer
+ (let ((start-time (current-time))
+ (status
+ (call-process
+ emacs nil t nil
+ "--quick" "--batch"
+ (concat "--seccomp=" filter)
+ (format "--eval=%S" `(call-process ,emacs nil nil nil
+ "--version"))))
+ (end-time (current-time)))
+ (ert-info ((emacs-tests--seccomp-debug start-time end-time))
+ (should-not (eql status 0)))))))
+
+(ert-deftest emacs-tests/bwrap/allows-stdout ()
+ (let ((bash (executable-find "bash"))
+ (bwrap (executable-find "bwrap"))
+ (emacs
+ (expand-file-name invocation-name invocation-directory))
+ (filter (expand-file-name "seccomp-filter-exec.bpf"
+ emacs-tests--lib-src))
+ (process-environment nil))
+ (skip-unless bash)
+ (skip-unless bwrap)
+ (skip-unless (file-executable-p emacs))
+ (skip-unless (file-readable-p filter))
+ (should-not (file-remote-p bwrap))
+ (should-not (file-remote-p emacs))
+ (should-not (file-remote-p filter))
+ (with-temp-buffer
+ (let* ((command
+ (concat
+ (mapconcat #'shell-quote-argument
+ `(,(file-name-unquote bwrap)
+ "--ro-bind" "/" "/"
+ "--seccomp" "20"
+ "--"
+ ,(file-name-unquote emacs)
+ "--quick" "--batch"
+ ,(format "--eval=%S" '(message "Hi")))
+ " ")
+ " 20< "
+ (shell-quote-argument (file-name-unquote filter))))
+ (start-time (current-time))
+ (status (call-process bash nil t nil "-c" command))
+ (end-time (current-time)))
+ (ert-info ((emacs-tests--seccomp-debug start-time end-time))
+ (should (eql status 0)))
+ (should (equal (string-trim (buffer-string)) "Hi"))))))
+
+(defun emacs-tests--seccomp-debug (start-time end-time)
+ "Return potentially useful debugging information for Seccomp.
+Assume that the current buffer contains subprocess output for the
+failing process. START-TIME and END-TIME are time values between
+which the process was running."
+ ;; Add a bit of slack for the timestamps.
+ (cl-callf time-subtract start-time 5)
+ (cl-callf time-add end-time 5)
+ (with-output-to-string
+ (princ "Process output:")
+ (terpri)
+ (princ (buffer-substring-no-properties (point-min) (point-max)))
+ ;; Search audit logs for Seccomp messages.
+ (when-let ((ausearch (executable-find "ausearch")))
+ (terpri)
+ (princ "Potentially relevant Seccomp audit events:")
+ (terpri)
+ (let ((process-environment '("LC_TIME=C")))
+ (call-process ausearch nil standard-output nil
+ "--message" "SECCOMP"
+ "--start"
+ (format-time-string "%D" start-time)
+ (format-time-string "%T" start-time)
+ "--end"
+ (format-time-string "%D" end-time)
+ (format-time-string "%T" end-time)
+ "--interpret")))
+ ;; Print coredump information if available.
+ (when-let ((coredumpctl (executable-find "coredumpctl")))
+ (terpri)
+ (princ "Potentially useful coredump information:")
+ (terpri)
+ (call-process coredumpctl nil standard-output nil
+ "info"
+ "--since" (format-time-string "%F %T" start-time)
+ "--until" (format-time-string "%F %T" end-time)
+ "--no-pager"))))
+
+;;; emacs-tests.el ends here
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 7f193d4eeab..f4d123b4261 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -1,4 +1,4 @@
-;;; unit tests for src/fileio.c -*- lexical-binding: t; -*-
+;;; fileio-tests.el --- unit tests for src/fileio.c -*- lexical-binding: t; -*-
;; Copyright 2017-2021 Free Software Foundation, Inc.
@@ -160,4 +160,26 @@ Also check that an encoding error can appear in a symlink."
(should-error (file-exists-p "/foo\0bar")
:type 'wrong-type-argument))
+(ert-deftest fileio-tests/file-name-concat ()
+ (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo" "bar" "zot") "foo/bar/zot"))
+ (should (equal (file-name-concat "foo/" "bar") "foo/bar"))
+ (should (equal (file-name-concat "foo//" "bar") "foo//bar"))
+ (should (equal (file-name-concat "foo/" "bar/" "zot") "foo/bar/zot"))
+ (should (equal (file-name-concat "fóo" "bar") "fóo/bar"))
+ (should (equal (file-name-concat "foo" "bár") "foo/bár"))
+ (should (equal (file-name-concat "fóo" "bár") "fóo/bár"))
+ (let ((string (make-string 5 ?a)))
+ (should (not (multibyte-string-p string)))
+ (aset string 2 255)
+ (should (not (multibyte-string-p string)))
+ (should (equal (file-name-concat "fóo" string) "fóo/aa\377aa")))
+ (should (equal (file-name-concat "foo") "foo"))
+ (should (equal (file-name-concat "foo/") "foo/"))
+ (should (equal (file-name-concat "foo" "") "foo"))
+ (should (equal (file-name-concat "foo" "" "" "" nil) "foo"))
+ (should (equal (file-name-concat "" "bar") "bar"))
+ (should (equal (file-name-concat "" "") "")))
+
;;; fileio-tests.el ends here
diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
new file mode 100644
index 00000000000..a96d6d67289
--- /dev/null
+++ b/test/src/filelock-tests.el
@@ -0,0 +1,183 @@
+;;; filelock-tests.el --- test file locking -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file tests code in src/filelock.c and, to some extent, the
+;; related code in src/fileio.c.
+;;
+;; See also (info "(emacs)Interlocking") and (info "(elisp)File Locks")
+
+;;; Code:
+
+(require 'cl-macs)
+(require 'ert)
+(require 'seq)
+
+(defun filelock-tests--fixture (test-function)
+ "Call TEST-FUNCTION under a test fixture.
+Create a test directory and a buffer whose `buffer-file-name' and
+`buffer-file-truename' are a file within it, then call
+TEST-FUNCTION. Finally, delete the buffer and the test
+directory."
+ (let* ((temp-dir (make-temp-file "filelock-tests" t))
+ (name (concat (file-name-as-directory temp-dir)
+ "userfile"))
+ (create-lockfiles t))
+ (unwind-protect
+ (with-temp-buffer
+ (setq buffer-file-name name
+ buffer-file-truename name)
+ (unwind-protect
+ (save-current-buffer
+ (funcall test-function))
+ ;; Set `buffer-file-truename' nil to prevent unlocking,
+ ;; which might prompt the user and/or signal errors.
+ (setq buffer-file-name nil
+ buffer-file-truename nil)))
+ (delete-directory temp-dir t nil))))
+
+(defun filelock-tests--make-lock-name (file-name)
+ "Return the lock file name for FILE-NAME.
+Equivalent logic in Emacs proper is implemented in C and
+unavailable to Lisp."
+ (concat (file-name-directory (expand-file-name file-name))
+ ".#"
+ (file-name-nondirectory file-name)))
+
+(defun filelock-tests--spoil-lock-file (file-name)
+ "Spoil the lock file for FILE-NAME.
+Cause Emacs to report errors for various file locking operations
+on FILE-NAME going forward. Create a file that is incompatible
+with Emacs' file locking protocol, but uses the same name as
+FILE-NAME's lock file. A directory file is used, which is
+portable in practice."
+ (make-directory (filelock-tests--make-lock-name file-name)))
+
+(defun filelock-tests--unspoil-lock-file (file-name)
+ "Remove the lock file spoiler for FILE-NAME.
+See `filelock-tests--spoil-lock-file'."
+ (delete-directory (filelock-tests--make-lock-name file-name) t))
+
+(defun filelock-tests--should-be-locked ()
+ "Abort the current test if the current buffer is not locked.
+Exception: on systems without lock file support, aborts the
+current test if the current file is locked (which should never
+the case)."
+ (if (eq system-type 'ms-dos)
+ (should-not (file-locked-p buffer-file-truename))
+ (should (file-locked-p buffer-file-truename))))
+
+(ert-deftest filelock-tests-lock-unlock-no-errors ()
+ "Check that locking and unlocking works without error."
+ (filelock-tests--fixture
+ (lambda ()
+ (should-not (file-locked-p (buffer-file-name)))
+
+ ;; inserting text should lock the buffer's file.
+ (insert "this locks the buffer's file")
+ (filelock-tests--should-be-locked)
+ (unlock-buffer)
+ (set-buffer-modified-p nil)
+ (should-not (file-locked-p (buffer-file-name)))
+
+ ;; `set-buffer-modified-p' should lock the buffer's file.
+ (set-buffer-modified-p t)
+ (filelock-tests--should-be-locked)
+ (unlock-buffer)
+ (should-not (file-locked-p (buffer-file-name)))
+
+ (should-not (file-locked-p (buffer-file-name))))))
+
+(ert-deftest filelock-tests-lock-spoiled ()
+ "Check `lock-buffer' ."
+ (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (filelock-tests--fixture
+ (lambda ()
+ (filelock-tests--spoil-lock-file buffer-file-truename)
+ ;; FIXME: errors when locking a file are ignored; should they be?
+ (set-buffer-modified-p t)
+ (filelock-tests--unspoil-lock-file buffer-file-truename)
+ (should-not (file-locked-p buffer-file-truename)))))
+
+(ert-deftest filelock-tests-file-locked-p-spoiled ()
+ "Check that `file-locked-p' fails if the lockfile is \"spoiled\"."
+ (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (filelock-tests--fixture
+ (lambda ()
+ (filelock-tests--spoil-lock-file buffer-file-truename)
+ (let ((err (should-error (file-locked-p (buffer-file-name)))))
+ (should (equal (seq-subseq err 0 2)
+ '(file-error "Testing file lock")))))))
+
+(ert-deftest filelock-tests-unlock-spoiled ()
+ "Check that `unlock-buffer' fails if the lockfile is \"spoiled\"."
+ (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (filelock-tests--fixture
+ (lambda ()
+ ;; Set the buffer modified with file locking temporarily
+ ;; disabled.
+ (let ((create-lockfiles nil))
+ (set-buffer-modified-p t))
+ (should-not (file-locked-p buffer-file-truename))
+ (filelock-tests--spoil-lock-file buffer-file-truename)
+
+ ;; Errors from `unlock-buffer' should call
+ ;; `userlock--handle-unlock-error' (bug#46397).
+ (let (errors)
+ (cl-letf (((symbol-function 'userlock--handle-unlock-error)
+ (lambda (err) (push err errors))))
+ (unlock-buffer))
+ (should (consp errors))
+ (should (equal '(file-error "Unlocking file")
+ (seq-subseq (car errors) 0 2)))
+ (should (equal (length errors) 1))))))
+
+(ert-deftest filelock-tests-kill-buffer-spoiled ()
+ "Check that `kill-buffer' fails if a lockfile is \"spoiled\"."
+ (skip-unless (not (eq system-type 'ms-dos))) ; no filelock support
+ (filelock-tests--fixture
+ (lambda ()
+ ;; Set the buffer modified with file locking temporarily
+ ;; disabled.
+ (let ((create-lockfiles nil))
+ (set-buffer-modified-p t))
+ (should-not (file-locked-p buffer-file-truename))
+ (filelock-tests--spoil-lock-file buffer-file-truename)
+
+ ;; Kill the current buffer. Because the buffer is modified Emacs
+ ;; will attempt to unlock it. Temporarily bind `yes-or-no-p' to
+ ;; a function that fakes a "yes" answer for the "Buffer modified;
+ ;; kill anyway?" prompt.
+ ;;
+ ;; File errors from unlocking files should call
+ ;; `userlock--handle-unlock-error' (bug#46397).
+ (let (errors)
+ (cl-letf (((symbol-function 'yes-or-no-p)
+ (lambda (&rest _) t))
+ ((symbol-function 'userlock--handle-unlock-error)
+ (lambda (err) (push err errors))))
+ (kill-buffer))
+ (should (consp errors))
+ (should (equal '(file-error "Unlocking file")
+ (seq-subseq (car errors) 0 2)))
+ (should (equal (length errors) 1))))))
+
+(provide 'filelock-tests)
+;;; filelock-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 928fb15f109..9f6593a177c 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index de153b8de9b..ea57b122f4f 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -159,6 +159,31 @@ expected font properties from parsing NAME.")
(insert "\n"))))
(goto-char (point-min)))
+(ert-deftest font-parse-xlfd-test ()
+ ;; Normal number of segments.
+ (should (equal (font-get
+ (font-spec :name "-GNU -FreeSans-semibold-italic-normal-*-*-*-*-*-*-0-iso10646-1")
+ :family)
+ 'FreeSans))
+ (should (equal (font-get
+ (font-spec :name "-GNU -FreeSans-semibold-italic-normal-*-*-*-*-*-*-0-iso10646-1")
+ :foundry)
+ 'GNU\ ))
+ ;; Dash in the family name.
+ (should (equal (font-get
+ (font-spec :name "-Take-mikachan-PS-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1")
+ :family)
+ 'mikachan-PS))
+ (should (equal (font-get
+ (font-spec :name "-Take-mikachan-PS-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1")
+ :weight)
+ 'normal))
+ ;; Synthetic test.
+ (should (equal (font-get
+ (font-spec :name "-foundry-name-with-lots-of-dashes-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1")
+ :family)
+ 'name-with-lots-of-dashes)))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el
index 10f1202949b..6a3f1a5c95f 100644
--- a/test/src/indent-tests.el
+++ b/test/src/indent-tests.el
@@ -4,18 +4,18 @@
;; This file is part of GNU Emacs.
-;; This program is free software: you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation, either version 3 of the
-;; License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `https://www.gnu.org/licenses/'.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 4be11b8c81a..8dc0a744aa0 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -51,6 +51,34 @@
(should (equal (json-parse-buffer) lisp))
(should (eobp)))))
+(ert-deftest json-serialize/roundtrip-scalars ()
+ "Check that Bug#42994 is fixed."
+ (skip-unless (fboundp 'json-serialize))
+ (dolist (case '((:null "null")
+ (:false "false")
+ (t "true")
+ (0 "0")
+ (123 "123")
+ (-456 "-456")
+ (3.75 "3.75")
+ ;; The noncharacter U+FFFF should be passed through,
+ ;; cf. https://www.unicode.org/faq/private_use.html#noncharacters.
+ ("abc\uFFFFαβγ𝔸𝐁𝖢\"\\"
+ "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"")))
+ (cl-destructuring-bind (lisp json) case
+ (ert-info ((format "%S ↔ %S" lisp json))
+ (should (equal (json-serialize lisp) json))
+ (with-temp-buffer
+ (json-insert lisp)
+ (should (equal (buffer-string) json))
+ (should (eobp)))
+ (should (equal (json-parse-string json) lisp))
+ (with-temp-buffer
+ (insert json)
+ (goto-char 1)
+ (should (equal (json-parse-buffer) lisp))
+ (should (eobp)))))))
+
(ert-deftest json-serialize/object ()
(skip-unless (fboundp 'json-serialize))
(let ((table (make-hash-table :test #'equal)))
@@ -224,7 +252,7 @@ Test with both unibyte and multibyte strings."
(let* ((input
"{ \"abc\" : [9, false] , \"def\" : null }")
(output
- (replace-regexp-in-string " " "" input)))
+ (string-replace " " "" input)))
(should (equal (json-parse-string input
:object-type 'plist
:null-object :json-null
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
index 607d2eafd45..41c8cdd15f0 100644
--- a/test/src/keyboard-tests.el
+++ b/test/src/keyboard-tests.el
@@ -23,14 +23,15 @@
(ert-deftest keyboard-unread-command-events ()
"Test `unread-command-events'."
- (should (equal (progn (push ?\C-a unread-command-events)
- (read-event nil nil 1))
- ?\C-a))
- (should (equal (progn (run-with-timer
- 1 nil
- (lambda () (push '(t . ?\C-b) unread-command-events)))
- (read-event nil nil 2))
- ?\C-b)))
+ (let ((unread-command-events nil))
+ (should (equal (progn (push ?\C-a unread-command-events)
+ (read-event nil nil 1))
+ ?\C-a))
+ (should (equal (progn (run-with-timer
+ 1 nil
+ (lambda () (push '(t . ?\C-b) unread-command-events)))
+ (read-event nil nil 2))
+ ?\C-b))))
(ert-deftest keyboard-lossage-size ()
"Test `lossage-size'."
@@ -46,6 +47,28 @@
(should-error (lossage-size (1- min-value)))
(should (= lossage-orig (lossage-size lossage-orig)))))
+;; FIXME: This test doesn't currently work :-(
+;; (ert-deftest keyboard-tests--echo-keystrokes-bug15332 ()
+;; (let ((msgs '())
+;; (unread-command-events nil)
+;; (redisplay--interactive t)
+;; (echo-keystrokes 2))
+;; (setq unread-command-events '(?\C-u))
+;; (let* ((timer1
+;; (run-with-timer 3 1
+;; (lambda ()
+;; (setq unread-command-events '(?5)))))
+;; (timer2
+;; (run-with-timer 2.5 1
+;; (lambda ()
+;; (push (current-message) msgs)))))
+;; (run-with-timer 5 nil
+;; (lambda ()
+;; (cancel-timer timer1)
+;; (cancel-timer timer2)
+;; (throw 'exit msgs)))
+;; (recursive-edit)
+;; (should (equal msgs '("C-u 55-" "C-u 5-" "C-u-"))))))
(provide 'keyboard-tests)
;;; keyboard-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index d4f5fc3f190..a9b0cb502d3 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -63,10 +63,66 @@
(keymap--get-keyelt object t)
(should menu-item-filter-ran)))
+(ert-deftest keymap-define-key/undefined ()
+ ;; nil (means key is undefined in this keymap),
+ (let ((map (make-keymap)))
+ (define-key map [?a] nil)
+ (should-not (lookup-key map [?a]))))
+
+(ert-deftest keymap-define-key/keyboard-macro ()
+ ;; a string (treated as a keyboard macro),
+ (let ((map (make-keymap)))
+ (define-key map [?a] "abc")
+ (should (equal (lookup-key map [?a]) "abc"))))
+
+(ert-deftest keymap-define-key/lambda ()
+ (let ((map (make-keymap)))
+ (define-key map [?a] (lambda () (interactive) nil))
+ (should (functionp (lookup-key map [?a])))))
+
+(ert-deftest keymap-define-key/keymap ()
+ ;; a keymap (to define a prefix key),
+ (let ((map (make-keymap))
+ (map2 (make-keymap)))
+ (define-key map [?a] map2)
+ (define-key map2 [?b] 'foo)
+ (should (eq (lookup-key map [?a ?b]) 'foo))))
+
+(ert-deftest keymap-define-key/menu-item ()
+ ;; or an extended menu item definition.
+ ;; (See info node ‘(elisp)Extended Menu Items’.)
+ (let ((map (make-sparse-keymap))
+ (menu (make-sparse-keymap)))
+ (define-key menu [new-file]
+ '(menu-item "Visit New File..." find-file
+ :enable (menu-bar-non-minibuffer-window-p)
+ :help "Specify a new file's name, to edit the file"))
+ (define-key map [menu-bar file] (cons "File" menu))
+ (should (eq (lookup-key map [menu-bar file new-file]) 'find-file))))
+
(ert-deftest keymap-lookup-key ()
(let ((map (make-keymap)))
(define-key map [?a] 'foo)
- (should (eq (lookup-key map [?a]) 'foo))))
+ (should (eq (lookup-key map [?a]) 'foo))
+ (should-not (lookup-key map [?b]))))
+
+(ert-deftest keymap-lookup-key/list-of-keymaps ()
+ (let ((map1 (make-keymap))
+ (map2 (make-keymap)))
+ (define-key map1 [?a] 'foo)
+ (define-key map2 [?b] 'bar)
+ (should (eq (lookup-key (list map1 map2) [?a]) 'foo))
+ (should (eq (lookup-key (list map1 map2) [?b]) 'bar))
+ (should-not (lookup-key (list map1 map2) [?c]))))
+
+(ert-deftest keymap-lookup-key/too-long ()
+ (let ((map (make-keymap)))
+ (define-key map (kbd "C-c f") 'foo)
+ (should (= (lookup-key map (kbd "C-c f x")) 2))))
+
+;; TODO: Write test for the ACCEPT-DEFAULT argument.
+;; (ert-deftest keymap-lookup-key/accept-default ()
+;; ...)
(ert-deftest describe-buffer-bindings/header-in-current-buffer ()
"Header should be inserted into the current buffer.
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index f2a60bcf327..dac8f95bc4d 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -196,4 +196,71 @@ literals (Bug#20852)."
(should-error (read-event "foo: "))
(should-error (read-char-exclusive "foo: "))))
+(ert-deftest lread-float ()
+ (should (equal (read "13") 13))
+ (should (equal (read "+13") 13))
+ (should (equal (read "-13") -13))
+ (should (equal (read "13.") 13))
+ (should (equal (read "+13.") 13))
+ (should (equal (read "-13.") -13))
+ (should (equal (read "13.25") 13.25))
+ (should (equal (read "+13.25") 13.25))
+ (should (equal (read "-13.25") -13.25))
+ (should (equal (read ".25") 0.25))
+ (should (equal (read "+.25") 0.25))
+ (should (equal (read "-.25") -0.25))
+ (should (equal (read "13e4") 130000.0))
+ (should (equal (read "+13e4") 130000.0))
+ (should (equal (read "-13e4") -130000.0))
+ (should (equal (read "13e+4") 130000.0))
+ (should (equal (read "+13e+4") 130000.0))
+ (should (equal (read "-13e+4") -130000.0))
+ (should (equal (read "625e-4") 0.0625))
+ (should (equal (read "+625e-4") 0.0625))
+ (should (equal (read "-625e-4") -0.0625))
+ (should (equal (read "1.25e2") 125.0))
+ (should (equal (read "+1.25e2") 125.0))
+ (should (equal (read "-1.25e2") -125.0))
+ (should (equal (read "1.25e+2") 125.0))
+ (should (equal (read "+1.25e+2") 125.0))
+ (should (equal (read "-1.25e+2") -125.0))
+ (should (equal (read "1.25e-1") 0.125))
+ (should (equal (read "+1.25e-1") 0.125))
+ (should (equal (read "-1.25e-1") -0.125))
+ (should (equal (read "4.e3") 4000.0))
+ (should (equal (read "+4.e3") 4000.0))
+ (should (equal (read "-4.e3") -4000.0))
+ (should (equal (read "4.e+3") 4000.0))
+ (should (equal (read "+4.e+3") 4000.0))
+ (should (equal (read "-4.e+3") -4000.0))
+ (should (equal (read "5.e-1") 0.5))
+ (should (equal (read "+5.e-1") 0.5))
+ (should (equal (read "-5.e-1") -0.5))
+ (should (equal (read "0") 0))
+ (should (equal (read "+0") 0))
+ (should (equal (read "-0") 0))
+ (should (equal (read "0.") 0))
+ (should (equal (read "+0.") 0))
+ (should (equal (read "-0.") 0))
+ (should (equal (read "0.0") 0.0))
+ (should (equal (read "+0.0") 0.0))
+ (should (equal (read "-0.0") -0.0))
+ (should (equal (read "0e5") 0.0))
+ (should (equal (read "+0e5") 0.0))
+ (should (equal (read "-0e5") -0.0))
+ (should (equal (read "0e-5") 0.0))
+ (should (equal (read "+0e-5") 0.0))
+ (should (equal (read "-0e-5") -0.0))
+ (should (equal (read ".0e-5") 0.0))
+ (should (equal (read "+.0e-5") 0.0))
+ (should (equal (read "-.0e-5") -0.0))
+ (should (equal (read "0.0e-5") 0.0))
+ (should (equal (read "+0.0e-5") 0.0))
+ (should (equal (read "-0.0e-5") -0.0))
+ (should (equal (read "0.e-5") 0.0))
+ (should (equal (read "+0.e-5") 0.0))
+ (should (equal (read "-0.e-5") -0.0))
+ )
+
+
;;; lread-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index e62bcb3f7c0..9bab523708e 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -26,9 +26,9 @@
(require 'cl-lib)
(require 'ert)
(require 'puny)
-(require 'rx)
(require 'subr-x)
(require 'dns)
+(require 'url-http)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -348,8 +348,7 @@ See Bug#30460."
invocation-directory))
:stop t))))
-;; All the following tests require working DNS, which appears not to
-;; be the case for hydra.nixos.org, so disable them there for now.
+;; The following tests require working DNS
;; This will need updating when IANA assign more IPv6 global ranges.
(defun ipv6-is-available ()
@@ -360,9 +359,16 @@ See Bug#30460."
(= (logand (aref elt 0) #xe000) #x2000)))
(network-interface-list))))
+;; Check if the Internet seems to be working. Mainly to pacify
+;; Debian's CI system.
+(defvar internet-is-working
+ (progn
+ (require 'dns)
+ (dns-query "google.com")))
+
(ert-deftest lookup-family-specification ()
"`network-lookup-address-info' should only accept valid family symbols."
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-unless internet-is-working)
(with-timeout (60 (ert-fail "Test timed out"))
(should-error (network-lookup-address-info "localhost" 'both))
(should (network-lookup-address-info "localhost" 'ipv4))
@@ -371,20 +377,20 @@ See Bug#30460."
(ert-deftest lookup-unicode-domains ()
"Unicode domains should fail."
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-unless internet-is-working)
(with-timeout (60 (ert-fail "Test timed out"))
(should-error (network-lookup-address-info "faß.de"))
(should (network-lookup-address-info (puny-encode-domain "faß.de")))))
(ert-deftest unibyte-domain-name ()
"Unibyte domain names should work."
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-unless internet-is-working)
(with-timeout (60 (ert-fail "Test timed out"))
(should (network-lookup-address-info (string-to-unibyte "google.com")))))
(ert-deftest lookup-google ()
"Check that we can look up google IP addresses."
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-unless internet-is-working)
(with-timeout (60 (ert-fail "Test timed out"))
(let ((addresses-both (network-lookup-address-info "google.com"))
(addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
@@ -396,10 +402,12 @@ See Bug#30460."
(ert-deftest non-existent-lookup-failure ()
"Check that looking up non-existent domain returns nil."
- (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+ (skip-unless internet-is-working)
(with-timeout (60 (ert-fail "Test timed out"))
(should (eq nil (network-lookup-address-info "emacs.invalid")))))
+;; End of tests requiring DNS
+
(defmacro process-tests--ignore-EMFILE (&rest body)
"Evaluate BODY, ignoring EMFILE errors."
(declare (indent 0) (debug t))
@@ -619,6 +627,8 @@ FD_SETSIZE file descriptors (Bug#24325)."
FD_SETSIZE file descriptors (Bug#24325)."
(skip-unless (featurep 'make-network-process '(:server t)))
(skip-unless (featurep 'make-network-process '(:family local)))
+ ;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496).
+ (skip-unless (not (eq system-type 'cygwin)))
(with-timeout (60 (ert-fail "Test timed out"))
(process-tests--with-temp-directory directory
(process-tests--with-processes processes
@@ -907,5 +917,34 @@ Return nil if FILENAME doesn't exist."
;; ...and the change description should be "interrupt".
(should (equal '("interrupt\n") events)))))
+(ert-deftest process-async-https-with-delay ()
+ "Bug#49449: asynchronous TLS connection with delayed completion."
+ (skip-unless (and internet-is-working (gnutls-available-p)))
+ (let* ((status nil)
+ (buf (url-http
+ #s(url "https" nil nil "elpa.gnu.org" nil
+ "/packages/archive-contents" nil nil t silent t t)
+ (lambda (s) (setq status s))
+ '(nil) nil 'tls)))
+ (unwind-protect
+ (progn
+ ;; Busy-wait for 1 s to allow for the TCP connection to complete.
+ (let ((delay 1.0)
+ (t0 (float-time)))
+ (while (< (float-time) (+ t0 delay))))
+ ;; Wait for the entire operation to finish.
+ (let ((limit 4.0)
+ (t0 (float-time)))
+ (while (and (null status)
+ (< (float-time) (+ t0 limit)))
+ (sit-for 0.1)))
+ (should status)
+ (should-not (assq :error status))
+ (should buf)
+ (should (> (buffer-size buf) 0))
+ )
+ (when buf
+ (kill-buffer buf)))))
+
(provide 'process-tests)
;;; process-tests.el ends here
diff --git a/test/src/search-tests.el b/test/src/search-tests.el
new file mode 100644
index 00000000000..b7b4ab9a8ff
--- /dev/null
+++ b/test/src/search-tests.el
@@ -0,0 +1,42 @@
+;;; search-tests.el --- tests for search.c functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015-2016, 2018-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest test-replace-match-modification-hooks ()
+ (let ((ov-set nil))
+ (with-temp-buffer
+ (insert "1 abc")
+ (setq ov-set (make-overlay 3 5))
+ (overlay-put
+ ov-set 'modification-hooks
+ (list (lambda (o after &rest _args)
+ (when after
+ (let ((inhibit-modification-hooks t))
+ (save-excursion
+ (goto-char 2)
+ (insert "234")))))))
+ (goto-char 3)
+ (if (search-forward "bc")
+ (replace-match "bcd"))
+ (should (= (point) 10)))))
+
+;;; search-tests.el ends here
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 479b818935f..e4e3054d37a 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -21,6 +21,7 @@
(require 'ert)
(require 'ert-x)
+(require 'cl-lib)
(ert-deftest parse-partial-sexp-continue-over-comment-marker ()
"Continue a parse that stopped in the middle of a comment marker."
@@ -56,6 +57,16 @@
(should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC)
ppsX)))))
+(ert-deftest syntax-class-character-test ()
+ (cl-loop for char across " .w_()'\"$\\/<>@!|"
+ for i from 0
+ do (should (= char (syntax-class-to-char i)))
+ when (string-to-syntax (string char))
+ do (should (= char (syntax-class-to-char
+ (car (string-to-syntax (string char)))))))
+ (should-error (syntax-class-to-char -1))
+ (should-error (syntax-class-to-char 200)))
+
(ert-deftest parse-partial-sexp-paren-comments ()
"Test syntax parsing with paren comment markers.
Specifically, where the first character of the comment marker is
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index f14d2426ef0..fc7bc7441b7 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -1,4 +1,4 @@
-;;; threads.el --- tests for threads. -*- lexical-binding: t -*-
+;;; thread-tests.el --- tests for threads. -*- lexical-binding: t -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
@@ -315,8 +315,8 @@
"Test signaling a thread as soon as it is started by the OS."
(skip-unless (featurep 'threads))
(let ((thread
- (make-thread #'(lambda ()
- (while t (thread-yield))))))
+ (make-thread (lambda ()
+ (while t (thread-yield))))))
(thread-signal thread 'error nil)
(sit-for 1)
(should-not (thread-live-p thread))
@@ -331,7 +331,7 @@
(let (buffer-read-only)
(erase-buffer))
(let ((thread
- (make-thread #'(lambda () (thread-signal main-thread 'error nil)))))
+ (make-thread (lambda () (thread-signal main-thread 'error nil)))))
(while (thread-live-p thread)
(thread-yield))
(read-event nil nil 0.1)
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index e55bd1eb4ee..0a450a7573f 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -1,4 +1,4 @@
-;;; timefns-tests.el -- tests for timefns.c -*- lexical-binding: t -*-
+;;; timefns-tests.el --- tests for timefns.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2021 Free Software Foundation, Inc.
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 055bf102dfc..a658bccf6dc 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -46,6 +46,7 @@
;;; Code:
(require 'ert)
+(require 'facemenu)
(ert-deftest undo-test0 ()
"Test basics of \\[undo]."
@@ -87,6 +88,7 @@
(ert-deftest undo-test1 ()
"Test undo of \\[undo] command (redo)."
+ (require 'facemenu)
(with-temp-buffer
(buffer-enable-undo)
(undo-boundary)